/
/IO HANDLER PART II
/VERSION IOH2.V08
/COPYRIGHT 1969, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/
	CPAGE	30
PRINT, 0
	DCA	GCHR
	CMA		     /JUMP VECTOR CALCULATION
	TAD	DV	     /DEVICE-1
	DCA	JC
	TAD	JC	     /TIMES 3
	CLL RAL
	TAD	JC
	TAD	JA	     /PLUS BASE OF VECTOR
	DCA	JC
	TAD	GCHR
	JMP I	JC
BA,	0		     /THIS IS THE END OF LINE SWITCH
BH,	ISZ	BA	     /ENTRY TO LOOK FOR AN END OF LINE
BL,	TAD	(40
	JMP I	GCHR
G2,	0		     /ROUTINE TO GET A NEW INPUT RECORD
MM,	CLA
	TAD	BA
	SZA CLA
	JMP	BG
	JMS	GCHR
	JMP	MM
BG,	DCA	BA
	JMP I	G2
GCHR,	0		     /GET AN INPUT STRING CHARACTER
JD,	CLA
	TAD	BA	     /GET EOR SWITCH
	SZA CLA
	JMP	BL	     /IS EOR, RETURN BLANK
	CMA		     /JUMP VECTOR CALCULATION
	TAD	DV	     /DEVICE-1
	DCA	PRINT
	TAD	PRINT	     /TIMES 3
	CLL RAL
	TAD	PRINT
	TAD	JB	     /BEGINNING OF JUMP VECTOR
	DCA	PRINT
	JMP I	PRINT


JF,    DCA	PRINT	     /RETURN IS HERE, SAVE CHAR
	TAD	PRINT	     /PICK UP CHARACTER TO TEST IT
	TAD	(7440
	SMA		     /LESS THAN 340
	JMP	JD	     /NO , IGNORE
	TAD	(100	     /YES, IS IT .G.237
	SMA
	JMP	JE	     /YES, RETURN TRIMMED CHAR
	TAD	(23
	SNA
	JMP	BH	     /CARRIAGE RETURN, EOR AND RETURN BLANK
	TAD	(115	     /IS CHAR .GE. 100
	SMA
	JMP	JD	     /YES IGNORE
	TAD	(100	     /IS GCHAR .GE. 0
	SPA SNA
	JMP	JD	     /NO, IGNORE
JE,    CLA		     /YES, RETURN THE CHAR
	TAD	PRINT
	AND	(77
	JMP I	GCHR
BE,	0
JC,    0
JA,	JXXX
JB,	JWWW
IX,	JMS	GLST	     /INTEGER CONVERSION
II,	JMSKP	BB	     /TEST MORE AND NON ZERO CURRENT LIST ITEM
	JMP	IN	     /INPUT
	TAD	AB
	DCA	BE	     /OUTPUT
	TAD	(-4
	DCA	WH	     /-4
	DCA	SN	     /0
	TAD I	ARGUMT
	SMA		     /SET SN 0 FOR PLUS, 1 FOR MINUS
	JMP	XZ	     /PLACE MAGNITUDE IN 20
	CIA
	ISZ	SN
XZ,	DCA	SACH
IA,	TAD	SACH
	SNA		     /TEST FOR ALREADY ZERO
	JMP	IB
	CALL	1,DIV
	ARG	TW
	DCA	SACH
	CALL	1,IREM	     /IREM NEEDS AN ARGUMENT TO IGNORE
	ARG	0


	DCA I	BE	     /SAVE REMAINDER
	CMA
	TAD	BE	     /BE ' BE-1
	DCA	BE
	ISZ	WH	     /INDEX COUNT
	JMP	IA	     /CYCLE
IB,	TAD	WH	     /GET COUNT
	TAD	(4	     /FOUR -COUNT
	SNA		     /IF ZERO SET ' 1
	IAC
	TAD	SN	     /< COUNT ' TOTAL CHARS REQ D
	CIA		     /-COUNT
	TAD	N2	     /<W, W-COUNT
	CMA
	SMA
	JMP	AS2	     /MORE  HARS THAN WIDTH
	DCA	CR	     /U,S COMP OF W-COUNT
	SKP CLA
IC,	JMS	PRINT	     /PRINT BLANKS UNTIL CR OVERFLOWS
	TAD	(40
	ISZ	CR
	JMP	IC
	JMS	PSGN	     /PRINT THE SIGN
	TAD	WH	     /GET COUNT OF DIGITS
	TAD	(4
	SZA CLA		/ZERO, PRINT ONE ZRRO
	JMP	ID
	TAD	(60
	JMS	PRINT
	JMP	IX	     /EXIT OUTPUT AND TEST FOR MORE


IE,	TAD	(60
	JMS	PRINT
ID,	ISZ	BE	     /POINT TO DIGIT TO PRINT NEXT
	TAD I	BE	     /GET IT
	SMA		     /IS IT NEGATIVE, MUST BE THE TERMINATIOR
	JMP	IE	     /GO PRINT IT
	CLA		     /LEAVE
	JMP	IX
	CPAGE	5
	0		      /I1000
	0		      /I100
	0		      /I10
I1,	0		      /I1
	4000
AB,	I1
IN,	TAD	N2	     /INTEGER INPUT, GET WIDTH OF FIELD
	CMA		     /1,S COMP TO COUNTER, CR
	DCA	CR
	CMA
	DCA	WH	     /-1 TO NUMBER ACCUMULATED
VQ,	CMA		     /-1 TO SIGN
	DCA	SN
	DCA	SACH
RRS,	ISZ	CR	     /HAS WHOLE NUMBER BEEN ACCUMULATED
	SKP
	JMP	PRO
	CPAGE	5	/SC SUBROUTINE SKIPS SO WE MUST PLAY GAMES
	JMS	SC	/NOTE THAT PREVIOUS ISZ FORCES DATA FIELD
	JMP	ERR2		/ '.'
	JMP	RRS		/ SIGN OR BLANK
	JMP	ERR2		/ 'E'
	DCA	SACM		/ DIGIT ...
	TAD	SACH
	CLL RAL 	     /SACH= 10*SACH + NEW DIGIT
	DCA	SACH
	TAD	SACH
	RTL
	TAD	SACH
	TAD	SACM
	DCA	SACH
	JMP	RRS	     /GET NEXT DIGIT
PRO,	TAD	SACH	     /WE HAVE AN INTEGER ...
	ISZ	WH	     /WHAT KIND?
	JMP	PRO2
	ISZ	SN	     / 'I' FORMAT
	CIA
	DCA I	ARGUMT
	JMP	IX
PRO2,	ISZ	SN	     / 'E' FORMAT
	CMA		     /MINUS - MUST BE 1'S COMPLEMENT
	JMP	VZ




/     GET F.P. NUMBER INTO THE RANGE	  .1 .LE. N .L. 1.0
NR,	0
	CLA
	TAD	ARGUMT	     /WE MUST STORE AN ADDRESS
	DCA	STA1
	TAD	ARGUMT#	     /WE MUST STORE A 2 WORD ADDRESS
	DCA	STA1#
	CALL	1,FAD
STA1,	ARG	0
	DCA	SN	     /CLEAR THESE LOCS
	DCA	C
	TAD	ACH
	SNA
	JMP	NREX	     /NUMBER IS ZERO
	SMA		     /IS IT A MINUS F P NUMBER
	JMP	RETM
	TAD	(4000	     /YES-- MAKE IT POSITIVE
	ISZ	SN	     /SET SIGN
	DCA	ACH
RETM,	CLA			/MULTIPLY BY 10 UNTIL NR .GT. (1.0)
	TAD	ACH
	TAD	(5764
	SMA CLA
	JMP	TB	     /GOT IT IT IS .GE.1
	CALL	1,FMP
	ARG	TN
	ISZ	C	     /AND COUNT
	JMP	RETM	     /GO TRY TO DO IT AGAIN
TB,	JMS	SE	     /NOTE SE ' XR-1
	CALL	1,STO
	ARG	SV
	CALL	1,FAD
	ARG	HF	     /0.50000
	TAD	CH	     /TEST FORMAT
	TAD	(7772
	SZA CLA
	JMP	XJ	     /E FORMAT
	TAD	C	     /F FORMAT, GET COUNT OF MULTS NEEDED
	CIA		     /-NUMBER OF MULTS USED
XJ,	TAD	N2	     /< DADP
	SMA
	CMA		     /NUMBER OF THIMES TO DIVIDE .5 BY 10 TO RND
	JMS	DH	     /DO THE DIVIDES
	CALL	1,FAD
	ARG	SV
	JMS	SE	     /REDUCE TO NORMAL RANGE AGAIN


GD,	TAD	ACH
	RAL
	SPA CLA
	JMP	ZP	     /NUMBER IS ? 1/2
	TAD	ACH
	CLL RAR 	     /WE ARE GETTING EXP TO 200
	DCA	ACH
	TAD	ACM
	RAR
	DCA	ACM
	TAD	ACL
	RAR
	DCA	ACL
	TAD	ACH
	AND	(7774
	TAD	ACH
	TAD	(10
	DCA	ACH
	JMP	GD
ZP,	TAD	ACH
	AND	(7
	DCA	ACH
NREX,	JMP I	NR
SN,	0
GLST,	0
	INC	IOH#
	CALL	0,CLEAR
	RETRN	IOH
IOH,	BLOCK	2	     /ENTRY FOR LIST ITEM
	TAD I	IOH
	DCA	ARGUMT
	INC	IOH#	    /POINT TO WORD TWO
	TAD I	IOH
	DCA	ARGUMT#
	JMP I	GLST
	PAGE

CK,	0		     /CHECK LIST ITEM
	TAD	ARGUMT#
	SNA CLA
	JMS	WH
	JMP I	CK

SC,	0
	JMS	GCHR	     /GET CHARACTER FROM INPUT STRING AND TEST
	TAD	(7722	     /IS IT A PERIOD
	SNA
	JMP	XA	     /YES
	IAC		     /NO, INCREMENT AC
	SNA		     /IS CHAR A MINUS SIGN
	JMP	MI	     /YES
	TAD	(2	     /NO, TEST FOR PLUS SIGN
	SNA
	JMP	XB	     /PLUS SIGN
	TAD	(13	     /NOT A PLUS SIGN, ABLANK?
	SNA
	JMP	XB	     /YES
	TAD	(33	     /NO, TEST FOR AN E
	SNA
	JMP	XC	     /IS AN E
	TAD	(7713	     /IS NOT AN E


	SMA		     / IS CHAR < 72 ?
	JMP	BD	     /NO, ERROR
	TAD	(12	     /YES
	SPA		     / IS CHAR <= 60 ?
BD,	JMP	ERR3	     /NO AN ERROR
	ISZ	SC	     /YES, A DIGIT
XC,	ISZ	SC	     /AN E
XB,	ISZ	SC	     /SIGN OR BLANK
XA,	JMP I	SC	     /PERIOD ONLY
MI,	ISZ	SN
	JMP	ERR4	     /MORE THAN 1 MINUS SIGN
	JMP	XB
	CPAGE	3
SV,	0		     /FLOATING POINT TEMP
	0
	0
MT,	0		     /MULTIPLY FPAC BY TEN
	JMS	LS	     /LEFT SHIFT 1
	TAD	ACL	     /SAVE THE FPAC
	DCA	SACL
	TAD	ACM
	DCA	SACM
	TAD	ACH
	AND	(17
	DCA	SACH
	JMS	LS	     /LEFT SHIFT 2
	JMS	LS
	TAD	ACL	     /ADD THE DSAVE TO THE ACC
	TAD	SACL
	DCA	ACL
	RAL		     /*
	TAD	ACM
	TAD	SACM
	DCA	ACM
	RAL		     /*
	DCA	LS
	TAD	ACH
	AND	(77
	TAD	SACH
	TAD	LS
	DCA	ACH
	JMP I	MT
LS,	0		     /LEFT SHIFT THE FPAC 1
	TAD	ACL
	CLL RAL
	DCA	ACL
	TAD	ACM
	RAL
	DCA	ACM
	TAD	ACH
	RAL
	DCA	ACH
	JMP I	LS	     /DONE

	CPAGE	20
PR,	0		     /SUBROUTINE TO DECODE FORMAT
PR2,	TAD	CH	     /HERE WE DECODE ACTION TYPE
	TAD	(7750
	SNA
	JMP	XX	     /X FORMAT
	TAD	(0017
	SNA
	JMP	II	     /I FORMAT
	IAC
	SNA
	JMP	HH	     /H FORMAT
	TAD	(2
	SNA
	JMP	FF	     /F FORMAT
	IAC
	SNA
	JMP	EE	     /E FORMAT
	TAD	(4
	SNA
	JMP	AA	     /A FORMAT
	JMP	ERR5	     /NOT A VALID FORMAT CHARACTER



GFRM,	0		     /GET THE NEXT CHARACTER IN THE FORMAT
	TAD	SW	     /ARE WE ON LEFT HALF OR RIGHT
	SZA CLA
	JMP	OD
	ISZ	SW	     /LEFT SET THE SWITCH
	TAD I	FPNT	     /GET THE WORD
	RTR		     /ONLY WANT THE LEFT HALF
	RTR		     /*
	RTR		     /*
HR,	AND	(77
	JMP I	GFRM	     /F	 SEND IT BACK
OD,	DCA	SW
	TAD I	FPNT	     /GET THE FORMAT WORD
	INC	FPNT#	     /KICK THE POINTER FOR NEXT TIME
	JMP	HR


FPNT,	BLOCK	2
DT,	0
RETT,	ISZ	CR
	SKP
	JMP I	DT	     /DONE
	JMS	MT	     /MULTIPLY BY 10
	TAD	ACH
	CLL RAR 	     /ROTATE 3 RIGHT
	RTR
	TAD	(60	     /MAKE DIGIT
	JMS	PRINT	     /DUMP IT AND SEE IF ANY MORE
	JMP	RETT	     /*
EJ,	0		     /ROUTINE TO END RECORD
	TAD	IO
	SZA CLA
	JMP	E1	     /OUTPUT
E2,	JMS	G2	     /INPUT
	JMP I	EJ
E1,	JMS	PRINT
	JMP I	EJ
N1,	0			/REPETITION COUNT
MR,	0		     /MORE?
	ISZ	N1	     /SEE IF IT GOES TO ZERO
	JMP I	MR
	DCA	CH	     /NO MORE FIELDS, FIRST WIPE CHAR
	JMP I	PR	     /GO BACK TO FORMAT SCANNER
NM,	0
NU,	0		     /ROUTINE TO FETCH THE ACCUM NUMB
	TAD	NM
	SPA		     /IF IT IS NEG, SET IT TO 1
	CLA IAC 	     /IT IS AND WE DO
	JMP I	NU	     /GO HOME
BB,	0
	JMS	MR	     /MORE?
	JMS	CK	     /IF ARG ' 0, END RECORD AND RETURN
	TAD	IO	     /TEST IN OUT SWITCH
	SZA CLA 	     /OUTPUT
	INC	BB	     /INPUT
	JMP I	BB
AX,	JMS	GLST
AA,	TAD	N2
	CMA
	DCA	CX
	JMSKP	BB
JX,	JMP	AN
	JMP	AO


AS,	TAD I	ARGUMT
	RTR		     /SHIFT RIGHT 6
	RTR
	RTR
	AND	(77	     /MASK AND PRINT
	JMS	PRINT
	ISZ	CX	     /TEST FOR DONE
	SKP
	JMP	AX	     /DONE, MORE?
	TAD I	ARGUMT
	AND	(77
	JMS	PRINT
	ISZ	ARGUMT#
AO,	ISZ
CX	     /OUTPUT, TEST COUNT
	JMP	AS
	JMP	AX
AR,	JMS	GCHR	     /GET INPUT CHAR
	STL		     /MAKE RH CHR A BLANK
	RTL		     /SHIFT LEFT 6
	RTL
	RTL
	DCA I	ARGUMT
	ISZ	CX	     /DONE?
	SKP
	JMP	AX	     /YES
	JMS	GCHR	     /NO, GET RIGHT CHAR
	TAD I	ARGUMT
	TAD	(7740
	DCA I	ARGUMT	     /PUT THE WORD PACK
	ISZ	ARGUMT#	     /POINT TO THE NEXT WORD
AN,	ISZ	CX	     /INPUT , TEST COUNT
	JMP	AR
	JMP	AX
CX,	0
	CPAGE	3
TN,	2045		     /THIS IS A FLOATING POINT 10.0
	0		     /*
	0		     /*
PSGN,	0		     /IF THE SIGN IS
	CLA
	TAD	SN
	SNA CLA
	JMP I	PSGN	     /IF POSITIVE, FORGET IT
	TAD	(55
	JMS	PRMNT
	JMP I	PSGN	     /GO BACK


HH,	JMS	MR	     /THE H FIELD PROCESSOR
	JMS	GFRM	     /SAME AS XXX, BUT PRINT NEXT
	JMS	PRINT	     /----- FORMAT CHARACTER
	JMP	HH	     /OUTPUT ONLY
DH,	0
	DCA	CX	     /DIVIDE FPAC BY TEN CX TIMES
	JMP	DTA
DTB,	CALL	1,FDV
	ARG	TN
DTA,	ISZ	CX
	JMP	DTB
	JMP I	DH
AS3,	CLA		     /PRINT ASTERISKS FOR WHOLE FIELD SIZE
	TAD	N3	     /GET FIELD SIZE, E OR F
	JMP	XRLM
AS2,	CLA
	TAD	N2	     /GET FIELD SIZE, I
XRLM,	CMA
	DCA	CX	     /-COUNT
	JMP	QQ
QQA,	TAD	(52	     /PRINT CX ASTERISKS
	JMS	PRINT
QQ,	ISZ	CX	     /INDEX COUNT
	JMP	QQA
	JMS	GLST	     /TEST FOR MORE
	JMP	PR2	     /RETURN TO FORMAT PROCESSOR, SAME TYPE

	END