** PFORTH_VERSION changes when PForth is modified and released.
** See README file for version info.
*/
- #define PFORTH_VERSION "27"
+ #define PFORTH_VERSION "28"
/*
** PFORTH_FILE_VERSION changes when incompatible changes are made
** FV7 - 971203 - Added ID_FILL, (1LOCAL@), etc., ran out of reserved, resorted.
** FV8 - 980818 - Added Endian flag.
** FV9 - 20100503 - Added support for 64-bit CELL.
+ ** FV10 - 20170103 - Added ID_FILE_FLUSH ID_FILE_RENAME ID_FILE_RESIZE
*/
- #define PF_FILE_VERSION (9) /* Bump this whenever primitives added. */
+ #define PF_FILE_VERSION (10) /* Bump this whenever primitives added. */
#define PF_EARLIEST_FILE_VERSION (9) /* earliest one still compatible */
/***************************************************************
ID_QUIT_P,
ID_REFILL,
ID_RESIZE,
- ID_RESTORE_INPUT,
+ ID_SOURCE_LINE_NUMBER_FETCH, /* used to be ID_RESTORE_INPUT */
ID_ROLL,
ID_ROT,
ID_RP_FETCH,
ID_R_FETCH,
ID_R_FROM,
ID_SAVE_FORTH_P,
- ID_SAVE_INPUT,
+ ID_SOURCE_LINE_NUMBER_STORE, /* used to be ID_SAVE_INPUT */
ID_SCAN,
ID_SEMICOLON,
ID_SKIP,
ID_CELLS,
/* DELETE-FILE */
ID_FILE_DELETE,
+ ID_FILE_FLUSH, /* FLUSH-FILE */
+ ID_FILE_RENAME, /* (RENAME-FILE) */
+ ID_FILE_RESIZE, /* RESIZE-FILE */
/* If you add a word here, take away one reserved word below. */
#ifdef PF_SUPPORT_FP
/* Only reserve space if we are adding FP so that we can detect
ID_RESERVED08,
ID_RESERVED09,
ID_RESERVED10,
- ID_RESERVED11,
- ID_RESERVED12,
- ID_RESERVED13,
ID_FP_D_TO_F,
ID_FP_FSTORE,
ID_FP_FTIMES,
#define THROW_PAIRS (-22)
#define THROW_FLOAT_STACK_UNDERFLOW ( -45)
#define THROW_QUIT (-56)
+ #define THROW_FLUSH_FILE (-68)
+ #define THROW_RESIZE_FILE (-74)
/* THROW codes unique to pForth */
#define THROW_BYE (-256) /* Exit program. */
extern "C" {
#endif
- int pfCatch( ExecToken XT );
+ ThrowCode pfCatch( ExecToken XT );
#ifdef __cplusplus
}
/* Force Quad alignment. */
#define QUADUP(x) (((x)+3)&~3)
+#ifndef MIN
#define MIN(a,b) ( ((a)<(b)) ? (a) : (b) )
+#endif
+#ifndef MAX
#define MAX(a,b) ( ((a)>(b)) ? (a) : (b) )
-
+#endif
#ifndef TOUCH
#define TOUCH(argument) ((void)argument)
**
***************************************************************/
- #ifndef AMIGA
- #include <sys/types.h>
- #else
- typedef long off_t;
- #endif
-
#include "pf_all.h"
#if defined(WIN32) && !defined(__MINGW32__)
/* Use local copy of CODE_BASE for speed. */
#define LOCAL_CODEREL_TO_ABS( a ) ((cell_t *) (((cell_t) a) + CodeBase))
-static const char *pfSelectFileModeCreate(cell_t fam );
-static const char *pfSelectFileModeOpen(cell_t fam );
+ /* Truncate the unsigned double cell integer LO/HI to an uint64_t. */
+ static uint64_t UdToUint64( ucell_t Lo, ucell_t Hi )
+ {
+ return (( 2 * sizeof(ucell_t) == sizeof(uint64_t) )
+ ? (((uint64_t)Lo) | (((uint64_t)Hi) >> (sizeof(ucell_t) * 8)))
+ : Lo);
+ }
+
+ /* Return TRUE if the unsigned double cell integer LO/HI is not greater
+ * then the greatest uint64_t.
+ */
+ static int UdIsUint64( ucell_t Lo, ucell_t Hi )
+ {
+ return (( 2 * sizeof(ucell_t) == sizeof(uint64_t) )
+ ? TRUE
+ : Hi == 0);
+ }
+
+static const char *pfSelectFileModeCreate( cell_t fam );
+static const char *pfSelectFileModeOpen( cell_t fam );
/**************************************************************/
static const char *pfSelectFileModeCreate( cell_t fam )
}
/**************************************************************/
- int pfCatch( ExecToken XT )
+ ThrowCode pfCatch( ExecToken XT )
{
register cell_t TopOfStack; /* Cache for faster execution. */
register cell_t *DataStackPtr;
endcase;
case ID_BYE:
+ EMIT_CR;
M_THROW( THROW_BYE );
endcase;
/* Calculate product sign: */
sg = ((cell_t)(ahi ^ bhi) < 0);
/* Take absolute values and reduce to um* */
- if ((cell_t)ahi < 0) ahi = (ucell_t)(-ahi);
- if ((cell_t)bhi < 0) bhi = (ucell_t)(-bhi);
+ if ((cell_t)ahi < 0) ahi = (ucell_t)(-(cell_t)ahi);
+ if ((cell_t)bhi < 0) bhi = (ucell_t)(-(cell_t)bhi);
/* Break into hi and lo 16 bit parts. */
alo = LOWER_HALF(ahi);
Scratch = M_POP;
CharPtr = (char *) M_POP;
Temp = sdReadFile( CharPtr, 1, Scratch, FileID );
+ /* TODO check feof() or ferror() */
M_PUSH(Temp);
TOS = 0;
endcase;
+ /* TODO Why does this crash when passed an illegal FID? */
case ID_FILE_SIZE: /* ( fid -- ud ior ) */
/* Determine file size by seeking to end and returning position. */
FileID = (FileStream *) TOS;
{
- off_t endposition, offsetHi;
- off_t original = sdTellFile( FileID );
- sdSeekFile( FileID, 0, PF_SEEK_END );
- endposition = sdTellFile( FileID );
- M_PUSH(endposition);
- /* Just use a 0 if they are the same size. */
- offsetHi = (sizeof(off_t) > sizeof(cell_t)) ? (endposition >> (8*sizeof(cell_t))) : 0 ;
- M_PUSH(offsetHi);
- sdSeekFile( FileID, original, PF_SEEK_SET );
- TOS = (original < 0) ? -4 : 0 ; /* !!! err num */
+ file_offset_t endposition = -1;
+ file_offset_t original = sdTellFile( FileID );
+ if (original >= 0)
+ {
+ sdSeekFile( FileID, 0, PF_SEEK_END );
+ endposition = sdTellFile( FileID );
+ /* Restore original position. */
+ sdSeekFile( FileID, original, PF_SEEK_SET );
+ }
+ if (endposition < 0)
+ {
+ M_PUSH(0); /* low */
+ M_PUSH(0); /* high */
+ TOS = -4; /* TODO proper error number */
+ }
+ else
+ {
+ M_PUSH(endposition); /* low */
+ /* We do not support double precision file offsets.*/
+ M_PUSH(0); /* high */
+ TOS = 0; /* OK */
+ }
}
endcase;
case ID_FILE_REPOSITION: /* ( ud fid -- ior ) */
{
- off_t offset;
+ file_offset_t offset;
+ cell_t offsetHigh;
+ cell_t offsetLow;
FileID = (FileStream *) TOS;
- offset = M_POP;
- /* Avoid compiler warnings on Mac. */
- offset = (sizeof(off_t) > sizeof(cell_t)) ? (offset << 8*sizeof(cell_t)) : 0 ;
- offset += M_POP;
+ offsetHigh = M_POP;
+ offsetLow = M_POP;
+ /* We do not support double precision file offsets in pForth.
+ * So check to make sure the high bits are not used.
+ */
+ if (offsetHigh != 0)
+ {
+ TOS = -3; /* TODO err num? */
+ break;
+ }
+ offset = (file_offset_t)offsetLow;
TOS = sdSeekFile( FileID, offset, PF_SEEK_SET );
}
endcase;
case ID_FILE_POSITION: /* ( fid -- ud ior ) */
{
- off_t position;
- off_t offsetHi;
+ file_offset_t position;
FileID = (FileStream *) TOS;
position = sdTellFile( FileID );
- M_PUSH(position);
- /* Just use a 0 if they are the same size. */
- offsetHi = (sizeof(off_t) > sizeof(cell_t)) ? (position >> (8*sizeof(cell_t))) : 0 ;
- M_PUSH(offsetHi);
- TOS = (position < 0) ? -4 : 0 ; /* !!! err num */
+ if (position < 0)
+ {
+ M_PUSH(0); /* low */
+ M_PUSH(0); /* high */
+ TOS = -4; /* TODO proper error number */
+ }
+ else
+ {
+ M_PUSH(position); /* low */
+ /* We do not support double precision file offsets.*/
+ M_PUSH(0); /* high */
+ TOS = 0; /* OK */
+ }
}
endcase;
TOS = TOS | PF_FAM_BINARY_FLAG;
endcase;
+ case ID_FILE_FLUSH: /* ( fileid -- ior ) */
+ {
+ FileStream *Stream = (FileStream *) TOS;
+ TOS = (sdFlushFile( Stream ) == 0) ? 0 : THROW_FLUSH_FILE;
+ }
+ endcase;
+
+ case ID_FILE_RENAME: /* ( oldName newName -- ior ) */
+ {
+ char *New = (char *) TOS;
+ char *Old = (char *) M_POP;
+ TOS = sdRenameFile( Old, New );
+ }
+ endcase;
+
+ case ID_FILE_RESIZE: /* ( ud fileid -- ior ) */
+ {
+ FileStream *File = (FileStream *) TOS;
+ ucell_t SizeHi = (ucell_t) M_POP;
+ ucell_t SizeLo = (ucell_t) M_POP;
+ TOS = ( UdIsUint64( SizeLo, SizeHi )
+ ? sdResizeFile( File, UdToUint64( SizeLo, SizeHi ))
+ : THROW_RESIZE_FILE );
+ }
+ endcase;
+
case ID_FILL: /* ( caddr num charval -- ) */
{
register char *DstPtr;
case ID_PLUSLOOP_P: /* ( delta -- ) ( R: index limit -- | index limit ) */
{
- ucell_t OldIndex, NewIndex, Limit;
-
- Limit = M_R_POP;
- OldIndex = M_R_POP;
- NewIndex = OldIndex + TOS; /* add TOS to index, not 1 */
- /* Do indices cross boundary between LIMIT-1 and LIMIT ? */
- if( ( (OldIndex - Limit) & ((Limit-1) - NewIndex) & 0x80000000 ) ||
- ( (NewIndex - Limit) & ((Limit-1) - OldIndex) & 0x80000000 ) )
- {
+ cell_t Limit = M_R_POP;
+ cell_t OldIndex = M_R_POP;
+ cell_t Delta = TOS; /* add TOS to index, not 1 */
+ cell_t NewIndex = OldIndex + Delta;
+ cell_t OldDiff = OldIndex - Limit;
+
+ /* This exploits this idea (lifted from Gforth):
+ (x^y)<0 is equivalent to (x<0) != (y<0) */
+ if( ((OldDiff ^ (OldDiff + Delta)) /* is the limit crossed? */
+ & (OldDiff ^ Delta)) /* is it a wrap-around? */
+ < 0 )
+ {
InsPtr++; /* skip branch offset, exit loop */
}
else
endcase;
#endif
- /* Source Stack
- ** EVALUATE >IN SourceID=(-1) 1111
- ** keyboard >IN SourceID=(0) 2222
- ** file >IN lineNumber filePos SourceID=(fileID)
- */
- case ID_SAVE_INPUT: /* FIXME - finish */
- {
- }
- endcase;
-
case ID_SP_FETCH: /* ( -- sp , address of top of stack, sorta ) */
PUSH_TOS;
TOS = (cell_t)STKPTR;
else M_DROP;
endcase;
+ case ID_SOURCE_LINE_NUMBER_FETCH: /* ( -- linenr ) */
+ PUSH_TOS;
+ TOS = gCurrentTask->td_LineNumber;
+ endcase;
+
+ case ID_SOURCE_LINE_NUMBER_STORE: /* ( linenr -- ) */
+ gCurrentTask->td_LineNumber = TOS;
+ TOS = M_POP;
+ endcase;
+
case ID_SWAP:
Scratch = TOS;
TOS = *STKPTR;
/***************************************************************/
static int Write32ToFile( FileStream *fid, uint32_t Val )
{
- cell_t numw;
+ size_t numw;
uint8_t pad[4];
Write32BigEndian(pad,Val);
EvenNumW = EVENUP(NumBytes);
+ assert(ID <= UINT32_MAX);
if( Write32ToFile( fid, (uint32_t)ID ) < 0 ) goto error;
+ assert(EvenNumW <= UINT32_MAX);
if( Write32ToFile( fid, (uint32_t)EvenNumW ) < 0 ) goto error;
numw = sdWriteFile( Data, 1, EvenNumW, fid );
NameSize = QUADUP(NameSize); /* Align */
if( NameSize > 0 )
{
- NameSize = MAX( NameSize, (NameChunkSize + 1024) );
+ NameSize = MAX( (ucell_t)NameSize, (NameChunkSize + 1024) );
}
SD.sd_NameSize = NameSize;
}
/* How much real code is there? */
CodeChunkSize = QUADUP(relativeCodePtr);
CodeSize = QUADUP(CodeSize); /* Align */
- CodeSize = MAX( CodeSize, (CodeChunkSize + 2048) );
+ CodeSize = MAX( (ucell_t)CodeSize, (CodeChunkSize + 2048) );
SD.sd_CodeSize = CodeSize;
/***************************************************************/
static int32_t Read32FromFile( FileStream *fid, uint32_t *ValPtr )
{
- int32_t numr;
+ cell_t numr;
uint8_t pad[4];
numr = sdReadFile( pad, 1, sizeof(pad), fid );
if( numr != sizeof(pad) ) return -1;
uint32_t ChunkSize;
uint32_t FormSize;
uint32_t BytesLeft;
- uint32_t numr;
+ cell_t numr;
int isDicBigEndian;
DBUG(("pfLoadDictionary( %s )\n", FileName ));
/* Find special words in dictionary for global XTs. */
if( (Result = FindSpecialXTs()) < 0 )
{
- pfReportError("pfLoadDictionary: FindSpecialXTs", Result);
+ pfReportError("pfLoadDictionary: FindSpecialXTs", (Err)Result);
goto error;
}
}
\ This file must be loaded before loading any .J files.
\
\ Author: Phil Burk
- \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
+ \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
\
\ The pForth software code is dedicated to the public domain,
\ and any third party may reproduce, distribute and modify
: (S+REL!) ( ptr addr offset -- ) + >r if.use->rel r> ! ;
: compile+!bytes ( offset size -- )
-\ ." compile+!bytes ( " over . dup . ." )" cr
+ ." compile+!bytes ( " over . dup . ." )" cr
swap [compile] literal \ compile offset into word
CASE
cell OF compile (s+!) ENDOF
2 OF compile (s+w!) ENDOF
1 OF compile (s+c!) ENDOF
- -4 OF compile (s+rel!) ENDOF \ 00002
+ -cell OF compile (s+rel!) ENDOF \ 00002
-2 OF compile (s+w!) ENDOF
-1 OF compile (s+c!) ENDOF
true abort" s! - illegal size!"
: !BYTES ( value address size -- )
CASE
cell OF ! ENDOF
- -4 OF ( aptr addr ) swap if.use->rel swap ! ENDOF \ 00002
+ -cell OF ( aptr addr ) swap if.use->rel swap ! ENDOF \ 00002
ABS
2 OF w! ENDOF
1 OF c! ENDOF
cell OF @ ENDOF
2 OF w@ ENDOF
1 OF c@ ENDOF
- -4 OF @ if.rel->use ENDOF \ 00002
+ -cell OF @ if.rel->use ENDOF \ 00002
-2 OF w@ w->s ENDOF
-1 OF c@ b->s ENDOF
true abort" s@ - illegal size!"
: (S+W@) ( addr offset -- val ) + w@ w->s ;
: compile+@bytes ( offset size -- )
-\ ." compile+@bytes ( " over . dup . ." )" cr
+ ." compile+@bytes ( " over . dup . ." )" cr
swap [compile] literal \ compile offset into word
CASE
cell OF compile (s+@) ENDOF
2 OF compile (s+uw@) ENDOF
1 OF compile (s+uc@) ENDOF
- -4 OF compile (s+rel@) ENDOF \ 00002
+ -cell OF compile (s+rel@) ENDOF \ 00002
-2 OF compile (s+w@) ENDOF
-1 OF compile (s+c@) ENDOF
true abort" s@ - illegal size!"
:struct mapper
long map_l1
long map_l2
- aptr map_a1
- rptr map_r1
- flpt map_f1
short map_s1
ushort map_s2
byte map_b1
ubyte map_b2
+ aptr map_a1
+ rptr map_r1
+ flpt map_f1
;struct
mapper map1
+." compiling TT" cr
: TT
+ 123456 map1 s! map_l1
+ map1 s@ map_l1 123456 - abort" map_l1 failed!"
+ 987654 map1 s! map_l2
+ map1 s@ map_l2 987654 - abort" map_l2 failed!"
+
-500 map1 s! map_s1
- map1 s@ map_s1 -500 - abort" map_s1 failed!"
+ map1 s@ map_s1 dup . cr -500 - abort" map_s1 failed!"
-500 map1 s! map_s2
map1 s@ map_s2 -500 $ FFFF and - abort" map_s2 failed!"
+
-89 map1 s! map_b1
map1 s@ map_b1 -89 - abort" map_s1 failed!"
here map1 s! map_r1
\ the Object Development Environment.
\
\ Author: Phil Burk
- \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
+ \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
\
\ The pForth software code is dedicated to the public domain,
\ and any third party may reproduce, distribute and modify
;
\ Variables shared with object oriented code.
- VARIABLE OB-STATE ( Compilation state. )
- VARIABLE OB-CURRENT-CLASS ( ABS_CLASS_BASE of current class )
- 1 constant OB_DEF_CLASS ( defining a class )
- 2 constant OB_DEF_STRUCT ( defining a structure )
+VARIABLE OB-STATE ( Compilation state. )
+VARIABLE OB-CURRENT-CLASS ( ABS_CLASS_BASE of current class )
+1 constant OB_DEF_CLASS ( defining a class )
+2 constant OB_DEF_STRUCT ( defining a structure )
-4 constant OB_OFFSET_SIZE
+\ A member contains:
+\ cell size of data in bytes (1, 2, cell)
+\ cell offset within structure
+
+cell 1- constant CELL_MASK
+cell negate constant -CELL
+cell constant OB_OFFSET_SIZE
: OB.OFFSET@ ( member_def -- offset ) @ ;
: OB.OFFSET, ( value -- ) , ;
ABS ( -- |+-b| )
ob-current-class @ ( -- b addr-space)
tuck @ ( as #b c , current space needed )
- over 3 and 0= ( multiple of four? )
+ over CELL_MASK and 0= ( multiple of cell? )
IF
aligned
ELSE
\ Aliases
: APTR ( <name> -- ) long ;
-: RPTR ( <name> -- ) -4 bytes ; \ relative relocatable pointer 00001
+: RPTR ( <name> -- ) -cell bytes ; \ relative relocatable pointer 00001
: ULONG ( <name> -- ) long ;
: STRUCT ( <struct> <new_ivar> -- , define a structure as an ivar )
\ Utilities for PForth extracted from HMSL
\
\ Author: Phil Burk
- \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
+ \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
\
\ The pForth software code is dedicated to the public domain,
\ and any third party may reproduce, distribute and modify
variable if-debug
+ : ? ( address -- , fatch from address and print value )
+ @ .
+ ;
+
decimal
create msec-delay 10000 , ( default for SUN )
: (MSEC) ( #msecs -- )
: B->S ( c -- c' , sign extend byte )
dup $ 80 and
IF
- $ FFFFFF00 or
+ [ $ 0FF invert ] literal or
ELSE
- $ 000000FF and
+ $ 0FF and
THEN
;
-: W->S ( 16bit-signed -- 32bit-signed )
+: W->S ( 16bit-signed -- cell-signed )
dup $ 8000 and
- if
- $ FFFF0000 or
+ IF
+ [ $ 0FFFF invert ] literal or
ELSE
- $ 0000FFFF and
- then
+ $ 0FFFF and
+ THEN
;
: WITHIN { n1 n2 n3 -- flag }
addr3 cnt3 flag
;
+ private{
+
+ : env= ( c-addr u c-addr1 u1 x -- x true true | c-addr u false )
+ { x } 2over compare 0= if 2drop x true true else false then
+ ;
+
+ : 2env= ( c-addr u c-addr1 u1 x y -- x y true true | c-addr u false )
+ { x y } 2over compare 0= if 2drop x y true true else false then
+ ;
+
+ 0 invert constant max-u
+ 0 invert 1 rshift constant max-n
+
+ }private
+
+ : ENVIRONMENT? ( c-addr u -- false | i*x true )
+ s" /COUNTED-STRING" 255 env= if exit then
+ s" /HOLD" 128 env= if exit then \ same as PAD
+ s" /PAD" 128 env= if exit then
+ s" ADDRESS-UNITS-BITS" 8 env= if exit then
+ s" FLOORED" false env= if exit then
+ s" MAX-CHAR" 255 env= if exit then
+ s" MAX-D" max-n max-u 2env= if exit then
+ s" MAX-N" max-n env= if exit then
+ s" MAX-U" max-u env= if exit then
+ s" MAX-UD" max-u max-u 2env= if exit then
+ s" RETURN-STACK-CELLS" 512 env= if exit then \ DEFAULT_RETURN_DEPTH
+ s" STACK-CELLS" 512 env= if exit then \ DEFAULT_USER_DEPTH
+ \ FIXME: maybe define those:
+ \ s" FLOATING-STACK"
+ \ s" MAX-FLOAT"
+ \ s" #LOCALS"
+ \ s" WORDLISTS"
+ 2drop false
+ ;
+
+ privatize
\ Based on HMSL Forth
\
\ Author: Phil Burk
- \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
+ \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
\
\ The pForth software code is dedicated to the public domain,
\ and any third party may reproduce, distribute and modify
2* swap
;
+ : D= ( xd1 xd2 -- flag )
+ rot = -rot = and
+ ;
+
+ : D< ( d1 d2 -- flag )
+ d- nip 0<
+ ;
+
+ : D> ( d1 d2 -- flag )
+ 2swap d<
+ ;
+
\ define some useful constants ------------------------------
1 0= constant FALSE
0 0= constant TRUE
\ -------------- INCLUDE ------------------------------------------
variable TRACE-INCLUDE
- : INCLUDE.MARK.START ( $filename -- , mark start of include for FILE?)
- " ::::" pad $MOVE
- count pad $APPEND
- pad ['] noop (:)
+ : INCLUDE.MARK.START ( c-addr u -- , mark start of include for FILE?)
+ dup 5 + allocate throw >r
+ " ::::" r@ $move
+ r@ $append
+ r@ ['] noop (:)
+ r> free throw
;
: INCLUDE.MARK.END ( -- , mark end of include )
" ;;;;" ['] noop (:)
;
- : $INCLUDE ( $filename -- )
- \ Print messages.
+ : INCLUDED ( c-addr u -- )
+ \ Print messages.
trace-include @
IF
- >newline ." Include " dup count type cr
+ >newline ." Include " 2dup type cr
THEN
here >r
- dup
- count r/o open-file
- IF ( -- $filename bad-fid )
- drop ." Could not find file " $type cr abort
- ELSE ( -- $filename good-fid )
- swap include.mark.start
+ 2dup r/o open-file
+ IF ( -- c-addr u bad-fid )
+ drop ." Could not find file " type cr abort
+ ELSE ( -- c-addr u good-fid )
+ -rot include.mark.start
depth >r
include-file \ will also close the file
depth 1+ r> -
rdrop
;
+ : $INCLUDE ( $filename -- ) count included ;
+
create INCLUDE-SAVE-NAME 128 allot
: INCLUDE ( <fname> -- )
BL lword
FREEZE \ prevent forgetting below this point
.( Dictionary compiled, save in "pforth.dic".) cr
+\ 300000 headers-size !
+\ 700000 code-size !
c" pforth.dic" save-forth
projects / pforth / commitdiff