/ 7	FORTRAN II EXTENDED SUBROUTINE & FUNCTION LIBRARY
/
/	COPYRIGHT 1978, DIGICOS SOFTWARE DEVELOPMENT GROUP
/
/	24-SEP-78			W. HOUBEN
/
	ENTRY	]PUT	/ CALL 0,]PUT	/ DVNR & CHAR IN AC
	ENTRY	]GET	/ CALL 0,]GET	/ DVNR IN AC
	ENTRY	]PZE	/ CALL 0,]PZE	/ # IN AC
	ENTRY	]OPE	/ CALL 0,]OPE	/ INIT I/O SYSTEM
	ENTRY	]ISN	/ CALL 0,]ISN	/ ISN-SERVICE
	ENTRY	ASSIG	/ CALL 2,ASSIG	/ ASSIGN A UNIT
			/ ARG    LUN	/ TO A LOGICAL
			/ ARG    UNIT	/ UNIT NUMBER
	ENTRY	]CLR	/ CALL 0,]CLR	/ CLEAR FAC
	ENTRY	EXIT	/ CALL 0,EXIT	/ RETURN TO OS8
/
/	SPECIAL MRI - INSTRUCTIONS
/
	OPDEF	TADI	1400
	OPDEF	JMPI	5400
	OPDEF	DCAI	3400
	OPDEF	JMSI	4400
	SKPDF	JMSK	4000
/
/	TEMPORARY REGISTERS
/
	ABSYM	TEMP	6
	ABSYM	CHAR	7
	ABSYM	XR10	10
/
/	TERMINAL IOTS
/
	OPDEF	KCC	6032
	OPDEF	KRS	6034
/
/	LINE PRINTER IOTS
/
	OPDEF	LLB	6666
	SKPDF	LSF	6661
/
/	8/E MQ INSTRUCTIONS
/
	OPDEF	MQL	7421
	OPDEF	MQA	7501
	OPDEF	CAM	7621
	OPDEF	SWP	7521
	OPDEF	BSW	7002
/
/	CRT IOTS
/
	SKPDF	VTSF	6311
	OPDEF	VTLS	6316
	SKPDF	VKSF	6301
	OPDEF	VKRS	6304
	OPDEF	VKCC	6302
	OPDEF	VKRB	6306
	LAP
/
/	I/O-UNIT REFERENCE TABLE
/
LUNREF,	IOREF
IOREF,	IOE		/ UNIT 0	DEF ERR
	TTY		/ UNIT 1	DEF TTY
	HSRHSP		/ UNIT 2	DEF PTR/PTP
	CDRLPT		/ UNIT 3	DEF CDR/LPT
	FINFOU		/ UNIT 4	DEF FIN/FOU
	CRT		/ UNIT 5	DEF CRT
	BAT		/ UNIT 6	DEF BAT
	CENTRO		/ UNIT 7	DEF C101-LPT
/
/	PHYSICAL UNIT REFERENCE TABLE
/
/	INPUT-	OUTPUT-	HANDLER
/
IOE,	IOERR;	IOERR	/ PRINT AN ERROR MESSAGE
TTY,	TTYIN;	TTYOUT	/ THE SYSTEM TERMINAL
HSRHSP,	HSPIN;	HSPOUT	/ THE HIGHSPEED READER/PUNCH
CDRLPT,	CDRIN;	LPTOUT	/ CARDREADER AND LINEPRINTER
FINFOU,	GENIN;	GENOUT	/ OS/8 FILE I/O
CRT,	CRTIN;	CRTOUT	/ A SECOND TERMINAL
BAT,	BATIN;	BATOUT	/ BATCH STREAM AND LOG
CENTRO,	IOERR;	C101	/ THE CENTRONICS PRINTER
/
/	]PUT - SUBROUTINE
/
]PUT,	BLOCK	2	/ OUTPUT A CHAR
	JMS	GETLUN	/ GET LUN #
	TAD	LUNREF	/ ADD TABLE ADDR
	DCA	TEMP
	TADI	TEMP	/ GET PHYSICAL UNIT
	IAC		/ GET SECOND HANDLER
	DCA	TEMP
	TADI	TEMP	/ GET HANDLER ADDR
	DCA	TEMP
	TAD	CHAR
/
/	CARRIAGE CONTROL HANDLER
/
/	CARRIAGE CONTROL CHARACTERS :
/
/	0	DOUBLE LINE FEED
/
/	1	FORM FEED
/
/	+	NO LINE FEED
/
/	$	NO LINE FEED NO CARRIAGE RETURN
/
/	*	ELONGATE
/
/	ANY O.	SINGLE LINE FEED
/
	ISZ	FIRST	/ FIRST CHAR ON THIS LINE ?
	JMP	NOFST	/ NO: PRINT NORMAL
	TAD	(-244
	SNA		/ DOLLAR ?
	JMP	DOLL
	TAD	(-6
	SNA		/ STAR ?
	JMP	STAR
	TAD	(-1
	SNA		/ PLUS ?
	JMP	PLUS
	TAD	(-5
	SNA		/ NULL ?
	JMP	NULL
	TAD	(-1
	SNA CLA		/ EINS ?
	JMP	EINS
	JMP	PUTRTN	/ NONE OF THEM ! RETURN
NOFST,	TAD	(-212
	SNA		/ LINE FEED ?
	JMP	TSNLF
	TAD	(-3
	SNA		/ RETURN ?
	JMP	TSNCR
CRTN,	IAC		/ RETURN
EINS,	TAD	(2	/ FORM FEED
NULL,	TAD	(212	/ LINE FEED
	JMPI	TEMP	/ PRINT IT
STAR,	CMA
	DCA	FIRST	/ SET FIRST FLAG
	TAD	(16	/ ELEONGATE
	JMP	NULL#
DOLL,	CMA
	DCA	NOCR	/ SET NOCR FLAG
PLUS,	CMA
	DCA	NOLF	/ SET NOLF FLAG
	JMP	PUTRTN
TSNLF,	CMA		/ SET FIRST FLAG
	DCA	FIRST
	ISZ	NOLF	/ RESET NOLF FLAG AND TEST
	JMP	NULL	/ PRINT
	JMP	PUTRTN
TSNCR,	ISZ	NOCR	/ RESET NOCR FLAG AND TEST
	JMP	CRTN
PUTRTN,	CLA CLL
	RETRN	]PUT
NOLF,	0
NOCR,	0
FIRST,	-1
/
/	]GET - SUBROUTINE
/
]GET,	BLOCK	2	/ INPUT A CHAR
	JMS	GETLUN	/ GET LUN #
	TAD	LUNREF	/ ADD THE TABLE ADDR
	DCA	TEMP
	TADI	TEMP	/ GET PHYSICAL UNIT
	DCA	TEMP
	TADI	TEMP	/ GET HANDLER ADDR
	DCA	TEMP
	JMPI	TEMP	/ GO READ ONE CHAR
GETRTN,	RETRN	]GET
/
/	SUBROUTINE TO GET LUN AND SAVE CHAR
/
GETLUN,	0
	MQL		/ SAVE CHAR
	MQA
	BSW
	RTR
	AND	(17	/ MASK LUN
	SWP		/ SAVE LUN GET CHAR
	AND	(377
	DCA	CHAR	/ STORE 8-BIT CHAR
	MQA		/ GET LUN BACK
	JMPI	GETLUN
/
	PAGE
/
/	THE TTY-OUTPUT HANDLER
/
TTOWT,	DCA	CHAR	/ SAVE CHAR
	JMS	CTRLC	/ TEST ^C
	TAD	CHAR
TTYOUT,	TSF		/ WAIT FOR FLAG
	JMP	TTOWT
	TLS		/ OUTPUT CHAR
	JMP	PUTRTN
/
/	THE TTY-INPUT HANDLER
/
TTYIN,	KSF		/ WAIT FOR FLAG
	JMP	TTYIN
	TAD	(200
	KRS
	DCA	CHAR
	KCC
	TAD	CHAR
	TLS		/ ECHO IT
	TAD	(-203
	SNA
	JMP	STOP	/ USER TYPED ^C
	TAD	(-12
	SNA		/ CR ?
	JMP	TTYCR	/ YES: TYPE AN LINE FEED
	TAD	(215
	JMP	GETRTN
TTYCR,	TSF		/ WAIT FOR FLAG
	JMP	TTYCR
	CLA
	TAD	(212
	TLS		/ PRINT A LF ALSO
TTYLF,	TSF
	JMP	TTYLF
	CLA
	TAD	(215
	JMP	GETRTN
/
/	CTRLC - TEST - SUBROUTINE
/
CTRLC,	0
	CLA
	TAD	(200
	KRS
	TAD	(-203
	SZA CLA
	JMPI	CTRLC
STOP,	CALL	0,EXIT
/
/	HSP - HANDLER
/
HSPWT,	DCA	CHAR	/ SAVE CHAR
	JMS	CTRLC	/ TEST ^C
	TAD	CHAR
HSPOUT,	PSF		/ WAIT FOR FLAG
	JMP	HSPWT
	PLS		/ PUNCH CHAR
	JMP	PUTRTN
/
/	HSR - HANDLER
/
HSPIN,	RFC
	RSF
	SKP
	JMP	HSR1
	JMS	CTRLC
	JMP	HSPIN#
HSR1,	RRB
	JMP	GETRTN
/
/	INITIALIZE THE I/O - SYSTEM
/
]OPE,	BLOCK	2
	CLA CMA
	DCA	FIRST
	DCA	ACH
	DCA	ACM
	DCA	ACL
	TAD	(212
	TLS
	LLB
	KCC
	PLS
	6201
	DCAI	INHNDL
	DCAI	OUHNDL
	RETRN	]OPE
INHNDL,	122		/ * THE OPEN   *
OUHNDL,	121		/ * FILE FLAGS *
/
/	INTERNAL STATEMENT NUMBER SERVICE
/
]ISN,	BLOCK	2
	SNA
	JMP	ISN1	/ INCREMENT ISN
	DCA	ISN	/ LOAD ISN
	SKP
ISN1,	INC	ISN
	RETRN	]ISN
ISN,	0
/
/	CLEAR FLOATING ACCU
/
]CLR,	BLOCK	2
	DCA	TEMP
	DCA	ACH
	DCA	ACM
	DCA	ACL
	TAD	TEMP
	RETRN	]CLR
/
/	IOERR - HANDLER
/
IOERR,	HLT
	JMP	OS8
/
/	EXIT - ROUTINE
/
EXIT,	BLOCK	2
OS8,	6203
	JMPI	(7600
/
/	THE DEC-STANDARD LINEPRINTER HANDLER
/
LPTWT,	DCA	CHAR	/ SAVE CHAR
	JMS	CTRLC	/ TEST FOR ^C
	TAD	CHAR
LPTOUT,	LSF		/ WAIT FOR FLAG
	JMP	LPTWT
	LLB		/ OUTPUT CHAR
	JMP	PUTRTN
/
	PAGE
/
/	OS/8 FILE INPUT HANDLER
/
GENIN,	6201
	TADI	IHNDLR
	SNA CLA		/ OPEN INPUT FILE ?
	JMP	IOERR	/ NO: PRINT MESSAGE
	6202
	JMS I	FICHAR	/ GET ONE CHAR
	JMP	IOERR	/ ERROR RETURN
	JMP	GETRTN
/
/	OS/8 FILE OUTPUT HANDLER
/
GENOUT,	DCA	CHAR	/ SAVE CHAR
	6201
	TADI	OHNDLR
	SNA CLA		/ OPEN OUTPUT FILE ?
	JMP	IOERR	/ NO: PRINT MESSAGE
	6202
	TAD	CHAR	/ GET THE CHAR
	JMS I	FOCHAR	/ PUT ONE CHAR
	JMP	IOERR	/ ERROR RETURN
	JMP	PUTRTN
/
IHNDLR,	122		/ **************************
FICHAR,	606		/ *  LOCATIONS DEFINED IN  *
OHNDLR,	121		/ *  LOADER SOURCE         *
FOCHAR,	651		/ **************************
/
/	THE CRT OUTPUT HANDLER
/
CRTOWT,	DCA	CHAR	/ SAVE CHAR
	JMS	CTRLC	/ TEST FOR ^C
	TAD	CHAR
CRTOUT,	VTSF		/ WAIT FOR FLAG
	JMP	CRTOWT
	VTLS		/ OUTPUT CHAR
	JMP	PUTRTN
/
/	ASSIGN LOGICAL TO PHYSICAL UNIT
/
/	NAME	UNIT
/
/	TTY	SYSTEM TERMINAL
/	CRT	SECOND TERMINAL
/	LPT0	DEC - LINEPRINTER
/	LPT1	CENTRONICS PRINTER
/	PTP	PAPER TAPE PUNCH
/	PTR	PAPER TAPE READER
/	CDR	CARD READER
/	FIN	OS/8 FILE INPUT
/	FOU	OS/8 FILE OUTPUT
/	BTI	BATCH INPUT
/	BTO	BATCH OUTPUT
/
/	FORMAT OF REFERENCE TABLE
/
/	WORD 0	HASHED DEVICE NAME
/	WORD 1	INPUT HANDLER ADDR ( OR 0 IF NONE )
/	WORD 2	OUTPUT DEVICE HANDLER ( OR 0 IF NONE )
/
PHYREF,	PHYREF#
	-5564;	TTYIN;	TTYOUT	/ TTY
	-2762;	CRTIN;	CRTOUT	/ CRT
	-4100;	0;	LPTOUT	/ LPT
	-4101;	0;	C101	/ CENTRONICS
	-4064;	0;	HSPOUT	/ PTP
	-4264;	HSPIN;	0	/ HSR
	-2450;	GENIN;	0	/ FIN
	-3357;	0;	GENOUT	/ FOU
	-2544;	CDRIN;	0	/ CDR
	-1364;	BATIN;	0	/ BTI
	-2200;	0;	BATOUT	/ BTO
/
	DUMMY	ARG1
	DUMMY	ARG2
XARG,	XARG
ARG1,	BLOCK	2
ARG2,	BLOCK	2
ASSIG,	BLOCK	2	/ ASSIGN A LOGICAL UNIT
	TAD	ASSIG
	DCA	CDF1
	TAD	(-4
	DCA	TEMP
	TAD	XARG
	DCA	XR10	/ AUTOINDEX
CDF1,	HLT
	TADI	ASSIG#
	DCA I	XR10
	ISZ	TEMP
	JMP	CDF1
	TAD I	ARG1	/ GET LUN
	MQL		/ SAVE FOR LATER
	TAD I	ARG2	/ GET NAME
	INC	ARG2#
	TAD I	ARG2
	DCA	TEMP
	TAD	PHYREF
	DCA	CHAR
PHYLP,	TADI	CHAR
	TAD	TEMP
	SZA CLA		/ NAME FOUND ?
	JMP	PHYNX	/ NO: TRY NEXT ONE
	MQA		/ GET LUN
	TAD	LUNREF	/ ADD TABLE ADDR
	DCA	TEMP	/ POINTER TO INPUT HANDLER ADDR
	INC	CHAR
	TADI	CHAR	/ GET INPUT HANDLER
	SNA
	JMP	PHY1	/ GO HANDLE OUTPUT
	DCAI	TEMP
PHY1,	INC	TEMP
	INC	CHAR
	TADI	CHAR	/ GET OUTPUT HANDLER
	SNA
	JMP	PHY2
	DCAI	TEMP
PHY2,	RETRN	ASSIG	/ RETURN
PHYNX,	INC	CHAR
	INC	CHAR
	JMP	PHYLP
/
	PAGE
/
	END