Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-1/language-sources/rdwrit.b36
There are 21 other files named rdwrit.b36 in the archive. Click here to see a list.
MODULE RDWRIT ( ! Local Block I/O service for RMS
IDENT = '2',
ENTRY(
R$READ, ! RMS $READ (Block-mode input)
R$WRITE, ! RMS $WRITE (Block-mode output)
RMS$READ, ! RMS Local $READ
RMS$WRITE, ! RMS Local $WRITE
RMS$WBUCKET, ! Put out current bucket
RDHANDLE ! Handler for $READ
)
) =
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982, 1985.
! 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.
!++
! FACILITY: DAP
!
! ABSTRACT: Routines to transfer records or blocks of file data.
!
!
! ENVIRONMENT: RMS, BLISSNET, XPORT, Transportable code.
!
! AUTHOR: Andrew Nourse, CREATION DATE: 23-Apr-82
!
! MODIFIED BY:
!
! , : VERSION
! 02 - Put in entry points
! 01 - The beginning
!--
!
! INCLUDE FILES:
!
LIBRARY 'RMS'; ! RMS Definitions + XPORT
LIBRARY 'RMSLIB'; ! INTERNAL RMS definitions
LIBRARY 'BLISSNET'; ! BLISS DECNET Interface
LIBRARY 'CONDIT'; ! Condition handler defs
LIBRARY 'DAP'; ! DAP package defs
%IF %SWITCHES(TOPS20)
%THEN
UNDECLARE %QUOTE BPT;
LIBRARY 'BLI:MONSYM';
%FI;
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
R$READ, ! RMS $READ (Block-mode input)
R$WRITE, ! RMS $WRITE (Block-mode output)
RMS$READ, ! RMS Local $READ
RMS$WRITE, ! RMS Local $WRITE
NEXT_BUCKET, ! Find the next bucket number
RMS$WBUCKET, ! Put out current bucket
RDHANDLE; ! Handler for $READ
!
! STRUCTURES
!
STRUCTURE RMS_BLOCK[O,P,S]=(RMS_BLOCK+O)<P,S,0>; ! Unsigned always
! otherwise like BLOCK
!
! MACROS:
!
MACRO
BUILD_LIST(BLK)[LST]=BLK[%COUNT]=LST %,
$UTIL(FUNC)=(LOCAL ARGBLK: BLOCK[%LENGTH];
BIND ARGS=ARGBLK[1,0,0,0]: VECTOR;
BUILD_LIST(ARGS,%REMAINING);
ARGBLK[0,0,18,0]=FUNC;
ARGBLK[0,18,18,0]=1-%LENGTH;
$UTLINT(ARGUMENT_BLOCK=ARGBLK, ERR=RMS$SIGNAL);
.ARGBLK[0,0,36,0]) %;
KEYWORDMACRO
GET_BUCKET(RAB=SAME_RAB,BUCKET,BUCKET_SIZE=1,LOCK=0,DESC)=
(%IF NOT %IDENTICAL(RAB,SAME_RAB)
%THEN $UTIL(U$SETENVIR,RAB);
%FI
$UTIL(U$GETBKT,BUCKET,BUCKET_SIZE,LOCK,DESC)) %,
PUT_BUCKET(RAB=SAME_RAB,DESC,UPDATE=1)=
(%IF NOT %IDENTICAL(RAB,SAME_RAB)
%THEN $UTIL(U$SETENVIR,RAB);
%FI
$UTIL(U$PUTBKT,UPDATE,DESC)) %;
MACRO FREE_BUCKET(A)=PUT_BUCKET(A,%REMAINING,UPDATE=0) %;
MACRO COPY(AFROM,ATO,LEN)= ! Copy a block of memory
(REGISTER BLTPTR; ! using BLT instruction
BLTPTR<LH>=(AFROM); ! FROM is source addr
BLTPTR<RH>=(ATO); ! TO is destination addr
BLT(BLTPTR,((ATO)+(LEN)-1))) %; ! LEN is length of block
!
! EQUATED SYMBOLS:
!
LITERAL FIRST_VBN=1;
! UTLINT function codes and arguments
%( Defined in RMSLIB
LITERAL
U$SETENVIR=0, ! SETENVIR(RAB)
U$GMEM=1, ! GMEM(Len)
U$GPAGE=2, ! GPAGE(Numberofpages)
U$PMEM=3, ! PMEM(Len,Addr)
U$PPAGE=4, ! PPAGE(Pagenum,Numberofpages,KillFlag)
** Functions below this require SETENVIR to be done first
U$CHKDUP=6, ! CHKDUP(RecDesc_FirstSidr,BktDesc)
U$CKEYKU=7, ! CKEYKU(RDPptr,RECptr)
U$CKEYKK=%O'10', ! CKEYKK(RDPptr,KeyStringptr)
U$FBYRRV=%O'11', ! FBYRRV(RecDesc_Target,BktDesc)
U$FBYRFA=%O'12', ! FBYRFA(RecDesc_Target,BktDesc)
U$FNDDATA=%O'13', ! FNDDATA(RecDesc_Keystring,BktDesc)
U$FOLOPATH=%O'14', ! FOLOPATH(RecDesc_Searchkey,BktDesc)
U$GETBKT=%O'15', ! GETBKT(Bktno,Bktsize,Lockflag,BktDesc)
U$GETIDB=%O'16', ! GETIDB(BktDesc)
U$GETKDB=%O'17', ! GETKDB(Krf)
U$GETROOT=%O'20', ! GETROOT(RecDesc)
U$GTBKTPTR=%O'21', ! GTBKTPTR(RecDesc,BktDesc_curr,BktDesc_next)
U$MOVEKEY=%O'22', ! MOVEKEY(RecPtr,KeybufPtr)
U$PATH=%O'23', ! PATH()
U$PUTBKT=%O'24', ! PUTBKT(UpdateFlag,BktDesc)
U$PUTSIDR=%O'25'; ! PUTSIDR(RecDesc)
)%
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
DAP$GET,
DAP$PUT,
DAP$GET_MESSAGE,
DAP$PUT_MESSAGE,
DAP$GET_STRING,
DAP$GET_STATUS,
DAP$PUT_STRING,
DAP$PUT_CONTROL,
DAP$GET_ACK,
DAP$ERROR_DAP_RMS,
RMS$SIGNAL,
DAP$HANDLE; ! Condition handler
GLOBAL ROUTINE R$READ (RAB,ERR) = ! Get a bucket from a file
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a bucket from an open file.
! Use RMS if file is local, DAP (via DAP$GET) if remote.
!
! FORMAL PARAMETERS:
!
! RAB: A RAB as defined by RMS
! ERR: Address of error routine
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP RAB: REF $RAB_DECL;
BIND FAB=.RAB[RAB$A_FAB]: $FAB_DECL;
LOCAL V;
V=(IF .FAB[FAB$V_REMOTE]
THEN DAP$GET(RAB[$],.ERR)
ELSE RMS$READ(RAB[$],.ERR));
.V
END; !End of R$READ
GLOBAL ROUTINE R$WRITE (RAB,ERR) = ! Put a page
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a page to an open file.
! Use RMS if file is local, DAP (via DAP$PUT) if remote.
!
! FORMAL PARAMETERS:
!
! RAB: A RAB as defined by RMS
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! Standard RMS codes
!
! SIDE EFFECTS:
!
! NONE
!--
BEGIN
MAP RAB: REF $RAB_DECL;
BIND FAB=.RAB[RAB$A_FAB]: $FAB_DECL;
IF .FAB[FAB$V_REMOTE]
THEN DAP$PUT(RAB[$],.ERR)
ELSE RMS$WRITE(RAB[$],.ERR)
END; !End of R$WRITE
GLOBAL ROUTINE RMS$READ (URAB,ERR) = ! Get a page from a file
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a page from an open local file.
!
! FORMAL PARAMETERS:
!
! URAB: A 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=.URAB: $RAB_DECL;
BIND RST=.RAB[RAB$A_ISI]: RMS_BLOCK;
BIND CBKD=RST[RSTCBKD1]: RMS_BLOCK;
BIND CBFD=.CBKD[BKDBFDADR]: RMS_BLOCK;
LOCAL CRAB: REF $RAB_DECL VOLATILE;
LOCAL CERR: VOLATILE;
ENABLE RDHANDLE(CRAB,CERR); ! Handle page-not-found, in particular
CRAB=RAB; ! Copy for handler
CERR=.ERR; !
!Free the buffer if necessary
IF CBFD NEQ 0 ! Is there any buffer descriptor?
THEN
BEGIN
IF .CBFD[BFDUSECOUNT] GTR 0 ! Is a bucket in the buffer?
THEN FREE_BUCKET(RAB=RAB, 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
LINKAGE JSYS_3=JSYS(REGISTER=1,REGISTER=2,REGISTER=3): SKIP(0);
BIND ROUTINE GTFDB__=GTFDB_: JSYS_3;
BIND FAB=.RAB[RAB$A_FAB]: $FAB_DECL;
RAB[RAB$H_RSZ]=$FBLEN; ! Length of FDB
GTFDB__(.FAB[FAB$H_JFN],$FBLEN^18,.RAB[RAB$A_UBF]);
%ELSE %ERROR('Not implemented for TOPS-10')
%FI
RETURN RMS$_NORMAL
END;
! Get the requested page of the file
GET_BUCKET(RAB=RAB, DESC=CBKD, BUCKET=(.RAB[RAB$G_RFA]-FIRST_VBN));
SELECT .RAB[RAB$Z_RAC] OF
SET
[RAB$K_RAC_BLK, RAB$K_RAC_BFT]: ! If block mode,
BEGIN ! user wants the bucket itself
RAB[RAB$H_RSZ]=PAGESIZE*.CBKD[BKDBKTSIZE];
IF .RAB[RAB$V_ROP_LOC]
THEN RAB[RAB$A_RBF]=.CBKD[BKDBKTADR] !Point RBF at bucket itself
ELSE
BEGIN
RAB[RAB$A_RBF]=.RAB[RAB$A_UBF]; !Point RBF at user's buffer
COPY(.CBKD[BKDBKTADR],.RAB[RAB$A_RBF],.RAB[RAB$H_RSZ]);
END;
END;
TES;
RMS$_NORMAL
END; !End of RMS$READ
GLOBAL ROUTINE RMS$WRITE (URAB,ERR) = ! Put a page
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a page to an open local file.
!
! FORMAL PARAMETERS:
!
! URAB: A RAB as defined by RMS
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!--
BEGIN
BIND RAB=.URAB: $RAB_DECL;
BIND RST=.RAB[RAB$A_ISI]: RMS_BLOCK;
BIND CBKD=RST[RSTCBKD1]: RMS_BLOCK;
BIND CBFD=.CBKD[BKDBFDADR]: RMS_BLOCK;
LOCAL CRAB: REF $RAB_DECL VOLATILE;
LOCAL CERR: VOLATILE;
ENABLE RDHANDLE(CRAB,CERR); ! Handle page-not-found, in particular
CRAB=RAB; ! Copy for handler
CERR=.ERR; !
!Free the buffer if necessary
IF CBFD NEQ 0 ! Is there any buffer descriptor?
THEN
BEGIN
IF .CBFD[BFDUSECOUNT] GTR 0 ! Is a bucket in the buffer?
THEN FREE_BUCKET(RAB=RAB, 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
LINKAGE JSYS_3E=JSYS(REGISTER=1,REGISTER=2,REGISTER=3): SKIP(-1);
BIND FAB=.RAB[RAB$A_FAB]: $FAB_DECL;
BIND ROUTINE CHFDB__=CHFDB_: JSYS_3E;
OWN FDB_MASK:VECTOR[$FBLEN] ! Mask of what CHFDB can change
PRESET([$FBCTL]=FB_TMP+FB_PRM+FB_DEL+FB_NOD+FB_INV+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=.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;
%ELSE %ERROR('Not implemented for TOPS-10')
%FI
RETURN RMS$_NORMAL
END;
GET_BUCKET(RAB=RAB, DESC=CBKD, BUCKET=(.RAB[RAB$G_RFA]-FIRST_VBN)); !Get it
COPY(.RAB[RAB$A_RBF], .CBKD[BKDBKTADR], .RAB[RAB$H_RSZ]); ! Copy into it
PUT_BUCKET(UPDATE=1, DESC=CBKD); ! Write it out
RMS$_NORMAL
END; !End of RMS$WRITE
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
LINKAGE JSYS1E=JSYS(REGISTER=1;REGISTER=1): SKIP(-1);
BIND ROUTINE FFUFP__=FFUFP_: JSYS1E;
! Find next file page JSYS
BIND RAB=.URAB: $RAB_DECL;
BIND FAB=.RAB[RAB$A_FAB]: $FAB_DECL;
LOCAL NEXTB;
IF FFUFP__(((.FAB[FAB$H_JFN])^18)+(.RAB[RAB$G_RFA]-FIRST_VBN);NEXTB)
THEN
BEGIN
RAB[RAB$G_BKT]=RAB[RAB$G_RFA]=.NEXTB<RH>+FIRST_VBN;
RETURN RMS$_NORMAL
END
ELSE ! If no next page
BEGIN ! probably end of file
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
SIGNAL(.RAB[RAB$H_STS],.NEXTB,RAB[$],RMS$K_FIND_VALUE) ! oops
END
END;
GLOBAL ROUTINE RMS$WBUCKET (URAB,ERR) = ! Put current bucket
!++
! FUNCTIONAL DESCRIPTION:
!
! Put current bucket to an open local file.
!
! FORMAL PARAMETERS:
!
! URAB: A RAB or an RST as defined by RMS
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!--
BEGIN
BIND RAB=.URAB: $RAB_DECL;
BIND RST=(IF .RAB[RAB$H_BID] EQL RAB$K_BID
THEN .RAB[RAB$A_ISI]
ELSE .URAB): RMS_BLOCK;
BIND CBKD=RST[RSTCBKD1]: RMS_BLOCK;
BIND CBFD=.CBKD[BKDBFDADR]: RMS_BLOCK;
IF CBFD NEQ 0 ! Is there any buffer descriptor?
THEN
BEGIN
IF .CBFD[BFDUSECOUNT] GTR 0 ! Is a bucket in the buffer?
THEN PUT_BUCKET(UPDATE=1, DESC=CBKD); ! Write it out
END;
RMS$_NORMAL ! Good return
END; !End of RMS$WBUCKET
GLOBAL ROUTINE RDHANDLE (SIGNAL_ARGS,MECH_ARGS,ENABLE_ARGS) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Condition handler for RMS$READ and RMS$WRITE
!
! FORMAL PARAMETERS:
!
! SIGNAL_ARGS: addr of vector of SIGNAL arguments,
! MECH_ARGS: not used,
! ENABLE_ARGS: args passed when this handler was established
! [1]: Address of RAB
! [2]: Error routine
!
! COMPLETION CODES:
!
! 0: Resignal, 1: Continue
!
! SIDE EFFECTS:
!
! RMS$_UDF is changed to RMS$_RNF
! because this can only occur if the page doesn't exist
!--
BEGIN
MAP SIGNAL_ARGS: REF VECTOR,
MECH_ARGS: REF VECTOR,
ENABLE_ARGS: REF VECTOR;
LOCAL SEVERITY;
BIND ROUTINE $$ERRRTN=..ENABLE_ARGS[2]: RMS_ERCAL; ! Error routine
BIND RAB=..ENABLE_ARGS[1]: $RAB_DECL;
IF RAB EQL 0 THEN RETURN SS$_RESIGNAL; ! Not set up
SEVERITY=.(SIGNAL_ARGS[1])<0,3>;
SELECT .SIGNAL_ARGS[1] OF
SET
[SS$_UNWIND]: RETURN SS$_CONTINUE;
[RMS$_UDF]: BEGIN
IF (.RAB[RAB$Z_RAC] EQL RAB$K_RAC_BFT) ! Blk mode xfer
OR (.RAB[RAB$Z_RAC] EQL RAB$K_RAC_SEQ) ! or Sequential
OR (.RAB[RAB$Z_RAC] EQL RAB$K_RAC_TRA) ! or transfer
OR .RAB[RAB$V_ROP_KGE]
THEN
BEGIN
NEXT_BUCKET(RAB); ! Find next
RMS$READ(RAB,$$ERRRTN); ! And read it
SETUNWIND();
RETURN MECH_ARGS[1]=.RAB[RAB$H_STS] ! Return status
END; ! Unwind
SIGNAL_ARGS[1]=RMS$_RNF; ! GET_BUCKET returns this
END; ! if the page doesn't exist.
! We want Record-not-found
[RMS$K_ERR_MIN TO RMS$K_ERR_MIN+%O'7777']: ! RMS-20 predates
(SEVERITY=STS$K_ERROR; ! the standard
RAB[RAB$H_STS]=.SIGNAL_ARGS[1]);
[RMS$K_SUC_MIN TO RMS$K_SUC_MIN+%O'17']: !
(SEVERITY=STS$K_NORMAL; !
RAB[RAB$H_STS]=.SIGNAL_ARGS[1]);
TES;
CASE .SEVERITY FROM 0 TO 7 OF
SET
[STS$K_ERROR, STS$K_WARNING]:
BEGIN
$$ERROR(OPEN,RAB); !? Should get operation too
SETUNWIND();
END;
[STS$K_NORMAL, STS$K_INFO]: RETURN STS$K_NORMAL;
[STS$K_FATAL,INRANGE]: ;
TES;
STS$K_RESIGNAL
END; !End of RDHANDLE
END !End of module
ELUDOM