Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-03 - 43,50306/dir.imc
There are 2 other files named dir.imc in the archive. Click here to see a list.
TWOSEG;
#THIS IS FILE DIR.I10, DIRECTORY PACKAGE FOR IMP COMPILERS.
   DIR(I) RETURNS DIRECTORY INDEX OF ASCII NAME BEGINNING I.
   DPROP(PROP,I) RETURNS VALUE OF PROPERTY PROP FOR ENTRY WHOSE INDEX IS I
   DPROPS(PROP,I,V) SETS VALUE OF PROPERTY PROP TO V FOR ENTRY I.
     ** DPROP AND DPROPS HAVE BEEN EXPANDED IN-LINE  **
     ** REFER TO SPECIAL SYNTAX FOR COMPILER, IMPSYN **
   DSEQ(N) ALLOWS SEQUENCING THROUGH ALL ENTRIES IN THE DIRECTORY.  INITIALLY
      SET N NEGATIVE.  REPEATED CALLS ON DSEQ(N) WILL SET N TO INDEX OF EACH
      ENTRY IN DIR.  AFTER THE LAST ENTRY, N BECOMES NEGATIVE AGAIN.  THE
      VALUE OF DSEQ IS N.
   PNAME(N) PRINTS THE NAME OF DIR ENTRY N (FIRST 24 CHARS).
   GNAME(N) RETURNS THE ADDRESS OF A LOCAL VECTOR WHICH CONTAINS
            THE FIRST 24 CHARACTERS OF THE NAME OF DIR ENTRY N.
   DNAME(I,J) RETURNS JTH WORD (5 ASCII CHARACTERS) OF NAME FOR DIRECTORY
            INDEX I.
   DSTATS() PRINTS DIR STATISTICS.
   RADI50(N) RETURNS THE RADIX50 VALUE OF DIR ENTRY N (FIRST 6 CHARS ONLY)

 HASH-CODED DIRECTORY
 INDEX IS OFF-SET IN FREE ARRAY PRP, WHICH IS COMPOSED OF 3-WORD NODES:

        WORD 1  BITS 35-18   HASH SIBLING INDEX
                     17-0    ALF INDEX
        WORD 2  BITS 35-18   'ENTRY'     !
                     17-0    'NODE'      !
        WORD 3  BITS 29-27   'USE'        >  ACCESS TO THESE PROPERTIES
                     26-25   'LXTY'      !   IS GRANTED BY MEANS OF THE
                     24-23   'ISNM'      !   SYNTAX EXTENSIONS OF IMPSYN.
                     22-21   'COM'       !
                     20-18   'ATYPE'     !
                     17-0    'SEM'       !

 THE FREE ARRAY ALF CONCATENATES THE 'NAME'S.  TERMINAL NULL CHARACTERS
 ARE REQUIRED. #

SUBR HASH(NM) IS (#9-BIT HASH CODE#
                  HSH_NM XOR NM RS 18;
                  HSH_HSH XOR HSH RS 9;
                  HSH AND 777B);

SUBR DIR(NM) IS (
 DINIT=0 => (DINIT_1;
             FRELOT(PRP,'PRP',2100,DORGFIX); FINCSET(PRP,90); NPRP_1536;
             FRELOT(ALF,'ALF',900,DORGFIX); FINCSET(ALF,45); NALF_1);
 H_HASH(NM); HN_2; N_0;
L0: (NM[N] AND 377B) => (N_N+1; GO TO L0);
L1: (I_H*3)=0 => I_3;
L2: Q_FREE(PRP+I);
 J_Q AND 777777B;
 J=0 => (FREES(PRP+I,NALF); DM_DM+1; GO TO L4);
 ALFX_ALF+J;
 (NM[K] NE [ALFX+K] => (HN => (H_H XOR HN; HN_HN RS 1; GO TO L1);
                        I1_I; (I_Q RS 18) => GO TO L2;
                        GO TO L3))  FOR K TO N;
 GO TO L5;
L3: I_NPRP; DN_DN+1;
 FREES(PRP+I1,Q OR I LS 18);
 K_NPRP+3; FLEN(PRP) LE K => FADDEX(PRP,K);
 FREES(PRP+NPRP,NALF); NPRP_K;
L4: K_NALF+N+1; FLEN(ALF) LE K => FADDEX(ALF,K);
 ALFX_ALF+NALF; NALF_K;
 [ALFX+K]_NM[K] FOR K TO N;
L5: I);

SUBR DSEM(N,S) IS (DIRN_DIR(N); LOCS_LOC(S);
                   DPROPS('SEM',DIRN,LOCS));

SUBR DSEQ(N) IS (
 N<0 => (N_-3; NMARK_-1);
 NMARK GE 0 => (N_FREE(PRP+N) RS 18;
                N=0 => (N_NMARK; NMARK_-1));
 NMARK<0 => (L6: N_N+3;
              N GE 1536 => N_-1
                      ELSE (FREE(PRP+N)=0 => GO TO L6;
                            NMARK_N));
N);

SUBR PNAME(DJ) IS (DJ GE 0=>PRINT STG 0,FREE(ALF+FREE(PRP+DJ) AND 777777B));

SUBR DNAME(DI,J) IS FREE(ALF+J+FREE(PRP+DI) AND 777777B);

SUBR GNAME(DJ) IS (
 LCL IS 5 LONG;
 LCL[K]_DNAME(DJ,K) FOR K TO 5;
 LCL[4]_LCL[4] AND NOT 377B;
 LOC(LCL));

SUBR DSTATS() IS (
 PRINT STG 0,'DIRECTORY HASHED INTO ',IGR 0,DM,STG 0,' BOXES.  OVERFLOW IS ',
   IGR 0,DN,STG 0,'.',/;
 FINAM IS COMMON; (FINAM[5] AND 400B) => DSPILL(0);
 0);

SUBR DSPILL() IS (
 PRINT STG 0, 'HASH CODE   TOKEN', /;
 N_-1; H1_-1;
L7: DSEQ(N);
 N GE 0 => (H_HASH(DNAME(N,0));
            H NE H1 => (PRINT STG 0, '    ', OCT 3, H; H1_H)
                  ELSE (PRINT STG 0, '       ');
            PRINT STG 0, '    '; PNAME(N); PRINT /; GO TO L7);
 0);

SUBR RADI50(N) IS (
 NX IS 2 LONG; NX[1]_0;
 (NX_DNAME(N,0)) AND 377B => (NX[1]_DNAME(N,1) AND 774000000000B);
 VAL_0; P_BYTEP NX<7,36>;
NCHR: (C_<+P>) => (C=56B=>(K_37; GO TO UCH);  #.#
                   C=44B=>(K_38; GO TO UCH);  #$#
                   C=45B=>(K_39; GO TO UCH);  #%#
                   C>132B=>GO TO NCHR;
                   C>100B=>(K_C-66B; GO TO UCH);
                   C>71B=>GO TO NCHR;
                   (K_C-57B) LE 0=>GO TO NCHR;
              UCH: VAL_(VAL*40)+K; GO TO NCHR);
VAL);

SUBR DORGFIX() IS (
 ALF,DORG ARE COMMON,1 LONG;
 DORG1,DORG2,DPBYPA,DPBYPC,DPBYPI,DPBYPL,DPBYPU ARE COMMON,1 LONG;
 DORG_PRP; DORG1_DORG+1; DORG2_DORG1+1;
 DPBYPA_BYTEP [DORG2]<3,18>;
 DPBYPC_BYTEP [DORG2]<2,21>;
 DPBYPI_BYTEP [DORG2]<2,23>;
 DPBYPL_BYTEP [DORG2]<2,25>;
 DPBYPU_BYTEP [DORG2]<3,27>);



# THIS IS FILE CONVC - CONVERTS A CONSTANT.
  CALL WITH DIRECTORY ENTRY.
  RETURNS  0 IF NOT A CONSTANT
          -1 IF A NUMERIC CONSTANT, IN WHICH CASE VALUE IS IN COMMON
                  CONST.
          POSITIVE POINTER TO FREE ARRAY IF A STRING CONSTANT,
                  IN WHICH CASE ARRAY[0] IS N, AND CONSTANT IS IN
                  WORDS 1-N (AND FIRST WORD IN CONST).
  THIS ROUTINE COULD PROBABLY USE REWRITING TO USE BYTE POINTERS.
  STCON(V) MAKES A DIRECTORY ENTRY FOR CONSTANT VALUE V AND RETURNS INDEX.
  NEWNAME(I) RETURNS DIR INDEX OF A UNIQUE NAME PREFACED BY % AND
  THE FIRST LETTERS OF THE STRING I. #


SUBR CONVC(C) IS (
 CINIT=0=>(CINIT_1; FRELOT(CBUF,'CONVC',25,0));
 NC_VAL_OC_0; BAS_-1;
 CC_0;
 W_DNAME(C,CC);
 # CHECK FOR STRING, WHICH IS ONLY MULTI-WORD CASE.#
 (W RS 29)=47B=>(JNIT=0=>(JNIT_1; CFR_FALLOT('CONST',10)#FIXED#);
                 NCFR_1;
                  T1: WW_W LS 7;
                      (377B AND W)=>(
                           CC_CC+1;
                           W_DNAME(C,CC);
                           WW_WW OR 376B AND W RS 28);
                      FADD(CFR,NCFR,WW);
                      (377B AND WW)=>GO TO T1;
                  FREES(CFR,NCFR-1);
                  CONST_FREE(CFR+1);
                  VAL_CFR; GO TO CONVX);
 (WW_W RS 29)<60B=>GO TO CONVX; WW>71B=>GO TO CONVX;
 # PICK IT APART #
 GO TO T2;
 NXW: CC_CC+1;
      W_DNAME(C,CC);
 T2:  (CH_177B AND W RS N;
       CH=0=>GO TO T3;
       CH GE 60B=>CH LE 71B=>(T5: FADD(CBUF,NC,CH); GO TO T4);
       (CH_CH AND 137B)=102B=>(BAS_NC; GO TO T5);
       BAS_-1;
       CH>100B=>CH LE 132B=>(CH_CH-7; GO TO T5);
       GO TO CONVX;
       T4: 0) FOR N IN 29,-7,1;
      GO TO NXW;
 T3: J_NC-1;
 B_10;
 BAS>0=>(BAS=J=>(J_J-1; B_8; GO TO T6);
         B_0;
         (K_FREE(CBUF+I); B_(K-60B)+10*B) FOR I IN BAS+1,1,J;
         J_BAS-1);
 T6: CONST_0;
 (B=8=>(CONST_CONST LS 3) ELSE (CONST_CONST*B);
  (K_FREE(CBUF+I)-60B) GE B=>GO TO CONVX; CONST_CONST+K) FOR I TO J;
 CONST IS COMMON, 1 LONG;
 VAL_-1;
 CONVX: VAL);

SUBR STCON(V) IS (FOO IS 3 LONG;
                  FOO_FOO[1]_FOO[2]_0;
                  KK_K_BYTEP FOO<7,36>;
                  L_BYTEP V<3,36>; F_0;
                  ((J_<+L>) => F_1;
                   F => <+K>_J OR 060B) FOR I FROM 11;
                  K=KK => FOO_'0' ELSE <+K>_'B' RS 29;
                  DIR(FOO));

SUBR NEWNAME(I) IS (
 FOO_(NOT 1) AND (I RS 7) OR '%'; FOO[1]_FOO[2]_0;
 SH_29; W_0; J_NEWNUM_NEWNUM+1; TP_100000;
 T10: (J/TP)=0=>(TP_TP/10; GO TO T10);
 T8: (FOO[W] AND 177B LS SH)=>GO TO T9;
     JJ_J/TP;
     FOO[W]_FOO[W] OR (60B+JJ) LS SH;
     J_J-TP*JJ; TP_TP/10;
     TP=>(T9: (SH_SH-7)<0=>(SH_29; W_W+1);
          GO TO T8);
 DIR(FOO))%%