*	*	*	*	*	*	*	*	*
*	*	DECLARATIONS	*	*	*	*	*
*	*	*	*	*	*	*	*	*
*
*		LOCAL
*
	DECLARE('SNOBOL.SUBPROGRAM','EACTPH')
	DECLARE('OPTION','NO.STNO')
	DECLARE('PURGE.VARIABLE',ALL)
	DECLARE('PURGE.LABEL',ALL)
	DECLARE('EXTERNAL.FUNCTION','PUTOUT,ERRMSG,NEWLAB,SUBS,GETATR,
.GETBKT')
	DECLARE('ENTRY.VARIABLE','BRKTB1,BRKTB2,BRKTB3,BRKTB4')
	DECLARE('INTEGER','BRKTB1,BRKTB2,BRKTB3,BRKTB4')
	DECLARE('INTEGER','I,J,K,L,M,NVAR,NSYM')
	DECLARE('ENTRY.FUNCTION','INIEAC()')
	DECLARE('ENTRY.FUNCTION','EACTPH()')
*
*		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','INIEAC,EACTPH,PUTLIT,STR1')
	DECLARE('UNPURGE.LABEL','INIEAC EACTPH PUTLIT')
	DECLARE('PURGE.FUNCTION','DATA,ARRAY,DIFFER,DATATYPE,SIZE,
.SUBSTR,IDENT')
*	*	*	*	*	*	*	*	*
*	*	INITIALIZE END-ACTION PHASE	*	*	*
*	*	*	*	*	*	*	*	*
INIEAC	DEFINE('PUTLIT(STR1)')
	DATA('SYM(INAM,ATRB)')
	DATA('SNT(SNX,STY,SNM,SVL)')	:(RETURN)
*	*	*	*	*	*	*	*	*
*	*	GENERATE END-ACTION STORAGE	*	*	*
*	*	*	*	*	*	*	*	*
EACTPH
*	TEMP LOCATIONS
	PUTOUT(SUBS(EACTAR<1>,TEMLOC,MAXTMP))
*	RELEASE CODE ARRAYS IN CASE STORAGE IS NEEDED
*
	GOTOAR	=
	DECLAR	=
	PROGAR	=
	VARBAR	=
	MACHAR	=
	STENAR	=
	PATRAR	=
	PTVRAR	=
	PTFNAR	=
	EXPRAR	=
	AROPAR	=
	ARITAR	=
*	CONVERT INTEGER AND REAL CONSTANTS TABLE TO ARRAY, GENERATE
*	REQUIRED CONSTANTS AND/OR DESCRIPTORS
	?INE(OBJFLG + LISTOB,0)	:F(EAC2)
	LISTAR	= ARRAY(CONSTB)	:F(EAC2)
	CONSTB	= ?TABLE(CONSTB)
	I	= 1
EAC1	STR1	= LISTAR<I,1>	:F(EAC2)
	J	=
	J	= ?DIFFER(DATATYPE(STR1),'INTEGER') 1
	STR2	= LISTAR<I,2>
	ITATR	= ATRB(STR2)
	STR2	= INAM(STR2)
	(?INE(AND(ITATR,1048576),0) ?PUTOUT(SUBS(EACTAR<2 + J>,STR2,
.STR1)))
	(?INE(AND(ITATR,524288),0) ?PUTOUT(SUBS(EACTAR<4 + J>,STR2,STR1)
.))
	I	= I + 1	:(EAC1)
EAC2	LISTAR	=
*	CONVERT SYMBOL TABLE TO ARRAY, INITIALIZE FOR SYMBOL LOOP
	VARBLK	= NEWLAB()
	LISTAR	= ARRAY(SYMBTB)
	SYMBTB	= ?TABLE(SYMBTB)
	I	= 1
*	SYMBOL LOOP, GENERATE ALL STORAGE EXCEPT UNDEDICATED VARIABLE
*	LOCATIONS AND SYMBOL BLOCK ENTRIES
EAC3	STR1	= LISTAR<I,1>	:F(EAC22)
	STR2	= LISTAR<I,2>
	ITATR	= ATRB(STR2)
	STR2	= INAM(STR2)
	?INE(OBJFLG + LISTOB,0)	:F(EAC10)
* STRING ATTRIBUTES
	ITTYP	= 3
	GETATR()
* BREAK TABLE ATTRIBUTE
	ITTYP	= 4
	(?GETATR() ?INE(BTATRB,0) ?GETBKT(STR1) ?PUTOUT(SUBS(EACTAR<6>,
.STR2,BRKTB1)) ?PUTOUT(SUBS(EACTAR<7>,RSHIFT(BRKTB2,18),AND(BRKTB2,
.262143))) ?PUTOUT(SUBS(EACTAR<7>,RSHIFT(BRKTB3,18),AND(BRKTB3,262143)))
. ?PUTOUT(SUBS(EACTAR<7>,RSHIFT(BRKTB4,18),AND(BRKTB4,262143))))
* VARIABLE ATTRIBUTES
	ITTYP	= 5
	(?GETATR() ?INE(VTATRB,0) ?INE(VDATRB,VDPATR))	:F(EAC10)
	(?INE(VXATRB,0) ?IEQ(VNATRB,0))	:S(EAC10)
	(?INE(VXATRB,0) ?PUTOUT(SUBS(EACTAR<11>,STR2,VDATRB / VDDATR,
.XNAMTB[STR2])))	:S(EAC10)
	NVAR	= ?IEQ(VDATRB,0) NVAR + 1	:F(EAC5)
	STR3	= ?INE(XNATRB,XNVATR) 'N' STR2	:S(EAC4)
	STR3	= XNAMTB[STR2]
EAC4	STR3	= SUBS(EACTAR<8>,STR3,VARBLK,NVAR)	:(EAC8)
EAC5	STR3	= ?INE(XNATRB,XNVATR) 'V' STR2	:S(EAC6)
	STR3	= XNAMTB[STR2]
EAC6	(?INE(VDATRB,VDDATR) ?PUTOUT(SUBS(EACTAR<9>,STR3)))	:S(EAC7)
	J	= DSIZTB[STR2]
	K	= J / 5
	K	= ?INE(J,5 * K) K + 1
	PUTOUT(SUBS(EACTAR<10>,STR3,K))
EAC7	(?IEQ(VNATRB,0) ?IEQ(VGATRB,0) ?INE(VIATRB,0)) :S(EAC10)
	STR3	= SUBS(EACTAR<11>,STR2,VDATRB / VDDATR,STR3)
EAC8	(?IEQ(VGATRB,0) ?INE(VIATRB,0) ?PUTOUT(STR3))	:S(EAC10)
	SKATRB	= 1
	K	= 1 + VGATRB / VGGATR
	K	= ?INE(SDATRB,0) 8 + K	:F(EAC9)
	SDATRB	=
EAC9	SYMLST	= SNT(SYMLST,K,STR2,STR3)
	NSYM	= NSYM + 1
* LABEL ATTRIBUTES
EAC10	ITTYP	= 6
	(?GETATR() ?INE(LTATRB,0))	:F(EAC14)
	(?INE(LTATRB,LTDATR) ?ERRMSG('UNDEFINED LABEL: ' STR1))
	?INE(OBJFLG + LISTOB,0)	:F(EAC21)
	(?IEQ(LGATRB,0) ?INE(LIATRB,0) ?IEQ(LTATRB,LTDATR)) :S(EAC15)
	STR3	= ?INE(XNATRB,XNLATR) 'L' STR2	:S(EAC11)
	STR3	= XNAMTB[STR2]
EAC11	STR3	= ?INE(LTATRB,LTDATR) SUBS(EACTAR<31>,STR3,EACTAR<12>)
.	:S(EAC12)
	STR3	= SUBS(EACTAR<13>,STR3)
EAC12	(?IEQ(LGATRB,0) ?INE(LIATRB,0) ?PUTOUT(STR3))	:S(EAC15)
	SKATRB	= 1
	K	= 3 + LGATRB / LGGATR
	K	= ?INE(SDATRB,0) 8 + K	:F(EAC13)
	SDATRB	=
EAC13	SYMLST	= SNT(SYMLST,K,STR2,STR3)
	NSYM	= NSYM + 1
* FUNCTION ATTRIBUTES
EAC14	?INE(OBJFLG + LISTOB,0)	:F(EAC21)
EAC15	ITTYP	= 7
	(?GETATR() ?INE(FTATRB,0) ?IEQ(FDATRB,0) ?INE(FXATRB,FXXATR))
.	:F(EAC19)
	STR3	= ?IEQ(FXATRB,0) SUBS(EACTAR<14>,STR2)	:S(EAC17)
	STR3	= ?IEQ(FXATRB,FXXMSK) PRIMAR<TXATRB / TXTATR> :F(EAC16)
	STR3	RTAB(3) $ K  REM $ STR3
	STR3	= SUBS(EACTAR<16>,STR2,K,STR3)	:(EAC17)
EAC16	STR3	= ENTFTB[STR2]
	K	= STR3<4>
	STR3	= SUBS(EACTAR<15>,STR1,K,STR2)
EAC17	(?IEQ(FGATRB,0) ?INE(FIATRB,0) ?PUTOUT(STR3))	:S(EAC19)
	SKATRB	= 1
	K	= 5 + FGATRB / FGGATR
	K	= ?INE(SDATRB,0) 8 + K	:F(EAC18)
	SDATRB	=
EAC18	SYMLST	= SNT(SYMLST,K,STR2,STR3)
	NSYM	= NSYM + 1
* GENERATE STRING BLOCK AND DESCRIPTOR,IF REQUIRED
EAC19	(?INE(SDATRB,0) ?PUTOUT(SUBS(EACTAR<17>,STR2)))
	J	= ?INE(SKATRB,0) SIZE(STR1)	:F(EAC21)
	K	= J / 5
	K	= ?INE(J,5 * K) K + 1
	PUTOUT(SUBS(EACTAR<18>,STR2,K,J))
	(?ILE(J,60) ?PUTLIT(STR1))	:S(EAC21)
	P	=
EAC20	K	= 60
	K	= ?IGT(K,J - P) J - P
	PUTLIT(SUBSTR(STR1,K,P))
	P	= ?INE(P + K,J) P + 60	:S(EAC20)
* BOTTOM OF SYMBOL LOOP
EAC21	I	= I + 1	:(EAC3)
* END OF SYMBOL LOOP
EAC22	LISTAR	=
	?INE(OBJFLG + LISTOB,0)	:F(RETURN)
*	GENERATE VARIABLE BLOCK
	(?IGT(NVAR,0) ?PUTOUT(SUBS(EACTAR<20>,VARBLK,NVAR)))
*	GENERATE SYMBOL BLOCK
	SYMBLK	= ?IGT(NSYM,0) NEWLAB()	:F(EAC24)
	PUTOUT(SUBS(EACTAR<25>,SYMBLK,NSYM))
EAC23	I	= STY(SYMLST)
	STR1	=
	STR1	= ?INE(AND(I,8),0) SUBS(EACTAR<26>,SNM(SYMLST))
	I	= AND(I,7)
	PUTOUT(SUBS(EACTAR<27>,I,STR1,SNM(SYMLST),SVL(SYMLST)))
	SYMLST	= SNX(SYMLST)
	IDENT(SYMLST)	:F(EAC23)
*	GENERATE PARAMETER BLOCK
EAC24	VARBLK	= ?IEQ(NVAR,0) '0'
	SYMBLK	= ?IEQ(NSYM,0) '0'
	STNO	= ?INE(STNFLG,1) 0
	PUTOUT(SUBS(EACTAR<21>,PRGNAM,PARBLK,VARBLK,SYMBLK,STNO))
*	GENERATE 'ENTRY.FUNCTION' INITIALIZATIONS
	LISTAR	= ?DIFFER(ENTFTB) ARRAY(ENTFTB)	:F(EAC27)
	ENTFTB	= ?TABLE(ENTFTB)
	I	= 1
EAC25	STR1	= LISTAR<I,1>	:F(EAC27)
	STR2	= LISTAR<I,2>
	STR3	= STR2<3>
	STR3	= ?IDENT(STR3) '0'	:S(EAC26)
	STR3	= SUBS(EACTAR<22>,STR3)
EAC26	PUTOUT(SUBS(EACTAR<23>,STR2<1>,PARBLK,STR1,STR2<2>,STR3))
	I	= I + 1	:(EAC25)
*	GENERATE 'ENTRY.FORTRAN.FUNCTION' INITIALIZATIONS
EAC27	STR1	= ?DIFFER(FORTLS) FORTLS<5>	:F(EAC29)
	STR1	= ?IDENT(STR1) '0'	:S(EAC28)
	STR1	= SUBS(EACTAR<22>,STR1)
EAC28	PUTOUT(SUBS(EACTAR<24>,FORTLS<2>,FORTLS<3>,PARBLK,FORTLS<4>,
.STR1))
	FORTLS	= FORTLS<1>	:(EAC27)
*	GENERATE END STATEMENT
EAC29	(?INE(DMPFLG,0) ?PUTOUT(EACTAR<30>))
	(?DIFFER(SNONAM) ?PUTOUT(SUBS(EACTAR<29>,STARTP))) :S(RETURN)
	PUTOUT(EACTAR<28>)	:(RETURN)
*	*	*	*	*	*	*	*	*
*	*	SUBROUTINES	*	*	*	*	*
*	*	*	*	*	*	*	*	*
*	*	PUTLIT(STR1) OUTPUTS QUOTED STRING
*	IF STRING CONTAINS BOTH SINGLE AND DOUBLE QUOTES, IT IS BRO-
*	KEN UP AND THE TOUGH SECTION PUT OUT AS BYTES
*
PUTLIT	STR1	BREAK(SQCHR)	:S(PUTLT1)
	PUTOUT(SUBS(EACTAR<19>,SQCHR,STR1))	:(RETURN)
PUTLT1	STR1	BREAK(DQCHR)	:S(PUTLT2)
	PUTOUT(SUBS(EACTAR<19>,DQCHR,STR1))	:(RETURN)
PUTLT2	L	= SIZE(STR1)
	(?IGT(L,5) ?PUTLIT(SUBSTR(STR1,5)) ?PUTLIT(SUBSTR(STR1
.,SIZE(STR1) - 5,5)))	:S(RETURN)
	A	= ARRAY('5',0)
	L	=
PUTLT3	&ALPHABET	ARB  SUBSTR(STR1,1,L)  @M	:F(PUTLT4)
	L	= L + 1
	A<L>	= M - 1	:(PUTLT3)
PUTLT4	PUTOUT(SUBS(EACTAR<32>,A<1>,A<2>,A<3>,A<4>,A<5>))
.	:(RETURN)
*	*	*	*	*	*	*	*	*
END