Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0068/parse.imc
There are 2 other files named parse.imc in the archive. Click here to see a list.
TWOSEG;
# PARSE: THE IRONS FAST MULTI-TRACK PARSER WITH MODIFICATIONS,
ERROR CORRECTION AND DISAMBIGUATION BY BILOFSKY.
PARSES ARE COPIED FROM FREE STORAGE ARRAY P TO ARRAY PP.
OUTPUT IS STORED IN A FORWARD LINKED LIST,
FIRST-IN-LAST-OUT, IN FREE STORAGE ARRAY O.
WHEN A UNIQUE PARSE IS ENCOUNTERED, THE OUTPUT IS
EXTRACTED AND REVERSED, AND O IS CLEANED OUT.
THE FORMAT FOR PARSE ENTRIES IS:
WD 0 OUTPUT CHAIN POINTER OFFSET OF LAST PAIR
WD 1 CURRENT NODE
WD 2 ON NODE INVOKING GOAL NT NR OF GOAL
AND FOR OUTPUT ENTRIES:
BITS 0-17 PRODUCTION NR. OR -DIR INDEX OF NAME
BITS 18-35 INDEX OF NEXT WORD IN CHAIN
THE NEXT WORD OF P,PP,O IS NP,NPP,NO.
THE NUMBER OF PARSES IN P,PP IS PN,PPN.
THE SYNTAX GRAPH MUST REFER TO NODES MATCHING ANY NAME BY THE FUNNY
TERMINAL SYMBOL "NAM"+NUMBER-SIGN, SYMBOLS BY "SYM"+NUMBER-SIGN.
THE PARSER USUALLY GETS SYMBOLS FROM SUBR LEX, BUT SYMBOLS MAY BE
INSERTED IN THE STREAM BY CALLING PFORCE(DIR INDEX) FOR EACH
SYMBOL TO BE INSERTED, ON A LAST-IN-FIRST-OUT BASIS. #
SUBR PARSE(GOAL) IS (
FINAM IS COMMON; TR_FINAM[5] AND 100B;
PSTS_PSPN_PSPNT_PSPS_PSPST_PSOS_AMTIME_0;
PSTT_-CALLI(27B,0); SRTT_0;
INIT=0=>(INIT_1;
P_FALLOT('P/P',400);
PP_FALLOT('P/PP',150);
FRELOT(O,'P/OUT',100,0));
NO_1; PN_OPN_1; GOTIT_0;
GOL_DIR(GOAL); GOLE_DPROP('NODE',GOL); J_GGOAL(GOL);
FREES(P,2); FREES(P+1,J); FREES(P+2,GOLE OR J LS 18); NP_3;
S IS 3 LONG; S[1]_DIR('SYM#'); S[2]_DIR('NAM#');
NEXTS: SYMBOL(S); PSTS_PSTS+1;
(NAME_DPROP('ISNM',S)-1)<0=>DPROPS('ISNM',S,(NAME_ISNAME(S))+1);
NAME_ISNAME(S);
TR=>(PRINT /,STG 0,'NEXT INPUT SYMBOL: '; PNAME(S);
PRINT STG 0,', ',IGR 0,PN,STG 0,' POSSIBLE PARSES.',/);
PPN_IP_IPP_NPP_PI_0;
NEXTP: L_FORG+P+IP;
COFF_[L] AND 777777B;
NXIP_IP+COFF+1;
TR=>(PRINT STG 0,' PARSE #', IGR 0, PI+1);
CGOAL_[L+COFF] AND 777777B;
CNODE_[L+1];
NEXTN: CVAL_GVAL(CNODE);
TR=>PARTRA(0);
GO TO (NTWANTED,TWANTED,NTMADE,OUTPUT) GTYPE(CNODE);
TWANTED: (CVAL=S[I] => (J_COPY(PP,NPP,PPN);
K_GNEXT(SCR(CNODE),CGOAL);
FREES(J+1,K);
TR=>(PRINT STG 0,' MATCH FOR '; PNAME(CVAL);
PRINT STG 0,' SO NEW PARSE #',IGR 0,PPN,STG 0,
' IS MADE.',/);
I=>POUT(J,-S);
GO TO TAKEALT)) FOR I FROM NAME;
GO TO TAKEALT;
OUTPUT: J_CNODE;
L1: (J_GNEXT(ALT(J),CGOAL))=>(K_COPY(P,NP,PN);
TR=>(PRINT STG 0,' PARSE #',IGR 0,PN,
STG 0,' SPAWNED FOR ALT NODE.',/);
FREES(K+1,J);
GO TO L1);
POUT(P+IP,CVAL);
CNODE_SCR(CNODE);
GO TO NEXTN;
NTWANTED: NGOAL_DPROP('NODE',CVAL);
(ENT_DPROP('ENTRY',S[I]);
J_GNEXT(SCR(ENT),NGOAL);
J=>(K_COPY(PP,NPP,PPN);
TR=>(PRINT STG 0,' '; PNAME(S[I]);
PRINT STG 0,' -> '; PNAME(CVAL);
PRINT STG 0,' AT NODE #',IGR 0,ENT,STG 0,
' SO NEW PARSE #',IGR 0,PPN,STG 0,' IS FORMED.',/);
L_FORG+K;
[L]_[L]+1;
[L+1]_J;
I=>POUT(K,-S);
FADD(PP,NPP,NGOAL OR CNODE LS 18))) FOR I FROM NAME;
GO TO TAKEALT;
NTMADE: NTN_DPROP('NODE',CVAL);
(TNODE_DPROP('NODE',S[I]);
L2: TNODE => GNT2TX(NTN,TNODE,CGOAL,NNODE) =>
(K_COPY(P,NP,PN);
TR=>(PRINT STG 0,' "'; PNAME(S[I]);
PRINT STG 0,'" MAY CONTINUE SO PARSE #',
IGR 0,PN,STG 0,' IS SPAWNED.',/);
FREES(K+1,NNODE);
GPOUT1(CNODE,NNODE,K);
GO TO L2)) FOR I FROM NAME;
NTN=CGOAL => GO TO L3;
GMADE(CNODE,CGOAL)=>(GPOUT2(CNODE,CGOAL,P+IP);
L3: CGOAL=GOLE=>(COPY(PP,NPP,PPN);
GOTIT_1;
GO TO TAKEALT);
K_COPY(P,NP,PN);
L_FORG+K; [L]_[L]-1;
NP_NP-1; LL_FORG+P+NP;
J_[LL] RS 18;
NGOAL_[LL-1] AND 777777B;
J_GNEXT(SCR(J),NGOAL);
[L+1]_J;
TR=>(PRINT STG 0,' GOAL REACHED SO PARSE #',
IGR 0,PN,STG 0,' IS SPAWNED.',/));
TAKEALT: (CNODE_GNEXT(ALT(CNODE),CGOAL))=>
(TR=>PRINT STG 0,' ALT NODE TAKEN.'; GO TO NEXTN);
IP_NXIP; (PI_PI+1)<PN => GO TO NEXTP;
CKNP: PPN>1=> (FLAG'Z'=>AMTIME_AMTIME-1+CALLI(27B,0);
AMBIG(PP,NPP,PPN,O,TR);
FLAG'Z'=>AMTIME_AMTIME+CALLI(27B,0));
PPN>1=>(GOTIT=>ERROR(1,'SYNTACTIC AMBIGUITY; UNRESOLVED AT % **');
GO TO END1SYM);
PPN=0=>(#PARSE TREE DIED - DO ERROR CORRECTION#
FINAM[5]_FINAM[5] OR 4000B; #LIST#
PLINE1(OL);
OUTSTR('** SYNTAX ERROR ');
PRINT STG OL+4,'^',/,
STG 0,'** SYNTAX ERROR ','- "';
L_J_ERCOR(P,OPN,S);
MSG('**');
ERROR(1,0);
PRINT STG 0,'" IS REPLACED BY "';
L4: (K_FREE(J))=>(PNAME(K); J_J+1;
PRINT STG 0,' '; GO TO L4);
PRINT STG 0,'"',/;
PFORCE(FREE(I)) FOR I IN J-1,-1,L;
FALLOT(L,0);
NP_NOP; PN_OPN; GO TO NEXTS);
#THERE IS JUST 1 PARSE; FEED OUT OUTPUT.#
(J_FREE(PP) RS 18) => (PUSHMI(0);
L5: J => (J_FREE(O+J); K_J RS 18;
J<0=>K_K OR 777777000000B;
PUSHMI(K);
J_J AND 777777B; GO TO L5);
FINAM[5] AND 243130160B=>(
K_CALLI(27B,0); PSTT_PSTT+K; SRTT_SRTT-1+K);
L6: (K_PULLYU(0)) => (COTREE(K); GO TO L6);
FINAM[5] AND 243130160B=>(
K_CALLI(27B,0); PSTT_PSTT-1+K; SRTT_SRTT+K));
NO>PSOS=>PSOS_NO; NO_1;
HRL([FORG+PP],0);
END1SYM: NPP>PSPS=>PSPS_NPP; PPN>PSPN=>PSPN_PPN;
NP>PSPST=>PSPST_NP; PN>PSPNT=>PSPNT_PN;
GOTIT=0=>(J_P; P_PP; PP_J;
PN_OPN_PPN;
NOP_NP_NPP; GO TO NEXTS);
PSTT_PSTT+CALLI(27B,0));
SUBR SYMBOL(SS) IS (
NSYMBS=>(NSYMBS_NSYMBS-1; SS_FREE(SYMBS+NSYMBS))
ELSE OL_LEX(SS); 0);
SUBR PFORCE(SY) IS (
KNIT=0=>(KNIT_1; NSYMBS_0; FRELOT(SYMBS,'P/SYM',20,0));
FADD(SYMBS,NSYMBS,SY));
SUBR COPY(QQ,NQQ,QQN) IS (
# COPIES OLD PARSE FROM P+IP INTO QQ+NQQ AND
RETURNS FREE STORAGE POINTER TO FIRST WORD OF NEW PARSE.#
QQN_QQN+1;
COPYV_NQQ;
NQQ_NQQ+COFF+1;
FLEN(QQ)<NQQ => FADDEX(QQ,NQQ);
COPYV_COPYV+QQ;
MOVE [P+IP] THROUGH COFF TO [COPYV];
COPYV);
SUBR POUT(QQ,VV) IS (#PUTS OUTPUT VV ON PARSE CHAIN AT QQ#
TR=>(PRINT STG 0,' '; VV<0=>PNAME(-VV) ELSE (PRINT '[',OCT 0,VV,
STG 0,']'); PRINT STG 0,' ADDED TO OUTPUT.',/);
KQ_FORG+QQ;
Q_[KQ] RS 18; HRL([KQ],NO);
FADD(O,NO,Q OR VV LS 18));
SUBR PARSEF() IS (
FALLOT(PP,0); FALLOT(P,0); FALLOT(O,0));
SUBR PSTATS() IS (SRTT_SRTT-ASTIME(0);
PRINT STG 0,'PARSE TIME ',IGR 0,PSTT,STG 0,' MSEC., ', IGR 0,
PSTS,STG 0,' INPUT SYMBOLS.',/,' MAX. PARSE BRANCHING ',
IGR 0,PSPNT,STG 0,'/',IGR 0,PSPN,/,STG 0,' MAX. PARSE SPACE ',
IGR 0,PSPST,STG 0,'+',IGR 0,PSPS,STG 0,', MAX. OUTPUT SPACE ',
IGR 0,PSOS,/;
AMTIME=>PRINT STG 0,'AMBIG ',IGR 0,AMTIME,STG 0,' MS.',/;
(I_COTREE(1))=>(PRINT STG 0,'SEMANTIC ROUTINES TIME ',IGR 0,I,STG 0,' MS.',/,
'CODE TREE TIME '; SRTT_SRTT-I; GO TO PSTL1);
SRTT>0=>(PRINT STG 0,'SEMANTIC ROUTINES TIME ';
PSTL1: PRINT IGR 0,SRTT,STG 0,' MS.',/);
PSTS);
SUBR PARTRA() IS (
LOC(PARTR1) => J_PARTR1(CNODE,GTYPE(CNODE),CVAL,P,IP,O,IP+COFF)
ELSE (PAR0CNT=0=>(PAR0CNT_1; J_0;
ERROR(2,'PARTR1 DEBUGGING PGM NOT PRESENT')));
J) %%%