EXTERNALINTEGERARRAY A(1:255) ! INITIALISATION FOR I/O ROUTINES EXTERNALBYTEINTEGERARRAY NAMED(1:1024)=10,'R','E','A','D','S','Y','M', 'B','O','L',10,'N','E','X','T','S','Y','M','B','O','L',10,'S','K', 'I','P','S','Y','M','B','O','L',11,'P','R','I','N','T','S','Y','M', 'B','O','L',5,'S','P','A','C','E',6,'S','P','A','C','E','S',7,'N', 'E','W','L','I','N','E',8,'N','E','W','L','I','N','E','S',7,'N','E', 'W','P','A','G','E',4,'R','E','A','D',5,'W','R','I','T','E',0(930) EXTERNALINTEGERARRAY NAMEDLINK(0:255)=0,76,0(12),89,0(54),84,0(118), 52,0(11),1,12,23,34,0(4),67,0(23),46,0(5),59,0(17) EXTERNALINTEGERARRAY TAGLINK(0:255)=0,13,0(12),16,0(54),14,0(118),8, 0(11),1,3,4,5,0(4),11,0(23),7,0(5),10,0(17) EXTERNALINTEGERARRAY TAG(1:512)=X'40100001',X'01010002',X'41000002', X'40000003',X'40100004',X'01010002',X'40000005',X'40100006', X'01010002',X'40000007',X'40100008',X'01010002',X'40000009', X'4010000A',X'11010002',X'4020000B',X'01010002',X'01010003',0(494) EXTERNALINTEGERARRAY LINK(1:512)=2,0,0,0,6,0,0,9,0,0,12,0,0, 15,0,17,18,0,0(494) EXTERNALINTEGER NAMEDP=95 EXTERNALINTEGER TAGASL=19 EXTERNALINTEGER EXPROPT=0 EXTERNALINTEGER CONDOPT=0 EXTERNALINTEGER TAGSOPT=0 !----------------------------------------------------------------------- EXTERNALROUTINESPEC DEFINE(STRING(63) S) EXTERNALROUTINESPEC STATEMENT(INTEGER STATEMENTP) EXTERNALSTRING(255)FNSPEC STRINT(INTEGER N,P) EXTERNALROUTINESPEC FAULT(STRING(63) MESS) EXTERNALROUTINESPEC DUMP(STRING(7) OPN,REG,BASE,INTEGER DISP) EXTERNALSTRING(255)FNSPEC NAME(INTEGER IDENT) !----------------------------------------------------------------------- EXTERNALROUTINE SKIMP(STRING(63) S) ROUTINESPEC READPS ROUTINESPEC READ STATEMENT ROUTINESPEC RPSYM(INTEGERNAME L) INTEGERFNSPEC FINDK(STRINGNAME K) INTEGERFNSPEC COMPARE(INTEGER P) RECORDFORMAT KDF(BYTEINTEGER L,N,A,B) RECORDARRAY KD(1:255)(KDF) STRING(15)ARRAY PN(256:319) INTEGERARRAY PP(256:319) INTEGERARRAY PS(1:512) INTEGERARRAY T,TT(1:256) INTEGER TP,AP,TTP,TTPP,I,PSFLAG STRING(63) SOURCE,OBJECT,OPTIONS,OPTION OWNINTEGER LEXOPT=0 OWNINTEGER ANALOPT=0 UNLESS S->SOURCE.(",").OBJECT THEN FAULT("PARAMETERS ?") AND STOP IF OBJECT->OBJECT.(",").OPTIONS THEN START UNTIL OPTIONS="" CYCLE UNLESS OPTIONS->OPTION.(",").OPTIONS THEN OPTION=OPTIONS C AND OPTIONS="" IF OPTION->("NO").OPTION THEN I=0 ELSE I=1 IF OPTION="LEX" THEN LEXOPT=I IF OPTION="ANAL" THEN ANALOPT=I IF OPTION="EXPR" THEN EXPROPT=I IF OPTION="COND" THEN CONDOPT=I IF OPTION="TAGS" THEN TAGSOPT=I REPEAT FINISH READPS DEFINE("STREAM02,".OBJECT) SELECT OUTPUT(2) SET MARGINS(2,1,72) PRINT STRING(" SKIMP COMPILER MKII SOURCE: ".SOURCE." OBJECT: ".OBJECT." OPTIONS: ") IF LEXOPT=1 THEN PRINT STRING("LEX ") IF ANALOPT=1 THEN PRINT STRING("ANAL ") IF EXPROPT=1 THEN PRINT STRING("EXPR ") IF CONDOPT=1 THEN PRINT STRING("COND ") IF TAGSOPT=1 THEN PRINT STRING("TAGS ") NEWLINE IF PSFLAG#0 THEN FAULT("PHRASE STRUCTURE FAULTY") AND STOP DEFINE("STREAM01,".SOURCE) SELECT INPUT(1) ! SET UP TAGS AVAILABLE SPACE LIST CYCLE I=TAGASL,1,511 LINK(I)=I+1 REPEAT CYCLE ; ! FOR EACH STATEMENT READ STATEMENT TTP=TP-1 TP=1 AP=1 IF COMPARE(258)=0 OR TP#TTP THEN FAULT("SYNTAX ?") ELSE START IF ANALOPT=1 THEN START NEWLINE CYCLE I=1,1,AP-1 ; ! PRINT ANALYSIS RECORD IF A(I)<0 THEN PRINT STRING(" (".STRINT(I,1)."/". C PN(A(I)<<1>>17).")") AND A(I)=A(I)&X'FFFF' PRINT STRING(" ".STRINT(A(I),1)) REPEAT NEWLINES(2) FINISH ELSE START CYCLE I=1,1,AP-1 ; ! REMOVE PHRASE NUMBERS IF A(I)<0 THEN A(I)=A(I)&X'FFFF' REPEAT FINISH STATEMENT(1) ;! GENERATE CODE FOR STATEMENT FINISH REPEAT !----------------------------------------------------------------------- ROUTINE READPS ! READ PHRASE STRUCTURE FROM FILE 'SKIMPPS' AND REDUCE IT STRING(31)ARRAY KA(1:128) INTEGERARRAY KNA(1:128) STRING(31) K INTEGER KAP,KDASL,KN,I,L,PSP,PNP,ALT INTEGERNAME NP ROUTINESPEC INSERT(STRING(15) K) ROUTINESPEC EXTRACT(INTEGER I,STRING(15) K) ROUTINESPEC ASSIGN(INTEGER I) INTEGERFNSPEC NEWKD ROUTINESPEC RETURNKD(INTEGER I) ROUTINESPEC RETURNLIST(INTEGER I) INTEGERFNSPEC PHRASE ROUTINESPEC LITERAL ROUTINESPEC KEYWORD DEFINE("STREAM03,SKIMPPS") SELECT INPUT(3) DEFINE("STREAM04,SKIMPPSL") SELECT OUTPUT(4) PRINT STRING(" PHRASE STRUCTURE ") ! SCAN FILE TO BUILD KEYWORD DICTIONARY KAP=1 CYCLE RPSYM(L) IF L='$' THEN EXIT IF L='"' THEN START K="" CYCLE RPSYM(L) IF L='"' THEN EXIT IF 'A'<=L<='Z' THEN K=K.TOSTRING(L) REPEAT KA(KAP)=K KAP=KAP+1 FINISH REPEAT CYCLE I=1,1,26 KD(I)=0 REPEAT CYCLE I=27,1,254 KD(I)_B=I+1 REPEAT KDASL=27 I=1 UNTIL I=KAP THEN INSERT(KA(I)) AND I=I+1 KN=128 CYCLE I=1,1,26 IF KD(I)_L#0 THEN ASSIGN(I) REPEAT KAP=1 CYCLE I=1,1,26 IF KD(I)_L#0 THEN EXTRACT(I,"") REPEAT PRINT STRING(" KEYWORDS ") CYCLE I=1,1,KAP-1 PRINT STRING(STRINT(KNA(I),3)." ".KA(I)." ") REPEAT ! REREAD FILE AND REDUCE PHRASE STRUCTURE SELECT INPUT(0) CLOSE STREAM(3) SELECT INPUT(3) PN(256)="NAME" PP(256)=0 PN(257)="CONST" PP(257)=0 PNP=258 PSP=1 CYCLE ; ! FOR EACH PHRASE DEFINITION READ SYMBOL(L) IF L='$' THEN EXIT IF L='<' THEN START ; ! START OF PHRASE DEFINITION PP(PHRASE)=PSP CYCLE ; ! FOR EACH ALTERNATIVE ALT=PSP NP==PS(PSP+1) NP=0 ;! NUMBER OF PHRASES PSP=PSP+2 CYCLE ; ! FOR EACH ITEM READ SYMBOL(L) IF L='<' THEN PS(PSP)=PHRASE AND PSP=PSP+1 AND NP=NP+1 IF L='''' THEN LITERAL IF L='"' THEN KEYWORD IF L=',' OR L=';' THEN EXIT REPEAT PS(ALT)=PSP IF L=';' THEN EXIT REPEAT PS(PSP)=0 PSP=PSP+1 FINISH REPEAT PSFLAG=0 CYCLE I=258,1,PNP-1 IF PP(I)=0 THEN FAULT("<".PN(I)."> NOT DEFINED") AND PSFLAG=1 REPEAT PRINT STRING(" PHRASES ") CYCLE I=256,1,PNP-1 PRINT STRING(STRINT(I,3).STRINT(PP(I),6)." ".PN(I)." ") REPEAT PRINT STRING(" REDUCED PHRASE STRUCTURE ") CYCLE I=1,1,PSP-1 IF (I-1)&15=0 THEN PRINT STRING(" ".STRINT(I,3)." ") WRITE(PS(I),3) REPEAT NEWLINES(2) RETURN !----------------------------------------------------------------------- ROUTINE INSERT(STRING(15) K) ! SEARCH FOR AND INSERT KEYWORD INTO DICTIONARY INTEGER I,J,L L=CHARNO(K,1) K->(TOSTRING(L)).K I=L-'A'+1 IF KD(I)_L#0 THEN START SEARCH:IF K="" THEN START IF KD(I)_A#0 THEN EXTRACT(KD(I)_A,"") AND C RETURNLIST(KD(I)_A) AND KD(I)_A=0 RETURN FINISH IF KD(I)_A=0 THEN INSERT(K) AND RETURN L=CHARNO(K,1) K->(TOSTRING(L)).K I=KD(I)_A CYCLE IF KD(I)_L=L THEN ->SEARCH IF KD(I)_B=0 THEN EXIT I=KD(I)_B REPEAT J=I I=NEWKD KD(J)_B=I FINISH ! INSERT REMAINDER OF LETTERS CYCLE KD(I)_L=L IF K="" THEN RETURN L=CHARNO(K,1) K->(TOSTRING(L)).K J=I I=NEWKD KD(J)_A=I REPEAT END !----------------------------------------------------------------------- ROUTINE EXTRACT(INTEGER I,STRING(15) K) STRING(15) KK IF I=0 THEN RETURN KK=K.TOSTRING(KD(I)_L) IF KD(I)_A=0 THEN KA(KAP)=KK AND KNA(KAP)=KD(I)_N AND KAP=KAP+1C ELSE EXTRACT(KD(I)_A,KK) EXTRACT(KD(I)_B,K) END !----------------------------------------------------------------------- ROUTINE ASSIGN(INTEGER I) IF I=0 THEN RETURN IF KD(I)_A=0 THEN KD(I)_N=KN AND KN=KN+1 ELSE ASSIGN(KD(I)_A) ASSIGN(KD(I)_B) END !----------------------------------------------------------------------- INTEGERFN NEWKD INTEGER I IF KDASL=0 THEN PRINT STRING("KD ASL EMPTY") AND STOP I=KDASL KDASL=KD(I)_B KD(I)=0 RESULT=I END !----------------------------------------------------------------------- ROUTINE RETURNKD(INTEGER I) KD(I)_B=KDASL KDASL=I END !----------------------------------------------------------------------- ROUTINE RETURNLIST(INTEGER I) IF I=0 THEN RETURN RETURNLIST(KD(I)_A) RETURNLIST(KD(I)_B) RETURNKD(I) END !----------------------------------------------------------------------- INTEGERFN PHRASE STRING(15) P INTEGER I,L P="" CYCLE READ SYMBOL(L) IF L='>' THEN EXIT ELSE P=P.TOSTRING(L) REPEAT CYCLE I=256,1,PNP-1 IF PN(I)=P THEN RESULT=I REPEAT PN(PNP)=P PP(PNP)=0 PNP=PNP+1 RESULT=PNP-1 END !----------------------------------------------------------------------- ROUTINE LITERAL INTEGER L CYCLE READ SYMBOL(L) IF L='''' THEN RETURN ELSE PS(PSP)=L AND PSP=PSP+1 REPEAT END !----------------------------------------------------------------------- ROUTINE KEYWORD STRING(31) K INTEGER L K="" CYCLE READ SYMBOL(L) IF L='"' THEN EXIT IF 'A'<=L<='Z' THEN K=K.TOSTRING(L) REPEAT PS(PSP)=FINDK(K) AND PSP=PSP+1 UNTIL K="" END END !----------------------------------------------------------------------- ROUTINE READ STATEMENT ROUTINESPEC STORE(INTEGER L) ROUTINESPEC KEYWORD ROUTINESPEC NAME ROUTINESPEC CONST INTEGER I,L,KSH ! LINE RECONSTRUCT PHASE NEWLINES(3) TTP=1 KSH=0 CYCLE ; ! FOR EACH CHARACTER RPSYM(L) IF L='%' THEN KSH=128 ELSE START UNLESS 'A'<=L<='Z' THEN KSH=0 IF L#' ' THEN START ; ! DISCARD SPACES IF L='!' AND TTP=1 THEN START RPSYM(L) UNTIL L=';' OR L=NL ; ! DISCARD COMMENTS FINISH ELSE START STORE(L) IF L='''' THEN START UNTIL L='''' CYCLE RPSYM(L) STORE(L) REPEAT FINISH ELSE START IF L=';' OR L=NL THEN START IF TTP=2 THEN TTP=1 ELSE START IF L=';' THEN NEWLINE AND EXIT IF TT(TTP-2)='C'+128 THEN TTP=TTP-2 ELSE EXIT FINISH FINISH FINISH FINISH FINISH FINISH REPEAT ! LEXICAL PHASE TP=1 TTPP=1 UNTIL TTPP=TTP CYCLE ; ! FOR EACH LEXICAL ITEM I=TT(TTPP) IF I>=128 THEN KEYWORD ELSE START IF 'A'<=I<='Z' THEN NAME ELSE START IF '0'<=I<='9' OR I='''' THEN CONST ELSE C T(TP)=I AND TP=TP+1 AND TTPP=TTPP+1 FINISH FINISH REPEAT IF LEXOPT=1 THEN START NEWLINE CYCLE TTPP=1,1,TP-2 PRINT STRING(" ".STRINT(T(TTPP),1)) REPEAT NEWLINE FINISH RETURN !----------------------------------------------------------------------- ROUTINE STORE(INTEGER L) IF TTP>256 THEN FAULT("STATEMENT TOO LONG") AND STOP TT(TTP)=L+KSH TTP=TTP+1 END !----------------------------------------------------------------------- ROUTINE KEYWORD STRING(255) K INTEGER I K="" WHILE TT(TTPP)>128 THEN K=K.TOSTRING(TT(TTPP)-128) AND TTPP=TTPP+1 UNTIL K="" OR I=0 THEN I=FINDK(K) AND T(TP)=I AND TP=TP+1 END !----------------------------------------------------------------------- ROUTINE NAME STRINGNAME SNAME INTEGER I,L,HASH SNAME==STRING(ADDR(NAMED(NAMEDP))) HASH=0 SNAME="" L=TT(TTPP) UNTIL L<'0' OR '9'<L<'A' OR L>'Z' THEN CYCLE IF NAMEDP+LENGTH(SNAME)>=1022 THEN FAULT("NAME DICTIONARY FULL")C AND STOP IF LENGTH(SNAME)=255 THEN FAULT("NAME TOO LONG") AND STOP SNAME=SNAME.TOSTRING(L) HASH=HASH<<8!L TTPP=TTPP+1 L=TT(TTPP) REPEAT HASH=HASH-HASH//251*251 I=HASH CYCLE ; ! SCAN DICTIONARY IF NAMEDLINK(I)=0 THEN NAMEDLINK(I)=NAMEDP AND C NAMEDP=NAMEDP+LENGTH(SNAME)+1 AND EXIT ; ! INSERT NAME IF SNAME=STRING(ADDR(NAMED(NAMEDLINK(I)))) THEN EXIT I=(I+1)&255 IF I=HASH THEN FAULT("NAME DICTIONARY FULL") AND STOP REPEAT T(TP)=256 ;! <NAME> T(TP+1)=I ;! IDENT TP=TP+2 END !----------------------------------------------------------------------- ROUTINE CONST INTEGER L,VALUE,FLAG,COUNT,MAXBY10,MAXLD VALUE=0 FLAG=0 IF TT(TTPP)='''' THEN START COUNT=0 CYCLE TTPP=TTPP+1 IF TT(TTPP)='''' THEN START TTPP=TTPP+1 IF TT(TTPP)#'''' THEN EXIT FINISH VALUE=VALUE<<8!TT(TTPP) COUNT=COUNT+1 REPEAT UNLESS 1<=COUNT<=4 THEN FLAG=1 FINISH ELSE START MAXBY10=X'7FFFFFFF'//10 MAXLD=X'7FFFFFFF'-MAXBY10*10 L=TT(TTPP) UNTIL L<'0' OR L>'9' CYCLE IF VALUE>MAXBY10 OR (VALUE=MAXBY10 AND L>MAXLD) THEN FLAG=1 C ELSE VALUE=VALUE*10+L-'0' TTPP=TTPP+1 L=TT(TTPP) REPEAT FINISH T(TP)=257 ;! <CONST> IF FLAG#0 THEN FAULT("CONSTANT INVALID") AND VALUE=0 T(TP+1)=VALUE TP=TP+2 END END !----------------------------------------------------------------------- ROUTINE RPSYM(INTEGERNAME L) READ SYMBOL(L) PRINT SYMBOL(L) END !----------------------------------------------------------------------- INTEGERFN FINDK(STRINGNAME K) ! LOOK KEYWORD UP IN DICTIONARY INTEGER I,L L=CHARNO(K,1) K->(TOSTRING(L)).K I=L-'A'+1 IF KD(I)_L=0 THEN RESULT=0 SEARCH:IF K="" OR KD(I)_A=0 THEN RESULT=KD(I)_N L=CHARNO(K,1) K->(TOSTRING(L)).K I=KD(I)_A CYCLE IF KD(I)_L=L THEN ->SEARCH IF KD(I)_B=0 THEN RESULT=0 I=KD(I)_B REPEAT END !----------------------------------------------------------------------- INTEGERFN COMPARE(INTEGER P) INTEGER APP,TPP,ALT,ALTEND,PSP,PSI A(AP)=P<<16!X'80000001' ;! PHRASE NUMBER & ALTERNATIVE 1 IF P<=257 THEN START ; ! <NAME> OR <CONST> IF P=T(TP) THEN START ; ! SUCCESS A(AP+1)=T(TP+1) AP=AP+2 TP=TP+2 RESULT=1 FINISH ELSE RESULT=0 FINISH TPP=TP ;! PRESERVE TEXT POINTER APP=AP ;! PRESERVE ANALYSIS RECORD POINTER PSP=PP(P) ;! START OF PHRASE DEFINITION CYCLE ; ! FOR EACH ALTERNATIVE ALT=AP+1 ALTEND=PS(PSP) AP=ALT+PS(PSP+1) ;! LEAVE GAP FOR FORWARD POINTERS IF AP>255 THEN FAULT("ANALYSIS RECORD TOO LONG") AND STOP PSP=PSP+2 CYCLE ; ! FOR EACH ITEM IF PSP=ALTEND THEN RESULT=1 ; ! SUCCESS PSI=PS(PSP) IF PSI>=256 THEN START ; ! PHRASE A(ALT)=AP ;! FORWARD POINTER IF COMPARE(PSI)=0 THEN EXIT ALT=ALT+1 FINISH ELSE START ; ! LITERAL OR KEYWORD IF PSI#T(TP) THEN EXIT TP=TP+1 FINISH PSP=PSP+1 REPEAT IF PS(ALTEND)=0 THEN RESULT=0 ; ! FAILURE PSP=ALTEND TP=TPP ;! BACKTRACK TEXT POINTER AP=APP ;! BACKTRACK ANALYSIS RECORD POINTER A(AP)=A(AP)+1 ;! NEXT ALTERNATIVE NUMBER REPEAT END END ENDOFFILE