Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0068/cotree.imc
There are 2 other files named cotree.imc in the archive. Click here to see a list.
TWOSEG; #<EXP>::=TR::="0";<EXP>::=TRM::="0";#
#THIS IS FILE COTREE.I10, SEMANTIC STACK REDUCER FOR IMP COMPILERS.
COTREE(S) - CALLED BY THE PARSER TO ADD ANOTHER ITEM TO THE CODE STACK.
S IS EITHER A PRODUCTION NUMBER OR MINUS A DIRECTORY INDEX OF A TERMINAL
SYMBOL. IF THE ITEM ADDED IS A PRODUCTION NUMBER, A SEARCH-AND-PERHAPS-
GENERATE IS PERFORMED. THIS IS DONE AS FOLLOWS: A MATCH IS ATTEMPTED
BETWEEN A PATH THROUGH THE CODE TREE AND A SEGMENT OF THE CODE STACK,
STARTING AT EACH POSITION IN THE STACK. IF A MATCH IS FOUND, THE
MATCHING PORTION OF THE CODE STACK IS COPIED INTO THE SEMANTIC ROUTINES
STACK, AND THE APPROPRIATE SEMANTIC ROUTINE INVOKED VIA A CALL TO DOSEM.
UPON RETURN, THE TOP ENTRY IN THE SEMANTIC ROUTINES STACK CONTAINS THE
RESULT OF THE SEMANTICS, AND IS COPIED INTO THE CODE STACK, REPLACING ALL
THE ENTRIES THAT WERE COPIED OUT. THE PROCESS IS ITERATED UNTIL NO MATCH
IS FOUND. (COTREE(0) INITIALIZES CODE STACK.)
THE FORMAT OF A STACK ENTRY (EITHER CODE OR SEMANTICS) IS :
WORD 1 BITS 35-18 DI USUALLY A DIRECTORY INDEX
BITS 7-6 AR 0=NO TYPE ASSIGNED, 1=INTEGER, 2=REAL.
BITS 5-0 TY TYPE OF NODE. SEE BELOW.
WORD 2 VAL VALUE ASSOCIATED WITH NODE.
WORD 3 BITS 35-18 CB POINTER TO BEGINNING OF ASSOCIATED CODE
BITS 17-0 CE POINTER TO END OF CODE
THE TYPE IS AS FOLLOWS:
0 = PRODUCTION, DI = INDEX OF PRODUCTION IN SEMS.
1 = RAW IDENTIFIER.
2 = REGISTER, VAL AS BELOW.
4 = CONSTANT. VAL=VALUE (FIRST WORD, IF CONSTANT IS MULTIWORD).
DI=0 MEANS CONSTANT WAS RESULT OF COMPUTATION.
10 = IDENTIFIER. MAY CONSIST OF EITHER OR BOTH OF A DIRECTORY
INDEX PLUS AN OFFSET (VAL). IF THE DIR INDEX IS 0, IT
SHOULD REALLY BE A TYPE 4.
20 = SUBSCRIPTED VARIABLE. VAL (AND MAYBE CODE) ARE SUBSCRIPT.
FOR TYPES 2, 10, AND 20, VAL INDICATES THE VALUE OF THE ELEMENT OR
THE RESULT OF THE CODE COMPUTED, AS FOLLOWS:
BIT 35 INDIRECT BIT. IF 1, THE VALUE COMPUTED BY THIS EXPRESSION
IS THE ADDRESS OF THE RESULT, OTHERWISE IT IS THE RESULT.
BITS 28-18 REGISTER. INDEX OF ASSOCIATED REGISTER IN REGISTER ALLOCATION
ARRAY.
BITS 17-0 OFFSET. INTERPRETED AS A CONSTANT.
THE VALUE INDICATED IS THE SUM OF THE ADDRESS OF THE VARIABLE POINTED TO BY
THE DIRECTORY INDEX DI (OR 0 IF DI=0), THE CONTENTS OF THE REGISTER, AND
THE OFFSET.
IMP11 EXTENSIONS: WORD 1 BITS 7-6 AR 3=BYTE (HALF-WORD)
FOR TYPE 20, WORD 2 BITS 35-33 ADDRESS MODE (0-7)
BITS 28-18 REGISTER INDEX
BITS 17-0 CONSTANT OFFSET
SAMEAS(K,SN) - IS CALLED BY MATCH TO CHECK WHETHER THE ITEM AT FREE STORAGE
ADDRESS SN (WHICH COTREE HAS JUST FED TO MATCH) IS THE SAME AS THE KTH ITEM
IN THE PARTIAL MATCH. IF THERE IS ANY CODE ASSOCIATED WITH THE ITEMS, IT
IS COMPARED.
CODENT(A,B,C,F) - CALLED BY DOSEM TO PUT STACK ENTRIES BACK IN STACK FOR
QUOTED SEMANTICS. ENTRY IS (A,B,C), AND F=>MAKE FRESH COPY OF CODE IF ANY.
SETPRI(N) - SEMANTIC ROUTINE TO SET A PRIORITY FOR IMMEDIATE EXECUTION OF
PRIORITY SEMANTICS. IF (PRIORITY OF A PROD'N) AND (CURRENT PRIORITY) NE 0,
THE SEMANTICS IS EXECUTED RIGHT AWAY. PRIORITY BITS ASSIGNED SO FAR ARE:
1=NORMAL STATE, 2=INSIDE QUOTED STUFF, 4=AVAIL.
WHEN QUOTED SEMANTICS ARE PROCESSED, THEY ARE STORED IN FREE ARRAY MAXIE. THE
MAXWELL'S DEMON WHICH SHUNTS THEM THERE IS TURNED ON BY SEMANTICS MAXWELL(),
WHICH PUTS A PHONY TYPE 1 ENTRY ON THE STACK TO OCCUPY THE VACANT PLACE WHERE
THE QUOTED STUFF WON'T GO. MAXEND() TURNS OFF THE DEMON. IN ORDER TO PERMIT
HAVING MORE THAN ONE QUOTED PARSE OUTPUT AROUND AT A TIME, A SEPARATE ARRAY IS
USED FOR EACH ONE, AND THE ROUTINE THAT USES THE ARRAY MUST DELETE IT. #
TORG IS COMMON;
SUBR COTREE(SS) IS (S_SS;
FINAM IS COMMON; TR_FINAM[5] AND 110000B; TRM_FINAM[5] AND 10000B;
INIT=0=>(INIT_1; PRIO_1;
DSEM('MAXWELL',MAXWELL);
DSEM('MAXEND',MAXEND);
DSEM('SETPRI',SETPRI);
FRELOT(CS,'COSTK',90,0); NCS_CTT_0;
FRELOT(ST,'COST2',15,0));
S=0 => (NCS_0; GO TO COTREX); #INITIALIZE#
S=1 => GO TO COTREX; #DUMMY PRODUCTION NO#
IMMED_0; S>0 => IMMED_SEMED(S);
TR=>(PRINT STG 0,'COTREE CALLED WITH ';
S<0 => PNAME(-S) ELSE PRINT '[',OCT 0,S,STG 0,']';
IMMED => (PRINT STG 0,' IMMEDIATE EXECUTION';
(IMMED AND PRIO)=0 => PRINT ' (DEFERRED)');
PRINT '; STACKED AT ',IGR 0,NCS,STG 0,' MARK ',IGR 0,MARK,/);
DEMON => (IMMED AND PRIO)=0 => (FADD(MAXIE,NMAXIE,S); GO TO COTREX);
S<0 => J_1 OR -S LS 18
ELSE J_S LS 18;
I_NCS+3; FLEN(CS) LE I => FADDEX(CS,I);
K_CS+NCS; NCS_I; [K]_J; [K+1]_0; [K+2]_0;
S<0=>GO TO COTREX;
(IMMED AND PRIO) => (IC_NCS-3; XNOW: MARK=2 => MARK_4;
J_SNARG(S); NC_IC-3*J;
J_SEMGET(S); GO TO L1);
DOITAGAINSAM: GO TO (M1,M1,M2,M3,M4) MARK;
M4: IP_IM-3; NC_NM; MARK_1; GO TO TRYON;
M1: NC_-3;
NXST: (NC_NC+3) GE NCS => (MARK_3; GO TO COTREX);
IP_NC; L13: IP=NCS => (MARK_3; GO TO COTREX);
J_FREE(CS+IP); J AND 77B => (IP_IP+3; GO TO L13);
S_J RS 18; GO TO CK;
M3: IP_NCS-3;
CK: TRM=>(PRINT STG 0,'PLIES[',OCT 0,S,STG 0,']=',OCT 0,PLIES(S),STG 0,
' AT STACK ',IGR 0,IP,STG 0,' NC=',IGR 0,NC,/);
IC_IP; K_PLIES(S); K<0 => GO TO XNOW;
(SEMED(S) AND PRIO) => GO TO XNOW;
(I_1 LS (IP-NC)/3)=0=>ERROR(0,'SEMANTIC CONDITION TOO COMPLEX.');
L14: (K AND I)=0 => (I_I RS 1; I=0 => GO TO NXST; NC_NC+3;
NC GE NCS => (MARK_3; GO TO COTREX); GO TO L14);
SNONR_SNODEN(S);
NODE_TSCR(1); NST_0; IM_NM_NC;
TRYON: IM>IP => (IM=NCS => (MARK_2; GO TO COTREX); #PARTIAL MATCH#
L20: (IP_IP+3)<NCS => (J_FREE(CS+IP)) AND 77B => GO TO L20;
IP=NCS => (IP_IP-3; SNONR_-1) ELSE (
SEMED(S_J RS 18) AND PRIO=>(IC_IP; MARK_2;
GO TO XNOW);
(K_PLIES(S))>0=>
K AND 1 LS (IP-NC)/3=0=>GO TO POPPIT;
SNONR_SNODEN(S)));
M2: J_MATCH(NODE,CS+IM,SNONR); MARK_1;
TRM=>(PRINT STG 0,'MATCH NODE',IGR 4,NODE,STG 0,' BEFORE #',
IGR 0,SNONR,STG 0,' VS STACK',
IGR 3,IM,STG 0,' = ';
J>0 => PRINT OCT 0,J ELSE PRINT IGR 0,J; PRINT /);
J=0 => (TRYALT: NODE=>(NODE_TALT(NODE)) => GO TO M2;
POPPIT: NST=>(NST_NST-1;
(77B AND J_FREE(CS+IM))=0=>
(SNONR_SNODEN(S_J<L>); IP_IM);
IM_IM-3;
NODE_FREE(ST+NST) AND 777777B;
GO TO TRYALT);
GO TO NXST);
J<0 => ((T_TSCR(NODE)) => (#MARK VAL/ NODE READ AS ORIG PRODN#
J=-2=>NODE_NODE OR 400000000000B;
FADD(ST,NST,NODE);
IM_IM+3;
NODE_T; GO TO TRYON)
ELSE GO TO TRYALT);
IC_IM; NC_NM;
#MATCH FOR NC THRU IC - INVOKE [J]#
L1: IC_IC+3; L_STINIT(IC-NC); LL_0;
(([K_CS+I] AND 77B)=0 => (#IGNORE PRODNS UNLESS THEY ARE VAL/ ARGUMENTS#
[K+1]=0=>GO TO IGN;
FREE(ST+(I-NC)/3)<0=>GO TO IGN);
[L]_[K]; [L+1]_[K+1]; [L+2]_[K+2];
L_L+3; LL_LL-1; IGN: 0) FOR I IN NC,3,IC-3;
STPOP(LL);
ENTRIES_0;
FLAG'Z'=>CTT_CTT-1+CALLI(27B,0);
DOSEM(J);
FLAG'Z'=>CTT_CTT+CALLI(27B,0);
MARK NE 4 => MARK_1;
ENTRIES>0=>(#INSERTS FROM QUOTED SEMANTICS#
(I_ENTRIES-IC) => (J_NCS+I; FLEN(CS) LE J => FADDEX(CS,J);
MOVE [CS+IC] THROUGH I-1 TO [CS+NCS];
NCS_J);
IC_ENTRIES; GO TO L2);
J_STACK(0); K_CS+NC;
[K]_[J]; [K+1]_[J+1]; [K+2]_[J+2];
TR=>(PRINT STG 0,'REDUCED AT ',IGR 0,IC-3,STG 0,'. TOP=',
IGR 0,NCS+NC-IC,STG 0,', RESULT: ';
PSTACK(CS,NC); PCODE(CS+NC,5));
ENTRIES<0=>GO TO DOITAGAINSAM;
NC_NC+3;
L2: IC<NCS=>NC<IC=>MOVE [CS+IC] THROUGH NCS-(IC+1) TO [CS+NC];
NCS_NCS+NC-IC;
TR=0=>GO TO DOITAGAINSAM;
ENTRIES LE 0=>GO TO DOITAGAINSAM;
PRINT STG 0,'STACK AFTER INSERTING QUOTED SEMANTICS IS:',/;
PSTACK(CS,I) FOR I IN 0,3,NCS-3;
GO TO DOITAGAINSAM;
COTREX: CTT);
SUBR CFUDGE() IS (ENTRIES_-1);
SUBR CODENT(A,B,C,F) IS (
ENTRIES=0=>ENTRIES_NCS;
FLEN(CS) LE (NCS+3) => FADDEX(CS,NCS+3);
CSX_CS+NCS; NCS_NCS+3;
[CSX]_A; [CSX+1]_B; [CSX+2]_C;
F=>C=>COPYCO(CS+NCS-3));
SUBR CKDONE() IS (
NCS>6=>(ERROR(1,'CODE GENERATION STACK DID NOT REDUCE TO ONE ITEM **');
PSTACK(CS,I) FOR I IN 0,3,NCS-3));
SUBR MAXWELL(N) IS (NMAXIE_0; DEMON_1;
MAXIE_FALLOT('DEMON',15);
(FADD(CS,NCS,1); FADD(CS,NCS,0); FADD(CS,NCS,0)) FOR J FROM N; 0);
SUBR MAXEND(A) IS (DEMON_0; FADD(MAXIE,NMAXIE,0); FREES(A+1,MAXIE); A);
SUBR SETPRI(A) IS (PRIO_A; 0);
SUBR SAMEAS(SN,K) IS (
TN_CS+NC+3*K; SV_0;
R_FREE(SN); T_FREE(TN); R NE T=>GO TO SMEX;
S_R AND 77B;
R_FREE(SN+1); T_FREE(TN+1); R NE T=>(
(S AND 32B)=0=>GO TO SMEX;
(R AND 774000777777B) NE (T AND 774000777777B)=>GO TO SMEX;
GO TO SMUX);
R_FREE(SN+2); T_FREE(TN+2); R NE T=>(
R=0=>GO TO SMEX; T=0=>GO TO SMEX;
SMUX: MCODE(SN,TN)=0=>GO TO SMEX);
SMOK: SV_-1;
SMEX: SV);
SUBR PSTACK(S,N) IS (
LOC(PSTAC1) => J_PSTAC1(S,N)
ELSE (PST0CNT=0=>(PST0CNT_1; J_0;
ERROR(2,'PSTAC1 DEBUGGING PGM NOT PRESENT')));
J) %%