forth5mx_extend.fs

Descripción del contenido de la página

Fichero fuente con las extensiones en Forth de Forth 5mx, un Forth para la computadora Psion 5mx, escrito en OPL+.

Etiquetas:

Código fuente

\ forth5mx_extend.fs

\ Copyright (C) 2005-2010 Marcos Cruz (http://programandala.net)

\ This file is part of Forth 5mx.

\ Forth 5mx is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public License
\ as published by the Free Software Foundation; either version 2
\ of the License, or (at your option) any later version.

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU General Public License for more details.

\ You should have received a copy of the GNU General Public License
\ along with this program. If not, see <http://gnu.org/licenses>.


\ Comment marks:

\ :!!! = not finished
\ ?!!! = to be explored
\ *!!! = debug

\ Notation for the data stack arguments:

\ a-addr = cell-aligned address
\ addr = address
\ b = byte
\ c = printable character
\ char = printable character
\ c-addr = character-aligned address
\ f = flag
\ fam = file access method
\ fid = file identifier
\ ior = input/output result
\ n = signed number
\ +n = positive number
\ nt = name token
\ pfa = parameter field address (data field)
\ d = double number
\ u = unsigned number
\ ud = unsigned double number
\ x = unspecified cell
\ xt = execution token


10 BASE ! UNUSED

\ MARKER forth5mx_extend

.( Extending...) CR

\ ************************
\ .( -Core )

: '  ( -- xt ) \ Core
	BL WORD DUP FIND
	0= ROT COUNT ?abort
	;

: ."  \ Core
	?compiling
	POSTPONE S" POSTPONE TYPE
	; IMMEDIATE

: <resolve  ( -- )
	HERE CELL+ - ,
	;

: resolve>  ( a-addr -- )
	HERE OVER CELL+ - SWAP !
	;

: <mark  ( -- a-addr )
	\ Set up a backward branch by leaving the current address on the stack.
	HERE
	;

: mark>  ( -- a-addr )
	\ Mark the point of a forward branch by saving its address on the stack.
	HERE 0 ,
	;


1 CONSTANT if-mark
2 CONSTANT else-mark
3 CONSTANT begin-mark
4 CONSTANT while-mark
5 CONSTANT do-mark
6 CONSTANT endof-mark
7 CONSTANT of-mark


: IF  \ Core
	?compiling
	POSTPONE 0branch mark> if-mark
	; IMMEDIATE

: THEN  \ Core
	?compiling
	DUP if-mark <>  SWAP else-mark <>  AND
	S" IF missing" ?abort
	resolve>
	; IMMEDIATE

: unstructured  ( u1 u2 c-addr3 u3 -- )
	2SWAP <>  IF error THEN 2DROP
	;

: ELSE  \ Core
	?compiling
	if-mark S" IF missing" unstructured
	POSTPONE branch  mark> SWAP  resolve> else-mark
	; IMMEDIATE

: BEGIN  \ Core
	?compiling
	<mark begin-mark
	; IMMEDIATE

: UNTIL  \ Core
	?compiling
	begin-mark S" BEGIN missing" unstructured
	POSTPONE 0branch  <resolve
	; IMMEDIATE

: WHILE  \ Core
	?compiling
	begin-mark S" BEGIN missing" unstructured
	POSTPONE 0branch  mark> while-mark
	; IMMEDIATE

: REPEAT  \ Core
	?compiling
	while-mark S" WHILE missing" unstructured
	POSTPONE branch SWAP <resolve resolve>
	; IMMEDIATE

: DO  \ Core
	?compiling
	POSTPONE (do) mark> <mark do-mark
	; IMMEDIATE

: ?DO  \ Core
	?compiling
	POSTPONE (?do) mark> <mark do-mark
	; IMMEDIATE

: LOOP  \ Core
	?compiling
	do-mark S" DO missing" unstructured
	POSTPONE (loop) <resolve resolve>
	; IMMEDIATE

: +LOOP  \ Core
	?compiling
	do-mark S" DO missing" unstructured
	POSTPONE (+loop) <resolve resolve>
	; IMMEDIATE

: -LOOP  \ gforth
	\ :!!! *!!! experimental
	?compiling
	do-mark S" DO missing" unstructured
	POSTPONE (-loop) <resolve resolve>
	; IMMEDIATE


: ABORT"  ( f -- ) \ Core
	?compiling POSTPONE S" POSTPONE ?abort
	; IMMEDIATE

: 2!  \ Core
	SWAP OVER ! CELL+ !
	;
 
: 2@  \ Core
	DUP CELL+ @ SWAP @
	;

: BLANK  \ Core
	BL FILL
	;

: S>D  \ Core
	\ Taken from gforth.
	DUP 0<
	;

: LITERAL  ( Compile time: x -- ; Run time: -- x ) \ Core
	?compiling  POSTPONE (literal) ,
	; IMMEDIATE

: [']  \ Core  ( -- )
	?compiling ' POSTPONE LITERAL
	; IMMEDIATE

\ : literal, POSTPONE (literal) , ;
\ : ['] ?compiling ' literal, ; IMMEDIATE
\ : LITERAL ?compiling literal, ; IMMEDIATE

: use  ( xt -- ) \ PsiForth
	\ xt or cfa ?!!!
	\ Modify the code field content of the latest word, thereby
	\ giving it a different run time behaviour.
	\ latest name> ! \ PsiForth
	@ latest name> !  \ Forth 5mx
	;

: CHAR  ( "<spaces>name" -- c ) \ Core
	BL WORD CHAR+ C@
	;

: [CHAR]  ( Compilation: "<spaces>name" -- ; Run-time: -- c ) \ Core
	?compiling
	CHAR POSTPONE LITERAL
	; IMMEDIATE

: DECIMAL  ( -- ) \ Core
	10 BASE !
	;

: next-header  ( nt1 -- nt2 ) \ PsiForth
	1-
	;

: headers  ( xt -- ) \ PsiForth
	\ Executes xt for every word in the dictionary.
	\ In the first execution, the nt of the last word is on the stack.
	>R latest
	BEGIN  ?DUP  WHILE  R@ EXECUTE  REPEAT
	R> DROP
	;

: >name  ( xt -- nt ) \ Forth 5mx
	cell- @
	;

: DOES>  ( -- ) \ Core
	R>  latest name>  ['] (does>) >name
	OVER ! CELL+ !
	;

: RECURSE  ( -- ) \ Core
	latest name> POSTPONE LITERAL POSTPONE EXECUTE
	; IMMEDIATE

\ WORDLIST CONSTANT environment-wordlist
\ environment-wordlist DEFINITIONS

\ ENVIRONTMENT? strings:

\ /COUNTED-STRING is a high level constant
\ /HOLD is undefined
\ /PAD is a high level constant
FALSE CONSTANT BLOCK
FALSE CONSTANT BLOCK-EXT
FALSE CONSTANT CORE
FALSE CONSTANT CORE-EXT
FALSE CONSTANT DOUBLE
FALSE CONSTANT DOUBLE-EXT
FALSE CONSTANT EXCEPTION
FALSE CONSTANT EXCEPTION-EXT
FALSE CONSTANT FACILITY
FALSE CONSTANT FACILITY-EXT
FALSE CONSTANT FILE
FALSE CONSTANT FILE-EXT
FALSE CONSTANT FLOATING
FALSE CONSTANT FLOATING-EXT
\ FALSE CONSTANT FLOATING-STACK
\ FALSE CONSTANT FLOORED
\ FALSE CONSTANT MAX-D
\ FALSE CONSTANT MAX-FLOAT
\ FALSE CONSTANT MAX-N
\ FALSE CONSTANT MAX-U
\ FALSE CONSTANT MAX-UD
FALSE CONSTANT MEMORY-ALLOC
\ RETURN-STACK-CELLS is a high level constant
\ STACK-CELLS is a high level constant
FALSE CONSTANT SEARCH-ORDER
FALSE CONSTANT SEARCH-ORDER-EXT
FALSE CONSTANT STRINGS
FALSE CONSTANT TOOLS
FALSE CONSTANT TOOLS-EXT
\ WORDLISTS is a high level constant
	
: ENVIRONMENT?  ( c-addr u -- false | i*x true )

	\ Unfinished!!!

	\ environtment-wordlist search-wordlist \ :!!! Gforth
	find-name DUP IF
	name> EXECUTE TRUE
	THEN
	
	;

\ FORTH DEFINITIONS


\ ************************
\ .( -Core Ext )

\ Commented out untill >NUMBER is defined:
\ : CONVERT  ( ud1 c-addr1 -- ud2 c-addr2 )  CHAR+ 65535 >NUMBER DROP  ;

: HEX  ( -- ) \ Core Ext
	16 BASE !
	;

: AGAIN  \ Core Ext
	?compiling
	begin-mark S" BEGIN missing" unstructured
	POSTPONE branch <resolve
	; IMMEDIATE

: CASE  ( Compilation: -- 0 u ; Run-time: x -- x ) \ Core Ext
	?compiling
	0 endof-mark
	; IMMEDIATE

: OF  ( u endof-mark -- addr u of-mark ) \ Core Ext
	?compiling
	endof-mark pluck IF  S" ENDOF missing"  ELSE  S" CASE missing" THEN  unstructured
	>R 
	POSTPONE (of)
	mark>
	R> 1+ of-mark
	; IMMEDIATE
	
: ENDOF  ( addr u of-mark -- addr u endof-mark ) \ Core Ext
	?compiling
	of-mark S" OF missing" unstructured
	>R
	POSTPONE branch
	mark> SWAP
	resolve>
	R> endof-mark
	; IMMEDIATE

: ENDCASE  ( Compile: addr_1...addr_u u endof-mark -- ; Run-time: x -- ) \ Core Ext
	?compiling
	endof-mark S" ENDOF missing" unstructured
	POSTPONE DROP
	?DUP IF
		0 DO resolve> LOOP
	THEN
	; IMMEDIATE

: VALUE  ( x -- ) \ Core Ext
	CREATE ,  ['] (value) use
	;

: <to>  ( x "<spaces>name" -- ) \ Forth 5mx
	' >BODY !
	;

: [to]  ( Compile: "<spaces>name" -- ; Run: x -- ) \ Forth 5mx
	' >BODY  POSTPONE LITERAL  POSTPONE !
	; IMMEDIATE
	
: TO  ( Interpretation: x "<spaces>name" -- ; Compilation: "<spaces>name" -- ; Run-time: x -- ) \ Core Ext
	STATE @
	IF  POSTPONE [to]
	ELSE  <to>
	THEN
	; IMMEDIATE

-1 CONSTANT -1
 0 CONSTANT 0
 1 CONSTANT 1
 2 CONSTANT 2

: link  ( addr -- ) \ PsiForth
	\ ?!!! unused
	HERE SWAP exchange ,
	\ ?!!! exchange used only here
	;

: ERASE  ( addr u -- ) \ Core Ext
	0 FILL
	;
	
: WITHIN  ( test low high -- f ) \ Core Ext
	\ Taken from the ANS Forth documentation.
	OVER - >R - R>  U<
	;

: sconstant  ( c-addr u -- ) \ Forth 5mx
	CREATE  s, ALIGN
	DOES>  COUNT
	;

: message:  ( c-addr u -- ) \ PsiForth
	CREATE  s, ALIGN
	DOES>  COUNT TYPE SPACE
	;

: error:  ( c-addr u -- ) \ PsiForth
	CREATE  S, ALIGN
	DOES>  COUNT error
	;

: array  ( u -- ) \ PsiForth
	CREATE
	['] doarray use
	CELLS ALLOT
	;

: table  \ PsiForth
	CREATE
	['] dotable use
	;

: lookup:
	CREATE  HERE 0 ,
	DOES>  lookup
	;

: ;lookup
	HERE OVER CELL+ -
	2 CELLS / SWAP !
	;

: follow
	0 BEGIN
	SWAP ?DUP WHILE
		thread SWAP 1+
	REPEAT
	;

: threads  ( -- )
	\ show # members per thread
	#threads 0 DO
		I DUP 7 AND 0= IF CR THEN
		DUP 4 .R 1+ thread follow  2 .R
	LOOP
	;

\ ************************
\ CR .( -Double)

: 2VARIABLE  \ Double
	CREATE 2 CELLS ALLOT
	;

 : 2LITERAL  ( d -- )  \ Double
 	\ Taken from eForth.
 	SWAP  POSTPONE LITERAL  POSTPONE LITERAL
	; IMMEDIATE

\ : DNEGATE ( d -- -d )
	\ Taken from eForth.
\	INVERT >R INVERT 1 UM+ R> +
\	;

\ : D-  ( d1 d2 -- d3 )  \ Double
	\ Taken from hForth and eForth.
\	DNEGATE D+
\	;

\ : DNEGATE ( d -- -d )
	\ Taken from pForth.
\	0 0 2SWAP d-
\	;

: D>S  ( d -- n ) \ Double
	DROP
	;

\ ************************
\ CR .( -Double Ext)

: 2ROT  ( x1 x2 x3 x4 x5 x6 -- x3 x4 x5 x6 x1 x2 ) \ Double Ext
	2>R 2SWAP 2R> 2SWAP
	;

\ ************************
\ .(-File )

KIoOpenModeOpen
KIoOpenFormatBinary or
KIoOpenAccessRandom or
CONSTANT r/o \ read only file access method
\ This access method sets the file position to the start.

KIoOpenModeAppend
KIoOpenFormatBinary or
KIoOpenAccessRandom or
KIoOpenAccessUpdate or
DUP
CONSTANT w/o \ write only file access method
CONSTANT r/w \ read and write file access method
\ This access methods set the file position to the end.

: BIN  ( fam1 -- fam2 ) \ File
	\ Change file access method from text to binary.
	\ It does nothing, because all files are opened in binary mode.
	\ Old code:
	\ KIoOpenFormatText INVERT AND KIoOpenFormatBinary OR
	;

: REPOSITION-FILE  ( ud fid -- ior ) \ File
	\ Reset the file position to ud .
	\ It doesn't work with files opened in text mode.
	>R D>S R>  \ :!!!
	1 ( mode) SWAP seek-file
	SWAP DROP
	;

: rewind-file  ( fid -- ior ) \ Forth 5mx
	\ System specific version of REPOSITION-FILE .
	\ Rewind a text file to the start.
	\ It doesn't work with files opened in binary mode.
	0 ( offset) 6 ( mode) ROT seek-file
	SWAP DROP
	;

\ not finished
\ defer (rewind)
\ ' REPOSITION-FILE is (rewind)
\ : rewind   ( fid -- ) \ Common use
\	0 DUP ROT
\	;
	
: FILE-POSITION  ( fid -- ud ior ) \ File
	\ Return the current file position.
	\ It doesn't work with files opened in text mode.
	0 ( offset) 3 ( mode) ROT seek-file
	>R S>D R>
	;

: FILE-SIZE  ( fid -- ud ior ) \ File
	\ Return the file size.
	\ Unfinished:
	\ It doesn't work with files opened in text mode.
	\ It returns a dummy ior flag, always false :!!!
	DUP DUP file-position  ( fid fid d ior -- )  \ current file position
	ABORT" file-position error in file-size"
	ROT 0 ( offset) 2 ( mode) ROT seek-file  \ move file pointer to the end to get the file size
	ABORT" seek-file error in file-size"
	>R ROT REPOSITION-FILE  \ preserve the file size and restore the file pointer
	ABORT" reposition-file error in file-size"
	R> S>D  \ file lenght
	FALSE  \ dummy ior flag :!!!
	;

: include?  ( "<spaces>word<spaces>filename" -- ) \ Taken from pForth
	BL WORD FIND
	IF  BL WORD 2DROP
	ELSE  DROP include
	THEN
	;

' include? alias require  \ a more common name

\ ************************
\ .(-String )

: /STRING  ( c-addr1 u1 +n -- c-addr2 u2 ) \ String
	DUP >R - SWAP R> + SWAP
	;

: str=  ( c-addr1 u1 c-addr2 u2 -- f ) \ gforth
	COMPARE 0=
	;

: str<  ( c-addr1 u1 c-addr2 u2 -- f ) \ gforth
	COMPARE 0<
	;

: string-prefix?  ( c-addr1 u1 c-addr2 u2 -- f ) \ gforth
	\ Is c-addr2 u2 a prefix of c-addr1 u1 ?
	TUCK 2>R MIN 2R> str=
	;

\ ************************
\ .(-Tools )

: ?  ( addr -- ) \ Tools
	@ .
	;

: .S  ( -- ) \ Tools
	DEPTH DUP 0> IF
		BEGIN DUP
		WHILE DUP PICK . 1-
		REPEAT
	ELSE
		S" stack empty" TYPE
	THEN DROP
	;

: more  ( -- f) \ PsiForth
	\ f = TRUE (no key pressed, or other than Escape)
	\ f = FALSE (Escape key pressed)
	KEY? DUP  IF
		KEY esc <>  IF
			CR S" --- more ---" TYPE
			KEY esc = AND
		THEN
	THEN
	NOT
	;

15 CONSTANT #creators
#creators array creator

: creator"  ( n -- ) \ PsiForth
	HERE SWAP creator !
	[CHAR] " WORD COUNT S,
	;

0 creator" primitive"
1 creator" :"
2 creator" variable"
3 creator" variable" \ primitive variable
4 creator" constant"
5 creator" 2constant"
6 creator" does>"
7 creator" defer"
8 creator" uvariable"  \ ?!!! psiforth
9 creator" array"  \ ?!!! psiforth
10 creator" table"  \ ?!!! psiforth
11 creator" code"  \ ?!!! psiforth
12 creator" create"
13 creator" value"
14 creator" marker"
ALIGN

: .creator  ( nt -- ) \ Forth 5mx
	DUP #creators > AND
	DUP  IF
		name> @ DUP #creators < AND
	THEN
	creator @ COUNT  11 OVER - SPACES  TYPE SPACE
	;

: .header  ( nt -- nt ) \ PsiForth
	CR DUP 6 .R
	DUP name> 7 .R
	BL OVER immediate?  IF  DROP [CHAR] #  THEN  EMIT
	DUP .creator
	DUP .name
	next-header more AND
	;

: WORDS  ( -- ) \ Tool
	['] .header headers
	;


\ ************************
\ .(-Tools Ext )

\ The data stack is used as control stack:
' pick alias CS-PICK
' roll alias CS-ROLL

\ S" forth5mx_extend_[if].fs" INCLUDED

: [if]?  ( c-addr u -- f )
	S" [IF]" COMPARE 0=
	;

: [else]?  ( c-addr u -- f )
	S" [ELSE]" COMPARE 0=
	;

: [then]?  ( c-addr u -- f )
	S" [THEN]" COMPARE 0=
	;

: [ELSE]  ( -- ) \ Tools Ext
	\ Skip the code until [THEN] is found.
	\ Code taken from pforth.
	1  \ recursion level
	BEGIN	
		BEGIN
			\ parse-word DUP \ (this some times causes a "string too long OPL error" because of the parse-word implementation)
			BL WORD COUNT DUP  \ (the classic way 
		WHILE
			2DUP upper
			2DUP [if]?
			IF
				2DROP 1+
			ELSE 
				2DUP [else]?
				IF
					2DROP 1- DUP IF  1+  THEN
				ELSE
					[then]? IF  1-  THEN
				THEN
			THEN
			?DUP 0= IF  EXIT  THEN
		REPEAT
		2DROP REFILL 0=
	UNTIL
	; IMMEDIATE

: [IF]  ( f -- ) \ Tools Ext
	\ If TOS is true, skip the code until [THEN] is found.
	\ Code taken from pforth.
	0= IF  POSTPONE [ELSE]  THEN
	; IMMEDIATE

: [THEN]  ( -- ) \ Tools Ext
	; IMMEDIATE


	
\ ************************
\ .( -Facility Ext )

: TIME&DATE  ( -- sec min hour day month year )
	second minute hour day month year
	;
	
\ ************************
\ .(-Not ANS )  \ common use

: on  ( a-addr -- ) \ Common use
	TRUE SWAP !
	;

: off ( a-addr -- ) \ Common use
	FALSE SWAP !
	;

: [defined]  \ Common use
	BL WORD FIND NIP 0<>
	; IMMEDIATE
	
: [ifdef]  \ Common use
	POSTPONE [defined]
	POSTPONE [IF]
	; IMMEDIATE
	
: [undefined]  \ Common use
	POSTPONE [defined] INVERT
	; IMMEDIATE

: [ifundef]  \ Common use
	POSTPONE [undefined]
	POSTPONE [IF]
	; IMMEDIATE

: endif  \ Common use
	POSTPONE THEN ; IMMEDIATE

: defer ( "<spaces>name" -- )  \ Common use
	CREATE  ['] noop ,  ['] (defer) use
	;

: <is>  ( xt "<spaces>name" -- ) \ gforth
	' >BODY !
	;

: [is]  ( compilation: "<spaces>name" -- ; run-time: xt -- ) \ gforth	
	' >BODY  POSTPONE LITERAL  POSTPONE !
	; IMMEDIATE
	
: is  ( xt "<spaces>name" -- ) \ Common use
	STATE @  IF  POSTPONE [is]
	ELSE  <is>
	THEN
	; IMMEDIATE

: svariable  ( "<spaces>name" -- ) \ Common use
	CREATE  256 CHARS ALLOT  ALIGNED
	;

: place  ( c-addr1 u1 c-addr2 --) \ Common use

	\ From "An so Forth..." by J.L. Bezemer (2001-04-06):
	\ OVER OVER >R >R CHAR+ SWAP CHARS CMOVE R> R> C!

	\ My own version, from my fstr toolkit (I called it STR! ):
	2DUP C! 1+ SWAP CMOVE

	;

: binary  ( -- ) \ Common use
	2 BASE !
	;

FALSE [IF]
: alias  ( xt "<spaces>name" -- ) \ Common use
	CREATE ,
	DOES> @ EXECUTE
	;
[THEN]

: under+  ( n1 n2 n3 -- n4 n2 ) \ Common use
	ROT + SWAP
	;

: bounds  ( c-addr1 u1 -- c-addr2 c-addr1 ) \ Common use
	OVER + SWAP
	;

: under  ( x1 x2 x3 -- x3 x2 ) \ Common use
	ROT DROP SWAP
	;


\ ************************
\ Facility Ext (defered)

defer EMIT?
' TRUE is EMIT?

	
\ ************************
\ - Not ANS - Forth 5mx

: -seconds  \ Forth 5mx
	( second minute hour day month year -- seconds )
	\ Calculates time diference in seconds between the date given and now.
	date>secs TIME&DATE date>secs SWAP -
;

: pwd  \ Forth 5mx
	path TYPE
;

create 'newline 
	2 c, 13 c, 10 c,   \ dos:  cr lf
: newline  ( -- c-addr u ) 
	\ Used in Gforth.
	\ Needed by the Forth Foundation Libray (in config.fs).
	\ 2010-03-21
	'newline count
	;
	
: string,  ( -- c-addr u ) 
	\ Used in Gforth.
	\ Needed by the Forth Foundation Libray (in config.fs).
	\ 2010-03-21
	dup c, here swap dup allot move
	;

\ ************************
\ - Sound

: play:

	\ 2006 08 16 I Simplified the PsiForth version: no sound path.

	CREATE  ( c-addr u -- )
		s, ALIGN
	DOES>  ( pfa -- )
		COUNT play

	;

\ Examples:
\ S" c:\sounds\01" play: one
\ S" d:\doc\tmp\cock" play: cock

: bell 16 200 beep ;

: error-bell bell bell bell ;

\ ' error-bell error-sound-xt !
error-sound? on

\ ************************
\ Drafts and debugging

0 [IF]

: MARKER  ( "<spaces>name" -- ) \ Core Ext
	\ :!!!
	HERE latest
	CREATE , ,
	DOES> DUP @ (latest) ! CELL+ @ dp !
	;

[THEN]

: .thread ( -- )
	#threads 1+ 1
	DO
		I thread CR .
	LOOP
	;

\ ************************
\ Debug tools

: debug-included

	\ Redefine INCLUDED to detect unbalanced stack.

	\ 2007-06-19

	S" ' INCLUDED  : INCLUDED  LITERAL EXECUTE DEPTH IF 10 10 beep [CHAR] * EMIT KEY DROP THEN  ;" EVALUATE
	
	;

\ ************************
\ Provisional

\ Words that must exist but are not developed yet.

: FORTH ;
: ONLY ;
: ALSO ;
: root ;
: DEFINITIONS  CONTEXT @ CURRENT ! ;
: SET-CURRENT  ( wid -- )  CURRENT !  ;
: GET-CURRENT  ( -- @ )  CURRENT @  ;
: environment ;  \ in the future this will be a word-list
: forth5mx ;  \ this will be in the environment word-list and will return some info
: FALIGNED ALIGNED ;

\ ************************
\ Dummy

: · CR ." Warning: Char · found" ;  \ just to avoid the error caused by this symbol, left at the end of file texts by some editors

\ ************************
\ License

: license ( -- )
 cr
 ." This program is free software; you can redistribute it and/or modify" cr
 ." it under the terms of the GNU General Public License as published by" cr
 ." the Free Software Foundation; either version 2 of the License, or" cr
 ." (at your option) any later version." cr cr

 ." This program is distributed in the hope that it will be useful," cr
 ." but WITHOUT ANY WARRANTY; without even the implied warranty of" cr
 ." MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the" cr
 ." GNU General Public License for more details." cr cr

 ." You should have received a copy of the GNU General Public License" cr
 ." along with this program. If not, see <http://gnu.org/licenses>." cr
 ;


\ ************************
\ Preferences

error-sound? on
debug? on


\ ************************
\ Free memory

UNUSED TUCK -

CR .( Memory stats: )
. .( bytes compiled, )
. .( bytes free)
CR