Google
 

Trailing-Edge - PDP-10 Archives - bb-lw55a-bm - language-sources/dixdeb.bli
There are 21 other files named dixdeb.bli in the archive. Click here to see a list.
%title 'DIXDEB -- Debugging code and declarations'

MODULE dixdeb

!  COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 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.

!++
! .chapter >DIXDEB
!
!   FACILITY: Data Conversion Routines (DIX)
!
!   ABSTRACT:
! Debugging utility routines for DIX.
!
!   ENVIRONMENT:
!
!   AUTHOR: David Dyer-Bennet, Creation Date: 18-Jan-82
!--
    (					!
    IDENT = '2.1(53)'                   ! \.p;
                                        ! **EDIT**
    %REQUIRE ('DIXSWI.REQ')             ! \.P;\ [%O'34'] 
%bliss36 (
        , ENTRY (                       ! ; .p;Entry names:
        typint, typasz, typnel, ttygin, stsdmp, ffddmp, cbdmp, xidmp,   ! \
            cbinp, cfdmp  ! \
        )
    )
    ) =

BEGIN

!++
! .hl 1 Library files
!--

!++
!   This module can't use DIXREQ because that's where some of the other
! kludgery relating to the debug macros is defined.  So, much of the stuff
! in DIXREQ must be duplicated here.  If this suddenly stops compiling,
! check to see if DIXREQ has changed.
!
!   The order of declarations here is critical.  DIXLIB must come before
! TUTIO, because both define the list of names undeclared below, and it is
! vital for this routine that the TUTIO definitions win.
!--

LIBRARY 'DIXLIB';                       ! \.p;
LIBRARY 'FIELDS';                       ! \.p; { [7] \ [7] }

%BLISS36 (                              ! ;.P;If BLISS36, 
    LIBRARY 'STAR36';                   ! \
                                        ! [7] Remove FIELDS from conditional.
)
UNDECLARE                               ! \.p;\ the following macros:
                                        ! ; .list 0, " "
    %QUOTE tty_put_quo,                 ! \.le;\
    %QUOTE tty_put_integer,             ! \.le;\
    %quote tty_put_crlf;                ! \.le;\
                                        ! ; .end list
!++
! .hl 1 Require  files
!--

! ; .P;Require >TUTIO>.
%IF %BLISS (BLISS36)
%THEN

REQUIRE 'BLI:TUTIO';

%FI

%IF %BLISS (BLISS32)
%THEN

REQUIRE 'SYS$LIBRARY:TUTIO';

%FI
%sbttl 'Edit History'                   ! [7] Add this entire subsection

!++
! .hl 1 Edit History
!--

LIBRARY 'VERSION';

! ; .autotable

!++ COPY 

new_version (1, 0)

edit (7, '23-Aug-82', 'David Dyer-Bennet')
 %( Change version and revision standards everywhere.
    Files: All. )%

edit (10, '22-Sep-82', 'David Dyer-Bennet')
 %(  Always use long_relative addressing on VAX. )%

EDIT (%O'27', '17-Jan-83', 'David Dyer-Bennet')
 %(  Fix bug in TTYGIN that might manifest with different compiler version.
    This eliminates the warning message that was coming out.
 )%

Edit (%O'30', '19-Jan-83', 'David Dyer-Bennet')
 %(  Update copyright notices, add mark at end of edit histories.
 )%

Edit (%O'34', '19-May-83', 'David Dyer-Bennet')
 %( Add DIXSWI require file to headings of all modules.  DIXSWI
    contains the BLISS32 addressing-mode declarations and the TOPS-10
    OTS declaration to avoid invoking the losing default of .REQUESTING
    the OTS library from whatever directory the compiler was called from
    when the build ran.
 )%

Edit (%O'35', '7-June-83', 'Charlotte L. Richardson')
 %( Declare version 1 complete.  All modules.
 )%

new_version (1, 1)

new_version (2, 0)

Edit (%O'36', '11-Apr-84', 'Sandy Clemens')
%( Put all Version 2 DIX development files under edit control.  Some of
   the files listed below have major code edits, or are new modules.  Others
   have relatively minor changes, such as cleaning up a comment.
   FILES: COMDIX.VAX-COM, COMPDX.CTL, DIXCST.BLI, DIXDEB.BLI,
   DIXDN.BLI (NEW), DIXFBN.BLI, DIXFP.BLI, DIXGBL.BLI, DIXGEN.BLI,
   DIXHST.BLI, DIXINT.PR1, DIXINT.PR2, DIXLIB.BLI, DIXPD.BLI (NEW),
   DIXREQ.REQ, DIXSTR.BLI, DIXUTL.BLI, DXCM10.10-CTL, MAKDIXMSG.BLI,
   STAR36.BLI, VERSION.REQ.
)%

Edit (%O'50', '8-Oct-84', 'Sandy Clemens')
  %( Add new format of COPYRIGHT notice.  FILES:  ALL )%

new_version (2, 1)

Edit (%O'53', '3-Jul-86', 'Sandy Clemens')
  %( Add remaining sources to V2.1 area.  Update copyright notices. )%

! **EDIT**

!-- .autoparagraph

mark_versions ('DIX')
!++
! .hl 1 Global storage
!--

GLOBAL
    dix$gg_debug: INITIAL (on) VOLATILE;	! \\Control debug prints globally.

!++
! .hl 1 Own storage
!--

! [7] Remove version number word

!++
! .hl 1 External references
!
!   Some of this is normally in DIXREQ, but we can't use DIXREQ (see above)
! so we have to duplicate this stuff here.  Watch out for skew bugs.
!--

%BLISS36 (                              ! ; If BLISS36
    EXTERNAL LITERAL                    ! \
        ss$unw;                         ! \
EXTERNAL ROUTINE                        ! ;.p;EXTERNAL ROUTINES:
                                        ! ;.s 1.list 0, "o"
!++ copy /strip .le;
    dix$$get_argadr;
!-- .end list
)
GLOBAL ROUTINE TYPINT                   ! \.!=;.hl 1 \
! ; .index  TYPINT                   

!++
!   Type out an integer in specified radix.
!   Routine value: None.
!   Formal Arguments:
!--
    (                                   ! ; .s 1.list 1
    int_val,                            ! \.le;\
    radix_val,                          ! \.le;\
    lng_val                             ! \.le;\
    ) : NOVALUE =                       ! ; .end list

    BEGIN
    tty_put_integer (.int_val, .radix_val, .lng_val); ! \.p;Simply call TUTIO \
    END;
%sbttl 'Global Routine TYPASZ'
GLOBAL ROUTINE TYPASZ                 ! \.!=;.hl 1 \
! ; .index  TYPASZ                 

!++
!   Type an ASCIZ quantity given its starting address.
!   Routine value: none.
!   Formal Arguments:
!--
    (                                   ! ;.s 1.list 1
    str_addr                            ! \.le;\:
    ) : NOVALUE =                       ! ; .end list

    BEGIN
    tty_put_asciz (.str_addr);          ! \.p;Simply call TUTIO \
    end;
%sbttl 'Global Routine TYPNEL'
GLOBAL ROUTINE TYPNEL                   ! \.!=;.hl 1 \
! ; .index  TYPNEL                   

!++
!   Start a new line of terminal output.
!   Routine value: None.
!   Formal Arguments: None.
!--

    : NOVALUE =

    BEGIN
    tty_put_crlf ();                    ! \.p;Simply call TUTIO \
    END;
%sbttl 'Global Routine TTYGIN'
GLOBAL ROUTINE ttygin                   ! \.!=;.hl 1 \
! ; .index  ttygin
!++
!   Read in integer from the terminal.  Implementations vary considerably
! from system to system.  TOPS-10 signals dix$_unimp if this routine is called.
! TOPS-20 and VAX/VMS can both do decimal input.
!
!   Formal Argument:
!--
   (
    radix                               ! \\.
   ) =

BEGIN

%IF %BLISS (BLISS36)                    ! ;  If compiled under BLISS36
%THEN                                   ! ; .LM +4

%IF %SWITCHES (TOPS20)                  ! ;  If compiled specifically by TOPS-20
%THEN                                   ! ; .lm +4

! [%O'27'] Remove register declarations

    LIBRARY 'BLI:MONSYM';

! [%O'27'] Replace entire body with new code using JSYS linkage

    UNDECLARE nin;

    LINKAGE nin_linkage = JSYS (REGISTER=1, REGISTER=3;
        REGISTER=1,REGISTER=2,REGISTER=3) : SKIP (1);
    BIND ROUTINE nin = nin_ : nin_linkage;

    LOCAL
        the_number, ret_stat, error_code;

    ret_stat = nin ($priin, .radix;,the_number,error_code);     ! ; Use NIN JSYS.
    IF NOT .ret_stat THEN       ! ; If JSYS failed,
       	BEGIN                           ! ;.lm +4
	tty_put_quo ('%TTYGIN failed with ');   ! ; Print message if failed
	tty_put_integer (.ret_stat, 10, 2);
	tty_put_integer (.error_code, 10, 10);
	tty_put_crlf ();
	0                               ! ; .p;Return zero on error
        END                             ! ;.lm -4
    ELSE
        .the_number
! [%O'27'] End replacement of entire routine body

%ELSE                                   ! .lm -4.!%IF %SWITCHES (TOPS20)
                                        ! ; .lm +4
                                        ! ;  If compiled on not-TOPS20
    SIGNAL (dix$_unimp)                 ! \\.  TTY numeric input isn't an
                                        ! ; important debugging function.
%FI                                     ! ;.lm -4.!%IF %SWITCHES (TOPS20)
%FI                                     ! ;.lm -4.!%IF %BLISS (BLISS36)

%IF %BLISS (BLISS32) %THEN
    EXTERNAL ROUTINE BAS$INPUT, BAS$IN_L_R, BAS$IO_END;
    LOCAL TEMP;

    IF .RADIX NEQ 10 THEN
	BEGIN
	TTY_PUT_QUO ('%TTYGIN failed because radix not equal to 10');
	RETURN 0;
	END;
    
    BAS$INPUT (0);				! IO INITIALIZATION
    BAS$IN_L_R (TEMP);
    BAS$IO_END ();				! IO TERMINATION

    .TEMP
%FI
    END;
%sbttl 'Global Routine STSDMP'
GLOBAL ROUTINE STSDMP                   ! \.!=;.hl 1 \
! ; .index  STSDMP                   

!++
!   Dump a status value to the terminal in a meaningful form.
! 
! 
!   Routine Value: NONE
!
!   Formal Arguments:
!--

    (                                   ! ; .s 1.list 1
    status_formal                       ! \.le;\: (reference to integer) The status to dump.
    ) :                                 ! ; .end list
    FORTRAN_SUB                         ! \.P;Use \ linkage.
    NOVALUE =

    BEGIN

    BIND
	some_status = argadr (.status_formal) : CONDITION_VALUE;        ! [2] Remove REF

    TTY_PUT_QUO ('Status value: ');
    TTY_PUT_INTEGER (.some_status [sts$v_fac_no], 10, 3);
    TTY_PUT_INTEGER (.some_status [sts$v_msg_no], 10, 7);
    TTY_PUT_INTEGER (.some_status [sts$v_severity], 10, 2);
    TTY_PUT_CRLF ();
    END;					! END OF STSDMP
%sbttl 'Global Routine FFDDMP'
GLOBAL ROUTINE ffddmp                   ! \.!=;.hl 1 \
! ; .index  ffddmp                   

!++
!   Dump a foreign field descriptor to the terminal.
! 
!   Routine Value: NONE
!
!   Formal Arguments:
!--
    (                                   ! ; .s 1.list 1
    ffd_formal                          ! \.le;\: (ref) The descriptor to dump.
    ) :                                 ! ; .end list
    FORTRAN_SUB                         ! \.P;Use \ linkage.
    NOVALUE =

    BEGIN

    BIND
	some_ffd = argadr (.ffd_formal) : forgn_descr;  ! [2] remove REF

    tty_put_crlf ();
    tty_put_quo ('Orig ');
    tty_put_integer (.some_ffd [ffd$v_sys_orig], 10, 2);
    tty_put_quo (' Class: ');
    tty_put_integer (.some_ffd [ffd$v_dt_class], 10, 2);
    tty_put_quo (' Type: ');
    tty_put_integer (.some_ffd [ffd$v_dt_type], 10, 3);
    tty_put_quo (' Unit: ');
    tty_put_integer (.some_ffd [ffd$v_unit], 10, 7);
    tty_put_quo (' Off: ');
    tty_put_integer (.some_ffd [ffd$v_offset], 10, 3);
    tty_put_quo (' Lng: ');
    tty_put_integer (.some_ffd [ffd$v_length], 10, 4);
    tty_put_quo (' Scl: ');
    tty_put_integer (.some_ffd [ffd$v_scale], 10, 3);
    tty_put_quo (' Align: ');
    tty_put_integer (.some_ffd [ffd$v_align], 10, 3);
    tty_put_crlf ();
    END;					! END OF ffddmp
%sbttl 'Global Routine CBDMP'
GLOBAL ROUTINE cbdmp                    ! \.!=;.hl 1 \
! ; .index  cbdmp                    

!++
!   Display the digits of a canonical binary value.  This displays the
! CB number in base cb$k_base.  Each segment is treated as a digit.
!
!   Routine value: None.
!
!   Formal Arguments:
!--
    (                                   ! ; .s 1.list 1
    xval                                ! \.le;\: Adr of extended value
                                        ! ; .end list
    ) : NOVALUE =                       ! [2] Remove linkage attribute

BEGIN
MAP
    xval: REF cb;
LITERAL
    local_detail = ftdebug and 1;       ! Controls local detail printing
LOCAL
    ndx;
DECR ndx FROM cb$k_segments - 1 TO 0 DO
    tty_put_integer (.xval [.ndx, cb$v_dig], 10, 10);
tty_put_crlf ();
END;
%sbttl 'Global Routine XIDMP'
GLOBAL ROUTINE xidmp                    ! \.!=;.hl 1 \
! ; .index  xidmp                    

!++
!   Display a fixed intermediate (XI) value on the terminal.
! 
!   Routine value: None.
!
!   Formal arguments:
!--
    (                                   ! ; .s 1.list 1
    fix_int                             ! \.le;\: Address of value to display
                                        ! ; .end list
    ) : NOVALUE =                       ! [2] Remove linkage attribute
BEGIN
MAP
    fix_int: REF xi;

tty_put_quo ('Sign: ');
tty_put_integer (.fix_int [xi$v_sign], 10, 2);

tty_put_quo (' Scale: ');
tty_put_integer (.fix_int [xi$v_scale], 10, 6);
tty_put_crlf ();

tty_put_quo ('Digits: ');
DECR ndx FROM xi$k_digits - 1 TO 0 DO
    BEGIN
    tty_put_integer (.fix_int [xi$v_digit, .ndx], 10, 2)
    END;

tty_put_crlf ();
END;
%SBTTL 'Enter extended value'
GLOBAL ROUTINE cbinp                    ! \.!=;.hl 1 \
! ; .index  cbinp                    

!++
!   Enter a canonical binary value.  This routine does it clumsily,
! by forcing you to enter each digit individually.
!
!   Routine value: None.
!
!   Formal arguments:
!--
    (                                   ! ; .s 1.list 1
    xval                                ! \.le;\: Adr of extended value (return)
    ) : NOVALUE =                       ! ; .end list
BEGIN
MAP
    xval: REF cb;
LOCAL
    ndx;
INCR ndx FROM 0 TO cb$k_segments - 1 DO        ! ; Enter from l.o. to h.o.
    BEGIN
    tty_put_quo ('Value for digit ');
    tty_put_integer (.ndx, 10, 3);
    tty_put_quo (': ');
    xval [.ndx, cb$v_all] = 0;         ! No garbage, please
    xval [.ndx, cb$v_dig] = ttygin (10)
    END;
END;
%sbttl 'global routine cfdmp'
GLOBAL ROUTINE cfdmp                    ! \.!=;.hl 1 \
! ; .index  cfdmp                    

!++
!   Dump a canonical floating point quantity.
!--
    (                                   ! ;.s 1.list 1
    cf_fld                              ! \.le;\: Adr of cf field
    )                                   ! ;.end list
: NOVALUE =                             ! [2] Remove linkage attribute
begin                                   ! cfdmp
MAP
    cf_fld: REF cf;
tty_put_quo ('Sign = ');
tty_put_integer (.cf_fld [cf$v_sign], 10, 2);
tty_put_quo (' Exp = ');
tty_put_integer (.cf_fld [cf$v_exponent], 10, 10);
tty_put_crlf ();
tty_put_quo ('Mantissa: ');
INCR ndx FROM 0 TO cf$k_mantissa_segs - 1 DO
    (tty_put_integer (.cf_fld [cf$v_mantissa, .ndx], 10, 12));
tty_put_crlf ();
end;                                    ! cfdmp
END                                     ! End of module DIXDEB

ELUDOM