Menu
▾
▴
Let's share a stack together
Introduction
4tH has several facilities to allow you to share information. You can call 4tH like a function: you pass parameters and it will return an integer (actually, it's a cell. But that's not important right now).
However, some user asked me if he could use 4tH in a scenario where much more data is shared. First and foremost, 4tH is quite sandboxed - by design. It can extend its reach only that far outside its sandbox. However, the C host has no such limitations. It can reach all of 4tH's structures quite easily - but of course, you have to take care not to break anything.
There are two C-macro's that allow you to access 4tH's Character Segment and Integer Segment with ease:
#define MK_CP(a,b) ((a)->CellSeg+STACKSIZ+SYS4TH+((int)b)) #define MK_UP(a,b) ((a)->UnitSeg+((int)b))
The first one take a 4tH pointer and a cells address and will return a conventional C-pointer. The second also takes a 4tH pointer, but this time a strings address and it will return a pointer to unit. They're also used in 4tsh. The latter program may not be as useful as 4th or pp4th in everyday use, but from a developers view it is quite interesting, since it features a stack that is shared between C and 4tH and during the ride, they exchange quite a bit of information.
This is done by a user-stack in 4tH's Integer Segment, so if things really go haywire, the damage is limited. Of course 4tH is using the library calls to communicate with the stack, but things are quite different on the C-side. There are two functions, equivalent to >A and A>:
/* This function puts a value on the 4tH user stack. */ void to_4th (Hcode* Object, cell stack, cell item) { cell *sp = MK_CP (Object, stack); if (*sp < (stack + (USTACKSIZ-1))) *(MK_CP (Object, ++(*sp))) = item; } /* This function gets a value from the 4tH user stack */ cell from_4th (Hcode* Object, cell stack) { cell *sp = MK_CP (Object, stack); return ((*sp > stack) ? *(MK_CP (Object, (*sp)--)) : INT_MIN); }
I think the names speak for themselves. This is the core of the entire interface. Now we've got to make an educational demo program to illustrate the principle. I decided to make two identical Forth-like interpreters, one in 4tH and one in C and let them manage the same stack. They can also transfer control to one another.
The stack
We have to make the stack in 4tH, so let's start there. Simply include the library and define one:
include lib/stack.4th \ for the user stack 128 array stk \ user stack - same as C
That's it, stack defined. The C-interface requires the size of the stack, so let's fix that first:
#define USTACKSIZ 128 /* 4tH user stack size */
At the start of the 4tH program we got to initialize this stack:
: client stk dup stack
What the DUP is doing there I'll tell you later. As you might have noticed, C requires the address of the bottom of the stack. Of course, we could find that one out and hardcode it, but it is much nicer if 4tH tells C what that address it is. You can do that by storing that address in the 4tH OUT variable. This one is returned by the exec_4th() function of the API.
"But hey", you exclaim "That one is returned when the program is done. So what use is it then?" True, but you can actually pause 4tH's execution, return to C and resume later. Simply use PAUSE instead of ABORT or QUIT:
: client stk dup stack out ! pause
Now we got to bring C to start 4tH up. Let's assume for a minute we've already loaded and compiled the 4tH program:
Hcode *object; /* pointer to 4tH applet */ cell stk; stk = exec_4th (object, 0, NULL, 0 );
True. We've got to believe the blue-eyed return value of 4tH. Without some "hand shake" protocol we can't be sure if that value is accurate, but that's not the point here. For all means and purposes the C-program now knows where that user-stack is. Let's move on.
Loading and compiling
In the real world you would embed the 4tH program into the C-program, but here you have to issue it at the command line. Not only is that procedure a lot simpler, it also allows you to change the 4tH program and restart the host without recompiling the whole shebang.
So, how do we go about that? First, we check the arguments and get the filename of the 4tH program:
char *sources; /* pointer to 4tH source */ if (argc == 2) /* 4tH client given on command line? */ { /* open the source file */ if ((sources = open_4th (argv [1])) == NULL) { printf ("Loading; \'%s\' does not exist or too large\n", argv [1]); exit (0); }
If open4th() returns a NULL pointer, it failed - so we report that and quit the program. Nothing else we can do. If we succeed, we can continue with the next step, which is compiling the program:
else { /* now compile the source */ if ((object = comp_4th (sources)) == NULL) exit (0); if (object->ErrNo) /* exit if anything goes wrong */ { printf ("Compile; word %u: %s\n", object->ErrLine, errs_4th [object->ErrNo]); exit (0); } } }
If comp_4th() returns a NULL pointer (very bad - but extremely rare) or if ErrNo is set during compilation, we got a problem. Again, nothing we can do, let's move on. We still got to handle a situation in which the user didn't provide the correct parameters:
else /* you didn't issue a source */ { /* complain and get out */ printf ("Usage: host4th client.4th\n"); exit (0); }
Now we got that one settled, we have a compiled 4tH program and a pointer to it.
The C interpreter
So the interpreter has the following command set:
- . will print the top of the stack (TOS);
- + will add the top two values on the stack and return the result to TOS;
- DROP will delete the TOS;
- DUP will duplicate the TOS;
- PAUSE will transfer control to the 4tH program;
- ID will show you a message, indicating that you're in the C-interpreter;
- DEPTH will place the number of elements, currently on the stack, in TOS;
- QUIT will exit the C-program.
So, quite primitive - but enough to play around with.
Let's start with command loop:
stk = exec_4th (object, 0, NULL, 0 ); C_id (object, stk); printf (" ok\n"); /* trust he gives the right one ;-) */ while (fgets (cmd, 80, stdin) != NULL) { /* now type the commands */ cmd [strlen (cmd) - 1] = '\0'; /* terminate the command line */ token = strtok(cmd, " "); /* tokenize it */ while (token != NULL) /* as long as there's a token */ { /* interpret it */ Interpret (token, object, stk); token = strtok (NULL, " "); } /* get the next token */ printf (" ok\n"); /* display the prompt */ }
We start exactly where we left off: we got our stack-pointer (hopefully), we identify where we are (as we will see later on) and print an "ok" prompt. Then we get an eighty character commandline and start tokenizing it. By convention, every sequence of characters delimited by a space. That's our token. Then we pass it to our interpreter called Interpret() and we get the next token - until there are none left. Then we ask for another commandline - and so on.
Now, what does this interpreter look like? It's a simple thing that works by three simple rules:
- If it's a command, execute it;
- If it's a number, put it on the stack;
- Anything else gets presented on screen with a big, fat question mark behind it.
void Interpret (char *tok, Hcode *obj, cell stk) { cell t; /* simple counter */ /* as long as name != NULL */ for (t = 0; CmdList [t].CName; t++) /* compare the name */ if (! strcmp (CmdList [t].CName, tok)) { /* when found, execute it */ (*(CmdList [t].CFun)) (obj, stk); return; /* you found it, get out */ } /* try to convert it to a number */ if ((t = str2cell (tok, 10)) != CELL_MIN) to_4th (obj, stk, t); else printf ("%s?", tok); /* when this fails, complain */ }
For the number conversion we use 4tH's str2cell() function. It returns CELL_MIN on error. Talking of question marks, this probably is the biggest question mark on your mind:
for (t = 0; CmdList [t].CName; t++) /* compare the name */ if (! strcmp (CmdList [t].CName, tok)) { /* when found, execute it */ (*(CmdList [t].CFun)) (obj, stk); return; /* you found it, get out */ }
May be it becomes a lot clearer when we present the construction this function refers to:
typedef struct { char *CName; /* name of word */ void (*CFun) (Hcode *obj, cell stk); } Command; /* map functions to names */ static const Command CmdList [] = { { ".", C_dot }, { "+", C_plus }, { "drop", C_drop }, { "dup", C_dup }, { "pause", C_pause }, { "id", C_id }, { "depth", C_depth }, { "quit", C_quit }, { NULL, NULL } };
Yes, it's a structure that contains a string and the function that it refers to. So, when we reach the NULL entry on the list, we've actually reached the end of the list. If the string matches, we execute the function - it's as easy as that. Now you're probably curious what these functions look like. As a matter of fact, they're pretty trivial. Take this one, PAUSE:
void C_pause (Hcode *obj, cell stk) /* This is PAUSE */ { (void) exec_4th (obj, 0, NULL, 0 ); /* simply call 4tH */ }
Yeah, we execute 4tH, big surprise.. Ok, take ID:
void C_id (Hcode *obj, cell stk) /* This is ID */ { printf ("Welcome to C!\n"); /* say who you are */ }
Yawn. Another one? Sure:
void C_plus (Hcode *obj, cell stk) /* This is + */ { to_4th (obj, stk, from_4th (obj, stk) + from_4th (obj, stk)); } /* get two values, add 'em and */ /* put the result on the stack */
Here we see our + in action. It takes two values from the stack using from_4th() and puts the addition on the stack using to_4th(). Fortunately, addition is commutive, so it doesn't matter which order the C compiler selects.
And that's about it! Our C-program is done!
The 4tH interpreter
Since 4tH is geared towards interpreters, this will be pretty trivial. And it is - we need barely 1K to make this pig fly. Let's start with the main loop:
: client stk dup stack out ! pause stk.id \ setup user stack and show id begin \ show the prompt and get a command ." OK" cr refill drop \ interpret and issue oops when needed ['] interpret catch if ." Oops " then again \ repeat command loop eternally ;
We've seen parts of this. We initialize the stack, return the stack-pointer and quietly wait until the C-host passes control. Then we identify ourselves, print the prompt, take a line of commands and interpret the whole shebang. Then we do it again. The interpreter is largly built on a library:
[PRAGMA] ignorenumbers \ we handle our numbers ourselves include lib/interprt.4th \ for INTERPRET :noname \ handle numbers 2dup number error? ( a n --) if drop type [char] ? emit space ;then stk >a 2drop ; is NotFound
Why the [PRAGMA]? Well, the library usually takes care of numbers itself - and places them on the datastack. But we won't want that - we want they end up on the user-stack. So we have to interfere and define it ourselves. We try to convert it to a number - and when we fail, we print it on screen with a big, fat question mark. Yeah, you've read that before. Like I said, it's the same interpreter - but in 4tH.
Now we've all settled that, the rest of the interpreter is pretty simple:
: stk. stk a> . ; \ this is DOT : stk+ stk a> stk a> + stk >a ; \ this is PLUS : stk.drop stk a> drop ; \ this is DROP : stk.dup stk a@ stk >a ; \ this is DUP : stk.depth stk adepth stk >a ; \ this is DEPTH : stk.pause pause ; \ this is PAUSE : stk.id ." Welcome to 4tH!" cr ; \ this is ID : stk.quit ." You can't quit. Try 'pause'." cr ; \ map names to words create wordlist ," ." ' stk. , ," +" ' stk+ , ," drop" ' stk.drop , ," dup" ' stk.dup , ," pause" ' stk.pause , ," id" ' stk.id , ," depth" ' stk.depth , ," quit" ' stk.quit , NULL ,
It's a little more compact, but in essence it's the same code we've seen before. BTW, we transfer control by execting PAUSE. Of course, you can't quit, because you can't transfer control back to something that has already died - so we print a little 'hint' instead. All that's left is tell the library where to look:
wordlist to dictionary \ assign wordlist to dictionary
Done! Let's rock 'n roll.
Sample run
Welcome to C! ok 23 45 pause Welcome to 4tH! OK + . 68 OK pause ok depth . 0 ok id Welcome to C! ok pause OK id Welcome to 4tH! OK quit You can't quit. Try 'pause'. OK pause ok quit Bye bye!
- We start off in C (of course);
- We put "23" and "45" on the stack and transfer control to 4tH;
- We add the numbers and display the result;
- Then we transfer control back to C;
- We check how many items there are left on the stack - none;
- To be sure, we identify where we are;
- We transfer control back to 4tH and identify where we are;
- We try to quit - but 4tH won't let us - so we transfer control back to C;
- And there we finally quit.
I hope you found this little experiment useful and entertaining. The sources you'll find below.
Sources
#include <string.h> #include <stdio.h> #include <stdlib.h> #include "4th.h" #include "cmds_4th.h" #define USTACKSIZ 128 /* 4tH user stack size */ /* pointer calculator macros */ #define MK_CP(a,b) ((a)->CellSeg+STACKSIZ+SYS4TH+((int)b)) #define MK_UP(a,b) ((a)->UnitSeg+((int)b)) typedef struct { char *CName; /* name of word */ void (*CFun) (Hcode *obj, cell stk); } Command; /* code of word */ /* This function puts a value on the 4tH user stack. */ void to_4th (Hcode* Object, cell stack, cell item) { cell *sp = MK_CP (Object, stack); if (*sp < (stack + (USTACKSIZ-1))) *(MK_CP (Object, ++(*sp))) = item; } /* This function gets a value from the 4tH user stack */ cell from_4th (Hcode* Object, cell stack) { cell *sp = MK_CP (Object, stack); return ((*sp > stack) ? *(MK_CP (Object, (*sp)--)) : INT_MIN); } /* This is a list of all the words that are supported by the C-version */ void C_depth (Hcode *obj, cell stk) /* This is DEPTH */ { cell *sp = MK_CP (obj, stk); /* This points to the stack pointer */ to_4th (obj, stk, *sp - stk); /* subtract it from base */ } void C_pause (Hcode *obj, cell stk) /* This is PAUSE */ { (void) exec_4th (obj, 0, NULL, 0 ); /* simply call 4tH */ } void C_plus (Hcode *obj, cell stk) /* This is + */ { to_4th (obj, stk, from_4th (obj, stk) + from_4th (obj, stk)); } /* get two values, add 'em and */ /* put the result on the stack */ void C_dup (Hcode *obj, cell stk) /* This is DUP */ { cell t = from_4th (obj, stk); /* get TOS */ to_4th (obj, stk, t); /* put it on the stack TWICE */ to_4th (obj, stk, t); } void C_drop (Hcode *obj, cell stk) /* This is DROP */ { (void) from_4th (obj, stk); /* get a value from the stack */ } void C_dot (Hcode *obj, cell stk) /* This is DOT */ { printf ("%ld ", from_4th (obj, stk)); } /* print the value and a space */ void C_quit (Hcode *obj, cell stk) /* This is QUIT */ { printf ("Bye bye!\n"); exit (0); /* say byebye and quit */ } void C_id (Hcode *obj, cell stk) /* This is ID */ { printf ("Welcome to C!\n"); /* say who you are */ } /* map functions to names */ static const Command CmdList [] = { { ".", C_dot }, { "+", C_plus }, { "drop", C_drop }, { "dup", C_dup }, { "pause", C_pause }, { "id", C_id }, { "depth", C_depth }, { "quit", C_quit }, { NULL, NULL } }; /* interpret a token */ void Interpret (char *tok, Hcode *obj, cell stk) { cell t; /* simple counter */ /* as long as name != NULL */ for (t = 0; CmdList [t].CName; t++) /* compare the name */ if (! strcmp (CmdList [t].CName, tok)) { /* when found, execute it */ (*(CmdList [t].CFun)) (obj, stk); return; /* you found it, get out */ } /* try to convert it to a number */ if ((t = str2cell (tok, 10)) != CELL_MIN) to_4th (obj, stk, t); else printf ("%s?", tok); /* when this fails, complain */ } int main (int argc, char** argv) { char cmd [80]; /* command line storage */ char* token; /* pointer to token */ char *sources; /* pointer to 4tH source */ Hcode *object; /* pointer to 4tH applet */ cell stk; if (argc == 2) /* 4tH client given on command line? */ { /* open the source file */ if ((sources = open_4th (argv [1])) == NULL) { printf ("Loading; \'%s\' does not exist or too large\n", argv [1]); exit (0); } /* complain if you can't open it */ else { /* now compile the source */ if ((object = comp_4th (sources)) == NULL) exit (0); if (object->ErrNo) /* exit if anything goes wrong */ { printf ("Compile; word %u: %s\n", object->ErrLine, errs_4th [object->ErrNo]); exit (0); } } } else /* you didn't issue a source */ { /* complain and get out */ printf ("Usage: host4th client.4th\n"); exit (0); } /* ask 4tH for the stack pointer */ stk = exec_4th (object, 0, NULL, 0 ); C_id (object, stk); printf (" ok\n"); /* trust he gives the right one ;-) */ while (fgets (cmd, 80, stdin) != NULL) { /* now type the commands */ cmd [strlen (cmd) - 1] = '\0'; /* terminate the command line */ token = strtok(cmd, " "); /* tokenize it */ while (token != NULL) /* as long as there's a token */ { /* interpret it */ Interpret (token, object, stk); token = strtok (NULL, " "); } /* get the next token */ printf (" ok\n"); /* display the prompt */ } }
C host program
[PRAGMA] ignorenumbers \ we handle our numbers ourselves include lib/interprt.4th \ for INTERPRET include lib/stack.4th \ for the user stack 128 array stk \ user stack - same as C :noname \ handle numbers 2dup number error? ( a n --) if drop type [char] ? emit space ;then stk >a 2drop ; is NotFound \ try and convert it to a number \ all supported commands : stk. stk a> . ; \ this is DOT : stk+ stk a> stk a> + stk >a ; \ this is PLUS : stk.drop stk a> drop ; \ this is DROP : stk.dup stk a@ stk >a ; \ this is DUP : stk.depth stk adepth stk >a ; \ this is DEPTH : stk.pause pause ; \ this is PAUSE : stk.id ." Welcome to 4tH!" cr ; \ this is ID : stk.quit ." You can't quit. Try 'pause'." cr ; \ map names to words create wordlist ," ." ' stk. , ," +" ' stk+ , ," drop" ' stk.drop , ," dup" ' stk.dup , ," pause" ' stk.pause , ," id" ' stk.id , ," depth" ' stk.depth , ," quit" ' stk.quit , NULL , wordlist to dictionary \ assign wordlist to dictionary \ The interpreter itself : client stk dup stack out ! pause stk.id \ setup user stack and show id begin \ show the prompt and get a command ." OK" cr refill drop \ interpret and issue oops when needed ['] interpret catch if ." Oops " then again \ repeat command loop eternally ; client \ now call the whole shebang
4tH client program