Adapted for new Pascal Compiler
authorceriel <none@none>
Wed, 3 May 1989 09:53:25 +0000 (09:53 +0000)
committerceriel <none@none>
Wed, 3 May 1989 09:53:25 +0000 (09:53 +0000)
19 files changed:
lang/pc/libpc/LIST
lang/pc/libpc/buff.c
lang/pc/libpc/catch.c
lang/pc/libpc/hlt.c
lang/pc/libpc/ini.c
lang/pc/libpc/mdi.c
lang/pc/libpc/nfa.c [new file with mode: 0644]
lang/pc/libpc/opn.c
lang/pc/libpc/pcreat.c
lang/pc/libpc/pentry.c
lang/pc/libpc/pexit.c
lang/pc/libpc/popen.c
lang/pc/libpc/rcka.c [new file with mode: 0644]
lang/pc/libpc/wrf.c
lang/pc/libpc/wri.c
lang/pc/libpc/wrl.c
lang/pc/libpc/wrr.c
lang/pc/libpc/wrs.c
lang/pc/libpc/wrz.c

index cccee86..297fe8b 100644 (file)
@@ -68,4 +68,6 @@ wrz.c
 wrs.c
 outcpt.c
 wf.c
+nfa.c
+rcka.c
 trp.e
index 80f54a6..471025c 100644 (file)
@@ -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);
 }
index 663be2e..e801afc 100644 (file)
 
 #include       <em_abs.h>
 #include       <em_path.h>
+#include       <pc_err.h>
 #include       <pc_file.h>
 
 #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;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;
+       if (ep->errmes) *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++) {
index 3cf7307..99cf68c 100644 (file)
 
 #include       <pc_file.h>
 
-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);
 }
index 489ea7d..a621163 100644 (file)
@@ -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;
        }
index 7f087d2..5117c0f 100644 (file)
@@ -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 (file)
index 0000000..d310bf9
--- /dev/null
@@ -0,0 +1,10 @@
+/* Author: Hans van Eck */
+
+#include       <pc_err.h>
+
+extern trp();
+
+_nfa(bool)
+{
+       if (! bool) _trp(EFUNASS);
+}
index 5496629..3cb933e 100644 (file)
@@ -21,8 +21,8 @@
 #include       <pc_file.h>
 #include       <pc_err.h>
 
-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;
index d389ca8..7e3935a 100644 (file)
@@ -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);
 }
index 59190fb..bac8aad 100644 (file)
 
 #include       <pc_file.h>
 
-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);
 }
index 3a472c2..2b00a28 100644 (file)
 
 #include       <pc_file.h>
 
-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);
 }
index 6533fca..7baac96 100644 (file)
@@ -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 (file)
index 0000000..e1b0849
--- /dev/null
@@ -0,0 +1,19 @@
+/* Author: Hans van Eck */
+
+#include       <em_abs.h>
+
+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);
+}
index d7c592b..c5b9b36 100644 (file)
@@ -18,6 +18,7 @@
 
 /* Author: J.W. Stevenson */
 
+#include       <pc_err.h>
 #include       <pc_file.h>
 
 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;
index 7d30660..43e2468 100644 (file)
@@ -16,6 +16,7 @@
  *
  */
 
+#include       <pc_err.h>
 #include       <pc_file.h>
 
 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) {
index e3b8a2e..ae6018b 100644 (file)
@@ -18,6 +18,7 @@
 
 /* Author: J.W. Stevenson */
 
+#include       <pc_err.h>
 #include       <pc_file.h>
 
 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) {
index 704f8f7..4f8cfc3 100644 (file)
@@ -18,6 +18,7 @@
 
 /* Author: J.W. Stevenson */
 
+#include       <pc_err.h>
 #include       <pc_file.h>
 
 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);
 }
 
index b59e073..a10951c 100644 (file)
@@ -18,6 +18,7 @@
 
 /* Author: J.W. Stevenson */
 
+#include       <pc_err.h>
 #include       <pc_file.h>
 
 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);
 }
 
index 3fd3413..b14b5f2 100644 (file)
@@ -16,6 +16,7 @@
  *
  */
 
+#include       <pc_err.h>
 #include       <pc_file.h>
 
 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);
 }