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

-CROSREF
*	*	*	*	*	*	*	*	*
*	*	DECLARATIONS	*	*	*	*	*
*	*	*	*	*	*	*	*	*
*
*		LOCAL
*
	DECLARE('SNOBOL.SUBPROGRAM','INITLZ')
	DECLARE('OPTION','NO.STNO')
	DECLARE('PURGE.VARIABLE',ALL)
	DECLARE('PURGE.LABEL',ALL)
	DECLARE('EXTERNAL.FUNCTION','INIDEC,INIEXE,INIEAC,INICRS,NEWNAM,
.INITLA,INITLB,PRTOUT,ERRMSG')
	DECLARE('INTEGER','I,J,K')
	DECLARE('ENTRY.FUNCTION','INITLZ()')
*
*		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','INITLZ,SYMBOL,EXNAME')
	DECLARE('UNPURGE.LABEL','INITLZ')
	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
INITLZ	DATA('SYM(INAM,ATRB)')
	DATA('NOD(FRNT,BACK)')
	INITLA()
	INITLB()

*	*	*	*	*	*	*	*	*
*	*	INITIALIZE OTHER COMPILATION PHASES	*	*
*	*	*	*	*	*	*	*	*
	INIDEC()
	INIEXE()
	INIEAC()
	INICRS()
*	*	*	*	*	*	*	*	*
*	*	FREEZE THE COMPILER AT THIS POINT	*	*
*	*	*	*	*	*	*	*	*
	FREEZE()
	STRTIM	= TIME()
*	*	*	*	*	*	*	*	*
*	*	UPON RESTART, DECODE COMMAND LINE	*	*
*	*	*	*	*	*	*	*	*
COMLIN	OUTPUTC	= CRLCHR '*'
	C	= INPUT '?'
	P	=
	&ERRLIMIT	= 1
	FILSMT	= TAB(*P)  (BREAK(':,?' EQLCHR) . DEV  ':' ! '' . DEV)  @P
.  BREAK('.,?' EQLCHR) . FIL  @P  ('.'  BREAK(',?' EQLCHR) ! '') . EXT  @P
*	OBJECT FILE
OBJFIL	C	FILSMT  ','  @P	:F(BADCOM)
	?IGT(P,1)	:F(LSTFIL)
	DEV	= ?IDENT(DEV) 'DSK'
	OPEN(DEV '(2)',1)	:F(BADCOM)
	DIFFER(FIL)	:F(OBJF1)
	EXT	= ?IDENT(EXT) '.MAC'
	ENTER(FIL EXT,1)	:F(BADCOM)
OBJF1	OUTPUT('OBJLIN',1,500)	:F(BADCOM)
	OUTPUT('OBJCHR',1,-1)	:F(BADCOM)
	OBJFLG	= 1
*	LISTING FILE
LSTFIL	I	= P + 1
	C	FILSMT  ANY(EQLCHR)  @P	:F(BADCOM)
	?IGT(P,I)	:F(SRCFIL)
	DEV	= ?IDENT(DEV) 'DSK'
	OPEN(DEV '(2)',2)	:F(BADCOM)
	DIFFER(FIL)	:F(LSTF1)
	ENTER(FIL EXT,2)	:F(BADCOM)
LSTF1	OUTPUT('LSTLIN',2,500)	:F(BADCOM)
	OUTPUT('LSTCHR',2,-1)	:F(BADCOM)
	LISTSR	= 1
*	SOURCE FILE
SRCFIL	I	= P + 1
	C	FILSMT  '?'  @P  RPOS(0)	:F(BADCOM)
	?IGT(P,I)	:F(BADCOM)
	DEV	= ?IDENT(DEV) 'DSK'
	OPEN(DEV '(0,2)',3)	:F(BADCOM)
	DIFFER(FIL)	:F(SRCF1)
	EXT	= ?IDENT(EXT) '.SNO'
	LOOKUP(FIL EXT,3)	:F(BADCOM)
SRCF1	INPUT('SRCLIN',3,132)	:F(BADCOM)
	PRTOUT(SPLASH INDENT '** FASBOL II COMPILER V 1.0 (JUNE,1972) **
.' CRLCHR SPLASH CRLCHR 'COMPILATION DONE ON ' DATE() ' AT ' DAYTIM()
. CRLCHR CRLCHR)
	&ERRLIMIT	=
	OUTPUT('OUTPUT',0,500)
	INITLZ	= $'SRCLIN'	:S(RETURN)
*	IMMEDIATE EOF
	ERRMSG('NO SOURCE PROGRAM')	:(FRETURN)
*	BAD COMMAND LINE
BADCOM	OUTPUT	= DUPL(' ',P) '^'
	OUTPUT	= '*BAD COMMAND LINE*'
	RELEASE()	:(COMLIN)
END