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

MODULE GETACT	(
		IDENT = '1',
		%IF
		    %BLISS(BLISS36)
		%THEN
		    LANGUAGE(BLISS36)
		%ELSE
		    LANGUAGE(BLISS32),
		    ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
				    NONEXTERNAL=LONG_RELATIVE)
		%FI
		) =
BEGIN

!
!			COPYRIGHT (c) 19802 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:	CMS Library Processor (Miscellaneous Tool)
!
! ABSTRACT:
!
!	Get the current account (user name) that the program is being run from.
!
! ENVIRONMENT:	VAX/VMS, DS-20, TOPS-10
!
! AUTHOR: D. Knight , CREATION DATE: 17-Oct-79
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
        GETAC2,
	GETACT;

!
! INCLUDE FILES:
!

%IF %BLISS(BLISS32)
%THEN
    LIBRARY 'SYS$LIBRARY:STARLET';
%FI

%IF %BLISS(BLISS36) %THEN
        library 'XPORT:';      ! DEBUG
    %IF %SWITCHES(TOPS20) %THEN
	REQUIRE 'JSYS:';
    %ELSE
	REQUIRE 'UUO:';
    %FI
%FI

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

%IF %BLISS(BLISS32) %THEN
    MACRO
	JP_VAL=0,16,16,0 %,		!Item code
	JP_LEN=0,0,16,0 %,		!Item length
	JP_PTR=1,0,32,0 %,		!Pointer to buffer
	JP_RET=2,0,32,0 %;		!Return length
%FI

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

GLOBAL ROUTINE GETACT (BUF_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Get the ASCII string describing the current user name.
!
! FORMAL PARAMETERS:
!
!	BUF_PTR - address of buffer where string is to be placed.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	The length of the string is returned.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

%IF %BLISS(BLISS36) %THEN
    %IF %SWITCHES(TOPS20) %THEN

    LOCAL
        addr,
	TEMP:	BLOCK[1];

    !Length and location
    TEMP[LH]=-1;	! negative length of buffer
    TEMP[RH]=TEMP;

    !Now get the job number
    IF
	GETJI(-1,.TEMP,$JIUNO) NEQ 1
    THEN
        RETURN 0 ;
    
    !Now retrieve the information
    IF
	DIRST(ch$ptr(.BUF_PTR),.TEMP;TEMP) NEQ 1
    THEN
	RETURN 0 ;

    !Return the string length as the value
    CH$DIFF(.TEMP,ch$ptr(.BUF_PTR))

    %ELSE
	literal
	    $mlacts = 39,      !max length of account string
	    arg_block_length = 2+ch$allocation($mlacts);

	register
	    R;

	local
	    args:  vector[arg_block_length],
	    size;

	args[0] = arg_block_length;
	args[1] = -1;                !get account string of calling job
	R<LH> = $ACTRD;
	R<RH> = args;
	
	if UUO(1, ACCT$(R)) NEQ 1
	then
	    return 0;

	size = ch$diff(ch$find_ch($mlacts,ch$ptr(.buf_ptr),0),ch$ptr(.buf_ptr));
	ch$move(.size,ch$ptr(args[3]),ch$ptr(.buf_ptr));

	.size

    %FI
%FI

%IF %BLISS(BLISS32) %THEN

    LOCAL
	REQ_LST : BLOCK[3],
	SIZE : WORD;

    !Set up item list
    REQ_LST[JP_VAL]=JPI$_USERNAME;
    REQ_LST[JP_LEN]=12;
    REQ_LST[JP_PTR]=.BUF_PTR;
    REQ_LST[JP_RET]=SIZE;

    $GETJPI(ITMLST=REQ_LST);

    !Strip off trailing blanks
    WHILE
	CH$RCHAR(CH$PLUS(CH$PTR(.BUF_PTR),.SIZE-1)) EQL %C' '
    DO
	SIZE=.SIZE-1;

    !Return the size
    .SIZE

%FI

    END;				!End of GETACT

GLOBAL ROUTINE GETAC2 (BUF_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Get the ASCII string describing the current user name.
!
! FORMAL PARAMETERS:
!
!	BUF_PTR - character pointer to  buffer where string is to be placed.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	The length of the string is returned.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

%IF %BLISS(BLISS36) %THEN
    %IF %SWITCHES(TOPS20) %THEN

    LOCAL
	TEMP:	BLOCK[1];

    !Length and location
    TEMP[LH]=-1;	! negative length of buffer
    TEMP[RH]=TEMP;

    !Now get the job number
    IF
	GETJI(-1,.TEMP,$JIUNO) NEQ 1
    THEN
        RETURN 0 ;
    
    !Now retrieve the information
    IF
	DIRST(.BUF_PTR,.TEMP;TEMP) NEQ 1
    THEN
	RETURN 0 ;

    !Return the string length as the value
    CH$DIFF(.TEMP,.BUF_PTR)

    %ELSE
    0			! Shouldn't call this form TOPS-10
    %FI
%FI
%IF %BLISS(BLISS32) %THEN
    0			! Shouldn't call this routine from the VAX
%FI
    END;				!End of GETAC2

END				!End of Module GETACT
ELUDOM