From 19638876a1a822bf0799295f8499a0098964b85a Mon Sep 17 00:00:00 2001 From: ceriel Date: Wed, 3 May 1989 09:53:25 +0000 Subject: [PATCH] Adapted for new Pascal Compiler --- lang/pc/libpc/LIST | 2 + lang/pc/libpc/buff.c | 2 +- lang/pc/libpc/catch.c | 114 ++++++++++++++++++++++++++++++----------- lang/pc/libpc/hlt.c | 14 ++--- lang/pc/libpc/ini.c | 19 ++++--- lang/pc/libpc/mdi.c | 10 ++++ lang/pc/libpc/nfa.c | 10 ++++ lang/pc/libpc/opn.c | 14 ++--- lang/pc/libpc/pcreat.c | 4 +- lang/pc/libpc/pentry.c | 12 ++--- lang/pc/libpc/pexit.c | 12 ++--- lang/pc/libpc/popen.c | 2 +- lang/pc/libpc/rcka.c | 19 +++++++ lang/pc/libpc/wrf.c | 2 + lang/pc/libpc/wri.c | 2 + lang/pc/libpc/wrl.c | 2 + lang/pc/libpc/wrr.c | 17 ++++-- lang/pc/libpc/wrs.c | 6 +++ lang/pc/libpc/wrz.c | 2 + 19 files changed, 191 insertions(+), 74 deletions(-) create mode 100644 lang/pc/libpc/nfa.c create mode 100644 lang/pc/libpc/rcka.c diff --git a/lang/pc/libpc/LIST b/lang/pc/libpc/LIST index cccee86ad..297fe8bce 100644 --- a/lang/pc/libpc/LIST +++ b/lang/pc/libpc/LIST @@ -68,4 +68,6 @@ wrz.c wrs.c outcpt.c wf.c +nfa.c +rcka.c trp.e diff --git a/lang/pc/libpc/buff.c b/lang/pc/libpc/buff.c index 80f54a6e5..471025c48 100644 --- a/lang/pc/libpc/buff.c +++ b/lang/pc/libpc/buff.c @@ -31,5 +31,5 @@ buff(f) struct file *f; { return; _flush(f); sz = f->size; - f->count = f->buflen = (sz>512 ? sz : 512-512%sz); + f->count = f->buflen = (sz>PC_BUFLEN ? sz : PC_BUFLEN-PC_BUFLEN%sz); } diff --git a/lang/pc/libpc/catch.c b/lang/pc/libpc/catch.c index 663be2ef7..e801afca9 100644 --- a/lang/pc/libpc/catch.c +++ b/lang/pc/libpc/catch.c @@ -18,15 +18,71 @@ #include #include +#include #include #define MESLEN 30 #define PATHLEN 100 /* to make it easier to patch ... */ -char emdir[64] = EM_DIR; extern struct file *_curfil; +static struct errm { + int errno; + char *errmes; +} errors[] = { + { EARRAY, "array bound error"}, + { ERANGE, "range bound error"}, + { ESET, "set bound error"}, + { EIOVFL, "integer overflow"}, + { EFOVFL, "real overflow"}, + { EFUNFL, "real underflow"}, + { EIDIVZ, "divide by 0"}, + { EFDIVZ, "divide by 0.0"}, + { EIUND, "undefined integer"}, + { EFUND, "undefined real"}, + { ECONV, "conversion error"}, + + { ESTACK, "stack overflow"}, + { EHEAP, "heap overflow"}, + { EILLINS, "illegal instruction"}, + { EODDZ, "illegal size argument"}, + { ECASE, "case error"}, + { EMEMFLT, "addressing non existent memory"}, + { EBADPTR, "bad pointer used"}, + { EBADPC, "program counter out of range"}, + { EBADLAE, "bad argument of lae"}, + { EBADMON, "bad monitor call"}, + { EBADLIN, "argument if LIN too high"}, + { EBADGTO, "GTO descriptor error"}, + + { EARGC, "more args expected" }, + { EEXP, "error in exp" }, + { ELOG, "error in ln" }, + { ESQT, "error in sqrt" }, + { EASS, "assertion failed" }, + { EPACK, "array bound error in pack" }, + { EUNPACK, "array bound error in unpack" }, + { EMOD, "only positive j in 'i mod j'" }, + { EBADF, "file not yet open" }, + { EFREE, "dispose error" }, + { EFUNASS, "function not assigned" }, + { EWIDTH, "illegal field width" }, + + { EWRITEF, "not writable" }, + { EREADF, "not readable" }, + { EEOF, "end of file" }, + { EFTRUNC, "truncated" }, + { ERESET, "reset error" }, + { EREWR, "rewrite error" }, + { ECLOSE, "close error" }, + { EREAD, "read error" }, + { EWRITE, "write error" }, + { EDIGIT, "digit expected" }, + { EASCII, "non-ASCII char read" }, + { -1, 0} +}; + extern int _pargc; extern char **_pargv; extern char **_penvp; @@ -38,24 +94,22 @@ 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 filename[PATHLEN]; - char c; + register struct errm *ep = &errors[0]; + char *p,*q,*s,**qq; + char buf[20]; + unsigned i; + int j = erno; + char *pp[10]; + char mes[MESLEN]; qq = pp; if (p = FILN) *qq++ = p; else *qq++ = _pargv[0]; + + while (ep->errno != erno && ep->errmes != 0) ep++; p = &("xxxxx: "[5]); if (i = LINO) { *qq++ = ", "; @@ -70,25 +124,23 @@ _catch(erno) unsigned erno; { *qq++ = _curfil->fname; *qq++ = ": "; } - if ( (i=strtobuf(emdir,filename,PATHLEN)) >= PATHLEN-1 || - (filename[i]='/' , - strtobuf(RTERR_PATH,filename+i+1,PATHLEN-i-1) >= PATHLEN-i-1 - ) ) - goto error; - if ((fd=open(filename,0))<0) - goto error; - /* skip to correct message */ - for(i=0;ierrmes) *qq++ = ep->errmes; + else { + q = "error number xxxxxxxxxxxxx"; + p = &q[13]; + s = buf; + if (j < 0) { + j = -j; + *p++ = '-'; + } + do + *s++ = j % 10 + '0'; + while (j /= 10); + while (s > buf) *p++ = *--s; + *p = 0; + *qq++ = q; + } + *qq++ = "\n"; *qq = 0; qq = pp; while (q = *qq++) { diff --git a/lang/pc/libpc/hlt.c b/lang/pc/libpc/hlt.c index 3cf730729..99cf68cd3 100644 --- a/lang/pc/libpc/hlt.c +++ b/lang/pc/libpc/hlt.c @@ -20,16 +20,16 @@ #include -extern char *_hbase; -extern int *_extfl; -extern _cls(); -extern exit(); +extern struct file **_extfl; +extern int _extflc; +extern _cls(); +extern exit(); _hlt(ecode) int ecode; { int i; - for (i = 1; i <= _extfl[0]; i++) - if (_extfl[i] != -1) - _cls(EXTFL(i)); + for (i = 0; i < _extflc; i++) + if (_extfl[i] != (struct file *) 0) + _cls(_extfl[i]); exit(ecode); } diff --git a/lang/pc/libpc/ini.c b/lang/pc/libpc/ini.c index 489ea7d49..a6211634c 100644 --- a/lang/pc/libpc/ini.c +++ b/lang/pc/libpc/ini.c @@ -27,15 +27,15 @@ extern _catch(); extern int gtty(); #endif -char *_hbase; -int *_extfl; +struct file **_extfl; +int _extflc; /* number of external files */ 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; { +_ini(args,c,p,mainlb) char *args,*mainlb; int c; struct file **p; { struct file *f; char buf[128]; @@ -44,20 +44,19 @@ _ini(args,hb,p,mainlb) char *args,*hb,*mainlb; int *p; { _penvp= *(char ***)args; _sig(_catch); _extfl = p; - _hbase = hb; + _extflc = c; + if( !c ) return; _m_lb = mainlb; - if (_extfl[1] != -1) { - f = EXTFL(1); + if ( (f = _extfl[0]) != (struct file *) 0) { f->ptr = f->bufadr; f->flags = MAGIC|TXTBIT; f->fname = "INPUT"; f->ufd = 0; f->size = 1; f->count = 0; - f->buflen = 512; + f->buflen = PC_BUFLEN; } - if (_extfl[2] != -1) { - f = EXTFL(2); + if ( (f = _extfl[1]) != (struct file *) 0) { f->ptr = f->bufadr; f->flags = MAGIC|TXTBIT|WRBIT|EOFBIT|ELNBIT; f->fname = "OUTPUT"; @@ -66,7 +65,7 @@ _ini(args,hb,p,mainlb) char *args,*hb,*mainlb; int *p; { #ifdef CPM f->count = 1; #else - f->count = (gtty(1,buf) >= 0 ? 1 : 512); + f->count = (gtty(1,buf) >= 0 ? 1 : PC_BUFLEN); #endif f->buflen = f->count; } diff --git a/lang/pc/libpc/mdi.c b/lang/pc/libpc/mdi.c index 7f087d27e..5117c0fd4 100644 --- a/lang/pc/libpc/mdi.c +++ b/lang/pc/libpc/mdi.c @@ -24,6 +24,16 @@ extern _trp(); int _mdi(j,i) int j,i; { + if (j <= 0) + _trp(EMOD); + i = i % j; + if (i < 0) + i += j; + return(i); +} + +long _mdil(j,i) long j,i; { + if (j <= 0) _trp(EMOD); i = i % j; diff --git a/lang/pc/libpc/nfa.c b/lang/pc/libpc/nfa.c new file mode 100644 index 000000000..d310bf903 --- /dev/null +++ b/lang/pc/libpc/nfa.c @@ -0,0 +1,10 @@ +/* Author: Hans van Eck */ + +#include + +extern trp(); + +_nfa(bool) +{ + if (! bool) _trp(EFUNASS); +} diff --git a/lang/pc/libpc/opn.c b/lang/pc/libpc/opn.c index 549662963..3cb933ed3 100644 --- a/lang/pc/libpc/opn.c +++ b/lang/pc/libpc/opn.c @@ -21,8 +21,8 @@ #include #include -extern char *_hbase; -extern int *_extfl; +extern struct file **_extfl; +extern int _extflc; extern struct file *_curfil; extern int _pargc; extern char **_pargv; @@ -69,10 +69,10 @@ static int initfl(descr,sz,f) int descr; int sz; struct file *f; { sz++; descr |= TXTBIT; } - for (i=1; i<=_extfl[0]; i++) - if (f == EXTFL(i)) + for (i=0; i<_extflc; i++) + if (f == _extfl[i]) break; - if (i > _extfl[0]) { /* local file */ + if (i >= _extflc) { /* local file */ f->fname = "LOCAL"; if ((descr & WRBIT) == 0 && (f->flags & 0377) == MAGIC) { _xcls(f); @@ -83,7 +83,7 @@ static int initfl(descr,sz,f) int descr; int sz; struct file *f; { f->ufd = tmpfil(); } } else { /* external file */ - if ((i -= 2) <= 0) + if (--i <= 0) return(0); if (i >= _pargc) _trp(EARGC); @@ -97,7 +97,7 @@ static int initfl(descr,sz,f) int descr; int sz; struct file *f; { _trp(EREWR); } } - f->buflen = (sz>512 ? sz : 512-512%sz); + f->buflen = (sz>PC_BUFLEN ? sz : PC_BUFLEN-PC_BUFLEN%sz); f->size = sz; f->ptr = f->bufadr; f->flags = descr; diff --git a/lang/pc/libpc/pcreat.c b/lang/pc/libpc/pcreat.c index d389ca870..7e3935a7f 100644 --- a/lang/pc/libpc/pcreat.c +++ b/lang/pc/libpc/pcreat.c @@ -34,8 +34,8 @@ pcreat(f,s) struct file *f; char *s; { f->flags = WRBIT|EOFBIT|ELNBIT|TXTBIT|MAGIC; f->fname = s; f->size = 1; - f->count = 512; - f->buflen = 512; + f->count = PC_BUFLEN; + f->buflen = PC_BUFLEN; if ((f->ufd = creat(s,0644)) < 0) _trp(EREWR); } diff --git a/lang/pc/libpc/pentry.c b/lang/pc/libpc/pentry.c index 59190fbba..bac8aad0c 100644 --- a/lang/pc/libpc/pentry.c +++ b/lang/pc/libpc/pentry.c @@ -20,16 +20,16 @@ #include -extern int *_extfl; -extern char *_hbase; -extern _wrs(); -extern _wln(); +extern struct file **_extfl; +extern _wrs(); +extern _wrz(); +extern _wln(); procentry(name) char *name; { struct file *f; - f = EXTFL(2); + f = _extfl[1]; _wrs(5,"call ",f); - _wrs(8,name,f); + _wrz(name,f); _wln(f); } diff --git a/lang/pc/libpc/pexit.c b/lang/pc/libpc/pexit.c index 3a472c2d1..2b00a28ac 100644 --- a/lang/pc/libpc/pexit.c +++ b/lang/pc/libpc/pexit.c @@ -18,16 +18,16 @@ #include -extern int *_extfl; -extern char *_hbase; -extern _wrs(); -extern _wln(); +extern struct file **_extfl; +extern _wrs(); +extern _wrz(); +extern _wln(); procexit(name) char *name; { struct file *f; - f = EXTFL(2); + f = _extfl[1]; _wrs(5,"exit ",f); - _wrs(8,name,f); + _wrz(name,f); _wln(f); } diff --git a/lang/pc/libpc/popen.c b/lang/pc/libpc/popen.c index 6533fcaaf..7baac96ce 100644 --- a/lang/pc/libpc/popen.c +++ b/lang/pc/libpc/popen.c @@ -35,7 +35,7 @@ popen(f,s) struct file *f; char *s; { f->fname = s; f->size = 1; f->count = 0; - f->buflen = 512; + f->buflen = PC_BUFLEN; if ((f->ufd = open(s,0)) < 0) _trp(ERESET); } diff --git a/lang/pc/libpc/rcka.c b/lang/pc/libpc/rcka.c new file mode 100644 index 000000000..e1b084915 --- /dev/null +++ b/lang/pc/libpc/rcka.c @@ -0,0 +1,19 @@ +/* Author: Hans van Eck */ + +#include + +extern trp(); + +struct array_descr { + int lbound; + unsigned n_elts_min_one; + unsigned size; /* doesn't really matter */ + }; + +_rcka(descr, index) +struct array_descr *descr; +{ + if( index < descr->lbound || + index > (int) descr->n_elts_min_one + descr->lbound ) + _trp(ERANGE); +} diff --git a/lang/pc/libpc/wrf.c b/lang/pc/libpc/wrf.c index d7c592b49..c5b9b3651 100644 --- a/lang/pc/libpc/wrf.c +++ b/lang/pc/libpc/wrf.c @@ -18,6 +18,7 @@ /* Author: J.W. Stevenson */ +#include #include extern _wstrin(); @@ -33,6 +34,7 @@ extern char *_fcvt(); _wrf(n,w,r,f) int n,w; double r; struct file *f; { char *p,*b; int s,d; char buf[BUFSIZE]; + if ( n < 0 || w < 0) _trp(EWIDTH); p = buf; if (n > PREC_DIG) n = PREC_DIG; diff --git a/lang/pc/libpc/wri.c b/lang/pc/libpc/wri.c index 7d3066091..43e2468a9 100644 --- a/lang/pc/libpc/wri.c +++ b/lang/pc/libpc/wri.c @@ -16,6 +16,7 @@ * */ +#include #include extern _wstrin(); @@ -43,6 +44,7 @@ Something wrong here! _wsi(w,i,f) int w,i; struct file *f; { char *p; int j; char buf[SZ]; + if (w < 0) _trp(EWIDTH); p = &buf[SZ]; if ((j=i) < 0) { if (i == MININT) { diff --git a/lang/pc/libpc/wrl.c b/lang/pc/libpc/wrl.c index e3b8a2ed6..ae6018b8f 100644 --- a/lang/pc/libpc/wrl.c +++ b/lang/pc/libpc/wrl.c @@ -18,6 +18,7 @@ /* Author: J.W. Stevenson */ +#include #include extern _wstrin(); @@ -27,6 +28,7 @@ extern _wstrin(); _wsl(w,l,f) int w; long l; struct file *f; { char *p,c; long j; char buf[11]; + if (w < 0) _trp(EWIDTH); p = &buf[11]; if ((j=l) < 0) { if (l == MAXNEGLONG) { diff --git a/lang/pc/libpc/wrr.c b/lang/pc/libpc/wrr.c index 704f8f7c0..4f8cfc3ca 100644 --- a/lang/pc/libpc/wrr.c +++ b/lang/pc/libpc/wrr.c @@ -18,6 +18,7 @@ /* Author: J.W. Stevenson */ +#include #include extern _wstrin(); @@ -26,8 +27,9 @@ 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]; + char *p,*b; int s,d,i; char buf[PREC_DIG+7]; + if (w < 0) _trp(EWIDTH); p = buf; if ((i = w-6) < 2) i = 2; @@ -46,8 +48,17 @@ _wsr(w,r,f) int w; double r; struct file *f; { *p++ = '-'; } else *p++ = '+'; - *p++ = '0' + (d/10); - *p++ = '0' + (d%10); + + if (d >= 1000) { + *p++ = '*'; + *p++ = '*'; + *p++ = '*'; + } + else { + *p++ = '0' + d/100; + *p++ = '0' + (d/10) % 10; + *p++ = '0' + d%10; + } _wstrin(w,p-buf,buf,f); } diff --git a/lang/pc/libpc/wrs.c b/lang/pc/libpc/wrs.c index b59e07395..a10951c61 100644 --- a/lang/pc/libpc/wrs.c +++ b/lang/pc/libpc/wrs.c @@ -18,6 +18,7 @@ /* Author: J.W. Stevenson */ +#include #include extern _wf(); @@ -37,16 +38,21 @@ _wstrin(width,len,buf,f) int width,len; char *buf; struct file *f; { } _wsc(w,c,f) int w; char c; struct file *f; { + + if (w < 0) _trp(EWIDTH); _wss(w,1,&c,f); } _wss(w,len,s,f) int w,len; char *s; struct file *f; { + + if (w < 0 || len < 0) _trp(EWIDTH); if (w < len) len = w; _wstrin(w,len,s,f); } _wrs(len,s,f) int len; char *s; struct file *f; { + if (len < 0) _trp(EWIDTH); _wss(len,len,s,f); } diff --git a/lang/pc/libpc/wrz.c b/lang/pc/libpc/wrz.c index 3fd341382..b14b5f2d4 100644 --- a/lang/pc/libpc/wrz.c +++ b/lang/pc/libpc/wrz.c @@ -16,6 +16,7 @@ * */ +#include #include extern _wss(); @@ -24,6 +25,7 @@ extern _wrs(); _wsz(w,s,f) int w; char *s; struct file *f; { char *p; + if (w < 0) _trp(EWIDTH); for (p=s; *p; p++); _wss(w,p-s,s,f); } -- 2.34.1