OCODE(!1)   
SEND TO(!)  
BIN 
CHAIN(FIND#CGMX)
LIST
SWITCH(2)   
TREESIZE(9000)  
INCLUDE(%BLIB0,%BDEBUG,%BEDSFILES,%BSYSTEM,%BTYROUTINE) 
*   
GET "TSYNHEAD"  
    
GLOBAL $( DYVEC:27 $)   

GLOBAL $( START:1; REPORTGLOBALS:90; TRACE:53   
          TRANS:200; DECLLABELS:209;
          PROGRAMMAP:92; COMPILEAE:245  $)  

GLOBAL $(   
STEER:340;  GXV:341;  GFIMV:342;  GINFV:343;
GPLFV:344;  GSCFV:345;  GBINV:346;  GNAMEV:347; 
$)  
GLOBAL $( AUXPRINTOUTS:350 $)   
GLOBAL $( TREESIZE:360                 //  USED  BY STEER   
          TREEBASE:361                 // LIMIT OF TREE COMMON TO ALL SEGS. 
       $)   

MANIFEST $( IOSIZE= 700 $)  

STATIC $( ERRORS = FALSE $) 

LET COMPILESEGMENTS() BE
          $(C GLOBAL $( DYVEC:27 $) 
              TREEVEC := DYVEC(TREESIZE)
              WORDV := DYVEC(100)   

              TREEP := TREEVEC + TREESIZE   

              NAMETREE := 0 
              DECLSYSWORDS()
              TREEBASE := TREEP 
               $( LET O = OPTION
                  LET CLEARNAMETREE(X, LIMIT) BE
                          $(
                             IF X = 0 RETURN
                             TEST X!1 < LIMIT THEN X!1 := 0 OR  
                                           CLEARNAMETREE(X!1, LIMIT)
                             TEST X!2 < LIMIT THEN X!2 := 0 OR  
                                           CLEARNAMETREE(X!2, LIMIT)
                          $)
                 $( LET A = 0   
//                    BRING.SEG(#00200002)         // AREA 2, UNIT 2
                                                 // (SYNTAX ANALYSER)   
                    REPORTCOUNT := 0
                    TREEP := TREEBASE   
                    COMCOUNT1 := 0  
                    SEGCOUNT := SEGCOUNT + 1
                    $( LET P = OPTION!13 \/ OPTION!20   
                       IF P \/ OPTION!10 DO 
                       WRITEF("%CSEGMENT NUMBER %N*N*N%S", P->'*P', '*N',   
                                                           SEGCOUNT,
                             P->" LINE  COMMAND  TEXT*N*N", "") 
                    $)  
                    RDLINE()
                    RCH()   
                    NEXTSYMB()  

                    A := FORMTREE() 
                    WRITEF("*NTREE SIZE = %N*N", TREESIZE+TREEVEC-TREEP)
                    IF O!2 \/ O!7 \/ O!9 DO $( //  BRING.SEG(#00200003) 
                                                           // AREA 2, UNIT 3
                                                           // (PLIST ETC.)  
                                               AUXPRINTOUTS(A)  
                                            $)  
                    UNLESS O!3 DO $( // BRING.SEG(#00100004)
                                     // BRING.SEG(#00200004)
                                                 // 2 AREAS OF COMPILEAE
                                     TEST O!6 THEN WRITEC('*P') 
                                              OR   OUTPUT := OUTPUTT
                                     COMPILEAE(A)   
                                     NEWLINE()  
                                     FOR I = 1 TO 60 DO WRITEC('*0')
                                     NEWLINE()  
                                     OUTPUT := MONITOR  
                                  $)
                    WRITEF("*N*NNUMBER OF ERRORS = %N*N", REPORTCOUNT)  
                    UNLESS REPORTCOUNT = 0 DO ERRORS := TRUE
                    IF CH = '*E' BREAK  
                    // BRING.SEG(#00100001)         // BRING BACK INPUT ETC 
                    CLEARNAMETREE(NAMETREE, TREEBASE)   
                 $) REPEAT  
          $)C   


START:  
$(1 
LVCH    := LV CH
$(  LET OPT = VEC 40
    AND XV = VEC 7  
    AND FIMV = VEC 14   
    AND INFV = VEC 5
    AND IOVEC = VEC IOSIZE  
    AND GV = VEC 50 
    AND LINEV = VEC 121 
//    BRING.SEG(#00100001)                         // AREA 1, UNIT 1
                                                 // (INPUT ROUTINES,LOOKUPWORD) 
//    BRING.SEG(#00200001)                         // AREA 2, UNIT 1
                                                 // STEER, DECLSYSWORDS 
   INITIALIZEIOVEC(IOVEC, IOSIZE)   
    LINE, LINEP, LINEMAX, LINECOUNT := LINEV, 0, 120, 0 
    GETV, GETP, GETT := GV, 0, 50   
    OPTION := OPT   
    GXV, GFIMV, GINFV := XV, FIMV, INFV 
          TEST ENTRYUSED < 2 THEN $( MEDIUM := 30*ENTRYUSED 
                                     INPUT := FINDINPUT(MEDIUM) $)  
                              OR  $( MEDIUM := 0
                                     IF INIT.X.REGS!0 = 0 DO $( TY.HALT("LD")   
                                                                GOTO START $)   
                                     INPUT := FINDFILE(INIT.X.REGS) $)  
    STEER() 
    IF OPTION!22 DO $( ENDREAD(INPUT);  
                         INPUT := !GINFV < 100 -> FINDINPUT(!GINFV),
                                      FINDFILE(GINFV) $)


ERRORS := FALSE 
COMPILESEGMENTS()   

OUTPUT := OUTPUTT   
WRITES('*N*NSTOP*N*N*N')
OUTPUT := MONITOR   
      IF [ (RV OUTPUTT)!1 & #37700000 ] = #600000 DO
            WRITEF("%CLAST BUCKET USED OF %S = %N*N", OPTION!13 \/ OPTION!20 -> 
                                                      '*P', '*N', XV,   
                                          (RV OUTPUTT)!5 - 1)   

      ENDWRITE(OUTPUTT); ENDWRITE(MONITOR); ENDREAD(INPUT)  
      TEST ERRORS THEN TY.HALT("ZZ")
   OR TEST OPTION!21 THEN TY.CHAINPROG(FIMV,XV) 
  OR TY.DELETE("HH")
      FINISH   $)1  
.   
%L  
GET "TSYNHEAD"  
    
GLOBAL $( REPORTGLOBALS:90 $)   
GLOBAL $( TREESIZE = 360 $) 

GLOBAL $(   
STEER:340;  GXV:341;  GFIMV:342;  GINFV:343;
PRINTSTEERING:349;  
$)  
MANIFEST $( STEERSIZE =1000 $)  
MANIFEST $( TREEMAX=5000 $) 
STATIC $( BR = 0             // BRACKET COUNT   
          TERMIN = FALSE     // TERMINATOR CHARACTER INDICATOR  
          LPAREN = FALSE     // '(' OR '[' INDICATOR
          RPAREN = FALSE
          DIGIT = FALSE 
          NL = FALSE
          LISTMEDIUM = 0
          STEERVEC = 0  
       $)   

LET SKIPBLANKS() BE WHILE CH LE ' ' & CH # '*N' DO READ()   

AND READ() = VALOF $( READCH(INPUT, LV CH)  
                      IF STEERVEC!0 GE STEERSIZE DO PERROR("TOO MANY LINES OF *>
                                                            *<STEERING")
                      RV STEERVEC := RV STEERVEC + 1
                      STEERVEC!(RV STEERVEC) := CH = '*E' -> '*N', CH   
                      NL := CH = '*N' \/ CH = '*E'  

                      DIGIT := '0' <= CH <= '9' 

                      LPAREN := CH = '(' \/ CH = '['
                      RPAREN := CH = ')' \/ CH = ']'

                      TERMIN := CH = '=' \/ 
                                CH = ',' \/ 
                                CH = '**' \/
                                CH = ':' \/ 
                      NL \/ 
                                RPAREN \/   
                                LPAREN  
                      IF LPAREN DO BR := BR + 1 
                      IF RPAREN DO BR := BR - 1 
                      IF CH = '*N' DO BR := 0   
                      RESULTIS CH   
                   $)   
AND PERROR(S) BE $( TY.DISPLAY(S); TY.HALT("PE") $) 
LET STEER() BE  
   $(ST 
     $(P  LET RS(S) BE  
             $( LET V = VEC 40  
                AND M = 0   
                   $( IF RPAREN & BR < 0 BREAK  
                      M := M + 1;  V!M := CH
                      READ()
                   $) REPEATUNTIL NL \/ (BR <= 0 & TERMIN)  
                V!0 := M;  PACKSTRING(V,S)  
             $) 
          AND RN() = VALOF  
             $( LET N = 0   
                SKIPBLANKS()
                UNLESS DIGIT DO            PERROR("DIGIT EXPECTED") 
                WHILE DIGIT DO  
                   $( N := N * 10 + CH - '0';  READ() $)
                RESULTIS N  
             $) 
          AND READPARAMETER(N) = VALOF  
               $( LET P = 0 
                  $(
                  IF TERMIN RESULTIS P  
                  IF CH>96 DO CH := CH - 32 
                   UNLESS CH LE ' ' DO P, N := P*2 + CH - 'A', N-1  
                  READ()
                  $) REPEATUNTIL N = 0  
                  UNTIL TERMIN DO READ()
                  RESULTIS P
               $)   
          AND V = VEC STEERSIZE 
          AND PARAMETER = 0 
          AND O = 0 
          ! V := 0  
          STEERVEC := V 
          LISTMEDIUM := 20  
          OUTPUTT := 0  
          TREESIZE := TREEMAX   
          TREEDEPTH := 20   
          FOR I = 0 TO 40 DO OPTION!I := FALSE  
          FOR I = 0 TO  7 DO    GXV!I := 0  
          POUND.EQUALS.DOLLAR,DOLLAR.EQUALS.POUND := FALSE,FALSE
          REPORTMAX := 20   
          SEGCOUNT := 0 
          OPTION!36, OPTION!37 := TRUE, TRUE     // CHANGE *( AND *[ DEFAULT
          OPTION!10 := TRUE                      // SHORTLIST BECOMES DEFAULT   


          $(1 READ()
              PARAMETER := READPARAMETER(0) 
              O := VALOF
               $(O  
                  SWITCHON PARAMETER INTO   
                  $(SW  


                  CASE  2623:  // FULLLIST  
                  CASE   175:  // LIST  
                  CASE 7423:   // SHORTLIST 
                  CASE 1455:   // NOLIST

                 IF LPAREN DO $( READ(); LISTMEDIUM := RN() $)  
                  OPTION!20, OPTION!10, OPTION!13 := FALSE, FALSE, FALSE
                  RESULTIS  
                  PARAMETER  = 7423 -> 10,  
                  PARAMETER  = 175  -> 13,  
                  PARAMETER  = 2623 -> 20,  
                                       0


                  CASE    57:  // BCPL  
                  READ()
                   SKIPBLANKS() 
                 TEST DIGIT THEN !GINFV := RN() 
                            OR RS(GINFV)
                  RESULTIS 22   

                  CASE   306:  // OCODE 
             OCODE: 
                  READ()
                  SKIPBLANKS()  
                  TEST DIGIT             THEN !GXV := RN()  
                                         OR RS(GXV) 
                  ENDCASE   


                  CASE   176:  // ASCII 
                  RESULTIS 39   

                  CASE '\'-'A':// \              [ =$   
                  READ()
                  CASE   110:  // VDU   
                  POUND.EQUALS.DOLLAR := TRUE   
                  ENDCASE   

                  CASE '$'-'A':// $              [ =\   
                  READ()
                  DOLLAR.EQUALS.POUND := TRUE   
                  ENDCASE   

                  CASE   606:  // LEVEL1
                  RESULTIS 28   
                  CASE   608:  // LEVEL3
                  RESULTIS 30   

                  CASE    79:  // NIL   
                  RESULTIS 31   

                  CASE   115:  // OUT            [ =ENDCASE 
                  UNLESS CH = '=' GOTO OCODE
                  READ()
                  RESULTIS 29   
                  CASE   237:  // STAR           [ = MULT   
                  $(
                  LET P = 0 
                  LET TYPE, MULT = CH, FALSE
                  UNLESS        (CH = '=' \/ LPAREN) DO PERROR("'=', '(', *<
                                                             *>OR '[' EXPECTED")
                  READ()
                  UNLESS TYPE='=' $(
                                        P := READPARAMETER(0)   
                                        UNLESS P = 0 /\ CH = '=' DO 
                                                  PERROR("'=' EXPECTED")
                                       READ()   
                                     $) 
                  P := READPARAMETER(3) 
                  TEST P = 99      // MUL   
                  THEN MULT := TRUE 
                  OR TEST P = 94       // VEC   
                  THEN MULT := FALSE
                  OR PERROR("'MULT' OR 'VECAP' EXPECTED")   
                 UNLESS TYPE = '(' DO OPTION!36 := MULT 
                 UNLESS TYPE = '[' DO OPTION!37 := MULT 
                  $)
                  RESULTIS 0


                  CASE   117:  // CHAIN 
                  READ()
                  SKIPBLANKS()  
                  RS(GFIMV) 
                  RESULTIS 21   

                  CASE  3942:  // TREESIZE  
                  READ()
                  TREESIZE := RN()  
                  ENDCASE   

                  CASE  2674:  // ALPHACODE  
                  RESULTIS 15   

                  CASE   130:  // DEBUG 
                  RESULTIS 1

                  CASE   232:  // TREE  
                  IF LPAREN DO $( READ(); TREEDEPTH := RN() $)  
                  RESULTIS 2

                  CASE   722:  // NOCODE
                  RESULTIS 3

                  CASE  1008:  // GLOBALS   
                  RESULTIS 4

                  CASE  1609:  // MONITOR   
                  RESULTIS 6

                  CASE   282:  // NAMES 
                  RESULTIS 7

                  CASE 15936:  // TRANSTRACE
                  RESULTIS 8

                  CASE  2344:  // NAMETREE  
                  RESULTIS 9

                  CASE 1888:   // PPTRACE   
                  PPTRACE := TRUE   
                  RESULTIS 0
                  CASE   424:  // TIMEA 
                  RESULTIS 11   

                  CASE   425:  // TIMEB 
                  RESULTIS 12   

                  DEFAULT:  
                  BR := LPAREN -> 1, 0  
                  UNTIL NL \/ (TERMIN & BR <= 0 ) DO READ() 
                  $)SW  
                   RESULTIS 0   
               $)O  
               OPTION!O := TRUE 
                  UNTIL TERMIN DO  READ()   

          $)1 REPEATUNTIL CH = '**'  \/               // PARAMETER TERMINATOR   
                         CH = '*E' \/   
                         CH = '.'   

  UNTIL NL DO READ()

  MONITOR := CREATEOUTPUT(LISTMEDIUM)   
  OUTPUT := MONITOR 
 OUTPUTT := MONITOR 
  IF OPTION!10 \/ OPTION!13 \/ OPTION!20 DO 
  $(
  WRITEF("BCPL COMPILER MK.%N%C*N*N", 4, 'C')   
  PRINTSTEERING(MONITOR, STEERVEC)  
  $)

 OUTPUTT := !GXV = 0 -> OUTPUTT,
            !GXV = LISTMEDIUM -> OUTPUT,
            !GXV < 100 -> CREATEOUTPUT(!GXV),   
            CREATEFILE(GXV) 

  UNLESS MONITOR = OUTPUTT DO PRINTSTEERING(OUTPUTT, STEERVEC)  

      $)P   

  IF OPTION!4 DO
   $( LET C = 0 
      REPORTGLOBALS(0, 0)   
     WRITES("*NOPTIONS*N")  
     FOR I = 0 TO 40 DO IF OPTION!I DO $( WRITEC(' ') ; WRITEN(I) $)
     NEWLINE()  $)  

   $)ST 
.   
GET "TSYNHEAD"  
    

GLOBAL $(   
STEER:340;  GXV:341;  GFIMV:342;  GINFV:343;
GPLFV:344;  GSCFV:345;  GBINV:346;  GNAMEV:347; 
PRINTSTEERING:349;  
$)  

LET PRINTSTEERING(S, V) BE  
   $( LET T = OUTPUT
      LET I = 0 
      AND L = V!0   
      OUTPUT := S   
      $( WRITES("**#")  
         $( IF I >= L BREAK 
            I := I + 1  
            WRITEC(V!I) 
         $) REPEATUNTIL V!I = '*N'  
      $) REPEATUNTIL I >= L 
      WRITES("*N*****N")
      FOR I=1 TO 60 DO WRITEC(0)
      NEWLINE() 
      OUTPUT := T   
   $)   
.   
GET "TSYNHEAD"  
    

GLOBAL $( AUXPRINTOUTS:350 $)   

LET AUXPRINTOUTS(A) BE  
   $(   
    IF OPTION!7 DO        // NAMES  

              $( LET P(T) BE
                   $( IF T=0 RETURN 
                        P(T!1)  
                        IF T!0=S.NAME DO $( WRITES(T+3);  NEWLINE() $)  
                        P(T!2)   $) 
                   WRITES('*PNAMES*N*N')
                   P(NAMETREE)   $) 

      IF OPTION!9 DO       //NAMETREE   

        $( STATIC $( LINE=0  $) 
                   LET V = VEC 100  
                   LET PRINTNAMES(T, N) BE  
                        $( IF T=0 RETURN
                        LINE!N := NOT LINE!N
                        LINE!(N+1) := TRUE  
                        PRINTNAMES(T!1, N+1)
                        FOR I = 1 TO N-1 TEST LINE!I THEN WRITES('I ')  
                                                OR WRITES('  ') 
                        WRITES('.-+'); WRITES(T+3); NEWLINE()   
                        LINE!N := NOT LINE!N
                        LINE!(N+1) := FALSE 
                        FOR I = 1 TO N  TEST LINE!I THEN WRITES('I ')   
                                                OR WRITES('  ') 
                        UNLESS T!2=0 DO WRITES('I ')
                        NEWLINE()   
                        PRINTNAMES(T!2, N+1)  $)
      FOR I = 0 TO 100 DO V!I := FALSE  
      LINE := V 
      WRITES('*PNAME TREE*N*N') 
      PRINTNAMES(NAMETREE, 1)   
      NEWLINE()   $)

    IF OPTION!2 DO       //TREE 

              $( WRITES("*PAE TREE*N*N")
                   PLIST(A, 0, TREEDEPTH)   
                   NEWLINE()  $)

   $)   
.   
GET "TSYNHEAD"  
    

LET WRITESCH(STREAM,CH) BE  
   $( LET L = VALOF 
         $( CH := CH LOGAND $8 377  
            SWITCHON CH INTO
               $( CASE    8 : RESULTIS 'B'  
                  CASE    9 : RESULTIS 'T'  
                  CASE   10 : RESULTIS 'N'  
                  CASE   11 : RESULTIS 'L'  
                  CASE   12 : RESULTIS 'P'  
                  CASE   13 : RESULTIS 'C'  
                  CASE   14 : RESULTIS 'R'  
                  CASE   15 : RESULTIS 'K'  
                  CASE  255 : RESULTIS 'E'  
                  CASE    0 : RESULTIS '0'  
                  CASE   36 : RESULTIS 'D'  
                  CASE   63 : RESULTIS 'Q'  
                  CASE   64 : RESULTIS 'A'  
                  CASE   92 : RESULTIS '/'  
                  CASE   95 : RESULTIS '-'  
                  CASE   96 : RESULTIS 'U'  
                  DEFAULT   : RESULTIS  CH  
               $)   
         $) 
      IF L NE CH LOGOR CH = '**' LOGOR CH = '*'' LOGOR CH = '*"' DO 
            WRITECH(STREAM,'**')
      WRITECH(STREAM,L) 
   $)   

AND WRITESS(S) BE   
   $( LET W = S!0   
      LET N = W RSHIFT 16   
         $( IF N = 0 BREAK  
            WRITESCH(OUTPUT, W RSHIFT 8)
            IF N = 1 BREAK  
            WRITESCH(OUTPUT, W) 
            IF N = 2 BREAK  
            S,N := S+1,N-3  
            W := S!0
            WRITESCH(OUTPUT, W RSHIFT 16)   
         $) REPEAT  
   $)   

AND WRITESC(CH) BE WRITESCH(OUTPUT,CH)  

LET PLIST(X, N, D) BE   
    $(1 LET SIZE = 0
             LET V = TABLE 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 
                           0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 
                           0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0  
      IF X=0 DO $( WRITES("NIL")
                 RETURN $)  
            SWITCHON H1!X INTO  
         $(   CASE S.NUMBER:
                     WRITEN(H2!X)   
                     RETURN 
            CASE S.NAME:
                     WRITES(X+3)
                     RETURN 
               CASE S.CHAR: 
                WRITEC('*'');  WRITESC(H2!X)
                WRITEC('*'');  WRITES(" = ")
                WRITEN(H2!X);  RETURN   
               CASE S.STRING:   
                WRITEC('"') 
                WRITESS(X+1)
                WRITEC('"') 
                RETURN  
        CASE S.FOR: 
                SIZE := SIZE + 2
         CASE S.COND:CASE S.FNDEF:CASE S.RTDEF: 
         CASE S.TEST:CASE S.CONSTDEF:   
                       SIZE := SIZE + 1 
             CASE S.VECAP:CASE S.FNAP:  
             CASE S.MULT:CASE S.DIV:CASE S.REM:CASE S.PLUS:CASE S.MINUS:
         CASE S.EQ:CASE S.NE:CASE S.LS:CASE S.GR:CASE S.LE:CASE S.GE:   
              CASE S.LSHIFT:CASE S.RSHIFT:CASE S.LOGAND:CASE S.LOGOR:   
            CASE S.EQV:CASE S.NEQV:CASE S.COMMA:
           CASE S.AND:CASE S.VALDEF:CASE S.VECDEF:  
        CASE S.ASS:CASE S.RTAP:CASE S.COLON:CASE S.IF:CASE S.UNLESS:
         CASE S.WHILE:CASE S.UNTIL:CASE S.REPEATWHILE:  
         CASE S.REPEATUNTIL:
           CASE S.SWITCHON:CASE S.CASE:CASE S.SEQ:CASE S.LET:   
           CASE S.MANIFEST:CASE S.STATIC:CASE S.GLOBAL: 
                 SIZE := SIZE + 1   
            CASE S.VALOF:CASE S.LV:CASE S.RV:CASE S.NEG:CASE S.NOT: 
             CASE S.TABLE:CASE S.GOTO:CASE S.RESULTIS:CASE S.REPEAT:
                 SIZE := SIZE + 1   
      CASE S.LOOP:  CASE S.OUT:  CASE S.NIL:
               CASE S.BREAK:CASE S.RETURN:CASE S.FINISH:
             CASE S.TRUE:CASE S.FALSE:  
               DEFAULT: 
                        SIZE := SIZE + 1
                        IF N=D DO $( WRITES("ETC")  
                                           RETURN  $)   
                 WRITES ("OP")  
                 WRITEN(H1!X)   
               FOR I = 2 TO SIZE DO 
                     $( NEWLINE()   
                        FOR J=0 TO N-1 DO WRITES( V!J ) 
                        WRITES( I = SIZE -> "**-" , "+-" )  
                        V!N := I=SIZE->"  ","! "
                        PLIST(H1!(X+I-1), N+1, D)  $)   
       RETURN  $)1  
.   
GET "TSYNHEAD"  
    
LET RCH() BE
     $(   IF LINEP>LINELENGTH DO RDLINE()   
          CH := LINE!LINEP  
          LINEP := LINEP + 1     $) 

AND RDLINE() BE 
    $(    LINELENGTH := 0   
          LINECOUNT := LINECOUNT + 1
          $(   READCH(INPUT,LVCH)   
               LINELENGTH := LINELENGTH + 1 
               LINE!LINELENGTH := CH   $)   
          REPEATUNTIL CH='*N' LOGOR LINELENGTH=LINEMAX  
          IF OPTION!39 DO   
                FOR P = 1 TO LINELENGTH DO  
                   $( LET T = LINE!P
                      TEST  T = '\' THEN LINE!P := '$'  
                      OR IF T = '$' THEN LINE!P := '\'  
                   $)   
          IF OPTION!13 -> GETP=0 , OPTION!20 DO 
          IF CH NE ENDOFSTREAMCH DO 
          $( WRITEF("%I4   %I3     " , LINECOUNT, COMCOUNT1 )   
               FOR I = 1 TO LINELENGTH DO WRITEC(LINE!I)
         $) 
          LINEP := 1
   $)   

LET NEWVEC(N) = VALOF   
      $( TREEP := TREEP - N - 1 
         IF TREEP LE TREEVEC DO 
                  $( REPORTMAX := 0 
                     REPORT(98) $)  
         RESULTIS TREEP $)  

AND LOOKUPWORD() = VALOF
      $(1 LET M = LV NAMETREE   
NEXT: WORDNODE := RV M  
      IF WORDNODE NE 0 DO   
          $(2 LET P = WORDNODE+3
              FOR I = 0 TO WORDLENGTH-1 DO  
               $( LET X, Y = P!I, WORDV!I   
                  IF X>Y DO $( M := WORDNODE+1; GOTO NEXT $)
                  IF X<Y DO $( M := WORDNODE+2; GOTO NEXT $)  $)
              RESULTIS WORDNODE!0   $)2 
      WORDNODE := NEWVEC(WORDLENGTH+2)  
      WORDNODE!0, WORDNODE!1, WORDNODE!2 := S.NAME, 0, 0
      FOR I = 0 TO WORDLENGTH-1 DO WORDNODE!(I+3) := WORDV!I
      RV M := WORDNODE  
      RESULTIS S.NAME   $)1 
.   
GET "TSYNHEAD"  
    
LET NEXTSYMB() BE   
$(1   NLPENDING := FALSE
NEXT:   
  $(2 IF PPTRACE DO $( IF CH NE ENDSTREAMCH DO WRITEC(CH) $)
      SWITCHON CH INTO  
      $( CASE '*N': NLPENDING := TRUE   
         CASE '*T': 
         CASE '*S': RCH() REPEATWHILE CH='*S'   
                    LOOP
         CASE '0':CASE '1':CASE '2':CASE '3':CASE '4':  
         CASE '5':CASE '6':CASE '7':CASE '8':CASE '9':  
               DECVAL :=CH - '0'
               OCTVAL := DECVAL 
               SYMB := S.NUMBER 
               $( RCH() 
                  UNLESS '0' LE CH LE '9' RETURN
                  DECVAL := DECVAL*10 + CH - '0'
                  OCTVAL := OCTVAL LSHIFT 3 LOGOR CH - '0'   $) REPEAT  
         LETTERS:   
                RDTAG() 
                SYMB := LOOKUPWORD()
                IF SYMB=S.GET DO $( PERFORMGET(); LOOP $)   
                RETURN  
         CASE '$': IF DOLLAR.EQUALS.POUND DO GOTO POUND 
         DOLLAR:   RCH()
                  IF CH='8' DO $( SYMB := S.OCT; BREAK    $)
                  IF CH='(' LOGOR CH=')' DO 
                        $( SYMB := CH='(' -> S.LSECT, S.RSECT   
                           CH := '$'
                           RDTAG()  
                           LOOKUPWORD() 
                           RETURN   $)  
                  REPORT(91)
                  RCH() 
                  LOOP  
         CASE '?': SYMB := S.NIL; BREAK 
         CASE '@': SYMB := S.LV; BREAK  
         CASE '[':  
         CASE '(': SYMB := S.LPAREN; BREAK  
         CASE ']':  
         CASE ')': SYMB := S.RPAREN; BREAK  
         CASE '+': SYMB := S.PLUS; BREAK
         CASE ',': SYMB := S.COMMA; BREAK   
         CASE ';': SYMB := S.SEMICOLON; BREAK   
         CASE '&': SYMB := S.LOGAND; BREAK  
         CASE '#': SYMB := S.HASH; BREAK
         CASE '=': SYMB := S.EQ; BREAK  
         CASE '<': RCH(); IF CH='=' DO $( SYMB := S.LE; BREAK  $)   
                          IF CH='<' DO $( SYMB := S.LSHIFT; BREAK  $)   
                   SYMB := S.LS; RETURN 
         CASE '>': RCH(); IF CH='=' DO $( SYMB := S.GE; BREAK  $)   
                          IF CH='>' DO $( SYMB := S.RSHIFT; BREAK  $)   
                   SYMB := S.GR; RETURN 
         CASE '!': SYMB := S.VECAP; BREAK   
         CASE 'y': SYMB := S.ASS; BREAK 
         CASE '**':RCH()
                   SYMB := CH='(' LOGAND NOT OPTION!36 LOGOR
                           CH='[' LOGAND NOT OPTION!37 -> S.VECAP , S.MULT  
                   RETURN   
         CASE '/': RCH()
                   IF CH='\' DO $( SYMB := S.LOGAND; BREAK  $)  
                   UNLESS CH='/' DO $( SYMB := S.DIV; RETURN   $)   
         CASE 126: RCH() REPEATUNTIL CH='*N'
                   LOOP 
         CASE '-': RCH()
                   IF CH='>' LOGOR CH='**' DO $( SYMB := S.COND; BREAK  $)  
                   SYMB := S.MINUS  
                   RETURN   
         CASE ':': RCH()
                   IF CH='=' DO $( SYMB := S.ASS; BREAK    $)   
                   SYMB := S.COLON  
                   RETURN   
         CASE '*'':CASE '*"':   
              $(1 LET QUOTE = CH
                  LENGTH := 0   
                  WORDLENGTH := 0   
                  WORD := 0 
                  PACKCH := P2  
                R: $( RCH() 
                 IF LENGTH=255 & CH NE QUOTE DO 
                      $( CH := QUOTE; REPORT(95)   $)   
                 IF CH=QUOTE DO 
                        $( IF LENGTH=1 & CH='*'' DO 
                                   $( SYMB := S.CHAR
                                     BREAK     $)   
                   PACKLENGTH() 
                   SYMB := S.STRING 
                   BREAK    $)  
                IF CH = '**' DO 
                   CH := VALOF $(V RCH()
                      SWITCHON CH INTO $(   
                        CASE  98 :  
                        CASE 'B' : RESULTIS    8  // BACKSPACE  
                        CASE 116 :  
                        CASE 'T' : RESULTIS    9  // TAB
                        CASE 110 :  
                        CASE 'N' : RESULTIS   10  // NEWLINE
                        CASE 108 :  
                        CASE 'L' : RESULTIS   11  // LINE FEED  
                        CASE 112 :  
                        CASE 'P' : RESULTIS   12  // PAGE THROW / FORM FEED 
                        CASE  99 :  
                        CASE 'C' : RESULTIS   13  // CARRIGE RETURN 
                        CASE 114 :  
                        CASE 'R' : RESULTIS   14  // RED RIBBON SHIFT   
                        CASE 107 :  
                        CASE 'K' : RESULTIS   15  // BLACK RIBBON SHIFT 
                        CASE 115 :  
                        CASE 'S' : RESULTIS   32  // SPACE  
                        CASE 101 :  
                        CASE 'E' : RESULTIS  255  // END OF STREAMCH
                        CASE 100 :  
                        CASE 'D' : RESULTIS   36  // DOLLAR 
                        CASE 113 :  
                        CASE 'Q' : RESULTIS   63  // QUESTION MARK  
                        CASE  97 :  
                        CASE 'A' : RESULTIS   64  // AT SIGN
                        CASE 117 :  
                        CASE 'U' : RESULTIS   96  // UNDERLINE  
                        CASE '0' : RESULTIS    0  // NULL   
                        CASE '/' : RESULTIS   92  // BACKSLASH  
                        CASE '-' : RESULTIS   95  // BACK-ARROW 
                        DEFAULT  : RESULTIS  CH 
                        CASE '>' :  
                        CASE '<' : $( UNTIL CH = '**' \/ CH = '*E' DO RCH() 
                                      IF CH = '*E' BREAK
                                      RCH() 
                                      IF CH = '>' LOGOR CH = '<' GOTO R 
                                   $) REPEAT
                                   REPORT(96)   
                                   SYMB := S.END
                                   RETURN   
                               $)V  
              DECVAL := CH  
              PACKCH()   $) REPEAT   $)1

                   BREAK


         CASE '\': IF POUND.EQUALS.DOLLAR DO GOTO DOLLAR
         POUND:    RCH(); IF CH='/' DO $( SYMB := S.LOGOR; BREAK  $)
                          IF CH='=' DO $( SYMB := S.NE; BREAK  $)   
                          SYMB := S.NOT; RETURN 

         CASE '%': RCH()
                         IF CH = '(' \/ CH = ')' LOOP   
                   SWITCHON CH INTO 
                      $( DEFAULT : REPORT(94); ENDCASE  
                         CASE 'S':  
                         CASE 'N':  
                         CASE 'L':  
                         CASE 'F': OPTION!10,OPTION!13, OPTION!20 :=
                                    CH='S',  CH='L' ,  CH='F'  ;  ENDCASE   
                         CASE 'P': WRITEC('*P'); ENDCASE
                         CASE 'A':  
                         CASE 'Z': OPTION!39 := CH = 'A'; ENDCASE   
                         CASE 'D':  
                         CASE 'U': POUND.EQUALS.DOLLAR := CH = 'D'; ENDCASE 
                         CASE 'M':  
                         CASE 'V':  
                         CASE 'Q':  
                         CASE 'R': OPTION!36,OPTION!37 :=   
                                   CH='M' LOGOR CH='R' , CH='M' LOGOR CH='Q'
                                   ENDCASE  
                         CASE '#': OUTPUT := OUTPUTT
                                      WRITES("**#") 
                                      $( RCH(); WRITEC(CH) $) REPEATUNTIL   
                                                                     CH = '*N'  
                                   OUTPUT := MONITOR
                      $)
                   UNTIL CH = '*N' DO RCH() 
                   LOOP 
         CASE '.': RCH()
                   IF CH='.' DO $( SWITCH(); LOOP       $)  
                   SYMB := S.END;  RETURN   
      DEFAULT: IF 'A' LE CH LE 'Z' LOGOR 97 LE CH LE 122 DO GOTO LETTERS
               IF CH = ENDSTREAMCH DO   
                   $( IF GETP=0 DO  
                            $( SYMB := S.END
                               RETURN   $)  
                      GETP, LINECOUNT, INPUT := GETP - 2, GETV!(GETP+1),
                                                    GETV!GETP   
                      RDLINE()  
                      RCH() 
                      LOOP $)   
                   UNLESS CH < '*S' DO REPORT(94)   
                   RCH()
                   LOOP 
     $)                                // END OF SWITCHON BLOCK 
  $)2 REPEAT                           // END OF LOOP   
RCH()   
$)1 
.   
GET "TSYNHEAD"  
    

LET WRLINE() BE 
    $(    NEWLINE() 
          IF LINE!LINELENGTH NE ENDOFSTREAMCH DO
             $( WRITES("          ");   
          FOR I = 1 TO LINELENGTH DO WRITEC(LINE!I) 
             $) 
          FOR I = -9 TO LINEP - 3 DO WRITEC('*S')   
          WRITES('
N')    $)   

AND RDTAG() BE  
    $(    LENGTH, WORDLENGTH := 1, 0
          WORD := CH LSHIFT 8   
          PACKCH := P3  
          $(   RCH()
               UNLESS 'A' LE CH LE 'Z' LOGOR
                      '0' LE CH LE '9' LOGOR
                       96 LE CH LE 122 LOGOR
                      CH='.'    BREAK   
               PACKCH()         $) REPEAT   
          PACKLENGTH()     $)   

AND P1() BE 
    $(    WORDV!WORDLENGTH := WORD  
          WORDLENGTH := WORDLENGTH + 1  
          WORD := CH LSHIFT 16  
          LENGTH := LENGTH + 1  
          PACKCH := P2     $)   

AND P2() BE 
     $(   WORD := WORD LOGOR CH LSHIFT 8
          LENGTH, PACKCH := LENGTH + 1, P3   $) 

AND P3() BE 
     $(   WORD := WORD LOGOR CH 
          LENGTH, PACKCH := LENGTH + 1, P1     $)   

AND PACKLENGTH() BE 
     $(   WORDV!WORDLENGTH := WORD  
          WORDLENGTH := WORDLENGTH + 1  
          WORDV!0 := WORDV!0 LOGOR LENGTH LSHIFT 16   $)

AND PERFORMGET() BE 
     $(   NEXTSYMB()
          UNLESS SYMB=S.STRING LOGOR SYMB=S.NUMBER DO $( REPORT(97); RETURN $)  
          IF OPTION!5 RETURN
          GETV!GETP := INPUT
          GETV!(GETP+1) := LINECOUNT
          GETP := GETP + 2  
          INPUT := SYMB = S.STRING -> FINDFILE(WORDV) , FINDINPUT(DECVAL)   
          LINECOUNT := 0
          RDLINE()  
          RCH()     $)  

AND SWITCH() BE 
    $(    ENDREAD(INPUT)
          MEDIUM := 30-MEDIUM   
          INPUT := FINDINPUT(MEDIUM)
          RCH()              $) 
.   
GET "TSYNHEAD"  
    

LET LIST1(X) = VALOF
      $( LET P = NEWVEC(0)  
         P!0 := X   
         RESULTIS P $)  

AND LIST2(X, Y) = VALOF 
      $( LET P = NEWVEC(1)  
         P!0, P!1 := X, Y   
         RESULTIS P  $) 

AND LIST3(X, Y, Z) = VALOF  
      $( LET P = NEWVEC(2)  
         P!0, P!1, P!2 := X, Y, Z   
         RESULTIS P   $)

AND LIST4(X, Y, Z, T) = VALOF   
      $( LET P = NEWVEC(3)  
         P!0, P!1, P!2, P!3 := X, Y, Z, T   
         RESULTIS P    $)   

AND LIST5(X, Y, Z, T, U) = VALOF
      $( LET P = NEWVEC(4)  
         P!0, P!1, P!2, P!3, P!4 := X, Y, Z, T, U   
         RESULTIS P   $)

AND LIST6(X, Y, Z, T, U, V) = VALOF 
      $( LET P = NEWVEC(5)  
         P!0, P!1, P!2, P!3, P!4, P!5 := X, Y, Z, T, U, V   
         RESULTIS P   $)

AND CAEREPORT(N) BE 
      $( REPORTCOUNT := REPORTCOUNT +1  
         WRITEF("****************  SYNTAX ERROR %N ON LINE %N :    %S" ,
                N , LINECOUNT , MESSAGE(N) )
         WRLINE()   
         IF REPORTCOUNT GR REPORTMAX DO 
                  $( WRITES('*NCOMPILATION ABORTED*N')  
                     FINISH   $)   $)   

AND FORMTREE() =  VALOF 
      $(1   
      $( LET R = REPORT 
         REPORT := CAEREPORT
         IF OPTION!11 DO RCH() REPEATUNTIL CH=ENDSTREAMCH   
         IF OPTION!12 DO NEXTSYMB() REPEATUNTIL SYMB=S.END  
      L:
         COMCOUNT1 := 0 
         IF OPTION!1 DO                          // PP DEBUGGING OPTION 
                      $(
                         $( WRITEF("%D3   %S*N", SYMB, WORDV)   
                            IF SYMB = S.END RESULTIS 0  
                            NEXTSYMB()  
                         $)  REPEAT 
                      $)
      $( LET A = RDBLOCKBODY()  
         UNLESS SYMB=S.END DO $( REPORT(99) 
                                 NEXTSYMB() 
                                 GOTO L 
                              $)
         REPORT := R
         RESULTIS A       $)1   


AND MESSAGE(N) = VALOF  
      $( SWITCHON N INTO
$( DEFAULT: RESULTIS " "
         CASE 91: RESULTIS "'8' , '(' OR ')' EXPECTED"  
         CASE 94: RESULTIS "ILLEGAL CHARACTER"  
         CASE 95: RESULTIS "STRING LONGER THAN 255 CHARACTERS"  
         CASE 96: RESULTIS "STRING NOT TERMINATED - END OF PROGRAM REACHED" 
         CASE 97: RESULTIS "STRING OR DECIMAL NUMBER EXPECTED"  
         CASE 98: RESULTIS "PROGRAM TOO LARGE"  
         CASE 99: RESULTIS "INCORRECT TERMINATION"  
         CASE  1:   
         CASE 40:   
         CASE 43:   
         CASE 64: RESULTIS "NAME EXPECTED"  
         CASE  8: RESULTIS "NAME , '?' OR 'NIL' EXPECTED"   
         CASE  2:   
         CASE  6: RESULTIS "'$(' EXPECTED"  
         CASE  4:   
         CASE  7: RESULTIS "'$)' EXPECTED"  
         CASE 32: RESULTIS "EXPRESSION MISSING" 
         CASE 33: RESULTIS "ERROR IN OCTAL NUMBER"  
         CASE 15:   
         CASE 19:   
         CASE 41: RESULTIS "')' OR ']' MISSING" 
         CASE 30: RESULTIS "',' MISSING"
         CASE 42: RESULTIS "'=' OR 'BE' EXPECTED"   
         CASE 44: RESULTIS "'=' , '(' OR '[' EXPECTED"  
         CASE 50: RESULTIS "ERROR IN LABEL" 
         CASE 51: RESULTIS "':=' OR ':' EXPECTED"   
         CASE 54: RESULTIS "'OR' EXPECTED"  
         CASE 57: RESULTIS "'=' EXPECTED"   
         CASE 58: RESULTIS "'TO' EXPECTED"  
         CASE 60: RESULTIS "'INTO' EXPECTED"
         CASE 61:   
         CASE 62: RESULTIS "':' EXPECTED"   

         CASE 20: RESULTIS "'AND' OUT OF PLACE" 
         CASE 401:RESULTIS "'IFNOT' EXPECTED"   
         CASE 402:RESULTIS "'IFSO' EXPECTED"
         CASE 403:RESULTIS "'THEN' , 'DO' , 'IFSO' OR 'IFNOT' EXPECTED" 
         CASE 404:RESULTIS "'TO' OR 'BY' EXPECTED"  

                       $)   $)  
.   
GET "TSYNHEAD"  
    

LET DECLSYSWORDS() BE   
      $( LET V = WORDV  
         LET D(S, ITEM) BE $( LENGTH := S!0 RSHIFT 16   
                              WORDLENGTH := LENGTH/3 + 1
                              WORDV := S
                              LOOKUPWORD()  
                              WORDNODE!0 := ITEM  $)

         D('AND', S.AND)

         D('BE', S.BE)  
         D('BREAK', S.BREAK)

         D('CASE', S.CASE)  

         D('DO', S.DO)  
         D('DEFAULT', S.DEFAULT)

         D('EQ', S.EQ)  
         D('EQV', S.EQV)

         D('FALSE', S.FALSE)
         D('FOR', S.FOR)
         D('FINISH', S.FINISH)  

         D('GOTO', S.GOTO)  
         D('GE', S.GE)  
         D('GR', S.GR)  
         D('GLOBAL', S.GLOBAL)  
         D('GET', S.GET)

         D('IF', S.IF)  
         D('INTO', S.INTO)  

         D('LET', S.LET)
         D('LV', S.LV)  
         D('LE', S.LE)  
         D('LS', S.LS)  
         D('LOGOR', S.LOGOR)
         D('LOGAND', S.LOGAND)  
         D('LSHIFT', S.LSHIFT)  

         D('MANIFEST', S.MANIFEST)  

         D('NE', S.NE)  
         D('NOT', S.NOT)
         D('NEQV', S.NEQV)  

         D('OR', S.OR)  

         D('RESULTIS', S.RESULTIS)  
         D('RETURN', S.RETURN)  
         D('REM', S.REM)
         D('RSHIFT', S.RSHIFT)  
         D('RV', S.RV)  
         D('REPEAT', S.REPEAT)  
         D('REPEATWHILE', S.REPEATWHILE)
         D('REPEATUNTIL', S.REPEATUNTIL)

         D('SWITCHON', S.SWITCHON)  
         D('STATIC', S.STATIC)  

         D('TO', S.TO)  
         D('TEST', S.TEST)  
         D('TRUE', S.TRUE)  
         D('THEN', S.DO)
         D('TABLE', S.TABLE)

         D('UNTIL', S.UNTIL)
         D('UNLESS', S.UNLESS)  

         D('VEC', S.VEC)
         D('VALOF', S.VALOF)

         D('WHILE', S.WHILE)

UNLESS OPTION!28 DO $(  
         D('BY', S.BY)  
         D('IFNOT', S.IFNOT)
         D('IFSO', S.IFSO)  
         D('LOOP', S.LOOP)  
IF OPTION!31 DO 
         D('NIL', S.NIL)
         D('ENDCASE',S.OUT) 
IF OPTION!29 DO 
         D('OUT',S.OUT) 
IF OPTION!30 DO  $( 
         D('EXTERNAL', S.EXTERNAL)  
         D('REP', S.REP)
         D('SELECTON', S.SELECTON)  
                 $) 
                 $) 

         WORDV := V   $)

.   
GET "TSYNHEAD"  
    

LET RDBLOCKBODY() = VALOF   
      $(1 LET A = 0 
         SWITCHON SYMB INTO 
      $( CASE S.MANIFEST:   
         CASE S.STATIC: 
         CASE S.GLOBAL: 
             $( LET OP = SYMB   
                NEXTSYMB()  
                A := RDSECT(RDCDEFS)
                RESULTIS LIST3(OP, A, RDBLOCKBODY())  $)
         CASE S.AND: REPORT(20)                  // 'AND' OUT OF PLACE  
         CASE S.LET: NEXTSYMB() 
                     A := RDEF()
                     WHILE SYMB=S.AND DO
                           $( NEXTSYMB()
                              A := LIST3(S.AND, A, RDEF())  $)  
                     RESULTIS LIST3(S.LET, A, RDBLOCKBODY())
         DEFAULT: RESULTIS RDSEQ()   $)1

AND RDSEQ() = VALOF 
      $( LET A = 0  
         IGNORE(S.SEMICOLON)
         A := RCOM()
         IF SYMB=S.RSECT LOGOR SYMB=S.END LOGOR A=0 RESULTIS A  
         COMCOUNT1 := COMCOUNT1 + 1 
         RESULTIS LIST3(S.SEQ, A, RDSEQ())   $) 

AND RDCDEFS() = VALOF   
      $(1 LET A, B = 0, 0   
         $( B := RNAME()
            IGNORE(S.EQ)
            IGNORE(S.COLON) 
            A := LIST4(S.CONSTDEF, A, B, REXP(0))   
            IGNORE(S.SEMICOLON) $) REPEATWHILE SYMB=S.NAME  
      RESULTIS A $)1

AND RDSECT(R) = VALOF   
      $( LET TAG, A = WORDNODE, 0   
         CHECKFOR(S.LSECT, 6)   
         A := R()   
         UNLESS SYMB=S.RSECT DO 
                   $( REPORT(7) 
                      UNTIL SYMB=S.RSECT LOGOR SYMB=S.END DO NEXTSYMB() $)  
         TEST TAG=WORDNODE THEN NEXTSYMB()  
          OR  $( IF WORDNODE!3 RSHIFT 16 = 1 DO 
              $( WRITES(
"****************  WARNING :- POSSIBLE SECTION BRACKET ERROR DETECTED ON LINE ")
                 WRITEN(LINECOUNT)  
                 WRITES(
"*N////////  TAG OF UNMATCHED OPENING BRACKET IS '")
                 $( LET V = VEC BYTEMAX 
                    UNPACKSTRING(TAG+3,V)   
                    FOR I = 2 TO V!0 DO WRITEC(V!I) 
                 $) 
                 WRITEC('*'')   
                 WRLINE() $) $) 
         RESULTIS A   $)

AND RNAMELIST() = VALOF 
      $( LET A = RNAME()
         UNLESS SYMB=S.COMMA RESULTIS A 
         NEXTSYMB() 
         RESULTIS LIST3(S.COMMA, A, RNAMELIST())   $)   

AND RNAME() = VALOF 
      $( LET A = WORDNODE   
         IF SYMB = S.NIL DO $( NEXTSYMB();  RESULTIS LIST1(S.NIL) $)
         CHECKFOR(S.NAME, 8)
         RESULTIS A $)  

AND IGNORE(ITEM) BE 
      $( IF SYMB=ITEM DO NEXTSYMB()  $) 

AND CHECKFOR(ITEM, N) BE
      $( UNLESS SYMB=ITEM DO REPORT(N)  
         NEXTSYMB()  $) 
.   
GET "TSYNHEAD"  
    

LET RBEXP() = VALOF 
      $(1 LET A, OP = 0, SYMB   
         SWITCHON SYMB INTO 
      $( DEFAULT:    REPORT(32) 
         CASE S.NIL:  NEXTSYMB()
                      RESULTIS LIST1(S.NIL) 
         CASE S.TRUE:   
         CASE S.FALSE:  
         CASE S.NAME: A := WORDNODE 
                     NEXTSYMB() 
                     RESULTIS A 
         CASE S.STRING: 
                  A := NEWVEC(WORDLENGTH)   
                  A!0 := S.STRING   
                  FOR I = 0 TO WORDLENGTH-1 DO A!(I+1) := WORDV!I   
                  NEXTSYMB()
                  RESULTIS A
         CASE S.HASH:   
         CASE S.OCT:
                 NEXTSYMB() 
                  UNLESS SYMB=S.NUMBER DO REPORT(33)
                  DECVAL := OCTVAL  
                      OP := S.NUMBER
         CASE S.CHAR:   
         CASE S.NUMBER: 
                  A := LIST2(OP, DECVAL)
                  NEXTSYMB()
                  RESULTIS A
         CASE S.LPAREN: NEXTSYMB()  
                     A := REXP(0)   
                     CHECKFOR(S.RPAREN, 15) 
                     RESULTIS A 
         CASE S.VALOF: NEXTSYMB()   
                     RESULTIS LIST2(S.VALOF, RCOM())
         CASE S.VECAP: OP := S.RV   
         CASE S.LV: 
         CASE S.RV: NEXTSYMB(); RESULTIS LIST2(OP, REXP(35))
         CASE S.PLUS: NEXTSYMB(); RESULTIS REXP(34) 
         CASE S.MINUS: NEXTSYMB()   
                     A := REXP(34)  
                     TEST H1!A=S.NUMBER 
                         THEN H2!A := - H2!A
                           OR A := LIST2(S.NEG, A)  
                               RESULTIS A   
         CASE S.NOT: NEXTSYMB(); RESULTIS LIST2(S.NOT, REXP(24))
         CASE S.TABLE: NEXTSYMB(); RESULTIS LIST2(S.TABLE, REXP(11))  $)1   

AND REXP(N) = VALOF 
      $(1 LET A = RBEXP()   
         LET B,C,P,Q = 0, 0, 0, 0   
      L: $( LET OP = SYMB   
         IF NLPENDING RESULTIS A
          SWITCHON OP INTO  
      $(B DEFAULT: RESULTIS A   
         CASE S.LPAREN: NEXTSYMB()  
                     B := 0 
                     UNLESS SYMB=S.RPAREN DO B := REXP(0)   
                     CHECKFOR (S.RPAREN, 19)
                     A := LIST3(S.FNAP, A, B)   
                     GOTO L 
         CASE S.VECAP: P := 40; GOTO LASSOC 
         CASE S.REM: CASE S.MULT: CASE S.DIV: P := 35; GOTO LASSOC  
         CASE S.PLUS: CASE S.MINUS: P := 34; GOTO LASSOC
         CASE S.HASH: OP,SYMB := S.NE,S.NE  
         CASE S.EQ: CASE S.NE:  
         CASE S.LE: CASE S.GE:  
         CASE S.LS: CASE S.GR:  
                     IF N GE 30 RESULTIS A  
            $(R NEXTSYMB()  
                B := REXP(30)   
                A := LIST3(OP, A, B)
                TEST C=0 THEN C := A
                     OR C := LIST3(S.LOGAND, C, A)  
                A, OP := B, SYMB  $)R REPEATWHILE S.EQ LE OP LE S.GE
                A := C  
                GOTO L  
         CASE S.LSHIFT: CASE S.RSHIFT: P, Q := 25, 30; GOTO DIADIC  
         CASE S.LOGAND: P := 23; GOTO LASSOC
         CASE S.LOGOR: P := 22; GOTO LASSOC 
         CASE S.EQV: CASE S.NEQV: P := 21; GOTO LASSOC  
         CASE S.COND:   
                     IF N GE 13 RESULTIS A  
                     NEXTSYMB() 
                     B := REXP(12)  
                     CHECKFOR(S.COMMA, 30)  
                     A := LIST4(S.COND, A, B, REXP(12)) 
                     GOTO L 
         CASE S.COMMA: P, Q := 12, 11; GOTO DIADIC  
         LASSOC: Q := P 
         DIADIC: IF N GE P RESULTIS A   
                     NEXTSYMB() 
                     A := LIST3(OP, A, REXP(Q)) 
                     GOTO L                    $)B     $)1  
.   
GET "TSYNHEAD"  
    

LET RDEF() = VALOF  
      $(1 LET N = RNAMELIST()   
         SWITCHON SYMB INTO 
       $( CASE S.LPAREN:
               $( LET A = 0 
                    NEXTSYMB()  
                     UNLESS H1!N=S.NAME DO REPORT(40)   
                     IF SYMB=S.NAME DO A := RNAMELIST() 
                     CHECKFOR(S.RPAREN, 41) 
                     IF SYMB=S.BE DO
                        $( NEXTSYMB()   
                           RESULTIS LIST5(S.RTDEF, N, A, RCOM( ), 0)  $)
                     IF SYMB=S.EQ DO
                        $( NEXTSYMB()   
                           RESULTIS LIST5(S.FNDEF, N, A, REXP(0), 0)  $)
                     REPORT(42) 
                     RESULTIS LIST3(S.VALDEF, N, N)  $) 
         DEFAULT: REPORT(44)
         CASE S.EQ: 
              $( LET OP = S.VALDEF  
              NEXTSYMB()
              IF SYMB=S.VEC DO  
                     $( OP := S.VECDEF  
                        NEXTSYMB()  
                        UNLESS H1!N=S.NAME DO REPORT(43)  $)
              RESULTIS LIST3(OP, N, REXP(0))  $)1   
.   
GET "TSYNHEAD"  
    

LET RBCOM() = VALOF 
  $(1 LET A, B, OP = 0, 0, SYMB 
      SWITCHON SYMB INTO
   $( DEFAULT: RESULTIS 0   
      CASE S.NAME:CASE S.NUMBER:CASE S.STRING:CASE S.CHAR:  
      CASE S.TRUE:CASE S.FALSE:CASE S.LV:CASE S.RV:CASE S.VECAP:
      CASE S.LPAREN:CASE S.VALOF:CASE S.PLUS:CASE S.MINUS:  
      // THESE ARE ALL THE SYMBOL WHICH CAN START AN EXPRESSION 
           A := REXP(0) 
           IF SYMB=S.ASS DO 
                $( NEXTSYMB()   
                  RESULTIS LIST3(S.ASS, A, REXP(0))  $) 
           IF SYMB=S.COLON DO   
              $( UNLESS H1!A=S.NAME DO REPORT(50)   
             NEXTSYMB() 
             RESULTIS LIST4(S.COLON, A, RCOM()) $)  
      IF H1!A=S.FNAP DO 
           $( H1!A := S.RTAP
             RESULTIS A  $) 
      REPORT(51)
      RESULTIS A
      CASE S.GOTO:CASE S.RESULTIS:  
           NEXTSYMB()   
           RESULTIS LIST2(OP, REXP(0))  
      CASE S.IF:CASE S.UNLESS:  
      CASE S.WHILE:CASE S.UNTIL:
           NEXTSYMB()   
           A := REXP(0) 
           IGNORE(S.DO) 
           RESULTIS LIST3(OP, A, RCOM())
      CASE S.TEST:  
           NEXTSYMB()   
           A := REXP(0) 
              TEST SYMB = S.DO THEN $(  
                                       NEXTSYMB();  B := RCOM() 
                                       CHECKFOR(S.OR, 54)   
                                       RESULTIS LIST4(S.TEST,A,B,RCOM())
                                    $)  
           OR TEST SYMB = S.IFSO THEN $(
                                       NEXTSYMB();  B := RCOM() 
                                       CHECKFOR(S.IFNOT, 401)   
                                       RESULTIS LIST4(S.TEST,A,B,RCOM())
                                      $)
           OR TEST SYMB = S.IFNOT THEN $(   
                                       NEXTSYMB();  B := RCOM() 
                                       CHECKFOR(S.IFSO , 402)   
                                       RESULTIS LIST4(S.TEST,A,RCOM(),B)
                                       $)   
           OR $( REPORT(403); RESULTIS 0 $) 
      CASE S.FOR:   
         $( LET I, J = 0, 0 
            AND K = 0   
           NEXTSYMB()   
           A := RNAME() 
           CHECKFOR(S.EQ, 57)   
           I := REXP(0) 
           TEST SYMB = S.TO THEN $( NEXTSYMB(); J := REXP(0)
                                    IF SYMB = S.BY DO   
                                       $( NEXTSYMB(); K := REXP(0) $)$) 
        OR TEST SYMB = S.BY THEN $( NEXTSYMB(); K := REXP(0)
                                    CHECKFOR(S.TO, 58); J := REXP(0) $) 
        OR $( REPORT(404); RESULTIS 0 $)
           IGNORE(S.DO) 
           RESULTIS LIST6(S.FOR, A, I, J, K, RCOM()) $) 
      CASE S.BREAK:CASE S.RETURN:CASE S.FINISH: 
      CASE S.LOOP:  CASE S.OUT: 
           A := WORDNODE
           NEXTSYMB()   
           RESULTIS A   
      CASE S.SWITCHON:  
           NEXTSYMB()   
           A := REXP(0) 
           CHECKFOR(S.INTO, 60) 
           RESULTIS LIST3(S.SWITCHON, A, RCOM())
      CASE S.CASE:  
           NEXTSYMB()   
           IF SYMB NE S.NIL DO $(   
           A := REXP(0) 
           CHECKFOR(S.COLON, 61)
           RESULTIS LIST3(S.CASE, A, RCOM())
           $)                         //    CUNNING!!!    //  CASE ? = DEFAULT  
      CASE S.DEFAULT:   
           NEXTSYMB()   
           CHECKFOR(S.COLON, 62)
           RESULTIS LIST2(S.DEFAULT, RCOM())
      CASE S.LSECT: 
           RESULTIS RDSECT(RDBLOCKBODY)   $)1   

AND RCOM() = VALOF  
    $(1 LET A = RBCOM() 
           WHILE SYMB=S.REPEAT LOGOR SYMB=S.REPEATWHILE LOGOR SYMB=S.REPEATUNTIL
                  $( LET OP = SYMB  
                     NEXTSYMB() 
                     TEST OP=S.REPEAT   
                        THEN A := LIST2(OP, A)  
                            OR A := LIST3(OP, A, REXP(0))   $)  
       RESULTIS A  $)1  
.   
GET "TRNHEAD"   
MANIFEST $( SIZE.A=3000;  SIZE.D=1000;  SIZE.E=300;  $) 

LET NEXTPARAM() = VALOF 
   $( PARAMNUMBER := PARAMNUMBER + 1
      RESULTIS PARAMNUMBER  $)  

AND TRANSREPORT(N,X) BE 
   $( LET A = OUTPUT
      LET NULL() BE RETURN  
      OUTPUT := MONITOR 
      COMPLAB,COMPENTRY,COMPDATALAB,COMPJUMP,OUT1,OUT2,OUT2P,OUT3P,OUTN,OUTL,   
                                                                    OUTC := 
              NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
      REPORTCOUNT := REPORTCOUNT + 1
     WRITEF("****************  ERROR %N IN COMMAND %N ", N, COMCOUNT)   
      UNLESS X = 0 DO IF H1!X = S.NAME DO WRITEF("CONCERNING %S ", X + 3)   
      WRITEF(":     %S*N", MESSAGE(N))  
      //  PLIST(X, 0, 5); NEWLINE()  //  REMOVED HERE   
      IF REPORTCOUNT GE REPORTMAX DO
              $( WRITES('*NCOMPILATION ABORTED*N')  
                FINISH  $)  
      OUTPUT := A  $)   

AND MESSAGE(N) = VALOF  
      $( SWITCHON N INTO
      $( DEFAULT: RESULTIS "????????????????"   
        CASE 100: RESULTIS "UNKNOWN COMMAND"
        CASE 141: RESULTIS "TOO MANY CASES" 
        CASE 101: RESULTIS "DEFAULT USED TWICE" 
        CASE 102: RESULTIS "UNKNOWN DECLARATION"
        CASE 103: RESULTIS "BAD NAMELIST"   
        CASE 144: RESULTIS "TOO MANY GLOBALS"   
        CASE 142: RESULTIS "NAME DECLARED TWICE"
        CASE 143: RESULTIS "TOO MANY NAMES DECLARED"
        CASE 147:   
        CASE 148: RESULTIS "UNKNOWN EXPRESSION" 
        CASE 149: RESULTIS "'RESULTIS'  IS NOT WITHIN A 'VALOF' BLOCK"  
        CASE 115: RESULTIS "NAME NOT DECLARED"  
        CASE 116: RESULTIS "DYNAMIC FREE VARIABLE USED" 
        CASE 117:   
        CASE 118:   
        CASE 119: RESULTIS "ERROR IN CONSTANT EXPRESSION"   
        CASE 110:   
        CASE 112: RESULTIS "LHS AND RHS DO NOT MATCH"   
        CASE 109:   
        CASE 113: RESULTIS "LTYPE EXPRESSION EXPECTED"  
        CASE 199: RESULTIS "COMPILER BUG"   
                  $)   $)   

LET COMPILEAE(X) BE 
  $(1 LET A = VEC SIZE.A
      LET D = VEC SIZE.D
      LET E = VEC SIZE.E
      LET R = REPORT
      REPORT := TRANSREPORT 
      DVEC, DVECS, DVECE, DVECP, DVECT := A, 3, 3, 3, SIZE.A
      DVEC!0, DVEC!1, DVEC!2 := 0, 0, 0 
      GLOBDECL, GLOBDECLS, GLOBDECLT := D, 0, SIZE.D
      CASETABLE, CASEB, CASEP, CASET := E, 0, 0, SIZE.E 
      IF OPTION!8 DO
        $( LET B = OUTPUT   
          OUTPUT := MONITOR 
           WRITEF("*NSTACK BASE IN TRANS = %N*N*N" , LV B ) 
          OUTPUT := B  $)   
      RESULTLABEL, BREAKLABEL, DEFAULTLABEL := 0, 0, 0  
      LOOPLABEL, OUTLABEL := 0, 0   
      COMCOUNT, CURRENTBRANCH := 0, X   
      UNLESS OPTION!15 DO WRITEOP := WRITEN 
      PARAMNUMBER := 0  
      SAVESPACESIZE := 2
      SSP := SAVESPACESIZE  
      UNLESS REPORTCOUNT = 0 DO $( LET NULL() BE RETURN 
                                   COMPLAB,COMPENTRY, COMPDATALAB,COMPJUMP :=   
                                                        NULL, NULL, NULL, NULL  
                                   OUT1,OUT2,OUT2P,OUT3P,OUTN,OUTL,OUTC:=   
                                   NULL,NULL,NULL, NULL, NULL,NULL,NULL 
                                $)  
      OUT2(S.STACK, SSP)
      DECLLABELS(X) 
      TRANS(X)  
      OUT1(S.FINISH)
      OUT2(S.GLOBAL, GLOBDECLS/2)   
  $( LET I = 0  
     UNTIL I=GLOBDECLS DO   
         $( OUTN(GLOBDECL!I)
            OUTL(GLOBDECL!(I+1))
            I := I + 2 $)   
      REPORT := R   
      RETURN  $)1   
.   
GET "TRNHEAD"   

LET TRANS(X) BE 
  $(TR  
NEXT:   
    IF X=0 RETURN   
    CURRENTBRANCH := X  
    SWITCHON H1!X INTO  
$(  DEFAULT: TRANSREPORT(100, X); RETURN
    CASE S.LET: 
      $( LET A, B, S = DVECE, DVECS, SSP
      LET V = VECSSP
      STATLABEL := 0
      DECLNAMES(H2!X)   
      UNLESS STATLABEL=0 DO COMPLAB(STATLABEL)  
      CHECKDISTINCT(B, DVECS)   
      DVECE := DVECS
      VECSSP := SSP 
      SSP := S  
      TRANSDEF(H2!X)
      SSP := VECSSP 
      OUT2(S.STACK, SSP)
      OUT1(S.STORE) 
      DECLLABELS(H3!X)  
      TRANS(H3!X)   
      VECSSP := V   
      DVECE, DVECS, SSP := A, B, S  
      OUT2(S.STACK, SSP)
      RETURN  $)
CASE S.GLOBAL: CASE S.MANIFEST: 
  $(1 LET A, B, S = DVECE, DVECS, SSP   
      AND P = H1!X=S.GLOBAL -> S.GLOBAL, S.NUMBER   
      LET Y = H2!X  
      UNTIL Y=0 DO  
          $( ADDNAME(H3!Y, P, EVALCONST(H4!Y))  
               DVECE := DVECS      // REMOVE MANIFEST BUG   
             Y := H2!Y  $)  
      CHECKDISTINCT(B, DVECS)   
      DVECE := DVECS
      DECLLABELS(H3!X)  
      TRANS(H3!X)   
      DVECE, DVECS, SSP := A, B, S  
      RETURN  $)1   
CASE S.STATIC:  
 $(1 LET A, B, S = DVECE, DVECS, SSP
      LET L = NEXTPARAM()   
      COMPJUMP(L)   
$( LET Y = H2!X 
      UNTIL Y=0 DO  
         $( LET M = NEXTPARAM() 
            ADDNAME(H3!Y, S.LABEL, M)   
            COMPDATALAB(M)  
      OUT2(S.ITEMN, EVALCONST(H4!Y))
            Y := H2!Y  $)  $)   
      CHECKDISTINCT(B, DVECS)   
      DVECE := DVECS
      DECLLABELS(H3!X)  
      COMPLAB(L)
      TRANS(H3!X)   
      DVECE, DVECS, SSP := A, B, S  
      RETURN  $)1   
CASE S.ASS: 
      ASSIGN(H2!X, H3!X)
      RETURN
CASE S.RTAP:
 $( LET S = SSP 
      SSP := SSP+SAVESPACESIZE  
      OUT2(S.STACK, SSP)
      LOADLIST(H3!X)
      LOAD(H2!X)
      OUT2(S.RTAP, S)   
      SSP := S  
      RETURN  $)
CASE S.GOTO:
      LOAD(H2!X)
      OUT1(S.GOTO)  
      SSP := SSP-1  
      RETURN
CASE S.COLON:   
      COMPLAB(H4!X) 
      OUT2(S.STACK, SSP)
      TRANS(H3!X)   
      RETURN
CASE S.UNLESS: CASE S.IF:   
 $( LET L = NEXTPARAM() 
      JUMPCOND(H2!X, H1!X=S.UNLESS, L)  
      TRANS(H3!X)   
      COMPLAB(L)
      RETURN   $)   
CASE S.TEST:
 $( LET L, M = NEXTPARAM(), NEXTPARAM() 
      JUMPCOND(H2!X, FALSE, L)  
      TRANS(H3!X)   
      COMPJUMP(M)   
      COMPLAB(L)
      TRANS(H4!X)   
      COMPLAB(M)
      RETURN  $)
CASE S.BREAK:   
      IF BREAKLABEL=0 DO BREAKLABEL := NEXTPARAM()  
      COMPJUMP(BREAKLABEL)  
      RETURN
CASE S.LOOP:
      IF LOOPLABEL = 0 DO LOOPLABEL := NEXTPARAM()  
      COMPJUMP(LOOPLABEL)   
      RETURN
CASE S.OUT: 
      IF OUTLABEL = 0 DO OUTLABEL := NEXTPARAM()
      COMPJUMP(OUTLABEL)
      RETURN
CASE S.RETURN: OUT1(S.RTRN) 
                RETURN  
CASE S.FINISH: OUT1(S.FINISH)   
                RETURN  
CASE S.RESULTIS:
      IF RESULTLABEL = 0 DO REPORT(149)          // NO "VALOF"  
      LOAD(H2!X)
      OUT2P(S.RES, RESULTLABEL) 
      SSP := SSP - 1
      RETURN
CASE S.WHILE: CASE S.UNTIL: 
 $( LET L, M = NEXTPARAM(), NEXTPARAM() 
      LET BL = BREAKLABEL   
      LET LL = LOOPLABEL
      LOOPLABEL := 0
      BREAKLABEL := 0   
      COMPJUMP(M)   
      COMPLAB(L)
      TRANS(H3!X)   
      UNLESS LOOPLABEL = 0 DO $( COMPLAB(LOOPLABEL);  OUT2(S.STACK,SSP) $)  
      COMPLAB(M)
      JUMPCOND(H2!X, H1!X=S.WHILE, L)   
      UNLESS BREAKLABEL=0 DO
            $( COMPLAB(BREAKLABEL)  
                OUT2(S.STACK, SSP)  $)  
      BREAKLABEL := BL  
      LOOPLABEL := LL   
      RETURN  $)
CASE S.REPEAT:  
      CASE S.REPEATWHILE: CASE S.REPEATUNTIL:   
 $( LET L, BL = NEXTPARAM(), BREAKLABEL 
      LET LL = LOOPLABEL
      LOOPLABEL := 0
      BREAKLABEL := 0   
      COMPLAB(L)
      TRANS(H2!X)   
      UNLESS LOOPLABEL = 0 DO $( COMPLAB(LOOPLABEL);  OUT2(S.STACK,SSP) $)  
      LOOPLABEL := LL   
      TEST H1!X=S.REPEAT
            THEN COMPJUMP(L)
        OR JUMPCOND(H3!X, H1!X=S.REPEATWHILE, L)
      UNLESS BREAKLABEL=0 DO
            $( COMPLAB(BREAKLABEL)  
                OUT2(S.STACK, SSP)  $)  
      BREAKLABEL := BL  
      RETURN  $)
CASE S.CASE:
 $( LET L, Y = NEXTPARAM(), EVALCONST(H2!X) 
      IF CASEP GE CASET DO TRANSREPORT(141, X)  
      CASETABLE!CASEP := Y  
      CASETABLE!(CASEP+1) := L  
      CASEP := CASEP + 2
      COMPLAB(L)
      TRANS(H3!X)   
      RETURN  $)
CASE S.DEFAULT: 
      UNLESS DEFAULTLABEL=0 DO TRANSREPORT(101, X)  
      DEFAULTLABEL := NEXTPARAM()   
      COMPLAB(DEFAULTLABEL) 
      TRANS(H2!X)   
      RETURN
CASE S.SWITCHON:
      TRANSSWITCH(X)
      RETURN
CASE S.FOR: 
 $( LET A, B = DVECE, DVECS 
      LET L, M = NEXTPARAM(), NEXTPARAM()   
      LET BL = BREAKLABEL   
      LET S1 = SSP  
      LET LL = LOOPLABEL
      LET K = H5!X = 0 -> 1 , EVALCONST(H5!X)   
      LOOPLABEL := 0
      BREAKLABEL := 0   
      ADDNAME(H2!X, S.LOCAL, S1)
      DVECE := DVECS
      LOAD(H3!X)
 $( LET S2 = SSP
      LOAD(H4!X)
      OUT1(S.STORE) 
      COMPJUMP(L)   
      DECLLABELS(H6!X)  
      COMPLAB(M)
      TRANS(H6!X)   
      UNLESS LOOPLABEL = 0 DO $( COMPLAB(LOOPLABEL);  OUT2(S.STACK,SSP) $)  
      LOOPLABEL := LL   
      OUT2(S.LP, S1); OUT2(S.LN, K); OUT1(S.PLUS); OUT2(S.SP, S1)   
      COMPLAB(L)
      OUT2(S.LP, S1); OUT2(S.LP, S2); OUT1(K >= 0 -> S.LE,S.GE); OUT2P(S.JT, M) 
      UNLESS BREAKLABEL=0 DO COMPLAB(BREAKLABEL)
      BREAKLABEL, SSP := BL, S1 
      OUT2(S.STACK, SSP)
      DVECE, DVECS := A, B  
      RETURN  $)  $)
CASE S.SEQ: 
      TRANS(H2!X)   
      COMCOUNT := COMCOUNT + 1  
      X := H3!X 
      GOTO NEXT      $)TR   
.   
GET "TRNHEAD"   

LET DECLNAMES(X) BE 
   $(DN IF X=0 RETURN   
      SWITCHON H1!X INTO
   $(  DEFAULT: TRANSREPORT(102, CURRENTBRANCH) 
                RETURN  
      CASE S.VECDEF: CASE S.VALDEF: 
           DECLDYN(H2!X)
           RETURN   
      CASE S.RTDEF: CASE S.FNDEF:   
           H5!X := NEXTPARAM()  
           DECLSTAT(H2!X, H5!X) 
           RETURN   
      CASE S.AND:   
           DECLNAMES(H2!X)  
           DECLNAMES(H3!X)  
           RETURN   
                     $)DN   

AND DECLDYN(X) BE   
   $( IF X=0 RETURN 
      IF H1!X=S.NAME DO 
         $( ADDNAME(X, S.LOCAL, SSP)
           SSP := SSP + 1   
           RETURN   $)  
      IF H1!X=S.COMMA DO
         $( LET Y = H2!X
            UNLESS H1!Y = S.NIL DO ADDNAME(Y, S.LOCAL, SSP) 
         SSP := SSP + 1 
         DECLDYN(H3!X)  
         RETURN $)  
      IF H1!X=S.NIL DO $( SSP := SSP + 1; RETURN $) 
      TRANSREPORT(103, X)   $)  

AND DECLSTAT(X, L) BE   
   $(1 LET T = CELLWITHNAME(X)  
      IF DVEC!(T+1)=S.GLOBAL DO 
         $( LET N = DVEC!(T+2)  
            ADDNAME(X, S.GLOBAL, N) 
            IF GLOBDECLS GE GLOBDECLT DO TRANSREPORT(144, X)
            GLOBDECL!GLOBDECLS := N 
            GLOBDECL!(GLOBDECLS+1) := L 
            GLOBDECLS := GLOBDECLS + 2  
            RETURN  $)  
      IF STATLABEL=0 DO 
            $( STATLABEL := NEXTPARAM() 
              COMPJUMP(STATLABEL)  $)   
  $( LET M = NEXTPARAM()
      ADDNAME(X, S.LABEL, M)
      COMPDATALAB(M)
      OUT2P(S.ITEML, L)   $)1   

AND DECLLABELS(X) BE
  $( LET B = DVECS  
      STATLABEL := 0
      SCANLABELS(X) 
      UNLESS STATLABEL=0 DO COMPLAB(STATLABEL)  
      CHECKDISTINCT(B, DVECS)   
      DVECE := DVECS  $)

AND CHECKDISTINCT(E, S) BE  
  $( UNTIL E=S DO   
            $( LET P = E + 3
              AND N = DVEC!E
             WHILE P LS S DO
                $( IF DVEC!P=N DO TRANSREPORT(142, N)   
                  P := P + 3 $) 
              E := E + 3 $) $)  

AND ADDNAME(N, P, A) BE 
  $( IF DVECS GE DVECT DO TRANSREPORT(143, CURRENTBRANCH)   
      DVEC!DVECS, DVEC!(DVECS+1), DVEC!(DVECS+2) := N, P, A 
      DVECS := DVECS + 3 $) 

AND CELLWITHNAME(N) = VALOF 
  $( LET X = DVECE  
      $( X := X - 3 
        IF X=0 RESULTIS 0 $) REPEATUNTIL DVEC!X=N   
      RESULTIS X $) 

AND LOADLIST(X) BE  
    $( IF X=0 RETURN
      IF H1!X=S.COMMA DO $( LOADLIST(H2!X)  
                            LOADLIST(H3!X)  
                            RETURN  $)  
      LOAD(X)  $)   

AND SCANLABELS(X) BE
  $( IF X=0 RETURN  
        SWITCHON H1!X INTO  
  $( DEFAULT: RETURN
      CASE S.COLON: 
            H4!X := NEXTPARAM() 
            DECLSTAT(H2!X, H4!X)
            SCANLABELS(H3!X)
            RETURN  
      CASE S.IF: CASE S.UNLESS: CASE S.WHILE: CASE S.UNTIL: 
      CASE S.SWITCHON: CASE S.CASE: 
            SCANLABELS(H3!X)
            RETURN  
      CASE S.SEQ:   
            SCANLABELS(H3!X)
      CASE S.REPEAT:
      CASE S.REPEATWHILE: CASE S.REPEATUNTIL: CASE S.DEFAULT:   
            SCANLABELS(H2!X)
            RETURN  
      CASE S.TEST:  
            SCANLABELS(H3!X)
            SCANLABELS(H4!X)
            RETURN  $)  $)  

AND TRANSDEF(X) BE  
  $(1 IF X=0 RETURN 
        SWITCHON H1!X INTO  
  $( CASE S.AND:
            TRANSDEF(H2!X)  
            TRANSDEF(H3!X)  
            RETURN  
      CASE S.VECDEF:
            OUT2(S.LLP, VECSSP) 
            SSP := SSP + 1  
            VECSSP := VECSSP + 1 + EVALCONST(H3!X)  
            RETURN  
      CASE S.VALDEF: LOADLIST(H3!X) 
                RETURN  
      CASE S.FNDEF: CASE S.RTDEF:   
       $(2 LET L = NEXTPARAM()  
            COMPJUMP(L) 
       $(3 LET A, B, C = DVECE, DVECS, DVECP
         LET S = SSP
            COMPENTRY(H2!X, H5!X)   
            SSP := SAVESPACESIZE
            DVECP := DVECS  
             DECLDYN(H3!X)  
       CHECKDISTINCT(B, DVECS)  
       DVECE := DVECS   
       DECLLABELS(H4!X) 
      OUT2(S.SAVE, SSP) 
      TEST H1!X=S.FNDEF 
         THEN $( LOAD(H4!X); OUT1(S.FNRN) $)
          OR $( TRANS(H4!X); OUT1(S.RTRN) $)
      SSP := S  
      OUT2(S.STACK, SSP)
      DVECE, DVECS, DVECP := A, B, C $)3
      COMPLAB(L)
      RETURN $)2
DEFAULT: RETURN  $)1
.   
GET "TRNHEAD"   

LET JUMPCOND(X, B, L) BE
$(JC LET SW = B 
      SWITCHON H1!X INTO
      $( CASE S.FALSE: B := NOT B   
        CASE S.TRUE: IF B DO COMPJUMP(L)
                RETURN  
      CASE S.NOT: JUMPCOND(H2!X, NOT B, L)  
                RETURN  
      CASE S.LOGAND: SW := NOT SW   
      CASE S.LOGOR: 
       TEST SW THEN $( JUMPCOND(H2!X, B, L) 
                  JUMPCOND(H3!X, B, L)  $)  
            OR $( LET M = NEXTPARAM()   
                JUMPCOND(H2!X, NOT B, M)
                JUMPCOND(H3!X, B, L)
                COMPLAB(M)  $)  
       RETURN   
      DEFAULT: LOAD(X)  
            OUT2P(B -> S.JT, S.JF, L)   
            SSP := SSP - 1  
      RETURN   $)JC 

AND TRANSSWITCH(X) BE   
  $(1 LET P, DL = CASEP, DEFAULTLABEL   
      LET OL = OUTLABEL 
      LET L, M = NEXTPARAM(), NEXTPARAM()   
      COMPJUMP(L)   
      DEFAULTLABEL := 0 
      OUTLABEL := 0 
      TRANS(H3!X)   
      COMPJUMP(M)   
      COMPLAB(L)
      LOAD(H2!X)
      IF DEFAULTLABEL=0 DO DEFAULTLABEL := M
      OUT3P(S.SWITCHON, (CASEP-P)/2, DEFAULTLABEL)  
 $( LET I = P   
      UNTIL I=CASEP DO $( OUTN(CASETABLE!I) 
                OUTL(CASETABLE!(I+1))   
                I := I + 2  $)  
      SSP := SSP - 1
      UNLESS OUTLABEL = 0 DO $( COMPLAB(OUTLABEL);  OUT2(S.STACK,SSP) $)
      COMPLAB(M)
      OUTLABEL := OL
      CASEP, DEFAULTLABEL := P, DL  $)1 
.   
GET "TRNHEAD"   

LET LOAD(X) BE  
   $(1 IF X=0 DO $( TRANSREPORT(148, CURRENTBRANCH) 
                OUT2(S.LN, 0)   
                SSP := SSP + 1  
                RETURN $)   
  $( LET OP = H1!X  
      SWITCHON OP INTO  
  $( DEFAULT: TRANSREPORT(147, CURRENTBRANCH)   
            OUT2(S.LN, 0)   
            SSP := SSP + 1  
            RETURN  
      CASE S.DIV: CASE S.REM: CASE S.MINUS: 
      CASE S.LS: CASE S.GR: CASE S.LE: CASE S.GE:   
      CASE S.LSHIFT: CASE S.RSHIFT: 
         LOAD(H2!X) 
         LOAD(H3!X) 
         OUT1(OP)   
         SSP := SSP - 1 
         RETURN 
      CASE S.VECAP: CASE S.MULT: CASE S.PLUS: CASE S.EQ: CASE S.NE: 
         CASE S.LOGAND: CASE S.LOGOR: CASE S.EQV: CASE S.NEQV:  
       $( LET A, B = H2!X, H3!X 
         IF H1!A=S.NAME LOGAND H1!B NE S.NAME LOGOR H1!A=S.NUMBER DO
                  A, B := H3!X, H2!X
         LOAD(A)
         LOAD(B)
         IF OP=S.VECAP DO $( OUT1(S.PLUS); OP := S.RV  $)   
         OUT1(OP)   
         SSP := SSP - 1 
         RETURN  $) 
      CASE S.NEG: CASE S.NOT: CASE S.RV:
         LOAD(H2!X) 
         OUT1(OP)   
         RETURN 
      CASE S.NIL:   
         SSP := SSP + 1 
         OUT2(S.STACK, SSP) 
         RETURN 
      CASE S.TRUE: CASE S.FALSE:
         OUT1(OP)   
         SSP := SSP + 1 
         RETURN 
      CASE S.LV: LOADLV(H2!X)   
         RETURN 
      CASE S.NUMBER: CASE S.CHAR:   
         OUT2(S.LN, H2!X)   
         SSP := SSP + 1 
         RETURN 
      CASE S.STRING:
        $( LET V = VEC 256  
          UNPACKSTRING(LV H2!X, V)  
          OUT2(S.LSTR, V!0) 
          FOR I = 1 TO V!0 DO OUTC(V!I) 
          NEWLINE() 
          SSP := SSP + 1
          RETURN  $)
      CASE S.NAME:  
        $( LET T = CELLWITHNAME(X)  
           LET K, N = DVEC!(T+1), DVEC!(T+2)
         IF T=0 DO TRANSREPORT(115, X)  
          IF T LS DVECP & K=S.LOCAL DO TRANSREPORT(116, X)  
           SSP := SSP + 1   
         SWITCHON K INTO
         $( DEFAULT:
              CASE S.NUMBER: OUT2(S.LN, N); RETURN  
               CASE S.LOCAL: OUT2(S.LP, N); RETURN  
              CASE S.GLOBAL: OUT2(S.LG, N); RETURN  
                 CASE S.LABEL: OUT2P(S.LL, N); RETURN  $)  $)   
      CASE S.VALOF: 
       $( LET RL = RESULTLABEL  
          LET A, B = DVECS, DVECE   
          DECLLABELS(H2!X)  
            RESULTLABEL := NEXTPARAM()  
             TRANS(H2!X)
            COMPLAB(RESULTLABEL)
            OUT2(S.RSTACK, SSP) 
            SSP := SSP + 1  
              DVECS, DVECE := A, B  
              RESULTLABEL := RL 
              RETURN   $)   
      CASE S.FNAP:  
        $( LET S = SSP  
           SSP := SSP + SAVESPACESIZE   
          OUT2(S.STACK, SSP)
              LOADLIST(H3!X)
            LOAD(H2!X)  
            OUT2(S.FNAP, S) 
          SSP := S + 1  
          RETURN  $)
      CASE S.COND:  
      $( LET L, M = NEXTPARAM(), NEXTPARAM()
           LET S = SSP  
         JUMPCOND(H2!X, FALSE, M)   
         LOAD(H3!X) 
         COMPJUMP(L)
         SSP := S; OUT2(S.STACK, SSP)   
         COMPLAB(M) 
               LOAD(H4!X)   
              COMPLAB(L)
              RETURN  $)
      CASE S.TABLE: 
         $( LET L, M = NEXTPARAM(), NEXTPARAM() 
            COMPJUMP(L) 
            COMPDATALAB(M)  
            X := H2!X   
            WHILE H1!X=S.COMMA DO   
               $( OUT2(S.ITEMN, EVALCONST(H2!X))
                       X := H3!X   $)   
               OUT2(S.ITEMN, EVALCONST(X))  
              COMPLAB(L)
              OUT2P(S.LLL, M)   
                SSP := SSP + 1  
             RETURN $)                           $)1

AND LOADLV(X) BE
   $(1 IF X=0 GOTO ERR  
      SWITCHON H1!X INTO
   $( DEFAULT: GOTO ERR 
      CASE S.NAME:  
        $( LET T = CELLWITHNAME(X)  
          LET K, N = DVEC!(T+1), DVEC!(T+2) 
            SSP := SSP  + 1 
           IF T = 0 DO $( TRANSREPORT(115, X); GOTO ERR $) // UNDECLARED NAME   
             IF T LS DVECP & K=S.LOCAL DO TRANSREPORT(116, X)   
            SWITCHON K INTO 
            $( CASE S.LOCAL: OUT2(S.LLP, N); RETURN 
                       CASE S.GLOBAL: OUT2(S.LLG, N); RETURN
                       CASE S.LABEL: OUT2P(S.LLL, N); RETURN  $)  $)
         ERR: TRANSREPORT(113, CURRENTBRANCH)   
            OUT2(S.LN, 0)   
            SSP := SSP + 1  
             RETURN 
      CASE S.RV:
             LOAD(H2!X) 
          RETURN
      CASE S.VECAP: 
        $( LET A, B = H2!X, H3!X
           IF H1!A=S.NAME LOGAND H1!B NE S.NAME LOGOR H1!B=S.NUMBER DO  
               A,B := H3!X, H2!X
          LOAD(A)   
          LOAD(B)   
          OUT1(S.PLUS)  
            SSP := SSP - 1  
           RETURN   $)  
      CASE S.COND:  
           $( LET L, M = NEXTPARAM(), NEXTPARAM()   
          LET S = SSP   
           JUMPCOND(H2!X, FALSE, M) 
           LOADLV(H3!X) 
           COMPJUMP(L)  
          SSP := S; OUT2(S.STACK, SSP)  
            COMPLAB(M)  
          LOADLV(H4!X)  
           COMPLAB(L)   
          RETURN  $)        $)1 
      FINISH
.   
GET "TRNHEAD"   

LET EVALCONST(X) = VALOF
     $(1 IF X=0 DO $( TRANSREPORT(117, CURRENTBRANCH)   
                         RESULTIS 0  $) 
           SWITCHON H1!X INTO   
       $( DEFAULT: TRANSREPORT(118, X)  
                    RESULTIS 0  
      CASE S.NAME:  
        $( LET T = CELLWITHNAME(X)  
            IF DVEC!(T+1)=S.NUMBER RESULTIS DVEC!(T+2)  
             TRANSREPORT(119, X)
             RESULTIS 0 $)  
      CASE S.NIL   : RESULTIS 0 
      CASE S.CHAR  :
      CASE S.NUMBER: RESULTIS H2!X  
      CASE S.TRUE  : RESULTIS TRUE  
      CASE S.FALSE : RESULTIS FALSE 
      CASE S.NEG   : RESULTIS                 - EVALCONST(H2!X) 
      CASE S.MINUS : RESULTIS EVALCONST(H2!X) - EVALCONST(H3!X) 
      CASE S.PLUS  : RESULTIS EVALCONST(H2!X) + EVALCONST(H3!X) 
      CASE S.MULT  : RESULTIS EVALCONST(H2!X) * EVALCONST(H3!X) 
      CASE S.DIV   : RESULTIS EVALCONST(H2!X) / EVALCONST(H3!X) 
      CASE S.REM   : RESULTIS EVALCONST(H2!X) REM    EVALCONST(H3!X)
      CASE S.LS    : RESULTIS EVALCONST(H2!X) LS     EVALCONST(H3!X)
      CASE S.GR    : RESULTIS EVALCONST(H2!X) GR     EVALCONST(H3!X)
      CASE S.LE    : RESULTIS EVALCONST(H2!X) LE     EVALCONST(H3!X)
      CASE S.GE    : RESULTIS EVALCONST(H2!X) GE     EVALCONST(H3!X)
      CASE S.EQ    : RESULTIS EVALCONST(H2!X) EQ     EVALCONST(H3!X)
      CASE S.NE    : RESULTIS EVALCONST(H2!X) NE     EVALCONST(H3!X)
      CASE S.LSHIFT: RESULTIS EVALCONST(H2!X) LSHIFT EVALCONST(H3!X)
      CASE S.RSHIFT: RESULTIS EVALCONST(H2!X) RSHIFT EVALCONST(H3!X)
      CASE S.LOGAND: RESULTIS EVALCONST(H2!X) LOGAND EVALCONST(H3!X)
      CASE S.LOGOR : RESULTIS EVALCONST(H2!X) LOGOR  EVALCONST(H3!X)
      CASE S.EQV   : RESULTIS EVALCONST(H2!X) EQV    EVALCONST(H3!X)
      CASE S.NEQV  : RESULTIS EVALCONST(H2!X) NEQV   EVALCONST(H3!X)
      CASE S.NOT   : RESULTIS                 NOT    EVALCONST(H2!X)
      CASE S.COND  : RESULTIS EVALCONST(H2!X) -> EVALCONST(H3!X) ,  
                                                 EVALCONST(H4!X)
               $)1  

AND ASSIGN(X, Y) BE 
   $(1 IF X=0 LOGOR Y=0 DO  
        $( TRANSREPORT(110, CURRENTBRANCH)  
                 RETURN $)  
      SWITCHON H1!X INTO
   $( CASE S.COMMA: 
        UNLESS H1!Y=S.COMMA DO  
                   $( TRANSREPORT(112, CURRENTBRANCH)   
                        RETURN  $)  
                ASSIGN(H2!X, H2!Y)  
                ASSIGN(H3!X, H3!Y)  
                RETURN  
           CASE S.NAME: 
           $( LET T = CELLWITHNAME(X)   
           LET K, N = DVEC!(T+1), DVEC!(T+2)
             IF T=0 DO TRANSREPORT(115, X)  
             IF T LS DVECP & K=S.LOCAL DO TRANSREPORT(116, X)   
             LOAD(Y)
             SSP := SSP - 1 
             SWITCHON K INTO
             $( CASE S.NUMBER:  TRANSREPORT(116, X) 
                                  N := 0
                       CASE S.GLOBAL: OUT2(S.SG, N); RETURN 
                       CASE S.LOCAL: OUT2(S.SP, N); RETURN  
                       CASE S.LABEL: OUT2P(S.SL, N); RETURN  $)  $) 
          CASE S.RV: CASE S.VECAP: CASE S.COND: 
              LOAD(Y)   
              LOADLV(X) 
              OUT1(S.STIND) 
              SSP := SSP - 2
              RETURN
        DEFAULT: TRANSREPORT(109, CURRENTBRANCH)   $)1  
.   
GET "TRNHEAD"   

LET COMPLAB(L) BE   
     $( OUT2P(S.LAB, L)  $) 

AND COMPENTRY(N, L) BE  
       $(  LET V = VEC 50   
               UNPACKSTRING(N+3, V) 
               OUT3P(S.ENTRY, V!0, L)   
               FOR I = 1 TO V!0 DO OUTC(V!I)
               NEWLINE()  $)

AND COMPDATALAB(L) BE   
      $( OUT2P(S.DATALAB, L)  $)

AND COMPJUMP(L) BE  
     $( OUT2P(S.JUMP, L)  $)

AND OUT1(X) BE  
    $( WRITEOP(X); NEWLINE()  $)

AND OUT2(X, Y) BE   
   $( WRITEOP(X); WRITEC('*S')  
      WRITEN(Y); NEWLINE()    $)

AND OUT2P(X, Y) BE  
     $( WRITEOP(X); WRITES('*SL')   
          WRITEN(Y); NEWLINE()   $) 

AND OUT3P(X, Y, Z) BE   
      $( WRITEOP(X); WRITEC('*S')   
           WRITEN(Y); WRITES('*SL') 
           WRITEN(Z); NEWLINE()   $)

AND OUTN(N) BE  
      $( WRITEN(N)   $) 

AND OUTL(X) BE  
        $( WRITES('*SL'); WRITEN(X); NEWLINE()  $)  

AND OUTC(X)  BE 
    $( WRITEN(X); WRITEC('*S')   $) 

AND WRITEOP(X)  BE  
     $(1 LET S = VALOF  
       $( SWITCHON X INTO   
          $( DEFAULT: TRANSREPORT(199, CURRENTBRANCH)   
                       RESULTIS 'ERROR' 
               CASE S.MULT:      RESULTIS 'MULT'
               CASE S.DIV:       RESULTIS 'DIV' 
               CASE S.REM:       RESULTIS 'REM' 
               CASE S.PLUS:      RESULTIS 'PLUS'
               CASE S.MINUS:     RESULTIS 'MINUS'   
               CASE S.EQ:        RESULTIS 'EQ'  
               CASE S.NE:        RESULTIS 'NE'  
               CASE S.LS:        RESULTIS 'LS'  
               CASE S.GR:        RESULTIS 'GR'  
               CASE S.LE:        RESULTIS 'LE'  
               CASE S.GE:        RESULTIS 'GE'  
               CASE S.LSHIFT:    RESULTIS 'LSHIFT'  
               CASE S.RSHIFT:    RESULTIS 'RSHIFT'  
               CASE S.LOGAND:    RESULTIS 'LOGAND'  
               CASE S.LOGOR:     RESULTIS 'LOGOR'   
               CASE S.EQV:       RESULTIS 'EQV' 
               CASE S.NEQV:      RESULTIS 'NEQV'
               CASE S.NEG:       RESULTIS 'NEG' 
               CASE S.NOT:       RESULTIS 'NOT' 
               CASE S.RV:        RESULTIS 'RV'  
               CASE S.TRUE:      RESULTIS 'TRUE'
               CASE S.FALSE:     RESULTIS 'FALSE'   
               CASE S.LP:        RESULTIS 'LP'  
               CASE S.LG:        RESULTIS 'LG'  
               CASE S.LN:        RESULTIS 'LN'  
               CASE S.LSTR:      RESULTIS 'LSTR'
               CASE S.LL:        RESULTIS 'LL'  
               CASE S.LLP:       RESULTIS 'LLP' 
               CASE S.LLG:       RESULTIS 'LLG' 
               CASE S.LLL:       RESULTIS 'LLL' 
               CASE S.SP:        RESULTIS 'SP'  
               CASE S.SG:        RESULTIS 'SG'  
               CASE S.SL:        RESULTIS 'SL'  
               CASE S.STIND:     RESULTIS 'STIND'   
               CASE S.JUMP:      RESULTIS 'JUMP'
               CASE S.JT:        RESULTIS 'JT'  
               CASE S.JF:        RESULTIS 'JF'  
               CASE S.GOTO:      RESULTIS 'GOTO'
               CASE S.LAB:       RESULTIS 'LAB' 
               CASE S.STACK:     RESULTIS 'STACK'   
               CASE S.STORE:     RESULTIS 'STORE'   
               CASE S.ENTRY:     RESULTIS 'ENTRY'   
               CASE S.SAVE:      RESULTIS 'SAVE'
               CASE S.FNAP:      RESULTIS 'FNAP'
               CASE S.FNRN:      RESULTIS 'FNRN'
               CASE S.RTAP:      RESULTIS 'RTAP'
               CASE S.RTRN:      RESULTIS 'RTRN'
               CASE S.RES:       RESULTIS 'RES' 
               CASE S.RSTACK:    RESULTIS 'RSTACK'  
               CASE S.FINISH:    RESULTIS 'FINISH'  
               CASE S.SWITCHON:  RESULTIS 'SWITCHON'
               CASE S.GLOBAL:    RESULTIS 'GLOBAL'  
               CASE S.DATALAB:   RESULTIS 'DATALAB' 
               CASE S.ITEML:     RESULTIS 'ITEML'   
               CASE S.ITEMN:     RESULTIS 'ITEMN'   $)   $) 
     WRITES(S)   $)1


// ****
