PDP-10 Archive: 43,50263/initla.sno from decuslib10-02

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50263/initla.sno

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

*	*	*	*	*	*	*	*	*
*	*	DECLARATIONS	*	*	*	*	*
*	*	*	*	*	*	*	*	*
*
*		LOCAL
*
	DECLARE('SNOBOL.SUBPROGRAM','INITLA')
	DECLARE('OPTION','NO.STNO')
	DECLARE('PURGE.VARIABLE',ALL)
	DECLARE('PURGE.LABEL',ALL)
	DECLARE('EXTERNAL.FUNCTION','NEWNAM,
.PRTOUT,ERRMSG')
	DECLARE('INTEGER','I,J,K')
	DECLARE('ENTRY.FUNCTION','INITLA()')
*
*		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','INITLA,DXS,DTS
. ,SYMBOL,EXNAME')
	DECLARE('UNPURGE.LABEL','INITLA DXS DTS')
	DECLARE('PURGE.FUNCTION','DATA,SUBSTR,DUPL,TABLE,DEFINE,ARRAY,
.COPY,TIME,IDENT,OPEN,DIFFER,ENTER,OUTPUT,LOOKUP,INPUT,DATE,
.DAYTIM,RELEASE,SIZE,LGT')

*	*	*	*	*	*	*	*	*
*	*	INITIALIZE SYSTEM COMMON	*	*	*
*	*	*	*	*	*	*	*	*
*
*	LOCAL INITIALIZATION
INITLA	DATA('SYM(INAM,ATRB)')
	DATA('NOD(FRNT,BACK)')
*	SPECIAL CHARACTERS, CHARACTERR SEQUENCES, AND CHARACTER CLASSES
	FFCHR	= SUBSTR(&ALPHABET,1,12)
	LFCHR	= SUBSTR(&ALPHABET,1,10)
	CRCHR	= SUBSTR(&ALPHABET,1,13)
	TBCHR	= SUBSTR(&ALPHABET,1,9)
	SQCHR	= SUBSTR(&ALPHABET,1,39)
	DQCHR	= SUBSTR(&ALPHABET,1,34)
	LBCHR	= SUBSTR(&ALPHABET,1,3)
	CRLCHR	= CRCHR LFCHR
	BLNCHR	= ' ' TBCHR CRCHR
	EQLCHR	= '=_'
	QTSCHR	= SQCHR DQCHR
	LCSCHR	= SUBSTR(&ALPHABET,26,97)
	ELTCHR	= DUPL('A',34) 'DACABDFACCACCA' DUPL('E',10) DUPL('A',5)
. 'CC' DUPL('G',26) 'AC' DUPL('A',4) DUPL('G',26) DUPL('A',5)
*	STRING AND INTEGER PARAMETERS
	&ANCHOR	= 1
	&STLIMIT	= 10000000
	INDENT	= TBCHR
	SPLASH	= INDENT DUPL('*',42) CRLCHR
	XNVATR	= 1
	XNLATR	= 2
	XNFATR	= 3
	XNXMSK	= 3
	VTVATR	= 4
	VDDATR	= 8
	VDPATR	= 4 * 8
	VDDMSK	= 7 * 8
	LTDATR	= 64
	LTTMSK	= 3 * 64
	FTFATR	= 256
	FDPATR	= 512
	FDIATR	= 2 * 512
	FDDMSK	= 3 * 512
	TXTATR	= 2048
	TXTMSK	= 127 * 2048
	VNNATR	= 262144
	VXXATR	= 524288
	VIPATR	= 1048576
	VGGATR	= 2097152
	LIPATR	= 4194304
	LGGATR	= 8388608
	FIPATR	= 16777216
	FGGATR	= 33554432
	FXXATR	= 67108864
	FXXMSK	= 3 * 67108864
	SKRATR	= 268435456
	SDRATR	= 536870912
	BTRATR	= 1073741824

*	PATTERNS
	LETTER	= 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
	DIGIT	= '0123456789'
	COMSPT	= ANY('*-' FFCHR)
	INTGPT	= (SPAN('0') ! '')  (SPAN(DIGIT) $ STR1  FENCE
.  (*?ILT(SIZE(STR1),10) ! *LGT('8589934592',STR1))) $ INTGER
	BLNKPT	= SPAN(BLNCHR)
	OPBLPT	= NSPAN(BLNCHR)
	PCOMPT	= NSPAN(BLNCHR)  ','  NSPAN(BLNCHR)
	PCPRMT	= TAB(*P)  NSPAN(BLNCHR)  @P  ')'  @P
	IDENPT	= (ANY(LETTER LCSCHR)  NSPAN(LETTER LCSCHR DIGIT '.-'))
. $ ITNAM
	DCLCMT	= TAB(*P)  SQCHR  @P  NSPAN(BLNCHR)  @P  ')'  @P
.  NSPAN(BLNCHR)  @P  RPOS(0)
	RSIDPT	= (@I  ANY(LETTER LCSCHR)  NSPAN(LETTER LCSCHR DIGIT '.'
.)  @J  *?ILE(J - I,6)) $ ITNAM
	LABLPT	= (NOTANY('*-+.;' BLNCHR)  (BREAK(';' BLNCHR) ! REM)
.  FENCE) $ ITNAM
	POPRMT	= TAB(*P)  '('  @P  NSPAN(BLNCHR)  @P
	IDENMT	= TAB(*P)  IDENPT  @P
	SQLTPT	= BREAK(SQCHR CRCHR)
	DQLTPT	= BREAK(DQCHR CRCHR)
	LBDCPT	= BREAK(SQCHR BLNCHR)
	IDDCPT	= BREAK(SQCHR BLNCHR ',')

*	SYMBOL TABLES
	CONSTB	= TABLE(3,7)
	SYMBTB	= TABLE(85,7)
	XNAMTB	= TABLE(22,3)
* ROUTINE TO DEFINE SYMBOL WITH EXTERNAL NAME
	DEFINE('DXS(SYMBOL,EXNAME)')	:(DXSKIP)
DXS	DXS	= NEWNAM()
	SYMBTB[SYMBOL]	= SYM(DXS,I)
	XNAMTB[DXS]	= EXNAME	:(RETURN)
* EXTERNAL VARIABLES
DXSKIP	I	= VTVATR + VXXATR + XNVATR
	DXS('INPUT','S$$INP##')
	DXS('INPUTC','S$$INC##')
	DXS('OUTPUT','S$$OUT##')
	DXS('OUTPUTC','S$$OUC##')
* EXTERNAL LABELS
	I	= LTDATR + XNLATR + LIPATR
	DXS('RETURN','S$$SRT##')
	DXS('FRETURN','S$$FRT##')
	DXS('NRETURN','S$$NRT##')
	DXS('END','S$$SXT##')
* EXTERNAL FORTRAN FUNCTIONS
	I	= FTFATR + FDIATR + XNFATR
	DXS('FREEZE','F$$FRZ##')
	I	= I + TXTATR
	DXS('NOT','F$$NOT##')
	I	= I + TXTATR
	DXS('ILT','F$$LTP##')
	DXS('ILE','F$$LEP##')
	DXS('IEQ','F$$EQP##')
	DXS('INE','F$$NEP##')
	DXS('IGE','F$$GEP##')
	DXS('IGT','F$$GTP##')
	DXS('AND','F$$AND##')
	DXS('OR','F$$IOR##')
	DXS('XOR','F$$XOR##')
	DXS('RSHIFT','F$$RSH##')
	DXS('LSHIFT','F$$LSH##')
	DXS('REMDR','F$$RMD##')
* ROUTINE TO DEFINE SYMBOL WITH SPECIAL XT TYPE
	DEFINE('DTS(SYMBOL)')	:(DTSKIP)
DTS	SYMBTB[SYMBOL]	= SYM(NEWNAM(),I)
	I	= I + TXTATR	:(RETURN)
* PRIMITIVE PATTERN VARIABLES
DTSKIP	I	= VTVATR + VDPATR + TXTATR
	DTS('FAIL')
	DTS('FENCE')
	DTS('ABORT')
	DTS('ARB')
	DTS('BAL')
	DTS('SUCCEED')
	DTS('REM')
* PRIMITIVE PATTERN FUNCTIONS
	I	= FTFATR + FDPATR + TXTATR
	DTS('LEN')
	DTS('TAB')
	DTS('RTAB')
	DTS('POS')
	DTS('RPOS')
	DTS('SPAN')
	DTS('BREAK')
	DTS('ANY')
	DTS('NOTANY')
	DTS('NSPAN')
	DTS('BREAKX')
	DTS('BREAKQ')
	DTS('ARBNO')
* PREDEFINED PRIMITIVES
	I	= FXXMSK + TXTATR
	DTS('APPLY')
	DTS('ITEM')
	DTS('DATE')
	DTS('TIME')
	DTS('DAYTIM')
	DTS('EJECT')
	DTS('INTEGER')
	DTS('REAL')
	DTS('SIZE')
	DTS('TRIM')
	DTS('DATATYPE')
	DTS('COPY')
	DTS('PROTOTYPE')
	DTS('COLLECT')
	DTS('EXTIME')
	DTS('REVERS')
	DTS('DETACH')
	DTS('RELEASE')
	DTS('DATA')
	DTS('LGT')
	DTS('CONVERT')
	DTS('ARRAY')
	DTS('TABLE')
	DTS('DUPL')
	DTS('DEFINE')
	DTS('OPSYN')
	DTS('OPEN')
	DTS('LOOKUP')
	DTS('ENTER')
	DTS('DIFFER')
	DTS('IDENT')
	DTS('LT')
	DTS('LE')
	DTS('EQ')
	DTS('NE')
	DTS('GE')
	DTS('GT')
	DTS('LPAD')
	DTS('RPAD')
	DTS('SUBSTR')
* SPECIAL CASE OF 'INPUT' AND 'OUTPUT', ALREADY DEFINED
	DTS	= .ATRB(SYMBTB['INPUT'])
	$DTS	= $DTS + I
	DTS	= .ATRB(SYMBTB['OUTPUT'])
	$DTS	= $DTS + I + TXTATR
	I	= I + 2 * TXTATR
	DTS('CLOSE')
	DTS('REPLACE')
	DTS('INSERT')

*	OTHER SYSTEM TABLES
* KEYWORDS
	KEYWTB	= TABLE(20,1)
	KEYWTB['STFCOUNT']	= 0
	KEYWTB['LASTNO']	= 1
	KEYWTB['STNO']	= 2
	KEYWTB['FNCLEVEL']	= 3
	KEYWTB['STCOUNT']	= 4
	KEYWTB['ERRTYPE']	= 5
	KEYWTB['RTNTYPE']	= 6
	KEYWTB['ALPHABET']	= 7
	KEYWTB['ABEND']	= 8
	KEYWTB['ANCHOR']	= 9
	KEYWTB['FULLSCAN']	= 10
	KEYWTB['STNTRACE']	= 11
	KEYWTB['MAXLNGTH']	= 12
	KEYWTB['STLIMIT']	= 13
	KEYWTB['ERRLIMIT']	= 14
	KEYWTB['DENSITY']	= 15
	KEYWTB['INPUT']	= 16
	KEYWTB['OUTPUT']	= 17
	KEYWTB['DUMP']	= 18
	KEYWTB['SLOWFRAG']	= 19
* CONTROL TYPES
	CTRLTB	= TABLE(10,1)
	CTRLTB['LIST']	= 'CTL1'
	CTRLTB['UNLIST']	= 'CTL2'
	CTRLTB['NOCODE']	= 'CTL3'
	CTRLTB['CODE']	= 'CTL4'
	CTRLTB['EJECT']	= 'CTL5'
	CTRLTB['SPACE']	= 'CTL6'
	CTRLTB['FAIL']	= 'CTL7'
	CTRLTB['NOFAIL']	= 'CTL8'
	CTRLTB['NOCROSS']	= 'CTL9'
	CTRLTB['CROSREF']	= 'CTL10'
* DECLARATION TYPES
	DECLTB	= TABLE(24,1)
	DECLTB['OPTION']	= 'OPT'
	DECLTB['SNOBOL.MAIN']	= 'SNO'
	DECLTB['SNOBOL.SUBPROGRAM']	= 'SUB'
	DECLTB['PURGE.VARIABLE']	= 'PRV'
	DECLTB['UNPURGE.VARIABLE']	= 'UPV'
	DECLTB['PURGE.LABEL']	= 'PRL'
	DECLTB['UNPURGE.LABEL']	= 'UPL'
	DECLTB['PURGE.FUNCTION']	= 'PRF'
	DECLTB['UNPURGE.FUNCTION']	= 'UPF'
	DECLTB['STRING']	= 'STR'
	DECLTB['INTEGER']	= 'INT'
	DECLTB['REAL']	= 'REL'
	DECLTB['RENAME']	= 'REN'
	DECLTB['GLOBAL.VARIABLE']	= 'GLV'
	DECLTB['GLOBAL.LABEL']	= 'GLL'
	DECLTB['GLOBAL.FUNCTION']	= 'GLF'
	DECLTB['EXTERNAL.VARIABLE']	= 'EXV'
	DECLTB['ENTRY.VARIABLE']	= 'ENV'
	DECLTB['EXTERNAL.LABEL']	= 'EXL'
	DECLTB['ENTRY.LABEL']	= 'ENL'
	DECLTB['EXTERNAL.FUNCTION']	= 'EXF'
	DECLTB['ENTRY.FUNCTION']	= 'ENF'
	DECLTB['EXTERNAL.FORTRAN.FUNCTION']	= 'XFF'
	DECLTB['ENTRY.FORTRAN.FUNCTION']	= 'NFF'
* BINARY OPERATOR TYPES
	BOPRTB	= TABLE(9,1)
	BOPRTB['**']	= 30
	BOPRTB['^']	= 30
	BOPRTB['*']	= 32
	BOPRTB['/']	= 33
	BOPRTB['+']	= 34
	BOPRTB['-']	= 35
	BOPRTB['.']	= 36
	BOPRTB['$']	= 37
	BOPRTB['!']	= 40
* UNARY OPERATOR TYPES
	UOPRTB	= TABLE(8,1)
	UOPRTB['$']	= 10
	UOPRTB['?']	= 11
	UOPRTB['\']	= 12
	UOPRTB['+']	= 13
	UOPRTB['-']	= 14
	UOPRTB['.']	= 15
	UOPRTB['@']	= 16
	UOPRTB['*']	= 17

*	BINARY OPERATOR RESULT ARRAYS
	BEXPAR	= ARRAY('0:5,0:5',3)
	J	=
BEXP0	I	=
BEXP1	BEXPAR<I,J>	= 2
	I	= ?INE(I,4) I + 2	:S(BEXP1)
	J	= ?INE(J,4) J + 2	:S(BEXP0)
	BEXPAR<4,4>	= 4
	I	=
BEXP2	BEXPAR<I,5>	= 7
	I	= ?INE(I,5) I + 1	:S(BEXP2)
	I	=
BEXP3	BEXPAR<5,I>	= 7
	I	= ?INE(I,4) I + 1	:S(BEXP3)
	BARTAR	= COPY(BEXPAR)
	J	=
BART0	I	=
BART1	BARTAR<I,J>	= OR(I,J)
	I	= ?INE(I,1) I + 1	:S(BART1)
	J	= ?INE(J,1) J + 1	:S(BART0)
	BPATAR	= ARRAY('0:5,0:5',7)
	J	=
BPAT0	I	=
BPAT1	BPATAR<I,J>	= 5
	I	= ?IEQ(I,1) 4	:S(BPAT1)
	I	= ?INE(I,5) I + 1	:S(BPAT1)
	J	= ?IEQ(J,1) 4	:S(BPAT0)
	J	= ?INE(J,5) J + 1	:S(BPAT0)
	BSPCAR	= ARRAY('0:5,0:5',4)
	J	=
BSPC0	I	=
BSPC1	K	= J
	K	= ?IGT(I,J) I
	K	= ?IEQ(K,4) 6
	BSPCAR<I,J>	= ?IGE(K,5) K
	I	= ?INE(I,5) I + 1	:S(BSPC1)
	J	= ?INE(J,5) J + 1	:S(BSPC0)
	BOPRAR	= ARRAY('15:20',BARTAR)
	BOPRAR<15>	= BEXPAR
	BOPRAR<18>	= BPATAR
	BOPRAR<19>	= BSPCAR
	BOPRAR<20>	= BPATAR
*	UNARY OPERATOR RESULT ARRAYS
	USTRAR	= ARRAY('0:5',4)
	USTRAR<5>	= 7
	UARTAR	= ARRAY('0:5',7)
	I	=
UART0	UARTAR<I>	= I
	I	= ?INE(I,4) I + 1	:S(UART0)
	UNAMAR	= COPY(USTRAR)
	UNAMAR<2>	= 7
	UNAMAR<3>	= 7
	UPOSAR	= ARRAY('0:5',5)
	UASTAR	= COPY(UPOSAR)
	UPOSAR<2>	= 7
	UPOSAR<3>	= 7
	UASTAR<5>	= 7
	UOPRAR	= ARRAY('10:17',USTRAR)
	UOPRAR<13>	= UARTAR
	UOPRAR<14>	= UARTAR
	UOPRAR<15>	= UNAMAR
	UOPRAR<16>	= UPOSAR
	UOPRAR<17>	= UASTAR

*
	:(RETURN)
END