%BEGIN %ROUTINESPEC READ SYM(%INTEGERNAME I) %ROUTINESPEC READ PS %ROUTINESPEC READ LINE %INTEGERFNSPEC COMPARE(%INTEGER PSP) %ROUTINESPEC SS %ROUTINESPEC FAULT(%INTEGER A,B,C,D) %ROUTINESPEC OUT(%INTEGER I) %INTEGERFNSPEC CHNEXT %INTEGERFNSPEC NEWCELL %INTEGERFNSPEC RETURN CELL(%INTEGER I) %ROUTINESPEC PRINT NAME(%INTEGER I) %ROUTINESPEC PRINT LABEL(%INTEGER I) %ROUTINESPEC SHOW TAGS %INTEGER I,J,AP,APP,TP,ASL,BTN,CTN,CHP,FAULTS,NL,LEVEL,CA,COMP,SCF,PARS %INTEGERARRAY PS(-1000:-620) ;! REDUCED PHRASE STRUCTURE %INTEGERARRAY CHL,TAGL(0:255) %INTEGERARRAY TAG,LINK(1:1000) ;! TAGS LISTS %INTEGERARRAY A,PN,NP(1:200) ;! ANALYSIS RECORD %INTEGERARRAY T(1:300) ;! SOURCE TEXT %INTEGERARRAY BAT,COT(0:1023) ;! BRANCH, CONST TABLES %INTEGERARRAY CH(1:512) ;! NAME CHAR TABLE %INTEGERARRAY JUMP,STAR,BRT,NAME,RTP,BR,START,RAD(0:15);!LEVEL INFO %INTEGERARRAY TRUE,FALSE(1:6) ;! CONDITIONAL BRANCH INSTR %INTEGERARRAY PREC,UCN(1:12) ;! OPERATOR PRECS, TYPES %INTEGERARRAY OPR(0:12) ;! MACHINE OPERATIONS %INTEGERARRAY PT,PI(1:15) ;! FOR RT SPECS, HEADINGS !**** %EXTERNALROUTINESPEC DEFINE(%STRING(63) S) DEFINE('STREAM01,SKIMPPS+SKIMPI') SELECT INPUT(1) DEFINE('STREAM02,SKIMPO') SELECT OUTPUT(2) !**** READ PS I=0 10: CHL(I)=0 ; TAGL(I)=0 ;! CLEAR HASHING ARRAY I=I+1 %IF I<=255 %THEN ->10 I=1 11: TAG(I)=0 ; LINK(I)=I+1 ;! SET UP SPACE LIST I=I+1 %IF I<1000 %THEN ->11 LINK(1000)=0 ASL=1 ! BASE REGISTER MNEMONICS BR(0)=M'BR0' ; BR(1)=M'BR1' ; BR(2)=M'BR2' ; BR(3)=M'BR3' BR(4)=M'BR4' ; BR(5)=M'BR5' ; BR(6)=M'BR6' ; BR(7)=M'BR7' BR(8)=M'BR8' ; BR(9)=M'BR9' ; BR(10)=M'BR10'; BR(11)=M'BR11' BR(12)=M'BR12'; BR(13)=M'BR13'; BR(14)=M'BR14'; BR(15)=M'BR15' ! CONDITIONAL BRANCH MNEMONICS TRUE(1)=M'BZ' ; FALSE(1)=M'BNZ' TRUE(2)=M'BNZ' ; FALSE(2)=M'BZ' TRUE(3)=M'BNG' ; FALSE(3)=M'BG' TRUE(4)=M'BL' ; FALSE(4)=M'BNL' TRUE(5)=M'BNL' ; FALSE(5)=M'BL' TRUE(6)=M'BG' ; FALSE(6)=M'BNG' ! INSTRUCTION MNEMONICS, PRECEDENCES & TYPES ! 4 : HIGHEST PRECEDENCE, 1 : LOWEST PRECEDENCE ! 1 : UNARY, 2 : BINARY COMMUTATIVE, 3 : BINARY NON-COMMUTATIVE TYPES OPR(0)=M'LOAD' OPR(1)=M'SHL' ; PREC(1)=3 ; UCN(1)=3 ;! << OPR(2)=M'SHR' ; PREC(2)=3 ; UCN(2)=3 ;! >> OPR(3)=M'AND' ; PREC(3)=2 ; UCN(3)=2 ;! & OPR(4)=M'XOR' ; PREC(4)=1 ; UCN(4)=2 ;! !! OPR(5)=M'OR' ; PREC(5)=1 ; UCN(5)=2 ;! ! OPR(6)=M'EXP' ; PREC(6)=3 ; UCN(6)=3 ;! ** OPR(7)=M'DIV' ; PREC(7)=2 ; UCN(7)=3 ;! / OPR(8)=M'MLT' ; PREC(8)=2 ; UCN(8)=2 ;! * OPR(9)=M'ADD' ; PREC(9)=1 ; UCN(9)=2 ;! + OPR(10)=M'SUB' ; PREC(10)=1 ; UCN(10)=3 ;! - OPR(11)=M'NEG' ; PREC(11)=1 ; UCN(11)=1 ;! - OPR(12)=M'NOT' ; PREC(12)=4 ; UCN(12)=1 ;! \ BTN=0 ;! BRANCH TABLE POINTER CTN=0 ;! CONSTANT TABLE POINTER CHP=1 ;! NAME CHARACTER TABLE POINTER FAULTS=0 ;! FAULT COUNT NL=' ' ;! VALUE OF NEWLINE CHAR LEVEL=0 ;! TEXTUAL LEVEL SCF=0 ;! CONDITION FLAG JUMP(0)=0 ;! JUMP LIST POINTER STAR(0)=0 ;! STORAGE ALLOCATION POSITION NAME(0)=0 ;! NAME LIST POINTER RTP(0)=-1 ;! ROUTINE TYPE START(0)=0 ;! START/FINISH LIST RAD(0)=10 ;! NEXT REL ADDR TO ALLOCATE PARS=10 ;! NEXT PARAMETER REL ADDR CA=0 ;! CURRENT CODE DUMPING ADDRESS PRINT LABEL(M'PR') ;! LABEL AT START OF CODE ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! 1: READ LINE TP=1 ;! TEXT POINTER 2: %IF T(TP)='!' %THEN ->3 ;! COMMENT - SKIP TO END AP=1 ;! ANALYSIS REC POINTER %IF COMPARE(-1000)=1 %THEN %START ;! SUCCESSFUL ANALYSIS I=1 ;! PRINT OUT ANALYSIS REC J=1 5: WRITE(J,5) ;! INDEX TO ANALYSIS REC J=J+1 %IF J<=I+11 %AND J<=AP %THEN ->5 NEWLINE J=I 6: SPACES(2) ;! PHRASE NAMES OUT(PN(J)) J=J+1 %IF J<=I+11 %AND J<=AP %THEN ->6 NEWLINE J=I 7: WRITE(A(J),5) ;! ALTERNATIVE NUMBERS J=J+1 %IF J<=I+11 %AND J<=AP %THEN ->7 NEWLINE J=I 8: WRITE(NP(J),5) ;! NEXT PHRASE POSITION J=J+1 %IF J<=I+11 %AND J<=AP %THEN ->8 NEWLINES(2) I=I+12 %IF J<=AP %THEN ->5 AP=1 ;! ANALYSIS REC POINTER SS ;! PROCESS SOURCE STAT %IF T(TP-1)=';' %THEN ->2 ;! FURTHER STAT ON LINE ->1 ; %FINISH ;! GO TO READ NEXT LINE FAULT(M'SYNT',M'AX ',0,0) ;! UNSUCCESSFUL ANALYSIS 4: %IF T(TP)=NL %THEN ->1 ;! READ NEXT LINE %IF T(TP)=';' %THEN %START ;! END OF STATEMENT TP=TP+1 ;! TP TO START OF NEXT ->2 ; %FINISH ;! GO TO EXAMINE NEXT 3: TP=TP+1 ;! SKIP TO NEXT CHARACTER ->4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE READ SYM(%INTEGERNAME I) READ SYMBOL(I) PRINT SYMBOL(I) %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE READ PS ! READ IN AND REDUCE PHRASE STRUCTURE %INTEGER PNP,ALT,P,I,J,K %INTEGERARRAY PN,PSP(256:300) ;! PHRASE NAME CHARS & POINTERS %ROUTINESPEC INSERT LIT %INTEGERFNSPEC GET PN PNP=256 ;! PN POINTER P=-1000 ;! PS POINTER 1: READ SYM(I) %IF I='B' %THEN %START ;! BUILT-IN PHRASE 2: READ SYM(I) ;! SKIP TO < %IF I\='<' %THEN ->2 J=GET PN ;! READ PHRASE NAME ETC 3: READ SYM(I) ;! SKIP TO = %IF I\='=' %THEN ->3 READ(K) ;! READ PHRASE NUMBER WRITE(K,1) NEWLINE PSP(J)=K ;! FILL IN PHRASE NUMBER ->1 ; %FINISH ;! GO DEAL WITH NEXT PHRASE %IF I='P' %THEN %START ;! PHRASE 4: READ SYM(I) ;! SKIP TO < %IF I\='<' %THEN ->4 J=GET PN ;! READ PHRASE NAME PS(P)=PN(J) ;! STORE NAME PSP(J)=P ;! FILL IN POSITION P=P+1 7: ALT=P ;! REMEMBER START POSITION 6: P=P+1 ;! NEXT PS POSITION 5: READ SYM(I) ;! START OF NEXT ITEM %IF I='''' %THEN %START ;! LITERAL TEXT INSERT LIT ;! READ LITERAL & INSERT ->5 ; %FINISH ;! GO FOR NEXT ITEM %IF I='<' %THEN %START ;! ITEM IS A PHRASE NAME PS(P)=GET PN ;! READ PHRASE NAME & FILL IN ->6 ; %FINISH ;! GO FOR NEXT ITEM %IF I=',' %THEN %START ;! END OF THIS ALTERNATIVE PS(ALT)=P ;! FILL IN POINTER TO END ->7 ; %FINISH ;! GO FOR START OF NEXT ALT %IF I=';' %THEN %START ;! END OF PHRASE DEFINITION PS(ALT)=P ;! FILL IN POINTER TO END PS(P)=0 ;! FILL IN END MARKER P=P+1 ;! NEXT PS POSITION ->1 ; %FINISH ;! GO FOR NEXT PHRASE ->5 ; %FINISH ;! SKIP %IF I='E' %THEN %START ;! END OF PHRASE STRUCTURE NEWPAGE ;! REPLACE ALL POINTERS TO PS I=-1000 ;! & PRINT OUT REDUCED FORM J=0 8: %IF J=0 %THEN %START ;! 8 PER LINE NEWLINE WRITE(I,4) ;! INDEX TO PS SPACES(3) %FINISH K=PS(I) %IF K>=256 %AND K<=300 %THEN PS(I)=PSP(K) ;! PHRASES %IF PS(I)<=256 %THEN WRITE(PS(I),7) %ELSE %START SPACES(4) OUT(K) %FINISH I=I+1 J=(J+1)&7 %IF I\=P %THEN ->8 NEWPAGE %RETURN ; %FINISH ->1 ;! SKIP ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE INSERT LIT ! INSERT LITERAL TEXT INTO 'PS' %INTEGER SH,I SH=0 ;! % SHIFT VALUE TO 0 1: READ SYM(I) %IF I='''' %THEN %START %IF NEXT SYMBOL\='''' %THEN %RETURN ;! END OF LITERAL READ SYM(I) ;! QUOTE INSIDE LITERAL - IGNORE %FINISH %IF I='%' %THEN SH=128 %ELSE %START ;! SHIFT VALUE TO 128 FOR % %IF I<'A' %OR I>'Z' %THEN SH=0 ;! END OF KEYWORD - SHIFT VAL PS(P)=I+SH ;! STORE SHIFTED (POSSIBLY) CHAR P=P+1 ;! MOVE TO NEXT POSITION IN PS %FINISH ->1 %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %INTEGERFN GET PN ! READ IN PHRASE NAME AND GET INDEX IN 'PSP' %INTEGER NP,I NP=M' ' ;! TO ACCUMULATE PHRASE NAME CHARS 1: READ SYM(I) %IF I\='>' %THEN %START ;! NOT END OF NAME YET NP=NP<<8!I ;! PACK NEXT CHAR OF PHRASE NAME ->1 ; %FINISH %IF PNP\=256 %THEN %START ;! NOT FIRST PHRASE NAME I=256 ;! SCAN NAMES TO FIND IF ALREADY IN 2: %IF NP=PN(I) %THEN %RESULT=I I=I+1 %IF I\=PNP %THEN ->2 %FINISH PN(PNP)=NP ;! INSERT NEW NAME IN DICTIONARY PSP(PNP)=M'????' ;! UNDEFINED PHRASE MARKER PNP=PNP+1 ;! MOVE TO NEXT DICTIONARY POSITION %RESULT=PNP-1 %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE READ LINE ! LEXICAL PHASE - READ & CLEAN UP NEXT LINE OF TEXT %ROUTINESPEC STORE(%INTEGER I) %INTEGER SH,I NEWLINES(2) SH=0 ;! % & LITERAL SHIFT VALUE TO 0 TP=1 ;! POINTER TO TEXT ARRAY T 1: READ SYM(I) %IF I='''' %THEN %START SH=0 ;! SHIFT VALUE FOR LITERAL 2: STORE(I) ;! STORE CHAR IN TEXT A READ SYM(I) %IF I\='''' %THEN ->2 ;! NOT END OF LITERAL YET READ SYM(I) %IF I='''' %THEN ->2 ;! QUOTE IN LITERAL, IGNORE ONE STORE(''''+128) ;! STORE SHIFTED VAL %FINISH %IF I='%' %THEN %START ;! SHIFT VALUE TO 128 FOR KEYWD SH=128 ->1 ; %FINISH %IF I<'A' %OR I>'Z' %THEN SH=0 ;! SHIFT VALUE TO 0 FOR END %IF I=' ' %THEN ->1 ;! IGNORE SPACES STORE(I) %IF I\=NL %THEN ->1 ;! NEWLINE CHAR %IF TP>2 %THEN %START ;! IGNORE BLANK LINES %IF T(TP-2)='C'+128 %THEN TP=TP-2 %ELSE %RETURN ;! MOVE POINTER BACK IF % C %FINISH %ELSE TP=1 ->1 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE STORE(%INTEGER I) ! STORE (POSSIBLY) SHIFTED CHAR IN TEXT ARRAY & CHECK LINE NOT TOO LONG %IF TP>300 %THEN %START FAULT(M'STAT',M'MNT ',M'TOO ',M'LONG') TP=1 %FINISH T(TP)=I+SH ;! STORE CHAR IN TEXT ARRAY TP=TP+1 ;! MOVE TO NEXT POSITION %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN COMPARE(%INTEGER PSP) ! ANALYSE PHRASE %INTEGERFNSPEC NAME ;! BUILT-IN PHRASE %INTEGERFNSPEC CNST ;! BUILT-IN PHRASE %INTEGER APP,TPP,AE,N TPP=TP ;! PRESERVE INITIAL TEXT POINTER APP=AP ;! PRESERVE INITIAL ANAL REC PTR A(AP)=1 ;! ALTERNATIVEE 1 FIRST PN(AP)=PS(PSP) PSP=PSP+1 11: AE=PS(PSP) ;! POINTER TO END OF ALTERNATIVE PSP=PSP+1 ;! FIRST ITEM OF ALTERNATIVE DEF 12: %IF PSP=AE %THEN %START ;! END OF ALT REACHED - SUCCESS NP(APP)=AP+1 ;! POINTER TO NEXT PHRASE %RESULT=1 ; %FINISH N=PS(PSP) ;! NEXT ITEM OF ALT DEFN PSP=PSP+1 ;! FOR FOLLOWING ITEM %IF N<0 %THEN %START ;! SUB-PHRASEE AP=AP+1 ;! NEXT ANALYSIS RECORD POSITION %IF AP>200 %THEN %START FAULT(M'ANAL',M' REC',M' FUL',M'L ') %STOP ; %FINISH %IF COMPARE(N)=1 %THEN ->12 ;! SUCCESSFUL COMPARISON ->13 ; %FINISH ;! UNSUCCESSFUL - GO FOR NEXT ALT %IF N=1 %THEN %START ;! BUILT-IN PHRASE %IF NAME=1 %THEN ->12 ;! SUCCESS ->13 ; %FINISH ;! FAILURE %IF N=2 %THEN %START ;! BUILT-IN PHRASE CNST %IF CNST=1 %THEN ->12 ;! SUCCESS ->13 ; %FINISH ;! FAILURE %IF N=T(TP) %THEN %START ;! LITERAL - MATCHES SOURCE CHAR TP=TP+1 ;! MOVE TO NEXT SOURCE CHAR ->12 ; %FINISH ;! GO FOR NEXT ITEM 13: %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 ->11 ;! GO TO ANALYSE NEW ALTERNATIVE ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %INTEGERFN NAME ! RECOGNISE AND INSERT NAME IN HASHING AREA OF TAG/LINK ARRAYS %INTEGER I,J,K,L,M,N I=T(TP) ;! FIRST SOURCE CHAR %IF I<'A' %OR I>'Z' %OR (I='M' %AND T(TP+1)='''') %THEN %RESULT=0 ;! FAILURE - NOT A CONSTANT J=CHP ;! NEXT POSITION IN CHAR ARRAY K=I<<16 ;! LEAVE HOLE FOR LENGTH & PACK L=1 ;! NO OF CHARS M=8 ;! NEXT SHIFT VALUE FOR PACKING N=I ;! SUM VALUE OF CHARS FOR HASHING 1: TP=TP+1 I=T(TP) ;! NEXT CHAR FROM TEXT ARRAY %IF ('0'<=I %AND I<='9') %OR ('A'<=I %AND I<='Z') %THEN %START ;! A DIGIT OR A LETTER K=K!I<1 ; %FINISH ;! GO FOR NEXT CHAR %IF K\=0 %THEN CH(CH NEXT)=K ;! STORE ANY REMAINING CHARS CH(J)=CH(J)!L<<24 ;! FILL IN LENGTH IN HOLE LEFT I=(N<<4!!N>>4)&255 ;! HASH VALUE K=I ;! SCAN DICTIONARY FOR NAME 2: %IF CHL(K)\=0 %THEN %START ;! A NAME IN THIS POSITION L=CHL(K) ;! CHAR ARRAY POSITION M=J ;! CHAR ARRAY POSITION OF NEW NAME 4: %IF CH(L)=CH(M) %THEN %START ;! PACKED WORDS MATCH M=M+1 ;! NEXT WORD OF NEW NAME %IF M=CHP %THEN %START ;! NAMES MATCH CHP=J ;! MOVE CHP BACK SINCE NAME IN ->3 ; %FINISH L=L+1 ;! NEXT WORD OF OLD NAME ->4 ; %FINISH ;! GO FOR NEXT WORD K=(K+1)&255 ;! NO MATCH SO TRY NEXT POSITION %IF K=I %THEN %START ;! STARTING POSITION REACHED AGAIN FAULT(M'DICT',M'IONA',M'RY F',M'ULL ') %STOP ; %FINISH ->2 ; %FINISH CHL(K)=J ;! STORE CHAR ARRAY POSITION 3: AP=AP+1 ;! NEXT ANALYSIS RECORD POSITION %IF AP>200 %THEN %START FAULT(M'ANAL',M' REC',M' FUL',M'L ') %STOP ; %FINISH A(AP)=K ;! STORE IDENTIFICATION NO OF NAME PN(AP)=M'NAME' ;! PHRASE MATCHED NP(AP)=AP+1 ;! NEXT PHRASE %RESULT=1 ;! SUCCESS %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %INTEGERFN CNST ! RECOGNISE INTEGER AND LITERAL TEXT CONSTANTS %INTEGER I,J,K I=T(TP) ;! FIRST CHAR %IF I='M' %AND T(TP+1)='''' %THEN %START ;! M-TYPE CONSTANT TP=TP+1 ;! IGNORE THE M I='''' %FINISH %IF I='''' %THEN %START ;! START OF A LITERAL J=0 ;! TO ACCUMULATE LITERAL VALUE K=0 ;! CHARACTER COUNT 1: TP=TP+1 I=T(TP) ;! NEXT CHAR %IF I\=''''+128 %THEN %START ;! NOT END OF LITERAL J=J<<8!I ;! PACK CHAR K=K+1 ;! COUNT CHAR ->1 ; %FINISH TP=TP+1 ;! POINTER AFTER QUOTE %IF K>4 %THEN FAULT(M'STRI',M'NG T',M'OO L',M'ONG ') ->2 ; %FINISH %IF I<'0' %OR I>'9' %THEN %RESULT=0 ;! NOT A CONSTANT J=0 K=0 3: %IF J<214748364 %OR (J=214748364 %AND I<='7') %THEN %C J=10*J+I-'0' %ELSE K=1 ;! CHECK AND ACCUMULATE VALUE TP=TP+1 I=T(TP) ;! NEXT CHAR %IF '0'<=I %AND I<='9' %THEN ->3 ;! A DIGIT - PART OF CONSTANT %IF K\=0 %THEN FAULT(M'CONS',M'T TO',M'O BI',M'G ') 2: AP=AP+1 ;! NEXT ANALYSIS REC POSITION %IF AP>200 %THEN %START FAULT(M'ANAL',M' REC',M' FUL',M'L ') %STOP ; %FINISH A(AP)=J ;! FILL IN VALUE OF CONSTANT PN(AP)=M'CNST' ;! PHRASE MATCHED NP(AP)=AP+1 ;! NEXT PHRASE %RESULT=1 ;! SUCCESS %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE SS ! COMPILE SOURCE STATEMENT %ROUTINESPEC UI %ROUTINESPEC SCCOND(%INTEGERNAME LABEL) %ROUTINESPEC SEXPR %INTEGERFNSPEC FIND LABEL %ROUTINESPEC CHECK %ROUTINESPEC UNSET %ROUTINESPEC PUSH START(%INTEGER FLAG,LABEL) %INTEGERFNSPEC BT NEXT %INTEGERFNSPEC CT NEXT %INTEGERFNSPEC WS NEXT %ROUTINESPEC STORE TAG(%INTEGER NAM,FORM,TYPE,DIM,LEV,AD) %ROUTINESPEC DUMP(%INTEGER OP,REG,BASE,DISP) %ROUTINESPEC RT %ROUTINESPEC ARRAD %ROUTINESPEC ENTER(%INTEGER TYPE,ALLOC) %ROUTINESPEC RETURN %INTEGER I,J,K,L,M,N,P,Q,R,WS,LABEL I=A(AP) ;! ANALYSIS RECORD ENTRY AP=AP+1 ;! FOR FOLLOWING ENTRY WS=2 ;! SET WORKSPACE POINTER %IF I=1 %THEN ->10 ;! UNCONDITIONAL INSTRUCTION %IF I=2 %THEN ->20 ;! CONDITIONAL STATEMENT %IF I=3 %THEN ->30 ;! LABEL %IF I=4 %THEN ->40 ;! %FINISH %IF I=5 %THEN ->50 ;! DECLARATIONS %IF I=6 %THEN ->60 ;! ROUTINE/FN SPEC %IF I=7 %THEN ->70 ;! %END %IF I=8 %THEN ->80 ;! %BEGIN %IF I=9 %THEN ->90 ;! %ENDOFPROGRAM %RETURN ;! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! 10: UI ;! COMPILE UNCONDITIONAL INSTR %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %IF - - - %THEN - - - %ELSE 20: SCCOND(I) ;! COMPILE CONDITION %IF A(AP)=2 %THEN %START ;! AP ON - JUMP INSTR AP=AP+2 ;! AP ON J=-1 ;! MARKER FOR 'JUMP' %FINISH %ELSE %START ;! NOT A JUMP %IF A(AP)=3 %THEN %START ;! %START %IF A(AP+1)=1 %THEN FAULT(M'%STA',M'RT %',M'ELSE',M' ') PUSH START(0,I) %RETURN ; %FINISH UI ;! COMPILE REMAINING UI J=0 ;! 'NOT JUMP' MARKER %FINISH %IF A(AP)=1 %THEN %START ;! -CLAUSE PRESENT %IF J=0 %THEN %START ;! WAS NOT A JUMP J=BT NEXT ;! JUMP ROUND -CLAUSE DUMP('B',0,M'BT',J) %FINISH %IF I>=0 %THEN BAT(I)=CA ;! FILL IN LAB ON -CLAUSE AP=AP+1 ;! AP ON %IF A(AP)=3 %THEN %START ;! %START PUSH START(1,J) %RETURN ; %FINISH UI ;! COMPILE REMAINING S I=J ;! JUMP AROUND LABEL %FINISH %IF I>=0 %THEN BAT(I)=CA ;! TO BRANCH ROUND THE UI %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! CONST: - - - 30: I=FIND LABEL ;! LOCATE/INSERT LABEL IN JUMP %IF I>=0 %THEN %START ;! VALID LABEL %IF BAT(I)>=0 %THEN %START WRITE(LABEL,1) SPACES(2) FAULT(M'LABE',M'L SE',M'T TW',M'ICE ') %FINISH BAT(I)=CA ;! FILL IN LABEL ADDRESS %FINISH SS ;! COMPILE STATEMENT AFTER LAB %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %FINISH - - - 40: I=START(LEVEL) ;! LINK TO FIRST CELL %IF I=0 %THEN %START ;! NO CELLS IN LIST FAULT(M'SPUR',M'IOUS',M' %FI',M'NISH') %RETURN ; %FINISH J=TAG(I)&65535 ;! JUMP AROUND LABEL K=TAG(I)>>16 ;! BEFORE/AFTER %ELSE MARK START(LEVEL)=RETURN CELL(I) ;! POP UP CELL %IF A(AP)=1 %THEN %START ;! %ELSE PRESENT %IF K=1 %THEN FAULT(M'TWO ',M'%ELS',M'ES !',0) K=BT NEXT ;! JUMP AROUND DUMP('B',0,M'BT',K) %IF J\=65535 %THEN BAT(J)=CA ;! FILL IN LABEL ON AP=AP+1 ;! AP ON %IF A(AP)=3 %THEN %START ;! %START PUSH START(1,K) %RETURN ; %FINISH UI ;! COMPILE REMAINING S J=K ;! JUMP AROUND LABEL %FINISH %IF J\=65535 %THEN BAT(J)=CA ;! FILL IN JUMP AROUND LAB %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! DECLARATIONS 50: %IF A(AP)=1 %THEN %START ;! = %ARRAY APP=AP ;! SAVE AP AP=NP(AP+2) ;! AP ON <+-\> SEXPR ;! COMPILE EXPR DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! STORE VALUE IN WRK SEXPR ;! COMPILE EXPR DUMP(M'LDA',M'ACC',M'ACC',1) ;! INCREMENT VALUE DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) WS=WS-2 ;! RESTORE WORKSPACE I=1 ;! NO OF DIMS J=2 ;! TAG FOR 'ARRAY' AP=APP ;! RESTORE AP %FINISH %ELSE %START ;! SCALAR DECLARATIIONS I=0 ;! DIMS=0 FOR SCALARS J=0 ;! TAG FOR SCALAR %FINISH 52: STORE TAG(A(AP+1),J,1,0,LEVEL,RAD(LEVEL)) ;! PUSHDOWN TAG %IF I=1 %THEN %START ;! 1-DIM ARRAYS DUMP(M'SUB',M'STP',BR(LEVEL),WS) DUMP(M'STR',M'STP',BR(LEVEL),RAD(LEVEL)) DUMP(M'ADD',M'STP',BR(LEVEL),WS+1) %FINISH RAD(LEVEL)=RAD(LEVEL)+1 AP=AP+2 ;! AP ON %IF A(AP)=1 %THEN ->52 ;! MORE NAMES %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! RT SPEC - - - 60: I=A(AP)-1 ;! ROUTINE/FN J=A(AP+1) ;! SPEC K=A(AP+2) ;! NAME OF ROUTINE AP=AP+3 ;! AP ON L=0 ;! PARAMETER COUNT M=10 ;! FIRST REL ADDR 63: %IF A(AP)=1 %THEN %START ;! PARAMETERS AP=AP+1 ;! AP ON %IF A(AP)=1 %THEN N=3 %ELSE N=3-A(AP) ;! SET TAG FOR PARAM P=N<<28!1<<24!(LEVEL+1)<<16 ;! SET UP PATTERN 62: L=L+1 ;! PARAMETER COUNT %IF L>15 %THEN %START FAULT(M'TOO ',M'MANY',M' PAR',M'AMS ') ->61 ; %FINISH ;! IGNORE PARAMS PT(L)=P!M ;! STORE TAG PI(L)=A(AP+1) ;! STORE IDENT M=M+1 ;! NEXT REL ADDR AP=AP+2 ;! AP ON %IF A(AP)=1 %THEN ->62 ;! MORE NAMES AP=AP+1 ;! AP ON ->63 ; %FINISH 61: N=TAGL(K) ;! LINK TO TAG %IF N=0 %OR TAG(N)>>16&150 %THEN %START ;! PARAMETERS P=1 ;! PARAMETER COUNT Q=TAGL(K) ;! 'INSERT AFTER' PTR 64: R=NEWCELL ;! PUSHDOWN TAG TAG(R)=PT(P) LINK(R)=LINK(Q) LINK(Q)=R Q=R ;! NEW VALUE FOR PTR P=P+1 ;! PARAMETER COUNT %IF P<=L %THEN ->64 ;! MORE PARAMETERS %FINISH %IF LEVEL=0 %THEN BAT(BTN-1)=K+65536 ;! FLAG FOR EXT RT %FINISH %ELSE %START ;! NAME ALREADY SET %IF J=2 %AND TAG(N)>>28=4 %THEN %START ;! STATEMENT NOT SPEC %IF TAG(N)>>24&15\=I %THEN %START PRINT NAME(K) FAULT(M'RT N',M'OT A',M'S SP',M'EC ') %FINISH %IF BAT(TAG(N)&65535)>=0 %THEN %START PRINT NAME(K) FAULT(M'RT A',M'PPEA',M'RS T',M'WICE') %FINISH P=TAG(N)>>20&15 ;! NO OF PARAMS %IF L\=P %THEN %START FAULT(M'PARS',M' NOT',M' AS ',M'SPEC') %IF L>P %THEN L=P ;! IGNORE PARAMS %FINISH %IF L>0 %THEN %START ;! PARAMS PRESENT P=1 ;! PARAM COUNT Q=LINK(N) ;! LINK TO TAG 67: %IF PT(P)\=TAG(Q) %THEN %START PRINT NAME(PI(P)) FAULT(M'PAR ',M'NOT ',M'AS S',M'PEC ') %FINISH P=P+1 ;! PARAM COUNT Q=LINK(Q) ;! NEXT TAG CELL %IF P<=L %THEN ->67 ;! MORE PARAMS %FINISH %FINISH %ELSE %START PRINT NAME(K) FAULT(M'NAME',M' SET',M' TWI',M'CE ') %FINISH %FINISH %IF J=2 %THEN %START ;! STATEMENT NOT SPEC BRT(LEVEL)=BT NEXT ;! BRANCH ROUND RT DUMP('B',0,M'BT',BRT(LEVEL)) BAT(TAG(TAGL(K))&65535)=CA ;! FILL IN ADDR %IF LEVEL=15 %THEN FAULT(M'TOO ',M'MANY',M' LEV',M'ELS ') %C %ELSE LEVEL=LEVEL+1 ENTER(I,M) %IF L>0 %THEN %START ;! PARAMS PRESENT P=1 ;! PARAM COUNT 69: I=PT(P) ;! PUSHDOWN TAGS STORE TAG(PI(P),I>>28,1,0,LEVEL,I&65535) P=P+1 %IF P<=L %THEN ->69 ;! MORE PARAMS %FINISH %FINISH %ELSE %START ;! STATEMENT A SPEC %IF L>0 %THEN %START ;! PARAMS PRESENT P=1 68: I=PI(P) ;! PARAM IDENT %IF TAGL(I)=0 %THEN %START ;! NO TAG SET UP %IF CHP>CHL(I) %THEN CHP=CHL(I) ;! MOVE CHP BACK CHL(I)=0 ;! CLEAR NAME LINK %FINISH P=P+1 %IF P<=L %THEN ->68 ;! MORE PARAMS %FINISH %FINISH %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %END 70: SHOW TAGS ;! PRINT OUT TAGS CHECK ;! CHECK LABS & STARTS COT(STAR(LEVEL))=RAD(LEVEL) ;! STORE STATIC ALLOC UNSET ;! UNSET NAMES DECLARED %IF RTP(LEVEL)\=0 %THEN DUMP(M'STOP',0,0,0) ;! %STOP FOR FNS RETURN ;! DUMP %RETURN CODE LEVEL=LEVEL-1 ;! DECREMENT TEXT LEV %IF LEVEL<1 %THEN %START ;! NOT OUTER LEV FAULT(M'EXCE',M'SS %',M'END ',0) ->71 ; %FINISH ;! TREAT AS %ENDOFPROG BAT(BRT(LEVEL))=CA ;! FILL ADDR FOR BRANCH %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %BEGIN 80: %IF LEVEL\=0 %THEN %START FAULT(M'%BEG',M'IN E',M'XTRA',0) ;! NO INTERNAL BLOCKS %RETURN ; %FINISH %IF CA\=0 %OR RAD(0)\=10 %THEN %START FAULT(M'%BEG',M'IN N',M'OT F',M'IRST') %RETURN ; %FINISH LEVEL=1 ;! TEXTUAL LEVEL COUNT TO 1 ENTER(-1,10) %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ENDOFPROGRAM 90: SHOW TAGS ;! PRINT OUT NAME TAGS CHECK ;! CHECK LABELS & START COT(STAR(LEVEL))=RAD(LEVEL) ;! FILL IN STATIC ALLOCATION UNSET ;! UNSET NAMES DECLARED %IF LEVEL\=1 %THEN FAULT(M'TOO ',M'FEW ',M'%END',M'S ') 71: DUMP(M'STOP',0,0,0) ;! %STOP PRINT LABEL(M'BT') CA=0 93: %IF CA\=BTN %THEN %START DUMP('B',0,M'PR',BAT(CA)) ;! BRANCH RELATIVE TO START ->93 ; %FINISH PRINT LABEL(M'CT') CA=0 91: %IF CA\=CTN %THEN %START DUMP(0,0,0,COT(CA)) ->91 ; %FINISH PRINT LABEL(M'ST') WRITE(FAULTS,1) ;! NUMBER OF PROGRAM FAULTS FAULT(M' FAU',M'LTS ',M'IN P',M'ROG.') %STOP !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE UI ! COMPILE UNCONDITIONAL INSTRUCTION %INTEGER I,J,K,L I=A(AP) ;! NEXT ANALYSIS RECORD ENTRY AP=AP+1 %IF I=1 %THEN ->10 ;! ROUTINE CALL OR ASSIGNMENT %IF I=2 %THEN ->20 ;! JUMP INSTRUCTION %IF I=3 %THEN ->30 ;! %START %IF I=4 %THEN ->40 ;! %RETURN %IF I=5 %THEN ->50 ;! %RESULT= DUMP(M'STOP',0,0,0) ;! %STOP %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! NAME APP ASS 10: I=TAGL(A(AP)) ;! POINTER TO NAME TAGS %IF I=0 %THEN %START PRINT NAME(A(AP)) FAULT(M'NAME',M' NOT',M' SET',0) %FINISH %ELSE I=TAG(I) ;! NAME TAGS OR ZERO J=AP ;! PRESERVE ANAL REC PTR AP=NP(AP+1) ;! AP ON %IF A(AP)=2 %THEN %START ;! ROUTINE CALL %IF I>>24=64 %THEN %START ;! 'FORM/TYPE' IS ROUTINE AP=J ;! RESTORE AP TO RT ;! CALL ROUTINE %FINISH %ELSE %START %IF I\=0 %THEN %START PRINT NAME(A(J)) FAULT(M'NOT ',M'ROUT',M'INE ',M'NAME') %FINISH %FINISH AP=AP+1 ;! AP AFTER %RETURN ; %FINISH K=I>>28 ;! 'FORM' OF NAME %IF K=4 %THEN %START PRINT NAME(A(J)) FAULT(M'NAME',M' NOT',M' A D',M'ESTN') ;! ROUTINE/FN FORM I=0 ;! CLEAR TAGS TO AVOID %FINISH AP=AP+1 ;! AP ON <+-\> SEXPR %IF I=0 %THEN %RETURN ;! LHS NAME NOT SET %IF K>=2 %THEN %START ;! LHS AN ARRAY TYPE DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! PRESERVE ACCUMMULATOR K=AP ;! PRESERVE AP AP=J ;! RESTORE ANAL REC PTR ARRAD ;! CALCULATE ARRAY ADDR WS=WS-1 ;! RESTORE WORKSPACE PTR DUMP(M'LOAD',M'WK',BR(LEVEL),WS) ;! RESTORE ACCUMMULATOR DUMP(M'STR',M'WK',M'ACC',0) ;! DUMP ASSIGNMENT AP=K ;! RESTORE AP TO +1 %RETURN ; %FINISH %IF K=1 %THEN %START DUMP(M'LOAD',M'WK',BR(I>>16&15),I&65535);! INDIRECT ASSIGMENT DUMP(M'STR',M'ACC',M'WK',0) %FINISH %ELSE DUMP(M'STR',M'ACC',BR(I>>16&15),I&65535) %IF A(J+1)=1 %THEN %START PRINT NAME(A(J)) FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM') %FINISH %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! -> CONST 20: DUMP('B',0,M'BT',FIND LABEL) ;! SCAN/INSERT JUMP LIST %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %START 30: FAULT(M'%STA',M'RT ',0,0) ;! %START ALONE ILLEGAL %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %RETURN 40: %IF RTP(LEVEL)\=0 %THEN FAULT(M'%RET',M'URN ',M'CONT',M'EXT ') RETURN ;! DUMP %RETURN CODE %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %RESULT= 50: I=RTP(LEVEL) ;! ROUTINE/FN TYPE %IF I<=0 %THEN FAULT(M'%RES',M'ULT ',M'CONT',M'EXT ') ;! %BEGIN/%RT SEXPR ;! COMPILE RESULT EXPR RETURN ;! LEAVE RESULT IN ACC %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE SEXPR ! COMPILE ARITHMETIC EXPRESSION %ROUTINESPEC TORP %ROUTINESPEC STORE(%INTEGER I,J) %ROUTINESPEC EVAL(%INTEGER P) %INTEGER RPP,APP,PSTP %INTEGERARRAY RP,PT,PST(1:32) ;! REV POL, TYPES, PS-EVAL RPP=1 ;! RP POINTER PSTP=0 ;! PSEUDO-EVAL STACK PTR TORP ;! EXPR TO REV POLISH %IF SCF=1 %THEN %START ;! PART OF A SIMPLE COND SCF=0 ;! RESET FLAG COMP=A(AP) ;! COMPARATOR NUMBER %IF A(AP+3)=0 %AND A(AP+4)=2 %THEN AP=AP+5 %ELSE %START AP=AP+1 ;! 2ND EXPR NON-ZERO TORP ;! 2ND EXPRESSION TO REV POL STORE(10,1) ;! STORE 1ST-2ND %FINISH %FINISH APP=AP ;! SAVE FINAL ANAL REC PTR EVAL(RPP-1) ;! DUMP CODE FOR EXPR EVAL AP=APP ;! RESTORE ANAL REC PTR %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE TORP ! TRANSFORM EXPRESSION TO REVERSE POLISH %INTEGERARRAY OP(1:4) %INTEGER OPP,I,J,K %IF A(AP)=2 %OR A(AP)=3 %THEN %START ;! UNARY - OR \ OP(1)=A(AP)+9 ;! STACK UNARY OPERATOR OPP=1 %FINISH %ELSE OPP=0 AP=AP+1 ;! AP ON 3: %IF A(AP)=3 %THEN %START ;! SUB-EXPRESSION AP=AP+1 ;! AP ON <+-\> TORP ;! CONVERT SUB-EXPR TO RP ->1 ; %FINISH %IF A(AP)=2 %THEN %START ;! CONSTANT STORE(A(AP+1),-4) ;! STORE VALUE OF CONST AP=AP+2 ;! AP ON ->1 ; %FINISH I=A(AP+1) ;! NAME IDENT NUMBER J=TAGL(I) ;! LINK TO TAG OF NAME %IF J=0 %THEN %START ;! NAME NOT SET PRINT NAME(I) FAULT(M'NAME',M' NOT',M' SET',0) STORE(0,-3) ;! STORE DUMMY TAG ->2 ; %FINISH K=TAG(J) ;! TAG OF NAME %IF K>>28<=1 %THEN %START ;! SCALAR VARIABLE %IF A(AP+2)=1 %THEN %START ;! PARAMETERS PRESENT PRINT NAME(I) FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM') %FINISH STORE(K,-3) ;! STORE TAG & TYPE -3 ->2 ; %FINISH %IF K>>28<=3 %THEN %START ;! ARRAY VARIABLE STORE(AP+1,-2) ;! STORE ANAL REC POSITION ->2 ; %FINISH %IF K>>24&15=0 %THEN %START ;! %ROUTINE TYPE PRINT NAME(I) FAULT(M'ROUT',M'INE ',M'IN E',M'XPR ') STORE(0,-3) ;! STORE DUMMY TAG ->2 ; %FINISH STORE(AP+1,-1) ;! STORE ANAL REC POSITION 2: AP=NP(AP+2) ;! AP TO AFTER 1: %IF A(AP)=1 %THEN %START ;! ANOTHER OPERAND YET I=A(AP+1) ;! NEXT OPERATOR AP=AP+2 ;! AP TO 4: %IF OPP=0 %OR PREC(I)>PREC(OP(OPP)) %THEN %START ;! HIGHER PREC OPP=OPP+1 ;! SO STACK NEW OPERATOR OP(OPP)=I ->3 ; %FINISH ;! GO FOR NEXT OPERAND STORE(OP(OPP),1) ;! UNSTACK TOP OPERATOR OPP=OPP-1 ->4 ; %FINISH ;! COMPARE WITH PREVIOUS OP 5: %IF OPP>0 %THEN %START ;! OPERATORS LEFT IN STACK STORE(OP(OPP),1) ;! SO UNSTACK THEM OPP=OPP-1 ->5 ; %FINISH ;! ANY MORE OPERATORS LEFT ? AP=AP+1 ;! AP AFTER %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE STORE(%INTEGER I,J) ! STORE IN RP & PT ARRAYS & PSEUDO-EVALUATE %IF RPP>32 %THEN %START ;! REV POL ARRAY FULL FAULT(M'EXPR',M' TOO',M' LON',M'G ') RPP=1 ;! IN ORDER TO CONTINUE %FINISH %IF J>0 %THEN %START ;! OPERATOR %IF I<=10 %THEN %START ;! BINARY OP PSTP=PSTP-1 ;! UNSTACK TOP ITEM J=PST(PSTP) ;! POINTER TO 1ST OPERAND %FINISH %FINISH %ELSE PSTP=PSTP+1 ;! OPERAND RP(RPP)=I ;! STORE OP/OPD PT(RPP)=J ;! STORE POINTER OR TYPE PST(PSTP)=RPP ;! STACK NEXT POINTER RPP=RPP+1 ;! NEXT POSITION %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE EVAL(%INTEGER P) ! DUMP CODE FOR EVALUATION OF EXPRESSION %ROUTINESPEC OPN(%INTEGER OP,L) %INTEGER I,J,K I=PT(P) ;! PTR/TYPE OF LAST %IF I<0 %THEN %START ;! OPERAND OPN(0,P) ;! LOAD OPERAND %RETURN ; %FINISH J=RP(P) ;! OPERATOR K=P-1 ;! START OF 2ND OPD %IF UCN(J)=1 %THEN %START ;! UNARY OPERATOR %IF PT(K)>=-2 %THEN EVAL(K) %ELSE OPN(0,K) ;! EVAL IF NODE DUMP(OPR(J),M'ACC',0,0) ;! DUMP UNARY OPN %RETURN ; %FINISH %IF PT(I)>=-2 %THEN %START ;! FIRST OPD A NODE %IF PT(K)>=-2 %THEN %START ;! SECOND OPD A NODE EVAL(K) ;! EVALUATE 2ND OPD DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! & STORE IT EVAL(I) ;! EVALUATE 1ST OPD WS=WS-1 ;! RESTORE WORKSPACE DUMP(OPR(J),M'ACC',BR(LEVEL),WS) ;! DUMP OPERATION %FINISH %ELSE %START ;! 2ND OPD NOT NODE EVAL(I) ;! EVALUATE 1ST OPD OPN(J,K) ;! OPERATION WITH 2ND %FINISH %FINISH %ELSE %START ;! 1ST OPD NOT NODE %IF PT(K)>=-2 %THEN %START ;! 2ND OPERAND A NODE EVAL(K) ;! EVALUATE 2ND OPD %IF UCN(J)=2 %THEN %START ;! OPERATOR IS COMM OPN(J,I) ;! OPERATION WITH 1ST %RETURN ; %FINISH DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! STORE VALUE OF 2ND OPN(0,I) ;! LOAD 1ST OPERAND WS=WS-1 ;! RESTORE WORKSPACE DUMP(OPR(J),M'ACC',BR(LEVEL),WS) ;! DUMP OPN WITH 2ND %FINISH %ELSE %START ;! 2ND OPD NOT NODE OPN(0,I) ;! LOAD 1ST OPERAND OPN(J,K) ;! OPERATION WITH 2ND %FINISH %FINISH %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE OPN(%INTEGER OP,L) ! DUMP SIMPLE OPERATION, OP=OPERATOR, L=RP POSITION OF OPERAND %INTEGER I,J I=PT(L) ;! KIND OF OPERAND AP=RP(L) ;! ANAL REC POINTER %IF I=-1 %THEN %START ;! ROUTINE/FN TYPE RT ;! DUMP CALL ON FN %RETURN ; %FINISH %IF I=-2 %THEN %START ;! ARRAY ACCESS ARRAD ;! CALC ARRAY ADDR DUMP(M'LOAD',M'ACC',M'ACC',0) ;! LOAD VALUE %RETURN ; %FINISH %IF I=-3 %THEN %START ;! SCALAR TYPE %IF AP>>28=1 %THEN %START ;! %NAME TYPE DUMP(M'LOAD',M'WK',BR(AP>>16&15),AP&65535) ;! LOAD INDIRECT DUMP(OPR(OP),M'ACC',M'WK',0) %FINISH %ELSE DUMP(OPR(OP),M'ACC',BR(AP>>16&15),AP&65535) %RETURN ; %FINISH %IF OP\=0 %OR AP>65535 %THEN %START ;! NOT 'LDA'-ABLE J=CT NEXT ;! NEXT HOLE IN CT COT(J)=AP ;! STORE VALUE DUMP(OPR(OP),M'ACC',M'CT',J) %FINISH %ELSE DUMP(M'LDA',M'ACC',0,AP) %END %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE SCCOND(%INTEGERNAME LABEL) ! COMPILE CONDITION , LABEL SET FOR POSITION AFTER UI %ROUTINESPEC SC %ROUTINESPEC COND %ROUTINESPEC STORE(%INTEGER FT) %INTEGER I,J,K,L,APP %INTEGERARRAY CAP,LVL,TF,JMP,LBL(1:16) ;! ANAL REC PTRS, ;! NESTING LEVEL, TRUE/FALSE, JUMP ARRAYS I=1 ;! INDEX TO ARRAYS L=0 ;! NESTING LEVEL SC ;! PROCESS COND ;! PROCESS APP=AP ;! PRESERVE ANAL PTR L=-1 STORE(1) ;! PSEUDO-FALSE L=-2 STORE(2) ;! PSEUDO-TRUE K=I-1 ;! LAST POS FILLED IN I=1 2: J=I ;! FIND JUMPS L=LVL(I) 1: J=J+1 %IF LVL(J)>=L %THEN ->1 ;! SKIP HIGHER LEVELS L=LVL(J) %IF TF(J)=TF(I) %THEN ->1 JMP(I)=J ;! JUMP TO COMPARISON I=I+1 %IF I2 ;! MORE JUMPS TO FILL %IF A(AP)=2 %THEN %START ;! UI A JUMP INST AP=AP+1 ;! TO J=K-1 ;! LAST POS FILLED TF(J)=2 ;! SET AS 'TRUE' JMP(J)=J ;! SET JUMP AS UI JMP LBL(J)=FIND LABEL ;! FILL IN BRANCH %FINISH I=1 ;! FILL IN PSEUDO-LAB 3: %IF LBL(JMP(I))<0 %THEN LBL(JMP(I))=BT NEXT ;! NEXT BAT POSITION I=I+1 %IF I3 ;! MORE TO FILL IN I=1 4: AP=CAP(I) ;! ANAL REC PTR 1ST SCF=1 ;! SET FLAG FOR SEXPR SEXPR ;! TO EVAL 1ST-2ND %IF TF(I)=1 %THEN L=FALSE(COMP) %ELSE L=TRUE(COMP) DUMP(L,M'ACC',M'BT',LBL(JMP(I))) ;! BRANCH TO REQ POS %IF I=0%THEN BAT(LBL(I))=CA I=I+1 ;! FILL IN LABEL ADDR ->4 ; %FINISH ;! MORE COMPARISONS %IF LBL(I)>=0 %AND TF(I)=1 %THEN BAT(LBL(I))=CA ;! NOT FOR UI JUMP LABEL=LBL(K) ;! FINAL LABEL AP=APP ;! FINAL ANAL REC PTR %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE STORE(%INTEGER FT) ! STORE LEVEL & TRUE/FALSE FLAG %IF I>16 %THEN %START ;! ARRAYS FULL FAULT(M'COND',M'N TO',M'O LO',M'NG ') I=1 ;! TO CONTINUE %FINISH LVL(I)=L ;! SAVE NESTING LEVEL TF(I)=FT ;! SAVE TRUE/FALSE FLAG LBL(I)=-1 ;! SET 'LAB NOT FILLED' I=I+1 ;! NEXT ARRAY POSITION %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE SC AP=AP+1 %IF A(AP-1)=2 %THEN %START L=L+1 ;! NESTING LEVEL UP 1 SC ;! PROCESS SUB- COND ;! PROCESS SUB- L=L-1 ;! NESTING LEVEL DOWN %FINISH %ELSE %START CAP(I)=AP ;! ANAL REC POINTERP AP=NP(NP(AP+1)) ;! SKIP 1ST EXPR AP=NP(NP(AP+2)) ;! SKIP COMP & 2ND EXPR %FINISH %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE COND ! PROCESS FOR SIMPLE COMPARISONS %INTEGER I I=A(AP) ;! AP=AP+1 ;! AP ON %IF I\=3 %THEN %START ;! NOT NULL ALT OF 1: STORE(I) ;! SAVE %AND OR %OR TYPE SC ;! PROCESS AP=AP+1 %IF A(AP-1)=1 %THEN ->1 ;! MORE %ANDS OR %ORS %FINISH %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE CHECK ! CHECK LABELS ALL SET & STARTS MATCH FINISHES %INTEGER I,J I=JUMP(LEVEL) ;! POINTER TO JUMP LIST 1: %IF I\=0 %THEN %START ;! NO LABELS OR JUMPS %IF BAT(TAG(I)&65535)<0 %THEN %START ;! LABEL SET INCORRECTLY WRITE(TAG(I)>>16,1) ;! PRINT OUT LABEL NO FAULT(M' LAB',M'EL N',M'OT S',M'ET ') %FINISH I=RETURN CELL(I) ;! RETURN JUMP LIST CELL ->1 ; %FINISH I=START(LEVEL) ;! LINK TO START LIST 2: %IF I\=0 %THEN %START ;! A CELL STILL IN LIST FAULT(M'%FIN',M'ISH ',M'MISS',M'ING ') I=RETURN CELL(I) ;! POP UP CELL ->2 ; %FINISH %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE UNSET ! UNSET NAMES AND CHECK FOR MISSING ROUTINES %INTEGER I,J,K I=NAME(LEVEL) ;! NAME LIST POINTER 1: %IF I\=0 %THEN %START ;! UNSET NAMES DECLARED J=TAG(I) ;! NAME IDENT NO K=TAG(TAGL(J)) ;! TAG WORD AT TOP TAGL(J)=RETURN CELL(TAGL(J)) ;! POP UP CELL %IF K>>28=4 %THEN %START ;! ROUTINE/FN TYPE %IF BAT(K&65535)<0 %THEN %START PRINT NAME(J) FAULT(M'ROUT',M'INE ',M'MISS',M'ING ') %FINISH K=K>>20&15 ;! NO OF PARAMS 2: %IF K\=0 %THEN %START ;! PARAMS PRESENT TAGL(J)=RETURN CELL(TAGL(J)) ;! POP UP CELLS K=K-1 ;! PARAM COUNT ->2 ; %FINISH %FINISH %IF TAGL(J)=0 %THEN %START ;! NO PREVIOUS DECLN %IF CHP>CHL(J) %THEN CHP=CHL(J) ;! MOVE CHP BACK CHL(J)=0 ;! CLEAR NAME LINK %FINISH I=RETURN CELL(I) ;! RETURN NAMELIST CELL ->1 ; %FINISH %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE PUSH START(%INTEGER FLAG,LABEL) ! PUSHDOWN START/FINISH BLOCK INFORMATION %INTEGER I I=NEWCELL %IF LABEL<0 %THEN LABEL=65535 TAG(I)=FLAG<<16!LABEL ;! PACK FLAG & LABEL LINK(I)=START(LEVEL) ;! PUSH CELL DOWN START(LEVEL)=I ;! ONTO START LIST %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE ENTER(%INTEGER TYPE,ALLOC) ! DUMP CODE FOR NEW LEVEL & INITIALISE LEVEL ARRAYS %INTEGER I %IF LEVEL=1 %THEN DUMP(M'LDA',M'STP',M'ST',0) %ELSE %C DUMP(M'STR',BR(LEVEL),M'STP',0) ;! ENTRY SEQUENCE DUMP(M'LDA',BR(LEVEL),M'STP',0) DUMP(M'STR',M'WK',M'STP',1) I=CT NEXT ;! STATIC ALLOC HOLE DUMP(M'ADD',M'STP',M'CT',I) STAR(LEVEL)=I ;! REMEMBER POS OF HOLE JUMP(LEVEL)=0 ;! NO JUMPS AT NEW LEVEL NAME(LEVEL)=0 ;! NO NAMES AT NEW LEVEL RTP(LEVEL)=TYPE ;! BLOCK/ROUTINE/FN TYPE START(LEVEL)=0 ;! NO START/FINISH BLOCK RAD(LEVEL)=ALLOC ;! NEXT RELATIVE ADDRESS %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE RETURN ! DUMP CODE FOR %RETURN DUMP(M'LDA',M'STP',BR(LEVEL),0) ;! RESTORE DISPLAY DUMP(M'LOAD',BR(LEVEL),M'STP',0) DUMP(M'LOAD',M'WK',M'STP',1) DUMP('B',0,M'WK',0) ;! BRANCH TO RETRN ADDR %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE RT ! DUMP CODE FOR A ROUTINE OR FUNCTION CALL %INTEGER I,J,K,L,M,N,P,PP %IF PARS>10 %THEN DUMP(M'LDA',M'STP',M'STP',PARS) PP=PARS PARS=10 I=TAGL(A(AP)) ;! LINK TO TAG AP=AP+1 ;! AP ON J=TAG(I) ;! TAG OF NAME K=J>>20&15+1 ;! PARAMS+1 1: K=K-1 ;! COUNT PARAMS AP=AP+1 ;! AP ON +1 %IF A(AP-1)=2 %THEN %START ;! PARAMS ABSENT DUMP(M'BAL',M'WK',M'BT',J&65535) ;! DUMP BRANCH %IF K>0 %THEN FAULT(M'TOO ',M'FEW ',M'PARA',M'MS ') PARS=PP %IF PARS>10 %THEN %START I=CT NEXT COT(I)=PARS DUMP(M'SUB',M'STP',M'CT',I) %FINISH %RETURN ; %FINISH %IF K<=0 %THEN %START ;! TOO MANY PARAMS %IF K=0 %THEN FAULT(M'TOO ',M'MANY',M' PAR',M'AMS ') ->2 ; %FINISH I=LINK(I) ;! LINK TO NEXT CELL L=TAG(I) ;! TAG OF PARAMETER %IF L>>28=0 %THEN %START ;! SCALAR VALUE SEXPR ;! COMPILE EXPR ->3 ; %FINISH %IF A(AP)=4 %AND A(AP+1)=1 %THEN ->4 ;! <+-\> IS NULL 5: FAULT(M'NOT ',M'A NA',M'ME P',M'ARAM') 2: AP=NP(NP(AP+1)) ;! SKIP INVALID EXPR ->1 4: M=TAGL(A(AP+2)) ;! LINK TO TAG %IF M=0 %THEN %START PRINT NAME(A(AP+2)) FAULT(M'NAME',M' NOT',M' SET',M' ') ->2 ; %FINISH N=TAG(M) ;! TAG OF ACTUAL PARAM %IF L>>28=1 %THEN %START ;! PARAM SCALAR %IF N>>28=4 %THEN %START ;! ACTUAL IS RT PRINT NAME(A(AP+2)) ->5 ; %FINISH %IF N>>28>=2 %THEN %START ;! ACTUAL IS ARRAY AP=AP+2 ;! AP ON ARRAD ;! GET ELEMENT ADDR AP=AP+1 ;! AP +1 %IF A(AP-1)=1 %THEN ->5 ;! FURTHER OPERANDS ->3 ; %FINISH %IF A(AP+3)=1 %THEN %START ;! NOT NULL PRINT NAME(A(AP+2)) FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM') ->2 ; %FINISH %IF A(AP+4)=1 %THEN ->5 ;! FURTHER OPERAND %IF N>>28=1 %THEN P=M'LOAD' %ELSE P=M'LDA';! LOAD FOR NAME DUMP(P,M'ACC',BR(N>>16&15),N&65535) %FINISH %ELSE %START ;! PARAM IS ARRAY %IF A(AP+3)\=2 %OR A(AP+4)\=2 %THEN ->5 ;! NOT NULL %IF N>>28&2=0 %THEN %START PRINT NAME(A(AP+2)) FAULT(M'NOT ',M'AN A',M'RRAY',M' NME') ->2 ; %FINISH DUMP(M'LOAD',M'ACC',BR(N>>16&15),N&65535) %FINISH AP=AP+5 ;! AP ON 3: DUMP(M'STR',M'ACC',M'STP',L&65535) PARS=PARS+1 ->1 %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE ARRAD ! DUMP CODE TO CALCULATE ARRAY ELEMENT ADDRESS %INTEGER I,J,K,L L=A(AP) I=TAGL(L) ;! LINK TO TAG J=TAG(I) AP=AP+2 ;! AP ON +1 %IF A(AP-1)=1 %THEN %START ;! INDEXES PRESENT SEXPR ;! COMPILE EXPR %IF A(AP)=1 %THEN %START ;! 2ND INDEX PRESENT PRINT NAME(L) FAULT(M'TOO ',M'MANY',M' IND',M'EXES') AP=NP(AP) ;! SKIP EXCESS INDEXES %FINISH %ELSE AP=AP+1 ;! AP AFTER EXPR DUMP(M'ADD',M'ACC',BR(J>>16&15),J&65535) %FINISH %ELSE %START PRINT NAME(L) FAULT(M'NO A',M'RRAY',M' IND',M'EXES') %FINISH %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN BT NEXT ! ALLOCATE NEXT POSITION IN BRANCH TABLE %IF BTN>1023 %THEN %START ;! FULL FAULT(M'TOO ',M'MANY',M'LABE',M'LS ') BTN=0 ;! TRY TO CONTINUE %FINISH BAT(BTN)=-1 ;! MARKER BTN=BTN+1 ;! NEXT POSITION %RESULT=BTN-1 ;! THIS POSITION %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN CT NEXT ! ALLOCATE NEXT POSITION IN CONSTANT TABLE %IF CTN>1023 %THEN %START ;! FULL FAULT(M'TOO ',M'MANY',M' CON',M'STS ') CTN=0 ;! TRY TO CONTINUE %FINISH COT(CTN)=-1 CTN=CTN+1 ;! NEXT POSITION %RESULT=CTN-1 ;! THIS POSITION %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN WS NEXT ! ALLOCATE NEXT WORK SPACE POSITION WS=WS+1 %IF WS=11 %THEN FAULT(M'COMP',M'ILER',M' WKS',M'PACE') %RESULT=WS-1 %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN FIND LABEL ! CHECK & LOCATE OR INSERT LABEL IN JUMP LIST FOR THIS LEVEL %INTEGER I,J LABEL=A(AP) ;! VALUE OF CONST AP=AP+1 ;! AFTER %IF LABEL>>16\=0 %THEN %START ;! INVALID LABEL NUMBER WRITE(LABEL,1) SPACES(2) FAULT(M'INVA',M'LID ',M'LABE',M'L ') %RESULT=-1 ;! 'FAULTY' RESULT %FINISH I=JUMP(LEVEL) ;! JUMP LIST POINTER 1: %IF I\=0 %THEN %START ;! SOMETHING IN LIST %IF LABEL=TAG(I)>>16 %THEN %RESULT=TAG(I)&65535 ;! LABEL ALREADY I=LINK(I) ;! NEXT CELL IN LIST ->1 ; %FINISH I=NEWCELL ;! LABEL NOT IN LIST J=BT NEXT ;! GET NEXT BRANCH TABLE TAG(I)=LABEL<<16!J ;! FILL IN LIST ENTRY LINK(I)=JUMP(LEVEL) ;! PUSHDOWN JUMP(LEVEL)=I ;! NEW JUMP LIST POINTER %RESULT=J ;! NEW BRANCH TABLE POS %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE STORE TAG(%INTEGER NAM,FORM,TYPE,DIM,LEV,AD) ! STORE TAGS - SET NAME & CHECK NOT SET ALREADY %INTEGER M,N M=TAGL(NAM) ;! PTR TO EXISTING TAG %IF M\=0 %AND LEV=TAG(M)>>16&15 %AND FORM\=4 %THEN %START PRINT NAME(NAM) FAULT(M'NAME',M' SET',M' TWI',M'CE ') %RETURN ; %FINISH N=NEWCELL ;! NEW CELL FOR TAGS TAG(N)=FORM<<28!TYPE<<24!DIM<<20!LEV<<16!AD ;! FILL IN TAGS LINK(N)=TAGL(NAM) ;! PUSHDOWN ON TAGS LIST TAGL(NAM)=N N=NEWCELL TAG(N)=NAM ;! PUSHDOWN ON NAME LIST LINK(N)=NAME(LEVEL) NAME(LEVEL)=N %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE DUMP(%INTEGER OP,REG,BASE,DISP) ! PRINT OUT CURRENT ADDRESS, OPERATION MNEMONIC & OPERANDS %ROUTINESPEC PMN(%INTEGER I) WRITE(CA,5) ;! CURRENT ADDRESS PRINT SYMBOL('.') SPACES(10) PMN(OP) ;! OPERATOR MNEMONIC PMN(REG) ;! REGISTER MNEMONIC %IF BASE=M'PR' %AND DISP>=65536 %THEN PRINT NAME(DISP-65536) %C %ELSE %START PMN(BASE) ;! BASE MNEMONIC WRITE(DISP,1) ;! DISPLACEMENT %FINISH NEWLINE CA=CA+1 ;! INCREMENT CURRENT ADDR ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE PMN(%INTEGER I) ! PRINT MNEMONIC - CHARS INTO ONE WORD %INTEGER J,K,L J=2 ;! AT LEAST TWO SPACES K=24 ;! FIRST SHIFT VALUE 1: L=I>>K&255 ;! UNPACK NEXT CHARACTER %IF L=0 %THEN J=J+1 %ELSE PRINT SYMBOL(L) K=K-8 ;! NEXT SHIFT VALUE %IF K>=0 %THEN ->1 ;! MORE CHARS POSSIBLY YET %IF I=M'BT' %OR I=M'CT' %OR I=M'PR' %OR I=M'ST' %THEN %C PRINT SYMBOL('+') %ELSE %START PRINT SYMBOL(',') SPACES(J) ;! TO ALLIGN FIELDS %FINISH %END %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE FAULT(%INTEGER A,B,C,D) ! MONITOR FAULT - A 'PRINT STRING' ROUTINE OUT(A) OUT(B) OUT(C) OUT(D) NEWLINE FAULTS=FAULTS+1 ;! INCREMENT FAULT COUNT %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE OUT(%INTEGER I) ! PRINT OUT PACKED CHARS PRINT SYMBOL(I>>24) PRINT SYMBOL(I>>16&255) PRINT SYMBOL(I>>8&255) PRINT SYMBOL(I&255) %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN CH NEXT ! ALLOCATE NEXT POSITION IN 'CH' ARRAY %IF CHP>512 %THEN %START ;! CHARACTER ARRAY FULL FAULT(M'NAME',M'S TO',M'O LO',M'NG ') %STOP ; %FINISH CHP=CHP+1 %RESULT=CHP-1 %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN NEWCELL ! ALLOCATE NEW CELL FOR LIST PROCESSING %INTEGER I %IF ASL=0 %THEN %START ;! END OF AVAILABLE SPACE LIST FAULT(M'ASL ',M'EMPT',M'Y ',M' ') %STOP ; %FINISH I=ASL ;! POINTER TO TOP CELL OF ASL ASL=LINK(ASL) ;! ASL POINTER TO NEXT CELL DOW TAG(I)=0 ;! CLEAR NEW CELL OUT LINK(I)=0 %RESULT=I ;! INDEX TO NEW CELL %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN RETURN CELL(%INTEGER I) ! DEALLOCATE CELL AND RETURN IT TO ASL %INTEGER J J=LINK(I) ;! PRESENT LINK VALUE OF CELL LINK(I)=ASL ;! LINK TO TOP OF ASL ASL=I ;! ASL POINTER TO RETURNED CELL %RESULT=J ;! RETURN VALUE OF LINK %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE PRINT NAME(%INTEGER I) ! PRINT NAME FROM HASH POSITION %INTEGER J,K,L,M J=CHL(I) ;! POINTER TO CH ARRAY K=CH(J) ;! LENGTH & FIRST 3 CHARS L=K>>24 ;! NUMBER OF CHARS IN NAME M=16 ;! FIRST SHIFT VALUE 1: PRINT SYMBOL(K>>M&255) L=L-1 %IF L=0 %THEN %START SPACES(2) %RETURN ; %FINISH M=M-8 ;! NEXT SHIFT VALUE %IF M<0 %THEN %START J=J+1 K=CH(J) ;! NEXT WORD OF CHARS M=24 %FINISH ->1 %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE PRINT LABEL(%INTEGER I) ! PRINT PACKED LABEL NAME PRINT SYMBOL('.') OUT(I) PRINT SYMBOL(':') NEWLINE %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE SHOW TAGS ! DISPLAY TAGS OF NAMES IN SCOPE %INTEGER I,J,K,L,M I=0 ;! EXAMINE TAGS FROM 0 UP 1: %IF CHL(I)=0 %THEN ->2 ;! NO NAME WITH IDENTIFICATION NEWLINE WRITE(I,10) ;! IDENT NO SPACES(4) PRINT NAME(I) NEWLINE J=TAGL(I) ;! POINTER TO NAME TAGS %IF J=0 %THEN ->2 ;! IN CASE NO TAG SET UP SPACES(11) 7: SPACES(4) K=TAG(J) ;! FIRST TAGS WORD L=28 ;! FIRST SHIFT VALUE 6: M=K>>L&15 ;! NEXT HEX DIGIT %IF M<10 %THEN PRINT SYMBOL(M+'0') %ELSE PRINT SYMBOL(M+'A'-10) L=L-4 ;! NEXT SHIFT %IF L>=0 %THEN ->6 ;! MORE DIGITS IN THIS WORD J=LINK(J) ;! POINTER TO NEXT CELL %IF J\=0 %THEN ->7 ;! MORE CELLS 2: I=I+1 %IF I<=255 %THEN ->1 ;! MORE NAMES TO CONSIDER NEWLINES(2) %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ENDOFPROGRAM