Trailing-Edge
-
PDP-10 Archives
-
BB-H138E-BM
-
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,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
;
; 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
FILMAN==:106 ;Maintenance edit number
FILDEV==:122 ;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. Preliminaries. . . . . . . . . . . . . . . . . . . . . 1
; 2. Table Of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision History . . . . . . . . . . . . . . . . . . . 3
; 4. Global Routines. . . . . . . . . . . . . . . . . . . . 4
; 5. Local AC definitions . . . . . . . . . . . . . . . . . 5
; 6. Module Storage . . . . . . . . . . . . . . . . . . . . 5
; 7. FB - File Block Definitions. . . . . . . . . . . . 6
; 8. F%INIT - Initialize the world. . . . . . . . . . . . . 8
; 9. F%IOPN - Open an input file. . . . . . . . . . . . . . 9
; 10. F%OOPN - Open an output file . . . . . . . . . . . . . 10
; 11. F%AOPN - Open an output file in append mode. . . . . . 11
; 12. OPNCOM - Common file open routine. . . . . . . . . . . 13
; 13. LDLEB - Load a LOOKUP/ENTER block from an FD. . . . . 16
; 14. File attribute processing
; 14.1. Main loop and dispatch table. . . . . . . . . 17
; 15. SETFD - Set up a real description of opened file. . . 19
; 16. SETFOB - Build an internal FOB . . . . . . . . . . . . 20
; 17. OPNERR - Handle a system error from F%IOPN . . . . . . 21
; 18. F%IBYT - Read one byte from file . . . . . . . . . . 22
; 19. F%IBUF - Read a buffer of data from file . . . . . . 23
; 20. GETBUF - Read one input buffer from the operating system 24
; 21. F%POS - Position an input file . . . . . . . . . . . 25
; 22. F%REW - Rewind an input file . . . . . . . . . . . . 25
; 23. F%OBYT - Write one byte into file. . . . . . . . . . 29
; 24. F%OBUF - Write a buffer full of data to a file . . . 30
; 25. PUTBUF - Give one output buffer to the operating system 32
; 26. F%CHKP - Checkpoint a file . . . . . . . . . . . . . 33
; 27. WRTBUF - TOPS20 Subroutine to SOUT the current buffer 35
; 28. SETBFD
; 28.1. Setup Buffer Data . . . . . . . . . . . . . . 35
; 29. F%REN - Rename a file . . . . . . . . . . . . . . . . 36
; 30. F%REL - Release a file. . . . . . . . . . . . . . . . 39
; 31. F%DREL - Delete a file and release it. . . . . . . . . 40
; 32. F%DEL - Delete an unopened file . . . . . . . . . . . 41
; 33. F%INFO - Return system information about a file. . . . 42
; 34. F%FD - Return a pointer to the FD on an opened IFN . 43
; 35. F%FCHN - Find first free channel . . . . . . . . . . . 43
; 36. ALCIFN - Allocate an Internal File Number. . . . . . . 44
; 37. RELFB - Release a File Block. . . . . . . . . . . . . 44
; 38. GETERR . . . . . . . . . . . . . . . . . . . . . . . . 45
; 39. MAPERR - Map an operating system error . . . . . . . . 46
; 40. MAPIOE - Map an I/O error. . . . . . . . . . . . . . . 48
; 41. CHKIFN - Check user calls and set IFN context. . . . . 49
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.
***** 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.
\ ;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
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
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<
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
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
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
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
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
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
IBYT.4: MOVE S1,FB$BBP(FB) ;GET THE BUFFER BYTE POINTER
IBP S1 ;NORMALIZE IT
MOVE S1,(S1) ;GET THE WORD
TRNN S1,1 ;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
AOS FB$BBP(FB) ;INCREMENT BYTE-POINT BY ONE WORD
MOVNI S1,5-1 ;ACCOUNT FOR BYTES BYPASSED BY AOS
;FB$BIB WAS SOSGE'D ABOVE
ADDM S1,FB$BIB(FB) ;DECREMENT BYTES-IN-BUFFER
;EVEN IF FB$BIB GOES NEGATIVE HERE
;THE NEXT SOSGE IN IBYT WILL CATCH IT
SETZM FB$LSN(FB) ;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
JRST IBYT.1 ;ELSE, GET NEXT BYTE
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
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: MOVE S1,FB$JFN(FB) ;GET THE JFN
RLJFN ;RELEASE THE JFN
ERJMP .+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 .+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 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