Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

*	*	*	*	*	*	*	*	*
*	*	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