%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          ;! LITERAL
    %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
%ROUTINESPEC OPD
%INTEGERFNSPEC EVALN
%ROUTINESPEC DUMP(%INTEGER OPN,REG,BASE,DISP)
%SWITCH ALT(1:5)
->ALT(A(AP))
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
ALT(1):! ASSIGNMENT STATEMENT
!
! TO BE FILLED IN
!
%RETURN
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
ALT(2):! JUMP STATEMENT
!
! TO BE FILLED IN
!
%RETURN
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
ALT(3):! LABEL
!
! TO BE FILLED IN
!
%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 DUMP('B',0,0,BTAD(I)) %AND I=I+1
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
! COMPILE EXPRESSION
!
! TO BE FILLED IN
!
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE OPD
! COMPILE OPERAND
!
! TO BE FILLED IN
!
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN EVALN
! EVALUATE <N>
!
! TO BE FILLED IN
!
%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