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