SECTION"LEM"
GET "AHDR"
 LET OPCODE(T) BE $(
   SETLABEL(LAB)
   $(
      LET P1=VEC 15
      AND ADS,L=0,0
      AND P2=VEC 15
      AND F=TRUE
      AND OPCODETYPE=(!(NAMEP!T))&#XFF
       !P.CODEV:=FALSE
      EXPR.VALUE,EXPR.TYPE,ITEMSET:=FALSE,FALSE,FALSE
      ADTYPE1,ADR1,RB1,RI1,ADSIZE1:=0,0,0,0,0
      ADTYPE2,ADR2,RB2,RI2,ADSIZE2:=0,0,0,0,0
      TODIR:=1
      NT:=NAMEP!T
      SEGOVR:=0
      LOCK:=FALSE
      RSIZE:=1
      IMTRUE:=FALSE
      !P.CODET:=T.ABS
       P.CODEN:=0   // JUST TO MAKE SURE
      1!P.CODEV:=0
      2!P.CODEV:=0
      1!P.CODET:=T.ABS
      2!P.CODET:=T.ABS
      IF !ARG='&' THEN $( RSIZE:=0; ARG:=ARG+1 $)
//**      $( LET A=OUTPUT()
//**         SELECTOUTPUT(ERRSTR)
//**         FOR I=0 TO 39 DO WRCH(I!LINE)
//**         WRITES("          ***************N*N")
//**         NEWLINE()
//**         SELECTOUTPUT(A)
//**      $)
      TEST R.ADR(@ADTYPE1,@ADR1,@RB1,@RI1,@ADSIZE1)
         THEN TEST R.END(!ARG)
            THEN TODIR:=1
            ELSE TEST !ARG=','
               THEN $(
                  ARG:=ARG+1
                  UNLESS R.ADR(@ADTYPE2,@ADR2,@RB2,@RI2,@ADSIZE2) DO FAULT('S')
                  UNLESS R.END(!ARG) DO FAULT('S')
               $)
               ELSE FAULT('S')
         ELSE UNLESS R.END(!ARG)|ARG=0 DO FAULT('S')
   IF (ADTYPE2~=0)&(ADTYPE1>T.RSEG)&(ADTYPE2<=T.RSEG)&
           ((ADTYPE2&#XFF)~=T.IM) &
    (OPCODETYPE~=7)  THEN  $( R.SWAP() ; TODIR:=0 $)
   IF LOCK THEN R.OUT1(#XF0)
   IF SEGOVR>0 THEN R.OUT1(#X26|((SEGOVR-1)<<3))
   REG1:=(ADTYPE1=T.R8)|(ADTYPE1=T.R16)
   REG2:=(ADTYPE2=T.R8)|(ADTYPE2=T.R16)
   REL1:=( (ADTYPE1&#XFC00)=T.REL ) | ( (ADTYPE1&#XFC00)=T.EXT )
   REL2:=( (ADTYPE2&#XFC00)=T.REL ) | ( (ADTYPE2&#XFC00)=T.EXT )
   IMTRUE:=(ADTYPE2&#XFF)=T.IM
    //** DEBUG(" CODE STATES ARE REG1= %N REG2= %N REL1 = %N REL2 = %N*N*
 //**    *IMTRUE=%N*N",REG1,REG2,REL1,REL2,IMTRUE)
    //** DEBUG(" !ARG 1!ARG = (%X2,%C) (%X2,%C)*N",!ARG,!ARG,1!ARG,1!ARG)
   IF (ADTYPE1&#XFF=T.IM)|(IMTRUE&(TODIR=0)) DO FAULT('S')
   IF ((ADTYPE1=T.RSEG)|(ADTYPE2=T.RSEG)) &
      ~((OPCODETYPE=4)|(OPCODETYPE=5)) DO FAULT('S')
//

  IF OPCODETYPE=#X11 DO TODIR := 0    // TEST INSTRUCTION IS SPECIAL!

   SWITCHON OPCODETYPE INTO $(A
//
CASE 1:
   UNLESS (ADTYPE1=0) & (ADTYPE2=0) DO FAULT('S')
   R.OUT1(1!(NAMEP!T))
   ENDCASE
CASE 2:
   UNLESS (ADTYPE1=0) & (ADTYPE2=0) DO FAULT('S')
   R.OUT1(1!(NAMEP!T)); R.OUT1(2!(NAMEP!T))
   ENDCASE
CASE 3:
   UNLESS ADTYPE2=0 DO FAULT('S')
   UNLESS((CNT=ABSC)&(ADTYPE1=T.ABS)|(CNT=RELC)&(ADTYPE1=T.REL)) THEN
      FAULT('S')
   ADS:=ADR1-!CNT-2
   IF (ADS<-128)|(ADS>127) DO FAULT('U')
   R.OUT1(1!(NAMEP!T)) ; R.OUT1(ADS)
   ENDCASE
CASE 4:
   IF ADTYPE1=T.RSEG | ADTYPE2=T.RSEG THEN $(
      IF IMTRUE THEN FAULT('S')
      TEST ADTYPE1=T.RSEG DO R.SWAP()
      OR TODIR := 0
      IF ADTYPE1=T.RSEG DO FAULT('S')
      RSIZE:=0
      R.OUTADX2((7!(NAMEP!T))|(TODIR<<1),ADR2<<3)
      ENDCASE
   $)
   IF REG1 & IMTRUE THEN $(
      LET W=(RSIZE=0)|(ADTYPE1=T.R8)->0,1
      R.OUT1((4!(NAMEP!T))|W<<3|ADR1)
      IF REL2 THEN $(
         R.OUT2R(ADR2,ADTYPE2&#XFC00)
         ENDCASE
      $)
      R.OUT1(ADR2)
      IF W=0 THEN ENDCASE
      R.OUT1(ADR2>>8)
      ENDCASE
   $)
   IF REG1 & (ADR1=0) & (ADTYPE2=T.ABS|ADTYPE2=T.REL) THEN $(
      LET W=(RSIZE=0)|(ADTYPE1=T.R8)->0,1
      R.OUT1(5!(NAMEP!T)|(TODIR=0->1,0)<<1|W)
      IF REL2 THEN $(
         R.OUT2R(ADR2,ADTYPE2&#XFC00)
         ENDCASE
      $)
      R.OUT1(ADR2)
      R.OUT1(ADR2>>8)
      ENDCASE
   $)
   IF IMTRUE THEN $(
      LET W=(RSIZE=0)|(ADTYPE1=T.R8)->0,1
      R.OUTIMX((2!(NAMEP!T))|W,(W=1))
      ENDCASE
   $)
   R.OUTADX(1!(NAMEP!T))
   ENDCASE
//
CASE #X11:
CASE 9:
CASE 8:
   IF IMTRUE & REG1 & (ADR1=0) THEN $(
      R.OUTIMA(4!(NAMEP!T))
      ENDCASE
   $)
   IF IMTRUE THEN $(
      LET W=(RSIZE=0)|(ADTYPE1=T.R8)->0,1
      AND S=REL2|(ADSIZE2=1)->0,1
   TEST OPCODETYPE=8 THEN
      R.OUTIMX((2!(NAMEP!T))|(S<<1)|W,(S=0)&(W=1))
   ELSE
      R.OUTIMX((2!(NAMEP!T))|W,(W=1))
      ENDCASE
   $)
   R.OUTADX(1!(NAMEP!T))
   ENDCASE
CASE 22:
   UNLESS ADTYPE2=0 DO FAULT('S')
   IF IMTRUE DO FAULT('S')
      IF REG1 & (ADTYPE1=T.R16) THEN $(  R.OUT1(3!(NAMEP!T)|ADR1)
                                         ENDCASE
                                     $)
CASE 6:
   UNLESS ADTYPE2=0 DO FAULT('S')
   IF IMTRUE DO FAULT('S')
   R.OUTADX2(1!(NAMEP!T),2!(NAMEP!T))
   ENDCASE
CASE 7:
   IF IMTRUE THEN FAULT('S')
   UNLESS (ADTYPE2=0)|((ADR2=1)&REG2) DO FAULT('S')
   $(
   LET V=(ADR2=1)&REG2 ->1,0
   R.OUTADX2(1!(NAMEP!T)|(V<<1),2!(NAMEP!T))
   ENDCASE
CASE 5:
   IF IMTRUE THEN FAULT('S')
   UNLESS ADTYPE2=0 DO FAULT('S')
    IF REG1 THEN $(
      R.OUT1(3!(NAMEP!T)|ADR1)
      ENDCASE
   $)
   IF ADTYPE1=T.RSEG THEN $(
      R.OUT1(4!(NAMEP!T)|(ADR1<<3))
      ENDCASE
   $)
   R.OUTADX2(1!(NAMEP!T),2!(NAMEP!T))
   ENDCASE
CASE 10:
   IF IMTRUE THEN FAULT('S')
   IF REG1 & REG2 & (ADR1=0|ADR2=0)  & (ADTYPE1=T.R16|ADTYPE2=T.R16)
       THEN $(
      R.OUT1(2!(NAMEP!T)|(ADR2=0->ADR1,ADR2))
      ENDCASE
   $)
   R.OUTADX(1!(NAMEP!T))
   ENDCASE
CASE 11:
   IF (ADTYPE1=T.ABS)&(ADR1<256) THEN $(
      R.OUT1(1!(NAMEP!T))
      R.OUT1(ADR1)
      ENDCASE
   $)
   UNLESS ADTYPE1=0 DO FAULT('S')
   R.OUT1(2!(NAMEP!T))
   ENDCASE
CASE 12:
   IF IMTRUE DO FAULT('S')
   UNLESS ADTYPE1=T.R16 DO FAULT('S')
   R.SWAP()
   R.OUT1(1!(NAMEP!T))
   R.OUTG(ADR2<<3)
   ENDCASE
CASE 13:
CASE 15:
   UNLESS (CNT=ABSC)&~REL1|(CNT=RELC)&REL1 DO FAULT('S')
   UNLESS ADTYPE2=0 DO FAULT('S')
   ADS:=ADR1-!CNT-2
   IF (ADS<-128)|(ADS>=0)|~ITEMSET|EXPR.TYPE~=T.REL| OPCODETYPE=15 DO $(
      ADS:=ADS-1
      R.OUT1(1!(NAMEP!T)) ; R.OUT1(ADS) ; R.OUT1(ADS>>8)
      ENDCASE
   $)
   R.OUT1(2!(NAMEP!T))
   R.OUT1(ADS)
   ENDCASE
CASE 14:
   IF ADTYPE1=0 THEN $(
      R.OUT1(1!(NAMEP!T))
      ENDCASE
   $)
   UNLESS ADTYPE1=T.ABS DO FAULT('S')
   R.OUT1(ADR1)
   R.OUT1(ADR1>>8)
   ENDCASE
CASE 16:
   UNLESS (ADTYPE1=T.ABS)&(ADTYPE2=T.ABS) DO FAULT('S')
   R.OUT1(1!(NAMEP!T))
   R.OUT1(ADR1);R.OUT1(ADR1>>8)
   R.OUT1(ADR2);R.OUT1(ADR2>>8)
   ENDCASE
DEFAULT:
   ENDCASE
   $)A
//
   P.CODEN:=P.CODEN - 1
      P.LOCF,P.LOC:=TRUE,!CNT
      !CNT:=!CNT+P.CODEN+1
       //** DEBUG("1ST SET OF ADDRESS VALUES %X4 %X4 %X4 %X4 %X4*N",
 //**             ADTYPE1,ADR1,RB1,RI1,ADSIZE1)
       //** DEBUG("2ND SET OF ADDRESS VALUES %X4 %X4 %X4 %X4 %X4*N",
 //**             ADTYPE2,ADR2,RB2,RI2,ADSIZE2)
       //** DEBUG("OTHERBITS ARE CNT %N AND TODIR %N*N",!CNT,TODIR)
       //** DEBUG("NOW WHAT WE HAVE FOUND IN NAMEP!T *N*
 //**          * %X4 %X4 %X4 %X4 %X4 %X4*N",
 //**      0!(NAMEP!T),1!(NAMEP!T),2!(NAMEP!T),3!(NAMEP!T),
 //**      4!(NAMEP!T),5!(NAMEP!T))
   $)
     IF PASS=2 THEN FOR I=0 TO P.CODEN DO DUMP(P.CODET!I,P.CODEV!I,P.LOC+I)
   !P.CODET:=' '
$)
 AND DFF(T) BE $(
   $(
      LET P1=VEC 15
      AND P2=VEC 15
      AND F=TRUE
       !P.CODEV:=0
       UNPACKBITS(1!(NAMEP!T),P1)
      UNPACKBITS(2!(NAMEP!T),P2)
       FOR I=15 TO 0 BY -1 DO $(
         TEST P1!I=0 THEN !P.CODEV:=!P.CODEV LOGOR (P2!I&(1<<I))
         ELSE $(
            LET J=I
            UNTIL (I!P2=1) LOGOR (I<0) THEN I:=I-1
            IF I<0 THEN BREAK
            TEST !ARG=',' THEN $(
               TEST F THEN $(
                  FAULT('S'); BREAK
               $) ELSE ARG:=ARG+1
            $) ELSE UNLESS F THEN $(
               FAULT('S'); BREAK
            $)
            F:=FALSE
            !P.CODEV:=!P.CODEV LOGOR (READFIELD(J-I+1,@ARG)<<I)
         $)
      $)
      UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN FAULT('F')
      P.CODEN:=0
      P.LOCF,P.LOC:=TRUE,!CNT
      !P.CODET:=T.ABS
      !CNT:=!CNT+1
      DUMP(!P.CODET,!P.CODEV,P.LOC)
   $)
$)
 AND INC() BE $(
   LET A,T=0,0
   IF SCW THEN FAULT('W')
   $(
      LET COMMT,COMMV,SAVECNT=0,0,0
      AND COMMC=0
      AND TP=0
      IF ARG=0 THEN $(
         FAULT('S'); RETURN
      $)
      READEXPR(@ARG)
      IF EXPR.TYPE=-1 THEN RETURN
      IF EXPR.TYPE=T.ABS THEN EXPR.TYPE:=T.COMMON
      UNLESS (EXPR.TYPE&#XFC00)=T.COMMON THEN $(
         FAULT('E'); RETURN
      $)
      COMMT,COMMV:=EXPR.TYPE,EXPR.VALUE
      IF !ARG=',' THEN $(
         // ARG 2 IS PRESENT
         ARG:=ARG+1
         READEXPR(@ARG)
         IF EXPR.TYPE=-1 RETURN
         UNLESS EXPR.TYPE=T.ABS THEN $(
            FAULT('A'); RETURN
         $)
         P.CODEN:=0; !P.CODEV:=COMMV
         IF !ARG=',' THEN $(
            // ARG 3 IS PRESENT
            LET VALUE=EXPR.VALUE
            ARG:=ARG+1
            READEXPR(@ARG)
            IF EXPR.TYPE=-1 RETURN
            UNLESS EXPR.TYPE=T.ABS THEN $(
               FAULT('A'); RETURN
            $)
            DUMP(T.DIR+D.INC,COMMT,COMMV,VALUE,EXPR.VALUE)
            RETURN
         $)
         UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN $(
            FAULT('S'); RETURN
         $)
         DUMP(T.DIR+D.INC,COMMT,COMMV,EXPR.VALUE,1)
         RETURN
      $)
      DUMP(T.DIR+D.ORG,COMMT,COMMV)
      // ONLY THE FIRST ARGUMENT APPEARED
      // SO INITIALISE THEN INDICATED COMMON
      // FROM THE FOLLOWING LINES UP TO
      // THE NEXT 'END','INC,' OR 'ORG'
      // DIRECTIVE.
      COMMC:=COMMV            // COMMON COUNTER
      SAVECNT:=CNT            // SAVE POINTER TO CURRENT P COUN
      CNT:=@COMMC             // REPLACE BY POINTER TO COMMON C
      PRINTLINE()
      $(
         UNTIL READLINE() THEN PRINTLINE()
         TP:=OP
         IF !LINE='**' THEN $(
            PRINTLINE(); LOOP
         $)
         UNLESS LAB=0 THEN $(
            FAULT('L'); PRINTLINE(); LOOP
         $)
         IF TP=0 THEN $(
            FAULT('S'); PRINTLINE(); LOOP
         $)
         T:=GETOPN(@TP)
         IF (T<0) LOGOR (NAMEP!T=0) THEN $(
            FAULT('O'); PRINTLINE(); LOOP
         $)
         A:=!(NAMEP!T)&#X3FF
         IF A=D.END THEN $(
            PENDINGLINE:=TRUE
            CNT:=SAVECNT
            LONGJUMP(REC.P,REC.L)
         $)
         IF A=D.ORG THEN $(
            PENDINGLINE:=TRUE; RETURN
         $)
         UNLESS A=D.DFC THEN $(
            FAULT('O'); PRINTLINE(); LOOP
         $)
         DFC()
         FOR N=1 TO P.CODEN THEN
            UNLESS !P.CODET=T.ABS THEN FAULT('E')
         PRINTLINE()
      $) REPEAT
   $)
$)
 AND EVALCOND() = VALOF $(
         LET LHSV=0
         AND LHST=0
         AND RELOP=0
         READEXPR(@ARG)
         IF EXPR.TYPE=-1 THEN  $(
            FAULT('E'); RESULTIS 0
         $)
         LHSV:=EXPR.VALUE
         LHST:=EXPR.TYPE
         UNLESS COMP(!ARG) THEN $(
            FAULT('S')
            RESULTIS 0
         $)
         RELOP:=!ARG; ARG:=ARG+1
         READEXPR(@ARG)
         IF EXPR.TYPE=-1 THEN $(
            FAULT('E'); RESULTIS 0
         $)
         UNLESS !ARG=',' THEN $(
            FAULT('S')
            RESULTIS 0
         $)
         ARG:=ARG+1
         UNLESS LETTER(!ARG) THEN $(
            FAULT('S'); RESULTIS 0
         $)
         UNLESS LHST=EXPR.TYPE THEN $(
            IF RELOP='=' THEN RESULTIS -1
            FAULT('E')
            RESULTIS 0
         $)
         SWITCHON RELOP INTO $(
CASE '<':   IF LHSV<EXPR.VALUE THEN RESULTIS 1
            RESULTIS -1
CASE '=':   IF LHSV=EXPR.VALUE THEN RESULTIS 1
            RESULTIS -1
CASE '>':   IF LHSV>EXPR.VALUE THEN RESULTIS 1
            RESULTIS -1
         $)
$)
   //<3032
 AND EVALEXIST() = VALOF $(
         // 0 = SYNTAX; 1 = TRUE; -1 = FALSE
         UNLESS MACEXP THEN $(
            FAULT('S'); RESULTIS 0
         $)
         READEXPR(@ARG)
         UNLESS (EXPR.TYPE=T.ABS)&(1<=EXPR.VALUE<=16) THEN $(
            FAULT('E'); RESULTIS 0
         $)
         UNLESS !ARG=',' THEN $(
            FAULT('S'); RESULTIS 0
         $)
         ARG:=ARG+1
         UNLESS  LETTER(!ARG) THEN $(
            FAULT('S') ; RESULTIS 0
         $)
         IF MACARG!EXPR.VALUE=0 THEN RESULTIS -1
         RESULTIS 1
$)
   /*3032>*/
  AND CONDASS(DIR) BE $(
         LET J=0
         SWITCHON DIR INTO $(
CASE D.IF:
CASE D.IFN: J:=EVALCOND(); IF DIR=D.IFN THEN J:=-J
            IF (J=0)&(PASS=2) THEN PRINTLINE()
            IF J=1 THEN SEARCH()
            ENDCASE
CASE D.IFA: READEXPR(@ARG)
            UNLESS !ARG=',' THEN $(
               FAULT('S'); IF PASS=2 THEN PRINTLINE(); RETURN
            $)
            ARG:=ARG+1
            IF (EXPR.TYPE=-1)&(PASS=2) THEN PRINTLINE()
            IF EXPR.TYPE=T.ABS THEN SEARCH()
            ENDCASE
CASE D.IFR: READEXPR(@ARG)
            UNLESS !ARG=',' THEN $(
               FAULT('S'); IF PASS=2 THEN PRINTLINE(); RETURN
            $)
            ARG:=ARG+1
            IF (EXPR.TYPE=-1)&(PASS=2) THEN PRINTLINE()
            IF EXPR.TYPE=T.REL THEN SEARCH()
            ENDCASE
   //<3032
CASE D.IFP:
CASE D.IFM: J:=EVALEXIST(); IF DIR=D.IFM THEN J:=-J
            IF (J=0)&(PASS=2) THEN PRINTLINE()
            IF J=1 THEN SEARCH()
            ENDCASE
   /*3032>*/
CASE D.GTO: IF ARG=0 THEN $(
               FAULT('S'); IF PASS=2 THEN PRINTLINE(); ENDCASE
            $)
            SEARCH()
            ENDCASE
CASE D.GTC: READEXPR(@ARG)
            UNLESS (EXPR.TYPE=T.ABS)&(EXPR.VALUE>0) THEN ENDCASE
            $(
               LET C=0
               WHILE !ARG=',' DO $(
                  ARG:=ARG+1; C:=C+1
                  IF C=EXPR.VALUE THEN $(
                     SEARCH(); ENDCASE
                  $)
                  WHILE CAN(!ARG) DO ARG:=ARG+1
               $)
            $)
            ENDCASE
   //<3032
CASE D.EXM: UNLESS MACEXP THEN $(
               FAULT('S'); ENDCASE
            $)
            LONGJUMP(MACREC.P,MACREC.L)
   /*3032>*/
CASE D.AOP: ENDCASE
         $)
$)
.