Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-sources/rmsrdw.b36
There are 3 other files named rmsrdw.b36 in the archive. Click here to see a list.
%TITLE 'R D W R I T -- $READ/$WRITE processor'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE rdwrit (IDENT = '3.0'
) =
BEGIN
GLOBAL BIND
rdwrv = 3^24 + 0^18 + 614; ! Edit date: 1-Apr-86
!+
!
!
! FUNCTION: THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
! THE $READ MACRO FOR RMS-20.
! AUTHOR: A. Nourse
!
!
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1977, 1986.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
! COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
! THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
! ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
! AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
! SOFTWARE IS HEREBY TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
! NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
! EQUIPMENT CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
! ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
!
!
! ********** TABLE OF CONTENTS **************
!
! ROUTINE FUNCTION
! ======= ========
!
! $READ ACTION ROUTINE FOR $READ USER MACRO
! $WRITE ACTION ROUTINE FOR $WRITE USER MACRO
!
! 503 Implement $READ (AN, 6-84)
! 537 Ext addr fix
! 572 Put in conditionals for TOPS-10
! (AN/DR 19-Sep-95)
!-
REQUIRE 'RMSREQ';
REQUIRE 'RMSOSD'; ! SYSTEM-DEPENDANT
LIBRARY 'CONDIT';
!
! TABLE OF CONTENTS
!
FORWARD ROUTINE
$READ,
$WRITE,
DOREAD,
DOWRITE;
%IF %SWITCHES(TOPS20)
%THEN
FORWARD ROUTINE
WBUCKET,
NEXT_BUCKET;
%FI
!
! MACROS:
!
KEYWORDMACRO
GET_BUCKET(BUCKET,BUCKET_SIZE=1,LOCK=0,DESC)=
IF NOT GETBKT(BUCKET,BUCKET_SIZE,LOCK,DESC)
THEN SIGNAL (Rms$_Rnf, 0, rab[0,0,0,0] ) %,
PUT_BUCKET(DESC,UPDATE=1)=
PUTBKT(UPDATE,DESC) %;
MACRO FREE_BUCKET[]=PUT_BUCKET(%REMAINING,UPDATE=0) %;
MACRO Copy(From_Addr, To_Addr, Size)= ! Copy a block of memory
(REGISTER
tmpac1 = 6,
tmpac2 = 7,
tmpac3 = %O'10';
IF .RmsSec NEQ 0 ! If not in section 0
THEN
BEGIN
BIND
extend_block = UPLIT (Ext$k_Xblt^27); !m511
tmpac1 = size;
tmpac2 = from_addr;
tmpac3 = to_addr;
IF .tmpac2<18, 18> EQL 0 THEN tmpac2 = .tmpac2 OR .rmssec;
IF .tmpac3<18, 18> EQL 0 THEN tmpac3 = .tmpac3 OR .rmssec;
$extend_inst (tmpac1, extend_block)
END
ELSE
BEGIN
TmpAc1<Lh>=(From_Addr); ! FROM_ADDR is source addr
TmpAc1<Rh>=(To_Addr); ! TO_ADDR is destination addr
Blt(TmpAc1,((To_Addr)+(Size)-1)) ! SIZE is length of block
END ) %;
!
! EQUATED SYMBOLS:
!
LITERAL FIRST_VBN=1;
%SBTTL '$READ - $READ processor'
GLOBAL ROUTINE $read (rabblock, errorreturn) =
! $GET
! ====
! PROCESSOR FOR $READ MACRO
! INPUT:
! ADDRESS OF USER RECORD BLOCK (RAB)
! ADDRESS OF USER ERROR ROUTINE
! OUTPUT:
! <STATUS FIELD>
!
! FORMAT OF THE $GET MACRO:
!
! $READ <RAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! RAB FIELDS USED AS INPUT TO $READ:
!
! ISI INTERNAL STREAM IDENTIFIER
! RAC RECORD ACCESS
! BKT BUCKET NUMBER
! RFA RECORD'S FILE ADDRESS
! ROP RECORD OPTIONS
! RB$LOC USE LOCATE MODE
! RB$RAH READ-AHEAD
! UBF ADDRESS OF USER RECORD BUFFER
! USZ SIZE OF USER RECORD BUFFER
!
! RAB FIELDS WHICH ARE RETURNED BY $READ:
!
! BKT BUCKET NUMBER
! RBF ADDRESS OF RECORD TRANSFERED
! RFA RECORD'S FILE ADDRESS
! RSZ SIZE OF RECORD TRANSFERED
! STS STATUS OF OPERATION
! STV ADDITIONAL STATUS INFORMATION
BEGIN
rmsentry ($read);
!+
! FETCH THE ADDRESS OF THE USER RAB AND ERROR ROUTINE
!-
rab = .rabblock; ! 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 $READ OPERATION IS LEGAL
!-
rsetup (axget + axupd + axdel + axtrn); ! SET UP PARAMETERS
!+
! SET UP THE USER'S RBF FIELD
!-
IF (Rab [Rab$a_Rbf] = .Rab [Rab$a_Ubf]) LEQ minuserbuff !m502
THEN usererror (er$ubf);
IF .fst [fst$v_remote] !a501
THEN !a501
dap$get ( .rab, .erradr ) !a501
ELSE !a501
doread ( .rab, .erradr ); !a503
!+
! PAD THE USER'S BUFFER, IF HE WANTS IT.
!-
IF (chkflag (rab [rabrop, 0], roppad) NEQ 0) THEN padbuffer ();
!+
! INDICATE THAT THIS OPERATION WAS A SUCCESS
!-
setsuccess; ! THIS WAS DONE CORRECTLY
!+
! EXIT TO THE USER
!-
usrret ()
END; ! End $Read
%SBTTL 'WRITE - $WRITE processor'
GLOBAL ROUTINE $write (rab_block, errorreturn) =
! $PUT
! ====
! PROCESSOR FOR $WRITE MACRO
! INPUT:
! ADDRESS OF USER RECORD BLOCK (RAB)
! ADDRESS OF USER ERROR ROUTINE
! OUTPUT:
! <STATUS FIELD OF USER RAB>
! ROUTINES CALLED:
!
! FORMAT OF THE $WRITE MACRO:
!
! $WRITE <RAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! RAB FIELDS USED AS INPUT BY $WRITE:
!
! ISI INTERNAL STREAM IDENTIFIER
! RAC RECORD ACCESS
! RBF ADDRESS OF USER RECORD BUFFER
! RSZ SIZE OF RECORD
! BKT BUCKET NUMBER
!
! RAB FIELDS WHICH ARE SET BY $WRITE:
!
! BKT BUCKET NUMBER
! RBF ADDRESS OF BUFFER FOR NEXT RECORD (-11 COMPATIBILITY)
! RFA RECORD'S FILE ADDRESS
! STS COMPLETION STATUS CODE
! STV ADDITIONAL STATUS INFORMATION
BEGIN
LOCAL
errorcode; ! USED TO SAVE AN ERROR CODE
rmsentry ($write);
!+
! FETCH INPUT ARGS
!-
rab = .rab_block; ! GET ADDRESS OF RAB
erradr = .errorreturn; ! AND USER ERROR ADDRESS
rsetup (axput); ! DO OTHER STUFF
!+
!
! ERROR PROCESSING FOR $PUT MACRO
!
! THE FOLLOWING ERRORS ARE CHECKED:
! 1. RFA ADDRESSING IS ILLEGAL
! 2. RECORD-SIZE < = MAX-REC-SIZE
! 3. RECORD BUFFER MUST BE PROPER
!-
errorcode = 0; ! ASSUME NO ERROR
IF .rab [rabrbf, 0] LEQ minuserbuff THEN errorcode = er$rbf; ! CHECK BUFFER
!+
! WAS THERE AN ERROR?
!-
IF .errorcode NEQ 0
THEN
BEGIN
usrsts = .errorcode;
usrerr () ! EXIT FROM RMS
END;
!+
! ***** END OF ERROR PROCESSING FOR $WRITE ******
!-
IF .fst[fst$v_remote] !a501
THEN !a501
Dap$Put (.rab, .erradr) !a501
ELSE !a501
!+
! FILE IS LOCAL.
!-
DoWrite (.Rab, .erradr); !a503
!+
! SET THE "SUCCESS" BIT AND REMEMBER THAT THIS WAS A $PUT
!-
setsuccess; ! SET SUCCESS BIT AND LAST-OPER
!+
! RETURN THE RFA OF THIS RECORD TO THE USER
!-
rab [rabrfa, 0] = .rst [rstdatarfa];
!+
! EXIT TO THE USER
!-
usrret (); ! Exit
1
END; ! End $PUT
%SBTTL 'DoRead -- Local file Read'
ROUTINE DoRead ( P_Urab, Err ) = ! Get a page from a file
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a page from an open local file.
!
! FORMAL PARAMETERS:
!
! P_URAB: Address of RAB as defined by RMS
! ERR: Address of error routine
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
BIND Rab=.P_Urab: $Rab_decl;
BIND Rst=.Rab[Rab$a_Isi]: $Rms_Rst;
BIND Cbkd=Rst[RST$z_Current_Bucket]: $Rms_Bucket_Descriptor;
BIND Cbfd=.Cbkd[Bkt$a_Buffer_Desc]: $RMS_Buffer_Descriptor;
!Free the buffer if necessary
IF Cbfd NEQ 0 ! Is there any buffer descriptor?
THEN
BEGIN
IF .Cbfd[Buf$v_Use_Count] GTR 0 ! Is a bucket in the buffer?
THEN FREE_BUCKET( Desc=Cbkd); ! Yes. free it.
END;
Rab[Rab$g_Rfa]=.Rab[Rab$g_Bkt]; ! Assume we get what we asked for
! (If not, handler will fix it)
! Special case for VBN 0, which is the FDB of the file
IF .Rab[Rab$g_Rfa] EQL 0
THEN
BEGIN
%IF %SWITCHES(TOPS20)
%THEN
BIND Fab=UAddr(.Rab[Rab$a_Fab]): $Fab_decl;
Rab[Rab$h_Rsz]=$Fblen; ! Length of FDB
Gtfdb( .Fab[Fab$h_Jfn], $Fblen^18, UAddr( .Rab[Rab$a_Ubf] ) );
%ELSE
Rab[Rab$h_Rsz] = 0;
%FI
RETURN Rms$_Normal
END;
! See if the requested page of the file exists
! and find the next one in any case
%IF %SWITCHES(TOPS20)
%THEN
IF Next_Bucket( Rab ) NEQ .Rab[Rab$g_Bkt]
THEN ! Requested bucket nonexistant
BEGIN
IF .Rab[Rab$v_Kge]
OR (.Rab[Rab$b_Rac] EQL Rab$k_Seq)
OR (.Rab[Rab$b_Rac] EQL Rab$k_Tra)
OR (.Rab[Rab$b_Rac] EQL Rab$k_Bft)
THEN Rab[Rab$g_Rfa]=.Rst[Rst$g_Next_Record_Pointer]
ELSE Usererror ( Rms$_Rnf )
END;
%ELSE
!+
! If words written is greater than pagesize * bucket in question, at least
! one word of the bucket in question exists
!-
IF .Fst[Fst$g_sof_words] LEQ (.Rab[Rab$g_Bkt] - 1) * pagesize
THEN
BEGIN
Rab[Rab$h_Sts] = Rms$_Eof;
Rab[Rab$h_Stv] = 0;
Usererror(.Rab[Rab$h_Sts])
END;
%FI
Get_Bucket(Desc=Cbkd, Bucket=(.Rab[Rab$g_Rfa]-First_Vbn));
Rab[Rab$h_Rsz]=Pagesize*.Cbkd[Bkt$v_Size];
IF .rab[Rab$v_Loc] ! Locate Mode?
THEN Rab[Rab$a_Rbf]=.cbkd[Bkt$a_Address]+.RmsSec !Point RBF at bucket
ELSE
BEGIN ! Move Mode
Rab[Rab$a_Rbf]=.rab[Rab$a_Ubf]; !Point RBF at user's buffer
Copy(.cbkd[Bkdbktadr],UAddr(.rab[Rab$a_Rbf]),.rab[Rab$h_Rsz]);
END;
Rms$_Normal
END; !End of Doread
%SBTTL 'DoWrite -- Local file Write'
ROUTINE Dowrite (P_Urab,Err) = ! Put a page
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a page to an open local file.
!
! FORMAL PARAMETERS:
!
! P_URAB: Address of RAB as defined by RMS
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!--
BEGIN
BIND Rst=.Rab[Rab$a_Isi]: $Rms_Rst;
BIND Cbkd=Rst[Rst$z_Current_Bucket]: $RMS_Bucket_Descriptor;
BIND Cbfd=.CBKD[Bkt$a_Buffer_Desc]: $RMS_Buffer_Descriptor;
!Free the buffer if necessary
IF Cbfd NEQ 0 ! Is there any buffer descriptor?
THEN
BEGIN
IF .Cbfd[Buf$v_Use_Count] GTR 0 ! Is a bucket in the buffer?
THEN Free_Bucket( Desc=Cbkd ); ! Yes. free it.
END;
Rab[Rab$g_Rfa]=.Rab[Rab$g_Bkt]; ! Assume we got what we wanted
! Special case for VBN 0, which is the FDB of the file
! Note that words in the FDB
! that corrrespond to zero words in the buffer are not changed!
IF .Rab[Rab$g_Rfa] EQL 0
THEN
BEGIN
%IF %SWITCHES(TOPS20)
%THEN
BIND Fab=UAddr(.Rab[Rab$a_Fab]): $Fab_decl;
PSECT OWN=$HIGH$;
OWN Fdb_Mask:VECTOR[$Fblen] ! Mask of what CHFDB can change
PRESET([$Fbctl]=Fb_Tmp+Fb_Prm+Fb_Del+Fb_Nod+Fb_Inv+Fb_For
+Fb_Fcf,
! Temporary, Permanent, Deleted, No-dump,
! Invisible, File Class (RMS/not-RMS)
[$Fbprt]=%O'777777',! Protection of file
[$Fbbyv]=Fb_Ret+Fb_Bsz+Fb_Mod, ! GenRetent,bsz,mode
[$Fbsiz]=-1, ! Size of file in bytes
[$Fbcrv]=-1, ! Creation Date/Time
[$Fbwrt]=-1, ! Last user write dtm
[$Fbref]=-1, ! Last user read dtm
[$Fbusw]=-1 ! User settable word
);
LOCAL Ptr: REF VECTOR;
Local Len;
Ptr=UAddr(.Rab[Rab$a_Rbf]); ! Pointer to 'record'
INCR i FROM 0 TO MIN(.Rab[Rab$h_Rsz],$Fblen)-1
DO BEGIN
IF (.Fdb_Mask[.i] NEQ 0) ! If anything to change here
AND (.Ptr[.i] NEQ 0) ! and we provided something there
THEN Chfdb(Cf_Nud+(.i^18)+.Fab[Fab$h_Jfn],.Fdb_Mask[.i],.Ptr[.i])
END;
Gtfdb (.Fab[Fab$h_Jfn], $xwd(1,$Fbsiz),rst[rsthybyte]); ! 614
%FI
RETURN Rms$_Normal
END;
!+
! Get the correct bucket and copy into it
!-
Get_Bucket(Desc=Cbkd, Bucket=(.Rab[Rab$g_Rfa]-First_Vbn));
Copy( UAddr(.Rab[Rab$a_Rbf]), .Cbkd[Bkt$a_Address], .Rab[Rab$h_Rsz] );
Put_Bucket(Update=1, Desc=Cbkd); ! Write it out
Rms$_Normal
END; !End of DoWrite
%IF %SWITCHES(TOPS20)
%THEN
ROUTINE Next_Bucket( Urab )=
!++
! FUNCTIONAL DESCRIPTION:
!
! Find next bucket of file
!
! FORMAL PARAMETERS:
!
! URAB: Address of RAB
!
! RETURNED VALUE:
!
! Next bucket (page) number
!
! SIDE EFFECTS:
!
! If no next page, RMS$_EOF is signalled
! All other errors signal as RMS$_BUG
!--
BEGIN
LOCAL Nextb;
If Ffufp(((.Fab[Fab$h_Jfn])^18)+(.Rab[Rab$g_Rfa]-First_Vbn);Nextb)
THEN
Rst[Rst$g_Next_Record_Pointer] = .Nextb<Rh>+First_Vbn
ELSE ! If no next page
BEGIN ! probably end of file
Rab[Rab$h_Rsz] = 0; ! No record size !a566
Rab[Rab$H_Sts]=(IF .nextb EQL Ffufx3 ! Is it end of file?
THEN Rms$_Eof
ELSE Rms$_Bug);
Rab[Rab$H_Stv]=.nextb; ! Secondary status is TOPS-20 code
Usererror ( .Rab[Rab$h_sts] )
END
END;
GLOBAL ROUTINE Wbucket = ! Put current bucket
!++
! FUNCTIONAL DESCRIPTION:
!
! Put current bucket to an open local file.
!
!--
BEGIN
BIND Cbkd=Rst[Rst$z_Current_Bucket]: $Rms_Bucket_Descriptor;
BIND Cbfd=.cbkd[Bkt$a_Buffer_Desc ]: $Rms_Buffer_Descriptor;
IF Cbfd NEQ 0 ! Is there any buffer descriptor?
THEN
BEGIN
IF .cbfd[buf$v_use_count] GTR 0 ! Is a bucket in the buffer?
THEN Put_Bucket(Update=1, Desc=Cbkd); ! Write it out
END;
END; !End of Wbucket
%FI
END
ELUDOM