software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape3 / UTILTY.SB

/UTILITY SUBROUTINE PACKAGE               OS8 FORTRAN II LIBRARY
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/UTILITY SUBROUTINE PACKAGE               OS8 FORTRAN II LIBRARY
\f/	VERSION 10A (APRIL 28, 1977)
/	VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
/
	ENTRY	OPEN	     /INITIALIZING AND FLAG SETTING ROUTINE
	ENTRY	GENIO
	ENTRY	EXIT		/EXIT TO DISK MONITOR SYSTEM
	ENTRY	ERROR
	ENTRY	CKIO	/USELESS ROUTINE
	OPDEF	KRS	6034
	OPDEF	KCC	6032
	OPDEF TADI 1400
	OPDEF DCAI 3400
	OPDEF	JMSI	4400
	OPDEF JMPI 5400
/	CARD READER IOT'S
	OPDEF	RCSE	6672
	OPDEF	RCSP	6671
	OPDEF	RCSF	6631
	OPDEF	RCRA	6632
/LINE PRINTER IOT'S
	OPDEF	LLB	6666
	OPDEF	LSF	6661

	LAP

U17,	17		/*** MUST BE FIRST LOC IN PAGE ***

IOER,	1117
	0522		/"IOER" ERROR
GENIO,	BLOCK	1
	10			/GENERAL INPUT/OUTPUT ROUTINE
	DCA	7	/SAVE ENTRY AC
GENLP,	TAD	7
	RTL
	RTL
	RAL
U200,	AND	U17
	TAD	JMPITB
	DCA	DSPACH	/INDEX JUMP TABLE BY DEVICE NUMBER
	TAD	U200
	KRS
	TAD	UM203
	SNA CLA
	KSF		/CHECK FOR ^C ON TELETYPE
DSPACH,	NOP		/NO ^C - DISPATCH TO I/O ROUTINE
	CALL	0,EXIT

JMPITB,	JMPI	DEVTAB
DEVTAB,	TTYOUT
	HSPOUT
	LPTOUT
	GENOUT
	TTYIN
	HSRIN
	CDRIN
	GENIN
	TTYFUJ		/FUDGE - SEE TELETYPE INPUT ROUTINE
	IOERR
	IOERR
	IOERR
	IOERR
	IOERR
	IOERR
	IOERR

HSPOUT,	PSF
	JMP	GENLP
	TAD	7
	PLS
GENRTN,	CLA
	RETRN	GENIO

TTYIN,	KSF
	JMP	GENLP
	CLA CLL CML RTR	/****DEPENDS ON NUMBER OF DEVICES ****
	JMP	GENLP	/TEST FOR ^C ONE LAST TIME

HSRIN,	ISZ	T1
	JMP	HSRSF
	TAD	U336	/TIME OUT-PRINT '^'
	TLS
HLP,	KSF
	JMP	HLP
	AND	U200	/GET 200 INTO AC 
	KRS		/READ THE CHAR.
	TAD	UM203
	SZA	CLA	/IS IT CONTROL C?
	KCC		/NO-CLEAR FLAG
	RFC		/USER TYPED-TICKLE RDR-FALL THRU RFC
HSRSF,	RSF
	JMP	GENLP
	DCA	T1
	RRB RFC
	JMP	GENRTN#
U336,	336
T1,	0

UM203,	-203
PCDRGC,	CDRGCH		/USED TO FORCE DF=CURRENT WHEN NECESSARY
CDR215,	215
CDR100,	100
CDR240,	240
PCDRTB,	CDRTBL		/CONVERSION FROM CARD CODE TO ASCII-240
CDRCT,	0
CDRLEN,	0
CDRIN,	TAD	CDRCT
	SNA CLA
	JMP	CDRNXT	/NEW CARD NECESSARY
	ISZ	CDRCT	/ADVANCE TO NEXT COLUMN
	JMP	CDRGET
	TAD	CDR215	/NO MORE - SEND A CARRIAGE RETURN
	JMP	GENRTN#

CDREST,	KSF
	JMP	CDRTST
	KCC
CDRNXT,	RCSE
	JMP	GENLP	/CHECK FOR ^C WHILE WAITING FOR NEXT CARD
CDRTST,	RCSP
	JMP	CDRCOL	/NOT END OF CARD YET
	TAD	CDRCT	/END OF CARD - SET UP FOR EXTRACTION OF CHARS
	CIA
	DCA	CDRLEN
CDRGET,	TAD	CDRCT
	TAD	CDRLEN	/FORM CHAR POINTER INTO TABLE AT 10100
	CLL RAR
	TAD	CDR100
	6211
	JMSI	PCDRGCH	/INDEX TABLE AND PULL OUT CHAR (DF=10)
	TAD	CDR240	/CHANGE TO ASCII
	JMP	GENRTN#	/RETURN
CDRCOL,	RCSF		/ANYTHING YET?
	JMP	CDREST	/KEEP LOOKING
	RCRA		/READ IT
	CLL RAR
	TAD	PCDRTB
	JMS I	PCDRGC	/GET TABLE ENTRY, FORCING DATA FIELD CURRENT
	DCA	CDRLEN	/SAVE IT TEMPORARILY
	TAD	CDRCT
	CIA
	CLL RAR
	TAD	CDR100	/INDEX TABLE AT LOC 10100
	DCA	DSPACH
	6211		/CDF 10
	TAD	CDRLEN
	SZL		/WHICH HALF?
	JMP	CDNORT	/RIGHT HALF
	RTL
	RTL
	RTL
	SKP
CDNORT,	TADI	DSPACH	/ADD EXISTING LEFT HALF
	DCAI	DSPACH	/SAVE UPDATED ENTRY
	CLA CMA
	TAD	CDRCT
	DCA	CDRCT	/UPDATE COLUMN POINTER
	JMP	CDRCOL


	PAGE
\fU377,	377		/MUST BE FIRST LOC IN THIS PAGE
GENIN,	6201
	TADI	IHNDLR
	SNA CLA		/OPEN INPUT FILE?
	JMP	IOERR	/NO
	6202
	JMS I	FICHAR	/GET A CHAR
	JMP	IOERR	/INPUT ERROR
UU200,	AND	U377
GRTN2,	RETRN	GENIO

GENOUT,	6201
	TADI	OHNDLR
	SNA CLA		/OPEN OUTPUT FILE?
	JMP	IOERR	/NO
	6202
	TAD	7	/GET CHAR TO BE OUTPUT
	AND	U377
	JMS I	FOCHAR	/PUT A CHARACTER
	JMP	IOERR	/OUTPUT ERROR
	JMP	GRTN2

IHNDLR,	122		/***ALL THESE LOCATIONS ARE VERY VOLATILE!! ***
FICHAR,	606		/*******
OHNDLR,	121		/*******
FOCHAR,	651		/******************

/
/	INITIALIZING SUBROUTINE CALLED BY FORTRAN
/	CLEARS FLOATING AC AND SETS FLAGS
/
OPEN,	BLOCK	1
	10
	TAD	(212
	TLS	/PUT LINE-FEED ON TTY
	LLB	/INITIALIZE LPT
	KCC	/CLEAR KEYBOARD FLAG (AND AC)
	PLS
	RFC
	CALL	0,CLEAR
	6201
	DCAI	IHNDLR
	DCAI	OHNDLR		/ZERO DEVICE-INDEPENDENT IO FLAGS
	RETRN	OPEN


LPTOUT,	LSF
	JMP	GENLP
	TAD	7
	ISZ	PFSTCH
	JMP	NOFST
	TAD	(-1262	/LOOK FOR CONTROL CHARS IN PRINT POSITION 1
	CLL IAC
	IAC
	SNL
	JMP	DCACH
	CLL RAL
	TAD	(212
NOFST,	LLB
	TAD	(-1212
DCACH,	SNA CLA		/IF LINE FEED
	CMA		/SET "FIRST CHAR" SWITCH ON
	DCA	PFSTCH
	JMP	GRTN2
PFSTCH,	-1

TTYFUJ,	TAD	UU200
	KRS
	DCA	7	/SAVE KEYBOARD CHAR
	KCC		/CLEAR FLAG
	TAD	7
	TAD	(-212
	SZA CLA
	JMS	TYPE
	TAD	7
	TAD	(-215
	SZA CLA
	JMP	TYRTN
	CLA CLL CMA RTL
	JMS	TYPE
TYRTN,	TAD	7
	JMP	GRTN2	/RETURN WITH CHAR IN AC

TYPE,	0
	TAD	7
TYPELP,	TSF
	JMP	TYPELP
	TLS
	CLA
	JMPI	TYPE

TTYOUT,	JMS	TYPE
	JMP	GRTN2

IOERR,	CALL	1,ERROR
	ARG	IOER

CDRTBL,	0021;2223;2425;2627
	3031;3203;4007;3502
	2017;6364;6566;6770
	7172;7514;0577;3637
	1552;5354;5556;5760
	6162;0104;1211;3374
	0641;4243;4445;4647
	5051;7316;3410;1376

	PAGE
\f
PMESG,	MESG
MESG,	7777
	7777
	4005
	2222
	1722
	4001
	2440
	1417
	0340
LIT7,	0007

ERROR,	BLOCK	1
	10			/ERROR PROCESSOR
U7600,	7600
	TAD	ERROR
	DCA	TEM1
TEM1,	NOP		/SET DATA FIELD OF "CALL ERROR"
	TADI	ERROR#
	DCA	TEM3
	INC	ERROR#
E60,	CLA CMA CML	/CML IS WINDOW DRESSING
	TADI	ERROR#
	DCA	10
	INC	ERROR#
TEM3,	NOP		/DATA FIELD OF MESSAGE&ENTRY POINT
	DCA	CKIO	/ZERO "FATAL ERROR" FLAG
	TADI	10
	RAL
	SZL		/NON-FATAL BIT ON?
	ISZ	CKIO	/YES - SET "FATAL FLAG" TO NON-FATAL
	CLL RAR		/STRIP NON-FATAL BIT FROM MESSAGE
	DCA	MESG
	TADI	10	/SECOND WORD OF MESSAGE
	DCA	MESG#
	TADI	10
	DCA	TEM1
	TADI	10
	DCA	TEM3	/CALLING ADDRESS
	TAD	PMESG
	DCA	TEM2

ERLP,	TAD I	TEM2
	RTR
	RTR
	RTR
	JMS	PR6BIT
	TAD I	TEM2
	JMS	PR6BIT
	INC	TEM2
	JMP	ERLP

PRLOC,	TAD	TEM1
	RTR
	RTR
	JMS	ERTTY	/PRINT CALLING FIELD
	TAD	(-4
	DCA	TEM2
NUMLP,	TAD	TEM3
	RTL
	RAL
	DCA	TEM3
	TAD	TEM3
	JMS	ERTTY
	ISZ	TEM2
	JMP	NUMLP
	TAD	(215
	DCA	7
	JMS	TYPE
	CLA CLL CMA RTL
	JMS	TYPE
	TAD	CKIO	/GET THE FATAL ERROR FLAG
	SNA CLA		/WHADDOWEDO??
	JMP	EXITX
	RETRN	ERROR	/HE SAYS ITS NON-FATAL - LET HIM HANDLE IT

ERTTY,	0	/DIGIT PRINTING ROUTINE
	RAL
	AND	LIT7
	TAD	E60
	JMS	PR6BIT
	JMP I	ERTTY

PR6BIT,	0		/6BIT TO 8BIT CONVERTOR
	AND	(77
	SNA
	JMP	PRLOC	/MESSAGE OVER
	TAD	(7740
	SPA
	TAD	(100
	TAD	(240
	CALL	0,GENIO	/LOOK FOR ^C WHILE TYPING
	JMP I	PR6BIT

/
/EXIT TO DISK MONITOR SYSTEM
/
EXIT,	BLOCK	1
	10
EXITX,	CALL	0,CKIO
	6203
	JMPI	U7600	/RETURN TO MONITOR

CKIO,	0
TEM2,	10	/DUMMY SUBROUTINE TO WAIT FOR I/O COMPLETE
CKWAIT,	6041
	JMP	CKWAIT
	RETRN	CKIO

CDRGCH,	0	/GET A CHAR FROM A PACKED TABLE
	DCA	TEM2	/WORD PTR IN AC, LEFT/RIGHT SW IN LINK
	TADI	TEM2	/PRESERVE ENTRY FIELD
	SZL
	JMP	CDRAND	/RIGHT HALF
	RTR
	RTR
	RTR
CDRAND,	AND	CDR77
	JMP I CDRGCH	/RESTORE CURRENT FIELD AND GET OUT
CDR77,	77

	END
\f