summaryrefslogtreecommitdiffstats
path: root/qemu/roms/openbios/kernel
diff options
context:
space:
mode:
Diffstat (limited to 'qemu/roms/openbios/kernel')
-rw-r--r--qemu/roms/openbios/kernel/Kconfig88
-rw-r--r--qemu/roms/openbios/kernel/README93
-rw-r--r--qemu/roms/openbios/kernel/bootstrap.c1322
-rw-r--r--qemu/roms/openbios/kernel/build.xml16
-rw-r--r--qemu/roms/openbios/kernel/cross.h124
-rw-r--r--qemu/roms/openbios/kernel/dict.c320
-rw-r--r--qemu/roms/openbios/kernel/forth.c1966
-rw-r--r--qemu/roms/openbios/kernel/include/dict.h59
-rw-r--r--qemu/roms/openbios/kernel/stack.c46
9 files changed, 0 insertions, 4034 deletions
diff --git a/qemu/roms/openbios/kernel/Kconfig b/qemu/roms/openbios/kernel/Kconfig
deleted file mode 100644
index 32831f737..000000000
--- a/qemu/roms/openbios/kernel/Kconfig
+++ /dev/null
@@ -1,88 +0,0 @@
-menu "Kernel Debugging"
-
-config DEBUG
- bool "Kernel Debugging"
- default y
- help
- Kernel Debugging
-
-config DEBUG_BOOT
- bool "Boot messages"
- depends on DEBUG
- default y
- help
- early boot code (multiboot parsing etc)
-
-config DEBUG_DSTACK
- bool "dstack messages"
- depends on DEBUG
- default n
- help
- stack debugging. warning: heavy output!
-
-config DEBUG_RSTACK
- bool "rstack messages"
- depends on DEBUG
- default n
- help
- stack debugging. warning: heavy output!
-
-config DEBUG_DICTIONARY
- bool "Dictionary loading/dumping"
- depends on DEBUG
- default n
- help
- print few additional information on dictionary loading/dumping
-
-config DEBUG_INTERNAL
- bool "Prime Words"
- depends on DEBUG
- default n
- help
- print additional information for some prime words, like branches
-
-config DEBUG_INTERPRETER
- bool "Interpreter"
- depends on DEBUG
- default n
- help
- additional information about the unix.c builtin C interpreter
- and some other places where it actually does not belong.
-
-config DEBUG_CONSOLE
- bool "Console"
- default y
- help
- use builtin C console code for user interaction. There is no
- real alternative to this until someone writes a display/kbd or
- serial driver in forth.
-
-config DEBUG_CONSOLE_SERIAL
- bool "Serial Console"
- depends on DEBUG_CONSOLE
- default y
- help
- use serial console.
-
-config SERIAL_PORT
- int "Serial Port"
- depends on DEBUG_CONSOLE_SERIAL
- default "1"
- help
- 0 for none, 1 for ttyS0, 2 for ttyS1
-
-config SERIAL_SPEED
- int "Serial line speed"
- depends on DEBUG_CONSOLE_SERIAL
- default "115200"
- help
- supported speeds are: 115200, 57600, 38400, 19200, 9600
-
-config DEBUG_CONSOLE_VGA
- bool "VGA Console"
- depends on DEBUG_CONSOLE
- default y
- help
- use vga textmode and keyboard console
-
-endmenu
diff --git a/qemu/roms/openbios/kernel/README b/qemu/roms/openbios/kernel/README
deleted file mode 100644
index c84879b83..000000000
--- a/qemu/roms/openbios/kernel/README
+++ /dev/null
@@ -1,93 +0,0 @@
-
-Welcome to the OpenBIOS forth core "begin again".
-
-Find more information about OpenBIOS at http://www.openbios.org/
-
-This program was written by Patrick Mauritz and Stefan Reinauer in 2003
-For license details on this piece of software, check Documentation/COPYING.
-
-How OpenBIOS works
-------------------
-
- The OpenBIOS forth core is split into a forth kernel written in C
- and a forth dictionary which operated on by the kernel.
-
- When building the forth core, you get different versions of
- the forth kernel:
-
- * a "hosted" unix binary. This binary can be used on a unix system
-
- - to execute a forth dictionary from a file. This can be used for
- testing openbios code in a development environment on a unix host.
-
- - to create a dictionary file. Such a dictionary file sets up
- all of the forth language. Primitives are indexed to save relocations.
-
- The default is to create a forth dictionary forth.dict from
- forth/start.fs. This file includes all of the basic forth language
- constructs from forth/bootstrap.fs and starts the interpreter.
-
- To achieve this, the hosted unix version contains a basic set of
- forth words coded in C that allow creating a full dictionary.
-
- * a varying number of target specific binaries. On x86 you can start
- openbios for example from GRUB or LinuxBIOS. They are all based on
- the same forth engine consisting of a dictionary scheduler, primitive
- words needed to build the forth environment, 2 stacks and a simple
- set of console functions. These binaries can not be started directly
- in the unix host environment.
-
-Requirements
-------------
- * gcc
- * grub or any other multiboot loader to run the standalone
- binary "openbios.multiboot"
-
-Building & Usage
-----------------
-
- * make
-
- this builds "openbios.multiboot", the standalone image and "unix",
- the hosted image. Additionally it creates a forth dictionary
- file from forth/start.fs. All generated files are written to
- the absolute directory held by the variable BUILDDIR, which defaults
- to obj-[platform]. Some compile time parameters can be tweaked in
- include/config.h
-
- * use "unix" to create a forth dictionary on your own:
- $ ./unix -Iforth start.fs
- creates the file forth.dict from forth source forth/start.fs.
-
- * use "unix" to run a created dictionary:
- $ ./unix forth.dict
- This is useful for testing
-
- * booting openbios
- You can boot openbios i.e. in grub. Add the following lines to
- your menu.lst:
-
- title openbios
- kernel (hd0,2)/boot/openbios.multiboot
- module (hd0,2)/boot/openfirmware.dict
-
- Note: change (hd0,2) to the partition you copied openbios and
- forth.dict to.
-
- To boot OpenBIOS from LinuxBIOS/etherboot, you can either use
- "openbios" or "openbios.full":
-
- - openbios is the pure kernel that loads the dictionary from a
- hardcoded address in flash memory (0xfffe0000)
-
- - openbios.full also includes the dictionary directly so that it
- can be easily used from etherboot or the LinuxBIOS builtin ELF
- loader without taking care of the dictionary
-
-
-Comments are welcome.
-
- OpenBIOS team
-
-------------------------------------------------------------------------
-tag: README for openbios forth core
diff --git a/qemu/roms/openbios/kernel/bootstrap.c b/qemu/roms/openbios/kernel/bootstrap.c
deleted file mode 100644
index 520d7b48c..000000000
--- a/qemu/roms/openbios/kernel/bootstrap.c
+++ /dev/null
@@ -1,1322 +0,0 @@
-/* tag: forth bootstrap environment
- *
- * Copyright (C) 2003-2006 Stefan Reinauer, Patrick Mauritz
- *
- * See the file "COPYING" for further information about
- * the copyright and warranty status of this work.
- */
-
-#include "sysinclude.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <signal.h>
-#include <fcntl.h>
-#include <unistd.h>
-#include <termios.h>
-#include <sys/stat.h>
-
-#ifdef __GLIBC__
-#define _GNU_SOURCE
-#include <getopt.h>
-#endif
-
-#include "config.h"
-#include "kernel/stack.h"
-#include "sysinclude.h"
-#include "kernel/kernel.h"
-#include "dict.h"
-#include "cross.h"
-#include "openbios-version.h"
-
-#define MAX_PATH_LEN 256
-
-#define MEMORY_SIZE (1024*1024) /* 1M ram for hosted system */
-#define DICTIONARY_SIZE (256*1024) /* 256k for the dictionary */
-#define TRAMPOLINE_SIZE (4*sizeof(cell)) /* 4 cells for the trampoline */
-
-/* state variables */
-static ucell *latest, *state, *base;
-static ucell *memory;
-ucell *trampoline;
-
-/* local variables */
-static int errors = 0;
-static int segfault = 0;
-static int verbose = 0;
-
-#define MAX_SRC_FILES 128
-
-static FILE *srcfiles[MAX_SRC_FILES];
-static char *srcfilenames[MAX_SRC_FILES];
-static int srclines[MAX_SRC_FILES];
-static unsigned int cursrc = 0;
-
-static char *srcbasedict;
-
-/* console variables */
-static FILE *console;
-
-#ifdef NATIVE_BITWIDTH_SMALLER_THAN_HOST_BITWIDTH
-unsigned long base_address;
-#endif
-
-/* include path handling */
-typedef struct include_path include;
-struct include_path {
- const char *path;
- include *next;
-};
-
-static include includes = { ".", NULL };
-static FILE *depfile;
-
-static ucell * relocation_address=NULL;
-static int relocation_length=0;
-
-/* the word names are used to generate the prim words in the
- * dictionary. This is done by the C written interpreter.
- */
-static const char *wordnames[] = {
- "(semis)", "", "(lit)", "", "", "", "", "(do)", "(?do)", "(loop)",
- "(+loop)", "", "", "", "dup", "2dup", "?dup", "over", "2over", "pick", "drop",
- "2drop", "nip", "roll", "rot", "-rot", "swap", "2swap", ">r", "r>",
- "r@", "depth", "depth!", "rdepth", "rdepth!", "+", "-", "*", "u*",
- "mu/mod", "abs", "negate", "max", "min", "lshift", "rshift", ">>a",
- "and", "or", "xor", "invert", "d+", "d-", "m*", "um*", "@", "c@",
- "w@", "l@", "!", "+!", "c!", "w!", "l!", "=", ">", "<", "u>", "u<",
- "sp@", "move", "fill", "(emit)", "(key?)", "(key)", "execute",
- "here", "here!", "dobranch", "do?branch", "unaligned-w@",
- "unaligned-w!", "unaligned-l@", "unaligned-l!", "ioc@", "iow@",
- "iol@", "ioc!", "iow!", "iol!", "i", "j", "call", "sys-debug",
- "$include", "$encode-file", "(debug", "(debug-off)"
-};
-
-/*
- * dictionary related functions.
- */
-
-/*
- * Compare two dictionaries constructed at different addresses. When
- * the cells don't match, a need for relocation is detected and the
- * corresponding bit in reloc_table bitmap is set.
- */
-static void relocation_table(unsigned char * dict_one, unsigned char *dict_two, int length)
-{
- ucell *d1=(ucell *)dict_one, *d2=(ucell *)dict_two;
- ucell *reloc_table;
- int pos, bit;
- int l=(length+(sizeof(cell)-1))/sizeof(ucell), i;
-
- /* prepare relocation table */
- relocation_length=(length+BITS-1)/BITS;
- reloc_table = malloc(relocation_length*sizeof(cell));
- memset(reloc_table,0,relocation_length*sizeof(cell));
-
- for (i=0; i<l; i++) {
-
- pos=i/BITS;
- bit=i&~(-BITS);
-
- if(d1[i]==d2[i]) {
- reloc_table[pos] &= target_ucell(~((ucell)1ULL << bit));
-
- // This check might bring false positives in data.
- //if(d1[i] >= pointer2cell(dict_one) &&
- // d1[i] <= pointer2cell(dict_one+length))
- // printk("\nWARNING: inconsistent relocation (%x:%x)!\n", d1[i], d2[i]);
- } else {
- /* This is a pointer, it needs relocation, d2==dict */
- reloc_table[pos] |= target_ucell((ucell)1ULL << bit);
- d2[i] = target_ucell(target_ucell(d2[i]) - pointer2cell(d2));
- }
- }
-
-#ifdef CONFIG_DEBUG_DICTIONARY
- printk("dict1 %lx dict2 %lx dict %lx\n",dict_one, dict_two, dict);
- for (i=0; i< relocation_length ; i++)
- printk("reloc %d %lx\n",i+1, reloc_table[i]);
-#endif
- relocation_address=reloc_table;
-}
-
-static void write_dictionary(const char *filename)
-{
- FILE *f;
- unsigned char *write_data, *walk_data;
- int write_len;
- dictionary_header_t *header;
- u32 checksum=0;
-
- /*
- * get memory for dictionary
- */
-
- write_len = sizeof(dictionary_header_t)+dicthead+relocation_length*sizeof(cell);
- write_data = malloc(write_len);
- if(!write_data) {
- printk("panic: can't allocate memory for output dictionary (%d"
- " bytes\n", write_len);
- exit(1);
- }
- memset(write_data, 0, write_len);
-
- /*
- * prepare dictionary header
- */
-
- header = (dictionary_header_t *)write_data;
- *header = (dictionary_header_t){
- .signature = DICTID,
- .version = 2,
- .cellsize = sizeof(ucell),
-#ifdef CONFIG_BIG_ENDIAN
- .endianess = -1,
-#else
- .endianess = 0,
-#endif
- .checksum = 0,
- .compression = 0,
- .relocation = -1,
- .length = target_ulong((uint32_t)dicthead),
- .last = target_ucell((ucell)((unsigned long)last
- - (unsigned long)dict)),
- };
-
- /*
- * prepare dictionary data
- */
-
- walk_data=write_data+sizeof(dictionary_header_t);
- memcpy (walk_data, dict, dicthead);
-
- /*
- * prepare relocation data.
- * relocation_address is zero when writing a dictionary core.
- */
-
- if (relocation_address) {
-#ifdef CONFIG_DEBUG_DICTIONARY
- printk("writing %d reloc cells \n",relocation_length);
-#endif
- walk_data += dicthead;
- memcpy(walk_data, relocation_address,
- relocation_length*sizeof(cell));
- /* free relocation information */
- free(relocation_address);
- relocation_address=NULL;
- } else {
- header->relocation=0;
- }
-
- /*
- * Calculate Checksum
- */
-
- walk_data=write_data;
- while (walk_data<write_data+write_len) {
- checksum+=read_long(walk_data);
- walk_data+=sizeof(u32);
- }
- checksum=(u32)-checksum;
-
- header->checksum=target_long(checksum);
-
- if (verbose) {
- dump_header(header);
- }
-
- f = fopen(filename, "w");
- if (!f) {
- printk("panic: can't write to dictionary '%s'.\n", filename);
- exit(1);
- }
-
- fwrite(write_data, write_len, 1, f);
-
- free(write_data);
- fclose(f);
-
-#ifdef CONFIG_DEBUG_DICTIONARY
- printk("wrote dictionary to file %s.\n", filename);
-#endif
-}
-
-/*
- * Write dictionary as a list of ucell hex values to filename. Array
- * header and end lines are not generated.
- *
- * Cells with relocations are output using the expression
- * DICTIONARY_BASE + value.
- *
- * Define some helpful constants.
- */
-static void write_dictionary_hex(const char *filename)
-{
- FILE *f;
- ucell *walk;
-
- f = fopen(filename, "w");
- if (!f) {
- printk("panic: can't write to dictionary '%s'.\n", filename);
- exit(1);
- }
-
- for (walk = (ucell *)dict; walk < (ucell *)(dict + dicthead); walk++) {
- int pos, bit, l;
- ucell val;
-
- l = (walk - (ucell *)dict);
- pos = l / BITS;
- bit = l & ~(-BITS);
-
- val = read_ucell(walk);
- if (relocation_address[pos] & target_ucell((ucell)1ULL << bit)) {
- fprintf(f, "DICTIONARY_BASE + 0x%" FMT_CELL_x
- ",\n", val);
- } else {
- fprintf(f, "0x%" FMT_CELL_x",\n", val);
- }
- }
-
- fprintf(f, "#define FORTH_DICTIONARY_LAST 0x%" FMT_CELL_x"\n",
- (ucell)((unsigned long)last - (unsigned long)dict));
- fprintf(f, "#define FORTH_DICTIONARY_END 0x%" FMT_CELL_x"\n",
- (ucell)dicthead);
- fclose(f);
-
-#ifdef CONFIG_DEBUG_DICTIONARY
- printk("wrote dictionary to file %s.\n", filename);
-#endif
-}
-
-static ucell read_dictionary(char *fil)
-{
- int ilen;
- ucell ret;
- char *mem;
- FILE *f;
- struct stat finfo;
-
- if (stat(fil, &finfo))
- return 0;
-
- ilen = finfo.st_size;
-
- if ((mem = malloc(ilen)) == NULL) {
- printk("panic: not enough memory.\n");
- exit(1);
- }
-
- f = fopen(fil, "r");
- if (!f) {
- printk("panic: can't open dictionary.\n");
- exit(1);
- }
-
- if (fread(mem, ilen, 1, f) != 1) {
- printk("panic: can't read dictionary.\n");
- fclose(f);
- exit(1);
- }
- fclose(f);
-
- ret = load_dictionary(mem, ilen);
-
- free(mem);
- return ret;
-}
-
-
-/*
- * C Parser related functions
- */
-
-/*
- * skipws skips all whitespaces (space, tab, newline) from the input file
- */
-
-static void skipws(FILE * f)
-{
- int c;
- while (!feof(f)) {
- c = getc(f);
-
- if (c == ' ' || c == '\t')
- continue;
-
- if (c == '\n') {
- srclines[cursrc - 1]++;
- continue;
- }
-
- ungetc(c, f);
- break;
- }
-}
-
-/*
- * parse gets the next word from the input stream, delimited by
- * delim. If delim is 0, any word delimiter will end the stream
- * word delimiters are space, tab and newline. The resulting word
- * will be put zero delimited to the char array line.
- */
-
-static int parse(FILE * f, char *line, char delim)
-{
- int cnt = 0, c = 0;
-
- while (!feof(f)) {
- c = getc(f);
-
- if (delim && c == delim)
- break;
-
- if ((!delim) && (c == ' ' || c == '\t' || c == '\n'))
- break;
-
- line[cnt++] = c;
- }
-
- /* Update current line number */
- if (c == '\n') {
- srclines[cursrc - 1]++;
- }
-
- line[cnt] = 0;
-
- return cnt;
-}
-
-/*
- * parse_word is a small helper that skips whitespaces before a word.
- * it's behaviour is similar to the forth version parse-word.
- */
-
-static void parse_word(FILE * f, char *line)
-{
- skipws(f);
- parse(f, line, 0);
-}
-
-
-static void writestring(const char *str)
-{
- unsigned int i;
- for (i = 0; i < strlen(str); i++) {
- dict[dicthead + i] = str[i];
- }
- dicthead += i + 1;
- dict[dicthead - 1] = (char) strlen(str) + 128;
-}
-
-#define writebyte(value) {write_byte(dict+dicthead,value); dicthead++;}
-#define writecell(value) {write_cell(dict+dicthead, value); dicthead+=sizeof(cell);}
-
-/*
- * reveal a word, ie. make it visible.
- */
-
-static void reveal(void)
-{
- *last = *latest;
-}
-
-/*
- * dictionary padding
- */
-
-static void paddict(ucell align)
-{
- while (dicthead % align != 0)
- writebyte(0);
-}
-
-/*
- * generic forth word creator function.
- */
-
-static void fcreate(const char *word, ucell cfaval)
-{
- if (strlen(word) == 0) {
- printk("WARNING: tried to create unnamed word.\n");
- return;
- }
-
- writestring(word);
- /* get us at least 1 byte for flags */
- writebyte(0);
- paddict(sizeof(cell));
- /* set flags high bit. */
- dict[dicthead - 1] = 128;
- /* lfa and cfa */
- writecell(read_ucell(latest));
- *latest = target_ucell(pointer2cell(dict) + dicthead - sizeof(cell));
- writecell(cfaval);
-}
-
-
-static ucell *buildvariable(const char *name, cell defval)
-{
- fcreate(name, DOVAR); /* see dict.h for DOVAR and other CFA ids */
- writecell(defval);
- return (ucell *) (dict + dicthead - sizeof(cell));
-}
-
-static void buildconstant(const char *name, cell defval)
-{
- fcreate(name, DOCON); /* see dict.h for DOCON and other CFA ids */
- writecell(defval);
-}
-
-static void builddefer(const char *name)
-{
- fcreate(name, DODFR); /* see dict.h for DODFR and other CFA ids */
- writecell((ucell)0);
- writecell((ucell)findword("(semis)"));
-}
-
-/*
- * Include file handling
- */
-
-static void add_includepath(char *path)
-{
- include *incl = &includes;
- include *newpath;
-
- while (incl->next)
- incl = incl->next;
-
- newpath = malloc(sizeof(include));
- if (!newpath) {
- printk("panic: not enough memory for include path.\n");
- exit(1);
- }
-
- incl->next = newpath;
- newpath->path = path;
- newpath->next = NULL;
-}
-
-
-static FILE *fopen_include(const char *fil)
-{
- char fullpath[MAX_PATH_LEN];
- FILE *ret;
- include *incl = &includes;
-
- while (incl) {
- snprintf(fullpath, sizeof(fullpath), "%s/%s", incl->path, fil);
-
- ret = fopen(fullpath, "r");
- if (ret != NULL) {
-
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("Including '%s'\n", fil);
-#endif
- srcfilenames[cursrc] = strdup(fil);
- srclines[cursrc] = 1;
- srcfiles[cursrc++] = ret;
-
- if (depfile) {
- fprintf(depfile, " %s", fullpath);
- }
-
- return ret;
- }
-
- incl = incl->next;
- }
- return NULL;
-}
-
-
-/*
- * Forth exception handler
- */
-
-void exception(cell no)
-{
- printk("%s:%d: ", srcfilenames[cursrc - 1], srclines[cursrc - 1]);
-
- /* See also forth/bootstrap/interpreter.fs */
- switch (no) {
- case -1:
- case -2:
- printk("Aborted.\n");
- break;
- case -3:
- printk("Stack Overflow.\n");
- break;
- case -4:
- printk("Stack Underflow.\n");
- break;
- case -5:
- printk("Return Stack Overflow.\n");
- break;
- case -6:
- printk("Return Stack Underflow.\n");
- break;
- case -19:
- printk("undefined word.\n");
- break;
- case -21:
- printk("out of memory.\n");
- break;
- case -33:
- printk("undefined method.\n");
- break;
- case -34:
- printk("no such device.\n");
- break;
- default:
- printk("error %" FMT_CELL_d " occured.\n", no);
- }
- exit(1);
-}
-
-
-/*
- * This is the C version of the forth interpreter
- */
-
-static int interpret_source(char *fil)
-{
- FILE *f;
- char tib[160];
- cell num;
- char *test;
-
- const ucell SEMIS = (ucell)findword("(semis)");
- const ucell LIT = (ucell)findword("(lit)");
- const ucell DOBRANCH = (ucell)findword("dobranch");
-
- if ((f = fopen_include(fil)) == NULL) {
- printk("error while loading source file '%s'\n", fil);
- errors++;
- exit(1);
- }
-
- /* FIXME: We should read this file at
- * once. No need to get it char by char
- */
-
- while (!feof(f)) {
- xt_t res;
- parse_word(f, tib);
-
- /* if there is actually no word, we continue right away */
- if (strlen(tib) == 0) {
- continue;
- }
-
- /* Checking for builtin words that are needed to
- * bootstrap the forth base dictionary.
- */
-
- if (!strcmp(tib, "(")) {
- parse(f, tib, ')');
- continue;
- }
-
- if (!strcmp(tib, "\\")) {
- parse(f, tib, '\n');
- continue;
- }
-
- if (!strcmp(tib, ":")) {
- parse_word(f, tib);
-
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("create colon word %s\n\n", tib);
-#endif
- fcreate(tib, DOCOL); /* see dict.h for DOCOL and other CFA ids */
- *state = (ucell) (-1);
- continue;
- }
-
- if (!strcmp(tib, ";")) {
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("finish colon definition\n\n");
-#endif
- writecell((cell)SEMIS);
- *state = (ucell) 0;
- reveal();
- continue;
- }
-
- if (!strcasecmp(tib, "variable")) {
- parse_word(f, tib);
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("defining variable %s\n\n", tib);
-#endif
- buildvariable(tib, 0);
- reveal();
- continue;
- }
-
- if (!strcasecmp(tib, "constant")) {
- parse_word(f, tib);
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("defining constant %s\n\n", tib);
-#endif
- buildconstant(tib, POP());
- reveal();
- continue;
- }
-
- if (!strcasecmp(tib, "value")) {
- parse_word(f, tib);
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("defining value %s\n\n", tib);
-#endif
- buildconstant(tib, POP());
- reveal();
- continue;
- }
-
- if (!strcasecmp(tib, "defer")) {
- parse_word(f, tib);
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("defining defer word %s\n\n", tib);
-#endif
- builddefer(tib);
- reveal();
- continue;
- }
-
- if (!strcasecmp(tib, "include")) {
- parse_word(f, tib);
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("including file %s\n\n", tib);
-#endif
- interpret_source(tib);
- continue;
- }
-
- if (!strcmp(tib, "[']")) {
- xt_t xt;
- parse_word(f, tib);
- xt = findword(tib);
- if (*state == 0) {
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk
- ("writing address of %s to stack\n\n",
- tib);
-#endif
- PUSH_xt(xt);
- } else {
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("writing lit, addr(%s) to dict\n\n",
- tib);
-#endif
- writecell(LIT); /* lit */
- writecell((cell)xt);
- }
- continue;
- /* we have no error detection here */
- }
-
- if (!strcasecmp(tib, "s\"")) {
- int cnt;
- cell loco;
-
- cnt = parse(f, tib, '"');
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("compiling string %s\n", tib);
-#endif
- loco = dicthead + (6 * sizeof(cell));
- writecell(LIT);
- writecell(pointer2cell(dict) + loco);
- writecell(LIT);
- writecell((ucell)cnt);
- writecell(DOBRANCH);
- loco = cnt + sizeof(cell) - 1;
- loco &= ~(sizeof(cell) - 1);
- writecell(loco);
- memcpy(dict + dicthead, tib, cnt);
- dicthead += cnt;
- paddict(sizeof(cell));
- continue;
- }
-
- /* look if tib is in dictionary. */
- /* should the dictionary be searched before the builtins ? */
- res = findword(tib);
- if (res) {
- u8 flags = read_byte((u8*)cell2pointer(res) -
- sizeof(cell) - 1);
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("%s is 0x%" FMT_CELL_x "\n", tib, (ucell) res);
-#endif
- if (!(*state) || (flags & 3)) {
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("executing %s, %" FMT_CELL_d
- " (flags: %s %s)\n",
- tib, res,
- (flags & 1) ? "immediate" : "",
- (flags & 2) ? "compile-only" : "");
-#endif
- PC = (ucell)res;
- enterforth(res);
- } else {
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("writing %s to dict\n\n", tib);
-#endif
- writecell((cell)res);
- }
- continue;
- }
-
- /* if not look if it's a number */
- if (tib[0] == '-')
- num = strtoll(tib, &test, read_ucell(base));
- else
- num = strtoull(tib, &test, read_ucell(base));
-
-
- if (*test != 0) {
- /* what is it?? */
- printk("%s:%d: %s is not defined.\n\n", srcfilenames[cursrc - 1], srclines[cursrc - 1], tib);
- errors++;
-#ifdef CONFIG_DEBUG_INTERPRETER
- continue;
-#else
- return -1;
-#endif
- }
-
- if (*state == 0) {
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("pushed %" FMT_CELL_x " to stack\n\n", num);
-#endif
- PUSH(num);
- } else {
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("writing lit, %" FMT_CELL_x " to dict\n\n", num);
-#endif
- writecell(LIT); /* lit */
- writecell(num);
- }
- }
-
- fclose(f);
- cursrc--;
-
- return 0;
-}
-
-static int build_dictionary(void)
-{
- ucell lfa = 0;
- unsigned int i;
-
- /* we need a temporary place for latest outside the dictionary */
- latest = &lfa;
-
- /* starting a new dictionary: clear dicthead */
- dicthead = 0;
-
-#ifdef CONFIG_DEBUG_DICTIONARY
- printk("building dictionary, %d primitives.\nbuilt words:",
- sizeof(wordnames) / sizeof(void *));
-#endif
-
- for (i = 0; i < sizeof(wordnames) / sizeof(void *); i++) {
- if (strlen(wordnames[i]) != 0) {
- fcreate((char *) wordnames[i], i);
-#ifdef CONFIG_DEBUG_DICTIONARY
- printk(" %s", wordnames[i]);
-#endif
- }
- }
-#ifdef CONFIG_DEBUG_DICTIONARY
- printk(".\n");
-#endif
-
- /* get last/latest and state */
- state = buildvariable("state", 0);
- last = buildvariable("forth-last", 0);
- latest = buildvariable("latest", 0);
-
- *latest = target_ucell(pointer2cell(latest)-2*sizeof(cell));
-
- base=buildvariable("base", 10);
-
- buildconstant("/c", sizeof(u8));
- buildconstant("/w", sizeof(u16));
- buildconstant("/l", sizeof(u32));
- buildconstant("/n", sizeof(ucell));
- buildconstant("/x", sizeof(u64));
-
- reveal();
- if (verbose) {
- printk("Dictionary initialization finished.\n");
- }
- return 0;
-}
-
-/*
- * functions used by primitives
- */
-
-int availchar(void)
-{
- int tmp;
- if( cursrc < 1 ) {
- interruptforth |= FORTH_INTSTAT_STOP;
- /* return -1 in order to exit the loop in key() */
- return -1;
- }
-
- tmp = getc( srcfiles[cursrc-1] );
- if (tmp != EOF) {
- ungetc(tmp, srcfiles[cursrc-1]);
- return -1;
- }
-
- fclose(srcfiles[--cursrc]);
-
- return availchar();
-}
-
-int get_inputbyte( void )
-{
- int tmp;
-
- if( cursrc < 1 ) {
- interruptforth |= FORTH_INTSTAT_STOP;
- return 0;
- }
-
- tmp = getc( srcfiles[cursrc-1] );
-
- /* Update current line number */
- if (tmp == '\n') {
- srclines[cursrc - 1]++;
- }
-
- if (tmp != EOF) {
- return tmp;
- }
-
- fclose(srcfiles[--cursrc]);
-
- return get_inputbyte();
-}
-
-void put_outputbyte( int c )
-{
- if (console)
- fputc(c, console);
-}
-
-/*
- * segmentation fault handler. linux specific?
- */
-
-static void
-segv_handler(int signo __attribute__ ((unused)),
- siginfo_t * si, void *context __attribute__ ((unused)))
-{
- static int count = 0;
- ucell addr = 0xdeadbeef;
-
- if (count) {
- printk("Died while dumping forth dictionary core.\n");
- goto out;
- }
-
- count++;
-
- if (PC >= pointer2cell(dict) && PC <= pointer2cell(dict) + dicthead)
- addr = read_cell(cell2pointer(PC));
-
- printk("panic: segmentation violation at %p\n", (char *)si->si_addr);
- printk("dict=%p here=%p(dict+0x%" FMT_CELL_x ") pc=0x%" FMT_CELL_x "(dict+0x%" FMT_CELL_x ")\n",
- dict, dict + dicthead, dicthead, PC, PC - pointer2cell(dict));
- printk("dstackcnt=%d rstackcnt=%d instruction=%" FMT_CELL_x "\n",
- dstackcnt, rstackcnt, addr);
-
- printdstack();
- printrstack();
-
- printk("Writing dictionary core file\n");
- write_dictionary("forth.dict.core");
-
- out:
- exit(1);
-}
-
-/*
- * allocate memory and prepare engine for memory management.
- */
-
-static void init_memory(void)
-{
- memset(memory, 0, MEMORY_SIZE);
-
- /* we push start and end of memory to the stack
- * so that it can be used by the forth word QUIT
- * to initialize the memory allocator.
- * Add a cell to the start address so we don't end
- * up with a start address of zero during bootstrap
- */
-
- PUSH(pointer2cell(memory)+sizeof(cell));
- PUSH(pointer2cell(memory) + MEMORY_SIZE-1);
-}
-
-
-void
-include_file( const char *name )
-{
- FILE *file;
-
- if( cursrc >= sizeof(srcfiles)/sizeof(srcfiles[0]) ) {
- printk("\npanic: Maximum include depth reached!\n");
- exit(1);
- }
-
- file = fopen_include( name );
- if( !file ) {
- printk("\npanic: Failed opening file '%s'\n", name );
- exit(1);
- }
-}
-
-
-void
-encode_file( const char *name )
-{
- FILE *file = fopen_include(name);
- int size;
-
- if( !file ) {
- printk("\npanic: Can't open '%s'\n", name );
- exit(1);
- }
- fseek( file, 0, SEEK_END );
- size = ftell( file );
- fseek( file, 0, SEEK_SET );
-
- if (verbose) {
- printk("\nEncoding %s [%d bytes]\n", name, size );
- }
- fread( dict + dicthead, size, 1, file );
- PUSH( pointer2cell(dict + dicthead) );
- PUSH( size );
- dicthead += size;
- paddict(sizeof(cell));
-}
-
-
-static void run_dictionary(char *basedict, char *confile)
-{
- if(!basedict)
- return;
-
- read_dictionary(basedict);
- PC = (ucell)findword("initialize");
-
- if (!PC) {
- if (verbose) {
- printk("Unable to find initialize word in dictionary %s; ignoring\n", basedict);
- }
- return;
- }
-
- if(!srcfiles[0]) {
- cursrc = 1;
- srcfiles[cursrc-1] = stdin;
- }
-
- dstackcnt=0;
- rstackcnt=0;
-
- init_memory();
- if (verbose)
- printk("Jumping to dictionary %s...\n", basedict);
-
- /* If a console file has been specified, open it */
- if (confile)
- console = fopen(confile, "w");
-
- srcbasedict = basedict;
-
- enterforth((xt_t)PC);
-
- /* Close the console file */
- if (console)
- fclose(console);
-}
-
-static void new_dictionary(const char *source)
-{
- build_dictionary();
-
- interpret_source((char *)source);
-
- if (verbose || errors > 0) {
- printk("interpretion finished. %d errors occured.\n",
- errors);
- }
-}
-
-/*
- * main loop
- */
-
-#define BANNER "OpenBIOS bootstrap kernel. (C) 2003-2006 Patrick Mauritz, Stefan Reinauer\n"\
- "This software comes with absolutely no warranty. "\
- "All rights reserved.\n\n"
-
-#ifdef __GLIBC__
-#define USAGE "Usage: %s [options] [dictionary file|source file]\n\n" \
- " -h|--help show this help\n" \
- " -V|--version print version and exit\n" \
- " -v|--verbose print debugging information\n" \
- " -I|--include dir add dir to include path\n" \
- " -d|--source-dictionary bootstrap.dict\n" \
- " use this dictionary as base\n" \
- " -D|--target-dictionary output.dict\n" \
- " write to output.dict\n" \
- " -c|--console output.log\n" \
- " write kernel console output to log file\n" \
- " -s|--segfault install segfault handler\n" \
- " -M|--dependency-dump file\n" \
- " dump dependencies in Makefile format\n\n" \
- " -x|--hexdump output format is C language hex dump\n"
-#else
-#define USAGE "Usage: %s [options] [dictionary file|source file]\n\n" \
- " -h show this help\n" \
- " -V print version and exit\n" \
- " -v print debugging information\n" \
- " -I add dir to include path\n" \
- " -d bootstrap.dict\n" \
- " use this dictionary as base\n" \
- " -D output.dict\n" \
- " write to output.dict\n" \
- " -c output.log\n" \
- " write kernel console output to log file\n" \
- " -s install segfault handler\n\n" \
- " -M file dump dependencies in Makefile format\n\n" \
- " -x output format is C language hex dump\n"
-#endif
-
-int main(int argc, char *argv[])
-{
- struct sigaction sa;
-
- unsigned char *ressources=NULL; /* All memory used by us */
- const char *dictname = NULL;
- char *basedict = NULL;
- char *consolefile = NULL;
- char *depfilename = NULL;
-
- unsigned char *bootstrapdict[2];
- int c, cnt, hexdump = 0;
-
- const char *optstring = "VvhsI:d:D:c:M:x?";
-
- while (1) {
-#ifdef __GLIBC__
- int option_index = 0;
- static struct option long_options[] = {
- {"version", 0, NULL, 'V'},
- {"verbose", 0, NULL, 'v'},
- {"help", 0, NULL, 'h'},
- {"segfault", 0, NULL, 's'},
- {"include", 1, NULL, 'I'},
- {"source-dictionary", 1, NULL, 'd'},
- {"target-dictionary", 1, NULL, 'D'},
- {"console", 1, NULL, 'c'},
- {"dependency-dump", 1, NULL, 'M'},
- {"hexdump", 0, NULL, 'x'},
- };
-
- /*
- * option handling
- */
-
- c = getopt_long(argc, argv, optstring, long_options,
- &option_index);
-#else
- c = getopt(argc, argv, optstring);
-#endif
- if (c == -1)
- break;
-
- switch (c) {
- case 'V':
- printk("Version " OPENBIOS_VERSION_STR "\n");
- return 0;
- case 'h':
- case '?':
- printk("Version " OPENBIOS_VERSION_STR "\n" USAGE,
- argv[0]);
- return 0;
- case 'v':
- verbose = 1;
- break;
- case 's':
- segfault = 1;
- break;
- case 'I':
-#ifdef CONFIG_DEBUG_INTERPRETER
- printk("adding '%s' to include path\n", optarg);
-#endif
- add_includepath(optarg);
- break;
- case 'd':
- if (!basedict) {
- basedict = optarg;
- }
- break;
- case 'D':
- if(!dictname) {
- dictname = optarg;
- }
- break;
- case 'c':
- if (!consolefile) {
- consolefile = optarg;
- }
- break;
- case 'M':
- if (!depfilename) {
- depfilename = optarg;
- }
- break;
- case 'x':
- hexdump = 1;
- break;
- default:
- return 1;
- }
- }
-
- if (!dictname) {
- dictname = "bootstrap.dict";
- }
- if (verbose) {
- printk(BANNER);
- printk("Using source dictionary '%s'\n", basedict);
- printk("Dumping final dictionary to '%s'\n", dictname);
- printk("Dumping dependencies to '%s'\n", depfilename);
- }
-
- if (argc < optind) {
- printk(USAGE, argv[0]);
- return 1;
- }
-
- if (depfilename) {
- depfile = fopen(depfilename, "w");
- if (!depfile) {
- printk("panic: can't write to dependency file '%s'.\n",
- depfilename);
- exit(1);
- }
- fprintf(depfile, "%s:", dictname);
- }
-
- /*
- * Get all required resources
- */
-
-
- ressources = malloc(MEMORY_SIZE + (2 * DICTIONARY_SIZE) + TRAMPOLINE_SIZE);
- if (!ressources) {
- printk("panic: not enough memory on host system.\n");
- return 1;
- }
-
-#ifdef NATIVE_BITWIDTH_SMALLER_THAN_HOST_BITWIDTH
- base_address=(unsigned long)ressources;
-#endif
-
- memory = (ucell *)ressources;
-
- bootstrapdict[0] = ressources + MEMORY_SIZE;
- bootstrapdict[1] = ressources + MEMORY_SIZE + DICTIONARY_SIZE;
- trampoline = (ucell *)(ressources + MEMORY_SIZE + DICTIONARY_SIZE + DICTIONARY_SIZE);
-
-#ifdef CONFIG_DEBUG_INTERPRETER
- printf("memory: %p\n",memory);
- printf("dict1: %p\n",bootstrapdict[0]);
- printf("dict2: %p\n",bootstrapdict[1]);
- printf("trampoline: %p\n",trampoline);
- printf("size=%d, trampoline_size=%d\n",MEMORY_SIZE + (2 *
- DICTIONARY_SIZE) + TRAMPOLINE_SIZE,
- TRAMPOLINE_SIZE);
-#endif
-
- if (trampoline == NULL) {
- /* We're using side effects which is to some extent nasty */
- printf("WARNING: no trampoline!\n");
- } else {
- init_trampoline(trampoline);
- }
-
- if (!segfault) {
- if (verbose)
- printk("Installing SIGSEGV handler...");
-
- sa.sa_sigaction = segv_handler;
- sigemptyset(&sa.sa_mask);
- sa.sa_flags = SA_SIGINFO | SA_NODEFER;
- sigaction(SIGSEGV, &sa, NULL);
-
- if (verbose)
- printk("done.\n");
- }
-
- /*
- * Now do the real work
- */
-
- for (cnt=0; cnt<2; cnt++) {
- if (verbose) {
- printk("Compiling dictionary %d/%d\n", cnt+1, 2);
- }
- dict=bootstrapdict[cnt];
- if(!basedict) {
- new_dictionary(argv[optind]);
- } else {
- for (c=argc-1; c>=optind; c--)
- include_file(argv[c]);
-
- run_dictionary(basedict, consolefile);
- }
- if (depfile) {
- fprintf(depfile, "\n");
- fclose(depfile);
- depfile = NULL;
- }
- if(errors)
- break;
- }
-
-#ifndef CONFIG_DEBUG_INTERPRETER
- if (errors)
- printk("dictionary not dumped to file.\n");
- else
-#endif
- {
- relocation_table( bootstrapdict[0], bootstrapdict[1], dicthead);
- if (hexdump) {
- write_dictionary_hex(dictname);
- } else {
- write_dictionary(dictname);
- }
- }
-
- free(ressources);
-
- if (errors)
- return 1;
- else
- return 0;
-}
diff --git a/qemu/roms/openbios/kernel/build.xml b/qemu/roms/openbios/kernel/build.xml
deleted file mode 100644
index 1090cd62e..000000000
--- a/qemu/roms/openbios/kernel/build.xml
+++ /dev/null
@@ -1,16 +0,0 @@
-<build>
-
- <executable name="forthstrap" target="host">
- <object source="dict.c"/>
- <object source="bootstrap.c"/>
- <object source="forth.c"/>
- <object source="stack.c"/>
- </executable>
-
- <library name="bootstrap" type="static" target="target">
- <object source="dict.c"/>
- <object source="forth.c"/>
- <object source="stack.c"/>
- </library>
-
-</build>
diff --git a/qemu/roms/openbios/kernel/cross.h b/qemu/roms/openbios/kernel/cross.h
deleted file mode 100644
index 9dd656f8e..000000000
--- a/qemu/roms/openbios/kernel/cross.h
+++ /dev/null
@@ -1,124 +0,0 @@
-/* memory access abstraction layer for forth kernel
- *
- * Copyright (C) 2005 Stefan Reinauer
- *
- * See the file "COPYING" for further information about
- * the copyright and warranty status of this work.
- */
-
-#ifndef __CROSS_H
-#define __CROSS_H 1
-
-/* The forthstrap compiler has to abstract the underlying dictionary
- * type: big/little endian, 32/64bit. All other binaries shall use
- * unchanged memory access for performance.
- */
-
-/* byte swapping */
-
-#ifndef SWAP_ENDIANNESS
-
-/* trivial case - we don't have to change anything */
-#define read_ucell(addr) (*(ucell *)(addr))
-#define read_cell(addr) (*(cell *)(addr))
-#define read_long(addr) (*(u32 *)(addr))
-#define read_word(addr) (*(u16 *)(addr))
-#define read_byte(addr) (*(u8 *)(addr))
-
-#define write_ucell(addr, value) {*(ucell *)(addr)=(value);}
-#define write_cell(addr, value) {*(cell *)(addr)=(value);}
-#define write_long(addr, value) {*(u32 *)(addr)=(value);}
-#define write_word(addr, value) {*(u16 *)(addr)=(value);}
-#define write_byte(addr, value) {*(u8 *)(addr)=(value);}
-
-#define target_ucell(x) (x)
-#define target_cell(x) (x)
-#define target_long(x) (x)
-#define target_ulong(x) (x)
-
-#else /* SWAP_ENDIANNESS */
-
-#define target_word(value) ( (((value)>>8)&0xff) | (((value)&0xff)<<8) )
-#define target_long(value) ( (((value)&0xff000000)>>24)|(((value)&0x00ff0000)>>8)|(((value)&0xff00)<<8)|(((value)&0xff)<<24) )
-#define target_ulong(value) (target_long(value))
-
-#if BITS==32
-#define target_ucell(value) ((ucell)target_long(value))
-#define target_cell(value) ((cell)target_long(value))
-#elif BITS==64
-#define target_ucell(value) \
- ((((ucell)target_long((value) & 0xffffffff)) << 32) | \
- ((ucell)target_long((value) >> 32)))
-#define target_cell(value) \
- ((((cell)target_long((value) & 0xffffffff)) << 32) | \
- ((cell)target_long((value) >> 32)))
-#else
-#error "Endianness not supported. Please report."
-#endif
-
-#define read_ucell(addr) target_ucell(*(ucell *)(addr))
-#define read_cell(addr) target_cell(*(cell *)(addr))
-#define read_long(addr) target_long(*(u32 *)(addr))
-#define read_word(addr) target_word(*(u16 *)(addr))
-#define read_byte(addr) (*(u8 *)(addr))
-
-#define write_ucell(addr, value) {*(ucell *)(addr)=target_ucell(value);}
-#define write_cell(addr, value) {*(cell *)(addr)=target_cell(value);}
-#define write_long(addr, value) {*(u32 *)(addr)=target_long(value);}
-#define write_word(addr, value) {*(u16 *)(addr)=target_word(value);}
-#define write_byte(addr, value) {*(u8 *)(addr)=(value);}
-#endif
-
-#ifdef CONFIG_LITTLE_ENDIAN
-#define unaligned_read_word(addr) \
- (read_byte(addr)|(read_byte((u8 *)addr+1)<<8))
-
-#define unaligned_read_long(addr) \
- (unaligned_read_word(addr)|(unaligned_read_word((u8 *)addr+2)<<16))
-
-#define unaligned_write_word(addr, value) \
- write_byte(addr, (value & 0xff)); write_byte((u8 *)(addr+1), (value>>8))
-
-#define unaligned_write_long(addr, value) \
- unaligned_write_word(addr, (value & 0xffff)); \
- unaligned_write_word((addr + 2), (value >> 16))
-
-#endif
-
-#ifdef CONFIG_BIG_ENDIAN
-#define unaligned_read_word(addr) \
- ((read_byte(addr)<<8)|read_byte((u8 *)addr+1))
-
-#define unaligned_read_long(addr) \
- ((unaligned_read_word(addr)<<16)|unaligned_read_word((u8 *)addr+2))
-
-#define unaligned_write_word(addr, value) \
- write_byte(addr, (value >> 8)); write_byte((u8 *)(addr+1), (value & 0xff))
-
-#define unaligned_write_long(addr, value) \
- unaligned_write_word(addr, (value >> 16)); \
- unaligned_write_word((addr + 2), (value & 0xffff))
-#endif
-
-/* bit width handling */
-
-#if BITS==32
-#define FMT_CELL_x PRIx32
-#define FMT_CELL_d PRId32
-#else
-#define FMT_CELL_x PRIx64
-#define FMT_CELL_d PRId64
-#endif
-
-#ifdef NATIVE_BITWIDTH_SMALLER_THAN_HOST_BITWIDTH
-extern unsigned long base_address;
-#define pointer2cell(x) ((ucell)(((unsigned long)(x))-base_address))
-#define cell2pointer(x) ((u8 *)(((unsigned long)(x))+base_address))
-#endif
-
-#ifdef NATIVE_BITWIDTH_LARGER_THAN_HOST_BITWIDTH
-#define pointer2cell(x) ((ucell)(unsigned long)(x))
-#define cell2pointer(x) ((u8 *)((unsigned long)(x)&0xFFFFFFFFUL))
-#endif
-
-#endif
diff --git a/qemu/roms/openbios/kernel/dict.c b/qemu/roms/openbios/kernel/dict.c
deleted file mode 100644
index 0986cb14f..000000000
--- a/qemu/roms/openbios/kernel/dict.c
+++ /dev/null
@@ -1,320 +0,0 @@
-/*
- * tag: dict management
- *
- * Copyright (C) 2003-2005 Stefan Reinauer, Patrick Mauritz
- *
- * See the file "COPYING" for further information about
- * the copyright and warranty status of this work.
- */
-
-#include "config.h"
-#include "kernel/kernel.h"
-#include "dict.h"
-#ifdef BOOTSTRAP
-#include <string.h>
-#else
-#include "libc/string.h"
-#endif
-#include "cross.h"
-
-
-unsigned char *dict = NULL;
-ucell *last;
-cell dicthead = 0;
-cell dictlimit = 0;
-
-/* lfa2nfa
- * converts a link field address to a name field address,
- * i.e find pointer to a given words name
- */
-
-ucell lfa2nfa(ucell ilfa)
-{
- /* get offset from dictionary start */
- ilfa = ilfa - (ucell)pointer2cell(dict);
- ilfa--; /* skip status */
- while (dict[--ilfa] == 0); /* skip all pad bytes */
- ilfa -= (dict[ilfa] - 128);
- return ilfa + (ucell)pointer2cell(dict);
-}
-
-/* lfa2cfa
- * converts a link field address to a code field address.
- * in this forth implementation this is just a fixed offset
- */
-
-static xt_t lfa2cfa(ucell ilfa)
-{
- return (xt_t)(ilfa + sizeof(cell));
-}
-
-
-/* fstrlen - returns length of a forth string. */
-
-ucell fstrlen(ucell fstr)
-{
- fstr -= pointer2cell(dict)+1;
- //fstr -= pointer2cell(dict); FIXME
- while (dict[++fstr] < 128)
- ;
- return dict[fstr] - 128;
-}
-
-/* to_lower - convert a character to lowecase */
-
-static int to_lower(int c)
-{
- return ((c >= 'A') && (c <= 'Z')) ? (c - 'A' + 'a') : c;
-}
-
-/* fstrcmp - compare null terminated string with forth string. */
-
-static int fstrcmp(const char *s1, ucell fstr)
-{
- char *s2 = (char*)cell2pointer(fstr);
- while (*s1) {
- if ( to_lower(*(s1++)) != to_lower(*(s2++)) )
- return -1;
- }
- return 0;
-}
-
-/* fstrncpy - copy a forth string to a destination (with NULL termination) */
-
-void fstrncpy(char *dest, ucell src, unsigned int maxlen)
-{
- int len = fstrlen(src);
-
- if (fstrlen(src) >= maxlen) len = maxlen - 1;
- memcpy(dest, cell2pointer(src), len);
- *(dest + len) = '\0';
-}
-
-
-/* findword
- * looks up a given word in the dictionary. This function
- * is used by the c based interpreter and to find the "initialize"
- * word.
- */
-
-xt_t findword(const char *s1)
-{
- ucell tmplfa, len;
-
- if (!last)
- return 0;
-
- tmplfa = read_ucell(last);
-
- len = strlen(s1);
-
- while (tmplfa) {
- ucell nfa = lfa2nfa(tmplfa);
-
- if (len == fstrlen(nfa) && !fstrcmp(s1, nfa)) {
- return lfa2cfa(tmplfa);
- }
-
- tmplfa = read_ucell(cell2pointer(tmplfa));
- }
-
- return 0;
-}
-
-
-/* findsemis_wordlist
- * Given a DOCOL xt and a wordlist, find the address of the semis
- * word at the end of the word definition. We do this by finding
- * the word before this in the dictionary, then counting back one
- * from the NFA.
- */
-
-static ucell findsemis_wordlist(ucell xt, ucell wordlist)
-{
- ucell tmplfa, nextlfa, nextcfa;
-
- if (!wordlist)
- return 0;
-
- tmplfa = read_ucell(cell2pointer(wordlist));
- nextcfa = lfa2cfa(tmplfa);
-
- /* Catch the special case where the lfa of the word we
- * want is the last word in the dictionary; in that case
- * the end of the word is given by "here" - 1 */
- if (nextcfa == xt)
- return pointer2cell(dict) + dicthead - sizeof(cell);
-
- while (tmplfa) {
-
- /* Peek ahead and see if the next CFA in the list is the
- * one we are searching for */
- nextlfa = read_ucell(cell2pointer(tmplfa));
- nextcfa = lfa2cfa(nextlfa);
-
- /* If so, count back 1 cell from the current NFA */
- if (nextcfa == xt)
- return lfa2nfa(tmplfa) - sizeof(cell);
-
- tmplfa = nextlfa;
- }
-
- return 0;
-}
-
-
-/* findsemis
- * Given a DOCOL xt, find the address of the semis word at the end
- * of the word definition by searching all vocabularies */
-
-ucell findsemis(ucell xt)
-{
- ucell usesvocab = findword("vocabularies?") + sizeof(cell);
- unsigned int i;
-
- if (read_ucell(cell2pointer(usesvocab))) {
- /* Vocabularies are in use, so search each one in turn */
- ucell numvocabs = findword("#order") + sizeof(cell);
-
- for (i = 0; i < read_ucell(cell2pointer(numvocabs)); i++) {
- ucell vocabs = findword("vocabularies") + 2 * sizeof(cell);
- ucell semis = findsemis_wordlist(xt, read_cell(cell2pointer(vocabs + (i * sizeof(cell)))));
-
- /* If we get a non-zero result, we found the xt in this vocab */
- if (semis)
- return semis;
- }
- } else {
- /* Vocabularies not in use */
- return findsemis_wordlist(xt, read_ucell(last));
- }
-
- return 0;
-}
-
-
-/* findxtfromcell_wordlist
- * Given a cell and a wordlist, determine the CFA of the word containing
- * the cell or 0 if we are unable to return a suitable CFA
- */
-
-ucell findxtfromcell_wordlist(ucell incell, ucell wordlist)
-{
- ucell tmplfa;
-
- if (!wordlist)
- return 0;
-
- tmplfa = read_ucell(cell2pointer(wordlist));
- while (tmplfa) {
- if (tmplfa < incell)
- return lfa2cfa(tmplfa);
-
- tmplfa = read_ucell(cell2pointer(tmplfa));
- }
-
- return 0;
-}
-
-
-/* findxtfromcell
- * Given a cell, determine the CFA of the word containing
- * the cell by searching all vocabularies
- */
-
-ucell findxtfromcell(ucell incell)
-{
- ucell usesvocab = findword("vocabularies?") + sizeof(cell);
- unsigned int i;
-
- if (read_ucell(cell2pointer(usesvocab))) {
- /* Vocabularies are in use, so search each one in turn */
- ucell numvocabs = findword("#order") + sizeof(cell);
-
- for (i = 0; i < read_ucell(cell2pointer(numvocabs)); i++) {
- ucell vocabs = findword("vocabularies") + 2 * sizeof(cell);
- ucell semis = findxtfromcell_wordlist(incell, read_cell(cell2pointer(vocabs + (i * sizeof(cell)))));
-
- /* If we get a non-zero result, we found the xt in this vocab */
- if (semis)
- return semis;
- }
- } else {
- /* Vocabularies not in use */
- return findxtfromcell_wordlist(incell, read_ucell(last));
- }
-
- return 0;
-}
-
-void dump_header(dictionary_header_t *header)
-{
- printk("OpenBIOS dictionary:\n");
- printk(" version: %d\n", header->version);
- printk(" cellsize: %d\n", header->cellsize);
- printk(" endianess: %s\n", header->endianess?"big":"little");
- printk(" compression: %s\n", header->compression?"yes":"no");
- printk(" relocation: %s\n", header->relocation?"yes":"no");
- printk(" checksum: %08x\n", target_long(header->checksum));
- printk(" length: %08x\n", target_long(header->length));
- printk(" last: %0" FMT_CELL_x "\n", target_cell(header->last));
-}
-
-ucell load_dictionary(const char *data, ucell len)
-{
- u32 checksum=0;
- const char *checksum_walk;
- ucell *walk, *reloc_table;
- dictionary_header_t *header=(dictionary_header_t *)data;
-
- /* assertions */
- if (len <= (sizeof(dictionary_header_t)) || strncmp(DICTID, data, 8))
- return 0;
-#ifdef CONFIG_DEBUG_DICTIONARY
- dump_header(header);
-#endif
-
- checksum_walk=data;
- while (checksum_walk<data+len) {
- checksum+=read_long(checksum_walk);
- checksum_walk+=sizeof(u32);
- }
-
- if(checksum) {
- printk("Checksum invalid (%08x)!\n", checksum);
- return 0;
- }
-
- data += sizeof(dictionary_header_t);
-
- dicthead = target_long(header->length);
-
- memcpy(dict, data, dicthead);
- reloc_table=(ucell *)(data+dicthead);
-
-#ifdef CONFIG_DEBUG_DICTIONARY
- printk("\nmoving dictionary (%x bytes) to %x\n",
- (ucell)dicthead, (ucell)dict);
- printk("\ndynamic relocation...");
-#endif
-
- for (walk = (ucell *) dict; walk < (ucell *) (dict + dicthead);
- walk++) {
- int pos, bit, l;
- l=(walk-(ucell *)dict);
- pos=l/BITS;
- bit=l&~(-BITS);
- if (reloc_table[pos] & target_ucell((ucell)1ULL << bit)) {
- // printk("%lx, pos %x, bit %d\n",*walk, pos, bit);
- write_ucell(walk, read_ucell(walk)+pointer2cell(dict));
- }
- }
-
-#ifdef CONFIG_DEBUG_DICTIONARY
- printk(" done.\n");
-#endif
-
- last = (ucell *)(dict + target_ucell(header->last));
-
- return -1;
-}
diff --git a/qemu/roms/openbios/kernel/forth.c b/qemu/roms/openbios/kernel/forth.c
deleted file mode 100644
index 61dd70d31..000000000
--- a/qemu/roms/openbios/kernel/forth.c
+++ /dev/null
@@ -1,1966 +0,0 @@
-/* tag: C implementation of all forth primitives,
- * internal words, inner interpreter and such
- *
- * Copyright (C) 2003 Patrick Mauritz, Stefan Reinauer
- *
- * See the file "COPYING" for further information about
- * the copyright and warranty status of this work.
- */
-
-#include "config.h"
-#include "sysinclude.h"
-#include "kernel/stack.h"
-#include "kernel/kernel.h"
-#include "dict.h"
-
-/*
- * cross platform abstraction
- */
-
-#include "cross.h"
-
-#ifndef FCOMPILER
-#include "libc/vsprintf.h"
-#else
-#include <stdarg.h>
-#endif
-
-/*
- * execution works as follows:
- * - PC is pushed on return stack
- * - PC is set to new CFA
- * - address pointed by CFA is executed by CPU
- */
-
-typedef void forth_word(void);
-
-static forth_word * const words[];
-ucell PC;
-volatile int interruptforth = 0;
-
-#define DEBUG_MODE_NONE 0
-#define DEBUG_MODE_STEP 1
-#define DEBUG_MODE_TRACE 2
-#define DEBUG_MODE_STEPUP 3
-
-#define DEBUG_BANNER "\nStepper keys: <space>/<enter> Up Down Trace Rstack Forth\n"
-
-/* Empty linked list of debug xts */
-struct debug_xt {
- ucell xt_docol;
- ucell xt_semis;
- int mode;
- struct debug_xt *next;
-};
-
-static struct debug_xt debug_xt_eol = { (ucell)0, (ucell)0, 0, NULL};
-static struct debug_xt *debug_xt_list = &debug_xt_eol;
-
-/* Static buffer for xt name */
-char xtname[MAXNFALEN];
-
-#ifndef FCOMPILER
-/* instead of pointing to an explicit 0 variable we
- * point behind the pointer.
- */
-static ucell t[] = { 0, 0, 0, 0 };
-static ucell *trampoline = t;
-
-/*
- * Code Field Address (CFA) definitions (DOCOL and the like)
- */
-
-void forth_init(void)
-{
- init_trampoline(trampoline);
-}
-#endif
-
-#ifndef CONFIG_DEBUG_INTERPRETER
-#define dbg_interp_printk( a... ) do { } while(0)
-#else
-#define dbg_interp_printk( a... ) printk( a )
-#endif
-
-#ifndef CONFIG_DEBUG_INTERNAL
-#define dbg_internal_printk( a... ) do { } while(0)
-#else
-#define dbg_internal_printk( a... ) printk( a )
-#endif
-
-
-void init_trampoline(ucell *tramp)
-{
- tramp[0] = DOCOL;
- tramp[1] = 0;
- tramp[2] = target_ucell(pointer2cell(tramp) + 3 * sizeof(ucell));
- tramp[3] = 0;
-}
-
-static inline void processxt(ucell xt)
-{
- void (*tokenp) (void);
-
- dbg_interp_printk("processxt: pc=%x, xt=%x\n", PC, xt);
- tokenp = words[xt];
- tokenp();
-}
-
-static void docol(void)
-{ /* DOCOL */
- PUSHR(PC);
- PC = read_ucell(cell2pointer(PC));
-
- dbg_interp_printk("docol: %s\n", cell2pointer( lfa2nfa(PC - sizeof(cell)) ));
-}
-
-static void semis(void)
-{
- PC = POPR();
-}
-
-static inline void next(void)
-{
- PC += sizeof(ucell);
-
- dbg_interp_printk("next: PC is now %x\n", PC);
- processxt(read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))));
-}
-
-static inline void next_dbg(void);
-
-int enterforth(xt_t xt)
-{
- ucell *_cfa = (ucell*)cell2pointer(xt);
- cell tmp;
-
- if (read_ucell(_cfa) != DOCOL) {
- trampoline[1] = target_ucell(xt);
- _cfa = trampoline;
- }
-
- if (rstackcnt < 0) {
- rstackcnt = 0;
- }
-
- tmp = rstackcnt;
- interruptforth = FORTH_INTSTAT_CLR;
-
- PUSHR(PC);
- PC = pointer2cell(_cfa);
-
- while (rstackcnt > tmp && !(interruptforth & FORTH_INTSTAT_STOP)) {
- if (debug_xt_list->next == NULL) {
- while (rstackcnt > tmp && !interruptforth) {
- dbg_interp_printk("enterforth: NEXT\n");
- next();
- }
- } else {
- while (rstackcnt > tmp && !interruptforth) {
- dbg_interp_printk("enterforth: NEXT_DBG\n");
- next_dbg();
- }
- }
-
- /* Always clear the debug mode change flag */
- interruptforth = interruptforth & (~FORTH_INTSTAT_DBG);
- }
-
-#if 0
- /* return true if we took an exception. The caller should normally
- * handle exceptions by returning immediately since the throw
- * is supposed to abort the execution of this C-code too.
- */
-
- if (rstackcnt != tmp) {
- printk("EXCEPTION DETECTED!\n");
- }
-#endif
- return rstackcnt != tmp;
-}
-
-/* called inline thus a slightly different behaviour */
-static void lit(void)
-{ /* LIT */
- PC += sizeof(cell);
- PUSH(read_ucell(cell2pointer(PC)));
- dbg_interp_printk("lit: %x\n", read_ucell(cell2pointer(PC)));
-}
-
-static void docon(void)
-{ /* DOCON */
- ucell tmp = read_ucell(cell2pointer(read_ucell(cell2pointer(PC)) + sizeof(ucell)));
- PUSH(tmp);
- dbg_interp_printk("docon: PC=%x, value=%x\n", PC, tmp);
-}
-
-static void dovar(void)
-{ /* DOVAR */
- ucell tmp = read_ucell(cell2pointer(PC)) + sizeof(ucell);
- PUSH(tmp); /* returns address to variable */
- dbg_interp_printk("dovar: PC: %x, %x\n", PC, tmp);
-}
-
-static void dobranch(void)
-{ /* unconditional branch */
- PC += sizeof(cell);
- PC += read_cell(cell2pointer(PC));
-}
-
-static void docbranch(void)
-{ /* conditional branch */
- PC += sizeof(cell);
- if (POP()) {
- dbg_internal_printk(" ?branch: end loop\n");
- } else {
- dbg_internal_printk(" ?branch: follow branch\n");
- PC += read_cell(cell2pointer(PC));
- }
-}
-
-
-static void execute(void)
-{ /* EXECUTE */
- ucell address = POP();
- dbg_interp_printk("execute: %x\n", address);
-
- PUSHR(PC);
- trampoline[1] = target_ucell(address);
- PC = pointer2cell(trampoline);
-}
-
-/*
- * call ( ... function-ptr -- ??? )
- */
-static void call(void)
-{
-#ifdef FCOMPILER
- printk("Sorry. Usage of Forth2C binding is forbidden during bootstrap.\n");
- exit(1);
-#else
- void (*funcptr) (void);
- funcptr=(void *)cell2pointer(POP());
- dbg_interp_printk("call: %x", funcptr);
- funcptr();
-#endif
-}
-
-/*
- * sys-debug ( errno -- )
- */
-
-static void sysdebug(void)
-{
-#ifdef FCOMPILER
- cell errorno=POP();
- exception(errorno);
-#else
- (void) POP();
-#endif
-}
-
-static void dodoes(void)
-{ /* DODOES */
- ucell data = read_ucell(cell2pointer(PC)) + (2 * sizeof(ucell));
- ucell word = read_ucell(cell2pointer(read_ucell(cell2pointer(PC)) + sizeof(ucell)));
-
- dbg_interp_printk("DODOES data=%x word=%x\n", data, word);
-
- PUSH(data);
- PUSH(word);
-
- execute();
-}
-
-static void dodefer(void)
-{
- docol();
-}
-
-static void dodo(void)
-{
- cell startval, endval;
- startval = POP();
- endval = POP();
-
- PUSHR(endval);
- PUSHR(startval);
-}
-
-static void doisdo(void)
-{
- cell startval, endval, offset;
-
- startval = POP();
- endval = POP();
-
- PC += sizeof(cell);
-
- if (startval == endval) {
- offset = read_cell(cell2pointer(PC));
- PC += offset;
- } else {
- PUSHR(endval);
- PUSHR(startval);
- }
-}
-
-static void doloop(void)
-{
- cell offset, startval, endval;
-
- startval = POPR() + 1;
- endval = POPR();
-
- PC += sizeof(cell);
-
- if (startval < endval) {
- offset = read_cell(cell2pointer(PC));
- PC += offset;
- PUSHR(endval);
- PUSHR(startval);
- }
-
-}
-
-static void doplusloop(void)
-{
- ucell high, low;
- cell increment, startval, endval, offset;
-
- increment = POP();
-
- startval = POPR();
- endval = POPR();
-
- low = (ucell) startval;
- startval += increment;
-
- PC += sizeof(cell);
-
- if (increment >= 0) {
- high = (ucell) startval;
- } else {
- high = low;
- low = (ucell) startval;
- }
-
- if (endval - (low + 1) >= high - low) {
- offset = read_cell(cell2pointer(PC));
- PC += offset;
-
- PUSHR(endval);
- PUSHR(startval);
- }
-}
-
-/*
- * instance handling CFAs
- */
-#ifndef FCOMPILER
-static ucell get_myself(void)
-{
- static ucell *myselfptr = NULL;
- if (myselfptr == NULL) {
- myselfptr = (ucell*)cell2pointer(findword("my-self")) + 1;
- }
- ucell *myself = (ucell*)cell2pointer(*myselfptr);
- return (myself != NULL) ? *myself : 0;
-}
-
-static void doivar(void)
-{
- ucell r, *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell));
- ucell ibase = get_myself();
-
- dbg_interp_printk("ivar, offset: %d size: %d (ibase %d)\n", p[0], p[1], ibase );
-
- r = ibase ? ibase + p[0] : pointer2cell(&p[2]);
- PUSH( r );
-}
-
-static void doival(void)
-{
- ucell r, *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell));
- ucell ibase = get_myself();
-
- dbg_interp_printk("ivar, offset: %d size: %d\n", p[0], p[1] );
-
- r = ibase ? ibase + p[0] : pointer2cell(&p[2]);
- PUSH( *(ucell *)cell2pointer(r) );
-}
-
-static void doidefer(void)
-{
- ucell *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell));
- ucell ibase = get_myself();
-
- dbg_interp_printk("doidefer, offset: %d size: %d\n", p[0], p[1] );
-
- PUSHR(PC);
- PC = ibase ? ibase + p[0] : pointer2cell(&p[2]);
- PC -= sizeof(ucell);
-}
-#else
-static void noinstances(void)
-{
- printk("Opening devices is not supported during bootstrap. Sorry.\n");
- exit(1);
-}
-#define doivar noinstances
-#define doival noinstances
-#define doidefer noinstances
-#endif
-
-/*
- * $include / $encode-file
- */
-#ifdef FCOMPILER
-static void
-string_relay(void (*func)(const char *))
-{
- int len = POP();
- char *name, *p = (char*)cell2pointer(POP());
- name = malloc(len + 1);
- memcpy(name, p, len);
- name[len] = 0;
- (*func)(name);
- free(name);
-}
-#else
-#define string_relay(dummy) do { DROP(); DROP(); } while(0)
-#endif
-
-static void
-do_include(void)
-{
- string_relay(&include_file);
-}
-
-static void
-do_encode_file( void )
-{
- string_relay(&encode_file);
-}
-
-/*
- * Debug support functions
- */
-
-static
-int printf_console(const char *fmt, ...)
-{
- cell tmp;
-
- char buf[512];
- va_list args;
- int i;
-
- va_start(args, fmt);
- i = vsnprintf(buf, sizeof(buf), fmt, args);
- va_end(args);
-
- /* Push to the Forth interpreter for console output */
- tmp = rstackcnt;
-
- PUSH(pointer2cell(buf));
- PUSH((int)strlen(buf));
- trampoline[1] = findword("type");
-
- PUSHR(PC);
- PC = pointer2cell(trampoline);
-
- while (rstackcnt > tmp) {
- dbg_interp_printk("printf_console: NEXT\n");
- next();
- }
-
- return i;
-}
-
-static
-int getchar_console(void)
-{
- cell tmp;
-
- /* Push to the Forth interpreter for console output */
- tmp = rstackcnt;
-
- trampoline[1] = findword("key");
-
- PUSHR(PC);
- PC = pointer2cell(trampoline);
-
- while (rstackcnt > tmp) {
- dbg_interp_printk("getchar_console: NEXT\n");
- next();
- }
-
- return POP();
-}
-
-static void
-display_dbg_dstack(void)
-{
- /* Display dstack contents between parentheses */
- int i;
-
- if (dstackcnt == 0) {
- printf_console(" ( Empty ) ");
- return;
- } else {
- printf_console(" ( ");
- for (i = 1; i <= dstackcnt; i++) {
- if (i != 1) {
- printf_console(" ");
- }
- printf_console("%" FMT_CELL_x, dstack[i]);
- }
- printf_console(" ) ");
- }
-}
-
-static void
-display_dbg_rstack(void)
-{
- /* Display rstack contents between parentheses */
- int i;
-
- if (rstackcnt == 0) {
- printf_console(" ( Empty ) ");
- return;
- } else {
- printf_console("\nR: ( ");
- for (i = 1; i <= rstackcnt; i++) {
- if (i != 1) {
- printf_console(" ");
- }
- printf_console("%" FMT_CELL_x, rstack[i]);
- }
- printf_console(" ) \n");
- }
-}
-
-static int
-add_debug_xt(ucell xt)
-{
- struct debug_xt *debug_xt_item;
-
- /* If the xt CFA isn't DOCOL then issue a warning and do nothing */
- if (read_ucell(cell2pointer(xt)) != DOCOL) {
- printf_console("\nprimitive words cannot be debugged\n");
- return 0;
- }
-
- /* If this xt is already in the list, do nothing but indicate success */
- for (debug_xt_item = debug_xt_list; debug_xt_item->next != NULL;
- debug_xt_item = debug_xt_item->next)
- if (debug_xt_item->xt_docol == xt) {
- return 1;
- }
-
- /* We already have the CFA (PC) indicating the starting cell of
- the word, however we also need the ending cell too (we cannot
- rely on the rstack as it can be arbitrarily changed by a forth
- word). Hence the use of findsemis() */
-
- /* Otherwise add to the head of the linked list */
- debug_xt_item = malloc(sizeof(struct debug_xt));
- debug_xt_item->xt_docol = xt;
- debug_xt_item->xt_semis = findsemis(xt);
- debug_xt_item->mode = DEBUG_MODE_NONE;
- debug_xt_item->next = debug_xt_list;
- debug_xt_list = debug_xt_item;
-
- /* Indicate debug mode change */
- interruptforth |= FORTH_INTSTAT_DBG;
-
- /* Success */
- return 1;
-}
-
-static void
-del_debug_xt(ucell xt)
-{
- struct debug_xt *debug_xt_item, *tmp_xt_item;
-
- /* Handle the case where the xt is at the head of the list */
- if (debug_xt_list->xt_docol == xt) {
- tmp_xt_item = debug_xt_list;
- debug_xt_list = debug_xt_list->next;
- free(tmp_xt_item);
-
- return;
- }
-
- /* Otherwise find this xt in the linked list and remove it */
- for (debug_xt_item = debug_xt_list; debug_xt_item->next != NULL;
- debug_xt_item = debug_xt_item->next) {
- if (debug_xt_item->next->xt_docol == xt) {
- tmp_xt_item = debug_xt_item->next;
- debug_xt_item->next = debug_xt_item->next->next;
- free(tmp_xt_item);
- }
- }
-
- /* If the list is now empty, indicate debug mode change */
- if (debug_xt_list->next == NULL) {
- interruptforth |= FORTH_INTSTAT_DBG;
- }
-}
-
-static void
-do_source_dbg(struct debug_xt *debug_xt_item)
-{
- /* Forth source debugger implementation */
- char k, done = 0;
-
- /* Display current dstack */
- display_dbg_dstack();
- printf_console("\n");
-
- fstrncpy(xtname, lfa2nfa(read_ucell(cell2pointer(PC)) - sizeof(cell)), MAXNFALEN);
- printf_console("%p: %s ", cell2pointer(PC), xtname);
-
- /* If in trace mode, we just carry on */
- if (debug_xt_item->mode == DEBUG_MODE_TRACE) {
- return;
- }
-
- /* Otherwise in step mode, prompt for a keypress */
- k = getchar_console();
-
- /* Only proceed if done is true */
- while (!done) {
- switch (k) {
-
- case ' ':
- case '\n':
- /* Perform a single step */
- done = 1;
- break;
-
- case 'u':
- case 'U':
- /* Up - unmark current word for debug, mark its caller for
- * debugging and finish executing current word */
-
- /* Since this word could alter the rstack during its execution,
- * we only know the caller when (semis) is called for this xt.
- * Hence we mark the xt as a special DEBUG_MODE_STEPUP which
- * means we run as normal, but schedule the xt for deletion
- * at its corresponding (semis) word when we know the rstack
- * will be set to its final parent value */
- debug_xt_item->mode = DEBUG_MODE_STEPUP;
- done = 1;
- break;
-
- case 'd':
- case 'D':
- /* Down - mark current word for debug and step into it */
- done = add_debug_xt(read_ucell(cell2pointer(PC)));
- if (!done) {
- k = getchar_console();
- }
- break;
-
- case 't':
- case 'T':
- /* Trace mode */
- debug_xt_item->mode = DEBUG_MODE_TRACE;
- done = 1;
- break;
-
- case 'r':
- case 'R':
- /* Display rstack */
- display_dbg_rstack();
- done = 0;
- k = getchar_console();
- break;
-
- case 'f':
- case 'F':
- /* Start subordinate Forth interpreter */
- PUSHR(PC - sizeof(cell));
- PC = findword("outer-interpreter") + sizeof(ucell);
-
- /* Save rstack position for when we return */
- dbgrstackcnt = rstackcnt;
- done = 1;
- break;
-
- default:
- /* Display debug banner */
- printf_console(DEBUG_BANNER);
- k = getchar_console();
- }
- }
-}
-
-static void docol_dbg(void)
-{ /* DOCOL */
- struct debug_xt *debug_xt_item;
-
- PUSHR(PC);
- PC = read_ucell(cell2pointer(PC));
-
- /* If current xt is in our debug xt list, display word name */
- debug_xt_item = debug_xt_list;
- while (debug_xt_item->next) {
- if (debug_xt_item->xt_docol == PC) {
- fstrncpy(xtname, lfa2nfa(PC - sizeof(cell)), MAXNFALEN);
- printf_console("\n: %s ", xtname);
-
- /* Step mode is the default */
- debug_xt_item->mode = DEBUG_MODE_STEP;
- }
-
- debug_xt_item = debug_xt_item->next;
- }
-
- dbg_interp_printk("docol_dbg: %s\n", cell2pointer(lfa2nfa(PC - sizeof(cell))));
-}
-
-static void semis_dbg(void)
-{
- struct debug_xt *debug_xt_item, *debug_xt_up = NULL;
-
- /* If current semis is in our debug xt list, disable debug mode */
- debug_xt_item = debug_xt_list;
- while (debug_xt_item->next) {
- if (debug_xt_item->xt_semis == PC) {
- if (debug_xt_item->mode != DEBUG_MODE_STEPUP) {
- /* Handle the normal case */
- fstrncpy(xtname, lfa2nfa(debug_xt_item->xt_docol - sizeof(cell)), MAXNFALEN);
- printf_console("\n[ Finished %s ] ", xtname);
-
- /* Reset to step mode in case we were in trace mode */
- debug_xt_item->mode = DEBUG_MODE_STEP;
- } else {
- /* This word requires execution of the debugger "Up"
- * semantics. However we can't do this here since we
- * are iterating through the debug list, and we need
- * to change it. So we do it afterwards.
- */
- debug_xt_up = debug_xt_item;
- }
- }
-
- debug_xt_item = debug_xt_item->next;
- }
-
- /* Execute debugger "Up" semantics if required */
- if (debug_xt_up) {
- /* Only add the parent word if it is not within the trampoline */
- if (rstack[rstackcnt] != (cell)pointer2cell(&trampoline[1])) {
- del_debug_xt(debug_xt_up->xt_docol);
- add_debug_xt(findxtfromcell(rstack[rstackcnt]));
-
- fstrncpy(xtname, lfa2nfa(findxtfromcell(rstack[rstackcnt]) - sizeof(cell)), MAXNFALEN);
- printf_console("\n[ Up to %s ] ", xtname);
- } else {
- fstrncpy(xtname, lfa2nfa(findxtfromcell(debug_xt_up->xt_docol) - sizeof(cell)), MAXNFALEN);
- printf_console("\n[ Finished %s (Unable to go up, hit trampoline) ] ", xtname);
-
- del_debug_xt(debug_xt_up->xt_docol);
- }
-
- debug_xt_up = NULL;
- }
-
- PC = POPR();
-}
-
-static inline void next_dbg(void)
-{
- struct debug_xt *debug_xt_item;
- void (*tokenp) (void);
-
- PC += sizeof(ucell);
-
- /* If the PC lies within a debug range, run the source debugger */
- debug_xt_item = debug_xt_list;
- while (debug_xt_item->next) {
- if (PC >= debug_xt_item->xt_docol && PC <= debug_xt_item->xt_semis &&
- debug_xt_item->mode != DEBUG_MODE_STEPUP) {
- do_source_dbg(debug_xt_item);
- }
-
- debug_xt_item = debug_xt_item->next;
- }
-
- dbg_interp_printk("next_dbg: PC is now %x\n", PC);
-
- /* Intercept DOCOL and SEMIS and redirect to debug versions */
- if (read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))) == DOCOL) {
- tokenp = docol_dbg;
- tokenp();
- } else if (read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))) == DOSEMIS) {
- tokenp = semis_dbg;
- tokenp();
- } else {
- /* Otherwise process as normal */
- processxt(read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))));
- }
-}
-
-static void
-do_debug_xt(void)
-{
- ucell xt = POP();
-
- /* Add to the debug list */
- if (add_debug_xt(xt)) {
- /* Display debug banner */
- printf_console(DEBUG_BANNER);
-
- /* Indicate change to debug mode */
- interruptforth |= FORTH_INTSTAT_DBG;
- }
-}
-
-static void
-do_debug_off(void)
-{
- /* Empty the debug xt linked list */
- while (debug_xt_list->next != NULL) {
- del_debug_xt(debug_xt_list->xt_docol);
- }
-}
-
-/*
- * Forth primitives needed to set up
- * all the words described in IEEE1275-1994.
- */
-
-/*
- * dup ( x -- x x )
- */
-
-static void fdup(void)
-{
- const cell tmp = GETTOS();
- PUSH(tmp);
-}
-
-
-/*
- * 2dup ( x1 x2 -- x1 x2 x1 x2 )
- */
-
-static void twodup(void)
-{
- cell tmp = GETITEM(1);
- PUSH(tmp);
- tmp = GETITEM(1);
- PUSH(tmp);
-}
-
-
-/*
- * ?dup ( x -- 0 | x x )
- */
-
-static void isdup(void)
-{
- const cell tmp = GETTOS();
- if (tmp)
- PUSH(tmp);
-}
-
-
-/*
- * over ( x y -- x y x )
- */
-
-static void over(void)
-{
- const cell tmp = GETITEM(1);
- PUSH(tmp);
-}
-
-
-/*
- * 2over ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
- */
-
-static void twoover(void)
-{
- const cell tmp = GETITEM(3);
- const cell tmp2 = GETITEM(2);
- PUSH(tmp);
- PUSH(tmp2);
-}
-
-/*
- * pick ( xu ... x1 x0 u -- xu ... x1 x0 xu )
- */
-
-static void pick(void)
-{
- const cell u = POP();
- if (dstackcnt >= u) {
- ucell tmp = dstack[dstackcnt - u];
- PUSH(tmp);
- } else {
- /* underrun */
- }
-}
-
-
-/*
- * drop ( x -- )
- */
-
-static void drop(void)
-{
- POP();
-}
-
-/*
- * 2drop ( x1 x2 -- )
- */
-
-static void twodrop(void)
-{
- POP();
- POP();
-}
-
-
-/*
- * nip ( x1 x2 -- x2 )
- */
-
-static void nip(void)
-{
- const cell tmp = POP();
- POP();
- PUSH(tmp);
-}
-
-
-/*
- * roll ( xu ... x1 x0 u -- xu-1... x1 x0 xu )
- */
-
-static void roll(void)
-{
- const cell u = POP();
- if (dstackcnt >= u) {
- int i;
- const cell xu = dstack[dstackcnt - u];
- for (i = dstackcnt - u; i < dstackcnt; i++) {
- dstack[i] = dstack[i + 1];
- }
- dstack[dstackcnt] = xu;
- } else {
- /* Stack underrun */
- }
-}
-
-
-/*
- * rot ( x1 x2 x3 -- x2 x3 x1 )
- */
-
-static void rot(void)
-{
- const cell tmp = POP();
- const cell tmp2 = POP();
- const cell tmp3 = POP();
- PUSH(tmp2);
- PUSH(tmp);
- PUSH(tmp3);
-}
-
-
-/*
- * -rot ( x1 x2 x3 -- x3 x1 x2 )
- */
-
-static void minusrot(void)
-{
- const cell tmp = POP();
- const cell tmp2 = POP();
- const cell tmp3 = POP();
- PUSH(tmp);
- PUSH(tmp3);
- PUSH(tmp2);
-}
-
-
-/*
- * swap ( x1 x2 -- x2 x1 )
- */
-
-static void swap(void)
-{
- const cell tmp = POP();
- const cell tmp2 = POP();
- PUSH(tmp);
- PUSH(tmp2);
-}
-
-
-/*
- * 2swap ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
- */
-
-static void twoswap(void)
-{
- const cell tmp = POP();
- const cell tmp2 = POP();
- const cell tmp3 = POP();
- const cell tmp4 = POP();
- PUSH(tmp2);
- PUSH(tmp);
- PUSH(tmp4);
- PUSH(tmp3);
-}
-
-
-/*
- * >r ( x -- ) (R: -- x )
- */
-
-static void tor(void)
-{
- ucell tmp = POP();
-#ifdef CONFIG_DEBUG_RSTACK
- printk(" >R: %x\n", tmp);
-#endif
- PUSHR(tmp);
-}
-
-
-/*
- * r> ( -- x ) (R: x -- )
- */
-
-static void rto(void)
-{
- ucell tmp = POPR();
-#ifdef CONFIG_DEBUG_RSTACK
- printk(" R>: %x\n", tmp);
-#endif
- PUSH(tmp);
-}
-
-
-/*
- * r@ ( -- x ) (R: x -- x )
- */
-
-static void rfetch(void)
-{
- PUSH(GETTORS());
-}
-
-
-/*
- * depth ( -- u )
- */
-
-static void depth(void)
-{
- const cell tmp = dstackcnt;
- PUSH(tmp);
-}
-
-
-/*
- * depth! ( ... u -- x1 x2 .. xu )
- */
-
-static void depthwrite(void)
-{
- ucell tmp = POP();
- dstackcnt = tmp;
-}
-
-
-/*
- * rdepth ( -- u )
- */
-
-static void rdepth(void)
-{
- const cell tmp = rstackcnt;
- PUSH(tmp);
-}
-
-
-/*
- * rdepth! ( u -- ) ( R: ... -- x1 x2 .. xu )
- */
-
-static void rdepthwrite(void)
-{
- ucell tmp = POP();
- rstackcnt = tmp;
-}
-
-
-/*
- * + ( nu1 nu2 -- sum )
- */
-
-static void plus(void)
-{
- cell tmp = POP() + POP();
- PUSH(tmp);
-}
-
-
-/*
- * - ( nu1 nu2 -- diff )
- */
-
-static void minus(void)
-{
- const cell nu2 = POP();
- const cell nu1 = POP();
- PUSH(nu1 - nu2);
-}
-
-
-/*
- * * ( nu1 nu2 -- prod )
- */
-
-static void mult(void)
-{
- const cell nu2 = POP();
- const cell nu1 = POP();
- PUSH(nu1 * nu2);
-}
-
-
-/*
- * u* ( u1 u2 -- prod )
- */
-
-static void umult(void)
-{
- const ucell tmp = (ucell) POP() * (ucell) POP();
- PUSH(tmp);
-}
-
-
-/*
- * mu/mod ( n1 n2 -- rem quot.l quot.h )
- */
-
-static void mudivmod(void)
-{
- const ucell b = POP();
- const ducell a = DPOP();
-#ifdef NEED_FAKE_INT128_T
- if (a.hi != 0) {
- fprintf(stderr, "mudivmod called (0x%016llx %016llx / 0x%016llx)\n",
- a.hi, a.lo, b);
- exit(-1);
- } else {
- ducell c;
-
- PUSH(a.lo % b);
- c.hi = 0;
- c.lo = a.lo / b;
- DPUSH(c);
- }
-#else
- PUSH(a % b);
- DPUSH(a / b);
-#endif
-}
-
-
-/*
- * abs ( n -- u )
- */
-
-static void forthabs(void)
-{
- const cell tmp = GETTOS();
- if (tmp < 0) {
- POP();
- PUSH(-tmp);
- }
-}
-
-
-/*
- * negate ( n1 -- n2 )
- */
-
-static void negate(void)
-{
- const cell tmp = POP();
- PUSH(-tmp);
-}
-
-
-/*
- * max ( n1 n2 -- n1|n2 )
- */
-
-static void max(void)
-{
- const cell tmp = POP();
- const cell tmp2 = POP();
- PUSH((tmp > tmp2) ? tmp : tmp2);
-}
-
-
-/*
- * min ( n1 n2 -- n1|n2 )
- */
-
-static void min(void)
-{
- const cell tmp = POP();
- const cell tmp2 = POP();
- PUSH((tmp < tmp2) ? tmp : tmp2);
-}
-
-
-/*
- * lshift ( x1 u -- x2 )
- */
-
-static void lshift(void)
-{
- const ucell u = POP();
- const ucell x1 = POP();
- PUSH(x1 << u);
-}
-
-
-/*
- * rshift ( x1 u -- x2 )
- */
-
-static void rshift(void)
-{
- const ucell u = POP();
- const ucell x1 = POP();
- PUSH(x1 >> u);
-}
-
-
-/*
- * >>a ( x1 u -- x2 ) ??
- */
-
-static void rshifta(void)
-{
- const cell u = POP();
- const cell x1 = POP();
- PUSH(x1 >> u);
-}
-
-
-/*
- * and ( x1 x2 -- x3 )
- */
-
-static void and(void)
-{
- const cell x1 = POP();
- const cell x2 = POP();
- PUSH(x1 & x2);
-}
-
-
-/*
- * or ( x1 x2 -- x3 )
- */
-
-static void or(void)
-{
- const cell x1 = POP();
- const cell x2 = POP();
- PUSH(x1 | x2);
-}
-
-
-/*
- * xor ( x1 x2 -- x3 )
- */
-
-static void xor(void)
-{
- const cell x1 = POP();
- const cell x2 = POP();
- PUSH(x1 ^ x2);
-}
-
-
-/*
- * invert ( x1 -- x2 )
- */
-
-static void invert(void)
-{
- const cell x1 = POP();
- PUSH(x1 ^ -1);
-}
-
-
-/*
- * d+ ( d1 d2 -- d.sum )
- */
-
-static void dplus(void)
-{
- const dcell d2 = DPOP();
- const dcell d1 = DPOP();
-#ifdef NEED_FAKE_INT128_T
- ducell c;
-
- if (d1.hi != 0 || d2.hi != 0) {
- fprintf(stderr, "dplus called (0x%016llx %016llx + 0x%016llx %016llx)\n",
- d1.hi, d1.lo, d2.hi, d2.lo);
- exit(-1);
- }
- c.hi = 0;
- c.lo = d1.lo + d2.lo;
- DPUSH(c);
-#else
- DPUSH(d1 + d2);
-#endif
-}
-
-
-/*
- * d- ( d1 d2 -- d.diff )
- */
-
-static void dminus(void)
-{
- const dcell d2 = DPOP();
- const dcell d1 = DPOP();
-#ifdef NEED_FAKE_INT128_T
- ducell c;
-
- if (d1.hi != 0 || d2.hi != 0) {
- fprintf(stderr, "dminus called (0x%016llx %016llx + 0x%016llx %016llx)\n",
- d1.hi, d1.lo, d2.hi, d2.lo);
- exit(-1);
- }
- c.hi = 0;
- c.lo = d1.lo - d2.lo;
- DPUSH(c);
-#else
- DPUSH(d1 - d2);
-#endif
-}
-
-
-/*
- * m* ( ?? -- )
- */
-
-static void mmult(void)
-{
- const cell u2 = POP();
- const cell u1 = POP();
-#ifdef NEED_FAKE_INT128_T
- ducell c;
-
- if (0) { // XXX How to detect overflow?
- fprintf(stderr, "mmult called (%016llx * 0x%016llx)\n", u1, u2);
- exit(-1);
- }
- c.hi = 0;
- c.lo = u1 * u2;
- DPUSH(c);
-#else
- DPUSH((dcell) u1 * u2);
-#endif
-}
-
-
-/*
- * um* ( u1 u2 -- d.prod )
- */
-
-static void ummult(void)
-{
- const ucell u2 = POP();
- const ucell u1 = POP();
-#ifdef NEED_FAKE_INT128_T
- ducell c;
-
- if (0) { // XXX How to detect overflow?
- fprintf(stderr, "ummult called (%016llx * 0x%016llx)\n", u1, u2);
- exit(-1);
- }
- c.hi = 0;
- c.lo = u1 * u2;
- DPUSH(c);
-#else
- DPUSH((ducell) u1 * u2);
-#endif
-}
-
-
-/*
- * @ ( a-addr -- x )
- */
-
-static void fetch(void)
-{
- const ucell *aaddr = (ucell *)cell2pointer(POP());
- PUSH(read_ucell(aaddr));
-}
-
-
-/*
- * c@ ( addr -- byte )
- */
-
-static void cfetch(void)
-{
- const u8 *aaddr = (u8 *)cell2pointer(POP());
- PUSH(read_byte(aaddr));
-}
-
-
-/*
- * w@ ( waddr -- w )
- */
-
-static void wfetch(void)
-{
- const u16 *aaddr = (u16 *)cell2pointer(POP());
- PUSH(read_word(aaddr));
-}
-
-
-/*
- * l@ ( qaddr -- quad )
- */
-
-static void lfetch(void)
-{
- const u32 *aaddr = (u32 *)cell2pointer(POP());
- PUSH(read_long(aaddr));
-}
-
-
-/*
- * ! ( x a-addr -- )
- */
-
-static void store(void)
-{
- const ucell *aaddr = (ucell *)cell2pointer(POP());
- const ucell x = POP();
-#ifdef CONFIG_DEBUG_INTERNAL
- printk("!: %lx : %lx -> %lx\n", aaddr, read_ucell(aaddr), x);
-#endif
- write_ucell(aaddr,x);
-}
-
-
-/*
- * +! ( nu a-addr -- )
- */
-
-static void plusstore(void)
-{
- const ucell *aaddr = (ucell *)cell2pointer(POP());
- const cell nu = POP();
- write_cell(aaddr,read_cell(aaddr)+nu);
-}
-
-
-/*
- * c! ( byte addr -- )
- */
-
-static void cstore(void)
-{
- const u8 *aaddr = (u8 *)cell2pointer(POP());
- const ucell byte = POP();
-#ifdef CONFIG_DEBUG_INTERNAL
- printk("c!: %x = %x\n", aaddr, byte);
-#endif
- write_byte(aaddr, byte);
-}
-
-
-/*
- * w! ( w waddr -- )
- */
-
-static void wstore(void)
-{
- const u16 *aaddr = (u16 *)cell2pointer(POP());
- const u16 word = POP();
- write_word(aaddr, word);
-}
-
-
-/*
- * l! ( quad qaddr -- )
- */
-
-static void lstore(void)
-{
- const u32 *aaddr = (u32 *)cell2pointer(POP());
- const u32 longval = POP();
- write_long(aaddr, longval);
-}
-
-
-/*
- * = ( x1 x2 -- equal? )
- */
-
-static void equals(void)
-{
- cell tmp = (POP() == POP());
- PUSH(-tmp);
-}
-
-
-/*
- * > ( n1 n2 -- greater? )
- */
-
-static void greater(void)
-{
- cell tmp = ((cell) POP() < (cell) POP());
- PUSH(-tmp);
-}
-
-
-/*
- * < ( n1 n2 -- less? )
- */
-
-static void less(void)
-{
- cell tmp = ((cell) POP() > (cell) POP());
- PUSH(-tmp);
-}
-
-
-/*
- * u> ( u1 u2 -- unsigned-greater? )
- */
-
-static void ugreater(void)
-{
- cell tmp = ((ucell) POP() < (ucell) POP());
- PUSH(-tmp);
-}
-
-
-/*
- * u< ( u1 u2 -- unsigned-less? )
- */
-
-static void uless(void)
-{
- cell tmp = ((ucell) POP() > (ucell) POP());
- PUSH(-tmp);
-}
-
-
-/*
- * sp@ ( -- stack-pointer )
- */
-
-static void spfetch(void)
-{
- // FIXME this can only work if the stack pointer
- // is within range.
- ucell tmp = pointer2cell(&(dstack[dstackcnt]));
- PUSH(tmp);
-}
-
-
-/*
- * move ( src-addr dest-addr len -- )
- */
-
-static void fmove(void)
-{
- ucell count = POP();
- void *dest = (void *)cell2pointer(POP());
- const void *src = (const void *)cell2pointer(POP());
- memmove(dest, src, count);
-}
-
-
-/*
- * fill ( addr len byte -- )
- */
-
-static void ffill(void)
-{
- ucell value = POP();
- ucell count = POP();
- void *src = (void *)cell2pointer(POP());
- memset(src, value, count);
-}
-
-
-/*
- * unaligned-w@ ( addr -- w )
- */
-
-static void unalignedwordread(void)
-{
- const unsigned char *addr = (const unsigned char *) cell2pointer(POP());
- PUSH(unaligned_read_word(addr));
-}
-
-
-/*
- * unaligned-w! ( w addr -- )
- */
-
-static void unalignedwordwrite(void)
-{
- const unsigned char *addr = (const unsigned char *) cell2pointer(POP());
- u16 w = POP();
- unaligned_write_word(addr, w);
-}
-
-
-/*
- * unaligned-l@ ( addr -- quad )
- */
-
-static void unalignedlongread(void)
-{
- const unsigned char *addr = (const unsigned char *) cell2pointer(POP());
- PUSH(unaligned_read_long(addr));
-}
-
-
-/*
- * unaligned-l! ( quad addr -- )
- */
-
-static void unalignedlongwrite(void)
-{
- unsigned char *addr = (unsigned char *) cell2pointer(POP());
- u32 l = POP();
- unaligned_write_long(addr, l);
-}
-
-/*
- * here ( -- dictionary-pointer )
- */
-
-static void here(void)
-{
- PUSH(pointer2cell(dict) + dicthead);
-#ifdef CONFIG_DEBUG_INTERNAL
- printk("here: %x\n", pointer2cell(dict) + dicthead);
-#endif
-}
-
-/*
- * here! ( new-dict-pointer -- )
- */
-
-static void herewrite(void)
-{
- ucell tmp = POP(); /* converted pointer */
- dicthead = tmp - pointer2cell(dict);
-#ifdef CONFIG_DEBUG_INTERNAL
- printk("here!: new value: %x\n", tmp);
-#endif
-
- if (dictlimit && dicthead >= dictlimit) {
- printk("Dictionary space overflow:"
- " dicthead=" FMT_ucellx
- " dictlimit=" FMT_ucellx
- "\n",
- dicthead, dictlimit);
- }
-}
-
-
-/*
- * emit ( char -- )
- */
-
-static void emit(void)
-{
- cell tmp = POP();
-#ifndef FCOMPILER
- putchar(tmp);
-#else
- put_outputbyte(tmp);
-#endif
-}
-
-
-/*
- * key? ( -- pressed? )
- */
-
-static void iskey(void)
-{
- PUSH((cell) availchar());
-}
-
-
-/*
- * key ( -- char )
- */
-
-static void key(void)
-{
- while (!availchar());
-#ifdef FCOMPILER
- PUSH(get_inputbyte());
-#else
- PUSH(getchar());
-#endif
-}
-
-
-/*
- * ioc@ ( reg -- val )
- */
-
-static void iocfetch(void)
-{
-#ifndef FCOMPILER
- cell reg = POP();
- PUSH(inb(reg));
-#else
- (void)POP();
- PUSH(0);
-#endif
-}
-
-
-/*
- * iow@ ( reg -- val )
- */
-
-static void iowfetch(void)
-{
-#ifndef FCOMPILER
- cell reg = POP();
- PUSH(inw(reg));
-#else
- (void)POP();
- PUSH(0);
-#endif
-}
-
-/*
- * iol@ ( reg -- val )
- */
-
-static void iolfetch(void)
-{
-#ifndef FCOMPILER
- cell reg = POP();
- PUSH(inl(reg));
-#else
- (void)POP();
- PUSH(0);
-#endif
-}
-
-
-/*
- * ioc! ( val reg -- )
- */
-
-static void iocstore(void)
-{
-#ifndef FCOMPILER
- cell reg = POP();
- cell val = POP();
-
- outb(val, reg);
-#else
- (void)POP();
- (void)POP();
-#endif
-}
-
-
-/*
- * iow! ( val reg -- )
- */
-
-static void iowstore(void)
-{
-#ifndef FCOMPILER
- cell reg = POP();
- cell val = POP();
-
- outw(val, reg);
-#else
- (void)POP();
- (void)POP();
-#endif
-}
-
-
-/*
- * iol! ( val reg -- )
- */
-
-static void iolstore(void)
-{
-#ifndef FCOMPILER
- ucell reg = POP();
- ucell val = POP();
-
- outl(val, reg);
-#else
- (void)POP();
- (void)POP();
-#endif
-}
-
-/*
- * i ( -- i )
- */
-
-static void loop_i(void)
-{
- PUSH(rstack[rstackcnt]);
-}
-
-/*
- * j ( -- i )
- */
-
-static void loop_j(void)
-{
- PUSH(rstack[rstackcnt - 2]);
-}
-
-/* words[] is a function array of all native code functions used by
- * the dictionary, i.e. CFAs and primitives.
- * Any change here needs a matching change in the primitive word's
- * name list that is kept for bootstrapping in kernel/bootstrap.c
- *
- * NOTE: THIS LIST SHALL NOT CHANGE (EXCEPT MANDATORY ADDITIONS AT
- * THE END). ANY OTHER CHANGE WILL BREAK COMPATIBILITY TO OLDER
- * BINARY DICTIONARIES.
- */
-static forth_word * const words[] = {
- /*
- * CFAs and special words
- */
- semis,
- docol,
- lit,
- docon,
- dovar,
- dodefer,
- dodoes,
- dodo,
- doisdo,
- doloop,
- doplusloop,
- doival,
- doivar,
- doidefer,
-
- /*
- * primitives
- */
- fdup, /* dup */
- twodup, /* 2dup */
- isdup, /* ?dup */
- over, /* over */
- twoover, /* 2over */
- pick, /* pick */
- drop, /* drop */
- twodrop, /* 2drop */
- nip, /* nip */
- roll, /* roll */
- rot, /* rot */
- minusrot, /* -rot */
- swap, /* swap */
- twoswap, /* 2swap */
- tor, /* >r */
- rto, /* r> */
- rfetch, /* r@ */
- depth, /* depth */
- depthwrite, /* depth! */
- rdepth, /* rdepth */
- rdepthwrite, /* rdepth! */
- plus, /* + */
- minus, /* - */
- mult, /* * */
- umult, /* u* */
- mudivmod, /* mu/mod */
- forthabs, /* abs */
- negate, /* negate */
- max, /* max */
- min, /* min */
- lshift, /* lshift */
- rshift, /* rshift */
- rshifta, /* >>a */
- and, /* and */
- or, /* or */
- xor, /* xor */
- invert, /* invert */
- dplus, /* d+ */
- dminus, /* d- */
- mmult, /* m* */
- ummult, /* um* */
- fetch, /* @ */
- cfetch, /* c@ */
- wfetch, /* w@ */
- lfetch, /* l@ */
- store, /* ! */
- plusstore, /* +! */
- cstore, /* c! */
- wstore, /* w! */
- lstore, /* l! */
- equals, /* = */
- greater, /* > */
- less, /* < */
- ugreater, /* u> */
- uless, /* u< */
- spfetch, /* sp@ */
- fmove, /* move */
- ffill, /* fill */
- emit, /* emit */
- iskey, /* key? */
- key, /* key */
- execute, /* execute */
- here, /* here */
- herewrite, /* here! */
- dobranch, /* dobranch */
- docbranch, /* do?branch */
- unalignedwordread, /* unaligned-w@ */
- unalignedwordwrite, /* unaligned-w! */
- unalignedlongread, /* unaligned-l@ */
- unalignedlongwrite, /* unaligned-l! */
- iocfetch, /* ioc@ */
- iowfetch, /* iow@ */
- iolfetch, /* iol@ */
- iocstore, /* ioc! */
- iowstore, /* iow! */
- iolstore, /* iol! */
- loop_i, /* i */
- loop_j, /* j */
- call, /* call */
- sysdebug, /* sys-debug */
- do_include, /* $include */
- do_encode_file, /* $encode-file */
- do_debug_xt, /* (debug */
- do_debug_off, /* (debug-off) */
-};
diff --git a/qemu/roms/openbios/kernel/include/dict.h b/qemu/roms/openbios/kernel/include/dict.h
deleted file mode 100644
index 749fd6fba..000000000
--- a/qemu/roms/openbios/kernel/include/dict.h
+++ /dev/null
@@ -1,59 +0,0 @@
-/* tag: dict management headers
- *
- * Copyright (C) 2003 Patrick Mauritz, Stefan Reinauer
- *
- * See the file "COPYING" for further information about
- * the copyright and warranty status of this work.
- */
-
-#ifndef __DICT_H
-#define __DICT_H
-
-#define DICTID "OpenBIOS"
-
-#define DOSEMIS 0
-#define DOCOL 1
-#define DOLIT 2
-#define DOCON 3
-#define DOVAR 4
-#define DODFR 5
-#define DODOES 6
-
-#define MAXNFALEN 128
-
-/* The header is 28/32 bytes on 32/64bit platforms */
-
-typedef struct dictionary_header {
- char signature[8];
- u8 version;
- u8 cellsize;
- u8 endianess;
- u8 compression;
- u8 relocation;
- u8 reserved[3];
- u32 checksum;
- u32 length;
- ucell last;
-} __attribute__((packed)) dictionary_header_t;
-
-ucell lfa2nfa(ucell ilfa);
-ucell load_dictionary(const char *data, ucell len);
-void dump_header(dictionary_header_t *header);
-ucell fstrlen(ucell fstr);
-void fstrncpy(char *dest, ucell src, unsigned int maxlen);
-ucell findsemis(ucell xt);
-ucell findxtfromcell_wordlist(ucell incell, ucell wordlist);
-ucell findxtfromcell(ucell incell);
-
-/* program counter */
-extern ucell PC;
-
-extern unsigned char *dict;
-extern cell dicthead;
-extern cell dictlimit;
-extern ucell *last;
-#ifdef FCOMPILER
-extern ucell *trampoline;
-#endif
-
-#endif
diff --git a/qemu/roms/openbios/kernel/stack.c b/qemu/roms/openbios/kernel/stack.c
deleted file mode 100644
index f6715d1c3..000000000
--- a/qemu/roms/openbios/kernel/stack.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/* tag: defines the stacks, program counter and ways to access those
- *
- * Copyright (C) 2003 Patrick Mauritz, Stefan Reinauer
- *
- * See the file "COPYING" for further information about
- * the copyright and warranty status of this work.
- */
-
-
-#include "config.h"
-#include "kernel/stack.h"
-#include "cross.h"
-
-#define dstacksize 512
-int dstackcnt = 0;
-cell dstack[dstacksize];
-
-#define rstacksize 512
-int rstackcnt = 0;
-cell rstack[rstacksize];
-
-/* Rstack value saved before entering forth interpreter in debugger */
-int dbgrstackcnt = 0;
-
-#if defined(CONFIG_DEBUG_DSTACK) || defined(FCOMPILER)
-void printdstack(void)
-{
- int i;
- printk("dstack:");
- for (i = 0; i <= dstackcnt; i++) {
- printk(" 0x%" FMT_CELL_x , dstack[i]);
- }
- printk("\n");
-}
-#endif
-#if defined(CONFIG_DEBUG_RSTACK) || defined(FCOMPILER)
-void printrstack(void)
-{
- int i;
- printk("rstack:");
- for (i = 0; i <= rstackcnt; i++) {
- printk(" 0x%" FMT_CELL_x , rstack[i]);
- }
- printk("\n");
-}
-#endif