home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume10 / ptoc / part03 / ptc.c.1
Encoding:
Text File  |  1987-07-26  |  33.0 KB  |  1,501 lines
  1. /***************************************************************************/
  2. /***************************************************************************/
  3. /**                                      **/
  4. /**    Copyright (C) 1987 by Per Bergsten, Gothenburg, Sweden          **/
  5. /**                                      **/
  6. /**    No part of this program, or parts derived from this program,      **/
  7. /**    may be sold, hired or otherwise exploited without the author's      **/
  8. /**    written consent.                          **/
  9. /**                                      **/
  10. /**    The program may be freely redistributed provided that:          **/
  11. /**                                      **/
  12. /**        1) the original program text, including this notice,      **/
  13. /**           is reproduced unaltered,                  **/
  14. /**        2) no charge (other than a nominal media cost) is      **/
  15. /**           demanded for the copy.                  **/
  16. /**                                      **/
  17. /**    The program may be included in a package only on the condition      **/
  18. /**    that the package as a whole is distributed at media cost.      **/
  19. /**                                      **/
  20. /***************************************************************************/
  21. /***************************************************************************/
  22. /**                                      **/
  23. /**    The program is a Pascal-to-C translator.              **/
  24. /**    It accepts a correct Pascal program and creates a C program      **/
  25. /**    with the same behaviour. It is not a complete compiler in the      **/
  26. /**    sense that it does NOT do complete typechecking or error-      **/
  27. /**    reporting. Only a minimal typecheck is done so that the meaning      **/
  28. /**    of each construct can be determined. Therefore, an incorrect      **/
  29. /**    Pascal program can easily cause the translator to malfunction.      **/
  30. /**                                      **/
  31. /***************************************************************************/
  32. /***************************************************************************/
  33. /**                                      **/
  34. /**    Things which are known to be dependent on the underlying cha-      **/
  35. /**    racterset are marked with a comment containing the word    CHAR.      **/
  36. /**    Things that are known to be dependent on the host operating      **/
  37. /**    system are marked with a comment containing the word OS.      **/
  38. /**    Things known to be dependent on the cpu and/or the target C-      **/
  39. /**    implementation are marked with the word CPU.              **/
  40. /**    Things dependent on the target C-library are marked with LIB.      **/
  41. /**                                      **/
  42. /**    The code generated by the translator assumes that there    is a      **/
  43. /**    C-implementation with at least a reasonable <stdio> library      **/
  44. /**    since all input/output is implemented in terms of C functions      **/
  45. /**    like fprintf(), getc(), fopen(), rewind() etc.              **/
  46. /**    If the source-program uses Pascal functions like sin(), sqrt()      **/
  47. /**    etc, there must also exist such functions in the C-library.      **/
  48. /**                                      **/
  49. /***************************************************************************/
  50. /***************************************************************************/
  51. /*
  52. **    Code derived from program ptc
  53. */
  54. extern void    exit();
  55. /*
  56. **    Definitions for i/o
  57. */
  58. # include <stdio.h>
  59. typedef struct {
  60.     FILE    *fp;
  61.     unsigned short    eoln:1,
  62.             eof:1,
  63.             out:1,
  64.             init:1,
  65.             :12;
  66.     char    buf;
  67. }     text;
  68. text    input = { stdin, 0, 0 };
  69. text    output = { stdout, 0, 0 };
  70. # define Fread(x, f) fread((char *)&x, sizeof(x), 1, f)
  71. # define Get(f) Fread((f).buf, (f).fp)
  72. # define Getx(f) (f).init = 1, (f).eoln = (((f).buf = fgetc((f).fp)) == '\n') ? (((f).buf = ' '), 1) : 0
  73. # define Getchr(f) (f).buf, Getx(f)
  74. static FILE    *Tmpfil;
  75. static long    Tmplng;
  76. static double    Tmpdbl;
  77. # define Fscan(f) (f).init ? ungetc((f).buf, (f).fp) : 0, Tmpfil = (f).fp
  78. # define Scan(p, a) Scanck(fscanf(Tmpfil, p, a))
  79. void    Scanck();
  80. # define Eoln(f) ((f).eoln ? true : false)
  81. # define Eof(f) ((((f).init == 0) ? (Get(f)) : 0, ((f).eof ? 1 : feof((f).fp))) ? true : false)
  82. # define Fwrite(x, f) fwrite((char *)&x, sizeof(x), 1, f)
  83. # define Put(f) Fwrite((f).buf, (f).fp)
  84. # define Putx(f) (f).eoln = ((f).buf == '\n'), (void)fputc((f).buf, (f).fp)
  85. # define Putchr(c, f) (f).buf = (c), Putx(f)
  86. # define Putl(f, v) (f).eoln = v
  87. /*
  88. **    Definitions for case-statements
  89. **    and for non-local gotos
  90. */
  91. # define Line __LINE__
  92. void    Caseerror();
  93. # include <setjmp.h>
  94. static struct Jb { jmp_buf    jb; } J[1];
  95. /*
  96. **    Definitions for standard types
  97. */
  98. extern int strncmp();
  99. # define Cmpstr(x, y) strncmp((x), (y), sizeof(x))
  100. typedef char    boolean;
  101. # define false (boolean)0
  102. # define true (boolean)1
  103. extern char    *Bools[];
  104. typedef int    integer;
  105. # define maxint    2147483647
  106. extern void abort();
  107. /*
  108. **    Definitions for pointers
  109. */
  110. # ifndef Unionoffs
  111. # define Unionoffs(p, m) (((long)(&(p)->m))-((long)(p)))
  112. # endif
  113. # define NIL 0
  114. extern char *malloc();
  115. /*
  116. **    Definitions for set-operations
  117. */
  118. # define Claimset() (void)Currset(0, (setptr)0)
  119. # define Newset() Currset(1, (setptr)0)
  120. # define Saveset(s) Currset(2, s)
  121. # define setbits 15
  122. typedef unsigned short    setword;
  123. typedef setword *    setptr;
  124. boolean    Member(), Le(), Ge(), Eq(), Ne();
  125. setptr    Union(), Diff();
  126. setptr    Insmem(), Mksubr();
  127. setptr    Currset(), Inter();
  128. static setptr    Tmpset;
  129. extern setptr    Conset[];
  130. void    Setncpy();
  131. extern char *strncpy();
  132. /*
  133. **    Start of program definitions
  134. */
  135. static char    version[]    = "From: @(#)ptc.p    1.5  Date 87/05/01";
  136. static char    sccsid[]    = "@(#)ptc.c    1.2 Date 87/05/09";
  137. # define keytablen 38
  138. # define keywordlen 10
  139. static char    othersym[]    = "otherwise ";
  140. static char    externsym[]    = "external  ";
  141. static char    dummysym[]    = "          ";
  142. static char    wordtype[]    = "unsigned short";
  143. # define C37_setbits 15
  144. static char    filebits[]    = "unsigned short";
  145. # define filefill 12
  146. # define maxsetrange 15
  147. # define scalbase 0
  148. # define maxprio 7
  149. # define maxmachdefs 8
  150. # define machdeflen 16
  151. # define maxstrblk 1023
  152. # define maxblkcnt 63
  153. # define maxstrstor 65535
  154. # define maxtoknlen 127
  155. # define hashmax 64
  156. # define null 0
  157. # define minchar null
  158. # define maxchar 127
  159. static char    tmpfilename[]    = "\"/tmp/ptc%d%c\", getpid(), ";
  160. # define space ' '
  161. # define tab1 '    '
  162. static char    tab2[]    = "        ";
  163. static char    tab3[]    = "            ";
  164. static char    tab4[]    = "                ";
  165. # define bslash '\\'
  166. static char    nlchr[]    = "'\\n'";
  167. static char    ffchr[]    = "'\\f'";
  168. static char    nulchr[]    = "'\\0'";
  169. static char    spchr[]    = "' '";
  170. # define quote '\''
  171. # define cite '"'
  172. # define xpnent 'e'
  173. # define percent '%'
  174. # define uscore '_'
  175. # define badchr '?'
  176. # define okchr quote
  177. # define tabwidth 8
  178. # define echo false
  179. # define diffcomm false
  180. # define lazyfor false
  181. # define unionnew true
  182. static char    inttyp[]    = "int";
  183. static char    chartyp[]    = "char";
  184. static char    setwtyp[]    = "setword";
  185. static char    setptyp[]    = "setptr";
  186. static char    floattyp[]    = "float";
  187. static char    doubletyp[]    = "double";
  188. static char    dblcast[]    = "(double)";
  189. # define realtyp doubletyp
  190. static char    voidtyp[]    = "void";
  191. static char    voidcast[]    = "(void)";
  192. # define intlen 10
  193. # define fixlen 20
  194. static char    C24_include[]    = "# include ";
  195. static char    C4_define[]    = "# define ";
  196. static char    ifdef[]    = "# ifdef ";
  197. static char    ifndef[]    = "# ifndef ";
  198. static char    elsif[]    = "# else";
  199. static char    endif[]    = "# endif";
  200. static char    C50_static[]    = "static ";
  201. static char    xtern[]    = "extern ";
  202. static char    typdef[]    = "typedef ";
  203. static char    registr[]    = "register ";
  204. # define indstep 8
  205. typedef unsigned char    hashtyp;
  206. typedef unsigned short    strindx;
  207. typedef unsigned short    strbidx;
  208. typedef struct { char    A[maxstrblk + 1]; }    strblk;
  209. typedef strblk *    strptr;
  210. typedef unsigned char    strbcnt;
  211. typedef struct S59 *    idptr;
  212. typedef struct S59 {
  213.     idptr    inext;
  214.     unsigned char    inref;
  215.     hashtyp    ihash;
  216.     strindx    istr;
  217. }    idnode;
  218. typedef unsigned char    toknidx;
  219. typedef struct { char    A[maxtoknlen - 1 + 1]; }    toknbuf;
  220. typedef struct { char    A[keywordlen - 1 + 1]; }    keyword;
  221. typedef enum { dabs, darctan, dargc, dargv,
  222.     dboolean, dchar, dchr, dclose,
  223.     dcos, ddispose, deof, deoln,
  224.     dexit, dexp, dfalse, dflush,
  225.     dget, dhalt, dinput, dinteger,
  226.     dln, dmaxint, dmessage, dnew,
  227.     dodd, dord, doutput, dpage,
  228.     dpack, dpred, dput, dread,
  229.     dreadln, dreal, dreset, drewrite,
  230.     dround, dsin, dsqr, dsqrt,
  231.     dsucc, dtext, dtrue, dtrunc,
  232.     dtan, dwrite, dwriteln, dunpack,
  233.     dzinit, dztring }     predefs;
  234. typedef enum { sand, sarray, sbegin, scase,
  235.     sconst, sdiv, sdo, sdownto,
  236.     selse, send, sextern, sfile,
  237.     sfor, sforward, sfunc, sgoto,
  238.     sif, sinn, slabel, smod,
  239.     snil, snot, sof, sor,
  240.     sother, spacked, sproc, spgm,
  241.     srecord, srepeat, sset, sthen,
  242.     sto, stype, suntil, svar,
  243.     swhile, swith, seof, sinteger,
  244.     sreal, sstring, schar, sid,
  245.     splus, sminus, smul, squot,
  246.     sarrow, slpar, srpar, slbrack,
  247.     srbrack, seq, sne, slt,
  248.     sle, sgt, sge, scomma,
  249.     scolon, ssemic, sassign, sdotdot,
  250.     sdot }     symtyp;
  251. typedef struct { setword    S[6]; }    symset;
  252. typedef struct S180 {
  253.     symtyp    st;
  254.     union {
  255.         struct  {
  256.             idptr    vid;
  257.         } V1;
  258.         struct  {
  259.             char    vchr;
  260.         } V2;
  261.         struct  {
  262.             integer    vint;
  263.         } V3;
  264.         struct  {
  265.             strindx    vflt;
  266.         } V4;
  267.         struct  {
  268.             strindx    vstr;
  269.         } V5;
  270.     } U;
  271. }    lexsym;
  272. typedef enum { lpredef, lidentifier, lfield, lforward,
  273.     lpointer, lstring, llabel, lforwlab,
  274.     linteger, lreal, lcharacter }     ltypes;
  275. typedef struct S60 *    declptr;
  276. typedef struct S61 *    treeptr;
  277. typedef struct S62 *    symptr;
  278. typedef struct S62 {
  279.     treeptr    lsymdecl;
  280.     symptr    lnext;
  281.     declptr    ldecl;
  282.     ltypes    lt;
  283.     union {
  284.         struct  {
  285.             idptr    lid;
  286.             boolean    lused;
  287.         } V6;
  288.         struct  {
  289.             strindx    lstr;
  290.         } V7;
  291.         struct  {
  292.             strindx    lfloat;
  293.         } V8;
  294.         struct  {
  295.             integer    lno;
  296.             boolean    lgo;
  297.         } V9;
  298.         struct  {
  299.             integer    linum;
  300.         } V10;
  301.         struct  {
  302.             char    lchar;
  303.         } V11;
  304.     } U;
  305. }    symnode;
  306. typedef struct S60 {
  307.     declptr    dprev;
  308.     struct { symptr    A[hashmax + 1]; }    ddecl;
  309. }    declnode;
  310. typedef enum { npredef, npgm, nfunc, nproc,
  311.     nlabel, nconst, ntype, nvar,
  312.     nvalpar, nvarpar, nparproc, nparfunc,
  313.     nsubrange, nvariant, nfield, nrecord,
  314.     narray, nconfarr, nfileof, nsetof,
  315.     nbegin, nptr, nscalar, nif,
  316.     nwhile, nrepeat, nfor, ncase,
  317.     nchoise, ngoto, nwith, nwithvar,
  318.     nempty, nlabstmt, nassign, nformat,
  319.     nin, neq, nne, nlt,
  320.     nle, ngt, nge, nor,
  321.     nplus, nminus, nand, nmul,
  322.     ndiv, nmod, nquot, nnot,
  323.     numinus, nuplus, nset, nrange,
  324.     nindex, nselect, nderef, ncall,
  325.     nid, nchar, ninteger, nreal,
  326.     nstring, nnil, npush, npop,
  327.     nbreak }     treetyp;
  328. typedef enum { tnone, tboolean, tchar, tinteger,
  329.     treal, tstring, tnil, tset,
  330.     ttext, tpoly, terror }     pretyps;
  331. typedef enum { anone, aregister, aextern, areference }     attributes;
  332. typedef struct S61 {
  333.     treeptr    tnext, ttype, tup;
  334.     treetyp    tt;
  335.     union {
  336.         struct  {
  337.             predefs    tdef;
  338.             pretyps    tobtyp;
  339.         } V12;
  340.         struct  {
  341.             treeptr    tsubid, tsubpar, tfuntyp, tsublab,
  342.                 tsubconst, tsubtype, tsubvar, tsubsub,
  343.                 tsubstmt;
  344.             integer    tstat;
  345.             declptr    tscope;
  346.         } V13;
  347.         struct  {
  348.             treeptr    tidl, tbind;
  349.             attributes    tattr;
  350.         } V14;
  351.         struct  {
  352.             treeptr    tparid, tparparm, tpartyp;
  353.         } V15;
  354.         struct  {
  355.             treeptr    tptrid;
  356.             boolean    tptrflag;
  357.         } V16;
  358.         struct  {
  359.             treeptr    tscalid;
  360.         } V17;
  361.         struct  {
  362.             treeptr    tof;
  363.         } V18;
  364.         struct  {
  365.             treeptr    tlo, thi;
  366.         } V19;
  367.         struct  {
  368.             treeptr    tselct, tvrnt;
  369.         } V20;
  370.         struct  {
  371.             treeptr    tflist, tvlist;
  372.             idptr    tuid;
  373.             declptr    trscope;
  374.         } V21;
  375.         struct  {
  376.             treeptr    tcindx, tindtyp, tcelem;
  377.             idptr    tcuid;
  378.         } V22;
  379.         struct  {
  380.             treeptr    taindx, taelem;
  381.         } V23;
  382.         struct  {
  383.             treeptr    tbegin;
  384.         } V24;
  385.         struct  {
  386.             treeptr    tlabno, tstmt;
  387.         } V25;
  388.         struct  {
  389.             treeptr    tlabel;
  390.         } V26;
  391.         struct  {
  392.             treeptr    tlhs, trhs;
  393.         } V27;
  394.         struct  {
  395.             treeptr    tglob, tloc, ttmp;
  396.         } V28;
  397.         struct  {
  398.             treeptr    tbrkid, tbrkxp;
  399.         } V29;
  400.         struct  {
  401.             treeptr    tcall, taparm;
  402.         } V30;
  403.         struct  {
  404.             treeptr    tifxp, tthen, telse;
  405.         } V31;
  406.         struct  {
  407.             treeptr    twhixp, twhistmt;
  408.         } V32;
  409.         struct  {
  410.             treeptr    treptstmt, treptxp;
  411.         } V33;
  412.         struct  {
  413.             treeptr    tforid, tfrom, tto, tforstmt;
  414.             boolean    tincr;
  415.         } V34;
  416.         struct  {
  417.             treeptr    tcasxp, tcaslst, tcasother;
  418.         } V35;
  419.         struct  {
  420.             treeptr    tchocon, tchostmt;
  421.         } V36;
  422.         struct  {
  423.             treeptr    twithvar, twithstmt;
  424.         } V37;
  425.         struct  {
  426.             treeptr    texpw;
  427.             declptr    tenv;
  428.         } V38;
  429.         struct  {
  430.             treeptr    tvariable, toffset;
  431.         } V39;
  432.         struct  {
  433.             treeptr    trecord, tfield;
  434.         } V40;
  435.         struct  {
  436.             treeptr    texpl, texpr;
  437.         } V41;
  438.         struct  {
  439.             treeptr    texps;
  440.         } V42;
  441.         struct  {
  442.             symptr    tsym;
  443.         } V43;
  444.     } U;
  445. }    treenode;
  446. typedef enum { cabort, cbreak, ccontinue, cdefine,
  447.     cdefault, cdouble, cedata, cenum,
  448.     cetext, cextern, cfgetc, cfclose,
  449.     cfflush, cfloat, cfloor, cfprintf,
  450.     cfputc, cfread, cfscanf, cfwrite,
  451.     cgetc, cgetpid, cint, cinclude,
  452.     clong, clog, cmain, cmalloc,
  453.     cprintf, cpower, cputc, cread,
  454.     creturn, cregister, crewind, cscanf,
  455.     csetbits, csetword, csetptr, cshort,
  456.     csigned, csizeof, csprintf, cstdin,
  457.     cstdout, cstderr, cstrncmp, cstrncpy,
  458.     cstruct, cstatic, cswitch, ctypedef,
  459.     cundef, cungetc, cunion, cunlink,
  460.     cunsigned, cwrite }     cnames;
  461. typedef enum { ebadsymbol, elongstring, elongtokn, erange,
  462.     emanytokn, enotdeclid, emultdeclid, enotdecllab,
  463.     emultdecllab, emuldeflab, ebadstring, enulchr,
  464.     ebadchar, eeofcmnt, eeofstr, evarpar,
  465.     enew, esetbase, esetsize, eoverflow,
  466.     etree, etag, euprconf, easgnconf,
  467.     ecmpconf, econfconf, evrntfile, evarfile,
  468.     emanymachs, ebadmach }     errors;
  469. typedef struct { char    A[machdeflen - 1 + 1]; }    machdefstr;
  470. typedef struct { struct S206 {
  471.     keyword    wrd;
  472.     symtyp    sym;
  473. }    A[keytablen + 1]; }    T63;
  474. typedef struct { strptr    A[maxblkcnt + 1]; }    T64;
  475. typedef struct { idptr    A[hashmax + 1]; }    T65;
  476. typedef struct { treeptr    A[50]; }    T66;
  477. typedef struct { symptr    A[50]; }    T67;
  478. typedef struct { treeptr    A[11]; }    T68;
  479. typedef struct { unsigned char    A[(int)(nnil) - (int)(nassign) + 1]; }    T69;
  480. typedef struct { idptr    A[58]; }    T70;
  481. typedef struct { struct S193 {
  482.     integer    lolim, hilim;
  483.     strindx    typstr;
  484. }    A[maxmachdefs - 1 + 1]; }    T71;
  485. typedef struct { char    A[15 + 1]; }    T72;
  486. typedef struct { setword    S[2]; }    bitset;
  487. integer    *G204_indnt;
  488. integer    *G202_doarrow;
  489. boolean    *G200_donearr;
  490. boolean    *G198_dropset;
  491. boolean    *G196_setused;
  492. boolean    *G194_conflag;
  493. integer    *G191_nelems;
  494. treeptr    *G189_vp;
  495. treeptr    *G187_tv;
  496. symptr    *G185_iq;
  497. symptr    *G183_ip;
  498. unsigned char    *G181_lastchr;
  499. toknidx    *G178_i;
  500. toknbuf    *G176_t;
  501. boolean    usemax, usejmps, usecase, usesets, useunion, usediff,
  502.     usemksub, useintr, usesge, usesle, useseq, usesne,
  503.     usememb, useins, usescpy, usecomp, usefopn, usescan,
  504.     usegetl, usenilp, usebool;
  505. treeptr    top;
  506. treeptr    setlst;
  507. integer    setcnt;
  508. lexsym    currsym;
  509. T63    keytab;
  510. T64    strstor;
  511. strindx    strfree;
  512. strbidx    strleft;
  513. T65    idtab;
  514. declptr    symtab;
  515. integer    statlvl, maxlevel;
  516. T66    deftab;
  517. T67    defnams;
  518. T68    typnods;
  519. T69    pprio, cprio;
  520. T70    ctable;
  521. unsigned char    nmachdefs;
  522. T71    machdefs;
  523. integer    lineno, colno, lastcol, lastline;
  524. toknbuf    lasttok;
  525. integer    varno;
  526. T72    hexdig;
  527.  
  528.  void
  529. prtmsg(m)
  530.     errors    m;
  531. {
  532.     static char    user[]    = "Error: ";
  533.     static char    restr[]    = "Implementation restriction: ";
  534.     static char    inter[]    = "* Internal error * ";
  535. # define xtoklen 64
  536.     typedef struct { char    A[xtoklen - 1 + 1]; }    T73;
  537.     toknidx    i;
  538.     T73    xtok;
  539.  
  540.     switch (m) {
  541.       case ebadsymbol:
  542.         (void)fprintf(stderr, "%sUnexpected symbol\n", user), Putl(output, 1);
  543.         break ;
  544.       case ebadchar:
  545.         (void)fprintf(stderr, "%sBad character\n", user), Putl(output, 1);
  546.         break ;
  547.       case elongstring:
  548.         (void)fprintf(stderr, "%sToo long string\n", restr), Putl(output, 1);
  549.         break ;
  550.       case ebadstring:
  551.         (void)fprintf(stderr, "%sNewline in string or character\n", user), Putl(output, 1);
  552.         break ;
  553.       case eeofstr:
  554.         (void)fprintf(stderr, "%sEnd of file in string or character\n", user), Putl(output, 1);
  555.         break ;
  556.       case eeofcmnt:
  557.         (void)fprintf(stderr, "%sEnd of file in comment\n", user), Putl(output, 1);
  558.         break ;
  559.       case elongtokn:
  560.         (void)fprintf(stderr, "%sToo long identfier\n", restr), Putl(output, 1);
  561.         break ;
  562.       case emanytokn:
  563.         (void)fprintf(stderr, "%sToo many strings, identifiers or real numbers\n", restr), Putl(output, 1);
  564.         break ;
  565.       case enotdeclid:
  566.         (void)fprintf(stderr, "%sIdentifier not declared\n", user), Putl(output, 1);
  567.         break ;
  568.       case emultdeclid:
  569.         (void)fprintf(stderr, "%sIdentifier declared twice\n", user), Putl(output, 1);
  570.         break ;
  571.       case enotdecllab:
  572.         (void)fprintf(stderr, "%sLabel not declared\n", user), Putl(output, 1);
  573.         break ;
  574.       case emultdecllab:
  575.         (void)fprintf(stderr, "%sLabel declared twice\n", user), Putl(output, 1);
  576.         break ;
  577.       case emuldeflab:
  578.         (void)fprintf(stderr, "%sLabel defined twice\n", user), Putl(output, 1);
  579.         break ;
  580.       case evarpar:
  581.         (void)fprintf(stderr, "%sActual parameter not a variable\n", user), Putl(output, 1);
  582.         break ;
  583.       case enulchr:
  584.         (void)fprintf(stderr, "%sCannot handle nul-character in strings\n", restr), Putl(output, 1);
  585.         break ;
  586.       case enew:
  587.         (void)fprintf(stderr, "%sNew returned a nil-pointer\n", restr), Putl(output, 1);
  588.         break ;
  589.       case eoverflow:
  590.         (void)fprintf(stderr, "%sToken buffer overflowed\n", restr), Putl(output, 1);
  591.         break ;
  592.       case esetbase:
  593.         (void)fprintf(stderr, "%sCannot handle sets with base >> 0\n", restr), Putl(output, 1);
  594.         break ;
  595.       case esetsize:
  596.         (void)fprintf(stderr, "%sCannot handle sets with very large range\n", restr), Putl(output, 1);
  597.         break ;
  598.       case etree:
  599.         (void)fprintf(stderr, "%sBad tree structure\n", inter), Putl(output, 1);
  600.         break ;
  601.       case etag:
  602.         (void)fprintf(stderr, "%sCannot find tag\n", inter), Putl(output, 1);
  603.         break ;
  604.       case evrntfile:
  605.         (void)fprintf(stderr, "%sCannot initialize files in record variants\n", restr), Putl(output, 1);
  606.         break ;
  607.       case evarfile:
  608.         (void)fprintf(stderr, "%sCannot handle files in structured variables\n", restr), Putl(output, 1);
  609.         break ;
  610.       case euprconf:
  611.         (void)fprintf(stderr, "%sNo upper bound on conformant arrays\n", inter), Putl(output, 1);
  612.         break ;
  613.       case easgnconf:
  614.         (void)fprintf(stderr, "%sCannot assign conformant arrays\n", inter), Putl(output, 1);
  615.         break ;
  616.       case ecmpconf:
  617.         (void)fprintf(stderr, "%sCannot compare conformant arrays\n", inter), Putl(output, 1);
  618.         break ;
  619.       case econfconf:
  620.         (void)fprintf(stderr, "%sCannot handle nested conformat arrays\n", restr), Putl(output, 1);
  621.         break ;
  622.       case erange:
  623.         (void)fprintf(stderr, "%sCannot find C-type for integer-subrange\n", inter), Putl(output, 1);
  624.         break ;
  625.       case emanymachs:
  626.         (void)fprintf(stderr, "%sToo many machine integer types\n", restr), Putl(output, 1);
  627.         break ;
  628.       case ebadmach:
  629.         (void)fprintf(stderr, "%sBad name for machine integer type\n", inter), Putl(output, 1);
  630.         break ;
  631.       default:
  632.         Caseerror(Line);
  633.     }
  634.     if (lastline != 0) {
  635.         (void)fprintf(stderr, "Line %1d, col %1d:\n", lastline, lastcol), Putl(output, 1);
  636.         if (Member((unsigned)(m), Conset[0])) {
  637.             i = 1;
  638.             while ((i < xtoklen) && (lasttok.A[i - 1] != null)) {
  639.                 xtok.A[i - 1] = lasttok.A[i - 1];
  640.                 i = i + 1;
  641.             }
  642.             while (i < xtoklen) {
  643.                 xtok.A[i - 1] = ' ';
  644.                 i = i + 1;
  645.             }
  646.             xtok.A[xtoklen - 1] = ' ';
  647.             (void)fprintf(stderr, "Current symbol: %.64s\n", xtok.A), Putl(output, 1);
  648.         }
  649.     }
  650. }
  651.  
  652. void fatal();
  653.  
  654. void error();
  655.  
  656.  char
  657. uppercase(c)
  658.     char    c;
  659. {
  660.     register char    R75;
  661.  
  662.     if ((c >= 'a') && (c <= 'z'))
  663.         R75 = (unsigned)(c) + (unsigned)('A') - (unsigned)('a');
  664.     else
  665.         R75 = c;
  666.     return R75;
  667. }
  668.  
  669.  char
  670. lowercase(c)
  671.     char    c;
  672. {
  673.     register char    R76;
  674.  
  675.     if ((c >= 'A') && (c <= 'Z'))
  676.         R76 = (unsigned)(c) - (unsigned)('A') + (unsigned)('a');
  677.     else
  678.         R76 = c;
  679.     return R76;
  680. }
  681.  
  682.  void
  683. gettokn(i, t)
  684.     strindx    i;
  685.     toknbuf    *t;
  686. {
  687.     char    c;
  688.     toknidx    k;
  689.     strbidx    j;
  690.     strptr    p;
  691.  
  692.     k = 1;
  693.     p = strstor.A[i / (maxstrblk + 1)];
  694.     j = i % (maxstrblk + 1);
  695.     do {
  696.         c = p->A[j];
  697.         t->A[k - 1] = c;
  698.         j = j + 1;
  699.         k = k + 1;
  700.         if (k == maxtoknlen) {
  701.             c = null;
  702.             t->A[maxtoknlen - 1] = null;
  703.             prtmsg(eoverflow);
  704.         }
  705.     } while (!(c == null));
  706. }
  707.  
  708.  void
  709. puttokn(i, t)
  710.     strindx    i;
  711.     toknbuf    *t;
  712. {
  713.     char    c;
  714.     toknidx    k;
  715.     strbidx    j;
  716.     strptr    p;
  717.  
  718.     k = 1;
  719.     p = strstor.A[i / (maxstrblk + 1)];
  720.     j = i % (maxstrblk + 1);
  721.     do {
  722.         c = t->A[k - 1];
  723.         p->A[j] = c;
  724.         k = k + 1;
  725.         j = j + 1;
  726.     } while (!(c == null));
  727. }
  728.  
  729.  void
  730. writetok(w)
  731.     toknbuf    *w;
  732. {
  733.     toknidx    j;
  734.  
  735.     j = 1;
  736.     while (w->A[j - 1] != null) {
  737.         Putchr(w->A[j - 1], output);
  738.         j = j + 1;
  739.     }
  740. }
  741.  
  742.  void
  743. printtok(i)
  744.     strindx    i;
  745. {
  746.     toknbuf    w;
  747.  
  748.     gettokn(i, &w);
  749.     writetok(&w);
  750. }
  751.  
  752.  void
  753. printid(ip)
  754.     idptr    ip;
  755. {
  756.     printtok(ip->istr);
  757. }
  758.  
  759.  void
  760. printchr(c)
  761.     char    c;
  762. {
  763.     if ((c == quote) || (c == bslash))
  764.         (void)fprintf(output.fp, "%c%c%c%c", quote, bslash, c, quote), Putl(output, 0);
  765.     else
  766.         (void)fprintf(output.fp, "%c%c%c", quote, c, quote), Putl(output, 0);
  767. }
  768.  
  769.  void
  770. printstr(i)
  771.     strindx    i;
  772. {
  773.     toknidx    k;
  774.     char    c;
  775.     toknbuf    w;
  776.  
  777.     gettokn(i, &w);
  778.     Putchr(cite, output);
  779.     k = 1;
  780.     while (w.A[k - 1] != null) {
  781.         c = w.A[k - 1];
  782.         k = k + 1;
  783.         if ((c == cite) || (c == bslash))
  784.             Putchr(bslash, output);
  785.         Putchr(c, output);
  786.     }
  787.     Putchr(cite, output);
  788. }
  789.  
  790.  treeptr
  791. idup(ip)
  792.     treeptr    ip;
  793. {
  794.     register treeptr    R77;
  795.  
  796.     R77 = ip->U.V43.tsym->lsymdecl->tup;
  797.     return R77;
  798. }
  799.  
  800.  hashtyp
  801. hashtokn(id)
  802.     toknbuf    *id;
  803. {
  804.     register hashtyp    R78;
  805.     integer    h;
  806.     toknidx    i;
  807.  
  808.     i = 1;
  809.     h = 0;
  810.     while (id->A[i - 1] != null) {
  811.         h = h + (unsigned)(id->A[i - 1]);
  812.         i = i + 1;
  813.     }
  814.     R78 = h % hashmax;
  815.     return R78;
  816. }
  817.  
  818.  strindx
  819. savestr(t)
  820.     toknbuf    *t;
  821. {
  822.     register strindx    R79;
  823.     toknidx    k;
  824.     strindx    i;
  825.     strbcnt    j;
  826.  
  827.     k = 1;
  828.     while (t->A[k - 1] != null)
  829.         k = k + 1;
  830.     if (k > strleft) {
  831.         if (strstor.A[maxblkcnt] != (strblk *)NIL)
  832.             error(emanytokn);
  833.         j = (strfree + maxstrblk) / (maxstrblk + 1);
  834.         strstor.A[j] = (strblk *)malloc((unsigned)(sizeof(*strstor.A[j])));
  835.         if (strstor.A[j] == (strblk *)NIL)
  836.             error(enew);
  837.         strfree = j * (maxstrblk + 1);
  838.         strleft = maxstrblk;
  839.     }
  840.     i = strfree;
  841.     strfree = strfree + k;
  842.     strleft = strleft - k;
  843.     puttokn(i, &(*t));
  844.     R79 = i;
  845.     return R79;
  846. }
  847.  
  848.  idptr
  849. saveid(id)
  850.     toknbuf    *id;
  851. {
  852.     register idptr    R80;
  853.     toknidx    k;
  854.     idptr    ip;
  855.     hashtyp    h;
  856.     toknbuf    t;
  857.  
  858.     h = hashtokn(&(*id));
  859.     ip = idtab.A[h];
  860.     while (ip != (struct S59 *)NIL) {
  861.         gettokn(ip->istr, &t);
  862.         k = 1;
  863.         while (id->A[k - 1] == t.A[k - 1])
  864.             if (id->A[k - 1] == null)
  865.                 goto L999;
  866.             else
  867.                 k = k + 1;
  868.         ip = ip->inext;
  869.     }
  870.     ip = (struct S59 *)malloc((unsigned)(sizeof(*ip)));
  871.     if (ip == (struct S59 *)NIL)
  872.         error(enew);
  873.     ip->inref = 0;
  874.     ip->istr = savestr(&(*id));
  875.     ip->ihash = h;
  876.     ip->inext = idtab.A[h];
  877.     idtab.A[h] = ip;
  878. L999:
  879.     R80 = ip;
  880.     return R80;
  881. }
  882.  
  883.  idptr
  884. mkconc(sep, p, q)
  885.     char    sep;
  886.     idptr    p, q;
  887. {
  888.     register idptr    R81;
  889.     toknbuf    w, x;
  890.     toknidx    i, j;
  891.  
  892.     gettokn(q->istr, &x);
  893.     j = 1;
  894.     while (x.A[j - 1] != null)
  895.         j = j + 1;
  896.     w.A[1 - 1] = null;
  897.     if (p != (struct S59 *)NIL)
  898.         gettokn(p->istr, &w);
  899.     i = 1;
  900.     while (w.A[i - 1] != null)
  901.         i = i + 1;
  902.     if (i + j + 2 >= maxtoknlen)
  903.         error(eoverflow);
  904.     if (sep == '>') {
  905.         w.A[i - 1] = '-';
  906.         i = i + 1;
  907.     }
  908.     if (sep != space) {
  909.         w.A[i - 1] = sep;
  910.         i = i + 1;
  911.     }
  912.     j = 1;
  913.     do {
  914.         w.A[i - 1] = x.A[j - 1];
  915.         i = i + 1;
  916.         j = j + 1;
  917.     } while (!(w.A[i - 1 - 1] == null));
  918.     R81 = saveid(&w);
  919.     return R81;
  920. }
  921.  
  922. idptr mkuniqname();
  923.  
  924.  void
  925. dig(n)
  926.     integer    n;
  927. {
  928.     if (n > 0) {
  929.         dig(n / 10);
  930.         if ((*G178_i) == maxtoknlen)
  931.             error(eoverflow);
  932.         (*G176_t).A[(*G178_i) - 1] = n % 10 + (unsigned)('0');
  933.         (*G178_i) = (*G178_i) + 1;
  934.     }
  935. }
  936.  
  937.  idptr
  938. mkuniqname(t)
  939.     toknbuf    *t;
  940. {
  941.     register idptr    R82;
  942.     toknidx    i;
  943.     toknbuf    *F177;
  944.     toknidx    *F179;
  945.  
  946.     F179 = G178_i;
  947.     G178_i = &i;
  948.     F177 = G176_t;
  949.     G176_t = &(*t);
  950.     (*G178_i) = 1;
  951.     while ((*G176_t).A[(*G178_i) - 1] != null)
  952.         (*G178_i) = (*G178_i) + 1;
  953.     varno = varno + 1;
  954.     dig(varno);
  955.     (*G176_t).A[(*G178_i) - 1] = null;
  956.     R82 = saveid(&(*G176_t));
  957.     G176_t = F177;
  958.     G178_i = F179;
  959.     return R82;
  960. }
  961.  
  962.  idptr
  963. mkvariable(c)
  964.     char    c;
  965. {
  966.     register idptr    R83;
  967.     toknbuf    t;
  968.  
  969.     t.A[1 - 1] = c;
  970.     t.A[2 - 1] = null;
  971.     R83 = mkuniqname(&t);
  972.     return R83;
  973. }
  974.  
  975.  idptr
  976. mkrename(c, ip)
  977.     char    c;
  978.     idptr    ip;
  979. {
  980.     register idptr    R84;
  981.  
  982.     R84 = mkconc(uscore, mkvariable(c), ip);
  983.     return R84;
  984. }
  985.  
  986.  idptr
  987. mkvrnt()
  988. {
  989.     register idptr    R85;
  990.     toknbuf    t;
  991.  
  992.     t.A[1 - 1] = 'U';
  993.     t.A[2 - 1] = '.';
  994.     t.A[3 - 1] = 'V';
  995.     t.A[4 - 1] = null;
  996.     R85 = mkuniqname(&t);
  997.     return R85;
  998. }
  999.  
  1000.  void
  1001. checksymbol(ss)
  1002.     symset    ss;
  1003. {
  1004.     if (!(Member((unsigned)(currsym.st), ss.S)))
  1005.         error(ebadsymbol);
  1006. }
  1007.  
  1008. void nextsymbol();
  1009.  
  1010.  char
  1011. nextchar()
  1012. {
  1013.     register char    R86;
  1014.     char    c;
  1015.  
  1016.     if (Eof(input))
  1017.         c = null;
  1018.     else {
  1019.         colno = colno + 1;
  1020.         if (Eoln(input)) {
  1021.             lineno = lineno + 1;
  1022.             colno = 0;
  1023.         }
  1024.         c = Getchr(input);
  1025.         if (echo)
  1026.             if (colno == 0)
  1027.                 Putchr('\n', output);
  1028.             else
  1029.                 Putchr(c, output);
  1030.         if (c == tab1)
  1031.             colno = ((colno / tabwidth) + 1) * tabwidth;
  1032.     }
  1033.     if ((*G181_lastchr) > 0) {
  1034.         lasttok.A[(*G181_lastchr) - 1] = c;
  1035.         (*G181_lastchr) = (*G181_lastchr) + 1;
  1036.     }
  1037.     R86 = c;
  1038.     return R86;
  1039. }
  1040.  
  1041.  char
  1042. peekchar()
  1043. {
  1044.     register char    R87;
  1045.  
  1046.     if (Eof(input))
  1047.         R87 = null;
  1048.     else
  1049.         R87 = input.buf;
  1050.     return R87;
  1051. }
  1052.  
  1053. void nexttoken();
  1054.  
  1055.  boolean
  1056. idchar(c)
  1057.     char    c;
  1058. {
  1059.     register boolean    R88;
  1060.  
  1061.     R88 = (boolean)((c >= 'a') && (c <= 'z') || (c >= '0') && (c <= '9') || (c >= 'A') && (c <= 'Z') || (c == uscore));
  1062.     return R88;
  1063. }
  1064.  
  1065.  boolean
  1066. numchar(c)
  1067.     char    c;
  1068. {
  1069.     register boolean    R89;
  1070.  
  1071.     R89 = (boolean)((c >= '0') && (c <= '9'));
  1072.     return R89;
  1073. }
  1074.  
  1075.  integer
  1076. numval(c)
  1077.     char    c;
  1078. {
  1079.     register integer    R90;
  1080.  
  1081.     R90 = (unsigned)(c) - (unsigned)('0');
  1082.     return R90;
  1083. }
  1084.  
  1085.  symtyp
  1086. keywordcheck(w, l)
  1087.     toknbuf    *w;
  1088.     toknidx    l;
  1089. {
  1090.     register symtyp    R91;
  1091.     register unsigned char    n;
  1092.     unsigned char    i, j, k;
  1093.     keyword    wrd;
  1094.     symtyp    kwc;
  1095.  
  1096.     if ((l > 1) && (l < keywordlen)) {
  1097.         wrd = keytab.A[keytablen].wrd;
  1098.         {
  1099.             unsigned char    B44 = 1,
  1100.                 B45 = l;
  1101.  
  1102.             if (B44 <= B45)
  1103.                 for (n = B44; ; n++) {
  1104.                     wrd.A[n - 1] = w->A[n - 1];
  1105.                     if (n == B45) break;
  1106.                 }
  1107.         }
  1108.         i = 0;
  1109.         j = keytablen;
  1110.         while (j > i) {
  1111.             k = (i + j) / 2;
  1112.             if (Cmpstr(keytab.A[k].wrd.A, wrd.A) >= 0)
  1113.                 j = k;
  1114.             else
  1115.                 i = k + 1;
  1116.         }
  1117.         if (Cmpstr(keytab.A[j].wrd.A, wrd.A) == 0)
  1118.             kwc = keytab.A[j].sym;
  1119.         else
  1120.             kwc = sid;
  1121.     } else
  1122.         kwc = sid;
  1123.     R91 = kwc;
  1124.     return R91;
  1125. }
  1126.  
  1127.  void
  1128. nexttoken(realok)
  1129.     boolean    realok;
  1130. {
  1131.     char    c;
  1132.     integer    n;
  1133.     boolean    ready;
  1134.     toknidx    wl;
  1135.     toknbuf    wb;
  1136.  
  1137.     (*G181_lastchr) = 0;
  1138.     do {
  1139.         c = nextchar();
  1140.         if (c == '{') {
  1141.             do {
  1142.                 c = nextchar();
  1143.                 if (diffcomm)
  1144.                     ready = (boolean)(c == '}');
  1145.                 else
  1146.                     ready = (boolean)(((c == '*') && (peekchar() == ')')) || (c == '}'));
  1147.             } while (!(ready || Eof(input)));
  1148.             if (Eof(input) && !ready)
  1149.                 error(eeofcmnt);
  1150.             if ((c == '*') && !Eof(input))
  1151.                 c = nextchar();
  1152.             c = space;
  1153.         } else
  1154.             if ((c == '(') && (peekchar() == '*')) {
  1155.                 c = nextchar();
  1156.                 do {
  1157.                     c = nextchar();
  1158.                     if (diffcomm)
  1159.                         ready = (boolean)((c == '*') && (peekchar() == ')'));
  1160.                     else
  1161.                         ready = (boolean)(((c == '*') && (peekchar() == ')')) || (c == '}'));
  1162.                 } while (!(ready || Eof(input)));
  1163.                 if (Eof(input) && !ready)
  1164.                     error(eeofcmnt);
  1165.                 if ((c == '*') && !Eof(input))
  1166.                     c = nextchar();
  1167.                 c = space;
  1168.             }
  1169.     } while (!((c != space) && (c != tab1)));
  1170.     lasttok.A[1 - 1] = c;
  1171.     (*G181_lastchr) = 2;
  1172.     lastcol = colno;
  1173.     lastline = lineno;
  1174.     if (c < okchr)
  1175.         c = badchr;
  1176.     {
  1177.         register struct S180 *W46 = &currsym;
  1178.  
  1179.         if (Eof(input)) {
  1180.             lasttok.A[1 - 1] = '*';
  1181.             lasttok.A[2 - 1] = 'E';
  1182.             lasttok.A[3 - 1] = 'O';
  1183.             lasttok.A[4 - 1] = 'F';
  1184.             lasttok.A[5 - 1] = '*';
  1185.             (*G181_lastchr) = 6;
  1186.             W46->st = seof;
  1187.         } else
  1188.             switch (c) {
  1189.               case '|':  case '`':  case '~':  case '}':
  1190.               case 92:  case 95:  case 63:
  1191.                 error(ebadchar);
  1192.                 break ;
  1193.               case 'a':  case 'b':  case 'c':  case 'd':
  1194.               case 'e':  case 'f':  case 'g':  case 'h':
  1195.               case 'i':  case 'j':  case 'k':  case 'l':
  1196.               case 'm':  case 'n':  case 'o':  case 'p':
  1197.               case 'q':  case 'r':  case 's':  case 't':
  1198.               case 'u':  case 'v':  case 'w':  case 'x':
  1199.               case 'y':  case 'z':  case 'A':  case 'B':
  1200.               case 'C':  case 'D':  case 'E':  case 'F':
  1201.               case 'G':  case 'H':  case 'I':  case 'J':
  1202.               case 'K':  case 'L':  case 'M':  case 'N':
  1203.               case 'O':  case 'P':  case 'Q':  case 'R':
  1204.               case 'S':  case 'T':  case 'U':  case 'V':
  1205.               case 'W':  case 'X':  case 'Y':  case 'Z':
  1206.                 wb.A[1 - 1] = lowercase(c);
  1207.                 wl = 2;
  1208.                 while ((wl < maxtoknlen) && idchar(peekchar())) {
  1209.                     wb.A[wl - 1] = lowercase(nextchar());
  1210.                     wl = wl + 1;
  1211.                 }
  1212.                 if (wl >= maxtoknlen) {
  1213.                     lasttok.A[(*G181_lastchr) - 1] = null;
  1214.                     error(elongtokn);
  1215.                 }
  1216.                 wb.A[wl - 1] = null;
  1217.                 W46->st = keywordcheck(&wb, wl - 1);
  1218.                 if (W46->st == sid)
  1219.                     W46->U.V1.vid = saveid(&wb);
  1220.                 break ;
  1221.               case '0':  case '1':  case '2':  case '3':
  1222.               case '4':  case '5':  case '6':  case '7':
  1223.               case '8':  case '9':
  1224.                 wb.A[1 - 1] = c;
  1225.                 wl = 2;
  1226.                 n = numval(c);
  1227.                 while (numchar(peekchar())) {
  1228.                     c = nextchar();
  1229.                     n = n * 10 + numval(c);
  1230.                     wb.A[wl - 1] = c;
  1231.                     wl = wl + 1;
  1232.                 }
  1233.                 W46->st = sinteger;
  1234.                 W46->U.V3.vint = n;
  1235.                 if (realok) {
  1236.                     if (peekchar() == '.') {
  1237.                         W46->st = sreal;
  1238.                         wb.A[wl - 1] = nextchar();
  1239.                         wl = wl + 1;
  1240.                         while (numchar(peekchar())) {
  1241.                             wb.A[wl - 1] = nextchar();
  1242.                             wl = wl + 1;
  1243.                         }
  1244.                     }
  1245.                     c = peekchar();
  1246.                     if ((c == 'e') || (c == 'E')) {
  1247.                         W46->st = sreal;
  1248.                         c = nextchar();
  1249.                         wb.A[wl - 1] = xpnent;
  1250.                         wl = wl + 1;
  1251.                         c = peekchar();
  1252.                         if ((c == '-') || (c == '+')) {
  1253.                             wb.A[wl - 1] = nextchar();
  1254.                             wl = wl + 1;
  1255.                         }
  1256.                         while (numchar(peekchar())) {
  1257.                             wb.A[wl - 1] = nextchar();
  1258.                             wl = wl + 1;
  1259.                         }
  1260.                     }
  1261.                     if (W46->st == sreal) {
  1262.                         wb.A[wl - 1] = null;
  1263.                         W46->U.V4.vflt = savestr(&wb);
  1264.                     }
  1265.                 }
  1266.                 break ;
  1267.               case '(':
  1268.                 if (peekchar() == '.') {
  1269.                     c = nextchar();
  1270.                     W46->st = slbrack;
  1271.                 } else
  1272.                     W46->st = slpar;
  1273.                 break ;
  1274.               case ')':
  1275.                 W46->st = srpar;
  1276.                 break ;
  1277.               case '[':
  1278.                 W46->st = slbrack;
  1279.                 break ;
  1280.               case ']':
  1281.                 W46->st = srbrack;
  1282.                 break ;
  1283.               case '.':
  1284.                 if (peekchar() == '.') {
  1285.                     c = nextchar();
  1286.                     W46->st = sdotdot;
  1287.                 } else
  1288.                     if (peekchar() == ')') {
  1289.                         c = nextchar();
  1290.                         W46->st = srbrack;
  1291.                     } else
  1292.                         W46->st = sdot;
  1293.                 break ;
  1294.               case ';':
  1295.                 W46->st = ssemic;
  1296.                 break ;
  1297.               case ':':
  1298.                 if (peekchar() == '=') {
  1299.                     c = nextchar();
  1300.                     W46->st = sassign;
  1301.                 } else
  1302.                     W46->st = scolon;
  1303.                 break ;
  1304.               case ',':
  1305.                 W46->st = scomma;
  1306.                 break ;
  1307.               case '@':  case '^':
  1308.                 W46->st = sarrow;
  1309.                 break ;
  1310.               case '=':
  1311.                 W46->st = seq;
  1312.                 break ;
  1313.               case '<':
  1314.                 if (peekchar() == '=') {
  1315.                     c = nextchar();
  1316.                     W46->st = sle;
  1317.                 } else
  1318.                     if (peekchar() == '>') {
  1319.                         c = nextchar();
  1320.                         W46->st = sne;
  1321.                     } else
  1322.                         W46->st = slt;
  1323.                 break ;
  1324.               case '>':
  1325.                 if (peekchar() == '=') {
  1326.                     c = nextchar();
  1327.                     W46->st = sge;
  1328.                 } else
  1329.                     W46->st = sgt;
  1330.                 break ;
  1331.               case '+':
  1332.                 W46->st = splus;
  1333.                 break ;
  1334.               case '-':
  1335.                 W46->st = sminus;
  1336.                 break ;
  1337.               case '*':
  1338.                 W46->st = smul;
  1339.                 break ;
  1340.               case '/':
  1341.                 W46->st = squot;
  1342.                 break ;
  1343.               case 39:
  1344.                 wl = 0;
  1345.                 ready = false;
  1346.                 do {
  1347.                     if (Eoln(input)) {
  1348.                         lasttok.A[(*G181_lastchr) - 1] = null;
  1349.                         error(ebadstring);
  1350.                     }
  1351.                     c = nextchar();
  1352.                     if (c == quote)
  1353.                         if (peekchar() == quote)
  1354.                             c = nextchar();
  1355.                         else
  1356.                             ready = true;
  1357.                     if (c == null) {
  1358.                         if (Eof(input))
  1359.                             error(eeofstr);
  1360.                         lasttok.A[(*G181_lastchr) - 1] = null;
  1361.                         error(enulchr);
  1362.                     }
  1363.                     if (!ready) {
  1364.                         wl = wl + 1;
  1365.                         if (wl >= maxtoknlen) {
  1366.                             lasttok.A[(*G181_lastchr) - 1] = null;
  1367.                             error(elongstring);
  1368.                         }
  1369.                         wb.A[wl - 1] = c;
  1370.                     }
  1371.                 } while (!(ready));
  1372.                 if (wl == 1) {
  1373.                     W46->st = schar;
  1374.                     W46->U.V2.vchr = wb.A[1 - 1];
  1375.                 } else {
  1376.                     wl = wl + 1;
  1377.                     if (wl >= maxtoknlen) {
  1378.                         lasttok.A[(*G181_lastchr) - 1] = null;
  1379.                         error(elongstring);
  1380.                     }
  1381.                     wb.A[wl - 1] = null;
  1382.                     W46->st = sstring;
  1383.                     W46->U.V5.vstr = savestr(&wb);
  1384.                 }
  1385.                 break ;
  1386.               default:
  1387.                 Caseerror(Line);
  1388.             }
  1389.     }
  1390.     if ((*G181_lastchr) == 0)
  1391.         (*G181_lastchr) = 1;
  1392.     lasttok.A[(*G181_lastchr) - 1] = null;
  1393. }
  1394.  
  1395.  void
  1396. nextsymbol(ss)
  1397.     symset    ss;
  1398. {
  1399.     unsigned char    lastchr;
  1400.     unsigned char    *F182;
  1401.  
  1402.     F182 = G181_lastchr;
  1403.     G181_lastchr = &lastchr;
  1404.     nexttoken((boolean)(Member((unsigned)(sreal), ss.S)));
  1405.     checksymbol(ss);
  1406.     G181_lastchr = F182;
  1407. }
  1408.  
  1409.  treeptr
  1410. typeof(tp)
  1411.     treeptr    tp;
  1412. {
  1413.     register treeptr    R92;
  1414.     treeptr    tf, tq;
  1415.  
  1416.     tq = tp;
  1417.     tf = tq->ttype;
  1418.     while (tf == (struct S61 *)NIL) {
  1419.         switch (tq->tt) {
  1420.           case nchar:
  1421.             tf = typnods.A[(int)(tchar)];
  1422.             break ;
  1423.           case ninteger:
  1424.             tf = typnods.A[(int)(tinteger)];
  1425.             break ;
  1426.           case nreal:
  1427.             tf = typnods.A[(int)(treal)];
  1428.             break ;
  1429.           case nstring:
  1430.             tf = typnods.A[(int)(tstring)];
  1431.             break ;
  1432.           case nnil:
  1433.             tf = typnods.A[(int)(tnil)];
  1434.             break ;
  1435.           case nid:
  1436.             tq = idup(tq);
  1437.             if (tq == (struct S61 *)NIL)
  1438.                 fatal(etree);
  1439.             break ;
  1440.           case ntype:  case nvar:  case nconst:  case nfield:
  1441.           case nvalpar:  case nvarpar:
  1442.             tq = tq->U.V14.tbind;
  1443.             break ;
  1444.           case npredef:  case nptr:  case nscalar:  case nrecord:
  1445.           case nconfarr:  case narray:  case nfileof:  case nsetof:
  1446.             tf = tq;
  1447.             break ;
  1448.           case nsubrange:
  1449.             if (tq->tup->tt == nconfarr)
  1450.                 tf = tq->tup->U.V22.tindtyp;
  1451.             else
  1452.                 tf = tq;
  1453.             break ;
  1454.           case ncall:
  1455.             tf = typeof(tq->U.V30.tcall);
  1456.             if (tf == typnods.A[(int)(tpoly)])
  1457.                 tf = typeof(tq->U.V30.taparm);
  1458.             break ;
  1459.           case nfunc:
  1460.             tq = tq->U.V13.tfuntyp;
  1461.             break ;
  1462.           case nparfunc:
  1463.             tq = tq->U.V15.tpartyp;
  1464.             break ;
  1465.           case nproc:  case nparproc:
  1466.             tf = typnods.A[(int)(tnone)];
  1467.             break ;
  1468.           case nvariant:  case nlabel:  case npgm:  case nempty:
  1469.           case nbegin:  case nlabstmt:  case nassign:  case npush:
  1470.           case npop:  case nif:  case nwhile:  case nrepeat:
  1471.           case nfor:  case ncase:  case nchoise:  case ngoto:
  1472.           case nwith:  case nwithvar:
  1473.             fatal(etree);
  1474.             break ;
  1475.           case nformat:  case nrange:
  1476.             tq = tq->U.V41.texpl;
  1477.             break ;
  1478.           case nplus:  case nminus:  case nmul:
  1479.             tf = typeof(tq->U.V41.texpl);
  1480.             if (tf == typnods.A[(int)(tinteger)])
  1481.                 tf = typeof(tq->U.V41.texpr);
  1482.             else
  1483.                 if (tf->tt == nsetof)
  1484.                     tf = typnods.A[(int)(tset)];
  1485.             break ;
  1486.           case numinus:  case nuplus:
  1487.             tq = tq->U.V42.texps;
  1488.             break ;
  1489.           case nmod:  case ndiv:
  1490.             tf = typnods.A[(int)(tinteger)];
  1491.             break ;
  1492.           case nquot:
  1493.             tf = typnods.A[(int)(treal)];
  1494.             break ;
  1495.           case neq:  case nne:  case nlt:  case nle:
  1496.           case ngt:  case nge:  case nin:  case nor:
  1497.           case nand:  case nnot:
  1498.             tf = typnods.A[(int)(tboolean)];
  1499.             break ;
  1500.           case nset:
  1501.