Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
7/galaxy-sources/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 Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; 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 THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH GLXMAC ;SEARCH SUBSYSTEMS SYMBOLS
PROLOG(GLXFIL,FIL) ;GENERATE PROLOG CODE
FILMAN==:0 ;Maintenance edit number
FILDEV==:141 ;Development edit number
VERSIN (FIL) ;Generate edit number
;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. Revision History . . . . . . . . . . . . . . . . . . . 3
; 2. Global Routines . . . . . . . . . . . . . . . . . . . 4
; 3. Local AC definitions . . . . . . . . . . . . . . . . . 5
; 4. FB - File Block Definitions . . . . . . . . . . . . . 6
; 5. F%INIT - Initialize the world . . . . . . . . . . . . 8
; 6. F%IOPN - Open an input file . . . . . . . . . . . . . 9
; 7. F%OOPN - Open an output file . . . . . . . . . . . . . 10
; 8. F%AOPN - Open an output file in append mode . . . . . 11
; 9. OPNCOM - Common file open routine . . . . . . . . . . 13
; 10. LDLEB - Load a LOOKUP/ENTER block from an FD . . . . . 16
; 11. File attribute processing - Main loop and dispatch tab 17
; 12. SETFD - Set up a real description of opened file . . . 19
; 13. SETFOB - Build an internal FOB . . . . . . . . . . . . 20
; 14. OPNERR - Handle a system error from F%IOPN . . . . . . 21
; 15. F%IBYT - Read one byte from file . . . . . . . . . . . 22
; 16. F%IBUF - Read a buffer of data from file . . . . . . . 23
; 17. GETBUF - Read one input buffer from the operating syst 24
; 18. F%POS - Position an input file . . . . . . . . . . . . 25
; 19. F%OBYT - Write one byte into file . . . . . . . . . . 26
; 20. F%OBUF - Write a buffer full of data to a file . . . . 27
; 21. PUTBUF - Give one output buffer to the operating syste 29
; 22. F%CHKP - Checkpoint a file . . . . . . . . . . . . . . 30
; 23. WRTBUF - TOPS20 Subroutine to SOUT the current buffer 32
; 24. F%REN - Rename a file . . . . . . . . . . . . . . . . 33
; 25. F%REL - Release a file . . . . . . . . . . . . . . . . 36
; 26. F%DREL - Delete a file and release it . . . . . . . . 37
; 27. F%DEL - Delete an unopened file . . . . . . . . . . . 38
; 28. F%INFO - Return system information about a file . . . 39
; 29. F%FD - Return a pointer to the FD on an opened IFN . . 40
; 30. ALCIFN - Allocate an Internal File Number . . . . . . 41
; 31. GETERR - Get Last -20 error to MAP it . . . . . . . . 42
; 32. MAPERR - Map an operating system error . . . . . . . . 43
; 33. MAPIOE - Map an I/O error . . . . . . . . . . . . . . 45
; 34. CHKIFN - Check user calls and set IFN context . . . . 46
SUBTTL Revision History
COMMENT \
***** Release 4.2 -- begin maintenance edits *****
104 4.2.1495
Don't set pages in FDB when checkpointing.
105 4.2.1579 29-May-84
In OPNERR check for JFN and if found, release it.
106 4.2.1601 14-Jan-85
In F%OOPN and F%AOPN change protection check to .CKAWR from .CKACN.
107 4.2.1620 Aug-13-85
In F%OOPN, allow a file to supersede an existing file
***** Release 5.0 -- begin development edits *****
120 5.1002 28-Dec-82
Move to new development area. Clean up edit organization. Update TOC.
121 5.1199 6-Feb-85
If a RENAME fails, delete the created file.
122 5.1200 6-Feb-85
Set bit IB.NAC to zero so as not to restrict access to JFNs.
123 5.1216 13-May-85
Fix multiple bugs involving APPEND mode files. In particular,
Update F%CHKP, NXTBYT, etc. to use the TOPS-20 byte count for
EOF. In F%xOPN, use the user-specified byte size when opening
files. In F%AOPN, use OF%APP mode OPENF so appends get done
right. This ends up fixing CRL stop codes, hung programs that
can't find the EOF for an append, and in general, trashed files.
125 Increment maintenance edit level for version 5 of GALAXY.
126 5.1229 30-Dec-85
In routine F%IOPN, set OF%PLN if LSNs are not suppressed.
127 5.1235 Apr-15-86
Add ERJMP after OPENF in routine OPNC.2
130 5.1240 Jun-16-86
In routine F%POS (POS.2), check to see if the caller wants to include
LSN in its calculation to position a byte within a file and set the according
bit (SF%LSN) to the SFPTR JSYS. (only for version 5 of GALAXY)
******This edit requires MONITOR edit 7321 and MONSYM 7322. *******
***** Release 6.0 -- begin development edits *****
140 6.1005 5-Oct-87
If F%REL encounters an error while closing a file, cause it to return
an error. If the error is due to "file still mapped", then have it return
error GALAXY error ERFSM$; otherwise, have it return GALAXY error ERUSE$.
141 6.1225 8-Mar-88
Update copyright notice.
\ ;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 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 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
FB VBP,1 ;Virgin Byte Pointer (initial)
> ;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$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
;**;[126]At F%IOPN:+1L add one line JYCW 12/30/85
PUSH P,S2 ;[126]Save FOB address
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<
LOAD S1,FOB.CW(S2),FB.BSZ ;Get user-specified byte size
LSH S1,^D30 ;Stuff into byte size field
IORX S1,OF%RD ;Open for read
;**;[126]At F%IOPN:+8L (within TOPS-20 conditional) add 3 lines JYCW 12/30/85
LOAD S2,FOB.CW(S2),FB.LSN ;[126]See if user wants to supress lsns
SKIPN S2 ;[126]If not
IORX S1,OF%PLN ;[126] set disable LSN checking
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
;**;[126]At F%IOPN:+17L add 1 line JYCW 12/30/85
POP P,S2 ;[126]Restore FOB address
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<
LOAD S1,FOB.CW(S2),FB.BSZ ;Get user-specified byte size
LSH S1,^D30 ;Stuff into byte size field
IORX S1,OF%WR ;Open for write
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
;**;[107]At F%OOPN:10L insert four lines JCR 8/13/85
LOAD S1,FOB.CW(S2),FB.SUP ;[107]Get the supersede bit
TDZE S1,S1 ;[107]Is it on?
MOVX S1,GJ%FOU!GJ%NEW ;[107]Yes, get the bits to turn off
ANDCAM S1,O$GJFN ;[107]And turn them off
MOVX S1,.CKAWR ;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<
LOAD P1,FOB.CW(S2),FB.BSZ ;Get user-specified byte size
LSH P1,^D30 ;Stuff into byte size field
IORX P1,OF%APP ;Open for append
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,.CKAWR ;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
TOPS10<
$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
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
> ;END TOPS10 CONDITIONAL
$RETT ;AND RETURN
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
$STOP(OTS,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
$STOP(IBS,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< 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
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
TXNN S2,TY.SPL ;Spooled device?
CAXN S1,.TYDSK ;IS IT A DISK?
SKIPA ;Spooled, or disk, OK...
JRST [ MOVX S1,ERFND$ ;NO, RETURN A 'FILE NOT ON DISK'
PJRST RETERR ] ;
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: 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
LOAD S2,IIB##+IB.FLG,IB.NAC ;Get access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as value of JFN access
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
;**;[127]At OPNC.2:+3L change 1 line JYCW 4/15/86
ERJMP OPNERR ;[127]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
MOVE S1,FB$BUF(FB) ;Buffer page address
HRLI S1,440000 ;Form byte pointer to first byte
MOVE S2,FB$BYT(FB) ;Get byte size
DPB S2,[POINT 6,S1,11] ;Set byte size field in byte pointer
MOVEM S1,FB$VBP(FB) ;Store virgin byte pointer
SETZM FB$BIB(FB) ;Mark buffer as empty
MOVE S1,FB$VBP(FB) ;Get virgin byte pointer
MOVEM S1,FB$BBP(FB) ;set current buffer pointer
OPNC.E: 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
HLLZ S2,.FDEXT(S1) ;GET THE EXTENSION
HLLM S2,FB$LEB+.RBEXT(FB) ;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
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 .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: EXP ATRPRO ;(01) PROTECTION CODE
EXP ATRACT ;(02) ACCOUNT STRING
EXP ATRSPL ;(03) SPOOLED FILE NAME
; 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$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
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
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: MOVE S1,FB$PTH+.PTFCN(FB) ;GET FILE'S DEVICE
MOVEM S1,FB$RFD+.FDSTR(FB) ;STORE INTO STRUCTURE LOCATION
MOVE S1,FB$LEB+.RBNAM(FB) ;GET FILE'S NAME
MOVEM S1,FB$RFD+.FDNAM(FB) ;STORE INTO RFD
HLLZ S1,FB$LEB+.RBEXT(FB) ;GET FILE'S EXTENSION
MOVEM S1,FB$RFD+.FDEXT(FB) ;STORE IT
MOVX S1,.FDPPN ;GET LENGTH OF ALL BUT PATH
STORE S1,FB$RFD+.FDLEN(FB),FD.LEN ;STORE IT AWAY
MOVSI S1,-<FDXSIZ-.FDPPN-1> ;GET MAXIMUM LENGTH OF PATH
HRR S1,FB ;RELOCATE TO THE RFD
SETF.1: SKIPE S2,FB$PTH+.PTPPN(S1) ;IS THIS PART OF PATH SPECIFIED?
INCR FB$RFD+.FDLEN(FB),FD.LEN;YES, INCREMENT LENGTH OF FD
MOVEM S2,FB$RFD+.FDPPN(S1) ;STORE THE ACTUAL PATH
SETF.2: AOBJN S1,SETF.1 ;REPEAT FOR ALL PARTS
MOVEI S1,FB$PTH(FB) ;POINT TO ACTUAL PATH BLOCK
MOVEM S1,FB$LEB+.RBPPN(FB) ;SAVE FOR FUTURE REFERENCE
$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/ USER SPECIFIED BYTE SIZE,, 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
HLRZ P1,S2 ;Get the user specified byte size
SKIPN P1 ;Was one specified?
MOVEI P1,^D36 ;No, so use 36. bit size
CAIL P1,1 ;Check for
CAILE P1,^D36 ;legal byte sizde
JRST S..IBS ;Illegal byte size specified.
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
SKIPE S1,FB$JFN(FB) ;Don't release if there is no JFN
RLJFN ;Release the JFN
ERJMP .+1 ;Ignore any errors
NOJFN: 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
;**;[130]At IBYT.1:+2L Delete two lines JYCW 6/16/86
IBYT.2: ILDB S2,FB$BBP(FB) ;NO, JUST GET THE NEXT BYTE
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
;**;[130]At IBYT.4+0L delete 17 lines (routine IBYT.4) JYCW 6/16/86
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?
$STOP(CTL,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$VBP(FB) ;Get virgin byte pointer
MOVEM S2,FB$BRH+.BFPTR(FB) ;SAVE THE BYTE POINTER
MOVEI T1,SZ.BUF ;Number of words in buffer
IMUL T1,FB$BPW(FB) ;Compute bytes in buffer
MOVEM T1,FB$BRH+.BFCNT(FB) ;Save the byte count
MOVNS T1 ;Negate it for SIN
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: ADD T1,FB$BRH+.BFCNT(FB) ;Calculate actual bytes read
MOVEM T1,FB$BRH+.BFCNT(FB) ;Save the count
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 the file to the end of
; the buffer containing the byte specified in S2. The pointer FB$BBP(FB)
; will point to the byte.
;
;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
$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
PUSHJ P,FSIZE ;Get max pointer
CAMLE T4,S1 ;Ok?
$RETE(IFP) ;Illegal File pointer
MOVE T1,FB$BPW(FB) ;Get the number of bytes/word
IMULI T1,SZ.BUF ;Get the number of bytes/buffer
MOVE T2,T4 ;Pick up the position
IDIV T2,T1 ;T2=number of buffers,T3=byte in buffer
MOVEM T2,FB$BFN(FB) ;Update the buffer number
IMUL T2,T1 ;Number of bytes in previous buffers
MOVE S1,FB$JFN(FB) ;Pick up the JFN
;**;[130]At POS.2+12L Add two lines JYCW 6/16/86
SKIPE FB$LSN(FB) ;[130]Want to trim line numbers?
TXO S1,SF%LSN ;[130]Yes, set bit to include LSN
MOVE S2,T2 ;Position to start of current buffer
SFPTR% ;Do it
$STOP(FOF,File operation failed unexpectedly)
MOVE S1,FB$JFN(FB) ;Get the JFN
MOVE S2,FB$VBP(FB) ;Get virgin byte pointer
MOVEM S2,FB$BRH+.BFPTR(FB) ;SAVE THE BYTE POINTER
MOVEI T1,SZ.BUF ;Number of words in buffer
IMUL T1,FB$BPW(FB) ;Compute bytes in buffer
MOVEM T1,FB$BRH+.BFCNT(FB) ;Save the byte count
MOVNS T1 ;Negate it for SIN
SIN% ;Read them
ERJMP [GTSTS ;Get file status
TXNN S2,GS%EOF ;Is it EOF?
PJRST GETERR ;Get error, map it and return
JRST POS.3] ;And continue on
POS.3: ADD T1,FB$BRH+.BFCNT(FB) ;Calculate actual bytes read
MOVEM T1,FB$BRH+.BFCNT(FB) ;Save the count
PUSHJ P,SETBFD ;Set up pointers for this buffer
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
SETZM FB$EOF(FB) ;Clear EOF flag
POS.4: SOJL T4,.RETT ;More odd bytes?
IBP FB$BBP(FB) ;Yes, bump the pointer
JRST POS.4 ;And loop
POSEOF: PUSH P,T1 ;Save T1 for later
SETOM FB$BIB(FB) ;MAKE SURE WE ALWAYS GET HERE
SETOM FB$EOF(FB) ;DITTO
MOVE S1,FB$JFN(FB) ;Point monitor's file pointer to EOF
SETO S2, ;...
SFPTR ;...
JFCL ;Ignore errors, this should never fail
POP P,T1 ;Restore T1
$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: MOVE S1,FB$BIB(FB) ;GET BYTES REMAINING IN BUFFER
EXCH S1,FB$BRH+.BFCNT(FB) ;EXCH WITH ORIGNINAL byte COUNT
SUB S1,FB$BRH+.BFCNT(FB) ;GET NUMBER OF byteS WRITTEN
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$VBP(FB) ;Get a virgin byte pointer
MOVEM S1,FB$BRH+.BFPTR(FB) ;and save it
MOVEI S1,SZ.BUF ;Get the buffer size
IMUL S1,FB$BPW(FB) ;Make it into bytes
MOVEM S1,FB$BRH+.BFCNT(FB) ;and save the count
> ;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$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,CHKOS ;CHECKPOINT THE OUTPUT
JUMPF .RETF ;FAILED?
PUSHJ P,NXTOUT ;GET NEXT BYTE NUMBER
JUMPF .RETF ;
$RETT ;AND RETURN
NXTOUT: SKIPGE S1,FB$BFN(FB) ;ANY INPUTS DONE YET?
JRST [SETZM S1 ;NO, RETURN BYTE 0
$RETT] ; AND TRUE!
MOVE S1,FB$JFN(FB) ;Get the JFN
RFPTR% ;Get the next byte number
ERJMP .RETF ;Return false if an error
MOVE S1,S2 ;Place byte number in S1
$RETT
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
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
MOVE S1,FB$BPW(FB) ;Get bytes per word
IMULI S1,SZ.BUF ;Calculate bytes per buffer
SUB S1,FB$BIB(FB) ;Subtract unused part
SKIPLE S1 ;Skip if buffer is empty
JRST [ PUSHJ P,PUTBUF ;WRITE THE BUFFER
JUMPF GETERR ;FILE DATA ERROR?
JRST .+1 ] ;Rejoin main code
MOVE S1,FB$JFN(FB) ;GET THE JFN
SIZEF ;Get size of file
ERJMP GETERR ;MAP ERROR
HRLZ S1,FB$JFN(FB) ;Put JFN in LF, 0 in RH
MOVE S2,T1 ;Put page count here
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
MOVX S2,.FBBYV ;GET NUMBER OF WORD TO CHANGE
STORE S2,S1,CF%DSP ;STORE IN S1
PUSH P,S1 ;Save this for a bit
HRRZ S1,FB$JFN(FB) ;Get the JFN again
RFBSZ ;Get file's real byte size
ERJMP [ POP P,S1 ;Restore S1
JRST GETERR ] ;and return error
POP P,S1 ;Restore S1
SETZ T1, ;CLEAR T1
STORE S2,T1,FB%BSZ ;Put the byte size in the right place
MOVX S2,FB%BSZ ;PUT MASK IN S2
CHFDB ;SET THE BYTE SIZE
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 S2,FB$BFN(FB) ;GET THE BUFFER NUMBER
JUMPL S2,.RETT ;RETURN IF THIS IS THE DUMMY OUTPUT
MOVE S1,FB$JFN(FB) ;GET THE JFN
MOVE S2,FB$MOD(FB) ;Get the file open mode
CAIN S2,FBM$AP ;Is it append?
JRST WRTB.2 ;Yes, can't SFPTR an appended file
SETOM S2 ;Set to the end of the file
SFPTR% ;Do it
ERJMP .RETF ;Return I/O error
WRTB.2: MOVE S2,FB$VBP(FB) ;Get virgin byte pointer
MOVNI T1,SZ.BUF ;Get negative size of buffer in words
IMUL T1,FB$BPW(FB) ;Make that into a byte count
SKIPGE FB$BIB(FB) ;Check NUMBER OF BYTES LEFT
SETZM FB$BIB(FB) ;-1 IS ACTUALLY 0
ADD T1,FB$BIB(FB) ;Add in the unused part of the buffer
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
MOVEM S1,FB$BBP(FB) ;STORE THE BUFFER BYTE POINTER
MOVE S1,FB$BRH+.BFCNT(FB) ;Get byte count again
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/ BYTE SIZE(OPTIONAL),,ADDRESS OF FRB (FILE RENAME BLOCK)
; IF BYTE SIZE NOT SPECIFIED THEN DEFAULTS TO 36.
;
;TRUE RETURN: IF RENAME OPERATION IS SUCCESSFUL
;
;FALSE RETURN: S1/ ERROR CODE
;
; POSSIBLE ERRORS: ERPRT$ ERFNF$ ERFDS$
TOPS10<
F%REN: $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
$STOP(RTS,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
MOVE S2,.FDSTR(S1) ;GET STRUCTURE THAT FILE IS ON
MOVEM S2,FB$FUB+.FODEV(T3) ;STORE INTO 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
MOVE T2,.FDSTR(S1) ;GET SOURCE STRUCTURE
MOVE S2,FRB.DF(T1) ;GET FD FOR DESTINATION
PUSHJ P,LDLEB ;LOAD THE LOOKUP/ENTER BLOCK FROM FD
PUSHJ P,ALCIFN ;ALLOCATE ANOTHER IFN
JUMPF REN.21 ;PASS ERROR AFTER RELEASING FIRST IFN
JUMPE P1,REN.X ;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.X: 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
;F%REN IS CONTINUED ON THE FOLLOWING PAGE
;CONTINUED FROM PREVIOUS PAGE
MOVX S1,FO.ASC ;ASSIGN CHANNEL NUMBER
IOR S1,[FO.PRV+.FORNM] ;PRIVELEGES+ 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.3 ;FAILED...
REN.2: 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.3: PUSH P,S1 ;SAVE ERROR CODE
PUSHJ P,REN.2 ;RELEASE THE IFNS
POP P,S1 ;RESTORE ERROR CODE
PJRST MAPERR ;RETURN, AFTER MAPPING ERROR
REN.21: 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.
$STOP(RTS,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.5 ;RETURN ERROR
EXCH FB,T4 ;SWAP CUZ EVERYONE BELEIVES IN 'FB'
PUSHJ P,ATTRIB ;PROCESS ATTRIBUTE BLOCK
EXCH T4,FB ;RESET THINGS
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
REN.5: PUSH P,S1 ;Save the original error
MOVE S1,FB$JFN(T4) ;Get destination (created file) JFN
TXO S1,DF%NRJ!DF%EXP ;Delete and expunge but keep the JFN
DELF% ;Get rid of it
ERJMP .+1 ;Ignore errors
POP P,S1 ;Get back the original error
JRST REN.4 ;Resume error handling
> ;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.
SKIPN FB$JFN(FB) ;See if there's a jfn yet
JRST RELFB ;If not, just release the storage
MOVE S1,FB$IFN(FB) ;PUT THE IFN IN S1
$CALL F%CHKP ;AND CHECKPOINT THE FILE
INTREL: SKIPN S1,FB$JFN(FB) ;GET THE JFN
JRST RELFB ;If no jfn, just release storage
CLOSF ;GET RID OF IT
ERJMP INTR.1 ;PROCESS THE ERROR
JRST RELFB ;AND DELETE THE FB
INTR.1: PUSH P,S1 ;[6000]SAVE THE ERROR CODE
MOVE S1,FB$JFN(FB) ;GET THE JFN
RLJFN ;RELEASE THE JFN
ERJMP .+1 ;IGNORE THE ERROR
$CALL RELFB ;[6000]AND DELETE THE FB
POP P,S1 ;[6000]RESTORE THE ERROR CODE
PJRST MAPERR ;[6000]RETURN ERROR AS GALAXY ERROR
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 .+2 ;Maybe never opened ... toss it
JRST RELFB ;AND DELETE THE FB
MOVE S1,FB$JFN(FB) ;Reload the JFN
RLJFN% ;And get rid of it
ERJMP .+1 ;Ignore any errors
JRST RELFB ;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
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
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
$STOP(UFI,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>
SYSPRM XX.SIZ,<MOVE S1,FB$WRD(FB)>,<PUSHJ P,FSIZE>
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)>
DEFINE X(A)<
EXP < XX.'A>
> ;END OF X DEFINITION
FITAB: CFI
LEN.FI==.-FITAB
; This code is not immediately obvious. The problem is that the user
; may have opened the file with a different byte size than that with
; which the file was written. We can't guarantee perfection, since
; not all byte sizes are integral multiples of each other. Howeer,
; we get as close as possible, always rounding up so a reader will be
; guaranteed to read everything in the file (although the last byte
; may only be partially significant). In the comments, (file) refers
; to quantities related to the way the file was written, and (opening)
; refers to the same quantities related to the way the file is opened.
FSIZE: $CALL .SAVET ;Save these work registers
MOVE S1,FB$JFN(FB) ;Get JFN
MOVE S2,[2,,.FBBYV] ;Byte size and count words (FILE)
MOVEI T1,T1 ;Byte size in T1, count in T2 (FILE)
GTFDB ;..
ERCAL S..FOF ;unexpected error
RFBSZ ;Get the byte size (OPENING)
ERCAL S..FOF ;unexpected error
LDB T1,[POINT 6,T1,11] ;Get byte size (FILE)
CAIN T1,(S2) ;Same byte sizes?
JRST [ MOVE S1,T2 ;So use the value from the FDB
$RET ] ;and return to caller
MOVE T3,S2 ;Save byte size (OPENING)
MOVEI S1,^D36 ;Get word size
IDIVI S1,(T1) ;Compute bytes per word (FILE), truncate
MOVE S2,S1 ;Move it here
MOVE S1,T2 ;Get byte count (FILE)
IDIVI S1,(S2) ;Compute fullword count (FILE)
IMULI S2,(T1) ;Remainder * byte size (FILE) = extra bt
MOVE T1,S2 ;Preserve for a bit
MOVEI T2,^D36 ;bits per word
IDIVI T2,(T3) ;Bytes per word (OPENING)
IMULI S1,(T2) ;Fullwords (FILE) * bytes/word (OPENING)
; = bytes (OPENING) to fill fullwords
; (FILE)
ADDI T1,-1(T3) ;Round up
IDIVI T1,(T3) ;Extra bits after fullwords (FILE)
; * bits/byte (OPENING) = bytes (OPEN)
; required to hold extra bits
ADDI S1,(T1) ;the sum is the answer
$RET
TOPS10<
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
> ; 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
$STOP(FIT,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 CLSX3, ERFSM$ ;[6000]FILE STILL MAPPED
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
$STOP(IFN,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: $STOP(IFM,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
MOVE S1,@FB$PTR(FB) ;GET VALUE
TXNE S1,FI.IMM ;IMMEDIATE ARGUMENT?
SETOM FB$IMM(FB) ;YES
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
$RETT ;AND RETURN
FIL%L: END