Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/rmsio.mac
There are 20 other files named rmsio.mac in the archive. Click here to see a list.
; UPD ID= 1526 on 2/7/84 at 4:07 PM by HOFFMAN
TITLE RMSIO FOR LIBOL 13 - LIBOL MODULE TO HANDLE RMS I/O
SUBTTL D. WRIGHT / J. MASLANKA
SEARCH COPYRT
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) 1979, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
HISEG
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
RMSV2==2 ;RMS V2 VERSION NO.
;EDIT HISTORY
;WHO DATE COMMENT
;***** V12B *****
;SMI 14-Oct-82 [1046] Fix CHECKPOINT with RMS files for DELETE and REWRITE.
; Modified by JSM for COBOL V13 18-Nov-82.
;JSM 18-Oct-82 [1045] Use $MESSAGE in RMSGET as first RMS-20 call to
; initialize RMS-20 global data symbols.
;RLF 8-Oct-82 [1044] Space fill record area.
;RJD 29-Apr-82 [1022] Deallocate memory if OPEN fails.
;RJD 21-Apr-82 [1020] Test for CHECKPOINT with RMS files.
; Modified by JSM for COBOL V13 18-Nov-82.
;NOTE: THIS MODULE DOES NOT SUPPORT THE FOLLOWING ANS 8X FILE-STATUS CODES:
; 07 OPEN/CLOSE - NO REWIND, REEL, UNIT, FOR REMOVAL
; A TEMPORARY DIAGNOSTIC FOR THIS STATE IS GIVEN IN THE COMPILER.
; 14 SEQUENTIAL READ OF RELATIVE FILE - KEY VALUE WONT FIT IN KEY FIELD
; 36 OPEN MULTI-FILE TAPE - FILE IS ALREADY OPEN OR DOES NOT EXIST
; SINCE MAG-TAPE IS CURRENTLY NOT ALLOWED IN RMS-20, THIS
; CODE WILL BE COVERED BY CODE 37, WHICH INDICATES A DEVICE
; ERROR.
;Note, parts of this routine run in a non-zero section.
;Eventually all of it should.
;So be very careful to observe the usages of the SETSEC and RETSEC macros
;around the RMS JSYS Calls.
SEARCH LBLPRM ;GET COBOTS PARAMETERS
;GET APPROPRIATE SYSTEM SYMBOLS
;Note: The monitor symbol universal files must be searched before
;COMUNI to avoid conflicts with LOAD and STORE macros
IFN TOPS20, SEARCH MONSYM,MACSYM
IFE TOPS20, SEARCH UUOSYM,MACTEN
IFN TOPS20,< SM%RWX==:SM%RD!SM%WR!SM%EX> ; CONVENIENCE
SEARCH COMUNI ;GET COMMON SYMBOLS, MACROS
SEARCH FTDEFS ;FILE-TABLE DEFINITIONS
SEARCH RMSINT ;AND RMS SYMBOLS
;****** MAGIC NUMBERS FIXED IN NEXT VERSION OF RMSINT ********
BA$OVH==6 ;HEADER WORDS IN A BUCKET
BA$WPU==^D512 ; WORDS PER BUCKET UNIT
;*************************************************************
T0=0
T1=1 ;NOT DEFINED IN COMUNI YET
T2=2
T3=3
T4=4
P1=5 ;PERM. AC (SAVED ACROSS SUBROUTINES)
P2=6
P3=7
P4=10
C=11
FT=12 ;FILE TABLE PTR (PERM)
FTL=13
FLG=14
ARG=16
PP=17
REPEAT 0,< ;DISABLE ASCII STREAM
CRBUF: XWD 64000,0 ;CARRIAGE-RETURN
;THE FOLLOWING TABLE WAS ADAPTED FROM CBLIO, UNDER THE NAME "WADTBL"
;IT GIVES THE PRINT CONTROL CHANNEL NUMBERS FOR ASCII STREAM TEXT.
; CHAR CHANNEL NUMBER
WVTTBL: XWD 050000,0 ; 8 LF
XWD 060000,0 ; 1 FF
XWD 100000,0 ; 2 DLE
XWD 104000,0 ; 3 DC1
XWD 110000,0 ; 4 DC2
XWD 114000,0 ; 5 DC3
XWD 120000,0 ; 6 DC4
XWD 054000,0 ; 7 VT
> ;END REPEAT 0
;RMS ENTRY POINTS
ENTRY OP.MIX ;OPEN RMS FILE
ENTRY CL.MIX ;CLOSE RMS FILE
ENTRY WT.MIR ;WRITE- RMS RANDOM
ENTRY WT.MIS ;WRITE- RMS SEQUENTIAL
ENTRY WT.MSV ;WRITE RMS ASCII STREAM SEQ FOR VAR LEN RECS
ENTRY RD.MIR ;READ- RMS RANDOM
ENTRY RD.MIS ;READ- RMS SEQUENTIAL
ENTRY DL.MIR ;DELETE RMS (RANDOM ACCESS)
ENTRY DL.MIS ;DELETE RMS (SEQUENTIAL ACCESS)
ENTRY RW.MIR ;REWRITE- RMS (RANDOM ACCESS)
ENTRY RW.MIS ;REWRITE- RMS (SEQUENTIAL ACCESS)
ENTRY ST.MEQ ;START- RMS EQUAL
ENTRY ST.MGT ;START- RMS GREATER THAN
ENTRY ST.MNL ;START- RMS NOT LESS THAN
IFN TOPS20,<
ENTRY FA.MIR ;FAKE READ FOR SMU OPTION 1 FOR KEYED READ TO RMS FILES
ENTRY FA.MIS ;FAKE READ FOR SMU OPTION 1 FOR SEQUENTIAL READ TO RMS FILE
INTERNAL VB.FLG ;BYTE POINTER IS ALSO USED IN LSU
>
;ROUTINES CALLED BY OTHER PARTS OF LIBOL:
ENTRY RMSGET ;GET RMS IN CORE AND TELL IT WHERE THE CORE MANAGER IS
DEFINE TYPE (ADDR),<
IFN TOPS20,<
HRROI T1,ADDR
PSOUT%
>
IFE TOPS20,<
OUTSTR ADDR
>
>
;Macros to make sure RMS JSYSes are called from non-zero section if RMS is in a non-zero section.
DEFINE SETSEC,<
SKIPE RMS.SC ;;Is RMS in a non-zero section?
SKIPE OTS.SC ;;Yes, are we already in non-zero section?
TRNA ;;Yes, OK
XJRSTF [0
1,,.+1] ;;No, so get to section 1
>
DEFINE RETSEC,<
SKIPN OTS.SC ;;Want to return to section zero?
XJRSTF [0
0,,.+1] ;;Yes
>
OPDEF PJRST [JRST]
SUBTTL EXTERNAL ROUTINES AND SYMBOLS
;ROUTINES IN LBLERR:
EXTERN LBLERR ;THE ERROR ROUTINE
EXTERN SETFS ;SET FILE-STATUS FROM FS.FS
EXTERN SETEFS ;SET ERROR-FILE-STATUS VARIABLES
EXTERN CHKUSE ;CHECK FOR USE PROCEDURE
EXTERN RMSERP ;RMS-ERROR REPORT FOR UNEXPECTED ERRORS
EXTERN SU.RMS ;CHECKS OUT SMU OPTION 1 RECORD I-O VERBS
;CONVERSION ROUTINES:
EXTERN C.D6D7,C.D7D6,C.D6D9,C.D9D6,C.D7D9,C.D9D7
;IN LILOWS:
EXTERN CVPRM. ;2-WORD BLOCK TO HOLD CONVERSION PARAMETERS
EXTERN FS.ZRO,FS.IF,FS.FS
IFN TOPS20,<
EXTERN ER.JSE ;JSYS ERROR CODE STORED FOR $ERROR PROCESSING
>
IFE TOPS20,<
EXTERN ER.E10 ;TOPS10 ERROR CODE STORED FOR $ERROR PROCESSING
>
EXTERN ER.RBG ;RMS BUG ERROR CODE
EXTERN SM.ARG ;TWO-WORD ARG BLOCK FOR CALL TO RMS FAKE READS
EXTERN SM.BUF ;ADDRESS OF RMS SHADOW BUFFER FOR RMS FAKE READS
EXTERN SM.RLN ;RECORD LENGTH IN BYTES FOR CALL TO RMS OPEN
EXTERN SM.BN ;BUCKET NUMBER RETURNED FROM FAKE READ CALL
EXTERN SM.BSZ ;RMS FILE BYTE SIZE FOR FAKE READS
EXTERN SM.KBF ;RMS KEY BUFFER ADDRESS FOR FAKE READS
EXTERN SM.KRF ;RMS INDEXED KEY OF REFERENCE NUMBER FOR FAKE READS.
; ALSO USED ON RECORD I-O VERBS TO TRANSMIT CURRENT
; KEY OF REFERENCE NUMBER TO LSU FOR RMS INDEXED FILES.
EXTERN SU.T1 ;SMU OPTION 1 TEMP WHICH CARRIES ADDR OF CURRENT RRT ENTRY
SUBTTL DEFINITIONS (SHARED WITH CBLIO)
F.RAD==3 ;FUNCT. FUNCTION TO RETURN CORE AT ADDRESS
F.PAG==15 ;FUNCT. FUNCTION TO GET CORE ON PAGE BOUNDARY
CKP.FL==1
;SOME DATA MODE SETTINGS FOR TESTING RELATED TO SETTING CF%CNV BIT
BINMOD==0
EBCMOD==1
SIXMOD==2
ASCMOD==3
ASCDDM==4 ;TO HASSLE RMS / CBLIO DEV DATA MODE INCOMPATIBILITY.
;BYTE SIZES AND BYTE COUNTS PER WORD
SIXSIZ==6
ASCSIZ==7
EBCSIZ==9
SIXCT==6
ASCCT==5
EBCCT==4
;RANGE OF RECORD I-O VERB NUMBERS AS SPECIFIED IN THE FORS FOUR BITS OF
; THE FLAGS IN THE FIRST WORD OF THE CALLING ARG LIST
VB%MAX==6 ;HIGHEST RECORD I-O VERB NO.
VB%MIN==3 ;LOWEST RECORD I-O VERB NO.
VB%RD==VB%MIN ;IS READ VERB.
VB%WR==4 ;WRITE VERB
VB%RW==5 ;REWRITE VERB
VB%DL==VB%MAX ;DELETE VERB
VB%ST==7 ;START VERB, THE "FUNNY" RECORD I-O VERB.
RRTKEY==3 ;FOR SMU OPTION 1 REL ADDR OF KEY FIELD IN RRT ENTRY
;DEFINE THE BYTE POINTERS TO ITEMS IN THE FILE TABLE.
;THE ACTUAL DEFINITIONS ARE IN FTDEFS BUT THOSE DEFINITIONS USE ACC 16
;THESE ARE EQUIVALENT BUT USE ACC FT.
;USE THIS METHOD IN CASE THE FTDEFS DEFINITIONS CHANGE.
DEFINE FTDEF (FOO),<<FOO>&<777740,,-1>+<Z (FT)>>
FT.BBL: FTDEF (F%BBLC) ;FILE IS IN OVERLAY
FT.BLF: FTDEF (F%BLF) ;LOCKED
FT.MRS: FTDEF (F%BMRS) ;MAX RECORD SIZE (CHARACTERS)
FT.PPN: FTDEF (F%BPPN) ;ADDRESS OF USER-NUMBER
FT.DIO: FTDEF (F%BDIO) ;DEFERRED OUTPUT BIT
FT.CKP: FTDEF (F%BCKP) ;CHECKPOINT OUTPUT
FT.CRC: FTDEF (F%BCRC) ;[1020] CHECKPOINT RECORD COUNT
FT.NAB: FTDEF (F%BNAB) ;NUMBER OF ALTERNATE BUFFERS
FT.ORG: FTDEF (F%BORG) ;FILE ORG FLAG PTR.
FT.ABL: FTDEF (F%APBL) ;APPLY BASIC-LOCKING FLAG
FT.NOC: FTDEF (F%APBL) ;FLAG FOR WRITING FUNNY <CR> FOR ASCII STREAM
SM1SLF: FTDEF (F%BSLF) ;SMU "SELF" BYTE FOR OPTION 1
PO.CHR: POINT 7,(T1),35 ;GET A CHARACTER TO WRITE AFTER POSITIONING
CH.CHR: POINT 3,T4,17 ;GET CHANNEL CONTROL CHARACTER FROM ARG WORD 3
;FOR MANIPULATING SMU BITS
VB.FLG: POINT 4,(ARG),3 ;VERB FLAG IN %LIT00 OPERAND
VB.FL1: POINT 4,(T4),3 ;VERB FLAG IN %LIT00 OPERAND, FOR USE AT DOCONN PLUS A FEW
SM.SLF: POINT 3,(ARG),11 ;SMU "SELF" BYTE FOR OPTION 5
SM.OTH: POINT 4,(ARG),15 ;SMU "OTHER" BYTE FOR OPTION 5
;AD HOC BITS FOR TESTING SMU REQS IN BYTES FROM LEFT HALF OF ARG WORD.
SMU.RD==1B32 ;READ
SMU.RW==1B33 ;REWRITE
SMU.WR==1B34 ;WRITE
SMU.DL==1B35 ;DELETE
V.OPT5==12 ;SMU OPTION 5 OPEN VERB
V.OPEN==1 ;ANY OTHER OPEN VERB
;FOR CALLS TO CHKUSE:
UP%ERR==0 ;CHECK FOR ERROR USE PROCEDURE
UP%OER==1 ;FILENAME OPEN USE PROCEDURE
IFE TOPS20,<
;PAGE THAT RMS USES FOR ITS GLOBAL STORAGE
.RGLBP==572 ;AND THE NEXT ONE, TOO..
>;END IFE TOPS20
;RANDOM FLAG DEFINITIONS THAT FOR V13 WILL BE DEFINED IN FTDEFS
CF%CNV==1B18 ;CONVERSION REQUIRED
LF%FNA==1B32 ;FILENAME IS IN ASCII
LF%INP==1B33 ;FILE IS OPEN FOR INPUT
LF%OUT==1B34 ;FILE IS OPEN FOR OUTPUT
LF%IO==1B35 ;FILE IS OPEN FOR I-O (ALL 3 BITS ON)
;TWO FLAGS FOR OPTIONAL SEQUENTIAL FILES -- ALSO DEFINED IN CBLIO
FILOPT==200000 ;FILE SPECIFIED AS OPTIONAL IN SELECT. IS IN LEFT-HAND
; OF WORD D.F1 IN THE FILE'S FILE TABLE.
NOTPRS==400 ;OPTIONAL FILE IS NOT PRESENT. SET IN LEFT-HAND OF
; WORD F.WFLG IN THE FILE'S FILE TABLE.
; ADVANCING / POSITIONING BITS FOR WRITING ASCII STREAM FILES
; THESE BITS ARE ALSO DEFINED IN CBLIO
WDVADR==40 ; BIT18-35 IS THE ADDRESS OF THE ADVANCING COUNT
WDVBFR==20 ; =1 IF BEFORE ADVANCING
WDVPOS==10 ; POSITIONING
;WORD NUMBERS FOR ARGUMENT LISTS, ESP ASCII STREAM WRITE ADVANCING
ADVPR0==0 ;FIRST WORD -- HAS FLAGS ,, FT ADDR
ADVPR1==1 ;SECOND WORD -- HAS REC LEN ,, UNUSED
ADVPR2==2 ;THIRD WORD -- HAS ADV/POS PARMS ,, COUNT/ ADDR PARM
; NOTE: ONLY WRITE WITH ADVANCING FOR ASCII STREAM FILES KNOWS ABOUT THE
; THIRD WORD.
SUBTTL PROTOTYPE RMS STRUCTURES
;HA HA THE RMS PEOPLE MADE THIS NECESSARY.
;PROTOTYPE FAB:
PRFAB: FAB$B
FAB$E
PRFABL==.-PRFAB ;LENGTH OF PROTOTYPE FAB
;PROTOTYPE RAB:
PRRAB: RAB$B
RAB$E
PRRABL==.-PRRAB ;LENGTH OF PROTOTYPE RAB
;PROTOTYPE XAB:
PRXAB: XAB$B KEY
X$FLG XB$CHG ;DEFAULT IS TO ALLOW KEYS TO CHANGE
XAB$E
PRXABL==.-PRXAB ;LENGTH OF PROTOTYPE XAB
SUBTTL SETIO - ROUTINE TO SETUP FOR I/O
;CALLED BY EVERY I/O ENTRY POINT
SETIO: MOVEM ARG,BS.AGL ;SAVE BASE OF ARG LIST
HRRZ FT,(ARG) ;GET FILE-TABLE ADDRESS
SETZM FS.FS ;CLEAR OUT FILE-STATUS WORD
PUSHJ PP,SETFS ; AND USER'S F-S FIELD
;IF THE LEFTMOST FOUR BITS OF THE LEFT HALF OF THE ARG WORD IS 12 (I.E.
; V%OPS5) WE HAVE AN SMU OPTION 5 OPEN FOR I-O. THIS VALUE WAS SUBSTITUTED IN
; IOGEN FOR THE 143 OF THE GENFIL OPERATOR WHICH WAS PUT THERE BY COBOLD.
; NOTE: 12 HAPPENS TO BE 2 * 5 OCTAL, MAKING THIS MNEMONIC EASY TO REMEMBER.
; ALSO, THE SEVEN SMU BITS AND THE UNAVAILABLE FLAG WERE PUT IN THE GENFIL
; OPERATOR BY COBOLD AND HAVE BEEN CARRIED ALONG SINCE THEN.
; WE HAVE TO CONVERT THE SMU BITS TO RMS FAC AND SHR FORM AND SAVE THEM
; ASIDE AT OPEN TIME. ALSO, WE HAVE TO SET UP THE LEFT HALF OF THE AC "FLG"
; SO THAT IT SAYS THAT WE ARE DOING AN OPEN FOR I-O, I.E. SET THE BITS
; TO 40700. WHEN WE ARE SETTING UP FAC AND SHR, WE HAVE TO BE ABLE TO GET
; BACK TO THE ORIGINAL FORM OF THE ARG SO THAT WE CAN KNOW IF WE ARE DOING
; A SMU OPEN OR NOT. NOTE: THE SEVEN SMU BITS FOR OPTION 5 DO NOT (REPEAT
; >>>> DO NOT <<<< ) GET PUT INTO WORD F.WSMU IN THE FILE'S FILE TABLE.
; SMU OPTION 5 REQUIRES THAT WE DO NOT TELL LIBOL IN ANY WAY THAT RMS
; IS DOING FILE SHARING FOR US. ONLY SMU OPTION 1 USES F.WSMU. OTHERWISE,
; F.WSMU REMAINS AT 0.
SETZM SMU.AG## ;INIT SMU ARG WORD
LDB T3,VB.FLG ;GET LEFTMOST 4 BITS OF ARG FLAGS
CAIN T3,V.OPT5 ;SMU OPTION 5 OPEN?
PUSHJ PP,STSMU5 ;CONVERT SMU BITS FROM COMPILED TO RMSIO VERSION
CAIE T3,V.OPEN ;ANY OTHER OPEN?
JRST SETIO4 ; NO
SKIPE T3,F.WSMU(FT) ;SMU OPTION 1 OPEN?
PUSHJ PP,STSMU1 ; CONVERT SMU BITS FOR RMSIO OPEN
SETIO4: ;
HLLZ FLG,(ARG) ;GET ARG-LIST FLAGS
CAIN T3,V.OPT5 ;TEST FOR SMU OPTION 5 OPERATOR AGAIN
HRLZI FLG,40700 ; IF SO, MANUFACTURE PROPER OPEN BITS FOR OP.MIX
; I.E. OPEN FOR I-O
SKIPE FTL,D.RMSP(FT) ;GET LIBOL FILE-TABLE ADDRESS
;IF THIS IS AN OPEN, IT WILL SKIP UNLESS
; THE FILE IS ALREADY OPEN. ALL OTHER
; VERBS WILL NOT SKIP HERE.
HRR FLG,D.F1(FT) ;GET LIBOL FILE FLAGS
;AT THIS POINT, WE CHECK FOR SMU OPTION 1. IF IT IS BEING DONE, THE WORD
; F.WSMU IN THE FILE TABLE CONTAINS A NON-ZERO VALUE. THE ONLY VERBS
; CHECKED NOW ARE THE RECORD I-O VERBS -- READ, WRITE, REWRITE AND
; DELETE. IF THESE TWO CONDITIONS ARE MET, WE CALL THE ROUTINE IN LSU
; WHICH CHECKS TO SEE IF THE PROPER RETAIN WAS DONE FOR THIS RECORD I-O
; VERB. IF NOT, THE LSU ROUTINE WILL CAUSE A PROGRAM FAILURE.
SKIPN F.WSMU(FT) ;GET SMU OPTION 1 WORD FROM FILE TABLE
JRST SETIO1 ; IS ZERO, NOT DOING SMU OPTION 1
LDB T1,VB.FLG ;GET VERB FLAG FROM ARG LIST
CAIN T1,VB%ST ;IS IT START VERB?
HRRZI T1,VB%RD ;MAKE IT BE READ FOR PURPOSES OF SMU OPTION 1
CAIL T1,VB%MIN ;READ OR HIGHER?
CAILE T1,VB%MAX ;DELETE OR LOWER?
JRST SETIO1 ; NO
TXNE FLG,FA%FAK ;DON'T DO SU.RMS IF FAKE READ FLAG SET
JRST SETIO1 ;
;NOW CHECK FOR INDEXED FILE AND GET ITS CURRENT KEY-OF-REF NO.
; THE READ VERB CARRIES THE KEY-OF-REF NUMBER IN ITS ARG LIST
; BUT THE OTHERS DO NOT. WE ARE PUTTING THE NUMBER INTO SM.KRF
; NO MATTER WHICH VERB IT IS. HOWEVER, IN SU.RMS FOR THE READ
; VERB THE NUMBER IN THE LEFT HALF OF THE SECOND WORD OF THE ARG
; LIST WILL BE USED INSTEAD OF THIS NUMBER.
SETZM SM.KRF## ;INITIALIZE THIS FIELD FOR CALL TO SU.RMS
MOVE T2,.RCRAB(FTL) ;GET ADDRESS OF RAB
MOVE T3,SM.KRF## ;AND RESET KEY OF REFERENCE TO 0
$STORE T3,KRF,(T2) ;IN THE RAB
;NEXT WE GET THE CURRENT KEY OF REFERENCE
LDB T3,FT.ORG ;GET FILE'S ORGANIZATION FROM FILE TABLE
CAIE T3,IDXFIL ;IS IT INDEXED?
JRST SETIO2 ; FILE NOT INDEXED
CAIN T1,VB%RD ;CHECK FOR READ
TXNN FLG,FA%KYR ; WITH KEY
JRST SETIO3 ;
HLRZ T1,KYINFO(ARG) ; AND IF SO, GET IT FROM THE ARG LIST
MOVEM T1,SM.KRF## ; AND SAVE IT FOR CALL BELOW
JRST SETIO2 ;
SETIO3: ;
HRRZ T2,.RCRAB(FTL) ;FILE IS INDEXED, SO WE GO AHEAD AND GET IT
$FETCH T1,KRF,(T2) ;
MOVEM T1,SM.KRF## ; AND SAVE IT FOR TRANSMISSION TO SU.RMS
SETIO2: ;
PUSHJ PP,SU.RMS ;DO SMU OPTION 1 CHECKS FOR RECORD I-O VERBS
;ZERO THE ERROR STATUS WORDS
SETIO1:
MOVE T1,[FS.ZRO,,FS.FS] ;ZERO THE ERROR STATUS WORDS
BLT T1,FS.IF
POPJ PP, ;RETURN
;FOR SMU OPENS WE HAVE TO MASSAGE THE ARG BITS ONE BY ONE FROM COMPILE
; FORM TO RMS FAC AND SHR FORM BECAUSE THEY ARE IN REVERSE ORDER IN THE
; TWO SYSTEMS. FIRST WE HANDLE FILE ACCESS CAPABILITIES FOR SELF, AND
; THEN FOR THE OTHER. WE NEED TWO ROUTINES FOR THIS BECAUSE THE BITS ARE
; FOUND IN DIFFERENT PLACES (FOR OPTION 1 IN THE FILE TABLE WORD F.WSMU,
; AND FOR OPTION 5 IN THE CALLING ARG LIST) AND WE DO DIFFERENT THINGS
; FOR THEM. FOR OPTION 1 WE SET UP THE FAC BITS AS GIVEN AS WELL AS THE
; SMU OPTION 1 BIT FB$SMU BUT ON SHR WE ONLY GIVE FB$GET. THIS ALLOWS
; THE FAKE RAB TO DO SHARED RETRIEVALS. FOR OPTION 5 WE SET UP BOTH FAC
; AND SHR AS GIVEN AND THAT'S ALL.
STSMU1: ;MASSAGE THE BITS FOR OPTION 1 OPEN
IFE TOPS20,<
TYPE [ASCIZ/
?COBLIB: Simultaneous Update with Retain and Free not allowed on RMS-10 Files
/]
JRST RSFAIR
>
SETZ T2, ;INIT A WORK AC
LDB T1,SM1SLF ;GET SMU OPTION 1 SELF BYTE
PUSHJ PP,SETSLF ; AND GO SET "SELF" BITS
TLO T2,FB$SMU ;SET SMU OPTION 1 CAPABILITY BIT
TRO T2,FB$GET ;ALLOW "OTHER" READ
MOVEM T2,SMU.AG## ;SAVE REFORMATTED BITS
POPJ PP, ; AND RETURN
STSMU5: ;MASSAGE THE BITS FOR OPTION 5 OPEN
SETZ T2, ;INIT A WORK AC
LDB T1,SM.SLF ;GET SMU SELF BYTE - IS ONLY RIGHTMOST THREE BITS
CAIN T1,0 ;SELF WANTS TO READ ONLY?, I.E. READ REGARDLESS
TLO T2,FB$NIL ;YES, SET READ REGARDLESS
CAIE T1,0 ;TEST IT AGAIN IN OPPOSITE SENSE
PUSHJ PP,SETSLF ; AND GO SET "SELF" BITS
PUSHJ PP,SETOTH ;GO SET "OTHER" BITS
MOVEM T2,SMU.AG## ;SAVE REFORMATTED BITS
POPJ PP, ; AND RTEURN
; ROUTINE TO SET "SELF" BITS
SETSLF:
TLO T2,FB$GET ;GIVE SELF READ
TRNE T1,SMU.RW ;REWRITE?
TLO T2,FB$UPD ; YES
TRNE T1,SMU.WR ;WRITE?
TLO T2,FB$PUT ; YES
TRNE T1,SMU.DL ;DELETE?
TLO T2,FB$DEL ; YES
POPJ PP, ;AND RETURN
; ROUTINE TO SET "OTHER" BITS
SETOTH:
LDB T1,SM.OTH ;GET SMU OTHER BYTE
TRNE T1,SMU.RD ;OTHER CAN READ?
TRO T2,FB$GET ; YES
TRNE T1,SMU.RW ;REWRITE?
TRO T2,FB$UPD ; YES
TRNE T1,SMU.WR ;WRITE?
TRO T2,FB$PUT ; YES
TRNE T1,SMU.DL ;DELETE?
TRO T2,FB$DEL ; YES
POPJ PP, ; AND RETURN
;FATAL ERROR - EXCLUDE FILES WITH SEQUENTIAL ORGANIZATION FROM SMU OPTION 1
SM1SER: $ERROR (E.528,SV.KIL,MT.FIL)
;THE FOLLOWING ROUTINE DOES SOME CLEANUP FOR RECORD I-O VERBS.
; FIRST IT SETS THE FILE-STATUS NO MATTER WHAT. THIS WAS SET UP BECAUSE
; A LOT OF THE CODE DOES NOT RETURN TO THE USER IN A WAY WHICH CONSISTENTLY
; CONFORMS TO THE ANSI 74 STANDARD. THUS, IF THE USER HAS FILE-STATUS
; TO TEST AFTER EVERY RECORD I-O VERB, HE CAN PLAY SAFE FOR HIMSELF.
; BESIDES, THIS HAPPENS TO CONFORM TO THE 8X DPANS. ALSO, THE FILE I-O
; VERBS AND THE START VERB HAVE BEEN REVISED TO CALL SETFS IN ANY EVENT.
;
; SECOND IT CHECKS FOR SMU OPTION 1 WITH A RECORD I-O VERB (READ, WRITE,
; REWRITE, OR DELETE) AND IF SO IT CHECKS IF THE RECORD HAS BEEN FLAGGED
; TO BE FREED IMPLICITLY. IF SO, IT CALLS LRDEQX IN LSU TO DO THE JOB.
RCLNUP:
PUSHJ PP,SETFS ;FIRST SET FILE STATUS FOR CALLER
HRRZI T0,0 ;NOW SEE IF WE ARE DOING SMU OPTION 1
CAME T0,F.WSMU(FT) ; IF SO, CHECK TO SEE IF WE SHOULD FREE
; THE CURRENT RECORD.
PUSHJ PP,LRDEQX## ;GO FREE IT
POPJ PP, ; AND RETURN TO WRAP UP RECORD I-O VERB
SUBTTL RMSGET - GET RMS, AND SET IT UP
;CALL: PUSHJ PP,RMSGET
; <RETURN HERE>, OR IF ERRORS, GO TO KILL
; USES AC1-AC4
RMSGET: MOVEI T1,ER$BUG ;GET RMS "BUG" ERROR CODE
MOVEM T1,ER.RBG ;TELL LBLERR
IFN TOPS20,<
;See if we are running version 1 or version 2 of RMS,
; easiest way is by seeing if GTJFN succeeds
MOVX T1,GJ%OLD+GJ%SHT ;
HRROI T2,[ASCIZ/SYS:XRMS.EXE/] ;
GTJFN% ;
ERJMP GETV1 ;Try for version 1
;See if we are running on an extended machine.
;If so call RMS from non-zero section so as to use XRMS in its own section.
XMOVEI T1,. ;SEE IF WE ARE IN SECTION 0
HLRZM T1,OTS.SC## ;SAVE RESULT FOR RETURN TO CALLER
TLNE T1,-1
JRST RMSGT1 ;NO, THEN WE MUST BE EXTENDED
MOVE T1,[.FHSLF,,1] ;YES, SEE IF WE CAN MAP SECTION 0 TO 1
RSMAP% ; THIS IS A TEST FOR AN EXTENDED MACHINE
ERJMP RMSGT1 ;NOT AN EXTENDED MACHINE (I.E. 2020)
;Now map section 0 and 1 together.
AOJN T1,RMSGT1 ;ALREADY DONE (T1 NOT = -1)
MOVSI T1,.FHSLF ;THIS FORK IN SECT 0
MOVE T2,[.FHSLF,,1] ;... IN SECT 1
MOVX T3,SM%RWX+1
SMAP% ;MAP SECTIONS 0 & 1 TOGETHER
ERJMP RMSGT1 ;CAN'T DO IT
;NOW JUMP INTO SECTION 1 FOR REST OF RMS INITIATION
XJRSTF [0
1,,.+1]
;DISABLE TRAPS FOR REFS OF NON-EX PAGE SO PA1050 DOESN'T BOMB OUT RMS
RMSGT1: MOVEI T1,.FHSLF
MOVX T2,1B<.ICNXP>
DIC%
PUSHJ PP,$$RMS ;GET RMS
RETSEC ;IF ORIGINALLY FROM SECTION ZERO, RETURN TO IT
POPJ PP, ;RETURN
>;END IFN TOPS20
IFE TOPS20,<
;TOPS10 - READ IN RMS
SKIPE SLRSW.## ;SKIP IF NOT /R
POPJ PP, ;EVERYTHING TAKEN CARE OF
;SAVE ACS OVER MERGE. UUO CALL
MOVE T1,[T1,,ACSAV0##]
BLT T1,ACSAV0+16 ;SAVE ACS THRU PP
;See if RMS is already part of the OTS
MOVE T1,[.PAGCA,,RMS.FP]
PAGE. T1, ;Get access info for page
HALT ;Should never fail
JUMPL T1,RMSMRG ;Does not exist yet
MOVE T1,RMS.FP*1000+.JBHNM
CAMN T1,['RMSCOB'] ;Is it what we expected?
JRST RMSGOT ;Yes, we already have RMS
RMSMRG: MOVEI T1,RMSNMP ;POINT TO NAME BLOCK
MERGE. T1, ;MERGE IN RMS
HALT . ;TYPE MONITOR ERROR MESSAGE AND DIE
RMSGOT: MOVE T1,[ACSAV0,,T1]
BLT T1,PP ;RESTORE ACS
;Save version number of RMS for LIBOL error printing
HLRZ T1,RMSNMP+5 ;Get starting page number
LSH T1,^D9 ;Shift to make address
MOVE T1,RMSV10(T1) ;Get version number from EXE file
MOVEM T1,RMSVR.## ;Save RMS version number
;DO THE PAGE. UUO TO CREATE THE PAGES THAT RMS NEEDS
MOVE T1,[.PAGCD,,[EXP 2
EXP .RGLBP
EXP .RGLBP+1]]
PAGE. T1, ;CREATE THE PAGES FOR RMS GLOBAL STORAGE
JRST PGUFAI ;;FAILED, GO COMPLAIN
POPJ PP, ;ALL OK, RETURN
PGUFAI: TYPE [ASCIZ/?PAGE. UUO FAILED -- CANNOT SET UP RMS STORAGE
/]
JRST KILL.## ;GO BOMB OUT PROGRAM
RMSNMP: SIXBIT /SYS/
SIXBIT /RMSCOB/
SIXBIT /EXE/
0
0 ;PROJ,,PROG
RMS.FP,,RMS.LP ;WHICH PAGES OF RMSCOB.EXE TO MERGE
>;END IFE TOPS20
IFN TOPS20,<
RMSNMP: POINT 7,[ASCIZ/SYS:RMSCOB.EXE/] ;VERSION 1 RMS
;STORE POINTER TO THIS BLOCK IN RMS ENTRY VECTOR
;RSEBLK: EXP FUNCT.## ;ADDRESS OF FUNCT. ROUTINE
;This code copied from RMSINI.MAC
;However it has to run in the OTS and call RMS from a non-zero section.
$$RMS::
IFN TOPS20,<
;*** The following is needed for TOPS-20 release 5, because XRMS
; is not automatically gotten in just because the JSYS was from
; an extended section.
XMOVEI 1,. ;What section are we in?
TLNE 1,-1 ;Non-zero section?
PUSHJ 17,GINRMS ;Get RMS in, set entry vector
;** End of Release 5 code.
$MESSAGE [0] ;[1045] TURN ON RMS-20 INTERNAL MESSAGE REPORTING
;[1045] AND ALSO INCIDENTALLY INITIALIZE THE
;[1045] AREA FOR RMS-20 GLOBAL DATA SYMBOLS.
POPJ 17, ;OK
HRROI 1,[ASCIZ/? Could not initialize RMS/]
PSOUT% ;TELL USER
HALTF%
;** More release 5 code
; We have to find a free section where RMS will go
GINRMS: MOVE T1,[.XSEVD,,.FHSLF] ;See if RMS has already been initialized
XGSEV%
JUMPE T3,GRMS0 ;None defined yet, go do it
TXZ T3,77B5 ;Clear flags
TLNN T3,-1 ;Must be in a non-zero section..
JRST E$$BRM ;?Can't init XRMS
POPJ P, ;Got it, return
GRMS0: XMOVEI T4,. ;Get this section number
HLRZ T4,T4 ;Start here
GRMS1: AOS T1,T4 ;Try next section
CAILE T1,37 ;Make sure some still left
JRST E$$NFS
HRLI T1,.FHSLF
RSMAP%
ERJMP E$$SNA
AOJN T1,GRMS1 ;Not free, try another
MOVEM T4,RMS.SC## ;Save section number
SETZ T1, ;Create the section
HRLI T2,.FHSLF
HRR T2,T4
MOVX T3,<PM%RWX!1>
SMAP%
ERJMP E$$SNA
MOVX T1,GT%BAS ;Set RMS block to have
MOVEM T1,RMS.BK ; section number in .GBASE
SETZM RMS.BK+.GLOW ;Make sure
SETZM RMS.BK+.GHIGH ; ...
;We have created the section. GET XRMS.EXE into it.
MOVEI T1,.FHSLF ;Get my entry vector
XGVEC% ;Get length in T2, addr in T3
DMOVEM T2,MY.EVC## ;..
MOVX T1,GJ%OLD+GJ%SHT ;Find XRMS.EXE
HRROI T2,[ASCIZ/SYS:XRMS.EXE/]
GTJFN%
ERJMP NOXRMS ;?Can't get V2 RMS
HRRZ T1,T1 ;Get JFN
HRLI T1,.FHSLF ;process handle in LH
TXO T1,GT%ARG ;Arg address in T2
XMOVEI T2,RMS.BK ;Point to arg block
GET%
ERJMP E$$CGR ;?Can't
MOVEI T1,.FHSLF ;Find out RMS's entry vector
XGVEC%
MOVE T1,RMSV20(T3) ;Get version number word
MOVEM T1,RMSVR.## ;Save it incase OTS wants to print it
TXO T3,XS%EEV ;It's an "extended" kind.
MOVE T1,[.XSEVD,,.FHSLF] ;RMS, this fork
XSSEV% ;Extended set special entry vector
;Bring in DDT in that section and tell it where the symbols are
MOVX T1,GJ%OLD+GJ%SHT
HRROI T2,[ASCIZ/SYS:UDDT.EXE/]
GTJFN%
ERJMP E$$CGD
HRRZ T1,T1 ;Get JFN
HRLI T1,.FHSLF ;process handle in LH
TXO T1,GT%ARG ;Arg address in T2
XMOVEI T2,RMS.BK## ;Point to arg block
GET%
ERJMP E$$CGD
HRLZ T1,RMS.SC ;Get
HRRI T1,600006 ; loc 600006 of that section
MOVE T2,(T1) ;Get symbol word for RMS
HRRI T1,770001
HRRZ T1,(T1) ;Get address in 770001
HRL T1,RMS.SC ; in that section..
MOVEM T2,(T1) ;Store symbol table info there.
MOVEI T1,.FHSLF ;Now restore my entry vector
DMOVE T2,MY.EVC
XSVEC%
POPJ 17, ;Return
GETV1: TYPE [ASCIZ/%COBLIB: RMS V2 not found, loading RMS V1
/] ;
SKIPE SLRSW.## ;WAS PROGRAM COMPILED WITH /R?
JRST RMSGSR ;YES, JUST FIND ENTRY VECTOR
MOVX T1,GJ%OLD!GJ%SHT
MOVE T2,RMSNMP
GTJFN%
ERJMP RGETE1 ;?NO RMS
PUSH PP,T1 ;SAVE THE JFN
MOVEI T1,.FHSLF ;SAVE ENTRY VECTOR INFO
GEVEC% ; (GET% SMASHES IT)
PUSH PP,T2 ;SAVE THE INFO
MOVE T1,-1(PP) ;GET BACK JFN
HRLI T1,.FHSLF ;READ INTO SAME FORK
TXO T1,GT%NOV ;DON'T OVERLAY EXISTING PAGES!
GET%
ERJMP RGETE2 ;FAILED
MOVEI T1,.FHSLF ;GET RMS'S ENTRY VECTOR
GEVEC%
MOVE T4,T2 ;SAVE IN T4
POP PP,T2 ;ENTRY VECTOR INFO
MOVEI T1,.FHSLF
SEVEC% ;SET IT BACK TO WHAT IT WAS
POP PP,(PP) ;FORGET JFN, DON'T CARE ANYMORE
;TELL SYSTEM THAT WE HAVE AN RMS ENTRY VECTOR
SKIPA T2,T4 ;ENTRY VECTOR WORD
RMSGSR: MOVE T2,[RMS.EV##] ;GET RMS'S ENTRY VECTOR WORD
JUMPE T2,RSBADV ;BAD ENTRY VECTOR
HRRZ T1,T2 ;Get address of start of entry vector
MOVE T1,RMSV20(T1) ;Get version number word
MOVEM T1,RMSVR.## ;Save it incase LIBOL wants to print it
MOVEI T1,.FHSLF ;SET MY FORK'S
SDVEC% ;RMS ENTRY VECTOR
;Disable traps for refs of non-ex page so PA1050 doesn't bomb out RMS
MOVEI T1,.FHSLF ;
MOVX T2,1B<.ICNXP> ;
DIC% ;
$MESSAGE [0] ;[1045] TURN ON RMS-20 INTERNAL MESSAGE
;[1045] AND ALSO INCIDENTALLY INITIAL THE
;[1045] AREA FOR RMS-20 GLOBAL DATA SYMBOLS.
SETZM RMS.SC ;Mark RMS section as section 0
SETZM OTS.SC ;Mark OTS section as section 0
POPJ PP, ;Return
NOXRMS: HRROI 1,[ASCIZ/?Can't find SYS:XRMS.EXE
/]
PSOUT%
HALTF%
E$$CGR: HRROI 1,[ASCIZ/?Can't GET SYS:XRMS.EXE
/]
PSOUT%
HALTF%
E$$SNA: HRROI 1,[ASCIZ/?Non-zero sections not available
/]
PSOUT%
HALTF%
E$$NFS: HRROI 1,[ASCIZ/?No free sections
/]
PSOUT%
HALTF%
E$$BRM: HRROI 1,[ASCIZ/?Can't init RMS in non-zero section: RMS entry vector
already set up in section zero
/]
PSOUT%
HALTF%
E$$CGD: HRROI 1,[ASCIZ/?Can't get DDT in RMS's section
/]
PSOUT%
HALTF%
>;END IFN TOPS20
IFE TOPS20,<
SEARCH UUOSYM
RMS$10==:600010 ;RESOLVE SYMBOL REFFED IN $verb MACROS
;(ONLY $verb FOR TOPS-10 MACRO PROGRAMS)
SKIPE SAVE17 ;REPEAT CALL?
POPJ 17, ;YES
MOVEM 17,SAVE17 ;BECAUSE MERGE. CLOBBERS IT
MOVEI 17,SAVEAC ;SAVE OTHERS NOW
BLT 17,SAVEAC+16 ;DONE
MOVEI 1,RMS.FS ;LOAD PTR TO RMS FILE SPEC
MERGE. 1, ;GET IT
JRST INIERR ;OOPS
MOVE 1,[.PAGCD,,[EXP 2,643,644]];CREATE RMS GLOBALS AREA
PAGE. 1, ;DO IT
JRST INIERR ;OOPS
MOVSI 17,SAVEAC ;RESTORE AC'S
BLT 17,17 ;DONE
POPJ 17,
RMS.FS:
SIXBIT /SYS/
SIXBIT /RMS/
SIXBIT /EXE/
EXP 0
EXP 0
XWD 600,677 ;GIVE IT RANGE TO MERGE
SAVEAC:
BLOCK 17
SAVE17:
EXP 0
INIERR:
OUTSTR [ASCIZ/? Could not initialize RMS
/]
EXIT 1,
> ;END IFE TOPS20
;ERRORS GETTING RMS
IFN TOPS20,<
;GTJFN FAILED
RGETE1: TYPE [ASCIZ/? /]
HRRZ T1,RMSNMP ;GET NAME
TYPE <(T1)> ;TYPE IT
TYPE [ASCIZ/ is not accessible/]
JRST RSFAIL ;SAY "RMS-SYSTEM FAILURE"
;THE "GET" FAILED
RGETE2: TYPE [ASCIZ/? /]
POP PP,(PP) ;FORGET ENTRY VECTOR INFO
MOVEI T1,.FHSLF ;GET THE ERROR
GETER%
CAMN T2,[.FHSLF,,GETX3] ;TRYNG TO OVERLAY EXISTING PAGES?
JRST RGETE3 ;YES
TYPE [ASCIZ/Can't GET /]
HRRZ T1,RMSNMP ;GET ADDR OF THE ASCIZ NAME
TYPE <(T1)> ;TYPE NAME
TYPE [ASCIZ/: /]
PUSHJ PP,LSTFER ;TYPE LAST ERROR IN THIS FORK
RSFAIL: $ERROR (E.500,SV.KIL) ;RMS-SYSTEM FAILURE
RGETE3: TYPE [ASCIZ/?Can't GET RMS: Program too big/]
JRST RSFAIL ;RMS-SYSTEM FAILURE ERROR
RSBADV: TYPE [ASCIZ/RMS entry vector is invalid -- RMS not loaded?/]
JRST RSFAIL ;GO DIE OFF
>;END IFN TOPS20
IFN TOPS20,<
SUBTTL LSTFER - ROUTINE TO TYPE LAST ERROR IN THIS FORK
;CALL: PUSHJ PP,LSTFER
; <RETURN HERE ALWAYS>
LSTFER: MOVEI T1,.PRIOU ;OUTPUT TO TERMINAL
HRLOI T2,.FHSLF ;LAST ERROR IN THIS FORK
SETZ T3, ;ALL OF THE TEXT
ERSTR%
JFCL
JFCL
POPJ PP, ;RETURN
>;END IFN TOPS20
;SAVE AC ROUTINE.
;THIS SAVES ALL THE IMPORTANT ACS USED BY RMSIO.
SVPACS: EXCH P1,(PP) ;SAVE P1,GET CALLER PC
HRLI P1,(PP) ;GET ADDRESS WHERE P1 IS SAVED
PUSH PP,FLG ;SAVE FLAGS
PUSH PP,FT ;SAVE FILE-TABLE PTR
PUSH PP,FTL ;SAVE OTHER FILE-TABLE PTR
PUSHJ PP,SAVJMP ;STACK NEW RETURN PC AND JUMP
SOS SVNOSK(PP) ;NON-SKIP RETURN, COMPENSATE CPOPJ1
POP PP,FTL ;RESTORE FTL
POP PP,FT ;RESTORE FT
POP PP,FLG ;RESTORE FLG
POP PP,P1 ;RESTORE P1
AOS (PP) ;INCREMENT PC
POPJ PP, ;RETURN
;THE FOLLOWING INSTRUCTION RESTORES P1 AND DISPATCHES TO THE CALLER.
SAVJMP: JRA P1,(P1) ;RETURN TO CALLER
SUBTTL OP.MIX -- OPEN RMS INDEXED FILE, AND RELATIVE AND SEQUENTIAL
;THIS ROUTINE CONSISTS OF SIX PARTS:
; (1) CHECK FOR ERRORS AND CONFLICTS OPENING THE FILE, OP.MIX - OPEPVL
; (2) GET LOW-CORE FOR RMS IN-CORE ARG BLKS, OP.MX0 - MNCR1
; (3) SET UP FOR RMS CALL TO OPEN / CREATE THE FILE, OP.M0D - OP.MXC
; PICKFN - PCKF1B IS CALLED FROM THIS CODE.
; (4) OPEN / CREATE THE FILE, OP.MXC - RFNFER
; (5) CHECK OUT THE RESULTS OF THE CALL TO RMS, CHKOPF
; (6) CALL RMS TO CONNECT RAB TO FILE, DOCONN - CONDM2
;ERROR HANDLING ROUTINES ARE INTERSPERSED THROUGHOUT AS APPROPRIATE
;CALL:
; MOVEI 16,ARGLIST
; PUSHJ PP,OP.MIX
; <RETURN>
;ARGUMENT FORMAT:
;
;ARGLIST: FLAG-BITS,,FILTAB-ADDR
; 0,,ADDR-OF-KEY-INFO
;***** NOTE: 2ND WORD OF ARGLIST HAS BEEN DELETED. ADDR-OF-KEY-INFO LIST
;***** CAN NOW BE FOUND IN THE FILE TABLE IN THE LEFT HALF OF THE WORD
;***** F.RMKL
;THERE ARE NOW TWO KINDS OF FLAG BITS IMPLEMENTED FOR RMS OPENS: (1) THE
;STAND-ALONE (NON-SMU) OPEN, WHICH HAS BEEN IMPLEMENTED SINCE V 12B, AND
;(2) THE SMU OPTION 5 FORM OF OPEN, WHICH ASSUMES THAT THE FILE IS TO BE
;OPENED FOR I-O AND WHOSE FLAG BITS LOOK LIKE THE FLAG BITS FOR A NON-RMS
;SMU OPTION 1 OPEN.
;
;FLAG-BITS FOR STAND-ALONE OPEN:
; V%OPEN==1B3 LIBOL OPEN VERB FLAG - NOT RECOGNIZED BY RMSIO
OPN%IN==1B9 ;OPEN FOR INPUT
OPN%OU==1B10 ;OPEN FOR OUTPUT
OPN%IO==1B11 ;OPEN FOR I-O
; ALL BITS 9-11 ON FOR OPEN I-O
;OPEN NO REWIND, OPEN REVERSED NOT SUPPORTED
;FLAG-BITS FOR SMU OPTION 5 OPEN:
V%OPS5==12 ;SMU OPTION 5 OPEN
OPN%UN==1B17 ;OPEN HAS UNAVAILABLE CLAUSE
;KEY INFORMATION:
;THE KEY INFO IS POINTED TO BY THE LEFT HALF OF THE WORD F.RMKL IN THE
;FILE TABLE, AND IS IN THE "HIGH-SEG" UNDER %x: WHICH IS UNDER "START.".
;
; OCT NUMBER OF KEYS
; (2 WORDS FOR EACH KEY, AS FOLLOWS):
; XWD BYTE POSITION,,KEY SIZE
; XWD FLAGS,,DATATYPE
;
; WHERE FLAGS ARE:
KI%DUP==1B0 ;DUPLICATE KEYS ALLOWED
;
;AND DATATYPE VALUES ARE:
; SIXBIT=0, ASCII=1, EBCDIC=2
;OPEN NO REWIND, OPEN REVERSED NOT SUPPORTED.
OP.MIX: PUSHJ PP,SETIO ;SETUP FOR I/O
;FIRST CHECK FOR RMS VERSION 2 WITH SMU OPTION 1. WE CANT ACTUALLY
; TEST FOR IT UNTIL THIS POINT BECAUSE WE DONT KNOW IF A FILE IS
; GOING TO BE UNDER SMU OPTION 1 UNTIL IT IS ACTUALLY OPENED.
SKIPN F.WSMU(FT) ;DOING SMU OPTION 1?
JRST OP.MIZ ; NO
LDB T0,[POINT 9,RMSVR.,11] ;YES, REQUIRES RMS V2 OR HIGHER
CAIGE T0,RMSV2 ; IS IT?
JRST OPERV1 ;NO, FATAL ERROR
OP.MIZ: ;
LDB T0,FT.CRC ;[1020] IS THERE CHECKPOINTING?
SKIPE T0 ;[1020] NO
MOVEM T0,D.CRC(FT) ;[1020] YES, INITIALIZE RECORD COUNT
;CAN'T OPEN FILE FROM OVERLAY
LDB T1,FT.BBL
JUMPE T1,OPEOVL
;CAN'T OPEN FILE IF ALREADY OPEN
TXNE FLG,LF%INP!LF%OUT ;IS THE FILE OPEN?
JRST OPEALO ;YES, ERROR
;CAN'T OPEN FILE IF IT IS "LOCKED"
LDB T1,FT.BLF
JUMPN T1,OPELCK
;TEST FILE TYPE FIELD FROM FILE TABLE FLAG WORD FOR VALID ORG.
;ALL WE WANT TO SEE HERE IS IF EXACTLY ONE BIT IS SET, SO WE HAVE NO
;HASSLE HERE. HOWEVER, THERE IS A DISCREPANCY BETWEEN LIBOL AND RMS
;REGARDING THE BIT SETTINGS FOR SEQUENTIAL AND RELATIVE FILES:
;
; RELATIVE SEQUENTIAL INDEXED
; IN LIBOL RANFIL==1 SEQFIL==2 IDXFIL==4
; IN RMS FB$REL==2 FB$SEQ==1 FB$IDX==3
;
;THIS DISCREPANCY WILL CAUSE US A HASSLE FURTHER DOWN WHEN WE HAVE TO
;HANDLE THE EXACT BIT SETTINGS.
LDB T1,FT.ORG ;GET FILE TYPE FIELD
CAIG T1,IDXFIL ;IDXFIL SET AND ANOTHER BIT SET?
CAIN T1,RANFIL!SEQFIL ;BOTH REL AND SEQ TYPES SET?
JRST OPEORG ;ERROR
JUMPE T1,OPEORG ;ERROR, NO BITS SET
CAIN T1,IDXFIL ;Is this other than an index file?
JRST OP.MZ1 ;No
LDB T2,[POINT 9, RMSVR.,11] ;Yes, is it RMS V2 or greater?
CAIGE T2,RMSV2 ;
JRST OPEWV ;No, error
;CHECK TO MAKE SURE THAT IF SIMULTANEOUS UPDATE BEING DONE, THAT IT IS
;OPTION 5 WITH APPLY BASIC-LOCKING.
OP.MZ1: MOVE T2,BS.AGL## ;GET ADDRESS OF INCOMING ARG LIST
LDB T1,[POINT 4,(T2),3] ; GET LEFTMOST HALF A BUCK
CAIE T1,V%OPS5 ;SMU OPTION 5 OPEN?
JRST OP.MIY ; NO
LDB T1,FT.ABL ;APPLY BASIC-LOCKING FLAG SET?
JUMPE T1,OPESMU ; NO - ERROR
OP.MIY:
;FALL TO NEXT PAGE IF EVERYTHING OK SO FAR
;CHECK FOR FILES THAT SHARE THE SAME BUFFER. NONE OF THEM
; MAY BE OPEN AT THIS POINT.
HLRZ T4,F.LSBA(FT) ;FILTAB THAT SHARES THE SAME BUFFER
OP.M0A: JUMPE T4,OP.MX0 ;JUMP IF NO ONE SHARES
CAIN T4,(FT) ;HAVE WE CHECKED ALL "SBA" FILES?
JRST OP.MX0 ;YES
LDB T1,[POINT 1,F.RMS(T4),7] ;RMS BIT FOR THIS FILE
JUMPN T1,OP.SA1 ; JUMP IF THIS SBA FILE IS AN RMS FILE
; NON-RMS, V12B FILES:
HLL T4,F.WFLG(T4) ;GET THE FLAGS
TLNE T4,OPNIN!OPNOUT ;SKIP IF ANY FILES ARE NOT OPEN
JRST OP.M0B ;GIVE ERROR
JRST OP.SA2
; END OF NON-RMS, V12B FILES
; RMS FILES ONLY FOR V12B, THIS CODE WILL BE VALID FOR ALL V13 FILES
OP.SA1: HRR T1,D.F1(T4) ;GET V13 STYLE FLAGS FOR THIS FILE
TXNE T1,LF%INP!LF%OUT ;IS THIS FILE OPEN?
JRST OP.M0B ;YES, GIVE ERROR
; END OF RMS CODE
OP.SA2: HLRZ T4,F.LSBA(T4) ;GET NEXT "SBA" FILTAB
JRST OP.M0A ;LOOP
;** ERROR: ANOTHER FILE THAT SHARES THE SAME BUFFER IS ALREADY OPEN
OP.M0B: $ERROR (E.504,SV.KIL,MT.FIL)
;** ERROR: FILE CANNOT BE OPENED: ALREADY OPEN
OPEALO: SKIPL WANT8.## ;WANT ANS 8X FUNCT?
JRST OPEAL1 ; NO
MOVEI T0,FS%41 ;SET UP FILE-STATUS FILE-ALREADY-OPEN
MOVEM T0,FS.FS ; AND SAVE IT
PUSHJ PP,SETFS ; AND MOVE IT TO USER FIELD
OPEAL1: $ERROR (E.509,SV.KIL,MT.FIL)
;** ERROR: FILE IS LOCKED
OPELCK: SKIPL WANT8. ;WANT ANS 8X FUNCT?
JRST OPELC1 ; NO
MOVEI T0,FS%38 ;SET UP FILE-STATUS FILE-ALREADY-OPEN
MOVEM T0,FS.FS ; AND SAVE IT
PUSHJ PP,SETFS ; AND MOVE IT TO USER FIELD
OPELC1: $ERROR (E.510,SV.KIL,MT.FIL)
;** ERROR: CAN'T OPEN FILE IN OVERLAY (TEMP ERROR)
OPEOVL: $ERROR (E.511,SV.KIL,MT.FIL)
;** ERROR: FILE CANT BE OPENED BECAUSE IT HAS INCORRECT ORG FIELD VALUE
;** IF THIS SHOWS UP, IT IS A COMPILER ERROR.
OPEORG: $ERROR (E.524,SV.KIL,MT.FIL)
;** ERROR: SIMULTANEOUS UPDATE OF RMS FILES REQUIRES APPLY BASIC LOCKING
;** COMPILER SHOULD CATCH THIS PROBLEM, IS ATTEMPT TO PLAY SAFE IF WE
;** DON'T HAVE OTHER SMU OPTIONS FOR RMS FILES.
OPESMU: $ERROR (E.526,SV.KIL,MT.FIL)
OPERV1: $ERROR (E.530,SV.KIL,MT.FIL)
OPEWV: $ERROR (E.531,SV.KIL,MT.FIL)
;HERE IF OPEN IS GOING OK SO FAR.
;SEE IF CONVERSION REQUIRED. IF YES, SET UP AN ALTERNATE RECORD
; AREA AND KEY BUFFER.
;NOTE: FROM HERE UNTIL AFTER FUNCT. IS CALLED,
; WE WILL USE TEMPORARY VARIABLES ON THE STACK.
; 0(PP) = # WORDS NEEDED FOR CONVERSION RECORD BUFFER
; -1(PP) = # WORDS NEEDED FOR CONVERSION KEY BUFFER
OP.MX0:
MOVSI T1,(TRN) ;SET UP NULL CONVERT INSTR FOR SMU OPT 1
MOVEM T1,D.RCNV(FT) ;AND SAVE IT IN FILE TABLE WORD
PUSH PP,[0] ; SET # WORDS NEEDED FOR CONVERSION
PUSH PP,[0] ; BUFFERS
MOVE T3,F.WFLG(FT) ;GET FLAGS
;** CHANGE IN V13:
LDB T1,[POINT 3,T3,14] ;GET INTERNAL RECORDING MODE
LDB T2,[POINT 3,T3,2] ;GET EXTERNAL RECORDING MODE
CAMN T1,T2 ;THE SAME?
JRST OP.M0C ;YES
CAIN T2,BINMOD ;EXTERNAL MODE BINARY?
JRST [CAIN T1,SIXMOD ; AND INTERNAL MODE SIXBIT?
JRST OP.M0C ;YES, NO NEED FOR CONVERSION
JRST OP.M0H] ;
;Conversion is required.
; Find the size of the largest key, and reserve some words
;for the conversion key buffer.
; Then reserve as many words as we need to store the converted record.
OP.M0H:
MOVX T1,CF%CNV ;NOTE "CONVERSION REQUIRED"
IORM T1,D.F1(FT)
TXO FLG,CF%CNV ;NOTE CONVERSION REQUIRED
;SET T4= # BYTES/WORD FOR THIS RECORDING MODE
MOVE T3,F.WFLG(FT) ;GET COMPILER FLAGS
MOVEI T4,SIXCT ; ASSUME SIX BYTES PER WORD
TLNE T3,DDMASC ; IS IT ASCII?
MOVEI T4,ASCCT ;YES, FIVE BYTES PER WORD
TLNE T3,DDMEBC ; IS IT EBCDIC?
MOVEI T4,EBCCT ;YES, FOUR BYTES PER WORD
;FIND T1=SIZE OF LARGEST KEY
;
;LEAVE THIS STUFF IN-LINE FOR RELATIVE FILES, WHICH DO HAVE ONE KEY.
;IT WON'T HURT SINCE WE ARE ONLY FIGURING OUT HOW MUCH CORE WE WANT FROM FUNCT.
;WE DON'T NEED IT, BUT IT ONLY COMES TO TWO WORDS PER RELATIVE FILE.
;IF A CONVERSION BUFFER IS NEEDED FOR A RELATIVE KEY, THE COMPILER BUILDS
;IT IN %PARAM.
;
TLNE T3,SEQFIL ;BYPASS KEY INFO PROCESSING FOR SEQ FILES
JRST OP.M0J
HLRZ T3,F.RMKL(FT) ;GET ADDRESS OF KEY INFO TO FIND
; LARGEST KEY
MOVE T2,(T3) ;T2= NUMBER OF KEYS
ADDI T3,1 ;T3 POINTS TO FIRST 2-WORD KEY BLOCK
SETZ T1, ;ANYTHING IS BIGGER THAN THIS
OP.M0E: HRRZ T0,(T3) ;GET SIZE OF THIS KEY
CAILE T0,(T1) ;SKIP IF NO BIGGER THAN ANOTHER KEY
HRRZ T1,T0 ;USE THIS ONE
ADDI T3,NXKEYB ;BUMP UP TO NEXT KEY INFO BLOCK
SOJG T2,OP.M0E ;LOOP FOR ALL KEYS
ADDI T1,-1(T4) ;FIND # WORDS NEEDED
IDIV T1,T4
MOVEM T1,-1(PP) ;STORE ON THE STACK
;GET T1= # WORDS NEEDED FOR THE RECORD. THIS APPLIES TO THE CONVERSION
;BUFFER ONLY. THE USER BUFFER HAS BEEN SET UP IN THE GENERATED CODE.
OP.M0J:
LDB T1,FT.MRS ;GET MAX RECORD SIZE
ADDI T1,-1(T4)
IDIV T1,T4 ;GET # WORDS NEEDED
MOVEM T1,0(PP) ;STORE ON THE STACK
;GET CORE FOR RMS-TYPE BLOCKS: FAB, RAB, AND KEY XAB'S.
;KEY XAB'S ARE ONLY REQUIRED FOR INDEXED FILES, SO WE WILL BYPASS THE CORE
;CALCULATIONS FOR THEM.
;ALSO, IF WE ARE DOING SMU OPTION 1, WE NEED SHADOW RAB FOR FAKE READS.
;THIS WAY WE WILL BE ABLE TO DO ALL THE RETAIN / FREE I-O IN THE BUFFERS
;OF THE SHADOW RAB AND THE RECORD CURRENCY IN THE BUFFERS OF THE MAIN
;RAB WILL REMAIN UNTOUCHED.
; GET T1:= # WORDS NEEDED, STORE IN FUN.A2
OP.M0C:
HRRZI T1,0 ;INITIALIZE T1
;FIGURE OUT MAX RECORD SIZE IN WORDS
MOVEI T4,SIXCT ;ASSUME SIXBIT
MOVE T3,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNE T3,DDMASC ;IS IT ASCII?
MOVEI T4,ASCCT ; YES
TLNE T3,DDMEBC ;IS IT EBCDIC?
MOVEI T4,EBCCT ; YES
LDB T1,FT.MRS ;NOW GET MAX RECORD SIZE (IN BYTES)
ADDI T1,-1(T4) ; AND FORCE ROUNDING UP REMAINDERS
IDIV T1,T4 ;CALCULATE MAX RECORD SIZE IN WORDS
MOVEM T1,SM.RLN ; AND SAVE ASIDE FOR ARITHMETIC BELOW
MOVEM T1,RMS.RL## ;SAVE RECORD LENGTH FOR READ
ADDI T1,RA$LNG ;ADD IN LENGTH OF RAB (FOR SHADOW RAB)
SKIPN F.WSMU(FT) ;DOING SMU OPTION 1?
HRRZI T1,0 ;NO, RE-INITIALIZE T1
OP.M0K:
ADDI T1,.RCLEN+FA$LNG+RA$LNG ;NEED A CONTROL-BLOCK, AND A FAB, AND A RAB
;FIND # OF KEYS, PUT IN T2 - FOR INDEXED FILES ONLY
MOVE T3,F.WFLG(FT) ;GET FLAG WORD FROM FILE TABLE
TLNN T3,IDXFIL ;IS FILE INDEXED?
JRST OP.M0F ;NO - BYPASS XAB SPACE CALCULATION
HLRZ T3,F.RMKL(FT) ;GET ADDRESS OF KEY INFO
MOVE T2,(T3) ;FIRST WORD = # OF KEYS
IMULI T2,XA$LNG ; NEED THIS MANY WORDS FOR EACH KEY
ADD T1,T2 ;ADD TO NUMBER OF WORDS NEEDED
OP.M0F:
SKIPN F.WSMU(FT) ;IF DOING SMU OPTION 1
JRST OP.M0M ; NOT
ADD T1,(PP) ;ADD IN SIZE OF FAKE CONVERSION BUFFER
ADD T1,-1(PP) ; AND MAX KEY SIZE FOR FAKE KEY CONV BUFFER
OP.M0M:
ADD T1,(PP) ;ADD NUMBER OF WORDS NEEDED FOR
ADD T1,-1(PP) ; CONVERSION BUFFERS
MOVEM T1,FUN.A2 ;** STORE # WORDS NEEDED **
MOVEI ARG,1+[-5,,0
XWD 0,FUN.A0##
XWD 0,[ASCIZ/LBL/]
XWD 0,FUN.ST##
XWD 0,FUN.A1##
XWD 0,FUN.A2##]
MOVEI T1,F.PAG ;FUNCTION WE WANT
MOVEM T1,FUN.A0## ;STORE FUNCTION
SETZM FUN.ST## ;CLEAR STATUS
SETZM FUN.A1## ; AND ADDRESS RETURNED
PUSHJ PP,FUNCT.## ;CALL FUNCT. ROUTINE
POP PP,T4 ;RESTORE # WORDS USED FOR CONVERSION BUFFERS
POP PP,T3 ;KEY BUFFER
SKIPE FUN.ST## ;STATUS MUST BE 0...
JRST MNCR ; ? NOPE - NO CORE AVAILABLE
;STORE POINTER TO CONTROL-BLOCK IN THE FILE-TABLE
HRRZ FTL,FUN.A1## ;GET ADDRESS OF CORE WE GOT
MOVEM FTL,D.RMSP(FT) ; SAVE ADDR OF RMS CONTROL-BLOCK
;FTL:= ADDR OF CONTROL BLOCK.
;STORE # WORDS OF MEMORY WE JUST OBTAINED IN THE CONTROL BLOCK
MOVE T1,FUN.A2## ;(IT'S STILL HERE)
MOVEM T1,.RCMEM(FTL)
; STORE ADDR OF FAB, RAB, AND FIRST XAB IN THE CONTROL BLOCK
MOVEI T1,.RCLEN(FTL) ;ADDR OF FAB
MOVEM T1,.RCFAB(FTL) ;STORE ADDR OF FAB
ADDI T1,FA$LNG
MOVEM T1,.RCRAB(FTL) ;ADDR OF THE RAB
ADDI T1,RA$LNG
SKIPN F.WSMU(FT) ;DOING SMU OPTION 1?
JRST OP.M0G ; NO
MOVEM T1,.RCFAK(FTL) ;YES -- STORE ADDRESS OF RMS SHADOW RAB
ADDI T1,RA$LNG ;ADD LENGTH OF RAB
MOVEM T1,SM.BUF ;STORE ADDRESS OF SHADOW BUFFER
ADD T1,SM.RLN ;ADD LENGTH OF RECORD BUFFER
OP.M0G:
TXNN FLG,CF%CNV ;SKIP IF CONVERSION REQUIRED
JRST OP.M0D ;NO
MOVEM T1,.RCCRB(FTL) ;CONVERSION RECORD BUFFER
ADD T1,T4 ;ADD # WORDS NEEDED FOR RECORD BUFFER
MOVEM T1,.RCCKB(FTL) ;CONVERSION KEY BUFFER
ADD T1,T3 ;ADD # WORDS NEEDED FOR KEY BUFFER
SKIPN F.WSMU(FT) ;IF DOING SMU OPTION 1
JRST OP.M0L ;
MOVEM T1,.RCFCB(FTL) ;SET UP ADDR OF FAKE RECORD CONVERSION BUFFER
ADD T1,T4 ; AND ADVANCE COUNT OF NUMBER OF WORDS
MOVEM T1,.RCFKC(FTL) ;SET UP ADDRESS OF FAKE KEY CONVERSION BUFFER
ADD T1,T3 ; AND THE NUMBER OF WORDS REQUIRED FOR IT
OP.M0L:
;MAKING SURE TO PRESERVE T1 FOR OP.M0D, WE WILL NOW
; GET THE ADDRESSES OF THE CONVERSION ROUTINES, AND STORE THEM
; IN .RCCRS:
;WE HAVE TO BE CONCERNED WITH RECORDING MODE BINARY FOR CONVERSIONS TOO.
;THE FOLLOWING LDB'S HAVE BEEN CHANGED TO REFLECT THE COMMENT NEAR OP.MX5
;ON THIS BASIS, BINARY = 0, EBCDIC = 1, SIXBIT = 2, AND ASCII =4 AFTER
;THE LDB IS EXECUTED. BINARY WILL BE TREATED AS SIXBIT, AND ALL OF THE
;OTHER VALUES WILL BE ALTERED TO THEIR ORIGINALLY CODED VALUES BY THE
;LITTLE KROCKS BELOW THE LDB'S. IT WOULD BE BETTER TO REWRITE THE XCT
;TABLE AND THE CONVERSION TABLES TO REFLECT FOUR ENTRIES WHEN WE HAVE
;TIME. THE PURPOSE OF THIS EFFORT IS TO DO SOMETHING REASONABLE FOR THE
;GUY WHO SPECIFIES RECORDING MODE BINARY AND USES DATA MODE DISPLAY-7.
;WE WILL SEND DISPLAY-6 DATA TO HIS FILE FOR HIS DISPLAY-7 FIELDS.
;THIS IS A LOT BETTER THAN DOING NO CONVERSION AT ALL BECAUSE THE DISPLAY-7
;DATA AT THE END OF HIS RECORD WOULD BE TRUNCATED IF WE MERELY ASSUMED
;DEVICE DATA MODE SIXBIT WERE COMPATIBLE.
MOVE T0,F.WFLG(FT) ;GET COMPILER FLAGS
LDB T2,[POINT 3,T0,14] ;INTERNAL RECORDING MODE..
CAIN T2,BINMOD ;BINARY? SPECIFY SIXBIT
JRST [MOVEI T2,SIXMOD
JRST OP.M0X]
CAIN T2,ASCDDM ;ASCII? MAKE 0.
JRST [MOVEI T2,BINMOD
JRST OP.M0X]
OP.M0X:
LDB T3,[POINT 3,T0,2] ;EXTERNAL RECORDING MODE..
CAIN T3,BINMOD ;BINARY? SPECIFY SIXBIT
JRST [MOVEI T3,SIXMOD
JRST OP.M0Y]
CAIN T3,ASCDDM ;ASCII? MAKE 0.
JRST [MOVEI T3,BINMOD
JRST OP.M0Y]
OP.M0Y:
XCT GETCRF(T2) ;GET "FROM" ROUTINE
HRLM T4,.RCCRS(FTL) ;STORE IN LH(.RCCRS)
EXCH T2,T3 ;NOW GET THE REVERSE ROUTINE
XCT GETCRF(T2)
HRRM T4,.RCCRS(FTL) ;STORE IN RH(.RCCRS)
JRST OP.M0D ;GO ON
;XCT TABLE
GETCRF: HRRZ T4,CV.A(T3) ;GET ASCII TO .. ROUTINE
HRRZ T4,CV.E(T3) ;GET EBCDIC TO.. ROUTINE
HRRZ T4,CV.S(T3) ;GET SIXBIT TO.. ROUTINE
;CONVERSION TABLES.
CV.A: 0 ;7-7 NO CONVERSION
C.D7D9 ;7-9
C.D7D6 ;7-6
CV.E: C.D9D7 ;9-7
0 ;9-9 NO CONVERSION
C.D9D6 ;9-6
CV.S: C.D6D7 ;6-7
C.D6D9 ;6-9
0 ;6-6 NO CONVERSION
;COME HERE IF FUNCT. FAILED TRYING TO GET CORE FOR THE OPEN
MNCR: MOVEI T1,FS%30 ;SET FILE-STATUS TO
MOVEM T1,FS.FS ; "PERMANENT ERROR"
PUSHJ PP,SETFS
$ERROR (E.503,SV.FAT,MT.FIL,MNCR1) ;NOT ENOUGH CORE TO OPEN FILE
;ERROR HAS BEEN TRAPPED BY THE USER, NOW HE WANTS TO "IGNORE" IT
MNCR1: POPJ PP, ;** RETURN FROM OPEN **
;THIS SECTION SETS UP THE FAB RAB AND XAB'S FOR THE RMS OPEN / CREATE CALL
;IT CONSISTS OF FOUR PARTS:
; (1) COPY OVER THE PROTOTYPE zAB'S TO THIS FILE'S COMMUNICATION AREA.
; THERE ARE SOME DEFAULT FIELD SETTINGS IN THE zAB'S
; AND THEY ARE PRE-DEFINED TO BE THE CORRECT LENGTHS.
; (2) SET UP THE KEY XAB'S (FOR INDEXED FILES)
; (3) SET UP THE FAB
; (4) SET UP THE RAB
;UPDATES TO THE RMS COMMUNICATIONS HEADER ARE INTERSPERSED THRU THIS CODE
;Come here with T1 = address where we will put the first XAB.
; Conversion buffers have been allocated if necessary.
;HOWEVER, IF THE FILE IS NOT INDEXED WE DON'T NEED THE XAB ADDRESS.
OP.M0D:
MOVE T3,F.WFLG(FT) ;GET FLAG WORD FROM FILE TABLE
TLNE T3,IDXFIL ;IS FILE INDEXED?
;IF NO, SKIP NEXT INSTRUCTION.
MOVEM T1,.RCXAB(FTL) ;ADDR OF THE FIRST XAB
MOVE T1,RMS.RL ;GET RECORD SIZE (IN WORDS)
MOVEM T1,.RCRLN(FTL) ; AND PUT IT IN THE RAB
;Now setup the RMS structures. (the assigned space is
;empty at this point).
;Start with the prototypes.
HRLZI T1,PRFAB ;FROM PROTOTYPE FAB
HRR T1,.RCFAB(FTL) ; TO REAL FAB
HRRZI T2,PRFABL-1(T1) ;COPY ALL OF PROTOTYPE
BLT T1,(T2)
HRLZI T1,PRRAB ;FROM PROTOTYPE RAB
HRR T1,.RCRAB(FTL) ; TO REAL RAB
HRRZI T2,PRRABL-1(T1) ;COPY ALL OF PROTOTYPE
BLT T1,(T2)
;MAKE RAB POINT TO THE FAB.
MOVE T3,.RCRAB(FTL) ;T3 POINTS TO RAB
MOVE T1,.RCFAB(FTL) ;T1 POINTS TO FAB
$STORE T1,FAB,(T3)
;WE DON'T HAVE TO SET UP KEY XAB'S IF THE FILE IS NOT INDEXED
MOVE T3,F.WFLG(FT) ;GET FLAG WORD FROM FILE TABLE
TLNN T3,IDXFIL ;IS FILE INDEXED?
JRST OP.MX4 ;NO - BYPASS XAB SETUP
;STORE INFO INTO THE XAB'S.
HLRZ T3,F.RMKL(FT) ;GET ADDR OF KEY INFO
MOVEM T3,.RCKIN(FTL) ;SAVE IT FOR OTHER OPERATIONS
MOVE T4,(T3) ;T4:= FIRST WORD = # OF KEYS
MOVN T4,T4 ;GET -N
HRLZ T4,T4 ;GET -N,,0
MOVE T2,.RCXAB(FTL) ;T2= ADDR OF FIRST XAB
ADDI T3,KYINFO ;T3 POINTS TO FIRST 2-WORD KEY BLOCK
;HERE WITH T2= ADDRESS OF XAB
; RH(T4)= NUMBER OF THIS KEY
; T3= ADDRESS OF THIS KEY BLOCK
OP.MX1: HRLZI T1,PRXAB ;COPY A PROTOTYPE XAB
HRR T1,T2
BLT T1,PRXABL-1(T2) ;COPY WHOLE PROTOTYPE
HRRZ T1,T4 ;;THE NUMBER OF THIS KEY
$STORE T1,REF,(T2) ;STORE IN REF FIELD
TXNE FLG,OPN%IN ;IF OPEN FOR INPUT OR I/O
JRST OP.MX3 ;DON'T HAVE TO SET IT UP
HLRZ T1,(T3) ;GET POSITION OF THE KEY
$STORE T1,POS,(T2) ;STORE IN XAB
HRRZ T1,(T3) ;GET SIZE OF THE KEY
$STORE T1,SIZ,(T2) ;STORE IN XAB
;
; THE DATATYPE PASSED IN THE KEY BUFFER IS NOT USED. IT IS ASSUMED
; TO BE THE SAME AS THE INTERNAL RECORDING MODE. WE WILL TELL RMS
; THAT THE DATATYPE IS THE SAME AS THE EXTERNAL RECORDING MODE.
MOVE T0,F.WFLG(FT) ;GET COMPILER FT FLAGS
MOVEI T1,XB$SIX ;ASSUME SIXBIT
TLNE T0,DDMASC ; IF ASCII,
MOVEI T1,XB$STG ;GET ASCII DATATYPE
TLNE T0,DDMEBC ; IF EBCDIC,
MOVEI T1,XB$EBC ;GET EBCDIC DATATYPE
$STORE T1,DTP,(T2) ;STORE IN XAB
;STORE KEY-SPECIFIC FLAGS
$FETCH T1,FLG,(T2) ;GET INITIAL FLAGS
PUSH PP,T2 ;SAVE AN AC FOR A SEC..
HLLZ T2,KYINFO(T3) ;GET FLAGS FOR THIS KEY
TXNE T2,KI%DUP ;DUPLICATES ALLOWED?
TXO T1,XB$DUP ; YES, SET FLAG
POP PP,T2 ;RESTORE T2
$STORE T1,FLG,(T2) ;STORE THE FLAGS
OP.MX3: AOBJP T4,OP.MX2 ;JUMP IF NO MORE KEYS
ADDI T3,NXKEYB ;BUMP TO NEXT KEY INFO BLOCK
MOVEI T1,XA$LNG(T2) ;ADDR OF NEXT XAB
$STORE T1,NXT,(T2) ;STORE IN THIS XAB
MOVE T2,T1 ;GO BACK WITH T2= NEXT XAB
JRST OP.MX1 ;LOOP FOR ALL KEYS
;HERE WHEN ALL KEY XAB'S HAVE BEEN CREATED
OP.MX2: MOVE T2,.RCXAB(FTL) ;T2 POINTS TO FIRST XAB
$FETCH T1,FLG,(T2) ;GET THE FLAGS
TXZ T1,XB$CHG ; VALUES MAY NOT CHANGE FOR PRIMARY KEY
$STORE T1,FLG,(T2) ; (THIS GETS RID OF DEFAULT XB$CHG)
;*** SETUP THE FAB ***
OP.MX4:
; MOST OF THE INFORMATION IS IN THE NORMAL FILE-TABLE.
MOVE T4,.RCFAB(FTL) ;T4 POINTS TO THE FAB
;FOR SMU OPTION 5, WE ALREADY HAVE FAC AND SHR SET UP IN SMU.AG, SO FIND
;IF WE ARE OPENING FOR SMU OPT 5 AND IF SO GO DO THE TWO MOVES. SMU
; OPTION 5 LETS RMS DO ALL OF THE LOCKING AS WELL AS THE FILE I-O.
MOVE T1,BS.AGL## ;GET ADDRESS OF ARG LIST
LDB T0,[POINT 4,(T1),3] ;GET LEFTMOST 4 BITS OF ARG WORD
CAIN T0,V%OPS5 ; DOING SMU OPTION 5 OPEN?
JRST OP.SMU ; YES
HLL T0,FLGFIL(T1) ;GET FLAGS FROM ARG WORD TO TEST FOR SMU OPTION 1
;DO THIS BEFORE T1 GETS BLOWN AWAY
;FILE ACCESS DESIRED
SETZ T1, ;T1 WILL LIST THE OPERATIONS WE WANT TO DO
;
;SMU OPTION 1 IS LSU-STYLE FILE AND RECORD LOCKING, AND DOES NOT USE
; RMS LOCKING AT ALL. THE FLAG FB$SU1 WHICH HAS BEEN DEFINED AND SET
; HERE FOR THE FAC WORD HAS TO BE IMPLEMENTED IN RMS.
;
SKIPE F.WSMU(FT) ;DOING SMU OPTION 1 OPEN?
JRST OP.SMU ; GO SET UP FAC AND SHR FOR EITHER SMU
;IF OPEN FOR INPUT, NO BITS WILL BE SET IN "FAC".
TXNE FLG,OPN%OU ;OPEN FOR OUTPUT?
TXO T1,FB$PUT ;"PUT" ACCESS
;NOW WE TEST TO SEE IF A SEQUENTIAL FILE IS BEING OPENED UP FOR I-O.
; NOTE: THE FOLLOWING FIVE LINES OF CODE ARE OBSOLETE
;;; MOVE T0,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
;;; TLNE T0,SEQFIL ;AND CHECK FOR SEQ FILE
;;; JRST [TXNE FLG,OPN%IO ;IF SO, TEST ARG AC FLAGS FOR OPEN I-O
;;; JRST OPIOER ;IF SO AGAIN, STUFF IT TO HIM.
;;; JRST OPMX4A] ;OTHERWISE, OK.
TXNE FLG,OPN%IO ;OPEN FOR I-O?
TXO T1,FB$UPD!FB$DEL ;YES, ALSO ALLOW 'UPDATE', 'DELETE'
OPMX4A:
$STORE T1,FAC,(T4) ;STORE ACCESS WANTED
;OTHERS ACCESS
SETZ T1, ;ALWAYS SET TO 0 TO START
$STORE T1,SHR,(T4) ;STORE OTHERS ACCESS
JRST OP.PFN ;NEXT GO GET FILE NAME
;FOR SMU OPEN WE NOW TRANSFER THE FAC AND SHR FROM SMU.AG TO FAC + SHR
OP.SMU:
HLRZ T1,SMU.AG## ;GET FAC
$STORE T1,FAC,(T4) ; AND STORE IT
HRRZ T1,SMU.AG## ;GET SHR
$STORE T1,SHR,(T4) ; AND STORE IT
;FIGURE OUT FILE NAME. IF PRECISELY 9 CHARACTERS CONSISTING ONLY OF
; ALPHABETICS, NUMERICS AND SPACES ASSUME OLD "TOPS-10" STYLE. OTHERWISE
; ASSUME TOPS-20 STYLE. IF THE FILENAME IS BAD IN EITHER STYLE, IT WILL
; BE STOPPED AT OPEN TIME.
OP.PFN:
MOVE T2,F.WVID(FT) ;GET BYTE POINTER TO NAME
LDB T1,[POINT 06,T2,11] ;GET BYTE SIZE
HRRZ T3,F.SZID(FT) ;GET SIZE OF FILE NAME
CAIE T3,^D9 ; NINE CHARACTERS?
JRST OP.T20 ; NO, ASSUME TOPS-20 STYLE NAME
OP.NCH: ;
ILDB C,T2 ;GET AN ID CHARACTER
CAIN T1,6 ;SIXBIT?
ADDI C,40 ;
CAIN T1,11 ;EBCDIC?
LDB C,PTR.97## ;
;THE FOLLOWING SET OF TESTS ARE VERY PEDESTRIAN BUT THEY GET THE JOB DONE.
CAIN C," " ; ASCII SPACE?
JRST OP.PLP ;YES, GO GET NEXT CHAR
CAIGE C,"0" ;ANYTHING ELSE LESS THAN "0"?
JRST OP.T20 ; YES
CAIG C,"9" ;LESS THAN OR = "9"?
JRST OP.PLP ; YES, ON TO NEXT CHAR
CAIGE C,"A" ;LESS THAN "A"?
JRST OP.T20 ; YES
CAIG C,"Z" ;LESS THAN OR = "Z"?
JRST OP.PLP ; YES, ON TO NEXT CHAR
CAIGE C,"a" ;LESS THAN "a"?
JRST OP.T20 ; YES
CAILE C,"z" ;LESS THAN OR = "z"?
JRST OP.T20 ; NO
OP.PLP: ;
SOJG T3,OP.NCH ;SUB 1 AND IF > 0 GO PICK UP NEXT CHAR
; JRST OP.T10 ; ALL DONE WITH LOOP - IS OLD-STYLE NAME
OP.T10: ;
PUSHJ PP,PICKFN ;CONVERT VALUE-OF-ID TO TOPS-10 RMS FILENAME
JRST RFNFER ;ERROR, GO RECOVER FROM FNF ERROR
JRST OP.PNX ;IF OK, GO ON
OP.T20: ;
CAIE T1,7 ;IS BYTESIZE 7? (IN ASCII)
JRST CVTVID ;NO, CONVERT IT TO ASCIZ STRING
HRRZ T1,F.WVID(FT) ;GET ADDRESS OF ASCIZ VALUE OF ID STRING
$STORE T1,FNA,(T4) ; AND STORE IT IN THE FAB FOR RMS-20
JRST OP.PNX ;
CVTVID: MOVEI T1,.RCFNM(FTL) ;
$STORE T1,FNA,(T4) ;STORE ADDRESS OF ASCIZ ID IN FAB
HRRZ T3,F.SZID(FT) ;SIZE OF NAME
MOVSI T4,(POINT 7,) ;BUILD BYTE POINTER TO NAME
HRR T4,T1 ;
MOVE T2,F.WVID(FT) ;SOURCE BYTE POINTER
CVT.1: ILDB C,T2 ;GET CHARACTER
TLNE T2,1000 ;EBCDIC?
LDB C,PTR.97## ;
TLNN T2,1000 ;SIXBIT?
ADDI C,40 ;
IDPB C,T4 ;
SOJG T3,CVT.1 ;DECREMENT CHARACTER COUNT
OP.PNX: ;
TXO FLG,LF%FNA ;"FILENAME IS OK TO TYPE NOW"
HRRM FLG,D.F1(FT) ; REMEMBER THAT
MOVE T4,.RCFAB(FTL) ;GET PTR TO FAB AGAIN
;FILE ORGANIZATION
; THIS IS RETURNED TO US IF OPEN FOR INPUT OR I/O
;HOWEVER, FOR CREATE WE HAVE TO FIGURE IT OUT. START OUT WITH NULL VALUE
;AND QUERY THE INDIVIDUAL BITS IN FILE ORG FIELD OF FILE TABLE FLAG WORD.
SETZ T1, ;ZERO IT OUT
MOVE T3,F.WFLG(FT) ;GET FLAG WORD FROM FILE TABLE
TLNE T3,IDXFIL ;INDEXED?
MOVEI T1,FB$IDX ;SET BIT
TLNE T3,RANFIL ;RELATIVE?
MOVEI T1,FB$REL ;SET BIT
TLNE T3,SEQFIL ;SEQUENTIAL?
MOVEI T1,FB$SEQ ;SET BIT
$STORE T1,ORG,(T4) ;PUT ORG IN FAB
TLNE T3,SEQFIL ;IS FILE SEQUENTIAL?
SKIPN F.WSMU(FT) ; AND ARE WE DOING SMU OPTION 1?
SKIPA ;NO TO AT LEAST ONE OF THE ABOVE
JRST SM1SER ; YES TO BOTH
;*** RECORD ATTRIBUTES -- ALL ZERO FOR INDEXED FILES *** AND FOR RELATIVE FILES
;FILE OPTIONS -- FOR INDEXED FILES ONLY, FILE FLAG WORD STILL IN T3.
TLNN T3,IDXFIL ;INDEXED?
JRST OP.MX5 ;NO. NOTE, DON'T NEED XAB ADDR EITHER
LDB T1,FT.DIO ;DEFERRED WRITE
SKIPE T1 ;SKIP IF USER DIDN'T SPECIFY "DEFERRED WRITE"
MOVEI T1,FB$DFW ; SET THE BIT
$STORE T1,FOP,(T4) ;IN "FILE-OPTIONS"
;XAB ADDRESS
MOVE T1,.RCXAB(FTL)
$STORE T1,XAB,(T4)
;THE FOLLOWING COMMENT DOES NOT APPLY TO RELATIVE FILES.
;WE DEAL WITH MRS FOR THEM UNDER BUCKET SIZE
; ** Leave maximum record size (MRS) at zero **
; This allows a file to be created and then later
; the record size increased.
;BYTE SIZE
;THE FOLLOWING CODE INVOLVING THE MOVES OF INDEXED LITERALS HAS BEEN
;REVISED TO TRY TO REFLECT MORE CLOSELY WHAT IS SHOWN IN FTDEFS.MAC
;CONCERNING THE RUN-TIME DEVICE DATA MODE FIELD IN THE FILE TABLE FLAG
;WORD. THE LDB INSTRUCTION IS NOT COMPLETELY IN CONFORMITY WITH THE
;FIELD F%ADDM IN FTDEFS, AS THAT FIELD SHOWS A BYTE SIZE OF 4.
;THIS LDB TRUNCATES THE RIGHTMOST BIT OF THAT FIELD.
;YOU WILL NOTICE, HOWEVER, THAT RECORDING MODE BINARY IS SET UP AS SIXBIT.
;SORRY ABOUT THAT, FOLKS. IT WOULD HAVE TAKEN A LOT OF KROCKING TO MAKE
;PURE BINARY WORK ACCORDING TO THE CONCEPT, AND THE EFFECT IS THE SAME
;AS FAR AS THE USER IS CONCERNED. THE ONLY DIFFERENCE IS THAT THE BYTE
;SIZE IS SET UP AS 6 IN THE RMS FILE HEADER, AND THE BYTE COUNT IN THE
;RECORD HEADER IS GIVEN FOR SIXBIT BYTES.
OP.MX5:
MOVE T0,F.WFLG(FT) ;GET COMPILER FLAGS
LDB T1,[POINT 3,T0,2] ;GET DEVICE DATA MODE
CAIN T1,ASCDDM ;ASCII?
MOVEI T1,ASCMOD ;YES, NORMALIZE FOR LITERAL S BELOW
; BINARY = 0; EBCDIC = 1; SIXBIT = 2; ASCII = 3
MOVE T2,[SIXSIZ
EBCSIZ
SIXSIZ
ASCSIZ](T1) ;GET BYTE SIZE DEPENDING ON MODE
;;;;; THE FOLLOWING COMMENT APPLIED TO THE WORK DONE ON INDEX FILES RE
;;;;; THE FCCTC TESTS FOR VERSION 12B
;APPARENTLY BINARY IS NOT AN ISSUE. SUBSUME UNDER SIXBIT?
;;;;; THE ANSWER IS YES.
$STORE T2,BSZ,(T4)
;T1 STILL CONTAINS THE MODE..
;BUCKET SIZE
MOVE T2,[SIXCT
EBCCT
SIXCT
ASCCT](T1) ;GET BYTES/WORD DEPENDING ON MODE
LDB T1,FT.MRS ;GET MAXIMUM RECORD SIZE
;T0: STILL CONTAINS THE FLAG WORD FROM THE FILE TABLE, SO TEST FOR MRS ON
;RELATIVE FILE NOW, AND STORE IT IN FAB.
TLNE T0,RANFIL ;RELATIVE FILE?
$STORE T1,MRS,(T4) ;YES, PUT IT IN FAB
;DO THE REST OF THIS PARAGRAPH ONLY FOR INDEXED FILES. DON'T WORRY ABOUT
;BUCKET SIZE FOR OTHER FILE TYPES BESIDES INDEXED.
TLNN T0,IDXFIL ;INDEXED?
JRST OP.MX6
IDIV T1,T2 ;GET T1=# WORDS, T2=REMAINDER
SKIPE T2 ;ROUND UP
ADDI T1,1
ADDI T1,BA$OVH ;# HEADER WORDS PER BUCKET
IDIVI T1,BA$WPU ;GET # BUCKET UNITS NEEDED
SKIPE T2
ADDI T1,1 ;ROUND UP
$STORE T1,BKS,(T4)
;[1044] SPACE FILL THE RECORD AREA
MOVE T0,F.WFLG(FT) ;[1044] GET FLAGS
LDB T3,[POINT 2,T0,2] ;[1044] GRAB OFF EBCDIC AND SIXBIT BITS OF
;[1044] DEVICE DATA MODE FIELD.
MOVE T2,[EXP ASCCT,
EBCCT,
SIXCT](T3) ;[1044] GET BYTES/WORD IN T2
LDB T1,FT.MRS ;[1044] MAX RECORD SIZE
IDIV T1,T2 ;[1044] # OF WORDS
SKIPE T2 ;[1044] ROUND UP IF
ADDI T1,1 ;[1044] ANY REMAINDER
LDB T3,[POINT 2,T0,14] ;[1044] GET EBCDIC AND SIXBIT BITS OF INTERNAL DATA MODE
MOVE T0,SPCTLE(T3) ;[1044] GET PROPER SPACE FOR INTERNAL DATA MODE
MOVE T2,F.RREC(FT) ;[1044] GET RECORD PTR
MOVEM T0,(T2) ;[1044] FILL FIRST LOC WITH SPACE
HRLI T0,(T2) ;[1044] THE FROM ADR
HRRI T0,1(T2) ;[1044] THE TO ADR
ADDI T1,-1(T2) ;[1044] THE UNTIL ADR
BLT T0,(T1) ;[1044] FILL WITH SPACES
MOVE T0,F.WFLG(FT) ;RESTORE FLAGS TO T0
;RECORD FORMAT
OP.MX6:
MOVEI T1,FB$VAR ;VARIABLE LENGTH FORMAT
TLNN T0,SEQFIL ;SEQENTIAL FILE?
JRST OP.MX7 ;NO
$FETCH T3,BSZ,(T4) ;GET BYTE SIZE
REPEAT 0,< ;DISABLE ASCII STREAM
CAIN T3,ASCSIZ ;IS IT ASCII?
MOVEI T1,FB$STM ;YES, SPECIFY STREAM FILE
> ;END REPEAT 0
OP.MX7:
$STORE T1,RFM,(T4)
CAIE T3,ASCSIZ ;ALSO ZERO OUT FLAG FOR FUNNY <CR> FOR
JRST OPMX7A ; ASCII STREAM FILES
SETZ T2, ; TAKE T2 BECAUSE IT IS ABOUT TO BE ZEROED
DPB T2,FT.NOC ; OUT IN ANY EVENT.
OPMX7A:
;DON'T ALLOW BUCKET SPANNING FOR RELATIVE AND SEQUENTIAL FILES EXCEPT
;FOR ASCII STREAM.
HRRZI T2,0 ;INIT TO RECEIVE REC ATTRIB VALUES
REPEAT 0,< ;DISABLE ASCII STREAM
CAIE T0,IDXFIL ;INDEXED FILE?, YES - NOT APPLICABLE
CAIN T1,FB$STM ;ASCII STREAM FILE?
JRST OP.MX9 ; YES - ILLEGAL NOT TO ALLOW SPANNING
> ;END REPEAT 0
MOVEI T2,FB$BLK ;MAKE IT BLOCKED
OP.MX9:
$STORE T2,RAT,(T4) ;RECORD ATTRIBUTES INTO FAB.
;SETUP SOME THINGS IN THE RAB, SINCE WE KNOW WHERE THE RECORD IS.
MOVE T2,.RCRAB(FTL) ;POINT TO THE RAB
HRRZ T1,F.RREC(FT) ;POINT TO RECORD
TXNE FLG,CF%CNV ;IF CONVERSION REQUIRED,
HRRZ T1,.RCCRB(FTL) ;POINT TO CONVERTED RECORD BUFFER
$STORE T1,UBF,(T2) ;TELL RMS WHERE RECORD AREA IS
$STORE T1,RBF,(T2) ;. .
TLNE T0,SEQFIL ;DOING SEQ FILE?
JRST OP.MX8 ;DON'T NEED KEY BUFFER
HRRZ T1,.RCCKB(FTL) ;GET KEY BUFFER IF CONVERSION REQUIRED.
TXNE FLG,CF%CNV ;IF WE MADE A KEY BUFFER ADDRESS,
$STORE T1,KBF,(T2) ;TELL RMS WHERE IT IS
;TELL RMS HOW MANY BUFFERS IT WILL NEED (1 PAGE EACH).
; WE WILL LET IT USE 1 BUFFER FOR EACH KEY, PLUS THREE.
;FIND # OF KEYS -- ONLY FOR INDEXED FILES.
;WE DON'T NEED A BUFFER FOR RELATIVE FILES.
OP.MX8:
SETZ T1, ;CLEAR T1, IN CASE WE JUMP BELOW
TLNN T0,IDXFIL ;NEED KEY BUFFERS ONLY FOR INDEX FILES
JRST ORABS0 ;NOT INDEXED
HLRZ T3,F.RMKL(FT) ;GET ADDRESS OF KEY INFO
MOVE T1,(T3) ;T1:=FIRST WORD = # OF KEYS
ORABS0:
ADDI T1,OVHEAD ;GET # KEYS + 3
LDB T3,FT.NAB ; GET NUMBER HE SPECIFIED
JUMPE T3,ORABS1 ;JUMP IF HE DIDN'T SPECIFY ANY
MOVEI T1,0 ;WE MIGHT HAVE TO LET RMS DECIDE
CAIL T3,OVHEAD ;MUST BE AT LEAST THREE
MOVE T1,T3 ;OK, USE THE NUMBER HE SPECIFIED
ORABS1: $STORE T1,MBF,(T2) ;TELL RMS
TLNN T0,RANFIL ;RELATIVE FILE?
JRST ORABS2 ;NO
HRRZ T1,F.RACK(FT) ;SET UP KEY BUFFER ADDRESS
$STORE T1,KBF,(T2) ; AND SAVE IN RAB
ORABS2:
SKIPN F.WSMU(FT) ;DOING SMU OPTION 1?
JRST ORABS3 ; NO
;FOR SMU OPTION 1 SET UP SHADOW RAB NOW
HRLZ T1,.RCRAB(FTL) ;COPY OVER EXISTING REGULAR RAB SETUP
HRR T1,.RCFAK(FTL) ; TO SHADOW RAB AREA
HRRZI T2,PRRABL-1(T1) ;
BLT T1,(T2) ;
; AND TELL SHADOW RAB WHERE SHADOW BUFFER AND FAKE KEY CONV BUFFER ARE..
MOVE T2,.RCFAK(FTL) ;GET ADDRESS OF SHADOW RAB FROM CONTROL BLOCK
HRRZ T1,SM.BUF ;GET ADDRESS OF SHADOW BUFFER
$STORE T1,UBF,(T2) ; AND STORE IT IN THE SHADOW RAB AS USER BUFFER
$STORE T1,RBF,(T2) ; AND RECORD BUFFER
HRRZ T1,.RCFKC(FTL) ;GET ADDR OF FAKE KEY BUFFER
$STORE T1,KBF,(T2) ; AND STORE IT IN SHADOW RAB.
ORABS3:
;SETUP BYTE PTR TO THE USER'S RECORD IN THE RMS CONTROL BLOCK.
; (THIS WILL DEFINITELY BE NEEDED FOR CONVERSION, AT LEAST).
HRRZ T1,F.RREC(FT) ;POINT TO RECORD
MOVE T2,F.WFLG(FT) ;GET COMPILER FLAGS
LDB T2,[POINT 2,T2,14] ;GET INTERNAL REC. MODE.
;0= ASCII, 1=EBCDIC, 2=SIXBIT
HRL T1,[(POINT 7,)
(POINT 9,)
(POINT 6,)](T2) ;GET LH OF BYTE PTR.
MOVEM T1,.RCBPR(FTL) ;STORE BYTE PTR TO RECORD.
;CALL RMS. IF OPEN OUTPUT, DO A $CREATE.
; IF OPEN INPUT, DO A $OPEN
; IF OPEN I-O, DO A $OPEN
; IF OPEN EXTEND, DO A $CREATE WITH FB$CIF BIT SET
TXNE FLG,OPN%IO ;OPEN I-O?
JRST OP.MXA ;YES
TXNE FLG,OPN%IN ;OPEN INPUT?
JRST OP.MXB ;YES
;OPEN OUTPUT AND OPEN EXTEND
OP.MXC: MOVE T2,.RCFAB(FTL) ;POINT TO FAB
$FETCH T1,FOP,(T2) ;GET FOP BITS NOW
TXNN FLG,OPN%EX ;DOING OPEN EXTEND?
IORI T1,FB$SUP ;NO, SET SUPERSEDE MODE
TXNE FLG,OPN%EX ;DOING OPEN EXTEND?
IORI T1,FB$CIF ;YES, SET CREATE-IF-MUST BIT
$STORE T1,FOP,(T2)
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$CREATE <(T2)>,OPCER ;** DO THE CREATE **
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
SKIPE FS.FS ;DID WE SET FILE-STATUS TO NON-ZERO?
POPJ PP, ;YES, * RETURN FROM OPEN *
PUSHJ PP,DOCONN ;DO THE CONNECT
SKIPE FS.FS ;DID WE SET FILE-STATUS TO NON-ZERO?
POPJ PP, ;YES, CONNECT ERROR RECOVERED, FILE IS CLOSED
TXO FLG,LF%OUT ;FILE IS NOW OPEN FOR OUTPUT
HRRM FLG,D.F1(FT) ;SET IN FILE-TABLE
PUSHJ PP,SETFS ;SET THE FILE-STATUS TO 00
JRST OPNDON ;DONE
;ERROR RETURN FROM $CREATE
OPCER: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCFAB(FTL) ;ADDR OF THE FAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIN T1,ER$COF ;RMS CAN'T OPEN FILE?
JRST OPCER1 ;YES, SAY WHY
CAIN T1,ER$FNF ;FILE-NOT-FOUND ERROR
JRST OPOFNF ;YES
CAIN T1,ER$PRV ;PROTECTION VIOLATION?
JRST OPOPRV ;YES
TYPE [ASCIZ/
?COBLIB: Error on Creating RMS File
/]
;RMS-SYSTEM FAILURES, THE FAB HAS THE ERROR STUFF IN IT.
;NOTE: RMS ERROR CODES CAN ALSO COME HOPPING OUT TO THE USER AT RUN TIME.
;THEY WILL BE OCTAL NUMBERS OF THE FORM 300nnn, AND THEY CAN BE LOOKED
;UP IN THE TOPS-10/20 REFERENCE MANUAL, RMSREF.MEM.
RSFAIF: MOVE T2,.RCFAB(FTL) ;POINT TO FAB
RSFAI1: $FETCH P1,STS,(T2) ;STS IN P1
$FETCH P2,STV,(T2) ;STV IN P2
PUSHJ PP,RMSERP ;REPORT RMS ERROR
PUSHJ PP,SETFS ;PUT F-S INTO USER'S F-S FIELD
RSFAI2: $ERROR (E.500,SV.KIL,MT.FIL) ;ERROR 500 WITH FILENAME
;RMS-SYSTEM FAILURES, THE RAB HAS THE ERROR STUFF IN IT
RSFAIR: MOVE T2,.RCRAB(FTL) ;POINT TO RAB
JRST RSFAI1
;RMS-SYSTEM FAILURES, THE FAKE RAB HAS THE ERROR STUFF IN IT
RSFAIK: MOVE T2,.RCFAK(FTL) ;POINT TO FAKE RAB
JRST RSFAI1
OPCER1: TYPE [ASCIZ/
?COBLIB: can't create RMS file
/]
JRST RSFAIF ;ERROR WITH FILENAME
;OPEN I-O
OP.MXA: MOVE T2,.RCFAB(FTL) ;POINT TO FAB
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$OPEN <(T2)>,OPOER ;** DO THE OPEN **
TRNA ;NORMAL RETURN
JRST OP.MXA ;TRY-AGAIN RETURN
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVE T1,FS.FS ;GET FILE-STATUS CODE
CAIE T1,FS%92 ;IS IT 92 FOR FILE LOCKED BY SOMEONE ELSE?
JRST OPMXAK ; NO, GO TO CHECK RETURNED PARAMETERS
MOVE T2,BS.AGL## ;GET POINTER TO ARG LIST
MOVE T1,FLGFIL(T2) ;GET ARG PASSED WHEN OP.MIX CALLED
TXNN T1,OPN%UN ;UNAVAILABLE FLAG SET?
JRST OPMXAK ; NO, GO CHECK RETURNED PARAMETERS
AOS (PP) ;YES, DO SKIP RETURN TO UNAVAILABLE RETURN
POPJ PP, ;
OPMXAK:
SKIPE FS.FS ;DID WE SET FILE-STATUS NON-ZERO?
POPJ PP, ;Yes, ** ERROR IGNORED, return from OPEN **
PUSHJ PP,CHKOPF ;CHECK PARAMETERS RETURNED TO US
SKIPE FS.FS ;Error 507 given and user ignored it?
JRST OPMXAI ;Yes
PUSHJ PP,DOCONN ;DO THE CONNECT
SKIPE FS.FS ;FILE STATUS NON-ZERO?
POPJ PP, ;YES, CONNECT FAILED, RETURN
OPMXAJ: TXO FLG,LF%INP!LF%OUT!LF%IO ;FILE IS OPEN FOR IO
HRRM FLG,D.F1(FT) ;SET IN FILE-TABLE
PUSHJ PP,SETFS ;SET THE FILE-STATUS TO 00
JRST OPNDON ;DONE
OPMXAI: PUSH PP,FS.FS ;Save file-status word
SETZM FS.FS ;To test it..
PUSHJ PP,DOCONN ;Try to do connect
SKIPN FS.FS ;Did connect fail?
JRST [POP PP,FS.FS ;No, restore file-status of "PERM error"
JRST OPMXAJ] ;Go set "FILE is open" bits and return
POP PP,(PP) ;Return newest set file-status
JRST OPMXAJ ;Remember file is open, though
;RMS $OPEN I-O OR OUTPUT ERRORS COME HERE
OPOER: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCFAB(FTL) ;ADDR OF THE FAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
TXNN FLG,OPN%IO ;OPEN FOR I-O?
JRST OPOER2 ; NO
CAIN T1,ER$DEV ;DEVICE ERROR?
JRST OPDVER ; YES
OPOER2: CAIN T1,ER$FNF ;FILE NOT FOUND?
JRST OPOFNF ;YES
CAIN T1,ER$COF ;RMS CAN'T OPEN FILE?
JRST OPOER1 ;SAY WHY
CAIN T1,ER$FLK ;FILE ALREADY LOCKED (BY SOME OTHER JOB)
JRST OPOFLK ;YES
CAIN T1,ER$PRV ;PROTECTION VIOLATION?
JRST OPOPRV ;YES
TYPE [ASCIZ/
?COBLIB: Error on Opening RMS File
/]
JRST RSFAIF ;RMS-SYSTEM FAILURE
OPDVER: MOVEI T1,FS%37 ;SET F-S CODE FOR DEVICE ERROR ON OPEN
MOVEM T1,FS.FS ;
PUSHJ PP,SETFS ;
TYPE [ASCIZ/
?Error Opening RMS File: Improper Device
/]
JRST RSFAIF ; AND GIVE PROGRAM FAILURE
;FILE NOT FOUND - ERROR FOR $OPEN OR $CREATE
;NOTE: IF AN OPTIONAL SEQUENTIAL FILE OPENED FOR INPUT IS NOT PRESENT,
;THE $OPEN HAS FAILED. HERE WE SHOULD WARN THE USER THAT WE ARE PROCEEDING
;WITHOUT THE FILE, THEN SET THE NOTPRS BIT, RELEASE THE CORE AND RETURN.
;IN RD.MIS FOR SEQUENTIAL READS, WE INTERCEPT THE READ AND SET THE AT-END
;BIT FOR THE FIRST ATTEMPT TO READ.
OPOFNF:
MOVE T1,D.F1(FT) ;GET THE FLG1 FLAG WORD FROM FILE TABLE
TLNN T1,FILOPT ;FILE OPTIONAL?
JRST OPOFN2 ;NO
MOVE T1,F.WFLG(FT) ;GET FILE TABLE'S FLAG WORD
TLNE T1,SEQFIL ;IS FILE SEQUENTIAL?
TXNN FLG,OPN%IN ;YES, FILE OPENED FOR INPUT?
JRST OPOFN2 ;NO
TLO T1,NOTPRS ;SET FILE-NOT-PRESENT BIT
MOVEM T1,F.WFLG(FT) ;UPDATE FILE TABLE FLAG WORD
SKIPL WANT8. ;WANT ANS 8X FUNCT?
JRST OPOFN1 ; NO
MOVEI T0,FS%35 ;SET F-S FOR NON-OPT FILE NOT PRES
HLLZ T1,D.F1(FT) ;GET FLG1 FLAGS
TXNE T1,B%OPTF ;IS FILE OPTIONAL?
MOVEI T0,FS%05 ; YES, LET EM OFF EASY
MOVEM T0,FS.FS ;SAVE FILE-STATUS
PUSH PP,T1 ;SAVE FLAGS TEMPORARILY
PUSHJ PP,SETFS ; AND PUT IT IN USER'S FIELD
POP PP,T1 ;GET FLAGS BACK
TXNE T1,B%OPTF ;TEST FOR OPTIONAL AGAIN
JRST OPOFN2 ; IF NOT, SOCK IT TO THEM
;THE FOLLOWING ERROR ROUTINE RETURNS AT THE NORMAL RETURN FOLLOWING THE
; $OPEN AT OP.MXB
OPOFN1: $ERROR (E.525,SV.WRN,MT.FIL,RFNFER) ;AND WARN USER
OPOFN2: MOVE T2,.RCFAB(FTL) ;GET ADDR OF FAB AGAIN.
$FETCH T1,STV,(T2) ;FETCH THE JSYS ERROR CODE
IFN TOPS20,<
MOVEM T1,ER.JSE ;STORE FOR ERROR PRINTOUT
$ERROR (E.508,SV.FAT,MT.FIL!MT.JSE,RFNFER)
>;END IFN TOPS20
IFE TOPS20,<
SETO T2, ;INCASE ONE DOESN'T MATCH
CAIN T1,ERIPP%
MOVEI T2,0 ;GET TOPS10 ERROR CODE
CAIN T1,ERDNA%
MOVEI T2,1
CAIN T1,ERNSD%
MOVEI T2,2
CAIN T1,ERSNF%
MOVEI T2,3
JUMPL T2,OPOFN1 ;NO ADDITIONAL STATUS WE CAN USE
MOVEM T2,ER.E10 ;SAVE TOPS10 ERROR CODE
$ERROR (E.508,SV.FAT,MT.FIL!MT.E10,RFNFER)
OPOFN1: $ERROR (E.508,SV.FAT,MT.FIL,RFNFER)
>;END IFE TOPS20
OPOER1: TYPE [ASCIZ/
?Can't open file
/]
JRST RSFAIF ;RMS-SYSTEM FAILURE
;PROTECTION VIOLATION - THIS IS SIMILAR TO "FILE NOT FOUND"
; FROM USER'S POINT OF VIEW
;GO TO "RFNFER" IF HE WANTS TO TRAP THE ERROR - IT WILL CLEAR CORE
; AND RETURN FROM THE "OPEN" STATEMENT
OPOPRV: $ERROR (E.521,SV.FAT,MT.FIL,RFNFER)
;Here if file is already locked - probably someone else has the file
; open for I-O
;IF WE ARE DOING AN OPEN WITH APPLY BASIC-LOCKING AND THERE IS AN UNAVAILABLE
;CLAUSE ON THE OPEN STMT., WE DON'T WANT THE RUN TO INCUR A FATAL ERROR
;BECAUSE THE PROGRAMMER HAS SUPPLIED THE PROPER ESCAPE HATCH.
OPOFLK:
LDB T1,FT.ABL ;ARE WE DOING APPLY BASIC-LOCKING?
JUMPE T1,OPFLKE ;NO - ERROR
MOVE T2,BS.AGL## ;GET POINTER TO ARG LIST
MOVE T1,FLGFIL(T2) ; GET ARG WORD ON ENTRY TO OP.MIX
TXNN T1,OPN%UN ;UNAVAILABLE CLAUSE ON OPEN?
JRST OPFLKE ;NO - ERROR
MOVEI T1,FS%92 ;SET FILE-LOCKED CODE INTO FILE-STATUS
MOVEM T1,FS.FS ;
PJRST SETFS ; ETC., AND DO NORMAL RETURN
OPFLKE:
$ERROR (E.520,SV.FAT,MT.FIL!MT.OER,OPOFL1)
;Ignore OPEN error for "file is busy"
OPOFL1: MOVEI T1,UP%OER ;Check for filename OPEN
PUSHJ PP,CHKUSE ;Skip if that special case.
JRST RFNFER ;[1022] Jump to routine to release memory
AOS (PP) ;GIVE A TRY-AGAIN RETURN
POPJ PP, ;RETURN..
;OPEN INPUT
OP.MXB: MOVE T2,.RCFAB(FTL) ;POINT TO FAB
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$OPEN <(T2)>,OPOER ;** DO THE OPEN **
TRNA ;NORMAL RETURN
JRST OP.MXB ;TRY-AGAIN RETURN
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
SKIPE FS.FS ;DID WE SET FILE-STATUS NON-ZERO?
POPJ PP, ;YES, ERROR IGNORED. * RETURN FROM OPEN *
MOVE T1,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNN T1,NOTPRS ;OPTIONAL FILE NOT PRESENT?
JRST OPMXB2 ; NO
SKIPL WANT8. ;WANT 8X FUNCT?
JRST OPMXB2 ; NO
MOVEI T0,FS%05 ;SET UP FILE-STATUS NUMBER
MOVEM T0,FS.FS ; AND SAVE IT
PJRST SETFS ; AND SET IT, RETURN -- SUCCESS SORT OF
OPMXB2: PUSHJ PP,CHKOPF ;CHECK PARAMETERS RETURNED TO US
SKIPE FS.FS ;Error 507 happen?
JRST OPMXBI ;Yes
PUSHJ PP,DOCONN ;DO THE CONNECT
SKIPE FS.FS ;FILE-STATUS SET NON-ZERO?
POPJ PP, ;YES, ERROR IGNORED, * RETURN FROM OPEN *
OPMXBJ: TXO FLG,LF%INP ;FILE IS NOW OPEN FOR INPUT
HRRM FLG,D.F1(FT) ;STORE UPDATED FLAGS
PUSHJ PP,SETFS ;SET THE FILE-STATUS TO 00
JRST OPNDON ;DONE
OPMXBI: PUSH PP,FS.FS ;Save file-status word
SETZM FS.FS ;To test it..
PUSHJ PP,DOCONN ;Try to do connect
SKIPN FS.FS ;Did connect fail?
JRST [POP PP,FS.FS ;No, restore file-status of "PERM error"
JRST OPMXBJ] ;Go set "FILE is open" bits and return
POP PP,(PP) ;Return newest set file-status
JRST OPMXBJ ;Remember file is open, though
;HERE WHEN OPEN IS DONE (RMS $CREATE/$OPEN AND $CONNECT)
OPNDON: POPJ PP, ;SUCCESS, RETURN
;COME HERE IF USER WANTS TO RECOVER FROM "FILE NOT FOUND" TYPE ERROR
; THE FILE IS NOT OPENED, WE MUST RELEASE THE CORE WE GOT AND RETURN
; FROM THE OPEN STATEMENT
RFNFER: PUSHJ PP,ROPCOR ;RELEASE CORE FROM THE OPEN
POPJ PP, ; RETURN FROM OPEN, OR OPOER ERROR ROUTINE
SPCTLE: ASCII / / ;[1044] ASCII SPACES
BYTE (9) 100,100,100,100 ;[1044] EBCDIC
SIXBIT / / ;[1044] SIXBIT
;CHKOPF Routine to check parameters of the file we just opened
;Called after $OPEN returned successfully
; RMS has stored the parameters it found in the prologue of the
;file in the FAB and XAB's we gave it.
;
;Inputs:
; FTL points to RMS file table
;Call:
; PUSHJ PP,CHKOPF
; <return here if no error or error ignored>
; Doesn't return if user doesn't trap the error
;Uses T1-T4
;
;Notes:
;1) If we are opening a file that was created with more keys
; than we specified, no error will be generated. (this is a feature!)
;2) If the file organization is wrong, error 519 is given. This
; may be trapped (and ignored) by a USE procedure.
;3) If anything else is wrong, error 507 will be generated, which
; may be trapped by a USE procedure. If there is no USE procedure,
; a specific error message will be printed.
;4) Skips if there was no error, or an error was ignored and the
; file was left open.
;FTL POINTS TO THE RMS-CONTROL BLOCK
CHKOPF: MOVE T2,.RCFAB(FTL) ;GET PTR TO FAB RETURNED
;THE FOLLOWING TEST IS NOT APPLICABLE FOR V13
;
;;;;;MAKE SURE FILE ORGANIZATION IS INDEXED
;;;;; $FETCH T1,ORG,(T2) ;GET FILE ORGANIZATION
;;;;; CAIE T1,FB$IDX ;MUST BE INDEXED
;;;;; JRST ERORG ;?WRONG ORGANIZATION
;
;INSTEAD, CHECK ORG FIELD IN FAB AGAINST ORG FIELD IN FILE TABLE FLAG WORD.
;TO DO THIS, WE MAP THE BITS OF THE FAB'S ORG FIELD INTO THE FORM USED
;BY THE FILE TABLE, THEN COMPARE THE RESULT OF THIS MAPPING WITH WHAT IS
;IN THE FILE TYPE FIELD OF THE FILE TABLE'S FLAG WORD.
$FETCH T1,ORG,(T2) ;GET FAB'S ORG FIELD
SETZ T0, ;CLEAR T0 TO RECEIVE BIT MAP
CAIN T1,FB$IDX ;TEST BITS IN T1 AND TWEAK IN T0
;NOTE: FB$IDX = 3 !!!
TRO T0,IDXFIL
CAIN T1,FB$REL
TRO T0,RANFIL
CAIN T1,FB$SEQ
TRO T0,SEQFIL
SETZ T1, ;NOW CLEAR T1 TO RECEIVE FILE TABLE TYPE
LDB T1,FT.ORG ;GET THE FILE TABLE TYPE
CAME T0,T1 ;ARE THEY THE SAME?
JRST ERORG ;NO -- ERROR
;CHECK MAX RECORD SIZE
$FETCH T1,MRS,(T2) ;Get file's value
JUMPE T1,CHKOP0 ;Zero means unlimited.
LDB T3,FT.MRS ;GET program max record size
CAMGE T1,T3 ;Skip if user will be able to write
; a record.
JRST CKFE0 ;NO, COMPLAIN
;ALL THE REST OF THE TESTS DEAL WITH INDEXED FILES ONLY.
;WE SHALL HAVE TO PUT IN A SEPARATE SERIES OF TESTS FOR
; SEQUENTIAL FILES.
CHKOP0:
$FETCH T1,ORG,(T2) ;GET FILE'S ORG TYPE
CAIE FB$IDX ;CONTINUE ON IF INDEXED
JRST CPOPJ ;HOP OUT OTHERWISE
;CHECK THE KEY INFORMATION
HRRZ T3,.RCKIN(FTL) ;GET ADDRESS OF KEY INFO
MOVE T4,(T3) ;T4= # OF KEYS
MOVN T4,T4
HRLZ T4,T4 ;GET -N,,0
MOVE T2,.RCXAB(FTL) ;T2= ADDRESS OF FIRST XAB
ADDI T3,1 ;T3 POINTS TO FIRST 2-WORD BLOCK
;HERE WITH T2= ADDRESS OF XAB
; RH(T4)= NUMBER OF THIS KEY (0 thru n)
; T3= ADDRESS OF THIS KEY BLOCK
CHKOP1: PUSH PP,T4 ;SAVE KEY NUMBER
HLRZ T4,(T3) ;T4= POSITION OF THE KEY
$FETCH T1,POS,(T2) ;GET POSITION RETURNED
CAME T1,T4 ;DO THEY MATCH?
JRST [POP PP,T4 ;NO, GIVE ERROR
JRST CKFE1]
HRRZ T4,(T3) ;GET SIZE OF THE KEY IN PROGRAM
$FETCH T1,SIZ,(T2) ;GET SIZE OF KEY IN THE FILE
CAME T1,T4 ;BETTER MATCH..
JRST [POP PP,T4 ;;NO, ERROR
JRST CKFE2]
$FETCH T1,DTP,(T2) ;GET DATATYPE OF THE KEY
MOVE T0,F.WFLG(FT) ;GET COMPILER FT FLAGS
MOVEI T4,XB$SIX ;ASSUME SIXBIT
TLNE T0,DDMASC ; IF ASCII,
MOVEI T4,XB$STG ;GET ASCII DATATYPE
TLNE T0,DDMEBC ; IF EBCDIC,
MOVEI T4,XB$EBC ;GET EBCDIC DATATYPE
CAME T1,T4 ;DOES PROGRAM DATATYPE MATCH FILE'S?
JRST [POP PP,T4 ;NO, GIVE ERROR
JRST CKFE3]
HRRZ T1,(PP) ;Get this key number
JUMPE T1,CHKOP2 ;If primary key, don't check dup flag yet
$FETCH T1,FLG,(T2) ;GET FLAGS
HLLZ T4,KYINFO(T3) ;GET FLAGS FOR THIS KEY
TXNE T1,XB$DUP ;DOES FILE SAY "DUPS ALLOWED" FOR THIS KEY?
JRST [TXNE T4,KI%DUP ;YES, IS DUPLICATES ALLOWED IN PROGRAM?
JRST CHKOP2 ;YES, ALL OK
POP PP,T4 ;NO, GIVE ERROR
JRST CKFE4]
TXNN T4,KI%DUP ;NO DUPS ALLOWED IN FILE, IN PROGRAM?
JRST CHKOP2 ;ALL OK
POP PP,T4 ;NO, GIVE ERROR
JRST CKFE4
;ALL OK
CHKOP2: POP PP,T4 ;RESTORE KEY AOBJN PTR.
AOBJP T4,CPOPJ ;Return if done all keys
ADDI T3,NXKEYB ;BUMP TO NEXT KEY INFO BLOCK
$FETCH T2,NXT,(T2) ;FETCH ADDRESS OF NEXT XAB
JRST CHKOP1 ;AND LOOP
;CHKOPF ROUTINE (CONT'D)
;COME HERE WITH MINOR ERROR MESSAGE NUMBER IN T1
CKFEEP: PUSH PP,T1 ;SAVE
MOVEI T1,FS%30 ;SET FILE-STATUS TO 30
SKIPGE WANT8. ;WANT 8X FUNCT?
MOVEI T1,FS%39 ;SET F-S CODE FOR FILE-PROG ATTRIBUTE CONFLICT
MOVEM T1,FS.FS
PUSHJ PP,SETFS ;SO USER CAN SEE THAT THERE WAS A PROBLEM
MOVEI T1,UP%ERR ;CHECK FOR ERROR USE PROCEDURE
PUSHJ PP,CHKUSE
JRST CKFEE1 ;NONE
POP PP,T1 ;Fix stack
$ERROR (E.507,SV.FAT,MT.FIL,CPOPJ) ;LET HIM TRAP IT
;HERE IF NO USE PROCEDURE. TYPE MESSAGE AND BOMB HIM OUT
CKFEE1: TYPE [ASCIZ/
?LBLEOO Error on OPEN: /]
POP PP,T1 ;GET MESSAGE NUMBER (MINOR)
TYPE @CKERS(T1) ;TYPE MESSAGE
$ERROR (E.507,SV.KIL,MT.FIL) ;GIVE FATAL ERROR
;CHKOPF errors that could happen
CKERS: [ASCIZ/Maximum record size of program is larger than file's/] ;0
[ASCIZ/Key position in program differs from file's/] ;1
[ASCIZ/Key length of program differs from file's/] ;2
[ASCIZ/Datatype of key in program differs from file's/] ;3
[ASCIZ/Key flags specified in program differ from file's key flags/] ;4
NMCERS==.-CKERS ;NUMBER OF ERROR MESSAGES
;DEFINE ERROR MESSAGE ROUTINES FOR THE MINOR ERRORS
DEFINE CKFEE(NN),<
CKFE'NN: MOVEI T1,NN ;GET MINOR ERROR NUMBER
JRST CKFEEP ;AND REPORT ERROR
>
%NN==0 ;INDEX FOR THE REPEAT..
REPEAT NMCERS,<
CKFEE(\%NN)
%NN==%NN+1
>
;ERROR - WRONG ORGANIZATION
ERORG: MOVEI T1,FS%30 ;SET FILE-STATUS TO 30
MOVEM T1,FS.FS
PUSHJ PP,SETFS ;SO USER CAN SEE THAT THERE WAS A PROBLEM
$ERROR (E.519,SV.FAT,MT.FIL,ERORGR) ;GIVE TRAPPABLE ERROR
;HERE IF USER WANTS TO IGNORE THE ERROR
; SET FLAGS SAYING THAT THE FILE IS OPEN, then call CLOSE.
ERORGR: TXO FLG,LF%INP ;"FILE IS OPEN FOR INPUT"
HRRM FLG,D.F1(FT) ;STORED UPDATED FLAGS
MOVE T1,BS.AGL ;GET BASE OF OPEN ARG LIST
MOVE T1,(T1) ;GET FILE-TABLE & FLAGS
TLZ T1,-1 ; JUST GET FILE-TABLE ADDR
PUSH PP,T1 ;SAVE ON STACK
MOVEI ARG,(PP) ;POINT TO ARG ON STACK
PUSHJ PP,CL.MIX ;CLOSE THE FILE
POP PP,(PP) ;FIX STACK
POPJ PP, ;RETURN
;DOCONN - ROUTINE TO DO A $CONNECT
;CALLED AFTER THE $OPEN OR $CREATE WAS SUCCESSFUL
;IF IT FAILS, $ERROR IS CALLED AND FILE STATUS SET TO 30
;IF THE ERROR IS TRAPPABLE, A USE PROCEDURE IS CALLED.
;
;IF ERROR HAPPENS AND THE USER TRAPPED IT, MEMORY IS CLEANED
;UP AND THE FILE IS CLOSED.
;
DOCONN: MOVE T2,.RCRAB(FTL) ;POINT TO THE RAB
;IF THE FILE HAS BEEN OPENED EXTEND, HERE WE POSITION THE RECORD POINTER (NRP)
;AT THE END
$FETCH T1,ROP,(T2) ;GET THE RAB RECORD OPERATION FLAGS
;NOW WE HAVE TO CHECK FOR SMU OPT 5 OPEN. FILE IS ALWAYS OPENED FOR I-O,
;SO THE FLAGS ARE USED DIFFERENTLY. SO, WE CANT GO THRU THE TEST FOR
;OPEN EXTEND
MOVE T4,BS.AGL## ;GET BS.AGL, WHICH POINTS AT THE ORIGINAL FLAGS
LDB T3,VB.FL1 ;GET THE VERB FIELD OF FLAG WORD
CAIN T3,V.OPT5 ;ARE WE DOING SMU OPTION 5 OPEN?
JRST DOCON1 ; YES
TXNE FLG,OPN%EX ;FILE OPENED FOR EXTEND?
IORI T1,RB$EOF ;SET THE EOF BIT IN THE ROP FLAGS
DOCON1:
$STORE T1,ROP,(T2) ;RESTORE THE ROP FIELD TO THE RAB
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$CONNECT <(T2)>,CONERR ;DO IT
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
;IF THE CONNECT IS SUCCESSFUL, WE CAN SAVE THE JFN ASIDE IN THE FILE TABLE
MOVE T2,.RCFAB(FTL) ;GET ADDRESS OF FAB
$FETCH T1,JFN,(T2) ; GET FILE'S JFN
HRRZM T1,D.JFN(FT) ; AND STORE IT IN FILE TABLE
;IF WE ARE DOING SMU OPTION 1 CONNECT SHADOW RAB
SKIPN F.WSMU(FT) ;DOING SMU OPTION 1?
JRST DOCNEX ; NO
MOVE T2,.RCFAK(FTL) ;YES, GET ADDRESS OF SHADOW RAB
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$CONNECT <(T2)>,CONER1 ; AND CONNECT IT.
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
;THEN RETURN TO CALLING ROUTINE
DOCNEX:
POPJ PP, ; RETURN
;CONNECT REAL RAB FAILED
CONERR: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVE T2,.RCRAB(FTL) ;ADDR OF THE FAB
JRST CONER2
;CONNECT SHADOW RAB FAILED
CONER1: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVE T2,.RCFAK(FTL) ;ADDR OF FAKE RAB
CONER2: $FETCH T1,STS,(T2) ;GET STATUS RETURNED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
CAIN T1,ER$DME ;DYNAMIC MEMORY EXHAUSTED
JRST CONDME ;YES
TYPE [ASCIZ/
?COBLIB: Failed to Connect to RMS File
/]
JRST RSFAIR ;RMS-SYSTEM FAILURE
;DYNAMIC MEMORY EXHAUSED, LET USER TRAP THIS IF HE WANTS
; (This will most likely happen in $CONNECT)
CONDME: MOVEI T1,FS%30 ;SET FILE-STATUS
MOVEM T1,FS.FS ; "PERMANENT ERROR"
PUSHJ PP,SETFS ;SET IT
$ERROR (E.503,SV.FAT,MT.FIL,CONDM1)
;HERE IF THE ERROR RETURNS (HE TRAPPED IT AND WANTS TO IGNORE IT).
;CLEAN UP AND RETURN TO USER
CONDM1: MOVE T2,.RCFAB(FTL) ;T2 POINTS TO FAB
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$CLOSE <(T2)>,CONDM2 ;** CLOSE THE FILE **
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
PUSHJ PP,ROPCOR ;RELEASE THE CORE
POPJ PP, ;AND RETURN
CONDM2:
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
TYPE [ASCIZ/?$CLOSE failed trying to recover from $CONNECT error
/]
JRST RSFAIF ;FAB HAS ERROR STUFF IN IT
;PICKFN - PICKUP FILENAME FROM VALUE-OF-ID AND STORE IT IN
; THE RMS FAB. FOR TOPS-10-STYLE NAME ONLY.
;ACS T1-T4 ARE SMASHED.
PICKFN: MOVEI T1,.RCFNM(FTL) ;STORE THE FILENAME ADDRESS
$STORE T1,FNA,(T4) ; IN THE FIELD
MOVSI T4,(POINT 7,) ;MAKE T4= BYTE PTR TO OUTPUT STRING
HRR T4,T1
;FIRST STORE DEVICE NAME
HRRZ T1,F.WDNM(FT) ;GET ADDR OF DEVICE NAME
HRLI T1,(POINT 6,) ;MAKE BYTE PTR TO IT
MOVEI T2,6 ;MAXIMUM OF 6 CHARACTERS
PICKF0: ILDB C,T1 ;GET A CHAR OF DEVICE NAME
JUMPE C,PICKF1 ;NULL IS DONE
ADDI C,40 ;MAKE IT ASCII
IDPB C,T4 ;STORE ON STRING
SOJG T2,PICKF0 ;.. FOR ALL CHARS IN DEVICE NAME
PICKF1: MOVEI C,":" ;COLON TO DELIMIT DEVICE NAME
IDPB C,T4 ;PUT THAT ON STRING
IFN TOPS20,<
;CHECK FOR USER-NUMBER, IF HE SUPPLIED ONE,
; TRANSLATE TO DIRECTORY STRING OVERWRITING
; THE DEVICE NAME IN ASCII STRING.
LDB T1,FT.PPN ;T1= ADDRESS OF USER-NUMBER
JUMPE T1,PCKF1A ;JUMP IF NO USER-NUMBER
MOVE T2,T4 ;PUT NULL ON END OF DEVICE STRING
SETZ T3,
IDPB T3,T2
MOVE T2,(T1) ;FETCH PPN
MOVEI T1,.RCFNM(FTL) ;POINT TO FILENAME
HRLI T1,(POINT 7,)
MOVE T3,T1 ;FROM..
PPNST% ;TRANSLATE PPN TO STRING..
ERJMP PCKF1B ;ERROR
MOVE T4,T1 ;GET UPDATED PTR
PCKF1A:
>;END IFN TOPS20
;NOW THE FILE NAME
MOVE T1,F.WVID(FT) ;T1:=BYTE PTR TO VALUE OF ID
LDB T2,[POINT 6,T1,11] ;T2= BYTE SIZE
;OLD STYLE (BEFORE V13) VID IS 9 CHARS LONG.
MOVEI T3,6 ;GET SIX CHARS OF NAME
PICKF2: ILDB C,T1 ;GET A CHAR
CAIN T2,SIXSIZ ;SIXBIT?
ADDI C,40 ;YES, CONVERT TO ASCIZ
CAIN T2,EBCSIZ ;EBCDIC
LDB C,PTR.97## ; YES, CONVERT TO ASCII
CAIG C," " ;SPACE OR NULL OR CONTROL CHAR?
JRST PICKF3 ;YES, THAT'S THE END
IDPB C,T4 ;STORE IN PTR
SOJN T3,PICKF2
PICKF3: MOVEI C,"." ;TO DELIMIT FILE NAME
IDPB C,T4
SOJLE T3,.+3 ;SKIP BLANKS TO EXTENSION
IBP T1
JRST .-2
MOVEI T3,3 ;3 CHARS OF EXTENSION
PICKF4: ILDB C,T1
CAIN T2,SIXSIZ ;SIXBIT?
ADDI C,40 ;YES, CONVERT TO ASCII
CAIN T2,EBCSIZ ;EBCDIC?
LDB C,PTR.97## ; YES, CONVERT TO ASCII
CAIN C," " ;DONE EXT?
JRST PICKF5 ;YES
IDPB C,T4 ;STORE IN PTR
SOJN T3,PICKF4 ;LOOP
PICKF5:
IFE TOPS20,<
;APPEND USER-NUMBER AS A [P,PN] IF GIVEN
LDB T1,FT.PPN ;T1= ADDRESS OF USER-NUMBER
JUMPE T1,PCKF5D ;HE DIDN'T SUPPLY ONE
MOVEI T2,"[" ;START PPN
IDPB T2,T4
HLRZ T1,(T1) ;GET PROJECT NUMBER
PUSHJ PP,T4OCT ;APPEND TO T4 THE OCTAL NUMBER
MOVEI T2,"," ;TO SEPARATE PROJ AND PROG
IDPB T2,T4
LDB T1,FT.PPN ;GET ADDR OF PPN AGAIN
HRRZ T1,(T1) ;GET PROGRAMMER NUMBER
PUSHJ PP,T4OCT ;APPEND TO STRING
MOVEI T2,"]" ;TO END PPN
IDPB T2,T4
PCKF5D:
>;END IFE TOPS20
SETZ C, ;NULL TO END STRING
IDPB C,T4
JRST CPOPJ1 ;DONE, RETURN SUCCESSFUL
IFE TOPS20,<
;APPEND OCTAL NUMBER IN T1 TO STRING IN T4
T4OCT: IDIVI T1,8 ;DIVIDE BY RADIX
HRLM T2,(PP) ;STORE DIGIT
SKIPE T1 ;ALL DONE?
PUSHJ PP,T4OCT ;NO, RECURSE
HLRZ T1,(PP) ;GET BACK DIGIT
ADDI T1,"0" ;MAKE ASCII
IDPB T1,T4 ;STORE
POPJ PP, ;UNWIND
> ;END IFE TOPS20
;HERE IF ERROR TRYING TO TRANSLATE PPN
IFN TOPS20,<
PCKF1B: MOVEI T1,.FHSLF ;GET JSYS ERROR
GETER%
MOVEM T2,ER.JSE ;SAVE JSYS ERROR MNENOMIC
;GIVE "FILE-NOT-FOUND" LIBOL ERROR
$ERROR (E.508,SV.FAT,MT.FIL!MT.JSE,CPOPJ)
>;END IFN TOPS20
SUBTTL CL.MIX - CLOSE RMS INDEXED FILE
;ARGLIST: FLAG-BITS,,FILTAB-ADDR
;
; WHERE FLAG-BITS ARE:
CLS%CF==1B12 ;CLOSE FILE = 0
CLS%LK==1B13 ;LOCK, LOCKED FILES MAY NOT BE REOPENED
CLS%DL==1B14 ;CLOSE WITH DELETE
;THE FOLLOWING ARE NOT SUPPORTED:
; END-OF-FILE LABEL, END-OF-VOLUME LABEL, BEGINNING-OF-VOLUME LABEL,
; CLOSE REEL, NO REWIND, UNLOAD.
CL.MIX: PUSHJ PP,SETIO ;SETUP FOR IO
;IF WE ARE DEALING WITH AN OPTIONAL FILE WHICH WAS NOT PRESENT, WE MERELY
; UNSET THE NOTPRS BIT AND RETURN. THE FILE WAS NEVER ACTUALLY OPENED
; SUCCESSFULLY AND THE ALLOCATED CORE HAD ALL BEEN RETURNED.
MOVE T1,F.WFLG(FT) ;FIND OUT IF THE NOTPRS BIT IS ON
TLNN T1,NOTPRS ;
JRST CL.MX1 ;NO
TLZ T1,NOTPRS ;TURN OFF THE BIT
MOVEM T1,F.WFLG(FT) ;AND UPDATE THE FILE TABLE FLAG WORD
POPJ PP, ; AND RETURN
CL.MX1:
TXNE FLG,LF%INP+LF%OUT ;SKIP IF FILE WAS NOT OPEN
JRST CL.MX4 ;CONTINUE WITH NORMAL CLOSE
SKIPN F.WSMU(FT) ;IF FILE NOT OPEN AND SMU OPTION 1, SMU OPEN
; FAILED AND WE ARE JUST SHUTTING DOWN.
; NO NEED TO BOMB OUT USER.
JRST CLMER1 ;NO, GIVE ERROR
POPJ PP, ;YES, RETURN TO CALLING ROUTINE
CL.MX4:
TXNE FLG,CLS%LK ;CLOSE WITH LOCK?
PUSHJ PP,[SETO T1, ;YES, SET THE FLAG
DPB T1,FT.BLF
POPJ PP,] ;CONTINUE CLOSE CODE
LDB T1,FT.ABL ;APPLY BASIC-LOCKING IN EFFECT?
;IF SO, WE ARE NOT GOING THRU SU.CL IN LSU
JUMPN T1,CL.MX2 ;JUMP IF SO.
SKIPN F.WSMU(FT) ;FILE OPEN FOR LSU-STYLE SMU?
JRST CL.MX2 ; NO
PUSH PP,FT ;SAVE FT FTL AND FLG, WHICH GET SMASHED
PUSH PP,FTL ;
PUSH PP,FLG ; BY SU.CL
MOVEM FT,ARG ;WHERE SU.CL EXPECTS TO FIND IT
PUSHJ PP,SU.CL## ;
POP PP,FLG ;RESTORE FLG FTL AND FT
POP PP,FTL ;
POP PP,FT ;
CL.MX2:
;HERE IF OK TO CLOSE FILE
MOVE T2,.RCFAB(FTL) ;T2 POINTS TO FAB
REPEAT 0,< ;DISABLE ASCII STREAM
;CHECK HERE FOR ASCII STREAM NEEDING FUNNY FINAL <CR>
$FETCH T1,RFM,(T2) ;GET RECORD FORMAT FROM FAB
CAIE T1,FB$STM ;IS IT ASCII STREAM?
JRST CL.MX3 ; NO
LDB T1,FT.NOC ;GET FUNNY <CR> FLAG
CAIE T1,0 ;IS IT ON?
PUSHJ PP,WTS.CR ; YES, PUT OUT FINAL FUNNY <CR>
CL.MX3:
MOVE T2,.RCFAB(FTL) ;MAKE SURE THAT T2 POINTS TO THE FAB
;(MAY HAVE BEEN ZAPPED BY WRITING FUNNY <CR>.)
> ;END REPEAT 0
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$CLOSE <(T2)>,RCLSER ;** CLOSE THE FILE **
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
TXNN FLG,CLS%DL ;CLOSE WITH DELETE?
JRST CL.AFT ;NO
MOVE T2,.RCFAB(FTL) ;T2 POINTS TO FAB
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$ERASE <(T2)>,RCLSER ;** DELETE THE FILE **
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
;CLOSE WAS SUCCESSFUL. RELEASE THE CORE.
CL.AFT:
SETZM D.JFN(FT) ;CLEAR JFN FIELD IN FILE TABLE
PUSHJ PP,ROPCOR ;[1073] * RELEASE CORE FROM OPEN *
PJRST SETFS ;SET FILE-STATUS TO 00, RETURN TO USER
;CLOSE WAS UNSUCCESSFUL. REPORT THE ERROR
;** NOTE: IF THIS IS CHANGED TO RECOVER, WE MUST CHANGE FILE'S
; STATE TO BE "UNF" (UNLESS IT WAS "ATE": THEN IT REMAINS "ATE")
RCLSER: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
TYPE [ASCIZ/
?COBLIB: Failed to Close RMS File
/]
JRST RSFAIF ;RMS-SYSTEM FAILURE
;FILE WAS NOT OPEN
CLMER1:
MOVEI T0,FS%30 ;CATCH ALL FILE-STATUS
SKIPGE WANT8. ;WANT ANS 8X FUNCT?
MOVEI T0,FS%42 ;MOVE FILE-STATUS FILE-NOT-OPEN
MOVEM T0,FS.FS ; AND SAVE IT
PUSHJ PP,SETFS ; AND MOVE IT TO USER'S FS FIELD
$ERROR (E.512,SV.KIL,MT.FIL) ;FILE WAS NOT OPEN
;ROPCOR routine: Release core obtained at OPEN time
;This is called by OPEN (incase errors happen) or CLOSE (normal case)
;with FTL and FT set up. This routine gets rid of the FTL block.
;If the core cannot be released, this causes a fatal LIBOL error,
; else it will return .+1
ROPCOR: MOVEM FTL,FUN.A1## ;ARG1= ADDRESS
MOVE T1,.RCMEM(FTL) ;ARG2= SIZE
MOVEM T1,FUN.A2## ; OF BLOCK TO RETURN
MOVEI ARG,1+[-5,,0
XWD 0,FUN.A0##
XWD 0,[ASCIZ/LBL/]
XWD 0,FUN.ST##
XWD 0,FUN.A1##
XWD 0,FUN.A2##]
MOVEI T1,F.RAD ;FUNCTION WE WANT
MOVEM T1,FUN.A0## ;STORE FUNCTION
SETZM FUN.ST## ;CLEAR STATUS
PUSHJ PP,FUNCT.## ;CALL FUNCT. ROUTINE
SETZM D.RMSP(FT) ;CLEAR POINTER TO THE RMS CONTROL BLOCK
SKIPE T1,FUN.ST ;STATUS NON-ZERO?
JRST CRCOR ;?CAN'T RELEASE CORE
TXZ FLG,LF%INP+LF%OUT+LF%IO ;NOT OPENED ANY MORE
TXZ FLG,CF%CNV+LF%FNA ;CLEAR TEMP FLAGS
HRRM FLG,D.F1(FT) ;SAVE UPDATED FLAGS
POPJ PP, ;RETURN
CRCOR: TYPE [ASCIZ/
?COBLIB: Couldn't release core from the RMS OPEN
/]
JRST RSFAI2 ;*** FIX ***
SUBTTL RMS WRITE ENTRY POINTS
;ARG FORMAT:
;ARG-ADDR: FLAG-BITS,,FILTAB-ADDR
; WRT-REC-LENGTH,,KEY-BUFFER-ADDRESS
;
;FLAGS-BITS:
WT%SEQ==1B9 ;SEQUENTIAL ACCESS MODE
WT%NIK==1B11 ;NO "INVALID KEY" CLAUSE GIVEN
; "USE PROCEDURE" INSTEAD
WT%VLR==1B19 ;WRITE SEQ VAR LEN REC.
;HERE WHEN THE ACCESS MODE OF THE FILE IS RANDOM OR DYNAMIC
WT.MIR: PUSHJ PP,WTSET ;SETUP TO DO "WRITE"
MOVE T2,.RCRAB(FTL) ;POINT TO THE RAB FOR THIS FILE
MOVEI T1,RB$KEY ;SIGNAL KEYED ACCESS
$STORE T1,RAC,(T2) ; FOR RANDOM READ
;ADDRESS OF RECORD WAS ALREADY STORED BY "OPEN".
;STORE SIZE OF RECORD
WRTMI1: MOVE T1,BS.AGL ;SIZE OF RECORD TO WRITE IS HERE
HLRZ T1,RECLNG(T1) ; IN THE ARG LIST
$STORE T1,RSZ,(T2)
;;;READY TO DO THE $PUT ;;;
WRTMI2: SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$PUT <(T2)>,PUTERR ;** DO THE PUT **
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
PUSHJ PP,CHKPT ;CHECK IF DOING CHECKPOINTING FOR INDEXED FILE
PUSHJ PP,CHKSDP ;CHECK FOR SUCCESSFUL RETURN, BUT DUPLICATE KEY
MOVE T1,FS.FS ;GET FILE STATUS
PUSHJ PP,RCLNUP ;AND GO DO FILE STATUS AND SMU OPTION 1 CHECKING
MOVE T1,FS.FS ;GET FILE STATUS AGAIN
CAIL T1,FS%10 ;SEE IF SOME KIND OF AT-END/INVALID KEY
CAILE T1,FS%29
TRNA ;YES, THERE IS
CPOPJ1: AOS (PP) ;GIVE SKIP RETURN - INVALID KEY
CPOPJ: POPJ PP, ;FOR "INVALID KEY"
; ANYBODY WHO USES THIS CODE WITHOUT ALSO
; USING FILE-STATUS HAS ROCKS IN HIS HEAD.
;DO CHECKPOINTING FOR INDEXED FILES IF REQUIRED
CHKPT:
MOVE T2,.RCRAB(FTL) ;[1020] RE-GET ADDRESS OF RAB
$FETCH T1,STS,(T2) ;[1020] GET STATUS CODE
CAIL T1,ER$AID - 1 ;[1020] A SUCCESS CODE?
JRST CKPTEX ;[1020] NO - BYPASS CKPT
LDB T0,FT.CRC ;[1020] CHECKPOINTING?
JUMPE T0,CKPTEX ;[1020] NO
SOSE D.CRC(FT) ;[1020] DECREMENT COUNT - TIME TO OUTPUT?
JRST CKPTEX ;[1020] NOT YET
MOVEM T0,D.CRC(FT) ;[1020] RESET COUNT
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$FLUSH <(T2)>,FSHERR ;[1020] WRITE REC TO DISK
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
CKPTEX:
POPJ PP, ;[1020] GIVE NORMAL RETURN
FSHERR: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
TYPE [ASCIZ/
?COBOTS $FLUSH failed for RMS Indexed File Checkpointing
/] ;[1020] RETURN ERROR MESSAGE
JRST RSFAIR ;[1020] RMS SYSTEM ERROR
;ERROR ON $PUT
PUTERR: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCRAB(FTL) ;ADDR OF THE RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
; CAIN T1,ER$CHG ;KEY CANNOT BE CHANGED?
; JRST PUTERC ;YES, GIVE ERROR
CAIN T1,ER$DUP ;DUPLICATE KEY?
JRST PUTERD ;YES
; CAIN T1,ER$REX ;RECORD ALREADY EXISTS?
; JRST PUTERD ;YES, "DUPLICATE KEY"
;NOTE: KEY OUT-OF-SEQUENCE ERROR NOT IN ANS82 COBOL DRAFT STANDARD
CAIN T1,ER$SEQ ;OUT OF SEQUENCE?
JRST SEQERR ;YES, RETURN STATUS
CAIN T1,ER$RLK ;RECORD LOCKED BY SOMEONE ELSE?
JRST PTLKER ; YES
CAIN T1,ER$FAC ;SMU OPEN DOES NOT ALLOW $PUT FOR SELF?
JRST PUTFAC ; YES
SKIPL WANT8. ;WANT ANS 8X FUNCT?
JRST PUTER1 ; NO
CAIN T1,ER$RSZ ;RECORD SIZE ERROR?
JRST PTRSZE ; YES
PUTER1: TYPE [ASCIZ/
?COBLIB: Failed to Write to RMS File
/]
JRST RSFAIR ;RMS SYSTEM ERROR
PTRSZE: MOVEI T1,FS%44 ;SET F-S CODE FOR WRONG-SIZE-RECORD
MOVEM T1,FS.FS ;
PUSHJ PP,SETFS ;
JRST RSFAIR ; AND GO TO PROCESS PROGRAM FAILURE FOR HARD I-O ERROR
PTLKER: MOVEI T1,FS%92 ;RECORD LOCKED, ERROR 92
JRST PUTERP
PUTFAC: MOVEI T1,FS%94 ;NOT SPEC'D ON SMU OPEN, ERROR 94
JRST PUTERP
PUTERD: MOVEI T1,FS%22 ;DUPLICATE KEY, ERROR 22
JRST PUTERP
SEQERR: MOVEI T1,FS%21 ;SEQUENCE ERROR, ERROR 21
; JRST PUTERP
PUTERP: MOVEM T1,FS.FS ;STORE IN FILE-STATUS WORD
PUSHJ PP,RCLNUP ;SET IT
POPJ PP, ;RETURN
;HERE WHEN THE ACCESS MODE OF THE FILE IS SEQUENTIAL
;CALLING SEQUENCE MOVEI 16,ADDRESS-OF-ARG-LIST
; PUSHJ 17,WT.MIS / WT.MSV
;ARG LIST
; FLAGS ,, FILE-TABLE-ADDRESS
; RECORD-LENGTH ,, UNUSED BY SEQUENTIAL
; ADV / POS PARMS ,, COUNT / ADDRESS FIELD
;
WT.MSV: ;SEQUENTIAL VAR LEN WRITE
PUSHJ PP,WTSET ;SET UP FOR WRITE VERB
TXO FLG,WT%VLR ;SET FLAG TO WRITE VARIABLE LEN REC
JRST WT.MI1 ; JOIN COMMON CODE FOR SEQ WRITE
WT.MIS: ;ALL OTHER SEQUENTIAL WRITES
PUSHJ PP,WTSET ;SET UP FOR WRITE VERB
WT.MI1:
;THIS HAS RETURNED IF FILE WAS OPEN FOR OUTPUT OR I-O.
; BUT ONLY "OUTPUT" IS ALLOWED WHEN ACCESS MODE IS SEQUENTIAL.
TXNE FLG,LF%IO ;SKIP IF NOT I-O
JRST WTMSE0 ;OPEN I-O, ILLEGAL
;THE STANDARD SAYS WE ARE SUPPOSED TO MAKE SURE THAT THE
; KEY BEING WRITTEN IS NOT LE THE LAST KEY THAT WAS WRITTEN,
; AND IF IT WAS, GIVE AN "INVALID KEY".
; LUCKILY, RMS RETURNS A UNIQUE ERROR CODE (ER$SEQ) FOR THIS CONDITION.
MOVE T2,.RCRAB(FTL) ;T2 POINTS TO THE RAB FOR THIS FILE
MOVEI T1,RB$SEQ ;SEQUENTIAL ACCESS
$STORE T1,RAC,(T2) ;STORE IT
;IF THE USER IS DOING SEQUENTIAL WRITES TO AN RMS RELATIVE FILE, WE ARE
;IGNORING ANY VALUE WHICH HE MAY HAVE PUT INTO THE KEY FIELD. INSTEAD,
;WE ARE TAKING THE BUCKET NUMBER RETURNED FROM THE PREVIOUS I-O VERB,
;WHATEVER THAT WAS, ADDING 1 TO IT AND USING THAT AS THE RELATIVE KEY
;VALUE OF THE NEXT RECORD ABOUT TO BE WRITTEN. THIS VALUE GOES INTO %PARAM
;FOR DISPLAY KEYS, AND THE CONVERSION ROUTINES IN THE GENERATED CODE
;WHICH FOLLOW THIS CALL CONVERT THE VALUE IN %PARAM BACK TO DISPLAY.
MOVE T1,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNN T1,RANFIL ;IS IT A RELATIVE FILE?
JRST WT.MS1 ;NO
$FETCH T0,BKT,(T2) ;GET THE BUCKET NO.
$FETCH T1,KBF,(T2) ;GET KEY BUFFER ADDRESS
MOVEM T0,KY.BUF(T1) ;MOVE THIS VALUE TO THE KEY BUFFER
WT.MS1:
MOVE T3,.RCFAB(FTL) ;GET ADDRESS OF FAB
$FETCH T0,RFM,(T3) ;GET ITS RECORD FORMAT
REPEAT 0,< ;DISABLE ASCII STREAM
CAIN T0,FB$STM ;IS FILE (ASCII) STREAM?
JRST WT.STM ;YES
> ; END REPEAT 0
JRST WRTMI1 ;NO, JOIN COMMON WRITE CODE
;"Attempt to WRITE indexed file / seq access mode not OPEN for OUTPUT"
WTMSE0: $ERROR (E.515,SV.KIL,MT.FIL)
REPEAT 0,< ;DISABLE ASCII STREAM
;THE FOLLOWING CODE WRITES OUT AN ASCII STREAM RECORD USING THE ANSI-74
;COBOL FORMAT. THERE ARE TWO MAJOR FORMS OF THE FORMAT AS SET FORTH IN
;THE STANDARD: (1) BEFORE ADVANCING, AND (2) AFTER ADVANCING / AFTER
; POSITIONING / THE DEFAULT CASE. THE AFTER ADVANCING ... CASE WORKS
; GENERALLY LIKE THIS: (A) PUT OUT <CR> IF NOT POSITIONING "+", (B)
; PUT OUT ANY REQUIRED VERTICAL POSITIONING STUFF, (C) PUT OUT USER
; RECORD, AND (D) SET FUNNY <CR> FLAG TO 1 TO INDICATE THAT THE CURRENT
; RECORD DOES NOT HAVE A <CR> FOLLOWING IT. THE BEFORE ADVANCING CASE
; WORKS GENERALLY LIKE THIS: (A) CHECK THE FUNNY <CR> FLAG AND IF IT
; IS ON, PUT OUT A <CR>, (B) SET THE FUNNY <CR> FLAG TO 0, (C) PUT
; OUT THE USER RECORD, (D) PUT OUT A <CR>, AND (E) PUT OUT THE VERTICAL
; POSITIONING STUFF. NOTE: IN DOING THE CODE BELOW I HAVE TRIED TO REPRO-
; DUCE THE EFFECT WHICH CBLIO DOES FOR NON-RMS FILES. HOWEVER, THE CODE
; IS ENTIRELY DIFFERENT BECAUSE MY ANALYSIS REVEALED THAT THERE ARE
; ACTUALLY TWO SEPARATE FLOWS, RATHER THAN JUST ONE. ONE FLOW IS FOR
; WRITE BEFORE ADVANCING, AND THE OTHER IS FOR WRITE AFTER ADVANCING /
; AFTER POSITIONING / DEFAULT.
;ALSO, THE FUNNY <CR> FLAG IS SET TO 0 AT OPEN TIME AND IS CHECKED AT
;CLOSE TIME. IF IT IS ON AT CLOSE TIME A FINAL FUNNY <CR> IS WRITTEN OUT.
WT.STM:
MOVE T1,BS.AGL ;GET THE ADV / POS PARAM WORD
MOVE T1,ADVPR2(T1) ;
TLNN T1,WDVBFR ;BEFORE ADVANCING?
JRST WT.AFT ; NO, AFTER
WT.BEF:
LDB T1,FT.NOC ;GET FLAG FOR WRITING FUNNY <CR>
CAIE T1,0 ;IS IT SET?
PUSHJ PP,WTS.CR ; YES, GO PUT OUT FUNNY <CR>
SETZ T1, ;ZERO IT OUT IN ANY EVENT
DPB T1,FT.NOC ; AND PUT IT BACK
PUSHJ PP,WTS.WT ;THEN WRITE OUT MAIN PART OF USER REC
PUSHJ PP,WTS.CR ;WRITE OUT REGULAR "AFTER ADV" <CR>
PUSHJ PP,WTS.VT ; AND WRITE OUT THE VERTICAL STUFF.
JRST WTS.EX ; THEN GO TO END
WT.AFT:
TLNN T1,WDVPOS ;TEST FOR BEFORE POSITIONING "+", WHICH
JRST WTAFT1 ; IS THE CASE IN WHICH ABSOLUTELY NO
; EOL / BOL CHARACTERS ARE INCLUDED.
LDB T0,PO.CHR ;GET THE POSITIONING CHARACTER
CAIN T0,"+" ;IF IT IS "+", DON'T PUT OUT <CR>
JRST WTAFT2
WTAFT1:
PUSHJ PP,WTS.CR ;
WTAFT2:
PUSHJ PP,WTS.VT ;PUT OUT THE VERTICAL POSITIONING STUFF
PUSHJ PP,WTS.WT ;THEN WRITE OUT MAIN PART OF USER REC
SETO T1, ;SET FUNNY <CR> FLAG. (WHEN THIS FLAG IS
; SET IT MEANS THAT THE RECORD JUST WRITTEN
; IS NOT FOLLOWED BY ANY END-OF-LINE CHAR.)
DPB T1,FT.NOC ; AND PUT IT BACK IN FILE TABLE
; JRST WTS.EX ; THEN GO TO THE END
WTS.EX:
POPJ PP, ;THE END -- RETURN TO CALLER
;ROUTINE TO WRITE A <CR> TO AN ASCII STREAM FILE
; THIS ROUTINE CHANGES THE RECORD BUFFER LOCATION TEMPORARILY TO THE
; LOCATION WHERE <CR> IS DEFINED AS A CONSTANT. ALSO, THE RECORD SIZE
; IS SET TO 1 FOR THIS OCCASION. AFTER THE $PUT IS DONE THE RECORD
; BUFFER LOCATION IS CHANGED BACK TO THE ORIGINAL LOCATION SPECIFIED
; AT FILE OPEN TIME.
WTS.CR:
MOVE T2,.RCRAB(FTL) ;GET ADDRESS OF RAB
$FETCH T1,RBF,(T2) ;GET RECORD'S BUFFER ADDRESS
PUSH PP,T1 ; AND SAVE IT ON THE STACK.
MOVEI T1,CRBUF ;ADDRESS OF CARRIAGE-RETURN BUFFER
$STORE T1,RBF,(T2) ;STORE IT IN RAB
MOVEI T1,1 ;REC SIZE 1
$STORE T1,RSZ,(T2) ;STORE IT IN RAB
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$PUT <(T2)>,PUTERR ;** DO THE PUT ** AND THEN PLOW RIGHT ON
;ALL ERRORS FOR THIS PUT THAT COME BACK
;SHOULD BE +1 RETURN
JFCL ;BUT PLAY SAFE FOR NOW BECAUSE PUTERR CAN
; RETURN +1 OR +2
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
POP PP,T1 ;GET RECORD'S BUFF ADDR FROM STACK
MOVE T2,.RCRAB(FTL) ;GET ADDRESS OF RAB
$STORE T1,RBF,(T2) ;STORE RECORD'S BUFFER ADDR BACK IN RAB
POPJ PP, ; AND RETURN TO USER.
;ROUTINE TO WRITE OUT USER RECORD TO AN ASCII STREAM FILE
; ASSUMES RECORD'S BUFFER ADDRESS IS THE SAME AS IT WAS AT OPEN TIME.
; HOWEVER, IT TAKES THE RECORD LENGTH FROM THE USER'S SECOND ARG WORD.
WTS.WT:
MOVE T2,.RCRAB(FTL) ;GET ADDRESS OF RAB
MOVE T1,BS.AGL ;SIZE OF RECORD TO WRITE IS HERE
HLRZ T1,ADVPR1(T1) ; IN THE ARG LIST
JUMPE T1,WTS.E0 ;WARN ON ZERO-LENGTH RECORD
$STORE T1,RSZ,(T2) ;PUT IT IN THE RAB
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$PUT <(T2)>,PUTERR ;** DO THE PUT ** AND THEN PLOW RIGHT ON
;ALL ERRORS FOR THIS PUT SHOULD BE +1 RETURN
JFCL ;BUT PLAY SAFE FOR NOW BECAUSE PUTERR CAN
; RETURN +1 OR +2
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
POPJ PP, ; AND RETURN TO USER.
;Attempt to write ASCII STREAM zero-length record, Ignored.
WTS.E0: $ERROR (E.527,SV.WRN,MT.FIL)
POPJ PP, ; AND RETURN
;ROUTINE TO WRITE VERTICAL POSITIONING STUFF TO AN ASCII STREAM FILE.
;THE PURPOSE OF THIS ROUTINE IS TO FIND OUT (1) WHICH ASCII PRINT CONTROL
; CHARACTER TO PUT INTO THE FILE AND (2) HOW MANY OF THEM.
; THERE ARE SEVERAL DIFERENT SITUATIONS WHICH HAVE TO BE HANDLED. (A)
; WRITE WITH ADVANCING, (B) WRITE WITH POSITIONING, AND (C) WRITE
; [DEFAULT] WHICH IS CONSIDERED TO BE WRITE AFTER ADVANCING 1. AS A
; RESULT, THE ROUTINE IS SOMEWHAT LONG.
;
;AT THE POINT WHEN THIS ROUTINE IS CALLED, IT HAS ALREADY BEEN DETERMINED
; THAT WE HAVE TO PUT OUT A VERTICAL POSITIONING CHARACTER AND THE QUES-
; TION OF AFTER / BEFORE ADVANCING ETC. HAS ALREADY BEEN TAKEN CARE OF
; AT THE HIGHER LEVEL. THIS PROBLEM IS RESOLVED BY LOOKING AT THE THIRD
; ARGUMENT WORD WHICH HAS BEEN PASSED TO THE CALLING ROUTINE. THIS WORD
; HAS THE FOLLOWING FIELDS OF INTEREST:
;
; (1) BITS 12 - 14 FLAGS
;
; 12 WDVADR VALUE IN RH OF WORD IS MOST LIKELY AN ADDRESS
; 13 WDVBFR WRITE BEFORE - OF NO CONCERN TO THIS ROUTINE
; 14 WDVPOS WRITE POSITIONING
;
; (2) BITS 15 - 17 PRINT CHANNEL CONTROL CHARACTER. (SEE WVTTBL
; IN DECLARATIONS AT TOP OF THIS FILE.)
;
; (3) RIGHT-HALF (BITS 18 - 35)
;
; IF WDVADR IS ON, IS ADDRESS OF DATA FIELD HOLDING COUNT
; OF CHARS TO BE PUT OUT, OR -1 FOR DEFAULT WRITE.
; IF WDVADR IS OFF, IS COUNT OF CHARACTERS TO BE WRITTEN.
; THIS COUNT CAN BE NOT = 1 FOR <LF> ONLY.
; IF IT IS NOT = 1, ONLY ONE CHAR AT A TIME WILL
; BE PUT OUT IN THE LOOP AT "WTSVPT" UNTIL ENOUGH
; CHARS HAVE BEEN SENT TO THE OUTPUT FILE.
;
;
; THE FOLLOWING AC'S ARE USED:
;
; T4 TO CONTAIN ADDR OF ARG LIST FROM BS.AGL
; T3 TO CONTAIN COUNT OF PRINT CONTROL CHARS TO PUT OUT
; T2 TO CONTAIN ADDRESS OF RAB
; T1 TO POINT TO PRINT CONTROL CHAR, AND ALSO TO MANI-
; PULATE RECORD'S BUFFER ADDRESS.
;
WTS.VT:
;A LITTLE HOUSEKEEPING TO PRESERVE THE RBF ADDRESS OF
; THE USER'S RECORD AND TO SET UP THE PROPER RSZ = 1
; FOR A VERTICAL CONTROL CHARACTER.
;
MOVE T2,.RCRAB(FTL) ;GET ADDRESS OF RAB
$FETCH T1,RBF,(T2) ;GET RECORD'S BUFFER ADDRESS
PUSH PP,T1 ; AND SAVE IT ON THE STACK.
MOVEI T1,1 ;REC SIZE 1
$STORE T1,RSZ,(T2) ;STORE IT IN RAB
;GET THIRD WORD OF ARG LIST AND DETERMINE ADVANCING OR
; POSITIONING
;
MOVE T4,BS.AGL ;GET ADDRESS OF ARG LIST
MOVE T4,ADVPR2(T4) ; GET THIRD WORD OF ARG LIST
TLNE T4,WDVPOS ;ARE WE DOING POSITIONING?
JRST WTSPOS ; YES
;DETERMINE IF RIGHT-HALF OF THIRD ARG WORD IS AN ADDRESS
; OR A COUNT OR THE DEFAULT CASE.
;
HRRZ T3,T4 ;GET RH OF 3RD ARG WORD - MAY BE COUNT
TLNN T4,WDVADR ;IS IT ADDRESS OR COUNT?
JRST WTSCHR ; IS COUNT
CAIE T3,DEFADV ;IS IT DEFAULT ADVANCING?
JRST WTSADR ; NO, IS ADDRESS
HRRZI T3,1 ;SET THE CHAR COUNT TO 1
JRST WTSCHR ;
WTSADR:
HRRZ T3,(T3) ;GET COUNT FROM ADDRESS, I.E. %TEMP
;NOW A SMALL PRELIMINARY TO GET THE REFERENCE TO THE
; PROPER CONTROL CHARACTER.
;HOWEVER, IF BOTH COUNT AND CHAR REF ARE 0, WE WANT
; NO VERTICAL SPACING.
;
WTSCHR:
LDB T1,CH.CHR ;GET ADVANCING CHANNEL CHAR
JUMPN T1,WTSTAB ; CHANNEL CHAR IS NOT 0
JUMPE T3,WTSRST ;IF COUNT IS 0, BYPASS VERT POSITIONING
JRST WTSTAB ; HOWEVER, IF NOT, ON TO ACCESS CHANNEL TABLE
WTSPOS:
;DO POSITIONING, WHICH HAS MORE DETAIL RELATING TO THE
; PRINT CONTROL CHARACTER.
;
HRRZI T3,1 ;ASSUME CHAR COUNT OF 1
MOVE T1,T4 ;GET IT IN T1 FOR THE BYTE POINTER
LDB T1,PO.CHR ;GET POSITIONING CHAR FROM 3RD ARG WORD
CAIL T1,"1" ;CHAR IN RANGE 1 THRU 8 ?
CAILE T1,"8" ;
JRST WTSPLS ; NO
TRZ T1,777770 ;STRIP OFF "ZONE" TO CONVERT TO BINARY
JRST WTSTAB ; AND ON TO CHANNEL CHAR TABLE
WTSPLS:
CAIN T1,"+" ;NO POSITIONING?
JRST WTSRST ; YES, NO FURTHER WORK TO DO. JUST PUT BACK
; RBF IN RAB AND RETURN TO CALLER.
CAIN T1,"0" ;AFTER POS 2?
HRRZI T3,2 ; YES
CAIN T1,"-" ;AFTER POS 3?
HRRZI T3,3 ; YES
SETZ T1, ;AND SPECIFY A <LF> TO CHAN CHAR TABLE
;AT THIS POINT THE TWO STREAMS, ADVANCING AND POSITIONING
; COME BACK TOGETHER. T1 CONTAINS THE NUMBER OF THE ENTRY
; THAT WE WANT IN THE PRINT CHANNEL TABLE. WE ADD THE
; ADDRESS OF THE TABLE TO THIS VALUE AND PASS IT ON TO
; THE RAB SO THAT RMS WILL KNOW WHERE TO FIND THE CHAR.
;
WTSTAB:
ADDI T1,WVTTBL ;ADD IN ADDR OF CHAN CHAR TABLE TO POINT
; TO PROPER CHAR.
$STORE T1,RBF,(T2) ;STORE ADDR OF CHAN CHAR IN RAB
;THIS LOOP PUTS OUT THE PROPER COUNT OF PRINT CONTROL
; CHARCTERS
;
WTSVPT:
MOVE T2,.RCRAB(FTL) ;GET ADDR OF RAB FOR $PUT CALL
PUSH PP,T3 ;SAVE COUNT AC ON STACK
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$PUT <(T2)>,PUTERR ;** DO THE PUT ** AND THEN PLOW RIGHT ON
;ALL ERRORS FOR THIS PUT THAT COME BACK
;SHOULD BE +1 RETURN
JFCL 0 ;BUT PLAY SAFE FOR NOW BECAUSE PUTERR CAN
; RETURN +1 OR +2
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
POP PP,T3 ;GET COUNT BACK
SOJG T3,WTSVPT ;GO BACK AND PUT ANOTHER CHAR IF NECESSARY
;FINALLY, WE RESTORE THE ADDRESS OF THE USER'S RECORD
; BUFFER TO THE RAB, AND RETURN TO THE CALLING ROUTINE.
;
WTSRST:
POP PP,T1 ;GET RECORD'S BUFF ADDR FROM STACK
MOVE T2,.RCRAB(FTL) ;GET ADDRESS OF RAB
$STORE T1,RBF,(T2) ;STORE RECORD'S BUFFER ADDR BACK IN RAB
POPJ PP, ;RETURN
> ;END REPEAT 0
;ROUTINE TO SETUP TO DO "WRITE"
; DOESN'T RETURN IF ERRORS
WTSET: PUSHJ PP,SETIO ;SETUP FOR IO
TXNN FLG,LF%OUT ;SKIP IF OPEN FOR OUTPUT FOR I-O
JRST WTSETE ;FILE NOT OPEN FOR OUTPUT OR I-O (OR EXTEND)
MOVE T1,.RCSTE(FTL) ;GET FILE'S STATE
CAIN T1,RC.SUR ;IF SUCCESSFUL READ WAS JUST DONE,
MOVEI T1,RC.UNF ; SET STATE TO "UNDEFINED"
MOVEM T1,.RCSTE(FTL) ;STORE NEW STATE
MOVE T2,.RCRAB(FTL) ;POINT TO RAB
SETZ T1, ;DON'T USE LOAD PERCENTAGE
MOVE T0,D.CRC(FT) ;[1020] IF TIME TO CHECKPOINT
CAIE T0,CKP.FL ;[1020] DON'T TURN ON WRITE BEHIND
TXO T1,RB$WBH ; AND WRITE BEHIND
$STORE T1,ROP,(T2) ; NEXT REC. PTR SHOULD BE UNAFFECTED.
TXNN FLG,CF%CNV ;SKIP IF CONVERSION REQUIRED
POPJ PP, ;NO, JUST RETURN
;COPY RECORD AREA TO BUFFER ADDRESS
;ENTER HERE FROM "RWST" CODE
COPRCB: MOVE T1,.RCBPR(FTL) ;FROM
MOVEM T1,CVPRM. ; SAVE PARAMETER
HRRZ T1,.RCCRB(FTL) ;TO
HRLI T1,440000 ;GET STARTING BP.
HRRZ T2,BS.AGL ;POINT TO BASE OF ARG LIST
HLRZ T2,RECLNG(T2) ;GET REC LENGTH
DPB T2,[POINT 12,T1,17] ;STORE LENGTH
MOVEM T1,CVPRM.+1 ; SAVE 2ND PARAMETER
PUSHJ PP,SVPACS ;SAVE ALL PERMANENT ACS
MOVEI ARG,CVPRM. ;POINT TO PARAMS
HLRZ T1,.RCCRS(FTL) ;CONVERT FROM RECORD
PUSHJ PP,(T1) ;CALL ROUTINE
POPJ PP, ;ALL OK, RETURN
;"Attempt to WRITE and file not open for OUTPUT"
WTSETE: SKIPL WANT8. ;WANT ANS 8X FUNCT?
JRST WTSTE1 ; NO
MOVEI T0,FS%48 ;SET F-S FOR NOT OPEN FOR OUTPUT OR EXTEND
MOVEM T0,FS.FS ; AND SAVE ASIDE
PUSHJ PP,SETFS ; AND PUT IN USER'S F-S FIELD
WTSTE1: $ERROR (E.513,SV.KIL,MT.FIL)
SUBTTL RMS READ ENTRY POINTS
;ARG FORMAT:
;ARG-ADDR: FLAG-BITS,,FILTAB-ADDR
; [XWD KEY# OF REF,,ADDR OF KEY BUFFER] ;IF RANDOM READ
; WHERE FLAG-BITS ARE:
RD%NXT==1B9 ;READ NEXT RECORD
RD%KYR==1B10 ;KEY REFERENCE SPECIFIED
RD%NER==1B11 ;NO ERROR RETURN - DO "USE" PROCEDURE
;RD.MIR: READ RANDOMLY
RD.MIR: PUSHJ PP,RDSET ;SETUP FOR READ
MOVE T2,.RCRAB(FTL) ;NEED RAB ADDR AND RKBSET DESTROYS IT
MOVE T0,F.WFLG(FT) ;GET COMPILER FLAGS
SKIPGE WANT8. ;WANT 8X FUNCT?
TLNN T0,NOTPRS ;OPTIONAL FILE NOT PRESENT?
JRST RD.MI4 ;NO
MOVEI T0,FS%25 ;SET UP OPT-NOT-PRES F-S CODE
MOVEM T0,FS.FS ;
AOS (PP) ;SET UP RETURN TO .+2
PJRST SETFS ; REPORT IT TO USER AND RETURN IMMEDIATELY
RD.MI4: TLNE T0,RANFIL ;READING RELATIVE FILE?
JRST RD.MI3 ;YES, SKIP INDEX FILE STUFF
TXNE FLG,CF%CNV ;IF CONVERSION REQUIRED,
PUSHJ PP,RKBSET ;SETUP KEY BUFFER
;LOOKS GOOD. DO AN INDEXED-FILE RANDOM READ.
MOVE T2,.RCRAB(FTL) ;POINT TO RAB
;SET KEY BUFFER ADDRESS
HRRZ T1,BS.AGL ;GET BASE OF ARG LIST
HRRZ T1,KYINFO(T1) ; FETCH ADDRESS OF KEY BUFFER
TXNE FLG,CF%CNV ;UNLESS CONVERSION REQUIRED,
HRRZ T1,.RCCKB(FTL) ; THEN GET CONVERTED KEY BUFFER
$STORE T1,KBF,(T2) ; TELL RMS WHERE KEY IS
;SET "KEY OF REFERENCE"
SETZ T1, ;ASSUME PRIMARY KEY
TXNN FLG,RD%KYR ;WAS ANY SPECIFIED?
JRST RD.MI2 ;NO, USE 0
HRRZ T1,BS.AGL ;GET BASE OF ARG LIST
HLRZ T1,KYINFO(T1) ;GET T1= WHICH KEY
RD.MI2: $STORE T1,KRF,(T2) ;STORE "KEY OF REFERENCE"
MOVEM T1,.RCKRF(FTL) ;AND REMEMBER WHICH KEY IT IS
;SET "KEY BUFFER SIZE"
HRRZ T3,.RCKIN(FTL) ;POINT TO KEY INFO
LSH T1,1 ;EACH IS TWO WORDS LONG
ADDI T3,KYINFO(T1) ;POINT TO APPROPRIATE KEY-INFO BLOCK
HRRZ T1,KY.BUF(T3) ;GET KEY SIZE
$STORE T1,KSZ,(T2) ;STORE SIZE OF KEY BLOCK
;SET "USER BUFFER SIZE"
RD.MI3:
MOVE T1,.RCRLN(FTL) ;GET RECORD LENGTH IN WORDS
$STORE T1,USZ,(T2)
;SET "ACCESS MODE = RANDOM"
MOVEI T1,RB$KEY ;KEYED ACCESS
$STORE T1,RAC,(T2)
;SET RECORD OPTIONS TO JUST "SET NEXT REC PTR", BUT NOT FOR RELATIVE FILES
SETZ T1, ;CLEAR AN AC
;;;;; THE FOLLOWING EXCEPTION REMOVED BY RMS EDIT 303
;;;;; TLNN T0,RANFIL ;SKIP IF DOING RELATIVE FILE
MOVEI T1,RB$NRP
$STORE T1,ROP,(T2)
;;;; ALL READY TO DO THE $GET ;;;
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$GET <(T2)>,RDRERR ;DO IT
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
PUSHJ PP,CHKSDP ;CHECK FOR ALLOWABLE DUPL KEY FOUND
MOVE T1,FS.FS ;GET FILE-STATUS
PUSHJ PP,RCLNUP ;SET FILE-STATUS
MOVE T1,FS.FS ;GET FILE-STATUS AGAIN
JUMPE T1,RDDOK ;OK
CAIN T1,FS%23 ;INVALID KEY?
AOS (PP) ;YES, RETURN .+2
POPJ PP, ;RETURN
;HERE IF THE $GET WAS SUCCESSFUL. WE WILL RETURN .+1 TO USER,
; AFTER CONVERTING THE RECORD BACK TO THE INTERNAL MODE.
RDDOK:
TXNE FLG,CF%CNV ;IF CONVERSION REQUIRED,
PUSHJ PP,RDCVB ; GO DO IT
MOVEI T1,RC.SUR ;SUCCESSFUL READ JUST DONE.
MOVEM T1,.RCSTE(FTL) ;SAVE STATE
;RETURN # OF CHARACTERS READ
MOVE T2,.RCRAB(FTL) ;POINT TO RAB
$FETCH T1,RSZ,(T2) ;GET # CHARACTERS READ
MOVEM T1,D.CLRR(FT) ;[V12B] STORE IN FILE TABLE
POPJ PP, ;RETURN .+1 TO USER
;RANDOM READ FAILED
RDRERR: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
; MOVE T1,.RCSTE(FTL) ;GET STATE OF FILE
; CAIN T1,RC.SUR ; "SUCCESSFUL READ DONE"?
; MOVEI T1,RC.UNF ;NOT ANY MORE!
; MOVEM T1,.RCSTE(FTL) ;SAVE NEW STATE
MOVE T2,.RCRAB(FTL) ;ADDR OF THE RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIN T1,ER$RNF ;RECORD NOT FOUND?
JRST RDRIVK ;YES, RETURN "INVALID KEY"
SKIPL WANT8. ;WANT 8X FUNCT?
JRST RDRER1 ; NO
CAIN T1,ER$RTB ;RECORD TOO BIG?
JRST RDRRTB ; YES
;IF WE COME THRU HERE, WE HAVE A HARD READ FAILURE
RDRER1: MOVEI T1,RC.FAI ;READ-FAILED CODE
MOVEM T1,.RCSTE(FTL) ;SAVE IT IN RMS FILE STATE FLAG WORD
CAIN T1,ER$RLK ;RECORD LOCKED?
JRST RDLKER ; YES - WANT NORMAL RETURN WITH FILE-STATUS 92
TYPE [ASCIZ/
?COBLIB: Failed to Read from RMS File
/]
JRST RSFAIR ;RMS-SYSTEM FAILURE
RDRRTB: MOVEI T0,FS%04 ;SET UP FILE-STATUS CODE FOR RECORD TOO BIG
MOVEM T0,FS.FS ; AND SAVE IT
JRST RFSRPT ; AND HOP OVER F-S 23 TO REPORT F-S TO USER
RDRIVK: MOVEI T1,RC.INV ;FLAG INVALID KEY READ RESULT
MOVEM T1,.RCSTE(FTL) ; AND SAVE IT IN RMS FILE FLAG WORD
MOVEI T1,FS%23 ;FILE STATUS TO SET
MOVEM T1,FS.FS ;PUT HERE
RFSRPT: PUSHJ PP,RCLNUP ;SET THE STATUS
TXNE FLG,RD%NER ;NO INVALID KEY CLAUSE PROVIDED?
PUSHJ PP,SETEFS ; YEAH, GO SET THE ERROR-STATUS VARIABLES
POPJ PP,
;RD.MIS: READ SEQUENTIALLY
RD.MIS: PUSHJ PP,RDSET ;SETUP FOR READ
;GIVE ERROR IF FILE IS ALREADY "AT END"
MOVE T1,.RCSTE(FTL) ;GET STATE OF FILE
CAIL T1,RC.ATE ; IF "AT END",
JRST RDMSE1 ;GIVE ERROR
;TEST IF OPTIONAL FILE KNOWN NOT TO BE PRESENT AT OPEN TIME.
MOVE T1,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNN T1,NOTPRS ;OPTIONAL FILE WHICH IS NOT PRESENT?
JRST RD.MS4 ;NO
PUSHJ PP,RDEOF ;YES, GO SET EOF ON FIRST TIME THRU
JRST RD.MS2 ;AND GO TO TAKE "AT END" PATH
RD.MS4:
;LOOKS GOOD. DO AN INDEXED-FILE SEQUENTIAL READ.
MOVE T2,.RCRAB(FTL) ;POINT TO RAB, NEED IT BELOW
MOVE T1,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNN T1,SEQFIL ;READING SEQUENTIAL FILE?
TLNE T1,RANFIL ;READING RELATIVE FILE?
JRST RD.MS1 ;YES, DON'T SET UP KEY OF REFERENCE
;SET THE CURRENT KEY OF REFERENCE
MOVE T1,.RCKRF(FTL) ;THIS IS USUALLY 0 FOR PRIMARY KEY
$STORE T1,KRF,(T2)
;SET RECORD BUFFER ADDRESS
RD.MS1:
HRRZ T1,F.RREC(FT) ;POINT TO RECORD
TXNE FLG,CF%CNV ;UNLESS CONVERSION REQUIRED,
HRRZ T1,.RCCRB(FTL) ;THEN READ RECORD INTO INTERMEDIATE BUFFER
$STORE T1,UBF,(T2) ;TELL RMS WHERE RECORD AREA IS
;SET "USER BUFFER SIZE"
MOVE T1,.RCRLN(FTL) ;GET RECORD LENGTH
$STORE T1,USZ,(T2)
;SET "ACCESS MODE = SEQUENTIAL"
MOVEI T1,RB$SEQ ;SEQUENTIAL ACCESS
$STORE T1,RAC,(T2)
;SET "READ AHEAD" BIT , GAMBLING THAT THE USER WILL BE PROCESSING
; THE FILE SEQUENTIALLY FOR A WHILE
MOVEI T1,RB$RAH ;READ AHEAD
;ALSO CHECK FOR ASCII STREAM AND PAD WITH BINARY ZEROES ON READ.
;THUS, THE RETURNED RECORD LOOKS LIKE ASCIZ AND COBOL DISPLAY DOES THE
; RIGHT THING WITH IT.
MOVE T0,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNN T0,SEQFIL ;IS FILE SEQUENTIAL?
JRST RD.MS3 ;NO
MOVE T4,.RCFAB(FTL) ;GET ADDRESS OF FAB IN ORDER TO
$FETCH T3,BSZ,(T4) ; FIND THE BYTE SIZE
CAIE T3,ASCSIZ ;IF IT IS 7-BIT BYTES, WE WILL
; SET UP ASCII NULL AS PAD CHAR
;(I DON'T LIKE TO LEAVE THINGS TO CHANCE)
JRST RD.MS3 ;NO
MOVEI T0,0 ;YES -- SET UP PAD
$STORE T0,PAD,(T2) ; AND STORE IN RAB
IORI T1,RB$PAD ;AND SET FLAG IN ROP FLD OF RAB.
RD.MS3:
$STORE T1,ROP,(T2)
;;;; ALL READY TO DO THE $GET ;;;
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$GET <(T2)>,RDSERR ;DO IT
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
;FOR RELATIVE FILES
;IF $GET COMES BACK NORMALLY, WE HAVE TO MAKE SURE THAT THE KEY FIELD IS
;PROPERLY UPDATED. IF THE KEY FIELD IS COMP, IT IS IN THE USER RECORD BUFFER.
;HOWEVER, IF IT IS DISPLAY, A SEPARATE COMP KEY FIELD IS SET UP IN %PARAM.
;THE %PARAM FIELD MUST BE UPDATED HERE. HOWEVER, IT IS EASIER ALWAYS TO DO
;THE UPDATE HERE THAN TO DO THE CHECKING FOR WHETHER THE KEY FIELD IS IN
;%PARAM. FOR A COMP KEY FIELD THE EFFECT IS SIMPLY TO MOVE THE FIELD TO ITSELF.
MOVE T1,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNN T1,RANFIL ;RELATIVE FILE?
JRST RD.MS2 ;NO
MOVE T2,.RCRAB(FTL) ;GET ADDR OF RAB
$FETCH T0,BKT,(T2) ;GET THE CURRENT BUCKET NUMBER
$FETCH T1,KBF,(T2) ;GET THE ADDR OF THE KEY BUFFER
MOVEM T0,KY.BUF(T1) ;PUT THE KEY VALUE IN THE KEY BUFFER
SKIPN F.WSMU(FT) ;DOING SMU OPTION 1?
JRST RD.MS2 ; NO
MOVE T1,SU.T1## ;GET ADDR OF RRT ENTRY
MOVEM T0,RRTKEY(T1) ; AND PUT KEY VALUE THERE TOO
RD.MS2:
;NOW CHECK FILE STATUS STUFF.
PUSHJ PP,CHKSDP ;CHECK FOR ALLOWABLE DUPL KEY FOUND
MOVE T1,FS.FS ;GET FILE-STATUS NOW
PUSHJ PP,RCLNUP ; AND SET IT
MOVE T1,FS.FS ;GET FILE-STATUS AGAIN
JUMPE T1,RDDOK ;JUMP TO CONVERT BACK IF NECESSARY
CAIN T1,FS%10 ; AT END?
AOS (PP) ;YES, TAKE "AT END" PATH
POPJ PP, ;.. OR RETURN SUCCESS
;READ IN SEQUENTIAL MODE FAILED. THIS SHOULD ONLY HAPPEN ON EOF.
RDSERR: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCRAB(FTL) ;GET ADDRESS OF RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIN T1,ER$EOF ;END OF FILE REACHED?
JRST RDEOF ;YES
CAIN T1,ER$RTB ;RECORD IN FILE > RECORD DEFINED IN PROGRAM?
JRST RDSRTB ;YES
MOVEI T0,RC.FAI ;ANYTHING GOING THRU HERE IS A HARD READ FAILURE
MOVEM T0,.RCSTE(FTL) ;SAVE NEW STATE
CAIN T1,ER$RLK ;RECORD LOCKED?
JRST RDLKER ; YES - WANT NORMAL RETURN WITH FILE-STATUS 92
TYPE [ASCIZ/
?COBLIB: Sequential Read of RMS File failed
/]
JRST RSFAIR ;RMS-SYSTEM FAILURE
RDSRTB: $ERROR (E.533,SV.KIL,MT.FIL) ;
RDEOF:
MOVEI T1,FS%10 ;SET FILE STATUS TO SHOW EOF
SKIPL WANT8. ;WANT 8X FUNCT?
JRST RDEOF1 ; NO
MOVE T0,F.WFLG(FT) ;GET FILE TABLE FLAG WORD AGAIN
TLNE T0,NOTPRS ; IS FILE PRESENT?
MOVEI T1,FS%15 ; NO, SET EOF F-S CODE
RDEOF1: MOVEM T1,FS.FS ;SET UP THE STATUS WORD
PUSHJ PP,RCLNUP ;STORE INTO USER VARIABLE, IF ANY
TXNE FLG,RD%NER ;SKIP IF "AT END" CLAUSE PROVIDED
PUSHJ PP,SETEFS ;GO SET THE ERROR-STATUS VARIABLES
MOVEI T1,RC.ATE ;"FILE IS AT END"
MOVEM T1,.RCSTE(FTL) ;SAVE STATE
POPJ PP, ;RETURN TO RMS
;HAVE RMS ERROR RETURN SAYING RECORD IS LOCKED. THIS IS A NON-FATAL RETURN
;MESSAGE. JUST SET FILE-STATUS-1 TO 92 AND DO NORMAL RETURN TO USER. USER
;CAN THEN TEST FILE-STATUS-1 IN THE NEXT SENTENCE AND IF HE GETS A 92 AT
;THAT POINT, HE CAN BRANCH APPROPRIATELY.
RDLKER: MOVEI T1,FS%92 ;SET ERROR CODE 92 TO BE PUT INTO FILE-STATUS-1
; JRST RDSERP
;SET FILE-STATUS-1 AND RETURN TO CODE FOLLOWING THE $GET.
;THAT CODE WILL DO A NON-SKIP RETURN BACK TO THE USER.
RDSERP: MOVEM T1,FS.FS
PUSHJ PP,RCLNUP
POPJ PP,
;ERROR: ATTEMPT TO READ SEQUENTIALLY, BUT FILE IS ALREADY AT END
RDMSE1: SKIPL WANT8. ;WANT 8X FUNCT?
JRST RDMSE2 ; NO
MOVEI T1,FS%16 ;SET UP F-S FOR ATTEMPTED READ AFTER EOF
MOVE T0,.RCSTE(FTL) ;GET RMS FILE STATE WORD
CAIE T0,RC.ATE ;FILE ALREADY IN AT-END STATE?
MOVEI T1,FS%46 ; NO, SET BAD-READ-PRECEDES F-S CODE
MOVEM T1,FS.FS ; AND SAVE IT ASIDE
PUSHJ PP,SETFS ; AND REPORT IT TO USER
RDMSE2: $ERROR (E.518,SV.KIL,MT.FIL)
SUBTTL READ- SETUP ROUTINES
RDSET: PUSHJ PP,SETIO ;SETUP FOR DOING I-O
MOVE T1,F.WFLG(FT) ;IS THIS AN OPTIONAL FILE WHICH IS
TLNE T1,NOTPRS ; NOT PRESENT?
POPJ PP, ;YES - RETURN IMMEDIATELY.
;
SKIPE T1,F.WSMU(FT) ;TEST FOR SMU OPTION 1 OPEN
POPJ PP, ;IF IT IS, WE DID OPEN FOR I-O AND THE
; F.WSMU WORD IS NON-ZERO
;
TXNN FLG,LF%INP ;SKIP IF OPEN FOR INPUT
JRST RDSTE1 ;NO--GIVE ERROR
POPJ PP, ;DONE, RETURN
;FILE WAS NOT OPEN FOR INPUT
RDSTE1: SKIPL WANT8. ;WANT ANS 8X FUNCT?
JRST RDSTE2 ; NO
MOVEI T0,FS%47 ;SET UP F-S FOR FILE NOT OPEN FOR INPUT OR I-O
MOVEM T0,FS.FS ; AND SAVE IT ASIDE
PUSHJ PP,SETFS ; AND PUT IT IN USER'S F-S FIELD
RDSTE2: $ERROR (E.505,SV.KIL,MT.FIL)
SUBTTL READ- RECORD CONVERSION ROUTINE
;COPY RECORD READ FROM CONVERTED BUFFER TO REAL BUFFER
RDCVB: MOVE T1,F.WFLG(FT) ;GET FT FLAGS
;** CHANGE IN V13:
LDB T1,[POINT 2,T1,2] ;GET DEVICE DATA MODE
HRL T2,[(POINT 7,)
(POINT 9,)
(POINT 6,)](T1) ;GET PART OF B.P.
HRR T2,.RCCRB(FTL) ;GET ADDRESS PART
MOVEM T2,CVPRM. ;;SAVE 1ST PARAMETER
MOVE T2,.RCBPR(FTL) ;START 2ND PARAMTER - BP TO RECORD
LDB T1,FT.MRS ;GET MAXIMUM RECORD SIZE
DPB T1,[POINT 12,T2,17] ;STORE IN PARAM
MOVEM T2,CVPRM.+1 ;STORE 2ND PARAMETER
PUSHJ PP,SVPACS ;SAVE PERM ACS
MOVEI ARG,CVPRM. ;POINT TO PARAMS
HRRZ T1,.RCCRS(FTL) ;GET ROUTINE TO CONVERT TO RECORD
PUSHJ PP,(T1) ;CALL IT
POPJ PP, ;DONE, RETURN
SUBTTL RKBSET - COPY KEY BUFFER TO TEMP CONVERTED AREA
;COPY KEY BUFFER TO CONVERTED KEY BUFFER
;THIS ROUTINE IS CALLED WHEN DOING KEYED ACCESS.
; IT EXPECTS THAT ARG-LIST+1 IS
; XWD KEY-OF-REFERENCE,,KEY-BUFFER-ADDRESS
RKBSET: HRRZ T1,BS.AGL ;GET BASE OF ARG LIST
HLRZ T1,KYINFO(T1) ;GET KEY OF REFERENCE
HRRZ T3,.RCKIN(FTL) ;POINT TO KEY INFO
LSH T1,1 ;EACH IS TWO WORDS LONG
ADDI T3,KYINFO(T1) ;POINT TO APPROPRIATE KEY-INFO BLOCK
HRRZ T1,KY.BUF(T3) ;GET KEY SIZE
;ENTER HERE WHEN THE KEY SIZE IS IN T1
RKBST1: HRRZ T4,.RCCKB(FTL) ;POINT TO CONVERTED KEY BUFFER
TXNE FLG,FA%FAK ;DOING FAKE READ?
HRRZ T4,.RCFKC(FTL) ; YES, GIVE ADDR OF FAKE KEY CONV BUFFER INSTEAD
HRLI T4,440000 ;LH = BYTE RESIDUE
DPB T1,[POINT 12,T4,17] ;STORE IN REST OF PARAM
MOVEM T4,CVPRM.+1 ;SAVE PARAM+1
MOVE T1,.RCBPR(FTL) ;GET BP TO RECORD
HRRZ T2,BS.AGL ;REPLACE RECORD ADDR WITH KEY BUFFER ADDR
HRR T1,1(T2)
MOVEM T1,CVPRM. ;SAVE PARAM+0
PUSHJ PP,SVPACS ;SAVE PERM ACS.
MOVEI ARG,CVPRM. ;ARGUMENTS TO CONVERSION ROUTINE ARE HERE
HLRZ T1,.RCCRS(FTL) ;GET A ROUTINE TO CONVERT FROM KEY BUFFER MODE.
PUSHJ PP,(T1) ;;CALL IT
POPJ PP, ;RETURN
SUBTTL RMS DELETE - INDEXED FILE
;ARG FORMAT:
;ARG-ADDR: FLAG-BITS,,FILTAB-ADDR
;ARG-ADDR+1: [PRIMARY KEY BUFFER ADDRESS] ;RANDOM DELETE ONLY
;FLAGS-BITS:
DL%SEQ==1B9 ;SEQUENTIAL ACCESS
DL%NIK==1B11 ;NO INVALID KEY CLAUSE GIVEN
; "USE PROCEDURE" INSTEAD
DL.MIR: PUSHJ PP,DLST ;START DELETE, RETURN IF OK
MOVE T1,.RCSTE(FTL) ;GET FILE'S STATE
LDB T2,FT.ABL ;GET APPLY BASIC-LOCKING BIT
CAIN T2,1 ;IS IT ON?
JRST DLMIR1 ;YES
CAIN T1,RC.SUR ;IF SUCCESSFUL READ WAS JUST DONE,
MOVEI T1,RC.UNF ; SET STATE TO "UNDEFINED"
MOVEM T1,.RCSTE(FTL) ;STORE NEW STATE
;IF WE ARE DOING APPLY BASIC-LOCKING WE DON'T DO A PRELIMINARY FIND.
;THE USER IS SUPPOSED TO DO THAT HIMSELF.
;DO A $FIND TO POSITION TO THE RECORD
PUSHJ PP,FNDIT
JRST DLMIRE ;?CAN'T FIND THAT RECORD
JRST DLGO ;GO DO DELETE
;NOW DELETE THE RECORD
DLMIR1:
CAIE T1,RC.SUR ;LAST READ SUCCESSFUL?
JRST DLMSE1 ;NO, GIVE ERROR
JRST DLGO ;GO DO THE $DELETE
;HERE IF THE FIND FAILED
DLMIRE: JRST CPOPJ1 ;RETURN "INVALID KEY"
DL.MIS: PUSHJ PP,DLST ;START DELETE, RETURN IF OK
; THE LAST I-O MUST HAVE BEEN A SUCCESSFUL READ STMT.
MOVE T1,.RCSTE(FTL) ;GET FILE'S STATE
CAIE T1,RC.SUR ; SKIP IF SUCCESSFUL READ WAS JUST DONE
JRST DLMSE2 ;NO, GIVE ERROR
MOVEI T1,RC.UNF ;SET NEW STATE TO "UNDEFINED"
MOVEM T1,.RCSTE(FTL)
; WE WILL DELETE THE RECORD READ.
DLGO: MOVE T2,.RCRAB(FTL) ;POINT TO RAB
MOVEI T1,RB$WBH ;ONLY WRITE BEHIND
$STORE T1,ROP,(T2) ;STORE RECORD OPTIONS
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$DELETE <(T2)>,DELSER ;SEQ. DELETE ERROR
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
PUSHJ PP,CHKPT ;[1046] CHECK FOR CHECKPOINTING
MOVE T1,FS.FS ;GET FILE-STATUS
PUSHJ PP,RCLNUP ;SET FILE-STATUS
MOVE T1,FS.FS ;GET FILE-STATUS AGAIN
CAIL T1,FS%20 ;IS IT SOME FIND OF INVALID KEY?
CAILE T1,FS%29 ;
JRST DELOK ;NO, BUT OK RETURN
JRST CPOPJ1 ;YES - SKIP RETURN
DELOK: ;NON-SKIP RETURN TO USER
POPJ PP, ; RETURN TO USER PROG.
DELSER: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCRAB(FTL) ;ADDR OF THE RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIN T1,ER$RLK ;RECORD LOCKED?
JRST DELELK ; YES
CAIN T1,ER$CUR ;NO CURRENT RECORD?
JRST DELECU ; YES
CAIN T1,ER$FAC ;NOT ALLOWED BY SMU OPEN FOR SELF?
JRST DELFAC ; YES
TYPE [ASCIZ/
?$DELETE failed
/]
JRST RSFAIR ;RMS-SYSTEM FAILURE
DELELK: MOVEI T1,FS%92 ;ERROR CODE 92
JRST DELERP
DELECU: MOVEI T1,FS%93 ;ERROR CODE 93
JRST DELERP
DELFAC: MOVEI T1,FS%94 ;ERROR CODE 94
; JRST DELERP
DELERP: ;NON-SKIP ERROR RETURN TO USER
MOVEM T1,FS.FS ;SAVE ASIDE FILE-STATUS-1
PUSHJ PP,RCLNUP
POPJ PP,
;YOU MAY HAVE NOTICED THAT I WENT OUT OF MY WAY TO IMITATE THE EXISTING
;KROCKY ERROR DIAGNOSTIC PROCEDURES WHEN PUTTING IN THE NEW ONES FOR SMU
;OPTION 5. I PUT A LOT OF EFFORT INTO TRYING TO FIGURE OUT HOW TO IMPLEMENT
;A TABLE-DRIVEN PROCEDURE FOR REPORTING NON-FATAL ERROR SITUATIONS BUT I
;DECIDED THAT IT WOULD NOT BE A GOOD IDEA BECAUSE THE RMS ERROR CODES ARE
;NUMBERED IN ASCENDING ORDER TO CORRESPOND TO THEIR THREE-LETTER SUFFIX
;MNEMONIC. IN ORDER FOR A TABLE-DRIVEN PROCEDURE TO BE NON-WASTEFUL OF
;SPACE, OR AT LEAST NOT GREATLY AS IN A SPARSE TABLE, THE ERROR CODES
;WOULD HAVE TO BE NUMBERED IN SOME KIND OF FUNCTIONAL ORDER.
; DELETE with key was not preceeded by a successful READ
DLMSE1:
SKIPL WANT8. ;WANT 8X FUNCT?
JRST DLMSE4 ; NO
MOVEI T0,FS%96 ;SET F-S CODE FOR REW/DEL NOT PREC BY READ
MOVEM T0,FS.FS ;
PUSHJ PP,SETFS ;
DLMSE4: $ERROR (E.532,SV.KIL,MT.FIL)
;"DELETE of seq. access file was not immediately proceeded
; by a successful READ"
DLMSE2: SKIPL WANT8. ;WANT 8X FUNCT?
JRST DLMSE3 ; NO
MOVEI T0,FS%43 ;SET F-S CODE FOR REW/DEL NOT PREC BY READ
MOVEM T0,FS.FS ;
PUSHJ PP,SETFS ;
DLMSE3: $ERROR (E.517,SV.KIL,MT.FIL)
SUBTTL RMS REWRITE ENTRY POINTS
;ARG FORMAT:
;ARG-ADDR: FLAG-BITS,,FILTAB-ADDR
;ARG-ADDR+1: REWRITE RECORD LENGTH,,KEY-BUFFER-ADDRESS
;FLAG-BITS:
RW%SEQ==1B9 ;SEQUENTIAL ACCESS
RW%NIK==1B11 ;NO "INVALID KEY" CLAUSE GIVEN
RW.MIR: PUSHJ PP,RWST ;START REWRITE
MOVE T1,.RCSTE(FTL) ;GET FILE'S STATE
LDB T2,FT.ABL ;GET APPLY BASIC-LOCKING BIT
CAIN T2,1 ;IS IT ON?
JRST RWMIR1 ;YES.
CAIN T1,RC.SUR ;IF SUCCESSFUL READ WAS JUST DONE,
MOVEI T1,RC.UNF ; SET STATE TO "UNDEFINED"
MOVEM T1,.RCSTE(FTL) ;STORE NEW STATE
;IF WE ARE DOING APPLY BASIC-LOCKING WE DON'T DO A PRELIMINARY FIND.
;THE USER IS SUPPOSED TO DO THAT HIMSELF.
PUSHJ PP,FNDIT ;FIND THE RECORD
JRST RWMIRE ;?CAN'T FIND THE KEY
JRST RWGO ;GO DO REWRITE
RWMIR1:
CAIE T1,RC.SUR ;LAST READ SUCCESSFUL?
JRST RWMSE1 ;NO GIVE ERROR.
;NOW UPDATE THE RECORD
RWGO: MOVE T2,.RCRAB(FTL) ;POINT TO RAB
;ADDRESS OF RECORD - ALREADY SETUP BY OPEN
;SIZE OF RECORD -- FROM ARG LIST.
MOVE T1,BS.AGL
HLRZ T1,RECLNG(T1) ;GET SIZE OF RECORD
$STORE T1,RSZ,(T2) ;STORE IT
;RECORD ACCESS OPTIONS ARE LEFT AT "0" (FNDIT SET THEM)
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$UPDATE <(T2)>,UPDERR ;** DO THE UPDATE **
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
PUSHJ PP,CHKSDP ;CHECK FOR SUCCESSFUL RETURN, BUT DUPLICATE KEY
MOVE T1,FS.FS ;GET FILE-STATUS
PUSHJ PP,RCLNUP ; SET FILE-STATUS WORD
MOVE T1,FS.FS ;GET FILE-STATUS AGAIN
CAIL T1,FS%20
CAILE T1,FS%29 ;SOME KIND OF INVALID KEY?
JRST UPDOK ;NO
JRST CPOPJ1 ;YES, RETURN "INVALID KEY"
UPDOK:
PUSHJ PP,CHKPT ;[1046] CHECK FOR CHECKPOINTING
POPJ PP, ;AND RETURN SUCCESSFULLY
UPDERR: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCRAB(FTL) ;POINT TO RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIN T1,ER$DUP ;DUPLICATE KEY?
JRST UPDERK ;YES
CAIN T1,ER$CUR ;CURRENT RECORD KNOWN?
JRST UPDECU
CAIN T1,ER$RLK ;RECORD LOCKED?
JRST UPDELK
CAIN T1,ER$FAC ;DELETE NOT ALLOWED FOR SELF UNDER SMU OPEN?
JRST UPDFAC
CAIN T1,ER$CHG ;KEYS CANNOT BE CHANGED?
JRST UPDERC ;YES
CAIN T1,ER$RSZ ;ATTEMPT TO CHANGE RECORD SIZE?
JRST UPDERS ; FATAL ERROR FOR USER
TYPE [ASCIZ/
?COBLIB: Failed to Rewrite to RMS File
/]
JRST RSFAIR
UPDECU: MOVEI T1,FS%92 ;ERROR CODE 92 FOR CURRENT RECORD
JRST UPDERP
UPDELK: MOVEI T1,FS%93 ;ERROR CODE 93 FOR RECORD LOCKED
JRST UPDERP
UPDFAC: MOVEI T1,FS%94 ;ERROR CODE 94 FOR NOT ALLOWED UNDER OPEN
JRST UPDERP
;DUPLICATE KEY ERROR ON UPDATE
UPDERK: MOVEI T1,FS%22 ;SET FILE-STATUS
; JRST UPDERP
UPDERP:
MOVEM T1,FS.FS
PUSHJ PP,RCLNUP
POPJ PP, ;AND RETURN
;KEYS CANNOT BE CHANGED BY UPDATE
;LOOK AT STV TO SEE WHICH KEY CAUSED THE PROBLEM
UPDERC: $FETCH T1,STV,(T2) ;GET KEY NUMBER
JUMPE T1,RWMISE ;PRIMARY KEY: READ SEQ FAILURE
$ERROR (E.506,SV.FAT,MT.FIL,CPOPJ) ;"ATTEMPT TO CHANGE KEY VALUE"
;*** ERROR: USER ATTEMPTED TO CHANGE RECORD SIZE.
UPDERS: SKIPL WANT8. ;WANT 8X FUNCT?
JRST UPDRS1 ; NO
MOVEI T1,FS%44 ;SET BAD-RECORD-SIZE F-S CODE
MOVEM T1,FS.FS ;
PUSHJ PP,SETFS ;
UPDRS1: $ERROR (E.522,SV.KIL,MT.FIL)
;HERE IF THE FIND FAILED
RWMIRE: JRST CPOPJ1 ;RETURN "INVALID KEY"
;REWRITE IN SEQUENTIAL MODE
RW.MIS: PUSHJ PP,RWST ;START REWRITE
;CHECK HERE TO SEE IF LAST OPERATION WAS A SUCCESSFUL READ
MOVE T1,.RCSTE(FTL) ;GET FILE'S STATE
CAIE T1,RC.SUR ; SKIP IF SUCCESSFUL READ WAS JUST DONE
JRST RWMSE2 ;NO, GIVE ERROR
MOVEI T1,RC.UNF ;SET NEW STATE TO "UNDEFINED"
MOVEM T1,.RCSTE(FTL)
MOVE T2,.RCRAB(FTL) ;POINT TO RAB
MOVEI T1,RB$SEQ ;SIGNAL SEQUENTIAL ACCESS
$STORE T1,RAC,(T2)
MOVEI T1,RB$WBH ;ONLY WRITE BEHIND
$STORE T1,ROP,(T2) ;STORE RECORD OPTIONS
JRST RWGO ;GO DO REWRITE
;HERE IF WE TRIED TO CHANGE THE PRIMARY KEY
;THIS IS AN INVALID KEY CONDITION
RWMISE: MOVEI T1,FS%21 ;FILE-STATUS VALUE
MOVEM T1,FS.FS ;STORE IT
PUSHJ PP,RCLNUP ;TELL USER PROGRAM, RETURN FROM UPDERR
POPJ PP, ; (DO IT THE USUAL WAY)
;REWRITE with key no preceeded by successful READ
RWMSE1:
SKIPL WANT8. ;WANT 8X FUNCT?
JRST RWMSE4 ; NO
MOVEI T0,FS%96 ;SET F-S CODE REW/DEL NOT PREC BY READ
MOVEM T0,FS.FS ;
PUSHJ PP,SETFS ;
RWMSE4: $ERROR (E.532,SV.KIL,MT.FIL) ;GIVE ERROR
;"SEQ MODE REWRITE WAS NOT IMMEDIATELY PROCEEDED BY A SUCCESSFUL READ"
RWMSE2: SKIPL WANT8. ;WANT 8X FUNCT?
JRST RWMSE3 ; NO
MOVEI T0,FS%43 ;SET F-S CODE FOR REW/DEL NOT PREC BY READ
MOVEM T0,FS.FS ;
PUSHJ PP,SETFS ;
RWMSE3: $ERROR (E.516,SV.KIL,MT.FIL) ;GIVE KILL ERROR
;ROUTINE TO FIND A RECORD
; CALLED FROM RANDOM DELETE OR REWRITE.
;THIS ROUTINE SKIPS IF THE $FIND WAS SUCCESSFUL
;IT EXPECTS TO FIND THE KEY BUFFER ADDRESS IN RH(ARG-LIST + 1)
FNDIT: MOVE T2,.RCRAB(FTL) ;MAKE T2 POINT TO THE RAB
MOVEI T1,RB$KEY ;SIGNAL KEYED ACCESS
$STORE T1,RAC,(T2)
;WE DON'T NEED THE KEY INFO FOR RELATIVE FILES, AS THIS IS ALL SET UP
;AT OPEN TIME, AND REMAINS CONSTANT FOR THE DURATION OF THIS OPEN.
MOVE T0,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNE T0,RANFIL ;RELATIVE FILE?
JRST FNDIT2 ;YES, GO DOWN TO ROP STUFF
;SET KEY OF REFERENCE TO THE PRIMARY KEY
MOVEI T1,0
$STORE T1,KRF,(T2)
;SET SIZE OF KEY
HRRZ T4,.RCKIN(FTL) ;POINT TO KEY INFO
HRRZ T4,KYINFO(T4) ;GET SIZE OF PRIMARY KEY IN BYTES
$STORE T4,KSZ,(T2)
;SET KEY BUFFER ADDRESS
TXNE FLG,CF%CNV ;CONVERSION REQUIRED?
JRST FNDIT1 ;YES
MOVE T1,BS.AGL ;GET BASE OF ARG LIST
HRRZ T1,KYINFO(T1) ;GET KEY BUFFER ADDRESS
$STORE T1,KBF,(T2) ;TELL RMS
JRST FNDIT2 ;GO ON
;CONVERT THE KEY FROM @RH( ARG-LIST + 1) TO THE KEY BUFFER
FNDIT1: MOVE T1,T4 ;GET KEY SIZE
PUSHJ PP,RKBST1 ; CONVERT THE KEY
MOVE T2,.RCRAB(FTL) ;RESTORE T2
;TELL FIND WE WANT KEY=
FNDIT2: MOVEI T1,0 ;NO ALTERNATE OPTIONS
$STORE T1,ROP,(T2)
;** DO IT **
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$FIND <(T2)>,FNDITE ;** START = RECORD **
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVE T2,.RCRAB(FTL)
MOVE T1,FS.FS ;GET FILE STATUS
JUMPE T1,CPOPJ1 ;SKIP RETURN IF OK
PUSHJ PP,RCLNUP ; AND SET IT, BECAUSE WE WILL SLIDE OUT
; OF THE VERB CALL WITHOUT SETTING IT
; OTHERWISE.
POPJ PP, ;ERROR RETURN
;HERE IF $FIND FAILED TRYING TO POSITION TO THE RECORD.
; THIS IS PROBABLY A "RECORD NOT FOUND" = INVALID KEY ERROR
FNDITE: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCRAB(FTL) ;ADDR OF THE RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIN T1,ER$RNF ;RECORD NOT FOUND?
JRST FNDITF ;YES, SET "INVALID KEY/NO RECORD"
TYPE [ASCIZ/
?COBLIB: RMS $FIND failed for Rewrite or Delete
/]
JRST RSFAIR
FNDITF: MOVEI T1,FS%23 ;SET "INVALID KEY - RECORD NOT FOUND"
MOVEM T1,FS.FS
PUSHJ PP,RCLNUP ;SET IT AND RETURN
POPJ PP, ; SOMEWHAT MORE CLEARLY
; TO VERB'S ERROR HANDLING PROCEDURE
;ROUTINE TO CHECK FOR DUPLICATE KEY WRITTEN (WRITE OR REWRITE) OR READ.
;; IT LOOKS AT THE STS RETURNED IN THE RAB, AND CHECKS FOR "SU$DUP".
; IF THAT SUCCESS CODE IS GIVEN, SET FS.FS TO 02.
CHKSDP: MOVE T2,.RCRAB(FTL) ;POINT TO RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIE T1,SU$DUP ; SUCCESSFUL, BUT DUPLICATE KEYS?
POPJ PP, ;NO, LEAVE FS.FS ALONE.
MOVEI T1,FS%02 ;PUT 02 IN FS.FS
MOVEM T1,FS.FS
POPJ PP, ;AND RETURN
;ROUTINE TO START REWRITE
; ONLY RETURNS IF THINGS ARE OK
RWST: PUSHJ PP,SETIO ;SETUP FOR IO
TXNN FLG,LF%IO ;SKIP IF OPEN FOR IO
JRST DLENIO ;NOT OPEN IO, COMPLAIN
TXNN FLG,CF%CNV ;SKIP IF RECORD NEEDS CONVERTING
POPJ PP, ;ALL OK, RETURN
;COPY RECORD AREA TO BUFFER ADDRESS
;LH (ARG-LIST+1) IS THE LENGTH OF THE RECORD TO WRITE
JRST COPRCB ;GO DO IT LIKE "WRITE" DOES
;ROUTINE TO START DELETE
; ONLY RETURNS IF THINGS ARE OK
DLST: PUSHJ PP,SETIO ;SETUP FOR IO
TXNN FLG,LF%IO ;SKIP IF OPEN FOR IO
JRST DLENIO ;NOT OPEN IO, COMPLAIN
POPJ PP, ;RETURN
;;;;;RWENIO: $ERROR (E.502,SV.KIL,MT.FIL)
;;;;; DELETE OR REWRITE AND FILE NOT OPEN I-O
DLENIO: SKIPL WANT8. ;WANT ANS 8X FUNCT?
JRST DLENI2 ; NO
MOVEI T0,FS%49 ;SET UP F-S FOR FILE NOT OPEN I-O
MOVEM T0,FS.FS ; AND SAVE ASIDE
PUSHJ PP,SETFS ; AND PUT IN USER'S F-S FIELD
DLENI2: $ERROR (E.501,SV.KIL,MT.FIL)
SUBTTL RMS START ENTRY POINTS
;ARG FORMAT:
;ARG-ADDR: FLAG-BITS,,FILTAB-ADDR
;ARG-ADDR+1: KEY OF REF,,KEY BUFFER ADDRESS
;ARG-ADDR+2: [LENGTH OF APPROXIMATE KEY]
;
; WHERE START FLAG-BITS ARE DEFINED AS:
;
STA%EQ==3B13 ;EQUAL TO (IF 0)
STA%NL==1B12 ;NOT LESS THAN
STA%GT==1B13 ;GREATER THAN
STA%AK==1B14 ;START WITH APPROXIMATE KEY
STA%NI==1B15 ;NO "INVALID KEY" CLAUSE GIVEN
; "USE PROCEDURE" INSTEAD
;IF STA%AK IS 0, THEN ARG-ADDR+2 IS NOT USED
ST.MEQ: PUSHJ PP,STAST ;START "START"
MOVEI T1,RB$NRP ;SET NEXT RECORD PTR
$STORE T1,ROP,(T2) ;STORE
JRST ST.GO ;ALL DONE, GO
ST.MGT: PUSHJ PP,STAST ;START "START"
MOVEI T1,RB$KGT!RB$NRP ;GREATER THAN
$STORE T1,ROP,(T2) ;STORE
JRST ST.GO ;AND GO
ST.MNL: PUSHJ PP,STAST ;START "START"
MOVEI T1,RB$KGE!RB$NRP ;GREATER OR EQUAL
$STORE T1,ROP,(T2) ;STORE
ST.GO: MOVE T0,F.WFLG(FT) ;GET COMPILER FLAGS
SKIPGE WANT8. ;WANT 8X FUNCT?
TLNN T0,NOTPRS ;OPTIONAL FILE NOT PRESENT?
JRST ST.GO1 ;NO
MOVEI T0,FS%25 ;SET UP OPT-NOT-PRES F-S CODE
MOVEM T0,FS.FS ;
AOS (PP) ;SET UP RETURN TO .+2
PJRST SETFS ;REPORT IT TO USER, AND RETURN IMMEDIATELY
ST.GO1: SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$FIND <(T2)>,FNDERR ;** DO THE FIND **
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVE T1,FS.FS ;GET STATUS
PUSHJ PP,SETFS ;SET FILE-STATUS
MOVE T1,FS.FS ;GET STATUS AGAIN
JUMPE T1,FNDOK ;RETURN OK IF ZERO
CAIL T1,FS%20 ;SOME KIND OF INVALID KEY?
CAILE T1,FS%29
POPJ PP, ;NO, AN IGNORED ERROR
AOS (PP) ;INVALID KEY RETURN
POPJ PP,
FNDOK:
MOVEI T1,RC.UNF ;SET FILE'S STATE TO "UNDEFINED"
MOVEM T1,.RCSTE(FTL) ; (THIS CLEARS "AT END" IF SET)
POPJ PP, ;NORMAL RETURN
;RMS-ERROR ROUTINE IF $FIND FAILED
FNDERR: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCRAB(FTL) ;ADDR OF THE RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIN T1,ER$RNF ;RECORD NOT FOUND?
JRST FNDE23 ;YES, SET "INVALID KEY/NO RECORD"
CAIN T1,ER$RLK ;RECORD LOCKED?
JRST FNDELK ; YES
TYPE [ASCIZ/
?$FIND FAILED
/]
JRST RSFAIR
FNDELK: MOVEI T1,FS%92 ;ERROR 92 FOR RECORD LOCKED
JRST FNDERP
FNDE23: MOVEI T1,FS%23 ;SET FILE-STATUS, RECORD NOT FOUND
; JRST FNDERP
FNDERP: MOVEM T1,FS.FS
PJRST SETFS ;FOR "INVALID KEY", AND RETURN
;ROUTINE TO SETUP FOR DOING A "START". RETURNS ONLY IF EVERYTHING
; IS OK, WITH ACS SET UP.
STAST: PUSHJ PP,SETIO ;SETUP FOR IO
SKIPE F.WSMU(FT) ;DOING SMU OPTION 1?
JRST STASE2 ; YES, NOT ALLOWED
TXNN FLG,LF%INP ;SKIP IF OPEN FOR INPUT OR I-O
JRST STASE1 ;NO, GIVE ERROR
MOVE T1,.RCSTE(FTL) ;GET FILE'S STATE
CAIN T1,RC.SUR ; WAS LAST THING A SUCCESSFUL READ?
MOVEI T1,RC.UNF ;YES, SET NEW STATE TO "UNDEFINED"
MOVEM T1,.RCSTE(FTL) ;SAVE UPDATED STATE
MOVE T2,.RCRAB(FTL) ;T2 POINTS TO RAB
MOVEI T1,RB$KEY ;SIGNAL KEYED ACCESS
$STORE T1,RAC,(T2)
;IF FILE IS RELATIVE, WE JUST RETURN IF WE GOT THIS FAR.
MOVE T1,F.WFLG(FT) ;GET FLAG WORD FROM FILE'S FILE TABLE
TLNE T1,RANFIL ;RELATIVE FILE?
POPJ PP, ;YES - RETURN
;STORE KEY OF REFERENCE, AND KEY BUFFER ADDRESS
MOVE T1,BS.AGL ;GET BASE OF ARG LIST
HLRZ T3,KYINFO(T1) ;GET KEY OF REFERENCE FROM ARG LIST
$STORE T3,KRF,(T2) ;TELL RMS
MOVEM T3,.RCKRF(FTL) ;REMEMBER THE KEY OF REFERENCE
TXNN FLG,CF%CNV ;IS CONVERSION REQUIRED?
JRST STAS1 ;NO, SKIP THIS
HRRZ T3,.RCCKB(FTL) ; USE CONVERTED BUFFER ADDRESS
$STORE T3,KBF,(T2) ;TELL RMS
;SET T1= SIZE OF KEY TO MOVE, THEN CALL RKBST1 TO MOVE IT
TXNE FLG,STA%AK ;START WITH APPROX. KEY?
JRST STAS0 ;YES, USE KEY SIZE GIVEN
PUSHJ PP,RKBSET ;MOVE WHOLE KEY
MOVE T2,.RCRAB(FTL) ;RESTORE T2
JRST STAS2 ;GO ON
;MOVE # CHARS NEEDED FOR APPROX. KEY
STAS0: MOVE T1,BS.AGL ;POINT TO ARG LIST
MOVE T1,KEYLNG(T1) ;GET SIZE OF KEY PASSED IN ARG LIST
PUSHJ PP,RKBST1 ;MOVE THE KEY TO KEY BUFFER
MOVE T2,.RCRAB(FTL) ;;RESTORE T2
JRST STAS2 ;GO ON
;NO CONVERSION REQUIRED
STAS1: HRRZ T3,KYINFO(T1) ;GET KEY BUFFER ADDRESS FROM ARG LIST
$STORE T3,KBF,(T2) ;TELL RMS
;FALL INTO STAS2
;HERE WHEN KEY HAS BEEN MOVED AND CONVERTED AS NECESSARY.
;STORE SIZE OF KEY IN THE RAB
STAS2: TXNE FLG,STA%AK ;APPROXIMATE KEY?
JRST STAS3 ;YES, USE SIZE IN ARG LIST
HRRZ T4,.RCKIN(FTL) ;POINT TO KEY INFO
HRRZ T3,BS.AGL ;GET KEY OF REF.
HLRZ T3,KYINFO(T3) ; INTO T3
LSH T3,1 ;EACH IS TWO WORDS
ADDI T4,KYINFO(T3) ;POINT TO APPROPRIATE KEY-INFO BLOCK
HRRZ T1,(T4) ;GET KEY SIZE
$STORE T1,KSZ,(T2) ;STORE SIZE OF KEY BLOCK
POPJ PP, ;RETURN OK
STAS3: MOVE T1,BS.AGL ;POINT TO ARG LIST
MOVE T1,KEYLNG(T1) ;GET SIZE OF KEY PASSED IN ARG LIST
$STORE T1,KSZ,(T2) ;STORE SIZE OF KEY BLOCK
POPJ PP, ;AND RETURN
;HERE TO GIVE ERROR BECAUSE "START" WAS CALLED AND FILE
; WAS NOT OPEN FOR INPUT OR I-O
STASE1: SKIPL WANT8. ;WANT 8X FUNCT?
JRST STASE3 ; NO
MOVEI T1,FS%47 ;SET UP F-S FOR ATTEMPTED READ WITH FILE
; NOT OPEN FOR INPUT OR I-O
MOVEM T1,FS.FS ; AND SAVE IT ASIDE
PUSHJ PP,SETFS ; AND REPORT IT TO USER
STASE3: $ERROR (E.514,SV.KIL,MT.FIL)
;FATAL ERROR FOR USING START WITH SMU OPTION 1
STASE2: $ERROR (E.529,SV.KIL,MT.FIL)
SUBTTL FAKE READ ENTRY POINTS FOR SMU OPTION 1 FOR RMS FILES
IFN TOPS20,<
;NOTE: A FAKE READ IS NOT A READ AND IS NOT A FIND, BUT IS IN BETWEEN.
; A FIND BRINGS NO DATA INTO THE OTS'S BUFFERS, ONLY PROVIDING THE RFA
; TO THE CURRENTLY FOUND RECORD. A READ BRINGS DATA INTO THE OTS'S
; BUFFERS, AND FROM THERE THE OTS MOVES THE DATA INTO THE USER'S WORK
; AREA. A FAKE READ BRINGS DATA INTO THE OTS'S BUFFERS, BUT THE OTS
; DOES NOT MOVE THE DATA INTO THE USER'S BUFFERS. ALSO, THE OTS DOES
; NOT UPDATE THE RFA FOR THE USER FOR A CURRENTLY FOUND RECORD.
; ALSO, A FAKE READ DOES NOT UPDATE THE USER'S FILE CURRENCEY CONTEXT AT
; RUN TIME, WHICH A REGULAR READ OR A FIND DOES DO.
;FAKE READ BY KEY
;
;CALLING SEQUENCE:
;
; MOVEI ARG,ARG-ADDR
; PUSHJ PP,FA.MIR
;
;RETURNS: + 1 FOR SUCCESS
; + 2 FOR INVALID KEY
; PROGRAM FAILURE FOR ANY OTHER ERROR
;
;ARG FORMAT: CONSISTS OF TWO WORDS. THE FIRST IS ALWAYS PRESENT. THE
; SECOND IS PRESENT ONLY FOR KEYED ACCESS TO FILES.
;
;ARG-ADDR: FLAG-BITS ,,FILTAB-ADDR
; KEY# OF REF,,ADDR OF KEY BUFFER
;
; WHERE FLAG-BITS ARE: (DEFINED IN LBLPRM.MAC)
; FA%NXT==1B9 ;READ NEXT RECORD
; FA%KYR==1B10 ;KEY REFERENCE SPECIFIED
; FA%FAK==1B11 ;THIS READ IS A FAKE READ
;FA.MIR: FAKE READ RANDOMLY FOR SMU OPTION 1
FA.MIR: PUSHJ PP,RDSET ;SETUP FOR FAKE READ
TXO FLG,FA%FAK ;SET FAKE READ FLAG
MOVE T2,.RCFAK(FTL) ;NEED FAKE RAB ADDR AND RKBSET DESTROYS IT
MOVE T0,F.WFLG(FT) ;GET COMPILER FLAGS
TLNE T0,NOTPRS ;FILE MUST BE PRESENT FOR SMU OPTION 1
JRST FANPER ; ELSE FATAL RUN-TIME ERROR
TLNE T0,RANFIL ;READING RELATIVE FILE?
JRST FA.MI3 ;YES, SKIP INDEX FILE STUFF
TXNE FLG,CF%CNV ;IF CONVERSION REQUIRED,
PUSHJ PP,RKBSET ;SETUP KEY BUFFER
;LOOKS GOOD. DO AN INDEXED/RELATIVE-FILE RANDOM READ.
MOVE T2,.RCFAK(FTL) ;POINT TO FAKE RAB
;SET KEY BUFFER ADDRESS
HRRZ T1,BS.AGL ;GET BASE OF ARG LIST
HRRZ T1,KYINFO(T1) ; FETCH ADDRESS OF KEY BUFFER
TXNE FLG,CF%CNV ;UNLESS CONVERSION REQUIRED,
HRRZ T1,.RCFKC(FTL) ; THEN GET FAKE CONVERTED KEY BUFFER
$STORE T1,KBF,(T2) ; TELL RMS WHERE KEY IS
;SET "KEY OF REFERENCE"
SETZ T1, ;ASSUME PRIMARY KEY
TXNN FLG,FA%KYR ;WAS ANY SPECIFIED?
JRST FA.MI2 ;NO, USE 0
HRRZ T1,BS.AGL ;GET BASE OF ARG LIST
HLRZ T1,KYINFO(T1) ;GET T1= WHICH KEY
FA.MI2:
$STORE T1,KRF,(T2) ;STORE "KEY OF REFERENCE"
MOVEM T1,.RCFKR(FTL) ;AND REMEMBER WHICH KEY IT IS
; IN CASE OF FAKE SEQUENTIAL READ
;SET "KEY BUFFER SIZE"
HRRZ T3,.RCKIN(FTL) ;POINT TO KEY INFO
LSH T1,1 ;EACH IS TWO WORDS LONG
ADDI T3,KYINFO(T1) ;POINT TO APPROPRIATE KEY-INFO BLOCK
HRRZ T1,KY.BUF(T3) ;GET KEY SIZE
$STORE T1,KSZ,(T2) ;STORE SIZE OF KEY BLOCK
;SET "USER BUFFER SIZE"
FA.MI3:
LDB T1,FT.MRS ;GET MAXIMUM RECORD SIZE
$STORE T1,USZ,(T2)
;IF RELATIVE FILE IDENTIFY RELATIVE KEY BUFFER
MOVE T4,.RCFAB(FTL) ;GET FILE'S FAB
$FETCH T1,ORG,(T4) ;GET ITS ORGANIZATION
CAIE T1,FB$REL ;IS IT RELATIVE?
JRST FA.MI4 ; NO
HRRZ T1,F.RACK(FT) ;YES, GET ADDRESS OF KEY FROM FILE TABLE
$STORE T1,KBF,(T2) ; AND STORE IT IN THE RAB
;SET "ACCESS MODE = RANDOM"
FA.MI4:
MOVEI T1,RB$KEY ;KEYED ACCESS
$STORE T1,RAC,(T2)
;SET RECORD OPTIONS TO JUST "SET NEXT REC PTR", BUT NOT FOR RELATIVE FILES
SETZ T1, ;CLEAR AN AC
MOVEI T1,RB$NRP
$STORE T1,ROP,(T2)
;;;; ALL READY TO DO THE $GET ;;;
; THE PHILOSOPHY OF GET IN THIS CASE IS DIFFERENT FROM GET FOR READ.
; IF IT COMES BACK SUCCESSFULLY OR RECORD NOT FOUND, WE SIMPLY RETURN
; THE BUCKET NUMBER OR 0 TO SMU OPTION 1. IF THE RECORD WAS NOT FOUND
; RMS WILL RETURN 0 IN THE RFA WORD. IF ANY OTHER ERROR CODE IS RETURNED
; WE BLOW OFF WITH A FATAL RUN TIME MESSAGE.
;
; IN THE CASE OF A 0 RFA BEING RETURNED, WE CANNOT BE SURE OF WHAT THE
; USER'S INTENTION IS AT THIS LEVEL, SO WE SEND BACK A 0 BUCKET NUMBER
; TO THE CALLING ROUTINE IN LSU. AT THAT LEVEL, A BUCKET NUMBER OF 0
; WILL BE USED AS A CATCH-ALL BLOCK NUMBER AS IS A 0 BLOCK NUMBER NOW.
; THE PURPOSE OF THE 0 IS TO SERVE AS A DEFAULT BLOCK OR BUCKET WHEN
; IT IS NOT POSSIBLE TO LOCATE THE ACTUAL BUCKET(S) WHICH MIGHT BE
; AFFECTED BY A WRITE, ETC.
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$GET <(T2)>,FARERR ;DO THE GET FOR THE FAKE READ
JRST FARAFT ;BECAUSE FARERR RETURNS TO CALL+2
POPJ PP, ;LET FAILED EXIT RETURN TO CALLER BECAUSE
; IT IS ALREADY SET UP
FARAFT: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
;RETURN THE BUCKET NUMBER TO SMU OPTION 1
MOVE T4,.RCFAB(FTL) ;GET THE FAB'S ADDRESS
$FETCH T3,ORG,(T4) ; AND THE FILE'S ORGANIZATION
MOVE T2,.RCFAK(FTL) ;GET THE FAKE RAB'S ADDRESS
CAIE T3,FB$IDX ;IF INDEXED FILE
JRST FARAF1 ; IS NOT
$FETCH T1,RFA,(T2) ;THE BUCKET NUMBER IS IN THE RFA FROM THE FAKE RAB
JRST FARAFX ;
FARAF1: ;IS RELATIVE FILE
$FETCH T1,LSN,(T2) ;BUCKET NUMBER IS IN THE LINE SEQUENCE NUMBER FIELD
ADDI T1,1 ;ADD 1 FOR FIRST BLOCK IS 1
FARAFX: ;
HRRZM T1,SM.BN ;RETURN BLOCK NUM TO SMU OPTION 1
POPJ PP, ;RETURN
;RANDOM FAKE READ FAILED
FARERR: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
;FILE-STATUS IS NOT SUCH A BIG DEAL WITH THE FAKE READS BECAUSE SMU O
; OPTION 1 IS A DEC EXTENSION. HOWEVER, IN CASE OF A FATAL PROGRAM ERROR
; THEY MAY BE IMPORTANT, SO THEY WILL BE SET UP HERE AND IF THEY CAUSE
; A PROGRAM FAILURE THEY WILL GET BACK TO THE CALLING ROUTINE THROUGH
; DECLARATIVES.
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCFAK(FTL) ;ADDR OF THE FAKE RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIE T1,ER$RNF ;RECORD NOT FOUND?
JRST FARER1
SETZM SM.BN ;RETURN BLOCK NUMBER OF 0
AOS 0(PP) ;YES- RETURN +2
POPJ PP, ;
FARER1:
CAIN T1,ER$RLK ;RECORD LOCKED?
; SHOULDN'T BE, IS SERIOUS PROBLEM IF LOCKED
JRST FALKER ; YES - GIVE FATAL RUN-TIME ERROR
TYPE [ASCIZ/
?COBLIB: RMS Random Read Failed for SMU with Retain and Free
/]
JRST RSFAIK ;RMS-SYSTEM FAILURE
FALKER: TYPE [ASCIZ/
?COBLIB: Record to be Retained already Locked
/]
JRST RSFAIK ;RMS SYSTEM FAILURE
FANPER: TYPE [ASCIZ/
?COBLIB: File Must Be Present for SMU with Retain and Free
/]
JRST RSFAIK ;RMS SYSTEM FAILURE
;FAKE READ SEQUENTIALLY
;
;CALLING SEQUENCE:
;
; MOVEI ARG,ARG-ADDR
; PUSHJ PP,FA.MIS
;
;RETURNS: + 1 FOR SUCCESS
; + 2 FOR NO NEXT RECORD (EOF)
; PROGRAM FAILURE FOR ANY OTHER ERROR
;
;ARG FORMAT: CONSISTS OF ONE WORD.
;
;ARG-ADDR: FLAG-BITS ,,FILTAB-ADDR
;
; WHERE FLAG-BITS ARE THE SAME AS FOR A KEYED FAKE READ
;FA.MIS: FAKE READ SEQUENTIALLY
FA.MIS:
PUSHJ PP,RDSET ;SETUP FOR FAKE READ
TXO FLG,FA%FAK ;TURN ON FAKE READ FLAG
;GIVE BUCKET NUMBER OF 0 IF FILE IS ALREADY "AT END"
MOVE T1,.RCSTE(FTL) ;GET STATE OF FILE
CAIN T1,RC.ATE ; IF "AT END",
JRST FAEOF ;GO DO IT
;TEST IF OPTIONAL FILE NOT PRESENT AT OPEN TIME.
; FILE MUST BE PRESENT FOR SMU OPTION 1
MOVE T1,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNE T1,NOTPRS ;OPTIONAL FILE WHICH IS NOT PRESENT?
JRST FANPER ; YES, GROSS ERROR
TLNE T1,SEQFIL ;IS THIS A SEQUENTIAL FILE?
JRST FASQER ; NOT ALLOWED FOR SMU OPTION 1, ANOTHER
; GROSS ERROR
;SET UP FOR INDEXED/RELATIVE-FILE SEQUENTIAL READ.
MOVE T2,.RCFAK(FTL) ;POINT TO FAKE RAB, NEED IT BELOW
MOVE T1,F.WFLG(FT) ;GET FILE TABLE FLAG WORD
TLNE T1,RANFIL ;DOING RELATIVE FILE?
JRST FA.MS1 ;YES, BYPASS SETUP FOR KEY OF REFERENCE
MOVE T1,.RCKRF(FTL) ;SET UP THE CURRENT KEY OF REFERENCE
$STORE T1,KRF,(T2)
;SET RECORD BUFFER ADDRESS
FA.MS1:
HRRZ T1,SM.BUF## ;GET ADDRESS OF REGULAR BUFFER FOR FAKE RAB
TXNE FLG,CF%CNV ;CONVERSION REQUIRED?
HRRZ T1,.RCFCB(FTL) ; YES, READ RECORD INTO FAKE CONVERSION BUFFER
$STORE T1,UBF,(T2) ;TELL RMS WHERE RECORD AREA IS
;SET "USER BUFFER SIZE"
LDB T1,FT.MRS ;GET MAXIMUM RECORD SIZE
$STORE T1,USZ,(T2)
;SET "ACCESS MODE = SEQUENTIAL"
MOVEI T1,RB$SEQ ;SEQUENTIAL ACCESS
$STORE T1,RAC,(T2)
;SET "READ AHEAD" BIT , GAMBLING THAT THE USER WILL BE PROCESSING
; THE FILE SEQUENTIALLY FOR A WHILE
MOVEI T1,RB$RAH ;READ AHEAD
HRRZI T1,0
$STORE T1,ROP,(T2)
;;;; ALL READY TO DO THE $GET ;;;
SETSEC ;GET INTO NON-ZERO SECTION IF REQUIRED
$GET <(T2)>,FASERR ;DO IT
RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
;IF THE $GET COMES BACK NORMALLY, WE HAVE TO DO ONE THING FOR RELATIVE
; FILES AND TWO THINGS FOR INDEXED FILES.
;FOR RELATIVE FILES WE HAVE TO PUT THE LSN + 1 INTO THE FIELD SM.BN TO
; RETURN IT TO THE BLKNUM ROUTINE IN LSU.
;FOR INDEXED FILES, WE HAVE TO RETURN THE KEY VALUE OF THE CURRENT
; RECORD AS WELL AS ITS RELATIVE POSITION IN THE LIST OF KEYS. SO THAT
; THESE CAN BE TABULATED IN THE RETAINED-RECORDS TABLE. FOR AN INITIAL
; READ NEXT, WE WILL ALWAYS ASSUME THE PRIMARY KEY. WE WILL LET LSU DO
; THE WORK TO CREATE THE BYTE POINTER TO MOVE THE KEY VALUE TO THE RRT.
MOVE T4,.RCFAB(FTL) ;GET ADDR OF FAB
$FETCH T3,ORG,(T4) ;GET FILE'S ORGANIZATION
MOVE T2,.RCFAK(FTL) ;GET ADDR OF FAKE RAB
TRNE T3,FB$IDX ;IF INDEXED FILE
JRST FA.MS3 ; YES, GO TO FINISH UP FAKE READ
;FOR RELATIVE FILE
$FETCH T1,LSN,(T2) ;BUCKET NUMBER IS IN THE LINE SEQUENCE NUMBER FIELD
ADDI T1,1 ; BUMP UP THE BUCKET NUMBER FOR LSU
HRRZM T1,SM.BN ; PUT IT INTO SM.BN FIELD
$FETCH T1,RFA,(T2) ;GET RFA, WHICH IS RELATIVE KEY VALUE
MOVEM T1,SM.KBF ; PUT IT INTO WORD FOR KEY BUFFER
JRST FA.MS2 ; DONE
;NOW THE THINGS FOR INDEXED FILES ONLY.
; GET THEM FROM FAKE RAB BECAUSE WE KNOW THAT IT HAS BEEN INITIALIZED.
; IN THE CASE OF THE INITIAL RETAIN NEXT, THIS MIGHT NOT BE THE CASE.
FA.MS3:
$FETCH T1,RFA,(T2) ;THE BUCKET NUMBER IS IN THE RFA FROM THE FAKE RAB
HRRZM T1,SM.BN ; AND PUT IT INTO SM.BN FIELD
$FETCH T1,KRF,(T2) ;GET KEY OF REFERENCE FROM FAKE RAB
HRRZM T1,SM.KRF ; AND SAVE IT TO PASS BACK
$FETCH T1,UBF,(T2) ;GET USER RECORD BUFFER ADDRESS
MOVEM T1,SM.BUF ; AND SAVE IT TO PASS BACK
$FETCH T1,KBF,(T2) ;GET KEY BUFFER ADDRESS
MOVEM T1,SM.KBF ; AND SAVE IT TO PASS BACK
$FETCH T1,BSZ,(T4) ;GET RECORD'S BYTE SIZE FROM FAB
MOVEM T1,SM.BSZ ; AND SAVE IT TO PASS BACK
JRST FA.MS2 ; AND FINALLY, RETURN
FAEOF: ;EOF INTERLUDE
SETZM SM.BN ;SET THE FIELD TO 0 FOR NOT-FOUND RETURN
AOS 0(PP) ;RETURN +2
FA.MS2: ;SUCCESSFUL RETURN
POPJ PP, ;.. OR RETURN SUCCESS
;FAKE READ IN SEQUENTIAL MODE FAILED. SERIOUS ERROR.
FASERR: RETSEC ;RETURN TO SECTION ZERO IF REQUIRED
MOVEI T0,FS%30 ;GET CATCHALL FILE-STATUS
MOVEM T0,FS.FS ; AND SAVE IT FOR REPORTING
MOVE T2,.RCFAK(FTL) ;GET ADDRESS OF FAKE RAB
$FETCH T1,STS,(T2) ;GET STATUS RETURNED
CAIN T1,ER$EOF ;END OF FILE REACHED?
JRST FAEOF ;YES
CAIN T1,ER$RLK ;RECORD LOCKED? SHOULD NOT BE!
JRST FALKER ; YES - VERY SERIOUS - MAKE FATAL
;ALL OTHER TYPES OF ERRORS ARE MADE FATAL TOO, BUT WE HAVE NOT
; SEPARATED THEM OUT.
FASQER:
TYPE [ASCIZ/
?COBLIB: Fake RMS Sequential Read Failed for SMU with Retain and Free
/]
JRST RSFAIK ;RMS-SYSTEM FAILURE
> ;END IFN TOPS20
END