ref: 1591d8a423dee113d543648ab5c3ea07cfb5c55b
parent: d210d6548b86799554676b4dc5146ff0f4174999
author: jsadler <jsadler@ficl.sf.net>
date: Tue Jun 6 23:20:43 CDT 2000
*** empty log message ***
--- /dev/null
+++ b/Makefile
@@ -1,0 +1,41 @@
+OBJECTS= dict.o ficl.o math64.o softcore.o stack.o sysdep.o vm.o words.o
+HEADERS= ficl.h math64.h sysdep.h
+#
+# Flags for shared library
+#SHFLAGS = -fPIC
+CFLAGS= -O -c $(SHFLAGS)
+CC=gcc
+LIB = ar cr
+RANLIB = ranlib
+
+MAJOR = 1
+MINOR = 0.3
+
+lib: libficl.so.$(MAJOR).$(MINOR)
+
+# static library build
+libficl.a: $(OBJECTS)
+ $(LIB) libficl.a $(OBJECTS)
+ $(RANLIB) libficl.a
+
+# shared library build
+libficl.so.$(MAJOR).$(MINOR): $(OBJECTS)
+ $(CC) -shared -Wl,-soname,libficl.so.$(MAJOR) \
+ -o libficl.so.$(MAJOR).$(MINOR) $(OBJECTS)
+
+testmain: testmain.o ficl.h sysdep.h libficl.so.$(MAJOR).$(MINOR)
+ $(CC) testmain.o -o testmain -L. -lficl -lm
+
+#
+# generic object code
+#
+.SUFFIXES: .cxx .cc .c .o
+
+.c.o:
+ $(CC) $(CFLAGS) -c $*.c
+
+.cxx.o:
+ $(CPP) $(CPFLAGS) -c $*.cxx
+
+.cc.o:
+ $(CPP) $(CPFLAGS) -c $*.cc
--- /dev/null
+++ b/ReadMe.txt
@@ -1,0 +1,296 @@
+rel 2.02 -- 17 October 1998
+
+Changed ficlExec so that the search order really does get reset
+on an ERREXIT as advertised.
+
+marker ( "name" -- )
+forget ( "name" -- )
+forget-wid ( wid -- )
+
+SOURCE-ID is now equal to the (<>0) file id when loading a file
+(Win32 only), and -1 when doing EVALUATE. This means that
+REFILL now works correctly when loading a file...
+Win32 LOAD command (oops) now complies with the FILE wordset
+specification of FILE-INCLUDE (REFILL returns FALSE at EOF)
+
+ficl-wordlist ( nBins -- wid )
+ Creates a hashed wordlist with the number of bins specified.
+ Best hash performance if nBins is prime!
+ficl-vocabulary ( nBins "name" -- )
+ Uses ficl-wordlist to make a vocabulary with the given name
+ and number of hash bins
+
+:NONAME (bug fix) no longer pushes control marker for colon and
+ exec token in wrong order.
+WORDS ignores :noname (anonymous) definitions
+
+dictUnsmudge no longer links anonymous definitions into the hash
+
+HIDE ( -- wid-was )
+new wordlist called HIDDEN and word HIDE for keeping execution
+factors from cluttering the default namespace any worse than it
+already is... HIDE sets HIDDEN as the compile wordlist and pushes
+it onto the search order. When finished compiling execution factors,
+a call to SET-CURRENT restores the previous compile wordlist. When
+finished compiling words that use the execution factors, use PREVIOUS
+to restore the prior search order.
+
+Added (my current understanding of) the Johns Hopkins local syntax
+in file softwords/jhlocal.fr. This is in the default version of softcore.c
+instead of the previous {{ }} local syntax. That syntax is still available+in softwords/ficllocal.fr if you want it instead. Ficl's implementation
+of the Johns Hopkins local syntax:
+ { a b c | d -- e f }+ ^^^^^ ^ ^^ this is a comment
+ ||||| \ this local is cleared initially
+ \\\\\ these come off the stack in the correct order
+
+A, b, and c are initialized off the stack in right to left order
+(c gets the top of stack). D is initialized to zero. E and f are
+treated as comments. The | and -- delimiters are optional. If they
+appear, they must appear once only, and in the order shown.
+
+
+OOP vocabulary - no longer in the search order at startup.
+No longer default compile voc at startup
+
+oo.fr
+
+Revised to make more extensive use of early binding for speed.
+
+META (constant) pushes the address of METACLASS. This word is
+ not immediate. Makes it easier to deal with early binding of
+ class methods.
+
+object::init now uses metaclass::get-size explicitly rather
+ than object::size.
+
+classes.fr
+
+Added c-ptr base class for all pointer classes. derived
+ c-cellPtr, c-bytePtr, and c-wordPtr from c-ptr. These
+ classes model pointers to raw scalar types.
+
+
+rel 2.01
+18 sep 98 -- (local) changed so that it does not leave anything
+on the stack after it runs (previously left a marker after the
+first local, consumed it after the last local). Marker is now
+a static of (local).
+
+Added {{ -- }} local syntax with variable reordering+
+
+
+
+========================================================================
+ MICROSOFT FOUNDATION CLASS LIBRARY : ficlwin
+========================================================================
+
+
+AppWizard has created this ficlwin application for you. This application
+not only demonstrates the basics of using the Microsoft Foundation classes
+but is also a starting point for writing your application.
+
+This file contains a summary of what you will find in each of the files that
+make up your ficlwin application.
+
+ficlwin.h
+ This is the main header file for the application. It includes other
+ project specific headers (including Resource.h) and declares the
+ CFiclwinApp application class.
+
+ficlwin.cpp
+ This is the main application source file that contains the application
+ class CFiclwinApp.
+
+ficlwin.rc
+ This is a listing of all of the Microsoft Windows resources that the
+ program uses. It includes the icons, bitmaps, and cursors that are stored
+ in the RES subdirectory. This file can be directly edited in Microsoft
+ Developer Studio.
+
+res\ficlwin.ico
+ This is an icon file, which is used as the application's icon. This
+ icon is included by the main resource file ficlwin.rc.
+
+res\ficlwin.rc2
+ This file contains resources that are not edited by Microsoft
+ Developer Studio. You should place all resources not
+ editable by the resource editor in this file.
+
+ficlwin.clw
+ This file contains information used by ClassWizard to edit existing
+ classes or add new classes. ClassWizard also uses this file to store
+ information needed to create and edit message maps and dialog data
+ maps and to create prototype member functions.
+
+/////////////////////////////////////////////////////////////////////////////
+
+For the main frame window:
+
+MainFrm.h, MainFrm.cpp
+ These files contain the frame class CMainFrame, which is derived from
+ CFrameWnd and controls all SDI frame features.
+
+res\Toolbar.bmp
+ This bitmap file is used to create tiled images for the toolbar.
+ The initial toolbar and status bar are constructed in the
+ CMainFrame class. Edit this toolbar bitmap along with the
+ array in MainFrm.cpp to add more toolbar buttons.
+
+/////////////////////////////////////////////////////////////////////////////
+
+AppWizard creates one document type and one view:
+
+ficlwinDoc.h, ficlwinDoc.cpp - the document
+ These files contain your CFiclwinDoc class. Edit these files to
+ add your special document data and to implement file saving and loading
+ (via CFiclwinDoc::Serialize).
+
+ficlwinView.h, ficlwinView.cpp - the view of the document
+ These files contain your CFiclwinView class.
+ CFiclwinView objects are used to view CFiclwinDoc objects.
+
+
+
+/////////////////////////////////////////////////////////////////////////////
+Other standard files:
+
+StdAfx.h, StdAfx.cpp
+ These files are used to build a precompiled header (PCH) file
+ named ficlwin.pch and a precompiled types file named StdAfx.obj.
+
+Resource.h
+ This is the standard header file, which defines new resource IDs.
+ Microsoft Developer Studio reads and updates this file.
+
+/////////////////////////////////////////////////////////////////////////////
+Other notes:
+
+AppWizard uses "TODO:" to indicate parts of the source code you
+should add to or customize.
+
+If your application uses MFC in a shared DLL, and your application is
+in a language other than the operating system's current language, you
+will need to copy the corresponding localized resources MFC40XXX.DLL
+from the Microsoft Visual C++ CD-ROM onto the system or system32 directory,
+and rename it to be MFCLOC.DLL. ("XXX" stands for the language abbreviation.+For example, MFC40DEU.DLL contains resources translated to German.) If you
+don't do this, some of the UI elements of your application will remain in the
+language of the operating system.
+
+/////////////////////////////////////////////////////////////////////////////
+
+YOU SHOULD CAREFULLY READ THE FOLLOWING TERMS AND CONDITIONS BEFORE USING THIS PRODUCT.
+IT CONTAINS SOFTWARE, THE USE OF WHICH IS LICENSED BY PALM COMPUTING, INC., A SUBSIDIARY
+OF 3COM CORPORATION (COLLECTIVELY, "3COM"), TO ITS CUSTOMERS FOR THEIR USE ONLY AS SET
+FORTH BELOW. IF YOU DO NOT AGREE TO THE TERMS AND CONDITIONS OF THIS AGREEMENT,
+DO NOT USE THE SOFTWARE. USING ANY PART OF THE SOFTWARE INDICATES THAT YOU ACCEPT THESE
+TERMS.
+
+LICENSE: 3Com grants you a nonexclusive license to use the accompanying software program(s)
+(the "Software") subject to the terms and restrictions set forth in this License Agreement.
+You are not permitted to lease or rent (except under separate mutually agreeable terms set
+forth in writing), distribute or sublicense the Software or to use the Software in a
+time-sharing arrangement or in any other unauthorized manner. Further, no license is granted
+to you in the human readable code of the Software (source code). Except as provided below,
+this License Agreement does not grant you any rights to patents, copyrights, trade secrets,
+trademarks, or any other rights in respect to the Software.
+
+The Software is licensed to be used on any personal computer and/or any 3Com product, provided
+that the Software is used only in connection with 3Com products. With respect to the Desktop
+Software, you may reproduce and provide one (1) copy of such Software for each personal computer
+or 3Com product on which such Software is used as permitted hereunder. With respect to the
+Device Software, you may use such Software only on one (1) 3Com product. Otherwise, the Software
+and supporting documentation may be copied only as essential for backup or archive purposes in
+support of your use of the Software as permitted hereunder. You must reproduce and include all
+copyright notices and any other proprietary rights notices appearing on the Software on any
+copies that you make.
+
+NO Assignment; No Reverse Engineering: You may transfer the Software and this License
+Agreement to another party if the other party agrees in writing to accept the terms and
+conditions of this License Agreement. If you transfer the Software, you must at the same
+time either transfer all copies of the Software as well as the supporting documentation
+to the same party or destroy any such materials not transferred. Except as set forth
+above, you may not transfer or assign the Software or your rights under this License Agreement.
+
+Modification, reverse engineering, reverse compiling, or disassembly of the Software is
+expressly prohibited. However, if you are a European Community ("EC") resident, information +necessary to achieve interoperability of the Software with other programs within the meaning
+of the EC Directive on the Legal Protection of Computer Programs is available to you from
+3Com upon written request.
+
+EXPORT RESTRICTIONS: You agree that you will not export or re-export the Software or
+accompanying documentation (or any copies thereof) or any products utilizing the Software
+or such documentation in violation of any applicable laws or regulations of the United States
+or the country in which you obtained them.
+
+Trade Secrets; Title: You acknowledge and agree that the structure, sequence and organization
+of the Software are the valuable trade secrets of 3Com and its suppliers. You agree to hold
+such trade secrets in confidence. You further acknowledge and agree that ownership of, and
+title to, the Software and all subsequent copies thereof regardless of the form or media are
+held by 3Com and its suppliers.
+
+UNITED STATES Government Legend:
+
+The Software is commercial in nature and developed solely at private expense. The Software
+is delivered as "Commercial Computer Software" as defined in DFARS 252.227-7014 (June 1995)
+or as a commercial item as defined in FAR 2.101(a) and as such is provided with only such
+rights as are provided in this License Agreement, which is 3Com's standard commercial license
+for the Software. Technical data is provided with limited rights only as provided in
+DFAR 252.227-7015 (Nov. 1995) or FAR 52.227-14 (June 1987), whichever is applicable.
+
+TERM AND TERMINATION: This License Agreement is effective until terminated. You may
+terminate it at any time by destroying the Software and documentation together with
+all copies and merged portions in any form. It will also terminate immediately if
+you fail to comply with any term or condition of this License Agreement. Upon such
+termination you agree to destroy the Software and documentation, together with all copies
+and merged portions in any form.
+
+GOVERNING LAW: This License Agreement shall be governed by the laws of the State of
+California as such laws are applied to agreements entered into and to be performed
+entirely within California between California residents and by the laws of the United
+States. You agree that the United Nations Convention on Contracts for the International
+Sale of Goods (1980) is hereby excluded in its entirety from application to this License Agreement.
+
+NO WARRANTY: THE SOFTWARE AND ALL RELATED DOCUMENTATION ARE PROVIDED ON AN "AS IS" BASIS
+AND ALL RISK IS WITH YOU. BECAUSE THE SOFTWARE AND DOCUMENTATION ARE PROVIDED TO YOU FREE
+OF CHARGE, 3COM MAKES NO WARRANTIES, TERMS, OR CONDITIONS, EXPRESS, IMPLIED OR STATUTORY,
+AS TO ANY MATTER WHATSOEVER. IN PARTICULAR, ANY AND ALL WARRANTIES, TERMS OR CONDITIONS
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT OF THIRD PARTIES
+RIGHTS ARE EXPRESSLY EXCLUDED. FURTHER, 3COM MAKES NO REPRESENTATIONS, WARRANTIES, TERMS
+OR CONDITIONS THAT THE SOFTWARE AND DOCUMENTATION PROVIDED ARE FREE OF ERRORS OR VIRUSES
+OR THAT THE SOFTWARE AND DOCUMENTATION ARE SUITABLE FOR YOUR INTENDED USE.
+
+LIMITATION OF LIABILITY: IN NO EVENT SHALL 3COM OR ITS SUPPLIERS BE LIABLE TO YOU OR ANY
+OTHER PARTY FOR ANY INCIDENTAL, SPECIAL OR CONSEQUENTIAL DAMAGES, LOSS OF DATA OR DATA
+BEING RENDERED INACCURATE, LOSS OF PROFITS OR REVENUE, OR INTERRUPTION OF BUSINESS IN
+ANY WAY ARISING OUT OF OR RELATED TO THE USE OR INABILITY TO USE THE SOFTWARE AND/OR
+DOCUMENTATION, REGARDLESS OF THE FORM OF ACTION, WHETHER IN CONTRACT, TORT
+(INCLUDING NEGLIGENCE), STRICT PRODUCT LIABILITY OR OTHERWISE, EVEN IF ANY REPRESENTATIVE
+OF 3COM OR ITS SUPPLIERS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. NOTHING IN
+THIS AGREEMENT SHALL HAVE THE EFFECT OF LIMITING OR EXCLUDING 3COM'S LIABILITY FOR DEATH
+OR PERSONAL INJURY CAUSED BY ITS OWN NEGLIGENCE. THIS DISCLAIMER OF LIABILITY FOR DAMAGES
+WILL NOT BE AFFECTED BY ANY FAILURE OF THE SOLE AND EXCLUSIVE REMEDIES HEREUNDER.
+
+DISCLAIMER: Some countries, states, or provinces do not allow the exclusion or
+limitation of implied warranties or the limitation of incidental or consequential
+damages for certain products supplied to consumers or the limitation of liability
+for personal injury, so the above limitations and exclusions may be limited in their
+application to you. When the implied warranties are not allowed to be excluded in
+their entirety, they will be limited to the duration of the applicable written
+warranty. This warranty gives you specific legal rights which may vary depending
+on local law.
+
+SEVERABILITY: In the event any provision of this License Agreement is found to be
+invalid, illegal or unenforceable, the validity, legality and enforceability of any
+of the remaining provisions shall not in any way be affected or impaired and a valid,
+legal and enforceable provision of similar intent and economic impact shall be
+substituted therefor.
+
+ENTIRE AGREEMENT: This License Agreement sets forth the entire understanding and
+agreement between you and 3Com, supersedes all prior agreements, whether written or
+oral, with respect to the Software, and may be amended only in a writing signed by
+both parties.
+
binary files /dev/null b/doc/ficl_logo.jpg differ
binary files /dev/null b/doc/ficl_oop.jpg differ
--- /dev/null
+++ b/ficl.dsp
@@ -1,0 +1,174 @@
+# Microsoft Developer Studio Project File - Name="ficl" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 5.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Console Application" 0x0103
+
+CFG=ficl - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "ficl.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "ficl.mak" CFG="ficl - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "ficl - Win32 Release" (based on "Win32 (x86) Console Application")
+!MESSAGE "ficl - Win32 Debug" (based on "Win32 (x86) Console Application")
+!MESSAGE
+
+# Begin Project
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "ficl - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "/objects/common/ficl/release"
+# PROP Intermediate_Dir "/objects/common/ficl/release"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
+# ADD CPP /nologo /W4 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# SUBTRACT CPP /YX
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
+
+!ELSEIF "$(CFG)" == "ficl - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "/objects/common/ficl/debug"
+# PROP Intermediate_Dir "/objects/common/ficl/debug"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
+# ADD CPP /nologo /Za /W4 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /FR /FD /c
+# SUBTRACT CPP /YX
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
+
+!ENDIF
+
+# Begin Target
+
+# Name "ficl - Win32 Release"
+# Name "ficl - Win32 Debug"
+# Begin Group "Sources"
+
+# PROP Default_Filter "*.c"
+# Begin Source File
+
+SOURCE=.\dict.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\ficl.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\math64.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\softcore.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\stack.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\sysdep.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\testmain.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\vm.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\words.c
+# End Source File
+# End Group
+# Begin Group "Headers"
+
+# PROP Default_Filter "*.h"
+# Begin Source File
+
+SOURCE=.\ficl.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\math64.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\sysdep.h
+# End Source File
+# End Group
+# Begin Group "softcore"
+
+# PROP Default_Filter ".fr"
+# Begin Source File
+
+SOURCE=.\softwords\classes.fr
+# End Source File
+# Begin Source File
+
+SOURCE=.\softwords\ficlclass.fr
+# End Source File
+# Begin Source File
+
+SOURCE=.\softwords\ifbrack.fr
+# End Source File
+# Begin Source File
+
+SOURCE=.\softwords\oo.fr
+# End Source File
+# Begin Source File
+
+SOURCE=.\softwords\softcore.bat
+# End Source File
+# Begin Source File
+
+SOURCE=.\softwords\softcore.fr
+# End Source File
+# Begin Source File
+
+SOURCE=.\softwords\softcore.pl
+# End Source File
+# End Group
+# End Target
+# End Project
--- /dev/null
+++ b/ficl.dsw
@@ -1,0 +1,33 @@
+Microsoft Developer Studio Workspace File, Format Version 5.00
+# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
+
+###############################################################################
+
+Project: "ficl"=.\ficl.dsp - Package Owner=<4>
+
+Package=<5>
+{{{+ begin source code control
+ "$/Pamela/firmware/common/ficl", AUEAAAAA
+ .
+ end source code control
+}}}
+
+Package=<4>
+{{{+}}}
+
+###############################################################################
+
+Global:
+
+Package=<5>
+{{{+}}}
+
+Package=<3>
+{{{+}}}
+
+###############################################################################
+
binary files /dev/null b/ficl.exe differ
--- /dev/null
+++ b/math64.c
@@ -1,0 +1,296 @@
+/*******************************************************************
+** m a t h 6 4 . c
+** Forth Inspired Command Language - 64 bit math support routines
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 25 January 1998
+**
+*******************************************************************/
+
+#include "ficl.h"
+#include "math64.h"
+
+
+/**************************************************************************
+ m 6 4 A b s
+** Returns the absolute value of an INT64
+**************************************************************************/
+INT64 m64Abs(INT64 x)
+{+ if (m64IsNegative(x))
+ x = m64Negate(x);
+
+ return x;
+}
+
+
+/**************************************************************************
+ m 6 4 F l o o r e d D i v I
+**
+** FROM THE FORTH ANS...
+** Floored division is integer division in which the remainder carries
+** the sign of the divisor or is zero, and the quotient is rounded to
+** its arithmetic floor. Symmetric division is integer division in which
+** the remainder carries the sign of the dividend or is zero and the
+** quotient is the mathematical quotient rounded towards zero or
+** truncated. Examples of each are shown in tables 3.3 and 3.4.
+**
+** Table 3.3 - Floored Division Example
+** Dividend Divisor Remainder Quotient
+** -------- ------- --------- --------
+** 10 7 3 1
+** -10 7 4 -2
+** 10 -7 -4 -2
+** -10 -7 -3 1
+**
+**
+** Table 3.4 - Symmetric Division Example
+** Dividend Divisor Remainder Quotient
+** -------- ------- --------- --------
+** 10 7 3 1
+** -10 7 -3 -1
+** 10 -7 3 -1
+** -10 -7 -3 1
+**************************************************************************/
+INTQR m64FlooredDivI(INT64 num, INT32 den)
+{+ INTQR qr;
+ UNSQR uqr;
+ int signRem = 1;
+ int signQuot = 1;
+
+ if (m64IsNegative(num))
+ {+ num = m64Negate(num);
+ signQuot = -signQuot;
+ }
+
+ if (den < 0)
+ {+ den = -den;
+ signRem = -signRem;
+ signQuot = -signQuot;
+ }
+
+ uqr = ficlLongDiv(m64CastIU(num), (UNS32)den);
+ qr = m64CastQRUI(uqr);
+ if (signQuot < 0)
+ {+ qr.quot = -qr.quot;
+ if (qr.rem != 0)
+ {+ qr.quot--;
+ qr.rem = den - qr.rem;
+ }
+ }
+
+ if (signRem < 0)
+ qr.rem = -qr.rem;
+
+ return qr;
+}
+
+
+/**************************************************************************
+ m 6 4 I s N e g a t i v e
+** Returns TRUE if the specified INT64 has its sign bit set.
+**************************************************************************/
+int m64IsNegative(INT64 x)
+{+ return (x.hi < 0);
+}
+
+
+/**************************************************************************
+ m 6 4 M a c
+** Mixed precision multiply and accumulate primitive for number building.
+** Multiplies UNS64 u by UNS32 mul and adds UNS32 add. Mul is typically
+** the numeric base, and add represents a digit to be appended to the
+** growing number.
+** Returns the result of the operation
+**************************************************************************/
+UNS64 m64Mac(UNS64 u, UNS32 mul, UNS32 add)
+{+ UNS64 resultLo = ficlLongMul(u.lo, mul);
+ UNS64 resultHi = ficlLongMul(u.hi, mul);
+ resultLo.hi += resultHi.lo;
+ resultHi.lo = resultLo.lo + add;
+
+ if (resultHi.lo < resultLo.lo)
+ resultLo.hi++;
+
+ resultLo.lo = resultHi.lo;
+
+ return resultLo;
+}
+
+
+/**************************************************************************
+ m 6 4 M u l I
+** Multiplies a pair of INT32s and returns an INT64 result.
+**************************************************************************/
+INT64 m64MulI(INT32 x, INT32 y)
+{+ UNS64 prod;
+ int sign = 1;
+
+ if (x < 0)
+ {+ sign = -sign;
+ x = -x;
+ }
+
+ if (y < 0)
+ {+ sign = -sign;
+ y = -y;
+ }
+
+ prod = ficlLongMul(x, y);
+ if (sign > 0)
+ return m64CastUI(prod);
+ else
+ return m64Negate(m64CastUI(prod));
+}
+
+
+/**************************************************************************
+ m 6 4 N e g a t e
+** Negates an INT64 by complementing and incrementing.
+**************************************************************************/
+INT64 m64Negate(INT64 x)
+{+ x.hi = ~x.hi;
+ x.lo = ~x.lo;
+ x.lo ++;
+ if (x.lo == 0)
+ x.hi++;
+
+ return x;
+}
+
+
+/**************************************************************************
+ m 6 4 P u s h
+** Push an INT64 onto the specified stack in the order required
+** by ANS Forth (most significant cell on top)
+** These should probably be macros...
+**************************************************************************/
+void i64Push(FICL_STACK *pStack, INT64 i64)
+{+ stackPushINT32(pStack, i64.lo);
+ stackPushINT32(pStack, i64.hi);
+ return;
+}
+
+void u64Push(FICL_STACK *pStack, UNS64 u64)
+{+ stackPushINT32(pStack, u64.lo);
+ stackPushINT32(pStack, u64.hi);
+ return;
+}
+
+
+/**************************************************************************
+ m 6 4 P o p
+** Pops an INT64 off the stack in the order required by ANS Forth
+** (most significant cell on top)
+** These should probably be macros...
+**************************************************************************/
+INT64 i64Pop(FICL_STACK *pStack)
+{+ INT64 ret;
+ ret.hi = stackPopINT32(pStack);
+ ret.lo = stackPopINT32(pStack);
+ return ret;
+}
+
+UNS64 u64Pop(FICL_STACK *pStack)
+{+ UNS64 ret;
+ ret.hi = stackPopINT32(pStack);
+ ret.lo = stackPopINT32(pStack);
+ return ret;
+}
+
+
+/**************************************************************************
+ m 6 4 S y m m e t r i c D i v
+** Divide an INT64 by an INT32 and return an INT32 quotient and an INT32
+** remainder. The absolute values of quotient and remainder are not
+** affected by the signs of the numerator and denominator (the operation
+** is symmetric on the number line)
+**************************************************************************/
+INTQR m64SymmetricDivI(INT64 num, INT32 den)
+{+ INTQR qr;
+ UNSQR uqr;
+ int signRem = 1;
+ int signQuot = 1;
+
+ if (m64IsNegative(num))
+ {+ num = m64Negate(num);
+ signRem = -signRem;
+ signQuot = -signQuot;
+ }
+
+ if (den < 0)
+ {+ den = -den;
+ signQuot = -signQuot;
+ }
+
+ uqr = ficlLongDiv(m64CastIU(num), (UNS32)den);
+ qr = m64CastQRUI(uqr);
+ if (signRem < 0)
+ qr.rem = -qr.rem;
+
+ if (signQuot < 0)
+ qr.quot = -qr.quot;
+
+ return qr;
+}
+
+
+/**************************************************************************
+ m 6 4 U M o d
+** Divides an UNS64 by base (an UNS16) and returns an UNS16 remainder.
+** Writes the quotient back to the original UNS64 as a side effect.
+** This operation is typically used to convert an UNS64 to a text string
+** in any base. See words.c:numberSignS, for example.
+** Mechanics: performs 4 ficlLongDivs, each of which produces 16 bits
+** of the quotient. C does not provide a way to divide an UNS32 by an
+** UNS16 and get an UNS32 quotient (ldiv is closest, but it's signed,
+** unfortunately), so I've used ficlLongDiv.
+**************************************************************************/
+UNS16 m64UMod(UNS64 *pUD, UNS16 base)
+{+ UNS64 ud;
+ UNSQR qr;
+ UNS64 result;
+
+ result.hi = result.lo = 0;
+
+ ud.hi = 0;
+ ud.lo = pUD->hi >> 16;
+ qr = ficlLongDiv(ud, (UNS32)base);
+ result.hi = qr.quot << 16;
+
+ ud.lo = (qr.rem << 16) | (pUD->hi & 0x0000ffff);
+ qr = ficlLongDiv(ud, (UNS32)base);
+ result.hi |= qr.quot & 0x0000ffff;
+
+ ud.lo = (qr.rem << 16) | (pUD->lo >> 16);
+ qr = ficlLongDiv(ud, (UNS32)base);
+ result.lo = qr.quot << 16;
+
+ ud.lo = (qr.rem << 16) | (pUD->lo & 0x0000ffff);
+ qr = ficlLongDiv(ud, (UNS32)base);
+ result.lo |= qr.quot & 0x0000ffff;
+
+ *pUD = result;
+
+ return (UNS16)(qr.rem);
+}
+
+
--- /dev/null
+++ b/math64.h
@@ -1,0 +1,60 @@
+/*******************************************************************
+** m a t h 6 4 . h
+** Forth Inspired Command Language - 64 bit math support routines
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 25 January 1998
+**
+*******************************************************************/
+/*
+** N O T I C E -- DISCLAIMER OF WARRANTY
+**
+** Ficl is freeware. Use it in any way that you like, with
+** the understanding that the code is not supported.
+**
+** Any third party may reproduce, distribute, or modify the ficl
+** software code or any derivative works thereof without any
+** compensation or license, provided that the author information
+** and this disclaimer text are retained in the source code files.
+** The ficl software code is provided on an "as is" basis without
+** warranty of any kind, including, without limitation, the implied
+** warranties of merchantability and fitness for a particular purpose
+** and their equivalents under the laws of any jurisdiction.
+**
+** I am interested in hearing from anyone who uses ficl. If you have
+** a problem, a success story, a defect, an enhancement request, or
+** if you would like to contribute to the ficl release (yay!), please
+** send me email at the address above.
+*/
+
+#if !defined (__MATH64_H__)
+#define __MATH64_H__
+
+#ifdef __cplusplus
+extern "C" {+#endif
+
+INT64 m64Abs(INT64 x);
+int m64IsNegative(INT64 x);
+UNS64 m64Mac(UNS64 u, UNS32 mul, UNS32 add);
+INT64 m64MulI(INT32 x, INT32 y);
+INT64 m64Negate(INT64 x);
+INTQR m64FlooredDivI(INT64 num, INT32 den);
+void i64Push(FICL_STACK *pStack, INT64 i64);
+INT64 i64Pop(FICL_STACK *pStack);
+void u64Push(FICL_STACK *pStack, UNS64 u64);
+UNS64 u64Pop(FICL_STACK *pStack);
+INTQR m64SymmetricDivI(INT64 num, INT32 den);
+UNS16 m64UMod(UNS64 *pUD, UNS16 base);
+
+#define i64Extend(i64) (i64).hi = ((i64).lo < 0) ? -1L : 0
+#define m64CastIU(i64) (*(UNS64 *)(&(i64)))
+#define m64CastUI(u64) (*(INT64 *)(&(u64)))
+#define m64CastQRIU(iqr) (*(UNSQR *)(&(iqr)))
+#define m64CastQRUI(uqr) (*(INTQR *)(&(uqr)))
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
+
--- /dev/null
+++ b/softwords/classes.fr
@@ -1,0 +1,86 @@
+\ ** ficl/softwords/classes.fr
+\ ** F I C L 2 . 0 C L A S S E S
+\ john sadler 1 sep 98
+\ Needs oop.fr
+
+.( loading ficl utility classes ) cr
+
+\ REF subclass holds a pointer to an object. It's
+\ mainly for aggregation to help in making data structures.
+\
+object subclass c-ref
+ cell: .class
+ cell: .instance
+
+ : get ( inst class -- refinst refclass )
+ drop 2@ ;
+ : set ( refinst refclass inst class -- )
+ drop 2! ;
+end-class
+
+object subclass c-byte
+ char: .payload
+
+ : get drop c@ ;
+ : set drop c! ;
+end-class
+
+object subclass c-2byte
+ 2 chars: .payload
+
+ : get drop w@ ;
+ : set drop w! ;
+end-class
+
+object subclass c-4byte
+ cell: .payload
+
+ : get drop @ ;
+ : set drop ! ;
+end-class
+
+
+\ ** C - C E L L P T R C L A S S
+\ Models a pointer to cell.
+\ This class is simple enough that its methods could easily
+\ be written in straight Forth, but this implementation is OO
+\ so that I'm practicing what I preach. Also, it would be
+\ safe in this case to use early binding, but it's more
+\ maintainable not to.
+object subclass c-cellPtr
+ c-4byte obj: .addr
+
+ \ get the value of the pointer
+ : get-ptr ( inst class -- addr )
+ --> .addr --> get ;
+
+ \ set the pointer to address supplied
+ : set-ptr ( addr inst class -- )
+ --> .addr --> set ;
+
+ \ fetch and store through the pointer
+ : get ( inst class -- cell )
+ --> get-ptr @ ;
+ : set ( cell inst class -- )
+ --> get-ptr ! ;
+
+ \ increment the pointer in-place
+ : inc-ptr ( inst class -- )
+ 0 locals| ptr |
+ --> .addr \ ( a-inst a-class )
+ 2dup --> get to ptr \ ( a-inst a-class )
+ 2dup --> size ptr swap + \ ( a-inst a-class ptr' )
+ rot rot --> set
+ ;
+
+ \ Decrement the pointer in-place
+ : dec-ptr ( inst class -- )
+ 0 locals| ptr |
+ --> .addr \ ( a-inst a-class )
+ 2dup --> get to ptr \ ( a-inst a-class )
+ 2dup --> size ptr swap - \ ( a-inst a-class ptr' )
+ rot rot --> set
+ ;
+end-class
+
+
--- /dev/null
+++ b/softwords/ifbrack.fr
@@ -1,0 +1,52 @@
+\ ** ficl/softwords/ifbrack.fr
+\ ** ANS conditional compile directives [if] [else] [then]
+\ ** Requires ficl 2.0 or greater...
+\ Does not work correctly with ficl's load command
+\ bacause load sets SOURCE-ID to -1, causing REFILL to
+\ return FALSE.
+
+: ?[if] ( c-addr u -- c-addr u flag )
+ 2dup 2dup
+ s" [if]" compare 0= >r
+ s" [IF]" compare 0= r>
+ or
+;
+
+: ?[else] ( c-addr u -- c-addr u flag )
+ 2dup 2dup
+ s" [else]" compare 0= >r
+ s" [ELSE]" compare 0= r>
+ or
+;
+
+: ?[then] ( c-addr u -- c-addr u flag )
+ 2dup 2dup
+ s" [then]" compare 0= >r
+ s" [THEN]" compare 0= r>
+ or
+;
+
+: [else] ( -- )
+ 1 \ ( level )
+ begin
+ begin
+ parse-word dup while \ ( level addr len )
+ ?[if] if \ ( level addr len )
+ 2drop 1+ \ ( level )
+ else \ ( level addr len )
+ ?[else] if \ ( level addr len )
+ 2drop 1- dup if 1+ endif
+ else
+ ?[then] if 2drop 1- else 2drop endif
+ endif
+ endif ?dup 0= if exit endif \ level
+ repeat 2drop \ level
+ refill 0= until \ level
+ drop
+; immediate
+
+: [if] ( flag -- )
+0= if postpone [else] then ; immediate
+
+: [then] ( -- ) ; immediate
+
--- /dev/null
+++ b/softwords/softcore.bat
@@ -1,0 +1,1 @@
+\perl\bin\perl.exe softcore.pl softcore.fr oo.fr classes.fr >..\softcore.c
--- /dev/null
+++ b/softwords/softcore.pl
@@ -1,0 +1,89 @@
+#! \perl\bin\perl.exe
+# Convert forth source files to a giant C string
+
+$now = localtime;
+
+print <<EOF
+/*******************************************************************
+** s o f t c o r e . c
+** Forth Inspired Command Language -
+** Words from CORE set written in FICL
+** Author: John Sadler (john_sadler\@alum.mit.edu)
+** Created: 27 December 1997
+** Last update: $now
+*******************************************************************/
+/*
+** This file contains definitions that are compiled into the
+** system dictionary by the first virtual machine to be created.
+** Created automagically by ficl/softwords/softcore.pl
+*/
+
+
+#include "ficl.h"
+
+static char softWords[] =
+EOF
+;
+
+$commenting = 0;
+
+while (<>) {+ s"\n$""; # remove EOL
+ s"\t" "g; # replace each tab with 4 spaces
+ s/\"/\\\"/g; # escape quotes
+
+ next if /^\s*\\\s*$/;# toss empty comments
+ next if /^\s*$/; # toss empty lines
+
+ if (/^\\\s\*\*/) { # emit / ** lines as C comments+ s"^\\ "";
+ if ($commenting == 0) {+ print "/*\n";
+ }
+ $commenting = 1;
+ print "$_\n";
+ next;
+ }
+
+ if ($commenting == 1) {+ print "*/\n";
+ }
+
+ $commenting = 0;
+
+ if (/^\\\s#/) { # pass commented preprocessor directives+ s"^\\ "";
+ print "$_\n";
+ next;
+ }
+
+ next if /^\s*\\ /; # toss all other comments
+ s"\\\s+.*$"" ; # lop off trailing \ comments
+ s"\s+$" "; # remove trailing space
+ #
+ # emit all other lines as quoted string fragments
+ #
+ $out = " \"" . $_ . " \\n\"";
+ print "$out\n";
+}
+
+if ($commenting == 1) {+ print "*/\n";
+}
+
+print <<EOF
+ "quit ";
+
+
+void ficlCompileSoftCore(FICL_VM *pVM)
+{+ int ret = ficlExec(pVM, softWords);
+ if (ret == VM_ERREXIT)
+ assert(FALSE);
+ return;
+}
+
+
+EOF
+;
+
--- /dev/null
+++ b/stack.c
@@ -1,0 +1,301 @@
+/*******************************************************************
+** s t a c k . c
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+**
+*******************************************************************/
+#include <stdlib.h>
+
+#include "ficl.h"
+
+#define STKDEPTH(s) ((s)->sp - (s)->base)
+
+/*
+** N O T E: Stack convention:
+**
+** sp points to the first available cell
+** push: store value at sp, increment sp
+** pop: decrement sp, fetch value at sp
+** Stack grows from low to high memory
+*/
+
+/*******************************************************************
+ v m C h e c k S t a c k
+** Check the parameter stack for underflow or overflow.
+** nCells controls the type of check: if nCells is zero,
+** the function checks the stack state for underflow and overflow.
+** If nCells > 0, checks to see that the stack has room to push
+** that many cells. If less than zero, checks to see that the
+** stack has room to pop that many cells. If any test fails,
+** the function throws (via vmThrow) a VM_ERREXIT exception.
+*******************************************************************/
+void vmCheckStack(FICL_VM *pVM, int popCells, int pushCells)
+{+ FICL_STACK *pStack = pVM->pStack;
+ int nFree = pStack->base + pStack->nCells - pStack->sp;
+
+ if (popCells > STKDEPTH(pStack))
+ {+ vmThrowErr(pVM, "Error: stack underflow");
+ }
+
+ if (nFree < pushCells - popCells)
+ {+ vmThrowErr(pVM, "Error: stack overflow");
+ }
+
+ return;
+}
+
+/*******************************************************************
+ s t a c k C r e a t e
+**
+*******************************************************************/
+
+FICL_STACK *stackCreate(unsigned nCells)
+{+ size_t size = sizeof (FICL_STACK) + nCells * sizeof (CELL);
+ FICL_STACK *pStack = ficlMalloc(size);
+
+#if FICL_ROBUST
+ assert (nCells != 0);
+ assert (pStack != NULL);
+#endif
+
+ pStack->nCells = nCells;
+ pStack->sp = pStack->base;
+ pStack->pFrame = NULL;
+ return pStack;
+}
+
+
+/*******************************************************************
+ s t a c k D e l e t e
+**
+*******************************************************************/
+
+void stackDelete(FICL_STACK *pStack)
+{+ if (pStack)
+ ficlFree(pStack);
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k D e p t h
+**
+*******************************************************************/
+
+int stackDepth(FICL_STACK *pStack)
+{+ return STKDEPTH(pStack);
+}
+
+/*******************************************************************
+ s t a c k D r o p
+**
+*******************************************************************/
+
+void stackDrop(FICL_STACK *pStack, int n)
+{+#if FICL_ROBUST
+ assert(n > 0);
+#endif
+ pStack->sp -= n;
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k F e t c h
+**
+*******************************************************************/
+
+CELL stackFetch(FICL_STACK *pStack, int n)
+{+ return pStack->sp[-n-1];
+}
+
+void stackStore(FICL_STACK *pStack, int n, CELL c)
+{+ pStack->sp[-n-1] = c;
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k G e t T o p
+**
+*******************************************************************/
+
+CELL stackGetTop(FICL_STACK *pStack)
+{+ return pStack->sp[-1];
+}
+
+
+/*******************************************************************
+ s t a c k L i n k
+** Link a frame using the stack's frame pointer. Allot space for
+** nCells cells in the frame
+** 1) Push pFrame
+** 2) pFrame = sp
+** 3) sp += nCells
+*******************************************************************/
+
+void stackLink(FICL_STACK *pStack, int nCells)
+{+ stackPushPtr(pStack, pStack->pFrame);
+ pStack->pFrame = pStack->sp;
+ pStack->sp += nCells;
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k U n l i n k
+** Unink a stack frame previously created by stackLink
+** 1) sp = pFrame
+** 2) pFrame = pop()
+*******************************************************************/
+
+void stackUnlink(FICL_STACK *pStack)
+{+ pStack->sp = pStack->pFrame;
+ pStack->pFrame = stackPopPtr(pStack);
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k P i c k
+**
+*******************************************************************/
+
+void stackPick(FICL_STACK *pStack, int n)
+{+ stackPush(pStack, stackFetch(pStack, n));
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k P o p
+**
+*******************************************************************/
+
+CELL stackPop(FICL_STACK *pStack)
+{+ return *--pStack->sp;
+}
+
+void *stackPopPtr(FICL_STACK *pStack)
+{+ return (*--pStack->sp).p;
+}
+
+UNS32 stackPopUNS32(FICL_STACK *pStack)
+{+ return (*--pStack->sp).u;
+}
+
+INT32 stackPopINT32(FICL_STACK *pStack)
+{+ return (*--pStack->sp).i;
+}
+
+
+/*******************************************************************
+ s t a c k P u s h
+**
+*******************************************************************/
+
+void stackPush(FICL_STACK *pStack, CELL c)
+{+ *pStack->sp++ = c;
+}
+
+void stackPushPtr(FICL_STACK *pStack, void *ptr)
+{+ *pStack->sp++ = LVALUEtoCELL(ptr);
+}
+
+void stackPushUNS32(FICL_STACK *pStack, UNS32 u)
+{+ *pStack->sp++ = LVALUEtoCELL(u);
+}
+
+void stackPushINT32(FICL_STACK *pStack, INT32 i)
+{+ *pStack->sp++ = LVALUEtoCELL(i);
+}
+
+/*******************************************************************
+ s t a c k R e s e t
+**
+*******************************************************************/
+
+void stackReset(FICL_STACK *pStack)
+{+ pStack->sp = pStack->base;
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k R o l l
+** Roll nth stack entry to the top (counting from zero), if n is
+** >= 0. Drop other entries as needed to fill the hole.
+** If n < 0, roll top-of-stack to nth entry, pushing others
+** upward as needed to fill the hole.
+*******************************************************************/
+
+void stackRoll(FICL_STACK *pStack, int n)
+{+ CELL c;
+ CELL *pCell;
+
+ if (n == 0)
+ return;
+ else if (n > 0)
+ {+ pCell = pStack->sp - n - 1;
+ c = *pCell;
+
+ for (;n > 0; --n, pCell++)
+ {+ *pCell = pCell[1];
+ }
+
+ *pCell = c;
+ }
+ else
+ {+ pCell = pStack->sp - 1;
+ c = *pCell;
+
+ for (; n < 0; ++n, pCell--)
+ {+ *pCell = pCell[-1];
+ }
+
+ *pCell = c;
+ }
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k S e t T o p
+**
+*******************************************************************/
+
+void stackSetTop(FICL_STACK *pStack, CELL c)
+{+ pStack->sp[-1] = c;
+ return;
+}
+
+
--- /dev/null
+++ b/sysdep.c
@@ -1,0 +1,252 @@
+/*******************************************************************
+** s y s d e p . c
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+** Implementations of FICL external interface functions...
+**
+** (simple) port to Linux, Skip Carter 26 March 1998
+**
+*******************************************************************/
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "ficl.h"
+
+/*
+******************* P C / W I N 3 2 P O R T B E G I N S H E R E ***********************
+*/
+#if defined (_M_IX86)
+
+UNS64 ficlLongMul(UNS32 x, UNS32 y)
+{+ UNS64 q;
+
+ __asm
+ {+ mov eax,x
+ mov edx,y
+ mul edx
+ mov q.hi,edx
+ mov q.lo,eax
+ }
+
+ return q;
+}
+
+UNSQR ficlLongDiv(UNS64 q, UNS32 y)
+{+ UNSQR result;
+
+ __asm
+ {+ mov eax,q.lo
+ mov edx,q.hi
+ div y
+ mov result.quot,eax
+ mov result.rem,edx
+ }
+
+ return result;
+}
+
+#if !defined (_WINDOWS)
+
+void ficlTextOut(FICL_VM *pVM, char *msg, int fNewline)
+{+ IGNORE(pVM);
+
+ if (fNewline)
+ puts(msg);
+ else
+ fputs(msg, stdout);
+
+ return;
+}
+
+#endif
+
+void *ficlMalloc (size_t size)
+{+ return malloc(size);
+}
+
+void ficlFree (void *p)
+{+ free(p);
+}
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** is guaranteed to be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** befor timeout (optional - could also block forever)
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock)
+{+ IGNORE(fLock);
+ return 0;
+}
+#endif /* FICL_MULTITHREAD */
+
+/*
+******************* 6 8 K C P U 3 2 P O R T B E G I N S H E R E ********************
+*/
+#elif defined (MOTO_CPU32)
+
+UNS64 ficlLongMul(UNS32 x, UNS32 y)
+{+ UNS64 q;
+ IGNORE(q); /* suppress goofy compiler warnings */
+ IGNORE(x);
+ IGNORE(y);
+
+#pragma ASM
+ move.l (S_x,a6),d1
+ mulu.l (S_y,a6),d0:d1
+ move.l d1,(S_q+4,a6)
+ move.l d0,(S_q+0,a6)
+#pragma END_ASM
+
+ return q;
+}
+
+UNSQR ficlLongDiv(UNS64 q, UNS32 y)
+{+ UNSQR result;
+ IGNORE(result); /* suppress goofy compiler warnings */
+ IGNORE(q);
+ IGNORE(y);
+
+#pragma ASM
+ move.l (S_q+0,a6),d0 ; hi 32 --> d0
+ move.l (S_q+4,a6),d1 ; lo 32 --> d1
+ divu.l (S_y,a6),d0:d1 ; d0 <-- rem, d1 <-- quot
+ move.l d1,(S_result+0,a6)
+ move.l d0,(S_result+4,a6)
+#pragma END_ASM
+
+ return result;
+}
+
+void ficlTextOut(FICL_VM *pVM, char *msg, int fNewline)
+{+ return;
+}
+
+void *ficlMalloc (size_t size)
+{+}
+
+void ficlFree (void *p)
+{+}
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** is guaranteed to be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** befor timeout (optional - could also block forever)
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock)
+{+ IGNORE(fLock);
+ return 0;
+}
+#endif /* FICL_MULTITHREAD */
+
+#endif /* MOTO_CPU32 */
+
+/*
+******************* Linux P O R T B E G I N S H E R E ******************** Skip Carter, March 1998
+*/
+
+#ifdef linux
+
+UNS64 ficlLongMul(UNS32 x, UNS32 y)
+{+ UNS64 q;
+ __u64 qx;
+
+ qx = (__u64)x * (__u64) y;
+
+ q.hi = (__u32)( qx >> 32 );
+ q.lo = (__u32)( qx & 0xFFFFFFFFL);
+
+ return q;
+}
+
+UNSQR ficlLongDiv(UNS64 q, UNS32 y)
+{+ UNSQR result;
+ __u64 qx, qh;
+
+ qh = q.hi;
+ qx = (qh << 32) | q.lo;
+
+ result.quot = qx / y;
+ result.rem = qx % y;
+
+ return result;
+}
+
+void ficlTextOut(FICL_VM *pVM, char *msg, int fNewline)
+{+ IGNORE(pVM);
+
+ if (fNewline)
+ puts(msg);
+ else
+ fputs(msg, stdout);
+
+ return;
+}
+
+void *ficlMalloc (size_t size)
+{+ return malloc(size);
+}
+
+void ficlFree (void *p)
+{+ free(p);
+}
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** is guaranteed to be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** befor timeout (optional - could also block forever)
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock)
+{+ IGNORE(fLock);
+ return 0;
+}
+#endif /* FICL_MULTITHREAD */
+
+#endif /* linux */
+
+
--- /dev/null
+++ b/sysdep.h
@@ -1,0 +1,249 @@
+/*******************************************************************
+ s y s d e p . h
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+** Ficl system dependent types and prototypes...
+**
+** Note: Ficl also depends on the use of "assert" when
+** FICL_ROBUST is enabled. This may require some consideration
+** in firmware systems since assert often
+** assumes stderr/stdout.
+**
+*******************************************************************/
+/*
+** N O T I C E -- DISCLAIMER OF WARRANTY
+**
+** Ficl is freeware. Use it in any way that you like, with
+** the understanding that the code is not supported.
+**
+** Any third party may reproduce, distribute, or modify the ficl
+** software code or any derivative works thereof without any
+** compensation or license, provided that the author information
+** and this disclaimer text are retained in the source code files.
+** The ficl software code is provided on an "as is" basis without
+** warranty of any kind, including, without limitation, the implied
+** warranties of merchantability and fitness for a particular purpose
+** and their equivalents under the laws of any jurisdiction.
+**
+** I am interested in hearing from anyone who uses ficl. If you have
+** a problem, a success story, a defect, an enhancement request, or
+** if you would like to contribute to the ficl release (yay!), please
+** send me email at the address above.
+*/
+
+#if !defined (__SYSDEP_H__)
+#define __SYSDEP_H__
+
+#include <stddef.h> /* size_t, NULL */
+#include <setjmp.h>
+
+#include <assert.h>
+
+#if !defined IGNORE /* Macro to silence unused param warnings */
+#define IGNORE(x) &x
+#endif
+
+
+/*
+** TRUE and FALSE for C boolean operations, and
+** portable 32 bit types for CELLs
+**
+*/
+#if !defined TRUE
+#define TRUE 1
+#endif
+#if !defined FALSE
+#define FALSE 0
+#endif
+
+
+#if !defined INT32
+#define INT32 long
+#endif
+
+#if !defined UNS32
+#define UNS32 unsigned long
+#endif
+
+#if !defined UNS16
+#define UNS16 unsigned short
+#endif
+
+#if !defined UNS8
+#define UNS8 unsigned char
+#endif
+
+#if !defined NULL
+#define NULL ((void *)0)
+#endif
+
+typedef struct
+{+ UNS32 hi;
+ UNS32 lo;
+} UNS64;
+
+typedef struct
+{+ UNS32 quot;
+ UNS32 rem;
+} UNSQR;
+
+typedef struct
+{+ INT32 hi;
+ INT32 lo;
+} INT64;
+
+typedef struct
+{+ INT32 quot;
+ INT32 rem;
+} INTQR;
+
+
+/*
+** Build controls
+** FICL_MULTITHREAD enables dictionary mutual exclusion
+** wia the ficlLockDictionary system dependent function.
+*/
+#if !defined FICL_MULTITHREAD
+#define FICL_MULTITHREAD 0
+#endif
+
+/*
+** FICL_ROBUST enables bounds checking of stacks and the dictionary.
+** This will detect stack over and underflows and dictionary overflows.
+** Any exceptional condition will result in an assertion failure.
+** (As generated by the ANSI assert macro)
+** FICL_ROBUST == 1 --> stack checking in the outer interpreter
+** FICL_ROBUST == 2 also enables checking in many primitives
+*/
+
+#if !defined FICL_ROBUST
+#define FICL_ROBUST 2
+#endif
+
+/*
+** FICL_DEFAULT_STACK Specifies the default size (in CELLs) of
+** a new virtual machine's stacks, unless overridden at
+** create time.
+*/
+#if !defined FICL_DEFAULT_STACK
+#define FICL_DEFAULT_STACK 128
+#endif
+
+/*
+** FICL_DEFAULT_DICT specifies the number of CELLs to allocate
+** for the system dictionary by default. The value
+** can be overridden at startup time as well.
+** FICL_DEFAULT_ENV specifies the number of cells to allot
+** for the environment-query dictionary.
+*/
+#if !defined FICL_DEFAULT_DICT
+#define FICL_DEFAULT_DICT 12288
+#endif
+
+#if !defined FICL_DEFAULT_ENV
+#define FICL_DEFAULT_ENV 260
+#endif
+
+/*
+** FICL_DEFAULT_VOCS specifies the maximum number of wordlists in
+** the dictionary search order. See Forth DPANS sec 16.3.3
+** (file://dpans16.htm#16.3.3)
+*/
+#if !defined FICL_DEFAULT_VOCS
+#define FICL_DEFAULT_VOCS 16
+#endif
+
+/*
+** User variables: per-instance variables bound to the VM.
+** Kinda like thread-local storage. Could be implemented in a
+** VM private dictionary, but I've chosen the lower overhead
+** approach of an array of CELLs instead.
+*/
+#if !defined FICL_WANT_USER
+#define FICL_WANT_USER 1
+#endif
+
+#if !defined FICL_USER_CELLS
+#define FICL_USER_CELLS 16
+#endif
+
+/*
+** FICL_WANT_LOCALS controls the creation of the LOCALS wordset and
+** a private dictionary for local variable compilation.
+*/
+#if !defined FICL_WANT_LOCALS
+#define FICL_WANT_LOCALS 1
+#endif
+
+/* Max number of local variables per definition */
+#if !defined FICL_MAX_LOCALS
+#define FICL_MAX_LOCALS 16
+#endif
+
+/*
+** FICL_ALIGN is the power of two to which the dictionary
+** pointer address must be aligned. This value is usually
+** either 1 or 2, depending on the memory architecture
+** of the target system; 2 is safe on any 16 or 32 bit
+** machine.
+*/
+#if !defined FICL_ALIGN
+#define FICL_ALIGN 2
+#define FICL_ALIGN_ADD ((1 << FICL_ALIGN) - 1)
+#endif
+
+/*
+** System dependent routines --
+** edit the implementations in sysdep.c to be compatible
+** with your runtime environment...
+** ficlTextOut sends a NULL terminated string to the
+** default output device - used for system error messages
+** ficlMalloc and ficlFree have the same semantics as malloc and free
+** in standard C
+** ficlLongMul multiplies two UNS32s and returns a 64 bit unsigned
+** product
+** ficlLongDiv divides an UNS64 by an UNS32 and returns UNS32 quotient
+** and remainder
+*/
+struct vm;
+void ficlTextOut(struct vm *pVM, char *msg, int fNewline);
+void *ficlMalloc (size_t size);
+void ficlFree (void *p);
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** must be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** before timeout (optional - could also block forever)
+**
+** NOTE: this function must be implemented with lock counting
+** semantics: nested calls must behave properly.
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock);
+#else
+#define ficlLockDictionary(x) 0 /* ignore */
+#endif
+
+/*
+** 64 bit integer math support routines: multiply two UNS32s
+** to get a 64 bit prodict, & divide the product by an UNS32
+** to get an UNS32 quotient and remainder. Much easier in asm
+** on a 32 bit CPU than in C, which usually doesn't support
+** the double length result (but it should).
+*/
+UNS64 ficlLongMul(UNS32 x, UNS32 y);
+UNSQR ficlLongDiv(UNS64 q, UNS32 y);
+
+#endif /*__SYSDEP_H__*/