/*
 *	APfuncs.c
 */

/*
 *  Pourquoi 1 seul fichier de fonctions ? Bonne question ! La logique de
 *  programmation habituelle (dictee par qui, le bon sens, hum ?) impose
 *  de programmer structure. Cela implique l'utilisation de modules separes
 *  pour chaque fonction de base.
 *
 *  On dit que cela permet d'avoir un code plus lisible (pourquoi pas ?).
 *  Cependant, il existe un probleme dans le cadre d'une librairie de
 *  foncstions. En effet certaines fonctions peuvent etre vue privee dans
 *  un module (static en C). D'autres privee a la librairie. C'est a dire
 *  une fonction non disponible a l'exterieur de la librairie, mais publique
 *  pour chaque module de la librairie (la fonction do_print() en est un
 *  exemple). Malheureusement en C il est impossible de faire un tel
 *  distinguo, puisqu'il ne connait que la privaute au sein d'un module.
 *
 *  En C on est donc contraint a declarer ces fonctions publique. Cela pose
 *  des pbs a l'utilisateur de la librairie qui peut utiliser cette fonction
 *  sans connaitre son existance et provoquer des bugs (re-definition d'une
 *  fonction de bibliotheque). Par exemple, la fonction t_format()
 *  (_pfmtone() pour DICE) est parfois utilisee par printf() pour la sortie
 *  et je vous deconseille alors d'avoir une fonction qui porte le meme nom
 *  dans votre programme. La solution alors utilisee est de choisir le nom
 *  des fonctions de telle sorte qu'il soit peu probable que l'utilisateur
 *  choisisse un homonyme. Cepandant puisque ces fonctions ne sont pas
 *  doccumentees, il n'est pas impossible que cela arrive. De plus, les
 *  noms sont alors parfois prefixes d'une sequence identique (_ ou lib_
 *  en general). Ainsi le code apparait beaucoup moins clair a lire:
 *
 *	    int _lib_purify_do_print(fmt, ... )...
 *	    void proc_x()
 *	    {
 *	    _lib_purify_do_print("Ah que le nom de cette procedure"
 *				 "est peinible a ecrire !!!!");
 *	    }
 *
 *  La solution que je choisis pour ce source c'est de tout garder dans
 *  Un seul fichier et tout les static du modules sont donc les static de
 *  la bibliotheque. Ca fait un peu bordelique (le code depasse 19Ko),
 *  mais bon, s'il le faut, je decouperai cela un peu peut-etre (mais cela
 *  ferait passer beaucoup de procedures de static a public pour presque
 *  rien, donc je verrais... :-). En attendant, le code est comme ca. Ce que
 *  je lui reproche le plus est qu'il pourrait etre re-organise (mais bon,
 *  je travaille sur diskette avec 1Mo et j'ai pas specialement envie de
 *  passer mes nuits dessus). En general, les gens qui sont tres "modules"
 *  passent bcp de temps a decouper leur code alors qu'il est deja assez
 *  petit. Cela fait apparaitre plein de bugs nouveaux qu'il mettent un temps
 *  fou a trouver. En gros je pense que cela fait perdre bcp de temps pour
 *  pas grand chose tout compte fait (c'est un peu le meme phenomene avec
 *  les programmateurs "objets" qui font rammer leurs programmes a cause
 *  d'un nombre d'acces a des fonctions(methodes) bcp trop grand !).
 *
 */

#include <stdio.h>

#define TRD(FRANCAIS, ANGLAIS)  ANGLAIS     /* which translation ? */

#define ifn(x)          if(!(x))            /* usefull define */

#define WARNING 	"**** APURIFY WARNING !"
#define ERROR		"**** APURIFY ERROR !"

#define LVOAllocMem	(-0xC6)
#define LVOFreeMem	(-0xD2)

#define LARG_LINE	76
#define MARG_LINE	8

#define CACHE_SIZE	2 /* nb chunk en cache */

extern void	*AsmAllocMem(),AsmFreeMem();
extern void	*StdAlloc(),StdFree();

#define APopen	1
#define APlock	2
#define APwarn	4

typedef unsigned long ULONG;
typedef unsigned char UBYTE;

typedef struct simplecli
	{
	char tab1[60];
	ULONG Module;
	} simplecli;

typedef struct simpletask
	{
	char tab[58];
	ULONG BasPileTache,HautPileTache;
	char tab2[62];
	ULONG SegList;
	char tab3[40];
	ULONG CLI;
	} simpletask;

static ULONG APflg=0;
static simpletask *ThisTask;
extern simpletask *FindTask();
extern ULONG SetFunction();
static ULONG MallocProc,FreeProc;

char *AP_procname=TRD("Aucune procedure !",
		      "No precedure !");

typedef struct pile
	{
	struct pile *next;
	char *name;
	} pile;

static pile *stack=NULL;
static int cnt=0;

extern void *malloc();

typedef struct mchunk
	{
	struct mchunk *prev,*next;
	ULONG deb,fin;		    /* bornes incluses */
	char *name;
	UBYTE attr;
	} mchunk;

#define attr_rd  1
#define attr_wr  2
#define attr_sys 4

static mchunk *mfirst=NULL;

static char *line;

static char *blocks(c)
	mchunk *c;
	{
	static char buf[80];
	sprintf(buf,"[0x%08x(%d) %c%c%c (%s)]",
		c->deb, c->fin-c->deb+1,
		c->attr & attr_rd  ? 'R':'-',
		c->attr & attr_wr  ? 'W':'-',
		c->attr & attr_sys ? 'S':'-',
		c->name);
	return buf;
	}

static void do_spc(i)
	int i;
	{
	while(i--) fputc(' ',stderr);
	}

static int isspc(c)
	char c;
	{
	return (c>0) && (c<=' ');
	}

static void do_print(fmt, ...)
	char *fmt;
	{
	ULONG *b = (&fmt) + 1;
	char *s,*buff;
	ifn(buff = malloc(1024)) /* 1024 suffisant ? */
		{
		fprintf(stderr,TRD(
			WARNING" Impossible allouer memoire pour \"",
			WARNING" Can't alloc memory for \""));
		fprintf(stderr, fmt, b[0],b[1],b[2],b[3],b[4],b[5]);
		fprintf(stderr,"\"\n");
		return;
		}
	sprintf(buff, fmt, b[0],b[1],b[2],b[3],b[4],b[5]);
	if(line)
		{
		if(s = malloc(1+strlen(line)+strlen(buff)))
			{
			strcpy(s, line);strcat(s,buff);
			free(line);line = s;
			}
		else	fprintf(stderr,TRD(
				       WARNING" Impossible allouer memoire"
				       " pour \"%s\"\n",

				       WARNING" Can't alloc memory for \"%s"
				       "\"\n"),
				buff);
		}
	else
		{
		if(s = malloc(1+strlen(buff)))
			{
			strcpy(s, buff);line = s;
			}
		else	fprintf(stderr,TRD(
				       WARNING" Impossible allouer memoire"
				       " pour \"%s\"\n",

				       WARNING" Can't alloc memory for \"%s"
				       "\"\n"),
				buff);
		}
	free(buff);
	}

static void do_dump(mg,md)
	int mg,md;
	{
	int i,nbmot,nbcar;
	char *s=line,*debut_ligne,*fin_ligne;

	md -= mg;

	while(*s)
		{
		/* recuperation stats pour ligne: nbmots, nbcar .. */
		debut_ligne = s;
		nbmot = nbcar = 0;
		while(1)
			{
			int lenmot;
			while(isspc(*s)) ++s;
			fin_ligne = s;
			if(!*s) break;
			lenmot = 0;
			while(*s && !isspc(*s)) {++s;++lenmot;}
			if(nbmot + nbcar + lenmot>=md) break;
			++nbmot; nbcar += lenmot;
			}
		if(*s && nbmot)
			{
			int nbreste = 0,divi = nbmot - 1;
			s = debut_ligne;
			do_spc(mg);
			while(nbmot)
				{
				while(isspc(*s)) ++s;
				while(*s && !isspc(*s))
					{
					fputc(*s,stderr);
					++s;
					}
				if(--nbmot)
					{
					int i = md - nbcar + nbreste;
					do_spc(i/divi);
					nbreste = i % divi;
					}
				}
			fputc('\n',stderr);
			}
		else if(nbmot)
			{
			s = debut_ligne;
			do_spc(mg);
			while(nbmot)
				{
				while(isspc(*s)) ++s;
				while(*s && !isspc(*s))
					{
					fputc(*s,stderr);
					++s;
					}
				if(--nbmot) fputc(' ',stderr);
				}
			fputc('\n',stderr);
			}
		s = fin_ligne;
		}
	free(line); line = NULL;
	}

static mchunk *addchunk(),*addsyschunk();

static char *procname()
	{
	if(AP_procname) return AP_procname;
	return stack?stack->name:TRD("PILE AP_procname VIDE !",
				     "EMPTY AP_procname STACK !");
	}

static int pile_vide()
	{
	if(cnt || stack) return 1;
	return 0;
	}

static void addsegchunk(sl,name)
	ULONG sl;char *name;
	{
	ULONG haut,bas;

	sl <<= 2;
	while(sl)
		{
		bas = sl-4; haut = bas + ((ULONG*)sl)[-1] - 1;
		ifn(addsyschunk(bas, haut, name))
			{
			do_print(TRD(WARNING" Je ne peux allouer le block"
					    " 0x%08x - 0x%08x (%s). Ce block"
					    " ne sera pas pris en compte.",

				     WARNING" Can't alloc block 0x%08x -"
					    " 0x%08x (%s). That block will"
					    " be ignored."),
				 bas, haut, name);
			do_dump(0,LARG_LINE);
			}
		sl = (*(ULONG*)sl)<<2;
		}
	}

static void process_sys_chunk()
	{
	int tmp;
	ULONG *sp;
	mchunk *c;
#ifdef	MANX
	extern ULONG * _savesp;
	sp = _savesp;
#else
#ifdef	_DCC
	extern ULONG *_ExitSP;
	sp = _ExitSP+11;
#else
	ULONG l[2];
	l[1] = 1;
	sp   = l;
#endif
#endif

	ifn(c = addsyschunk(0,1023,TRD("Vecteurs de base 680x0",
				       "Basic 680x0 vectors")))
		{
		do_print(TRD(
			 WARNING" Je ne peux allouer le block representant"
				" les vecteurs de base. Ce block ne sera pas"
				" pris en compte.",

			 WARNING" Can't alloc block for basic vectors. That"
				" block will be ignored."));
		do_dump(0,LARG_LINE);
		}
	else c->attr &= ~attr_wr; /* lecture seulement...		   */
				  /* quoique ecriture peut-etre (qui va    */
				  /* faire une indirection en ecriture	   */
				  /* dessus ?) */

	ifn(addsyschunk(ThisTask->BasPileTache,
			ThisTask->HautPileTache - 1,
			TRD("pile standard de la tache",
			    "standard stack frame of task")))
		{
		do_print(TRD(
			 WARNING" Je ne peux allouer le block representant"
				" la pile de la tache. Ce block ne sera pas"
				" pris en compte: 0x%08x-0x%08x",

			 WARNING" Can't alloc block for standard stack frame"
				" of task. That block will be ignored:"
				" 0x%08x-0x%08x"),

			 ThisTask->BasPileTache,
			 ThisTask->HautPileTache - 1);
		do_dump(0,LARG_LINE);
		}

	if(((ULONG)&tmp < ThisTask->BasPileTache) ||
	   ((ULONG)&tmp > ThisTask->HautPileTache))
		{
		ULONG *haut = (ULONG*)((ULONG)sp + 8 - 1),
		      *bas  = (ULONG*)((ULONG)sp - sp[1] + 8);
		ifn(addsyschunk(bas,haut,TRD(
				"pile supplementaire (CLI?) de la tache",
				"extra stack (CLI?) of task")))
			{
			do_print(TRD(
				 WARNING" Je ne peux allouer le block"
					" representant la pile de la tache."
					" Ce block ne sera pas pris en"
					" compte: 0x%08x-0x%08x",

				 WARNING" Can't alloc block for stack of"
					" task. That block will be ignored:"
					" 0x%08x-0x%08x"),
				 bas, haut);
			do_dump(0,LARG_LINE);
			}
		}

	addsegchunk(((ULONG*)(ThisTask->SegList<<2))[3],TRD(
		    "segment du processus",
		    "segment process"));

	if(ThisTask->CLI)
		{ /* from CLI */
		addsegchunk(((simplecli *)(ThisTask->CLI<<2))->Module,TRD(
			    "segment du Module CLI",
			    "segment Module CLI"));
		}
	}

static Warn()
	{
	fprintf(stderr,TRD(WARNING" Librairie non ouverte (%s)\n",
			   WARNING" Library not opened (%s)\n"), procname());
	fprintf(stderr,TRD("Il faut ouvrir et fermer la librairie dans "
			   "main(). Par exemple:\n",

			   "You should open the library in main(). For "
			   "example:\n"));
	fprintf(stderr,"main(ac,av)\n");
	fprintf(stderr,"    int ac; char *av[];\n");
	fprintf(stderr,"    {\n");
	fprintf(stderr,"    AP_Init();    /* "TRD("Ouverture librairie",
						  "Opening library")" */\n");
	fprintf(stderr,"    ...           /* "TRD("Code normal",
						  "Your code")" */\n");
	fprintf(stderr,"    AP_Close();   /* "TRD("Fermeture librairie",
						  "Closing library")" */\n");
	fprintf(stderr,"    }\n");
	fprintf(stderr,TRD("L'execution continue sans APurify.\n",
			   "Execution goes on without APurify.\n"));
	APflg |= APwarn;
	}

void AP_Init()
	{
	register ULONG *tmp;
	int var_sur_pile;

	APflg	    = APopen|APlock;

	ThisTask    = FindTask(NULL);
	mfirst	    = NULL;

	Disable();
	tmp	    = (ULONG*)(((UBYTE*)StdAlloc)+14);
	MallocProc  = SetFunction(*(ULONG*)4, LVOAllocMem, AsmAllocMem);
	*tmp	    = MallocProc;
	tmp	    = (ULONG*)(((UBYTE*)StdFree)+16);
	FreeProc    = SetFunction(*(ULONG*)4, LVOFreeMem, AsmFreeMem);
	*tmp	    = FreeProc;
	Enable();

	process_sys_chunk();

	APflg	   &= ~APlock;
	}

void AP_Close()
	{
	mchunk *c,*mc;

	APflg |= APlock;
	ifn(APflg & APopen)
		{
		ifn(APflg & APwarn) Warn();
		APflg &= ~APlock;
		return;
		}

	for(c=mfirst;c && (c->attr & attr_sys); c=c->next);
	if(c)
		{
		do_print(TRD(
			 WARNING" Fermeture de la librairie sans"
				" desallocation du(des) block(s)"
				" suivant(s):",

			 WARNING" Closing library without deallocation of"
				" the following block(s):"));
		do_dump(0,LARG_LINE);
		while(c)
			{
			do_print("- %s",blocks(c));
			do_dump(MARG_LINE,LARG_LINE);
			for(c=c->next;c && (c->attr & attr_sys); c=c->next);
			}
		}
	for(c=mfirst;c;c=mc) {mc=c->next;free(c);}
	mfirst = NULL;

/* warning inutile est stupide: la pile est independante de APURIFY.
 * il est impossible que ca devienne vide qd on appelle AP_close(),
 * par construction.
	ifn(pile_vide())
		{
		do_print(TRD(
			 WARNING" Fermeture de la librairie sans etre"
				" retourne de la (des) procedure(s)"
				" suivante:",

			 WARNING" Closing library without returning from the"
				" following procedure(s):"));
		do_dump(0,LARG_LINE);
		do
			{
			AP_unprotect();
			do_print("- %s",procname());
			do_dump(MARG_LINE,LARG_LINE);
			}
		while(!pile_vide());
		}
*/
	Disable();
	SetFunction(*(ULONG*)4, LVOAllocMem, MallocProc);
	SetFunction(*(ULONG*)4, LVOFreeMem, FreeProc);
	Enable();
	APflg &= ~(APlock|APopen);
	}

static int chunkcmp(c1, c2)
	mchunk *c1,*c2;
	{
	ULONG c1d,c1f,c2d,c2f;
	if((c1d = c1->deb) < (c2d = c2->deb))
		{
		if((c1f = c1->fin) <  c2d) return -2;
		if(c1f <= c2->fin) return -1;
		return 3;
		}
	if(c1d > (c2f = c2->fin))  return 2;
	if((c1f = c1->fin) <= c2f) return 0;
	if(c1f > c2f) return 1;
	}

/*
 * dump complet des chunks... permet de voir si les listes sont bien
 * ordonnees
 */
/*
static dc()
	{
	mchunk *c = mfirst;
	printf("dc(): ");
	while(c)
		{
		printf("%s",blocks(c));
		if(c = c->next) printf(" %d ",chunkcmp(c->prev,c));
		}
	printf("\n");
	}
/**/

static struct cache {long hit;mchunk *c;} cache[CACHE_SIZE];

static mchunk *cachehit(ck)
	mchunk *ck;
	{ /* lecture cache */
	struct cache *cc=cache;
	int i;

	for(i = CACHE_SIZE + 1;--i && (cc->c);++cc) if(!chunkcmp(ck,cc->c))
		{
		++(cc->hit);
		return cc->c;
		}
	return NULL;
	}

static void uncachehit(c)
	mchunk *c;
	{ /* ecriture cache */
	struct cache *cc,*cv; int i;

	cv = cache;
	if(cv->c) for(cc = cv+1, i = CACHE_SIZE;--i;++cc)
		{
		ifn(cc->c) {cv = cc;break;}
		if(cc->hit < cv->hit) cv = cc;
		}
	cv->c	= c;
	cv->hit = 0;
	}

static void cacheflush(ck)
	mchunk *ck;
	{
	int i; struct cache *cc;

	for(cc = cache, i = CACHE_SIZE+1; --i; ++cc) ifn(cc->c - ck)
		{
		for(;--i;++cc) cc[0]=cc[1];
		cc->c	= NULL;
		cc->hit = 0;
		return;
		}
	}

static mchunk *findchunk(ck)
	mchunk *ck;
	{
	mchunk *c = mfirst, *pc;
	int lastcmp;

	ifn(c) return NULL;

	if(pc = cachehit(ck)) return pc;

	if((lastcmp = chunkcmp(ck, c)) - 2) goto suite;

	while((pc = c->next) && !((lastcmp = chunkcmp(ck, pc)) - 2)) c = pc;

	if(pc) c = pc;
suite:
	ifn(lastcmp) uncachehit(c);
	return c;
	}

static int i_addchunk(c)
	mchunk *c;
	{
	mchunk *d;

	ifn(d = findchunk(c)) {mfirst = c; return 1;}
	switch(chunkcmp(c,d))
		{
		case -2:
		c->next = d;
		if(c->prev = d->prev) c->prev->next = c; else mfirst = c;
		d->prev = c;
		break;

		case 2:
		c->prev = d;
		if(c->next = d->next) {c->next->prev = c;}
		d->next = c;
		break;

		case -1:
		case 0:
		case 1:
		case 3:
		do_print(TRD(ERROR" Le block nouvellement alloue %s",
			     ERROR" Newly allocated block %s"), blocks(c));
		do_print(TRD(" recouvre le block deja alloue %s",
			     " overlaps the already allocated block %s"),
			 blocks(d));
		do_dump(0,LARG_LINE);
		return 0;
		break;
		}
	return 1;
	}

static mchunk *addsyschunk(cd,cf,name)
	ULONG cd,cf;
	char *name;
	{
	mchunk *c;

	ifn(c = malloc(sizeof(*c))) return 0;
	c->next = c->prev = NULL;
	c->deb	= cd;
	c->fin	= cf;
	c->name = name;
	c->attr = attr_rd|attr_wr|attr_sys;
	ifn(i_addchunk(c)) {free(c);return NULL;} else return c;
	}

static mchunk *addchunk(cd,cf)
	ULONG cd,cf;
	{
	mchunk *c;

	ifn(c = malloc(sizeof(*c))) return 0;
	c->next = c->prev = NULL;
	c->deb	= cd;
	c->fin	= cf;
	c->name = procname();
	c->attr = attr_rd|attr_wr;
	ifn(i_addchunk(c)) {free(c);return NULL;} else return c;
	}

static int subchunk(cd,cf)
	ULONG cd,cf;
	{
	mchunk *c;
	ifn(c = mfirst)
		{
		do_print(TRD(ERROR" Liberation de memoire dans %s alors"
				  " qu'aucun block memoire n'est alloue",

			     ERROR" Freeing memory in %s while no memory"
				  " block is allocated"),
			 procname());
		do_dump(0,LARG_LINE);
		return 0;
		}
	while(c && (cd > c->deb)) c = c->next;
	if(c && (c->deb == cd && c->fin == cf))
		{
		cacheflush(c);
		if(c->next)
			{
			c->next->prev = c->prev;
			if(c->prev) c->prev->next = c->next;
			else	    mfirst = c->next;
			free(c);
			}
		else
			{
			if(c->prev) c->prev->next = NULL;
			else	    mfirst = NULL;
			free(c);
			}
		return 1;
		}
	do_print(TRD(ERROR" Aucun block memoire alloue ne correspond a"
			  " 0x%08x - 0x%08x (%s)",

		     ERROR" No memory block matches 0x%08x - 0x%08x (%s)"),
		 cd, cf, procname());
	do_dump(0,LARG_LINE);
	return 0;
	}

static void entre(type,c,c1,c2) /* acces entre 2 blocks */
	char *type;
	mchunk *c,*c1,*c2;
	{
	do_print(TRD(ERROR" Block %s\n",
		     ERROR" Block %s\n"),blocks(c));do_dump(0,LARG_LINE);

	do_print(TRD("%s illegale ",
		     "Illegal %s "), type);

	ifn(c1)      do_print(TRD("avant le block %s (depassement de %d"
				  " octet(s))",

				  "before block %s (overstepping of %d"
				  " byte(s))"),
			      blocks(c2), c2->deb - c->deb);

	else ifn(c2) do_print(TRD("apres le block %s (depassement de %d"
				  " octet(s))",

				  "after block %s (overstepping of %d"
				  " byte(s))"),
			      blocks(c1), c->fin - c1->fin);
	else	     {
		     do_print(TRD("entre les blocks ",
				  "between blocks "));

		     do_print(TRD("%s (depassement de %d octet(s)) et ",
				  "%s (overstepping of %d byte(s)) and "),
			      blocks(c1), c->deb - c1->fin);

		     do_print(TRD("%s (depassement de %d octet(s))",
				  "%s (overstepping of %d byte(s))"),
			      blocks(c2),c->fin - c2->deb);
		     }
	do_dump(MARG_LINE,LARG_LINE);
	}

static void achev(type,c,c1)   /* a cheval sur un block */
	char *type;
	mchunk *c,*c1;
	{
	int d;
	do_print(TRD(ERROR" Block %s",
		     ERROR" Block %s"), blocks(c));do_dump(0,LARG_LINE);
	do_print(TRD("%s debordant le block %s ",
		     "Overstepping %s on block %s "), type, blocks(c1));
	d = c1->deb - c->deb;
	if(d<0) d = c1->fin - c->fin;
	TRD(
	{
	if(d<0) do_print("a droite de %d octet(s)", -d);
	else	do_print("a gauche de %d octet(s)",  d);
	},
	{
	if(d<0) do_print("of %d byte(s) rightward", -d);
	else	do_print("of %d byte(s) leftward",   d);
	});
	do_dump(MARG_LINE,LARG_LINE);
	}

void AP_rd(pt,len)
	ULONG pt,len;
	{
	mchunk mc,*c;
	ifn(APflg & APopen) {ifn(APflg & APwarn) Warn();return;}
	APflg |= APlock;
/*	printf("Read : %08x-%08x par %s\n",pt,pt+len-1,procname());   /**/
	mc.deb	= pt;
	mc.fin	= pt + len - 1;
	mc.name = procname();
	mc.attr = attr_rd;
	ifn(c = findchunk(&mc))
		{
		do_print(TRD(ERROR" Aucun block memoire alloue (%s) !",
			     ERROR" No memory block allocated (%s) !"),
			 procname());
		do_dump(0,LARG_LINE);
		}
	else
		{
		switch(chunkcmp(&mc,c))
			{
			case -2:
			entre(TRD("Lecture","reading"), &mc, c->prev, c);
			break;

			case 2:
			entre(TRD("Lecture","reading"), &mc, c, c->next);
			break;

			case -1:
			achev(TRD("Lecture","reading"), &mc, c);
			break;

			case 1:
			achev(TRD("Lecture","reading"), &mc, c);
			break;

			case 3:
			TRD(
			{
			do_print(ERROR" Bizzare, erreur impossible: le block"
				      " %s ",blocks(&mc));
			do_print("recouvre le block %s",blocks(c));
			},{
			do_print(ERROR" Strange, impossible error: block %s",
				 blocks(&mc));
			do_print("is overlapping block %s", blocks(c));
			})
			do_dump(0,LARG_LINE);
			break;

			case 0:
			ifn((mc.attr & c->attr) == mc.attr)
				{
				do_print(TRD(ERROR" Block %s",
					     ERROR" Block %s"),
					 blocks(&mc));do_dump(0,LARG_LINE);
				do_print(TRD("Erreur de protection en"
					     " lecture sur le block %s\n",

					     "Protection error in reading"
					     " block %s\n"), blocks(c));
				do_dump(MARG_LINE,LARG_LINE);
				}
			break;
			}
		}
	APflg &= ~APlock;
	}

void AP_wr(pt,len)
	ULONG pt,len;
	{
	mchunk mc,*c;
	ifn(APflg & APopen) {ifn(APflg & APwarn) Warn();return;}
	APflg |= APlock;
/*	printf("Write: %08x-%08x par %s\n",pt,pt+len-1,procname());   /**/
	mc.deb	= pt;
	mc.fin	= pt + len - 1;
	mc.name = procname();
	mc.attr = attr_wr;
	ifn(c = findchunk(&mc))
		{
		do_print(TRD(ERROR" Aucun block memoire alloue (%s)",
			     ERROR" No memory block allocated (%s)"),
			 procname());
		do_dump(0,LARG_LINE);
		}
	else
		{
		switch(chunkcmp(&mc,c))
			{
			case -2:
			entre(TRD("Ecriture","writing"), &mc, c->prev, c);
			break;

			case 2:
			entre(TRD("Ecriture","writing"), &mc, c, c->next);
			break;

			case -1:
			achev(TRD("Ecriture","writing"), &mc, c);
			break;

			case 1:
			achev(TRD("Ecriture","writing"), &mc, c);
			break;

			case 3:
			do_print(TRD(ERROR" Bizzare, erreur impossible: le"
					  " block %s ",

				     ERROR" Strange, impossible error: block"
					  " %s "),
				 blocks(&mc));
			do_print(TRD("recouvre le block %s",
				     "is overlapping block %s"),
				 blocks(c));
			do_dump(0,LARG_LINE);
			break;

			case 0:
			ifn((mc.attr & c->attr) == mc.attr)
				{
				do_print(TRD(ERROR" Block %s",
					     ERROR" Block %s"),
					 blocks(&mc));
				do_dump(0,LARG_LINE);
				do_print(TRD("Erreur de protection en"
					     " ecriture sur le block %s",

					     "Protection error in writing on"
					     " block %s"),
					 blocks(c));
				do_dump(MARG_LINE,LARG_LINE);
				}
			break;
			}
		}
	APflg &= ~APlock;
	}

void AP_protect()
	{
	pile *s;
	APflg |= APlock;
	ifn(s = malloc(sizeof(*s))) {++cnt;goto end;}
	s->next = stack;
	s->name = AP_procname;
	AP_procname = NULL;
	stack = s;
end:	APflg &= ~APlock;
	}

void AP_unprotect()
	{
	pile *s;
	APflg |= APlock;
	if(cnt) --cnt;
	else
	    {
	    s = stack;stack = s->next;
	    AP_procname = s->name;
	    free(s);
	    }
	APflg &= ~APlock;
	}

ULONG PubAllocMem(len, type)
	register ULONG len, type;
	{
	register ULONG p;

	geta4();

	if((FindTask(NULL) - ThisTask)) goto normal;
	ifn(APflg & APopen)
		{
		ifn(APflg & APwarn) Warn();
		goto normal;
		}
	if(APflg & APlock) goto normal;

	APflg |= APlock;

/*	fprintf(stderr, "Malloc(%d,%d) par %s\n", len, type, procname());/**/

	if(p = (ULONG)StdAlloc(len, type))
	ifn(addchunk(p, p + len - 1)) {StdFree(p, len);p = NULL;}

/*	dc(); /**/

	APflg &= ~APlock;
	return p;
normal:
	return (ULONG)StdAlloc(len, type);
	}

void PubFreeMem(ptr, len)
	register ULONG ptr, len;
	{
	geta4();

	if((FindTask(NULL) - ThisTask)) goto normal;
	ifn(APflg & APopen)
		{
		ifn(APflg & APwarn) Warn();
		goto normal;
		}
	if(APflg & APlock) goto normal;

	APflg |= APlock;

/*	fprintf(stderr, "Free(%08x,%d) par %s\n", ptr, len, procname()); /**/

	if(subchunk(ptr, ptr + len - 1)) StdFree(ptr, len);

	APflg &= ~APlock;
	return;
normal:
	StdFree(ptr, len);
	}