ftp.cs.arizona.edu/ftp.cs.arizona.edu.tar/ftp.cs.arizona.edu/icon/historic/v941.tgz/icon.v941src.tar/icon.v941src/ipl/packs/itweak/dbg_run.icn

Text File | 2000-07-29 | 67KB | 2,291 lines

############################################################################
#
#    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