Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0068/entree.imc
There are 2 other files named entree.imc in the archive. Click here to see a list.
TWOSEG;

#THIS IS ENTREE, THE CODE TREE MAKING ROUTINE FOR THE IMP COMPILERS.

 THE CODE TREE IS KEPT IN FREE STORAGE ARRAY CT, AND CONSISTS OF TWO (OR
SOMETIMES THREE) WORD NODES:

    WORD 1: BITS 35-18  INDEX OF ALTERNATE NODE (DOWN POINTER)
            BITS 17-0   INDEX OF SUCCESSOR NODE (RIGHT POINTER)
    WORD 2: BITS 35-33  TYPE: 2=THIS NODE IS TO BE MATCHED WITH KTH ITEM OF
                                THE PATTERN.  K IS LOW 18 BITS OF THIS WORD.
                              3=MATCH WITH IDENTIFIER ID  (DIR INDEX OF ID IS
                                LOW 18 BITS).  IF BIT 18 IS A 1,  ID IS THE
                                INDEX OF A ONE WORD CONSTANT WHOSE VALUE IS IN
                                THE THIRD WORD OF THIS NODE, AND AN ATTEMPT
                                SHOULD ALSO BE MADE TO MATCH BY VALUE.
                              1=MATCH WITH A STACK ITEM OF INDICATED TYPE:

     TYPE 1 NODE HAS A SECOND WORD AS FOLLOWS:

      (NR BITS)  3   2 111 111  5  5  7   8
                TTT XI WSV CRN PP QQ KKK LLL

     TTT = TYPE
      X  = 1 IF FLOATING POINT MAY MATCH (NOT CHECKED FOR N)
      I  = 1 IF INTEGER MAY MATCH (NOT CHECKED FOR N)
             (IMP11: IF X=I=0, ONLY BYTE MAY MATCH)
      W  = 1 IF ONLY EXPRESSIONS GENERATING EXACTLY 1 WORD OF CODE MAY MATCH
             (IMP11: ONLY EXPRESSIONS WITHOUT SIDE-EFFECTS MAY MATCH)
      S  = 1 IF ANY SUBSCRIPTED VARIABLE MAY MATCH.
      V  = 1 IF ANY SIMPLE VARIABLE MAY MATCH.
      C  = 1 IF SOME CONSTANT MIGHT MATCH (MODIFIED BY KKK LLL)
      R  = 1 IF SOME REGISTER MIGHT MATCH (MODIFIED BY PPP QQQ)
      N  = 1 IF ANY RAW IDENTIFIER MAY MATCH.

     IF A REGISTER IS CALLED FOR IT MUST BE ONE OF THE REGISTERS NUMBERED
       PP THROUGH QQ (RANGE 0-37B).  IF A CONSTANT IS CALLED FOR,
       IT MUST BE ZERO EXCEPT FOR THE KKK BITS STARTING LLL BITS FROM THE
       RIGHT END OF THE WORD (RANGE 00-177B).  IF LLL HAS THE 200B BIT SET,
       THEN THE CONSTANT MUST BE ALL ONES EXCEPT FOR THE KKK BIITS STARTING
       (LLL AND 177B) BITS FROM THE RIGHT OF THE WORD.
     IF WSVCRN=00, THEN THE NODE MATCHES PRODUCTIONS, AND THE NODE IDENTIFIER
       IS IN THE RIGHTMOST 18 BITS OF THE WORD.  IF BIT 19=0, THEN THE NODE
       MATCHES ONLY THE PRODUCTION NUMBER WHICH IS THE IDENTIFIER.  BIT 18 IS
       0 IF THIS IS A REAL PRODUCTION AND 1 IF IT IS A CLASS OF VAL/ PROD'NS.   
       IF BIT 19 IS 1, THEN THIS IS A TERMINAL NODE AND MATCHP (IN DOSEM) IS
       CALLED TO DETERMINE IF THERE HAS BEEN A MATCH AND TO FETCH THE SEMANTICS.

THE ROUTINES WHICH BUILD AND SEARCH THE CODE TREE ARE:

MATCH(TN,SN) - CHECKS IF TREE NODE TN IS MATCHED BY A STACK ENTRY BEGINNING
   AT FREE STORAGE ADDRESS SN.  RETURNS 0 IF NO MATCH, -1 IF A MATCH, AND
   THE SEMANTICS NUMBER IF A MATCH WAS MADE AT A TERMINAL NODE (I.E., WHEN
   A COMPLETE PATH HAS BEEN FOUND).

ENTREE(S,CS,SR,PN) - S IS THE POINTER TO A FREE STORAGE ARRAY CONTAINING PARSER
   OUTPUT TO BE ENTERED IN THE CODE TREE.  THE ENTRIES ARE EITHER NEGATIVE DIR
   INDICES OR POSITIVE SEMANTICS INDICES.  CS IS THE NUMBER OF THE PRODUCTION
   BEING PROCESSED (I.E., PARSER OUTPUT).  SR IS THE SEMANTIC ROUTINE TO BE
   INVOKED BY THIS INSTANCE OF THE SEMANTICS.  PN IS THE PRODUCTION NUMBER TO
   BE INSERTED IN THE CODE GENERATION TREE (DIFFERS FROM CS IF A CASE IS
   BEING DEFINED).
  THE VALUE RETURNED BY ENTREE IS A FREE STORAGE ARRAY CONTAINING THE DIR
   INDICES OF THE IDENTIFIER CORRESPONDING TO EACH TERMINAL SYMBOL IN S (OR 0
   FOR A CONSTANT. THE ARRAY IS TERMINATED BY A NEGATIVE
   ENTRY.  ENTREE WILL ALTER THE ARRAY S.

 THE PARSER OUTPUT IS GENERATED BY PARSING AN INSTANCE OF THE PRODUCTION
   BEING PROCESSED.  IT CONTAINS IDENTIFIERS OF THE FOLLOWING FORMS:

             REGNNKK      NN,KK DECIMAL DIGITS - WILL MATCH A REGISTER
                              BETWEEN NN AND KK.
             REGNN        SAME AS REGNNNN
             REG          MATCHES ANY REGISTER.
             CONMMKK      MATCHES A CONSTANT IN MM BITS SHIFTED KK BITS LEFT.
             CONMM        SAME AS CONMM00
             CON          MATCHES ANY CONSTANT
             CNG          USED SAME AS CON, BUT FOR NEGATIVE CONSTANTS.
             VAR          MATCHES ANY CONSTANT OR SIMPLE VARIABLE
             MEM          MATCHES ANY SUBSCRIPTED VARIABLE.
             FLT          ONLY FLOATING POINT MAY MATCH
             IGR          ONLY FIXED POINT MAY MATCH
             BYT          (IMP11) ONLY ATYPE BYTE WILL MATCH
             NAM          MATCHES A RAW IDENTIFIER.
             WRD          (IMP10) ONLY 1 WORD OF CODE MAY MATCH.
             NSE          (IMP11) ONLY NO-SIDE-EFFECTS MAY MATCH.

     AN IDENTIFIER WITHOUT MODIFIERS MAY MATCH ANY OF THE ABOVE.
       THE PROPERTIES FLT AND IGR ARE ORTHOGONAL TO THE OTHERS.
       THE PROPERTY WRD IS ORTHOGONAL TO THE OTHERS.
     A REGISTER MATCHES THE SPECIFICATIONS ONLY WHEN IT IS FORCED, WHEN
       EVENTUALLY ALLOCATED, TO FALL WITHIN THE SPECIFIED LIMITS.
     AN IDENTIFIER WHICH MAY MATCH MORE THAN ONE OF THE ABOVE MAY BE MADE
       BY CATENATING THE APPROPRIATE IDENTIFIERS - E.G.,CON18REG0115.
     IN ADDITION, ANY IDENTIFIER NOT CONTAINING THE CHARACTER 0 MAY
       APPEAR.  IF AN IDENTIFIER APPEARS MORE THAN ONCE, SUBSEQUENT OCCURRENCES
       WILL BE REQUIRED TO MATCH THE FIRST OCCURRENCE EXACTLY (I.E., SAME
       EXPRESSION).  MODIFIERS ARE NOT ALLOWED ON THE SUBSEQUENT OCCURRENCES
       EXCEPT THAT IF THE IDENTIFIER IS TO MATCH A 'NAM' THE MODIFIER NAM
       >>MUST<< APPEAR ON EVERY OCCURENCE OF IT.
     TO INDICATE AN IDENTIFIER WHICH MATCHES ONE OR MORE OF THE CASES ABOVE,
       FOLLOW THE IDENTIFIER BY 0 AND THE APPROPRIATE CASES.  EXAMPLE:
              Q0REG0115 _ Q + CON18
       INDICATES SOMETHING OF THE FORM Q_Q+C WHERE Q IS A REGISTER BETWEEN 1
       AND 15, AND C IS AN 18-BIT CONSTANT.
     THE PARSE OUTPUT PROVIDED WILL, OF COURSE, BE A COMPLETE PARSE FROM RAW
       IDENTIFIERS TO STATEMENT LIST.  THE PARSE IS TRUNCATED TO MAKE THE
       TREE BRANCH AS FOLLOWS:
         1: EVERYTHING ABOVE THE HIGHEST OCCURRENCE OF THE PRODUCTION NUMBER  .
              BEING ENTERED (CS) IS DELETED.
         2: ALL [1] (NULL) SEMANTICS ARE DELETED.
         3: IF AN IDENTIFIER IS NOT A NAME (CONTAINS THE DESIGNATION 'NAM'), AND
              IF THE FIRST PRODUCTION ABOVE IT HAS ONE ARGUMENT, IT IS ASSUMED  
              TO BE THE PRODUCTION <NAM>::=NAM", AND IS DELETED.
      THE TRUNCATED PARSE IS THEN ENTERED IN THE TREE, TERMINATED BY A NEWLY
       CREATED SEMANTIC ENTRY IN THE SEMANTICS TABLE.  IT IS UP TO THE CALLING
       ROUTINE TO COMPLETE THIS ENTRY.
     NODES IN THE TREE MUST BE ORDERED SO THAT THE MORE SPECIFIC CASES ARE
       ALWAYS ENCOUNTERED FIRST.  THIS IS DONE BY CONSIDERING THE RESTRICTION
       BYTE 'WSVCRN' AS A 6-BIT NUMBER (WITH THE W BIT COMPLEMENTED).  THE
       LOWER THE NUMBER, THE MORE RESTRICTIVE THE CASE.  WHERE NUMBERS ARE
       EQUAL, THE RESTRICTIONS ON THE REGISTERS AND CONSTANTS ARE CONSIDERED.
       PRODUCTION NODES ARE ENTERED WITH THE LOWEST VALUE OF BITS 19-18 FIRST.,
       EXCEPT THAT TERMINAL NODES (BITS 19-18=2) ARE ENTERED AFTER ALL OTHER
       NODES. #





SUBR ENTREE(S,CS,SR,PN) IS (
 PLY_NTBL_0; NODE_1;
 INIT=0=>(FRELOT(CT,'TREE',550,TORGFIX);
	  SBITM IS 3 LONG; SBITM_0;
	  SBITM[1]_340; SBITM[2]_4;
          INIT_NCT_3; FINCSET(CT,40);
          FREES(CT+1,0); FREES(CT+2,0);
	  FRELOT(PRODS,'NTRE2',10,0); NODEN_-1;
          FRELOT(TBL,'NTREE',10,0));
 #TBL HOLDS NAMES OF IDENTIFIERS FOR NODES ALREADY ENTERED.
 ENTRY POINT OF TREE IS TSCR(1);
 NODE IS NEXT PLACE TO HANG A NODE AS AN ALT (POSITIVE) OR SCR (NEG.)#
 ST_S;
 NPRODS_0;
 L24: (J_FREE(ST))=>(ST_ST+1; GO TO L24);
 L23: (ST_ST-1)<S=>
        (ERROR(1,'QUOTED SEMANTICS NOT AN INSTANCE OF PRODUCTION.');
         GO TO ENTRX);
      J_FREE(ST);
      J NE CS=>GO TO L23;
 SS_S; EATIT_0;
 # NEXT ELEMENT IN PARSER OUTPUT #
 NEXT: J_FREE(SS); SS_SS+1;
 J<0=>(#IDENTIFIER. CHECK FOR CONSTANT. #
       EATIT_1;
       KON_CONVC(-J); KON=>(CONST IS COMMON;
                            NOTY_300001000000B OR -J;
                            FADD(TBL,NTBL,0);
                            GO TO L11);
       CODEID(-J);
       J_CODEID(0); KK_J;
       FADD(TBL,NTBL,J);
       J>0=>(#THIS ONE AT LEAST STARTS WITH A NAME - SEEN BEFORE? #
             NTBL>1=>((K_FREE(TBL+I);
                       K=J=>(# YES. #
                             L22: J_CODEID(0);
                             J NE 0=>(
         J=-10=>(EATIT_0; GO TO L22);
         PNAME(K); PRINT STG 0,' ';
         ERROR(1,'MODIFIER ON OTHER THAN FIRST OCCURRENCE OF NAME IS IGNORED');
         GO TO L22);
                             NOTY_I OR 2 LS 33; GO TO L11)) FOR I TO NTBL-2);
             J_CODEID(0));
       # FIRST OCCURRENCE OF ID, SO CHECK FOR RESTRICTIONS. #
       NOTY_160000000000B;
       NTY1_007603700177B;
       L12: J=>(J>0=>(PNAME(J); PRINT STG 0,' ';
                      ERROR(1,'BAD MODIFIER **');
                      GO TO L11);
                (K_-J)>2=>K_K-1;
                K=9=>(K_EATIT_0);
                K=8 => (NOTY_NOTY AND NOT (3 LS 31); GO TO L21);
                K>5=>(NOTY_NOTY AND NOT (1 LS 38-K); GO TO L21);
                K=5=>(NOTY_NOTY OR 010000000000B; GO TO L21);
                NTY1_0;
                NOTY_NOTY OR 1 LS K+25;
                J=-3=>NOTY_NOTY OR 200B;
                K=2=>(N1<0=>N1_177B; N2<0=>N2_0;
                      NOTY_NOTY OR N2 OR N1 LS 8);
                K=1=>(N1<0=>(N1_0; N2_37B);
                      N2<0=>N2_N1;
                      NOTY_NOTY OR (N1 LS 20) OR N2 LS 15);
                L21: J_CODEID(0); GO TO L12);
       NOTY_NOTY OR NTY1;
       L11: NODE_INSNO(NODE,NOTY,KON,CONST); #INSERT NODE IN TREE #
       FADD(PRODS,NPRODS,NODE);
       GO TO NEXT);
 SS LE ST=>(
   J=1=>GO TO NEXT;
   # CHECK FOR VAL/ PRODUCTION #
   JJ_J;
   (J RS 18)=>(FADD(TBL,NTBL,J);
               JJ_1000000B OR (J_J AND 777777B));
   EATIT=>(# EAT FIRST SEMANTICS NODE WITH 1 ARG DIRECTLY AFTER IDENTIFIER. #
           EATIT_0;
           K_SNARG(J); K=1=>GO TO NEXT);
   EATIT_0;
   J=CS=>CS NE PN=>ERROR(2,
       'CASE CONTAINS SUBEXPRESSION WHICH IS CASE BUT WONT GENERALIZE.');
   NOTEPROD(J,PLY);
   SNO_SNODEN(J);
   NODE_INSNO(NODE,JJ OR 100000000000B,0,0);
   FADD(PRODS,NPRODS,NODE);
   ENTMARK(SNO);
   GO TO NEXT);
 # MADE PRODUCTION - END OFF TREE AND RETURN #
 NOTEPROD(PN,PLY);
 NODE_INSNO(NODE,100002000000B,0,0);
 ENPROD(PN,NODE,SR);
 FADD(PRODS,NPRODS,NODE);
 J_SNODEN(PN);
 ENTMARK(J);
 ENTRX: FADD(TBL,NTBL,-1); TBL);

SUBR ENTMARK(J) IS (
 K_0;
 (L_FREE(PRODS+I);
  K=>[TORG1+L]<L> LE 100002B=>RETURN 0;
  K_-1;
  BITS(SBITM,TNODEN(L),J)) FOR I FROM NPRODS-1);

SUBR TORGFIX(NIL) IS (
 TORG,TSCRBP,TALTBP,TNONBP ARE 1 LONG;
 TORG_CT;
 TSCRBP_BYTEP [TORG]<12,24>;
 TALTBP_BYTEP [TORG]<12,12>;
 TNONBP_BYTEP [TORG]<12,0>;
 TORG1_TORG+1);

SUBR INSNO(HOOK,STUFF,K1,K2) IS (
 # INSERTS NODE ON AS SCR TO HOOK, WD 2 = STUFF #
 PLY_PLY+1;
 SH_TSCR(HOOK);
 SH=0=>(J_NUNO(STUFF,K1,K2); STSCR(HOOK,J); GO TO INSX);
 K_COMPNO(SH,STUFF);
 K=0=>GO TO INSXX;
 K>0=>(J_NUNO(STUFF,K1,K2); STSCR(HOOK,J); STALT(J,SH); GO TO INSX);
 L15: LSH_SH; SH_TALT(SH);
 SH=0=>(J_NUNO(STUFF,K1,K2); STALT(LSH,J); GO TO INSX);
 K_COMPNO(SH,STUFF);
 K=>(K<0=>GO TO L15;
     J_NUNO(STUFF,K1,K2);
     STALT(J,SH); STALT(LSH,J);
     GO TO INSX);
 INSXX: J_SH;
 INSX: SH_TSCR(HOOK);
 # SET SPECIAL FIELD TO INDEX OF FIRST PROD'N NODE #
 WHILE SH DO ([CT+SH+1]<L> LE 100002B=>GO TO L31; SH_TALT(SH));
 L31: K_TSCR(HOOK);
 WHILE K NE SH DO (FREES(CT+K-1,SH); K_TALT(K));
 J);

SUBR NUNO(A,B,C) IS (
 NCT_NCT+1;
 FLEN(CT) LE (NCT+4) => FADDEX(CT,NCT+4);
 Q_NCT; FREES(CT+NCT,0);
 STNODEN(Q,(NODEN_NODEN+1));
 (AA_A)=100002000000B=>AA_AA OR Q;
 FREES(CT+NCT+1,AA); NCT_NCT+2;
 B=>(FREES(CT+NCT,C); NCT_NCT+1);
 Q);

SUBR COMPNO(NO,VV) IS (
 # COMPARES NODE NO WITH VALUE VV.  RETURNS 1,0,-1 ACCORDING AS VV
   BELONGS ABOVE, IS EQUAL TO, BELONGS BELOW, NODE NO. #
 V_FREE(CT+NO+1);
 VL_0; V=VV=>GO TO COMPX;
 VL_1;
 (TV_V RS 33)=1=>TV_4;        #CHECK TYPE #
 (TVV_VV RS 33)=1=>TVV_4;
 TVV<TV=>GO TO COMPX;
 TVV=TV=>(TV NE 4=>GO TO COMPX;
          TV_V RS 18; TVV_VV RS 18;      # CHECK FOR PROD'N NODES #
	  TV LE 100002B=>(TV=TVV=>TV=100002B=>RETURN 0;
			  TVV>100002B=>GO TO COMPX;
			  TV>TVV=>GO TO COMPX;
			  GO TO COMPXX);
	  TVV LE 100002B=>GO TO COMPXX;
          TV_77B AND 40B+V RS 25;        # CHECK WSCVRN #
          TVV_77B AND 40B+VV RS 25;
          TVV<TV=>GO TO COMPX;
          TVV=TV=>(
              TV_V RS 31;            # CHECK ARITH. TYPE #
              TVV_VV RS 31;
              TVV<TV=>GO TO COMPX;
              TVV=TV=>(
                   KV_177B AND V RS 8; KVV_177B AND VV RS 8;
                   LV_177B AND V; LVV_177B AND VV;
# CHECK CONS #     (KVV+LVV)>(KV+LV)=>GO TO COMPX;
                   (KVV+LVV)=(KV+LV)=>(LVV>LV=>GO TO COMPX;
                                       LVV=LV=>(KV_37B AND V RS 20;
#CHECK REGS #                                   KVV_37B AND VV RS 20;
                                                KVV>KV=>GO TO COMPX;
                                                KVV=KV=>(KV_37B AND V RS 15;
                                                         KVV_37B AND VV RS 15;
                                                         KVV<KV=>GO TO COMPX)
                                                                     )))));
 COMPXX: VL_-1;                                                                 
 COMPX: VL);

REMOTE IDTB: DATA('REG  CON  CNG  VAR  MEM  WRD  IGR  FLT  BYT  NAM  NSE');

SUBR CODEID(SW) IS (
 # ROUTINE TO DISASSEMBLE AN IDENTIFIER.  IF SW=0, RETURNS THE DIRECTORY
   INDEX OF THE NEXT INDICATOR IN THE IDENTIFIER, OR 0 IF DONE.  IF SW NE 0,
   INITIALIZES ON IDENTIFIER ID.  FOR SPECIAL IDENTIFIER, RETURNS MINUS DEXE
   OF IDENTIFIER IN IDTB, AND N1 AND N2 ARE SET TO NUMERIC ARGS, OR -1 #
 CINIT=0=>(CINIT_1;
           (IDTB[I]_IDTB[I] RS 15) FOR I FROM 10);
 SW=>(CHAR_SH_0; LCH_CHAR_-1;
      IDDIR_SW; IDDIRX_-1;  GO TO CODEIDX);
 NSW_ANS_NAN_NA_0; NA IS 10 LONG;
 LCH=0=>(ANS_0; GO TO CODEIDX);
 N1_N2_-1;
 CHAR LE 0=>(NXCH: LCH=0=>(CHAR_0; GO TO L9);
                   SH<1=>(IDDIRX_IDDIRX+1;
                          ID_DNAME(IDDIR,IDDIRX);
                          SH_29);
                   LCH_CHAR_177B AND ID RS SH;
                   SH_SH-7);
  L9: NSW=>GO TO L3;
  (NA=IDTB[C]=>GO TO L2) FOR C FROM 10;
  ANS=0=>(# MAKE NAME #
          CHAR NE 0 =>CHAR NE 60B =>(NA[NAN]_CHAR OR NA[NAN] LS 7;
                                     (NA[NAN] RS 28)=>(
                          NA[NAN]_NA[NAN] LS 1;
                          (NAN_NAN+1)>9=>ERROR(0,'NAME TOO LONG **');
                          NA[NAN]_0);
                                     GO TO NXCH);
          (NA[NAN]_NA[NAN] LS 1)=>(
                L1: (NA[NAN] RS 29)=0=>(NA[NAN]_NA[NAN] LS 7;
                                        GO TO L1));
          ANS_DIR(NA);
          CHAR_0; GO TO CODEIDX);
 L2: NSW_1; C=10=>C_5; ANS_-(C+1); C>2=>GO TO CODEIDX;
 L3: NSW=5=>GO TO CODEIDX;
 CHAR GE 60B=>CHAR LE 71B=>GO TO SWTB[NSW-1];
 (1 AND NSW)=>GO TO CODEIDX;
 L8: ERROR(1,'NUMBER MISSING OR OUT OF PLACE IN SEMANTICS IDENTIFIER **');
     ANS_0; GO TO CODEIDX;
 SWTB: GO TO L4; GO TO L5; GO TO L6; GO TO L7;
 L4: N1_10*CHAR-60B; GO TO L10;
 L5: N1_N1+CHAR-60B; GO TO L10;
 L6: N2_10*CHAR-60B; L10: NSW_NSW+1; GO TO NXCH;
 L7: N2_N2+CHAR-60B; GO TO L10;
 CODEIDX: ANS);

SUBR MATCH(TN,SN,SNONR) IS (
 VAL_-1;
 S_FREE(SN);
 STY_S AND 37B;
 SDI_S RS 18;
 SVAL_FREE(SN+1);
 STY=0=>(TB_BYTEP [TORG1]<11,25>;
	TY0AL0: <TN+TB> NE 400B=>((TN_[TORG+TN-1])=>GO TO TY0AL0;
					RETURN 0);
	(T_[TN+TORG1]) AND 2000000B=>(
		(VAL_MATCHP(SDI,TN))=0=>GO TO TY0ALT;
		RETURN VAL);
	T<R>=SDI=>RETURN -1;
	SVAL=0=>GO TO TY0ALT;
	T<R>=SVAL<L>=>RETURN -2;
	TY0ALT: (TN_TALT(TN))=>GO TO TY0AL0; RETURN 0);
 SNN_SNONR;
 SN1_SBITM+SBITM[1]*SNN/36; SN2_1 LS SNN//36;
 TYALT: SNN GE 0=>(SN2 AND [SN1+TNODEN(TN)])=0=>GO TO NIX;
 T_[TN+TORG1];
 (TTY_T RS 33)=1=>(
	# PRODUCTIONS ARE LAST # T<6,25>=0=>RETURN (TN_0);
	(37B AND J_S AND T RS 25)=0=>(
		NIX: (TN_TALT(TN))=>GO TO TYALT;
		RETURN 0);
	 (J RS 6)=0=>(3 AND T LROT 5) NE 3=>GO TO NIX;
         (STY AND 6)=0=>GO TO MEX;
         STY=2=>(VAL_-RMATCH(T<5,20>,T<5,15>,SVAL<11,18>);
                 GO TO MEX);
         # CHECK IF CONSTANT MATCHES REQUIREMENTS #
	 T<15,0>=177B=>GO TO MEX;
	 (MASK_((1 LS T<7,8>)-1) LS T<7,0>)=0=>GO TO MEX;
         MASK_NOT MASK;
         REST_0; (T AND 200B)=>REST_MASK;
         (SVAL AND MASK)=REST=>GO TO MEX;
         GO TO NIX);
 TVAL_T AND 777777B;
 TTY=0=>(VAL_TVAL; GO TO MEX);
 TTY=2=>((VAL_SAMEAS(SN,TVAL))=0=>GO TO NIX; GO TO MEX);
 # MATCH WITH IDENTIFIER - IF DI ENTRIES EQUAL AND NO OFFSET THEN MATCH. #
 FREE(SN+2)=>GO TO NIX;
 SDI=TVAL=>SVAL=0=>GO TO MEX;
 (T AND 1000000B)=>STY=4=>(J_FREE(CT+TN+2);
                           J=SVAL=>GO TO MEX);
 GO TO NIX;
 MEX: (T AND 010000000000B)=>ONEWORD(SN)=0=>GO TO NIX;
 VAL=0=>VAL_-1;
 VAL);

SUBR ENTRCA(SEMN) IS (
 # SUBROUTINE CALLED WHEN SEMN IS A CASE OF ANOTHER PRODN.
   MUST COMPLETE SBITM MATRIX BY BRUTE FORCE. 
   USES THE UNUSED HIGH-ORDER BIT OF TYPE WORD TO MARK NODES. #
 # FIRST MARK TERMINAL TREE NODES MATCHING SEMN #
 ENTRNO_1;
 WHILE (I_ENTRC1()) DO ([TORG1+I]<L>=100002B=>MATCHP(SEMN,I)=>
		[TORG1+I]_[TORG1+I] OR 400000000000B);
 # NOW MAKE MULTIPLE PASSES MARKING PREDECESSORS OF MARKED NODES
   UP TO A PRODUCTION NODE #
 (FLAG _0;
  WHILE (I_ENTRC1()) DO ([TORG1+I] ARS 18 GT 100002B=>
	(J_TSCR(I);
	 WHILE J DO ([TORG1+J]<0=>([TORG1+I]_[TORG1+I] OR 400000000000B;
				   FLAG_-1; J_0)
		     ELSE (J_TALT(J)))))) UNTIL FLAG=0;
 # NOW CLEAR MARKER BIT, SETTING BIT MATRIX AT SAME TIME #
 S_SNODEN(SEMN);
 WHILE (I_ENTRC1()) DO ([TORG1+I]<0=>(
	[TORG1+I]_[TORG1+I] AND NOT 400000000000B;
	BITS(SBITM,TNODEN(I),S))));
SUBR ENTRC1() IS (
 (J_TSCR(ENTRNO))=>(PUSHMI(ENTRNO); RETURN (ENTRNO_J));
 EN1: (ENTRNO_TALT(ENTRNO))=>RETURN ENTRNO;
 (ENTRNO_PULLYU(0)) NE 1=>GO TO EN1;
 0);

SUBR TPRINT() IS (
 LOC(TPRIN1) => J_TPRIN1(CT,NCT,SBITM,NODEN)
          ELSE  (TPR0CNT=0=>(TPR0CNT_1; J_0;
                             ERROR(2,'TPRIN1 DEBUGGING PGM NOT PRESENT')));
J) %%%