Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/lngsrc/dapt20.b36
There are 20 other files named dapt20.b36 in the archive. Click here to see a list.
MODULE DAPT20(
IDENT='1',
ENTRY(S$DTSTR, S$STRDT, S$JFN_STR, S$RMS_VER,
S$JFNSTR, S$RMSVER, RMSv3 )
)=
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1986.
! 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 'RMSOSD';
!
! MACROS:
!
MACRO
lh = 18, 18 %,
rh = 0, 18 %,
xwd ( lft, rgt ) = (lft^18) OR (rgt) %,
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 DATA
!
GLOBAL RMSv3;
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)];
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 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 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
GLOBAL ROUTINE S$RMS_ver =
!+
! Functional Description:
!
! Check Which version of RMS we have
!
! Implicit Outputs:
!
! RMSv3 set if this is RMS version 3 or later
!
! Return Value:
!
! Version number of RMS
!-
BEGIN ![4] vv
LOCAL
t2,
t3,
dvec: REF BLOCK;
XGSEV_( XWD( $XSEVD, $FHSLF ); t2, t3 ); ! Get RMS entry vector
dvec = .t3<0,29>; ! Mask out flag bits
IF .dvec[2, 24, 9, 0] GEQ 3 ![72] typo
THEN RMSv3 = -1; ! We have RMS version 3
.dvec[2, 0, 36, 0] ! Return RMS version number
END; ![4] ^^
GLOBAL BIND ROUTINE S$JFNSTR = S$JFN_STR;
GLOBAL BIND ROUTINE S$RMSVER = S$RMS_VER;
END ELUDOM ! End of Module