SECTION "TRNA"
GET "LIBHDR"
GET "HEADERS(TRNHDR)"

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

AND TRNERRWRITE(N, X) BE
       $(
          WRITEF("Error near line %N", TRNLINE REM 10000)
          TEST TRNLINE >= 10000 DO
              WRITES(" of GET file:  ") OR WRITES(":  ")
          TRNMESSAGE(N, X)

          IF REPORTCOUNT>=REPORTMAX
              $(  REPORTCOUNT := REPORTMAX
                  WRITES("COMPILATION ABORTED*N")  $) $)


AND TRANSREPORT(N, X) BE
$(  REPORTCOUNT := REPORTCOUNT + 1

    SELECTOUTPUT(SYSOPT)
        IF OCODE & OCODESTREAM=SYSOPT DO $( NEWLINE(); OCOUNT:=0 $)
        IF QUIET & NOT PRSOURCE & REPORTCOUNT=1 &
               GETBYTE(SECTIONNAME, 0) ~= 0 DO
            WRITEF("Section *"%S*"*N", SECTIONNAME)
    TRNERRWRITE(N, X)
    SELECTOUTPUT(OCODESTREAM)
    IF REPORTCOUNT>=REPORTMAX DO STOP(8)
$)

AND TRNMESSAGE(N, X) BE
$(  LET FATAL, PRNAME, PRCONST = FALSE, FALSE, FALSE
    LET S = VALOF
    SWITCHON N INTO

    $( DEFAULT: WRITES("Compiler error  "); WRITEN(N); NEWLINE() ;RETURN

       CASE 141: RESULTIS "Too many cases"
       CASE 104: RESULTIS "Illegal use of BREAK, LOOP or RESULTIS"
       CASE 101:
       CASE 105: RESULTIS "Illegal use of CASE or DEFAULT"
       CASE 106: PRCONST := TRUE
                 RESULTIS "Two cases with same constant"
       CASE 144: FATAL := TRUE
                 RESULTIS "Too many globals"
       CASE 142: PRNAME := TRUE
                  RESULTIS "Name declared twice"
       CASE 145: FATAL := TRUE
                RESULTIS "Region too small"
       CASE 121:
       CASE 115: PRNAME := TRUE
                 RESULTIS "Name not declared"
       CASE 116: PRNAME := TRUE
                 RESULTIS "Dynamic free variable used"
       CASE 117:CASE 118:
                 RESULTIS "Error in constant expression"
       CASE 119: PRNAME := TRUE
                RESULTIS "Name not declared manifest"
       CASE 120:
                 RESULTIS "Divide by zero in constant"
       CASE 147: RESULTIS "Error in expression"
       CASE 110:CASE 112:
                 RESULTIS "LHS and RHS do not match"
       CASE 109:CASE 113:
                 RESULTIS "Ltype expression expected"
    $)

   WRITES(S)
   IF PRNAME & H1!X=S.NAME WRITEF(" - %S", X+2)
   IF PRCONST WRITEF(" - %N", X)
   NEWLINE()
   IF FATAL DO REPORTMAX := 0
                  $)

AND DUMMY() BE RETURN

AND COMPILEAE(X) BE
$(1 LET D = VEC 100
    LET K = VEC 256
    LET L = VEC 256

    DVEC, DVECS, DVECE, DVECP := TREEP, -3, -3, -3

    GLOBDECL, GLOBDECLS, GLOBDECLT := D, 0, 100

    CASEK, CASEL, CASEP, CASET, CASEB := K, L, 0, 256, -1
    ENDCASELABEL, DEFAULTLABEL := 0, 0

    RESULTLABEL, BREAKLABEL, LOOPLABEL := -1, -1, -1
    INPROC := FALSE

       TRNUNUSED := DVEC+DVECS-OBUFP

    CURRENTBRANCH := X
    UNLESS OCODE THEN WRITEOP, WRN, WRC, ENDOCODE :=
                           PUTBYTES, PUTBYTES, DUMMY, DUMMY
    IF NUMOCODE THEN WRITEOP := WRN

    OCOUNT := 0

    PARAMNUMBER := 0
    SSP := SAVESPACESIZE
    UNLESS X=0 THEN
    $(  LET T = H1!X
        UNLESS T=S.SECTION | T=S.NEEDS THEN BREAK
        OUT1(T)
        OUTSTRING(H2!X+1)
        X := H3!X
    $) REPEAT
    OUT2(S.STACK, SSP)
    TRNBLOCKBODY(X)
    OUT2(S.GLOBAL, GLOBDECLS/2)

 $( LET I = 0
    UNTIL I=GLOBDECLS DO
       $( OUTN(GLOBDECL!I)
          OUTL(GLOBDECL!(I+1))
          I := I + 2  $)

    ENDOCODE()
$)1


LET TRANS(X) BE
  $(TR
NEXT:
 $( LET SW = FALSE
    AND H1X, H2X, H3X = 0, 0, 0
    IF X=0 RETURN
    CURRENTBRANCH := X

    H1X, H2X, H3X := H1!X, H2!X, H3!X
    IF (H1X&BECOMESBIT) NE 0 THEN
    $(  ASSIGN(H2X, H3X, H1X&\BECOMESBIT); RETURN  $)

    SWITCHON H1X INTO
$(  DEFAULT: TRANSREPORT(100, X); RETURN

    CASE S.LET: CASE S.STATIC:
    CASE S.MANIFEST: CASE S.GLOBAL:
    $(  LET A, B, S, V = DVECE, DVECS, SSP, VECSSP
        TRNBLOCKBODY(X)
        IF NAMING&INPROC THEN $( OUT1(S.ENDBLOCK); WRITENAMES(B) $)
        UNLESS SSP=S DO OUT2(S.STACK, S)
        DVECE, DVECS, SSP, VECSSP := A, B, S, V
        RETURN
    $)

    CASE S.ASS:
       TRNLINE:=H4!X
       ASSIGN(H2X, H3X, S.STIND)
       RETURN

    CASE S.RTAP:
     $( LET S = SSP
        TRNLINE := H4!X
        SSP := SSP+SAVESPACESIZE
        OUT2(S.STACK, SSP)
        LOADLIST(H3X)
        LOAD(H2X)
        OUT2(S.RTAP, S)
        SSP := S
        RETURN  $)

    CASE S.GOTO:
        TRNLINE:=H3X
        LOAD(H2X)
        OUT1(S.GOTO)
        SSP := SSP-1
        RETURN

    CASE S.COLON:
        COMPLAB(H4!X)
        TRANS(H3X)
        RETURN

    CASE S.UNLESS: SW := TRUE
    CASE S.IF:
     $( LET L = NEXTPARAM()
        TRNLINE:=H4!X
        JUMPCOND(H2X, SW, L)
        TRANS(H3X)
        COMPLAB(L)
        RETURN   $)

    CASE S.TEST:
     $( LET L, M = NEXTPARAM(), NEXTPARAM()
        TRNLINE:=H5!X
        JUMPCOND(H2X, FALSE, L)
        TRANS(H3X)
        COMPJUMP(M)
        COMPLAB(L)
        TRANS(H4!X)
        COMPLAB(M)
        RETURN   $)

    CASE S.LOOP:
        IF LOOPLABEL<0 DO TRANSREPORT(104, X)
        IF LOOPLABEL=0 DO LOOPLABEL := NEXTPARAM()
        COMPJUMP(LOOPLABEL)
        RETURN

    CASE S.BREAK:
        IF BREAKLABEL<0 DO TRANSREPORT(104, X)
        IF BREAKLABEL=0 DO BREAKLABEL := NEXTPARAM()
        COMPJUMP(BREAKLABEL)
        RETURN

    CASE S.RETURN: OUT1(S.RTRN)
                   RETURN

    CASE S.FINISH: OUT1(S.FINISH)
                   RETURN

    CASE S.RESULTIS:
        TRNLINE:=H3X
        IF RESULTLABEL<0 DO TRANSREPORT(104, X)
        LOAD(H2X)
        OUT2P(S.RES, RESULTLABEL)
        SSP := SSP - 1
        RETURN

    CASE S.WHILE: SW := TRUE
    CASE S.UNTIL:
     $( LET L, M = NEXTPARAM(), NEXTPARAM()
        LET BL, LL = BREAKLABEL, LOOPLABEL
        LET SAVELINE = ?
        TRNLINE:=H4!X
        BREAKLABEL, LOOPLABEL := 0, M
        COMPJUMP(M)
        COMPLAB(L)
        TRANS(H3X)
        COMPLAB(M)
        SAVELINE := TRNLINE
        TRNLINE := H4!X
        JUMPCOND(H2X, SW, L)
        TRNLINE := SAVELINE
        UNLESS BREAKLABEL=0 DO COMPLAB(BREAKLABEL)
        BREAKLABEL, LOOPLABEL := BL, LL
        RETURN   $)

    CASE S.REPEATWHILE: SW := TRUE
    CASE S.REPEATUNTIL:
    CASE S.REPEAT:
     $( LET L, BL, LL = NEXTPARAM(), BREAKLABEL, LOOPLABEL
        BREAKLABEL, LOOPLABEL := 0, 0
        COMPLAB(L)
        TEST H1!X=S.REPEAT
            THEN $( LOOPLABEL := L
                    TRNLINE:=H3X
                    TRANS(H2X)
                    COMPJUMP(L)  $)
              OR $( TRNLINE:=H4!X
                    TRANS(H2X)
                    UNLESS LOOPLABEL=0 DO COMPLAB(LOOPLABEL)
                    JUMPCOND(H3X, SW, L)  $)
        UNLESS BREAKLABEL=0 DO COMPLAB(BREAKLABEL)
        BREAKLABEL, LOOPLABEL := BL, LL
        RETURN   $)

    CASE S.CASE:
     $( LET L, K = NEXTPARAM(), EVALCONST(H2X)
        IF CASEP>=CASET DO $( TRANSREPORT(141, X)
                              RETURN  $)
        IF CASEB<0 DO TRANSREPORT(105, X)
        FOR I = CASEB TO CASEP-1 DO
                    IF CASEK!I=K DO TRANSREPORT(106, K)
        CASEK!CASEP := K
        CASEL!CASEP := L
        CASEP := CASEP + 1
        COMPLAB(L)
        TRANS(H3X)
        RETURN   $)

    CASE S.DEFAULT:
        IF CASEB<0 DO TRANSREPORT(105, X)
        UNLESS DEFAULTLABEL=0 DO TRANSREPORT(101, X)
        DEFAULTLABEL := NEXTPARAM()
        COMPLAB(DEFAULTLABEL)
        TRANS(H2X)
        RETURN

    CASE S.ENDCASE: IF CASEB<0 DO TRANSREPORT(105, X)
                    COMPJUMP(ENDCASELABEL)
                    RETURN

    CASE S.SWITCHON:
        TRNLINE:=H4!X
        TRANSSWITCH(X)
        RETURN

    CASE S.FOR: TRANSFOR(X)
                RETURN

    CASE S.SEQ:
        TRANS(H2X)
        X := H3X
        GOTO NEXT        $)TR

AND WRITENAMES(X) BE

$(  LET I, N = X, 0
    WHILE I>DVECS DO
    $(  UNLESS DVEC!(I+1)=S.NUMBER THEN N := N+1
        I := I-3
    $)
    OUTN(N)
    WHILE X>DVECS DO
    $(  UNLESS DVEC!(X+1)=S.NUMBER THEN
        $(  OUTSTRING(DVEC!X + 2)
            OUTN(DVEC!(X+1)-S.MANIFEST)
            OUTN(DVEC!(X+2))
        $)
        X := X-3
    $)
$)

AND TRNBLOCKBODY(X) BE

$(1 IF NAMING & INPROC THEN OUT1(S.STARTBLOCK)
    UNTIL X=0 DO
    $(2 LET H2X, OP = H2!X, H1!X
        SWITCHON OP INTO

        $(3 DEFAULT:
                DECLLABELS(X); TRANS(X); RETURN

            CASE S.LET:
                $(  LET S, S1, B = SSP, 0, DVECS
                    TRNLINE := H4!X
                    DECLNAMES(H2X)
                    CHECKDISTINCT(B, DVECS)
                    DVECE := DVECS
                    VECSSP := SSP
                    S1 := SSP
                    SSP := S
                    TRANSDEF(H2X)
                    UNLESS SSP=S1 DO TRANSREPORT(110, X)
                    UNLESS SSP=VECSSP DO $( SSP := VECSSP
                                            OUT2(S.STACK, SSP)  $)
                    OUT1(S.STORE)
                    ENDCASE
                $)

            CASE S.MANIFEST: OP := S.NUMBER
            CASE S.STATIC:
            CASE S.GLOBAL:
                $(  LET Y = H2X
                    TRNLINE := H4!X
                    UNTIL Y=0 DO
                    $(  TEST OP=S.STATIC THEN
                        $(  LET M = NEXTPARAM()
                            ADDNAME(H3!Y, S.LABEL, M)
                            COMPDATALAB(M)
                            OUT2(S.ITEMN, EVALCONST(H4!Y))
                        $)
                        OR ADDNAME(H3!Y, OP, EVALCONST(H4!Y))
                        Y := H2!Y
                        DVECE := DVECS
                    $)

                $)

        $)3
        X := H3!X
    $)2
$)1

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
          $( ADDNAME(H2!X, S.LOCAL, SSP)
             SSP := SSP + 1
             DECLDYN(H3!X)
             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 >= GLOBDECLT DO $( TRANSREPORT(144, X)
                                             RETURN  $)
             GLOBDECL!GLOBDECLS := N
             GLOBDECL!(GLOBDECLS+1) := L
             GLOBDECLS := GLOBDECLS + 2
             RETURN  $)


    $( LET M = NEXTPARAM()
       ADDNAME(X, S.LABEL, M)
       COMPDATALAB(M)
       OUT2P(S.ITEML, L)    $)1


AND DECLLABELS(X) BE
$(  LET B = DVECS
    SCANLABELS(X)
    CHECKDISTINCT(B, DVECS)
    DVECE := DVECS
$)


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


AND ADDNAME(N, P, A) BE
    $( CHECKWORKSPACE()
       DVEC!DVECS, DVEC!(DVECS+1), DVEC!(DVECS+2) := N, P, A
       DVECS := DVECS - 3  $)


AND CELLWITHNAME(N) = VALOF
    $( LET X = DVECE
       X := X + 3 REPEATUNTIL X=0 | DVEC!X=N

       RESULTIS 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)

       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 UNLESS X=0 DO
    $(1 LET SAVELINE=TRNLINE
        TRANSDYNDEFS(X)
        IF STATDEFS(X) DO
           $( LET L, S= NEXTPARAM(), SSP
              COMPJUMP(L)
              TRNLINE := SAVELINE
              TRANSSTATDEFS(X)
              SSP := S
              OUT2(S.STACK, SSP)
              COMPLAB(L)  $)1


AND TRANSDYNDEFS(X) BE
        SWITCHON H1!X INTO
     $( CASE S.AND:
            TRANSDYNDEFS(H2!X)
            TRNLINE := H4!X
            TRANSDYNDEFS(H3!X)
            RETURN

        CASE S.VECDEF:
         $( LET N = EVALCONST(H3!X)
            OUT2(S.LLP, VECSSP + (BACKVEC->N,0))
            SSP := SSP + 1
            VECSSP := VECSSP + 1 + N
            RETURN  $)

        CASE S.VALDEF: LOADLIST(H3!X)
                       RETURN

        DEFAULT: RETURN  $)

AND TRANSSTATDEFS(X) BE
    SWITCHON H1!X INTO
     $( CASE S.AND:
             TRANSSTATDEFS(H2!X)
             TRNLINE := H4!X
             TRANSSTATDEFS(H3!X)
             RETURN

        CASE S.FNDEF: CASE S.RTDEF:
         $(2 LET A, B, C = DVECE, DVECS, DVECP
             AND BL, LL = BREAKLABEL, LOOPLABEL
             AND RL, CB = RESULTLABEL, CASEB
             AND IP = INPROC
             INPROC := TRUE
             BREAKLABEL, LOOPLABEL := -1, -1
             RESULTLABEL, CASEB := -1, -1

             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)  $)

             OUT1(S.ENDPROC)
             TEST NAMING THEN WRITENAMES(B) OR OUTN(0)

             INPROC := IP
             BREAKLABEL, LOOPLABEL := BL, LL
             RESULTLABEL, CASEB := RL, CB
             DVECE, DVECS, DVECP := A, B, C   $)2

        DEFAULT: RETURN   $)

AND STATDEFS(X) = H1!X=S.FNDEF | H1!X=S.RTDEF -> TRUE,
                  H1!X NE S.AND -> FALSE,
                  STATDEFS(H2!X) -> TRUE,
                  STATDEFS(H3!X)

.
SECTION "TRNB"
GET "LIBHDR"
GET "HEADERS(TRNHDR)"

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, B, DL = CASEP, CASEB, DEFAULTLABEL
        AND ECL = ENDCASELABEL
        LET L = NEXTPARAM()
        ENDCASELABEL := NEXTPARAM()
        CASEB := CASEP

        COMPJUMP(L)
        DEFAULTLABEL := 0
        TRANS(H3!X)
        COMPJUMP(ENDCASELABEL)

        COMPLAB(L)
        LOAD(H2!X)
        IF DEFAULTLABEL=0 DO DEFAULTLABEL := ENDCASELABEL
        OUT3P(S.SWITCHON, CASEP-P, DEFAULTLABEL)

        FOR I = CASEB TO CASEP-1 DO $( OUTN(CASEK!I)
                                       OUTL(CASEL!I)  $)

        SSP := SSP - 1
        COMPLAB(ENDCASELABEL)
        ENDCASELABEL := ECL
        CASEP, CASEB, DEFAULTLABEL := P, B, DL   $)1

AND TRANSFOR(X) BE
     $( LET A, B = DVECE, DVECS
        LET L, M = NEXTPARAM(), NEXTPARAM()
        LET BL, LL = BREAKLABEL, LOOPLABEL
        LET K, N = 0, 0
        LET STEP = 1
        LET S = SSP
        BREAKLABEL, LOOPLABEL := 0, 0

        TRNLINE := 6!X
        ADDNAME(H2!X, S.LOCAL, S)
        DVECE := DVECS
        LOAD(H3!X)

        TEST H1!(H4!X)=S.NUMBER
            THEN K, N := S.LN, H2!(H4!X)
              OR $( K, N := S.LP, SSP
                    LOAD(H4!X)  $)

        UNLESS H5!X=0 DO STEP := EVALCONST(H5!X)

        OUT1(S.STORE)
        COMPJUMP(L)
        DECLLABELS(H6!X)
        COMPLAB(M)
        TRANS(H6!X)
        UNLESS LOOPLABEL=0 DO COMPLAB(LOOPLABEL)
        OUT2(S.LP, S); OUT2(S.LN, STEP); OUT1(S.PLUS); OUT2(S.SP, S)
        COMPLAB(L)
        OUT2(S.LP, S); OUT2(K, N); OUT1(STEP<0 -> S.GE, S.LE)
        OUT2P(S.JT, M)

        UNLESS BREAKLABEL=0 DO COMPLAB(BREAKLABEL)
        BREAKLABEL, LOOPLABEL, SSP := BL, LL, S
        OUT2(S.STACK, SSP)
        DVECE, DVECS := A, B  $)


LET LOAD(X) BE
    $(1 IF X=0 DO $( TRANSREPORT(148, CURRENTBRANCH)
                     LOADZERO()
                     RETURN  $)

     $( LET OP = H1!X

        SWITCHON OP INTO
     $( DEFAULT: TRANSREPORT(147, CURRENTBRANCH)
                 LOADZERO()
                 RETURN

        CASE S.BYTEAP:  OP := S.GETBYTE

        CASE S.FDIV:CASE S.FMINUS:
        CASE S.FLS:CASE S.FGR:CASE S.FLE:CASE S.FGE:
        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.SLCTAP:
            LOAD(H3!X)
            OUTSLCT(S.SLCTAP, EVALCONST(H2!X))
            RETURN

        CASE S.FMULT:CASE S.FPLUS:CASE S.FEQ:CASE S.FNE:
        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 | 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.FIX:CASE S.FLOAT:CASE S.ABS:CASE S.FABS:
        CASE S.FNEG:CASE S.NEG: CASE S.NOT: CASE S.RV:
            LOAD(H2!X)
            OUT1(OP)
            RETURN

        CASE S.QUERY: 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.SLCT: OUT2(S.LN, EVALCONST(X))
                     SSP := SSP + 1
                     RETURN

        CASE S.NUMBER:
            OUT2(S.LN, H2!X)
            SSP := SSP + 1
            RETURN

        CASE S.STRING:
            OUT1(S.LSTR); OUTSTRING(LV H2!X)
            SSP := SSP + 1
            RETURN

        CASE S.NAME:
             TRANSNAME(X, S.LP, S.LG, S.LL, S.LN)
             SSP := SSP + 1
             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 M = NEXTPARAM()
            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))
            OUT2P(S.LLL, M)
            SSP := SSP + 1
            RETURN  $)                         $)1


AND LOADLV(X) BE
$(1 LET A2, A3 = 0, 0
    IF X=0 THEN GOTO ERR
    A2, A3 := H2!X, H3!X

    SWITCHON H1!X INTO
     $( DEFAULT:
        ERR:     TRANSREPORT(113, CURRENTBRANCH)
                 LOADZERO()
                 RETURN

        CASE S.NAME:
              TRANSNAME(X, S.LLP, S.LLG, S.LLL, 0)
              SSP := SSP + 1
              RETURN

        CASE S.RV:
            LOAD(A2)
            RETURN

        CASE S.VECAP:
            IF H1!A2=S.NAME THEN
                $( LET T = A2
                    A2 := A3; A3 := T
                $)
            LOAD(A2)
            LOAD(A3)
            OUT1(S.PLUS)
            SSP := SSP - 1
            RETURN
$)1


AND LOADZERO() BE $( OUT2(S.LN, 0)
                     SSP := SSP + 1  $)

AND LOADLIST(X) BE UNLESS X=0 DO
$(  UNLESS H1!X=S.COMMA DO $( LOAD(X); RETURN  $)

    LOADLIST(H2!X)
    LOADLIST(H3!X)
$)

LET EVALCONST(X) = VALOF

$(  IF X=0 THEN RESULTIS 0

    $(  LET H1X, H2X, H3X = H1!X, H2!X, H3!X

        SWITCHON H1X INTO

        $(  CASE S.NUMBER: RESULTIS H2X
            CASE S.TRUE:   RESULTIS TRUE
            CASE S.FALSE:  RESULTIS FALSE
            CASE S.QUERY:  RESULTIS 0

            CASE S.NEG: RESULTIS -EVALCONST(H2X)
            CASE S.NOT: RESULTIS NOT EVALCONST(H2X)
            CASE S.ABS: RESULTIS ABS EVALCONST(H2X)

            CASE S.NAME:
            $(  LET T = CELLWITHNAME(X)
                IF T = 0 DO
                $(  TRANSREPORT(121, X)
                    RESULTIS 0
                $)
                IF DVEC!(T+1)=S.NUMBER THEN RESULTIS DVEC!(T+2)
                TRANSREPORT(119, X)
                RESULTIS 0
            $)

            DEFAULT: TRANSREPORT(118, X); RESULTIS 0

            CASE S.MULT: CASE S.DIV: CASE S.REM: CASE S.PLUS: CASE S.MINUS:
            CASE S.LOGAND: CASE S.LOGOR: CASE S.EQV: CASE S.NEQV:
            CASE S.LSHIFT: CASE S.RSHIFT: CASE S.SLCT:
        $)
        $(  LET E2 = EVALCONST(H2X)
            AND E3 = EVALCONST(H3X)

            SWITCHON H1X INTO

            $(  CASE S.MULT:   RESULTIS E2*E3
                CASE S.DIV: CASE S.REM:
                    IF E3=0 DO
                    $( TRANSREPORT(120, X); RESULTIS 0 $)
                    RESULTIS H1X=S.DIV -> E2/E3, E2 REM E3
                CASE S.PLUS:   RESULTIS E2+E3
                CASE S.MINUS:  RESULTIS E2-E3

                CASE S.LOGAND: RESULTIS E2&E3
                CASE S.LOGOR:  RESULTIS E2|E3
                CASE S.EQV:    RESULTIS E2 EQV E3
                CASE S.NEQV:   RESULTIS E2 NEQV E3
                CASE S.LSHIFT: RESULTIS E2 << E3
                CASE S.RSHIFT: RESULTIS E2 >> E3

                CASE S.SLCT:   RESULTIS PACKSLCT(E2, E3, EVALCONST(H4!X))
            $)
        $)
    $)
$)

AND ASSIGN(X, Y, N) BE
    $(1 IF X=0 | 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, N)
            ASSIGN(H3!X, H3!Y, N)
            RETURN

        CASE S.NAME:
            IF N=S.STIND THEN
            $(  LOAD(Y)
                TRANSNAME(X, S.SP, S.SG, S.SL, 0)
                SSP := SSP-1
                RETURN
            $)

        CASE S.RV: CASE S.VECAP:
            LOAD(Y); LOADLV(X)
            IF N NE S.STIND THEN OUT1(S.MOD)
            OUT1(N)
            SSP := SSP - 2
            RETURN

        CASE S.BYTEAP:
           TEST N NE S.STIND THEN
           $(
               LOAD(X)
               LOAD(Y)
               OUT1(N)
               SSP := SSP - 1
           $)
           ELSE LOAD(Y)
           LOAD(H2!X)
           LOAD(H3!X)
           OUT1(S.PUTBYTE)
           SSP:=SSP-3
           RETURN

        CASE S.SLCTAP:
            TEST N=S.STIND
               THEN LOAD(Y)
               OR $( LOAD(X)
                     LOAD(Y)
                     OUT1(N)
                     SSP := SSP-1  $)
            LOAD(H3!X)
            OUTSLCT(S.SLCTST, EVALCONST(H2!X))
            SSP := SSP-2
            RETURN

        DEFAULT: TRANSREPORT(109, CURRENTBRANCH)   $)1


AND TRANSNAME(X, P, G, L, N) BE
    $(1 LET T = CELLWITHNAME(X)
        LET K, A = DVEC!(T+1), DVEC!(T+2)

        IF T=0 DO $( TRANSREPORT(115, X)
                     OUT2(G, 0)
                     RETURN  $)

        SWITCHON K INTO
        $( CASE S.LOCAL: IF T>DVECP DO TRANSREPORT(116, X)
                         OUT2(P, A); RETURN

           CASE S.GLOBAL: OUT2(G, A); RETURN

           CASE S.LABEL: OUT2P(L, A); RETURN

           CASE S.NUMBER: IF N=0 DO $( TRANSREPORT(113, X)
                                       N := P  $)
                          OUT2(N, A)  $)1

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

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

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

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

AND OUT1(X) BE WRITEOP(X)

AND OUT2(X, Y) BE
    $( WRITEOP(X)
       WRN(Y) $)

AND OUT2P(X, Y) BE
    $( WRITEOP(X); WRC('L')
       WRN(Y) $)

AND OUT3P(X, Y, Z) BE
    $( WRITEOP(X)
       WRN(Y); WRC('L')
       WRN(Z) $)


AND OUTN(N) BE WRN(N)

AND OUTL(X) BE
    $( WRC('*S'); WRC('L'); WRN(X) $)

AND OUTC(X) BE WRN(CHARCODE(X))

AND OUTSTRING(S) BE

$(  LET V = VEC 256
    UNPACKSTRING(S, V)
    OUTN(V!0)
    FOR I = 1 TO V!0 DO OUTC(V!I)
    WRC('*S')
$)


AND WRITEOP(X) BE
    $(1 LET S = VALOF SWITCHON X&255 INTO
        $( DEFAULT: TRANSREPORT(199, CURRENTBRANCH)
                    RESULTIS "ERROR"

           CASE S.FIX:     RESULTIS "FIX"
           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.ABS:     RESULTIS "ABS"
           CASE S.NEG:     RESULTIS "NEG"
           CASE S.NOT:     RESULTIS "NOT"
           CASE S.RV:      RESULTIS "RV"

           CASE S.GETBYTE: RESULTIS "GETBYTE"
           CASE S.PUTBYTE: RESULTIS "PUTBYTE"

           CASE S.SLCTAP:  RESULTIS "SLCTAP"
           CASE S.SLCTST:  RESULTIS "SLCTST"
           CASE S.MOD:     RESULTIS "MOD"
           CASE S.MODSLCT: RESULTIS "MODSLCT"

           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.STARTBLOCK: RESULTIS "STARTBLOCK"
           CASE S.ENDBLOCK: RESULTIS "ENDBLOCK"
           CASE S.ENDPROC: RESULTIS "ENDPROC"
           CASE S.RES:     RESULTIS "RES"
           CASE S.RSTACK:  RESULTIS "RSTACK"
           CASE S.FINISH:  RESULTIS "FINISH"
           CASE S.SECTION:  RESULTIS "SECTION"
           CASE S.NEEDS:    RESULTIS "NEEDS"
           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"   $)

        LET V = VEC 20
        UNPACKSTRING(S, V)
        UNLESS (X&FLBIT)=0 DO WRC('#')
        FOR I = 1 TO V!0 DO WRC(V!I)
        WRC('*S')
        PUTBYTES(X)
$)1


AND WRN(N) BE $( PUTBYTES(N)
                 IF N<0 THEN $( WRC('-'); N := -N $)
                 WRPN(N); WRC('*S')  $)

AND WRPN(N) BE $( IF N>9 DO WRPN(N/10)
                  WRC(N REM 10 + '0')  $)

AND ENDOCODE() BE $( WRCH('*N'); OCOUNT := 0  $)


AND WRC(CH) BE $( OCOUNT := OCOUNT + 1
                  IF OCOUNT>62 & CH='*S' DO
                            $( WRCH('*N'); OCOUNT := 0; RETURN  $)
                  WRCH(CH)  $)

AND PACKSLCT(A, B, C) = (A<<5 | B) <<10 | C

AND OUTSLCT(OP, S) BE

$(  LET C, BA = S REM 1024, S/1024
    WRITEOP(OP); WRN(BA/32); WRN(BA REM 32); WRN(C)
$)

AND PUTBYTES(N) BE

$(  LET K = N>>7
    TEST K=0 THEN WRBYTE(N)
    OR $( WRBYTE((N&127)+128)
          PUTBYTES(K)
       $)
$)

AND WRBYTE(N) BE $( PUTBYTE(OBUFP, OBUFB, N)
                    OBUFB := OBUFB+1
                    IF OBUFB=BYTESPERWORD THEN
                         OBUFP, OBUFB := OBUFP+1, 0
                    CHECKWORKSPACE()
                 $)

AND CHECKWORKSPACE() BE
$(  LET SLACK = DVEC+DVECS-OBUFP
    IF SLACK<TRNUNUSED DO
    $(  TRNUNUSED := SLACK
        IF TRNUNUSED <= 0 DO
        $(  TRANSREPORT(145, CURRENTBRANCH)
            STOP(8)
        $)
    $)
$)
