perm filename OCIO.MAC[SIM,SYS]1 blob sn#460151 filedate 1979-07-20 generic text, type T, neo UTF8
	SUBTTL	WRITTEN BY OLOF BJ@RNER DEC 1973

	SEARCH	SIMMAC,SIMMCR,SIMRPA
	SALL
	RTITLE	OCIO
	ERRMAC	OC
	MACINIT

COMMENT ;

This module contains routines common to IO and OCIN (and OCEP).
It contains the following subroutines:

FILEERROR/ERRFILE	outputs standard error message
FREEBUFF		releases a used buffer area in the buffer pool
GETCHANNEL		allocates a free I/O channel
LINKBUFF		links a buffer ring
GETNAME/GETREST		packs next name from a file specification
OUTOCT			Types last 9 bits of X0 in octal
TYPENAME		prints a name stored in SIXBIT on TTY
TYPDEC			types a decimal integer
TYPOCT			types an octal integer
TYPESPEC		types a full file spec from ZBI, ZXB, ZYS (SFD)

This module is present in both run-time high segments.
;
	TWOSEG
	RELOC	400K

IFN QDEBUG,<
IOST:		;LABEL FOR DEBUGGING
>

DEFINE BREAKOUTIMAGE(A)=<
	SKPINC	;;CLEAR CONTROL-O
	NOP
	OUTSTR	[ASCIZ/A/]>

DEFINE OUTIMAGE(A)=<
	SKPINC
	NOP
	OUTSTR	[ASCIZ/A
/]>


COMMENT ;

ERROR MESSAGES IN THIS MODULE:
===============================

OCERC	QDSCON,0,Too many files	[41]
;

	PROCINIT(OCIO)
Comment ;

	ZBH record - buffer area
	=========================

Word no:
	I------------------I------------------I
   0	I	ZBHLEN	   I	   ZBHLNK     I  Bit 0: ZBHFRE, Bit 18: ZBHCON
	I------------------I------------------I
   1	I		   I	   ZBHZBU     I  Bit 0: ZBHUSE
   	I------------------I------------------I
   2	I		ZBHBUP		      I
	I-------------------------------------I
   3	I		ZBHCNT		      I
	I-------------------------------------I
   4	I		ZBUSTA		      I
	I------------------I------------------I
   5	I	ZBUSIZ	   I	  ZBUZBU      I  Bit 0: ZBUUSE
	I------------------I------------------I
   6	I		   I	  ZBUWCT      I
	I------------------I------------------I
   7	I		ZBUDAT		      I
	I-------------------------------------I


Words 1-3 comprise the buffer ring header and are immediately
followed by the buffer ring.

Explanations:

ZBHFRE		=1 means that this buffer area is available
ZBHLEN		includes ZBHFRE and contains total length of
		this buffer area. The length is positive if
		the area is in use else negative.
ZBHCON		=1 if this area immediately follows the
		previous area (it might be preceded by the
		IOSPEC table)
ZBHLNK		pointer to next buffer area or -1 if
		it is the last buffer area
ZBHUSE		use bit for the buffer ring
ZBHZBU		pointer to current buffer
ZBHBUP		buffer byte pointer
ZBHCNT		no of bytes remaining in buffer
ZBUSTA		file status
ZBUUSE		use bit for this buffer
ZBUSIZ		file size
ZBUZBU		pointer to next buffer in the ring
ZBUWCT		word count for this buffer
ZBUDAT		data
;
	SUBTTL	LOCAL SUBROUTINE: FILEERROR/ERRFILE

COMMENT ;

PURPOSE:	TO PRINT THE STANDARD ERROR MESSAGE:
		ERROR FOR xxxxFILE: <FILE SPEC>
		ON TTY. xxxx::=/IN/OUT/PRINT/DIRECT.
ENTRIES:	.IOFER (FILEERROR)
		.IOERF (ERRFILE)
INPUT ARGUMENT:	XCB POINTS TO FILE OBJECT IF FILERROR ELSE XWAC1
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
USED ROUTINES:	BREAKOUTIMAGE
		TYPENAME
USED REGISTERS:	X0
ERROR MESSAGE:	-
;

.IOFER:	L	XCB	;[61]
	BREAKOUTIMAGE <ERROR FOR >
	BRANCH	.IOTYS	;[61]

.IOERF:	L	XWAC1	;[61]
	GOTO	.IOFER+1
	SUBTTL	FREEBUFF

COMMENT ;
PURPOSE:	TO FREE A BUFFER AREA AND LINK IT WITH THE
		SURROUNDING BUFFER AREAS (IF ANY).
		SINCE THE BUFFERS ARE ONLY LINKED IN THE FORWARD
		DIRECTION, FREEBUFF STARTS FROM THE BEGINNING OF
		OF THE BUFFER AREA AND LOOKS UP THE CURRENT BUFFER,
		SAVING THE ADDRESS OF THE PREVIOUS BUFFER.
ENTRY:		.OCINC
INPUT ARGUMENTS:
		X1 CONTAINS ADDRESS TO THE BUFFER AREA
OUTPUT ARGUMENT:	-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	FREEBUFF
USED ROUTINES:	OCINF1 (DEFINED LOCALLY IN FREEBUFF)
USED REGISTERS:	X0,X1,X2,X3
		X2 AND X3 ARE SAVED
ERROR MESSAGES:	-
;

.OCINC:	PROC
	SAVE	<X2,X3>
	L	X2,YOCBST(XLOW)
L1():!
	IF	;THIS IS NOT THE CURRENT BUFFER
		CAMN	X2,X1
		GOTO	FALSE
	THEN	;SEE IF IT IS THE PREVIOUS
		LF	X0,ZBHLNK(X2)
		IF	;IT WASN'T
			CAMN	X1,X0
			GOTO	FALSE
		THEN	;TRY NEXT
			L	X2,X0
			GOTO	L1
		FI
		FREE	(X2)
		GOTO	FALSE		;IF USED
		IFOFF	ZBHCON(X2)
		GOTO	FALSE		;OR NOT CONSECUTIVE
		EXCH	X2,X1
		EXEC	OCINF1		;JOIN THE BUFFERS
	FI
	LF	X2,ZBHLNK(X1)	;SEE IF NEXT BUFFER CAN BE JOINED
	IF	;NOT LAST
		CAIN	X2,377777
		GOTO	FALSE
	THEN	IF	;NEXT BUFFER FREE AND CONSECUTIVE
			FREE	(X2)
			GOTO	FALSE
			IFON	ZBHCON(X2)
		THEN	;JOIN THEM
			EXEC	OCINF1
		FI
	FI
	LF	X0,ZBHLEN(X1)	;RELEASE BUFFER
	MOVN	X0,X0
	SF	X0,ZBHLEN(X1)
	RETURN
	EPROC

OCINF1:
	;X1 HERE SHOULD POINT TO THE BUFFER WITH LOWEST ADDRESS.
	;IF IT IS BACKWARD JOINING THEN THE FIRST BUFFER IS
	;FREE AND THE SECOND (THE BUFFER TO BE RELEASED) IS
	;OCCUPIED. IF IT IS FORWARD JOINING AFTER BACKWARD JOINING
	;THEN BOTH BUFFERS ARE FREE. IF IT IS FORWARD JOINING
	;WITHOUT PREVIOUS BACKWARD JOINING THEN THE FIRST
	;BUFFER (TO BE RELEASED) IS OCCUPIED AND THE SECOND IS FREE.
	;IN EACH CASE THE RESULT IS A NEW FREE BUFFER.

	LFE	X0,ZBHLEN(X2)	;COMPUTE NEW LENGTH
	SKIPG	X0,X0
	MOVN	X0,X0
	LFE	X3,ZBHLEN(X1)
	SKIPG	X3,X3
	MOVN	X3,X3
	ADD	X0,X3
	SF	X0,ZBHLEN(X1)
	LF	X0,ZBHLNK(X2)	;LOAD NEW LINK
	SF	X0,ZBHLNK(X1)
	RETURN
	SUBTTL	GETCHANNEL

COMMENT ;

PURPOSE:	TO FIND A FREE CHANNEL IN IOCHTB.
		IF NONE IS FOUND EXECUTION IS TERMINATED WITH AN ERROR MESSAGE.
ENTRY:		.OCIN8
INPUT ARGUMENT:	FILE OBJECT REFERENCE IN XCB
OUTPUT ARGUMENTS:
		X1 CONTAINS INDEX TO FREE ELEMENT IN IOCHTB.
NORMAL EXIT:	RETURN
ERROR  EXIT:	UUO TRAP IF NO CHANNEL AVAILABLE
CALL FORMAT:	GETCHANNEL
USED ROUTINES:	-
USED REGISTERS:
		X0-X1.
ERROR MESSAGE:	TOO MANY FILES
;

.OCIN8:	PROC
	LI	X1,YIOCHTB+1(XLOW)
	HRLI	X1,-↑D14
	LOOP	;UNTIL FREE CHANNEL FOUND
		IF	SKIPE	X0,(X1)
			GOTO	FALSE
		THEN	IF 	IFON	ZFIIF(XCB)
				GOTO	FALSE
			THEN	;STORE FILE OBJECT REF IN OUTPUT HALF
				HRLM	XCB,(X1)
			ELSE	;STORE FILE OBJECT REF IN INPUT HALF
				HRRM	XCB,(X1)
				IFON	ZFIDF(XCB)
				GOTO	TRUE	;STORE ALSO IN OUTPUT HALF IF DIRECTFILE
			FI
			SUBI	X1,YIOCHTB(XLOW)
			HRLI	X1,0
			RETURN
		FI
	AS	INCR	X1,TRUE
	SA
	;HERE IF NO CHANNEL FREE
	;[41]:
	OCERC	QDSCON,0,Too many files
	GOTO	.OCIN8	;[41] Retry GETCHANNEL if user proceeds
	EPROC
	SUBTTL	LEGAL	;[61]

	.JBREL==44
	.JBHRL==115

.OCLA:	PROC	;Checks if (X1) is an address in the current low or high segment.
		;Skip returns if so, otherwise straight return.
	SAVE	X2
	N=1			;One quantity on stack
	IF	;inside current low or high segment
		CAMGE	X1,.JBREL
		GOTO	TRUE
		HRRZ	X2,.JBHRL	;Highest legal high seg addr
		CAIL	X1,400K		;Lowest hiseg address
		CAILE	X1,(X2)
		GOTO	FALSE
	THEN	;skip return - OK!
		AOS	-N(XPDP)
	FI
	RETURN
	N=0
	EPROC
	SUBTTL	LINKBUFF

COMMENT ;

PURPOSE:	TO LINK THE BUFFER RING IN A BUFFER AREA.
ENTRY:		.OCIND
INPUT ARGUMENTS:X1	POINTS TO THE BUFFER AREA
		X6	CONTAINS THE BUFFER SIZE
		X7	CONTAINS NUMBER OF BUFFERS.
OUTPUT ARGUMENT:	X1 STILL POINTS TO THE BUFFER AREA
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	LINKBUFF
USED ROUTINES:	-
USED REGISTERS:	X2,X3,X5
ERROR MESSAGES:	-
;

.OCIND:	PROC
	SAVE	<X2,X3,X5,X7>
	LI	X0,5(X1)	;ADDRESS TO FIRST BUFFER
	SF	X0,ZBHZBU(X1)	;STORE IT IN HEADER
	SETON	ZBHUSE(X1)	;SET USE BIT
	HRRI	X0,6(X1)	;CREATE BUFFER POINTER
	HRLI	X0,(POINT 7,0)
	SF	X0,ZBHBUP(X1)	;AND STORE IT IN HEADER
	;NOW LINK THE BUFFERS
	LI	X5,-2(X6)	;LENGTH OF BUFFER DATA AREA
	L	X2,X1		;SAVE BUFFER ADDRESS
	LI	X0,5(X2)	;AND ADDRESS TO FIRST BUFFER
L7():!
	ZF	ZBUSTA(X2)	;RESET FILE STATUS
	SF	X5,ZBUSIZ(X2)	;STORE BUFFER SIZE
	IF	;THIS IS THE LAST BUFFER
		SOJN	X7,FALSE
	THEN	;LINK IT TO THE FIRST
		SF	X0,ZBUZBU(X2)
		RETURN		;WITH BUFFER AREA ADDRESS IN X1
	FI
	LI	X3,5(X2)	;COMPUTE ADDRESS TO NEXT BUFFER
	ADD	X3,X6
	SF	X3,ZBUZBU(X2)	;AND STORE IT
	ADD	X2,X6		;NEXT BUFFER
	GOTO	L7		;REPEAT
	EPROC
	SUBTTL	GETBYTE

COMMENT ;

PURPOSE:	THIS PROCEDURE FETCHES NEXT BYTE FROM THE INTERNAL BUFFER YOCBUF.
		LOWER CASE LETTERS ARE CONVERTED TO UPPER CASE.
		LINE FEEDS ARE IGNORED.
ENTRY:		.OCING
INPUT ARGUMENTS:
		YOCPNT CONTAINS THE BYTE POINTER.
OUTPUT ARGUMENTS:
		NEXT BYTE IN XBYTE
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	GETBYTE
USED ROUTINES:	-
USED REGISTER:	XBYTE
ERROR MESSAGES:	-
;

.OCING:
	ILDB	XBYTE,YOCPNT(XLOW);LOAD NEXT BYTE
	CAIN	XBYTE,QLF	;IGNORE LINE FEED
	GOTO	.OCING
	CAIL	XBYTE,"a"
	CAILE	XBYTE,"z"
	RETURN
	SUBI	XBYTE,40	;CONVERT  TO UPPER CASE
	RETURN
	SUBTTL	GETNAME/GETREST

COMMENT ;

PURPOSE:	TO PACK NEXT NAME (FILE, DEVICE, EXTENSION ETC.)
		IN SIXBIT IN XNAME.
		LEADING SPACES AND TABS ARE SKIPPED. IF FOUND DELIMITER
		IS ASTERISK, NEXT BYTE IS TAKEN AS
		DELIMITER AND XNAME CONTAINS AN ASTERISK
		LEFT JUSTIFIED IN SIXBIT AT RETURN.
ENTRIES:	.OCINH (GETNAME)
		.OCIN1 (GETREST)
INPUT ARGUMENTS:
		THE BYTES ARE TAKEN FROM THE INPUT BUFFER WITH GETBYTE
OUTPUT ARGUMENTS:
		XNAME CONTAINS THE PACKED NAME
		XBYTE CONTAINS THE DELIMITER
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	GETNAME OR GETREST
USED ROUTINES:
		GETBYTE,OUTIMAGE,PRINTSPEC
USED REGISTER:	X0 POINTER TO XNAME
ERROR MESSAGES:	-
;

.OCINH:		;ENTRY GETREST:
	PROC
	LI	XNAME,0
	L	X0,[POINT 6,XNAME]
	GOTO	L1

.OCIN1:		;ENTRY GETNAME:
	LI	XNAME,0
	L	X0,[POINT 6,XNAME]
L2():!	WHILE	;LETTER OR DIGIT
		GETBYTE
L1():!
		CAIE	XBYTE,"	"
		CAIN	XBYTE," "
		JUMPE	XNAME,L2	;SKIP LEADING SPACES OR TABS
		CAIE	XBYTE,"$"
		CAIN	XBYTE,"%"
		GOTO	TRUE		;ACCEPT DOLLAR AND PERCENT SIGN!
		CAIGE	XBYTE,"0"
		GOTO	FALSE
		CAIG	XBYTE,"9"
		GOTO	TRUE
		CAIL	XBYTE,"A"
		CAILE	XBYTE,"Z"
		GOTO	FALSE
	DO	;CONVERT TO SIXBIT AND STORE
		SUBI	XBYTE,40
		TRNN	XNAME,77	;TRUNCATE IF MORE THAN 6
		IDPB	XBYTE,X0
	OD
	IF	;NOT ASTERISK
		CAIE	XBYTE,"*"
		GOTO	FALSE
	THEN	HRLZI	XNAME,'*'B23
		GETBYTE		;NEW DELIMITER
	FI
	CAIN	XBYTE,QALTMODE
	LI	XBYTE,QCR	;CHANGE ALTMODE TO CR
	RETURN
	EPROC
	SUBTTL	OUTOCT	;[61]

.OCOO:	PROC	;Output last 9 bits of X0 as 3 octal digits
	SAVE	<X1,X2>
	LI	X2,3
	ROT	↑D27
	LOOP
		ROT	3
		L	X1,X0
		ANDI	X1,7
		ADDI	X1,"0"
		OUTCHR	X1
	AS	SOJG	X2,TRUE
	SA
	RETURN
	EPROC
	SUBTTL	PRINTFILE

COMMENT ;[61] Moved here from OCIN

PURPOSE:	TO PRINT THE NAME OF A FILE IN THE FORMAT:
			FILE.EXT
		OR	FILE		IF EXTENSION IS MISSING
ENTRY:		.OCIN9
INPUT ARGUMENTS:
		X2 CONTAINS ADDRESS TO DOUBLE WORD
		   WITH FILE NAME AND EXTENSION.
OUTPUT ARGUMENTS:
		X0 IS DESTROYED
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	PRINTFILE
USED ROUTINE:	TYPENAME
USED REGISTERS:	X0,X1,X2,X3
ERROR MESSAGES:	-
;

.OCIN9::PROC
	L	X0,(X2)
	TYPENAME
	IF	;EXTENSION
		SKIPN	1(X2)
		GOTO	FALSE
	THEN	OUTCHR	["."]
		HLLZ	X0,1(X2)
		TYPENAME
	FI
	RETURN
	EPROC
	SUBTTL	TYPENAME

COMMENT ;

PURPOSE:	TO PRINT THE CONTENTS OF X0 IN SIXBIT ON TTY
ENTRY:		.OCIN2
INPUT ARGUMENT:	NAME IN X0
OUTPUT ARGUMENT:-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	TYPENAME
USED ROUTINES:	-
USED REGISTERS:	X0, X1
ERROR MESSAGES:	-
;

.OCIN2:	PROC
	SAVE	<X0,X1>
	LOOP
		SETZ	X1,
		ROTC	X0,6
		LI	X1," "(X1)
		OUTCHR	X1
	AS
		JUMPN	X0,TRUE
	SA
	RETURN
	EPROC
	SUBTTL	TYPDEC, TYPOCT

.OCRT:	;Any radix type-out
	STACK	X2
	GOTO	OCDT1
.OC8T:	;Octal type-out
	STACK	X2
	LI	X2,8
	GOTO	OCDT1
.OCDT:	;Decimal type-out
	STACK	X2
	LI	X2,↑D10
OCDT1:	STACK	X1
	IF	;Negative number
		JUMPGE	FALSE
	THEN	;Type minus sign
		OUTCHR	["-"]
		MOVNS		;Take abs value
	FI
	EXEC	OCDT.
	UNSTK	X1
	UNSTK	X2
	RETURN

OCDT.:	IDIVI	(X2)	;Get a digit
	HRLM	X1,(XPDP);Save
	IF	;More digits
		JUMPE	FALSE
	THEN	;Get the next by recursive call
		EXEC	OCDT.
	FI
	HLRZ	(XPDP)	;Wind up stack, get digit to output
	ADDI	"0"	;Convert to ASCII
	CAILE	"9"	;Convert to letter if GT 9
	ADDI	"A"-"0"
	OUTCHR
	RETURN

	SUBTTL	TYPESPEC	;[61]

Comment;
Input:		X1 points to file object
Output:		File spec on TTY
Function:	A comprehensive file specification is output on the TTY in
		a format resembling that expected in a specification file
		or in the parameter to NEW ...FILE(<file spec>).
Used routines:	IOTYSP called as a coroutine via NEXTF.
		TYPENAME, TYPDEC.

;

	XFIL==XWAC1	;File pointer
	XZXB==X2	;ZXB pointer
	XLNK==X4	;JSP ac
	OPDEF	NEXTF	[JSP	XLNK,(XLNK)]

.IOTYS:	PROC
	SAVE	<X1,XZXB,XLNK,XFIL,XSW>
	L	XFIL,X0
	L	XSW,OFFSET(ZFIDE)(XFIL)	;Switch word
	LF	,ZFINAM(XFIL)	;Logical name
	LI	XLNK,IOTYSP	;Set up coroutine
	NEXTF
	LF	,ZFIDVN(XFIL)	;Device name
	NEXTF
	LI	X1,OFFSET(ZFIFIL)(XFIL)	;File name or ZXB pointer
	IF	;Extended lookup/enter block
		IFOFFA	ZFIDE(XSW)
		GOTO	FALSE
	THEN	;File name.ext from that block
		L	XZXB,(X1)
		LI	X1,OFFSET(ZXBFIL)(XZXB)
	ELSE
		SETZ	XZXB,
	FI
	NEXTF
	IF	;SFD's
		IFOFFA	ZFISFD(XSW)
		GOTO	FALSE
	THEN
		LF	X1,ZFIARG(XFIL)
		WLF	,ZYSP1(X1)
		NEXTF		;ppn
		LOOP	;Over SFD list
			LF	,ZYSSFD(X1)
			JUMPE	FALSE
			OUTCHR	[","]
			TYPENAME
		AS
			AOJA	X1,TRUE
		SA
	ELSE
		WLF	,ZFIPPN(XFIL)
		IF	;Extended block
			JUMPE	XZXB,FALSE
		THEN	LF	,ZXBP2(XZXB)
		FI
		NEXTF
	FI
	LF	,ZFIPT(XFIL)
	IF	;Extended block
		JUMPE	XZXB,FALSE
	THEN	LF	,ZXBPT(XZXB)
	FI
	NEXTF		;Protection

	;Switches:
	IF	;/BUFFERS has a non standard value
		LF	,ZFIBFS(XFIL)
		JUMPE	FALSE
		CAIN	203
		GOTO	FALSE
	THEN	OUTSTR	[ASCIZ"/B:"]
		TYPDEC
	FI
	IF	;Outfile
		IFOFFA	ZFIOF(XSW)
		GOTO	FALSE
	THEN	IF	;Non-zero limit
		LF	,ZOFLIM(XFIL)
		JUMPE	FALSE
		THEN	OUTSTR	[ASCIZ"/L:"]
			TYPDEC
		FI
		IFONA	ZFIAPP(XSW)
		OUTSTR	[ASCIZ"/A:APPEND"]
		IFONA	ZFIWDB(XSW)
		OUTSTR	[ASCIZ"/W"]
	FI
	IF	;Not infile
		IFONA	ZFIIF(XSW)
		GOTO	FALSE
	THEN	IFONA	ZFINUM(XSW)
		OUTSTR	[ASCIZ"/N"]
	FI
	IF	;Directfile
		IFOFFA	ZFIDF(XSW)
		GOTO	FALSE
	THEN	IFONA	ZFIRON(XSW)
		OUTSTR	[ASCIZ"/A:RONLY"]
		IF	;Image length given
			LF	,ZDFIML(XFIL)
			JUMPE	FALSE
		THEN	OUTSTR	[ASCIZ"/I:"]
			SUBI	2
			TYPDEC
		FI
	FI
	OUTIMAGE
	RETURN
	EPROC
	SUBTTL	TYPESPEC, output coroutine IOTYSP

Comment;
Input:	Depends on stage of execution. Usually a sixbit name in X0 or
	a pointer in X1.
Output:	On TTY.
Function: Works as coroutine to TYPESPEC. Types one field, then goes
	back for more via NEXTF.
Calls:	TYPENAME, TYPOCT, OUTOCT
;
IOTYSP:	PROC
	STACK	;Logical name
	LF	X1,ZBIZPR(XFIL)
	LF	X1,ZPRSYM(X1)
	IF	;There is a symbol table
		JUMPE	X1,FALSE
		LEGAL	;and address is ok
		GOTO	FALSE
	THEN	;Get name from table
		L	-2(X1)
		JUMPE	FALSE
		TYPENAME
		L	-1(X1)
	ELSE
		L	[SIXBIT/FILE/]
	FI
	SKIPE
	TYPENAME
	BREAKOUTIMAGE	<: - >
	UNSTK	;Logical name
	TYPENAME
	OUTCHR	[" "]
	NEXTF
	IF	JUMPE	FALSE
	THEN	;Device
		TYPENAME
		OUTCHR	[":"]
	FI
	NEXTF
	L	(X1)
	IF	JUMPE	FALSE
	THEN	;File name
		TYPENAME
	FI
	HLLZ	1(X1)
	IF	JUMPE	FALSE
	THEN	;Extension
		OUTCHR	["."]
		TYPENAME
	FI
	NEXTF
	STACK
	OUTCHR	["["]
	HLRZ	(XPDP)
	SKIPE
	TYPOCT
	OUTCHR	[","]
	UNSTK
	HRRZ
	SKIPE
	TYPOCT
	NEXTF
	OUTCHR	["]"]
	IF	JUMPE	FALSE
	THEN	;<prot>
		OUTCHR	["<"]
		OUTOCT
		OUTCHR	[">"]
	FI
	NEXTF
	EPROC
	SUBTTL	IO DEBUG ROUTINES
IFN QDEBUG,<

COMMENT ;

THIS MODULE CONTAINS TEST ROUTINES FOR THE IO ROUTINES
THE ROUTINES ARE CALLED FROM DDT AND PRINT VARIOUS
DATA STRUCTURES ON THE TTY.

THE ROUTINES ARE:
BAREA (IODBBF) PRINTS THE BUFFER AREA
IOSPEC (IODBSP) PRINTS THE ENTIRE IOSPEC TABLE
FILOBJ (IODBFO) PRINTS A FILE OBJECT
CHAN (IODBCH) PRINTS THE CHANNEL TABLE
FILES (IODBFI) PRINTS ALL FILE OBJECTS REFERENCED IN THE CHANNEL TABLE

UTILITY SUBROUTINES:
TYPEBIN (IODB1) PRINTS A BINARY NUMBER ON TTY
TYPESUB (IODB2) PRINTS A SUB FILE DIRECTORY BLOCK

;

DEFINE TYPE(A)=<
	OUTSTR	[ASCIZ/
A = /]>

	OPDEF	TYPEBIN	[PUSHJ XPDP,IODB1]
	OPDEF	TYPESUB	[PUSHJ XPDP,IODB2]
	OPDEF	BAREA	[PUSHJ XPDP,IODBBF]
	OPDEF	FILOBJ	[PUSHJ XPDP,IODBFO]
	OPDEF	IOSPEC	[PUSHJ XPDP,IODBSP]
	OPDEF	CHAN	[PUSHJ XPDP,IODBCH]
	OPDEF	FILES	[PUSHJ XPDP,IODBFI]

	SUBTTL	IODBBF - PRINT THE BUFFER AREA

COMMENT ;
THIS SUBROUTINE PRINTS THE BUFFER AREA.
THE FOLLOWING INFORMATION IS PRINTED:
BUFFER STATUS(FREE OR OCCUPIED)
LINK TO NEXT BUFFER
CONSECUTIVE FLAG
THE BUFFER HEADER:
USE BIT
CURRENT BUFFER
BUFFER POINTER
BYTE COUNT
;

IODBBF:	PROC
	SAVE	<X0,X1>
	LOWADR
	L	X1,YOCBST(XLOW)
	OUTSTR	[ASCIZ/
BUFFER AREA INFORMATION
***********************
/]

L1():!
	OUTSTR	[ASCIZ/

LINK WORD:/]
	IF	;BUFFER IS FREE
		FREE	(X1)
		GOTO	FALSE
	THEN	OUTSTR	[ASCIZ/
BUFFER IS FREE/]
		HLRE	X0,OFFSET(ZBHLEN)(X1)
		MOVN	X0,X0
		TYPE	LENGTH
		TYPEBIN
		TYPE	LINK
		LF	X0,ZBHLNK(X1)
		TYPEBIN
		OUTSTR	[ASCIZ/
/]
		IFOFF	ZBHCON(X1)
		OUTSTR	[ASCIZ/NOT /]
		OUTSTR	[ASCIZ/CONSECUTIVE/]
	ELSE
		TYPE	LENGTH
		LF	X0,ZBHLEN(X1)
		TYPEBIN
		TYPE	LINK
		LF	X0,ZBHLNK(X1)
		TYPEBIN
		OUTSTR	[ASCIZ/
/]
		IFOFF	ZBHCON(X1)
		OUTSTR	[ASCIZ/NOT /]
		OUTSTR	[ASCIZ/CONSECUTIVE/]
		OUTSTR	[ASCIZ/
BUFFER HEADER:
/]
		OUTSTR	[ASCIZ/USE BIT/]
		IF	IFON	ZBHUSE(X1)
			GOTO	FALSE
		THEN	OUTSTR	[ASCIZ/ OFF/]
		ELSE
			OUTSTR	[ASCIZ/ ON/]
		FI
		TYPE	<CURRENT BUFFER>
		LF	X0,ZBHZBU(X1)
		TYPEBIN
		TYPE	<BUFFER POINTER>
		LF	X0,ZBHBUP(X1)
		TYPEBIN
		TYPE	<BYTE COUNT>
		LF	X0,ZBHCNT(X1)
		TYPEBIN
	FI
	LF	X1,ZBHLNK(X1)
	CAIE	X1,377777
	GOTO	L1
	OUTSTR	[ASCIZ/
END OF BUFFER AREA
/]
	RETURN
	EPROC
	SUBTTL	IODBSP - IOSPEC PRINTOUT

COMMENT ;

THIS ROUTINE PRINTS THE CONTENTS OF IOSPEC.
ALL ELEMENTS ARE PRINTED.
;

IODBSP:	PROC
	SAVE	<X0,X1,X2>
	LOWADR
	L	X1,YIOSPC(XLOW)
	IF	;IOSPEC IS EMPTY
		JUMPGE	X1,FALSE
	THEN	OUTSTR	[ASCIZ/
IOSPEC IS EMPTY!
/]
		GOTO	L9
	FI
	OUTSTR	[ASCIZ/
IOSPEC TABLE
************/]
	LOOP	;UNTIL IOSPEC IS EMPTY AND PRINT CONTENTS
		OUTSTR [ASCIZ/
****
/]
		TYPE	<LOGICAL NAME>
		LF	X0,ZFSNAM(X1)
		TYPENAME
		TYPE	DEVICE
		WLF	X0,ZFSDEV(X1)
		TYPENAME
		TYPE	<FILE SIZE>
		LF	X0,ZFSSIZ(X1)
		TYPEBIN
		TYPE	<MAX FILE SIZE>
		LF	X0,ZFSLIM(X1)
		TYPEBIN
		TYPE	<MAX IMAGE LENGTH>
		LF	X0,ZFSIML(X1)
		TYPEBIN
		IFON	ZFSAPP(X1)
		TYPE	<MODE APPEND>
		TYPE	<FILE NAME>
		LI	X2,OFFSET(ZFSFIL)(X1)
		PRINTFILE
		TYPE	<NO OF BUFFERS>
		LF	X0,ZFSBUF(X1)
		TYPEBIN
		TYPE	<PROTECTION CODE>
		LF	X0,ZFSPT(X1)
		TYPEBIN
		IF	;SUB FILE DIRECTORIES
			IFOFF	ZFSSUB(X1)
			GOTO	FALSE
		THEN	LF	X0,ZFSADR(X1)
			SUBI	X0,2
			TYPESUB
		ELSE
			TYPE	<PROJ NO>
			LF	X0,ZFSPRJ(X1)
			TYPEBIN
			TYPE	<PROGR NO>
			LF	X0,ZFSPRG(X1)
			TYPEBIN
		FI
	AS	LFE	X1,ZFSLNK(X1)
		LFE	X0,ZFSLNK(X1)
		JUMPG	X0,TRUE
	SA
	OUTSTR	[ASCIZ/
END OF IOSPEC TABLE
/]
L9():!
	RETURN
	EPROC
	SUBTTL	IODBFO	-	FILE OBJECT PRINTOUT

COMMENT ;
 
THIS ROUTINE PRINTS THE CONTENTS
OF A FILE OBJECT.
X1 SHOULD CONTAIN ADDRESS TO FILE OBJECT
AT ROUTINE ENTRY.

;

IODBFO:	PROC
	SAVE	<X0,X2,X3>
	OUTSTR	[ASCIZ/

FILE OBJECT CONTENTS
********************
/]
	TYPE	<IMAGE ADDRESS>
	LD	X2,OFFSET(ZFIIMG)(X1)
	LF	X0,ZTVZTE(,X2)
	TYPEBIN
	OUTSTR	[ASCIZ/
/]
	IFON	ZFIOPN(X1)
	OUTSTR	[ASCIZ/FILE IS OPEN
/]
	IFON	ZFIIF(X1)
	OUTSTR	[ASCIZ/INFILE
/]
	IFON	ZFIOF(X1)
	OUTSTR	[ASCIZ/OUTFILE
/]
	IFON	ZFIPF(X1)
	OUTSTR	[ASCIZ/PRINTFILE
/]
	IFON	ZFIDF(X1)
	OUTSTR	[ASCIZ/DIRECTFILE
/]
	IFON	ZFIIN(X1)
	OUTSTR	[ASCIZ/CAN DO INPUT
/]
	IFON	ZFIOUT(X1)
	OUTSTR	[ASCIZ/CAN DO OUTPUT
/]
	IFON	ZFIEND(X1)
	OUTSTR	[ASCIZ/TEMPORARY END REACHED
/]
	IFON	ZFIAPP(X1)
	OUTSTR	[ASCIZ/MODE APPEND
/]
	TYPE	CHANNEL
	LF	X0,ZFICHN(X1)
	TYPEBIN
	TYPE	BUFFERS
	LF	X0,ZFIBUF(X1)
	TYPEBIN
	TYPE	CHARACTERISTICS
	LF	X0,ZFIKAR(X1)
	TYPEBIN
	TYPE	STATUS
	LF	X0,ZFISTI(X1)
	TYPEBIN
	TYPE	DEVICE
	WLF	X0,ZFIDVN(X1)
	TYPENAME
	TYPE	<INPUT BUFFER>
	LF	X0,ZFIIBH(X1)
	TYPEBIN
	TYPE	<OUTPUT BUFFER>
	LF	X0,ZFIOBH(X1)
	TYPEBIN
	IF	;EXTENDED LOOKUP/ENTER BLOCK
		IFOFF	ZFIDE(X1)
		GOTO	FALSE
	THEN	LF	X3,ZFIFIL(X1)
		IF	;SUB FILE DIRECTORIES
			IFOFF	ZFISFD(X1)
			GOTO	FALSE
		THEN	LF	X0,ZFIARG(X1)
			SUBI	X0,2
			TYPESUB
		ELSE
			HLRZ	X0,OFFSET(ZXBP2)(X3)
			TYPE	<PROJ NO>
			TYPEBIN
			TYPE	<PROGR NO>
			HRRZ	X0,OFFSET(ZXBP2)(X3)
			TYPEBIN
		FI
		TYPE	<FILE NAME>
		LI	X2,OFFSET(ZXBFIL)(X3)
		PRINTFILE
		TYPE	<PROTECTION CODE>
		LF	X0,ZXBPRT(X3)
		TYPEBIN
		TYPE	<ESTIMATED LENGTH>
		LF	X0,ZXBLEN(X3)
		TYPEBIN
		TYPE	<ALLOCATED LENGTH>
		LF	X0,ZXBALC(X3)
		TYPEBIN
	ELSE
		TYPE	<FILE NAME>
		LI	X2,OFFSET(ZFIFIL)(X1)
		PRINTFILE
		TYPE	<PROTECTION CODE>
		LF	X0,ZFIPT(X1)
		TYPEBIN
		IF	;SUBFILE DIRECTORIES
			IFOFF	ZFISFD(X1)
			GOTO	FALSE
		THEN	LF	X0,ZFIARG(X1)
			TYPESUB
		ELSE
			TYPE	<PROJ NO>
			LF	X0,ZFIPRJ(X1)
			TYPEBIN
			TYPE	<PROGR NO>
			LF	X0,ZFIPRG(X1)
			TYPEBIN
		FI
	FI
	TYPE	<LOGICAL NAME>
	LF	X0,ZFINAM(X1)
	TYPENAME
	TYPE	<SAVED PPN>
	LF	X0,ZFIPPN(X1)
	TYPEBIN
	TYPE	<BUFFER SIZE>
	LF	X0,ZFIBFS(X1)
	TYPEBIN
	IF	;OUTFILE OR PRINTFILE
		IFOFF	ZFIOF(X1)
		GOTO	FALSE
	THEN	;PRINT LIMIT AND WRITTEN BLOCKS
		TYPE	<NO OF WRITTEN BLOCKS>
		LF	X0,ZOFBLK(X1)
		TYPEBIN
		TYPE	<MAX NO OF BLOCKS>
		LF	X0,ZOFLIM(X1)
		TYPEBIN
	FI
	IF	;PRINTFILE
		IFOFF	ZFIPF(X1)
		GOTO	FALSE
	THEN	TYPE	SPACING
		LF	X0,ZPFSP(X1)
		TYPEBIN
		TYPE	LINESPERPAGE
		LF	X0,ZPFLP(X1)
		TYPEBIN
		TYPE	<LAST PRINTED LINE>
		LF	X0,ZPFLL(X1)
		TYPEBIN
		TYPE	LINE
		LF	X0,ZPFLIN(X1)
		TYPEBIN
	ELSE
	IF	;DIRECTFILE
		IFOFF	ZFIDF(X1)
		GOTO	FALSE
	THEN	TYPE	<MAX IMAGE LENGTH>
		LF	X0,ZDFIML(X1)
		TYPEBIN
		TYPE	<MAX LOCATION>
		LF	X0,ZDFLIM(X1)
		TYPEBIN
		TYPE	LOCATION
		LF	X0,ZDFLOC(X1)
		TYPEBIN
		TYPE	<CURRENT BLOCK NO>
		LF	X0,ZDFBLK(X1)
		TYPEBIN
	FI
	FI
	OUTSTR	[ASCIZ/
END OF FILE OBJECT
/]
	RETURN
	EPROC
	SUBTTL	TYPESUB - PRINTS OUT A SUB FILE DIRECTORY BLOCK

COMMENT ;

THIS SUBROUTINE PRINTS OUT THE CONTENTS
OF A SUB-FILE DIRECTORY BLOCK, WHICH
IS EITHER A PART OF A ZFS-RECORD IN IOSPEC
OR A ZYS-RECORD LINKED TO A FILE OBJECT.
AT ENTRY X0 SHOULD CONTAIN ADDRESS TO
THE BLOCK.
;

IODB2:	PROC
	SAVE	<X1>
	L	X1,X0
	OUTSTR	[ASCIZ/

SUB FILE DIRECTORY BLOCK
------------------------
/]
	TYPE ARGUMENT
	LF	X0,ZYSARG(X1)
	TYPEBIN
	TYPE	PPN
	LF	X0,ZYSP1(X1)
	TYPEBIN
	OUTSTR	[ASCIZ/
SFD LIST: /]
	WHILE	;NOT END OF LIST
		LF	X0,ZYSSFD(X1)
		JUMPE	X0,FALSE
	DO	TYPENAME
		OUTSTR	[ASCIZ/,/]
		ADDI	X1,1
	OD
	RETURN
	EPROC
	SUBTTL - BINARY PRINT ROUTINE

COMMENT ;

THIS SUBROUTINE PRINTS A BINARY NUMBER ON TTY.
THE BINARY NUMBER IS IN X0 AT ENTRY.
;

IODB1:	PROC
	SAVE	<X1,X2,X3>
	L	X1,X0
	LI	X2,0		;SWITCH FOR LEADING ZERO SUPPRESSION
	LI	X3,↑D12		;MAX NO OF DIGITS
	LOOP	LI	X0,0
		LSHC	X0,3
		IF	;DIGIT IS ZERO
			JUMPN	X0,FALSE
		THEN	JUMPN	X2,FALSE	;IF NOT LEADING ZERO
			CAIE	X3,1		;ALWAYS PRINT LAST ZERO
		ELSE
			ADDI	X0,60
			LI	X2,1
			OUTCHR	X0
		FI
	AS	SOJG	X3,TRUE
	SA
	RETURN
	EPROC
	SUBTTL	CHAN - CHANNEL TABLE PRINTOUT ROUTINE

COMMENT ;

PURPOSE:	TO PRINT THE CHANNEL TABLE ON TTY.
		CHAN IS CALLED FROM DDT.
;

IODBCH:	PROC
	SAVE	<X1,X2,X3,X4,X5,X6,XLOW>
	OUTSTR	[ASCIZ/     CHANNEL TABLE
/]
	OUTSTR	[ASCIZ/     =============
/]
	OUTSTR	[ASCIZ/CH  FILE NAME   LOGICAL NAME    FILE REF
/]
	OUTSTR	[ASCIZ/----------------------------------------
/]
	LOWADR
	LI	X1,YIOCHTB(XLOW);ADDRESS TO CHANNEL TABLE
	LI	X3,↑D16		;AND NO OF ELEMENTS
	LOOP	;AND PRINT CHANNEL NO AND FILE NAMES
		LI	X0,(X1)
		SUBI	X0,YIOCHTB(XLOW)
		TYPEBIN
		OUTSTR	[ASCIZ/   /]
		HRRZ	X5,(X1)		;INPUT SIDE
		HLRZ	X6,(X1)		;OUTPUT SIDE
		IF	;OUTPUT SIDE OCCUPIED
			JUMPE	X6,FALSE
		THEN	;PRINT NAMES
			LI	X2,OFFSET(ZFIFIL)(X6)
			PRINTFILE
			OUTSTR	[ASCIZ/	/]	;PRINT TAB
			LF	X0,ZFINAM(X6)
			TYPENAME
			OUTSTR	[ASCIZ/		/]	;PRINT TAB
			L	X0,X6
			TYPEBIN
		FI
		IF	;INPUT SIDE OCCUPIED
			JUMPE	X5,FALSE
		THEN	IF	;NOT SAME AS OUTPUT SIDE
				CAMN	X5,X6
				GOTO	FALSE
			THEN	;PRINT NAMES
				IF	;OUTPUT SIDE PREVIOUSLY PRINTED
					JUMPE	X6,FALSE
				THEN	;PRINT CR AND SPACES
					OUTSTR	[ASCIZ/
    /]
				FI
				LI	X2,OFFSET(ZFIFIL)(X5)
				PRINTFILE
				OUTSTR	[ASCIZ/	/]	;PRINT TAB
				LF	X0,ZFINAM(X5)
				TYPENAME
				OUTSTR	[ASCIZ/		/]	;PRINT TAB
				L	X0,X5
				TYPEBIN
			FI
		FI
		OUTSTR	[ASCIZ/
/]
	AS	ADDI	X1,1
		SOJG	X3,TRUE
	SA
	RETURN
	EPROC
	SUBTTL	FILES - PRINT ALL FILES IN THE CHANNEL TABLE

COMMENT ;

PURPOSE:	FILES IS CALLED FROM DDT AND PRINTS ALL
		FILOBJECTS THAT ARE PRESENT IN THE
		CHANNEL TABLE YIOCHTB.
USED ROUTINE:	FILOBJ.
;

IODBFI:	PROC
	SAVE	<X0,X1,X2,X3,X5,X6,XLOW>
	LOWADR
	LI	X2,↑D15	;NUMBER OF ELEMENTS
	LI	X3,YIOCHTB(XLOW)	;ADDRES TO CHANNEL TABLE
	LOOP	;AND PRINT FILE OBJECTS
		IF	;THIS ENTRY IS NOT EMPTY
			SKIPG	X1,(X3)
			GOTO	FALSE
		THEN	HRRZ	X5,X1
			HLRZ	X6,X1
			L	X1,X6
			CAIE	X6,0
			FILOBJ		;PRINT OUTPUT SIDE IF OCCUPIED
			L	X1,X5
			JUMPE	X5,FALSE
			CAME	X5,X6
			FILOBJ		;PRINT INPUT SIDE IF OCCUPIED
					;AND DIFFERENT FROM OUTPUT SIDE
		FI
	AS	ADDI	X3,1
		SOJG	X2,TRUE
	SA
	RETURN
	EPROC

> 	;END OF IO DEBUG ROUTINES
	;========================
	SUBTTL	LITERALS
	LIT
	END