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

MODULE RMCUTIL(!RMCOPY GENERAL UTILITY ROUTINES
		  IDENT = '10'
		  ) =
BEGIN

! COPYRIGHT (C) 1978
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754
!
! THIS SOFTWARE IS FURNISHED  UNDER A LICENSE FOR USE ONLY ON A SINGLE
! COMPUTER  SYSTEM AND  MAY BE  COPIED ONLY WITH  THE INCLUSION OF THE
! ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY OTHER COPISE THEREOF,
! MAY NOT BE PROVIDED OR  OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
! EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE
! TERMS.  TITLE TO AND  OWNERSHIP OF THE  SOFTWARE  SHALL AT ALL TIMES
! REMAIN IN DEC.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD  NOT BE CONSTRUED  AS A COMMITMENT  BY DIGITAL  EQUIPMENT
! CORPORATION.
!
! DEC ASSUMES  NO  RESPONSIBLILTY  FOR  THE USE OR  RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
!
!++
! FACILITY:
!	RMCOPY TRANSPORTABLE CODE
!
! ABSTRACT:
!	This module DOES the INPUT COMD REQUEST, BASIC SYNTAX TESTING AND 
!	OPTION SWITCH DETECTIION AND LEGALLY CHKING.
!	indirect command file REQUESTS,CMD STRING AND node name 
!	checking ARE ALSO DONE IN THIS MODULE.
!
! ENVIRONMENT:
!	TRANSPORTABLE
!
! AUTHOR: JOHN DEROSE, CREATION DATE: FEB 1978
!
! MODIFIED BY:
!
!--
!

! TABLE OF CONTENTS:
!
FORWARD ROUTINE
	FILE_SPEC,		!FILE SPEC PTR ROUTINE
	COPY_SPEC,		!COPY FILE SPEC STRING FROM PTRS ROUTINE
	COMPRESS_BLKS,		!COMPRESS BLANKS ROUTINE
	BYPSBL,			!BY-PASS BLANKS ROUTINE
	RMC_RDNUMA,		!RADIX CHECK/ASCII TO NUMERIC 
				!CONVERT ROUTINE
	RMC_STRIPSTRING,	!STRIP TEXT STRING TO NEXT NON 
				!ALPA/NUMERIC CHAR. ROUTINE
	FND_VALUE,		!FIND VALUE ROUTINE
	FND_PATTERN;		!FIND PATTERN ROUTINE

! DEFINITION LIBRARY FILES:
!
LIBRARY 'RMCOPY';	!The interface to the system-independent portion
REQUIRE 'RMCOPT.REQ';	!ASCII COMPARSION TABLES
!
!
! CONDITIONAL COMPILATION:
!
	%IF FTTOPS10 %THEN %INFORM ('RMCOPY FOR TOPS10') %FI
	%IF FTTOPS20 %THEN %INFORM ('RMCOPY FOR TOPS20') %FI
	%IF FTVAX %THEN %INFORM ('RMCOPY FOR VAX') %FI
!
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
!	NONE
!


GLOBAL ROUTINE COPY_SPEC(STRGEPTR,STRGECNT,FILEPTR)=
BEGIN

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BIND CHARACTERS=PLIT(%ASCIZ ':[],.');

LOCAL
	PTRPERIOD,	!POINTER TO PERIOD CHAR
	PTRCOLON,	!POINTER TO COLON CHAR
	PTRLTBKT,	!POINTER TO LEFT BRACKET CHAR
	PTRRTBKT,	!POINTER TO RIGHT BRACKET CHAR
	PTRCOMMA;	!POINTER TO COMMA CHAR

MAP FILEPTR:	REF FILE$ARG;

PTRCOLON=CH$PTR(CHARACTERS);
PTRLTBKT=CH$PLUS(.PTRCOLON,1);
PTRRTBKT=CH$PLUS(.PTRLTBKT,1);
PTRCOMMA=CH$PLUS(.PTRRTBKT,1);
PTRPERIOD=CH$PLUS(.PTRCOMMA,1);

CH$COPY(.FILEPTR[DSK$CNT],	!DSK TEXT CHAR CNT
	.FILEPTR[DSK$PTR],	!DSK TEXT CHAR PTR
	!IF DSK COUNT IS NOT  ZERO THEN ADD DSK COLON
	IF .FILEPTR[DSK$CNT] NEQ 0 THEN 1 ELSE 0,
	.PTRCOLON,		!FILE SPEC DSK COLON PTR
	!IF PPN AND SFD COUNT IS NOT  ZERO THEN ADD LT BRACKET
	IF .FILEPTR[PPN$CNT] NEQ 0 THEN 1 ELSE 0,
	!FILE SPEC LEFT BRACKET CHAR CNT
	.PTRLTBKT,		!FILE SPEC LEFT BRACKET PTR
	.FILEPTR[PPN$CNT],	!USER NUMBER CHAR CNT
	.FILEPTR[PPN$PTR],	!USER NUMBER CHAR PTR
	!IF SFD COUNT IS NOT  ZERO THEN ADD SFD COMMA
	IF .FILEPTR[SFD$CNT] NEQ 0 THEN 1 ELSE 0,
	.PTRCOMMA,		!FILE SPEC SFD COMMA PTR
	.FILEPTR[SFD$CNT],	!USER SFD CHAR CNT
	.FILEPTR[SFD$PTR],	!USER SFD CHAR PTR
	!IF PPN AND SFD COUNT IS NOT  ZERO THEN ADD RT BRACKET
	IF .FILEPTR[PPN$CNT] NEQ 0 THEN 1 ELSE 0,
	!FILE SPEC RIGHT BRACKET CHAR CNT
	.PTRRTBKT,		!FILE SPEC RIGHT BRACKET PTR
	.FILEPTR[FILE$CNT],	!FILE NAME CHAR CNT
	.FILEPTR[FILE$PTR],	!FILE NAME CHAR PTR
	1,			!FILE/EXT PERIOD DELIMITER CNT
	.PTRPERIOD,		!FILE/EXT PERIOD DELIMITER PTR
	.FILEPTR[EXT$CNT],	!FILE EXT CHAR CNT
	.FILEPTR[EXT$PTR],	!FILE EXT CHAR PTR
	.FILEPTR[VER$CNT],	!FILE VERSION NUMBER CHAR CNT
	.FILEPTR[VER$PTR],	!FILE VERSION NUMBER CHAR PTR
	%O'0',			!FILL CHAR
	.STRGECNT,		!DESTINATION CHAR CNT
	.STRGEPTR);		!DESTINATION PTR

RETURN  .FILEPTR[DSK$CNT]
	+.FILEPTR[FILE$CNT]
	+.FILEPTR[EXT$CNT]
	+.FILEPTR[PPN$CNT]
	+.FILEPTR[SFD$CNT]
	+.FILEPTR[VER$CNT]
	+ (IF .FILEPTR[SFD$CNT] NEQ 0 THEN 1 ELSE 0)
	+ (IF .FILEPTR[PPN$CNT] NEQ 0 THEN 2 ELSE 0)
	+(IF .FILEPTR[DSK$CNT] NEQ 0 THEN 1 ELSE 0)
	+1 !CNT FOR PERIOD IN FILE SPEC
!	"3" MUST BE ADDED FOR "." AND "[","]" DELIMITERS
!	IF NO DSK PRESENT THEN DON'T ADDED DSK COLON CNT
!	IF NO SFD THEN COUNTS FOR THE ADDITION BRACKETS MUST BE ADDED
!	IN OTHERWISE THE COUNT FOR THE COMMA MUST ALSO BE ADDED

END;


	
GLOBAL ROUTINE FILE_SPEC(PTR,CC,FILEPTR)=

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BEGIN
	
MAP FILEPTR:REF FILE$ARG;
LOCAL BITTMP:BITVECTOR[SWFUNC$SIZE];
LOCAL COMMAS;
LOCAL
	CURPTR,
	PASTPTR,
	CONTEXTCC;
LABEL LOOP;

!IF EMPTY TEXT STRING THEN SKIP OUT
IF .CC EQL 0 THEN RETURN 0;
COMMAS=0;		!COMMAS COUNT ZEROED
BITTMP[SFD$VAL]=BITTMP[START$VAL]=BITTMP[EXT$VAL]=BITTMP[PPN$VAL]=0;
BITTMP[FILE$VAL]=1;
CURPTR=.PTR;

LOOP:BEGIN
WHILE 1 DO
BEGIN
PASTPTR=.CURPTR;
CONTEXTCC=RMC_STRIPSTRING(CURPTR);
PTR=.CURPTR;

	BEGIN
	SELECTONE CH$RCHAR_A(CURPTR) OF SET

[%C':']:BEGIN
		IF NOT .BITTMP[START$VAL]	!WAS DEVICE FIRST THING IN STRING ?
		THEN
		BEGIN			!YES
			BITTMP[START$VAL]=1;
			FILEPTR[DSK$PTR]=.PASTPTR;		!SET DEVICE POINTER 
			FILEPTR[DSK$CNT]=.CONTEXTCC
		END
		ELSE RETURN -1	!DEVICE WAS NOT FIRST THING IN STRING...ERROR
  	END;

[%C'.']:BEGIN
		!START OF A FILE EXT. FIELD ,PREVIOUS FIELD WAS FILE NAME
		IF .CONTEXTCC GTR 0
		THEN BEGIN
			FILEPTR[FILE$PTR]=.PASTPTR;	!SAVE FILE NAME
			FILEPTR[FILE$CNT]=.CONTEXTCC;
		     END;
		!IF NO PERIOD FOR FILE SPEC THEN DON'T DEFAULT EXT
		FILEPTR[EXT$CNT]=BITTMP[FILE$VAL]=0;
		BITTMP[EXT$VAL]=BITTMP[START$VAL]=1
  	END;

[%C'[']:BEGIN
		FILEPTR[PPN$PTR]=.CURPTR;
		FILEPTR[PPN$CNT]=0;
		FILEPTR[SFD$CNT]=0;
		BITTMP[START$VAL]=BITTMP[PPN$VAL]=1;
		IF .BITTMP[EXT$VAL] 
		THEN
		BEGIN
			FILEPTR[EXT$PTR]=.PASTPTR;	!SAVE EXT. PTR
			FILEPTR[EXT$CNT]=.CONTEXTCC;
			BITTMP[EXT$VAL]=0;
		END;
		IF .BITTMP[FILE$VAL] AND .CONTEXTCC GTR 0
		THEN
		BEGIN
			FILEPTR[FILE$PTR]=.PASTPTR;
			FILEPTR[FILE$CNT]=.CONTEXTCC;
			!IF NO PERIOD FOR FILE SPEC THEN DEFAULT EXT
			BITTMP[FILE$VAL]=0
		END
  	END;

[%C']']:BEGIN
		IF .BITTMP[PPN$VAL]
		THEN
		BEGIN
			BITTMP[START$VAL]=1;
			BITTMP[PPN$VAL]=0;
			FILEPTR[PPN$CNT]=.FILEPTR[PPN$CNT]+.CONTEXTCC;
		END
		ELSE
		BEGIN IF .BITTMP[SFD$VAL]
			THEN
			BEGIN
				FILEPTR[SFD$CNT]=.FILEPTR[SFD$CNT]+.CONTEXTCC;
				BITTMP[SFD$VAL]=0
			END;
	  	END;
	END;

[%C',']:BEGIN
		IF .BITTMP[PPN$VAL] OR .BITTMP[SFD$VAL]
		THEN
		BEGIN
		SELECTONE COMMAS=.COMMAS+1 OF
		SET
		[1]:	FILEPTR[PPN$CNT]=.FILEPTR[PPN$CNT]+.CONTEXTCC+1;
		[2]:BEGIN
			FILEPTR[PPN$CNT]=.FILEPTR[PPN$CNT]+.CONTEXTCC;
			FILEPTR[SFD$PTR]=.CURPTR;
			FILEPTR[SFD$CNT]=0;
			BITTMP[PPN$VAL]=0;
			BITTMP[SFD$VAL]=1
		    END;
		[3 TO 7]: FILEPTR[SFD$CNT]=.FILEPTR[SFD$CNT]+.CONTEXTCC+1;
		[OTHERWISE]:RETURN
		TES;
		END
		ELSE RETURN
	   END;

[OTHERWISE]:BEGIN
		IF .BITTMP[PPN$VAL]
		THEN
		BEGIN
			FILEPTR[PPN$CNT]=.FILEPTR[PPN$CNT]+.CONTEXTCC
		END
		ELSE IF .BITTMP[SFD$VAL]
			THEN FILEPTR[SFD$CNT]=.FILEPTR[SFD$CNT]+.CONTEXTCC
		ELSE IF .BITTMP[EXT$VAL]
			THEN
			BEGIN
				  FILEPTR[EXT$PTR]=.PASTPTR;
				  FILEPTR[EXT$CNT]=.CONTEXTCC
			END
		    ELSE IF .BITTMP[FILE$VAL] AND .CONTEXTCC NEQ 0
				THEN
				BEGIN
					FILEPTR[FILE$PTR]=.PASTPTR;
					FILEPTR[FILE$CNT]=.CONTEXTCC
				END;
		RETURN
            END

TES;
	END;			!END OF INCREMENTAL LOOP


END;
END;
END;				!END OF ROUTINE




GLOBAL ROUTINE COMPRESS_BLKS(CHARCOUNT,OLDPTR)=
BEGIN
LABEL LOOP;
LOCAL NEWCOUNT,NEWPTR;

NEWCOUNT=.CHARCOUNT;
LOOP:BEGIN
	WHILE 1 DO
	BEGIN
	IF CH$FAIL(NEWPTR=CH$FIND_CH(.NEWCOUNT,.OLDPTR,%C' '))
	  THEN BEGIN
		 CH$WCHAR(%O'0',CH$PLUS(.OLDPTR,.NEWCOUNT));
		 RETURN .CHARCOUNT
	       END
	  ELSE BEGIN
		 NEWCOUNT=.NEWCOUNT-(CH$DIFF(.NEWPTR,.OLDPTR)+1);
		 CH$MOVE(.NEWCOUNT,CH$PLUS(.NEWPTR,1),OLDPTR=.NEWPTR);
		 CHARCOUNT=.CHARCOUNT-1
	       END
	END
END;
END; ! END OF COMPRESS_BLANKS




GLOBAL ROUTINE BYPSBL(ADDRESSPTR)=
BEGIN
LABEL LOOP;
LOCAL NEWPTR;

NEWPTR=..ADDRESSPTR;
LOOP:BEGIN
	WHILE 1 DO
	BEGIN
	  IF (RMC_STRIPSTRING(NEWPTR)) EQL 0
	  THEN BEGIN
		SELECTONE CH$RCHAR_A(NEWPTR) OF
		SET
		[%O'11',%C' ']:	!A TAB OR BLANK
			.ADDRESSPTR=.NEWPTR;
		[OTHERWISE]: RETURN 0
		TES
	      END
	ELSE RETURN 0
	END
END;
END; ! END OF BYPSBL ROUTINE



GLOBAL ROUTINE RMC_RDNUMA(SOURCE,RADIX,CHARCOUNT,NUMADDR)=
!Using ..SOURCE as a byte pointer, get an octal number and return it
!and update the byte pointer past it. RADIX is the radix.
BEGIN
LOCAL C;	!LAST CHARACTER READ
LOCAL N;	!THE NUMBER SO FAR
N=0;
WHILE 1 DO BEGIN
	IF .CHARCOUNT LEQ 0
	THEN BEGIN
		.NUMADDR=.N;
		RETURN ZERO
	     END
	ELSE CHARCOUNT=.CHARCOUNT-1;
  C=CH$RCHAR(.SOURCE);
  SELECTONE .C OF SET
    [%C'0' TO %C'0'+(.RADIX)-1]: (N=(.N*.RADIX)+(.C-%C'0');CH$RCHAR_A(SOURCE));
    [OTHERWISE]:	RETURN -1;
    TES;
  END;
END;!RDNUMA




GLOBAL ROUTINE RMC_STRIPSTRING(ADDRESS)=
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! IMPLICIT INPUTS:
!
! IMPLICIT OUTPUTS:
!
! ROUTINE VALUE:
!
! SIDE EFFECTS:
!
!--


LOCAL CHARCOUNT;

CHARCOUNT=0;

WHILE 1 DO 
BEGIN

	SELECTONE CH$RCHAR(..ADDRESS) OF
	SET

	[%C'0' TO %C'9',
	%C'A' TO %C'Z']:
		BEGIN
			CH$RCHAR_A(.ADDRESS);
			CHARCOUNT=.CHARCOUNT+1
		END;

	[OTHERWISE]:
		BEGIN
			RETURN .CHARCOUNT
		END
	TES;
END;
END;



GLOBAL ROUTINE ZEROBLK(ADDRESS,WORDCOUNT)=
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! IMPLICIT INPUTS:
!
! IMPLICIT OUTPUTS:
!
! ROUTINE VALUE:
!
! SIDE EFFECTS:
!
!--

LOCAL PTR:REF VECTOR;
PTR=.ADDRESS;
INCR INDX FROM 0 TO .WORDCOUNT-1 DO
BEGIN
	PTR[.INDX]=0
END

END;











GLOBAL ROUTINE CHK_NEXT_CHAR(PTR)=
BEGIN
  SELECTONE CH$RCHAR_A(PTR) OF
  SET
	[%O'0']:	! A NULL WAS DETECTED
			RETURN C_N_C$NULL;
	[%C' ']:	! A BLANK WAS DETECTED
			RETURN C_N_C$BLANK;
	[%C'-']:	! A DASH "-" WAS DETECTED
			RETURN C_N_C$DASH;
	[OTHERWISE]:	! SOME OTHER CHARACTER WAS DETECTED
			RETURN C_N_C$OTHER
  TES
END;



GLOBAL ROUTINE FND_PATTERN(TEXTPTR,CHARCOUNT,TABLEADDR)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!	This routine compares a text string to a table list.  If an
!	uniqueness results, the value of the associated table entree
!	is return.   If no match then a -1 is return.   The table
!	is of the following form:
!
!	TABLENAME=PLIT(UPLIT(value,%ASCIZ text string),
!			UPLIT(value,%ASCIZ text string));
!
!
! FORMAL PARAMETERS:
!
!	TEXTPTR - text string pointer
!	CHARCOUNT - text string character count
!	TABLEADDR - list table starting address
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Routine returns the following values:
!		If value 0 or > then text string match value
!		If -1 then no match or uniqueness found in table
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LABEL LOOP1,LOOP2;

LOCAL
	CONTEXTPTR,	!CONTEXT POINTER
	PATTERN,	!ACTUAL SWITCH OPTION CHAR. PTR
	LCHARCOUNT,	!LOCAL CHAR.COUNTER
	OPTION_CODE;	!SELECTED OPTION CODE OF SELECTED SWITCH


OPTION_CODE=-1;

LOOP2:
BEGIN
INCR OPTION FROM 0 TO .((.TABLEADDR)-1)-1 DO
BEGIN

PATTERN=CH$PTR(.((.TABLEADDR)+.OPTION)+1);
CONTEXTPTR=.TEXTPTR;
LCHARCOUNT=0;

LOOP1:
BEGIN
	WHILE 1 DO 
	BEGIN

	IF CH$RCHAR(.PATTERN) EQL CH$RCHAR(.CONTEXTPTR)
	THEN BEGIN
		LOCAL CHAR;
		CHAR=CH$A_RCHAR(CONTEXTPTR);
	 	LCHARCOUNT=.LCHARCOUNT+1;
		IF (.CHAR EQL %O'0') OR
	 	(.LCHARCOUNT EQL .CHARCOUNT)
		THEN IF .OPTION_CODE EQL -1 
			THEN OPTION_CODE=.(.(.TABLEADDR+.OPTION)+0)
			!A MATCH HAS BEEN MADE NOW CHECK FOR OTHERS
			ELSE BEGIN
				!DOUBLE MATCH HAS OCCURRED, LEAVE ROUTINE
				!WITH NO MATCH AND RETURN OPTION_CODE (-1)
				OPTION_CODE=-1;
				LEAVE LOOP2
			    END
		ELSE IF (CH$A_RCHAR(PATTERN) EQL %O'0') OR
		     (.LCHARCOUNT EQL .CHARCOUNT)
			THEN LEAVE LOOP1
			!MORE CHARACTERS AT THE END OF THE CONTEXT STRING
			ELSE  !JUST CONTINUE TO SCAN
		END
	ELSE LEAVE LOOP1
	!NO MATCH - JUST TRY THE NEXT DEFINITION
	END;
END;
END;
END;
RETURN .OPTION_CODE
END;




GLOBAL ROUTINE FND_VALUE(MSGvalue,tableaddr)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!	This routine compares a value to a table list.  If an
!	uniqueness results, the textptr of the associated table entree
!	is return.   If no match then a ZERO is return.   The table
!	is of the following form:
!
!	TABLENAME=PLIT(UPLIT(value,%ASCIZ text string),
!			UPLIT(value,%ASCIZ text string));
!
!
! FORMAL PARAMETERS:
!
!	VALUE - value of text string to found
!	TABLEADDR - list table starting address
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Routine returns the following values:
!		If value neq 0 then text string pointer
!		If 0 then no match or uniqueness found in table
!
! SIDE EFFECTS:
!
!	NONE
!
!--


LABEL LOOP;
LOCAL PTRVALUE_RETURN;


!Set default return value
PTRVALUE_RETURN=0;

LOOP:
BEGIN
	INCR MSGINDEX FROM 0 TO .((.TABLEADDR)-1)-1 DO
BEGIN
	IF .(.((.TABLEADDR)+.MSGINDEX)) EQL .MSGVALUE
	THEN BEGIN
		PTRVALUE_RETURN=CH$PTR(.((.TABLEADDR)+.MSGINDEX)+1);
		LEAVE LOOP;
	     END;
END;
END;
RETURN .PTRVALUE_RETURN
END;


END
ELUDOM