FOTS TAPE 5
/CALCULATE SUBSCRIPTS

/SETUP IS:  A,     JMS CALSB
/                  LAC I OR LAW OR LAC B2-BN
/                  ARG (I)ADDRESS  (THIS IS ACTUAL ADDRESS OF ARRAY)

/           B,     CAL A
/                  ARG I1
/                  ARG I2-N
/                          (TERMINATED BY DISAPPEARANCE OF ARG

/IS ARE REGISTERS HOLDING ARGUMENTS
/B'S CONTAIN ARGUMENTS

CALSB,	0
	LAC (CALTB
	DAC TEMP1
BCA0,	LAC I TWENTY
	ISZ TWNTY
	DAC I TEMP1
	AND (740000
	SAD (ARX
	SKP
	JMP CALS1
	ISZ TEMP1
	JMP BCA0
CALTB,	XX
	XX
	XX
	XX
TEMP1,	XX		/PRESENT LIMIT IS 4 SUBSCRIPTS
CALS1,	DZM SUBTEM		/ACCUMULATE SUM HERE
	LAC (LAC CALTB
	DAC GETI

GETI,	XX		/GET I - LAC CALSUB 3 N
	AND (740000	/ARG?
	SAD (ARX
	SKP
	JMP DONCAL
	XCT GETI
	AND (37777
	XOR (LAC
	DAC TEMZER
	XCT TEMZER
	ADD (-1
IADD,	ADD SUBTEM	/ADD I TO SUM
	DAC S#UBTEM
GETB,	LAC I CALSB
	AND (17777
	SAD (1
	JMP HERE
	SAD (2
	JMP HERE
	SAD (3
	JMP HERE
	JMS I END+50
	LAC SUBTEM
STORESB,	DAC SUBTEM
	ISZ CALSB
	ISZ GETI
	JMP GETI

DONCAL,	LAC I CALSB
	XOR OLDMOD
DON2,	ADD SUBTEM
	RETUR 2

HERE,	CMA
	ADD (JMP COMPUT+3
	DAC HEREND
	CLA
HEREND,	XX		/JMP COMPUTE +N

COMPUTE,	ADD SUBTEM
	ADD SUBTEM
	ADD SUBTEM
	JMP STORESB

/CAL HANDLER TYPE IV

CALH,

	DAC A#C
	LAC 20
	ADD (-1
	DAC ADR		/PUT ADDRESS OF CAL IN ADR
	LAC 20
	DAC T#WENTY
	JMP HUNT
CALHA,	LAC F		/MODE?
	SZA
	JMP FLOT
	LAC AC		/SAVE FIXED AC
	PUSH
	LAC MODE
	DAC OLDMOD
	DZM MODE
	PUSH
	LAC 20		/20 HAS BEEN INDEXED BY GETARG TO PROPER 
	AND (17777	/RETURN
	PUSH		/SAVE ADDRESS; MODE IN SIGN BIT
CALH1,	LAC I ADR	/GET NAME F SUBROUTINE CALED
	ADD (JMP
	DAC ADR		/SETUP JMP TO SUBROUTINE
	DZM F		/SET MODE TO FIXED
	CLL
ADR,	XX		/GO
FLOT,	LAC ACX
	PUSH
	LAC ACL		/SAVE FLOATING AC
	PUSH
	LAC ACR
	PUSH
	LAC ACS
	PUSH
	LAC MODE
	DAC OLDMOD
	DZM MODE
	PUSH
	LAC 20		/SAVE ADDRESS; MODE IN SIGN BIT
	AND (17777
	XOR (400000
	PUSH
	JMP CALH1

/CALL SEQUENCE	JMS GTARG
/	JMP AAA
/	A, . . .
/AAA,
GTARG,	0
	LAC GTARG
	AND (17777
	DAC GTARG
	LAC I GTARG
	DAC ENDD
	AND (17777
	DAC END1		/ARGUMENT LIST ADDRESS
GGT3,	ISZ GTARG
	SAD GTARG
ENDD,	XX
	JMS GNA
GGT0,	LAC TEMP0
	AND (740000
	SAD (ARF
	JMP ARFGGT	/PICK UP ARGUMENT ADDR. UNLESS ARF
	SAD (ARX
	JMP GGT4
	SAD (400000
	JMP GGT4
	SZA
	CLA!SKP
GGT4,	LAC TEMP0
GGT2,	DAC I GTARG
	ISZ TWENTY
	LAC E#ND1
	JMP GGT3

GNA,	0
	LAC I TWENTY
	DAC TEMP0
	AND (I
	SNA
	JMP I GNA
	LAC TEMP0
	AND (17777
	DAC TEMP0
	LAC I TEMP0
	DAC TEMP0
	JMP I GNA
TEMP0,	0

ARFGGT,	LAC TEMP0
	AND (17777
	XOR OLDMOD
	JMP GGT2


PUSH=JMS .	0		/PUSH DOWN
	ISZ H#OLD
	ISZ PUSHCT
	SKP
TOOCAL,	HLT		/TOO MANY CALS
	DAC I HOLD
	JMP I PUSH-JMS

POPUP=JMS .	0	/GET 1 FROM STACK
	LAM -1
	ADD PUS#HCTK	DAC PUSHCT
	SAD (-101
EXITS,	HLT		/TOO MANY EXITS
	LAC I HOLD
	DAC TEMP#
	LAM -1
	ADD HOLD
	DAC HOLD
	LAC TEMP
	JMP I POPUP-JMS

CALST=JMS .
PUSHET,	0		/INITIALIZE PUSH DOWN LIST
	LAC (STORE-1
	DAC HOLD
	LAM -100
	DAC PUSHCT
	LAC (JMP CALH
	DAC 21
	DZM M#ODE
	DZM TECH#R
	DZM RO#N
	707702
	DZM DECHR
	DZM IBM.
	DZM ISVL.
	DZM FIOCAS
	DZM FTACAS
	DZM FIGLET
	LAC (1
	DAC NBLOCK
	DZM CSUNIT
	DZM LPLC
	DZM CBFE
	JMP PUSHCH
RETUR=JMP .
	AND (17777
	XOR MODE
	DAC TEMAD
RETWR=JMP .
	POPUP		/GET ADDRESS; MODE IN SIGN BIT
	DAC EFMTEM
	AND (400000
	DZM F
	SZA
	JMP FRET		/RESTORE FLOATING MODE
	POPUP
	DAC MODE
	POPUP
	JMP I EFMTEM



HUNT,	LAC I 20
	AND (740000
	SAD (ARX
	JMP .+4
	SAD (ARF
	SKP
	JMP CALHA
	ISZ 20
	JMP HUNT

FRET,	ISZ F
	POPUP
	DAC MODE
	POPUP
	DAC ACS
	POPUP
	DAC ACR		/RESTORE FLOATING AC
	POPUP
	DAC ACL
	POPUP
	DAC ACX
	JMP EFMTEM 1

TEMAD,	0
SET2W=JMS .	0
	LAC (400000
	DAC MODE
	EXIT SET2W

/NEW GOTO
GOTO,	0
	LAC I GOTO
	DAC GOTEM
	XCT I GOTEM
	SPA
	JMP GOTO1
	SNA
	JMP GOTO1		/0 CASE
	ADD GOTO
	DAC GOTO
	AND (17777
	CMA
	ADD GOTEM
	SMA
	JMP I GOTO
GOTO1,	ISZ GOTEM
	JMP I GOTEM
GOTEM,	0
INDIV,	0
	JMS I END+45
	XCT I INDIV
	ISZ INDIV
	JMP I INDIV

INMUL,	0
	JMS I END+50
	XCT I INMUL
	ISZ INMUL
	JMP I INMUL
START