diff --git a/doc/RETRO-Book.md b/doc/RETRO-Book.md index 7219f4b..97916f6 100644 --- a/doc/RETRO-Book.md +++ b/doc/RETRO-Book.md @@ -3681,6 +3681,74 @@ Assuming an Nga built with 524287 cells of memory: The buffers at the end of memory will resize when specific variables related to them are altered. +# Calling Retro from C + +The C implementation of Retro provides several functions for +interacting with code written in Retro. + +## Dictionary + +The dictionary is a linked list, with a pointer to the most +recent entry stored in address 2. + +You can access the fields for each entry using: + + d_link + d_xt + d_class + d_name + +Each takes a dictionary header address (the "dictionary token") +and returns a pointer to the Retro address for the desired data. + +To find a dictionary token, use `d_lookup`. This takes the address +of the dictionary to search (`memory[2]` in most cases) and the +name of the word to find. + +There is also `d_xt_for()` which takes a name and a dictionary +pointer and returns the execution token for the specified word. + +## Strings + +Like C, Retro uses NUL terminated strings. But, since all +addressing is 32-bit (or 64-bit, depending on your configuration), +some conversion is needed. + +To get a C version of a string, use `string_extract()`. This takes +a Retro address and returns a pointer to a C string. + +Example: + + // Get the name of the most recently defined word + string_extract(d_name(memory[2])); + +To push a C string into Retro memory, use `string_inject()`. This +takes a C string and a Retro address. + + // Copy a string to the TIB buffer + string_inject("hello", 1024); + +## Stack + +You can push values to the stack with `stack_push()` and pop them +off with `stack_pop()`. + +## Interacting + +If you have a word named `hello` that you wish to run: + + execute(d_xt_for("hello", memory[2])); + +If you want to evaluate a token as if it was typed into a Retro +listener: + + string_inject("token", 1024); + stack_push(1024); + execute("interpret", memory[2]); + +The `interpret` word handles things like prefixes, so this is +needed if you want to run something that needs those. + # Historical Papers and Notes ## On the Naming of RETRO diff --git a/doc/book/internals/calling-retro-from-c b/doc/book/internals/calling-retro-from-c new file mode 100644 index 0000000..3389131 --- /dev/null +++ b/doc/book/internals/calling-retro-from-c @@ -0,0 +1,67 @@ +# Calling Retro from C + +The C implementation of Retro provides several functions for +interacting with code written in Retro. + +## Dictionary + +The dictionary is a linked list, with a pointer to the most +recent entry stored in address 2. + +You can access the fields for each entry using: + + d_link + d_xt + d_class + d_name + +Each takes a dictionary header address (the "dictionary token") +and returns a pointer to the Retro address for the desired data. + +To find a dictionary token, use `d_lookup`. This takes the address +of the dictionary to search (`memory[2]` in most cases) and the +name of the word to find. + +There is also `d_xt_for()` which takes a name and a dictionary +pointer and returns the execution token for the specified word. + +## Strings + +Like C, Retro uses NUL terminated strings. But, since all +addressing is 32-bit (or 64-bit, depending on your configuration), +some conversion is needed. + +To get a C version of a string, use `string_extract()`. This takes +a Retro address and returns a pointer to a C string. + +Example: + + // Get the name of the most recently defined word + string_extract(d_name(memory[2])); + +To push a C string into Retro memory, use `string_inject()`. This +takes a C string and a Retro address. + + // Copy a string to the TIB buffer + string_inject("hello", 1024); + +## Stack + +You can push values to the stack with `stack_push()` and pop them +off with `stack_pop()`. + +## Interacting + +If you have a word named `hello` that you wish to run: + + execute(d_xt_for("hello", memory[2])); + +If you want to evaluate a token as if it was typed into a Retro +listener: + + string_inject("token", 1024); + stack_push(1024); + execute("interpret", memory[2]); + +The `interpret` word handles things like prefixes, so this is +needed if you want to run something that needs those. diff --git a/doc/html/chapters/internals/calling-retro-from-c.html b/doc/html/chapters/internals/calling-retro-from-c.html new file mode 100644 index 0000000..5ab955c --- /dev/null +++ b/doc/html/chapters/internals/calling-retro-from-c.html @@ -0,0 +1,114 @@ + + + +. + + +

Calling Retro from C +

+The C implementation of Retro provides several functions for +interacting with code written in Retro. +

+Dictionary +

+The dictionary is a linked list, with a pointer to the most +recent entry stored in address 2. +

+You can access the fields for each entry using: +

+d_link +d_xt +d_class +d_name +

+Each takes a dictionary header address (the "dictionary token") +and returns a pointer to the Retro address for the desired data. +

+To find a dictionary token, use d_lookup. This takes the address +of the dictionary to search (memory[2] in most cases) and the +name of the word to find. +

+There is also d_xt_for() which takes a name and a dictionary +pointer and returns the execution token for the specified word. +

+Strings +

+Like C, Retro uses NUL terminated strings. But, since all +addressing is 32-bit (or 64-bit, depending on your configuration), +some conversion is needed. +

+To get a C version of a string, use string_extract(). This takes +a Retro address and returns a pointer to a C string. +

+Example: +

+// Get the name of the most recently defined word +string_extract(d_name(memory[2])); +

+To push a C string into Retro memory, use string_inject(). This +takes a C string and a Retro address. +

+// Copy a string to the TIB buffer +string_inject("hello", 1024); +

+Stack +

+You can push values to the stack with stack_push() and pop them +off with stack_pop(). +

+Interacting +

+If you have a word named hello that you wish to run: +

+execute(d_xt_for("hello", memory[2])); +

+If you want to evaluate a token as if it was typed into a Retro +listener: +

+string_inject("token", 1024); +stack_push(1024); +execute("interpret", memory[2]); +

+The interpret word handles things like prefixes, so this is +needed if you want to run something that needs those. +

+ diff --git a/doc/html/index.html b/doc/html/index.html index a01b93a..8253dfb 100644 --- a/doc/html/index.html +++ b/doc/html/index.html @@ -1 +1 @@ - Retro Forth: Manual

Retro Forth

Introduction
Obtaining RETRO
Building on Unix
Building on Windows
Building Alternative Implementations
Advanced and Custom Builds
Starting RETRO
Basic User Interactions
Literate Source With Unu
Markdown
A Quick Tutorial
Syntax
Toolchain: Additional Tools
Toolchain: retro-compiler
Manpage: retro(1)
Manpage: retro-describe(1)
Manpage: retro-document(1)
Manpage: retro-embedimage(1)
Manpage: retro-extend(1)
Manpage: retro-locate(1)
Manpage: retro-muri(1)
Manpage: retro-tags(1)
Naming Conventions
The Return Stack
Stack Diagrams
Arrays
Assembly
Buffer
Characters
Defining Words
The Dictionary
Floating Point
Working With Files
Loops
Numbers
Pointers
Quotes
Sockets
Scripting
Strings
Using Combinators
Word Classes
Checking the Version
Errors
Lexical Scope
The Stacks
The Nga Virtual Machine
Interface Layers
Basic I/O
Detailed I/O
Image
Historical Papers
Metacompiling
Self-Hosting
Prefixes
Kernel Words
Ngaro to Nga
RETRO11 Retrospective
Security
Underscores in Names
Code It Yourself Manifesto
Deprecation Policy
Copyrights
\ No newline at end of file + Retro Forth: Manual

Retro Forth

Introduction
Obtaining RETRO
Building on Unix
Building on Windows
Building Alternative Implementations
Advanced and Custom Builds
Starting RETRO
Basic User Interactions
Literate Source With Unu
Markdown
A Quick Tutorial
Syntax
Toolchain: Additional Tools
Toolchain: retro-compiler
Manpage: retro(1)
Manpage: retro-describe(1)
Manpage: retro-document(1)
Manpage: retro-embedimage(1)
Manpage: retro-extend(1)
Manpage: retro-locate(1)
Manpage: retro-muri(1)
Manpage: retro-tags(1)
Naming Conventions
The Return Stack
Stack Diagrams
Arrays
Assembly
Buffer
Characters
Defining Words
The Dictionary
Floating Point
Working With Files
Loops
Numbers
Pointers
Quotes
Sockets
Scripting
Strings
Using Combinators
Word Classes
Checking the Version
Errors
Lexical Scope
The Stacks
The Nga Virtual Machine
Interface Layers
Basic I/O
Detailed I/O
Image
Calling Retro From C
Historical Papers
Metacompiling
Self-Hosting
Prefixes
Kernel Words
Ngaro to Nga
RETRO11 Retrospective
Security
Underscores in Names
Code It Yourself Manifesto
Deprecation Policy
Copyrights
\ No newline at end of file diff --git a/example/calling-retro-from-c.c b/example/calling-retro-from-c.c new file mode 100644 index 0000000..d17ce54 --- /dev/null +++ b/example/calling-retro-from-c.c @@ -0,0 +1,444 @@ +/* + * This demonstrates calling RETRO code from C. + * + * Assuming this is named `demo.c`: + * + * (1) Prepare a demo image: + * + * cp ngaImage demoImage + * retro-extend demoImage demo.c + * + * (2) Build: + * + * make demo + * + * (3) Run: + * + * ./demo + * + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * The next few lines will be compiled into demoImage + * when the `retro-extend` line is run from step 1. + * +~~~ +:average (...n-m) [ [ + ] times ] sip / ; +:hello 'hello_world! s:put nl ; +~~~ + * + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + */ + +#define CELL int32_t +#define IMAGE_SIZE 242000 +#define STACK_DEPTH 256 +#define NUM_DEVICES 2 + +#include +#include +#include +#include + +#define TIB 1025 /* Location of TIB */ + +#define D_OFFSET_LINK 0 /* Dictionary Format Info. Update if */ +#define D_OFFSET_XT 1 /* you change the dictionary fields. */ +#define D_OFFSET_CLASS 2 +#define D_OFFSET_NAME 3 + +CELL sp, rp, ip; +CELL data[STACK_DEPTH]; +CELL address[STACK_DEPTH]; +CELL memory[IMAGE_SIZE + 1]; +void ngaLoadImage(); +void ngaPrepare(); +void ngaProcessOpcode(CELL opcode); +void ngaProcessPackedOpcodes(CELL opcode); +int ngaValidatePackedOpcodes(CELL opcode); + +char string_data[8192]; + +/*--------------------------------------------------------------------- + Strings are next. RETRO uses C-style NULL terminated strings. So I + can easily inject or extract a string. Injection iterates over the + string, copying it into the image. This also takes care to ensure + that the NULL terminator is added. + ---------------------------------------------------------------------*/ + +CELL string_inject(char *str, CELL buffer) { + CELL m, i; + if (!str) { + memory[buffer] = 0; + return 0; + } + m = strlen(str); + i = 0; + while (m > 0) { + memory[buffer + i] = (CELL)str[i]; + memory[buffer + i + 1] = 0; + m--; i++; + } + return buffer; +} + + +/*--------------------------------------------------------------------- + Extracting a string is similar, but I have to iterate over the VM + memory instead of a C string and copy the charaters into a buffer. + This uses a static buffer (`string_data`) as I prefer to avoid using + `malloc()`. + ---------------------------------------------------------------------*/ + +char *string_extract(CELL at) { + CELL starting = at; + CELL i = 0; + while(memory[starting] && i < 8192) + string_data[i++] = (char)memory[starting++]; + string_data[i] = 0; + return (char *)string_data; +} + + +/*--------------------------------------------------------------------- + Continuing along, I now define functions to access the dictionary. + + RETRO's dictionary is a linked list. Each entry is setup like: + + 0000 Link to previous entry (NULL if this is the root entry) + 0001 Pointer to definition start + 0002 Pointer to class handler + 0003 Start of a NULL terminated string with the word name + + First, functions to access each field. The offsets were defineed at + the start of the file. + ---------------------------------------------------------------------*/ + +CELL d_link(CELL dt) { + return dt + D_OFFSET_LINK; +} + +CELL d_xt(CELL dt) { + return dt + D_OFFSET_XT; +} + +CELL d_class(CELL dt) { + return dt + D_OFFSET_CLASS; +} + +CELL d_name(CELL dt) { + return dt + D_OFFSET_NAME; +} + + +/*--------------------------------------------------------------------- + Next, a more complext word. This will walk through the entries to + find one with a name that matches the specified name. This is *slow*, + but works ok unless you have a really large dictionary. (I've not + run into issues with this in practice). + ---------------------------------------------------------------------*/ + +CELL d_lookup(CELL Dictionary, char *name) { + CELL dt = 0; + CELL i = Dictionary; + char *dname; + while (memory[i] != 0 && i != 0) { + dname = string_extract(d_name(i)); + if (strcmp(dname, name) == 0) { + dt = i; + i = 0; + } else { + i = memory[i]; + } + } + return dt; +} + + +/*--------------------------------------------------------------------- + My last dictionary related word returns the `xt` pointer for a word. + This is used to help keep various important bits up to date. + ---------------------------------------------------------------------*/ + +CELL d_xt_for(char *Name, CELL Dictionary) { + return memory[d_xt(d_lookup(Dictionary, Name))]; +} + + +CELL stack_pop() { + sp--; + return data[sp + 1]; +} + +void stack_push(CELL value) { + sp++; + data[sp] = value; +} + +void output() { + putc(stack_pop(), stdout); +} + +void output_query() { + stack_push(0); + stack_push(0); +} + +void input() { + stack_push(getc(stdin)); + if (data[sp] == 127) data[sp] = 8; +} + +void input_query() { + stack_push(0); + stack_push(1); +} + +void execute(CELL cell) { + rp = 1; + ip = cell; + while (ip < IMAGE_SIZE) { + if (ngaValidatePackedOpcodes(memory[ip]) != 0) { + ngaProcessPackedOpcodes(memory[ip]); + } else { + printf("Invalid instruction!\n"); + exit(1); + } + ip++; + if (rp == 0) + ip = IMAGE_SIZE; + } +} + +int main(int argc, char **argv) { + ngaPrepare(); + ngaLoadImage("demoImage"); + execute(d_xt_for("hello", memory[2])); +} + +typedef void (*Handler)(void); +Handler IO_deviceHandlers[] = { output, input }; +Handler IO_queryHandlers[] = { output_query, input_query }; + +void ngaLoadImage(char *imageFile) { + FILE *fp; + CELL i; + long fileLen; + if ((fp = fopen(imageFile, "rb")) != NULL) { + fseek(fp, 0, SEEK_END); + fileLen = ftell(fp) / sizeof(CELL); + rewind(fp); + fread(&memory, sizeof(CELL), fileLen, fp); + fclose(fp); + } +} + +void ngaPrepare() { + for (ip = 0; ip < IMAGE_SIZE; ip++) + memory[ip] = 0; + for (ip = 0; ip < STACK_DEPTH; ip++) + data[ip] = address[ip] = 0; + ip = sp = rp = 0; +} + +void inst_nop() { +} + +void inst_lit() { + ip++; + stack_push(memory[ip]); +} + +void inst_dup() { + sp++; + data[sp] = data[sp-1]; +} + +void inst_drop() { + data[sp] = 0; + sp--; +} + +void inst_swap() { + CELL a; + a = data[sp]; + data[sp] = data[sp-1]; + data[sp-1] = a; +} + +void inst_push() { + rp++; + address[rp] = stack_pop(); +} + +void inst_pop() { + stack_push(address[rp]); + rp--; +} + +void inst_jump() { + ip = stack_pop() - 1; +} + +void inst_call() { + rp++; + address[rp] = ip; + ip = stack_pop() - 1; +} + +void inst_ccall() { + if (data[sp-1] != 0) { + rp++; + address[rp] = ip; + ip = data[sp] - 1; + } + sp -= 2; +} + +void inst_return() { + ip = address[rp]; + rp--; +} + +void inst_eq() { + data[sp-1] = (data[sp-1] == data[sp]) ? -1 : 0; + inst_drop(); +} + +void inst_neq() { + data[sp-1] = (data[sp-1] != data[sp]) ? -1 : 0; + inst_drop(); +} + +void inst_lt() { + data[sp-1] = (data[sp-1] < data[sp]) ? -1 : 0; + inst_drop(); +} + +void inst_gt() { + data[sp-1] = (data[sp-1] > data[sp]) ? -1 : 0; + inst_drop(); +} + +void inst_fetch() { + switch (data[sp]) { + case -1: data[sp] = sp - 1; break; + case -2: data[sp] = rp; break; + case -3: data[sp] = IMAGE_SIZE; break; + default: data[sp] = memory[data[sp]]; break; + } +} + +void inst_store() { + memory[data[sp]] = data[sp-1]; + sp -= 2; +} + +void inst_add() { + data[sp-1] += data[sp]; + inst_drop(); +} + +void inst_sub() { + data[sp-1] -= data[sp]; + inst_drop(); +} + +void inst_mul() { + data[sp-1] *= data[sp]; + inst_drop(); +} + +void inst_divmod() { + CELL a, b; + a = data[sp]; + b = data[sp-1]; + data[sp] = b / a; + data[sp-1] = b % a; +} + +void inst_and() { + data[sp-1] = data[sp] & data[sp-1]; + inst_drop(); +} + +void inst_or() { + data[sp-1] = data[sp] | data[sp-1]; + inst_drop(); +} + +void inst_xor() { + data[sp-1] = data[sp] ^ data[sp-1]; + inst_drop(); +} + +void inst_shift() { + CELL y = data[sp]; + CELL x = data[sp-1]; + if (data[sp] < 0) + data[sp-1] = data[sp-1] << (data[sp] * -1); + else { + if (x < 0 && y > 0) + data[sp-1] = x >> y | ~(~0U >> y); + else + data[sp-1] = x >> y; + } + inst_drop(); +} + +void inst_zret() { + if (data[sp] == 0) { + inst_drop(); + ip = address[rp]; + rp--; + } +} + +void inst_end() { + ip = IMAGE_SIZE; +} + +void inst_ie() { + stack_push(NUM_DEVICES); +} + +void inst_iq() { + IO_queryHandlers[data[sp--]](); +} + +void inst_ii() { + IO_deviceHandlers[data[sp--]](); +} + +Handler instructions[] = { + inst_nop, inst_lit, inst_dup, inst_drop, inst_swap, inst_push, inst_pop, + inst_jump, inst_call, inst_ccall, inst_return, inst_eq, inst_neq, inst_lt, + inst_gt, inst_fetch, inst_store, inst_add, inst_sub, inst_mul, inst_divmod, + inst_and, inst_or, inst_xor, inst_shift, inst_zret, inst_end, inst_ie, + inst_iq, inst_ii +}; + +void ngaProcessOpcode(CELL opcode) { + if (opcode != 0) + instructions[opcode](); +} + +int ngaValidatePackedOpcodes(CELL opcode) { + CELL raw = opcode; + CELL current; + int valid = -1; + for (int i = 0; i < 4; i++) { + current = raw & 0xFF; + if (!(current >= 0 && current <= 29)) + valid = 0; + raw = raw >> 8; + } + return valid; +} + +void ngaProcessPackedOpcodes(CELL opcode) { + CELL raw = opcode; + for (int i = 0; i < 4; i++) { + ngaProcessOpcode(raw & 0xFF); + raw = raw >> 8; + } +} diff --git a/tools/book-chapters.retro b/tools/book-chapters.retro index a4fcd5c..33973fb 100755 --- a/tools/book-chapters.retro +++ b/tools/book-chapters.retro @@ -52,6 +52,7 @@ This contains the list of files for the chapters in the book. { 'Basic_I/O 'internals/io } { 'Detailed_I/O 'internals/io-devices } { 'Image 'internals/image } + { 'Calling_Retro_From_C 'internals/calling-retro-from-c } { 'Historical_Papers 'tech-notes/historical-papers } { 'Metacompiling 'tech-notes/metacompilation } { 'Self-Hosting 'tech-notes/self-hosting }