Initial revision

lang/pc/libpc/Makefile

@@ -0,0 +1,14 @@
+PC_TAIL=tail_pc.a
+
+head:
+	echo This Makefile needs arguments
+
+clean:
+	rm -f *.old
+
+opr:
+	make pr | opr
+
+pr:
+	@pr `echo * | sed s/$(PC_TAIL)//`
+	@ar pv $(PC_TAIL) | pr -h $(PC_TAIL)

lang/pc/libpc/READ_ME

@@ -0,0 +1,11 @@
+problems:
+- names of system call routines may clash with user routines
+- some modules in Pascal?
+- ttyio, stdio, pasio, unixio
+- mention all external references
+- list of routines and partitioning
+- size of sizes in asz,bcp,dis,new,opn,pac,unp: int or long ?
+
+NOTE:
+The run files in mach/*/libpc show the actual usage of this
+library.

lang/pc/libpc/abi.c

@@ -0,0 +1,22 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+int _abi(i) int i; {
+	return(i>=0 ? i : -i);
+}

lang/pc/libpc/abl.c

@@ -0,0 +1,22 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+long _abl(i) long i; {
+	return(i>=0 ? i : -i);
+}

lang/pc/libpc/abr.c

@@ -0,0 +1,22 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+double _abr(r) double r; {
+	return(r>=0 ? r : -r);
+}

lang/pc/libpc/arg.c

@@ -0,0 +1,55 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+/*
+/* function argc:integer; extern; */
+/* function argv(i:integer):string; extern; */
+/* procedure argshift; extern; */
+/* function environ(i:integer):string; extern; */
+
+extern int	_pargc;
+extern char	**_pargv;
+extern char	**_penvp;
+
+int argc() {
+	return(_pargc);
+}
+
+char *argv(i) {
+	if (i >= _pargc)
+		return(0);
+	return(_pargv[i]);
+}
+
+argshift() {
+
+	if (_pargc > 1) {
+		--_pargc;
+		_pargv++;
+	}
+}
+
+char *environ(i) {
+	char **p; char *q;
+
+	if (p = _penvp)
+		while (q = *p++)
+			if (i-- < 0)
+				return(q);
+	return(0);
+}

lang/pc/libpc/ass.c

@@ -0,0 +1,32 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<em_abs.h>
+#include	<pc_err.h>
+
+extern char	*_hol0();
+extern		_trp();
+
+_ass(line,bool) int line,bool; {
+
+	if (bool==0) {
+		LINO = line;
+		_trp(EASS);
+	}
+}

lang/pc/libpc/asz.c

@@ -0,0 +1,28 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+struct descr {
+	int	low;
+	int	diff;
+	int	size;
+};
+
+int _asz(dp) struct descr *dp; {
+	return(dp->size * (dp->diff + 1));
+}

lang/pc/libpc/atn.c

@@ -0,0 +1,91 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+/*
+	floating-point arctangent
+
+	atan returns the value of the arctangent of its
+	argument in the range [-pi/2,pi/2].
+
+	there are no error returns.
+
+	coefficients are #5077 from Hart & Cheney. (19.56D)
+*/
+
+
+static double sq2p1	= 2.414213562373095048802e0;
+static double sq2m1	=  .414213562373095048802e0;
+static double pio2	= 1.570796326794896619231e0;
+static double pio4	=  .785398163397448309615e0;
+static double p4	=  .161536412982230228262e2;
+static double p3	=  .26842548195503973794141e3;
+static double p2	=  .11530293515404850115428136e4;
+static double p1	=  .178040631643319697105464587e4;
+static double p0	=  .89678597403663861959987488e3;
+static double q4	=  .5895697050844462222791e2;
+static double q3	=  .536265374031215315104235e3;
+static double q2	=  .16667838148816337184521798e4;
+static double q1	=  .207933497444540981287275926e4;
+static double q0	=  .89678597403663861962481162e3;
+
+/*
+	xatan evaluates a series valid in the
+	range [-0.414...,+0.414...].
+*/
+
+static double
+xatan(arg)
+double arg;
+{
+	double argsq;
+	double value;
+
+	argsq = arg*arg;
+	value = ((((p4*argsq + p3)*argsq + p2)*argsq + p1)*argsq + p0);
+	value = value/(((((argsq + q4)*argsq + q3)*argsq + q2)*argsq + q1)*argsq + q0);
+	return(value*arg);
+}
+
+static double
+satan(arg)
+double arg;
+{
+	if(arg < sq2m1)
+		return(xatan(arg));
+	else if(arg > sq2p1)
+		return(pio2 - xatan(1/arg));
+	else
+		return(pio4 + xatan((arg-1)/(arg+1)));
+}
+
+
+/*
+	atan makes its argument positive and
+	calls the inner routine satan.
+*/
+
+double
+_atn(arg)
+double arg;
+{
+	if(arg>0)
+		return(satan(arg));
+	else
+		return(-satan(-arg));
+}

lang/pc/libpc/bcp.c

@@ -0,0 +1,29 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+int _bcp(sz,y,x) int sz; char *y,*x; {
+
+	while (--sz >= 0) {
+		if (*x < *y)
+			return(-1);
+		if (*x++ > *y++)
+			return(1);
+	}
+	return(0);
+}

lang/pc/libpc/bts.e

@@ -0,0 +1,55 @@
+#
+;
+; (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+;
+;          This product is part of the Amsterdam Compiler Kit.
+;
+; Permission to use, sell, duplicate or disclose this software must be
+; obtained in writing. Requests for such permissions may be sent to
+;
+;      Dr. Andrew S. Tanenbaum
+;      Wiskundig Seminarium
+;      Vrije Universiteit
+;      Postbox 7161
+;      1007 MC Amsterdam
+;      The Netherlands
+;
+; 
+
+; Author: J.W. Stevenson */
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+#define	SIZE	0
+#define	HIGH	EM_WSIZE
+#define	LOWB	2*EM_WSIZE
+#define	BASE	3*EM_WSIZE
+
+; _bts is called with four parameters:
+;	- the initial set (BASE)
+;	- low bound of range of bits (LOWB)
+;	- high bound of range of bits (HIGH)
+;	- set size in bytes (SIZE)
+
+ exp $_bts
+ pro $_bts,0
+ lal BASE	; address of initial set
+ lol SIZE
+ los EM_WSIZE	; load initial set
+1
+ lol LOWB	; low bound
+ lol HIGH	; high bound
+ bgt *2		; while low <= high
+ lol LOWB
+ lol SIZE
+ set ?		; create [low]
+ lol SIZE
+ ior ?		; merge with initial set
+ inl LOWB	; increment low bound
+ bra *1		; loop back
+2
+ lal BASE
+ lol SIZE
+ sts EM_WSIZE	; store result over initial set
+ ret 0
+ end ?

lang/pc/libpc/buff.c

@@ -0,0 +1,34 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+extern		_flush();
+
+/* procedure buff(var f:file of ?); */
+
+buff(f) struct file *f; {
+	int sz;
+
+	if ((f->flags & (0377|WRBIT)) != (MAGIC|WRBIT))
+		return;
+	_flush(f);
+	sz = f->size;
+	f->count = f->buflen = (sz>512 ? sz : 512-512%sz);
+}

lang/pc/libpc/catch.c

@@ -0,0 +1,94 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include	<em_abs.h>
+#include	<em_path.h>
+#include	<pc_file.h>
+
+#define	MESLEN		30
+
+extern struct file	*_curfil;
+
+extern int		_pargc;
+extern char		**_pargv;
+extern char		**_penvp;
+
+extern char		*_hol0();
+extern			_trp();
+extern			exit();
+extern int		open();
+extern int		read();
+extern int		write();
+
+/* Modified not to use a table of indices any more. This circumvents yet 
+   another point where byte order in words would make you lose.
+ */
+
+_catch(erno) unsigned erno; {
+	char		*p,*q,**qq;
+	unsigned	i;
+	int		fd;
+	char		*pp[8];
+	char		mes[MESLEN];
+	char		c;
+
+	qq = pp;
+	if (p = FILN)
+		*qq++ = p;
+	else
+		*qq++ = _pargv[0];
+	p = &("xxxxx: "[5]);
+	if (i = LINO) {
+		*qq++ = ", ";
+		do
+			*--p = i % 10 + '0';
+		while (i /= 10);
+	}
+	*qq++ = p;
+	if ((erno & ~037) == 0140 && (_curfil->flags&0377)==MAGIC) { 
+		/* file error */
+		*qq++ = "file ";
+		*qq++ = _curfil->fname;
+		*qq++ = ": ";
+	}
+	if ((fd=open(RTERR_PATH,0))<0)
+		goto error;
+	/* skip to correct message */
+	for(i=0;i<erno;i++)
+		do if (read(fd,&c,1)!=1)
+			goto error;
+		while (c!= '\n');
+	if(read(fd,mes,MESLEN-1)<=0)
+		goto error;
+	mes[MESLEN-1]=0;
+	for(i=0;i<MESLEN-1;i++)
+		if(mes[i]=='\n')
+			mes[i+1]=0;
+	*qq++ = mes;
+	*qq = 0;
+	qq = pp;
+	while (q = *qq++) {
+		p = q;
+		while (*p)
+			p++;
+		if (write(2,q,p-q) < 0)
+			;
+	}
+	exit(erno);
+error:
+	_trp(erno);
+}

lang/pc/libpc/clock.c

@@ -0,0 +1,36 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+/* function clock:integer; extern; */
+
+extern int	times();
+
+struct tbuf {
+	long	utime;
+	long	stime;
+	long	cutime;
+	long	cstime;
+};
+
+int clock() {
+	struct tbuf t;
+
+	times(&t);
+	return( (t.utime + t.stime) & 077777);
+}

lang/pc/libpc/cls.c

@@ -0,0 +1,66 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern struct file	*_curfil;
+extern			_trp();
+extern			_flush();
+extern			_outcpt();
+extern int		close();
+
+_xcls(f) struct file *f; {
+
+	if ((f->flags & WRBIT) == 0)
+		return;
+	if ((f->flags & (TXTBIT|ELNBIT)) == TXTBIT) {
+#ifdef CPM
+		*f->ptr = '\r';
+		_outcpt(f);
+#endif
+		*f->ptr = '\n';
+		_outcpt(f);
+	}
+	_flush(f);
+}
+
+_cls(f) struct file *f; {
+#ifdef MAYBE
+	char *p;
+#endif
+
+	_curfil = f;
+	if ((f->flags&0377) != MAGIC)
+		return;
+#ifdef MAYBE
+	p = f->bufadr;
+	if (f->ptr < p)
+		return;
+	if (f->buflen <= 0)
+		return;
+	p += f->buflen;
+	if (f->ptr >= p)
+		return;
+#endif
+	_xcls(f);
+	if (close(f->ufd) != 0)
+		_trp(ECLOSE);
+	f->flags = 0;
+}

lang/pc/libpc/cvt.c

@@ -0,0 +1,104 @@
+extern double	_fif();
+
+/*
+ *	_ecvt converts to decimal
+ *	the number of digits is specified by ndigit
+ *	decpt is set to the position of the decimal point
+ *	sign is set to 0 for positive, 1 for negative
+ */
+
+#define	NDIG	80
+
+static char*
+cvt(arg, ndigits, decpt, sign, eflag)
+double arg;
+int ndigits, *decpt, *sign, eflag;
+{
+	register int r2;
+	double fi, fj;
+	register char *p, *p1;
+	static char buf[NDIG];
+	int i;  /*!*/
+
+	if (ndigits<0)
+		ndigits = 0;
+	if (ndigits>=NDIG-1)
+		ndigits = NDIG-2;
+	r2 = 0;
+	*sign = 0;
+	p = &buf[0];
+	if (arg<0) {
+		*sign = 1;
+		arg = -arg;
+	}
+	arg = _fif(arg, 1.0, &fi);
+	/*
+	 * Do integer part
+	 */
+	if (fi != 0) {
+		p1 = &buf[NDIG];
+		while (fi != 0) {
+			i = (_fif(fi, 0.1, &fi) + 0.03) * 10;
+			*--p1 = i + '0';
+			r2++;
+		}
+		while (p1 < &buf[NDIG])
+			*p++ = *p1++;
+	} else if (arg > 0) {
+		while ((fj = arg*10) < 1) {
+			arg = fj;
+			r2--;
+		}
+	}
+	p1 = &buf[ndigits];
+	if (eflag==0)
+		p1 += r2;
+	*decpt = r2;
+	if (p1 < &buf[0]) {
+		buf[0] = '\0';
+		return(buf);
+	}
+	while (p<=p1 && p<&buf[NDIG]) {
+		arg = _fif(arg, 10.0, &fj);
+		i = fj;
+		*p++ = i + '0';
+	}
+	if (p1 >= &buf[NDIG]) {
+		buf[NDIG-1] = '\0';
+		return(buf);
+	}
+	p = p1;
+	*p1 += 5;
+	while (*p1 > '9') {
+		*p1 = '0';
+		if (p1>buf) {
+			p1--; *p1 += 1;
+		} else {
+			*p1 = '1';
+			(*decpt)++;
+			if (eflag==0) {
+				if (p>buf)
+					*p = '0';
+				p++;
+			}
+		}
+	}
+	*p = '\0';
+	return(buf);
+}
+
+char*
+_ecvt(arg, ndigits, decpt, sign)
+double arg;
+int ndigits, *decpt, *sign;
+{
+	return(cvt(arg, ndigits, decpt, sign, 1));
+}
+
+char*
+_fcvt(arg, ndigits, decpt, sign)
+double arg;
+int ndigits, *decpt, *sign;
+{
+	return(cvt(arg, ndigits, decpt, sign, 0));
+}

lang/pc/libpc/diag.c

@@ -0,0 +1,33 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+/* procedure diag(var f:text); */
+
+diag(f) struct file *f; {
+
+	f->ptr = f->bufadr;
+	f->flags = WRBIT|EOFBIT|ELNBIT|TXTBIT|MAGIC;
+	f->fname = "DIAG";
+	f->ufd = 2;
+	f->size = 1;
+	f->count = 1;
+	f->buflen = 1;
+}

lang/pc/libpc/dis.c

@@ -0,0 +1,86 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_err.h>
+
+#define assert()	/* nothing */
+
+/*
+ * use circular list of free blocks from low to high addresses
+ * _highp points to free block with highest address
+ */
+struct adm {
+	struct adm	*next;
+	int		size;
+};
+
+extern struct adm	*_lastp;
+extern struct adm	*_highp;
+extern			_trp();
+
+static int merge(p1,p2) struct adm *p1,*p2; {
+	struct adm *p;
+
+	p = (struct adm *)((char *)p1 + p1->size);
+	if (p > p2)
+		_trp(EFREE);
+	if (p != p2)
+		return(0);
+	p1->size += p2->size;
+	p1->next = p2->next;
+	return(1);
+}
+
+_dis(n,pp) int n; struct adm **pp; {
+	struct adm *p1,*p2;
+
+	/*
+	 * NOTE: dispose only objects whose size is a multiple of sizeof(*pp).
+	 *       this is always true for objects allocated by _new()
+	 */
+	n = ((n+sizeof(*p1)-1) / sizeof(*p1)) * sizeof(*p1);
+	if (n == 0)
+		return;
+	if ((p1= *pp) == (struct adm *) 0)
+		_trp(EFREE);
+	p1->size = n;
+	if ((p2 = _highp) == 0)  /*p1 is the only free block*/
+		p1->next = p1;
+	else {
+		if (p2 > p1) {
+			/*search for the preceding free block*/
+			if (_lastp < p1)  /*reduce search*/
+				p2 = _lastp;
+			while (p2->next < p1)
+				p2 = p2->next;
+		}
+		/* if p2 preceeds p1 in the circular list,
+		 * try to merge them			*/
+		p1->next = p2->next; p2->next = p1;
+		if (p2 <= p1 && merge(p2,p1))
+			p1 = p2;
+		p2 = p1->next;
+		/* p1 preceeds p2 in the circular list */
+		if (p2 > p1) merge(p1,p2);
+	}
+	if (p1 >= p1->next)
+		_highp = p1;
+	_lastp = p1;
+	*pp = (struct adm *) 0;
+}

lang/pc/libpc/efl.c

@@ -0,0 +1,35 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern struct file	*_curfil;
+extern			_trp();
+extern			_incpt();
+
+int _efl(f) struct file *f; {
+
+	_curfil = f;
+	if ((f->flags & 0377) != MAGIC)
+		_trp(EBADF);
+	if ((f->flags & (WINDOW|WRBIT|EOFBIT)) == 0)
+		_incpt(f);
+	return((f->flags & EOFBIT) != 0);
+}

lang/pc/libpc/eln.c

@@ -0,0 +1,32 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern		_trp();
+extern		_rf();
+
+int _eln(f) struct file *f; {
+
+	_rf(f);
+	if (f->flags & EOFBIT)
+		_trp(EEOF);
+	return((f->flags & ELNBIT) != 0);
+}

lang/pc/libpc/encaps.e

@@ -0,0 +1,143 @@
+#
+
+
+;  (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+; 
+;           This product is part of the Amsterdam Compiler Kit.
+; 
+;  Permission to use, sell, duplicate or disclose this software must be
+;  obtained in writing. Requests for such permissions may be sent to
+; 
+;       Dr. Andrew S. Tanenbaum
+;       Wiskundig Seminarium
+;       Vrije Universiteit
+;       Postbox 7161
+;       1007 MC Amsterdam
+;       The Netherlands
+; 
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+; procedure encaps(procedure p; procedure(q(n:integer));
+; {call q if a trap occurs during the execution of p}
+; {if q returns, continue execution of p}
+
+
+ inp $handler
+
+#define PIISZ   2*EM_PSIZE
+
+#define PARG    0
+#define QARG    PIISZ
+#define E_ELB   -EM_PSIZE
+#define E_EHA   -2*EM_PSIZE
+
+; encaps is called with two parameters:
+;       - procedure instance identifier of q (QARG)
+;       - procedure instance identifier of p (PARG)
+; and two local variables:
+;       - the lb of the previous encaps      (E_ELB)
+;       - the procedure identifier of the previous handler (E_EHA)
+;
+; One static variable:
+;       - the lb of the currently active encaps (enc_lb)
+
+enc_lb
+        bss EM_PSIZE,0,0
+
+ exp $encaps
+ pro $encaps,PIISZ
+ ; save lb of previous encaps
+ lae enc_lb
+ loi EM_PSIZE
+ lal E_ELB
+ sti EM_PSIZE
+ ; set new lb
+ lxl 0
+ lae enc_lb
+ sti EM_PSIZE
+ ; save old handler id while setting up the new handler
+ lpi $handler
+ sig
+ lal E_EHA
+ sti EM_PSIZE
+ ; handler is ready, p can be called
+ ; p doesn't expect parameters except possibly the static link
+ ; always passing the link won't hurt
+ lal PARG
+ loi PIISZ
+ cai
+ asp EM_PSIZE
+ ; reinstate old handler
+ lal E_ELB
+ loi EM_PSIZE
+ lae enc_lb
+ sti EM_PSIZE
+ lal E_EHA
+ loi EM_PSIZE
+ sig
+ asp EM_PSIZE
+ ret 0
+ end ?
+
+#define TRAP    0
+#define H_ELB   -EM_PSIZE
+
+; handler is called with one parameter:
+;       - trap number (TRAP)
+; one local variable
+;       - the current LB of the enclosing encaps (H_ELB)
+
+
+ pro $handler,EM_PSIZE
+ ; save LB of nearest encaps
+ lae enc_lb
+ loi EM_PSIZE
+ lal H_ELB
+ sti EM_PSIZE
+ ; fetch setting for previous encaps via LB of nearest
+ lal H_ELB
+ loi EM_PSIZE
+ adp E_ELB
+ loi EM_PSIZE   ; LB of previous encaps
+ lae enc_lb
+ sti EM_PSIZE
+ lal H_ELB
+ loi EM_PSIZE
+ adp E_EHA
+ loi EM_PSIZE   ; previous handler
+ sig
+ asp EM_PSIZE
+ ; previous handler is re-instated, time to call Q
+ lol TRAP       ; the one and only real parameter
+ lal H_ELB
+ loi EM_PSIZE
+ lpb            ; argument base of enclosing encaps
+ adp QARG
+ loi PIISZ
+ exg EM_PSIZE
+ dup EM_PSIZE   ; The static link is now on top
+ zer EM_PSIZE
+ cmp
+ zeq *1
+ ; non-zero LB
+ exg EM_PSIZE
+ cai
+ asp EM_WSIZE+EM_PSIZE
+ bra *2
+1
+ ; zero LB
+ asp EM_PSIZE
+ cai
+ asp EM_WSIZE
+2
+ ; now reinstate handler for continued execution of p
+ lal H_ELB
+ loi EM_PSIZE
+ lae enc_lb
+ sti EM_PSIZE
+ lpi $handler
+ sig
+ asp EM_PSIZE
+ rtt
+ end ?

lang/pc/libpc/exp.c

@@ -0,0 +1,123 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_err.h>
+
+extern double	_fif();
+extern double	_fef();
+extern		_trp();
+
+/*
+	exp returns the exponential function of its
+	floating-point argument.
+
+	The coefficients are #1069 from Hart and Cheney. (22.35D)
+*/
+
+#define	HUGE	1.701411733192644270e38
+
+static double p0	=  .2080384346694663001443843411e7;
+static double p1	=  .3028697169744036299076048876e5;
+static double p2	=  .6061485330061080841615584556e2;
+static double q0	=  .6002720360238832528230907598e7;
+static double q1	=  .3277251518082914423057964422e6;
+static double q2	=  .1749287689093076403844945335e4;
+static double log2e	= 1.4426950408889634073599247;
+static double sqrt2	= 1.4142135623730950488016887;
+static double maxf	= 10000.0;
+
+static double
+floor(d)
+double d;
+{
+	if (d<0) {
+		d = -d;
+		if (_fif(d, 1.0, &d) != 0)
+			d += 1;
+		d = -d;
+	} else
+		_fif(d, 1.0, &d);
+	return(d);
+}
+
+static double
+ldexp(fr,exp)
+double fr;
+int exp;
+{
+	int	neg,i;
+
+	neg = 1;
+	if (fr < 0) {
+		fr = -fr;
+		neg = -1;
+	}
+	fr = _fef(fr, &i);
+	/*
+	while (fr < 0.5) {
+		fr *= 2;
+		exp--;
+	}
+	*/
+	exp += i;
+	if (exp > 127) {
+		_trp(EEXP);
+		return(neg * HUGE);
+	}
+	if (exp < -127)
+		return(0);
+	while (exp > 14) {
+		fr *= (1<<14);
+		exp -= 14;
+	}
+	while (exp < -14) {
+		fr /= (1<<14);
+		exp += 14;
+	}
+	if (exp > 0)
+		fr *= (1<<exp);
+	if (exp < 0)
+		fr /= (1<<(-exp));
+	return(neg * fr);
+}
+
+double
+_exp(arg)
+double arg;
+{
+	double fract;
+	double temp1, temp2, xsq;
+	int ent;
+
+	if(arg == 0)
+		return(1);
+	if(arg < -maxf)
+		return(0);
+	if(arg > maxf) {
+		_trp(EEXP);
+		return(HUGE);
+	}
+	arg *= log2e;
+	ent = floor(arg);
+	fract = (arg-ent) - 0.5;
+	xsq = fract*fract;
+	temp1 = ((p2*xsq+p1)*xsq+p0)*fract;
+	temp2 = ((xsq+q2)*xsq+q1)*xsq + q0;
+	return(ldexp(sqrt2*(temp2+temp1)/(temp2-temp1), ent));
+}

lang/pc/libpc/fef.e

@@ -0,0 +1,21 @@
+#
+ mes 2,EM_WSIZE,EM_PSIZE
+
+#define FARG    0
+#define ERES    EM_DSIZE
+
+; _fef is called with two parameters:
+;       - address of exponent result (ERES)
+;       - floating point number to be split (FARG)
+; and returns an EM_DSIZE-byte floating point number
+
+ exp $_fef
+ pro $_fef,0
+ lal FARG
+ loi EM_DSIZE
+ fef EM_DSIZE
+ lal ERES
+ loi EM_PSIZE
+ sti EM_WSIZE
+ ret EM_DSIZE
+ end ?

lang/pc/libpc/fif.e

@@ -0,0 +1,23 @@
+#
+ mes 2,EM_WSIZE,EM_PSIZE
+
+#define ARG1    0
+#define ARG2    EM_DSIZE
+#define IRES    2*EM_DSIZE
+
+; _fif is called with three parameters:
+;       - address of integer part result (IRES)
+;       - float two (ARG2)
+;       - float one (ARG1)
+; and returns an EM_DSIZE-byte floating point number
+
+ exp $_fif
+ pro $_fif,0
+ lal 0
+ loi 2*EM_DSIZE
+ fif EM_DSIZE
+ lal IRES
+ loi EM_PSIZE
+ sti EM_DSIZE
+ ret EM_DSIZE
+ end ?

lang/pc/libpc/get.c

@@ -0,0 +1,13 @@
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern		_rf();
+extern		_trp();
+
+_get(f) struct file *f; {
+
+	_rf(f);
+	if (f->flags&EOFBIT)
+		_trp(EEOF);
+	f->flags &= ~WINDOW;
+}

lang/pc/libpc/gto.e

@@ -0,0 +1,84 @@
+#
+;  (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+; 
+;           This product is part of the Amsterdam Compiler Kit.
+; 
+;  Permission to use, sell, duplicate or disclose this software must be
+;  obtained in writing. Requests for such permissions may be sent to
+; 
+;       Dr. Andrew S. Tanenbaum
+;       Wiskundig Seminarium
+;       Vrije Universiteit
+;       Postbox 7161
+;       1007 MC Amsterdam
+;       The Netherlands
+; 
+
+/* Author: J.W. Stevenson */
+
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+#define TARLB   0
+#define DESCR   EM_PSIZE
+
+#define NEWPC   0
+#define SAVSP   EM_PSIZE
+
+#define D_PC    0
+#define D_SP    EM_PSIZE
+#define D_LB    EM_PSIZE+EM_PSIZE
+
+#define LOCLB   -EM_PSIZE
+
+; _gto is called with two arguments:
+;       - pointer to the label descriptor (DESCR)
+;       - local base (LB) of target procedure (TARLB)
+; the label descriptor contains two items:
+;       - label address i.e. new PC (NEWPC)
+;       - offset in target procedure frame (SAVSP)
+; using this offset and the LB of the target procedure, the address of
+; of local variable of the target procedure is constructed.
+; the target procedure must have stored the correct target SP there.
+
+descr
+ bss 3*EM_PSIZE,0,0
+
+ exp $_gto
+ pro $_gto,EM_PSIZE
+ lal DESCR
+ loi EM_PSIZE
+ adp NEWPC
+ loi EM_PSIZE
+ lae descr+D_PC
+ sti EM_PSIZE
+ lal TARLB
+ loi EM_PSIZE
+ zer EM_PSIZE
+ cmp
+ zeq *1
+ lal TARLB
+ loi EM_PSIZE
+ bra *2
+1
+ lae _m_lb
+ loi EM_PSIZE
+2
+ lal LOCLB
+ sti EM_PSIZE
+ lal LOCLB
+ loi EM_PSIZE
+ lal DESCR
+ loi EM_PSIZE
+ adp SAVSP
+ loi EM_WSIZE           ; or EM_PSIZE ?
+ ads EM_WSIZE           ; or EM_PSIZE ?
+ loi EM_PSIZE
+ lae descr+D_SP
+ sti EM_PSIZE
+ lal LOCLB
+ loi EM_PSIZE
+ lae descr+D_LB
+ sti EM_PSIZE
+ gto descr
+ end ?

lang/pc/libpc/head_pc.e

@@ -0,0 +1,2 @@
+#
+ mes 2,EM_WSIZE,EM_PSIZE

lang/pc/libpc/hlt.c

@@ -0,0 +1,34 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+extern char	*_hbase;
+extern int	*_extfl;
+extern		_cls();
+extern		exit();
+
+_hlt(ecode) int ecode; {
+	int i;
+
+	for (i = 1; i <= _extfl[0]; i++)
+		if (_extfl[i] != -1)
+			_cls(EXTFL(i));
+	exit(ecode);
+}

lang/pc/libpc/hol0.e

@@ -0,0 +1,11 @@
+#
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+; _hol0 return the address of the ABS block (hol0)
+
+ exp $_hol0
+ pro $_hol0,0
+ lae 0
+ ret EM_PSIZE
+ end ?

lang/pc/libpc/incpt.c

@@ -0,0 +1,74 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+#define EINTR	4
+
+extern int	errno;
+extern		_trp();
+extern int	read();
+
+_incpt(f) struct file *f; {
+
+	if (f->flags & EOFBIT)
+		_trp(EEOF);
+	f->flags |= WINDOW;
+	f->flags &= ~ELNBIT;
+#ifdef CPM
+	do {
+#endif
+	f->ptr += f->size;
+	if (f->count == 0) {
+		f->ptr = f->bufadr;
+		for(;;) {
+			f->count=read(f->ufd,f->bufadr,f->buflen);
+			if ( f->count<0 ) {
+				if (errno != EINTR) _trp(EREAD) ;
+				continue ;
+			}
+			break ;
+		}
+		if (f->count == 0) {
+			f->flags |= EOFBIT;
+			*f->ptr = '\0';
+			return;
+		}
+	}
+	if ((f->count -= f->size) < 0)
+		_trp(EFTRUNC);
+#ifdef CPM
+	} while ((f->flags&TXTBIT) && *f->ptr == '\r');
+#endif
+	if (f->flags & TXTBIT) {
+		if (*f->ptr & 0200)
+			_trp(EASCII);
+		if (*f->ptr == '\n') {
+			f->flags |= ELNBIT;
+			*f->ptr = ' ';
+		}
+#ifdef CPM
+		if (*f->ptr == 26) {
+			f->flags |= EOFBIT;
+			*f->ptr = 0;
+		}
+#endif
+	}
+}

lang/pc/libpc/ini.c

@@ -0,0 +1,72 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include        <pc_file.h>
+#include        <pc_err.h>
+
+extern          (*_sig())();
+extern          _catch();
+#ifndef CPM
+extern int      ioctl();
+#endif
+
+char            *_hbase;
+int             *_extfl;
+char            *_m_lb;         /* LB of m_a_i_n */
+struct file     *_curfil;       /* points to file struct in case of errors */
+int             _pargc;
+char            **_pargv;
+char            **_penvp;
+
+_ini(args,hb,p,mainlb) char *args,*hb,*mainlb; int *p; {
+	struct file *f;
+	char buf[6];
+
+	_pargc= *(int *)args; args += sizeof (int);
+	_pargv= *(char ***)args; args += sizeof (char **);
+	_penvp= *(char ***)args;
+	_sig(_catch);
+	_extfl = p;
+	_hbase = hb;
+	_m_lb = mainlb;
+	if (_extfl[1] != -1) {
+		f = EXTFL(1);
+		f->ptr = f->bufadr;
+		f->flags = MAGIC|TXTBIT;
+		f->fname = "INPUT";
+		f->ufd = 0;
+		f->size = 1;
+		f->count = 0;
+		f->buflen = 512;
+	}
+	if (_extfl[2] != -1) {
+		f = EXTFL(2);
+		f->ptr = f->bufadr;
+		f->flags = MAGIC|TXTBIT|WRBIT|EOFBIT|ELNBIT;
+		f->fname = "OUTPUT";
+		f->ufd = 1;
+		f->size = 1;
+#ifdef CPM
+		f->count = 1;
+#else
+		f->count = (ioctl(1,(('t'<<8)|8),buf) == 0 ? 1 : 512);
+#endif
+		f->buflen = f->count;
+	}
+}

lang/pc/libpc/log.c

@@ -0,0 +1,76 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_err.h>
+
+extern double	_fef();
+extern		_trp();
+
+/*
+	log returns the natural logarithm of its floating
+	point argument.
+
+	The coefficients are #2705 from Hart & Cheney. (19.38D)
+
+	It calls _fef.
+*/
+
+#define	HUGE	1.701411733192644270e38
+
+static double log2	= 0.693147180559945309e0;
+static double sqrto2	= 0.707106781186547524e0;
+static double p0	= -.240139179559210510e2;
+static double p1	= 0.309572928215376501e2;
+static double p2	= -.963769093368686593e1;
+static double p3	= 0.421087371217979714e0;
+static double q0	= -.120069589779605255e2;
+static double q1	= 0.194809660700889731e2;
+static double q2	= -.891110902798312337e1;
+
+double
+_log(arg)
+double arg;
+{
+	double x,z, zsq, temp;
+	int exp;
+
+	if(arg <= 0) {
+		_trp(ELOG);
+		return(-HUGE);
+	}
+	x = _fef(arg,&exp);
+	/*
+	while(x < 0.5) {
+		x =* 2;
+		exp--;
+	}
+	*/
+	if(x<sqrto2) {
+		x *= 2;
+		exp--;
+	}
+
+	z = (x-1)/(x+1);
+	zsq = z*z;
+
+	temp = ((p3*zsq + p2)*zsq + p1)*zsq + p0;
+	temp = temp/(((zsq + q2)*zsq + q1)*zsq + q0);
+	temp = temp*z + exp*log2;
+	return(temp);
+}

lang/pc/libpc/mdi.c

@@ -0,0 +1,32 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_err.h>
+
+extern		_trp();
+
+int _mdi(j,i) int j,i; {
+
+	if (j <= 0)
+		_trp(EMOD);
+	i = i % j;
+	if (i < 0)
+		i += j;
+	return(i);
+}

lang/pc/libpc/mdl.c

@@ -0,0 +1,32 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_err.h>
+
+extern		_trp();
+
+long _mdl(j,i) long j,i; {
+
+	if (j <= 0)
+		_trp(EMOD);
+	i = i % j;
+	if (i < 0)
+		i += j;
+	return(i);
+}

lang/pc/libpc/new.c

@@ -0,0 +1,66 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+extern		_sav();
+extern		_rst();
+
+#define assert()	/* nothing */
+#define	UNDEF		0x8000
+
+struct adm {
+	struct adm	*next;
+	int		size;
+};
+
+struct adm	*_lastp = 0;
+struct adm	*_highp = 0;
+
+_new(n,pp) int n; struct adm **pp; {
+	struct adm *p,*q;
+
+	n = ((n+sizeof(*p)-1) / sizeof(*p)) * sizeof(*p);
+	if ((p = _lastp) != 0)
+		do {
+			q = p->next;
+			if (q->size >= n) {
+				assert(q->size%sizeof(adm) == 0);
+				if ((q->size -= n) == 0) {
+					if (p == q)
+						p = 0;
+					else
+						p->next = q->next;
+					if (q == _highp)
+						_highp = p;
+				}
+				_lastp = p;
+				p = (struct adm *)((char *)q + q->size);
+				q = (struct adm *)((char *)p + n);
+				goto initialize;
+			}
+			p = q;
+		} while (p != _lastp);
+	/*no free block big enough*/
+	_sav(&p);
+	q = (struct adm *)((char *)p + n);
+	_rst(&q);
+initialize:
+	*pp = p;
+	while (p < q)
+		*((int *)p)++ = UNDEF;
+}

lang/pc/libpc/nobuff.c

@@ -0,0 +1,32 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+extern		_flush();
+
+/* procedure nobuff(var f:file of ?); */
+
+nobuff(f) struct file *f; {
+
+	if ((f->flags & (0377|WRBIT)) != (MAGIC|WRBIT))
+		return;
+	_flush(f);
+	f->count = f->buflen = f->size;
+}

lang/pc/libpc/notext.c

@@ -0,0 +1,5 @@
+#include	<pc_file.h>
+
+notext(f) struct file *f; {
+	f->flags &= ~TXTBIT;
+}

lang/pc/libpc/opn.c

@@ -0,0 +1,116 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern char		*_hbase;
+extern int		*_extfl;
+extern struct file	*_curfil;
+extern int		_pargc;
+extern char		**_pargv;
+extern char		**_penvp;
+
+extern			_cls();
+extern			_xcls();
+extern			_trp();
+extern int		getpid();
+extern int		creat();
+extern int		open();
+extern int		close();
+extern int		unlink();
+extern long		lseek();
+
+static int tmpfil() {
+	int i; char *p,*q;
+
+	i = getpid();
+	p = "/usr/tmp/plf.xxxxx";
+	q = p + 13;
+	do
+		*q++ = (i & 07) + '0';
+	while (i >>= 3);
+	*q = '\0';
+	if ((i = creat(p,0644)) < 0)
+		if ((i = creat(p += 4,0644)) < 0)
+			if ((i = creat(p += 5,0644)) < 0)
+				goto error;
+	if (close(i) != 0)
+		goto error;
+	if ((i = open(p,2)) < 0)
+		goto error;
+	if (unlink(p) != 0)
+error:		_trp(EREWR);
+	return(i);
+}
+
+static int initfl(descr,sz,f) int descr; int sz; struct file *f; {
+	int i;
+
+	_curfil = f;
+	if (sz == 0) {
+		sz++;
+		descr |= TXTBIT;
+	}
+	for (i=1; i<=_extfl[0]; i++)
+		if (f == EXTFL(i))
+			break;
+	if (i > _extfl[0]) {		/* local file */
+		f->fname = "LOCAL";
+		if ((descr & WRBIT) == 0 && (f->flags & 0377) == MAGIC) {
+			_xcls(f);
+			if (lseek(f->ufd,(long)0,0) == -1)
+				_trp(ERESET);
+		} else {
+			_cls(f);
+			f->ufd = tmpfil();
+		}
+	} else {	/* external file */
+		if ((i -= 2) <= 0)
+			return(0);
+		if (i >= _pargc)
+			_trp(EARGC);
+		f->fname = _pargv[i];
+		_cls(f);
+		if ((descr & WRBIT) == 0) {
+			if ((f->ufd = open(f->fname,0)) < 0)
+				_trp(ERESET);
+		} else {
+			if ((f->ufd = creat(f->fname,0644)) < 0)
+				_trp(EREWR);
+		}
+	}
+	f->buflen = (sz>512 ? sz : 512-512%sz);
+	f->size = sz;
+	f->ptr = f->bufadr;
+	f->flags = descr;
+	return(1);
+}
+
+_opn(sz,f) int sz; struct file *f; {
+
+	if (initfl(MAGIC,sz,f))
+		f->count = 0;
+}
+
+_cre(sz,f) int sz; struct file *f; {
+
+	if (initfl(WRBIT|EOFBIT|ELNBIT|MAGIC,sz,f))
+		f->count = f->buflen;
+}

lang/pc/libpc/outcpt.c

@@ -0,0 +1,49 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+#define EINTR	4
+
+extern int	errno;
+extern		_trp();
+extern int	write();
+
+_flush(f) struct file *f; {
+	int i,n;
+
+	f->ptr = f->bufadr;
+	n = f->buflen - f->count;
+	if (n <= 0)
+		return;
+	f->count = f->buflen;
+	if ((i = write(f->ufd,f->bufadr,n)) < 0 && errno == EINTR)
+		return;
+	if (i != n)
+		_trp(EWRITE);
+}
+
+_outcpt(f) struct file *f; {
+
+	f->flags &= ~ELNBIT;
+	f->ptr += f->size;
+	if ((f->count -= f->size) <= 0)
+		_flush(f);
+}

lang/pc/libpc/pac.c

@@ -0,0 +1,49 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_err.h>
+
+extern		_trp();
+
+#define	assert()	/* nothing */
+
+struct descr {
+	int	low;
+	int	diff;
+	int	size;
+};
+
+_pac(ad,zd,zp,i,ap) int i; struct descr *ad,*zd; char *zp,*ap; {
+
+	if (zd->diff > ad->diff ||
+			(i -= ad->low) < 0 ||
+			(i+zd->diff) > ad->diff)
+		_trp(EPACK);
+	ap += (i * ad->size);
+	i = (zd->diff + 1) * zd->size;
+	if (zd->size == 1) {
+		assert(ad->size == 2);
+		while (--i >= 0)
+			*zp++ = *((int *)ap)++;
+	} else {
+		assert(ad->size == zd->size);
+		while (--i >= 0)
+			*zp++ = *ap++;
+	}
+}

lang/pc/libpc/pclose.c

@@ -0,0 +1,9 @@
+#include	<pc_file.h>
+
+extern		_cls();
+
+/* procedure pclose(var f:file of ??); */
+
+pclose(f) struct file *f; {
+	_cls(f);
+}

lang/pc/libpc/pcreat.c

@@ -0,0 +1,40 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern		_cls();
+extern		_trp();
+extern int	creat();
+
+/* procedure pcreat(var f:text; s:string); */
+
+pcreat(f,s) struct file *f; char *s; {
+
+	_cls(f);	/* initializes _curfil */
+	f->ptr = f->bufadr;
+	f->flags = WRBIT|EOFBIT|ELNBIT|TXTBIT|MAGIC;
+	f->fname = s;
+	f->size = 1;
+	f->count = 512;
+	f->buflen = 512;
+	if ((f->ufd = creat(s,0644)) < 0)
+		_trp(EREWR);
+}

lang/pc/libpc/pentry.c

@@ -0,0 +1,34 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+extern int	*_extfl;
+extern char	*_hbase;
+extern		_wrs();
+extern		_wln();
+
+procentry(name) char *name; {
+	struct file *f;
+
+	f = EXTFL(2);
+	_wrs(5,"call ",f);
+	_wrs(8,name,f);
+	_wln(f);
+}

lang/pc/libpc/perrno.c

@@ -0,0 +1,7 @@
+/* function perrno:integer; extern; */
+
+extern int	errno;
+
+int perrno() {
+	return(errno);
+}

lang/pc/libpc/pexit.c

@@ -0,0 +1,15 @@
+#include	<pc_file.h>
+
+extern int	*_extfl;
+extern char	*_hbase;
+extern		_wrs();
+extern		_wln();
+
+procexit(name) char *name; {
+	struct file *f;
+
+	f = EXTFL(2);
+	_wrs(5,"exit ",f);
+	_wrs(8,name,f);
+	_wln(f);
+}

lang/pc/libpc/popen.c

@@ -0,0 +1,40 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern		_cls();
+extern		_trp();
+extern int	open();
+
+/* procedure popen(var f:text; s:string); */
+
+popen(f,s) struct file *f; char *s; {
+
+	_cls(f);	/* initializes _curfil */
+	f->ptr = f->bufadr;
+	f->flags = TXTBIT|MAGIC;
+	f->fname = s;
+	f->size = 1;
+	f->count = 0;
+	f->buflen = 512;
+	if ((f->ufd = open(s,0)) < 0)
+		_trp(ERESET);
+}

lang/pc/libpc/put.c

@@ -0,0 +1,9 @@
+#include	<pc_file.h>
+
+extern		_wf();
+extern		_outcpt();
+
+_put(f) struct file *f; {
+	_wf(f);
+	_outcpt(f);
+}

lang/pc/libpc/rdc.c

@@ -0,0 +1,13 @@
+#include	<pc_file.h>
+
+extern		_rf();
+extern		_incpt();
+
+int _rdc(f) struct file *f; {
+	int c;
+
+	_rf(f);
+	c = *f->ptr;
+	_incpt(f);
+	return(c);
+}

lang/pc/libpc/rdi.c

@@ -0,0 +1,77 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern		_trp();
+extern		_rf();
+extern		_incpt();
+
+_skipsp(f) struct file *f; {
+	while ((*f->ptr == ' ') || (*f->ptr == '\t'))
+		_incpt(f);
+}
+
+int _getsig(f) struct file *f; {
+	int sign;
+
+	if ((sign = (*f->ptr == '-')) || *f->ptr == '+')
+		_incpt(f);
+	return(sign);
+}
+
+int _fstdig(f) struct file *f; {
+	int ch;
+
+	ch = *f->ptr - '0';
+	if ((unsigned) ch > 9) {
+		_trp(EDIGIT);
+		ch = 0;
+	}
+	return(ch);
+}
+
+int _nxtdig(f) struct file *f; {
+	int ch;
+
+	_incpt(f);
+	ch = *f->ptr - '0';
+	if ((unsigned) ch > 9)
+		return(-1);
+	return(ch);
+}
+
+int _getint(f) struct file *f; {
+	int signed,i,ch;
+
+	signed = _getsig(f);
+	ch = _fstdig(f);
+	i = 0;
+	do
+		i = i*10 - ch;
+	while ((ch = _nxtdig(f)) >= 0);
+	return(signed ? i : -i);
+}
+
+int _rdi(f) struct file *f; {
+	_rf(f);
+	_skipsp(f);
+	return(_getint(f));
+}

lang/pc/libpc/rdl.c

@@ -0,0 +1,40 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+extern		_rf();
+extern		_skipsp();
+extern int	_getsig();
+extern int	_fstdig();
+extern int	_nxtdig();
+
+long _rdl(f) struct file *f; {
+	int signed,ch; long l;
+
+	_rf(f);
+	_skipsp(f);
+	signed = _getsig(f);
+	ch = _fstdig(f);
+	l = 0;
+	do
+		l = l*10 - ch;
+	while ((ch = _nxtdig(f)) >= 0);
+	return(signed ? l : -l);
+}

lang/pc/libpc/rdr.c

@@ -0,0 +1,77 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+#define	BIG	1e17
+
+extern		_rf();
+extern		_incpt();
+extern		_skipsp();
+extern int	_getsig();
+extern int	_getint();
+extern int	_fstdig();
+extern int	_nxtdig();
+
+static double		r;
+static int		pow10;
+
+static dig(ch) int ch; {
+
+	if (r>BIG)
+		pow10++;
+	else
+		r = r*10.0 + ch;
+}
+
+double _rdr(f) struct file *f; {
+	int i; double e; int signed,ch;
+
+	r = 0;
+	pow10 = 0;
+	_rf(f);
+	_skipsp(f);
+	signed = _getsig(f);
+	ch = _fstdig(f);
+	do
+		dig(ch);
+	while ((ch = _nxtdig(f)) >= 0);
+	if (*f->ptr == '.') {
+		_incpt(f);
+		ch = _fstdig(f);
+		do {
+			dig(ch);
+			pow10--;
+		} while ((ch = _nxtdig(f)) >= 0);
+	}
+	if ((*f->ptr == 'e') || (*f->ptr == 'E')) {
+		_incpt(f);
+		pow10 += _getint(f);
+	}
+	if ((i = pow10) < 0)
+		i = -i;
+	e = 1.0;
+	while (--i >= 0)
+		e *= 10.0;
+	if (pow10<0)
+		r /= e;
+	else
+		r *= e;
+	return(signed? -r : r);
+}

lang/pc/libpc/rf.c

@@ -0,0 +1,17 @@
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern struct file	*_curfil;
+extern			_trp();
+extern			_incpt();
+
+_rf(f) struct file *f; {
+
+	_curfil = f;
+	if ((f->flags&0377) != MAGIC)
+		_trp(EBADF);
+	if (f->flags & WRBIT)
+		_trp(EREADF);
+	if ((f->flags & WINDOW) == 0)
+		_incpt(f);
+}

lang/pc/libpc/rln.c

@@ -0,0 +1,12 @@
+#include	<pc_file.h>
+
+extern		_rf();
+extern		_incpt();
+
+_rln(f) struct file *f; {
+
+	_rf(f);
+	while ((f->flags & ELNBIT) == 0)
+		_incpt(f);
+	f->flags &= ~WINDOW;
+}

lang/pc/libpc/rnd.c

@@ -0,0 +1,3 @@
+double _rnd(r) double r; {
+	return(r + (r<0 ? -0.5 : 0.5));
+}

lang/pc/libpc/sav.e

@@ -0,0 +1,48 @@
+#
+;  (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+; 
+;           This product is part of the Amsterdam Compiler Kit.
+; 
+;  Permission to use, sell, duplicate or disclose this software must be
+;  obtained in writing. Requests for such permissions may be sent to
+; 
+;       Dr. Andrew S. Tanenbaum
+;       Wiskundig Seminarium
+;       Vrije Universiteit
+;       Postbox 7161
+;       1007 MC Amsterdam
+;       The Netherlands
+; 
+
+/* Author: J.W. Stevenson */
+
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+#define	PTRAD	0
+
+#define	HP	2
+
+; _sav called with one parameter:
+;	- address of pointer variable (PTRAD)
+
+ exp $_sav
+ pro $_sav,0
+ lor HP
+ lal PTRAD
+ loi EM_PSIZE
+ sti EM_PSIZE
+ ret 0
+ end ?
+
+; _rst is called with one parameter:
+;	- address of pointer variable (PTRAD)
+
+ exp $_rst
+ pro $_rst,0
+ lal PTRAD
+ loi EM_PSIZE
+ loi EM_PSIZE
+ str HP
+ ret 0
+ end ?

lang/pc/libpc/sig.e

@@ -0,0 +1,16 @@
+#define PROC    0
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+; _sig is called with one parameter:
+;       - procedure instance identifier (PROC)
+; and returns nothing.
+; only the procedure identifier inside the PROC is used.
+
+ exp $_sig
+ pro $_sig,0
+ lal PROC
+ loi EM_PSIZE
+ sig
+ ret 0                  ; ignore the result of sig
+ end ?

lang/pc/libpc/sin.c

@@ -0,0 +1,92 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+extern double	_fif();
+
+/*
+	C program for floating point sin/cos.
+	Calls _fif.
+	There are no error exits.
+	Coefficients are #3370 from Hart & Cheney (18.80D).
+*/
+
+static double twoopi	= 0.63661977236758134308;
+static double p0	=  .1357884097877375669092680e8;
+static double p1	= -.4942908100902844161158627e7;
+static double p2	=  .4401030535375266501944918e6;
+static double p3	= -.1384727249982452873054457e5;
+static double p4	=  .1459688406665768722226959e3;
+static double q0	=  .8644558652922534429915149e7;
+static double q1	=  .4081792252343299749395779e6;
+static double q2	=  .9463096101538208180571257e4;
+static double q3	=  .1326534908786136358911494e3;
+
+static double
+sinus(arg, quad)
+double arg;
+int quad;
+{
+	double e, f;
+	double ysq;
+	double x,y;
+	int k;
+	double temp1, temp2;
+
+	x = arg;
+	if(x<0) {
+		x = -x;
+		quad = quad + 2;
+	}
+	x = x*twoopi;	/*underflow?*/
+	if(x>32764){
+		y = _fif(x, 10.0, &e);
+		e = e + quad;
+		_fif(0.25, e, &f);
+		quad = e - 4*f;
+	}else{
+		k = x;
+		y = x - k;
+		quad = (quad + k) & 03;
+	}
+	if (quad & 01)
+		y = 1-y;
+	if(quad > 1)
+		y = -y;
+
+	ysq = y*y;
+	temp1 = ((((p4*ysq+p3)*ysq+p2)*ysq+p1)*ysq+p0)*y;
+	temp2 = ((((ysq+q3)*ysq+q2)*ysq+q1)*ysq+q0);
+	return(temp1/temp2);
+}
+
+double
+_cos(arg)
+double arg;
+{
+	if(arg<0)
+		arg = -arg;
+	return(sinus(arg, 1));
+}
+
+double
+_sin(arg)
+double arg;
+{
+	return(sinus(arg, 0));
+}

lang/pc/libpc/sqt.c

@@ -0,0 +1,77 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_err.h>
+
+extern	double	_fef();
+extern		_trp();
+
+/*
+	sqrt returns the square root of its floating
+	point argument. Newton's method.
+
+	calls _fef
+*/
+
+double
+_sqt(arg)
+double arg;
+{
+	double x, temp;
+	int exp;
+	int i;
+
+	if(arg <= 0) {
+		if(arg < 0)
+			_trp(ESQT);
+		return(0);
+	}
+	x = _fef(arg,&exp);
+	/*
+	while(x < 0.5) {
+		x =* 2;
+		exp--;
+	}
+	*/
+	/*
+	 * NOTE
+	 * this wont work on 1's comp
+	 */
+	if(exp & 1) {
+		x *= 2;
+		exp--;
+	}
+	temp = 0.5*(1 + x);
+
+	while(exp > 28) {
+		temp *= (1<<14);
+		exp -= 28;
+	}
+	while(exp < -28) {
+		temp /= (1<<14);
+		exp += 28;
+	}
+	if(exp >= 0)
+		temp *= 1 << (exp/2);
+	else
+		temp /= 1 << (-exp/2);
+	for(i=0; i<=4; i++)
+		temp = 0.5*(temp + arg/temp);
+	return(temp);
+}

lang/pc/libpc/string.c

@@ -0,0 +1,42 @@
+/* function strbuf(var b:charbuf):string; */
+
+char *strbuf(s) char *s; {
+	return(s);
+}
+
+/* function strtobuf(s:string; var b:charbuf; blen:integer):integer; */
+
+int strtobuf(s,b,l) char *s,*b; {
+	int i;
+
+	i = 0;
+	while (--l>=0) {
+		if ((*b++ = *s++) == 0)
+			break;
+		i++;
+	}
+	return(i);
+}
+
+/* function strlen(s:string):integer; */
+
+int strlen(s) char *s; {
+	int i;
+
+	i = 0;
+	while (*s++)
+		i++;
+	return(i);
+}
+
+/* function strfetch(s:string; i:integer):char; */
+
+int strfetch(s,i) char *s; {
+	return(s[i-1]);
+}
+
+/* procedure strstore(s:string; i:integer; c:char); */
+
+strstore(s,i,c) char *s; {
+	s[i-1] = c;
+}

lang/pc/libpc/trap.e

@@ -0,0 +1,15 @@
+#
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+#define	TRAP	0
+
+; trap is called with one parameter:
+;	- trap number (TRAP)
+
+ exp $trap
+ pro $trap,0
+ lol TRAP
+ trp
+ ret 0
+ end ?

lang/pc/libpc/trp.e

@@ -0,0 +1,20 @@
+#
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+#define TRAP    0
+
+; _trp() and trap() perform the same function,
+; but have to be separate. trap exists to facilitate the user.
+; _trp is there for the system, trap cannot be used for that purpose
+; because a user might define its own Pascal routine called trap.
+
+; _trp is called with one parameter:
+;       - trap number (TRAP)
+
+ exp $_trp
+ pro $_trp,0
+ lol TRAP
+ trp
+ ret 0
+ end ?

lang/pc/libpc/unp.c

@@ -0,0 +1,49 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_err.h>
+
+extern		_trp();
+
+#define	assert()	/* nothing */
+
+struct descr {
+	int	low;
+	int	diff;
+	int	size;
+};
+
+_unp(ad,zd,i,ap,zp) int i; struct descr *ad,*zd; char *ap,*zp; {
+
+	if (zd->diff > ad->diff ||
+			(i -= ad->low) < 0 ||
+			(i+zd->diff) > ad->diff)
+		_trp(EUNPACK);
+	ap += (i * ad->size);
+	i = (zd->diff + 1) * zd->size;
+	if (zd->size == 1) {
+		assert(ad->size == 2);
+		while (--i >= 0)
+			*((int *)ap)++ = *zp++;
+	} else {
+		assert(ad->size == zd->size);
+		while (--i >= 0)
+			*ap++ = *zp++;
+	}
+}

lang/pc/libpc/uread.c

@@ -0,0 +1,7 @@
+/* function uread(fd:integer; var b:buf; n:integer):integer; */
+
+extern int	read();
+
+int uread(fd,b,n) char *b; int fd,n; {
+	return(read(fd,b,n));
+}

lang/pc/libpc/uwrite.c

@@ -0,0 +1,7 @@
+/* function uwrite(fd:integer; var b:buf; n:integer):integer; */
+
+extern int	write();
+
+int uwrite(fd,b,n) char *b; int fd,n; {
+	return(write(fd,b,n));
+}

lang/pc/libpc/wdw.c

@@ -0,0 +1,12 @@
+#include	<pc_file.h>
+
+extern struct file	*_curfil;
+extern			_incpt();
+
+char *_wdw(f) struct file *f; {
+
+	_curfil = f;
+	if ((f->flags & (WINDOW|WRBIT|0377)) == MAGIC)
+		_incpt(f);
+	return(f->ptr);
+}

lang/pc/libpc/wf.c

@@ -0,0 +1,14 @@
+#include	<pc_file.h>
+#include	<pc_err.h>
+
+extern struct file	*_curfil;
+extern			_trp();
+
+_wf(f) struct file *f; {
+
+	_curfil = f;
+	if ((f->flags&0377) != MAGIC)
+		_trp(EBADF);
+	if ((f->flags & WRBIT) == 0)
+		_trp(EWRITEF);
+}

lang/pc/libpc/wrc.c

@@ -0,0 +1,23 @@
+#include	<pc_file.h>
+
+extern		_wf();
+extern		_outcpt();
+
+_wrc(c,f) int c; struct file *f; {
+	*f->ptr = c;
+	_wf(f);
+	_outcpt(f);
+}
+
+_wln(f) struct file *f; {
+#ifdef CPM
+	_wrc('\r',f);
+#endif
+	_wrc('\n',f);
+	f->flags |= ELNBIT;
+}
+
+_pag(f) struct file *f; {
+	_wrc('\014',f);
+	f->flags |= ELNBIT;
+}

lang/pc/libpc/wrf.c

@@ -0,0 +1,60 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+extern		_wstrin();
+extern char	*_fcvt();
+
+#define	assert()	/* nothing */
+
+#define	HUGE_DIG	39	/* log10(maxreal) */
+#define	PREC_DIG	80	/* the maximum digits returned by _fcvt() */
+#define	FILL_CHAR	'0'	/* char printed if all of _fcvt() used */
+#define	BUFSIZE		HUGE_DIG + PREC_DIG + 2
+
+_wrf(n,w,r,f) int n,w; double r; struct file *f; {
+	char *p,*b; int s,d; char buf[BUFSIZE];
+
+	p = buf;
+	if (n > PREC_DIG)
+		n = PREC_DIG;
+	b = _fcvt(r,n,&d,&s);
+	assert(abs(d) <= HUGE_DIG);
+	if (s)
+		*p++ = '-';
+	if (d<=0)
+		*p++ = '0';
+	else
+		do
+			*p++ = (*b ? *b++ : FILL_CHAR);
+		while (--d > 0);
+	if (n > 0)
+		*p++ = '.';
+	while (++d <= 0) {
+		if (--n < 0)
+			break;
+		*p++ = '0';
+	}
+	while (--n >= 0) {
+		*p++ = (*b ? *b++ : FILL_CHAR);
+		assert(p <= buf+BUFSIZE);
+	}
+	_wstrin(w,p-buf,buf,f);
+}

lang/pc/libpc/wri.c

@@ -0,0 +1,26 @@
+#include	<pc_file.h>
+
+extern		_wstrin();
+
+_wsi(w,i,f) int w,i; struct file *f; {
+	char *p; int j; char buf[6];
+
+	p = &buf[6];
+	if ((j=i) < 0) {
+		if (i == -32768) {
+			_wstrin(w,6,"-32768",f);
+			return;
+		}
+		j = -j;
+	}
+	do
+		*--p = '0' + j%10;
+	while (j /= 10);
+	if (i<0)
+		*--p = '-';
+	_wstrin(w,&buf[6]-p,p,f);
+}
+
+_wri(i,f) int i; struct file *f; {
+	_wsi(6,i,f);
+}

lang/pc/libpc/wrl.c

@@ -0,0 +1,48 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+extern		_wstrin();
+
+#define	MAXNEGLONG	-2147483648
+
+_wsl(w,l,f) int w; long l; struct file *f; {
+	char *p,c; long j; char buf[11];
+
+	p = &buf[11];
+	if ((j=l) < 0) {
+		if (l == MAXNEGLONG) {
+			_wstrin(w,11,"-2147483648",f);
+			return;
+		}
+		j = -j;
+	}
+	do {
+		c = j%10;
+		*--p = c + '0';
+	} while (j /= 10);
+	if (l<0)
+		*--p = '-';
+	_wstrin(w,&buf[11]-p,p,f);
+}
+
+_wrl(l,f) long l; struct file *f; {
+	_wsl(11,l,f);
+}

lang/pc/libpc/wrr.c

@@ -0,0 +1,55 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+extern		_wstrin();
+extern char	*_ecvt();
+
+#define	PREC_DIG	80	/* maximum digits produced by _ecvt() */
+
+_wsr(w,r,f) int w; double r; struct file *f; {
+	char *p,*b; int s,d,i; char buf[PREC_DIG+6];
+
+	p = buf;
+	if ((i = w-6) < 2)
+		i = 2;
+	b = _ecvt(r,i,&d,&s);
+	*p++ = s? '-' : ' ';
+	if (*b == '0')
+		d++;
+	*p++ = *b++;
+	*p++ = '.';
+	while (--i > 0)
+		*p++ = *b++;
+	*p++ = 'e';
+	d--;
+	if (d < 0) {
+		d = -d;
+		*p++ = '-';
+	} else
+		*p++ = '+';
+	*p++ = '0' + (d/10);
+	*p++ = '0' + (d%10);
+	_wstrin(w,p-buf,buf,f);
+}
+
+_wrr(r,f) double r; struct file *f; {
+	_wsr(13,r,f);
+}

lang/pc/libpc/wrs.c

@@ -0,0 +1,61 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+
+#include	<pc_file.h>
+
+extern		_wf();
+extern		_outcpt();
+
+_wstrin(width,len,buf,f) int width,len; char *buf; struct file *f; {
+
+	_wf(f);
+	for (width -= len; width>0; width--) {
+		*f->ptr = ' ';
+		_outcpt(f);
+	}
+	while (--len >= 0) {
+		*f->ptr = *buf++;
+		_outcpt(f);
+	}
+}
+
+_wsc(w,c,f) int w; char c; struct file *f; {
+	_wss(w,1,&c,f);
+}
+
+_wss(w,len,s,f) int w,len; char *s; struct file *f; {
+	if (w < len)
+		len = w;
+	_wstrin(w,len,s,f);
+}
+
+_wrs(len,s,f) int len; char *s; struct file *f; {
+	_wss(len,len,s,f);
+}
+
+_wsb(w,b,f) int w,b; struct file *f; {
+	if (b)
+		_wss(w,4,"true",f);
+	else
+		_wss(w,5,"false",f);
+}
+
+_wrb(b,f) int b; struct file *f; {
+	_wsb(5,b,f);
+}

lang/pc/libpc/wrz.c

@@ -0,0 +1,18 @@
+#include	<pc_file.h>
+
+extern		_wss();
+extern		_wrs();
+
+_wsz(w,s,f) int w; char *s; struct file *f; {
+	char *p;
+
+	for (p=s; *p; p++);
+	_wss(w,p-s,s,f);
+}
+
+_wrz(s,f) char *s; struct file *f; {
+	char *p;
+
+	for (p=s; *p; p++);
+	_wrs(p-s,s,f);
+}