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