#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 !%ROUTINESPEC READ SYMBOL(%INTEGERNAME I)
// 2 !%INTEGERFNSPEC NEXT SYMBOL
// 3 !%ROUTINESPEC SKIP SYMBOL
// 4 !%ROUTINESPEC PRINT SYMBOL(%INTEGER I)
// 5 !%ROUTINESPEC READ(%INTEGERNAME I)
// 6 !%ROUTINESPEC WRITE(%INTEGER I,J)
// 7 !%ROUTINESPEC SPACE
// 8 !%ROUTINESPEC SPACES(%INTEGER I)
// 9 !%ROUTINESPEC NEWLINE
// 10 !%ROUTINESPEC NEWLINES(%INTEGER I)
// 11 !%ROUTINESPEC NEWPAGE
// 12
// 13 %BEGIN
int main(int argc, char **argv) { /*%begin*/
_imp_initialise(argc, argv);
auto void READPS(void);
auto void READLINE(void);
auto int COMPARE(void);
auto void SS(void);
auto void FAULT(int A, int B, int C, int D);
auto int CHNEXT(void);
auto int NEWCELL(void);
auto int RETURNCELL(int I);
auto void PRINTNAME(int I);
// 14 %ROUTINESPEC READ PS
// 15 %ROUTINESPEC READ LINE
// 16 %INTEGERFNSPEC COMPARE
// 17 %ROUTINESPEC SS
// 18 %ROUTINESPEC FAULT(%INTEGER A,B,C,D)
// 19 %INTEGERFNSPEC CHNEXT
// 20 %INTEGERFNSPEC NEWCELL
// 21 %INTEGERFNSPEC RETURN CELL(%INTEGER I)
// 22 %ROUTINESPEC PRINT NAME(%INTEGER I)
// 23 %INTEGER AP,APP,TP,PSP,ASL,BTN,CTN,CHP,FAULTS,LEVEL,CA,COMP,SCF
int AP;
int APP;
int TP;
int PSP;
int ASL;
int BTN;
int CTN;
int CHP;
int FAULTS;
int LEVEL;
int CA;
int COMP;
int SCF;
// 24 %INTEGERARRAY PS(-1000:-600) ;! REDUCED PHRASE STRUCTURE
int PS[401];
// 25 %INTEGERARRAY TAG,LINK(0:1023) ;! TAGS LISTS
int TAG[1024];
int LINK[1024];
// 26 %INTEGERARRAY A(1:200) ;! ANALYSIS RECORD
int A[200];
// 27 %INTEGERARRAY T(1:300) ;! SOURCE TEXT
int T[300];
// 28 %INTEGERARRAY BAT,COT(0:1023) ;! BRANCH, CONST TABLES
int BAT[1024];
int COT[1024];
// 29 %INTEGERARRAY CH(1:512) ;! NAME CHAR TABLE
int CH[512];
// 30 %INTEGERARRAY JUMP,STAR,BRT,NAME,RTP,BR,CHPP,START,RAD(0:15) ;! LEVEL INFORMATION
int JUMP[16];
int STAR[16];
int BRT[16];
int NAME[16];
int RTP[16];
int BR[16];
int CHPP[16];
int START[16];
int RAD[16];
// 31 %INTEGERARRAY TRUE,FALSE(1:6) ;! CONDITIONAL BRANCH INSTRUCTIONS
int TRUE[6];
int FALSE[6];
// 32 %INTEGERARRAY PREC,UCN(1:12) ;! OPERATOR PRECEDENCES, TYPES
int PREC[12];
int UCN[12];
// 33 %INTEGERARRAY OPR(0:12) ;! MACHINE OPERATIONS
int OPR[13];
// 34 %INTEGERARRAY PT,PN,PTC(1:15) ;! FOR RT SPECS, HEADINGS
int PT[15];
int PN[15];
int PTC[15];
// 35 READ PS ;! READ IN AND REDUCE PHRASE STRUCTURE
READPS();
// 36 ASL=0 ;! CLEAR HASHING AREA &
ASL = 0;
// 37 L10: TAG(ASL)=0 ;! CREATE AVAILABLE SPACE LIST
U_1000:;
TAG[ASL] = 0;
// 38 LINK(ASL)=0 ;! IN REMAINDER
LINK[ASL] = 0;
// 39 %IF ASL>=256 %AND ASL<1023 %THEN LINK(ASL)=ASL+1
if (ASL < 256) goto L_0001;
if (ASL >= 1023) goto L_0001;
LINK[ASL] = ASL + 1;
L_0001:;
// 40 ASL=ASL+1
ASL = ASL + 1;
// 41 %IF ASL<=1023 %THEN ->L10
if (ASL > 1023) goto L_0002;
goto U_1000;
L_0002:;
// 42 ASL=256 ;! AVAILABLE SPACE LIST POINTER
ASL = 256;
// 43 BR(0)=M'BR0' ;! BASE REGISTER MNEMONICS
BR[0] = 4346416;
// 44 BR(1)=M'BR1'
BR[1] = 4346417;
// 45 BR(2)=M'BR2'
BR[2] = 4346418;
// 46 BR(3)=M'BR3'
BR[3] = 4346419;
// 47 BR(4)=M'BR4'
BR[4] = 4346420;
// 48 BR(5)=M'BR5'
BR[5] = 4346421;
// 49 BR(6)=M'BR6'
BR[6] = 4346422;
// 50 BR(7)=M'BR7'
BR[7] = 4346423;
// 51 BR(8)=M'BR8'
BR[8] = 4346424;
// 52 BR(9)=M'BR9'
BR[9] = 4346425;
// 53 BR(10)=M'BR10'
BR[10] = 1112682800;
// 54 BR(11)=M'BR11'
BR[11] = 1112682801;
// 55 BR(12)=M'BR12'
BR[12] = 1112682802;
// 56 BR(13)=M'BR13'
BR[13] = 1112682803;
// 57 BR(14)=M'BR14'
BR[14] = 1112682804;
// 58 BR(15)=M'BR15'
BR[15] = 1112682805;
// 59 TRUE(1)=M'BZ' ;! CONDITIONAL BRANCH MNEMONICS
TRUE[0] = 16986;
// 60 FALSE(1)=M'BNZ'
FALSE[0] = 4345434;
// 61 TRUE(2)=M'BNZ'
TRUE[1] = 4345434;
// 62 FALSE(2)=M'BZ'
FALSE[1] = 16986;
// 63 TRUE(3)=M'BNG'
TRUE[2] = 4345415;
// 64 FALSE(3)=M'BG'
FALSE[2] = 16967;
// 65 TRUE(4)=M'BL'
TRUE[3] = 16972;
// 66 FALSE(4)=M'BNL'
FALSE[3] = 4345420;
// 67 TRUE(5)=M'BNL'
TRUE[4] = 4345420;
// 68 FALSE(5)=M'BL'
FALSE[4] = 16972;
// 69 TRUE(6)=M'BG'
TRUE[5] = 16967;
// 70 FALSE(6)=M'BNG'
FALSE[5] = 4345415;
// 71 PREC(1)=3 ;! OPERATOR PRECEDENCES
PREC[0] = 3;
// 72 PREC(2)=3 ;! 4 : HIGHEST
PREC[1] = 3;
// 73 PREC(3)=2 ;! 1 : LOWEST
PREC[2] = 2;
// 74 PREC(4)=1
PREC[3] = 1;
// 75 PREC(5)=1
PREC[4] = 1;
// 76 PREC(6)=3
PREC[5] = 3;
// 77 PREC(7)=2
PREC[6] = 2;
// 78 PREC(8)=2
PREC[7] = 2;
// 79 PREC(9)=1
PREC[8] = 1;
// 80 PREC(10)=1
PREC[9] = 1;
// 81 PREC(11)=1
PREC[10] = 1;
// 82 PREC(12)=4
PREC[11] = 4;
// 83 OPR(0)=M'LOAD' ;! MACHINE INSTRUCTION MNEMONICS
OPR[0] = 1280262468;
// 84 OPR(1)=M'SHL'
OPR[1] = 5457996;
// 85 OPR(2)=M'SHR'
OPR[2] = 5458002;
// 86 OPR(3)=M'AND'
OPR[3] = 4279876;
// 87 OPR(4)=M'XOR'
OPR[4] = 5787474;
// 88 OPR(5)=M'OR'
OPR[5] = 20306;
// 89 OPR(6)=M'EXP'
OPR[6] = 4544592;
// 90 OPR(7)=M'DIV'
OPR[7] = 4475222;
// 91 OPR(8)=M'MLT'
OPR[8] = 5065812;
// 92 OPR(9)=M'ADD'
OPR[9] = 4277316;
// 93 OPR(10)=M'SUB'
OPR[10] = 5461314;
// 94 OPR(11)=M'NEG'
OPR[11] = 5129543;
// 95 OPR(12)=M'NOT'
OPR[12] = 5132116;
// 96 UCN(1)=3 ;! OPERATOR TYPES
UCN[0] = 3;
// 97 UCN(2)=3 ;! 1 : UNARY
UCN[1] = 3;
// 98 UCN(3)=2 ;! 2 : BINARY COMMUTATIVE
UCN[2] = 2;
// 99 UCN(3)=2 ;! 3 : BINARY NON-COMMUTATIVE
UCN[2] = 2;
// 100 UCN(4)=2
UCN[3] = 2;
// 101 UCN(5)=2
UCN[4] = 2;
// 102 UCN(6)=3
UCN[5] = 3;
// 103 UCN(7)=3
UCN[6] = 3;
// 104 UCN(8)=2
UCN[7] = 2;
// 105 UCN(9)=2
UCN[8] = 2;
// 106 UCN(10)=3
UCN[9] = 3;
// 107 UCN(11)=1
UCN[10] = 1;
// 108 UCN(12)=1
UCN[11] = 1;
// 109 BTN=0 ;! BRANCH TABLE POINTER
BTN = 0;
// 110 CTN=0 ;! CONSTANT TABLE POINTER
CTN = 0;
// 111 CHP=1 ;! NAME CHARACTER TABLE POINTER
CHP = 1;
// 112 FAULTS=0 ;! FAULT COUNT
FAULTS = 0;
// 113 LEVEL=0 ;! TEXTUAL LEVEL
LEVEL = 0;
// 114 SCF=0 ;! CONDITION FLAG
SCF = 0;
// 115 JUMP(0)=0 ;! JUMP LIST POINTER
JUMP[0] = 0;
// 116 STAR(0)=0 ;! STORAGE ALLOCATION POSITION IN COT
STAR[0] = 0;
// 117 NAME(0)=0 ;! NAME LIST POINTER
NAME[0] = 0;
// 118 RTP(0)=-1 ;! ROUTINE TYPE
RTP[0] = -1;
// 119 CHPP(0)=0 ;! NAME CHARACTER TABLE POSITION
CHPP[0] = 0;
// 120 START(0)=0 ;! START/FINISH LIST
START[0] = 0;
// 121 RAD(0)=10 ;! NEXT RELATIVE ADDRESS TO BE ALLOCATED
RAD[0] = 10;
// 122 CA=0 ;! CURRENT CODE DUMPING ADDRESS
CA = 0;
// 123 PRINT SYMBOL('P')
_imp_PRINTSYMBOL(80);
// 124 PRINT SYMBOL('R')
_imp_PRINTSYMBOL(82);
// 125 PRINT SYMBOL('G')
_imp_PRINTSYMBOL(71);
// 126 PRINT SYMBOL(':')
_imp_PRINTSYMBOL(58);
// 127 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 128 L1: READ LINE
U_1001:;
READLINE();
// 129 TP=1 ;! TEXT POINTER
TP = 1;
// 130 L2: %IF T(TP)='!' %THEN ->L3 ;! COMMENT - SKIP TO END
U_1002:;
if (T[TP - 1] != 33) goto L_0003;
goto U_1003;
L_0003:;
// 131 PSP=-1000 ;! START OF <SS> IN PHRASE STRUCTURE TABLES
PSP = -1000;
// 132 AP=1
AP = 1;
// 133 %IF COMPARE=1 %THEN %START ;! SUCCESSFUL ANALYSIS
if (COMPARE() != 1) goto L_0004;
// 134 AP=1 ;! ANALYSIS RECORD POINTER
AP = 1;
// 135 SS ;! PROCESS SOURCE STATEMENT
SS();
// 136 %IF T(TP-1)=';' %THEN ->L2 ;! FURTHER STATEMENT ON THIS LINE
if (T[TP - 1 - 1] != 59) goto L_0005;
goto U_1002;
L_0005:;
// 137 ->L1 ; %FINISH ;! GO TO READ NEXT LINE
goto U_1001;
L_0004:;
// 138 FAULT(M'SYNT',M'AX ?',M' ',M' ') ;! UNSUCCESSFUL ANALYSIS
FAULT(1398361684, 1096294463, 538976288, 538976288);
// 139 L5: %IF T(TP)=10 %THEN ->L1 ;! NEWLINE - READ NEXT LINE
U_1004:;
if (T[TP - 1] != 10) goto L_0006;
goto U_1001;
L_0006:;
// 140 %IF T(TP)=';' %THEN %START ;! END OF STATEMENT
if (T[TP - 1] != 59) goto L_0007;
// 141 TP=TP+1 ;! TP TO START OF NEXT STATEMENT
TP = TP + 1;
// 142 ->L2 ; %FINISH ;! GO TO EXAMINE NEXT STATEMENT
goto U_1002;
L_0007:;
// 143 L3: TP=TP+1 ;! SKIP TO NEXT CHARACTER OF STATEMENT
U_1003:;
TP = TP + 1;
// 144 ->L5
goto U_1004;
// 145 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 146 %ROUTINE READ PS
void READPS(void) {
// 147 ! READ IN AND REDUCE PHRASE STRUCTURE
// 148 %INTEGER PNP,ALT,P,I,J,K
int PNP;
int ALT;
int P;
int I;
int J;
int K;
// 149 %INTEGERARRAY PN,PSP(256:300) ;! PHRASE NAME CHARS & POINTERS TO START OF PHRASES IN PS
int PN[45];
int PSP[45];
auto void INSERTLIT(void);
auto int GETPN(void);
// 150 %ROUTINESPEC INSERT LIT
// 151 %INTEGERFNSPEC GET PN
// 152 PNP=256 ;! PN POINTER
PNP = 256;
// 153 P=-1000 ;! PS POINTER
P = -1000;
// 154 L1: READ SYMBOL(I)
U_1005:;
_imp_READSYMBOL(/*?*/ &I);
// 155 %IF I='B' %THEN %START ;! BUILT-IN PHRASE
if (I != 66) goto L_0008;
// 156 L2: READ SYMBOL(I) ;! SKIP TO <
U_1006:;
_imp_READSYMBOL(/*?*/ &I);
// 157 %IF I\='<' %THEN ->L2
if (I == 60) goto L_0009;
goto U_1006;
L_0009:;
// 158 J=GET PN ;! READ PHRASE NAME & GET POSITION IN PSP
J = GETPN();
// 159 L3: READ SYMBOL(I) ;! SKIP TO =
U_1007:;
_imp_READSYMBOL(/*?*/ &I);
// 160 %IF I\='=' %THEN ->L3
if (I == 61) goto L_000A;
goto U_1007;
L_000A:;
// 161 READ(K) ;! READ PHRASE NUMBER
_imp_READ(/*?*/ &K);
// 162 PSP(J)=K ;! FILL IN PHRASE NUMBER
PSP[J - 256] = K;
// 163 ->L1 ; %FINISH ;! GO TO DEAL WITH NEXT PHRASE
goto U_1005;
L_0008:;
// 164 %IF I='P' %THEN %START ;! PHRASE
if (I != 80) goto L_000B;
// 165 L4: READ SYMBOL(I) ;! SKIP TO <
U_1008:;
_imp_READSYMBOL(/*?*/ &I);
// 166 %IF I\='<' %THEN ->L4
if (I == 60) goto L_000C;
goto U_1008;
L_000C:;
// 167 PSP(GET PN)=P ;! READ PHRASE NAME & FILL IN PS POSITION
PSP[GETPN() - 256] = P;
// 168 L7: ALT=P ;! REMEMBER START POSITION IN PS OF THIS ALTERNATIVE
U_1009:;
ALT = P;
// 169 L6: P=P+1 ;! NEXT PS POSITION
U_100A:;
P = P + 1;
// 170 L5: READ SYMBOL(I) ;! START OF NEXT ITEM IN THIS ALTERNATIVE
U_100B:;
_imp_READSYMBOL(/*?*/ &I);
// 171 %IF I='''' %THEN %START ;! LITERAL TEXT
if (I != 39) goto L_000D;
// 172 INSERT LIT ;! READ LITERAL & INSERT IN PS
INSERTLIT();
// 173 ->L5 ; %FINISH ;! GO FOR NEXT ITEM
goto U_100B;
L_000D:;
// 174 %IF I='<' %THEN %START ;! ITEM IS A PHRASE NAME
if (I != 60) goto L_000E;
// 175 PS(P)=GET PN ;! READ PHRASE NAME & FILL IN PS WITH PSP POSITION
PS[P + 1000] = GETPN();
// 176 ->L6 ; %FINISH ;! GO FOR NEXT ITEM
goto U_100A;
L_000E:;
// 177 %IF I=',' %THEN %START ;! END OF THIS ALTERNATIVE
if (I != 44) goto L_000F;
// 178 PS(ALT)=P ;! FILL IN POINTER TO END OF ALTERNATIVE
PS[ALT + 1000] = P;
// 179 ->L7 ; %FINISH ;! GO FOR START OF NEXT ALTERNATIVE
goto U_1009;
L_000F:;
// 180 %IF I=';' %THEN %START ;! END OF PHRASE DEFINITION
if (I != 59) goto L_0010;
// 181 PS(ALT)=P ;! FILL IN POINTER TO END OF ALTERNATIVE
PS[ALT + 1000] = P;
// 182 PS(P)=0 ;! FILL IN END OF PHRASE MARKER
PS[P + 1000] = 0;
// 183 P=P+1 ;! NEXT PS POSITION FOR START OF NEXT PHRASE DEFINITION
P = P + 1;
// 184 ->L1 ; %FINISH ;! GO FOR NEXT PHRASE
goto U_1005;
L_0010:;
// 185 ->L5 ; %FINISH ;! SKIP TO SOMETHING SIGNIFICANT
goto U_100B;
L_000B:;
// 186 %IF I='E' %THEN %START ;! END OF PHRASE STRUCTURE DEFINITIONS
if (I != 69) goto L_0011;
// 187 I=-1000 ;! REPLACE ALL POINTERS TO PSP WITH CORRECT PS POINTERS
I = -1000;
// 188 L8: %IF PS(I)>=256 %THEN PS(I)=PSP(PS(I))
U_100C:;
if (PS[I + 1000] < 256) goto L_0012;
PS[I + 1000] = PSP[PS[I + 1000] - 256];
L_0012:;
// 189 I=I+1
I = I + 1;
// 190 %IF I\=P %THEN ->L8
if (I == P) goto L_0013;
goto U_100C;
L_0013:;
// 191 %RETURN ; %FINISH
return;
L_0011:;
// 192 ->L1 ;! SKIP TO SOMETHING SIGNIFICANT
goto U_1005;
// 193 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 194 %ROUTINE INSERT LIT
void INSERTLIT(void) {
// 195 ! INSERT LITERAL TEXT INTO 'PS'
// 196 %INTEGER SH,I
int SH;
int I;
// 197 SH=0 ;! % SHIFT VALUE TO 0
SH = 0;
// 198 L1: READ SYMBOL(I)
U_100D:;
_imp_READSYMBOL(/*?*/ &I);
// 199 %IF I='''' %THEN %START
if (I != 39) goto L_0014;
// 200 %IF NEXT SYMBOL\='''' %THEN %RETURN ;! END OF LITERAL
if (_imp_NEXTSYMBOL() == 39) goto L_0015;
return;
L_0015:;
// 201 READ SYMBOL(I) ;! QUOTE INSIDE LITERAL - IGNORE ONE
_imp_READSYMBOL(/*?*/ &I);
// 202 %FINISH
L_0014:;
// 203 %IF I='%' %THEN SH=128 %ELSE %START ;! SHIFT VALUE TO 128 FOR %
if (I != 37) goto L_0016;
SH = 128;
goto L_0017;
L_0016:;
// 204 %IF I<'A' %OR I>'Z' %THEN SH=0 ;! END OF KEYWORD - SHIFT VALUE TO 0
if (I < 65) goto L_0018;
if (I <= 90) goto L_0019;
L_0018:;
SH = 0;
L_0019:;
// 205 PS(P)=I+SH ;! STORE SHIFTED (POSSIBLY) CHAR IN PS
PS[P + 1000] = I + SH;
// 206 P=P+1 ;! MOVE TO NEXT POSITION IN PS
P = P + 1;
// 207 %FINISH
L_0017:;
// 208 ->L1
goto U_100D;
// 209 %END
} /* end of INSERTLIT */
// 210 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 211 %INTEGERFN GET PN
int GETPN(void) {
// 212 ! READ IN PHRASE NAME AND GET INDEX IN 'PSP'
// 213 %INTEGER NP,S,I
int NP;
int S;
int I;
// 214 NP=0 ;! TO ACCUMULATE PHRASE NAME CHARS
NP = 0;
// 215 S=24 ;! INITIAL SHIFT VALUE TO PACK CHARS
S = 24;
// 216 L1: READ SYMBOL(I)
U_100E:;
_imp_READSYMBOL(/*?*/ &I);
// 217 %IF I\='>' %THEN %START ;! NOT END OF NAME YET
if (I == 62) goto L_001A;
// 218 NP=NP!I<<S ;! PACK NEXT CHAR OF PHRASE NAME
NP = NP | I << S;
// 219 S=S-8 ;! REDUCE SHIFT VALUE FOR NEXT CHAR
S = S - 8;
// 220 ->L1 ; %FINISH
goto U_100E;
L_001A:;
// 221 %IF PNP\=256 %THEN %START ;! NOT FIRST PHRASE NAME
if (PNP == 256) goto L_001B;
// 222 I=256 ;! SCAN NAMES TO FIND IF ALREADY IN
I = 256;
// 223 L2: %IF NP=PN(I) %THEN %RESULT=I
U_100F:;
if (NP != PN[I - 256]) goto L_001C;
return I;
L_001C:;
// 224 I=I+1
I = I + 1;
// 225 %IF I\=PNP %THEN ->L2
if (I == PNP) goto L_001D;
goto U_100F;
L_001D:;
// 226 %FINISH
L_001B:;
// 227 PN(PNP)=NP ;! INSERT NEW NAME IN DICTIONARY
PN[PNP - 256] = NP;
// 228 PSP(PNP)=99999 ;! UNDEFINED PHRASE MARKER
PSP[PNP - 256] = 99999;
// 229 PNP=PNP+1 ;! MOVE TO NEXT DICTIONARY POSITION
PNP = PNP + 1;
// 230 %RESULT=PNP-1
return PNP - 1;
// 231 %END
} /* end of GETPN */
// 232 %END
return;
} /* end of READPS */
// 233 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 234 %ROUTINE READ LINE
void READLINE(void) {
auto void STORE(int I);
// 235 ! LEXICAL PHASE - READ & CLEAN UP NEXT LINE OF TEXT
// 236 %ROUTINESPEC STORE(%INTEGER I)
// 237 %INTEGER SH,I
int SH;
int I;
// 238 NEWLINES(2)
_imp_NEWLINES(2);
// 239 PRINT SYMBOL(';')
_imp_PRINTSYMBOL(59);
// 240 SH=0 ;! % & LITERAL SHIFT VALUE TO 0
SH = 0;
// 241 TP=1 ;! POINTER TO TEXT ARRAY T
TP = 1;
// 242 L1: READ SYMBOL(I)
U_1010:;
_imp_READSYMBOL(/*?*/ &I);
// 243 %IF I=10 %AND TP=1 %THEN ->L1
if (I != 10) goto L_001E;
if (TP != 1) goto L_001E;
goto U_1010;
L_001E:;
// 244 PRINT SYMBOL(I)
_imp_PRINTSYMBOL(I);
// 245 %IF I='''' %THEN %START
if (I != 39) goto L_001F;
// 246 SH=128 ;! SHIFT VALUE FOR LITERAL
SH = 128;
// 247 L2: STORE(I) ;! STORE SHIFTED CHAR IN TEXT ARRAY
U_1011:;
STORE(I);
// 248 READ SYMBOL(I)
_imp_READSYMBOL(/*?*/ &I);
// 249 PRINT SYMBOL(I)
_imp_PRINTSYMBOL(I);
// 250 %IF I=10 %THEN PRINT SYMBOL(';')
if (I != 10) goto L_0020;
_imp_PRINTSYMBOL(59);
L_0020:;
// 251 %IF I\='''' %THEN ->L2 ;! NOT END OF LITERAL YET
if (I == 39) goto L_0021;
goto U_1011;
L_0021:;
// 252 READ SYMBOL(I)
_imp_READSYMBOL(/*?*/ &I);
// 253 PRINT SYMBOL(I)
_imp_PRINTSYMBOL(I);
// 254 %IF I='''' %THEN ->L2 ;! QUOTE IN LITERAL - IGNORE ONE
if (I != 39) goto L_0022;
goto U_1011;
L_0022:;
// 255 SH=0 ;! SHIFT VALUE TO 0 FOR END OF LITERAL
SH = 0;
// 256 STORE('''') ;! STORE UNSHIFTED VALUE TO MARK END
STORE(39);
// 257 %FINISH
L_001F:;
// 258 %IF I='%' %THEN SH=128 %ELSE %START ;! SHIFT VALUE TO 128 FOR KEYWORD
if (I != 37) goto L_0023;
SH = 128;
goto L_0024;
L_0023:;
// 259 %IF I<'A' %OR I>'Z' %THEN SH=0 ;! SHIFT VALUE TO 0 FOR END OF KEYWORD
if (I < 65) goto L_0025;
if (I <= 90) goto L_0026;
L_0025:;
SH = 0;
L_0026:;
// 260 %IF I\=' ' %THEN %START ;! IGNORE SPACES
if (I == 32) goto L_0027;
// 261 STORE(I)
STORE(I);
// 262 %IF I=10 %THEN %START ;! NEWLINE CHAR
if (I != 10) goto L_0028;
// 263 %IF T(TP-2)='C'+128 %THEN %START
if (T[TP - 2 - 1] != 67 + 128) goto L_0029;
// 264 TP=TP-2
TP = TP - 2;
// 265 PRINT SYMBOL(';')
_imp_PRINTSYMBOL(59);
// 266 %FINISH %ELSE %RETURN
goto L_002A;
L_0029:;
return;
L_002A:;
// 267 %FINISH
L_0028:;
// 268 %FINISH
L_0027:;
// 269 %FINISH
L_0024:;
// 270 ->L1
goto U_1010;
// 271 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 272 %ROUTINE STORE(%INTEGER I)
void STORE(int I) {
// 273 ! STORE (POSSIBLY) SHIFTED CHARACTER IN TEXT ARRAY & CHECK LINE NOT TOO LONG
// 274 %IF TP>300 %THEN %START
if (TP <= 300) goto L_002B;
// 275 FAULT(M'STAT',M'MNT ',M'TOO ',M'LONG')
FAULT(1398030676, 1296978976, 1414483744, 1280265799);
// 276 TP=1
TP = 1;
// 277 %FINISH
L_002B:;
// 278 T(TP)=I+SH ;! STORE CHAR IN TEXT ARRAY
T[TP - 1] = I + SH;
// 279 TP=TP+1 ;! MOVE TO NEXT POSITION
TP = TP + 1;
// 280 %END
return;
} /* end of STORE */
// 281 %END
return;
} /* end of READLINE */
// 282 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 283 %INTEGERFN COMPARE
int COMPARE(void) {
auto int NAME(void);
auto int CNST(void);
// 284 ! ANALYSE PHRASE
// 285 %INTEGERFNSPEC NAME ;! BUILT-IN PHRASE NAME
// 286 %INTEGERFNSPEC CNST ;! BUILT-IN PHRASE <CNST>
// 287 %INTEGER APP,TPP,PSPP,AE,N
int APP;
int TPP;
int PSPP;
int AE;
int N;
// 288 TPP=TP ;! PRESERVE INITIAL TEXT POINTER
TPP = TP;
// 289 APP=AP ;! PRESERVE INITIAL ANALYSIS RECORD
APP = AP;
// 290 A(AP)=1 ;! ALTERNATIVE 1 FIRST
A[AP - 1] = 1;
// 291 L11: AE=PS(PSP) ;! POINTER TO END OF ALTERNATIVE
U_1012:;
AE = PS[PSP + 1000];
// 292 PSP=PSP+1 ;! FIRST ITEM OF ALTERNATIVE DEFN
PSP = PSP + 1;
// 293 L12: %IF PSP=AE %THEN %RESULT=1 ;! END OF ALT REACHED - SUCCESS
U_1013:;
if (PSP != AE) goto L_002C;
return 1;
L_002C:;
// 294 N=PS(PSP) ;! NEXT ITEM OF ALT DEFN
N = PS[PSP + 1000];
// 295 PSP=PSP+1 ;! FOR FOLLOWING ITEM
PSP = PSP + 1;
// 296 %IF N<0 %THEN %START ;! SUB-PHRASE
if (N >= 0) goto L_002D;
// 297 PSPP=PSP ;! PRESERVE PS POINTER
PSPP = PSP;
// 298 PSP=N ;! POINTER TO DEFN OF SUB-PHRASE
PSP = N;
// 299 AP=AP+1 ;! NEXT ANALYSIS RECORD POSITION
AP = AP + 1;
// 300 N=COMPARE ;! RECURSIVE COMPARISON FOR SUB-PHRASE
N = COMPARE();
// 301 PSP=PSPP ;! RESTORE PS POINTER
PSP = PSPP;
// 302 %IF N=1 %THEN ->L12 ;! SUCCESSFUL COMPARISON - GO FOR NEXT ITEM
if (N != 1) goto L_002E;
goto U_1013;
L_002E:;
// 303 ->L13 ; %FINISH ;! UNSUCCESSFUL - GO FOR NEXT ALTERNATIVE
goto U_1014;
L_002D:;
// 304 %IF N=1 %THEN %START ;! BUILT-IN PHRASE <NAME>
if (N != 1) goto L_002F;
// 305 %IF NAME=1 %THEN ->L12 ;! SUCCESS
if (NAME() != 1) goto L_0030;
goto U_1013;
L_0030:;
// 306 ->L13 ; %FINISH ;! FAILURE
goto U_1014;
L_002F:;
// 307 %IF N=2 %THEN %START ;! BUILT-IN PHRASE CNST
if (N != 2) goto L_0031;
// 308 %IF CNST=1 %THEN ->L12 ;! SUCCESS
if (CNST() != 1) goto L_0032;
goto U_1013;
L_0032:;
// 309 ->L13 ; %FINISH ;! FAILURE
goto U_1014;
L_0031:;
// 310 %IF N=T(TP) %THEN %START ;! LITERAL - MATCHES SOURCE CHAR
if (N != T[TP - 1]) goto L_0033;
// 311 TP=TP+1 ;! MOVE TO NEXT SOURCE CHAR
TP = TP + 1;
// 312 ->L12 ; %FINISH ;! GO FOR NEXT ITEM
goto U_1013;
L_0033:;
// 313 L13: %IF PS(AE)=0 %THEN %RESULT=0 ;! END OF PHRASE
U_1014:;
if (PS[AE + 1000] != 0) goto L_0034;
return 0;
L_0034:;
// 314 PSP=AE ;! START OF DEFN OF NEXT ALTERNATIVE
PSP = AE;
// 315 TP=TPP ;! BACKTRACK SOURCE TEXT
TP = TPP;
// 316 AP=APP ;! AND ANALYSIS RECORD POINTERS
AP = APP;
// 317 A(AP)=A(AP)+1 ;! COUNT ALTERNATIVE NUMBER ON ONE
A[AP - 1] = A[AP - 1] + 1;
// 318 ->L11 ;! GO TO ANALYSE NEW ALTERNATIVE
goto U_1012;
// 319 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 320 %INTEGERFN NAME
int NAME(void) {
// 321 ! RECOGNISE AND INSERT NAME IN HASHING AREA OF TAG/LINK ARRAYS
// 322 %INTEGER I,J,K,L,M,N
int I;
int J;
int K;
int L;
int M;
int N;
// 323 I=T(TP) ;! FIRST SOURCE CHAR
I = T[TP - 1];
// 324 %IF I<'A' %OR I>'Z' %OR (I='M' %AND T(TP+1)=''''+128) %THENRESULT=0
if (I < 65) goto L_0035;
if (I > 90) goto L_0035;
if (I != 77) goto L_0036;
if (T[TP + 1 - 1] != 39 + 128) goto L_0036;
L_0035:;
return 0;
L_0036:;
// 325 ;! FAILURE - NOT A LETTER OR AN M-TYPE CONSTANT
// 326 J=CHP ;! NEXT POSITION IN CHARACTER ARRAY
J = CHP;
// 327 K=I<<16 ;! LEAVE HOLE FOR LENGTH & PACK FIRST CHAR
K = I << 16;
// 328 L=1 ;! NO OF CHARS
L = 1;
// 329 M=8 ;! NEXT SHIFT VALUE FOR PACKING
M = 8;
// 330 N=I ;! SUM VALUE OF CHARS FOR HASHING
N = I;
// 331 L1: TP=TP+1
U_100B:;
TP = TP + 1;
// 332 I=T(TP) ;! NEXT CHAR FROM TEXT ARRAY
I = T[TP - 1];
// 333 %IF ('0'<=I %AND I<='9') %OR ('A'<=I %AND I<='Z') %THEN %START
if (48 > I) goto L_0037;
if (I <= 57) goto L_0038;
L_0037:;
if (65 > I) goto L_0039;
if (I > 90) goto L_0039;
L_0038:;
// 334 ;! A DIGIT OR A LETTER
// 335 K=K!I<<M ;! PACK NEXT LETTER
K = K | I << M;
// 336 L=L+1 ;! CHARACTER COUNT
L = L + 1;
// 337 M=M-8 ;! NEXT SHIFT
M = M - 8;
// 338 N=N+I ;! SUM OF LETTERS
N = N + I;
// 339 %IF M<0 %THEN %START ;! PACKED WORD OF CHARS FULL
if (M >= 0) goto L_003A;
// 340 CH(CH NEXT)=K ;! STORE WORD IN CHAR ARRAY
CH[CHNEXT() - 1] = K;
// 341 K=0 ;! PACKING WORD TO ZERO
K = 0;
// 342 M=24 ;! NEW SHIFT VALUE
M = 24;
// 343 %FINISH
L_003A:;
// 344 ->L1 ; %FINISH ;! GO FOR NEXT CHAR
goto U_100B;
L_0039:;
// 345 %IF K\=0 %THEN CH(CH NEXT)=K ;! STORE ANY REMAINING CHARS IN CHAR ARRAY
if (K == 0) goto L_003B;
CH[CHNEXT() - 1] = K;
L_003B:;
// 346 CH(J)=CH(J)!L<<24 ;! FILL IN LENGTH IN HOLE LEFT IN FIRST WORD
CH[J - 1] = CH[J - 1] | L << 24;
// 347 I=(N&15)<<4!N>>4&15 ;! HASH VALUE
I = (N & 15) << 4 | (unsigned int)N >> 4 & 15;
// 348 K=I ;! SCAN DICTIONARY FOR NAME
K = I;
// 349 L2: %IF TAG(K)\=0 %THEN %START ;! A NAME IN THIS POSITION
U_100C:;
if (TAG[K] == 0) goto L_003C;
// 350 L=TAG(K) ;! CHAR ARRAY POSITION
L = TAG[K];
// 351 M=J ;! CHAR ARRAY POSITION OF NEW NAME
M = J;
// 352 L4: %IF CH(L)=CH(M) %THEN %START ;! PACKED WORDS MATCH
U_1015:;
if (CH[L - 1] != CH[M - 1]) goto L_003D;
// 353 M=M+1 ;! NEXT WORD OF NEW NAME
M = M + 1;
// 354 %IF M=CHP %THEN %START ;! NAMES MATCH
if (M != CHP) goto L_003E;
// 355 CHP=J ;! MOVE CHP BACK SINCE NAME ALREADY IN
CHP = J;
// 356 ->L3 ; %FINISH
goto U_1016;
L_003E:;
// 357 L=L+1 ;! NEXT WORD OF OLD NAME
L = L + 1;
// 358 ->L4 ; %FINISH ;! GO FOR NEXT WORD
goto U_1015;
L_003D:;
// 359 K=(K+1)&255 ;! NO MATCH SO TRY NEXT DICTIONARY POSITION
K = K + 1 & 255;
// 360 %IF K=I %THEN %START ;! STARTING POSITION REACHED AGAIN
if (K != I) goto L_003F;
// 361 FAULT(M'DICT',M'IONA',M'RY F',M'ULL ')
FAULT(1145652052, 1229934145, 1381572678, 1431063584);
// 362 %STOP ; %FINISH
_imp_stop(0);
L_003F:;
// 363 ->L2 ; %FINISH
goto U_100C;
L_003C:;
// 364 TAG(K)=J ;! STORE CHAR ARRAY POSITION OF NAME
TAG[K] = J;
// 365 L3: AP=AP+1 ;! NEXT ANALYSIS RECORD POSITION
U_1016:;
AP = AP + 1;
// 366 A(AP)=K ;! STORE IDENTIFICATION NO OF NAME
A[AP - 1] = K;
// 367 %RESULT=1 ;! SUCCESS
return 1;
// 368 %END
} /* end of NAME */
// 369 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 370 %INTEGERFN CNST
int CNST(void) {
// 371 ! RECOGNISE INTEGER AND LITERAL TEXT CONSTANTS
// 372 %INTEGER I,J,K
int I;
int J;
int K;
// 373 I=T(TP) ;! FIRST CHAR
I = T[TP - 1];
// 374 %IF I='M' %AND T(TP+1)=''''+128 %THEN %START ;! M-TYPE CONSTANT
if (I != 77) goto L_0040;
if (T[TP + 1 - 1] != 39 + 128) goto L_0040;
// 375 TP=TP+1 ;! IGNORE THE M
TP = TP + 1;
// 376 I=T(TP)
I = T[TP - 1];
// 377 %FINISH
L_0040:;
// 378 %IF I=''''+128 %THEN %START ;! START OF A LITERAL
if (I != 39 + 128) goto L_0041;
// 379 J=0 ;! TO ACCUMULATE LITERAL VALUE
J = 0;
// 380 K=0 ;! CHARACTER COUNT
K = 0;
// 381 L1: TP=TP+1
U_1008:;
TP = TP + 1;
// 382 I=T(TP) ;! NEXT CHAR
I = T[TP - 1];
// 383 %IF I\='''' %THEN %START ;! NOT END OF LITERAL
if (I == 39) goto L_0042;
// 384 J=J<<8!I&127 ;! PACK CHAR
J = J << 8 | I & 127;
// 385 K=K+1 ;! COUNT CHAR
K = K + 1;
// 386 ->L1 ; %FINISH
goto U_1008;
L_0042:;
// 387 TP=TP+1 ;! POINTER AFTER QUOTE
TP = TP + 1;
// 388 %IF K>4 %THEN FAULT(M'STRI',M'NG T',M'OO L',M'ONG ')
if (K <= 4) goto L_0043;
FAULT(1398035017, 1313284180, 1330585676, 1330530080);
L_0043:;
// 389 ->L2 ; %FINISH
goto U_1009;
L_0041:;
// 390 %IF I<'0' %OR I>'9' %THEN %RESULT=0 ;! NOT A CONSTANT
if (I < 48) goto L_0044;
if (I <= 57) goto L_0045;
L_0044:;
return 0;
L_0045:;
// 391 J=0
J = 0;
// 392 L3: J=10*J+I-'0' ;! ACCUMULATE DECIMAL VALUE
U_100A:;
J = 10 * J + I - 48;
// 393 TP=TP+1
TP = TP + 1;
// 394 I=T(TP) ;! NEXT CHAR
I = T[TP - 1];
// 395 %IF '0'<=I %AND I<='9' %THEN ->L3 ;! A DIGIT - STILL PART OF CONSTANT
if (48 > I) goto L_0046;
if (I > 57) goto L_0046;
goto U_100A;
L_0046:;
// 396 L2: AP=AP+1 ;! NEXT ANALYSIS RECORD POSITION
U_1009:;
AP = AP + 1;
// 397 A(AP)=J ;! FILL IN VALUE OF CONSTANT
A[AP - 1] = J;
// 398 %RESULT=1 ;! SUCCESS
return 1;
// 399 %END
} /* end of CNST */
// 400 %END
_imp_signal(8, 4, 0, "result missing");
} /* end of COMPARE */
// 401 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 402 %ROUTINE SS
void SS(void) {
auto void UI(void);
auto void SCCOND(int *LABEL);
auto void SEXPR(void);
auto int FINDLABEL(void);
auto void CHECK(void);
auto void UNSET(void);
auto void PUSHSTART(int FLAG, int LABEL);
auto int BTNEXT(void);
auto int CTNEXT(void);
auto int WSNEXT(void);
auto void STORETAG(int NAM, int FORM, int TYPE, int DIM, int LEV, int AD);
auto void DUMP(int OP, int REG, int BASE, int DISP);
auto void SKIPSEXPR(void);
auto void SKIPAPP(void);
auto void RT(void);
auto void ARRAD(void);
auto void ENTER(int TYPE, int ALLOC);
auto void RETURN(void);
// 403 ! COMPILE SOURCE STATEMENT
// 404 %ROUTINESPEC UI
// 405 %ROUTINESPEC SCCOND(%INTEGERNAME LABEL)
// 406 %ROUTINESPEC SEXPR
// 407 %INTEGERFNSPEC FIND LABEL
// 408 %ROUTINESPEC CHECK
// 409 %ROUTINESPEC UNSET
// 410 %ROUTINESPEC PUSH START(%INTEGER FLAG,LABEL)
// 411 %INTEGERFNSPEC BT NEXT
// 412 %INTEGERFNSPEC CT NEXT
// 413 %INTEGERFNSPEC WS NEXT
// 414 %ROUTINESPEC STORE TAG(%INTEGER NAME,FORM,TYPE,DIM,LEV,AD)
// 415 %ROUTINESPEC DUMP(%INTEGER OP,REG,BASE,DISP)
// 416 %ROUTINESPEC SKIP SEXPR
// 417 %ROUTINESPEC SKIP APP
// 418 %ROUTINESPEC RT
// 419 %ROUTINESPEC ARRAD
// 420 %ROUTINESPEC ENTER(%INTEGER TYPE,ALLOC)
// 421 %ROUTINESPEC RETURN
// 422 %INTEGER I,J,K,L,M,N,P,Q,R,WS,LABEL
int I;
int J;
int K;
int L;
int M;
int N;
int P;
int Q;
int R;
int WS;
int LABEL;
// 423 I=A(AP) ;! ANALYSIS RECORD ENTRY
I = A[AP - 1];
// 424 AP=AP+1 ;! FOR FOLLOWING ENTRY
AP = AP + 1;
// 425 WS=2 ;! SET WORKSPACE POINTER
WS = 2;
// 426 %IF I=1 %THEN ->L10 ;! UNCONDITIONAL INSTRUCTION
if (I != 1) goto L_0047;
goto U_1017;
L_0047:;
// 427 %IF I=2 %THEN ->L20 ;! CONDITIONAL STATEMENT
if (I != 2) goto L_0048;
goto U_1018;
L_0048:;
// 428 %IF I=3 %THEN ->L30 ;! LABEL
if (I != 3) goto L_0049;
goto U_1019;
L_0049:;
// 429 %IF I=4 %THEN ->L40 ;! %FINISH
if (I != 4) goto L_004A;
goto U_101A;
L_004A:;
// 430 %IF I=5 %THEN ->L50 ;! DECLARATIONS
if (I != 5) goto L_004B;
goto U_101B;
L_004B:;
// 431 %IF I=6 %THEN ->L60 ;! ROUTINE/FN SPEC
if (I != 6) goto L_004C;
goto U_101C;
L_004C:;
// 432 %IF I=7 %THEN ->L70 ;! %END
if (I != 7) goto L_004D;
goto U_101D;
L_004D:;
// 433 %IF I=8 %THEN ->L80 ;! %BEGIN
if (I != 8) goto L_004E;
goto U_101E;
L_004E:;
// 434 %IF I=9 %THEN ->L90 ;! %ENDOFPROGRAM
if (I != 9) goto L_004F;
goto U_101F;
L_004F:;
// 435 %RETURN ;! <SEP>
return;
// 436 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 437 ! UI
// 438 L10: UI ;! COMPILE UNCONDITIONAL INSTRUCTION
U_1017:;
UI();
// 439 %RETURN
return;
// 440 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 441 ! %IF . . . %THEN . . . %ELSE
// 442 L20: SCCOND(I) ;! COMPILE CONDITION
U_1018:;
SCCOND(/*?*/ &I);
// 443 %IF A(AP)=2 %THEN %START ;! AP ON <UI> - JUMP INSTRUCTION
if (A[AP - 1] != 2) goto L_0050;
// 444 AP=AP+2 ;! AP ON <ELSE>
AP = AP + 2;
// 445 J=-1 ;! MARKER FOR 'JUMP'
J = -1;
// 446 %FINISH %ELSE %START ;! NOT A JUMP
goto L_0051;
L_0050:;
// 447 %IF A(AP)=3 %THEN %START ;! %START
if (A[AP - 1] != 3) goto L_0052;
// 448 %IF A(AP+1)=1 %THEN FAULT(M'%STA',M'RT %',M'ELSE',M' ? ')
if (A[AP + 1 - 1] != 1) goto L_0053;
FAULT(626218049, 1381244965, 1162629957, 541007904);
L_0053:;
// 449 PUSH START(0,I)
PUSHSTART(0, I);
// 450 %RETURN ; %FINISH
return;
L_0052:;
// 451 UI ;! COMPILE REMAINING UNCOND. INSTNS.
UI();
// 452 J=0 ;! 'NOT JUMP' MARKER
J = 0;
// 453 %FINISH
L_0051:;
// 454 %IF A(AP)=1 %THEN %START ;! <ELSE>-CLAUSE PRESENT
if (A[AP - 1] != 1) goto L_0054;
// 455 %IF J=0 %THEN %START ;! <UI> WAS NOT A JUMP
if (J != 0) goto L_0055;
// 456 J=BT NEXT ;! JUMP ROUND <ELSE>-CLAUSE <UI>
J = BTNEXT();
// 457 DUMP('B',0,M'BT',J)
DUMP(66, 0, 16980, J);
// 458 %FINISH
L_0055:;
// 459 %IF I>=0 %THEN BAT(I)=CA ;! FILL IN LABEL ON <ELSE>-CLAUSE <UI>
if (I < 0) goto L_0056;
BAT[I] = CA;
L_0056:;
// 460 AP=AP+1 ;! AP ON <UI>
AP = AP + 1;
// 461 %IF A(AP)=3 %THEN %START ;! %START
if (A[AP - 1] != 3) goto L_0057;
// 462 PUSH START(1,J)
PUSHSTART(1, J);
// 463 %RETURN ; %FINISH
return;
L_0057:;
// 464 UI ;! COMPILE REMAINING <UI>S
UI();
// 465 I=J ;! JUMP AROUND LABEL
I = J;
// 466 %FINISH
L_0054:;
// 467 %IF I>=0 %THEN BAT(I)=CA ;! TO BRANCH ROUND THE UI
if (I < 0) goto L_0058;
BAT[I] = CA;
L_0058:;
// 468 %RETURN
return;
// 469 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 470 ! CONST: . . .
// 471 L30: I=FIND LABEL ;! LOCATE/INSERT LABEL IN JUMP LIST
U_1019:;
I = FINDLABEL();
// 472 %IF I>=0 %THEN %START ;! VALID LABEL
if (I < 0) goto L_0059;
// 473 %IF BAT(I)>=0 %THEN %START
if (BAT[I] < 0) goto L_005A;
// 474 WRITE(LABEL,1)
_imp_WRITE(LABEL, 1);
// 475 SPACES(2)
_imp_SPACES(2);
// 476 FAULT(M'LABE',M'L SE',M'T TW',M'ICE ')
FAULT(1279345221, 1277186885, 1411404887, 1229145376);
// 477 %FINISH
L_005A:;
// 478 BAT(I)=CA ;! FILL IN LABEL ADDRESS
BAT[I] = CA;
// 479 %FINISH
L_0059:;
// 480 SS ;! COMPILE STATEMENT AFTER LABEL
SS();
// 481 %RETURN
return;
// 482 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 483 ! %FINISH . . .
// 484 L40: I=START(LEVEL) ;! LINK TO FIRST CELL IN START LIST
U_101A:;
I = START[LEVEL];
// 485 %IF I=0 %THEN %START ;! NO CELLS IN LIST
if (I != 0) goto L_005B;
// 486 FAULT(M'SPUR',M'IOUS',M' %FI',M'NISH')
FAULT(1397773650, 1229935955, 539313737, 1313428296);
// 487 %RETURN ; %FINISH
return;
L_005B:;
// 488 J=TAG(I)&65535 ;! JUMP AROUND LABEL
J = TAG[I] & 65535;
// 489 K=TAG(I)>>16 ;! BEFORE OR AFTER %ELSE MARKER
K = (unsigned int)TAG[I] >> 16;
// 490 START(LEVEL)=RETURN CELL(I) ;! POP UP CELL
START[LEVEL] = RETURNCELL(I);
// 491 %IF A(AP)=1 %THEN %START ;! %ELSE PRESENT
if (A[AP - 1] != 1) goto L_005C;
// 492 %IF K=1 %THEN FAULT(M'TWO ',M'%ELS',M'ES !',M' ')
if (K != 1) goto L_005D;
FAULT(1415008032, 625298515, 1163075617, 538976288);
L_005D:;
// 493 K=BT NEXT ;! JUMP AROUND <UI>
K = BTNEXT();
// 494 DUMP('B',0,M'BT',K)
DUMP(66, 0, 16980, K);
// 495 %IF J\=65535 %THEN BAT(J)=CA ;! FILL IN LABEL ON <UI> IF NECESSARY
if (J == 65535) goto L_005E;
BAT[J] = CA;
L_005E:;
// 496 AP=AP+1 ;! AP ON <UI>
AP = AP + 1;
// 497 %IF A(AP)=3 %THEN %START ;! %START
if (A[AP - 1] != 3) goto L_005F;
// 498 PUSH START(1,K)
PUSHSTART(1, K);
// 499 %RETURN ; %FINISH
return;
L_005F:;
// 500 UI ;! COMPILE REMAINING <UI>S
UI();
// 501 J=K ;! JUMP AROUND LABEL
J = K;
// 502 %FINISH
L_005C:;
// 503 %IF J\=65535 %THEN BAT(J)=CA ;! FILL IN JUMP AROUND LABEL IF NECESSARY
if (J == 65535) goto L_0060;
BAT[J] = CA;
L_0060:;
// 504 %RETURN
return;
// 505 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 506 ! DECLARATIONS
// 507 L50: %IF A(AP)=1 %THEN %START ;! <ARR> = %ARRAY
U_101B:;
if (A[AP - 1] != 1) goto L_0061;
// 508 APP=AP ;! SAVE AP
APP = AP;
// 509 L51: AP=AP+2 ;! AP ON <NAMS>
U_1020:;
AP = AP + 2;
// 510 %IF A(AP)=1 %THEN ->L51 ;! SKIP DOWN TO END OF LIST OF NAMES
if (A[AP - 1] != 1) goto L_0062;
goto U_1020;
L_0062:;
// 511 AP=AP+1 ;! AP ON <+-\>
AP = AP + 1;
// 512 SEXPR ;! COMPILE EXPRESSION - LOWER BOUND
SEXPR();
// 513 DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! STORE VALUE IN WORKSPACE
DUMP(5461074, 4277059, BR[LEVEL], WSNEXT());
// 514 SEXPR ;! COMPILE EXPRESSION - UPPER BOUND
SEXPR();
// 515 DUMP(M'LDA',M'ACC',M'ACC',1) ;! INCREMENT VALUE BY 1
DUMP(4998209, 4277059, 4277059, 1);
// 516 %IF A(AP)=1 %THEN %START ;! 2-DIM ARRAYS
if (A[AP - 1] != 1) goto L_0063;
// 517 DUMP(M'SUB',M'ACC',BR(LEVEL),WS-1) ;! PERFORM 2-DIM ARRAY DECLARATION CALCULATIONS
DUMP(5461314, 4277059, BR[LEVEL], WS - 1);
// 518 DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT)
DUMP(5461074, 4277059, BR[LEVEL], WSNEXT());
// 519 AP=AP+1
AP = AP + 1;
// 520 SEXPR ;! LOWER BOUND EXPR FOR 2ND DIM
SEXPR();
// 521 DUMP(M'MLT',M'ACC',BR(LEVEL),WS-1)
DUMP(5065812, 4277059, BR[LEVEL], WS - 1);
// 522 DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT)
DUMP(5461074, 4277059, BR[LEVEL], WSNEXT());
// 523 SEXPR ;! UPPER BOUND EXPR FOR 2ND DIM
SEXPR();
// 524 DUMP(M'LDA',M'ACC',M'ACC',1)
DUMP(4998209, 4277059, 4277059, 1);
// 525 DUMP(M'MLT',M'ACC',BR(LEVEL),WS-2)
DUMP(5065812, 4277059, BR[LEVEL], WS - 2);
// 526 DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT)
DUMP(5461074, 4277059, BR[LEVEL], WSNEXT());
// 527 WS=WS-4 ;! RESTORE WORKSPACE POINTER
WS = WS - 4;
// 528 I=2 ;! NO OF DIMS
I = 2;
// 529 %FINISH %ELSE %START ;! 1-DIM ARRAYS
goto L_0064;
L_0063:;
// 530 DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT)
DUMP(5461074, 4277059, BR[LEVEL], WSNEXT());
// 531 WS=WS-2 ;! RESTORE WORKSPACE POINTER
WS = WS - 2;
// 532 I=1 ;! NO OF DIMS
I = 1;
// 533 %FINISH
L_0064:;
// 534 J=2 ;! TAG FOR 'ARRAY'
J = 2;
// 535 AP=APP ;! RESTORE AP TO BEFORE LIST OF NAMES
AP = APP;
// 536 %FINISH %ELSE %START ;! SCALAR DECLARATIONS
goto L_0065;
L_0061:;
// 537 I=0 ;! DIMS=0 FOR SCALARS
I = 0;
// 538 J=0 ;! TAG FOR SCALAR
J = 0;
// 539 %FINISH
L_0065:;
// 540 L52: STORE TAG(A(AP+1),J,1,I,LEVEL,RAD(LEVEL)) ;! PUSHDOWN TAG FOR THIS NAME
U_1021:;
STORETAG(A[AP + 1 - 1], J, 1, I, LEVEL, RAD[LEVEL]);
// 541 %IF I=0 %THEN RAD(LEVEL)=RAD(LEVEL)+1 %ELSE %START;! ONE RELATIVE LOCATION FOR SCALARS
if (I != 0) goto L_0066;
RAD[LEVEL] = RAD[LEVEL] + 1;
goto L_0067;
L_0066:;
// 542 %IF I=1 %THEN %START ;! 1-DIM ARRAYS
if (I != 1) goto L_0068;
// 543 DUMP(M'SUB',M'STP',BR(LEVEL),WS)
DUMP(5461314, 5461072, BR[LEVEL], WS);
// 544 DUMP(M'STR',M'STP',BR(LEVEL),RAD(LEVEL))
DUMP(5461074, 5461072, BR[LEVEL], RAD[LEVEL]);
// 545 DUMP(M'ADD',M'STP',BR(LEVEL),WS+1)
DUMP(4277316, 5461072, BR[LEVEL], WS + 1);
// 546 %FINISH %ELSE %START ;! 2-DIM ARRAYS
goto L_0069;
L_0068:;
// 547 DUMP(M'LOAD',M'ACC',BR(LEVEL),WS+1)
DUMP(1280262468, 4277059, BR[LEVEL], WS + 1);
// 548 DUMP(M'STR',M'ACC',BR(LEVEL),RAD(LEVEL))
DUMP(5461074, 4277059, BR[LEVEL], RAD[LEVEL]);
// 549 DUMP(M'SUB',M'STP',BR(LEVEL),WS+2)
DUMP(5461314, 5461072, BR[LEVEL], WS + 2);
// 550 DUMP(M'LDA',M'ACC',M'STP',0)
DUMP(4998209, 4277059, 5461072, 0);
// 551 DUMP(M'SUB',M'ACC',BR(LEVEL),WS)
DUMP(5461314, 4277059, BR[LEVEL], WS);
// 552 DUMP(M'STR',M'ACC',BR(LEVEL),RAD(LEVEL)+1)
DUMP(5461074, 4277059, BR[LEVEL], RAD[LEVEL] + 1);
// 553 DUMP(M'ADD',M'STP',BR(LEVEL),WS+3)
DUMP(4277316, 5461072, BR[LEVEL], WS + 3);
// 554 %FINISH
L_0069:;
// 555 RAD(LEVEL)=RAD(LEVEL)+2 ;! 2 RELATIVE LOCATIONS FOR ARRAYS
RAD[LEVEL] = RAD[LEVEL] + 2;
// 556 %FINISH
L_0067:;
// 557 AP=AP+2 ;! AP ON <NAMS>
AP = AP + 2;
// 558 %IF A(AP)=1 %THEN ->L52 ;! MORE NAMES IN LIST OF NAMES
if (A[AP - 1] != 1) goto L_006A;
goto U_1021;
L_006A:;
// 559 %RETURN
return;
// 560 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 561 ! RT SPEC? . . .
// 562 L60: I=A(AP)-1 ;! ROUTINE/FN
U_101C:;
I = A[AP - 1] - 1;
// 563 J=A(AP+1) ;! SPEC ?
J = A[AP + 1 - 1];
// 564 K=A(AP+2) ;! NAME OF ROUTIINE OR FN
K = A[AP + 2 - 1];
// 565 AP=AP+3 ;! AP ON <FPP>
AP = AP + 3;
// 566 L=0 ;! PARAMETER COUNT
L = 0;
// 567 M=10 ;! FIRST RELATIVE ADDRESS TO BE ALLOCATED
M = 10;
// 568 L63: %IF A(AP)=1 %THEN %START ;! PARAMETERS PRESENT
U_1022:;
if (A[AP - 1] != 1) goto L_006B;
// 569 AP=AP+1 ;! AP ON <ARRN>
AP = AP + 1;
// 570 %IF A(AP)=1 %THEN N=3 %ELSE N=3-A(AP) ;! SET TAG FOR PARAMETER FORM
if (A[AP - 1] != 1) goto L_006C;
N = 3;
goto L_006D;
L_006C:;
N = 3 - A[AP - 1];
L_006D:;
// 571 P=N<<28!1<<24!(LEVEL+1)<<16 ;! SET UP PATTERN FOR WHOLE TAG
P = N << 28 | 1 << 24 | LEVEL + 1 << 16;
// 572 L62: L=L+1 ;! PARAMETER COUNT
U_1023:;
L = L + 1;
// 573 %IF L>15 %THEN %START
if (L <= 15) goto L_006E;
// 574 FAULT(M'TOO ',M'MANY',M' PAR',M'AMS ')
FAULT(1414483744, 1296125529, 542130514, 1095586592);
// 575 ->L61 ; %FINISH ;! IGNORE SUPERFLUOUS PARAMS
goto U_1024;
L_006E:;
// 576 PT(L)=P!M ;! STORE TAG FOR THIS PARAM
PT[L - 1] = P | M;
// 577 PN(L)=A(AP+1) ;! STORE THE NAMES IDENT. NO
PN[L - 1] = A[AP + 1 - 1];
// 578 %IF N=3 %THEN M=M+2 %ELSE M=M+1 ;! NEXT RELATIVE ADDRESS
if (N != 3) goto L_006F;
M = M + 2;
goto L_0070;
L_006F:;
M = M + 1;
L_0070:;
// 579 AP=AP+2 ;! AP ON <NAMS>
AP = AP + 2;
// 580 %IF A(AP)=1 %THEN ->L62 ;! MORE NAMES IN LIST
if (A[AP - 1] != 1) goto L_0071;
goto U_1023;
L_0071:;
// 581 AP=AP+1 ;! AP ON <FPS>
AP = AP + 1;
// 582 ->L63 ; %FINISH
goto U_1022;
L_006B:;
// 583 L61: N=LINK(K) ;! LINK TO TAG FOR NAME OF ROUTINE OR FN
U_1024:;
N = LINK[K];
// 584 %IF N=0 %OR TAG(N)>>16&15<LEVEL %THEN %START ;! NAME NOT SET OR SET AT LOWER LEVEL
if (N == 0) goto L_0072;
if ((unsigned int)TAG[N] >> 16 & 15 >= LEVEL) goto L_0073;
L_0072:;
// 585 %IF L>0 %THEN %START ;! PARAMETERS PRESENT
if (L <= 0) goto L_0074;
// 586 P=1 ;! PARAMETER COUNT
P = 1;
// 587 Q=K ;! 'INSERT AFTER' POINTER
Q = K;
// 588 L64: R=NEWCELL ;! PUSHDOWN TAG FOR PARAMETER
U_1025:;
R = NEWCELL();
// 589 TAG(R)=PT(P)
TAG[R] = PT[P - 1];
// 590 LINK(R)=LINK(Q)
LINK[R] = LINK[Q];
// 591 PTC(P)=R ;! SAVE POINTER TO TAG CELL
PTC[P - 1] = R;
// 592 LINK(Q)=R
LINK[Q] = R;
// 593 Q=R ;! NEW VALUE FOR 'INSERT AFTER' POINTER
Q = R;
// 594 P=P+1 ;! PARAMETER COUNT
P = P + 1;
// 595 %IF P<=L %THEN ->L64 ;! MORE PARAMETERS YET
if (P > L) goto L_0075;
goto U_1025;
L_0075:;
// 596 %FINISH
L_0074:;
// 597 STORE TAG(K,4,I,L,LEVEL,BT NEXT) ;! PUSHDOWN TAG FOR NAME OF ROUTINE OR FN
STORETAG(K, 4, I, L, LEVEL, BTNEXT());
// 598 %IF LEVEL=0 %THEN BAT(BTN-1)=K+65536 ;! FLAG FOR EXTERNAL SPECS
if (LEVEL != 0) goto L_0076;
BAT[BTN - 1] = K + 65536;
L_0076:;
// 599 %FINISH %ELSE %START ;! NAME ALREADY SET AT THIS LEVEL
goto L_0077;
L_0073:;
// 600 %IF J=2 %AND TAG(N)>>28=4 %THEN %START ;! STATEMENT NOT A SPEC & FORM OF NAME IS RT
if (J != 2) goto L_0078;
if ((unsigned int)TAG[N] >> 28 != 4) goto L_0078;
// 601 %IF TAG(N)>>24&15\=I %THEN %START
if ((unsigned int)TAG[N] >> 24 & 15 == I) goto L_0079;
// 602 PRINT NAME(K)
PRINTNAME(K);
// 603 FAULT(M'RT N',M'OT A',M'S SP',M'EC ')
FAULT(1381245006, 1330913345, 1394627408, 1162027040);
// 604 %FINISH
L_0079:;
// 605 %IF BAT(TAG(N)&65535)>=0 %THEN %START
if (BAT[TAG[N] & 65535] < 0) goto L_007A;
// 606 PRINT NAME(K)
PRINTNAME(K);
// 607 FAULT(M'RT A',M'PPEA',M'RS T',M'WICE')
FAULT(1381244993, 1347437889, 1381179476, 1464419141);
// 608 %FINISH
L_007A:;
// 609 P=TAG(N)>>20&15 ;! NO OF PARAMS IN SPEC
P = (unsigned int)TAG[N] >> 20 & 15;
// 610 %IF L\=P %THEN %START
if (L == P) goto L_007B;
// 611 FAULT(M'PARS',M' NOT',M' AS ',M'SPEC')
FAULT(1346458195, 542003028, 541152032, 1397769539);
// 612 %IF L>P %THEN L=P ;! IGNORE SUPERFLUOUS PARAMS
if (L <= P) goto L_007C;
L = P;
L_007C:;
// 613 %FINISH
L_007B:;
// 614 %IF L>0 %THEN %START ;! PARAMS PRESENT
if (L <= 0) goto L_007D;
// 615 P=1 ;! PARAM COUNT
P = 1;
// 616 Q=LINK(N) ;! LINK TO TAG OF FIRST PARAM
Q = LINK[N];
// 617 L67: %IF PT(P)!TAG(Q)&15<<20\=TAG(Q) %THEN %START
U_1026:;
if (PT[P - 1] | TAG[Q] & 15 << 20 == TAG[Q]) goto L_007E;
// 618 PRINT NAME(PN(P))
PRINTNAME(PN[P - 1]);
// 619 FAULT(M'PAR ',M'NOT ',M'AS S',M'PEC ')
FAULT(1346458144, 1313821728, 1095966803, 1346716448);
// 620 %FINISH
L_007E:;
// 621 PTC(P)=Q ;! SAVE POINTER TO TAG CELL
PTC[P - 1] = Q;
// 622 P=P+1 ;! PARAM COUNT
P = P + 1;
// 623 Q=LINK(Q) ;! NEXT TAG CELL
Q = LINK[Q];
// 624 %IF P<=L %THEN ->L67 ;! MORE PARAMS
if (P > L) goto L_007F;
goto U_1026;
L_007F:;
// 625 %FINISH
L_007D:;
// 626 %FINISH %ELSE %START
goto L_0080;
L_0078:;
// 627 PRINT NAME(K)
PRINTNAME(K);
// 628 FAULT(M'NAME',M' SET',M' TWI',M'CE ')
FAULT(1312902469, 542328148, 542398281, 1128603680);
// 629 %FINISH
L_0080:;
// 630 %FINISH
L_0077:;
// 631 L68: %IF J=2 %THEN %START ;! STATEMENT NOT A SPEC
U_1027:;
if (J != 2) goto L_0081;
// 632 BRT(LEVEL)=BT NEXT ;! BRANCH ROUND ROUTINE OR FN
BRT[LEVEL] = BTNEXT();
// 633 DUMP('B',0,M'BT',BRT(LEVEL))
DUMP(66, 0, 16980, BRT[LEVEL]);
// 634 BAT(TAG(LINK(K))&65535)=CA ;! FILL IN ADDRESS OF THIS ROUTINE OR FN
BAT[TAG[LINK[K]] & 65535] = CA;
// 635 %IF LEVEL=15 %THEN FAULT(M'TOO ',M'MANY',M' LEV',M'ELS ') %C
if (LEVEL != 15) goto L_0082;
FAULT(1414483744, 1296125529, 541869398, 1162629920);
goto L_0083;
L_0082:;
LEVEL = LEVEL + 1;
L_0083:;
// 636+ %ELSE LEVEL=LEVEL+1 ;! NEXT TEXTUAL LEVEL
// 637 ENTER(I,M)
ENTER(I, M);
// 638 %IF L>0 %THEN %START ;! PARAMS PRESENT
if (L <= 0) goto L_0084;
// 639 P=1 ;! PARAM COUNT
P = 1;
// 640 L69: I=PT(P) ;! PUSHDOWN TAGS FOR PARAMS
U_1028:;
I = PT[P - 1];
// 641 %IF I>>28=3 %THEN STORE TAG(PN(P),3,1,0,LEVEL,PTC(P)) %C
if ((unsigned int)I >> 28 != 3) goto L_0085;
STORETAG(PN[P - 1], 3, 1, 0, LEVEL, PTC[P - 1]);
goto L_0086;
L_0085:;
STORETAG(PN[P - 1], (unsigned int)I >> 28, 1, 0, LEVEL, I & 65535);
L_0086:;
// 642+ %ELSE STORE TAG(PN(P),I>>28,1,0,LEVEL,I&65535) ;! TREAT ARRAYNAMES SPECIALLY
// 643 P=P+1
P = P + 1;
// 644 %IF P<=L %THEN ->L69 ;! MORE PARAMS YET
if (P > L) goto L_0087;
goto U_1028;
L_0087:;
// 645 %FINISH
L_0084:;
// 646 %FINISH
L_0081:;
// 647 %RETURN
return;
// 648 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 649 ! %END
// 650 L70: CHECK ;! CHECK LABELS & START/FINISH BLOCKS
U_101D:;
CHECK();
// 651 COT(STAR(LEVEL))=RAD(LEVEL) ;! STORE STATIC ALLOCATION FOR THIS LEVEL
COT[STAR[LEVEL]] = RAD[LEVEL];
// 652 UNSET ;! UNSET NAMES DECLARED AT THIS LEVEL
UNSET();
// 653 CHP=CHPP(LEVEL)
CHP = CHPP[LEVEL];
// 654 %IF RTP(LEVEL)\=0 %THEN DUMP(M'STOP',0,0,0) ;! %STOP FOR FNS
if (RTP[LEVEL] == 0) goto L_0088;
DUMP(1398034256, 0, 0, 0);
L_0088:;
// 655 RETURN ;! DUMP %RETURN CODE
RETURN();
// 656 LEVEL=LEVEL-1 ;! DECREMENT TEXTUAL LEVEL COUNT
LEVEL = LEVEL - 1;
// 657 %IF LEVEL<1 %THEN %START ;! NOT BACK AT OUTER LEVEL YET
if (LEVEL >= 1) goto L_0089;
// 658 FAULT(M'EXCE',M'SS %',M'END ',M' ')
FAULT(1163412293, 1397956645, 1162757152, 538976288);
// 659 ->L71 ; %FINISH ;! TREAT AS %ENDOFPROGRAM
goto U_1029;
L_0089:;
// 660 BAT(BRT(LEVEL))=CA ;! FILL ADDR FOR BRANCH ROUND ROUTINE/FN
BAT[BRT[LEVEL]] = CA;
// 661 %RETURN
return;
// 662 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 663 ! %BEGIN
// 664 L80: %IF LEVEL\=0 %THEN %START
U_101E:;
if (LEVEL == 0) goto L_008A;
// 665 FAULT(M'%BEG',M'IN E',M'XTRA',M' ') ;! NO INTERNAL BLOCKS ALLOWED
FAULT(625100103, 1229856837, 1481921089, 538976288);
// 666 %RETURN ; %FINISH
return;
L_008A:;
// 667 %IF CA\=0 %OR RAD(0)\=10 %THEN %START
if (CA != 0) goto L_008B;
if (RAD[0] == 10) goto L_008C;
L_008B:;
// 668 FAULT(M'%BEG',M'IN N',M'OT F',M'IRST')
FAULT(625100103, 1229856846, 1330913350, 1230132052);
// 669 %RETURN ; %FINISH
return;
L_008C:;
// 670 LEVEL=1 ;! TEXTUAL LEVEL COUNT TO 1
LEVEL = 1;
// 671 ENTER(-1,10)
ENTER(-1, 10);
// 672 %RETURN
return;
// 673 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 674 ! %ENDOFPROGRAM
// 675 L90: CHECK ;! CHECK LABELS & START/FINISHES
U_101F:;
CHECK();
// 676 COT(STAR(LEVEL))=RAD(LEVEL) ;! FILL IN STATIC ALLOCATION FOR OUTER BLOCK
COT[STAR[LEVEL]] = RAD[LEVEL];
// 677 UNSET ;! UNSET NAMES DECLARED AT THIS LEVEL
UNSET();
// 678 %IF LEVEL\=1 %THEN FAULT(M'TOO ',M'FEW ',M'%END',M'S ')
if (LEVEL == 1) goto L_008D;
FAULT(1414483744, 1178949408, 625299012, 1394614304);
L_008D:;
// 679 L71: DUMP(M'STOP',0,0,0) ;! %STOP
U_1029:;
DUMP(1398034256, 0, 0, 0);
// 680 PRINT SYMBOL('B') ;! PRINT OUT BRANCH TABLE
_imp_PRINTSYMBOL(66);
// 681 PRINT SYMBOL('T')
_imp_PRINTSYMBOL(84);
// 682 PRINT SYMBOL(':')
_imp_PRINTSYMBOL(58);
// 683 NEWLINE
_imp_NEWLINE();
// 684 CA=0
CA = 0;
// 685 L93: %IF CA\=BTN %THEN %START
U_102A:;
if (CA == BTN) goto L_008E;
// 686 DUMP('B',0,M'PRG',BAT(CA)) ;! BRANCH RELATIVE TO START OF PROGRAM
DUMP(66, 0, 5263943, BAT[CA]);
// 687 ->L93 ; %FINISH
goto U_102A;
L_008E:;
// 688 PRINT SYMBOL('C') ;! PRINT OUT CONSTANT TABLE
_imp_PRINTSYMBOL(67);
// 689 PRINT SYMBOL('T')
_imp_PRINTSYMBOL(84);
// 690 PRINT SYMBOL(':')
_imp_PRINTSYMBOL(58);
// 691 NEWLINE
_imp_NEWLINE();
// 692 I=0
I = 0;
// 693 L91: %IF I\=CTN %THEN %START
U_102B:;
if (I == CTN) goto L_008F;
// 694 WRITE(COT(I),10)
_imp_WRITE(COT[I], 10);
// 695 NEWLINE
_imp_NEWLINE();
// 696 I=I+1
I = I + 1;
// 697 ->L91 ; %FINISH
goto U_102B;
L_008F:;
// 698 PRINT SYMBOL(';')
_imp_PRINTSYMBOL(59);
// 699 WRITE(FAULTS,1) ;! NUMBER OF PROGRAM FAULTS
_imp_WRITE(FAULTS, 1);
// 700 FAULT(M' FAU',M'LTS ',M'IN P',M'ROGM')
FAULT(541475157, 1280594720, 1229856848, 1380927309);
// 701 %STOP
_imp_stop(0);
// 702 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 703 %ROUTINE UI
void UI(void) {
// 704 ! COMPILE UNCONDITIONAL INSTRUCTION
// 705 %INTEGER I,J,K,L
int I;
int J;
int K;
int L;
// 706 I=A(AP) ;! NEXT ANALYSIS RECORD ENTRY
I = A[AP - 1];
// 707 AP=AP+1
AP = AP + 1;
// 708 %IF I=1 %THEN ->L10 ;! ROUTINE CALL OR ASSIGNMENT STATEMENT
if (I != 1) goto L_0090;
goto U_102C;
L_0090:;
// 709 %IF I=2 %THEN ->L20 ;! JUMP INSTRUCTION
if (I != 2) goto L_0091;
goto U_102D;
L_0091:;
// 710 %IF I=3 %THEN ->L30 ;! %START
if (I != 3) goto L_0092;
goto U_102E;
L_0092:;
// 711 %IF I=4 %THEN ->L40 ;! %RETURN
if (I != 4) goto L_0093;
goto U_102F;
L_0093:;
// 712 %IF I=5 %THEN ->L50 ;! %RESULT=
if (I != 5) goto L_0094;
goto U_1030;
L_0094:;
// 713 DUMP(M'STOP',0,0,0) ;! %STOP
DUMP(1398034256, 0, 0, 0);
// 714 %RETURN
return;
// 715 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 716 ! NAME APP ASS
// 717 L10: I=LINK(A(AP)) ;! POINTER TO NAME TAGS
U_102C:;
I = LINK[A[AP - 1]];
// 718 %IF I=0 %THEN %START
if (I != 0) goto L_0095;
// 719 PRINT NAME(A(AP))
PRINTNAME(A[AP - 1]);
// 720 FAULT(M'NAME',M' NOT',M' SET',0)
FAULT(1312902469, 542003028, 542328148, 0);
// 721 %FINISH %ELSE I=TAG(I) ;! NAME TAGS OR ZERO TO AVOID DIAGNOSTICS
goto L_0096;
L_0095:;
I = TAG[I];
L_0096:;
// 722 J=AP ;! PRESERVE ANALYSIS RECORD POINTER
J = AP;
// 723 AP=AP+1 ;! AP ON <APP>
AP = AP + 1;
// 724 SKIP APP ;! SKIP TO <ASS>
SKIPAPP();
// 725 %IF A(AP)=2 %THEN %START ;! ROUTINE CALL
if (A[AP - 1] != 2) goto L_0097;
// 726 %IF I>>24=64 %THEN %START ;! 'FORM/TYPE' IS ROUTINE
if ((unsigned int)I >> 24 != 64) goto L_0098;
// 727 AP=J ;! RESTORE AP TO <NAME>
AP = J;
// 728 RT ;! CALL ROUTINE
RT();
// 729 %FINISH %ELSE %START
goto L_0099;
L_0098:;
// 730 %IF I\=0 %THEN %START
if (I == 0) goto L_009A;
// 731 PRINT NAME(A(J))
PRINTNAME(A[J - 1]);
// 732 FAULT(M'NOT ',M'ROUT',M'INE ',M'NAME')
FAULT(1313821728, 1380930900, 1229866272, 1312902469);
// 733 %FINISH
L_009A:;
// 734 %FINISH
L_0099:;
// 735 AP=AP+1 ;! AP AFTER <UI>
AP = AP + 1;
// 736 %RETURN ; %FINISH
return;
L_0097:;
// 737 K=I>>28 ;! 'FORM' OF NAME
K = (unsigned int)I >> 28;
// 738 %IF K=4 %THEN %START
if (K != 4) goto L_009B;
// 739 PRINT NAME(A(J))
PRINTNAME(A[J - 1]);
// 740 FAULT(M'NAME',M' NOT',M' A D',M'ESTN') ;! ROUTINE/FN FORM
FAULT(1312902469, 542003028, 541139012, 1163088974);
// 741 I=0 ;! CLEAR TAGS TO AVOID FURTHER DIAGNOSTIC
I = 0;
// 742 %FINISH
L_009B:;
// 743 AP=AP+1 ;! AP ON <+-\>
AP = AP + 1;
// 744 SEXPR
SEXPR();
// 745 %IF I=0 %THEN %RETURN ;! LHS NAME NOT SET
if (I != 0) goto L_009C;
return;
L_009C:;
// 746 %IF K>=2 %THEN %START ;! LHS AN ARRAY TYPE
if (K < 2) goto L_009D;
// 747 DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! PRESERVE ACCUMMULATOR
DUMP(5461074, 4277059, BR[LEVEL], WSNEXT());
// 748 K=AP ;! PRESERVE AP
K = AP;
// 749 AP=J ;! RESTORE INITIALANAL REC POINTER
AP = J;
// 750 ARRAD ;! CALCULATE ARRAY ELEMENT ADDRESS
ARRAD();
// 751 WS=WS-1 ;! RESTORE WORKSPACE POINTER
WS = WS - 1;
// 752 DUMP(M'LOAD',M'WK',BR(LEVEL),WS) ;! RESTORE ACCUMMULATOR
DUMP(1280262468, 22347, BR[LEVEL], WS);
// 753 DUMP(M'STR',M'WK',M'ACC',0) ;! DUMP ASSIGNMENT
DUMP(5461074, 22347, 4277059, 0);
// 754 AP=K ;! RESTORE AP TO AFTER <UI>
AP = K;
// 755 %RETURN ; %FINISH
return;
L_009D:;
// 756 %IF K=1 %THEN %START
if (K != 1) goto L_009E;
// 757 DUMP(M'LOAD',M'WK',BR(I>>16&15),I&65535);! INDIRECT ASSIGMENT
DUMP(1280262468, 22347, BR[(unsigned int)I >> 16 & 15], I & 65535);
// 758 DUMP(M'STR',M'ACC',M'WK',0)
DUMP(5461074, 4277059, 22347, 0);
// 759 %FINISH %ELSE DUMP(M'STR',M'ACC',BR(I>>16&15),I&65535)
goto L_009F;
L_009E:;
DUMP(5461074, 4277059, BR[(unsigned int)I >> 16 & 15], I & 65535);
L_009F:;
// 760 %IF A(J+1)=1 %THEN %START
if (A[J + 1 - 1] != 1) goto L_00A0;
// 761 PRINT NAME(A(J))
PRINTNAME(A[J - 1]);
// 762 FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM')
FAULT(1396916556, 1095901256, 1095966800, 1095909709);
// 763 %FINISH
L_00A0:;
// 764 %RETURN
return;
// 765 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 766 ! -> CONST
// 767 L20: DUMP('B',0,M'BT',FIND LABEL) ;! SCAN/INSERT JUMP LIST AND DUMP JUMP
U_102D:;
DUMP(66, 0, 16980, FINDLABEL());
// 768 %RETURN
return;
// 769 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 770 ! %START
// 771 L30: FAULT(M'%STA',M'RT ?',M' ',M' ') ;! %START ALONE SHOULD NOT BE A SOURCE STATEMENT
U_102E:;
FAULT(626218049, 1381244991, 538976288, 538976288);
// 772 %RETURN
return;
// 773 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 774 ! %RETURN
// 775 L40: %IF RTP(LEVEL)\=0 %THEN FAULT(M'%RET',M'URN ',M'CONT',M'EXT ')
U_102F:;
if (RTP[LEVEL] == 0) goto L_00A1;
FAULT(626148692, 1431457312, 1129270868, 1163416608);
L_00A1:;
// 776 RETURN ;! DUMP %RETURN CODE - INCORRECT FOR FN
RETURN();
// 777 %RETURN
return;
// 778 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 779 ! %RESULT=
// 780 L50: I=RTP(LEVEL) ;! ROUTINE/FN TYPE
U_1030:;
I = RTP[LEVEL];
// 781 %IF I<=0 %THEN FAULT(M'%RES',M'ULT ',M'CONT',M'EXT ') ;! %BEGIN/%ROUTINE
if (I > 0) goto L_00A2;
FAULT(626148691, 1431065632, 1129270868, 1163416608);
L_00A2:;
// 782 SEXPR ;! COMPILE RESULT EXPRESSION
SEXPR();
// 783 RETURN ;! LEAVE RESULT IN ACC & DUMP RETURN CODE
RETURN();
// 784 %END
return;
} /* end of UI */
// ?L unused
// 785 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 786 %ROUTINE SEXPR
void SEXPR(void) {
auto void TORP(void);
auto void PSEVAL(void);
auto void EVAL(int P);
// 787 ! COMPILE ARITHMETIC EXPRESSION
// 788 %ROUTINESPEC TORP
// 789 %ROUTINESPEC PSEVAL
// 790 %ROUTINESPEC EVAL(%INTEGER P)
// 791 %INTEGER RPP,APP
int RPP;
int APP;
// 792 %INTEGERARRAY RP,PT(1:32) ;! REVERSE POLISH, POINTER/TYPE ARRAYS
int RP[32];
int PT[32];
// 793 RPP=1 ;! RP POINTER
RPP = 1;
// 794 TORP ;! EXPR TO REV POLISH
TORP();
// 795 %IF SCF=1 %THEN %START ;! PART OF A SIMPLE CONDITION
if (SCF != 1) goto L_00A3;
// 796 SCF=0 ;! RESET FLAG
SCF = 0;
// 797 COMP=A(AP) ;! COMPARATOR NUMBER
COMP = A[AP - 1];
// 798 %IF A(AP+3)=0 %AND A(AP+4)=2 %THEN AP=AP+5 %ELSE %START
if (A[AP + 3 - 1] != 0) goto L_00A4;
if (A[AP + 4 - 1] != 2) goto L_00A4;
AP = AP + 5;
goto L_00A5;
L_00A4:;
// 799 AP=AP+1 ;! 2ND EXPR NON-ZERO
AP = AP + 1;
// 800 TORP ;! 2ND EXPRESSION TO REVERSE POLISH
TORP();
// 801 RP(RPP)=10 ;! CODE FOR '-' I.E. (1ST-2ND)
RP[RPP - 1] = 10;
// 802 PT(RPP)=1 ;! FLAG=OPERATOR
PT[RPP - 1] = 1;
// 803 RPP=RPP+1 ;! INCREMENT RP POINTER
RPP = RPP + 1;
// 804 %FINISH
L_00A5:;
// 805 %FINISH
L_00A3:;
// 806 APP=AP ;! SAVE FINAL ANAL REC POINTER
APP = AP;
// 807 PSEVAL ;! PSEUDO-EVALUATE EXPRESSION
PSEVAL();
// 808 EVAL(RPP-1) ;! DUMP CODE FOR EXPR EVALUATION
EVAL(RPP - 1);
// 809 AP=APP ;! RESTORE FINAL ANAL REC POINTER
AP = APP;
// 810 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 811 %ROUTINE TORP
void TORP(void) {
auto void STORE(int I, int J);
// 812 ! TRANSFORM EXPRESSION TO REVERSE POLISH
// 813 %ROUTINESPEC STORE(%INTEGER I,J)
// 814 %INTEGERARRAY OP(1:4)
int OP[4];
// 815 %INTEGER OPP,I
int OPP;
int I;
// 816 OPP=0 ;! OPERATOR STACK POINTER
OPP = 0;
// 817 I=A(AP) ;! <+-\>
I = A[AP - 1];
// 818 AP=AP+1
AP = AP + 1;
// 819 %IF I=1 %OR I=4 %THEN ->L1 ;! + OR NULL
if (I == 1) goto L_00A6;
if (I != 4) goto L_00A7;
L_00A6:;
goto U_1031;
L_00A7:;
// 820 I=I+9 ;! CODES FOR - & \
I = I + 9;
// 821 L3: OPP=OPP+1 ;! STACK OPERATOR
U_1032:;
OPP = OPP + 1;
// 822 OP(OPP)=I
OP[OPP - 1] = I;
// 823 L1: I=A(AP) ;! <OPD>
U_1031:;
I = A[AP - 1];
// 824 %IF I=3 %THEN %START ;! SUB-EXPRESSION
if (I != 3) goto L_00A8;
// 825 AP=AP+1 ;! AP TO <+-\>
AP = AP + 1;
// 826 TORP ;! TRANSFORM SUB-EXPR TO REV POL
TORP();
// 827 %FINISH %ELSE %START
goto L_00A9;
L_00A8:;
// 828 STORE(AP,0) ;! STORE ANAL REC POSITION OF OPERAND
STORE(AP, 0);
// 829 AP=AP+2 ;! AP ON <APP> OR AFTER <CNST>
AP = AP + 2;
// 830 %IF I=1 %THEN SKIP APP ;! OPERAND A NAME
if (I != 1) goto L_00AA;
SKIPAPP();
L_00AA:;
// 831 %FINISH
L_00A9:;
// 832 %IF A(AP)=2 %THEN %START ;! END OF <EXPR>
if (A[AP - 1] != 2) goto L_00AB;
// 833 AP=AP+1 ;! AP AFTER EXPRESSION
AP = AP + 1;
// 834 L2: %IF OPP=0 %THEN %RETURN ;! OPERATOR STACK EMPTIED
U_1033:;
if (OPP != 0) goto L_00AC;
return;
L_00AC:;
// 835 STORE(OP(OPP),1) ;! UNSTACK REMAINING OPERATORS
STORE(OP[OPP - 1], 1);
// 836 OPP=OPP-1
OPP = OPP - 1;
// 837 ->L2 ; %FINISH
goto U_1033;
L_00AB:;
// 838 I=A(AP+1) ;! <OP>
I = A[AP + 1 - 1];
// 839 AP=AP+2 ;! AP ON <EXPR>
AP = AP + 2;
// 840 L4: %IF OPP=0 %OR PREC(I)>PREC(OP(OPP)) %THEN ->L3 ;! OP STACK EMPTY OR NEW OP HIGHER PREC
U_1034:;
if (OPP == 0) goto L_00AD;
if (PREC[I - 1] <= PREC[OP[OPP - 1] - 1]) goto L_00AE;
L_00AD:;
goto U_1032;
L_00AE:;
// 841 STORE(OP(OPP),1) ;! UNSTACK TOP OPERATOR
STORE(OP[OPP - 1], 1);
// 842 OPP=OPP-1
OPP = OPP - 1;
// 843 ->L4
goto U_1034;
// 844 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 845 %ROUTINE STORE(%INTEGER I,J)
void STORE(int I, int J) {
// 846 ! STORE IN RP & PT ARRAYS, I=ANAL REC PTR , J= OP/OPD FLAG
// 847 %IF RPP>32 %THEN %START ;! REV POL ARRAY FULL
if (RPP <= 32) goto L_00AF;
// 848 FAULT(M'EXPR',M' TOO',M' LON',M'G ')
FAULT(1163415634, 542396239, 541871950, 1193287712);
// 849 RPP=1 ;! IN ORDER TO CONTINUE
RPP = 1;
// 850 %FINISH
L_00AF:;
// 851 RP(RPP)=I ;! STORE OP/OPD
RP[RPP - 1] = I;
// 852 PT(RPP)=J ;! STORE FLAG
PT[RPP - 1] = J;
// 853 RPP=RPP+1 ;! NEXT POSITION
RPP = RPP + 1;
// 854 %END
return;
} /* end of STORE */
// 855 %END
return;
} /* end of TORP */
// 856 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 857 %ROUTINE PSEVAL
void PSEVAL(void) {
// 858 ! PSEUDO-EVALUATION, CHECKING OPERANDS
// 859 %INTEGERARRAY PST(1:32) ;! OPERAND POINTER STACK
int PST[32];
// 860 %INTEGER PSTP,I,J,K
int PSTP;
int I;
int J;
int K;
// 861 PSTP=0 ;! PST POINTER
PSTP = 0;
// 862 I=1 ;! REV POL ARRAY POINTER
I = 1;
// 863 L3: AP=RP(I) ;! ANAL REC POSITION OF OPERAND
U_1032:;
AP = RP[I - 1];
// 864 %IF A(AP)=1 %THEN %START ;! OPERAND A NAME
if (A[AP - 1] != 1) goto L_00B0;
// 865 J=LINK(A(AP+1)) ;! LINK TO TAG OF NAME
J = LINK[A[AP + 1 - 1]];
// 866 %IF J=0 %THEN %START
if (J != 0) goto L_00B1;
// 867 PRINT NAME(A(AP+1))
PRINTNAME(A[AP + 1 - 1]);
// 868 FAULT(M'NAME',M' NOT',M' SET',0)
FAULT(1312902469, 542003028, 542328148, 0);
// 869 K=0 ;! DUMMY TAG VALUE
K = 0;
// 870 ->L1 ; %FINISH
goto U_1033;
L_00B1:;
// 871 K=TAG(J) ;! TAG OF NAME
K = TAG[J];
// 872 J=K>>28 ;! 'FORM' OF NAME
J = (unsigned int)K >> 28;
// 873 %IF J>1 %THEN %START ;! ARRAY OR ROUTINE/FN TYPE
if (J <= 1) goto L_00B2;
// 874 RP(I)=AP+1 ;! STORE ANAL REC POSITION OF <NAME>
RP[I - 1] = AP + 1;
// 875 %IF J=4 %THEN %START ;! NAME IS ROUTINE/FN TYPE
if (J != 4) goto L_00B3;
// 876 %IF K>>24&15=0 %THEN %START
if ((unsigned int)K >> 24 & 15 != 0) goto L_00B4;
// 877 PRINT NAME(A(AP+1))
PRINTNAME(A[AP + 1 - 1]);
// 878 FAULT(M'RT N',M'AME ',M'IN E',M'XPR ')
FAULT(1381245006, 1095583008, 1229856837, 1481658912);
// 879 K=0 ;! DUMMY TAG VALUE
K = 0;
// 880 ->L1 ; %FINISH
goto U_1033;
L_00B4:;
// 881 PT(I)=-1 ;! FLAG FOR FUNCTION
PT[I - 1] = -1;
// 882 %FINISH %ELSE PT(I)=-2 ;! FLAG FOR ARRAY
goto L_00B5;
L_00B3:;
PT[I - 1] = -2;
L_00B5:;
// 883 ->L2 ; %FINISH ;! GO TO STACK POINTER
goto U_1034;
L_00B2:;
// 884 %IF A(AP+2)=1 %THEN %START
if (A[AP + 2 - 1] != 1) goto L_00B6;
// 885 PRINT NAME(A(AP+1))
PRINTNAME(A[AP + 1 - 1]);
// 886 FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM')
FAULT(1396916556, 1095901256, 1095966800, 1095909709);
// 887 %FINISH
L_00B6:;
// 888 L1: RP(I)=K ;! STORE TAG OF NAME FOR SCALARS
U_1033:;
RP[I - 1] = K;
// 889 PT(I)=-3 ;! FLAG FOR SCALARS
PT[I - 1] = -3;
// 890 %FINISH %ELSE %START ;! OPERAND IS A <CNST>
goto L_00B7;
L_00B0:;
// 891 RP(I)=A(AP+1) ;! STORE VALUE OF CONSTANT
RP[I - 1] = A[AP + 1 - 1];
// 892 PT(I)=-4 ;! FLAG FOR CONSTANTS
PT[I - 1] = -4;
// 893 %FINISH
L_00B7:;
// 894 L2: PSTP=PSTP+1 ;! STACK OPERAND POINTER
U_1034:;
PSTP = PSTP + 1;
// 895 L4: PST(PSTP)=I
U_1035:;
PST[PSTP - 1] = I;
// 896 I=I+1 ;! REV POL ARRAY POINTER
I = I + 1;
// 897 %IF I<RPP %THEN %START ;! NOT END OF REV POL YET
if (I >= RPP) goto L_00B8;
// 898 %IF PT(I)=0 %THEN ->L3 ;! AN OPERAND IS NEXT
if (PT[I - 1] != 0) goto L_00B9;
goto U_1032;
L_00B9:;
// 899 %IF RP(I)<=10 %THEN %START ;! BINARY OPERATORS
if (RP[I - 1] > 10) goto L_00BA;
// 900 PSTP=PSTP-1 ;! PSEUDO-EVALUATE POINTERS
PSTP = PSTP - 1;
// 901 PT(I)=PST(PSTP) ;! STACK POINTER TO RESULT
PT[I - 1] = PST[PSTP - 1];
// 902 %FINISH
L_00BA:;
// 903 ->L4 ; %FINISH
goto U_1035;
L_00B8:;
// 904 %END
return;
} /* end of PSEVAL */
// 905 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 906 %ROUTINE EVAL(%INTEGER P)
void EVAL(int P) {
auto void OPN(int OP, int L);
// 907 ! DUMP CODE FOR EVALUATION OF EXPRESSION
// 908 %ROUTINESPEC OPN(%INTEGER OP,L)
// 909 %INTEGER I,J,K
int I;
int J;
int K;
// 910 I=PT(P) ;! POINTER/TYPE OF LAST REV POL ENTRY
I = PT[P - 1];
// 911 %IF I<0 %THEN %START ;! OPERAND
if (I >= 0) goto L_00BB;
// 912 OPN(0,P) ;! LOAD OPERAND
OPN(0, P);
// 913 %RETURN ; %FINISH
return;
L_00BB:;
// 914 J=RP(P) ;! OPERATOR
J = RP[P - 1];
// 915 K=P-1 ;! START OF 2ND OPERAND
K = P - 1;
// 916 %IF UCN(J)=1 %THEN %START ;! UNARY OPERATOR
if (UCN[J - 1] != 1) goto L_00BC;
// 917 %IF PT(K)>=-2 %THEN EVAL(K) %ELSE OPN(0,K) ;! EVAL IF NODE OTHERWISE LOAD OPERAND
if (PT[K - 1] < -2) goto L_00BD;
EVAL(K);
goto L_00BE;
L_00BD:;
OPN(0, K);
L_00BE:;
// 918 DUMP(OPR(J),M'ACC',0,0) ;! DUMP UNARY OPERATION
DUMP(OPR[J], 4277059, 0, 0);
// 919 %RETURN ; %FINISH
return;
L_00BC:;
// 920 %IF PT(I)>=-2 %THEN %START ;! FIRST OPERAND A NODE
if (PT[I - 1] < -2) goto L_00BF;
// 921 %IF PT(K)>=-2 %THEN %START ;! SECOND OPERAND A NODE
if (PT[K - 1] < -2) goto L_00C0;
// 922 EVAL(K) ;! EVALUATE 2ND OPERAND
EVAL(K);
// 923 DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! & STORE IT IN WORKSPACE
DUMP(5461074, 4277059, BR[LEVEL], WSNEXT());
// 924 EVAL(I) ;! EVALUATE 1ST OPERAND
EVAL(I);
// 925 WS=WS-1 ;! RESTORE WORKSPACE POINTER
WS = WS - 1;
// 926 DUMP(OPR(J),M'ACC',BR(LEVEL),WS) ;! DUMP OPERATION
DUMP(OPR[J], 4277059, BR[LEVEL], WS);
// 927 %FINISH %ELSE %START ;! 2ND OPERAND NOT A NODE
goto L_00C1;
L_00C0:;
// 928 EVAL(I) ;! EVALUATE 1ST OPERAND
EVAL(I);
// 929 OPN(J,K) ;! OPERATION WITH 2ND OPERAND
OPN(J, K);
// 930 %FINISH
L_00C1:;
// 931 %FINISH %ELSE %START ;! 1ST OPERAND NOT A NODE
goto L_00C2;
L_00BF:;
// 932 %IF PT(K)>=-2 %THEN %START ;! 2ND OPERAND A NODE
if (PT[K - 1] < -2) goto L_00C3;
// 933 EVAL(K) ;! EVALUATE 2ND OPERAND
EVAL(K);
// 934 %IF UCN(J)=2 %THEN %START ;! OPERATOR IS COMMUTATIVE
if (UCN[J - 1] != 2) goto L_00C4;
// 935 OPN(J,I) ;! OPERATION WITH 1ST OPERAND
OPN(J, I);
// 936 %RETURN ; %FINISH
return;
L_00C4:;
// 937 DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! STORE VALUE OF 2ND OPERAND IN WORKSPACE
DUMP(5461074, 4277059, BR[LEVEL], WSNEXT());
// 938 OPN(0,I) ;! LOAD 1ST OPERAND
OPN(0, I);
// 939 WS=WS-1 ;! RESTORE WORKSPACE POINTER
WS = WS - 1;
// 940 DUMP(OPR(J),M'ACC',BR(LEVEL),WS) ;! DUMP OPERATION WITH 2ND OPERAND
DUMP(OPR[J], 4277059, BR[LEVEL], WS);
// 941 %FINISH %ELSE %START ;! 2ND OPERAND NOT A NODE
goto L_00C5;
L_00C3:;
// 942 OPN(0,I) ;! LOAD 1ST OPERAND
OPN(0, I);
// 943 OPN(J,K) ;! OPERATION WITH 2ND OPERAND
OPN(J, K);
// 944 %FINISH
L_00C5:;
// 945 %FINISH
L_00C2:;
// 946 %RETURN
return;
// 947 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 948 %ROUTINE OPN(%INTEGER OP,L)
void OPN(int OP, int L) {
// 949 ! DUMP SIMPLE OPERATION, OP=OPERATOR, L=RP POSITION OF OPERAND
// 950 %INTEGER I,J
int I;
int J;
// 951 I=PT(L) ;! KIND OF OPERAND
I = PT[L - 1];
// 952 AP=RP(L) ;! ANAL REC POINTER OR NAME TAGS
AP = RP[L - 1];
// 953 %IF I=-1 %THEN %START ;! ROUTINE/FN TYPE
if (I != -1) goto L_00C6;
// 954 RT ;! DUMP CALL ON FUNCTION
RT();
// 955 %RETURN ; %FINISH
return;
L_00C6:;
// 956 %IF I=-2 %THEN %START ;! ARRAY ACCESS
if (I != -2) goto L_00C7;
// 957 ARRAD ;! CALCULATE ARRAY ELEMENT ADDRESS
ARRAD();
// 958 DUMP(M'LOAD',M'ACC',M'ACC',0) ;! LOAD VALUE
DUMP(1280262468, 4277059, 4277059, 0);
// 959 %RETURN ; %FINISH
return;
L_00C7:;
// 960 %IF I=-3 %THEN %START ;! SCALAR TYPE
if (I != -3) goto L_00C8;
// 961 %IF AP>>28=1 %THEN %START ;! %NAME TYPE
if ((unsigned int)AP >> 28 != 1) goto L_00C9;
// 962 DUMP(M'LOAD',M'WK',BR(AP>>16&15),AP&65535) ;! LOAD INDIRECT
DUMP(1280262468, 22347, BR[(unsigned int)AP >> 16 & 15], AP & 65535);
// 963 DUMP(OPR(OP),M'ACC',M'WK',0)
DUMP(OPR[OP], 4277059, 22347, 0);
// 964 %FINISH %ELSE DUMP(OPR(OP),M'ACC',BR(AP>>16&15),AP&65535)
goto L_00CA;
L_00C9:;
DUMP(OPR[OP], 4277059, BR[(unsigned int)AP >> 16 & 15], AP & 65535);
L_00CA:;
// 965 %RETURN ; %FINISH
return;
L_00C8:;
// 966 %IF OP\=0 %OR AP>65535 %THEN %START ;! CONSTANT NOT 'LDA'-ABLE
if (OP != 0) goto L_00CB;
if (AP <= 65535) goto L_00CC;
L_00CB:;
// 967 J=CT NEXT ;! NEXT HOLE IN CONSTANT TABLE
J = CTNEXT();
// 968 COT(J)=AP ;! STORE VALUE
COT[J] = AP;
// 969 DUMP(OPR(OP),M'ACC',M'CT',J)
DUMP(OPR[OP], 4277059, 17236, J);
// 970 %FINISH %ELSE DUMP(M'LDA',M'ACC',0,AP)
goto L_00CD;
L_00CC:;
DUMP(4998209, 4277059, 0, AP);
L_00CD:;
// 971 %END
return;
} /* end of OPN */
// 972 %END
return;
} /* end of EVAL */
// 973 %END
return;
} /* end of SEXPR */
// 974 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 975 %ROUTINE SKIP SEXPR
void SKIPSEXPR(void) {
// 976 ! SKIP PAST <+-\><OPD><EXPR> IN ANALYSIS RECORD, AP INITIALLY ON <+-\>
// 977 L1: AP=AP+2 ;! AP ON <OPD>+1
U_1036:;
AP = AP + 2;
// 978 %IF A(AP-1)=3 %THEN SKIP SEXPR %ELSE %START ;! SKIP SUB-EXPR ELSE <NAME> OR <CNST>
if (A[AP - 1 - 1] != 3) goto L_00CE;
SKIPSEXPR();
goto L_00CF;
L_00CE:;
// 979 AP=AP+1 ;! AP ON <APP> OR AFTER <CNST>
AP = AP + 1;
// 980 %IF A(AP-2)=1 %THEN SKIP APP ;! OPERAND IS A NAME
if (A[AP - 2 - 1] != 1) goto L_00D0;
SKIPAPP();
L_00D0:;
// 981 %FINISH
L_00CF:;
// 982 AP=AP+1 ;! AP AFTER <EXPR>
AP = AP + 1;
// 983 %IF A(AP-1)=1 %THEN ->L1 ;! MORE OPERANDS
if (A[AP - 1 - 1] != 1) goto L_00D1;
goto U_1036;
L_00D1:;
// 984 %END
return;
} /* end of SKIPSEXPR */
// 985 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 986 %ROUTINE SKIP APP
void SKIPAPP(void) {
// 987 ! SKIP PAST <APP> IN ANALYSIS RECORD
// 988 L1: AP=AP+1 ;! POINTER TO <APP>+1 OR <EXPS>+1
U_1036:;
AP = AP + 1;
// 989 %IF A(AP-1)=1 %THEN %START ;! EXPRESSIONS TO SKIP
if (A[AP - 1 - 1] != 1) goto L_00D2;
// 990 SKIP SEXPR
SKIPSEXPR();
// 991 ->L1 ; %FINISH
goto U_1036;
L_00D2:;
// 992 %END
return;
} /* end of SKIPAPP */
// 993 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 994 %ROUTINE SCCOND(%INTEGERNAME LABEL)
void SCCOND(int *LABEL) {
auto void SC(void);
auto void COND(void);
auto void STORE(int FT);
// 995 ! COMPILE CONDITION I.E. <SC><COND>, LABEL SET FOR POSITION AFTER UI
// 996 %ROUTINESPEC SC
// 997 %ROUTINESPEC COND
// 998 %ROUTINESPEC STORE(%INTEGER FT)
// 999 %INTEGER I,J,K,L,APP
int I;
int J;
int K;
int L;
int APP;
// 1000 %INTEGERARRAY CAP,LVL,TF,JMP,LBL(1:16) ;! ANAL REC POINTERS, NESTING LEVEL,
int CAP[16];
int LVL[16];
int TF[16];
int JMP[16];
int LBL[16];
// 1001 ;! TRUE/FALSE, JUMP & LABEL ARRAYS
// 1002 I=1 ;! INDEX TO ARRAYS
I = 1;
// 1003 L=0 ;! NESTING LEVEL
L = 0;
// 1004 SC ;! PROCESS <SC>
SC();
// 1005 COND ;! PROCESS <COND>
COND();
// 1006 APP=AP ;! PRESERVE FINAL ANAL REC POINTER
APP = AP;
// 1007 L=-1
L = -1;
// 1008 STORE(1) ;! PSEUDO-FALSE AT LEVEL -1
STORE(1);
// 1009 L=-2
L = -2;
// 1010 STORE(2) ;! PSEUDO-TRUE AT LEVEL -2
STORE(2);
// 1011 K=I-1 ;! LAST POSITION FILLED IN IN ARRAYS
K = I - 1;
// 1012 I=1
I = 1;
// 1013 L2: J=I ;! FIND POSITIONS TO JUMP TO
U_1034:;
J = I;
// 1014 L1: J=J+1 ;! AFTER COMPARISONS
U_1035:;
J = J + 1;
// 1015 %IF LVL(J)>=LVL(I) %OR TF(J)=TF(I) %THEN ->L1 ;! SKIP HIGHER LEVELS ETC
if (LVL[J - 1] >= LVL[I - 1]) goto L_00D3;
if (TF[J - 1] != TF[I - 1]) goto L_00D4;
L_00D3:;
goto U_1035;
L_00D4:;
// 1016 JMP(I)=J ;! JUMP TO COMPARISON POSITION J
JMP[I - 1] = J;
// 1017 I=I+1
I = I + 1;
// 1018 %IF I<K %THEN ->L2 ;! MORE JUMPS TO FILL IN YET
if (I >= K) goto L_00D5;
goto U_1034;
L_00D5:;
// 1019 %IF A(AP)\=2 %THEN ->L3 ;! UI NOT A JUMP INSTRUCTION
if (A[AP - 1] == 2) goto L_00D6;
goto U_1037;
L_00D6:;
// 1020 AP=AP+1 ;! TO <CONST>
AP = AP + 1;
// 1021 J=K-1 ;! LAST POSITION FILLED IN
J = K - 1;
// 1022 TF(J)=2 ;! SET AS 'TRUE'
TF[J - 1] = 2;
// 1023 JMP(J)=J ;! SET JUMP AS THE UI JUMP
JMP[J - 1] = J;
// 1024 LBL(J)=FIND LABEL ;! FILL IN BRANCH TABLE POSITION
LBL[J - 1] = FINDLABEL();
// 1025 L3: I=1 ;! FILL IN PSEUDO-LABELS FOR INNER JUMPS
U_1037:;
I = 1;
// 1026 L4: %IF LBL(JMP(I))<0 %THEN LBL(JMP(I))=BT NEXT ;! NEXT BAT POSITION
U_1038:;
if (LBL[JMP[I - 1] - 1] >= 0) goto L_00D7;
LBL[JMP[I - 1] - 1] = BTNEXT();
L_00D7:;
// 1027 I=I+1
I = I + 1;
// 1028 %IF I<K %THEN ->L4 ;! MORE TO FILL IN
if (I >= K) goto L_00D8;
goto U_1038;
L_00D8:;
// 1029 I=1
I = 1;
// 1030 L7: AP=CAP(I) ;! ANAL REC POINTER FOR 1ST EXPR OF COMP
U_1039:;
AP = CAP[I - 1];
// 1031 SCF=1 ;! SET FLAG FOR SEXPR
SCF = 1;
// 1032 SEXPR ;! TO EVALUATE (1ST - 2ND)
SEXPR();
// 1033 %IF TF(I)=1 %THEN L=FALSE(COMP) %ELSE L=TRUE(COMP)
if (TF[I - 1] != 1) goto L_00D9;
L = FALSE[COMP - 1];
goto L_00DA;
L_00D9:;
L = TRUE[COMP - 1];
L_00DA:;
// 1034 DUMP(L,M'ACC',M'BT',LBL(JMP(I))) ;! BRANCH TO REQUIRED POSITION
DUMP(L, 4277059, 16980, LBL[JMP[I - 1] - 1]);
// 1035 %IF LBL(I)>=0 %AND (I\=K-1 %OR TF(I)=1) %THEN BAT(LBL(I))=CA
if (LBL[I - 1] < 0) goto L_00DB;
if (I != K - 1) goto L_00DC;
if (TF[I - 1] != 1) goto L_00DB;
L_00DC:;
BAT[LBL[I - 1]] = CA;
L_00DB:;
// 1036 I=I+1 ;! FILL IN LABEL ADDRESS
I = I + 1;
// 1037 %IF I<K %THEN ->L7 ;! MORE COMPARISONS YET
if (I >= K) goto L_00DD;
goto U_1039;
L_00DD:;
// 1038 LABEL=LBL(K) ;! FINAL LABEL
*LABEL = LBL[K - 1];
// 1039 AP=APP ;! FINAL ANALYSIS RECORD POINTER
AP = APP;
// 1040 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 1041 %ROUTINE STORE(%INTEGER FT)
void STORE(int FT) {
// 1042 ! STORE LEVEL & TRUE/FALSE FLAG
// 1043 %IF I>16 %THEN %START ;! ARRAYS FULL
if (I <= 16) goto L_00DE;
// 1044 FAULT(M'COND',M'N TO',M'O LO',M'NG ')
FAULT(1129270852, 1310741583, 1327516751, 1313284128);
// 1045 I=1 ;! TO CONTINUE
I = 1;
// 1046 %FINISH
L_00DE:;
// 1047 LVL(I)=L ;! SAVE NESTING LEVEL
LVL[I - 1] = L;
// 1048 TF(I)=FT ;! SAVE TRUE/FALSE FLAG
TF[I - 1] = FT;
// 1049 LBL(I)=-1 ;! SET 'LABEL NOT FILLED IN YET' FLAG
LBL[I - 1] = -1;
// 1050 I=I+1 ;! NEXT ARRAY POSITION
I = I + 1;
// 1051 %END
return;
} /* end of STORE */
// 1052 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 1053 %ROUTINE SC
void SC(void) {
// 1054 AP=AP+1
AP = AP + 1;
// 1055 %IF A(AP-1)=2 %THEN %START
if (A[AP - 1 - 1] != 2) goto L_00DF;
// 1056 L=L+1 ;! NESTING LEVEL UP 1 FOR SUB-CONDITION
L = L + 1;
// 1057 SC ;! PROCESS SUB-<SC>
SC();
// 1058 COND ;! PROCESS SUB-<COND>
COND();
// 1059 L=L-1 ;! NESTING LEVEL DOWN AFTER SUB-CONDITION
L = L - 1;
// 1060 %FINISH %ELSE %START
goto L_00E0;
L_00DF:;
// 1061 CAP(I)=AP ;! ANAL REC POINTER FOR SIMPLE COMPARISON
CAP[I - 1] = AP;
// 1062 SKIP SEXPR ;! SKIP 1ST EXPR OF COMPARISON
SKIPSEXPR();
// 1063 AP=AP+1 ;! SKIP COMPARATOR
AP = AP + 1;
// 1064 SKIP SEXPR ;! SKIP 2ND EXPR
SKIPSEXPR();
// 1065 %FINISH
L_00E0:;
// 1066 %END
return;
} /* end of SC */
// 1067 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 1068 %ROUTINE COND
void COND(void) {
// 1069 ! PROCESS <COND> FOR SIMPLE COMPARISONS
// 1070 %INTEGER I
int I;
// 1071 I=A(AP) ;! <COND>
I = A[AP - 1];
// 1072 AP=AP+1 ;! AP ON <SC>
AP = AP + 1;
// 1073 %IF I\=3 %THEN %START ;! NOT NULL ALTERNATIVE OF <COND>
if (I == 3) goto L_00E1;
// 1074 L1: STORE(I) ;! SAVE %AND OR %OR TYPE OF CONDITION
U_103A:;
STORE(I);
// 1075 SC ;! PROCESS <SC>
SC();
// 1076 AP=AP+1 ;! POINTER ON <ANDC>+1 OR <ORC>+1
AP = AP + 1;
// 1077 %IF A(AP-1)=1 %THEN ->L1 ;! MORE %ANDS OR %ORS
if (A[AP - 1 - 1] != 1) goto L_00E2;
goto U_103A;
L_00E2:;
// 1078 %FINISH
L_00E1:;
// 1079 %END
return;
} /* end of COND */
// 1080 %END
return;
} /* end of SCCOND */
// 1081 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1082 %ROUTINE CHECK
void CHECK(void) {
// 1083 ! CHECK LABELS ALL SET & STARTS MATCH FINISHES
// 1084 %INTEGER I,J
int I;
int J;
// 1085 I=JUMP(LEVEL) ;! POINTER TO JUMP LIST FOR THIS LEVEL
I = JUMP[LEVEL];
// 1086 L1: %IF I\=0 %THEN %START ;! NO LABELS OR JUMPS USED AT THIS LEVEL
U_103B:;
if (I == 0) goto L_00E3;
// 1087 %IF BAT(TAG(I)&65535)<0 %THEN %START ;! LABEL SET INCORRECTLY
if (BAT[TAG[I] & 65535] >= 0) goto L_00E4;
// 1088 WRITE(TAG(I)>>16,1) ;! PRINT OUT LABEL NO OF LABEL NOT SET
_imp_WRITE((unsigned int)TAG[I] >> 16, 1);
// 1089 FAULT(M' LAB',M'EL N',M'OT S',M'ET ')
FAULT(541868354, 1162616910, 1330913363, 1163141152);
// 1090 %FINISH
L_00E4:;
// 1091 I=RETURN CELL(I) ;! RETURN JUMP LIST CELL TO ASL
I = RETURNCELL(I);
// 1092 ->L1 ; %FINISH
goto U_103B;
L_00E3:;
// 1093 I=START(LEVEL) ;! LINK TO START LIST
I = START[LEVEL];
// 1094 L2: %IF I\=0 %THEN %START ;! A CELL STILL IN LIST
U_103C:;
if (I == 0) goto L_00E5;
// 1095 FAULT(M'%FIN',M'ISH ',M'MISS',M'ING ')
FAULT(625363278, 1230194720, 1296651091, 1229866784);
// 1096 I=RETURN CELL(I) ;! POP UP CELL
I = RETURNCELL(I);
// 1097 ->L2 ; %FINISH
goto U_103C;
L_00E5:;
// 1098 %END
return;
} /* end of CHECK */
// ?J unused
// 1099 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1100 %ROUTINE UNSET
void UNSET(void) {
// 1101 ! UNSET NAMES AND CHECK FOR MISSING ROUTINES
// 1102 %INTEGER I,J,K
int I;
int J;
int K;
// 1103 I=NAME(LEVEL) ;! NAME LIST POINTER
I = NAME[LEVEL];
// 1104 L1: %IF I\=0 %THEN %START ;! UNSET NAMES DECLARED AT THIS LEVEL
U_103C:;
if (I == 0) goto L_00E6;
// 1105 J=TAG(I) ;! NAME IDENT NO
J = TAG[I];
// 1106 K=TAG(LINK(J)) ;! TAG WORD AT TOP OF LIST
K = TAG[LINK[J]];
// 1107 LINK(J)=RETURN CELL(LINK(J)) ;! POP UP CELL
LINK[J] = RETURNCELL(LINK[J]);
// 1108 %IF K>>28=4 %THEN %START ;! ROUTINE/FN TYPE
if ((unsigned int)K >> 28 != 4) goto L_00E7;
// 1109 %IF BAT(K&65535)<0 %THEN %START
if (BAT[K & 65535] >= 0) goto L_00E8;
// 1110 PRINT NAME(J)
PRINTNAME(J);
// 1111 FAULT(M'ROUT',M'INE ',M'MISS',M'ING ')
FAULT(1380930900, 1229866272, 1296651091, 1229866784);
// 1112 %FINISH
L_00E8:;
// 1113 K=K>>20&15 ;! NO OF PARAMS
K = (unsigned int)K >> 20 & 15;
// 1114 L2: %IF K\=0 %THEN %START ;! PARAMS PRESENT
U_102C:;
if (K == 0) goto L_00E9;
// 1115 LINK(J)=RETURN CELL(LINK(J)) ;! POP UP CELLS
LINK[J] = RETURNCELL(LINK[J]);
// 1116 K=K-1 ;! PARAM COUNT
K = K - 1;
// 1117 ->L2 ; %FINISH
goto U_102C;
L_00E9:;
// 1118 %FINISH
L_00E7:;
// 1119 %IF LINK(J)=0 %THEN TAG(J)=0 ;! A PREVIOUS DECLARATION OF SAME NAME
if (LINK[J] != 0) goto L_00EA;
TAG[J] = 0;
L_00EA:;
// 1120 I=RETURN CELL(I) ;! RETURN NAME LIST CELL
I = RETURNCELL(I);
// 1121 ->L1 ; %FINISH
goto U_103C;
L_00E6:;
// 1122 %END
return;
} /* end of UNSET */
// 1123 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1124 %ROUTINE PUSH START(%INTEGER FLAG,LABEL)
void PUSHSTART(int FLAG, int LABEL) {
// 1125 ! PUSHDOWN START/FINISH BLOCK INFORMATION
// 1126 %INTEGER I
int I;
// 1127 I=NEWCELL
I = NEWCELL();
// 1128 TAG(I)=FLAG<<16!LABEL&65535 ;! PACK FLAG & LABEL
TAG[I] = FLAG << 16 | LABEL & 65535;
// 1129 LINK(I)=START(LEVEL) ;! PUSH CELL DOWN
LINK[I] = START[LEVEL];
// 1130 START(LEVEL)=I ;! ONTO START LIST
START[LEVEL] = I;
// 1131 %END
return;
} /* end of PUSHSTART */
// 1132 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1133 %ROUTINE ENTER(%INTEGER TYPE,ALLOC)
void ENTER(int TYPE, int ALLOC) {
// 1134 ! DUMP CODE FOR NEW LEVEL & INITIALISE LEVEL ARRAYS
// 1135 %INTEGER I
int I;
// 1136 DUMP(M'STR',BR(LEVEL),M'STP',0) ;! ENTRY SEQUENCE
DUMP(5461074, BR[LEVEL], 5461072, 0);
// 1137 DUMP(M'LDA',BR(LEVEL),M'STP',0)
DUMP(4998209, BR[LEVEL], 5461072, 0);
// 1138 DUMP(M'STR',M'WK',M'STP',1)
DUMP(5461074, 22347, 5461072, 1);
// 1139 I=CT NEXT ;! STATIC ALLOCATION HOLE IN CONST TABLE
I = CTNEXT();
// 1140 DUMP(M'ADD',M'STP',M'CT',I)
DUMP(4277316, 5461072, 17236, I);
// 1141 STAR(LEVEL)=I ;! REMEMBER POSITION OF HOLE
STAR[LEVEL] = I;
// 1142 JUMP(LEVEL)=0 ;! NO JUMPS AT NEW LEVEL YET
JUMP[LEVEL] = 0;
// 1143 NAME(LEVEL)=0 ;! NO NAMES AT NEW LEVEL YET
NAME[LEVEL] = 0;
// 1144 RTP(LEVEL)=TYPE ;! BLOCK/ROUTINE/FN TYPE
RTP[LEVEL] = TYPE;
// 1145 CHPP(LEVEL)=CHP ;! SAVE CHARACTER ARRAY POINTER
CHPP[LEVEL] = CHP;
// 1146 START(LEVEL)=0 ;! NO START/FINISH BLOCKS YET
START[LEVEL] = 0;
// 1147 RAD(LEVEL)=ALLOC ;! NEXT RELATIVE ADDRESS TO BE ASSIGNED
RAD[LEVEL] = ALLOC;
// 1148 %END
return;
} /* end of ENTER */
// 1149 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1150 %ROUTINE RETURN
void RETURN(void) {
// 1151 ! DUMP CODE FOR %RETURN
// 1152 DUMP(M'LDA',M'STP',BR(LEVEL),0) ;! RESTORE DIJKSTRA DISPLAY
DUMP(4998209, 5461072, BR[LEVEL], 0);
// 1153 DUMP(M'LOAD',BR(LEVEL),M'STP',0)
DUMP(1280262468, BR[LEVEL], 5461072, 0);
// 1154 DUMP(M'LOAD',M'WK',M'STP',1)
DUMP(1280262468, 22347, 5461072, 1);
// 1155 DUMP('B',0,M'WK',0) ;! BRANCH TO RETURN ADDRESS
DUMP(66, 0, 22347, 0);
// 1156 %END
return;
} /* end of RETURN */
// 1157 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1158 %ROUTINE RT
void RT(void) {
// 1159 ! DUMP CODE FOR A ROUTINE OR FUNCTION CALL
// 1160 %INTEGER I,J,K,L,M,N,P
int I;
int J;
int K;
int L;
int M;
int N;
int P;
// 1161 I=LINK(A(AP)) ;! LINK TO TAG FOR NAME
I = LINK[A[AP - 1]];
// 1162 AP=AP+1 ;! AP ON <APP>
AP = AP + 1;
// 1163 J=TAG(I) ;! TAG OF NAME
J = TAG[I];
// 1164 K=J>>20&15+1 ;! NO OF PARAMS +1
K = ((unsigned int)J >> 20 & 15) + 1;
// 1165 L1: K=K-1 ;! COUNT PARAMS
U_102F:;
K = K - 1;
// 1166 AP=AP+1 ;! AP ON <APP>+1
AP = AP + 1;
// 1167 %IF A(AP-1)=2 %THEN %START ;! PARAMS ABSENT OR NO MORE TO PROCESS
if (A[AP - 1 - 1] != 2) goto L_00EB;
// 1168 DUMP(M'BAL',M'WK',M'BT',J&65535) ;! DUMP BRANCH TO ROUTINE/FN
DUMP(4342092, 22347, 16980, J & 65535);
// 1169 %IF K>0 %THEN FAULT(M'TOO ',M'FEW ',M'PARA',M'MS ')
if (K <= 0) goto L_00EC;
FAULT(1414483744, 1178949408, 1346458177, 1297293344);
L_00EC:;
// 1170 %RETURN ; %FINISH
return;
L_00EB:;
// 1171 %IF K<=0 %THEN %START ;! MORE PARAMS THAN SPEC
if (K > 0) goto L_00ED;
// 1172 %IF K=0 %THEN FAULT(M'TOO ',M'MANY',M' PAR',M'AMS ') ;! ONLY MONITOR ONCE
if (K != 0) goto L_00EE;
FAULT(1414483744, 1296125529, 542130514, 1095586592);
L_00EE:;
// 1173 ->L2 ; %FINISH
goto U_1030;
L_00ED:;
// 1174 I=LINK(I) ;! LINK TO NEXT PARAM CELL
I = LINK[I];
// 1175 L=TAG(I) ;! TAG OF PARAM
L = TAG[I];
// 1176 %IF L>>28=0 %THEN %START ;! SCALAR VALUE
if ((unsigned int)L >> 28 != 0) goto L_00EF;
// 1177 SEXPR ;! COMPILE EXPRESSION
SEXPR();
// 1178 ->L3 ; %FINISH
goto U_103D;
L_00EF:;
// 1179 %IF A(AP)=4 %AND A(AP+1)=1 %THEN ->L4 ;! <+-\> IS NULL & <OPD> IS A NAME
if (A[AP - 1] != 4) goto L_00F0;
if (A[AP + 1 - 1] != 1) goto L_00F0;
goto U_103E;
L_00F0:;
// 1180 L5: FAULT(M'NOT ',M'A NA',M'ME P',M'ARAM')
U_1031:;
FAULT(1313821728, 1092636225, 1296375888, 1095909709);
// 1181 L2: SKIP SEXPR ;! SKIP INVALID PARAM TO CONTINUE
U_1030:;
SKIPSEXPR();
// 1182 ->L1
goto U_102F;
// 1183 L4: M=LINK(A(AP+2)) ;! LINK TO TAG FOR PARAM NAME
U_103E:;
M = LINK[A[AP + 2 - 1]];
// 1184 %IF M=0 %THEN %START
if (M != 0) goto L_00F1;
// 1185 PRINT NAME(A(AP+2))
PRINTNAME(A[AP + 2 - 1]);
// 1186 FAULT(M'NAME',M' NOT',M' SET',M' ')
FAULT(1312902469, 542003028, 542328148, 538976288);
// 1187 ->L2 ; %FINISH
goto U_1030;
L_00F1:;
// 1188 N=TAG(M) ;! TAG OF PARAM NAME
N = TAG[M];
// 1189 %IF L>>28=1 %THEN %START ;! PARAM IS SCALAR NAME TYPE
if ((unsigned int)L >> 28 != 1) goto L_00F2;
// 1190 %IF N>>28=4 %THEN %START ;! ACTUAL NAME IS ROUTINE/FN TYPE
if ((unsigned int)N >> 28 != 4) goto L_00F3;
// 1191 PRINT NAME(A(AP+2))
PRINTNAME(A[AP + 2 - 1]);
// 1192 ->L5 ; %FINISH
goto U_1031;
L_00F3:;
// 1193 %IF N>>28>=2 %THEN %START ;! ACTUAL NAME IS AN ARRAY
if ((unsigned int)N >> 28 < 2) goto L_00F4;
// 1194 AP=AP+2 ;! AP ON <NAME>
AP = AP + 2;
// 1195 ARRAD ;! CALCULATE ARRAY ELEMENT ADDRESS
ARRAD();
// 1196 AP=AP+1 ;! AP ON <EXPR>+1 - SHOULD BE <EXPS>
AP = AP + 1;
// 1197 %IF A(AP-1)=1 %THEN ->L5 ;! FURTHER OPERAND - INVALID
if (A[AP - 1 - 1] != 1) goto L_00F5;
goto U_1031;
L_00F5:;
// 1198 ->L3 ; %FINISH
goto U_103D;
L_00F4:;
// 1199 %IF A(AP+3)=1 %THEN %START ;! <APP> NOT NULL
if (A[AP + 3 - 1] != 1) goto L_00F6;
// 1200 PRINT NAME(A(AP+2))
PRINTNAME(A[AP + 2 - 1]);
// 1201 FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM')
FAULT(1396916556, 1095901256, 1095966800, 1095909709);
// 1202 ->L2 ; %FINISH
goto U_1030;
L_00F6:;
// 1203 %IF A(AP+4)=1 %THEN ->L5 ;! FURTHER OPERANDS - INVALID
if (A[AP + 4 - 1] != 1) goto L_00F7;
goto U_1031;
L_00F7:;
// 1204 %IF N>>28=1 %THEN P=M'LOAD' %ELSE P=M'LDA' ;! LOAD FOR NAME TYPE & LDA FOR VALUE TYPE
if ((unsigned int)N >> 28 != 1) goto L_00F8;
P = 1280262468;
goto L_00F9;
L_00F8:;
P = 4998209;
L_00F9:;
// 1205 DUMP(P,M'ACC',BR(N>>16&15),N&65535)
DUMP(P, 4277059, BR[(unsigned int)N >> 16 & 15], N & 65535);
// 1206 %FINISH %ELSE %START ;! PARAM IS ARRAY NAME
goto L_00FA;
L_00F2:;
// 1207 %IF A(AP+3)\=2 %OR A(AP+4)\=2 %THEN ->L5 ;! <APP> NOT NULL OR MORE OPERANDS
if (A[AP + 3 - 1] != 2) goto L_00FB;
if (A[AP + 4 - 1] == 2) goto L_00FC;
L_00FB:;
goto U_1031;
L_00FC:;
// 1208 %IF N>>28&2=0 %THEN %START ;! 'FORM' OF ACTUAL IS NOT ARRAY
if ((unsigned int)N >> 28 & 2 != 0) goto L_00FD;
// 1209 PRINT NAME(A(AP+2))
PRINTNAME(A[AP + 2 - 1]);
// 1210 FAULT(M'NOT ',M'AN A',M'RRAY',M' NME')
FAULT(1313821728, 1095639105, 1381122393, 542002501);
// 1211 ->L2 ; %FINISH
goto U_1030;
L_00FD:;
// 1212 %IF N>>28=3 %THEN %START ;! ACTUAL IS ARRAY NAME
if ((unsigned int)N >> 28 != 3) goto L_00FE;
// 1213 M=N&65535 ;! POINTER TO TAG CELL OF PARAM LIST
M = N & 65535;
// 1214 N=TAG(M) ;! CORRECT TAG FOR PARAM
N = TAG[M];
// 1215 %FINISH
L_00FE:;
// 1216 %IF N>>20&15\=L>>20&15 %THEN %START ;! DIMENSIONS DIFFERENT
if ((unsigned int)N >> 20 & 15 == (unsigned int)L >> 20 & 15) goto L_00FF;
// 1217 %IF L>>20&15=0 %THEN %START ;! FORMAL PARAM DIMENSION UNKNOWN
if ((unsigned int)L >> 20 & 15 != 0) goto L_0100;
// 1218 L=TAG(I)!N&15<<20 ;! FILL FORMAL TAG WITH DIMENSION
L = TAG[I] | N & 15 << 20;
// 1219 TAG(I)=L ;! OF ACTUAL PARAM
TAG[I] = L;
// 1220 %FINISH %ELSE %START ;! DIMENSION OF FORMAL KNOWN
goto L_0101;
L_0100:;
// 1221 %IF N>>20&15=0 %THEN TAG(M)=TAG(M)!L&15<<20 %ELSE %START
if ((unsigned int)N >> 20 & 15 != 0) goto L_0102;
TAG[M] = TAG[M] | L & 15 << 20;
goto L_0103;
L_0102:;
// 1222 ;! FILL IN DIMENSION OF ACTUAL IF UNKNOWN
// 1223 PRINT NAME(A(AP+2))
PRINTNAME(A[AP + 2 - 1]);
// 1224 FAULT(M'ARRA',M'Y DI',M'MENS',M'ION?')
FAULT(1095914049, 1495286857, 1296387667, 1229934143);
// 1225 ->L2 ; %FINISH
goto U_1030;
L_0103:;
// 1226 %FINISH
L_0101:;
// 1227 %FINISH
L_00FF:;
// 1228 DUMP(M'LOAD',M'ACC',BR(N>>16&15),N&65535)
DUMP(1280262468, 4277059, BR[(unsigned int)N >> 16 & 15], N & 65535);
// 1229 %IF L>>20&15\=1 %THEN %START ;! NOT 1-DIM ARRAY
if ((unsigned int)L >> 20 & 15 == 1) goto L_0104;
// 1230 DUMP(M'STR',M'ACC',M'STP',L&65535)
DUMP(5461074, 4277059, 5461072, L & 65535);
// 1231 DUMP(M'LOAD',M'ACC',BR(N>>16&15),N&65535+1)
DUMP(1280262468, 4277059, BR[(unsigned int)N >> 16 & 15], (N & 65535) + 1);
// 1232 L=L+1
L = L + 1;
// 1233 %FINISH
L_0104:;
// 1234 %FINISH
L_00FA:;
// 1235 AP=AP+5 ;! AP ON <EXPS>
AP = AP + 5;
// 1236 L3: DUMP(M'STR',M'ACC',M'STP',L&65535)
U_103D:;
DUMP(5461074, 4277059, 5461072, L & 65535);
// 1237 ->L1
goto U_102F;
// 1238 %END
} /* end of RT */
// 1239 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1240 %ROUTINE ARRAD
void ARRAD(void) {
// 1241 ! DUMP CODE TO CALCULATE ARRAY ELEMENT ADDRESS
// 1242 %INTEGER I,J,K,L
int I;
int J;
int K;
int L;
// 1243 L=A(AP)
L = A[AP - 1];
// 1244 I=LINK(L) ;! LINK TO TAG FOR NAME OF ARRAY
I = LINK[L];
// 1245 J=TAG(I)
J = TAG[I];
// 1246 %IF J>>28=3 %THEN %START ;! NAME IS AN ARRAY NAME
if ((unsigned int)J >> 28 != 3) goto L_0105;
// 1247 I=J&65535 ;! SUBSTITUTE CORRECT TAG VALUE
I = J & 65535;
// 1248 J=TAG(I)
J = TAG[I];
// 1249 %FINISH
L_0105:;
// 1250 AP=AP+2 ;! AP ON <APP>+1
AP = AP + 2;
// 1251 %IF A(AP-1)=1 %THEN %START ;! INDEXES PRESENT
if (A[AP - 1 - 1] != 1) goto L_0106;
// 1252 SEXPR ;! COMPILE EXPR FOR FIRST INDEX
SEXPR();
// 1253 AP=AP+1 ;! AP ON <EXPS>+1
AP = AP + 1;
// 1254 %IF A(AP-1)=1 %THEN %START ;! 2ND INDEX PRESENT
if (A[AP - 1 - 1] != 1) goto L_0107;
// 1255 DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! STORE 1ST INDEX IN WORKSPACE
DUMP(5461074, 4277059, BR[LEVEL], WSNEXT());
// 1256 SEXPR ;! COMPILE EXPR FOR 2ND INDEX
SEXPR();
// 1257 %IF A(AP)=1 %THEN %START ;! 3RD INDEX PRESENT
if (A[AP - 1] != 1) goto L_0108;
// 1258 PRINT NAME(L)
PRINTNAME(L);
// 1259 FAULT(M'TOO ',M'MANY',M' IND',M'EXES')
FAULT(1414483744, 1296125529, 541675076, 1163412819);
// 1260 SKIP APP ;! SKIP EXCESS INDEXES
SKIPAPP();
// 1261 %FINISH %ELSE AP=AP+1 ;! AP AFTER EXPRESSION
goto L_0109;
L_0108:;
AP = AP + 1;
L_0109:;
// 1262 DUMP(M'MLT',M'ACC',BR(J>>16&15),J&65535)
DUMP(5065812, 4277059, BR[(unsigned int)J >> 16 & 15], J & 65535);
// 1263 WS=WS-1 ;! RESTORE WORKSPACE POINTER
WS = WS - 1;
// 1264 DUMP(M'ADD',M'ACC',BR(LEVEL),WS)
DUMP(4277316, 4277059, BR[LEVEL], WS);
// 1265 DUMP(M'ADD',M'ACC',BR(J>>16&15),J&65535+1)
DUMP(4277316, 4277059, BR[(unsigned int)J >> 16 & 15], (J & 65535) + 1);
// 1266 K=2 ;! DIMENSION MARKER
K = 2;
// 1267 %FINISH %ELSE %START ;! ONLY ONE INDEX PRESENT
goto L_010A;
L_0107:;
// 1268 DUMP(M'ADD',M'ACC',BR(J>>16&15),J&65535)
DUMP(4277316, 4277059, BR[(unsigned int)J >> 16 & 15], J & 65535);
// 1269 K=1 ;! DIMENSION MARKER
K = 1;
// 1270 %FINISH
L_010A:;
// 1271 %IF K\=J>>20&15 %THEN %START ;! DIMS FOUND DO NOT AGREE WITH TAG
if (K == (unsigned int)J >> 20 & 15) goto L_010B;
// 1272 %IF J>>20&15=0 %THEN TAG(I)=TAG(I)!K<<20 %ELSE %C
if ((unsigned int)J >> 20 & 15 != 0) goto L_010C;
TAG[I] = TAG[I] | K << 20;
goto L_010D;
L_010C:;
PRINTNAME(L);
L_010D:;
// 1273+ PRINT NAME(L)
// 1274 FAULT(M'ARRA',M'Y DI',M'MENS',M'ION?') ;! FILL IN DIMS IF UNKNOWN
FAULT(1095914049, 1495286857, 1296387667, 1229934143);
// 1275 %FINISH
L_010B:;
// 1276 %FINISH %ELSE %START
goto L_010E;
L_0106:;
// 1277 PRINT NAME(L)
PRINTNAME(L);
// 1278 FAULT(M'NO A',M'RRAY',M' IND',M'EXES')
FAULT(1313808449, 1381122393, 541675076, 1163412819);
// 1279 %FINISH
L_010E:;
// 1280 %END
return;
} /* end of ARRAD */
// 1281 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1282 %INTEGERFN BT NEXT
int BTNEXT(void) {
// 1283 ! ALLOCATE NEXT POSITION IN BRANCH TABLE
// 1284 %IF BTN>1023 %THEN %START ;! FULL
if (BTN <= 1023) goto L_010F;
// 1285 FAULT(M'TOO ',M'MANY',M'LABE',M'LS ')
FAULT(1414483744, 1296125529, 1279345221, 1280516128);
// 1286 BTN=0 ;! TRY TO CONTINUE
BTN = 0;
// 1287 %FINISH
L_010F:;
// 1288 BAT(BTN)=-1 ;! MARKER FOR ADDRESS NOT FILLED IN YET
BAT[BTN] = -1;
// 1289 BTN=BTN+1 ;! NEXT POSITION
BTN = BTN + 1;
// 1290 %RESULT=BTN-1 ;! THIS POSITION
return BTN - 1;
// 1291 %END
} /* end of BTNEXT */
// 1292 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1293 %INTEGERFN CT NEXT
int CTNEXT(void) {
// 1294 ! ALLOCATE NEXT POSITION IN CONSTANT TABLE
// 1295 %IF CTN>1023 %THEN %START ;! FULL
if (CTN <= 1023) goto L_0110;
// 1296 FAULT(M'TOO ',M'MANY',M' CON',M'STS ')
FAULT(1414483744, 1296125529, 541282126, 1398035232);
// 1297 CTN=0 ;! TRY TO CONTINUE
CTN = 0;
// 1298 %FINISH
L_0110:;
// 1299 CTN=CTN+1 ;! NEXT POSITION
CTN = CTN + 1;
// 1300 %RESULT=CTN-1 ;! THIS POSITION
return CTN - 1;
// 1301 %END
} /* end of CTNEXT */
// 1302 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1303 %INTEGERFN WS NEXT
int WSNEXT(void) {
// 1304 ! ALLOCATE NEXT WORK SPACE POSITION
// 1305 WS=WS+1
WS = WS + 1;
// 1306 %IF WS=11 %THEN FAULT(M'COMP',M'ILER',M' WKS',M'PACE')
if (WS != 11) goto L_0111;
FAULT(1129270608, 1229735250, 542591827, 1346454341);
L_0111:;
// 1307 %RESULT=WS-1
return WS - 1;
// 1308 %END
} /* end of WSNEXT */
// 1309 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1310 %INTEGERFN FIND LABEL
int FINDLABEL(void) {
// 1311 ! CHECK & LOCATE OR INSERT LABEL IN JUMP LIST FOR THIS LEVEL
// 1312 %INTEGER I,J
int I;
int J;
// 1313 LABEL=A(AP) ;! VALUE OF CONST
LABEL = A[AP - 1];
// 1314 AP=AP+1 ;! AFTER <CONST>
AP = AP + 1;
// 1315 %IF LABEL>>16\=0 %THEN %START ;! INVALID LABEL NUMBER
if ((unsigned int)LABEL >> 16 == 0) goto L_0112;
// 1316 WRITE(LABEL,1)
_imp_WRITE(LABEL, 1);
// 1317 SPACES(2)
_imp_SPACES(2);
// 1318 FAULT(M'INVA',M'LID ',M'LABE',M'L ')
FAULT(1229870657, 1279869984, 1279345221, 1277173792);
// 1319 %RESULT=-1 ;! 'FAULTY' RESULT
return -1;
// 1320 %FINISH
L_0112:;
// 1321 I=JUMP(LEVEL) ;! JUMP LIST POINTER
I = JUMP[LEVEL];
// 1322 L1: %IF I\=0 %THEN %START ;! SOMETHING IN LIST
U_103B:;
if (I == 0) goto L_0113;
// 1323 %IF LABEL=TAG(I)>>16 %THEN %RESULT=TAG(I)&65535 ;! LABEL ALREADY IN
if (LABEL != (unsigned int)TAG[I] >> 16) goto L_0114;
return TAG[I] & 65535;
L_0114:;
// 1324 I=LINK(I) ;! NEXT CELL IN LIST
I = LINK[I];
// 1325 ->L1 ; %FINISH
goto U_103B;
L_0113:;
// 1326 I=NEWCELL ;! LABEL NOT IN LIST SO GET NEW CELL
I = NEWCELL();
// 1327 J=BT NEXT ;! GET NEXT BRANCH TABLE POSITION
J = BTNEXT();
// 1328 TAG(I)=LABEL<<16!J ;! FILL IN LIST ENTRY
TAG[I] = LABEL << 16 | J;
// 1329 LINK(I)=JUMP(LEVEL) ;! PUSHDOWN ONTO JUMP LIST
LINK[I] = JUMP[LEVEL];
// 1330 JUMP(LEVEL)=I ;! NEW JUMP LIST POINTER
JUMP[LEVEL] = I;
// 1331 %RESULT=J ;! NEW BRANCH TABLE POSITION
return J;
// 1332 %END
} /* end of FINDLABEL */
// 1333 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1334 %ROUTINE STORE TAG(%INTEGER NAM,FORM,TYPE,DIM,LEV,AD)
void STORETAG(int NAM, int FORM, int TYPE, int DIM, int LEV, int AD) {
// 1335 ! STORE TAGS I.E. SET NAME & CHECK NOT SET ALREADY
// 1336 %INTEGER M,N
int M;
int N;
// 1337 M=LINK(NAM) ;! POINTER TO EXISTING TAGS WORD FOR THIS
M = LINK[NAM];
// 1338 %IF M\=0 %AND LEV=TAG(M)>>16&15 %AND FORM\=4 %THEN %START
if (M == 0) goto L_0115;
if (LEV != (unsigned int)TAG[M] >> 16 & 15) goto L_0115;
if (FORM == 4) goto L_0115;
// 1339 PRINT NAME(NAM)
PRINTNAME(NAM);
// 1340 FAULT(M'NAME',M' SET',M' TWI',M'CE ')
FAULT(1312902469, 542328148, 542398281, 1128603680);
// 1341 %RETURN ; %FINISH
return;
L_0115:;
// 1342 N=NEWCELL ;! NEW CELL FOR TAGS
N = NEWCELL();
// 1343 TAG(N)=FORM<<28!TYPE<<24!DIM<<20!LEV<<16!AD ;! FILL IN TAGS
TAG[N] = FORM << 28 | TYPE << 24 | DIM << 20 | LEV << 16 | AD;
// 1344 LINK(N)=LINK(NAM) ;! PUSHDOWN ONTO TAGS LIST FOR THIS NAME
LINK[N] = LINK[NAM];
// 1345 LINK(NAM)=N
LINK[NAM] = N;
// 1346 N=NEWCELL
N = NEWCELL();
// 1347 TAG(N)=NAM ;! PUSHDOWN NEW CELL ONTO NAME LIST
TAG[N] = NAM;
// 1348 LINK(N)=NAME(LEVEL) ;! FOR NAMES DECLARED AT THIS LEVEL
LINK[N] = NAME[LEVEL];
// 1349 NAME(LEVEL)=N
NAME[LEVEL] = N;
// 1350 %END
return;
} /* end of STORETAG */
// 1351 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1352 %ROUTINE DUMP(%INTEGER OP,REG,BASE,DISP)
void DUMP(int OP, int REG, int BASE, int DISP) {
auto void PMN(int I);
// 1353 ! PRINT OUT CURRENT ADDRESS, OPERATION MNEMONIC & OPERANDS
// 1354 %ROUTINESPEC PMN(%INTEGER I)
// 1355 %INTEGER COM
int COM;
// 1356 SPACES(10)
_imp_SPACES(10);
// 1357 COM=' '
COM = 32;
// 1358 PMN(OP) ;! OPERATOR MNEMONIC
PMN(OP);
// 1359 COM=','
COM = 44;
// 1360 PMN(REG) ;! REGISTER MNEMONIC
PMN(REG);
// 1361 %IF DISP>=65536 %THEN %START
if (DISP < 65536) goto L_0116;
// 1362 PRINT SYMBOL(',')
_imp_PRINTSYMBOL(44);
// 1363 SPACES(7)
_imp_SPACES(7);
// 1364 PRINT NAME(DISP-65536)
PRINTNAME(DISP - 65536);
// 1365 %FINISH %ELSE %START
goto L_0117;
L_0116:;
// 1366 %IF BASE=M'BT' %OR BASE=M'CT' %OR BASE=M'PRG' %THEN %START
if (BASE == 16980) goto L_0118;
if (BASE == 17236) goto L_0118;
if (BASE != 5263943) goto L_0119;
L_0118:;
// 1367 PRINT SYMBOL(',')
_imp_PRINTSYMBOL(44);
// 1368 SPACES(7)
_imp_SPACES(7);
// 1369 %FINISH
L_0119:;
// 1370 PMN(BASE) ;! BASE MNEMONIC
PMN(BASE);
// 1371 WRITE(DISP,1) ;! DISPLACEMENT
_imp_WRITE(DISP, 1);
// 1372 %FINISH
L_0117:;
// 1373 NEWLINE
_imp_NEWLINE();
// 1374 CA=CA+1 ;! INCREMENT CURRENT ADDRESS COUNT
CA = CA + 1;
// 1375 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 1376 %ROUTINE PMN(%INTEGER I)
void PMN(int I) {
// 1377 ! PRINT MNEMONIC - CHARS INTO ONE WORD
// 1378 %INTEGER J,K,L
int J;
int K;
int L;
// 1379 J=2 ;! AT LEAST TWO SPACES
J = 2;
// 1380 K=24 ;! FIRST SHIFT VALUE
K = 24;
// 1381 L1: L=I>>K&255 ;! UNPACK NEXT CHARACTER
U_103E:;
L = (unsigned int)I >> K & 255;
// 1382 %IF L=0 %THEN J=J+1 %ELSE PRINT SYMBOL(L)
if (L != 0) goto L_011A;
J = J + 1;
goto L_011B;
L_011A:;
_imp_PRINTSYMBOL(L);
L_011B:;
// 1383 K=K-8 ;! NEXT SHIFT VALUE
K = K - 8;
// 1384 %IF K>=0 %THEN ->L1 ;! MORE CHARS POSSIBLY YET
if (K < 0) goto L_011C;
goto U_103E;
L_011C:;
// 1385 %IF I=M'BT' %OR I=M'CT' %OR I=M'PRG' %THEN %C
if (I == 16980) goto L_011D;
if (I == 17236) goto L_011D;
if (I != 5263943) goto L_011E;
L_011D:;
_imp_PRINTSYMBOL(43);
goto L_011F;
L_011E:;
// 1386+ PRINT SYMBOL('+') %ELSE %START
// 1387 PRINT SYMBOL(COM)
_imp_PRINTSYMBOL(COM);
// 1388 SPACES(J) ;! TO ALLIGN FIELDS CORRECTLY
_imp_SPACES(J);
// 1389 %FINISH
L_011F:;
// 1390 %END
return;
} /* end of PMN */
// 1391 %END
return;
} /* end of DUMP */
// 1392 %END
return;
} /* end of SS */
// ?L68 unused
// 1393 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1394 %ROUTINE FAULT(%INTEGER A,B,C,D)
void FAULT(int A, int B, int C, int D) {
auto void OUT(int I);
// 1395 ! MONITOR FAULT - A 'PRINT STRING' ROUTINE
// 1396 %ROUTINESPEC OUT(%INTEGER I)
// 1397 OUT(A)
OUT(A);
// 1398 OUT(B)
OUT(B);
// 1399 OUT(C)
OUT(C);
// 1400 OUT(D)
OUT(D);
// 1401 NEWLINE
_imp_NEWLINE();
// 1402 FAULTS=FAULTS+1 ;! INCREMENT FAULT COUNT
FAULTS = FAULTS + 1;
// 1403 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// 1404 %ROUTINE OUT(%INTEGER I)
void OUT(int I) {
// 1405 ! PRINT OUT PACKED CHARS
// 1406 PRINT SYMBOL(I>>24) %if I>>24 # 0
if ((unsigned int)I >> 24 == 0) goto L_0120;
_imp_PRINTSYMBOL((unsigned int)I >> 24);
L_0120:;
// 1407 PRINT SYMBOL(I>>16&255) %if I>>16&255 # 0
if ((unsigned int)I >> 16 & 255 == 0) goto L_0121;
_imp_PRINTSYMBOL((unsigned int)I >> 16 & 255);
L_0121:;
// 1408 PRINT SYMBOL(I>>8&255) %if I>>8&255 # 0
if ((unsigned int)I >> 8 & 255 == 0) goto L_0122;
_imp_PRINTSYMBOL((unsigned int)I >> 8 & 255);
L_0122:;
// 1409 PRINT SYMBOL(I&255) %if I&255 # 0
if (I & 255 == 0) goto L_0123;
_imp_PRINTSYMBOL(I & 255);
L_0123:;
// 1410 %END
return;
} /* end of OUT */
// 1411 %END
return;
} /* end of FAULT */
// 1412 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1413 %INTEGERFN CH NEXT
int CHNEXT(void) {
// 1414 ! ALLOCATE NEXT POSITION IN 'CH' ARRAY
// 1415 %IF CHP>512 %THEN %START ;! CHARACTER ARRAY FULL
if (CHP <= 512) goto L_0124;
// 1416 FAULT(M'NAME',M'S TO',M'O LO',M'NG ')
FAULT(1312902469, 1394627663, 1327516751, 1313284128);
// 1417 %STOP ; %FINISH
_imp_stop(0);
L_0124:;
// 1418 CHP=CHP+1
CHP = CHP + 1;
// 1419 %RESULT=CHP-1
return CHP - 1;
// 1420 %END
} /* end of CHNEXT */
// 1421 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1422 %INTEGERFN NEWCELL
int NEWCELL(void) {
// 1423 ! ALLOCATE NEW CELL FOR LIST PROCESSING
// 1424 %INTEGER I
int I;
// 1425 %IF ASL=0 %THEN %START ;! END OF AVAILABLE SPACE LIST
if (ASL != 0) goto L_0125;
// 1426 FAULT(M'ASL ',M'EMPT',M'Y ',M' ')
FAULT(1095978016, 1162694740, 1495277600, 2105376);
// 1427 %STOP ; %FINISH
_imp_stop(0);
L_0125:;
// 1428 I=ASL ;! POINTER TO TOP CELL OF ASL
I = ASL;
// 1429 ASL=LINK(ASL) ;! ASL POINTER TO NEXT CELL DOWN
ASL = LINK[ASL];
// 1430 TAG(I)=0 ;! CLEAR NEW CELL OUT
TAG[I] = 0;
// 1431 LINK(I)=0
LINK[I] = 0;
// 1432 %RESULT=I ;! INDEX TO NEW CELL
return I;
// 1433 %END
} /* end of NEWCELL */
// 1434 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1435 %INTEGERFN RETURN CELL(%INTEGER I)
int RETURNCELL(int I) {
// 1436 ! DEALLOCATE CELL AND RETURN IT TO ASL
// 1437 %INTEGER J
int J;
// 1438 J=LINK(I) ;! PRESENT LINK VALUE OF CELL
J = LINK[I];
// 1439 LINK(I)=ASL ;! LINK TO TOP OF ASL
LINK[I] = ASL;
// 1440 ASL=I ;! ASL POINTER TO RETURNED CELL
ASL = I;
// 1441 %RESULT=J ;! RETURN VALUE OF LINK
return J;
// 1442 %END
} /* end of RETURNCELL */
// 1443 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1444 %ROUTINE PRINT NAME(%INTEGER I)
void PRINTNAME(int I) {
// 1445 ! PRINT NAME FROM HASH POSITION
// 1446 %INTEGER J,K,L,M
int J;
int K;
int L;
int M;
// 1447 J=TAG(I) ;! POINTER TO CH ARRAY
J = TAG[I];
// 1448 K=CH(J) ;! LENGTH & FIRST 3 CHARS
K = CH[J - 1];
// 1449 L=K>>24 ;! NUMBER OF CHARS IN NAME
L = (unsigned int)K >> 24;
// 1450 M=16 ;! FIRST SHIFT VALUE
M = 16;
// 1451 L1: PRINT SYMBOL(K>>M&255)
U_103F:;
_imp_PRINTSYMBOL((unsigned int)K >> M & 255);
// 1452 L=L-1
L = L - 1;
// 1453 %IF L=0 %THEN %START
if (L != 0) goto L_0126;
// 1454 SPACES(2)
_imp_SPACES(2);
// 1455 %RETURN ; %FINISH
return;
L_0126:;
// 1456 M=M-8 ;! NEXT SHIFT VALUE
M = M - 8;
// 1457 %IF M<0 %THEN %START
if (M >= 0) goto L_0127;
// 1458 J=J+1
J = J + 1;
// 1459 K=CH(J) ;! NEXT WORD OF CHARS
K = CH[J - 1];
// 1460 M=24
M = 24;
// 1461 %FINISH
L_0127:;
// 1462 ->L1
goto U_103F;
// 1463 %END
} /* end of PRINTNAME */
// 1464 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1465 %ENDOFPROGRAM
_imp_stop(0);
return 0;
end_0:;
}