Trailing-Edge
-
PDP-10 Archives
-
decuslib10-03
-
43,50306/code.imc
There are 2 other files named code.imc in the archive. Click here to see a list.
TWOSEG;
# THIS IS FILE CODE, CONTAINING THE SEMANTIC ROUTINES WHICH GENERATE
AND TWIDDLE CODE FOR THE IMP COMPILER.
SOME OF THE PROGRAMS CONTAINED ON THIS FILE ARE OBJECT-MACHINE-DEPENDANT.
THE CODE IS STORED IN FREE ARRAY CO, IN THE FOLLOWING FORMAT:
BITS 35-34 CONTAIN THE TYPE OF THE ENTRY. THE REST OF THE WORD
DEPENDS ON THE TYPE.
TYPE=2: LINK WORD. BITS 17-0 CONTAIN INDEX OF NEXT WORD (0 TERMINATES).
TYPE=1: SPECIAL FUNCTION. THE EXACT FUNCTION IS INDICATED BY BITS 33-27.
FUNCTION 0: DEFINE A TAG AT THIS POINT - INDEX OF NAME IN BITS 17-0.
1: SAVE ALL REGISTERS IN USE AT THE MOMENT IN THE RANGE
I-J, WHERE I=BITS 11-6, J=BITS 5-0.
2: RESTORE SAVED REGISTERS, AND FORCE DUMMY REFERENCE TO
REGISTER WHOSE INDEX IS IN BITS 17-0.
3: ENTER "DELETE NO INSTRUCTIONS" MODE.
4: LEAVE "DELETE NO INSTRUCTIONS" MODE.
5: REGISTER REFERENCE (INDEX IN BITS 17-0) TO SET ASIDE
USER REGISTER.
6: RESERVE REGISTER UNTIL END OF PROGRAM.
7: FOLLOWING INSTRUCTION IS A MOVE FROM A USER-DEFINED REG.
TO A TEMPORARY ONE, AND CAN BE OPTIMIZED OUT IF THE
RESULT OF THE FOLLOWING INSTRUCTION IS MOVED BACK TO THE
USER-DEFINED REG. IN THE SECOND INSTRUCTION FOLLOWING.
8: MAKE REGISTER AVAILABLE TO COMPILER.
9: DECLARE REGISTER SCRATCH.
10: DECLARE REGISTER PROTECTED (DEFAULT CASE).
11: SUPPRESS REFERENCE COUNT FOR REGISTER IN NEXT
INSTRUCTION WORD (USED TO AVOID RESERVING
INDEX REGISTERS IN BYTE POINTERS UP TO PTR.)
TYPE=3: CONSTANT WORD OF CODE. VAL=NEXT WORD + DIRECTORY INDEX IN BITS 17-0.
TYPE=0: WORD OF CODE. THIS IS A TWO WORD ENTRY.
WORD 1: BITS 35-34: 0
BIT 33 : INDIRECT BIT IN INSTRUCTION.
BITS 32-24: OPCODE.
BITS 22-12: INDEX OF AC FOR INSTRUCTION.
BIT 11 : IF 1, ADDRESS FIELD IS INDEX OF REGISTER, NOT VARIABLE
BITS 10-0 : INDEX OF INDEX REGISTER FOR INSTRUCTION.
WORD 2: BITS 35-18: CONSTANT TO BE ADDED TO ADDRESS FIELD.
BITS 17-0 : INDEX OF VARIABLE NAME FOR ADDRESS FIELD.
THE ROUTINES WHICH PERFORM OPERATIONS ON CODE ARE ALL SEMANTIC ROUTINES AND MAY
BE CALLED FROM SEMANTICS OR FROM OTHER ROUTINES (EXCEPT WHERE NOTED). MOST
OF THEM TAKE AS FIRST ARGUMENT THE STACK POINTER TO A NODE WHICH SERVES AS THE
SOURCE AND DESTINATION OF THE CODE.
* DESIGNATES OBJECT-MACHINE-DEPENDANT ROUTINES.
IF A ROUTINE LISTED BELOW IS NOT ON THIS FILE, LOOK ON CODE2.
CODEI(0) INITIALIZES THE ROUTINES.
*FETCH(S) GETS A FRESH REGISTER AND LOADS THE ITEM S INTO IT.
*STORE(S,T) STORES STACK ITEM T IN ITEM S, HOOKING THE CODE FOR T ON BEFORE
THAT OF S.
HOOK(D,A,B) - HOOKS CODE FOR A TO CODE FOR B, PUTS CODE IN D. VALUE OF D
IS SET TO VALUE OF B.
ADDCODE(S,W1,W2) ADDS THE WORDS W1 AND (IF TYPE IN W1 IS 0 OR 3) W2 TO THE
CODE FOR THE STACK ENTRY S. (NOT A SEMANTIC ROUTINE).
MCODE(S,T) RETURNS 1 IF THE CODE FOR S AND FOR T IS IDENTICAL (UP TO SOME
CORRESPONDENCE BETWEEN REGISTER ASSIGNMENTS).
*DEWOP(OP,A,S) ADDS TO THE CODE FOR S AN INSTRUCTION TO PERFORM OPCODE OP
WITH THE ACCUMULATOR DESIGNATED BY A AND THE OPERAND DESIGNATED BY THE
ENTRY AT S. AS A RESULT, S BECOMES TYPE 2 (REGISTER A) UNLESS A=0.
IF A IS A USER-ASSIGNED REGISTER, THEN THE VALUE IN A IS MOVED TO ANOTHER
REGISTER FIRST IF OP WOULD CLOBBER IT, UNLESS A IS NEGATIVE.
*ADDOP(OP,S,T) IS HOOK(S,T,DEWOP(OP,REGOF(FETCH(T)),S)), WHICH IS THE USUAL
WAY ONE WANTS TO USE DEWOP TO PERFORM A BINARY OPERATION S OP T.
REGOF(S) RETURNS THE INDEX OF THE REGISTER OF STACK ENTRY S.
*FIX(S) INSURES THAT THE STACK ENTRY S IS OF TYPE INTEGER.
*FLOAT(S) INSURES THAT S IS OF TYPE REAL.
*SUBRCALL(S) GENERATES A SUBROUTINE CALL TO S.
*SUBRPAR(S,P) ADDS THE ARGUMENT P TO THE SUBROUTINE CALL S.
*SUBARG(S,P) (NOT A SEMANTIC ROUTINE) FORCES P INTO AN ADDRESS, STORING IT
IF NECESSARY, FOR SUBR CALL, PERHAPS ADDING A TAG TO S FOR THE PURPOSE
OF STORING AN ADDRESS IN THE NEXT WORD OF CODE TO BE ADDED TO S.
*PRINPAR(N,A,B,C,D) PROCESSES A PRINT LIST IT M, GENERATING A FUNNY STACK NODE
WITH CODE FOR COMPUTING THE ITEM IN WORD 2, AND FOR ENTERING THE ITEM IN
THE PRINT LIST, IN WORD 1.
*PRINCAL(A,B) ADDS PRINT LIST ITEM B TO THE PRINT LIST BEING BUILT IN A.
DATAST(A) GENERATES CONSTANTS FOR A DATA STATEMENT.
COPYCO(S) MAKES A FRESH COPY (INCLUDING NEW REGISTERS) OF THE CODE FOR
STACK ENTRY S.
TAG(S) ADDS CODE TO S TO DEFINE IT AS A TAG.
*ADDR(S) MAKES S OF TYPE 20B, SO THAT WHAT WAS PREVIOUSLY THE VALUE WILL WIND
UP IN THE ADDRESS FIELD WHEN S IS THE ARGUMENT OF DEWOP. THE RESULT WILL
NOT HAVE AN INDIRECT BIT SET.
CONOP(S,T,I) PERFORMS AN OPERATION ON ONE OR TWO CONSTANTS S AND T, INDICATED
BY THE INDEX I.
*RETURN(A) ENTERS CODE FOR "RETURN A" - RETURNS A AS THE VALUE OF THE
CURRENT SUBROUTINE.
*SUBSCRIPT(S,T) MAKES THE SUBSCRIPTED VARIABLE S[T].
ONEWORD(S) - RETURNS 1 IF STACK ENTRY S HAS EXACTLY ONE WORD OF CODE ASSICIATED
WITH IT.
FREEZE(S) FLAGS THE CODE ON S SO THAT THE ASSEMBLY PASS WILL NOT DELETE ANY
WORDS FROM IT.
*RELVAL(S,T,I) COMPUTES THE RELATIONAL VALUE S <I> T WHERE <I> IS THE OPERATOR.
*OJUMPOP(I) - RETURNS THE OPCODE FOR THE COMPLEMENTARY JUMP TO THE OPCODE I.
JUMPAROUND(S,OP,REG) - PUTS A UNIQUE TAG AT THE END OF S, AND A JUMP TO IT
AT THE BEGINNING, USING OPCODE OP AND REGISTER REG. VALUE OF S UNCHANGED.
THERE FOLLOWS SOME VALUABLE INFORMATION FOR ANYONE HOPING TO GENERATE CODE USING
THESE ROUTINES.
THE MAJOR PROCESS INVOLVED IN CRAFTING SEMANTICS TO GENERATE GOOD CODE IS THAT
OF CONSIDERING THE MANY CASES OF DIFFERENT OPERAND TYPES FOR THE OPERATOR
BEING IMPLEMENTED. THE OPERAND TYPES WHICH MAY CROP UP IN THIS COMPILER ARE
SUMMARIZED HERE.
AS IS KNOWN TO EVERY SCHOOLCHILD, STACK ENTRIES COME IN ABOUT
FIVE TYPES: NAME, REGISTER, CONSTANT, VARIABLE, AND MEMORY (I.E., SUBSCRIPTED
VARIABLE). FOR CODE GENERATION PURPOSES, IT IS POSSIBLE TO IGNORE NAMES,
SINCE THEY WILL ALWAYS BE PASSED THROUGH NAME(S) BEFORE COMING HERE, AND THUS
WILL BE TRANSFORMED INTO ONE OF THE OTHER CLASSES.
AS IS DOCUMENTED ON FILE COTREE, STACK ENTRIES HAVE THE FOLLOWING FIELDS:
TYPE: REGISTER=2, CONSTANT=4, VARIABLE=10B, MEMORY=20B.
DI: DIRECTORY INDEX, USUALLY A VARIABLE NAME.
AR: ARITHMETIC TYPE (1=INTEGER, 2=REAL.)
AND EITHER
(I: INDIRECT BIT.
(REG: INDEX OF REGISTER.
(CON: CONSTANT.
OR
VAL: VALUE OF FIRST WORD, FOR CONSTANTS.
PLUS MAYBE SOME ASSOCIATED CODE.
WE NOW DESCRIBE EACH TYPE OF STACK ENTRY INDIVIDUALLY. THE ARITHMETIC TYPE
FIELD APPLIES TO EACH TYPE OF NODE, AND WILL NOT BE MENTIONED FURTHER HERE.
EVERY ONE OF THESE TYPES MAY HAVE CODE ASSOCIATED WITH IT.
TYPE 2 (REGISTER): ALL FIELDS EXCEPT REG ARE IGNORED. THIS ENTRY IS TALKING
ABOUT THE NUMBER IN A REGISTER AND NOTHING BUT.
TYPE 4 (CONSTANT): ALL FIELDS BUT VAL AND DIR ARE IGNORED. FURTHERMORE, IF
DIR IS NONZERO, IT IS ALWAYS THE DIRECTORY INDEX OF SOME IDENTIFIER WHICH
IS A CONSTANT WITH VALUE EQUAL TO THE VAL FIELD. (IF THE CONSTANT IS
MULTIWORD, THE VAL FIELD IS THE VALUE OF THE FIRST WORD.)
TYPE 10 (NAME): ALL FIELDS BUT DIR AND CONST ARE IGNORED. DIR (IF NONZERO)
IS THE DIR INDEX OF SOME IDENTIFIER WHICH WILL WIND UP AS A TAG OR SOMETHING
ELSE WITH AN ADDRESS. THIS NODE IS TALKING ABOUT THE VALUE OF THE MEMORY
LOCATION AT DIR+CON.
TYPE 20 (MEMORY): THIS ONE IS THE HAIRY BRUTE. ALL FIELDS (EXCEPT VAL, WHICH
IS ONLY FOR CONSTANTS) SWING INTO ACTION. THIS NODE IS TALKING ABOUT ANY
WORD WHOSE ADDRESS CANNOT BE COMPILED INTO AN ADDRESS FIELD AT COMPILE TIME.
EXAMPLES: VARIABLES WITH NON-CONSTANT SUBSCRIPTS, AND SUBROUTINE PARAMETERS.
THE DI+CON, REG, AND INDIRECT BIT ARE STUFFED INTO THE ADDRESS PORTION OF A
PDP-10 INSTRUCTION WORD, AND VOILA. THIS IS THE ONLY TYPE OF STACK ENTRY
WHICH MAY HAVE THE INDIRECT BIT SET.
THE ROUTINES DEWOP(OP,REG,S), ADDOP(OP,S,T), AND STORE(S,T)
HAVE A BIT MORE MACHINE-DEPENDANT "SMARTS" THAN
ONE MIGHT EXPECT, AND THE READER WHO PLANS TO WRITE SEMANTICS ON THE
INSTRUCTION-GENERATING LEVEL WILL SAVE HIMSELF A LOT OF WORK BY TAKING NOTE
OF THEM.
DEWOP TAKES A 9-BIT OPCODE OP, A REGISTER INDEX REG (REG=0=>NO ACCUMULATOR),
AND A STACK ENTRY S. IT ADDS TO S THE INSTRUCTION CONSTRUCTED BY INSERTING
OP AND REG AS THE OPCODE AND ACCUMULATOR, AND GETTING THE INDEX REGISTER,
INDIRECT BIT, AND ADDRESS FROM S. IT ASSUMES THAT THE RESULT OF THE INSTRUC-
TION WINDS UP IN REG, SO IF REG IS NONZERO IT CHANGES THE TYPE OF S TO 2.
OTHER THAN THAT, THE FIELDS OF S ARE NOT CHANGED.
IF S IS OF TYPE 2 TO BEGIN WITH, THE ADDRESS FIELD OF THE INSTRUCTION GETS THE
REGISTER NUMBER - THE REGISTER IS TREATED AS A MEMORY LOCATION.
IF S IS OF TYPE 4, DEWOP CHECKS TO SEE IF THE CONSTANT IS IN THE RIGHT 18 BITS,
AND IF THE OPCODE HAS AN IMMEDIATE MODE. IF SO, AN IMMEDIATE INSTRUCTION IS
GENERATED. IF NOT, A CHECK IS MADE TO SEE IF THE CONSTANT HAS A DIR INDEX.
IF NOT, AN IDENTIFIER IS CREATED FOR IT SO THAT ITS ADDRESS CAN BE REFERRED
TO BY THE INSTRUCTION.
FETCH(S) GETS S INTO A REGISTER. IT CALLS DEWOP(200B,REG,S) TO DO SO UNLESS
S IS A CONSTANT, IN WHICH CASE IT MAY USE ANY OF A NUMBER OF HALF-WORD
INSTRUCTIONS.
STORE(S,T) GETS T INTO S, WHICH OUGHT NOT TO BE OF TYPE 4. IT HOOKS ON THE
CODE FOR T BEFORE THAT OF S. IT DOES THE JOB BY CALLING DEWOP(202B,REG,S)
IN MOST CASES. HOWEVER, IF S IS OF TYPE 10 OR 20 WITH NO ASSOCIATED CODE,
AND THE LAST INSTRUCTION IN T'S CODE REFERENCES S, STORE ALTERS THE INSTRUC-
TION TO DO A SELF OR BOTH OPERATION IF POSSIBLE.
ADDOP(OP,S,T) IS HOOK(S,T,DEWOP(OP,REGOF(FETCH(T)),S)), WHICH PERFORMS THE
BINARY OPERATION OP ON S AND T. THIS COULD BE WRITTEN EXPLICITLY IN
SEMANTICS, BUT WAS DEFINED AS A ROUTINE TO SAVE WRITING THE SAME THING
MANY TIMES. ADDOP, NATURALLY, HAS ALL THE SMARTS OF DEWOP.
#
SUBR CODEI(NIL) IS (
DSEM('STORE',STORE);
DSEM('FETCH',FETCH);
DSEM('REGOF',REGOF);
DSEM('DEWOP',DEWOP);
DSEM('ADDOP',ADDOP);
DSEM('TAG',TAG);
CODE2I(0);
CO,NCO ARE COMMON, 1 LONG;
NCO_1; FRELOT(CO,'CODE',200,0); FINCSET(CO,200));
#THESE ARE BIT VECTORS INDEXED BY FIRST 6 BITS OF OPCODE. IMM TELLS IF THERE
IS AN IMMEDIATE MODE, SELF IF THERE IS A BOTH OR SELF MODE, BOTH IF THERE
IS A BOTH MODE. #
IMM: DATA (43600000B,177777B);
SELF:DATA (43770000B,177777B);
BOTH:DATA (43170000B,000377B);
SUBR STORE(S,T) IS (
UNPCK(S);
# CHECK FOR POSSIBLE SELF/BOTH INSTRUCTION #
(TSE AND 30B)=>(
J_FREE(S+2); J=>GO TO L26; # S HAS NO CODE #
CT_FREE(T+2); CT=0=>GO TO L26; # T HAS CODE #
J_FREE(T); (2 AND J)=0=>GO TO L26; # T IS IN A REGISTER #
TI_FREE(CO+(C_777777B AND CT)-2);
(TI RS 34)=>GO TO L26; # LAST CODE IN T IS INSTR. #
T2_FREE(CO+C-1);
(T2 RS 18) NE CSE=>GO TO L26; # CONST. PARTS MATCH #
(T2 AND 777777B) NE DSE=>GO TO L26; # VARIABLE NAMES MATCH #
((SE1 RS 35)+1 AND TI RS 33)=1=>GO TO L26;# INDIRECT BITS MATCH #
(TI AND 4000B)=>GO TO L26; # T REFERENCES NON-REGISTER LOC#
REGEQ(TI AND 3777B,RSE)=0=>GO TO L26; # IF BOTH SAME INDEX REG #
J_37B AND TI RS 27; K_1 AND TI RS 32;
(3 AND TI RS 24)=>GO TO L26; # INSTRUCTION IS NORMAL MODE #
(1 AND SELF[K] RS J)=0=>GO TO L26; # INSTRUCTION HAS BOTH MODE #
REG0(RSE)=>(1 AND BOTH[K] RS J)=0=> # .. NOT FOR REGISTER 0 #
GO TO L26;
FREES(CO+C-2,TI OR 300000000B); # OK - MAKE IT A BOTH INST. #
HOOK(S,T,S);
GO TO STORED);
L26: TSE=2=>((FREE(T) AND 77B) NE 2 =>
(L27: HOOK(S,DEWOP(200B,-(S1_RSE),T),S); GO TO STORED);
#IF REG TO REG, TRY TO OPTIMIZE OUT DESTINATION#
TCO_FREE(T+2) RS 18;
RT_3777B AND FREE(T+1) RS 18;
TMPREG(RT)=0 => GO TO L27;
RCOCHK(1,TCO,RSE,0) => GO TO L27;
RCOCHK(2,TCO,RT,0) => GO TO L27;
FREES(T+1,(RSE LS 18) OR FREE(T+1) AND 774000777777B);
RCOCHK(3,TCO,RT,RSE); RETURN T);
# CHECK 0 OR 1 #
(FREE(T) AND 77B)=4=>(S1_FREE(T+1);
S1=0=>(OP_402B;
LL1: HOOK(S,T,DEWOP(OP,0,S));
FREES(S,FREE(T)); FREES(S+1,FREE(T+1));
GO TO STORED);
S1=-1=>(OP_476B; GO TO LL1));
FETCH(T); HOOK(S,T,S);
DEWOP(202B,REGOF(T),S);
STORED: S);
SUBR FETCH(S) IS ((FREE(S) AND 77B) NE 2=>DEWOP(200B,AREG1(1,15B),S); S);
SUBR REGOF(S) IS (3777B AND FREE(S+1) RS 18);
SUBR UNPCK(S) IS (
SE_FREE(S); TSE_SE AND 77B; DSE_SE RS 18;
SE1_FREE(S+1); RSE_3777B AND SE1 RS 18; CSE_777777B AND SE1);
SUBR RCOCHK(N,C,R,R1) IS (
CJ_C; V_0;
L34: CJ => (CC_FREE(CO+CJ); GO TO (L30,L31,L32,L33) CC RS 34;
L31: CJ_CJ+1; GO TO L34;
L32: CJ_CC AND 777777B; GO TO L34;
L33: CJ_CJ+2; GO TO L34;
L30: RA_3777B AND CC RS 12; RI_3777B AND CC;
RR_0; 4000B AND CC => RR_FREE(CO+CJ+1) AND 777777B;
N=1 => (RA=R => V_V+1;
RI=R => V_V+1;
RR=R => V_V+1);
N=2 => (RI=R => V_V+1;
RR=R => V_V+1);
N=3 => RA=R => (CC_CC AND NOT 37770000B;
FREES(CO+CJ,CC OR R1 LS 12));
CJ_CJ+2; GO TO L34);
V);
SUBR ADDOP(OP,S,T) IS HOOK(S,T,DEWOP(OP,REGOF(FETCH(T)),S));
SUBR DEWOP(OPP,RR,S) IS (
OP_OPP; (R_RR) LE 0=>(R_-RR; GO TO L72);
# OP AND 1000B=> THIS HITS A PROGRAMMER-SPEC REG ON PURPOSE. #
(OP AND 1000B)=>(OP_OP AND NOT 1000B; GO TO L72);
# CHECK IF OP CLOBBERS A PROGRAMMER-SPECIFIED REGISTER #
# SUBR OCHK IS PART OF THE ASSEMBLER. AOJ,AOS,SOJ,SOS ARE OK#
(OP AND 740B) NE 340B=>(OCHK(OP) AND 1)=>HISREG(R)=>(J_AREG1(1,15B);
ADDCODE(S,207000000000B,0);
ADDCODE(S,020000004000B OR J LS 12,R);
R_J);
L72: UNPCK(S);
ISE_100000000000B AND SE1 RS 2;
TSE=4=>(# CONST - CHECK FOR POSSIBLE IMMEDIATE INSTR. #
RSE_ISE_CSE_0;
(OP AND 770B)=310B => (SE1 RS 18)=0 => (OP_300B OR OP AND 7;
#CAMX TO CAIX# CSE_SE1; DSE_0; GO TO L6);
(OP AND 1003B)=0=>(
(J_SE1 RS 18)=0=>
(J_OP RS 8; K_37B AND OP RS 3;
(1 AND IMM[J] RS K)=>(L53: OP_OP OR 1;
CSE_SE1; DSE_0;
GO TO L6));
OP=200B=>(SE1=-1 => (OP_474B; CSE_0; DSE_0; GO TO L6);
J=777777B=>(OP_561B; SE1_SE1 AND 777777B; GO TO L53);
(J_SE1 AND 777777B)=0=>(OP_515B; GO TO L54);
J=777777B=>(OP_525B; GO TO L54));
# SPECIAL FLOATING POINT IMMEDIATES #
(OP AND 747B)=144B=>(SE1 AND 777777B)=0=>
(L54: SE1_SE1 RS 18; GO TO L53));
DSE=0=>DSE_STCON(SE1));
TSE=2=>(ISE_ISE OR 4000B; DSE_RSE; RSE_0);
L6: ADDCODE(S,ISE OR RSE OR (R LS 12) OR OP LS 24,DSE OR CSE LS 18);
R=>SUBREG(R)=0=>(FREES(S,2 OR SE AND 777700B);
FREES(S+1,R LS 18));
S);
SUBR TAG(S) IS (QQ_FREE(S); ADDCODE(S,200000000000B OR QQ RS 18,0); S);
SUBR COPYCO(S) IS (
NCOP_0; COPYS=0=>COPYS_FALLOT('CPYCO',20);
CJ_FREE(S+2); CJ_CJ RS 18; FREES(S+2,0);
L1: CJ=>(CC_FREE(CO+CJ);
GO TO (L10,L11,L12,L13) CC RS 34;
L13: ADDCODE(S,CC,FREE(CO+CJ+1)); CJ_CJ+2; GO TO L1;
L11: J_CC AND 777777B; CD_177B AND CD RS 27;
CD=2 => J_COPYC1(J);
CD GE 5 => CD LE 6 => J_COPYC1(J);
CD GE 8 => CD LE 10 => J_COPYC1(J);
CC_J OR CC AND NOT 777777B;
ADDCODE(S,CC,0);
CJ_CJ+1; GO TO L1;
L12: CJ_CC AND 777777B; GO TO L1;
L10: CD_FREE(CO+CJ+1);
(J_3777B AND CC RS 12) =>
(J_COPYC1(J); CC_(J LS 12) OR CC AND NOT 37770000B);
(CC AND 4000B) =>
(J_COPYC1(CD AND 777777B); CD_J OR CD AND NOT 777777B);
(J_3777B AND CC) =>
(J_COPYC1(J); CC_J OR CC AND NOT 3777B);
ADDCODE(S,CC,CD); CJ_CJ+2; GO TO L1);
CD_FREE(S+1); CT_FREE(S) AND 77B;
CT NE 2 => CT NE 20B => GO TO L16;
(J_3777B AND CD RS 18) => CD<11,18>_COPYC1(J);
L16: FREES(S+1,CD));
SUBR COPYC1(J) IS (
NCOP=>((K_FREE(COPYS+I);
(K RS 18)=J=>(I_K AND 777777B; GO TO L18)) FOR I TO NCOP-1);
I_SAMEREG(J);
FADD(COPYS,NCOP,I OR J LS 18);
L18: I);
SUBR NEXCO(I) IS (
L20: I=>(A_FREE(CO+I);
(A RS 34)=2=>(I_A AND 777777B; GO TO L20);
I_I+1);
A);
SUBR MCODE(S,T) IS (
COPYS=0=>COPYS_FALLOT('CPYCO',20);
NCOP_0;
VAL_0;
# FIRST COMPARE REGISTERS IN STACK ENTRY #
JS_FREE(S+1); JT_FREE(T+1);
MCODE1(3777B AND JS RS 18,3777B AND JT RS 18)=0=>GO TO MCOX;
JS_FREE(S+2); JT_FREE(T+2);
JS_JS RS 18; JT_JT RS 18;
L21: SE_NEXCO(JS); TE_NEXCO(JT);
(JS OR JT)=0=>(VAL_1; GO TO MCOX);
JS=0=>GO TO MCOX; JT=0=>GO TO MCOX;
(STY_SE RS 34) NE (TE RS 34)=>GO TO MCOX;
STY=>(SE NE TE=>GO TO MCOX;
STY=1=>GO TO L21;
SE_FREE(CO+JS); TE_FREE(CO+JT);
SE NE TE=>GO TO MCOX;
GO TO L22);
# COMPARE INSTRUCTION WORDS #
(SE AND 777700004000B) NE (TE AND 777700004000B)=>GO TO MCOX;
MCODE1(SE AND 3777B,TE AND 3777B)=0=>GO TO MCOX;
MCODE1(3777B AND SE RS 12,3777B AND TE RS 12)=0=>GO TO MCOX;
J_SE AND 4000B; SE_FREE(CO+JS); TE_FREE(CO+JT);
SE NE TE=>(J=0=>GO TO MCOX;
(SE RS 18) NE (TE RS 18)=>GO TO MCOX;
MCODE1(3777B AND SE,3777B AND TE)=0=>GO TO MCOX);
L22: JS_JS+1; JT_JT+1; GO TO L21;
MCOX: VAL);
SUBR MCODE1(I,J) IS ( # REGISTER CORRESPONDENCE CHECKER #
I=J=>GO TO MCX1;
D_0; B_J OR I LS 18;
NCOP=>((A_FREE(COPYS+K); A=B=>GO TO MCX1;
T_A RS 18; T=I=>GO TO MCX0; T=J=>GO TO MCX0;
T_A AND 777777B; T=I=>GO TO MCX0; T=J=>GO TO MCX0) FOR K FROM NCOP-1);
REGSIM(I,J)=0=>GO TO MCX0;
FADD(COPYS,NCOP,B);
MCX1: D_1;
MCX0: D);
SUBR SUBARG(S,PP) IS (P_PP;
UNPCK(P);
TSE=10B=>GO TO L14;
TSE=2=>(TM_SUBPRM(0);
S1_FREE(TM);S2_FREE(TM+1);
STORE(TM,P);
FREES(TM,S1); FREES(TM+1,S2);
P_TM;
GO TO L14);
TSE=4=>((SE RS 18)=0=>(J_STCON(FREE(P+1));
FREES(P,(SE AND 777777B)OR J LS 18));
FREES(P+1,0);
GO TO L14);
# TYPE 20 - SUBSCRIPTED VARIABLE #
DSE=0 => CSE=0 => (1 AND SE1 RS 35)=0 => (FREES(P,2 OR FREE(P) AND NOT 77B);
GO TO L15);
DEWOP(201B,AREG1(1,15B),P);
L15: TM_NEWNAME('CAL');
FINAM IS COMMON; RNTRNT_FINAM[5] AND 400000B;
QM_NAME(ENSTACK(TM));
DEWOP(542B,REGOF(P),QM);
HOOK(P,P,QM);
RNTRNT => P_P OR TM LS 18
ELSE ADDCODE(S,200000000000B OR TM,0);
L14: P) %%%