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
b727d802
Commit
b727d802
authored
May 02, 1998
by
pazsan
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Mega-Patch; lots of changes
parent
1a243cc2
Changes
34
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
34 changed files
with
3144 additions
and
327 deletions
+3144
-327
Makefile.in
Makefile.in
+57
-8
arch/4stack/mach.fs
arch/4stack/mach.fs
+25
-11
arch/mips/machine.h
arch/mips/machine.h
+1
-1
arch/misc/asm.fs
arch/misc/asm.fs
+1
-1
arch/misc/mach.fs
arch/misc/mach.fs
+20
-12
arch/misc/tt.fs
arch/misc/tt.fs
+4
-1
cross.fs
cross.fs
+374
-206
engine/32bit.h
engine/32bit.h
+51
-0
engine/Makefile.in
engine/Makefile.in
+20
-2
engine/cache.c
engine/cache.c
+33
-0
engine/config.h.in
engine/config.h.in
+111
-0
engine/ecvt.c
engine/ecvt.c
+5
-3
engine/io.c
engine/io.c
+6
-3
engine/io.h
engine/io.h
+2
-2
hash.fs
hash.fs
+1
-1
kernel/aliases.fs
kernel/aliases.fs
+414
-0
kernel/basics.fs
kernel/basics.fs
+4
-1
kernel/comp.fs
kernel/comp.fs
+425
-0
kernel/int.fs
kernel/int.fs
+622
-0
kernel/io.fs
kernel/io.fs
+5
-0
kernel/kernel.fs
kernel/kernel.fs
+4
-1
kernel/main.fs
kernel/main.fs
+7
-1
kernel/nio.fs
kernel/nio.fs
+1
-1
kernel/paths.fs
kernel/paths.fs
+47
-5
kernel/prim.fs
kernel/prim.fs
+832
-0
kernel/prim0.fs
kernel/prim0.fs
+1
-1
kernel/saccept.fs
kernel/saccept.fs
+6
-6
kernel/special.fs
kernel/special.fs
+8
-46
kernel/tools.fs
kernel/tools.fs
+2
-2
prims2x.fs
prims2x.fs
+50
-10
search.fs
search.fs
+1
-1
sokoban.fs
sokoban.fs
+2
-0
stamp-h.in
stamp-h.in
+1
-0
test/other.fs
test/other.fs
+1
-1
No files found.
Makefile.in
View file @
b727d802
...
...
@@ -31,8 +31,8 @@
# ------------- gforth version
VERSION_MAJOR
=
0
VERSION_MINOR
=
3
VERSION_RELEASE
=
1
VERSION_MINOR
=
4
VERSION_RELEASE
=
0
VERSION
=
$(VERSION_MAJOR)
.
$(VERSION_MINOR)
.
$(VERSION_RELEASE)
DOSVERSION
=
$(VERSION_MAJOR)$(VERSION_MINOR)$(VERSION_RELEASE)
...
...
@@ -131,12 +131,30 @@ KERN_SRC = \
kernel/vars.fs
\
kernel/accept.fs
\
kernel/basics.fs
\
kernel/interp.fs
\
kernel/int.fs
\
kernel/comp.fs
\
kernel/io.fs
\
kernel/license.fs
\
kernel/nio.fs
\
kernel/saccept.fs
EC_SRC
=
\
asm/00-readme
\
asm/bitmask.fs
\
asm/numref.fs
\
asm/basic.fs
\
asm/generic.fs
\
asm/target.fs
\
ec/00-readme
\
ec/crossdoc.fd
\
ec/mirror.fs
\
ec/mirrors.fs
\
ec/shex.fs
\
ec/builttag.fs
\
ec/dotx.fs
\
ec/mirrored.fs
\
ec/nesting.fs
GFORTH_FI_SRC
=
\
assert.fs
\
blocked.fb
\
...
...
@@ -171,7 +189,7 @@ GFORTH_FI_SRC = \
sieve.fs
\
add.fs
FORTH_SRC
=
$(KERN_SRC)
$(GFORTH_FI_SRC)
\
FORTH_SRC
=
$(KERN_SRC)
$(GFORTH_FI_SRC)
$(EC_SRC)
\
ans-report.fs ansi.fs answords.fs
\
code.fs colorize.fs comp-i.fs
\
doskey.fs ds2texi.fs
\
...
...
@@ -213,7 +231,30 @@ ARCHS = arch/generic/machine.h \
arch
/misc/prim.fs
\
arch
/misc/sim.fs
\
arch
/misc/sokoban.fs
\
arch
/misc/tt.fs
arch
/misc/tt.fs
\
arch
/6502/asm.fs
\
arch
/6502/prim.fs
\
arch
/6502/mach.fs
\
arch
/6502/zero.fs
\
arch
/6502/softuart.fs
\
arch
/6502/cold.fs
\
arch
/8086/asm.fs
\
arch
/8086/mach.fs
\
arch
/8086/mach.sh
\
arch
/8086/prim.fs
\
arch
/avr/asm.fs
\
arch
/c165/asm.fs
\
arch
/c165/mach.fs
\
arch
/c165/prim.fs
\
arch
/h8/asm.fs
\
arch
/shboom/asm.fs
\
arch
/shboom/compiler.fs
\
arch
/shboom/dis.fs
\
arch
/shboom/mach.fs
\
arch
/shboom/prim.fs
\
arch
/shboom/dis2.fs
\
arch
/shboom/sh.p
\
arch
/shboom/doers.fs
SOURCES
=
CVS compat Makefile.in engine/Makefile.in gforthmi
\
configure.in configure config.sub config.guess
\
...
...
@@ -445,7 +486,7 @@ check test: gforth gforth.fi
$(FORTH)
test
/other.fs
-e
bye
$(FORTH)
code.fs
test
/checkans.fs
-e
bye
@
echo
'Expect no differences'
$(FORTH)
-m
100000 prims2x.fs
-e
"s
\"
$(srcdir)
/prim.b
\"
' output-c process-file bye"
| diff
-c
-
$(srcdir)
/engine/prim.i
$(FORTH
K
)
-m
100000 prims2x.fs
-e
"s
\"
$(srcdir)
/prim.b
\"
' output-c process-file bye"
| diff
-c
-
$(srcdir)
/engine/prim.i
bench
:
gforth gforth.fi
@
echo
'Each benchmark takes about 30s on a 486-66 (gcc-2.6.3 -DFORCE_REG)'
...
...
@@ -556,10 +597,10 @@ kernel/prim.fs: prim.b prims2x.fs kernel/prim0.fs
$(RM)
$@
-
engine
:
engine/prim_lab.i engine/prim.i engine/version.h FORCE
bash makein.bsh
engine engine
$(MAKE)
-C
engine engine
engine_ditc
:
engine/prim_lab.i engine/prim.i engine/version.h FORCE
bash makein.bsh
engine engine_ditc
$(MAKE)
-C
engine engine_ditc
gforth
:
engine
-
$(CP)
gforth gforth~
...
...
@@ -570,6 +611,14 @@ gforth-ditc: engine_ditc
$(GCC)
$(LDFLAGS)
$(OBJECTS_DITC)
$(OBJECTS0)
$(LDLIBS)
-o
$@
@
GFORTHDITC_EXE@
# ------------- additional C primitives
%.c
:
%.pri prim2cl.fs
$(FORTHK)
prim2cl.fs
-e
"file
$<
altogether bye"
>
$@
%.so
:
%.c
$(GCC)
-shared
$(CFLAGS)
$<
-o
$@
# ------------- Make Documentation
#TAGS is a GNU standard target
...
...
arch/4stack/mach.fs
View file @
b727d802
...
...
@@ -31,19 +31,33 @@
true
Constant
NIL
\
relocating
false
Constant
has
-
files
false
Constant
has
-
OS
false
Constant
has
-
prims
false
Constant
has
-
floats
false
Constant
has
-
locals
false
Constant
has
-
dcomps
false
Constant
has
-
hash
false
Constant
has
-
xconds
false
Constant
has
-
header
false
Constant
ITC
:
prims
-
include
.
" Include primitives"
cr
s
" arch/4stack/prim.fs"
included
;
:
asm
-
include
.
" Include assembler"
cr
s
" arch/4stack/asm.fs"
included
;
:
>
boot
S
" ' boot >body $800 ! here $804 !"
evaluate
;
>
ENVIRON
false
Constant
file
\
controls
the
presence
of
the
\
file
access
wordset
false
Constant
OS
\
flag
to
indicate
a
operating
system
false
Constant
prims
\
true
:
primitives
are
c
-
code
false
Constant
floating
\
floating
point
wordset
is
present
false
Constant
glocals
\
gforth
locals
are
present
\
will
be
loaded
false
Constant
dcomps
\
double
number
comparisons
false
Constant
hash
\
hashing
primitives
are
loaded
/
present
false
Constant
xconds
\
used
together
with
glocals
,
\
special
conditionals
supporting
gforths'
\
local
variables
false
Constant
header
\
save
a
header
information
false
Constant
ec
false
Constant
crlf
false
Constant
ITC
arch/mips/machine.h
View file @
b727d802
...
...
@@ -45,7 +45,7 @@
#define FLUSH_ICACHE(addr,size) \
cacheflush((char *)(addr), (int)(size), BCACHE)
#include "../../
eng
ine/32bit.h"
#include "../../
mach
ine/32bit.h"
#ifdef DIRECT_THREADED
/* some definitions for composing opcodes */
...
...
arch/misc/asm.fs
View file @
b727d802
...
...
@@ -8,7 +8,6 @@ also assembler also definitions forth
$
0
Constant
PC
$
1
Constant
PC
+
2
$
2
Constant
PC
+
4
$
3
Constant
PC
+
6
$
7
Constant
*
ACCU
$
8
Constant
ACCU
$
9
Constant
SF
$
A
Constant
ZF
$
C
Constant
CF
...
...
@@ -17,6 +16,7 @@ $A Constant ZF $C Constant CF
$
0
Constant
JMP
$
1
Constant
JS
$
2
Constant
JZ
$
4
Constant
JC
$
7
Constant
*
ACCU
(
$
8
Constant
ACCU
)
$
9
Constant
SUB
(
$
A
Constant
SUBR
)
$
B
Constant
ADD
$
C
Constant
XOR
$
D
Constant
OR
...
...
arch/misc/mach.fs
View file @
b727d802
...
...
@@ -40,16 +40,24 @@ false Constant NIL \ relocating
>
ENVIRON
false
Constant
file
false
Constant
OS
false
Constant
prims
false
Constant
floating
false
Constant
glocals
false
Constant
dcomps
false
Constant
hash
false
Constant
xconds
false
Constant
header
true
Constant
ec
true
Constant
crlf
true
Constant
ITC
false
Constant
file
\
controls
the
presence
of
the
\
file
access
wordset
false
Constant
OS
\
flag
to
indicate
a
operating
system
false
Constant
prims
\
true
:
primitives
are
c
-
code
false
Constant
floating
\
floating
point
wordset
is
present
false
Constant
glocals
\
gforth
locals
are
present
\
will
be
loaded
false
Constant
dcomps
\
double
number
comparisons
false
Constant
hash
\
hashing
primitives
are
loaded
/
present
false
Constant
xconds
\
used
together
with
glocals
,
\
special
conditionals
supporting
gforths'
\
local
variables
false
Constant
header
\
save
a
header
information
true
Constant
ec
false
Constant
crlf
arch/misc/tt.fs
View file @
b727d802
...
...
@@ -12,7 +12,10 @@
decimal
:
ms
0
?
DO
(
$
3000
0
DO
LOOP
)
LOOP
;
variable
loops
/
ms
0
loops
/
ms
!
:
ms
0
?
DO
loops
/
ms
@
0
?
DO
LOOP
LOOP
;
:
blank
bl
fill
;
Create
pn
-
tab
,
" 000102030405060708091011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980"
...
...
cross.fs
View file @
b727d802
This diff is collapsed.
Click to expand it.
engine/32bit.h
0 → 100644
View file @
b727d802
/*
This is a generic file for 32-bit machines with IEEE FP arithmetic (no VMS).
It only supports indirect threading.
Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of Gforth.
Gforth 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, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/* define this if IEEE singles and doubles are available as C data types */
#define IEEE_FP
/* the IEEE types are used only for loading and storing */
/* the IEEE double precision type */
typedef
double
DFloat
;
/* the IEEE single precision type */
typedef
float
SFloat
;
#ifndef USE_FTOS
#ifndef USE_NO_FTOS
/* keep top of FP stack in register. Since most processors have FP
registers and they are hardly used in gforth, this is usually a
good idea. The 88100 has no separate FP regs, but many general
purpose regs, so it should be ok */
#define USE_FTOS
#endif
#endif
/* I don't do the same for the data stack (i.e. USE_TOS), since this
loses on processors with few registers. USE_TOS might be defined in
the processor-specific files */
#ifdef DIRECT_THREADED
/* If you want direct threading, write a .h file for your processor! */
/* We could put some stuff here that causes a compile error, but then
we could not use this file in the other machine.h files */
#endif
engine/Makefile.in
View file @
b727d802
...
...
@@ -21,8 +21,8 @@
# ------------- gforth version
VERSION_MAJOR
=
0
VERSION_MINOR
=
3
VERSION_RELEASE
=
1
VERSION_MINOR
=
4
VERSION_RELEASE
=
0
VERSION
=
$(VERSION_MAJOR)
.
$(VERSION_MINOR)
.
$(VERSION_RELEASE)
DOSVERSION
=
$(VERSION_MAJOR)$(VERSION_MINOR)$(VERSION_RELEASE)
...
...
@@ -51,6 +51,24 @@ STRIP = strip
FORTHPATH
=
$(libdir)
/gforth/site-forth
$(PATHSEP)$(datadir)
/gforth/site-forth
$(PATHSEP)$(libdir)
/gforth/
$(VERSION)$(PATHSEP)$(datadir)
/gforth/
$(VERSION)$(PATHSEP)
.
# ------------ Install Directorys
VPATH
=
@srcdir@
prefix
=
@prefix@
exec_prefix
=
@exec_prefix@
srcdir
=
@srcdir@
bindir
=
$(exec_prefix)
/bin
#read-only architecture-independent files
datadir
=
$(prefix)
/share
#read-only architecture-dependent non-ascii files
libdir
=
$(prefix)
/lib
infodir
=
$(prefix)
/info
mandir
=
$(prefix)
/man
man1dir
=
$(mandir)
/man1
man1ext
=
.1
#older emacses have their site-lisp in $(libdir)/emacs/
emacssitelispdir
=
$(datadir)
/emacs/site-lisp
# ------------- Compiler Flags
XCFLAGS
=
@CFLAGS@
...
...
engine/cache.c
0 → 100644
View file @
b727d802
/* cache flushing for the HP-PA architecture
Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of Gforth.
Gforth 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, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
void
cacheflush
(
void
*
address
,
int
size
,
int
linewidth
)
{
int
i
;
address
=
(
void
*
)((
int
)
address
&
(
-
linewidth
));
for
(
i
=
1
-
linewidth
;
i
<
size
;
i
+=
linewidth
)
asm
volatile
(
"fdc (%0)
\n\t
"
"sync
\n\t
"
"fic,m %1(%0)
\n\t
"
"sync"
:
:
"r"
(
address
),
"r"
(
linewidth
)
:
"memory"
);
}
engine/config.h.in
0 → 100644
View file @
b727d802
/* engine/config.h.in. Generated automatically from configure.in by autoheader. */
/* Define if `sys_siglist' is declared by <signal.h>. */
#undef SYS_SIGLIST_DECLARED
/* Define if your processor stores words with the most significant
byte first (like Motorola and SPARC, unlike Intel and VAX). */
#undef WORDS_BIGENDIAN
/* Define if you want to force a direct threaded code implementation
(does not work on all machines */
#ifndef DIRECT_THREADED
#undef DIRECT_THREADED
#endif
/* Define if you want to force an indirect threaded code implementation */
#ifndef INDIRECT_THREADED
#undef INDIRECT_THREADED
#endif
/* Define if you want to use explicit register declarations for better
performance or for more convenient CODE words (does not work with
all GCC versions on all machines) */
#ifndef FORCE_REG
#undef FORCE_REG
#endif
/* an integer type that is as long as a pointer */
#define CELL_TYPE long
/* an integer type that is twice as long as a pointer */
#define DOUBLE_CELL_TYPE none
/* a path separator character */
#define PATHSEP ':'
/* define this if there is no working DOUBLE_CELL_TYPE on your machine */
#undef BUGGY_LONG_LONG
/* The number of bytes in a char *. */
#undef SIZEOF_CHAR_P
/* The number of bytes in a int. */
#undef SIZEOF_INT
/* The number of bytes in a long. */
#undef SIZEOF_LONG
/* The number of bytes in a long long. */
#undef SIZEOF_LONG_LONG
/* The number of bytes in a short. */
#undef SIZEOF_SHORT
/* Define if you have the atanh function. */
#undef HAVE_ATANH
/* Define if you have the dlopen function. */
#undef HAVE_DLOPEN
/* Define if you have the ecvt function. */
#undef HAVE_ECVT
/* Define if you have the expm1 function. */
#undef HAVE_EXPM1
/* Define if you have the getpagesize function. */
#undef HAVE_GETPAGESIZE
/* Define if you have the log1p function. */
#undef HAVE_LOG1P
/* Define if you have the memmove function. */
#undef HAVE_MEMMOVE
/* Define if you have the mmap function. */
#undef HAVE_MMAP
/* Define if you have the pow10 function. */
#undef HAVE_POW10
/* Define if you have the rint function. */
#undef HAVE_RINT
/* Define if you have the strerror function. */
#undef HAVE_STRERROR
/* Define if you have the strsignal function. */
#undef HAVE_STRSIGNAL
/* Define if you have the strtoul function. */
#undef HAVE_STRTOUL
/* Define if you have the sys_siglist function. */
#undef HAVE_SYS_SIGLIST
/* Define if you have the sysconf function. */
#undef HAVE_SYSCONF
/* Define if you have the <sys/mman.h> header file. */
#undef HAVE_SYS_MMAN_H
/* Define if you have the dl library (-ldl). */
#undef HAVE_LIBDL
/* Define if you have the kernel32 library (-lkernel32). */
#undef HAVE_LIBKERNEL32
/* Define if you have the m library (-lm). */
#undef HAVE_LIBM
/* Of course, sys_siglist is a variable, not a function */
engine/ecvt.c
View file @
b727d802
/* cheap ecvt replacement */
#include <stdio.h>
#include "config.h"
#include <math.h>
extern
double
floor
(
double
);
...
...
@@ -12,6 +13,7 @@ char* ecvt(double x, int len, int* exp, int* sign)
{
int
i
,
j
;
double
z
;
fprintf
(
stderr
,
"using own ecvt
\n
"
);
if
(
len
>
(
MAXCONV
-
1
))
len
=
MAXCONV
-
1
;
...
...
@@ -53,7 +55,7 @@ char* ecvt(double x, int len, int* exp, int* sign)
scratch
[
j
]
=
'0'
;
}
}
if
(
j
==
0
)
if
(
j
<
0
)
{
scratch
[
0
]
=
'1'
;
*
exp
+=
1
;
...
...
@@ -69,8 +71,8 @@ char* ecvt(double x, int len, int* exp, int* sign)
int
main
(
int
argc
,
char
**
argv
)
{
int
a
,
b
;
char
*
conv
=
ecvt
(
PI
*
1e1
0
,
20
,
&
a
,
&
b
);
char
*
conv
=
ecvt
(
9e
0
,
20
,
&
a
,
&
b
);
printf
(
"ecvt Test: %f -> %s, %d, %d
\n
"
,
PI
,
conv
,
a
,
b
);
printf
(
"ecvt Test: %f -> %s, %d, %d
\n
"
,
9e0
,
conv
,
a
,
b
);
}
#endif
engine/io.c
View file @
b727d802
...
...
@@ -85,12 +85,15 @@
#endif
/* !_POSIX_VERSION */
/* Posix systems use termios and the Posix signal functions. */
#if defined (_POSIX_VERSION)
#if defined (_POSIX_VERSION)
|| defined (NeXT)
# if !defined (TERMIOS_MISSING)
# undef NEW_TTY_DRIVER
# define TERMIOS_TTY_DRIVER
# include <termios.h>
# endif
/* !TERMIOS_MISSING */
#endif
/* _POSIX_VERSION || NeXT */
#if defined (_POSIX_VERSION)
# define HAVE_POSIX_SIGNALS
# if !defined (O_NDELAY)
# define O_NDELAY O_NONBLOCK
/* Posix-style non-blocking i/o */
...
...
@@ -107,7 +110,7 @@
special character is disabled and to disable certain special
characters. Posix systems should set to 0, USG systems to -1. */
#if !defined (NEW_TTY_DRIVER) && !defined (_POSIX_VDISABLE)
# if defined (_POSIX_VERSION)
# if defined (_POSIX_VERSION)
|| defined (NeXT)
# define _POSIX_VDISABLE 0
# else
/* !_POSIX_VERSION */
# define _POSIX_VDISABLE -1
...
...
@@ -974,7 +977,7 @@ void install_signal_handlers (void)
signal (sigs_to_ignore [i], SIG_IGN);
*/
for
(
i
=
0
;
i
<
DIM
(
sigs_to_throw
);
i
++
)
signal
(
sigs_to_throw
[
i
],
signal_throw
);
signal
(
sigs_to_throw
[
i
],
die_on_signal
?
graceful_exit
:
signal_throw
);
for
(
i
=
0
;
i
<
DIM
(
sigs_to_quit
);
i
++
)
signal
(
sigs_to_quit
[
i
],
graceful_exit
);
#ifdef SIGCONT
...
...
engine/io.h
View file @
b727d802
...
...
@@ -33,8 +33,8 @@ extern jmp_buf throw_jmp_buf;
#else
unsigned
char
getkey
(
FILE
*
);
long
key_avail
(
FILE
*
);
void
prep_terminal
();
void
deprep_terminal
();
void
prep_terminal
(
void
);
void
deprep_terminal
(
void
);
void
get_winsize
(
void
);
# define key() getkey(stdin)
...
...
hash.fs
View file @
b727d802
...
...
@@ -175,7 +175,7 @@ has? cross 0=
base
@
>
r
hex
HashTable
Hashlen
0
DO
cr
i
2
.
r
.
" : "
dup
i
cells
+
BEGIN
@
dup
WHILE
dup
cell
+
@
head
>
string
type
space
REPEAT
drop
dup
cell
+
@
name
>
string
type
space
REPEAT
drop
LOOP
drop
r
>
base
!
;
\
\
this
stuff
is
for
evaluating
the
hash
function
...
...
kernel/aliases.fs
0 → 100644
View file @
b727d802
\
run
-
time
routine
headers
\
Copyright
(
C
)
1997
Free
Software
Foundation
,
Inc
.
\
This
file
is
part
of
Gforth
.
\
Gforth
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
,
write
to
the
Free
Software
\
Foundation
,
Inc
.
,
675
Mass
Ave
,
Cambridge
,
MA
02139
,
USA
.
-2
Alias
:
:
docol
-
3
Alias
:
:
docon
-
4
Alias
:
:
dovar
-
5
Alias
:
:
douser
-
6
Alias
:
:
dodefer
-
7
Alias
:
:
dofield
-
8
Alias
:
:
dodoes
-
9
Alias
:
:
doesjump
-
10
alias
noop
-
11
alias
lit
-
12
alias
execute
-
13
alias
perform
has
?
glocals
[
IF
]
-
14
alias
branch
-
lp
+!#
[
THEN
]
-
15
alias
branch
-
16
alias
?
branch
has
?
glocals
[
IF
]
-
17
alias
?
branch
-
lp
+!#
[
THEN
]
has
?
xconds
[
IF
]
-
18
alias
?
dup
-?
branch
-
19
alias
?
dup
-
0
=-?
branch
[
THEN
]
-
20
alias
(
next
)
has
?
glocals
[
IF
]
-
21
alias
(
next
)-
lp
+!#
[
THEN
]
-
22
alias
(
loop
)
has
?
glocals
[
IF
]
-
23
alias
(
loop
)-
lp
+!#
[
THEN
]
-
24
alias
(+
loop
)
has
?
glocals
[
IF
]
-
25
alias
(+
loop
)-
lp
+!#
[
THEN
]
has
?
xconds
[
IF
]
-
26
alias
(-
loop
)
has
?
glocals
[
IF
]
-
27
alias
(-
loop
)-
lp
+!#
[
THEN
]
-
28
alias
(
s
+
loop
)
has
?
glocals
[
IF
]
-
29
alias
(
s
+
loop
)-
lp
+!#
[
THEN
]
[
THEN
]
-
30
alias
unloop
-
31
alias
(
for
)
-
32
alias
(
do
)
-
33
alias
(?
do
)
has
?
xconds
[
IF
]