Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0057/crosph.sno
There are 2 other files named crosph.sno in the archive. Click here to see a list.
* * * * * * * * *
* * DECLARATIONS * * * * *
* * * * * * * * *
*
* LOCAL
*
DECLARE('SNOBOL.SUBPROGRAM','CROSPH')
DECLARE('OPTION','NO.STNO')
DECLARE('PURGE.VARIABLE',ALL)
DECLARE('PURGE.LABEL',ALL)
DECLARE('EXTERNAL.FUNCTION','PRTOUT')
DECLARE('STRING','SSTNO(5)')
DECLARE('INTEGER','I,J,PUTSYM')
DECLARE('ENTRY.FUNCTION','INICRS()')
DECLARE('ENTRY.FUNCTION','CROSPH()TREEHD')
*
* SYSTEM COMMON
*
* TABLES AND LISTS
DECLARE('EXTERNAL.VARIABLE',
.'SYMBTB,XNAMTB,KEYWTB,CTRLTB,DECLTB,CROSTB,CONSTB,ENTFTB,DSIZTB,
.BOPRTB,UOPRTB')
DECLARE('EXTERNAL.VARIABLE',
.'ENTRLS,EXTRLS,FORTLS')
* ARRAYS
DECLARE('EXTERNAL.VARIABLE',
.'PTVRAR,PTFNAR,PRIMAR,GOTOAR,DECLAR,PROGAR,VARBAR,MACHAR,STENAR,BOPRAR,
.UOPRAR,PATRAR,EXPRAR,AROPAR,ARITAR,EACTAR')
* PARAMETERS (STRINGS,DATATYPES)
DECLARE('EXTERNAL.VARIABLE',
.'C,INDENT,SPLASH,ITNAM,ITENT,NOFAIL,SNONAM,SUBNAM,PARBLK,PRGNAM,STARTP,
.TEMLOC,P1,P2,P3,P4,P5')
* PARAMETERS (INTEGERS)
DECLARE('EXTERNAL.VARIABLE',
.'P,OBJFLG,LISTSR,INTGER,ITTYP,ITATR,PRGALV,PRGALL,PRGALF,STNFLG,HSHSIZ,
.STRTIM,DMPFLG,LISTOB,STNO,MAXTMP')
DECLARE('INTEGER',
.'P,OBJFLG,LISTSR,INTGER,ITTYP,ITATR,PRGALV,PRGALL,PRGALF,STNFLG,HSHSIZ,
.STRTIM,DMPFLG,LISTOB,STNO,MAXTMP')
DECLARE('EXTERNAL.VARIABLE',
.'XNATRB,VTATRB,VDATRB,LTATRB,FTATRB,FDATRB,TXATRB,VNATRB,VXATRB,VIATRB,
.VGATRB,LIATRB,LGATRB,FIATRB,FGATRB,FXATRB,SKATRB,SDATRB,BTATRB')
DECLARE('INTEGER',
.'XNATRB,VTATRB,VDATRB,LTATRB,FTATRB,FDATRB,TXATRB,VNATRB,VXATRB,VIATRB,
.VGATRB,LIATRB,LGATRB,FIATRB,FGATRB,FXATRB,SKATRB,SDATRB,BTATRB')
DECLARE('EXTERNAL.VARIABLE',
.'XNVATR,XNLATR,XNFATR,XNXMSK,VTVATR,VDDATR,VDPATR,VDDMSK,LTDATR,LTTMSK,
.FTFATR,FDPATR,FDIATR,FDDMSK,TXTATR,TXTMSK,VNNATR,VXXATR,VIPATR,VGGATR,
.LIPATR,LGGATR,FIPATR,FGGATR,FXXATR,FXXMSK,SKRATR,SDRATR,BTRATR')
DECLARE('INTEGER',
.'XNVATR,XNLATR,XNFATR,XNXMSK,VTVATR,VDDATR,VDPATR,VDDMSK,LTDATR,LTTMSK,
.FTFATR,FDPATR,FDIATR,FDDMSK,TXTATR,TXTMSK,VNNATR,VXXATR,VIPATR,VGGATR,
.LIPATR,LGGATR,FIPATR,FGGATR,FXXATR,FXXMSK,SKRATR,SDRATR,BTRATR')
* SPECIAL CHARACTERS,CHARACTER SEQUENCES, AND CHARACTER CLASSES
DECLARE('EXTERNAL.VARIABLE',
.'FFCHR,CRLCHR,LFCHR,CRCHR,SQCHR,DQCHR,TBCHR,LCSCHR,BLNCHR,EQLCHR,
.QTSCHR,ELTCHR,LBCHR')
* PATTERNS AND MATCHES
DECLARE('EXTERNAL.VARIABLE',
.'COMSPT,INTGPT,BLNKPT,OPBLPT,PCOMPT,PCPRMT,IDENPT,DCLCMT,RSIDPT,LABLPT,
.POPRMT,IDENMT,SQLTPT,DQLTPT,LBDCPT,IDDCPT')
*
* MINIMAL SYMBOL TABLE
*
DECLARE('UNPURGE.VARIABLE','INICRS,CROSPH,TREEHD,PUTSYM,ENT,
.WALK')
DECLARE('UNPURGE.LABEL','INICRS CROSPH PUTSYM WALK')
DECLARE('PURGE.FUNCTION','DEFINE,DATA,ARRAY,DIFFER,DATATYPE,LGT,
.COPY,SIZE,TIME')
* * * * * * * * *
* * INITIALIZE CROSS-REFERENCE PHASE * *
* * * * * * * * *
INICRS DEFINE('PUTSYM(ENT)')
DEFINE('WALK(ENT)')
DATA('CRS(NEXT,CRSI)')
DATA('NOD(FRNT,BACK)')
ATRARR = ARRAY('0:4,0:1')
ATRARR<0,1> = INDENT 'VARIABLE'
ATRARR<1,1> = INDENT 'LABEL'
ATRARR<2,1> = INDENT 'FUNCTION'
ATRARR<3,1> = INDENT 'STRING'
ATRARR<4,1> = INDENT 'BREAK TABLE' :(RETURN)
* * * * * * * * *
* * PRODUCE CROSS-REFERENCE LISTING * * *
* * * * * * * * *
CROSPH ?INE(LISTSR,0) :F(RETURN)
LISTAR = ARRAY(CROSTB) :F(RETURN)
PRTOUT(FFCHR CRLCHR CRLCHR SPLASH INDENT
. '******* CROSS-REFERENCE DICTIONARY *******' CRLCHR SPLASH CRLCHR
. '[SYMBOL]' CRLCHR INDENT 'ATTRIBUTE,STATEMENT NUMBERS' CRLCHR CRLCHR
. CRLCHR)
I = 1
TREEHD = 1
* LOOP TO PUT SYMBOL INDICES IN TREE
CROS1 I = I + 1
ITNAM = LISTAR<I,1> :F(CROS2)
J = PUTSYM(TREEHD)
?INE(J,0) :F(CROS1)
TREEHD = ?ILT(J,0) NOD(I,TREEHD) :S(CROS1)
TREEHD = NOD(TREEHD,I) :(CROS1)
* WALK TREE AND LIST SYMBOLS IN ORDER
CROS2 WALK(TREEHD) :(RETURN)
* * * * * * * * *
* * SUBROUTINES * * * * *
* * * * * * * * *
* PUTSYM(ENT) PUT SYMBOL IN TREE IN LEXICAL ORDER
* RETURNS -N, 0, 0R N DEPENDING ON WHETHER THE NEW SYMBOL IS TO
* THE LEFT (LESS), WITHIN, OR TO THE RIGHT (GREATER) OF THE
* SUBTREE. N IS THE FUNCTION (TREE) DEPTH AT WHICH THE COMPARISON
* WAS MADE, AND IS USED TO KEEP THE TREE AS BALANCED AS POSSIBLE
*
PUTSYM ENT = ?DIFFER(DATATYPE(ENT),'NOD') LISTAR<ENT,1> :F(PUTS1)
PUTSYM = LGT(ENT,ITNAM) -&FNCLEVEL :S(RETURN)
PUTSYM = &FNCLEVEL :(RETURN)
PUTS1 PUTSYM = PUTSYM(FRNT(ENT))
J = ?IGT(PUTSYM,0) PUTSYM(BACK(ENT)) :F(RETURN)
PUTSYM = ?IGE(J,0) J :S(RETURN)
FRNT(ENT) = ?ILT(PUTSYM + J,0) NOD(FRNT(ENT),I) :S(PUTS2)
BACK(ENT) = ?IGT(PUTSYM + J,0) NOD(I,BACK(ENT)) :S(PUTS2)
FRNT(ENT) = ?IEQ(AND(TIME(),1),0) NOD(FRNT(ENT),I)
. :S(PUTS2)
BACK(ENT) = NOD(I,BACK(ENT))
PUTS2 PUTSYM = :(RETURN)
* * * * * * * * *
* WALK(ENT) WALK TREE
* DOES A LEFT-TO-RIGHT, BOTTOM-TO-TOP TREE WALK, PRINTING THE
* INFORMATION FOR EACH SYMBOL AS IT IS ENCOUNTERED IN THE TREE
*
WALK (?DIFFER(DATATYPE(ENT),'INTEGER') ?WALK(FRNT(ENT))
. ?WALK(BACK(ENT))) :S(RETURN)
AR = COPY(ATRARR)
PRTOUT(CRLCHR '[' LISTAR<ENT,1> ']')
ENT = LISTAR<ENT,2> :(WLK2)
WLK1 ENT = NEXT(ENT)
WLK2 I = ?DIFFER(ENT) CRSI(ENT) :F(WLK3)
J = RSHIFT(I,3)
I = AND(I,7)
AR<I,0> = CRS(AR<I,0>,J) :S(WLK1)
AR<I - 5,0> = CRS(AR<I - 5,0>,J) :(WLK1)
WLK3 I =
WLK4 ENT = AR<I,0>
WALK = ?DIFFER(ENT) AR<I,1> :F(WLK8)
J = ?PRTOUT(WALK,'',1) SIZE(WALK) :(WLK6)
WLK5 ENT = NEXT(ENT)
WLK6 SSTNO = ?DIFFER(ENT) CRSI(ENT) :F(WLK7)
WALK = ',' SSTNO
J = ?PRTOUT(WALK,'',1) J + SIZE(WALK)
J = ?IGE(J,60) ?PRTOUT(CRLCHR INDENT,'',1) SIZE(INDENT)
. :(WLK5)
WLK7 PRTOUT()
WLK8 I = ?INE(I,4) I + 1 :F(RETURN)S(WLK4)
* * * * * * * * *
END