Lexical Functions - F$DELTA_TIME

Our next lexical function is F$DELTA_TIME. It takes two time specifications and provides a delta time representing the difference between the two. Here is the definition:

F$DELTA_TIME returns the time difference between to dates.

Format
F$DELTA_TIME(start_time,end_time)

Return Value
A string containing a delta time specification which indicates the difference between the start and end times. The string has the following format:
+dddd hh:mm:ss.cc

Arguments
start_time

Specifies a string containing an absolute or combination time indicating the starting date/time. "TODAY", "TOMORROW", and "YESTERDAY" are also allowed.

end_time

Specifies a string containing an absolute or combination time indicating the ending date/time. "TODAY", "TOMORROW", and "YESTERDAY" are also allowed.

Example
$ X = F$DELTA_TIME("1-JAN-2019 10:10:00","1-JAN-2019 10:30:01") This would result in X containing "+0:0:20:01".

        Function_Delta : begin
                             if( Missing_Parentheses( '(' ) ) then
                             begin
                                 exit ;
                             end ;
                             if( Parse_Delta_Time( Err, Context ) ) then
                             begin
                                 exit ;
                             end ;
                             if( Missing_Parentheses( ')' ) ) then
                             begin
                                 exit ;
                             end ;
                             Result := tExpression_Node.Create ;
                             Result.Value := Context ;
                         end ;

We add code to Function_Reference to handle the lexical function.

function Parse_Delta_Time( var Err : integer ; var Context : string ) : boolean ;

var Start_Time, End_Time : string ;
    Starting, Ending : int64 ;

begin
    Start_Time := trim( Get_Parameter( Err, Context ) ) ;
    if( Err <> 0 ) then
    begin
        Result := True ;
        exit ;
    end ;
    Result := Missing_Comma( Err ) ;
    if( Result ) then
    begin
        Result := True ;
        exit ;
    end ;
    End_Time := trim( Get_Parameter( Err, Context ) ) ;
    if( Err <> 0 ) then
    begin
        Result := True ;
        exit ;
    end ;
    if( Start_Time = '' ) then
    begin
        Result := True ;
        Err := UCL_IVTIME ;
        exit ;
    end ;
    if( End_Time = '' ) then
    begin
        Result := True ;
        Err := UCL_IVTIME ;
        exit ;
    end ;
    Starting := BINTIM( Start_Time ) ;
    if( ( Last_Error <> 0 ) and ( Last_Error <> LIB_ENGLUSED ) ) then
    begin
        Result := True ;
        Err := UCL_IVTIME ;
        exit ;
    end ;
    Ending := BINTIM( End_Time ) ;
    if( ( Last_Error <> 0 ) and ( Last_Error <> LIB_ENGLUSED ) ) then
    begin
        Result := True ;
        Err := UCL_IVTIME ;
        exit ;
    end ;
    Starting := Ending - Starting ;
    Context := Delta_Time_Representation( Starting ) ;
end ; // Parse_Delta_Time

This function is simple. It gets the start and end time arguments, validates the command between them, then converts them to internal time stamps with BINTIM, and calls Delta_Time_Representation to converst the difference to a delta specification. We will cover those functions in a moment, but one thing to note is the comparison of the error with 0 (indicating success) and LIB_ENGLUSED which simply indicates that the time format defaulted to English. If the error value is neither, we exit with an error.

function BINTIM( const Time : string ) : int64 ;

var E : integer ;
    SRB : TSRB ;

begin
    Set_String( Time, SRB ) ;
    Result := 0 ;
    E := LIB_Convert_Date_String( int64( @SRB ), int64( @Result ), 0, -1 ) ;
    if( ( E <> 0 ) and ( E <> LIB_ENGLUSED ) ) then
    begin
        Result := 0 ; // Signal failure
    end ;
    Set_Error( E ) ;
end ;

As you may have noticed, the system routines pass string values via the system request buffer structure (TSRB). This not only provides for ring 0 access to outer ring data, but serves as an indirection to whatever string format is used by whichever language a program is written in. For instance, C and Pascal strings are implemented differently. Thus, starlet works with any language so long as the program properly constructs a TSRB structure to pass to the library. However, using TSRB starts to get tedious in our Pascal code. So we introduce the PasStarlet library, which is an interface to starlet and system routines that wraps the calls needing TSRB arguments so that we can call the routine with Pascal strings. The functions in this library take care of constructing the TSRBs for the passed strings. They can even unpack result values and return them as strings. Much of the data returned by system calls also must be written to a memory location in the program's data space. PasStarlet handles getting these value and returning them as function results. This simplifies our Pascal code. The BINTIM function is one of the routines in PasStarlet that performs this service for us. It takes a string and returns a timestamp value. Inside the routine, we create a TSRB structure from the passed string, and pass it to Starlet. PasStarlet uses an error code that can be queried to determine if an error occurred. If an error happens, the returned timestamp is 0. Note the check for the two possible return codes from LIB_Convert_Date_String as we discussed above.

Note that we've moved some of the other routines from Starlet into this library (those that used Pascal strings in parameters), and the Starlet API functions now all use TSRB instead. But we won't bother to show those code changes here. You will have noticed, no doubt, the "LIB_" and "SYS_" prefixes used on Starlet and system routine names. PasStarlet wraps these with functions that lack the prefix. Thus, BINTIM wraps SYS_BINTIM, which uses TSRB for the string argument. Alert readers may note "But BINTIM doesn't call SYS_BINTIM". This is true. Remember that we talked about the date/time functions being handled by Starlet routines? SYS_BINTIM is only provided for VMS compatibility, and turns around to call Starlet. We could have had BINTIM call SYS_BINTIM, but that is extra overhead, so they both directly call the Starlet routines.

procedure SYS_BINTIM( timbuf, timadr : int64 ) ;

var E, R : int64 ;

begin
    R := 0 ;
    E := LIB_Convert_Date_String( TimBuf, int64( @R ) ) ;
    if( E <> 0 ) then
    begin
        R := 0 ; // Signal failure
    end ;
    PInt64( TimAdr )^ := R ;
end ;

And here is the SYS_BINTIM function, which takes a source address (to a TSRB) structure, and a target address of an int64. It essentially does the same thing as BINTIM otherwise.

var _Last_Error : int64 = 0 ;

procedure Set_Error( E : int64 ) ;

begin
    _Last_Error := E ;
end ;


function Last_Error : int64 ;

begin
    Result := _Last_Error ;
end ;

These routines are for letting internal PasStarlet code set the last error value, and for external code to obtain the value. Each time a PasStarlet routine exits, the last error code is set properly (usually 0 indicates success).

function LIB_Convert_Date_String( DateS, DateA : int64 ;
    ContextA : int64 = 0 ; Flags : int64 = 0 ; Defaults : int64 = 0 ;
    DefaultsA : int64 = 0 ) : int64 ;

var Context : int64 ;
    Date : string ;
    Def : int64 ;
    DTSS : TDTSS ;
    SRB : PSRB ;
    TimBuf : PTimBuf ;
    Timestamp : int64 ;

begin
    // Setup...
    Result := SS_NORMAL ; // Assume success
    Context := 0 ;
    if( ContextA <> 0 ) then
    begin
        if( pint64( ContextA )^ = 0 ) then
        begin
            pint64( ContextA )^ := int64( TDate_Time_Context.Create ) ;
        end ;
        Context := pint64( ContextA )^ ;
    end ;
    SRB := PSRB( DateS ) ;
    Date := Get_String( SRB^ ) ;

This Starlet function does some of the work of converting a date/time specification into a UOS timestamp (most of the work is done by LIB_Parse_Date_Time, which we discussed three articles ago). The function can do this conversion in accordance with a caller-provided Date/Time Context instance if desired. If one is provided (neither the address is 0 nor the instance at that address is 0), then we will use that. Otherwise, the default date/time context will be used. Then we convert the passed SRB into a Pascal string, via Get_String, for our use here.

    // Parse string and check for issues...
    LIB_Parse_Date_Time( Context, Date, DTSS ) ;
    if( DTSS.Last_Valid_Position < length( Date ) ) then
    begin
        Result := LIB_IVTIME ;
        exit ;
    end ;
    if( ( DTSS.Flags and DTF_Error ) <> 0 ) then
    begin
        Result := LIB_UNRFORCOD ;
        exit ;
    end ;
    if( ( Context <> 0 ) and TDate_Time_Context( pointer( Context ) ).Defaulted_To_English ) then
    begin
        Result := LIB_ENGLUSED ;
    end ;

We call LIB_Parse_Date_Time to fill the DTSS structure. If the last valid position isn't the last string position, we return an error that the time passed was invalid. If the error code is set, we return an appropriate error. In these two cases, we exit. If the context (if there is one) has the Defaulted_To_English flag set, we return the LIB_ENGLUSED value, but continue processing - this result is informational, not an error.

    // Validate defaults...
    Def := 0 ;
    if( ( DTSS.Flags and DTF_Defaulted_Year ) <> 0 ) then
    begin
        if( ( Flags and 1 ) = 0 ) then
        begin
            Result := LIB_INCDATTIM ;
            exit ;
        end ;
        Def := Def or 1 ;
    end ;
    if( ( DTSS.Flags and DTF_Defaulted_Month ) <> 0 ) then
    begin
        if( ( Flags and 2 ) = 0 ) then
        begin
            Result := LIB_INCDATTIM ;
            exit ;
        end ;
        Def := Def or 2 ;
    end ;
    if( ( DTSS.Flags and DTF_Defaulted_Day ) <> 0 ) then
    begin
        if( ( Flags and 4 ) = 0 ) then
        begin
            Result := LIB_INCDATTIM ;
            exit ;
        end ;
        Def := Def or 4 ;
    end ;
    if( ( DTSS.Flags and DTF_Defaulted_Hour ) <> 0 ) then
    begin
        if( ( Flags and 8 ) = 0 ) then
        begin
            Result := LIB_INCDATTIM ;
            exit ;
        end ;
        Def := Def or 8 ;
    end ;
    if( ( DTSS.Flags and DTF_Defaulted_Minute ) <> 0 ) then
    begin
        if( ( Flags and 16 ) = 0 ) then
        begin
            Result := LIB_INCDATTIM ;
            exit ;
        end ;
        Def := Def or 16 ;
    end ;
    if( ( DTSS.Flags and DTF_Defaulted_Second ) <> 0 ) then
    begin
        if( ( Flags and 32 ) = 0 ) then
        begin
            Result := LIB_INCDATTIM ;
            exit ;
        end ;
        Def := Def or 32 ;
    end ;
    if( ( DTSS.Flags and DTF_Defaulted_Tenths ) <> 0 ) then
    begin
        if( ( Flags and 64 ) = 0 ) then
        begin
            Result := LIB_INCDATTIM ;
            exit ;
        end ;
        Def := Def or 64 ;
    end ;
    if( DefaultsA <> 0 ) then
    begin
        move( Def, pchar( pointer( DefaultsA ) )[ 0 ], sizeof( Def ) ) ;
    end ;

We next validate that date and time fields that were defaulted were supposed to be defaulted, according to the flags passed into the function. If something was defaulted that isn't supposed to be, we exit with the LIB_INCDATTIM code.

    // Handle defaults...
    if( Defaults <> 0 ) then
    begin
        TimBuf := PTimBuf( pointer( Defaults ) ) ;
        if( ( DTSS.Flags and DTF_Defaulted_Year ) <> 0 ) then
        begin
            DTSS.Year := TimBuf^.Year ;
        end ;
        if( ( DTSS.Flags and DTF_Defaulted_Month ) <> 0 ) then
        begin
            DTSS.Month := TimBuf^.Month ;
        end ;
        if( ( DTSS.Flags and DTF_Defaulted_Day ) <> 0 ) then
        begin
            DTSS.Day := TimBuf^.Day ;
        end ;
        if( ( DTSS.Flags and DTF_Defaulted_Hour ) <> 0 ) then
        begin
            DTSS.Hour := TimBuf^.Hour ;
        end ;
        if( ( DTSS.Flags and DTF_Defaulted_Minute ) <> 0 ) then
        begin
            DTSS.Minute := TimBuf^.Minute ;
        end ;
        if( ( DTSS.Flags and DTF_Defaulted_Second ) <> 0 ) then
        begin
            DTSS.Second := TimBuf^.Second ;
        end ;
        if( ( DTSS.Flags and DTF_Defaulted_Tenths ) <> 0 ) then
        begin
            DTSS.Billionths := TimBuf^.Billionths ;
        end ;
    end ;

    // Handle delta-only...
    if( ( DTSS.Flags and ( DTF_Absolute or DTF_Delta ) ) = DTF_Delta ) then
    begin
        DTSS.Year := 0 ;
        DTSS.Month := 0 ;
        DTSS.Day := 0 ;
    end ;

If defaults were provided (the Defaults pointer isn't 0), we fill the defaulted fields from the provided structure. Then, if the parsed date was a delta only, we fill the year, month, and day fields with 0.

    // Construct timestamp...
    Timestamp := Encode_Sirius_Timestamp( DTSS.Year, DTSS.Month, DTSS.Day, DTSS.Hour, DTSS.Minute, 
        DTSS.Second, DTSS.Billionths ) ;

    // Handle relative dates...
    case DTSS.Relative of
        1 : // Yesterday
            Timestamp := Timestamp - Day_Value ;
        3 : // Tomorrow
            Timestamp := Timestamp + Day_Value ;
    end ;

We encode the new DTSS fields into a timestamp. Then, if a relative day was specified, we adjust the timestamp by a day.

    // Handle delta values...
    if( ( DTSS.Flags and DTF_Negative ) <> 0 ) then
    begin
        Timestamp := Timestamp - DTSS.Delta_Days * Day_Value ;
        Timestamp := Timestamp - DTSS.Delta_Hours * Hour_Value ;
        Timestamp := Timestamp - DTSS.Delta_Minutes * Minute_Value ;
        Timestamp := Timestamp - DTSS.Delta_Seconds * Second_Value ;
        Timestamp := Timestamp - DTSS.Delta_Billionths ;
    end else
    begin
        Timestamp := Timestamp + DTSS.Delta_Days * Day_Value ;
        Timestamp := Timestamp + DTSS.Delta_Hours * Hour_Value ;
        Timestamp := Timestamp + DTSS.Delta_Minutes * Minute_Value ;
        Timestamp := Timestamp + DTSS.Delta_Seconds * Second_Value ;
        Timestamp := Timestamp + DTSS.Delta_Billionths ;
    end ;

Next we apply any delta values to the timestamp.

    if( ( DTSS.Flags and ( DTF_Absolute or DTF_Delta ) ) = DTF_Delta ) then
    begin
        if( Timestamp > 0 ) then
        begin
            Timestamp := -Timestamp ;
        end ;
    end ;

    // Write result...
    if( DateA <> 0 ) then
    begin
        move( Timestamp, PChar( pointer( DateA ) )[ 0 ], sizeof( Timestamp ) ) ;
    end ;
end ;  // LIB_Convert_Date_String

Finally, if the passed date/time consisted solely of a delta specification, we make sure the resulting timestamp is negative to indicate that. Then we write the timestamp to the destination.

type TTimbuf = packed record
                   Year : word ;
                   Month : word ;
                   Day : word ;
                   Hour : word ;
                   Minute : word ;
                   Second : word ;
                   Billionths : cardinal ;
               end ;
    PTimbuf = ^TTimbuf ;

This is the Time buffer (Timbuf) structure, used above (and in some routines we will discuss in the future).

procedure Set_String( const Value : string ; var SRB : TSRB ) ;

begin
    SRB.Buffer := int64( PChar( Value ) ) ; // Symbol name
    SRB.Length := length( Value ) ;
end ;


function Get_String( const SRB : TSRB ) : string ;

begin
    setlength( Result, SRB.Length ) ;
    move( PChar( pointer( SRB.Buffer ) )[ 0 ], PChar( Result )[ 0 ], SRB.Length ) ;
end ;

These functions convert between Pascal strings and TSRB.

function Delta_Time_Representation( Time : int64 ) : string ;

var Days : int64 ;
    Y, Mo, D, H, M, Sec : word ;
    NS : longint ;

begin
    Result := '+' ;
    if( Time < 0 ) then
    begin
        Time := -Time ;
        Result := Result + '-' ;
    end ;
    Days := Time div Day_Value ; // Number of days ;
    Time := Time - Days * Day_Value ;
    Result := Result + inttostr( Days ) + ':' ;
    Parse_Sirius_Timestamp( Time, Y, Mo, D, H, M, Sec, NS ) ;
    Result := Result + inttostr( H ) + ':' + inttostr( M ) + ':' + inttostr( Sec ) ;
end ;

This function converts a timestamp into a human-readable delta time specification. We make sure the timestamp is positive (and if negative, we add the minus sign). Then we parse the timestamp and add the hour, minute, and second to the result.

This wraps up our introduction to UOS date/time code. We will briefly revisit in the future for a few other system routines. In the next article, we'll continue with our examination of UCL lexical functions.