Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/cpafil.mac
There are 7 other files named cpafil.mac in the archive. Click here to see a list.
TITLE CPAFIL -- File I/O needed by CMDPAR
SUBTTL Irwin L. Goverman - Larry Samberg/MLB/DC/PW/AWC 12-Sep-79
;
;
;
; COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1978, 1986.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
; COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
; ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
; AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
; SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
; EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
; ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;
SEARCH CPASYM ;SEARCH SUBSYSTEMS SYMBOLS
PROLOG(CPAFIL) ;GENERATE PROLOG CODE
SUBTTL Table Of Contents
SUBTTL Revision History
SUBTTL Local AC definitions and Entry Points
FB==15 ;ALWAYS ADDRESS OF CURRENT FILE BLOCK
ENTRY F%INIT,F%IOPN,F%IBYT,F%IBUF,F%REL,F%INFO
SUBTTL Module Storage
$IMPURE
;TEMPORARY ASSIGNMENT TILL CPAFIL CHANGE MADE TO USE THIS CPAFIL
SYSPRM SZ.BUF,200,200 ;SIZE OF BUFFER AREA
SYSPRM SZ.OBF,200,200 ;MAXIMUM WORDS XFERRED ON F%?BUF CALL
$DATA IFNTAB,1+1 ;ADDRESS OF FILE DATA PAGE FOR
; TAKE IFN
$DATA TAKBUF,SZ.BUF+3 ;TAKE INPUT BUFFER (+3 FOR -10 BH)
; 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
$DATA TAK.FB,FB$END ;FB OF TAKE FILE
$PURE
SUBTTL F%INIT - Initialize the world
;F%INIT IS CALLED TO INITIALIZE THE CPAFIL MODULE. IT MUST
; BE CALLED BEFORE ANY OTHER ROUTINE IN CPAFIL 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
$CALL .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 CPASYM)
; 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 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
$CALL 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
$STOP(IBS,Illegal byte size given)
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,1 ;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
$CALL 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
$CALL 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
$CALL 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: $CALL .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?
JRST [MOVEI T1,FD.LEN ;GET LEN OF FD
ADDM T1,FB$RFD+.FDLEN(FB) ;ADD TO CURR POS
JRST .+1]
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 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 CPALIB 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<
$CALL INTREL ;RELEASE THE IFN
>;END TOPS20
TOPS10<
$CALL 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
$CALL 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: $CALL 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: $CALL 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
$CALL 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: $CALL 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: $CALL 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
$CALL SETBFD ;SETUP BUFFER DATA
$RETT
SUBTTL MISCELLANEOUS ROUTINES
POSEOF: SETOM FB$BIB(FB) ;MAKE SURE WE ALWAYS GET HERE
SETOM FB$EOF(FB) ;DITTO
$RETE(EOF) ;RETURN THE ERROR
;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%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%REL: $CALL 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: $CALL CHKIFN ;VALIDATE THE IFN ETC.
INTREL: MOVE S1,FB$IFN(FB) ;PUT THE IFN IN S1
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
> ;END TOPS20
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 CPASYM)
;
; RETURN: S1/ CONTENTS OF DESIRED WORD
F%INFO: $CALL 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 ALCIFN - Allocate an Internal File Number
;CALL: NO ARGUMENTS
;
;TRUE RETURN: FB/ ADRESS OF THE FILE BLOCK
;
;FALSE RETURN: S1/ERROR CODE
;
ALCIFN: $CALL .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 S2,TAK.FB ;GET TAKE FB
MOVEM S2,IFNTAB(P1) ;STORE ADDRESS IN TABLE
MOVE FB,S2 ;SETUP FB REGISTER
HRRZM P1,FB$IFN(FB) ;SAVE THE IFN
MOVEI S1,TAKBUF ;BUFFER PAGE ADDR
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$IFN(FB) ;GET THE IFN
SETZM IFNTAB(S1) ;CLEAR THE IFN TABLE ENTRY
$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: $CALL .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
XMOVEI T1,RSTIFN ;PLACE TO RESTORE THE REGS FROM
PUSH P,T1
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)
END