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

MODULE DAPT20(
              IDENT='1',
              ENTRY(S$DTSTR, S$STRDT, S$JFN_STR)
              )=
BEGIN
!  COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985.
!  ALL RIGHTS RESERVED.
!  
!  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 THAT IS NOT SUPPLIED BY DIGITAL.

!++
! FACILITY:
!   DAP-20.
!
! ABSTRACT:
!   This module contains various interface routines to TOPS-20.
!
! ENVIRONMENT:
!   TOPS-20 user mode, XPORT.
!
! AUTHOR: Larry Campbell, CREATION DATE: 21 Oct 1982
!
! MODIFIED BY: Andrew Nourse
!
! 01 -    Move these routines from FTST20 to DAPT20 (this module)
!--

FORWARD ROUTINE
    s$dtstr : NOVALUE,                  ! Convert date/time to string
    s$strdt,                            ! convert string to date/time
    s$jfn_str;                          ! Convert JFN to string

!
! INCLUDE FILES:
!
LIBRARY 'BLI:XPORT';
LIBRARY 'BLI:MONSYM';
REQUIRE 'JSYSDEF';


!
! MACROS:
!
MACRO
    lh = 18, 18 %,
    rh =  0, 18 %,

    asciz_len (string) =
        BEGIN
        LOCAL
            tptr;
        tptr = string;
        INCR i FROM 0
        DO
        IF CH$RCHAR_A (tptr) EQL 0
        THEN
            EXITLOOP .i
        END %;

!
! EQUATED SYMBOLS:
!
LITERAL
    minute = %O'1000000' / (24 * 60);   ! One minute

GLOBAL ROUTINE s$dtstr (date_time, p_descr) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!   Convert internal date/time to string.
!
! FORMAL PARAMETERS:
!   date_time           - date and time in universal internal format
!                         (-1 means now)
!   p_descr             - pointer to descriptor to receive string
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   NONE
!
!--
    BEGIN

    BIND
        descr = .p_descr : $STR_DESCRIPTOR ();

    LOCAL
        ptr,
        length,
        string_buffer : VECTOR [CH$ALLOCATION (32)];

    JSYS_ODTIM (CH$PTR (string_buffer), .date_time, 0);
    ptr = CH$PTR (string_buffer);
    length = 0;
    UNTIL (CH$RCHAR_A (ptr) EQL 0)
    DO
        length = .length + 1;
    $STR_COPY (STRING = (.length, CH$PTR (string_buffer)), TARGET = descr,
               OPTION = TRUNCATE);
    END;                                ! End of s$dtstr

GLOBAL ROUTINE s$strdt (p_descr) =
!++
! FUNCTIONAL DESCRIPTION:
!   Convert string to internal date/time
!
! FORMAL PARAMETERS:
!   p_descr             - pointer to descriptor to string
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE
!   Internal Date/Time
!
! SIDE EFFECTS:
!   NONE
!
!--
    BEGIN

    BIND
        descr = .p_descr : $STR_DESCRIPTOR ();

    LOCAL
        internal_date_time,
        result,
        string_buffer : VECTOR [CH$ALLOCATION (32)];

    $STR_COPY (STRING = $STR_CONCAT (descr, %CHAR(0)),
               TARGET = (31, CH$PTR (string_buffer)),
               OPTION = TRUNCATE);

    IF JSYS_IDTIM (CH$PTR (string_buffer), 0; result, internal_date_time)
    THEN
        RETURN (.internal_date_time)    ! Returned value
    ELSE
        SIGNAL (.result)                ! String was trash or something
    END;                                ! End of s$strdt

GLOBAL ROUTINE s$jfn_str (jfn, p_desc, bits) =
!++
! FUNCTIONAL DESCRIPTION:
!   Convert a JFN to a filespec string.
!
! FORMAL PARAMETERS:
!   jfn         - the JFN
!   p_desc      - address of descriptor to receive the string
!   bits        - format control bits (AC3 of JFNS call).  If 0, this
!                 defaults to the usual case (supply and punctuate everything)
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   The length of the filespec string is returned, or 0 if any errors (which
!   are also signalled).
!
! SIDE EFFECTS:
!   NONE
!
!--
    BEGIN

    BIND
        desc = .p_desc : $STR_DESCRIPTOR ();

    LOCAL
	temp_desc : $STR_DESCRIPTOR (CLASS = FIXED),
        temp_desc_buffer : VECTOR [CH$ALLOCATION (255)],
        adjusted_length,
        jfns_bits,
        new_ptr;

    $STR_DESC_INIT (DESCRIPTOR = temp_desc,
                    STRING = (255, CH$PTR (temp_desc_buffer)));
    IF .bits EQL 0
    THEN
        jfns_bits = %O'111110000001'    ! Return all the usual fields
    ELSE
        jfns_bits = .bits;
    IF NOT JSYS_JFNS (.temp_desc[STR$A_POINTER], .jfn, .jfns_bits, 0; new_ptr)
    THEN
        RETURN (SIGNAL (XPO$_CHANNEL); 0);
    temp_desc[STR$H_LENGTH] = ABS (CH$DIFF (.new_ptr,
                                            .temp_desc[STR$A_POINTER])) + 1;
    $STR_COPY (STRING = temp_desc, TARGET = desc, OPTION = TRUNCATE);
    !
    ! Unless the target descriptor was too short, we also copied the trailing
    ! null.  Here we account for that.  If the last character of the target
    ! is null, we copied the null, so must return a length one less.
    !
    adjusted_length = MIN (.desc[STR$H_LENGTH],
                           .temp_desc[STR$H_LENGTH]);
    IF CH$RCHAR (CH$PLUS (.desc[STR$A_POINTER], .adjusted_length - 1)) EQL 0
    THEN
        adjusted_length = .adjusted_length - 1;
    RETURN (.adjusted_length)
    END;                                ! End of s$jfn_str

END ELUDOM			! End of Module