Google
 

Trailing-Edge - PDP-10 Archives - DEC_CMS-20_V1.0_SRC - cms/sources/dattim.bli
There are no other files named dattim.bli in the archive.
MODULE DATTIM (	! ASCII date and time operations.
		IDENT = '1',
		%IF
		    %BLISS(BLISS32)
		%THEN
		    LANGUAGE(BLISS32),
		    ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
				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:  CMS Library Processor
!
! ABSTRACT:
!
!	Pick up or convert ASCII date and time from operating system.
!
! ENVIRONMENT:  VAX/VMS, DS-20, TOPS-10
!
! AUTHOR: D. Knight , CREATION DATE: 17-Oct-79
!
!--
!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	ASCTIM,			! Convert binary time to ASCII.
	DATTIM;			! Get current time in ASCII.

!
! INCLUDE FILES:
!

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

%IF %BLISS(BLISS36)
%THEN
    %IF %SWITCHES(TOPS20)
    %THEN
	REQUIRE 'JSYS:';
    %FI
%FI

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!
%if %bliss(bliss36) %then
    %if not %switches(tops20) %then
	literal
	    k_ticks = 3;	! approximate # of clock ticks per second
    %fi
%fi
!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!
%if %bliss(bliss36) %then
    %if not %switches(tops20) %then
	external routine
	    curtim;	! get current date and time
    %fi
%fi
GLOBAL ROUTINE ASCTIM (A_BINARY_TIME, P_BUFFER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Convert the given binary time to ASCII representation and store it in
!	the buffer supplied.  The form returned is "dd-mmm-yy hh:mm:ss" for the
!	10 and 20, and "dd-mmm-yyyy hh:mm:ss" for VAX/VMS.
!
! FORMAL PARAMETERS
!
!	A_BINARY_TIME - Address of a cell containing the binary time to be
!			converted.  An address of zero means to convert the
!			current time.
!	P_BUFFER -	Character pointer to a buffer for storing the date and
!			time.  It must be at least 24 characters long.
!			The time string is left-adjusted in the buffer,
!			and the remaining characters are undefined.
!
! 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;

    !Set to return date and time
    IF
	.A_BINARY_TIME NEQ 0
    THEN
	ODTIM(.P_BUFFER,..A_BINARY_TIME,ot_4yr;TEMP)
    ELSE
	ODTIM(.P_BUFFER,-1,ot_4yr;TEMP);

    !Get the length of the string for the caller
     CH$DIFF(.TEMP,.P_BUFFER) 

    %FI
%FI

%IF %BLISS(BLISS32) %THEN

    LOCAL
	BUF_PTR : VECTOR[2],
	TEMP : WORD;

    !Set up the quad-word descriptor.
    BUF_PTR[0]=24;
    BUF_PTR[1]=.P_BUFFER;

    !Get the current date and time in ASCII
    $ASCTIM(TIMADR=.A_BINARY_TIME,TIMLEN=TEMP,TIMBUF=BUF_PTR);

    !Remove tenths and hundredths of seconds
    DO
	TEMP=.TEMP-1
    UNTIL
	CH$RCHAR(CH$PLUS(.P_BUFFER,.TEMP)) EQL %C'.';

    !Return the string length
    .TEMP

%FI

    END;				!End of ASCTIM
GLOBAL ROUTINE DATTIM (STG_BUF) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Get the date and time from the monitor and return it in
!	the buffer supplied.  The form returned is "dd-mmm-yy hh:mm:ss".
!
! FORMAL PARAMETERS
!
!	STG_BUF -  Address of buffer for placing date and time.  It must be
!		   at least 24 characters long, and must start on a fullword
!		   boundary.  The time string is left-adjusted in the buffer,
!		   and the remaining characters are undefined.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! IMPLICIT OUTPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	The length of the string is returned.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    ! Ask for the current time to be converted.
    ASCTIM(0, CH$PTR(.STG_BUF))

    END;				!End of DATTIM
END				!End of Module DATTIM
ELUDOM