Trailing-Edge
-
PDP-10 Archives
-
BB-BT99S-BB_1990
-
10,7/galaxy/glxlib/glxfil.mac
There are 40 other files named glxfil.mac in the archive. Click here to see a list.
TITLE GLXFIL -- File I/O Interface for GALAXY Programs
SUBTTL Irwin L. Goverman - Larry Samberg/MLB/DC/PW/AWC/LWS/CTK 10-May-84
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
; 1983,1984,1985,1986,1987,1990
; DIGITAL EQUIPMENT CORPORATION
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC ;SEARCH SUBSYSTEMS SYMBOLS
PROLOG(GLXFIL,FIL) ;GENERATE PROLOG CODE
FILEDT==122 ;EDIT LEVEL
;THE PURPOSE OF THIS MODULE IS TO PROVIDE AN OPERATING SYSTEM INDEPENDENT
; INPUT FILE INTERFACE TO GALAXY PROGRAMS (OR ANY OTHER PROGRAM WHICH
; WANTS TO USE IT).
SUBTTL Table Of Contents
; TABLE OF CONTENTS FOR GLXFIL
;
;
; SECTION PAGE
; 1. Table Of Contents......................................... 2
; 2. Revision History.......................................... 3
; 3. Global Routines........................................... 4
; 4. Local AC definitions...................................... 5
; 5. Module Storage............................................ 5
; 6. FB - File Block Definitions........................... 6
; 7. F%INIT - Initialize the world............................. 8
; 8. F%IOPN - Open an input file............................... 9
; 9. F%OOPN - Open an output file.............................. 10
; 10. F%AOPN - Open an output file in append mode............... 11
; 11. OPNCOM - Common file open routine......................... 13
; 12. LDLEB - Load a LOOKUP/ENTER block from an FD............. 16
; 13. SETFD - Set up a real description of opened file......... 17
; 14. SETFOB - Build an internal FOB............................ 18
; 15. OPNERR - Handle a system error from F%IOPN................ 19
; 16. F%IBYT - Read one byte from file........................ 20
; 17. F%IBUF - Read a buffer of data from file................ 21
; 18. GETBUF - Read one input buffer from the operating system 22
; 19. POSBUF - Setup new input buffer for the user............ 23
; 20. F%POS - Position an input file.......................... 24
; 21. F%REW - Rewind an input file............................ 24
; 22. F%OBYT - Write one byte into file....................... 26
; 23. F%OBUF - Write a buffer full of data to a file.......... 27
; 24. PUTBUF - Give one output buffer to the operating system. 29
; 25. F%CHKP - Checkpoint a file.............................. 30
; 26. WRTBUF - TOPS20 Subroutine to SOUT the current buffer... 32
; 27. SETBFD -- Setup Buffer Data............................. 32
; 28. F%REN - Rename a file.................................... 33
; 29. F%REL - Release a file................................... 36
; 30. F%DREL - Delete a file and release it..................... 37
; 31. F%DEL - Delete an unopened file.......................... 38
; 32. F%INFO - Return system information about a file........... 39
; 33. F%FD - Return a pointer to the FD on an opened IFN...... 40
; 34. F%FCHN - Find first free channel.......................... 40
; 35. ALCIFN - Allocate an Internal File Number................. 41
; 36. RELFB - Release a File Block............................. 41
; 37. MAPERR - Map an operating system error.................... 42
; 38. CHKIFN - Check user calls and set IFN context............. 44
SUBTTL Revision History
COMMENT \
Edit GCO Explanation
---- ------- -------------------------------------------------
0001 Create GLXFIL module
0002 Make positioning code much smarter
0003 Add FI.SIZ to the F%INFO routine to get file size
0004 Optimize the Line Sequence Number checking code
0005 Add the F%FCHN routine find first free channel
0006 G005 On -10 reset the byte count after file-update
(F%CHKP) else blocks of output get lost.
0007 G003 On -10 if an FD is given to one of the open routines
with null device field, default it to 'DSK'.
0010 G018 Add F%INFO function 'FI.CHN' which returns I/O channel
number on the -10 and JFN on the -20.
0011 G028 Make F%CHKP smarter so that checkpoints will only be
done if there was any file activity
0012 G030 Fix DMPBUF, F%REL and F%CHKP to not dump out buffer
if going to checkpoint or close since on the -10 the
monitor will dump the buffer
0013 G047 Fix DMPBUF to clear the buffer after each output on the
-20 in DMPB.1
0014 G048 Make F%DREL and F%DEL Expunge file on -20
Allow Output to NUL: on the -20.
0015 G050 Make F%CHKP on the -20 Update Byte size of File and Count
0016 Fix OPNCOM to do range check on FD length word
and return ERIFS$ if not valid
0017 Rewrite F%OBUF so that it always uses ILDB/IDPB logic.
Move the code for QUOTA EXCEEDED to DMPBUF.
0021 Remove PJUMPx macros
0022 Superseded by edit 24
0023 Change SAVE macro to $SAVE.
0024 Significant re-work and cleanup of GLXFIL.
0025 Make IFNs start at 1 rather than 0
0026 Fix a bug in the F%POS routine which caused 'holey'
files.
0027 Fix a number of bugs and make line-sequence numbered file
processing faster.
0030
0031 Make checkpoint code work on the -10.
On -20 clear residue of output buffer.
0032 -10, Don't try to release channel if FILOP. to OPEN
fails. Assume that OPEN failing doesn't assign a chan.
0033 -10, During positioning which requires moving to a new buffer,
after USETIng to EOF, clear EOF so the INs to flush buffers win
xxxx Get rid of FB$POS, and FB$IBD. Clean up checkpoint
state of the world
0034 Fix bug in OPNERR on -10. Call RELFB to give
back the IFNTAB slot if the FILOP. OPEN fails
0035 -10, in LDLEB, if PPN is zero, don't make a path block
even if the FB contains an (assumedly blank) one
0036 CHANGED F%REN SO THAT IF THE SECOND IFN GET FAILS
THE FIRST ONE IS RELEASED.
0037 Fix the writing of nulls to not write any if on a full
word boundary at the end.
0040 Fix F%REW & F%POS so that we dont loop forever positioning
null files.
Add FDE error from F%REW & F%POS.
0041 Fix CHKIFN so that it correctly checks IFNTAB for the
IFN which is passed.(Fixes Illegal IFN Stopcode for valid IFN's)
0042 Change F%DREL so that it lites the Priv bit in the FILOP.
Also make it exit through INTREL on an error.
0043 Fix F%CHKP to return 0 if no inputs have been done
against IFN when F%CHKP is called.
0044 Fix F%REN to release its IFN if things look bad
0045 Fix F%DEL to do F%OOPN instead of IOPN
0046 Fix F%DEL to do F%AOPN instead of F%OOPN
Change F%DREL (TOPS20) to check for write access instead
of directory access.
0047 Fix INTREL code for -20 to do a RLJFN if the CLOSF fails on
a file that we have a JFN but have not opened
Also add GETERR routine to get the last error on -20 before
trying to MAP it
0050 Change SETFD to correctly remember the actual path found
in lookup enter block to cure problems caused when F%DRREL
was called for a file that lived in an SFD
0051 Change OPNC.2 (TOPS10) so that if the FILOP. fails, we save the
extended channel number away before going off to OPNERR.
Change OPNERR to delete the TOPS10/TOPS20 conditionals and
always call INTREL to release either the channel or JFN.
Change INTREL (TOPS10) so that if an error occurs, we release
the file data base (Call RELFB)
0052 Removed phantom reference to T4 in F%REN and changed
RELFB to watch for -1 in FB$CHN which indicates the
file was never opened.
0053 Moved REN.2 label up 2 instructions so that if the rename fails,
the channel is closed (if it was open'd)
0054 SPR 20-14563 F%POS loops if positioning to last byte of last
page of a file. If doing so, return EOF.
0055 Zero out entire $DATA space instead of only IFN table.
0056 Allow output to spooled devices, they're really disks.
0057 Repair edit 54 to allow rewinds for short files again.
0060 If the CHKAC fails on TOPS20, return 'protection failure'
instead of stopcoding.
0061 Fix F%REL to check FB$CHN(FB). Right now we are only checking
FB$CHN.
0062 Delete CSF stopcode in WRTBUF and just .RETF (SPR 20-14724)
0063 Expand file and I/O error codes and messages for TOPS-10.
0064 Fix stevens QAR. Add DEVSIZ to get disk buffer length.
0065 Change F%INFO to return the correct creation time by adding
routine FTINFO
0066 3/7/81 End TOPS-10 conditional at the end of routine FTINFO
0067 Fix for SPR 20-14773 & 20-14728 F%AOPN & WRTBUF
0070 3/30/81 Fix QAR-05695; F%CHKP lost data
0071 4/3/81 Add part of missing HOSS edit (SPR #20-14262) to allow
in-your-behalf renames and deletes work correctly.
0072 Map a couple more LOOKUP/ENTER/RENAME error codes.
0073 Add support for FB.PHY to allow physical-only OPENs.
0074 5/4/81 Add FRB.FL flag word to F%REN arg block
0075 Add a field in the FOBs for protection codes. Add support
for physical-only on RENAMEs.
0076 Add a file attribute block. Remove protection crock created
by edit 75 since protections will be handled in the attribute
block.
0077 Use .FOMAX instead of .FOPPN+1. Increase the size of the
L/E/R block to .RBMAX words to accomodate account strings.
Don't use .PTMAX+1 as the length of path block. .PTMAX
insures a zero word at the end of the block.
0100 Lots of little things. Under TOPS-10 conditionals, add a
missing POPJ P,. Under TOPS-20 conditionals, clean up access
checking/connected directory stuff and CHGFDB code. Don't
checkpoint a file at INTREL, we might not have a valid IFN
JFN.
0101 Remove file attribute block definitions. They exist in GLXMAC.
0102 1427 Remove bogus defs of SZ.BUF and SZ.OBF
;**;Begin Galaxy 4.1 code maintenance
0103 Fix illegal memory reference problem when using
F%xOPN routines.
SPR 10-33434,10-34187 25-SEP-83/CTK
104 Make F%IBYT handle page marks in LSN file correctly.
7-Nov-83 /LWS
105 In OPNCOM the FILOP. uuo returns a 0 in the path
block when the structure is NUL. This caused the SETFD
routine to create FD blocks with 0 as the structure
name. The final result was BATCON passing QUASAR
bad information, leading to QUASAR CRL then RRF
stopcodes.
1-Mar-84/CTK SPR 10-34431
106 The F%REN routine always resets the file IO
mode to zero/ASCII mode. This causes problems
for /DISP:RENAME on plotter files because the
file IO mode is used by SPROUT to control
the plotter.
15-Mar-84/CTK SPR 10-34531
107 Add code and revamp the F%REN routine so we
do the FILOP RENAME correctly. Edit 106
introduced a DATE-75 bug.
17-Apr-84 SPR 10-34531
110 Fix problem with F%REN found by the VEREDT tool.
We could not rename from an SFD to an SFD and
release channels after use.
10-May-84/CTK SPR 10-34690
111 Pick up the pieces from edit 110, the channel
release code was dropped on the floor.
19-Oct-84/CTK GCO 10199
112 10144 Add support for setting the new RDH fields in the
exteneded LOOKUP/ENTER block.
5-Feb-85/DPM
113 10201 Finish GCO 10144. Return RDH fields via F%INFO.
26-Apr-85 /NT
114 ? Fix GCOs 10144 & 10201. Do the right things with arg blocks.
29-Aug-85 /RCB
116 10462 Change $STOP to STOPCD.
14-Nov-86 /BAH
117 10494 Fix F%DREL so that it will use a real RENAME block instead
of a single (maybe) zeroed AC when deleting files.
17-Feb-87 /JJF
120 10651 Relax restriction where device must be spooled or a disk.
TTYs and MTAs are most common devices (others haven't
been tested). If device is a TTY and byte-size is 7 or 8,
I/O mode is .IOASC or .IOAS8 respectively, not .IOIMG.
121 10674 Add missing file attributes, and the ability to set them
from the IFN of another file.
122 10677 Fix SETFD to always return the correct FD length. Use
FILOP. UUO returned filespec block to return accurate
filespec parts.
\ ; END OF REVISION HISTORY
SUBTTL Global Routines
ENTRY F%INIT ;INITIALIZE THE MODULE
ENTRY F%IOPN ;OPEN A FILE FOR INPUT
ENTRY F%AOPN ;OPEN A FILE FOR APPENDED OUTPUT
ENTRY F%OOPN ;OPEN A FILE FOR OUTPUT
ENTRY F%IBYT ;READ AN INPUT BYTE
ENTRY F%OBYT ;WRITE AN OUTPUT BYTE
ENTRY F%IBUF ;READ AN INPUT BUFFER
ENTRY F%OBUF ;WRITE AN OUTPUT BUFFER
ENTRY F%REL ;RELEASE A FILE
ENTRY F%DREL ;DELETE AND RELEASE A FILE
ENTRY F%RREL ;RESET (ABORT) I/O AND RELEASE A FILE
ENTRY F%REW ;REWIND A FILE
ENTRY F%POS ;POSITION A FILE
ENTRY F%CHKP ;CHECKPOINT A FILE, RETURN POSITION
ENTRY F%INFO ;RETURN SYSTEM INFORMATION ON FILE
ENTRY F%FD ;RETURN POINTER TO AN IFN'S FD
ENTRY F%REN ;RENAME AN FILE
ENTRY F%DEL ;DELETE A FILE
ENTRY F%FCHN ;FIND FIRST FREE CHANNEL
; ENTRY F%NXT ;(FUTURE) GET NEXT FILE IN SPECIFICATION
SUBTTL Local AC definitions
FB==15 ;ALWAYS ADDRESS OF CURRENT FILE BLOCK
SUBTTL Module Storage
$DATA FILBEG,0 ;START OF ZEROABLE $DATA FOR GLXFIL
$DATA IFNTAB,SZ.IFN+1 ;ADDRESS OF FILE DATA PAGE FOR
; EACH IFN
; DATA BLOCK FOR COMMON FILE OPEN ROUTINE
$DATA O$MODE ;MODE FILE IS TO BE OPENED IN
$DATA O$FUNC ;FILOP. OR OPENF BITS TO USE
$DATA O$PROT ;PROTECTION FOR IN BEHALF
$DATA O$GJFN ;GTJFN BITS TO USE
$DATA DMPFLG ;FLAG TO DUMP THE BUFFER
$DATA F$FOB,FOB.SZ ;FOR FOR INTERNAL USE
$DATA FILEND,0 ;END OF ZEROABLE $DATA FOR GLXFIL
SUBTTL FB - File Block Definitions
FB%%%==0 ;INITIAL OFFSET
DEFINE FB(A1,A2),<
FB$'A1==FB%%%
FB%%%==FB%%%+A2
IFG <FB%%%-1000>,<PRINTX FB TOO LARGE>
> ;END DEFINE FB
;The following entries in the FB are invariant for a given file opening.
FB BEG,0 ;BEGINNING OF PAGE
FB IFN,1 ;THE IFN
FB BYT,1 ;BYTE SIZE
FB WRD,1 ;NUMBER OF WORDS IN FILE
FB BPW,1 ;NO. OF BYTES/WORD
FB MOD,1 ;OPEN MODE
FBM$IN==1 ; INPUT
FBM$OU==2 ; OUTPUT
FBM$AP==3 ; APPEND
FBM$UP==4 ; UPDATE
FB CNT,1 ;ATTRIBUTE ARGUMENT COUNT
FB PTR,1 ;ATTRIBUTE ARGUMENT POINTER
FB IMM,1 ;ATTRIBUTE ARGUMENT FLAG
FB IFF,1 ;ATTRIBUTE FROM IFN ARGUMENT FLAG
FB ATT,1 ;ATTRIBUTE TYPE
FB BUF,1 ;ADDRESS OF BUFFER PAGE
FB FD,FDXSIZ ;FD GIVEN ON OPEN CALL,MAY BE WILDCARDED
FB RFD,FDXSIZ ;ACTUAL DESCRIPTION OF CURRENT FILE ON THIS IFN
TOPS10<
FB FUB,.FOMAX ;FILOP. UUO BLOCK
FB LEB,.RBMAX ;LOOKUP/ENTER UUO BLOCK
FB PTH,.PTMAX ;PATH BLOCK
FB FIL,.FOFMX ;RETURNED FILESPEC BLOCK
FB CHN,1 ;CHANNEL NUMBER FOR THIS FILE
> ;END TOPS10 CONDITIONAL
TOPS20<
FB FDB,.FBLEN ;BLOCK FOR THE FDB
FB CHK,.CKAUD+1 ;BLOCK FOR CHKAC JSYS
FB JFN,1 ;THE JFN
FB ACT,10 ;USED FOR ACCOUNT STRING STORAGE
> ;END TOPS20 CONDITIONAL
;The following variables define the current buffer state
FB BIB,1 ;Bytes In Buffer
; ON INPUT, THIS IS THE NUMBER OF DATA
; BYTES REMAINING IN THE CURRENT BUFFER.
; ON OUTPUT, THIS IS THE NUMBER OF BYTES
; WHICH MAY BE DEPOSITED INTO THE BUFFER
; BEFORE IT MUST BE DUMPED.
FB BBP,1 ;Buffer Byte Pointer
; ON INPUT, THIS POINTS TO THE LAST
; BYTE READ FROM THE BUFFER AND ON
; OUTPUT IT POINTS TO THE LAST BYTE
; DEPOSITED. IT IS NORMALLY INCREMENTED
; BEFORE USING.
FB BFN,1 ;BuFfer Number
; THIS IS THE NUMBER (RELATIVE TO THE
; DISK FILE) OF THE CURRENT BUFFER (I.E.
; THE ONE DEFINED BY FB$BRH)
FB EOF,1 ;SET IF EOF SEEN ON INPUT
FB LSN,1 ;Line Sequence Numbers
; CONTAINS 0 IF LSN PROCESSING WAS NOT
; REQUESTED. IF LSN PROCESSING WAS
; REQUESTED, THIS IS SET TO 1 DURING
; FILE-OPEN ROUTINE. FIRST INPUT WILL
; SET TO -1 OR 0 DEPENDING ON WHETHER
; OR NOT FILE HAS LSNS.
FB FNC,1 ;File Needs Checkpointing
; THE IS AN OUTPUT ONLY FLAG WHICH IS
; -1 IF ANY OUTPUT HAS BEEN DONE SINCE
; THE LAST CHECKPOINT. IF 0 WHEN F%CHKP
; IS CALLED, NOTHING IS UPDATED TO DISK.
; THIS ALLOWS A PROGRAM TO CHECKPOINT AN
; OUTPUT FILE ON A TIME BASIS (E.G.) AND
; NOT INCUR THE EXPENSE OF I/O IF NO
; OUTPUT CALLS HAVE BEEN MADE SINCE LAST
; CHECKPOINT.
FB BRH,3 ;BUFFER RING HEADER
TOPS20<
; .BFADR==0 ;BUFFER ADDRESS
.BFPTR==1 ;BUFFER BYTE POINTER
.BFCNT==2 ;BUFFER BYTE COUNT
; DUE TO AN OUTPUT CHECKPOINT
> ;END TOPS20
FB TYP,1 ;DEVICE TYPE
FB FLG,1 ;FLAG WORD
FB.BNW==1B35 ;MODE USES BYTES THAT ARE NOT WORD SIZE
FB$END==FB%%% ;END OF FILE BLOCK
SUBTTL F%INIT - Initialize the world
;F%INIT IS CALLED TO INITIALIZE THE GLXFIL MODULE. IT MUST
; BE CALLED BEFORE ANY OTHER ROUTINE IN GLXFIL IS CALLED.
; CALL IS: NO ARGUMENTS
;
; RETURN: ALWAYS TRUE
F%INIT: MOVE S1,[FILBEG,,FILBEG+1] ;BLT PTR TO ZEROABLE $DATA SPACE
SETZM FILBEG ;DO THE FIRST LOCATION
BLT S1,FILEND-1 ;AND BLT THE REST TO ZERO
$RETT ;RETURN.
SUBTTL F%IOPN - Open an input file
;CALL: S1/ LENGTH OF FILE OPEN BLOCK (FOB)
; S2/ ADDRESS OF FOB (DESCRIBED IN GLXMAC)
; FOB.FD (WORD 0) : ADDRESS OF FD
; FOB.CW (WORD 1) : CONTROL INFORMATION
; FOB.US (WORD 2) : USER ID FOR IN BEHALF
; FOB.CD (WORD 3) : CONNECTED DIRECTORY (TOPS-20)
;
;TRUE RETURN: S1/ CONTAINS INTERNAL FILE NUMBER (IFN)
;
;FALSE RETURN: S1/ CONTAINS ERROR CODE
;POSSIBLE ERRORS:
; ERSLE$ ERIFS$ ERFNF$ ERPRT$ ERDNA$ ERUSE$
F%IOPN: PUSH P,S1 ;SAVE FOB SIZE
MOVX S1,FBM$IN ;FILE WILL BE READ
MOVEM S1,O$MODE ;SO SET THAT UP NOW
TOPS10<
MOVX S1,<FO.PRV+.FORED> ;READ FUNCTION TO FILOP.
MOVEM S1,O$FUNC ;STORE AS FUNCTION
> ;END OF TOPS10 CONDITIONAL
TOPS20<
MOVX S1,<44B5+OF%RD> ;36 BIT READ FUNCTION
MOVEM S1,O$FUNC ;IS FUNCTION FOR OPENF
MOVX S1,GJ%SHT+GJ%OLD ;AND SHORT GTJFN, OLD FILE
MOVEM S1,O$GJFN ;IS FUNCTION FOR GTJFN
MOVX S1,.CKARD ;WANT TO KNOW IF WE CAN READ FILE
MOVEM S1,O$PROT ;IF CHKAC IS DONE
> ;END OF TOPS20 CONDITIONAL
POP P,S1 ;RESTORE LENGTH OF FOB
PJRST OPNCOM ;PERFORM THE OPEN
SUBTTL F%OOPN - Open an output file
;CALL: S1/ LENGTH OF FILE OPEN BLOCK (FOB)
; S2/ ADDRESS OF FOB (DESCRIBED IN GLXMAC)
; FOB.FD (WORD 0) : ADDRESS OF FD
; FOB.CW (WORD 1) : CONTROL WORD
; FOB.US (WORD 2) : USER ID FOR IN BEHALF
; FOB.CD (WORD 3) : CONNECTED DIRECTORY (TOPS-20)
;
;TRUE RETURN: S1/ CONTAINS INTERNAL FILE NUMBER (IFN)
;
;FALSE RETURN: S1/ CONTAINS ERROR CODE
;POSSIBLE ERRORS:
; ERSLE$ ERIFS$ ERPRT$ ERDNA$ ERUSE$
F%OOPN: PUSH P,S1 ;SAVE LENGTH OF THE FOB
MOVX S1,FBM$OU ;THE FILE IS BEING WRITTEN
MOVEM S1,O$MODE ;
TOPS10<
LOAD S1,FOB.CW(S2),FB.NFO ;GET NEW FILE ONLY FLAG
SKIPE S1 ;IF ITS SET,
SKIPA S1,[EXP FO.PRV+.FOCRE] ;SET FOR FILE CREATION
MOVX S1,<FO.PRV+.FOWRT> ;ELSE, GET PRIVELEGED WRITE FUNCTION
MOVEM S1,O$FUNC ;STORE AS OPEN FUNCTION CODE
> ;END OF TOPS10 CONDITIONAL
TOPS20<
MOVX S1,<^D36B5+OF%WR> ;36 BIT WRITE IS THE FUNCTION
MOVEM S1,O$FUNC ;FOR THE OPENF
LOAD S1,FOB.CW(S2),FB.NFO ;GET THE NEW FILE ONLY BIT
SKIPE S1 ;IF ITS SET
SKIPA S1,[EXP GJ%SHT+GJ%NEW] ;FORCE A NEW FILE
MOVX S1,GJ%SHT+GJ%FOU ;OTHERWISE, JUST NEW GENERATION , SHORT GTJFN
MOVEM S1,O$GJFN ;IS GTJFN FUNCTION
MOVX S1,.CKACN ;THE PROTECTION TO CHECK FOR
MOVEM S1,O$PROT ;CONNECT TO DIRECTORY ACCESS
> ; END OF TOPS20 CONDITIONAL
POP P,S1 ;RESTORE LENGTH OF FOB
PJRST OPNCOM ;DO COMMON OPENING
SUBTTL F%AOPN - Open an output file in append mode
; OPEN FILE FOR OUTPUT, APPENDING IF FILE ALREADY EXISTS
;CALL: S1/ LENGTH OF FILE OPEN BLOCK (FOB)
; S2/ ADDRESS OF FOB (SEE DESCRIPTION IN GLXMAC)
;
;TRUE RETURN: S1/ CONTAINS INTERNAL FILE NUMBER (IFN)
;
;FALSE RETURN: S1/ CONTAINS ERROR CODE
; POSSIBLE ERRORS: ERSLE$ ERIFS$ ERPRT$ ERDNA$ ERUSE$
F%AOPN: PUSHJ P,.SAVE1 ;SAVE A PERM AC
MOVE P1,0(S2) ;GET THE FD ADDRESS.
MOVE P1,.FDFIL(P1) ;GET THE STRUCTURE NAME.
TOPS10<
CAMN P1,[SIXBIT/NUL/] ;IS IT NULL ???
> ;END OF TOPS10 CONDITIONAL
TOPS20<
AND P1,[-1,,777400] ;GET JUST THE BITS WE WANT.
CAMN P1,[ASCIZ/NUL:/] ;IS IT NULL ???
> ;END OF TOPS20 CONDITIONAL
PJRST F%OOPN ;YES,,OPEN IT AS OUTPUT.
MOVX P1,FBM$AP ;FILE IS WRITTEN, APPEND MODE
MOVEM P1,O$MODE ;
TOPS10<
MOVX P1,<FO.PRV+.FOAPP> ;GET PRIVELEGED APPEND FUNCTION
MOVEM P1,O$FUNC ;STORE AS OPEN FUNCTION CODE
> ;END OF TOPS10 CONDITIONAL
TOPS20<
MOVX P1,<^D36B5+OF%WR+OF%RD> ;36 BIT UPDATE MODE IS THE FUNCTION
; USE UPDATE INSTEAD OF APPEND SO THAT
; WE CAN MAP FULL PAGES
MOVEM P1,O$FUNC ;FOR THE OPENF
MOVX P1,GJ%SHT ;USE SHORT GTJFN, AND OLD FILE (IF ANY)
MOVEM P1,O$GJFN ;SET GTJFN FUNCTION
MOVX P1,.CKACN ;THE PROTECTION TO CHECK FOR
MOVEM P1,O$PROT ;CONNECT TO DIRECTORY ACCESS
> ; END OF TOPS20 CONDITIONAL
;F%AOPN IS CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
PUSHJ P,OPNCOM ;OPEN UP THE FILE
JUMPF .RETF ;PASS ON FAILURE IF IT OCCURRED
$SAVE FB ;SAVE FB
MOVE FB,IFNTAB(S1) ;SET FB ADDRESS
SKIPN FB$WRD(FB) ;DOES THIS FILE EXIST?
$RETT ;NO, NO NEED FOR ANYTHING SPECIAL
TOPS10<
PUSHJ P,SETBFD ;SETUP BBP, BIB
MOVE S1,FB$WRD(FB) ;GET THE FILE SIZE
IDIVI S1,SZ.BUF ;DIVIDE BY BUFFER SIZE
MOVEM S1,FB$BFN(FB) ;SAVE BUFFER NUMBER
MOVE S1,FB$IFN(FB) ;GET IFN TO RETURN
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20<
MOVEI S1,FBM$IN ;GET INPUT FUNCTION
MOVEM S1,FB$MOD(FB) ;AND STORE FOR A SHORT TIME
MOVE S1,FB$IFN(FB) ;PUT IFN IN S1
MOVE S2,FB$WRD(FB) ;GET NUMBER OF WORDS IN FILE
IMUL S2,FB$BPW(FB) ;GET NUMBER OF LAST BYTE
SUBI S2,1 ;AND BACK UP BY ONE
$CALL F%POS ;POSITION TO BEFORE LAST BYTE IN FILE
JUMPF [STOPCD (CPE,HALT,,<Can't position to EOF>)]
MOVE S1,FB$IFN(FB) ;GET THE IFN
$CALL F%IBYT ;GET THE LAST BYTE
JUMPF [STOPCD (CRL,HALT,,<Can't read last byte of file>)]
MOVEI S1,FBM$AP ;GET APPEND MODE BACK
MOVEM S1,FB$MOD(FB) ;STORE IT
MOVE S1,FB$WRD(FB) ;GET NUMBER OF WORDS IN FILE
IDIVI S1,SZ.BUF ;DIVIDE BY WORDS/BUFFER
SKIPN S2 ;[67] IS BUFFER ACTUALLY FULL ???
MOVX S2,SZ.BUF ;[67] YES,,INDICATE SO
MOVNS S2 ;-VE WORDS IN LAST BUFFER
ADDI S2,SZ.BUF ;WORDS REMAINING IN LAST BUFFER
IMUL S2,FB$BPW(FB) ;BYTES REMAINING IN LAST BUFFER
MOVEM S2,FB$BIB(FB) ;STORE IT
MOVE S1,FB$IFN(FB) ;PUT THE IFN IN S1
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL OPNCOM - Common file open routine
OPNCOM: $SAVE <FB> ;PRESERVE REGS
$CALL .SAVET ;SAVE T REGS TOO
MOVE T1,S2 ;SAVE ADDRESS OF FOB
MOVE T4,S1 ;AND ITS LENGTH
CAIGE T4,FOB.MZ ;CHECK FOR MINIMUM SIZE
STOPCD (OTS,HALT,,<File Open Block is too small>)
LOAD T2,FOB.FD(T1) ;GET THE FD ADDRESS
LOAD T3,FOB.CW(T1),FB.BSZ ;GET THE BYTE SIZE
CAIL T3,1 ;CHECK BYTE RANGE
CAILE T3,^D36 ; FROM 1 TO 36
STOPCD (IBS,HALT,,<Illegal byte size given>)
LOAD S1,(T2),FD.LEN ;GET FD LENGTH
CAIL S1,FDMSIZ ;CHECK RANGE
CAILE S1,FDXSIZ
$RETE (IFS) ;INVALID FILE SPEC
PUSHJ P,ALCIFN ;GET AN IFN
JUMPF .RETF ;PASS ON ANY ERROR
MOVEM T3,FB$BYT(FB) ;AND SAVE THE BYTE SIZE
LOAD S1,FOB.CW(T1),FB.LSN ;SEE IF USER WANTS TO SUPRESS LSNS
JUMPE S1,OPNC.0 ;IF NOT, SKIP TESTS
AOS FB$LSN(FB) ;MARK THAT LSN PROCESSING REQUESTED
CAIE T3,7 ;MUST BE A SEVEN BIT FILE
PUSHJ P,S..IBS ;IF NOT SEVEN-BIT, ITS WRONG
OPNC.0: CAILE T4,FOB.AB ;FOB CONTAIN ATTRIBUTE BLOCK WORD?
SKIPN S1,FOB.AB(T1) ;YES - GET ATTRIBUTE BLOCK ADDRESS
JRST OPNC.X ;THERE ISN'T ONE
MOVEM S1,FB$PTR(FB) ;STORE IT
HRRZ S1,(S1) ;GET WORD COUNT
MOVEM S1,FB$CNT(FB) ;STORE IT
OPNC.X: MOVEI S1,^D36 ;GET BITS/WORD
IDIV S1,FB$BYT(FB) ;DIVIDE BY BITS/BYTE
MOVEM S1,FB$BPW(FB) ;STORE BYTES/WORD
MOVE S1,O$MODE ;GET REQUESTED ACCESS MODE
MOVEM S1,FB$MOD(FB) ;STORE INTO MODE WORD
MOVEI S2,FB$FD(FB) ;GET LOCATION TO MOVE FD TO
LOAD S1,.FDLEN(T2),FD.LEN ;GET FD'S LENGTH
ADD S1,S2 ;LAST LOCATION FOR BLT
HRLI S2,0(T2) ;STARTING LOCATION OF FD
BLT S2,-1(S1) ;STORE TILL LAST WORD
SETOM FB$BFN(FB) ;SET CURRENT BUFFER TO -1
SETZM FB$BIB(FB) ;NO BYTES IN BUFFER
SETZM FB$EOF(FB) ;CLEAR EOF FLAG
SETZM FB$FNC(FB) ;FILE DOESN'T NEED CHECKPOINTING
;FALL THRU TO OPERATING SYSTEM
; DEPENDENT CODE
TOPS10< SKIPN S2,.FDSTR(T2) ;GET THE STRUCTURE
MOVSI S2,'DSK' ;USE 'DSK' AS DEFAULT
MOVEM S2,FB$FUB+.FODEV(FB) ;STORE IN FILE BLOCK
DEVTYP S2, ;SEE IF ITS A DISK TYPE DEVICE
MOVX S2,.TYDSK ;IF IT FAILS, DONT KICK OUT YET
LOAD S1,S2,TY.DEV ;GET DEVICE TYPE ONLY
TXNE S2,TY.SPL ;SPOOLED DEVICE?
MOVX S1,.TYDSK ;YES, TREAT AS DISK
MOVEM S1,FB$TYP(FB) ;SAVE DEVICE TYPE
CAXE S1,.TYTTY ;TTY?
JRST OPNC.Y ;NOT A TTY
CAIL T3,^D7 ;TTY
CAILE T3,^D8 ;7 OR 8 BIT BYTES?
JRST OPNC.Y ;NO
SETO S1, ;SET "BYTE NOT WORD" BIT
STORE S1,FB$FLG(FB),FB.BNW
SUBI T3,7 ;YES, GET MODE
SKIPA S2,[EXP .IOASC ;ASCII
EXP .IOAS8](T3) ;8-BIT ASCII
OPNC.Y: MOVEI S2,.IOIMG ;LOAD IMAGE MODE
MOVX S1,FB.PHY ;GET /PHYSICAL BIT
TDNE S1,FOB.CW(T1) ;IS IT SET?
TXO S2,UU.PHS ;YES
MOVEM S2,FB$FUB+.FOIOS(FB) ;STORE IN FILE BLOCK
MOVEI S2,FB$PTH(FB) ;LOCATION TO START PATH BLOCK AT
HRLI S2,.PTMAX ;SET SIZE UP TOO
MOVEM S2,FB$FUB+.FOPAT(FB) ;STORE IT AWAY
MOVEI S2,FB$BRH(FB) ;GET ADR OF BUFFER RING HDR
MOVEM S2,FB$FUB+.FOBRH(FB) ;AND STORE IT
MOVE TF,FB$FUB+.FOIOS(FB) ;GET THE DATA MODE IN TF
MOVE S1,FB$FUB+.FODEV(FB) ;GET THE SIXBIT DEVICE IN S1
MOVEI S2,TF ;POINT TO THE ARG BLK
DEVSIZ S2, ;GET THE DEVICE BUFFER SIZE
MOVEI S2,203 ;FAILED,,USE WHAT WE KNOW IS RIGHT
HRRZS S2 ;GET ONLY BUFFER LENGTH
MOVX S1,PAGSIZ ;GET THE TOTAL BUFFER LENGTH
IDIV S1,S2 ;CALC NUMBER OF BUFFERS THAT WILL FIT
MOVEM S1,FB$FUB+.FONBF(FB) ;STORE AS # OF BUFFERS
MOVE S2,FB$MOD(FB) ;GET THE MODE WORD
CAIE S2,FBM$OU ;IS IT OUTPUT
CAIN S2,FBM$AP ; OR APPEND?
SKIPA ;YES IT IS
JRST OPNC.1 ;NO, SKIP THIS CODE
MOVSS FB$FUB+.FOBRH(FB) ;REVERSE BUFFER HEADER WORD
MOVSS FB$FUB+.FONBF(FB) ; AND BUFFER NUMBER WORD
OPNC.1: MOVEI S2,FB$LEB(FB) ;GET ADDRESS OF LOOKUP/ENTER BLOCK
MOVEM S2,FB$FUB+.FOLEB(FB) ;STORE IT
MOVE S1,T2 ;GET ADDRESS OF FD BLOCK
PUSHJ P,LDLEB ;LOAD THE LOOKUP ENTER BLOCK
PUSHJ P,ATTRIB ;SET FILE ATTRIBUTES
MOVE S2,O$FUNC ;GET FILOP. FUNCTION WORD
TXO S2,FO.ASC ;ASSIGN CHANNEL NUMBER
MOVEM S2,FB$FUB+.FOFNC(FB) ;STORE IN FUNCTION WORD
CAIG T4,FOB.US ;IS THIS "ON BEHALF"?
JRST OPNC.2 ;NO
LOAD S1,FOB.US(T1) ;GET PPN OF USER
MOVEM S1,FB$FUB+.FOPPN(FB) ;AND STORE IT
OPNC.2: MOVEI S1,FB$FIL(FB) ;POINT TO RETURNED FILESPEC BLOCK
HRLI S1,.FOFMX ;GET ITS LENGTH
MOVEM S1,FB$FUB+.FOFSP(FB) ;SAVE FOR MONITOR
;**;[105]ADD 2 LINES AT OPNC.2:+0L 1-MAR-84/CTK
MOVE S1,FB$FUB+.FODEV(FB) ;[105]GET DEVICE, SETUP FILOP. 0 RETURN
MOVEM S1,FB$PTH+.PTFCN(FB) ;[105]STORE STRUCTURE NAME
MOVE T1,FB$BUF(FB) ;GET ADDRESS OF BUFFER
EXCH T1,.JBFF## ;TELL MONITOR TO BUILD BUFFERS THERE
MOVSI S1,.FOMAX ;GET LEN,,0
HRRI S1,FB$FUB(FB) ;GET LEN,,ADDRESS
FILOP. S1, ;DO THE FILOP.
MOVNS T1 ;FLAG THAT FILOP FAILED
MOVMM T1,.JBFF## ;RESTORE FIRST FREE
LOAD TF,FB$FUB+.FOFNC(FB),FO.CHN ;GET THE CHANNEL NUMBER
MOVEM TF,FB$CHN(FB) ;AND SAVE IT AWAY
JUMPL T1,OPNERR ;IF ERROR OCCURRED, COMPLAIN
PUSHJ P,SETFD ;SET UP REAL FILE DESCRIPTION
MOVE S1,FB$LEB+.RBSIZ(FB) ;GET WORDS IN FILE
MOVEM S1,FB$WRD(FB) ;STORE IT
MOVE S1,FB$IFN(FB) ;GET THE IFN IN S1
$RETT ;AND RETURN OUR SUCCESS
> ;END TOPS10 CONDITIONAL
TOPS20<
MOVE T3,T1 ;GET LOCATION OF FOB INTO SAFER PLACE
MOVE S1,O$GJFN ;GET GTJFN FUNCTION WORD
MOVX S2,FB.PHY ;GET /PHYSICAL BIT
TDNE S2,FOB.CW(T3) ;IS IT SET?
TXO S1,GJ%PHY ;YES
HRROI S2,FB$FD+.FDSTG(FB) ;POINT TO THE FILE
GTJFN ;FIND IT
JRST OPNERR ;LOSE
MOVEM S1,FB$JFN(FB) ;SAVE THE JFN
SETZ T2, ;ASSUME NO CONNECTED DIRECTORY
CAILE T4,FOB.CD ;IS THIS FOR SOMEONE?
MOVE T2,FOB.CD(T3) ;GET CD IF IT'S THERE
MOVEM T2,FB$CHK+.CKACD(FB) ;STORE THE CONNECTED DIRECTORY
JUMPE T2,OPNC.2 ;SKIP ACCESS CHECK IF NO DIRECTORY
MOVE T2,O$PROT ;GET PROTECTION TO CHECK FOR
MOVEM T2,FB$CHK+.CKAAC(FB) ;AND PUT WHERE IT WILL GET CHECKED
LOAD T2,FOB.US(T3) ;GET USER ID
MOVEM T2,FB$CHK+.CKALD(FB) ;STORE IT
MOVEM S1,FB$CHK+.CKAUD(FB) ;STORE JFN TO CHECK AGAINST
MOVEI S2,FB$CHK(FB) ;ADDRESS OF BLOCK
MOVX S1,CK%JFN+.CKAUD+1 ;LENGTH + CHECKING JFN
CHKAC ;CHECK IT
SETZM S1 ;RETURN PROTECTION FAILURE
JUMPE S1,[ MOVX S1,ERPRT$ ;GET A PROTECTION FAILURE
PJRST RETERR ] ;AND GO FROM THERE
OPNC.2: MOVE S1,FB$JFN(FB) ;RESTORE JFN
MOVE S2,O$FUNC ;GET FILE OPEN FUNCTION
OPENF ;OPEN THE FILE
JRST OPNERR ;LOSE?
DVCHR ;LOOK UP THE DEVICE'S CHARACTERISTICS
LOAD S1,S2,DV%TYP ;ISOLATE THE TYPE CODE
CAXE S1,.DVNUL ;IF IT THE NULL DEVICE ???
CAXN S1,.DVDSK ;OR A DISK ???
JRST OPNC.1 ;YES TO EITHER,,CONTINUE
MOVX S1,ERFND$ ;LOAD 'DEVICE IS NOT THE DISK'
PJRST RETERR ;CLEAN UP AND RETURN THE ERROR
OPNC.1: SKIPE FB$PTR(FB) ;ATTRIBUTE BLOCK EXIST?
PUSHJ P,ATTRIB ;LOAD FILE ATTRIBUTES
MOVE S1,FB$JFN(FB) ;Get JFN back
MOVX S2,<.FBLEN,,.FBHDR> ;GET FILE DESCRIPTOR BLOCK
MOVEI T1,FB$FDB(FB) ;AND STORE INTO OUR FB
GTFDB ;
ERJMP .+1 ;IGNORE ERRORS FOR NOW
PUSHJ P,SETFD ;SET UP THE ACTUAL FILE DESCRIPTION
MOVEI S1,^D36 ;GET A FULL WORD BYTE
LOAD S2,FB$FDB+.FBBYV(FB),FB%BSZ ;GET THE SIZE FILE WAS WRITTEN IN
IDIV S1,S2 ;GET BYTES PER WORD
MOVE S2,FB$FDB+.FBSIZ(FB) ;GET HIGHEST BYTE ADDR IN FILE
IDIV S2,S1 ;GET BYTES IN FILE
SKIPE T1 ;ANY RESIDUE?
ADDI S2,1 ;YES, ADD ONE TO WORD COUNT
MOVEM S2,FB$WRD(FB) ;STORE WORDS IN FILE
MOVE S1,FB$IFN(FB) ;PUT IFN IN S1
$RETT ;RETURN SUCCESS, IFN IN S1
> ;END TOPS20 CONDITIONAL
SUBTTL LDLEB - Load a LOOKUP/ENTER block from an FD
; LDLEB IS USED TO LOAD THE LOOKUP/ENTER BLOCK FOR OPEN AND RENAME
; ROUTINES.
; CALL IS: FB/ ADDRESS OF FB
; S1/ ADDRESS OF FD
;
; RETURN: ALWAYS TRUE
TOPS10<
LDLEB: PUSHJ P,.SAVE2 ;GET SOME SCRATCH SPACE
MOVEI S2,.RBMAX ;LENGTH OF LOOKUP
MOVEM S2,FB$LEB+.RBCNT(FB) ;STORE IN LOOKUP/ENTER BLOCK
LOAD S2,.FDNAM(S1) ;GET FILE NAME
MOVEM S2,FB$LEB+.RBNAM(FB) ;STORE IN LOOKUP/ENTER BLOCK
LOAD S2,.FDEXT(S1) ;GET THE EXTENSION
;**;[107]CHANGE 1 LINE AT LDLEB:+6L 10-APR-84/CTK
HLLM S2,FB$LEB+.RBEXT(FB) ;[107]STORE IT
MOVE P1,.FDPPN(S1) ;GET THE PPN
MOVEM P1,FB$LEB+.RBPPN(FB) ;STORE INTO LOOKUP/ENTER BLOCK
LOAD S2,.FDLEN(S1),FD.LEN ;GET FD LENGTH
SUBI S2,.FDPAT ;SUBTRACT OFFSET OF FIRST SFD
JUMPLE S2,.RETT ;IF NO SFDS, WE ARE DONE
JUMPE P1,.RETT ;IF PPN IS 0, DON'T MAKE A PATH BLOCK
MOVEM P1,FB$PTH+.PTPPN(FB) ;STORE PPN IN PATH BLOCK
MOVEI P2,FB$PTH(FB) ;AND MAKE THE PPN WORD OF LEB
MOVEM P2,FB$LEB+.RBPPN(FB) ;POINT TO THE PATH BLOCK
MOVE P1,FB ;GET FB POINTER
LDLE.1: MOVE P2,.FDPAT(S1) ;GET AN SFD
MOVEM P2,FB$PTH+.PTPPN+1(P1) ;STORE IT
ADDI S1,1 ;INCREMENT 1ST PTR
ADDI P1,1 ;INCREMENT 2ND PTR
SOJG S2,LDLE.1 ;AND GET THEM ALL
POPJ P, ;RETURN
> ;END OF TOPS10 CONDITIONAL
SUBTTL File attribute processing -- Main loop and dispatch table
; Here to process file attributes.
; Call: MOVE FB,address of file block
; PUSHJ P,ATTRIB
;
; TRUE return: attributes set.
; FALSE return: failed for some reason; error code stored.
;
; For TOPS-10 this must be done before any FILOP. UUOs are done
; to that the attributes get put into the LOOKUP/ENTER/RENAME blocks.
;
; For TOPS-20, this routine must be called after any GTJFN/OPENF JSYS are
; done.
;
ATTRIB: SKIPN FB$PTR(FB) ;HAVE AN ATTRIBUTE BLOCK?
$RETT ;NO
$SAVE <FB,P4> ;NEED TO MANGLE FILE BLOCKS
PUSHJ P,GETBLK ;EAT OVERHEAD WORD
JUMPT ATTR.1 ;CHECK FOR ERRORS
$RETE (FAI) ;FILE ATTRIBUTE BLOCK INCONSISTANCY
ATTR.1: PUSHJ P,GETBLK ;GET A BLOCK TYPE
JUMPF .RETT ;RETURN IF ALL DONE
LOAD S2,S1,FI.ATR ;GET BLOCK TYPE
CAIL S2,1 ;RANGE CHECK
CAILE S2,.FIMAX ; IT
$RETE (IFA) ;ILLEGAL FILE ATTRIBUTE
LOAD S1,S1,FI.LEN ;GET LENGTH
PUSHJ P,@ATRTAB-1(S2) ;PROCESS IT
JUMPT ATTR.1 ;LOOP FOR MORE IF ALL IS OK
$RETE (FAI) ;FILE ATTRIBUTE BLOCK INCONSISTANCY
; Attribute dispatch table
; All routines are called with S1:= attribute block word count.
;
ATRTAB: IFIW ATRPRO ;(01) PROTECTION CODE
IFIW ATRACT ;(02) ACCOUNT STRING
IFIW ATRSPL ;(03) SPOOLED FILE NAME
IFIW ATRCRY ;(04) ENCRYPTION CODE
IFIW ATRDTY ;(05) DATA TYPE
IFIW ATRDTO ;(06) DATA "OTS" TYPE
IFIW ATRDCC ;(07) DATA CARRIAGE CONTROL
IFIW ATRBSZ ;(10) LOCAL DATA BYTE SIZE
IFIW ATRFSZ ;(11) PHYSICAL DATA FRAME SIZE
IFIW ATRHSZ ;(12) FIXED-HEADER SIZE (VARIABLE-LEN RECORDS)
IFIW ATRRFM ;(13) RECORD FORMAT
IFIW ATRRFO ;(14) RECORD FORMAT ORGANIZATION
IFIW ATRRSZ ;(15) RECORD SIZE
IFIW ATRBLS ;(16) BLOCK SIZE (BYTES)
IFIW ATRFFB ;(17) FIRST FREE BYTE WITHIN LAST BLOCK
IFIW ATRACW ;(20) APPLICATION-SPECIFIC FIELD
IFIW ATRRMS ;(21) RMS-10 FORMATTED FILE
IFIW ATRMCY ;(22) MACY11 FORMATTED FILE
IFIW ATRCTG ;(23) CONTIGUOUS ALLOCATION
IFIW ATRNSB ;(24) RECORDS DO NO SPAN PHYSICAL BLOCKS
IFIW ATRCRE ;(25) CREATION DATE,,TIME
IFIW ATRACD ;(26) ACCESS DATE
IFIW ATRMOD ;(27) I/O MODE OF FILE
IFIW ATRVER ;(30) FILE VERSION WORD
IFIW ATRUSW ;(31) USER-SETTABLE WORD
IFIW ATRMTA ;(32) TAPE LABEL
IFIW ATRSTS ;(33) FILE STATUS BITS
IFIW ATRIDT ;(34) BACKUP INCREMENTAL DATE/TIME
IFIW ATRPCA ;(35) PRIVILEGED CUSTOMER-SETTABLE WORD
IFIW ATRTIM ;(36) PHYSICAL CREATION DATE/TIME
IFIW ATRLAD ;(37) LAST ACCOUNTING DATE
IFIW ATREXP ;(40) EXPIRATION DATE (UDT)
IFIW ATRAUT ;(41) FILE AUTHOR
; Protection
;
ATRPRO: CAIE S1,1 ;1 WORD WE HOPE
$RETF ;LOSER
PUSHJ P,GETVAL ;GET PROTECTION CODE
JUMPF .RETF ;THERE WASN'T ONE
TOPS10 <STORE S1,FB$LEB+.RBPRV(FB),RB.PRV> ;STORE IT
TOPS20 <
MOVE T1,S1 ;GET PROTECTION CODE
HRLI S1,.FBPRT ;INDEX INTO FDB TO CHANGE
HRR S1,FB$JFN(FB) ;GET THE JFN
MOVEI S2,-1 ;MASK OF BITS TO CHANGE
CHFDB ;AND SET IT
ERJMP GETERR ;CAN'T
>
$RETT ;RETURN
; Account string
;
ATRACT: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SKIPG P1,S1 ;GET WORD COUNT
$RETF ;NEGATIVE OR ZERO LOSES
TOPS10 <MOVEI P2,FB$LEB+.RBACT(FB)> ;TOPS-10 BASE ADDRESS OF ACCT STRING
TOPS20 <MOVEI P2,FB$ACT(FB)> ;TOPS-20 BASE ADDRESS OF ACCT STRING
SKIPN FB$IFF(FB) ;FROM AN IFN?
JRST ATRAC4 ;NOPE
PUSHJ P,GETVAL ;GET THE ADDRESS
$RETIF ;PROPAGATE FAILURE
MOVSS S1 ;MAKE BLT SOURCE
JRST ATRAC5 ;GO JOIN INDIRECTED CASE
ATRAC4: SKIPN FB$IMM(FB) ;IMMEDIATE ARGUMENT?
JRST ATRAC2 ;NOPE
ATRAC1: PUSHJ P,GETVAL ;GET A WORD
JUMPF .RETF ;PREMATURE END OF LIST
MOVEM S1,(P2) ;PUT A WORD
ADDI P2,1 ;POINT TO NEXT STORAGE LOCATION
SOJG P1,ATRAC1 ;LOOP FOR ALL WORDS
JRST ATRAC3 ;FINISH UP
ATRAC2: SOSGE FB$CNT(FB) ;COUNT ARGUMENTS
$RETF ;END OF LIST
HRLZ S1,@FB$PTR(FB) ;GET ADDRESS OF BLOCK
ATRAC5: HRRI S1,(P2) ;MAKE A BLT POINTER
AOS FB$PTR(FB) ;INCREMENT FOR NEXT TIME
ADDI P1,(P2) ;COMPUTE END ADDRESS OF BLT
BLT S1,-1(P1) ;COPY BLOCK
ATRAC3:
TOPS20 <
MOVE S1,FB$JFN(FB) ;GET THE JFN
HRROI S2,FB$ACT(FB) ;POINT TO ACCOUNT STRING
SACTF ;SET FILE ACCOUNT
$RETF ;CAN'T
>
$RETT ;RETURN
; Spooled file name (TOPS-10 only)
;
ATRSPL: CAIE S1,1 ;1 WORD
$RETF ;BAD ARGUMENT
PUSHJ P,GETVAL ;GET SPOOLED FILE NAME
JUMPF .RETF ;END OF LIST
TOPS10 <MOVEM S1,FB$LEB+.RBSPL(FB)> ;STORE IT
$RETT ;RETURN
ATRCRY: SKIPA S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.CRY] ;ENCRYPTION CODE
ATRDTY: MOVE S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.DTY] ;DATA TYPE
PJRST RDHCOM ;ENTER COMMON CODE
ATRDTO: SKIPA S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.DTO] ;DATA "OTS" TYPE
ATRDCC: MOVE S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.DCC] ;DATA CARRIAGE CONTROL
PJRST RDHCOM ;ENTER COMMON CODE
ATRBSZ: SKIPA S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.BSZ] ;LOCAL DATA BYTE SIZE
ATRFSZ: MOVE S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.FSZ] ;PHYSICAL FRAME SIZE
PJRST RDHCOM ;ENTER COMMON CODE
ATRHSZ: SKIPA S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.HSZ] ;FIXED-HEADER SIZE
ATRRFM: MOVE S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.RFM] ;RECORD FORMAT
PJRST RDHCOM ;ENTER COMMON CODE
ATRRFO: MOVE S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.RFO] ;REC FORMAT ORGANIZATION
PJRST RDHCOM ;ENTER COMMON CODE
ATRRSZ: SKIPA S2,[STORE S1,FB$LEB+.RBRSZ(FB),RB.RSZ] ;RECORD SIZE (BYTES)
ATRBLS: MOVE S2,[STORE S1,FB$LEB+.RBRSZ(FB),RB.BLS] ;BLOCK SIZE (BYTES)
PJRST RDHCOM ;ENTER COMMON CODE
ATRFFB: SKIPA S2,[STORE S1,FB$LEB+.RBFFB(FB),RB.FFB] ;FIRST FREE BYTE
ATRACW: MOVE S2,[STORE S1,FB$LEB+.RBFFB(FB),RB.ACW] ;APPLICATION FIELD
PJRST RDHCOM ;ENTER COMMON CODE
ATRRMS: SKIPA S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.RMS] ;RMS-10 FORMATTED FILE
ATRMCY: MOVE S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.MCY] ;MACY11 FORMATTED FILE
PJRST RDHCOM ;ENTER COMMON CODE
ATRCTG: SKIPA S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.CTG] ;CONTIGUOUS ALLOCATION
ATRNSB: MOVE S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.NSB] ;/NOSPAN PHY BLOCKS
PJRST RDHCOM ;ENTER COMMON CODE
; Common code to set the RDH fields in the extended LOOKUP/ENTER block
RDHCOM: CAIE S1,1 ;1 WORD
$RETF ;BAD ARGUMENT
PUSHJ P,GETVAL ;FETCH THE VALUE TO STORE
$RETIF ;BETTER WORK
TOPS10<
XCT S2 ;STORE FIELD IN L/E BLOCK
MOVX S2,RB.DEC ;BIT TO SET
IORM S2,FB$LEB+.RBTYP(FB) ;MAKE NEW FIELD VALID
> ;END TOPS-10 CONDITIONAL
$RETT ;RETURN
ATRCRE: CAIE S1,1 ;MUST HAVE CORRECT LENGTH
$RETE (FAI)
PUSHJ P,GETVAL ;GET THE WORD
$RETIF ;END OF LIST
PUSHJ P,CNTDT## ;CONVERT UDT TO OLD-STYLE DATE/TIME
DPB S2,[POINTR FB$LEB+.RBPRV(FB),RB.CRD] ;STORE LOW PORTION OF DATE
LSH S2,-^D12 ;ISOLATE HIGH BITS
DPB S2,[POINTR FB$LEB+.RBEXT(FB),RB.CRX] ;STORE HIGH PORTION
ADDI S1,1 ;ACCOUNT FOR POSSIBLE ROUNDING ERRORS
IDIVI S1,^D60000 ;MAKE INTO MINUTES SINCE MIDNIGHT
DPB S2,[POINTR FB$LEB+.RBPRV(FB),RB.CRT] ;STORE CREATION TIME
$RETT ;DONE
ATRACD: SKIPA S2,[POINTR FB$LEB+.RBEXT(FB),RB.ACD] ;ACCESS DATE
ATRMOD: MOVE S2,[POINTR FB$LEB+.RBPRV(FB),RB.MOD] ;I/O MODE
PJRST ATRCOM ;COMMON CODE FOR 1-WORD VALUES
ATRVER: SKIPA S2,[POINT 36,FB$LEB+.RBVER(FB),35] ;VERSION
ATRUSW: MOVE S2,[POINT 36,FB$LEB+.RBNCA(FB),35] ;USER-SETTABLE WORD
PJRST ATRCOM ;COMMON CODE FOR 1-WORD VALUES
ATRMTA: SKIPA S2,[POINT 36,FB$LEB+.RBMTA(FB),35] ;TAPE LABEL
ATRSTS: MOVE S2,[POINT 36,FB$LEB+.RBSTS(FB),35] ;STATUS BITS
PJRST ATRCOM ;COMMON CODE FOR 1-WORD VALUES
ATRIDT: SKIPA S2,[POINT 36,FB$LEB+.RBIDT(FB),35] ;BACKUP DATE/TIME
ATRPCA: MOVE S2,[POINT 36,FB$LEB+.RBPCA(FB),35] ;PRIV'ED USW
PJRST ATRCOM ;COMMON CODE FOR 1-WORD VALUES
ATRTIM: SKIPA S2,[POINT 36,FB$LEB+.RBTIM(FB),35] ;PHYSICAL CREATION UDT
ATRLAD: MOVE S2,[POINT 36,FB$LEB+.RBLAD(FB),35] ;LAST ACCOUNTING DATE
PJRST ATRCOM ;COMMON CODE FOR 1-WORD VALUES
ATREXP: SKIPA S2,[POINT 36,FB$LEB+.RBDED(FB),35] ;EXPIRATION DATE
ATRAUT: MOVE S2,[POINT 36,FB$LEB+.RBAUT(FB),35] ;AUTHOR PPN
ATRCOM: CAIE S1,1 ;BETTER BE A ONE-WORD VALUE HERE
$RETE (FAI)
PUSHJ P,GETVAL ;READ THE WORD
$RETIF ;END OF LIST?
DPB S1,S2 ;STUFF INTO THE RIB
$RETT ;WIN
SUBTTL SETFD - Set up a real description of opened file
;SETFD IS CALLED AFTER A FILE IS OPENED TO STORE A REAL
; I.E. OBTAINED FROM THE SYSTEM , FD
;CALL IS: FB POINTS TO THE FILE'S FILE BLOCK
;
;RETURN IS: ALWAYS TRUE
TOPS10<
SETFD: MOVSI S1,FB$FIL(FB) ;POINT TO RETURNED FILESPEC BLOCK
HRRI S1,FB$RFD(FB) ;AND TO DESTINATION
BLT S1,FB$RFD+FDXSIZ-1(FB) ;COPY (SMASHES LENGTH WORD)
MOVEI S1,FB$RFD+.FDSTR(FB) ;POINT TO START OF REAL DATA
HRLI S1,-FDXSIZ ;MAKE AN AOBJN POINTER
SKIPE (S1) ;END?
AOBJN S1,.-1 ;KEEP SEARCHING
HRRZS S1 ;ISOLATE END ADDR
SUBI S1,FB$RFD(FB) ;GET OFFSET
CAIGE S1,FDMSIZ ;SMALLER THAN MINIMUM?
MOVEI S1,FDMSIZ ;ROUND UP
STORE S1,FB$RFD+.FDLEN(FB),FD.LEN ;SET BLOCK LENGTH
$RETT ;THEN RETURN TO CALLER
> ;END OF TOPS10 CONDITIONAL
TOPS20<
SETFD: PUSH P,T1 ;SAVE JSYS REGISTER
HRROI S1,FB$RFD+.FDSTG(FB) ;MAKE POINTER TO PLACE TO STORE STRING
MOVE S2,FB$JFN(FB) ;GET JFN OF FILE
MOVX T1,1B2+1B5+1B8+1B11+1B14+JS%TMP+JS%PAF
JFNS ;MAKE STRING FROM JFN
ANDI S1,-1 ;GET ADDRESS LAST USED
SUBI S1,FB$RFD-1(FB) ;GET LENGTH OF THE FD
STORE S1,FB$RFD+.FDLEN(FB),FD.LEN ;STORE THE LENGTH AWAY
POP P,T1 ;RESTORE THE REGISTER
$RETT ;RETURN TO CALLER
> ;END OF TOPS20 CONDITIONAL
SUBTTL SETFOB - Build an internal FOB
;SETFOB is used to create an internal FOB, which is built from a regular
;FOB with any missing fields defaulted. It is used by rename and delete
;to create a complete FOB where the user may have supplied only a partial
;one.
;
;CALL IS: S1/ LENGTH OF INPUT FOB
; S2/ ADDRESS OF INPUT FOB
;TRUE RETURN: S1/ LENGTH OF INTERNAL FOB
; S2/ ADDRESS OF INTERNAL FOB
;
; TRUE RETURN IS ALWAYS GIVEN
SETFOB: PUSHJ P,.SAVE1 ;GET ONE WORK AC
MOVE P1,FOB.FD(S2) ;FD ALWAYS GIVEN
STORE P1,F$FOB+FOB.FD ;SO USE IT
MOVEI P1,^D36 ;ALWAYS USE 36. BIT BYTE SIZE
STORE P1,F$FOB+FOB.CW,FB.BSZ ;FOR THE FILE
CAIG S1,FOB.US ;IS USER ID GIVEN?
TDZA P1,P1 ;NO, FILL IT WITH ZERO
MOVE P1,FOB.US(S2) ;ELSE USE WHAT IS GIVEN
STORE P1,F$FOB+FOB.US ;STORE IT
TOPS20<
CAIG S1,FOB.CD ;IS CONNECTED DIRECTORY GIVEN?
> ;END OF TOPS20 CONDITIONAL
TDZA P1,P1 ;NO, FILL WITH ZERO
MOVE P1,FOB.CD(S2) ;ELSE USE WHAT IS GIVEN
STORE P1,F$FOB+FOB.CD ;STORE IT
MOVEI S1,FOB.SZ ;SIZE OF FOB
MOVEI S2,F$FOB ;AND ITS LOCATION
$RETT ;RETURN WITH POINTERS SET UP
SUBTTL OPNERR - Handle a system error from F%IOPN
;OPNERR IS CALLED ON A SYSTEM GENERATED ERROR IN F%IOPN TO CLEAN
; UP, TRANSLATE THE SYSTEM ERROR CODE INTO A GALAXY ERROR CODE
; AND RETURN FALSE.
;
;RETERR IS LIKE OPNERR, EXCEPT THAT THE ERROR CODE IS ALREADY A GLXLIB ERROR
; CODE, NOT A SYSTEM ERROR CODE
;
;UPON ENTERING, S1 CONTAINS THE ERROR CODE
; FB CONTAINS THE ADDRESS OF THE WORK PAGE
; I CONTAINS THE IFN
OPNERR: PUSH P,S1 ;SAVE THE ERROR CODE
PUSHJ P,INTREL ;RELEASE THE IFN
POP P,S1 ;RESTORE THE ERROR CODE
PJRST MAPERR ;MAP THE OPERATING SYSTEM ERROR
;RETERR IS AN IDENTICAL ERROR ROUTINE, EXCEPT THAT THE ERROR CODE IS
; PRE-MAPPED.
RETERR: PUSH P,S1 ;SAVE THE CODE
PUSHJ P,INTREL ;RELEASE THE IFN
POP P,S1 ;RESTORE THE CODE
MOVEM S1,.LGERR## ;SET UP IN CASE OF STOP CODE
MOVEI S2,. ;AND SET UP THE PC TOO
MOVEM S2,.LGEPC## ;
$RETF ;FINALLY, TAKE FAILURE RETURN
SUBTTL F%IBYT - Read one byte from file
;F%IBYT is called for a file open for INPUT or UPDATE to return the next
; byte from the file.
;
;Call: S1/ IFN
;
;True Return: S1/ IFN
; S2/ Next byte from file
;
;False Return: S1/ Error code: EREOF$ ERFDE$
F%IBYT: PUSHJ P,CHKIFN ;CHECK THE IFN
MOVE S1,FB$MOD(FB) ;GET OPEN MODE
CAIN S1,FBM$IN ;IS IT INPUT?
JRST IBYT.1 ;YES, CONTINUE
CAIN S1,FBM$UP ;OR UPDATE?
HALT . ;NOT IMPLEMENTED YET!
JRST ILLMOD ;NO, GIVE A STOPCODE
IBYT.1: SOSGE FB$BIB(FB) ;COUNT OFF ONE MORE BYTE
JRST IBYT.3 ;NO MORE IN BUFFER
SKIPE FB$LSN(FB) ;ARE WE TRIMMING LSN'S?
JRST IBYT.4 ;YES, GO CHECK IT
IBYT.2: ILDB S2,FB$BBP(FB) ;NO, JUST GET THE NEXT BYTE
JUMPN S2,IBYT.A ;NON-NULL -- NO CHECK OF DEV TYPE
MOVE S1,FB$TYP(FB) ;GET DEVICE TYPE
CAIE S1,.TYTTY ;TTY?
JRST IBYT.A ;NO
MOVE S1,FB$BYT(FB) ;YES, GET BYTE SIZE
CAIE S1,^D7 ;SOME TYPE OF ASCII?
CAIN S1,^D8
JRST [SETZM FB$BIB(FB)
JRST IBYT.1]
IBYT.A: MOVE S1,FB$IFN(FB) ;RESTORE IFN
$RETT ;AND RETURN
IBYT.3: PUSHJ P,GETBUF ;GET NEXT BUFFER FULL
JUMPF .RETF ;RETURN IF IT FAILED
JRST IBYT.1 ;ELSE, TRY AGAIN
;**;[104] Redo code from IBYT.4 to end of F%IBYT. 3-Nov-83 /LWS
;[104] Here to handle LSN strangeness.
IBYT.4: $SAVE <T1> ;[104] SAVE T1
MOVE S1,FB$BBP(FB) ;GET THE BUFFER BYTE POINTER
IBP S1 ;NORMALIZE IT
MOVE T1,(S1) ;[104] GET THE WORD
TRNN T1,1 ;[104] IS LSN BIT SET?
JRST [SKIPLE FB$LSN(FB) ;SKIP IF NOT VIRGIN FILE
SETZM FB$LSN(FB) ;IT IS, THEN THERE ARE NO LSNS IN FILE!
JRST IBYT.2] ;GET THE BYTE
PUSHJ P,IBYT.8 ;[104] GO ADJUST BYTE COUNT AND POINTER
CAME T1,[EXP <<" ">_1>!1];[104] BEGINNING OF LSN PAGE MARK?
JRST IBYT.7 ;[104] NO,,MUST JUST BE LINE NUMBER
IBYT.5: SOSGE FB$BIB(FB) ;[104] COULD BE,,BUFFER HAVE ANY MORE?
JRST IBYT.6 ;[104] NO,,GO GET ANOTHER BUFFER
MOVE S1,FB$BBP(FB) ;[104] GET BYTE POINTER
IBP S1 ;[104] NORMALIZE IT
MOVE T1,(S1) ;[104] GET WHOLE WORD
CAME T1,[BYTE (7) .CHCRT,.CHFFD,0,0,0] ;[104] SECOND WORD OF PAGE MARK?
JRST IBYT.2 ;[104] NO,,GIVE THE GUY THE NEXT BYTE
PUSHJ P,IBYT.8 ;[104] YES,,GO ADJUST BYTE COUNT AND POINTER
JRST IBYT.1 ;[104] GO GET THE NEXT BYTE
IBYT.6: PUSHJ P,GETBUF ;[104] GET NEXT BUFFER
JUMPF .RETF ;[104] RETURN IF NO MORE
JRST IBYT.5 ;[104] GO BACK AND GET NEXT BYTE
IBYT.7: SETZM FB$LSN(FB) ;[104] CLEAR FLAG TO AVOID RECURSION
PUSHJ P,IBYT.1 ;GET THE TAB FOLLOW LSN
SETOM FB$LSN(FB) ;RE-SET THE FLAG
JUMPF .RETF ;PASS ON THE ERROR
CAIN S2,.CHTAB ;[104] WAS IT REALLY A TAB?
JRST IBYT.1 ;[104] YES,,GET NEXT BYTE
$RETT ;[104] NO,,DON'T KEEP IT FROM CALLER
IBYT.8: AOS FB$BBP(FB) ;[104] INCREMENT BYTE-POINT BY ONE WORD
MOVNI S1,5-1 ;[104] ACCOUNT FOR BYTES BYPASSED BY AOS
;[104] FB$BIB WAS SOSGE'D ABOVE
ADDM S1,FB$BIB(FB) ;[104] DECREMENT BYTES-IN-BUFFER
;[104] EVEN IF FB$BIB GOES NEGATIVE HERE
;[104] THE NEXT SOSGE IN IBYT WILL CATCH IT
POPJ P, ;[104] RETURN
SUBTTL F%IBUF - Read a buffer of data from file
;F%IBUF is called for a file open for INPUT or UPDATE to return the next
; 'n' bytes of data from the file.
;
;Call: S1/ IFN
;
;True Return: S1/ Number of bytes returned
; S2/ Byte Pointer to first byte (ILDB)
;
;False Return: S1/ Error Code: EREOF$ ERFDE$
F%IBUF: PUSHJ P,CHKIFN ;CHECK THE IFN
MOVE S1,FB$MOD(FB) ;GET I/O MODE
CAIN S1,FBM$IN ;IS IT INPUT?
JRST IBUF.1 ;YES, CONTINUE
CAIN S1,FBM$UP ;IS IT UPDATE?
HALT . ;NOT IMPLEMENTED YET
JRST ILLMOD ;INCORRECT MODE
IBUF.1: SKIPE FB$LSN(FB) ;WANT TO TRIM LINE NUMBERS?
STOPCD (CTL,HALT,,<Cannot trim LSN in buffered mode>)
SKIPG S1,FB$BIB(FB) ;GET NUMBER OF BYTES IN BUFFER
JRST IBUF.2 ;NONE THERE, NEED TO READ ANOTHER
MOVE S2,FB$BBP(FB) ;GET THE BYTE POINTER
SETZM FB$BIB(FB) ;NO BYTES LEFT IN BUFFER
$RETT ;RETURN
IBUF.2: PUSHJ P,GETBUF ;GET A NEW BUFFER
JUMPF .RETF ;PROPAGATE THE ERROR
JRST IBUF.1 ;AND TRY AGAIN
SUBTTL GETBUF - Read one input buffer from the operating system
;GETBUF is called by F%IBYT and F%IBUF to read another bufferful of data
; from the file. It has no explicit input arguments. On TRUE return,
; it has no explicit output arguments but it returns with the FB
; fully updated.
;
;False return: S1/ Error code: EREOF$ ERFDE$
GETBUF: SKIPE FB$EOF(FB) ;HAVE WE SEEN EOF?
JRST POSEOF ;YES, JUST RETURN EOF
TOPS10<
HRL S1,FB$CHN(FB) ;GET THE CHANNEL NUMBER
HRRI S1,.FOINP ;LOAD THE INPUT FUNCTION CODE
MOVE S2,[1,,S1] ;FILOP ARG POINTER
FILOP. S2, ;AND DO THE INPUT
SKIPA ;SKIP IF ERROR
JRST GETB.2 ;ELSE CONTINUE ON
TXNE S2,IO.EOF ;IS IT END OF FILE?
JRST POSEOF ;YES, HANDLE IT
PJRST MAPIOE ;MAP I/O ERROR
> ;END TOPS10
TOPS20<
$CALL .SAVET ;SAVE T1 THRU T4
MOVE S1,FB$JFN(FB) ;GET THE JFN
MOVE S2,FB$BUF(FB) ;GET BUFFER ADDRESS
HRLI S2,(POINT ^D36,0) ;MAKE A BYTE POINTER
MOVEM S2,FB$BRH+.BFPTR(FB) ;SAVE THE BYTE POINTER
MOVNI T1,SZ.BUF ;NUMBER OF WORDS TO READ
SIN ;READ THEM
ERJMP [GTSTS ;GET FILE STATUS
TXNN S2,GS%EOF ;IS IT EOF?
PJRST GETERR ;GET ERROR, MAP IT AND RETURN
PUSHJ P,POSEOF ;YES, SET EOF
JRST GETB.1] ;AND CONTINUE ON
GETB.1: ADDI T1,SZ.BUF ;ADD NUMBER OF WORDS REQUESTED
MOVEM T1,FB$BRH+.BFCNT(FB) ;STORE NUMBER OF WORDS READ
JUMPE T1,POSEOF ;GOT EOF!!
> ;END TOPS20
GETB.2: AOS FB$BFN(FB) ;INCREMENT BUFFER NUMBER
PUSHJ P,SETBFD ;SETUP BUFFER DATA
$RETT
SUBTTL F%POS - Position an input file
SUBTTL F%REW - Rewind an input file
;F%POS is called for a file open for INPUT to position to a
; particular byte within the file.
;
;F%REW is a special case of F%POS to position to the first byte
; of the file.
;
;Call: S1/ IFN (for F%POS and F%REW)
; S2/ Byte number (for F%POS only)
;
;True Return: Nothing returned
;
;False Return: S1/ Error code: ERIFP$ ERFDE$
F%REW: SETZ S2, ;POSITION TO BYTE 0 FOR REWIND
F%POS: PUSHJ P,CHKIFN ;CHECK THE IFN GIVEN
MOVE S1,FB$TYP(FB) ;MAKE SURE A DISK
CAXE S1,.TYDSK
JRST [MOVX S1,ERFND$ ;NO, RETURN A 'FILE NOT ON DISK'
PJRST RETERR ]
$CALL .SAVET ;SAVE T REGS
MOVE T4,S2 ;SAVE DESIRED BYTE NUMBER
MOVE S1,FB$MOD(FB) ;GET I/O MODE
CAIN S1,FBM$IN ;IS IT INPUT?
JRST POS.1 ;YES, ALL IS WELL
CAIN S1,FBM$UP ;UPDATE?
HALT . ;NO IMPLEMENTED
JRST ILLMOD ;ELSE, LOSE
POS.1: CAME S2,[EXP -1] ;DOES HE WANT EOF?
JRST POS.2 ;NO, CONTINUE ON
PUSHJ P,POSEOF ;SETUP EOF
$RETT ;AND RETURN
POS.2: SKIPGE S2 ;RANGE CHECK THE BYTE NUMBER
$RETE(IFP) ;NEGATIVE BYTES LOSE
SKIPN T1,FB$WRD(FB) ;GET WORDS IN FILE
JRST [PUSHJ P,POSEOF ;NULL FILE,,POSITION TO EOF
$RETT ] ;AND RETURN
IMUL T1,FB$BPW(FB) ;CONVERT TO BYTES
CAMN S2,T1 ;POSITIONING TO EOF ???
JRST [PUSHJ P,POSEOF ;YES, POSITION THERE
$RETT ] ;AND RETURN
CAML S2,T1 ;POSITIONING WITHIN FILE ???
$RETE(IFP) ;NO,,RETURN AN ERROR
MOVE T1,FB$BPW(FB) ;GET BYTES PER WORD
IMULI T1,SZ.BUF ;GET BYTES PER BUFFER
MOVE T2,S2 ;COPY THE BYTE NUMBER OVER
IDIV T2,T1 ;T2=BUFFER NUMBER
;T3=BYTE WITHIN BUFFER
SKIPN FB$EOF(FB) ;ARE WE AT EOF?
CAME T2,FB$BFN(FB) ;YES, IS BYTE IN CURRENT BUFFER?
JRST POS.4 ;WE HAVE TO DO SOME WORK
PUSHJ P,SETBFD ;SETUP POINTERS FOR THIS BUFFER
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVNS T3 ;NEGATE BYTE COUNT
ADDM T3,FB$BIB(FB) ;TO DECREMENT BUFFER COUNT
MOVNS T3 ;RE-NEGATE
IDIV T3,FB$BPW(FB) ;CONVERT TO WORDS
ADDM T3,FB$BBP(FB) ;PUSH UP THE BYTE POINTER SOME
POS.3: SOJL T4,.RETT ;MORE ODD BYTES?
IBP FB$BBP(FB) ;YES, BUMP THE POINTER
JRST POS.3 ;AND LOOP
;F%POS IS CONTINUED ON THE FOLLOWING PAGE
;CONTINUED FROM THE PREVIOUS PAGE
POS.4:
SETOM FB$BIB(FB) ;FORCE A READ
MOVEM T2,FB$BFN(FB) ;SAVE FOR POSBUF
SOS FB$BFN(FB) ;BUT DECREMENT FOR LATER INCREMENT
TOPS10<
HRL S1,FB$CHN(FB) ;GET CHANNEL NUMBER
HRRI S1,.FOUSI ;USETI CODE
SETO S2, ;POSITION TO EOF
MOVE T1,[2,,S1] ;FILOP ARG POINTER
FILOP. T1, ;POSITION TO EOF
JFCL ;IGNORE THE ERROR (ALWAYS HAPPENS)
MOVE S2,T1 ;COPY STATUS BITS
TXZ S2,IO.EOF ;CLEAR EOF
HRRI S1,.FOSET ;DO A SETST ON THE SAME CHANNEL
MOVE T1,[2,,S1] ;AIM AT ARG LIST
FILOP. T1, ;CLEAR EOF, SO INPUT WINS
PJRST MAPIOE ;CAN'T CLEAR EOF, MAP I/O ERROR
;NOW, LOOP AROUND DOING INPUTS UNTIL THE MONITOR HAS TO READ US A NEW BUFFER
POS.5: HRRI S1,.FOINP ;INPUT FUNCTION ON SAME CHANNEL
MOVE S2,[1,,S1] ;FILOP ARG POINTER
FILOP. S2, ;START FLUSHING UNTIL EOF
SKIPA ;EOF FINALLY?
JRST POS.5 ;NO, LOOP
TXZN S2,IO.EOF ;END OF FILE?
PJRST MAPIOE ;MAP I/O ERROR
HRRI S1,.FOSET ;SETSTS FUNCTION FOR THIS CHANNEL
MOVE T1,[2,,S1] ;SETUP FOR FILOP.
FILOP. T1, ;RESET THE I/O STATUS
PJRST MAPIOE ;CAN'T CLEAR EOF, NEXT IN WOULD LOSE
MOVEI S2,1(T2) ;NOW, GET BLOCK TO POSITION TO
;(ADD 1 TO CONVERT FROM OUR 0 BASE
; CONVENTION TO USETI 1 BASE)
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
HRRI S1,.FOUSI ;USETI FUNCTION ON THIS CHANNEL
MOVE T1,[2,,S1] ;ARG POINTER
FILOP. T1, ;SET THE BLOCK NUMBER
PJRST MAPIOE ;MAP I/O ERROR
> ;END TOPS10
TOPS20<
MOVE S2,T2 ;GET BUFFER NUMBER
IMULI S2,SZ.BUF ;CONVERT TO WORD NUMBER
MOVE S1,FB$JFN(FB) ;GET THE JFN
SFPTR ;SET FILE POINTER
STOPCD (FOF,HALT,,<File operation failed unexpectedly>)
> ;END TOPS20
PUSHJ P,GETBUF ;READ THAT NEXT BUFFER
JUMPT POS.6 ;ANY ERRORS ?
CAXE S1,EREOF$ ;WAS IT END OF FILE ?
$RET ;NO - JUST PROPAGATE ERROR BACK
POS.6: SETZM FB$EOF(FB) ;CLEAR EOF FLAG
MOVE S2,T4 ;RESET DESIRED POSITION
JRST POS.2 ;GO BACK AND POSITION IN THIS BUFFER
POSEOF: SETOM FB$BIB(FB) ;MAKE SURE WE ALWAYS GET HERE
SETOM FB$EOF(FB) ;DITTO
$RETE(EOF) ;RETURN THE ERROR
SUBTTL F%OBYT - Write one byte into file
;F%OBYT is called for an open OUTPUT or APPEND file to write one byte.
;
;Call: S1/ IFN
; S2/ Byte to write
;
;True Return: No data returned
;
;False Return: S1/ Error code: ERFDE$
F%OBYT: PUSHJ P,CHKIFN ;CHECK OUT THE IFN
SETOM FB$FNC(FB) ;DO SOMETHING ON NEXT CHECKPOINT CALL
MOVE S1,FB$MOD(FB) ;GET THE MODE
CAIE S1,FBM$OU ;IF OUTPUT
CAIN S1,FBM$AP ;OR APPEND
JRST OBYT.1 ;CONTINUE ON
JRST ILLMOD ;ELSE, LOSE
OBYT.1: SOSGE FB$BIB(FB) ;ANY ROOM IN BUFFER?
JRST OBYT.2 ;NO, DUMP THE BUFFER AND GET NEXT ONE
IDPB S2,FB$BBP(FB) ;YES, DEPOSIT THE BYTE
$RETT ;RETURN TRUE
OBYT.2: PUSH P,S2 ;SAVE S2
PUSHJ P,PUTBUF ;WRITE OUT THE BUFFER
POP P,S2 ;RESTORE S2
JUMPF .RETF ;PROPAGATE AN ERROR
JRST OBYT.1 ;ELSE, TRY AGAIN
SUBTTL F%OBUF - Write a buffer full of data to a file
;F%OBUF is called to transfer a buffer full of data to a file which is
; open for OUTPUT or APPEND.
;
;Call: S1/ IFN
; S2/ XWD Number of bytes,Address of buffer
;
;True Return: No data returned
;
;False Return: S1/ Error code: ERFDE$
F%OBUF: PUSHJ P,CHKIFN ;CHECK THE IFN OUT
PUSHJ P,.SAVE4 ;SAVE P1 THRU P4
SETOM FB$FNC(FB) ;DO SOMETHING ON NEXT CHECKPOINT CALL
MOVE P1,FB$MOD(FB) ;GET THE MODE
CAIE P1,FBM$OU ;IF IT IS OUTPUT
CAIN P1,FBM$AP ; OR APPEND,
SKIPA ; THEN WIN
JRST ILLMOD ;ELSE LOSE
HRRZ P1,S2 ;GET ADDRESS IN P1
HLRZ P2,S2 ;GET COUNT IN P2
HRLI P1,(POINT) ;MAKE IT A BYTE POINTER
MOVE P3,FB$BYT(FB) ;GET BYTE SIZE
DPB P3,[POINT 6,P1,11] ;STORE IT
MOVE S1,FB$BIB(FB) ;GET BYTES REMAINING
IDIV S1,FB$BPW(FB) ;DIVIDE BY BYTES/WORD
JUMPE S2,OBUF.5 ;JUMP TO SPECIAL CASE IF WORD-ALIGNED
OBUF.1: SOJL P2,.RETT ;RETURN WHEN DONE
ILDB P3,P1 ;ELSE, GET A BYTE
OBUF.2: SOSGE FB$BIB(FB) ;ANY ROOM IN BUFFER?
JRST OBUF.3 ;NO, GET MORE ROOM
IDPB P3,FB$BBP(FB) ;STORE THE BYTE
JRST OBUF.1 ;AND LOOP
OBUF.3: PUSHJ P,PUTBUF ;WRITE OUT THE BUFFER
JUMPF .RETF ;PROPAGATE THE FAILURE
JRST OBUF.2 ;AND TRY AGAIN
;F%OBUF IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;HERE IF CURRENT BUFFER IS WORD ALIGNED
;P1 CONTAINS BYTE POINTER TO USER'S BUFFER
;P2 CONTAINS BYTE COUNT
OBUF.5: IDIV P2,FB$BPW(FB) ;P2 GETS WORD COUNT P3 GET REMAIN BYTES
;NOW LOOP BLT'ING AS MANY OF THE USER'S DATA WORDS AS WILL FIT INTO THE
; FILE BUFFER EACH TIME THRU.
OBUF.6: JUMPE P2,OBUF.8 ;DONE IF NOTHING LEFT TO MOVE
SKIPE S1,FB$BIB(FB) ;ANY ROOM IN BUFFER?
JRST OBUF.7 ;YES, CONTINUE ON
PUSHJ P,PUTBUF ;NO, DUMP IT OUT
JUMPF .RETF ;IF FAILURE, RETURN IT
MOVE S1,FB$BIB(FB) ;NOW GET BYTES REMAINING IN BUFFER
OBUF.7: IDIV S1,FB$BPW(FB) ;GET WORDS REMAINING IN BUFFER
CAML S1,P2 ;IS THERE ENOUGH ROOM FOR ALL USER DATA?
MOVE S1,P2 ;YES, USE DATA COUNT
SUB P2,S1 ;AND UPDATE FOR NEXT ITERATION
MOVN S2,S1 ;GET NEGATIVE WORD COUNT
IMUL S2,FB$BPW(FB) ;GET NEGATIVE BYTE COUNT
ADDM S2,FB$BIB(FB) ;UPDATE BUFFER BYTE COUNT
MOVE S2,FB$BBP(FB) ;GET BUFFER BYTE POINTER
ADDM S1,FB$BBP(FB) ;UPDATE FOR NEXT ITERATION
IBP S2 ;NORMALIZE THE BYTE POINTER
HRL S2,P1 ;MAKE A BLT POINTER
ADD P1,S1 ;UPDATE SOURCE POINTER
ADDI S1,-1(S2) ;GET END OF BLT ADDRESS
BLT S2,(S1) ;MOVE SOME DATA
JRST OBUF.6 ;AND LOOP
OBUF.8: SOJL P3,.RETT ;RETURN WHEN NO MORE BYTES
ILDB S2,P1 ;GET A BYTE
MOVE S1,FB$IFN(FB) ;GET THE IFN
$CALL F%OBYT ;WRITE THE BYTE
JRST OBUF.8 ;AND LOOP
SUBTTL PUTBUF - Give one output buffer to the operating system
;PUTBUF is called from F%OBYT and F%OBUF to write a buffer full of information
; into the output file. It has no explicit input arguments. On True
; return it has no explicit output arguments but it returns with the FB
; fully updated.
;
;False return: S1/ Error code: ERFDE$
TOPS10<
PUTBUF: MOVX TF,FB.BNW ;GET "BYTE NOT WORD" BIT
MOVE S1,FB$BIB(FB) ;GET BYTES REMAINING IN BUFFER
TDNN TF,FB$FLG(FB) ;36-BIT BYTES?
IDIV S1,FB$BPW(FB) ;GET WORDS REMAINING
EXCH S1,FB$BRH+.BFCNT(FB) ;EXCH WITH ORIGNINAL WORD COUNT
SUB S1,FB$BRH+.BFCNT(FB) ;GET NUMBER OF WORDS WRITTEN
TDNE TF,FB$FLG(FB) ;36-BIT BYTES?
IDIV S1,FB$BPW(FB) ;GET WORDS REMAINING
ADDM S1,FB$BRH+.BFPTR(FB) ;UPDATE THE BYTE POINTER
HRL S1,FB$CHN(FB) ;GET THE CHENNEL NUMBER
HRRI S1,.FOOUT ;GET OUTPUT FUNCTION
MOVE S2,[1,,S1] ;SETUP ARG POINTER
FILOP. S2, ;OUTPUT A BLOCK
PJRST MAPIOE ;MAP I/O ERROR
;AND FALL INTO PUTB.1
> ;END TOPS10
TOPS20<
PUTBUF: PUSHJ P,WRTBUF ;WRITE OUT THE BUFFER
JUMPF GETERR ;RETURN FILE DATA ERROR
MOVE S1,FB$BUF(FB) ;GET ADDRESS OF BUFFER
HRLI S1,(POINT ^D36,0) ;MAKE A BYTE POINTER
MOVEM S1,FB$BRH+.BFPTR(FB) ;SAVE BUFFER BYTE POINTER
MOVEI S1,SZ.BUF ;LOAD BUFFER SIZE
MOVEM S1,FB$BRH+.BFCNT(FB) ;AND STORE IT
> ;END TOPS20
PUSHJ P,SETBFD ;SET BUFFER DATA (BBP, BIB)
AOS FB$BFN(FB) ;INCREMENT THE BUFFER NUMBER
$RETT ;AND RETURN
SUBTTL F%CHKP - Checkpoint a file
;F%CHKP is called to checkpoint the current file. If the file is open
; for INPUT, the number of the next byte to be returned to the
; user is returned. If the file is opened for OUTPUT, all internal
; buffers are written out, and all file pointers are updated to
; relect the file's existence. The byte number of the next byte
; to be written is returned.
;
;Call: S1/ IFN
;
;True Return: S1/ Number of next byte
;
;False Return: S1/ Error code: ERFDE$ or MAPERR mapping
F%CHKP: PUSHJ P,CHKIFN ;CHECK OUT THE IFN
MOVE S1,FB$TYP(FB) ;GET DEVICE TYPE
CAXE S1,.TYDSK ;DISK?
JRST [MOVX S1,ERFND$ ;NO, RETURN A 'FILE NOT ON DISK'
PJRST RETERR ]
MOVE S1,FB$MOD(FB) ;GET THE MODE
CAIN S1,FBM$IN ;IS IT INPUT?
JRST CHK.I ;YES, GO HANDLE IT
CAIE S1,FBM$OU ;IS IT OUTPUT
CAIN S1,FBM$AP ;OR APPEND?
JRST CHK.O ;YES, GO HANDLE THAT
CAIN S1,FBM$UP ;IS IT UPDATE
HALT . ;YES, NOT IMPLEMENTED YET!
JRST ILLMOD ;ELSE, ILLEGAL MODE
CHK.I: SETO S1, ;SETUP TO RETURN EOF
SKIPE FB$EOF(FB) ;HIT EOF?
SKIPLE FB$BIB(FB) ;YES, ANYTHING LEFT IN THE BUFFER?
JRST NXTBYT ;GO COMPUTE AND RETURN NEXT BYTE NUMBER
$RETT ;NO, REALLY EOF
CHK.O: $CALL .SAVE1 ;SAVE P1
PUSHJ P,NXTBYT ;GET NEXT BYTE NUMBER
MOVE P1,S1 ;SAVE IT
PUSHJ P,CHKOS ;CHECKPOINT THE OUTPUT
JUMPF .RETF ;FAILED?
MOVE S1,P1 ;GET THE BYTE NUMBER BACK
$RETT ;AND RETURN
NXTBYT: SKIPGE S1,FB$BFN(FB) ;ANY INPUTS DONE YET?
JRST [SETZM S1 ;NO, RETURN BYTE 0
$RETT] ; AND TRUE!
IMUL S1,FB$BPW(FB) ;GET NUMBER OF COMPLETE WORDS
IMULI S1,SZ.BUF ;GET NUMBER OF COMPLETE BUFFERS
MOVE S2,FB$BRH+.BFCNT(FB) ;GET NUMBER OF WORDS ORIGINALLY IN BFR
IMUL S2,FB$BPW(FB) ;CONVERT TO BYTES
SUB S2,FB$BIB(FB) ;GET REMAININDER OF CURRENT BUFFER
ADD S1,S2 ;AND WE HAVE THE ANSWER
$RETT ;SO RETURN
TOPS10<
CHKOS: SKIPL FB$FNC(FB) ;SKIP IF FILE NEEDS CHECKPOINTING
$RETT ;ELSE, JUST RETURN
SETZM FB$FNC(FB) ;NO LONGER NEEDS CHECKPOINTING
$CALL .SAVE1 ;SAVE P1
MOVE P1,FB$BBP(FB) ;GET THE BUFFER BYTE POINTER
HRRZ S1,FB$BRH+.BFADR(FB) ;GET THE BUFFER ADDRESS
SUB P1,S1 ;GET OFFSET INTO BUFFER
MOVE S1,FB$BIB(FB) ;GET BYTES REMAINING IN BUFFER
IDIV S1,FB$BPW(FB) ;GET WORDS REMAINING
EXCH S1,FB$BRH+.BFCNT(FB) ;EXCH WITH ORIGNINAL WORD COUNT
SUB S1,FB$BRH+.BFCNT(FB) ;GET NUMBER OF WORDS WRITTEN
ADDM S1,FB$BRH+.BFPTR(FB) ;UPDATE THE BYTE POINTER
HRL S1,FB$CHN(FB) ;GET THE CHANNEL NUMBER
HRRI S1,.FOURB ;UPDATE RIB FUNCTION
MOVE S2,[1,,S1] ;FILOP ARG POINTER
FILOP. S2, ;DO THE FILOP.
PJRST MAPIOE ;MAP I/O ERROR
MOVE S1,FB$BIB(FB) ;GET BYTES REMAINING IN BUFFER
IDIV S1,FB$BPW(FB) ;GET WORDS REMAINING
SKIPG S1 ;ANY SPACE LEFT ???
PJRST SETBFD ;NO,,RETURN RESETTING BBP AND BIB
HRRZ S1,FB$BRH+.BFADR(FB) ;YES,,GET THE CURRENT BUFFER ADDRESS
ADD P1,S1 ;UPDATE THE BYTE POINTER
MOVEM P1,FB$BBP(FB) ;AND SAVE IT
$RETT ;RETURN
> ;END TOPS10 CONDITIONAL
TOPS20<
CHKOS: SKIPL FB$FNC(FB) ;SKIP IF FILE NEEDS CHECKPOINTING
$RETT ;ELSE, JUST SKIP IT
SETZM FB$FNC(FB) ;DISK IS (WILL BE) UP TO DATE
$CALL .SAVET ;SAVE T REGS
PUSHJ P,WRTBUF ;WRITE THE BUFFER
JUMPF GETERR ;FILE DATA ERROR?
HRLZ S1,FB$JFN(FB) ;GET THE JFN
MOVE S2,FB$BFN(FB) ;GET THE BUFFER NUMBER
ADDI S2,1 ;GET EVERYTHING TILL THIS ONE
UFPGS ;FORCE IT ALL OUT
ERJMP GETERR ;MAP THE ERROR
MOVE S1,FB$JFN(FB) ;GET THE JFN
RFPTR ;READ THE FILE POINTER
ERJMP GETERR ;MAP THE ERROR
MOVE T1,S2 ;SAVE THE SIZE IN T1
HRRZ S1,FB$JFN(FB) ;GET THE JFN
MOVX S2,.FBSIZ ;GET NUMBER OF WORD TO CHANGE
STORE S2,S1,CF%DSP ;STORE IN S1
TXO S1,CF%NUD ;DON'T UPDATE THE DISK
SETOM S2 ;CHANGE ALL BITS
CHFDB ;CHANGE THE FILE LENGTH
ERJMP GETERR ;MAP THE ERROR
HRRZ S1,FB$JFN(FB) ;GET THE JFN
IDIVI T1,PAGSIZ ;GET NUMBER OF PAGES
SKIPE T2 ;ANY LEFT OVER WORDS?
ADDI T1,1 ;YES - ROUND UP
MOVX S2,.FBBYV ;GET NUMBER OF WORD TO CHANGE
STORE S2,S1,CF%DSP ;STORE IN S1
MOVEI S2,44 ;GET THE BYTE SIZE
STORE S2,T1,FB%BSZ ;STORE IN T1
MOVX S2,FB%BSZ!FB%PGC ;PUT MASK IN S2
CHFDB ;CHANGE THE FILE LENGTH
ERJMP GETERR ;MAP THE ERROR
$RETT ;AND RETURN
> ;END TOPS20
SUBTTL WRTBUF - TOPS20 Subroutine to SOUT the current buffer
TOPS20<
;Call: FB$BIB setup
;
;True Return: Buffer SOUTed
;
;False Return: If file data error
WRTBUF: $CALL .SAVET ;SAVE T REGS
MOVE S1,FB$JFN(FB) ;GET THE JFN
MOVE S2,FB$BFN(FB) ;GET THE BUFFER NUMBER
IMULI S2,SZ.BUF ;GET WORD COUNT
JUMPL S2,.RETT ;RETURN IF THIS IS THE DUMMY OUTPUT
SFPTR ;ELSE, SET FILE POINTER
ERJMP .RETF ;CAN'T,,RETURN AN I/O ERROR
SKIPG FB$BIB(FB) ;[67] AT END OF BUFFER
JRST WRTB.2 ;YES..NO PADDING NEEDED
MOVE S1,FB$BBP(FB) ;GET THE BUFFER BYTE POINTER
SETZ S2, ;LOAD A NULL
LOAD T1,S1,BP.POS ;GET THE POSITION FIELD
LOAD T2,S1,BP.SIZ ;GET THE SIZE FIELD
WRTB.1: CAMGE T1,T2 ;IS POS .LT. SIZE
JRST WRTB.2 ;YES, WORD IS FULL
IDPB S2,S1 ;NO, DEPOSIT A NULL
SUB T1,T2 ;POS GETS POS-SIZE
JRST WRTB.1 ;AND LOOP
WRTB.2: MOVE S1,FB$JFN(FB) ;GET THE JFN
MOVE S2,FB$BUF(FB) ;GET ADDRESS OF BUFFER
HRLI S2,(POINT ^D36,0) ;MAKE A BYTE POINTER
SKIPGE T1,FB$BIB(FB) ;GET NUMBER OF BYTES LEFT IN THE BUFFER
SETZB T1,FB$BIB(FB) ;-1 IS ACTUALLY 0
IDIV T1,FB$BPW(FB) ;GET NUMBER OF FULL WORDS LEFT
SUBI T1,SZ.BUF ;GET NEGATIVE NUMBER OF WORDS TO XFER
SOUT ;AND DO THE OUTPUT
ERJMP .RETF ;PROPAGATE FAILURE
$RETT ;ELSE, RETURN
> ;END TOPS20
SUBTTL SETBFD -- Setup Buffer Data
;SETBFD is called to set the current 'user' buffer parameters (i.e.
; FB$BIB, FB$BBP) from the 'operating system' values
; (FB$BRH). No calling parameters, returns with BIB and BBP, setup.
SETBFD: MOVE S1,FB$BRH+.BFPTR(FB) ;GET THE BYTE POINTER
MOVE S2,FB$BYT(FB) ;GET BYTESIZE
DPB S2,[POINT 6,S1,11] ;MAKE THE CORRECT BYTE POINTER
MOVEM S1,FB$BBP(FB) ;STORE THE BUFFER BYTE POINTER
MOVE S1,FB$BRH+.BFCNT(FB) ;GET WORD(BYTE) COUNT AGAIN
MOVX S2,FB.BNW ;GET "BYTE NOT WORD" BIT
TDNN S2,FB$FLG(FB) ;36-BIT BYTES (IMAGE MODE)?
IMUL S1,FB$BPW(FB) ;YES, CONVERT TO BYTES
MOVEM S1,FB$BIB(FB) ;SAVE FOR USER
$RETT ;AND RETURN
SUBTTL F%REN - Rename a file
; CALLS TO F%REN PROVIDE A SOURCE AND DESTINATION NAME.
; THE SOURCE FILE IS RENAMED TO THE NAME SPECIFIED AS THE
; DESTINATION FILE.
; CALL: S1/ LENGTH OF FILE RENAME BLOCK (DESCRIBED IN GLXMAC)
; S2/ ADDRESS OF FRB (FILE RENAME BLOCK)
;
;TRUE RETURN: IF RENAME OPERATION IS SUCCESSFUL
;
;FALSE RETURN: S1/ ERROR CODE
;
; POSSIBLE ERRORS: ERPRT$ ERFNF$ ERFDS$
TOPS10<
F%REN:
;**;[107]ADD AND REVAMP CODE AT F%REN:+0L 12-APR-84/CTK
$SAVE FB ;SAVE THE FB ADDRESS RESGISTER
PUSHJ P,.SAVET ;GET SOME WORK SPACE
PUSHJ P,.SAVE1 ;SAVE P1
MOVE T1,S2 ;GET FRB ADDRESS
MOVE T2,S1 ;AND ITS SIZE INTO PERMANENT PLACES
CAIG T2,FRB.DF ;REQUIRE AT LEAST SOURCE AND
STOPCD (RTS,HALT,,<Rename block too small>)
PUSHJ P,ALCIFN ;ALLOCATE AN IFN
JUMPF .RETF ;PROPOGATE ANY ERROR
MOVE T3,FB ;AND THE FB ADDRESS
MOVE S1,FRB.SF(T1) ;GET FD FOR SOURCE OF RENAME
MOVX S2,FR.PHY ;GET PHYSICAL ONLY BIT
TDNE S2,FRB.FL(T1) ;IS IT SET?
SKIPA S2,[UU.PHS+.IOIMG] ;YES
MOVEI S2,.IOIMG ;NO
MOVEM S2,FB$FUB+.FOIOS(T3) ;ALTHOUGH NONE WILL BE DONE
SKIPN S2,.FDSTR(S1) ;GET STRUCTURE THAT FILE IS ON
MOVSI S2,'DSK'
PUSH P,S2 ;SAVE DEVICE
DEVTYP S2, ;SEE IF ITS A DISK TYPE DEVICE
MOVX S2,.TYDSK ;IF IT FAILS, DONT KICK OUT YET
LOAD TF,S2,TY.DEV ;GET DEVICE TYPE ONLY
CAIE TF,.TYDSK ;DISK?
JRST [ POP P,(P) ;SYNCH STACK
MOVX S1,ERFND$ ;NO, RETURN A 'FILE NOT ON DISK'
PJRST RETERR ] ;
POP P,FB$FUB+.FODEV(T3) ;PUT DEVICE IN FILOP BLOCK
MOVEI S2,FB$LEB(T3) ;GET ADDRESS OF LOOKUP/ENTER AREA
MOVEM S2,FB$FUB+.FOLEB(T3) ;STORE IT TOO
CAIG T2,FRB.US ;IS THIS "IN BEHALF"?
JRST REN.1 ;NO, NO NEED TO SET IT UP
MOVE S2,FRB.US(T1) ;GET USER ID (PPN)
MOVEM S2,FB$FUB+.FOPPN(T3) ;STORE IT
REN.1: CAIG T2,FRB.AB ;FOB CONTAIN ATTRIBUTE BLOCK POINTER?
TDZA P1,P1 ;NOPE
MOVE P1,FRB.AB(T1) ;GET ATTRIBUTE BLOCK ADDRESS
;**;[110]DELETE 2 LINES AT REN.1:+3L 10-MAY-84/CTK
PUSHJ P,LDLEB ;LOAD THE LOOKUP/ENTER BLOCK FROM FD
PUSHJ P,ALCIFN ;ALLOCATE ANOTHER IFN
JUMPF REN.5 ;[107]PASS ERROR, RELEASING FIRST IFN
;F%REN IS CONTINUED ON THE FOLLOWING PAGE
;CONTINUED FROM PREVIOUS PAGE
;**;[110]ADD 1 LINES AT REN.1:+7 10-MAY-84/CTK
MOVE S2,FB$LEB+.RBPPN(T3) ;[110]SAVE THE PATH POINTER
MOVE S1,[FO.ASC+FO.PRV+.FORED] ;[107]PRIV'S, CHANNEL, READ-IN
MOVEM S1,FB$FUB+.FOFNC(T3) ;[107]STORE INTO FUNCTION WORD
HRLI S1,.FOMAX ;[107]SET LENGTH OF BLOCK
HRRI S1,FB$FUB(T3) ;[107]AND ITS ADDRESS
FILOP. S1, ;[107]DO THE LOOKUP
JRST REN.4 ;[107]PASS ERROR, RELEASING FIRST IFN
;**;[110]ADD 7 LINES AT REN.1:+15 10-MAY-84/CTK
MOVEM S2,FB$LEB+.RBPPN(T3) ;[110]RESTORE THE PATH POINTER
LOAD S1,FB$FUB+.FOFNC(T3),FO.CHN ;[110]GET THE CHANNEL
HRL S2,S1 ;[110]LOAD THE CHANNEL NUMBER
HRRI S2,.FOREL ;[110]GET RELEASE FUNCTION
MOVE S1,[1,,S2] ;[110]GET ARG POINTER
FILOP. S1, ;[110]RELEASE THE CHANNEL
JFCL ;[110]CAN'T CARE ABOUT ERRORS
HRLI S1,FB$LEB(T3) ;[107]POINT TO THE LOOKUP/ENTER BLOCK
HRRI S1,FB$LEB(FB) ;[107]POINT TO THE RENAME BLOCK
MOVEI S2,FB$LEB+.RBMAX-1(FB) ;[107]LET'S GET THE ENDING ADDRESS
BLT S1,(S2) ;[107]NOW FILL IN THE RENAME BLOCK
;**;[111]ADD 4 LINES AT REN.1:+24 19-OCT-84/CTK
EXCH T3,FB ;[111]LET'S RESET UP THE LOOK UP BLOCK
MOVE S1,FRB.SF(T1) ;[111]TO HANDLE RENAMES FROM SFDS
PUSHJ P,LDLEB ;[111]LOAD THE LOOK/ENTER AREA
EXCH T3,FB ;[111]AND RESTORE THE AC'S
JUMPE P1,REN.2 ;ANY ATTRIBUTES?
MOVEM P1,FB$PTR(FB) ;SET ATTRIBUTE BLOCK ADDR IN NEW FB
HRRZ P1,(P1) ;GET WORD COUNT
MOVEM P1,FB$CNT(FB) ;SET ATTRIBUTE BLOCK COUNT IN NEW FB
REN.2: MOVEI S2,FB$LEB(FB) ;GET ADDRESS OF 2ND LEB
HRLM S2,FB$FUB+.FOLEB(T3) ;STORE AS LH OF 1ST .FOLEB POINTER
MOVE S1,FRB.DF(T1) ;NOW GET 2ND FD ADDRESS
PUSHJ P,LDLEB ;LOAD THE LOOKUP/ENTER AREA
PUSHJ P,ATTRIB ;SET FILE ATTRIBUTES
MOVE S1,[FO.ASC+FO.PRV+.FORNM] ;[107]PRIV'S, CHANNEL, RENAME FUNCTION
MOVEM S1,FB$FUB+.FOFNC(T3) ;STORE INTO FUNCTION WORD
HRLI S1,.FOMAX ;SET LENGTH OF BLOCK
HRRI S1,FB$FUB(T3) ;AND ITS ADDRESS
FILOP. S1, ;DO THE RENAME
JRST REN.4 ;FAILED...
REN.3: LOAD S1,FB$FUB+.FOFNC(T3),FO.CHN ;GET THE CHANNEL
MOVEM S1,FB$CHN(T3) ;REMEMBER FOR RELEASE
MOVE S1,FB$IFN(T3) ;GET THE FIRST IFN
$CALL F%RREL ;AND RELEASE IT
MOVE S1,FB$IFN(FB) ;GET THE SECOND IFN
$CALL F%RREL ;RELEASE IT
$RETT ;AND RETURN
REN.4: PUSH P,S1 ;SAVE ERROR CODE
PUSHJ P,REN.3 ;RELEASE THE IFNS
POP P,S1 ;RESTORE ERROR CODE
PJRST MAPERR ;RETURN, AFTER MAPPING ERROR
REN.5: PUSH P,S1 ;SAVE ERROR CODE
MOVE S1,FB$IFN(T3) ;GET FIRST IFN
$CALL F%REL ;AND RELEASE IT
POP P,S1 ;RESTORE ERROR CODE
$RETF ;PROPAGATE ERROR
> ;END OF TOPS10 CONDITIONAL
TOPS20<
F%REN: PUSHJ P,.SAVET ;GET SOME WORK SPACE
PUSHJ P,.SAVE2 ;SAVE P1
CAIG S1,FRB.DF ;REQUIRE AT LEAST SOURCE AND DEST.
STOPCD (RTS,HALT,,<Rename block too small>)
CAIGE S1,FRB.FL ;ANY FLAG WORD ???
TDZA T2,T2 ;NO, FILL IT WITH ZERO
LOAD T2,FRB.FL(S2),FR.NFO ;ELSE PICK UP 'NEW FILE ONLY' BIT
MOVE T4,FRB.DF(S2) ;REMEMBER THE DESTINATION
MOVX P1,FR.PHY ;GET PHYSICAL ONLY BIT
TDNN P1,FRB.FL(S2) ;IS IT SET?
TDZA P1,P1 ;NOPE
MOVEI P1,FB.PHY ;GET FOB BIT
MOVEM P1,F$FOB+FOB.CW ;STORE SOMETHING
PUSHJ P,SETFOB ;SET UP INTERNAL FOB
PUSHJ P,F%IOPN ;OPEN THE FILE FOR INPUT
JUMPF .RETF ;IF IT FAILS, GIVE UP NOW
MOVEM S1,T1 ;REMEMBER SOURCE IFN
MOVEM T4,F$FOB+FOB.FD ;REPLACE SOURCE FD WITH DESTINATION FD
STORE T2,F$FOB+FOB.CW,FB.NFO ;SET 'NEW FILE ONLY' FLAG
MOVEI S1,FOB.SZ ;AND SET UP FOR USE OF THE
MOVEI S2,F$FOB ;INTERNAL FOB
PUSHJ P,F%OOPN ;MAKE IT OUTPUT SO PROTECTION IS CHECKED
JUMPF REN.31 ;ON ERROR, RELEASE FIRST IFN AND PROPAGATE
MOVEM S1,T2 ;REMEMBER DESTINATION IFN
MOVE T3,IFNTAB(T1) ;GET FB OF SOURCE
MOVE T4,IFNTAB(T2) ;AND OF DESTINATION
SKIPN FB$CHK+.CKACD(T3) ;IS THIS IN SOMEONES BEHALF?
JRST REN.2 ;NO
MOVX S1,.CKACN ;YES, SEE IF WE COULD CONNECT
MOVEM S1,FB$CHK+.CKAAC(T3) ;BECAUSE WE WILL "DELETE" THE
MOVX S1,CK%JFN+.CKAUD+1 ;FILE BY RENAMING IT
MOVEI S2,FB$CHK(T3) ;AND THATS MORE THAN JUST READING IT
CHKAC ;ASK MONITOR
SETZM S1 ;RETURN PROTECTION FAILURE
JUMPE S1,[ MOVX S1,OPNX3 ;RETURN A PROTECTION FAILURE
JRST REN.4 ] ;TO CALLER
REN.2: MOVE S1,FB$JFN(T3) ;GET JFN OF SOURCE FILE
TXO S1,CO%NRJ ;KEEP THE JFN AFTER CLOSING
CLOSF ;CLOSE THE FILE
ERJMP REN.4 ;RETURN ERROR
MOVE S1,FB$JFN(T4) ;GET SOURCE JFN
TXO S1,CO%NRJ ;KEEP THE JFN AFTER CLOSING
CLOSF ;CLOSE DESTINATION TOO
ERJMP REN.4 ;MAP ERROR, RETURN
MOVE S1,FB$JFN(T3) ;SET SOURCE FOR RENAME
MOVE S2,FB$JFN(T4) ;SET DESTINATION TOO
RNAMF ;RENAME THE FILE
ERJMP REN.4 ;RETURN ERROR
EXCH FB,T4 ;SWAP CUZ EVERYONE BELEIVES IN 'FB'
PUSHJ P,ATTRIB ;PROCESS ATTRIBUTE BLOCK
EXCH T4,FB ;RESET THINGS
MOVE S1,FB$JFN(T4) ;GET DESTINATION JFN
RLJFN ;AND RELEASE IT NOW
ERJMP REN.4 ;IF IT FAILS, COMPLAIN
REN.3: MOVE S1,T1 ;SETUP SOURCE IFN
$CALL F%RREL ;AND RELEASE IT
MOVE S1,T2 ;AND DESTINATION IFN
$CALL F%RREL ;AND RELEASE IT
$RETT ;AND RETURN
REN.31: PUSH P,S1 ;SAVE ERROR CODE
MOVE S1,T1 ;GET SOURCE IFN
$CALL F%REL ;AND RELEASE IT
POP P,S1 ;RESTORE ERROR CODE
$RETF ;PROPAGATE ERROR
REN.4: PUSH P,S1 ;SAVE ERROR CODE
PUSHJ P,REN.3 ;RELEASE ALL IFN'S
POP P,S1 ;RESTORE ERROR CODE
PJRST MAPERR ;RETURN, MAPPING THE ERROR
> ;END OF TOPS20 CONDITIONAL
SUBTTL F%REL - Release a file
;F%REL CLOSES THE FILE AND RELEASE THE IFN.
;CALL: S1/ IFN
;
;TRUE RETURN: IF FILE HAS BEEN CLOSED SUCCESSFULLY.
; NOTE: FILE IS RELEASED (I.E. IFN MADE INVALID) EVEN IF AN ERROR IS
; RETURNED.
;
;FALSE RETURN: S1/ERROR CODE
;
; POSSIBLE ERRORS: ERFDE$
TOPS10<
F%RREL: PUSHJ P,CHKIFN ;CHECK THE IFN
SKIPGE FB$CHN(FB) ;WAS IT EVER OPENED?
PJRST RELFB ;NO..JUST RELEASE THE FB
$CALL .SAVE2 ;SAVE P1 - P2
HRL P1,FB$CHN(FB) ;GET CHANNEL NUMBER
HRRI P1,.FOCLS ;GET CLOSE FUNCTION
MOVX P2,CL.RST ;GET CLOSE BITS
MOVE S1,[2,,P1] ;GET FILOP. ARG POINTER
FILOP. S1, ;AND RESET THE CHANNEL
PJRST DREL.2 ;FAILED,,PASS ERROR CODE BACK
JRST INTREL ;RELEASE THE CHANNEL
F%REL: PUSHJ P,CHKIFN ;CHECK THE IFN
SKIPGE FB$CHN(FB) ;WAS FILE EVER OPENED?
PJRST RELFB ;NO..JUST RELEASE THE FB
MOVE S1,FB$BIB(FB) ;GET BYTES REMAINING IN BUFFER
IDIV S1,FB$BPW(FB) ;GET WORDS REMAINING
EXCH S1,FB$BRH+.BFCNT(FB) ;EXCH WITH ORIGNINAL WORD COUNT
SUB S1,FB$BRH+.BFCNT(FB) ;GET NUMBER OF WORDS WRITTEN
ADDM S1,FB$BRH+.BFPTR(FB) ;UPDATE THE BYTE POINTER
INTREL: HRL S1,FB$CHN(FB) ;GET THE CHANNEL
HRRI S1,.FOREL ;GET RELEASE FUNCTION
MOVE S2,[1,,S1] ;GET ARG POINTER
FILOP. S2, ;RELEASE THE CHANNEL
SETOM S1 ;SET ERROR INDICATOR
PUSH P,S2 ;SAVE POSSIBLE I/O ERROR BITS
PUSHJ P,RELFB ;IN ANY CASE RELEASE THE FILE DATA BASE
POP P,S2 ;RESTORE S2
CAMN S1,[-1] ;DID AN ERROR OCCUR ???
PJRST MAPIOE ;MAP I/O ERROR
$RETT ;NO,,JUST RETURN
> ;END TOPS10
TOPS20<
F%REL: PUSHJ P,CHKIFN ;VALIDATE THE IFN ETC.
MOVE S1,FB$IFN(FB) ;PUT THE IFN IN S1
$CALL F%CHKP ;AND CHECKPOINT THE FILE
INTREL: MOVE S1,FB$JFN(FB) ;GET THE JFN
CLOSF ;GET RID OF IT
JRST INTR.1 ;PROCESS THE ERROR
JRST RELFB ;AND DELETE THE FB
INTR.1: MOVE S1,FB$JFN(FB) ;GET THE JFN
RLJFN ;RELEASE THE JFN
JRST .+1 ;IGNORE THE ERROR
JRST RELFB ;AND DELETE THE FB
F%RREL: PUSHJ P,CHKIFN ;VALIDATE THE IFN ETC.
MOVE S1,FB$JFN(FB) ;GET THE JFN
TXO S1,CZ%ABT ;ABORT THE OPERATION
CLOSF ;CLOSE THE FILE
ERJMP .+1 ;IGNORE THE ERROR
JRST RELFB ;AND DELETE THE FB
> ;END TOPS20
SUBTTL F%DREL - Delete a file and release it
;CALL: S1/ IFN
;
;TRUE RETURN: IF DELETION COULD BE ACCOMPLISHED
;
;FALSE RETURN: S1/ ERROR CODE
;
;POSSIBLE ERRORS: ERPRT$ ERUSE$
TOPS10<
F%DREL: PUSHJ P,CHKIFN ;CHECK FOR LEGAL IFN
MOVE S1,FB$TYP(FB) ;GET DEVICE TYPE
CAXE S1,.TYDSK ;DISK?
JRST [MOVX S1,ERFND$ ;NO, RETURN A 'FILE NOT ON DISK'
PJRST RETERR ]
HRL S1,FB$CHN(FB) ;GET CHANNEL NUMBER
HRRI S1,.FOCLS ;GET CLOSE FUNCTION
MOVE S2,[1,,S1] ;GET FILOP. ARG POINTER
FILOP. S2, ;AND CLOSE THE FILE
JFCL ;IGNORE ERROR
HRLZ S1,FB$CHN(FB) ;GET CHANNEL NUMBER
IORX S1,<FO.PRV+.FODLT> ;LITE PRIV+DELETE FUNCTION
MOVEM S1,FB$FUB+.FOFNC(FB) ;SAVE IT IN THE FILOP BLOCK
SETZM FB$FUB+.FONBF(FB) ;NO BUFFERS
SETZM FB$FUB+.FOBRH(FB) ;NO BUFFER RING HEADER
PUSHJ P,.SAVET ;SAVE T1-T4, BECAUSE WE'RE
SETZB T1,T2 ; GOING TO ZERO ALL OF THEM
SETZB T3,T4 ; TO PROVIDE A ZEROED RENAME BLOCK
MOVEI S1,T1 ;GET THE BLOCK'S ADDRESS
HRLM S1,FB$FUB+.FOLEB(FB) ;...AND PUT IT IN THE FILOP. BLOCK
MOVSI S1,.FOMAX ;GET FILOP BLOCK LENGTH
HRRI S1,FB$FUB(FB) ;AND ADDRESS
FILOP. S1, ;AND DELETE THE FILE
JRST DREL.2 ;IT FAILED!
PJRST INTREL ;RELEASE IFN AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20<
F%DREL: PUSHJ P,CHKIFN ;VALIDATE THE IFN
SKIPN FB$CHK+.CKACD(FB) ;SHOULD WE CHECK PROTECTION?
JRST DREL.1 ;NO
MOVX S2,.CKAWR ;SEE IF WE COULD WRITE THE FILE
MOVEM S2,FB$CHK+.CKAAC(FB) ;SAVE IN CHKAC BLOCK
MOVEI S2,FB$CHK(FB) ;ADDRESS OF CHKAC BLOCK
MOVX S1,CK%JFN+.CKAUD+1 ;LENGTH OF CHKAC BLOCK
CHKAC ;CHECK THE ACCESS
SETZM S1 ;RETURN PROTECTION FAILURE
JUMPE S1,[ MOVX S2,OPNX3 ;LOAD A PROTECTION FAILURE
JRST DREL.2 ] ;AND CONTINUE
DREL.1: MOVE S1,FB$JFN(FB) ;GET THE JFN
TXO S1,CO%NRJ ;DONT RELEASE THE JFN
CLOSF ;CLOSE THE FILE
JRST DREL.2 ;ERROR CHECK
MOVX S1,DF%EXP ;SET EXPUNGE FILE BIT
HRR S1,FB$JFN(FB) ;GET JFN FROM ADDRESS
DELF ;DELETE THE FILE
ERJMP DREL.2 ;FAILED, EXAMINE IT
PJRST RELFB ;RELEASE FB BLOCK
> ;END OF TOPS20 CONDITIONAL
DREL.2: PUSH P,S1 ;SAVE ERROR CODE
PUSHJ P,INTREL ;RETURN MEMORY
POP P,S1 ;GET FAILURE CODE
PJRST MAPERR ;RETURN AFTER MAPPING TO GALAXY ERROR
SUBTTL F%DEL - Delete an unopened file
;F%DEL is used to delete a file that has not been opened.
;In actuality, this routine opens the file and then closes it with delete.
;CALL IS: S1/ Size of the FOB
; S2/ Address of the FOB (See GLXMAC for FOB description)
;
;TRUE RETURN: If file deletion has been successful
;
;FALSE RETURN: S1/ Error code if file can not be deleted.
F%DEL: PUSHJ P,SETFOB ;USE INTERNAL FOB TO BUILD DEFAULTS
PUSHJ P,F%AOPN ;OPEN THE FILE UP (APPEND MEANS WRITE ACCESS)
JUMPF .RETF ;IF IT FAILS, PASS IT ON
PJRST F%DREL ;DELETE THE FILE, PASS ON ANY FAILURE
SUBTTL F%INFO - Return system information about a file
; F%INFO WILL RETURN INFORMATION FROM EITHER THE FDB OR THE LOOKUP/ENTER BLOCK
; BASED ON THE CANONICAL FILE INFORMATION TOKEN PASSED AS THE INPUT
; ARGUMENT.
; CALL: S1/ IFN
; S2/ CANONICAL FILE INFORMATION DESCRIPTOR (SEE GLXMAC)
;
; RETURN: S1/ CONTENTS OF DESIRED WORD
F%INFO: PUSHJ P,CHKIFN ;VALIDATE INTERNAL FILE NUMBER
SKIPL S2 ;INSURE THAT ARGUMENT IS IN RANGE
CAIL S2,LEN.FI ;OF AVAILABLE DATA
STOPCD (UFI,HALT,,<Unknown File Information Descriptor>)
XCT FITAB(S2) ;FETCH THE INFORMATION
$RETT ;AND TAKE A GOOD RETURN
; MAKE UP THE SYSTEM-DEPENDENT TABLE FOR FETCHING VALUES
SYSPRM FINF,FB$LEB,FB$FDB ;BASE OF FILE INFORMATION
SYSPRM XX.CRE,<$CALL FTINFO>,<MOVE S1,FINF+.FBCRV(FB)>
SYSPRM XX.GEN,<MOVE S1,FINF+.RBVER(FB)>,<LDB S1,[POINTR(FINF+.FBGEN(FB),FB%GEN)]>
SYSPRM XX.PRT,<LDB S1,[POINTR(FINF+.RBPRV(FB),RB.PRV)]>,<LDB S1,[POINTR(FINF+.FBPRT(FB),RHMASK)]>
SYSPRM XX.CLS,<SETZM S1>,<LDB S1,[POINTR(FINF+.FBCTL(FB),FB%FCF)]>
SYSPRM XX.AUT,<MOVE S1,FINF+.RBAUT(FB)>,<LDB S1,[POINTR(FINF+.FBUSE(FB),RHMASK)]>
SYSPRM XX.USW,<MOVE S1,FINF+.RBNCA(FB)>,<MOVE S1,FINF+.FBUSW(FB)>
SYSPRM XX.SPL,<MOVE S1,FINF+.RBSPL(FB)>,<SETZM S1>
XX.SIZ==< PUSHJ P,[EXP <MOVE S1,FB$WRD(FB)>,<IMUL S1,FB$BPW(FB)>,<POPJ P,>]>
SYSPRM XX.MOD,<LDB S1,[POINTR(FINF+.RBPRV(FB),RB.MOD)]>,<LDB S1,[POINTR(FINF+.FBBYV(FB),FB%MOD)]>
SYSPRM XX.CHN,<MOVE S1,FB$CHN(FB)>,<MOVE S1,FB$JFN(FB)>
SYSPRM XX.ACT,<MOVEI S1,FINF+.RBACT(FB)>,<> ;ACCOUNT STRING
SYSPRM XX.CRY,<$CALL FIATRB>,<> ;ENCRYPTION CODE
SYSPRM XX.DTY,<$CALL FIATRB>,<> ;DATA TYPE
SYSPRM XX.DTO,<$CALL FIATRB>,<> ;DATA "OTS" TYPE
SYSPRM XX.DCC,<$CALL FIATRB>,<> ;DATA CARRIAGE CONTROL
SYSPRM XX.BSZ,<$CALL FIATRB>,<> ;LOCAL DATA BYTE SIZE
SYSPRM XX.FSZ,<$CALL FIATRB>,<> ;PHYSICAL DATA FRAME SIZE
SYSPRM XX.HSZ,<$CALL FIATRB>,<> ;FIXED-HEADER SIZE
SYSPRM XX.RFM,<$CALL FIATRB>,<> ;RECORD FORMAT
SYSPRM XX.RFO,<$CALL FIATRB>,<> ;RECORD FORMAT ORGANIZATION
SYSPRM XX.RSZ,<$CALL FIATRB>,<> ;RECORD SIZE
SYSPRM XX.BLS,<$CALL FIATRB>,<> ;BLOCK SIZE (BYTES)
SYSPRM XX.FFB,<$CALL FIATRB>,<> ;FIRST FREE BYTE WITHIN LAST BLOCK
SYSPRM XX.ACW,<$CALL FIATRB>,<> ;APPLICATION-SPECIFIC FIELD
SYSPRM XX.RMS,<$CALL FIATRB>,<> ;RMS-10 FORMATTED FILE
SYSPRM XX.MCY,<$CALL FIATRB>,<> ;MACY11 FORMATTED FILE
SYSPRM XX.CTG,<$CALL FIATRB>,<> ;CONTIGUOUS ALLOCATION
SYSPRM XX.NSB,<$CALL FIATRB>,<> ;RECORDS DON'T SPAN PHYSICAL BLOCKS
SYSPRM XX.ACD,<LDB S1,[POINTR FINF+.RBEXT(FB),RB.ACD]>,<> ;ACCESS DATE
SYSPRM XX.MTA,<MOVE S1,FINF+.RBMTA(FB)>,<> ;TAPE LABEL
SYSPRM XX.STS,<MOVE S1,FINF+.RBSTS(FB)>,<> ;FILE STATUS BITS
SYSPRM XX.IDT,<MOVE S1,FINF+.RBIDT(FB)>,<> ;BACKUP INCREMENTAL DATE/TIME
SYSPRM XX.PCA,<MOVE S1,FINF+.RBPCA(FB)>,<> ;PRIVILEGED CUSTOMER WORD
SYSPRM XX.TIM,<MOVE S1,FINF+.RBTIM(FB)>,<> ;PHYSICAL CREATION DATE/TIME
SYSPRM XX.LAD,<MOVE S1,FINF+.RBLAD(FB)>,<> ;LAST ACCOUNTING DATE
SYSPRM XX.EXP,<MOVE S1,FINF+.RBDED(FB)>,<> ;EXPIRATION DATE
DEFINE X(A)<
EXP < XX.'A>
> ;END OF X DEFINITION
FITAB: CFI
LEN.FI==.-FITAB
RDHTAB: ;FILE ATTRIBUTE RIB WORDS
TOPS10 <
LOAD S1,FB$LEB+.RBTYP(FB),RB.CRY ;ENCRYPTION CODE
LOAD S1,FB$LEB+.RBTYP(FB),RB.DTY ;DATA TYPE
LOAD S1,FB$LEB+.RBTYP(FB),RB.DTO ;DATA "OTS" TYPE
LOAD S1,FB$LEB+.RBTYP(FB),RB.DCC ;DATA CARRIAGE CONTROL
LOAD S1,FB$LEB+.RBBSZ(FB),RB.BSZ ;LOCAL DATA BYTE SIZE
LOAD S1,FB$LEB+.RBBSZ(FB),RB.FSZ ;PHYSICAL FRAME SIZE
LOAD S1,FB$LEB+.RBBSZ(FB),RB.HSZ ;FIXED-HEADER SIZE
LOAD S1,FB$LEB+.RBBSZ(FB),RB.RFM ;RECORD FORMAT
LOAD S1,FB$LEB+.RBBSZ(FB),RB.RFO ;REC FORMAT ORGANIZATION
LOAD S1,FB$LEB+.RBRSZ(FB),RB.RSZ ;RECORD SIZE (BYTES)
LOAD S1,FB$LEB+.RBRSZ(FB),RB.BLS ;BLOCK SIZE (BYTES)
LOAD S1,FB$LEB+.RBFFB(FB),RB.FFB ;FIRST FREE BYTE
LOAD S1,FB$LEB+.RBFFB(FB),RB.ACW ;APPLICATION FIELD
LOAD S1,FB$LEB+.RBTYP(FB),RB.RMS ;RMS-10 FORMATTED FILE
LOAD S1,FB$LEB+.RBTYP(FB),RB.MCY ;MACY11 FORMATTED FILE
LOAD S1,FB$LEB+.RBTYP(FB),RB.CTG ;CONTIGUOUS ALLOCATION
LOAD S1,FB$LEB+.RBTYP(FB),RB.NSB ;/NOSPAN PHY BLOCKS
RD.LEN==.-RDHTAB
FTINFO: LOAD S2,FINF+.RBPRV(FB),RB.CRD ;Get low order bits of 15 bit
; creation date
LOAD S1,FINF+.RBEXT(FB),RB.CRX ;Get the higher order 3 bits
DPB S1,[POINT 3,S2,23] ;Put date together in S2
LOAD S1,FINF+.RBPRV(FB),RB.CRT ;Get minutes since midnight
IMULI S1,^D60000 ;Make it milliseconds
$CALL CNVDT## ;Convert to internal date time
$RET
FIATRB: LOAD S1,FB$LEB+.RBTYP(FB),RB.DEC ;Get the attributes valid bit
JUMPE S1,.RETF ;If not valid, return error now
XCT RDHTAB-FI.CRY(S2) ;Get value user requested from the rib
$RETT
> ; END OF TOPS10 CONDITIONAL
SUBTTL F%FD - Return a pointer to the FD on an opened IFN
;CALL: S1/IFN
; S2/0 ;TO OBTAIN ORIGINAL FD, PERHAPS WITH
;WILDCARDS
; OR
; S2/-1 ;TO OBTAIN CURRENT FD, I.E. ACTUAL FILE
; ;SPECIFICATION
;
;TRUE RETURN: S1/LOCATION OF THE FIRST WORD OF THE FD CURRENTLY
; ASSOCIATED WITH THE IFN.
; TRUE RETURN IS ALWAYS GIVEN
;
F%FD: PUSHJ P,CHKIFN ;VALIDATE THE INTERNAL FILE NUMBER
CAIG S2,0 ;IF 0, WANT MASTER FD
CAMGE S2,[EXP -1] ; IF -1, WANT CURRENT FD
STOPCD (FIT,HALT,,<FD location requested with illegal type>)
MOVE S1,FB ;GET BASE ADDRESS OF FILE BLOCK
ADD S1,[EXP FB$RFD,FB$FD]+1(S2) ;POINT TO REQUESTED FD
$RETT ;RETURN, S1 HAS FD LOCATION
SUBTTL F%FCHN - Find first free channel
;F%FCHN is used on the TOPS-10 operating system to find the lowest I/O
; channel that is not in use. This routine does not allocate the
; channel and the channel must be OPENed before the next F%FCHN call.
;CALL IS: No arguments
;
;TRUE RETURN: S1/ Number of lowest channel not OPENed or INITed
;FALSE RETURN: All channels are in use
F%FCHN:
TOPS10<
MOVSI S1,-20 ;20 CHANNELS ARE AVAILABLE (0-17)
FCHN.1: HRRZ S2,S1 ;GET CHANNEL NUMBER
DEVCHR S2, ;DO A DEVICE CHARACTERISTICS CHECK
SKIPE S2 ;IF ZERO, NOT OPENED YET
AOBJN S1,FCHN.1 ;LOOP FOR ALL OF THEM
JUMPGE S1,[$RETE(SLE)] ;TAKE FALSE RETURN IF ALL TRIED
ANDI S1,-1 ;GET DOWN TO JUST CHANNEL NUMBER
> ;END OF TOPS10 CONDITIONAL
$RETT ;AND RETURN
SUBTTL ALCIFN - Allocate an Internal File Number
;CALL: NO ARGUMENTS
;
;TRUE RETURN: FB/ ADRESS OF THE FILE BLOCK
;
;FALSE RETURN: S1/ERROR CODE
;
ALCIFN: PUSHJ P,.SAVE1 ;SAVE P1
MOVSI P1,-SZ.IFN ;MAKE AOBJN POINTER FOR LOOP
HRRI P1,1 ;AND START AT 1
ALCI.1: SKIPE IFNTAB(P1) ;CHECK THE TABLE
AOBJN P1,ALCI.1 ;NOT THIS ENTRY SO, LOOP
JUMPGE P1,[ $RETE(SLE) ] ;SYSTEM LIMIT ON FILES EXCEEDED
MOVEI S1,FB$END ;GET FB SIZE
$CALL M%GMEM ;GET THE MEMORY
MOVEM S2,IFNTAB(P1) ;STORE ADDRESS IN TABLE
MOVE FB,S2 ;SETUP FB REGISTER
HRRZM P1,FB$IFN(FB) ;SAVE THE IFN
TOPS10 <
SETOM FB$CHN(FB) ;VIRGINIZE CHANNEL NUMBER
> ;End TOPS10
$CALL M%GPAG ;GET A BUFFER PAGE
MOVEM S1,FB$BUF(FB) ;SAVE THE ADDRESS
$RETT ;AND TAKE A GOOD RETURN
SUBTTL RELFB - Release a File Block
;CALL IS: S1/ Index into IFNTAB to release
;
;TRUE RETURN: Always
RELFB: MOVE S1,FB$BUF(FB) ;GET ADDRESS OF BUFFER PAGE
$CALL M%RPAG ;RETURN THE PAGE
MOVE S1,FB$IFN(FB) ;GET THE IFN
SETZM IFNTAB(S1) ;CLEAR THE IFN TABLE ENTRY
MOVEI S1,FB$END ;GET A LENGTH
MOVE S2,FB ;AND AN ADDRESS
$CALL M%RMEM ;RETURN THE MEMORY
$RETT ;AND RETURN
SUBTTL GETERR - Get Last -20 error to MAP it
TOPS20 <
;This routine is either ERJMP'ed or JRST'ed to as a result
;of a JSYS error involving some file manipulation. The
;error code for the JSYS error is retrieved from the monitor
;and saved in case the user does an ^E/[-1]/ or stopcodes.
;The error code returned to the user is 'File Data Error'
GETERR: MOVEI S1,.FHSLF ;USE MY HANDLE
GETER ;GET THE LAST ERROR CODE
HRRZ S1,S2 ;GET THE ERROR AND FALL INTO MAPERR
JRST MAPERR ;MAP THE ERROR
>;END TOPS20
SUBTTL MAPERR - Map an operating system error
;ROUTINE TO MAP AN OPERATING SYSTEM ERROR INTO A GALAXY ERROR.
; CALL WITH ERROR CODE IN S1 AND RETURN FALSE WITH GALAXY
; ERROR CODE IN S1.
;
MAPERR: PUSHJ P,.SAVE1 ;GET ONE SCRATCH AC
MOVSI S2,-ERRLEN ;GET -VE LEN OF TABLE
MAPE.1: HLRZ P1,ERRTAB(S2) ;GET A SYSTEM CODE
CAMN P1,S1 ;IS IT OURS?
JRST MAPE.2 ;YES, WIN
AOBJN S2,MAPE.1 ;NO, LOOP
TOPS20 <MOVEM S1,.LGERR## ;SAVE THE ERROR CODE FOR TOPS20
MOVEI S1,ERUSE$ ;GET UNEXPECTED ERROR CODE
$RETF ;RETURN IT TO THE USER
>;END TOPS20
TOPS10 <$RETE(USE)> ;IF EXHAUSTED, RETURN 'UNEXPECTED ERROR'
MAPE.2: HRRZ S1,ERRTAB(S2) ;PICK UP THE ERROR CODE
MOVEM S1,.LGERR## ;STORE ERROR CODE IN CASE OF STOP
MOVEI S2,. ;ALSO OUR CURRENT LOCATION
MOVEM S2,.LGEPC## ;FOR LATER EXAMINATION
$RETF ;THEN TAKE A FAILURE RETURN
TOPS10<
ERRTAB: XWD ERFNF%, ERFNF$
XWD ERIPP%, ERIPP$
XWD ERPRT%, ERPRT$
XWD ERFBM%, ERFBM$
XWD ERAEF%, ERFAE$
XWD ERTRN%, ERTRN$
XWD ERDNA%, ERDNA$
XWD ERNSD%, ERNSD$
XWD ERNRM%, ERQEF$
XWD ERWLK%, ERWLK$
XWD ERNET%, ERSLE$
XWD ERCSD%, ERCSD$
XWD ERDNE%, ERCDD$
XWD ERSNF%, ERSNF$
XWD ERSLE%, ERESL$
XWD ERLVL%, ERLVL$
XWD ERNCE%, ERCCW$
XWD ERFCU%, ERFCU$
XWD ERENQ%, ERENQ$
ERRLEN==.-ERRTAB
> ;END TOPS10 CONDITIONAL
TOPS20<
ERRTAB: XWD DESX8, ERFND$
XWD GJFX3, ERSLE$
XWD GJFX4, ERIFS$
XWD GJFX5, ERIFS$
XWD GJFX6, ERIFS$
XWD GJFX7, ERIFS$
XWD GJFX8, ERIFS$
XWD GJFX16, ERNSD$
XWD GJFX17, ERFNF$
XWD GJFX18, ERFNF$
XWD GJFX19, ERFNF$
XWD GJFX20, ERFNF$
XWD GJFX22, ERSLE$
XWD GJFX23, ERSLE$
XWD GJFX24, ERFNF$
XWD GJFX27, ERFAE$
XWD GJFX28, ERDNA$
XWD GJFX29, ERDNA$
XWD GJFX35, ERPRT$
XWD OPNX2, ERFNF$
XWD OPNX3, ERPRT$
XWD OPNX4, ERPRT$
XWD OPNX7, ERDNA$
XWD OPNX8, ERDNA$
XWD OPNX10, ERQEF$
XWD OPNX23, ERQEF$
XWD OPNX25, ERPRT$
XWD RNAMX1, ERFDS$
XWD RNAMX3, ERPRT$
XWD RNAMX4, ERQEF$
XWD RNAMX8, ERPRT$
XWD IOX11, ERQEF$
ERRLEN==.-ERRTAB
> ;END TOPS20 CONDITIONAL
SUBTTL MAPIOE - Map an I/O error
; Routine to map I/O error bits into a Galaxy error code
; S2:= I/O status word
;
TOPS10 < ;TOPS-10 ONLY
MAPIOE: TXNE S2,IO.IMP ;IMPROPER MODE
$RETE (SWS) ;? Software write-locked file structure
TXNE S2,IO.DER ;DISK ERROR
$RETE (DER) ;? Hardware device error
TXNE S2,IO.DTE ;HARD DATA/PARITY ERROR
$RETE (DTE) ;? Hard data error
TXNE S2,IO.BKT ;BLOCK TOO LARGE/DISK FULL/ENQ
$RETE (BKT) ;? Block too large
$RETE (FDE) ;? File data error
> ;END OF TOPS-10 CONDITIONAL
SUBTTL CHKIFN - Check user calls and set IFN context
;CHKIFN CHECKS TO SEE IF AN IFN IS OPENED. CALL WITH IFN IN S1.
; THIS ROUTINE IS ALSO RESPONSIBLE, AS A CO-ROUTINE, FOR SETTING
; UP THE REGISTERS "FB" AND "I", TO GIVE THE FB ADDRESS AND THE IFN
; RESPECTIVELY. THESE REGISTERS ARE RESTORED UPON A "POPJ " RETURN.
CHKIFN: EXCH FB,0(P) ;SAVE CONTENTS OF FB, GET RETURN PC
PUSH P,[EXP RSTIFN] ;PLACE TO RESTORE THE REGS FROM
PUSH P,FB ;SAVE RETURN PC
CAILE S1,0 ;IT MUST BE GREATER THAN 0
CAILE S1,SZ.IFN ;AND LESS THAN MAX
SKIPA ;LOSE!!!
SKIPN FB,IFNTAB(S1) ;IS IFN ALLOCATED
STOPCD (IFN,HALT,,<Illegal IFN provided in call>)
$RETT ;TAKE A GOOD RETURN
; HERE TO RESTORE I AND FB TO THEIR PRE-CALL CONTENTS
RSTIFN: POP P,FB ;RESTORE FB
POPJ P, ;RETURN
ILLMOD: STOPCD (IFM,HALT,,<Illegal file mode in subroutine call>)
; Get a word (block type) from the user's argument list
; Call: PUSHJ P,GETBLK
;
; TRUE return: S1:= word, FI.IMM remembered for later
; FALSE return: end of list
;
GETBLK: SOSGE FB$CNT(FB) ;COUNT ARGUMENTS
$RETF ;END OF LIST
SETZM FB$IMM(FB) ;ASSUME NOT IMMEDIATE VALUE
SETZM FB$IFF(FB) ;ASSUME NOT FROM ANOTHER IFN
MOVE S1,@FB$PTR(FB) ;GET VALUE
TXNE S1,FI.IMM ;IMMEDIATE ARGUMENT?
SETOM FB$IMM(FB) ;YES
TXNE S1,FI.IFN ;FROM ANOTHER IFN?
SETOM FB$IFF(FB) ;YES
HRRZM S1,FB$ATT(FB) ;SAVE ATTRIBUTE TYPE FOR GETVAL W/IFN
AOS FB$PTR(FB) ;POINT TO NEXT WORD
$RETT ;RETURN
; Get a value from the user's argument list
; This routine will either return an immediate value or resolve
; an address based on the setting of the FB$IMM(FB) flag. It is expected
; that GETBLK be called first to set or clear FB$IMM(FB).
;
GETVAL: SOSGE FB$CNT(FB) ;COUNT ARGUMENTS
$RETF ;END OF LIST
SKIPE FB$IMM(FB) ;IMMEDIATE VALUE?
MOVE S1,@FB$PTR(FB) ;YES
SKIPN FB$IMM(FB) ;CHECK AGAIN
JRST [MOVE S1,@FB$PTR(FB) ;GET ADDRESS
MOVE S1,@S1 ;GET A VALUE
JRST .+1] ;ONWARD
AOS FB$PTR(FB) ;POINT TO NEXT WORD
SKIPN FB$IFF(FB) ;IF NOT VIA AN IFN,
$RETT ;RETURN THE INFORMATION
CAMN S1,FB$IFN(FB) ;BETTER BE A DIFFERENT FILE
$RETE (FAI) ;CALL IT INCONSISTENT IF NOT
$SAVE <S2> ;IT IS VIA AN IFN, SAVE VOLATILE AC
MOVE S2,FB$ATT(FB) ;GET THE INCOMING ATTRIBUTE TYPE
MOVE S2,ATINFT-1(S2) ;CONVERT TO F%INFO FI.??? CODE
PJRST F%INFO ;GET THE VALUE FROM THE IFN AND RETURN
ATINFT: EXP FI.PRT ;(01) PROTECTION CODE
EXP FI.ACT ;(02) ACCOUNT STRING
EXP FI.SPL ;(03) SPOOLED FILE NAME
EXP FI.CRY ;(04) ENCRYPTION CODE
EXP FI.DTY ;(05) DATA TYPE
EXP FI.DTO ;(06) DATA "OTS" TYPE
EXP FI.DCC ;(07) DATA CARRIAGE CONTROL
EXP FI.BSZ ;(10) LOCAL DATA BYTE SIZE
EXP FI.FSZ ;(11) PHYSICAL DATA FRAME SIZE
EXP FI.HSZ ;(12) FIXED-HEADER SIZE
EXP FI.RFM ;(13) RECORD FORMAT
EXP FI.RFO ;(14) RECORD FORMAT ORGANIZATION
EXP FI.RSZ ;(15) RECORD SIZE
EXP FI.BLS ;(16) BLOCK SIZE (BYTES)
EXP FI.FFB ;(17) FIRST FREE BYTE WITHIN LAST BLOCK
EXP FI.ACW ;(20) APPLICATION-SPECIFIC FIELD
EXP FI.RMS ;(21) RMS-10 FORMATTED FILE
EXP FI.MCY ;(22) MACY11 FORMATTED FILE
EXP FI.CTG ;(23) CONTIGUOUS ALLOCATION
EXP FI.NSB ;(24) RECORDS DO NO SPAN PHYSICAL BLOCKS
EXP FI.CRE ;(25) CREATION DATE,,TIME
EXP FI.ACD ;(26) ACCESS DATE
EXP FI.MOD ;(27) I/O MODE OF FILE
EXP FI.GEN ;(30) FILE VERSION WORD
EXP FI.USW ;(31) USER-SETTABLE WORD
EXP FI.MTA ;(32) TAPE LABEL
EXP FI.STS ;(33) FILE STATUS BITS
EXP FI.IDT ;(34) BACKUP INCREMENTAL DATE/TIME
EXP FI.PCA ;(35) PRIVILEGED CUSTOMER-SETTABLE WORD
EXP FI.TIM ;(36) PHYSICAL CREATION DATE/TIME
EXP FI.LAD ;(37) LAST ACCOUNTING DATE
EXP FI.EXP ;(40) EXPIRATION DATE (UDT)
EXP FI.AUT ;(41) FILE AUTHOR
FIL%L: END