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
