# This file is automatically generated.
################################################################################
#
# Copyright (C) 1996-2005 Jason Evans <jasone@canonware.com>.
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice(s), this list of conditions and the following disclaimer
#    unmodified other than the allowable addition of one or more
#    copyright notices.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice(s), this list of conditions and the following disclaimer in
#    the documentation and/or other materials provided with the
#    distribution.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER(S) ``AS IS'' AND ANY
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDER(S) BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
################################################################################
#
# Version: Onyx 5.1.2
#
################################################################################

systemdict begin

#
# sprintsdict implements syntactic printing to strings for every type.
#
$sprintsdict <
    $arraytype {
	#array #depth
	dup 0 gt {
	    over dup xcheck {
		pop
		`{'
	    }{
	    echeck {
		`_{'
	    }{
		`['
	    } ifelse
	    } ifelse

	    #array #depth #accum
	    2 idup length 1 gt {
		#array #depth #accum
		0 1 4 idup length 2 sub {
		    #array #depth #accum #i
		    3 idup exch get
		    2 idup 1 sub
		    #array #depth #accum #el #rdepth
		    over type sprintsdict exch get eval
		    cat
		    #array #depth #accum #el #rdepth
		` ' cat
		} for
	    } if
	    #array #depth #accum

	    2 idup length 0 gt {
		2 idup dup length 1 sub get
		2 idup 1 sub
		#array #depth #accum #el #rdepth
		over type sprintsdict exch get eval
		cat
	    } if
	    #array #depth #accum

	    nip
	    #array #accum
	    exch dup xcheck {
		pop
		`}'
	    }{
	    echeck {
		`}_'
	    }{
		`]'
	    } ifelse
	    } ifelse
	    cat
	    #accum
	}{
	    2 npop
	    `-array-'
	} ifelse
    } bind
    $booleantype {
	pop
	cvs
    } bind
    $classtype {
	#instance #depth
	exch classname
	#depth #classname
	dup type $nulltype ne {
	    exch 1 sub
	    #classname #rdepth
	    over type sprintsdict exch get eval
	    #tagstr
	    `-class=' exch `-' 3 ncat
	}{
	    2 npop
	    `-class-'
	} ifelse
    } bind
    $conditiontype {
	2 npop
	`-condition-'
    } bind
    $dicttype {
	#dict #depth
	dup 0 gt {
	    # Update recursion depth.
	    1 sub

	    0
	    `<'

	    #dict #rdepth #i #accum
	    3 idup {
		#dict #rdepth #i #accum #key #value
		exch 4 idup
		#dict #rdepth #i #accum #value #key #rdepth
		over type sprintsdict exch get eval
		` ' cat
		#dict #rdepth #accum #i #value #keystr
		exch 4 idup
		#dict #rdepth #i #accum #keystr #value #rdepth
		over type sprintsdict exch get eval
		#dict #rdepth #i #accum #keystr #valstr
		cat cat
		#dict #rdepth #i #accum

		# Update counter.
		exch 1 add dup 4 idup length lt {
		    #dict #rdepth #accum #i
		    exch
		    ` ' cat
		    #dict #rdepth #i #accum
		}{
		    # Last element.
		    exch
		    #dict #rdepth #accum
		} ifelse
	    } foreach
	    #dict #rdepth #i #accum

	    4 nup 3 npop
	    #accum
	    `>'
	    cat
	    #accum
	}{
	    2 npop
	    `-dict-'
	} ifelse
    } bind
    $filetype {
	2 npop
	`-file-'
    } bind
    $finotype {
	2 npop
	`-fino-'
    } bind
    $handletype {
	#handle #depth
	exch handletag
	#depth #tag
	dup type $nulltype ne {
	    exch 1 sub
	    #tag #rdepth
	    over type sprintsdict exch get eval
	    #tagstr
	    `-handle=' exch `-' 3 ncat
	}{
	    2 npop
	    `-handle-'
	} ifelse
    } bind
    $instancetype {
	#instance #depth
	exch isa
	dup type $nulltype ne {
	    classname
	    #depth #classname
	    dup type $nulltype ne {
		exch 1 sub
		#classname #rdepth
		over type sprintsdict exch get eval
		#tagstr
		`-instance=' exch `-' 3 ncat
	    }{
		2 npop
		`-instance-'
	    } ifelse
	}{
	    2 npop
	    `-instance-'
	} ifelse
    } bind
    $integertype {
	pop
	cvs
    } bind
    $marktype {
	2 npop
	`-mark-'
    } bind
    $mutextype {
	2 npop
	`-mutex-'
    } bind
    $nametype {
	#name #depth
	pop
	dup cvs exch
	#str #name
	dup lcheck {
	    # Literal.
	    pop
	    `$' exch cat
	}{
	dup echeck {
	    # Evaluable.
	    pop
	    `!' exch cat
	}{
	dup xcheck {
	    # Executable.
	    pop
	}{
	dup ccheck {
	    # Callable.
	    pop
	    `:' exch cat
	}{
	icheck {
	    # Invokable.
	    `;' exch cat
	}{
	    # Fetchable.
	    `,' exch cat
	} ifelse
	} ifelse
	} ifelse
	} ifelse
	} ifelse
    } bind
    $nulltype {
	2 npop
	`null'
    } bind
    $operatortype {
	pop
	cvs
	dup `-operator-' ne {
	    `--' tuck
	    cat cat
	} if
    } bind
    $pmarktype {
	2 npop
	`-pmark-'
    } bind
    $realtype {
	pop
	cvs
    } bind
    $regextype {
	2 npop
	`-regex-'
    } bind
    $regsubtype {
	2 npop
	`-regsub-'
    } bind
    $stacktype {
	#stack #depth
	dup 0 gt {
	    `('

	    #stack #depth #accum
	    2 idup scount 1 gt {
		#stack #depth #accum
		2 idup scount 1 sub -1 1 {
		    #stack #depth #accum #i
		    3 idup dup dn sidup spop
		    2 idup 1 sub
		    #stack #depth #accum #el #rdepth
		    over type sprintsdict exch get eval
		    cat
		    #stack #depth #accum #el #rdepth
		` ' cat
		} for
	    } if
	    #stack #depth #accum

	    2 idup scount 0 gt {
		2 idup dup sdup spop
		2 idup 1 sub
		#stack #depth #accum #el #rdepth
		over type sprintsdict exch get eval
		cat
	    } if
	    #stack #depth #accum

	    up 2 npop
	    #accum
	    `)'
	    cat
	    #accum
	}{
	    2 npop
	    `-stack-'
	} ifelse
    } bind
    $stringtype {
	pop
	cvs
    } bind
    $threadtype {
	2 npop
	`-thread-'
    } bind
> def

#object #depth sprints #string
$sprints {
    over type sprintsdict exch get eval
} bind def

$sprint {
    sprints print
    `\n' print flush
} bind def

#
# outputsdict implements formatted output to strings for every type.
#
$outputsdict <
    $integertype {
	#int #flags

	# Get the base.
	dup $b known {
	    dup $b get
	}{
	    10
	} ifelse
	#int #flags #base

	2 idup exch cvrs
	#int #flags #str

	# Prepend the sign if necessary.
	over $s known {
	    over $s get $+ eq {
		2 idup 0 ge {
		    `+' exch cat
		} if
	    } if
	} if
	#int #flags #str
	dn pop
	#flags #str
	exch
	#str #flags
	outputsdict $stringtype get eval
	#str
    } bind
    $realtype {
	#real #flags

	# Determine precision past decimal point.
	dup $d known {
	dup $d get
	}{
	6
	} ifelse
	#real #flags #precision

	# Determine whether to use decimal or exponential notation.
	over $e known {
	over $e get
	}{
	false
	} ifelse
	#real #flags #precision #exp?

	3 idup up
	#real #flags #real #precision #exp?
	{
	# Use exponential notation.
	cves
	}{
	# Use decimal notation.
	cvds
	} ifelse
	#real #flags #str

	# Prepend the sign if necessary.
	over $s known {
	over $s get $+ eq {
	    2 idup 0 ge {
	    `+' exch cat
	    } if
	} if
	} if
	#real #flags #str
	dn pop exch
	#str #flags

	outputsdict $stringtype get eval
	#str
    } bind
    # Temporarily define.
    $_s {
	# Check for $w flag.  $w takes precedence over $n.
	dup $w known {
	    # Get padding character.
	    dup $p known {
		dup $p get
	    }{
		` '
	    } ifelse
	    #str #flags #pad

	    over $w get
	    #str #flags #pad #width
	    3 idup length
	    #str #flags #pad #width #len

	    dup 2 idup le {
		# Pad string.
		#str #flags #pad #width #len

		over string
		#str #flags #pad #width #len #pstr

		# Fill #pstr with #pad.
		0 1 4 idup 1 sub {
		    over exch 5 idup putinterval
		} for
		#str #flags #pad #width #len #pstr
		3 ipop
		#str #flags #width #len #pstr

		# Get the justification.
		3 idup $j known {
		    3 idup $j get
		}{
		    $r
		} ifelse
		#str #flags #width #len #pstr #just

		dup $r eq {
		    pop
		    # Right justify.
		    #str #flags #width #len #pstr
		    up sub
		}{
		$l eq {
		    # Left justify.
		    #str #flags #width #len #pstr
		    up 2 npop
		    0
		}{
		    # Center.
		    #str #flags #width #len #pstr
		    up sub 2 idiv
		} ifelse
		} ifelse
		#str #flags #pstr #offset

		over exch
		#str #flags #pstr #pstr #offset
		5 ndn
		#flags #pstr #pstr #offset #str
		putinterval
		#flags #pstr
		exch
		#pstr #flags
	    }{
		# No padding necessary.
		3 npop
	    } ifelse
	    #str #flags
	}{
	    #str #flags
	    dup $n known {
		# Truncate the string if it is too long.
		over length
		over $n get
		#str #flags #len #max
		dup 2 idup lt {
		    # Truncate.
		    nip
		    dup string
		    #str #flags #max #nstr
		    dup
		    #str #flags #max #nstr #nstr
		    5 ndn
		    #flags #max #nstr #nstr #str
		    4 ndn
		    #flags #nstr #nstr #str #max
		    0 exch getinterval
		    #flags #nstr #nstr #substr
		    0 exch putinterval
		    #flags #nstr
		    exch
		}{
		    2 npop
		} ifelse
		#nstr #flags
	    } if
	    #str #flags
	} ifelse
	#str #flags

	pop
	#str
    } bind def
    $stringtype $_s load

    # Most types can be handled identically.  The following code uses the
    # same procedure body for all of those types.
    #
    # The following block of code looks scary because it avoids deferred
    # execution in order to "bind" things correctly (we cannot use immediate
    # evaluation in this file).
    [
	#object #flags

	# Get recursion depth.
	$dup cvx $r $known cvx [
	    $dup cvx $r $get cvx
	] cvx [
	    1
	] cvx $ifelse cvx
	#object #flags #rdepth

	$dn cvx $exch cvx
	#flags #object #rdepth
	$sprints cvx $exch cvx
	#str #flags
	$_s load cve
	#str
    ] cvx bind
    [
	$arraytype
	$booleantype
	$classtype
	$conditiontype
	$dicttype
	$filetype
	$finotype
	$handletype
	$instancetype
	$marktype
	$mutextype
	$nametype
	$nulltype
	$operatortype
	$pmarktype
	$regextype
	$regsubtype
	$stacktype
	$threadtype
    ]{
	#proc #name
	exch dup
	#name #proc #proc
    } bind foreach
    # Get rid of the extra copy of #proc.
    pop

    # Now that we are done using _s, undef it.
    currentdict $_s undef
> def

#
# Formatted output to a string.  Supported flags:
#
# All types:
#
# $n : maximum width
#    : #integer
# $w : minimum width
#    : #integer
# $j : justification
#    : $l, $c, $r
# $p : padding character
#    : `?'
# $r : recursion depth
#    : 0..n
#
# Integers only:
#
# $b : base
#    : 2..36
# $s : sign
#    : $+ $-
#
# Reals only:
#
# $d : digits of precision past decimal
#    : #integer (default 6)
# $e : exponential notation
#    : #boolean (default false)
#
#obj #flags outputs #string
$outputs {
    dup type $dicttype ne {
	$typecheck throw
    } if
    over type
    #obj #flags #type
    outputsdict exch get eval
} bind def

#obj #flags output -
$output {
    outputs print
} bind def

# - product #string
$product `Canonware Onyx' def

# - pstack -
$pstack {
    ostack {
	1 sprint
    } foreach
    flush
} bind def
# [`<path>' `<args>'...] system #exit_code
$system {
    forkexec
    waitpid
} bind def
# Define require and mrequire configuration parameters in onyxdict.  By default,
# the search order is:
#
# 1) Absolute path: `'.
# 2) Relative path: `.'.
# 3) $ONYX_[MR]PATH: Colon-separated string in envdict.
# 4) onyxdict [rm]path_post: Standard location(s).
onyxdict begin
$rpath_pre [`' `.'] def
$mpath_pre [`' `.'] def
$rpath_post [`/usr/pkg/share/onyx-5.1.2/nx'] def
$mpath_post [`/usr/pkg/share/onyx-5.1.2/nxm'] def
end # onyxdict.

#filename require -
$require {
    # Make sure the argument is a string.
    dup type $stringtype ne {
	$typecheck throw
    } if

    {
	[
	    onyxdict $rpath_pre get

	    envdict $ONYX_RPATH 2 ndup known {
		get `:' split
	    }{
		2 npop
	    } ifelse

	    onyxdict $rpath_post get
	]{
	    #filename #path
	    {
		#filename #dir
		`/' cat
		over cat
		#filename #full_path
		dup `f' test {
		    # Found.
		    #filename #full_path
		    nip
		    #full_path
		    `r' open cvx eval
		    stop # Success.
		}{
		    # Not found.
		    #filename #full_path
		    pop
		} ifelse
	    } foreach
	} foreach
    } stopped not {
	# Failure.
	$undefinedfilename throw
    } if
} bind def

#filename #symbol mrequire -
$mrequire {
    # Make sure the arguments are strings.
    over type $stringtype ne {
	$typecheck throw
    } if
    dup type $stringtype ne {
	$typecheck throw
    } if

    exch
    #symbol #filename
    {
	[
	    onyxdict $mpath_pre get

	    envdict $ONYX_MPATH 2 ndup known {
		get `:' split
	    }{
		2 npop
	    } ifelse

	    onyxdict $mpath_post get
	]{
	    #symbol #filename #path
	    {
		#symbol #filename #dir
		`/' cat
		over cat
		#symbol #filename #full_path
		dup `f' test {
		    # Found.
		    #symbol #filename #full_path
		    nip
		    #symbol #full_path
		    exch modload
		    stop # Success.
		}{
		    # Not found.
		    #symbol #filename #full_path
		    pop
		} ifelse
	    } foreach
	} foreach
    } stopped not {
	# Failure.
	#symbol #filename
	exch
	$undefinedfilename throw
    } if
} bind def

# Define vclass, which is provided as the top level base class.
$vclass null <
><
    #class#
    #- new #instance
    $new {
	# Create instance.
	instance dup this setisa

	dup dict setdata
    } bind

    # Typically called at the beginning of new in subclasses.  Recursively
    # invokes new, and sets isa.
    #
    #class#
    #- rnew #instance
    $rnew {
	this super
	dup type $classtype eq {
	    dup methods
	    dup type $dicttype eq {
		dup $new known {
		    # Call super:new.
		    pop
		    :new
		}{
		    # new not defined.
		    pop
		    instance
		} ifelse
	    }{
		# No methods.
		pop
		instance
	    } ifelse
	}{
	    # No superclass.
	    pop
	    instance
	} ifelse
	#instance

	dup this setisa
    } bind

    #class#
    #name implementor #class
    $implementor {
	this exch implementor
    } bind

    #class#
    #name implements #boolean
    $implements {
	this exch implements
    } bind

    #class#
    #name method #method
    $method {
	this exch method
    } bind

    #class#
    #- classname #name/null
    $classname {
	this classname
    } bind

    #class#
    #name/null setclassname -
    $setclassname {
	this exch setclassname
    } bind

    #class#
    #- super #super/null
    $super {
	this super
    } bind

    #class#
    #super/null setsuper -
    $setsuper {
	this exch setsuper
    } bind

    #class#
    #- methods #methods/null
    $methods {
	this methods
    } bind

    #class#
    #methods/null setmethods -
    $setmethods {
	this exch setmethods
    } bind

    #
    # Class/instance-related methods.
    #

    #class/instance#
    #- data #data/null
    $data {
	this data
    } bind

    #class/instance#
    #data/null setdata -
    $setdata {
	this exch setdata
    } bind

    #class/instance#
    #key #val def -
    $def {
	this data up put
    } bind

    #class/instance#
    #key undef -
    $undef {
	this data exch undef
    } bind

    #
    # Instance-related methods.
    #

    #instance#
    #- isa #class/null
    $isa {
	this isa
    } bind

    #instance#
    #class/null setisa -
    $setisa {
	this exch setisa
    } bind

    #instance#
    #class kind #boolean
    $kind {
	this exch kind
    } bind
> cdef

# Singleton responsible for tracking all loaded modules.
$mclass vclass <
    # Dictionary of classname-->singleton associations.
    $singletons dict
><
    # This is a singleton class, so do not allow new to be called.
    #
    #class#
    #- new #instance
    $new {
	$invalidaccess throw
    } bind

    #class#
    #- p_new #instance
    $p_new {
	;rnew
	#instance

	<
	    $modules dict
	> over data copy pop
    } bind

    #class#
    #- singleton #instance
    $singleton {
	,singletons
	#singletons
	this classname
	#singletons #classname
	2 ndup known {
	    # Already instantiated.  Retrieve the singleton.
	    get
	}{
	    # Not instantiated.  Instantiate and record a reference.
	    ;p_new
	    #singletons #classname #instance
	    dup 4 nup
	    #instance #singletons #classname #instance
	    put
	} ifelse
    } bind

    #instance#
    #modname load -
    $load {
	,modules
	#modname #modules
	over under known {
	    # Already loaded.
	    2 npop
	}{
	    exch dup this
	    #modules #modname #modname #this
	    module:new
	    #modules #modname #module
	    put
	} ifelse
    } bind

    # Called by module:unload.
    #
    #instance#
    #modname unload_notify -
    $unload_notify {
	,modules exch undef
    } bind

    #instance#
    #- modules #<modules>
    $modules {
	,modules
    } bind
> cdef

# Each loaded module has a corresponding instance of this class, which can be
# accessed via mclass:singleton:modules.
$module vclass <
><
    #class#
    #modname #mclass_singleton new #instance
    $new {
	;rnew
	#modname #mclass_singleton #instance

	# Initialize the module instance.
	:p_module_init
	#instance
    } bind

    #instance#
    #modname #mclass_singleton p_init #instance
    $p_module_init {
	# Define instance data.
	<
	    #modname #mclass_singleton <
	    $name 4 ndn
	    #mclass_singleton < $name #modname
	    $mclass_singleton 5 ndn
	    #< $name #modname $mclass_singleton #mclass_singleton 
	    $mdefs dict
	    $deps dict
	    $pre_unload_hook null cvx
	    $post_unload_hook null cvx
	    $version 0
	>{
	    ;def
	} foreach

	# Load the module.
	`X/X.nx' `X' ,name cvx cvs <$g true> subst pop
	#`mod#modname/#modname.nx'
	require

	# Associate the module with its name in currentdict, in order to make
	# later module access easier.
	,name this currentdict ;mdef

	this
	#instance
    } bind

    #instance#
    #- version_get #version
    $version_get {
	,version
    } bind

    #instance#
    #version version_set -
    $version_set {
	$version exch ;def
    } bind

    #instance#
    #- deps_get #<deps>
    $deps_get {
	,deps
    } bind

    #instance#
    #- mdefs_get #<mdefs>
    $mdefs_get {
	,mdefs
    } bind

    # Define #defname as #defval in #defdict.  Make a record of the definition
    # in the $mdefs dictionary, with a format of:
    #
    #   [#defname #defval] --> #defdict
    #
    #instance#
    #defname #defval #defdict mdef -
    $mdef {
	# Record the existence of the definition in $mdefs.
	,mdefs
	#defname #defval #defdict #mdefs
	[
	    4 idup
	    4 idup
	]
	2 idup
	#defname #defval #defdict #mdefs [#defname #defval] #defdict
	put
	#defname #defval #defdict

	# Define.
	up put
    } bind

    # Load a module that this one depends on, and record the dependency.
    #
    #instance#
    #depname dep_load -
    $dep_load {
	,mclass_singleton
	#depname #mclass_singleton
	under :load
	#depname
	dup cvx eval
	#depname #depmod
	,deps up put
    } bind

    # Store a reference to #hook, and evaluate it at the beginning of :unload.
    #
    #instance#
    #hook pre_unload_hook_set -
    $pre_unload_hook_set {
	$pre_unload_hook exch ;def
    } bind

    # Store a reference to #hook, and evaluate it at the end of :unload.
    #
    #instance#
    #hook post_unload_hook_set -
    $post_unload_hook_set {
	$post_unload_hook exch ;def
    } bind

    # Unload the module.
    #
    #instance#
    #- unload -
    $unload {
	# Evaluate the pre-unload hook.
	,pre_unload_hook eval

	# Iteratively undefine the module definitions, as recorded in the mdefs
	# dict.
	,mdefs {
	    exch 0 get
	    #defdict #defname
	    undef
	} foreach

	# Evaluate the post-unload hook.
	,post_unload_hook eval

	# Notify mclass_singleton of the unload.
	,name ,mclass_singleton:unload_notify
    } bind
> cdef

# $errorname throw -
$throw {
    # Do some sanity checking, to try to avoid going infinitely recursive
    # in the error handling machinery.
    {
	{$errordict where {pop true}{false} ifelse}
	{$currenterror where {pop true}{false} ifelse}
    }{
	eval not {
	    `Onyx: Missing errordict or currenterror definitions\n'
	    {stderr exch write}{} until

	    # Print stack dumps.
	    `ostack: ' {stderr exch write}{} until
	    ostack 2 sprints {stderr exch write}{} until

	    `\ndstack: ' {stderr exch write}{} until
	    dstack 2 sprints {stderr exch write}{} until

	    `\ncstack: ' {stderr exch write}{} until
	    cstack 2 sprints {stderr exch write}{} until
	    `\nestack: ' {stderr exch write}{} until
	    estack 2 sprints {stderr exch write}{} until

	    `\nistack: ' {stderr exch write}{} until
	    istack 2 sprints {stderr exch write}{} until

	    `\nOnyx: dieing\n' {stderr exch write}{} until
	    1 die
	} if
    } foreach

    # Make sure the argument is a name.
    dup type $nametype ne {
	$typecheck !throw
    } if

    !currenterror begin

    # Set newerror to true to indicate there is an error.  It is up to the
    # application to clear this afterwards if it wants to make newerror
    # meaningful in the face of multiple errors.
    $newerror true def

    # Set errorname to the argument passed in.
    dup $errorname exch cvl def

    # ostack.  Get rid of $errorname in the snapshot.  Ordering is important
    # to keep from polluting the snapshot.
    ostack dup spop pop $ostack exch def

    # dstack.  Do not include the top element, which is the copy of
    # currenterror that we pushed.
    $dstack dstack dup spop pop def
    # cstack.
    $cstack cstack def
    # estack.  Remove this procedure from the snapshot.
    $estack estack dup tailopt 1 2 ifelse snpop pop def

    # istack.  Remove this procedure from the snapshot.
    $istack istack dup tailopt 1 2 ifelse snpop pop def

    # Push the offending object onto ostack.
    !estack dup sdup spop
    exch
    #object #errorname

    end # currenterror.

    # If there is an error handler for the error name, call it.  Otherwise,
    # call the errordict handleerror, then call the errordict stop.
    !errordict
    #object #errorname #errordict
    dup 2 idup known {
	# Call error handler.
	exch get eval
    }{
	# No error handler.
	nip
	#object #errordict

	dup $handleerror known {
	    dup $handleerror get eval
	} if
	dup $stop known {
	    $stop get eval
	}{
	    `Onyx: Missing stop in errordict\n' {stderr exch write}{} until

	    # Print errordict
	    `errordict: ' {stderr exch write}{} until
	    2 sprints {stderr exch write}{} until

	    `\nOnyx: dieing\n' {stderr exch write}{} until
	    1 die
	} ifelse
    } ifelse
} bind def

# - version #string
$version `5.1.2' def

end # systemdict.
