Trailing-Edge
-
PDP-10 Archives
-
decuslib10-03
-
43,50306/dosem.imc
There are 2 other files named dosem.imc in the archive. Click here to see a list.
TWOSEG;
#THIS IS FILE DOSEM.I10, SEMANTIC ARRAY INTERPRETER FOR IMP COMPILERS.
DOSEM IS CALLED BY COTREE WITH A POINTER INTO THE SEMANTIC ARRAY SEMS:
BITS 17-0 V (ADDRESS OR VALUE FIELD).
BITS 29-18 N (AUXILIARY COUNT FIELD).
BITS 35-30 TYPE 0=THIS IS BEGINNING OF A SEMANTIC ROUTINE WITH
N ARGUMENTS. BITS 29-27 ARE PRIORITY FOR
IMMEDIATE EXECUTION BY COTREE. V IS THE
INDEX OF THE PRODUCTION'S ENTRY IN PROSEM.
1=THIS IS END OF SEMANTICS. (SO IS SECOND TYPE 0.)
2=PUSH STACK POINTER OF PARAMETER V ONTO PSTAK.
3=CALL SEMANTIC SUBROUTINE V WITH N BOTTOM ENTRIES
(MAX 12) OF PSTAK AND PUT RESULT ON PSTAK.
4=PUSH THE VALUE -V AS NEXT SEMANTICS PARAMETER.
TYPES 5-7 ARE FOR USE IN QUOTED SEMANTICS. THEY MAKE A NUMBER
OF ENTRIES AT THE CURRENT POSITION IN THE CODE GENERATOR'S
STACK. TYPES 6 AND 7 ALSO REPLACE FUNNY TYPE 0 NODES
(GENERATED BY VALUE SEMANTICS) BY THEIR ORIGINAL PRODUCTIONS.
5=ENTER A NODE WITH VALUE V IN NEXT POSITION. IF
VALUE LESS THEN -100000, IT IS LOCAL SYMBOL -
INDEX LS 18, AND, FIRST TIME ONLY, DIR INDEX
IN LOW 18 BITS. MAKE FUNNYNAME ACCCORDINGLY.
6=ENTER NTH PARAMETER OF STACK IN NEXT POSITION.
7=COPY NTH PARAMETER OF STACK TO NEXT POSITION,
MAKING COPY OF GENERATED CODE IF ANY.
10=LOAD CONSTANT ON STACK OF PARAMS FOR 'CASE'.
11=PERFORM + FUNCTION ON LAST TWO STACK ELEMENTS.
12=PUT NODE TYPE 0 FOR [V], VALUE N, ON STACK.
(OTHER ROUTINES EXPECT THIS TO BE RIGHT
AFTER TYPE 0 NODE). ALSO TELLS COTREE THAT
ARGS OF THIS PRODN ARE NOT TO BE COLLAPSED.
********************** WARNING *************************
ANY CHANGES IN THE ABOVE MUST BE REFLECTED IN TWO PLACES: IN DOSEM AND IN SEMFIX
IF A NAME IS A SEMANTIC ROUTINE OR PREDICATE, ITS ADDRESS IS IN THE
DIRECTORY WITH THE PROPERTY 'SEM'.
THE ARRAY SEMS IS SET BY THE ROUTINE SETSEM(TY,VAL) WHICH PLACES A WORD
WITH TYPE TY AND VALUE VAL IN THE NEXT WORD IN SEMS, AND RETURNS THE
INDEX (GUARANTEED NONZERO) OF THAT WORD. (THE PRODUCTION NUMBERS IN
THE SYNTAX GRAPH WILL BE THE SEMS INDEX OF THE FIRST WORD OF THE
SEMANTICS OF THAT PRODUCTION.)
SNARG(PRODNR) IS THE NUMBER OF ARGUMENTS IN THAT PRODUCTION.
THE SEMANTIC ROUTINES OPERATE ON ENTRIES IN THE STACK ST, WHICH IS MAINTAINED
BY THE MODULE STACK AND SET UP UNDER COTREE'S DIRECTION.
THE WAY SEMANTIC ROUTINES WORK IS THIS: WHEN COTREE DECIDES THAT A ROUTINE IS
TO BE INVOKED, IT SETS UP THE STACK AND CALLS DOSEM. THE STACK POINTER
POINTS TO THE FIRST ARGUMENT OF THE PRODUCTION.
NOW THE SEMANTIC ROUTINES ARE INVOKED, AS FOLLOWS: PARAMETERS ARE EITHER
OBJECTS OR CONSTANTS OR OTHER NAMES. (THE ROUTINES ARE CALLED WITH MINUS
THE DIRECTORY INDEX FOR OTHER NAMES.) IT IS UP TO THE SEMANTIC ROUTINE TO
DO SANE THINGS (MAY CHANGE STACK ENTRIES, ETC.). THE SEMANTIC ROUTINE WILL
USUALLY RETURN A VALUE WHICH IS A STACK POINTER.
AFTER ALL THE SEMANTIC ROUTINES HAVE BEEN EXECUTED, IF THEIR RESULT IS NON-
ZERO THEN IT IS A STACK POINTER TO THE RESULT OF THE SEMANTICS. IF THE
RESULT IS ZERO, THE RESULT OF THE SEMANTICS IS WHATEVER IS IN THE STACK
ENTRY POINTED TO BY THE STACK POINTER (FIRST ARGUMENT OF THE PRODUCTION).
SEMFIX(I,A) IS CALLED BY THE SEMANTICS MAKER ROUTINE TO FIX UP SEMANTICS
INVOKED BY A QUOTED CONDITIONAL. I IS THE INDEX OF THE SEMANTICS, AND
A IS A FREE ARRAY CONTAINING THE INDICES OF THE LOCAL NAMES OF THE
ARGUMENTS, TERMINATED BY -1.
SEMFX1(I,A,N) IS CALLED BY SEMANTICS MAKER TO PATCH UP A POSSIBLE CASE OF
VAL/"STUFF" AS DEFAULT CASE. IT REPLACES TYPE 05 REFERENCES TO PRODUCTIONS
WHICH ARE CASES OF VAL BY TYPE 06 IF IT FINDS VAL IN THE PARAMETER LIST OF
THE PRODUCTION. IT ALSO REPLACES ENTRIES IN THE PARAMETER LIST BY PRODN
NUMBER FOR VAL. I,A AS ABOVE, N IS LENGTH OF A.
ENPROD(PN,NO,SEM) - IS CALLED BY ENTREE TO RECORD THE FACT THAT A PRODUCTION
MATCHES AT A CODE GENERATION TREE TERMINAL NODE. PN IS THE PRODUCTION NUMBER,
NO THE TERMINAL NODE, AND SEM THE SEMANTICS ENTRY.
THE DATA IS RECORDED IN THE FREE ARRAY PROSEM IN ENTRIES
FOR TERMINAL NODE PRODUCTIONS. THERE IS A POINTER INTO PROSEM IN THE TYPE 0
WORD OF THE PRODUCTION (BITS 17-0). THE WORD POINTED TO CONTAINS A BIT
VECTOR - 1 LS N IN THE VECTOR MEANS THAT THE PRODUCTION MATCHES SOME NODE ON
LEVEL N OF THE CODE GENERATION TREE (NOT NECESSARILY TERMINAL).
**THIS "PLIES" BIT VECTOR IS INCREMENTED EVERY TIME A PRODUCTION IS ADDED
TO THE CODE GEN TREE. FIRST TIME ONLY: PLIES_-(1 LS N). THEREAFTER, PLIES
IS AS DESCRIBED ABOVE. THUS, PLIES<0 NOW INDICATES THAT THE PRODUCTION HAS
ONLY BEEN ENTERRED ONCE INTO CODE GEN TREE, HENCE THAT THERE IS NO NEED TO
WALK INTO THE TREE WITH IT - CAN CALL SINGLE SEMANTICS IMMEDIATELY.**
THE NEXT WORD POINTS TO THE START OF A LINKED LIST OF NODES WITH FORMAT:
WORD 0: BITS 35-18: NUMBER OF A TERMINAL CODE TREE NODE WHICH THIS
PRODUCTION MATCHES.
BITS 17-0 : INDEX OF NEXT ENTRY ON LIST (OR 0).
WORD 1: BITS 35-18: IF NONZERO, THIS IS A CASE OF A CLASS. THE
SEMANTICS FROM THE LOW 18 BITS SETS UP THE
PARAMETERS. WHEN THE OP=1 IS ENCOUNTERD, THIS
IS THE INDEX AT WHICH TO START EXECUTING THE
CLASS SEMANTICS.
BITS 17-0 : INDEX IN SEMS OF THE SEMANTICS TO BE INVOKED.
WORD 2: ROW IN BIT MATRIX SBITM FOR THIS PRODUCTION.
SBITM[I,J] TELLS IF TREE NODE J CAN LEAD TO PRODUCTION
I.
WHEN A CLASS OF SEMANTICS IS DEFINED, A SPECIAL DUMMY PRODUCTION NUMBER IS
CREATED AND ENTERED IN THE DICTIONARY AS THE PROPERTY 'SEM' OF THE CLASS
NAME. A LIST IN PROSEM IS CREATED FOR THIS DUMMY ENTRY, TELLING WHERE IT
MATCHES IN THE CODE TREE AND WHERE IN SEMS TO GO FOR THE SEMANTICS. WHEN
A CASE OF IT IS FOUND, A DUPLICATE OF THE LIST IS MADE, PLUGGING IN THE
PARTICULAR SETUP SEMANTICS INDEX INTO THE SECOND WORD OF EACH NODE.
PLIES(I) - RETURNS THE BIT VECTOR FOR PRODUCTION I - BUT, IF [I] MATCHES AT
NO TERMINAL NODES, IT RETURNS 0 REGARDLESS.
NOTEPROD(PN,N) - MAKES A BIT VECTOR ENTRY FOR PRODUCTION PN AT PLY N.
MATCHP(PN,N) - CALLED BY TREE NODE MATCHER. RETURNS SEMANTICS ENTRY IF
PRODUCTION PN MATCHES AT NODE N, ELSE ZERO.
PAR(I) - SEMANTIC ROUTINE WHICH FETCHES THE I-TH PARAMETER ON THE 'CASE'
PARAMETER STACK. #
SUBR DOSEM(PPO) IS (
NPO_PPO RS 18; PO_PPO AND 777777B;
PO=1 => GO TO DOSEX;
FINAM IS COMMON; TR_FINAM[5] AND 100000B;
S_PO; NCASEP_NT0_0; FREES(PSTAK,0);
NEXTSEM: SE_FREE(SEMS+S); STY_SE RS 30; SVAL_SE AND 777777B;
TR => PRINT STG 0,' [', OCT 0,S,STG 0,'] = ',OCT 12,SE;
GO TO (TYPE0,TYPE1,TYPE2,TYPE3,TYPE4,TYPE5,
TYPE6,TYPE7,TYPE10,TYPE11,TYPE12) STY;
TYPE0: NT0=>GO TO TYPE1; # SECOND TYPE 0 IS A TYPE 1 #
NT0_1;
NPO=>GO TO NXSEM;
SCRATCH_SNARG(S);
# TRY TO INSURE STACK WON'T MOVE DURING DOSEM, WHICH WOULD BE DISASTROUS. #
SETSTK(MANY,0,0,0);
STACKP_STPOP(SCRATCH-1);
GO TO NXSEM;
TYPE1: NPO=0=>(J_FREE(PSTAK); K_STACK(0);
J=K => GO TO TYPEX;
J>K => J LE (K+3*SCRATCH) => ([K]_[J]; [K+1]_[J+1];
[K+2]_[J+2]; GO TO TYPEX);
J=0=>(FREES(K+2,0); GO TO TYPEX);
PRINT /,OCT 0,PPO,STG 0,'=',OCT 0,J,STG 0,', ';
ERROR(2,'BAD RESULT OF SEMANTICS; IGNORED **');
GO TO TYPEX);
S_NPO; NPO_NT0_0; GO TO NEXTSEM;
TYPE2: FADD(PSTAK,NPSTAK,STACK(SVAL));
GO TO NXSEM;
TYPE3: SVAL=0=>ERROR(0,'ATTEMPT TO EXECUTE UNDEFINED SEMANTIC ROUTINE.');
SN_7777B AND SE RS 18;
NPSTAK_NPSTAK-SN;
SN LE MARGS=>NPSTAK GE 0 =>GO TO L1;
ERROR(0,'** TOO MANY ARGS TO SEMANTIC RTN OR PARAM STACK UNDERFLOW **');
L1: SN => (JX_PSTAK+NPSTAK+SN;
PARS[I]_[JX_JX-1] FOR I FROM SN-1);
JSA_SVAL OR JSA AND NOT 777777B; GO TO JSA;
REMOTE (JSA: J_DOSEM(PARS[0],PARS[1],PARS[2],PARS[3],PARS[4],PARS[5],
PARS[6],PARS[7],PARS[8],PARS[9]); GO TO RET);
RET: FADD(PSTAK,NPSTAK,J); GO TO NXSEM;
TYPE10:
TYPE4:
TYPE5: SVAL_SE AND 007777777777B;
(SVAL AND 004000000000B)=>SVAL_SVAL OR 770000000000B;
STY=4=>(FADD(PSTAK,NPSTAK,-SVAL); GO TO NXSEM);
STY=10B=>(FADD(CASEP,NCASEP,-SVAL); GO TO NXSEM);
J_1;
SVAL>0=>(# USE PARS FOR LOCAL VBLS SINCE SEMANTIC RTNS AND "STUFF" NEVER
ARE MIXED. #
SVAL>777777B=>((I_(SVAL RS 18)-1)>MARGS=>ERROR((I_1),
' TOO MANY LOCAL SYMBOLS IN REFERENCED SEMANTICS');
(SVAL_SVAL AND 777777B)=>(
XNAME_DNAME(SVAL,0);
SVAL_NEWNAME(XNAME);
PARS[I]_SVAL);
SVAL_PARS[I]));
SVAL<0=>(J_0; SVAL_-SVAL);
CODENT(J OR SVAL LS 18,0,0,0);
GO TO NXSEM;
TYPE6:
TYPE7: J_STACK(SVAL);
I_FREE(J);
(I AND 77B)=0=>FREE(J+1)=>(# VALUE SEMANTICS - REPLACE ORIG. PRODN NR #
I_FREE(J+1);
FREES(J,777777000000B AND I);
FREES(J+1,0));
CODENT(FREE(J),FREE(J+1),FREE(J+2),STY-6);
GO TO NXSEM;
TYPE11:NPSTAK_NPSTAK-1; J_FREE(PSTAK+NPSTAK);
QQ_FREE(PSTAK+NPSTAK-1); FREES(PSTAK+NPSTAK-1,J+QQ);
GO TO NXSEM;
TYPE12:J_STACK(0);
FREES(J,SVAL LS 18);
FREES(J+1,(PO LS 18) OR 7777B AND SE RS 18);
FREES(J+2,0);
FREES(PSTAK,J);
CFUDGE(0);
NXSEM: TR=>(PRINT STG 0,'=>STK[',IGR 0,NPSTAK,STG 0,']=';
(J_FREE(PSTAK+NPSTAK)) GE STACK(0)=>J LE STACK(0)+3*SCRATCH=>
(PSTACK(STACK(0),J-STACK(0)); GO TO LL1);
PRINT IGR 0,J,/; LL1:0);
S_S+1; GO TO NEXTSEM;
TYPEX: TR=>PRINT /; NPSTAK_0;
DOSEX: 0);
SUBR SEMFIX(I,A) IS (
NA_I0_0;
L2: K_FREE(A+NA); K GE 0=>(NA_NA+1; GO TO L2);
J_FREE(SEMS+I);
FREES(SEMS+I,(NA LS 18) OR J AND 776000777777B);
NA_NA-1;
J_I;
L3: J_J+1;
K_FREE(SEMS+J);
JT_K RS 30;
GO TO L4[JT];
L4: GO TO L10; GO TO L11; GO TO L12; GO TO L3; GO TO L14;
GO TO L14; GO TO L12; GO TO L12; GO TO L3; GO TO L3;
GO TO L3;
L10: I0=>GO TO L11;
I0_1; GO TO L3;
L12: JT_4 OR 2 AND JT RS 1;
K_SYNARG(K AND 777777B); K_K OR 040000000000B;
FREES(SEMS+J,K);
L14: (K AND 004000000000B)=0=>NA GE 0=>(K_K AND 777777B)=>(
(KT_FREE(A+KK);
KT=(-K)=>(FREES(SEMS+J,70000000000B OR KK); GO TO L3);
KT=K=>(JT=4=>FREES(SEMS+J,20000000000B OR KK)
ELSE (FREES(SEMS+J,60000000000B OR KK);
FREES(A+KK,-KT));
GO TO L3)) FOR KK TO NA);
# CHECK FOR VAL/ ARGUMENTS #
(K AND 004000000000B)=>(
KT_-(K OR 770000000000B);
KT<1000000B=>GO TO L3;
NA GE 0=>((JJ_FREE(A+KK);
JJ=KT=>(FREES(SEMS+J,600000000000B OR KK);
GO TO L3)) FOR KK TO NA));
GO TO L3;
L11: 0);
SUBR SEMFX1(I,A,NA) IS (
NA=0=>GO TO L20;
J_I+1;
L21: K_FREE(SEMS+J);
JT_K RS 30;
JT=5=>(K AND 004000000000B)=>(K_-(770000000000B OR K)) GE 1000000B=>(
K_K AND 777777B;
(JJ_-FREE(A+KK);
JJ<0=>JJ_DPROP('SEM',-JJ);
JJ=K=>(FREES(A+KK,-(JJ OR JJ LS 18));
FREES(SEMS+J,060000000000B OR KK))) FOR KK FROM NA-1);
JT>1=>(J_J+1; GO TO L21);
L20: 0);
SUBR DOCASE(ID,SEMN,PRODN) IS (
# ROUTINE TO MAKE PROSEM ENTRIES FOR ALL CASES OF CASE ID UNDER PRODN,
WHERE SEMN IS THE SEMANTICS FOR THE SETUP. #
JD_DPROP('SEM',ID);
JD=0=>(ERROR(1,'CASE UNDEFINED ** '); PNAME(ID); PRINT /;
GO TO DOCEX);
JD_FREE(SEMS+JD); JD_JD AND 777777B;
# OR IN LEVEL BITS FOR CODE GENERATION TREE #
JE_FREE(PROSEM+JD); JE<0=>JE_-JE;
NOTEPROD(PRODN,-1);
KD_FREE(SEMS+PRODN); KD_PROSEM+KD AND 777777B;
KE_FREE(KD); KE<0=>KE_-KE; FREES(KD,KE OR JE);
JD_FREE(PROSEM+JD+1);
L29: JD=>(JE_FREE(PROSEM+JD+1); JD_FREE(PROSEM+JD);
ENPROD(PRODN,JD RS 18,SEMN OR JE LS 18);
JD_JD AND 777777B;
GO TO L29);
DOCEX: 0);
SUBR ENPROD(PN,NO,SEM) IS (
J_FREE(SEMS+PN);
(K_J AND 777777B)=0=>(K_NPROSEM; FADD(PROSEM,NPROSEM,0);
FADD(PROSEM,NPROSEM,0);
FREES(SEMS+PN,J OR K));
J_FREE(PROSEM+K+1);
FREES(PROSEM+K+1,NPROSEM);
FADD(PROSEM,NPROSEM,J OR NO LS 18);
FADD(PROSEM,NPROSEM,SEM));
SUBR MATCHP(PN,N) IS (
J,JX ARE REGISTER;
(J_FREE(SEMS+PN)<R>)=0 => GO TO MATCHPX;
J_FREE((PROSEM+J)+1);
LM1: J=>(K_FREE(JX_PROSEM+J);
N=K<L> => (J_FREE(JX+1); GO TO MATCHPX);
J_K<R>; GO TO LM1);
MATCHPX: J);
J,JX ARE RELEASED;
SUBR NOTEPROD(PN,N) IS (
J_FREE(SEMS+PN);
(K_J AND 777777B)=0=>(K_NPROSEM; FADD(PROSEM,NPROSEM,0);
FADD(PROSEM,NPROSEM,0);
FADD(PROSEM,NPROSEM,NSNODES_NSNODES+1);
FREES(SEMS+PN,J OR K));
J_FREE(PROSEM+K);
J=0 => (J_-(1 LS N))
ELSE (J<0 => J_-J;
J_J OR 1 LS N);
FREES(PROSEM+K,J));
SUBR PLIES(I) IS ((J_FREE(SEMS+I)<R>)=>J_FREE(PROSEM+J); J);
SUBR SNODEN(I) IS ((J_FREE(SEMS+I)<R>)=>J_FREE(PROSEM+J+2); J);
SUBR ENSTACK(V) IS(
#TAKES A POS OR NEG. DIRECTORY INDEX, MAKES A SCRATCH STACK NODE.#
SCRATCH>MANY=>ERROR(0,' SEMANTICS STACK OVERFLOW **');
(VV_V)<0=>VV_-V;
W_SETSTK(SCRATCH,1 OR VV LS 18,0,0);
SCRATCH_SCRATCH+1; W);
SUBR RESETSEM(VAL,A) IS (
J_FREE(SEMS+A);
FREES(SEMS+A,(J AND 777777B) OR VAL LS 18));
SUBR SETSEM(TY,VAL) IS (
SNIT=0=>(SNIT_1; FRELOT(SEMS,'SEMS',2200,0); NSEMS_2;
MANY_31; #MAX STACK EXPANSION DURING ONE EXECUTION#
FREES(SEMS+1,010000000001B);
FRELOT(PSTAK,'SPSTK',20,0); NPSTAK_0;
FRELOT(PROSEM,'PROSM',1200,0); NPROSEM_1;
FRELOT(CASEP,'CASEP',10,0);
DSEM('PAR',PAR);
DSEM('STACK',STACK);
NSNODES_0;
PARS IS 10 LONG; MARGS_10);
V_NSEMS; FADD(SEMS,NSEMS,VAL OR TY LS 30); V);
SUBR PAR(I) IS FREE(CASEP+I);
SUBR SEMPER() IS (
LOC(SEMPR1) => J_SEMPR1(SEMS,PROSEM,NSEMS,K)
ELSE (SE0CNT=0=>(SE0CNT_1; J_0;
ERROR(2,'SEMPER DEBUGGING PGM NOT PRESENT')));
J);
SUBR SNARG(N) IS (777B AND FREE(SEMS+N) RS 18);
SUBR SEMGET(N) IS (Q_FREE(SEMS+N) AND 777777B;
Q_FREE(PROSEM+Q+1);
Q_FREE(PROSEM+Q+1) AND 777777B; Q);
SUBR SEMED(A) IS (7 AND FREE(SEMS+A) RS 27);
SUBR SEMOR(A,N) IS (QQ_FREE(SEMS+N);
FREES(SEMS+N,QQ OR A));
SUBR CKSVAL(V,I) IS ( # CHECKS IF [V] IS A VALUE (TYPE 12) CASE OF I #
Q_FREE(SEMS+V+1);
VAL_0;
(Q AND 770000777777B)=(I OR 120000000000B)=>VAL_1;
VAL)%%