Commit 62956219 authored by jwilke's avatar jwilke

changes from gforth-ec:

updated cross (side-effect: no more warnings :-)
some changed other forth-files
['] can not do forward references any more
parent 170e3b6b
This diff is collapsed.
......@@ -31,6 +31,10 @@ Create environment-wordlist wordlist drop
: e? name environment? ; immediate
: has? name environment? IF ELSE false THEN ;
: $has? environment? IF ELSE false THEN ;
environment-wordlist set-current
get-order environment-wordlist swap 1+ set-order
......
......@@ -47,7 +47,7 @@ Variable argc ( -- addr ) \ gforth
r> >tib +! 2 EXIT THEN
." Unknown option: " type cr 2drop 1 ;
: process-args ( -- )
: (process-args) ( -- )
true to script?
>tib @ >r
argc @ 1
......@@ -64,3 +64,4 @@ Variable argc ( -- addr ) \ gforth
false to script?
;
' (process-args) IS process-args
......@@ -28,8 +28,10 @@ HEX
\ Aliases
[IFUNDEF] r@
' i Alias r@ ( -- w ; R: w -- w ) \ core r-fetch
\G copy w from the return stack to the data stack
[THEN]
\ !! this is machine-dependent, but works on all but the strangest machines
......@@ -50,8 +52,14 @@ HEX
\ UNUSED 17may93jaw
has? ec
[IF]
unlock ram-dictionary area nip lock
Constant dictionary-end
[ELSE]
: dictionary-end ( -- addr )
forthstart [ 3 cells ] Aliteral @ + ;
[THEN]
: unused ( -- u ) \ core-ext
dictionary-end here - [ word-pno-size pad-minsize + ] Literal - ;
......@@ -65,6 +73,7 @@ HEX
\ on off 23feb93py
\ on is used by docol:
: on ( addr -- ) \ gforth
true swap ! ;
: off ( addr -- ) \ gforth
......
......@@ -67,6 +67,8 @@
\ additional words only needed if there is file support
Warnings off
: ( ( compilation 'ccc<close-paren>' -- ; run-time -- ) \ core,file paren
loadfile @ 0= IF postpone ( EXIT THEN
BEGIN
......@@ -84,3 +86,4 @@
THEN
REPEAT ; immediate
Warnings on
\ definitions needed for interpreter / compiler only
doer? :docon [IF]
: docon: ( -- addr ) \ gforth
\G the code address of a @code{CONSTANT}
['] bl >code-address ;
[THEN]
: docol: ( -- addr ) \ gforth
\G the code address of a colon definition
['] docol: >code-address ;
doer? :dovar [IF]
: dovar: ( -- addr ) \ gforth
\G the code address of a @code{CREATE}d word
\ in rom-applications variable might be implemented with constant
\ use really a created word!
['] ??? >code-address ;
[THEN]
doer? :douser [IF]
: douser: ( -- addr ) \ gforth
\G the code address of a @code{USER} variable
['] sp0 >code-address ;
[THEN]
doer? :dodefer [IF]
: dodefer: ( -- addr ) \ gforth
\G the code address of a @code{defer}ed word
['] source >code-address ;
[THEN]
doer? :dofield [IF]
: dofield: ( -- addr ) \ gforth
\G the code address of a @code{field}
['] reveal-method >code-address ;
[THEN]
.( test1 )
has-prims 0= [IF]
: dodoes: ( -- addr ) \ gforth
\G the code address of a @code{field}
['] spaces >code-address ;
.( test2 )
[THEN]
\ here allot , c, A, 17dec92py
: allot ( n -- ) \ core
......@@ -161,6 +117,21 @@ Defer source ( -- addr count ) \ core
: [char] ( compilation 'char' -- ; run-time -- n )
char postpone Literal ; immediate restrict
\ threading 17mar93py
: cfa, ( code-address -- ) \ gforth cfa-comma
here
dup lastcfa !
0 A, 0 , code-address! ;
: compile, ( xt -- ) \ core-ext compile-comma
A, ;
: !does ( addr -- ) \ gforth store-does
lastxt does-code! ;
: (does>) ( R: addr -- )
r> cfaligned /does-handler + !does ;
: dodoes, ( -- )
cfalign here /does-handler allot does-handler! ;
: (compile) ( -- ) \ gforth
r> dup cell+ >r @ compile, ;
......@@ -448,21 +419,6 @@ const Create ??? 0 , 3 c, char ? c, char ? c, char ? c,
: body> 0 >body - ;
\ threading 17mar93py
: cfa, ( code-address -- ) \ gforth cfa-comma
here
dup lastcfa !
0 A, 0 , code-address! ;
: compile, ( xt -- ) \ core-ext compile-comma
A, ;
: !does ( addr -- ) \ gforth store-does
lastxt does-code! ;
: (does>) ( R: addr -- )
r> cfaligned /does-handler + !does ;
: dodoes, ( -- )
cfalign here /does-handler allot does-handler! ;
doer? :dovar [IF]
: Create ( "name" -- ) \ core
Header reveal dovar: cfa, ;
......@@ -605,9 +561,6 @@ struct
cell% field interpret/compile-comp
end-struct interpret/compile-struct
: interpret/compile? ( xt -- flag )
>does-code ['] S" >does-code = ;
: (cfa>int) ( cfa -- xt )
dup interpret/compile?
if
......@@ -944,6 +897,7 @@ DEFER DOERROR
[ [THEN] ] ;
defer bootmessage
defer process-args
' (bootmessage) IS bootmessage
......
......@@ -56,3 +56,49 @@ interpret/compile: DOES> ( compilation colon-sys1 -- colon-sys2 ; run-time nest
immediate
doer? :docon [IF]
: docon: ( -- addr ) \ gforth
\G the code address of a @code{CONSTANT}
['] bl >code-address ;
[THEN]
: docol: ( -- addr ) \ gforth
\G the code address of a colon definition
['] on >code-address ;
\ !! mark on
doer? :dovar [IF]
: dovar: ( -- addr ) \ gforth
\G the code address of a @code{CREATE}d word
\ in rom-applications variable might be implemented with constant
\ use really a created word!
['] ??? >code-address ;
[THEN]
doer? :douser [IF]
: douser: ( -- addr ) \ gforth
\G the code address of a @code{USER} variable
['] sp0 >code-address ;
[THEN]
doer? :dodefer [IF]
: dodefer: ( -- addr ) \ gforth
\G the code address of a @code{defer}ed word
['] source >code-address ;
[THEN]
doer? :dofield [IF]
: dofield: ( -- addr ) \ gforth
\G the code address of a @code{field}
['] reveal-method >code-address ;
[THEN]
has-prims 0= [IF]
: dodoes: ( -- addr ) \ gforth
\G the code address of a @code{field}
['] spaces >code-address ;
[THEN]
: interpret/compile? ( xt -- flag )
>does-code ['] S" >does-code = ;
\ Interpretative Structuren 16feb92py
\ Copyright (C) 1995 Free Software Foundation, Inc.
\ This file is part of Gforth.
......@@ -18,6 +16,7 @@
\ along with this program; if not, write to the Free Software
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Warnings off
Variable countif
......@@ -95,3 +94,4 @@ User (i)
0= IF postpone [ELSE] true rdrop rdrop 1 countif +! THEN ;
immediate
Warnings on
......@@ -44,23 +44,34 @@ decimal
\ !!! nicht optimal!
[IFUNDEF] look
[IFUNDEF] dictionary-end has-rom [ELSE] false [THEN]
[IF]
has? ec [IF]
has-rom
[IF]
: look
dup [ unlock rom-dictionary area lock ]
literal literal within
IF
>name dup ?? <>
ELSE
forth-wordlist @ (look)
THEN ;
[ELSE]
: look ( cfa -- lfa flag )
forth-wordlist @ (look) ;
>name dup ??? <> ;
[THEN]
[ELSE]
: PrimStart ['] true >name ;
: look ( cfa -- lfa flag )
dup dictionary-end forthstart within
IF
PrimStart (look)
ELSE
>name dup ??? <>
THEN ;
dup dictionary-end forthstart within
IF
PrimStart (look)
ELSE
>name dup ??? <>
THEN ;
[THEN]
[THEN]
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment