Trailing-Edge
-
PDP-10 Archives
-
704rmsf2
-
10,7/rms10/rmssrc/rmscnc.b36
There are 6 other files named rmscnc.b36 in the archive. Click here to see a list.
MODULE CONECT =
BEGIN
GLOBAL BIND CNCTV = 1^24 + 0^18 + 19; !EDIT DATE: 12-OCT-77
%([
FUNCTION: THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
THE $CONNECT AND $DISCONNECT MACROS IN 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
======= ========
$CONNECT PROCESSOR FOR $CONNECT MACRO
$DISCONNECT PROCESSOR FOR $DISCONNECT MACRO
DCNTRAB DISCONNECT A SINGLE RAB STREAM
REVISION HISTORY:
PRODUCT LOCAL
EDIT EDIT DATE PURPOSE
==== ==== ==== ========
- 1 7-19 /SB ADD DISCONNECT FOR IDX FILES
- 2 7-19 /SB RESET FILE PTR FOR ASCII FILES ON CONNECT
- 3 7-21 /SB CHECK FOR ONLY 1 CONNECT RAB ON ASCII FILE
- AND CLEAR NEWFILE BIT ON DISCONNECT
- 4 7-26 /SB TAKE OUT LAST EDIT
- 5 8-6 /JK APPENDOPTION IS ILLEGAL FOR REL. AND IDX. FILES
- 6 8-12 /JK 'SETSUCCESS' FOR '$CONNECT'.
- 7 8-27 /JK GIVE 'ER$PEF' FOR ATTEMPT TO APPEND TO REL/IDX FILE
-
- 8 16-SEP-76 /SB ADD IDX HEADER
- 9 8-OCT-76 /SB SET THE RBF FIELD ON CONNECT
- 10 11-NOV-76 /SB USE ERROR CODE RETURNED BY SETRST
- 11 16-NOV-76 /SB TAKE OUT LOCATE MODE CHECK
- 12 20-DEC-76 /SB ADD CHECK FOR BID, BLN FIELDS
- 13 22-DEC-76 /SB CHANGE ERRSA TO ERCCR
- 14 25-FEB-77 /SB RELEASE BUFFERS AS CONTIGUOUS
- 15 30-MAR-77 /SB REMOVE CALLDELINK
- 16 7-APR-77 /SB DO EOF UPDATE IN DISCONNECT
1 17 4-OCT-77 /SB SET UP CBD IN DCNCTRAB BEFORE
ANY BUFFER OPERATIONS ARE DONE
2 18 12-OCT-77 /SB USE RST, NOT VALUD OF RABISI TO UNLOCK
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
100 19 Dev Make declaration for PUTBKT be EXTERNAL
ROUTINE so RMS will compile under
BLISS V4 (RMT, 10/22/86).
***** END OF REVISION HISTORY *****
])%
%([ EXTERNAL DECLARATIONS ])%
EXTERNAL ROUTINE
CRASH,
DUMP,
GMEM,
LOCKIT,
PMEM,
PPAGE,
RSETUP,
SETRST,
WRITEBUFFER;
%([ ERROR MESSAGES REFERENCED WITHIN THIS MODULE ])%
EXTERNAL
MSGNLW; ! NULL FILE WINDOW FOUND
FORWARD ROUTINE DCNTRAB; ! FORWARD DECLARATIONS
REQUIRE 'RMSREQ';
EXTDECLARATIONS;
! $CONNECT
! ====
! THIS ROUTINE PROCESSES THE $CONNECT MACRO
!
! FORMAT OF THE $CONNECT MACRO:
!
! $CONNECT <RAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! RAB FIELDS WHICH ARE USED AS INPUT TO $CONNECT:
!
! FAB ADDRESS OF ASSOCIATED FAB
! KRF KEY OF REFERENCE (INDEXED)
! MBF MULTI-BUFFER COUNT
! RAC RECORD ACCESS
! ROP RECORD OPTIONS
! RB$EOF $CONNECT TO END-OF-FILE
! RAB FIELDS RETURNED BY $CONNECT:
!
! STS STATUS CODE
! ISI INTERNAL STREAM IDENTIFIER
! INPUT:
! ADDRESS OF RAB
! ADDRESS OF ERROR-ROUTINE
! OUTPUT:
! <NONE>
! GLOBALS USED:
! GMEM
! PMEM
! SETRST
%([ **** FLOW OF $CONNECT ROUTINE ****
1. GET FAB ADDRESS FROM RAB AND CHECK IT
2. CHECK FOR ERRORS
3. SET UP RST
4. RETURN STREAM-ID TO USER
] )%
GLOBAL ROUTINE %NAME('$CONNECT') ( BLOCK, ERRORRETURN ) =
BEGIN
ARGUMENT (BLOCK,BASEADD);
ARGUMENT (ERRORRETURN,BASEADD);
LOCAL
FILEID;
RMSENTRY ( $CONNECT );
%([ FETCH THE ADDRESS OF THE USER'S RAB AND ERROR ADDRESS ])%
RAB = .BLOCK; ! GET ADDRESS OF RAB
ERRADR = .ERRORRETURN; ! AND USER ERROR ADDRESS
ERRORBLOCK ( RAB ); ! ERRORS GO TO RAB
%([ CHECK FOR VALID RAB CODE AND SIZE ])%
IF .RAB [ BLOCKTYPE ] ISNT RABCODE THEN USERERROR ( ER$RAB );
IF .RAB [ BLOCKLENGTH ] ISNT V1RABSIZE THEN USERERROR ( ER$BLN );
%( [ FETCH FILE-ID FROM RAB ])%
FAB = .RAB [ RABFAB ]; ! GET FAB ADDRESS
FST = .FAB [ FABIFI ]; ! CONVERT IFI TO FST ADDRESS
IF .FAB EQL 0 OR .FST EQL 0 !FILE OPEN?
THEN USERERROR (ER$IFI); !NO
IF ( .FST [ BLOCKTYPE ] ISNT FSTCODE ) ! OR IF IT ISNT VALID ( DOESNT POINT TO FST )
THEN USERERROR ( ER$IFI );
%([ CHECK NOW TO BE SURE THAT THE RB$EOF OPTION BIT
IS BEING USED CORRECTLY. THIS OPTION IS VALID ONLY
FOR SEQUENTIAL FILES (INCLUDING ASCII/LSA) ])%
IF ( APPENDOPTION ISON )
THEN IF ( FILEORG GTR ORGSEQ )
THEN %(THERE IS AN ERROR)%
USERERROR ( ER$PEF );
%([ NOTE THAT THERE IS NO CHECK HERE FOR A ZERO ISI FIELD
IN THE USER'S RAB. ALTHOUGH THIS MAY SEEM LIKE A LOGICAL
THING TO CHECK FOR, IT WOULD MEAN THAT RMS-20 WOULD HAVE
TO CLEAR THE ISI FIELD WHENEVER THE RAB WAS DISCONNECTED.
THIS IS FINE FOR A DISCONNECT MACRO, BUT IT COULDN'T BE
DONE ON A CLOSE. THEREFORE, THE ISI FIELD IS OVERWRITTEN
IF NON-ZERO ON A CONNECT ])%
%([ IF WE ARE CONNECTING MULTIPLE STREAMS, THEN WE
MUST INSURE THAT WRITE ACCESS IS NOT BEING USED IF
THE FILE IS ONLY FOR EXCLUSIVE ACCESS. THIS IS BECAUSE
MULTIPLE STREAMS MUST BE INTERLOCKED FROM EACH OTHER
JUST AS DIFFERENT PROCESSES ARE ALSO INTERLOCKED. THUS,
IF WE ARE NOT LOCKING (I.E., FAC=SHR=FB$GET OR SHR=FB$NIL),
THEN WE MUST CHECK THAT WE ARE ONLY READING THE FILE. ])%
IF .FST [ FLINK ] ISNT .FST ! IF STREAM ALREADY ACTIVE
THEN
BEGIN
IF ( ( NOT LOCKING ) AND IOMODE )
OR
( ASCIIFILE )
OR
( MTA )
THEN %(ONLY ONE STREAM IS ALLOWED)%
USERERROR ( ER$CCR )
END; %(OF IF STREAM ALREADY ACTIVE)%
%([ SET UP A RECORD STATUS TABLE ])%
$CALL (SETRST);
%([ PLACE THE ADDRESS OF THE USER'S BUFFER INTO
THE "RECORD-BUFFER ADDRESS" FIELD SO THAT THE
FIRST RECORD INSERTION WILL OPERATE CORRECTLY. ])%
RAB [ RABRBF ] = .RAB [ RABUBF ];
RAB [ RABISI ] = .RST; ! RETURN STREAM-ID
SETSUCCESS; ! WE WERE SUCCESSFUL
USEREXIT ! RETURN TO USER
END; %( OF $CONNECT )%
! $DISCONNECT
! ===========
! THIS ROUTINE PROCESSES THE $DISCONNECT MACRO
! FORMAT OF $DISCONNECT MACRO:
!
! $DISCONNECT <RAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! RAB FIELDS USED AS INPUT TO $DISCONNECT:
!
! ISI INTERNAL STREAM IDENTIFIER
!
!
! RAB FIELDS RETURNED BY $DISCONNECT:
!
! STS STATUS CODE
! INPUT:
! ADDRESS OF RAB
! ADDRESS OF ERROR-ROUTINE
! OUTPUT:
! <STATUS CODE>
! GLOBALS USED:
! DELINK
! PMEM
! PPAGE
GLOBAL ROUTINE %NAME('$DISCONNECT') ( BLOCK, ERRORRETURN ) =
BEGIN
ARGUMENT (BLOCK,BASEADD);
ARGUMENT (ERRORRETURN,BASEADD);
RMSENTRY ( $DISCONNECT );
RAB = .BLOCK; ! FETCH RAB ADDRESS
ERRADR = .ERRORRETURN; ! AND USER ERROR ADDRESS
ERRORBLOCK ( RAB ); ! STATUS GOES TO RAB
%([ PERFORM NORMAL SET-UP OPERATIONS JUST LIKE ANY
OTHER RECORD OPERATION. HOWEVER, PASS RSETUP A
VALUE OF "TRUE" SO THAT THE "FAC" ACCESS CHECK
WILL ALWAYS SUCCEED. ])%
CALLRSETUP ( PCI ( TRUE ) ); ! SET UP RST,FST, ETC.
%([ DISCONNECT A SINGLE RECORD STREAM ])%
CALLDCNTRAB; ! PROCESS THE RAB
USEREXIT ! RETURN TO USER
END; %( OF $DISCONNECT PROCESSOR )%
! DCNCTRAB
! ========
! ROUTINE TO "$DISCONNECT" A SINGLE RAB FROM A
! FILE. THIS ROUTINE IS CALLED ONCE BY THE
! $DISCONNECT PROCESSOR AND POSSIBLY SEVERAL
! TIMES BY THE "$CLOSE" PROCESSOR, ONCE FOR
! EACH DEFINED RECORD STREAM.
! INPUT:
! <NONE>
! OUTPUT:
! <NONE>
! GLOBALS USED:
! PMEM
! PPAGE
! PUTBKT
GLOBAL ROUTINE DCNTRAB =
BEGIN
%IF INDX %THEN
EXTERNAL ROUTINE
PUTBKT;
%FI
EXTERNAL ROUTINE
ADJEOF;
LOCAL
TEMP,
OUREOFBYTE, ! THE EOF AS WE KNOW IT
BFDPTR: POINTER,
BUFFERPAGE, ! FIRST PAGE OF CONTIGUUS BUFFERS
BUFFERSIZE, ! SIZE (IN PAGES) OF EACH RECORD BUFFER
KEYBUFFSIZE, ! SIZE OF KEY BUFFER
KEYBUFFADR; ! ADDRESS OF KEY BUFFER ( INDEXED ONLY )
TRACE ( 'DCNCTRAB' );
%([ WE NOW MUST INSURE THAT ALL LOCKED RECORDS FOR
THE STREAM HAVE BEEN UNLOCKED. THERE IS A VERY
EASY WAY OF DOING THIS...ISSUE A "DEQ" JSYS TO
UNLOCK ALL RECORDS FOR THE STREAM. HOWEVER, IF
THERE ARE NO LOCKED RECORDS, THIS IS AN UNNECESSARY
OVERHEAD. THEREFORE, FOR SEQUENTIAL/RELATIVE FILES,
WE WILL CHECK THE "DLOCKED" BIT IN THE RST; FOR INDEXED
FILES, WE WILL CHECK TO SEE IF THERE IS A CURRENT BUCKET.
IN EITHER CASE, ALL LOCKED RECORDS WILL BE UNLOCKED. ])%
%([ UNLOCK ANY LOCKED RECORD ])%
IF DATALOCKED
THEN %(WE MUST UNLOCK ALL LOCKED RECORDS/BUCKETS IN THE FILE)%
$CALLOS ( ER$EDQ, ($CALL ( LOFFALL, .RST ))); ! UNLOCK EVERYTHING
%([ SET UP THE CURRENT BUFFER DESCRIPTOR POINTER ])%
CBD = .RST + RSTCBDOFFSET; !**[1]** GET PTR TO CURR. BKT.
%([ FOR INDEXED FILES, FLUSH THE CURRENT BUCKET AND THE KEY BUFFER ])%
%IF INDX %THEN
IF IDXFILE
THEN %(WE MUST FLUSH THE KEY BUFFER)%
BEGIN
RELEASCURENTBKT;
KEYBUFFSIZE = .FST [ FSTKBFSIZE ]; ! GET SIZE OF BUFFER
KEYBUFFADR = .RST [ RSTKEYBUFF ]; ! AND ITS ADDRESS
IF .KEYBUFFSIZE ISNT ZERO
THEN
CALLPMEM ( LCI ( KEYBUFFSIZE ), RLCI ( KEYBUFFADR ) )
END; %(OF IF IDXFILE)%
%FI
$CALL (FLUBUF); !PUT OUT ALL UPD BUFFERS
%([ RELEASE ALL BUFFERS USED BY RECORD STREAM ])%
BUFFERSIZE = .FST [ FSTBUFSIZ ] * .RST [ RSTBFDCOUNT ]; ! GET SIZE OF EACH BUFFER
BFDPTR = BFDOFFSET; ! GET PTR TO FIRST BUFFER
BUFFERPAGE = .BFDPTR [ BFDBPAGE ]; ! AND PAGE NUMBER OF FIRST ONE
CALLPPAGE ( %( PAGE NO. )% LCI ( BUFFERPAGE ),
%( PAGE COUNT )% LCI ( BUFFERSIZE ),
%( DESTROY )% PCI ( TRUE ));
%([ FETCH OUR EOF BYTE NUMBER AND START TO COMPARE IT ])%
%([ NOTE: FOR LSA FILES, HYBYTE AND EOFBYTE ARE IN WORDS, NOT CHARS. ])%
OUREOFBYTE = .RST [ RSTHYBYTE ];
IF SEQUENCED THEN OUREOFBYTE = ( .OUREOFBYTE + 4 ) / 5;
TEMP = ( .RST [ RSTFLAGS ] AND FLGTRUNC ); ! TRUNCATE FLAG FOR ADJEOF
IF ( RMSFILE ) ! RMS FILE (ONLY PMAPS DONE)
AND
( .OUREOFBYTE ISNT ZERO ) ! BEEN UPDATED?
OR
( .TEMP ISNT ZERO ) ! OR ...WE DID A $TRUNCATE
THEN %(WE MAY HAVE TO UPDATE THE EOF POINTER)%
$CALL ( ADJEOF, GCI ( FST [ FSTJFN ] ),
LCI ( OUREOFBYTE ), LCI ( TEMP ) );
%( [ REMOVE RST FROM FST CHAIN ] )%
DELINK ( %(THIS RST)% RST );
%( [ RELEASE CORE USED BY RST ] )%
TEMP = .RST [ BLOCKLENGTH ];
CALLPMEM ( %( BLOCK SIZE )% LCI ( TEMP ),
%( BLOCK PTR )% RGCI ( RST ));
GOODRETURN
END; %( OF DCNTRAB )%
END
ELUDOM