%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+1%C %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''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 ;! 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 ;! %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 ;! OR %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