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 1 (of 7)."
# Contents: .forthicon README RELEASES doc doc/memory.doc error.h
# forthtool io.h memory.c memory.h src src/blocks.f83
# src/enumerates.f83 tst tst/bitfields.tst tst/blocks.tst
# tst/bubble-sort.tst tst/byte-sieve.tst tst/channels.tst
# tst/colburn-sieve.tst tst/debugger.tst tst/enumerates.tst
# tst/exceptions.tst tst/fibonacci.tst tst/locals.tst tst/macros.tst
# tst/matrix-mult.tst tst/permutations.tst tst/queues.tst
# tst/ranges.tst tst/rendezvous.tst tst/semaphores.tst
# tst/structures.tst tst/task-sieve.tst tst/towers-of-hanoi.tst
# Wrapped by mip@massormetrix on Mon Dec 18 18:40:08 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f .forthicon -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \".forthicon\"
else
echo shar: Extracting \".forthicon\" \(1933 characters\)
sed "s/^X//" >.forthicon <<'END_OF_.forthicon'
X/* Format_version=1, Width=64, Height=64, Depth=1, Valid_bits_per_item=16
X */
X 0xFFFF,0xFFFF,0xFFFF,0xFFFF,0x8000,0x0000,0x0000,0x0001,
X 0x8000,0x0000,0x0000,0x0001,0x8000,0x0000,0x0000,0x0001,
X 0x8FFF,0xFFFF,0xF800,0x0001,0x8800,0x0000,0x0800,0x0001,
X 0x8800,0x0000,0x0800,0x0001,0x8804,0x0000,0x0800,0x0001,
X 0x8804,0x0000,0x0800,0x0001,0x8834,0x8960,0x0800,0x0001,
X 0x884C,0x8991,0xC800,0x0001,0x8844,0x8912,0x3E00,0x0001,
X 0x8844,0x8912,0x69E0,0x0001,0x8844,0x8912,0x281E,0x0001,
X 0x884C,0x9991,0xC801,0x8001,0x8834,0x6960,0x0800,0x4001,
X 0x8800,0x0100,0x0800,0x4001,0x8800,0x0100,0x0800,0x2001,
X 0x8800,0x0100,0x0800,0x2001,0x8800,0x0000,0x0800,0x2001,
X 0x8FFF,0xFFFF,0xF800,0x2001,0x8000,0x0000,0x0000,0x2001,
X 0x8000,0x0000,0x0000,0x4001,0x8000,0x0000,0x0000,0x4001,
X 0x8000,0x0000,0x0000,0x8001,0x8000,0x0000,0x0003,0x0001,
X 0x8000,0x0000,0x0004,0x0001,0x8000,0x0000,0x0008,0x0001,
X 0x8000,0x0FFF,0xFFFF,0xF001,0x8000,0x0800,0x0000,0x1001,
X 0x8000,0x0800,0x0000,0x1001,0x8000,0x0800,0x0000,0x1001,
X 0x8000,0x0800,0x0000,0x1001,0x8000,0x0810,0x0000,0x1001,
X 0x8000,0x0810,0x0003,0x9001,0x8000,0x087C,0x0007,0x5001,
X 0x8000,0x0810,0x0005,0xD001,0x8000,0x0810,0x0004,0x5001,
X 0x8000,0x0800,0x0003,0xB001,0x8000,0x0800,0x0000,0x1001,
X 0x8000,0x0800,0x0000,0x1801,0x8000,0x0800,0x0000,0x1801,
X 0x8000,0x0800,0x0000,0x1801,0x8000,0x0FFF,0xFFFF,0xF401,
X 0x8000,0x0000,0x0000,0x0201,0x8000,0x0000,0x0000,0x0201,
X 0x8000,0x0000,0x0000,0x0201,0x81E0,0x0000,0x0000,0x0101,
X 0x803E,0x0000,0x0000,0x0101,0x8003,0xE000,0x0000,0x0101,
X 0x8000,0x3F00,0x0000,0x0101,0x8000,0x03F0,0x0000,0x0101,
X 0x8000,0x003F,0x0000,0x0101,0x8000,0x0003,0xF000,0x0201,
X 0x8000,0x0000,0x3F80,0x0201,0x8000,0x0000,0x03F8,0x0401,
X 0x8000,0x0000,0x003F,0x8401,0x8000,0x0000,0x0003,0xFC01,
X 0x8000,0x0000,0x0000,0x3401,0x8000,0x0000,0x0000,0x1C01,
X 0x8000,0x0000,0x0000,0x0001,0x8000,0x0000,0x0000,0x0001,
X 0x8000,0x0000,0x0000,0x0001,0xFFFF,0xFFFF,0xFFFF,0xFFFF
END_OF_.forthicon
if test 1933 -ne `wc -c <.forthicon`; then
echo shar: \".forthicon\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f README -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"README\"
else
echo shar: Extracting \"README\" \(12698 characters\)
sed "s/^X//" >README <<'END_OF_README'
XTHREADED INTERPRETIVE LANGUAGE ENVIRONMENT (TILE)
X
XNovember 30, 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
X1. INTRODUCTION
X
XTILE Forth is a Forth-83 implementation written in C. Thus allowing it to
Xbe easily moved between different computers compared to traditional Forth
Ximplementations in assembler.
X
XTILE Forth is organized in a set of modules to allow the kernel to be used
Xas a general threading engine for C. Also environment dependencies such
Xas memory allocation, error handling and input/output are separated to
Xincrease flexibility.
X
XThe kernel supports the Standard Forth-83 Word Set except for blocks
Xwhich are not used. The kernel is extended with the following; argument
Xbinding and local variables, queue management, low level compiler words,
Xnull terminated string functions, exceptions and multi-tasking. The TILE
XForth environment also contains a set of source files for high level multi-
Xtasking, data structuring and a number of programming tools.
X
XTo allow interaction and incremental program development TILE Forth
Xcontains a programming environment. This environment helps with
Xprogram structuring, i.e., pretty printing, documentation search, and
Xprogram development. Each vocabulary in the kernel and the source files
Xis described by a documentation and test file. This style of programming
Xis emphasized throughout the environment.
X
XSo far TILE Forth has been ported and tested to over twenty locations
Xwithout any major problems except where C compilers do not allow sub-
Xroutine pointers in data structures.
X
XMost Forth implementations are done in assembly to be able to
Xutilize the underlying architecture as optimal as possible. TILE Forth
Xgoes an other direction. The main idea behind TILE Forth is to achieve
Xa portable forth implementation for workstations and medium size
Xcomputer systems so that new groups of programmers may be exposed
Xto the flavor of an extensible language such as Forth. The forth
Xapplication is just an example of how to use the kernel.
X
XThe organization of TILE Forth is selected so that, in principle, any
XC-level procedure may become available on the interactive and
Xincremental forth level. Other models of implementation of a threaded
Xinterpreter in C are possible but are not as flexible.
X
XTILE Forth is divided into three major parts, the kernel, io-, error-,
Xand memory management packages, and the application example, TILE Forth
Xitself.
X
XTILE Forth extends the Forth 83 required standard with many of the
Xconcepts from modern programming language such as argument binding,
Xand local variable frame, multi-tasking, exception management etc.
X
XWriting a Forth in C gives some possibilities that normally are
Xnot available when performing the same task in assembler. TILE Forth
Xhas been profiled using the available tools in Unix. This information
Xhas been used to optimize the compiler so that it achieves a compilation
Xspeed of over 100.000 lines per minute on a Sun-4.
X
XCurrently code is only saved in source form and applications are
Xtypically compile-and-go.
X
XComparing with the traditional benchmark such as the classical sieves
Xcalculation is difficult because of difference in speed between
Xworkstations and personal computers. The Byte sieves benchmark is
Xreported to typically run in 16 seconds on a DTC forth implementation.
XThis benchmark will run in 27 seconds in TILE forth on a SUN-3/60.
XThis is the total time for starting forth, compiling and executing the
Xbenchmark.
X
XComparing to, for instance, other interpretive languages such as
XLisp, where one of the classical benchmarks is calculation of the
XFibonacci function, the performance increase is almost two magnitudes.
X
X
X2. EXTENSIONS
X
XWhat is new in the forth vocabulary? First of all is the overall
Xorganization of words. Vocabularies, casting and entry caching is
Xused to make word search faster, but also to make programs written
Xin TILE Forth more portable to other forth dialects. If a vocabulary
Xother than forth is used the target system much realize these. The
Xcasting operator in the forth top loop, interpret, allow selection
Xof words from vocabularies without changing the search order thus
Xoperator overloading may be achieved. In general, the top loop
Xrecognizes a casting operation as a parenthesized vocabulary name
Xprefix. An example; selecting string concatenation without changing
Xthe search order just write:
X
X (string) +
X
XAs Forth lack tools for description of data structures TILE Forth
Xcontains a fairly large library of tools. These are described more
Xin detail in the next section.
X
XWhen writing a forth function with many arguments stack shuffling
Xbecomes a real pain. Argument binding and local variables are nice
Xways out of these situations. Also for the new-comer to Forth
Xthis gives some support. Even the stack function may be rewritten:
X
X : 2swap { a b c d } c d a b ;
X : 2drop { a b } ;
X
XAn other extension in TILE Forth are exception handing with multiple
Xexception handling code block. The syntactical structure is very
Xclose to that of Ada, i.e., any colon definition may contain an error
Xhandling section. Should an error occur during the execution of the
Xfunction the stack status is restore to the situation at call
Xand the last exception block is executed. Error situations may be
Xindicated user an exception raise function. Low level errors, such as
Xzero division, are transformed to exceptions in TILE Forth.
X
X : div ( x y -- z)
X /
X exception> ( x y exception -- )
X true abort" div: zero division attempted"
X ;
X
XLast some of the less significant extension are forward declaration
Xof entries, hidden or private entries, and extra entry modes. Three
Xnew entry modes have been added to the classical forth model (immediate).
XThese allow hiding of entries in different situations.
X
XThe first two marks the last defined words visibility according to
Xan interpreter state. These two modifiers are called "compilation"
Xand "execution" and are used as "immediate". A word like "if" is
X"compilation immediate" meaning it is visible when compiling and then
Xalways executed.
X
X compiler forth definitions
X
X : if ( -- ) compile (?branch) >mark ; compilation immediate
X
XThe "private" modifier is somewhat different. If concerns the
Xvisibility across vocabularies. If a word is marked as "private"
Xthe word is only visible when the vocabulary in which it is defined
Xin is "current". This means that if the vocabulary is not "current"
Xand in the search chain "context" the word is not visible. This
Xis very close to the concept of hidden in modules and packages in Modula-2
Xand Ada.
X
X 4 field +name ( entry -- name) private
X
XThe above definition will only be visible in the vocabulary it was
Xdefined. This is useful to isolate implementation dependencies and reduce
Xthe name space.
X
X
X3. SOURCE LIBRARY
X
XThe TILE Forth programming environment contains a number of tools to make
Xprogramming in Forth a bit easier. If you have GNU Emacs, TILE Forth
Xmay run in a specialized forth-mode. This mode supports automatic
Xprogram indentation (pretty printing), documentation search, interactive and
Xincremental program development.
X
XTo aid program development there is also a source code library with
Xdocumentation (glossary), and test and example code. Most of the source
Xcode are data modeling tools. In principle, from bit field definition to
Xobject oriented structures are available. The source code library also
Xcontains debugging tools for tracing, break-point'ing and profiling of
Xprograms.
X
XThe first level of data modeling tools are three modules for describing;
X1) bit fields, 2) structures (records), and 3) aggregates of data (vectors,
Xstacks, buffers, etc).
X
XThe next level of tools are some tools for high level syntactic sugar
Xfor multi-tasking concepts (semaphores, channels, etc), finite state
Xmachines (FSM), and anonymous code block (blocks).
X
XThe source library will be extended during the coming releases (see
Xthe release plan, file: RELEASES).
X
X
X4. PROGRAMMING STYLE
X
XA source code module has, in general, the following structure; First
Xsection includes any modules needed (theses are only loaded once).
XSecond follows global definitions for the module. Normally this is
Xa vocabulary for the module. Third comes the search chain to be used
Xthroughout the module. It is important not to change the search order
Xas 1) it becomes difficult for a reader to understand to code, 2)
Xany change in the search chain flushes the internal lookup cache
Xin TILE Forth.
X
X .( Loading the Library...) cr
X
X #include someLibrary.f83
X
X ( Global data and definitions)
X
X vocabulary theLibrary
X
X someLibrary theLibrary definitions
X
X ( Local data and definitions)
X
X : someDefinitions ( -- ) ... ;
X : somePrivateDefinitions ( -- ) ... ; private
X
X forth only
X
XTo create lexical level within the same vocabulary the word "restore" may
Xbe used. It stores the vocabulary pointer to the given entry and thus
Xhides the words defined after this entry. The word "restore" has much the
Xsame action as "forget" but without putting back the dictionary pointer (dp).
X
XEach module should also be documented according to the template documentation
Xfile. This format allows the documentation function to work properly.
X
X
X5. SOURCE FILES
X
XThe TILE Forth source is broken down into the following files:
X
Xtile
X The TILE Forth source code and documentation library.
X
Xtile.1
X Manual for "man" under Unix.
X
XREADME
X This short documentation of TILE.
X
XCOPYING
X The GNU General Public License.
X
XRELEASES
X The current plan of source code releases.
X
XPORTING
X Some help on how to port TILE Forth and typical problems
X
XMakefile
X Allows a number of compilation styles for debugging, profiling, sharing
X etc. New machines and conditional compilation symbols are added here.
X
Xforth.c
X The main program using the multi-tasking kernel. Also gives access to
X program arguments and start symbol.
X
Xforth.el
X Forth Mode for GNU Emacs. Allows interactive program development in
X EMACS and documentation search.
X
Xkernel.c..h
X The multi-tasking Forth kernel.
X
Xerror.c..h
X The signal and error handling package of TILE Forth.
X
Xio.c..h
X The input and output management package of TILE Forth.
X
Xmemory.c..h
X Memory allocation package of TILE Forth.
X
Xsrc
X The Forth source library with data description, high level tasking and
X other tools.
X
Xtst
X Test file for each Forth source code file and a set of benchmarks.
X
Xdoc
X Documentation and glossary for each source code file and kernel
X vocabularies.
X
XThe documentation follow the C style and the glossary structure is used
Xby the Forth Mode search function.
X
X
X6. CONFIGURATION
X
XTILE forth is targeted for 32-bit machines and no special aid is available
Xto allow it to be compiled for other bit-widths. The configuration is
Xmaintained by a "make" files.
X
XThe configuration file allows a number of different modes to support
Xtypical program development phases (on C level) such as debugging,
Xprofiling, optimization and packaging. Please see the information in
Xthese files.
X
X
X7. COPYING
X
XThis software is offered as shareware. You may use it freely, but
Xif you do use it and find it useful, you are encouraged to send the
Xauthor a contribution for the next project (an object oriented threaded
Xinterpreter -- `the flexibility of Smalltalk to the speed of Forth').
X
XFor further information about copying see the file COPYING and the
Xheader in each source code file.
X
X
X8. NOTE
X
XDue to the 32-bit implementation in C a number of Forth definitions are
Xnot confirmed. Below is a short list of words that might give problems
Xwhen porting Forth code to this environment:
X
X* The Block Word Set is not supported. Source code is saved as text files.
X
X* All stacks and words size are 32-bit. Thus special care must be taken
X with memory allocation and access.
X
X* Lowercase and uppercase are distinguished, and all forth words are
X lowercase.
X
X* A word in TILE is allowed arbitrary length as the name is stored as
X as a null terminated string.
X
X* Input such as key performs a traditional read operation to the
X operation system thus will echo the characters.
X
X* Variables should not allocate extra memory. "create" should be used.
X
X
XACKNOWLEDGMENTS
X
XFirst of all I wish to express my gratitude to Goran Rydqvist for helped
Xme out with the first version of the kernel and who implemented the
Xforth-mode for GNU Emacs.
X
XSecond a special thanks to the beta test group who gave me valuable
Xfeedback. Especially Mitch Bradley, Bob Giovannucci Jr., Moises Lejter,
Xand Brooks David Smith.
X
XThank you all.
X
X
X
X
END_OF_README
if test 12698 -ne `wc -c <README`; then
echo shar: \"README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f RELEASES -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"RELEASES\"
else
echo shar: Extracting \"RELEASES\" \(1747 characters\)
sed "s/^X//" >RELEASES <<'END_OF_RELEASES'
XTHREADED INTERPRETIVE LANGUAGE ENVIRONMENT (TILE) RELEASE PLAN
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
XRELEASE 1, December 1989
X
XC LEVEL CODE
X forth forth application
X kernel c-based kernel
X memory memory management functions
X string string manipulation
X queues double linked
X multi-tasking basic multi-tasking primitives
X exceptions error handling
X locals argument binding and local variables
X
XFORTH LEVEL CODE
X forth internal structures
X bitfields bit field access functions
X structures data structures
X enumerates enumerate variables
X ranges intervals
X queues double linked lists
X multi-tasking high level multi-tasking definitions
X blocks code blocks
X macros macro code definitions
X debugger basic debugger; trace, break and profile
X
X
XRELEASE 2, February-March 1990
X
XC LEVEL CODE
X float floating point numbers
X double double size number primitives
X
XFORTH LEVEL CODE
X *double double size numbers
X *vectors vectors
X *stacks lifo stacks
X *buffers cyclic buffers
X *linked-lists single linked lists
X *bitsets fast bit represented sets
X strings high level string functions
X trees tree data structures
X sets symbol sets
X
X
XRELEASE 3, May-June 1990
X
XC LEVEL CODE
X device device functions
X io generic input-output
X objects primitives supporting of late binding
X
XFORTH LEVEL CODE
X *relations association model
X *prototypes prototype based object orientation
X *objects class and instance model
X *forthtalk basic classes for OOP in Forth
X
X*/ available December 1989 but not fully documented and tested.
X
END_OF_RELEASES
if test 1747 -ne `wc -c <RELEASES`; then
echo shar: \"RELEASES\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d doc ; then
echo shar: Creating directory \"doc\"
mkdir doc
fi
if test -f doc/memory.doc -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"doc/memory.doc\"
else
echo shar: Extracting \"doc/memory.doc\" \(2046 characters\)
sed "s/^X//" >doc/memory.doc <<'END_OF_doc/memory.doc'
XMEMORY(1) KERNEL MEMORY ALLOCATION FUNCTIONS MEMORY(1)
X
XNAME
X memory - kernel dynamic memory allocation
X
XSYNOPSIS
X memory ( -- )
X
X malloc ( bytes -- ptr)
X realloc ( bytes ptr -- ptr)
X free ( ptr -- )
X
XDESCRIPTION
X Kernel support for dynamic memory allocation from the run-time
X heap.
X
Xmemory ( -- )
X Vocabulary containing the heap management extension.
X
Xmalloc ( bytes -- ptr)
X Allocates "bytes" and returns a pointer to the memory area.
X Returns nil if the heap is saturated.
X
Xrealloc ( bytes ptr -- ptr)
X Resizes an allocated block on the heap. If the new size is
X larger than the grow size of the block. A new block is
X allocated and the old blocks contains is copied and freed.
X
Xfree ( ptr -- )
X Returns a block of memory to the heap pool.
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/memory.doc
if test 2046 -ne `wc -c <doc/memory.doc`; then
echo shar: \"doc/memory.doc\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f error.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"error.h\"
else
echo shar: Extracting \"error.h\" \(391 characters\)
sed "s/^X//" >error.h <<'END_OF_error.h'
X/*
X C BASED FORTH-83 MULTI-TASKING KERNEL ERROR MANAGEMENT DEFINITIONS
X
X Copyright (c) 1989 by Mikael R.K. Patel
X
X*/
X
X
X/* INCLUDE FILES: SETJUMP */
X
X#include <setjmp.h>
X
X
X/* WARM RESTART ENVIRONMENT FOR LONGJMP */
X
Xextern jmp_buf restart;
X
X
X/* EXPORTED FUNCTIONS AND PROCEDURES */
X
Xvoid error_initiate();
Xvoid error_restart();
Xvoid error_fatal();
Xvoid error_signal();
Xvoid error_finish();
END_OF_error.h
if test 391 -ne `wc -c <error.h`; then
echo shar: \"error.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f forthtool -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"forthtool\"
else
echo shar: Extracting \"forthtool\" \(688 characters\)
sed "s/^X//" >forthtool <<'END_OF_forthtool'
X
X# NAME
X# forthtool - tile forth interaction tool in sunview
X# SYNOPSIS
X# forthtool [<parameter>...]
X# DESCRIPTION
X# Starts forth in a cmdtool window with TILE Forth icon when closed.
X# Allows cmdtool editing and session file saving. Any parameters
X# are passed on to forth.
X# OPTIONS
X# none
X# FILES
X# .forthicon icon for closed forthtool
X# SEE ALSO
X# tile(1), cmdtool(1), sunview(1)
X# AUTHOR
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
X#
Xcmdtool -Wl "forthtool - forth" -WL Forth -WI $HOME/bin/.forthicon forth $1 $2 $3 $4 $5 $6 $7 $8 $9
X
X
END_OF_forthtool
if test 688 -ne `wc -c <forthtool`; then
echo shar: \"forthtool\" unpacked with wrong size!
fi
chmod +x forthtool
# end of overwriting check
fi
if test -f io.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"io.h\"
else
echo shar: Extracting \"io.h\" \(1356 characters\)
sed "s/^X//" >io.h <<'END_OF_io.h'
X/*
X C BASED FORTH-83 MULTI-TASKING IO MANAGEMENT DEFINITIONS
X
X Copyright (c) 1989 by Mikael R.K. Patel
X
X*/
X
X
X/* INCLUDE FILES: STANDARD INPUT/OUTPUT */
X
X#include <stdio.h>
X
X
X/* STANDARD INPUT AND OUTPUT DESCRIPTORS */
X
X#define STDIN 0
X#define STDOUT 1
X
X
X/* WHITE SPACE DEFINITION AND CHARACTER MASK */
X
X#define ISSPACE(c) ((c) <= ' ')
X#define CMASK 0377
X
X
X/* FILE BUFFER DEFINITION */
X
X#define BUFSIZE 1024
X
Xtypedef struct {
X int fd;
X int bufp;
X int cc;
X char buf[BUFSIZE];
X} FILE_BUFFER;
X
Xextern FILE_BUFFER *io_fstack[];
Xextern int io_fsp;
X
X
X/* APPEND ORDER FOR IO_PATH */
X
X#define IO_PATH_FIRST 1
X#define IO_PATH_LAST 0
X
X
X/* IO MANAGE ERROR CODES */
X
X#define IO_NO_ERROR 0
X#define IO_EOF -1
X#define IO_PATH_DEFINED -1
X#define IO_FILE_INCLUDED -1
X#define IO_UNKNOWN_FILE -2
X#define IO_UNKNOWN_PATH -2
X#define IO_TOO_MANY_PATHS -3
X#define IO_TOO_MANY_FILES -3
X
X
X/* EXPORTED MACROS, FUNCTIONS, AND PROCEDURES */
X
X#define io_getchar() \
X ((io_fstack[io_fsp] -> bufp < io_fstack[io_fsp] -> cc) ? \
X (long) io_fstack[io_fsp] -> buf[io_fstack[io_fsp] -> bufp++] & CMASK : \
X (long) io_fillbuf())
X
X#define io_eof() (io_fsp == -1)
X
X#define io_not_eof() (io_fsp > -1)
X
Xint io_path();
Xint io_infile();
Xint io_fillbuf();
X
Xvoid io_flush();
X
Xvoid io_skip();
Xvoid io_scan();
Xvoid io_skipspace();
X
Xvoid io_initiate();
Xvoid io_finish();
X
END_OF_io.h
if test 1356 -ne `wc -c <io.h`; then
echo shar: \"io.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f memory.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"memory.c\"
else
echo shar: Extracting \"memory.c\" \(1659 characters\)
sed "s/^X//" >memory.c <<'END_OF_memory.c'
X/*
X C BASED FORTH-83 MULTI-TASKING KERNEL MEMORY 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: 8 November 1989
X
X Last updated on: 28 November 1989
X
X Dependencies:
X (cc) memory.h and kernel.h
X
X Description:
X Handles low level access to memory and dictionary allocation.
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#include "memory.h"
X#include "kernel.h"
X
Xvoid memory_initiate(size)
X long size;
X{
X /* Allocate dictionary area and setup dictionary pointer */
X
X dictionary = (long *) malloc((unsigned) size);
X if (dictionary == NIL) {
X (void) printf("memory: can not allocate dictionary area\n");
X exit(0);
X }
X dp = dictionary;
X}
X
Xvoid memory_finish()
X{
X /* Future clean up function for memory management package */
X}
END_OF_memory.c
if test 1659 -ne `wc -c <memory.c`; then
echo shar: \"memory.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f memory.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"memory.h\"
else
echo shar: Extracting \"memory.h\" \(306 characters\)
sed "s/^X//" >memory.h <<'END_OF_memory.h'
X/*
X C BASED FORTH-83 MULTI-TASKING KERNEL MEMORY MANAGEMENT DEFINITIONS
X
X Copyright (c) 1989 by Mikael R.K. Patel
X
X*/
X
X
X/* INCLUDED FILES: SYSTEM MEMORY ALLOCATION */
X
X#ifdef LINT
X#include <malloc.h>
X#endif
X
X/* EXPORTED MACROS, FUNCTIONS, AND PROCEDURES */
X
Xvoid memory_initiate();
Xvoid memory_finish();
END_OF_memory.h
if test 306 -ne `wc -c <memory.h`; then
echo shar: \"memory.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d src ; then
echo shar: Creating directory \"src\"
mkdir src
fi
if test -f src/blocks.f83 -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/blocks.f83\"
else
echo shar: Extracting \"src/blocks.f83\" \(1994 characters\)
sed "s/^X//" >src/blocks.f83 <<'END_OF_src/blocks.f83'
X\
X\ CODE BLOCK 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) compiler
X\
X\ Description:
X\ Code blocks as an alternative to passing functions as parameters.
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 Block definitions...) cr
X
Xvocabulary blocks
X
Xcompiler blocks definitions
X
X16 field +block ( addr1 -- addr2 )
X
X: block[ ( -- )
X compiling ( Check interpreter state)
X if here +block [compile] literal ( If compiling then create literal)
X compile (branch) >mark ( to code section and branch over)
X true ( Mark code compilation state)
X else
X here ( Return pointer to code section)
X false ( Mark non-code compilation state)
X ] ( Start compiling code for block)
X then ; immediate
X
X: ]; ( -- block)
X [compile] ; ( Compile what semicolon does)
X if >resolve ( If within code resolve branch)
X ] ( And Continue compiling)
X then ; immediate
X
X: call ( block -- )
X >r ; ( Perform the block definition)
X
Xforth only
X
END_OF_src/blocks.f83
if test 1994 -ne `wc -c <src/blocks.f83`; then
echo shar: \"src/blocks.f83\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/enumerates.f83 -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/enumerates.f83\"
else
echo shar: Extracting \"src/enumerates.f83\" \(1744 characters\)
sed "s/^X//" >src/enumerates.f83 <<'END_OF_src/enumerates.f83'
X\
X\ ENUMERATE VARIABLES
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: 24 November 1989
X\
X\ Dependencies:
X\ (forth) none
X\
X\ Description:
X\ Forth level definition of enumerate types and variables.
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 Enumeration definitions...) cr
X
Xvocabulary enumerates
X
Xenumerates definitions
X
X: enum.type ( -- id0)
X create 0 ( Create symbol and start definition)
X does> drop variable ; ( Create variable for enumerate type)
X
X: enum.null ( id1 -- id2)
X 1+ ; ( Advance to next identity)
X
X: enum ( id1 -- id2)
X dup constant enum.null ; ( Create an item and advance ident.)
X
X: >enum ( value -- )
X constant ; ( Create an item using value given)
X
X: enum.end ( id3 -- )
X drop ; ( Drop identity value)
X
Xforth only
X
END_OF_src/enumerates.f83
if test 1744 -ne `wc -c <src/enumerates.f83`; then
echo shar: \"src/enumerates.f83\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d tst ; then
echo shar: Creating directory \"tst\"
mkdir tst
fi
if test -f tst/bitfields.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/bitfields.tst\"
else
echo shar: Extracting \"tst/bitfields.tst\" \(947 characters\)
sed "s/^X//" >tst/bitfields.tst <<'END_OF_tst/bitfields.tst'
X.( Loading Bit Field test...) cr
X
X#include bitfields.f83
X
Xbitfields
X
X.( 1: Create a demo bit field definition) cr
X
Xbitfield.type STATUS-REG
X bit ERROR
X3 bits ERROR.CODE
X nibble INDEX
X bit INDIRECT
X byte OP.CODE
Xbitfield.end
X
X
X.( 2: Print information about the fields) cr
X
XERROR .field cr
XERROR.CODE .field cr
XINDEX .field cr
XINDEX .field cr
XOP.CODE .field cr
X
X
X.( 3: Access some data with the fields) cr
X
Xbinary
X
X10101001000100111 ERROR get .
X10101001000100111 ERROR.CODE get .
X10101001000100111 INDEX get .
X10101001000100111 INDIRECT get .
X10101001000100111 OP.CODE get . cr
X
X
X.( 4: Change bit fields in some data) cr
X
X0 10101001000100111 ERROR put ERROR get .
X101 10101001000100111 ERROR.CODE put ERROR.CODE get .
X1111 10101001000100111 INDEX put INDEX get .
X1 10101001000100111 INDIRECT put INDIRECT get .
X10101111 10101001000100111 OP.CODE put OP.CODE get . cr
X
Xdecimal
X
Xforth only
X
X
X
X
X
END_OF_tst/bitfields.tst
if test 947 -ne `wc -c <tst/bitfields.tst`; then
echo shar: \"tst/bitfields.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/blocks.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/blocks.tst\"
else
echo shar: Extracting \"tst/blocks.tst\" \(762 characters\)
sed "s/^X//" >tst/blocks.tst <<'END_OF_tst/blocks.tst'
X.( Loading Blocks test...) cr
X
X#include blocks.f83
X
Xlocals blocks
X
X.( 1: Define a code block for "nip") cr
X
Xblock[ swap drop ]; constant nip
X
X1 2 nip call . cr
X
X
X.( 2: Define a code block in a colon definition and call it) cr
X
X: foo block[ 5 + 3 * ]; call ;
X
X6 foo . cr
X
X
X.( 3: Make a colon definition return a code block depending on parameter) cr
X
X: fie if block[ 5 + ]; else block[ 8 + ]; then ;
X
X5 true fie call . cr
X
X
X.( 4: Show that blocks can return blocks as values) cr
X
X5 false block[ if block[ 5 + ]; else block[ 8 + ]; then ]; call call . cr
X
X
X.( 5: Define a generalized factorial function block) cr
X
Xblock[ { x y z } x 0> if x 1- y z y call x * else z call then ]; constant fum
X
X: fac ( n -- n! ) fum block[ 1 ]; fum call ;
X
X5 fac . cr
X
Xforth only
X
END_OF_tst/blocks.tst
if test 762 -ne `wc -c <tst/blocks.tst`; then
echo shar: \"tst/blocks.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/bubble-sort.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/bubble-sort.tst\"
else
echo shar: Extracting \"tst/bubble-sort.tst\" \(1437 characters\)
sed "s/^X//" >tst/bubble-sort.tst <<'END_OF_tst/bubble-sort.tst'
X.( Loading Bubble Sort benchmark...) cr
X
X\ A classical benchmark of an O(n**2) algorithm; Bubble sort
X\
X\ Part of the programs gathered by John Hennessy for the MIPS
X\ RISC project at Stanford. Translated to forth by Matin Freamen,
X\ Johns Hopkins University/Applied Physics Laboratory.
X
X
X4 constant cell
X
X: cells ( n -- m) cell * ;
X: align ( -- ) here cell 1- and allot ;
X
X: exchange ( x y -- ) dup @ rot dup @ >r ! r> swap ! ;
X
Xvariable seed
X
X: initiate-seed ( -- ) 74755 seed ! ;
X: random ( -- n ) seed @ 1309 * 13849 + 65535 and dup seed ! ;
X
X500 constant elements
X
Xalign create list elements 1+ cells allot
X
X: initiate-list ( -- )
X list elements cells + list do random i ! cell +loop ;
X
X: dump-list ( -- )
X list elements cells + list do i @ . cell +loop cr ;
X
X: verify-list ( -- )
X list elements 1- cells + list do
X i @ i cell + @ > abort" bubble-sort: not sorted"
X cell +loop ;
X
X: bubble ( -- )
X 1 elements 1- do
X list i cells + list do
X i @ i cell + @ >
X if i i cell + exchange then
X cell +loop
X -1 +loop ;
X
X: bubble-sort ( -- )
X initiate-seed
X initiate-list
X bubble
X verify-list ;
X
X: bubble-with-flag
X 1 elements 1- do
X true
X list i cells + list do
X i @ i cell + @ >
X if i i cell + exchange
X drop false
X then
X cell +loop
X if leave then
X -1 +loop ;
X
X: bubble-sort-with-flag ( -- )
X initiate-seed
X initiate-list
X bubble-with-flag
X verify-list ;
X
Xforth only
END_OF_tst/bubble-sort.tst
if test 1437 -ne `wc -c <tst/bubble-sort.tst`; then
echo shar: \"tst/bubble-sort.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/byte-sieve.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/byte-sieve.tst\"
else
echo shar: Extracting \"tst/byte-sieve.tst\" \(1062 characters\)
sed "s/^X//" >tst/byte-sieve.tst <<'END_OF_tst/byte-sieve.tst'
X.( Loading Byte Magazine Sieve benckmark...) cr
X
Xdecimal
X8192 constant size
Xcreate flags size allot
X
X\ This is the "standard" sieve benchmark as published in Byte Magazine.
X\ The algorithm is wrong in the sense that it gives an incorrect count
X\ of the number of primes. That doesn't affect it's usefulness as a
X\ benchmark.
X\
X\ This benchmark tends to be relatively insensitive to the efficiency
X\ of "nesting" (calling a colon definition), since it is implemented
X\ almost entirely with very low level words, which are code words in
X\ most Forth implementations. This is reasonably fair, however, since
X\ studies have shown that in many Forth programs, code words get
X\ executed on the order of 8 times more frequently than colon
X\ definitions.
X
X
X: do-prime ( -- )
X flags size 1 fill
X 0 size 0 do
X flags i + c@
X if i dup + 3 + dup i +
X begin
X dup size <
X while
X 0 over flags + c!
X over +
X repeat
X drop drop 1+
X then
X loop
X 1899 = not abort" prime: wrong result" ;
X
X: byte-sieve ( -- )
X 10 0 do do-prime loop ;
X
Xforth only
END_OF_tst/byte-sieve.tst
if test 1062 -ne `wc -c <tst/byte-sieve.tst`; then
echo shar: \"tst/byte-sieve.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/channels.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/channels.tst\"
else
echo shar: Extracting \"tst/channels.tst\" \(1135 characters\)
sed "s/^X//" >tst/channels.tst <<'END_OF_tst/channels.tst'
X.( Loading Channel test...) cr
X
X#include multi-tasking.f83
X
Xstructures multi-tasking
X
XONE-TO-ONE CHAN binding
X
X: bind ( x -- ) binding receive swap ! ;
X: wire ( x -- ) binding send ;
X: WIRE ( -- ) ONE-TO-ONE CHAN this wire ;
X
X.( 1: Use a task and three channels to add two numbers) cr
X
X100 100 task.type ADDER
X ptr a
X ptr b
X ptr c
Xtask.body
X a bind b bind c bind
X begin
X a @ receive b @ receive
X +
X c @ send
X again
Xtask.end
X
XADDER a1 WIRE x WIRE y WIRE z
X
X: add2 ( x y -- z=x+y) x send y send z receive ;
X
Xwho 100 90 add2 . cr
X
X.( 2: Add an other adder and add three numbers using two tasks) cr
X
XADDER a2 z wire WIRE a WIRE b
X
X: add3 ( x y z -- x+y+z) x send y send a send b receive ;
X
Xwho 1000 100 90 add3 . cr
X
X.( 3: Run factorial as a task with two channels) cr
X
X100 100 task.type FAC
X ptr a
X ptr b
Xtask.body
X a bind b bind
X begin
X 1 a @ receive 1+ 1 do
X i * detach
X loop
X b @ send
X again
Xtask.end
X
XFAC f WIRE n WIRE n!
X
X: fac ( n -- n!)
X n send
X ." I'm waiting.."
X begin
X n! ?avail not
X while
X ." .."
X detach
X repeat
X ." done" cr
X n! receive ;
X
Xwho 10 fac . cr
X
Xforth only
END_OF_tst/channels.tst
if test 1135 -ne `wc -c <tst/channels.tst`; then
echo shar: \"tst/channels.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/colburn-sieve.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/colburn-sieve.tst\"
else
echo shar: Extracting \"tst/colburn-sieve.tst\" \(1026 characters\)
sed "s/^X//" >tst/colburn-sieve.tst <<'END_OF_tst/colburn-sieve.tst'
X.( Loading Colburn Sieve benchmark...) cr
X
Xdecimal
X8192 constant size
Xcreate flags size allot
X
X\ This is the "Colburn Sieve" as published in a letter to the editor
X\ of Dr. Dobbs' Journal. It is the same algorithm as the first, but
X\ is a better Forth implementation of the algorithm. It uses a
X\ DO .. LOOP in the inner loop instead of BEGIN .. WHILE .. REPEAT
X\ This version is a more fair comparison of Forth in relation to other
X\ languages. For comparisons between different Forth systems, both
X\ versions are widely used. It is necessary to state which version
X\ you are using in order for your benchmark to be useful.
X\
X\ The Colburn Sieve typically runs in about 60% of the time of the
X\ Byte sieve.
X
X: do-prime ( -- )
X flags size 1 fill
X 0 size 0 do
X flags i + c@
X if 3 i + i + dup i + size <
X if size flags +
X over i + flags + do
X 0 i c! dup
X +loop
X then
X drop 1+
X then
X loop
X 1899 = not abort" prime: wrong result" ;
X
X: colburn-sieve ( -- )
X 10 0 do do-prime loop ;
X
Xforth only
END_OF_tst/colburn-sieve.tst
if test 1026 -ne `wc -c <tst/colburn-sieve.tst`; then
echo shar: \"tst/colburn-sieve.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/debugger.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/debugger.tst\"
else
echo shar: Extracting \"tst/debugger.tst\" \(884 characters\)
sed "s/^X//" >tst/debugger.tst <<'END_OF_tst/debugger.tst'
X.( Loading Debugger test...) cr
X
X#include debugger.f83
X
Xdebugger
X
X
X.( 1: Define a debuggable tail-recursive function) cr
X
X: foo ( n -- )
X ?dup if ." foo " 1- tail-recurse else cr then ;
X
X12 foo
Xtrace foo
X12 foo
X.profile
X
X
X.( 2: Redefine it as a recursive function) cr
X
X: fie ( n -- )
X ?dup if ." fie " 1- recurse else cr then ;
X
X12 fie
Xtrace fie
X12 fie
X.profile
X
X
X.( 3: Run the break point function) cr
X
X( Only in interactive mode
X
Xbreak foo
X
X10 foo a .s cr
X10 foo c .s cr
X10 foo e r .s cr
X
X)
X
X
X.( 4: Fibonanci number function; recursive and tail recursive) cr
X
X: fib ( n -- m)
X dup 1 > if dup 1- recurse swap 2- recurse + then ;
X
Xtrace fib
X10 fib . cr
X.profile
X
X: fib-tail ( a b c -- m)
X ?dup if 1- rot rot over + swap rot tail-recurse else swap drop then ;
X
X: fib-iter ( n -- m)
X 1 0 rot fib-tail ;
X
Xtrace fib-tail
Xtrace fib-iter
X20 fib-iter . cr
X.profile
X
Xforth only
X
X
END_OF_tst/debugger.tst
if test 884 -ne `wc -c <tst/debugger.tst`; then
echo shar: \"tst/debugger.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/enumerates.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/enumerates.tst\"
else
echo shar: Extracting \"tst/enumerates.tst\" \(539 characters\)
sed "s/^X//" >tst/enumerates.tst <<'END_OF_tst/enumerates.tst'
X.( Loading Enumerates test...) cr
X
X#include enumerates.f83
X
Xenumerates
X
X.( 1: Define a set of small numbers as enumerates and check their values) cr
X
Xenum.type SMALL.NUMBERS
X enum ZERO
X enum ONE
X enum TWO
X enum THREE
X enum FOUR
X enum FIVE
Xenum.end
X
XZERO . ONE . TWO . THREE . FOUR . FIVE . cr
X
X
X.( 2: Define a set of operation code and give the values for each enumerate) cr
X
Xenum.type OP.CODES
X 10 >enum LOAD
X 15 >enum STORE
X 17 >enum ADD
X 21 >enum SUB
X 22 >enum MUL
Xenum.end
X
XLOAD . STORE . ADD . SUB . MUL . cr
X
Xforth only
END_OF_tst/enumerates.tst
if test 539 -ne `wc -c <tst/enumerates.tst`; then
echo shar: \"tst/enumerates.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/exceptions.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/exceptions.tst\"
else
echo shar: Extracting \"tst/exceptions.tst\" \(1816 characters\)
sed "s/^X//" >tst/exceptions.tst <<'END_OF_tst/exceptions.tst'
X.( Loading Exceptions test...) cr
X
X( Should be used in interactive mode only
X
X#include multi-tasking.f83
X
Xmulti-tasking exceptions forth definitions
X
X.( 1: Low level errors generated by hardware) cr
X10 0 / ( Try some real errors)
X0 @ ( Divide by zero, seg. violation)
X1198203980 @ ( and bus error. All on a SUN-3/60)
X
X.( 2: Example of simulating low level errors, i.e., signals) cr
X3 raise ( Simulates a quit signal)
X5 raise ( and a trace trap signal)
X0 raise ( and an input package error)
X
X.( 3: Example of user defined errors types, i.e., exceptions) cr
Xexception zero-divide ( User defined exception)
Xzero-divide raise ( And default error message)
X
X.( 4: Example showing that the errors are only local to a task) cr
X0 SEMAPHORE synch
X
X100 100 task.type FOO
Xtask.body
X ." Task#" running @ . ." scheduled" cr
X synch wait
X 10 0 /
X ." You shouldn't receive this message" cr
Xtask.end
X
XFOO foo
X
X100 100 task.type FIE
Xtask.body
X ." Task#" running @ . ." schedule" cr
X synch wait
X zero-divide raise
X ." You shouldn't receive this message" cr
Xtask.end
X
XFIE fie
X
Xwho
Xsynch signal ( Signal to the tasks to continue)
Xsynch signal
Xwho ( Show that they are terminated)
X
X.( 5: Forth level exception block definition examples) cr
X
X.( 5.1: Example of transformation of signal to exception) cr
X: div ( x y -- q)
X /
Xexception> ( x y signal -- )
X drop zero-divide raise ; ( Transform signal to an exception)
X
X10 0 div
X
X.( 5.2: Example of user level messages) cr
X: divide ( x y - )
X div
Xexception> ( x y signal -- )
X abort" divide: you shouldn't divide by zero" ;
X
X10 0 divide cr
X
X.( 5.3: Example of a retry expection handling) cr
X: divide ( x y -- )
X div
Xexception> ( x y exception -- )
X case
X zero-divide of 1+ recurse endof
X raise
X endcase ;
X
X10 0 divide . cr
X
X)
X
Xforth only
END_OF_tst/exceptions.tst
if test 1816 -ne `wc -c <tst/exceptions.tst`; then
echo shar: \"tst/exceptions.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/fibonacci.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/fibonacci.tst\"
else
echo shar: Extracting \"tst/fibonacci.tst\" \(901 characters\)
sed "s/^X//" >tst/fibonacci.tst <<'END_OF_tst/fibonacci.tst'
X.( Loading Fibonacci benchmark...) cr
X
X\ This is a standard benckmark used for interpretive languages such as
X\ Lisp. Compution of fibonacci for 20 in MacLisp interpreter on a
X\ DEC KA10 takes about 3.6 minutes. The Scheme-79 chip was reported
X\ by G.J. Sussman et al. in IEEE COMPUTER, July 1981, to perform
X\ the task in about a minute at 1595 ns clock period and 32K Lisp cells.
X\
X\ The recursive and tail recursive versions in forth. Demonstrates
X\ the **4.
X
X: fib ( n -- m)
X dup 1 >
X if dup 1- recurse
X swap 2- recurse +
X then ;
X
X: recursive-fib ( -- )
X 20 fib 6765 = not abort" recursive-fib: wrong result" ;
X
X: fib-tail ( a b c -- m)
X ?dup
X if 1- rot rot over + swap rot tail-recurse
X else swap drop then ;
X
X: fib-iter ( n -- m) 1 0 rot fib-tail ;
X
X: tail-recursive-fib ( -- )
X 1000 0 do
X 20 fib-iter
X 6765 = not abort" tail-recursive-fib: wrong result"
X loop ;
X
Xforth only
END_OF_tst/fibonacci.tst
if test 901 -ne `wc -c <tst/fibonacci.tst`; then
echo shar: \"tst/fibonacci.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/locals.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/locals.tst\"
else
echo shar: Extracting \"tst/locals.tst\" \(713 characters\)
sed "s/^X//" >tst/locals.tst <<'END_OF_tst/locals.tst'
X.( Loading Locals Test...) cr
X
Xlocals
X
X
X.( 1: Redefinition of the basic stack operations using argument binding) cr
X
X: swap { a b } b a ;
X: dup { a } a a ;
X: drop { a } ;
X: rot { a b c } b c a ;
X
X1 2 .s swap cr
X3 .s dup cr
X .s drop cr
X .s rot cr
X .s cr
Xdrop drop drop
X
X.( 2: Recursive factorial function with argument binding) cr
X
X: fac { n }
X n 0>
X if n 1- recurse n *
X else
X 1
X then ;
X
X5 fac . cr
X
X
X.( 3: Tail recursive factorial function) cr
X
X: tail { n a }
X n 0>
X if n 1- n a * tail-recurse
X else
X a
X then ;
X
X5 1 tail . cr
X
X
X.( 4: Iterative factorial function with a local variable) cr
X
X: iter { n | a }
X 1 -> a
X n 1+ 1 do
X i a * -> a
X loop
X a ;
X
X5 iter . cr
X
Xforth only
X
END_OF_tst/locals.tst
if test 713 -ne `wc -c <tst/locals.tst`; then
echo shar: \"tst/locals.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/macros.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/macros.tst\"
else
echo shar: Extracting \"tst/macros.tst\" \(627 characters\)
sed "s/^X//" >tst/macros.tst <<'END_OF_tst/macros.tst'
X.( Loading Macro test...) cr
X
X#include macros.f83
X
Xmacros
X
X.( 1: Define "nip" and mark it as a macro definition) cr
X
X: nip ( a b -- b) swap drop ; macro
X
X.macro nip cr
X1 2 nip . cr
X
X: x ( a b -- b) nip ;
X
X1 2 x . cr
X
X
X.( 2: Define "mip" as a double "nip" macro) cr
X
X: mip ( a b c -- c) nip nip ; macro
X
X.macro mip cr
X1 2 3 mip . cr
X
X
X.( 3: Conditional code may also be used as a macro) cr
X
X: 0<> ( x -- flag) 0= if false else true then ; macro
X
X.macro 0<> cr
X1 0<> . 0 0<> . cr
X
X
X.( 4: Macros in macros work the way they should) cr
X
X: ?1- ( x -- [x-1] or [0]) dup 0<> if 1- then ; macro
X
X.macro ?1- cr
X10 ?1- . cr
X
Xforth only
END_OF_tst/macros.tst
if test 627 -ne `wc -c <tst/macros.tst`; then
echo shar: \"tst/macros.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/matrix-mult.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/matrix-mult.tst\"
else
echo shar: Extracting \"tst/matrix-mult.tst\" \(1253 characters\)
sed "s/^X//" >tst/matrix-mult.tst <<'END_OF_tst/matrix-mult.tst'
X.( Loading Matrix Multiplication benchmark...) cr
X
X\ A classical benchmark of an O(n**3) algorithm; Matrix Multiplication
X\
X\ Part of the programs gathered by John Hennessy for the MIPS
X\ RISC project at Stanford. Translated to forth by Matin Freamen,
X\ Johns Hopkins University/Applied Physics Laboratory.
X
X4 constant cell
X
X: cells ( n -- m) cell * ;
X: align ( -- ) here cell 1- and allot ;
X
Xvariable seed
X
X: initiate-seed ( -- ) 74755 seed ! ;
X: random ( -- n ) seed @ 1309 * 13849 + 65535 and dup seed ! ;
X
X40 constant rowsize
Xrowsize rowsize * cells constant matsize
X
Xalign create ima rowsize 1+ dup * cells allot
Xalign create imb rowsize 1+ dup * cells allot
Xalign create imr rowsize 1+ dup * cells allot
X
X: initiate-matrix ( m[rowsize+1][rowsize+1] -- )
X dup matsize + swap do
X random dup 120 / 120 * - 60 - i !
X cell +loop ;
X
X: innerproduct ( a[r][*] b[*][c] -- result)
X 0 rowsize 0 do
X >r over @ over @ * r> + >r
X cell + swap rowsize cells + swap
X r>
X loop
X swap drop swap drop ;
X
X: matrix-mult ( -- )
X initiate-seed
X ima initiate-matrix
X imb initiate-matrix
X imr ima matsize + ima do
X imb rowsize cells + imb do
X j i innerproduct over ! cell +
X cell +loop
X rowsize cells +loop
X drop ;
X
Xforth only
X
END_OF_tst/matrix-mult.tst
if test 1253 -ne `wc -c <tst/matrix-mult.tst`; then
echo shar: \"tst/matrix-mult.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/permutations.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/permutations.tst\"
else
echo shar: Extracting \"tst/permutations.tst\" \(1109 characters\)
sed "s/^X//" >tst/permutations.tst <<'END_OF_tst/permutations.tst'
X.( Loading Permutation benchmark...) cr
X
X\ A heavily recursive permutation program written by Denny Brown
X\
X\ Part of the programs gathered by John Hennessy for the MIPS
X\ RISC project at Stanford. Translated to forth by Matin Freamen,
X\ Johns Hopkins University/Applied Physics Laboratory.
X
X4 constant cell
X
X: cells ( n -- m) cell * ;
X: align ( -- ) here cell 1- and allot ;
X
X: exchange ( x y -- ) dup @ rot dup @ >r ! r> swap ! ;
X
X: array ( size -- )
X create
X 1+ cells allot immediate
X does> ( index array -- element)
X [compile] literal compile + ;
X
X10 constant permrange
Xalign permrange array permarray
Xvariable pctr
X
X: initialize-array ( -- )
X 8 1 do i 1- i permarray ! loop ;
X
X: permute ( n -- )
X 1 pctr +!
X dup 1 = not
X if dup 1- dup recurse
X begin
X dup 0>
X while
X over permarray over permarray exchange
X over 1- recurse
X over permarray over permarray exchange
X 1-
X repeat
X drop
X then
X drop ;
X
X: permutations ( -- )
X 0 pctr !
X 6 1 do
X initialize-array
X 7 permute
X loop
X pctr @ 43300 = not abort" permutations: wrong result" ;
X
Xforth only
X
END_OF_tst/permutations.tst
if test 1109 -ne `wc -c <tst/permutations.tst`; then
echo shar: \"tst/permutations.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/queues.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/queues.tst\"
else
echo shar: Extracting \"tst/queues.tst\" \(607 characters\)
sed "s/^X//" >tst/queues.tst <<'END_OF_tst/queues.tst'
X.( Loading Queues test...) cr
X
X#include queues.f83
X#include blocks.f83
X
Xblocks queues
X
X
X.( 1: Create a queue and insert some elements) cr
X
XQUEUE foo
Xfoo print
Xfoo ?empty .
Xfoo length . cr
X
XQUEUE fie
Xfie foo into
Xfoo print
Xfoo ?empty .
Xfoo length . cr
X
XQUEUE fum
Xfum foo into
Xfoo print
Xfoo ?empty .
Xfoo length . cr
X
X
X.( 2: Print information about all the queue elements) cr
X
Xfoo block[ .queue cr ]; map
X
X
X.( 3: Remove some queue elements) cr
X
Xfie out
Xfoo .queue cr
Xfum out
Xfoo .queue cr
X
X
X.( 4: Try the member function) cr
X
Xfoo foo ?member .
Xfie foo ?member .
Xfie foo into
Xfie foo ?member . cr
X
X
Xforth only
END_OF_tst/queues.tst
if test 607 -ne `wc -c <tst/queues.tst`; then
echo shar: \"tst/queues.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/ranges.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/ranges.tst\"
else
echo shar: Extracting \"tst/ranges.tst\" \(1289 characters\)
sed "s/^X//" >tst/ranges.tst <<'END_OF_tst/ranges.tst'
X.( Loading Ranges test...) cr
X
X#include ranges.f83
X#include blocks.f83
X
Xblocks ranges
X
X.( 1: Create some typical ranges and print information about them) cr
X
X1901 2099 RANGE YEAR_NUMBER ( Ranges for time and date)
X1 12 RANGE MONTH_NUMBER
X1 31 RANGE DAY_NUMBER
X1 24 RANGE HOUR_NUMBER
X1 60 RANGE MINUTE_NUMBER
X1 60 RANGE SECOND_NUMBER
X
XYEAR_NUMBER .range cr ( Print range intervals)
XYEAR_NUMBER print cr ( Print range values)
XMONTH_NUMBER .range cr ( Print range intervals)
XMONTH_NUMBER print cr ( Print range values)
XDAY_NUMBER .range cr ( Print range intervals)
XDAY_NUMBER print cr ( Print range values)
X
X
X.( 2: Count number of odd numbers in the ranges) cr
X
X: #odd ( range -- n)
X 0 swap block[ 1 and if 1+ then ]; map ;
X
XYEAR_NUMBER #odd .
XMONTH_NUMBER #odd .
XDAY_NUMBER #odd . cr
X
X
X.( 3: Test membership function) cr
X
X3 YEAR_NUMBER ?member .
X3 MONTH_NUMBER ?member .
X3 DAY_NUMBER ?member . cr
X
X
X.( 4: Conditional iteration; print a sub-range) cr
X
X: .sub.range ( upper range -- )
X over over ?member
X if block[ dup . over = ]; ?map
X else
X drop
X then
X drop ;
X
X4 DAY_NUMBER .sub.range cr
X
X
X.( 5: Union and intersections of ranges) cr
X
XDAY_NUMBER YEAR_NUMBER ?intersection .
XDAY_NUMBER YEAR_NUMBER intersection . .
XDAY_NUMBER YEAR_NUMBER union . . cr
X
Xforth only
X
X
END_OF_tst/ranges.tst
if test 1289 -ne `wc -c <tst/ranges.tst`; then
echo shar: \"tst/ranges.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/rendezvous.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/rendezvous.tst\"
else
echo shar: Extracting \"tst/rendezvous.tst\" \(1033 characters\)
sed "s/^X//" >tst/rendezvous.tst <<'END_OF_tst/rendezvous.tst'
X.( Loading Rendezvous test...) cr
X
X#include multi-tasking.f83
X
Xmulti-tasking
X
X
X.( 1: A simple server task that performs the service one-plus) cr
X
XRENDEZVOUS service ( n -- m)
X
X100 100 task.type SERVER
Xtask.body
X begin
X accept service ( arg -- res)
X 1+
X accept.end
X again
Xtask.end
X
XSERVER aServer
X
X
X.( 2: A multiple read buffer with services put and get) cr
X
XRENDEZVOUS put ( n -- nil)
XRENDEZVOUS get ( nil -- n)
X
X100 100 task.type BUFFER
X long item
Xtask.body
X accept put ( item -- nil)
X item ! nil
X accept.end
X begin
X ?awaiting put if
X accept put ( item -- nil)
X item ! nil
X accept.end
X then
X ?awaiting get if
X accept get ( nil -- item)
X drop item @
X accept.end
X then
X detach
X again
Xtask.end
X
XBUFFER aBuffer
X
X
X.( 3: A demon task which feed the two other tasks with calls) cr
X
X100 100 task.type DEMON
Xtask.body
X begin
X nil get service put drop
X again
Xtask.end
X
XDEMON aDevil
X
X.( 4: Initiate the buffer and run the scenario) cr
X
X0 put drop 1000 delay 0 get . cr
X
Xforth only
END_OF_tst/rendezvous.tst
if test 1033 -ne `wc -c <tst/rendezvous.tst`; then
echo shar: \"tst/rendezvous.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/semaphores.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/semaphores.tst\"
else
echo shar: Extracting \"tst/semaphores.tst\" \(734 characters\)
sed "s/^X//" >tst/semaphores.tst <<'END_OF_tst/semaphores.tst'
X.( Loading Multi-tasking test...) cr
X
X#include multi-tasking.f83
X
X.( *** start of multi-tasking demo ***) cr
X
Xmulti-tasking
X
X0 SEMAPHORE synch
X
X100 100 task.type TASK-1
Xtask.body
X ." ** t1 waiting **" cr
X synch wait
X ." ** t1 terminated **" cr
Xtask.end
X
X.( ** t1 scheduled **) cr
XTASK-1 t1
Xwho
X
X100 100 task.type TASK-2
Xtask.body
X 20 0 do
X 100 delay who
X loop
X ." ** t2 terminated **" cr
Xtask.end
X
X.( ** t2 scheduled **) cr
XTASK-2 t2
Xwho
X
X100 100 task.type TASK-3
Xtask.body
X 1000 delay
X ." ** t3 signaling ** " cr
X synch signal
X ." ** t3 waiting for t2 **" cr
X t2 join who
X ." ** t3 terminated **" cr
Xtask.end
X
X.( ** t3 scheduled **) cr
XTASK-3 t3
Xwho
X
X.( ** main waiting for t3 **) cr
Xwho
Xt3 join
Xwho
X
X
Xforth only
X
END_OF_tst/semaphores.tst
if test 734 -ne `wc -c <tst/semaphores.tst`; then
echo shar: \"tst/semaphores.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/structures.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/structures.tst\"
else
echo shar: Extracting \"tst/structures.tst\" \(1294 characters\)
sed "s/^X//" >tst/structures.tst <<'END_OF_tst/structures.tst'
X.( Loading Structure Test...) cr
X
X#include structures.f83
X
Xstructures
X
X.( 1: Print size of primitive fields) cr
X
Xsizeof byte .
Xsizeof word .
Xsizeof ptr .
Xsizeof long .
Xsizeof enum .
Xcr
X
X
X.( 2: Allocate some data) cr
Xhere . new word . here . cr
X
X
X.( 3: Define a list structures) cr
X
Xstruct.type LIST
X ptr +next
Xstruct.init ( self -- )
X nil swap +next !
Xstruct.end
X
Xsizeof LIST . new LIST dup . +next @ . cr
X
X
X.( 4: Define a double linked list) cr
X
Xstruct.type QUEUE
X struct LIST +succ
X struct LIST +pred
Xstruct.init ( flag self -- )
X swap
X if dup over +succ !
X dup +pred !
X else
X dup +succ as LIST initiate
X +pred as LIST initiate
X then
Xstruct.end
X
Xsizeof QUEUE . cr
Xtrue new QUEUE dup . dup +succ +next @ . +pred +next @ . cr
Xfalse new QUEUE dup . dup +succ +next @ . +pred +next @ . cr
X
X
X.( 5: Define a block using double linked list and instance function) cr
X
Xstruct.type BLOCK
X struct QUEUE +queue
X long +size
Xstruct.init ( size flag self -- )
X swap over +queue as QUEUE initiate
X over allot +size !
Xstruct.does ( self -- ptr)
X sizeof BLOCK +
Xstruct.end
X
X: block ( ptr -- block) sizeof BLOCK - ;
X: size ( ptr -- size) block +size @ sizeof BLOCK + ;
X
Xsizeof BLOCK .
Xhere 1000 true BLOCK x here swap - .
Xx .
Xx block .
Xx block +size @ .
Xx size . cr
X
Xforth only
X
END_OF_tst/structures.tst
if test 1294 -ne `wc -c <tst/structures.tst`; then
echo shar: \"tst/structures.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/task-sieve.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/task-sieve.tst\"
else
echo shar: Extracting \"tst/task-sieve.tst\" \(746 characters\)
sed "s/^X//" >tst/task-sieve.tst <<'END_OF_tst/task-sieve.tst'
X.( Loading Multi-tasking Sieve benchmark...) cr
X
X#include structures.f83
X#include multi-tasking.f83
X
Xstructures multi-tasking forth definitions
X
XONE-TO-ONE CHAN parameter
X
X24 24 task.type FILTER ( -- )
X ptr previous
X ptr next
X long prime
Xtask.body
X parameter receive previous !
X nil next !
X parameter receive dup . prime !
X begin
X previous @ receive dup
X prime @ mod
X if next @ ?dup
X if send
X else
X new FILTER drop
X ONE-TO-ONE (structures) new CHAN dup next !
X parameter send
X parameter send
X then
X else
X drop
X then
X again
Xtask.end
X
X: task-sieve ( -- )
X new FILTER drop
X ONE-TO-ONE (structures) new CHAN dup parameter send
X 2 parameter send
X 8192 3 do
X i over send
X loop
X drop ;
X
Xforth only
END_OF_tst/task-sieve.tst
if test 746 -ne `wc -c <tst/task-sieve.tst`; then
echo shar: \"tst/task-sieve.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tst/towers-of-hanoi.tst -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tst/towers-of-hanoi.tst\"
else
echo shar: Extracting \"tst/towers-of-hanoi.tst\" \(987 characters\)
sed "s/^X//" >tst/towers-of-hanoi.tst <<'END_OF_tst/towers-of-hanoi.tst'
X.( Loading Towers of Hanoi benchmark...) cr
X
X\ The classical Towers of Hanoi benchmark
X\
X\ From W.P. Salman, O. Tisserand and B. Toulout, FORTH, Macmillan
X\ pp. 120-121
X
Xvariable moves
X
X: copy ( x y z -- x y z x y z)
X >r over over r@ rot rot r> ;
X
X: dispose ( x y z -- )
X drop drop drop ;
X
X: edit ( d a n -- d a n)
X copy drop swap ." From: " . ." to: " . cr ;
X
X: prepare-call ( d a n -- d a n d i n-1)
X copy rot rot over + 6 swap - rot 1- ;
X
X: prepare-return ( d a n -- d a n i a n-1)
X copy swap rot over + 6 swap - swap rot 1- ;
X
X: verify-hanoi ( departure arrival number -- )
X dup
X if prepare-call recurse
X edit
X prepare-return recurse
X then
X dispose ;
X
X: verify-towers-of-hanoi ( -- )
X 1 3 4 verify-hanoi ;
X
X: hanoi ( departure arrival number -- )
X dup
X if prepare-call recurse
X 1 moves +!
X prepare-return recurse
X then
X dispose ;
X
X: towers-of-hanoi ( -- )
X 0 moves !
X 1 3 14 hanoi
X moves @ 16383 = not abort" towers-of-hanoi: wrong result" ;
X
Xforth only
END_OF_tst/towers-of-hanoi.tst
if test 987 -ne `wc -c <tst/towers-of-hanoi.tst`; then
echo shar: \"tst/towers-of-hanoi.tst\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 1 \(of 7\).
cp /dev/null ark1isdone
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