├── .gitattributes ├── .gitignore ├── .settings ├── org.eclipse.cdt.core.prefs └── org.eclipse.cdt.ui.prefs ├── COPYING.LIB ├── ChangeLog ├── INSTALL.TXT ├── Makefile.am ├── Makefile.in ├── Makefile.mk ├── README ├── TODO ├── aclocal.m4 ├── autogen.sh ├── bin ├── Makefile.am ├── Makefile.in ├── aclocal.m4 ├── configure ├── configure.ac └── pfe-exec.c ├── configure ├── configure.ac ├── dbk ├── pfe-fth.dbk ├── pfe-fth.mk ├── pfe-words.xml ├── wordsets2words.pl └── xml-c-pfe-doc.e ├── doc ├── 4ring.gif ├── 4thtutor.ar ├── Forthprimer.pdf ├── Makefile.am ├── Makefile.in ├── PFE.css ├── authors.htm ├── body.htm ├── changes.htm ├── dirk-zoller-readme.dbk ├── doc-index.dbk ├── documentation.htm ├── dpans.ar ├── forth-any-192.png ├── forth-pfe-192-light.png ├── forth-pfe-192.png ├── header-fields.dbk ├── help2man.pl ├── how-to-write-a-pfe-module.dbk ├── index.htm ├── internal-decisions-about-headers.dbk ├── known-problems.dbk ├── lgpl-license.dbk ├── lgpl-license.htm ├── license.dbk ├── license.htm ├── literature.dbk ├── locals.dbk ├── make-dist.dbk ├── makedocs.py ├── pfe-manual.dbk ├── pfe-master.odt ├── pfe.1 ├── pfe.htm ├── pfedoc │ ├── __init__.py │ ├── commentmarkup.py │ ├── dbk2htm.py │ ├── docbookdocument.py │ ├── forthheader.py │ ├── forthmodule.py │ ├── forthnotation.py │ ├── forthwords.py │ ├── forthwordset.py │ ├── forthwordsethtmlpage.py │ ├── forthwordsetreference.py │ ├── functionheader.py │ ├── functionlisthtmlpage.py │ ├── functionlistreference.py │ ├── functionprototype.py │ ├── htm2dbk.py │ ├── htmldirectory.py │ ├── htmldocument.py │ ├── match.py │ ├── odtdocument.py │ ├── odttypes.py │ ├── options.py │ ├── textfile.py │ └── textfileheader.py ├── porting-sbr-threading.dbk ├── posixcalls.dbk ├── quoted-parse-idea.dbk ├── special-implementation-strategies.dbk ├── src │ ├── Makefile │ └── PFE.css ├── statesmart-words.dbk ├── threading.dbk ├── tuning.dbk ├── uppercasing.dbk └── wordset-modules.dbk ├── lib ├── Makefile.am ├── Makefile.in ├── arrays.4th ├── defer-is.4th ├── doermake.4th ├── easy4th.f ├── library.4th ├── loading.4th ├── pardot.4th ├── sh-libs.4th └── struct.4th ├── mk ├── Make-H.pl ├── Make-H.py ├── fb-2-fs.pl └── fb-2-fs.py ├── pfe.spec ├── pfe ├── Makefile.am ├── Makefile.in ├── _missing.c ├── _missing.h ├── _nonansi.h ├── aclocal.m4 ├── assembler-dll.c ├── assembler-ext.c ├── assembler-ext.h ├── block-ext.c ├── block-ext.h ├── block-mix.c ├── block-mix.h ├── block-stk.c ├── block-sub.c ├── block-sub.h ├── cdecl-ext.c ├── cdecl-ext.h ├── cdecl-stk.c ├── chain-ext.c ├── chain-ext.h ├── chain-stk.c ├── chainlist-ext.c ├── chainlist-ext.h ├── chainlist-stk.c ├── complex-dll.c ├── complex-ext.c ├── complex-ext.h ├── complex-pfe.log ├── config.h.in ├── configure ├── configure.ac ├── core-ext.c ├── core-ext.h ├── core-mix.c ├── core-mix.h ├── core-stk.c ├── core-sub.c ├── core-sub.h ├── debug-ext.c ├── debug-ext.h ├── debug-stk.c ├── def-cell.h ├── def-check.c ├── def-comp-c89.h ├── def-comp.h ├── def-config.h ├── def-const.h ├── def-gcc.h ├── def-limits.h ├── def-macro.h ├── def-paths.h ├── def-pth.h ├── def-regmacro.h ├── def-regs.h ├── def-regth.h ├── def-restore.h ├── def-sbrcode.h ├── def-types.h ├── def-words.h ├── dict-comp.c ├── dict-comp.h ├── dict-sub.c ├── dict-sub.h ├── dl-def.c ├── dl-dlfcn.c ├── dl-ext.c ├── dl-hpux.c ├── dl-internal.c ├── dl-none.c ├── dl-vxworks.c ├── dl-win32.c ├── double-ext.c ├── double-ext.h ├── double-mix.c ├── double-mix.h ├── double-sub.c ├── double-sub.h ├── dstrings-dll.c ├── dstrings-ext.c ├── dstrings-ext.h ├── edit-dll.c ├── edit-ext.c ├── edit-ext.h ├── emu-menu-table.c ├── engine-ext.c ├── engine-set.c ├── engine-set.h ├── engine-sub.c ├── engine-sub.h ├── environ-ext.c ├── environ-ext.h ├── exception-ext.c ├── exception-ext.h ├── exception-stk.c ├── exception-sub.c ├── exception-sub.h ├── facility-ext.c ├── facility-ext.h ├── facility-mix.c ├── facility-mix.h ├── facility-stk.c ├── file-ext.c ├── file-ext.h ├── file-mix.c ├── file-mix.h ├── file-stk.c ├── file-sub.c ├── file-sub.h ├── floating-dll.c ├── floating-ext.c ├── floating-ext.h ├── floating-mix.c ├── floating-mix.h ├── forth-83-ext.c ├── forth-83-ext.h ├── forth-83-stk.c ├── forth-usual-ext.c ├── forth-usual-ext.h ├── fpnostack-dll.c ├── fpnostack-ext.c ├── fpnostack-ext.h ├── gforth-dll.c ├── gforth-ext.c ├── gforth-ext.h ├── header-ext.c ├── header-ext.h ├── header-sub.c ├── header-sub.h ├── help-dll.c ├── help-ext.c ├── help-ext.h ├── host-k12.c ├── incl-ext.h ├── incl-mix.h ├── incl-sub.h ├── incl-sup.h ├── lib-sdl.c ├── libltdl │ ├── COPYING.LIB │ ├── Makefile.am │ ├── Makefile.in │ ├── README │ ├── aclocal.m4 │ ├── config-h.in │ ├── config.guess │ ├── config.sub │ ├── config │ │ ├── compile │ │ ├── config.guess │ │ ├── config.sub │ │ ├── depcomp │ │ ├── install-sh │ │ ├── ltmain.sh │ │ └── missing │ ├── configure │ ├── configure.ac │ ├── install-sh │ ├── libltdl │ │ ├── lt__alloc.h │ │ ├── lt__argz_.h │ │ ├── lt__dirent.h │ │ ├── lt__glibc.h │ │ ├── lt__private.h │ │ ├── lt__strl.h │ │ ├── lt_dlloader.h │ │ ├── lt_error.h │ │ ├── lt_system.h │ │ └── slist.h │ ├── loaders │ │ ├── dld_link.c │ │ ├── dlopen.c │ │ ├── dyld.c │ │ ├── load_add_on.c │ │ ├── loadlibrary.c │ │ ├── preopen.c │ │ └── shl_load.c │ ├── lt__alloc.c │ ├── lt__argz.c │ ├── lt__dirent.c │ ├── lt__strl.c │ ├── lt_dlloader.c │ ├── lt_error.c │ ├── ltdl.c │ ├── ltdl.h │ ├── ltmain.sh │ ├── m4 │ │ ├── argz.m4 │ │ ├── libtool.m4 │ │ ├── ltdl.m4 │ │ ├── ltoptions.m4 │ │ ├── ltsugar.m4 │ │ ├── ltversion.m4 │ │ └── lt~obsolete.m4 │ ├── missing │ └── slist.c ├── lined.c ├── lined.h ├── locals-ext.c ├── locals-ext.h ├── logging.h ├── main-alloc.c ├── main-def.c ├── main-k12.c ├── main-k12.h ├── main-mmap.c ├── main-static.c ├── main-stdc.c ├── main-sub.c ├── main-sub.h ├── memory-alloc-ext.c ├── memory-alloc-ext.h ├── memory-alloc-stk.c ├── memory-sub.c ├── memory-sub.h ├── misc-ext.c ├── misc-ext.h ├── misc-stk.c ├── module-dll.c ├── module-ext.c ├── option-ext.c ├── option-ext.h ├── option-set.c ├── option-set.h ├── os-ctype.c ├── os-ctype.h ├── os-delay.c ├── os-delay.h ├── os-fesetenv.h ├── os-setjmp.h ├── os-string.c ├── os-string.h ├── p4-gettimeofday.c ├── p4-gettimeofday.h ├── pfe-base.h ├── pfe-ext.h ├── pfe-mix.c ├── pfe-mix.h ├── pfe-set.h ├── pfe-sub.h ├── pfe-sup.h ├── pfe.h ├── posix-ext.c ├── posix-ext.h ├── search-order-ext.c ├── search-order-ext.h ├── shell-os-ext.c ├── shell-os-ext.h ├── signals-ext.c ├── signals-ext.h ├── smart-go-dll.c ├── smart-go-ext.c ├── smart-go-ext.h ├── socket-dll.c ├── socket-ext.c ├── stackhelp-dll.c ├── stackhelp-ext.c ├── stackhelp-ext.h ├── stackhelp-stk.c ├── string-ext.c ├── string-ext.h ├── string-stk.c ├── struct-dll.c ├── struct-ext.c ├── struct-ext.h ├── structs-dll.c ├── structs-ext.c ├── system-ext.c ├── system-ext.h ├── term-curses.c ├── term-def.c ├── term-dj.c ├── term-emx.c ├── term-ext.c ├── term-ext.h ├── term-k12.c ├── term-k12.h ├── term-lib.c ├── term-sub.c ├── term-sub.h ├── term-wat.c ├── term-wincon.c ├── term-x11.c ├── termcatch-dll.c ├── termcatch-ext.c ├── toolbelt-dll.c ├── toolbelt-ext.c ├── tools-ext.c ├── tools-ext.h ├── tools-mix.c ├── tools-mix.h ├── tools-sub.c ├── tools-sub.h ├── useful-ext.c ├── useful-ext.h ├── version-sub.c ├── version-sub.h ├── with-spy.c ├── your-ext.c ├── your-ext.h ├── zchar-dll.c └── zchar-ext.c ├── test ├── Makedist.mk ├── Makefile.am ├── Makefile.in ├── anslocal.4th ├── anslocal.fs ├── anslocal.test.ok ├── anslocal.test64.ok ├── anstests1 │ ├── Makefile.am │ ├── Makefile.in │ └── anstests0.6.zip ├── answords.fs ├── arith.4th ├── arith.sh ├── arith.test.ok ├── benchm.blk ├── bubble.fs ├── checkans.4th ├── checkans.fs ├── checkans.nomodules.ok ├── checkans.sh ├── checkans.test.ok ├── checkans.test64.ok ├── compare.4th ├── compare.sh ├── compare.test.ok ├── compspeed.fs ├── core.fr ├── coretest.4th ├── coretest.fs ├── coretest.sh ├── coretest.test.ok ├── dbltest.4th ├── dbltest.fs ├── deferred-x.4th ├── deferred-x.fs ├── deferred-x.test.ok ├── deferred-x.test64.ok ├── deferred.fs ├── defs.4th ├── defs.sh ├── defs.test.ok ├── dstester.fs ├── dstrings-test.fs ├── dstrings.txt ├── environ.4th ├── environ.nomodules.ok ├── environ.sh ├── environ.test.ok ├── environ.test64.ok ├── exceptn.4th ├── exceptn.sh ├── exceptn.test.ok ├── fib.fs ├── file.4th ├── file.sh ├── file.test.ok ├── float.4th ├── float.nomodules.ok ├── float.sh ├── float.test.ok ├── float.test64.ok ├── forth-signal.4th ├── fp-stack.4th ├── fp-stack.fs ├── fp-stack.nomodules.ok ├── fp-stack.test.ok ├── fp-stack.test64.ok ├── fpnostack.4th ├── fpnostack.nomodules.ok ├── fpnostack.sh ├── fpnostack.test.ok ├── fpnostack.test64.ok ├── hashvocdistri.fs ├── intactv.4th ├── locals-ext.4th ├── loop-test.4th ├── loop-test.sh ├── loop-test.test.ok ├── matrix.fs ├── mini-oof.fs ├── moof-exm.fs ├── moofglos.fs ├── number-prefixes.4th ├── number-prefixes.fs ├── number-prefixes.test.ok ├── number-prefixes.test64.ok ├── parse-name.4th ├── parse-name.fs ├── parse-name.test.ok ├── parse-name.test64.ok ├── postpone.4th ├── postpone.fs ├── postpone.sh ├── postpone.test.ok ├── queryapp.4th ├── queryapp.sh ├── queryapp.test.ok ├── queryapp.test64.ok ├── queryapp.txt ├── search-order.4th ├── search-order.fs ├── search-order.sh ├── search-order.test.ok ├── siev.fs ├── sieve.fs ├── sievem.fs ├── sokoban.4th ├── sokoban.fs ├── speedwhile.fs ├── stack.4th ├── stack.sh ├── stack.test.ok ├── string.4th ├── string.sh ├── string.test.ok ├── suite.4th ├── test-num-prefixes.4th ├── test-num-prefixes.fs ├── test-num-prefixes.test.ok ├── test-num-prefixes.test64.ok ├── test-num-prefixes2.4th ├── test-num-prefixes2.fs ├── test-num-prefixes2.test.ok ├── test-num-prefixes2.test64.ok ├── tester.fr ├── tester.fs ├── trydstrings.fs ├── tt.4th ├── tt.fs ├── wordsets.4th ├── wordsets.fs ├── wordsets.nomodules.ok ├── wordsets.sh └── wordsets.test.ok ├── testmodule1 ├── COPYING.ZLIB ├── Makefile.am ├── Makefile.in ├── README ├── aclocal.m4 ├── configure ├── configure.ac ├── testmodule1-dll.c ├── testmodule1-ext.c └── testmodule1.fs ├── testmodule2 ├── COPYING.ZLIB ├── Makefile.in ├── aclocal.m4 ├── configure ├── configure.ac ├── testmodule2-dll.c ├── testmodule2-ext.c └── testmodule2.fs └── uses ├── ac_c_bigendian_cross.m4 ├── ac_c_long_long_.m4 ├── ac_compile_check_sizeof.m4 ├── ac_cond_with.m4 ├── ac_cond_with_level.m4 ├── ac_create_generic_config.m4 ├── ac_create_target_h.m4 ├── ac_define_dir_.m4 ├── ac_define_path_style.m4 ├── ac_define_versionlevel.m4 ├── ac_func_mkdir.m4 ├── ac_func_snprintf.m4 ├── ac_set_default_paths_system.m4 ├── ac_spec_package_version.m4 ├── ac_sys_largefile_sensitive.m4 ├── acx_restrict.m4 ├── ax_c_declare_block.m4 ├── ax_cflags_gcc_option.m4 ├── ax_cflags_no_writable_strings.m4 ├── ax_cflags_strict_prototypes.m4 ├── ax_cflags_warn_all.m4 ├── ax_check_define.m4 ├── ax_check_gnu_dladdr.m4 ├── ax_check_tls_support.m4 ├── ax_configure_args.m4 ├── ax_create_pkgconfig_info.m4 ├── ax_enable_builddir_uname.m4 ├── ax_expand_prefix.m4 ├── ax_prefix_config_h.m4 ├── ax_set_version_info.m4 ├── ax_spec_file.m4 ├── ax_spec_package_version.m4 ├── ax_subst_with.m4 ├── ax_warning_default_pkgconfig.m4 ├── compile ├── config.guess ├── config.sub ├── depcomp ├── install-sh ├── libtool.m4 ├── ltargz.m4 ├── ltconfig ├── ltdl.m4 ├── ltmain.sh ├── ltoptions.m4 ├── ltsugar.m4 ├── ltversion.m4 ├── lt~obsolete.m4 ├── missing ├── mkbins.cmd ├── mkinstalldirs ├── patch_libtool_changing_cmds_ifs.m4 ├── patch_libtool_on_darwin_pass_all.m4 ├── patch_libtool_on_darwin_zsh_overquoting.m4 ├── patch_libtool_sys_lib_search_path_spec.m4 └── patch_libtool_to_add_host_cc.m4 /.gitattributes: -------------------------------------------------------------------------------- 1 | *.fs linguist-language=Forth 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.cache 3 | build 4 | Makefile 5 | -------------------------------------------------------------------------------- /.settings/org.eclipse.cdt.ui.prefs: -------------------------------------------------------------------------------- 1 | #Sun Dec 21 10:04:00 CET 2008 2 | eclipse.preferences.version=1 3 | formatter_profile=org.eclipse.cdt.ui.default.kandr_profile 4 | formatter_settings_version=1 5 | -------------------------------------------------------------------------------- /autogen.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | make -f Makefile.mk 3 | 4 | 5 | -------------------------------------------------------------------------------- /bin/Makefile.am: -------------------------------------------------------------------------------- 1 | AUTOMAKE_OPTIONS = 1.5 foreign dist-bzip2 2 | AUTOTOOL_VERSION = autoconf-2.52 automake-1.5 libtool-1.4.2 3 | ACLOCAL_AMFLAGS = -I ../uses 4 | # $Id: Makefile.am,v 1.2 2006-08-11 22:56:03 guidod Exp $ 5 | 6 | DEFS= @DEFS@ -I. -I.. -I$(srcdir)/.. # do not do -I$(srcdir) !! 7 | 8 | bin_PROGRAMS = pfe-exec 9 | 10 | pfe_exec_LDADD = ../pfe/libpfe.la 11 | 12 | ../pfe/libpfe.la : $(srcdir)/../pfe/*.c 13 | (cd ../pfe && $(MAKE) `basename $@`) 14 | 15 | -------------------------------------------------------------------------------- /bin/configure.ac: -------------------------------------------------------------------------------- 1 | AC_INIT(pfe-exec.c) 2 | AC_PREREQ(2.49) 3 | AC_COPYRIGHT([Guido U. Draheim for PFE.sourceforge.net]) 4 | AC_REVISION($Revision: 1.2 $) 5 | AC_CONFIG_AUX_DIR([../uses]) 6 | AC_CONFIG_MACRO_DIRS([../uses]) 7 | AC_CANONICAL_HOST 8 | AC_CANONICAL_SYSTEM 9 | AC_LANG_C 10 | AC_PROG_CC 11 | AC_SET_DEFAULT_PATHS_SYSTEM 12 | AC_SPEC_PACKAGE_VERSION(pfe.spec) 13 | AM_INIT_AUTOMAKE($PACKAGE, $VERSION) 14 | LT_CONFIG_LTDL_DIR([../pfe/libltdl]) 15 | AC_LIBTOOL_WIN32_DLL 16 | AM_PROG_LIBTOOL 17 | AC_PROG_INSTALL 18 | AC_OUTPUT(Makefile) 19 | -------------------------------------------------------------------------------- /bin/pfe-exec.c: -------------------------------------------------------------------------------- 1 | #define _POSIX_SOURCE 2 | 3 | /* this include should be changed somewhen!! */ 4 | #include 5 | #include 6 | #include 7 | 8 | int main (int argc, char** argv) 9 | { 10 | int i; 11 | p4_Session session; 12 | p4_Thread pfe; 13 | p4_SetOptions (&session, sizeof(session), 0, 0); 14 | session.quiet = 1; 15 | if (i=p4_InitVM(&pfe, &session)) 16 | { 17 | fputs ("error during initVM", stderr); 18 | return 1; 19 | } 20 | 21 | for (i=1; i Authors guidod@gmx.de 2 | 3 | 4 |

5 | Guido U. Draheim has been working on PFE at Tektronix in the last 6 | years. The released version is now maintained by me, Guido U. Draheim 7 | on a sparetime basis. You can contact me by e-mail, 8 | 9 | <guidod@gmx.de> 10 |

11 | 12 |

13 | In 1998 I had been contacting the original author Dirk-Uwe Zoller - 14 | well, his e-mail adress had changed since 1995 but I did 15 | find him. He told me that he has no serious intentions at all 16 | to do anything about Forth again, but he likes to look for 17 | his old project PFE on an occasional basis. He has put up 18 | a new homepage lately under 19 | www.dirk-zoller.de. 20 |

21 | 22 |

23 | The Forthprimer.pdf is copyrighted by Hans Bezeemer, author 24 | of the 4th compiler. See his website at 25 | http://come.to/hansoft. 26 | The Forthprimer is distributed unter the GNU Free 27 | Documentation License, a copy of the GNU FDL is contained in the 28 | pdf document. The pdf is shipped along in pfe sources for 29 | convenience to pfe users. To run the examples in the tutorial, 30 | be sure to include the file "easy4th.f" before. 31 |

32 | -------------------------------------------------------------------------------- /doc/dpans.ar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/doc/dpans.ar -------------------------------------------------------------------------------- /doc/forth-any-192.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/doc/forth-any-192.png -------------------------------------------------------------------------------- /doc/forth-pfe-192-light.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/doc/forth-pfe-192-light.png -------------------------------------------------------------------------------- /doc/forth-pfe-192.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/doc/forth-pfe-192.png -------------------------------------------------------------------------------- /doc/help2man.pl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/doc/help2man.pl -------------------------------------------------------------------------------- /doc/pfe-manual.dbk: -------------------------------------------------------------------------------- 1 | 4 | PFE' > 5 | Tek/MPT' > 6 | ]> 7 | 8 | Portable Forth Environment 9 |
10 | The Portable Forth Environment (PFE) is based on the ANSI Standard 11 | for Forth. The PFE has been created by Dirk-Uwe Zoller and had been 12 | maintained up to the 0.9.x versions (1993-1995). 13 | Tektronix has adopted the PFE package in 1998 14 | and made a number of extensions. It is now fully multithreaded and 15 | it features a module system. You can load additional C objects 16 | at runtime to extend the Forth dictionary. It is best targeted for 17 | embedded environments since you can easily exchange the terminal 18 | driver and the initilization routines. 19 |
20 | 21 | 23 | 37 | 39 | 40 | 42 | 43 | -------------------------------------------------------------------------------- /doc/pfe-master.odt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/doc/pfe-master.odt -------------------------------------------------------------------------------- /doc/pfe.1: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/doc/pfe.1 -------------------------------------------------------------------------------- /doc/pfedoc/__init__.py: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/doc/pfedoc/__init__.py -------------------------------------------------------------------------------- /doc/pfedoc/dbk2htm.py: -------------------------------------------------------------------------------- 1 | from match import Match 2 | import string 3 | 4 | class dbk2htm_conversion: 5 | mapping = { "" : "
", "" : "
", 6 | "" : "

", "" : "

" , 7 | "" : "", "" : "" } 8 | def __init__(self): 9 | pass 10 | def section2html(self, text): 11 | for str in self.mapping: 12 | text = string.replace(text, str, self.mapping[str]) 13 | return text 14 | def paramdef2html(self, text): 15 | s = Match() 16 | txt = text & s(r"\s+") >> r"\n" 17 | txt &= s(r"") >> r"" 18 | txt &= s(r"") >> r"" 19 | txt &= s(r"") >> r"\n " 20 | txt &= s(r"") >> r"\n" 21 | return txt 22 | 23 | def section2html(text): 24 | return dbk2htm_conversion().section2html(text) 25 | def paramdef2html(text): 26 | return dbk2htm_conversion().paramdef2html(text) 27 | -------------------------------------------------------------------------------- /doc/pfedoc/forthnotation.py: -------------------------------------------------------------------------------- 1 | from match import Match 2 | 3 | class ForthNotation: 4 | def __init__(self, text = None, header = None): 5 | self.header = header 6 | self.text = text 7 | self.name = None 8 | self.stack = None 9 | self.hints = None 10 | def get_filename(self): 11 | if self.header: 12 | return self.header.get_filename() 13 | return None 14 | def parse(self, text = None): 15 | if text is not None: 16 | self.text = text 17 | text = self.text 18 | if text is None: 19 | return False 20 | m1 = Match(r"^\s*'([^']+)'\s+(\([^\(\)]*--[^\(\)]*\))(.*)") 21 | m2 = Match(r"^\s*\"([^\"]+)\"\s+(\([^\(\)]*--[^\(\)]*\))(.*)") 22 | m3 = Match(r"^\s*([^\(\)\s]+)\s+(\([^\(\)]*--[^\(\)]*\))(.*)") 23 | if text & m1: 24 | self.name = m1[1] ; self.stack = m1[2] ; self.hints = m1[3] 25 | self.name &= Match(r"\\(.)") >> "\\1" 26 | return True 27 | elif text & m2: 28 | self.name = m2[1] ; self.stack = m2[2] ; self.hints = m2[3] 29 | self.name &= Match(r"\\(.)") >> "\\1" 30 | return True 31 | elif text & m3: 32 | self.name = m3[1] ; self.stack = m3[2] ; self.hints = m3[3] 33 | return True 34 | else: 35 | return False 36 | def _parsed(self): 37 | if not self.name: 38 | return self.parse() 39 | return True 40 | def get_name(self): 41 | if not self._parsed(): return None 42 | return self.name 43 | def get_stack(self): 44 | if not self._parsed(): return None 45 | return self.stack 46 | def get_hints(self): 47 | if not self._parsed(): return None 48 | return self.hints 49 | -------------------------------------------------------------------------------- /doc/pfedoc/options.py: -------------------------------------------------------------------------------- 1 | #! /usr/bin/python 2 | # -*- coding: utf-8 -*- 3 | # @creator (C) 2003 Guido U. Draheim 4 | # @license http://creativecommons.org/licenses/by-nc-sa/2.0/de/ 5 | 6 | from match import Match 7 | 8 | # use as o.optionname to check for commandline options. 9 | class Options: 10 | var = {} 11 | def __getattr__(self, name): 12 | if not self.var.has_key(name): return None 13 | return self.var[name] 14 | def __setattr__(self, name, value): 15 | self.var[name] = value 16 | def scan(self, optionstring): # option-name or None 17 | x = Match() 18 | if optionstring & x(r"^--?(\w+)=(.*)"): 19 | self.var[x[1]] = x[2] ; return x[1] 20 | if optionstring & x(r"^--?no-(\w+)$"): 21 | self.var[x[1]] = "" ; return x[1] 22 | if optionstring & x(r"^--?(\w+)$"): 23 | self.var[x[1]] = "*"; return x[1] 24 | return None 25 | #end Options 26 | 27 | if False: 28 | o = Options() 29 | o.help = """ 30 | scans for options 31 | """ 32 | -------------------------------------------------------------------------------- /doc/pfedoc/textfile.py: -------------------------------------------------------------------------------- 1 | 2 | def _src_to_xml(text): 3 | if not text: return "" 4 | return text.replace("&", "&").replace("<", "<").replace(">", ">") 5 | 6 | class TextFile: 7 | def __init__(self, filename = None): 8 | self.filename = filename 9 | self.src_text = None 10 | self.xml_text = None 11 | def parse(self, filename = None): 12 | if filename is not None: 13 | self.filename = filename 14 | if self.filename is None: 15 | return False 16 | try: 17 | fd = open(self.filename, "r") 18 | self.src_text = fd.read() 19 | fd.close() 20 | return True 21 | except IOError, e: 22 | pass 23 | return False 24 | def assert_src_text(self): 25 | if self.src_text: return True 26 | return self.parse() 27 | def assert_xml_text(self): 28 | if self.xml_text: return True 29 | if not self.assert_src_text(): return False 30 | self.xml_text = _src_to_xml(self.src_text) 31 | def get_src_text(self): 32 | self.assert_src_text() 33 | return self.src_text 34 | def get_xml_text(self): 35 | self.assert_xml_text() 36 | return self.xml_text 37 | def get_filename(self): 38 | return self.filename 39 | def line_xml_text(self, offset): 40 | self._line(self.xml_text, offset) 41 | def line_src_text(self, offset): 42 | self._line(self.src_text, offset) 43 | def _line(self, text, offset): 44 | line = 1 45 | for x in xrange(0,offset): 46 | if x == "\n": 47 | line += 1 48 | return line 49 | 50 | 51 | -------------------------------------------------------------------------------- /lib/Makefile.am: -------------------------------------------------------------------------------- 1 | AUTOMAKE_OPTIONS = 1.5 foreign dist-bzip2 2 | AUTOTOOL_VERSION = autoconf-2.52 automake-1.5 libtool-1.4.2 3 | 4 | # these are outdated, sorry... 5 | noinst_DATA = \ 6 | arrays.4th doermake.4th library.4th \ 7 | defer-is.4th easy4th.f loading.4th \ 8 | pardot.4th struct.4th sh-libs.4th 9 | EXTRA_DIST = $(DATA) 10 | -------------------------------------------------------------------------------- /lib/arrays.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ library.4th --- Library code for pfe. 3 | \ 4 | \ (duz 22May94) 5 | \ 6 | 7 | \ ======================================================================= 8 | \ multi-dimensional array type 9 | \ ======================================================================= 10 | 11 | \ Multi-dimensional arrays are supported by two primitives in the kernel 12 | \ doing the multiplication work: 13 | \ BUILD-ARRAY \ n1 n2 ... nX X --- n 14 | \ takes a list of upper bounds plus the dimension of the array, 15 | \ writes those upper bounds to the dictionary, returns their 16 | \ product. 17 | \ ACCESS-ARRAY \ i1 i2 ... iX addr1 --- addr2 offset 18 | \ addr1 points to a list generated by BUILD-ARRAY. 19 | \ Multiplies the actual indices i with the registered bounds 20 | \ pointed to by addr1. 21 | \ Returns the offset in items of the accessed element, 22 | \ addr2 points to just after the list of upper bounds. 23 | \ Indices start with 0, highest index iY is nY - 1. 24 | \ On index out of range ACCESS-ARRAY throws -2051. 25 | \ Usage is simple and demonstrated below with an array of Cells: 26 | 27 | : CELL-ARRAY CREATE \ n1 n2 ... nX X --- ; X is dimension of ARRAY 28 | BUILD-ARRAY \ --- size in items 29 | CELLS \ --- size in address units 30 | HERE OVER ALLOT \ allocate space 31 | SWAP ERASE \ and wipe it 32 | DOES> \ i1 i2 ... iX --- addr 33 | ACCESS-ARRAY \ addr item-offset 34 | CELLS + ; 35 | 36 | \ ======================================================================= 37 | \ end of arrays.4th 38 | \ ======================================================================= 39 | 40 | CR .( Array types loaded. ) 41 | -------------------------------------------------------------------------------- /lib/defer-is.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ library.4th --- Library code for pfe. 3 | \ 4 | \ (duz 22May94) 5 | \ 6 | 7 | \ ======================================================================= 8 | \ F83-like DEFER and IS for vectorized execution 9 | \ ======================================================================= 10 | 11 | : CRASH \ --- ; default action when a DEFER is created 12 | TRUE ABORT" uninitialized DEFER called" ; 13 | 14 | : DEFER \ "word" --- \ yes you can do CONSTANT ... DOES> in pfe: 15 | ['] CRASH CONSTANT DOES> PERFORM ; 16 | 17 | : IS \ xt --- \ store in PFA of following word 18 | \ which should be defined by DEFER 19 | POSTPONE TO ; IMMEDIATE 20 | 21 | \ ======================================================================= 22 | \ end of defer-is.4th 23 | \ ======================================================================= 24 | 25 | CR .( DEFER...IS loaded. ) 26 | -------------------------------------------------------------------------------- /lib/doermake.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ doermake.4th --- Library code for pfe. 3 | \ 4 | \ (duz 22May94) 5 | \ 6 | 7 | ONLY FORTH ALSO DEFINITIONS 8 | 9 | \ ======================================================================= 10 | \ Leo Brodie's DOER ... MAKE construct: 11 | \ ======================================================================= 12 | 13 | : NOTHING ; 14 | 15 | : DOER CREATE ['] NOTHING >BODY , 16 | DOES> @ >R ; 17 | 18 | : (MAKE) R> DUP CELL+ 19 | DUP CELL+ SWAP @ >BODY ! 20 | @ ?DUP IF >R THEN ; 21 | 22 | : MAKE STATE @ IF 23 | POSTPONE (MAKE) HERE 0 , 24 | ELSE 25 | HERE ' >BODY ! ] 26 | THEN 27 | ; IMMEDIATE 28 | 29 | : ;AND POSTPONE EXIT HERE SWAP ! 30 | ; IMMEDIATE 31 | 32 | : UNDO ['] NOTHING >BODY ' >BODY ! ; 33 | 34 | \ let's test it: 35 | 36 | DOER TEST 37 | MAKE TEST CR ." DOER...MAKE " ; 38 | TEST 39 | : T MAKE TEST ." loaded. " ;AND TEST ; 40 | T 41 | UNDO TEST 42 | TEST 43 | FORGET TEST 44 | 45 | \ ======================================================================= 46 | \ end of doermake.4th 47 | \ ======================================================================= 48 | 49 | RESET-ORDER 50 | -------------------------------------------------------------------------------- /lib/library.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ library.4th --- Library code for pfe, load file. 3 | \ 4 | \ (duz 22May94) 5 | \ 6 | 7 | REDEFINED-MSG OFF 8 | : HAVE BL WORD FIND NIP ; 9 | : [IFDEF] HAVE POSTPONE [IF] ; IMMEDIATE 10 | : [IFNDEF] HAVE 0= POSTPONE [IF] ; IMMEDIATE 11 | REDEFINED-MSG ON 12 | 13 | [IFDEF] FORGET-LIBRARY FORGET-LIBRARY [THEN] 14 | ONLY EXTENSIONS ALSO FORTH ALSO DEFINITIONS DEFAULT-ORDER 15 | MARKER FORGET-LIBRARY 16 | 17 | \ ======================================================================= 18 | \ include individual features 19 | \ ======================================================================= 20 | 21 | INCLUDE sh-libs 22 | INCLUDE loading 23 | INCLUDE defer-is 24 | INCLUDE doermake 25 | INCLUDE arrays 26 | INCLUDE pardot 27 | 28 | \ ======================================================================= 29 | \ String stuff 30 | \ ======================================================================= 31 | 32 | : " POSTPONE S" OVER + 0 SWAP C! ; 33 | -------------------------------------------------------------------------------- /lib/loading.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ loading.4th --- Library code for pfe, utilities for loading blocks. 3 | \ 4 | \ (duz 22May94) 5 | \ 6 | 7 | \ ======================================================================= 8 | \ more on blocks and loading 9 | \ ======================================================================= 10 | 11 | : #BLOCKS \ --- u ; number of blocks in current block file 12 | BLOCK-FILE FILE-SIZE ?FILE 1024 UM/MOD NIP ; 13 | 14 | : +LOAD \ n --- ; load screen relative 15 | ?LOADING BLK @ + LOAD ; 16 | 17 | : +THRU \ first last --- ; like THRU, relative block numbers 18 | ?LOADING SWAP BLK @ + SWAP BLK @ + THRU ; 19 | 20 | : INDEX \ first last --- ; show first lines of block range 21 | START?CR 22 | 1+ SWAP DO ?CR I 3 .R SPACE I BLOCK 64 TYPE 23 | LOOP SPACE ; 24 | 25 | : QX \ --- ; show first lines partially of every block in file 26 | CR START?CR 27 | #BLOCKS 0 DO 28 | OUT @ 20 + XMAX >= IF ?CR THEN 29 | I 3 .R SPACE I BLOCK 16 TYPE 30 | LOOP SPACE ; 31 | 32 | \ ======================================================================= 33 | \ end of loading.4th 34 | \ ======================================================================= 35 | 36 | CR .( Loading utilities loaded. ) 37 | -------------------------------------------------------------------------------- /lib/pardot.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ pardot.4th --- Paren-dot words, i.e. formatting numbers in strings 3 | \ 4 | \ (duz 26Jul94) 5 | \ 6 | 7 | : (UD.) ( ud --- ) <# #S #> ; 8 | : (U.) ( u --- ) 0 (UD.) ; 9 | 10 | : (D.) ( d --- ) TUCK DABS <# #S ROT SIGN #> ; 11 | : (.) ( n --- ) DUP ABS 0 <# #S ROT SIGN #> ; 12 | -------------------------------------------------------------------------------- /lib/sh-libs.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ sh_libs.4th --- Library code for pfe, Linux' shared libraries. 3 | \ By Kevin Haddock. 4 | \ 5 | \ (duz 22May94) 6 | \ 7 | 8 | \ ======================================================================= 9 | \ Shared libraries for Linux 10 | \ ======================================================================= 11 | 12 | S" HOST-SYSTEM" ENVIRONMENT? DROP S" Linux" COMPARE 0= [IF] 13 | 14 | \ creates shared library variable 15 | : GOT ( N _) CREATE , DOES> ( a) @ @ ; 16 | 17 | \ creates shared library call 18 | : PLT ( N _) CREATE , DOES> ( ... cw a - res) @ CALL-C ; 19 | 20 | [THEN] 21 | 22 | \ ======================================================================= 23 | \ end of sh-libs.4th 24 | \ ======================================================================= 25 | 26 | CR .( Linux shared library calls loaded. ) 27 | -------------------------------------------------------------------------------- /mk/fb-2-fs.pl: -------------------------------------------------------------------------------- 1 | #! /usr/bin/perl 2 | 3 | # convert a block (forth) script into a serial (forth) script 4 | # a block script has a fixed linelength of 64 chars and no 5 | # line end character. 6 | 7 | for (@ARGV) 8 | { 9 | if (/^--(.*)/) 10 | { 11 | print "no options available, sorry"; 12 | }else{ 13 | my $F = $_; 14 | my $line; 15 | open F, "<$F" or next; 16 | while ((read F, $line, 64)) 17 | { 18 | print $line,"\n"; 19 | } 20 | close F; 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /mk/fb-2-fs.py: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env python 2 | import sys 3 | 4 | # convert a block (forth) script into a serial (forth) script 5 | # a block script has a fixed linelength of 64 chars and no 6 | # line end character. 7 | 8 | for arg in sys.argv[1:]: 9 | if arg.startswith("--"): 10 | print "no options available, sorry" 11 | else: 12 | try: 13 | F = open (arg, "r") 14 | except IOError, x: 15 | print "could not open",arg,":",str(x) 16 | else: 17 | line = F.read(64) 18 | while len(line): 19 | sys.stdout.write(line) 20 | sys.stdout.write("\n") 21 | line = F.read(64) 22 | ## 23 | F.close() 24 | # 25 | # 26 | ## 27 | -------------------------------------------------------------------------------- /pfe/assembler-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(assembler); 5 | P4_MODULE_LIST (assembler); 6 | 7 | -------------------------------------------------------------------------------- /pfe/block-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- StackHelp for Block-Ext 3 | * 4 | * Copyright (C) Tektronix, Inc. 2003 - 2003. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:29 $) 11 | * 12 | * @description 13 | * see stackhelp-ext for details 14 | */ 15 | /*@{*/ 16 | #if defined(__version_control__) && defined(__GNUC__) 17 | static char* id __attribute__((unused)) = 18 | "@(#) $Id: block-stk.c,v 1.3 2008-04-20 04:46:29 guidod Exp $"; 19 | #endif 20 | 21 | #define _P4_SOURCE 1 22 | #include 23 | 24 | 25 | P4_LISTWORDS (block_check) = 26 | { 27 | P4_STKi ("BLOCK", "block# -- block*"), 28 | P4_STKi ("BUFFER", "block# -- block*"), 29 | P4_STKi ("SAVE-BUFFERS", "--"), 30 | P4_STKi ("EMPTY-BUFFERS", "--"), 31 | P4_STKi ("FLUSH", "--"), 32 | P4_STKi ("LIST", "block# --"), 33 | P4_STKi ("LOAD", "block# -- ?? "), 34 | P4_STKi ("THRU", "block1# block2# --"), 35 | P4_STKi ("UPDATE", "--"), 36 | P4_STKi ("BLK", "-- block#"), 37 | P4_STKi ("SCR", "-- scr"), 38 | /* block_misc */ 39 | P4_STKi ("CLOSE-BLOCKFILE", "--"), 40 | P4_STKi ("OPEN-BLOCKFILE", " --"), 41 | P4_STKi ("CREATE-BLOCKFILE", " --"), 42 | P4_STKi ("SET-BLOCKFILE", "file* --"), 43 | P4_STKi ("BLOCK-FILE", "-- file*"), 44 | P4_STKi ("B/BUF", "-- blocksize#"), 45 | }; 46 | P4_COUNTWORDS (block_check, "Check-Block words + extension"); 47 | 48 | /*@}*/ 49 | 50 | /* 51 | * Local variables: 52 | * c-file-style: "stroustrup" 53 | * End: 54 | */ 55 | -------------------------------------------------------------------------------- /pfe/cdecl-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Stackhelp for C-like declaration primitives 3 | * 4 | * Copyright (C) Tektronix, Inc. 2001 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:29 $) 11 | * 12 | * @description 13 | * some words that mimic partial behaviour of a C compiler 14 | * especially it's preprocessor. 15 | */ 16 | /*@{*/ 17 | #if defined(__version_control__) && defined(__GNUC__) 18 | static char* id __attribute__((unused)) = 19 | "@(#) $Id: cdecl-stk.c,v 1.3 2008-04-20 04:46:29 guidod Exp $"; 20 | #endif 21 | 22 | #define _P4_SOURCE 1 23 | #include 24 | #include 25 | 26 | P4_LISTWORDS (cdecl_check) = 27 | { 28 | P4_STKi ("#ELSE", "--"), /* want code (branch)*/ 29 | P4_STKi ("#ENDIF", "--"), /* want code (branch)*/ 30 | P4_STKi ("#IF", "val? --"), /* want code (branch)*/ 31 | P4_STKi ("#IFDEF", "[name] --"), /* want code (branch)*/ 32 | P4_STKi ("#IFNDEF", "[name] --"), /* want code (branch)*/ 33 | P4_STKi ("#IFNOTDEF", "[name] --"), /* want code (branch)*/ 34 | P4_STKi ("#IS_TRUE", "x -- x?"), 35 | P4_STKi ("#IS_FALSE", "x -- x?"), 36 | P4_STKi ("//", "[string] --"), 37 | P4_STKi ("#DEFINE", " --"), 38 | P4_STKi ("#PRAGMA", " -- ?"), 39 | }; 40 | P4_COUNTWORDS (cdecl_check, "Check-C-preprocessor declaration syntax"); 41 | 42 | /*@}*/ 43 | 44 | -------------------------------------------------------------------------------- /pfe/chain-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Stackhelp for CHAIN words 3 | * 4 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:30 $) 11 | * 12 | * @description 13 | * Allow for chained words in the interpreter core. 14 | */ 15 | /*@{*/ 16 | #if defined(__version_control__) && defined(__GNUC__) 17 | static char* id __attribute__((unused)) = 18 | "@(#) $Id: chain-stk.c,v 1.3 2008-04-20 04:46:30 guidod Exp $"; 19 | #endif 20 | 21 | #define _P4_SOURCE 1 22 | #include 23 | #include 24 | 25 | P4_LISTWORDS (chain_check) = 26 | { 27 | P4_STKi ("link,", "list -- "), 28 | P4_STKi ("chain-link", " -- var*"), 29 | P4_STKi (".chain", " --"), 30 | P4_STKi (".chains", "chain* --"), 31 | P4_STKi ("chain-add", "chain* --"), 32 | P4_STKi ("chain-add-before", "chain* --"), 33 | 34 | P4_STKi ("do-chain", "chain* --"), 35 | P4_STKi ("new-chain", " --"), 36 | P4_STKi ("xdo-chain", "chain* --"), 37 | P4_STKi ("new-sys-chain", " --"), 38 | /* P4_STKi ("semicolon-chain", "-- chain*"), */ 39 | }; 40 | P4_COUNTWORDS (chain_check, "Check-chain of executions"); 41 | 42 | /*@}*/ 43 | 44 | /* 45 | * Local variables: 46 | * c-file-style: "stroustrup" 47 | * End: 48 | */ 49 | -------------------------------------------------------------------------------- /pfe/chainlist-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Stackhelp for CHAINLIST words - executable WORDLISTs 3 | * 4 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:30 $) 11 | * 12 | * @description 13 | * Allow executables list embedded in the pfe interpreter 14 | * based on pure wordlists instead of defer link chains. 15 | */ 16 | /*@{*/ 17 | #if defined(__version_control__) && defined(__GNUC__) 18 | static char* id __attribute__((unused)) = 19 | "@(#) $Id: chainlist-stk.c,v 1.3 2008-04-20 04:46:30 guidod Exp $"; 20 | #endif 21 | 22 | #define _P4_SOURCE 1 23 | #include 24 | #include 25 | 26 | P4_LISTWORDS (chainlist_check) = 27 | { 28 | P4_STKi ("NEW-WORDLIST", " --"), 29 | P4_STKi (".WORDS", "wordlist* --"), 30 | P4_STKi ("REDO-ALL-WORDS", "wordlist* --"), 31 | P4_STKi ("DO-ALL-WORDS", "wordlist* --"), 32 | P4_STKi ("DO-ALL-WORDS-WHILE-LOOP", "wordlist* xt* --"), 33 | P4_STKi ("DO-ALL-WORDS-WHILE", "wordlist* xt* --"), 34 | P4_STKi ("DO-SYNONYM", "wordlist* --"), 35 | P4_STKi ("DO-ALIAS", "xt* on-wordlist* --"), 36 | P4_STKi ("ALIAS-ATEXIT", "xt* --"), 37 | P4_STKi ("ALIAS", "xt* --"), 38 | P4_STKi ("ATEXIT-WORDLIST", "-- atexit-wordlist*"), 39 | P4_STKi ("PROMPT-WORDLIST", "-- prompt-wordlist*"), 40 | P4_STKi ("ABORT-WORDLIST", "-- abort-wordlist*"), 41 | }; 42 | P4_COUNTWORDS (chainlist_check, "Check-chainlists - executable wordlists"); 43 | 44 | /*@}*/ 45 | 46 | /* 47 | * Local variables: 48 | * c-file-style: "stroustrup" 49 | * End: 50 | */ 51 | -------------------------------------------------------------------------------- /pfe/complex-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(complex); 5 | P4_MODULE_LIST (complex); 6 | 7 | -------------------------------------------------------------------------------- /pfe/complex-pfe.log: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/pfe/complex-pfe.log -------------------------------------------------------------------------------- /pfe/debug-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Stackhelp for PFE-Debug 3 | * 4 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:29 $) 11 | * 12 | */ 13 | /*@{*/ 14 | #if defined(__version_control__) && defined(__GNUC__) 15 | static char* id __attribute__((unused)) = 16 | "@(#) $Id: debug-stk.c,v 1.3 2008-04-20 04:46:29 guidod Exp $"; 17 | #endif 18 | 19 | #define _P4_SOURCE 1 20 | 21 | #include 22 | #include 23 | 24 | P4_LISTWORDS (debug_check) = 25 | { 26 | P4_INTO ("FORTH", 0), 27 | P4_STKi ("DEBUG", " --"), 28 | P4_STKi ("NO-DEBUG", " --"), 29 | P4_STKi ("(SEE)", "xt* --"), 30 | P4_STKi ("ADDR>NAME", "addr* -- nfa* | 0"), 31 | P4_STKi ("COME_BACK", "--"), 32 | 33 | P4_INTO ("ENVIRONMENT", 0), 34 | P4_STKi ("PFE-DEBUG", "-- level#"), 35 | }; 36 | P4_COUNTWORDS (debug_check, "Check-Debugger words"); 37 | 38 | /*@}*/ 39 | 40 | -------------------------------------------------------------------------------- /pfe/def-cell.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_DEF_CELL_H 2 | #define __PFE_DEF_CELL_H 3 | 4 | /* 5 | * -- The basic types 6 | * 7 | * Copyright (C) 2005 - 2008 Guido U. Draheim 8 | * 9 | * @see GNU LGPL 10 | * @author Guido U. Draheim (modified by $Author: guidod $) 11 | * @version $Revision: 1.4 $ 12 | * (modified $Date: 2008-04-20 04:46:31 $) 13 | * 14 | * note that TYPEOF_CELL is either long or int. 15 | * It must be atleast as big as a pointer. 16 | */ 17 | #include 18 | 19 | typedef unsigned char p4char; /* hopefully an 8-bit type */ 20 | typedef unsigned short p4word; /* hopefully a 16-bit type */ 21 | 22 | typedef unsigned char const p4cchar; 23 | 24 | typedef PFE_TYPEOF_CELL p4cell; /* a stack item */ 25 | typedef unsigned PFE_TYPEOF_CELL p4ucell; /* dito unsigned */ 26 | 27 | # if PFE_SIZEOF_CELL+0 == PFE_SIZEOF_LONG+0 28 | typedef long p4celll; /* using the C type "long" saves us */ 29 | typedef unsigned long p4ucelll; /* a couple of warnings on LP64 */ 30 | # else 31 | typedef p4cell p4celll; /* FIXME: default p4cell should be "long" */ 32 | typedef p4ucell p4celll; /* instead of the traditional "int" default */ 33 | # endif 34 | 35 | typedef struct 36 | { 37 | p4cell hi; 38 | p4ucell lo; 39 | } p4dcell; /* dito, double precision signed */ 40 | 41 | typedef struct 42 | { 43 | p4ucell hi; 44 | p4ucell lo; 45 | } p4udcell; /* dito, double precision unsigned */ 46 | 47 | typedef struct /* "map" of a cell */ 48 | { 49 | #if PFE_BYTEORDER == 4321 50 | unsigned PFE_TYPEOF_HALFCELL hi; 51 | unsigned PFE_TYPEOF_HALFCELL lo; 52 | #else 53 | unsigned PFE_TYPEOF_HALFCELL lo; 54 | unsigned PFE_TYPEOF_HALFCELL hi; 55 | #endif 56 | } p4ucell_hi_lo; 57 | 58 | typedef p4char p4_byte_t; /* adressing element */ 59 | typedef p4char p4_char_t; /* i/o char element */ 60 | typedef p4cell p4_cell_t; /* computational element */ 61 | typedef p4cell p4_bool_t; /* and as boolean flag */ 62 | 63 | #endif 64 | -------------------------------------------------------------------------------- /pfe/def-limits.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_DEF_LIMITS_H 2 | #define __PFE_DEF_LIMITS_H 3 | 4 | #ifndef CHAR_BIT 5 | #include 6 | #endif 7 | 8 | #ifndef BITSOF 9 | #define BITSOF(X) ((int)(sizeof (X) * CHAR_BIT)) 10 | #endif 11 | 12 | /* Maximum number of bytes allowed in a terminal input queue. 13 | * _POSIX_MAX_INPUT minimum value: 255 (also used on Linux) 14 | */ 15 | #ifdef MAX_INPUT 16 | #define P4_MAX_INPUT MAX_INPUT 17 | #else 18 | #define P4_MAX_INPUT 255 19 | #endif 20 | 21 | /* Unless otherwise noted, the maximum length, in bytes, of a utility's 22 | * input line (either standard input or another file), when the utility 23 | * is described as processing text files. The length includes room for the 24 | * trailing newline. Minimum Acceptable Value: _POSIX2_LINE_MAX = 2048 25 | */ 26 | #ifdef LINE_MAX 27 | #define P4_LINE_MAX LINE_MAX 28 | #else 29 | #define P4_LINE_MAX 2048 30 | #endif 31 | 32 | /* Maximum number of bytes that is guaranteed to be atomic when writing 33 | * to a pipe. Minimum value is _POSIX_PIPE_BUF = 512 34 | */ 35 | #ifdef PIPE_BUF 36 | #define P4_PIPE_BUF PIPE_BUF 37 | #else 38 | #define P4_PIPE_BUF 512 39 | #endif 40 | 41 | /* Maximum length of argument to the exec functions including environment 42 | * data. Minimum Acceptable Value: _POSIX_ARG_MAX = 4096 43 | */ 44 | #ifdef ARG_MAX 45 | #define P4_ARG_MAX 46 | #else 47 | #define P4_ARG_MAX 4096 48 | #endif 49 | 50 | #endif 51 | -------------------------------------------------------------------------------- /pfe/def-regth.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_DEF_THREADP_H 2 | #define __PFE_DEF_THREADP_H 3 | /* 4 | * Copyright (C) 2005 - 2008 Guido U. Draheim 5 | * 6 | * @see GNU LGPL 7 | * @author Guido U. Draheim (modified by $Author: guidod $) 8 | * @version $Revision: 1.3 $ 9 | * (modified $Date: 2008-04-20 04:46:29 $) 10 | */ 11 | 12 | /* requires P4_REGTH declaration */ 13 | #include 14 | 15 | #ifdef _P4_NO_REGS_SOURCE 16 | #ifdef __GNUC__ 17 | #warning including def-regs.h in a pfe c source file that does not want it 18 | /* some sources do not want the reserved set of global machine registers */ 19 | #endif 20 | #endif 21 | 22 | struct p4_Thread; 23 | struct p4_Session; 24 | 25 | # ifdef P4_REGTH 26 | # define PFE_USE_THREAD_POINTER 27 | # elif defined PFE_WITH_STATIC_REGS 28 | # define PFE_USE_THREAD_BLOCK 29 | # else 30 | # define PFE_USE_THREAD_POINTER 31 | # endif 32 | 33 | # if PFE_HAS_TLS_SUPPORT+0 34 | # define PFE_CC_THREADED __thread 35 | /* FIXME: __thread seems to be broken */ 36 | # undef PFE_CC_THREADED 37 | # define PFE_CC_THREADED 38 | # else 39 | # define PFE_CC_THREADED 40 | # endif 41 | 42 | # ifdef PFE_USE_THREAD_POINTER 43 | # ifdef P4_REGTH 44 | register struct p4_Thread* p4TH asm (P4_REGTH); 45 | # else 46 | extern PFE_CC_THREADED struct p4_Thread* p4TH; 47 | # endif 48 | # else 49 | # define p4TH (&p4_reg) 50 | extern PFE_CC_THREADED struct p4_Thread p4_reg; 51 | extern PFE_CC_THREADED struct p4_Session p4_opt; 52 | # endif 53 | 54 | /* the THREAD_BLOCK structs are defined in option-set.c */ 55 | 56 | /* actually, the following two defines are the same when p4TH == &p4_reg */ 57 | /* but for debugging, the .c -> .i precompiler output is better readable */ 58 | #ifdef PFE_USE_THREAD_BLOCK 59 | #define PFE p4_reg 60 | #else /* _USE_THREAD_POINTER */ 61 | #define PFE (*p4TH) 62 | #endif 63 | 64 | #endif 65 | -------------------------------------------------------------------------------- /pfe/dict-comp.h: -------------------------------------------------------------------------------- 1 | #ifndef _PFE_DICT_COMP_H 2 | #define _PFE_DICT_COMP_H 1209930552 3 | /* generated 2008-0504-2149 ../../pfe/../mk/Make-H.pl ../../pfe/dict-comp.c */ 4 | 5 | #include 6 | 7 | /** 8 | * Compile definitions, load-time with load-wordl, runtime with compile-comma 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.6 $ 16 | * (modified $Date: 2008-05-04 19:53:05 $) 17 | */ 18 | 19 | #ifdef __cplusplus 20 | extern "C" { 21 | #endif 22 | 23 | 24 | extern p4xcode* p4_compile_comma (p4xcode* at, p4xt); 25 | extern p4xcode* p4_compile_xcode (p4xcode* at, p4xcode); 26 | extern p4xcode* p4_compile_xcode_CODE (p4xcode* at, p4xcode); 27 | extern p4xcode* p4_compile_xcode_BODY (p4xcode* at, p4xcode, p4cell*); 28 | 29 | 30 | extern P4_CODE (p4_forget_wordset_RT); 31 | 32 | _extern void p4_load_words (const p4Words* ws, p4_Wordl* wid, int unused) ; /*{*/ 33 | 34 | _extern void p4_sbr_call (p4xt xt) ; /*{*/ 35 | 36 | #ifdef __cplusplus 37 | } /* extern "C" */ 38 | #endif 39 | 40 | 41 | #endif 42 | -------------------------------------------------------------------------------- /pfe/double-sub.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_DOUBLE_SUB_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_DOUBLE_SUB_H 1209868835 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/double-sub.c */ 4 | 5 | #include 6 | 7 | #ifdef __cplusplus 8 | extern "C" { 9 | #endif 10 | 11 | 12 | #define dnegate p4_d_negate 13 | #define dadd p4_d_plus 14 | #define ummul p4_d_ummul 15 | #define mmul p4_d_mmul 16 | #define umdiv p4_d_umdiv 17 | #define smdiv p4_d_smdiv 18 | #define fmdiv p4_d_fmdiv 19 | 20 | 21 | /** left shift of *a by n positions */ 22 | _extern void p4_d_shiftleft (p4dcell *a, int n) ; /*{*/ 23 | 24 | /** arithm. right shift of *a by n positions */ 25 | _extern void p4_d_shiftright (p4dcell *a, int n) ; /*{*/ 26 | 27 | /** add b to a */ 28 | _extern void p4_um_plus (p4dcell * a, p4ucell b) ; /*{*/ 29 | 30 | /** add b to a */ 31 | _extern void p4_d_plus (p4dcell * a, p4dcell * b) ; /*{*/ 32 | 33 | /** subtract b from a */ 34 | _extern void p4_d_minus (p4dcell * a, p4dcell * b) ; /*{*/ 35 | 36 | /** negate a */ 37 | _extern void p4_d_negate (p4dcell * a) ; /*{*/ 38 | 39 | /** result: a < b */ 40 | _extern int p4_d_less (p4dcell * a, p4dcell * b) ; /*{*/ 41 | 42 | /** result: a < b */ 43 | _extern int p4_d_u_less (p4udcell * a, p4udcell * b) ; /*{*/ 44 | 45 | /** unsigned multiply, mixed precision */ 46 | _extern p4udcell p4_d_ummul (p4ucell a, p4ucell b) ; /*{*/ 47 | 48 | /** signed multiply, mixed precision */ 49 | _extern p4dcell p4_d_mmul (p4cell a, p4cell b) ; /*{*/ 50 | 51 | /** unsigned divide procedure, mixed precision */ 52 | _extern udiv_t p4_d_umdiv (p4udcell num, p4ucell denom) ; /*{*/ 53 | 54 | /** symmetric divide procedure, mixed precision */ 55 | _extern fdiv_t p4_d_smdiv (p4dcell num, p4cell denom) ; /*{*/ 56 | 57 | /** floored divide procedure, mixed precision */ 58 | _extern fdiv_t p4_d_fmdiv (p4dcell num, p4cell denom) ; /*{*/ 59 | 60 | #ifdef __cplusplus 61 | } /* extern "C" */ 62 | #endif 63 | 64 | 65 | #endif 66 | -------------------------------------------------------------------------------- /pfe/dstrings-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(dstrings); 5 | P4_MODULE_LIST (dstrings); 6 | 7 | -------------------------------------------------------------------------------- /pfe/edit-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(edit); 5 | P4_MODULE_LIST (edit); 6 | 7 | -------------------------------------------------------------------------------- /pfe/edit-ext.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_EDIT_EXT_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_EDIT_EXT_H 1209868838 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/edit-ext.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- simple FORTH-screenfile editor 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2000. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | * 18 | * @description 19 | * This is a simple fullscreen FORTH block editor. 20 | * 21 | * will be missing in most builds 22 | * 23 | */ 24 | 25 | #ifdef __cplusplus 26 | extern "C" { 27 | #endif 28 | 29 | 30 | 31 | 32 | extern P4_CODE (p4_edit_forget); 33 | 34 | extern P4_CODE (p4_edit_init); 35 | 36 | /** EDIT-BLOCK ( blk -- ) 37 | * start the internal block-editor on the assigned block 38 | */ 39 | extern P4_CODE (p4_edit_block); 40 | 41 | /** EDIT-TEXT name ( -- ) 42 | * start an external => EDITOR with the specified filename 43 | */ 44 | extern P4_CODE (p4_edit_text); 45 | 46 | /** EDIT-ERROR ( -- ) 47 | * if an error occured, this routine can be called to invoke 48 | * an appropriate => EDITOR (see also =>"EDIT-BLOCK") 49 | */ 50 | extern P4_CODE (p4_edit_error); 51 | 52 | #ifdef __cplusplus 53 | } /* extern "C" */ 54 | #endif 55 | 56 | 57 | #endif 58 | -------------------------------------------------------------------------------- /pfe/exception-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Stackhelp for The Optional Exception Word Set 3 | * 4 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:30 $) 11 | * 12 | * @description 13 | * These words implement an exception system in the 14 | * widely known => THROW & => CATCH concept. 15 | * 16 | * see the PFE-SIG wordset for catching OS traps. 17 | */ 18 | /*@{*/ 19 | #if defined(__version_control__) && defined(__GNUC__) 20 | static char* id __attribute__((unused)) = 21 | "@(#) $Id: exception-stk.c,v 1.3 2008-04-20 04:46:30 guidod Exp $"; 22 | #endif 23 | 24 | #define _P4_SOURCE 1 25 | 26 | #include 27 | #include 28 | 29 | P4_LISTWORDS (exception_check) = 30 | { 31 | P4_STKi ("CATCH", "xt* -- exception! | 0"), 32 | P4_STKi ("THROW", "exception! -- [THROW] | exception# -- "), 33 | P4_STKi ("ABORT", "-- [THROW]"), 34 | P4_STKi ("ABORT\"", "[string] -- [THROW]"), 35 | 36 | P4_INTO ("EXTENSIONS", 0), 37 | P4_STKi ("NEXT-EXCEPTION", "-- exception#*"), 38 | }; 39 | P4_COUNTWORDS (exception_check, "Check-Exception + extensions"); 40 | 41 | /*@}*/ 42 | 43 | -------------------------------------------------------------------------------- /pfe/exception-sub.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_EXCEPTION_SUB_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_EXCEPTION_SUB_H 1209868837 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/exception-sub.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- Exception-oriented Subroutines. 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.6 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | */ 18 | 19 | #ifdef __cplusplus 20 | extern "C" { 21 | #endif 22 | 23 | 24 | #define p4_longjmp_abort() (p4_longjmp_loop('A')) 25 | #define p4_longjmp_exit() (p4_longjmp_loop('X')) 26 | #define p4_longjmp_quit() (p4_longjmp_loop('Q')) 27 | #define p4_longjmp_yield() (p4_longjmp_loop('S')) 28 | 29 | 30 | extern P4_CODE (p4_cr_show_input); 31 | 32 | /** 33 | * just call longjmp on PFE.loop 34 | */ 35 | _extern void p4_longjmp_loop(int arg) ; /*{*/ 36 | 37 | /** 38 | * the CATCH impl 39 | */ 40 | _extern int p4_catch (p4xt xt) ; /*{*/ 41 | 42 | _extern void p4_throw (int id) ; /*{*/ 43 | 44 | _extern void p4_throwstr (int id, const char* description) ; /*{*/ 45 | 46 | /** 47 | * the THROW impl 48 | */ 49 | _extern void p4_throws (int id, const p4_char_t* description, int len) ; /*{*/ 50 | 51 | #ifdef __cplusplus 52 | } /* extern "C" */ 53 | #endif 54 | 55 | 56 | #endif 57 | -------------------------------------------------------------------------------- /pfe/facility-mix.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_FACILITY_MIX_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_FACILITY_MIX_H 1209868837 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/facility-mix.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- Words making sense in POSIX-like systems only. 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | * 18 | * @description 19 | * This file exports a set of system words for 20 | * a posixish OS environment. So should do 21 | * any alternative wordset you might create for your OS. 22 | */ 23 | 24 | #ifdef __cplusplus 25 | extern "C" { 26 | #endif 27 | 28 | 29 | 30 | 31 | /** #! ( "..." -- ) 32 | * ignores the rest of the line, 33 | * defining `#!' is used to support forth scripts 34 | * executed by the unix kernel 35 | */ 36 | extern P4_CODE (p4_ignore_line); 37 | 38 | /** CLOCK@ ( --- clock-ticks# ) [EXT] 39 | * return clock(2) - the number of clocks of this proces. 40 | * To get the number of seconds, divide by CLOCKS_PER_SEC a.k.a. CLK_TCK 41 | * as represented in the => ENVIROMENT for a hosted forth system. 42 | * 43 | * Remember that the process clock will wrap around at some point, 44 | * therefore only use difference values between two clock reads. 45 | */ 46 | extern P4_CODE (p4_clock_fetch); 47 | 48 | #ifdef __cplusplus 49 | } /* extern "C" */ 50 | #endif 51 | 52 | 53 | #endif 54 | -------------------------------------------------------------------------------- /pfe/facility-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * --- Stackhelp for The Optional Facility Word Set 3 | * 4 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:29 $) 11 | */ 12 | /*@{*/ 13 | #if defined(__version_control__) && defined(__GNUC__) 14 | static char* id __attribute__((unused)) = 15 | "@(#) $Id: facility-stk.c,v 1.3 2008-04-20 04:46:29 guidod Exp $"; 16 | #endif 17 | 18 | #define _P4_SOURCE 1 19 | 20 | #include 21 | #include 22 | 23 | P4_LISTWORDS (facility_check) = 24 | { 25 | P4_STKi ("AT-XY", "col# row# --"), 26 | P4_STKi ("KEY?", "-- key?"), 27 | P4_STKi ("PAGE", "--"), 28 | P4_STKi ("EKEY", "-- key-code#"), 29 | P4_STKi ("EKEY>CHAR", "key-code# -- key-code# 0 | char# true!"), 30 | P4_STKi ("EKEY?", "-- ekey?"), 31 | P4_STKi ("EMIT?", "-- emit?"), 32 | P4_STKi ("MS", "milliseconds# --"), 33 | P4_STKi ("TIME&DATE", "-- sec# min# hrs# day# month# year#"), 34 | 35 | P4_INTO ("ENVIRONMENT", 0 ), 36 | P4_STKi ("FACILITY-EXT", "-- year# true! | 0" ), 37 | }; 38 | P4_COUNTWORDS (facility_check, "Check-Facility + extensions"); 39 | 40 | /*@}*/ 41 | 42 | -------------------------------------------------------------------------------- /pfe/file-sub.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_FILE_SUB_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_FILE_SUB_H 1209868837 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/file-sub.c */ 4 | 5 | #include 6 | 7 | /** 8 | * Subroutines for file access 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | */ 18 | 19 | #ifdef __cplusplus 20 | extern "C" { 21 | #endif 22 | 23 | 24 | 25 | 26 | _extern _p4_off_t p4_file_size (FILE * f) /* Result: file length, -1 on error */ ; /*{*/ 27 | 28 | _extern _p4_off_t p4_file_copy (const char *src, const char *dst, _p4_off_t limit) /* * Copies file, but at most limit characters. * Returns destination file length if successful, -1 otherwise. */ ; /*{*/ 29 | 30 | _extern int p4_file_move (const char *src, const char *dst) ; /*{*/ 31 | 32 | _extern int p4_file_resize (const char *fn, _p4_off_t new_size) ; /*{*/ 33 | 34 | #ifdef __cplusplus 35 | } /* extern "C" */ 36 | #endif 37 | 38 | 39 | #endif 40 | -------------------------------------------------------------------------------- /pfe/floating-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(floating); 5 | P4_MODULE_LIST (floating); 6 | 7 | -------------------------------------------------------------------------------- /pfe/forth-83-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Stackhelp for Compatiblity with the FORTH-83 standard. 3 | * 4 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:31 $) 11 | * 12 | * @description 13 | * All FORTH-83-Standard words are included here that are not 14 | * in the dpANS already. 15 | * Though most of the "uncontrolled reference words" are omitted. 16 | */ 17 | /*@{*/ 18 | #if defined(__version_control__) && defined(__GNUC__) 19 | static char* id __attribute__((unused)) = 20 | "@(#) $Id: forth-83-stk.c,v 1.3 2008-04-20 04:46:31 guidod Exp $"; 21 | #endif 22 | 23 | #define _P4_SOURCE 1 24 | 25 | #include 26 | #include 27 | 28 | P4_LISTWORDS (forth_83_check) = 29 | { 30 | P4_STKi ("2+", "a# -- a#' | a* -- a*'"), 31 | P4_STKi ("2-", "a# -- a#' | a* -- a*'"), 32 | P4_STKi ("?TERMINAL", ""), 33 | P4_STKi ("COMPILE", " --"), 34 | P4_STKi ("VOCABULARY", " --"), 35 | 36 | P4_STKi ("-->", "--"), 37 | P4_STKi ("INTERPRET", "--"), 38 | P4_STKi ("K", "-- loop#"), 39 | P4_STKi ("OCTAL", "--"), 40 | P4_STKi ("SP@", "-- sp-cell*"), 41 | 42 | P4_STKi ("!BITS", "x-bits# x-addr* mask# --"), 43 | P4_STKi ("@BITS", "x-addr* mask# -- x-bits#"), 44 | P4_STKi ("_like:NTOHS", "a -- a'"), 45 | P4_STKi ("_like:NTOHS-MOVE", "from-addr* to-addr* count# --"), 46 | P4_STKi ("**", "a# b# -- power#"), 47 | P4_STKi ("DPL", "dpl-cell*"), 48 | 49 | P4_STKi ("SEAL", "--"), 50 | }; 51 | P4_COUNTWORDS (forth_83_check, "Check-Forth'83 compatibility"); 52 | 53 | /*@}*/ 54 | 55 | /* 56 | * Local variables: 57 | * c-file-style: "stroustrup" 58 | * End: 59 | */ 60 | 61 | -------------------------------------------------------------------------------- /pfe/fpnostack-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(fpnostack); 5 | P4_MODULE_LIST (fpnostack); 6 | 7 | -------------------------------------------------------------------------------- /pfe/gforth-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(gforth); 5 | P4_MODULE_LIST (gforth); 6 | 7 | -------------------------------------------------------------------------------- /pfe/help-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(help); 5 | P4_MODULE_LIST (help); 6 | 7 | -------------------------------------------------------------------------------- /pfe/help-ext.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_HELP_EXT_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_HELP_EXT_H 1209868838 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/help-ext.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- extra words for external HELP system 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | * 18 | * @description 19 | * we grep the installed header files for comments ;-) 20 | */ 21 | 22 | #ifdef __cplusplus 23 | extern "C" { 24 | #endif 25 | 26 | 27 | 28 | 29 | /** (HELP) ( str-ptr str-len -- ) 30 | * display help for the specified word 31 | * (not functional yet) 32 | */ 33 | extern P4_CODE (p4_paren_help); 34 | 35 | #ifdef __cplusplus 36 | } /* extern "C" */ 37 | #endif 38 | 39 | 40 | #endif 41 | -------------------------------------------------------------------------------- /pfe/incl-ext.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_INCL_EXT_H 2 | #define __PFE_INCL_EXT_H 3 | /** 4 | * Copyright (C) Tektronix, Inc. 1998 - 2000. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:30 $) 11 | */ 12 | 13 | /* didn't you include it beforehand ? */ 14 | #include 15 | 16 | #include 17 | #include 18 | #include 19 | #include 20 | 21 | #endif 22 | 23 | -------------------------------------------------------------------------------- /pfe/incl-mix.h: -------------------------------------------------------------------------------- 1 | #include 2 | -------------------------------------------------------------------------------- /pfe/incl-sub.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_DEF_SUB_H 2 | #define __PFE_DEF_SUB_H 3 | /** 4 | * Copyright (C) Tektronix, Inc. 1998 - 2000. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:30 $) 11 | */ 12 | 13 | #include 14 | #include 15 | #include 16 | #include 17 | 18 | #endif 19 | -------------------------------------------------------------------------------- /pfe/incl-sup.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_INCL_SUP_H 2 | #define __PFE_INCL_SUP_H 3 | 4 | /** 5 | * -- declare types and prototypes for support.c 6 | * 7 | * Copyright (C) Tektronix, Inc. 1998 - 2000. 8 | * Copyright (C) 2005 - 2008 Guido U. Draheim 9 | * 10 | * @see GNU LGPL 11 | * @author Guido U. Draheim (modified by $Author: guidod $) 12 | * @version $Revision: 1.3 $ 13 | * (modified $Date: 2008-04-20 04:46:30 $) 14 | * 15 | * @description 16 | * most of the routines of the internal forth system 17 | * are declared here 18 | */ 19 | /*@{*/ 20 | 21 | #include 22 | 23 | #ifndef FILE 24 | #include 25 | #endif 26 | 27 | #include 28 | #include 29 | #include 30 | #include 31 | #include 32 | #include 33 | 34 | /*@}*/ 35 | #endif 36 | -------------------------------------------------------------------------------- /pfe/libltdl/README: -------------------------------------------------------------------------------- 1 | This is GNU libltdl, a system independent dlopen wrapper for GNU libtool. 2 | 3 | It supports the following dlopen interfaces: 4 | * dlopen (POSIX) 5 | * shl_load (HP-UX) 6 | * LoadLibrary (Win16 and Win32) 7 | * load_add_on (BeOS) 8 | * GNU DLD (emulates dynamic linking for static libraries) 9 | * dyld (darwin/Mac OS X) 10 | * libtool's dlpreopen 11 | -- 12 | Copyright (C) 1999, 2003, 2011-2015 Free Software Foundation, Inc. 13 | Written by Thomas Tanner, 1999 14 | 15 | This file is part of GNU Libtool. 16 | 17 | Copying and distribution of this file, with or without modification, 18 | are permitted in any medium without royalty provided the copyright 19 | notice and this notice are preserved. This file is offered as-is, 20 | without warranty of any kind. 21 | -------------------------------------------------------------------------------- /pfe/libltdl/m4/ltversion.m4: -------------------------------------------------------------------------------- 1 | # ltversion.m4 -- version numbers -*- Autoconf -*- 2 | # 3 | # Copyright (C) 2004 Free Software Foundation, Inc. 4 | # Written by Scott James Remnant, 2004 5 | # 6 | # This file is free software; the Free Software Foundation gives 7 | # unlimited permission to copy and/or distribute it, with or without 8 | # modifications, as long as this notice is preserved. 9 | 10 | # Generated from ltversion.in. 11 | 12 | # serial 3012 ltversion.m4 13 | # This file is part of GNU Libtool 14 | 15 | m4_define([LT_PACKAGE_VERSION], [2.2.6]) 16 | m4_define([LT_PACKAGE_REVISION], [1.3012]) 17 | 18 | AC_DEFUN([LTVERSION_VERSION], 19 | [macro_version='2.2.6' 20 | macro_revision='1.3012' 21 | _LT_DECL(, macro_version, 0, [Which release of libtool.m4 was used?]) 22 | _LT_DECL(, macro_revision, 0) 23 | ]) 24 | -------------------------------------------------------------------------------- /pfe/lined.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_LINED_H 2 | #define __PFE_LINED_H 3 | 4 | /** 5 | * -- declarations for line editor 6 | * 7 | * Copyright (C) Tektronix, Inc. 1998 - 2000. 8 | * Copyright (C) 2005 - 2008 Guido U. Draheim 9 | * 10 | * @see GNU LGPL 11 | * @author Guido U. Draheim (modified by $Author: guidod $) 12 | * @version $Revision: 1.3 $ 13 | * (modified $Date: 2008-04-20 04:46:29 $) 14 | */ 15 | /*@{*/ 16 | 17 | #include 18 | 19 | /* Simple input of one line only: initialize the members string and max_length 20 | and all others with 0, then call p4_lined(). 21 | For luxury: before first call to p4_lined() initialize history and 22 | history_max with a static or calloc()-ed memory area, all others with 0. 23 | Then don't touch the components between further calls to lined() 24 | */ 25 | 26 | struct lined 27 | { 28 | char *string; /* where to place the result */ 29 | int max_length; /* maximum chars to input */ 30 | char *history; /* where the history is kept */ 31 | int history_max; /* size of history area */ 32 | int (*complete) /* called on tab key for completion */ 33 | (char *in, /* string typed so far */ 34 | char *out, /* possible completion */ 35 | int display); /* flag: display alternatives */ 36 | void (**executes) (int); /* NULL or list of functions bound to keys */ 37 | int length; /* output: how many chars actually typed */ 38 | char overtype, caps, hidden, unused; /* flags */ 39 | /* these are for internal use only: */ 40 | int cursor; /* position in the string */ 41 | int history_length; /* how much history is available */ 42 | int history_read; /* when using arrow up and down: */ 43 | int history_write; /* where you are in that mass of strings. */ 44 | /* some extensions that came in later: */ 45 | int (*intercept) (char* str, int len); /* returns new length of 'str' */ 46 | void *user3, *user2, *user1; /* padded to 16*32bit on 32bit machines */ 47 | }; 48 | 49 | int p4_lined (struct lined *l, char *dflt); 50 | 51 | /*@}*/ 52 | #endif 53 | 54 | 55 | 56 | 57 | -------------------------------------------------------------------------------- /pfe/main-alloc.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Process command line, get memory and start up. 3 | * 4 | * Copyright (C) Tektronix, Inc. 1999 - 2001. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:29 $) 11 | * 12 | * @description 13 | * Process command line, get memory and start up the interpret loop of PFE 14 | */ 15 | /*@{*/ 16 | 17 | #if defined(__version_control__) && defined(__GNUC__) 18 | static char* id __attribute__((unused)) = 19 | "@(#) $Id: main-alloc.c,v 1.3 2008-04-20 04:46:29 guidod Exp $"; 20 | #endif 21 | 22 | #define _P4_SOURCE 1 23 | 24 | #include 25 | #include 26 | #include 27 | #include 28 | 29 | #ifdef PFE_WITH_STATIC_DICT 30 | static char memory[P4_KB*1024]; /* BSS */ 31 | #endif 32 | 33 | int 34 | main (int argc, const char** argv) 35 | { 36 | p4_Session* session; 37 | p4_Thread* thread; 38 | int i; 39 | 40 | session = p4_NewSessionOptions (500); 41 | if (!session) return 1; 42 | if ((i=p4_AddOptions (session, argc, argv))) return i-1; 43 | 44 | # ifndef PFE_WITH_MODULES 45 | { extern p4Words P4WORDS(internal); 46 | if ((i=p4_SetModules (session, &(P4WORDS(internal))))) return i-1; 47 | } 48 | # endif 49 | 50 | # ifdef PFE_WITH_STATIC_DICT 51 | session->total_size = P4_KB*1024; 52 | p4_SetDictMem(thread, memory); 53 | # endif 54 | 55 | thread = p4_NewThreadOptions(session); 56 | i = p4_Exec (thread); 57 | p4_FreeThreadPtr (thread); 58 | p4_FreeOptions (i, session); 59 | p4_FreeSessionPtr (session); 60 | return i; 61 | } 62 | 63 | -------------------------------------------------------------------------------- /pfe/main-def.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Process command line, get memory and start up. 3 | * 4 | * Copyright (C) Tektronix, Inc. 1999 - 2001. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:30 $) 11 | * 12 | * @description 13 | * Process command line, get memory and start up the interpret loop of PFE 14 | */ 15 | /*@{*/ 16 | 17 | #include "pfe/_config.h" 18 | 19 | #if defined PFE_WITH_STATIC_REGS 20 | #include "main-alloc.c" 21 | #elif defined PFE_WITH_STATIC_DICT 22 | #include "main-static.c" 23 | #else 24 | #include "main-stdc.c" 25 | #endif 26 | 27 | /*@}*/ 28 | 29 | -------------------------------------------------------------------------------- /pfe/main-k12.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_MAIN_K12_H 2 | #define __PFE_MAIN_K12_H 3 | /** @name main-k12.h 4 | * 5 | * Copyright (C) Tektronix, Inc. 1998 - 2000. 6 | * 7 | * @see GNU LGPL 8 | * @author Tektronix CTE (modified by $Author: guidod $) 9 | * @version $Revision: 1.2 $ 10 | * (modified $Date: 2006-08-11 22:56:04 $) 11 | */ 12 | /*@{ */ 13 | 14 | #include 15 | 16 | typedef char _p4_msc_string_buffer_t[256]; 17 | 18 | typedef struct /* FIXME: Later deletion planned! */ 19 | { 20 | int msc_ints[16]; 21 | _p4_msc_string_buffer_t msc_strings[16]; 22 | int msc_timers[64]; 23 | } _p4_msc_var_buf_t; 24 | 25 | typedef struct 26 | { 27 | struct k12_priv private; 28 | union { 29 | p4_Session old; 30 | struct { 31 | char blocked; /* #define config_blocked has.config.blocked */ 32 | char const** scriptfile; 33 | char const** scriptpath; /* session.inc_paths */ 34 | } config; 35 | } has; 36 | struct p4_Thread thread; 37 | _p4_msc_var_buf_t msc_vars; 38 | struct p4_Session session; 39 | char extra[1024]; 40 | } p4_emu_t; 41 | 42 | extern k12_emu_table_t p4_emu_table; 43 | 44 | #define P4_K12_EMUL(P) ((p4_emu_t*)((P)->priv)) 45 | 46 | extern char* k12_pfe_sap_table[]; 47 | 48 | /*@}*/ 49 | #endif 50 | -------------------------------------------------------------------------------- /pfe/main-static.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Process command line, get memory and start up. 3 | * 4 | * Copyright (C) Tektronix, Inc. 1999 - 2001. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:30 $) 11 | * 12 | * @description 13 | * Process command line, get memory and start up the interpret loop of PFE 14 | */ 15 | /*@{*/ 16 | 17 | #if defined(__version_control__) && defined(__GNUC__) 18 | static char* id __attribute__((unused)) = 19 | "@(#) $Id: main-static.c,v 1.3 2008-04-20 04:46:30 guidod Exp $"; 20 | #endif 21 | 22 | #define _P4_SOURCE 1 23 | 24 | #include 25 | #include 26 | #include 27 | #include 28 | 29 | static char memory[P4_KB*1024]; /* BSS */ 30 | 31 | int 32 | main (int argc, char** argv) 33 | { 34 | p4_Thread* thread; 35 | p4_Session session; 36 | int i; 37 | 38 | if ((i=p4_SetOptions (&session, 0, argc, argv))) return i-1; 39 | # ifndef PFE_WITH_MODULES 40 | { extern p4Words P4WORDS(internal); 41 | if ((i=p4_SetModules (&session, &(P4WORDS(internal))))) return i-1; 42 | } 43 | # endif 44 | 45 | thread = (p4_Thread*) memory; 46 | p4_memset (thread, 0, sizeof(p4_Thread)); 47 | 48 | /* how to override the size of the dict if the user did use an option? */ 49 | p4_SetDictMem(thread, memory+sizeof(p4_Thread)); 50 | thread->set = &session; 51 | 52 | return p4_Exec (thread); 53 | } 54 | 55 | -------------------------------------------------------------------------------- /pfe/main-sub.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- Process command line, get memory and start up. 3 | * 4 | * Copyright (C) Tektronix, Inc. 1998 - 2003. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:31 $) 11 | * 12 | * @description 13 | * Process command line, get memory and start up the interpret loop of PFE 14 | */ 15 | /*@{*/ 16 | #if defined(__version_control__) && defined(__GNUC__) 17 | static char* id __attribute__((unused)) = 18 | "@(#) $Id: main-sub.c,v 1.3 2008-04-20 04:46:31 guidod Exp $"; 19 | #endif 20 | 21 | #error DO NOT USE main-sub.c anymore - compile option-set.c and engine-set.c 22 | -------------------------------------------------------------------------------- /pfe/main-sub.h: -------------------------------------------------------------------------------- 1 | #ifdef __GNUC__ 2 | #warning DO NOT USE main-sub.h - use engine-set.h and option-set.h 3 | #endif 4 | 5 | #include 6 | #include 7 | -------------------------------------------------------------------------------- /pfe/memory-alloc-ext.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_MEMORY_ALLOC_EXT_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_MEMORY_ALLOC_EXT_H 1209868837 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/memory-alloc-ext.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- The Optional Memory Allocation Word Set 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | * 18 | * @description 19 | * The optional memory allocation wordset interfaces to 20 | * the surrounding OS heap memory management. 21 | */ 22 | 23 | #ifdef __cplusplus 24 | extern "C" { 25 | #endif 26 | 27 | 28 | 29 | 30 | /** ALLOCATE ( size# -- alloc*! 0 | 0 errno#! ) [ANS] 31 | * Allocate a chunk of memory from the system heap. 32 | * use => FREE to release the memory area back to the system.
33 | * A code of zero means success. 34 | */ 35 | extern P4_CODE (p4_allocate); 36 | 37 | /** FREE ( alloc* -- errno# ) [ANS] 38 | * Free the memory from => ALLOCATE 39 | * A code of zero means success. 40 | */ 41 | extern P4_CODE (p4_free); 42 | 43 | /** RESIZE ( alloc* newsize# -- alloc*' errno# ) [ANS] 44 | * Resize the system memory chunk. A code of zero means success. 45 | * Our implementation returns the old pointer on failure. 46 | */ 47 | extern P4_CODE (p4_resize); 48 | 49 | #ifdef __cplusplus 50 | } /* extern "C" */ 51 | #endif 52 | 53 | 54 | #endif 55 | -------------------------------------------------------------------------------- /pfe/memory-alloc-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- StackHelp for Memory-Alloc-Ext 3 | * 4 | * Copyright (C) Tektronix, Inc. 2003 - 2003. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:30 $) 11 | * 12 | * @description 13 | * see stackhelp-ext for details 14 | */ 15 | /*@{*/ 16 | #if defined(__version_control__) && defined(__GNUC__) 17 | static char* id __attribute__((unused)) = 18 | "@(#) $Id: memory-alloc-stk.c,v 1.3 2008-04-20 04:46:30 guidod Exp $"; 19 | #endif 20 | 21 | #define _P4_SOURCE 1 22 | #include 23 | 24 | 25 | P4_LISTWORDS (memory_check) = 26 | { 27 | P4_STKi ("ALLOCATE", "size# -- ptr* 0 | 0 code#"), 28 | P4_STKi ("FREE", "ptr* -- 0 | code#"), 29 | P4_STKi ("RESIZE", "ptr* newsize# -- ptr*' 0 | ptr* code#"), 30 | 31 | }; 32 | P4_COUNTWORDS (memory_check, "Check-Memory-Alloc words + extension"); 33 | 34 | /*@}*/ 35 | 36 | /* 37 | * Local variables: 38 | * c-file-style: "stroustrup" 39 | * End: 40 | */ 41 | -------------------------------------------------------------------------------- /pfe/memory-sub.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_MEMORY_SUB_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_MEMORY_SUB_H 1209868837 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/memory-sub.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- Memory Allocation Words 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | * 18 | * @description 19 | * memory allocation interfaces to the surrounding OS. 20 | */ 21 | 22 | #ifdef __cplusplus 23 | extern "C" { 24 | #endif 25 | 26 | 27 | 28 | 29 | _extern void * p4_xcalloc (int n_elem, size_t size) /* allocate memory, die when failed */ ; /*{*/ 30 | 31 | _extern void * p4_calloc (int n_elem, size_t size) /* allocate memory, with debug info */ ; /*{*/ 32 | 33 | _extern void * p4_xalloc (size_t size) /* allocate memory, throw when failed */ ; /*{*/ 34 | 35 | _extern void p4_xfree (void* p) ; /*{*/ 36 | 37 | /** 38 | * helper routine to allocate a portion of the dictionary 39 | * especially for some stack-areas of the forth system 40 | * ... just decreases PFE.dictlimit, returns 0 if impossible. 41 | */ 42 | _extern void* p4_dict_allocate (int items, int size, int align, void** lower, void** upper) ; /*{*/ 43 | 44 | _extern int p4_mmap_creat(char* name, void* addr, long size) ; /*{*/ 45 | 46 | _extern void p4_mmap_close(int fd, void* addr, long size) ; /*{*/ 47 | 48 | #ifdef __cplusplus 49 | } /* extern "C" */ 50 | #endif 51 | 52 | 53 | #endif 54 | -------------------------------------------------------------------------------- /pfe/module-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(module); 5 | P4_MODULE_LIST (module); 6 | 7 | -------------------------------------------------------------------------------- /pfe/os-ctype.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/pfe/os-ctype.c -------------------------------------------------------------------------------- /pfe/os-ctype.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_OS_CTYPE_H 2 | #include 3 | /* 4 | * Copyright (C) 2005 - 2008 Guido U. Draheim 5 | * 6 | * @see GNU LGPL 7 | * @author Guido U. Draheim (modified by $Author: guidod $) 8 | * @version $Revision: 1.3 $ 9 | * (modified $Date: 2008-04-20 04:46:30 $) 10 | */ 11 | 12 | /* fscking solaris */ 13 | #if defined HOST_OS_SOLARIS 14 | #define p4_isspace(x) isspace((unsigned int)(x)) 15 | #define p4_isupper(x) isupper((unsigned int)(x)) 16 | #define p4_isalnum(x) isalnum((unsigned int)(x)) 17 | #define p4_isprint(x) isprint((unsigned int)(x)) 18 | #define p4_iscntrl(x) iscntrl((unsigned int)(x)) 19 | #define p4_isascii(x) isascii((unsigned int)(x)) 20 | #else 21 | #define p4_isspace(x) isspace((unsigned char)(x)) 22 | #define p4_isupper(x) isupper((unsigned char)(x)) 23 | #define p4_isalnum(x) isalnum((unsigned char)(x)) 24 | #define p4_isprint(x) isprint((unsigned char)(x)) 25 | #define p4_iscntrl(x) iscntrl((unsigned char)(x)) 26 | # ifdef isascii 27 | #define p4_isascii(x) isascii((unsigned char)(x)) 28 | # else 29 | #define p4_isascii(X) ((unsigned char)(X) < 0x80) 30 | # endif 31 | #endif 32 | 33 | #endif 34 | -------------------------------------------------------------------------------- /pfe/os-delay.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_OS_DELAY_H 2 | #define __PFE_OS_DELAY_H 3 | /* 4 | * Copyright (C) 2005 - 2008 Guido U. Draheim 5 | * 6 | * @see GNU LGPL 7 | * @author Guido U. Draheim (modified by $Author: guidod $) 8 | * @version $Revision: 1.3 $ 9 | * (modified $Date: 2008-04-20 04:46:31 $) 10 | */ 11 | #include 12 | 13 | #ifdef __cplusplus 14 | extern "C" { 15 | #endif 16 | 17 | _extern void p4_delay (int ms) ; 18 | 19 | #ifdef __cplusplus 20 | } /* extern "C" */ 21 | #endif 22 | 23 | 24 | #endif 25 | -------------------------------------------------------------------------------- /pfe/os-fesetenv.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_OS_SETENV_H 2 | #define __PFE_OS_SETENV_H 3 | 4 | /* 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author$) 9 | * @version $Revision$ 10 | * (modified $Date$) 11 | * 12 | * This is similar to os-setjmp.h in that is checks for an implentation 13 | * of mathlib fesetenv() / fegetenv(). These are needed to store the FPU 14 | * state across setjmp calls - i.e. THROW/CATCH blocks. 15 | * 16 | * http://www.opengroup.org/onlinepubs/009695399/functions/fegetenv.html 17 | */ 18 | 19 | #if !defined P4_NO_FP && defined(PFE_HAVE_FENV_H) 20 | #include 21 | 22 | #define p4_fegetenv(fenv_buffer) fegetenv(fenv_buffer) 23 | #define p4_fesetenv(fenv_buffer) fesetenv(fenv_buffer) 24 | typedef struct { 25 | int initialized; 26 | fenv_t fenv; 27 | } p4_fenv_t; 28 | 29 | #else 30 | 31 | #define p4_fegetenv(fenv_buffer) 0 32 | #define p4_fesetenv(fenv_buffer) 0 33 | typedef struct { 34 | int initialized; 35 | unsigned fenv; 36 | } p4_fenv_t; 37 | 38 | #endif 39 | #endif 40 | -------------------------------------------------------------------------------- /pfe/p4-gettimeofday.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | /* 3 | * Copyright (C) 2005 - 2008 Guido U. Draheim 4 | * 5 | * @see GNU LGPL 6 | * @author Guido U. Draheim (modified by $Author: guidod $) 7 | * @version $Revision: 1.3 $ 8 | * (modified $Date: 2008-04-20 04:46:30 $) 9 | */ 10 | 11 | #include 12 | #include 13 | #include 14 | #include 15 | 16 | #ifdef VxWorks 17 | #include 18 | #endif 19 | 20 | #include 21 | #include 22 | 23 | #if defined PFE_HAVE_WINBASE_H 24 | /* --target mingw32msvc */ 25 | # undef LP 26 | # undef CONTEXT 27 | # include 28 | #endif 29 | 30 | /** 31 | * helper function - both arg pointers MUST be given 32 | */ 33 | _export void 34 | p4_gettimeofday (p4ucell* sec, p4ucell* usec) 35 | { 36 | # ifdef PFE_HAVE_VXWORKS_H 37 | # define PFE_HAVE_CLOCK_GETTIME 38 | # endif 39 | 40 | # if defined PFE_HAVE_CLOCK_GETTIME 41 | struct timespec tv; 42 | clock_gettime (CLOCK_REALTIME, &tv); 43 | if (usec) *usec = tv.tv_nsec/1000; 44 | *sec = tv.tv_sec; 45 | # elif defined PFE_HAVE_WINBASE_H 46 | SYSTEMTIME stime; 47 | GetSystemTime (&stime); 48 | if (usec) *usec = stime.wMilliseconds*1000; 49 | *sec = time(0); 50 | # elif defined PFE_HAVE_UNISTD_H || defined PFE_HAVE_GETTIMEOFDAY 51 | struct timeval tv; 52 | gettimeofday (&tv, 0); 53 | if (usec) *usec = tv.tv_usec; 54 | *sec = tv.tv_sec; 55 | # else 56 | if (usec) *usec = 0; 57 | *sec = time(0); 58 | # endif 59 | }; 60 | -------------------------------------------------------------------------------- /pfe/p4-gettimeofday.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_OS_GETTIMEOFDAY_H 2 | #define __PFE_OS_GETTIMEOFDAY_H 3 | /* 4 | * Copyright (C) 2005 - 2008 Guido U. Draheim 5 | * 6 | * @see GNU LGPL 7 | * @author Guido U. Draheim (modified by $Author: guidod $) 8 | * @version $Revision: 1.3 $ 9 | * (modified $Date: 2008-04-20 04:46:30 $) 10 | */ 11 | 12 | #include 13 | 14 | #ifdef __cplusplus 15 | extern "C" { 16 | #endif 17 | 18 | _extern void p4_gettimeofday (p4ucell* sec, p4ucell* usec) ; 19 | 20 | #ifdef __cplusplus 21 | } /* extern "C" */ 22 | #endif 23 | 24 | 25 | #endif 26 | -------------------------------------------------------------------------------- /pfe/pfe-base.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_PFE_BASE_H 2 | #define __PFE_PFE_BASE_H 3 | /** 4 | * -- declare prototypes of the base system 5 | * 6 | * Copyright (C) Tektronix, Inc. 1998 - 2003. 7 | * Copyright (C) 2005 - 2008 Guido U. Draheim 8 | * 9 | * @see GNU LGPL 10 | * @author Guido U. Draheim (modified by $Author: guidod $) 11 | * @version $Revision: 1.3 $ 12 | * (modified $Date: 2008-04-20 04:46:30 $) 13 | * 14 | * @description 15 | * most of the routines of the internal forth system 16 | * are declared here 17 | */ 18 | /*@{*/ 19 | 20 | #include 21 | 22 | #include 23 | #include 24 | #include 25 | #include 26 | #include 27 | #include 28 | #include 29 | #include 30 | #include 31 | #include 32 | #include 33 | #include 34 | #include 35 | #include 36 | #include 37 | #include 38 | #include 39 | #include 40 | #include 41 | 42 | /*@}*/ 43 | #endif 44 | -------------------------------------------------------------------------------- /pfe/pfe-ext.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_INCL_EXT_H 2 | #define __PFE_INCL_EXT_H 3 | /** 4 | * Copyright (C) Tektronix, Inc. 1998 - 2003. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:31 $) 11 | */ 12 | 13 | /* didn't you include it beforehand ? */ 14 | #include 15 | 16 | #include 17 | #include 18 | #include 19 | #include 20 | 21 | #endif 22 | 23 | -------------------------------------------------------------------------------- /pfe/pfe-mix.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/pfe/pfe-mix.c -------------------------------------------------------------------------------- /pfe/pfe-mix.h: -------------------------------------------------------------------------------- 1 | #include 2 | -------------------------------------------------------------------------------- /pfe/pfe-set.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | -------------------------------------------------------------------------------- /pfe/pfe-sub.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_DEF_SUB_H 2 | #define __PFE_DEF_SUB_H 3 | /** 4 | * Copyright (C) Tektronix, Inc. 1998 - 2003. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.4 $ 10 | * (modified $Date: 2008-05-01 18:26:25 $) 11 | */ 12 | 13 | #include 14 | #include 15 | #include 16 | #include 17 | #include 18 | 19 | #endif 20 | -------------------------------------------------------------------------------- /pfe/pfe-sup.h: -------------------------------------------------------------------------------- 1 | #ifndef __PFE_INCL_SUP_H 2 | #define __PFE_INCL_SUP_H 3 | /** 4 | * -- declare types and prototypes for support.c 5 | * 6 | * Copyright (C) Tektronix, Inc. 1998 - 2003. 7 | * Copyright (C) 2005 - 2008 Guido U. Draheim 8 | * 9 | * @see GNU LGPL 10 | * @author Guido U. Draheim (modified by $Author: guidod $) 11 | * @version $Revision: 1.3 $ 12 | * (modified $Date: 2008-04-20 04:46:30 $) 13 | * 14 | * @description 15 | * most of the routines of the internal forth system 16 | * are declared here 17 | */ 18 | /*@{*/ 19 | 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | 27 | /*@}*/ 28 | #endif 29 | -------------------------------------------------------------------------------- /pfe/posix-ext.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_POSIX_EXT_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_POSIX_EXT_H 1209868837 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/posix-ext.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- Words making sense in POSIX-like systems only. 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | * 18 | * @description 19 | * This file exports a set of system words for 20 | * a posixish OS environment. So should do 21 | * any alternative wordset you might create for your OS. 22 | * 23 | * NOTE: this wordset is going to be removed soon. 24 | */ 25 | 26 | #ifdef __cplusplus 27 | extern "C" { 28 | #endif 29 | 30 | 31 | 32 | 33 | /** NTOHS ( w -- w' ) 34 | * if current host-encoding is bigendian, this is a NOOP 35 | * otherwise byteswap the lower 16-bit bits of the topofstack. 36 | * see =>'W@' and =>'W!' 37 | * (on some platforms, the upper bits are erased, on others not) 38 | */ 39 | extern P4_CODE (p4_ntohs); 40 | 41 | /** NTOHL ( l -- l' ) 42 | * if current host-encoding is bigendian, this is a NOOP 43 | * otherwise byteswap the lower 32-bit bits of the topofstack. 44 | * see =>'L@' and =>'L!' (being usually just =>'@' and =>'!' ) 45 | * (on some platforms, the upper bits are erased, on others not) 46 | */ 47 | extern P4_CODE (p4_ntohl); 48 | 49 | #ifdef __cplusplus 50 | } /* extern "C" */ 51 | #endif 52 | 53 | 54 | #endif 55 | -------------------------------------------------------------------------------- /pfe/smart-go-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(smart_go); 5 | P4_MODULE_LIST (smart_go); 6 | 7 | -------------------------------------------------------------------------------- /pfe/smart-go-ext.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_SMART_GO_EXT_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_SMART_GO_EXT_H 1209868838 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/smart-go-ext.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- smart outer interpreter 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | * 18 | * @description 19 | * Smart Outer Interpreter allows to register executions tokens 20 | * that get tied to a single char - if the outer interpreter 21 | * Compatiblity with former standards, miscellaneous useful words. 22 | * ... for TOOLS-EXT 23 | */ 24 | 25 | #ifdef __cplusplus 26 | extern "C" { 27 | #endif 28 | 29 | 30 | 31 | 32 | /** SMART-INTERPRET-INIT ( -- ) 33 | * creates a set of interpret-words that are used in the inner 34 | * interpreter, so if a word is unknown to the interpreter-loop 35 | * it will use the first char of that word, attach it to an 36 | * "interpret-" prefix, and tries to use that =>'IMMEDIATE'-=>'DEFER'-word 37 | * on the rest of the word. This => SMART-INTERPRET-INIT will set up 38 | * words like interpret-" so you can write 39 | * "hello" instead of " hello" 40 | * and it creates interpret-\ so that words like \if-unix are 41 | * ignoring the line if the word \if-unknown is unknown in itself. 42 | * This is usually not activated on startup. 43 | */ 44 | extern P4_CODE (p4_smart_interpret_init); 45 | 46 | /** SMART-INTERPRET! ( -- ) 47 | * enables/disables the SMART-INTERPRET extension in => INTERPRET , 48 | * (actually stores an XT in => DEFER inside the mainloop interpreter) 49 | */ 50 | extern P4_CODE (p4_smart_interpret_store); 51 | 52 | #ifdef __cplusplus 53 | } /* extern "C" */ 54 | #endif 55 | 56 | 57 | #endif 58 | -------------------------------------------------------------------------------- /pfe/socket-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(socket); 5 | P4_MODULE_LIST (socket); 6 | 7 | -------------------------------------------------------------------------------- /pfe/socket-ext.c: -------------------------------------------------------------------------------- 1 | /* 2 | * -- SOCKET-EXT - socket interface 3 | * 4 | * Copyright (C) 2005 - 2008 Guido U. Draheim 5 | * 6 | * @see GNU LGPL 7 | * @author Guido U. Draheim (modified by $Author: guidod $) 8 | * @version $Revision: 1.3 $ 9 | * (modified $Date: 2008-04-20 04:46:29 $) 10 | * 11 | * @description 12 | * The api is largely modelled after the glib ones for maximum compatibility 13 | */ 14 | 15 | /** gethostbyname ( name -- hostent ) 16 | */ 17 | 18 | /** socket ( class type proto -- fd ) 19 | */ 20 | 21 | /** connect ( fd sock size -- err ) 22 | */ 23 | 24 | /** fdopen ( fd fileattr -- file ) 25 | */ 26 | 27 | /** htonl ( x -- x' ) 28 | */ 29 | 30 | /* structures */ 31 | /* .......... */ 32 | 33 | /* c-string */ 34 | /* host-addr */ 35 | 36 | /* .... c-string ( addr u -- addr' ) */ 37 | 38 | 39 | /** "host>addr" ( addr u -- x ) 40 | * coverts an internet path into a IPv$ adress 41 | * the resulting address in network by order 42 | */ 43 | 44 | /* PF_INET ( -- 2 ) */ 45 | /* SOCK_STREAM ( -- 1 ) */ 46 | /* IPPROTO_TCP ( -- 6 ) */ 47 | 48 | /** open-socket ( addr u port -- fid ) 49 | */ 50 | 51 | 52 | -------------------------------------------------------------------------------- /pfe/stackhelp-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(stackhelp); 5 | P4_MODULE_LIST (stackhelp); 6 | 7 | -------------------------------------------------------------------------------- /pfe/string-stk.c: -------------------------------------------------------------------------------- 1 | /** 2 | * -- StackHelp for String-Ext 3 | * 4 | * Copyright (C) Tektronix, Inc. 2003 - 2003. 5 | * Copyright (C) 2005 - 2008 Guido U. Draheim 6 | * 7 | * @see GNU LGPL 8 | * @author Guido U. Draheim (modified by $Author: guidod $) 9 | * @version $Revision: 1.3 $ 10 | * (modified $Date: 2008-04-20 04:46:29 $) 11 | * 12 | * @description 13 | * see stackhelp-ext for details 14 | */ 15 | /*@{*/ 16 | #if defined(__version_control__) && defined(__GNUC__) 17 | static char* id __attribute__((unused)) = 18 | "@(#) $Id: string-stk.c,v 1.3 2008-04-20 04:46:29 guidod Exp $"; 19 | #endif 20 | 21 | #define _P4_SOURCE 1 22 | #include 23 | 24 | 25 | P4_LISTWORDS (string_check) = 26 | { 27 | P4_STKi ("-TRAILING", "str-ptr str-len -- str-ptr str-len'"), 28 | P4_STKi ("/STRING", "str-ptr str-len n -- str-ptr' str-len'"), 29 | P4_STKi ("BLANK", "str-ptr str-len -- "), 30 | P4_STKi ("CMOVE", "from-ptr to-ptr len# -- "), 31 | P4_STKi ("CMOVE>", "from-ptr to-ptr len# -- "), 32 | P4_STKi ("COMPARE", "str1-ptr str1-len str2-ptr str2-len -- n"), 33 | P4_STKi ("SEARCH", "str1-ptr str1-len str2-ptr str2-len -- " 34 | /*................*/ "str1-ptr' str1-len' flag" ), 35 | P4_STKi ("SLITERAL", "C: str-ptr str-len -- str-ptr str-len"), 36 | }; 37 | P4_COUNTWORDS (string_check, "Check-String words + extension"); 38 | 39 | /*@}*/ 40 | 41 | /* 42 | * Local variables: 43 | * c-file-style: "stroustrup" 44 | * End: 45 | */ 46 | -------------------------------------------------------------------------------- /pfe/struct-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(struct); 5 | P4_MODULE_LIST (struct); 6 | 7 | -------------------------------------------------------------------------------- /pfe/structs-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(structs); 5 | P4_MODULE_LIST (structs); 6 | 7 | -------------------------------------------------------------------------------- /pfe/term-def.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #ifdef PFE_WITH_X11 4 | #include 5 | #endif 6 | 7 | #if PFE_TERM_DEF == 1 8 | #include 9 | #elif PFE_TERM_DEF == 2 10 | #include 11 | #elif PFE_TERM_DEF == 3 12 | #include 13 | #elif PFE_TERM_DEF == 4 14 | #include 15 | #elif PFE_TERM_DEF == 5 16 | #include 17 | #elif PFE_TERM_DEF == 6 18 | #include 19 | #elif PFE_TERM_DEF == 7 20 | #include 21 | #elif PFE_TERM_DEF == 8 22 | #include 23 | #elif PFE_TERM_DEF == 9 24 | #include 25 | #elif PFE_TERM_DEF == 11 26 | #include 27 | #else 28 | #include 29 | #endif 30 | 31 | 32 | -------------------------------------------------------------------------------- /pfe/termcatch-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(termcatch); 5 | P4_MODULE_LIST (termcatch); 6 | 7 | -------------------------------------------------------------------------------- /pfe/toolbelt-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(toolbelt); 5 | P4_MODULE_LIST (toolbelt); 6 | 7 | -------------------------------------------------------------------------------- /pfe/tools-sub.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_TOOLS_SUB_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_TOOLS_SUB_H 1209868837 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/tools-sub.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- implementation words for TOOLS-EXT / TOOLS-MIX 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2001. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | * 18 | * @description 19 | * These are tool words used throughout the system implemenation. 20 | */ 21 | 22 | #ifdef __cplusplus 23 | extern "C" { 24 | #endif 25 | 26 | 27 | # ifndef HASNT_SYSTEM 28 | _extern int p4_systemf (const char* s, ...); 29 | # endif 30 | 31 | 32 | /** 33 | * ?PAIRS 34 | */ 35 | _extern void p4_Q_pairs (p4cell n) ; /*{*/ 36 | 37 | /** 38 | * ?OPEN 39 | */ 40 | _extern void p4_Q_file_open (p4_File *fid) ; /*{*/ 41 | 42 | /** _?stop_ ( -- ?key ) 43 | * check for a keypress, and if it was 'q' being pressed 44 | : _?stop_ _key?_ _key_ [char] q = ; 45 | */ 46 | _extern int p4_Q_stop (void) ; /*{*/ 47 | 48 | /** _?cr_ ( -- ?stopped ) 49 | * Like CR but stop after one screenful and return flag if 'q' pressed. 50 | * Improved by aph@oclc.org (Andrew Houghton) 51 | */ 52 | _extern int p4_Q_cr (void) ; /*{*/ 53 | 54 | /** 55 | * ABORT" string" impl. 56 | */ 57 | _extern void p4_abortq (const char *fmt,...) ; /*{*/ 58 | 59 | #ifdef __cplusplus 60 | } /* extern "C" */ 61 | #endif 62 | 63 | 64 | #endif 65 | -------------------------------------------------------------------------------- /pfe/version-sub.h: -------------------------------------------------------------------------------- 1 | #ifndef _VOL_8_SRC_CVS_PFE_33_PFE_VERSION_SUB_H 2 | #define _VOL_8_SRC_CVS_PFE_33_PFE_VERSION_SUB_H 1209868837 3 | /* generated 2008-0504-0440 /vol/8/src/cvs/pfe-33/pfe/../mk/Make-H.pl /vol/8/src/cvs/pfe-33/pfe/version-sub.c */ 4 | 5 | #include 6 | 7 | /** 8 | * -- Version File 9 | * 10 | * Copyright (C) Tektronix, Inc. 1998 - 2003. 11 | * Copyright (C) 2005 - 2008 Guido U. Draheim 12 | * 13 | * @see GNU LGPL 14 | * @author Guido U. Draheim (modified by $Author: guidod $) 15 | * @version $Revision: 1.5 $ 16 | * (modified $Date: 2008-05-04 02:57:30 $) 17 | * 18 | * @description 19 | * there are some internal functions in the version-file 20 | * that are used to print out compile-time, -date, -version 21 | * and the license of course. 22 | */ 23 | 24 | #ifdef __cplusplus 25 | extern "C" { 26 | #endif 27 | 28 | 29 | 30 | 31 | _extern P4_GCC_CONST const char* p4_version_string(void) ; /*{*/ 32 | 33 | _extern P4_GCC_CONST const char* p4_copyright_string(void) ; /*{*/ 34 | 35 | _extern P4_GCC_CONST const char* p4_license_string (void) ; /*{*/ 36 | 37 | _extern P4_GCC_CONST const char* p4_warranty_string (void) ; /*{*/ 38 | 39 | _extern P4_GCC_CONST const char* p4_compile_date (void) ; /*{*/ 40 | 41 | _extern P4_GCC_CONST const char* p4_compile_time (void) ; /*{*/ 42 | 43 | #ifdef __cplusplus 44 | } /* extern "C" */ 45 | #endif 46 | 47 | 48 | #endif 49 | -------------------------------------------------------------------------------- /pfe/zchar-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(zchar); 5 | P4_MODULE_LIST (zchar); 6 | 7 | -------------------------------------------------------------------------------- /test/anslocal.4th: -------------------------------------------------------------------------------- 1 | cr .( http://www.complang.tuwien.ac.at/forth/anslocal.fs ) cr 2 | atexit-wordlist current ! variable -parsing.fs 3 | definitions 4 | 5 | include test/anslocal.fs 6 | 7 | : test-swap { a b -- b a } ." xxx " 8 | b a ; 9 | 10 | 1 2 test-swap . . .s cr 11 | 12 | cr .( done ) cr 13 | 14 | -------------------------------------------------------------------------------- /test/anslocal.fs: -------------------------------------------------------------------------------- 1 | \ This implements a subset of the gforth locals syntax in pure ANS Forth 2 | 3 | \ This file is in the public domain. NO WARRANTY. 4 | 5 | \ This implementation technique has been described by John Hayes in 6 | \ the SigForth Newsletter 4(2), Fall '92. He did not do the complete 7 | \ job, but left some more mundane parts as an exercise to the reader. 8 | 9 | \ I don't implement the "|" part, because 1) gforth does not implement 10 | \ it and 2) it's unnecessary; just put a 0 before the "{" for every 11 | \ additional local you want to declare. 12 | 13 | \ This program uses PARSE from the core ext and COMPARE from the 14 | \ string wordsets 15 | 16 | : local ( "name" -- ) 17 | bl word count (local) ; 18 | 19 | : {helper ( -- final-offset ) 20 | >in @ 21 | bl word count 22 | 2dup s" --" compare 0= if 23 | 2drop [char] } parse 2drop true 24 | else 25 | s" }" compare 0= 26 | then 27 | if 28 | drop >in @ 29 | else 30 | recurse 31 | swap >in ! local 32 | then ; 33 | 34 | : { ( -- ) 35 | {helper >in ! 0 0 (local) ; immediate 36 | 37 | \ : test-swap { a b -- b a } ." xxx" 38 | \ b a ; 39 | 40 | \ 1 2 test-swap . . .s cr 41 | -------------------------------------------------------------------------------- /test/anslocal.test.ok: -------------------------------------------------------------------------------- 1 | 2 | http://www.complang.tuwien.ac.at/forth/anslocal.fs 3 | xxx 1 2 4 | 5 | 6 | done 7 | -------------------------------------------------------------------------------- /test/anslocal.test64.ok: -------------------------------------------------------------------------------- 1 | 2 | http://www.complang.tuwien.ac.at/forth/anslocal.fs 3 | xxx 1 2 4 | 5 | 6 | done 7 | -------------------------------------------------------------------------------- /test/anstests1/Makefile.am: -------------------------------------------------------------------------------- 1 | ANSTESTS = 0.6 2 | ANSTESTS_ZIP = anstests$(ANSTESTS).zip 3 | ANSTESTS_URL = http://www.qlikz.org/forth/anstests/$(ANSTESTS_ZIP) 4 | 5 | EXTRA_DIST = $(ANSTESTS_ZIP) anstests.txt 6 | 7 | ../pfe/pfe$(EXEEXT) : 8 | (cd ../pfe && $(MAKE) `basename $@`) 9 | 10 | PFE_DIR = $(top_builddir)/pfe 11 | PFE = $(PFE_DIR)/pfe$(EXEEXT) 12 | PFE_LIB_PATH_STRING = --lib-path-string=$(PFE_DIR)/.libs 13 | PFE_SCRIPTDIR_STRING = --inc-path-string=$(builddir) 14 | PFE_CHECK_ARGS = --bye --quiet $(PFE_SCRIPTDIR_STRING) $(PFE_LIB_PATH_STRING) 15 | UNZIP = unzip 16 | WGET = wget 17 | 18 | wget: 19 | test -f $(ANSTESTS_ZIP) || ( \ 20 | test -s $(srcdir)/$(ANSTESTS_ZIP) && \ 21 | cp $(srcdir)/$(ANSTESTS_ZIP) $(ANSTESTS_ZIP) \ 22 | ) || $(WGET) $(ANSTESTS_URL) 23 | test -s $(ANSTESTS_ZIP) 24 | anstests.txt: 25 | echo "downloaded from $(ANSTESTS_URL)" > $@ 26 | 27 | checks: \ 28 | coreexttest coreplustest doubletest exceptiontest filetest \ 29 | memorytest searchordertest stringtest toolstest core 30 | 31 | coreexttest coreplustest doubletest exceptiontest filetest \ 32 | memorytest searchordertest stringtest toolstest: 33 | @ test -s $(ANSTESTS_ZIP) || $(MAKE) wget 34 | $(UNZIP) -o $(ANSTESTS_ZIP) tester.fr $@.fth 35 | $(PFE) $(PFE_CHECK_ARGS) -i tester.fr $@.fth 36 | 37 | core: 38 | @ test -s $(ANSTESTS_ZIP) || $(MAKE) wget 39 | $(UNZIP) -o $(ANSTESTS_ZIP) tester.fr $@.fr 40 | cat $@.fr | sed -e "s/^T{ *ACCEPT-TEST/\\\\ &/" > $@.fth 41 | $(PFE) $(PFE_CHECK_ARGS) -i tester.fr $@.fth 42 | -------------------------------------------------------------------------------- /test/anstests1/anstests0.6.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/test/anstests1/anstests0.6.zip -------------------------------------------------------------------------------- /test/arith.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | cnt=`grep "BAD" $* | wc -l` 4 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 5 | test "0" -eq "$cnt" 6 | exit 7 | 8 | -------------------------------------------------------------------------------- /test/arith.test.ok: -------------------------------------------------------------------------------- 1 | 2 | 3 | integer add, subtract 4 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 7 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 8 | integer multiply 9 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 10 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 11 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 12 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 13 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 14 | integer divide 15 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 16 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 17 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 18 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 19 | /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ /Y/ 0 20 | -------------------------------------------------------------------------------- /test/bubble.fs: -------------------------------------------------------------------------------- 1 | \ .( Loading Bubble Sort benchmark...) cr 2 | 3 | \ A classical benchmark of an O(n**2) algorithm; Bubble sort 4 | \ 5 | \ Part of the programs gathered by John Hennessy for the MIPS 6 | \ RISC project at Stanford. Translated to forth by Marty Fraeman 7 | \ Johns Hopkins University/Applied Physics Laboratory. 8 | 9 | \ MM forth2c doesn't have it ! 10 | : mybounds over + swap ; 11 | 12 | 1 cells Constant cell 13 | 14 | variable seed ( -- addr) 15 | 16 | : initiate-seed ( -- ) 74755 seed ! ; 17 | : random ( -- n ) seed @ 1309 * 13849 + 65535 and dup seed ! ; 18 | 19 | 6000 constant elements ( -- int) 20 | 21 | align create list elements cells allot 22 | 23 | : initiate-list ( -- ) 24 | list elements cells + list do random i ! cell +loop 25 | ; 26 | 27 | : dump-list ( -- ) 28 | list elements cells + list do i @ . cell +loop cr 29 | ; 30 | 31 | : verify-list ( -- ) 32 | list elements 1- cells mybounds do 33 | i 2@ > abort" bubble-sort: not sorted" 34 | cell +loop 35 | ; 36 | 37 | : bubble ( -- ) 38 | \ ." bubbling..." cr 39 | 1 elements 1 do 40 | list elements i - cells mybounds do 41 | i 2@ > if i 2@ swap i 2! then 42 | cell +loop 43 | loop 44 | ; 45 | 46 | : bubble-sort ( -- ) 47 | initiate-seed 48 | initiate-list 49 | bubble 50 | verify-list 51 | ; 52 | 53 | : bubble-with-flag ( -- ) 54 | 1 elements 1 do 55 | -1 list elements i - cells mybounds do 56 | i 2@ > if i 2@ swap i 2! drop 0 then 57 | cell +loop 58 | if leave then 59 | loop 60 | ; 61 | 62 | : bubble-sort-with-flag ( -- ) 63 | initiate-seed 64 | initiate-list 65 | bubble-with-flag 66 | verify-list 67 | ; 68 | 69 | : main ( -- ) 70 | bubble-sort 71 | \ bubble-sort-with-flag 72 | ; 73 | 74 | 75 | -------------------------------------------------------------------------------- /test/checkans.4th: -------------------------------------------------------------------------------- 1 | : WORDSETS_FS S" test/wordsets.fs" ; 2 | include test/checkans.fs 3 | -------------------------------------------------------------------------------- /test/checkans.fs: -------------------------------------------------------------------------------- 1 | \ CHECKANS.STR ANS Forth wordset checker 01may93jaw 2 | 3 | \ 1-3MAY93 Jens A. Wilke 4 | \ This program is public domain 5 | \ Not for commercial usage! 6 | 7 | DECIMAL 8 | 9 | VARIABLE CharCount 10 | 30 CONSTANT MaxChars 11 | VARIABLE Flag 12 | 13 | CREATE Names 1000 ALLOT 14 | VARIABLE PNT Names PNT ! 15 | 16 | : INIT TRUE Flag ! 0 CharCount ! ; 17 | 18 | : ^ PNT @ DUP @ 1+ SWAP ! 19 | BL WORD FIND 20 | 0= IF PNT @ CELL+ DUP @ 1+ SWAP ! 21 | Flag @ IF CR ." Missing: " FALSE Flag ! THEN 22 | COUNT DUP CharCount +! TYPE SPACE 23 | CharCount @ MaxChars U< 0= IF CR 9 SPACES 0 CharCount ! THEN 24 | ELSE DROP THEN ; 25 | 26 | [UNDEFINED] PLACE [IF] : PLACE ( adr cnt adr -- ) 2DUP C! 1+ SWAP MOVE ; [THEN] 27 | 28 | : WS INIT 29 | PNT @ 2 CELLS + PNT ! 30 | BL WORD 31 | CR CR ." Checking " DUP COUNT TYPE ." wordset..." 32 | DUP COUNT PNT @ PLACE COUNT SWAP DROP 1+ 33 | PNT @ + ALIGNED DUP PNT ! 34 | DUP 0 SWAP ! CELL+ 0 SWAP ! ; 35 | 36 | [DEFINED] WORDSETS_FS 37 | [IF] WORDSETS_FS [ELSE] S" wordsets.fs" [THEN] INCLUDED 38 | 39 | : END 40 | CR CR ." Wordset: Status: Words:" CR 41 | 42 | Names 2 CELLS + 43 | BEGIN 44 | DUP COUNT TYPE 45 | DUP COUNT SWAP DROP 20 SWAP - SPACES 46 | COUNT + ALIGNED 47 | DUP @ OVER CELL+ @ 48 | 2DUP 0= 49 | IF ." complete " . DROP DROP 50 | ELSE OVER = 51 | IF ." missing " . DROP 52 | ELSE ." partial " OVER SWAP - . ." / " . 53 | THEN 54 | THEN CR 55 | 2 CELLS + 56 | DUP PNT @ U< 0= 57 | UNTIL DROP ; 58 | 59 | END 60 | -------------------------------------------------------------------------------- /test/checkans.nomodules.ok: -------------------------------------------------------------------------------- 1 | 2 | 3 | Checking CORE wordset... 4 | 5 | Checking CORE-EXT wordset... 6 | 7 | Checking BLOCK wordset... 8 | 9 | Checking BLOCK-EXT wordset... 10 | 11 | Checking DOUBLE wordset... 12 | 13 | Checking DOUBLE-EXT wordset... 14 | 15 | Checking EXEPTION wordset... 16 | 17 | Checking EXEPTION-EXT wordset... 18 | 19 | Checking FACILITY wordset... 20 | 21 | Checking FACILITY-EXT wordset... 22 | 23 | Checking FILE wordset... 24 | 25 | Checking FILE-EXT wordset...no floating extensions 26 | 27 | Checking LOCAL wordset... 28 | 29 | Checking LOCAL-EXT wordset... 30 | 31 | Checking MEMORY wordset... 32 | 33 | Checking TOOLS wordset... 34 | 35 | Checking TOOLS-EXT wordset... 36 | Missing: EDITOR 37 | 38 | Checking SEARCH wordset... 39 | 40 | Checking SEARCH-EXT wordset... 41 | 42 | Checking STRING wordset... 43 | 44 | Wordset: Status: Words: 45 | CORE complete 133 46 | CORE-EXT complete 46 47 | BLOCK complete 8 48 | BLOCK-EXT complete 6 49 | DOUBLE complete 20 50 | DOUBLE-EXT complete 2 51 | EXEPTION complete 2 52 | EXEPTION-EXT complete 2 53 | FACILITY complete 3 54 | FACILITY-EXT complete 6 55 | FILE complete 21 56 | FILE-EXT complete 4 57 | LOCAL complete 2 58 | LOCAL-EXT complete 1 59 | MEMORY complete 3 60 | TOOLS complete 5 61 | TOOLS-EXT partial 12 / 13 62 | SEARCH complete 9 63 | SEARCH-EXT complete 5 64 | STRING complete 8 65 | -------------------------------------------------------------------------------- /test/checkans.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="checkans" 3 | 4 | echo " 5 | //d 6 | /^ *\$/d 7 | /^Checking .*\$/d 8 | /^Missing: \\;CODE ASSEMBLER CODE EDITOR *\$/d 9 | /^Missing: ASSEMBLER EDITOR *\$/d 10 | /^Missing: EDITOR *\$/d 11 | /^Wordset: *Status: *Words: */!bNX 12 | /^Wordset: *Status: *Words: */{g;N;} 13 | /\n11 0/{g;N;} 14 | /\nCORE *complete 133 \$/{g;N;} 15 | /\nCORE-EXT *complete 46 \$/{g;N;} 16 | /\nBLOCK *complete 8 \$/{g;N;} 17 | /\nBLOCK-EXT *complete 6 \$/{g;N;} 18 | /\nDOUBLE *complete 20 \$/{g;N;} 19 | /\nDOUBLE-EXT *complete 2 \$/{g;N;} 20 | /\nEXEPTION *complete 2 \$/{g;N;} 21 | /\nEXEPTION-EXT *complete 2 \$/{g;N;} 22 | /\nFACILITY *complete 3 \$/{g;N;} 23 | /\nFACILITY-EXT *complete 6 \$/{g;N;} 24 | /\nFILE *complete 21 \$/{g;N;} 25 | /\nFILE-EXT *complete 4 \$/{g;N;} 26 | /\nFLOATING *complete 31 \$/{g;N;} 27 | /\nFLOATING-EXT *complete 41 \$/{g;N;} 28 | /\nLOCAL *complete 2 \$/{g;N;} 29 | /\nLOCAL-EXT *complete 1 \$/{g;N;} 30 | /\nMEMORY *complete 3 \$/{g;N;} 31 | /\nTOOLS *complete 5 \$/{g;N;} 32 | /\nTOOLS-EXT *partial 9 . 13 \$/{g;N;} 33 | /\nTOOLS-EXT *partial 11 . 13 \$/{g;N;} 34 | /\nTOOLS-EXT *partial 12 . 13 \$/{g;N;} 35 | /\nSEARCH *complete 9 \$/{g;N;} 36 | /\nSEARCH-EXT *complete 5 \$/{g;N;} 37 | /\nSTRING *complete 8 \$/d 38 | :NX 39 | /----------*/d 40 | {p;d;} 41 | " >$testcase.sed 42 | 43 | sed -n -f $testcase.sed $* >$testcase.tmp 44 | cnt=`cat $testcase.tmp | wc -w` 45 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 46 | test "0" -eq "$cnt" 47 | exit 48 | -------------------------------------------------------------------------------- /test/checkans.test.ok: -------------------------------------------------------------------------------- 1 | 2 | 3 | Checking CORE wordset... 4 | 5 | Checking CORE-EXT wordset... 6 | 7 | Checking BLOCK wordset... 8 | 9 | Checking BLOCK-EXT wordset... 10 | 11 | Checking DOUBLE wordset... 12 | 13 | Checking DOUBLE-EXT wordset... 14 | 15 | Checking EXEPTION wordset... 16 | 17 | Checking EXEPTION-EXT wordset... 18 | 19 | Checking FACILITY wordset... 20 | 21 | Checking FACILITY-EXT wordset... 22 | 23 | Checking FILE wordset... 24 | 25 | Checking FILE-EXT wordset... 26 | 27 | Checking FLOATING wordset... 28 | 29 | Checking FLOATING-EXT wordset... 30 | 31 | Checking LOCAL wordset... 32 | 33 | Checking LOCAL-EXT wordset... 34 | 35 | Checking MEMORY wordset... 36 | 37 | Checking TOOLS wordset... 38 | 39 | Checking TOOLS-EXT wordset... 40 | Missing: EDITOR 41 | 42 | Checking SEARCH wordset... 43 | 44 | Checking SEARCH-EXT wordset... 45 | 46 | Checking STRING wordset... 47 | 48 | Wordset: Status: Words: 49 | CORE complete 133 50 | CORE-EXT complete 46 51 | BLOCK complete 8 52 | BLOCK-EXT complete 6 53 | DOUBLE complete 20 54 | DOUBLE-EXT complete 2 55 | EXEPTION complete 2 56 | EXEPTION-EXT complete 2 57 | FACILITY complete 3 58 | FACILITY-EXT complete 6 59 | FILE complete 21 60 | FILE-EXT complete 4 61 | FLOATING complete 31 62 | FLOATING-EXT complete 41 63 | LOCAL complete 2 64 | LOCAL-EXT complete 1 65 | MEMORY complete 3 66 | TOOLS complete 5 67 | TOOLS-EXT partial 12 / 13 68 | SEARCH complete 9 69 | SEARCH-EXT complete 5 70 | STRING complete 8 71 | -------------------------------------------------------------------------------- /test/checkans.test64.ok: -------------------------------------------------------------------------------- 1 | 2 | 3 | Checking CORE wordset... 4 | 5 | Checking CORE-EXT wordset... 6 | 7 | Checking BLOCK wordset... 8 | 9 | Checking BLOCK-EXT wordset... 10 | 11 | Checking DOUBLE wordset... 12 | 13 | Checking DOUBLE-EXT wordset... 14 | 15 | Checking EXEPTION wordset... 16 | 17 | Checking EXEPTION-EXT wordset... 18 | 19 | Checking FACILITY wordset... 20 | 21 | Checking FACILITY-EXT wordset... 22 | 23 | Checking FILE wordset... 24 | 25 | Checking FILE-EXT wordset... 26 | 27 | Checking FLOATING wordset... 28 | 29 | Checking FLOATING-EXT wordset... 30 | 31 | Checking LOCAL wordset... 32 | 33 | Checking LOCAL-EXT wordset... 34 | 35 | Checking MEMORY wordset... 36 | 37 | Checking TOOLS wordset... 38 | 39 | Checking TOOLS-EXT wordset... 40 | Missing: EDITOR 41 | 42 | Checking SEARCH wordset... 43 | 44 | Checking SEARCH-EXT wordset... 45 | 46 | Checking STRING wordset... 47 | 48 | Wordset: Status: Words: 49 | CORE complete 133 50 | CORE-EXT complete 46 51 | BLOCK complete 8 52 | BLOCK-EXT complete 6 53 | DOUBLE complete 20 54 | DOUBLE-EXT complete 2 55 | EXEPTION complete 2 56 | EXEPTION-EXT complete 2 57 | FACILITY complete 3 58 | FACILITY-EXT complete 6 59 | FILE complete 21 60 | FILE-EXT complete 4 61 | FLOATING complete 31 62 | FLOATING-EXT complete 41 63 | LOCAL complete 2 64 | LOCAL-EXT complete 1 65 | MEMORY complete 3 66 | TOOLS complete 5 67 | TOOLS-EXT partial 12 / 13 68 | SEARCH complete 9 69 | SEARCH-EXT complete 5 70 | STRING complete 8 71 | -------------------------------------------------------------------------------- /test/compare.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ test/compare.4th --- test comparision operators 3 | \ (duz 05Aug93) (guidod Oct00) 4 | \ 5 | 6 | CR .( compare... ) CR 7 | 8 | [DEFINED] Y [NOT] [IF] : Y IF ." /Y/ " ELSE ." BAD/Y/ " THEN ; [THEN] 9 | [DEFINED] N [NOT] [IF] : N IF ." BAD/N/ " ELSE ." /N/ " THEN ; [THEN] 10 | 11 | 0 0= Y 12 | 1 0= N 13 | 123456789 123456789 = Y 14 | 123456789 123456788 = N CR 15 | 16 | 0 0<> . 17 | 1 0<> Y 18 | 123456789 123456789 <> N 19 | 123456789 123456788 <> Y CR 20 | 21 | 1234567890 987654321 1234567890 987654321 D= Y 22 | 1234567890 987654321 1234567891 987654321 D= N 23 | 1234567890 987654321 1234567890 987654320 D= N CR 24 | 25 | 26 | 1 0< N 27 | 0 0< N 28 | -1 0< Y CR 29 | 30 | 1 0> Y 31 | 0 0> N 32 | -1 0> N CR 33 | 34 | 1 0<= N 35 | 0 0<= Y 36 | -1 0<= Y CR 37 | 38 | 1 0>= Y 39 | 0 0>= Y 40 | -1 0>= N CR 41 | 42 | 43 | 123456789 234567890 < Y 44 | 234567890 123456789 < N 45 | -123456789 -234567890 < N 46 | -234567890 -123456789 < Y 47 | 123456789 -234567890 < N 48 | -234567890 123456789 < Y CR 49 | 50 | 234567890 123456789 > Y 51 | 123456789 234567890 > N 52 | -234567890 -123456789 > N 53 | -123456789 -234567890 > Y 54 | -234567890 123456789 > N 55 | 123456789 -234567890 > Y CR 56 | 57 | 123456789 234567890 <= Y 58 | 234567890 123456789 <= N 59 | -123456789 -234567890 <= N 60 | -234567890 -123456789 <= Y 61 | 123456789 -234567890 <= N 62 | -234567890 123456789 <= Y 63 | 123456789 123456789 <= Y CR 64 | 65 | 234567890 123456789 >= Y 66 | 123456789 234567890 >= N 67 | -234567890 -123456789 >= N 68 | -123456789 -234567890 >= Y 69 | -234567890 123456789 >= N 70 | 123456789 -234567890 >= Y 71 | 123456789 123456789 >= Y CR CR 72 | 73 | 1234567890 2345678901 U< Y 74 | 2345678901 1234567890 U< N CR 75 | 76 | 2345678901 1234567890 U> Y 77 | 1234567890 2345678901 U> N CR 78 | 79 | 1234567890 2345678901 U<= Y 80 | 2345678901 1234567890 U<= N 81 | 2345678901 2345678901 U<= Y CR 82 | 83 | 2345678901 1234567890 U>= Y 84 | 1234567890 2345678901 U>= N 85 | 2345678901 2345678901 U>= Y CR 86 | 87 | cr 88 | 89 | -------------------------------------------------------------------------------- /test/compare.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | cnt=`grep "BAD" $* | wc -l` 4 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 5 | test "0" -eq "$cnt" 6 | exit 7 | 8 | -------------------------------------------------------------------------------- /test/compare.test.ok: -------------------------------------------------------------------------------- 1 | 2 | compare... 3 | /Y/ /N/ /Y/ /N/ 4 | 0 /Y/ /N/ /Y/ 5 | /Y/ /N/ /N/ 6 | /N/ /N/ /Y/ 7 | /Y/ /N/ /N/ 8 | /N/ /Y/ /Y/ 9 | /Y/ /Y/ /N/ 10 | /Y/ /N/ /N/ /Y/ /N/ /Y/ 11 | /Y/ /N/ /N/ /Y/ /N/ /Y/ 12 | /Y/ /N/ /N/ /Y/ /N/ /Y/ /Y/ 13 | /Y/ /N/ /N/ /Y/ /N/ /Y/ /Y/ 14 | 15 | /Y/ /N/ 16 | /Y/ /N/ 17 | /Y/ /N/ /Y/ 18 | /Y/ /N/ /Y/ 19 | 20 | -------------------------------------------------------------------------------- /test/compspeed.fs: -------------------------------------------------------------------------------- 1 | 2 | : SECS TIME&DATE DROP DROP DROP 60 * + 60 * + ; 3 | 4 | create buf 60 allot 5 | 6 | : holds ( str len -- ) 7 | 0 do dup i + c@ hold loop drop 8 | ; 9 | 10 | : third 2 pick ; 11 | 12 | : create-comptest.fs ( -- 0 | errorstat ) 13 | s" comptest.fs" W/O create-file 14 | ?dup if ." could not open comptest.fs for testpurpose " nip exit then 15 | 30000 0 do 16 | i 0 <# s" ; pord pud " holds #S s" x : " holds #> 17 | third write-line drop 18 | loop 19 | close-file 20 | ; 21 | 22 | create-comptest.fs drop 23 | secs 24 | s" comptest.fs" included 25 | secs swap - cr . .( secs) 26 | \ s" comptest.fs" delete-file drop 27 | bye 28 | 29 | 30 | -------------------------------------------------------------------------------- /test/coretest.4th: -------------------------------------------------------------------------------- 1 | CR 2 | include test/tester.fs 3 | include test/coretest.fs 4 | CR 5 | 6 | -------------------------------------------------------------------------------- /test/coretest.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="coretest" 3 | 4 | echo " 5 | /is redefined/d 6 | //d 7 | /YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:/b graphicchars 8 | /YOU SHOULD SEE 0-9 SEPARATED BY A SPACE:/b onespacedigits 9 | /YOU SHOULD SEE 0-9 (WITH NO SPACES):/b nospacedigits 10 | /YOU SHOULD SEE A-G SEPARATED BY A SPACE:/b onespacealpha 11 | /YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES:/b twospacealpha 12 | /YOU SHOULD SEE TWO SEPARATE LINES:/b twoseperatelines 13 | {p;d;} 14 | :graphicchars 15 | # actually ASCII chars... 16 | {N;N;N;s/YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS://;} 17 | s|!\"\#\$%&'()\*+,\-\.\/0123456789:;<=>?@|| 18 | s/ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\\\]\^\_\`// 19 | s/abcdefghijklmnopqrstuvwxyz{|}\~// 20 | {p;d;} 21 | :onespacedigits 22 | {N;s/YOU SHOULD SEE 0-9 SEPARATED BY A SPACE://;} 23 | s/0 1 2 3 4 5 6 7 8 9 // 24 | {p;d;} 25 | :nospacedigits 26 | {N;s/YOU SHOULD SEE 0-9 (WITH NO SPACES)://;} 27 | s/0123456789// 28 | {p;d;} 29 | :onespacealpha 30 | {N;s/YOU SHOULD SEE A-G SEPARATED BY A SPACE://;} 31 | s/A B C D E F G // 32 | {p;d;} 33 | :twospacealpha 34 | {N;s/YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES://;} 35 | s/0 1 2 3 4 5 // 36 | {p;d;} 37 | :twoseperatelines 38 | {N;N;s/YOU SHOULD SEE TWO SEPARATE LINES://;} 39 | s/LINE 1.*\n.*LINE 2// 40 | {p;d;} 41 | " >$testcase.sed 42 | 43 | sed -n -f $testcase.sed $* >$testcase.tmp 44 | cnt=`cat $testcase.tmp | wc -w` 45 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 46 | test "0" -eq "$cnt" 47 | exit 48 | -------------------------------------------------------------------------------- /test/coretest.test.ok: -------------------------------------------------------------------------------- 1 | 2 | YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS: 3 | !"#$%&'()*+,-./0123456789:;<=>?@ 4 | ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` 5 | abcdefghijklmnopqrstuvwxyz{|}~ 6 | YOU SHOULD SEE 0-9 SEPARATED BY A SPACE: 7 | 0 1 2 3 4 5 6 7 8 9 8 | YOU SHOULD SEE 0-9 (WITH NO SPACES): 9 | 0123456789 10 | YOU SHOULD SEE A-G SEPARATED BY A SPACE: 11 | A B C D E F G 12 | YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES: 13 | 0 1 2 3 4 5 14 | YOU SHOULD SEE TWO SEPARATE LINES: 15 | LINE 1 16 | LINE 2 17 | 18 | "GDX" is redefined 19 | -------------------------------------------------------------------------------- /test/dbltest.4th: -------------------------------------------------------------------------------- 1 | CR 2 | : require [compile] include ; immediate 3 | [DEFINED] D<> [NOT] [IF] : D<> D= 0= ; [THEN] 4 | [DEFINED] D> [NOT] [IF] : D> 2SWAP D< ; [THEN] 5 | [DEFINED] D>= [NOT] [IF] : D>= D< 0= ; [THEN] 6 | [DEFINED] D<= [NOT] [IF] : D<= D> 0= ; [THEN] 7 | 8 | [UNDEFINED] MAX-UINT [IF] 9 | [DEFINED] ENVIRONMENT [IF] 10 | ALSO ENVIRONMENT MAX-U CONSTANT MAX-UINT PREVIOUS 11 | [ELSE] 12 | -1 CONSTANT MAX-UINT 13 | [THEN] 14 | [THEN] 15 | 16 | [UNDEFINED] MIN-INT [IF] 17 | [DEFINED] ENVIRONMENT [IF] 18 | ALSO ENVIRONMENT MAX-N 1+ CONSTANT MIN-INT PREVIOUS 19 | [ELSE] 20 | 0x80000000 CONSTANT MIN-INT 21 | [THEN] 22 | [THEN] 23 | 24 | 25 | include dbltest.fs 26 | CR 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /test/deferred-x.4th: -------------------------------------------------------------------------------- 1 | 2 | cr .( http://www.forth200x.org/deferred.fs ) cr 3 | include test/deferred-x.fs 4 | 5 | .s 6 | -------------------------------------------------------------------------------- /test/deferred-x.fs: -------------------------------------------------------------------------------- 1 | \ example implementation and test cases 2 | 3 | [DEFINED] ACTION-OF [NOT] [IF] 4 | 5 | : defer ( "name" -- ) 6 | create ['] abort , 7 | does> ( ... -- ... ) 8 | @ execute ; 9 | 10 | : defer@ ( xt1 -- xt2 ) 11 | >body @ ; 12 | 13 | : defer! ( xt2 xt1 -- ) 14 | >body ! ; 15 | 16 | : is 17 | state @ if 18 | POSTPONE ['] POSTPONE defer! 19 | else 20 | ' defer! 21 | then ; immediate 22 | 23 | : action-of 24 | state @ if 25 | POSTPONE ['] POSTPONE defer@ 26 | else 27 | ' defer@ 28 | then ; immediate 29 | 30 | [THEN] 31 | 32 | \ test cases 33 | require test/tester.fs 34 | 35 | { defer defer1 -> } 36 | { : is-defer1 is defer1 ; -> } 37 | { : action-defer1 action-of defer1 ; -> } 38 | { ' * ' defer1 defer! -> } 39 | { 2 3 defer1 -> 6 } 40 | { ' defer1 defer@ -> ' * } 41 | { action-of defer1 -> ' * } 42 | { action-defer1 -> ' * } 43 | { ' + is defer1 -> } 44 | { 1 2 defer1 -> 3 } 45 | { ' defer1 defer@ -> ' + } 46 | { action-of defer1 -> ' + } 47 | { action-defer1 -> ' + } 48 | { ' - is-defer1 -> } 49 | { 1 2 defer1 -> -1 } 50 | { ' defer1 defer@ -> ' - } 51 | { action-of defer1 -> ' - } 52 | { action-defer1 -> ' - } 53 | 54 | -------------------------------------------------------------------------------- /test/deferred-x.test.ok: -------------------------------------------------------------------------------- 1 | 2 | http://www.forth200x.org/deferred.fs 3 | 4 | -------------------------------------------------------------------------------- /test/deferred-x.test64.ok: -------------------------------------------------------------------------------- 1 | 2 | http://www.forth200x.org/deferred.fs 3 | 4 | -------------------------------------------------------------------------------- /test/deferred.fs: -------------------------------------------------------------------------------- 1 | \ example implementation and test cases 2 | 3 | : defer ( "name" -- ) 4 | create ['] abort , 5 | does> ( ... -- ... ) 6 | @ execute ; 7 | 8 | : defer@ ( xt1 -- xt2 ) 9 | >body @ ; 10 | 11 | : defer! ( xt2 xt1 -- ) 12 | >body ! ; 13 | 14 | : is 15 | state @ if 16 | POSTPONE ['] POSTPONE defer! 17 | else 18 | ' defer! 19 | then ; immediate 20 | 21 | : action-of 22 | state @ if 23 | POSTPONE ['] POSTPONE defer@ 24 | else 25 | ' defer@ 26 | then ; immediate 27 | 28 | \ test cases 29 | require test/tester.fs 30 | 31 | { defer defer1 -> } 32 | { : is-defer1 is defer1 ; -> } 33 | { : action-defer1 action-of defer1 ; -> } 34 | { ' * ' defer1 defer! -> } 35 | { 2 3 defer1 -> 6 } 36 | { ' defer1 defer@ -> ' * } 37 | { action-of defer1 -> ' * } 38 | { action-defer1 -> ' * } 39 | { ' + is defer1 -> } 40 | { 1 2 defer1 -> 3 } 41 | { ' defer1 defer@ -> ' + } 42 | { action-of defer1 -> ' + } 43 | { action-defer1 -> ' + } 44 | { ' - is-defer1 -> } 45 | { 1 2 defer1 -> -1 } 46 | { ' defer1 defer@ -> ' - } 47 | { action-of defer1 -> ' - } 48 | { action-defer1 -> ' - } 49 | -------------------------------------------------------------------------------- /test/defs.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ test/defs.4th --- test VARIABLE and CONSTANT and simple colon definitions 3 | \ provide some shortcuts 4 | \ (duz 05Aug93) 5 | \ 6 | 7 | CR .( simple colon definitions) CR 8 | 9 | : T 0 . ; T FORGET T 10 | : T 00 . ; T FORGET T 11 | : T 0.0 D. ; T FORGET T SPACE 12 | 13 | \ Y prints 0 if a clean true-flag is on top of stack 14 | \ N prints 0 if a clean false-flag is on top of stack 15 | \ D prints DEPTH 16 | 17 | : Y -1 = 0= . ; -1 Y 18 | : N . ; 0 N 19 | : D DEPTH . ; D 20 | 21 | : WAIT CR ." press any key..." KEY DROP ; 22 | 23 | CR .( constants) CR .( ) 24 | 25 | DECIMAL 26 | 27 | 123456789 CONSTANT N1 123456789.123456789 2CONSTANT D1 28 | 987654321 CONSTANT N2 987654321.987654321 2CONSTANT D2 29 | 1111111110 CONSTANT N3 1111111111.111111110 2CONSTANT D3 30 | 31 | N1 123456789 = Y D1 123456789.123456789 D= Y 32 | N2 987654321 = Y D D2 987654321.987654321 D= Y D 33 | 34 | : =N1 N1 = Y ; : =N2 N2 = Y ; : =N3 N3 = Y ; 35 | : =D1 D1 D= Y ; : =D2 D2 D= Y ; : =D3 D3 D= Y ; 36 | 37 | CR 38 | -------------------------------------------------------------------------------- /test/defs.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="defs" 3 | 4 | echo " 5 | //d 6 | /^\$/d 7 | /^simple colon definitions.*/!bskip 8 | /^simple colon definitions/{g;N;} 9 | /\n0 0 0 0 0 0/{g;N;} 10 | /\nconstants.*/{g;N;} 11 | /\n 0 0 0 0 0 0.*/{g;N;} 12 | :skip 13 | /----------*/d 14 | {p;d;} 15 | " >$testcase.sed 16 | 17 | sed -n -f $testcase.sed $* >$testcase.tmp 18 | cnt=`cat $testcase.tmp | wc -w` 19 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 20 | test "0" -eq "$cnt" 21 | exit 22 | -------------------------------------------------------------------------------- /test/defs.test.ok: -------------------------------------------------------------------------------- 1 | 2 | simple colon definitions 3 | 0 0 0 0 0 0 4 | constants 5 | 0 0 0 0 0 0 6 | -------------------------------------------------------------------------------- /test/environ.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ test/environ.4th --- prints, what ENVIRONMENT? reports. 3 | \ (duz 05Aug93) 4 | \ 5 | 6 | CR .( Environment as reported by system:) 7 | CR .( ==================================) 8 | CR 9 | 10 | MARKER FORGET-ENVIRONMENT-DISPLAY 11 | DECIMAL 12 | 13 | : KNOWN? 2DUP TYPE 20 OUT @ - SPACES ." = " 14 | ENVIRONMENT? DUP 0= IF ." UNKNOWN!" CR THEN ; 15 | 16 | : .FLAG KNOWN? IF IF ." YES " ELSE ." NO " THEN CR THEN ; 17 | : .NUMBER KNOWN? IF . CR THEN ; 18 | 19 | : SHOW-ENV S" /COUNTED-STRING" .NUMBER 20 | S" /HOLD" .NUMBER 21 | S" /PAD" .NUMBER 22 | S" ADDRESS-UNIT-BITS" .NUMBER 23 | S" CORE-EXT" .FLAG 24 | S" CORE" .FLAG 25 | S" FLOORED" .FLAG 26 | S" MAX-CHAR" .NUMBER 27 | S" MAX-D" KNOWN? IF D. CR THEN 28 | S" MAX-N" .NUMBER 29 | S" MAX-U" KNOWN? IF U. CR THEN 30 | S" MAX-UD" KNOWN? IF UD. CR THEN 31 | S" RETURN-STACK-CELLS" .NUMBER 32 | S" STACK-CELLS" .NUMBER 33 | S" BLOCK-EXT" .FLAG 34 | S" BLOCK" .FLAG 35 | S" DOUBLE-EXT" .FLAG 36 | S" DOUBLE" .FLAG 37 | S" EXCEPTION-EXT" .FLAG 38 | S" EXCEPTION" .FLAG 39 | S" FACILITY-EXT" .FLAG 40 | S" FACILITY" .FLAG 41 | S" FILE-EXT" .FLAG 42 | S" FILE" .FLAG 43 | S" FLOATING-EXT" .FLAG 44 | S" FLOATING" .FLAG 45 | S" FLOATING-STACK" .NUMBER 46 | [DEFINED] FS. [IF] 47 | S" MAX-FLOAT" KNOWN? IF FS. CR THEN 48 | [THEN] 49 | S" LOCALS-EXT" .FLAG 50 | S" LOCALS" .FLAG 51 | S" #LOCALS" .NUMBER 52 | S" MEMORY-ALLOC-EXT" .FLAG 53 | S" MEMORY-ALLOC" .FLAG 54 | S" TOOLS" .FLAG 55 | S" TOOLS-EXT" .FLAG 56 | S" SEARCH-ORDER-EXT" .FLAG 57 | S" SEARCH-ORDER" .FLAG 58 | S" WORDLISTS" .NUMBER 59 | S" STRING-EXT" .FLAG 60 | S" STRING" .FLAG 61 | S" A NONSENSE STRING" .FLAG 62 | ; 63 | 64 | SHOW-ENV .S 65 | 66 | FORGET-ENVIRONMENT-DISPLAY 67 | 68 | CR 69 | 70 | -------------------------------------------------------------------------------- /test/environ.nomodules.ok: -------------------------------------------------------------------------------- 1 | 2 | Environment as reported by system: 3 | ================================== 4 | /COUNTED-STRING = 255 5 | /HOLD = 256 6 | /PAD = 1024 7 | ADDRESS-UNIT-BITS = 8 8 | CORE-EXT = YES 9 | CORE = YES 10 | FLOORED = YES 11 | MAX-CHAR = 255 12 | MAX-D = 9223372036854775807 13 | MAX-N = 2147483647 14 | MAX-U = 4294967295 15 | MAX-UD = 18446744073709551615 16 | RETURN-STACK-CELLS = 4160 17 | STACK-CELLS = 8256 18 | BLOCK-EXT = YES 19 | BLOCK = YES 20 | DOUBLE-EXT = YES 21 | DOUBLE = YES 22 | EXCEPTION-EXT = YES 23 | EXCEPTION = YES 24 | FACILITY-EXT = YES 25 | FACILITY = YES 26 | FILE-EXT = YES 27 | FILE = YES 28 | FLOATING-EXT = UNKNOWN! 29 | FLOATING = UNKNOWN! 30 | FLOATING-STACK = UNKNOWN! 31 | LOCALS-EXT = YES 32 | LOCALS = YES 33 | #LOCALS = 32 34 | MEMORY-ALLOC-EXT = YES 35 | MEMORY-ALLOC = YES 36 | TOOLS = YES 37 | TOOLS-EXT = YES 38 | SEARCH-ORDER-EXT = YES 39 | SEARCH-ORDER = YES 40 | WORDLISTS = 64 41 | STRING-EXT = YES 42 | STRING = YES 43 | A NONSENSE STRING = UNKNOWN! 44 | 45 | 46 | -------------------------------------------------------------------------------- /test/environ.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | cnt=`grep "UNKNOWN" $* | grep -v "NONSENSE" | wc -l` 4 | mod=`grep "UNKNOWN" $* | grep -v "NONSENSE" | grep -v "FLOATING" | wc -l` 5 | mod_floating=`grep "FLOATING-EXT .* UNKNOWN" $* | wc -l` 6 | if test "$mod_floating" = "1" ; then 7 | echo " no floating wordset available" 8 | test "3" -eq "$cnt" || echo "$* : $cnt BAD lines" 9 | else test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" ; fi 10 | test "0" -eq "$cnt" && exit 0 11 | test "0" -eq "$mod" && exit 11 12 | exit 1 13 | -------------------------------------------------------------------------------- /test/environ.test.ok: -------------------------------------------------------------------------------- 1 | 2 | Environment as reported by system: 3 | ================================== 4 | /COUNTED-STRING = 255 5 | /HOLD = 256 6 | /PAD = 1024 7 | ADDRESS-UNIT-BITS = 8 8 | CORE-EXT = YES 9 | CORE = YES 10 | FLOORED = YES 11 | MAX-CHAR = 255 12 | MAX-D = 9223372036854775807 13 | MAX-N = 2147483647 14 | MAX-U = 4294967295 15 | MAX-UD = 18446744073709551615 16 | RETURN-STACK-CELLS = 4160 17 | STACK-CELLS = 8256 18 | BLOCK-EXT = YES 19 | BLOCK = YES 20 | DOUBLE-EXT = YES 21 | DOUBLE = YES 22 | EXCEPTION-EXT = YES 23 | EXCEPTION = YES 24 | FACILITY-EXT = YES 25 | FACILITY = YES 26 | FILE-EXT = YES 27 | FILE = YES 28 | FLOATING-EXT = YES 29 | FLOATING = YES 30 | FLOATING-STACK = 511 31 | LOCALS-EXT = YES 32 | LOCALS = YES 33 | #LOCALS = 32 34 | MEMORY-ALLOC-EXT = YES 35 | MEMORY-ALLOC = YES 36 | TOOLS = YES 37 | TOOLS-EXT = YES 38 | SEARCH-ORDER-EXT = YES 39 | SEARCH-ORDER = YES 40 | WORDLISTS = 64 41 | STRING-EXT = YES 42 | STRING = YES 43 | A NONSENSE STRING = UNKNOWN! 44 | 45 | 46 | -------------------------------------------------------------------------------- /test/environ.test64.ok: -------------------------------------------------------------------------------- 1 | 2 | Environment as reported by system: 3 | ================================== 4 | /COUNTED-STRING = 255 5 | /HOLD = 256 6 | /PAD = 1024 7 | ADDRESS-UNIT-BITS = 8 8 | CORE-EXT = YES 9 | CORE = YES 10 | FLOORED = YES 11 | MAX-CHAR = 255 12 | MAX-D = 39614081238685424727357390847 13 | MAX-N = 9223372036854775807 14 | MAX-U = 18446744073709551615 15 | MAX-UD = 79228162495817593524129366015 16 | RETURN-STACK-CELLS = 2080 17 | STACK-CELLS = 4128 18 | BLOCK-EXT = YES 19 | BLOCK = YES 20 | DOUBLE-EXT = YES 21 | DOUBLE = YES 22 | EXCEPTION-EXT = YES 23 | EXCEPTION = YES 24 | FACILITY-EXT = YES 25 | FACILITY = YES 26 | FILE-EXT = YES 27 | FILE = YES 28 | FLOATING-EXT = YES 29 | FLOATING = YES 30 | FLOATING-STACK = 511 31 | LOCALS-EXT = YES 32 | LOCALS = YES 33 | #LOCALS = 32 34 | MEMORY-ALLOC-EXT = YES 35 | MEMORY-ALLOC = YES 36 | TOOLS = YES 37 | TOOLS-EXT = YES 38 | SEARCH-ORDER-EXT = YES 39 | SEARCH-ORDER = YES 40 | WORDLISTS = 64 41 | STRING-EXT = YES 42 | STRING = YES 43 | A NONSENSE STRING = UNKNOWN! 44 | 45 | 46 | -------------------------------------------------------------------------------- /test/exceptn.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | cnt=`grep "BAD" $* | wc -l` 4 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 5 | test "0" -eq "$cnt" 6 | exit 7 | 8 | -------------------------------------------------------------------------------- /test/exceptn.test.ok: -------------------------------------------------------------------------------- 1 | 2 | exception words 3 | system throws: - stack underflow / invalid memory access [sigbus] 4 | -4 /Y/ 0 -9 /Y/ 0 3 /Y/ 0 5 | throw inside evaluate: - catched on commandline / inside a word 6 | 3 /Y/ 0 3 /Y/ 0 7 | sigbus inside evaluate: - catched on commandline / inside a word 8 | -9 /Y/ 0 -9 /Y/ 0 9 | evaluate catch 10 | /Y/ 0 -------------------------------------------------------------------------------- /test/fib.fs: -------------------------------------------------------------------------------- 1 | : fib ( n1 -- n2 ) 2 | dup 2 < if 3 | drop 1 4 | else 5 | dup 6 | 1- recurse 7 | swap 2 - recurse 8 | + 9 | then ; 10 | 11 | : main 34 fib drop ; 12 | -------------------------------------------------------------------------------- /test/file.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ file.4th --- test some file functions 3 | \ (duz 15Apr95) 4 | \ 5 | 6 | CR .( file access word set) 7 | CR .( ====================) 8 | CR 9 | 10 | MARKER FORGET-FILE-TESTS 11 | 12 | [UNDEFINED] Y [IF] : Y -1 = 0= . ; [THEN] 13 | [UNDEFINED] N [IF] : N . ; [THEN] 14 | [UNDEFINED] D [IF] : D DEPTH . ; [THEN] 15 | 16 | \ create a file 17 | : TEST-FN1 S" TESTFN1" ; 18 | : TEST-FN2 S" TESTFN2" ; 19 | 20 | TEST-FN1 R/W CREATE-FILE . VALUE TEST-FILE 21 | D CR 22 | 23 | \ after creation length = position = 0 24 | TEST-FILE FILE-POSITION D. . 25 | TEST-FILE FILE-SIZE D. . 26 | D CR 27 | 28 | \ write something 29 | : TEST-TEXT S" THIS IS JUST SOME TEXT" ; 30 | 31 | TEST-TEXT TEST-FILE WRITE-FILE . 32 | TEST-TEXT NIP S>D TEST-FILE FILE-POSITION DROP D= Y 33 | D CR 34 | 35 | \ read it back and compare it 36 | 0. TEST-FILE REPOSITION-FILE . 37 | PAD DUP TEST-TEXT NIP TEST-FILE READ-FILE . 38 | TEST-TEXT COMPARE . 39 | D CR 40 | 41 | 42 | \ resize the file 43 | 1024. TEST-FILE RESIZE-FILE . TEST-FILE FILE-SIZE . 1024. D= Y SPACE 44 | TEST-FILE FILE-POSITION . TEST-TEXT NIP S>D D= Y SPACE 45 | 46 | 10240. TEST-FILE RESIZE-FILE . TEST-FILE FILE-SIZE . 10240. D= Y SPACE 47 | 2048. TEST-FILE RESIZE-FILE . TEST-FILE FILE-SIZE . 2048. D= Y SPACE 48 | 100. TEST-FILE RESIZE-FILE . TEST-FILE FILE-SIZE . 100. D= Y SPACE 49 | D CR 50 | 51 | TEST-FILE CLOSE-FILE . 52 | TEST-FN1 TEST-FN2 RENAME-FILE . 53 | 54 | TEST-FN2 FILE-STATUS . R/W = Y 55 | TEST-FN2 DELETE-FILE . 56 | D CR 57 | 58 | 59 | FORGET-FILE-TESTS 60 | -------------------------------------------------------------------------------- /test/file.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="stack" 3 | 4 | echo " 5 | //d 6 | /^\$/d 7 | /^file access word set */!bNX 8 | /^file access word set */{g;N;} 9 | /\n==================== */{g;N;} 10 | /\n0 0 \$/{g;N;} 11 | /\n0 0 0 0 0 \$/{g;N;} 12 | /\n0 0 0 \$/{g;N;} 13 | /\n0 0 0 0 \$/{g;N;} 14 | /\n0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 \$/{g;N;} 15 | /\n0 0 0 0 0 0 \$/d 16 | :NX 17 | /----------*/d 18 | {p;d;} 19 | " >$testcase.sed 20 | 21 | sed -n -f $testcase.sed $* >$testcase.tmp 22 | cnt=`cat $testcase.tmp | wc -w` 23 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 24 | test "0" -eq "$cnt" 25 | exit 26 | -------------------------------------------------------------------------------- /test/file.test.ok: -------------------------------------------------------------------------------- 1 | 2 | file access word set 3 | ==================== 4 | 0 0 5 | 0 0 0 0 0 6 | 0 0 0 7 | 0 0 0 0 8 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 9 | 0 0 0 0 0 0 10 | -------------------------------------------------------------------------------- /test/float.nomodules.ok: -------------------------------------------------------------------------------- 1 | no floating wordset available -------------------------------------------------------------------------------- /test/float.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="float" 3 | 4 | echo " 5 | //d 6 | /^\$/d 7 | /^floating point word set */!bN2 8 | /^floating point word set */{g;N;} 9 | /\n======================= *\$/{g;N;} 10 | /\n\\[ .... \\] */d 11 | :N2 12 | /^testing F~ */!bN3 13 | /^testing F~ */{g;N;} 14 | /\n 0 0 0 0 0 0 0 0 0 0 0 0 0 0 */d 15 | :N3 16 | /^floating point number input */!bN4 17 | /^floating point number input */{g;N;} 18 | /\n 0 0 0 0 0 */{g;N;} 19 | /\n 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 */d 20 | :N4 21 | /^floating point constants and variables */!bN5 22 | /^floating point constants and variables */{g;N;} 23 | /\n 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 */d 24 | :N5 25 | /^floating point stack operations */!bN6 26 | /^floating point stack operations */{g;N;} 27 | /\n 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 */d 28 | :N6 29 | /^testing REPRESENT */!bN7 30 | /^testing REPRESENT */{g;N;} 31 | /\n 0 0 >0< 0 0 >000< 0 0 >0000000< 0 0 >00000000000< */{g;N;} 32 | /\n 0 1 >1< 0 1 >100< 0 1 >1000000< 0 1 >10000000000< .*/{g;N;} 33 | /\n 0 2 >1< 0 4 >100< 0 6 >1000000< 0 12 >10000000000< */{g;N;} 34 | /\n 0 2 >1< 0 3 >999< 0 6 >1000000< 0 30 >999999990< */{g;N;} 35 | /\n 0 0 >1< 0 -3 >999< 0 -4 >1000000< 0 -30 >999999990< */{g;N;} 36 | /\n 0 0 >1< 0 -3 >999< 0 -5 >9999999< 0 -30 >999999990< */{g;N;} 37 | /\n 0 10 >1< 0 12 >123< 0 14 >1234568< 0 39 >123456789< */{g;N;} 38 | /\n 0 8 >1< 0 6 >123< 0 4 >1234568< 0 -21 >123456789< */d 39 | :N7 40 | /^testing FROUND */!bNX 41 | /^testing FROUND */{g;N;} 42 | /\n 1.00* 2.00* -1.00* -2.00* */{g;N;} 43 | /\n 0.00* 2.00* 2.00* 4.00* -*0.00* -2.00* -2.00* -4.00* */{g;N;} 44 | /\n 4000000000 4000000002 -4000000000 -4000000002 */{g;N;} 45 | :NX 46 | /\n 0 0 */d 47 | /----------*/d 48 | {p;d;} 49 | " >$testcase.sed 50 | 51 | sed -n -f $testcase.sed $* >$testcase.tmp 52 | cnt=`cat $testcase.tmp | wc -w` 53 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 54 | test "0" -eq "$cnt" 55 | exit 56 | -------------------------------------------------------------------------------- /test/float.test.ok: -------------------------------------------------------------------------------- 1 | 2 | floating point word set 3 | ======================= 4 | [ 1994 ] 5 | testing F~ 6 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7 | floating point number input 8 | 0 0 0 0 0 9 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 | floating point constants and variables 11 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 12 | floating point stack operations 13 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 14 | testing REPRESENT 15 | 0 0 >0< 0 0 >000< 0 0 >0000000< 0 0 >00000000000< 16 | 0 1 >1< 0 1 >100< 0 1 >1000000< 0 1 >10000000000< 17 | 0 2 >1< 0 4 >100< 0 6 >1000000< 0 12 >10000000000< 18 | 0 2 >1< 0 3 >999< 0 6 >1000000< 0 30 >999999990< 19 | 0 0 >1< 0 -3 >999< 0 -5 >9999999< 0 -30 >999999990< 20 | 0 10 >1< 0 12 >123< 0 14 >1234568< 0 39 >123456789< 21 | 0 8 >1< 0 6 >123< 0 4 >1234568< 0 -21 >123456789< 22 | testing FROUND 23 | 1.000000 2.000000 -1.000000 -2.000000 24 | 0.000000 2.000000 2.000000 4.000000 -0.000000 -2.000000 -2.000000 -4.000000 25 | 4000000000 4000000002 -4000000000 -4000000002 26 | 0 0 -------------------------------------------------------------------------------- /test/float.test64.ok: -------------------------------------------------------------------------------- 1 | 2 | floating point word set 3 | ======================= 4 | [ 1994 ] 5 | testing F~ 6 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7 | floating point number input 8 | 0 0 0 0 0 9 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 | floating point constants and variables 11 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 12 | floating point stack operations 13 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 14 | testing REPRESENT 15 | 0 0 >0< 0 0 >000< 0 0 >0000000< 0 0 >00000000000< 16 | 0 1 >1< 0 1 >100< 0 1 >1000000< 0 1 >10000000000< 17 | 0 2 >1< 0 4 >100< 0 6 >1000000< 0 12 >10000000000< 18 | 0 2 >1< 0 3 >999< 0 6 >1000000< 0 30 >999999990< 19 | 0 0 >1< 0 -3 >999< 0 -5 >9999999< 0 -30 >999999990< 20 | 0 10 >1< 0 12 >123< 0 14 >1234568< 0 39 >123456789< 21 | 0 8 >1< 0 6 >123< 0 4 >1234568< 0 -21 >123456789< 22 | testing FROUND 23 | 1.000000 2.000000 -1.000000 -2.000000 24 | 0.000000 2.000000 2.000000 4.000000 -0.000000 -2.000000 -2.000000 -4.000000 25 | 4000000000 4000000002 -4000000000 -4000000002 26 | 0 0 -------------------------------------------------------------------------------- /test/forth-signal.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ test/exception.4th --- test forth signals (orig.: tests the exception word set) 3 | \ (duz 10Aug93) 4 | \ 5 | 6 | [DEFINED] D [NOT] [IF] : D DEPTH . ; [THEN] 7 | [DEFINED] Y [NOT] [IF] : Y IF ." /Y/ " ELSE ." BAD/Y/ " THEN ; [THEN] 8 | [DEFINED] N [NOT] [IF] : N IF ." BAD/N/ " ELSE ." /N/ " THEN ; [THEN] 9 | 10 | CR .( Test handling signals with Forth words. ) CR 11 | 12 | : SIG-TERM-HDL ." SIGTERM handled ok. " ; 13 | ' SIG-TERM-HDL SIGTERM FORTH-SIGNAL . 14 | SIGTERM RAISE-SIGNAL 15 | 0 SIGTERM FORTH-SIGNAL ' SIG-TERM-HDL = Y 16 | 17 | \ (guidod: this seems to have been working at some time but it fails now, ouch) 18 | -------------------------------------------------------------------------------- /test/fp-stack.4th: -------------------------------------------------------------------------------- 1 | .( http://www.forth200x.org/tests/fp-stack.fs ) 2 | 3 | needs floating-ext 4 | 5 | s" FLOATING-EXT" ENVIRONMENT? [IF] DROP 6 | include test/fp-stack.fs 7 | [ELSE] 8 | .( no floating-ext seen, skipped execution ) 9 | [THEN] 10 | 11 | .s 12 | -------------------------------------------------------------------------------- /test/fp-stack.fs: -------------------------------------------------------------------------------- 1 | require test/tester.fs 2 | 3 | decimal 4 | { 2.5e 3 2.5e 2 0e f~ -> 3 2 -1 } 5 | -------------------------------------------------------------------------------- /test/fp-stack.nomodules.ok: -------------------------------------------------------------------------------- 1 | http://www.forth200x.org/tests/fp-stack.fs 2 | .... floating-ext not available 3 | no floating-ext seen, skipped execution 4 | -------------------------------------------------------------------------------- /test/fp-stack.test.ok: -------------------------------------------------------------------------------- 1 | http://www.forth200x.org/tests/fp-stack.fs 2 | -------------------------------------------------------------------------------- /test/fp-stack.test64.ok: -------------------------------------------------------------------------------- 1 | http://www.forth200x.org/tests/fp-stack.fs 2 | -------------------------------------------------------------------------------- /test/fpnostack.nomodules.ok: -------------------------------------------------------------------------------- 1 | no floating wordset available -------------------------------------------------------------------------------- /test/fpnostack.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="fpnostack" 3 | 4 | echo " 5 | //d 6 | /^\$/d 7 | /^fpnostack floating point word set */!bN2 8 | /^fpnostack floating point word set */{g;N;} 9 | /\n======================= *\$/{g;N;} 10 | /\n\\[ 0 \\] */{g;N;} 11 | /\n\\[\\[ .... \\]\\] */d 12 | :N2 13 | /^testing F~ */!bN3 14 | /^testing F~ */{g;N;} 15 | /\n 0 0 0 0 0 0 0 0 0 0 0 0 0 0 */d 16 | :N3 17 | /^floating point number input */!bN4 18 | /^floating point number input */{g;N;} 19 | /\n 0 0 0 0 0 */{g;N;} 20 | /\n 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 */d 21 | :N4 22 | /^floating point constants and variables */!bN5 23 | /^floating point constants and variables */{g;N;} 24 | /\n 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 */d 25 | :N5 26 | /^floating point stack operations */!bN6 27 | /^floating point stack operations */{g;N;} 28 | /\n 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 */d 29 | :N6 30 | /^testing REPRESENT */!bN7 31 | /^testing REPRESENT */{g;N;} 32 | /\n 0 0 >0< 0 0 >000< 0 0 >0000000< 0 0 >00000000000< */{g;N;} 33 | /\n 0 1 >1< 0 1 >100< 0 1 >1000000< 0 1 >10000000000< .*/{g;N;} 34 | /\n 0 2 >1< 0 4 >100< 0 6 >1000000< 0 12 >10000000000< */{g;N;} 35 | /\n 0 2 >1< 0 3 >999< 0 6 >1000000< 0 30 >999999990< */{g;N;} 36 | /\n 0 0 >1< 0 -3 >999< 0 -4 >1000000< 0 -30 >999999990< */{g;N;} 37 | /\n 0 0 >1< 0 -3 >999< 0 -5 >9999999< 0 -30 >999999990< */{g;N;} 38 | /\n 0 10 >1< 0 12 >123< 0 14 >1234568< 0 39 >123456789< */{g;N;} 39 | /\n 0 8 >1< 0 6 >123< 0 4 >1234568< 0 -21 >123456789< */d 40 | :N7 41 | /^testing FROUND */!bNX 42 | /^testing FROUND */{g;N;} 43 | /\n 1.00* 2.00* -1.00* -2.00* */{g;N;} 44 | /\n 0.00* 2.00* 2.00* 4.00* -*0.00* -2.00* -2.00* -4.00* */{g;N;} 45 | /\n 4000000000 4000000002 -4000000000 -4000000002 */{g;N;} 46 | :NX 47 | /\n 0 0 */d 48 | /----------*/d 49 | {p;d;} 50 | " >$testcase.sed 51 | 52 | sed -n -f $testcase.sed $* >$testcase.tmp 53 | cnt=`cat $testcase.tmp | wc -w` 54 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 55 | test "0" -eq "$cnt" 56 | exit 57 | -------------------------------------------------------------------------------- /test/fpnostack.test.ok: -------------------------------------------------------------------------------- 1 | 2 | fpnostack floating point word set 3 | ======================= 4 | [ 0 ] 5 | [[ 2003 ]] 6 | testing F~ 7 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 8 | floating point number input 9 | 0 0 0 0 0 10 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 11 | floating point constants and variables 12 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 13 | floating point stack operations 14 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 15 | testing REPRESENT 16 | 0 0 >0< 0 0 >000< 0 0 >0000000< 0 0 >00000000000< 17 | 0 1 >1< 0 1 >100< 0 1 >1000000< 0 1 >10000000000< 18 | 0 2 >1< 0 4 >100< 0 6 >1000000< 0 12 >10000000000< 19 | 0 2 >1< 0 3 >999< 0 6 >1000000< 0 30 >999999990< 20 | 0 0 >1< 0 -3 >999< 0 -5 >9999999< 0 -30 >999999990< 21 | 0 10 >1< 0 12 >123< 0 14 >1234568< 0 39 >123456789< 22 | 0 8 >1< 0 6 >123< 0 4 >1234568< 0 -21 >123456789< 23 | testing FROUND 24 | 1.000000 2.000000 -1.000000 -2.000000 25 | 0.000000 2.000000 2.000000 4.000000 -0.000000 -2.000000 -2.000000 -4.000000 26 | 4000000000 4000000002 -4000000000 -4000000002 27 | 0 0 -------------------------------------------------------------------------------- /test/fpnostack.test64.ok: -------------------------------------------------------------------------------- 1 | 2 | fpnostack floating point word set 3 | ======================= 4 | [ 0 ] 5 | [[ 2003 ]] 6 | testing F~ 7 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 8 | floating point number input 9 | 0 0 0 0 0 10 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 11 | floating point constants and variables 12 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 13 | floating point stack operations 14 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 15 | testing REPRESENT 16 | 0 0 >0< 0 0 >000< 0 0 >0000000< 0 0 >00000000000< 17 | 0 1 >1< 0 1 >100< 0 1 >1000000< 0 1 >10000000000< 18 | 0 2 >1< 0 4 >100< 0 6 >1000000< 0 12 >10000000000< 19 | 0 2 >1< 0 3 >999< 0 6 >1000000< 0 30 >999999990< 20 | 0 0 >1< 0 -3 >999< 0 -5 >9999999< 0 -30 >999999990< 21 | 0 10 >1< 0 12 >123< 0 14 >1234568< 0 39 >123456789< 22 | 0 8 >1< 0 6 >123< 0 4 >1234568< 0 -21 >123456789< 23 | testing FROUND 24 | 1.000000 2.000000 -1.000000 -2.000000 25 | 0.000000 2.000000 2.000000 4.000000 -0.000000 -2.000000 -2.000000 -4.000000 26 | 4000000000 4000000002 -4000000000 -4000000002 27 | 0 0 -------------------------------------------------------------------------------- /test/hashvocdistri.fs: -------------------------------------------------------------------------------- 1 | 2 | \ how good is the hashfunction in use. 3 | 4 | : hashlink-depth ( nfa -- depth ) 5 | 0 swap 6 | begin ?dup while 7 | swap 1+ swap 8 | name> >link @ 9 | repeat 10 | ; 11 | 12 | : hashvoc-distri ( -- ) 13 | 31 0 do 14 | context @ i cells + @ 15 | hashlink-depth . 16 | i 15 and 0= if cr then 17 | loop ; 18 | 19 | : run hashvoc-distri ; 20 | 21 | \ background: 22 | \ in pfe, words are memorized case-sensitive but 23 | \ the wordset itself can be case-insensitive. Therefore 24 | \ the hashvalue for a name must be the same for all 25 | \ words that only differ in case for a few positions. 26 | \ Currently, I use ( h += *s++ ; h ^= l++ ; ) and the 27 | \ hashsize is limited to 32-modulo - it's just about 28 | \ the lower 5-bits of ascii-chars to match for this 29 | \ case. A greater hashmodulo would need to have it 30 | \ forcebly made case-insensitive, e.g. 31 | \ ( h += 0x40 | *s++ ; h ^= l++ ; ) 32 | 33 | -------------------------------------------------------------------------------- /test/locals-ext.4th: -------------------------------------------------------------------------------- 1 | CR 2 | 3 | CR .( locals test ) 4 | : x locals| a b | a . b . dup . to a a . b . ; 5 | CR 1 2 3 x 6 | CR .( 3 2 1 1 2 ) 7 | 8 | CR 9 | 10 | 11 | -------------------------------------------------------------------------------- /test/loop-test.4th: -------------------------------------------------------------------------------- 1 | CR 2 | 3 | CR .( loop zero-up ) 4 | : x 0 do i . loop ; 5 | CR 20 x 6 | CR .( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ) 7 | 8 | CR .( loop two-up ) 9 | : xx 2 do i . loop ; 10 | CR 20 xx 11 | CR .( 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ) 12 | 13 | CR 14 | 15 | 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /test/loop-test.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="loop-test" 3 | 4 | echo " 5 | /is redefined/d 6 | //d 7 | /loop zero-up/b zeroup 8 | /loop two-up/b twoup 9 | {p;d;} 10 | :zeroup 11 | {N;N;s/loop zero-up//;} 12 | s/0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19// 13 | s/0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19// 14 | {p;d;} 15 | :twoup 16 | {N;N;s/loop two-up//;} 17 | s/2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19// 18 | s/2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19// 19 | {p;d;} 20 | " >$testcase.sed 21 | 22 | sed -n -f $testcase.sed $* >$testcase.tmp 23 | cnt=`cat $testcase.tmp | wc -w` 24 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 25 | test "0" -eq "$cnt" 26 | exit 27 | 28 | -------------------------------------------------------------------------------- /test/loop-test.test.ok: -------------------------------------------------------------------------------- 1 | 2 | 3 | loop zero-up 4 | 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 5 | 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 6 | loop two-up 7 | 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 8 | 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 9 | -------------------------------------------------------------------------------- /test/matrix.fs: -------------------------------------------------------------------------------- 1 | \ .( Loading Matrix Multiplication benchmark...) cr 2 | \ NOTE: This version needs 0.5MB data space 3 | 4 | \ A classical benchmark of an O(n**3) algorithm; Matrix Multiplication 5 | \ 6 | \ Part of the programs gathered by John Hennessy for the MIPS 7 | \ RISC project at Stanford. Translated to forth by Marty Fraeman, 8 | \ Johns Hopkins University/Applied Physics Laboratory. 9 | 10 | \ MM forth2c doesn't have it ! 11 | : mybounds over + swap ; 12 | 13 | variable seed 14 | 15 | : initiate-seed ( -- ) 74755 seed ! ; 16 | : random ( -- n ) seed @ 1309 * 13849 + 65535 and dup seed ! ; 17 | 18 | 200 constant row-size 19 | row-size cells constant row-byte-size 20 | 21 | row-size row-size * constant mat-size 22 | mat-size cells constant mat-byte-size 23 | 24 | align create ima mat-byte-size allot 25 | align create imb mat-byte-size allot 26 | align create imr mat-byte-size allot 27 | 28 | : initiate-matrix ( m[row-size][row-size] -- ) 29 | mat-byte-size mybounds do 30 | random dup 120 / 120 * - 60 - i ! 31 | cell +loop 32 | ; 33 | 34 | : innerproduct ( a[row][*] b[*][column] -- int) 35 | 0 row-size 0 do 36 | >r over @ over @ * r> + >r 37 | swap cell+ swap row-byte-size + 38 | r> 39 | loop 40 | >r 2drop r> 41 | ; 42 | 43 | : main ( -- ) 44 | initiate-seed 45 | ima initiate-matrix 46 | imb initiate-matrix 47 | imr ima mat-byte-size mybounds do 48 | imb row-byte-size mybounds do 49 | j i innerproduct over ! cell+ 50 | cell +loop 51 | row-size cells +loop 52 | drop 53 | ; 54 | 55 | 56 | -------------------------------------------------------------------------------- /test/mini-oof.fs: -------------------------------------------------------------------------------- 1 | \ Mini-OOF 12apr98py 2 | : method ( m v "name" -- m' v ) Create over , swap cell+ swap 3 | DOES> ( ... o -- ... ) @ over @ + @ execute ; 4 | : var ( m v size "name" -- m v' ) Create over , + 5 | DOES> ( o -- addr ) @ + ; 6 | : class ( class -- class methods vars ) dup 2@ ; 7 | : end-class ( class methods vars "name" -- ) 8 | Create here >r , dup , 2 cells ?DO ['] noop , 1 cells +LOOP 9 | cell+ dup cell+ r> rot @ 2 cells /string move ; 10 | : defines ( xt class "name" -- ) ' >body @ + ! ; 11 | : new ( class -- o ) here over @ allot swap over ! ; 12 | : :: ( class "name" -- ) ' >body @ + @ compile, ; 13 | Create object 1 cells , 2 cells , 14 | -------------------------------------------------------------------------------- /test/moof-exm.fs: -------------------------------------------------------------------------------- 1 | \ usage: 2 | 3 | object class 4 | cell var text 5 | cell var len 6 | cell var x 7 | cell var y 8 | method init 9 | method draw 10 | end-class button 11 | 12 | :noname ( o -- ) >r 13 | r@ x @ r@ y @ at-xy r@ text @ r> len @ type ; 14 | button defines draw 15 | :noname ( addr u o -- ) >r 16 | 0 r@ x ! 0 r@ y ! r@ len ! r> text ! ; 17 | button defines init 18 | 19 | \ interitance 20 | 21 | : bold 27 emit ." [1m" ; 22 | : normal 27 emit ." [0m" ; 23 | 24 | button class end-class bold-button 25 | :noname bold [ button :: draw ] normal ; bold-button defines draw 26 | 27 | \ Create and draw a button: 28 | 29 | button new Constant foo 30 | s" thin foo" foo init 31 | page 32 | foo draw 33 | bold-button new Constant bar 34 | s" fat bar" bar init 35 | 1 bar y ! 36 | bar draw 37 | -------------------------------------------------------------------------------- /test/moofglos.fs: -------------------------------------------------------------------------------- 1 | \ This contains the same Forth source as mini-oof.fs, but 2 | \ also contains glossary information for the manual. 3 | 4 | : method ( m v "name" -- m' v ) \ mini-oof 5 | \G Define a selector. 6 | Create over , swap cell+ swap 7 | DOES> ( ... o -- ... ) @ over @ + @ execute ; 8 | 9 | : var ( m v size "name" -- m v' ) \ mini-oof 10 | \G Define a variable with @var{size} bytes. 11 | Create over , + 12 | DOES> ( o -- addr ) @ + ; 13 | 14 | : class ( class -- class selectors vars ) \ mini-oof 15 | \G Start the definition of a class. 16 | dup 2@ ; 17 | 18 | : end-class ( class selectors vars "name" -- ) \ mini-oof 19 | \G End the definition of a class. 20 | Create here >r , dup , 2 cells ?DO ['] noop , 1 cells +LOOP 21 | cell+ dup cell+ r> rot @ 2 cells /string move ; 22 | 23 | : defines ( xt class "name" -- ) \ mini-oof 24 | \G Bind @var{xt} to the selector @var{name} in class @var{class}. 25 | ' >body @ + ! ; 26 | 27 | : new ( class -- o ) \ mini-oof 28 | \G Create a new incarnation of the class @var{class}. 29 | here over @ allot swap over ! ; 30 | 31 | : :: ( class "name" -- ) \ mini-oof colon-colon 32 | \G Compile the method for the selector @var{name} of the class 33 | \G @var{class} (not immediate!). 34 | ' >body @ + @ compile, ; 35 | 36 | Create object ( -- a-addr ) \ mini-oof 37 | 1 cells , 2 cells , 38 | \G @var{object} is the base class of all objects. 39 | -------------------------------------------------------------------------------- /test/number-prefixes.4th: -------------------------------------------------------------------------------- 1 | .( http://www.forth200x.org/tests/number-prefixes.fs ) cr 2 | 3 | .( fake 'z' - char prefix is not supported ) cr 4 | [CHAR] z VALUE 'z' 5 | 6 | include ./tester.fs 7 | 8 | REDEFINED-MSG OFF 9 | include test/number-prefixes.fs 10 | 11 | .S 12 | -------------------------------------------------------------------------------- /test/number-prefixes.fs: -------------------------------------------------------------------------------- 1 | require ./tester.fs 2 | decimal 3 | 4 | { #1289 -> 1289 } 5 | { #12346789. -> 12346789. } 6 | { #-1289 -> -1289 } 7 | { #-12346789. -> -12346789. } 8 | { $12eF -> 4847 } 9 | { $12aBcDeF. -> 313249263. } 10 | { $-12eF -> -4847 } 11 | { $-12AbCdEf. -> -313249263. } 12 | { %10010110 -> 150 } 13 | { %10010110. -> 150. } 14 | { %-10010110 -> -150 } 15 | { %-10010110. -> -150. } 16 | { 'z' -> 122 } 17 | -------------------------------------------------------------------------------- /test/number-prefixes.test.ok: -------------------------------------------------------------------------------- 1 | http://www.forth200x.org/tests/number-prefixes.fs 2 | fake 'z' - char prefix is not supported 3 | 4 | -------------------------------------------------------------------------------- /test/number-prefixes.test64.ok: -------------------------------------------------------------------------------- 1 | http://www.forth200x.org/tests/number-prefixes.fs 2 | fake 'z' - char prefix is not supported 3 | 4 | -------------------------------------------------------------------------------- /test/parse-name.4th: -------------------------------------------------------------------------------- 1 | 2 | \ old PFE: SYNONYM PARSE-NAME PARSE-WORD 3 | 4 | cr .( http://www.forth200x.org/tests/parse-name.fs ) cr 5 | include test/parse-name.fs 6 | 7 | .s 8 | -------------------------------------------------------------------------------- /test/parse-name.fs: -------------------------------------------------------------------------------- 1 | require test/tester.fs 2 | 3 | { PARSE-NAME abcd S" abcd" COMPARE -> 0 } 4 | { PARSE-NAME abcde S" abcde" COMPARE -> 0 } 5 | \ test empty parse area 6 | { PARSE-NAME 7 | NIP -> 0 } 8 | { PARSE-NAME 9 | nip -> 0 } 10 | 11 | { : parse-name-test ( "name1" "name2" -- n ) 12 | PARSE-NAME PARSE-NAME COMPARE ; -> } 13 | { parse-name-test abcd abcd -> 0 } 14 | { parse-name-test abcd abcd -> 0 } 15 | { parse-name-test abcde abcdf -> -1 } 16 | { parse-name-test abcdf abcde -> 1 } 17 | { parse-name-test abcde abcde 18 | -> 0 } 19 | { parse-name-test abcde abcde 20 | -> 0 } 21 | 22 | -------------------------------------------------------------------------------- /test/parse-name.test.ok: -------------------------------------------------------------------------------- 1 | 2 | http://www.forth200x.org/tests/parse-name.fs 3 | 4 | -------------------------------------------------------------------------------- /test/parse-name.test64.ok: -------------------------------------------------------------------------------- 1 | 2 | http://www.forth200x.org/tests/parse-name.fs 3 | 4 | -------------------------------------------------------------------------------- /test/postpone.4th: -------------------------------------------------------------------------------- 1 | CR 2 | include test/tester.fs 3 | CR .( ----------------------------------------------- ) CR 4 | include test/postpone.fs 5 | CR 6 | 7 | 8 | -------------------------------------------------------------------------------- /test/postpone.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="postpone" 3 | 4 | echo " 5 | /is redefined/d 6 | //d 7 | /testing postpone .*/d 8 | /you should see this first./b postponeorder 9 | /----------*/d 10 | {p;d;} 11 | :postponeorder 12 | {N;s/you should see this first.//;} 13 | s/you should see this later.// 14 | {p;d;} 15 | " >$testcase.sed 16 | 17 | sed -n -f $testcase.sed $* >$testcase.tmp 18 | cnt=`cat $testcase.tmp | wc -w` 19 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 20 | test "0" -eq "$cnt" 21 | exit 22 | -------------------------------------------------------------------------------- /test/postpone.test.ok: -------------------------------------------------------------------------------- 1 | 2 | 3 | ----------------------------------------------- 4 | testing postpone ( 5 | testing postpone +loop 6 | testing postpone ." 7 | you should see this first. 8 | you should see this later. 9 | testing postpone ; 10 | testing postpone abort" 11 | testing postpone begin 12 | testing postpone do 13 | testing postpone does> 14 | testing postpone else 15 | testing postpone if 16 | testing postpone literal 17 | testing postpone loop 18 | testing postpone postpone 19 | testing postpone recurse 20 | testing postpone repeat 21 | testing postpone S" 22 | testing postpone then 23 | testing postpone until 24 | testing postpone while 25 | testing postpone ['] 26 | testing postpone [char] 27 | 28 | -------------------------------------------------------------------------------- /test/queryapp.4th: -------------------------------------------------------------------------------- 1 | : main 2 | BEGIN 3 | QUERY 4 | #TIB @ 1 = IF TIB C@ ASCII . = IF EXIT THEN THEN 5 | TIB #TIB @ TYPE s" ! " TYPE CR 6 | AGAIN 7 | ; 8 | 9 | ' main APPLICATION ! 10 | 11 | -------------------------------------------------------------------------------- /test/queryapp.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="queryapp" 3 | 4 | echo " 5 | //d 6 | s/^hello world// 7 | s/^boo// 8 | s/^oops// 9 | s/^!// 10 | {p;d;} 11 | " >$testcase.sed 12 | 13 | sed -n -f $testcase.sed $* >$testcase.tmp 14 | cnt=`cat $testcase.tmp | wc -w` 15 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 16 | test "0" -eq "$cnt" 17 | exit 18 | -------------------------------------------------------------------------------- /test/queryapp.test.ok: -------------------------------------------------------------------------------- 1 | APPLICATION is set 2 | -------------- 3 | APPLICATION is started 4 | ------------------- 5 | hello world! 6 | boo! 7 | ! 8 | oops! 9 | -------------------------------------------------------------------------------- /test/queryapp.test64.ok: -------------------------------------------------------------------------------- 1 | APPLICATION is set 2 | -------------- 3 | APPLICATION is started 4 | ------------------- 5 | hello world! 6 | boo! 7 | ! 8 | oops! 9 | -------------------------------------------------------------------------------- /test/queryapp.txt: -------------------------------------------------------------------------------- 1 | hello world 2 | boo 3 | 4 | oops 5 | . 6 | plonk 7 | -------------------------------------------------------------------------------- /test/search-order.4th: -------------------------------------------------------------------------------- 1 | CR 2 | include test/tester.fs 3 | verbose on 4 | include test/search-order.fs 5 | CR 6 | 7 | -------------------------------------------------------------------------------- /test/search-order.fs: -------------------------------------------------------------------------------- 1 | 2 | FORTH-WORDLIST VALUE #FORTH# 3 | ENVIRONMENT-WORDLIST VALUE #ENVIRON# 4 | 5 | TESTING bootup CURRENT must be FORTH-WORDLIST 6 | 7 | { GET-CURRENT -> #FORTH# } 8 | 9 | TESTING ONLY FORTH should leave ORDER with only FORTH-WORDLIST 10 | 11 | { ONLY FORTH GET-ORDER -> #FORTH# 1 } 12 | 13 | TESTING ONLY FORTH ALSO should leave two times FORTH-WORDLIST 14 | 15 | { ONLY FORTH ALSO GET-ORDER -> #FORTH# #FORTH# 2 } 16 | 17 | TESTING ONLY FORTH ALSO ENVIRONMENT should leave two different wordlists 18 | 19 | { ONLY FORTH ALSO ENVIRONMENT GET-ORDER -> #FORTH# #ENVIRON# 2 } 20 | 21 | TESTING ONLY FORTH ALSO ENVIRONMENT DEFINITIONS should change CURRENT } 22 | { ONLY FORTH ALSO ENVIRONMENT DEFINITIONS GET-CURRENT -> #ENVIRON# } 23 | 24 | TESTING PREVIOUS to revert ALSO 25 | { ONLY FORTH ALSO ENVIRONMENT PREVIOUS GET-ORDER -> #FORTH# 1 } 26 | 27 | TESTING SET-ORDER / GET-ORDER pairs 28 | { #FORTH# #ENVIRON# 2 SET-ORDER GET-ORDER -> #FORTH# #ENVIRON# 2 } 29 | { ONLY FORTH ALSO ENVIRONMENT GET-ORDER ROT SWAP SET-ORDER GET-ORDER -> #ENVIRON# #FORTH# 2 } 30 | 31 | [DEFINED] CURRENT [IF] 32 | TESTING SET-CURRENT / GET-CURRENT and CURRENT ! / CURRENT @ identical 33 | { #ENVIRON# SET-CURRENT CURRENT @ -> #ENVIRON# } 34 | { FORTH DEFINITIONS CURRENT @ -> #FORTH# } 35 | { #ENVIRON# CURRENT ! GET-CURRENT -> #ENVIRON# } 36 | [THEN] 37 | 38 | [DEFINED] CONTEXT [IF] 39 | TESTING SET-ORDER / GET-ORDER and CONTEXT ! / CONTEXT @ identical 40 | { #FORTH# #ENVIRON# 2 SET-ORDER CONTEXT @ -> #ENVIRON# } 41 | { #FORTH# #ENVIRON# 2 SET-ORDER CONTEXT CELL+ @ -> #FORTH# } 42 | { ONLY FORTH ALSO #ENVIRON# CONTEXT ! GET-ORDER -> #FORTH# #ENVIRON# 2 } 43 | { ONLY FORTH ALSO ENVIRONMENT CONTEXT CELL+ @ CONTEXT ! GET-ORDER -> #FORTH# #FORTH# 2 } 44 | [THEN] 45 | -------------------------------------------------------------------------------- /test/search-order.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="search-order" 3 | 4 | echo " 5 | /is redefined/d 6 | //d 7 | /testing .*/d 8 | /TESTING .*/d 9 | /----------*/d 10 | {p;d;} 11 | " >$testcase.sed 12 | 13 | sed -n -f $testcase.sed $* >$testcase.tmp 14 | cnt=`cat $testcase.tmp | wc -w` 15 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 16 | test "0" -eq "$cnt" 17 | exit 18 | -------------------------------------------------------------------------------- /test/search-order.test.ok: -------------------------------------------------------------------------------- 1 | 2 | TESTING bootup CURRENT must be FORTH-WORDLIST 3 | TESTING ONLY FORTH should leave ORDER with only FORTH-WORDLIST 4 | TESTING ONLY FORTH ALSO should leave two times FORTH-WORDLIST 5 | TESTING ONLY FORTH ALSO ENVIRONMENT should leave two different wordlists 6 | TESTING ONLY FORTH ALSO ENVIRONMENT DEFINITIONS should change CURRENT } 7 | TESTING PREVIOUS to revert ALSO 8 | TESTING SET-ORDER / GET-ORDER pairs 9 | TESTING SET-CURRENT / GET-CURRENT and CURRENT ! / CURRENT @ identical 10 | TESTING SET-ORDER / GET-ORDER and CONTEXT ! / CONTEXT @ identical 11 | 12 | -------------------------------------------------------------------------------- /test/siev.fs: -------------------------------------------------------------------------------- 1 | \ #! /usr/stud/paysan/bin/forth 2 | 3 | DECIMAL 4 | \ : SECS TIME&DATE SWAP 60 * + SWAP 3600 * + NIP NIP NIP ; 5 | CREATE FLAGS 8190 ALLOT 6 | variable eflag 7 | \ FLAGS 8190 + CONSTANT EFLAG 8 | 9 | : PRIMES ( -- n ) FLAGS 8190 1 FILL 0 3 EFLAG @ FLAGS 10 | DO I C@ 11 | IF DUP I + DUP EFLAG @ < 12 | IF EFLAG @ SWAP 13 | DO 0 I C! DUP +LOOP 14 | ELSE DROP THEN SWAP 1+ SWAP 15 | THEN 2 + 16 | LOOP DROP ; 17 | 18 | : BENCHMARK 0 1000 0 DO PRIMES NIP LOOP ; 19 | \ SECS BENCHMARK . SECS SWAP - CR . .( secs) 20 | : main 21 | flags 8190 + eflag ! 22 | benchmark ( . ) drop 23 | ; 24 | -------------------------------------------------------------------------------- /test/sieve.fs: -------------------------------------------------------------------------------- 1 | DECIMAL 2 | : SECS TIME&DATE DROP DROP DROP 60 * + 60 * + ; 3 | CREATE FLAGS 8190 ALLOT 4 | FLAGS 8190 + CONSTANT EFLAG 5 | 6 | : PRIMES ( -- n ) FLAGS 8190 1 FILL 0 3 EFLAG FLAGS 7 | DO I C@ 8 | IF DUP I + DUP EFLAG < 9 | IF EFLAG SWAP 10 | DO 0 I C! DUP +LOOP 11 | ELSE DROP THEN SWAP 1+ SWAP 12 | THEN 2 + 13 | LOOP DROP ; 14 | 15 | : BENCHMARK 0 100 0 DO PRIMES NIP LOOP ; 16 | SECS BENCHMARK . SECS SWAP - CR . .( secs) 17 | BYE 18 | -------------------------------------------------------------------------------- /test/sievem.fs: -------------------------------------------------------------------------------- 1 | DECIMAL 2 | : SECS TIME&DATE DROP DROP DROP 60 * + 60 * + ; 3 | CREATE FLAGS 8190 ALLOT 4 | FLAGS 8190 + CONSTANT EFLAG 5 | 6 | : PRIMES ( -- n ) FLAGS 8190 1 FILL 0 3 EFLAG FLAGS 7 | DO I C@ 8 | IF DUP I + DUP EFLAG < 9 | IF EFLAG SWAP 10 | DO 0 I C! DUP +LOOP 11 | ELSE DROP THEN SWAP 1+ SWAP 12 | THEN 2 + 13 | LOOP DROP ; 14 | 15 | : BENCHMARK 0 1000 0 DO PRIMES NIP LOOP ; 16 | SECS BENCHMARK . SECS SWAP - CR . .( secs) 17 | BYE 18 | -------------------------------------------------------------------------------- /test/sokoban.4th: -------------------------------------------------------------------------------- 1 | : page .clrscr ; 2 | include sokoban.fs 3 | sokoban 4 | bye 5 | -------------------------------------------------------------------------------- /test/speedwhile.fs: -------------------------------------------------------------------------------- 1 | 2 | : sec@ gettimeofday nip ; 3 | 4 | variable duration 5 | : x sec@ swap begin dup while 1 - repeat drop sec@ swap - duration ! ; 6 | 7 | cr .( 1/4mio x = ) 250000 x duration ? 8 | cr duration @ 10 < [IF] 9 | .( 1mio x = ) 1000000 x duration ? 10 | [ELSE] .( 1mio x skipped-) [THEN] 11 | cr duration @ 10 < [IF] 12 | .( 4mio x = ) 4000000 x duration ? 13 | [ELSE] .( 4mio x skipped-) [THEN] 14 | cr duration @ 10 < [IF] 15 | .( 16mio x = ) 16000000 x duration ? 16 | [ELSE] .( 16mio x skipped-) [THEN] 17 | cr duration @ 10 < [IF] 18 | .( 64mio x = ) 64000000 x duration ? 19 | [ELSE] .( 64mio x skipped-) [THEN] 20 | cr duration @ 10 < [IF] 21 | .( 256mio x = ) 256000000 x duration ? 22 | [ELSE] .( 256mio x skipped-) [THEN] 23 | cr duration @ 10 < [IF] 24 | .( 1024mio x = ) 1024000000 x duration ? 25 | [ELSE] .( 1024mio x skipped-) [THEN] 26 | cr 27 | 28 | -------------------------------------------------------------------------------- /test/stack.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ test/stack.4th --- test stack and return stack operators 3 | \ (duz 05Aug93) 4 | \ 5 | 6 | [UNDEFINED] D [IF] : D DEPTH . ; [THEN] 7 | 8 | CR .( stack operators ) 9 | 10 | CR .( single co ) 11 | 11 CONSTANT N1 12 | 22 CONSTANT N2 13 | 33 CONSTANT N3 14 | 15 | CR N1 N2 DROP . D CR .( 11 0 ) 16 | CR N1 N2 DUP . . . D CR .( 22 22 11 0 ) 17 | CR N1 N2 ?DUP . . . D CR .( 22 22 11 0 ) 18 | CR N1 0 ?DUP . . D CR .( 0 11 0 ) 19 | CR N1 N2 SWAP . . D CR .( 11 22 0 ) 20 | CR N1 N2 OVER . . . D CR .( 11 22 11 0 ) 21 | CR N1 N2 N3 ROT . . . D CR .( 11 33 22 0 ) 22 | CR N1 N2 NIP . D CR .( 22 0 ) 23 | CR N1 N2 TUCK . . . D CR .( 22 11 22 0 ) 24 | CR N1 N2 N3 -ROT . . . D CR .( 22 11 33 0 ) 25 | 26 | CR .( double co ) 27 | 11. 2CONSTANT D1 28 | 22. 2CONSTANT D2 29 | 33. 2CONSTANT D3 30 | 31 | CR D1 D2 2DROP D. D CR .( 11 0 ) 32 | CR D1 D2 2DUP D. D. D. D CR .( 22 22 11 0 ) 33 | CR D1 D2 2SWAP D. D. D CR .( 11 22 0 ) 34 | CR D1 D2 2OVER D. D. D. D CR .( 11 22 11 0 ) 35 | CR D1 D2 D3 2ROT D. D. D. D CR .( 11 33 22 0 ) 36 | 37 | CR 38 | 39 | -------------------------------------------------------------------------------- /test/stack.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="stack" 3 | 4 | echo " 5 | //d 6 | /^\$/d 7 | /^stack operators.*/d 8 | /^single co.*/!bN2 9 | /^single co.*/{g;N;} 10 | /\n11 0/{g;N;} 11 | /\n11 0/{g;N;} 12 | /\n22 22 11 0/{g;N;} 13 | /\n22 22 11 0/{g;N;} 14 | /\n22 22 11 0/{g;N;} 15 | /\n22 22 11 0/{g;N;} 16 | /\n0 11 0/{g;N;} 17 | /\n0 11 0/{g;N;} 18 | /\n11 22 0/{g;N;} 19 | /\n11 22 0/{g;N;} 20 | /\n11 22 11 0/{g;N;} 21 | /\n11 22 11 0/{g;N;} 22 | /\n11 33 22 0/{g;N;} 23 | /\n11 33 22 0/{g;N;} 24 | /\n22 0/{g;N;} 25 | /\n22 0/{g;N;} 26 | /\n22 11 22 0/{g;N;} 27 | /\n22 11 22 0/{g;N;} 28 | /\n22 11 33 0/{g;N;} 29 | /\n22 11 33 0/d 30 | :N2 31 | /^double co.*/!bNX 32 | /^double co.*/{g;N;} 33 | /\n11 0/{g;N;} 34 | /\n11 0/{g;N;} 35 | /\n22 22 11 0/{g;N;} 36 | /\n22 22 11 0/{g;N;} 37 | /\n11 22 0/{g;N;} 38 | /\n11 22 0/{g;N;} 39 | /\n11 22 11 0/{g;N;} 40 | /\n11 22 11 0/{g;N;} 41 | /\n11 33 22 0/{g;N;} 42 | /\n11 33 22 0/d 43 | :NX 44 | /----------*/d 45 | {p;d;} 46 | " >$testcase.sed 47 | 48 | sed -n -f $testcase.sed $* >$testcase.tmp 49 | cnt=`cat $testcase.tmp | wc -w` 50 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 51 | test "0" -eq "$cnt" 52 | exit 53 | -------------------------------------------------------------------------------- /test/stack.test.ok: -------------------------------------------------------------------------------- 1 | 2 | stack operators 3 | single co 4 | 11 0 5 | 11 0 6 | 22 22 11 0 7 | 22 22 11 0 8 | 22 22 11 0 9 | 22 22 11 0 10 | 0 11 0 11 | 0 11 0 12 | 11 22 0 13 | 11 22 0 14 | 11 22 11 0 15 | 11 22 11 0 16 | 11 33 22 0 17 | 11 33 22 0 18 | 22 0 19 | 22 0 20 | 22 11 22 0 21 | 22 11 22 0 22 | 22 11 33 0 23 | 22 11 33 0 24 | double co 25 | 11 0 26 | 11 0 27 | 22 22 11 0 28 | 22 22 11 0 29 | 11 22 0 30 | 11 22 0 31 | 11 22 11 0 32 | 11 22 11 0 33 | 11 33 22 0 34 | 11 33 22 0 35 | -------------------------------------------------------------------------------- /test/string.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ string.4th --- test some string functions 3 | \ (duz 15Apr95) 4 | \ 5 | 6 | [UNDEFINED] D [IF] : D DEPTH . ; [THEN] 7 | [UNDEFINED] Y [IF] : Y IF ." /Y/ " ELSE ." BAD/Y/ " THEN ; [THEN] 8 | [UNDEFINED] N [IF] : N IF ." BAD/N/ " ELSE ." /N/ " THEN ; [THEN] 9 | 10 | CR .( string word set) 11 | CR .( ===============) 12 | CR 13 | 14 | MARKER FORGET-STRING-TESTS 15 | 16 | CR .( define ) 17 | : STR1 S" ASDFASDF" ; 18 | : STR2 S" ASDFASDFGHJK" ; 19 | : STR3 S" ASDFGHJK" ; 20 | 21 | CR .( compare ) 22 | STR1 STR3 COMPARE -1 = Y 23 | STR3 STR1 COMPARE 1 = Y 24 | STR1 STR1 COMPARE 0 = Y 25 | STR1 STR2 COMPARE -1 = Y 26 | STR2 STR1 COMPARE 1 = Y SPACE D 27 | 28 | CR .( search ) 29 | STR2 STR1 SEARCH Y STR2 D= Y 30 | STR2 STR3 SEARCH Y STR2 4 /STRING D= Y 31 | STR3 STR1 SEARCH N STR3 D= Y SPACE D 32 | 33 | 34 | FORGET-STRING-TESTS 35 | 36 | CR 37 | -------------------------------------------------------------------------------- /test/string.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="string" 3 | 4 | echo " 5 | //d 6 | /^\$/d 7 | /^string word set\$/!bskip 8 | /^string word set\$/{g;N;} 9 | /\n===============\$/{g;N;N;} 10 | /\n\ndefine \$/{g;N;} 11 | /\ncompare .Y. .Y. .Y. .Y. .Y. 0 $/{g;N;} 12 | /\nsearch .Y. .Y. .Y. .Y. .N. .Y. 0 $/d 13 | :skip 14 | /----------*/d 15 | {p;d;} 16 | " >$testcase.sed 17 | 18 | sed -n -f $testcase.sed $* >$testcase.tmp 19 | cnt=`cat $testcase.tmp | wc -w` 20 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 21 | test "0" -eq "$cnt" 22 | exit 23 | -------------------------------------------------------------------------------- /test/string.test.ok: -------------------------------------------------------------------------------- 1 | 2 | string word set 3 | =============== 4 | 5 | define 6 | compare /Y/ /Y/ /Y/ /Y/ /Y/ 0 7 | search /Y/ /Y/ /Y/ /Y/ /N/ /Y/ 0 8 | -------------------------------------------------------------------------------- /test/suite.4th: -------------------------------------------------------------------------------- 1 | \ 2 | \ testsuite.4th --- tests to verify the proper operation 3 | \ of the portable forth environment 4 | \ (duz 05Aug93) 5 | \ 6 | 7 | ONLY FORTH ALSO DEFINITIONS 8 | 9 | CR 10 | CR .( running "tester.fr" and "core.fr") 11 | CR .( =================================) 12 | CR 13 | 14 | MARKER FORGET-TESTER/CORE 15 | S" test/tester.fr" INCLUDED 16 | S" test/core.fr" INCLUDED 17 | FORGET-TESTER/CORE 18 | 19 | CR 20 | CR .( running checkans, a test for words missing from the ANS word sets) 21 | CR .( =================================================================) 22 | CR 23 | MARKER FORGET-CHECKANS 24 | : WORDSETS_FS S" test/wordsets.fs" ; 25 | S" test/checkans.fs" INCLUDED 26 | FORGET-CHECKANS 27 | 28 | 29 | CR 30 | CR .( testing pfe extensions:) 31 | EXTENSIONS ALSO FORTH 32 | INCLUDE test/defs.4th 33 | WAIT 34 | 35 | \ display status and environment 36 | SHOW-STATUS 37 | WAIT 38 | 39 | INCLUDE test/environ.4th 40 | WAIT 41 | 42 | \ test help 43 | HELP FE. 44 | WAIT 45 | 46 | 47 | CR 48 | CR .( More tests:) 49 | CR .( ===========) 50 | CR 51 | 52 | INCLUDE test/stack.4th WAIT 53 | INCLUDE test/compare.4th WAIT 54 | INCLUDE test/arith.4th WAIT 55 | INCLUDE test/float.4th WAIT 56 | INCLUDE test/exceptn.4th WAIT 57 | INCLUDE test/string.4th WAIT 58 | INCLUDE test/file.4th WAIT 59 | INCLUDE test/intactv.4th WAIT 60 | 61 | 62 | CR 63 | CR .( Do you want to try the block editor? ) KEY 64 | BL OR CHAR n <> [IF] USING test/benchm.blk 1 EDIT-BLOCK [THEN] 65 | 66 | 67 | CR 68 | CR .( Finally some benchmarks:) 69 | CR .( ========================) 70 | CR 71 | 72 | USING test/benchm.blk 1 LOAD WAIT 73 | 74 | 75 | CR 76 | CR .( This should be nicely formatted FORTH-source:) 77 | CR .( =============================================) 78 | CR 79 | 80 | SEE DO-PRIME WAIT 81 | 82 | 83 | CR 84 | CR .( System survived so far?) 85 | CR .( Fine!) 86 | CR 87 | 88 | CR 89 | -------------------------------------------------------------------------------- /test/test-num-prefixes.4th: -------------------------------------------------------------------------------- 1 | cr .( obsoletion warning for old style &10 decimal prefix) cr 2 | 3 | REDEFINED-MSG OFF ( avoid obsoletion warning for &10 prefix ) 4 | 5 | cr cr .( http://www.forth200x.org/tests/number-prefixes.fs ) cr 6 | include test/test-num-prefixes.fs 7 | 8 | .S 9 | -------------------------------------------------------------------------------- /test/test-num-prefixes.fs: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/test/test-num-prefixes.fs -------------------------------------------------------------------------------- /test/test-num-prefixes.test.ok: -------------------------------------------------------------------------------- 1 | 2 | obsoletion warning for old style &10 decimal prefix 3 | 4 | 5 | http://www.forth200x.org/tests/number-prefixes.fs 6 | 7 | !10 @10 #10 $10 %10 ^10 &10 0x10 0X10 10h 10H $f $F 'a 'a' input 8 | - - 10 16 2 - 10 16 16 - - 15 15 - - interpreter 9 | - - - - - - - - - - - - - - - >number 10 | 11 | -------------------------------------------------------------------------------- /test/test-num-prefixes.test64.ok: -------------------------------------------------------------------------------- 1 | 2 | obsoletion warning for old style &10 decimal prefix 3 | 4 | 5 | http://www.forth200x.org/tests/number-prefixes.fs 6 | 7 | !10 @10 #10 $10 %10 ^10 &10 0x10 0X10 10h 10H $f $F 'a 'a' input 8 | - - 10 16 2 - 10 16 16 - - 15 15 - - interpreter 9 | - - - - - - - - - - - - - - - >number 10 | 11 | -------------------------------------------------------------------------------- /test/test-num-prefixes2.4th: -------------------------------------------------------------------------------- 1 | cr .( http://www.forth200x.org/tests/number-prefixes2.fs ) cr 2 | 3 | include test/test-num-prefixes2.fs 4 | 5 | .S 6 | -------------------------------------------------------------------------------- /test/test-num-prefixes2.fs: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/test/test-num-prefixes2.fs -------------------------------------------------------------------------------- /test/test-num-prefixes2.test.ok: -------------------------------------------------------------------------------- 1 | 2 | http://www.forth200x.org/tests/number-prefixes2.fs 3 | 4 | #9. #9 -#9. -#9 #-9. #-9 $F. $F -$F. -$F $-F. $-F %1. %1 -%1. -%1 %-1. %-1 5 | 9 9 -9 -9 -9 -9 15 15 -15 -15 -15 -15 1 1 -1 -1 -1 -1 6 | 7 | -------------------------------------------------------------------------------- /test/test-num-prefixes2.test64.ok: -------------------------------------------------------------------------------- 1 | 2 | http://www.forth200x.org/tests/number-prefixes2.fs 3 | 4 | #9. #9 -#9. -#9 #-9. #-9 $F. $F -$F. -$F $-F. $-F %1. %1 -%1. -%1 %-1. %-1 5 | 9 9 -9 -9 -9 -9 15 15 -15 -15 -15 -15 1 1 -1 -1 -1 -1 6 | 7 | -------------------------------------------------------------------------------- /test/tester.fr: -------------------------------------------------------------------------------- 1 | \ (C) 1993 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY 2 | \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. 3 | \ VERSION 1.0 4 | HEX 5 | 6 | \ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY 7 | \ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG. 8 | VARIABLE VERBOSE 9 | FALSE VERBOSE ! 10 | 11 | : EMPTY-STACK \ ( ... -- ) EMPTY STACK. 12 | DEPTH ?DUP IF 0 DO DROP LOOP THEN ; 13 | 14 | : ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY 15 | \ THE LINE THAT HAD THE ERROR. 16 | TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR 17 | EMPTY-STACK \ THROW AWAY EVERY THING ELSE 18 | ; 19 | 20 | VARIABLE ACTUAL-DEPTH \ STACK RECORD 21 | CREATE ACTUAL-RESULTS 20 CELLS ALLOT 22 | 23 | : { \ ( -- ) SYNTACTIC SUGAR. 24 | ; 25 | 26 | : -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. 27 | DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH 28 | ?DUP IF \ IF THERE IS SOMETHING ON STACK 29 | 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM 30 | THEN ; 31 | 32 | : } \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED 33 | \ (ACTUAL) CONTENTS. 34 | DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH 35 | DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK 36 | 0 DO \ FOR EACH STACK ITEM 37 | ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED 38 | <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN 39 | LOOP 40 | THEN 41 | ELSE \ DEPTH MISMATCH 42 | S" WRONG NUMBER OF RESULTS: " ERROR 43 | THEN ; 44 | 45 | : TESTING \ ( -- ) TALKING COMMENT. 46 | SOURCE VERBOSE @ 47 | IF DUP >R TYPE CR R> >IN ! 48 | ELSE >IN ! DROP 49 | THEN ; 50 | -------------------------------------------------------------------------------- /test/tester.fs: -------------------------------------------------------------------------------- 1 | \ From: John Hayes S1I 2 | \ Subject: tester.fr 3 | \ Date: Mon, 27 Nov 95 13:10:09 PST 4 | 5 | \ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY 6 | \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. 7 | \ VERSION 1.1 8 | HEX 9 | 10 | \ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY 11 | \ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG. 12 | VARIABLE VERBOSE 13 | FALSE VERBOSE ! 14 | 15 | : EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO. 16 | DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ; 17 | 18 | : ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY 19 | \ THE LINE THAT HAD THE ERROR. 20 | TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR 21 | EMPTY-STACK \ THROW AWAY EVERY THING ELSE 22 | ; 23 | 24 | VARIABLE ACTUAL-DEPTH \ STACK RECORD 25 | CREATE ACTUAL-RESULTS 20 CELLS ALLOT 26 | 27 | : { \ ( -- ) SYNTACTIC SUGAR. 28 | ; 29 | 30 | : -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. 31 | DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH 32 | ?DUP IF \ IF THERE IS SOMETHING ON STACK 33 | 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM 34 | THEN ; 35 | 36 | : } \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED 37 | \ (ACTUAL) CONTENTS. 38 | DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH 39 | DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK 40 | 0 DO \ FOR EACH STACK ITEM 41 | ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED 42 | <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN 43 | LOOP 44 | THEN 45 | ELSE \ DEPTH MISMATCH 46 | S" WRONG NUMBER OF RESULTS: " ERROR 47 | THEN ; 48 | 49 | : TESTING \ ( -- ) TALKING COMMENT. 50 | SOURCE VERBOSE @ 51 | IF DUP >R TYPE CR R> >IN ! 52 | ELSE >IN ! DROP 53 | THEN ; 54 | -------------------------------------------------------------------------------- /test/tt.4th: -------------------------------------------------------------------------------- 1 | [UNDEFINED] [IFDEF] : [IFDEF] 2 | [COMPILE] [DEFINED] [COMPILE] [IF] ; IMMEDIATE 3 | [THEN] 4 | : page .clrscr ; 5 | include tt.fs 6 | tt 7 | bye 8 | -------------------------------------------------------------------------------- /test/wordsets.4th: -------------------------------------------------------------------------------- 1 | 2 | only forth definitions 3 | : WS CR BL WORD ." checking wordset " COUNT TYPE CR ; 4 | 5 | : ^ BL WORD 6 | FIND IF SPACE ASCII ^ EMIT 7 | ELSE CR SPACE COUNT TYPE SPACE ." missing" SPACE CR THEN 8 | ; 9 | 10 | include test/wordsets.fs 11 | -------------------------------------------------------------------------------- /test/wordsets.nomodules.ok: -------------------------------------------------------------------------------- 1 | 2 | checking wordset CORE 3 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 4 | checking wordset CORE-EXT 5 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 6 | checking wordset BLOCK 7 | ^ ^ ^ ^ ^ ^ ^ ^ 8 | checking wordset BLOCK-EXT 9 | ^ ^ ^ ^ ^ ^ 10 | checking wordset DOUBLE 11 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 12 | checking wordset DOUBLE-EXT 13 | ^ ^ 14 | checking wordset EXEPTION 15 | ^ ^ 16 | checking wordset EXEPTION-EXT 17 | ^ ^ 18 | checking wordset FACILITY 19 | ^ ^ ^ 20 | checking wordset FACILITY-EXT 21 | ^ ^ ^ ^ ^ ^ 22 | checking wordset FILE 23 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 24 | checking wordset FILE-EXT 25 | ^ ^ ^ ^no floating extensions 26 | checking wordset LOCAL 27 | ^ ^ 28 | checking wordset LOCAL-EXT 29 | ^ 30 | checking wordset MEMORY 31 | ^ ^ ^ 32 | checking wordset TOOLS 33 | ^ ^ ^ ^ ^ 34 | checking wordset TOOLS-EXT 35 | ^ ^ ^ ^ ^ ^ ^ 36 | EDITOR missing 37 | ^ ^ ^ ^ ^ 38 | checking wordset SEARCH 39 | ^ ^ ^ ^ ^ ^ ^ ^ ^ 40 | checking wordset SEARCH-EXT 41 | ^ ^ ^ ^ ^ 42 | checking wordset STRING 43 | ^ ^ ^ ^ ^ ^ ^ ^ -------------------------------------------------------------------------------- /test/wordsets.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | testcase="wordsets" 3 | 4 | echo " 5 | /checking .*/D 6 | / ^/D 7 | s/ CODE *missing // 8 | s/ ;CODE *missing // 9 | s/ ASSEMBLER *missing // 10 | s/ EDITOR *missing // 11 | s/ missing// 12 | p 13 | " >$testcase.sed 14 | 15 | sed -n -f $testcase.sed $* >$testcase.tmp 16 | cnt=`cat $testcase.tmp | wc -w` 17 | test "0" -eq "$cnt" || echo "$* : $cnt BAD lines" 18 | test "0" -eq "$cnt" 19 | exit 20 | 21 | 22 | -------------------------------------------------------------------------------- /test/wordsets.test.ok: -------------------------------------------------------------------------------- 1 | 2 | checking wordset CORE 3 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 4 | checking wordset CORE-EXT 5 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 6 | checking wordset BLOCK 7 | ^ ^ ^ ^ ^ ^ ^ ^ 8 | checking wordset BLOCK-EXT 9 | ^ ^ ^ ^ ^ ^ 10 | checking wordset DOUBLE 11 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 12 | checking wordset DOUBLE-EXT 13 | ^ ^ 14 | checking wordset EXEPTION 15 | ^ ^ 16 | checking wordset EXEPTION-EXT 17 | ^ ^ 18 | checking wordset FACILITY 19 | ^ ^ ^ 20 | checking wordset FACILITY-EXT 21 | ^ ^ ^ ^ ^ ^ 22 | checking wordset FILE 23 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 24 | checking wordset FILE-EXT 25 | ^ ^ ^ ^ 26 | checking wordset FLOATING 27 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 28 | checking wordset FLOATING-EXT 29 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 30 | checking wordset LOCAL 31 | ^ ^ 32 | checking wordset LOCAL-EXT 33 | ^ 34 | checking wordset MEMORY 35 | ^ ^ ^ 36 | checking wordset TOOLS 37 | ^ ^ ^ ^ ^ 38 | checking wordset TOOLS-EXT 39 | ^ ^ ^ ^ ^ ^ ^ 40 | EDITOR missing 41 | ^ ^ ^ ^ ^ 42 | checking wordset SEARCH 43 | ^ ^ ^ ^ ^ ^ ^ ^ ^ 44 | checking wordset SEARCH-EXT 45 | ^ ^ ^ ^ ^ 46 | checking wordset STRING 47 | ^ ^ ^ ^ ^ ^ ^ ^ -------------------------------------------------------------------------------- /testmodule1/COPYING.ZLIB: -------------------------------------------------------------------------------- 1 | 2 | THE ZLIB/LIBPNG LICENSE (copy from opensource.org) 3 | 4 | Copyright (c) 5 | 6 | This software is provided 'as-is', without any express 7 | or implied warranty. In no event will the authors be 8 | held liable for any damages arising from the use of this 9 | software. 10 | 11 | Permission is granted to anyone to use this software for 12 | any purpose, including commercial applications, and to 13 | alter it and redistribute it freely, subject to the 14 | following restrictions: 15 | 16 | 1. The origin of this software must not be 17 | misrepresented; you must not claim that you 18 | wrote the original software. If you use this 19 | software in a product, an acknowledgment in 20 | the product documentation would be 21 | appreciated but is not required. 22 | 23 | 2. Altered source versions must be plainly 24 | marked as such, and must not be 25 | misrepresented as being the original 26 | software. 27 | 28 | 3. This notice may not be removed or altered 29 | from any source distribution. 30 | 31 | -------------------------------------------------------------------------------- /testmodule1/Makefile.am: -------------------------------------------------------------------------------- 1 | AUTOMAKE_OPTIONS = 1.5 foreign dist-bzip2 2 | AUTOTOOL_VERSION = autoconf-2.52 automake-1.5 libtool-1.4.2 3 | ACLOCAL_AMFLAGS = -I ../uses 4 | 5 | pfedatadir = @pfedatadir@ 6 | pfedata_DATA = testmodule1.fs 7 | EXTRA_DIST = $(DATA) COPYING.ZLIB 8 | 9 | LIBS = @PFE_LIBS@ @LIBS@ 10 | CFLAGS = @PFE_CFLAGS@ @CFLAGS@ -I.. 11 | pfelibdir = @PFE_LIBDIR@ 12 | pfesuffix = @PFE_SUFFIX@ 13 | pfepluginsdir = ${pfelibdir}${pfesuffix} 14 | pfeplugins_LTLIBRARIES = testmodule1.la 15 | 16 | testmodule1_la_SOURCES = testmodule1-ext.c testmodule1-dll.c 17 | testmodule1_la_LDFLAGS = -module -avoid-version 18 | 19 | testmodule1-dll.c : @pfeincludedir@/pfe/module-dll.c 20 | sed -e s/module/testmodule1/ "$?" > $@ 21 | 22 | # because we had used pfe-uninstalled.sh to link to... 23 | # ... but this is not needed in an external module 24 | install-data-hook: 25 | mv $(DESTDIR)$(pfepluginsdir)/testmodule1.la \ 26 | $(DESTDIR)$(pfepluginsdir)/testmodule1.la.orig 27 | sed -e "s: -L/[^ ]*/.libs : :g" \ 28 | < $(DESTDIR)$(pfepluginsdir)/testmodule1.la.orig \ 29 | > $(DESTDIR)$(pfepluginsdir)/testmodule1.la 30 | - diff -u \ 31 | $(DESTDIR)$(pfepluginsdir)/testmodule1.la.orig \ 32 | $(DESTDIR)$(pfepluginsdir)/testmodule1.la 33 | rm $(DESTDIR)$(pfepluginsdir)/testmodule1.la.orig 34 | -------------------------------------------------------------------------------- /testmodule1/README: -------------------------------------------------------------------------------- 1 | Here is testmodule1. Here we did not add some bits to allow 2 | us to compile the testmodule within the pfe source tree. With 3 | some autoconf/automake knowledge it should be easy to pick up 4 | the sources and modify them to build it all outside of pfe. 5 | 6 | If instead you want to compile another module within pfe: 7 | - create a toplevel subdirectory in parallel to "testmodule1" 8 | - copy the files from "testmodule1" into that new subdirectory 9 | - modify toplevel configure.ac, somewhere near the end you 10 | need another ARG_WITH followed by the if...fi clause that 11 | implants your subdirectory into the build process. 12 | - modify toplevel Makefile.am only in the case that you want 13 | to store the complete sourcetree somewhere - add your new 14 | subdirectory to DIST_SUBDIRS and ACSUBDIRS 15 | - change into your new subdirectory and start modifying the 16 | testmodule example. Be sure to replace anything that is 17 | called "testmodule" of course. 18 | 19 | That's about it, the files in this subdirectory are given 20 | away under the ZLIB License. Basically, it requires that 21 | you change everything and that you take all liabilities. 22 | See the file COPYING.ZLIB for details. 23 | 24 | -------------------------------------------------------------------------------- /testmodule1/testmodule1-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(testmodule1); 5 | P4_MODULE_LIST (testmodule1); 6 | 7 | -------------------------------------------------------------------------------- /testmodule1/testmodule1-ext.c: -------------------------------------------------------------------------------- 1 | /** 2 | * an example module implementation (C) 2003 Guido U. Draheim 3 | * given away under the terms of the ZLIB License (see COPYING.ZLIB) 4 | * 5 | * after install, start up a `pfe` box, and type 6 | * needs testmodule-ext 7 | * hello 8 | */ 9 | 10 | #include 11 | 12 | /* The macro FCode creates the callframe info needed by C to be a forth prim */ 13 | static 14 | FCode (p4_hello) 15 | { 16 | p4_outs ("\nHello World!\n"); 17 | } 18 | 19 | /* the pfe export table binds FCode primitives (in C) to their forth name. 20 | * it carries other information as well interpreted at load-time of the module. 21 | */ 22 | P4_LISTWORDS(testmodule1) = 23 | { 24 | P4_INTO ("EXTENSIONS", 0), 25 | P4_FXco ("hello", p4_hello), 26 | }; 27 | P4_COUNTWORDS(testmodule1, "TESTMODULE1 - example module implementation"); 28 | 29 | /* emacs... 30 | * Local variables: 31 | * c-file-style: "stroustrup" 32 | * End: 33 | */ 34 | -------------------------------------------------------------------------------- /testmodule1/testmodule1.fs: -------------------------------------------------------------------------------- 1 | needs testmodule1-ext 2 | hello 3 | -------------------------------------------------------------------------------- /testmodule2/COPYING.ZLIB: -------------------------------------------------------------------------------- 1 | 2 | THE ZLIB/LIBPNG LICENSE (copy from opensource.org) 3 | 4 | Copyright (c) 5 | 6 | This software is provided 'as-is', without any express 7 | or implied warranty. In no event will the authors be 8 | held liable for any damages arising from the use of this 9 | software. 10 | 11 | Permission is granted to anyone to use this software for 12 | any purpose, including commercial applications, and to 13 | alter it and redistribute it freely, subject to the 14 | following restrictions: 15 | 16 | 1. The origin of this software must not be 17 | misrepresented; you must not claim that you 18 | wrote the original software. If you use this 19 | software in a product, an acknowledgment in 20 | the product documentation would be 21 | appreciated but is not required. 22 | 23 | 2. Altered source versions must be plainly 24 | marked as such, and must not be 25 | misrepresented as being the original 26 | software. 27 | 28 | 3. This notice may not be removed or altered 29 | from any source distribution. 30 | 31 | -------------------------------------------------------------------------------- /testmodule2/configure.ac: -------------------------------------------------------------------------------- 1 | dnl use `aclocal && autoconf` to compile this script correctly into "configure" 2 | dnl and remember to run `libtoolize --force --copy` to get the libtoo files. 3 | dnl btw, the first few lines are mandatory, modify name/version, always!!! 4 | 5 | AC_INIT(testmodule2-ext.c,testmodule2,0.2.0) 6 | AC_CONFIG_AUX_DIR([../uses]) 7 | AC_PROG_CC 8 | AM_PROG_LIBTOOL 9 | AC_PROG_INSTALL 10 | 11 | PKG_CONFIG_PATH="$PKG_CONFIG_PATH:../pfe" ; export PKG_CONFIG_PATH 12 | PKG_CHECK_MODULES(PFE,[pfe > 0.33.10],,[ 13 | PKG_CONFIG="$SHELL ../pfe/pfe-uninstalled.sh" 14 | AC_MSG_RESULT(fallback for pkg-config... $PKG_CONFIG) 15 | PFE_CFLAGS=`$PKG_CONFIG --cflags` 16 | PFE_LIBS=`$PKG_CONFIG --libs` ]) 17 | 18 | PFE_VERSION=`${PKG_CONFIG} pfe --modversion` 19 | PFE_INCLUDEDIR=`${PKG_CONFIG} pfe --variable=includedir` 20 | PFE_DATADIR=`${PKG_CONFIG} pfe --variable=prefix`/share/pfe 21 | PFE_LIBDIR=`${PKG_CONFIG} pfe --variable=libdir`/pfe 22 | PFE_SUFFIX=`${PKG_CONFIG} pfe --variable=suffix` 23 | test -n "$pfemoduleslibdir" && PFE_LIBDIR="$pfemoduleslibdir/pfe" 24 | AC_SUBST([PFE_VERSION]) 25 | AC_SUBST([PFE_INCLUDEDIR]) 26 | AC_SUBST([PFE_DATADIR]) 27 | AC_SUBST([PFE_LIBDIR]) 28 | AC_SUBST([PFE_SUFFIX]) 29 | AC_MSG_RESULT([installs into... $PFE_LIBDIR$PFE_SUFFIX]) 30 | 31 | AC_OUTPUT(Makefile) 32 | -------------------------------------------------------------------------------- /testmodule2/testmodule2-dll.c: -------------------------------------------------------------------------------- 1 | #define _P4_SOURCE 1 2 | #define MODULE 3 | #include 4 | extern const p4Words P4WORDS(testmodule2); 5 | P4_MODULE_LIST (testmodule2); 6 | 7 | -------------------------------------------------------------------------------- /testmodule2/testmodule2-ext.c: -------------------------------------------------------------------------------- 1 | /** 2 | * an example module implementation (C) 2003 Guido U. Draheim 3 | * given away under the terms of the ZLIB License (see COPYING.ZLIB) 4 | * 5 | * after install, start up a `pfe` box, and type 6 | * needs testmodule-ext 7 | * hello 8 | */ 9 | 10 | #include 11 | 12 | /* The macro FCode creates the callframe info needed by C to be a forth prim */ 13 | static 14 | FCode (p4_hello) 15 | { 16 | p4_outs ("\nHello World!\n"); 17 | } 18 | 19 | /* the pfe export table binds FCode primitives (in C) to their forth name. 20 | * it carries other information as well interpreted at load-time of the module. 21 | */ 22 | P4_LISTWORDS(testmodule2) = 23 | { 24 | P4_INTO ("EXTENSIONS", 0), 25 | P4_FXco ("hello", p4_hello), 26 | }; 27 | P4_COUNTWORDS(testmodule2, "TESTMODULE2 - example module implementation"); 28 | 29 | /* emacs... 30 | * Local variables: 31 | * c-file-style: "stroustrup" 32 | * End: 33 | */ 34 | -------------------------------------------------------------------------------- /testmodule2/testmodule2.fs: -------------------------------------------------------------------------------- 1 | needs testmodule1-ext 2 | hello 3 | -------------------------------------------------------------------------------- /uses/ac_c_long_long_.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/guidod/ac_c_long_long_.m4 2 | dnl @synopsis AC_C_LONG_LONG 3 | dnl 4 | dnl Provides a test for the existance of the long long int type and 5 | dnl defines HAVE_LONG_LONG if it is found. 6 | dnl 7 | dnl change: add a comment for the ac_define 8 | dnl 9 | dnl @category C 10 | dnl @author Caolan McNamara 11 | dnl @version 2001-05-03 12 | dnl @license AllPermissive 13 | 14 | AC_DEFUN([AC_C_LONG_LONG_], 15 | [AC_CACHE_CHECK(for long long int, ac_cv_c_long_long, 16 | [if test "$GCC" = yes; then 17 | ac_cv_c_long_long=yes 18 | else 19 | AC_TRY_COMPILE(,[long long int i;], 20 | ac_cv_c_long_long=yes, 21 | ac_cv_c_long_long=no) 22 | fi]) 23 | if test $ac_cv_c_long_long = yes; then 24 | AC_DEFINE(HAVE_LONG_LONG, 1, [compiler understands long long]) 25 | fi 26 | ]) 27 | 28 | -------------------------------------------------------------------------------- /uses/ac_define_dir_.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/guidod/ac_define_dir_.m4 2 | dnl @synopsis AC_DEFINE_DIR_(VARNAME, DIR [, DESCRIPTION]) 3 | dnl 4 | dnl @obsoleted Use AC_DEFINE_DIR instead. 5 | dnl 6 | dnl This macro _AC_DEFINEs VARNAME to the expansion of the DIR 7 | dnl variable, taking care of fixing up ${prefix} and such. 8 | dnl 9 | dnl Note that the 3 argument form is only supported with autoconf 2.13 10 | dnl and later (i.e. only where _AC_DEFINE supports 3 arguments). 11 | dnl 12 | dnl Examples: 13 | dnl 14 | dnl AC_DEFINE_DIR_(DATADIR, datadir) 15 | dnl AC_DEFINE_DIR_(PROG_PATH, bindir, [Location of installed binaries]) 16 | dnl 17 | dnl This macro is based on Alexandre Oliva's AC_DEFINE_DIR. 18 | dnl 19 | dnl @category Obsolete 20 | dnl @author Guido U. Draheim 21 | dnl @version 2005-08-01 22 | dnl @license GPLWithACException 23 | 24 | AC_DEFUN([AC_DEFINE_DIR_], [ 25 | test "x$prefix" = xNONE && prefix="$ac_default_prefix" 26 | test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' 27 | ac_define_dir=`eval "echo [$]$2"` 28 | ac_define_dir=`eval "echo [$]ac_define_dir"` 29 | ifelse($3, ,dnl 30 | AC_DEFINE_UNQUOTED($1, "$ac_define_dir"),dnl 31 | AC_DEFINE_UNQUOTED($1, "$ac_define_dir", $3)) 32 | ]) 33 | 34 | -------------------------------------------------------------------------------- /uses/ac_define_path_style.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/guidod/ac_define_path_style.m4 2 | dnl @synopsis AC_DEFINE_PATH_STYLE ([defvar-name]) 3 | dnl 4 | dnl _AC_DEFINE(PATH_STYLE) describing the filesys interface. The value 5 | dnl is numeric, where the basetype is encoded as 16 = dos/win, 32 = 6 | dnl unix, 64 = url/www, 0 = other 7 | dnl 8 | dnl note that there could be a combination of the values that should 9 | dnl lead you to accept multiple forms of PATH_SEP and DIR_SEP 10 | dnl 11 | dnl @category Misc 12 | dnl @author Guido U. Draheim 13 | dnl @version 2001-05-03 14 | dnl @license GPLWithACException 15 | 16 | AC_DEFUN([AC_DEFINE_PATH_STYLE], [ 17 | AC_CACHE_CHECK([for path style], ac_cv_path_style, 18 | [ 19 | if test -z "$ac_cv_path_style"; then 20 | case "$target_os" in 21 | *djgpp | *mingw32* | *emx*) ac_cv_path_style="dos" ;; 22 | *) ac_cv_path_style="unix" ;; # it is just the default ;-) 23 | esac 24 | if test "$ac_cv_path_style" = "unix" ; then 25 | _exec_prefix=`eval "echo $exec_prefix"` 26 | _exec_prefix=`eval "echo $_exec_prefix"` 27 | case "$_exec_prefix" in 28 | *:*) ac_cv_path_style="url" ;; 29 | *\\) ac_cv_path_style="dos" ;; 30 | esac 31 | fi 32 | fi 33 | ]) 34 | case "$ac_cv_path_style" in 35 | *dos*) ac_define_path_style=16 ;; 36 | *unix*) ac_define_path_style=32 ;; 37 | *url*) ac_define_path_style=64 ;; 38 | *mac*) ac_define_path_style=128 ;; 39 | *) ac_define_path_style=1 40 | esac 41 | AC_DEFINE_UNQUOTED(PATH_STYLE,$ac_define_path_style,dnl 42 | [path style 16=dos 32=unix 64=url 128=mac])dnl 43 | ]) 44 | 45 | -------------------------------------------------------------------------------- /uses/ac_func_snprintf.m4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gdraheim/pfe/88a3e321a6ad663dfc484ec157aad7e2fa467f94/uses/ac_func_snprintf.m4 -------------------------------------------------------------------------------- /uses/ac_spec_package_version.m4: -------------------------------------------------------------------------------- 1 | dnl @synopsis AC_SPEC_PACKAGE_VERSION(rpmspecfile) 2 | dnl 3 | dnl @obsoleted Use AX_SPEC_PACKAGE_VERSION. 4 | dnl 5 | dnl set PACKAGE and VERSION from the defines in the given specfile 6 | dnl default to basename and currentde if rpmspecfile is not found 7 | dnl 8 | dnl @category Obsolete 9 | dnl @author Guido U. Draheim 10 | dnl @version 2005-01-25 11 | dnl @license GPLWithACException 12 | 13 | AC_DEFUN([AC_SPEC_PACKAGE_VERSION],[dnl 14 | pushdef([specfile], ac_spec_package_version_file) 15 | specfile=`basename $1` 16 | AC_MSG_CHECKING( $specfile package version) 17 | if test -z "$1"; then 18 | AC_MSG_ERROR( no rpm spec file given ) 19 | else 20 | # find specfile 21 | for i in $1 $srcdir/$1 $srcdir/../$1 ; do 22 | if test -f "$i" ; then 23 | specfile="$i" 24 | break 25 | fi 26 | done 27 | if test ! -f $specfile ; then 28 | k="w/o spec" 29 | else 30 | if test -z "$PACKAGE" ; then 31 | i=`grep -i '^name:' $specfile | head -1 | sed -e 's/.*://'` 32 | PACKAGE=`echo $i | sed -e 's/ /-/'` 33 | fi 34 | if test -z "$VERSION" ; then 35 | i=`grep -i '^version:' $specfile | head -1 | sed -e 's/.*://'` 36 | VERSION=`echo $i | sed -e 's/ /-/'` 37 | fi 38 | fi 39 | if test -z "$PACKAGE" ; then 40 | PACKAGE=`basename $specfile .spec` 41 | fi 42 | if test -z "$VERSION" ; then 43 | VERSION=`date +%Y.%m.%d` 44 | fi 45 | AC_MSG_RESULT( $PACKAGE $VERSION $k ) 46 | fi 47 | ]) 48 | -------------------------------------------------------------------------------- /uses/ac_sys_largefile_sensitive.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/guidod/ac_sys_largefile_sensitive.m4 2 | dnl @synopsis AC_SYS_LARGEFILE_SENSITIVE 3 | dnl 4 | dnl checker whether the current system is sensitive to -Ddefines making 5 | dnl off_t having different types/sizes. Automatically define a config.h 6 | dnl symbol LARGEFILE_SENSITIVE if that is the case, otherwise leave 7 | dnl everything as is. 8 | dnl 9 | dnl This macro builds on top of AC_SYS_LARGEFILE to detect whether 10 | dnl special options are neede to make the code use 64bit off_t - in 11 | dnl many setups this will also make the code use 64bit off_t 12 | dnl immediatly. 13 | dnl 14 | dnl The common use of a LARGEFILE_SENSITIVE config.h-define is to 15 | dnl rename exported functions, usually adding a 64 to the original 16 | dnl function name. Such renamings are only needed on systems being both 17 | dnl (a) 32bit off_t by default and (b) implementing large.file 18 | dnl extensions (as for unix98). 19 | dnl 20 | dnl a renaming section could look like this: 21 | dnl 22 | dnl #if defined LARGEFILE_SENSITIVE && _FILE_OFFSET_BITS+0 == 64 23 | dnl #define zzip_open zzip_open64 24 | dnl #define zzip_seek zzip_seek64 25 | dnl #endif 26 | dnl 27 | dnl for libraries, it is best to take advantage of the prefix-config.h 28 | dnl macro, otherwise you want to export a renamed LARGEFILE_SENSITIVE 29 | dnl in an installed header file. -> see AX_PREFIX_CONFIG_H 30 | dnl 31 | dnl @category Misc 32 | dnl @author Guido U. Draheim 33 | dnl @version 2003-02-02 34 | dnl @license GPLWithACException 35 | 36 | AC_DEFUN([AC_SYS_LARGEFILE_SENSITIVE],[dnl 37 | AC_REQUIRE([AC_SYS_LARGEFILE])dnl 38 | # we know about some internals of ac_sys_largefile here... 39 | AC_MSG_CHECKING(whether system differentiates 64bit off_t by defines) 40 | ac_cv_sys_largefile_sensitive="no" 41 | if test ".$ac_cv_sys_file_offset_bits$ac_cv_sys_large_files" != ".nono" 42 | then ac_cv_sys_largefile_sensitive="yes" 43 | AC_DEFINE(LARGEFILE_SENSITIVE, 1, 44 | [whether the system defaults to 32bit off_t but can do 64bit when requested]) 45 | fi 46 | AC_MSG_RESULT([$ac_cv_sys_largefile_sensitive]) 47 | ]) 48 | 49 | -------------------------------------------------------------------------------- /uses/acx_restrict.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/ac-archive/acx_restrict.m4 2 | dnl @synopsis ACX_C_RESTRICT 3 | dnl 4 | dnl @obsoleted Replaced by AC_C_RESTRICT in Autoconf 2.58 5 | dnl 6 | dnl This macro determines whether the C compiler supports the 7 | dnl "restrict" keyword introduced in ANSI C99, or an equivalent. Does 8 | dnl nothing if the compiler accepts the keyword. Otherwise, if the 9 | dnl compiler supports an equivalent (like gcc's __restrict__) defines 10 | dnl "restrict" to be that. Otherwise, defines "restrict" to be empty. 11 | dnl 12 | dnl @category Obsolete 13 | dnl @author Steven G. Johnson 14 | dnl @version 2005-05-31 15 | dnl @license GPLWithACException 16 | 17 | AC_DEFUN([ACX_C_RESTRICT], 18 | [AC_CACHE_CHECK([for C restrict keyword], acx_cv_c_restrict, 19 | [acx_cv_c_restrict=unsupported 20 | AC_LANG_SAVE 21 | AC_LANG_C 22 | # Try the official restrict keyword, then gcc's __restrict__, then 23 | # SGI's __restrict. __restrict has slightly different semantics than 24 | # restrict (it's a bit stronger, in that __restrict pointers can't 25 | # overlap even with non __restrict pointers), but I think it should be 26 | # okay under the circumstances where restrict is normally used. 27 | for acx_kw in restrict __restrict__ __restrict; do 28 | AC_TRY_COMPILE([], [float * $acx_kw x;], [acx_cv_c_restrict=$acx_kw; break]) 29 | done 30 | AC_LANG_RESTORE 31 | ]) 32 | if test "$acx_cv_c_restrict" != "restrict"; then 33 | acx_kw="$acx_cv_c_restrict" 34 | if test "$acx_kw" = unsupported; then acx_kw=""; fi 35 | AC_DEFINE_UNQUOTED(restrict, $acx_kw, [Define to equivalent of C99 restrict keyword, or to nothing if this is not supported. Do not define if restrict is supported directly.]) 36 | fi 37 | ]) 38 | 39 | -------------------------------------------------------------------------------- /uses/ax_check_define.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/ac-archive/ax_check_define.m4 2 | dnl @synopsis AC_CHECK_DEFINE([symbol], [ACTION-IF-FOUND], [ACTION-IF-NOT]) 3 | dnl @synopsis AX_CHECK_DEFINE([includes],[symbol], [ACTION-IF-FOUND], [ACTION-IF-NOT]) 4 | dnl 5 | dnl complements AC_CHECK_FUNC but it does not check for a function but 6 | dnl for a define to exist. Consider a usage like 7 | dnl AC_CHECK_DEFINE(__STRICT_ANSI__, CFLAGS="$CFLAGS 8 | dnl -D_XOPEN_SOURCE=500") 9 | dnl 10 | dnl @category Misc 11 | dnl @author Guido U. Draheim 12 | dnl @version 2006-10-13 13 | dnl @license GPLWithACException 14 | 15 | AC_DEFUN([AC_CHECK_DEFINED],[ 16 | AS_VAR_PUSHDEF([ac_var],[ac_cv_defined_$1])dnl 17 | AC_CACHE_CHECK([for $1 defined], ac_var, 18 | AC_TRY_COMPILE(,[ 19 | #ifdef $1 20 | int ok; 21 | #else 22 | choke me 23 | #endif 24 | ],AS_VAR_SET(ac_var, yes),AS_VAR_SET(ac_var, no))) 25 | AS_IF([test AS_VAR_GET(ac_var) != "no"], [$2], [$3])dnl 26 | AS_VAR_POPDEF([ac_var])dnl 27 | ]) 28 | 29 | AC_DEFUN([AX_CHECK_DEFINED],[ 30 | AS_VAR_PUSHDEF([ac_var],[ac_cv_defined_$2])dnl 31 | AC_CACHE_CHECK([for $1 defined], ac_var, 32 | AC_TRY_COMPILE($1,[ 33 | #ifndef $2 34 | int ok; 35 | #else 36 | choke me 37 | #endif 38 | ],AS_VAR_SET(ac_var, yes),AS_VAR_SET(ac_var, no))) 39 | AS_IF([test AS_VAR_GET(ac_var) != "no"], [$3], [$4])dnl 40 | AS_VAR_POPDEF([ac_var])dnl 41 | ]) 42 | 43 | AC_DEFUN([AX_CHECK_FUNC], 44 | [AS_VAR_PUSHDEF([ac_var], [ac_cv_func_$2])dnl 45 | AC_CACHE_CHECK([for $2], ac_var, 46 | dnl AC_LANG_FUNC_LINK_TRY 47 | [AC_LINK_IFELSE([AC_LANG_PROGRAM([$1 48 | #undef $2 49 | char $2 ();],[ 50 | char (*f) () = $2; 51 | return f != $2; ])], 52 | [AS_VAR_SET(ac_var, yes)], 53 | [AS_VAR_SET(ac_var, no)])]) 54 | AS_IF([test AS_VAR_GET(ac_var) = yes], [$3], [$4])dnl 55 | AS_VAR_POPDEF([ac_var])dnl 56 | ])# AC_CHECK_FUNC 57 | 58 | -------------------------------------------------------------------------------- /uses/ax_check_gnu_dladdr.m4: -------------------------------------------------------------------------------- 1 | dnl @synopsis AX_CHECK_GNU_DLADDR 2 | dnl 3 | dnl Check if this system has a dladdr in dlfcn.h which is atleast 4 | dnl the case for gnuish systems. Define HAVE_GNU_DLADDR if yes. 5 | dnl 6 | dnl @author Guiod U. Draheim 7 | dnl @version 2002 8 | dnl @category C 9 | 10 | AC_DEFUN([AX_CHECK_GNU_DLADDR],[ 11 | AC_MSG_CHECKING(for gnu dladdr) 12 | AC_TRY_COMPILE( 13 | [ 14 | #ifndef _GNU_SOURCE 15 | #define _GNU_SOURCE 1 16 | #endif 17 | #include 18 | ],[ 19 | Dl_info* info = 0; 20 | dladdr(0, info); 21 | ],[ 22 | AC_DEFINE([HAVE_GNU_DLADDR],[1],[gnuish system might have a dladdr in dlfcn.h]) 23 | AC_MSG_RESULT(yes) 24 | ],[ 25 | AC_MSG_RESULT(no) 26 | ]) 27 | ]) 28 | -------------------------------------------------------------------------------- /uses/ax_check_tls_support.m4: -------------------------------------------------------------------------------- 1 | dnl @synopsis AX_CHECK_TLS_SUPPORT 2 | dnl 3 | dnl Check whether operating system is assumed to support tls registers. 4 | dnl The compiler will allow for the __thread keyword to assemble global 5 | dnl variables into a per-thread stack block. That data block must be 6 | dnl declared specifically in a binary / shared library export table to 7 | dnl be copied on thread creation. - Defiens HAVE_TLS_SUPPORT if yes. 8 | dnl 9 | dnl Implementation note: we do currently just check the compiler version 10 | dnl of a compiler/platform combination that is known to be good. There 11 | dnl is no generic check at the moment. Someone? 12 | dnl 13 | dnl @author Guido U. Draheim 14 | dnl @version 2005 15 | dnl @category C 16 | 17 | AC_DEFUN([AX_CHECK_TLS_SUPPORT],[ 18 | AC_MSG_CHECKING(tls support) 19 | AC_CACHE_VAL([ac_cv_have_tls_support],[ 20 | case "$GCC_VERSION,$host" in 21 | 2.*,*) ac_cv_have_tls_support="no" ;; 22 | 3.0,*) ac_cv_have_tls_support="no" ;; 23 | 3.*,*linux*) ac_cv_have_tls_suport="yes" ;; 24 | *) ac_cv_have_tls_support="unkown (no)" ;; 25 | esac]) 26 | AC_MSG_RESULT([$ac_cv_tls_support]) 27 | if test ".$ac_cv_have_tls_support" = ".yes" ; then 28 | AC_DEFINE([HAVE_TLS_SUPPORT], [1], 29 | [whether operating system is assumed to support tls registers]) 30 | fi 31 | ]) 32 | -------------------------------------------------------------------------------- /uses/ax_configure_args.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/guidod/ax_configure_args.m4 2 | dnl @synopsis AX_CONFIGURE_ARGS 3 | dnl 4 | dnl Helper macro for AX_ENABLE_BUILDDIR and AX_ENABLE_BUILDDIR_UNAME 5 | dnl 6 | dnl The traditional way of starting a subdir-configure is running the 7 | dnl script with ${1+"$@"} but since autoconf 2.60 this is broken. 8 | dnl Instead we have to rely on eval'ing $ac_configure_args however 9 | dnl some old autoconf versions do not provide that. To ensure maximum 10 | dnl portability of autoconf extension macros this helper can be 11 | dnl AC_REQUIRE'd so that $ac_configure_args will alsways be present. 12 | dnl 13 | dnl Sadly, the traditional "exec $SHELL" of the enable_builddir macros 14 | dnl is spoiled now and must be replaced by eval + exit $? 15 | dnl 16 | dnl example: 17 | dnl AC_DEFUN([AX_ENABLE_SUBDIR],[dnl 18 | dnl AC_REQUIRE([AX_CONFIGURE_ARGS])dnl 19 | dnl eval $SHELL $ac_configure_args || exit $? 20 | dnl ...]) 21 | dnl 22 | dnl @category Misc 23 | dnl @author Guido Draheim 24 | dnl @version 2007-02-01 25 | dnl @license GPLWithACException 26 | 27 | AC_DEFUN([AX_CONFIGURE_ARGS],[ 28 | # [$]@ is unsable in 2.60+ but earlier autoconf had no ac_configure_args 29 | if test "${ac_configure_args+set}" != "set" ; then 30 | ac_configure_args= 31 | for ac_arg in ${1+"[$]@"}; do 32 | ac_configure_args="$ac_configure_args '$ac_arg'" 33 | done 34 | fi 35 | ]) 36 | 37 | -------------------------------------------------------------------------------- /uses/ax_expand_prefix.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/guidod/ax_expand_prefix.m4 2 | dnl @synopsis AX_EXPAND_PREFIX 3 | dnl 4 | dnl when $prefix and $exec_prefix are still set to NONE then set them 5 | dnl to the usual default values - being based on $ac_default_prefix. - 6 | dnl this macro can be AC_REQUIREd by other macros that need to compute 7 | dnl values for installation directories. It has been observed that it 8 | dnl was done wrong over and over again, so this is a bit more safe to 9 | dnl do. 10 | dnl 11 | dnl remember - setting exec_prefix='${prefix}' needs you interpolate 12 | dnl directories multiple times, it is not sufficient to just say 13 | dnl MYVAR="${datadir}/putter" but you do have to run `eval` a few 14 | dnl times, sth. like MYVAR=`eval "echo \"$MYVAR\""` done atleast two 15 | dnl times. 16 | dnl 17 | dnl The implementation of this macro simply picks up the lines that 18 | dnl would be run at the start of AC_OUTPUT anyway to set the 19 | dnl prefix/exec_prefix defaults. Between AC_INIT and the first command 20 | dnl to AC_REQUIRE this macro you can set the two variables to something 21 | dnl explicit instead. Probably, any command to compute installation 22 | dnl directories should be run _after_ AM_INIT_AUTOMAKE 23 | dnl 24 | dnl @category Misc 25 | dnl @author Guido U. Draheim 26 | dnl @version 2005-01-21 27 | dnl @license GPLWithACException 28 | 29 | AC_DEFUN([AX_EXPAND_PREFIX],[dnl 30 | # The prefix default can be set in configure.ac (otherwise it is /usr/local) 31 | test "x$prefix" = xNONE && prefix=$ac_default_prefix 32 | # Let make expand exec_prefix. Allows to override the makevar 'prefix' later 33 | test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' 34 | ]) 35 | 36 | -------------------------------------------------------------------------------- /uses/ltversion.m4: -------------------------------------------------------------------------------- 1 | # ltversion.m4 -- version numbers -*- Autoconf -*- 2 | # 3 | # Copyright (C) 2004, 2011-2015 Free Software Foundation, Inc. 4 | # Written by Scott James Remnant, 2004 5 | # 6 | # This file is free software; the Free Software Foundation gives 7 | # unlimited permission to copy and/or distribute it, with or without 8 | # modifications, as long as this notice is preserved. 9 | 10 | # @configure_input@ 11 | 12 | # serial 4179 ltversion.m4 13 | # This file is part of GNU Libtool 14 | 15 | m4_define([LT_PACKAGE_VERSION], [2.4.6]) 16 | m4_define([LT_PACKAGE_REVISION], [2.4.6]) 17 | 18 | AC_DEFUN([LTVERSION_VERSION], 19 | [macro_version='2.4.6' 20 | macro_revision='2.4.6' 21 | _LT_DECL(, macro_version, 0, [Which release of libtool.m4 was used?]) 22 | _LT_DECL(, macro_revision, 0) 23 | ]) 24 | -------------------------------------------------------------------------------- /uses/mkbins.cmd: -------------------------------------------------------------------------------- 1 | @echo off 2 | 3 | rem Batch file to compile pfe with EMX and Watcom C on OS/2 4 | rem Builds directory bin. 5 | 6 | set emxdir=E:\EMX 7 | set watdir=D:\WATCOM 8 | 9 | rm -rf bin 10 | md bin 11 | 12 | rem EMX binaries 13 | rem ------------ 14 | 15 | cd src 16 | make clean 17 | bash config.sh EMX 18 | make all 19 | cd .. 20 | md bin\EMX 21 | copy src\config.h bin\EMX 22 | copy src\Makefile bin\EMX 23 | copy src\*.exe bin\EMX 24 | copy %emxdir%\bin\emx.exe bin\EMX 25 | copy %emxdir%\dll\emx.dll bin\EMX 26 | 27 | rem Help files assuming prefix=c:\ 28 | rem ------------------------------ 29 | 30 | c: 31 | rm -rf /pfe 32 | md \lib 33 | md \lib\pfe 34 | md \lib\pfe\help 35 | cd \lib\pfe\help 36 | copy e:help\*.hlp 37 | bash -c "e:bin/EMX/helpidx -o index *.hlp" 38 | copy index e:bin\EMX 39 | e: 40 | 41 | 42 | rem Watcom binaries 43 | rem --------------- 44 | 45 | cd src 46 | make clean 47 | set TARGET=OS2V2 48 | bash config.sh WATCOM 49 | make TARGET=OS2V2 pfe.exe 50 | cd .. 51 | md bin\WC_OS2V2 52 | copy src\config.h bin\WC_OS2V2 53 | copy src\config.h src\config\WATCOM 54 | copy src\Makefile bin\WC_OS2V2 55 | copy src\pfe.exe bin\WC_OS2V2 56 | 57 | cd src 58 | make clean 59 | set TARGET=DOS4G 60 | bash config.sh WATCOM 61 | make TARGET=DOS4G pfe.exe 62 | cd .. 63 | md bin\WC_DOS4G 64 | copy src\config.h bin\WC_DOS4G 65 | del src\config\WATCOM\config.h 66 | copy src\Makefile bin\WC_DOS4G 67 | copy src\pfe.exe bin\WC_DOS4G 68 | copy %watdir%\bin\dos4gw.exe bin\WC_DOS4G 69 | -------------------------------------------------------------------------------- /uses/patch_libtool_on_darwin_pass_all.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/guidod/patch_libtool_on_darwin_pass_all.m4 2 | dnl @synopsis PATCH_LIBTOOL_ON_DARWIN_PASS_ALL 3 | dnl 4 | dnl libtool 1.4.x on darwin uses a lib_check with a file_magic that 5 | dnl tests for "Mach-O dynamically linked shared library". However, this 6 | dnl is the file_magic for ".dylib" sharedlibraries but not for ".so" 7 | dnl sharedlibraries. They have another "file -L" result of "Mach-O 8 | dnl bundle ppc", which has an annoying result: when a a module (a .so) 9 | dnl is dependent on another module (another .so) then libtool will 10 | dnl error out and say that the import-module was not found where in 11 | dnl fact it is available. It does not even try to call the real linker. 12 | dnl 13 | dnl Later libtool generations have changed the processing, the import 14 | dnl file_check has been changed from "file_magic" to "pass_all". This 15 | dnl ac-macro does a similar thing: it checks for the darwin host, it 16 | dnl checks for the check_method, and when it was not "pass_all" then we 17 | dnl set it to "deplibs_check_method=pass_all" 18 | dnl 19 | dnl @category Misc 20 | dnl @author Guido U. Draheim 21 | dnl @version 2005-01-21 22 | dnl @license GPLWithACException 23 | 24 | AC_DEFUN([PATCH_LIBTOOL_ON_DARWIN_PASS_ALL], 25 | [# libtool-1.4 specific, on darwin set deplibs_check_method=pass_all 26 | case "$host_os" in 27 | darwin*) 28 | if grep "^deplibs_check_method=.*file_magic" libtool >/dev/null ; then 29 | AC_MSG_RESULT(patching libtool to set deplibs_check_method=pass_all) 30 | test -f libtool.old || (mv libtool libtool.old && cp libtool.old libtool) 31 | sed -e '/^deplibs_check_method=/s/=.*/="pass_all"/' libtool >libtool.new 32 | (test -s libtool.new || rm libtool.new) 2>/dev/null 33 | test -f libtool.new && mv libtool.new libtool # not 2>/dev/null !! 34 | test -f libtool || mv libtool.old libtool 35 | fi 36 | ;; 37 | esac 38 | ]) 39 | 40 | -------------------------------------------------------------------------------- /uses/patch_libtool_on_darwin_zsh_overquoting.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/guidod/patch_libtool_on_darwin_zsh_overquoting.m4 2 | dnl @synopsis PATCH_LIBTOOL_ON_DARWIN_ZSH_OVERQUOTING 3 | dnl 4 | dnl libtool 1.4.x has a bug on darwin where the "zsh" is installed as 5 | dnl the bourne shell replacement. Of course, the zsh is called in a 6 | dnl compatibility mode but there is a common problem with it, probably 7 | dnl a bug of zsh. Newer darwin systems have a "bash" installed now, but 8 | dnl the configure-default will be "zsh" in most systems still. 9 | dnl 10 | dnl The bug revelas itself as an overquoted statement in the libtool 11 | dnl cmds-spec for sharedlib creation on testing for "module" builds. 12 | dnl Later libtool has gone rid of it by simply removing the quotes at 13 | dnl that point . Here we maintain the original style and simply remove 14 | dnl the extra escape character, i.e. we look for "archive_cmds" and 15 | dnl replace a sequence of triple-backslash-and-doublequote with 16 | dnl single-backslash-and-doublequote. 17 | dnl 18 | dnl @category Misc 19 | dnl @author Guido U. Draheim 20 | dnl @version 2003-03-23 21 | dnl @license GPLWithACException 22 | 23 | AC_DEFUN([PATCH_LIBTOOL_ON_DARWIN_ZSH_OVERQUOTING], 24 | [# libtool-1.4 specific, on zsh target the final requoting does one too much 25 | case "$host_os" in 26 | darwin*) 27 | if grep "1.92" libtool >/dev/null ; then 28 | AC_MSG_RESULT(patching libtool on .so-sharedlib creation (zsh overquoting)) 29 | test -f libtool.old || (mv libtool libtool.old && cp libtool.old libtool) 30 | sed -e '/archive_cmds=/s:[[\\]][[\\]][[\\]]*":\\":g' libtool >libtool.new 31 | (test -s libtool.new || rm libtool.new) 2>/dev/null 32 | test -f libtool.new && mv libtool.new libtool # not 2>/dev/null !! 33 | test -f libtool || mv libtool.old libtool 34 | fi 35 | ;; 36 | esac 37 | ]) 38 | 39 | -------------------------------------------------------------------------------- /uses/patch_libtool_sys_lib_search_path_spec.m4: -------------------------------------------------------------------------------- 1 | dnl /usr/share/aclocal/guidod/patch_libtool_sys_lib_search_path_spec.m4 2 | dnl ______ /usr/share/aclocal/guidod-cvs/patch_libtool_sys_lib_search_path_spec.m4 ______ 3 | dnl @synopsis PATCH_LIBTOOL_SYS_LIB_SEARCH_PATH_SPEC 4 | dnl 5 | dnl Cross-compiling to win32 from a unix system reveals a bug - the 6 | dnl path-separator has been set to ";" depending on the target system. 7 | dnl However, the crossgcc search_path_spec works in a unix-environment 8 | dnl with unix-style directories and unix-stylish path_separator. The 9 | dnl result: the search_path_spec is a single word still containing the 10 | dnl ":" separators. 11 | dnl 12 | dnl This macro fixes the situation: when we see the libtool PATH_SEP to 13 | dnl be ":" and search_path_spec to contain ":" characters, then these 14 | dnl are replaced with spaces to let the resulting string work as a 15 | dnl for-loop argument in libtool scripts that resolve -no-undefined 16 | dnl libraries. 17 | dnl 18 | dnl Later libtool generations have fixed the situation with using 19 | dnl $PATH_SEPARATOR in the first place as the original path delimiter 20 | dnl that will be scanned for and replaced into spaces. 21 | dnl 22 | dnl @category Misc 23 | dnl @author Guido U. Draheim 24 | dnl @version 2005-01-21 25 | dnl @license GPLWithACException 26 | 27 | AC_DEFUN([PATCH_LIBTOOL_SYS_LIB_SEARCH_PATH_SPEC], 28 | [# patch libtool to fix sys_lib_search_path (e.g. crosscompiling a win32 dll) 29 | if test "_$PATH_SEPARATOR" = "_:" ; then 30 | if grep "^sys_lib_search_path_spec.*:" libtool >/dev/null ; then 31 | AC_MSG_RESULT(patching libtool to fix sys_lib_search_path_spec) 32 | test -f libtool.old || (mv libtool libtool.old && cp libtool.old libtool) 33 | sed -e "/^sys_lib_search_path_spec/s/:/ /g" libtool >libtool.new 34 | (test -s libtool.new || rm libtool.new) 2>/dev/null 35 | test -f libtool.new && mv libtool.new libtool # not 2>/dev/null !! 36 | test -f libtool || mv libtool.old libtool 37 | fi 38 | fi 39 | ]) 40 | 41 | 42 | --------------------------------------------------------------------------------