PDP-10 Archive: decus/20-0057/declph.sno from decuslib20-02

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0057/declph.sno

There are 2 other files named declph.sno in the archive. Click here to see a list.

*	*	*	*	*	*	*	*	*
*	*	DECLARATIONS	*	*	*	*	*
*	*	*	*	*	*	*	*	*
*
*		LOCAL
*
	DECLARE('SNOBOL.SUBPROGRAM','DECLPH')
	DECLARE('OPTION','NO.STNO')
	DECLARE('PURGE.VARIABLE',ALL)
	DECLARE('PURGE.LABEL',ALL)
	DECLARE('EXTERNAL.FUNCTION','GETSTA,STXERR,ERRMSG,PARLIT,GETITM'
.)
	DECLARE('INTEGER','I,J,K,ITSW,DFATR')
	DECLARE('ENTRY.FUNCTION','INIDEC()')
	DECLARE('ENTRY.FUNCTION','DECLPH()')
*
*		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','INIDEC,DECLPH,DFI,DSB,STR1')
	DECLARE('UNPURGE.LABEL','INIDEC DECLPH DFI DSB NO.STNO TIMER
. HASHSIZE= LD4 VD4 FD4 DCLEND XFF1 DD3 OPT SNO SUB PRV UPV PRL UPL
. PRF UPF STR INT REL REN GLV GLL GLF EXV ENV EXL ENL EXF ENF XFF NFF')
	DECLARE('PURGE.FUNCTION','DEFINE,DATA,IDENT,DIFFER,TABLE,ARRAY,
.SUBSTR')

*	*	*	*	*	*	*	*	*
*	*	INITIALIZE DECLARATION PHASE	*	*	*
*	*	*	*	*	*	*	*	*
INIDEC	DEFINE('DFI()')
	DEFINE('DSB(STR1)')
	DATA('SYM(INAM,ATRB)')
	DATA('CRS(NEXT,CRSI)')	:(RETURN)
*	*	*	*	*	*	*	*	*
*	*	PROCESS DECLARATIONS	*	*	*	*
*	*	*	*	*	*	*	*	*
DECLPH
*	DECLARATION LOOP
DCLOOP	C	= GETSTA()	:F(NOEND)
	C	SPAN(BLNCHR)  @P	:F(RETURN)
	C	LEN(*P)  'DECLARE('  @P	:F(RETURN)
*	DECLARATION DECODING
	C	LEN(*P)  NSPAN(BLNCHR)  @P  SQCHR  @P  @I
.  SPAN('ABCDEFGHIJKLMNOPQRSTUVWXYZ.') $ DECTYP  @P  SQCHR  @P
.  NSPAN(BLNCHR)  ','  NSPAN(BLNCHR)  @P  (SQCHR ! 'ALL') $ STR1  @P
.	:F(BADDEC)
	DECTYP	= DECLTB[DECTYP]
	(?IDENT(STR1,'ALL') ?DIFFER(SUBSTR(DECTYP,2),'PR'))
.	:S(BADDEC)
	P	= ?IDENT(DECTYP) I	:F($DECTYP)
*	ERRORS
	STXERR('UNKNOWN DECLARATION')	:(DCLOOP)
BADDEC	STXERR('BAD DECLARATION')	:(DCLOOP)
BADOPT	STXERR('UNKNOWN OPTION')	:(DCLOOP)
BADEXT	ERRMSG('MULTIPLE EXTERNAL FOR: ' ITNAM ', IGNORED')
.	:($RETLAB)
BADDEF	ERRMSG('REDEFINITION OF: ' ITNAM ', IGNORED')	:($RETLAB)
NOEND	C	=	:(RETURN)
*	DECLARATION LOOP BOTTOM
DCLEND	C	DCLCMT	:F(BADDEC)S(DCLOOP)
DCAEND	C	PCPRMT  @P  OPBLPT  @P  RPOS(0)	:F(BADDEC)S(DCLOOP)
*	OPTION DECLARATION
OPT	C	LEN(*P)  ('NO.STNO' ! 'TIMER' ! 'HASHSIZE=') $ DECTYP
.  @P	:F(BADOPT)S($DECTYP)
NO.STNO	STNFLG	= -1	:(DCLEND)
TIMER	STNFLG	= 1	:(DCLEND)
HASHSIZE=	C	LEN(*P)  INTGPT  @P	:F(BADDEC)
	HSHSIZ	= INTGER	:(DCLEND)
*	SNOBOL.MAIN DECLARATION
SNO	C	LEN(*P)  IDENPT $ SNONAM  @P	:F(BADDEC)S(DCLEND)
*	SNOBOL.SUBPROGRAM DECLARATION
SUB	C	LEN(*P)  IDENPT $ SUBNAM  @P	:F(BADDEC)S(DCLEND)
*	RENAME DECLARATION
REN	C	LEN(*P)  IDENPT $ STR1  @P SQCHR  @P  PCOMPT  @P  SQCHR
.  @P  IDENPT $ STR2  @P	:F(BADDEC)
	STR1	= .SYMBTB[STR1]
	SYMBTB[STR2]	= $STR1
	$STR1	=	:(DCLEND)

*	LABEL DECLARATIONS
* PURGE.LABEL
PRL	PRGALL	= ?IDENT(STR1,'ALL') LIPATR	:S(DCAEND)
	ITSW	= 1
	DFATR	= 2 * LTDATR + LIPATR
LD1	ITPAT	= LABLPT
LD2	ITSEP	= SPAN(BLNCHR) ! @I
	ITBRK	= LBDCPT
	ITTYP	= 1
	I	=	:(LD5)
* UNPURGE.LABEL
UPL	ITSW	= 2
	DFATR	= 2 * LTDATR	:(LD1)
* GLOBAL.LABEL
GLL	ITSW	= 3
	DFATR	= 2 * LTDATR + LGGATR	:(LD1)
* EXTERNAL.LABEL
EXL	ITSW	= 4
	DFATR	= LTDATR + PRGALL + XNLATR
LD3	ITPAT	= RSIDPT		:(LD2)
* ENTRY.LABEL
ENL	ITSW	= 5
	DFATR	= 2 * LTDATR + PRGALL + XNLATR	:(LD3)
* COMMON CODE FOR LABELS
LD4	?INE(I,P)	:F(DCLEND)
LD5	STR1	= DFI()	:F(BADDEC)
	IDENT(STR1)	:F(LD7)
LD6	?IGE(ITSW,4)	:F(LD4)
	XNAMTB[INAM(ITENT)]	= ITNAM
	EXTRLS	= ?IEQ(ITSW,4) CRS(EXTRLS,ITNAM)	:S(LD4)
	ENTRLS	= CRS(ENTRLS,ITNAM)	:(LD4)
LD7	ATRB(ITENT)	= ?IEQ(LTATRB,0) OR(ITATR,DFATR)	:F(LD9)
LD8	ATRB(ITENT)	= ?IGE(ITSW,4) ?INE(XNATRB,0) OR(ITATR,DFATR -
. XNLATR)	:F(LD6)
	RETLAB	= 'LD4'	:(BADEXT)
LD9	ATRB(ITENT)	= ?IEQ(ITSW,3) OR(ITATR,LGGATR)	:S(LD4)
	ATRB(ITENT)	= ?IEQ(ITSW,1) OR(ITATR,LIPATR)	:S(LD4)
	ATRB(ITENT)	= ?IEQ(ITSW,2) AND(ITATR,NOT(LIPATR))	:S(LD4)
	ITATR	= ITATR - LTATRB
	DFATR	= DFATR - PRGALL
	ATRB(ITENT)	= OR(ITATR,DFATR)	:(LD8)

*	VARIABLE DECLARATIONS
* PURGE.VARIABLE
PRV	PRGALV	= ?IDENT(STR1,'ALL') VIPATR	:S(DCAEND)
	ITSW	= 1
	DFATR	= VTVATR + VIPATR
VD1	ITPAT	= IDENPT
VD2	ITSEP	= PCOMPT ! @I
	ITBRK	= IDDCPT
	ITTYP	=
	I	=	:(VD5)
* UNPURGE.VARIABLE
UPV	ITSW	= 2
	DFATR	= VTVATR	:(VD1)
* GLOBAL.VARIABLE
GLV	ITSW	= 3
	DFATR	= VTVATR + VGGATR	:(VD1)
* EXTERNAL.VARIABLE
EXV	ITSW	= 4
	DFATR	= VTVATR + PRGALV + XNVATR + VXXATR
VD3	ITPAT	= RSIDPT	:(VD2)
* ENTRY.VARIABLE
ENV	ITSW	= 5
	DFATR	= VTVATR + PRGALV + XNVATR	:(VD3)
* COMMON CODE FOR VARIABLES
VD4	?INE(I,P)	:F(DCLEND)
VD5	STR1	= DFI()	:F(BADDEC)
	IDENT(STR1)	:F(VD7)
VD6	?IGE(ITSW,4)	:F(VD4)
	XNAMTB[INAM(ITENT)]	= ITNAM
	EXTRLS	= ?IEQ(ITSW,4) CRS(EXTRLS,ITNAM)	:S(VD4)
	ENTRLS	= CRS(ENTRLS,ITNAM)	:(VD4)
VD7	ATRB(ITENT)	= ?IEQ(VTATRB,0) OR(ITATR,DFATR)	:F(VD9)
VD8	ATRB(ITENT)	= ?IGE(ITSW,4) ?INE(XNATRB,0) OR(ITATR,DFATR -
. XNATRB - (5 - ITSW) * VXXATR)	:F(VD6)
	RETLAB	= 'VD4'	:(BADEXT)
VD9	RETLAB	= ?IEQ(VDATRB,VDPATR) 'VD4'	:S(BADDEF)
	ATRB(ITENT)	= ?IEQ(ITSW,3) OR(ITATR,VGGATR)	:S(VD4)
	ATRB(ITENT)	= ?IEQ(ITSW,1) OR(ITATR,VIPATR)	:S(VD4)
	ATRB(ITENT)	= ?IEQ(ITSW,2) AND(ITATR,NOT(VIPATR))	:S(VD4)
	DFATR	= DFATR - PRGALV
	ATRB(ITENT)	= OR(ITATR,DFATR)	:(VD8)

*	FUNCTION DECLARATIONS
* PURGE.FUNCTION
PRF	PRGALF	= ?IDENT(STR1,'ALL') FIPATR	:S(DCAEND)
	ITSW	= 1
	DFATR	= FTFATR + FIPATR
FD1	ITPAT	= IDENPT
FD2	ITSEP	= PCOMPT ! @I
	ITBRK	= IDDCPT
	ITTYP	= 7
	I	=	:(FD5)
* UNPURGE.FUNCTION
UPF	ITSW	= 2
	DFATR	= FTFATR	:(FD1)
* GLOBAL.FUNCTION
GLF	ITSW	= 3
	DFATR	= FTFATR + FGGATR	:(FD1)
* EXTERNAL.FUNCTION
EXF	ITSW	= 4
	DFATR	= FTFATR + FXXATR + XNFATR
	ITPAT	= RSIDPT	:(FD2)
* COMMON CODE FOR FUNCTIONS
FD4	?INE(I,P)	:F(DCLEND)
FD5	STR1	= DFI()	:F(BADDEC)
	IDENT(STR1)	:F(FD7)
FD6	?IEQ(ITSW,4)	:F(FD4)
	XNAMTB[INAM(ITENT)]	= ITNAM
	EXTRLS	= CRS(EXTRLS,ITNAM)	:(FD4)
FD7	ITATR	= ?IEQ(ITSW,4) ?IEQ(FXATRB,FXXMSK) ITATR - FXATRB -
. TXATRB
	ATRB(ITENT)	= ?IEQ(FTATRB,0) OR(ITATR,DFATR)	:F(FD9)
FD8	ATRB(ITENT)	= ?IEQ(ITSW,8) ?INE(XNATRB,0) OR(ITATR,FTFATR)
.	:F(FD6)
	RETLAB	= 'FD4'	:(BADEXT)
FD9	RETLAB	= ?IEQ(FDATRB,FDPATR) 'FD4'	:S(BADDEF)
	ATRB(ITENT)	= ?IEQ(ITSW,3) OR(ITATR,FGGATR)	:S(FD4)
	ATRB(ITENT)	= ?IEQ(ITSW,1) OR(ITATR,FIPATR)	:S(FD4)
	ATRB(ITENT)	= ?IEQ(ITSW,2) AND(ITATR,NOT(FIPATR))	:S(FD4)
	ATRB(ITENT)	= OR(ITATR,DFATR)	:(FD8)

*	ENTRY.FUNCTION DECLARATION
ENF	J	= P
	STR1	= PARLIT(SQCHR,SQLTPT)	:F(BADDEC)
	STR1	@K  RSIDPT  @K  '('  @K  BREAK(')')	:S(ENFA)
ENFX	P	= J + K	:(BADDEC)
ENFA	STR2	=
	C	LEN(*(P + 1))  PCOMPT  SQCHR  @P	:F(ENFB)
	STR2	= PARLIT(SQCHR,SQLTPT)	:F(BADDEC)
ENFB	DFATR	= FTFATR + 2 * FXXATR + XNFATR + PRGALF
	ITTYP	= 7
	ITATR	= DFATR
	(?GETITM() ?IEQ(DFATR,ITATR))	:F(ENF4)
ENF1	XNAMTB[INAM(ITENT)]	= ITNAM
	ENTRLS	= CRS(ENTRLS,ITNAM)
	ENTFTB	= ?IDENT(ENTFTB) TABLE(3,3)
	ITPTR	= .ENTFTB[INAM(ITENT)]
	$ITPTR	= ARRAY('4',STNO)
	ITPTR	= $ITPTR
	ITPTR<2>	= DSB(STR1)
	I	=
	STR1	BREAK('(')  @J  '(' NSPAN(BLNCHR) ')'	:S(ENF3)
	I	= 1
ENF2	STR1	LEN(*(J + 1))  BREAK(',)')  @J  ','	:F(ENF3)
	I	= I + 1	:(ENF2)
ENF3	ITPTR<4>	= I
	ITPTR<3>	= ?IDENT(STR2) STR2	:S(DCLEND)
	ITPTR<3>	= DSB(STR2)	:(DCLEND)
ENF4	ITATR	= ?IEQ(FXATRB,FXXMSK) ITATR - FXATRB - TXATRB
	ATRB(ITENT)	= ?IEQ(FTATRB,0) OR(ITATR,DFATR)	:F(ENF6)
ENF5	ATRB(ITENT)	= ?INE(XNATRB,0) OR(ITATR,DFATR - 2 * FXXATR -
. XNFATR)	:F(ENF1)
	RETLAB	= 'DCLEND'	:(BADEXT)
ENF6	RETLAB	= ?IEQ(FDATRB,FDPATR) 'DCLEND'	:S(BADDEF)
	DFATR	= DFATR - PRGALF
	ATRB(ITENT)	= OR(ITATR,DFATR)	:(ENF5)

*	EXTERNAL.FORTRAN.FUNCTION DECLARATION
XFF	ITTYP	= 7
	I	=	:(XFF2)
XFF1	?INE(I,P)	:F(DCLEND)
XFF2	J	= P
	STR2	= PARLIT(SQCHR,IDDCPT)	:F(BADDEC)
	STR2	@K  RSIDPT $ STR1  @K  ('='  ('INTEGER' !
. 'REAL') $ STR1 ! '')  @K  '('  @K  INTGPT  @K  ')'  RPOS(0)	:F(ENFX)
	C	LEN(*P)  (PCOMPT ! @I)  @P	:F(BADDEC)
	J	= FDIATR
	STR1	NOTANY('IJKLMN')	:F(XFF3)
	J	= FDDMSK
XFF3	DFATR	= FTFATR + J + XNFATR + INTGER * TXTATR
	ITATR	= DFATR
	(?GETITM() ?IEQ(DFATR,ITATR))	:F(XFF5)
XFF4	XNAMTB[INAM(ITENT)]	= ITNAM
	EXTRLS	= CRS(EXTRLS,ITNAM)	:(XFF1)
XFF5	ITATR	= ?IEQ(FXATRB,FXXMSK) ITATR - FXATRB - TXATRB	:F(XFF6)
	TXATRB	=
XFF6	RETLAB	= ?INE(TXATRB,0) 'XFF1'	:S(BADDEF)
	ATRB(ITENT)	= ?IEQ(FTATRB,0) OR(ITATR,DFATR)	:F(XFF8)
XFF7	ATRB(ITENT)	= ?INE(XNATRB,0) OR(ITATR,DFATR - XNFATR)
.	:F(XFF4)
	RETLAB	= 'XFF1'	:(BADEXT)
XFF8	RETLAB	= ?INE(FXATRB,0) 'XFF1'	:S(BADDEF)
	ATRB(ITENT)	= OR(ITATR,DFATR)	:(XFF7)
*
*	ENTRY.FORTRAN.FUNCTION DECLARATION
NFF	J	= P
	STR1	= PARLIT(SQCHR,SQLTPT)	:F(BADDEC)
	STR1	@K  RSIDPT  @K  '('  @K  BREAK(')')  ')'  @K
.  RPOS(0)	:F(ENFX)
	STR2	=
	C	LEN(*P)  PCOMPT  SQCHR  @P	:F(NFF1)
	STR2	= PARLIT(SQCHR,SQLTPT)	:F(BADDEC)
NFF1	FORTLS	= ARRAY('5',FORTLS)
	FORTLS<2>	= ITNAM
	FORTLS<3>	= STNO
	FORTLS<4>	= DSB(STR1)
	FORTLS<5>	= ?IDENT(STR2) STR2	:S(NFF2)
	FORTLS<5>	= DSB(STR2)
NFF2	ENTRLS	= CRS(ENTRLS,ITNAM)	:(DCLEND)

*	DEDICATED VARIABLE DECLARATIONS
* INTEGER
INT	ITSW	= 2
DD1	ITPAT	= IDENPT
DD2	ITSEP	= PCOMPT ! @I
	DFATR	= VTVATR + ITSW * VDDATR + PRGALV
	ITBRK	= IDDCPT
	ITTYP	=
	I	=	:(DD4)
* REAL
REL	ITSW	= 3	:(DD1)
* STRING
STR	ITSW	= 1
	ITPAT	= IDENPT  '('  INTGPT  ')'	:(DD2)
* COMMON CODE FOR DEDICATED VARIABLES
DD3	?INE(I,P)	:F(DCLEND)
DD4	STR1	= DFI()		:F(BADDEC)
	IDENT(STR1)	:F(DD6)
DD5	?IEQ(ITSW,1)	:F(DD3)
	DSIZTB	= ?IDENT(DSIZTB) TABLE(3,3)
	DSIZTB[INAM(ITENT)]	= INTGER	:(DD3)
DD6	ATRB(ITENT)	= ?IEQ(VTATRB,0) OR(ITATR,DFATR)	:S(DD5)
	ATRB(ITENT)	= ?IEQ(VDATRB,0) OR(ITATR,ITSW * VDDATR)
.	:S(DD5)
	RETLAB	= 'DD3'	:(BADDEF)
*	*	*	*	*	*	*	*	*
*	*	SUBROUTINES	*	*	*	*	*
*	*	*	*	*	*	*	*	*
*		DFI() DEFINE ITEM
*	EXPECTS ITPAT SET TO ITEM RECOGNIZER PATTERN, ITBRK TO THE BREAK
*	PATTERN THAT ENDS THE ITEM, ITSEP TO THE SEPARATOR PATTERN,
*	ITTYP, DFATR TO THE DEFINING ATTRIBUTES, AND RETURNS A NON-NULL
*	VALUE IF THE SYMBOL HAS ALREADY BEEN ENTERED
*
DFI	PARLIT(SQCHR,ITBRK)	ITPAT	:F(FRETURN)
	C	LEN(*P)  ITSEP  @P	:F(FRETURN)
	ITATR	= DFATR
	DFI	= ?GETITM() ?INE(ITATR,DFATR) 'OLD'	:(RETURN)
*	*	*	*	*	*	*	*	*
*		DSB(STR1) DEFINE STRING BLOCK
*	CREATES DEFINITION FOR STRING BLOCK, RETURNS INAM
*
DSB	ITTYP	= 3
	ITATR	= SKRATR
	ITNAM	= STR1
	GETITM()
	ATRB(ITENT)	= ?IEQ(SKATRB,0) OR(ITATR,SKRATR)
	DSB	= INAM(ITENT)	:(RETURN)
*	*	*	*	*	*	*	*	*
END