Trailing-Edge
-
PDP-10 Archives
-
704rmsf2
-
10,7/rms10/rmssrc/rmsrsu.b36
There are 6 other files named rmsrsu.b36 in the archive. Click here to see a list.
MODULE RSETUP =
BEGIN
GLOBAL BIND RSETV = 1^24 + 0^18 + 4; !EDIT DATE: 21-JUN-77
%([
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
FUNCTION: THIS MODULE IS USED ONLY TO INITIATE THE PROCESSING
OF A RECORD OPERATION ( E.G. GET, PUT,... ). IT IS CALLED
AT THE BEGINNING OF EACH SUCH OPERATION IN ORDER TO CHECK
FOR ERRORS AND TO SET UP THE RELEVANT DATA STRUCTURE POINTERS.
IT EXISTS AS A SELF-CONTAINED MODULE TO ALLOW IT TO BE PLACED
ANYWHERE IN ORDER TO MINIMIZE PAGE FAULTS.
AUTHOR: S. BLOUNT
REVISION HISTORY:
EDIT DATE WHO PURPOSE
==== ==== ==== =======
1 21-JUL-76 SB ADD FSETUP /SB
2 22-DEC-76 SB CHANGE ER$IOP TO ER$FAC
3 16-MAY-77 SB DELETE CHECK FOR KBF ERROR
4 21-JUN-77 SB MAKE RSETUP NOT CHECK ERRORS IF FACBIT=TRUE
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
***** END OF REVISION HISTORY *****
])%
%([ EXTERNAL DECLARATIONS ])%
EXTERNAL
CRASH,
DUMP,
GMEM,
GPAGE,
PMEM,
PPAGE;
REQUIRE 'RMSREQ';
EXTDECLARATIONS;
! RSETUP
! ======
! THIS ROUTINE PERFORMS ALL SET UP REQUIRED FOR EACH
! RECORD-RELATED VERB.
! INPUT:
! FACBIT = FILE-ACCESS BIT TO CHECK
! (IF FACBIT = TRUE, THEN ANY FAC VALUE IS TO
! BE ACCEPTED, AND NO ERROR CHECKS ON RAC, ETC.
! ARE TO BE DONE)
! OUTPUT:
! <NO VALUE RETURNED>
!
! NOTES:
!
! 1. ON AN ERROR, THIS ROUTINE WILL EXIT DIRECTLY TO USER.
%([
THIS ROUTINE CHECKS THE FOLLOWING THINGS:
1. RAB MUST BE PROPERLY STRUCTURED
A. BLOCK-CODE VALID
2. RECORD-ACCESS VALUE IS LEGAL FOR FILE AND DEVICE
3. OPERATION WAS GIVEN IN FAC FIELD
4. UNUSED OPTIONS ARE 0
5. KBF NOT 0 IF KEY ADDRESSING
6. RFA ADDRESSING IS USED ONLY FOR RMS DISK FILES
])%
GLOBAL ROUTINE RSETUP ( FACBIT ): NOVALUE =
BEGIN
ARGUMENT (FACBIT,VALUE); ! THIS BIT MUST BE SET IN FAC FIELD
REGISTER
RABPTR, ! FOR SPEED, WE WILL USE REGISTERS FOR THESE BLOCKS
ERRORCODE, ! KEEP CODE HERE
FSTPTR,
RSTPTR;
LABEL LOOP;
MAP
RABPTR: POINTER,
FSTPTR: POINTER,
RSTPTR: POINTER;
TRACE ('RSETUP');
ERRORCODE = ZERO; ! CLEAR THIS VARIABLE
ERRORBLOCK (RAB); ! ALL ERRORS GO TO RAB
RABPTR = .RAB; ! SET UP REGISTERS
FAB = .RAB [RABFAB]; !GET FAB PTR FROM RAB
FSTPTR = .FAB [FABIFI]; !GET FST ADDR FROM FAB
IF .FAB EQL 0 OR .FST EQL 0 ! FILE NOT OPEN?
THEN USERERROR (ER$IFI); ! FRAID SO
IF .FSTPTR [FLINK] EQL .FSTPTR !ANYTHING CONNECTED?
THEN USERERROR (ER$ISI); ! NOT CONNECTED
RSTPTR = .RABPTR [ RABISI ]; ! GET ISI
FST = .FSTPTR; ! STORE IS ALSO IN GLOBAL
RST = .RSTPTR;
%([ SET UP THE POINTER TO THE CURRENT BUCKET DESCRIPTOR IN THE RST ])%
CBD = .RST + RSTCBDOFFSET;
%([ BEGINNING OF BLOCK WHICH WILL CHECK FOR ERRORS.
THE FIRST ERROR WHICH IS FOUND WILL CAUSE AN EXIT
TO THE END OF THE BLOCK ])%
LOOP: BEGIN
IF .RABPTR [ BLOCKLENGTH ] LSS V1RABSIZE THEN ( LEAVE LOOP WITH ERRORCODE = ER$BLN );
IF .RABPTR [ BLOCKTYPE ] ISNT RABCODE THEN (LEAVE LOOP WITH ERRORCODE = ER$RAB );
IF (.FSTPTR [ BLOCKTYPE ] ISNT FSTCODE)
OR
(.RSTPTR [ BLOCKTYPE ] ISNT RSTCODE)
THEN ( LEAVE LOOP WITH ERRORCODE = ER$ISI); ! BAD ISI
%([ IF THIS IS A $DISCONNECT (I.E., FACBIT=TRUE),
THEN WE DON'T WANT TO DO ANY CHECKS ON THE CONTENT
OF THE RAB FIELDS SUCH AS RAC, ETC. ])%
IF .FACBIT ISNT TRUE
THEN %(DO THESE ERROR CHECKS)%
BEGIN
IF .RABPTR [ RABRAC ] GTR RACRFA
THEN ( LEAVE LOOP WITH ERRORCODE = ER$RAC);
%([ CHECK THAT FILE IS NOT IN AN UNDEFINED STATE ])%
%([ **THIS CODE IS DIS-ABLED CURRENTLY***])%
! IF ( .FST [ FSTFLAGS ] AND FLGUNDEF ) ISON
! THEN
! ( LEAVE LOOP WITH ERRORCODE _ ERUDF );
%([ THIS NEXT CHECK WILL BE ELIMINATED FOR NOW ( SPEED ) ])%
! IF (.RABPTR [ RABROP ] AND ROPUNUSED) ISNT ZERO
! THEN ( LEAVE LOOP WITH ERRORCODE _ ERIRO);
IF (FILEACCESS AND .FACBIT) IS ZERO
THEN ( LEAVE LOOP WITH ERRORCODE = ER$FAC); ! CHECK FOR FAC BIT
CASE RECORDACCESS FROM 0 TO 2 OF ! CHECK VARIOUS THINGS
SET
[0]: %(SEQ)% 0; ! NO CHECKS HERE
[1]: %(KEY)% BEGIN ! CHECK KEY BUFFER
IF FILEORG LSS ORGREL THEN ( LEAVE LOOP WITH ERRORCODE = ER$RAC);
END; %( OF CASE KEY )%
[2]: %(RFA)% BEGIN
IF (DASD IS FALSE)
OR
(ASCIIFILE)
THEN ( LEAVE LOOP WITH ERRORCODE = ER$RAC)
END %( OF CASE RFA )%
TES %( END OF CASE RECORDACCESS )%
END %(OF IF .FACBIT ISNT TRUE)%
END; %(OF BLOCK USED TO CHECK FOR ERRORS)%
%([ DID WE FIND AN ERROR? ])%
IF .ERRORCODE ISNT ZERO
THEN USERERROR (.ERRORCODE);
%([ CHECK TO SEE IF THE LAST OPERATION WAS SUCCESSFUL ])%
IF NOT SUCCESS THEN RST [ RSTLASTOPER ] = ZERO; ! IF NOT, DONT REMEMBER IT
CLEARSUCCESS; ! CLEAR FLAG
RETURN
END; %( OF RSETUP )%
! FSETUP
! ======
! ROUTINE TO SET UP FOR FILE OPERATIONS.
! THIS ROUTINE IS USED FOR FILE OPERATIONS TO SET UP
! POINTERS TO THE RELEVANT INTERNAL BLOCKS, AND TO
! CHECK THAT THE USER IS ACCESSING A VALID FILE, ETC.
! THIS ROUTINE DOES NOT CHECK IF THE FILE-STATUS TABLE
! IS CORRECT, BECAUSE $OPEN/$CREATE DO NOT REQUIRE THIS.
! INPUT:
! <NONE>
! OUTPUT:
! <NO STATUS RETURNED>
GLOBAL ROUTINE FSETUP: NOVALUE =
BEGIN
REGISTER
ERRORCODE;
TRACE ( 'FSETUP');
ERRORBLOCK ( FAB ); ! ERRORS GO TO THE FAB
ERRORCODE = ZERO; ! INIT ERROR CODE
%([ CHECK IF THIS IS A FAB ])%
IF .FAB [ BLOCKTYPE ] ISNT FABCODE THEN ERRORCODE = ER$FAB;
IF .FAB [ BLOCKLENGTH ] ISNT V1FABSIZE THEN ERRORCODE = ER$BLN;
IF ( FST = .FAB [ FABIFI ] ) IS ZERO THEN ERRORCODE = ER$IFI;
%([ CHECK FOR ERRORS ])%
IF .ERRORCODE ISNT ZERO
THEN
BEGIN
USRSTS = .ERRORCODE; ! STORE ERROR CODE
USEREXIT ! RETURN TO USER
END; %( OF IF ERRORCODE IS NON-ZERO)%
RETURN
END; %( OF FSETUP)%
END
ELUDOM