Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

%TITLE 'U T L M S C  -- Miscellaneous RMSUTL routines'
!<BLF/REQUIRE 'RMSBLF.REQ';
MODULE utlmsc (					!Module for Miscellaneous routines.
		IDENT = '2.0'
		) =
BEGIN
!
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1980, 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.
!
!

!++
! FACILITIY:	RMS UTILITY (RMSUTL)
!
! ABSTRACT:	This module contains some miscellaneous routines.
!
! ENVIRONMENT:	User mode with  RMS.
!
! AUTHOR: A. Uddin			CREATION DATE: 29 April 80
!
! MODIFIED BY:
!
!	Ron Lusk, 3-Feb-84 : VERSION 2.0
! 423	-   Fix up for version 2: reformat, cleanup.
! 430	-   Fix GETMEM to return the address rather than the page
!	    number when it allocates a block a page or longer.
! 455	-
!
!--

!
! TABLE OF CONTENTS:
!

%IF 0
%THEN

FORWARD ROUTINE
    rc$rel,					! POSITION TO A RECORD
    getmem,
    fremem : NOVALUE;

%FI

!
! REQUIRE FILES:
!

REQUIRE 'sys:rmslus';

LIBRARY 'rmslib';

LIBRARY 'utlext';

BUILTIN
    machskip,
    POINT,
    REPLACEI,
    scani,
    copyii,
    incp,
    copyni;

!MACRO
!ILDB[] = MACHOP (%O'134', %REMAINING) %;

OWN
    rddesc : BLOCK [rdsize];

OWN
    arglst : BLOCK [5];

LITERAL
    killflag = 1;

%SBTTL 'FREMEM - Free memory'

GLOBAL ROUTINE fremem (start_addr, words) : NOVALUE = 	! Free memory

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine frees memory that was acquired via the
!	GETMEM routine. Both GETMEM and FREMEM interface
!	with RMS's free storage management module (RMSFSM).
!	The parameters to this routine specify the start
!	of a block of memory to be freed and no. of words
!	to be freed. If the no.of words is a multiple of
!	512 words, the block is treated as page(s).
!
! FORMAL PARAMETERS:
!
!	START_ADDR:
!	WORDS:
!
    BEGIN

    LOCAL
	temp1,
	temp2,
	func;

    IF (temp2 = .words^w2p) GTR 0
    THEN
	BEGIN
	temp1 = .start_addr^w2p;		! CONVERT ADDR TO PAGE NO
	temp2 = .temp2 + (IF .words MOD 512 GTR 0 THEN 1 ELSE 0);
	func = u$ppage;				! FREE PAGE
	END
    ELSE
	BEGIN
	temp1 = start_addr;			! FREEING BLOCK OF MEMORY
	temp2 = .words;
	func = u$pmem;				! FREE BLOCK OF MEMORY
	END;

    bld_arg_lst (arglst, .func, .temp1, .temp2, killflag);
    $utlint (arglst, interr);
    RETURN;
    END;					! end of routine FREMEM

%SBTTL 'GETMEM - Allocate memory'

GLOBAL ROUTINE getmem (size_of_alloc) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called to allocate a block of memory from
!	the RMS's free storage manager. If the block of memory exceeds
!	512 words, the request is treated as a multiple of pages and
!	GPAGE function in RMS is called. Else the GMEM function is
!	called.
!
! FORMAL PARAMETERS:
!
!	SIZE_OF_ALLOC
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	None
!
! COMPLETION CODES:
!
!	Returns the address of allocated block of memory.
!	On an RMS error, control is transferred to INTERR.
!
! SIDE EFFECTS:
!
!	None
!--

    BEGIN

    LOCAL
	func,
	temp1;

    IF (temp1 = .size_of_alloc^w2p) GTR 0
    THEN
	BEGIN
	func = u$gpage;				! GET PAGE FUNCTION
	temp1 = .temp1 + (IF .size_of_alloc MOD 512 GTR 0 THEN 1 ELSE 0);
	END
    ELSE
	BEGIN
	func = u$gmem;				! GET BLOCK OF MEM
	temp1 = .size_of_alloc;			!NO OF WORDS TO ALLOC
	END;

    bld_arg_lst (arglst, .func, .temp1);
    $utlint (arglst, interr);

    IF .func EQL u$gmem				! Did we get words?	!A430
    THEN 					!			!A430
	RETURN .arglst [0, wrd]			! Yes - return address	!M430
    ELSE 					!			!A430
	RETURN (.arglst [0, wrd])^9;		! Convert page to addr	!A430

    END;					! end of GETMEM routine

%SBTTL 'RC$FIND - find a record'

GLOBAL ROUTINE rc$find =
! RC$FIND - FINDS A RECORD USING "RAB"
! RETURNS:
!	-1 IF ERR MSG OUTPUT, 0 IF RNF, OR PHYSICAL RFA OF RECORD FND
! NOTES:
!	RB$NRP MUST BE SET SO THAT THE PHYSICAL RFA IS RETURNED
!	PHYSICAL RFA MEANS THE UDR RATHER THAN ITS RRV FOR PRIM KEY
!	AND THE SIDR RATHER THAN THE UDR FOR SEC KEY
    BEGIN

    EXTERNAL
	scanning;				!FLAG TO DET IF SCANNING CMD

    IF .scanning AND (chkflag ($field (rop, .rab), rb$kgt) EQL 0)	!LOW LIM OF SCAN WANTS DEL ENTS INCL
    THEN
	BEGIN					!SCANNING

	LOCAL
	    bkdesc : BLOCK [bdsize];

	LOCAL
	    pt1 : REF BLOCK;

	LOCAL
	    nrp1;

	rddesc [rdusersize] = .$field (ksz, .rab);
	rddesc [rduserptr] = .$field (kbf, .rab);
	rddesc [rdflags] = rdflghorizok;	!FIND GE KEY
	bld_arg_lst (arglst, u$fnddata, rddesc, bkdesc);
	$utlint (arglst, interr);		!FIND HI KEY REC (EVEN IF DEL)
	pt1 = .rddesc [rdrecptr];		!GET PTR TO ACTU REC
	nrp1 = makerfa (.bkdesc [bkdbktno], .pt1 [drrecordid]);
	bd$put (bkdesc, 0);			!DONT NEED DATA ITSELF

	IF chkflag (rddesc [rdstatus], rdflgpst)
	THEN
	    RETURN 0				!KEY TOO HI, NO SUCH REC
	ELSE
	    RETURN .nrp1;			!RET ENTRY FND

	END;

    ;
    $field (rop, .rab) = .$field (rop, .rab) OR rb$nrp;
    $find (.rab);				!TRY TO LOCATE THE RECORD

    IF .$field (sts, .rab) EQL er$rnf		!REASONABLY FAIL?
	OR .$field (sts, .rab) EQL er$eof	!REASONABLY FAIL?
    THEN
	RETURN 0;				!YES

    IF m$erms (.rab, 				!
	    UPLIT (%ASCIZ'?UTLURR unable to setup record range')) EQL 1	!
    THEN

	IF .scanning				!IS IT SCANNING CMD?
	THEN
	    RETURN .rst [rstnrp]		!YES, RET RFA OF SEQ ELEM IN IDX
	ELSE
	    RETURN .rst [rstdatarfa]		!NO, PHYS UDR ADDR
    ELSE

	RETURN -1;				!OOPS

    END;

%SBTTL 'RC$GET - read a record'

GLOBAL ROUTINE rc$get =
! RC$GET - READS RECORD USING "RAB"
! RETURNS:
!	-1 IF ERR MSG OUTPUT, 0 IF RNF, OR PHYS RFA OF RECORD THAT WAS GOTTEN
! NOTES:
!	KLUDGE AROUND FACT THAT 1ST GET AFTER FIND ZEROES RSTNRP
    BEGIN

    LOCAL
	t1;

    t1 = .rst [rstnrp];				!SAVE NRP
    $get (.rab);				!TRY TO LOCATE THE RECORD

    IF .rst [rstnrp] EQL 0 THEN rst [rstnrp] = .t1;	!RESTORE IT IF GET ZAPPED IT

    IF .$field (sts, .rab) EQL er$rnf		!REASONABLY FAIL?
	OR .$field (sts, .rab) EQL er$eof	!REASONABLY FAIL?
    THEN
	RETURN 0;				!YES

    IF m$erms (.rab, 				!
	    UPLIT (%ASCIZ'?UTLUGR unable to get record')) EQL 1
    THEN
	RETURN .rst [rstdatarfa]		!TELL CALLER WHAT FOUND
    ELSE
	RETURN -1;				!OOPS

    END;

%SBTTL 'RC$RFA - find data entry by RFA'

GLOBAL ROUTINE rc$rfa (entrfa) =
! RC$RFA - FIND DATA-LEVEL ENTRY BY RFA VALUE
! ARGUMENTS:
!	ENTRFA = RFA OF REC TO FIND
! RETURNS:
!	0 IF REC NOT FND
!	1 IF FND
    BEGIN

    LOCAL
	bkdesc : BLOCK [bdsize];

    rddesc [rdrecptr] = 0;			!INSURE DONT IMPROP START IN MID
    rddesc [rdrfa] = .entrfa;			!MAKE ARG PASSABLE
    bld_arg_lst (arglst, u$fbyrfa, rddesc, bkdesc, 0);
    $utlint (arglst, bugerr);			!READ IN THIS RECORD

    IF .$field (sts, arglst) EQL er$rfa THEN RETURN 0;	!NO REC TO GET KEY FROM

    IF .arglst EQL 0				!ANY OTHER FAILURE?
    THEN
	RETURN m$erms (arglst, 			!
		UPLIT (%ASCIZ'?UTLUIO unable to do I/O'));

    bd$put (bkdesc, 0);				!GIVE IT BACK
    RETURN 1;					!RET FND ENTRY
    END;					!RC$RFA

%SBTTL 'RC$REL - position by relative record number'

GLOBAL ROUTINE rc$rel (rstblock, recnum) =
! FUNCTIONAL DESCRIPTION:
!	This routine is called to position an imaginary
!	record pointer to a record identified by a signed
!	number. The number defines the new record position
!	relative to the RFA passed.
!	For ex., if the argument ,i.e., relative record number,
!	is +1 the record pointer is positioned to the next record.
!	If it -1, the record pointer is positioned to the previous
!	record etc. .
!
! FORMAL PARAMETERS:
!	RSTBLOCK.	RST DATA CORRES TO RELATIVE 0
!	RECNUM.		RELATIVE RECORD NUMBER
!
! COMPLETION CODES:
!	-1 = FAILURE WITH MSG
!	 0 = FAILURE.
!	m,,n = RFA OF RECORD FOUND
!
    BEGIN
!	V1 RESTRICTON: RECNO MUST BE GE 0

    LABEL
	consis;

    LOCAL
	p1 : REF BLOCK;

    LOCAL
	tempbd : REF BLOCK;

    LOCAL
	t1;

    m$rstcop (.rstblock, .rst);			!RESTORE RST INFO
    bd$put (rst [rstcbkd1], 0);			!CLEAR AWAY WHATS THERE
    rddesc [rdrfa] = .rst [rstdatarfa];		!PHYS LOC RECORD
    bld_arg_lst (arglst, u$fbyrrv, rddesc, rst [rstcbkd1]);
    $utlint (arglst, bugerr);			!HAVE RMS SET CURR KEY

    IF .$field (sts, arglst) EQL er$rfa		!NO LONGER THERE?
    THEN
	BEGIN					!YES
	txtout (utlrnx);			!CANT REPOS BECAUS REC EXPUNGED
	RETURN -1;				!TELL CALLER
	END;

    IF .arglst EQL 0				!ANY OTHER FAILURE?
    THEN
	RETURN m$erms (arglst, 			!
		UPLIT (%ASCIZ'?UTLUIO unable to do I/O'));	!

    rst [rstpagptr] = .rddesc [rdrecptr];	!PUT CURR REC'S LOC INTO RST
    p1 = .rddesc [rdrecptr];			!CHK DELETED FLAG
    rst [rstlastoper] = c$find;			!WANT $GET TO GET SAVED REC
    $field (rac, .rab) = rb$seq;		!SET ACC MODE

    IF .recnum GTR 0
    THEN

	DECR j FROM .recnum TO 1		!LOCATE RELATIVE TO CURR
	    DO
	    BEGIN
	    $find (.rab);

	    IF .$field (sts, .rab) EQL er$rnf	!REASONABLY FAIL?
		OR .$field (sts, .rab) EQL er$eof	!REASONABLY FAIL?
	    THEN
		RETURN 0;			!YES

	    IF m$erms (.rab, 			!
		    UPLIT (%ASCIZ'?UTLUGR unable to get record')) LEQ 0	!
	    THEN
		RETURN -1;			! OOPS

	    END

    ELSE
consis :
	BEGIN					!VERIF THAT CURR REC STILL THERE

	IF deleteflag (p1) NEQ 0		!IS IT LOGICALLY DELETED?
	THEN
	    BEGIN
	    txtout (utlpno);			!YES, REC DEL, SO POS NOT OCC
	    RETURN -1;
	    END;

	IF .kdb [kdbref] EQL 0			!SIDR ARRAY CHK NECES?
	THEN
	    LEAVE consis;			!NO, PRIM KEY

	rddesc [rdrecptr] = 0;			!INSURE DONT IMPROP START IN MID
	rddesc [rdrfa] = .rst [rstnrp];		!PHYS LOC RECORD
	bld_arg_lst (arglst, u$fbyrfa, rddesc, tempbd, 0);
	$utlint (arglst, interr);		!HAVE RMS SET CURR KEY
	p1 = .rddesc [rdrecptr];		!GET PTR TO REC
	t1 = .ksizw + .kdb [kdbhsz] + .rst [rstsidrelement] - 1;	!PTR TO APPROP ELEM IN SIDR ARR
	t1 = .p1 [.t1, wrd];			!GET VAL OF WD SO CAN PUTBKT
	bd$put (tempbd, 0);			!GIVE IT BACK

	IF .t1 NEQ 0 THEN LEAVE consis;		!IS ARRAY ELEM OCC?

	txtout (utlpno);			!POS NOT OCC (EG. AFTER $UPDATE)
	RETURN -1;				!TELL CALLER ERR MSG PUT OUT
	END;					!END CONSIS

    RETURN .rst [rstdatarfa];
    END;					! End of RC$REL

%SBTTL 'M$ERMS - output message after RMS fails'

GLOBAL ROUTINE m$erms (currab, titasz) =
! M$ERMS - OUTPUT APPROPRIATE MESSAGE AFTER RMS FAILURE
! ARGUMENTS:
!	CURRAB = PTR TO ARGBLK USED IN LAST RMS CALL
!	TITASZ = PTR TO ASCIZ STRING TO USE IN BEGINNING OF MSG
! RETURNS:
!	-1 IF MESSAGE PUT OUT
!	1 IF SU$--- WAS ERROR CODE
! NOTES:
!	EXITS TO CMD LEVEL IF CODE IS ER$BUG
    BEGIN

    EXTERNAL
	rmevec : VECTOR;			!SYMBOLIC RMS ERRS

    LOCAL
	cause,
	sts,
	stv;

    MACRO
	$cause (err$, msg$) =
	!SET PTR TO MSG FOR USER-CAUSED RMS ERR
		IF .sts EQL err$ THEN cause = UPLIT (%ASCIZ msg$)
	%;

    sts = .$field (sts, .currab);		!GET RMS OPERATION STATUS
    stv = .$field (stv, .currab);		!GET 2NDARY STATUS, IN CASE NEEDED

    IF .sts LSS er$bas THEN RETURN 1;		!NO PROBLEM

    IF .sts EQL er$bug THEN interr ();		!JUST GIVE UP ON RMS INT ERR

    cause = 0;					!INDIC NO CAUSE IDENT YET
    $cause (er$chg, 'key not declared changable');
    $cause (er$del, 'record deleted');
    $cause (er$dme, 'no more room in memory');
    $cause (er$dup, 'duplicates not allowed');
    $cause (er$fex, 'file already exists');
    $cause (er$fnf, 'file not found');
    $cause (er$flk, 'the access mode of another program conflicts');
    $cause (er$fsi, 'file spec improperly formatted');
    $cause (er$ksz, 'invalid key size specified');
    $cause (er$prv, 'of inadequate file access privileges');
    $cause (er$rtb, 'record buffer too small');
    $cause (er$siz, 'key longer than 255 characters');

    IF .cause NEQ 0				!USER-CAUSED ERR?
    THEN
	txtout (utlxrf, .titasz, .cause)	!yes. tell him		!M435
    ELSE
	txtout (utlurf, .titasz, rmevec [.sts - er$bas], .stv);	!M435

    RETURN -1;					!GIVE ERR MSG FAILURE RET
    END;					!END M$ERMS

%SBTTL 'M$KDB - set up KDB, etc.'

GLOBAL ROUTINE m$kdb (keyref) =
! M$KDB - SETUP KDB, RABKRF, KSIZB/W GIVEN KEY OF REF
! ARGUMENTS:
!	KEYREF = KEY OF REF
! RETURNS:
!	1 & FLDS SET UP  OR  0, INDICATING KREF OUT OF RANGE
    BEGIN
    bld_arg_lst (arglst, u$getkdb, .keyref);
    $utlint (arglst, bugerr);			!HAVE RMS SET CURR KEY

    IF .arglst EQL 0 THEN RETURN 0;		!RMS DIDNT RECOG THE KRF

    kdb = .arglst;				!PERMANIZE IN RMSUTL ENVIR
    ksizw = .kdb [kdbkszw];			!MAKE KEY SIZ WDS AVAIL
    ksizb = .kdb [kdbksz];			!DITTO BYTES
    !
    !   Set up the datatype as RMSM2 knows it
    !
    ktype = (					!			!A455
    CASE .kdb [kdbdtp]				! Get key datatype	!A455
    FROM xb$stg TO xb$un4 OF 			! Range of datatypes	!A455
	SET 					!			!A455
	[xb$stg] : dtp$k_asc;			! ASCII			!A455
	[xb$six] : dtp$k_six;			! SIXBIT		!A455
	[xb$ebc] : dtp$k_ebc;			! EBCDIC		!A455
	[xb$pac] : dtp$k_pac;			! Packed decimal	!A455
	[xb$in4] : dtp$k_in4;			! Integer		!A455
	[xb$fl1] : dtp$k_fl1;			! 1-word floating	!A455
	[xb$fl2] : dtp$k_fl2;			! 2-word floating	!A455
	[xb$gfl] : dtp$k_gfl;			! G-Floating		!A455
	[xb$in8] : dtp$k_in8;			! Double-integer	!A455
	[xb$as8] : dtp$k_as8;			! 8-bit ASCII		!A455
	[xb$un4] : dtp$k_un4;			! Binary		!A455
	[INRANGE, OUTRANGE] : dtp$k_asc;	! Default to ASCII	!A455
	TES);					!			!A455
    $field (krf, .rab) = .keyref;		!SET IN ARGBLK TOO
    RETURN 1;
    END;					!M$KDB

%SBTTL 'M$KLOC - locate entry''s key-value'

GLOBAL ROUTINE m$kloc (kbfadr, entadr, bktype) =
! M$KLOC - LOCATE (AND COPY AND COMBINE IF NECESSARY) ENTRY'S KEY-VALUE
! ARGUMENTS:
!	KBFADR = ADDR OF KEY BUFFER
!	ENTADR = ADDRESS OF ENTRY
!	BKTYPE = TYPE OF BKT KEY IS BEING PICKED UP FROM
! RETURNS:
!	ADDRESS WHERE KEY-VALUE (NOW) IS OR -1 IF INTERNAL ERROR
    BEGIN

    LOCAL
	prikdb : REF BLOCK;

    IF .bktype EQL bty_sec THEN RETURN .entadr + sidrhdrsize;	!SET KEY LOC IN SDIR

    IF .bktype EQL bty_prim			!LOCATING KEY VAL IN UDR?
    THEN
	BEGIN					!YES
	prikdb = .fst [fstkdb];			!ADDR OF PRI KDB
	bld_arg_lst (arglst, u$movekey, .entadr + .prikdb [kdbhsz], .kbfadr);
	$utlint (arglst, interr);		!COPY THE KEY VALUE
	RETURN .kbfadr;
	END;

    IF .bktype EQL bty_idx			!LOCATING KEY VAL IN IDX ENT?
    THEN
	RETURN .entadr + irhdrsize;		!RET ADDR ACTU IN ENTRY

    txtout (utliue);				!BAD BKTYPE ARG
    RETURN -1;
    END;					!M$KLOC

%SBTTL 'M$KUDR - copy record key to buffer'

GLOBAL ROUTINE m$kudr (kbfadr, entadr) =
! M$KUDR - COPY REC'S KEY TO BUF AT KBFADR
! ARGUMENTS:
!	KBFADR = ADDR OF KEY BUFFER
!	ENTADR = ADDRESS OF UDR, RFA OF UDR, OR 0 (USE RSTPAGPTR)
! RETURNS:
!	NORMALLY 1 IF KEY-VALUE FND, -1 IF SCREWUP
!	KEY IN BUFFER & KSZ AND KBF SETUP IF T1 GE 1
!	IF ENTADR=RFA, ADDIT RULES:
!	0 IF NO REC FOR GIVEN RFA, 1 IF RFA OF DELETED REC, PHYS RFA IF REC OK
    BEGIN

    LOCAL
	bkdesc : BLOCK [bdsize];

    MAP
	entadr : REF BLOCK;

    rddesc [rdrfa] = 1;				!PRESUME NORM CASE & SUCC

    IF .entadr EQL 0				!USING DEFAULT ENTRY ADDR?
    THEN
	entadr = .rst [rstpagptr];		!YES

    IF .entadr<lh> NEQ 0			!IS ARG RFA?
    THEN
	BEGIN					!YES
	rddesc [rdrfa] = .entadr;		!MAKE ARG PASSABLE
	bld_arg_lst (arglst, u$fbyrrv, rddesc, bkdesc);
	$utlint (arglst, bugerr);		!READ IN THIS RECORD, IF ENTADR=RRV, RDRFA RESET TO PHYS RFA

	IF .$field (sts, arglst) EQL er$rfa THEN RETURN 0;	!NO REC TO GET KEY FROM

	IF .arglst EQL 0			!ANY OTHER FAILURE?
	THEN
	    RETURN m$erms (arglst, 		!
		    UPLIT (%ASCIZ'?UTLUIO unable to do I/O'));	!

	entadr = .rddesc [rdrecptr];		!GET ADDR OF REC

	IF deleteflag (entadr) NEQ 0		!REC DELETED?
	THEN
	    rddesc [rdrfa] = 1;			!INDIC KEY SET UP, BUT REC DEL

	bd$put (bkdesc, 0);			! DONT NEED BKT
	END;

    IF rrvflag (entadr) NEQ 0			!SHOULDNT HAPPEN
    THEN
	BEGIN					!OOPS, SOMEHOW PTING AT RRV
	txtout (utliue);			!GIVE MSG
	RETURN -1;
	END;

    $field (kbf, .rab) = 			! LOC KEY & SET BUF ADDR IN RAB
    m$kloc (.kbfadr, .entadr, bty_prim);
    $field (ksz, .rab) = .kdb [kdbksz];		!DITTO KSZ
    RETURN .rddesc [rdrfa];
    END;

%SBTTL 'M$USET - set environment for $UTLINT'

GLOBAL ROUTINE m$uset : NOVALUE =
! M$USET - SET CURR ENV FOR $UTLINT
    BEGIN
    bld_arg_lst (arglst, u$setenvir, .rab);
    $utlint (arglst, interr);			!SET RABUTL IN RMSUIN
    nrp$ad = rst [rstnrp];			!SAVE PTR TO RSTNRP
    bld_arg_lst (arglst, u$path, 0);
    $utlint (arglst, interr);			! NO ERRORS EXPECTED
    path = .arglst [0, wrd];			!ADDR OF PATH ARRAY
    RETURN;
    END;

%SBTTL 'M$RSTCOP - copy NRP data between RSTs'

GLOBAL ROUTINE m$rstcop (rstcur, rstsav) : NOVALUE =
! M$RSTCOP - COPIES NRP RELATED DATA BETWEEN RST COPIES
! ARGUMENTS:
!	RSTCUR = POINTER TO RST TO COPY
!	RSTSAV = POINTER TO SAVE BLK
! NOTES:
!	USED BY RC$REL TO ESTAB CURR REC.
!	ADDIT, LASTOPER ALWAYS SET TO FIND AND PAGPTR 0-ED
    BEGIN

    MAP
	rstcur : REF BLOCK;

    MAP
	rstsav : REF BLOCK;

    rstsav [rstflags] = .rstcur [rstflags];
    rstsav [rstdatarfa] = .rstcur [rstdatarfa];
    rstsav [rstnrp] = .rstcur [rstnrp];
    rstsav [rstrpref] = .rstcur [rstrpref];
    rstsav [rstnrpref] = .rstcur [rstnrpref];
    rstsav [rstnrprrv] = .rstcur [rstnrprrv];
    rstsav [rstsidrelement] = .rstcur [rstsidrelement];
    rstsav [rstrpsidr] = .rstcur [rstrpsidr];
    RETURN;
    END;					!END M$RSTCOP

END

ELUDOM