Trailing-Edge
-
PDP-10 Archives
-
BB-H138B-BM
-
language-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 Irwin L. Goverman - Larry Samberg/MLB/DC/PW/AWC 12-Sep-79
;
;
; COPYRIGHT (c) 1978,1979
; DIGITAL EQUIPMENT CORPORATION
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC ;SEARCH SUBSYSTEMS SYMBOLS
PROLOG(GLXFIL,FIL) ;GENERATE PROLOG CODE
FILEDT==47 ;EDIT LEVEL
;THE PURPOSE OF THIS MODULE IS TO PROVIDE AN OPERATING SYSTEM INDEPENDENT
; INPUT FILE INTERFACE TO GALAXY PROGRAMS (OR ANY OTHER PROGRAM WHICH
; WANTS TO USE IT).
SUBTTL Table Of Contents
; TABLE OF CONTENTS FOR GLXFIL
;
;
; SECTION PAGE
; 1. Table Of Contents......................................... 2
; 2. Revision History.......................................... 3
; 3. Global Routines........................................... 4
; 4. Local AC definitions...................................... 5
; 5. Module Storage............................................ 5
; 6. FB - File Block Definitions........................... 6
; 7. F%INIT - Initialize the world............................. 8
; 8. F%IOPN - Open an input file............................... 9
; 9. F%OOPN - Open an output file.............................. 10
; 10. F%AOPN - Open an output file in append mode............... 11
; 11. OPNCOM - Common file open routine......................... 13
; 12. LDLEB - Load a LOOKUP/ENTER block from an FD............. 16
; 13. SETFD - Set up a real description of opened file......... 17
; 14. SETFOB - Build an internal FOB............................ 18
; 15. OPNERR - Handle a system error from F%IOPN................ 19
; 16. F%IBYT - Read one byte from file........................ 20
; 17. F%IBUF - Read a buffer of data from file................ 21
; 18. GETBUF - Read one input buffer from the operating system 22
; 19. POSBUF - Setup new input buffer for the user............ 23
; 20. F%POS - Position an input file.......................... 24
; 21. F%REW - Rewind an input file............................ 24
; 22. F%OBYT - Write one byte into file....................... 26
; 23. F%OBUF - Write a buffer full of data to a file.......... 27
; 24. PUTBUF - Give one output buffer to the operating system. 29
; 25. F%CHKP - Checkpoint a file.............................. 30
; 26. WRTBUF - TOPS20 Subroutine to SOUT the current buffer... 32
; 27. SETBFD -- Setup Buffer Data............................. 32
; 28. F%REN - Rename a file.................................... 33
; 29. F%REL - Release a file................................... 36
; 30. F%DREL - Delete a file and release it..................... 37
; 31. F%DEL - Delete an unopened file.......................... 38
; 32. F%INFO - Return system information about a file........... 39
; 33. F%FD - Return a pointer to the FD on an opened IFN...... 40
; 34. F%FCHN - Find first free channel.......................... 40
; 35. ALCIFN - Allocate an Internal File Number................. 41
; 36. RELFB - Release a File Block............................. 41
; 37. MAPERR - Map an operating system error.................... 42
; 38. CHKIFN - Check user calls and set IFN context............. 44
SUBTTL Revision History
COMMENT \
Edit GCO Explanation
---- ------- -------------------------------------------------
0001 Create GLXFIL module
0002 Make positioning code much smarter
0003 Add FI.SIZ to the F%INFO routine to get file size
0004 Optimize the Line Sequence Number checking code
0005 Add the F%FCHN routine find first free channel
0006 G005 On -10 reset the byte count after file-update
(F%CHKP) else blocks of output get lost.
0007 G003 On -10 if an FD is given to one of the open routines
with null device field, default it to 'DSK'.
0010 G018 Add F%INFO function 'FI.CHN' which returns I/O channel
number on the -10 and JFN on the -20.
0011 G028 Make F%CHKP smarter so that checkpoints will only be
done if there was any file activity
0012 G030 Fix DMPBUF, F%REL and F%CHKP to not dump out buffer
if going to checkpoint or close since on the -10 the
monitor will dump the buffer
0013 G047 Fix DMPBUF to clear the buffer after each output on the
-20 in DMPB.1
0014 G048 Make F%DREL and F%DEL Expunge file on -20
Allow Output to NUL: on the -20.
0015 G050 Make F%CHKP on the -20 Update Byte size of File and Count
0016 Fix OPNCOM to do range check on FD length word
and return ERIFS$ if not valid
0017 Rewrite F%OBUF so that it always uses ILDB/IDPB logic.
Move the code for QUOTA EXCEEDED to DMPBUF.
0021 Remove PJUMPx macros
0022 Superseded by edit 24
0023 Change SAVE macro to $SAVE.
0024 Significant re-work and cleanup of GLXFIL.
0025 Make IFNs start at 1 rather than 0
0026 Fix a bug in the F%POS routine which caused 'holey'
files.
0027 Fix a number of bugs and make line-sequence numbered file
processing faster.
0030
0031 Make checkpoint code work on the -10.
On -20 clear residue of output buffer.
0032 -10, Don't try to release channel if FILOP. to OPEN
fails. Assume that OPEN failing doesn't assign a chan.
0033 -10, During positioning which requires moving to a new buffer,
after USETIng to EOF, clear EOF so the INs to flush buffers win
xxxx Get rid of FB$POS, and FB$IBD. Clean up checkpoint
state of the world
0034 Fix bug in OPNERR on -10. Call RELFB to give
back the IFNTAB slot if the FILOP. OPEN fails
0035 -10, in LDLEB, if PPN is zero, don't make a path block
even if the FB contains an (assumedly blank) one
0036 CHANGED F%REN SO THAT IF THE SECOND IFN GET FAILS
THE FIRST ONE IS RELEASED.
0037 Fix the writing of nulls to not write any if on a full
word boundary at the end.
0040 Fix F%REW & F%POS so that we dont loop forever positioning
null files.
Add FDE error from F%REW & F%POS.
41 Fix CHKIFN so that it correctly checks IFNTAB for the
IFN which is passed.(Fixes Illegal IFN Stopcode for valid IFN's)
42 Change F%DREL so that it lites the Priv bit in the FILOP.
Also make it exit through INTREL on an error.
43 Fix F%CHKP to return 0 if no inputs have been done
against IFN when F%CHKP is called.
44 Fix F%REN to release its IFN if things look bad
45 Fix F%DEL to do F%OOPN instead of IOPN
46 Fix F%DEL to do F%AOPN instead of F%OOPN
Change F%DREL (TOPS20) to check for write access instead
of directory access.
47 Fix INTREL code for -20 to do a RLJFN if the CLOSF fails on
a file that we have a JFN but have not opened
Also add GETERR routine to get the last error on -20 before
trying to MAP it
\
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
;TEMPORARY ASSIGNMENT TILL GLXFIL CHANGE MADE TO USE THIS GLXFIL
SYSPRM SZ.BUF,200,1000 ;SIZE OF BUFFER AREA
SYSPRM SZ.OBF,200,1000 ;MAXIMUM WORDS XFERRED ON F%?BUF CALL
$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
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 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,.FOPPN+1 ;FILOP. UUO BLOCK
FB LEB,.RBTIM+1 ;LOOKUP/ENTER UUO BLOCK
FB PTH,10 ;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
> ;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: MOVEI S1,SZ.IFN ;CLEAR THE IFN
MOVEI S2,IFNTAB ;TABLE FOR RE-USE
PUSHJ P,.ZCHNK ;ZERO IT OUT.
$RETT ;RETURN.
SUBTTL F%IOPN - Open an input file
;CALL: S1/ LENGTH OF FILE OPEN BLOCK (FOB)
; S2/ ADDRESS OF FOB (DESCRIBED IN GLXMAC)
; FOB.FD (WORD 0) : ADDRESS OF FD
; FOB.CW (WORD 1) : CONTROL INFORMATION
; FOB.US (WORD 2) : USER ID FOR IN BEHALF
; FOB.CD (WORD 3) : CONNECTED DIRECTORY (TOPS-20)
;
;TRUE RETURN: S1/ CONTAINS INTERNAL FILE NUMBER (IFN)
;
;FALSE RETURN: S1/ CONTAINS ERROR CODE
;POSSIBLE ERRORS:
; ERSLE$ ERIFS$ ERFNF$ ERPRT$ ERDNA$ ERUSE$
F%IOPN: PUSH P,S1 ;SAVE FOB SIZE
MOVX S1,FBM$IN ;FILE WILL BE READ
MOVEM S1,O$MODE ;SO SET THAT UP NOW
TOPS10<
MOVX S1,<FO.PRV+.FORED> ;READ FUNCTION TO FILOP.
MOVEM S1,O$FUNC ;STORE AS FUNCTION
> ;END OF TOPS10 CONDITIONAL
TOPS20<
MOVX S1,<44B5+OF%RD> ;36 BIT READ FUNCTION
MOVEM S1,O$FUNC ;IS FUNCTION FOR OPENF
MOVX S1,GJ%SHT+GJ%OLD ;AND SHORT GTJFN, OLD FILE
MOVEM S1,O$GJFN ;IS FUNCTION FOR GTJFN
MOVX S1,.CKARD ;WANT TO KNOW IF WE CAN READ FILE
MOVEM S1,O$PROT ;IF CHKAC IS DONE
> ;END OF TOPS20 CONDITIONAL
POP P,S1 ;RESTORE LENGTH OF FOB
PJRST OPNCOM ;PERFORM THE OPEN
SUBTTL F%OOPN - Open an output file
;CALL: S1/ LENGTH OF FILE OPEN BLOCK (FOB)
; S2/ ADDRESS OF FOB (DESCRIBED IN GLXMAC)
; FOB.FD (WORD 0) : ADDRESS OF FD
; FOB.CW (WORD 1) : CONTROL WORD
; FOB.US (WORD 2) : USER ID FOR IN BEHALF
; FOB.CD (WORD 3) : CONNECTED DIRECTORY (TOPS-20)
;
;TRUE RETURN: S1/ CONTAINS INTERNAL FILE NUMBER (IFN)
;
;FALSE RETURN: S1/ CONTAINS ERROR CODE
;POSSIBLE ERRORS:
; ERSLE$ ERIFS$ ERPRT$ ERDNA$ ERUSE$
F%OOPN: PUSH P,S1 ;SAVE LENGTH OF THE FOB
MOVX S1,FBM$OU ;THE FILE IS BEING WRITTEN
MOVEM S1,O$MODE ;
TOPS10<
LOAD S1,FOB.CW(S2),FB.NFO ;GET NEW FILE ONLY FLAG
SKIPE S1 ;IF ITS SET,
SKIPA S1,[EXP FO.PRV+.FOCRE] ;SET FOR FILE CREATION
MOVX S1,<FO.PRV+.FOWRT> ;ELSE, GET PRIVELEGED WRITE FUNCTION
MOVEM S1,O$FUNC ;STORE AS OPEN FUNCTION CODE
> ;END OF TOPS10 CONDITIONAL
TOPS20<
MOVX S1,<^D36B5+OF%WR> ;36 BIT WRITE IS THE FUNCTION
MOVEM S1,O$FUNC ;FOR THE OPENF
LOAD S1,FOB.CW(S2),FB.NFO ;GET THE NEW FILE ONLY BIT
SKIPE S1 ;IF ITS SET
SKIPA S1,[EXP GJ%SHT+GJ%NEW] ;FORCE A NEW FILE
MOVX S1,GJ%SHT+GJ%FOU ;OTHERWISE, JUST NEW GENERATION , SHORT GTJFN
MOVEM S1,O$GJFN ;IS GTJFN FUNCTION
MOVX S1,.CKACN ;THE PROTECTION TO CHECK FOR
MOVEM S1,O$PROT ;CONNECT TO DIRECTORY ACCESS
> ; END OF TOPS20 CONDITIONAL
POP P,S1 ;RESTORE LENGTH OF FOB
PJRST OPNCOM ;DO COMMON OPENING
SUBTTL F%AOPN - Open an output file in append mode
; OPEN FILE FOR OUTPUT, APPENDING IF FILE ALREADY EXISTS
;CALL: S1/ LENGTH OF FILE OPEN BLOCK (FOB)
; S2/ ADDRESS OF FOB (SEE DESCRIPTION IN GLXMAC)
;
;TRUE RETURN: S1/ CONTAINS INTERNAL FILE NUMBER (IFN)
;
;FALSE RETURN: S1/ CONTAINS ERROR CODE
; POSSIBLE ERRORS: ERSLE$ ERIFS$ ERPRT$ ERDNA$ ERUSE$
F%AOPN: PUSHJ P,.SAVE1 ;SAVE A PERM AC
MOVE P1,0(S2) ;GET THE FD ADDRESS.
MOVE P1,.FDFIL(P1) ;GET THE STRUCTURE NAME.
TOPS10<
CAMN P1,[SIXBIT/NUL/] ;IS IT NULL ???
> ;END OF TOPS10 CONDITIONAL
TOPS20<
AND P1,[-1,,777400] ;GET JUST THE BITS WE WANT.
CAMN P1,[ASCIZ/NUL:/] ;IS IT NULL ???
> ;END OF TOPS20 CONDITIONAL
PJRST F%OOPN ;YES,,OPEN IT AS OUTPUT.
MOVX P1,FBM$AP ;FILE IS WRITTEN, APPEND MODE
MOVEM P1,O$MODE ;
TOPS10<
MOVX P1,<FO.PRV+.FOAPP> ;GET PRIVELEGED APPEND FUNCTION
MOVEM P1,O$FUNC ;STORE AS OPEN FUNCTION CODE
> ;END OF TOPS10 CONDITIONAL
TOPS20<
MOVX P1,<^D36B5+OF%WR+OF%RD> ;36 BIT UPDATE MODE IS THE FUNCTION
; USE UPDATE INSTEAD OF APPEND SO THAT
; WE CAN MAP FULL PAGES
MOVEM P1,O$FUNC ;FOR THE OPENF
MOVX P1,GJ%SHT ;USE SHORT GTJFN, AND OLD FILE (IF ANY)
MOVEM P1,O$GJFN ;SET GTJFN FUNCTION
MOVX P1,.CKACN ;THE PROTECTION TO CHECK FOR
MOVEM P1,O$PROT ;CONNECT TO DIRECTORY ACCESS
> ; END OF TOPS20 CONDITIONAL
;F%AOPN IS CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
PUSHJ P,OPNCOM ;OPEN UP THE FILE
JUMPF .RETF ;PASS ON FAILURE IF IT OCCURRED
$SAVE FB ;SAVE FB
MOVE FB,IFNTAB(S1) ;SET FB ADDRESS
SKIPN FB$WRD(FB) ;DOES THIS FILE EXIST?
$RETT ;NO, NO NEED FOR ANYTHING SPECIAL
TOPS10<
PUSHJ P,SETBFD ;SETUP BBP, BIB
MOVE S1,FB$WRD(FB) ;GET THE FILE SIZE
IDIVI S1,SZ.BUF ;DIVIDE BY BUFFER SIZE
MOVEM S1,FB$BFN(FB) ;SAVE BUFFER NUMBER
MOVE S1,FB$IFN(FB) ;GET IFN TO RETURN
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20<
MOVEI S1,FBM$IN ;GET INPUT FUNCTION
MOVEM S1,FB$MOD(FB) ;AND STORE FOR A SHORT TIME
MOVE S1,FB$IFN(FB) ;PUT IFN IN S1
MOVE S2,FB$WRD(FB) ;GET NUMBER OF WORDS IN FILE
IMUL S2,FB$BPW(FB) ;GET NUMBER OF LAST BYTE
SUBI S2,1 ;AND BACK UP BY ONE
$CALL F%POS ;POSITION TO BEFORE LAST BYTE IN FILE
JUMPF [$STOP(CPE,Can't position to EOF)]
MOVE S1,FB$IFN(FB) ;GET THE IFN
$CALL F%IBYT ;GET THE LAST BYTE
JUMPF [$STOP(CRL,Can't read last byte of file)]
MOVEI S1,FBM$AP ;GET APPEND MODE BACK
MOVEM S1,FB$MOD(FB) ;STORE IT
MOVE S1,FB$WRD(FB) ;GET NUMBER OF WORDS IN FILE
IDIVI S1,SZ.BUF ;DIVIDE BY WORDS/BUFFER
MOVNS S2 ;-VE WORDS IN LAST BUFFER
ADDI S2,SZ.BUF ;WORDS REMAINING IN LAST BUFFER
IMUL S2,FB$BPW(FB) ;BYTES REMAINING IN LAST BUFFER
MOVEM S2,FB$BIB(FB) ;STORE IT
MOVE S1,FB$IFN(FB) ;PUT THE IFN IN S1
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL OPNCOM - Common file open routine
OPNCOM: $SAVE <FB> ;PRESERVE REGS
$CALL .SAVET ;SAVE T REGS TOO
MOVE T1,S2 ;SAVE ADDRESS OF FOB
MOVE T4,S1 ;AND ITS LENGTH
CAIGE T4,FOB.MZ ;CHECK FOR MINIMUM SIZE
$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: 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
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
CAXE S1,.TYDSK ;IS IT A DISK?
JRST [ MOVX S1,ERFND$ ;NO, RETURN A 'FILE NOT ON DISK'
PJRST RETERR ] ;
MOVEI S2,FB$RFD+.FDPPN-2(FB) ;LOCATION TO START PATH BLOCK AT
HRLI S2,FDXSIZ-.FDEXT+2 ;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
MOVEI S2,<1000/203> ;GET NUMBER OF BUFFERS
MOVEM S2,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
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,.FOPPN+1 ;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
JUMPL T1,OPNERR ;IF ERROR OCCURRED, COMPLAIN
LOAD S1,FB$FUB+.FOFNC(FB),FO.CHN ;GET THE CHANNEL NUMBER
MOVEM S1,FB$CHN(FB) ;AND SAVE IT AWAY
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
HRROI S2,FB$FD+.FDSTG(FB) ;POINT TO THE FILE
GTJFN ;FIND IT
JRST OPNERR ;LOSE
MOVEM S1,FB$JFN(FB) ;SAVE THE JFN
DVCHR ;LOOK UP THE DEVICE'S CHARACTERISTICS
LOAD S1,S2,DV%TYP ;ISOLATE THE TYPE CODE
CAXN S1,.DVDSK ;MAKE SURE ITS A DISK
JRST OPNC.1 ;DISK..O.K..CONTINUE
CAXE S1,.DVNUL ;ALSO CHECK FOR NUL:
JRST [ MOVX S1,ERFND$ ;LOAD 'DEVICE IS NOT THE DISK'
PJRST RETERR ] ;CLEAN UP AND RETURN
OPNC.1: MOVE S1,FB$JFN(FB) ;RESTORE JFN
CAILE T4,FOB.CD ;IS THIS FOR SOMEONE?
SKIPN T2,FOB.CD(T3) ;IF NOT THERE OR ZERO,
JRST OPNC.2 ;SKIP THE ACCESS CHECK
MOVEM T2,FB$CHK+.CKACD(FB) ;STORE THE CONNECTED 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
$STOP(FOF,File operation failed unexpectedly)
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?
MOVX S2,<.FBLEN,,.FBHDR> ;GET FILE DESCRIPTOR BLOCK
MOVEI T1,FB$FDB(FB) ;AND STORE INTO OUR FB
GTFDB ;
ERJMP .+1 ;IGNORE ERRORS FOR NOW
PUSHJ P,SETFD ;SET UP THE ACTUAL FILE DESCRIPTION
MOVEI S1,^D36 ;GET A FULL WORD BYTE
LOAD S2,FB$FDB+.FBBYV(FB),FB%BSZ ;GET THE SIZE FILE WAS WRITTEN IN
IDIV S1,S2 ;GET BYTES PER WORD
MOVE S2,FB$FDB+.FBSIZ(FB) ;GET HIGHEST BYTE ADDR IN FILE
IDIV S2,S1 ;GET BYTES IN FILE
SKIPE T1 ;ANY RESIDUE?
ADDI S2,1 ;YES, ADD ONE TO WORD COUNT
MOVEM S2,FB$WRD(FB) ;STORE WORDS IN FILE
MOVE S1,FB$IFN(FB) ;PUT IFN IN S1
$RETT ;RETURN SUCCESS, IFN IN S1
> ;END TOPS20 CONDITIONAL
SUBTTL LDLEB - Load a LOOKUP/ENTER block from an FD
; LDLEB IS USED TO LOAD THE LOOKUP/ENTER BLOCK FOR OPEN AND RENAME
; ROUTINES.
; CALL IS: FB/ ADDRESS OF FB
; S1/ ADDRESS OF FD
;
; RETURN: ALWAYS TRUE
TOPS10<
LDLEB: PUSHJ P,.SAVE2 ;GET SOME SCRATCH SPACE
MOVEI S2,.RBTIM ;LENGTH OF LOOKUP
MOVEM S2,FB$LEB+.RBCNT(FB) ;STORE IN LOOKUP/ENTER BLOCK
LOAD S2,.FDNAM(S1) ;GET FILE NAME
MOVEM S2,FB$LEB+.RBNAM(FB) ;STORE IN LOOKUP/ENTER BLOCK
LOAD S2,.FDEXT(S1) ;GET THE EXTENSION
MOVEM 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
$RETT ;THEN RETURN
> ;END OF TOPS10 CONDITIONAL
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$RFD+.FDPPN-2(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+1 ;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 FB$RFD+.FDPAT(S1) ;IS THIS PART OF PATH SPECIFIED?
INCR FB$RFD+.FDLEN(FB),FD.LEN;YES, INCREMENT LENGTH OF FD
AOBJN S1,SETF.1 ;REPEAT FOR ALL PARTS
$RETT ;THEN RETURN TO CALLER
> ;END OF TOPS10 CONDITIONAL
TOPS20<
SETFD: PUSH P,T1 ;SAVE JSYS REGISTER
HRROI S1,FB$RFD+.FDSTG(FB) ;MAKE POINTER TO PLACE TO STORE STRING
MOVE S2,FB$JFN(FB) ;GET JFN OF FILE
MOVX T1,1B2+1B5+1B8+1B11+1B14+JS%TMP+JS%PAF
JFNS ;MAKE STRING FROM JFN
ANDI S1,-1 ;GET ADDRESS LAST USED
SUBI S1,FB$RFD-1(FB) ;GET LENGTH OF THE FD
STORE S1,FB$RFD+.FDLEN(FB),FD.LEN ;STORE THE LENGTH AWAY
POP P,T1 ;RESTORE THE REGISTER
$RETT ;RETURN TO CALLER
> ;END OF TOPS20 CONDITIONAL
SUBTTL SETFOB - Build an internal FOB
;SETFOB is used to create an internal FOB, which is built from a regular
;FOB with any missing fields defaulted. It is used by rename and delete
;to create a complete FOB where the user may have supplied only a partial
;one.
;
;CALL IS: S1/ LENGTH OF INPUT FOB
; S2/ ADDRESS OF INPUT FOB
;TRUE RETURN: S1/ LENGTH OF INTERNAL FOB
; S2/ ADDRESS OF INTERNAL FOB
;
; TRUE RETURN IS ALWAYS GIVEN
SETFOB: PUSHJ P,.SAVE1 ;GET ONE WORK AC
MOVE P1,FOB.FD(S2) ;FD ALWAYS GIVEN
STORE P1,F$FOB+FOB.FD ;SO USE IT
MOVEI P1,^D36 ;ALWAYS USE 36. BIT BYTE SIZE
STORE P1,F$FOB+FOB.CW,FB.BSZ ;FOR THE FILE
CAIG S1,FOB.US ;IS USER ID GIVEN?
TDZA P1,P1 ;NO, FILL IT WITH ZERO
MOVE P1,FOB.US(S2) ;ELSE USE WHAT IS GIVEN
STORE P1,F$FOB+FOB.US ;STORE IT
TOPS20<
CAIG S1,FOB.CD ;IS CONNECTED DIRECTORY GIVEN?
> ;END OF TOPS20 CONDITIONAL
TDZA P1,P1 ;NO, FILL WITH ZERO
MOVE P1,FOB.CD(S2) ;ELSE USE WHAT IS GIVEN
STORE P1,F$FOB+FOB.CD ;STORE IT
MOVEI S1,FOB.SZ ;SIZE OF FOB
MOVEI S2,F$FOB ;AND ITS LOCATION
$RETT ;RETURN WITH POINTERS SET UP
SUBTTL OPNERR - Handle a system error from F%IOPN
;OPNERR IS CALLED ON A SYSTEM GENERATED ERROR IN F%IOPN TO CLEAN
; UP, TRANSLATE THE SYSTEM ERROR CODE INTO A GALAXY ERROR CODE
; AND RETURN FALSE.
;
;RETERR IS LIKE OPNERR, EXCEPT THAT THE ERROR CODE IS ALREADY A GLXLIB ERROR
; CODE, NOT A SYSTEM ERROR CODE
;
;UPON ENTERING, S1 CONTAINS THE ERROR CODE
; FB CONTAINS THE ADDRESS OF THE WORK PAGE
; I CONTAINS THE IFN
OPNERR:
PUSH P,S1 ;SAVE THE ERROR CODE
TOPS20<
PUSHJ P,INTREL ;RELEASE THE IFN
>;END TOPS20
TOPS10<
PUSHJ P,RELFB ;GIVE BACK THE IFN
>;END TOPS10
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
$RETE(FDE) ;NO, RETURN DATA ERROR
> ;END TOPS10
TOPS20<
$CALL .SAVET ;SAVE T1 THRU T4
MOVE S1,FB$JFN(FB) ;GET THE JFN
MOVE S2,FB$BUF(FB) ;GET BUFFER ADDRESS
HRLI S2,(POINT ^D36,0) ;MAKE A BYTE POINTER
MOVEM S2,FB$BRH+.BFPTR(FB) ;SAVE THE BYTE POINTER
MOVNI T1,SZ.BUF ;NUMBER OF WORDS TO READ
SIN ;READ THEM
ERJMP [GTSTS ;GET FILE STATUS
TXNN S2,GS%EOF ;IS IT EOF?
PJRST GETERR ;GET ERROR, MAP IT AND RETURN
PUSHJ P,POSEOF ;YES, SET EOF
JRST GETB.1] ;AND CONTINUE ON
GETB.1: ADDI T1,SZ.BUF ;ADD NUMBER OF WORDS REQUESTED
MOVEM T1,FB$BRH+.BFCNT(FB) ;STORE NUMBER OF WORDS READ
JUMPE T1,POSEOF ;GOT EOF!!
> ;END TOPS20
GETB.2: AOS FB$BFN(FB) ;INCREMENT BUFFER NUMBER
PUSHJ P,SETBFD ;SETUP BUFFER DATA
$RETT
SUBTTL F%POS - Position an input file
SUBTTL F%REW - Rewind an input file
;F%POS is called for a file open for INPUT to position to a
; particular byte within the file.
;
;F%REW is a special case of F%POS to position to the first byte
; of the file.
;
;Call: S1/ IFN (for F%POS and F%REW)
; S2/ Byte number (for F%POS only)
;
;True Return: Nothing returned
;
;False Return: S1/ Error code: ERIFP$ ERFDE$
F%REW: SETZ S2, ;POSITION TO BYTE 0 FOR REWIND
F%POS: PUSHJ P,CHKIFN ;CHECK THE IFN GIVEN
$CALL .SAVET ;SAVE T REGS
MOVE T4,S2 ;SAVE DESIRED BYTE NUMBER
MOVE S1,FB$MOD(FB) ;GET I/O MODE
CAIN S1,FBM$IN ;IS IT INPUT?
JRST POS.1 ;YES, ALL IS WELL
CAIN S1,FBM$UP ;UPDATE?
HALT . ;NO IMPLEMENTED
JRST ILLMOD ;ELSE, LOSE
POS.1: CAME S2,[EXP -1] ;DOES HE WANT EOF?
JRST POS.2 ;NO, CONTINUE ON
PUSHJ P,POSEOF ;SETUP EOF
$RETT ;AND RETURN
POS.2: SKIPGE S2 ;RANGE CHECK THE BYTE NUMBER
$RETE(IFP) ;NEGATIVE BYTES LOSE
SKIPN T1,FB$WRD(FB) ;GET WORDS IN FILE
JRST [PUSHJ P,POSEOF ;NULL FILE,,POSITION TO EOF
$RETT ] ;AND RETURN
IMUL T1,FB$BPW(FB) ;CONVERT TO BYTES
CAMLE S2,T1 ;POSITIONING WITHIN FILE?
$RETE(IFP) ;NO, LOSE
MOVE T1,FB$BPW(FB) ;GET BYTES PER WORD
IMULI T1,SZ.BUF ;GET BYTES PER BUFFER
MOVE T2,S2 ;COPY THE BYTE NUMBER OVER
IDIV T2,T1 ;T2=BUFFER NUMBER
;T3=BYTE WITHIN BUFFER
SKIPN FB$EOF(FB) ;ARE WE AT EOF?
CAME T2,FB$BFN(FB) ;YES, IS BYTE IN CURRENT BUFFER?
JRST POS.4 ;WE HAVE TO DO SOME WORK
PUSHJ P,SETBFD ;SETUP POINTERS FOR THIS BUFFER
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVNS T3 ;NEGATE BYTE COUNT
ADDM T3,FB$BIB(FB) ;TO DECREMENT BUFFER COUNT
MOVNS T3 ;RE-NEGATE
IDIV T3,FB$BPW(FB) ;CONVERT TO WORDS
ADDM T3,FB$BBP(FB) ;PUSH UP THE BYTE POINTER SOME
POS.3: SOJL T4,.RETT ;MORE ODD BYTES?
IBP FB$BBP(FB) ;YES, BUMP THE POINTER
JRST POS.3 ;AND LOOP
;F%POS IS CONTINUED ON THE FOLLOWING PAGE
;CONTINUED FROM THE PREVIOUS PAGE
POS.4:
SETOM FB$BIB(FB) ;FORCE A READ
MOVEM T2,FB$BFN(FB) ;SAVE FOR POSBUF
SOS FB$BFN(FB) ;BUT DECREMENT FOR LATER INCREMENT
TOPS10<
HRL S1,FB$CHN(FB) ;GET CHANNEL NUMBER
HRRI S1,.FOUSI ;USETI CODE
SETO S2, ;POSITION TO EOF
MOVE T1,[2,,S1] ;FILOP ARG POINTER
FILOP. T1, ;POSITION TO EOF
JFCL ;IGNORE THE ERROR (ALWAYS HAPPENS)
MOVE S2,T1 ;COPY STATUS BITS
TXZ S2,IO.EOF ;CLEAR EOF
HRRI S1,.FOSET ;DO A SETST ON THE SAME CHANNEL
MOVE T1,[2,,S1] ;AIM AT ARG LIST
FILOP. T1, ;CLEAR EOF, SO INPUT WINS
$RETE (FDE) ;CAN'T CLEAR EOF, TELL USER
;NOW, LOOP AROUND DOING INPUTS UNTIL THE MONITOR HAS TO READ US A NEW BUFFER
POS.5: HRRI S1,.FOINP ;INPUT FUNCTION ON SAME CHANNEL
MOVE S2,[1,,S1] ;FILOP ARG POINTER
FILOP. S2, ;START FLUSHING UNTIL EOF
SKIPA ;EOF FINALLY?
JRST POS.5 ;NO, LOOP
TXZN S2,IO.EOF ;END OF FILE?
$RETE (FDE) ;NO, FILE DATA ERROR
HRRI S1,.FOSET ;SETSTS FUNCTION FOR THIS CHANNEL
MOVE T1,[2,,S1] ;SETUP FOR FILOP.
FILOP. T1, ;RESET THE I/O STATUS
$RETE (FDE) ;CAN'T CLEAR EOF, NEXT IN WOULD LOSE
MOVEI S2,1(T2) ;NOW, GET BLOCK TO POSITION TO
;(ADD 1 TO CONVERT FROM OUR 0 BASE
; CONVENTION TO USETI 1 BASE)
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
HRRI S1,.FOUSI ;USETI FUNCTION ON THIS CHANNEL
MOVE T1,[2,,S1] ;ARG POINTER
FILOP. T1, ;SET THE BLOCK NUMBER
$RETE (FDE) ;CAN'T, TELL USER
> ;END TOPS10
TOPS20<
MOVE S2,T2 ;GET BUFFER NUMBER
IMULI S2,SZ.BUF ;CONVERT TO WORD NUMBER
MOVE S1,FB$JFN(FB) ;GET THE JFN
SFPTR ;SET FILE POINTER
PUSHJ P,S..FOF ;LOSE BIG!!!
> ;END TOPS20
PUSHJ P,GETBUF ;READ THAT NEXT BUFFER
SKIPT ;GETBUF WINS !!!
CAXE S1,ERFDE$ ;NOPE,,IS IT FILE DATA ERROR ???
SKIPA ;NO,,MAY BE OK
$RET ;YES,,RETURN FILE DATA ERROR
SETZM FB$EOF(FB) ;CLEAR EOF FLAG
MOVE S2,T4 ;RESET DESIRED POSITION
JRST POS.2 ;GO BACK AND POSITION IN THIS BUFFER
POSEOF: SETOM FB$BIB(FB) ;MAKE SURE WE ALWAYS GET HERE
SETOM FB$EOF(FB) ;DITTO
$RETE(EOF) ;RETURN THE ERROR
SUBTTL F%OBYT - Write one byte into file
;F%OBYT is called for an open OUTPUT or APPEND file to write one byte.
;
;Call: S1/ IFN
; S2/ Byte to write
;
;True Return: No data returned
;
;False Return: S1/ Error code: ERFDE$
F%OBYT: PUSHJ P,CHKIFN ;CHECK OUT THE IFN
SETOM FB$FNC(FB) ;DO SOMETHING ON NEXT CHECKPOINT CALL
MOVE S1,FB$MOD(FB) ;GET THE MODE
CAIE S1,FBM$OU ;IF OUTPUT
CAIN S1,FBM$AP ;OR APPEND
JRST OBYT.1 ;CONTINUE ON
JRST ILLMOD ;ELSE, LOSE
OBYT.1: SOSGE FB$BIB(FB) ;ANY ROOM IN BUFFER?
JRST OBYT.2 ;NO, DUMP THE BUFFER AND GET NEXT ONE
IDPB S2,FB$BBP(FB) ;YES, DEPOSIT THE BYTE
$RETT ;RETURN TRUE
OBYT.2: PUSH P,S2 ;SAVE S2
PUSHJ P,PUTBUF ;WRITE OUT THE BUFFER
POP P,S2 ;RESTORE S2
JUMPF .RETF ;PROPAGATE AN ERROR
JRST OBYT.1 ;ELSE, TRY AGAIN
SUBTTL F%OBUF - Write a buffer full of data to a file
;F%OBUF is called to transfer a buffer full of data to a file which is
; open for OUTPUT or APPEND.
;
;Call: S1/ IFN
; S2/ XWD Number of bytes,Address of buffer
;
;True Return: No data returned
;
;False Return: S1/ Error code: ERFDE$
F%OBUF: PUSHJ P,CHKIFN ;CHECK THE IFN OUT
PUSHJ P,.SAVE4 ;SAVE P1 THRU P4
SETOM FB$FNC(FB) ;DO SOMETHING ON NEXT CHECKPOINT CALL
MOVE P1,FB$MOD(FB) ;GET THE MODE
CAIE P1,FBM$OU ;IF IT IS OUTPUT
CAIN P1,FBM$AP ; OR APPEND,
SKIPA ; THEN WIN
JRST ILLMOD ;ELSE LOSE
HRRZ P1,S2 ;GET ADDRESS IN P1
HLRZ P2,S2 ;GET COUNT IN P2
HRLI P1,(POINT) ;MAKE IT A BYTE POINTER
MOVE P3,FB$BYT(FB) ;GET BYTE SIZE
DPB P3,[POINT 6,P1,11] ;STORE IT
MOVE S1,FB$BIB(FB) ;GET BYTES REMAINING
IDIV S1,FB$BPW(FB) ;DIVIDE BY BYTES/WORD
JUMPE S2,OBUF.5 ;JUMP TO SPECIAL CASE IF WORD-ALIGNED
OBUF.1: SOJL P2,.RETT ;RETURN WHEN DONE
ILDB P3,P1 ;ELSE, GET A BYTE
OBUF.2: SOSGE FB$BIB(FB) ;ANY ROOM IN BUFFER?
JRST OBUF.3 ;NO, GET MORE ROOM
IDPB P3,FB$BBP(FB) ;STORE THE BYTE
JRST OBUF.1 ;AND LOOP
OBUF.3: PUSHJ P,PUTBUF ;WRITE OUT THE BUFFER
JUMPF .RETF ;PROPAGATE THE FAILURE
JRST OBUF.2 ;AND TRY AGAIN
;F%OBUF IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;HERE IF CURRENT BUFFER IS WORD ALIGNED
;P1 CONTAINS BYTE POINTER TO USER'S BUFFER
;P2 CONTAINS BYTE COUNT
OBUF.5: IDIV P2,FB$BPW(FB) ;P2 GETS WORD COUNT P3 GET REMAIN BYTES
;NOW LOOP BLT'ING AS MANY OF THE USER'S DATA WORDS AS WILL FIT INTO THE
; FILE BUFFER EACH TIME THRU.
OBUF.6: JUMPE P2,OBUF.8 ;DONE IF NOTHING LEFT TO MOVE
SKIPE S1,FB$BIB(FB) ;ANY ROOM IN BUFFER?
JRST OBUF.7 ;YES, CONTINUE ON
PUSHJ P,PUTBUF ;NO, DUMP IT OUT
JUMPF .RETF ;IF FAILURE, RETURN IT
MOVE S1,FB$BIB(FB) ;NOW GET BYTES REMAINING IN BUFFER
OBUF.7: IDIV S1,FB$BPW(FB) ;GET WORDS REMAINING IN BUFFER
CAML S1,P2 ;IS THERE ENOUGH ROOM FOR ALL USER DATA?
MOVE S1,P2 ;YES, USE DATA COUNT
SUB P2,S1 ;AND UPDATE FOR NEXT ITERATION
MOVN S2,S1 ;GET NEGATIVE WORD COUNT
IMUL S2,FB$BPW(FB) ;GET NEGATIVE BYTE COUNT
ADDM S2,FB$BIB(FB) ;UPDATE BUFFER BYTE COUNT
MOVE S2,FB$BBP(FB) ;GET BUFFER BYTE POINTER
ADDM S1,FB$BBP(FB) ;UPDATE FOR NEXT ITERATION
IBP S2 ;NORMALIZE THE BYTE POINTER
HRL S2,P1 ;MAKE A BLT POINTER
ADD P1,S1 ;UPDATE SOURCE POINTER
ADDI S1,-1(S2) ;GET END OF BLT ADDRESS
BLT S2,(S1) ;MOVE SOME DATA
JRST OBUF.6 ;AND LOOP
OBUF.8: SOJL P3,.RETT ;RETURN WHEN NO MORE BYTES
ILDB S2,P1 ;GET A BYTE
MOVE S1,FB$IFN(FB) ;GET THE IFN
$CALL F%OBYT ;WRITE THE BYTE
JRST OBUF.8 ;AND LOOP
SUBTTL PUTBUF - Give one output buffer to the operating system
;PUTBUF is called from F%OBYT and F%OBUF to write a buffer full of information
; into the output file. It has no explicit input arguments. On True
; return it has no explicit output arguments but it returns with the FB
; fully updated.
;
;False return: S1/ Error code: ERFDE$
TOPS10<
PUTBUF: 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 CHENNEL NUMBER
HRRI S1,.FOOUT ;GET OUTPUT FUNCTION
MOVE S2,[1,,S1] ;SETUP ARG POINTER
FILOP. S2, ;OUTPUT A BLOCK
$RETE(FDE) ;ERROR!
;AND FALL INTO PUTB.1
> ;END TOPS10
TOPS20<
PUTBUF: PUSHJ P,WRTBUF ;WRITE OUT THE BUFFER
JUMPF GETERR ;RETURN FILE DATA ERROR
MOVE S1,FB$BUF(FB) ;GET ADDRESS OF BUFFER
HRLI S1,(POINT ^D36,0) ;MAKE A BYTE POINTER
MOVEM S1,FB$BRH+.BFPTR(FB) ;SAVE BUFFER BYTE POINTER
MOVEI S1,SZ.BUF ;LOAD BUFFER SIZE
MOVEM S1,FB$BRH+.BFCNT(FB) ;AND STORE IT
> ;END TOPS20
PUSHJ P,SETBFD ;SET BUFFER DATA (BBP, BIB)
AOS FB$BFN(FB) ;INCREMENT THE BUFFER NUMBER
$RETT ;AND RETURN
SUBTTL F%CHKP - Checkpoint a file
;F%CHKP is called to checkpoint the current file. If the file is open
; for INPUT, the number of the next byte to be returned to the
; user is returned. If the file is opened for OUTPUT, all internal
; buffers are written out, and all file pointers are updated to
; relect the file's existence. The byte number of the next byte
; to be written is returned.
;
;Call: S1/ IFN
;
;True Return: S1/ Number of next byte
;
;False Return: S1/ Error code: ERFDE$ or MAPERR mapping
F%CHKP: PUSHJ P,CHKIFN ;CHECK OUT THE IFN
MOVE S1,FB$MOD(FB) ;GET THE MODE
CAIN S1,FBM$IN ;IS IT INPUT?
JRST CHK.I ;YES, GO HANDLE IT
CAIE S1,FBM$OU ;IS IT OUTPUT
CAIN S1,FBM$AP ;OR APPEND?
JRST CHK.O ;YES, GO HANDLE THAT
CAIN S1,FBM$UP ;IS IT UPDATE
HALT . ;YES, NOT IMPLEMENTED YET!
JRST ILLMOD ;ELSE, ILLEGAL MODE
CHK.I: SETO S1, ;SETUP TO RETURN EOF
SKIPE FB$EOF(FB) ;HIT EOF?
SKIPLE FB$BIB(FB) ;YES, ANYTHING LEFT IN THE BUFFER?
JRST NXTBYT ;GO COMPUTE AND RETURN NEXT BYTE NUMBER
$RETT ;NO, REALLY EOF
CHK.O: $CALL .SAVE1 ;SAVE P1
PUSHJ P,NXTBYT ;GET NEXT BYTE NUMBER
MOVE P1,S1 ;SAVE IT
PUSHJ P,CHKOS ;CHECKPOINT THE OUTPUT
JUMPF .RETF ;FAILED?
MOVE S1,P1 ;GET THE BYTE NUMBER BACK
$RETT ;AND RETURN
NXTBYT: SKIPGE S1,FB$BFN(FB) ;ANY INPUTS DONE YET?
JRST [SETZM S1 ;NO, RETURN BYTE 0
$RETT] ; AND TRUE!
IMUL S1,FB$BPW(FB) ;GET NUMBER OF COMPLETE WORDS
IMULI S1,SZ.BUF ;GET NUMBER OF COMPLETE BUFFERS
MOVE S2,FB$BRH+.BFCNT(FB) ;GET NUMBER OF WORDS ORIGINALLY IN BFR
IMUL S2,FB$BPW(FB) ;CONVERT TO BYTES
SUB S2,FB$BIB(FB) ;GET REMAININDER OF CURRENT BUFFER
ADD S1,S2 ;AND WE HAVE THE ANSWER
$RETT ;SO RETURN
TOPS10<
CHKOS: SKIPL FB$FNC(FB) ;SKIP IF FILE NEEDS CHECKPOINTING
$RETT ;ELSE, JUST RETURN
SETZM FB$FNC(FB) ;NO LONGER NEEDS CHECKPOINTING
$CALL .SAVE1 ;SAVE P1
MOVE P1,FB$BBP(FB) ;GET THE BUFFER BYTE POINTER
HRRZ S1,FB$BRH+.BFADR(FB) ;GET THE BUFFER ADDRESS
SUB P1,S1 ;GET OFFSET INTO BUFFER
MOVE S1,FB$BIB(FB) ;GET BYTES REMAINING IN BUFFER
IDIV S1,FB$BPW(FB) ;GET WORDS REMAINING
EXCH S1,FB$BRH+.BFCNT(FB) ;EXCH WITH ORIGNINAL WORD COUNT
SUB S1,FB$BRH+.BFCNT(FB) ;GET NUMBER OF WORDS WRITTEN
ADDM S1,FB$BRH+.BFPTR(FB) ;UPDATE THE BYTE POINTER
HRL S1,FB$CHN(FB) ;GET THE CHANNEL NUMBER
HRRI S1,.FOURB ;UPDATE RIB FUNCTION
MOVE S2,[1,,S1] ;FILOP ARG POINTER
FILOP. S2, ;DO THE FILOP.
$RETE(FDE) ;FILE DATA ERROR?
HRRZ S1,FB$BRH+.BFADR(FB) ;GET IN THE NEW BUFFER ADDRESS
ADD P1,S1 ;ADD IT IN
MOVEM P1,FB$BBP(FB) ;AND STORE IT AWAY
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20<
CHKOS: SKIPL FB$FNC(FB) ;SKIP IF FILE NEEDS CHECKPOINTING
$RETT ;ELSE, JUST SKIP IT
SETZM FB$FNC(FB) ;DISK IS (WILL BE) UP TO DATE
$CALL .SAVET ;SAVE T REGS
PUSHJ P,WRTBUF ;WRITE THE BUFFER
JUMPF GETERR ;FILE DATA ERROR?
HRLZ S1,FB$JFN(FB) ;GET THE JFN
MOVE S2,FB$BFN(FB) ;GET THE BUFFER NUMBER
ADDI S2,1 ;GET EVERYTHING TILL THIS ONE
UFPGS ;FORCE IT ALL OUT
ERJMP GETERR ;MAP THE ERROR
MOVE S1,FB$JFN(FB) ;GET THE JFN
RFPTR ;READ THE FILE POINTER
ERJMP GETERR ;MAP THE ERROR
MOVE T1,S2 ;SAVE THE SIZE IN T1
HRRZ S1,FB$JFN(FB) ;GET THE JFN
MOVX S2,.FBSIZ ;GET NUMBER OF WORD TO CHANGE
STORE S2,S1,CF%DSP ;STORE IN S1
TXO S1,CF%NUD ;DON'T UPDATE THE DISK
SETOM S2 ;CHANGE ALL BITS
CHFDB ;CHANGE THE FILE LENGTH
ERJMP GETERR ;MAP THE ERROR
HRRZ S1,FB$JFN(FB) ;GET THE JFN
MOVX S2,.FBBYV ;GET NUMBER OF WORD TO CHANGE
STORE S2,S1,CF%DSP ;STORE IN S1
MOVEI S2,44 ;GET THE BYTE SIZE
STORE S2,T1,FB%BSZ ;STORE IN T1
MOVX S2,FB%BSZ ;PUT MASK IN S2
CHFDB ;CHANGE THE FILE LENGTH
ERJMP GETERR ;MAP THE ERROR
$RETT ;AND RETURN
> ;END TOPS20
SUBTTL WRTBUF - TOPS20 Subroutine to SOUT the current buffer
TOPS20<
;Call: FB$BIB setup
;
;True Return: Buffer SOUTed
;
;False Return: If file data error
WRTBUF: $CALL .SAVET ;SAVE T REGS
MOVE S1,FB$JFN(FB) ;GET THE JFN
MOVE S2,FB$BFN(FB) ;GET THE BUFFER NUMBER
IMULI S2,SZ.BUF ;GET WORD COUNT
JUMPL S2,.RETT ;RETURN IF THIS IS THE DUMMY OUTPUT
SFPTR ;ELSE, SET FILE POINTER
ERJMP [$STOP (CSF,Couldn't set file pointer)]
SKIPN FB$BIB(FB) ;AT END OF BUFFER
JRST WRTB.2 ;YES..NO PADDING NEEDED
MOVE S1,FB$BBP(FB) ;GET THE BUFFER BYTE POINTER
SETZ S2, ;LOAD A NULL
LOAD T1,S1,BP.POS ;GET THE POSITION FIELD
LOAD T2,S1,BP.SIZ ;GET THE SIZE FIELD
WRTB.1: CAMGE T1,T2 ;IS POS .LT. SIZE
JRST WRTB.2 ;YES, WORD IS FULL
IDPB S2,S1 ;NO, DEPOSIT A NULL
SUB T1,T2 ;POS GETS POS-SIZE
JRST WRTB.1 ;AND LOOP
WRTB.2: MOVE S1,FB$JFN(FB) ;GET THE JFN
MOVE S2,FB$BUF(FB) ;GET ADDRESS OF BUFFER
HRLI S2,(POINT ^D36,0) ;MAKE A BYTE POINTER
SKIPGE T1,FB$BIB(FB) ;GET NUMBER OF BYTES LEFT IN THE BUFFER
SETZB T1,FB$BIB(FB) ;-1 IS ACTUALLY 0
IDIV T1,FB$BPW(FB) ;GET NUMBER OF FULL WORDS LEFT
SUBI T1,SZ.BUF ;GET NEGATIVE NUMBER OF WORDS TO XFER
SOUT ;AND DO THE OUTPUT
ERJMP .RETF ;PROPAGATE FAILURE
$RETT ;ELSE, RETURN
> ;END TOPS20
SUBTTL SETBFD -- Setup Buffer Data
;SETBFD is called to set the current 'user' buffer parameters (i.e.
; FB$BIB, FB$BBP) from the 'operating system' values
; (FB$BRH). No calling parameters, returns with BIB and BBP, setup.
SETBFD: MOVE S1,FB$BRH+.BFPTR(FB) ;GET THE BYTE POINTER
MOVE S2,FB$BYT(FB) ;GET BYTESIZE
DPB S2,[POINT 6,S1,11] ;MAKE THE CORRECT BYTE POINTER
MOVEM S1,FB$BBP(FB) ;STORE THE BUFFER BYTE POINTER
MOVE S1,FB$BRH+.BFCNT(FB) ;GET WORD COUNT AGAIN
IMUL S1,FB$BPW(FB) ;CONVERT TO BYTES
MOVEM S1,FB$BIB(FB) ;SAVE FOR USER
$RETT ;AND RETURN
SUBTTL F%REN - Rename a file
; CALLS TO F%REN PROVIDE A SOURCE AND DESTINATION NAME.
; THE SOURCE FILE IS RENAMED TO THE NAME SPECIFIED AS THE
; DESTINATION FILE.
; CALL: S1/ LENGTH OF FILE RENAME BLOCK (DESCRIBED IN GLXMAC)
; S2/ ADDRESS OF FRB (FILE RENAME BLOCK)
;
;TRUE RETURN: IF RENAME OPERATION IS SUCCESSFUL
;
;FALSE RETURN: S1/ ERROR CODE
;
; POSSIBLE ERRORS: ERPRT$ ERFNF$ ERFDS$
TOPS10<
F%REN: $SAVE FB ;SAVE THE FB ADDRESS RESGISTER
PUSHJ P,.SAVET ;GET SOME WORK SPACE
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,.IOIMG ;IMAGE MODE FOR IO
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: MOVE T2,.FDSTR(S1) ;GET SOURCE STRUCTURE
MOVE S2,FRB.DF(T1) ;GET FD FOR DESTINATION
CAME T2,.FDSTR(S2) ;ARE THEY THE SAME STRUCTURE?
JRST REN.22 ;NO, GET RID OF THE IFN, TELL CALLER
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
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
;F%REN IS CONTINUED ON THE FOLLOWING PAGE
;CONTINUED FROM PREVIOUS PAGE
HRLZ S1,T4 ;GET CHANNEL NR. TO USE
IOR S1,[FO.PRV+.FORNM] ;PRIVELEGES+ RENAME FUNCTION
MOVEM S1,FB$FUB+.FOFNC(T3) ;STORE INTO FUNCTION WORD
HRLI S1,.FOPPN+1 ;SET LENGTH OF BLOCK
HRRI S1,FB$FUB(T3) ;AND ITS ADDRESS
FILOP. S1, ;DO THE RENAME
JRST REN.3 ;FAILED...
REN.2: 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
REN.22: MOVE S1,FB$IFN(T3) ;GET THE FIRST IFN
$CALL F%REL ;GIVE IT BACK
$RETE(FDS) ;AND COMPLAIN
> ;END OF TOPS10 CONDITIONAL
TOPS20<
F%REN: PUSHJ P,.SAVET ;GET SOME WORK SPACE
CAIG S1,FRB.DF ;REQUIRE AT LEAST SOURCE AND DEST.
$STOP(RTS,Rename block too small)
MOVE T4,FRB.DF(S2) ;REMEMBER THE DESTINATION
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
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(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
PUSHJ P,S..FOF ;STOP "FILE OPERATION FAILED..."
JUMPE S1,[ MOVX S1,OPNX3 ;RETURN A PROTECTION FAILURE
JRST REN.4 ] ;TO CALLER
REN.2: MOVE S1,FB$JFN(T3) ;GET JFN OF SOURCE FILE
TXO S1,CO%NRJ ;KEEP THE JFN AFTER CLOSING
CLOSF ;CLOSE THE FILE
ERJMP REN.4 ;RETURN ERROR
MOVE S1,FB$JFN(T4) ;GET SOURCE JFN
TXO S1,CO%NRJ ;KEEP THE JFN AFTER CLOSING
CLOSF ;CLOSE DESTINATION TOO
ERJMP REN.4 ;MAP ERROR, RETURN
MOVE S1,FB$JFN(T3) ;SET SOURCE FOR RENAME
MOVE S2,FB$JFN(T4) ;SET DESTINATION TOO
RNAMF ;RENAME THE FILE
ERJMP REN.4 ;RETURN ERROR
MOVE S1,FB$JFN(T4) ;GET DESTINATION JFN
RLJFN ;AND RELEASE IT NOW
ERJMP REN.4 ;IF IT FAILS, COMPLAIN
REN.3: MOVE S1,T1 ;SETUP SOURCE IFN
$CALL F%RREL ;AND RELEASE IT
MOVE S1,T2 ;AND DESTINATION IFN
$CALL F%RREL ;AND RELEASE IT
$RETT ;AND RETURN
REN.31: PUSH P,S1 ;SAVE ERROR CODE
MOVE S1,T1 ;GET SOURCE IFN
$CALL F%REL ;AND RELEASE IT
POP P,S1 ;RESTORE ERROR CODE
$RETF ;PROPAGATE ERROR
REN.4: PUSH P,S1 ;SAVE ERROR CODE
PUSHJ P,REN.3 ;RELEASE ALL IFN'S
POP P,S1 ;RESTORE ERROR CODE
PJRST MAPERR ;RETURN, MAPPING THE ERROR
> ;END OF TOPS20 CONDITIONAL
SUBTTL F%REL - Release a file
;F%REL CLOSES THE FILE AND RELEASE THE IFN.
;CALL: S1/ IFN
;
;TRUE RETURN: IF FILE HAS BEEN CLOSED SUCCESSFULLY.
; NOTE: FILE IS RELEASED (I.E. IFN MADE INVALID) EVEN IF AN ERROR IS
; RETURNED.
;
;FALSE RETURN: S1/ERROR CODE
;
; POSSIBLE ERRORS: ERFDE$
TOPS10<
F%RREL: PUSHJ P,CHKIFN ;CHECK THE IFN
$CALL .SAVE1 ;SAVE P1
HRL S1,FB$CHN(FB) ;GET CHANNEL NUMBER
HRRI S1,.FOCLS ;GET CLOSE FUNCTION
MOVX S2,CL.RST ;GET CLOSE BITS
MOVE P1,[2,,S1] ;GET FILOP. ARG POINTER
FILOP. P1, ;AND RESET THE CHANNEL
JFCL ;IGNORE ERROR ON RESET
JRST INTREL ;AND RELEASE THE CHANNEL
F%REL: PUSHJ P,CHKIFN ;CHECK THE IFN
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
$RETE(FDE) ;LOSE
JRST RELFB ;GET RID OF MEMORY AND RETURN
> ;END TOPS10
TOPS20<
F%REL: PUSHJ P,CHKIFN ;VALIDATE THE IFN ETC.
INTREL: MOVE S1,FB$IFN(FB) ;PUT THE IFN IN S1
$CALL F%CHKP ;AND CHECKPOINT THE FILE
MOVE S1,FB$JFN(FB) ;GET THE JFN
CLOSF ;GET RID OF IT
JRST INTR.1 ;PROCESS THE ERROR
JRST RELFB ;AND DELETE THE FB
INTR.1: MOVE S1,FB$JFN(FB) ;GET THE JFN
RLJFN ;RELEASE THE JFN
JRST .+1 ;IGNORE THE ERROR
JRST RELFB ;AND DELETE THE FB
F%RREL: PUSHJ P,CHKIFN ;VALIDATE THE IFN ETC.
MOVE S1,FB$JFN(FB) ;GET THE JFN
TXO S1,CZ%ABT ;ABORT THE OPERATION
CLOSF ;CLOSE THE FILE
ERJMP .+1 ;IGNORE THE ERROR
JRST RELFB ;AND DELETE THE FB
> ;END TOPS20
SUBTTL F%DREL - Delete a file and release it
;CALL: S1/ IFN
;
;TRUE RETURN: IF DELETION COULD BE ACCOMPLISHED
;
;FALSE RETURN: S1/ ERROR CODE
;
;POSSIBLE ERRORS: ERPRT$ ERUSE$
TOPS10<
F%DREL: PUSHJ P,CHKIFN ;CHECK FOR LEGAL IFN
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,.FOPPN+1 ;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(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
PUSHJ P,S..FOF ;ALL LEGAL ERRORS ALREADY SCREENED
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,<MOVE S1,FINF+.RBTIM(FB)>,<MOVE S1,FINF+.FBCRV(FB)>
SYSPRM XX.GEN,<MOVE S1,FINF+.RBVER(FB)>,<LDB S1,[POINTR(FINF+.FBGEN(FB),FB%GEN)]>
SYSPRM XX.PRT,<LDB S1,[POINTR(FINF+.RBPRV(FB),RB.PRV)]>,<LDB S1,[POINTR(FINF+.FBPRT(FB),RHMASK)]>
SYSPRM XX.CLS,<SETZM S1>,<LDB S1,[POINTR(FINF+.FBCTL(FB),FB%FCF)]>
SYSPRM XX.AUT,<MOVE S1,FINF+.RBAUT(FB)>,<LDB S1,[POINTR(FINF+.FBUSE(FB),RHMASK)]>
SYSPRM XX.USW,<MOVE S1,FINF+.RBNCA(FB)>,<MOVE S1,FINF+.FBUSW(FB)>
SYSPRM XX.SPL,<MOVE S1,FINF+.RBSPL(FB)>,<SETZM S1>
XX.SIZ==< PUSHJ P,[EXP <MOVE S1,FB$WRD(FB)>,<IMUL S1,FB$BPW(FB)>,<POPJ P,>]>
SYSPRM XX.MOD,<LDB S1,[POINTR(FINF+.RBPRV(FB),RB.MOD)]>,<LDB S1,[POINTR(FINF+.FBBYV(FB),FB%MOD)]>
SYSPRM XX.CHN,<MOVE S1,FB$CHN(FB)>,<MOVE S1,FB$JFN(FB)>
DEFINE X(A)<
EXP < XX.'A>
> ;END OF X DEFINITION
FITAB: CFI
LEN.FI==.-FITAB
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
$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%, ERIFS$
XWD ERPRT%, ERPRT$
XWD ERFBM%, ERPRT$
XWD ERAEF%, ERFAE$
XWD ERDNA%, ERDNA$
XWD ERNSD%, ERNSD$
XWD ERNRM%, ERQEF$
XWD ERWLK%, ERPRT$
XWD ERNET%, ERSLE$
XWD ERSNF%, ERFNF$
XWD ERLVL%, ERFNF$
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 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)
FIL%L: END
$RETE(USE) ;IF EXHAUSTED, RETURN 'UNEXPECTED ERROR'
MAPE.2: HRRZ S1,ERRTAB(S2) ;PICK UP THE SYSTEMIZED ERROR CODE
MOVEM S1,.LGERR## ;SAVE THE ERROR CODE
MOVEI S2,. ;ALSO OUR CURRENT LOCATION
MOVEM S2,.LGEPC## ;FOR LATER EXAMINATION
$RETF ;THEN TAKE A FAILURE RETURN
TOPS20 <
ERR20: MOVX S1,.FHSLF ;GET OUR HANDLE
GETER ;GET THE ERROR WHICH DID US IN