2.11BSD#431 - /usr/src/ucb/pascal/px/int.c

   1: #
   2: /*
   3:  * px - interpreter for Berkeley Pascal
   4:  * Version 1.0 August 1977
   5:  *
   6:  * Bill Joy, Charles Haley, Ken Thompson
   7:  *
   8:  * 1996/3/22 - make Perror look like that in ../pi/subr.c
   9:  */
  10: 
  11: #include "0x.h"
  12: #include "opcode.h"
  13: #include "E.h"
  14: #include <sys/types.h>
  15: #include <sys/uio.h>
  16: 
  17: int display[20] = { display };
  18: 
  19: int onintr();
  20: 
  21: main(ac, av)
  22:     int ac;
  23:     char *av[];
  24: {
  25:     register char *cp;
  26:     register int bytes, rmdr;
  27:     int size, *bp, i, of;
  28: 
  29:     i = signal(2, 1);
  30:     argc = ac - 1, argv = av + 1;
  31:     randim = 1./randm;
  32:     setmem();
  33:     if (av[0][0] == '-' && av[0][1] == 'o') {
  34:         av[0] += 2;
  35:         file = av[0];
  36:         argv--, argc++;
  37:         discard++;
  38:     } else if (argc == 0)
  39:         file = *--argv = "obj", argc++;
  40:     else if (argv[0][0] == '-' && argv[0][1] == 0) {
  41:         argv[0][0] = 0;
  42:         file = 0;
  43:         argv[0] = argv[-1];
  44:     } else
  45:         file = *argv;
  46:     if (file) {
  47:         cp = file;
  48:         of = open(cp, 0);
  49:         if (discard)
  50:             unlink(cp);
  51:     } else
  52:         of = 3;
  53:     if ((i & 01) == 0)
  54:         signal(2, onintr);
  55:     if (of < 0) {
  56: oops:
  57:         perror(cp);
  58:         exit(1);
  59:     }
  60:     if (file) {
  61: #include <sys/types.h>
  62: #include <sys/stat.h>
  63:         struct stat stb;
  64:         fstat(of, &stb);
  65:         size = stb.st_size;
  66:     } else
  67:         if (read(of, &size, 2) != 2) {
  68:             ferror("Improper argument");
  69:             exit(1);
  70:         }
  71:     if (size == 0) {
  72:         ferror("File is empty");
  73:         exit(1);
  74:     }
  75:     if (file) {
  76:         read(of, &i, 2);
  77:         if (i == 0407) {
  78:             size -= 1024;
  79:             lseek(of, (long)1024, 0);
  80:         } else
  81:             lseek(of, (long)0, 0);
  82:     }
  83:     bp = cp = alloc(size);
  84:     if (cp == -1) {
  85:         ferror("Too large");
  86:         exit(1);
  87:     }
  88:     rmdr = size;
  89:     while (rmdr != 0) {
  90:         i = (rmdr > 0 && rmdr < 512) ? rmdr : 512;
  91:         bytes = read(of, cp, i);
  92:         if (bytes <= 0) {
  93:             ferror("Unexpected end-of-file");
  94:             exit(1);
  95:         }
  96:         rmdr -= bytes;
  97:         cp += bytes;
  98:     }
  99:     if (read(of, cp, 1) == 1) {
 100:         ferror("Expected end-of-file");
 101:         exit(1);
 102:     }
 103:     close(of);
 104:     if (file == 0)
 105:         wait(&i);
 106:     if (*bp++ != 0404) {
 107:         ferror("Not a Pascal object file");
 108:         exit(1);
 109:     }
 110:     if (discard && bp[(bp[0] == O_PXPBUF ? bp[5] + 8 : bp[1]) / 2 + 1] != O_NODUMP)
 111:         write(2, "Execution begins...\n", 20);
 112:     interpret(bp, size);
 113: }
 114: 
 115: /*
 116:  * Can't use 'fprintf(stderr...)' because that would require stdio.h and
 117:  * that can't be used because the 'ferror' macro would conflict with the routine
 118:  * of the same name.   But we don't want to use sys_errlist[] because that's
 119:  * ~2kb of D space.
 120: */
 121: 
 122: Perror(file, mesg)
 123:     char *file, *mesg;
 124: {
 125:     struct  iovec   iov[3];
 126: 
 127:     iov[0].iov_base = file;
 128:     iov[0].iov_len = strlen(file);
 129:     iov[1].iov_base = ": ";
 130:     iov[1].iov_len = 2;
 131:     iov[2].iov_base = mesg;
 132:     iov[2].iov_len = strlen(mesg);
 133:     writev(2, iov, 3);
 134: }
 135: 
 136: /*
 137:  * Initialization of random number "constants"
 138:  */
 139: long    seed    = 7774755.;
 140: double  randa   = 62605.;
 141: double  randc   = 113218009.;
 142: double  randm   = 536870912.;
 143: 
 144: /*
 145:  * Routine to put a string on the current
 146:  * pascal output given a pointer to the string
 147:  */
 148: puts(str)
 149:     char *str;
 150: {
 151:     register char *cp;
 152: 
 153:     cp = str;
 154:     while (*cp)
 155:         pputch(*cp++);
 156: }
 157: 
 158: ferror(cp)
 159:     char *cp;
 160: {
 161: 
 162:     Perror(file, cp);
 163: }
 164: 
 165: onintr()
 166: {
 167:     extern int draino[];
 168: 
 169:     if (dp == 0)
 170:         exit(1);
 171:     draino[0] = 512;
 172:     draino[1] = &draino[2];
 173:     error(EINTR);
 174: }

Defined functions

Defined variables