diff options
Diffstat (limited to 'ipl/packs/itweak')
| -rw-r--r-- | ipl/packs/itweak/Makefile | 125 | ||||
| -rw-r--r-- | ipl/packs/itweak/README | 37 | ||||
| -rw-r--r-- | ipl/packs/itweak/dbg_run.icn | 2290 | ||||
| -rw-r--r-- | ipl/packs/itweak/demo.cmd | 131 | ||||
| -rw-r--r-- | ipl/packs/itweak/ipxref.icn | 234 | ||||
| -rw-r--r-- | ipl/packs/itweak/itweak.htm | 725 | ||||
| -rw-r--r-- | ipl/packs/itweak/itweak.icn | 830 | ||||
| -rw-r--r-- | ipl/packs/itweak/options.icn | 167 |
8 files changed, 4539 insertions, 0 deletions
diff --git a/ipl/packs/itweak/Makefile b/ipl/packs/itweak/Makefile new file mode 100644 index 0000000..4778556 --- /dev/null +++ b/ipl/packs/itweak/Makefile @@ -0,0 +1,125 @@ +############################################################################ +# +# Unix Makefile for installing itweak and running a sample debugging session. +# +# $Id: Makefile,v 2.21 1996/10/04 03:45:37 hs Rel $ +# updated 4-aug-2000/gmt +# +# 'make' or 'make install' +# does the necessary compilations to get the itweak package ready to use. +# Note, however, that it leaves the resulting files in the current directory. +# You must move or copy them yourself if you want them any other place. +# (See the documentation.) +# +# 'make sample-debug' +# compiles, tweaks, and links a sample program to make it ready for a +# debugging session. +# Assumes the 'dbg_run.u?' files are on your IPATH or in the current directory +# which is the case if you haven't moved things around since 'make install'. +# +# The sample executable is named 'sample'. +# The program is, however, identical 'ipxref' copied from the Icon Library. +# It also requires 'options.icn' (included), so the program is built from two +# source files. +# +# 'make demo' +# runs a debugging session with the sample program. +# It is uncommon to run debugging sessions from a Makefile. +# This is only for demo purposes. +# +# This makefile is in itself an example of how to construct makefiles. +# It provides a simple way to switch between a clean (untweaked) version +# and a tweaked version of the sample program without duplicating a lot of +# makefile code. +# Use 'make sample-clean' to force compilation of a clean (untweaked) copy of +# 'sample'. +# +############################################################################ +# +# Copyright (c) 1994 Hakan Soderstrom and +# Soderstrom Programvaruverkstad AB, Sweden +# +# Permission to use, copy, modify, distribute, and sell this software +# and its documentation for any purpose is hereby granted without fee, +# provided that the above copyright notice and this permission notice +# appear in all copies of the software and related documentation. +# +# THE SOFTWARE IS PROVIDED "AS-IS" AND WITHOUT WARRANTY OF ANY KIND, +# EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY +# WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. +# +# IN NO EVENT SHALL HAKAN SODERSTROM OR SODERSTROM PROGRAMVARUVERKSTAD +# AB BE LIABLE FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL +# DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +# OF USE, DATA OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY +# OF DAMAGE, AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN +# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +# +############################################################################ + +ICONT=icont -s +ITWEAK=itweak + + +MAKEFILE=Makefile +SAMPLE_INIT=samp_ini.icn +CMD=demo.cmd + +##### 'install' targets + +install : itweak dbg_run.u1 + +itweak : itweak.icn + $(ICONT) itweak.icn + +dbg_run.u1 : dbg_run.icn + $(ICONT) -c dbg_run.icn + +##### 'sample' targets: first the plain ones +##### The program is built from source files 'ipxref.icn' and 'options.icn'. +##### The name of the resulting program is 'sample'. + +sample : ipxref.u1 options.u1 $(DEBUG) + $(ICONT) -u -o sample ipxref.u1 options.u1 + +ipxref.u1 : ipxref.icn + $(ICONT) -cu ipxref.icn + +options.u1 : options.icn + $(ICONT) -cu options.icn + +##### 'sample' targets: the debugging stuff + +sample-debug : + $(MAKE) -f $(MAKEFILE) sample DEBUG=$(SAMPLE_INIT) + +$(SAMPLE_INIT) : ipxref.u1 options.u1 + @echo '*** This is how the program files are tweaked...' + $(ITWEAK) -o $(SAMPLE_INIT) ipxref options + @echo '*** ... and don't forget to compile the generated file.' + $(ICONT) -cu $(SAMPLE_INIT) + +sample-clean : + rm -f ipxref.u? options.u? + $(MAKE) -f $(MAKEFILE) sample + +##### demo session + +demo : sample-debug + @echo 'We will now start a sample debugging session.' + @echo 'Debugging commands will be taken from the file $(CMD).' + @echo 'Please open an editor on this file -- the commands will' + @echo 'not appear in the debugger output.' + @echo '-------------- session start --------------------------' + @(DBG_INPUT=$(CMD); export DBG_INPUT; sample ipxref.icn) + @echo '-------------- session end ----------------------------' + +##### build executable and copy to ../../iexe +##### (nothing done in this case because the executable doesn't stand alone) + +Iexe : + +##### cleanup + +Clean : + rm -f $(ITWEAK) *.u[12] diff --git a/ipl/packs/itweak/README b/ipl/packs/itweak/README new file mode 100644 index 0000000..8944215 --- /dev/null +++ b/ipl/packs/itweak/README @@ -0,0 +1,37 @@ +WHAT IS ITWEAK? + +'itweak' is an interactive debugging utility for the Icon programming +language. The idea is that you compile your Icon program to ucode +files (.u1, .u2). 'itweak' then tweaks the ucode, inserting potential +breakpoints. The resulting ucode files are linked with a debugging +run-time and off you go. The 'itweak' system provides you with most of +the facilities you would expect from an interactive debugger, +including the ability to evaluate a wide range of Icon expressions. + +PREREQUISITES + +'itweak' requires Icon 8.10 or higher. It is completely written in +Icon, and thus as portable as Icon itself. + +INSTANT ITWEAK -- UNIX + +Assuming you have the itweak distribution in the form of a file named +'itweak-<version>.tar.gz' (where <version> is a version designator): +uncompress and untar the file. This can be done in a single step, + + gunzip < itweak-<version>.tar.gz | tar xvf - + +This will create an installation directory in the current directory. +The name of the installation directory will be 'itweak-<version>'. + +To install itweak, type 'make' in the installation directory. Run a +demo session by typing 'make demo'. + +OTHER SYSTEMS -- NOT SO INSTANT + +For systems other than Unix, and for more information, please refer to +the documentation. + +DOCUMENTATION + +There is a description in the form of an HTML file. diff --git a/ipl/packs/itweak/dbg_run.icn b/ipl/packs/itweak/dbg_run.icn new file mode 100644 index 0000000..b8a766b --- /dev/null +++ b/ipl/packs/itweak/dbg_run.icn @@ -0,0 +1,2290 @@ +############################################################################ +# +# File: dbg_run.icn +# +# Subject: Icon interactive debugging. +# Contains an interactive debugging run-time system. +# +# Author: Hakan Soderstrom +# +# Revision: $Revision: 2.21 $ +# +########################################################################### +# +# Copyright (c) 1994 Hakan Soderstrom and +# Soderstrom Programvaruverkstad AB, Sweden +# +# Permission to use, copy, modify, distribute, and sell this software +# and its documentation for any purpose is hereby granted without fee, +# provided that the above copyright notice and this permission notice +# appear in all copies of the software and related documentation. +# +# THE SOFTWARE IS PROVIDED "AS-IS" AND WITHOUT WARRANTY OF ANY KIND, +# EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY +# WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. +# +# IN NO EVENT SHALL HAKAN SODERSTROM OR SODERSTROM PROGRAMVARUVERKSTAD +# AB BE LIABLE FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL +# DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +# OF USE, DATA OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY +# OF DAMAGE, AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN +# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +# +########################################################################### +# +# General note: all names are prefixed in an elaborate way in order to +# avoid name collisions with the debugged program. +# The default prefix for all globally visible names is '__dbg_'. +# +# This is the reason why lists are frequently used instead of records +# (whose field names clutter the global name space). +# +########################################################################### + +# +#-------- Constants -------- +# + +# Versions (this program and 'itweak'). +$define PROGRAM_VERSION "$Revision: 2.21 $" + +# Components of a breakpoint descriptor (list). +# Breakpoint id (integer). +$define BRKP_ID 1 +# Source file (string). +$define BRKP_FILE 2 +# File index. +$define BRKP_FIDX 3 +# First line number. +$define BRKP_LINE1 4 +# Second line number. +$define BRKP_LINE2 5 +# Ignore counter (integer). +$define BRKP_IGNORE 6 +# Condition for breaking. +$define BRKP_COND 7 +# Commands to perform on break. +$define BRKP_DO 8 + +# Constants for 'the current breakpoint' and 'the last breakpoint'. +$define BRKP_CURRENT -1 +$define BRKP_LAST -2 + +# Keywords for the 'clear' command. +# Definitions must match list in compilation procedure. +$define CLEAR_BREAKPOINT 1 +$define CLEAR_COND 2 +$define CLEAR_DO 3 +$define CLEAR_ECHO 4 +$define CLEAR_MACRO 5 + +# Keywords for the 'info' command. +# Definitions must match list in compilation procedure. +$define INFO_BREAKPOINT 1 +$define INFO_ECHO 2 +$define INFO_FILES 3 +$define INFO_GLOBALS 4 +$define INFO_LOCALS 5 +$define INFO_MACROS 6 +$define INFO_TRACE 7 +$define INFO_VERSION 8 + +# Keywords for the 'set' command. +# Definitions must match list in compilation procedure. +$define SET_ECHO 1 +$define SET_PRELUDE 2 +$define SET_POSTLUDE 3 + +# Components of a command definition (list). +# Used for built-in commands as well as user-defined macros. +# Unabbreviated command/macro name (string). +$define CMD_NAME 1 +# Command code (an integer corresponding to the name). +$define CMD_CODE 2 +# Help text (list of string). +$define CMD_HELP 3 +# Compilation procedure; null if macro. +$define CMD_COMPILE 4 +# Macro definition (list of command instances, list of list). +# Null if built-in command. +$define CMD_MACRO 5 +# Executing procedure, if built-in. Null otherwise. +$define CMD_EXEC 6 + +# Command codes. +$define BREAK_CMD 1 +$define CLEAR_CMD 2 +$define COMMENT_CMD 3 +$define CONDITION_CMD 4 +$define DO_CMD 5 +$define END_CMD 6 +$define EPRINT_CMD 7 +$define FAIL_CMD 8 +$define FPRINT_CMD 9 +$define FRAME_CMD 10 +$define GOON_CMD 11 +$define HELP_CMD 12 +$define INFO_CMD 13 +$define IGNORE_CMD 14 +$define MACRO_CMD 15 +$define NEXT_CMD 16 +$define PRINT_CMD 17 +$define SET_CMD 18 +$define SOURCE_CMD 19 +$define STOP_CMD 20 +$define TRACE_CMD 21 +$define WHERE_CMD 22 +$define USERDEF_CMD 23 + +# Environment variable for defining the input file (must be a string value). +$define DBG_INPUT_ENV "DBG_INPUT" + +# Environment variable for defining the primary output file +# (must be a string value). +$define DBG_OUTPUT_ENV "DBG_OUTPUT" + +# Prefix for debugging run-time global names. +$define DBG_PREFIX "__dbg_" + +# Maximum source nesting levels. +$define MAX_SOURCE_NESTING 12 + +# File index is obtained by shifting a small integer left a number of +# positions. +$define FIDX_SHIFT 10 + +# Prompt string to use in initialization mode. +$define INIT_PROMPT "debug init $ " + +# Execution return status. +# Normal return. +$define OK_STATUS 0 +# Break the command loop, resume execution. +$define RESUME_STATUS 1 +# Break the command loop, terminate the session. +$define STOP_STATUS 2 +# Break the command loop, make the current procedure fail. +$define FAIL_STATUS 3 + +# Index into '__dbg_g_where'. +$define WHERE_FILE 1 +$define WHERE_LINE 2 +$define WHERE_PROC 3 +$define WHERE_BRKP 4 +$define WHERE_PRELUDE 5 +$define WHERE_POSTLUDE 6 + +# +#-------- Record types -------- +# + +# +#-------- Globals -------- +# + +global __dbg_default_prelude, __dbg_default_postlude +# The source text for the default pre/postlude (single command assumed). + +global __dbg_g_automacro +# The 'prelude' and 'postlude' macros. +# List of two components: +# (1) prelude commands, +# (2) postlude commands. +# Both are lists of compiled commands, not complete macros. + +global __dbg_g_brkpcnt +# Counter incremented each break. +# Used to identify the file written by 'display' which is used by several +# commands. +# In this way we can check if we have to write the file anew. + +global __dbg_g_brkpdef +# Lookup table for breakpoints. +# Entry key is a breakpoint id (integer). +# Entry value is a breakpoint descriptor (list). + +global __dbg_g_brlookup +# Lookup table for breakpoints. +# Entry key is a file index or'ed with a line number (integer). +# Entry value is a breakpoint descriptor (list). + +global __dbg_g_brkpid +# Id of the latest breakpoint created (integer). + +global __dbg_g_cmd +# Table of command and macro definitions. +# Entry key is an unabbreviated command/macro name. +# Entry value is a command descriptor (list). + +global __dbg_g_display +# Name of temporary file used by '__dbg_x_opendisplay' and others. + +global __dbg_g_fileidx +# Table mapping source file names on (large) integers. +# Entry key is a source file name (string). +# Entry value is a file index (integer). + +global __dbg_g_in +# The file through which debugging input is taken. + +global __dbg_g_level +# Value of &level for the interrupted procedure. +# Calculated as &level for the breakpoint procedure - 1. + +global __dbg_g_local +# Table containing local variables. +# Entry key is variable name (string). +# Entry value is the value of the variable (any type). + +global __dbg_g_out1 +# Primary file for debugging output. + +global __dbg_g_out2, __dbg_g_out2name +# Secondary file for debugging output; used for 'set echo'. +# Null when no echoing is not active. +# The name of this file. + +global __dbg_g_src +# Stack of input files used by the 'source' command (list of file). +# Empty list when no 'source' command is active. + +global __dbg_g_trace +# Current trace level (passed to &trace when resuming execution). + +global __dbg_g_where +# A list with data about the current breakpoint. +# Contents (symbolic names below): +# (1) Source file name (string). +# (2) Source line number (integer). +# (3) Procedure name (string). +# (4) The breakpoint causing this break (breakpoint descriptor, a list). + +global __dbg_g_white +# This program's definition of white space. + +# A note on the use of global '__dbg_test' (defined in 'dbg_init.icn'). +# The runtime system assigns this variable one of the following values. +# ** Function 'member' for ordinary testing against the breakpoint sets. +# ** Function 'integer' (which is guaranteed to always fail, given a +# set as its first parameter) in the 'nobreak' mode; execution continues +# without break until the program completes. +# ** Integer '2' which causes a break at every intercept point. +# (Returns the second parameter which is the line number.) + +# +#-------- Globals for Icon functions used by the debuggin runtime -------- +# In an excruciating effort to avoid being hit by bad manners from the +# program under test we use our own variables for Icon functions. + +global __dbg_fany, __dbg_fclose, __dbg_fdelete, __dbg_fexit, __dbg_ffind +global __dbg_fgetenv, __dbg_fimage, __dbg_finsert, __dbg_finteger, __dbg_fior +global __dbg_fishift, __dbg_fkey, __dbg_fmany, __dbg_fmatch +global __dbg_fmove, __dbg_fpop, __dbg_fpos, __dbg_fproc, __dbg_fpush +global __dbg_fput, __dbg_fread, __dbg_fremove, __dbg_freverse, __dbg_fright +global __dbg_fsort, __dbg_fstring, __dbg_ftab, __dbg_ftable, __dbg_ftrim +global __dbg_ftype, __dbg_fupto, __dbg_fwrite, __dbg_fwrites + +# +#-------------- Expression management globals ----------- +# + +global __dbg_ge_message +# Holds message if there is a conflict in expression compilation or +# evaluation + +global __dbg_ge_singular +# Value used as default for the local variable table. +# Must be initialized to an empty list (or other suitable value). + +# +#-------- Main -------- +# + +procedure __dbg_proc (file, line, proc_name, var_name, var_val[]) +# This procedure is invoked a first time during initialization with parameters +# all null. +# Then it is called every time we hit a breakpoint during a debugging session. +# The parameters define the breakpoint, as follows, +# 'file': source file name (string). +# 'line': source line number (integer). +# 'proc_name': name of the current procedure (string). +# 'var_name': names of variables local to the current procedure +# (list of string). +# The list is sorted alphabetically. +# 'Local' variables include parameters and static variables. +# 'var_val': The current values of the local variables (list). +# The values occur in the same order as the names in 'var_name'. +# NOTE: In order not to affect the logic of the debugged program this +# procedure MUST FAIL. +# If it returns anything the current procedure will fail immediately. +local bdescr, cond, cmd, idx, tfname + # Save trace level; turn tracing off. + __dbg_g_trace := &trace + &trace := 0 + + if \file then { # Not the first-time invocation from "dbg_init". + # Increment the global breakpoint counter. + __dbg_g_brkpcnt +:= 1 + + # Compute the procedure nesting level. + __dbg_g_level := &level - 1 + + # Begin setting up the 'where' structure. + __dbg_g_where := [file, line, proc_name, &null] + + # We get here either because of a 'next', or because we hit a + # breakpoint. + # If we break because of a 'next' we should not treat this as + # a breakpoint, even if there is one on this source line. + if __dbg_test === member then { + # This is a breakpoint; get it. + if bdescr := __dbg_g_brlookup[__dbg_fior (__dbg_g_fileidx[file], + line)] then { + # Check ignore count. + ((bdescr[BRKP_IGNORE] -:= 1) = -1) | fail + bdescr[BRKP_IGNORE] := 0 + } + else + __dbg_io_cfl ("Mysterious break: %1 (%2:%3).", + proc_name, file, line) + } + else { # Break caused by 'next'. + # By convention treated as breakpoint number 0. + bdescr := __dbg_g_brkpdef[0] + # Check ignore count. + ((bdescr[BRKP_IGNORE] -:= 1) = -1) | fail + bdescr[BRKP_IGNORE] := 0 + } + __dbg_g_where[WHERE_BRKP] := bdescr + + # Create table of locals. + __dbg_g_local := __dbg_ftable (__dbg_ge_singular) + every idx := 1 to *var_name do + __dbg_g_local[var_name[idx]] := var_val[idx] + + # Evaluate the condition of the breakpoint, if any. + if cond := \(bdescr)[BRKP_COND] then { + idx := 0 + __dbg_e_eval (cond[1]) & (idx +:= 1) + # Check for conflict. + # Make sure we don't resume in such case. + __dbg_io_cfl ("[%1] condition '%2'\n %3", + bdescr[BRKP_ID], cond[2], \__dbg_ge_message) & + (idx +:= 1) + (idx > 0) | fail + } + + # Reset the test procedure (effective if this is a 'next' break). + __dbg_test := member + + # The first command to execute is the macro attached to the + # breakpoint, if any; otherwise the prelude. + cmd := (\(\bdescr)[BRKP_DO] | __dbg_g_automacro[1]) + } + else { # Initialize global variables for Icon functions. + __dbg_func_init () + # Initialize breakpoint globals. + __dbg_g_brkpcnt := 0 + __dbg_g_brkpdef := __dbg_ftable () + __dbg_g_brlookup := __dbg_ftable () + __dbg_g_brkpid := 0 + + # Compute the procedure nesting level. + __dbg_g_level := &level - 2 + + # Create breakpoint number 0, used for 'next' breaks. + __dbg_g_brkpdef[0] := [0, "*any*", 0, 0, 0, 0, , ] + + # Display file name. + __dbg_g_display := "_DBG" || &clock[4:6] || &clock[7:0] || ".tmp" + + # More globals. + __dbg_g_src := [] + __dbg_g_white := ' \t' + __dbg_ge_singular := [] + + # Create file index table. + idx := -1 + __dbg_g_fileidx := __dbg_ftable () + every __dbg_g_fileidx[key(__dbg_file_map)] := + __dbg_fishift ((idx +:= 1), FIDX_SHIFT) + + # Open input and output files. + if tfname := __dbg_fgetenv (DBG_INPUT_ENV) then + __dbg_g_in := __dbg_x_openfile (tfname) + (/__dbg_g_in := &input) | __dbg_fpush (__dbg_g_src, &input) + + if tfname := __dbg_fgetenv (DBG_OUTPUT_ENV) then + __dbg_g_out1 := __dbg_x_openfile (tfname, 1) + /__dbg_g_out1 := &errout + + # Initialize command definitions. + __dbg_cmd_init () + + # Set up the breakpoint data structure. + # This is not a breakpoint; the following keeps some commands from + # crashing. + __dbg_g_local := __dbg_ftable () + __dbg_g_where := [&null, 0, "main", &null] + __dbg_default_prelude := + "fprint \"[%1] %2 (%3:%4)\\n\";&bp;&proc;&file;&line" + __dbg_default_postlude := "" + __dbg_g_automacro := [[__dbg_c_compile (__dbg_default_prelude)], + []] + cmd := [] + } + + # Command processing. + repeat { + case __dbg_c_interp (cmd) of { + RESUME_STATUS: break + STOP_STATUS: { + __dbg_fremove (__dbg_g_display) + __dbg_io_note ("Debug session terminates.") + __dbg_fexit (0) + } + } + # Get input until it compiles OK. + repeat { + (*__dbg_g_src > 0) | __dbg_fwrites ("$ ") + if cmd := [__dbg_c_compile (__dbg_io_getline ())] then + break + } + } + # Run the postlude, if any; status discarded. + __dbg_c_interp (__dbg_g_automacro[2]) + &trace := __dbg_g_trace +end + +# +#-------- Command processing procedures -------- +# + +procedure __dbg_c_compile (str, macro_def) +# Compiles a command. +# 'str' must be a command to compile (string). +# 'macro_def' must be non-null to indicate a macro is being defined. +# RETURNS a command instance (list), or +# FAILS on conflict. +local cmd, keywd + str ? { + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + keywd := __dbg_ftab (__dbg_fupto (__dbg_g_white) | 0) + if *keywd = 0 then # empty line treated as comment + return [__dbg_cx_NOOP, COMMENT_CMD] + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + (cmd := __dbg_c_findcmd (keywd)) | fail + return cmd[CMD_COMPILE] (cmd, macro_def) + } +end + +procedure __dbg_c_brkpt (not_zero) +# Extracts a breakpoint id from a command. +# A breakpoint id is either an integer, or one of the special forms +# '.' (current), '$' (last defined). +# 'not_zero' may be non-null to indicate that breakpoint number zero +# is not accepted. +# RETURNS a breakpoint identifier (integer) on success; +# FAILS with a suitable conflict message otherwise. +local id, res + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + (res := (__dbg_finteger (__dbg_ftab (__dbg_fmany (&digits))) | + 2(id := =".", BRKP_CURRENT) | + 2(id := ="$", BRKP_LAST))) | { + __dbg_io_cfl ("Breakpoint id (integer, '.', '$') expected.") + fail + } + (res > 0) | /not_zero | { + __dbg_io_cfl ("Breakpoint number 0 not accepted here.") + fail + } + return res +end + +procedure __dbg_c_interp (clist) +# Command interpreter. +# 'clist' must be a list of command instances. +# The interpreter may call itself indirectly through commands. +# RETURNS a status code, or +# FAILS on conflict, abandoning its command list. +local cmd, code + every cmd := !clist do { + (code := cmd[1]!cmd) | fail + (code = OK_STATUS) | return code + } + return OK_STATUS +end + +procedure __dbg_c_findcmd (keywd) +# Finds a command descriptor given a keyword. +# 'keywd' must be a command keyword candidate, possibly abbreviated (string). +# RETURNS a command definition, or +# FAILS with a message on conflict. +local count, cmd, mstr, sep, try + count := 0 + sep := mstr := "" + every __dbg_fmatch (keywd, (try := !__dbg_g_cmd)[CMD_NAME], 1, 0) do { + cmd := try + count +:= 1 + mstr ||:= sep || cmd[CMD_NAME] + sep := ", " + } + case count of { + 0: { + __dbg_io_cfl ("%1: unrecognized command.", keywd) + fail + } + 1: return cmd + default : { + __dbg_io_cfl ("'%1': ambiguous (matches %2).", keywd, mstr) + fail + } + } +end + +procedure __dbg_c_findkey (keywd, keylist) +# Finds a command descriptor given a keyword. +# 'keywd' must be a keyword candidate, possibly abbreviated (string). +# 'keylist' must be a list of available keywords. +# RETURNS an integer index into 'keylist', or +# FAILS with a message on conflict. +local count, cmd, idx, mstr, sep + count := 0 + sep := mstr := "" + every __dbg_fmatch (keywd, keylist[idx := 1 to *keylist], 1, 0) do { + count +:= 1 + mstr ||:= sep || keylist[cmd := idx] + sep := ", " + } + case count of { + 0: { + __dbg_io_cfl ("%1: unrecognized keyword.", keywd) + fail + } + 1: return cmd + default : { + __dbg_io_cfl ("'%1': ambiguous (matches %2).", keywd, mstr) + fail + } + } +end + +procedure __dbg_c_mcompile (fname) +# Compiles a macro. +# 'fname' must contain a file name (string) if the macro definition should +# be read from a file; otherwise null. +# If 'fname' is defined and can be opened, a null value is pushed on the file +# stack before the file, as a mark. +# RETURNS a macro, i.e. a list of compiled commands -- on success. +# FAILS if a conflict arises during the macro definition. +local cfl_count, cmd, f, line, macro + cfl_count := 0 + macro := [] + if \fname then { + if f := __dbg_x_openfile (fname) then { + __dbg_fpush (__dbg_g_src, __dbg_g_in) + __dbg_fpush (__dbg_g_src, &null) + __dbg_g_in := f + } + else + fail + } + repeat { + (*__dbg_g_src > 0) | __dbg_fwrites ("> ") + (line := __dbg_io_getline ()) | break + if cmd := __dbg_c_compile (line, 1) then { + if cmd[CMD_CODE] = END_CMD then + break + else + __dbg_fput (macro, cmd) + } + else + cfl_count +:= 1 + (cfl_count < 30) | break + } + /__dbg_g_in := __dbg_fpop (__dbg_g_src) + if cfl_count = 0 then + return macro + else { + __dbg_io_note ("The definition did not take effect.") + fail + } +end + +procedure __dbg_c_msource () +# Checks if the source of a macro is a file. +# RETURNS a file name if there is a '<' followed by a file name. +# RETURNS null if there is nothing but white space. +# FAILS with a message on conflict. +local fname + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + if ="<" then { + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + if __dbg_fpos (0) then { + __dbg_io_cfl ("File name expected.") + fail + } + fname := __dbg_ftrim (__dbg_ftab (0)) + } + return fname +end + +procedure __dbg_x_brkpt (id) +# RETURNS a breakpoint descriptor, given a breakpoint id ('id', integer). +# FAILS with a diagnostic message on conflict. +local bdescr + bdescr := case id of { + BRKP_CURRENT: \__dbg_g_where[WHERE_BRKP] | + (__dbg_io_cfl ("No current breakpoint."), &null) + BRKP_LAST: \__dbg_g_brkpdef[__dbg_g_brkpid] | + (__dbg_io_cfl ("Breakpoint [%1] undefined.", __dbg_g_brkpid), + &null) + default: \__dbg_g_brkpdef[id] | + (__dbg_io_cfl ("Breakpoint [%1] undefined.", id), &null) + } + return \bdescr +end + +procedure __dbg_x_dispglob (f, pat) +# Essentially performs the 'info globals' command. +# 'f' must be a display file open for input. +# 'pat' must be a substring that variable names must contain. +local fchanged, line, word +static func +initial { + func := set () + # A set containing all function names. + every insert (func, function ()) + } + fchanged := [] + until __dbg_fread (f) == "global identifiers:" + repeat { + (line := __dbg_fread (f)) | break + word := [] + line ? repeat { + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + if __dbg_fpos (0) then + break + __dbg_fput (word, __dbg_ftab (__dbg_fupto (__dbg_g_white) | 0)) + } + __dbg_fmatch (DBG_PREFIX, word[1]) | (word[1] == word[-1]) | + if __dbg_ffind (pat, word[1]) then + __dbg_io_info ("%1", word[1]) + + # Check if function name has been used for other things. + if member (func, word[1]) then { + (word[-2] == "function" & word[-1] == word[1]) | + put (fchanged, word[1]) + } + } + if *fchanged > 0 then { + __dbg_io_note ("The following global(s) no longer hold their usual Icon functions:") + every __dbg_io_wrline (" " || !fchanged) + } +end + +procedure __dbg_x_dispinit (f) +# Reads the display file, skipping over lines caused by the debugger. +# 'f' must be the display file, open for input. +# RETURNS the first 'significant' line. +# NOTE that you must take care of the 'co-expression' line before calling +# this procedure. +local line + until __dbg_fmatch (DBG_PREFIX, line := __dbg_fread (f)) + while line[1] == " " | __dbg_fmatch (DBG_PREFIX, line) do + line := __dbg_fread (f) + return line +end + +procedure __dbg_x_lbreak (bdescr) +# Lists the nominal definition of a breakpoint. +# 'bdescr' may be a breakpoint descriptor, or null. +# If null all breakpoints are listed. +local bd, blist, cond, dodef, tmplist + (blist := [\bdescr]) | { + tmplist := __dbg_fsort (__dbg_g_brkpdef) + blist := [] + every __dbg_fput (blist, (!tmplist)[2]) + } + every bd := !blist do { + dodef := if \bd[BRKP_DO] then " DO defined" else "" + __dbg_io_info ("[%1] %2 %3:%4%5", bd[BRKP_ID], bd[BRKP_FILE], + bd[BRKP_LINE1], bd[BRKP_LINE2], dodef) + if cond := \bd[BRKP_COND] then + __dbg_io_info (" CONDITION: %1", cond[2]) + } +end + +procedure __dbg_x_openfile (fname, output, quiet) +# Opens a file. +# 'fname' must be the name of the file to open. +# 'output' must be non-null if the file is to be opened for output. +# 'quiet' must be non-null to prevent a conflict from generating a message. +# RETURNS an open file on success; +# FAILS with a message otherwise, unless 'quiet' is set. +# FAILS silently if 'quiet' is set. +local f, mode, modestr + if \output then { + mode := "w" + modestr := "output" + } + else { + mode := "r" + modestr := "input" + } + (f := open (fname, mode)) | (\quiet & fail) | + __dbg_io_cfl ("Cannot open '%1' for %2.", fname, modestr) + return \f +end + +procedure __dbg_x_opendisplay () +# Opens the display file for reading; writes it first, if necessary. +# RETURNS a file open for input on success. +# FAILS with a message on conflict. +local f, res + if f := __dbg_x_openfile (__dbg_g_display,, 1) then { + if __dbg_finteger (__dbg_fread (f)) = __dbg_g_brkpcnt then + res := f + else + __dbg_fclose (f) + } + \res | { + (f := __dbg_x_openfile (__dbg_g_display, 1)) | fail + __dbg_fwrite (f, __dbg_g_brkpcnt) + display (, f) + __dbg_fclose (f) + (f := __dbg_x_openfile (__dbg_g_display)) | fail + __dbg_fread (f) # Throw away breakpoint counter. + res := f + } + return res +end + +#-------- Command compilation procedures -------- +# 'macro_def' must be non-null to indicate that a macro is being defined. +# The command compilation procedures must return a list representing the +# compiled command, or fail on conflict. +# When they are invoked the keyword and any following white space has been +# parsed. + + +procedure __dbg_cc_break (cmd, macro_def) +local fidx, fname, line1, line2 + __dbg_fany (&digits) | (fname := __dbg_ftab (__dbg_fupto (__dbg_g_white))) | { + __dbg_io_cfl ("File name and/or line number expected.") + fail + } + + # Get file name. + if \fname then { + (fidx := \__dbg_g_fileidx[fname]) | { + __dbg_io_cfl ("File name '%1' not recognized.", fname) + fail + } + } + else if fname := \__dbg_g_where[WHERE_FILE] then + fidx := __dbg_g_fileidx[fname] + else { # init mode + __dbg_io_cfl ("File name required.") + fail + } + + # Get line number(s). + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + (line1 := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits)))) | { + __dbg_io_cfl ("Line number expected.") + fail + } + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + if =":" then { + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + (line2 := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits)))) | { + __dbg_io_cfl ("Line number expected.") + fail + } + } + else + line2 := line1 + (line1 <= line2 < 1000000) | { + __dbg_io_cfl ("Weird line number.") + fail + } + + # Create an almost finished breakpoint descriptor (id is missing). + return [cmd[CMD_EXEC], cmd[CMD_CODE], [ , fname, fidx, line1, line2, 0, ,]] +end + +procedure __dbg_cc_clear (cmd, macro_def) +# A compound command. +local keyidx, parm +static ckey +initial ckey := ["breakpoint", "condition", "do", "echo", "macro"] + (keyidx := __dbg_c_findkey (__dbg_ftab (__dbg_fupto (__dbg_g_white) | 0), ckey)) | + fail + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + case keyidx of { + CLEAR_BREAKPOINT: + (parm := __dbg_c_brkpt (1)) | fail + (CLEAR_COND | CLEAR_DO): + (parm := __dbg_c_brkpt ()) | fail + CLEAR_MACRO: + (parm := __dbg_e_idf ()) | { + __dbg_io_cfl ("Macro name expected.") + fail + } + } + return [cmd[CMD_EXEC], cmd[CMD_CODE], ckey, keyidx, parm] +end + +procedure __dbg_cc_condition (cmd, macro_def) +local brkpt, expr + (brkpt := __dbg_c_brkpt ()) | fail + # This makes the expression cleaner, but not necessary. + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + (expr := __dbg_e_compile (__dbg_ftab (0))) | { + __dbg_io_cfl (__dbg_ge_message) + fail + } + (*expr = 1) | __dbg_io_note ("Last %1 expressions ignored.", *expr - 1) + return [cmd[CMD_EXEC], cmd[CMD_CODE], brkpt, expr[1]] +end + +procedure __dbg_cc_do (cmd, macro_def) +local brkpt, fname + /macro_def | { + __dbg_io_cfl ("Sorry, nested macros not accepted.") + fail + } + (brkpt := __dbg_c_brkpt ()) | fail + (fname := __dbg_c_msource ()) | fail + return [cmd[CMD_EXEC], cmd[CMD_CODE], brkpt, fname] +end + +procedure __dbg_cc_end (cmd, macro_def) + \macro_def | { + __dbg_io_cfl ("'end' out of context.") + fail + } + return [cmd[CMD_EXEC], cmd[CMD_CODE]] +end + +procedure __dbg_cc_eprint (cmd, macro_def) +local expr + (expr := __dbg_e_compile (__dbg_ftab (0))) | { + __dbg_io_cfl (__dbg_ge_message) + fail + } + (*expr = 1) | __dbg_io_note ("Last %1 expressions ignored.", *expr - 1) + return [cmd[CMD_EXEC], cmd[CMD_CODE], expr[1]] +end + +procedure __dbg_cc_frame (cmd, macro_def) +local frame_no + __dbg_fpos (0) | (frame_no := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits ++ '-')))) | { + __dbg_io_cfl ("Frame number expected.") + fail + } + return [cmd[CMD_EXEC], cmd[CMD_CODE], frame_no] +end + +procedure __dbg_cc_goon (cmd, macro_def) +local opt + __dbg_fpos (0) | __dbg_fmatch (opt := __dbg_ftab (__dbg_fmany (&lcase)), "nobreak", 1, 0) | { + __dbg_io_cfl ("Expected 'nobreak', found '%1'.", opt) + fail + } + return [cmd[CMD_EXEC], cmd[CMD_CODE], opt] +end + +procedure __dbg_cc_help (cmd, macro_def) +local keywd + __dbg_fpos (0) | (keywd := __dbg_ftab (__dbg_fmany (&lcase))) | { + __dbg_io_cfl ("Command keyword expected.") + fail + } + return [cmd[CMD_EXEC], cmd[CMD_CODE], keywd] +end + +procedure __dbg_cc_ignore (cmd, macro_def) +local brkpt, count + (brkpt := __dbg_c_brkpt ()) | fail + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + (count := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits ++ '+-')))) | { + __dbg_io_cfl ("Integer ignore count expected.") + fail + } + return [cmd[CMD_EXEC], cmd[CMD_CODE], brkpt, count] +end + +procedure __dbg_cc_info (cmd, macro_def) +# A compound command. +local keyidx, parm +static ckey +initial ckey := ["breakpoint", "echo", "files", "globals", "locals", "macros", + "trace", "version"] + (keyidx := __dbg_c_findkey (__dbg_ftab (__dbg_fupto (__dbg_g_white) | 0), ckey)) | + fail + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + if keyidx = INFO_BREAKPOINT then + __dbg_fpos (0) | (parm := __dbg_c_brkpt ()) | fail + else if keyidx = INFO_GLOBALS then + __dbg_fpos (0) | (parm := __dbg_ftab (__dbg_fupto (__dbg_g_white) | 0)) + return [cmd[CMD_EXEC], cmd[CMD_CODE], ckey, keyidx, parm] +end + +procedure __dbg_cc_macro (cmd, macro_def) +local fname, idf + /macro_def | { + __dbg_io_cfl ("Sorry, nested macros not accepted.") + fail + } + (idf := __dbg_ftab (__dbg_fmany (&lcase))) | { + __dbg_io_cfl ("Macro name expected.") + fail + } + (fname := __dbg_c_msource ()) | fail + return [cmd[CMD_EXEC], cmd[CMD_CODE], idf, fname] +end + +procedure __dbg_cc_next (cmd, macro_def) +local count + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + __dbg_fpos (0) | (count := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits ++ '+-')))) | { + __dbg_io_cfl ("Integer ignore count expected.") + fail + } + return [cmd[CMD_EXEC], cmd[CMD_CODE], count] +end + +procedure __dbg_cc_print (cmd, macro_def) +# Used to compile 'fprint' and 'print'. +local expr + (expr := __dbg_e_compile (__dbg_ftab (0))) | { + __dbg_io_cfl (__dbg_ge_message) + fail + } + return [cmd[CMD_EXEC], cmd[CMD_CODE], expr] +end + +procedure __dbg_cc_set (cmd, macro_def) +# A compound command. +local keyidx, parm +static ckey +initial ckey := ["echo", "prelude", "postlude"] + (keyidx := __dbg_c_findkey (__dbg_ftab (__dbg_fupto (__dbg_g_white) | 0), ckey)) | + fail + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + case keyidx of { + SET_ECHO: { + parm := __dbg_ftrim (__dbg_ftab (__dbg_fupto (__dbg_g_white) | 0)) + (*parm > 0) | { + __dbg_io_cfl ("File name expected.") + fail + } + } + (SET_PRELUDE | SET_POSTLUDE): + (parm := __dbg_c_msource ()) | fail + } + return [cmd[CMD_EXEC], cmd[CMD_CODE], ckey, keyidx, parm] +end + +procedure __dbg_cc_source (cmd, macro_def) +# The 'source' command is different from other commands, because it is not +# really compiled; it takes effect immediately. +# In contrast to macro compilation, no null marker is pushed on the file stack. +# RETURNS a dummy 'source' command. +local f, fname, res + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + if __dbg_fpos (0) then + __dbg_io_cfl ("File name expected.") + else { + fname := __dbg_ftrim (__dbg_ftab (0)) + if *__dbg_g_src >= MAX_SOURCE_NESTING then + __dbg_io_cfl ("%1: Too deeply nested 'source' file.", fname) + else if f := __dbg_x_openfile (fname) then { + __dbg_fpush (__dbg_g_src, __dbg_g_in) + __dbg_g_in := f + res := [cmd[CMD_EXEC], cmd[CMD_CODE], fname] + } + } + return \res +end + +procedure __dbg_cc_trace (cmd, macro_def) +local tlevel + (tlevel := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits ++ '+-')))) | { + __dbg_io_cfl ("Integer value expected.") + fail + } + return [cmd[CMD_EXEC], cmd[CMD_CODE], \tlevel] +end + +procedure __dbg_cc_SIMPLE (cmd, macro_def) +# Used to compile all keyword-only commands, including macros. + return [cmd[CMD_EXEC], cmd[CMD_CODE], cmd[CMD_MACRO]] +end + +#-------- Command executing procedures -------- +# The first parameter of these procedures is the procedure itself. +# (Not a very interesting parameter.) +# The command executing procedures must return a return code on success. +# Return codes are defined among the symbolic constants. +# The procedures must fail on conflict. + + +procedure __dbg_cx_break (proced, ccode, brkp) +local id, bpset, fidx, line1, line2 + # Add the breakpoint id to the descriptor. + brkp[BRKP_ID] := id := (__dbg_g_brkpid +:= 1) + __dbg_io_wrline ("[" || id || "]") + # Make sure we can find the breakpint descriptor, given its id. + __dbg_g_brkpdef[id] := brkp + # Install the breakpoint lines in the lookup table. + fidx := brkp[BRKP_FIDX] + line1 := brkp[BRKP_LINE1] + line2 := brkp[BRKP_LINE2] + every __dbg_g_brlookup[__dbg_fior (fidx, line1 to line2)] := brkp + # Add the line numbers to the breakpoint set. + bpset := __dbg_file_map[brkp[BRKP_FILE]] + every __dbg_finsert (bpset, line1 to line2) + return OK_STATUS +end + +procedure __dbg_cx_clear (proced, ccode, ckey, keyidx, parm) +# 'ckey' will be a list containing all the possible keywords to 'clear'. +# 'keyidx' is an index into that list, indicating a subcommand. +local bdescr, bpset, cmd, fidx, lcode, line, line1, line2 + if keyidx = (CLEAR_BREAKPOINT | CLEAR_COND | CLEAR_DO) then + (bdescr := __dbg_x_brkpt (parm)) | fail + else if keyidx = CLEAR_MACRO then + (cmd := __dbg_c_findcmd (parm)) | fail + case keyidx of { + CLEAR_BREAKPOINT: { + __dbg_fdelete (__dbg_g_brkpdef, bdescr[BRKP_ID]) + fidx := bdescr[BRKP_FIDX] + line1 := bdescr[BRKP_LINE1] + line2 := bdescr[BRKP_LINE2] + bpset := __dbg_file_map[bdescr[BRKP_FILE]] + # The range of lines once defined for the breakpoint might + # have been overwritten by later breakpoints. + every lcode := __dbg_fior (fidx, line := line1 to line2) do { + if __dbg_g_brlookup[lcode] === bdescr then { + __dbg_fdelete (__dbg_g_brlookup, lcode) + __dbg_fdelete (bpset, line) + } + } + } + CLEAR_COND: bdescr[BRKP_COND] := &null + CLEAR_DO: bdescr[BRKP_DO] := &null + CLEAR_ECHO: { + __dbg_fclose (\__dbg_g_out2) + __dbg_g_out2 := &null + } + CLEAR_MACRO: { + (cmd := __dbg_c_findcmd (parm)) | fail + __dbg_fdelete (__dbg_g_cmd, cmd[CMD_NAME]) + } + } + return OK_STATUS +end + +procedure __dbg_cx_condition (proced, ccode, brkpt, expr) +local bdescr + (bdescr := __dbg_x_brkpt (brkpt)) | fail + bdescr[BRKP_COND] := expr + return OK_STATUS +end + +procedure __dbg_cx_do (proced, ccode, brkpt, fname) +local bdescr + (bdescr := __dbg_x_brkpt (brkpt)) | fail + (bdescr[BRKP_DO] := __dbg_c_mcompile (fname)) | fail + return OK_STATUS +end + +procedure __dbg_cx_eprint (proced, ccode, expr) +local count, val + __dbg_io_wrline ("{" || expr[2] || "}") + count := 0 + every val := __dbg_fimage (__dbg_e_eval (expr[1])) do { + if __dbg_io_cfl (\__dbg_ge_message) then + fail + else + __dbg_io_wrline ("" || __dbg_fright ((count +:= 1), 3) || + ": " || val) + } + return OK_STATUS +end + +procedure __dbg_cx_fprint (proced, ccode, elist) +# 'elist' must be a list on the format returned by '__dbg_e_compile'. +local expr, fmt, idx, sval, val + val := [] + every expr := !elist do { + __dbg_fput (val, __dbg_e_eval (expr[1]) | "&fail") + if __dbg_io_cfl (\__dbg_ge_message) then + fail + } + (fmt := __dbg_fstring (val[1])) | { + __dbg_io_cfl ("Expected format string; got '%1'.", __dbg_fimage (val[1])) + fail + } + sval := [] + every idx := 2 to *val do { + __dbg_fput (sval, __dbg_fstring (val[idx])) | { + __dbg_io_cfl ("Expression not string-convertible: {%1} %2", + elist[idx][2], __dbg_fimage (val[idx])) + fail + } + } + __dbg_io_wrstr (__dbg_x_subst (fmt, sval)) + return OK_STATUS +end + +procedure __dbg_cx_frame (proced, ccode, frame_spec) +local f, frame_no, idx, line + frame_no := if \frame_spec then { + if frame_spec < 0 then __dbg_g_level + frame_spec else frame_spec + } else __dbg_g_level + (1 <= frame_no <= __dbg_g_level) | { + __dbg_io_cfl ("Invalid frame number.") + fail + } + (f := __dbg_x_opendisplay ()) | fail + line := __dbg_x_dispinit (f) + idx := __dbg_g_level + while idx > frame_no do { + repeat if (line := __dbg_fread (f))[1] ~== " " then + break + idx -:= 1 + } + __dbg_io_info ("(%1) %2", frame_no, line) + repeat { + if (line := __dbg_fread (f))[1] ~== " " then + break + line ? { + __dbg_ftab (__dbg_fmany (__dbg_g_white)) + =DBG_PREFIX | __dbg_io_info ("%1", line, *line > 0) + } + } + __dbg_fclose (f) + return OK_STATUS +end + +procedure __dbg_cx_goon (proced, ccode, nobreak) + if \nobreak then { + __dbg_test := integer + __dbg_fremove (__dbg_g_display) + } + return RESUME_STATUS +end + +procedure __dbg_cx_help (proced, ccode, keywd) +# 'keywd' will be an identifier if the command had a keyword. +local cmd, hstr + if cmd := __dbg_c_findcmd (\keywd) then { + if hstr := \cmd[CMD_HELP] then + __dbg_io_wrline (hstr) + else + __dbg_io_note ("No help available for '%1'.", cmd[CMD_NAME]) + } + else +__dbg_io_wrline ("Available commands: (all keywords may be abbreviated)\n_ +break (set breakpoint)\n_ +clear (clear breakpoint or debugger parameter)\n_ +condition (attach condition to breakpoint)\n_ +do (attach macro to breakpoint)\n_ +end (terminate macro definition)\n_ +eprint (print every value from expression)\n_ +fprint (formatted print)\n_ +frame (inspect procedure call chain)\n_ +goon (resume execution)\n_ +help (print explanatory text)\n_ +ignore (set ignore counter on breakpoint)\n_ +info (print information about breakpoint or debugger parameter)\n_ +macro (define new command)\n_ +next (resume execution, break on every line)\n_ +print (print expressions)\n_ +set (set a debugger parameter)\n_ +source (read debugging commands from file)\n_ +stop (terminate program and debugging session)\n_ +trace (set value of Icon &trace)\n_ +where (print procedure call chain)\n\n_ +An expression may be formed from a large subset of Icon operators; integer,\n_ +string, list literals; locals from the current procedure, and globals.\n_ +Procedure/function invocation, subscripting, record field reference is\n_ +supported. Several keywords are also included.\n\n_ +New/altered keywords,\n_ +\ &bp, &breakpoint current breakpoint id (integer)\n_ +\ &file current breakpoint source file name (string)\n_ +\ &line current breakpoint line number (integer)\n_ +\ &proc current breakpoint procedure name (string)") + return OK_STATUS +end + +procedure __dbg_cx_ignore (proced, ccode, brkpt, count) +local bdescr + (bdescr := __dbg_x_brkpt (brkpt)) | fail + bdescr[BRKP_IGNORE] := count + return OK_STATUS +end + +procedure __dbg_cx_info (proced, ccode, ckey, keyidx, parm) +# 'ckey' will be a list containing all the possible keywords to 'info'. +# 'keyidx' is an index into that list, indicating a subcommand. +local cmd, bdescr, f, nlist, version + case keyidx of { + INFO_BREAKPOINT: + if \parm then { + (bdescr := __dbg_x_brkpt (parm)) | fail + __dbg_x_lbreak (bdescr) + } + else + __dbg_x_lbreak () + INFO_ECHO: + if \__dbg_g_out2 then + __dbg_io_info ("Echo file: %1.", __dbg_g_out2name) + else + __dbg_io_info ("No echo file.") + INFO_FILES: { + nlist := [] + every __dbg_fput (nlist, __dbg_fkey (__dbg_file_map)) + nlist := __dbg_fsort (nlist) + __dbg_io_info ("Tweaked source files in this program:") + every __dbg_io_info (" %1", !nlist) + } + INFO_GLOBALS: { + (f := __dbg_x_opendisplay ()) | fail + if \parm then + __dbg_x_dispglob (f, parm) + else + __dbg_x_dispglob (f, "") + __dbg_fclose (f) + } + INFO_LOCALS: { + nlist := [] + every __dbg_fput (nlist, __dbg_fkey (__dbg_g_local)) + nlist := __dbg_fsort (nlist) + __dbg_io_info ("Local identifiers in the current procedure:", + *nlist > 0) + every __dbg_io_info (" %1", !nlist) + } + INFO_MACROS: { + nlist := [] + every \(cmd := !__dbg_g_cmd)[CMD_MACRO] do + __dbg_fput (nlist, cmd[CMD_NAME]) + nlist := __dbg_fsort (nlist) + __dbg_io_info ("Currently defined macros:", *nlist > 0) + every __dbg_io_info (" %1", !nlist) + } + INFO_TRACE: + __dbg_io_info ("Current trace level: %1.", __dbg_g_trace) + INFO_VERSION: { + version := (PROGRAM_VERSION ? (__dbg_ftab (__dbg_fupto (&digits)), + __dbg_ftab (__dbg_fmany (&digits++'.')))) + __dbg_io_info ("Program tweaked by itweak version %1.\n_ + This is runtime version %2.", __dbg_itweak_ver, version) + } + } + return OK_STATUS +end + +procedure __dbg_cx_macro (proced, ccode, idf, fname) +# Executes a 'macro' statement (not the resulting macro). +# 'fname' contains a file name (string) if the macro definition should be +# read from a file; otherwise null. +# SIDE EFFECT: Adds a command definition to '__dbg_g_cmd' on success. +local count, macro, mstr, sep, try + count := 0 + mlist := [] + # Macro name must not be an abbreviation of an existing command. + every __dbg_fmatch (idf, try := (!__dbg_g_cmd)[CMD_NAME], 1, 0) do { + count +:= 1 + __dbg_fput (mlist, try) + } + # Check that no existing command is an abbreviation of macro name. + every __dbg_fmatch (try := (!__dbg_g_cmd)[CMD_NAME], idf, 1, 0) do { + count +:= 1 + (try == !mlist) | __dbg_fput (mlist, try) + } + (count = 0) | { + mstr := sep := "" + every mstr ||:= sep || !mlist do + sep := ", " + __dbg_io_cfl ("'%1' clashes with existing command (%2).", idf, mstr) + fail + } + (macro := __dbg_c_mcompile (fname)) | fail + __dbg_g_cmd[idf] := [idf, USERDEF_CMD, , __dbg_cc_SIMPLE, macro, __dbg_cx_userdef] + return OK_STATUS +end + +procedure __dbg_cx_next (proced, ccode, count) +# 'count' may be an ignore count. + __dbg_g_brkpdef[0][BRKP_IGNORE] := \count + __dbg_test := 2 + return RESUME_STATUS +end + +procedure __dbg_cx_print (proced, ccode, elist) +# 'elist' must be a list on the format returned by '__dbg_e_compile'. +local expr, val + every expr := !elist do { + val := (__dbg_fimage (__dbg_e_eval (expr[1])) | "&fail") + if __dbg_io_cfl (\__dbg_ge_message) then + fail + else + __dbg_io_wrline ("{" || expr[2] || "} " || val) + } + return OK_STATUS +end + +procedure __dbg_cx_set (proced, ccode, ckey, keyidx, parm) +# 'ckey' will be a list containing all the possible keywords to 'set'. +# 'keyidx' is an index into that list, indicating a subcommand. + case keyidx of { + SET_ECHO: { + (__dbg_g_out2 := __dbg_x_openfile (parm, 1)) | fail + __dbg_g_out2name := parm + } + SET_PRELUDE: + (__dbg_g_automacro[1] := __dbg_c_mcompile (parm)) | fail + SET_POSTLUDE: + (__dbg_g_automacro[2] := __dbg_c_mcompile (parm)) | fail + } + return OK_STATUS +end + +procedure __dbg_cx_stop (proced, ccode) + return STOP_STATUS +end + +procedure __dbg_cx_trace (proced, ccode, tlevel) + __dbg_g_trace := tlevel + return OK_STATUS +end + +procedure __dbg_cx_where (proced, ccode) +local f, idf, idx, line + (f := __dbg_x_opendisplay ()) | fail + __dbg_io_info ("Current call stack in %1:", __dbg_fread (f)) + idx := __dbg_g_level + line := __dbg_x_dispinit (f) + repeat { + idf := (line ? __dbg_ftab (__dbg_fupto (__dbg_g_white))) + if idf == "global" then + break + if *idf > 0 then { + __dbg_io_info ("(%1) %2", idx, idf) + idx -:= 1 + } + (line := __dbg_fread (f)) | break # Sanity. + } + __dbg_fclose (f) + return OK_STATUS +end + +procedure __dbg_cx_userdef (proced, ccode, macro) + return __dbg_c_interp (macro) +end + +procedure __dbg_cx_NOOP (proced, ccode) + return OK_STATUS +end + +# +#-------- General-purpose procedures -------- +# + +procedure __dbg_x_fld_adj (str) +# Part of 'subst' format string parsing. +# 'str' must be a parameter string identified by the beginning part of a +# placeholder ('%n'). +# This procedure checks if the placeholder contains a fixed field width +# specifier. +# A fixed field specifier begins with '<' or '>' and continues with the field +# width expressed as a decimal literal. +# RETURNS 'str' possibly inserted in a fixed width field. +local just, init_p, res, wid +static fwf +initial fwf := '<>' + init_p := &pos + if (just := if ="<" then left else if =">" then right) & + (wid := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits)))) then + res := just (str, wid) + else { + res := str + &pos := init_p + } + return res +end + +procedure __dbg_x_subst (msg, parm) +# Substitutes parameters in a message template. +# 'msg' must be a message template (string). +# 'parm' must be a list of parameters (list of string-convertible), or null. +# It may also be a string. +local esc, res, sub +static p_digit +initial p_digit := '123456789' + \parm | return msg + parm := [__dbg_fstring (parm)] + res := "" + msg ? until __dbg_fpos (0) do { + res ||:= __dbg_ftab (__dbg_fupto ('%\\') | 0) + if ="%" then res ||:= { + if __dbg_fany (p_digit) then { + sub := (\parm[__dbg_finteger (__dbg_fmove (1))] | "") + __dbg_x_fld_adj (sub) + } + else if __dbg_fany ('%') then + __dbg_fmove (1) + else "" + } + else if ="\\" then res ||:= case esc := __dbg_fmove (1) of { + "n": "\n" + "t": "\t" + default: esc + } + } + return res +end + +# +#-------- Input/Output procedures -------- +# + +procedure __dbg_io_cfl (format, parm[]) +# Writes a conflict message to debugging output. +# 'format' must be a format string. +# 'parm' must be string-convertibles to insert into placeholders in the +# format string, if any. +# RETURNS 1 (i.e. always succeeds). + __dbg_io_wrline ("[debug CONFLICT] " || __dbg_x_subst (format, parm)) + return 1 +end + +procedure __dbg_io_getline () +# RETURNS the next line from debugging input, or +# FAILS on end of file. +local line + (line := __dbg_fread (__dbg_g_in)) | { + __dbg_fclose (__dbg_g_in) + # Check for a macro definition marker. + \(__dbg_g_in := __dbg_fpop (__dbg_g_src)) | fail + if *__dbg_g_src > 0 then + return __dbg_io_getline () + } + __dbg_fwrite (\__dbg_g_out2, "$ ", \line) + return \line +end + +procedure __dbg_io_info (format, parm[]) +# Writes an info message to debugging output. +# 'format' must be a format string. +# 'parm' must be string-convertibles to insert into placeholders in the +# format string, if any. + __dbg_io_wrline (__dbg_x_subst (format, parm)) +end + +procedure __dbg_io_note (format, parm[]) +# Writes a note to debugging output. +# 'format' must be a format string. +# 'parm' must be string-convertibles to insert into placeholders in the +# format string, if any. + __dbg_io_wrline ("[debug NOTE] " || __dbg_x_subst (format, parm)) +end + +procedure __dbg_io_wrline (line) +# Writes a string and a newline to debugging output. +# 'line' must be the string to write. +# It may contains additional newlines. + __dbg_fwrite (__dbg_g_out1, line) + __dbg_fwrite (\__dbg_g_out2, line) +end + +procedure __dbg_io_wrstr (line) +# Writes a string without a newline to debugging output. +# 'line' must be the string to write. +# It may contains additional newlines. + __dbg_fwrites (__dbg_g_out1, line) + __dbg_fwrites (\__dbg_g_out2, line) +end + +# +#-------- Function initialization --------- +# +procedure __dbg_func_init () + __dbg_fany := any + __dbg_fclose := close + __dbg_fdelete := delete + __dbg_fexit := exit + __dbg_ffind := find + __dbg_fgetenv := getenv + __dbg_fimage := image + __dbg_finsert := insert + __dbg_finteger := integer + __dbg_fior := ior + __dbg_fishift := ishift + __dbg_fkey := key + __dbg_fmany := many + __dbg_fmatch := match + __dbg_fmove := move + __dbg_fpop := pop + __dbg_fpos := pos + __dbg_fproc := proc + __dbg_fpush := push + __dbg_fput := put + __dbg_fread := read + __dbg_fremove := remove + __dbg_freverse := reverse + __dbg_fright := right + __dbg_fsort := sort + __dbg_fstring := string + __dbg_ftab := tab + __dbg_ftable := table + __dbg_ftrim := trim + __dbg_ftype := type + __dbg_fupto := upto + __dbg_fwrite := write + __dbg_fwrites := writes +end + +# +#-------- Command initialization --------- +# + +procedure __dbg_cmd_init () +# Initialize command definitions. + __dbg_g_cmd := __dbg_ftable () +### break + __dbg_g_cmd["break"] := ["break", BREAK_CMD, +" break [file] [line [: line]]\n_ +Sets a breakpoint on a line or a range of lines. The file name (if present)\n_ +must be one of the tweaked files (cf. the 'info files' command). If omitted\n_ +the file of the current breakpoint is assumed. The identity of the new\n_ +breakpoint (an integer) is displayed. It may be used in other commands.\n_ +Besides an integer there are two other ways to identify a breakpoint,\n_ +\ . (dot) the current breakpoint,\n_ +\ $ (dollar) the last breakpoint defined by a 'break' command.\n_ +Breakpoint 0 (zero) is special; see the 'next' command.\n\n_ +As a rule a breakpoint takes effect AFTER the breakpointed line has been\n_ +executed. If two breakpoints are defined on the same line, only the latest\n_ +is in effect.", +__dbg_cc_break, , __dbg_cx_break] +### clear + __dbg_g_cmd["clear"] := ["clear", CLEAR_CMD, +" clear breakpoint brkpt\n_ +Deletes breakpoint identified by 'brkpt'.\n_ +\ clear condition brkpt\n_ +Removes condition from breakpoint 'brkpt'. The breakpoint becomes\n_ +unconditional.\n_ +\ clear do brkpt\n_ +Removes commands associated with breakpoint 'brkpt'.\n_ +\ clear echo\n_ +Stops output to echo file.\n_ +\ clear macro name\n_ +Removes macro identified by 'name'.", +__dbg_cc_clear, , __dbg_cx_clear] +### comment + __dbg_g_cmd["#"] := ["#", COMMENT_CMD, +" # comment text\n_ +A line beginning with '#' is ignored.", +__dbg_cc_SIMPLE, , __dbg_cx_NOOP] +### condition + __dbg_g_cmd["condition"] := ["condition", CONDITION_CMD, +" condition brkpt expr\n_ +Attaches a condition to breakpoint 'brkpt'. The expression 'expr' must\n_ +succeed for a break to occur.", +__dbg_cc_condition, , __dbg_cx_condition] +### do + __dbg_g_cmd["do"] := ["do", DO_CMD, +" do brkpt [<filename]\n_ +Attaches commands to the breakpoint identified by 'brkpt'. The commands\n_ +are entered interactively (terminate with 'end'), or are read from a file.", +__dbg_cc_do, , __dbg_cx_do] +### end + __dbg_g_cmd["end"] := ["end", END_CMD, +" end\n_ +Terminates a macro definition.", +__dbg_cc_end, , __dbg_cx_NOOP] +### eprint + __dbg_g_cmd["eprint"] := ["eprint", EPRINT_CMD, +" eprint expr\n_ +Prints image of every value generated by expression 'expr'.", +__dbg_cc_eprint, , __dbg_cx_eprint] +### fprint + __dbg_g_cmd["fprint"] := ["fprint", FPRINT_CMD, +" fprint format-expr {; expr}\n_ +Formatted print. The first expression must evaluate to a format string,\n_ +possibly containing placeholders (%1, %2, etc). The result of evaluating\n_ +remaining expressions will be substituted for the placeholders. You must\n_ +make sure their values are string-convertible (the 'image' function is\n_ +available). Insert '\\n' in format string to obtain newline.", +__dbg_cc_print, , __dbg_cx_fprint] +### frame + __dbg_g_cmd["frame"] := ["frame", FRAME_CMD, +" frame [n]\n_ +Shows a call frame. 'n' may be an integer frame number (obtained from\n_ +the 'where' command), or may be omitted. Omitted frame number = current\n_ +procedure. Negative frame number is relative to the current procedure.\n_ +The command prints the image of all local variables.", +__dbg_cc_frame, , __dbg_cx_frame] +### goon + __dbg_g_cmd["goon"] := ["goon", GOON_CMD, +" goon [nobreak]\n_ +Resumes execution. With 'nobreak': lets the program run to completion\n_ +without breaking.", +__dbg_cc_goon, , __dbg_cx_goon] +### help + __dbg_g_cmd["help"] := ["help", HELP_CMD, +" help [command]\n_ +Displays information. Prints short command description if command keyword\n_ +is included. Otherwise prints list of available commands.", +__dbg_cc_help, , __dbg_cx_help] +### ignore + __dbg_g_cmd["ignore"] := ["ignore", IGNORE_CMD, +" ignore brkpt count\n_ +Sets the ignore counter of breakpoint 'brkpt'. 'count' may be a positive\n_ +or negative integer. It replaces the previous ignore counter value.\n_ +A breakpoint with a non-zero ignore count does not cause a break, but the\n_ +ignore count is decremented by 1.", +__dbg_cc_ignore, , __dbg_cx_ignore] +### info + __dbg_g_cmd["info"] := ["info", INFO_CMD, +" info breakpoint [brkpt]\n_ +Prints info about breakpoint identified by 'brkpt', or about all\n_ +breakpoints if 'brkpt' is omitted.\n_ +\ info echo\n_ +Prints the current 'echo' file name, if any.\n_ +\ info files\n_ +Prints names of source files with tweaked ucode in this program.\n_ +\ info globals [substr]\n_ +Prints names of global variables. The optional substring limits output\n_ +to global names containing this substring.\n_ +\ info locals\n_ +Prints names of all local variables in current procedure.\n_ +\ info macros\n_ +Prints names of all currently defined macros.\n_ +\ info trace\n_ +Prints the current value of &trace.\n_ +\ info version\n_ +Prints itweak and runtime versions.", +__dbg_cc_info, , __dbg_cx_info] +### macro + __dbg_g_cmd["macro"] := ["macro", MACRO_CMD, +" macro name\n_ +Creates a new command called 'name'. The command will consist of\n_ +subsequent lines, up to a line containing 'end'.\n_ +\ macro name <filename\n_ +As above, but macro definition read from a file. 'end' command optional.", +__dbg_cc_macro, , __dbg_cx_macro] +### next + __dbg_g_cmd["next"] := ["next", NEXT_CMD, +" next [count]\n_ +Resumes execution as if a breakpoint were defined on every line. An\n_ +ignore count may be included (see the 'ignore' command). A break\n_ +caused by 'next' is considered breakpoint 0 (zero), even if an\n_ +ordinary breakpoint is in effect on the same line. The 'condition',\n_ +'do', 'info' commands accept 0 as a breakpoint number.", +__dbg_cc_next, , __dbg_cx_next] +### print + __dbg_g_cmd["print"] := ["print", PRINT_CMD, +" print expr {; expr}\n_ +Evaluates and print image of expression(s). Only the first value from\n_ +each expression is printed. '&fail' printed if an expression fails.", +__dbg_cc_print, , __dbg_cx_print] +### set + __dbg_g_cmd["set"] := ["set", SET_CMD, +" set echo filename\n_ +Starts echoing output to a file.\n_ +\ set prelude [<file]\n_ +Defines a macro to be exeucted at breaks. The default prelude is\n_ +\ fprint \"[%1] %2 (%3:%4)\\n\";&bp;&proc;&file;&line\n_ +It prints breakpoint number, procedure name, source file name, and\n_ +line number.\n_ +\ set postlude [<file]\n_ +Defines a macro to be executed when resuming execution. The default\n_ +postlude does nothing.", +__dbg_cc_set, , __dbg_cx_set] +### source + __dbg_g_cmd["source"] := ["source", SOURCE_CMD, +" source filename\n_ +Reads commands from a file. Takes effect immediately when used in a macro\n_ +definition.", +__dbg_cc_source, , __dbg_cx_NOOP] +### stop + __dbg_g_cmd["stop"] := ["stop", STOP_CMD, +" stop\n_ +Stops the program and terminates the debugging session.", +__dbg_cc_SIMPLE, , __dbg_cx_stop] +### trace + __dbg_g_cmd["trace"] := ["trace", TRACE_CMD, +" trace count\n_ +Sets the value of the Icon trace counter (&trace) to 'count'.", +__dbg_cc_trace, , __dbg_cx_trace] +### where + __dbg_g_cmd["where"] := ["where", WHERE_CMD, +" where\n_ +Prints the call chain leading up to the current procedure.\n_ +Displays frame numbers which may be used by the 'frame' command.", +__dbg_cc_SIMPLE, , __dbg_cx_where] +end + +############### EXPRESSIONS ############################## +# +# Parses a fair subset of Icon expressions. +# Compiles them into a linear post-fix representation. +# Evaluates. +# Somewhat adapted to the debugging environment, but +# generally useful with small modifications. +# +########################################################## + +# +#-------------- Expression management constants ---------- +# + +$define IDENT_T 1 +$define INTEGER_T 2 +$define STRING_T 3 +$define SPECIAL_T 4 +$define FIELD_T 5 +$define LIST_T 6 +$define EXPR_T 8 +$define ELIST_T 9 +$define UNOP_T 10 +$define BINOP_T 11 +$define TEROP_T 12 +$define INVOKE_T 13 + +$define NOTN_OP 901 +$define ISN_OP 902 +$define SIZ_OP 903 +$define BNG_OP 904 +$define NEG_OP 905 + +$define ALT_OP 1501 +$define CNJ_OP 1401 +# N -- numerical comparison. +$define NEQ_OP 1301 +$define NNE_OP 1302 +$define NLE_OP 1303 +$define NLT_OP 1304 +$define NGE_OP 1305 +$define NGT_OP 1306 +# L -- lexical comparison. +$define LLT_OP 1307 +$define LLE_OP 1308 +$define LEQ_OP 1309 +$define LNE_OP 1310 +$define LGE_OP 1311 +$define LGT_OP 1312 +$define EQ_OP 1313 +$define NE_OP 1314 +$define ADD_OP 1201 +$define SUBTR_OP 1202 +$define UNION_OP 1203 +$define DIFF_OP 1204 +$define CAT_OP 1101 +$define LCAT_OP 1102 +$define MUL_OP 1001 +$define DIV_OP 1002 +$define REM_OP 1003 +$define ISCT_OP 1004 +$define EXP_OP 1001 +$define INVOKE_OP 801 +$define SSC_OP 802 +$define PART_OP 803 +$define FLD_OP 804 + +$define CLOCK_SP 1 +$define CURRENT_SP 2 +$define DATE_SP 3 +$define DATELINE_SP 4 +$define POS_SP 5 +$define REGIONS_SP 6 +$define SOURCE_SP 7 +$define STORAGE_SP 8 +$define SUBJECT_SP 9 +$define VERSION_SP 10 + +$define BREAK_SP 101 +$define FILE_SP 102 +$define LEVEL_SP 103 +$define LINE_SP 104 +$define PROC_SP 105 +$define TRACE_SP 106 + +# +#-------------- Expression parsing ---------------------- +# + +procedure __dbg_e_compile (str) +# Compiles one or more expressions separated by a semicolon. +# 'str' must be the candidate expression (string). +# RETURNS a list of lists where each sublist has the following components: +# (1) The compiled expression in postfix representation (list). +# This representation can be used with the '__dbg_e_eval' procedure. +# (2) The expression source string. +# FAILS on conflict. +# SIDE EFFECT: Assigns a message (string) to '__dbg_ge_message' on conflict; +# assigns &null otherwise. +local elist, res1, res2, pos1, pos2 + elist := [] + # Parse the expression(s). + str ? repeat { + pos1 := &pos + (res1 := 1(__dbg_e_expr(), pos2:= &pos, __dbg_e_ws (), + (__dbg_fpos (0) | __dbg_fany (';')))) | { + __dbg_ge_message := "Expression syntax error." + fail + } + # Linearize, convert to postfix. + __dbg_ge_message := &null + res2 := [] + __dbg_e_ecode (res1, res2) + # Check for conflict. + /__dbg_ge_message | fail + __dbg_fput (elist, [res2, str[pos1:pos2]]) + if __dbg_fpos (0) then + break + else { + __dbg_fmove (1) + __dbg_e_ws () + } + } + return elist +end + +procedure __dbg_e_expr() + __dbg_ftab (__dbg_fmany (' \t')) + suspend [__dbg_e_term()] | + ([__dbg_e_term(), __dbg_e_bin()] ||| __dbg_e_expr()) +end + +procedure __dbg_e_term() + __dbg_ftab (__dbg_fmany (' \t')) + suspend [__dbg_e_factor()] | + [__dbg_e_factor(), __dbg_e_form()] | + [__dbg_e_un(), __dbg_e_factor()] | + [__dbg_e_un(), __dbg_e_factor(), __dbg_e_form()] +end + +procedure __dbg_e_form() + __dbg_ftab (__dbg_fmany (' \t')) + suspend 2(=".", [FLD_OP, [FIELD_T, __dbg_e_idf()]]) | + 2(="[", [SSC_OP, __dbg_e_expr()], ="]") | + 2(="(", [INVOKE_OP, __dbg_e_elist()], =")") | + 2(="[", [PART_OP, __dbg_e_expr(), + 3(__dbg_e_ws(), =":", __dbg_e_expr())], ="]") | + (2(=".", [FLD_OP, [FIELD_T, __dbg_e_idf()]]) ||| __dbg_e_form()) | + (2(="[", [SSC_OP, __dbg_e_expr()], ="]") ||| __dbg_e_form()) | + (2(="(", [INVOKE_OP, __dbg_e_elist()], =")") ||| __dbg_e_form()) | + (2(="[", [PART_OP, __dbg_e_expr(), + 3(__dbg_e_ws(), =":", __dbg_e_expr())], ="]") ||| + __dbg_e_form()) +end + +procedure __dbg_e_elist() + __dbg_ftab (__dbg_fmany (' \t')) + suspend [] | + [__dbg_e_expr()] | + [__dbg_e_expr()] ||| 3(__dbg_e_ws(), =",", __dbg_e_elist()) +end + +procedure __dbg_e_factor() + __dbg_ftab (__dbg_fmany (' \t')) + suspend [IDENT_T, __dbg_e_idf()] | + [INTEGER_T, __dbg_e_ilit()] | + [STRING_T, __dbg_e_slit()] | + [SPECIAL_T, (="&", __dbg_e_idf())] | + 2(="(", [EXPR_T, __dbg_e_expr()], __dbg_e_ws(), =")") | + 2(="[", [LIST_T, __dbg_e_elist()], __dbg_e_ws(), ="]") +end + +procedure __dbg_e_idf() +static char1, char2 +initial { + char1 := &ucase ++ &lcase ++ '_' + char2 := char1 ++ &digits + } + suspend __dbg_ftab (__dbg_fmany (char1)) || (__dbg_ftab (__dbg_fmany (char2)) | "") +end + +procedure __dbg_e_ilit() + suspend __dbg_ftab (__dbg_fmany (&digits)) +end + +procedure __dbg_e_strend() +static signal, nonsignal +initial { + signal := '\"\\' + nonsignal := ~signal + } + suspend 2(="\"", "") | + 1(__dbg_e_stresc(), ="\"") | + (__dbg_e_stresc() || __dbg_ftab (__dbg_fmany (nonsignal)) || __dbg_e_strend()) | + (__dbg_e_stresc() || __dbg_e_strend()) +end + +procedure __dbg_e_stresc() + suspend (="\\n", "\n") | + (="\\t", "\t") | + (="\\r", "\r") | + (="\\", __dbg_fmove (1)) +end + +procedure __dbg_e_slit() +static signal, nonsignal +initial { + signal := '\"\\' + nonsignal := ~signal + } + suspend 2(="\"", + (__dbg_ftab (__dbg_fmany (nonsignal)) || __dbg_e_strend()) | __dbg_e_strend()) +end + +procedure __dbg_e_un() +# Sequence of unary operators. +# Always succeeds. +# NOTE: Assumes no space between operators. +static unop +initial unop := '\\/*!-' + __dbg_ftab (__dbg_fmany (' \t')) + suspend [UNOP_T, __dbg_ftab (__dbg_fmany (unop))] +end + +procedure __dbg_e_bin() +# Binary operators. +static optab +initial { + # Table of operators. + # Operators are coded as decimal integers where the hundreds + # digit defines precedence. + optab := table() + optab["|"] := ALT_OP + optab["&"] := CNJ_OP + optab["="] := NEQ_OP + optab["~="] := NNE_OP + optab["<="] := NLE_OP + optab["<"] := NLT_OP + optab[">="] := NGE_OP + optab[">"] := NGT_OP + optab["<<"] := LLT_OP + optab["<<="] := LLE_OP + optab["=="] := LEQ_OP + optab["~=="] := LNE_OP + optab[">>="] := LGE_OP + optab[">>"] := LGT_OP + optab["==="] := EQ_OP + optab["~==="] := NE_OP + optab["+"] := ADD_OP + optab["-"] := SUBTR_OP + optab["++"] := UNION_OP + optab["--"] := DIFF_OP + optab["||"] := CAT_OP + optab["|||"] := LCAT_OP + optab["*"] := MUL_OP + optab["/"] := DIV_OP + optab["%"] := REM_OP + optab["**"] := ISCT_OP + optab["^"] := EXP_OP + } + __dbg_ftab (__dbg_fmany (' \t')) + suspend \optab[__dbg_fmove (3)] | + \optab[__dbg_fmove (2)] | + \optab[__dbg_fmove (1)] | + \optab[=("~===")] +end + +procedure __dbg_e_ws() +# Removes optional white space. +# The point is that it always succeeds. + __dbg_ftab (__dbg_fmany (' \t')) + return 1 +end + +#-------------- Linearization ---------------------- + +procedure __dbg_e_ecode (ex, res) +# 'Evaluates' the list resulting from pattern matching. +# Produces a single list with everything in postfix order. +# 'ex' must be an expression in the form that '__dbg_e_compile' generates. +# 'res' must be an (empty) list where the expression elements are to +# be inserted. +# Always FAILS. +# SIDE EFFECT: Adds elements to 'res'. +# Assigns a message string to '__dbg_ge_message' on conflict. +local opnd, oprt, op_stack + if *ex = 1 then + __dbg_e_tcode (ex[1], res) + else { + op_stack := [] + opnd := create !ex + __dbg_e_tcode (@opnd, res) + while oprt := @opnd do { + while (op_stack[1]/100) <= (oprt/100) do + __dbg_fput (res, __dbg_e_proc ([BINOP_T, __dbg_fpop (op_stack),])) + __dbg_fpush (op_stack, oprt) + __dbg_e_tcode (@opnd, res) + } + while __dbg_fput (res, __dbg_e_proc ([BINOP_T, __dbg_fpop (op_stack),])) + } +end + +procedure __dbg_e_tcode (tm, res) +# Disentangles a term. +local comp, unary +static special, unop +initial { + special := __dbg_ftable () + # The 'normal' keywords. + special["clock"] := CLOCK_SP + special["current"] := CURRENT_SP + special["date"] := DATE_SP + special["dateline"] := DATELINE_SP + special["pos"] := POS_SP + special["regions"] := REGIONS_SP + special["source"] := SOURCE_SP + special["storage"] := STORAGE_SP + special["subject"] := SUBJECT_SP + special["trace"] := TRACE_SP + special["version"] := VERSION_SP + + # The special keywords. + special["bp"] :=BREAK_SP + special["breakpoint"] :=BREAK_SP + special["file"] := FILE_SP + special["level"] := LEVEL_SP + special["line"] := LINE_SP + special["proc"] := PROC_SP + + unop := __dbg_ftable () + unop["\\"] := NOTN_OP + unop["/"] := ISN_OP + unop["*"] := SIZ_OP + unop["!"] := BNG_OP + unop["-"] := NEG_OP + } + every comp := !tm do case comp[1] of { + UNOP_T: unary := comp # Save for later. + INTEGER_T: { + comp[2] := __dbg_finteger (comp[2]) + __dbg_fput (res, comp) + } + SPECIAL_T: { + if comp[2] := \special[comp[2]] then + __dbg_fput (res, comp) + else + __dbg_ge_message := "'" || comp[2] || + "': unrecognized special identifier." + } + EXPR_T: __dbg_e_ecode (comp[2], res) + LIST_T: { + every __dbg_e_ecode (!comp[2], res) + __dbg_fput (res, [LIST_T, *comp[2]]) + } + (FLD_OP | SSC_OP | INVOKE_OP | PART_OP) : + __dbg_e_fcode (comp, res) + default: __dbg_fput (res, comp) + # This includes: IDENT_T, STRING_T + } + every __dbg_fput (res, __dbg_e_proc ([UNOP_T, unop[!__dbg_freverse ((\unary)[2])],])) +end + +procedure __dbg_e_fcode (fm, res) +# Disentangles a form. +# The operators have the same precedence; stack not needed. +local comp, opnd, oprt + comp := create !fm + while oprt := @comp do { + opnd := @comp # There is at least one operand. + case oprt of { + FLD_OP: { + __dbg_fput (res, opnd) + __dbg_fput (res, [BINOP_T, oprt, __dbg_e_field]) + } + SSC_OP: { + __dbg_e_ecode (opnd, res) + __dbg_fput (res, [BINOP_T, oprt, __dbg_fproc ("[]", 2)]) + } + INVOKE_OP: { + every __dbg_e_ecode (!opnd, res) + __dbg_fput (res, [INVOKE_T, *opnd]) + } + PART_OP: { + __dbg_e_ecode (opnd, res) + __dbg_e_ecode (@comp, res) + __dbg_fput (res, [TEROP_T, oprt, __dbg_fproc ("[:]", 3)]) + } + default: __dbg_ge_message := __dbg_fimage (oprt) || ": weird operator." + } + } +end + +procedure __dbg_e_proc (op_d) +# 'op_d' must be an operator descriptor (list(3)). +# RETURNS the descriptor with the 3rd component filled in by a +# procedure/function. +static opt +initial { + opt := __dbg_ftable () + opt[NOTN_OP] := __dbg_fproc ("\\", 1) + opt[ISN_OP] := __dbg_fproc ("/", 1) + opt[SIZ_OP] := __dbg_fproc ("*", 1) + opt[BNG_OP] := __dbg_fproc ("!", 1) + opt[NEG_OP] := __dbg_fproc ("-", 1) + opt[ALT_OP] := __dbg_e_alt + opt[CNJ_OP] := __dbg_e_cnj + opt[NEQ_OP] := __dbg_fproc ("=", 2) + opt[NNE_OP] := __dbg_fproc ("~=", 2) + opt[NLE_OP] := __dbg_fproc ("<=", 2) + opt[NLT_OP] := __dbg_fproc ("<", 2) + opt[NGE_OP] := __dbg_fproc (">=", 2) + opt[NGT_OP] := __dbg_fproc (">", 2) + opt[LLT_OP] := __dbg_fproc ("<<", 2) + opt[LLE_OP] := __dbg_fproc ("<<=", 2) + opt[LEQ_OP] := __dbg_fproc ("==", 2) + opt[LNE_OP] := __dbg_fproc ("~==", 2) + opt[LGE_OP] := __dbg_fproc (">>=", 2) + opt[LGT_OP] := __dbg_fproc (">>", 2) + opt[EQ_OP] := __dbg_fproc ("===", 2) + opt[NE_OP] := __dbg_fproc ("~===", 2) + opt[ADD_OP] := __dbg_fproc ("+", 2) + opt[SUBTR_OP] := __dbg_fproc ("-", 2) + opt[UNION_OP] := __dbg_fproc ("++", 2) + opt[DIFF_OP] := __dbg_fproc ("--", 2) + opt[CAT_OP] := __dbg_fproc ("||", 2) + opt[LCAT_OP] := __dbg_fproc ("|||", 2) + opt[MUL_OP] := __dbg_fproc ("*", 2) + opt[DIV_OP] := __dbg_fproc ("/", 2) + opt[REM_OP] := __dbg_fproc ("%", 2) + opt[ISCT_OP] := __dbg_fproc ("**", 2) + opt[EXP_OP] := __dbg_fproc ("^", 2) + opt[SSC_OP] := __dbg_fproc ("[]", 2) + opt[PART_OP] := __dbg_fproc ("[:]", 2) + opt[FLD_OP] := __dbg_e_field + } + op_d[3] := opt[op_d[2]] + return op_d +end + +#-------------- Evaluation ---------------------- + +procedure __dbg_e_eval (expr) +# Evaluates a compiled expression. +# 'expr' must be an expression using the representation created by +# '__dbg_e_compile' (list). +# GENERATES all expression values. +# SIDE EFFECT: Assigns a message (string) to '__dbg_ge_message' on conflict; +# assigns &null otherwise. +local val + __dbg_ge_message := &null + &error := -1 + every val := __dbg_e_eval1 (expr, []) do { + &error := 0 + suspend val + __dbg_ge_message := &null + &error := -1 + } + if &error < -1 then + __dbg_ge_message := "Error number " || &errornumber || ": " || + &errortext || "." || + (("\nOffending value: " || __dbg_fimage (\&errorvalue) || ".") | "") + &error := 0 +end + +procedure __dbg_e_alt (opnd1, opnd2) +# Our version of alternation. + suspend (opnd1 | opnd2) +end + +procedure __dbg_e_cnj (opnd1, opnd2) +# Our version of conjunction. + suspend (opnd1 & opnd2) +end + +procedure __dbg_e_field (opnd1, opnd2) +# Record field access. +# Any better way to determine if a value is a record of any type? +static builtin +initial { + builtin := __dbg_ftable () + builtin["co-expression"] := 1 + builtin["cset"] := 1 + builtin["file"] := 1 + builtin["integer"] := 1 + builtin["list"] := 1 + builtin["null"] := 1 + builtin["procedure"] := 1 + builtin["real"] := 1 + builtin["set"] := 1 + builtin["string"] := 1 + builtin["table"] := 1 + } + if \builtin[__dbg_ftype (opnd1)] then { + __dbg_ge_message := "Record expected; found " || __dbg_fimage (opnd1) + fail + } + suspend opnd1[opnd2] +end + +procedure __dbg_e_ident (idf) +# Evaluates an identifier. +local val + (val := ((__dbg_ge_singular ~=== __dbg_g_local[idf]) | variable (idf))) | { + __dbg_ge_message := "Identifier '" || idf || "' not visible." + fail + } + suspend val +end + +procedure __dbg_e_special (sp_code) +# Evaluates a special identifier. + suspend case sp_code of { + # Regular Icon keyword variables. + CLOCK_SP: &clock + CURRENT_SP: ¤t + DATE_SP: &date + DATELINE_SP: &dateline + POS_SP: &pos + REGIONS_SP: ®ions + SOURCE_SP: &source + STORAGE_SP: &storage + SUBJECT_SP: &subject + VERSION_SP: &version + # Special keywords. + BREAK_SP: (\__dbg_g_where[WHERE_BRKP])[BRKP_ID] + FILE_SP: __dbg_g_where[WHERE_FILE] + LEVEL_SP: __dbg_g_level + LINE_SP: __dbg_g_where[WHERE_LINE] + PROC_SP: __dbg_g_where[WHERE_PROC] + TRACE_SP: __dbg_g_trace + default: { + __dbg_ge_message := __dbg_fimage (sp_code) || + ": weird special identifier code." + fail + } + } +end + +procedure __dbg_e_eval1 (expr, stack) +# Evaluates an expression. +# 'stack' must be the current evaluation stack (list). +# The procedure is recursive; the initial invocation must supply an +# empty list. +local comp + (comp := expr[1]) | while suspend __dbg_fpop (stack) | fail + suspend __dbg_e_eval1 (expr[2:0], case comp[1] of { + IDENT_T: stack ||| [__dbg_e_ident (comp[2])] + SPECIAL_T: stack ||| [__dbg_e_special (comp[2])] + LIST_T: stack[1:-comp[2]] ||| [stack[-comp[2]:0]] + UNOP_T: stack[1:-1] ||| [comp[3](stack[-1])] + BINOP_T: stack[1:-2] ||| [comp[3]!stack[-2:0]] + TEROP_T: stack[1:-3] ||| [comp[3]!stack[-3:0]] + INVOKE_T: stack[1:-(comp[2]+1)] ||| + [stack[-(comp[2]+1)]!stack[-comp[2]:0]] + default: stack ||| [comp[2]] + }) +end diff --git a/ipl/packs/itweak/demo.cmd b/ipl/packs/itweak/demo.cmd new file mode 100644 index 0000000..bacd405 --- /dev/null +++ b/ipl/packs/itweak/demo.cmd @@ -0,0 +1,131 @@ +# Annotated debugging commands for the demo debugging session. +# $Id: demo.cmd,v 2.21 1996/10/04 03:45:37 hs Rel $ +# +# After seeing the 'automatic' debugging session you may want to repeat +# some of the commands manually in a new interactive session. + +# +# The following commands use a liberal amount of 'fprint' to make the output +# more readable. +# The first few commands are spelled out fully. Then we start using +# abbreviations. +# + +# When you get the first prompt you are somewhere in anonymous initialization +# code. Enter 'next' to step into a real source file. This is not necessary, +# but may allow you to omit the file name in 'breakpoint' commands. +next + +# What source files do we have? +info files + +# Let's find out what globals the program contains... +fprint "--- Globals:\n" +info global + +# ...and the locals of the current procedure: +fprint "--- Locals in %1:\n"; &proc +info locals + +# Set a breakpoint in the main loop. +break 88 +goon + +# Got the first break. +print word +goon + +# Next break. +pr word + +# Boring to 'print word' every time. Add this command to the +# breakpoint. Note that when a breakpoint has commands the usual +# prelude is not printed when a breakpoint is reached. Thus add some +# extra printing. Note that 'fprint' does not automatically output a +# newline. +do . +fprint "--- Break in %1 line %2: "; &proc; &line +print word +end + +go +go +go + +# Attach a condition to the breakpoint. This time we use the explicit +# breakpoint id (1). +cond 1 word == "buffer" +go + +# Let's examine a compound variable. +fprint "--- Examining 'resword'.\n" +pr resword +# It's a list. Try 'eprint' to see all elements. +eprint !resword +# 'eprint' prints 'every' value generated by an expression. + +# Try another one. +pr prec +# A list again. Prints its elements, +epr !prec +# Only one element which is a record. +pr prec[1].pname +epr !prec[1] + +# We may even invoke one of the target program's procedures. +# Here we invoke 'addword' to add a bogus entry in the cross reference. +# We use global 'linenum' to provide the line number. +pr addword("ZORRO", "nowhere", linenum) + +# Examine globals again. +fprint "--- Globals one more time:\n" +inf gl +fprint "--- WHAT??!!! The program has modified 'proc' -- bad manners!\n" +# It's good to have a robust debugger. Let's examine the new value. +pr proc; type(proc) + +# Examine the current breakpoint. +fprint "--- The current breakpoint:\n" +info br . + +# Let's set a breakpoint i procedure 'addword'... +br 150 +# ...and delete the first breakpoint. +clear br 1 +go + +# This is the way to find out where we are (the procedure call chain): +where +# It is possible to examine any of the frames in the call chain. +frame 1 + +# Let the program work along for a while. +# Ignore the 280 next breaks. +fprint "--- Ignoring the next 280 breaks...\n" +ign . 280 +go +# Find out about the word "word": +pr var["word"] +# It's a table. Examine its keys and entries. +epr key(var["word"]) +epr !var["word"] +# The entries are lists. Let's look at the "addword" entry. +epr !var["word"]["addword"] +# That's a lot of typing. Let's try a macro. +mac var +eprint !var["word"]["addword"] +fprint "That was %1 items.\n"; *var["word"]["addword"] +end + +# Try the macro (which has now become a new command): +var + +# Now we've tried the most common commands. +# Let the program run to completion undisturbed. The following is an +# abbreviation of 'goon nobreak'. +fpr "--- Now let the program produce its normal output...\n\n" +go no + +# We will se the normal output of the program: a cross reference listing +# (in this case applied to its own source code). +# Note the bogus 'ZORRO' variable we entered by calling 'addword'. diff --git a/ipl/packs/itweak/ipxref.icn b/ipl/packs/itweak/ipxref.icn new file mode 100644 index 0000000..22cceaa --- /dev/null +++ b/ipl/packs/itweak/ipxref.icn @@ -0,0 +1,234 @@ +############################################################################ +# +# File: ipxref.icn +# +# Subject: Program to cross reference Icon program +# +# Author: Allan J. Anderson +# +# Date: June 10, 1988 +# +############################################################################ +# +# This program cross-references Icon programs. It lists the +# occurrences of each variable by line number. Variables are listed +# by procedure or separately as globals. The options specify the +# formatting of the output and whether or not to cross-reference +# quoted strings and non-alphanumerics. Variables that are followed +# by a left parenthesis are listed with an asterisk following the +# name. If a file is not specified, then standard input is cross- +# referenced. +# +# Options: The following options change the format defaults: +# +# -c n The column width per line number. The default is 4 +# columns wide. +# +# -l n The starting column (i.e. left margin) of the line +# numbers. The default is column 40. +# +# -w n The column width of the whole output line. The default +# is 80 columns wide. +# +# Normally only alphanumerics are cross-referenced. These +# options expand what is considered: +# +# -q Include quoted strings. +# +# -x Include all non-alphanumerics. +# +# Note: This program assumes the subject file is a valid Icon pro- +# gram. For example, quotes are expected to be matched. +# +############################################################################ +# +# Bugs: +# +# In some situations, the output is not properly formatted. +# +############################################################################ +# +# Links: options +# +############################################################################ + +link options + +global resword, linenum, letters, alphas, var, buffer, qflag, infile, xflag +global inmaxcol, inlmarg, inchunk, localvar, lin + +record procrec(pname,begline,lastline) + +procedure main(args) + + local word, w2, p, prec, i, L, ln, switches, nfile + + resword := ["break","by","case","default","do","dynamic","else","end", + "every","fail","global","if","initial","link", "local","next","not", + "of","procedure", "record","repeat","return","static","suspend","then", + "to","until","while"] + linenum := 0 + var := table() # var[variable[proc]] is list of line numbers + prec := [] # list of procedure records + localvar := [] # list of local variables of current routine + buffer := [] # a put-back buffer for getword + proc := "global" + letters := &letters ++ '_' + alphas := letters ++ &digits + + switches := options(args,"qxw+l+c+") + + if \switches["q"] then qflag := 1 + if \switches["x"] then xflag := 1 + inmaxcol := \switches["w"] + inlmarg := \switches["l"] + inchunk := \switches["c"] + infile := open(args[1],"r") # could use some checking + + while word := getword() do + if word == "link" then { + buffer := [] + lin := "" + next + } + else if word == "procedure" then { + put(prec,procrec("",linenum,0)) + proc := getword() | break + p := pull(prec) + p.pname := proc + put(prec,p) + } + else if word == ("global" | "link" | "record") then { + word := getword() | break + addword(word,"global",linenum) + while (w2 := getword()) == "," do { + if word == !resword then break + word := getword() | break + addword(word,"global",linenum) + } + put(buffer,w2) + } + else if word == ("local" | "dynamic" | "static") then { + word := getword() | break + put(localvar,word) + addword(word,proc,linenum) + while (w2 := getword()) == "," do { + if word == !resword then break + word := getword() | break + put(localvar,word) + addword(word,proc,linenum) + } + put(buffer,w2) + } + else if word == "end" then { + proc := "global" + localvar := [] + p := pull(prec) + p.lastline := linenum + put(prec,p) + } + else if word == !resword then + next + else { + ln := linenum + if (w2 := getword()) == "(" then + word ||:= " *" # special mark for procedures + else + put(buffer,w2) # put back w2 + addword(word,proc,ln) + } + every write(!format(var)) + write("\n\nprocedures:\tlines:\n") + L := [] + every p := !prec do + put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline) + every write(!sort(L)) +end + +procedure addword(word,proc,lineno) + if any(letters,word) | \xflag then { + /var[word] := table() + if /var[word]["global"] | (word == !\localvar) then { + /(var[word])[proc] := [word,proc] + put((var[word])[proc],lineno) + } + else { + /var[word]["global"] := [word,"global"] + put((var[word])["global"],lineno) + } + } +end + +procedure getword() + local j, c + static i, nonwhite + initial nonwhite := ~' \t\n' + + repeat { + if *buffer > 0 then return get(buffer) + if /lin | i = *lin + 1 then + if lin := read(infile) then { + i := 1 + linenum +:= 1 + } + else fail + if i := upto(nonwhite,lin,i) then { # skip white space + j := i + if lin[i] == ("'" | "\"") then { # don't xref quoted words + if /qflag then { + c := lin[i] + i +:= 1 + repeat + if i := upto(c ++ '\\',lin,i) + 1 then + if lin[i - 1] == c then break + else i +:= 1 + else { + i := 1 + linenum +:= 1 + lin := read(infile) | fail + } + } + else i +:= 1 + } + else if lin[i] == "#" then { # don't xref comments; get next line + i := *lin + 1 + } + else if i := many(alphas,lin,i) then + return lin[j:i] + else { + i +:= 1 + return lin[i - 1] + } + } + else + i := *lin + 1 + } # repeat +end + +procedure format(T) + local V, block, n, L, lin, maxcol, lmargin, chunk, col + initial { + maxcol := \inmaxcol | 80 + lmargin := \inlmarg | 40 + chunk := \inchunk | 4 + } + L := [] + col := lmargin + every V := !T do + every block := !V do { + lin := left(block[1],16," ") || left(block[2],lmargin - 16," ") + every lin ||:= center(block[3 to *block],chunk," ") do { + col +:= chunk + if col >= maxcol - chunk then { + lin ||:= "\n\t\t\t\t\t" + col := lmargin + } + } + if col = lmargin then lin := lin[1:-6] # came out exactly even + put(L,lin) + col := lmargin + } + L := sort(L) + push(L,"variable\tprocedure\t\tline numbers\n") + return L +end diff --git a/ipl/packs/itweak/itweak.htm b/ipl/packs/itweak/itweak.htm new file mode 100644 index 0000000..6f465ff --- /dev/null +++ b/ipl/packs/itweak/itweak.htm @@ -0,0 +1,725 @@ +<HTML> +<HEAD> +<TITLE>Itweak: Interactive Icon Debugging</TITLE> +<!-- $Id: itweak.html,v 2.21 1996/10/04 03:45:37 hs Rel $ --> +</HEAD> +<BODY BGCOLOR=#FFFFDF> + +<CENTER> +<H1><EM>itweak</EM><BR>An Interactive Debugging Utility for the<BR>Icon Programming Language</H1> +<P>Release 2.21 +<P>Håkan Söderström (<tt>hs@soderstrom.se</tt>) +<P>Söderström Programvaruverkstad AB<BR>Bandhagsvägen 51<BR>S-122 42 Enskede, Sweden +</CENTER> + +<H2>Contents</H2> + +<OL> +<LI><A HREF="#intro">Introduction, Acknowledgements and Non-Warranty</A> +<LI><A HREF="#prereq">Prerequisites</A> +<LI><A HREF="#install">Installing <EM>itweak</EM></A> + <UL> + <LI><A HREF="#unix">Unix</A> + <LI><A HREF="#other-platforms">Other Platforms, or Platforms Without Make</A> + </UL> +<LI><A HREF="#samples">Debugging Samples</A> + <UL> + <LI><A HREF="#canned-session">Canned Debugging Session</A> + <LI><A HREF="#sample-commands">Sample Debugging Commands</A> + </UL> +<LI><A HREF="#preparing-debug">Preparing for a Debugging Session</A> + <UL> + <LI><A HREF="#tweak-link">Tweaking and Linking an Icon Program</A> + <LI><A HREF="#re-tweaking">Note on Re-Tweaking Files</A> + <LI><A HREF="#quirks-limit"><EM>itweak</EM> Quirks and Limitations</A> + </UL> +<LI><A HREF="#debug-session">The Debugging Session</A> + <UL> + <LI><A HREF="#start-session">Starting a Debugging Session</A> + <LI><A HREF="#env-variables">Run-Time Environment Variables</A> + <LI><A HREF="#debug-commands">Debugging Commands: Overview</A> + <UL> + <LI><A HREF="#keyw-abbrev">Keyword Abbreviations</A> + <LI><A HREF="#breakpoints"> + <LI><A HREF="#expressions">Expressions</A> + <LI><A HREF="#printing-cmd">Commands for Printing</A> + </UL> + <LI><A HREF="#run-quirks-limit">Run-Time Quirks, Limitations</A> + </UL> +<LI><A HREF="#performance">Performance Considerations</A> +<LI><A HREF="#impl-notes">Implementation Notes (The Hidden Art of Tweaking)</A> +</OL> + +<BLOCKQUOTE>Copyright © 1994-1996 Hakan Soderstrom and Soderstrom Programvaruverkstad AB, Sweden. Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice and this permission notice appear in all copies of the software and related documentation. +</BLOCKQUOTE> + +<H2><A NAME="intro">1. Introduction, Acknowledgements and Non-Warranty</A></H2> + +<P><EM>itweak</EM> is an Icon interactive debugging utility. The idea is that +you compile your Icon program to ucode files (<tt>.u1</tt>, <tt>.u2</tt>). +<EM>itweak</EM> then tweaks the ucode, inserting potential breakpoints. +The resulting ucode files are linked with a debugging run-time and off +you go. + +<P>The <EM>itweak</EM> system provides you with many of the facilities +you would +expect from an interactive debugger, including the ability to evaluate +a wide range of Icon expressions. +Personally I wouldn't like to be without this tool, but I may be biased. +It can be used both for finding bugs and to convince oneself that an +Icon program indeed works the intended way. + +<P><EM>itweak</EM> owes a lot to the pioneering <em>debugify</em> system +by Charles A. Shartsis. +This heritage is gratefully acknowledged. What <EM>itweak</EM> +offers over <em>debugify</em> is radically improved performance (in time as +well as space) and a more fully-fledged run-time system. + +<P>The author believes the software is useful but wouldn't imagine it is +free from bugs. +The software is provided "as-is" and without warranty of any kind. +Please send bug reports, change requests, and other comments to the +address above. + +<H2><A NAME="prereq">2. Prerequisites</A></H2> + +<P><EM>itweak</EM> has been tested with Icon 8.10 and 9.0 under Unix +(SunOS 4.1.4) and DOS. +The software is completely written in Icon, and should be as portable +as Icon itself. + +<H2><A NAME="install">3. Installing <EM>itweak</EM></A></H2> + +<P>Installation is straightforward. +For Unix there is a makefile that does most of the job. + +<H3><A NAME="unix">Unix</A></H3> + +<P>Under Unix, type <tt>make</tt> in the installation directory. +The following files are generated. +<DL> +<DT>itweak<DD>an Icon 'executable'. +Copy it to a commonly accessible directory and include it in your +PATH. +<DT>dbg_run.u1, dbg_run.u2 +<DD>These files constitute the <em>debugging run-time</em> system which will +be linked with your tweaked programs. +Make the debugging run-time available to the Icon linker by including +its directory in the IPATH environment variable. +Or, alternatively, make sure that the <tt>dbg_run.u</tt> files are +present in the same directory as the program you are going to debug. +</DL> + +<H3><A NAME="other-platforms">Other Platforms, or Platforms Without Make</A></H3> + +<P><EM>itweak</EM> comes with two Icon source files, <tt>itweak.icn</tt> and <tt>dbg_run.icn</tt>. +Run the following command to produce the <EM>itweak</EM> program, +<P><CODE> + icont itweak.icn +</CODE> +<P>Put <EM>itweak</EM> (the resulting file) in a commonly accessible directory and +include it in your PATH. +(If you can, you should of course use the Icon compiler to produce <EM>itweak</EM>.) +Now run the following command, +<P><CODE> + icont -c dbg_run.icn +</CODE> +<P>The resulting files (<tt>dbg_run.u1, dbg_run.u2</tt>) constitute the +<em>debugging run-time</em> system which will be linked with your +tweaked programs. + +<P>Make the debugging run-time available to the Icon linker by including +its directory in the IPATH environment variable. +Or, alternatively, make sure that the <tt>dbg_run.u</tt> files are +present in the same directory as the program you are going to debug. + +<H2><A NAME="samples">4. Debugging Samples</A></H2> + +<P>There are at least two ways you may examine <EM>itweak</EM> without +committing yourself too heavily to it. + +<H3><A NAME="canned-session">Canned Debugging Session</A></H3> + +<P>The <EM>itweak</EM> distribution comes with a demo. +Under Unix, type <tt>make demo</tt> to make it happen. + +<P>On other platforms, or on platforms without <EM>make:</EM> do the following commands. +<P><CODE> + icont -c ipxref.icn<BR> + icont -c options.icn<BR> + itweak -o samp_ini.icn ipxref options<BR> + icont -c samp_ini.icn<BR> + icont -o sample ipxref.u1 options.u1<BR> + setenv DBG_INPUT demo.cmd<BR> + sample ipxref.icn<BR> +</CODE> +<P>The commands compile and tweak a sample program. +The source files are <tt>ipxref.icn</tt> and <tt>options.icn</tt>. +The resulting 'executable' is called <tt>sample</tt>. +The last command runs a canned debugging session. + +<P>Debugging commands for the demo are taken from the file <tt>demo.cmd</tt>. +To make the demo more meaningful you should open an editor on +<tt>demo.cmd</tt> and compare it to the output of the debugging session. +The commands are annotated. + +<H3><A NAME="sample-commands">Sample Debugging Commands</A></H3> + +<P>Read this to get a first impression of what kinds of debugging commands +<EM>itweak</EM> offer. +For reading convenience all commands are spelled out fully. +(Commands may be abbreviated as long as the abbreviation is unambiguous.) + +<P>Set a breakpoint on a source code line and then let the program run to +its first break. +<P><CODE> + break 88 + goon +</CODE> +<P>In the following examples we omit the <tt>goon</tt> command which makes +the program continue until the next break (or until it exits). + +<P>Print the current value of a simple variable (<tt>word</tt>). +<P><CODE> + print word +</CODE> +<P>Attach a macro which automatically prints <tt>word</tt> every time we hit +this breakpoint. +<P><CODE> + do .<BR> + print word<BR> + end<BR> +</CODE> +<P>Attach a condition to the breakpoint which causes a break only if +<tt>word</tt> contains the string <tt>buffer</tt>. +<P><CODE> + cond . word == "buffer" +</CODE> +<P>The dot means <em>the current breakpoint</tt>. + +<P>Now some more advanced printing: +Print every value generated by an expression. +This is useful if the variable contains a list, for example. +<P><CODE> + eprint !resword +</CODE> +<P>You may use subscripting and record field references when printing an +expression: +<P><CODE> + print prec[1].pname +</CODE> +<P>The printing commands actually accept almost all Icon expressions. +You may invoke procedures or Icon functions, for instance. + +<P>You may use the <tt>info</tt> command to get information about a + breakpoint, source files, local or global variables, among other things: +<P><CODE> + info break .<BR> + info files<BR> + info local<BR> + info global<BR> +</CODE> +<P>These are not all commands. +Please refer to the special section on +<A HREF="#debug-commands">debugging commands</A>. +The <EM>itweak</EM> on-line help contains details about all available commands. + +<H2><A NAME="preparing-debug">5. Preparing for a Debugging Session</A></H2> + +<P>In order to debug an Icon program you will need to go through +the following major steps. +These steps assume you have installed <EM>itweak</EM> as described above. +<OL> +<LI>Compile the Icon source files (usually <tt>icont -c</tt>). +<LI>Tweak some or all of the program's ucode files. +<LI>Compile the Icon source file generated by <EM>itweak</EM>. +<LI>Link the tweaked files. +<LI>Run an interactive debugging session. +</OL> + +<P>The demo described in the previous section provides an example. +The next few sections go more into detail. + +<H3><A NAME="tweak-link">Tweaking and Linking an Icon Program</A></H3> + +<P>Let us assume you have a program built from source files named +<tt>alpha.icn</tt>, <tt>beta.icn</tt>, and <tt>gamma.icn</tt>. +Compile all source files, but do not link them yet. +A suitable command is +<P><CODE> + icont -c alpha.icn beta.icn gamma.icn +</CODE> +<P>This will produce <tt>.u1</tt> and <tt>.u2</tt> (i.e. ucode) files for +each of the source files. + +<P>It is not necessary to tweak all files. However, you will be able to set +breakpoints only in tweaked files. In order to illuminate this point, let +us assume you decide to tweak only files <tt>alpha</tt> and <tt>gamma</tt>. +Do this the following way. +Note that the <EM>itweak</EM> command takes base file names, omitting the file +name extension (<tt>.u1</tt>, for example). +<P><CODE> + itweak alpha gamma +</CODE> +<P>The above command will tweak <tt>alpha.u1</tt> and <tt>gamma.u1</tt> and one of +the <tt>.u2</tt> files. +It is important to tweak the files in a single <EM>itweak</EM> command. +For reasons described in the <A HREF="#quirks-limit">quirks</A> section +the general recommendation is that you include the file containing the +<B>main</B> procedure in the set of tweaked files. + +<P>Whenever a ucode file is tweaked the original file is saved under a +different name. +A <tt>.u1</tt> file will have its extension changed to <tt>.u1~</tt>. +A tweaked <tt>.u2</tt> file will have its extension changed to <tt>.u2~</tt>. + +<P>Later, when running the program, reference will only be made to source +files, not to ucode files. + +<P>The <EM>itweak</EM> command produces an additional Icon file. +Its default name is <tt>dbg_init.icn</tt>. +You may change the name of this file by using the <tt>-o</tt> command line option. +For instance, the following is a possible command, +<P><CODE> + itweak -o proginit.icn alpha gamma +</CODE> +<P>This command will generate a file named <tt>proginit.icn</tt>, but +otherwise perform the same function as the <EM>itweak</EM> command above. +You must compile the generated Icon file. +The following command does this (now assuming the default name has been used). +<P><CODE> + icont -c dbg_init.icn +</CODE> +<P>Finally link the program as you would normally do it. +Like this, for instance, +<P><CODE> + icont alpha.u beta.u gamma.u +</CODE> +<P>The <EM>itweak</EM> command tweaks one of the <tt>.u2</tt> files involved. +It inserts the equivalent of <B>link</B> statements. +This will, in effect, add <tt>dbg_init.icn</tt> and <tt>dbg_run.u</tt> to +the link list. +The <tt>dbg_init.u</tt> files will usually be present in the current +directory. +Of course the <tt>dbg_run.u</tt> files may also reside in the current +directory. +However, it is often more useful to have the run-time files in a +separate directory which is included in the IPATH environment +variable. + +If the linkage is successful, the result is an executable program +<tt>alpha</tt> (under Unix). + +<H3><A NAME="re-tweaking">Note on Re-Tweaking Files</A></H3> + +<P>Usually you would develop a program in an edit-compile-debug cycle. +<EM>itweak</EM> notices if a file is already tweaked and does not tweak it a +second time. Thus you may run the same <EM>itweak</EM> command after you have +modified and compiled just one of the source files. This means the +<EM>itweak</EM> command is suited for inclusion in a Makefile. + +<H3><A NAME="quirks-limit"><EM>itweak</EM> Quirks and Limitations</A></H3> + +<P><EM>itweak</EM> and the debugging run-time introduce numerous +global names for its own use. +A common prefix is used on all such names to minimize the risk of name +clashes with your program. +The prefix is '<tt>__dbg_</tt>' (beginning with a double underscore). +It is, of course, possible for the target program to interfere with +the debugging run-time, possibly causing it to crash. + +<P><EM>itweak</EM> detects the <B>main</B> Icon procedure of your program. +It inserts code for executing a parameterless procedure named +<tt>__dbg_init</tt> before anything else. +This procedure initializes the run-time environment. +(The procedure is generated by <EM>itweak</EM> as part of the <tt>dbg_init.icn</tt> file.) + +<P>If you omit the file containing <B>main</B> from the set of tweaked +files you must modify your program to invoke <tt>__dbg_init</tt> before +execution reaches a tweaked file. +Otherwise the program will terminate with a run-time error. + +<P>This is one reason why tweaked ucode files are not suited for shared +libraries. +Tweaking a file in a way marks it for a particular program. +You (or somebody else) may attempt to tweak the same file in order to +use it in a different program, but <EM>itweak</EM> will not touch it, +because it has been tweaked already. +There will probably be a conflict at linkage time, however: <em>__dbg_init: +inconsistent redeclaration</em>. +What you have to do in this case is erase the ucode files and +recompile and tweak from scratch. + +<P>For each tweaked file <EM>itweak</EM> creates a global variable +holding a set of active breakpoints. +The name of this variable contains the base name of the file. +This limits file names to the syntax accepted as Icon identifiers. + +<H2><A NAME="debug-session">6. The Debugging Session</A></H2> + +<P>This section describes what a debugging session looks like. + +<H3><A NAME="start-session">Starting a Debugging Session</A></H3> + +<P>After having tweaked and linked your program according to the +description above you should be able to start it as usual. +It will behave slightly different, however. +After starting up a '<tt>$</tt>' prompt will appear (on standard error). +The prompt means you are expected to enter a debugging command (on +standard input). + +<P>Detailed command descriptions are available on-line through the +<tt>help</tt> command. +Type <tt>help</tt> to see a list of available commands. +Type <tt>help <i>command</i></tt> to get a description of a particular +command. + +<H3><A NAME="env-variables">Run-Time Environment Variables</A></H3> + +<P>Environment variables may be used to re-direct debugging +input and output. + +<DL> +<DT>DBG_INPUT<DD>if set to a file name will cause debugging commands +to be read from the file. +If end-of-file is encountered remaining commands will be taken from +standard input. + +<DT>DBG_OUTPUT<DD>if set to a file name will cause debugging output to +be written to the file. +</DL> + +<H3><A NAME="debug-commands">Debugging Commands: Overview</A></H3> + +<P>The debugging commands will enable you to control and monitor the +execution of your program. +This section contains general information and some examples. +Detailed descriptions are available on-line through the <tt>help</tt> command. + +<H4><A NAME="keyw-abbrev">Keyword Abbreviations</A></H4> + +<P>All debugging command keywords may be abbreviated as long as the +abbreviation is unambiguous. +For instance, <tt>goon nobreak</tt> may usually be written <tt>g no</tt>. + +<P>The reason we say <em>usually</em> is that you may define new commands +by means of the <tt>macro</tt> command. +Macro names are subject to the same abbreviation rules as built-in +commands. + +<H4><A NAME="breakpoints">Breakpoints</A></H4> + +<H5><A NAME="setting-clearing-brk">Setting and Clearing a Breakpoint</A></H5> + +<P>The <tt>break</tt> command defines a breakpoint on a source line or on a +number of consecutive source lines. +The break will take effect <B>after</B> the expression on the source +line has been evaluated. +(This is a difference from most other debuggers where breaks occur +before the source line is executed.) + +<P>In some cases the break occurs in a slightly different place from +where you would expect it. +This is the reason the <tt>break</tt> command optionally covers more +than one source line. +By setting breakpoints on a few lines around the interesting spot you +may make sure that there really is a break. + +<P>A source line cannot have more than one breakpoint. +Each <tt>break</tt> command silently supersedes any previous breakpoints +it happens to overlap. + +The <tt>clear breakpoint</tt> removes a breakpoint. + +<H5><A NAME="identifying-brk">Identifying Breakpoints</A></H5> + +<P>A breakpoint is identified by a small integer, the <em>breakpoint +number</em>. +The <tt>break</tt> command prints the breakpoint number of the +breakpoint it creates. +The breakpoint number can be used in other debugging commands. + +<P>You may identify a breakpoint by its literal breakpoint number, or by +the special symbols '<tt>.</tt>' (dot) and '<tt>$</tt>' (dollar). +Dot means the <em>current</em> breakpoint, i.e. the breakpoint that +caused the current break. +Dollar means the <em>last</em> breakpoint defined by a <tt>break</tt> +command. + +<P>Use the <tt>info breakpoint</tt> command to see the definition of a +breakpoint (or all breakpoints). + +<H5><A NAME="tailoring-brk">Tailoring a Breakpoint</A></H5> + +<P>A plain breakpoint as created by <tt>break</tt> is unconditional. +There are several ways you may modify its behavior to suit your needs. + +<UL> +<LI>The <tt>ignore</tt> command sets an <em>ignore counter</em> on a +breakpoint. +A breakpoint having a non-zero ignore counter does not cause a break +when execution runs into it. +Instead of causing a break the ignore counter is decremented by one. +Setting an ignore counter to a negative value effectively disables +the breakpoint. + +<LI>The <tt>condition</tt> command defines a condition for a +breakpoint. +The condition will be evaluated each time execution reaches the +breakpoint. +If the condition fails the breakpoint does not cause a break. + +<LI>The <tt>do</tt> command attaches an anonymous macro (one or more +debugging commands) to a breakpoint. +The macro is executed whenever the breakpoint causes a break. +</UL> + +<P>When a plain break occurs a special macro called the <em>prelude</em> is +executed. +The standard prelude prints the breakpoint number and the location of +the breakpoint. +In a similar way a special macro called the <em>postlude</em> is +executed just before execution is resumed after a break. +The standard postlude is empty. + +<P>The prelude and postlude are ordinary macros which you may redefine by +means of the <tt>set</tt> command. + +<P>Note that the prelude is not executed if a break is caused by a +breakpoint with a <tt>do</tt> macro. + +<H5><A NAME="brk-0">Breakpoint 0 (Zero)</A></H5> + +<P>Breakpoint zero is special. +The <tt>next</tt> debugging command causes a break to occur after the +next source line has been executed (or after a specified number of +lines). +A break caused by a <tt>next</tt> command is treated as if defined by +breakpoint number zero. +(This is the case even if there is an ordinary breakpoint on the same +source line.) +Breakpoint number zero may be assigned a condition, a <tt>do</tt> macro, +or an ignore count, just like other breakpoints. +It may not be cleared, however. + +<H4><A NAME="expressions">Expressions</A></H4> + +<P>Expressions may be included in the various print commands and in +breakpoint conditions. +Expressions may be formed from +<UL> +<LI>a large subset of Icon operators, including subscripting and +record field references, +<LI>integer, string, list literals, +<LI>locals from the current procedure, +<LI>globals, +<LI>procedure and function invocations, +<LI>a subset of the Icon keywords. +</UL> + +<P>A few keywords have been added or altered: +<DL> +<DT>&bp, &breakpoint<DD>The breakpoint number of the current +breakpoint (integer). + +<DT>&file<DD>The source file name of the current breakpoint (string). + +<DT>&line<DD>The source line number of the current breakpoint (integer). + +<DT>&proc<DD>The name of the procedure where the current breakpoint +occurred (string). +</DL> + +<P>Expression evaluation is guarded by error conversion. +An Icon error during evaluation should cause a conflict message, but +not terminate the program. + +<H4><A NAME="printing-cmd">Commands for Printing</A></H4> + +<P>There are several debugging commands for evaluating and printing +expressions. + +<P>The <tt>print</tt> command takes any number of expressions separated by +semicolon. +The command evaluates and prints the image of the first value returned +by each expression. +This is a common way to inspect variables, for instance. + +<P>The <tt>eprint</tt> command (<em>e</em> as in <B>every</B>) takes a single +expression and prints the image of every value it generates. +The following example shows a simple way of printing the contents of a +list, +<P><CODE> + eprint !mylist +</CODE> +<P>The <tt>fprint</tt> command (<em>f</em> as in <em>format</em>) +expects a format string followed by any number of expressions. +The format string can be any expression returning a string-convertible +value. +The expressions must be separated by semicolon. +The format string may contain placeholders. +The remaining expressions are expected to return values to insert into +the format string, replacing the placeholders. +In this case the actual value is used, not the image. +A conflict is generated if any of the values is not +string-convertible, so you may have to use the <B>image</B> function, +or some other explicit conversion. + +<P>The <tt>fprint</tt> command is useful when you care about the appearance +of the output. + +<P>The <tt>fprint</tt> command does not print a newline unless it is +explicitly included in the output. +Usually it can be inserted at the end of the format string. + +<P>A format string placeholder is basically a percent (<tt>%</tt>) character +followed by a digit 1-9. +Thus there can be up to nine different placeholders. +A particular placeholder ('<tt>%1</tt>' for example) may occur any +number of times. +Each occurrence of '<tt>%1</tt>' will be replaced by the value of the +first expression after the format string. +Each occurrence of '<tt>%2</tt>' will be replaced by the value of the +second expression after the format string, and so on. + +<P>A plain placeholder represents a variable-length field. +It is possible to specify a fixed-length field. +Add '<tt><</tt>' for a left-justified, or '<tt>></tt>' for a +right-justified field. +Also add the length of the field. +For instance, '<tt>%1<20</tt>' defines a left-justified field with a fixed +length of 20 characters. + +<P>To print a percent character, double the character in the format +string (<tt>%%</tt>). +Backslash (<tt>\</tt>) can also be used to quote other characters. + +<P>A placeholder for which there is no value is silently replaced by its +placeholder number. + +<H3><A NAME="run-quirks-limit">Run-Time Quirks, Limitations</A></H3> + +<P>The <EM>itweak</EM> algorithm for deciding source line limits is +rather simple-minded. +This is the reason breaks do not always occur exactly where you +expect. + +<P>The implementation of the alternation (<tt>|</tt>) control structure is +naive; works only in simple cases. +(See <cite>The Icon Analyst,</cite> Number 23, April 1994.) + +<P>It is currently not possible to list macro definitions (including +<tt>do</tt> macros). + +<P>A few commands use the <em>display file</em>: <tt>frame, info globals, +where</tt>. +The display file is simply the output from the <B>display</B> Icon +function. +Writing the display file requires write permission in the current +directory. + +<P>It should be possible to negate a breakpoint condition, but this is +not implemented yet. + +<P>It is possible to invoke a target program procedure in an expression. +This can be useful for side effects. +The run-time is not fully re-entrant, however, so if there is a +breakpoint in the procedure the run-time may get confused when it +returns. +(No fatal error should occur.) + +<P>Escaping characters in <tt>fprint</tt> format strings do not always work. +Beware of the following format string. +It generates a long, long output. +<CODE>"foo/year=%1<20\1994\n"</CODE> + +<H2><A NAME="performance">7. Performance Considerations</A></H2> + +<P>My main dissatisfaction with the <em>debugify</em> package was +performance. +Thus a lot of effort has gone into finding ways to minimize the +debugging overhead. +The following performance measurements were made on a Sun SPARCstation +IPC under SunOS 4.1.3 with 24 Mb of memory. + +<P>A tweaked ucode file will be less than 2 times the size of the +untweaked file (<em>debugify:</em> 5 times). +A tweaked program without any breakpoints (<tt>goon nobreak</tt>) runs +approximately 4 times slower than an untweaked program +(<em>debugify:</em> 200 times; this easily becomes unbearable). +The <EM>itweak</EM> program itself runs at over 3 times the speed of +<em>debugify</em>. + +<P>The increased performance carries a certain cost: Only a single +potential breakpoint is created per source line. +No provision is made for setting variables. +The code is not executable unless certain global variables (created by +<EM>itweak</EM>) have been initialized. + +<P>Debugging commands are compiled to an internal representation as they +are entered. +This is especially important for expressions. +Expressions are parsed with simple string matching, backtracking and +all. +They are immediately unwound and converted to a postfix notation. +This means that breakpoint conditions and macros can be evaluated +efficiently. + +<H2><A NAME="impl-notes">8. Implementation Notes (The Hidden Art of Tweaking)</A></H2> + +<P>The Icon source code generated by <EM>itweak</EM> mainly creates and initializes +a number of global variables. +An Icon <B>set</B> is created for each tweaked source file. +The sets are used to hold breakpoint line numbers. + +<P><EM>itweak</EM> creates a potential breakpoint on every source line +it finds in the ucode file. +A potential breakpoint consists of code testing the current line +number against the set of breakpoint line numbers for the +current source file. + +<P>If the test says 'yes' then a jump is made to code added at the end of +the current procedure. +This code collects the values and names of all locals and calls the +debugging run-time. +The same code is used for all potential breakpoints in one procedure. +This means that besides potential breakpoints a chunk of code is added +at the end of every procedure. + +<P>A global variable named <tt>__dbg_test</tt> is used to test for +breakpoints. +It may be set to different Icon functions to achieve various effects. +The function will be called with two parameters: a set of breakpoint +line numbers and an integer line number. +The following values are currently used, + +<DL> +<DT>member<DD>This is the initial value. +The effect is to check if there is a breakpoint on the current line. + +<DT>integer<DD>Always fails (since a set cannot be converted to an +integer). +Used to implement the <tt>goon nobreak</tt> command. + +<DT>2<DD>(integer 2) +The effect is to cause the second parameter to be returned. +Hence always succeeds. +Used to implement the <tt>next</tt> command which causes a break on +every potential breakpoint. +</DL> + +<P>The debugging run-time is a procedure. +It must fail in order not to disturb the logic of the current +procedure. + +<P>It surprises me that it is possible to do this amount of tweaking to +an Icon program. +I have debugged fairly complex programs without noticing any +unexpected weirdness (like tweaked program logic). +However, <EM>itweak</EM> as a whole is a case of reverse engineering. +Someone with greater theoretical insight may be able to detect cracks +in the tweaking scheme. +Please tell me in such case. + +</BODY> +</HTML> diff --git a/ipl/packs/itweak/itweak.icn b/ipl/packs/itweak/itweak.icn new file mode 100644 index 0000000..47324ef --- /dev/null +++ b/ipl/packs/itweak/itweak.icn @@ -0,0 +1,830 @@ +############################################################################ +# +# File: itweak.icn +# +# Subject: Icon interactive debugging. +# Tweaks a ucode file ('.u1') to invoke a debugging procedure. +# +# Author: Hakan Soderstrom +# +# Revision: $Revision: 2.21 $ +# +########################################################################### +# +# Copyright (c) 1994 Hakan Soderstrom and +# Soderstrom Programvaruverkstad AB, Sweden +# +# Permission to use, copy, modify, distribute, and sell this software +# and its documentation for any purpose is hereby granted without fee, +# provided that the above copyright notice and this permission notice +# appear in all copies of the software and related documentation. +# +# THE SOFTWARE IS PROVIDED "AS-IS" AND WITHOUT WARRANTY OF ANY KIND, +# EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY +# WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. +# +# IN NO EVENT SHALL HAKAN SODERSTROM OR SODERSTROM PROGRAMVARUVERKSTAD +# AB BE LIABLE FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL +# DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +# OF USE, DATA OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY +# OF DAMAGE, AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN +# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +# +########################################################################### + +# +#-------- Record types -------- +# + +record l_decl (d_type, d_serial, d_code, d_name, d_displ, ld_cserial, ld_dbg) +# Holds a 'local' declaration. +# 'd_type' must be the declaration type (integer), in this case, +$define D_LOCAL 1 +# 'd_serial' must be the serial number of the declaration (integer). +# 'd_code' must be the bitfield that further characterizes the declaration. +# It is stored as the integer obtained by interpreting the octal coded +# bitfield as a decimal number. +# 'd_name' must be the source name of the declared entity. +# 'd_displ' must be non-null to indicate that this declaration is to be +# passed to the debug procedure. +# 'ld_cserial' may be a constant serial number (integer), or null. +# If integer then the name of this local exists as a constant in the current +# procedure, which means we include it among the visible variables. +# 'ld_dbg' is non-null if the declaration has been added by this program. + +record c_decl (d_type, d_serial, d_code, d_name, d_displ) +# Holds a constant declaration added by the program. +# Like 'l_decl', except 'd_type' must be +$define D_CONST 2 + +record fmap (fm_ucode, fm_source) +# Holds the mapping between an ucode file name and a source file name. +# 'fm_ucode' must be the root of an ucode file name (string). +# I.e. the file name without the trailing '.u?'. +# 'fm_source' must be the name of the source file from which the ucode +# file originates (string). + +global file_map +# Set containing mapping between ucode and source files (set of record fmap). + +global file_root, uin, uout, ulno +# The current root file name (i.e. file name without '.u?'). +# The current ucode input file. +# The current ucode output file. +# The current line number in the current ucode input file. + +global init_file +# Output file name: init file. + +global msgout +# Message output file. + +global proc_hil +# Table containing the "high label" of each procedure in a ucode file. +# Entry key is a procedure name (string). +# Entry value is the numeric part of the highest existing label before +# debugification (integer). + +global white +# This program's definition of white space. + +# +#-------- Constants -------- +# + +# Version of this program, variable for holding it. +$define PROGRAM_VERSION "$Revision: 2.21 $" +$define PROG_VERSION_VAR "__dbg_itweak_ver" + +# DEBUGGING IDENTIFIERS. +# List holding breakpoints for one source file; two parts. +# The root file name should be spliced in between. +$define DBG_BRKP1 "__dbg_file_" +$define DBG_BRKP2 "_brkp" +# Global variable holding source/ucode file map. +# Note: any change affects 'dbg.icn' as well. +$define DBG_FILE_MAP "__dbg_file_map" +# Procedure for initializing debugging globals. +$define DBG_INIT "__dbg_init" +# Local variable: trapped line number. +$define DBG_LINE "__dbg_line" +# List containing names of interesting local variables. +$define DBG_NAME "__dbg_name" +# Procedure to call on break. +$define DBG_PROC "__dbg_proc" +# Procedure deciding on break. +$define DBG_TEST "__dbg_test" + +# Name of variable whose presence is taken as assurance that an ucode +# file has been tweaked. +$define DBG_SENTINEL DBG_LINE + +# Default file name for writing the debug initialization code. +$define DBG_INIT_FILE "dbg_init.icn" + +# File name for the debugging run-time. +$define DBG_RUN_TIME "dbg_run.u1" + +# Ucode 'codes' (bitfields) for local declarations. +# The values are the octal coded bitfield interpreted as decimal. +$define LD_GLOBAL 0 +$define LD_LOCAL 20 +$define LD_PARM 1000 +$define LD_STATIC 40 + +# Ucode 'codes' (bitfields) for constant declarations. +$define CD_INT 2000 +$define CD_STRING 10000 + +# Various ucode op-codes. +$define OP_CONST "con" +$define OP_DEND "declend" +$define OP_END "end" +$define OP_FILEN "filen" +$define OP_LABEL "lab" +$define OP_LINE "line" +$define OP_LOCAL "local" +$define OP_PROC "proc" + +# Op-codes in the '.u2' file. +$define OP_VERSION "version" +$define OP_LINK "link" +$define OP_GLOBAL "global" + +# Icon versions for which the program has been tested. +$define ICON_VER_LO "U8.10.00" +$define ICON_VER_HI "U9.0.00" + +# Prefix used for labels. +$define ULAB_PREF "L" + +$define NALN -1 +# Not A Line Number. + +$define PROGNAME "itweak" +# The name by which the user knows this program. + +$define U1 ".u1" +$define U2 ".u2" +# Standard ucode file name suffix. + +$define U1TMP ".uA" +$define U2TMP ".uB" +# Suffix of temporary ucode file. + +$define U1OLD ".u1~" +$define U2OLD ".u2~" +# Suffix of renamed, original ucode file. + +# +#-------- Main -------- +# + +procedure main (argv) +local file_names, iout, u2count + # Initialize globals. + file_map := set () + msgout := &errout + white := '\t ' + # Process command line options; leave a list of file names. + if argv[1] == "-o" then { + get (argv) + (init_file := get (argv)) | + confl ("'-o' requires a file name") + } + else + init_file := DBG_INIT_FILE + file_names := copy (argv) + # The number of tweaked '.u2' files. + u2count := 0 + # Do two passes on each file. + every file_root := !file_names do { + # Allow for 'file.u1' and 'file.u'. + file_root := if file_root[-3:0] == ".u1" then + file_root[1:-3] else if file_root[-2:0] == ".u" then + file_root[1:-2] + # Pass 1. + (uin := open (file_root || U1, "r")) | + confl ("Cannot open '%1%2' for input.", file_root, U1) + uout := &null + if pass1 () then { + close (uin) + # Tweak at most one '.u2' file. + if u2count = 0 then { + (uin := open (file_root || U2, "r")) | + confl ("Cannot open '%1%2' for input.", file_root, U2) + (uout := open (file_root || U2TMP, "w")) | + confl ("Cannot open '%1%2' for output.", file_root, + U2TMP) + u2tweak () + close (uin) + close (uout) + u2count +:= 1 + # Make way for the following rename. + remove (file_root || U2OLD) + rename (file_root || U2, file_root || U2OLD) | + confl ("Cannot rename '%1%2' to '%1%3'.", file_root, + U2, U2OLD) + rename (file_root || U2TMP, file_root || U2) | + confl ("Cannot rename '%1%2' to '%1%3'.", file_root, + U2TMP, U2) + } + # Pass 2. + (uin := open (file_root || U1, "r")) | + confl ("Cannot open '%1%2' for input.", file_root, U1) + (uout := open (file_root || U1TMP, "w")) | + confl ("Cannot open '%1%2' for output.", file_root, U1TMP) + pass2 () + close (uin) + close (uout) + # Make way for the following rename. + remove (file_root || U1OLD) + rename (file_root || U1, file_root || U1OLD) | + confl ("Cannot rename '%1%2' to '%1%3'.", file_root, U1, U1OLD) + rename (file_root || U1TMP, file_root || U1) | + confl ("Cannot rename '%1%2' to '%1%3'.", file_root, U1TMP, U1) + } + else { + close (uin) + note ("'%1%2' seems to be tweaked already; left untouched.", + file_root, U1) + } + } + # Write initialization code. + (iout := open (init_file, "w")) | + confl ("Cannot open '%1' for output.", init_file) + cre_init (iout) + note ("Initialization code written to '%1'.", init_file) +end + +# +#-------- Pass 1 procedures -------- +# + +procedure pass1 () +# Performs a first pass over a ucode file, collecting label statistics. +# RETURNS null normally. +# FAILS if the first procedure has a local declaration containing the sentinel +# variable. +# This is taken to imply that the ucode file is already tweaked. +# SIDE EFFECT: Updates glocal 'proc_hil' (max labels per proc). +# Updates 'file_map' (source file name ~ ucode file name). +local cur_high, cur_proc, labint, line, loc, op, proc_no +static fn_instr, lc_decl +initial { + fn_instr := [OP_FILEN, OP_LINE, OP_LABEL] + lc_decl := [OP_LOCAL, OP_CONST, OP_DEND] + } + proc_hil := table () + loc := table () + proc_no := 0 + while op := p1_proclab () do if op[1] == "proc" then { + if \cur_proc then { + (/proc_hil[cur_proc] := cur_high) | + confl ("%1: occurs twice; confusing.", cur_proc) + } + cur_proc := op[2] + cur_high := -1 + + # Special treatment of the first procedure in every file. + if (proc_no +:= 1) = 1 then { + # Borrow some pass 2 code to collect the local declarations. + while (op := p2_upto (lc_decl))[1] == OP_LOCAL do + p2_getlocal (loc, op[2]) + # Look for source file name. + repeat if (op := p2_upto (fn_instr))[1] == OP_FILEN then { + insert (file_map, fmap (file_root, op[2])) + break + } + else if op[1] == OP_LABEL then + cur_high <:= integer (op[2][2:0]) + # Flush buffers. + p2_upto () + # Fail if the sentinel is present. + if \loc[DBG_SENTINEL] then + fail + } + } + else if op[1] == "lab" then { + # ASSUME the label consists of one character followed by an integer. + (labint := integer (op[2][2:0])) | + intern ("pass1: Problem parsing label %1.", image (op[2])) + cur_high <:= labint + } + if \cur_proc then { + (/proc_hil[cur_proc] := cur_high) | + confl ("%1: occurs twice; confusing.", cur_proc) + } + else + intern ("pass1: No proc found.") + return &null +end + +procedure p1_proclab () +# Returns the next ucode line containing a "proc" or "lab" instruction. +# If a matching line is found, RETURNS a two-component list. +# The first element contains the instruction found (string). +# The second element contains the second word on the line. +# FAILS on end-of-file. +local line, opcode, tail +static opchar +initial opchar := &lcase + while line := read (uin) do line ? { + if (opcode := tab (many (opchar))) == ("proc" | "lab") then { + tab (many (white)) + tail := tab (upto (white) | 0) + break + } + } + return [opcode, \tail] +end + +# +#-------- Pass 2 procedures -------- +# + +procedure pass2 () +# Performs a second pass over the ucode file, doing the actual tweaking. +# Writes the new ucode to 'uout'. +local counter, op + counter := 0 + while op := p2_upto ([OP_PROC]) do + p2_proc (trim (op[2]), counter +:= 1) +end + +procedure p2_addbrkp (line, last_lab, dbg_brkp, dbg_label, dbg_line, dbg_test) +# Adds code for breakpoint testing. +# 'line' should be the line number associated with the current ucode 'line' +# instruction. +# 'ltab' must be a table containing declarations of the current procedure. +# 'last_lab' must be the previous highest label serial (integer). +# RETURNS the new highest label serial. + write (uout, + "\tmark\t", ULAB_PREF, last_lab +:= 1, + "\n\tpnull", + "\n\tvar\t", dbg_line, + "\n\tvar\t", dbg_test, + "\n\tvar\t", dbg_brkp, + "\n\tkeywd\tline\n\tinvoke\t2\n\tasgn\n\tgoto\t", dbg_label, + "\n\tunmark\nlab ", ULAB_PREF, last_lab) + return last_lab +end + +procedure p2_addcall (ltab, dbg_label, init_label, end_label, dbg_line, dbg_name, + dbg_proc, pname_decl) +# Adds code for invoking the debug procedure. +local decl, pname_var, vlist + # Make vlist an alphabetically sorted list of identifiers: the names of + # the variables which should be passed to the debugging procedure. + vlist := [] + every \(decl := !ltab).d_displ do + put (vlist, decl.d_name) + vlist := sort (vlist) + # Begin writing the code. + write (uout, + "\tgoto\t", end_label, + "\nlab ", dbg_label, + "\n\tinit\t", init_label, + "\n\tmark\t", init_label, + "\n\tpnull\n\tvar\t", dbg_name, + "\n\tpnull") + every write (uout, "\tstr\t", (ltab[!vlist]).ld_cserial) + pname_var := if pname_decl.d_type = D_LOCAL then + pname_decl.ld_cserial else pname_decl.d_serial + write (uout, + "\tllist\t", *vlist, + "\n\tasgn\n\tunmark\nlab ", init_label, + "\n\tmark0\n\tvar\t", dbg_proc, + "\n\tkeywd\tfile\n\tvar\t", dbg_line, + "\n\tstr\t", pname_var, + "\n\tvar\t", dbg_name) + every write (uout, "\tvar\t", (ltab[!vlist]).d_serial) + write (uout, + "\tinvoke\t", 4 + *vlist, + "\n\tunmark\nlab ", end_label, + "\n\tpfail") +end + +procedure p2_addconst (decl, last_ser) +# Adds a string constant declaration containing the name of a local or constant +# declaration. +# 'decl' must be the declaration (record l_decl or c_decl). +# 'last_ser' must be the previous highest constant serial in this procedure. +# RETURNS the serial of the new constant. +# SIDE EFFECT: Updates 'decl'. +# Writes the new constant to the ucode output file. +# NOTE: This version does not add the name if the declaration is a global and +# is known to be a procedure. +local serial + # Omit variables which have been added by this program. + (decl.d_type = D_CONST) | (/decl.ld_dbg & decl.d_code ~= LD_GLOBAL) | + fail + (decl.d_type = D_CONST) | (decl.d_displ := 1) + serial := last_ser + 1 + if decl.d_type = D_LOCAL then + decl.ld_cserial := serial + else + decl.d_serial := serial + writes (uout, "\tcon\t", serial, ",", + right (CD_STRING, 6, "0"), ",", *decl.d_name) + every writes (uout, ",", octal (ord (!decl.d_name))) + write (uout) + return serial +end + +procedure p2_addinit (ltab, init_label) + write (uout, + "\tinit\t", init_label, + "\n\tmark\t", init_label, + "\n\tvar\t", ltab[DBG_INIT].d_serial, + "\n\tinvoke\t0\n\tunmark\nlab ", init_label) +end + +procedure p2_addlocal (pname, ltab, serial, code, name, dbg) +# Adds a local declaration to a table. +# 'pname' must be the current procedure name. +# 'ltab' must be the table where the new declaration is stored. +# See 'p2_getlocal' for details. +# 'serial' must be the serial to assign to the new declaration. +# 'code' must be the code, +# 'name' must be the name of the new declaration. +# 'dbg' may be non-null to indicate something different from a normal variable +# declaration. +# RETURNS the new declaration (record l_decl). +# SIDE EFFECT: Writes code for the new declaration to the ucode output file. +# Creates a new entry in 'ltab'. +local decl, old_d + # Check if the declaration already is there. + if old_d := \ltab[name] then { + # Check that the existing declaration is equivalent to the new. + (old_d.d_code = code) | + confl ("%1: conflicting declarations in procedure %2.", name, pname) + return old_d + } + decl := l_decl (D_LOCAL) + decl.d_serial := serial + decl.d_code := code + decl.ld_dbg := 1 + ltab[decl.d_name := name] := decl + write (uout, "\tlocal\t", serial, ",", right (code, 6, "0"), ",", name) + return decl +end + +procedure p2_brkp () +# Scans the ucode input file for the next breakpoint location. +# Ucode 'line' instructions are considered suitable breakpoint locations. +# If there are several 'line' instructions with the same line number only the +# last one is considered suitable. +# If a location is found, RETURNS the line number of the current location. +# FAILS if no suitable location is found. +# This means that an 'end' instruction has been reached +# When the procedure returns the 'line' instruction has been copied to the ucode +# output file. +# When the procedure encounters an 'end' instruction this instruction is not +# copied to the ucode output file. +local last_lno, line, opcode +static cur_lno, opchar +initial { + cur_lno := NALN + opchar := &lcase ++ '01' + } + repeat { + # Read and copy until the next 'line' or 'end' instruction is found. + repeat { + (line := read (uin)) | + intern ("p2_brkp: unexpected end of file.") + line ? if tab (many (white)) & + (opcode := tab (many (opchar))) then { + (opcode ~== OP_END) | { + last_lno := NALN + break + } + write (uout, line) + (opcode ~== OP_LINE) | { + last_lno := integer (tab (0)) + break + } + } + else + write (uout, line) + } + if last_lno = NALN then + break + else case cur_lno of { + # Still the same line, try another one. + last_lno: next # a little unstructured ... + # First line found. + NALN: cur_lno := last_lno + # OK, this is it, stop here. + default: break + } + } + if last_lno = NALN then + fail + else + return cur_lno :=: last_lno +end + +procedure p2_getlocal (ltab, dstring) +# Gets a local declaration from ucode representation; adds it to a table. +# 'ltab' must be a table storing declarations. +# Entry key is the variable name. +# Entry value is an 'l_decl' record. +# 'dstring' must be the ucode string defining the local. +# RETURNS the serial number of the new declaration. +# SIDE EFFECT: Adds an entry to 'ltab'. +local decl + decl := l_decl (D_LOCAL) + dstring ? { + decl.d_serial := integer (tab (many (&digits))) + ="," + decl.d_code := integer (tab (many (&digits))) + ="," + decl.d_name := tab (upto (white) | 0) + } + ltab[decl.d_name] := decl + return decl.d_serial +end + +procedure p2_newlocals (pname, ltab, last_ser, main_flag) +# Adds debugging local declarations to a procedure. +# 'pname' must be the procedure name (string). +# 'ltab' must be a table holding local declarations; see 'p2_getlocal'. +# 'last_ser' must be the last (highest) serial previously assigned. +# 'main_flag' must be non-null if the current procedure is 'main'. +# This will add the DBG_INIT procedure. +# RETURNS the last local declaration serial. +# SIDE EFFECT: Writes the new declarations to the ucode output file. +# Adds the new declarations to 'ltab'. + # Add the debugging init procedure if this is 'main'. + /main_flag | + p2_addlocal (pname, ltab, last_ser +:= 1, LD_GLOBAL, DBG_INIT) + p2_addlocal (pname, ltab, last_ser +:= 1, LD_LOCAL, DBG_LINE) + p2_addlocal (pname, ltab, last_ser +:= 1, LD_STATIC, DBG_NAME) + p2_addlocal (pname, ltab, last_ser +:= 1, LD_GLOBAL, DBG_PROC) + p2_addlocal (pname, ltab, last_ser +:= 1, LD_GLOBAL, DBG_TEST) + p2_addlocal (pname, ltab, last_ser +:= 1, LD_GLOBAL, + make_brkp_idf (file_root)) + return last_ser +end + +procedure p2_proc (pname) +# Tweaks the ucode of a single procedure. +# 'pname' must be the name of the procedure. +# SIDE EFFECT: Writes tweaked ucode to the ucode output file. +local dbg_brkp, dbg_label, dbg_line, dbg_name, dbg_proc, dbg_test +local init_label, end_label, pname_decl +local loc, first_new_const, last_conser, last_label, last_locser, line +local main_flag, op +static con_decl, lc_decl +initial { + # This is just a piece of hand optimization. + con_decl := [OP_CONST, OP_DEND] + lc_decl := [OP_LOCAL, OP_CONST, OP_DEND] + } + main_flag := pname == "main" + # Go through local declarations; add some new. + # See 'p2_getlocal' for documentation of the 'loc' table. + loc := table () + last_locser := -1 + while (op := p2_upto (lc_decl))[1] == OP_LOCAL do { + last_locser <:= p2_getlocal (loc, op[2]) + } + # Add our own locals, write them to the ucode output file. + last_locser := p2_newlocals (pname, loc, last_locser, main_flag) + # Go through constant declarations in order to find the maximum serial. + last_conser := -1 + repeat { + if op[1] == OP_CONST then + last_conser <:= (op[2] ? integer (tab (many (&digits)))) + else + break + (op := p2_upto (con_decl)) | break + } + # Declare a constant for the procedure name. + # Note that the procedure name may be hidden by a local! + /loc[pname] := c_decl (D_CONST, , CD_STRING, pname) + # Add new constant declarations to the ucode file. + first_new_const := last_conser + 1 + every last_conser := p2_addconst (!loc, last_conser) + # We will soon need a new label. + last_label := proc_hil[pname] + # Flush the 'p2_upto' buffer, normally the 'declend' instruction. + p2_upto () + # If this is the 'main' procedure insert code for invoking the + # initialization procedure. + if \main_flag then + p2_addinit (loc, ULAB_PREF || (last_label +:= 1)) + # Insert breakpoint testing code. + dbg_brkp := loc[make_brkp_idf (file_root)].d_serial + dbg_label := ULAB_PREF || (last_label +:= 1) + dbg_line := loc[DBG_LINE].d_serial + dbg_test := loc[DBG_TEST].d_serial + while last_label := p2_addbrkp (p2_brkp (), last_label, + dbg_brkp, dbg_label, dbg_line, dbg_test) + # Write the debug invocation code. + init_label := ULAB_PREF || (last_label +:= 1) + end_label := ULAB_PREF || (last_label +:= 1) + dbg_name := loc[DBG_NAME].d_serial + dbg_proc := loc[DBG_PROC].d_serial + pname_decl := loc[pname] + p2_addcall (loc, dbg_label, init_label, end_label, dbg_line, dbg_name, + dbg_proc, pname_decl) + # Add an 'end' instruction swallowed by 'p2_brkp'. + write (uout, "\t", OP_END) +end + +procedure p2_upto (op) +# Scans the ucode file, looking for the next line containing an interesting +# op-code. +# Copies non-matching lines to the new ucode file (if non-null) +# 'op' must be a list of the interesting op-code(s), or null. +# If a matching line is found, RETURNS a list of two elements. +# The first element contains the op-code, the second element the tail of the +# instruction (excluding any leading white space). +# FAILS on end-of-file. +# FLUSHING THE BUFFER: +# If the procedure is invoked with null 'op' any uncopied lines are written to +# the ucode output file; the procedure fails. +# NOTE: The procedure is used occasionally in pass 1, where there is no 'uout' +# file. +# This is the reason 'uout' is checked for existence (otherwise ucode will +# appear on standard output). +local opcode, tail +static new_line, opchar, old_line +initial opchar := &lcase ++ '01' + write (\uout, \new_line) + new_line := &null + \op | fail + repeat { + old_line := new_line + (new_line := read (uin)) | fail + new_line ? { + tab (many (white)) + if (opcode := tab (many (opchar))) == !op then { + tab (many (white)) + tail := tab (0) + break + } + else + write (\uout, new_line) + } + } + return [opcode, tail] +end + +# +#-------- '.u2' tweaking ----------- +# + +procedure u2tweak () +# Tweaks a '.u2' file, which means: +# Check the Icon version number; +# insert 'link' commands to the debugging run-time and to the init procedure. +local hitcount, op + (op := p2_upto ([OP_VERSION])) | { + note ("Surprising absence of 'version' in .u2 file...") + fail + } + (ICON_VER_LO <<= op[2] <<= ICON_VER_HI) | + note ("WARNING: %1 is tested only for Icon versions '%2'-'%3', found '%4'.", + PROGNAME, ICON_VER_LO, ICON_VER_HI, op[2]) + hitcount := 0 + while (op := p2_upto ([OP_LINK, OP_GLOBAL]))[1] == OP_LINK do + if op[2] == DBG_RUN_TIME then + hitcount +:= 1 + if hitcount = 0 then { + write (uout, OP_LINK, "\t", DBG_RUN_TIME) + write (uout, OP_LINK, "\t", init_file) + } + p2_upto () + while write (uout, read (uin)) +end + +# +#-------- General message handling and other utilities -------- +# + +procedure confl (msg, parm[]) +# Writes a conflict message and stops the program with nonzero exit code. + message ("[CONFLICT] ", subst (msg, parm)) + message ("*** ", PROGNAME, " stops with failure.") + stop () +end + +procedure cre_init (f) +# Creates initialization code. +# 'f' must be a file open for output. +local map, version + version := (PROGRAM_VERSION ? (tab (upto (&digits)), + tab (many (&digits++'.')))) + every write (f, "global ", (PROG_VERSION_VAR | DBG_TEST | DBG_FILE_MAP)) + every write (f, "global ", make_brkp_idf ((!file_map).fm_ucode)) + write (f, + "\nprocedure ", DBG_INIT, " ()\n\t", + PROG_VERSION_VAR, " := \"", version, "\"\n\t", + DBG_TEST, " := member") + every write (f, + "\t", make_brkp_idf ((!file_map).fm_ucode), " := set ()") + write (f, "\t", DBG_FILE_MAP, " := table ()") + every map := !file_map do + write (f, "\t", + DBG_FILE_MAP, "[\"", map.fm_source, "\"] := ", + make_brkp_idf (map.fm_ucode)) + write (f, "\t", DBG_PROC, " ()\nend") +end + +procedure fld_adj (str) +# Part of 'subst' format string parsing. +# 'str' must be a parameter string identified by the beginning part of a +# placeholder ('%n'). +# This procedure checks if the placeholder contains a fixed field width +# specifier. +# A fixed field specifier begins with '<' or '<' and continues with the field +# width expressed as a decimal literal. +# RETURNS 'str' possibly inserted in a fixed width field. +local just, init_p, res, wid +static fwf +initial fwf := '<>' + init_p := &pos + if (just := if ="<" then left else if =">" then right) & + (wid := integer (tab (many (&digits)))) then + res := just (str, wid) + else { + res := str + &pos := init_p + } + return res +end + +procedure intern (msg, parm[]) +# Writes an internal conflict message and stops the program with nonzero exit +# code. + message ("*** INTERNAL: ", subst (msg, parm)) + message ("*** ", PROGNAME, " stops with failure.") + stop () +end + +procedure make_brkp_idf (ucode_root) +# RETURNS an identifier which should be used to hold the breakpoints of an +# ucode file whose root name is 'ucode_root'. + return DBG_BRKP1 || ucode_root || DBG_BRKP2 +end + +procedure message (parm[]) +# Writes any number of strings to the message file. + every writes (msgout, !parm) + write (msgout) +end + +procedure note (msg, parm[]) +# Writes a note message. + message ("[NOTE] ", subst (msg, parm)) +end + +procedure octal (i) +# RETURNS the 'i' integer in the form of an octal literal. + static digits + local s, d + initial digits := string (&digits) + if i = 0 then return "0" + s := "" + while i > 0 do { + d := i % 8 + if d > 9 then d := digits[d + 1] + s := d || s + i /:= 8 + } + return s +end + +procedure subst (msg, parm) +# Substitutes parameters in a message template. +# 'msg' must be a message template (string). +# 'parm' must be a list of parameters (list of string-convertible), or null. +# It may also be a string. +local esc, res, sub +static p_digit +initial p_digit := '123456789' + \parm | return msg + parm := [string (parm)] + res := "" + msg ? until pos (0) do { + res ||:= tab (upto ('%\\') | 0) + if ="%" then res ||:= { + if any (p_digit) then { + sub := (\parm[integer (move (1))] | "") + fld_adj (sub) + } + else if any ('%') then + move (1) + else "" + } + else if ="\\" then res ||:= case esc := move (1) of { + "n": "\n" + "t": "\t" + default: esc + } + } + return res +end diff --git a/ipl/packs/itweak/options.icn b/ipl/packs/itweak/options.icn new file mode 100644 index 0000000..f3ee803 --- /dev/null +++ b/ipl/packs/itweak/options.icn @@ -0,0 +1,167 @@ +############################################################################ +# +# File: options.icn +# +# Subject: Procedure to get command-line options +# +# Authors: Robert J. Alexander and Gregg M. Townsend +# +# Date: February 27, 1992 +# +############################################################################ +# +# options(arg,optstring,errproc) -- Get command line options. +# +# This procedure separates and interprets command options included in +# the main program argument list. Option names and values are removed +# from the argument list and returned in a table. +# +# On the command line, options are introduced by a "-" character. An +# option name is either a single printable character, as in "-n" or "-?", +# or a string of letters, as in "-geometry". Valueless single-character +# options may appear in combination, for example as "-qtv". +# +# Some options require values. Generally, the option name is one +# argument and the value appears as the next argument, for example +# "-F file.txt". However, with a single-character argument name +# (as in that example), the value may be concatenated: "-Ffile.txt" +# is accepted as equivalent. +# +# Options may be freely interspersed with non-option arguments. +# An argument of "-" is treated as a non-option. The special argument +# "--" terminates option processing. Non-option arguments are returned +# in the original argument list for interpretation by the caller. +# +# An argument of the form @filename (a "@" immediately followed +# by a file name) causes options() to replace that argument with +# arguments retrieved from the file "filename". Each line of the file +# is taken as a separate argument, exactly as it appears in the file. +# Arguments beginning with - are processed as options, and those +# starting with @ are processed as nested argument files. An argument +# of "--" causes all remaining arguments IN THAT FILE ONLY to be +# treated as non-options (including @filename arguments). +# +# The parameters of options(arg,optstring,errproc) are: +# +# arg the argument list as passed to the main procedure. +# +# optstring a string specifying the allowable options. This is +# a concatenation, with optional spaces between, of +# one or more option specs of the form +# -name% +# where +# - introduces the option +# name is either a string of letters +# or any single printable character +# % is one of the following flag characters: +# ! No value is required or allowed +# : A string value is required +# + An integer value is required +# . A real value is required +# +# The leading "-" may be omitted for a single-character +# option. The "!" flag may be omitted except when +# needed to terminate a multi-character name. +# Thus, the following optstrings are equivalent: +# "-n+ -t -v -q -F: -geometry: -silent" +# "n+tvqF:-geometry:-silent" +# "-silent!n+tvqF:-geometry:" +# +# If "optstring" is omitted any single letter is +# assumed to be valid and require no data. +# +# errproc a procedure which will be called if an error is +# is detected in the command line options. The +# procedure is called with one argument: a string +# describing the error that occurred. After errproc() +# is called, options() immediately returns the outcome +# of errproc(), without processing further arguments. +# Already processed arguments will have been removed +# from "arg". If "errproc" is omitted, stop() is +# called if an error is detected. +# +# A table is returned containing the options that were specified. +# The keys are the specified option names. The assigned values are the +# data values following the options converted to the specified type. +# A value of 1 is stored for options that accept no values. +# The table's default value is &null. +# +# Upon return, the option arguments are removed from arg, leaving +# only the non-option arguments. +# +############################################################################ + +procedure options(arg,optstring,errproc) + local f,fList,fileArg,fn,ignore,optname,opttable,opttype,p,x,option + # + # Initialize. + # + /optstring := string(&letters) + /errproc := stop + option := table() + fList := [] + opttable := table() + # + # Scan the option specification string. + # + optstring ? { + while optname := move(1) do { + if optname == " " then next + if optname == "-" then + optname := tab(many(&letters)) | move(1) | break + opttype := tab(any('!:+.')) | "!" + opttable[optname] := opttype + } + } + # + # Iterate over program invocation argument words. + # + while x := get(arg) do { + if /x then ignore := &null # if end of args from file, stop ignoring + else x ? { + if ="-" & not pos(0) & /ignore then { + if ="-" & pos(0) then ignore := 1 # ignore following args if -- + else { + tab(0) ? until pos(0) do { + if opttype := \opttable[ + optname := ((pos(1),tab(0)) | move(1))] then { + option[optname] := + if any(':+.',opttype) then { + p := "" ~== tab(0) | get(arg) | + return errproc( + "No parameter following -" || optname) + case opttype of { + ":": p + "+": integer(p) | + return errproc("-" || optname || + " needs numeric parameter") + ".": real(p) | + return errproc("-" || optname || + " needs numeric parameter") + } + } + else 1 + } + else return errproc("Unrecognized option: -" || optname) + } + } + } + # + # If the argument begins with the character "@", fetch option + # words from lines of a text file. + # + else if ="@" & not pos(0) & /ignore then { + f := open(fn := tab(0)) | + return errproc("Can't open " || fn) + fileArg := [] + while put(fileArg,read(f)) + close(f) + push(arg) # push null to signal end of args from file + while push(arg,pull(fileArg)) + } + else put(fList,x) + } + } + while push(arg,pull(fList)) + return option +end |