Trailing-Edge
-
PDP-10 Archives
-
704rmsf2
-
10,7/rms10/rmssrc/rmsget.b36
There are 6 other files named rmsget.b36 in the archive. Click here to see a list.
MODULE GET =
BEGIN
GLOBAL BIND GETV = 1^24 + 0^18 + 8; !EDIT DATE: 21-JUN-77
%([
FUNCTION: THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
THE $GET MACRO FOR RMS-20.
AUTHOR: S. BLOUNT
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1977, 1979 BY DIGITAL EQUIPMENT CORPORATION
********** TABLE OF CONTENTS **************
ROUTINE FUNCTION
======= ========
$GET DISPATCHER FOR $GET USER MACRO
DOGETASCII PERFORM $GET FOR ASCII FILES
DOGETSEQ PERFORM $GET FOR SEQUENTIAL FILES
DOGETREL PERFORM $GET FOR RELATIVE FILES
DOGET PERFORM $GET FOR INDEXED FILES
GETREC I/O ROUTINE FOR $GET PROCESSOR
PADBUFFER ROUTINE TO PAD USER'S BUFFER FOR RB$PAD
GET ROUTINE TO GET A RECORD FROM INDEXED FILE
REVISION HISTORY:
EDIT DATE WHO PURPOSE
==== ==== === ==========
1 1-NOV-76 SEB NO ABORT FOR GTBYTE
2 16-NOV-76 SEB ADD GETIDX AND FIX LOCATE MODE BUG
3 16-DEC-76 SEB CHANGE ERPOS TO ERCUR
4 22-DEC-76 SEB MAKE UPD,DEL,TRU IMPLY FB$GET IN FAC
5 5-APR-77 SEB MAKE GETREC USE RSZW FOR ALL FILES
6 4-MAY-77 SEB RELEASE BUCKET FOR IDX FILE IF READ-ONLY
7 21-JUN-77 SEB FIX GETIDX SO FIND-GET ON
SEC KEY CLEARS THE RSTNRP FIELD
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
100 8 Dev Make declarations for routine names
be EXTERNAL ROUTINE so RMS will compile
under BLISS V4 (RMT, 10/22/85).
***** END OF REVISION HISTORY *****
])%
%([ EXTERNAL DECLARATIONS ])%
EXTERNAL ROUTINE
CRASH,
DUMP, ! DEBUGGING ROUTINE
DOEOF, ! PROCESS EOF CONDITION
GETASCII,
LOCKIT;
! MOVESTRING,
! FNDREL;
%([ EXTERNAL ERROR MESSAGES CONTAINED IN THIS MODULE ])%
EXTERNAL
! MSGPGONE, ! FILE PAGE MISSING
MSGBKT, ! CURRENT BUCKET IS NULL
MSGKDB, ! BAD KDB VALUE
MSGINPUT, ! BAD INPUT ARGS TO A ROUTINE
! MSGUNLOCKED, ! RECORD IS UNLOCKED
MSGFAILURE; ! ROUTINE FAILURE
FORWARD ROUTINE GETREC;
REQUIRE 'RMSREQ';
EXTDECLARATIONS;
! $GET
! ====
! PROCESSOR FOR $GET MACRO
! INPUT:
! ADDRESS OF USER RECORD BLOCK (RAB)
! ADDRESS OF USER ERROR ROUTINE
! OUTPUT:
! <STATUS FIELD>
! GLOBALS USED:
! $FIND
! FINDASCII
! FINDSEQ
! FINDREL
! GETASCII
! GETREC
! LOCKIT
! FORMAT OF THE $GET MACRO:
!
! $GET <RAB-ADDRESS> [,<ERROR-ADDRESS>]
!
!! RAB FIELDS USED AS INPUT TO $GET:
!
! ISI INTERNAL STREAM IDENTIFIER
! KBF KEY BUFFER ADDRESS (RELATIVE/INDEXED)
! KRF KEY OF REFERENCE (INDEXED)
! KSZ SIZE OF KEY IN BUFFER (INDEXED)
! RAC RECORD ACCESS
! RFA RECORD'S FILE ADDRESS
! ROP RECORD OPTIONS
! RB$LOC USE LOCATE MODE
! RB$RAH READ-AHEAD
! RB$KGT KEY IS GREATER THAN (INDEXED)
! RB$KGE KEY IS GREATER THAN OR EQUAL TO (INDEXED)
! UBF ADDRESS OF USER RECORD BUFFER
! USZ SIZE OF USER RECORD BUFFER
! RAB FIELDS WHICH ARE RETURNED BY $GET:
!
! BKT RELATIVE RECORD NUMBER OF TARGET RECORD (RELATIVE)
! LSN LINE-SEQUENCED NUMBER (ASCII)
! RBF ADDRESS OF RECORD TRANSFERED
! RFA RECORD'S FILE ADDRESS
! RSZ SIZE OF RECORD TRANSFERED
! STS STATUS OF OPERATION
! STV ADDITIONAL STATUS INFORMATION
GLOBAL ROUTINE %NAME('$GET') ( BLOCK, ERRORRETURN ) =
BEGIN
ARGUMENT (BLOCK,BASEADD);
ARGUMENT (ERRORRETURN,BASEADD);
EXTERNAL ROUTINE
DOGETASCII, ! PROCESSS $GET FOR ASCII FILES
PADBUFFER, ! PAD THE USER'S BUFFER
DOGETSEQ, ! PROCESS $GET FOR SEQUENTIAL FILES
DOGETREL, ! PROCESS $GET FOR RELATIVE FILES
%IF INDX %THEN
DOGETIDX, ! PROCESS $GET FOR INDEXED FIES
%FI
RSETUP;
RMSENTRY ($GET);
%([ FETCH THE ADDRESS OF THE USER RAB AND ERROR ROUTINE ])%
RAB = .BLOCK; ! GET RAB ADDRESS
ERRADR = .ERRORRETURN; ! AND USER ERROR ADDRESS
%([ PERFORM STANDARD SET-UP AND CHECK FOR READ ACCESS.
NOTE THAT IF ANY BIT IN THE FAC FIELD IS SET OTHER THAN
FB$PUT, THEN A $GET OPERATION IS LEGAL ])%
CALLRSETUP (PCI (AXGET+AXUPD+AXDEL+AXTRN)); ! SET UP PARAMETERS
%([ SET UP THE USER'S RBF FIELD ])%
IF ( RAB [ RABRBF ] = .RAB [ RABUBF ] ) LEQ MINUSERBUFF THEN USERERROR ( ER$UBF );
%([ DISPATCH TO THE PROPER ROUTINE FOR THIS FILE ORGANIZATION ])%
CASE FILEORG FROM 0 TO 3 OF
SET
[0]: %(ASCII)% CALLDOGETASCII;
[1]: %(SEQUNTIAL)% CALLDOGETSEQ;
[2]: %(RELATIVE)% CALLDOGETREL;
%IF INDX %THEN
[3]: %(INDEXED)% CALLDOGETIDX
%FI
TES; %(END OF CASE FILEORG)%
%([ PAD THE USER'S BUFFER, IF HE WANTS IT. ])%
IF ( CHKFLAG ( RAB [ RABROP ], ROPPAD ) ISON )
THEN
CALLPADBUFFER;
%([ INDICATE THAT THIS OPERATION WAS A SUCCESS ])%
SETSUCCESS; ! THIS WAS DONE CORRECTLY
%([ EXIT TO THE USER ])%
USEREXIT
END; %( OF $GET )%
! DOGETASCII
! ==========
! ROUTINE TO PROCESS THE $GET MACRO FOR ASCII FILES.
! THIS ROUTINE MUST INSURE THAT THE ASCII FILE
! IS CORRECTLY POSITIONED TO THE RECORD, AND THEN
! MUST TRANSFER THE DATA INTO THE USER'S BUFFER.
! INPUT:
! <NONE>
! OUTPUT:
! <NO STATUS RETURNED>
! NOTES:
!
! 1. ON AN ERROR, THIS ROUTINE WILL NOT EXIT TO THE
! MAIN $GET PROCESSOR, BUT WILL EXIT DIRECTLY TO
! THE USER.
GLOBAL ROUTINE DOGETASCII: NOVALUE =
BEGIN
EXTERNAL ROUTINE
FINDASC, ! LOCATE THE ASCII RECORD
GETASCII; ! MOVE THE RECORD
TRACE ('DOGETASCII');
%([ IF THE LAST OPERATION WAS NOT A $FIND, THEN WE
MUST INSURE THAT WE ARE POSITIONED AT THE CORRECT
RECORD. IF THE LAST OPERATION WAS A $FIND, THEN WE
ARE ALREADY AT THE TARGET RECORD. ])%
IF .RST [ RSTLASTOPER ] ISNT C$FIND
THEN %(LOCATE THE RECORD)%
CALLFINDASC;
%([ MOVE THE RECORD AND SET UP THE USER'S RSZ FIELD ])%
RAB [ RABRSZ ] = CALLGETASCII ( PCI ( TRUE ) ); ! MOVE THE DATA
RETURN
END; %(OF DOGETASCII)%
! DOGETSEQ
! ========
! ROUTINE TO ACTUALLY PERFORM THE $GET MACRO FOR SEQUENTIAL FILES.
! THIS ROUTINE MUST LOCATE THE CURRENT RECORD AND THEN
! TRANSFER ALL ITS DATA INTO THE USER'S BUFFER. IF THE LAST
! OPERATION WAS A $FIND, THEN WE ARE ALREADY AT THE CURRENT
! RECORD AND THE DATA CAN BE MOVED IMMEDIATELY. IF THE
! USER SPECIFIED LOCATE MODE FOR HIS $GET OPERATION, AND IF
! HE IS ONLY READING THE FILE, THEN WE WILL MERELY
! RETURN A POINTER TO THE RECORD IN HIS RBF FIELD INSTEAD
! OF ACTUALLY MOVING THE DATA TO HIS BUFFER.
! INPUT:
! <NONE>
! OUTPUT:
! <NO STATUS RETURNED>
! NOTES:
!
! 1. IF AN ERROR OCCURS, THIS ROUTINE WILL EXIT DIRECTLY
! TO THE USER.
!
! 2. IF THE LAST OPERATION WAS A $FIND, THEN IT IS
! ASSUMED THAT THE NRP IS NOT SET UP AND MUST BE
! COMPUTED BY THIS ROUTINE.
GLOBAL ROUTINE DOGETSEQ: NOVALUE =
BEGIN
EXTERNAL ROUTINE
FINDSEQ, ! LOCATE THE RECORD
GETREC; ! MOVE THE DATA
LOCAL
CRP; ! ADDRESS OF CURRENT RECORD
TRACE ('DOGETSEQ');
%([ IF THE LAST OPERATION WAS A $FIND, AND THIS IS A
$GET SEQUENTIAL, THEN WE ARE ALREADY LOCATED AT
THE TARGET RECORD. IF NOT, WE MUST LOCATE IT ])%
IF SEQADR %(SEQUENTIAL ACCESS)%
AND
( .RST [ RSTLASTOPER ] IS C$FIND )
THEN %(WE ALREADY HAVE A CURRENT RECORD)%
BEGIN
%([ FETCH THE CURRENT RECORD AND CHECK IT ])%
CRP = ( RAB [ RABRFA ] = .RST [ RSTDATARFA ] );
IF .CRP IS ZERO THEN USERERROR ( ER$CUR ); ! NO RP
%([ COMPUTE THE NRP VALUE BECAUSE THE $FIND OPERATION
DID NOT RESET IT ])%
RST [ RSTNRP ] = .CRP %(CURRENT RECORD)%
+
HEADERSIZE %(SIZE OF HEADER)%
+
.RST [ RSTRSZW ]; %(SIZE OF LAST REC)%
END %(OF IF LAST OPER WAS A $FIND)%
ELSE %(WE MUST FIND THE RECORD)%
CALLFINDSEQ;
%([ TRANSFER THE RECORD INTO THE USER'S BUFFER ])%
RAB [ RABRSZ ] = CALLGETREC;
RETURN
END; %(OF DOGETSEQ)%
! GETREC
! ======
! THIS ROUTINE PERFORMS THE ACTUAL "GET"ING OF A
! RECORD FROM A SEQUENTIAL OR RELATIVE FILE.
! ON INPUT, THE FILE PAGE MUST BE CORRECTLY MAPPED
! AND PAGPTR MUST POINT TO THE FIRST WORD
! OF THE HEADER. IF THE FILE IS OPENED
! IN LOCATE MODE AND THE RECORD DOESN'T SPAN
! THE PAGE BOUNDARIES, THEN THE RECORD IS NOT
! MOVED, A POINTER TO IT IS RETURNED.
! INPUT:
! <NONE>
! OUTPUT:
! # OF BYTES MOVED
! GLOBALS USED:
! GTBYTE
! MOVEREC
! NOTES:
!
! 1. THE FOLLOWING MACROS ARE USED WITHIN THIS ROUTINE. THESE
! ARE DEFINED IN "BUFFER.REQ":
!
! CURRENTWINDOW
! CURRENTFILEPAGE
!
! 2. ON INPUT TO THIS ROUTINE, THE FOLLOWING FIELDS ARE
! ASSUMED TO SET UP:
! RSTRSZ SIZE IN BYTES OF RECORD
! RSTRSZW SIZE IN WORDS OF RECORD
GLOBAL ROUTINE GETREC =
BEGIN
LOCAL
RECORDPTR,
WORDCOUNT,
BYTECOUNT,
BYTESIZE,
BYTESWORD,
USERPTR,
CRP,
BYTEADR,
USERBUFFSIZE;
REGISTER
TEMPAC; ! USED FOR TEMP CALCULATIONS
MAP
RECORDPTR: FORMAT;
EXTERNAL ROUTINE
GTBYTE,
MOVEREC;
TRACE ('GETREC');
%([ GET THE POINTER TO THE CURRENT RECORD ])%
RECORDPTR = .RST [ RSTPAGPTR ];
%([ GET VARIOUS VALUES ])%
BYTESIZE = .FST [ FSTBSZ ]; ! FILE BYTE SIZE
BYTECOUNT = .RST [ RSTRSZ ]; ! RECORD BYTE COUNT
WORDCOUNT = .RST [ RSTRSZW ]; ! RECORD WORD COUNT
%([ IF THE USER SPECIFIED THAT HE WANTED LOCATE MODE,
AND IF HE IS ONLY READING THE FILE (IF HE IS WRITING
IT, LOCATE MODE IS DISABLED), THEN WE MUST CHECK TO
SEE IF THE RECORD SPANS PAGE BOUNDARIES. ])%
IF LOCATEMODE AND INPUTMODE
THEN %( CHECK FOR SPANNING RECORD )%
BEGIN
IF ( .RECORDPTR [OFSET] %( OFFSET INTO CURRENT PAGE )%
+ HEADERSIZE %( PLUS SIZE OF HEADER )%
+ .WORDCOUNT ) %( PLUS RECORD LENGTH )%
LEQ PAGESIZE %( IS LESS THAN ONE PAGE )%
THEN %( THE RECORD DOESN'T SPAN PAGES )%
BEGIN
RAB [ RABRBF ] = .RECORDPTR + HEADERSIZE; ! CONTRUCT POINTER TO OUR BUFFER
RETURN .BYTECOUNT; ! RETURN
END %( OF IF RECORD DOESN'T SPAN )%
END; %( OF IF LOCATEMODE )%
%([ AT THIS POINT, EITHER WE ARE IN MOVE MODE OR
THE RECORD SPANS PAGES. IN EITHER CASE, THE
RECORD WILL BE MOVED INTO THE USER'S BUFFER ])%
RECORDPTR = .RECORDPTR + HEADERSIZE; ! COMPUTE START OF DATA
%([ CHECK IF DATA PORTION OF RECORD BEGINS ON NEXT PAGE )%
%([ NOTE THAT THIS NEXT CHECK MAKES NO ASSUMPTION ABOUT
THE SIZE OF THE RECORD HEADER. IF THE ASSUMPTION IS
MADE THAT THE HEADER IS ALWAYS 1 WORD LONG, THEN THIS
CHECK CAN BE MADE SIMPLER AND FASTER ])%
IF .RECORDPTR [ PAGE ] ISNT .CURRENTWINDOW THEN ! DID WE GO OVER THE FILE PAGE?
BEGIN
BYTEADR = ( .CURRENTFILEPAGE + 1 ) ^ P2W; ! FIND BYTE OF NEXT FILE PAGE
CALLGTBYTE ( %(RFA ADDR)% LCI (BYTEADR),
%(NO ABORT)% PCI (FALSE));
RECORDPTR = .RST [ RSTPAGPTR ] ! GET THE UPDATED DATA POINTER
END; %( IF RECORD DATA BEGINS ON NEXT PAGE )%
%([ THE DATA PORTION OF THE RECORD IS NOW
IN THE WINDOW AND PAGPTR POINTS TO IT.
WE MUST DETERMINE IF THE RECORD IS TOO BIG
FOR THE USER'S BUFFER. ])%
USERBUFFSIZE = .RAB [ RABUSZ ];
IF .WORDCOUNT GTR .USERBUFFSIZE
THEN
%( RECORD CANT FIT IN BUFFER )%
BEGIN %( TO COMPUTE HOW MUCH OF IT WILL FIT )%
USRSTS = ER$RTB; ! SET "PARTIAL RECORD" CODE
USRSTV = .BYTECOUNT; ! RETURN SIZE OF RECORD
BYTECOUNT = (36 / .BYTESIZE ) * .USERBUFFSIZE ! USER-BUFFER
END; %( OF CHECKING FOR PARTIAL RECORD )%
%([ AT THIS POINT, WE HAVE THE FOLLOWING VALUES:
BYTECOUNT = # OF BYTES TO BE TRANSFERRED
RECORDPTR = ADDRESS OF 1ST DATA WORD IN RECORD
WE CAN NOW MOVE THE RECORD INTO USERS BUFFER ])%
USERPTR = .RAB [ RABUBF ]; ! GET ADRESS OF USER BUFFER
IF CALLMOVEREC (LCI (RECORDPTR), %( FROM HERE... )%
LCI (USERPTR), %( TO HERE )%
PCI (FALSE), %( THIS IS A GET )%
LCI (BYTECOUNT), %( BYTES TO MOVE )%
LCI (BYTESIZE)) %( SIZE OF EACH BYTE )%
IS FALSE THEN RMSBUG ( MSGFAILURE ); ! ROUTINE FAILURE
%([ IF THE FILE IS ONLY BEING READ, THEN WE CAN
IMMEDIATELY UNLOCK THE CURRENT RECORD ])%
IF INPUTMODE
THEN IF DATALOCKED
THEN
UNLOCK ( RST [ RSTDATARFA ] ); ! UNLOCK CURRENT RECORD
%([ RETURN THE SIZE OF THE RECORD MOVED ])%
RETURN .BYTECOUNT ! RETURN # OF BYTES MOVED
END; %( OF GETREC )%
! DOGETREL
! ========
! ROUTINE TO ACTUALLY PERFORM THE $GET MACRO FOR SEQUENTIAL FILES.
! THIS ROUTINE MUST LOCATE THE CURRENT RECORD AND THEN
! TRANSFER ALL ITS DATA INTO THE USER'S BUFFER. IF THE LAST
! OPERATION WAS A $FIND, THEN WE ARE ALREADY AT THE CURRENT
! RECORD AND THE DATA CAN BE MOVED IMMEDIATELY. IF THE
! USER SPECIFIED LOCATE MODE FOR HIS $GET OPERATION, AND IF
! HE IS ONLY READING THE FILE, THEN WE WILL MERELY
! RETURN A POINTER TO THE RECORD IN HIS RBF FIELD INSTEAD
! OF ACTUALLY MOVING THE DATA TO HIS BUFFER.
! INPUT:
! <NONE>
! OUTPUT:
! <NO STATUS RETURNED>
! NOTES:
!
! 1. IF AN ERROR OCCURS, THIS ROUTINE WILL EXIT DIRECTLY
! TO THE USER.
!
! 2. IF THE LAST OPERATION WAS A $FIND, THEN IT IS
! ASSUMED THAT THE NRP IS NOT SET UP AND MUST BE
! COMPUTED BY THIS ROUTINE.
GLOBAL ROUTINE DOGETREL: NOVALUE =
BEGIN
EXTERNAL ROUTINE
FINDREL, ! LOCATE THE RECORD
GETREC; ! MOVE THE DATA
LOCAL
CRP; ! ADDRESS OF CURRENT RECORD
TRACE ('DOGETREL');
%([ IF THE LAST OPERATION WAS A $FIND, AND THIS IS A
$GET SEQUENTIAL, THEN WE ARE ALREADY LOCATED AT
THE TARGET RECORD. IF NOT, WE MUST LOCATE IT ])%
IF SEQADR %(SEQUENTIAL ACCESS)%
AND
( .RST [ RSTLASTOPER ] IS C$FIND )
THEN %(WE ALREADY HAVE A CURRENT RECORD)%
BEGIN
%([ FETCH THE CURRENT RECORD AND CHECK IT ])%
CRP = ( RAB [ RABRFA ] = .RST [ RSTDATARFA ] );
IF .CRP IS ZERO THEN USERERROR ( ER$CUR ); ! NO RP
%([ COMPUTE THE NRP VALUE BECAUSE THE $FIND OPERATION
DID NOT RESET IT ])%
RST [ RSTNRP ] = .CRP + 1 ! BUMP RP
END %(OF IF LAST OPER WAS A $FIND)%
ELSE %(WE MUST FIND THE RECORD)%
CALLFINDREL;
%([ TRANSFER THE RECORD INTO THE USER'S BUFFER ])%
RAB [ RABRSZ ] = CALLGETREC;
RETURN
END; %(OF DOGETREL)%
! DOGETIDX
! ========
! ROUTINE TO PERFORM THE PRIMARY PROCESSING FOR THE $GET MACRO
! FOR AN INDEXED FILE. IF THE LAST OPERATION WAS A $FIND,
! THEN THE CURRENT RECORD (DATARFA) POSITION IS ALREADY
! SET UP AND WE CAN DIRECTLY ACCESS THE RECORD. IF NOT,
! WE MUST CALL FINDIDX TO LOCATE THE TARGET RECORD.
! INPUT:
! <NONE>
! OUTPUT:
! <NO STATUS RETURNED>
GLOBAL ROUTINE DOGETIDX: NOVALUE =
BEGIN
%IF INDX %THEN
LOCAL
RECDESC: FORMATS[ RDSIZE ], ! RECORD DESCRIPTOR PACKET
DATABD: FORMATS[ BDSIZE ], ! BUCKET DESCRIPTOR
KEYOFREFERENCE, ! RP KRF
RECORDPTR: POINTER, ! PTR TO CURRENT RECORD
SAVEDKDB; ! SAVE THE ADDRESS OF CURRENT KEY
REGISTER TEMPAC;
EXTERNAL ROUTINE
FBYRFA, ! LOCATE RECORD BY ITS RFA
SETNRP, ! SET UP THE NEXT-RECORD-POINTER
PUTBKT, ! RELEASE THE CURRENT BUCKET
GETKDB,
GETIDX, ! READ A RECORD FROM INDEXED FILE
FINDIDX; ! FIND THE TARGET RECORD
TRACE ('DOGETIDX');
%([ FOR A $FIND-$GET SEQUENCE, WE MUST LOCATE THE
CURRENT RECORD BY ITS RFA ADDRESS. ])%
IF SEQADR AND ( .RST [ RSTLASTOPER ] IS C$FIND )
THEN %(WE MUST LOCATE THE RECORD)%
BEGIN
%([ WE MUST NOW FETCH THE RP RFA AND STORE IT IN THE REC
DESCRIPTOR. NOTE THAT THIS RFA IS OF THE USER
DATA RECORD. THUS, IF THE $FIND WAS DONE ON A
SECONDARY KEY, WE HAVE NO RFA FOR THE SIDR SO WE
MUST MAKE SURE THAT WE DON'T USE THE UDR RFA AS THE
NRP POINTER BECAUSE THE NRP MIGHT REPRESENT THE SIDR
RFA. ])%
IF (TEMPAC = .RST [ RSTDATARFA ]) IS ZERO ! GET UDR RFA
THEN USERERROR ( ER$CUR ); ! NO CURRENT RECORD
%([ IF THE FIND WAS BY SECONDARY KEY, DONT USE THIS VALUE ])%
IF .RST [ RSTRPREF ] ISNT REFPRIMARY THEN TEMPAC = ZERO;
RECDESC [ RDRFA ] = .TEMPAC;
%([ NOW, SET UP THE SIDR-ELEMENT OFFSET WHICH WE KEEP
IN THE RST. WE WILL NEED IT IN "SETNRP". ])%
RECDESC [ RDSIDRELEMENT ] = .RST [ RSTRPSIDR ]; ![%44] CONV TENTA SIDR ELEM TO ACTUAL 1
%([ LOCATE THE CURRENT RECORD ])%
KEYOFREFERENCE = .RST [ RSTRPREF ]; ! USE RP KEY-OF-REFERENCE
IF (KDB = CALLGETKDB ( LCI ( KEYOFREFERENCE ) )) IS FALSE
THEN RMSBUG ( MSGKDB );
FETCHCURRENTBKT ( DATABD ); ! GET THE CURRENT BUCKET
IF NULLBD ( DATABD ) THEN RMSBUG ( MSGBKT ); ! CHECK IT OUT
%([ GET THE POINTER TO THE CURRENT RECORD ])%
RECORDPTR = ( RECDESC [ RDRECPTR ] = .RST [ RSTPAGPTR ] );
%([ WE MUST NOW SET UP THE ADDRESS OF THE RRV OF THIS
RECORD, SINCE IT IS NOT KEPT INTERNALLY (ONLY THE
NRP RRV ADDRESS IS MAINTAINED IN THE RST).
TO DO THIS, WE MUST ACTUALLY ACCESS THE RECORD ])%
RECDESC [ RDRRV ] = .RECORDPTR [ DRRRVADDRESS ]
END %(OF IF LAST OPER WAS A $FIND)%
ELSE %(WE MUST LOCATE THE RECORD)%
CALLFINDIDX ( %(RD)% LCT ( RECDESC ),
%(BKT)% LCT ( DATABD ) );
%([ WE HAVE NOW LOCATED THE RECORD. WE MUST MOVE IT INTO
THE USER'S BUFFER, OR SET UP A POINTER TO IT IF LOCATE
MODE IS BEING USED. ])%
SAVEDKDB = .KDB; ! SAVE CURRENT KEY
RAB [ RABRSZ ] = CALLGETIDX ( %(RD)% LCT ( RECDESC ),
%(BKT)% LCT ( DATABD ) );
KDB = .SAVEDKDB; ! RESTORE CURRENT KEY
%([ SET THE RFA IN THE USER'S FAB ])%
RAB [ RABRFA ] = .RECDESC [ RDRRV ];
%([ WE CAN NOW UPDATE THE INTERNAL DATA BASE BY ADJUSTING
THE NEXT-RECORD-POINTER (NRP) VALUES.])%
CALLSETNRP ( %(RECORD DESC)% LCT ( RECDESC ),
%(BUCKET)% LCT ( DATABD ) );
%([ IF THE FILE IS READ-ONLY, THEN UNLOCK THE CURRENT BUCKET ])%
IF INPUTMODE THEN RELEASCURENTBKT;
RETURN
%FI
END; %(OF DOGETIDX)%
! PADBUFFER
! =========
! ROUTINE TO PERFORM USER BUFFER PADDING IF THE RB$PAD OPTION
! IS SPECIFIED ON A $GET. THIS ROUTINE IS CALLED ONLY
! AFTER THE ENTIRE RECORD (OR AS MUCH OF IT AS WOULD FIT)
! IS MOVED INTO THE USER'S RECORD BUFFER. THE REST OF THE
! BUFFER IS THEN PADDED WITH THE CHARACTER SPECIFIED IN
! THE "PAD" FIELD OF THE RAB.
! INPUT:
! <NONE>
! OUTPUT:
! <NO STATUS RETURNED>
! IMPLICIT INPUT FIELDS:
!
! RAB:
! RBF ADDRESS OF USER RECORD BUFFER
! UBF ADDRESS OF USER BUFFER
! RSZ SIZE OF USER RECORD
!
! ROUTINES CALLED:
! <NONE>
! NOTES:
!
! 1. THIS ROUTINE SHOULD OBVIOUSLY NOT PERFORM ITS
! FUNCTION IF THE USER IS OPERATING IN LOCATE MODE
! (AND THE RECORD WAS ACTUALLY "LOCATED" IN THE RMS-20
! FILE BUFFER). THUS, IF RBF ISNT UBF, THIS ROUTINE WILL
! IMMEDIATELY EXIT.
!
! 2. **THIS ROUTINE HAS NOT BEEN OPTIMIZED**
! TO SPEED IT UP, THE BYTES IN THE CURRENT WORD
! CAN BE DEPOSITED, THEN EACH SUCCESSIVE WORD CAN
! BE STORED WITH A FULL WORD OF BYTES UNTIL THE
! BUFFER IS FULL.
GLOBAL ROUTINE PADBUFFER: NOVALUE =
BEGIN
REGISTER
BUFFERBYTEPTR, ! PTR TO USER BUFFER
AC0 = 0, ! EXTEND AC BLOCK
AC1 = 1,
AC2 = 2,
AC3 = 3,
AC4 = 4;
LOCAL
EXTENDBLOCK: FORMATS[ EXTBLKSIZE ], ! USED FOR OP-CODE OF EXTEND INSTR.
BYTESLEFT; ! # OF BYTES LEFT IN BUFFER
TRACE ('PADBUFFER');
%([ IF THE USER IS IN LOCATE MODE, THEN WE WILL EXIT WITHOUT
DOING ANYTHING. WE KNOW THAT HE IS IN LOCATE MODE IF
HIS RBF ADDRESS IS NOT THE SAME AS HIS UBF ADDRESS. ])%
IF ( BUFFERBYTEPTR = .RAB [ RABRBF ] ) ISNT .RAB [ RABUBF ]
THEN %(DONT PAD OUR OWN BUFFER)%
RETURN ;
%([ COMPUTE THE SIZE OF HIS BUFFER IN BYTES ])%
BYTESLEFT = 36 / .FST [ FSTBSZ ]; ! # OF BYTES PER WORD
BYTESLEFT = ( .BYTESLEFT * .RAB [ RABUSZ ] ) - .RAB [ RABRSZ ];
%([ FORM A POINTER TO THE LAST BYTE IN THE BUFFER ])%
BUFFERBYTEPTR = POINT ( .BUFFERBYTEPTR, 36, .FST [ FSTBSZ ] );
AC4 = .RAB [ RABRSZ ]; ! GET RECORD SIZE
ADJBP ( AC4, BUFFERBYTEPTR ); ! POINTER TO END OF BUFFER
%([ SET UP EXTEND OP-CODE BLOCK ])%
EXTENDBLOCK [ 0, WRD ] = MOVSLJ ^ 27; ! MOVE LEFT OP-CODE
EXTENDBLOCK [ 1, WRD ] = .RAB [ RABPAD ]; ! GET PAD CHAR
EXTENDBLOCK [ 2, WRD ] = ZERO; ! NO FILL
%([ FILL IN THE AC BLOCK ])%
AC0 = ZERO; ! NO SOURCE STRING
AC1 = ZERO; ! NO BYTE POINTER
AC3 = .BYTESLEFT; ! # OF BYTES IN BUFFER
%([ NOW, DO THE BUFFER PADDING...NOTE THAT THERE IS
CURRENTLY NO CHECK TO SEE IF THIS INSTRUCTION
FAILED. HOWEVER, THE IFSKIP MUST PERFORM SOME
DUMMY OPERATION OR BLISS WILL OPTIMIZE OUT THE
SKIP AND THE STACK WILL NOT BE ADJUSTED PROPERLY. ])%
IF NOT EXTEND ( AC0, EXTENDBLOCK )
THEN
TRUE
ELSE
FALSE;
RETURN
END; %(OF PADBUFFER)%
! GETIDX
! ======
! ROUTINE TO READ A RECORD FROM AN INDEXED FILE.
! THIS ROUTINE IS CALLED ONLY AFTER THE TARGET
! RECORD HAS BEEN LOCATED AND ITS ADDRESS HAS BEEN
! ESTABLISHED. THIS ROUTINE WILL THEN COMPUTE HOW
! MUCH (IF ANY) OF THE RECORD IS TO BE MOVED, AND
! WILL MOVE THE RECORD INTO THE USER'S BUFFER.
!
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! RFA RFA OF CURRENT RECORD
! RECPTR ADDRESS (IN BUFFER) OF CURRENT RECORD
! RRV RRV ADDRESS OF CURRENT RECORD
!
! DATABD BKT DESCRIPTOR OF DATA BUCKET
!
! OUTPUT:
! VALUE RETURNED = SIZE IN BYTES OF RECORD (ACTUAL BYTES MOVED)
GLOBAL ROUTINE GETIDX ( RECDESC, DATABD ) =
BEGIN
%IF INDX %THEN
ARGUMENT (RECDESC,BASEADD); ! RECORD DESCRTIPTOR
ARGUMENT (DATABD,BASEADD); ! BUCKET DESCRIPTOR
MAP
RECDESC: POINTER,
DATABD: POINTER;
REGISTER
TEMPAC, ! TEMPORARY AC
BYTESPERWORD, ! # OF BYTES PER WORD FOR THIS FILE
RECORDPTR: POINTER; ! PTR TO THE TARGET RECORD
EXTERNAL ROUTINE
PUTBKT; ! RELEASE A BUCKET
LOCAL
RECORDSIZE, ! SIZE IN BYTES OF THIS RECORD
WORDSTOMOVE, ! # OF WORDS IN RECORD
EXTRABYTES, ! # OF LEFT-OVER BYTES
BUFFERSIZE, ! SIZE OF USER'S BUFFER
FULLWORDS, ! TOTAL # OF WORDS IN RECORD
BUFFERPTR: POINTER; ! PTR TO USER'S BUFFER
TRACE ('GETIDX');
CHECKEXACTCOUNT;
%([ ON ENTRY, WE SHOULD HAVE THE ADDRESS OF THE RECORD
IN THE RECORD DESCRIPTOR. LET'S GET IT AND HAVE A LOOK. ])%
RECORDPTR = .RECDESC [ RDRECPTR ];
LOOKAT (' READING REC AT: ', RECORDPTR);
%([ SET UP THE PRIMARY KDB BECAUSE WE ARE ALWAYS MOVING
A PRIMARY USER DATA RECORD ])%
KDB = .FST [ FSTKDB ]; ! GET UDR KDB
%([ WE CAN NOW GET THE SIZE OF THIS RECORD, IN BYTES ])%
IF FIXEDLENGTH
THEN
RECORDSIZE = .FST [ FSTMRS ]
ELSE
RECORDSIZE = .RECORDPTR [ DRRECSIZE ];
%([ BUMP THE POINTER PAST THE RECORD HEADER ])%
INC ( RECORDPTR, .KDB [ KDBHSZ ] );
%([ IF THIS IS LOCATE MODE, AND THE USE IS ONLY READING THE
FILE, THEN WE CAN SIMPLY SET UP A POINTER TO THE RECORD
IN OUR BUFFER. ])%
IF LOCATEMODE
THEN IF INPUTMODE
THEN %(WE CAN PASS BACK A POINTER)%
BEGIN
RTRACE (%STRING(' LOCATE MODE FOUND...',%CHAR(13),%CHAR(10)));
RAB [ RABRBF ] = .RECORDPTR; ! STORE RECORD ADDR
RETURN .RECORDSIZE
END; %(OF IF LOCATEMODE)%
%([ EITHER THIS IS MOVE MODE, OR THE USER IS NOT IN
READ-ONLY ACCESS. IN EITHER CASE, WE WILL MOVE
THE RECORD INTO THE USER'S BUFFER AREA. ])%
%([ COMPUTE THE SIZE IN WORDS OF THIS RECORD ])%
BYTESPERWORD = 36 / .FST [ FSTBSZ ]; ! # OF BYTES IN EACH WORD
WORDSTOMOVE = .RECORDSIZE / .BYTESPERWORD; ! # OF FULL WORDS
EXTRABYTES = .RECORDSIZE - ( .WORDSTOMOVE * .BYTESPERWORD );
%([ LET'S SEE ALL THIS ])%
LOOKAT (' WORDS-TO-MOVE: ', WORDSTOMOVE);
LOOKAT (' EXTRA-BYTES: ', EXTRABYTES );
%([ LET'S FIND OUT IF THE ENTIRE RECORD WILL FIT IN THE BUFFER ])%
FULLWORDS = .WORDSTOMOVE;
IF .EXTRABYTES ISNT ZERO
THEN %(WE CAN FIT ONE MORE WORD IN)%
INC ( FULLWORDS, 1 );
%([ GET THE SIZE OF THE USER'S BUFFER ])%
BUFFERSIZE = .RAB [ RABUSZ ];
IF .BUFFERSIZE LSS .FULLWORDS
THEN %(THE RECORD WON'T FIT)%
BEGIN
RTRACE (%STRING(' RECORD CANT FIT...',%CHAR(13),%CHAR(10)));
EXTRABYTES = ZERO; ! CHOP OFF EXTRA
WORDSTOMOVE = .BUFFERSIZE; ! MOVE THIS MUCH
USRSTS = ER$RTB; ! PARTIAL RECORD
USRSTV = .RECORDSIZE ! RETURN FULL SIZE
END; %( OF IF RECORD WOULDNT FIT)%
%([ FORM A PTR TO THE USER'S BUFFER ])%
BUFFERPTR = .RAB [ RABUBF ];
%([ MOVE THE MAIN BODY OF THE RECORD ])%
IF .WORDSTOMOVE ISNT ZERO
THEN
MOVEWORDS ( %(FROM)% .RECORDPTR,
%(TO)% .BUFFERPTR,
%(SIZE)% .WORDSTOMOVE );
%([ BUMP OUR POINTERS AND DECREMENT THE SIZE OF THE BUFFER ])%
INC ( BUFFERPTR, .WORDSTOMOVE );
INC ( RECORDPTR, .WORDSTOMOVE );
DEC ( BUFFERSIZE, .WORDSTOMOVE );
%([ WE CAN NOW MOVE THE SLACK BYTES ])%
IF .EXTRABYTES ISNT ZERO
THEN
BEGIN
%([ WE WILL CREATE A BYTE POINTER WHICH HAS A
BYTE SIZE OF ( FILE BYTE SIZE * # OF BYTES TO MOVE).
THIS AVOIDS THE NECESSITY OF USING A ILDB LOOP
TO MOVE A SMALL NUMBER OF BYTES. ])%
TEMPAC = .FST [ FSTBSZ ] * .EXTRABYTES; ! # OF BITS TO MOVE
TEMPAC = ( .TEMPAC ^ 6 ) + NULLBP; ! FORM LH OF PTR
RECORDPTR<LH> = .TEMPAC;
BUFFERPTR<LH> = .TEMPAC; ! STORE IN POINTERS
LOOKAT (' RECORD-PTR: ', RECORDPTR);
LOOKAT (' BUFF-PTR: ', BUFFERPTR );
REPLACEI ( BUFFERPTR, SCANI ( RECORDPTR ))
END; %(OF IF THERE WERE EXTRA BYTES)%
%([ COMPUTE THE SIZE OF THE RECORD WE MOVED ])%
RECORDSIZE = ( .WORDSTOMOVE * .BYTESPERWORD ) + .EXTRABYTES;
RETURN .RECORDSIZE
%FI
END; %(OF GETIDX)%
END
ELUDOM