--- /dev/null
+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)
--- /dev/null
+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.
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+ }
+}
--- /dev/null
+/*
+ * (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));
+}
--- /dev/null
+/*
+ * (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));
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+#
+;
+; (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 ?
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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;
+}
--- /dev/null
+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));
+}
--- /dev/null
+/*
+ * (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;
+}
--- /dev/null
+/*
+ * (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;
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+#
+
+
+; (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 ?
--- /dev/null
+/*
+ * (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));
+}
--- /dev/null
+#
+ 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 ?
--- /dev/null
+#
+ 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 ?
--- /dev/null
+#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;
+}
--- /dev/null
+#
+; (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 ?
--- /dev/null
+#
+ mes 2,EM_WSIZE,EM_PSIZE
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+#
+
+ 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 ?
--- /dev/null
+/*
+ * (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
+ }
+}
--- /dev/null
+/*
+ * (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;
+ }
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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;
+}
--- /dev/null
+/*
+ * (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;
+}
--- /dev/null
+#include <pc_file.h>
+
+notext(f) struct file *f; {
+ f->flags &= ~TXTBIT;
+}
--- /dev/null
+/*
+ * (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;
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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++;
+ }
+}
--- /dev/null
+#include <pc_file.h>
+
+extern _cls();
+
+/* procedure pclose(var f:file of ??); */
+
+pclose(f) struct file *f; {
+ _cls(f);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/* function perrno:integer; extern; */
+
+extern int errno;
+
+int perrno() {
+ return(errno);
+}
--- /dev/null
+#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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+#include <pc_file.h>
+
+extern _wf();
+extern _outcpt();
+
+_put(f) struct file *f; {
+ _wf(f);
+ _outcpt(f);
+}
--- /dev/null
+#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);
+}
--- /dev/null
+/*
+ * (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));
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+#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);
+}
--- /dev/null
+#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;
+}
--- /dev/null
+double _rnd(r) double r; {
+ return(r + (r<0 ? -0.5 : 0.5));
+}
--- /dev/null
+#
+; (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 ?
--- /dev/null
+#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 ?
--- /dev/null
+/*
+ * (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));
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/* 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;
+}
--- /dev/null
+#
+
+ 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 ?
--- /dev/null
+#
+
+ 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 ?
--- /dev/null
+/*
+ * (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++;
+ }
+}
--- /dev/null
+/* 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));
+}
--- /dev/null
+/* 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));
+}
--- /dev/null
+#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);
+}
--- /dev/null
+#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);
+}
--- /dev/null
+#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;
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+#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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+/*
+ * (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);
+}
--- /dev/null
+#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);
+}
public / ack.git / commitdiff