Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/rts/ocio.mac
There is 1 other file named ocio.mac in the archive. Click here to see a list.
;<TENDERIN>OCIO.MAC.3, 17-Jan-77 01:10:08, Edit by ENDERIN
;<ENDERIN>OCIO.MAC.15, 3-Jan-77 18:24:17, Edit by ENDERIN
SUBTTL Written by Olof Bjorner 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]
;
edit(41)
PROCINIT(OCIO)
edit(225)
IF1,<;[225]
QDIRTR==QDEC20 ;Determines translation of <directory> - [p,pn]
;; IFN QDEC20,<IFDEF PPNST,<QDIRTR==1>>
>
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: -
;
edit(61)
edit(61)
.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
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 one
LF X0,ZBHLNK(X2)
IF ;It was not
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 should now point to the buffer with lowest address.
;If joining is backward then the first buffer is
;free and the second (the buffer to be released) is
;occupied. If joining is forward after backward joining
;then both buffers are free. If joining is forward
;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
edit(201)
IF ;[201] Special call
IFOFF ZFIFND(XCB)
GOTO FALSE
THEN ;Return -1 as channel no
SETO X1,
RETURN
FI ;[201]
edit(41) ;[41]:
OCERC QDSCON,0,Too many files
GOTO .OCIN8 ;[41] Retry GETCHANNEL if user proceeds
EPROC
SUBTTL LEGAL ;[61]
edit(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,X4,X5 [207]
ERRORMESSAGES: -
;
.OCIND: PROC
edit(207)
SAVE <X2,X3,X4,X5,X7> ;[207]
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 X4,5(X2) ;AND ADDRESS TO FIRST BUFFER [207]
L7():!
ZF ZBUSTA(X2) ;RESET FILE STATUS
SETOFF ZBUUSE(X2) ;SETOFF USE BIT IN BUFFER HEADER [207]
SF X5,ZBUSIZ(X2) ;STORE BUFFER SIZE
IF ;THIS IS THE LAST BUFFER
SOJN X7,FALSE
THEN ;LINK IT TO THE FIRST
SF X4,ZBUZBU(X2) ; [207]
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: LOOP
ILDB XBYTE,YOCPNT(XLOW);Load next byte
AS
CAIN XBYTE,QLF ;Ignore line feed
GOTO TRUE
SA
CAIL XBYTE,"a"
CAILE XBYTE,"z"
RET
SUBI XBYTE,40 ;CONVERT TO UPPER CASE
RET
SUBTTL GETNAME/GETREST
COMMENT ;
PURPOSE: To pack next name (file, device, extension etc.) in
sixbit in XNAME. Leading spaces are skipped. If found
delimiter is asterisk, next byte is taken as
delimiter and XNAME contains an asterisk left
justified in sixbit at return.
[263] Special feature: A string of characters, left
justified, may be given in octal code: #000013000134
for example.
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
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():!
CAIN XBYTE," "
JUMPE XNAME,L2 ;Skip leading spaces
edit(225)
IFE QDEC20,<CAIE XBYTE,"%">;[225] Allow % on DEC10
CAIN XBYTE,"$"
GOTO TRUE ;ACCEPT DOLLAR
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 ;ASTERISK
CAIE XBYTE,"*"
GOTO FALSE
THEN HRLZI XNAME,'*'B23
GETBYTE ;NEW DELIMITER
ELSE ;[263] May be octal string
edit(263)
CAIE XBYTE,"#"
RET
;Maybe we have a funny name in octal representation
HRLOI XBYTE,(NOP)
IF ;Instr following GETNAME is NOP -1
CAME XBYTE,@(XPDP)
GOTO FALSE
THEN ;Do not allow funny name
LI XBYTE,"#"
RET
FI
TLC X0,000500 ;Change byte size
WHILE
GETBYTE
CAIL XBYTE,"0"
CAILE XBYTE,"7"
GOTO FALSE
DO
SUBI XBYTE,"0"
TLNE X0,770000 ;Store digit if ptr not at end yet
IDPB XBYTE,X0
OD
TLNE X0,010000 ;Extra null if odd no of digits
IBP X0
TLC X0,000500 ;Reset byte size
GOTO L1
FI
RETURN
EPROC
SUBTTL OUTOCT ;[61]
edit(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"
edit(225)
PBOUT ;[225]
AS SOJG X2,TRUE
SA
RETURN
EPROC
SUBTTL PRINTFILE
edit(61)
COMMENT ;[61] Moved here from OCIN
PURPOSE: TO PRINT THE NAME OF A FILE IN THE FORMAT:
FILE.EXT
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
edit(225)
SAVE X1 ;[225]
L X0,(X2)
TYPENAME
LI X1,"."
PBOUT ;[225]
HLLZ X0,1(X2)
TYPENAME
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)
PBOUT
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]
edit(61)
Comment;
Input: X0 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
edit(225)
IFE QDIRTR,<;[225]
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
IFN QDIRTR,<;[225]
WLF ,ZFIPPN(XFIL)
IF ;EXTENDED LOOKUP BLOCK
JUMPE XZXB,FALSE
THEN LF ,ZXBP2(XZXB)
FI
NEXTF ;<DIRECTORY>
LI X1,OFFSET(ZFIFIL)(XFIL)
SKIPE XZXB
LI X1,OFFSET(ZXBFIL)(XZXB)
>
NEXTF
IFE QDIRTR,<;[225]
IF ;SFD's
IFOFFA ZFISFD(XSW)
GOTO FALSE
THEN
edit(225)
IFE QDEC20,<;[225]
LF X1,ZFIARG(XFIL)
edit(262)
SKIPE XZXB ;[262]
LF X1,ZXBP2(XZXB) ;[262]
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
CAMN [-1]
SETZ
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
edit(304)
IFE QDIRTR,<;[304]
IF JUMPE FALSE
THEN ;Device
TYPENAME
OUTCHR [":"]
FI
NEXTF >
edit(225)
IFN QDIRTR,<;[225]
IF JUMPE FALSE
THEN ;<DIRECTORY>
STACK X0 ;[304]
STACK X1
STACK X2
STACK X3 ;[304]
N==4
LF ,ZFIDVN(XFIL)
SKIPN
MOVSI 'DSK'
LI X3,10(XPDP)
HRLI X3,(POINT 7,)
LOOP
SETZ X1,
ROTC 6
LI X1," "(X1)
IDPB X1,X3
AS
JUMPN TRUE
SA
IDPB X3 ;Final zero
L X2,X0+1-N(XPDP) ;ppn to X2 (was in X0)
LI X1,.PRIOU ;Output on primary JFN
HRROI X3,10(XPDP) ;STR
PPNST%
ERJMP .+1
UNSTK X3
UNSTK X2
UNSTK X1
UNSTK X0
ELSE
LF ,ZFIDVN(XFIL)
IF JUMPE FALSE
THEN TYPENAME ;Device:
OUTCHR [":"]
FI
FI >
L (X1)
IF JUMPE FALSE
THEN ;File name
TYPENAME
FI
HLLZ 1(X1)
IF JUMPE FALSE
THEN ;Extension
OUTCHR ["."]
TYPENAME
FI
NEXTF
IFE QDIRTR,<;[225]
edit(144)
IF ;[144,225] NOT DEFAULT PATH
JUMPE FALSE
THEN ;TYPE [P,PN,...]
STACK
OUTCHR ["["]
HLRZ (XPDP)
SKIPE
TYPOCT
OUTCHR [","]
UNSTK
HRRZ
SKIPE
TYPOCT
IFE QDEC20,< NEXTF ;POSSIBLE SFD>
OUTCHR ["]"]
ELSE
NEXTF
FI ;[144]
>
NEXTF
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