+/* Copyright (c) 1979 Regents of the University of California */
+#
+/*
+ * pi - Pascal interpreter code translator
+ *
+ * Charles Haley, Bill Joy UCB
+ * Version 1.2 January 1979
+ */
+
+#include "0.h"
+
+/*
+ * This program is described in detail in the "PI 1.0 Implementation Notes"
+ *
+ * This version of pi has been in use at Berkeley since May 1977
+ * and is very stable, except for the syntactic error recovery which
+ * has just been written. Please report any problems with the error
+ * recovery to the second author at the address given in the file
+ * READ_ME. The second author takes full responsibility for any bugs
+ * in the syntactic error recovery.
+ */
+
+char piusage[] "pi [ -blnpstuw ] [ -i file ... ] name.p";
+char pixusage[] "pix [ -blnpstuw ] [ -i file ... ] name.p [ arg ... ]";
+
+char *usageis piusage;
+char *obj "obj";
+/*
+ * Be careful changing errfile and howfile.
+ * There are the "magic" constants 9 and 15 immediately below.
+ */
+char *errfile "/usr/lib/pi1:2strings";
+char *howfile "/usr/lib/how_pi\0";
+
+int onintr();
+
+extern int ibuf[259];
+
+extern char *lastname;
+
+/*
+ * Main program for pi.
+ * Process options, then call yymain
+ * to do all the real work.
+ */
+main(argc, argv)
+ int argc;
+ char *argv[];
+{
+ extern char *PI1;
+ register char *cp;
+ register c;
+ int i;
+
+ cp = argv[0];
+ if (cp[0] == 'a')
+ errfile =+ 9, howfile =+ 9;
+#ifdef PC0
+ if (cp[1] == 'c')
+ PI1 = "/usr/lib/pc1";
+#endif
+ if (cp[0] == 'x')
+ errfile = "/usr/lib/xpi_strings";
+ if (argv[0][0] == '-' && argv[0][1] == 'o') {
+ obj = &argv[0][2];
+ usageis = pixusage;
+ howfile[15] = 'x';
+ ofil = 3;
+ } else {
+ ofil = creat(obj, 0755);
+ if (ofil < 0) {
+ perror(obj);
+ pexit(NOSTART);
+ }
+ }
+ argv++, argc--;
+ if (argc == 0) {
+ i = fork();
+ if (i == -1)
+ goto usage;
+ if (i == 0) {
+ execl("/bin/cat", "cat", howfile, 0);
+ goto usage;
+ }
+ while (wait(&i) != -1)
+ continue;
+ pexit(NOSTART);
+ }
+ opt('p') = opt('t') = opt('b') = 1;
+ while (argc > 0) {
+ cp = argv[0];
+ if (*cp++ != '-')
+ break;
+ while (c = *cp++) switch (c) {
+#ifdef DEBUG
+ case 'r':
+ togopt(c);
+ continue;
+ case 'C':
+ yycosts();
+ pexit(NOSTART);
+ case 'A':
+ testtrace++;
+ case 'F':
+ fulltrace++;
+ case 'E':
+ errtrace++;
+ opt('r')++;
+ continue;
+ case 'U':
+ yyunique = 0;
+ continue;
+ case 'h':
+ hp21mx++;
+ continue;
+#endif
+ case 'b':
+ opt('b') = 2;
+ continue;
+ case 'i':
+ pflist = argv + 1;
+ pflstc = 0;
+ while (argc > 1) {
+ if (dotted(argv[1], 'p'))
+ break;
+ pflstc++, argc--, argv++;
+ }
+ if (pflstc == 0)
+ goto usage;
+ continue;
+ case 'c':
+ case 'd':
+#ifdef PC0
+ case 'f':
+#endif
+ case 'l':
+ case 'n':
+ case 'p':
+ case 's':
+ case 't':
+ case 'u':
+ case 'w':
+ case 'y':
+ case 'z':
+ togopt(c);
+ continue;
+ default:
+usage:
+ Perror( "Usage", usageis);
+ pexit(NOSTART);
+ }
+ argc--, argv++;
+ }
+ if (argc != 1)
+ goto usage;
+ efil = open(errfile, 0);
+ if (efil < 0)
+ perror(errfile), pexit(NOSTART);
+ filename = argv[0];
+ if (!dotted(filename, 'p')) {
+ Perror(filename, "Name must end in '.p'");
+ pexit(NOSTART);
+ }
+ close(0);
+ if (fopen(filename, ibuf) < 0)
+ perror(filename), pexit(NOSTART);
+ if ((signal(2, 1) & 01) == 0)
+ signal(2, onintr);
+ if (opt('l')) {
+ opt('n')++;
+ yysetfile(filename);
+ opt('n')--;
+ } else
+ lastname = filename;
+ yymain();
+ /* No return */
+}
+
+/*
+ * Buffer for putchar
+ */
+char pcbuf[128];
+char *pcbp pcbuf;
+
+/*
+ * Line buffered putchar for pi.
+ */
+putchar(c)
+ char c;
+{
+
+ *pcbp++ = c;
+ if (c == '\n' || pcbp == &pcbuf[sizeof pcbuf-1]) {
+ write(1, &pcbuf, pcbp-pcbuf);
+ pcbp = pcbuf;
+ }
+}
+
+char ugh[] "Fatal error in pi\n";
+/*
+ * Exit from the Pascal system.
+ * We throw in an ungraceful termination
+ * message if c > 1 indicating a severe
+ * error such as running out of memory
+ * or an internal inconsistency.
+ */
+pexit(c)
+ int c;
+{
+
+ if (opt('l') && c != DIED && c != NOSTART)
+ while (getline() != -1)
+ continue;
+ yyflush();
+ switch (c) {
+ case DIED:
+ write(2, ugh, sizeof ugh);
+ case NOSTART:
+ case ERRS:
+ if (ofil > 0)
+ unlink(obj);
+ send(RKILL);
+ break;
+ case AOK:
+ break;
+ }
+ exit(c);
+}
+
+onintr()
+{
+
+ signal(2, 1);
+ pexit(NOSTART);
+}
+
+/*
+ * Get an error message from the error message file
+ */
+geterr(seekpt, buf)
+ int seekpt;
+ char *buf;
+{
+
+ if (seek(efil, seekpt, 0) || read(efil, buf, 256) <= 0)
+ perror(errfile), pexit(DIED);
+}
+
+header()
+{
+ extern char version[];
+ static char anyheaders;
+
+ gettime();
+ if (anyheaders && opt('n'))
+ putchar('\f');
+ anyheaders++;
+ printf("Berkeley Pascal PI -- Version 1.2 (%s)\n\n%s %s\n\n", version, myctime(tvec), filename);
+}