/** * Title: Interpreting the input stream * Version: 0.6.8 * File: interpreting-ext.c * Author: David N. Williams * License: LGPL * Last revision: August 26, 2006 * * Copyright (C) 2001, 2002, 2004, 2006 David N. Williams * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later * version. * * This library is distributed in the hope that it will be * useful, but WITHOUT ANY WARRANTY; without even the implied * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR * PURPOSE. See the GNU Library General Public License for more * details. * * You should have received a copy of the GNU Lesser General * Public License along with this library; if not, write to the * Free Software Foundation, 59 Temple Place, Suite 330, Boston, * MA 02111-1307 USA. * * If you take advantage of the option in the LGPL to put a * particular version of this library under the GPL, the author * would regard it as polite if you would put any direct * modifications under the LGPL as well, and include a copy of * this request near the beginning of the modified library * source. A "direct modification" is one that enhances or * extends the library in line with its original concept, as * opposed to developing a distinct application or library which * might use it. */ /************ Preamble ************/ /** * This is an external pfe module, not part of the pfe * distribution. Some of the words implemented here were * proposed by Michael L. Gasanenko (mlg) at * * http://forth.sourceforge.net/word/evaluate-with/index.html */ #define _P4_SOURCE 1 #include #include /* P4_fail2() */ #include /* strlen() */ /* We use the prefix "dw_" to avoid possible label conflicts * with pfe prefixes. */ #include "interpreting-ext.h" /************ Glossary ************/ p4xt dw_interp_vec = 0; /* private interpret vector */ /** SET-INTERP ( xt -- ) * Store xt in the private interpret vector. */ FCode (dw_set_interp) { dw_interp_vec = (p4xt)*SP++; } /** * EVAL* ( s -- ) * * A version of EVALUATE that uses the private interpret vector. * * WARNING! We expect to replace this with EVALUATE-WITH. */ FCode (dw_eval_star) { p4char *p = (p4char *) SP[1]; int n = *SP; SP += 2; RP = (p4xt **) p4_save_input (RP); SOURCE_ID = -1; BLK = 0; TIB = p; NUMBER_TIB = n; TO_IN = 0; /* FX (dw_interpret); */ PFE.execute (dw_interp_vec); RP = (p4xt **) p4_restore_input (RP); } /** * EVALUATE-WITH ( s xt -- ) * * A version of EVALUATE that executes the xt to interpret the * string. "evaluate-with" * * Proposed by mlg at * http://forth.sourceforge.net/word/evaluate-with/index.html * * This version silently ignores a null xt, like p4_fetch_execute. */ FCode (dw_evaluate_with) { p4xt xt = (p4xt) FX_POP; p4char *p = (p4char *) SP[1]; int n = *SP; SP += 2; RP = (p4xt **) p4_save_input (RP); SOURCE_ID = -1; BLK = 0; TIB = p; NUMBER_TIB = n; TO_IN = 0; if (xt) { PFE.execute (xt); } RP = (p4xt **) p4_restore_input (RP); } /** * Subroutine based on p4_include_file() in engine-sub.c. This * version silently ignores a null xt, like p4_fetch_execute(). * Called by INCLUDE-FILE-WITH. */ _export void dw_include_file_with (p4_File *fid, p4xt xt) { if (fid == NULL || fid->f == NULL) p4_throws (P4_ON_FILE_NEX, (p4char*)fid->name, 0); RP = (p4xt **) p4_save_input (RP); SOURCE_ID = (p4cell) fid; BLK = 0; TO_IN = 0; p4_refill (); /* get first line; pfe doesn't seem to do this */ if (xt) { PFE.execute (xt); } RP = (p4xt **) p4_restore_input (RP); } /** * INCLUDE-FILE-WITH ( fid xt -- ) * * Perform the function of INCLUDE-FILE but use xt rather than * the normal Forth outer interpreter. In the style of * INCLUDE-FILE, which also takes a fid, the file is not closed * before RESTORE-INPUT. It is understood that xt is not to * invoke REFILL. "include-file-with" * * Proposed by mlg at * http://forth.sourceforge.net/word/evaluate-with/index.html */ FCode (dw_include_file_with) { p4xt xt = (p4xt) FX_POP; dw_include_file_with ((File *) *SP++, xt); } /** * INCLUDE-FILE-LINES-WITH ( fid xt -- ) * * An alias for INCLUDE-FILE-WITH where xt is understood to * invoke REFILL until the end of the file. * "include-file-lines-with" */ /** * Subroutine based on p4_included1() in engine-sub.c. Called * by INCLUDED-WITH. */ _export int dw_included1_with (const p4char *name, int len, p4xt xt, int throws) { File* f; p4char* fn = (p4char*) p4_pocket_expanded_filename (name, len, *P4_opt.inc_paths, *P4_opt.inc_ext); f = p4_open_file (fn, strlen ((char*)fn), FMODE_RO); if (!f) { if (throws) { p4_throws (P4_ON_FILE_NEX, fn, 0); }else{ P4_fail2 ("- could not open '%s' (paths='%s')\n", fn, *P4_opt.inc_paths); return 0; } } dw_include_file_with (f, xt); p4_close_file (f); return 1; } /** * INCLUDED-WITH ( s xt -- ) * * Perform the function of INCLUDED but use xt rather than * the normal Forth outer interpreter. In the style of * INCLUDED, which also takes a name string, the file is closed * before RESTORE-INPUT. It is understood that xt is not to * invoke REFILL. "included-with" * * Corollary to proposal by mlg at * http://forth.sourceforge.net/word/evaluate-with/index.html */ FCode (dw_included_with) { p4xt xt = (p4xt) FX_POP; p4char *fn = (p4char *) SP[1]; /* c-addr, name */ p4ucell u = SP[0]; /* length of name */ SP += 2; dw_included1_with (fn, u, xt, 1); } /** * LINES-INCLUDED-WITH ( s xt -- ) * * An alias for INCLUDED-WITH where xt is understood to invoke * REFILL until the end of the file. * "lines-included-with" */ /********* Words *********/ P4_LISTWORDS (interpreting) = { P4_FXco ("SET-INTERP", dw_set_interp), P4_FXco ("EVAL*", dw_eval_star), P4_FXco ("EVALUATE-WITH", dw_evaluate_with), P4_FXco ("INCLUDE-FILE-WITH", dw_include_file_with), P4_FXco ("INCLUDE-FILE-LINES-WITH", dw_include_file_with), P4_FXco ("INCLUDED-WITH", dw_included_with), P4_FXco ("LINES-INCLUDED-WITH", dw_included_with), }; P4_COUNTWORDS (interpreting, "interpreting primitives");