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

module rescan (	!
		ident = '1',
		%if
		    %bliss(bliss32)
		%then
		    language(bliss32),
		    addressing_mode(external=general,
				nonexternal=long_relative)
		%else
		    language(bliss36)
		%fi
		) =
begin

!
!			  COPYRIGHT (C) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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 WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! Facility:	Miscellaneous tool
!
! Abstract:
!
!	Pick up the command line which was used to invoke the called
!	program and return it to the requestor.
!
! Environment: VAX/VMS, DS-20, TOPS-10
!
! Author:	Earl Van Horn	Creation Date:	17-Oct-1979
!
!--

!
! Table of Contents:
!

forward routine
    getcline ;

!
! Include Files:
!

%if %bliss(bliss32) %then
    library 'SYS$LIBRARY:STARLET' ;
    undeclare %quote $descriptor ;	! Conflict with XPORT
%fi
library 'XPORT:' ;
%if %bliss(bliss36) %then
    %if %switches(tops20) %then
	require 'JSYS:';
    %else
	require 'UUO:';
    %fi
%fi
require 'BLISSX:' ;

!
! Macros:
!

!
! Equated Symbols:
!

!
! Own Storage:
!

!
! External References:
!

external literal
    %if vaxvms %then
    lib$_inpstrtru,			! input string truncated by get_foreign
    %fi
    s_editerr,
    s_nocmnd,
    s_clinenot,				 !could not get command line
    s_cltoolong;		 	 !command line is too long

external routine
    ers,				 ! Report a user mistake.
%if %bliss(bliss32) %then
    bugsts : novalue,			 ! Report a bug involving system status
    lib$get_foreign;			 ! get command line
%else
    bug;
%fi

global routine getcline(a_buffer, max_chars) =

!++
! Functional Description:
!
!	Obtain the command line that was used to invoke the program, and
!	copy it into the buffer supplied by the caller.
!
!	If the user typed too many characters, he is informed of his mistake
!	and -1 is returned.
!
! Formal Parameters:
!
!	a_buffer:	! Address of the buffer where a copy of the command
!			! line is to be stored.
!	max_chars:	! Number of characters that the buffer can hold.
!
! Implicit Inputs:
!
!	The command line is read.
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	The number of characters stored into the buffer is returned,
!	unless the user typed more characters than the buffer can hold.
!	In that case -1 is returned.
!
! Side Effects:
!
!	None
!
!--

    begin	! GETCLINE

%if %bliss(bliss36) %then
    %if %switches(tops20) %then
    LOCAL
	COUNT,			! Length of returned string
	R_PTR,			! Pointer to buffer to be read
	REAL_COUNT,		! COUNT minus leading fac_name and trailing CRLF
	SUCCESS_BITS,		!Information returned by successful RDTTY.
	UPDATED_PTR,		!Character pointer to position one beyond the
				!last character read.
	W_PTR;			! Pointer to buffer to be written

    ! make rescan buffer data available to any job in the current process
    IF
	not RSCAN($rsini) 
    THEN
	BUG(LIT('GETCLINE could not set the rescan marker.'));
    ! Kludge to get around BLISS bug
    SUCCESS_BITS = 0 ;

    IF
	not RDTTY(CH$PTR(.A_BUFFER),.MAX_CHARS,0;UPDATED_PTR,SUCCESS_BITS) 
    THEN
	ERS(s_clinenot,LIT('Could not get the command line'));

    !Report unusual successes.
    IF
	.SUCCESS_BITS<23,1> EQL 0	!B12 off means byte count exhausted.
    THEN
	BEGIN	!Too long.
	ERS(s_cltoolong,LIT('Command line is too long'));
	RETURN -1;
	END;
    IF
	.SUCCESS_BITS<21,1> EQL 1	!B14 on means too much editing.
    THEN
	BEGIN	!Too much editing.
	ERS(s_editerr,LIT('The backup limit for editing was reached'));
	RETURN -1;
	END;

    COUNT = CH$DIFF(.UPDATED_PTR,CH$PTR(.A_BUFFER));

    ! Get rid of leading 'fac_name'
    W_PTR = CH$PTR(.A_BUFFER) ;
    R_PTR = CH$PTR(.A_BUFFER) ;
    DO
	COUNT = .COUNT - 1
    WHILE
	CH$RCHAR_A(R_PTR) NEQ %C' ' AND
	.COUNT NEQ 0 ;
    IF
	.COUNT LSS 0
    THEN
	ERS(s_nocmnd,LIT('No command specified')) ;

    REAL_COUNT = .COUNT ;
    ! Rewrite buffer in place, ignoring leading fac_name and trailing CR or LF
    
    DECR I FROM .COUNT TO 0 DO
	BEGIN
	LOCAL
	    CHAR;		! Character read
	
	CHAR = CH$RCHAR_A(R_PTR) ;
	IF .CHAR EQL $chcrt		!Carriage return
	   OR .CHAR EQL $chlfd		! Line feed
	THEN
	    REAL_COUNT = .REAL_COUNT - 1 	!decrement length to be returned
	ELSE
	    CH$WCHAR_A(.CHAR, W_PTR)		! write character
	END;
    .REAL_COUNT
    %else
	local
	    char,
	    charCount,
	    csPtr;	! character sequence pointer

	if UUO(1,RESCAN(0)) neq 1 then
	    BUG(LIT('GETCLINE could not set the rescan marker.'));

	! skip over "fac_name "
	do
	    UUO(0,INCHWL(char))
	while (.char neq %C' ') and (.char neq %O'15');

	csPtr = ch$ptr(.a_buffer);

	! copy command line to the buffer
	incr charCount from 0 do
	    begin

	    ! read next char
	    UUO(0,INCHWL(char));

	    ! check for CR or LF
	    if (.char eql %O'15') or (.char eql %O'12') then exitloop;
	    if .charCount geq .max_chars then
		BEGIN		!Too long.
		ERS(s_cltoolong,LIT('Command line is too long'));
		RETURN -1;
		END;

	    ch$wchar_a(.char,csPtr);
	    end;

	if .charCount leq 0 then
	    ERS(s_nocmnd,LIT('No command specified')) ;

	.charCount

    %fi
%fi

%if %bliss(bliss32) %then

    local
	length : word,			! length of command line return
	d_buffer : $str_descriptor(),	! desc for buffer to be filled in
	status ;			! System status code.


    $str_desc_init (descriptor = d_buffer,
		    string = (.max_chars,.a_buffer) );

    status = lib$get_foreign (d_buffer, 0, length);

    if .status eql lib$_inpstrtru
    then
	begin	! Too long.
	ers(s_cltoolong,lit('Command line is too long')) ;
	return -1 ;
	end ;	! Too long.

    if not .status
    then
	ERS(s_clinenot,LIT('Could not get the command line'));

    RETURN .length;
%fi

    end ;  ! GETCLINE

end				! Module RESCAN
eludom