Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0057/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