author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
Wed, 16 Jan 2019 17:15:58 +0000 | |
changeset 438 | 1fe179d53161 |
parent 146 | 42de487aa9bb |
permissions | -rw-r--r-- |
145
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1 |
/* A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2 |
By Richard W.M. Jones <rich@annexia.org> http://annexia.org/forth |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
3 |
This is PUBLIC DOMAIN (see public domain release statement below). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
4 |
$Id: jonesforth.S,v 1.19 2007/09/08 22:51:28 rich Exp $ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
5 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
6 |
gcc -m32 -nostdlib -static -Wl,-Ttext,0 -o jonesforth jonesforth.S |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
7 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
8 |
.set JONES_VERSION,19 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
9 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
10 |
INTRODUCTION ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
11 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
12 |
FORTH is one of those alien languages which most working programmers regard in the same |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
13 |
way as Haskell, LISP, and so on. Something so strange that they'd rather any thoughts |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
14 |
of it just go away so they can get on with writing this paying code. But that's wrong |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
15 |
and if you care at all about programming then you should at least understand all these |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
16 |
languages, even if you will never use them. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
17 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
18 |
LISP is the ultimate high-level language, and features from LISP are being added every |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
19 |
decade to the more common languages. But FORTH is in some ways the ultimate in low level |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
20 |
programming. Out of the box it lacks features like dynamic memory management and even |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
21 |
strings. In fact, at its primitive level it lacks even basic concepts like IF-statements |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
22 |
and loops. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
23 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
24 |
Why then would you want to learn FORTH? There are several very good reasons. First |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
25 |
and foremost, FORTH is minimal. You really can write a complete FORTH in, say, 2000 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
26 |
lines of code. I don't just mean a FORTH program, I mean a complete FORTH operating |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
27 |
system, environment and language. You could boot such a FORTH on a bare PC and it would |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
28 |
come up with a prompt where you could start doing useful work. The FORTH you have here |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
29 |
isn't minimal and uses a Linux process as its 'base PC' (both for the purposes of making |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
30 |
it a good tutorial). It's possible to completely understand the system. Who can say they |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
31 |
completely understand how Linux works, or gcc? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
32 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
33 |
Secondly FORTH has a peculiar bootstrapping property. By that I mean that after writing |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
34 |
a little bit of assembly to talk to the hardware and implement a few primitives, all the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
35 |
rest of the language and compiler is written in FORTH itself. Remember I said before |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
36 |
that FORTH lacked IF-statements and loops? Well of course it doesn't really because |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
37 |
such a lanuage would be useless, but my point was rather that IF-statements and loops are |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
38 |
written in FORTH itself. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
39 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
40 |
Now of course this is common in other languages as well, and in those languages we call |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
41 |
them 'libraries'. For example in C, 'printf' is a library function written in C. But |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
42 |
in FORTH this goes way beyond mere libraries. Can you imagine writing C's 'if' in C? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
43 |
And that brings me to my third reason: If you can write 'if' in FORTH, then why restrict |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
44 |
yourself to the usual if/while/for/switch constructs? You want a construct that iterates |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
45 |
over every other element in a list of numbers? You can add it to the language. What |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
46 |
about an operator which pulls in variables directly from a configuration file and makes |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
47 |
them available as FORTH variables? Or how about adding Makefile-like dependencies to |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
48 |
the language? No problem in FORTH. This concept isn't common in programming languages, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
49 |
but it has a name (in fact two names): "macros" (by which I mean LISP-style macros, not |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
50 |
the lame C preprocessor) and "domain specific languages" (DSLs). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
51 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
52 |
This tutorial isn't about learning FORTH as the language. I'll point you to some references |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
53 |
you should read if you're not familiar with using FORTH. This tutorial is about how to |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
54 |
write FORTH. In fact, until you understand how FORTH is written, you'll have only a very |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
55 |
superficial understanding of how to use it. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
56 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
57 |
So if you're not familiar with FORTH or want to refresh your memory here are some online |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
58 |
references to read: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
59 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
60 |
http://en.wikipedia.org/wiki/Forth_%28programming_language%29 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
61 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
62 |
http://galileo.phys.virginia.edu/classes/551.jvn.fall01/primer.htm |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
63 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
64 |
http://wiki.laptop.org/go/Forth_Lessons |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
65 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
66 |
Here is another "Why FORTH?" essay: http://www.jwdt.com/~paysan/why-forth.html |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
67 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
68 |
ACKNOWLEDGEMENTS ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
69 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
70 |
This code draws heavily on the design of LINA FORTH (http://home.hccnet.nl/a.w.m.van.der.horst/lina.html) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
71 |
by Albert van der Horst. Any similarities in the code are probably not accidental. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
72 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
73 |
Also I used this document (http://ftp.funet.fi/pub/doc/IOCCC/1992/buzzard.2.design) which really |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
74 |
defies easy explanation. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
75 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
76 |
PUBLIC DOMAIN ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
77 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
78 |
I, the copyright holder of this work, hereby release it into the public domain. This applies worldwide. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
79 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
80 |
In case this is not legally possible, I grant any entity the right to use this work for any purpose, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
81 |
without any conditions, unless such conditions are required by law. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
82 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
83 |
SETTING UP ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
84 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
85 |
Let's get a few housekeeping things out of the way. Firstly because I need to draw lots of |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
86 |
ASCII-art diagrams to explain concepts, the best way to look at this is using a window which |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
87 |
uses a fixed width font and is at least this wide: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
88 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
89 |
<------------------------------------------------------------------------------------------------------------------------> |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
90 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
91 |
Secondly make sure TABS are set to 8 characters. The following should be a vertical |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
92 |
line. If not, sort out your tabs. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
93 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
94 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
95 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
96 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
97 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
98 |
Thirdly I assume that your screen is at least 50 characters high. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
99 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
100 |
ASSEMBLING ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
101 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
102 |
If you want to actually run this FORTH, rather than just read it, you will need Linux on an |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
103 |
i386. Linux because instead of programming directly to the hardware on a bare PC which I |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
104 |
could have done, I went for a simpler tutorial by assuming that the 'hardware' is a Linux |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
105 |
process with a few basic system calls (read, write and exit and that's about all). i386 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
106 |
is needed because I had to write the assembly for a processor, and i386 is by far the most |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
107 |
common. (Of course when I say 'i386', any 32- or 64-bit x86 processor will do. I'm compiling |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
108 |
this on a 64 bit AMD Opteron). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
109 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
110 |
Again, to assemble this you will need gcc and gas (the GNU assembler). The commands to |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
111 |
assemble and run the code (save this file as 'jonesforth.S') are: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
112 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
113 |
gcc -m32 -nostdlib -static -Wl,-Ttext,0 -o jonesforth jonesforth.S |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
114 |
./jonesforth |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
115 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
116 |
You will see lots of 'Warning: unterminated string; newline inserted' messages from the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
117 |
assembler. That's just because the GNU assembler doesn't have a good syntax for multi-line |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
118 |
strings (or rather it used to, but the developers removed it!) so I've abused the syntax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
119 |
slightly to make things readable. Ignore these warnings. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
120 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
121 |
If you want to run your own FORTH programs you can do: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
122 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
123 |
./jonesforth < myprog.f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
124 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
125 |
If you want to load your own FORTH code and then continue reading user commands, you can do: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
126 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
127 |
cat myfunctions.f - | ./jonesforth |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
128 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
129 |
ASSEMBLER ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
130 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
131 |
(You can just skip to the next section -- you don't need to be able to read assembler to |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
132 |
follow this tutorial). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
133 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
134 |
However if you do want to read the assembly code here are a few notes about gas (the GNU assembler): |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
135 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
136 |
(1) Register names are prefixed with '%', so %eax is the 32 bit i386 accumulator. The registers |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
137 |
available on i386 are: %eax, %ebx, %ecx, %edx, %esi, %edi, %ebp and %esp, and most of them |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
138 |
have special purposes. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
139 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
140 |
(2) Add, mov, etc. take arguments in the form SRC,DEST. So mov %eax,%ecx moves %eax -> %ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
141 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
142 |
(3) Constants are prefixed with '$', and you mustn't forget it! If you forget it then it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
143 |
causes a read from memory instead, so: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
144 |
mov $2,%eax moves number 2 into %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
145 |
mov 2,%eax reads the 32 bit word from address 2 into %eax (ie. most likely a mistake) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
146 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
147 |
(4) gas has a funky syntax for local labels, where '1f' (etc.) means label '1:' "forwards" |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
148 |
and '1b' (etc.) means label '1:' "backwards". |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
149 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
150 |
(5) 'ja' is "jump if above", 'jb' for "jump if below", 'je' "jump if equal" etc. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
151 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
152 |
(6) gas has a reasonably nice .macro syntax, and I use them a lot to make the code shorter and |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
153 |
less repetitive. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
154 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
155 |
For more help reading the assembler, do "info gas" at the Linux prompt. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
156 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
157 |
Now the tutorial starts in earnest. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
158 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
159 |
THE DICTIONARY ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
160 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
161 |
In FORTH as you will know, functions are called "words", and just as in other languages they |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
162 |
have a name and a definition. Here are two FORTH words: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
163 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
164 |
: DOUBLE DUP + ; \ name is "DOUBLE", definition is "DUP +" |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
165 |
: QUADRUPLE DOUBLE DOUBLE ; \ name is "QUADRUPLE", definition is "DOUBLE DOUBLE" |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
166 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
167 |
Words, both built-in ones and ones which the programmer defines later, are stored in a dictionary |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
168 |
which is just a linked list of dictionary entries. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
169 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
170 |
<--- DICTIONARY ENTRY (HEADER) -----------------------> |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
171 |
+------------------------+--------+---------- - - - - +----------- - - - - |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
172 |
| LINK POINTER | LENGTH/| NAME | DEFINITION |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
173 |
| | FLAGS | | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
174 |
+--- (4 bytes) ----------+- byte -+- n bytes - - - - +----------- - - - - |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
175 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
176 |
I'll come to the definition of the word later. For now just look at the header. The first |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
177 |
4 bytes are the link pointer. This points back to the previous word in the dictionary, or, for |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
178 |
the first word in the dictionary it is just a NULL pointer. Then comes a length/flags byte. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
179 |
The length of the word can be up to 31 characters (5 bits used) and the top three bits are used |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
180 |
for various flags which I'll come to later. This is followed by the name itself, and in this |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
181 |
implementation the name is rounded up to a multiple of 4 bytes by padding it with zero bytes. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
182 |
That's just to ensure that the definition starts on a 32 bit boundary. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
183 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
184 |
A FORTH variable called LATEST contains a pointer to the most recently defined word, in |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
185 |
other words, the head of this linked list. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
186 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
187 |
DOUBLE and QUADRUPLE might look like this: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
188 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
189 |
pointer to previous word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
190 |
^ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
191 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
192 |
+--|------+---+---+---+---+---+---+---+---+------------- - - - - |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
193 |
| LINK | 6 | D | O | U | B | L | E | 0 | (definition ...) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
194 |
+---------+---+---+---+---+---+---+---+---+------------- - - - - |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
195 |
^ len padding |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
196 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
197 |
+--|------+---+---+---+---+---+---+---+---+---+---+---+---+------------- - - - - |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
198 |
| LINK | 9 | Q | U | A | D | R | U | P | L | E | 0 | 0 | (definition ...) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
199 |
+---------+---+---+---+---+---+---+---+---+---+---+---+---+------------- - - - - |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
200 |
^ len padding |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
201 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
202 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
203 |
LATEST |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
204 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
205 |
You shoud be able to see from this how you might implement functions to find a word in |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
206 |
the dictionary (just walk along the dictionary entries starting at LATEST and matching |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
207 |
the names until you either find a match or hit the NULL pointer at the end of the dictionary); |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
208 |
and add a word to the dictionary (create a new definition, set its LINK to LATEST, and set |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
209 |
LATEST to point to the new word). We'll see precisely these functions implemented in |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
210 |
assembly code later on. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
211 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
212 |
One interesting consequence of using a linked list is that you can redefine words, and |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
213 |
a newer definition of a word overrides an older one. This is an important concept in |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
214 |
FORTH because it means that any word (even "built-in" or "standard" words) can be |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
215 |
overridden with a new definition, either to enhance it, to make it faster or even to |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
216 |
disable it. However because of the way that FORTH words get compiled, which you'll |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
217 |
understand below, words defined using the old definition of a word continue to use |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
218 |
the old definition. Only words defined after the new definition use the new definition. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
219 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
220 |
DIRECT THREADED CODE ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
221 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
222 |
Now we'll get to the really crucial bit in understanding FORTH, so go and get a cup of tea |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
223 |
or coffee and settle down. It's fair to say that if you don't understand this section, then you |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
224 |
won't "get" how FORTH works, and that would be a failure on my part for not explaining it well. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
225 |
So if after reading this section a few times you don't understand it, please email me |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
226 |
(rich@annexia.org). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
227 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
228 |
Let's talk first about what "threaded code" means. Imagine a peculiar version of C where |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
229 |
you are only allowed to call functions without arguments. (Don't worry for now that such a |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
230 |
language would be completely useless!) So in our peculiar C, code would look like this: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
231 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
232 |
f () |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
233 |
{ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
234 |
a (); |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
235 |
b (); |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
236 |
c (); |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
237 |
} |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
238 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
239 |
and so on. How would a function, say 'f' above, be compiled by a standard C compiler? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
240 |
Probably into assembly code like this. On the right hand side I've written the actual |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
241 |
i386 machine code. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
242 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
243 |
f: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
244 |
CALL a E8 08 00 00 00 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
245 |
CALL b E8 1C 00 00 00 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
246 |
CALL c E8 2C 00 00 00 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
247 |
; ignore the return from the function for now |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
248 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
249 |
"E8" is the x86 machine code to "CALL" a function. In the first 20 years of computing |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
250 |
memory was hideously expensive and we might have worried about the wasted space being used |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
251 |
by the repeated "E8" bytes. We can save 20% in code size (and therefore, in expensive memory) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
252 |
by compressing this into just: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
253 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
254 |
08 00 00 00 Just the function addresses, without |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
255 |
1C 00 00 00 the CALL prefix. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
256 |
2C 00 00 00 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
257 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
258 |
[Historical note: If the execution model that FORTH uses looks strange from the following |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
259 |
paragraphs, then it was motivated entirely by the need to save memory on early computers. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
260 |
This code compression isn't so important now when our machines have more memory in their L1 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
261 |
caches than those early computers had in total, but the execution model still has some |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
262 |
useful properties]. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
263 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
264 |
Of course this code won't run directly any more. Instead we need to write an interpreter |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
265 |
which takes each pair of bytes and calls it. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
266 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
267 |
On an i386 machine it turns out that we can write this interpreter rather easily, in just |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
268 |
two assembly instructions which turn into just 3 bytes of machine code. Let's store the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
269 |
pointer to the next word to execute in the %esi register: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
270 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
271 |
08 00 00 00 <- We're executing this one now. %esi is the _next_ one to execute. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
272 |
%esi -> 1C 00 00 00 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
273 |
2C 00 00 00 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
274 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
275 |
The all-important i386 instruction is called LODSL (or in Intel manuals, LODSW). It does |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
276 |
two things. Firstly it reads the memory at %esi into the accumulator (%eax). Secondly it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
277 |
increments %esi by 4 bytes. So after LODSL, the situation now looks like this: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
278 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
279 |
08 00 00 00 <- We're still executing this one |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
280 |
1C 00 00 00 <- %eax now contains this address (0x0000001C) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
281 |
%esi -> 2C 00 00 00 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
282 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
283 |
Now we just need to jump to the address in %eax. This is again just a single x86 instruction |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
284 |
written JMP *(%eax). And after doing the jump, the situation looks like: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
285 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
286 |
08 00 00 00 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
287 |
1C 00 00 00 <- Now we're executing this subroutine. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
288 |
%esi -> 2C 00 00 00 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
289 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
290 |
To make this work, each subroutine is followed by the two instructions 'LODSL; JMP *(%eax)' |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
291 |
which literally make the jump to the next subroutine. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
292 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
293 |
And that brings us to our first piece of actual code! Well, it's a macro. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
294 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
295 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
296 |
/* NEXT macro. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
297 |
.macro NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
298 |
lodsl |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
299 |
jmp *(%eax) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
300 |
.endm |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
301 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
302 |
/* The macro is called NEXT. That's a FORTH-ism. It expands to those two instructions. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
303 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
304 |
Every FORTH primitive that we write has to be ended by NEXT. Think of it kind of like |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
305 |
a return. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
306 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
307 |
The above describes what is known as direct threaded code. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
308 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
309 |
To sum up: We compress our function calls down to a list of addresses and use a somewhat |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
310 |
magical macro to act as a "jump to next function in the list". We also use one register (%esi) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
311 |
to act as a kind of instruction pointer, pointing to the next function in the list. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
312 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
313 |
I'll just give you a hint of what is to come by saying that a FORTH definition such as: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
314 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
315 |
: QUADRUPLE DOUBLE DOUBLE ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
316 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
317 |
actually compiles (almost, not precisely but we'll see why in a moment) to a list of |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
318 |
function addresses for DOUBLE, DOUBLE and a special function called EXIT to finish off. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
319 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
320 |
At this point, REALLY EAGLE-EYED ASSEMBLY EXPERTS are saying "JONES, YOU'VE MADE A MISTAKE!". |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
321 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
322 |
I lied about JMP *(%eax). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
323 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
324 |
INDIRECT THREADED CODE ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
325 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
326 |
It turns out that direct threaded code is interesting but only if you want to just execute |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
327 |
a list of functions written in assembly language. So QUADRUPLE would work only if DOUBLE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
328 |
was an assembly language function. In the direct threaded code, QUADRUPLE would look like: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
329 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
330 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
331 |
| addr of DOUBLE --------------------> (assembly code to do the double) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
332 |
+------------------+ NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
333 |
%esi -> | addr of DOUBLE | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
334 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
335 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
336 |
We can add an extra indirection to allow us to run both words written in assembly language |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
337 |
(primitives written for speed) and words written in FORTH themselves as lists of addresses. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
338 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
339 |
The extra indirection is the reason for the brackets in JMP *(%eax). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
340 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
341 |
Let's have a look at how QUADRUPLE and DOUBLE really look in FORTH: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
342 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
343 |
: QUADRUPLE DOUBLE DOUBLE ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
344 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
345 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
346 |
| codeword | : DOUBLE DUP + ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
347 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
348 |
| addr of DOUBLE ---------------> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
349 |
+------------------+ | codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
350 |
| addr of DOUBLE | +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
351 |
+------------------+ | addr of DUP --------------> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
352 |
| addr of EXIT | +------------------+ | codeword -------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
353 |
+------------------+ %esi -> | addr of + --------+ +------------------+ | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
354 |
+------------------+ | | assembly to <-----+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
355 |
| addr of EXIT | | | implement DUP | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
356 |
+------------------+ | | .. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
357 |
| | .. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
358 |
| | NEXT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
359 |
| +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
360 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
361 |
+-----> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
362 |
| codeword -------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
363 |
+------------------+ | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
364 |
| assembly to <------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
365 |
| implement + | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
366 |
| .. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
367 |
| .. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
368 |
| NEXT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
369 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
370 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
371 |
This is the part where you may need an extra cup of tea/coffee/favourite caffeinated |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
372 |
beverage. What has changed is that I've added an extra pointer to the beginning of |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
373 |
the definitions. In FORTH this is sometimes called the "codeword". The codeword is |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
374 |
a pointer to the interpreter to run the function. For primitives written in |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
375 |
assembly language, the "interpreter" just points to the actual assembly code itself. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
376 |
They don't need interpreting, they just run. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
377 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
378 |
In words written in FORTH (like QUADRUPLE and DOUBLE), the codeword points to an interpreter |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
379 |
function. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
380 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
381 |
I'll show you the interpreter function shortly, but let's recall our indirect |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
382 |
JMP *(%eax) with the "extra" brackets. Take the case where we're executing DOUBLE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
383 |
as shown, and DUP has been called. Note that %esi is pointing to the address of + |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
384 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
385 |
The assembly code for DUP eventually does a NEXT. That: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
386 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
387 |
(1) reads the address of + into %eax %eax points to the codeword of + |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
388 |
(2) increments %esi by 4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
389 |
(3) jumps to the indirect %eax jumps to the address in the codeword of +, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
390 |
ie. the assembly code to implement + |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
391 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
392 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
393 |
| codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
394 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
395 |
| addr of DOUBLE ---------------> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
396 |
+------------------+ | codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
397 |
| addr of DOUBLE | +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
398 |
+------------------+ | addr of DUP --------------> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
399 |
| addr of EXIT | +------------------+ | codeword -------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
400 |
+------------------+ | addr of + --------+ +------------------+ | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
401 |
+------------------+ | | assembly to <-----+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
402 |
%esi -> | addr of EXIT | | | implement DUP | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
403 |
+------------------+ | | .. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
404 |
| | .. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
405 |
| | NEXT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
406 |
| +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
407 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
408 |
+-----> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
409 |
| codeword -------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
410 |
+------------------+ | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
411 |
now we're | assembly to <------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
412 |
executing | implement + | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
413 |
this | .. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
414 |
function | .. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
415 |
| NEXT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
416 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
417 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
418 |
So I hope that I've convinced you that NEXT does roughly what you'd expect. This is |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
419 |
indirect threaded code. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
420 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
421 |
I've glossed over four things. I wonder if you can guess without reading on what they are? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
422 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
423 |
. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
424 |
. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
425 |
. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
426 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
427 |
My list of four things are: (1) What does "EXIT" do? (2) which is related to (1) is how do |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
428 |
you call into a function, ie. how does %esi start off pointing at part of QUADRUPLE, but |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
429 |
then point at part of DOUBLE. (3) What goes in the codeword for the words which are written |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
430 |
in FORTH? (4) How do you compile a function which does anything except call other functions |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
431 |
ie. a function which contains a number like : DOUBLE 2 * ; ? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
432 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
433 |
THE INTERPRETER AND RETURN STACK ------------------------------------------------------------ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
434 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
435 |
Going at these in no particular order, let's talk about issues (3) and (2), the interpreter |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
436 |
and the return stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
437 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
438 |
Words which are defined in FORTH need a codeword which points to a little bit of code to |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
439 |
give them a "helping hand" in life. They don't need much, but they do need what is known |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
440 |
as an "interpreter", although it doesn't really "interpret" in the same way that, say, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
441 |
Java bytecode used to be interpreted (ie. slowly). This interpreter just sets up a few |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
442 |
machine registers so that the word can then execute at full speed using the indirect |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
443 |
threaded model above. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
444 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
445 |
One of the things that needs to happen when QUADRUPLE calls DOUBLE is that we save the old |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
446 |
%esi ("instruction pointer") and create a new one pointing to the first word in DOUBLE. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
447 |
Because we will need to restore the old %esi at the end of DOUBLE (this is, after all, like |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
448 |
a function call), we will need a stack to store these "return addresses" (old values of %esi). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
449 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
450 |
As you will have read, when reading the background documentation, FORTH has two stacks, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
451 |
an ordinary stack for parameters, and a return stack which is a bit more mysterious. But |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
452 |
our return stack is just the stack I talked about in the previous paragraph, used to save |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
453 |
%esi when calling from a FORTH word into another FORTH word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
454 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
455 |
In this FORTH, we are using the normal stack pointer (%esp) for the parameter stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
456 |
We will use the i386's "other" stack pointer (%ebp, usually called the "frame pointer") |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
457 |
for our return stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
458 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
459 |
I've got two macros which just wrap up the details of using %ebp for the return stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
460 |
You use them as for example "PUSHRSP %eax" (push %eax on the return stack) or "POPRSP %ebx" |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
461 |
(pop top of return stack into %ebx). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
462 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
463 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
464 |
/* Macros to deal with the return stack. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
465 |
.macro PUSHRSP reg |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
466 |
lea -4(%ebp),%ebp // push reg on to return stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
467 |
movl \reg,(%ebp) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
468 |
.endm |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
469 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
470 |
.macro POPRSP reg |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
471 |
mov (%ebp),\reg // pop top of return stack to reg |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
472 |
lea 4(%ebp),%ebp |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
473 |
.endm |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
474 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
475 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
476 |
And with that we can now talk about the interpreter. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
477 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
478 |
In FORTH the interpreter function is often called DOCOL (I think it means "DO COLON" because |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
479 |
all FORTH definitions start with a colon, as in : DOUBLE DUP + ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
480 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
481 |
The "interpreter" (it's not really "interpreting") just needs to push the old %esi on the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
482 |
stack and set %esi to the first word in the definition. Remember that we jumped to the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
483 |
function using JMP *(%eax)? Well a consequence of that is that conveniently %eax contains |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
484 |
the address of this codeword, so just by adding 4 to it we get the address of the first |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
485 |
data word. Finally after setting up %esi, it just does NEXT which causes that first word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
486 |
to run. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
487 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
488 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
489 |
/* DOCOL - the interpreter! */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
490 |
.text |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
491 |
.align 4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
492 |
DOCOL: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
493 |
PUSHRSP %esi // push %esi on to the return stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
494 |
addl $4,%eax // %eax points to codeword, so make |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
495 |
movl %eax,%esi // %esi point to first data word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
496 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
497 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
498 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
499 |
Just to make this absolutely clear, let's see how DOCOL works when jumping from QUADRUPLE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
500 |
into DOUBLE: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
501 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
502 |
QUADRUPLE: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
503 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
504 |
| codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
505 |
+------------------+ DOUBLE: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
506 |
| addr of DOUBLE ---------------> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
507 |
+------------------+ %eax -> | addr of DOCOL | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
508 |
%esi -> | addr of DOUBLE | +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
509 |
+------------------+ | addr of DUP | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
510 |
| addr of EXIT | +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
511 |
+------------------+ | etc. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
512 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
513 |
First, the call to DOUBLE calls DOCOL (the codeword of DOUBLE). DOCOL does this: It |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
514 |
pushes the old %esi on the return stack. %eax points to the codeword of DOUBLE, so we |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
515 |
just add 4 on to it to get our new %esi: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
516 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
517 |
QUADRUPLE: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
518 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
519 |
| codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
520 |
+------------------+ DOUBLE: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
521 |
| addr of DOUBLE ---------------> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
522 |
top of return +------------------+ %eax -> | addr of DOCOL | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
523 |
stack points -> | addr of DOUBLE | + 4 = +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
524 |
+------------------+ %esi -> | addr of DUP | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
525 |
| addr of EXIT | +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
526 |
+------------------+ | etc. | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
527 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
528 |
Then we do NEXT, and because of the magic of threaded code that increments %esi again |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
529 |
and calls DUP. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
530 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
531 |
Well, it seems to work. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
532 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
533 |
One minor point here. Because DOCOL is the first bit of assembly actually to be defined |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
534 |
in this file (the others were just macros), and because I usually compile this code with the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
535 |
text segment starting at address 0, DOCOL has address 0. So if you are disassembling the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
536 |
code and see a word with a codeword of 0, you will immediately know that the word is |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
537 |
written in FORTH (it's not an assembler primitive) and so uses DOCOL as the interpreter. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
538 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
539 |
STARTING UP ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
540 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
541 |
Now let's get down to nuts and bolts. When we start the program we need to set up |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
542 |
a few things like the return stack. But as soon as we can, we want to jump into FORTH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
543 |
code (albeit much of the "early" FORTH code will still need to be written as |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
544 |
assembly language primitives). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
545 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
546 |
This is what the set up code does. Does a tiny bit of house-keeping, sets up the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
547 |
separate return stack (NB: Linux gives us the ordinary parameter stack already), then |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
548 |
immediately jumps to a FORTH word called COLD. COLD stands for cold-start. In ISO |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
549 |
FORTH (but not in this FORTH), COLD can be called at any time to completely reset |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
550 |
the state of FORTH, and there is another word called WARM which does a partial reset. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
551 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
552 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
553 |
/* ELF entry point. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
554 |
.text |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
555 |
.globl _start |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
556 |
_start: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
557 |
cld |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
558 |
mov %esp,var_S0 // Store the initial data stack pointer. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
559 |
mov $return_stack,%ebp // Initialise the return stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
560 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
561 |
mov $cold_start,%esi // Initialise interpreter. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
562 |
NEXT // Run interpreter! |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
563 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
564 |
.section .rodata |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
565 |
cold_start: // High-level code without a codeword. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
566 |
.int COLD |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
567 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
568 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
569 |
We also allocate some space for the return stack and some space to store user |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
570 |
definitions. These are static memory allocations using fixed-size buffers, but it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
571 |
wouldn't be a great deal of work to make them dynamic. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
572 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
573 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
574 |
.bss |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
575 |
/* FORTH return stack. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
576 |
#define RETURN_STACK_SIZE 8192 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
577 |
.align 4096 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
578 |
.space RETURN_STACK_SIZE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
579 |
return_stack: // Initial top of return stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
580 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
581 |
/* Space for user-defined words. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
582 |
#define USER_DEFS_SIZE 16384 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
583 |
.align 4096 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
584 |
user_defs_start: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
585 |
.space USER_DEFS_SIZE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
586 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
587 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
588 |
BUILT-IN WORDS ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
589 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
590 |
Remember our dictionary entries (headers). Let's bring those together with the codeword |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
591 |
and data words to see how : DOUBLE DUP + ; really looks in memory. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
592 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
593 |
pointer to previous word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
594 |
^ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
595 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
596 |
+--|------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
597 |
| LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
598 |
+---------+---+---+---+---+---+---+---+---+------------+--|---------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
599 |
^ len pad codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
600 |
| V |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
601 |
LINK in next word points to codeword of DUP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
602 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
603 |
Initially we can't just write ": DOUBLE DUP + ;" (ie. that literal string) here because we |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
604 |
don't yet have anything to read the string, break it up at spaces, parse each word, etc. etc. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
605 |
So instead we will have to define built-in words using the GNU assembler data constructors |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
606 |
(like .int, .byte, .string, .ascii and so on -- look them up in the gas info page if you are |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
607 |
unsure of them). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
608 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
609 |
The long way would be: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
610 |
.int <link to previous word> |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
611 |
.byte 6 // len |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
612 |
.ascii "DOUBLE" // string |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
613 |
.byte 0 // padding |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
614 |
DOUBLE: .int DOCOL // codeword |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
615 |
.int DUP // pointer to codeword of DUP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
616 |
.int PLUS // pointer to codeword of + |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
617 |
.int EXIT // pointer to codeword of EXIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
618 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
619 |
That's going to get quite tedious rather quickly, so here I define an assembler macro |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
620 |
so that I can just write: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
621 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
622 |
defword "DOUBLE",6,,DOUBLE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
623 |
.int DUP,PLUS,EXIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
624 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
625 |
and I'll get exactly the same effect. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
626 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
627 |
Don't worry too much about the exact implementation details of this macro - it's complicated! |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
628 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
629 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
630 |
/* Flags - these are discussed later. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
631 |
#define F_IMMED 0x80 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
632 |
#define F_HIDDEN 0x20 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
633 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
634 |
// Store the chain of links. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
635 |
.set link,0 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
636 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
637 |
.macro defword name, namelen, flags=0, label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
638 |
.section .rodata |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
639 |
.align 4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
640 |
.globl name_\label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
641 |
name_\label : |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
642 |
.int link // link |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
643 |
.set link,name_\label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
644 |
.byte \flags+\namelen // flags + length byte |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
645 |
.ascii "\name" // the name |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
646 |
.align 4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
647 |
.globl \label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
648 |
\label : |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
649 |
.int DOCOL // codeword - the interpreter |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
650 |
// list of word pointers follow |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
651 |
.endm |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
652 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
653 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
654 |
Similarly I want a way to write words written in assembly language. There will quite a few |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
655 |
of these to start with because, well, everything has to start in assembly before there's |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
656 |
enough "infrastructure" to be able to start writing FORTH words, but also I want to define |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
657 |
some common FORTH words in assembly language for speed, even though I could write them in FORTH. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
658 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
659 |
This is what DUP looks like in memory: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
660 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
661 |
pointer to previous word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
662 |
^ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
663 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
664 |
+--|------+---+---+---+---+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
665 |
| LINK | 3 | D | U | P | code_DUP ---------------------> points to the assembly |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
666 |
+---------+---+---+---+---+------------+ code used to write DUP, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
667 |
^ len codeword which ends with NEXT. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
668 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
669 |
LINK in next word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
670 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
671 |
Again, for brevity in writing the header I'm going to write an assembler macro called defcode. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
672 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
673 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
674 |
.macro defcode name, namelen, flags=0, label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
675 |
.section .rodata |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
676 |
.align 4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
677 |
.globl name_\label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
678 |
name_\label : |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
679 |
.int link // link |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
680 |
.set link,name_\label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
681 |
.byte \flags+\namelen // flags + length byte |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
682 |
.ascii "\name" // the name |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
683 |
.align 4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
684 |
.globl \label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
685 |
\label : |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
686 |
.int code_\label // codeword |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
687 |
.text |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
688 |
.align 4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
689 |
.globl code_\label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
690 |
code_\label : // assembler code follows |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
691 |
.endm |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
692 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
693 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
694 |
Now some easy FORTH primitives. These are written in assembly for speed. If you understand |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
695 |
i386 assembly language then it is worth reading these. However if you don't understand assembly |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
696 |
you can skip the details. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
697 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
698 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
699 |
defcode "DUP",3,,DUP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
700 |
pop %eax // duplicate top of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
701 |
push %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
702 |
push %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
703 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
704 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
705 |
defcode "DROP",4,,DROP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
706 |
pop %eax // drop top of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
707 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
708 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
709 |
defcode "SWAP",4,,SWAP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
710 |
pop %eax // swap top of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
711 |
pop %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
712 |
push %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
713 |
push %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
714 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
715 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
716 |
defcode "OVER",4,,OVER |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
717 |
mov 4(%esp),%eax // get the second element of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
718 |
push %eax // and push it on top |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
719 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
720 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
721 |
defcode "ROT",3,,ROT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
722 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
723 |
pop %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
724 |
pop %ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
725 |
push %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
726 |
push %ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
727 |
push %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
728 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
729 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
730 |
defcode "-ROT",4,,NROT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
731 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
732 |
pop %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
733 |
pop %ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
734 |
push %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
735 |
push %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
736 |
push %ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
737 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
738 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
739 |
defcode "1+",2,,INCR |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
740 |
incl (%esp) // increment top of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
741 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
742 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
743 |
defcode "1-",2,,DECR |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
744 |
decl (%esp) // decrement top of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
745 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
746 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
747 |
defcode "4+",2,,INCR4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
748 |
addl $4,(%esp) // add 4 to top of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
749 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
750 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
751 |
defcode "4-",2,,DECR4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
752 |
subl $4,(%esp) // subtract 4 from top of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
753 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
754 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
755 |
defcode "+",1,,ADD |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
756 |
pop %eax // get top of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
757 |
addl %eax,(%esp) // and add it to next word on stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
758 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
759 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
760 |
defcode "-",1,,SUB |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
761 |
pop %eax // get top of stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
762 |
subl %eax,(%esp) // and subtract it from next word on stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
763 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
764 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
765 |
defcode "*",1,,MUL |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
766 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
767 |
pop %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
768 |
imull %ebx,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
769 |
push %eax // ignore overflow |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
770 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
771 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
772 |
defcode "/",1,,DIV |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
773 |
xor %edx,%edx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
774 |
pop %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
775 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
776 |
idivl %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
777 |
push %eax // push quotient |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
778 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
779 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
780 |
defcode "MOD",3,,MOD |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
781 |
xor %edx,%edx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
782 |
pop %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
783 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
784 |
idivl %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
785 |
push %edx // push remainder |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
786 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
787 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
788 |
defcode "=",1,,EQU // top two words are equal? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
789 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
790 |
pop %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
791 |
cmp %ebx,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
792 |
je 1f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
793 |
pushl $0 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
794 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
795 |
1: pushl $1 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
796 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
797 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
798 |
defcode "<>",2,,NEQU // top two words are not equal? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
799 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
800 |
pop %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
801 |
cmp %ebx,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
802 |
je 1f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
803 |
pushl $1 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
804 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
805 |
1: pushl $0 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
806 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
807 |
|
146
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
808 |
defcode ">",1,,GT // greater-than |
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
809 |
pop %eax |
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
810 |
pop %ebx |
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
811 |
cmp %ebx,%eax |
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
812 |
jl 1f |
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
813 |
pushl $0 |
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
814 |
NEXT |
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
815 |
1: pushl $1 |
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
816 |
NEXT |
42de487aa9bb
Add ">" operator to jonesforth
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
145
diff
changeset
|
817 |
|
145
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
818 |
defcode "0=",2,,ZEQU // top of stack equals 0? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
819 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
820 |
test %eax,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
821 |
jz 1f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
822 |
pushl $0 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
823 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
824 |
1: pushl $1 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
825 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
826 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
827 |
defcode "AND",3,,AND |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
828 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
829 |
andl %eax,(%esp) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
830 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
831 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
832 |
defcode "OR",2,,OR |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
833 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
834 |
orl %eax,(%esp) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
835 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
836 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
837 |
defcode "INVERT",6,,INVERT // this is the FORTH "NOT" function |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
838 |
notl (%esp) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
839 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
840 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
841 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
842 |
RETURNING FROM FORTH WORDS ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
843 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
844 |
Time to talk about what happens when we EXIT a function. In this diagram QUADRUPLE has called |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
845 |
DOUBLE, and DOUBLE is about to exit (look at where %esi is pointing): |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
846 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
847 |
QUADRUPLE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
848 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
849 |
| codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
850 |
+------------------+ DOUBLE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
851 |
| addr of DOUBLE ---------------> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
852 |
+------------------+ | codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
853 |
| addr of DOUBLE | +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
854 |
+------------------+ | addr of DUP | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
855 |
| addr of EXIT | +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
856 |
+------------------+ | addr of + | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
857 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
858 |
%esi -> | addr of EXIT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
859 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
860 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
861 |
What happens when the + function does NEXT? Well, the following code is executed. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
862 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
863 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
864 |
defcode "EXIT",4,,EXIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
865 |
POPRSP %esi // pop return stack into %esi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
866 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
867 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
868 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
869 |
EXIT gets the old %esi which we saved from before on the return stack, and puts it in %esi. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
870 |
So after this (but just before NEXT) we get: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
871 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
872 |
QUADRUPLE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
873 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
874 |
| codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
875 |
+------------------+ DOUBLE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
876 |
| addr of DOUBLE ---------------> +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
877 |
+------------------+ | codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
878 |
%esi -> | addr of DOUBLE | +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
879 |
+------------------+ | addr of DUP | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
880 |
| addr of EXIT | +------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
881 |
+------------------+ | addr of + | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
882 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
883 |
| addr of EXIT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
884 |
+------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
885 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
886 |
And NEXT just completes the job by, well in this case just by calling DOUBLE again :-) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
887 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
888 |
LITERALS ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
889 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
890 |
The final point I "glossed over" before was how to deal with functions that do anything |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
891 |
apart from calling other functions. For example, suppose that DOUBLE was defined like this: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
892 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
893 |
: DOUBLE 2 * ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
894 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
895 |
It does the same thing, but how do we compile it since it contains the literal 2? One way |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
896 |
would be to have a function called "2" (which you'd have to write in assembler), but you'd need |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
897 |
a function for every single literal that you wanted to use. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
898 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
899 |
FORTH solves this by compiling the function using a special word called LIT: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
900 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
901 |
+---------------------------+-------+-------+-------+-------+-------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
902 |
| (usual header of DOUBLE) | DOCOL | LIT | 2 | * | EXIT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
903 |
+---------------------------+-------+-------+-------+-------+-------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
904 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
905 |
LIT is executed in the normal way, but what it does next is definitely not normal. It |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
906 |
looks at %esi (which now points to the literal 2), grabs it, pushes it on the stack, then |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
907 |
manipulates %esi in order to skip the literal as if it had never been there. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
908 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
909 |
What's neat is that the whole grab/manipulate can be done using a single byte single |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
910 |
i386 instruction, our old friend LODSL. Rather than me drawing more ASCII-art diagrams, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
911 |
see if you can find out how LIT works: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
912 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
913 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
914 |
defcode "LIT",3,,LIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
915 |
// %esi points to the next command, but in this case it points to the next |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
916 |
// literal 32 bit integer. Get that literal into %eax and increment %esi. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
917 |
// On x86, it's a convenient single byte instruction! (cf. NEXT macro) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
918 |
lodsl |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
919 |
push %eax // push the literal number on to stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
920 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
921 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
922 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
923 |
MEMORY ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
924 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
925 |
As important point about FORTH is that it gives you direct access to the lowest levels |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
926 |
of the machine. Manipulating memory directly is done frequently in FORTH, and these are |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
927 |
the primitive words for doing it. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
928 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
929 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
930 |
defcode "!",1,,STORE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
931 |
pop %ebx // address to store at |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
932 |
pop %eax // data to store there |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
933 |
mov %eax,(%ebx) // store it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
934 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
935 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
936 |
defcode "@",1,,FETCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
937 |
pop %ebx // address to fetch |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
938 |
mov (%ebx),%eax // fetch it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
939 |
push %eax // push value onto stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
940 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
941 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
942 |
defcode "+!",2,,ADDSTORE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
943 |
pop %ebx // address |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
944 |
pop %eax // the amount to add |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
945 |
addl %eax,(%ebx) // add it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
946 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
947 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
948 |
defcode "-!",2,,SUBSTORE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
949 |
pop %ebx // address |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
950 |
pop %eax // the amount to subtract |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
951 |
subl %eax,(%ebx) // add it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
952 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
953 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
954 |
/* ! and @ (STORE and FETCH) store 32-bit words. It's also useful to be able to read and write bytes. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
955 |
* I don't know whether FORTH has these words, so I invented my own, called !b and @b. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
956 |
* Byte-oriented operations only work on architectures which permit them (i386 is one of those). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
957 |
* UPDATE: writing a byte to the dictionary pointer is called C, in FORTH. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
958 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
959 |
defcode "!b",2,,STOREBYTE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
960 |
pop %ebx // address to store at |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
961 |
pop %eax // data to store there |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
962 |
movb %al,(%ebx) // store it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
963 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
964 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
965 |
defcode "@b",2,,FETCHBYTE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
966 |
pop %ebx // address to fetch |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
967 |
xor %eax,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
968 |
movb (%ebx),%al // fetch it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
969 |
push %eax // push value onto stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
970 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
971 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
972 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
973 |
BUILT-IN VARIABLES ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
974 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
975 |
These are some built-in variables and related standard FORTH words. Of these, the only one that we |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
976 |
have discussed so far was LATEST, which points to the last (most recently defined) word in the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
977 |
FORTH dictionary. LATEST is also a FORTH word which pushes the address of LATEST (the variable) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
978 |
on to the stack, so you can read or write it using @ and ! operators. For example, to print |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
979 |
the current value of LATEST (and this can apply to any FORTH variable) you would do: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
980 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
981 |
LATEST @ . CR |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
982 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
983 |
To make defining variables shorter, I'm using a macro called defvar, similar to defword and |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
984 |
defcode above. (In fact the defvar macro uses defcode to do the dictionary header). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
985 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
986 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
987 |
.macro defvar name, namelen, flags=0, label, initial=0 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
988 |
defcode \name,\namelen,\flags,\label |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
989 |
push $var_\name |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
990 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
991 |
.data |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
992 |
.align 4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
993 |
var_\name : |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
994 |
.int \initial |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
995 |
.endm |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
996 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
997 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
998 |
The built-in variables are: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
999 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1000 |
STATE Is the interpreter executing code (0) or compiling a word (non-zero)? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1001 |
LATEST Points to the latest (most recently defined) word in the dictionary. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1002 |
HERE Points to the next free byte of memory. When compiling, compiled words go here. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1003 |
_X These are three scratch variables, used by some standard dictionary words. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1004 |
_Y |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1005 |
_Z |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1006 |
S0 Stores the address of the top of the parameter stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1007 |
R0 Stores the address of the top of the return stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1008 |
VERSION Is the current version of this FORTH. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1009 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1010 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1011 |
defvar "STATE",5,,STATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1012 |
defvar "HERE",4,,HERE,user_defs_start |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1013 |
defvar "LATEST",6,,LATEST,name_SYSEXIT // SYSEXIT must be last in built-in dictionary |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1014 |
defvar "_X",2,,TX |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1015 |
defvar "_Y",2,,TY |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1016 |
defvar "_Z",2,,TZ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1017 |
defvar "S0",2,,SZ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1018 |
defvar "R0",2,,RZ,return_stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1019 |
defvar "VERSION",7,,VERSION,JONES_VERSION |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1020 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1021 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1022 |
RETURN STACK ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1023 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1024 |
These words allow you to access the return stack. Recall that the register %ebp always points to |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1025 |
the top of the return stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1026 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1027 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1028 |
defcode ">R",2,,TOR |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1029 |
pop %eax // pop parameter stack into %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1030 |
PUSHRSP %eax // push it on to the return stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1031 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1032 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1033 |
defcode "R>",2,,FROMR |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1034 |
POPRSP %eax // pop return stack on to %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1035 |
push %eax // and push on to parameter stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1036 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1037 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1038 |
defcode "RSP@",4,,RSPFETCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1039 |
push %ebp |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1040 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1041 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1042 |
defcode "RSP!",4,,RSPSTORE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1043 |
pop %ebp |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1044 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1045 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1046 |
defcode "RDROP",5,,RDROP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1047 |
lea 4(%ebp),%ebp // pop return stack and throw away |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1048 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1049 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1050 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1051 |
PARAMETER (DATA) STACK ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1052 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1053 |
These functions allow you to manipulate the parameter stack. Recall that Linux sets up the parameter |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1054 |
stack for us, and it is accessed through %esp. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1055 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1056 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1057 |
defcode "DSP@",4,,DSPFETCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1058 |
mov %esp,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1059 |
push %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1060 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1061 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1062 |
defcode "DSP!",4,,DSPSTORE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1063 |
pop %esp |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1064 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1065 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1066 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1067 |
INPUT AND OUTPUT ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1068 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1069 |
These are our first really meaty/complicated FORTH primitives. I have chosen to write them in |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1070 |
assembler, but surprisingly in "real" FORTH implementations these are often written in terms |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1071 |
of more fundamental FORTH primitives. I chose to avoid that because I think that just obscures |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1072 |
the implementation. After all, you may not understand assembler but you can just think of it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1073 |
as an opaque block of code that does what it says. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1074 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1075 |
Let's discuss input first. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1076 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1077 |
The FORTH word KEY reads the next byte from stdin (and pushes it on the parameter stack). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1078 |
So if KEY is called and someone hits the space key, then the number 32 (ASCII code of space) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1079 |
is pushed on the stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1080 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1081 |
In FORTH there is no distinction between reading code and reading input. We might be reading |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1082 |
and compiling code, we might be reading words to execute, we might be asking for the user |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1083 |
to type their name -- ultimately it all comes in through KEY. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1084 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1085 |
The implementation of KEY uses an input buffer of a certain size (defined at the end of the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1086 |
program). It calls the Linux read(2) system call to fill this buffer and tracks its position |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1087 |
in the buffer using a couple of variables, and if it runs out of input buffer then it refills |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1088 |
it automatically. The other thing that KEY does is if it detects that stdin has closed, it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1089 |
exits the program, which is why when you hit ^D the FORTH system cleanly exits. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1090 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1091 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1092 |
#include <asm-i386/unistd.h> |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1093 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1094 |
defcode "KEY",3,,KEY |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1095 |
call _KEY |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1096 |
push %eax // push return value on stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1097 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1098 |
_KEY: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1099 |
mov (currkey),%ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1100 |
cmp (bufftop),%ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1101 |
jge 1f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1102 |
xor %eax,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1103 |
mov (%ebx),%al |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1104 |
inc %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1105 |
mov %ebx,(currkey) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1106 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1107 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1108 |
1: // out of input; use read(2) to fetch more input from stdin |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1109 |
xor %ebx,%ebx // 1st param: stdin |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1110 |
mov $buffer,%ecx // 2nd param: buffer |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1111 |
mov %ecx,currkey |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1112 |
mov $buffend-buffer,%edx // 3rd param: max length |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1113 |
mov $__NR_read,%eax // syscall: read |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1114 |
int $0x80 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1115 |
test %eax,%eax // If %eax <= 0, then exit. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1116 |
jbe 2f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1117 |
addl %eax,%ecx // buffer+%eax = bufftop |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1118 |
mov %ecx,bufftop |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1119 |
jmp _KEY |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1120 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1121 |
2: // error or out of input: exit |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1122 |
xor %ebx,%ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1123 |
mov $__NR_exit,%eax // syscall: exit |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1124 |
int $0x80 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1125 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1126 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1127 |
By contrast, output is much simpler. The FORTH word EMIT writes out a single byte to stdout. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1128 |
This implementation just uses the write system call. No attempt is made to buffer output, but |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1129 |
it would be a good exercise to add it. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1130 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1131 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1132 |
defcode "EMIT",4,,EMIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1133 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1134 |
call _EMIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1135 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1136 |
_EMIT: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1137 |
mov $1,%ebx // 1st param: stdout |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1138 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1139 |
// write needs the address of the byte to write |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1140 |
mov %al,(2f) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1141 |
mov $2f,%ecx // 2nd param: address |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1142 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1143 |
mov $1,%edx // 3rd param: nbytes = 1 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1144 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1145 |
mov $__NR_write,%eax // write syscall |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1146 |
int $0x80 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1147 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1148 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1149 |
.bss |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1150 |
2: .space 1 // scratch used by EMIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1151 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1152 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1153 |
Back to input, WORD is a FORTH word which reads the next full word of input. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1154 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1155 |
What it does in detail is that it first skips any blanks (spaces, tabs, newlines and so on). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1156 |
Then it calls KEY to read characters into an internal buffer until it hits a blank. Then it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1157 |
calculates the length of the word it read and returns the address and the length as |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1158 |
two words on the stack (with address at the top). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1159 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1160 |
Notice that WORD has a single internal buffer which it overwrites each time (rather like |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1161 |
a static C string). Also notice that WORD's internal buffer is just 32 bytes long and |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1162 |
there is NO checking for overflow. 31 bytes happens to be the maximum length of a |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1163 |
FORTH word that we support, and that is what WORD is used for: to read FORTH words when |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1164 |
we are compiling and executing code. The returned strings are not NUL-terminated, so |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1165 |
in some crazy-world you could define FORTH words containing ASCII NULs, although why |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1166 |
you'd want to is a bit beyond me. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1167 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1168 |
WORD is not suitable for just reading strings (eg. user input) because of all the above |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1169 |
peculiarities and limitations. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1170 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1171 |
Note that when executing, you'll see: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1172 |
WORD FOO |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1173 |
which puts "FOO" and length 3 on the stack, but when compiling: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1174 |
: BAR WORD FOO ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1175 |
is an error (or at least it doesn't do what you might expect). Later we'll talk about compiling |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1176 |
and immediate mode, and you'll understand why. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1177 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1178 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1179 |
defcode "WORD",4,,WORD |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1180 |
call _WORD |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1181 |
push %ecx // push length |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1182 |
push %edi // push base address |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1183 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1184 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1185 |
_WORD: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1186 |
/* Search for first non-blank character. Also skip \ comments. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1187 |
1: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1188 |
call _KEY // get next key, returned in %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1189 |
cmpb $'\\',%al // start of a comment? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1190 |
je 3f // if so, skip the comment |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1191 |
cmpb $' ',%al |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1192 |
jbe 1b // if so, keep looking |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1193 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1194 |
/* Search for the end of the word, storing chars as we go. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1195 |
mov $5f,%edi // pointer to return buffer |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1196 |
2: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1197 |
stosb // add character to return buffer |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1198 |
call _KEY // get next key, returned in %al |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1199 |
cmpb $' ',%al // is blank? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1200 |
ja 2b // if not, keep looping |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1201 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1202 |
/* Return the word (well, the static buffer) and length. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1203 |
sub $5f,%edi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1204 |
mov %edi,%ecx // return length of the word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1205 |
mov $5f,%edi // return address of the word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1206 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1207 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1208 |
/* Code to skip \ comments to end of the current line. */ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1209 |
3: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1210 |
call _KEY |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1211 |
cmpb $'\n',%al // end of line yet? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1212 |
jne 3b |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1213 |
jmp 1b |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1214 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1215 |
.bss |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1216 |
// A static buffer where WORD returns. Subsequent calls |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1217 |
// overwrite this buffer. Maximum word length is 32 chars. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1218 |
5: .space 32 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1219 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1220 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1221 |
. (also called DOT) prints the top of the stack as an integer. In real FORTH implementations |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1222 |
it should print it in the current base, but this assembler version is simpler and can only |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1223 |
print in base 10. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1224 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1225 |
Remember that you can override even built-in FORTH words easily, so if you want to write a |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1226 |
more advanced DOT then you can do so easily at a later point, and probably in FORTH. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1227 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1228 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1229 |
defcode ".",1,,DOT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1230 |
pop %eax // Get the number to print into %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1231 |
call _DOT // Easier to do this recursively ... |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1232 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1233 |
_DOT: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1234 |
mov $10,%ecx // Base 10 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1235 |
1: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1236 |
cmp %ecx,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1237 |
jb 2f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1238 |
xor %edx,%edx // %edx:%eax / %ecx -> quotient %eax, remainder %edx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1239 |
idivl %ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1240 |
pushl %edx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1241 |
call _DOT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1242 |
popl %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1243 |
jmp 1b |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1244 |
2: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1245 |
xor %ah,%ah |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1246 |
aam $10 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1247 |
cwde |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1248 |
addl $'0',%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1249 |
call _EMIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1250 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1251 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1252 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1253 |
Almost the opposite of DOT (but not quite), SNUMBER parses a numeric string such as one returned |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1254 |
by WORD and pushes the number on the parameter stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1255 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1256 |
This function does absolutely no error checking, and in particular the length of the string |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1257 |
must be >= 1 bytes, and should contain only digits 0-9. If it doesn't you'll get random results. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1258 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1259 |
This function is only used when reading literal numbers in code, and shouldn't really be used |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1260 |
in user code at all. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1261 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1262 |
defcode "SNUMBER",7,,SNUMBER |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1263 |
pop %edi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1264 |
pop %ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1265 |
call _SNUMBER |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1266 |
push %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1267 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1268 |
_SNUMBER: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1269 |
xor %eax,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1270 |
xor %ebx,%ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1271 |
1: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1272 |
imull $10,%eax // %eax *= 10 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1273 |
movb (%edi),%bl |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1274 |
inc %edi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1275 |
subb $'0',%bl // ASCII -> digit |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1276 |
add %ebx,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1277 |
dec %ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1278 |
jnz 1b |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1279 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1280 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1281 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1282 |
DICTIONARY LOOK UPS ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1283 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1284 |
We're building up to our prelude on how FORTH code is compiled, but first we need yet more infrastructure. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1285 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1286 |
The FORTH word FIND takes a string (a word as parsed by WORD -- see above) and looks it up in the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1287 |
dictionary. What it actually returns is the address of the dictionary header, if it finds it, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1288 |
or 0 if it didn't. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1289 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1290 |
So if DOUBLE is defined in the dictionary, then WORD DOUBLE FIND returns the following pointer: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1291 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1292 |
pointer to this |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1293 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1294 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1295 |
V |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1296 |
+---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1297 |
| LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1298 |
+---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1299 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1300 |
See also >CFA which takes a dictionary entry pointer and returns a pointer to the codeword. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1301 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1302 |
FIND doesn't find dictionary entries which are flagged as HIDDEN. See below for why. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1303 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1304 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1305 |
defcode "FIND",4,,FIND |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1306 |
pop %edi // %edi = address |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1307 |
pop %ecx // %ecx = length |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1308 |
call _FIND |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1309 |
push %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1310 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1311 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1312 |
_FIND: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1313 |
push %esi // Save %esi so we can use it in string comparison. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1314 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1315 |
// Now we start searching backwards through the dictionary for this word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1316 |
mov var_LATEST,%edx // LATEST points to name header of the latest word in the dictionary |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1317 |
1: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1318 |
test %edx,%edx // NULL pointer? (end of the linked list) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1319 |
je 4f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1320 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1321 |
// Compare the length expected and the length of the word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1322 |
// Note that if the F_HIDDEN flag is set on the word, then by a bit of trickery |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1323 |
// this won't pick the word (the length will appear to be wrong). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1324 |
xor %eax,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1325 |
movb 4(%edx),%al // %al = flags+length field |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1326 |
andb $(F_HIDDEN|0x1f),%al // %al = name length |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1327 |
cmpb %cl,%al // Length is the same? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1328 |
jne 2f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1329 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1330 |
// Compare the strings in detail. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1331 |
push %ecx // Save the length |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1332 |
push %edi // Save the address (repe cmpsb will move this pointer) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1333 |
lea 5(%edx),%esi // Dictionary string we are checking against. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1334 |
repe cmpsb // Compare the strings. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1335 |
pop %edi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1336 |
pop %ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1337 |
jne 2f // Not the same. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1338 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1339 |
// The strings are the same - return the header pointer in %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1340 |
pop %esi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1341 |
mov %edx,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1342 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1343 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1344 |
2: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1345 |
mov (%edx),%edx // Move back through the link field to the previous word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1346 |
jmp 1b // .. and loop. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1347 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1348 |
4: // Not found. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1349 |
pop %esi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1350 |
xor %eax,%eax // Return zero to indicate not found. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1351 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1352 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1353 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1354 |
FIND returns the dictionary pointer, but when compiling we need the codeword pointer (recall |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1355 |
that FORTH definitions are compiled into lists of codeword pointers). The standard FORTH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1356 |
word >CFA turns a dictionary pointer into a codeword pointer. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1357 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1358 |
The example below shows the result of: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1359 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1360 |
WORD DOUBLE FIND >CFA |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1361 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1362 |
FIND returns a pointer to this |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1363 |
| >CFA converts it to a pointer to this |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1364 |
| | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1365 |
V V |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1366 |
+---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1367 |
| LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1368 |
+---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1369 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1370 |
Notes: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1371 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1372 |
Because names vary in length, this isn't just a simple increment. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1373 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1374 |
In this FORTH you cannot easily turn a codeword pointer back into a dictionary entry pointer, but |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1375 |
that is not true in most FORTH implementations where they store a back pointer in the definition |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1376 |
(with an obvious memory/complexity cost). The reason they do this is that it is useful to be |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1377 |
able to go backwards (codeword -> dictionary entry) in order to decompile FORTH definitions. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1378 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1379 |
What does CFA stand for? My best guess is "Code Field Address". |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1380 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1381 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1382 |
defcode ">CFA",4,,TCFA |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1383 |
pop %edi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1384 |
call _TCFA |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1385 |
push %edi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1386 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1387 |
_TCFA: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1388 |
xor %eax,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1389 |
add $4,%edi // Skip link pointer. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1390 |
movb (%edi),%al // Load flags+len into %al. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1391 |
inc %edi // Skip flags+len byte. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1392 |
andb $0x1f,%al // Just the length, not the flags. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1393 |
add %eax,%edi // Skip the name. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1394 |
addl $3,%edi // The codeword is 4-byte aligned. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1395 |
andl $~3,%edi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1396 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1397 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1398 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1399 |
COMPILING ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1400 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1401 |
Now we'll talk about how FORTH compiles words. Recall that a word definition looks like this: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1402 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1403 |
: DOUBLE DUP + ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1404 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1405 |
and we have to turn this into: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1406 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1407 |
pointer to previous word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1408 |
^ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1409 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1410 |
+--|------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1411 |
| LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1412 |
+---------+---+---+---+---+---+---+---+---+------------+--|---------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1413 |
^ len pad codeword | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1414 |
| V |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1415 |
LATEST points here points to codeword of DUP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1416 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1417 |
There are several problems to solve. Where to put the new word? How do we read words? How |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1418 |
do we define the words : (COLON) and ; (SEMICOLON)? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1419 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1420 |
FORTH solves this rather elegantly and as you might expect in a very low-level way which |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1421 |
allows you to change how the compiler works on your own code. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1422 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1423 |
FORTH has an INTERPRETER function (a true interpreter this time, not DOCOL) which runs in a |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1424 |
loop, reading words (using WORD), looking them up (using FIND), turning them into codeword |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1425 |
pointers (using >CFA) and deciding what to do with them. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1426 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1427 |
What it does depends on the mode of the interpreter (in variable STATE). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1428 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1429 |
When STATE is zero, the interpreter just runs each word as it looks them up. This is known as |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1430 |
immediate mode. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1431 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1432 |
The interesting stuff happens when STATE is non-zero -- compiling mode. In this mode the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1433 |
interpreter appends the codeword pointer to user memory (the HERE variable points to the next |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1434 |
free byte of user memory). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1435 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1436 |
So you may be able to see how we could define : (COLON). The general plan is: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1437 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1438 |
(1) Use WORD to read the name of the function being defined. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1439 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1440 |
(2) Construct the dictionary entry -- just the header part -- in user memory: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1441 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1442 |
pointer to previous word (from LATEST) +-- Afterwards, HERE points here, where |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1443 |
^ | the interpreter will start appending |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1444 |
| V codewords. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1445 |
+--|------+---+---+---+---+---+---+---+---+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1446 |
| LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1447 |
+---------+---+---+---+---+---+---+---+---+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1448 |
len pad codeword |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1449 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1450 |
(3) Set LATEST to point to the newly defined word, ... |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1451 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1452 |
(4) .. and most importantly leave HERE pointing just after the new codeword. This is where |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1453 |
the interpreter will append codewords. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1454 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1455 |
(5) Set STATE to 1. This goes into compile mode so the interpreter starts appending codewords to |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1456 |
our partially-formed header. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1457 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1458 |
After : has run, our input is here: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1459 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1460 |
: DOUBLE DUP + ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1461 |
^ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1462 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1463 |
Next byte returned by KEY |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1464 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1465 |
so the interpreter (now it's in compile mode, so I guess it's really the compiler) reads DUP, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1466 |
gets its codeword pointer, and appends it: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1467 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1468 |
+-- HERE updated to point here. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1469 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1470 |
V |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1471 |
+---------+---+---+---+---+---+---+---+---+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1472 |
| LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1473 |
+---------+---+---+---+---+---+---+---+---+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1474 |
len pad codeword |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1475 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1476 |
Next we read +, get the codeword pointer, and append it: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1477 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1478 |
+-- HERE updated to point here. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1479 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1480 |
V |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1481 |
+---------+---+---+---+---+---+---+---+---+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1482 |
| LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1483 |
+---------+---+---+---+---+---+---+---+---+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1484 |
len pad codeword |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1485 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1486 |
The issue is what happens next. Obviously what we _don't_ want to happen is that we |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1487 |
read ";" and compile it and go on compiling everything afterwards. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1488 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1489 |
At this point, FORTH uses a trick. Remember the length byte in the dictionary definition |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1490 |
isn't just a plain length byte, but can also contain flags. One flag is called the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1491 |
IMMEDIATE flag (F_IMMED in this code). If a word in the dictionary is flagged as |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1492 |
IMMEDIATE then the interpreter runs it immediately _even if it's in compile mode_. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1493 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1494 |
I hope I don't need to explain that ; (SEMICOLON) just such a word, flagged as IMMEDIATE. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1495 |
And all it does is append the codeword for EXIT on to the current definition and switch |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1496 |
back to immediate mode (set STATE back to 0). Shortly we'll see the actual definition |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1497 |
of ; and we'll see that it's really a very simple definition, declared IMMEDIATE. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1498 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1499 |
After the interpreter reads ; and executes it 'immediately', we get this: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1500 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1501 |
+---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1502 |
| LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1503 |
+---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1504 |
len pad codeword ^ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1505 |
| |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1506 |
HERE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1507 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1508 |
STATE is set to 0. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1509 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1510 |
And that's it, job done, our new definition is compiled, and we're back in immediate mode |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1511 |
just reading and executing words, perhaps including a call to test our new word DOUBLE. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1512 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1513 |
The only last wrinkle in this is that while our word was being compiled, it was in a |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1514 |
half-finished state. We certainly wouldn't want DOUBLE to be called somehow during |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1515 |
this time. There are several ways to stop this from happening, but in FORTH what we |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1516 |
do is flag the word with the HIDDEN flag (F_HIDDEN in this code) just while it is |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1517 |
being compiled. This prevents FIND from finding it, and thus in theory stops any |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1518 |
chance of it being called. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1519 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1520 |
Compared to the description above, the actual definition of : (COLON) is comparatively simple: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1521 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1522 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1523 |
defcode ":",1,,COLON |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1524 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1525 |
// Get the word and create a dictionary entry header for it. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1526 |
call _WORD // Returns %ecx = length, %edi = pointer to word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1527 |
mov %edi,%ebx // %ebx = address of the word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1528 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1529 |
movl var_HERE,%edi // %edi is the address of the header |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1530 |
movl var_LATEST,%eax // Get link pointer |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1531 |
stosl // and store it in the header. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1532 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1533 |
mov %cl,%al // Get the length. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1534 |
orb $F_HIDDEN,%al // Set the HIDDEN flag on this entry. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1535 |
stosb // Store the length/flags byte. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1536 |
push %esi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1537 |
mov %ebx,%esi // %esi = word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1538 |
rep movsb // Copy the word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1539 |
pop %esi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1540 |
addl $3,%edi // Align to next 4 byte boundary. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1541 |
andl $~3,%edi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1542 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1543 |
movl $DOCOL,%eax // The codeword for user-created words is always DOCOL (the interpreter) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1544 |
stosl |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1545 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1546 |
// Header built, so now update LATEST and HERE. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1547 |
// We'll be compiling words and putting them HERE. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1548 |
movl var_HERE,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1549 |
movl %eax,var_LATEST |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1550 |
movl %edi,var_HERE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1551 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1552 |
// And go into compile mode by setting STATE to 1. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1553 |
movl $1,var_STATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1554 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1555 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1556 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1557 |
, (COMMA) is a standard FORTH word which appends a 32 bit integer (normally a codeword |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1558 |
pointer) to the user data area pointed to by HERE, and adds 4 to HERE. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1559 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1560 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1561 |
defcode ",",1,,COMMA |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1562 |
pop %eax // Code pointer to store. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1563 |
call _COMMA |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1564 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1565 |
_COMMA: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1566 |
movl var_HERE,%edi // HERE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1567 |
stosl // Store it. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1568 |
movl %edi,var_HERE // Update HERE (incremented) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1569 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1570 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1571 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1572 |
; (SEMICOLON) is also elegantly simple. Notice the F_IMMED flag. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1573 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1574 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1575 |
defcode ";",1,F_IMMED,SEMICOLON |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1576 |
movl $EXIT,%eax // EXIT is the final codeword in compiled words. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1577 |
call _COMMA // Store it. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1578 |
call _HIDDEN // Toggle the HIDDEN flag (unhides the new word). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1579 |
xor %eax,%eax // Set STATE to 0 (back to execute mode). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1580 |
movl %eax,var_STATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1581 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1582 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1583 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1584 |
EXTENDING THE COMPILER ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1585 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1586 |
Words flagged with IMMEDIATE (F_IMMED) aren't just for the FORTH compiler to use. You can define |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1587 |
your own IMMEDIATE words too, and this is a crucial aspect when extending basic FORTH, because |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1588 |
it allows you in effect to extend the compiler itself. Does gcc let you do that? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1589 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1590 |
Standard FORTH words like IF, WHILE, .", [ and so on are all written as extensions to the basic |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1591 |
compiler, and are all IMMEDIATE words. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1592 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1593 |
The IMMEDIATE word toggles the F_IMMED (IMMEDIATE flag) on the most recently defined word, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1594 |
or on the current word if you call it in the middle of a definition. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1595 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1596 |
Typical usage is: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1597 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1598 |
: MYIMMEDWORD IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1599 |
...definition... |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1600 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1601 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1602 |
but some FORTH programmers write this instead: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1603 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1604 |
: MYIMMEDWORD |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1605 |
...definition... |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1606 |
; IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1607 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1608 |
The two usages are equivalent, to a first approximation. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1609 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1610 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1611 |
defcode "IMMEDIATE",9,F_IMMED,IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1612 |
call _IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1613 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1614 |
_IMMEDIATE: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1615 |
movl var_LATEST,%edi // LATEST word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1616 |
addl $4,%edi // Point to name/flags byte. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1617 |
xorb $F_IMMED,(%edi) // Toggle the IMMED bit. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1618 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1619 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1620 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1621 |
HIDDEN toggles the other flag, F_HIDDEN, of the latest word. Note that words flagged |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1622 |
as hidden are defined but cannot be called, so this is rarely used. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1623 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1624 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1625 |
defcode "HIDDEN",6,,HIDDEN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1626 |
call _HIDDEN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1627 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1628 |
_HIDDEN: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1629 |
movl var_LATEST,%edi // LATEST word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1630 |
addl $4,%edi // Point to name/flags byte. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1631 |
xorb $F_HIDDEN,(%edi) // Toggle the HIDDEN bit. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1632 |
ret |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1633 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1634 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1635 |
' (TICK) is a standard FORTH word which returns the codeword pointer of the next word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1636 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1637 |
The common usage is: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1638 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1639 |
' FOO , |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1640 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1641 |
which appends the codeword of FOO to the current word we are defining (this only works in compiled code). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1642 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1643 |
You tend to use ' in IMMEDIATE words. For example an alternate (and rather useless) way to define |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1644 |
a literal 2 might be: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1645 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1646 |
: LIT2 IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1647 |
' LIT , \ Appends LIT to the currently-being-defined word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1648 |
2 , \ Appends the number 2 to the currently-being-defined word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1649 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1650 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1651 |
So you could do: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1652 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1653 |
: DOUBLE LIT2 * ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1654 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1655 |
(If you don't understand how LIT2 works, then you should review the material about compiling words |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1656 |
and immediate mode). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1657 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1658 |
This definition of ' uses a cheat which I copied from buzzard92. As a result it only works in |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1659 |
compiled code. It is possible to write a version of ' based on WORD, FIND, >CFA which works in |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1660 |
immediate mode too. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1661 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1662 |
defcode "'",1,,TICK |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1663 |
lodsl // Get the address of the next word and skip it. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1664 |
pushl %eax // Push it on the stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1665 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1666 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1667 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1668 |
BRANCHING ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1669 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1670 |
It turns out that all you need in order to define looping constructs, IF-statements, etc. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1671 |
are two primitives. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1672 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1673 |
BRANCH is an unconditional branch. 0BRANCH is a conditional branch (it only branches if the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1674 |
top of stack is zero). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1675 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1676 |
The diagra below shows how BRANCH works in some imaginary compiled word. When BRANCH executes, |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1677 |
%esi starts by pointing to the offset field (compare to LIT above): |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1678 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1679 |
+---------------------+-------+---- - - ---+------------+------------+---- - - - ----+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1680 |
| (Dictionary header) | DOCOL | | BRANCH | offset | (skipped) | word | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1681 |
+---------------------+-------+---- - - ---+------------+-----|------+---- - - - ----+------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1682 |
^ | ^ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1683 |
| | | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1684 |
| +-----------------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1685 |
%esi added to offset |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1686 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1687 |
The offset is added to %esi to make the new %esi, and the result is that when NEXT runs, execution |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1688 |
continues at the branch target. Negative offsets work as expected. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1689 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1690 |
0BRANCH is the same except the branch happens conditionally. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1691 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1692 |
Now standard FORTH words such as IF, THEN, ELSE, WHILE, REPEAT, etc. can be implemented entirely |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1693 |
in FORTH. They are IMMEDIATE words which append various combinations of BRANCH or 0BRANCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1694 |
into the word currently being compiled. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1695 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1696 |
As an example, code written like this: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1697 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1698 |
condition-code IF true-part THEN rest-code |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1699 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1700 |
compiles to: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1701 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1702 |
condition-code 0BRANCH OFFSET true-part rest-code |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1703 |
| ^ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1704 |
| | |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1705 |
+-------------+ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1706 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1707 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1708 |
defcode "BRANCH",6,,BRANCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1709 |
add (%esi),%esi // add the offset to the instruction pointer |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1710 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1711 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1712 |
defcode "0BRANCH",7,,ZBRANCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1713 |
pop %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1714 |
test %eax,%eax // top of stack is zero? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1715 |
jz code_BRANCH // if so, jump back to the branch function above |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1716 |
lodsl // otherwise we need to skip the offset |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1717 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1718 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1719 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1720 |
PRINTING STRINGS ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1721 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1722 |
LITSTRING and EMITSTRING are primitives used to implement the ." operator (which is |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1723 |
written in FORTH). See the definition of that operator below. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1724 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1725 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1726 |
defcode "LITSTRING",9,,LITSTRING |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1727 |
lodsl // get the length of the string |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1728 |
push %eax // push it on the stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1729 |
push %esi // push the address of the start of the string |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1730 |
addl %eax,%esi // skip past the string |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1731 |
addl $3,%esi // but round up to next 4 byte boundary |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1732 |
andl $~3,%esi |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1733 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1734 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1735 |
defcode "EMITSTRING",10,,EMITSTRING |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1736 |
mov $1,%ebx // 1st param: stdout |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1737 |
pop %ecx // 2nd param: address of string |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1738 |
pop %edx // 3rd param: length of string |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1739 |
mov $__NR_write,%eax // write syscall |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1740 |
int $0x80 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1741 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1742 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1743 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1744 |
COLD START AND INTERPRETER ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1745 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1746 |
COLD is the first FORTH function called, almost immediately after the FORTH system "boots". |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1747 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1748 |
INTERPRETER is the FORTH interpreter ("toploop", "toplevel" or "REPL" might be a more accurate |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1749 |
description -- see: http://en.wikipedia.org/wiki/REPL). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1750 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1751 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1752 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1753 |
// COLD must not return (ie. must not call EXIT). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1754 |
defword "COLD",4,,COLD |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1755 |
.int INTERPRETER // call the interpreter loop (never returns) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1756 |
.int LIT,1,SYSEXIT // hmmm, but in case it does, exit(1). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1757 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1758 |
/* This interpreter is pretty simple, but remember that in FORTH you can always override |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1759 |
* it later with a more powerful one! |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1760 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1761 |
defword "INTERPRETER",11,,INTERPRETER |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1762 |
.int INTERPRET,RDROP,INTERPRETER |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1763 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1764 |
defcode "INTERPRET",9,,INTERPRET |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1765 |
call _WORD // Returns %ecx = length, %edi = pointer to word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1766 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1767 |
// Is it in the dictionary? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1768 |
xor %eax,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1769 |
movl %eax,interpret_is_lit // Not a literal number (not yet anyway ...) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1770 |
call _FIND // Returns %eax = pointer to header or 0 if not found. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1771 |
test %eax,%eax // Found? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1772 |
jz 1f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1773 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1774 |
// In the dictionary. Is it an IMMEDIATE codeword? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1775 |
mov %eax,%edi // %edi = dictionary entry |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1776 |
movb 4(%edi),%al // Get name+flags. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1777 |
push %ax // Just save it for now. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1778 |
call _TCFA // Convert dictionary entry (in %edi) to codeword pointer. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1779 |
pop %ax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1780 |
andb $F_IMMED,%al // Is IMMED flag set? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1781 |
mov %edi,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1782 |
jnz 4f // If IMMED, jump straight to executing. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1783 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1784 |
jmp 2f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1785 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1786 |
1: // Not in the dictionary (not a word) so assume it's a literal number. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1787 |
incl interpret_is_lit |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1788 |
call _SNUMBER // Returns the parsed number in %eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1789 |
mov %eax,%ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1790 |
mov $LIT,%eax // The word is LIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1791 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1792 |
2: // Are we compiling or executing? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1793 |
movl var_STATE,%edx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1794 |
test %edx,%edx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1795 |
jz 4f // Jump if executing. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1796 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1797 |
// Compiling - just append the word to the current dictionary definition. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1798 |
call _COMMA |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1799 |
mov interpret_is_lit,%ecx // Was it a literal? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1800 |
test %ecx,%ecx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1801 |
jz 3f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1802 |
mov %ebx,%eax // Yes, so LIT is followed by a number. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1803 |
call _COMMA |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1804 |
3: NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1805 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1806 |
4: // Executing - run it! |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1807 |
mov interpret_is_lit,%ecx // Literal? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1808 |
test %ecx,%ecx // Literal? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1809 |
jnz 5f |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1810 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1811 |
// Not a literal, execute it now. This never returns, but the codeword will |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1812 |
// eventually call NEXT which will reenter the loop in INTERPRETER. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1813 |
jmp *(%eax) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1814 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1815 |
5: // Executing a literal, which means push it on the stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1816 |
push %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1817 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1818 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1819 |
.data |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1820 |
.align 4 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1821 |
interpret_is_lit: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1822 |
.int 0 // Flag used to record if reading a literal |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1823 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1824 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1825 |
ODDS AND ENDS ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1826 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1827 |
CHAR puts the ASCII code of the first character of the following word on the stack. For example |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1828 |
CHAR A puts 65 on the stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1829 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1830 |
SYSEXIT exits the process using Linux exit syscall. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1831 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1832 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1833 |
defcode "CHAR",4,,CHAR |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1834 |
call _WORD // Returns %ecx = length, %edi = pointer to word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1835 |
xor %eax,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1836 |
movb (%edi),%al // Get the first character of the word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1837 |
push %eax // Push it onto the stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1838 |
NEXT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1839 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1840 |
// NB: SYSEXIT must be the last entry in the built-in dictionary. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1841 |
defcode SYSEXIT,7,,SYSEXIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1842 |
pop %ebx |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1843 |
mov $__NR_exit,%eax |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1844 |
int $0x80 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1845 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1846 |
/* |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1847 |
START OF FORTH CODE ---------------------------------------------------------------------- |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1848 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1849 |
We've now reached the stage where the FORTH system is running and self-hosting. All further |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1850 |
words can be written as FORTH itself, including words like IF, THEN, .", etc which in most |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1851 |
languages would be considered rather fundamental. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1852 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1853 |
As a kind of trick, I prefill the input buffer with the initial FORTH code. Once this code |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1854 |
has run (when we get to the "OK" prompt), this input buffer is reused for reading any further |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1855 |
user input. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1856 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1857 |
Some notes about the code: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1858 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1859 |
\ (backslash) is the FORTH way to start a comment which goes up to the next newline. However |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1860 |
because this is a C-style string, I have to escape the backslash, which is why they appear as |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1861 |
\\ comment. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1862 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1863 |
Similarly, any backslashes in the code are doubled, and " becomes \" (eg. the definition of ." |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1864 |
is written as : .\" ... ;) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1865 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1866 |
I use indenting to show structure. The amount of whitespace has no meaning to FORTH however |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1867 |
except that you must use at least one whitespace character between words, and words themselves |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1868 |
cannot contain whitespace. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1869 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1870 |
FORTH is case-sensitive. Use capslock! |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1871 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1872 |
Enjoy! |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1873 |
*/ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1874 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1875 |
.data |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1876 |
.align 4096 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1877 |
buffer: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1878 |
// Multi-line constant gives 'Warning: unterminated string; newline inserted' messages which you can ignore. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1879 |
.ascii "\ |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1880 |
\\ Define some character constants |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1881 |
: '\\n' 10 ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1882 |
: 'SPACE' 32 ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1883 |
: '\"' 34 ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1884 |
: ':' 58 ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1885 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1886 |
\\ CR prints a carriage return |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1887 |
: CR '\\n' EMIT ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1888 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1889 |
\\ SPACE prints a space |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1890 |
: SPACE 'SPACE' EMIT ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1891 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1892 |
\\ Primitive . (DOT) function doesn't follow with a blank, so redefine it to behave like FORTH. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1893 |
\\ Notice how we can trivially redefine existing functions. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1894 |
: . . SPACE ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1895 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1896 |
\\ DUP, DROP are defined in assembly for speed, but this is how you might define them |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1897 |
\\ in FORTH. Notice use of the scratch variables _X and _Y. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1898 |
\\ : DUP _X ! _X @ _X @ ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1899 |
\\ : DROP _X ! ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1900 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1901 |
\\ The 2... versions of the standard operators work on pairs of stack entries. They're not used |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1902 |
\\ very commonly so not really worth writing in assembler. Here is how they are defined in FORTH. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1903 |
: 2DUP OVER OVER ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1904 |
: 2DROP DROP DROP ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1905 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1906 |
\\ More standard FORTH words. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1907 |
: 2* 2 * ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1908 |
: 2/ 2 / ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1909 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1910 |
\\ [ and ] allow you to break into immediate mode while compiling a word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1911 |
: [ IMMEDIATE \\ define [ as an immediate word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1912 |
0 STATE ! \\ go into immediate mode |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1913 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1914 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1915 |
: ] |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1916 |
1 STATE ! \\ go back to compile mode |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1917 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1918 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1919 |
\\ LITERAL takes whatever is on the stack and compiles LIT <foo> |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1920 |
: LITERAL IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1921 |
' LIT , \\ compile LIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1922 |
, \\ compile the literal itself (from the stack) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1923 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1924 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1925 |
\\ condition IF true-part THEN rest |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1926 |
\\ compiles to: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1927 |
\\ condition 0BRANCH OFFSET true-part rest |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1928 |
\\ where OFFSET is the offset of 'rest' |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1929 |
\\ condition IF true-part ELSE false-part THEN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1930 |
\\ compiles to: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1931 |
\\ condition 0BRANCH OFFSET true-part BRANCH OFFSET2 false-part rest |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1932 |
\\ where OFFSET if the offset of false-part and OFFSET2 is the offset of rest |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1933 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1934 |
\\ IF is an IMMEDIATE word which compiles 0BRANCH followed by a dummy offset, and places |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1935 |
\\ the address of the 0BRANCH on the stack. Later when we see THEN, we pop that address |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1936 |
\\ off the stack, calculate the offset, and back-fill the offset. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1937 |
: IF IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1938 |
' 0BRANCH , \\ compile 0BRANCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1939 |
HERE @ \\ save location of the offset on the stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1940 |
0 , \\ compile a dummy offset |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1941 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1942 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1943 |
: THEN IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1944 |
DUP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1945 |
HERE @ SWAP - \\ calculate the offset from the address saved on the stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1946 |
SWAP ! \\ store the offset in the back-filled location |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1947 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1948 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1949 |
: ELSE IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1950 |
' BRANCH , \\ definite branch to just over the false-part |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1951 |
HERE @ \\ save location of the offset on the stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1952 |
0 , \\ compile a dummy offset |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1953 |
SWAP \\ now back-fill the original (IF) offset |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1954 |
DUP \\ same as for THEN word above |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1955 |
HERE @ SWAP - |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1956 |
SWAP ! |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1957 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1958 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1959 |
\\ BEGIN loop-part condition UNTIL |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1960 |
\\ compiles to: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1961 |
\\ loop-part condition 0BRANCH OFFSET |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1962 |
\\ where OFFSET points back to the loop-part |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1963 |
\\ This is like do { loop-part } while (condition) in the C language |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1964 |
: BEGIN IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1965 |
HERE @ \\ save location on the stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1966 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1967 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1968 |
: UNTIL IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1969 |
' 0BRANCH , \\ compile 0BRANCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1970 |
HERE @ - \\ calculate the offset from the address saved on the stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1971 |
, \\ compile the offset here |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1972 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1973 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1974 |
\\ BEGIN loop-part AGAIN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1975 |
\\ compiles to: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1976 |
\\ loop-part BRANCH OFFSET |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1977 |
\\ where OFFSET points back to the loop-part |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1978 |
\\ In other words, an infinite loop which can only be returned from with EXIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1979 |
: AGAIN IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1980 |
' BRANCH , \\ compile BRANCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1981 |
HERE @ - \\ calculate the offset back |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1982 |
, \\ compile the offset here |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1983 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1984 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1985 |
\\ BEGIN condition WHILE loop-part REPEAT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1986 |
\\ compiles to: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1987 |
\\ condition 0BRANCH OFFSET2 loop-part BRANCH OFFSET |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1988 |
\\ where OFFSET points back to condition (the beginning) and OFFSET2 points to after the whole piece of code |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1989 |
\\ So this is like a while (condition) { loop-part } loop in the C language |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1990 |
: WHILE IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1991 |
' 0BRANCH , \\ compile 0BRANCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1992 |
HERE @ \\ save location of the offset2 on the stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1993 |
0 , \\ compile a dummy offset2 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1994 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1995 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1996 |
: REPEAT IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1997 |
' BRANCH , \\ compile BRANCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1998 |
SWAP \\ get the original offset (from BEGIN) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1999 |
HERE @ - , \\ and compile it after BRANCH |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2000 |
DUP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2001 |
HERE @ SWAP - \\ calculate the offset2 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2002 |
SWAP ! \\ and back-fill it in the original location |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2003 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2004 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2005 |
\\ With the looping constructs, we can now write SPACES, which writes n spaces to stdout. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2006 |
: SPACES |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2007 |
BEGIN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2008 |
SPACE \\ print a space |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2009 |
1- \\ until we count down to 0 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2010 |
DUP 0= |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2011 |
UNTIL |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2012 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2013 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2014 |
\\ .S prints the contents of the stack. Very useful for debugging. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2015 |
: .S |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2016 |
DSP@ \\ get current stack pointer |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2017 |
BEGIN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2018 |
DUP @ . \\ print the stack element |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2019 |
4+ \\ move up |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2020 |
DUP S0 @ 4- = \\ stop when we get to the top |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2021 |
UNTIL |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2022 |
DROP |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2023 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2024 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2025 |
\\ DEPTH returns the depth of the stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2026 |
: DEPTH S0 @ DSP@ - ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2027 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2028 |
\\ .\" is the print string operator in FORTH. Example: .\" Something to print\" |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2029 |
\\ The space after the operator is the ordinary space required between words. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2030 |
\\ This is tricky to define because it has to do different things depending on whether |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2031 |
\\ we are compiling or in immediate mode. (Thus the word is marked IMMEDIATE so it can |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2032 |
\\ detect this and do different things). |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2033 |
\\ In immediate mode we just keep reading characters and printing them until we get to |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2034 |
\\ the next double quote. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2035 |
\\ In compile mode we have the problem of where we're going to store the string (remember |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2036 |
\\ that the input buffer where the string comes from may be overwritten by the time we |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2037 |
\\ come round to running the function). We store the string in the compiled function |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2038 |
\\ like this: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2039 |
\\ ..., LITSTRING, string length, string rounded up to 4 bytes, EMITSTRING, ... |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2040 |
: .\" IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2041 |
STATE @ \\ compiling? |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2042 |
IF |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2043 |
' LITSTRING , \\ compile LITSTRING |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2044 |
HERE @ \\ save the address of the length word on the stack |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2045 |
0 , \\ dummy length - we don't know what it is yet |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2046 |
BEGIN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2047 |
KEY \\ get next character of the string |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2048 |
DUP '\"' <> |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2049 |
WHILE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2050 |
HERE @ !b \\ store the character in the compiled image |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2051 |
1 HERE +! \\ increment HERE pointer by 1 byte |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2052 |
REPEAT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2053 |
DROP \\ drop the double quote character at the end |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2054 |
DUP \\ get the saved address of the length word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2055 |
HERE @ SWAP - \\ calculate the length |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2056 |
4- \\ subtract 4 (because we measured from the start of the length word) |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2057 |
SWAP ! \\ and back-fill the length location |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2058 |
HERE @ \\ round up to next multiple of 4 bytes for the remaining code |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2059 |
3 + |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2060 |
3 INVERT AND |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2061 |
HERE ! |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2062 |
' EMITSTRING , \\ compile the final EMITSTRING |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2063 |
ELSE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2064 |
\\ In immediate mode, just read characters and print them until we get |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2065 |
\\ to the ending double quote. Much simpler than the above code! |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2066 |
BEGIN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2067 |
KEY |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2068 |
DUP '\"' = IF EXIT THEN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2069 |
EMIT |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2070 |
AGAIN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2071 |
THEN |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2072 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2073 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2074 |
\\ While compiling, [COMPILE] WORD compiles WORD if it would otherwise be IMMEDIATE. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2075 |
: [COMPILE] IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2076 |
WORD \\ get the next word |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2077 |
FIND \\ find it in the dictionary |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2078 |
>CFA \\ get its codeword |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2079 |
, \\ and compile that |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2080 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2081 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2082 |
\\ RECURSE makes a recursive call to the current word that is being compiled. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2083 |
\\ Normally while a word is being compiled, it is marked HIDDEN so that references to the |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2084 |
\\ same word within are calls to the previous definition of the word. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2085 |
: RECURSE IMMEDIATE |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2086 |
LATEST @ >CFA \\ LATEST points to the word being compiled at the moment |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2087 |
, \\ compile it |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2088 |
; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2089 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2090 |
\\ ALLOT is used to allocate (static) memory when compiling. It increases HERE by |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2091 |
\\ the amount given on the stack. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2092 |
\\: ALLOT HERE +! ; |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2093 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2094 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2095 |
\\ Finally print the welcome prompt. |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2096 |
.\" JONESFORTH VERSION \" VERSION @ . CR |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2097 |
.\" OK \" |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2098 |
" |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2099 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2100 |
_initbufftop: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2101 |
.align 4096 |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2102 |
buffend: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2103 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2104 |
currkey: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2105 |
.int buffer |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2106 |
bufftop: |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2107 |
.int _initbufftop |
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2108 |
|
608899826a12
jonesforth.S, unmodified
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2109 |
/* END OF jonesforth.S */ |