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