*			TAPE 4 OF 5 - BEGIN
*
EX34	LDA	B	IF B = 0
	SUB	EXT7
	SZE
	JMP	EX40	NO, GO TO EX40
	LDA	T0EX	IF T (0) = 0
	SZE
	JMP	EX38	NO, GO TO EX38
EX35	CRA
	STA	IFLG	IFLG = 0
	LDA	F
	AOA
	SMI		F . GE. -1
	JMP	EX36	YES
	JMP*	EX00	RETURN - NO
EX36	JST	CA00	SCAN
	JST	OT00	OUTPUT TRIADS
	JMP*	EX00	RETURN
EX38	JST	STXI
	LDA	B
	SUB	K109
	STA	B
	LDA	K103
	STA	MFL
	LDA	T0EX
	LGL	9	O (I) = T (0)
	ADD	B	I (I) = B+9
	ADD	K124	I = I+2
	STA	DP+1,1
	JST	EX99	DATA POOL CHECK
	CRA
	STA	T0EX	T0 = 0
	STA	EXT7	T7 = 0
EX39	LDA	L0
	STA	A	A = L0
	STA	IM	IM NOT EQ 0
	JMP	EX10
EX40	LDA	TC	TC 0 ,
	CAS	K5	='254 (,) IN BCD MODE
	JMP	*+2
	JMP	EX41
	SUB	K134	=17
	SZE
	JMP	EX44	NO, GO TO EX44
EX41	LDA	I
EX42	SUB	K102
	STA	XR	B VS. I (J)
	LDA	DP+1,1
	ANA	K118
	CAS	B
	JMP	*+3
	JMP	EX24	EQUAL, GO TO EX24
	JMP*	EX00	LESS, RETURN
	LDA	XR	GREATER, REPEAT LOOP
	JMP	EX42
EX44	JST	IP00	) - INPUT OPERATOR
	JMP	EX30	GO TO EX30
EX46	LDA*	A
	STA	T6EX	IF O1(O1(A)) = L(0)
	LDA*	T6EX
	CAS	L0
	JMP	*+2
	JMP	EX34	GO TO EX34
	STA	O2	O2 = L0
EX48	JST	ET00	ENTER TRIAD
	JMP	EX34
EX50	JST	STXI
	LDA	A	A(I) = A
	STA	DP,1
	LDA	IU	IU = SUB OR ARR
	SLN
	JMP	EX30	NO, GO TO EX30
	LDA	TC
	SUB	K17	TC = (
	SZE
	JMP	EX76	NO, GO TO EX76
	LDA	B	YES, B = B+16
	ADD	K109
	STA	B
	LDA	IU	IU = ARR
	SUB	K103
	SZE
	JMP	EX75	NO, GO TO EX75
	CRA
	STA	DP,1	A(I) = 0
	STA	X4	X4 = 0
	STA	T3EX	T3 = 0
	STA	K	T5 = A
	LDA	D0
	STA	T9EX	T9 = D0
	LDA	A
	STA	T5EX	T5 = A
	LDA	AT
	SUB	K105	AT = DUM
	SZE
	JMP	EX74	NO, GO TO EX74
	CRA
	STA	T2EX	YES, T (0) = 0
	JST	EX99	DATA POOL CHECK
	JST	STXI
	LDA	A
	STA	DP,1	A(I) = A
	LDA	K132	OI (I) = A, 11
	LGL	9
	ADD	K124
	STA	DP+1,1	I=9
EX54	LDA	D0	IF D0 = 1, GO TO EX56
	SUB	K101
	SNZ
	JMP	EX56
	JST	EX99	DATA POOL CHECK
	JMP	*+2
EX55	IRS	K	K = K+1
	LDA	K
	STA	XR
	LDA	X,1
	STA	T6EX	T6 = X (K)
	JST	STXI
	LDA	T6EX
	STA	DP,1	O(I) = *
	LDA	K103	I (I) = T3+13
	LGL	9	T3 = T3+16
	ADD	T3EX	A (A) = T6
	ADD	K129	=13
	STA	DP+1,1
	ANA	K118
	ADD	K103
	STA	T3EX	T3 = A(A)
EX56	JST	IV00	INPUT INTEGER VARIABLE
	JST	EX99	DATA POOL CHECK
	JST	STXI
	LDA	A	A(I) = A
	STA	DP,1
	LDA	NT
	SZE
	JMP	EX68	CONSTANT ENCOUNTERED
	JST	UC00	UNINPUT COLUMN
	JST	DN00	INPUT DO NOT ASSIGN
	SNZ
	JMP	EX57	IM = 0
	SUB	K101
	SNZ
	JMP	EX57	IM * INTEGEH
	JST	ER00
	BCI	1,SU	SUBSCRIPT INCREMENTER NOT A CONSTANT
EX57	JST	STXI
	LDA	K101
	LGL	9
	ADD	T3EX
	ADD	K127
	STA	DP+1,1	O(1) = +, I(I) = T3+11
	JST	EX99	DATA POOL CHECK
EX58	LDA	T9EX
	STA	D0	RESET D(0)
	LDA	ID	SUBSCRIPT SIZE
	SUB	K101	ID = ID-1
	STA	ID
	SNZ		IF ZERO, GO TO EX60
	JMP	EX60
	LDA	K
	STA	0
	LDA	D0,1	D(K) = 0
	SNZ
	JMP	EX67	YES - (DUMMY DIMENSION)
	IAB
	LDA	ID
	JST	IM00
	ADD	T2EX
	STA	T2EX	T2 = T2+ID*D(K)
EX60	LDA	T9EX
	STA	D0	RESET D(0)
	LDA	K
	STA	0
	LDA	X+2,1	X(K+2) = 0
	SNZ
	JMP	EX62	YES - FINISHED
	LDA	K134	=17
	JST	TS00	COMMA TEST
	LDA	D0+1,1
	IAB
	LDA	D0,1
	JST	IM00
	STA	D0+1,1	D(K+1) = D(K+1)*D(K)
	JMP	EX55
EX62	JST	STXI
	LDA	DP-1,1	DOES O(--2) = *
	SSP
	LGR	9
	CAS	K103
	JMP	*+2
	JMP	EX66	YES.
	SNZ		NO.
	JMP	EX64	O(I-2) = 0 - YES
	CAS	K132	DOES O(I-2) = A
	JMP	EX63
	JMP	*+2	YES
	JMP	EX63
	LDA	T2EX	IS T2 = 0
	SNZ
	JMP	EX65	YES (DUMMY ARRAY (1,1,1))
EX63	LDA	K101
	STA	DP-1,1	01(I-2) = 1
	LDA	T2EX	A(I) = T2
	STA	DP,1
	LDA	K137	0='X' ('24),   I=2
	STA	DP+1,1
	CRA
	STA	DP+3,1	O1(1+2) = 0
	LDA	T5EX
	STA	DP+2,1	A(I+2) = T5
	JST	EX99	DATA POOL CHECK
	JST	CA00	SCAN
	LDA	O1
	STA	A	A = O1
	JST	STXA
	LDA	DP+2,1	S(A) = NON-ZERO
	SSM
	STA	DP+2,1	S(A) = 1
	JMP	EX44
EX64	LDA	L0
	STA	DP,1	A(I) = L0
	JST	EX99	DATA POOL CHECK
	JST	STXI
	JMP	EX63
EX65	LDA	I
	SUB	K104
	STA	I	I = I-4
	LDA	T5EX
	STA	DP-4,1	A (I) = T5
	JMP	EX44
EX66	LDA	I
	SUB	K102
	STA	I	I = I-2
	JMP	EX62	ASSIGN INT CONSTANT
EX67	JST	AI00
	JST	STXI	SET XR TO I
	LDA	A
	STA	DP,1	A(I) = A
	LDA	K101
	LGL	9
	ADD	T3EX
	ADD	K127
	STA	DP+1,1	OI(I) = +, T3+11
	JST	EX99	DATA POOL CHECK
	JMP	EX60
EX68	LDA	TC	IS TC
	CAS	K103	= *
	JMP	*+2
	JMP	*+2
	JMP	EX58	NO
	LGL	9
	ADD	T3EX
	ADD	K129	=13
	STA	DP+1,1	OI(I) = *, T3+13
	JST	IR00	INPUT INTEGER VAR/CON
	JMP	EX56+1
EX69	CRA		SET LISTING FOR OCTAL ADDR
	STA	A
	LDA	OMI5	JMP 0  INSTRUCTION
	STA	DF	SET LISTING FOR SYMBOLIC A INSTR,
	JST	OA00	OUTPUT ABSOLUTE
	LDA	RPL
	STA	O2
	LDA	K138
	STA	P	P = H
	JST	ET00	ENTER TRIAD
	JST	HS00	TRANSFER HOLLERITH STRING
	LDA	CRET	(A) = C/R
	JST	OK00	OUTPUT PACK
	CRA
	STA	0	SET LISTING FOR OCTAL ADDR.
	STA	A	SET LISTING FOR OCTAL ADDR.
	LDA	O2
	SUB	K101
	JST	OS00	OUTPUT STRING RPL-1
	JST	CH00	INPUT CHARACTER
	JST	FN00
	JST	STXI	RESET INDEX TO I
	LDA	L
	STA	DP,1	A(I) = L
	JMP	EX76
EX74	LDA	AF
	STA	T2EX	T2 = AF
	JMP	EX54	GO TO EX54
EX75	LDA	K134
	STA	TC	TC = ,
	JMP	EX24	GO TO EX24
EX76	LDA	DP-1,1
	LGR	9
	ANA	K133
	SUB	K134
	SNZ
	JMP	EX34	WITHIN AN ARGUMENT LIST
	JST	ER00
	BCI	1,AG	SUBROUTINE OR ARRAY NAME NOT IN ARG. LIST
EX78	LDA	K127
EX79	STA	T1EX	T (1) = 11
	JMP	EX22
EX80	LDA	K129	T (1) = 13
	JMP	EX79
EX81	LDA	K106
	STA	T1EX	T (1) = 6
	JMP	EX20
EX82	LDA	K104	T (1) = 4
	JMP	EX81+1
EX83	LDA	T0EX	T (0) =0
	SZE
	JMP	EX84
	LDA	TC	YES,
	STA	T0EX	T (0) = TC
	LDA	EX92+1
	STA	TC	TC = -
	LDA	B
	ADD	K109
	STA	B
	STA	EXT7
	LDA	*+2
	JMP	EX79
	DEC	-5
EX84	JST	ER00	ERROR
	BCI	1,RL	MORE THAN 1 RELATIONAL OPERATOR
EX85	LDA	F
	ADD	K102	T (5) = T (5) +2 = B = 0
	STA	F
	ADD	B
	SNZ
	JMP	EX24
	JST	ER00	ERROR
	BCI	1,EQ	MULTIPLE ='S, OR EXPRESSIUN TO LEFT OF =
EX90	OCT	250	(
	OCT	3	*
	OCT	5	NOT
	OCT	1	+
	OCT	2	-
	OCT	310	H
EX91	DAC	EX12	(
	DAC	EX16	*
	DAC	EX18	NOT
	DAC	EX26	+
	DAC	EX26	-
	DAC	EX69	H
EX92	OCT	1	+
	OCT	2	-
	OCT	3	*
	OCT	4	/
	OCT	6	AND
	OCT	7	OR
	OCT	15	NE
	OCT	12	EQ
	OCT	14	GT
	OCT	10	LT
	OCT	13	GE
	OCT	11	LE
	OCT	16	=
	OCT	16	= (ERROR)
EX93	DAC	EX78	+
	DAC	EX78
	DAC	EX80	*
	DAC	EX80	/
	DAC	EX81	AND
	DAC	EX82	OR
	DAC	EX83	NE
	DAC	EX83	EQ
	DAC	EX83	GT
	DAC	EX83	LT
	DAC	EX83	GE
	DAC	EX83	LE
	DAC	EX85	=
	DAC	EX34	NONE OF THESE
EX95	JST	ER00
	BCI	1,OP	MURE THAN ONE OPERATOR IN A ROW
EX96	JST	ER00	ERROR
	BCI	1,PA	OPERATOR MUST BE WITHIN PARENTHESES
EX97	JST	ER00	ERROR
	BCI	1,UO	MULTIPLE + OR - SIGNS NOT AS UNARY OPS
*    BUMP THE I COUNT BY TWO AND CHECK FOR DATA OVERFLOW
EX99	DAC	**
	IRS	I
	IRS	I
	LDA	I
	AOA
	CAS	L
	NOP
	JMP	AS50
	JMP*	EX99
K133	OCT	77
K130	DEC	-6
K141	DEC	33
K	PZE	0
KM8	DEC	-8
*
*
*
*
*             ******************
*             *SCAN            *
*             *TRIAD SEARCH    *
*             *TEMP STORE CHECK*
*             ******************
T0CA	PZE	0
T1CA	PZE	0
T2CA	PZE	0
T9CA	PZE	0
*          THE AOIN TABLE IS PROCESSED FROM THE BOTTOM
*               UP AND ENTRIES ARE FORMED FOR INCLUSION
*               IN THE TRIAD TABLE, LEVELS ARE USED
*               TO CONTROL THE ORDER OF ENTRY INTO
*               THE TRIADS. SIGN CONTROL IS ALSO
*               ACCOMPLISHED IN THIS ROUTINE.
CA00	DAC	**
	LDA	L0
	STA	ACCP	INDICATE EMPTY ACCUM
CA04	JST	STXI	ESTABLISH I
	STA	T1CA	T1 = I
	LDA	DP-1,1
	ANA	K118	IF I (I-2) = 0,
*                            OR .LT. I (I)
	STA	T9CA
	LDA	DP+1,1
	ANA	K118
	CAS	T9CA
	JMP	CA08	GO TO CA08
	NOP
	LDA	I
	SUB	K102
	STA	I	I = I-2
	STA	0
CA08	LDA	DP+3,1
	ERA	DP+1,1
	STA	T0CA
	LDA	DP+1,1
	ANA	K118
	STA	T2CA
	LDA	DP+1,1
	SSP
	LGR	9	P = O (I)
	STA	P
	CAS	K102	IF P IS NOT * OR /, GO TO CCA10
	CAS	K105
	JMP	CA10
	JMP	CA10
	JMP	CA14	GO T0 CA14
CA10	LDA	T0CA
	SMI
	JMP	CA13
	LDA	KM8
	IMA	XR
	IAB
	LDA	P
	CAS	CA90+8,1
	JMP	*+2
	JMP	*+4
	IRS	XR
	JMP	*-4
	JMP	CA45
	LDA	CA91+8,1
	STA	P
	IAB
	STA	XR
CA13	LDA	K130
	IMA	XR
	IAB
	LDA	P
	CAS	CA90+8,1
	JMP	*+2
	JMP	CA50
	IRS	XR
	JMP	*-4
	IAB
	STA	XR
	IAB
	LDA	DP+1,1
	JMP	*+2
CA50	CRA
	STA	T0CA
	IAB
	STA	XR
CA14	LDA	DP,1
	STA	O1	O1=A(I)
	LDA	DP+2,1
	STA	O2	O2 = A (I+2)
	LDA	T2CA
	SNZ
	JMP	CA37	IF ZER0, GO TO CA37
	LDA	DP-1,1
	SSP
	LGR	9
	STA	T1CA
	LDA	DP-1,1
	ANA	K118	IF T2 .GT. I (I-2)
	SUB	T2CA
	SPL
	JMP	CA18
	SZE
	JMP	CA04
	LDA	O2
	SUB	ACCP
	SZE
	JMP	CA04
	LDA	P
	SUB	K103
	SMI
	JMP	CA39
	LDA	T1CA
	SUB	P
	SZE
	LDA	K101	GO TO
	ADD	K101	P = - OR +
	STA	P
CA18	LDA	I
	STA	0	J=I
CA20	LDA	DP+2,1
	STA	DP,1	AOIN(J) = AOIN(J+2)
	LDA	DP+3,1
	STA	DP+1,1
	SSP
	SNZ
	JMP	CA22
	IRS	XR	J = J+2
	IRS	XR
	JMP	CA20
CA22	JST	STXI
	LDA	DP+1,1
	SSP		IF O (I) = ,
	LGR	9
	CAS	P
	JMP	CA24
	CAS	K134
	JMP	CA24
	JMP	CA30	GO TO CA30
CA24	JST	ST00	TRIAD SEARCH
	LDA	P
	CAS	K132	IF P = +,*, AND, OR
	JMP	CA28
	JMP	CA37	GO TO CA37
	CAS	K107
	JMP	CA28	ELSE, GO TO CA26
	JMP	CA37
	CAS	K106
	JMP	CA28
	JMP	CA37
	CAS	K103
	JMP	CA28
	JMP	CA37
	CAS	K101
	JMP	CA26
*
*
*
	JMP	CA37
CA26	CAS	K102
	JMP	*+2	IF P = -
	JMP	CA35	GO TO
CA28	LDA	O1
	JST	TC00	TEMP STORE CHECK
CA30	LDA	O2
	JST	TC00	TEMP STORE CHECK
CA31	JST	ET00	ENTER TRIAD
CA32	JST	STXI
	LDA	O1
	STA	DP,1
	LDA	DP+1,1
	LRL	15
	LDA	T0CA
	LGR	15
	LLL	15
	STA	DP+1,1
	LDA	T2CA	IF T2 NOT ZERO,
	SZE
	JMP	CA04	GO TU CA04
	JMP*	CA00	ELSE, RETURN
CA35	LDA	T0CA
	ERA	='100000
	STA	T0CA
CA37	LDA	O2
	IMA	O1	O1 * = O2
	STA	O2
	SNZ		IF 02 = 0,
	JMP	CA32	GO TO CA32
*
*
*
	JST	ST00	TRIAD SEARCH
	LDA	T0CA
	SMI
	JMP	CA28	GO TO CA28
	LDA	P
	JMP	CA26	ELSE, GO TO CA26
CA39	SUB	K128
	SNZ		IF P = , OR
	JMP	CA04
	LDA	T1CA
	SUB	K104
	SZE		ELSE,
	JMP	CA18	GO TO CA18
	JMP	CA04
CA45	LDA	T1CA
	STA	I	I = T1
	STA	T2CA
	CRA
	STA	T0CA	* * * * * * * * * * *
	STA	O2	O2 = C = 0
	SUB	K110	P = C
	STA	P
	JMP	CA24	GO TO CA24
*          IF THE CURRENT TRIAD (IN WORKING STORAGE) MATCHES
*               ANY TRIAD TABLE ENTRY, EXIT WITH THE
*               POINTER VALUE OF THE MATCHING ENTRY
*               (THIS ACCOMPLISHES ELIMINATION OF REDUNDANT
*               SUBEXPRESSION CALCULATIONS.
ST00	DAC	**	TRIAD SEARCH
	LDA	F
	ADD	K103
	SZE
	JMP	ST10	GO TO ST10
ST05	LDA	P	ELSE, IF P = X
	SUB	K139
	SNZ
	JMP	CA31	GO TO CA31
	LDA	O1	ELSE, IF 01=ACCP
	SUB	ACCP
	SNZ
	JMP	CA30	GO TO CA30
	JMP*	ST00	ELSE, RETURN
ST10	LDA	L0
	STA	XR
ST20	LDA	XR
	SUB	K103
	STA	XR	J = J-2
	SUB	L	IF J .LT. L
	SPL
	JMP	ST05	GO TO ST05
	LDA	O2
	SUB	DP,1	IF O1/P/O2 .NE. O1/P/O2(J)
	SZE
	JMP	ST20	GO TO ST20
	LDA	DP+2,1
	SSP		EXTRACT OFF STORE BIT
	SUB	P
	SZE
	JMP	ST20
	LDA	O1
	SUB	DP+1,1
	SZE
	JMP	ST20	O1 = J
	LDA	XR
	STA	O1
	JST	STXI	ESTABLISH I
	JMP	CA32	GO T0 CA32
*          IF J IS A REFERENCE TO A TRIAD , THE TEMP
*               STORE BIT 0F THE REFERENCED TRIAD IS SET.)
TC00	DAC	**	TEMP STORE CHECK
	STA	XR
	LDA	ABAR
	SUB	XR
	SMI		IS J .GR. ABAR
	JMP*	TC00	NO.
	LDA	DP+2,1	YES.
	SSM
	STA	DP+2,1	S(J) = 1
	JMP*	TC00
CA90	OCT	1,2,11,10,13,14,12,15
CA91	OCT	2,1,13,14,11,10,12,15
*
*
*             *************
*             *ENTER TRIAD*
*             *************
*          STORE CURRENT TRIAD INTO THE NEXT TRIAD ENTRY
*               LOCATION.
ET00	DAC	**
	JST	SAV
	LDA	L
	SUB	K103	=3
	STA	L	L=L-3
	STA	ACCP	SET ACCUM PTR TO LAST TRIAD ENTRY
	STA	0	J=L
	LDA	P
	STA	DP+2,1	P(J) = P
	LDA	O1
	STA	DP+1,1	O1(J) = O1
	LDA	O2
	STA	DP,1	O2(J) = O2
	LDA	0
	STA	O1	O1=J
	JST	RST
	JMP*	ET00
ACCP	DAC	**	ACCUM POINTER
*
*
SFTB	BSS	36	SUBFUNCTION TABLE
*              **************************
*              *GENERATE SUBPRO ENTRANCE*
*              **************************
*           OUTPUT SUBPROGRAM ENTRANCE CODE , INCLUDING THE
*                CALL TO ARGUMENT ADDRESS TRANSFER.
T0GE	PZE	0
GE00	DAC	**
	CRA
	STA	T0GE
	LDA	K17	(  TEST
	JST	TS00
GE10	JST	NA00	INPUT NAME
	LDA	I	IFF I=0,
	SNZ
	JMP	GE20	GO TO GE20
	CAS	K141
	NOP
	JMP	GE30	MAKE ENTRY IN SFTB TABLE
	ADD	K103
	STA	I	IF FULL, GO TO GE30
	JST	STXA	SET XR TO A
	LDA	DP,1
	IAB
	JST	STXI	ESTABLISH I
	IAB
	STA	SFTB,1
	JST	STXA	SET XR TO A
	LDA	DP+1,1
	IAB
	JST	STXI	SET XR TO I
	IAB
	STA	SFTB+1,1
	LDA	A
	STA	SFTB+2,1
	JST	STXA	SET XR TO A
	CRA
	STA	DP+1,1	CLEAR OLD USACE
GE20	LDA	K105
	IAB
	LDA	RPL
	ADD	T0GE
	ADD	K103	(B) = DUM
	JST	AF00	DEFINE AFT (A=RPL+T0+3)
	IRS	T0GE	T0 = T0+1
	LDA	K134
	SUB	TC	IF TC = ,
	SNZ
	JMP	GE10	GO TO GE10
	JST	IP00	INPUT OPERATOR
	CRA
	STA	DF
	JST	OA00	OUTPUT ABS (0)
	LDA	T0GE
	STA	ID	ID = T0
	LDA	K69
	STA	NAMF+1	NAMF = AT
	JST	NF00	FILL IN REMAINING NAME
	JST	OL00	OUTPUT OBJECT LINK
	LDA	T0GE
	TCA
	STA	T0GE
	CRA
	JST	OA00	OUTPUT NUMBER OF ARGS
	IRS	T0GE	OUTPUT SPACE FOR ARG. ADDR.
	JMP	*-3
	JMP*	GE00	RETURN
GE30	JST	ER00	CONSTR, ERROR
	BCI	1,AE
K69	BCI	1,AT	AT
*
*             ****************
*             *EXCHANGE LINKS*
*             ****************
*          CL SUBA IS INTERCHANGED WITH CL SUBF
EL00	DAC	**
	JST	STXA
	LDA	DP,1
	STA	EL90	CL (F) == CL (A)
	LDA	F
	STA	0
	JST	EL40
	JST	STXA
	JST	EL40
	JMP*	EL00
EL40	DAC	**
	LDA	DP,1
	IMA	EL90
	ANA	K118
	IMA	DP,1
	ANA	K119
	ADD	DP,1
	STA	DP,1
	JMP*	EL40
EL90	PZE	0
*
*
*             *****************
*             *NON COMMON TEST*
*             *****************
NM00	DAC	**	NON-COMMON TEST
	LDA	AT
	SUB	K104
	SZE
	JMP*	NM00
	JST	ER00
	BCI	1,CR	ILLEGAL COMMON REFERENCE
*
*
*             **************************
*             *NON DUMMY OR SUBPRO TEST*
*             **************************
ND00	DAC	**
	LDA	AT	TEST
	SUB	K105
	SZE
	JMP	ND10
	JST	ER00
	BCI	1,DA	ILLEGAL USE OF A DUMMY ARGUMENT
	JMP*	ND00
ND10	JST	NS00
	JMP*	ND00
*
*
*             *****************
*             *INPUT SUBSCRIPT*
*             *****************
SCT0	PZE	0
SC00	DAC	**
	STA	SCT0	T0 = (A)
	CRA
	STA	NS
	STA	S2	NS = S2 = S3 = 0
	STA	S3
	LDA	K17	(-TEST
	JST	TS00
SC10	LDA	EBAR
	SMI
	JMP	SC15	EBAR .GR. 0
	JST	XN00	EXAMINE NEXT CHAR,
	SZE
	JMP	SC70	IF (A) NON ZERO,
SC15	JST	IG00	GO TO SC70
	LDA	SCT0	INPUT INTEGER
	SZE
	SPL
	JMP	SC60
	LDA	ID
	SUB	K101
	JMP	SC30
SC60	JST	AS00	ASSIGN ITEM
SC20	LDA	A	S (NS+1) = A
SC30	IAB
	LDA	SC90
	ADD	NS
	STA	SC91
	IAB		S(NS + 1) = A
	STA*	SC91
	LDA	NS
	AOA
	STA	NS	NS = NS + 1
	SUB	K103
	SZE
	JMP	SC50	MORE SUBSCRIPTS PERMITTED
SC40	JST	IP00	)-INPUT OPERATOR
	JMP*	SC00	RETURN
SC50	LDA	TC
	SUB	K134
	SZE
	JMP	SC40	TERMINATOR NOT A COMMA
	JMP	SC10	G0 TO SC10
SC70	JST	IR00	INPUT INT VARIABLE
	LDA	SCT0	CHECK FOR NON-DUMMY
	SNZ		VARIABLE DIMENSIONS
	JMP	SC20
	LDA	AT
	SUB	K105
	SNZ
	JMP	SC20
	JST	ER00
	BCI	1,VD	ILLEGAL SYMBOLIC SUBSCRIPT
SC90	DAC	S1
SC91	DAC	**
*
*
*             ********************
*             *INPUT LIST ELEMENT*
*             ********************
*          IF THE ITEM IS AN ARRAY, PROCESS THE SUBSCRIPT
IL00	DAC	**
	JST	NA00	INPUT NAME
	LDA	AT
	SUB	K105	NON-DUMMY TEST
	SZE
	JMP	*+3
	JST	ER00	USAGE ERROR
	BCI	1,DD	DUMMY ITEM IN AN EQUIV, OR DATA LIST
	LDA	IU	IF IU NOT ARR,
	SUB	K103
	SZE
	JMP	IL30	GO TO IL30
	LDA	K103
	JST	SC00	INPUT SUBSCRIPTS
	JST	FA00	FETCH ASSIGNS
	LDA	ND	IF ND = NS
	SUB	NS
	SZE		S1 = D* (S1 + D1* (S2+D2*S3)
	JMP	IL10	ELSE, GO TO IL10
	LDA	S3
	IAB
	LDA	D2
	JST	IM00
	ADD	S2
	IAB
	LDA	D1
	JST	IM00
	ADD	S1
	IAB
	LDA	D0
	JST	IM00
	STA	S1
	JMP*	IL00	RETURN
IL10	LDA	NS	IF NS NOT 1
	SUB	K101
	SZE
	JMP	IL20	GO TO IL20
	LDA	S1	ELSE,  20
	IAB		S1 * D0*S1
	LDA	D0
	JST	IM00
IL18	STA	S1
	JMP*	IL00	RETURN
IL20	JST	ER00
	BCI	1,ND	WRONG NUMBER OF DIMENSIONS IN ARRAY ELEMENT
	JMP*	IL00	RETURN
IL30	JST	TV00	TAG VARIABLE
	CRA		S1 = 0
	JMP	IL18	RETURN
*
*
*             ************
*             *FUNCTION *
*             *SUBROUTINE*
*             ************
*          IF LSTF IS ZERO, THE STATEMENT IS OUT OF ORDER
*               FUNCTIONS ARE CHECKED TO ENSURE ARGUMENTS
R1	LDA	K101
	STA	SFF	SFF = 1
R2	LDA	LSTF
	SZE		IF LSTF = 0
	JMP	R2A
	JST	ER00	ILLEGAL STATEMENT
	BCI	1,FS	NOT FIRST STATEMENT IN SUBPROGRAM
R2A	JST	NA00	INPUT NAME
	LDA	A
	STA	SBF	SBF = A
	CRA		ADDR=0, S/C CODE =0
	JST	ON00	OUTPUT NAME BLOCK TO THE LOADER
	LDA	MFL
	SZE
	JST	DM00	DEFINE IM
	LDA	TC
	SUB	CRET	IF IC NOT C/R
	SZE
	JMP	R2C	GO TO
	LDA	SFF	IF SFF = 0
	SNZ
	JMP	R2D	GO TO R2D
	JST	ER00	ERROR
	BCI	1,FA	FUNCTION HAS NO ARGUMENTS
R2C	CRA
	STA	I	I = 0
	JST	GE00	GENERATE SUBPROGRAM ENTRY
	JMP	A1	GO TO C/R TEST
R2D	CRA
	JST	OA00	OUTPUT ABS
	JMP	C6	GO TO CONTINUE
*
*
*             ******************
*             *INTEGER         *
*             *REAL            *
*             *DOUBLE PRECISION*
*             *COMPLEX         *
*             *LOGICAL         *
*             ******************
*          THE MODE FLAG (MFL) IS SET TO THE APPROPRIATE
*               VALUE AND ANY ARRAY INFO IS PROCESSED
A3	LDA	K101	INTEGER
	JMP	A7A	TMFL = INT
A4	LDA	K102	REAL
	JMP	A7A	TMFL = REAL
A5	LDA	K106	DOUBLE PRECISION
	JMP	A7A	TMFL = DBL
A6	LDA	K105	COMPLEX
	JMP	A7A	TMFL = CPX
A7	LDA	K103	LOGICAL
A7A	STA	MFL	TMFL = LOG
	LDA	LSTF	IF LSTF = 0, GO TO A7B (2)
	SNZ
	JMP	A7B	ELSE,
	LDA	CC	SAVE CC
	STA	A790
	CRA
	STA	ICSW
	JST	DN00	INPUT DNA
	LDA	A790	RESTORE CC
	STA	CC
	STA	ICSW	ICSW = IPL
	LDA	DFL	IF DFL NOT = 0, GO TO A7B
	SZE
	JMP	A7B
	LDA	TID	IF ID = FUNCTI,
	SUB	A7K	GO TO A9
	SNZ		SKIP IF NOT 'FUNCTION'
	JMP	A9	FUNCTION PROCESSOR
A7A5	JST	ER00	CONSTRUCTION ERROR
	BCI	1,TF	'TYPE' NOT FOLLOWED BY 'FUNCTION' OR LIST
A7K	BCI	1,FU	CONSTANT FOR 'FUNCTION' CHECK
A7B	JST	NA00	INPUT NAME
	LDA	MFL
	JST	DM00	DEFINE IM
	JMP	B7	GO TO INPUT DIMENSION
A790	PZE	0
*
*
*   -      B2   EXTERNAL
*          TAGS NAME AS SUBPROGRAM
B2	JST	NA00	EXTERNAL, INPUT NAME
	JST	TG00	TAG SUBPROGRAM
	JMP	B1	GO TO , OR C/R TEST
*
*
*             *****************
*             *DIMENSION     *
*             *INPUT DIMENSION*
*             *****************
*          PROCESS ARRAYS, PUT DIMENSION INFO IN SPECIAL
*               ARRAY POINTER ITEM
B3T0	PZE	0
B3T1	PZE	0
B3T2	PZE	0
B3T3	PZE	0
B3	JST	NA00
B3A	LDA	AT	IF AT = DUM
	SUB	K105	(A) = 0
	SZE		ELSE (A) = .LT. 0
	SSM
B3B	STA	B3T0	T0 = (A)
	LDA	AF
	STA	B3T3	T3 = AF
	LDA	A
	STA	B3T1	T1 = A
	LDA	AT	TEST FOR AT=DUMMY
	SUB	K105	=5
	SZE		SKIP NO-USAGE TEST IF DUMMY
	JST	NU00	NO USAGE TEST
	JST	STXA
	LDA	DP+1,1	IU (A) = ARR
	LRL	14
	LDA	K103
	LLL	14
	STA	DP+1,1
	LDA	B3T0	(A) = T0
	JST	SC00	INPUT SUBSCRIPT
	LDA	S1
	STA	ID
	LDA	S2	PLACE SUBSCRIPTS IN ID
	STA	ID+1
	LDA	S3
	STA	ID+2
	LDA	NS	(A) = 0, B = NS
	LRL	16
	JST	AA00	ASSIGN SPECIAL.
	JST	STXA
	LDA	DP+1,1
	LLR	2
	LDA	B3T3
	LGL	2
	LRR	2
	STA	DP+1,1	DEFINE GF T0 GF(A)
	LDA	A
	STA	B3T2	T2 = A
	LDA	B3T1
	STA	A	A = T1
	JST	STXA
	LDA	DP+1,1
	LLR	2
	LDA	B3T2
	LGL	2
	LRR	2
	STA	DP+1,1	DEFINE GF TO GF(A)
B3D	LDA	TC
	SUB	K104	IF TC NOT SLASH
	SZE
	JMP	B1	GO TO ,-C/R TEST
	LDA	A9T2	IF SIDSW = COMMON-4
	SUB	B4Z9
	SZE		GO T0 B4 (COMMON-0)
	JMP	B1	ELSE, GO TO ,-C/R TEST
	JMP	B40
B7	LDA	TC	IF TC = (
	SUB	K17
	SZE
	JMP	B3D
	JMP	B3A
*
*
*             ********
*             *COMMON*
*             ********
*          INPUT BLOCK NAMES AND LINK THEM WITH THE
*               FOLLOWING VAR/ARRAY NAMES, BLOCK NAMES
*               ARE LINKED TOGETHER THROUGH THEIR GENERAL FIELDS
B4	LDA	K81
	STA	ID
	STA	ID+1
	STA	ID+2
	LDA	B4Z9	SET SWITCH IN INPUT DIMENSION
	STA	A9T2
	JST	CH00	INPUT CHAR
	SUB	K9	IF NOT SLASH
	SZE		GO TO
	JMP	B4E
B40	JST	DN00	INPUT DNA
	LDA	K104	SLASH TEST
	JST	TS00
B4B	LRL	32
	LDA	K101	(A) = SUB, (B) = 0
	JST	AA00	ASSIGN SPECIAL
	LDA	CFL
	SNZ
	LDA	A
	STA	CFL
	LDA	A
	STA	F
	JST	FL00	FETCH LINK
	SZE
	JMP	B4D
	LDA	CFL
	STA	0
	LDA	DP+1,1	GF(CFL)
	IMA	A
	STA	0	INDEX = A
	IMA	A
	STA	DP+1,1	GF(A) = GF(CFL)
	LDA	CFL
	STA	0	INDEX = CFL
	LDA	A
	ADD	K122	='040000
	STA	DP+1,1	GF(CFL) = A
B4D	JST	NA00	INPUT NAME
	JST	ND00	NON DUMMY/SUBPROG TEST
	JST	NM00	NON-COMMON TEST
	JST	EL00	EXCHANGE LINKS
	LDA	DP,1
	ANA	B4F	='107777
	ADD	K122	AT(A) = COM  (='040000)
	STA	DP,1
	JMP	B7
B4E	JST	UC00	UNINPUT COLUMN
	JMP	B4B
B4Z9	DAC	B4D	GO TO INPUT DIMENSION
B4F	OCT	107777	EXTRACT MASK TO STRIP OFF AT FIELD
*
*
*             *************
*             *EQUIVALENCE*
*             *************
*          STORE EQUIV INFO IN THE DATA POOL FOR LATER
*               PROCESSING BY GROUP EQUIV (PART OF SPECS WRAPUP)
B5	LDA	E0	L = NEXT WORD IN EQUIVALENCE TABLE
	STA	I	I=L
	SUB	K101	(=1)
	STA	E0	L=L-1
	SUB	ABAR
	SMI
	JMP	*+3
	JST	ER00	DATA POOL FULL
	BCI	1,MO	MEMORY OVERFLOW
	JST	STXI	ESTABLISH I
	CRA
	STA	DP,1	DP (I) = 0
B5B	JST	CH00
	LDA	DP,1	INPUT CHAR
	SZE
	JMP	B5D
	LDA	TC	PUT IN FIRST CHARACTER
	LGL	8	PACK INTO DP (I)
B5C	STA	DP,1
	LDA	TC
	SUB	CRET
	SNZ
	JMP	C6	CHARACTER E C/R - EXIT
	LDA	DP,1
	ANA	K100
	SNZ
	JMP	B5B	WORD NOT FULL
	JMP	B5	OBTAIN NEW WORD
B5D	LDA	TC	PUT IN SECOND CHARACTER
	ERA	DP,1
	JMP	B5C
*
*
*             *********************
*             *RELATE COMMON ITEMS*
*             *********************
*          ALL ITEMS LINKED TO A COMMON BLOCK ARE PROCESSED
*               AND THEIR INVERSE OFFSETS CALCULATED. THESE
*               WILL BE INVERTED LATER TO GIVE TRUE
*               POSITION IN THE BLOCK.
C2T0	PZE	0
C2	LDA	CFL
	STA	A	A = F = CFL
C2A	CRA
	STA	C2T0	T0 = 0
	LDA	A
	STA	F	F = A
C2B	JST	FL00	FETCH LINK
	SNZ
	JMP	C2D
	LDA	D0
	ADD	C2T0	T0 = T0 + D0
	STA	C2T0
	JST	DA00	DEFINE ADDRESS FIELD
	JMP	C2B
C2D	JST	FL00	FETCH LINK
	SZE
	JMP	C2F
	LDA	AF
	STA	A	A = AF
	SUB	CFL
	SZE
	JMP	C2A	AF = CFL. NO
	JMP	C3	YES - GROUP EQUIVALENCE
C2F	LDA	C2T0
	SUB	AF	(A) = T0 - AF
	JST	DA00	DEFINE AF
	LDA	IU
	SZE
	JMP	C2D
	JST	TV00	TAG VARIABLE
	JMP	C2D
*
*
*              *******************
*              *GROUP EQUIVALENCE*
*              *******************
*		 THE EQUIV GROUPS ARE PROCESSED NOW. ANY COMMON
*                USAGE IS CHECKED TO SEE THAT THE ORIGIN
*                IS NOT MOVED AND THAT ONLY ONE ITEM IS
*                COMMON.
C3T0	PZE	0
C3T1	PZE	0
C3T2	PZE	0
C3T3	PZE	0
C3T4	PZE	0
C3T5	PZE	0
T0C3	EQU	C3T0
T1C3	EQU	C3T1
T2C3	EQU	C3T2
T3C3	EQU	C3T3
T4C3	EQU	C3T4
C3	LDA	E0
	STA	EBAR	EBAR=E(0) = END OF EQUIVALENCE TABLE
	LDA	L0
	STA	E	E=L(0) = START OF EUUIVALENCE TABLE
	LDA	CRET
	STA	TC
C3B	LDA	E
	STA	EP	E-PRIME = E
	CRA
	STA	F	I = 0
	LDA	K102	T4 = STR-ABS
	STA	C3T4
	JST	CH00	INPUT CHARACTER
	LDA	K17
	JST	TS00	(TEST
C3D	JST	IL00	INPUT LIST ELEMENT
	JST	SAF
	LDA	S1
	SUB	AF	TL = S1-AF
	STA	C3T1
	LDA	A	T2 = A
	STA	C3T2
C3F	LDA	F	IF I=0, GO TO C3P
	SNZ
	JMP	C3P
C3G	LDA	F	ELSE,
	SUB	A
	SNZ		IF A = I, GO TO C3N
	JMP	C3N
C3H	LDA	AT
	SUB	K104	ELSE,
	SNZ		IF AT = COM, GO TO C3O
	JMP	C3O
C3H2	LDA	T1C3
	ADD	AF
	STA	T0C3	T(0) = AF +T (1)
	LDA	T4C3
	SUB	K104	IF T(4) = 0, GO T0 C3K
	SZE
	JMP	C3K
	LDA	T3C3
	SUB	T0C3	ELSE,
	STA	T0C3	T(0) = T(3)-T(0)
	SMI
	JMP	C3K
	JST	ER00	IF T(0)<0,
	BCI	1,IC
C3K	LDA	C3T4	IMPOSSIBLE COMMON EQUIVALENCING
	IAB
	LDA	T0C3	AT (A) = COM
	ALS	2
	LGR	2
	JST	AF00
	JST	FL00	DEFINE AF
	JST	SAF	FETCH LINK
	LDA	A
	SUB	C3T2
	SZE		IF A .NE. T (2),
	JMP	C3G	GO TO C3G (5)
*
	JST	EL00	EXCHANGE CL(A) == CL(I)
C3M	LDA	TC	EXCHANGE LINKS (CL(A) WITH CL(F) )
	SUB	K134	IF TC = ,
	SNZ
	JMP	C3D	ELSE,
	JST	IP00	)-INPUT OPERATOR
	LDA	TC
	SUB	K134	IF TC = , OR C/R
	SNZ		GO TO C3B (1)
	JMP	C3B
	LDA	TC
	SUB	CRET
	SNZ
	JMP	C3B	ELSE,
	JST	ER00
	BCI	1,EC	EOUIVALENCE GROUP NOT FOLLOWED BY , OR CR
	JMP	C3B
C3N	LDA	T1C3	IF T1 = 0, GO TO C3M
	SNZ
	JMP	C3M
C3N5	JST	ER00	ERROR IMPOSSIBLE GROUP
	BCI	1,IE	IMPOSSIBLE EQUIVALENCE GROUPING
C3O	LDA	S1
	ADD	AF
	STA	T3C3
	LDA	K104	=4
	CAS	T4C3
	JMP	*+2
	JMP	C3N5
	STA	T4C3
	LDA	F
	CAS	A	IF A = F, GO TO C3M (B)
	JMP	*+2
	JMP	C3M	ELSE,
	STA	A	A = I
	IMA	C3T2
	STA	F
	CRA		T1 = 0
	STA	C3T1
	JST	FA00	FETCH ASSIGNS
	JST	SAF
	JMP	C3H2	GO TO C3H2
C3P	LDA	A
	STA	F
	JMP	C3H
*
*
*             ***********************
*             *ASSIGN SPECIFICATIONS*
*             ***********************
*          NON-COMMON NON-EQUIV ITEMS ARE PROCESSED AFTER
*               COMMON BLOCKS ARE OUTPUT (WITH SIZE).
C4T0	PZE	0
C4T1	PZE	0
C4B	STA	A	A = 0
C4C	LDA	A
	ADD	K105	I = A = A+5
	STA	A
	STA	F
	CAS	ABAR
	JMP	NP35	RETURN TO FIRST NON-SPEC CHECK (POINT 1)
	NOP
	JST	FA00	ELSE, FETCH ASSIGN
	LDA	AT
	SUB	K102	IF AT = STR-ABS
	SZE		IU=VAR, OR ARR, AND
	JMP	C4C	NT = 0
	LDA	IU	GO TO C4E
	SUB	K102	ELSE, GO TO C4C
	SPL
	JMP	C4C
	LDA	NT
	SZE
	JMP	C4C
C4E	CRA
	STA	C4T0	T0 = 0. T1 =-MAX
	SUB	K111
	STA	C4T1
	JST	KT00	SET D(0) = NO. OF WORDS PER ITEM
C4F	JST	SAF
	CAS	C4T0
	STA	C4T0
	NOP
	LDA	D0
	SUB	AF	(A) = D(0) - AF
	CAS	C4T1
	STA	C4T1
	NOP
	JST	FL00	FETCH LINK ( (A)=A - F  )
	SZE
	JMP	C4F	GO TO C4F
	LDA	RPL
	ADD	C4T0	RPL * RPL + T0 + TL
	STA	C4T0
	ADD	C4T1	TO = RPL-T1
	STA	RPL
C4I	JST	SAF
	LDA	K101
	IAB		(B) = REL
	LDA	C4T0	(A) = TO-AF
	SUB	AF
	JST	AF00	DEFIME AFT
	JST	FL00	FETCH LINK
	SZE		IF (A) NOT ZERO,
	JMP	C4I	NOT END OF EQUIVALENCE GROUP
	JMP	C4C	CHECK NEXT ITEM IN ASSIGNMENI TABLE
*
C4L2	LDA	FLT1	= LINK LOCATION TO COMMON BLOCK NAME
	STA	C4T1
C4L3	LDA	A
	STA	I	SAVE A FOR LATER MODIFICATION
	JST	FL00	FETCH LINK
	SNZ
	JMP	C4M	END OF COMMON GROUP
	JST	STXI	SET INDEX TO POINT TO CURRENT ITEM IN
*                                       COMMON GROUP.
	LDA	DP,1	SET CL FIELD TO POINT AT COMMON BLOCK
*                                      NAME.
	ANA	K119	( = '177000)
	ADD	C4T1	(= LINK LOCATION OF COMMON BLOCK NAME)
	STA	DP,1
	JMP	C4L3	PROCESS NEXT ITEM IN COMMON BLOCK
*
C4	LDA	CFL	LOC, OF FIRST (BLANK) COMMON BLOCK
	STA	F
C4L6	STA	A
	CRA
	STA	C4T0
C4L	JST	FL00	FETCH LINK
	SNZ
	JMP	C4L2	NO MORE ITEMS IN COMMON BLOCK
	LDA	D0	ELSE, IF TO .LT. DO+AF,
	ADD	AF
	CAS	C4T0	T0 = D0 + AF
	STA	C4T0
	NOP
	JMP	C4L	GO TO C4L
C4M	LDA	AF
	STA	F	I=AF
	LDA	C4T0	(A) = T0
	JST	DA00	DEFINE AF
* OUTPUT COMMON BLOCK NAME AND SIZE TO LOADER
	LDA	AF	LENGTH OF COMMON BLOCK
	ANA	K111	='37777
	ADD	K122	='40000  (S/C CODE = 1)
	JST	ON00	OUTPUT NAME BLOCK TO LOADER
	LDA	F
	SUB	CFL	IF I = CFL
	SNZ
	JMP	C4B
	LDA	F
	JMP	C4L6
*
SAF	DAC	**
	LDA	AF
	LGL	2
	ARS	2
	STA	AF
	JMP*	SAF
*
*             **************************
*             *DATA STATEMENT PROCESSOR*
*             **************************
*          PROCESS VARIABLE LIST .THEN OUTPUT LITERAL ITEMS
*               TO APPROPRIATE LOCATIONS. MODES MUST AGREE
T0W4	PZE	0
T1W4	PZE	0
G	PZE	0	LOWEST INDEX POINT IN LIST
W4	LDA	L0
	STA	I	I=END OF DATA POOL
W4B	JST	IL00	INPUT LIST ELEMENT
	LDA	AT	D (0) = =WDS/ITEM
	SUB	K102
	SNZ		IF AT = 'STR-ABS'
	JMP	W4T	GO TO
	LDA	I
	STA	0
	LDA	S1	S1 * DEFLECTION IF AN ARRAY
	ADD	AF
	STA	DP,1	DP(E) = AF + S1
W4C	LDA	A
	STA	DP-1,1	DP (E-1) = A
	LDA	I
	SUB	K102
	STA	I
	STA	G
	LDA	TC	IF TC = ,
	SUB	K134
	SNZ
	JMP	W4B	GO TO W4B
	LDA	K104
	JST	TS00	TEST FOR SLASH TERMINATOR
	LDA	RPL
	STA	T1W4
	LDA	L0
	STA	I	I= END OF DATA POOL
W4E	CRA
	STA	KPRM	K' = KBAR = 0
	STA	KBAR
W4F	JST	DN00	INPUT, DNA
	LDA	NT
	SZE		IF NT = 0
	JMP	W4G	VARIABLE OR ARRAY
	LDA	TC	LAST CHARACTER
	CAS	K17	='250  ( =(  )
	JMP	*+2
	JMP	*+3	START OF COMPLEX CONSTANT
	JST	ER00	ERROR
	BCI	1,CN	NON-CON DATA
	STA	SXF	SET SXF TO NON-ZERO
	JMP	W4F	FINISH INPUT OF COMPLEX CONSTANT
W4G	LDA	KBAR	MULTIPLY COUNT
	SZE
	JMP	W4K	GO TO W4K
	LDA	TC	IF TC NOT *
	SUB	K103
	SZE
	JMP	W4L
	LDA	ID
	SUB	K101
	STA	KBAR	KBAR = ID-1
	JST	IT00	INTEGER TEST
	JMP	W4F
W4K	LDA	KPRM	IF K NOT ZERO
	SZE
	JMP	W4M	GO TO W4M
W4L	LDA	KBAR
	ALS	1	K ' = E-3* KBAR
	TCA
	ADD	I
	STA	KPRM
W4M	JST	STXI	SET INDEX = I
	LDA	DP-1,1
	STA	A	A = DP (E-1)
	LDA	IM
	STA	T0W4	TO = IM
	JST	FA00
	LDA	BDF	IF BDF NOT ZERO
	SZE
	JMP	W4S	GO TO W4S
	JST	NM00	NON-COMMON TEST
W4O	JST	STXI	SET INDEX = I
	LDA	DP,1
	STA	RPL	RPL = AF
	JST	FS00	FLUSH
	CRA
	STA	DF	DF = 0
	LDA	HOLF	IS IT HOLLERITH DATA
	SZE		NO
	JMP	WHOW	YES, GO TO OUTPUT IT
	LDA	D0
	STA	0
	JMP	*,1	SWITCH ON NUMBER OF WORDS TO OUTPUT
	JMP	W405
	JMP	W403
	JMP	W404
	LDA	TID+2
	JST	OA00
	LDA	TID+1
	JST	OA00
	LDA	TIDB+2
	JST	OA00
	LDA	TIDB+1
	JMP	W406
* 
*			TAPE 4 OF 5 - END
	MOR