Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/rts/ocin.mac
There are 2 other files named ocin.mac in the archive. Click here to see a list.
;<TENDERIN>OCIN.MAC.4, 17-Jan-77 02:06:20, Edit by ENDERIN
;<ENDERIN>OCIN.MAC.72, 5-Jan-77 16:43:28, Edit by ENDERIN
SEARCH SIMMAC,SIMMCR,SIMRPA
SALL
RTITLE OCIN
; Edits: [1C,3,24,32,41,61,67,144,177,224,225,244,261]
SUBTTL Written by Olof Bjorner and Lars Enderin Nov 1973
ERRMAC OC
MACINIT
EXTERN .JB41,.JBAPR,.JBFF,.JBHRL,.JBREL,.PDERR
EXTERN .SAAB,.SAAR,.SAGC,.SAGI,.TXBL
INTERN .OCIN
LOC .JBOPS
Z ;TELLS OCSP THAT SIMRTS WAS LOADED
TWOSEG
RELOC 400K
edit(225)
IF1,<;[225]
QDIRTR==1 ;Determines translation of <directory> - [p,pn]
IFN QDEC20,<IFDEF PPNST,<QDIRTR==1>>
>
SUBTTL OCIN, SIMRTS high segment initialisation routine
Comment;
.OCIN
Purpose
-------
To initialise for a SIMULA program execution (finish the job started
by .OCSP).
Input
-----
XFP still points to the inline parameter given to .OCSP. The
accumulators have been saved in YACSAV. X2 points to .YXAC (first
pseudo ac). XCB points to the low segment static area. .JBFF has
the first free address in low core.
Function
--------
Initialize the pushdown stack and set up a stack pointer in XPDP.
Initialize YIOLP to QIOLP, YTXLT to "E". Put a few error entries at
YPDL(XLOW) to catch stack underflow. YXACAD(XLOW) is set to the
address of .YXAC, which is transmitted in X2 on entry to .OCIN from
.OCSP. Open the user's tty as SYSIN and SYSOUT. Enable traps,
initialize UUO handler by calling .OCIT. If the parameter pointed
to by XFP had a non-zero address part, decode the "runswitches"
information and read in the file specified. Form IOSPEC for any
file specifications encountered in that file. Next, if SYSIN and/or
SYSOUT have been redefined, reallocate those files. Allocate buffer
space according to switches provided and set YSABOT to the end of the
buffer space. SAGI is called to initialize the dynamic storage pool.
;
SUBTTL OCIN DESCRIPTION
COMMENT ;
OCIN contains a subroutine package as well as a main routine. The
subroutines are called with special operators defined in SIMRPA.MAC.
These operators are made available through the PROCINIT macro, which
also contains necessary INTERN and EXTERN declarations.
The main routine in OCIN performs the following tasks:
- sets up pointers to certain areas in low segment
- sets up job number
- sets up run-time stack
- enables certain traps
- sets up buffers for TTY input and output
- processes file definitions in any specification file
- sets up file objects for SYSIN and SYSOUT
- performs SYSIN.OPEN(...) and prepares for SYSOUT.OPEN(...)
;
SUBTTL Local macros
edit(225)
TOPS10,<;[225]
Comment ;
The macro YOCTAB creates two tables, YOCSWT and YOCSWA. YOCSWT
contains the long forms (except the first letter) of all compiler
switches packed together in consecutive words. YOCSWA is an access
table for YOCSWT. Each entry is a word where the left halfword
contains the short one-letter form of the switch and the right
halfword contains the byte index to the start of the long form in
YOCSWT. YOCTAB also defines the constant YOCSWL which contains the
length of YOCSWA.
;
DEFINE YOCTAB=<
DEFINE X(A)=<
$$SWL=0 ;;No of letters in switch name
IRPC A,<
$$SWL=$$SWL+1
IFE <$$SWL-1>,<
TINQ ("A") ;;IF FIRST CHARACTER SAVE IT IN QUEUE
>
IFN <$$SWL-1>,<
$$ENTR=$$ENTR+"A"B<$$BIT>
$$BIT=$$BIT+7
IFG <$$BIT-^D34>,<
JINQ $$ENTR ;;IF FULL WORD ENTER IT INTO QUEUE J
$$JNO=$$JNO+1 ;;COUNT ENTRY
$$BIT=6
$$ENTR=0
>
>
>;; END OF IRPC
TINQ ($$IND) ;;SAVE BYTE INDEX
$$IND=$$IND+$$SWL-1
$$SWNO=$$SWNO+1
>;;END OF X
GETQUE (T) ;;GET A QUEUE FOR YOCSWA
GETQUE (J) ;;GET A QUEUE FOR YOCSWT
$$SWNO=0 ;;NO OF SWITCH NAMES
$$IND=0 ;;BYTE INDEX TO YOCSWT
$$ENTR=0 ;;ENTRY IN YOCSWT
$$BIT=6 ;;BIT POSITION
$$JNO=0 ;;NO OF ENTRIES IN QUEUE J
;; NOW USE X
X ACCESS
X BUFFERS
X FILES
X HELP
X IMAGESIZE
X LIMIT
edit(24)
X NUMBERED ;[24]
X SIZE
X WORDALIGNED ;[24]
JINQ $$ENTR
$$JNO=$$JNO+1
;; SET UP ACCESS TABLE
$$TMP1=<$$TMP2=0>
YOCSWA: ;;ACCESS TABLE
REPEAT $$SWNO,<
TOUTQ ($$TMP1) ;;GET SHORT FORM
TOUTQ ($$TMP2) ;;GET BYTE INDEX
XWD $$TMP1,$$TMP2
>
YOCSWT: ;;CHARACTER TABLE
REPEAT $$JNO,<
JOUTQ ($$TMP1) ;;GET ENTRY IN YOCSWT
EXP $$TMP1
>
YOCSWL:: EXP -$$SWNO
PURGE $$IND,$$TMP1,$$TMP2,$$SWL,$$SWNO,$$JNO,$$ENTR,$$BIT
>;END OF MACRO YOCTAB
>;[225]
IFN QDEBUG,<
OCINST: ;LABEL FOR DEBUGGING ONLY
>
edit(225)
IFE QDEC20,<;[225]
YOCTAB ;CREATE SWITCH TABLES
>
SUBTTL MESSAGES
NOP==NOP
DEFINE OUTIMAGE(A)=<
EXEC OCINTS
EXP NOP+<QIND'A>B26+QM'A
>
edit(224)
DEFINE SWERROR(A)=<;;[224]
EXEC OCINSE
EXP NOP+<QIND'A>B26+QM'A
>
DEFINE BREAKOUTIMAGE(A)=<
EXEC OCINTL
EXP NOP+<QIND'A>B26+QM'A
>
;MESSAGES IS A MACRO THAT PACKS ALL MESSAGES
;IN FIVEBIT FORMAT
DEFINE MESSAGES=<
.XCREF
DEFINE X(ARG)=<
QCOUNT=QCOUNT+1 ;;MESSAGE NUMBER UPDATED
IFNB <ARG>,<
.CREF
$$C(QM,\QCOUNT)==<44-CC.*5> ;;SET UP BYTE POINTER
$$C(QIND,\QCOUNT)==QINDEX;;SET INDEX REGISTER
.XCREF
IRPC ARG,<
ZZ.==-1 ;;HELP VARIABLE
IFE <"ARG"-" ">,<ZZ.=0>
IFE <"ARG"-".">,<ZZ.=33>
IFE <"ARG"-"?">,<ZZ.=34>
IFE <"ARG"-":">,<ZZ.=35>
IFE <"ARG"-"^">,<ZZ.=36>;;[224]
IFGE <"ARG"-"A">,<
IFLE <"ARG"-"Z">,<ZZ.="ARG"&37>
>
IFE <ZZ.+1>,<PRINTX NOT VALID FIVEBIT CHARACTER: ARG>
IFN <ZZ.+1>,<
WORD=WORD_5+ZZ. ;;UPDATE ELEMENT ENTRY
CC.=CC.+1 ;;COUNT THIS CHARACTER
IFE <CC.-7>,< ;;IF ENTRY IS FULL
WORD=WORD_1
EXP WORD ;;THEN ENTER THIS ELEMENT IN YOCMES
QINDEX=QINDEX+1 ;;UPDATE INDEX TO YOCMES
CC.=0
WORD=0
>
>
>;;END OF IRPC
ZZ.=37 ;;SET END OF MESSAGE
WORD=WORD_5+ZZ.
CC.=CC.+1
IFE <CC.-7>,< ;;IF ENTRY IS FULL
WORD=WORD_1
EXP WORD ;;THEN ENTER THIS ELEMENT IN YOCMES
QINDEX=QINDEX+1 ;;UPDATE INDEX
CC.=0
WORD=0
>
>>;;END OF MACRO X
;;INITIATE ASSEMBLY CONSTANTS:
WORD==0 ;;YOCMES ENTRY
QINDEX==0 ;;VALUE OF INDEX REGISTER
QCOUNT==0 ;;MESSAGE NUMBER
CC.==0 ;;CHARACTER COUNT
;;QMn IS BYTE POINTER TO YOCMES FOR MESSAGE n
;;QINDn IS VALUE OF INDEX REGISTER FOR MESSAGE n
;;[224] Each message starts in upper case, ^ switches case.
;;NOW SET UP THE MESSAGES:
X(<?D^EVICE >) ;;1
X(< ^ILLEGAL>) ;;2
X(<P^LEASE SPECIFY NEW DEVICE>) ;;3
X(<P^LEASE ENTER FILE DEFINITION>) ;;4
X(<^ILL DEL AFTER LAST SWITCH>) ;;5
X(<?APPEND ^OR ^RONLY^ EXPECTED AFTER ^ACCESS>);;6
X(<WARNING: FILES ^MUST BE A GLOBAL SWITCH. ^FILES ^IGNORED>) ;;7
X(<HELP ^SWITCH MISPLACED. ^I^GNORED>) ;;10
X(<?C^ANNOT OPEN DISK>) ;;11
edit(225)
IFE QDEC20,<;;[225]
X(< >) ;;12 *** FREE ***
>
IFN QDEC20,<;;[225]
X(<?D^IRECTORY NOT FOUND>) ;;12
>
X(<?D^IRECTORY ALREADY SPECIFIED>) ;;13
X(<B^AD FILE SPECIFICATION>) ;;14
X(<L^OCAL SWITCH: >) ;;15
X(<^USED AS GLOBAL. ^I^GNORED>) ;;16
X(<?N^ULL ARG AFTER SWITCH: >) ;;17
X(<?I^LLEGAL DELIMITER: >) ;;20
X(<WARNING: P^ROJ OR PROG NO TRUNCATED>);;21
X(<?P^ROJ NO NOT FOLLOWED BY COMMA>) ;;22
X(<?I^LLEGAL PPN>) ;;23
X(<?P^ROT CODE: ^TOO MANY DIGITS>) ;;24
X(<?I^LLEGAL PROTECTION CODE>) ;;25
X(<S^WITCH: >) ;;26
X(<^NOT RECOGNIZED.>) ;;27
X(<^NOT FOLLOWED BY COLON>) ;;30
X(<^NOT FOLLOWED BY DECIMAL NUMBER>) ;;31
X(<?R^EAD ERROR ON: >) ;;32
X(<?C^LOSE ERROR ON: >) ;;33
X(<?T^TY END OF FILE OR TTY INPUT ERROR>);;34
X(<>) ;;35
X(<E^NTER FILE DEFINITIONS:>) ;;36
X(<?F^ILE: >) ;;37
X(< ^NOT FOUND>) ;;40
X(< E^NTER NEW FILE DESCRIPTOR:>) ;;41
X(<WARNING: SFD^ IGNORED>) ;;42
X(<WARNING: S^WITCHES IGNORED>) ;;43
X(<O^NLY ^DSK^ ALLOWED>) ;;44
X(<N^ESTED IND FILES NOT ALLOWED.^ I^GNORED>);;45
X(<S^PEC FILE STILL OPEN AS ^SYSIN. L^INE IGNORED>);;46
X(<WARNING: D^EVICE NOT ^DSK^ FOR SPEC FILE.^DSK^ ASSUMED>);;47
X(<?>) ;;50
X(<SYSIN^ ALREADY READ.^ L^INE IGNORED>);;51
X(<?I^LL DEL AFTER LOGICAL NAME>) ;;52
X(< ^IN FILE DESCRIPTOR>) ;;53
X(<W^ARNING: NO SWITCH NAME FOUND. ^I^GNORED.>) ;;54
X(<?C^ORE NOT AVAILABLE>) ;;55
X(<?C^ANNOT OPEN>) ;;56
X(<P^LEASE ENTER NEW DEVICE:>) ;;57
X(<?T^OO DEEP ^SFD^ NESTING>) ;;60
X(<?>) ;;61
IFN QDEBUG,<
X(<S^W INDEX OUT OF RANGE>)> ;;62
IFE QDEBUG,<
X(<>)>
X(<L^OGICAL NAME: >) ;;63
X(< ^ALREADY DEFINED. ^I^GNORED.>) ;;64
X(< >) ;;65 *** FREE ***
X(<EXECUTION STARTED>) ;;66
X(<I^ND SPEC FILE NOT FOUND. >) ;;67
X(<?>) ;;70
X(<I^ SWITCH IGNORED. ^F^ILE: >) ;;71
X(< ^IS NOT A DIRECTFILE>) ;;72
X(<L ^SWITCH IGNORED. ^F^ILE: >) ;;73
X(< ^IS NOT AN ^OUTFILE^ OR ^PRINTFILE>);;74
REPEAT <7-CC.>,<
WORD=WORD_5
>
WORD=WORD_1
EXP WORD
PURGE QINDEX,ZZ.,CC.,QCOUNT,WORD
.CREF
> ;END OF MACRO MESSAGES
YOCMES:
MESSAGES
SUBTTL OPDEF DECLARATIONS
OPDEF COMPSIZ [XEC OCINCS]
OPDEF ERROR [GOTO OCINER]
OPDEF FINDFILE [XEC OCINFF]
OPDEF GETPPN [XEC .OCIN3]
OPDEF GETSWITCH [XEC OCINSW]
OPDEF GETSYSBUFF [XEC OCINGS]
OPDEF MOVESPEC [XEC .OCIN5]
OPDEF NAMECOPY [XEC .OCINX]
OPDEF NEXTBUFF [GOTO OCIN3]
OPDEF NEXTLINE [GOTO OCIN4]
OPDEF NEXTSPEC [GOTO OCIN2]
OPDEF READSPEC [XEC OCINRE]
OPDEF READTTY [XEC .OCIN4]
OPDEF SETWIDTH [XEC OCINWI]
OPDEF TYPESWITCH [XEC OCINTW]
PROCINIT OCIN
SUBTTL COMPSIZ
COMMENT ;
Purpose: To compute the default buffer size and default
buffer number with a DEVSIZ UUO.
If DEVSIZ fails a DEVNAM is tried. If this
also fails the user is asked to supply the
physical device name.
ENTRY: OCINCS
INPUT ARGUMENTS:
X1 points to the actual ZFS record
OUTPUT ARGUMENTS:
LH of X3 contains default no of buffers
RH of X3 contains default buffer size
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: COMPSIZ
USED REGISTERS:
X0,X3,X4,X5,XNAME
USED ROUTINES: TYPENAME, TTYSPEC, GETNAME [225]
ERROR MESSAGE: Device: <DEVICE> illegal
;
OCINCS: PROC
LF X5,ZFSDEV(X1)
HLRZ X0,X5
CAIN X0,'*'B23
MOVSI X5,'DSK' ;Use DSK instead of *
LI X4,1 ;File status
LI X3,X4 ;DEVCHR argument in X4-X5
DEVSIZ X3,
NOP
IF ;RETURN ARG POSITIVE
JUMPLE X3,FALSE
THEN ;ARG OK
RETURN
FI
;NOW TRY DEVNAM
IF ;DEVICE EXISTED
DEVNAM X5,
GOTO FALSE
THEN ;USE PHYSICAL NAME
SF X5,ZFSDEV(X1)
GOTO OCINCS
FI
edit(41)
L1():! ;[41]
;ERROR
BREAKOUTIMAGE 1 ;?DEVICE
LF X0,ZFSDEV(X1)
TYPENAME
OUTIMAGE 2 ;ILLEGAL
OUTIMAGE 3 ;PLEASE ENTER PHYSICAL DEVICE
edit(225)
TTYSPEC ;[225]
GOTO L1 ;[225] on altmode
SF XNAME,ZFSDEV(X1);STORE NEW DEVICE NAME
GOTO OCINCS ;AND TRY AGAIN
EPROC
SUBTTL COPYSPEC
COMMENT ;
PURPOSE: To copy information from an IOSPEC entry (ZFS) to a
file object (ZFI) and possibly to a SFD record (ZYS).
If the ZFS entry contains sub-file directories then a
ZYS record is allocated with the .SAAR routine. Note
that both a ZYS block and a ZXB block may exist when
COPYSPEC is called. Only fields that are defined in
IOSPEC are copied. COPYSPEC is called from OCIN main
routine when the file objects for SYSIN and SYSOUT
are created and from the SETUPFILE subroutine in the
IONF module when a new file is generated.
ENTRY: .OCIN6
INPUT ARGUMENTS:
X1 points to ZFS
XRAC points to ZFI.
OUTPUT ARGUMENT:
Updated ZFI record
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: COPYSPEC
USED REGISTERS:
X0,X5,X4,XTAC
USED ROUTINE:
SAAR to allocate ZYS.
ERROR MESSAGES: -
;
.OCIN6:
PROC
SAVE <X6,X5,X4,XTAC>
LI X6,0 ;X6=0 means no extended block
IFON ZFIDE(XRAC)
LF X6,ZFIFIL(XRAC) ;ELSE X6=ref to extended block
IF ;ppn is specified in ZFS
SKIPN X0,OFFSET(ZFSPRJ)(X1)
GOTO FALSE
THEN
IF ;Sub-file directories in ZFS
LF X0,ZFSPRJ(X1)
JUMPN X0,FALSE
THEN ;Compute size of SFD block in ZFS
edit(225)
IFE QDEC20,<;[225]
LF XTAC,ZFSLNK(X1)
SUB XTAC,X1 ;Length of ZFS
SUBI XTAC,11 ;Length of SFD
L X4,XTAC
IF ;SFD IN ZFI
IFOFF ZFISFD(XRAC)
GOTO FALSE
THEN ;CHECK IF SIZE IS ADEQUATE
LF X5,ZFIARG(XRAC) ;LINK TO ZYS
SKIPE X6
LF X5,ZXBP2(X6) ;Link to ZYS if extended block
L X0,1(X5) ;LENGTH OF OLD ZYS
SUBI X0,2 ;SUBTRACT ZYS HEADER LENGTH
CAML X0,X4
ELSE
;HERE IF NEW ZYS RECORD MUST
;BE ALLOCATED!
HRLI XTAC,QZYS ;RECORD TYPE
ADDI XTAC,2 ;LENGTH INCL. HEADER
SETOM YSANIN(XLOW)
EXEC .SAAR ;GET RECORD
SF XTAC,ZFIARG(XRAC);LINK TO ZYS IN FILE OBJECT
SKIPE X0,X6
SF XTAC,ZXBP2(X6) ;Link to ZYS in extended block
SETON ZFISFD(XRAC) ;FLAG SFD:S FOR THIS FILE
IFN QSADEA,< ;UPDATE YSADEA IN DEALLOCATE VER.
L X0,YSATOP(XLOW)
ST X0,YSADEA(XLOW)>
FI
HRLI X0,OFFSET(ZFSARG)(X1)
HRRI X0,2(XTAC)
ADDI X4,2(XTAC)
BLT X0,(X4) ;MOVE SFD BLOCK
LF X0,ZYSP1(XTAC)
SF X0,ZFIPPN(XRAC) >;[225]
ELSE ;MOVE PPN TO ZFI OR ZXB
WLF X5,ZFSPRJ(X1) ;PPN TO BE MOVED
IF ;SFD IN ZFI
IFOFF ZFISFD(XRAC)
GOTO FALSE
THEN ;STORE PPN IN ZYS
WLF XTAC,ZFIPRJ(XRAC)
SKIPE X0,X6
LF XTAC,ZXBP2(X6)
SF X5,ZYSP1(XTAC)
ELSE
WSF X5,ZFIPRJ(XRAC)
FI
SF X5,ZFIPPN(XRAC)
FI FI
;NOW MOVE FILE NAME, EXTENSION AND PROTECTION
SKIPE X4,OFFSET(ZFSDEV)(X1)
SF X4,ZFIDVN(XRAC) ;MOVE DEVICE
SKIPE X4,OFFSET(ZFSFIL)(X1)
SF X4,ZFIFIL(XRAC) ;MOVE FILE NAME
SKIPE X4,OFFSET(ZFSEXT)(X1)
WSF X4,ZFIEXT(XRAC) ;MOVE EXTENSION
SKIPE X4,OFFSET(ZFSPT)(X1)
WSF X4,ZFIPT(XRAC) ;MOVE PROTECTION ETC.
LF X4,ZFSBUF(X1)
SF X4,ZFIBUF(XRAC) ;MOVE BUFFER
edit(24)
IF ;[24] not INFILE
IFON ZFIIF(XRAC)
GOTO FALSE
THEN ;Copy ZFSWDB,-NUM,-RON
LF ,ZFSWLR(X1)
SF ,ZFIWLR(XRAC)
FI ;[24]
IF ;OUTPUT FILE
IFOFF ZFIOF(XRAC)
GOTO FALSE
THEN ;SET MODE APPEND IF DEFINED
IFOFF ZFSAPP(X1)
GOTO FALSE
SETON ZFIAPP(XRAC)
FI
IF ;DIRECT FILE
IFOFF ZFIDF(XRAC)
GOTO FALSE
THEN LF X0,ZFSIML(X1)
SF X0,ZDFIML(XRAC)
FI
RETURN
EPROC
SUBTTL ERROR
Comment ;
Purpose: To print the file specification on the user TTY
and prepare for reading of correction. ERROR is
entered by a GOTO.
Entry: OCINER
Input argument: -
Output argument:-
Normal exit: IF TTY THEN NEXTSPEC ELSE NEXTBUFF
Error exit: -
Call format: ERROR
Used routines: OUTIMAGE, PRINTSPEC
Used register: XBUF
Error message: -
;
OCINER:
PRINTSPEC
OUTIMAGE 4 ;Please enter file spec
IFON SWTTY
NEXTSPEC
SETON SWERR
ST XBUF,YOCBF2(XLOW) ;Save current pointer
LI XBUF,YLOW+2(XLOW) ;XBUF now points to TTY buffer
NEXTBUFF
SUBTTL FINDFILE
COMMENT ;
PURPOSE: TO CHECK FOR DOUBLY DEFINED LOGICAL NAME IN IOSPEC
ENTRY: OCINFF
INPUT ARGUMENT:
LOGICAL NAME IN XNAME
OUTPUT ARGUMENTS:
-
NORMAL EXIT: RETURN
ERROR EXIT: NEXTSPEC IF LOGICAL NAME WAS ALREADY DEFINED
CALL FORMAT: FINDFILE
USED ROUTINES: BREAKOUTIMAGE
OUTIMAGE
TYPENAME
USED REGISTERS: X1 POINTER TO IOSPEC
ERROR MESSAGE: ?LOGICAL NAME <...> ALREADY DEFINED. IGNORED
;
OCINFF:
L X1,YIOSPC(XLOW) ;START OF IOSPEC
WHILE ;MORE SPECIFICATIONS
JUMPL X1,FALSE
DO ;MATCH NAME
IF CAME XNAME,OFFSET(ZFSNAM)(X1)
GOTO FALSE
THEN BREAKOUTIMAGE 63 ;LOGICAL NAME
L X0,XNAME
TYPENAME
OUTIMAGE 64 ;ALREADY DEFINED. IGNORED
UNSTK ;REMOVE RETURN ADDRESS
NEXTSPEC
FI
LFE X1,ZFSLNK(X1) ;NEXT ELEMENT
OD
RETURN
SUBTTL FIXSWITCH
COMMENT ;
Purpose: To scan and process a number of file switches.
GETSWITCH is used to retrieve next switch.
The switch list is considered ended when
delimiter space or carriage return is found.
Any other delimiter is considered illegal.
Entry: .OCINF
Input argument: -
Output arguments:
Switch SWSWERR is TRUE if error(s) were
detected during switch processing.
SWHLP is true if help message printed
successfully.
Normal exit: RETURN
Error exit: -
Call format: FIXSWITCH
Used routines: GETSWITCH to check validity and spelling of switch.
Used registers: X0,X2,X3
Error messages: ?Ill delimiter after last switch
?APPEND or RONLY expected after ACCESS
FILES must not be a global switch
I switch ignored
HELP switch misplaced. ignored
?Cannot open DISK
L switch ignored
Local switch used as global. Ignored
?Null arg after switch <...>
;
.OCINF:
LOOP ;until CR is found
IF GETSWITCH
GOTO FALSE ;ERROR RETURN, IGNORE SWITCH
THEN ;OK RETURN
JUMPE X2,FALSE ;NO SWITCH!
ASSERT < ;THAT INDEX FROM GETSWITCH IS OK
IF CAIGE X2,YOCSRE
GOTO FALSE
THEN OUTIMAGE 62 ;SW INDEX OUT OF RANGE
EXIT
FI
>
edit(225)
L X2,(X2) ;[225] TABLE ENTRY
XEC (X2) ;[225] PERFORM APPROPRIATE SWITCH ROUTINE
FI
AS ;MORE SWITCHES
CAIN XBYTE,"/"
GOTO TRUE
IF CAIE XBYTE," "
CAIN XBYTE,QCR
GOTO FALSE
THEN OUTIMAGE 5 ;ILL DEL AFTER LAST SWITCH
FI
SA
RETURN
;SWITCH ROUTINE DISPATCH TABLE:
edit(225)
DEFINE X(A,B)<;;[225]
IRP B,<
IFN QDEC20,<
XWD [ASCIZ"B"],A'B
>
IFE QDEC20,<
XWD ..N,A'B
..N==..N+1
>
>>
;;[225] NOTE THE ALPHABETIC ORDER!
edit(225)
..N==YOCSRE-YOCSRT ;[225]
IFN QDEC20,<XWD ..N,..N>;[225]
..N==0 ;[225]
YOCSRT: X(OCIN,<ACCESS,BUFFERS,FILES,HELP,IMAGESIZE>)
X(OCIN,<LIMIT,NUMBERED,SIZE,WORDALIGNED>)
edit(225)
YOCSRE: ;[225]
;ROUTINE FOR SWITCH "ACCESS":
OCINACCESS:
IFON SWGSW
GOTO OCINE1 ;LOCAL SWITCH USED AS GLOBAL
IF ;APPEND AFTER COLON
CAME X3,[SIXBIT/APPEND/]
GOTO FALSE
THEN IF ;SWITCH IN NEW
IFOFF SWTR
GOTO FALSE
THEN SETON ZFIAPP(XCB)
ELSE
SETON ZFSAPP(XBASE)
FI
RETURN
FI
edit(24)
IF ;[24] RONLY AFTER COLON
CAME X3,[SIXBIT/RONLY/]
GOTO FALSE
THEN IF ;SWITCH IN NEW
IFOFF SWTR
GOTO FALSE
THEN SETON ZFIRON(XCB)
ELSE
SETON ZFSRON(XBASE)
FI
RETURN
FI
;ELSE ERROR:
OUTIMAGE 6 ;[24] APPEND OR RONLY EXPECTED AFTER ACCESS
SETON SWSWERR
RETURN
;ROUTINE FOR SWITCH "BUFFERS"
OCINBUFFERS:
JUMPE X3,OCINE2 ;NULL ARGUMENT
IF ;GLOBAL SWITCH
IFOFF SWGSW
GOTO FALSE
THEN IF ;ARGUMENT LESS 32
CAILE X3,^D32
GOTO FALSE
THEN ST X3,YOCBFN(XLOW)
RETURN
FI
ST X3,YOCBFS(XLOW)
RETURN
FI
;LOCAL SWITCH:
IF ;SWITCH IN NEW
IFOFF SWTR
GOTO FALSE
THEN SF X3,ZFIBUF(XCB)
ELSE
SF X3,ZFSBUF(XBASE)
FI
RETURN
;ROUTINE FOR SWITCH "FILES"
OCINFILES:
IF ;NOT GLOBAL SWITCH
IFON SWGSW
GOTO FALSE
THEN ;ERROR
OUTIMAGE 7 ;FILES MUST BE A GLOBAL SWITCH
RETURN
FI
JUMPE X3,OCINE2 ;NULL ARGUMENT
ST X3,YOCFIL(XLOW)
RETURN
;ROUTINE FOR SWITCH "IMAGESIZE":
OCINIMAGESIZE:
IFON SWGSW
GOTO OCINE1 ;ERROR IF USED AS GLOBAL
JUMPE X3,OCINE2 ;NULL ARG
ADDI X3,2 ;ADJUST IMAGESIZE FOR CR-LF
IF ;SWITCH IN NEW
IFOFF SWTR
GOTO FALSE
THEN IF ;NOT DIRECTFILE
IFON ZFIDF(XCB)
GOTO FALSE
THEN BREAKOUTIMAGE 71 ;I SWITCH IGNORED
LF X0,ZFINAM(XCB)
TYPENAME
OUTIMAGE 72
ELSE
SF X3,ZDFIML(XCB)
FI
ELSE
SF X3,ZFSIML(XBASE)
FI
RETURN
;ROUTINE FOR SWITCH "HELP"
OCINHELP:
BEGIN
IF ;HELP MISPLACED
edit(67)
repeat 0,<;[67] Help possible also in NEW
IFON SWTR
GOTO TRUE
> ;[67]
IFON SWTTY
GOTO FALSE
IFON SWERR
GOTO FALSE
THEN OUTIMAGE 10 ;HELP SWITCH MISPLACED IGNORED
RETURN
FI
;*** [67] Use HELPER
EXTERN .HELPR
SETZ X2,
IF ;Channel 0 active now
DEVCHR X2,
JUMPE X2,FALSE
THEN ;Save status, call HELPER, restore channel
GETSTS X2
L X1,[SIXBIT/SIMRTS/]
EXEC .HELPR
L X4,YOCBST(XLOW)
IF ;Properly active
JUMPE X4,FALSE
THEN ;Restore
LI X1,(X2)
MOVSI X2,'TTY'
HRRI X3,1(X4)
HRLI X3,52+1(X4)
OPEN 0,X1
HALT
LI X6,23
LI X7,2
HRRI X1,-1(X3)
LINKBUFF
HLRZ X1,X3
HRRI X1,-1(X1)
LINKBUFF
FI
ELSE
L X1,[SIXBIT/SIMRTS/]
EXEC .HELPR
FI
RETURN
;*** End [67]
ENDD
;ROUTINE FOR SWITCH "LIMIT":
OCINLIMIT:
IFON SWGSW
GOTO OCINE1 ;LIMIT USED GLOBALLY
JUMPE X3,OCINE2 ;NULL ARGUMENT
IF ;SWITCH IN NEW
IFOFF SWTR
GOTO FALSE
THEN IF ;NOT AN OUTFILE OR PRINTFILE
IFON ZFIOF(XCB)
GOTO FALSE
THEN BREAKOUTIMAGE 73 ;L SWITCH IGNORED
LF X0,ZFINAM(XCB)
TYPENAME
OUTIMAGE 74
ELSE
SF X3,ZOFLIM(XCB)
FI
ELSE
SF X3,ZFSLIM(XBASE)
FI
RETURN
edit(24)
;[24] ROUTINE FOR SWITCH "NUMBERED":
OCINNUMBERED:
IFON SWGSW
GOTO OCINE1
IF ;Given in NEW
IFOFF SWTR
GOTO FALSE
THEN SETON ZFINUM(XCB)
ELSE
SETON ZFSNUM(XBASE)
FI
GOTO OCINW1 ;Also implies WORDALIGNED switch
;ROUTINE FOR SWITCH "SIZE":
OCINSIZE:
IFON SWGSW
GOTO OCINE1 ;GLOBAL SWITCH
JUMPE X3,OCINE2 ;NULL ARG
IF ;SIZE IN NEW
IFOFF SWTR
GOTO FALSE
THEN ST X3,YIOSIZ(XLOW)
ELSE
SF X3,ZFSSIZ(XBASE)
FI
RETURN
;[24] ROUTINE for switch "WORDALIGNED"
OCINWORDALIGNED:
IFON SWGSW
GOTO OCINE1
OCINW1: IF ;Given via NEW
IFOFF SWTR
GOTO FALSE
THEN SETON ZFIWDB(XCB)
ELSE
SETON ZFSWDB(XBASE)
FI
RETURN
;LOCAL SWITCH USED AS GLOBAL:
OCINE1:
BREAKOUTIMAGE 15 ;LOCAL SWITCH:
TYPESWITCH
OUTIMAGE 16 ;USED AS GLOBAL. IGNORED
RETURN
;NULL ARGUMENT:
OCINE2:
BREAKOUTIMAGE 17 ;NULL ARG AFTER SWITCH:
TYPESWITCH
SETON SWSWERR
RETURN
SUBTTL GETBUFF
COMMENT ;
Purpose: To find the smallest free buffer in IOBUFS.
Garbage collection (SAGC) is called when
there is no free buffer of sufficient size.
The selected buffer is NOT flagged as used.
Entry: .OCIN7
Input arguments:
X6 contains buffer size not including buffer header and link
X7 contains number of buffers
YOCBFS (LH) contains address to first buffer
Output arguments:
X1 contains buffer area base address
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: GETBUFF
USED ROUTINES: .SAGC
USED REGISTERS:
X0 - X7
X2 - X7 are saved
ERROR MESSAGE: -
;
.OCIN7: PROC
SAVE <X2,X3,X4,X5,X6,X7>
SETZB X2,X3 ;X2 = ADDRESS TO BUFFER CANDIDATE
;X3 = LENGTH OF " "
L X5,X6 ;SAVE BUFFER SIZE
IMUL X6,X7 ;BUFFER LENGTH * NO OF BUFFERS
ADDI X6,4 ;BUFFER RING HEADER + LENGTH
L X1,YOCBST(XLOW) ;LOAD START ADDRESS
L1():!
IF ;THIS BUFFER IS FREE
FREE (X1)
GOTO FALSE
THEN ;CHECK IF IT IS BIG ENOUGH
LFE X0,ZBHLEN(X1)
MOVN X0,X0
CAMN X0,X6
GOTO L5 ;Equal, take this buffer
CAMG X0,X6
GOTO FALSE ;Less, try next free
IF ;This is a possible candidate
JUMPE X2,TRUE ;Any previous candidates
CAIG X3,X0 ;Yes, is previous smaller?
GOTO FALSE ;Yes
THEN ;Nominate this buffer as candidate
L X3,X0
L X2,X1
FI
FI
LF X0,ZBHLNK(X1) ;NEXT LINK
IF ;NOT LAST LINK
CAIN X0,377777
GOTO FALSE
THEN ;LOAD NEXT LINK AND KEEP SEARCHING
L X1,X0
GOTO L1
FI
IF ;BUFFER FOUND
JUMPE X2,FALSE
THEN ;MAKE A NEW BUFFER AREA OF THE
;REMAINING SIZE
L X4,X2 ;COMPUTE LINK TO NEW BUFFER
ADD X4,X6
LF X0,ZBHLNK(X2)
SF X0,ZBHLNK(X4) ;MOVE OLD LINK
SF X4,ZBHLNK(X2) ;AND SET UP NEW
MOVN X0,X6
SF X0,ZBHLEN(X2) ;STORE NEW LENGTH
SUB X3,X6
MOVN X3,X3
SF X3,ZBHLEN(X4) ;STORE LENGTH OF NEW BUFFER
SETON ZBHCON(X4) ;FLAG NEW BUFFER AS CONSECUTIVE
L X1,X2
GOTO L5 ;TAKE THIS BUFFER
FI
;HERE IF NO BUFFER FOUND
L X0,X6
ST X0,YSAREL(XLOW)
STACK X0 ;SAVE LENGTH
LI X0,0
EXEC .SAGC ;CALL GARBAGE COLLECTOR
;NOW SET UP A NEW BUFFER WITH THE
;REQUIRED LENGTH OBTAINED WITH .SAGC
LFE X0,ZBHLEN(X1) ;COMPUTE LINK TO NEW BUFFER
SKIPG X0
MOVN X0,X0
ADDI X0,(X1)
SF X0,ZBHLNK(X1) ;STORE LINK
L X1,X0 ;X1 NOW POINTS TO NEW BUFFER
SETOM OFFSET(ZBHLNK)(X1);FLAG LAST BUFFER AS CONSECUTIVE
UNSTK X0 ;GET LENGTH OF NEW BUFFER
MOVN X0,X0
SF X0,ZBHLEN(X1) ;AND STORE IT
GOTO L1 ;TRY THIS NEW BUFFER NOW
L5():! ;HERE WHEN BUFFER FOUND
RETURN
EPROC
SUBTTL GETPPN
COMMENT ;
PURPOSE: TO CONVERT A PROJECT OR PROGRAMMER NUMBER.
FIRST NON-OCTAL CHARACTER IS TAKEN AS DELIMITER.
IF THE NUMBER CONTAINS MORE THAN 6 DIGITS
A WARNING IS PRINTED. IF FOUND DELIMITER IS
ASTERISK THEN NEXT CHARACTER IS RETURNED
AS DELIMITER AND XNAME CONTAINS AN ASTERISK
IN SIXBIT LEFT JUSTIFIED AT RETURN.
ENTRY: .OCIN3
INPUT ARGUMENT: -
OUTPUT ARGUMENTS:
BINARY CODED OCTAL PRJ OR PRG NO IN XNAME
DELIMITER IN XBYTE.
NORMAL EXIT: SKIP RETURN
ERROR EXIT: IMMEDIATE RETURN WHEN TRUNCATION OCCURRED
USED ROUTINES: GETBYTE, OUTIMAGE
USED REGISTERS: XBYTE, XNAME
ERROR MESSAGE: PROJ OR PROG NO TRUNCATED
;
.OCIN3:
LI XNAME,0
WHILE ;OCTAL DIGIT
GETBYTE
CAIL XBYTE,"0"
CAILE XBYTE,"7"
GOTO FALSE
DO ;PACK IT IN XNAME
IF ;MORE THAN 6 DIGITS
TRNN XBYTE,700000
GOTO FALSE
THEN TLO XNAME,-1 ;FLAG TRUNCATION
ELSE ;CONVERT AND PACK
LSH XNAME,3
ADDI XNAME,-60(XBYTE);ASCII -60 = BINARY DIGIT
FI
OD
IF TLZN XNAME,-1
GOTO FALSE
THEN OUTIMAGE 21 ;WARNING: PROJ OR PROG NO TRUNCATED
RET
FI
AOS (XPDP)
CAIE XBYTE,"*"
RET
LI XNAME,'*'B23
GETBYTE
RET
SUBTTL GETSPEC
COMMENT ;
PURPOSE: TO PARSE A FILE SPECIFICATION AND STORE
IT IN THE ZFD RECORD
GETSPEC ACCEPTS SPACES BETWEEN PARTS OF THE
FILE SPECIFICATION AND AFTER THE FILE
SPECIFICATION. IF THERE ARE SPACE(S) AFTER
THE LAST PART GETSPEC SCANS UNTIL A NON
SPACE CHARACTER IS FOUND. THIS SHOULD BE
EITHER OF SLASH OR CARRIAGE RETURN.
ENTRY: .OCINB
INPUT ARGUMENTS:
GETNAME CAN BE USED TO GET NEXT NAME
OF THE SPECIFICATION
OUTPUT ARGUMENT:
ZFD IS UPDATED AND CONTAINS THE FILE SPEC
XBYTE CONTAINS THE DELIMITER (NORMALLY SLASH OR CR).
NORMAL EXIT: SKIP RETURN
ERROR EXIT: IMMEDIATE RETURN
CALL FORMAT: GETSPEC
USED ROUTINES:
GETNAME, GETPPN
USED REGISTERS:
X0, XBYTE, XNAME
ERROR MESSAGES: ?PROJ NO NOT FOLLOWED BY COMMA
?TOO DEEP SFD NESTING
?RIGHT SQUARE BRACKET MISSING
?PROTECTION CODE EXCEEDS THREE DIGITS
?RIGHT ANGLE BRACKET MISSING
?ILL DELIMITER <(XBYTE)> IN FILE SPEC
?Directory already specified
;
.OCINB: PROC
SETZM OFFSET(ZFDDEV)(XLOW) ;ZERO ZFD RECORD
HRLI OFFSET(ZFDDEV)(XLOW)
HRRI OFFSET(ZFDFIL)(XLOW)
BLT OFFSET(ZFDSFD)(XLOW)
GETNAME
IF ;DELIMITER IS COLON
CAIE XBYTE,":"
GOTO FALSE
THEN SF XNAME,ZFDDEV(XLOW);STORE DEVICE
GETNAME ;AND GET NEXT PART
FI
edit(225)
IFN QDIRTR,<;[225] CHECK FOR <DIRECTORY>
IF ;LEFT BROKET
CAIE XBYTE,74
GOTO FALSE
THEN XEC OCINGD ;TRANSLATE TO [p,pn]
GOTO L9 ;ON ERROR
FI>
SF XNAME,ZFDFIL(XLOW);STORE FILE NAME
IF ;DELIMITER IS DOT
CAIE XBYTE,"."
GOTO FALSE
L1():! THEN ;EXTENSION
GETNAME ;GET EXTENSION
edit(3)
;[3] SET FUTURE DATE TO 77777 IN DATE1 FIELD IN EXTENSION
; WORD TO INDICATE THAT OLD EXTENSION SHOULD BE ZEROED IF
; THE FILE SPEC CONTAINS A . BUT NO EXTENSION
SKIPN XNAME
LI XNAME,77777
WSF XNAME,ZFDEXT(XLOW);AND STORE IT
FI
IF ;DELIMITER IS LEFT SQUARE BRACKET
CAIE XBYTE,"["
GOTO FALSE
edit(225)
L2():! THEN IF ;[225] PATH (DIRECTORY) NOT ALREADY DEFINED
SKIPN OFFSET(ZFDPRJ)(XLOW)
GOTO FALSE
THEN ;ERROR
OUTIMAGE 13
GOTO L9
FI
GETPPN ;GET PROJECT NO
RET ;IF ERROR
SF XNAME,ZFDPRJ(XLOW);STORE PROJECT NUMBER
edit(144)
IF ;[144] Delimiter is "-"
CAIE XBYTE,"-"
GOTO FALSE
JUMPN XNAME,FALSE ;AND no proj no given
THEN ;Default path if "]" follows
STACK YOCPNT(XLOW)
edit(244)
SETOM OFFSET(ZFDPRG)(XLOW) ;[244] Save explicit
; default path as -1
GETNAME
NOP -1 ;[263] No funny name
edit(263)
UNSTK
JUMPE XNAME,L4 ;Go check for "]"
ST YOCPNT(XLOW) ;Back up pointer
LI XBYTE,"-"
FI ;[144]
IF ;DELIMITER IS NOT COMMA
CAIN XBYTE,","
GOTO FALSE
THEN ;ERROR
OUTIMAGE 22 ;PROJ NO NOT FOLLOWED BY COMMA
RETURN
FI
GETPPN ;GET PROGRAMMER NO
RET ;IF ERROR
SF XNAME,ZFDPRG(XLOW);STORE PROGRAMMER NO
edit(144)
IF ;[144] proj or prog is zero
JUMPE XNAME,TRUE
LF ,ZFDPRJ(XLOW)
JUMPN FALSE
THEN ;Fill from device ppn
edit(244)
SKIPE XNAME,OFFSET(ZFDDEV)(XLOW) ;[244]
DEVPPN XNAME, ;[244]
CALLI XNAME,24 ;GETPPN UUO, was redefined here
NOP ;Just in case of JACCT
WLF ,ZFDPRJ(XLOW)
TLNN -1
HLLM XNAME,OFFSET(ZFDPRJ)(XLOW)
TRNN -1
HRRM XNAME,OFFSET(ZFDPRG)(XLOW)
FI ;[144]
edit(225)
IFE QDEC20,<;[225]
IF ;DELIMITER IS COMMA
CAIE XBYTE,","
GOTO FALSE
THEN ;WE HAVE FOUND SFD!
L X0,YOCPNT(XLOW) ;SAVE POINTER TO FIRST SFD
SF X0,ZFDPNT(XLOW) ;IN ZFD
LOOP ;UNTIL NO MORE SFD
GETNAME
NOP -1 ;[263] No funny SFD name!
edit(263)
AOS OFFSET(ZFDSFD)(XLOW) ;COUNT NO OF SFD:S
AS CAIN XBYTE,","
GOTO TRUE
SA
;NOW DO A GETTAB FROM TABLE .GTLVD (TABLE 16)
;ELEMENT %LDSFD (ENTRY 17) TO DETERMINE
;MAX NESTING LEVEL
L X0,[XWD 17,16]
GETTAB X0,
LI X0,0 ;NO SFD:S ON ERROR RETURN!
IF ;TOO DEEP NESTING
CAML X0,OFFSET(ZFDSFD)(XLOW)
GOTO FALSE
THEN ;ERROR!
OUTIMAGE 60 ;?TOO DEEP SFD NESTING
RET
FI
FI
>;[225]
L4():! IF ;NOT RIGHT SQUARE BRACKET
CAIN XBYTE,"]"
GOTO FALSE
THEN ;ERROR
OUTIMAGE 23 ;RIGHT SQUARE BRACKET MISSING
RET
FI
GETBYTE ;GET NEXT DELIMITER
FI
IFN QDEC20,<;[225]
IF ;Delimiter is ";"
CAIE XBYTE,";"
GOTO FALSE
THEN ;May be DEC-20 style protection
GETBYTE
IF ;P
CAIN XBYTE,"P"
GOTO TRUE
CAIE XBYTE,"p"
GOTO FALSE
THEN ;Should be protection
GETPPN
GOTO L9
IF ;Too many digits
TLNN XNAME,-1
GOTO FALSE
THEN ;Error message
OUTIMAGE 24
RET
FI
;Translate to TOPS-10 format
HRRZ X1,XNAME
LSH XNAME,6 ;Propagate privileges
TRO X1,(XNAME)
LSH XNAME,6
TRO X1,(XNAME)
MOVSI XNAME,(1B9) ;Stop bit for loop
LOOP
LI 7
TRNE X1,<FP%EX>B23
LI 6 ;EXECUTE
TRNE X1,<FP%RD>B23
LI 5 ;READ
TRNE X1,<FP%APP>B23
LI 4 ;APPEND
TRNE X1,<FP%WR>B23
LI 2 ;WRITE
TRC X1,77B23
TRCE X1,77B23
ORM XNAME
LSH XNAME,3
AS
JUMPG XNAME,TRUE ;3 times through loop
SA
LSH XNAME,-3
edit(305)
GOTO L5 ;[305]
FI
GOTO L9 ;Give up
FI
>
IF ;DELIMITER IS LEFT ANGLE BRACKET
CAIE XBYTE,74
GOTO FALSE
L3():! THEN ;PROTECTION CODE
GETPPN
RET ;IF ERROR
IF ;MORE THAN 3 DIGITS
TRZN XNAME,777000
GOTO FALSE
THEN ;PRINT ERROR
OUTIMAGE 24 ;PROT CODE EXCEEDS THREE DIGITS
RET
FI
IF ;DELIMITER IS NOT RIGHT ANGLE BRACKET
CAIN XBYTE,76
GOTO FALSE
THEN ;ERROR
OUTIMAGE 25 ;RIGHT ANGLE BRACKET MISSING
RET
FI
L5():! SF XNAME,ZFDPT(XLOW) ;[305]
GETBYTE ;GET NEXT DELIMITER
FI
CAIN XBYTE," " ;ELIMINATE POSSIBLE SPACE HERE
edit(225)
GETBYTE ;[225] Only one possible
IF ;Delimiter is not CR or /
CAIE XBYTE,QCR
CAIN XBYTE,"/"
GOTO FALSE
THEN ;See if it is a usable delimiter
CAIN XBYTE,"."
GOTO L1 ;Try extension
CAIN XBYTE,"["
GOTO L2 ;Try ppn
CAIN XBYTE,74
GOTO L3 ;Try protection
;ELSE illegal delimiter!
BREAKOUTIMAGE 20 ;?Ill delimiter
LI X1,""""
PBOUT ;[225]
L X1,XBYTE
PBOUT ;[225]
LI X1,""""
PBOUT ;[225]
OUTIMAGE 53 ;in file spec
ELSE
AOS (XPDP)
FI
L9():! RETURN
EPROC
SUBTTL NAMECOPY [225]
COMMENT;
Purpose: Copies a string valid as a directory or (long)
file name.
Entry: .OCINX
Input: X2 points to next byte in target string
or is zero (at least left half) when no
copy is wanted.
The coroutine "byte-producer" (see below)
delivers one byte in XBYTE on each call.
Call: NAMECOPY
GOTO byte-producer
Output: X2 is updated target pointer.
The delimiter following the name is also copied.
;
.OCINX: PROC
N==0 ;SHOULD BE ZERO
LOOP
XEC @-N(XPDP) ;NEXT BYTE
TLNE X2,-1
IDPB XBYTE,X2
AS
IFN QDEC20,<
CAIE XBYTE,"_"
CAIN XBYTE,"-"
GOTO TRUE
>
IFE QDEC20,<CAIE XBYTE,"%">
CAIN XBYTE,"$"
GOTO TRUE
CAIL XBYTE,"0"
CAILE XBYTE,"z"
GOTO FALSE
CAIGE XBYTE,"a"
CAIG XBYTE,"9"
GOTO TRUE
CAIG XBYTE,"Z"
CAIGE XBYTE,"A"
GOTO FALSE
GOTO TRUE
SA
AOS -N(XPDP) ;SKIP RETURN
RETURN
EPROC
SUBTTL OCINGD [225] Translate directory to ppn
IFN QDIRTR,<
Comment;
Input: YOCPNT points to first char after left broket.
Output: On success, ZFDPPN is [p,,pn]
or SIXBIT"* ", and
YOCPNT points to first character after first "name"
Following right broket, XNAME is that "name" in SIXBIT.
Normal return: skip.
Error return: non-skip.
;
OCINGD: PROC
SAVE <X1,X2,X3>
N==3
L X2,YOCPNT(XLOW)
ILDB XBYTE,X2
IF ;*
CAIE XBYTE,"*"
GOTO FALSE
THEN ;Put SIXBIT"* " in PPN field
ST X2,YOCPNT(XLOW)
MOVSI X1,(<'*'>B5)
ILDB XBYTE,YOCPNT(XLOW)
CAIE XBYTE,76
GOTO L9
ELSE
L X2,[POINT 7,YOCTXT(XLOW)]
WLF X1,ZFDDEV(XLOW)
IF ;Device was scanned
JUMPE X1,FALSE
THEN ;Put DEV: in string
NAMECOPY
GOTO [SETZ
LSHC 6
ADDI 40
ST XBYTE
RET]
LI ":"
DPB X2 ;Overwrite blank
FI
LI 74
IDPB X2 ;Left broket
NAMECOPY
GOTO [ILDB XBYTE,YOCPNT(XLOW)
RET]
CAIE XBYTE,76;Right broket?
GOTO L9
SETZ
DPB X2 ;CLOSE ASCIZ STRING
L X2,[POINT 7,YOCTXT(XLOW)]
SETZ X1, ;TRY RECOGNITION
RCDIR
ERJMP .+2
TLNE X1,(RC%NOM+RC%AMB)
SETZB X2,X3
IF ;OK
JUMPE X3,FALSE
THEN ;Find PPN
L X1,X3
STPPN%
ERJMP [SETZ X2,
GOTO .+1]
FI
FI
IF ;Zero ppn
JUMPN X2,FALSE
THEN ;ERROR
OUTIMAGE 12 ;DIRECTORY NOT FOUND
ELSE
WSF X2,ZFDPRG(XLOW)
GETNAME
AOS -N(XPDP) ;Success, skip
FI
L9():! RETURN
EPROC
>
SUBTTL GETSWITCH
COMMENT ;
Purpose: To look up a switch and get its value.
MOST SWITCHES SHOULD BE
FOLLOWED BY COLON AND AN ARGUMENT. THIS ARGUMENT
SHOULD BE A DECIMAL INTEGER OPTIONALLY FOLLOWED
BY THE LETTER P OR K. THE ACCESS SWITCH SHOULD
HOWEVER BE FOLLOWED BY A KEYWORD.
IF THE SWITCH IS NOT FOUND AN ERROR MESSAGE IS
ISSUED.
ENTRY: OCINSW
INPUT ARGUMENTS:
GETBYTE WILL RETURN FIRST BYTE OF THE SWITCH AFTER THE SLASH
OUTPUT ARGUMENTS:
X0-X1 CONTAIN THE SWITCH IN SIXBIT (DEC10 ONLY)
X2 POINTS TO ENTRY IN YOCSRT, OR IS ZERO
X3 CONTAINS THE NUMBER AFTER : IN BINARY,
OR THE KEYWORD IN SIXBIT.
NORMAL EXIT: SKIP RETURN
ERROR EXIT: IMMEDIATE RETURN
CALL FORMAT: GETSWITCH
USED ROUTINES:
GETBYTE, OUTIMAGE
USED REGISTERS:
X0-X10, XBYTE
ERROR MESSAGES: WARNING: NO SWITCH
SWITCH: <...> NOT RECOGNIZED. IGNORED
SWITCH: <...> NOT FOLLOWED BY DECIMAL DIGIT
;
OCINSW: PROC
SAVE <X4,X6>
edit(225)
IFE QDEC20,<;[225]
LI X0,0
MOVSI X4,440700 ;BYTE POINTER TO X0
>
L X2,YOCPNT(XLOW) ;[225]
GETBYTE ;GET FIRST CHARACTER OF SWITCH
IF ;SLASH, CR OR SPACE
CAIE XBYTE,QCR
CAIN XBYTE,"/"
GOTO TRUE
CAIE XBYTE," "
GOTO FALSE
THEN ;NO SWITCH!
SETZ X2, ;[225]
OUTIMAGE 54 ;WARNING: NO SWITCH
GOTO L8
FI
IFN QDEC20,<;[225]
ST X2,YOCPNT(XLOW)
L X2,[POINT 7,YOCTXT(XLOW)]
ST XBYTE,X6 ;REMEMBER 1ST LTR
NAMECOPY
GOTO [ILDB XBYTE,YOCPNT(XLOW)
RET]
SETZ
DPB X2 ;END OF ASCIZ STRING
L X2,[POINT 7,YOCTXT(XLOW)]
LI X1,YOCSRT-1
TBLUK
IF ;NO MATCH OR AMBIGUOUS
TLNN X2,(TL%NOM+TL%AMB)
GOTO FALSE
THEN ;NO FIND
SWERROR 27
GOTO L9
FI
LI X2,(X1)
IF ;":" FOUND
CAIE XBYTE,":"
GOTO FALSE
THEN ;FIND VALUE
IF ;ACCESS
CAIE X6,"A"
GOTO FALSE
THEN GETNAME
L X3,XNAME
GOTO L8
FI
STACK X2
L X1,YOCPNT(XLOW)
LI X3,^D10
NIN
IF ;OK
GOTO FALSE
THEN
L X3,X2
UNSTK X2
ST X1,YOCPNT(XLOW)
LDB XBYTE,X1
CAIN XBYTE,QLF
LI XBYTE,QCR
CAIN XBYTE,QCR
GOTO L8
CAILE XBYTE,"Z"
SUBI XBYTE,40
IF ;"P"
CAIE XBYTE,"P"
GOTO FALSE
THEN ;MULTIPLY BY 512
LSH X3,9
GETBYTE
ELSE
IF ;"K"
CAIE XBYTE,"K"
GOTO FALSE
THEN ;MULT BY 1024
LSH X3,^D10
GETBYTE
FI FI
GOTO L8
FI
UNSTK X2 ;ERROR
SWERROR 31
GOTO L9
ELSE ;FIND OUT IF A COLON SHOULD HAVE BEEN SUPPLIED
CAIN X6,"W"
GOTO L8
CAIE X6,"H"
CAIN X6,"N"
GOTO L8
SWERROR 30
GOTO L9
FI>
IFE QDEC20,<;[225]
IDPB XBYTE,X4
HRLZ X2,YOCSWL ;LENGTH OF YOCSWA
LOOP ;UNTIL SHORT FORM FOUND
;OR TABLE EXHAUSTED
HLRZ X1,YOCSWA(X2)
CAMN X1,XBYTE
GOTO FALSE ;FOUND!
AS INCR X2,TRUE
;NOT FOUND!
edit(32)
GETBYTE ;[32]
WHILE ;NOT CR OR SLASH
CAIE XBYTE,QCR
CAIN XBYTE,"/"
GOTO FALSE
DO ;STORE IT
TRNN X0,(177B16) ;[32]
IDPB XBYTE,X4
GETBYTE
OD
SWERROR 27
GOTO L9
SA
;NOW COMPUTE BYTE POINTER TO LONG FORM IN YOCSWT:
HRLI X2,0 ;REMOVE NEG LENGTH IN LH OF X2
HRRZ X7,YOCSWA(X2) ;X7:=START INDEX TO REST OF SWITCH IN YOCSWT
IDIVI X7,5 ;X7:=WORD ADDRESS
L X6,X10 ;X6:=BYTE ADDRESS WITHIN THIS WORD
IMULI X6,7 ;COMPUTE P OF BYTE POINTER
SUBI X6,44
IMULI X6,-^D4096 ;SHIFT P TO ITS PLACE
IORI X6,7B29+X7 ;INSERT SIZE AND INDEX REGISTER
LSH X6,^D18 ;MOVE TO LH OF POINTER
HRRI X6,YOCSWT ;SET UP START ADDRESS
;COMPUTE LENGTH OF LONG FORM:
HRRZ X5,YOCSWA+1(X2) ;START OF NEXT SWITCH MINUS
HRRZ X1,YOCSWA(X2) ;START OF THIS SWITCH =
SUB X5,X1 ;LENGTH OF THIS SWITCH
;SCAN LONG FORM AND COMPARE:
WHILE SOJL X5,L3
DO ILDB X3,X6 ;GET BYTE FROM YOCSWT
GETBYTE ;GET BYTE FROM SWITCH
CAIN XBYTE,":"
GOTO L2 ;Match is over, switch shorter than long form
CAIE XBYTE,"/"
CAIN XBYTE,QCR
GOTO L1 ;Match is over, switch shorter than long form,
;no colon
CAIN XBYTE," " ;[32] Space finishes the switch
GOTO L3 ;[32] Scan past spaces and other stuff
TRNN X0,(177B16) ;[32]
IDPB XBYTE,X4 ;Store byte in X0 if not overflow
CAMN XBYTE,X3 ;Continue if match
OD
;Here if the switch did not match
edit(225)
SWERROR 27 ;[225]
;Here if long form in YOCSWT exhausted
;Scan until switch exhausted
L3():! LOOP ;Until colon, null, slash or CR
GETBYTE
AS CAIN XBYTE,":"
GOTO L2
CAIN XBYTE,"/"
GOTO FALSE
JUMPE XBYTE,TRUE ;[225]
CAIE XBYTE,QCR
GOTO TRUE
SA
L1():! SETO X3, ;[225] Return -1 as value if no colon found
GOTO L8
;Here if colon found
L2():! IF ;ACCESS
CAIE X2,0
GOTO FALSE
THEN GETNAME
L X3,XNAME
GOTO L8
FI
LI X3,0
WHILE ;DECIMAL DIGIT, "P" OR "K"
GETBYTE
CAIN XBYTE," "
GOTO L8
CAIE XBYTE,"/"
CAIN XBYTE,QCR
GOTO L8
IF ;P
CAIE XBYTE,"P"
GOTO FALSE
THEN LSH X3,^D9
GOTO L8
FI
IF ;K
CAIE XBYTE,"K"
GOTO FALSE
THEN LSH X3,^D10
GOTO L8
FI
IF ;Not decimal digit
CAIGE XBYTE,"0"
GOTO TRUE
CAIG XBYTE,"9"
GOTO FALSE
THEN ;ERROR
edit(225)
SWERROR 31 ;[225]
GOTO L9
FI
DO ;CONVERT TO BINARY
IMULI X3,^D10
ADDI X3,-60(XBYTE)
OD >;[225]
edit(225)
L8():! IFE QDEC20,<LI X2,YOCSRT(X2)> ;[225]
AOS -2(XPDP) ;OK RETURN
L9():! LDB XBYTE,YOCPNT(XLOW) ;[225]
CAIN XBYTE,QLF ;[225]
LI XBYTE,QCR ;[225]
WHILE ;NOT CR, NULL, SLASH OR SPACE
JUMPE XBYTE,FALSE
CAIN XBYTE," "
GOTO FALSE
CAIE XBYTE,"/"
CAIN XBYTE,QCR
GOTO FALSE
DO GETBYTE
OD
RETURN
EPROC
edit(225)
OCINSE: PROC ;[225] SWITCH ERROR
BREAKOUTIMAGE 26 ;SWITCH:
OUTSTR YOCTXT(XLOW)
OUTCHR [" "]
SETZ X2,
SETON SWSWERR
BRANCH OCINTS ;USE INLINE PARAM FROM OCINSE CALL
EPROC
SUBTTL GETSYSBUFF
COMMENT ;
PURPOSE: TO ALLOCATE A BUFFER AREA FOR SYSIN AND SYSOUT.
NUMBER OF BUFFERS AND BUFFER SIZE IS TAKEN
FIRST FROM THE LOCAL B-SWITCH, OR, IF NOT
DEFINED, FROM THE GLOBAL B-SWITCH, OR, IF STILL
NOT DEFINED, FROM DEFAULT OBTAINED WITH THE
DEVSIZ UUO.
ENTRY: OCINGS
INPUT ARGUMENT: XRAC POINTS TO FILE OBJECT
X0 POINTS TO BUFFER RING HEADER
OUTPUT ARGUMENTS:
X1 POINTS TO BUFFER AREA
X0 POINTS TO BUFFER RING HEADER
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: GETSYSBUFF
USED ROUTINES: GETBUFF
USED REGISTERS: X0,X6,X7
ERROR MESSAGES: -
;
OCINGS:
LF X7,ZFIDVN(XRAC) ;GET DEVICE
LI X6,1
LI X0,X6
DEVSIZ X0, ;FIND DEFAULT NO OF BUFFERS
;AND DEFAULT BUFFER SIZE
NOP ;Ignore error return
LF X7,ZFIBUF(XRAC) ;LOCALLY DEFINED NO OF BUFFERS
HRRZ X6,X0 ;X6:=DEFAULT BUFFER SIZE
IF ;BUFFERS NOT DECLARED IN IOSPEC
CAIN X7,0
SKIPE X7,YOCBFN(XLOW)
GOTO FALSE
THEN HLRZ X7,X0 ;X7:=DEFAULT NO OF BUFFERS
ELSE
IF ;BUFFER SIZE IN IOSPEC
CAIG X7,^D32
GOTO FALSE
THEN L X6,X7 ;X6:=DEFINED BUFFER SIZE
HLRZ X7,X0 ;AND X7:=DEFAULT NO OF BUFFERS
FI
FI
SF X7,ZFIBUF(XRAC)
SF X6,ZFIBFS(XRAC) ;SAVE VALUES IN FILE OBJECT
EXCH XCB,XRAC
GETBUFF ;NOW GET A BUFFER
EXCH XCB,XRAC
LI X0,1(X1) ;X0:=POINTER TO BUFFER RING HEADER
RET
SUBTTL FINDLOGICAL
COMMENT ;
PURPOSE: TO DEFINE THE LOGICAL NAME IN A FILE SPEC
THE FOLLOWING RULES ARE APPLIED:
SPECIFICATION: LOGICAL NAME WILL BE:
LOG [<DIR>]FIL.EXT LOG
[DEV:][<DIR>]FIL.EXT FIL
DEV: DEV
AT LEAST DEVICE OR FILE NAME MUST THUS BE
PRESENT WHEN LOGICAL NAME IS OMITTED.
ENTRY: .OCINJ
INPUT ARGUMENT:
X6 POINTS TO THE BEGINNING OF FILE SPEC
FILE SPEC IN YOCBUF.
OUTPUT ARGUMENT:
YOCPNT POINTS TO BEGINNING OF PART FOLLOWING
LOGICAL NAME
XNAME CONTAINS LOGICAL NAME
XBYTE CONTAINS FOUND DELIMITER
X0 = -1 IF ERROR FOUND
X0 = 1 IF DELIMITER IS CARRIAGE RETURN
X0 = 0 OTHERWISE
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: FINDLOGICAL
USED ROUTINES: GETREST, GETNAME
USED REGISTERS: X0,X1,XBYTE
ERROR MESSAGES: -
;
.OCINJ: PROC
GETREST
edit(225)
IF ;[225] NO NAME YET FOUND
JUMPN XNAME,FALSE
THEN ;POSSIBLE ERROR
IFN QDEC20,<
IF ;THERE IS A DIRECTORY NAME
CAIE XBYTE,74
GOTO FALSE
THEN ;SCAN PAST IT
L1():!
STACK X2
SETZ X2, ;Want no copy, just scan
NAMECOPY
GOTO [ILDB XBYTE,YOCPNT(XLOW)
RET]
UNSTK X2
IF ;WE NOW HAVE RIGHT BROKET
CAIE XBYTE,76
GOTO FALSE
THEN ;DIRECTORY NAME WAS SCANNED ALLRIGHT
GETNAME ;THIS SHOULD BE IT
JUMPN XNAME,L2
FI FI
>
SETO
RETURN
FI
L2():! IF ;DELIMITER IS NOT SPACE
CAIN XBYTE," "
GOTO FALSE
THEN ;CHECK FOR POSSIBLE DELIMITERS
IF ;COLON
CAIE XBYTE,":"
GOTO FALSE
THEN ;DEVICE, TRY NEXT
L X1,XNAME
GETNAME
IF ;NO NAME FOUND
JUMPN XNAME,FALSE
THEN
IFN QDEC20,<;CHECK FOR DIRECTORY
CAIN XBYTE,74
GOTO L1 >
L XNAME,X1
FI FI
SETZ XBYTE,
ST X6,YOCPNT(XLOW)
FI
SETZ ;OK RETURN
RETURN
EPROC
SUBTTL MOVESPEC
edit(225)
COMMENT ; [225] SEVERAL CHANGES: SQUEEZE BLANKS ETC
PURPOSE: TO MOVE A LINE FROM THE INPUT BUFFER TO THE INTERNAL BUFFER
ENTRY: .OCIN5
INPUT ARGUMENTS:
XBUF POINTS TO THE CURRENT BUFFER POINTER
OUTPUT ARGUMENTS:
YOCPNT POINTS TO THE FIRST BYTE IN YOCBUF.
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: MOVESPEC
USED ROUTINES: READSPEC, SPECCOPY
USED REGISTERS:
XBYTE,XBUF
ERROR MESSAGES: -
;
.OCIN5: PROC
SETON SWGC
SPECCOPY
GOTO [SOSGE 1(XBUF)
READSPEC
ILDB XBYTE,(XBUF)
RET ] ;COROUTINE TO GET ONE CHARACTER
RETURN
EPROC
SUBTTL SPECCOPY [225]
COMMENT;
PURPOSE: COPIES A SPECIFICATION CHARACTER BY CHARACTER,
EDITING OUT MULTIPLE SPACES, WHICH ARE
REPLACED BY ONE SPACE (NONE AT THE END).
INPUT: A CHARACTER AT A TIME IS DELIVERED BY THE
COROUTINE WHOSE ADDRESS FOLLOWS THE PUSHJ.
CALL: SPECCOPY
GOTO COROUTINE
ENTRY: .OCINZ
RETURN: SKIP PAST COROUTINE ADDRESS
OUTPUT: A FILE SPECIFICATION LINE (PRESUMABLY), FINISHED
BY CR-LF-NULL, SUITABLE AS ASCIZ STRING, AND
CONTAINING NO MULTIPLE SPACES.
THE LINE IS PLACED IN YOCBUF(XLOW).
;
QCOMCHAR=="!" ;START OF COMMENT - IGNORE REST OF LINE
IFE QDEC20,<QCOMCHAR==";"> ;HAVE TO KEEP SEMICOLON?
.OCINZ: PROC
SAVE <X1,X7>
N==2 ;NUMBER OF WORDS ON STACK
L X7,[POINT 7,YOCBUF(XLOW)]
ST X7,YOCPNT(XLOW)
;NOW GET NEXT LINE FROM INPUT BUFFER:
LI X1,5*<YOCBUE-YOCBUF> ;BUFFER LENGTH: 5 SPARE CHARS
LOOP ;UNTIL END OF LINE
XEC @-N(XPDP) ;GET A CHARACTER
IF ;SPACE OR TAB
CAIE XBYTE," "
CAIN XBYTE,QHT
GOTO TRUE
GOTO FALSE
THEN ;SUBSTITUTE JUST ONE SPACE FOR ANY STRING
LOOP ; OF SPACES AND TABS
XEC @-N(XPDP) ;GET NEXT CHAR
AS CAIE XBYTE," "
CAIN XBYTE,QHT
GOTO TRUE
SA
STACK XBYTE
LI XBYTE," "
SOS X1
IDPB XBYTE,X7
UNSTK XBYTE
FI
IF ;COMMENT
CAIE XBYTE,QCOMCHAR
GOTO FALSE
THEN ;FLUSH REST OF LINE
LOOP
XEC @-N(XPDP)
CAIE XBYTE,QLF
CAIN XBYTE,QALTMODE
GOTO L9
AS
GOTO TRUE
SA
GOTO L9
FI
CAIE XBYTE,QLF
CAIN XBYTE,QALTMODE
GOTO L9
JUMPE XBYTE,L9
AS
CAIN XBYTE,QCR
GOTO TRUE
IDPB XBYTE,X7
SOJG X1,TRUE
SA
L9():! LDB XBYTE,X7 ;LAST BYTE COPIED
IF ;SPACE WAS THE LAST CHAR
CAIN XBYTE," "
CAMN X7,YOCPNT(XLOW) ;AND ANYTHING COPIED
GOTO FALSE
THEN ;REPLACE SPACE WITH CR
LI XBYTE,QCR
DPB XBYTE,X7
ELSE ;ADD CR
LI XBYTE,QCR
IDPB XBYTE,X7
FI
LI XBYTE,QLF
IDPB XBYTE,X7
LI XBYTE,0
IDPB XBYTE,X7
AOS -N(XPDP) ;SKIP RETURN
RETURN
EPROC
SUBTTL .OCTI (initialize traps etc)
; Purpose
; -------
; To enable and prepare for handling of traps and UUO's.
; Function
; --------
; Set up location .JBAPR with the address of OCTR, then issue an
; APRENB UUO specifying the following conditions (see MONITOR
; CALLS 3.1.3):
; AP.REN ;Repetitive enable
; AP.ILM ;Illegal memory reference
; AP.NXM ;Non-existent memory (detects NONE)
; AP.FOV ;Floating-point overflow
; AP.AOV ;Arithmetic overflow
; Other traps may be treated in later versions. At present,
; .JBINT will not be initialized to catch interrupts, since the
; monitor messages should be sufficient and REENTER can be used to
; start SIMDDT. Set up .JB41 to contain a "PUSHJ XPDP,OCUU"
; instruction. OCUU will take care of user UUO's used e g for
; error messages.
.OCTI: PROC
LI X1,OCTR
ST X1,.JBAPR
LI X1,AP.ILM!AP.NXM!AP.FOV!AP.AOV!AP.REN
JRSTF @[004000,,.+1] ;Clear user flags (retain user in-out if enabled)
APRENB X1,
;Set up for UUO handling
L [PUSHJ XPDP,OCUU]
ST .JB41
RETURN
EPROC
SUBTTL OUTENTER
COMMENT ;
PURPOSE: THIS SUBROUTINE ENTERS AN OUTFILE OR A PRINTFILE.
IN APPEND MODE LOOKUP IS TRIED FIRST.
SHOULD LOOKUP FAIL, THE FILE IS ENTERED AND CLOSED,
AND LOOKUP IS TRIED AGAIN. WHEN LOOKUP
SUCCEEDS THE FILE IS ENTERED AND USETI -1 IS PERFORMED.
ENTRY: .OCINI
INPUT ARGUMENT:
XCB POINTS TO THE FILE OBJECT.
OUTPUT ARGUMENT: -
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: OUTENTER
USED REGISTER: X0
USED SUBROUTINES:
FILELOOKUP AND FILEENTER
ERROR MESSAGE: -
;
.OCINI: PROC
IF ;APPEND MODE
IFOFF ZFIAPP(XCB)
GOTO FALSE
L1():! THEN IF FILELOOKUP
GOTO FALSE
THEN ;ERROR RETURN!
FILEENTER ;ENTER THE FILE
NOP ;IGNORE ERROR RETURN
edit(67)
JUMPN L7 ;[61] If normal case,
;THE FILE IS ALWAYS CLOSED
;AND LOOKUP TRIED AGAIN
HLLZ X0,OFFSET(ZFICHN)(XCB)
TLO X0,(CLOSE)
XCT X0 ;IMMEDIATE CLOSE
GOTO L1
FI
;HERE WHEN LOOKUP OK!
FILEENTER
SKIPA ;OK RETURN
GOTO L1 ;ERROR RETURN, DON'T GIVE UP, TRY LOOKUP AGAIN
JUMPN L7 ;[61]
HLLO X0,OFFSET(ZFICHN)(XCB)
TLO X0,(USETI)
XCT X0 ;USETI -1
SETZ ;[61] Ok return
ELSE
FILEENTER
FI
L7():! RETURN
EPROC
SUBTTL OUTIMAGE/BREAKOUTIMAGE
COMMENT ;
PURPOSE: TO PRINT A STRING STORED IN FIVEBIT ON TTY
THE FIVE BIT CODE IS ASCII CODE - 100 (OCTAL)
FOR UPPER CASE LETTERS
AND 0 FOR SPACE
33 FOR DOT
34 FOR QUESTION MARK
35 FOR COLON
36 FOR CASE SHIFT [224]
37 DENOTES END OF MESSAGE.
ENTRIES: OCINTS (OUTIMAGE) PRINTS THE STRING AND
APPENDS CR-LF AT THE END
OCINTL (BREAKOUTIMAGE) PRINTS THE STRING
WITHOUT TRAILING CR-LF
INPUT ARGUMENT:
THE WORD AFTER THE CALL CONTAINS:
- A NOP IN BITS 0-9
- THE INDEX REGISTER VALUE IN BITS 11-17
- THE BYTE POINTER TO THE MESSAGE IN YOCMES IN BITS 18-35
OUTPUT ARGUMENT: -
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: OUTIMAGE <ERROR NO>
WHICH EXPANDS TO: EXEC .OCINTS
EXP NOP+<QIND'<ERR NO>>B26+<QM'<ERR NO>>
OR
BREAKOUTIMAGE <ERROR NO>
WHICH EXPANDS TO: EXEC .OCINTL
EXP NOP+<QIND'<ERR NO>>B26+<QM'<ERR NO>>
USED ROUTINES: -
USED REGISTERS: X0, X1, X2, X3, X4 [224]
ERROR MESSAGES: -
;
OCINTL: PROC
SETOFF SWCRLF ;FLAG NO CR-LF
GOTO OCINT1
OCINTS:
SETON SWCRLF ;FLAG CR-LF
OCINT1:
edit(224)
SAVE <X0,X1,X2,X3,X4>;[224]
N==5 ;[224] QUANTITIES ON THE STACK
SETZ X3, ;[224] NO INITIAL CASE SHIFT
LI X0,-N(XPDP)
L X0,@X0
CLEARO ;CLEAR CONTROL-O
HRRZ X4,@X0 ;PICK UP INDEX VALUE
LSH X4,-^D9 ;REMOVE BYTE POINTER
HRRZ X2,@X0 ;CREATE BYTE POINTER
LSH X2,^D30
TLO X2,0500+X4 ;[224] LENGTH AND INDEX
HRRI X2,YOCMES
LOOP ;[224] TO END OF MESSAGE
ILDB X0,X2
IF ;[224] CASE SHIFT
CAIE X0,36
GOTO FALSE
THEN ;CHANGE X3: 40 TO 0 OR VICE VERSA
TRC X3,40
ILDB X0,X2
FI
CAIN X0,37
GOTO FALSE
;CONVERT TO ASCII AND PRINT
IF ;LETTER
CAIL X0,1
CAILE X0,32
GOTO FALSE
THEN ADDI X0,100(X3);[224]
ELSE ;SPECIAL CHARACTER
CAIN X0,0
LI X0," "
CAIN X0,33
LI X0,"."
CAIN X0,34
LI X0,"?"
CAIN X0,35
LI X0,":"
FI
CAIN X0,"?"
OUTSTR [ASCIZ/
/]
OUTCHR X0 ;OUTPUT CONVERTED BYTE
AS
GOTO TRUE
SA
IFON SWCRLF ;PRINT CR-LF IF WANTED
OUTSTR [ASCIZ/
/]
RETURN
EPROC
SUBTTL READSPEC
COMMENT ;
PURPOSE: TO READ THE NEXT BUFFER FROM THE CURRENT SPECIFICATION FILE.
IF END OF FILE OCCURS READSPEC INVESTIGATES WHICH FILE IS
EXHAUSTED AND WHEN.
IF IT IS EXHAUSTED IN THE MIDDLE OF THE CREATION
OF AN IOSPEC ENTRY THEN A WARNING IS WRITTEN ON TTY.
THIS WILL HAPPEN IF THE LAST FILE SPECIFICATION
IS NOT ENDED WITH CARRIAGE RETURN.
IF END OF FILE OCCURS ON AN INDIRECT FILE
A SWITCH IS MADE BACK TO THE OLD SPECIFICATION FILE.
ENTRY: OCINRE
INPUT ARGUMENTS:
SWTTY, SWERR, SWIND AND SWSYSR.
SWGC IS TRUE IF READSPEC WAS CALLED FROM MOVESPEC
OUTPUT ARGUMENTS:
-
NORMAL EXITS: BRANCH TO READTTY IF SPECIFICATION FILE COMES FROM TTY.
RETURN IF NOT END OF FILE.
BRANCH TO OCIN5 IF END OF FILE ON INDIRECT
SPECIFICATION FILE.
BRANCH TO OCINEN IF END OF FILE ON SPECIFICATION FILE.
ERROR EXIT: TO MONITOR WITH EXIT IF TRANSFER FAILURE OCCURS
DURING THE READING OF THE SPECIFICATION FILE FROM DISK.
CALL FORMAT: READSPEC
USED ROUTINES:
PRINTFILE, OUTIMAGE, FREEBUFF, PRINTSPEC
USED REGISTERS: X0, X1, X2
ERROR MESSAGES: ?READ ERROR ON: <...>
?CLOSE ERROR ON: <...>
;
OCINRE:
IFON SWTTY
BRANCH .OCIN4 ;ENTER READTTY IF INPUT FROM TTY
IFON SWERR
BRANCH .OCIN4 ;OR IF CORRECTION IS TO BE READ
IF ;INDIRECT FILE
IFOFF SWIND
GOTO FALSE
THEN OPZ X0,(IN 2,)
OPZ X1,(STATZ 2,)
LI X2,YOCINF(XLOW)
ELSE
OPZ X0,(IN 1,)
OP X1,(STATZ 1,)
LI X2,OFFSET(ZSWFIL)(XSPEC)
FI
HRRI X1,740000
XCT X0 ;READ NEXT BUFFER
RETURN ;IF OK
;NOW INVESTIGATE WHY IN SKIPPED
IF XCT X1
GOTO TRUE
GOTO FALSE ;END OF FILE HERE!!
THEN ;READ ERROR
BREAKOUTIMAGE 32 ;READ ERROR ON:
LI X2,OFFSET(ZSWFIL)(XSPEC)
PRINTFILE
EXIT
FI
edit(261) ;[261] Restore stack for return to program
HRRZ XPDP
SUBI YOBJRT(XLOW)
HRL
SUB XPDP,
IF ;INDIRECT FILE
IFOFF SWIND
GOTO FALSE
THEN ;CLOSE INDIRECT FILE
IFON SWSYSI
SETON SWSYSE
GOTO OCIN5
FI
IF ;END OF FILE ON SYSIN
IFOFF SWSYSR
GOTO FALSE
THEN SETON SWSYSE
BRANCH OCINEN
FI
IFON SWTTY
BRANCH OCINEN
CLOSE 1,
IF STATZ 1,740000
GOTO TRUE
GOTO FALSE
THEN ;ERROR
BREAKOUTIMAGE 33 ;CLOSE ERROR ON:
PRINTSPEC
EXIT
FI
RELEAS 1,0
LI X1,-2(XBUF) ;ADDRESS TO BUFFER AREA
FREEBUFF ;RELEASE BUFFER
BRANCH OCINEN
SUBTTL READTTY
COMMENT ;
PURPOSE: TO READ AN INPUT BUFFER FROM TTY
ENTRY: .OCIN4
INPUT ARGUMENTS: -
OUTPUT ARGUMENTS: -
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: READTTY
THIS ROUTINE IS CALLED WITH GOTO .OCIN4
FROM READSPEC, WHICH MEANS THAT READTTY
WILL RETURN TO THE INSTRUCTION FOLLOWING
THE READSPEC CALL.
USED REGISTERS: -
USED ROUTINE: OUTIMAGE
ERROR MESSAGE: ?INPUT ERROR. TRY AGAIN
;
.OCIN4:
edit(225)
OUTSTR [ASCIZ/*/] ;[225]
IN 0, ;READ A LINE
RET
OUTIMAGE 34 ;TTY END OF FILE OR TTY INPUT ERROR [1C]
edit(61)
EXIT 1, ;[1C],[61] Temporary exit
EXIT ;[61] Exit finally if continued
SUBTTL SETWIDTH
COMMENT ;
PURPOSE: TO DETERMINE THE LINE WIDTH FOR A TERMINAL
USED FOR SYSIN OR SYSOUT AND GET THE IMAGE.
INPUT ARGUMENT: XCB POINTS TO FILE OBJECT
OUTPUT ARGUMENT:
XWAC1-XWAC2 CONTAINS TEXT REF TO IMAGE
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: SETWIDTH
USED ROUTINE: .TXBL
USED REGISTERS: X0,X1,X2,XWAC1
ERROR MESSAGE: -
;
OCINWI:
IF ;DEVICE IS A TTY
IFOFF ZFITTY(XCB)
GOTO FALSE
THEN ;GET CARRIAGE WIDTH WITH TRMOP
L X2,YJOBNO(XLOW) ;LOAD JOB NUMBER
TRMNO. X2, ;GET UNIVERSAL I/O INDEX
GOTO FALSE ;USE DEFAULT ON FAILURE!
L X0,[XWD 2,1] ;ARGUMENTS IN X1-X2
LI X1,1012 ;READ CODE FOR CARRIAGE WIDTH
TRMOP. X0,
SETZ X0, ;Failed
edit(305)
JUMPE X0,FALSE ;[305] Default value on failure
L XWAC1,X0
FI
EXEC .TXBL
Z
RETURN
SUBTTL TTYSPEC [225]
edit(225)
COMMENT; THIS CAN BE STREAMLINED
;
.OCINY: PROC
READTTY
LI XBUF,YLOW+2(XLOW) ;BUFFER BYTE PTR ADDR
L XBYTE,(XBUF) ;CHECK FIRST BYTE
ILDB XBYTE,XBYTE
IF ;FIRST CHARACTER WAS ALTMODE
CAIE XBYTE,QALTMODE
GOTO FALSE
THEN ;ENTER SIMDDT, ALLOW CONTINUATION
edit(261)
SKIPE YDSLOAD(XLOW) ;[261] Must not call SIMDDT too early
OCERC QDSCON,2,SIMDDT entered after file specification error
RET ;IF CONTINUED, NON-SKIP RETURN
FI
SPECCOPY
GOTO [SOSGE YLOW+3(XLOW)
READTTY
ILDB XBYTE,YLOW+2(XLOW)
RET ] ;GETS NEXT BYTE
AOS (XPDP)
RETURN
EPROC
SUBTTL TYPESWITCH
edit(225)
TOPS10,<;[225]
COMMENT ;
PURPOSE: TO TYPE THE CHARACTERS IN X0
FOLLOWED BY A SPACE.
ENTRY: OCINTW
INPUT ARGUMENT: NAME IN X0
OUTPUT ARGUMENT: -
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: TYPESWITCH
USED ROUTINES: -
USED REGISTERS: X0-X1
ERROR MESSAGES: -
;
OCINTW: PROC
SAVE <X0,X1>
LOOP
SETZ X1,
ROTC X0,7
OUTCHR X1
AS
JUMPN X0,TRUE
SA
OUTCHR [" "]
RETURN
EPROC
>
TOPS20,<;[225]
OCINTW: PROC ;Types the string pointed to
; by X2 (TBLUK format), followed by space
HLRO X1,X2
PSOUT
LI X1," "
PBOUT
RETURN
EPROC
>
SUBTTL OCIN MAIN PROGRAM
SETLOW ;LOW SEGMENT POINTER IN STANDARD XLOW REGISTER (XIAC) ON ENTRY
.OCIN: BEGIN
ST X2,YXACAD(XLOW)
ST X3,YDSZLA(XLOW) ;LINE NO TABLE ADDRESS
ST X4,YOCGS(XLOW) ;Address of GETSEG routine ;[1C]
HRRZ X1,.JBHRL ;FIND OUT HIGH SEGM SIZE
SUBI X1,377776
ST X1,YSAHSZ(XLOW)
LI X1,YLOW(XLOW) ;ADDRESS OF DYNAMIC AREA
AOS X3,.JBREL
HRRM X3,.JBFF
ST X1,YSABOT(XLOW)
ST X1,YSATOP(XLOW)
SUBI X3,QSALIM
ST X3,YSALIM(XLOW)
LI QIOLP
ST YIOLP(XLOW)
LI "E"
ST YTXLT(XLOW)
;;; ALSO GET JOB NUMBER, TIME, ETC ;;;
edit(225)
TOPS20,<GJINF> ;[225]
TOPS10,<PJOB X3,> ;[225] JOB NUMBER
ST X3,YJOBNO(XLOW)
MSTIME X1, ;GET CURRENT TIME OF DAY
ST X1,YDAYTM(XLOW) ;SAVE IT
SETZ X1, ;GET RUNTIME SINCE LOGIN
RUNTIM X1,
ST X1,YRUNTM(XLOW) ;SAVE IT
; SET UP RUN TIME STACK ;
HRRI XPDP,YOBJRT-1(XLOW)
HRLI XPDP,-QPDLEN
Q==YOBJRT-YPDL
IFG Q,<
LI X3,(XLOW)
HRLI X3,-Q
LI .PDERR
LOOP
ST YPDL(X3)
AS
INCR X3,TRUE
SA >
;Fake PUSHJ from main program to .OCIN
edit(242)
LI 1(XSPEC) ;[242] ;Account for inline parameter
HRRZ XSPEC,(XSPEC) ;Retrieve inline parameter (runswitches address)
STACK
edit(225)
TOPS20,<XEC V1BINI##> ;[225] Make STPPN% etc work
EXEC .OCTI ;SET UP TRAP AND UUO HANDLER
;NOW ALLOCATE BUFFERS FOR TTY AND OPEN TTY
;XBASE NOW POINTS TO AVAILABLE BUFFER SPACE
ZEROSW ;RESET ALL SWITCHES
LI XBASE,YLOW(XLOW);ADDRESS TO FIRST FREE LOCATION
ST XBASE,YOCBST(XLOW)
SETOM YIOSPC(XLOW) ;IOSPEC IS EMPTY INITIALLY
HRROI X0,-124
MOVSM X0,(XBASE) ;INITIAL LINK AND NEG LENGTH
HRRI X3,1(XBASE) ;SAVE ADDRESS TO INPUT BUFFER HEADER
;FOR LATER USE BY OPEN
LI X7,2 ;NUMBER OF BUFFERS
LI X6,23 ;STANDARD BUFFER SIZE FOR TTY
GETBUFF ;THE INPUT BUFFER
LFE X0,ZBHLEN(X1) ;FLAG OCCUPIED
MOVN X0,X0
SF X0,ZBHLEN(X1)
LI X2,(X1) ;SAVE BUFFER AREA ADDRESS
ADDI XBASE,52
HRLI X3,1(XBASE) ;SAVE ADDRESS TO OUTPUT BUFFER HEADER
;FOR LATER USE BY OPEN
GETBUFF ;THE OUTPUT BUFFER
LFE X0,ZBHLEN(X1)
MOVN X0,X0
SF X0,ZBHLEN(X1) ;FLAG BUFFER OCCUPIED
ADDI XBASE,52
LI X5,1 ;SET UP OPEN ARGUMENTS
MOVSI X6,'TTY' ;NOTE THAT X7 NOW CONTAINS XWD OBUF,IBUF
L X7,X3
OPEN 0,X5
HALT ;DEAD END ON OPEN FAILURE
LI X7,2
LI X6,23
LINKBUFF
LI X1,(X2)
LINKBUFF
ST XBASE,YIOBUF(XLOW)
JUMPE XSPEC,OCINNS
SUBTTL OCIN MAIN PROGRAM: SPECIFICATION FILE PROCESSING
COMMENT /
The following algorithm is used to process specification files:
BEGIN
expand buffer area;
IF device is TTY THEN
BEGIN flag TTY; print text on TTY END
ELSE
BEGIN open channel 1 for specification file;
set up buffers for specification file;
lookup specification file
END;
loop: read next line from spec file;
IF first char = carriage return THEN
BEGIN IF indirect spec file THEN
BEGIN IF not SYSIN THEN
BEGIN close spec file on channel 2;
release buffers
END;
switch to direct spec file; GOTO loop
END;
IF TTY or SYSIN THEN GOTO over;
close spec file on channel 1;
release buffers; GOTO over
END carriage return case;
IF first char = slash THEN
BEGIN FIXSWITCH;
IF error or delimiter is not space THEN GOTO loop
END;
IF next char is "@" THEN
BEGIN COMMENT indirect file spec;
IF current is indirect THEN BEGIN error; GOTO loop END;
IF previous ind spec file from SYSIN THEN BEGIN error; GOTO loop END;
get buffers for indirect spec file;
open channel 2 for indirect spec file;
lookup indirect spec file;
flag indirect spec file being read; GOTO loop
END of indirect case;
COMMENT file definition found;
get logical name;
FINDLOGICAL; FINDFILE;
IF already defined logical name THEN BEGIN error; GOTO loop END;
process file definition;
set up IOSPEC entry; GOTO loop;
over: scan IOSPEC and save references to SYSIN and SYSOUT
END of spec file processing;
/
;EXPAND BUFFER AREA FOR SPECIFICATION FILES
QBFLEN==2*<2*<QBUFS>+4>
HRROI X0,-QBFLEN
MOVSM X0,(XBASE) ;NEW LENGTH AND LINK -1
LI X1,-52(XBASE) ;ADDRESS TO LAST BUFFER
SF XBASE,ZBHLNK(X1);UPDATE OLD LINK
ADDI XBASE,QBFLEN
;INVESTIGATE THE RUNSWITCH BLOCK ZSW:
LF X0,ZSWDEV(XSPEC)
IF ;DEVICE IS TTY
CAME X0,[SIXBIT/TTY/]
GOTO FALSE
THEN
L1():! SETON SWTTY ;FLAG INPUT FROM TTY
OUTIMAGE 36 ;ENTER FILE DEFINITIONS
LI XBUF,YLOW+2(XLOW);SET UP ADDRESS TO BUFFER POINTER
NEXTBUFF
FI
;MUST BE DEVICE DSK
LF X0,ZSWFIL(XSPEC)
IF ;IT IS SYSIN
CAME X0,[SIXBIT/SYSIN/]
GOTO FALSE
THEN ;CHECK IF SYSIN WAS ASSIGNED TO TTY
SETON SWSYSR ;FLAG SYSIN READ
DEVCHR X0,
IF ;TTY
TLNN X0,DV.TTY
GOTO FALSE
THEN SETON SWSYST ;FLAG SYSIN READ FROM TTY
GOTO L1
FI
FI
;MUST OPEN CHANNEL 1
LI X7,2
LI X6,QBUFS
GETBUFF ;GET A BUFFER AREA FOR THE SPECIFICATION FILE
LI X2,1 ;SET UP OPEN ARGUMENTS
LF X3,ZSWDEV(XSPEC)
HLRZ X0,X3
IF ;NOT DSK
CAIN X0,'DSK'
GOTO FALSE
THEN DEVCHR X3,
IF ;Not disk device
TLNE X3,DV.DSK
GOTO FALSE
THEN ;Make it
OUTIMAGE 47 ;ONLY DSK ALLOWED FOR SPEC FILE
MOVSI X3,'DSK'
ELSE
LF X3,ZSWDEV(XSPEC)
FI
FI
LI X4,1(X1) ;ADDRESS TO BUFFER HEADER
OPEN 1,X2
GOTO [OUTIMAGE 11 ;CANNOT OPEN DISK
EXIT]
LINKBUFF
;NOW LOOKUP THE SPECIFICATION FILE
L2():!
edit(177)
HRLI OFFSET(ZSWFIL)(XSPEC) ;[177] Copy lookup block by BLT
q==OFFSET(ZBUDAT)+1
HRRI q(X1) ;[177] Use buffer for lookup block
BLT q+3(X1) ;[177] Four words copied
edit(225)
IFN QDEC20,<;[225] MAY HAVE DIRECTORY STRING PTR
L X2,Q+3(X1) ;PPN OR STRING PTR
IF ;String ptr
JUMPE X2,FALSE
HLRZ X2
GOTO FALSE
THEN ;Translate str:<directory> to PPN
EXCH X1
MOVSI X1,(RC%EMO) ;Exact match only
RCDIR
TLNE X1,(RC%NOM)
GOTO [EXCH X1
GOTO L4()] ;[261] Error
L X1,X3 ;Directory
STPPN%
ERJMP [EXCH X1
GOTO L4()] ;[261]
EXCH X1
ST X2,Q+3(X1)
FI
>
IF LOOKUP 1,Q(X1) ;[177] Succeeds
GOTO FALSE
THEN LFE X0,ZBHLEN(X1) ;FLAG THIS BUFFER OCCUPIED
MOVN X0,X0
SF X0,ZBHLEN(X1)
LI XBUF,2(X1) ;COMPUTE ADDRESS TO BUFFER POINTER
IFOFF SWSYSR
NEXTBUFF
HRLZM XBUF,YSYSIN(XLOW);SAVE ADDRESS TO SYSIN BUFFER
AOS YSYSIN(XLOW) ;AND THE CHANNEL
NEXTBUFF
FI
;LOOKUP FAILED!
L4():! BREAKOUTIMAGE 37 ;FILE:
LI X2,OFFSET(ZSWFIL)(XSPEC)
PRINTFILE
OUTIMAGE 40 ;NOT FOUND
L3():!
OUTIMAGE 41 ;ENTER NEW FILE SPEC
TTYSPEC ;[225]
GOTO L3 ;[225]
L X0,YOCPNT(XLOW)
GETBYTE
CAIE XBYTE,"/" ;IGNORE LEADING SLASH IF ANY
ST X0,YOCPNT(XLOW)
GETSPEC ;DECODE NEW FILE SPEC
GOTO L3 ;IF ERROR!
SKIPE OFFSET(ZFDSFD)(XLOW)
OUTIMAGE 42 ;WARNING: SFD IGNORED
CAIN XBYTE,"/"
OUTIMAGE 43 ;WARNING: SWITCHES IGNORED
IF ;NOT DSK
SKIPE X2,OFFSET(ZFDDEV)(XLOW)
CAMN X2,[SIXBIT/DSK/]
GOTO FALSE
L X2 ;[177]
DEVCHR
edit(302) ;[302] There is no error ret from DEVCHR
TLNE DV.DSK
GOTO FALSE
THEN ;ERROR
OUTIMAGE 44 ;ONLY DSK ALLOWED
GOTO L3
FI
HRLI X0,OFFSET(ZFDFIL)(XLOW)
edit(261)
GOTO 1+L2 ;[261] Try again
OCIN2: ;ENTRY NEXTSPEC
IFON SWTTY
NEXTBUFF
IF ;CORRECTION WAS READ BEFORE
IFOFF SWERR
GOTO FALSE
THEN IF ;HELP BEFORE
IFOFF SWHLP
GOTO FALSE
THEN SETOFF SWHLP
NEXTLINE
FI
SETOFF SWERR
L XBUF,YOCBF2(XLOW) ;LOAD OLD BUFFER POINTER
FI
NEXTLINE
OCIN3: ;ENTRY NEXTBUFF
SETOFF SWGC ;FLAG CALL FROM NEXTBUFF TO READSPEC
edit(41) ;[41]:
IF ;TTY input or error recovery
IFON SWTTY
GOTO TRUE
IFOFF SWERR
GOTO FALSE
edit(225)
THEN ;[225] USE TTYSPEC
TTYSPEC
ERROR ;repeat error procedure
;if return from SIMDDT after escape
GOTO OCIN4A ;MOVESPEC DONE BY TTYSPEC
ELSE
READSPEC
FI
;End of [41]
OCIN4: ;ENTRY NEXTLINE
MOVESPEC
OCIN4A: L X6,YOCPNT(XLOW)
GETBYTE ;GET FIRST BYTE OF THE LINE
IF ;CR IN FIRST POSITION
CAIE XBYTE,QCR
GOTO FALSE
THEN ;END OF SPECIFICATION FILE
IF ;INDIRECT FILE
IFOFF SWIND
GOTO FALSE
OCIN5: THEN IF ;NOT SYSIN
IFON SWSYSI
GOTO FALSE
THEN ;CLOSE INDIRECT FILE
CLOSE 2,
IF STATZ 2,740000
GOTO TRUE
GOTO FALSE
THEN BREAKOUTIMAGE 33 ;CLOSE ERROR ON
LI X2,YOCINF(XLOW)
PRINTFILE
EXIT
FI
RELEAS 2,0
LI X1,-2(XBUF)
FREEBUFF
FI
L XBUF,YOCBF1(XLOW)
SETOFF SWIND
UNSTK YOCSW+1(XLOW)
NEXTSPEC
FI
;HERE IF NOT INDIRECT FILE
IFON SWTTY
BRANCH OCINEN
IFON SWSYSR
BRANCH OCINEN
;Close and release buffer and channel
;if dsk file is not Sysin
CLOSE 1,
IF STATZ 1,740000
GOTO TRUE
GOTO FALSE
THEN BREAKOUTIMAGE 33 ;CLOSE ERROR ON
LI X2,OFFSET(ZSWFIL)(XSPEC)
PRINTFILE
EXIT
FI
RELEASE 1,
IFON SWERR
L XBUF,YOCBF2(XLOW)
LI X1,-2(XBUF)
FREEBUFF ;RELEASE BUFFER
BRANCH OCINEN
FI
IF ;SLASH
CAIE XBYTE,"/"
GOTO FALSE
THEN ;GLOBAL SWITCH
SETON SWGSW
FIXSWITCH
IF ;ERROR IN SWITCH HANDLING
IFOFF SWSWERR
GOTO FALSE
THEN SETOFF SWSWERR
ERROR
FI
CAIE XBYTE," "
NEXTSPEC ;IF CR
L X6,YOCPNT(XLOW)
FI
SETOFF SWGSW
IF ;INDIRECT FILE SPECIFICATION
CAIE XBYTE,"@"
GOTO FALSE
THEN ;SEE IF IT IS ALLOWED
IF ;CURRENT FILE IS INDIRECT
IFOFF SWIND
GOTO FALSE
THEN OUTIMAGE 45 ;NESTED IND FILES NOT ALLOWED
PRINTSPEC
NEXTSPEC
FI
IF ;EARLIER INDIRECT FILE STILL OPEN AS SYSIN
IFON SWSYSR
GOTO TRUE
IFOFF SWSYSI
GOTO FALSE
THEN OUTIMAGE 46 ;IND SPEC FILE STILL OPEN AS SYSIN. SPEC IGNORED
PRINTSPEC
NEXTSPEC
FI
GETSPEC
ERROR
SKIPE X0,OFFSET(ZFDSFD)(XLOW)
OUTIMAGE 42 ;WARNING: SFD IGNORED
CAIN XBYTE,"/"
OUTIMAGE 43 ;WARNING: SWITCHES IGNORED
LI X7,2
LI X6,QBUFS
GETBUFF ;GET BUFFER AREA FOR INDIRECT SPECIFICATION FILE
LI X2,YOCINF(XLOW)
HRLI X2,OFFSET(ZFDFIL)(XLOW)
BLT X2,YOCINF+3(XLOW);MOVE FILE SPEC
LI X2,1 ;SET UP OPEN ARGUMENTS
IF ;DEVICE NOT DSK
LF X3,ZFDDEV(XLOW)
SKIPN X0,X3
MOVSI X3,'DSK'
HLRZ X0,X3
CAIN X0,'DSK'
GOTO FALSE
THEN ;CHECK IF ASSIGN IS DONE
DEVCHR X3,
IF ;Not DSK device
TLNE X3,DV.DSK
GOTO FALSE
THEN ;Make it
OUTIMAGE 47 ;WARNING ONLY DSK ALLOWED
MOVSI X3,'DSK'
ELSE
LF X3,ZFDDEV(XLOW)
FI
FI
LI X4,1(X1)
OPEN 2,X2
GOTO [OUTIMAGE 11 ;CANNOT OPEN DSK
EXIT]
LINKBUFF
IF LOOKUP 2,YOCINF(XLOW)
GOTO TRUE
GOTO FALSE
THEN ;ERROR
BREAKOUTIMAGE 67 ;IND SPEC FILE NOT FOUND
ERROR
FI
L X0,[SIXBIT/SYSIN/]
IF ;SYSIN
CAME X0,YOCINF(XLOW)
GOTO FALSE
THEN IF ;DIRECT FILE IS SYSIN
IFOFF SWSYSR
GOTO FALSE
THEN ;ERROR
OUTIMAGE 51 ;SYSIN ALREADY READ. SPEC IGNORED
PRINTSPEC
NEXTSPEC
FI
SETON SWSYSI
FI
ST XBUF,YOCBF1(XLOW)
LI XBUF,2(X1) ;NEW BUFFER POINTER ADDRESS
LF X0,ZBHLEN(X1)
MOVN X0,X0
SF X0,ZBHLEN(X1) ;FLAG FOUND BUFFER AS OCCUPIED
SETON SWIND
SETOFF SWERR
STACK YOCSW+1(XLOW)
SETOFF SWTTY
IF IFON SWSYSR
GOTO FALSE
IFOFF SWSYSI
NEXTSPEC
THEN HRLZM XBUF,YSYSIN(XLOW);SAVE BUFFER ADDRESS
LI X0,2
HRRM X0,YSYSIN(XLOW)
NEXTSPEC
FI
FI
;HERE IF THE LINE DID NOT START WITH / OR @
;NOW INITIALIZE THE NEW IOSPEC ENTRY
;XBASE POINTS TO THE START OF THE NEW ENTRY
SKIPG YIOSPC(XLOW)
ADDI XBASE,1 ;Allow for ZFSLNK word 741120 /LE/
MOVSI X0,'DSK'
SF X0,ZFSDEV(XBASE)
SETZM OFFSET(ZFSSIZ)(XBASE)
HRLI OFFSET(ZFSSIZ)(XBASE)
HRRI OFFSET(ZFSIML)(XBASE)
BLT OFFSET(ZFSPRJ)(XBASE)
IF FINDLOGICAL
JUMPGE X0,FALSE
THEN ;ERROR IF X0 < 0
OUTIMAGE 52 ;ILL DEL AFTER LOGICAL NAME
ERROR
FI
FINDFILE
edit(225)
REPEAT 0,<;[225] NOT NECESSARY?
IF ;DELIMITER WAS CR
CAIE XBYTE,QCR
GOTO FALSE
THEN SF XNAME,ZFSNAM(XBASE);SET FILE = LOGICAL NAME
SF XNAME,ZFSFIL(XBASE)
;LINK THIS ELEMENT
LI X0,QFSLNG(XBASE)
SF X0,ZFSLNK(XBASE)
SKIPG X0,YIOSPC(XLOW) ;IF FIRST ELEMENT
ST XBASE,YIOSPC(XLOW)
ADDI XBASE,QFSLNG
LI X0,-1
SF X0,ZFSLNK(XBASE);FLAG THIS ELEMENT AS LAST
NEXTSPEC
FI
>;[225]
STACK XNAME
;NOW GET REST OF FILE SPECIFICATION
GETSPEC
GOTO [UNSTK
ERROR]
IF ;SWITCHES
CAIE XBYTE,"/"
GOTO FALSE
THEN FIXSWITCH
IF ;SWITCH ERROR
IFOFF SWSWERR
GOTO FALSE
THEN UNSTK
SETOFF SWSWERR
ERROR
FI
FI
;NOW MOVE THE FILE SPEC AND COMPLETE THIS IOSPEC ENTRY
UNSTK OFFSET(ZFSNAM)(XBASE)
LF X0,ZFDFIL(XLOW)
SF X0,ZFSFIL(XBASE)
LF X0,ZFDEXT(XLOW)
SF X0,ZFSEXT(XBASE)
SKIPE X1,OFFSET(ZFDDEV)(XLOW)
ST X1,OFFSET(ZFSDEV)(XBASE)
L X0,OFFSET(ZFDPRG)(XLOW)
ST X0,OFFSET(ZFSPRG)(XBASE)
LF X0,ZFDPT(XLOW)
SF X0,ZFSPT(XBASE)
edit(225)
IFE QDEC20,<;[225]
IF ;SUB FILE DIRECTORIES
SKIPN X6,OFFSET(ZFDSFD)(XLOW)
GOTO FALSE
THEN ;READ THESE AND EXTEND IOSPEC ENTRY
SETON ZFSSUB(XBASE)
LF X0,ZFDPNT(XLOW)
ST X0,YOCPNT(XLOW) ;POINTER TO FIRST SFD
LF X0,ZFSADR(XBASE);MOVE PPN
SF X0,ZFSPPN(XBASE)
LI X0,OFFSET(ZFSARG)(XBASE)
SF X0,ZFSADR(XBASE);ADDRESS TO EXT ARG
LOOP ;UNTIL NO MORE SFD:S
GETNAME
NOP -1 ;[263] No funny name here
edit(263)
SF XNAME,ZFSSFD(XBASE)
ADDI XBASE,1
AS SOJG X6,TRUE
SA
ZF ZFSSFD(XBASE) ;RESET LAST SFD
SUB XBASE,OFFSET(ZFDSFD)(XLOW)
LI X0,4
ADDM X0,OFFSET(ZFDSFD)(XLOW)
FI
>;[225]
SKIPGE X0,YIOSPC(XLOW) ;IF FIRST ELEMENT
ST XBASE,YIOSPC(XLOW) ;THEN UPDATE YIOSPC POINTER
LI X0,QFSLNG(XBASE) ;ADDRESS TO NEXT ENTRY
ADD X0,OFFSET(ZFDSFD)(XLOW) ;COMPENSATE FOR SFD:S
SF X0,ZFSLNK(XBASE) ;UPDATE XBASE
L XBASE,X0
HRROI X0,-1
SF X0,ZFSLNK(XBASE) ;FLAG THIS ELEMENT AS LAST
NEXTSPEC
SUBTTL OCIN: SEARCH IOSPEC FOR SYSIN AND SYSOUT
;HERE WHEN END OF SPECIFICATION FILE OCCURRED
OCINEN:
;NOW SEARCH IOSPEC TABLE TO SEE IF THERE
;IS ANY FILE CALLED SYSIN OR SYSOUT ON DSK
L X6,YIOSPC(XLOW)
IF ;MORE ENTRIES IN IOSPC
JUMPL X6,FALSE
THEN ;CHECK IF SYSIN OR SYSOUT
LOOP LF X2,ZFSNAM(X6)
LF X0,ZFSFIL(X6)
CAME X2,[SIXBIT/SYSIN/]
CAMN X0,[SIXBIT/SYSIN/]
ST X6,YOCSIN(XLOW)
CAME X2,[SIXBIT/SYSOUT/]
CAMN X0,[SIXBIT/SYSOUT/]
ST X6,YOCSOU(XLOW)
AS LF X6,ZFSLNK(X6)
SKIPL X0,OFFSET(ZFSLNK)(X6)
GOTO TRUE
SA
FI
IFON SWTTY
OUTIMAGE 66 ;EXECUTION STARTED
ENDD
SUBTTL OCIN: ALLOCATE IOBUFS
BEGIN
ST XBASE,YIOBUF(XLOW)
SKIPGE X1,YIOSPC(XLOW)
BRANCH OCINNS ;IF IOSPEC EMPTY!
LI X7,0
;NOW SCAN IOSPEC AND COMPUTED REQUESTED SIZE
L1():!
IF ;LOCAL SIZE IS GIVEN
LF X2,ZFSBUF(X1)
CAIN X2,0
GOTO FALSE
THEN ;SEE IF IT IS BUFFERS OR TOTAL SIZE
CAILE X2,^D32
GOTO L3 ;IT WAS TOTAL SIZE
ELSE
L X2,YOCBFN(XLOW) ;LOAD GLOBAL NO OF BUFFERS
FI
COMPSIZE
CAIN X2,0
HLR X2,X3 ;USE DEFAULT OBTAINED BY DEVSIZ
TLZ X3,-1 ;RESET LEFT PART
IMULI X3,(X2)
ADDI X7,4(X3) ;UPDATE TOTAL SIZE, 4 IS TO
;COMPENSATE FOR THE BUFFER HEADER AND LINK
GOTO L8
L3():! ;ENTRY WHEN WE HAVE TOTAL SIZE
COMPSIZE
HRRZ X4,X3
IF ;REQUESTED SIZE IS LESS THAN STANDARD BUFFER SIZE
CAML X2,X4
GOTO FALSE
THEN ;TAKE STANDARD SIZE INSTEAD
HLRZ X2,X3
TLZ X3,-1
IMUL X2,X3
ADDI X3,4 ;COMPENSATE AS BEFORE
FI
ADD X7,X2
L8():! SOS YOCFIL(XLOW)
LF X1,ZFSLNK(X1) ;LINK TO NEXT BUFFER
SKIPL X0,OFFSET(ZFSLNK)(X1)
GOTO L1 ;IF NOT LAST IOSPEC ENTRY
;NOW SEE IF YOCFIL STILL IS POSITIVE
IF SKIPG X1,YOCFIL(XLOW)
GOTO FALSE
THEN ;COMPUTE REQUESTED ADDITIONAL SIZE
SKIPN X2,YOCBFN(XLOW)
LI X2,2 ;DEFAULT NO OF BUFFERS
LI X3,QBUFS ;DEFAULT BUFFER SIZE
IMUL X2,X3
ADDI X2,4 ;BUFFER AREA HEADER
IMUL X2,X1 ;NUMBER OF FILES
ADD X7,X2
FI
;FINALLY CHECK IF GLOBAL BUFFER SIZE IS
;DEFINED AS LARGER THAN THE COMPUTED SIZE
L X0,YOCBFS(XLOW)
CAMLE X0,X7
L X7,X0 ;YES, TAKE GLOBAL BUFFER SIZE
;SIZE OF IOBUFS IS NOW COMPUTED IN X7
MOVN X0,X7
SF X0,ZBHLEN(XBASE) ;LENGTH OF THIS IOBUFS ELEMENT
;NOW LOOK UP LAST LINK
L X1,YOCBST(XLOW)
WHILE ;NOT LAST LINK
LF X2,ZBHLNK(X1)
CAIN X2,377777
GOTO FALSE
DO L X1,X2
OD
;X1 NOW POINTS TO LAST BUFFER BEFORE IOSPEC
SF XBASE,ZBHLNK(X1)
SETOFF ZBHCON(X1) ;FLAG THIS BUFFER AS N O T CONSECUTIVE
HRROI X0,-1
SF X0,ZBHLNK(XBASE)
ADD XBASE,X7 ;ADDRESS TO LAST LOCATION IN IOBUFS
IF ;NOT WITHIN CURRENT LOW SEGMENT
L X3,.JBREL
SUBI X3,QPOLMI(XBASE)
JUMPGE X3,FALSE
THEN ;GRAB CORE
LI X1,QPOLMI(XBASE)
CORE X1,
GOTO [OUTIMAGE 55 ;CORE NOT AVAILABLE
EXIT]
L X0,.JBREL
HRRM X0,.JBFF
SUBI X0,QSALIM
ST X0,YSALIM(XLOW)
FI
OCINNS: ;ENTRY HERE WHEN NO SPEC FILE
ST XBASE,YSABOT(XLOW)
ST XBASE,YSATOP(XLOW)
EXEC .SAGI
;NOW SAVE BUFFER ADDRESS TO TTY BUFFERS
L X0,YOCBST(XLOW)
ADDI X0,1
ST X0,YTTIB(XLOW)
ADDI X0,52
ST X0,YTTOB(XLOW)
ENDD
SUBTTL SET UP FILE OBJECT FOR SYSIN
COMMENT ;
FIVE CASES CAN BE DISTINGUISHED HERE:
1. SYSIN HAS BEEN READ AS A SPECIFICATION FILE FROM TTY.
(SWITCH /R:"SYSIN" AND SYSIN ASSIGNED TO TTY)
- SET DEVICE TTY
- SET LOGICAL FILE NAME SYSIN
- UPDATE BUFFER ADDRESS
- SET CHANNEL 0
2. SYSIN IS DECLARED IN IOSPEC, I.E. THE SPECIFICATION FILE
CONTAINED SYSIN AS A LOGICAL NAME.
THE FOLLOWING SEQUENCE IS NEEDED:
- DUMMY OPEN
- GET A BUFFER
- OPEN
- LINK THE BUFFERS
- COPY INFORMATION FROM IOSPEC TO FILE OBJECT
- LOOKUP
- CLAIM THE BUFFERS
3. SYSIN HAS BEEN READ AS A SPECIFICATION FILE FROM DSK.
(SWITCH /R:"SYSIN" AND SYSIN ASSIGNED TO DSK)
COPY IOSPEC ENTRY TO FILE OBJECT
4. SYSIN HAS BEEN READ AS AN INDIRECT SPECIFICATION FILE.
COPY INFORMATION FROM YOCINF-RECORD TO FILE OBJECT
5. SYSIN NOT DECLARED
(SWITCH /-R)
THE FOLLOWING SEQUENCE IS NEEDED:
- DUMMY OPEN
- CHECK ASSIGN, IF TTY OR UNASSIGNED PERFORM CASE 1
- DEVSIZ
- GET A BUFFER
- DEVNAM
- OPEN
- LINK THE BUFFERS
- LOOKUP
- CLAIM THE BUFFERS
;
;CREATE FILE OBJECT FOR SYSIN
BEGIN
LI XSAC,IOIN
EXEC .SAAB ;GET FILE OBJECT FOR SYSIN
MOVSI X0,(<QZCL>B<%ZDNTYP>+1B<%ZDNTER>)
WSF X0,ZDNTYP(XRAC)
L X0,[SIXBIT/SYSIN/]
SF X0,ZFINAM(XRAC) ;LOGICAL NAME IS SYSIN
IF ;CASE 1
IFOFF SWSYST
GOTO FALSE
L4():! THEN HRRM XRAC,YIOCHTB(XLOW);CHANNEL 0
SETZM YIOCHTB+1(XLOW) ;RELEASE CHANNEL 1 IN CHANNEL TABLE
MOVSI X0,'TTY'
SF X0,ZFIDVN(XRAC) ;DEVICE IS TTY
LI X0,2
WSF X0,ZFIBUF(XRAC) ;2 BUFFERS
HRL X0,YTTOB(XLOW)
HRR X0,YTTIB(XLOW)
WSF X0,ZFIIBH(XRAC) ;SET UP BUFFER POINTER
L X0,[SIXBIT/SYSIN/]
SF X0,ZFIFIL(XRAC) ;FILE NAME IS ALSO SYSIN
ELSE
IF ;SYSIN IN IOSPEC, CASE 2
SKIPN X1,YOCSIN(XLOW)
GOTO FALSE
THEN COPYSPEC
LF X5,ZFIDVN(XRAC)
CAMN X5,[SIXBIT/TTY/]
GOTO L4 ;IF TTY
GOTO L5
FI
IF ;CASE 3
;SYSIN HAS BEEN READ AS A SPEC FILE
IFOFF SWSYSI
IFOFF SWSYSR
GOTO FALSE
THEN ;COPY INFORMATION FROM ZSW TO ZFI
HRRM XRAC,YIOCHTB+1(XLOW);CHANNEL 1
HLRZ X0,YSYSIN(XLOW)
SUBI X0,1
SF X0,ZFIIBH(XRAC) ;SET INPUT BUFFER POINTER
LI X0,1
SF X0,ZFICHN(XRAC) ;SET CHANNEL NO
LI X0,2
SF X0,ZFIBUF(XRAC) ;AND TWO BUFFERS
LF X0,ZSWDEV(XSPEC);MOVE DEVICE
SF X0,ZFIDVN(XRAC)
LI X0,OFFSET(ZFIFIL)(XRAC) ;MOVE LOOKUP INFORMATION
HRLI X0,OFFSET(ZSWFIL)(XSPEC)
BLT X0,OFFSET(ZFIARG)(XRAC)
ELSE
IF ;CASE 4
;SYSIN HAS BEEN READ AS AN INDIRECT SPEC FILE
IFOFF SWSYSI
GOTO FALSE
THEN ;COPY INFORMATION FROM YOCINF TO ZFI
HLRZ X0,YSYSIN(XLOW)
SUBI X0,1
SF X0,ZFIIBH(XRAC) ;SET UP INPUT BUFFER POINTER
LI X0,2
SF X0,ZFICHN(XRAC) ;SET CHANNEL 2
SF X0,ZFIBUF(XRAC) ;AND TWO BUFFERS
HRRM XRAC,YIOCHTB+2(XLOW)
MOVSI X0,'DSK'
SF X0,ZFIDVN(XRAC) ;AND DEVICE
LI X0,OFFSET(ZFIFIL)(XRAC) ;MOVE LOOKUP INFORMATION
HRLI X0,YOCINF(XLOW)
BLT X0,OFFSET(ZFIARG)(XRAC)
ELSE ;CASE 5!
MOVSI X5,'DSK'
L5():!
LI X4,1
SF X4,ZFICHN(XRAC) ;SET CHANNEL 1
HRRM XRAC,YIOCHTB+1(XLOW);UPDATE CHANNEL TABLE
LI X6,OFFSET(ZFISTI)(XRAC);USE FILEOBJECT FOR DUMMY OPEN
OPEN 1,X4
GOTO [ERRFILE
OCERR 3,OPEN failure
]
SF X5,ZFIDVN(XRAC)
IF ;NOT IN IOSPEC
SKIPE X0,YOCSIN(XLOW)
GOTO FALSE
THEN L X4,[SIXBIT/SYSIN/]
DEVCHR X4,
JUMPE X4,L4 ;If SYSIN unassigned
edit(302)
TLNE X4,DV.TTA ;[302]
GOTO L4 ;If SYSIN assigned to TTY
L X0,[SIXBIT/SYSIN/]
SF X0,ZFIFIL(XRAC)
DEVNAM X0,
NOP
SF X0,ZFIDVN(XRAC)
FI
GETSYSBUFF ;SET UP BUFFER AREA FOR SYSIN
SF X0,ZFIIBH(XRAC)
LI X0,1
SF X0,ZFISTI(XRAC)
WHILE OPEN 1,OFFSET(ZFISTI)(XRAC)
GOTO TRUE
GOTO FALSE
DO ;CAN'T OPEN SPECIFIED DEVICE!!
BREAKOUTIMAGE 56 ;CANNOT OPEN
LF X0,ZFIDVN(XRAC)
TYPENAME
OUTIMAGE 57 ;PLEASE ENTER NEW DEVICE:
edit(225)
TTYSPEC ;[225]
GOTO TRUE
GETNAME
SF XNAME,ZFIDVN(XRAC)
OD
LINKBUFF
L XCB,XRAC
FILELOOKUP
LFE X0,ZBHLEN(X1)
MOVN X0,X0
SF X0,ZBHLEN(X1) ;FLAG THIS BUFFER OCCUPIED
FI
FI
FI
;COMMON ACTIONS FOR SYSIN:
LF X0,ZFIDVN(XRAC)
DEVCHR X0,
SF X0,ZFIKAR(XRAC) ;FILE CHARACTERISTICS FOR SYSIN
ST XRAC,YSYSIN(XLOW)
SETON ZFIOPN(XRAC) ;FLAG SYSIN OPEN
SETON ZFIIN(XRAC) ;AS A FILE THAT CAN DO INPUT
SETON ZFIIF(XRAC) ;AND AS AN INFILE
IF ;END OF FILE on Sysin when reading specifications
IFOFF SWSYSE
GOTO FALSE
THEN ;Flag end of file on Sysin
SETON ZFIEND(XRAC)
FI
L XCB,XRAC
LI XWAC1,^D80 ;DEFAULT IMAGE SIZE FOR SYSIN
SETWIDTH
HLRS XWAC2 ;MAKE POS=LENGTH+1
STD XWAC1,OFFSET(ZFIIMG)(XCB) ;SAVE IMAGE REFERENCE
ENDD
SUBTTL SET UP FILE OBJECT FOR SYSOUT
;NOW SYSOUT MUST BE OPENED AND INITIALIZED
BEGIN
LI XSAC,IOPF
EXEC .SAAB ;GET FILE OBJECT FOR SYSOUT
MOVSI X0,(<QZCL>B<%ZDNTYP>+1B<%ZDNTER>)
WSF X0,ZDNTYP(XRAC)
L X0,[SIXBIT/SYSOUT/]
SF X0,ZFINAM(XRAC) ;LOGICAL NAME IS SYSOUT
ST XRAC,YSYSOU(XLOW)
SETON ZFIOF(XRAC) ;FLAG SYSOUT AS OUTFILE
L XCB,XRAC
IF ;SYSOUT IS SPECIFIED
SKIPN X1,YOCSOU(XLOW)
GOTO FALSE
THEN ;COPY IOSPEC ENTRY
COPYSPEC
LF X5,ZFIDVN(XRAC)
CAMN X5,[SIXBIT/TTY/]
GOTO L1
ELSE ;TRY ASSIGN
MOVSI X5,'DSK'
FI
edit(177)
L X5 ;[177]
L X4,YSYSIN(XLOW) ;[177]
IF ;[177] Proper device, same as SYSIN device
DEVNAM
GOTO FALSE
CAME OFFSET(ZFIDVN)(X4)
GOTO FALSE
THEN ;May be placed on the same channel
LF ,ZFIKAR(X4) ;Characteristics from SYSIN file
IF ;A terminal, but not the controlling one
TLNN DV.TTA
TLNN DV.TTY
GOTO FALSE
THEN ;Use channel and buffer header from SYSIN
LF X1,ZFICHN(X4)
SF X1,ZFICHN(XRAC)
SF X5,ZFIDVN(XRAC)
LF X0,ZFIIBH(X4)
SF X0,ZFIIBH(XRAC)
ADDI X1,(XLOW)
HRLM XRAC,YIOCHT(X1)
GETSYSBUFF
SF X0,ZFIOBH(X4)
GOTO L7
FI FI ;[177]
GETCHANNEL
SF X1,ZFICHN(XRAC)
LI X4,1
LI X6,OFFSET(ZFISTI)(XRAC);USE FILEOBJECT FOR DUMMY OPEN
HLLZ X0,OFFSET(ZFICHN)(XRAC)
TLO X0,(OPEN)
HRRI X0,X4
XCT X0
GOTO [ERRFILE
OCERR 3,OPEN failure
]
SF X5,ZFIDVN(XRAC)
IF ;NOT IN IOSPEC
SKIPE X0,YOCSOU(XLOW)
GOTO FALSE
THEN L X0,[SIXBIT/SYSOUT/]
SF X0,ZFIFIL(XRAC) ;FILE NAME IS ALSO SYSOUT IF NOT IN IOSPEC
DEVCHR X0,
IF ;TTY
JUMPE X0,TRUE
TLNN X0,DV.TTA
GOTO FALSE
THEN
LF X1,ZFICHN(XRAC)
ADDI X1,(XLOW)
SETZM YIOCHTB(X1) ;RELEASE CHANNEL IN CHANNEL TABLE
MOVSI X0,'TTY'
SF X0,ZFIDVN(XRAC)
L1():!
HRLM XRAC,YIOCHTB(XLOW)
LI X0,2
WSF X0,ZFICHN(XRAC) ;SET CHANNEL 0 AND TWO BUFFERS
HRL X0,YTTOB(XLOW)
HRR X0,YTTIB(XLOW)
WSF X0,ZFIIBH(XRAC) ;SET UP BUFFER AREA POINTERS
GOTO L9
FI
L X0,[SIXBIT/SYSOUT/]
DEVNAM X0,
NOP
SF X0,ZFIDVN(XRAC) ;SET PHYSICAL DEVICE NAME
FI
GETSYSBUFF
L7():! SF X0,ZFIOBH(XRAC)
WHILE
OP X0,(OPEN)
IOR X0,OFFSET(ZFICHN)(XRAC)
HRRI X0,OFFSET(ZFISTI)(XRAC)
XCT X0 ;OPEN THIS CHANNEL
GOTO TRUE
GOTO FALSE
DO ;OPEN FAILURE
OUTIMAGE 56 ;CANNOT OPEN
LF X0,ZFIDVN(XRAC)
TYPENAME
OUTIMAGE 57 ;PLEASE ENTER NEW DEVICE
edit(225)
TTYSPEC ;[225]
GOTO TRUE
GETNAME
SF XNAME,ZFIDVN(XRAC);STORE NEW DEVICE AND TRY AGAIN
OD
LINKBUFF
L XCB,XRAC
OUTENTER
LFE X0,ZBHLEN(X1)
MOVN X0,X0
SF X0,ZBHLEN(X1)
;HERE WHEN SYSOUT OPENED AND ENTERED
L9():!
SETON ZFIPF(XCB) ;FLAG SYSOUT AS PRINTFILE
SETON ZFIOUT(XCB) ;WHICH CAN DO OUTPUT
LF X0,ZFIDVN(XCB)
DEVCHR X0,
SF X0,ZFIKAR(XCB) ;FILE CHARACTERISTICS FOR SYSOUT
LI XWAC1,^D132 ;DEFAULT IMAGE SIZE FOR SYSOUT
SETWIDTH
BRANCH OCEI
ENDD
IFN QDEBUG,<
OCINPA: BLOCK 100 ;PATCH AREA
>
SUBTTL LITERALS
LIT
END