[alt.sources] TILE FORTH PACKAGE 3

mip@massormetrix.ida.liu.se (Mikael Patel) (12/19/89)

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 3 (of 7)."
# Contents:  PORTING doc/compiler.doc doc/debugger.doc doc/forth.doc
#   doc/locals.doc doc/structures.doc error.c forth.c src/debugger.f83
#   tile.1
# Wrapped by mip@massormetrix on Mon Dec 18 18:40:11 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f PORTING -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"PORTING\"
else
echo shar: Extracting \"PORTING\" \(5386 characters\)
sed "s/^X//" >PORTING <<'END_OF_PORTING'
XTHREADED INTERPRETIVE LANGUAGE ENVIRONMENT (TILE) PORTING
X
XDecember 14, 1989
X
XMikael R.K. Patel
XComputer Aided Design Laboratory (CADLAB)
XDepartment of Computer and Information Science
XLinkoping University
XS-581 83 LINKOPING
XSWEDEN
XEmail: mip@ida.liu.se
X
X
X
X1. KERNEL DEFINITIONS
X
X1.1	Vocabulary listing parameters (File: kernel.c)
X
XThe column and line width used by "words" may be altered by changing
Xthe lines:
X
X#define COLUMNWIDTH 15
X#define LINEWIDTH 75
X
X
X1.2	Set of search vocabularies (File: kernel.c)
X
XThe set of search vocabularies, "context", is realized as a vector.
XThe maximum number of vocabularies in is defined by:
X
X#define CONTEXTSIZE 32
X
XAn error will occur it the set is filled. No checking is currently 
Xperformed.
X
X
X1.3	Lookup cache (File: kernel.c)
X
XThe lookup function in the kernel is supported by a simple cache.
XA hash function (see below) is used to map a string into the cache
Xand there, if possible, find the entry. The size of the cache
Xis given by:
X
X#define CACHESIZE 256
X#define hash(s) ((s[0] + (s[1] << 4)) & (CACHESIZE - 1))
X
XThe hash function is tailored for the current cache size and thus
Xspecial care must be taken when altering these.
X
X
X1.4	Internal structures (File: kernel.c)
X
XThe "pad" and the "tib" may be changed by altering:
X
X#define PADSIZE 84
X#define TIBSIZE 256
X
X
X1.5	Word alignment (File: kernel.h)
X
XAlignment of threaded code and data structures are performed by the
Xmacro:
X
X#define align(p) p = (long *) ((long) ((char *) p + 3) & -4)
X
XThis macro currently aligns to word (long) boundaries and is used by
X"colon" and "create".
X
X
X1.6	Function casting (File: kernel.h)
X
XSome compilers might not like the current definition of casting of
Xa function to a long number in the entry structure. To reduce rewriting
Xa macro is used:
X
X#define SUBR(x) ((long) (void (*) ()) (x))
X
XThis macro is used by the entry generators (see kernel.h). Some
Xcompilers will not allow this and thus will require that the primitive,
Xi.e. the C-level subroutines, are bound at run-time. This code is
Xnot included.
X
X
X1.7	Initialization of the kernel (File: kernel.c)
X
XThe initialization function for the kernel requires five parameters.
XThe two first allows the application such as forth.c to extend the
Xbasic forth vocabulary by giving the first and last entry in the 
Xapplication vocabulary. The three following parameters specify the
Xsize of the foreground task, the forth interpreter. See the file
Xforth.c for an example.
X
X
X2. 	IO MANAGEMENT
X
X2.1	File and path name size (File: io.c)
X
XThe maximum length of a file or path name is defined as:
X
X#define FILENAMESIZE 128
X#define PATHNAMESIZE 128
X
XThese length are not test for currently. An error may occur if
Xa file or path name is longer than the given sizes.
X
X
X2.2	File buffer stack (File: io.c)
X
XThe io management package implements a stack of input file buffers to
Xallow loading of files from within other files etc. The maximum depth
Xof this stack is defined as:
X
X#define FSTACKSIZE 32
X
XThe depth should be chosen to the maximum number of open files.
X
X
X2.3	Set of loaded files (File: io.c)
X
XThe file loading mechanism automatically looks if the file already
Xhas been opened. The set of opened files is maintained as a vector.
XThe maximum number of loaded files is:
X
X#define INFILESSIZE 64
X
XThe vector contains the fully expanded names of the loaded files.
XAn error may occur if this limit is succeeded. It is not checked for
Xcurrently.
X
X
X2.4	Set of paths (File: io.c)
X
XThe io packages also maintains an ordered collection of paths which
Xare used to expand file names with when search for the file. The
Xmaximum size of this collection is defined by:
X
X#define PATHSSIZE 64
X
XThis collection is automatically appended by the $TILEPATH environ-
Xment variable when the io package is initiated.
X
X
X2.5	White space (File: io.h)
X
XThe definition of "white" space is defined as:
X
X#define ISSPACE(c) ((c) <= ' ')
X
XThis eliminates space and any control characters. Some application
Xmight want to redefine this.
X
X
X2.6	Non-blocking read operation (File: io.c)
X
XTo achieve multi-tasking during input wait the input package function
X"io_fillbuf" uses a non-blocking read operation. Some environments
Xdo not support this. Thus this may require re-implementation.
X
XTo check if the read operation was an success the error number 
Xvariable is used ("errno"). Some environments do not include it
Xin the include file thus the below line is needed:
X
Xextern int errno;
X
XThis is available in SUN include files.
X
X
X3. 	ERROR MANAGEMENT
X
X3.1	Signals (File: error.c)
X
XError handing is realized using two basic mechanisms; first signals from
Xthe execution environment and second by user defined exceptions in
Xthe kernel (high level code).
X
XThe signal message table and the appropriate operations, "error_restart",
Xor "error_fatal", may have to be changed to give the right performance.
X
XPlease see these functions and "error_initiate" where the actual binding
Xof signals and actions is performed.
X
X
X4.	MEMORY MANAGEMENT
X
X4.1	Memory allocation (File: memory.c)
X
XCurrently memory for the dictionary, strings, entries, and task blocks
Xare allocated using "malloc".
X
XThe size of the dictionary is determined when calling the initialization
Xfunction in the memory management package, "memory_initiate". The
Xcurrent size is defined as:
X
X#define DICTIONARYSIZE 128L * 1024L
X
XAnd may be too large for smaller machines. Please see the file: forth.c.
END_OF_PORTING
if test 5386 -ne `wc -c <PORTING`; then
    echo shar: \"PORTING\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f doc/compiler.doc -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"doc/compiler.doc\"
else
echo shar: Extracting \"doc/compiler.doc\" \(5252 characters\)
sed "s/^X//" >doc/compiler.doc <<'END_OF_doc/compiler.doc'
XCOMPILER(1)                KERNEL COMPILER FUNCTIONS	             COMPILER(1)
X
XNAME
X	compiler - kernel compiler support functions
X
XSYNOPSIS
X	compiler ( -- )
X
X	(branch) ( -- ) compilation 
X	(?branch) ( flag -- ) compilation
X	(do) ( end start -- ) compilation
X	(?do) ( end start -- ) compilation
X	(loop) ( -- ) compilation
X	(+loop) ( increment -- ) compilation
X
X	(literal) ( -- literal) compilation
X	(.") ( -- string) compilation
X
X	(abort") ( flag -- ) compilation
X
X	(;) ( -- ) compilation
X	(does>) ( -- ) compilation
X
X	thread ( ptr -- ) 
X	unthread ( ptr1 -- ptr2)
X
X	>mark ( -- marker) compilation
X	<mark ( -- marker) compilation
X	>resolve ( marker -- ) compilation
X	<resolve ( marker -- ) compilation
X
XDESCRIPTION
X	Kernel compiler definitions isolated to a separate vocabulary 
X	to minimize dependencies and increase portability.
X
Xcompiler ( -- )
X	Vocabulary containing the compilation word set. Compiler 
X	support, compiled words and threading primitives.
X
X(branch) ( -- ) compilation 
X	Performs the run-time action of branching in threaded code. 
X	Literal succeeding this word contains a relative address to 
X	the next thread. 
X
X(?branch) ( flag -- ) compilation
X	Performs the run-time action of conditionally branching in 
X	threaded code. If the flag is zero a branch is performed
X	using a literal succeeding this word else the literal is 
X	skipped. 
X
X(do) ( end start -- ) compilation
X	Performs the run-time action of initializing for a loop block. 
X	Moves the two parameters, "end" and "start", to the return 
X	stack and a pointer to the relative address literal succeeding
X	this word so that "leave" may be performed in any section of
X	the looped block.
X
X(?do) ( end start -- ) compilation
X	Performs the run-time action of initializing for a loop block if
X	the "start" and "end" index are not equal else skips the block.
X	Moves the two parameters, "end" and "start", to the return 
X	stack and a pointer to the relative address literal succeeding
X	this word so that "leave" may be performed in any section of
X	the looped block.
X
X(loop) ( -- ) compilation
X	Performs the run-time action of incrementing the loop index and
X	checking it against the upper limit for the loop. If the index
X	is still within the loop limit a branch is performed back to the 
X	beginning of the loop. The branch offset is stored in-line 
X	directly after the "(loop)" thread.
X
X(+loop) ( increment -- ) compilation
X	Performs the same action as "(loop)" but uses the top of stack
X	value as the increment of the loop index. Checks if the loop
X	limit has been exceeded.
X
X(literal) ( -- literal) compilation
X	Pushes the in-line constant following the threaded code onto
X	the parameter stack.
X
X(.") ( -- string) compilation
X	Pushes the in-line string pointer following the threaded code
X	onto the parameter stack.
X
X(abort") ( flag -- ) compilation
X	Performs the run-time action of checking the error flag and
X	if non-zero, true, aborts the current computation. Uses an
X	in-line string to display an abort message.
X
X(;) ( -- ) compilation
X	Performs the run-time action of returning from a colon definition.
X
X(does>) ( -- ) compilation
X	Performs the run-time action of returning from the current colon
X	definition and setting the code type of the last defined entry
X	to be the code following "(does>)" thus giving it the right
X	run-time action.
X
Xthread ( ptr -- ) 
X	Used to create threaded code in the dictionary area. Allows code
X	to be written without considering the threading principle.
X
Xunthread ( ptr1 -- ptr2)
X	Given a reference to threaded code returns an unthreaded entry
X	pointer.
X
X>mark ( -- marker) compilation
X	Allocates space for a branch offset and marks it for forward
X	resolving.
X
X<mark ( -- marker) compilation
X	Marks the current position in the compilation code stream as
X	a position for backwards branch.
X
X>resolve ( marker -- ) compilation
X	Resolves a forward branch offset.
X
X<resolve ( marker -- ) compilation
X	Allocates space for and calculates a backward branch offset.
X
XSEE ALSO
X	forth(1)
X
XWARNING
X	Code written using this word set is not directly portable to
X	other forth environments.
X
XBUG
X	Pointers are not check. Illegal pointer value will result in
X	a possible error situation.	
X
XCOPYING
X	Copyright (C) 1989 Mikael R.K. Patel
X	Permission is granted to make and distribute verbatim copies
X	of this manual provided the copyright notice and this permission
X	notice are preserved on all copies.
X	Permission is granted to copy and distribute modified versions
X	of this manual under the conditions for verbatim copying, 
X	provided also that the section entitled "GNU General Public
X	License" is included exactly as in the original, and provided
X	that the entire resulting derived work is distributed under
X	the terms of a permission notice identical to this one.
X	Permission is granted to copy and distribute translations of
X	this manual into another language, under the above conditions
X	for modified versions, except that the section entitled "GNU
X	General Public License" may be included in a translation approved
X	by the author instead of in the original English.
X
XAUTHOR
X	Mikael R.K. Patel
X	Computer Aided Design Laboratory (CADLAB)
X	Department of Computer and Information Science
X	Linkoping University
X	S-581 83 LINKOPING
X	SWEDEN
X	Email: mip@ida.liu.se
END_OF_doc/compiler.doc
if test 5252 -ne `wc -c <doc/compiler.doc`; then
    echo shar: \"doc/compiler.doc\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f doc/debugger.doc -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"doc/debugger.doc\"
else
echo shar: Extracting \"doc/debugger.doc\" \(5780 characters\)
sed "s/^X//" >doc/debugger.doc <<'END_OF_doc/debugger.doc'
XDEBUGGER(2)	       FORTH LEVEL DEBUGGER FUNCTIONS 		     DEBUGGER(2)
X
XNAME
X	debugger - forth level debugger; trace, break and profile
X
XSYNOPSIS
X	#include debugger.f83
X
X	debugger ( -- )
X
X	ADVICE ( -- ) private
X	+block ( advice -- block) private
X	+entry ( advice -- entry) private
X	+advice ( advice -- advice) private
X	+profile ( advice -- profile) private
X
X	[advice] ( advice -- ) private
X	[colon] ( advice -- ) private
X	[trace] ( advice -- ) private
X	[break] ( advice -- ) private
X
X	tail-recurse ( -- ) compilation immediate
X
X	?advice ( entry -- flag)
X
X	advice ( action -- )
X	colon ( -- )
X	trace ( -- )
X	break ( -- )
X
X	.r ( n w -- )
X
X	.profile ( -- )
X
X	: ( -- )
X
XDESCRIPTION
X	Forth level debugger package. Allows basic black-box tracing of
X	colon definitions, break on function call and profiling of function
X	calls. The debugger is built on a general advice package so that
X	it may easily be extended with addition debugging functions. The
X	advice concept is a function may be asked for advice to handle a 
X	colon definition. The trace advice function wraps the function 
X	call in printing of the stack status and the name of the function.
X
Xdebugger ( -- )
X	Vocabulary containing the debugger definitions.
X
XADVICE ( -- ) private
X	The advice structure type. Allows general handling of execution
X	of code definitions.
X
X+block ( advice -- block) private
X	Access field to code block of advice colon definition. Stored
X	as a pointer to threaded code.
X
X+entry ( advice -- entry) private
X	Access field to entry with advice block. Allows access of entry
X	fields such as name, link, etc. Stored as a pointer to an entry.
X
X+advice ( advice -- advice) private
X	Access field to advice function which is called to handle the
X	code block. The advice function is call with execute thus it
X	is a pointer to an entry. Three predefined advice functions
X	are available for profiling, tracing and break points.
X	
X+profile ( advice -- profile) private
X	Access field to counter for number of function calls. Basic
X	profiling information. Updated by the advice primitives.
X
X[advice] ( advice -- ) private
X	Management function to allow interception of function call and
X	calling of advice function.
X
X[colon] ( advice -- ) private
X	Primitive advice function call for normal function call and
X	increment of profiling counter.
X
X[trace] ( advice -- ) private
X	Primitive advice function for black-box tracing of function
X	calls. The entry and exit of the function call are printed
X	together with the name of the function and the status of the
X	stack.
X
X[break] ( advice -- ) private
X	Primitive advice function which allows a simple break point
X	command loop. The commands are currently: a(bort), c(ontinue),
X	e(xecute), p(rofile) and r(eturn). The e(xecute) command calls
X	the function and returns to the break point command loop.
X	The e(xecute) performs the function in the normal manner
X	without returning to the command loop. The p(rofile) command
X	print the profile counter for the broken function. And last
X	the r(eturn) command exits the command loop without performing
X	the function.
X
Xtail-recurse ( -- ) compilation immediate
X	Redefinition of the tail recursion compilation word to make it
X	work correctly in this context.
X
X?advice ( entry -- flag)
X	Verifies that the entry passed as a parameter is an advice 
X	function.
X
Xadvice ( action -- )
X	Used in the form:
X		' <advice-action> advice <advice-colon-definition>
X	Make the parameter action the advice action for an advice
X	colon definition. The colon definition is verified before
X	the assignment is performed. The advice action should be
X	a function which receives an advice block and performs some
X	action on it. Resets the profile information.
X
Xcolon ( -- )
X	Used in the form:
X		colon <advice-colon-definition>
X	To make an advice colon definition a "normal" function again.
X	An error message is given if the succeeding symbol is not of 
X	correct type.
X
Xtrace ( -- )
X	Used in the form:
X		trace <advice-colon-definition>
X	To make an advice colon definition a traced function. An
X	error message is given if the succeeding symbol is not of 
X	correct type.
X
Xbreak ( -- )
X	Used in the form:
X		break <advice-colon-definition>
X	To make an advice colon definition function with a break point.
X	An error message is given if the succeeding symbol is not of 
X	correct type.
X
X.r ( n w -- )
X	Prints the number, "n", right aligned in a field with width, "w".
X
X.profile ( -- )
X	Scans through the vocabulary and prints the profile information
X	for advice functions. Prints the number of calls and the name
X	of the functions.
X
X: ( -- )
X	Redefinition of "colon" to allow easy debugging of "any" code
X	definitions without rewriting.
X
XSEE ALSO
X	compiler(1), blocks(2), structures(2), forth(1)
X
XCOPYING
X	Copyright (C) 1989 Mikael R.K. Patel
X	Permission is granted to make and distribute verbatim copies
X	of this manual provided the copyright notice and this permission
X	notice are preserved on all copies.
X	Permission is granted to copy and distribute modified versions
X	of this manual under the conditions for verbatim copying, 
X	provided also that the section entitled "GNU General Public
X	License" is included exactly as in the original, and provided
X	that the entire resulting derived work is distributed under
X	the terms of a permission notice identical to this one.
X	Permission is granted to copy and distribute translations of
X	this manual into another language, under the above conditions
X	for modified versions, except that the section entitled "GNU
X	General Public License" may be included in a translation approved
X	by the author instead of in the original English.
X
XAUTHOR
X	Mikael R.K. Patel
X	Computer Aided Design Laboratory (CADLAB)
X	Department of Computer and Information Science
X	Linkoping University
X	S-581 83 LINKOPING
X	SWEDEN
X	Email: mip@ida.liu.se
END_OF_doc/debugger.doc
if test 5780 -ne `wc -c <doc/debugger.doc`; then
    echo shar: \"doc/debugger.doc\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f doc/forth.doc -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"doc/forth.doc\"
else
echo shar: Extracting \"doc/forth.doc\" \(5999 characters\)
sed "s/^X//" >doc/forth.doc <<'END_OF_doc/forth.doc'
XFORTH(3)                 HIGH LEVEL EXTENSIONS TO FORTH	  	   	FORTH(1)
X
XNAME
X	forth - high level forth extensions
X
XSYNOPSIS
X	#include forth.f83
X
X	BITS/WORD ( -- n)
X	BYTES/WORD ( -- n)
X	
X	MIN_INT ( -- n)
X	MAX_INT ( -- n)
X
X	ENTRY ( -- )
X	+link ( entry -- link)
X	+name ( entry -- name)
X	+mode ( entry -- mode)
X	+code ( entry -- code)
X	+parameter ( entry -- parameter)
X
X	MODES ( -- )
X	IMMEDIATE ( -- field)
X	EXECUTION ( -- field)
X	COMPILATION ( -- field)
X	PRIVATE ( -- field)
X	RESERVED ( -- field)
X
X	CODES ( -- )
X	CODE ( -- 0)
X	COLON ( -- 1)
X	VARIABLE ( -- 2)
X	CONSTANT ( -- 3)
X	VOCABULARY ( -- 4)
X	CREATE ( -- 5)
X	USER ( -- 6)
X	LOCAL ( -- 7)
X	FORWARD ( -- 8)
X	FIELD ( -- 9)
X	EXCEPTION ( -- 10)
X
X	.entry ( entry -- )
X	.context ( -- )
X	.current ( -- )
X	.vocabulary ( -- )
X
XDESCRIPTION
X	High level definitions of internal data structures. These extensions
X	are very implementation dependent and caution must be take as code
X	written using these definitions is not directly portable.	
X
XBITS/WORD ( -- n)
X	Number of bits per word in stack data etc. TILE Forth is 32 bits.
X
XBYTES/WORD ( -- n)
X	Number of bytes per word. TILE Forth is 4 bytes per word.	
X
XMIN_INT ( -- n)
X	Minimum integer number in two complement of 32 bits.
X
XMAX_INT ( -- n)
X	Maximum integer number in two complement of 32 bits.
X
XENTRY ( -- )
X	Structure of vocabulary entries. 
X
X+link ( entry -- link)
X	Field access of link to predecessor entry in vocabulary list.
X	Stored as a pointer, ptr, on an "ENTRY".
X
X+name ( entry -- name)
X	Field access of name string of an entry. Stored as a pointer, 
X	ptr, on a null terminated string.
X
X+mode ( entry -- mode)
X	Field access of mode bit field of an entry. Stored as a number,
X	long, and access using bit fields. See "MODES" below.
X
X+code ( entry -- code)
X	Field access of code enumerative of an entry. Stored as a
X	number, enum. See "CODES" below. 
X
X+parameter ( entry -- parameter)
X	Field access of parameter part of entry structure. Stored as
X	a long. May contain a pointer to the body.
X
XMODES ( -- )
X	Bit field structure definition of possible set of mode. The 
X	kernel uses four bits and allows applications to use the
X	bits within the three most significant bytes (bit 8-31).
X
XIMMEDIATE ( -- field)
X	Access of immediate bit field in mode. If true then immediate.
X
XEXECUTION ( -- field)
X	Access of execution bit field in mode. If true then not visible
X	in execution mode.
X
XCOMPILATION ( -- field)
X	Access of compilation bit field in mode. If true then not visible
X	in compilation mode.
X
XRESERVED ( -- field)
X	Access of reserved bit field in mode. These bits of the mode
X	are reserved for the kernel. Bits 8-31 may be freely used by
X	applications.
X
XCODES ( -- )
X	Predefined code numbers. Used by the kernel, inner, to determine
X	management of primitives. Codes larger than "EXCEPTION" are 
X	regarded as pointers to forth level management code, and are 
X	used to implement "does>"-handling.
X
XCODE ( -- 0)
X	Numeral for machine level code management. The parameter field
X	of entry is a pointer to a subroutine implementing the function.
X
XCOLON ( -- 1)
X	Numeral for forth level code management. The parameter field
X	contains a pointer to the body of the definition.
X
XVARIABLE ( -- 2)
X	Numeral to mark variable management of entry. The parameter field
X	is used for the variable area.
X
XCONSTANT ( -- 3)
X	Numeral to mark constant management of entry. The parameter field
X	contains the constant value.
X
XVOCABULARY ( -- 4)
X	Numeral to mark vocabulary management of entry. The parameter field
X	contains a pointer to the latest defined entry in the vocabulary.
X	
XCREATE ( -- 5)
X	Numeral to mark create, symbol, management of entry. 
X	The parameter field contains a pointer to the data area 	
X	for the symbol.
X
XUSER ( -- 6)
X	Numeral to mark user management of entry. The parameter
X	field contains the offset from the task instance pointer.
X
XLOCAL ( -- 7)
X	Numeral to mark local variable management of entry. The
X	parameter field contains the offset within the current 
X	frame to the location of the argument or local variable.
X
XFORWARD ( -- 8)
X	Numeral to mark forward management of entry. The parameter
X	field contains initially a pointer to "abort" but this is
X	replaced if the entry is redefined later.
X
XFIELD ( -- 9)
X	Numeral to mark field management of entry. The parameter
X	field contains the field offset.
X
XEXCEPTION ( -- 10)
X	Numeral to mark exception variable management of entry. The
X	parameter field contains a pointer to the entry.
X
X.entry ( entry -- )
X	Given a pointer to an entry, prints all fields of the entry.
X
X.context ( -- )
X	Similar to "words" but prints the current state of the vocabulary
X	search set, "context".
X
X.current ( -- )
X	Prints the name of the current definitions vocabulary.
X
X.vocabulary ( -- )
X	Prints the name of the available vocabularies along the current
X	search path. Gives a list of available vocabularies to include.
X
XSEE ALSO
X	forth(1), string(1), enumerates(2), structures(2), bitfields(2)
X
XCOPYING
X	Copyright (C) 1989 Mikael R.K. Patel
X	Permission is granted to make and distribute verbatim copies
X	of this manual provided the copyright notice and this permission
X	notice are preserved on all copies.
X	Permission is granted to copy and distribute modified versions
X	of this manual under the conditions for verbatim copying, 
X	provided also that the section entitled "GNU General Public
X	License" is included exactly as in the original, and provided
X	that the entire resulting derived work is distributed under
X	the terms of a permission notice identical to this one.
X	Permission is granted to copy and distribute translations of
X	this manual into another language, under the above conditions
X	for modified versions, except that the section entitled "GNU
X	General Public License" may be included in a translation approved
X	by the author instead of in the original English.
X
XAUTHOR
X	Mikael R.K. Patel
X	Computer Aided Design Laboratory (CADLAB)
X	Department of Computer and Information Science
X	Linkoping University
X	S-581 83 LINKOPING
X	SWEDEN
X	Email: mip@ida.liu.se
END_OF_doc/forth.doc
if test 5999 -ne `wc -c <doc/forth.doc`; then
    echo shar: \"doc/forth.doc\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f doc/locals.doc -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"doc/locals.doc\"
else
echo shar: Extracting \"doc/locals.doc\" \(4261 characters\)
sed "s/^X//" >doc/locals.doc <<'END_OF_doc/locals.doc'
XLOCALS(1)             KERNEL ARGUMENT BINDING FUNCTIONS	   	       LOCALS(1)
X
XNAME
X	locals - kernel argument binding and local variable functions
X
XSYNOPSIS
X	locals ( -- )
X
X	(link) ( arguments -- frame) compilation
X	(unlink) ( frame return -- return) compilation
X	(unlink;) ( frame return -- return) compilation
X	(unlink>) ( frame return -- return) compilation
X	
X	(local) ( -- addr) compilation
X	(local@) ( -- value) compilation
X	(local!) ( value -- ) compilation
X
X	-> ( x -- ) compilation
X	exit ( -- ) compilation
X
X	{ ( -- ) immediate compilation
X
XDESCRIPTION
X	Kernel support for argument binding and local variables in
X	colon definitions. The virtual machine model support building
X	and disposing of argument frames.
X
Xlocals ( -- )
X	Vocabulary containing the argument binding and local variable
X	extension.
X
X(link) ( arguments -- frame) compilation
X	Compiled by "{" to perform the run-time action of building
X	the argument and local variable frame. These are built on the
X	parameter stack to minimize data movement. The frame consists
X	of the arguments and stack area for the local variables. The
X	old frame pointer and the top of stack are saved on the return
X	stack so that the stack and the frame pointer may be restored
X	after a definition using this extension.
X
X(unlink) ( frame return -- return) compilation
X	Drops the frame and move the return values down. The old
X	frame pointer and the top of stack at entry of the definition
X	are used to restore. 
X
X(unlink;) ( frame return -- return) compilation
X	Performs the same action as "(unlink)" but also leaves the 
X	definition. Is compiled by ";".
X
X(unlink>) ( frame return -- return) compilation
X	Performs the same action as "(unlink;)" but also performs
X	"(does>)". Is compiled by "does>".
X
X(local) ( -- addr) compilation
X	Using an inline literal offset within the current argument frame
X	returns the address of an argument or local variable.
X
X(local@) ( -- value) compilation
X	Using an inline literal offset within the current argument frame
X	access the value of an argument or local variable.
X
X(local!) ( value -- ) compilation
X	Using an inline literal offset within the current argument frame
X	store "value" to an argument or local variable.	
X
X-> ( x -- ) compilation
X	Assigns an argument or a local variable. Used in the
X	following manner:
X		<value> -> <frame-variable>
X	
Xexit ( -- ) compilation
X	Performs the equivalent action of the normal "exit" but also
X	restores the stack after argument binding and local variables.
X
X{ ( -- ) immediate compilation
X	Starts the named argument and local variable compiler. Used
X	in the following way:
X		{ <argument-names> | <local-names> -- <any> }
X	or 
X		{ <argument-names> | <local-names> }
X	or
X		{ <argument-names> -- <any> }
X	or
X		{ <argument-names> }
X	or
X		{ | <local-names> -- <any> }
X	or
X		{ | <local-names> }
X	The different parts are optional. The only restriction is
X	that the definition is ended by "}" or "--". In the "--" case
X	characters until "}" are skipped. 
X
XSEE ALSO
X	forth(1)
X
XWARNING
X	Code written using this word set is not directly portable to
X	other forth environments.
X
XBUG
X	Pointers are not check. Illegal pointer value will result in
X	a possible error situation.	
X
XCOPYING
X	Copyright (C) 1989 Mikael R.K. Patel
X	Permission is granted to make and distribute verbatim copies
X	of this manual provided the copyright notice and this permission
X	notice are preserved on all copies.
X	Permission is granted to copy and distribute modified versions
X	of this manual under the conditions for verbatim copying, 
X	provided also that the section entitled "GNU General Public
X	License" is included exactly as in the original, and provided
X	that the entire resulting derived work is distributed under
X	the terms of a permission notice identical to this one.
X	Permission is granted to copy and distribute translations of
X	this manual into another language, under the above conditions
X	for modified versions, except that the section entitled "GNU
X	General Public License" may be included in a translation approved
X	by the author instead of in the original English.
X
XAUTHOR
X	Mikael R.K. Patel
X	Computer Aided Design Laboratory (CADLAB)
X	Department of Computer and Information Science
X	Linkoping University
X	S-581 83 LINKOPING
X	SWEDEN
X	Email: mip@ida.liu.se
END_OF_doc/locals.doc
if test 4261 -ne `wc -c <doc/locals.doc`; then
    echo shar: \"doc/locals.doc\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f doc/structures.doc -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"doc/structures.doc\"
else
echo shar: Extracting \"doc/structures.doc\" \(6744 characters\)
sed "s/^X//" >doc/structures.doc <<'END_OF_doc/structures.doc'
XSTRUCTURES(2)         	STRUCTURE DEFINITION FUNCTIONS     	   STRUCTURES(2)
X
XNAME
X	structures - aggregated data definitions
X
XSYNOPSIS
X	#include structures.f83
X
X	structures ( -- )
X
X	+size ( struct -- size) private
X	+initiate ( struct -- initiate) private
X
X	as ( -- struct) immediate
X	this ( -- ptr)
X
X	initiate ( ptr struct -- )
X	make ( struct -- ptr)
X	new ( -- ptr) immediate
X
X	sizeof ( -- size) immediate
X	assign ( x y -- ) immediate
X
X	struct.type ( -- )
X	bytes ( n -- )
X	align ( -- )
X	field ( bytes -- )
X	struct ( -- )
X	byte ( -- )
X	word ( -- )
X	long ( -- )
X	ptr ( -- )
X	enum ( -- )
X	struct.init ( -- )
X	struct.does ( -- ) immediate compilation
X	struct.end ( -- ) immediate
X
XDESCRIPTION
X	Allows composition of data field description to build structures.
X
Xstructures ( -- )
X	Vocabulary for structure type functions.
X
X+size ( struct -- size) private
X	Field for accessing the size of a structure type. This field is
X	a long containing the number of bytes to allocate for an instance
X	of the structure type.
X
X+initiate ( struct -- initiate) private
X	Field for accessing the initialization code of a structure type.
X  	This field is a ptr containing a pointer to the initialization 
X	code for the structure type. A zero value, nil, indicates that 
X	the structure type does not perform initialization.
X
Xas ( -- struct) immediate
X	Used as:
X		as <struct-type>
X	Returns the address of the body of the structure type information.
X
Xthis ( -- ptr)
X	Returns the compilation address of the latest defined word.
X
Xinitiate ( ptr struct -- )
X	Take a pointer to a memory area and initializes it according to 
X	the initialization code for the structure type given as the second
X	parameter.
X
Xmake ( struct -- ptr)
X	Given a pointer to a structure type information block, as generated
X	by "as", allocates memory in the dictionary and initializes it.
X 	
Xnew ( -- ptr) immediate
X	Used as:
X		new <struct-type>
X	Performs the corresponding function as "make" but takes the 
X	preceding word to be a defined structure type.
X
Xsizeof ( -- size) immediate
X	Used as:
X		sizeof <struct-type>
X	or	
X		sizeof <prim-type>
X	Returns the size, in bytes, of the preceding structure or 
X	primitive type. The primitive types are defined below.
X
Xassign ( x y -- ) immediate
X	Used as:
X		x y assign <struct-type>
X	or
X		x y assign <prim-type>
X	Assigns the structure or primitive pointed to by "y" the value 
X	of "x".
X
Xstruct.type ( -- )
X	Used as:
X		struct.type <struct-type>
X		  <struct-layout>
X		struct.init ( self -- )
X		  <inititialization-code>
X		struct.does ( self -- )
X	          <instance-code>
X	        struct.end
X	and then:
X		<struct-type> <instance-name>
X	Starts the definition of a structure type. The layout
X	section <struct.layout> may contain the words;
X		n bytes	<field-name>
X	Allocates "n" bytes,
X		byte <field-name>
X	a byte,
X		word <field-name>
X	a word,
X		long <field-name>
X	a long,
X		ptr <field-name>
X	a pointer,
X		enum <field-name>
X	an enumerative, and
X		struct <struct-type> <field-name>
X	a structure. To align a field to even address us:
X		align.
X	The initialization code receives a pointer to the block to
X	initialize and any additional parameters. Thus additional memory
X	may be allocated directly after the block. If the structure
X	contains structure fields these should be initialized by the
X	initialization code. For this "as" and "initiate" are used:
X		<struct-field> as <struct-type> initiate
X	The normal action performed by a instance of a structure
X	type is to return the address to the instance. The optional
X	"struct.does" part redefines the normal action of a created
X	structure block. It receives a pointer to the instance as
X	parameter and any additional parameters. The parts 
X	"struct.init" and "struct.does" are optional.
X	
Xbytes ( n -- )
X	Used as:
X		<number> bytes <field-name>
X	within a structure type definition. Creates a field access
X	name to a <number> of bytes.
X
Xalign ( -- )
X	Used within a structure type definition to align the current
X	field address to an even address. 
X
Xfield ( bytes -- )
X	Used as:
X		<bytes> field <field-type>
X	to create additional field types other than "byte" etc.
X
Xstruct ( -- )
X	Used as:
X		struct <struct-type> <field-name>
X	within a structure type definition. Creates an access field name
X	to a structure. The structure is not initialized automatically
X	by the structure type. This should be performed by the initial-
X	ization code of the structure type it is a part of.
X
Xbyte ( -- )
X	Used as:
X		byte <field-name>
X	within a structure type definitions. Creates an access field name
X	to a byte.
X
Xword ( -- )
X	Used as:
X		word <field-name>
X	within a structure type definitions. Creates an access field name
X	to a word, two bytes.
X
Xlong ( -- )
X	Used as:
X		long <field-name>
X	within a structure type definitions. Creates an access field name
X	to a long, four bytes.
X
Xptr ( -- )
X	Used as:
X		ptr <field-name>
X	within a structure type definitions. Creates an access field name
X	to a pointer, four bytes.
X
Xenum ( -- )
X	Used as:
X		enum <field-name>
X	within a structure type definitions. Creates an access field name
X	to a enumerate, four bytes.
X
Xstruct.init ( -- )
X	Used within a structure type definitions to define the end of the
X	structure layout and the beginning of the initialization code. At
X	run-time the code receives a pointer to the instance as parameter.
X
Xstruct.does ( -- ) immediate compilation
X	Used within a structure type definition to define the end of the 
X	structure layout or initialization code and the beginning of the
X	instance action code. At run-time, performed for the instance,
X	the code receives a pointer to the instance as parameter.
X
Xstruct.end ( -- ) immediate
X	Used to end a structure type definition.
X
XSEE ALSO
X	forth(1)
X
XCOPYING
X	Copyright (C) 1989 Mikael R.K. Patel
X	Permission is granted to make and distribute verbatim copies
X	of this manual provided the copyright notice and this permission
X	notice are preserved on all copies.
X	Permission is granted to copy and distribute modified versions
X	of this manual under the conditions for verbatim copying, 
X	provided also that the section entitled "GNU General Public
X	License" is included exactly as in the original, and provided
X	that the entire resulting derived work is distributed under
X	the terms of a permission notice identical to this one.
X	Permission is granted to copy and distribute translations of
X	this manual into another language, under the above conditions
X	for modified versions, except that the section entitled "GNU
X	General Public License" may be included in a translation approved
X	by the author instead of in the original English.
X
XAUTHOR
X	Mikael R.K. Patel
X	Computer Aided Design Laboratory (CADLAB)
X	Department of Computer and Information Science
X	Linkoping University
X	S-581 83 LINKOPING
X	SWEDEN
X	Email: mip@ida.liu.se
END_OF_doc/structures.doc
if test 6744 -ne `wc -c <doc/structures.doc`; then
    echo shar: \"doc/structures.doc\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f error.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"error.c\"
else
echo shar: Extracting \"error.c\" \(4724 characters\)
sed "s/^X//" >error.c <<'END_OF_error.c'
X/*
X  C BASED FORTH-83 MULTI-TASKING KERNEL ERROR MANAGEMENT 
X
X  Copyright (c) 1989 by Mikael Patel
X
X  Computer Aided Design Laboratory (CADLAB)
X  Department of Computer and Information Science
X  Linkoping University
X  S-581 83 LINKOPING
X  SWEDEN
X
X  Email: mip@ida.liu.se
X  
X  Started on: 7 March 1989
X
X  Last updated on: 7 December 1988
X
X  Dependencies:
X       (cc) signal.h, fcntl.h, kernel.h, memory.h, io.h, and error.h 
X
X  Description:
X       Handles low level signal to error message conversion and printing.
X       Low level signals from run-time environment are transformation
X       to forth level exceptions and may be intercepted.
X  
X  Copying:
X       This program is free software; you can redistribute it and/or modify
X       it under the terms of the GNU General Public License as published by
X       the Free Software Foundation; either version 1, or (at your option)
X       any later version.
X
X       This program is distributed in the hope that it will be useful,
X       but WITHOUT ANY WARRANTY; without even the implied warranty of
X       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X       GNU General Public License for more details.
X
X       You should have received a copy of the GNU General Public License
X       along with this program; see the file COPYING.  If not, write to
X       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
X
X*/
X
X#include <signal.h>
X#include <fcntl.h>
X#include "kernel.h"
X#include "memory.h"
X#include "error.h"
X#include "io.h"
X
X
X/* ENVIRONMENT FOR LONGJMP AND RESTART AFTER ERROR SIGNAL */
X
Xjmp_buf restart;
X
X
X/* SIGNAL MESSAGE TABLE AND SIZE */
X
X#define SIGNALMSGSIZE 20
X
Xstatic char *signalmsg[SIGNALMSGSIZE] = {
X    "io error",
X    "hangup",
X    "interrupt",
X    "quit",
X    "illegal instruction",
X    "trace trap",
X    "abort",
X    "emulator trap",
X    "arithmetric exception",
X    "kill",
X    "bus error",
X    "segmentation violation",
X    "bad argument to system call",
X    "write to a pipe or other socket with no one to read it",
X    "alarm clock",
X    "software termination",
X    "urgent condition on IO channel",
X    "sendable stop signal not from tty",
X    "stop signal from tty",
X    "continue after stop"
X    };
X
X
Xvoid error_signal(sig)
X    long sig;
X{
X    /* Check which task received the signal */
X    if (tp == foreground)
X	(void) printf("foreground#%d: ", foreground);
X    else
X	(void) printf("task#%d: ", tp);
X
X    /* Print the signal number and a short description */
X    if (sig < SIGNALMSGSIZE)
X	(void) printf("signal#%d: %s\n", sig, signalmsg[sig]);
X    else
X	(void) printf("exception#%d: %s\n", sig, ((ENTRY *) sig) -> name);
X
X    /* Abort the current virtual machine call */
X    doabort();
X}
X
Xvoid error_fatal(sig)
X    int sig;			/* Signal number */
X{
X    /* Notify the error signal */
X    error_signal((long) sig);
X
X    /* Clean up the mess after all the packages */
X    io_finish();
X    error_finish();
X    kernel_finish();
X    memory_finish();
X    
X    /* Exit and pass on the signal number */
X    exit(sig);
X}
X
Xvoid error_restart(sig)
X    int sig;			/* Signal number */
X{
X    /* Check the type of signal and perform an appropriate action */
X    switch (sig) {
X      case SIGTSTP:
X	(void) fcntl(STDIN, F_SETFL, 0);
X	(void) kill(getpid(), SIGSTOP);
X	return;
X      case SIGCONT:
X	(void) fcntl(STDIN, F_SETFL, FNDELAY);
X	return;
X      default:
X	/* Check if the lowest file descriptor is a tty */
X	if (isatty(io_fstack[0] -> fd)) {
X	    
X	    /* Close all other files */
X	    io_flush();
X
X	    /* Check for interrupt in input management */
X	    if (sig == SIGINT && !running) {
X
X		/* Notify the type of signal */
X		error_signal((long) sig);
X	    }
X	    else
X		/* Warm start the kernel and pass on the signal number */
X		longjmp(restart, sig);	
X	}
X	else error_fatal(sig);
X    }
X}
X
Xvoid error_initiate()
X{
X    /* Add error_fatal and error_restart as signal handlers */
X    (void) signal(SIGHUP,  error_fatal);
X    (void) signal(SIGINT,  error_restart);
X    (void) signal(SIGQUIT, error_restart);
X    (void) signal(SIGILL,  error_restart);
X    (void) signal(SIGTRAP, error_fatal);
X    (void) signal(SIGIOT,  error_fatal);
X    (void) signal(SIGEMT,  error_fatal);
X    (void) signal(SIGFPE,  error_restart);
X    (void) signal(SIGBUS,  error_restart);
X    (void) signal(SIGSEGV, error_restart);
X    (void) signal(SIGSYS,  error_restart);
X    (void) signal(SIGPIPE, error_restart);
X    (void) signal(SIGALRM, error_restart);
X    (void) signal(SIGTERM, error_fatal);
X    (void) signal(SIGURG,  error_restart);
X    (void) signal(SIGSTOP, error_fatal);
X    (void) signal(SIGTSTP, error_restart);
X    (void) signal(SIGCONT, error_restart);
X}
X
Xvoid error_finish()
X{
X    /* Future clean up function for the error package */
X}
X
END_OF_error.c
if test 4724 -ne `wc -c <error.c`; then
    echo shar: \"error.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f forth.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"forth.c\"
else
echo shar: Extracting \"forth.c\" \(4251 characters\)
sed "s/^X//" >forth.c <<'END_OF_forth.c'
X/*
X  C BASED FORTH-83 MULTI-TASKING KERNEL APPLICATION: TILE FORTH
X
X  Copyright (c) 1989 by Mikael R.K. Patel
X
X  Computer Aided Design Laboratory (CADLAB)
X  Department of Computer and Information Science
X  Linkoping University
X  S-581 83 LINKOPING
X  SWEDEN
X
X  Email: mip@ida.liu.se
X  
X  Started on: 30 June 1988
X
X  Last updated on: 28 November 1989
X
X  Dependencies:
X       (cc) kernel.h, error.h, memory.h, and io.h
X
X  Description:
X       A 32-bit Forth-83 Standard written in C. Illustrating the use of
X       the multi-tasking forth kernel, memory, io and error packages. 
X  
X       Allows parameters to be given to forth and selection of inter-
X       action symbol. Thus providing the basic interface for making forth
X       programs act as compile-and-go applications.
X
X  Copying:
X       This program is free software; you can redistribute it and/or modify
X       it under the terms of the GNU General Public License as published by
X       the Free Software Foundation; either version 1, or (at your option)
X       any later version.
X
X       This program is distributed in the hope that it will be useful,
X       but WITHOUT ANY WARRANTY; without even the implied warranty of
X       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X       GNU General Public License for more details.
X
X       You should have received a copy of the GNU General Public License
X       along with this program; see the file COPYING.  If not, write to
X       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
X
X*/
X
X
X/* EXTERNAL DEFINITIONS */
X
X#include "kernel.h"
X#include "error.h"
X#include "memory.h"
X#include "io.h"
X
X
X/* VERSION BANNER */
X
X#define BANNER	"TILE Forth version 2.48, Copyright (c) 1989, by Mikael Patel\n"
X
X
X/* STRUCTURE SIZES */
X
X#define DICTIONARYSIZE 128L * 1024L
X#define USERSIZE 1024
X#define PARAMSIZE 1024
X#define RETURNSIZE 1024
X
X
X/* ACCESS TO APPLICATION ARGUMENTS */
X
Xstatic long  ARGC;
Xstatic long *ARGV;
Xstatic long  ARGS;
Xstatic char *ARGI;
X
X
X/* APPLICATION IO DISPATCH. RUN ON IO-WAIT FOR PERIODICAL ACTIONS */
X
Xvoid io_dispatch()
X{
X    /* Any application action which requires periodical attention */
X}
X
X
X/* EXAMPLE OF APPLICATION VOCABULARY */
X
Xvoid doarguments()
X{
X    spush(ARGC - ARGS);
X}
X
XNORMAL_CODE(arguments, forth, "argc", doarguments);
X
Xvoid doargument()
X{
X    if (!tos && !ARGI)
X	tos = *(long *) ARGV;
X    else
X	tos = *((long *) (long) ARGV + tos + ARGS);
X}
X
XNORMAL_CODE(argument, arguments, "argv", doargument);
X
X
X/* MAIN WITH APPLICATION STARTUP OF FORTH TOP-LOOP */
X
Xmain(argc, argv)
X    int argc;
X    char *argv[];
X{
X    long i;
X    
X    /* Initiate memory, error, io, and kernel */
X    memory_initiate(DICTIONARYSIZE);
X    error_initiate();
X    io_initiate(BANNER);
X    kernel_initiate(&argument, &arguments, USERSIZE, PARAMSIZE, RETURNSIZE);
X    /* Arguments: first, last, user area, parameter and return stack size */
X    
X    /* Set up argument counter and pointer */
X    ARGC = argc;
X    ARGV = (long *) argv;
X    ARGS = argc - 1;
X    ARGI = (char *) 0;
X    
X    /* Load argument files before taking input from standard input */
X    for(i = 1; i < argc; i++) {
X
X	/* Look for argument or start symbol switch */
X	if (STREQ(argv[i], "-a")) {
X	    ARGS = i;
X	    i = argc;
X	}
X	else {
X	    if (STREQ(argv[i], "-s")) {
X		ARGI = argv[i + 1];
X		ARGS = i + 1;
X		i = argc;
X	    }
X	    else {
X
X		/* Use the argument as an input file name and try loading it*/
X		if (io_infile(argv[i]) == IO_UNKNOWN_FILE) {
X		    (void) printf("%s: file not found\n", argv[i]);
X		    kernel_finish();
X		    io_finish();
X		    error_finish();
X		    memory_finish();
X		    exit(0);
X		}
X		else 
X		    doquit();
X	    }
X	}
X    }
X
X    /* Use standard input as input stream */
X    (void) io_infile((char *) STDIN);
X
X    /* Check if there was a start symbol argument */
X    if (ARGI) {
X
X	/* Find the symbol in the vocabulary */
X	verbose = FALSE;
X	spush((long) ARGI);
X	dofind();
X	if (tos) {
X	    dodrop();
X	    docommand();
X	}
X	else
X	    (void) printf("%s ??\n", ARGI);
X    }
X    else {
X	/* Else start the normal interaction loop */
X	verbose = TRUE;
X	doquit();
X    }
X
X    /* Clean up the kernel, io, error and memory package before exit */
X    kernel_finish();
X    io_finish();
X    error_finish();
X    memory_finish();
X}
X
END_OF_forth.c
if test 4251 -ne `wc -c <forth.c`; then
    echo shar: \"forth.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/debugger.f83 -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"src/debugger.f83\"
else
echo shar: Extracting \"src/debugger.f83\" \(4700 characters\)
sed "s/^X//" >src/debugger.f83 <<'END_OF_src/debugger.f83'
X\
X\  FORTH DEBUGGER DEFINITIONS
X\
X\  Copyright (c) 1989 by Mikael R.K. Patel
X\
X\  Computer Aided Design Laboratory (CADLAB)
X\  Department of Computer and Information Science
X\  Linkoping University
X\  S-581 83 LINKOPING
X\  SWEDEN
X\
X\  Email: mip@ida.liu.se
X\
X\  Started on: 30 June 1988
X\
X\  Last updated on: 29 November 1989
X\
X\  Dependencies:
X\       (forth) forth, compiler, structures, blocks
X\
X\  Description:
X\       Basic debugging function built on a general advice function
X\       management. Allows black-box tracing, break points and
X\       colon definitions call profiling.
X\
X\  Copying:
X\       This program is free software; you can redistribute it and\or modify
X\       it under the terms of the GNU General Public License as published by
X\       the Free Software Foundation; either version 1, or (at your option)
X\       any later version.
X\
X\       This program is distributed in the hope that it will be useful,
X\       but WITHOUT ANY WARRANTY; without even the implied warranty of
X\       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X\       GNU General Public License for more details.
X\
X\       You should have received a copy of the GNU General Public License
X\       along with this program; see the file COPYING.  If not, write to
X\       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
X
X.( Loading Debugger definitions...) cr
X
X#include structures.f83
X#include forth.f83
X#include blocks.f83
X
Xvocabulary debugger
X
Xcompiler blocks structures forth debugger definitions
X
Xstruct.type ADVICE ( -- )
X  ptr  +block private			( Pointer to code definition)
X  ptr  +entry private			( Pointer to entry structure)
X  ptr  +advice private			( Pointer to advice function)
X  long +profile private			( Call counter for profiling)
Xstruct.end
X
X: [advice] ( advice -- )
X  dup +advice @ execute ; private	( Access and execute the advice)
X
X: [colon] ( advice -- )
X  1 over +profile +!			( Increment profile counter)
X  +block @ call ; private		( Call the code definition)
X
X: [trace] ( advice -- )
X  ." --> " dup >r +entry @ .name .s cr	( Print function entry)
X  r@ [colon]				( Call the code definition)
X  ." <-- " r> +entry @ .name .s cr 	( Print function exit)
X; private
X
X: [break] ( advice -- )
X  >r					( Save pointer to advice block)
X  begin
X    .s ."  Break at: "			( Print stack status and break)
X    r@ +entry @ .name cr		( Print name of entry)
X    [compile] ascii			( Scan a command)
X    case
X      ascii a				( Abort command)
X        of abort endof
X      ascii c				( Call command)
X	of r> [colon] exit endof
X      ascii e				( Execute command)
X        of r@ [colon] endof
X      ascii p				( Profile command)
X        of r@ +profile @ . cr endof
X      ascii r				( Return command)
X	of r> drop exit endof
X      ." a(bort), c(ontinue), e(xecute), p(rofile) or r(eturn)" cr
X   endcase
X  again ; private
X
X: tail-recurse ( -- )
X  compile (branch)			( Compile a branch to the beginning)
X  last >body +block @ <resolve		( And resolve the address)
X; compilation immediate
X
X: ?advice ( entry -- flag)
X  +code @ ['] [advice] >body = ;	( Check for advice handler)
X
X: advice ( action -- )
X  ' dup ?advice not			( Access entry and check coding)
X  abort" advice: not an adviced definition" ( Abort if wrong code type)
X  >body					( Access advice block)
X  0 over +profile !			( Initiate the profile counter)
X  +advice ! ;				( Define a new advice action)
X
X: colon ( -- )
X  ['] [colon] advice ;			( Use colon as the advice action)
X
X: trace ( -- )
X  ['] [trace] advice ;			( Use trace as the advice action)
X
X: break ( -- )
X  ['] [break] advice ;			( Use break as the advice action)
X
X: .r ( n w -- )
X  >r <# #s #> r> over - spaces type ;	( Formated printing of numbers)
X
X: .profile ( -- )
X  last					( Print profile for all definitions)
X  5 spaces ." Calls"			( Print a profile header with calls and)
X  1 spaces ." Function" cr		( last the name of the function)
X  begin
X    dup ?advice				( Check for adviced function)
X    if dup >body +profile @		( Access profile information)
X      10 .r space			( Print in a nice format)
X      dup .name cr			( Print name)
X    then
X    +link @ ?dup nil =			( Print information about all functions)
X  until ;				( in the current search path)
X      
X: : ( -- )
X  :					( Use the old colon definition)
X  new ADVICE				( Create an advice block)
X  dup last +parameter !			( Store the advice block into the last)
X  ['] [advice] >body last +code !	( Make the last entry use the advice)
X  last over +entry !			( Save pointer to the entry)
X  ['] [colon] over +advice !		( Colon is the initiate advice action)
X  0 over +profile !			( Initiate the profile counter)
X  here swap +block ! ;			( Setup pointer to block definition)
X
Xforth only
X
END_OF_src/debugger.f83
if test 4700 -ne `wc -c <src/debugger.f83`; then
    echo shar: \"src/debugger.f83\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tile.1 -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"tile.1\"
else
echo shar: Extracting \"tile.1\" \(5558 characters\)
sed "s/^X//" >tile.1 <<'END_OF_tile.1'
X.\" 
X.TH TILE 1 "30 November 1989" "Version 2.48"
X.SH NAME
Xtile \- c based forth-83 standard programming environment
X.SH SYNOPSIS
X.B forth
X.RI "[\|" file " .\|.\|.\|]"
X.RB "[\|" \-a
X.IR argument " .\|.\|.\|]"
X.br
X.B forth
X.RI "[\|" file " .\|.\|.\|]"
X.RB "[\|" \-s
X.IR start-symbol "\|]"
X.RI "[\|" argument " .\|.\|.\|]"
X.SH DESCRIPTION
X.I forth
Xuses a command syntax much like a compiler. The 
X.I file
Xarguments are loaded before the interaction top loop is started. A
X.I start\-symbol
Xmay also be given as an argument thus allowing
X.I forth
Xto act as a `compile-and-go' compiler of applications. An extra 
Xoptions or parameters passed to 
X.I forth 
Xmay be accessed by the application. As extensions of the Forth-83 Standard
X.I forth
Xsupports multi-tasking, exceptions, vocabulary casting, private definitions, 
Xargument binding and local variables. Written in C the kernel may
Xbe used as a general purpose environment for interactive testing of
XC-code.
X.LP
XTo provide an interactive programming environment for developing programs
X.I forth
Xmay be run as a sub-process to GNU Emacs in a specialized
X.I forth\-mode.
XSource code may be edited and directly tested by passing either
Xa paragraph of code or a whole buffer to 
X.I forth
Xfrom Emacs. The 
X.I forth\-mode
Xalso supports documentation retrieval and automatic indentation of
Xforth code, comments and definitions.
X.LP
XAn environment variable is used to specify file search paths thus
Xliberating and supporting management of libraries of source code.
X.I forth
Xcompiles faster than most compilers link with approx. 50.000 lines per
Xminute on a SUN-3/60, thus code is only saved in source form. 
X.SH OPTIONS
X.TP 
X.BI \-a " argument .\|.\|."
XAllows access of the rest of the arguments. The first arguments is the string
X.I forth\. 
X.TP
X.BI \-s " start-symbol "
XDefines the symbol to be used instead of the normal interaction top loop. 
XThe
X.I start\-symbol
Xbecomes the first argument and any further arguments may be accessed by the
Xapplication. The library contains some examples of argument fetching functions.
X.SH LIBRARIES
XThe
X.I tile
Xenvironment has currently three directories with forth-83 source, test and
Xexample code and documentation. The directory
X.I src
Xcontains Forth-83 source code library, consisting of a number of
Xdata modelling, and debugging tools, and high level multi-tasking 
Xconstructs such as semaphores, channels and task types. Documentation 
Xof the source code and the kernel are found in the directory
X.I doc. 
XTest programs for and example of usage of the source library code may be
Xfound in the directory
X.I tst.
X.SH FILES
X.PD 0
X.TP 20
X.B file.f83
XForth-83 source input file
X.TP
X.B file.doc
XForth-83 source documentation file
X.TP
X.B file.tst
XForth-83 source test file
X.TP
X.B kernel.c..h
Xmulti-tasking c based Forth-83 kernel
X.TP
X.B error.c..h
Xerror management package
X.TP
X.B io.c..h
Xmulti-tasking input package
X.TP
X.B memory.c..h
Xmemory management package
X.TP
X.B forth.c
Xthis application
X.TP
X.B forth.doc
Xdocumentation of extensions
X.TP
X.B forth.el
XGNU Emacs forth-mode source
X.TP
X.B tile.1
Xthis manual
X.TP
X.B Makefile
Xputs the forth application together
X.PD
X.SH ENVIRONMENT
X.TP 20
X.B TILEPATH
XSearch path for library source files. A normal setting is 
X`.:~/tile/src:~/tile/tst' which will allow the file include function in 
X.I forth
Xto locate library source files in current directory, the standard library, 
Xand the test code library. 
X.I forth
Xalso looks for files at the users home directory.
X.SH GNU EMACS FORTH MODE
XThe GNU Emacs forth-mode supports interactive programming, automatic 
Xindentation of source code, and documentation search of the
X.I forth
Xkernel and library within Emacs. To allow automatic loading of mode your 
X.I .emacs
Xfile should contain the following definitions;
X.LP
X.br
X  (set-variable 'load-path
X                (append load-path
X                        '(nil "~/tile")))
X.br
X  (setq forth-help-load-path '(nil "~/tile/doc"))
X.br
X  (setq auto-mode-alist
X.br
X        (append '(("\\.tst$" . forth-mode)
X.br
X		  	  ("\\.f83$" . forth-mode))
X.br
X			  auto-mode-alist))
X.br
X  (autoload 'forth-mode "forth")
X.LP
XFurther documentation about the 
X.I forth\-mode
Xmay be found by giving the command `M-x describe-mode' in Emacs. 
X.SH BUGS
XBugs should be reported to mip@ida.liu.se. Bugs tend actually to be
Xfixed if they can be isolated, so it is in your interest to report them
Xin such a way that they can be easily reproduced according to
Xget newer version.
X.SH COPYING
XCopyright (C) 1989 Mikael R.K. Patel
X.br
XPermission is granted to make and distribute verbatim copies
Xof this manual provided the copyright notice and this permission
Xnotice are preserved on all copies.
X.br
XPermission is granted to copy and distribute modified versions
Xof this manual under the conditions for verbatim copying, 
Xprovided also that the section entitled "GNU General Public
XLicense" is included exactly as in the original, and provided
Xthat the entire resulting derived work is distributed under
Xthe terms of a permission notice identical to this one.
X.br
XPermission is granted to copy and distribute translations of
Xthis manual into another language, under the above conditions
Xfor modified versions, except that the section entitled "GNU
XGeneral Public License" may be included in a translation approved
Xby the author instead of in the original English.
X.SH AUTHORS
XMikael R.K. Patel
X.br
XComputer Aided Design Laboratory (CADLAB)
X.br
XDepartment of Computer and Information Science
X.br
XLinkoping University
X.br
XS-581 83 LINKOPING
X.br
XSWEDEN
X.br
XEmail: mip@ida.liu.se
END_OF_tile.1
if test 5558 -ne `wc -c <tile.1`; then
    echo shar: \"tile.1\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 3 \(of 7\).
cp /dev/null ark3isdone
MISSING=""
for I in 1 2 3 4 5 6 7 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 7 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0