Directory of image this file is from
This file as a plain text file

	FIELD	0
	*200
START,	JMP I	.+1
	BEGIN			/BEGIN PROGRAM
/
/	MESG	GENERAL MESSAGE OUTPUT ROUTINE
/
/	CDF	N0		/CALLED FROM FIELD N
/	CIF	00		/MESG IS IN FIELD 0
/	JMS I	 MESG		/CALL
/	 ADDR;CDF M0;FUNC	/ADDR IS ADDRESS OF MESSAGE
/				/M=FIELD OF MESSAGE
/				/FUNC=0, USE CONSOLE FOR OUTPUT
/				/FUNC=1, USE OSIO PUT FOR OUTPUT
	ZBLOCK	5		/TEMPORARIES FOR MESG
MESG,	.-.
	CLA CMA
	TAD I	MESG		/SAVE POINTER
	DCA	MESG-1
	ISZ	MESG		/FOR RETURN
	TAD I	MESG		/GET CDF INSTRUCTION
	ISZ	MESG
	DCA	MES5+1		/SAVE FOR GET OF CHAR
	TAD I	MESG		/GET FUNCTION
	SNA CLA
	TAD	(MES6-PUT	/PUT TO CONSOLE
	TAD	(PUT
	DCA	MESG-5		/SAVE OUTPUT ADDRESS
	RDF			/GET CALLERS FIELD
	TAD	.+2		/+CDF CIF 00
	DCA	MES5-2		/SAVE FOR EXIT
	CDF CIF 00
	TAD	(377
	DCA	MESG-4
MES1,	CLA CMA
	DCA	MESG-2		/UNPACK SWITCH
	ISZ	MESG-1		/NEXT WORD
	JMS	MES5		/FETCH WORD
	RTR
	RTR
	RTR
MES2,	AND	(77		/MASK 6 BITS
	SNA
	JMP	MES5-2		/YES
	TAD	(240		/RECODE
	AND	(77		/CHARACTER TO
	TAD	(240		/BE PRINTED
	DCA	MESG-3
	TAD	MESG-3
	TAD	(-"%		/CTRL CHAR?
	SZA CLA
	JMP	MES3		/NO
	TAD	(277		/SET MASK
	DCA	MESG-4		/AND SAVE IT
	JMP	MES4
MES3,	TAD	MESG-3		/GET CHARACTER
	AND	MESG-4		/MASK IT
	JMS I	MESG-5		/PUT OUT THE CHARACTER
	TAD	(377		/RESET MASK
	DCA	MESG-4
MES4,	ISZ	MESG-2		/TEST L-R SWITCH
	JMP	MES1		/LEFT
	JMS	MES5		/RIGHT
	JMP	MES2
	0-0			/BECOMES CDF CIF N0
	JMP	MES5-2
MES5,	.-.
	0-0			/BECOMES CDF M0
	TAD I	MESG-1		/GET THE WORD
	CDF CIF 00
	JMP I	MES5
MES6,	.-.
	TLS
	TSF
	JMP	.-1
	CLA
	JMP I	MES6

	PAGE
	0-0			/TEMPORARY
PUT,	.-.
	DCA	PUT-1		/SAVE CHARACTER
	RDF			/GET CALLERS FIELD
	TAD	.+1
	CDF CIF 00
	DCA	PUT10-2 	/SAVE FOR EXIT
	TAD	PUT-1		/GET IT BACK
	TAD	(-"Z+100	/CTRLZ?
	SNA CLA
	JMP	PUT10		/YES, END IT
	TAD	PUT-1		/GET IT BACK
	CIF	10
	JMS I	(OCHAR		/PUT OUT THE CHAR
	JMP	PUT20		/OUTPUT ERROR
	0-0			/EXIT CDF CIF
	JMP I	PUT		/DONE, EXIT
PUT10,	CIF	10		/CLOSE THE FILE
	JMS I	(OCLOSE
	JMP	PUT30		/CLOSE ERROR
	JMP	PUT10-2 	/EXIT
PUT20,	JMS	ERROR
	 1			/OUTPUT ERROR
PUT30,	JMS	ERROR
	 2			/CLOSE ERROR

GET,	.-.
	CLA CLL
	RDF
	TAD	PUT+4
	DCA	GET10
	CIF	10
	JMS I	(ICHAR		/GET A CHAR
	SKP			/SKIP IF ERROR
	JMP	GET10
	SMA CLA
	JMP	GET10-1 	/EOF, RETURN CTRLZ
	JMS	ERROR
	 3			/INPUT ERROR
GET10,	0-0
	TAD	("Z-100
	JMP I	GET		/EXIT WITH IT
	SMA CLA 		/SKIP IF FATAL ERROR
	IAC
	TAD	(5
	JMP	ERROR+3

ERROR,	.-.
	CLA CLL
	TAD I	ERROR
	DCA	.+4
	CIF	10
	JMS I	(200
	7
	0-0			/ERROR CODE

	-1;-14;7642;0-0;0-0
OPTION, .-.
	DCA	OPTION-2
	RDF
	TAD	PUT+4
	DCA	OPTI10		/SAVE FOR EXIT
	TAD	OPTION-3
	DCA	OPTION-1
	TAD	OPTION-2
	TAD	OPTION-4
	ISZ	OPTION-1
	SMA SZA
	JMP	.-3
	TAD	OPTION-5
	DCA	OPTION-2
	CLL CML
	RAL
	ISZ	OPTION-2
	JMP	.-2
	CDF	10
	AND I	OPTION-1
OPTI10, 0-0			/BECOMES EXIT CDF CIF
	JMP I	OPTION		/AC=0, OPTION OFF, AC=1, OPTION ON
	PAGE
/OSIO.PA--OS8 I/O ROUTINE PARAMETER DEFINITIONS
OUBUF=6200;OUCTL=4210	/2 PAGE OUTPUT BUFFER STARTS AT 16200
OUDEVH=6600		/1 OR 2 PAGE OUTPUT HANDLER LOADED AT 06600
INBUF=5600;INCTL=0210	/2 PAGE INPUT BUFFER STARTS AT 15400
INDEVH=7200		/1 OR 2 PAGE INPUT HANDLER AT 7200.
ORIGIN=6600		/THE SUBROUTINES RESIDE AT 16600.
/
/	CORE MAP
/
/	00000-06577	USER AVAILABLE
/	06600-07177	OUTPUT DEVICE HANDLER
/	07200-07577	INPUT DEVICE HANDLER
/	10000-10777	USR RESERVED
/	12000-11577	USER AVAILABLE
/	15600-16177	INPUT BUFFER
/	16200-16577	OUTPUT BUFFER
/	16600-17577	OSIO SUBROUTINES
/
	EJECT
	XLIST
INRECS=1		/2 PAGES = 1 RECORD
DCB=7760		/DEVICE CONTROL TABLE
	FIELD 1
	*ORIGIN
INFLD=INCTL&70		/INPUT BUFFER FILED
OUFLD=OUCTL&70		/OUTPUT BUFFER FIELD
IN7400, 7400
IOPEN,	0		/INITIALIZE INPUT
	CLA CMA
	DCA INCHCT	/SET TO READ FROM NEW DEVICE.
	ISZ INEOF	/FORCE A NEW INPUT FILE.
	TAD (7617	/POINT TO CD INPUT LIST.
	DCA INFPTR
	TAD	IOPEN	/GET CALLERS ADDRESS
	JMP	IOPENE	/AND CONTINUE SOMEWHERE ELSE
INEOF,	0
INFPTR, 0
INPTR,	0
ICHAR,	0		/INPUT A CHARACTER.
IN7600, 7600
	RDF		/SAVE CALLING FIELD FOR RETURN
	TAD INCDIF
	DCA INRTRN
INCHAR, CDF INFLD	/DATA FIELD TO FIELD OF BUFFER
	ISZ INJMP	/3 - WAY UNPACKING SWITCH
	ISZ INCHCT	/INPUT BUFFER EXHAUSTED?
INJMPP, JMP INJMP	/NO..UNPACKTHE NEXT CHAR.
	TAD INEOF	/DID LAST READ GIVE EOF ON THIS DEVICE?
	SNA CLA
	JMP INGBUF	/NO. CONTINUE READING.
GETNEW, JMS INNEWF	/YES..GET NEXT INPUT IF IT EXISTS.
	JMP EOFERR	/TAKE EOF EXIT FROM ICHAR.
INGBUF, TAD INCTR	/INCTR HOLDS THE CURRENT LENGTH OF
			/THE INPUT FILE. WHEN THE AMOUNT REMAINING
			/TO READ IS LESS THAN THE SIZE OF THE
			/INPUT BUFFER, AN EOF IS SIGNALLED.
	CLL
	TAD (INRECS
	SNL
	DCA INCTR	/UPDATE REMAINING LENGTH
	SZL
	ISZ INEOF	/AND SIGNAL EOF FOR NEXT READ.
	CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THIS
	RTR		/READ FROM THE OVERFLOW, IF ANY,
	RTR		/AND THE STANDARD CONTROL WORD.
	TAD (INCTL+1
	DCA INCTLW
INCDIF, CIF CDF 0	/NOW DO A CALL TO THE INPUT HANDLER
	CDF 10		/WE ARE IN FIELD 1, HANDLER IN FIELD 0
	JMS I INHNDL
INCTLW, 0		/INPUT CONTROL WORD
INBUFP, INBUF		/INPUT BUFFER ADDRESS
INREC,	0		/POINTER TO INPUT RECORD
	JMP INERRX
INBREC, TAD INREC
	TAD (INRECS	/UPDATE POINTER INTO FILE
	DCA INREC
	TAD INCTLW	/NOW COMPUTE THE NUMBER OF CHARACTERS
	AND IN7600	/IN THIS INPUT BUFFER
	CLL RAL
	TAD INCTLW
	AND IN7600
	CMA
	DCA INCHCT	/NEW NUMBER OF CHARACTERS.
	TAD INJMPP	/RESET 3 WAY SWITCH
	DCA INJMP
	TAD INBUFP
	DCA INPTR	/AND BUFFER POINTER
	JMP INCHAR	/NOW READ THE BUFFER
INERRX, ISZ INEOF	/SET EOF JUST IN CASE
	SMA CLA 	/IF<0, A PHYSICAL ERROR
	JMP INBREC	/EOF ON INPUT
INERR,	CLA CLL CML RAR /FATAL
EOFERR, JMP INRTRN	/GET OUT
INJMP,	HLT		/3 WAY UNPACK SWITCH
	JMP ICHAR1	/GET 1ST OF 3
	JMP ICHAR2	/SECOND
ICHAR3, TAD INJMPP
	DCA INJMP	/SET FOR FIRST CHAR. NEXT
	TAD I INPTR	/THE THIRD WORD IS MADE OF THE HIGH
IN200,	AND IN7400	/ORDER FOUR BITS OF THE FIRST
	CLL RTR 	/TWO.
	RTR
	TAD INCTLW
	RTR
	RTR
	ISZ INPTR	/POINT TO NEXT WORD
	JMP INCOMN	/GET OUT  WITH CHAR IN AC
ICHAR2, TAD I INPTR
	AND IN7400	/SAVE HIGH ORDER FOR THIRD WORD
	DCA INCTLW
	ISZ INPTR
ICHAR1, TAD I INPTR
INCOMN, AND (377
	TAD (-232	/IS IT A  Z (EOF)?
	SNA
	JMP GETNEW	/YES..LOOK AT NEXT INPUT
	TAD (232
	ISZ ICHAR	/TAKE NORMAL RETURN
INRTRN, 0		/CIF CDF N.
	JMP I ICHAR
INNEWF, -1
INCHCT=INNEWF
	CDF 10
	TAD (INDEVH+1	/INITIALIZE IN CALSE WE NEED A NEW
	DCA INHNDL	/MORE INPUT?
	TAD I INFPTR
	SNA
	JMP I INNEWF	/NOPE
	JMS I IN200	/CALL MONITOR TO GET HANDLER
	1
INHNDL, 0
	HLT		/VERY BAD!
	TAD I INFPTR
	AND (7760	/GET INPUT FILE LENGTH
	SZA
	TAD (17
	CLL CML RTR
	RTR		/NEGATIVE OF FILE LENGTH
	DCA INCTR
	ISZ INFPTR	/POINT TO STARTING BLOCK
	TAD I INFPTR
	DCA INREC	/STORE IN HANDLER CALL
	ISZ INFPTR	/NEXT INPUT.
	DCA INEOF	/CLEAR EOF FLAG.
	ISZ INNEWF
	JMP I INNEWF
	INCTR=IOPEN
	PAGE
OOPEN,	0		/OPEN OUTPUT FILE
OU7600, 7600
	RDF
	TAD	(CDF CIF 00
	DCA	OORETN
	CDF CIF 10
	TAD OU7601	/POINT TO OUTPUT FILE NAME IN CD
	DCA OUBLK	/AREA
	TAD (OUDEVH+1
	DCA OUHNDL	/INITIALIZE OUTPUT DEVICE HANDLER
	TAD I OU7600	/PICK UP OUTPUT DEVICE NUMBER
	AND (17
	SNA		/IS THERE ONE?
	JMP ONOFIL	/NO..INHIBIT OUTPUT
	JMS I (200	/FETCH OUTPUT HANDLER
	1
OUHNDL, 0
	HLT		/BAD THING
OUENTR, TAD I OU7600
	JMS I (200	/ENTER THE OUTPUT FILE
	3
OUBLK,	7601		/GETS STARTING BLOCK OF HOLE
OUELEN, 0		/GETS SIZE OF HOLE AVAILABLE
	JMP OEFAIL	/FAILURE. SEE WHAT WE DID.
	DCA OUCCNT	/CLEAR CLOSING LENGTH
	DCA I  (OUTINH	/CLEAR OUTPUT INHIBIT
	JMS I (OUSETP	/SET UP POINTERS
	ISZ OOPEN
OORETN, CDF CIF 10
	JMP I OOPEN	/RETURN O.K.
OEFAIL, TAD I OU7600	/IFLENGTH=0, GIVE OPEN ERROR
	AND (7760	/IF NOT, MAKE IT 0 AND TRY AGAIN
	SNA CLA
	JMP ONTERR	/WAS 0, FAILED
	TAD I OU7600
	AND (17 	/MAKE IT 0
	DCA I OU7600
	JMP OUENTR	/AND TRY AGAIN
ONTERR, CLA CLL CML RAR
	JMP OORETN
ONOFIL, ISZ I (OUTINH	/INHIBIT OUTPUT
	JMP OORETN
OUTDMP, 0		/DUMP OUTPUT BUFFER
	DCA OUCTLW	/STORE CONTROL WORD
	CDF 10
	TAD I (OUTINH	/IS OUTPUT INHIBITED?
	SZA CLA
	JMP OUNOWR	/YEP.
	TAD OUCCNT	/IF THIS IS FIRST WRITE, START THE
	SNA		/SEARCH FORWARD ON DECTAPE
	ISZ OUCTLW
	TAD OUBLK	/GET STARTING BLOCK OF THIS
	DCA OUREC	/TRANSFER
	TAD OUCTLW
	CLL RTL
	RTL
	RTL		/COMPUTE # OF RECORDS TO OUTPUT
	AND (17
	TAD OUCCNT	/UPDATE CLOSING LENGTH
	DCA OUCCNT
	TAD OUCCNT	/SEE IF CLOSING LENGTH WILL BE
	CLL CML 	/BIGGER THAN OUTPUT HOLE
	TAD OUELEN
	SNL SZA CLA
	JMP I OUTDMP	/WILL BE TOO BIG
OUCDIF, CIF CDF 0
	CDF 10
	JMS I OUHNDL	/DO THE WRITE
OUCTLW, 0
	OUBUF
OUREC,	0
	SKP		/ERROR
OUNOWR, ISZ OUTDMP	/TAKE NORMAL RETURN
	JMP I OUTDMP
	PTP=0020
	PAGE
OCLOSE, 0		/CLOSE OUTPUT FILE
OC7600, 7600		/DON'T TRUST ANYONE
	RDF		/GET USERS FIELD
	TAD	(CDF CIF 00
	DCA	OCRET	/SAVE FOR EXIT
	CDF 10
	TAD I (OUTINH	/IF OUTPUT INHIBITED, CLOSE IS A NOP.
	SZA CLA
	JMP OCISZ	/A NOP
	JMS I (OTYPE	/DETERMINE IF OUTPUT IS TO PTP
	AND (770	/IF IT IS, DON'T OUTPUT A  Z.
	TAD (-PTP
	SZA CLA
	TAD (232	/NOT PTP. OUTPUT  Z AS EOF
	JMS I (OCHAR
	JMP OCRET	/ERROR RETURN
	JMS I (OCHAR	/FILL WITH 0 CHARACTERS
	JMP OCRET
FILLIP, JMS I (OCHAR	/FILL TO BOUNDARY WITH 0
	JMP OCRET
	JMS I (OTYPE	/IF OUTPUT IS DIRECTORY DEVICE, FILL
	SPA CLA 	/WHOLE RECORD, ELSE HALF RECORD
	TAD (100
	TAD (77
	AND I (OUDWCT	/ARE WE UP TO BOUNDARY YET?
	SZA CLA
	JMP FILLIP	/NO
	TAD I (OUDWCT
	TAD (OUCTL&3700 /IS THERE A FULL WRITE LEFT?
	SNA
	JMP NODUMP	/YES. BUT DON'T DO IT, AS  Z IS OUT.
	TAD (4000+OUFLD
	JMS OUTDMP	/DUMP LAST BUFFER
	JMP OCRET
NODUMP, TAD I OC7600	/GET DEVICE NUMBER
	JMS I (200	/CLOSE THE OUTPUT FILE
	4
OU7601, 7601		/POINTER TO FILE NAME
OUCCNT, 0		/CLOSING FILE LENGTH HERE
	SKP		/ERROR
OCISZ,	ISZ OCLOSE	/NORMAL RETURN
OCRET,	CDF CIF 10	/RESTORE CALLING FIELDS
	JMP I OCLOSE
	PAGE
OUSETP, 0	/INITIALIZE OUTPUT POINTERS
	TAD (OUCTL&3700
	CIA
	DCA OUDWCT	/DOUBLE WORD OUTPUT COUNT
	TAD (OUBUF	/INITIALIZE WORD POINTER
	DCA OUPTR
	TAD OUJMPE
	DCA OUJMP	/3 WAY UNPACK SWITCH
	JMP I OUSETP
OCHAR,	0		/OUTPUT CHARACTER ROUTINE
	AND (377	/ISOLATE EIGHT BITS
	DCA OUTEMP
	RDF		/GET FIELD WE WERE CALLED
	TAD (CIF CDF 0	/FROM
	DCA OUCRET
	TAD OUTINH	/OUTPUT INHIBITED?
	SZA CLA
	JMP OUCOMN	/YES. NOP.
OUCHAR, CDF OUFLD	/GO TO DATA FIELD OF BUFFER
	ISZ OUJMP	/BUMP CHARACTER SWITCH
OUJMP,	HLT		/GETS JMP.,JMP.+1,ETC.
	JMP OCHAR1
	JMP OCHAR2
OCHAR3, TAD OUTEMP	/THIRD CHAR
	CLL RTL 	/HIGH ORDER BITS GO INTO THE
	RTL		/HIGHORDER 4 BITS OF THE
	AND (7400	/FIRST OF TWO WORDS
	TAD I OUPOLD
	DCA I OUPOLD
	TAD OUTEMP	/THE SECOND DOUBLE WORD GETS
	CLL RTR 	/THE LOW ORDER BITS OF
	RTR		/THE THIRD CHAR
	RAR
	AND (7400
	TAD I OUPTR
	DCA I OUPTR
	TAD OUJMPE	/RESET CHARACTER SWITCH
	DCA OUJMP
	ISZ OUPTR	/POINT TO NEXT BUFFER WORD
	ISZ OUDWCT	/BUMP DOUBLE COUNT AFTER
	JMP OUCOMN	/GET OUT
	TAD (OUCTL	/READY TO OUTPUT A BUFFER
	JMS I (OUTDMP	/OUTPUT IT
	JMP OUCRET	/AN ERROR
	JMS OUSETP	/RESET OUTPUT POINTERS
	JMP OUCOMN
OCHAR2, TAD OUPTR	/POINT TO FIRST DOUBLE WORD
	DCA OUPOLD
	ISZ OUPTR	/POINT OUPTR TO SECOND
OCHAR1, TAD OUTEMP
	DCA I OUPTR
OUCOMN, ISZ OCHAR	/NORMAL EXIT
OUCRET, HLT
	JMP I OCHAR
OUTEMP, 0
OUPOLD, 0
OUPTR,	0
OUJMPE, JMP OUJMP
OUDWCT, 0
OUTINH, 0
OTYPE,	0		/OTYPE LOOKS AT THE OUTPUT DEVICE #,
	RDF
	TAD (CIF CDF 0
	DCA OTRTN
	CDF 10
	TAD I (7600	/AND LOOKS UP THE DCB WORD FOR
	AND (17 	/THAT DEVICE.
	TAD (DCB-1
	DCA OUTEMP
	TAD I OUTEMP	/GET DCB ENTRY
OTRTN,	HLT
	JMP I OTYPE
/CONTINUE IOPEN
IOPENE, DCA	OTYPE		/SAVE OPENS EXIT ADDRESS
	RDF			/GET CALLERS FIELD
	TAD	(CDF CIF 00
	DCA	OTRTN		/SAVE FOR EXIT
	JMP	OTRTN		/AND EXIT
	XLIST
	$END$

$UPTR,	0
OUJMPE, JMP OUJMP
OUDWCT, 0
OUTINH, 0
OTYPE,	0		/OTYPE LOOKS AT THE OUTPUT DEVICE #,
	RDF
	TAD (CIF CDF 0
	DCA OTRTN
	CDF 10
	TAD I (7600	/AND LOOKS UP THE DCB WORD FOR
	AND (17 	/THAT DEVICE.
	TAD (DCB-1
	DCA OUTEMP
	TAD I OUTEMP	/GET DCB ENTRY
OTRTN,	HLT
	JMP I OTYPE