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