%EXTERNALROUTINE SPL
%ROUTINESPEC READ LINE
%INTEGERFNSPEC COMPARE(%INTEGER PSP)
%ROUTINESPEC SS
%ROUTINESPEC OUT(%INTEGER N)
%CONSTINTEGERARRAY PS(-1000:-906)= %C
  M'SS',-993,'X',-977,'=',-969,10,-987,'-','>',-957,-930,10,
  -983,-957,':',-1000,-981,'!',-978,'E',10,0,M'INDX',-972,'(',
  -969,')',-970,-957,0,M'EXPR',-965,-964,-946,0,M'OPD',-960,'X',
  -977,-958,-957,0,'N',-953,M'DIG',-952,0,M'RDIG',-948,M'DIG',
  -952,-947,0,M'REXP',-942,-940,-964,-941,0,M'OP',-937,'+',-935,
  '-',-933,'*',-931,'/',0,M'IF',-923,'I','F',-964,-921,-964,
  -922,0,M'COMP',-918,'=',-916,'#',-913,'>','=',-911,'>',-908,
  '<','=',-906,'<',0
%INTEGERARRAY A,PN,T(1:100)
%INTEGERARRAY CT,BTLAB,BTAD(0:100)       ;! CONSTANT & BRANCH  TABLES
%INTEGER I,J,TP,AP,CA,CTP,BTP
CA=0
CT(0)=0        ;! HOLE FOR 'X' BASE
CTP=1
BTP=0
%CYCLE
 READ LINE
 TP=1                                      ;! TEXT POINTER
 AP=1                                      ;! ANALYSIS REC POINTER
 %IF COMPARE(-1000)=1 %THEN %START          ;! SUCCESSFUL ANALYSIS
!  I=1                                    ;! PRINT OUT ANALYSIS REC
!  %UNTIL J>AP %CYCLE
!   J=I
!   %WHILE J<I+12 %AND J<=AP %THEN WRITE(J,5) %AND J=J+1
!   NEWLINE
!   J=I
!   %WHILE J<I+12%AND J<=AP %THEN SPACES(2)%AND OUT(PN(J))%AND J=J+1
!   NEWLINE
!   J=I
!   %WHILE J<I+12 %AND J<=AP %THEN WRITE(A(J),5) %AND J=J+1
!   NEWLINES(2)
!   I=I+12
!  %REPEAT
  AP=1
  SS
 %FINISH %ELSE PRINT STRING('SYNTAX ?
')
     %REPEAT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE READ LINE
! LEXICAL PHASE - READ & CLEAN UP NEXT LINE OF TEXT
%INTEGER I,TP
TP=1                                ;! POINTER TO TEXT ARRAY T
%CYCLE
READ SYMBOL(I) %UNTIL I#' '
%IF TP>100 %THEN PRINT STRING('
LINE TOO LONG') %AND %STOP
T(TP)=I
TP=TP+1
%IF I=NL %THEN %START
 %IF TP>2 %THEN %RETURN %ELSE TP=1       ;! IGNORE BLANK LINES
%FINISH
%REPEAT
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN COMPARE(%INTEGER PSP)
! SYNTAX ANALYSIS PHASE - ANALYSE PHRASE
%INTEGER APP,TPP,AE,P
TPP=TP                           ;! PRESERVE INITIAL TEXT POINTER
APP=AP                           ;! PRESERVE INITIAL ANAL REC PTR
A(AP)=1
PN(AP)=PS(PSP)
PSP=PSP+1
%CYCLE                           ;! FOR EACH ALTERNATIVE
 AE=PS(PSP)                      ;! POINTER TO END OF ALTERNATIVE
 PSP=PSP+1
 %CYCLE                           ;! FOR EACH ITEM
  %IF PSP=AE %THEN %RESULT=1     ;! SUCCESS
  P=PS(PSP)
  PSP=PSP+1
  AP=AP+1
  %IF AP>=100 %THEN PRINT STRING('
ANALYSIS RECORD FULL') %AND %STOP
  %IF P<0 %THEN %START           ;! SUB-PHRASE
   %IF COMPARE(P)=0 %THEN %EXIT
  %FINISH %ELSE %START
   %IF P=M'DIG' %THEN %START
    %UNLESS '0'<=T(TP)<='9' %THEN %EXIT
    PN(AP)=M'DIG'
    A(AP)=T(TP)-'0'+1
    AP=AP+1
   %FINISH %ELSE %START
    %IF P#T(TP) %THEN %EXIT
   %FINISH
   PN(AP)=T(TP)
   A(AP)=0
   TP=TP+1
  %FINISH
 %REPEAT
 %IF PS(AE)=0 %THEN %RESULT=0     ;! END OF PHRASE
 PSP=AE                           ;! START OF DEFN OF NEXT ALT
 TP=TPP                           ;! BACKTRACK SOURCE TEXT
 AP=APP                           ;!  AND ANALYSIS RECORD POINTER
 A(AP)=A(AP)+1                    ;! COUNT ALTERNATIVE NUMBER ON
%REPEAT
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE SS
%ROUTINESPEC EXPR(%INTEGER REG)
%ROUTINESPEC OPD(%INTEGER OPN,REG)
%ROUTINESPEC INDEX
%INTEGERFNSPEC EVALN
%INTEGERFNSPEC FIND LABEL(%INTEGER LAB)
%ROUTINESPEC BRANCH(%INTEGER BOPN,LAB)
%ROUTINESPEC DUMP(%INTEGER OPN,REG,BASE,DISP)
%SWITCH ALT(1:5)
%CONSTINTEGERARRAY BOPN(1:6)=M'BZ',M'BNZ',M'BNL',M'BG',M'BNG',M'BL'
%INTEGER APP,I,LAB
->ALT(A(AP))
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
ALT(1):! ASSIGNMENT STATEMENT
APP=AP            ;! SAVE <INDX> PNTR
AP=AP+1 %UNTIL PN(AP)='='
AP=AP+1
EXPR(M'ACC')        ;! COMPILE EXPRESSION ON RHS
AP=APP+3
%IF A(AP-1)=1 %THEN INDEX %AND DUMP(M'STR',M'ACC','I',0) %C
  %ELSE DUMP(M'STR',M'ACC','X',EVALN)
%RETURN
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
ALT(2):! JUMP STATEMENT
AP=AP+3
LAB=EVALN
%IF A(AP)=1 %THEN %START
 AP=AP+3        ;! ON LHS <OPD>       
 OPD(M'LOAD',M'ACC')
APP=AP
%IF A(APP)=3 %OR A(APP)=5 %THEN AP=AP+3 %ELSE AP=AP+2
 OPD(M'SUB',M'ACC') %UNLESS A(AP)=2 %AND A(AP+2)=1 %AND A(AP+4)=2
 BRANCH(BOPN(A(APP)),LAB)
%FINISH %ELSE BRANCH('B',LAB)
%RETURN
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
ALT(3):! LABEL
AP=AP+1
LAB=EVALN
AP=AP+1
I=FIND LABEL(LAB)
%IF BTAD(I)>=0 %THEN PRINT STRING('LABEL') %AND WRITE(LAB,1) %C
  %AND PRINT STRING(' SET TWICE
')
BTAD(I)=CA
SS
%RETURN
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
ALT(4):! COMMENT
%RETURN
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
ALT(5):! END OF PROGRAM
DUMP(M'STOP',0,0,0)
PRINT STRING('ENTER:
')
DUMP(M'LDA',M'BT',0,CA+5)
DUMP(M'LDA',M'CT',0,CA+4+BTP)
DUMP(M'LDA','X',0,CA+3+BTP+CTP)
DUMP(M'STR','X',M'CT',0)
DUMP('B',0,0,0)
PRINT STRING('BT:
')
I=0
%WHILE I<BTP %THEN %CYCLE
 %IF BTAD(I)<0 %THEN PRINT STRING('LABEL') %AND WRITE(BTLAB(I),1) %C
   %AND PRINT STRING(' NOT SET
')
 DUMP('B',0,0,BTAD(I))
 I=I+1
%REPEAT
PRINT STRING('CT:
')
I=0
%WHILE I<CTP %THEN DUMP(0,0,0,CT(I)) %AND I=I+1
PRINT STRING('X:
')
%STOP
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE EXPR(%INTEGER REG)
! COMPILE EXPRESSION - AP POINTS TO <OPD>
%CONSTINTEGERARRAY OPN(1:4)=M'ADD',M'SUB',M'MLT',M'DIV'
%INTEGER APP
AP=AP+1
OPD(M'LOAD',REG)        ;! LOAD FIRST OPERAND
%IF A(AP)=1 %THEN AP=AP+3 %AND OPD(OPN(A(AP-2)),REG) %ELSE AP=AP+1
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE OPD(%INTEGER OPN,REG)
! COMPILE OPERAND
%INTEGER N
%IF A(AP)=1 %THEN %START    ;! X<INDX>
 AP=AP+3
 %IF A(AP-1)=1 %THEN %START    ;! SUBSCRIPT INDEX
  %IF REG='I' %THEN PRINT STRING('INDEXING TOO DEEP
')
  INDEX
  DUMP(OPN,REG,'I',0)
 %FINISH %ELSE DUMP(OPN,REG,'X',EVALN)
%FINISH %ELSE %START
 AP=AP+1
 N=EVALN
 %IF OPN=M'LOAD' %THEN DUMP(M'LDA',REG,0,N) %ELSE %START
  %IF CTP>100 %THEN PRINT STRING('
CONSTANT TABLE FULL') %AND %STOP
  CT(CTP)=N
  DUMP(OPN,REG,M'CT',CTP)
  CTP=CTP+1
 %FINISH
%FINISH
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE INDEX
! EVALUATE  ADDRESS OF 'X' VARIABLE
AP=AP+1
EXPR('I')
AP=AP+1
DUMP(M'ADD','I',M'CT',0)
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN EVALN
%INTEGER N
%UNLESS PN(AP)='N' %THEN PRINT STRING('
EVALN NOT ON <N>') %AND %STOP
N=A(AP+1)-1
AP=AP+4
%WHILE A(AP-1)=1 %THEN N=10*N+A(AP)-1 %AND AP=AP+3
%RESULT=N
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN FIND LABEL(%INTEGER LAB)
! FIND OR INSERT  LABEL INTO BRANCH TABLE
%INTEGER I
I=0
%WHILE I<BTP %CYCLE
 %IF LAB=BTLAB(I) %THEN %RESULT=I
 I=I+1
%REPEAT
%IF BTP>100 %THEN PRINT STRING('
BRANCH TABLE FULL') %AND %STOP
BTLAB(BTP)=LAB
BTAD(BTP)=-1
BTP=BTP+1
%RESULT=BTP-1
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE BRANCH(%INTEGER BOPN,LAB)
%INTEGER I,REG
%IF BOPN='B' %THEN REG=0 %ELSE REG=M'ACC'
I=FIND LABEL(LAB)
%IF BTAD(I)>=0 %THEN DUMP(BOPN,REG,0,BTAD(I)) %ELSE %C
  DUMP(BOPN,REG,M'BT',I)
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE DUMP(%INTEGER OPN,REG,BASE,DISP)
! OUTPUT MACHINE INSTRUCTION
WRITE(CA,4)        ;! CURRENT ADDRESS
SPACES(6)
OUT(OPN)
PRINT SYMBOL(',')
OUT(REG)
PRINT SYMBOL(',')
OUT(BASE)
PRINT SYMBOL(',')
WRITE(DISP,1)
CA=CA+1
NEWLINE
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE OUT(%INTEGER N)
! PRINT OUT PACKED CHARS
%INTEGER I,J
%IF N=NL %THEN PRINT STRING('  NL') %AND %RETURN
%CYCLE I=24,-8,0
 J=N>>I&X'FF'
 %IF J=0 %THEN SPACE %ELSE  PRINT SYMBOL(J)
%REPEAT
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%END
%ENDOFFILE