Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/17/ionf.mac
There are 2 other files named ionf.mac in the archive. Click here to see a list.
;<ENDERIN>IONF.MAC.18, 3-Jan-77 19:36:34, Edit by ENDERIN
SEARCH SIMMAC,SIMMCR,SIMRPA
SALL
RTITLE IONF
SUBTTL WRITTEN BY OLOF BJ@RNER DEC 1973
ERRMAC(IO)
MACINIT
COMMENT ;
This module contains actions necessary to create and initialize
a file object.
It contains the following subroutines:
CHECKAST checks a field in a file specification
for presence of asterisk
CREATEFILE allocates buffers for a new file
FILELOOKUP/FILEENTER performs LOOKUP or ENTER on a new file
OPENFILE performs OPEN for a new file
PRINTSPEC types a file specification on TTY
PROCSPEC creates the ZFI record from the ZFD record
REOPEN reopens a file that has been closed previously
SETUPFILE performs all common initial actions for a new file
When a new file object is generated SETUPFILE is called from the
file object generation code in the IO module (IOCA entry).
See the the source code of the IO module. SETUPFILE uses
all the other subroutines in this module.
;
OPDEF CHECKAST [XEC IOAST]
OPDEF OPENFILE [XEC .IOOPN]
OPDEF PROCSPEC [XEC .OCINA]
EXTERN .SAAR
PROCINIT IONF
INTERN .IOCOM,.OCINK
TWOSEG
RELOC 400K
IFN QDEBUG,<
IONFST: ;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:
=============================
NO MESSAGE
-- -------
1 OPEN FAILURE
2 FILE ALREADY ASSIGNED TO TTY
;
SUBTTL LOCAL SUBROUTINE: CHECKAST
COMMENT ;
PURPOSE: TO SEE IF A FIELD IN THE FILE SPECIFICATION
CONTAINS AN ASTERISK AND TO ASK THE USER
FOR INFORMATION.
ENTRY: IOAST
INPUT ARGUMENTS:
X1 POINTS TO THE FIELD
OUTPUT ARGUMENTS:
IMMEDIATE RETURN IF AN ASTERISK IS FOUND, ELSE SKIP RETURN.
THE USERS ANSWER IN YOCBUF READY FOR GETNAME OR GETPPN.
NORMAL EXIT: SEE OUTPUT ARGUMENTS
ERROR EXIT: -
CALL FORMAT: CHECKAST
USED ROUTINES: BREAKOUTIMAGE,TYPENAME,TTYSPEC [225],GETSPEC,PROCSPEC
USED REGISTERS: X0, X1, XBYTE
ERROR MESSAGES: -
;
IOAST: PROC
HRLI X1,(POINT 6,0) ;MAKE X1 A BYTE POINTER
ILDB XBYTE,X1 ;LOAD POSSIBLE ASTERISK, WHICH SHOULD BE LEFT JUSTIFIED
IF ;NOT ASTERISK
CAIN XBYTE,'*'
GOTO FALSE
THEN AOS (XPDP) ;NO ASTERISK, SKIP RETURN
edit(61)
SETZ ;[61] Ok signal
RETURN
FI
L1():! IFON ZFIFND(XCB) ;[61]
GOTO L7
BREAKOUTIMAGE <%Please specify additional information for logical file: >
LF X0,ZFINAM(XCB)
TYPENAME
OUTIMAGE <>
edit(225)
edit(41)
TTYSPEC ;[225,41]
GOTO L1 ;[225,41]
GETSPEC
GOTO L1 ;ERROR!
PROCSPEC
GOTO L1 ;ERROR!
RETURN
L7():! AOS (XPDP) ;[61]
SETO
RETURN
EPROC
SUBTTL LOCAL SUBROUTINE: CREATEFILE
COMMENT ;
PURPOSE: TO ALLOCATE BUFFERS FOR A NEW FILE,
TELL THE MONITOR, LINK THE BUFFERS
AND FINALLY CLAIM THEM.
A ZXB BLOCK IS CREATED IF THE FILE
IS A DIRECTFILE OR AN OUTFILE.
ENTRY: .IOCF
INPUT ARGUMENTS:
XCB POINTS TO FILE OBJECT.
X6-X7 SHOULD CONTAIN ARGUMENTS TO GETBUFF
OUTPUT ARGUMENTS:
X0=0 if ok, -1 if not ok [61]
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: CREATEFILE
USED ROUTINES:
GETBUFF
OPENFILE
LINKBUFF
FILELOOKUP
OUTENTER
.SAAR
FILEENTER
USED REGISTERS: X0, X1, XTAC
ERROR MESSAGES: -
;
.IOCF: PROC
edit(105)
IF ;[105] Buffers are wanted
IFON ZFIBNW(XCB)
GOTO FALSE
THEN ;[105] Set them up
GETBUFF
ADDI X1,1 ;ADDRESS TO BUFFER RING HEADER
;SET UP BUFFER HEADER ADDRESS
edit(61)
L OFFSET(ZFIIN)(XCB) ;[61]
IFONA ZFIIN
SF X1,ZFIIBH(XCB)
IFONA ZFIOUT
SF X1,ZFIOBH(XCB)
;NOW PERFORM REAL OPEN AND LINK THE BUFFERS
OPENFILE
SUBI X1,1
LINKBUFF
edit(114)
IF ;[114] TTY
LF ,ZFIKAR(XCB)
TLNN DV.TTU
GOTO FALSE
THEN ;Check if another buffer header already exists
WLF X1,ZFIIBH(XCB)
IFOFF ZFIOUT(XCB)
MOVSS X1 ;Put the other pointer in right half
IF ;There was a header for the other side
TRNN X1,-1
GOTO FALSE
THEN ;Restore current buffer pointer, destroyed by OPEN
LI 4(X1) ;First buffer address
SETONA ZBHUSE
WSF ,ZBHZBU(X1,-1)
ZF ZBHCNT(X1,-1) ;Reset count
FI FI ;[114]
edit(242)
ELSE ;[242] May have buffers already
SKIPE OFFSET(ZFIIBH)(XCB)
OPENFILE
FI ;[105]
edit(244)
IF ;[244] DSK file
LF ,ZFIKAR(XCB)
TLNN DV.DSK
GOTO FALSE
THEN ;Always extended lookup/enter block
IF ;Not already allocated
IFON ZFIDE(XCB)
GOTO FALSE
THEN ;MUST CREATE AN EXTENDED ENTER BLOCK
LI XTAC,2+1+.RBDEV ;LENGTH OF THIS BLOCK
HRLI XTAC,QZXB ;BLOCK TYPE
SETZM YSANIN(XLOW)
EXEC .SAAR ;GET RECORD
IFN QSADEA,< ;UPDATE YSADEA IN DEALLOCATE VER.
L X0,YSATOP(XLOW)
ST X0,YSADEA(XLOW)
>
;NOW MOVE INFORMATION FROM ZFI TO ZXB
LI X0,.RBDEV ;NUMBER OF ARGUMENTS
SF X0,ZYSARG(XTAC)
HRLI X0,OFFSET(ZFIFIL)(XCB)
HRRI X0,OFFSET(ZXBFIL)(XTAC)
BLT X0,OFFSET(ZXBPRT)(XTAC);MOVE LOOKUP/ENTER INFO
LF X1,ZFIPPN(XCB)
IFON ZFISFD(XCB)
WLF X1,ZFIPRJ(XCB) ;GET SFD-BLOCK REF
SF X1,ZXBP2(XTAC)
SKIPE X1,YIOZFS(XLOW)
LF X1,ZFSSIZ(X1)
IF ;SIZE DEFINED IN IOSPEC
JUMPN X1,FALSE ;TAKE ESTIMATED SIZE FROM
;ZFS IF DEFINED THERE
THEN SKIPN X1,YIOSIZ(XLOW) ;TAKE FROM NEW IF DEFINED
LI X1,5 ;ELSE DEFAULT
FI
SF X1,ZXBLEN(XTAC)
SF XTAC,ZFIFIL(XCB) ;POINTER TO EXTENDED BLOCK
SETON ZFIDE(XCB)
ELSE
LF XTAC,ZFIFIL(XCB)
ZF ZXBALC(XTAC)
FI
FI
edit(105)
IFON ZFINLE(XCB) ;[105] No lookup/enter?
GOTO L6 ;[105] If not
;THEN INITIALIZE THE FILE THRU LOOKUP OR ENTER
IF ;INFILE
IFOFF ZFIIF(XCB)
GOTO FALSE
THEN FILELOOKUP
edit(61)
JUMPN L7 ;[61] failure
ELSE
IF ;Not Directfile
IFON ZFIDF(XCB)
GOTO FALSE
THEN OUTENTER
JUMPN L7 ;[61] failed
ELSE ;Directfile
L8():! IF FILELOOKUP
GOTO FALSE
THEN ;FAILURE RETURN
FILEENTER ;ENTER THIS FILE
NOP ;IGNORE ERROR RETURN
JUMPN L7 ;[61]
;NOW CLOSE THE FILE
HLLZ X0,OFFSET(ZFICHN)(XCB)
TLO X0,(CLOSE)
XCT X0
GOTO L8 ;AND TRY LOOKUP AGAIN
FI
JUMPN L7 ;[61]
;HERE IF LOOKUP OK
L X1,OFFSET(ZFIRON)(XCB) ;[61]
edit(24)
IFOFFA ZFIRON(X1) ;[24] [61] No enter if read only
FILEENTER
SKIPA ;OK RETURN
GOTO L8 ;ERROR RETURN, TRY LOOKUP AGAIN
JUMPN L7 ;[61]
ZF ZDFLOC(XCB) ;LOCATE(0)
;[24] Code for ZDFIML, ZDFLIM moved to .IOOP
FI FI
;LOOKUP/ENTER HAS NOW SUCCEEDED
;CLAIM THE ALLOCATED BUFFER
edit(105)
L6():! WLF X1,ZFIIBH(XCB) ;[105] IBH in rh, word is zero if no buffer
IF ;[105] There are buffers
JUMPE X1,FALSE
THEN ;Link them up, claim them
IFOFF ZFIIN(XCB)
LF X1,ZFIOBH(XCB)
LF X0,ZBHLEN(X1,-1) ;CLAIM BUFFER
MOVN X0,X0
SF X0,ZBHLEN(X1,-1)
FI
L9():!
edit(61)
SETZ ;[61] Ok return
L7():! RETURN ;[61] X0 already set here
EPROC
SUBTTL LOCAL SUBROUTINE: FILELOOKUP/FILEENTER
COMMENT ;
PURPOSE: TO LOOKUP OR ENTER A FILE.
IF ENTER FAILURE OCCURS THEN THE USER IS ASKED
TO SUPPLY A NEW FILE SPECIFICATION AND
ENTER IS TRIED AGAIN UNLESS IT IS A DIRECTFILE
OR APPEND MODE ENTER.
IF LOOKUP FAILURE OCCURS THEN THE USER IS ALSO
CONSULTED AND LOOKUP IS TRIED AGAIN UNLESS
IT IS DIRECTFILE OR APPEND MODE LOOKUP.
ENTRIES: .IOLOK FOR LOOKUP
.IOENT FOR ENTER
INPUT ARGUMENTS:
XCB POINTS TO THE FILE OBJECT
OUTPUT ARGUMENTS:-
EXITS: INFILE IMMEDIATE RETURN WHEN LOOKUP SUCCEEDS
OUTFILE IMMEDIATE RETURN WHEN ENTER SUCCEEDS
PRINTFILE SAME AS OUTFILE
APPEND MODE IF LOOKUP FAILURE THEN IMMEDIATE RETURN
IF ENTER FAILURE THEN SKIP RETURN
AFTER DIALOGUE
DIRECTFILE IF LOOKUP/ENTER SUCCEEDS THEN IMMEDIATE RETURN
IF LOOKUP FAILURE THEN IMMEDIATE RETURN
IF ENTER FAILURE THEN SKIP RETURN AFTER
DIALOGUE
CALL FORMATS: FILELOOKUP OR FILEENTER
USED ROUTINES: BREAKOUTIMAGE
OUTIMAGE
TYPENAME
TTYSPEC [225]
GETSPEC
PROCSPEC
OPENFILE
USED REGISTERS: X0,X1,X2,X3,XBUF,XFL [61]
ERROR MESSAGES: ?LOOKUP OR ENTER FAILURE ...
?DEVICE <...> ILLEGAL
CAN'T SWITCH DEVICE AT THIS STAGE
?ILL FILE DESC.
;
edit(61)
XFL==X7 ;[61] Flag register
.IOLOK: PROC
OPZ (LOOKUP) ;X0:=DESIRED UUO
SETON SWLOK
GOTO L1 ;[61]
.IOENT:
OPZ (ENTER) ;X0:=DESIRED UUO
SETOFF SWLOK
L1():! SAVE <X1,X2,X3,XBUF,XFL> ;[61]
N==5 ;[61] Number of words on stack
L X3,X0 ;[61] Opcode (LOOKUP or ENTER)
L2():!
L XFL,OFFSET(ZFIDE)(XCB) ;[61] Most flags easily accessible
IOR X3,OFFSET(ZFICHN)(XCB) ;INSERT CHANNEL
;FETCH ADDRESS TO LOOKUP/ENTER INFO
HRRI X3,OFFSET(ZFIFIL)(XCB)
IF ;Extended block exists
IFOFFA ZFIDE(XFL) ;[61]
GOTO FALSE
THEN ;Use it
LF X2,ZFIFIL(XCB)
HRRI X3,OFFSET(ZYSARG)(X2)
FI
LF X2,ZFIPPN(XCB)
edit(244)
CAMN X2,[-1] ;[244]
SETZ X2, ;[244]
IF ;SFD:S
IFOFFA ZFISFD(XFL)
GOTO FALSE
THEN
edit(225)
IFE QDEC20,<;[225]
IF ;EXTENDED BLOCK
IFOFFA ZFIDE(XFL)
GOTO FALSE
THEN ;MOVE PPN TO ZXB INDICATED BY EXTENDED BLK
LF X1,ZFIFIL(XCB) ;POINTER TO EXT BLOCK
LF XBUF,ZXBP2(X1) ;POINTER TO SFD BLOCK
SF X2,ZYSP1(XBUF) ;STORE PPN
LI X1,OFFSET(ZXBP2)(X1);X1 = REF TO SFD REF
ELSE ;MOVE PPN TO ZYS POINTED AT
;FROM FILE OBJECT
LF X1,ZFIARG(XCB) ;POINTER TO SFD BLOCK
SF X2,ZYSP1(X1)
LI X1,OFFSET(ZFIARG)(XCB);X1 = REF TO SFD REF
FI
edit(144)
STACK (X1) ;[144] Save ppn field
AOS (X1) ;UPDATE SFD POINTER FOR
AOS (X1) ;LOOKUP/ENTER UUO
>
ELSE ;STORE PPN IN FILE OBJECT OR EXTENDED BLOCK
LI X1,OFFSET(ZFIPRJ)(XCB) ;[144] Address of ppn field
edit(244)
edit(244)
IFONA ZFIDE(XFL) ;[244]
LI X1,.RBPPN(X3) ;[244]
ST X2,(X1)
edit(144)
STACK X2 ;[144] Save ppn
FI
IF XCT X3 ;EXECUTE DESIRED UUO
GOTO FALSE ;LOOKUP/ENTER FAILURE
THEN ;LOOKUP/ENTER OK!
UNSTK (X1) ;[144] Restore ppn or SFD pointer
GOTO L8 ;[61] Ok return
edit(61)
FI
UNSTK (X1) ;[144] Restore ppn or SFD pointer
LI X2,OFFSET(ZFIEXT)(XCB) ;ADDRESS TO ERROR CODE
LF X1,ZFIFIL(XCB)
IFONA ZFIDE(XFL)
LI X2,OFFSET(ZXBEXT)(X1)
HRRZ X0,(X2) ;LOAD ERROR CODE
IF ;[61] This does not count as an error
JUMPN FALSE
IFOFF SWLOK
GOTO FALSE
IFONA ZFIAPP(XFL)
GOTO TRUE
IFONA ZFIDF(XFL)
edit(24)
IFONA ZFIRON(XFL) ;[24]
GOTO FALSE
THEN ;SKIP RETURN
edit(61)
AOS -N(XPDP) ;[61]
GOTO L8 ;[61]
FI
L3():!
IF ;[61] failure should not cause dialogue
IFOFFA ZFIFND(XFL)
GOTO FALSE
THEN ;Return with -1 in X0
SETO
GOTO L9
FI
BREAKOUTIMAGE <?LOOKUP or ENTER error (>
;CONVERT AND PRINT ERROR CODE:
OUTOCT ;[61]
BREAKOUTIMAGE <) on >
L XCB ;[61]
TYPESPEC ;[61]
L4():!
SETOFF SWSWERR
OUTIMAGE <Enter new file desc>
;GET AND PROCESS ANSWER
edit(225)
TTYSPEC ;[225]
GOTO L4 ;[225]
GETSPEC
GOTO L5
PROCSPEC
GOTO L5
edit(61)
L XFL,OFFSET(ZFIDE)(XCB) ;[61] Fetch flag word
IF ;NEW DEVICE DEFINED
SKIPN X1,YOCFD(XLOW)
GOTO FALSE
THEN ;CHECK IF DEVICE SWITCHED!
DEVCHR X1,
IF ;ILLEGAL DEVICE
JUMPN X1,FALSE
L6():! THEN ;ERROR
BREAKOUTIMAGE <?Device >
L X0,YOCFD(XLOW)
TYPENAME
BREAKOUTIMAGE < illegal. >
GOTO L4
FI
IF ;OLD DEVICE IS DISK
IFOFF ZFIDSK(XCB)
GOTO FALSE
THEN IF ;NEW DEVICE IS NOT DSK
TLNE X1,DV.DSK
GOTO FALSE
L7():! THEN ;ERROR
OUTIMAGE<Cannot switch device at this stage!>
GOTO L6
FI
ELSE ;MUST BE DECTAPE!
TLNN X1,DV.DTA
GOTO L7 ;IF NEW DEVICE IS NOT DECTAPE
FI
LF X2,ZFIIBH(XCB)
IFONA ZFIOUT(XFL) ;[61]
LF X2,ZFIOBH(XCB)
STACK (X2) ;SAVE FIRST WORD OF BUFFER
;RING HEADER
OPENFILE
UNSTK (X2) ;AND RESTORE IT AFTER OPEN
FI
edit(10)
EXEC IONFCA ;[10] CHECK ACCESS:APPEND
IF IFONA ZFIAPP(XFL)
GOTO TRUE
edit(61)
IFOFFA ZFIRON(XFL) ;[61]
IFOFFA ZFIDF(XFL)
GOTO L2
THEN ;DIRECTFILE OR APPEND MODE
;RETURN AND TRY AGAIN
AOS -N(XPDP)
FI
edit(61)
L8():! SETZ ;[61]
L9():! RETURN
L5():!
BREAKOUTIMAGE <?Ill. file desc. >
GOTO L4
EPROC
SUBTTL LOCAL SUBROUTINE: OPENFILE
COMMENT ;
PURPOSE: THIS SUBROUTINE OPENS A FILE ON THE CHANNEL
SPECIFIED IN THE FILE OBJECT
ENTRY: .IOOPN
INPUT ARGUMENTS:XCB POINTS TO THE FILE OBJECT
OUTPUT ARGUMENTS:
X0=0 if OK, -1 otherwise
NORMAL EXIT: RETURN
ERROR EXIT: IOERR
CALL FORMAT: OPENFILE
USED ROUTINES: FILEERROR
USED REGISTERS: X0
ERROR MESSAGE: OPEN FAILURE
(NOTE THAT THIS SHOULD NOT OCCUR SINCE
THIS CHANNEL WAS OPENED EARLIER TO
FACILITATE OTHER UUO:S, SEE SETUPFILE)
;
.IOOPN: PROC
HLLZ X0,OFFSET(ZFICHN)(XCB);GET CHANNEL
TLO X0,(OPEN)
HRRI X0,OFFSET(ZFISTI)(XCB);AND STATUS
edit(61)
IF ;[61] OPEN works
XCT X0
GOTO FALSE
THEN ;Ok
GOTO L8
FI
IF ;[61] Error can be accepted
IFOFF ZFIFND(XCB)
GOTO FALSE
THEN ;Signal the error in X0
SETO
GOTO L9
FI
FILEERROR
IOERR 1,OPEN failure
L8():! SETZ ;[61] Ok return
L9():! RETURN ;[61]
EPROC
SUBTTL PRINTSPEC
COMMENT ;
PURPOSE: TO PRINT THE CURRENT SPECIFICATION ON TTY
ENTRY: .OCINE
INPUT ARGUMENT: -
OUTPUT ARGUMENT:-
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: PRINTSPEC
USED ROUTINES: -
USED REGISTERS: X0, X1
ERROR MESSAGE: -
;
.OCINE: PROC
SAVE <X1>
IFON SWTTY
GOTO L9 ;DON'T PRINT IF INPUT FROM TTY!
L X0,[POINT 7,YOCBUF(XLOW)];POINTER TO INTERNAL BUFFER
LOOP ;UNTIL CR
ILDB X1,X0
edit(225)
PBOUT ;[225]
AS CAIE X1,QCR
GOTO TRUE
SA
LI X1,QLF
PBOUT ;PRINT LINE FEED
L9():!
RETURN
EPROC
SUBTTL PROCSPEC
COMMENT ;
PURPOSE: TO PROCESS A ZFD RECORD AND UPDATE ZFI.
A ZYS RECORD IS CREATED IF THERE ARE SFD:S.
ONLY NON-EMPTY FIELDS IN ZFD ARE MOVED TO ZFI.
POSSIBLE SWITCHES ARE PROCESSED.
ENTRY: .OCINA
INPUT ARGUMENTS:
XLOW POINTS TO ZFD
XCB POINTS TO ZFI.
OUTPUT ARGUMENTS:-
NORMAL EXIT: SKIP RETURN
ERROR EXIT: IMMEDIATE RETURN, IF ERROR IN SWITCHES
CALL FORMAT: PROCSPEC
USED ROUTINES: FIXSWITCH
.SAAR
GETNAME
USED REGISTERS: X0, XTAC, X3
ERROR MESSAGES: -
;
.OCINA: PROC
SAVE <XTAC,X3>
N==2 ;Number of quantities on stack above return address
IF ;DEVICE IN ZFD
SKIPN XTAC,OFFSET(ZFDDEV)(XLOW)
GOTO FALSE
THEN SF XTAC,ZFIDVN(XCB)
ELSE
IF ;NO DEVICE IN ZFI
SKIPE X0,OFFSET(ZFIDVN)(XCB)
GOTO FALSE
THEN MOVSI XTAC,'DSK' ;DEFAULT DEVICE
SF XTAC,ZFIDVN(XCB)
FI
FI
IF ;EXTENDED BLOCK EXISTS
IFOFF ZFIDE(XCB)
GOTO FALSE
THEN ;MOVE INFO TO THIS BLOCK
LF X3,ZFIFIL(XCB) ;X3:=POINTER TO EXTENDED BLOCK
SKIPE XTAC,OFFSET(ZFDFIL)(XLOW)
SF XTAC,ZXBFIL(X3)
SKIPE XTAC,OFFSET(ZFDEXT)(XLOW)
edit(3)
WSF XTAC,ZXBEXT(X3) ;[3]
ELSE ;MOVE INFO TO FILE OBJECT
SKIPE XTAC,OFFSET(ZFDFIL)(XLOW)
SF XTAC,ZFIFIL(XCB)
SKIPE XTAC,OFFSET(ZFDEXT)(XLOW)
WSF XTAC,ZFIEXT(XCB)
FI
IF ;PPN DEFINED
SKIPN XTAC,OFFSET(ZFDPRJ)(XLOW)
GOTO FALSE
THEN SF XTAC,ZFIPPN(XCB)
IF ;SFD BLOCK EXISTS
IFOFF ZFISFD(XCB)
GOTO FALSE
THEN IF ;NO SFD IN NEW FILE SPEC
SKIPE X0,OFFSET(ZFDSFD)(XLOW)
GOTO FALSE
THEN ;STORE PPN IN FILE OBJECT AND
;DELETE OLD SFD BLOCK
WSF XTAC,ZFIPRJ(XCB)
ELSE ;STORE PPN IN OLD SFD BLOCK
LF X1,ZFIARG(XCB)
SF XTAC,ZYSP1(X1)
FI
ELSE
IF ;EXTENDED BLOCK EXISTS
IFOFF ZFIDE(XCB)
GOTO FALSE
THEN ;STORE PPN IN EXTENDED BLOCK
;ADDRESS SHOULD STILL BE IN X3!
SF XTAC,ZXBP2(X3)
ELSE ;STORE PPN IN FILE OBJECT
WSF XTAC,ZFIPRJ(XCB)
FI
FI
FI
CAIN XBYTE,"/"
FIXSWITCH
edit(225)
IFE QDEC20,<;[225]
IF ;SUB FILE DIRECTORIES
SKIPN X3,OFFSET(ZFDSFD)(XLOW)
GOTO FALSE
THEN ;CREATE ZYS RECORD
LI XTAC,4(X3) ;LENGTH OF RECORD = NO OF SFD:S + 4
IF ;SFD IN ZFI
IFOFF ZFISFD(XCB)
GOTO FALSE
THEN ;CHECK IF EXISTING ZYS IS BIG ENOUGH
LF X1,ZFIARG(XCB)
IF ;EXTENDED BLOCK
IFOFF ZFIDE(XCB)
GOTO FALSE
THEN LF X1,ZFIFIL(XCB)
LF X1,ZXBP2(X1)
FI
L X0,1(X1) ;LENGTH OF OLD ZYS
SUBI X0,2
CAMGE X0,XTAC
GOTO FALSE
LI XTAC,(X1) ;OLD RECORD WILL DO!
ELSE ;ALLOCATE A NEW RECORD
HRLI XTAC,QZYS ;RECORD TYPE
ADDI XTAC,2
SETOM YSANIN(XLOW) ;NO INITIALIZATION
ST XCB,YOBJAD+3(XLOW)
LF XCB,ZDRZBI(XCB)
EXEC .SAAR
IFN QSADEA,< ;UPDATE YSADEA IN DEALLOCATE VER.
L X0,YSATOP(XLOW)
ST X0,YSADEA(XLOW)
>
L XCB,YOBJAD+3(XLOW)
SETZM YOBJAD+3(XLOW)
IF ;EXTENDED BLOCK DEFINED
IFOFF ZFIDE(XCB)
GOTO FALSE
THEN ;STORE SFD REF IN EXTENDED BLOCK
LF X3,ZFIFIL(XCB) ;REF TO EXT BLOCK
SF XTAC,ZXBP2(X3)
ELSE ;STORE REF TO SFD IN FILE OBJECT'S PPN
SF XTAC,ZFIARG(XCB);ADDRESS TO ZYS
FI
SETON ZFISFD(XCB)
FI
LF X0,ZFDPNT(XLOW)
ST X0,YOCPNT(XLOW)
LF X0,ZFIPPN(XCB) ;MOVE PPN
SF X0,ZYSP1(XTAC)
edit(262)
LF X3,ZFDSFD(XLOW) ;[262] Number of SFD's again
LOOP ;AND STORE SFD:S
GETNAME
NOP -1 ;[263] Disallow funny name
edit(263)
SF XNAME,ZYSSFD(XTAC)
AS ADDI XTAC,1
SOJG X3,TRUE
SA
ZF ZYSSFD(XTAC) ;RESET LAST SFD NAME
FI >;[225]
IF ;NEW PROTECTION
SKIPN XTAC,OFFSET(ZFDPT)(XLOW)
GOTO FALSE
THEN IF ;EXTENDED BLOCK EXISTS
IFOFF ZFIDE(XCB)
GOTO FALSE
THEN ;STORE PROTECTION IN ZXB
LF X1,ZFIFIL(XCB)
SF XTAC,ZXBPRT(X1)
ELSE ;STORE PROTECTION IN FILE OBJECT
WSF XTAC,ZFIPT(XCB)
FI FI
IFOFF SWSWERR
AOS -N(XPDP) ;IMMEDIATE RETURN IF ERROR IN SWITCHES
RETURN
EPROC
SUBTTL REOPEN
COMMENT ;
PURPOSE: TO REOPEN AN ALREADY USED FILE
ENTRY: .OCINK
INPUT ARGUMENT: XWAC1 POINTS TO FILE OBJECT
OUTPUT ARGUMENT:-
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: REOPEN
USED ROUTINES: GETCHANNEL
CREATEFILE
USED REGISTERS: XWAC1, XCB, X1, X6, X7
ERROR MESSAGES: -
;
.OCINK:
EXCH XCB,XWAC1
ST XWAC1,YOBJAD(XLOW) ;SAVE XWAC1 IN CASE OF
;GARBAGE COLLECTION
GETCHANNEL
HRRZS OFFSET(ZFICHN)(XCB) ;RESET HALFWORD WITH CHANNEL
SF X1,ZFICHN(XCB) ;STORE NEW CHANNEL
LF X6,ZFIBFS(XCB) ;BUFFER SIZE
LF X7,ZFIBUF(XCB) ;NUMBER OF BUFFERS
CREATEFILE
L XWAC1,YOBJAD(XLOW)
edit(274)
SETZM YOBJAD(XLOW) ;[274] Must not leave address for GC
EXCH XCB,XWAC1
RETURN
SUBTTL SUBROUTINE: SETUPFILE
COMMENT ;
PURPOSE: THIS PROCEDURE PERFORMS ALL COMMON INITIAL FILE ACTIONS:
1. THE LOGICAL NAME IS FETCHED FROM THE PARAMETER YYNAME.
THE FILE SPECIFICATION IS FETCHED AND STORED IN ZFI.
2. IOSPEC IS SEARCHED FOR THE LOGICAL NAME.
IF IT IS FOUND, RELEVANT INFORMATION IS COPIED
TO THE FILE OBJECT, THUS OVERRIDING THE
SPECIFICATION IN YYNAME.
3. AN I/O CHANNEL IS ESTABLISHED.
4. IF THE FILE SPECIFICATION CONTAINS ASTERISKS
A DIALOGUE IS INITIATED TO COMPLETE THE
SPECIFICATION.
5. A DUMMY OPEN IS PERFORMED TO FACILITATE LATER
USE OF DEVCHR.
6. IF THE FILE IS OF TYPE DIRECT, THE DEVICE IS CHECKED
WITH DEVCHR TO ASSERT THAT IT IS DSK. IF NOT A WARNING
MESSAGE IS PRINTED AND DSK IS ASSUMED.
7. IF THE DEVICE IS TTY THEN THE DEDICATED CHANNEL 0 IS USED.
SHOULD THIS CHANNEL BE OCCUPIED BY ANOTHER FILE
A RUN TIME ERROR OCCURS.
8. THE BUFFER SIZE AND THE NUMBER OF BUFFERS ARE DETERMINED
AND A BUFFER AREA IS ALLOCATED. IF IT IS A DIRECTFILE
ONLY ONE BUFFER IS USED REGARDLESS OF THE USER SPECIFICATION.
9. A REAL OPEN IS PERFORMED WITH THE ACTUAL BUFFER ADDRESS.
10. THE MONITOR IS INFORMED THROUGH THE CREATEFILE SUBROUTINE.
ENTRY: .IOCOM
INPUT ARGUMENTS:XCB POINTS TO THE FILE OBJECT.
ZFISPC CONTAINS TEXT REFERENCE TO THE FILE
OBJECT ARGUMENT.
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: SETUPFILE
USED ROUTINES: GETBYTE
FIXSWITCH
FINDLOGICAL
GETSPEC
OUTIMAGE
BREAKOUTIMAGE
PRINTSPEC
TTYSPEC [225]
PROCSPEC
COPYSPEC
GETCHANNEL
CHECKAST
TYPENAME
GETNAME
FILEERROR
CREATEFILE
USED REGISTERS: X0 - X7
XCB, XBUF
ERROR MESSAGES: ?ILL FILE DESCRIPTOR IN FILE OBJECT ARGUMENT
?DEVICE ILLEGAL
CAN'T DO OUTPUT TO DEVICE
CAN'T DO INPUT FROM DEVICE
APPEND MODE IGNORED FOR NON DISK DEVICES
APPEND MODE IGNORED FOR INFILE
APPEND MODE IGNORED FOR DIRECTFILE
DEVICE NOT DSK FOR DIRECTFILE
FILE ALREADY ASSIGNED TO TTY (IOERR 2)
TOO MANY BUFFERS FOR FILE
;
.IOCOM: PROC
LOWADR ;SET BASE REGISTER TO STATIC AREA
CDEFER ;DEFER CALL ON SIMDDT TO USER RETURN IF ^C-REENTER
LF X3,ZFISPC(XCB) ;CREATE POINTER TO TEXT RECORD
ADDI X3,2
HRLI X3,(POINT 7,0)
SETON SWTR
SETON SWTTY ;IN CASE DIALOGUE IS REQUIRED
SETZM YIOSIZ(XLOW) ;RESET SIZE SWITCH ARG AREA
;NOW MOVE TEXT RECORD TO YOCBUF
HLRZ X6,OFFSET(ZFISPC)+1(XCB);GET LENGTH
edit(225)
Q==5*<YOCBUE-YOCBUF> ;[225] BUFFER LENGTH
CAILE X6,Q ;IF IMAGE LENGTH > YOCBUF LENGTH
LI X6,Q ;THEN SET LENGTH TO YOCBUF LENGTH
edit(225)
SPECCOPY ;[225] USE GENERAL COPY ROUTINE
GOTO [ ;[225] WITH THIS CHARACTER-PRODUCER
ILDB XBYTE,X3;NEXT TEXT BYTE
SOSGE X6 ;END OF LINE IF NO MORE
LI XBYTE,QLF
RET ]
L1():!
L X6,YOCPNT(XLOW)
GETBYTE
CAIN XBYTE,"@"
GOTO L5 ;ILLEGAL IF INDIRECT SPEC
IF ;SLASH
CAIE XBYTE,"/"
GOTO FALSE
THEN ;GLOBAL SWITCH!
SETON SWGSW
FIXSWITCH
IFON SWSWERR
GOTO L5 ;IF ERROR!
L X6,YOCPNT(XLOW)
FI
SETOFF SWGSW
FINDLOGICAL
JUMPL X0,L5 ;ILL LOGICAL NAME!
SF XNAME,ZFINAM(XCB)
IF ;DELIMITER IS CR
JUMPE X0,FALSE
THEN MOVSI X0,'DSK'
SF X0,ZFIDVN(XCB)
GOTO L6
FI
IF GETSPEC
GOTO TRUE
GOTO FALSE
L5():! THEN ;ERROR!!
edit(61)
IFON ZFIFND(XCB) ;[61]
GOTO IOCOME
OUTIMAGE <?Illegal file descriptor in file class argument.>
PRINTSPEC
OUTIMAGE <Please enter new file definition>
edit(225)
TTYSPEC ;[225]
GOTO L5 ;[225]
SETOFF SWSWERR
GOTO L1 ;AND TRY AGAIN
FI
PROCSPEC
GOTO L5 ;ERROR!
L6():!
LF XNAME,ZFINAM(XCB)
SKIPN X0,OFFSET(ZFIFIL)(XCB)
SF XNAME,ZFIFIL(XCB) ;SET FILE NAME TO LOGICAL NAME AS DEFAULT
;NOW SEARCH IOSPEC TO SEE IF THIS FILE IS DEFINED THERE
SETZM YIOZFS(XLOW) ;NO IOSPEC ENTRY FOR THIS FILE YET
L X1,YIOSPC(XLOW) ;ADDRESS TO FIRST ELEMENT IN IOSPEC
WHILE ;MORE ELEMENTS
JUMPL X1,FALSE
DO ;CHECK LOGICAL NAME
IF ;SAME NAME
CAME XNAME,OFFSET(ZFSNAM)(X1)
GOTO FALSE
THEN ST X1,YIOZFS(XLOW) ;SAVE ADDRESS TO IOSPEC
;ENTRY FOR LATER USE
L XRAC,XCB
ST XCB,YOBJAD+3(XLOW)
LF XCB,ZDRZBI(XCB)
COPYSPEC
L XCB,YOBJAD+3(XLOW)
SETZM YOBJAD+3(XLOW)
HRROI X1,-1
ELSE
LFE X1,ZFSLNK(X1)
SKIPL X0,OFFSET(ZFSLNK)(X1)
FI
OD
;NOW GET A CHANNEL NUMBER
GETCHANNEL
edit(201)
JUMPL X1,IOCOME ;[201]
SF X1,ZFICHN(XCB) ;AND SAVE IT
;NOW THE DEVICE FIELD IS CHECKED FOR ASTERISKS
LI XBUF,YLOW+2(XLOW)
L2():!
LI X1,OFFSET(ZFIDVN)(XCB)
CHECKAST ;DEVICE FIELD
GOTO L2
edit(61)
JUMPN IOCOME ;[61]
edit(15)
;[15] CODE TO CHECK FOR ASTERISKS IN NAME, EXT AND PPN FIELD
; REMOVED FROM HERE TO AFTER DEVICE CHECK IS COMPLETED.
;NOW PERFORM A DUMMY OPEN
;TO ESTABLISH A CHANNEL
;X3-X5 CONTAIN THE OPEN BLOCK
;X6 CONTAINS THE OPEN UUO
BEGIN
edit(225)
DEFINE OUST(X)<;;[225]
IFN <X-X1>,<PRINTX *** OUST PARAMETER ERROR ***>
IFN QDEC20,<PSOUT>
IFE QDEC20,<OUTSTR X1>>
L1():!
HLLZ X6,OFFSET(ZFICHN)(XCB)
TLO X6,(OPEN)
HRRI X6,3
edit(61)
LF X3,ZFISTI(XCB) ;[61]
LF X4,ZFIDVN(XCB)
edit(15)
SETZ X5, ;[15] ZERO BOTH IN AND OUT BUFFER HEADER ADDRESS
XCT X6
GOTO L2
;NOW THAT A CHANNEL IS ESTABLISHED, CHECK DEVICE
SF X4,ZFIDVN(XCB)
DEVCHR X4, ;DEVICE SHOULD STILL BE IN X4 NOW
IF ;DEVICE DOES NOT EXIST
JUMPN X4,FALSE
L2():! THEN ;ERROR
edit(61)
IFON ZFIFND(XCB) ;[61]
GOTO IOCOME
BREAKOUTIMAGE <?Device >
LF X0,ZFIDVN(XCB)
TYPENAME
OUTIMAGE < Illegal.>
OUTIMAGE <Please specify new device:>
edit(225)
TTYSPEC ;[225]
GOTO L2 ;[225]
GETNAME
SF XNAME,ZFIDVN(XCB)
GOTO L1
FI
SF X4,ZFIKAR(XCB)
;Now check correspondence file type vs. device type
IF ;File can do input
IFOFF ZFIIN(XCB)
GOTO FALSE
THEN IF ;DEVICE CANNOT DO INPUT
IFON ZFIDIN(XCB)
GOTO FALSE
THEN ;ERROR
HRROI X1,[ASCIZ/Cannot do input from device: /]
L7():!
edit(61)
IFON ZFIFND(XCB) ;[61]
GOTO IOCOME
CLEARO
edit(225)
OUST (X1) ;[225]
LF X0,ZFIDVN(XCB)
TYPENAME
OUTIMAGE <!>
GOTO L2
FI
ELSE
IF ;DEVICE CANNOT DO OUTPUT
IFON ZFIDOU(XCB)
GOTO FALSE
THEN ;ERROR!
HRROI X1,[ASCIZ/Cannot do output to device: /]
GOTO L7
FI
FI
ENDD
edit(10)
EXEC IONFCA ;[10] CHECK ACCESS:APPEND
IF ;DEVICE IS NOT DSK
TLNE X4,DV.DSK
GOTO FALSE
THEN ;CHECK for DIRECTFILE
IF ;Not DIRECTFILE
IFOFF ZFIDF(XCB)
GOTO FALSE
THEN
BREAKOUTIMAGE <Warning: Device not DSK for DIRECTFILE: >
LF X0,ZFINAM(XCB)
TYPENAME
OUTIMAGE <. DSK assumed.>
MOVSI X4,'DSK'
SF X4,ZFIDVN(XCB)
DEVCHR X4,
SF X4,ZFIKAR(XCB)
FI FI
IF ;DEVICE IS TTY
TLNN X4,DV.TTA
GOTO FALSE
THEN ;IF TTY ALREADY OCCUPIED BY ANOTHER FILE
IF ;CHANNEL FOR TTY ALREADY OCCUPIED
SKIPG X0,YIOCHTB(XLOW)
GOTO FALSE
THEN IF ;INFILE
IFOFF ZFIIF(XCB)
GOTO FALSE
THEN HRRZ X0,YIOCHTB(XLOW)
ELSE
HLRZ X0,YIOCHTB(XLOW)
FI
JUMPE X0,FALSE
L3():! edit(15) ;[15]
edit(61)
IFON ZFIFND(XCB) ;[61]
GOTO IOCOME
FILEERROR
IOERR 2,File already assigned to TTY
FI
;NOW ASSIGN TTY
HLLZ X0,OFFSET(ZFICHN)(XCB)
TLO X0,(RELEASE) ;RELEASE PREVIOUSLY OPENED CHANNEL
XCT X0
LF X1,ZFICHN(XCB)
ADD X1,XLOW
SETZM YIOCHTB(X1) ;RELEASE CHANNEL ENTRY
LI X0,0
SF X0,ZFICHN(XCB) ;CHANNEL 0
IF ;INFILE
IFOFF ZFIIF(XCB)
GOTO FALSE
edit(15)
THEN HRRM XCB,YIOCHTB(XLOW) ;[15] RH INPUT
L X1,YTTIB(XLOW)
SF X1,ZFIIBH(XCB)
ELSE
HRLM XCB,YIOCHTB(XLOW) ;[15] LH OUTPUT
L X1,YTTOB(XLOW)
SF X1,ZFIOBH(XCB)
FI
;[15] INITIALIZE THE BUFFER HEADER
SUBI X1,1 ;X1=ZBH START
LF X0,ZBHZBU(X1) ;CURRENT BUFFER
ADDI X0,1
HRLI X0,(POINT 7,0,0) ;700,,ZBUDAT-1
SF X0,ZBHBUP(X1)
ZF ZBHCNT(X1)
GOTO L9
FI
IF ;THIS DEVICE IS ANOTHER TERMINAL
TLNN X4,DV.TTU
GOTO FALSE
THEN ;SEE IF THIS TTY WAS USED BEFORE
TLNE X4,DV.DSK
GOTO L8 ;[15] DEVICE NUL: IF DSK AND TTU AT
; THE SAME TIME
LF X4,ZFIDVN(XCB)
LI X1,YIOCHTB(XLOW);ADDRESS TO CHANNEL TABLE
HRLI X1,-^D15 ;MAX NO OF FILES
LOOP ;AND SEARCH CHANNEL TABLE
IF ;CHANNEL OCCUPIED
SKIPN X6,(X1) ;[15] NOT SKIPG
GOTO FALSE
THEN ;INVESTIGATE FILE OBJECTS
HLRZ X7,X6
IF ;OUTPUT SIDE IS OCCUPIED
JUMPE X7,FALSE
THEN ;CHECK DEVICE NAME
LF X0,ZFIDVN(X7)
CAMN X0,X4
GOTO L7 ;FOUND IT!!
FI
HRRZ X7,X6
IF ;INPUT SIDE OCCUPIED
JUMPE X7,FALSE
THEN ;CHECK DEVICE NAME
LF X0,ZFIDVN(X7)
CAMN X0,X4
GOTO L7 ;FOUND IT!!
FI
FI
AS INCR X1,TRUE
SA
GOTO L8 ;NOT FOUND
L7():!
;DEVICE FOUND
;X1 CONTAINS ADDRESS TO CHANNEL TABLE
;X7 POINTS TO OLD FILE OBJECT or this object
CAIN X7,(XCB)
edit(114)
GOTO L8 ;[114] The new channel should be used
edit(15)
;[15] Proper RELEASE of the new channel
HLLZ X0,OFFSET(ZFICHN)(XCB)
TLO X0,(RELEASE) ;RELEASE PREVIOUSLY OPENED CHANNEL
XCT X0
LI X2,YIOCHTB(XLOW)
LF X0,ZFICHN(XCB)
ADD X2,X0
SETZM (X2) ;RELEASE NEW CHANNEL
L X2,(X1) ;[15]
LF X0,ZFICHN(X7)
SF X0,ZFICHN(XCB) ;AND TAKE OLD INSTEAD
IF ;INFILE
IFOFF ZFIIF(XCB)
GOTO FALSE
THEN ;GET OLD OUTPUT BUFFER INTO OPEN BLOCK
TRNE X2,-1 ;[15]
GOTO L3 ;[15] TTY ALREADY ASSIGNED
LF X0,ZFIOBH(X7)
SF X0,ZFIOBH(XCB)
HRRM XCB,(X1) ;UPDATE CHANNEL TABLE
ELSE ;GET OLD INPUT BUFFER INTO OPEN BLOCK
TLNE X2,-1 ;[15]
GOTO L3 ;[15] TTY ALREADY ASSIGNED
LF X0,ZFIIBH(X7)
SF X0,ZFIIBH(XCB)
HRLM XCB,(X1) ;UPDATE CHANNEL TABLE
FI
L8():!
FI
;[15] CODE TO CHECK FOR NON DIRECTORY DEVICES INCLUDED
IF ;Non-directory device
TLNE X4,DV.DIR
GOTO FALSE
THEN
edit(201)
;[201] Do not clear file name - can be useful e g for LPT:
SETZM OFFSET(ZFIEXT)(XCB)
IF
IFOFF ZFISFD(XCB)
GOTO FALSE
THEN
LF X1,ZFIARG(XCB)
SETZM OFFSET(ZYSP1)(X1)
ELSE
SETZM OFFSET(ZFIPRJ)(XCB)
FI
ELSE
edit(15)
;[15] CODE TO CHECK FOR ASTERISKS IN NAME, EXT AND PPN
; FIELDS IS PLACED HERE AND WILL BE EXECUTED ONLY FOR
; DIRECTORY DEVICES.
edit(167) ;[167]:
LF X1,ZFIDVN(XCB)
IF ;not NUL:
CAMN X1,[SIXBIT/NUL/]
GOTO FALSE
THEN ;[167] ends here
LI X1,OFFSET(ZFIFIL)(XCB)
CHECKAST ;FILE NAME FIELD
GOTO L2
edit(61)
JUMPN IOCOME ;[61]
LI X1,OFFSET(ZFIEXT)(XCB)
CHECKAST ;EXTENSION FIELD
GOTO L2
JUMPN IOCOME ;[61]
IF ;SUB FILE DIRECTORIES
IFOFF ZFISFD(XCB)
GOTO FALSE
THEN
LF X1,ZFIARG(XCB)
LI X1,OFFSET(ZYSP1)(X1)
ELSE
LI X1,OFFSET(ZFIPRJ)(XCB)
FI
CHECKAST ;PPN FIELD
GOTO L2
JUMPN IOCOME ;[61]
FI ;[167]
FI
edit(105)
BEGIN ;[105]
IFON ZFIBNW(XCB) ;[105] Buffers wanted?
GOTO L8 ;[105] No!
;NOW COMPUTE ARGUMENTS TO GETBUFF:
;X6 = BUFFER SIZE
;X7 = NO OF BUFFERS
;OPEN ARGUMENTS SHOULD STILL BE IN X3,X5
LF X4,ZFIDVN(XCB)
LI X2,3
DEVSIZ X2,
NOP ;IGNORE ERROR RETURN
IF ;"BUFFERS"
LF X6,ZFIBUF(XCB)
JUMPE X6,FALSE
THEN ;CHECK IF IT IS SIZE OR NUMBER OF BUFFERS
IF ;NO OF BUFFERS
CAILE X6,^D32
GOTO FALSE
THEN L X7,X6 ;X7:=NO OF BUFFERS
HRR X6,X2 ;X6:=DEFAULT SIZE
ELSE
IF ;NOT MAGTAPE
IFON ZFIMTA(XCB)
GOTO FALSE
THEN BREAKOUTIMAGE <WARNING: Too many buffers for file: >
LF X0,ZFINAM(XCB)
TYPENAME
OUTIMAGE < . 2 standard buffers assumed>
LI X6,QBUFS
FI
HLR X7,X2 ;X7:=DEFAULT NUMBER
FI
ELSE
;HERE IF "BUFFERS" IS NOT DEFINED OR IF THIS FILE
;IS NOT IN IOSPEC
HRRZ X6,X2 ;ELSE DEFAULT
SKIPN X7,YOCBFN(XLOW) ;USE GLOBAL NUMBER OF BUFFERS
HLRZ X7,X2 ;ELSE DEFAULT
FI
;FINALLY CHECK IF THIS FILE IS DIRECT
IF IFOFF ZFIDF(XCB)
GOTO FALSE
THEN LI X6,QBUFS ;STANDARD BUFFER SIZE FOR DSK
LI X7,1 ;USE ONE BUFFER ONLY FOR DIRECTFILE
FI
SF X7,ZFIBUF(XCB)
SF X6,ZFIBFS(XCB)
edit(105)
L8():! ;[105]
ENDD ;[105]
CREATEFILE
edit(61)
JUMPE L9 ;[61]
;[105]
IOCOME: SKIPA ;[61] Flag file not found by not setting ENDFILE!
L9():!
SETON ZIFEND(XCB) ;FLAG END-OF-FILE FOR THIS FILE
CENABLE ;ENABLE SIMDDT CALL AT ^C-REENTER
RETURN
EPROC
SUBTTL IONFCA (CHECK APPEND MODE) [10]
COMMENT;
PURPOSE: TO CHECK THE USE OF /ACCESS:APPEND
ENTRY: IONFCA
INPUT ARG: XCB POINTS TO THE FILE OBJECT
OUTPUT ARG: -
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC IONFCA
;
edit(10)
;[10] New routine
; The code was previously found in SETUPFILE (.IOCOM).
; The routine is now also called in FILELOOKUP/FILEENTER
; The switch ZFIAPP is set off if append mode was misused.
IONFCA: PROC
;NOW CHECK IF ACCESS:APPEND IS USED FOR OTHER DEVICE THAN DISK
;OR FOR OTHER FILE TYPE THAN OUTFILE OR PRINTFILE
IFOFF ZFIAPP(XCB)
RET
IF ;DEVICE NOT DISK
IFON ZFIDSK(XCB)
GOTO FALSE
THEN ;WARNING!
OUTIMAGE <Warning: Append mode ignored for non-disk devices!>
edit(61)
ELSE ;[61]
IFON ZFIOF(XCB)
RET
BREAKOUTIMAGE <Warning: Append mode ignored for >
FI
SETOFF ZFIAPP(XCB)
L XCB ;[61]
TYPESPEC ;[61]
RET
EPROC
SUBTTL LITERALS
LIT
END