GET "SY:TRAN.GET"



STATIC $( WP=0  $)

LET READOP() = VALOF
    $(1 LET S = VEC 20
        LET T(S) = VALOF
        $( FOR I = 0 TO (S%0+1)/2 DO UNLESS S%I=WORDV%I RESULTIS FALSE
           RESULTIS TRUE   $)

        NEXTCH()
        IF CH = 26 \/ CH= '^' RESULTIS S.END
        CC := CC+1
        WP := 0
     $( WP := WP + 1
        S%WP := CH
        CH := RDCH() $) REPEATWHILE 'A' LE CH LE 'Z'

        S%0 := WP
        PACKSTRING(S, WORDV)

        SWITCHON S%1 INTO
     $( DEFAULT: IF CH=26 RESULTIS S.END
                 RESULTIS ERROR

        CASE 'C':
        RESULTIS T('CODE') -> S.CODE, ERROR
 
        CASE 'D':
        RESULTIS T('DATALAB') -> S.DATALAB,
                 T('DIV') -> S.DIV,ERROR 

        CASE 'E':
        RESULTIS T('EQ') -> S.EQ,
                 T('ENTRY') -> S.ENTRY,
                 T('EQV') -> S.EQV,
                 T('END') -> S.END, ERROR

        CASE 'F':
        RESULTIS T('FNAP') -> S.FNAP,
                 T('FNRN') -> S.FNRN,
                 T('FALSE') -> S.FALSE,
                 T('FINISH') -> S.FINISH, ERROR


        CASE 'G':
        RESULTIS T('GOTO') -> S.GOTO,
                 T('GE') -> S.GE,
                 T('GR') -> S.GR,
                 T('GLOBAL') -> S.GLOBAL, ERROR

        CASE 'I':
        RESULTIS T('ITEMN') -> S.ITEMN,
                 T('ITEML') -> S.ITEML,  ERROR

        CASE 'J':
        RESULTIS T('JUMP') -> S.JUMP,
                 T('JF') -> S.JF,
                 T('JT') -> S.JT,  ERROR

        CASE 'L':
        IF WP=2 DO
             SWITCHON S%2 INTO
             $( DEFAULT: RESULTIS ERROR
                CASE 'E': RESULTIS S.LE
                CASE 'N': RESULTIS S.LN
                CASE 'G': RESULTIS S.LG
                CASE 'P': RESULTIS S.LP
                CASE 'L': RESULTIS S.LL
                CASE 'S': RESULTIS S.LS  $)

        RESULTIS T('LAB') -> S.LAB,
                 T('LLG') -> S.LLG,
                 T('LLL') -> S.LLL,
                 T('LLP') -> S.LLP,
                 T('LOGAND') -> S.LOGAND,
                 T('LOGOR') -> S.LOGOR,
                 T('LSHIFT') -> S.LSHIFT,
                 T('LSTR') -> S.LSTR, ERROR

        CASE 'M':
        RESULTIS T('MINUS') -> S.MINUS,
                 T('MULT') -> S.MULT, ERROR

        CASE 'N':
        RESULTIS  T('NE') -> S.NE,
                  T('NEG') -> S.NEG,
                  T('NEQV') -> S.NEQV,
                  T('NOT') -> S.NOT,  ERROR
 
        CASE 'P':
        RESULTIS T('PLUS') -> S.PLUS, ERROR

        CASE 'R':
        RESULTIS T('RES') -> S.RES,
                 T('REM') -> S.REM,
                 T('RTAP') -> S.RTAP,
                 T('RTRN') -> S.RTRN,
                 T('RSHIFT') -> S.RSHIFT,
                 T('RSTACK') -> S.RSTACK,
                 T('RV') -> S.RV, ERROR

        CASE 'S':
        RESULTIS T('SG') -> S.SG,
                 T('SP') -> S.SP,
                 T('SL') -> S.SL,
                 T('STIND') -> S.STIND,
                 T('STACK') -> S.STACK,
                 T('SAVE') -> S.SAVE,
                 T('SWITCHON') -> S.SWITCHON,
                 T('STORE') -> S.STORE, ERROR

        CASE 'T':
        RESULTIS T('TRUE') -> S.TRUE,ERROR  $)1   


AND READL() = VALOF
        $(1 LET N = 0
        NEXTCH()
        IF CH NE 'L' DO $( REPORT("LABEL DOES NOT START WITH LETTER L");RESULTIS 0 $)
        N := READN()+LABELBASE
        IF N>TOPLABEL TOPLABEL:=N
        RESULTIS N
$)1

AND NEXTCH() BE CH := RDCH() REPEATWHILE CH='*S' \/ CH='*N'
.


 
 
GET "SY:BCPLIB"
 
GLOBAL $(
MOREINPUT:105
TRANSLATE:106
REPORT   :113
SU       :186
DU       :187
$)
 
STATIC $( NEXT.P=0; NEXT.L=0
          EXIT.P=0; EXIT.L=0 $)
 
STATIC $( DEFAULTERROR=0; REPORTCOUNT=0; CSIBLOCK=0 $)
 
STATIC $( CONSOLE=0; MACRO=0 $)
 
LET CMLERR() BE
    $( WRITES("COMMAND LINE ERROR*N")
       LONGJUMP(EXIT.P, EXIT.L) $)
 
AND RESTART() BE
    $( UNHEAP(CSIBLOCK)
       LONGJUMP(NEXT.P, NEXT.L) $)
 
AND SYNERR() BE
    $( WRITES("SYNTAX ERROR*N")
       RESTART() $)
 
AND OPENIERR() BE
    $( OUTPUT := CONSOLE
       WRITES("OPEN FAIL ON INPUT FILE*N")
       UNLESS INPUT%FILE=0 CLOSE(MACRO%FILE)
       RESTART() $)
 
AND OPENOERR() BE
    $( WRITES("OPEN FAIL ON OUTPUT FILE*N")
       CLOSE(INPUT%FILE)
       RESTART() $)
 
AND ISWITCHERR() BE
    $( OUTPUT := CONSOLE
       WRITES("ILLEGAL INPUT SWITCH*N")
       UNLESS INPUT%FILE=0 CLOSE(MACRO%FILE)
       RESTART() $)
 
AND OSWITCHERR() BE
    $( WRITES("ILLEGAL OUTPUT SWITCH*N")
       CLOSE(INPUT%FILE)
       RESTART() $)
 
AND MOREINPUT() = VALOF
    $( LET DATASET=0
       UNLESS INPUT%FILE=0 CLOSE(INPUT%FILE)
       ERROR := ISWITCHERR
       DATASET := PARSEINPUT(CSIBLOCK, 0)
       IF DATASET=0 RESULTIS FALSE
       ERROR := OPENIERR
       INPUT%FILE := OPENINPUT(DATASET,IDEFAULT(),120)
       INPUT%POINTER, INPUT%ENDED := 0, FALSE
       ERROR := DEFAULTERROR
       RESULTIS TRUE $)
 
AND IDEFAULT() BE
    CODE "	MOV	#IDFN/2,R0"
 
AND ODEFAULT() BE
    CODE "	MOV	#ODFN/2,R0"
 
AND DUMMY() BE $(
    CODE "	.MCALL	NMBLK$"
    CODE "IDFN:	NMBLK$	INPUT,OCO"
    CODE "ODFN:	NMBLK$	OUTPUT,MAC"
    CODE "	.MCALL	CSI$SW,CSI$ND,CSI$SV"
    CODE "SW:	CSI$SW	ID,,,,,IDV"
    CODE "	CSI$SW	TI,,,,,TIV"
    CODE "	CSI$SW	PS,,,,,PSV"
    CODE "	CSI$ND"
    CODE "IDV:	CSI$SV	,IDS+2,6"
    CODE "	CSI$ND"
    CODE "TIV:	CSI$SV	,TIS+2,6"
    CODE "	CSI$ND"
    CODE "PSV:	CSI$SV	,PSS+2,6"
    CODE "	CSI$ND"
    CODE "IDS:	6,0,0,0"
    CODE "TIS:	6,0,0,0"
    CODE "PSS:	6,0,0,0" $)
 
AND OSWITCH() BE
    CODE "	MOV	#SW/2,R0"
 
AND REPORT(S,P) BE
    $( OUTPUT := CONSOLE
       WRITES("REPORT: ")
       WRITEF(S,P)
       NEWLINE()
       REPORTCOUNT := REPORTCOUNT+1
       IF REPORTCOUNT > 6
       $( WRITES("TRANSLATION ABORTED*N")
          CLOSE(INPUT%FILE)
          CLOSE(MACRO%FILE)
          LONGJUMP(NEXT.P, NEXT.L) $)
       OUTPUT := MACRO $)
 
START: $(S
      LET INBUFF = VEC 120
      LET OUTBUFF = VEC 120
      LET ISTREAM = VEC STREAMSIZE
      LET OSTREAM = VEC STREAMSIZE
      LET CBUFF = VEC 41
      LET COMMAND, DATASET = 0, 0
      INPUT := ISTREAM
      MACRO := OSTREAM
      INPUT%BUFFER := INBUFF
      INPUT%ENDOF  := ENDOFFILE
      INPUT%TRANSFER := READREC
      MACRO%BUFFER := OUTBUFF
      MACRO%ENDOF := ENDOFFILE
      MACRO%TRANSFER := WRITEREC
      DEFAULTERROR := ERROR
      INITIALIZEIO()
      CONSOLE := CREATEOUTPUT("TI:")
      NEXT.L, NEXT.P := NEXT, LEVEL()
      EXIT.L, EXIT.P := EXIT, LEVEL()
 
NEXT: OUTPUT := CONSOLE
      REPORTCOUNT := 0
      INPUT%FILE := 0
      ERROR := CMLERR
      COMMAND := READCOMMAND("TRAN>", CBUFF)
      IF COMMAND=0 GOTO EXIT
      ERROR := SYNERR
      CSIBLOCK := ANALYZE(COMMAND)
      UNLESS MOREINPUT() SYNERR()
      ERROR := OSWITCHERR
      DATASET := PARSEOUTPUT(CSIBLOCK, OSWITCH())
      IF DATASET=0 $( CLOSE(INPUT%FILE); SYNERR() $)
      ERROR := OPENOERR
      MACRO%FILE := OPENOUTPUT(DATASET,ODEFAULT(),120)
      MACRO%POINTER := 0
      ERROR := DEFAULTERROR
      OUTPUT := MACRO
      TRANSLATE()
      OUTPUT := CONSOLE
      IF REPORTCOUNT>0
      $( WRITEF("TRANSLATION FAILED - %N", REPORTCOUNT)
         WRITEF(" ERROR%C*N", REPORTCOUNT=1 -> '*S','S') $)
//      WRITEF("%O BYTES CODE, %O BYTES DATA*N", SU*2, DU*2)
      CLOSE(MACRO%FILE)
      UNHEAP(CSIBLOCK)
      GOTO NEXT
 
EXIT: ENDWRITE(CONSOLE)
      FINISH $)S
.
 
  GET "SY:TRAN.GET"

STATIC $( PARAMNUMBER=0 $)
 
LET TRANSLATE() BE
$(T LET V = VEC DATAMAX
    DATAV, DATAP := V, 0

$(  LET V = VEC 30
    BLOCKNAME := V

$(  LET V = VEC 500
    TEMPV := V

$(  LET V = VEC 500
    LIST := V

$(  LET V = VEC 63
    LABV := V

$(  LET V = VEC 63
    LABL := V

$(  LET V = VEC 50
    WORDV := V

$(  LET V = VEC 400
    GLIB := V
    FOR I = 1 TO 400 GLIB%I := 0
    GLIB%0 := 1

$(  LET V = VEC 3
    REG := V
    FOR I=0 TO 3 REG%I := FREE

    TOPLABEL := 0
    PARAMNUMBER := 10000
    CC, SU, DU := 0, 0, 0
    CGPROGRAMHEAD()
    WHILE ANOTHERBLOCK() DO
    $(  INITSTACK(3)
        INITLABS()
        LABELBASE := TOPLABEL
        CGPSECT(BLOCKNAME)
        CGBLOCK()
        CGSTATICS() $)
    CGPROGRAMEND()  $)T

AND CGPROGRAMHEAD() BE
$(  LET T, I, P = TITLE(), IDENT(), PSECT()
    WRITEF("*T.TITLE*T%S*N", T%1=0 -> "BCPL", T)
    UNLESS I%1=0 WRITEF("*T.IDENT*T/%S/*N", I)
    BLOCKNAME := P%1=0 -> "BCPL", P
    WRITES("*TT=%4*N*TP=%5*N")
    WRITES("*T.ENABL*TLC*N")
    CGPSECT("GLOBAL,GBL,OVR")
    WRITES("GV:*N")  $)

AND CGPROGRAMEND() BE
$(  FOR I = 0 TO 59
    DO IF GLIB%I>0 WRITEF("*T.GLOBL*TG%N*N",I)
    WRITES("*T.END*N")  $)

AND CGSTATICS() BE
$(  IF DATAP=0 RETURN
    CGPSECT("CONST")
    FOR I=0 TO DATAP-1 BY 2 DO
    SWITCHON DATAV%I INTO $(

    CASE S.DATALAB: COMPL(DATAV%(I+1)); ENDCASE

    CASE S.ITEML:   COMPWL(DATAV%(I+1)); DU := DU+1; ENDCASE

    CASE S.ITEMN:   COMPWN(DATAV%(I+1)); DU := DU+1; ENDCASE $)

    DATAP := 0  $)

AND CGPSECT(NAME) BE
    WRITEF("*T.PSECT*T%S*N",NAME)

AND TITLE() BE
    CODE "	MOV	#TIS/2,R0"
 
AND IDENT() BE
    CODE "	MOV	#IDS/2,R0"
 
AND PSECT() BE
    CODE "	MOV	#PSS/2,R0"
 
AND ANOTHERBLOCK() = VALOF
$(  LET S = VEC 100
    LET N = 0
    $( CH := RDCH()
       IF CH=26 \/ CH='^' UNLESS MOREINPUT() RESULTIS FALSE
    $) REPEATUNTIL 'A' <= CH <= 'Z'
    $( N := N+1
       S%N := CH
       CH := RDCH() 
    $) REPEATUNTIL CH = '*N'
    S%0 := N
    RESULTIS TRUE $)
 
AND NEXTPARAM() = VALOF
    $( PARAMNUMBER := PARAMNUMBER-1; RESULTIS PARAMNUMBER $)
 .

  GET "SY:TRAN.GET"
 


LET INITSTACK(N) BE
    $( ARG2, ARG1 := TEMPV, TEMPV+TEMPSIZE
       SSP := N; PENDINGOP := S.NONE; BASE := N-2
       FOR I = 0 TO 3 DO REG%I := FREE
       H1%ARG2, H2%ARG2, H3%ARG2 := S.LOCAL, SSP-2, SSP-2
       H1%ARG1, H2%ARG1, H3%ARG1 := S.LOCAL, SSP-1, SSP-1
$)


AND STACK(N) BE
    $(1 PENDINGOP := S.NONE 

        IF N GE SSP+6 DO
            $( STORE(BASE,SSP-1)
               INITSTACK(N)
               RETURN   $)

        WHILE N GR SSP DO LOADT(S.LOCAL, SSP)

     L: IF N=SSP RETURN

         UNLESS ARG2=TEMPV DO $( REDUCE(); GOTO L $)


        INITSTACK(N)   $)1



AND STORE(A,B) BE $(1

 NEXT:   IF A>SSP-1 LOGOR A>B RETURN

   $( LET P=TEMPV+(A-BASE)*TEMPSIZE
      TEST LOCAL(P)
      THEN $( A := A+1; GOTO NEXT $)
      OR  $(
            LET Z=A+3
            TEST (Z<B  LOGAND  Z<SSP-1  LOGAND  NEXTTHREE(P))

            THEN $(
                   COMPD(MOV,S.REGISTER,PREG,S.REGISTER,WREG)
                   COMPD(ADD,S.NUMBER,2*A,S.REGISTER,WREG)

                   FOR I = A TO B<SSP-1 -> B,SSP-1 DO $(
                    IF LOCAL(P) GOTO NEXT
                    TEST NUMBERIS(0,P)
                    THEN COMPS(CLR,S.AUTOINC,WREG)
                    OR COMPD(MOV,S.STACK,P,S.AUTOINC,WREG)

                    IF H1%P = S.REGISTER REG%(H2%P) := FREE
                    H1%P,H2%P := S.LOCAL,H3%P
                    P := P+TEMPSIZE
                    A := A+1  $)

                  GOTO NEXT $)

            OR TEST NUMBERIS(0,P)
               THEN COMPSX(CLR,2*A,PREG)
               OR COMPDX2(MOV,S.STACK,P,2*A,PREG)

               IF H1%P=S.REGISTER REG%(H2%P) := FREE
               H1%P,H2%P := S.LOCAL,H3%P

               A := A+1
               GOTO NEXT

$)1


AND LOCAL(A) = VALOF $(
IF H1%A=S.LOCAL  LOGAND  H2%A=H3%A RESULTIS TRUE
RESULTIS FALSE
$)


AND NEXTTHREE(P) = VALOF $(
IF (NOT LOCAL(P+TEMPSIZE)  LOGAND  NOT LOCAL(P+2*TEMPSIZE)  LOGAND  NOT LOCAL(P+3*TEMPSIZE))
RESULTIS TRUE
RESULTIS FALSE
$)
.





  GET "SY:TRAN.GET"

LET CGBLOCK() BE
$(1    LET NEXTOP=0
      OP := S.NONE

NEXT: NEXTOP := READOP()
      IF OP=S.LAB  LOGAND  NEXTOP=S.LAB WRCH('*N')
      OP := NEXTOP

   L: SWITCHON OP INTO

 $( DEFAULT: REPORT("UNKNOWN KEYWORD,  %S",WORDV);  GOTO NEXT

      CASE S.END: RETURN

      CASE S.LG: LOADT(S.GLOBAL,READN()); GOTO NEXT
      CASE S.LP: LOADT(S.LOCAL, READN()); GOTO NEXT
      CASE S.LL: LOADT(S.LABEL, READL()); GOTO NEXT

      CASE S.LN: LOADT(S.NUMBER, READN()); GOTO NEXT

      CASE S.LSTR: CGSTRING(READN()); GOTO NEXT

      CASE S.TRUE: LOADT(S.NUMBER, #177777); GOTO NEXT
      CASE S.FALSE: LOADT(S.NUMBER, 0); GOTO NEXT


     CASE S.LLP: LOADLVP(READN()); GOTO NEXT
     CASE S.LLG: LOADT(S.LVGLOBAL,READN()); GOTO NEXT
     CASE S.LLL: LOADT(S.LVLABEL,READL()); GOTO NEXT

     CASE S.SP:   STOREIN(S.LOCAL,READN()); GOTO NEXT
     CASE S.SG: STOREIN(S.GLOBAL,READN()); GOTO NEXT
     CASE S.SL:   STOREIN(S.LABEL,READL()); GOTO NEXT
     CASE S.STIND:STOREI(); GOTO NEXT

     CASE S.MULT:CASE S.DIV:CASE S.REM:
     CASE S.PLUS:CASE S.MINUS:CASE S.NEG:
     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.NOT:CASE S.RV:
           UNLESS PENDINGOP=S.NONE DO SIMPLIFY()
           PENDINGOP := OP
           GOTO NEXT


     CASE S.JUMP: SIMPLIFY()
                  STORE(BASE, SSP-1)
                 CGBRANCH(BR,READL())
                  GOTO NEXT

     CASE S.JT:  BRANCH(TRUE, READL()); GOTO NEXT
     CASE S.JF:  BRANCH(FALSE, READL()); GOTO NEXT

     CASE S.GOTO:
        SIMPLIFY()
        STORE(BASE, SSP-2)
        COMPS(JMP,S.STACKDEF,ARG1)
        STACK(SSP-1)
      ALLOWJP()
        GOTO NEXT

    CASE S.LAB: SIMPLIFY()
                STORE(BASE,SSP-1)
                CGLABEL(READL())
                GOTO NEXT

     CASE S.STACK: SIMPLIFY()
                   STACK(READN())
                   GOTO NEXT

     CASE S.STORE: SIMPLIFY()
                   STORE(BASE, SSP-1)
                   GOTO NEXT

    CASE S.ENTRY: CGENTRY(READN(),READL()); GOTO NEXT
    CASE S.CODE:   CGCODE(READN()); GOTO NEXT

    CASE S.SAVE: CGSAVE(READN()); GOTO NEXT

    CASE S.FNAP: 
    CASE S.RTAP:CGAPPLY(OP, READN())
                GOTO NEXT

    CASE S.RTRN:
    CASE S.FNRN: SIMPLIFY()
                 CGRETURN(OP); GOTO NEXT

    CASE S.RES: $( LET LAB=READL()
                   SIMPLIFY()
                   STORE(BASE, SSP-2)
                   MOVETOR(ARG1,0)
                   REDUCE()
                   OP := READOP()
                   TEST OP = S.LAB
                   THEN $( LET NEXTLAB = READL()
                           IF LAB NE NEXTLAB CGBRANCH(BR,LAB)
                           CGLABEL(NEXTLAB)
                           GOTO NEXT $)
                   OR   CGBRANCH(BR,LAB); GOTO L $)

    CASE S.RSTACK:
        SIMPLIFY()
        STACK(READN())
        LOADT(S.REGISTER, 0)
        GOTO NEXT

    CASE S.FINISH:
        COMPS(JMP,S.LIB,"STOP")
        ALLOWJP()
        GOTO NEXT

    CASE S.SWITCHON:
        CGSWITCH()
        GOTO NEXT

     CASE S.GLOBAL: CGGLOBAL(READN()); RETURN
     CASE S.DATALAB:
     CASE S.ITEML:
     CASE S.ITEMN:  DATAV%DATAP := OP
                    DATAV%(DATAP+1) := OP=S.ITEMN -> READN(),READL()
                    DATAP := DATAP+2
                    IF DATAP>DATAMAX $(
                       REPORT("STATIC SPACE EXCEEDED"); DATAP := 0 $)
                    GOTO NEXT

$)1


.





  GET "SY:TRAN.GET"

LET SIMPLIFY() BE $(1

        IF PENDINGOP=S.NONE RETURN

        $(
        LET R = 0
        AND F,SOURCE,DESTINATION = 0,ARG1,ARG2

        UNLESS EXCEPTIONS(DESTINATION) DO R:=REGISTER(DESTINATION)

        SWITCHON PENDINGOP INTO $(

                DEFAULT:
                CASE S.NONE:    RETURN

                CASE S.EQ: F := BNE; GOTO BL
                CASE S.NE: F := BEQ; GOTO BL
                CASE S.LS: F := BGE; GOTO BL
                CASE S.GR: F := BLE; GOTO BL
                CASE S.LE: F := BGT; GOTO BL
                CASE S.GE: F := BLT; GOTO BL

                BL:     $( LET L = NEXTPARAM()
			R := FREEREG()
                        COMPS(CLR,S.REGISTER,R)
                        TEST NUMBERIS(0,SOURCE)
                        THEN COMPS(TST,S.STACK,DESTINATION)
                        OR COMPD(CMP,S.STACK,DESTINATION,S.STACK,SOURCE)
                        COMPS(F,S.LABEL,L)
                        COMPS(COM,S.REGISTER,R)
			COMPL(L)
                        LOSE1(R)
                        RETURN $)


                CASE S.EQV:
		CASE S.NEQV:
			$( LET RS = REGISTER(SOURCE)
			   COMPD(XOR,S.REGISTER,RS,S.REGISTER,R)
                             IF PENDINGOP = S.EQV COMPS(COM,S.REGISTER,R)
                             LOSE1(R)
                             RETURN $)


                CASE S.PLUS:

                IF (NOT NUMBERIS(0,SOURCE))
                        TEST NUMBERIS(1,SOURCE)
                        THEN COMPS(INC,S.REGISTER,R)
                        OR $(
                                TEST NUMBERIS(1,DESTINATION)
                                THEN $(
                                        R := REGISTER(SOURCE)
                                        COMPS(INC,S.REGISTER,R)
                                $)

                                OR COMPD(ADD,S.STACK,SOURCE,S.REGISTER,R)
                        $)

                        LOSE1(R)
                        RETURN


                CASE S.MINUS:

                        IF (NOT NUMBERIS(0,SOURCE))
                        TEST NUMBERIS(1,SOURCE)
                        THEN COMPS(DEC,S.REGISTER,R)
                        OR COMPD(SUB,S.STACK,SOURCE,S.REGISTER,R)

                        LOSE1(R)
                        RETURN



                CASE S.MULT:

                        IF (NOT NUMBERIS(1,SOURCE))
                        TEST NUMBERIS(2,SOURCE)
                        THEN COMPS(ASL,S.REGISTER,R)
                        OR TEST NUMBERIS(2,DESTINATION)
                           THEN $(
                                R := REGISTER(SOURCE)
                                COMPS(ASL,S.REGISTER,R)  $)

                        OR      COMPD(MUL,S.STACK,SOURCE,S.REGISTER,R)
                        LOSE1(R)
                        RETURN


                CASE S.DIV:
                CASE S.REM:

                        IF NOT (NUMBERIS(1,SOURCE)  LOGAND  PENDINGOP = S.DIV)
                        TEST (NUMBERIS(2,SOURCE)  LOGAND  PENDINGOP=S.DIV)
                        THEN COMPS(ASR,S.REGISTER,R)
                        OR $(   VACATE(R-1)
                                COMPS(TST,S.REGISTER,R)
                                COMPS(SXT,S.REGISTER,R-1)
                                COMPD(DIV,S.STACK,SOURCE,S.REGISTER,R-1)
                                TEST PENDINGOP=S.DIV
                                THEN $( REG%R := FREE; R:=R-1 $)
                                OR      REG%(R-1):=FREE  $)
                        LOSE1(R)
                        RETURN


                CASE S.LOGOR:
                        COMPD(BIS,S.STACK,SOURCE,S.REGISTER,R)
                        LOSE1(R)
                        RETURN


                CASE S.LOGAND:
                        TEST H1%SOURCE = S.NUMBER
                        THEN $(
                                LET R = REGISTER(DESTINATION)
                                COMPD(BIC,S.NUMBER,NOT H2%SOURCE,S.REGISTER,R)
                                LOSE1(R)
                                RETURN  $)
                          OR TEST H1%DESTINATION = S.NUMBER
                             THEN $(
                                LET R = REGISTER(SOURCE)
                            COMPD(BIC,S.NUMBER,NOT H2%DESTINATION,S.REGISTER,R)
                                LOSE1(R)
                                RETURN  $)
                       OR $( LET R,RS = REGISTER(DESTINATION),REGISTER(SOURCE)
                           COMPS(COM,S.REGISTER,RS)
                           COMPD(BIC,S.REGISTER,RS,S.REGISTER,R)
                           LOSE1(R)
                           RETURN  $)


                CASE S.LSHIFT:
			TEST NUMBERIS(1,SOURCE)
			THEN COMPS(ASL,S.REGISTER,R)
			OR   COMPD(ASH,S.STACK,SOURCE,S.REGISTER,R)
			LOSE1(R)
			RETURN
 
                CASE S.RSHIFT:
			UNLESS H1%SOURCE=S.NUMBER COMPS(NEG,S.REGISTER,REGISTER(SOURCE))
			VACATE(R-1)
			COMPS(CLR,S.REGISTER,R-1)
			TEST H1%SOURCE=S.NUMBER
			THEN COMPD(ASHC,S.NUMBER,-(H2%SOURCE),S.REGISTER,R-1)
			OR   COMPD(ASHC,S.STACK,SOURCE,S.REGISTER,R-1)
			LOSE1(R)
			RETURN


                CASE S.NEG:
                CASE S.NOT:
                        $(  LET RS = REGISTER(SOURCE)
                            COMPS(PENDINGOP=S.NEG -> NEG,COM,S.REGISTER,RS)
                            PENDINGOP := S.NONE
                            RETURN  $)


                CASE S.RV:
                        $(  LET RS = REGISTER(SOURCE)
                            COMPS(ASL,S.REGISTER,RS)
                            COMPD(MOV,S.REGDEF,RS,S.REGISTER,RS)
                            PENDINGOP := S.NONE
                            RETURN  $)

$)1


AND EXCEPTIONS(D) = VALOF $(
LET A = PENDINGOP
IF ((A=S.PLUS  LOGAND  NUMBERIS(1,D)) LOGOR (A=S.MULT  LOGAND  NUMBERIS(2,D)))
RESULTIS TRUE
IF (A=S.NEG LOGOR A=S.NOT LOGOR A=S.RV LOGOR A=S.LOGAND)
RESULTIS TRUE
IF S.EQ <= A <= S.GE RESULTIS TRUE
RESULTIS FALSE
$)

.





  GET "SY:TRAN.GET"

LET REGISTER(A) = VALOF
$(1 LET R=H2%A
    LET O = PENDINGOP
    SPECIAL:=(O=S.MULT\/O=S.DIV\/O=S.REM\/O=S.RSHIFT)
    TEST H1%A=S.REGISTER & OKAY(R)
    THEN RESULTIS R
    OR $( R := FREEREG()
          MOVETOR(A,R)
          RESULTIS R $)
$)1


AND MOVETOR(A,R) BE $(1

        UNLESS H1%A=S.REGISTER  LOGAND  H2%A=R DO $(

        COMPD(MOV,S.STACK,A,S.REGISTER,R)

        IF H1%A=S.REGISTER REG%(H2%A) := FREE
        H1%A := S.REGISTER
        H2%A := R
        REG%R := NOT FREE
$)1


AND MOVEFROMR(A) BE $(1

        COMPDX2(MOV,S.REGISTER,H2%A,(H3%A)*2,PREG)

        REG%(H2%A) := FREE
        H1%A := S.LOCAL
        H2%A := H3%A


$)1



AND LOADT(A, B) BE
    $(  UNLESS PENDINGOP=S.NONE DO SIMPLIFY()
        ARG2 := ARG1
        ARG1 := ARG1 + TEMPSIZE
        H1%ARG1,H2%ARG1,H3%ARG1 := A,B,SSP
        IF A=S.REGISTER REG%B := NOT FREE
        SSP := SSP + 1   $)


AND LOSE1(R) BE
    $(  IF H1%ARG1 = S.REGISTER DO   REG%(H2%ARG1) := FREE
        SSP := SSP - 1
        PENDINGOP := S.NONE
        TEST ARG2=TEMPV
             THEN H1%ARG2,H2%ARG2,H3%ARG2 := S.LOCAL,SSP-2,SSP-2
               OR $( ARG1 := ARG2; ARG2 := ARG2 - TEMPSIZE $)
        H1%ARG1, H2%ARG1, H3%ARG1 := S.REGISTER, R, SSP-1
        REG%R := NOT FREE
$)



AND FREEREG() = VALOF
$(  FOR I = 0 TO 3 IF REG%I=FREE & OKAY(I) RESULTIS I
    $(  LET A = TEMPV
    $(  LET R = H2%A
        IF H1%A=S.REGISTER & OKAY(R) $( VACATE(R); RESULTIS R $)
        A := A+TEMPSIZE  $) REPEAT $) $)

AND OKAY(R) = VALOF
$(  UNLESS SPECIAL RESULTIS TRUE
    RESULTIS R REM 2 = 1 $)

AND VACATE(R) BE
$(  LET A=TEMPV
    IF REG%R=FREE RETURN
    UNTIL H1%A=S.REGISTER & H2%A=R DO A:=A+TEMPSIZE
    MOVEFROMR(A)  $)



AND REDUCE() BE $(

        SSP := SSP-1
        IF H1%ARG1=S.REGISTER DO REG%(H2%ARG1) := FREE
        ARG1 := ARG2
        ARG2 := ARG2-TEMPSIZE

$)



AND NUMBERIS(N,A) = H1%A=S.NUMBER  LOGAND  H2%A=N -> TRUE,FALSE

.




  GET "SY:TRAN.GET"

LET STOREIN(S,N) BE $(1

    IF SAME(S,N) RETURN

    SIMPLIFY()

    LOADT(S,N)
    COMPD(MOV,S.STACK,ARG2,S.STACK,ARG1)

    REDUCE()
    REDUCE()
$)1


AND STOREI() BE $(1

        SIMPLIFY()
        $( LET R = REGISTER(ARG1)

        COMPS(ASL,S.REGISTER,R)
        COMPD(MOV,S.STACK,ARG2,S.REGDEF,R)

        REDUCE()
        REDUCE()
$)1


AND SAME(S,N) = VALOF $(1

    LET A,B = FALSE, VALOF $( TEST H1%ARG1=S  LOGAND  H2%ARG1=N
                              THEN RESULTIS 1
                                OR TEST H1%ARG2=S  LOGAND  H2%ARG2=N
                                   THEN RESULTIS 2
                                     OR RESULTIS 0  $)

    SWITCHON PENDINGOP INTO $(

       DEFAULT:  RESULTIS FALSE

       CASE S.PLUS:  A := TRUE
       CASE S.MINUS: TEST (B=1 & OP=S.PLUS) LOGOR B=2
                     THEN $( PLUSCASE(A,B); RESULTIS TRUE $)
                       OR RESULTIS FALSE
       CASE S.NEG: A:=TRUE
       CASE S.NOT: TEST B=1
                   THEN $( COMPS(A -> NEG,COM,S.STACK,ARG1)
                           REDUCE()
                           PENDINGOP := S.NONE
                           RESULTIS TRUE  $)
                     OR RESULTIS FALSE

$)1


AND PLUSCASE(A,B) BE $(1

    LET SOURCE,DEST = B=1 -> ARG2,ARG1, B=1 -> ARG1,ARG2

    TEST NUMBERIS(1,SOURCE)
    THEN COMPS(A -> INC,DEC,S.STACK,DEST)
      OR TEST NUMBERIS(-1,SOURCE)
         THEN COMPS(A -> DEC,INC,S.STACK,DEST)
           OR COMPD(A -> ADD,SUB,S.STACK,SOURCE,S.STACK,DEST)

    REDUCE()
    REDUCE()
    PENDINGOP := S.NONE

$)1

AND LOADLVP(N) BE $(

        LET R = FREEREG()

        COMPD(MOV,S.REGISTER,PREG,S.REGISTER,R)
        COMPS(ASR,S.REGISTER,R)
        COMPD(ADD,S.NUMBER,N,S.REGISTER,R)

        REG%R := NOT FREE
        LOADT(S.REGISTER,R)
$)
 .








  GET "SY:TRAN.GET"

GLOBAL $( SWITCH:4 $)

LET CGCODE(N) BE
$(  SIMPLIFY()
    STORE(BASE, SSP-1)
    EMPTYLIST()
    FOR I=1 TO N WRCH(READN())
    NEWLINE() $)
 
AND CGENTRY(N,L) BE 
$(  LET S = NEXTPARAM()
    DU := DU+(N+3)/2
    CGPSECT("CONST")
    COMPL(S)
    COMPWN(N)
    WRITES("*T.ASCII*T^")
    FOR I=1 TO N WRCH(READN())
    WRITES("^*N")
    UNLESS (N&1)=0 WRITES("*T.EVEN*N")
    CGPSECT(BLOCKNAME)
    ALLOWJP()
    COMPL(L)
    COMPD(JSR,S.REGISTER,1,S.LIB,"ENTER")
    COMPWL(S) 
    SU := SU+1  $)

AND CGSAVE(N) BE $(1

        INITSTACK(3)
        FOR I = 3 TO N-1 DO $(
                ARG2 := ARG1
                ARG1 := ARG1+TEMPSIZE
                H1%ARG1,H2%ARG1,H3%ARG1 := S.LOCAL,I,I
        $)
        SSP := N
$)1



AND CGAPPLY(OP,N) BE $(1
        SIMPLIFY()
        STORE(BASE,SSP-2)
	WRITES("*TJSR*TR0,")
	COMP(S.STACKDEF,ARG1)
	NEWLINE()
	COMPWN(2*N+6)
	SU := SU+2
	FORCEJP()
        STACK(N)
        IF OP=S.FNAP LOADT(S.REGISTER,0)
$)1


AND CGRETURN(OP) BE $(1
    IF OP=S.FNRN MOVETOR(ARG1,0)
    COMPS(JMP,S.LIB,"EXIT")
    ALLOWJP()
$)1

AND CGSTRING(N) BE
$(  LET L = NEXTPARAM()
    LOADT(S.LVLABEL,L)
    DU := DU + (N+3)/2
    CGPSECT("CONST")
    COMPL(L)
    COMPWN(N)
    UNLESS N=0 WRITES("*T.ASCII*T")
    $( LET INSTRING = FALSE
       FOR I = 1 TO N DO
       $( LET CHAR = READN()
          TEST '*S'<=CHAR<='Z' \/ #141<=CHAR<=#172
          THEN $( UNLESS INSTRING WRCH('^')
                  WRCH(CHAR); INSTRING := TRUE $)
          OR   $( IF INSTRING WRCH('^')
                  WRITEF("<%O>",CHAR); INSTRING := FALSE $) $)
       IF INSTRING WRCH('^') $)
    NEWLINE()
    UNLESS (N&1)=0 WRITES("*T.EVEN*N")
    CGPSECT(BLOCKNAME)  $)

AND CGGLOBAL(N) BE
$(C LET LAST = -1
    EMPTYLIST()
    IF N=0 RETURN
    CGPSECT("GLOBAL")
    FOR I=1 TO N
    $(  LET N = READN()
        LET L = READL()
        UNLESS N = LAST+1 WRITEF("*T.=GV+%N.*N",2*N)
        COMPWL(L)
        IF N<60 $( WRITEF("*TG%N == L%N*N",N,L); GLIB%N := -1 $)
        LAST := N $)
    FOR I=1 TO 400 IF GLIB%I>0 LAST := I
    WRITEF("*T.=GV+%N.*N",2*LAST) $)C
.












  GET "SY:TRAN.GET"

MANIFEST $(
HEAD = 0; NEXT = 0
TAIL = 1; LAST = 1
REALL = 2
FAKEL = 3
VALUE = 4 
ATOMSIZE = 5 $)
 
STATIC $(
FREELIST=0
FIRSTL=0
LASTL=0 $)

LET BRANCH(B, L) BE
$(1 LET F = 0
    IF NUMBERIS(0,ARG2) SWITCHON PENDINGOP INTO $(
 
    CASE S.LS: PENDINGOP := S.GR; ENDCASE
    CASE S.LE: PENDINGOP := S.GE; ENDCASE
    CASE S.GR: PENDINGOP := S.LS; ENDCASE
    CASE S.GE: PENDINGOP := S.LE; ENDCASE $)
 
    SWITCHON PENDINGOP INTO $(

    DEFAULT:   SIMPLIFY()
               STORE(BASE,SSP-2)
               COMPS(TST,S.STACK,ARG1)
               CGBRANCH(B -> BNE, BEQ, L)
               REDUCE()
               RETURN

    CASE S.EQ: B := NOT B
    CASE S.NE: F := B -> BNE, BEQ; ENDCASE
    CASE S.LS: B := NOT B
    CASE S.GE: F := B -> BGE, BLT; ENDCASE
    CASE S.LE: B := NOT B
    CASE S.GR: F := B -> BGT, BLE  $)

    STORE(BASE,SSP-3)
    TEST NUMBERIS(0,ARG1)
    THEN COMPS(TST,S.STACK,ARG2)
    OR TEST NUMBERIS(0,ARG2)
    THEN COMPS(TST,S.STACK,ARG1)
    OR COMPD(CMP,S.STACK,ARG2,S.STACK,ARG1)
    CGBRANCH(F,L)
    PENDINGOP := S.NONE
    REDUCE()
    REDUCE()  $)1

AND CGBRANCH(F,L) BE
$(  LET M = L
    UNLESS LOOKUP(L) DO
    $(  LET REF = SEARCHLIST(L)
        TEST REF = 0
        THEN $( M := NEXTPARAM(); FORWARDREF(M,L)  $)
        OR   M := FAKEL%REF  $)
    COMPS(F,S.LABEL,M) 
    SU := SU-1
    IF F=BR ALLOWJP()  $)

AND CGLABEL(L) BE
$(  LET REF = SEARCHLIST(L)
    UNLESS REF = 0
    $(  TAKEOFFLIST(REF)
        COMPL(FAKEL%REF)
        NEWLINE() $)
    COMPL(L)
    ENTER(L)  $)

AND ALLOWJP() BE
$(  LET REF = TAIL%LIST
    IF  REF = LIST RETURN
    IF  SU-VALUE%REF < 110 RETURN
    CGJP(REF)  $) REPEAT

AND FORCEJP() BE
$(  LET REF = TAIL%LIST
    IF  REF = LIST RETURN
    IF SU - VALUE%REF < 120 RETURN
    $(  LET L = NEXTPARAM()
        WRITEF("*TBR*TL%N*N",L)
        SU := SU+1
        ALLOWJP()
        COMPL(L)  $)  $)

AND CGJP(REF) BE
$(  LET L = REALL%REF
    COMPL(FAKEL%REF)
    WRITEF("*TJMP*TL%N*N",L)
    SU := SU+2
    TAKEOFFLIST(REF)  $)

AND FORWARDREF(M,L) BE
$(  LET REF = HEAPATOM()
    REALL%REF := L
    FAKEL%REF := M
    VALUE%REF := SU
    ADDTOLIST(REF)  $)

AND SEARCHLIST(L) = VALOF
$(  LET ATOM = HEAD%LIST
    UNTIL ATOM = LIST DO
    $(  IF REALL%ATOM = L RESULTIS ATOM
        ATOM := NEXT%ATOM  $)
    RESULTIS 0  $)

AND EMPTYLIST() BE
$(  SU := SU+200
    FORCEJP()
    SU := SU-200  $)

AND ADDTOLIST(ATOM) BE
$(  LET NEXTATOM = HEAD%LIST
    HEAD%LIST := ATOM
    LAST%NEXTATOM := ATOM
    NEXT%ATOM := NEXTATOM
    LAST%ATOM := LIST  $)

AND TAKEOFFLIST(ATOM) BE
$(  LET LASTATOM = LAST%ATOM
    AND NEXTATOM = NEXT%ATOM
    NEXT%LASTATOM := NEXTATOM
    LAST%NEXTATOM := LASTATOM
    UNHEAP(ATOM)  $)

AND ENTER(LABEL) BE
$(  LABL%LASTL := LABEL
    LABV%LASTL := SU
    LASTL := (LASTL+1) REM 64  $)

AND LOOKUP(LABEL) = VALOF
$(1 CLEARLABELS()
$(  LET I = FIRSTL
    UNTIL I = LASTL DO
    $(  IF LABL%I = LABEL RESULTIS TRUE
        I := (I+1) REM 64  $)
    RESULTIS FALSE  $)1

AND CLEARLABELS() BE
$(  LET RANGE = SU-128
    UNTIL FIRSTL = LASTL DO
    $(  IF LABV%FIRSTL > RANGE RETURN
        FIRSTL := (FIRSTL+1) REM 64  $)  $)

AND HEAPATOM() = VALOF
$(  LET ATOM = FREELIST
    FREELIST := NEXT%ATOM
    RESULTIS ATOM  $)

AND UNHEAP(ATOM) BE
$(  NEXT%ATOM := FREELIST
    FREELIST := ATOM  $)

AND INITLABS() BE
$(  HEAD%LIST := LIST
    TAIL%LIST := LIST
    FREELIST  := LIST+2
    FOR I = 0 TO 500 BY ATOMSIZE
        FREELIST%I := FREELIST+I+ATOMSIZE
   FIRSTL, LASTL := 0, 0  $)

 .









  GET "SY:TRAN.GET"



MANIFEST  $( CASEMAX = 200 $)
STATIC    $( CASELAB = 0; CASEVAL = 0 $)

LET CGSWITCH() BE
$(1 LET A = VEC CASEMAX
    LET B = VEC CASEMAX
    CASEVAL, CASELAB := A, B
$(  LET NOCASES = READN()
    AND DEFLAB = READL()
    FOR I = 1 TO NOCASES DO
    $(  LET VALUE = READN()
        AND LABEL = READL()
        AND J = I
        WHILE J > 1 DO
        $(  IF VALUE > CASEVAL%(J-1) BREAK
            CASEVAL%J := CASEVAL%(J-1)
            CASELAB%J := CASELAB%(J-1)
            J := J-1  $)
        CASEVAL%J, CASELAB%J := VALUE, LABEL  $)
    SIMPLIFY()
    STORE(BASE, SSP-2)
    COMPD(MOV,S.STACK,ARG1,S.REGISTER,WREG)
    REDUCE()
    TEST 3*NOCASES > 16+CASEVAL%NOCASES-CASEVAL%1
    THEN LSWITCH(NOCASES,DEFLAB)
    OR   BSWITCH(1,NOCASES,DEFLAB)  $)1

AND BSWITCH(LO,HI,DEFLAB) BE
TEST HI-LO >= 6
THEN $( LET L = NEXTPARAM()
        AND MIDDLE = (HI+LO)/2
        COMPD(CMP,S.REGISTER,WREG,S.NUMBER,MIDDLE%CASEVAL)
        COMPS(BGE,S.LABEL,L)
        BSWITCH(LO,MIDDLE-1,DEFLAB)
        COMPL(L)
        CGBRANCH(BEQ,MIDDLE%CASELAB)
        BSWITCH(MIDDLE+1,HI,DEFLAB)  $)
OR   $( FOR I = LO TO HI DO
        $(  COMPD(CMP,S.REGISTER,WREG,S.NUMBER,CASEVAL%I)
            CGBRANCH(BEQ,CASELAB%I)  $)
        CGBRANCH(BR,DEFLAB)  $)

AND LSWITCH(NOCASES,DEFLAB) BE
$(1 LET L = NEXTPARAM()
    AND LOCASE, HICASE = CASEVAL%1, CASEVAL%NOCASES
    COMPD(SUB,S.NUMBER,LOCASE,S.REGISTER,WREG)
    CGBRANCH(BLT,DEFLAB)
    COMPD(CMP,S.REGISTER,WREG,S.NUMBER,HICASE-LOCASE)
    CGBRANCH(BGT,DEFLAB)
    COMPS(ASL,S.REGISTER,WREG)
    WRITEF("*TJMP*T@L%N(T)*N",L)
    SU := SU+3+HICASE-LOCASE
    ALLOWJP()
    COMPL(L)
$(  LET P = 1
    FOR I = LOCASE TO HICASE DO
    TEST CASEVAL%P=I
    THEN $( COMPWL(CASELAB%P); P := P+1 $)
    OR   COMPWL(DEFLAB)  $)1
 .








  GET "SY:TRAN.GET"

LET COMP(MODE,ARG,AR1) BE $(1

        SWITCHON MODE INTO $(

        DEFAULT: REPORT("UNKNOWN ADDRESS MODE: %N",MODE); RETURN

        CASE S.REGISTER: COMPREG(ARG); RETURN
        CASE S.AUTODEC:  WRCH('-')
        CASE S.REGDEF:   COMPRDEF(ARG); RETURN
        CASE S.AUTOINC:  COMPRDEF(ARG); WRCH('+'); RETURN
        CASE S.INDEX:    WROCT(ARG); COMPRDEF(AR1); SU := SU+1; RETURN
        CASE S.STACKDEF: WRCH('@')
        CASE S.STACK:    TEST H1%ARG=S.LOCAL
                         THEN COMP(S.INDEX,2*(H2%ARG),PREG)
                         OR TEST H1%ARG=S.GLOBAL
                         THEN COMP(S.GLOBAL,(H2%ARG)*2)
                         OR COMP(H1%ARG,H2%ARG)
                         RETURN
        CASE S.LABEL:    WRITEF("L%N",ARG); SU := SU+1; RETURN
        CASE S.LVLABEL:  WRITEF("#L%N/2",ARG); SU := SU+1; RETURN
        CASE S.OCTAL:
        CASE S.NUMBER:   WRITEF("#%O", ARG); SU :=SU+1; RETURN
        CASE S.IMDL:     WRITEF("#L%N",ARG); SU := SU+1;RETURN
        CASE S.GLOBAL:   WRITEF("GV+%N.",ARG); SU := SU+1
	                 ARG := ARG/2; IF GLIB%ARG=0 GLIB%ARG := 1; RETURN
        CASE S.LVGLOBAL: WRITEF("#GV/2+%N.",ARG); SU := SU+1;RETURN
        CASE S.LIB:      WRITES(ARG); SU := SU+1; RETURN
$)1


AND COMPF(F) BE $(1

        LET S = 0

        SWITCHON F INTO $(

        CASE MOV: S := "MOV"; ENDCASE
        CASE CMP: S := "CMP"; ENDCASE
        CASE BIT: S := "BIT"; ENDCASE
        CASE BIC: S := "BIC"; ENDCASE
        CASE BIS: S := "BIS"; ENDCASE
        CASE ADD: S := "ADD"; ENDCASE
        CASE SUB: S := "SUB"; ENDCASE
        CASE MUL: S := "MUL"; ENDCASE
        CASE DIV: S := "DIV"; ENDCASE
        CASE ASHC:S :="ASHC"; ENDCASE
        CASE XOR: S := "XOR"; ENDCASE

        CASE BR:  S := "BR"; ENDCASE
        CASE BNE: S := "BNE"; ENDCASE
        CASE BEQ: S := "BEQ"; ENDCASE
        CASE BGE: S := "BGE"; ENDCASE
        CASE BLT: S := "BLT"; ENDCASE
        CASE BGT: S := "BGT"; ENDCASE
        CASE BLE: S := "BLE"; ENDCASE

        CASE JSR: S := "JSR"; ENDCASE
        CASE JMP: S := "JMP"; ENDCASE

        CASE COM: S := "COM"; ENDCASE
        CASE CLR: S := "CLR"; ENDCASE
        CASE TST: S := "TST"; ENDCASE
        CASE INC: S := "INC"; ENDCASE
        CASE DEC: S := "DEC"; ENDCASE
        CASE NEG: S := "NEG"; ENDCASE
        CASE SXT: S := "SXT"; ENDCASE

        CASE ROR: S := "ROR"; ENDCASE
        CASE ASH: S := "ASH"; ENDCASE
        CASE ASR: S := "ASR"; ENDCASE
        CASE ASL: S := "ASL"; ENDCASE

        CASE CLC: S := "CLC"; ENDCASE

$)

        WRITEF("*T%S*T",S)

$)1

AND COMPREG(R) BE
        SWITCHON R INTO
$(      CASE 0:
        CASE 1:
        CASE 2:
        CASE 3: WRCH('R'); WROCT(R); RETURN
        CASE 4: WRCH('T'); RETURN
        CASE 5: WRCH('P');RETURN
        CASE 6: WRITES("SP"); RETURN
        CASE 7: WRITES("PC"); RETURN  $)

AND COMPRDEF(R) BE
$(  WRCH('(')
    COMPREG(R)
    WRCH(')')  $)

AND COMPS(F,M,A) BE $(

        COMPF(F)
        COMP(M,A)
        NEWL()
$)

AND COMPD(F,M1,A1,M2,A2) BE $(1

        TEST F=MOV & ((M1=S.NUMBER & A1=0) \/ (M1=S.STACK & NUMBERIS(0,A1)))
        THEN COMPS(CLR,M2,A2)
        OR $(
        COMPF(F)
        COMP(M1,A1)
        WRITES(", ")
        COMP(M2,A2)
        NEWL()

$)1


AND COMPL(L) BE WRITEF("L%N:",L)


AND COMPSX(F,N,R) BE $(
        COMPF(F)
        COMP(S.INDEX,N,R)
        NEWL()
$)

AND COMPDX(F,N1,R1,N2,R2) BE $(
        COMPF(F)
        COMP(S.INDEX,N1,R1)
        WRITES(", ")
        COMP(S.INDEX,N2,R2)
        NEWL()
$)

AND COMPDX1(F,N,R,M,A) BE $(
        COMPF(F)
        COMP(S.INDEX,N,R)
        WRITES(", ")
        COMP(M,A)
        NEWL()
$)


AND COMPDX2(F,M,A,N,R) BE $(1
TEST F=MOV & ((M=S.NUMBER & A=0) \/ (M=S.STACK & NUMBERIS(0,A)))
THEN COMPSX(CLR,N,R)
OR $(
        COMPF(F)
        COMP(M,A)
        WRITES(", ")
        COMP(S.INDEX,N,R)
        NEWL()
$)1

AND COMPN(F) BE $( COMPF(F); NEWL() $)


AND NEWL() BE $( SU := SU+1; NEWLINE(); FORCEJP() $)




AND COMPWL(L) BE
    WRITEF("*T.WORD*TL%N*N",L)


AND COMPWN(N) BE
    WRITEF("*T.WORD*T%O*N",N)

.