1119483Sobrien/*- 240875Smsmith * Copyright (c) 1998 Michael Smith <msmith@freebsd.org> 340875Smsmith * All rights reserved. 440875Smsmith * 540875Smsmith * Redistribution and use in source and binary forms, with or without 640875Smsmith * modification, are permitted provided that the following conditions 740875Smsmith * are met: 840875Smsmith * 1. Redistributions of source code must retain the above copyright 940875Smsmith * notice, this list of conditions and the following disclaimer. 1040875Smsmith * 2. Redistributions in binary form must reproduce the above copyright 1140875Smsmith * notice, this list of conditions and the following disclaimer in the 1240875Smsmith * documentation and/or other materials provided with the distribution. 1340875Smsmith * 1440875Smsmith * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 1540875Smsmith * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 1640875Smsmith * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 1740875Smsmith * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 1840875Smsmith * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 1940875Smsmith * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 2040875Smsmith * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 2140875Smsmith * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 2240875Smsmith * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 2340875Smsmith * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 2440875Smsmith * SUCH DAMAGE. 2540875Smsmith */ 2640875Smsmith 27119483Sobrien#include <sys/cdefs.h> 28119483Sobrien__FBSDID("$FreeBSD$"); 29119483Sobrien 3043077Smsmith#include <sys/param.h> /* to pick up __FreeBSD_version */ 3142290Speter#include <string.h> 3240875Smsmith#include <stand.h> 3340875Smsmith#include "bootstrap.h" 3440875Smsmith#include "ficl.h" 3540875Smsmith 3643077Smsmithextern char bootprog_rev[]; 3743077Smsmith 3840984Sjkh/* #define BFORTH_DEBUG */ 3940948Smsmith 4040948Smsmith#ifdef BFORTH_DEBUG 4187599Sobrien# define DEBUG(fmt, args...) printf("%s: " fmt "\n" , __func__ , ## args) 4240948Smsmith#else 4340948Smsmith# define DEBUG(fmt, args...) 4440948Smsmith#endif 4540948Smsmith 4640875Smsmith/* 4743077Smsmith * Eventually, all builtin commands throw codes must be defined 4843077Smsmith * elsewhere, possibly bootstrap.h. For now, just this code, used 4943077Smsmith * just in this file, it is getting defined. 5043077Smsmith */ 5143077Smsmith#define BF_PARSE 100 5243077Smsmith 5343077Smsmith/* 54245148Sgrehan * FreeBSD loader default dictionary cells 55245148Sgrehan */ 56245148Sgrehan#ifndef BF_DICTSIZE 57245148Sgrehan#define BF_DICTSIZE 10000 58245148Sgrehan#endif 59245148Sgrehan 60245148Sgrehan/* 6140875Smsmith * BootForth Interface to Ficl Forth interpreter. 6240875Smsmith */ 6340875Smsmith 6494313SdcsFICL_SYSTEM *bf_sys; 6542000SabialFICL_VM *bf_vm; 6643614SdcsFICL_WORD *pInterp; 6740875Smsmith 6840875Smsmith/* 6940875Smsmith * Shim for taking commands from BF and passing them out to 'standard' 7040875Smsmith * argv/argc command functions. 7140875Smsmith */ 7240875Smsmithstatic void 7340875Smsmithbf_command(FICL_VM *vm) 7440875Smsmith{ 7540948Smsmith char *name, *line, *tail, *cp; 7664187Sjhb size_t len; 7740875Smsmith struct bootblk_command **cmdp; 7840875Smsmith bootblk_cmd_t *cmd; 7943321Sjkh int nstrings, i; 8040875Smsmith int argc, result; 8140875Smsmith char **argv; 8240875Smsmith 8340875Smsmith /* Get the name of the current word */ 8440875Smsmith name = vm->runningWord->name; 8540875Smsmith 8640875Smsmith /* Find our command structure */ 8742290Speter cmd = NULL; 8840875Smsmith SET_FOREACH(cmdp, Xcommand_set) { 8940875Smsmith if (((*cmdp)->c_name != NULL) && !strcmp(name, (*cmdp)->c_name)) 9040875Smsmith cmd = (*cmdp)->c_fn; 9140875Smsmith } 9240875Smsmith if (cmd == NULL) 9340875Smsmith panic("callout for unknown command '%s'", name); 9443321Sjkh 9543321Sjkh /* Check whether we have been compiled or are being interpreted */ 9651786Sdcs if (stackPopINT(vm->pStack)) { 9743321Sjkh /* 9843321Sjkh * Get parameters from stack, in the format: 9943321Sjkh * an un ... a2 u2 a1 u1 n -- 10043321Sjkh * Where n is the number of strings, a/u are pairs of 10143321Sjkh * address/size for strings, and they will be concatenated 10243321Sjkh * in LIFO order. 10343321Sjkh */ 10451786Sdcs nstrings = stackPopINT(vm->pStack); 10543321Sjkh for (i = 0, len = 0; i < nstrings; i++) 10643321Sjkh len += stackFetch(vm->pStack, i * 2).i + 1; 10743321Sjkh line = malloc(strlen(name) + len + 1); 10843321Sjkh strcpy(line, name); 10943321Sjkh 11043321Sjkh if (nstrings) 11143321Sjkh for (i = 0; i < nstrings; i++) { 11251786Sdcs len = stackPopINT(vm->pStack); 11343321Sjkh cp = stackPopPtr(vm->pStack); 11443321Sjkh strcat(line, " "); 11543321Sjkh strncat(line, cp, len); 11643321Sjkh } 11743321Sjkh } else { 11843321Sjkh /* Get remainder of invocation */ 11943321Sjkh tail = vmGetInBuf(vm); 12043321Sjkh for (cp = tail, len = 0; cp != vm->tib.end && *cp != 0 && *cp != '\n'; cp++, len++) 12143321Sjkh ; 12240875Smsmith 12343321Sjkh line = malloc(strlen(name) + len + 2); 12443321Sjkh strcpy(line, name); 12543321Sjkh if (len > 0) { 12643321Sjkh strcat(line, " "); 12743321Sjkh strncat(line, tail, len); 12843321Sjkh vmUpdateTib(vm, tail + len); 12943321Sjkh } 13040950Smsmith } 13140948Smsmith DEBUG("cmd '%s'", line); 13240948Smsmith 13340875Smsmith command_errmsg = command_errbuf; 13440875Smsmith command_errbuf[0] = 0; 13540875Smsmith if (!parse(&argc, &argv, line)) { 13640875Smsmith result = (cmd)(argc, argv); 13740875Smsmith free(argv); 13840875Smsmith } else { 13943077Smsmith result=BF_PARSE; 14040875Smsmith } 14140875Smsmith free(line); 142242145Smav /* 143242145Smav * If there was error during nested ficlExec(), we may no longer have 144242145Smav * valid environment to return. Throw all exceptions from here. 145242145Smav */ 146242145Smav if (result != 0) 147242145Smav vmThrow(vm, result); 14843077Smsmith /* This is going to be thrown!!! */ 14951786Sdcs stackPushINT(vm->pStack,result); 15040875Smsmith} 15140875Smsmith 15240875Smsmith/* 15343321Sjkh * Replace a word definition (a builtin command) with another 15443321Sjkh * one that: 15543321Sjkh * 15643321Sjkh * - Throw error results instead of returning them on the stack 15743321Sjkh * - Pass a flag indicating whether the word was compiled or is 15843321Sjkh * being interpreted. 15943321Sjkh * 16043321Sjkh * There is one major problem with builtins that cannot be overcome 16143614Sdcs * in anyway, except by outlawing it. We want builtins to behave 16243614Sdcs * differently depending on whether they have been compiled or they 16343614Sdcs * are being interpreted. Notice that this is *not* the interpreter's 16443614Sdcs * current state. For example: 16543321Sjkh * 16643321Sjkh * : example ls ; immediate 16743614Sdcs * : problem example ; \ "ls" gets executed while compiling 16843614Sdcs * example \ "ls" gets executed while interpreting 16943321Sjkh * 17043614Sdcs * Notice that, though the current state is different in the two 17143614Sdcs * invocations of "example", in both cases "ls" has been 17243614Sdcs * *compiled in*, which is what we really want. 17343321Sjkh * 17443321Sjkh * The problem arises when you tick the builtin. For example: 17543321Sjkh * 17643321Sjkh * : example-1 ['] ls postpone literal ; immediate 17743321Sjkh * : example-2 example-1 execute ; immediate 17843321Sjkh * : problem example-2 ; 17943321Sjkh * example-2 18043321Sjkh * 18143321Sjkh * We have no way, when we get EXECUTEd, of knowing what our behavior 18243321Sjkh * should be. Thus, our only alternative is to "outlaw" this. See RFI 18343614Sdcs * 0007, and ANS Forth Standard's appendix D, item 6.7 for a related 18443614Sdcs * problem, concerning compile semantics. 18543321Sjkh * 18643614Sdcs * The problem is compounded by the fact that "' builtin CATCH" is valid 18743321Sjkh * and desirable. The only solution is to create an intermediary word. 18843321Sjkh * For example: 18943321Sjkh * 19043321Sjkh * : my-ls ls ; 19143321Sjkh * : example ['] my-ls catch ; 19243321Sjkh * 19343614Sdcs * So, with the below implementation, here is a summary of the behavior 19443614Sdcs * of builtins: 19543614Sdcs * 19643614Sdcs * ls -l \ "interpret" behavior, ie, 19743614Sdcs * \ takes parameters from TIB 19843614Sdcs * : ex-1 s" -l" 1 ls ; \ "compile" behavior, ie, 19943614Sdcs * \ takes parameters from the stack 20043614Sdcs * : ex-2 ['] ls catch ; immediate \ undefined behavior 20143614Sdcs * : ex-3 ['] ls catch ; \ undefined behavior 20243614Sdcs * ex-2 ex-3 \ "interpret" behavior, 20343614Sdcs * \ catch works 20443614Sdcs * : ex-4 ex-2 ; \ "compile" behavior, 20543614Sdcs * \ catch does not work 20643614Sdcs * : ex-5 ex-3 ; immediate \ same as ex-2 20743614Sdcs * : ex-6 ex-3 ; \ same as ex-3 20843614Sdcs * : ex-7 ['] ex-1 catch ; \ "compile" behavior, 20943614Sdcs * \ catch works 21043614Sdcs * : ex-8 postpone ls ; immediate \ same as ex-2 21143614Sdcs * : ex-9 postpone ls ; \ same as ex-3 21243614Sdcs * 21343614Sdcs * As the definition below is particularly tricky, and it's side effects 21443321Sjkh * must be well understood by those playing with it, I'll be heavy on 21543321Sjkh * the comments. 21643321Sjkh * 21743321Sjkh * (if you edit this definition, pay attention to trailing spaces after 21843321Sjkh * each word -- I warned you! :-) ) 21943321Sjkh */ 22043321Sjkh#define BUILTIN_CONSTRUCTOR \ 22143321Sjkh": builtin: " \ 22243321Sjkh ">in @ " /* save the tib index pointer */ \ 22343321Sjkh "' " /* get next word's xt */ \ 22443321Sjkh "swap >in ! " /* point again to next word */ \ 22543321Sjkh "create " /* create a new definition of the next word */ \ 22643321Sjkh ", " /* save previous definition's xt */ \ 22743321Sjkh "immediate " /* make the new definition an immediate word */ \ 22843321Sjkh \ 22943321Sjkh "does> " /* Now, the *new* definition will: */ \ 23043321Sjkh "state @ if " /* if in compiling state: */ \ 23143321Sjkh "1 postpone literal " /* pass 1 flag to indicate compile */ \ 23243321Sjkh "@ compile, " /* compile in previous definition */ \ 23343321Sjkh "postpone throw " /* throw stack-returned result */ \ 23443321Sjkh "else " /* if in interpreting state: */ \ 23543321Sjkh "0 swap " /* pass 0 flag to indicate interpret */ \ 23643321Sjkh "@ execute " /* call previous definition */ \ 23743321Sjkh "throw " /* throw stack-returned result */ \ 23843321Sjkh "then ; " 23943321Sjkh 24043321Sjkh/* 24140875Smsmith * Initialise the Forth interpreter, create all our commands as words. 24240875Smsmith */ 24340875Smsmithvoid 24440875Smsmithbf_init(void) 24540875Smsmith{ 24640875Smsmith struct bootblk_command **cmdp; 24743077Smsmith char create_buf[41]; /* 31 characters-long builtins */ 24840988Sjkh int fd; 249245148Sgrehan 250245148Sgrehan bf_sys = ficlInitSystem(BF_DICTSIZE); 25194313Sdcs bf_vm = ficlNewVM(bf_sys); 25240875Smsmith 25361371Sdcs /* Put all private definitions in a "builtins" vocabulary */ 25461371Sdcs ficlExec(bf_vm, "vocabulary builtins also builtins definitions"); 25561371Sdcs 25643321Sjkh /* Builtin constructor word */ 25751786Sdcs ficlExec(bf_vm, BUILTIN_CONSTRUCTOR); 25843077Smsmith 25940875Smsmith /* make all commands appear as Forth words */ 26043077Smsmith SET_FOREACH(cmdp, Xcommand_set) { 26194313Sdcs ficlBuild(bf_sys, (char *)(*cmdp)->c_name, bf_command, FW_DEFAULT); 26261720Sdcs ficlExec(bf_vm, "forth definitions builtins"); 26343077Smsmith sprintf(create_buf, "builtin: %s", (*cmdp)->c_name); 26451786Sdcs ficlExec(bf_vm, create_buf); 26561720Sdcs ficlExec(bf_vm, "builtins definitions"); 26643077Smsmith } 26761371Sdcs ficlExec(bf_vm, "only forth definitions"); 26840988Sjkh 26943077Smsmith /* Export some version numbers so that code can detect the loader/host version */ 27094313Sdcs ficlSetEnv(bf_sys, "FreeBSD_version", __FreeBSD_version); 27194313Sdcs ficlSetEnv(bf_sys, "loader_version", 27243077Smsmith (bootprog_rev[0] - '0') * 10 + (bootprog_rev[2] - '0')); 27343077Smsmith 27440988Sjkh /* try to load and run init file if present */ 27540988Sjkh if ((fd = open("/boot/boot.4th", O_RDONLY)) != -1) { 27640988Sjkh (void)ficlExecFD(bf_vm, fd); 27740988Sjkh close(fd); 27840988Sjkh } 27943614Sdcs 28043614Sdcs /* Do this last, so /boot/boot.4th can change it */ 28194313Sdcs pInterp = ficlLookup(bf_sys, "interpret"); 28240875Smsmith} 28340875Smsmith 28440875Smsmith/* 28540875Smsmith * Feed a line of user input to the Forth interpreter 28640875Smsmith */ 28743614Sdcsint 28840875Smsmithbf_run(char *line) 28940875Smsmith{ 29040875Smsmith int result; 29143614Sdcs 29251786Sdcs result = ficlExec(bf_vm, line); 29343614Sdcs 29440948Smsmith DEBUG("ficlExec '%s' = %d", line, result); 29543077Smsmith switch (result) { 29643077Smsmith case VM_OUTOFTEXT: 29743077Smsmith case VM_ABORTQ: 29843077Smsmith case VM_QUIT: 29943077Smsmith case VM_ERREXIT: 30043077Smsmith break; 30143077Smsmith case VM_USEREXIT: 30243077Smsmith printf("No where to leave to!\n"); 30343077Smsmith break; 30443077Smsmith case VM_ABORT: 30543077Smsmith printf("Aborted!\n"); 30643077Smsmith break; 30743077Smsmith case BF_PARSE: 30843077Smsmith printf("Parse error!\n"); 30943077Smsmith break; 31043077Smsmith default: 31143077Smsmith /* Hopefully, all other codes filled this buffer */ 31243077Smsmith printf("%s\n", command_errmsg); 31343077Smsmith } 31440948Smsmith 31540875Smsmith if (result == VM_USEREXIT) 31640875Smsmith panic("interpreter exit"); 31786608Sobrien setenv("interpret", bf_vm->state ? "" : "OK", 1); 31843614Sdcs 31943614Sdcs return result; 32040875Smsmith} 321