1: /* static	char	sccsid[] = "%W%";	/* SCCS id keyword */
   2: /* Copyright (c) 1979 Regents of the University of California */
   3: #
   4: /*
   5:  * pi - Pascal interpreter code translator
   6:  *
   7:  * Steven Schultz, GTE
   8:  * Version 1.2.1 October 1996
   9:  *
  10:  * Charles Haley, Bill Joy UCB
  11:  * Version 1.2 November 1978
  12:  */
  13: 
  14: #include "whoami"
  15: #include "0.h"
  16: #include "yy.h"
  17: 
  18: 
  19: /*
  20:  * This version of pi has been in use at Berkeley since May 1977
  21:  * and is very stable, except for the syntactic error recovery which
  22:  * has just been written.  Please report any problems with the error
  23:  * recovery to the second author at the address given in the file
  24:  * READ_ME.  The second author takes full responsibility for any bugs
  25:  * in the syntactic error recovery.
  26:  */
  27: 
  28: char    piusage[]   = "pi [ -blnpstuw ] [ -i file ... ] name.p";
  29: char    pixusage[]  = "pix [ -blnpstuw ] [ -i file ... ] name.p [ arg ... ]";
  30: 
  31: char    *usageis    = piusage;
  32: char    *obj        = "obj";
  33: 
  34: /*
  35:  * Be careful changing errfile and howfile.
  36:  * There are the "magic" constants err_pathlen and how_pathlen
  37:  * immediately below.
  38:  */
  39: char    *err_file   = "/usr/share/pascal/pi1.2strings";
  40: int err_pathlen = 18;           /* "/usr/share/pascal/" */
  41: 
  42: char    *how_file   = "/usr/share/pascal/how_pi\0"; /* room for 'x' in pix */
  43: int how_pathlen = 18;           /* "/usr/share/pascal/" */
  44: 
  45: int onintr();
  46: 
  47: extern  char *lastname;
  48: 
  49: FILE    *ibuf;
  50: 
  51: /*
  52:  * these are made real variables
  53:  * so they can be changed
  54:  * if you are compiling on a smaller machine
  55:  */
  56: double  MAXINT  =  2147483647.;
  57: double  MININT  = -2147483648.;
  58: 
  59: /*
  60:  * Main program for pi.
  61:  * Process options, then call yymain
  62:  * to do all the real work.
  63:  */
  64: main(argc, argv)
  65:     int argc;
  66:     char *argv[];
  67: {
  68:     register char *cp;
  69:     register c;
  70:     int i;
  71: 
  72:     if (argv[0][0] == 'a')
  73:         err_file += err_pathlen, how_file += how_pathlen;
  74:     if (argv[0][0] == '-' && argv[0][1] == 'o') {
  75:         obj = &argv[0][2];
  76:         usageis = pixusage;
  77:         how_file[strlen(how_file)] = 'x';
  78:         ofil = 3;
  79:     } else {
  80:         ofil = creat(obj, 0755);
  81:         if (ofil < 0) {
  82:             perror(obj);
  83:             pexit(NOSTART);
  84:         }
  85:     }
  86:     argv++, argc--;
  87:     if (argc == 0) {
  88:         i = fork();
  89:         if (i == -1)
  90:             goto usage;
  91:         if (i == 0) {
  92:             execl("/bin/cat", "cat", how_file, 0);
  93:             goto usage;
  94:         }
  95:         while (wait(&i) != -1)
  96:             continue;
  97:         pexit(NOSTART);
  98:     }
  99:     opt('p') = opt('t') = opt('b') = 1;
 100:     while (argc > 0) {
 101:         cp = argv[0];
 102:         if (*cp++ != '-')
 103:             break;
 104:         while (c = *cp++) switch (c) {
 105: #ifdef DEBUG
 106:             case 'c':
 107:             case 'r':
 108:             case 'y':
 109:                 togopt(c);
 110:                 continue;
 111:             case 'C':
 112:                 yycosts();
 113:                 pexit(NOSTART);
 114:             case 'A':
 115:                 testtrace++;
 116:             case 'F':
 117:                 fulltrace++;
 118:             case 'E':
 119:                 errtrace++;
 120:                 opt('r')++;
 121:                 continue;
 122:             case 'U':
 123:                 yyunique = 0;
 124:                 continue;
 125: #endif
 126:             case 'b':
 127:                 opt('b') = 2;
 128:                 continue;
 129:             case 'i':
 130:                 pflist = argv + 1;
 131:                 pflstc = 0;
 132:                 while (argc > 1) {
 133:                     if (dotted(argv[1], 'p'))
 134:                         break;
 135:                     pflstc++, argc--, argv++;
 136:                 }
 137:                 if (pflstc == 0)
 138:                     goto usage;
 139:                 continue;
 140:             case 'l':
 141:             case 'n':
 142:             case 'p':
 143:             case 's':
 144:             case 't':
 145:             case 'u':
 146:             case 'w':
 147:                 togopt(c);
 148:                 continue;
 149:             case 'z':
 150:                 monflg++;
 151:                 continue;
 152:             default:
 153: usage:
 154:                 Perror( "Usage", usageis);
 155:                 pexit(NOSTART);
 156:         }
 157:         argc--, argv++;
 158:     }
 159:     if (argc != 1)
 160:         goto usage;
 161:     efil = open ( err_file, 0 );
 162:     if ( efil < 0 )
 163:         perror(err_file), pexit(NOSTART);
 164:     filename = argv[0];
 165:     if (!dotted(filename, 'p')) {
 166:         Perror(filename, "Name must end in '.p'");
 167:         pexit(NOSTART);
 168:     }
 169:     close(0);
 170:     if ( ( ibuf = fopen ( filename , "r" ) ) == NULL )
 171:         perror(filename), pexit(NOSTART);
 172:     ibp = ibuf;
 173:     if ((signal(2, 1) & 01) == 0)
 174:         signal(2, onintr);
 175:     if (opt('l')) {
 176:         opt('n')++;
 177:         yysetfile(filename);
 178:         opt('n')--;
 179:     } else
 180:         lastname = filename;
 181:     yymain();
 182:     /* No return */
 183: }
 184: 
 185: pchr(c)
 186:     char c;
 187: {
 188: 
 189:     putc ( c , stdout );
 190: }
 191: 
 192: char    ugh[]   = "Fatal error in pi\n";
 193: /*
 194:  * Exit from the Pascal system.
 195:  * We throw in an ungraceful termination
 196:  * message if c > 1 indicating a severe
 197:  * error such as running out of memory
 198:  * or an internal inconsistency.
 199:  */
 200: pexit(c)
 201:     int c;
 202: {
 203: 
 204:     if (opt('l') && c != DIED && c != NOSTART)
 205:         while (getline() != -1)
 206:             continue;
 207:     yyflush();
 208:     switch (c) {
 209:         case DIED:
 210:             write(2, ugh, sizeof ugh);
 211:         case NOSTART:
 212:         case ERRS:
 213:             if (ofil > 0)
 214:                 unlink(obj);
 215:             break;
 216:         case AOK:
 217:             pflush();
 218:             break;
 219:     }
 220:     exit(c);
 221: }
 222: 
 223: onintr()
 224: {
 225: 
 226:     signal(2, 1);
 227:     pexit(NOSTART);
 228: }
 229: 
 230: /*
 231:  * Get an error message from the error message file
 232:  */
 233: geterr(seekpt, buf)
 234:     int seekpt;
 235:     char *buf;
 236: {
 237: 
 238:     lseek(efil, (long) seekpt, 0);
 239:     if (read(efil, buf, 256) <= 0)
 240:         perror(err_file), pexit(DIED);
 241: }
 242: 
 243: header()
 244: {
 245:     extern char version[];
 246:     static char anyheaders;
 247: 
 248:     gettime();
 249:     if (anyheaders && opt('n'))
 250:         putc( '\f' , stdout );
 251:     anyheaders++;
 252:     printf("Berkeley Pascal PI -- Version 1.2 (%s)\n\n%s  %s\n\n",
 253:         version, myctime(&tvec), filename);
 254: }

Defined functions

geterr defined in line 233; used 2 times
header defined in line 243; used 1 times
main defined in line 64; never used
onintr defined in line 223; used 2 times

Defined variables

MAXINT defined in line 56; never used
MININT defined in line 57; never used
err_file defined in line 39; used 4 times
err_pathlen defined in line 40; used 1 times
  • in line 73
how_file defined in line 42; used 4 times
how_pathlen defined in line 43; used 1 times
  • in line 73
obj defined in line 32; used 5 times
piusage defined in line 28; used 1 times
  • in line 31
pixusage defined in line 29; used 1 times
  • in line 76
ugh defined in line 192; used 2 times
  • in line 210(2)
usageis defined in line 31; used 2 times
Last modified: 1996-10-24
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 3227
Valid CSS Valid XHTML 1.0 Strict