FORTRAN ASSEMBLER TAPE 6
/OUTPUT PACKAGE

TY1,	0
	DAC TE#MY
	AND (37
	DAC TEM#ZZ
	SNA
	JMP TY2
	LAS
	AND (100
	SZA
	JMP TY4
	LAC TEMZZ
	703301
	SKP
	JMP TY1B
TY4,	LAC OCL
	SPL
	LAC OCU
	SAD O#CS
	JMP . 3
	JMS OTY
	DAC OCS
	LAC TEMY
	JMS OTY
	ISZ T#BC
TY2,	LAC TEMY
	JMP I TY1

TY3,	0
	JMS RL6
	JMS TY1
	JMS RL6
	JMS TY1
	JMS RL6
	JMS TY1
	JMP I TY3

TCR,	0
	LAT
	AND (100
	SZA
	JMP TCR1
	703301
	JMP TCR1
	LAW 215
	JMS OTY
	LAW 212
	JMS OTY
	JMP TCR2
TCR1,	LAW 2
	JMS OTY
	LAW 10
	JMS OTY
TCR2,	DZM TBC
	JMP I TCR

TSP,	0
	LAT
	AND (100
	SZA
	JMP . 3
	LAW 240
	703301
	LAW 4
	JMS OTY
	ISZ TBC
	JMP I TSP

TYT,	0
	LAC TBC		/TYPE A TAB
	ADD (-TTAB
	SMA
	JMP .-2
	ADD (1
	SMA
	LAC (-TTAB
	ADD (-1
	DAC TEM
	JMS TSP
	ISZ TEM
	JMP .-2
	JMP I TYT

/TYPEWRITER INITIALIZE

TIN,	0
	LAC OCL	/SET LOWER CASE
	DAC OCS
	LAM -50
	DAC ANXCNT	/LPT BUFFER LENGTH COUNTER
	DZM SV3C
	DZM PNTF
	LAW 7
	DAC SPC#IND	/TOP OF FORM INITIALLY
	LAT
	AND (100
	SZA
	JMP TIN3
	LAC OCL
	703301
	JMS OTY
TIN2,	JMS TCR
	JMP I TIN
TIN3,	LPCB	/CLEAR PRINTING BUFFER
	LAC OCL	/INITIALIZE LOWER CASE
	JMP TIN2-1
TY1B,	ADD (LAC BTATAB-1
	DAC .+1
	XX
	SZL
	JMS RR9
TY1D,	JMS OTY
	JMP TY2-1
BTATAB,	265324
	215215
	271317
	240240
	243310
	254316
	256315
	212212
	251314
	264322
	246307
	270311
	260320
	272303
	273326
	263305
	242332
	244304
	277302
	211323
	266331
	241306
	257330
	255301
	262327
	247312
	200200
	267325
	261321
	250313
	200200

/MORE OUTPUT ROUTINES

TDIGIT,	0
	ADD (LAC NCT
	DAC . 1
	XX
	RAR
	JMS TY1
	JMP I TDIGIT

/CONVERT ONE WORD FORM INTERNAL TO TELETYPE

ITT,	0
	DAC TEM
	DZM TE#MT
	LAM -2
	DAC TT#CNT
	LAC TEM
	JMS RL6
	DAC TEM
	AND (37
	ADD (LAC TTABLE
	DAC . 1
	XX
	SML
	JMS RR6
	AND (77
	ADD TEMT
	ISZ TTCNT
	JMP . 2
	JMP I ITT
	JMS RL6
	DAC TEMT
	JMP ITT 5

/OCTAL PRINT

OPS,	0
	DAC O#CN
	LAM -5
	DAC O#PC
	LAC (SZA
	DAC OPM
OP0,	LAC OCN
	RCL
	RTL
	DAC OCN
	RAL
	AND (7
OPM,	XX
	JMP OP2
	ISZ OPC
	JMP OP0
	JMS TDIGIT
	JMP I OPS

OP2,	JMS TDIGIT
	LAC OPM 1
	ISZ OPC
	JMP OP0-1
	JMP I OPS

/SOME DATA STORAGE

NCT,	33	73	63	41	25
	3	53	71	31	7

OCU,	33
OCL,	37


/ROTATE SUBS

RL6,	0
	RCL	RAL	RTL	RTL
	JMP I RL6

RL9,	0
	RCL	RTL	RTL	RTL	RTL
	JMP I RL9

RR3,	0
	RCR	RTR
	JMP I RR3

RR6,	0
	RCR	RTR	RTR	RAR
	JMP I RR6

RR7,	0
	JMS RR6	RAR
	JMP I RR7

RR9,			0
	JMS RR7	RTR
	JMP I RR9


/ROUTINES TO MAKE ASSEMBLER PUNCH 

P1B,	0
	DAC TEM
	JMS P1BL
	LAC TEM
	JMS RR6
	DAC TEM
	JMS P1BL
	LAC TEM
	JMS RR6
	JMS P1BL
	JMP I P1B

P1BL,	0
	AND (77
	ADD (200
	JMS IPB
	JMP I P1BL

FEED,	0
	DAC TEM
	CLA
	JMS IPB
	ISZ TEM
	JMP .-3
	JMP I FEED

PUNCH8,	0
	AND (377
	DAC TEM
	JMS IPB
	LAC TEM
	ADD CKS
	DAC CKS
	JMP I PUNCH8


/PUNCH UNDEFINED

PUND,	0
	LAC UNC
	SNA		/NUMBER OF UNDEFINED
	JMP I PUND	/IF NONE, EXIT
	LAW UNDT		/SET UP
	DAC D#UN1

PUND1,	LAC DUN1		/TEST FOR DONE
	SAD DUN
	JMP I PUND
	LAC I DUN1	/PICK UP ADDRESS OF FIRST UND
	SNA
	JMP PUND2	/ZERO MEANS ALREADY PUNCHED
	DAC DU#NA
	AND (700000
	DAC DU#NT		/TEST OPERATIONS ON UNDEFINED
	LAC I DUNA
	AND (637777	/MASK OUT VARIA BITS
	SZA
	JMP PUND3A
	LAC UNDC
	ISZ UNDC		/GET NUMBER TO ASSIGN UNDEFINED
	ADD I DUNA
	DAC I DUNA
PUND3,	AND (17777
	ADD DUNT
	JMS E1W
	C23
PUND2,	ISZ DUN1		/INDEX AND GO TO TEST
	JMP PUND1
PUND3A,	SAD (600000
	JMP . 2		/EXTERNAL
	JMP PUND3
	LAC DUNT
	JMS E1W
	C23
	LAC DUNA
	JMS SYMDAC
	JMS NPNCH
	C15		/RELOCATABLE PLUS OR MINUS
	JMP PUND2


/DEPOSIT WORD

DWD,	0
	DAC DW#T
	LAC LAD
	SAD CAI
	JMP . 2
	JMS PBK
	LAC C1NR
	SNA
	JMP DWDC 2
	LAC DWT		/RELOCATABLE
	JMS E1W
DWDC,	C21
	JMP . 4
	LAC DWT
	JMS E1W
	C1
	LAC DWDC
	SAD (C22
	JMP DWD1
DWD3,	JMS PUND
	ISZ LAD
	ISZ DECNT
	LAC (C21
	DAC DWDC
	ISZ DCNT
	JMP I DWD
DWD1,	LAC SYT
	SAD (6
	JMP DWD2
	JMP DWD3
DWD2,	JMS NPNCH
	C17
	JMP DWD3

/FINISH PUNCHING OF A BLOCK

PBK,	0
	LAC DECNT
	SNA
	ISZ LAD
	LAC DCNT
	SNA
	JMP PBK2
	LAC CNT
	SNA
	JMP PBKR
	CMA
	DAC CN#T
	ADD CKS
	ADD LAD
	ADD (DAC-1
	ADD RELABS
	CMA
	JMS P1B
	LAC CNT
	JMS P1B
	LAC LAD
	ADD (DAC-1
	ADD RELABS
	JMS P1B
	LAM -6
	JMS FEED
PBKR,	DZM DC#NT
	DZM C#KS
	DZM CNT
	DZM DECNT
PBK3,	LAC CAI
	DAC LAD
	JMP I PBK
PBK2,	LAC CNT
	SNA
	JMP PBKR
	JMP PBK3

/ENTER 1 WORD AS THREE 8 BIT CHUNKS

E1W,	0
	DAC TEM#3
	RAL
	AND (400000
	ADD I E1W
	RTL
	JMS PUNCH8
	LAC TEM3
	JMS RR7
	RAR
	JMS  PUNCH8
	LAC TEM3
	JMS PUNCH8
	ISZ CNT
	ISZ E1W
	JMP I E1W

START
