-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