Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
gforth
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Bernd Paysan
gforth
Commits
58d3846d
Commit
58d3846d
authored
Jun 17, 1994
by
anton
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Integrated locals (in particular automatic scoping) into the system.
parent
2eacd44a
Changes
14
Hide whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
578 additions
and
464 deletions
+578
-464
Makefile
Makefile
+1
-1
cross.fs
cross.fs
+5
-2
float.fs
float.fs
+0
-7
gforth.el
gforth.el
+2
-1
gforth.texi
gforth.texi
+10
-6
glocals.fs
glocals.fs
+61
-293
io.c
io.c
+1
-1
kernal.fs
kernal.fs
+360
-70
locals-test.fs
locals-test.fs
+63
-43
machine32b.fs
machine32b.fs
+1
-0
machine32l.fs
machine32l.fs
+1
-0
main.c
main.c
+6
-1
primitives
primitives
+65
-37
toolsext.fs
toolsext.fs
+2
-2
No files found.
Makefile
View file @
58d3846d
...
...
@@ -3,7 +3,7 @@
RM
=
echo
'Trying to remove'
GCC
=
gcc
CC
=
gcc
SWITCHES
=
-DUSE_TOS
-DUSE_FTOS
-DDEFAULTBIN
=
'"'
$(PWD)
'"'
# -DDIRECT_THREADED
SWITCHES
=
-D
_POSIX_VERSION
#-D
USE_TOS -DUSE_FTOS -DDEFAULTBIN='"'
$(PWD)
'"'
# -DDIRECT_THREADED
CFLAGS
=
-O4
-Wall
-g
$(SWITCHES)
#-Xlinker -n puts text and data into the same 256M region
...
...
cross.fs
View file @
58d3846d
\
CROSS
.
FS
The
Cross
-
Compiler
06
oct92py
\
$
Id
:
cross
.
fs
,
v
1
.
5
1994
-
06
-
01
10
:
05
:
14
pazsa
n
Exp
$
\
$
Id
:
cross
.
fs
,
v
1
.
6
1994
-
06
-
17
12
:
34
:
58
anto
n
Exp
$
\
Idea
and
implementation
:
Bernd
Paysan
(
py
)
\
Copyright
1992
by
the
ANSI
figForth
Development
Group
...
...
@@ -134,7 +134,8 @@ include machine.fs
: cell+ cell + ;
: cells cell<< lshift ;
: chars ;
: floats float * ;
>CROSS
: cell/ cell<< rshift ;
>TARGET
...
...
@@ -488,6 +489,8 @@ Cond: [Char] ( "<char>" -- ) restrict? Char lit, ;Cond
Cond: EXIT ( -- ) restrict? compile ;S ;Cond
Cond: ?EXIT ( -- ) 1 abort"
CROSS
:
using
?
exit
" ;Cond
Cond: ; ( -- ) restrict?
depth ?dup IF 1- <> ABORT"
CROSS
:
Stack
changed
"
ELSE true ABORT"
CROSS
:
Stack
empty
" THEN
...
...
float.fs
View file @
58d3846d
\
High
level
floating
point
14
jan94py
:
faligned
(
addr
--
f
-
addr
)
[
1
floats
1
-
]
Literal
+
[
-
1
floats
]
Literal
and
;
:
falign
(
--
)
here
dup
faligned
swap
?
DO
bl
c
,
LOOP
;
:
f
,
(
f
--
)
here
1
floats
allot
f
!
;
\
!!
have
create
produce
faligned
pfas
...
...
gforth.el
View file @
58d3846d
...
...
@@ -16,7 +16,7 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; $Header: /usr/local/lib/cvs-repository/src-master/gforth/gforth.el,v 1.
1 1994-05-07 14:55:53
anton Exp $
;;; $Header: /usr/local/lib/cvs-repository/src-master/gforth/gforth.el,v 1.
2 1994-06-17 12:35:01
anton Exp $
;;-------------------------------------------------------------------
;; A Forth indentation, documentation search and interaction library
...
...
@@ -121,6 +121,7 @@ OBS! All words in forth-negatives must be surrounded by spaces.")
(make-local-variable 'parse-sexp-ignore-comments)
(setq parse-sexp-ignore-comments t))
;;;###autoload
(defun forth-mode ()
"
Major
mode
for
editing
Forth
code.
Tab
indents
for
Forth
code.
Comments
...
...
gforth.texi
View file @
58d3846d
...
...
@@ -177,7 +177,7 @@ variable @code{GFORTHPATH}; if this does not exist, in
@node Notation, Arithmetic, Words, Words
@section Notation
The Forth words are describe
s
in this section in the glossary notation
The Forth words are describe
d
in this section in the glossary notation
that has become a de-facto standard for Forth texts, i.e.
@quotation
...
...
@@ -320,10 +320,10 @@ theoretically keep floating point numbers on the data stack. As an
additional difficulty, you don't know how many cells a floating point
numkber takes. It is reportedly possible to write words in a way that
they work also for a unified stack model, but we do not recommend trying
it. Also, a Forth system
to keep the local variables on the return
stack. This is reasonable, as local variables usually eliminate the need
t
o use the return stack explicitely. So, if you want to produce a
standard complying program and if you are using local variables in a
it. Also, a Forth system
is allowed to keep the local variables on the
return stack. This is reasonable, as local variables usually eliminate
t
he need to use the return stack explicitely. So, if you want to produce
a
standard complying program and if you are using local variables in a
word, forget about return stack manipulations in that word (see the
standard document for the exact rules).
...
...
@@ -417,7 +417,7 @@ IF
@var
{
code
}
ENDIF
@end example
or
@example
@var
{
flag
}
IF
...
...
@@ -527,11 +527,13 @@ index by @var{n} instead of by 1. The loop is terminated when the border
between @var
{
limit-1
}
and @var
{
limit
}
is crossed. E.g.:
4 0 ?DO i . 2 +LOOP prints 0 2
4 1 ?DO i . 2 +LOOP prints 1 3
The behaviour of @code
{
@var
{
n
}
+LOOP
}
is peculiar when @var
{
n
}
is negative:
-1 0 ?DO i . -1 +LOOP prints 0 -1
0 0 ?DO i . -1 +LOOP prints nothing
Therefore we recommend avoiding using @code
{
@var
{
n
}
+LOOP
}
with negative
...
...
@@ -539,7 +541,9 @@ Therefore we recommend avoiding using @code{@var{n} +LOOP} with negative
case behaves symmetrical to the positive case:
-2 0 ?DO i . -1 +LOOP prints 0 -1
-1 0 ?DO i . -1 +LOOP prints 0
0 0 ?DO i . -1 +LOOP prints nothing
The loop is terminated when the border between @var
{
limit-sgn(n)
}
and
...
...
glocals.fs
View file @
58d3846d
...
...
@@ -64,6 +64,22 @@
include
float
.
fs
include
search
-
order
.
fs
:
compile
-@
local
(
n
--
)
case
0
of
postpone
@
local0
endof
4
of
postpone
@
local4
endof
8
of
postpone
@
local8
endof
12
of
postpone
@
local12
endof
(
otherwise
)
dup
postpone
@
local
#
,
endcase
;
:
compile
-
f
@
local
(
n
--
)
case
0
of
postpone
f
@
local0
endof
8
of
postpone
f
@
local8
endof
(
otherwise
)
dup
postpone
f
@
local
#
,
endcase
;
\
the
locals
stack
grows
downwards
(
see
primitives
)
\
of
the
local
variables
of
a
group
(
in
braces
)
the
leftmost
is
on
top
,
\
i
.
e
.
by
going
onto
the
locals
stack
the
order
is
reversed
.
...
...
@@ -72,9 +88,7 @@ include search-order.fs
\
for
simplicity
we
align
it
strictly
for
every
group
.
vocabulary
locals
\
this
contains
the
local
variables
'
locals
>
body
Constant
locals
-
list
\
acts
like
a
variable
that
contains
\
a
linear
list
of
locals
names
:
locals
-
list
!
(
list
--
)
locals
-
list
!
locals
-
list
rehash
;
'
locals
>
body
'
locals
-
list
>
body
!
create
locals
-
buffer
1000
allot
\
!!
limited
and
unsafe
\
here
the
names
of
the
local
variables
are
stored
...
...
@@ -84,10 +98,10 @@ variable locals-dp \ so here's the special dp for locals.
:
alignlp
-
w
(
n1
--
n2
)
\
cell
-
align
size
and
generate
the
corresponding
code
for
aligning
lp
dup
aligned
tuck
-
compile
-
lp
+!#
;
aligned
dup
adjust
-
locals
-
size
;
:
alignlp
-
f
(
n1
--
n2
)
dup
faligned
tuck
-
compile
-
lp
+!#
;
faligned
dup
adjust
-
locals
-
size
;
\
a
local
declaration
group
(
the
braces
stuff
)
is
compiled
by
calling
\
the
appropriate
compile
-
pushlocal
for
the
locals
,
starting
with
the
...
...
@@ -112,7 +126,7 @@ variable locals-dp \ so here's the special dp for locals.
postpone
swap
postpone
>
l
postpone
>
l
;
:
compile
-
pushlocal
-
c
(
a
-
addr
--
)
(
run
-
time
:
w
--
)
-
1
chars
compile
-
lp
+!
#
-
1
chars
compile
-
lp
+!
locals
-
size
@
swap
!
postpone
lp
@
postpone
c
!
;
...
...
@@ -122,11 +136,15 @@ variable locals-dp \ so here's the special dp for locals.
immediate
here
0
,
(
place
for
the
offset
)
;
:
lp
-
offset
(
n1
--
n2
)
\
converts
the
offset
from
the
frame
start
to
an
offset
from
lp
and
\
i
.
e
.,
the
address
of
the
local
is
lp
+
locals_size
-
offset
locals
-
size
@
swap
-
;
:
lp
-
offset
,
(
n
--
)
\
converts
the
offset
from
the
frame
start
to
an
offset
from
lp
and
\
adds
it
as
inline
argument
to
a
preceding
locals
primitive
\
i
.
e
.,
the
address
of
the
local
is
lp
+
locals_size
-
offset
locals
-
size
@
swap
-
,
;
lp
-
offset
,
;
vocabulary
locals
-
types
\
this
contains
all
the
type
specifyers
,
--
and
}
locals
-
types
definitions
...
...
@@ -137,7 +155,7 @@ locals-types definitions
[
'
]
compile
-
pushlocal
-
w
does
>
(
Compilation
:
--
)
(
Run
-
time
:
--
w
)
\
compiles
a
local
variable
access
postpone
@
local
#
@
lp
-
offset
,
;
@
lp
-
offset
compile
-@
local
;
:
W
^
create
-
local
(
"name"
--
a
-
addr
xt
)
...
...
@@ -149,7 +167,7 @@ locals-types definitions
create
-
local
(
"name"
--
a
-
addr
xt
)
[
'
]
compile
-
pushlocal
-
f
does
>
(
Compilation
:
--
)
(
Run
-
time
:
--
w
)
postpone
f
@
local
#
@
lp
-
offset
,
;
@
lp
-
offset
compile
-
f
@
local
;
:
F
^
create
-
local
(
"name"
--
a
-
addr
xt
)
...
...
@@ -193,8 +211,6 @@ forth definitions
\
So
we
create
a
vocabulary
new
-
locals
,
that
creates
a
'
w
:
'
local
named
x
\
when
it
is
asked
if
it
contains
x
.
0
.
2
constant
last
-
local
\
!!
actually
a
2
value
also
locals
-
types
:
new
-
locals
-
find
(
caddr
u
w
--
nfa
)
...
...
@@ -202,9 +218,8 @@ also locals-types
\
make
a
new
local
with
name
caddr
u
;
w
is
ignored
\
the
returned
nfa
denotes
a
word
that
produces
what
W
:
produces
\
!!
do
the
whole
thing
without
nextname
drop
nextname
W
:
\
we
don't
want
the
thing
that
W
:
produces
,
[
'
]
last
-
local
>
body
2
!
\
but
the
nfa
of
a
word
that
produces
that
value
:
last
-
local
[
'
last
-
local
>
name
]
Aliteral
;
drop
nextname
[
'
]
W
:
>
name
;
previous
...
...
@@ -337,98 +352,7 @@ forth definitions
\
If
this
assumption
is
too
optimistic
,
the
compiler
will
warn
the
user
.
\
Implementation
:
\
orig
,
dest
and
do
-
sys
have
the
following
structure
:
\
address
(
of
the
branch
or
the
instruction
to
be
branched
to
)
(
TOS
)
\
locals
-
list
(
valid
at
address
)
(
second
)
\
locals
-
size
(
at
address
;
this
could
be
computed
from
locals
-
list
,
but
so
what
)
(
third
)
3
constant
cs
-
item
-
size
:
CS
-
PICK
(
...
u
--
...
destu
)
1
+
cs
-
item
-
size
*
1
-
>
r
r
@
pick
r
@
pick
r
@
pick
rdrop
;
:
CS
-
ROLL
(
destu
/
origu
..
dest0
/
orig0
u
--
..
dest0
/
orig0
destu
/
origu
)
1
+
cs
-
item
-
size
*
1
-
>
r
r
@
roll
r
@
roll
r
@
roll
rdrop
;
:
CS
-
PUSH
(
--
dest
/
orig
)
locals
-
size
@
locals
-
list
@
here
;
:
BUT
sys
?
1
cs
-
roll
;
immediate
restrict
:
YET
sys
?
0
cs
-
pick
;
immediate
restrict
:
common
-
list
(
list1
list2
--
list3
)
\
list1
and
list2
are
lists
,
where
the
heads
are
at
higher
addresses
than
\
the
tail
.
list3
is
the
largest
sublist
of
both
lists
.
begin
2
dup
u
<>
while
2
dup
u
>
if
swap
endif
@
repeat
drop
;
:
sub
-
list
?
(
list1
list2
--
f
)
\
true
iff
list1
is
a
sublist
of
list2
begin
2
dup
u
<
while
@
repeat
=
;
:
list
-
size
(
list
--
u
)
\
size
of
the
locals
frame
represented
by
list
0
(
list
n
)
begin
over
0
<>
while
over
cell
+
name
>
>
body
@
max
swap
@
swap
(
get
next
)
repeat
faligned
nip
;
:
x
>
mark
(
--
orig
)
cs
-
push
0
,
;
variable
dead
-
code
\
true
if
normal
code
at
"here"
would
be
dead
:
unreachable
(
--
)
\
declares
the
current
point
of
execution
as
unreachable
and
\
prepares
the
assumptions
for
a
possible
upcoming
BEGIN
dead
-
code
on
dup
0
<>
if
2
pick
2
pick
else
0
0
endif
locals
-
list
!
locals
-
size
!
;
:
check
-
begin
(
list
--
)
\
warn
if
list
is
not
a
sublist
of
locals
-
list
locals
-
list
@
sub
-
list
?
0
=
if
\
!!
print
current
position
.
" compiler was overly optimistic about locals at a BEGIN"
cr
\
!!
print
assumption
and
reality
endif
;
:
xahead
(
--
orig
)
POSTPONE
branch
x
>
mark
unreachable
;
immediate
:
xif
(
--
orig
)
POSTPONE
?
branch
x
>
mark
;
immediate
\
Implementation
:
migrated
to
kernal
.
fs
\
THEN
(
another
control
flow
from
before
joins
the
current
one
):
\
The
new
locals
-
list
is
the
intersection
of
the
current
locals
-
list
and
...
...
@@ -442,192 +366,36 @@ variable dead-code \ true if normal code at "here" would be dead
\
inefficient
,
e
.
g
.
if
there
is
a
locals
declaration
between
IF
and
\
ELSE
.
However
,
if
ELSE
generates
an
appropriate
"lp+!#"
before
the
\
branch
,
there
will
be
none
after
the
target
<
then
>.
:
xthen
(
orig
--
)
sys
?
dup
@
?
struc
dead
-
code
@
if
>
resolve
locals
-
list
!
locals
-
size
!
else
locals
-
size
@
3
roll
-
compile
-
lp
+!#
>
resolve
locals
-
list
@
common
-
list
locals
-
list
!
locals
-
size
@
locals
-
list
@
list
-
size
-
compile
-
lp
+!#
endif
dead
-
code
off
;
immediate
:
scope
(
--
dest
)
cs
-
push
;
immediate
:
endscope
(
dest
--
)
\
explicit
scoping
:
scope
(
--
scope
)
cs
-
push
-
part
scopestart
;
immediate
:
endscope
(
scope
--
)
scope
?
drop
locals
-
list
@
common
-
list
locals
-
list
!
locals
-
size
@
locals
-
list
@
list
-
size
-
compile
-
lp
+!#
drop
;
immediate
:
xexit
(
--
)
locals
-
size
@
compile
-
lp
+!#
POSTPONE
exit
unreachable
;
immediate
:
x
?
exit
(
--
)
POSTPONE
xif
POSTPONE
xexit
POSTPONE
xthen
;
immediate
:
xelse
(
orig1
--
orig2
)
sys
?
POSTPONE
xahead
1
cs
-
roll
POSTPONE
xthen
;
immediate
:
xbegin
(
--
dest
)
cs
-
push
dead
-
code
off
;
immediate
:
xwhile
(
dest
--
orig
dest
)
sys
?
POSTPONE
xif
1
cs
-
roll
;
immediate
\
AGAIN
(
the
current
control
flow
joins
another
,
earlier
one
):
\
If
the
dest
-
locals
-
list
is
not
a
subset
of
the
current
locals
-
list
,
\
issue
a
warning
(
see
below
).
The
following
code
is
generated
:
\
lp
+!#
(
current
-
local
-
size
-
dest
-
locals
-
size
)
\
branch
<
begin
>
:
xagain
(
dest
--
)
sys
?
locals
-
size
@
3
roll
-
compile
-
lp
+!#
POSTPONE
branch
<
resolve
check
-
begin
unreachable
;
immediate
\
UNTIL
(
the
current
control
flow
may
join
an
earlier
one
or
continue
):
\
Similar
to
AGAIN
.
The
new
locals
-
list
and
locals
-
size
are
the
current
\
ones
.
The
following
code
is
generated
:
\
lp
+!#
(
current
-
local
-
size
-
dest
-
locals
-
size
)
\
?
branch
<
begin
>
\
lp
+!#
(
dest
-
local
-
size
-
current
-
locals
-
size
)
\
(
Another
inefficiency
.
Maybe
we
should
introduce
a
?
branch
-
lp
+!#
\
primitive
.
This
would
also
solve
the
interrupt
problem
)
:
until
-
like
(
dest
xt
--
)
>
r
sys
?
locals
-
size
@
dup
4
roll
-
compile
-
lp
+!#
(
list
dest
-
addr
old
-
locals
-
size
)
r
>
compile
,
>
r
<
resolve
check
-
begin
locals
-
size
@
r
>
-
compile
-
lp
+!#
;
:
xuntil
(
dest
--
)
[
'
]
?
branch
until
-
like
;
immediate
:
xrepeat
(
orig
dest
--
)
3
pick
0
=
?
struc
postpone
xagain
postpone
xthen
;
immediate
\
counted
loops
\
leave
poses
a
little
problem
here
\
we
have
to
store
more
than
just
the
address
of
the
branch
,
so
the
\
traditional
linked
list
approach
is
no
longer
viable
.
\
This
is
solved
by
storing
the
information
about
the
leavings
in
a
\
special
stack
.
The
leavings
of
different
DO
-
LOOPs
are
separated
\
by
a
0
entry
\
!!
remove
the
fixed
size
limit
.
'
Tis
easy
.
20
constant
leave
-
stack
-
size
create
leave
-
stack
leave
-
stack
-
size
cs
-
item
-
size
*
cells
allot
variable
leave
-
sp
leave
-
stack
leave
-
sp
!
:
clear
-
leave
-
stack
(
--
)
leave
-
stack
leave
-
sp
!
;
\
:
leave
-
empty
?
(
--
f
)
\
leave
-
sp
@
leave
-
stack
=
;
:
>
leave
(
orig
--
)
\
push
on
leave
-
stack
leave
-
sp
@
dup
[
leave
-
stack
leave
-
stack
-
size
cs
-
item
-
size
*
cells
+
]
Aliteral
>=
if
abort
" leave-stack full"
endif
tuck
!
cell
+
tuck
!
cell
+
tuck
!
cell
+
leave
-
sp
!
;
:
leave
>
(
--
orig
)
\
pop
from
leave
-
stack
leave
-
sp
@
dup
leave
-
stack
<=
if
abort
" leave-stack empty"
endif
cell
-
dup
@
swap
cell
-
dup
@
swap
cell
-
dup
@
swap
leave
-
sp
!
;
:
done
(
--
)
\
!!
the
original
done
had
(
addr
--
)
begin
leave
>
dup
while
POSTPONE
xthen
repeat
2
drop
drop
;
immediate
:
xleave
(
--
)
POSTPONE
xahead
>
leave
;
immediate
:
x
?
leave
(
--
)
POSTPONE
0
=
POSTPONE
xif
>
leave
;
immediate
:
xdo
(
--
do
-
sys
)
POSTPONE
(
do
)
POSTPONE
xbegin
0
0
0
>
leave
;
immediate
:
x
?
do
(
--
do
-
sys
)
0
0
0
>
leave
POSTPONE
(?
do
)
x
>
mark
>
leave
POSTPONE
xbegin
;
immediate
:
xfor
(
--
do
-
sys
)
POSTPONE
(
for
)
POSTPONE
xbegin
0
0
0
>
leave
;
immediate
\
LOOP
etc
.
are
just
like
UNTIL
\
the
generated
code
for
?
DO
...
LOOP
with
locals
is
inefficient
,
this
\
could
be
changed
by
introducing
(
loop
)-
lp
+!#
etc
.
:
loop
-
like
(
do
-
sys
xt
--
)
until
-
like
POSTPONE
done
POSTPONE
unloop
;
:
xloop
(
do
-
sys
--
)
[
'
]
(
loop
)
loop
-
like
;
immediate
:
x
+
loop
(
do
-
sys
--
)
[
'
]
(+
loop
)
loop
-
like
;
immediate
:
xs
+
loop
(
do
-
sys
--
)
[
'
]
(
s
+
loop
)
loop
-
like
;
immediate
:
locals
-:-
hook
(
sys
--
sys
addr
xt
)
locals
-
list
@
common
-
list
dup
list
-
size
adjust
-
locals
-
size
locals
-
list
!
;
immediate
\
adapt
the
hooks
:
locals
-:-
hook
(
sys
--
sys
addr
xt
n
)
\
addr
is
the
nfa
of
the
defined
word
,
xt
its
xt
DEFERS
:-
hook
last
@
lastcfa
@
clear
-
leave
-
stack
0
locals
-
size
!
locals
-
buffer
locals
-
dp
!
0
locals
-
list
!
;
(
clear
locals
vocabulary
)
0
locals
-
list
!
dead
-
code
off
defstart
;
:
locals
-;-
hook
(
sys
addr
xt
--
sys
)
:
locals
-;-
hook
(
sys
addr
xt
sys
--
sys
)
def
?
0
TO
locals
-
wordlist
locals
-
size
@
compile
-
lp
+!#
0
adjust
-
locals
-
size
(
not
every
def
ends
with
an
exit
)
lastcfa
!
last
!
DEFERS
;-
hook
;
...
...
@@ -678,14 +446,14 @@ variable leave-sp leave-stack leave-sp !
\
And
here's
finally
the
ANS
standard
stuff
:
(
local
)
(
addr
u
--
)
\
a
little
space
-
inefficient
,
but
well
deserved
;-)
\
In
exchange
,
there
are
no
restrictions
whatsoever
on
using
(
local
)
dup
if
nextname
POSTPONE
{
[
also
locals
-
types
]
W
:
}
[
previous
]
else
2
drop
endif
;
\
a
little
space
-
inefficient
,
but
well
deserved
;-)
\
In
exchange
,
there
are
no
restrictions
whatsoever
on
using
(
local
)
dup
if
nextname
POSTPONE
{
[
also
locals
-
types
]
W
:
}
[
previous
]
else
2
drop
endif
;
\
\
!!
untested
\
:
TO
(
c
|
w
|
d
|
r
"name"
--
)
...
...
io.c
View file @
58d3846d
...
...
@@ -717,7 +717,7 @@ install_signal_handlers (void)
but I would like something more automatic - anton */
#define SIGS_TO_IGNORE SIGCHLD
#define SIGS_TO_ABORT SIGINT, SIGILL, SIGFPE, SIGUSR1, SIGSEGV, SIGUSR2, \
SIGALRM,
SIGEMT, SIGBUS, SIGSY
S
SIGALRM,
SIGBU
S
#define SIGS_TO_QUIT SIGHUP, SIGQUIT, SIGABRT, SIGPIPE, \
SIGTERM
...
...
kernal.fs
View file @
58d3846d
...
...
@@ -57,6 +57,17 @@ DOES> ( n -- ) + c@ ;
[
cell
1
-
]
Literal
+
[
-
1
cells
]
Literal
and
;
:
align
(
--
)
here
dup
aligned
swap
?
DO
bl
c
,
LOOP
;
:
faligned
(
addr
--
f
-
addr
)
[
1
floats
1
-
]
Literal
+
[
-
1
floats
]
Literal
and
;
:
falign
(
--
)
here
dup
faligned
swap
?
DO
bl
c
,
LOOP
;
:
A
!
(
addr1
addr2
--
)
dup
relon
!
;
:
A
,
(
addr
--
)
here
cell
allot
A
!
;
...
...
@@ -135,9 +146,9 @@ Defer source
\
Literal
17
dec92py
:
Literal
(
n
--
)
state
@
0
=
?
EXIT
postpone
lit
,
;
:
Literal
(
n
--
)
state
@
IF
postpone
lit
,
THEN
;
immediate
:
ALiteral
(
n
--
)
state
@
0
=
?
EXIT
postpone
lit
A
,
;
:
ALiteral
(
n
--
)
state
@
IF
postpone
lit
A
,
THEN
;
immediate
:
char
(
'
char'
--
n
)
bl
word
char
+
c
@
;
...
...
@@ -155,7 +166,10 @@ Defer source
\
digit
?
17
dec92py
:
digit
?
(
char
--
digit
true
/
false
)
base
@
$
100
=
?
dup
?
EXIT
base
@
$
100
=
IF
true
EXIT
THEN
toupper
[
char
]
0
-
dup
9
u
>
IF
[
'
A
'
9
1
+
-
]
literal
-
dup
9
u
<=
IF
...
...
@@ -241,7 +255,6 @@ hex
\
catch
throw
23
feb93py
\
bounce
08
jun93jaw