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