From 597d25decd008250cae3588d74bdb39dded39e46 Mon Sep 17 00:00:00 2001 From: sater Date: Fri, 20 Jul 1984 10:44:57 +0000 Subject: [PATCH] Initial revision --- lang/pc/libpc/Makefile | 14 ++++ lang/pc/libpc/READ_ME | 11 ++++ lang/pc/libpc/abi.c | 22 +++++++ lang/pc/libpc/abl.c | 22 +++++++ lang/pc/libpc/abr.c | 22 +++++++ lang/pc/libpc/arg.c | 55 ++++++++++++++++ lang/pc/libpc/ass.c | 32 +++++++++ lang/pc/libpc/asz.c | 28 ++++++++ lang/pc/libpc/atn.c | 91 +++++++++++++++++++++++++ lang/pc/libpc/bcp.c | 29 ++++++++ lang/pc/libpc/bts.e | 55 ++++++++++++++++ lang/pc/libpc/buff.c | 34 ++++++++++ lang/pc/libpc/catch.c | 94 ++++++++++++++++++++++++++ lang/pc/libpc/clock.c | 36 ++++++++++ lang/pc/libpc/cls.c | 66 +++++++++++++++++++ lang/pc/libpc/cvt.c | 104 +++++++++++++++++++++++++++++ lang/pc/libpc/diag.c | 33 ++++++++++ lang/pc/libpc/dis.c | 86 ++++++++++++++++++++++++ lang/pc/libpc/efl.c | 35 ++++++++++ lang/pc/libpc/eln.c | 32 +++++++++ lang/pc/libpc/encaps.e | 143 ++++++++++++++++++++++++++++++++++++++++ lang/pc/libpc/exp.c | 123 ++++++++++++++++++++++++++++++++++ lang/pc/libpc/fef.e | 21 ++++++ lang/pc/libpc/fif.e | 23 +++++++ lang/pc/libpc/get.c | 13 ++++ lang/pc/libpc/gto.e | 84 +++++++++++++++++++++++ lang/pc/libpc/head_pc.e | 2 + lang/pc/libpc/hlt.c | 34 ++++++++++ lang/pc/libpc/hol0.e | 11 ++++ lang/pc/libpc/incpt.c | 74 +++++++++++++++++++++ lang/pc/libpc/ini.c | 72 ++++++++++++++++++++ lang/pc/libpc/log.c | 76 +++++++++++++++++++++ lang/pc/libpc/mdi.c | 32 +++++++++ lang/pc/libpc/mdl.c | 32 +++++++++ lang/pc/libpc/new.c | 66 +++++++++++++++++++ lang/pc/libpc/nobuff.c | 32 +++++++++ lang/pc/libpc/notext.c | 5 ++ lang/pc/libpc/opn.c | 116 ++++++++++++++++++++++++++++++++ lang/pc/libpc/outcpt.c | 49 ++++++++++++++ lang/pc/libpc/pac.c | 49 ++++++++++++++ lang/pc/libpc/pclose.c | 9 +++ lang/pc/libpc/pcreat.c | 40 +++++++++++ lang/pc/libpc/pentry.c | 34 ++++++++++ lang/pc/libpc/perrno.c | 7 ++ lang/pc/libpc/pexit.c | 15 +++++ lang/pc/libpc/popen.c | 40 +++++++++++ lang/pc/libpc/put.c | 9 +++ lang/pc/libpc/rdc.c | 13 ++++ lang/pc/libpc/rdi.c | 77 ++++++++++++++++++++++ lang/pc/libpc/rdl.c | 40 +++++++++++ lang/pc/libpc/rdr.c | 77 ++++++++++++++++++++++ lang/pc/libpc/rf.c | 17 +++++ lang/pc/libpc/rln.c | 12 ++++ lang/pc/libpc/rnd.c | 3 + lang/pc/libpc/sav.e | 48 ++++++++++++++ lang/pc/libpc/sig.e | 16 +++++ lang/pc/libpc/sin.c | 92 ++++++++++++++++++++++++++ lang/pc/libpc/sqt.c | 77 ++++++++++++++++++++++ lang/pc/libpc/string.c | 42 ++++++++++++ lang/pc/libpc/trap.e | 15 +++++ lang/pc/libpc/trp.e | 20 ++++++ lang/pc/libpc/unp.c | 49 ++++++++++++++ lang/pc/libpc/uread.c | 7 ++ lang/pc/libpc/uwrite.c | 7 ++ lang/pc/libpc/wdw.c | 12 ++++ lang/pc/libpc/wf.c | 14 ++++ lang/pc/libpc/wrc.c | 23 +++++++ lang/pc/libpc/wrf.c | 60 +++++++++++++++++ lang/pc/libpc/wri.c | 26 ++++++++ lang/pc/libpc/wrl.c | 48 ++++++++++++++ lang/pc/libpc/wrr.c | 55 ++++++++++++++++ lang/pc/libpc/wrs.c | 61 +++++++++++++++++ lang/pc/libpc/wrz.c | 18 +++++ 73 files changed, 3041 insertions(+) create mode 100644 lang/pc/libpc/Makefile create mode 100644 lang/pc/libpc/READ_ME create mode 100644 lang/pc/libpc/abi.c create mode 100644 lang/pc/libpc/abl.c create mode 100644 lang/pc/libpc/abr.c create mode 100644 lang/pc/libpc/arg.c create mode 100644 lang/pc/libpc/ass.c create mode 100644 lang/pc/libpc/asz.c create mode 100644 lang/pc/libpc/atn.c create mode 100644 lang/pc/libpc/bcp.c create mode 100644 lang/pc/libpc/bts.e create mode 100644 lang/pc/libpc/buff.c create mode 100644 lang/pc/libpc/catch.c create mode 100644 lang/pc/libpc/clock.c create mode 100644 lang/pc/libpc/cls.c create mode 100644 lang/pc/libpc/cvt.c create mode 100644 lang/pc/libpc/diag.c create mode 100644 lang/pc/libpc/dis.c create mode 100644 lang/pc/libpc/efl.c create mode 100644 lang/pc/libpc/eln.c create mode 100644 lang/pc/libpc/encaps.e create mode 100644 lang/pc/libpc/exp.c create mode 100644 lang/pc/libpc/fef.e create mode 100644 lang/pc/libpc/fif.e create mode 100644 lang/pc/libpc/get.c create mode 100644 lang/pc/libpc/gto.e create mode 100644 lang/pc/libpc/head_pc.e create mode 100644 lang/pc/libpc/hlt.c create mode 100644 lang/pc/libpc/hol0.e create mode 100644 lang/pc/libpc/incpt.c create mode 100644 lang/pc/libpc/ini.c create mode 100644 lang/pc/libpc/log.c create mode 100644 lang/pc/libpc/mdi.c create mode 100644 lang/pc/libpc/mdl.c create mode 100644 lang/pc/libpc/new.c create mode 100644 lang/pc/libpc/nobuff.c create mode 100644 lang/pc/libpc/notext.c create mode 100644 lang/pc/libpc/opn.c create mode 100644 lang/pc/libpc/outcpt.c create mode 100644 lang/pc/libpc/pac.c create mode 100644 lang/pc/libpc/pclose.c create mode 100644 lang/pc/libpc/pcreat.c create mode 100644 lang/pc/libpc/pentry.c create mode 100644 lang/pc/libpc/perrno.c create mode 100644 lang/pc/libpc/pexit.c create mode 100644 lang/pc/libpc/popen.c create mode 100644 lang/pc/libpc/put.c create mode 100644 lang/pc/libpc/rdc.c create mode 100644 lang/pc/libpc/rdi.c create mode 100644 lang/pc/libpc/rdl.c create mode 100644 lang/pc/libpc/rdr.c create mode 100644 lang/pc/libpc/rf.c create mode 100644 lang/pc/libpc/rln.c create mode 100644 lang/pc/libpc/rnd.c create mode 100644 lang/pc/libpc/sav.e create mode 100644 lang/pc/libpc/sig.e create mode 100644 lang/pc/libpc/sin.c create mode 100644 lang/pc/libpc/sqt.c create mode 100644 lang/pc/libpc/string.c create mode 100644 lang/pc/libpc/trap.e create mode 100644 lang/pc/libpc/trp.e create mode 100644 lang/pc/libpc/unp.c create mode 100644 lang/pc/libpc/uread.c create mode 100644 lang/pc/libpc/uwrite.c create mode 100644 lang/pc/libpc/wdw.c create mode 100644 lang/pc/libpc/wf.c create mode 100644 lang/pc/libpc/wrc.c create mode 100644 lang/pc/libpc/wrf.c create mode 100644 lang/pc/libpc/wri.c create mode 100644 lang/pc/libpc/wrl.c create mode 100644 lang/pc/libpc/wrr.c create mode 100644 lang/pc/libpc/wrs.c create mode 100644 lang/pc/libpc/wrz.c diff --git a/lang/pc/libpc/Makefile b/lang/pc/libpc/Makefile new file mode 100644 index 000000000..ab01c2b0c --- /dev/null +++ b/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) diff --git a/lang/pc/libpc/READ_ME b/lang/pc/libpc/READ_ME new file mode 100644 index 000000000..90712d07f --- /dev/null +++ b/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. diff --git a/lang/pc/libpc/abi.c b/lang/pc/libpc/abi.c new file mode 100644 index 000000000..3844c79f9 --- /dev/null +++ b/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); +} diff --git a/lang/pc/libpc/abl.c b/lang/pc/libpc/abl.c new file mode 100644 index 000000000..fb625c0b7 --- /dev/null +++ b/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); +} diff --git a/lang/pc/libpc/abr.c b/lang/pc/libpc/abr.c new file mode 100644 index 000000000..9ee7d418d --- /dev/null +++ b/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); +} diff --git a/lang/pc/libpc/arg.c b/lang/pc/libpc/arg.c new file mode 100644 index 000000000..4c43e2a0a --- /dev/null +++ b/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); +} diff --git a/lang/pc/libpc/ass.c b/lang/pc/libpc/ass.c new file mode 100644 index 000000000..747587ec7 --- /dev/null +++ b/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 +#include + +extern char *_hol0(); +extern _trp(); + +_ass(line,bool) int line,bool; { + + if (bool==0) { + LINO = line; + _trp(EASS); + } +} diff --git a/lang/pc/libpc/asz.c b/lang/pc/libpc/asz.c new file mode 100644 index 000000000..b47e69907 --- /dev/null +++ b/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)); +} diff --git a/lang/pc/libpc/atn.c b/lang/pc/libpc/atn.c new file mode 100644 index 000000000..edfa45553 --- /dev/null +++ b/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)); +} diff --git a/lang/pc/libpc/bcp.c b/lang/pc/libpc/bcp.c new file mode 100644 index 000000000..12783d5f0 --- /dev/null +++ b/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); +} diff --git a/lang/pc/libpc/bts.e b/lang/pc/libpc/bts.e new file mode 100644 index 000000000..8dd36b358 --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/buff.c b/lang/pc/libpc/buff.c new file mode 100644 index 000000000..9d64327eb --- /dev/null +++ b/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 + +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); +} diff --git a/lang/pc/libpc/catch.c b/lang/pc/libpc/catch.c new file mode 100644 index 000000000..f6abc3a96 --- /dev/null +++ b/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 +#include +#include + +#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 +#include + +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; +} diff --git a/lang/pc/libpc/cvt.c b/lang/pc/libpc/cvt.c new file mode 100644 index 000000000..0d73ef7d8 --- /dev/null +++ b/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)); +} diff --git a/lang/pc/libpc/diag.c b/lang/pc/libpc/diag.c new file mode 100644 index 000000000..3b43cfc9b --- /dev/null +++ b/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 + +/* 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; +} diff --git a/lang/pc/libpc/dis.c b/lang/pc/libpc/dis.c new file mode 100644 index 000000000..64320f0b0 --- /dev/null +++ b/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 + +#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; +} diff --git a/lang/pc/libpc/efl.c b/lang/pc/libpc/efl.c new file mode 100644 index 000000000..7b8581b90 --- /dev/null +++ b/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 +#include + +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); +} diff --git a/lang/pc/libpc/eln.c b/lang/pc/libpc/eln.c new file mode 100644 index 000000000..74e6cf24d --- /dev/null +++ b/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 +#include + +extern _trp(); +extern _rf(); + +int _eln(f) struct file *f; { + + _rf(f); + if (f->flags & EOFBIT) + _trp(EEOF); + return((f->flags & ELNBIT) != 0); +} diff --git a/lang/pc/libpc/encaps.e b/lang/pc/libpc/encaps.e new file mode 100644 index 000000000..1715e4aac --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/exp.c b/lang/pc/libpc/exp.c new file mode 100644 index 000000000..3726de14e --- /dev/null +++ b/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 + +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< 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)); +} diff --git a/lang/pc/libpc/fef.e b/lang/pc/libpc/fef.e new file mode 100644 index 000000000..3bceb28ec --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/fif.e b/lang/pc/libpc/fif.e new file mode 100644 index 000000000..40d54d1d7 --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/get.c b/lang/pc/libpc/get.c new file mode 100644 index 000000000..7cee957d0 --- /dev/null +++ b/lang/pc/libpc/get.c @@ -0,0 +1,13 @@ +#include +#include + +extern _rf(); +extern _trp(); + +_get(f) struct file *f; { + + _rf(f); + if (f->flags&EOFBIT) + _trp(EEOF); + f->flags &= ~WINDOW; +} diff --git a/lang/pc/libpc/gto.e b/lang/pc/libpc/gto.e new file mode 100644 index 000000000..76e32a2ad --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/head_pc.e b/lang/pc/libpc/head_pc.e new file mode 100644 index 000000000..1099b03aa --- /dev/null +++ b/lang/pc/libpc/head_pc.e @@ -0,0 +1,2 @@ +# + mes 2,EM_WSIZE,EM_PSIZE diff --git a/lang/pc/libpc/hlt.c b/lang/pc/libpc/hlt.c new file mode 100644 index 000000000..c1d27a451 --- /dev/null +++ b/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 + +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); +} diff --git a/lang/pc/libpc/hol0.e b/lang/pc/libpc/hol0.e new file mode 100644 index 000000000..db2ff4ff1 --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/incpt.c b/lang/pc/libpc/incpt.c new file mode 100644 index 000000000..e05ccf934 --- /dev/null +++ b/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 +#include + +#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 + } +} diff --git a/lang/pc/libpc/ini.c b/lang/pc/libpc/ini.c new file mode 100644 index 000000000..c7e5e8e15 --- /dev/null +++ b/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 +#include + +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; + } +} diff --git a/lang/pc/libpc/log.c b/lang/pc/libpc/log.c new file mode 100644 index 000000000..662fcd0e4 --- /dev/null +++ b/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 + +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 + +extern _trp(); + +int _mdi(j,i) int j,i; { + + if (j <= 0) + _trp(EMOD); + i = i % j; + if (i < 0) + i += j; + return(i); +} diff --git a/lang/pc/libpc/mdl.c b/lang/pc/libpc/mdl.c new file mode 100644 index 000000000..4c5465d4f --- /dev/null +++ b/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 + +extern _trp(); + +long _mdl(j,i) long j,i; { + + if (j <= 0) + _trp(EMOD); + i = i % j; + if (i < 0) + i += j; + return(i); +} diff --git a/lang/pc/libpc/new.c b/lang/pc/libpc/new.c new file mode 100644 index 000000000..80868f48d --- /dev/null +++ b/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; +} diff --git a/lang/pc/libpc/nobuff.c b/lang/pc/libpc/nobuff.c new file mode 100644 index 000000000..3274a14e0 --- /dev/null +++ b/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 + +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; +} diff --git a/lang/pc/libpc/notext.c b/lang/pc/libpc/notext.c new file mode 100644 index 000000000..1256087c1 --- /dev/null +++ b/lang/pc/libpc/notext.c @@ -0,0 +1,5 @@ +#include + +notext(f) struct file *f; { + f->flags &= ~TXTBIT; +} diff --git a/lang/pc/libpc/opn.c b/lang/pc/libpc/opn.c new file mode 100644 index 000000000..882a2dc8b --- /dev/null +++ b/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 +#include + +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; +} diff --git a/lang/pc/libpc/outcpt.c b/lang/pc/libpc/outcpt.c new file mode 100644 index 000000000..2cc03f524 --- /dev/null +++ b/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 +#include + +#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); +} diff --git a/lang/pc/libpc/pac.c b/lang/pc/libpc/pac.c new file mode 100644 index 000000000..e3cb43b35 --- /dev/null +++ b/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 + +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++; + } +} diff --git a/lang/pc/libpc/pclose.c b/lang/pc/libpc/pclose.c new file mode 100644 index 000000000..6d0bdd11f --- /dev/null +++ b/lang/pc/libpc/pclose.c @@ -0,0 +1,9 @@ +#include + +extern _cls(); + +/* procedure pclose(var f:file of ??); */ + +pclose(f) struct file *f; { + _cls(f); +} diff --git a/lang/pc/libpc/pcreat.c b/lang/pc/libpc/pcreat.c new file mode 100644 index 000000000..ea8449012 --- /dev/null +++ b/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 +#include + +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); +} diff --git a/lang/pc/libpc/pentry.c b/lang/pc/libpc/pentry.c new file mode 100644 index 000000000..e979e64e9 --- /dev/null +++ b/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 + +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); +} diff --git a/lang/pc/libpc/perrno.c b/lang/pc/libpc/perrno.c new file mode 100644 index 000000000..4ed3b715c --- /dev/null +++ b/lang/pc/libpc/perrno.c @@ -0,0 +1,7 @@ +/* function perrno:integer; extern; */ + +extern int errno; + +int perrno() { + return(errno); +} diff --git a/lang/pc/libpc/pexit.c b/lang/pc/libpc/pexit.c new file mode 100644 index 000000000..170704411 --- /dev/null +++ b/lang/pc/libpc/pexit.c @@ -0,0 +1,15 @@ +#include + +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); +} diff --git a/lang/pc/libpc/popen.c b/lang/pc/libpc/popen.c new file mode 100644 index 000000000..ae245eaed --- /dev/null +++ b/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 +#include + +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); +} diff --git a/lang/pc/libpc/put.c b/lang/pc/libpc/put.c new file mode 100644 index 000000000..21254f3e9 --- /dev/null +++ b/lang/pc/libpc/put.c @@ -0,0 +1,9 @@ +#include + +extern _wf(); +extern _outcpt(); + +_put(f) struct file *f; { + _wf(f); + _outcpt(f); +} diff --git a/lang/pc/libpc/rdc.c b/lang/pc/libpc/rdc.c new file mode 100644 index 000000000..70b2f2d2b --- /dev/null +++ b/lang/pc/libpc/rdc.c @@ -0,0 +1,13 @@ +#include + +extern _rf(); +extern _incpt(); + +int _rdc(f) struct file *f; { + int c; + + _rf(f); + c = *f->ptr; + _incpt(f); + return(c); +} diff --git a/lang/pc/libpc/rdi.c b/lang/pc/libpc/rdi.c new file mode 100644 index 000000000..d32e7f5f1 --- /dev/null +++ b/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 +#include + +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)); +} diff --git a/lang/pc/libpc/rdl.c b/lang/pc/libpc/rdl.c new file mode 100644 index 000000000..a687d58b5 --- /dev/null +++ b/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 + +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); +} diff --git a/lang/pc/libpc/rdr.c b/lang/pc/libpc/rdr.c new file mode 100644 index 000000000..7d7a6b000 --- /dev/null +++ b/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 + +#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); +} diff --git a/lang/pc/libpc/rf.c b/lang/pc/libpc/rf.c new file mode 100644 index 000000000..42e81aa63 --- /dev/null +++ b/lang/pc/libpc/rf.c @@ -0,0 +1,17 @@ +#include +#include + +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); +} diff --git a/lang/pc/libpc/rln.c b/lang/pc/libpc/rln.c new file mode 100644 index 000000000..66e56fc96 --- /dev/null +++ b/lang/pc/libpc/rln.c @@ -0,0 +1,12 @@ +#include + +extern _rf(); +extern _incpt(); + +_rln(f) struct file *f; { + + _rf(f); + while ((f->flags & ELNBIT) == 0) + _incpt(f); + f->flags &= ~WINDOW; +} diff --git a/lang/pc/libpc/rnd.c b/lang/pc/libpc/rnd.c new file mode 100644 index 000000000..848ff18de --- /dev/null +++ b/lang/pc/libpc/rnd.c @@ -0,0 +1,3 @@ +double _rnd(r) double r; { + return(r + (r<0 ? -0.5 : 0.5)); +} diff --git a/lang/pc/libpc/sav.e b/lang/pc/libpc/sav.e new file mode 100644 index 000000000..47b9524a1 --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/sig.e b/lang/pc/libpc/sig.e new file mode 100644 index 000000000..5ba95134f --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/sin.c b/lang/pc/libpc/sin.c new file mode 100644 index 000000000..782ec9017 --- /dev/null +++ b/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)); +} diff --git a/lang/pc/libpc/sqt.c b/lang/pc/libpc/sqt.c new file mode 100644 index 000000000..097d60f2c --- /dev/null +++ b/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 + +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); +} diff --git a/lang/pc/libpc/string.c b/lang/pc/libpc/string.c new file mode 100644 index 000000000..7cb16a258 --- /dev/null +++ b/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; +} diff --git a/lang/pc/libpc/trap.e b/lang/pc/libpc/trap.e new file mode 100644 index 000000000..b94aba924 --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/trp.e b/lang/pc/libpc/trp.e new file mode 100644 index 000000000..bc9986ae4 --- /dev/null +++ b/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 ? diff --git a/lang/pc/libpc/unp.c b/lang/pc/libpc/unp.c new file mode 100644 index 000000000..d292cae5f --- /dev/null +++ b/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 + +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++; + } +} diff --git a/lang/pc/libpc/uread.c b/lang/pc/libpc/uread.c new file mode 100644 index 000000000..e63aab02d --- /dev/null +++ b/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)); +} diff --git a/lang/pc/libpc/uwrite.c b/lang/pc/libpc/uwrite.c new file mode 100644 index 000000000..9cc838573 --- /dev/null +++ b/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)); +} diff --git a/lang/pc/libpc/wdw.c b/lang/pc/libpc/wdw.c new file mode 100644 index 000000000..d8c1931f6 --- /dev/null +++ b/lang/pc/libpc/wdw.c @@ -0,0 +1,12 @@ +#include + +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); +} diff --git a/lang/pc/libpc/wf.c b/lang/pc/libpc/wf.c new file mode 100644 index 000000000..1836f87db --- /dev/null +++ b/lang/pc/libpc/wf.c @@ -0,0 +1,14 @@ +#include +#include + +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); +} diff --git a/lang/pc/libpc/wrc.c b/lang/pc/libpc/wrc.c new file mode 100644 index 000000000..e90d61e99 --- /dev/null +++ b/lang/pc/libpc/wrc.c @@ -0,0 +1,23 @@ +#include + +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; +} diff --git a/lang/pc/libpc/wrf.c b/lang/pc/libpc/wrf.c new file mode 100644 index 000000000..f2c680bfe --- /dev/null +++ b/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 + +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); +} diff --git a/lang/pc/libpc/wri.c b/lang/pc/libpc/wri.c new file mode 100644 index 000000000..b2dfe5d80 --- /dev/null +++ b/lang/pc/libpc/wri.c @@ -0,0 +1,26 @@ +#include + +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); +} diff --git a/lang/pc/libpc/wrl.c b/lang/pc/libpc/wrl.c new file mode 100644 index 000000000..6f8aa12f1 --- /dev/null +++ b/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 + +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); +} diff --git a/lang/pc/libpc/wrr.c b/lang/pc/libpc/wrr.c new file mode 100644 index 000000000..c64fee28f --- /dev/null +++ b/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 + +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); +} diff --git a/lang/pc/libpc/wrs.c b/lang/pc/libpc/wrs.c new file mode 100644 index 000000000..2770fc87d --- /dev/null +++ b/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 + +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); +} diff --git a/lang/pc/libpc/wrz.c b/lang/pc/libpc/wrz.c new file mode 100644 index 000000000..03f8cbfc3 --- /dev/null +++ b/lang/pc/libpc/wrz.c @@ -0,0 +1,18 @@ +#include + +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); +} -- 2.34.1