diff --git a/.gitignore b/.gitignore index 731548c..a69cdbc 100644 --- a/.gitignore +++ b/.gitignore @@ -6,8 +6,6 @@ round-*.html next-round run-tanks -forf.c -forf.h designer.cgi forf.html diff --git a/forf.c b/forf.c new file mode 100644 index 0000000..71a5cad --- /dev/null +++ b/forf.c @@ -0,0 +1,753 @@ +/* forf: a crappy Forth implementation + * Copyright (C) 2010 Adam Glasgall + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +/* Notes + * ------------------------------------------------------- + * + * This is intended to be implemented as a library. As such, it doesn't + * use the libc memory allocation functions. This may be a different + * programming style than you're used to. + * + * There are two data types: numbers and stacks. Because we can't + * allocate memory, stacks are implemented with begin and end markers + * and not new stack types. + */ + +#include +#include +#include + +#include "forf.h" +#include "dump.h" + +#ifndef max +#define max(a,b) (((a) > (b)) ? (a) : (b)) +#define min(a,b) (((a) < (b)) ? (a) : (b)) +#endif + +char *forf_error_str[] = { + "None", + "Runtime", + "Parse", + "Underflow", + "Overflow", + "Type", + "No such procedure", + "Divide by zero", +}; + +/* + * + * Memory manipulation + * + */ +void +forf_memory_init(struct forf_memory *m, + long *values, + size_t size) +{ + m->mem = values; + m->size = size; +} + + +/* + * + * Stack manipulation + * + */ + +void +forf_stack_init(struct forf_stack *s, + struct forf_value *values, + size_t size) +{ + s->stack = values; + s->size = size; + s->top = 0; +} + +void +forf_stack_reset(struct forf_stack *s) +{ + s->top = 0; +} + +size_t +forf_stack_len(struct forf_stack *s) +{ + return s->top; +} + +int +forf_stack_push(struct forf_stack *s, struct forf_value *v) +{ + if (s->top == s->size) { + return 0; + } + s->stack[(s->top)++] = *v; + return 1; +} + +int +forf_stack_pop(struct forf_stack *s, struct forf_value *v) +{ + if (0 == s->top) { + return 0; + } + *v = s->stack[--(s->top)]; + return 1; +} + +void +forf_stack_copy(struct forf_stack *dst, struct forf_stack *src) +{ + int top = min(dst->size, src->top); + + dst->top = top; + memcpy(dst->stack, src->stack, sizeof(*dst->stack) * top); +} + + +void +forf_stack_reverse(struct forf_stack *s) +{ + struct forf_value val; + size_t pos; + + for (pos = 0; pos < (s->top)/2; pos += 1) { + size_t qos = s->top - pos - 1; + + val = s->stack[pos]; + s->stack[pos] = s->stack[qos]; + s->stack[qos] = val; + } +} + +long +forf_pop_num(struct forf_env *env) +{ + struct forf_value val; + + if (! forf_stack_pop(env->data, &val)) { + env->error = forf_error_underflow; + return 0; + } + if (forf_type_number != val.type) { + forf_stack_push(env->data, &val); + env->error = forf_error_type; + return 0; + } + return val.v.i; +} + +void +forf_push_num(struct forf_env *env, long i) +{ + struct forf_value val; + + val.type = forf_type_number; + val.v.i = i; + if (! forf_stack_push(env->data, &val)) { + env->error = forf_error_overflow; + } +} + + +/* Pop an entire stack + * + * DANGER WILL ROBINSON + * + * This returned stack points to values on the data stack. You must be + * finished with this stack before you push anything onto the data + * stack, otherwise your returned stack will be corrupted. + */ +struct forf_stack +forf_pop_stack(struct forf_env *env) +{ + struct forf_stack s = { 0, 0, NULL }; + struct forf_value val; + size_t depth = 1; + + if (! forf_stack_pop(env->data, &val)) { + env->error = forf_error_underflow; + return s; + } + if (forf_type_stack_end != val.type) { + forf_stack_push(env->data, &val); + env->error = forf_error_type; + return s; + } + /* Duplicate just the stack onto s. Begin with -1 to account for the + end of list marker. */ + s.size = -1; + while (depth) { + s.size += 1; + if (! forf_stack_pop(env->data, &val)) { + /* You should never underflow here, there should at least be a + stack begin marker. */ + env->error = forf_error_runtime; + s.size = 0; + return s; + } + switch (val.type) { + case forf_type_stack_end: + depth += 1; + break; + case forf_type_stack_begin: + depth -= 1; + break; + default: + break; + } + } + s.top = s.size; + s.stack = (env->data->stack) + (env->data->top + 1); + return s; +} + +/* Push an entire stack onto another stack. + */ +int +forf_push_stack(struct forf_stack *dst, struct forf_stack *src) +{ + struct forf_value val; + + while (forf_stack_pop(src, &val)) { + if (! forf_stack_push(dst, &val)) { + return 0; + } + } + return 1; +} + +/* Push an entire stack onto the command stack. + * + * This is meant to work with the return value from forf_pop_stack. + */ +int +forf_push_to_command_stack(struct forf_env *env, struct forf_stack *src) +{ + if (! forf_push_stack(env->command, src)) { + env->error = forf_error_overflow; + return 0; + } + return 1; +} + +/* Move one value from src to dst. Note that one value could mean a + * whole substack, in which case dst gets the stack in reverse! dst can + * also be NULL, in which case a value is just discarded. + * + * Because of the reversing thing, it's important to make sure that the + * data stack is either src or dst. This way, the data stack will + * always have "reversed" substacks, and everything else will have them + * in the right order. + */ +int +forf_stack_move_value(struct forf_env *env, + struct forf_stack *dst, + struct forf_stack *src) +{ + struct forf_value val; + size_t depth = 0; + + do { + /* Pop from src */ + if (! forf_stack_pop(env->command, &val)) { + env->error = forf_error_underflow; + return 0; + } + + /* Push to dst (or discard if dst is NULL) */ + if (dst) { + if (! forf_stack_push(env->data, &val)) { + env->error = forf_error_overflow; + return 0; + } + } + + /* Deal with it being a substack marker */ + switch (val.type) { + case forf_type_stack_begin: + depth += 1; + break; + case forf_type_stack_end: + depth -= 1; + break; + default: + break; + } + } while (depth > 0); + + return 1; + +} + + +/* + * + * Procedures + * + */ + +#define unproc(name, op) \ + static void \ + forf_proc_ ## name(struct forf_env *env) \ + { \ + long a = forf_pop_num(env); \ + \ + forf_push_num(env, op a); \ + } + +unproc(inv, ~) +unproc(not, !) + +#define binproc(name, op) \ + static void \ + forf_proc_ ## name(struct forf_env *env) \ + { \ + long a = forf_pop_num(env); \ + long b = forf_pop_num(env); \ + \ + forf_push_num(env, b op a); \ + } + +binproc(add, +) +binproc(sub, -) +binproc(mul, *) +binproc(and, &) +binproc(or, |) +binproc(xor, ^) +binproc(lshift, <<) +binproc(rshift, >>) +binproc(gt, >) +binproc(ge, >=) +binproc(lt, <) +binproc(le, <=) +binproc(eq, ==) +binproc(ne, !=) + +static void +forf_proc_div(struct forf_env *env) +{ + long a = forf_pop_num(env); + long b = forf_pop_num(env); + + if (0 == a) { + env->error = forf_error_divzero; + return; + } + forf_push_num(env, b / a); +} + +static void +forf_proc_mod(struct forf_env *env) +{ + long a = forf_pop_num(env); + long b = forf_pop_num(env); + + if (0 == a) { + env->error = forf_error_divzero; + return; + } + forf_push_num(env, b % a); +} + +static void +forf_proc_abs(struct forf_env *env) +{ + forf_push_num(env, abs(forf_pop_num(env))); +} + +static void +forf_proc_dup(struct forf_env *env) +{ + long a = forf_pop_num(env); + + forf_push_num(env, a); + forf_push_num(env, a); +} + +static void +forf_proc_pop(struct forf_env *env) +{ + forf_pop_num(env); +} + +static void +forf_proc_exch(struct forf_env *env) +{ + long a = forf_pop_num(env); + long b = forf_pop_num(env); + + forf_push_num(env, a); + forf_push_num(env, b); +} + +static void +forf_proc_if(struct forf_env *env) +{ + struct forf_stack ifclause = forf_pop_stack(env); + long cond = forf_pop_num(env); + + if (cond) { + forf_push_to_command_stack(env, &ifclause); + } +} + +static void +forf_proc_ifelse(struct forf_env *env) +{ + struct forf_stack elseclause = forf_pop_stack(env); + struct forf_stack ifclause = forf_pop_stack(env); + long cond = forf_pop_num(env); + + if (cond) { + forf_push_to_command_stack(env, &ifclause); + } else { + forf_push_to_command_stack(env, &elseclause); + } +} + +static void +forf_proc_memset(struct forf_env *env) +{ + long pos = forf_pop_num(env); + long a = forf_pop_num(env); + + if (pos >= env->memory->size) { + env->error = forf_error_overflow; + return; + } + + env->memory->mem[pos] = a; +} + +static void +forf_proc_memget(struct forf_env *env) +{ + long pos = forf_pop_num(env); + + if (pos >= env->memory->size) { + env->error = forf_error_overflow; + return; + } + + forf_push_num(env, env->memory->mem[pos]); +} + +/* + * + * Lexical environment + * + */ +struct forf_lexical_env forf_base_lexical_env[] = { + {"~", forf_proc_inv}, + {"!", forf_proc_not}, + {"+", forf_proc_add}, + {"-", forf_proc_sub}, + {"*", forf_proc_mul}, + {"/", forf_proc_div}, + {"%", forf_proc_mod}, + {"&", forf_proc_and}, + {"|", forf_proc_or}, + {"^", forf_proc_xor}, + {"<<", forf_proc_lshift}, + {">>", forf_proc_rshift}, + {">", forf_proc_gt}, + {">=", forf_proc_ge}, + {"<", forf_proc_lt}, + {"<=", forf_proc_le}, + {"=", forf_proc_eq}, + {"<>", forf_proc_ne}, + {"abs", forf_proc_abs}, + {"dup", forf_proc_dup}, + {"pop", forf_proc_pop}, + {"exch", forf_proc_exch}, + {"if", forf_proc_if}, + {"ifelse", forf_proc_ifelse}, + {"mset", forf_proc_memset}, + {"mget", forf_proc_memget}, + {NULL, NULL} +}; + +/** Extend a lexical environment */ +int +forf_extend_lexical_env(struct forf_lexical_env *dest, + struct forf_lexical_env *src, + size_t size) +{ + int base, i; + + for (base = 0; dest[base].name; base += 1); + for (i = 0; (base+i < size) && (src[i].name); i += 1) { + dest[base+i] = src[i]; + } + if (base + i == size) { + /* Not enough room */ + return 0; + } + dest[base+i].name = NULL; + dest[base+i].proc = NULL; + return 1; +} + + +/* + * + * Parsing + * + */ +static int +forf_push_token(struct forf_env *env, char *token, size_t tokenlen) +{ + long i; + char s[MAX_TOKEN_LEN + 1]; + char *endptr; + struct forf_value val; + + /* Zero-length token yields int:0 from strtol */ + + /* NUL-terminate it */ + memcpy(s, token, tokenlen); + s[tokenlen] = '\0'; + + /* Try to make in an integer */ + i = strtol(s, &endptr, 0); + if ('\0' == *endptr) { + /* Was an int */ + val.type = forf_type_number; + val.v.i = i; + } else { + /* If not an int, a procedure name */ + val.type = forf_type_proc; + for (i = 0; NULL != env->lenv[i].name; i += 1) { + if (0 == strcmp(s, env->lenv[i].name)) { + val.v.p = env->lenv[i].proc; + break; + } + } + if (NULL == env->lenv[i].name) { + env->error = forf_error_noproc; + return 0; + } + } + + if (! forf_stack_push(env->command, &val)) { + env->error = forf_error_overflow; + return 0; + } + + return 1; +} + +/* Parse an input stream onto the command stack */ +int +forf_parse_stream(struct forf_env *env, + forf_getch_func *getch, + void *datum) +{ + int running = 1; + long pos = 0; + char token[MAX_TOKEN_LEN]; + size_t tokenlen = 0; + struct forf_value val; + size_t stack_depth = 0; + int comment = 0; + +#define _tokenize() \ + do { \ + if (tokenlen) { \ + if (! forf_push_token(env, token, tokenlen)) return pos; \ + tokenlen = 0; \ + } \ + } while (0) + + while (running) { + int c; + + c = getch(datum); + pos += 1; + + /* Handle comments */ + if (comment) { + if (')' == c) { + comment = 0; + } + continue; + } + + switch (c) { + case EOF: + running = 0; + break; + case '(': + comment = 1; + break; + case ' ': + case '\f': + case '\n': + case '\r': + case '\t': + case '\v': + _tokenize(); + break; + case '{': + _tokenize(); + val.type = forf_type_stack_begin; + if (! forf_stack_push(env->command, &val)) { + env->error = forf_error_overflow; + return pos; + } + stack_depth += 1; + break; + case '}': + _tokenize(); + val.type = forf_type_stack_end; + if (! forf_stack_push(env->command, &val)) { + env->error = forf_error_overflow; + return pos; + } + stack_depth -= 1; + break; + default: + if (tokenlen < sizeof(token)) { + token[tokenlen++] = c; + } + break; + } + } + _tokenize(); + + if (0 != stack_depth) { + env->error = forf_error_parse; + return pos; + } + + // The first thing we read should be the first thing we do + forf_stack_reverse(env->command); + + return 0; +} + +struct forf_char_stream { + char *buf; + size_t len; + size_t pos; +}; + +static int +forf_string_getch(struct forf_char_stream *stream) +{ + if (stream->pos >= stream->len) { + return EOF; + } + return stream->buf[stream->pos++]; +} + +int +forf_parse_buffer(struct forf_env *env, + char *buf, + size_t len) +{ + struct forf_char_stream stream; + + stream.buf = buf; + stream.len = len; + stream.pos = 0; + + return forf_parse_stream(env, (forf_getch_func *)forf_string_getch, &stream); +} + +int +forf_parse_string(struct forf_env *env, + char *str) +{ + return forf_parse_buffer(env, str, strlen(str)); +} + +int +forf_parse_file(struct forf_env *env, + FILE *f) +{ + return forf_parse_stream(env, (forf_getch_func *)fgetc, f); +} + + +/* + * + * Forf environment + * + */ + +void +forf_env_init(struct forf_env *env, + struct forf_lexical_env *lenv, + struct forf_stack *data, + struct forf_stack *cmd, + struct forf_memory *mem, + void *udata) +{ + env->lenv = lenv; + env->data = data; + env->command = cmd; + env->memory = mem; + env->udata = udata; +} + + +int +forf_eval_once(struct forf_env *env) +{ + struct forf_value val; + + if (! forf_stack_pop(env->command, &val)) { + env->error = forf_error_underflow; + return 0; + } + switch (val.type) { + case forf_type_number: + case forf_type_stack_begin: + // Push back on command stack, then move it + forf_stack_push(env->command, &val); + if (! forf_stack_move_value(env, env->data, env->command)) return 0; + break; + case forf_type_proc: + (val.v.p)(env); + break; + default: + env->error = forf_error_runtime; + return 0; + } + return 1; +} + +int +forf_eval(struct forf_env *env) +{ + int ret; + + env->error = forf_error_none; + while (env->command->top) { + ret = forf_eval_once(env); + if ((! ret) || (env->error)) { + return 0; + } + } + return 1; +} diff --git a/forf.h b/forf.h new file mode 100644 index 0000000..689db10 --- /dev/null +++ b/forf.h @@ -0,0 +1,150 @@ +#ifndef __FORF_H__ +#define __FORF_H__ + +#include +#include + +#define MAX_TOKEN_LEN 20 +#define MAX_CMDSTACK 200 + +struct forf_env; + +enum forf_value_type { + forf_type_number, + forf_type_proc, + forf_type_stack_begin, + forf_type_stack_end, +}; + +enum forf_error_type { + forf_error_none, + forf_error_runtime, + forf_error_parse, + forf_error_underflow, + forf_error_overflow, + forf_error_type, + forf_error_noproc, + forf_error_divzero, +}; + +extern char *forf_error_str[]; + +typedef void (forf_proc)(struct forf_env *); + +struct forf_value { + enum forf_value_type type; + union { + forf_proc *p; + long i; + } v; +}; + +struct forf_stack { + size_t size; + size_t top; + struct forf_value *stack; +}; + +struct forf_memory { + size_t size; + long *mem; +}; + +struct forf_lexical_env { + char *name; + forf_proc *proc; +}; + +struct forf_env { + enum forf_error_type error; + struct forf_lexical_env *lenv; + struct forf_stack *data; + struct forf_stack *command; + struct forf_memory *memory; + void *udata; +}; + + +/* + * + * Main entry points + * + */ + +/** Initialize a memory structure, given an array of longs */ +void forf_memory_init(struct forf_memory *m, + long *values, + size_t size); + +/** Initialize a stack, given an array of values */ +void forf_stack_init(struct forf_stack *s, + struct forf_value *values, + size_t size); + +void forf_stack_reset(struct forf_stack *s); +void forf_stack_copy(struct forf_stack *dst, struct forf_stack *src); +int forf_stack_push(struct forf_stack *s, struct forf_value *v); +int forf_stack_pop(struct forf_stack *s, struct forf_value *v); + +/** Pop a number off the data stack */ +long forf_pop_num(struct forf_env *env); + +/** Push a number onto the data stack */ +void forf_push_num(struct forf_env *env, long i); + +/** Pop a whole stack */ +struct forf_stack forf_pop_stack(struct forf_env *env); + + +/** The base lexical environment */ +extern struct forf_lexical_env forf_base_lexical_env[]; + +/** Extend a lexical environment */ +int +forf_extend_lexical_env(struct forf_lexical_env *dest, + struct forf_lexical_env *src, + size_t size); + +/** Initialize a forf runtime environment. + * + * data, cmd, and mem should have already been initialized + */ +void forf_env_init(struct forf_env *env, + struct forf_lexical_env *lenv, + struct forf_stack *data, + struct forf_stack *cmd, + struct forf_memory *mem, + void *udata); + +/** The type of a getch function (used for parsing) */ +typedef int (forf_getch_func)(void *); + +/** Parse something by calling getch(datum) + * + * Returns the character at which an error was encountered, or + * 0 for successful parse. + */ +int forf_parse_stream(struct forf_env *env, + forf_getch_func *getch, + void *datum); + +/** Parse a buffer */ +int forf_parse_buffer(struct forf_env *env, + char *buf, + size_t len); + +/** Parse a string */ +int forf_parse_string(struct forf_env *env, + char *str); + +/** Parse a FILE * */ +int forf_parse_file(struct forf_env *env, + FILE *f); + +/** Evaluate the topmost value on the command stack */ +int forf_eval_once(struct forf_env *env); + +/** Evaluate the entire command stack */ +int forf_eval(struct forf_env *env); + +#endif diff --git a/forf.txt b/forf.txt new file mode 100644 index 0000000..3a818a0 --- /dev/null +++ b/forf.txt @@ -0,0 +1,204 @@ +The Forf Language +================= + +Welcome to Forf! *PUNCH* + +Forf is a simple, postfix, stack-based programming language. It was +designed to be used as an extension language for games. Forf programs +run in fixed size memory and can be time-constrained. + +Forf was heavily influenced by the PostScript programming language. + + +About Stacks +============ + +Central to the operation of Forf is the notion of a stack, or queue. A +stack is a first-in-first-out (FIFO) list, like a stack of dishes. +Items can be "pushed" onto the top of the stack, or "popped" off the top +of the stack. Items may only be pushed or popped, meaning the top stack +element is the only element that can be accessed. To get to the third +item down in a stack, it is necessary to first pop two items off. + + +Data Types +========== + +There are three data types in Forf: Integers, Substacks, and Procedures. + + +Integers +-------- + +Integers are stored as the "long" type and have whatever boundaries the +host CPU and C compiler enforce. They may be entered in decimal (12), +octal (014), or hex (0xC), and may be positive or negative. + +The following are valid integers: + +* 58 +* -58 +* 0x3A (hex) +* 072 (octal) + + +Procedures +---------- + +Data is read one by one from your program and either pushed onto the +data stack (integers and substacks) or evaluated (procedures). When a +procedures is evaluated, it pops zero or more elements off the data +stack, does something with them, and then pushes zero or more elements +back onto the stack. + +The "+" procudure, for instance, pops two values, adds them, and pushes +the result. The following data stack: + + [bottom] 58 88 5 [top] + +When given to the "+" procedure, would yield: + + [bottom] 58 93 [top] + + +Substacks +--------- + +Substacks are groups of data on the data stack. They are used only by +the "if" and "ifelse" procedures, and are denoted by "{" (start +substack) and "}" (end substack). Substacks may be nested. + +The following will result in 58 on the top of the stack: + + 5 8 < { 50 8 + } { 50 8 - } ifelse + + +Built-in Procedures +=================== + +The following procedures are built in to Forf. Since the language was +designed to be extended, your game provides additional procedures. + + +Unary Operations +---------------- + +These procedures pop one value and push one. + +* `x ~` (bitwise invert) +* `x !` (logical not) +* `x abs` (absolute value) + + +Binary Operations +----------------- + +The following procedures pop two values and push one. They work as in +an RPN calculator, meaning that `8 4 /` yields `2`. + +* `y x +` (y + x) +* `y x -` (y - x) +* `y x *` (y * x) +* `y x /` (y / x) +* `y x %` (y modulo x) +* `y x &` (y and x) +* `y x |` (y or x) +* `y x ^` (x xor x) +* `y x <<` (y shifted left by x) +* `y x >>` (y shifted right by x) + + +Comparison +---------- + +These procedures pop two numbers and compare them, pushing `1` if the +comparison is true, `0` if false. For instance, `5 3 >` yields `1`. + +* `y x >` (y greater than x) +* `y x >=` (y greater than or equal to x) +* `y x <` (y less than x) +* `y x <=` (y less than or equal to x) +* `y x =` (y equal to x) +* `y x <>` (y not equal to x) + + +Conditional Procedures +---------------------- + +* `x { i ... } if` (if x, evaluate i) +* `x { i ... } { e ... } ifelse` (if x, evaluate i, otherwise evaluate e) + + +Stack Manipulation +------------------ + +* `x pop` (discard x) +* `x dup` (duplicate x) +* `y x exch` (exchange x and y on the stack) + + +Memory +------ + +Your game may provide you with one or more memory slots. These are like +variables in other languages, and may persist across invocations of your +program. + +* `y x mset` (store y in slot x) +* `x mget` (retrieve value in slot x) + + +Examples +======== + +Compute 58²: + + 58 58 * + +Compute 58³: + + 58 58 58 * * + +Another way to compute 58³: + + 58 dup dup * * + + +The ifelse example, which does a comparison and puts 58 on the stack: + + 5 8 < { 50 8 + } { 50 8 - } ifelse + +Another way to do that: + + 50 5 8 < { 8 + } { 8 - } ifelse + +Yet another way: + + 50 8 5 8 < { + } { - } ifelse + +Is memory slot 3 greater than 100? + + 3 mget 100 > + +Given x, if x² is greater than 100 yield x², otherwise 0: + + dup dup * 100 > { dup * } { pop 0 } ifelse + +Another way to do the same thing: + + dup * dup 100 < { pop 0 } if + +Given coordinates (x, y) on the stack, is the distance to (x, y) less +than 88? This compares x²+y² against 88². + + dup * exch dup * + 88 88 * < + +Perform different actions given some number between 0 and 3: + + dup 0 = { action0 } if + dup 1 = { action1 } if + dup 2 = { action2 } if + dup 3 = { action3 } if + pop + +