Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/time.bli
There are no other files named time.bli in the archive.
module time ( ! operations having to do with time.
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:
!
! The routines in this module handle the host's system time values.
!
! Environment: VAX/VMS, DS-20, TOPS-20
!
! Author: Earl Van Horn Creation Date: January 21, 1980
!
!--
!
! Table of Contents:
!
forward routine
curtim : novalue, ! Obtain the current binary system time.
hibernate : novalue, ! Hibernate for a given number of seconds.
timcop : novalue, ! Copy a time value.
timeql, ! Compare two times for equality.
timinc : novalue, ! Increase a time by a number of seconds.
timleq ; ! Compare two times for less than or equal.
!
! Include Files:
!
%if %bliss(bliss32) %then
library 'SYS$LIBRARY:STARLET' ;
undeclare %quote $descriptor ; ! Conflict with XPORT
%fi
%if %bliss(bliss36) %then
%if %switches(tops20) %then
require 'JSYS:';
%else
require 'UUO:';
%fi
%fi
library 'XPORT:' ;
require 'BLISSX:' ;
require 'TIMUSR:' ;
!
! Macros:
!
!
! Equated Symbols:
!
%if %bliss(bliss32) %then
literal
k_one_second = 10*1000*1000 ; ! Number of VMS system time units
! (100 nanoseconds) in one second.
%else
literal
k_milli = 1000, !# of milliseconds per second
k_ticks=3; !approximate # of clock ticks per second.
%fi
!
! Own Storage:
!
!
! External References:
!
external routine
%if %bliss(bliss32) %then
bugsts : novalue , ! Report a bug involving a system status code.
lib$addx : addressing_mode(general), ! Add quadword, two operands
%fi
bug : novalue; ! Report a bug.
global routine curtim(a_the_time) : novalue =
!++
! Functional Description:
!
! This routine obtains the current time in system format and
! stores it in the time block whose address is supplied.
!
! Formal Parameters:
!
! a_the_time: Address of a time block into which the current time
! will be stored.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! None
!
!--
begin ! CURTIM
%if %bliss(bliss32) %then
bind
the_time = .a_the_time : time_block ;
local
status ; ! Status code from a system service.
! The current time is specified by defaulting all fields, giving one
! delimiter, and omitting trailing delimiters.
if not (status = $bintim(timbuf = lit('-'), timadr = the_time))
then
bugsts(.status, lit('CURTIM failed to get the current time')) ;
%fi
%if %bliss(bliss36) %then
%if %switches(tops20) %then
!Get the time
gtad(;.a_the_time);
if
..a_the_time eql -1
then
bug(lit('CURTIM failed to get the current time.'))
! a_the_time is now in internal absolute date-time format
%else
register
R;
local
temp;
R<LH> = _cndtm;
R<RH> = $gtcnf;
temp = UUO(1,GETTAB(R));
if (temp neq 1) or (.R eql 0) then
bug(lit('CURTIM failed to get the current time.'));
.a_the_time = .R;
%fi
%fi
end ; ! CURTIM
global routine hibernate(seconds) : novalue =
!++
! Functional Description:
!
! This routine causes the process to hibernate for the given number
! of seconds.
!
! Formal Parameters:
!
! seconds: The number of seconds to hibernate. In this
! implementation this number must not exceed 200.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! The process hibernates for the given number of seconds.
!
!--
begin ! HIBERNATE
%if %bliss(bliss32) %then
local
hibernate_delta : time_block ;
! Make sure the given number of seconds will fit in the lower half
! of a VMS time value.
if .seconds gtr 200
then
bug(lit('HIBERNATE was asked to wait for more than 200 seconds.')) ;
! Prepare the interval to hibernate in a VMS time value.
hibernate_delta[tim_lower_longword] = - (.seconds * k_one_second) ;
hibernate_delta[tim_upper_longword] = - 1 ;
! Hibernate for that interval.
$schdwk(daytim = hibernate_delta) ;
$hiber ;
%fi
%if %bliss(bliss36) %then
%if %switches(tops20) %then
disms(.seconds*k_milli)
%else
register
R;
local
delta;
! SLEEP has a max of 68 seconds, so repeat as necessary
until .seconds leq 0 do
begin
delta = min(68, .seconds);
R = .delta;
UUO(0,SLEEP(R));
seconds = .seconds - .delta;
end;
%fi
%fi
end ; ! HIBERNATE
global routine timcop(a_source_time, a_destination_time) : novalue =
!++
! Functional Description:
!
! This routine copies a time value from one time block to another.
! Its primary purpose is the keep details of the time representation
! out of code in which it is irrelevant.
!
! Formal Parameters:
!
! a_source_time: Address of a time block containing the time value to
! be copied.
! a_destination_time:
! Address of a time block into which the time value is
! to be copied.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! None
!
!--
begin ! TIMCOP
%if %bliss(bliss32) %then
bind
source_time = .a_source_time : time_block,
destination_time = .a_destination_time : time_block ;
destination_time[tim_lower_longword] = .source_time[tim_lower_longword] ;
destination_time[tim_upper_longword] = .source_time[tim_upper_longword] ;
%fi
%if %bliss(bliss36) %then
.a_destination_time=..a_source_time
%fi
end ; ! TIMCOP
global routine timeql(a_left_time, a_right_time) =
!++
! Functional Description:
!
! This routine compares two absolute time values in system format.
!
! Formal Parameters:
!
! a_left_time: Address of the time block for the first operand.
! a_right_time: Address of the time block for the second operand.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! TRUE means the two times are equal. FALSE means not.
!
! Side Effects:
!
! None
!
!--
begin ! TIMEQL
%if %bliss(bliss32) %then
bind
left_time = .a_left_time : time_block,
right_time = .a_right_time : time_block ;
local
left_split_time: numtim_block, ! left time split out into integers
right_split_time : numtim_block, ! right time split out into integers
status ; ! return of system service
! Make sure each operand is an absolute time.
if .left_time[tim_upper_longword] lss 0
then
bug(lit('The left operand of TIMEQL is a delta time.')) ;
if .right_time[tim_upper_longword] lss 0
then
bug(lit('The right operand of TIMEQL is a delta time.')) ;
! split the times into integers (so we can ignore the hundredths of a second)
if not ( status = $numtim ( timbuf = left_split_time, timadr = left_time))
then
bugsts( .status , lit('TIMEQL failed to get an integer for the internal time'));
if not ( status = $numtim ( timbuf = right_split_time, timadr = right_time))
then
bugsts( .status , lit('TIMEQL failed to get an integer for the internal time'));
! See if they are equal
(.left_split_time[k_year_part] eql .right_split_time[k_year_part]) and
(.left_split_time[k_month_part] eql .right_split_time[k_month_part]) and
(.left_split_time[k_day_part] eql .right_split_time[k_day_part]) and
(.left_split_time[k_hour_part] eql .right_split_time[k_hour_part]) and
(.left_split_time[k_minute_part] eql .right_split_time[k_minute_part]) and
(.left_split_time[k_seconds_part] eql .right_split_time[k_seconds_part])
%fi
%if %bliss(bliss36) %then
..a_left_time eql ..a_right_time
%fi
end ; ! TIMEQL
global routine timinc(a_base_time, seconds, a_result_time) : novalue =
!++
! Functional Description:
!
! This routine adds a given number of seconds to a given time.
!
! Formal Parameters:
!
! a_base_time: Address of a time block representing an absolute time
! to be increased.
! seconds: The number of seconds to be added to the base time.
! In this implementation, this parameter cannot exceed
! 200 seconds.
! a_result_time: Address of a time block into which the increased
! absolute time value will be stored.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! None
!
!--
begin ! TIMINC
%if %bliss(bliss32) %then
bind
base_time = .a_base_time : time_block,
result_time = .a_result_time : time_block ;
! Check that an absolute time was supplied.
if .base_time[tim_upper_longword] lss 0
then
bug(lit('TIMINC was given a delta time.')) ;
! Check that the number of seconds will fit in one longword.
if .seconds gtr 200
then
bug(lit('TIMINC was asked to add more than 200 seconds.')) ;
! Initialize the result to the system equivalent of the increment.
result_time[tim_lower_longword] = .seconds * k_one_second ;
result_time[tim_upper_longword] = 0 ;
! Perform the addition.
if not lib$addx(base_time, result_time, result_time)
then
bug(lit('LIB$ADDX reported a failure to TIMINC.')) ;
%fi
%if %bliss(bliss36) %then
.a_result_time=..a_base_time+(.seconds*k_ticks)
%fi
end ; ! TIMINC
global routine timleq(a_left_time, a_right_time) =
!++
! Functional Description:
!
! This routine compares two absolute time values in system format.
!
! Formal Parameters:
!
! a_left_time: Address of the time block for the first operand.
! a_right_time: Address of the time block for the second operand.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! TRUE means the left time is less than or equal to the right time.
! FALSE means not.
!
! Side Effects:
!
! None
!
!--
begin ! TIMLEQ
%if %bliss(bliss32) %then
bind
left_time = .a_left_time : time_block,
right_time = .a_right_time : time_block ;
local
left_split_time: numtim_block, ! left time split into pieces
right_split_time : numtim_block, ! right time split into pieces
status ; ! return of system service
! Make sure each operand is an absolute time.
if .left_time[tim_upper_longword] lss 0
then
bug(lit('The left operand of TIMLEQ is a delta time.')) ;
if .right_time[tim_upper_longword] lss 0
then
bug(lit('The right operand of TIMLEQ is a delta time.')) ;
! split the times into integers (so we can ignore the hundredths of a second)
if not ( status = $numtim ( timbuf = left_split_time, timadr = left_time))
then
bugsts( .status , lit('TIMLEQ failed to get an integer for the internal time'));
if not ( status = $numtim ( timbuf = right_split_time, timadr = right_time))
then
bugsts( .status , lit('TIMLEQ failed to get an integer for the internal time'));
! Now it gets hairy ('cos there's no pretty way to do it)
! but get out as soon as you can
if .left_split_time[k_year_part] gtr .right_split_time[k_year_part]
then
return false;
if .left_split_time[k_year_part] lss .right_split_time[k_year_part]
then
return true;
if .left_split_time[k_month_part] gtr .right_split_time[k_month_part]
then
return false;
if .left_split_time[k_month_part] lss .right_split_time[k_month_part]
then
return true;
if .left_split_time[k_day_part] gtr .right_split_time[k_day_part]
then
return false;
if .left_split_time[k_day_part] lss .right_split_time[k_day_part]
then
return true;
if .left_split_time[k_hour_part] gtr .right_split_time[k_hour_part]
then
return false;
if .left_split_time[k_hour_part] lss .right_split_time[k_hour_part]
then
return true;
if .left_split_time[k_minute_part] gtr .right_split_time[k_minute_part]
then
return false;
if .left_split_time[k_minute_part] lss .right_split_time[k_minute_part]
then
return true;
if .left_split_time[k_seconds_part] gtr .right_split_time[k_seconds_part]
then
return false;
if .left_split_time[k_seconds_part] lss .right_split_time[k_seconds_part]
then
return true;
! If we get to here, the times must be equal, so return true
true
%fi
%if %bliss(bliss36) %then
..a_left_time lequ ..a_right_time
%fi
end ; ! TIMLEQ
end ! Module TIME
eludom