FOTS 12000
END=12000
START

	FORTRAN OBJECT TIME SYSTEM WITH MODULAR I/O - PART 1
/'END' IS SET AS A PARAMETER (CF OTS TAPE 0)
/'END' IS USED TO LABEL AN EXECUTE TABLE OF OTS REFERENCES
/FOR I/O SUBROUTINES.  IT ALSO SERVES TO DEFINE THE TOP OF 'COMMON' STORAGE
END/	DAC BUFILL+1	/SET ENTRY TO ONE ITEM INPUT
	DAC XI2		/END+1, SET ENTRY TO 'X' FORMAT PROCESSOR
	DAC EMP1		/END+2, SET ENTRY TO ONE-CHARACTER OUTPUT
	DAC EMP2		/END+3, SET END-OF-RECORD ENTRY
IO,	0		/END+4, I/O DIRECTION INDICATOR
	JMP GEN4		/END+5, USED BY 57A SET-UP ROUTINE
RON,	0		/END+6, READER ON-OFF INDICATOR
NBLOCK,	0		/END 7,NEXT BLOCK ON DECTAPE
	0		/END 10,MP5,HI ORDER PRODUCT
	0		/END 11,#COUNT# FOR EQUALIZATION OF EXPONENTS
	0		/END+12,DVD,REMAINDER
TWENTY,	0		/END+13,POINTER TO I/O LIST
	IOERR		/END+14, ERROR ENTRY FOR SUBROUTINES
OLDMOD,	0		/END+15, FLOATING POINT DATA MODE
	BUFSET		/END+16, BUFFER CLEAR ENTRY FOR SUBROUTINES
TECHR,	0		/END+17, BUFFER FULL-EMPTY INDICATOR, 57A
	INBUF+100	/END+20, DEFINES 57A INPUT BUFFER
	RL6		/END+21, ROTATE ROUTINE FOR SUBROUTINES
FUBNI,	INBUF-1		/END+22, BUFFER INDEX START ADDRESS
	JMP EMP2		/END 23  EXIT USED BY 57A WRITE
AUTTEM,	0		/END+24, AUTO INDEX ADDRESS POINTER
	FARAD		/END+25, SET FOR NORMAL OR BINARY I/O
	XARAD		/END+26,  (AS ABOVE)
	DONE		/END+27,  (AS ABOVE)
	FIOCON		/END+30, FIODEC TO ANELEX CONVERSION
	STASH		/END+31, STORE CHARACTER IN BUFFER
	JMS R9R		/END+32, ROTATE ROUTINE FOR CODE CONVERSION
FIOCAS,	0		/END+33, FIODEC CASE IN
FLDCOD,	0		/END+34, FIELD TYPE
FIGLET,	0		/END+35, TYPE 28 CASE SHIFT
	ANATEL		/END+36, ANELEX TO BAUDOT
	TELANA		/END+37, BAUDOT TO ANELEX
FTACAS,	0		/END+40, FIODEC CASE OUT
RATF,	XX		/END+41, 'A' FORMAT ACCESS TO ATF
FLDLNG,	XX		/END+42, FIELD LENGTH COUNTER
	0		/END+43,NOR,NORMALIZE
	0		/END+44,MPY,UNSIGNED MULTIPLY
	0		/END+45,DIV,UNSIGNED DIVIDE
	0		/END+46,IDIV,INTEGER DIVIDE
	0		/END+47,CEECH,EXPONENT EQUALIZER
	0		/END+50,MUL,INTEGER MULTIPLY
ISVL.,	0		/END+51,SENSE LEVEL,57A
IBM.,	0		/END+52,BCD TYPE,57A
CSUNIT,	0		/END+53,CURRENTLY SELECTED DECTAPE
DECHR,	0		/END+54, DECTAPE BUFFER FULL,EMPTY
	RR6		/END+55, ROTATE ROUTINE ENTRY
LPLC,	0		/END+56, LINE PRINTER LINE COUNT
CBFE,	0		/END+57, CARD BUFFER FULL, EMPTY
	0		/END+60, TO SET UP FORMAT CHECK (SARITH)
	0		/END+61, TO CHECK FOR FORMATING (SARITH)
	ANAFIO		/END+62, ANELEX TO FIODEC CONVERSION
ARX=IOT
ARF=640000
FDV=ISZ
FMP=XCT
FSB=TAD
FCS=XOR
FOR=CAL
RPA=JMP
CAS=SAD
FORIND=13
ARGIND=14
AUTOI=15
AUTO=16
AUTOI2=17
BN=400
TWNTY=TWENTY
EXIT=JMP I-JMS

/I/O PROCESSOR
READ,	CLL		/CLEAR LINK FOR INPUT
	LAC (NOP
	DAC EMP2		/IGNORE SLASH PUNCTUATION ON INPUT
	SKP
WRITE,	STL		/SET LINK FOR OUTPUT
	CLA!RAL		/LINK TO AC17
	DAC IO		/SET I/O DIRECTION INDICATOR
	LAC (FARAD
	DAC END+25	/DEFINE = I END+25
	LAC (XARAD
	DAC END+26	/DEFINE = I END+26
	LAC (DONE
	DAC END+27	/DEFINE = I END+27
	XCT I TWENTY	/EXECUTE CONTENTS OF NEXT
			/ADDRESS IN CALL SEQUENCE
			/COMPILER GENERATES "JMS .IOX"
			/IN RESPONSE TO THE DEVICE NUMBER.
	ISZ TWENTY	/DEVICE NUMBER PROCESSED BY I/O ROUTINES
	LAC I TWENTY
	DAC DN#UMB	/SAVE DEVICE NUMBER FOR TEXT OUTPUT
	LAC OLDMOD
	DAC F#ARMOD
	DZM IT#ER		/CLEAR FORMAT ITERATION INDICATOR
	DZM ARG#UE	/CLEAR ARRAY ELEMENT INDICATOR
	ISZ TWENTY	/STEP CALL SEQUENCE POINTER
	LAC TWENTY
	DAC ARGIND		/SET ARGUMENT LIST INDEX
	LAC I TWENTY
	SAD (ENDIO
	JMP ENDIO
	ADD (-1
	DAC FORIND		/SET FORMAT TABLE INDEX
	DAC PTEM		/SAVE FOR REPETITION
GEN4,	JMS BUFSET	/CLEAR BUFFER
GEN1,	LAC I FORIND
	SNA
	JMP .-2		/IGNORE BLANK WORD
	DAC AC#CTEM	/CURRENT FORMAT WORD
	AND (JMP
	SAD (JMP
	JMP CHECK	/END OF FORMAT TABLE ENCOUNTERED
	SPA
	JMP SLASH	/END OF RECORD REQUEST
	SAD (LAC
	JMP LEFPAR	/SET OR RESET NEW LEFT PAREND

GEN21,	LAC ACCTEM	/SET COUNT FOR H,X,A FORMAT
	AND (177
	CMA
	ADD (1
	DAC RCNT		/SET 2'S COMPLEMENT
GEN2,	LAC ACCTEM
	AND (DZM I
	DAC FLDCOD
	SAD (JMS I
	JMP HOI		/HOLLERITH
	SAD (JMS
	JMP XOI		/'X' FORMAT
	JMS ARGCHK	/CHECK FOR EXECUTABLE ENTRY
GEN3,	LAC IO
	SNA
	JMP GENRED	/READ I,F,E,A
	JMS PCKARG	/PICK UP ARGUMENT ADDRESS
	JMS WRSET	/SET FIELD WIDTH AND REPETITION COUNT
	SAD (I
	JMP OUTPTI	/'I' FORMAT
	SAD (DZM
	JMP AOUT		/'A' FORMAT
	SAD (DAC
	JMP OUTPTF	/'F' FORMAT
OUTPTE,	ISZ TE#MFE	/'E' OUTPUT PROCESSOR, SO INDICATE
	JMS FECOMO	/F,E COMMON SUBROUTINE
	ADD (-4
	TAD W
	SMA!SZA
	CMA!SKP
	CLC		/NONE
	DAC BL#ANKS	/LEADING BLANKS IN FIELD
	CLC
	DAC LE#ADDG	/NO ITEGRAL DIGITS
	DAC FR#AZER	/NO LEADING ZEROS
	JMP OUTLOO	/GO TO PROCESS FRACTION
EXPPUT,	LAC EXSGN
	JMS GETSGN	/GET SIGN OF EXPONENT, SPACE,-
	STASH		/STORE IN BUFFER
	LAC DEXP
	TAD (-143
	SPA
	JMP EXP1
	LAC (27		/EXPONENT TOO LARGE FOR OUTPUT
	STASH		/SUBSTITUTE 'XX'
	STASH
	JMP EXP2

EXP1,	CLA
	JMS I END+46	/IDIV-DOUBLE PRECISION INTEGER DIVIDE
	LAC DEXP
	LAC (12		/DIVISOR OF TEN
	SNA
	LAC (20
	STASH		/FIODEC CODE FOR DIGIT IS DIGIT
	LAC END+12	/UNITS
	SNA
	LAC (20
	STASH

EXP2,	LAC (13
	STASH		/SET END OF ITEM
	JMP XTFE

OUTPTF,	DZM TEMFE	/'F' OUTPUT PROCESSOR, SO INDICATE
	JMS FECOMO
	ADD (-1
	TAD W
	DAC BLANKS	/INTEGRAL DIGITS ALLOWED BY W
	LAC EXSGN
	RCR
	LAC DEXP
	SNL!SZA
	JMP TECHK	/EXPONENT IS POSITIVE, NON-ZERO
	CLC
	DAC LEADDG	/NO LEADING DIGITS
	LAC BLANKS
	CMA
	DAC BLANKS	/SET FOR COUNT
	LAC DEXP
	SNA!CMA
	JMP TECHK2	/EXPONENT IS ZERO
	DAC FRAZER	/COUNT OF LEADING ZEROS POSSIBLE
	LAC D
	TAD DEXP
	SMA
	JMP OUTPTE	/NUMBER TOO SMALL, USE 'E' FORMAT
	JMP TECHK3
TECHK,	CMA
	ADD (1
	TAD BLANKS
	SPA
	JMP OUTPTE	/NUMBER TOO BIG, USE 'E' FORMAT
	SNA!CMA
	CLC
	DAC BLANKS	/LEADING BLANKS
	LAC DEXP
	CMA
	DAC LEADDG	/INTEGRAL DIGITS
TECHK2,	CLC
	DAC FRAZER	/NO LEADING ZEROS
	LAC D

TECHK3,	DAC FRADIG	/FRACTIONAL DIGITS
	JMP OUTLOO
	CLA
	STASH		/LEADING BLANKS
OUTLOO,	ISZ BLANKS
	JMP .-3
	LAC ACS
	JMS GETSGN
	STASH		/SIGN= SPACE OR MINUS
	JMP .+3
	JMS PUTDIG
	STASH		/INTEGRAL DIGITS
	ISZ LEADDG
	JMP .-3
	LAC (73
	STASH		/DECIMAL POINT
	JMP .+3
	LAC (20
	STASH		/LEADING ZEROS
	ISZ FRAZER
	JMP .-3
	JMP .+3
	JMS PUTDIG
	STASH		/FRACTIONAL DIGITS
	ISZ FRADIG
	JMP .-3
	LAC TEMFE
	SZA
	JMP EXPPUT	/'E' FORMAT
	LAC (13
	STASH
	JMP XTFE		/'F' FORMAT

OUTPTI,	LAC W		/'I' FORMAT OUTPUT
	TAD (-6
	SMA
	JMP WLIM		/LIMIT FIELD TO SEVEN
	LAC (7		/CONTAINS 2#S COMPLIMENT OF W
	TAD WCNT
	CMA
	ADD (1
WCOM,	DAC TEMZER	/COUNT FOR HI-ORDER DIGITS
	SPA
	JMP IGNORE	/HI DIGITS OUTSIDE SPECIFIED FIELD
	LAC (DONIG1

DONIG6,	DAC D#ECALL	/PRINT EXIT
	LAC PRNTEM	/CONTAINS INTEGER VALUE
	SAD (-0
	JMP . 3
	SZA
	JMP DECPNT	/SINGLE DIGIT OUTPUT ROUTINE
	CLA
	STASH		/SUPPRESS LEADING ZEROS
	ISZ WCNT
	JMP .-2
	LAC AUTO
	ADD (-1
	DAC AUTO
	LAC (20
	STASH		/SINGLE ZERO OUTPUT
	JMP DONIG
IGNORE,	LAC (IG2
	JMP DONIG6
IG2,	0
	SZA
	JMP JIG2
	ISZ TEMZER	/SUPPRESS HI ORDER DIGITS
	JMP I IG2
	LAC (DONIG1
	DAC DECALL	/ALLOW OUTPUT
	JMP I IG2
JIG2,	LAC (27
	JMS DONIG1
	JMP .-2
WLIM,	LAC (-6
	DAC WCNT		/SET FIELD WIDTH TO SEVEN
	CLA
	JMP WCOM

DONIG1,	0
	STASH		/DIGIT TO OUTPUT BUFFER
	ISZ WCNT
	JMP I DONIG1	/RETURN FOR NEXT
DONIG,	LAC (13
	STASH		/END OF ITEM INDICATOR
	JMP XTIA

AOUT,	LAC PRNTEM	/'A' FORMAT OUTPUT
	ISZ WCNT
	SKP
	JMP AOUT1	/ONE CHARACTER
	ISZ WCNT
	JMP AOUTC	/THREE CHARACTERS
AOUT2,	RL6		/TWO CHARACTERS
	ADD(13
AOUTC,	DAC AIMG
	LAC (SKP
	DAC TOCX
	LAC (AIMG
	TOC		/TEXT OUTPUT
	JMP XTIA
AOUT1,	RL6
	ADD (13
	JMP AOUT2
AIMG,	0
	130000		/INDICATE END OF TEXT

GENRED,	LAC ACCTEM	/I,F,E,A INPUT
	AND (DZM I
	SAD (DZM
	JMP AIN		/'A' FORMAT
	JMS WRSET	/SET FIELD WIDTH ETC.
	JMS BUFILL	/NEXT ITEM TO INPUT BUFFER
	LAC ACCTEM
	AND (DZM I
	SAD (I		/AC HAS FORMAT TYPE
	JMP INPUTI	/'I' FORMAT
	LAC AUTO		/F,E INPUT PROCESSOR
	DAC AUTTEM	/SAVE BUFFER ADDRESS POINTER
	DZM TE#MONE	/CLEAR POINTER TO DECIMAL POINT
PSCAN1,	LAC I AUTO	/SCAN INPUT ITEM FOR POINT
	SAD (73
	JMP PSCAN2	/FOUND ONE, DON'T SET POINTER
	SAD (13
	JMP PSCAN3
	SAD (65
	JMP PSCAN3
	SPA
	JMP PSCAN3	/END OF RECORD
	ISZ WCNT		/INDEX FIELD WIDTH COUNTER
	JMP PSCAN1
	SKP!CLA		/COUNTER ZERO
PSCAN3,	CLC
	TAD AUTO
	ADD D
	DAC TEMONE	/SET POINTER (CALCULATED)
PSCAN2,	LAC AUTTEM
	DAC AUTO		/RESTORE ADDRESS POINTER
	JMS WCT		/RESTORE FIELD COUNT
	JMS DFSET	/INITIALIZE CONVERSION ROUTINE
	DZM E#YRIE	/CLEAR LETTER 'E' INDICATOR
	DZM ZE#RO		/CLEAR LEADING ZEROS
	ISZ DFFLSW
PSCAN4,	LAC AUTO
	SAD TEMONE
	JMP TIE1
	LAC I AUTO
	SNA
	JMP PSCAN4
	SKP

BEGFA,	LAC I AUTO
	ISZ ZERO		/COUNT AFTER LEADING ZEROS
	SAD (65
	ISZ EYRIE	/LETTER E
	SAD (74		/PLUS
	JMP ECHK
	SAD (54		/MINUS
	JMP ECHK
	SNA
	JMP ECHK		/SPACE
BEF,	JMS DFETCH
	JMP TIE1
	JMS PCKARG	/DFETCH COMES HERE WHEN THROUGH
	EFM
	DAC I TEMPD	/STORE BINARY EQUIVALENT
	LFM
	JMP XTFE

TIE1,	LAC TEMONE
	SAD AUTO
	SKP
	JMP BEGFA	/CONTINUE
	DZM TEMONE
	LAC (73		/FORCE DECIMAL POINT
	JMP BEF

ECHK,	DAC TEMZER	/CHECK FOR SIGN
	LAC ZERO
	SAD (1
	JMP ECHK2	/FIRST NON-ZERO CHARACTER IS SIGN
	LAC EYRIE
	SZA
	JMP ECHK2	/E CHARACTER PRECEDED
	LAC (65		/NOT FIRST CHARACTER, FORCE E
	JMS DFETCH
ECHK2,	LAC TEMZER	/SET SIGN, FRACTION OR EXPONENT
	JMP BEF

INPUTI,	LAC I ARGIND	/'I' INPUT PROCESSOR
	AND (37777
	XOR (DAC
	DAC IDAC	/SET STORE INSTRUCTION
	JMS DFSET	/INITIALIZE CONVERSION ROUTINE
SCAN1,	LAC I AUTO
	JMS DFETCH	/DECIMAL TO BINARY
	JMP SCAN1
	SNL		/DFETCH COMES HERE WHEN THROUGH
	JMP .+4		/NOT A FIXED QUANTITY
	LAC DFCHAR	/BINARY EQUIVALENT
IDAC,	XX
	JMP XTIA
	JMS TFXA		/FIX A FLOATING QUANTITY
	LAC ACR
	JMP IDAC

AIN,	JMS WRSET	/'A' INPUT PROCESSOR
	LAC I ARGIND
	AND (37777
	XOR (DAC
	DAC ADAC		/SET TO STORE INPUT WORD
	JMP GETAIN
ADAC,	XX		/PRESET STORE
	JMP XTIA
GETAIN,	CLA!SKP		/CLEAR CHARACTER ACCUMULATOR
	RL6		/CONTINUING ENTRY
	DAC G#AIN

ANE,	XCT END+41
	AND (77)
ANE2,	XOR GAIN
	ISZ WCNT		/INDEX CHARACTER COUNT
	JMP GETAIN+1	/CONTINUE
	JMP ADAC		/EXIT


/COMMON EXIT ROUTINE FOR I,F,E,A FORMATS

XTFE,	LAC (JMP I FARAD	/F,E ENTRY
	SKP
XTIA,	LAC (JMP I XARAD	/I,A ENTRY
	DAC ZELF
	LAC IO
	RAR
	LAC END+5	/JMP GEN4 FOR INPUT
	SZL
	ADD (1		/JMP GEN1 FOR OUTPUT
	DAC YELF
	ISZ R#CNT		/INDEX REPETITION COUNT
	JMP RNZ		/NOT ZERO
	DZM ITER		/CLEAR REPETITION INDICATOR
	DZM ACCTEM	/CLEAR CURRENT FORMAT WORD
	LAC ARGUE	/ARRAY VARIABLE INDICATOR
	SNA
	XCT YELF		/NOT ARRAY VARIABLE
	LAC (YELF
	DAC ARGIND	/RETURN TO MAIN PROGRAM LATER
	XCT YELF		/GO TO GET NEXT FORMAT WORD

RNZ,	ISZ ITER		/INDICATE REPETITION
	LAC IO
	SNA
	JMS BUFSET	/CLEAR BUFFER BOTTOM
	LAC ARGUE	/ARRAY VARIABLE INDICATOR
	SZA
	XCT ZELF		/RETURN TO MAIN PROGRAM
	JMS ARGCHK	/CHECK FOR NEXT EXECUTABLE
	JMP GEN3	/CONTINUE
YELF,	0
ZELF,	0

STASH=JMS .	0	/PUT CHARACTER IN THE BUFFER
	DAC T#EMZER
	LAC AUTO
	SAD (INBUF+BN-1
	EXIT STASH	/IF BUFFER FULL, IGNORE
	LAC TEMZER
	DAC I AUTO
	EXIT STASH

BUFSET,	0		/CLEAR THE BUFFER BOTTOM
	LAC FUBNI
	DAC AUTO
	DZM I AUTO
	LAC AUTO
	SAD (INBUF+77
	SKP
	JMP .-4
	LAC FUBNI
	DAC AUTO
	JMP I BUFSET
START

FOTS TAPE 1 PART 2
/UNEXPECTED IO ERRORS COME HERE
IOERR,	0
	LAM -7
	DAC EC#O		/PREPARE TO PRINT 8 TIMES
	LAW 330		/LETTER X TYPE 33
	703301
	LAW 27		/LETTER X OR FIGURE SLASH TYPE 28
	TLS
	TSF
	JMP .-1
	ISZ ECO		/REPEAT COUNT
	JMP .-4
	LAC IOERR
	HLT		/HALT WITH ERROR ADDRESS IN AC
	JMP .-1

CHECK,	LAC I ARGIND	/END OF FORMAT TABLE ENCOUNTERED
	SAD (ENDIO
	JMP ENDIO	/ARGUMENT LIST EXHAUSTED ALSO
	LAC P#TEM
	DAC FORIND	/RETURN TO LAST LEFT PAREND
	LAC ARGIND
	ADD (-1
	DAC ARGIND	/RESET ARGUMENT LIST INDEX
	JMS ARGSLS
	JMP GEN1		/CONTINUE FORMAT PROCESSING

SLASH,	LAC IO		/END OF RECORD REQUEST
	SNA
	XCT EMP2		/SLASH RESPONSE ON READ
	SZA
	JMS DUMP
	JMS ARGSLS		/LOOK FOR EXECUTABLE ARGUMENTS
	LAC ACCTEM
	AND (377777
	SNA
	JMP GEN1		/SLASH PUNCTUATION ALONE
	JMP GEN21	/CONTINUE

LEFPAR,	LAC FORIND
	ADD (-1
	DAC PTEM		/FORMAT TABLE POINTER FOR LEFT PAREND
	LAC ACCTEM
	SAD (LAC
	JMP GEN1		/LEFT PAREND ONLY
	JMP GEN21	/CONTINUE

BUFILL,	0
	XX
	LAC FUBNI
	DAC AUTO
	JMP I BUFILL

ARGCHK,	0		/LOOK FOR EXECUTABLE ARGUMENTS
	JMS ARGSLS
	SAD (ENDIO
	JMP GEN1		/CHECK FOR ARGUMENT INDEPENDENT FORMAT
	JMP I ARGCHK

ARGSLS,	0
	LAC ARGIND
	ADD (1
	DAC TEMZER
	LAC I TEMZER	/NEXT ARGUMENT
	SAD (ENDIO
	JMP I ARGSLS	/EXIT IF EXHAUSTED
	AND (NOP
	SAD (ARF
	JMP I ARGSLS
	SAD (ARX
	JMP I ARGSLS
	JMP I TEMZER	/IF NOT ARGUMENT, SHOULD EXECUTE

DUMP,	0		/WRITE OUT THE BUFFER
	LAC AUTO
	SAD FUBNI
	JMP DUMPA
DUMPB,	CLC
	DAC I AUTO	/SET END OF RECORD
	LAC AUTO
	DAC AUTTEM	/SAVE END ENTRY POINTER
	LAC FUBNI
	DAC AUTO		/INITIALIZE BUFFER INDEX
EMP1,	XX		/SET BY I/O SUBROUTINES
EMP2,	XX
	JMS BUFSET	/CLEAR BUFFER BOTTOM
	JMP I DUMP
DUMPA,	LAC ACCTEM
	SAD (JMP
	JMP I DUMP
	JMP DUMPB

ENDIO,	ISZ ARGIND	/EXIT FROM I/O PROCESSOR
	LAC ARGIND
	AND (17777
	DAC TEMZER
	POPUP
	AND (400000
	XOR TEMZER
	PUSH		/SET NEW CAL EXIT
	LAC IO
	SZA
	JMS DUMP		/EMPTY BUFFER, IF OUTPUT
	RETWR		/EXIT TO CAL HANDLER

FECOMO,	0
	EFM
	LAC I TEMPD
	LFM
	JMS FOP
	LAC D
	DAC FR#ADIG
	JMP I FECOMO

GETSGN,	0
	SZA
	LAC (54
	JMP I GETSGN

PCKARG,	0
	LAC I ARGIND
	DAC TE#MPD
	AND (I
	SNA
	JMP PCK2
	LAC TEMPD
	AND (17777
	DAC TEMPD
	LAC I TEMPD
PCK3,	DAC TEMPD
	LAC I TEMPD
	DAC PR#NTEM
	JMP I PCKARG
PCK2,	LAC TEMPD
	AND (77777
	XOR OLDMOD
	JMP PCK3

WRSET,	0		/BREAK OUT R,W,D
	LAC ITER		/REPETITION INDICATOR
	SZA
	JMP WRS2		/RESET FIELD WIDTH COUNTER ONLY
	LAC ACCTEM
	AND (37
	DAC #W		/FIELD WIDTH
	JMS WCT
	LAC ACCTEM
	JMS R9R
	AND (17
	SNA
	LAC (1
	CMA
	ADD (1
	DAC RCNT		/REPETITION COUNT
	LAC ACCTEM
	RR6
	RAL
	AND (17
	CMA
	DAC #D		/FRACTIONAL FIELD, COMPLEMENTED

WRS3,	LAC ACCTEM
	AND (DZM I	/RESTORE FORMAT TYPE TO AC
	JMP I WRSET
WRS2,	JMS WCT
	JMP WRS3
WCT,	0
	LAC W
	CMA
	ADD (1
	DAC W#CNT		/SET FIELD WIDTH COUNTER
	DAC FLDLNG
	JMP I WCT

HOI,	LAC IO		/HOLLERITH PROCESSOR I/O SWITCH
	SZA
	JMP OUTPTH	/IO NON-ZERO INPLIES WRITE
	LAC RCNT
	DAC FLDLNG
	JMS BUFILL	/NEXT ITEM TO BUFFER
	DZM FIOCAS	/INITIAL LOWER CASE
	LAC AUTO		/TRANSLATE ANELEX TO FIODEC
	DAC AUTOI2	/AUTO POINTS OT BUFFER BEGINNING
BUFFIO,	LAC I AUTO
	SAD (13
	JMP FDTAB	/FOUND TAB
	SPA
	JMP FDCR		/FOUND END OF RECORD
	ANAFIO		/ANELEX TO FIODEC
FIO2,	DAC I AUTOI2
	JMP BUFFIO
FDTAB,	LAC (36
	JMP FIO2	/FIODEC TAB CODE, CONTINUE
FDCR,	LAC FUBNI
	DAC AUTO		/RESTORE BUFFER INDEX
	DZM I AUTOI2		/ZERO FOR RECORD END
INPUTH,HOL1,	DZM H#OLER	/'H' INPUT
	LAM -2
	DAC C#NT
	LAC HOLER
HOL2,	RL6		/PREPARE TO PACK NEXT CHARACTER
	DAC HOLER
	LAC I AUTO
	SPA!CLL
	CML		/UPPER CASE (SET BY ANAFIO)
	AND (77
	DAC TEMZER
	CLA!RAL
	XOR FIOCAS
	SZA
	JMP CASET	/FIODEC CASE CHANGE
	LAC TEMZER
	ADD HOLER
	ISZ RCNT		/CHARACTER COUNT
	SKP

	JMP HOLFIN	/FINISHED
HOL3,	ISZ CNT		/CHARACTER PER WORD COUNT
	JMP HOL2		/CONTINUE PACKING
	DAC I FORIND	/WORD TO FORMAT LIST
	JMP HOL1
HOLFIN,	ISZ CNT
	SKP
	JMP FIN
	RL6
	ADD (13		/HOLLERITH FILLER CODE (FIODEC)
	JMP HOLFIN
FIN,	DAC I FORIND
	AND (77
	SAD (13
	SKP
	ISZ FORIND
	JMP GEN4

CASET,	LAC AUTO
	ADD (-1
	DAC AUTO		/RESTORE PICK-UP ADDRESS
	LAC FIOCAS	/SET NEW FIODEC CASE
	RAR
	DZM FIOCAS
	SNL
	ISZ FIOCAS
	LAC (72
	SNL
	LAC (74		/LINK SENSE OPPOSITE OF NEW CASE
	ADD HOLER
	JMP HOL3

OUTPTH,	LAC (NOP
	DAC TOCX
	LAC FORIND
	ADD (1
	TOC		/OUTPUT TEXT ROUTINE
	LAC TO#CTEM
	DAC FORIND
	JMP GEN1

XOI,	LAC IO		/'X' FORMAT PROCESSOR
	SZA
	JMP OUTPTX	/NON-ZERO IMPLIES WRITE
XI2,	XX		/'X' INPUT PRESET
	ISZ RCNT		/TWO#S COMPLEMENT COLUMN COUNT
	JMP XI2
	JMP GEN4

OUTPTX,	CLA
	STASH		/BLANK TO OUTPUT BUFFER
	ISZ RCNT
	JMP OUTPTX
	JMP GEN1

/RESET ROUTINE WHEN FINISHED WITH CURRENT ARRAY
DONE,	0
	DZM ARGUE	/ARRAY VARIABLE INDICATOR CLEAR
	LAC DONE
	ADD (-1
	DAC ARGIND	/RESET I/O LIST INDEX
	LAC ITER		/REPETITION COUNT
	SZA
	JMP GEN3-1	/DO NOT PICK UP NEW FORMAT WORD
	LAC I DONE
	AND (17777
	SAD (ENDIO
	JMP XDON
	LAC IO
	RAR
	LAC ACCTEM
	SAD (JMP
	SKP
	AND (377777
	SNA
	JMP YDON
	SZL
	JMP GEN1+3
	JMS BUFSET
	LAC ACCTEM
	AND (377777
	JMP GEN1+3


/INTERMEDIATE PROCESSOR FOR ARRAY VARIABLE I/O
XARAD,	0
	LAC (ARX I TEMAD	/ELEMENT ACCESS ADDRESS
	JMP XARFAR
FARAD,	0
	LAC TEMAD	/CONTAINS ELEMENT ACCESS ADDRESS
	AND (77777
	XOR FARMOD	/INCLUDE DATA MODE
	DAC TEMAD
	LAC (ARF I TEMAD
XARFAR,	DAC XELF
	LAC (XELF-1
	DAC ARGIND	/SET PSEUDO IN I/O LIST INDEX
	ISZ ARGUE
	LAC ACCTEM
	AND (177777
	SNA
	JMP GEN1
	LAC ITER
	SZA
	JMP GEN2		/ALREADY IN PROCESS
	JMP GEN21	/SET UP FOR POSSIBLE H,X
XELF,	0

XDON,	ISZ ARGIND
	JMP ENDIO

YDON,	SNL
	JMP GEN4
	JMP GEN1
START

FORTRAN OTS TAPE 2
/DECIMAL FLOATING TO BINARY
/JMS DFSET	/SETUP ENTRY
/JMS DFETCH	/CHARACTER ENTRY(CONCISE
	/TERM. CHAR. IF LINK=0 THEN ACL,R,X HOLD NUMBER
		/IF LINK=1, THEN DFCHAR HOLDS SIGNED NUMBER


ACS,	0
ACX,	0
ACL,	0
ACR,	0
YS,	0
YX,	0
YL,	0
YR,	0

DFEXSW,	0	/EXPONENT ENTRY
DFFLSW,	0	/FLOATING SWITCH
DFDPSW,	0	/DECIMAL PT. SWITCH
DFDPCT,	0	/COUNT OF DIGITS
DFOVSW,	0	/OVERFLOW SWITCH
DFSGSW,	0	/SIGN SWITCH
DFCHAR,	0	/CHARACTER STORAGE
	0
DFSUM,	0	/DOUBLE PRECISION SUM
	0
	
DFSET,	0	/CLEAR TEMPORARY-READY ENTRY
	DZM DFCHAR
	DZM DFEXSW
	DZM DFFLSW
	DZM DFDPCT
	DZM DFSGSW
	DZM DFSUM
	DZM DFDPSW
	DZM DFOVSW
	DZM DFCHAR+1
	DZM DFSUM+1
	JMP I DFSET
ANELEX
	
DFETCH,	0	/CHARACTER ENTRIES
	CMA
	SNA!CMA
	JMP DFTERM	/CLC=C.R
	SAD (CHAR R0	/MODIFY 0
		JMP CLRAC
	SAD (CHAR R+	/IGNOR SIGN
	JMP I DFETCH
	SAD (CHAR R 	/SPACE IGNORED
	JMP I DFETCH
	SAD (CHAR R-	/-SIGN
	JMP DFSIGN
	SAD (CHAR RE	/EXPONENT
	JMP DFEX
	SAD (CHAR R.	/DECIMAL PT.
	JMP DFPOIN
	SAD (13
	JMP DFTERM
TAKENO,	DAC DFCHAR+1
	ADD (-12


	SPA
	JMP .+3
	JMS DFSET	/ILLEGAL CHARACTER-RESET TYPE X
	JMP I DFETCH
/BEGIN UPDATE SUM
	LAC DFOVSW	/IF OVERFLOW DONOT ADD IN
	SZA
	JMP DFINDX
/10*SUM+DFCHAR=SUM
	LAC DFSUM
	DAC DBAC
	LAC DFSUM+1
	DAC DBAC+1
	JMS DFSHL1
	JMS DFSHL1
	JMS DBADD
	DFSUM
	JMS DFSHL1
	JMS DBADD
	DFCHAR
	LAC DFOVSW
	SZA
	JMP .+5
	LAC DBAC
	DAC DFSUM
	LAC DBAC+1
	DAC DFSUM+1
	LAC DFDPSW
	SZA
	ISZ DFDPCT
	JMP I DFETCH
	
/END NUMBER INPUT
DFINDX,	LAC DFDPSW	/INDEX DECIMAL PT. IF OVERFLOW
	SNA
	ISZ DFDPCT
	JMP I DFETCH
	
/EXPONENT
DFEX,	ISZ DFEXSW
	JMS DFMOVE
	DZM DFSGSW
	DZM DFOVSW
	JMP DFPOIN+1
	
/DECIMAL POINT
DFPOIN,	ISZ DFDPSW	/SET POINT SWITCH AND FLOAT SWITCH
	ISZ DFFLSW
	JMP I DFETCH
	
DFSIGN,	ISZ DFSGSW	/SIGN SWITCH
	JMP I DFETCH
	
DFMOVE,	0	/MOVE SUM TO AC, CLEAR SUM, HOLD SIGN
	LAC DFSUM
	DAC ACL
	LAC DFSUM+1
	DAC ACR
	DZM DFSUM
	DZM DFSUM+1
	LAC DFSGSW
	DAC FSIGN
	LAC DFDPCT
	DAC PONDIG#
	JMP I DFMOVE
	
DFTERM,	ISZ DFETCH
	LAC DFSGSW	/SIGNED DFSUM GOES TO DFCHAR
	RAR
	LAC DFSUM+1
	SZL
	CMA
	DAC DFCHAR
	LAC DFFLSW	/TEST FOR FLOATING NUMBER
	SZA!STL
	JMP .+2
	JMP I DFETCH
	LAC DFEXSW	/FIX EXPONENT
	SZA
	JMP DFL
	JMS DFMOVE	/NO EXPONENT PART
	DZM DFCHAR
DFL,	LAC (43
	DAC ACX	/FLOAT
	LAC ACL
	SZA
	JMP .+13
	LAC ACR
	SMA
	JMP .+10
	RCL
	DAC ACR
	CLA!RAL
	DAC ACL
	LAC ACX
	ADD (-1
	DAC ACX
	JMS I END+43
	LAC FSIGN	/FIX SIGN OF FLOAT PART
	DAC ACS
	LAC PONDIG
	CMA
	ADD DFCHAR
	SPA!CLL	/EXPONENT-OR +
	CMA!STL
	DAC DFSUM
	LAC (FMP FLTEND	/MULTIPLY
	SPL
	LAC (FDV FLTEND	/DIVIDE
	DAC DFTER4
DFTER1,	LAC DFSUM
	SNA
	JMP DFTER3	/DONE
	ADD (-12
	SPA
	JMP DFTER2	/AT LEAST 10 TO 10
	DAC DFSUM
	EFM
DFTER4,	0	/MULT OR DIVIDE BY 10 TO 10
	LFM
	JMP DFTER1
	
DFTER2,	CMA
	DAC DFSUM+1
	CLL!RAL
	ADD DFSUM+1	/3*DFSUM+1
	CMA
	DAC DFTER5
	LAC DFTER4
	AND (740000
	ADD DFTER5
	ADD (FLTEND
	DAC DFTER5
	EFM
DFTER5,	0
	LFM
DFTER3,	CLL
	JMP I DFETCH	/EXIT

DBAC,	0	/AC
	0
DBOR,	0	/OPERAND
	0
	
/ADD
DBADD,	0
	LAC I DBADD	/FETCH OPERAND
	DAC DBOR+1
	LAC I DBOR+1
	DAC DBOR
	ISZ DBOR+1
	LAC I DBOR+1
	CLL
	TAD DBAC+1
	DAC DBAC+1
	CLA!RAL
	TAD DBOR
	TAD DBAC
	DAC DBAC
	SPA
	ISZ DFOVSW
	ISZ DBADD
	JMP I DBADD

/SHIFT LEFT
DFSHL1,	0	/LEFT 1
	LAC DBAC+1
	RCL
	
	DAC DBAC+1
	LAC DBAC
	RAL
	DAC DBAC
	SPA
	ISZ DFOVSW
	JMP I DFSHL1

FLTENS,	4	/10 TO 1
	240000
	0
	7	/10 TO 2
	310000
	0
	12	/10 TO 3
	372000
	0
	16	/10 TO 4
	234200
	0
	21	/10 TO 5
	303240
	0
	24	/10 TO 6
	364110
	0
	30	/10 TO 7
	230455
	0
	33	/10 TO 8
	276570
	200000
	36	/10 TO 9
	356326
	240000
FLTEND,	42
	225005
	744000	/10 TO 10
CLRAC,	CLA
	JMP TAKENO


FOP,FDOUT,	0
	DZM DEXP
	DZM A
	DZM EXSGN
	LAC ACL
	SZA
	JMP .+3
	SAD ACR
	JMP FD2
	JMS FDCONV
	JMS UNFLOT
	0
	GLK
	DAC LINK
FDDIT,	CLL
	LAC (1
	TAD ACR
	DAC ACR
	GLK
	TAD ACL
	SAD (400000
	JMP FIXONE

FD1,	DAC ACL
	LAC LINK
	RCR
	LAC ACR
	RAL
	DAC YR
	DAC ACR
	LAC ACL
	RAL
	DAC ACL
	DAC YL
	JMS PUTDIG
	SAD (20
	JMP ADJUST
	LAC YR
	DAC ACR
	LAC YL
	DAC ACL
FD2,	JMP I FOP

ADJUST,	LAC EXSGN
	SZA!CLC
	LAC (1
	TAD DEXP
	DAC DEXP
	JMP FD2

FDCONV,	0
	LAC ACX
	SPA
	JMS FDESGN
	DAC #B
	LAC EXSGN
	CLL!RAR
	LAC (FDV FLTEND	/DIVIDE
	SPL
	LAC (FMP FLTEND	/MULTIPLY
	DAC FDCOV4

FDCOV1,	LAM -42
	ADD B
	SPA
	JMP FDCOV2
	DAC B	/AT LEAST 10 TO 10
	EFM
FDCOV4,	XX		/FMP OR FDV FLTEND
	LFM
	LAC (12
	ADD DEXP
	DAC DEXP
	JMP FDCOV1
FDCOV2,	LAC ACX
	SZA!SMA
	JMP . 4
	ADD (3
	SMA
	JMP AA.
	LAC FDCOV4
	ADD (FLTENS-FLTEND
	DAC FDCOV5
	EFM
FDCOV5,	XX		/FMP OR FDV FLTENS
	LFM
	ISZ A
	JMP FDCOV2

AA.,	LAC DEXP
	ADD A
	DAC DEXP
	LAC ACX
	TAD (3
	SZA!SMA
	JMP I FDCONV
	LAC ONEOVTEN
	TAD ACL
	SMA
	JMP I FDCONV
	EFM
	FMP FLTENS
	LFM
	LAC EXSGN
	RCR
	LAC DEXP
	SML
	JMP .+3
	ADD (1
	SML!CLL
	TAD (777777
	DAC DEXP
	JMP I FDCONV

FIXONE,	ISZ DEXP
	LAC (146315
	DAC ACR
	LAC (31463
	JMP FD1

FDESGN,	0
	ISZ EXSGN
	CMA
	JMP I FDESGN




PUTDIG,	0
	LAC ACL
	JMS I END+44
	LAC (12
	DAC ACL
	LAC END+10
	DAC DIGIT
	LAC ACR
	JMS I END+44
	LAC (12
	DAC ACR
	LAC END+10
	TAD ACL
	DAC ACL
	CLA!RAL
	TAD DIGIT
	DAC DIGIT
	SAD (11
	JMP PUTULT
	LAC OLDMOD
	SMA
	JMP PUTULT
	LAC ACL
	SAD (777777
	JMP PUTPEN
PUTULT,	LAC DIGIT
	SNA
	LAC (20
	JMP I PUTDIG
PUTPEN,	LAC ACR
	SMA
	JMP PUTULT
	DZM ACL
	DZM ACR
	LAC DIGIT
	ADD (1
	JMP I PUTDIG
DIGIT,	0


DEXP,	0
A,	0
ONEOVTEN,	-314630		/0.1
NOSIGT=-10
DECIMAL
DCPTAB,	100000
	10000
	1000
	100
	10
	1
OCTAL

/FLOAT AND FIX

TFLO,	0		/FLOAT A FIXED NUMBER
	LAC DFCHAR	/PUT DFCHAR IN ACR
	SPA
	CMA
	DAC ACR
	LAC (43		/START WITH 43 FOR EXPONENT
	DAC ACX
	DZM ACL
	JMS I END+43	/NORMALIZE
	DZM ACS
	LAC DFCHAR
	SPA
	ISZ ACS
	JMP I TFLO

TFXA,	0
	LAC ACS
	DAC FSIGN
	DZM LI#NK
TFXA1,	LAC ACX
	SAD (43		/IS EXPONENT 43 YET?
	JMP DONET		/YES, DONE
	ADD (-43
	SMA
	JMP UNPOS	/YES, SHIFT LEFT
	JMS ROTR
	LAC LINK
	RAL
	DAC LINK
	ISZ ACX
	NOP
	JMP TFXA1

DONET,	LAC FSIGN
	RCR
	LAC ACR
	SZL
	CMA
	JMP I TFXA

UNPOS,	JMS ROTL
	JMP UNPOSA
UNPOSR,	DAC ACX
	SAD (43		/43 YET?
	JMP DONET	/YES, DONE
	JMP UNPOS

ROTR,	0
	LAC ACL
	RCR
	DAC ACL
	LAC ACR
	RAR
	DAC ACR
	JMP I ROTR

ROTL,	0
	LAC ACR
	RCL
	DAC ACR
	LAC ACL
	RAL
	DAC ACL
	JMP I ROTL

FLO=JMS .	0
	DAC DFCHAR
	JMS TFLO
	LAC FLO-JMS
	DAC EFMTEM
	JMP EFMTEM+1

FXA=JMS .	0
	LFM
	JMS TFXA
	JMP I FXA-JMS

/DECIMAL INTEGER PRINT  INTEGER IN AC ON ENTRANCE

DECPNT,	CLL!SMA
	CMA!CML
	DAC COM
	LAC (CLA
	SNL
	LAC (LAC MINU
	DAC LINKA
	LAC (ADD DCPTAB
	DAC DCPLOP 2
	LAC (SZA
	DAC DCPMOD
DCPGDC,	DZM CO#M1
	LAC C#OM
	JMP .+3

DCPLOP,	DAC COM
	ISZ COM1
	XX	/ADD DCPTAB
	SPA
	JMP DCPLOP
	ISZ DCPLOP 2
	LAC COM1
DCPMOD,	XX	/SZA
	JMP DCMRA
	JMS I DECALL
	JMP DCPGDC
LINKA,	XX	/CLA IF POSITIVE INTEGER; LAC MINU IF NEG.
DCPR,	LAC COM1
	SNA
	LAC (20	/ZERO
	JMS I DECALL
	LAC (JMP DCPR
	JMP DCPGDC-1
MINU,	54

	NOP	/TO PREVENT
	NOP	/SYMBOL-ABSOLUTE
	NOP	/ADDRESS RELATIONSHIP
	NOP	/CHANGES
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
DCMRA,	XCT LINKA
	JMS I DECALL
	JMP DCPR
START
FOTS TAPE 3
/FLOATING INTERPRETER

EFM=JMS .
EFMTEM,	0	/EFM IS PC
	LAC I EFMTEM
	SAD (EFM
	JMP BACK
	SAD (LFM
	JMP LEAVE
	RCL
	RTL
	RTL
	AND (17
	ADD (XCT FLOTAB
	DAC EFME#ND
	ISZ F#
	DZM IDRE#CT
	LAC I EFMTEM
	AND (37777
	DAC T
	AND (I	/INTERPRET INDIRECT
	SNA
EFMEND,	XX
	LAC T
	AND (17777
	DAC T
	LAC I T
	DAC T
	ISZ IDRECT
	JMP EFMEND

BACK,	ISZ EFMTEM
	JMP EFMTEM+1

FLOTAB,	JMP I EFMTEM
	JMP FDAC	/FDAC,04
	JMP FJMS	/JMS,10
	HLT	/14
	JMP FLAC	/CLA,20
	JMP FLAM	/CLS,24
	JMP FADD	/FTAD,30
	JMP FSUB	/FSUB,34
	JMP FMPY	/FMPY,40
	JMP FDIV	/FDIV,44
	HLT
	JMP FCAS	/CAS, 54
	JMP FJMP	/JMP, 60
	HLT	/64
	HLT	/70
	HLT	/74

FJMS,	LAC T	/GET ADDRESS
	AND (17777
	DAC B
	ADD (DAC	/CHANGE PC
		DAC DACPC
	LAC EFMTEM
	ADD (1
	AND (17777
	SZL
	XOR (400000
DACPC,	XX
	LAC B
	DAC EFMTEM


	JMP BACK

FJMP,	LAC T
	AND (17777
	DAC EFMTEM	/CHANGE PC
	JMP EFMTEM+1	/DON'T INDEX PC


LEAVE,	ISZ EFMTEM
	DZM F
	JMP I EFMTEM

LFM=JMS .	0
	JMP I .-1

FLAM,	JMS JLAC
	LAC ACS
	XOR (1
	DAC ACS
	JMP BACK



/CAS
FCAS,	JMP . 20
	LAC ACS
	XOR YS
	SNA
	JMP FCASDF
FCAS1,	LAC ACS
	SZA
	JMP CASEND 2
	JMP CASEND
FCASDF,	LAC EFMTEM
	DAC FCASTM
	EFM
	FSB YX
	LFM
	LAC FCASTM
	DAC EFMTEM
	LAC ACL
	SZA
	JMP FCAS1
	SKP
CASEND,	ISZ EFMTEM
	ISZ EFMTEM
	JMP BACK
FCASTM,	0

START

FORTRAN OTS TAPE 3 INTERPRETIVE ARITHMETIC

/FLOATING POINT ADD AND SUBTRACT
FSUB,	JMS FPKUP
	LAC YS
	XOR (1
	DAC YS
	SKP
FADD,	JMS FPKUP
	JMS FMAG
	JMS CEE
	LAC FSI#GN
	SZA!CLL
	JMS FADCOM
	LAC ACR
	TAD YR
	DAC ACR
	GLK
	TAD ACL
	TAD YL
	DAC ACL
	LAC FSIGN
	SZA
	JMP FADREC
	JMS OVFL
FADA,	JMS I END+43
	LAC YS
	DAC ACS
MAGF,	LAC ACL
	ADD ACR
	SZA
	JMP BACK
	DZM ACX
	DZM ACS
	JMP BACK

FADCOM,	0
	LAC ACR
	CMA!CLL
	TAD (1
	DAC ACR
	LAC ACL
	CMA
	SZL
	TAD (1
	DAC ACL
	CLL
	JMP I FADCOM

OVFL,	0
	LAC ACL
	SMA
	JMP I OVFL
	RCR
	DAC ACL
	LAC ACR
	RAR
	DAC ACR
	ISZ ACX
	OPR
	JMP I OVFL

FADREC,	LAC ACL
	SMA
	JMP FADA
	JMS FADCOM
	LAC YS
	XOR (1
	DAC YS
	JMP FADA

/DOUBLE PRECISION FLOATING POINT DIVISION

FDIV,	JMS FPKUP	/PICKUP ARGUMENT
	JMS FMAG		/TAKE ABSOLUTE VALUES AND SAVE SIGN
	LAC #YR	/SHIFT DIVISOR LEFT
	RCL	/SO AS TO AVOID OVERFLOW
	DAC YR
	LAC YL
	RAL
	DAC YL
	LAC ACL	/PERFORM FIRST DIVIDE:
	JMS I END+46
	LAC ACR	/  -------------
	LAC YL	/       YL
	DAC ACL	/HIGH ORDER QUOTIENT, Q1
	JMS I END+44	/MULTIPLY Q1 * YR
	LAC YR
	DAC ACR	/LOW ORDER PRODUCT TO ACR
	LAC END+10	/TAKE HIGH ORDER PRODUCT
	CMA	/AND SUBTRACT FROM
	TAD END+12	/REMAINDER OF FIRST DIVISION
	CMA
	SZA!CMA
	JMP .+3
	DZM ACR
	JMP FDIV5
	JMS FDIV2
FDIV2,	0		/SAVE LINK, INDICATES FINAL SIGN
	SNL
	JMP FDIV1	/LINK PLUS INDICATES CORECTION FACTOR -
	TAD (1
	DAC T#
	LAC ACR	/ADJUST LEFT HALF FOR OVERFLOW
	CMA
	DAC ACR
	LAC T
	ISZ ACR
	TAD (-0

FDIV3,	JMS I END+46
	LAC ACR	/  R - Q1 * YR (LEFT) - Q1 * YR (RIGHT) * K
	LAC YL	/  ----------------------------------------
	DAC ACR	/                  YL
	LAC FDIV2
	SMA
	JMP FDIV4

FDIV5,	LAC YX
	CMA	/EXPONENT IS DIFFERENCE OF ACX AND YX
	TAD (1
	TAD ACX
	DAC ACX
	JMS OVFL
	JMS I END+43	/IF ZERO CLEAR EXPONENT
	LAC FSIGN
	DAC ACS
	JMP MAGF

FDIV1,	CMA
	SMA
	JMP FDIV3
	DAC T
	CMA
	TAD YL
	CMA
	SPA
	JMP FDIV6
	DAC T
	CLC
	TAD ACL
	DAC ACL
FDIV6,	LAC T
	SZA
	JMP FDIV3
	JMP FDIV2-3

FDIV4,	LAC ACR
	CMA!CLL
	TAD (1
	DAC ACR
	GLK
	ADD ACL
	ADD (-1
	DAC ACL
	JMP FDIV5

FMPY,	JMS FPKUP
	JMS FMAG
	LAC ACR
	JMS I END+44
	LAC YL
	DAC T
	LAC END+10
	DAC T1#
	LAC ACL
	JMS I END+44
	LAC YR
	CLL
	TAD T
	GLK
	TAD END+10
	TAD T1
	DAC T
	GLK
	DAC T1
	LAC ACL
	JMS I END+44
	LAC YL
	CLL
	TAD T
	DAC ACR
	GLK
	TAD T1
	TAD END+10
	DAC ACL
	LAC YX
	TAD ACX
	TAD (1
	DAC ACX
	JMS I END+43
	LAC FSIGN
	DAC ACS
	JMP MAGF



/COMPARE AND EQUALIZE EXPONENTS

CEE,	0
	LAC ACL
	ADD ACR
	SNA
	JMP CEESWA
	LAC YL
	ADD YR
	SNA
	JMP I CEE
	LAC YX
	CMA
	TAD ACX
	TAD (1
	DAC END+11
	SNA
	JMP I CEE
	SPA!CMA
	JMP CEESW
	TAD (1
	DAC END+11
	LAC ACX
	DAC YX
	JMS I END+47
	JMP I CEE

CEESWA,	DZM END+11

CEESW,	LAC YX
	DAC ACX
	LAC ACL
	DAC TEMZER
	LAC YL
	DAC ACL
	LAC TEMZER
	DAC YL
	LAC ACR
	DAC TEMZER
	LAC YR
	DAC ACR
	LAC TEMZER
	DAC YR
	LAC AC#S
	RAR
	LAC Y#S
	DAC ACS
	CLA!RAL
	DAC YS
	JMS I END+47
	JMP I CEE

FLAC,	JMS JLAC
	JMP BACK

JLAC,	0
	JMS JLAC0
	SZA
	JMP JLAC2
	LAC I T
	DAC ACX
	ISZ T
	LAC I T
	DZM ACS
	SPA
	ISZ ACS
	AND (377777
	DAC ACL
	ISZ T
	LAC I T
	DAC ACR
	JMP I JLAC
JLAC2,	LAM -10
	DAC JLACTM
	LAC I T
	AND (777000
JLAC3,	CLL!SPA
	STL
	RAR
	ISZ JLACTM
	JMP JLAC3
	DAC JLACTM
	LAC I T
	AND (777
	DAC ACL
	ISZ T
	DZM ACS
	LAC I T
	SPA!CLL
	ISZ ACS
	RAL
	DAC ACR
	JMS I END+43
	LAC JL#ACTM
	DAC ACX
	JMP I JLAC
JLAC0,	0
	LAC IDRECT
	SZA
	JMP . 3
	LAC MODE
	JMP I JLAC0
	LAC T
	AND (400000
	JMP I JLAC0




FDAC,	JMS JLAC0
	SZA
	JMP FDAC2
	LAC ACX
	DAC I T
	ISZ T
	LAC ACS
	RCR	RAR
	XOR ACL
	JMP SETACS
FDAC2,	LAC T
	DAC FOP
	LAC ACX
	AND (777
	RL6
	RTL	RAL
	DAC JLACTM
	DZM ACX
	JMS UNFLOT
	7
	LAC ACS
	RCR
	LAC ACR
	RAR
	DAC ACR
	LAC ACL
	ADD JLACTM
SETACS,	DAC I T
	ISZ T
	LAC ACR
	DAC I T
	JMS JLAC0
	SNA
	JMP BACK
	LAC FOP
	DAC T
	JMP FLAC

FPKUP,	0
	JMS JLAC0
	RCL
	LAC T
	AND (77777
	SZL
	XOR (400000
	DAC TEM#P2
	LAC EFMTEM
	DAC TEMP#3
	EFM
	DAC TEMP4
	LAC I TEMP2
	LFM
	LAC ACS
	DAC YS
	LAC ACX
	DAC YX
	LAC ACL
	DAC YL
	LAC ACR
	DAC YR
	EFM
	LAC TEMP4
	LFM
	LAC TEMP3
	DAC EFMTEM
	JMP I FPKUP
TEMP4,	0
TEMP4 3/

FMAG,	0
	LAC YS
	XOR ACS
	DAC FSIGN
	JMP I FMAG

UNFLOT,	0
	LAC ACX
	CMA
	ADD I UNFLOT
	CMA
	DAC END+11
	LAC ACL
	DAC YL
	LAC ACR
	DAC YR
	JMS I END+47
	LAC YL
	DAC ACL
	LAC YR
	DAC ACR
	ISZ UNFLOT
	DZM ACX
	JMP I UNFLOT

START

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

FOTS W/MODULAR I/O
/COMMON I/O
INDEX=10
TELANA=JMS .	0
	DAC T#EMFIO	/BAUDOT CHARACTER W/CASE
	LAC (CT-1
	DAC INDEX	/INITIALIZE TABLE SEARCH ADDRESS
TEL2=JMP .	LAC I INDEX
	AND (77
	SAD TEMFIO
	SKP
	TEL2		/NO COMPARE
	LAC INDEX
	ADD (-CT		/ANELEX CODE FROM TABLE ADDRESS
	SPA
	CLA
	XIT TELANA
XIT=JMP I-JMS

TOC=JMS .	0		/TEXT OUTPUT
	DAC TOCTEM	/TEXT ADDRESS
	DZM FIOCAS	/LOWER CASE
	DZM FIGLET	/FIGURES
TOC2=JMP .	LAM -2
	DAC CH#AC		/-3
	LAC I TOC#TEM
TOC3=JMP .	RL6
	DAC CH#AC1
	RAL
	AND (77
	SAD (13
	JMP TOCEX		/END OF TEXT
TOCX,	XX

	FIOCON		/MODIFIED BY FIOC
	SAD (13
	LAC (136		/TAB IN TEXT OUTPUT
	SAD (40
	SKP
	STASH
	LAC CHAC1
	ISZ CHAC
	TOC3
	ISZ TOCTEM
	TOC2
TOCEX,	STASH
	XIT TOC

FIOCON=JMS .	0	/FIODEC TO ANELEX
	SAD (36
	FIOTAB		/TAB
	SAD (13
	XIT FIOCON	/END OF ITEM
	SAD (72
	JMP CASSET	/LOWER CASE
	SAD (74
	JMP CASSET+2	/UPPER CASE
	SAD (77
	JMP FIOCAR	/CARRIAGE RETURN=END OF RECORD
	DAC CH#ARG
	LAC FIOCAS
	SZA		/LOWER CASE FIODEC=ANELEX
	FIOANA		/CONVERT UPPER CASE FIODEC
	LAC CHARG
	XIT FIOCON
CASSET,	DZM FIOCAS	/LOWER CASE
	SKP
	ISZ FIOCAS	/UPPER CASE
	LAC (40)		/CASE SHIFT
	XIT FIOCON
FIOCAR,	CLC
	XIT FIOCON
FIOTAB=JMP .	LAC (13	/TAB=END OF ITEM
	XIT FIOCON

FIOANA=JMP .	LAC CHARG	/UPPER CASE FIODEC TO ANELEX
	GCHAR		/TABLE WORD
	AND (7700
	DAC TEMFIO
	TAD (776500	/LOOK FOR 13 FILLER
	SNA
	JMP FIOANB	/NO EQUIVALENT
	LAC TEMFIO
	RR6		/RIGHT JUSTIFY
	XIT FIOCON
FIOANB,	LAC CHARG
	XIT FIOCON

GCHAR=JMS .	0
	ADD (LAC CT
	DAC .+1
	XX		/GET CT TABLE ENTRY
	XIT GCHAR

RL6=JMS .	0		/CLEAR LINK AND ROTATE LEFT 6
	RCL
	RTL
	RTL
	RAL
	XIT RL6

RR6=JMS .	0		/CLEAR LINK AND ROTATE RIGHT 6
	RCR
	RTR
	RTR
	RAR
	XIT RR6
ANATEM=RR6-JMS
ANAFIO=JMS .	0	/ANELEX TO FIODEC
	DAC ANATEM
	GCHAR
	RL6
	RAL
	AND (77
	SAD (13
	JMP ANA2		/LOWER CASE
	XOR (400000	/UPPER CASE BIT
	XIT ANAFIO
ANA2,	LAC ANATEM	/ANELEX = LOWER CASE FIODEC
	XIT ANAFIO

ANATEL=JMS .	0	/ANELEX TO BAUDOT
	GCHAR		/TABLE ENTRY
	AND (77
	XIT ANATEL

/INTERNAL ANELEX CONVERSION TABLE
/FIELD 1, 0-5, FIELD 2, 6-11, FIELD 3, 12-17
/FIELD 1=UPPER CASE FIODEC INDEXED BY ANELEX, 13 FILLER
/FIELD 2=ANELEX INDEXED BY UPPER CASE FIODEC, 13 FILLER
/FIELD 3=BAUDOT INDEXED BY ANELEX, 00 FILLER
CT=.	130010
	133272
	131262
	131340
	131424
	131502
	131652
	131770
	133430
	133506
	021350
	031300
	041300
	051336
	061354
	071300
	133632
	133756
	131351
	131303
	131371
	131337

	131363
	131357
	131353
	131343
	011300
	135314
	101300
	111300
	201344
	211346
	136000
	131365
	131375
	131323
	131317
	131315
	131307
	131333
	131373
	131325
	131300
	331342
	137460
	137522
	137664
	137774
	401334

	131361
	131347
	131335
	131345
	131341
	131355
	131327
	131313
	131331
	731312
	137216
	541326
	551300
	561300
	571300
R9R,	0
	RR6
	RTR
	RAR
	JMP I R9R
MODE,	0
LINK,	0

UNPOSA,	LAC ACX
	ADD (-1
	JMP UNPOSR

PUSHCH,	DZM F
	JMP I PUSHET

STORE,	STORE 144/
INBUF,	INBUF 401/
EXSGN,	0
START
