Re: Small, understandable Forth

On Jan 1, 8:47 am, Josh Grams <j...@xxxxxxxxxxx> wrote:
Given ``F"'', a tool library hierarchy can be bootstrapped with a pair
of scripts at the top of the library hierarchy. One script is called
with the desired target and executes F" in the context of the library
hierarchy to get the host filename, with the other bootstrapping the
first by using ``F"'' to compile the location of the second into the
dictionary. The system specific prelude simply includes the second to
install access to the library hierarchy.

I prefer to just have paths to INCLUDED and company default to being
relative to the directory containing the current source file (or search
a system include path if not found).  For systems which don't have it,
it's easy enough to build this on top of INCLUDE-FILE.  Well, replacing
REQUIRE isn't so easy, but if you don't worry about symlinks you can
still do it fairly portably.

This was discussed when DIRECTORIES went out for three RfD ... the
problem is not for systems that don't have it so much as for systems
that have already different path handling that is assumed by local
files using INCLUDED.

IOW, its not a question of preferred implementation designs, but
rather a question of existing implementation designs.

Implementations that have relative paths by default be relative to the
directory containing the current source file, F" is just a word that
copies the text into a buffer and returns the ( ca u ) for the buffer.
For systems that have a particular prefix specifying loading relative
to the file currently being interpreted (gforth uses ``./'' but others
uses ``./'' for the current working directory), its the same thing
except prepending that prefix.

For systems that do not have it, its likely to be straightforward in
most cases so long as you know which operating system you are working
on, so implementation could well be more a per-OS than a per-
implementation task.

"(5) REQUIRE ... because the library oversight system needs to know
precisely what semantics can be expected of this word. There are also
benefits to implementors knowing exactly what the portable semantics
are, so that they can work out the most effective way of dividing the
labor between the portable word and the specific approach to source
code and wordset management taken by the implementation."
   It turns out that I've been able to write REQUIRE out of the naive
incrementally compiled library oversight system I was experimenting
with earlier by defining conditional compilation test words that work
in the scope of the library oversight vocabulary. This pushes the
intelligence from the word to the script.

Can I see your code?  I have accumulated enough bits of compatibility
code that I decided I need some sort of helper code to load them.  I've
been trying to design a Forth package manager that can start out very
simple, but whose design won't impede later extension.  So I'd be
curious to see what you have done...

Its just building a vocabulary hierarchy from scratch, a registry
vocabulary, and having some words for testing for the existence of
version constants.

This library system is built on the concept of three levels of file -
ordinary forth script files (.fs) assume that the words they use are
available and just compile into the CURRENT vocabulary when they are
called.

Niclos file scripts know about the existence of the []Niclos[]
hierarchy, install themselves, and may export their target public
words to FORTH or to the CURRENT vocabulary at the time they are
called. They may INCLUDE ordinary forth file script files or other
niclos file script files, but only in the directory in which they are
located or the current working directory.

Niclos library scripts (.nls) perform version control and engage in
optional compilation in response to tokens handed to the script in a
dedicated command stack, and also navigate the Niclos file hierarchy
system.

I don't have anything from the .nls level that has been tested yet
(that's why the word to export a version constant into the []Niclos
vocabulary is not below), but here is an unstable alpha of the .nfs
support. Given that the system is to be self-boostrapping, the
foundation for the .nfs level is a .fs file, and the foundation for
the .nls is a .nfs file.

With respect to REQUIRE, by looking into []Niclos to see whether a
toolkit exists, and then into the toolkit to see whether it has the
correct version constants, a .nfs script can see whether a desired
capability is there, providing, for major version, a known set of
words with defined behavior. The primary purpose of the minor version
is to support patching around bugs if there is a known bug that was
not fixed until a later minor version.

The two other parts of the foundation file is the extended block
comments and the dummy THROW. The dummy THROW is just print the THROW
code and ABORT, but allows applications that use CATCH THROW error
handling to use toolkits without restricting those toolkits to systems
with CATCH and THROW available.

\ -[ niclos.fs ]-
ONLY FORTH
BL WORD []Niclos[] FIND NIP [IF]
\ S" nlocal.nfs" INCLUDED
\\ Skip to <eof>

This is Niclos-core.
The definitions below should be found anytime []Niclos[]
is defined. So if it is, we're outta here.
[THEN]

FALSE [IF] ====================
Using CORE, BLOCK, SEARCH
Using from CORE EXT:
\ Part of boot-strapping process
:NONAME FALSE NIP TRUE \

\ eligible for conditional compilation
2>R 2R> ?DO REFILL TO U> VALUE

Using from SEARCH EXT:
ALSO FORTH ONLY

.... And now, because the ``---['' word is not yet defined and this
is an IF-THEN scripting block comment, time to get back the
compilation process started.


--[ Core Niclos Structure ]--
======================== [THEN]

\ []Niclos[] Bootstrap - only word exported to FORTH
\ do not assume WORDLIST beyond Forth-94 standard words

ONLY FORTH DEFINITIONS

\ Cannot do colon definition between CREATE and DOES>
:NONAME ( -- )
DOES> @ >R ONLY FORTH GET-ORDER R> SWAP 1+ SET-ORDER ;

WORDLIST CREATE []Niclos[] , EXECUTE

[]Niclos[] DEFINITIONS

\ Version constants
TRUE CONSTANT Niclos01?
0 CONSTANT Niclos01#

\ * runtime action for subvocabularies, Forth-83 model
: {does-vocabulary} ( -- )
DOES> @ >R GET-ORDER NIP R> SWAP SET-ORDER ;

\ Leave exit unlocked
: ONLY ONLY ; : ALSO ALSO ; : FORTH FORTH ;

\ bootstrap [UNDEFINED] and [DEFINED]
\
BL WORD [UNDEFINED] FIND NIP 0= [IF]
\ * True if word is not visible
: [UNDEFINED] ( "name" -- undefined? )
BL WORD FIND NIP 0= ; IMMEDIATE
[THEN]

[UNDEFINED] [DEFINED] [IF]
\ * True if word is visible
: [DEFINED] ( "name" -- defined? )
BL WORD FIND NIP 0<> ; IMMEDIATE
[THEN]

[UNDEFINED] \\ [IF] \ TOOL2000.TXT extended to Blocks
\ * \\ skips interpreting rest of a block or a file
\ the way that \ skips interpreting rest of a line
\ Works w/chained blocks, not 'THRU' blockset
\
: \\ ( "...<eof>" -- )
BLK @ IF
SOURCE >IN ! DROP
ELSE
BEGIN REFILL 0= UNTIL
THEN ;
[THEN]

\ * target vocabulary for exported words
GET-CURRENT VALUE get-export

\ * target vocabulary for exported words
: set-export ( wid -- ) TO get-export ;

\ * current compilation wordlist becomes export target
: export>current ( -- ) GET-CURRENT set-export ;

\ * bring export target to front of search order
: []export[] ( -- )
GET-ORDER NIP get-export SWAP SET-ORDER ;

\ * []Niclos wordlist is a vocabulary/version registry
WORDLIST CONSTANT Niclos-tools

\ * Access Niclos vocabularies
CREATE []Niclos Niclos-tools , {does-vocabulary}

\ * defined vocabulary replaces first wordlist in the
\ search order, which will be Niclos-tools.
\ ``ALSO []Niclos Tkit1[]''
\
: []Toolkit: ( "name" -- ) \ Makes: name ( -- TRUE )
WORDLIST CREATE , {does-vocabulary} ;

\ * creates vocabulary if it does not exist in []Niclos and
\ then makes it the CURRENT vocabulary for definitions. It
\ leaves search order 'vocname' []Niclos[] FORTH so if
\ there are required support vocabularies, that comes next.
\
: []Extend: ( "tkitname" -- )
[]Niclos DEFINITIONS >IN @ >R
BL WORD FIND 0= IF
R@ >IN ! []Toolkit: R@ >IN ! '
THEN
RDROP EXECUTE DEFINITIONS ;

FALSE [IF] ====================
--[ Foundation Niclos Tools: Ntools[] ]--
======================== [THEN]

\ * used for open support tool sharing without requiring
\ Major Version changes when changing factoring of support
\ words. Always test Ntools[] word for existence before
\ defining.
[]Niclos[] ALSO []Extend: Ntools[]

\ Words below which are are Comus - eg, the more widespread
\ words in Forth Toolbelt2002 - conditionally compiled.

TRUE CONSTANT Ntools00?
0 CONSTANT NTools00#

[DEFINED] NOT [IF] \ Forth-79
1 NOT [IF] \ if true, NOT means INVERT
\ * In Niclos scripts, NOT means 0=
: NOT ( flag -- ~flag ) 0= ;
[THEN]
[ELSE]
: NOT ( flag -- ~flag ) 0= ;
[THEN]

[UNDEFINED] ON [IF] \ TOOL2002.TXT
\ * SET variable
: ON ( addr -- ) TRUE SWAP ! ;
[THEN]

[UNDEFINED] OFF [IF] \ TOOL2002.TXT
\ * RESET variable
: OFF ( addr -- ) FALSE SWAP ! ;
[THEN]

\ * Promiscuous variables
\ Rule for use: use at point where only words
\ in the same script are being called
\
VARIABLE temp
VARIABLE flag
VARIABLE out
VARIABLE act1
VARIABLE act2
VARIABLE act3

\ * One-shot private words
\ Usage :noname ... ; act1 ! ... : foo ... [,act1] ... ;
: [,act1] ( -- ) act1 @ COMPILE, ; IMMEDIATE
: [,act2] ( -- ) act2 @ COMPILE, ; IMMEDIATE
: [,act3] ( -- ) act3 @ COMPILE, ; IMMEDIATE

[UNDEFINED] ANDIF [IF] \ TOOL2002.TXT
: ANDIF \ p ANDIF q THEN ... yields p=0 otherwise q
POSTPONE DUP POSTPONE IF POSTPONE DROP
; IMMEDIATE
[THEN]
[UNDEFINED] ORIF [IF] \ TOOL2002.TXT
: ORIF \ p ORIF q THEN ... yields q when p=0, otherwise p
POSTPONE DUP POSTPONE 0= POSTPONE IF POSTPONE DROP
; IMMEDIATE
[THEN]

[UNDEFINED] \\line [IF]
: \\line ( "..." -- "" ) SOURCE >IN ! DROP ;
[THEN]

: c=str? ( c ca u -- [ca u]="c"? ) 1 = >R C@ = R> AND ;
: \token? ( "\ ..."|"..." -- T|F ) [CHAR] \ BL PARSE c=str? ;

: ---[file ( ... "<eol>\<bl>" | <eof>" -- )
\\line BEGIN REFILL 0= ORIF \token? \\line THEN UNTIL ;

1024 CONSTANT blksize
64 CONSTANT blkrow
blkrow 1 - INVERT CONSTANT rowmask

: \\row ( "..." -- "" )
>IN @ rowmask AND blkrow + blksize MIN >IN ! ;

: eob? ( ""|"..." -- T|F ) >IN @ blksize = ;

: ---[block ( ... "<eor>\<bl>"|"<eob>" -- )
\\row BEGIN eob? ORIF \token? \\row THEN UNTIL ;

FALSE [IF] ====================
---[ Multi-line Comments ]---
======================== [THEN]

[]Niclos[] DEFINITIONS
ALSO []Niclos Ntools[]

: ---[ ( ... "\ "|"end" -- )
BLK @ IF ---[block ELSE ---[file THEN ;

: --[ ( ... "\ "|"end" -- ) ---[ ;
: -[ ( ... "\ "|"end" -- ) ---[ ;

---[ Using Extended Comments ]---

And now, extended comments are available:

.... -[ filename ]- can be used to concatenate scripts
and scan or split them later, alternate ``\ -[''.
.... --[ major section ]--
.... ---[ minor section ]---

To Forth, everything after the ---[ word is decoration,
but literate programming filters may make use of it.


--[ Niclos-Core: Version Testing ]--

Niclos version control vocabularies are named in the
pattern of ``Name[]'' and they contain version information
based on "Name", eg, ``Niclos00?'' and ``Niclos00#''.

``[]Niclos[]'', the foundation vocabulary, must be in the
search order when any Niclos system script is being
interpreted. It contains ``[]Niclos'', the toolkit
container vocabulary, which is named for use in a pair, as
in ``ALSO []Niclos Nblocks[]''

Nothing should be defined into []Niclos other than
Niclos vocabularies or words that emulate provision of
Niclos vocabularies, since []Niclos never remains in the
search order in normal use.


---[ Niclos Major Versions ]--

Major versions work like:
* Major versions are: name00?
* They are constants (or values) that return a value
as indicated below.
* The major-return-value is ``mrv'' in stack comments.
* DROPPING words is permitted between major versions
* Choice of versionid scheme is up to author/librarian,
but Name and id should fit in EIGHT (8) characters.
* Niclos uses six char Name and:
** 00 pre-alpha, experimental
** 01-05, alpha, (any 02 through 05 might be skipped)
** 06-09, beta (any 07 through 09 might be skipped)
** 10-99, release
* Not present in Name[] or []Niclos[] implies not
compiled, but, tacitly, permitted to be compiled.
* FALSE implies not compiled and DON'T compile (this
allows block problematic major versions to be blocked,
either by the user or in a prelude file.
* TRUE if supported in this wordlist
* Any other value MUST BE a wordlist-id, indicating it
is supported in a different wordlist

Note that "wordlist-id" version constants will normally be
stored in the []Niclos[] vocabulary, and the "flag"
version constants normally stored in that version's
public vocabulary.

Variants not in a main release path should have their main
version incremented and be initialed with two or three
letters. In a script file hierarchy, these will have a
normal eight (8) character version load script name but be
in a subdirectory or parallel directory based on the initials.
So ``TRUE CONSTANT Niclos03-brm01'', would be a variant
release of Niclos02.


---[ Minor Versions ]--

Minor versions are: <name><version#>#

Minor versions may only fix bugs and add available public
words so each minor version is an increment on the previous,
and the version is a constant of the version index, tested
by relative comparison. A minor version equal 0 indicates a
major version is not yet tested/stable - its presence is
required to test that it respects version control but is not
for released code.

This is a publication-oriented system rather than one
focused on development in progress, so do not publish
an untested modification into a main release. Until
all words have been tested, and whatever other publication
requirements of the Niclos toolkit librarian have been met,
a new minor version should only ever have the unstable minor
version 0.

Publishing code for review and testing for portability
when the author does not have access to a broad range of
systems can be done with a pre-alpha variant release with
a version 0.

---[ Version Factors ]---

find-version searches for a string in the most recent
wordlist and []Niclos[]

\ * This vocabulary is for sharing support words that are
\ not part of the main public wordset contained in the
\ main Niclos toolkit.
\
[]Niclos[] ALSO []Extend: Ntools[]

\ Is-White ( char -- flag ) TOOL2002.TXT
\ used here as is-ws? and as factor in is-not-ws?

\ NB. If more complex White-Space is needed, this should be
\ defined in the system prelude.
\ When Comus words are publicly defined in Mixed or Upper,
\ do multi-case test for case-sensitive models

[UNDEFINED] is-ws? [IF]
[DEFINED] is-white [IF]
: is-ws? ( c -- flag ) is-white ;
[ELSE] [DEFINED] Is-White [IF] \ TOOL2002.TXT
: is-ws? ( c -- flag ) Is-White ;
[ELSE]
\ * Test c for white space. By default, any character
\ with value less than 33 is taken as white space.
: is-ws? ( char -- flag ) \ TOOL2002.TXT
33 - 0< ;
[THEN]
[THEN]
[THEN]
[UNDEFINED] not-ws? [IF]
\ * test for not white space
: not-ws? ( char -- flag ) is-ws? 0= ;
[THEN]

[UNDEFINED] PARSE-NAME [IF]
[DEFINED] parse-name [IF] \ reference implementation
: PARSE-NAME parse-name ;
[ELSE]
[UNDEFINED] xt-skip [IF] \ reference implementation
\ * skip all characters satisfying xt ( c -- f )
: xt-skip ( addr1 n1 xt -- addr2 n2 ) \ gforth
>R BEGIN
DUP
WHILE
OVER C@ R@ EXECUTE
WHILE
1 /STRING
REPEAT
THEN R> DROP ;
[THEN]

: PARSE-NAME ( "name" -- c-addr u )
SOURCE >IN @ /STRING
['] is-ws? xt-skip OVER >R
['] not-ws? xt-skip
( end-word restlen r: start-word )
2DUP 1 MIN + SOURCE DROP - >IN !
DROP R> TUCK - ;
[THEN]
[THEN]

: get-first-wid ( -- wid )
GET-ORDER OVER >R
0 ?DO DROP LOOP
R> ;

: find-version ( ca u -- mvr )
2DUP 2>R get-first-wid SEARCH-WORDLIST IF
2RDROP EXECUTE
ELSE
2R> Niclos-tools SEARCH-WORDLIST IF EXECUTE ELSE 0 THEN
THEN ;

---[ Major Version Test ]---

Version control is performed with tests that can drive
conditional [IF] ... [ELSE] ... [THEN] scripts.

version? name
searches for the name in the current search order. If
it is not present, 0 is returned, if it is present, it
is executed.

version? name version! [IF] ...
version! leaves FALSE and TRUE alone, and assumes otherwise
that it is a replacement wordlist-id, replacing the current
vocabulary.

external? ( mrv -- mrv flag=wid? )
generates a flag based on whether it is a definite result
here, or an external vocabulary - this is a factor of version?
useful in its own right.
``version? name external? [IF] ...''

possibly? ( "name" -- x*j TRUE | FALSE )
executes name if found anywhere, leaving flag on whether
found or not. This is a generally useful support word, and
especially useful for selecting which of various
vocabularies that can be used to provide a needed facility.
``[]Niclos possibly? Nbmw[] NOT [IF] ...''

\ Foundation words in []Niclos[]

[]Niclos[] DEFINITIONS ALSO []Niclos Ntools[]

\ * generic execute if found
: possibly ( "token" -- x*j )
BL WORD FIND IF EXECUTE ELSE DROP THEN ;

\ * generic execute if found, flag=found?
: possibly? ( "version-token -- x*j flag )
BL WORD FIND IF EXECUTE TRUE ELSE DROP FALSE THEN ;

\ * execute
: version? ( "version-token" -- mvr )
PARSE-NAME find-version ;

\ * distinguish "definite" major version results from
\ external wordlist-id's

: external? ( mvr -- mvr flag=wid? )
DUP 0= OVER TRUE = OR 0= ;

\ * resolves workspace-id if it is one
: version! ( mvr -- mvr' )
external? IF
>R GET-ORDER NIP R> SWAP SET-ORDER
TRUE
THEN ;

---[ Minor Version Test ]---

<minor? is an AMENDMENT to a major version return (mvr) on
the stack. If the mvr is not TRUE, minor# returns false, so
it is normally used after [>version] and, indeed, normally
only PRESENT in the vocabulary/ies for which [version] gives
TRUE.

\ * test for minor version
\ version? Niclos00? version! 16 <minor? Niclos00# [IF]
\ No minor is equivalent to a minor of 0

: <minor? ( mvr target-minor# "version#" -- mvr' )
version? ?DUP U> 0= AND TRUE = ;

\ * test for stable version
: stable? ( mrv "version" -- mrv' )
1 <minor? ;

---[ Backup Error Return ]---

Niclos scripts are encouraged to THROW without worrying
about whether the THROW will be caught. When CATCH is not
available, the script should simply report the return code
and abort.

NB. A Niclos script that relies on CATCH/THROWN does not
test for ``THROW'', it tests for ``CATCH''.

This is deferred, so that if THROW is an extension in a
system, a prelude for a Niclos script that requires THROW
can load it and then install it to any earlier Niclos
scripts that simply THROW errors.

\ NB: Commonwealth English slang alert

[UNDEFINED] THROW [IF]
\ * Value to defer THROW
' DROP VALUE {THROW}

\ * THROW deferred through {THROW}
: THROW ( k*x n | k*x | i*x n ) {THROW} EXECUTE ;

\ * When CATCH/THROW not available, Niclos
\ THROWS errors back to user with ABORT
\
: throw-the-dummy ( flag -- continue | ABORT )
?DUP IF
CR ." Thrown value: " . CR ABORT
THEN ;

' throw-the-dummy TO {THROW}
[THEN]

[]Niclos[]

\\ // \\ // \\ // \\ // \\ //

---[ That's All, Folks! ]---

This is the Niclos01 minor version 00 model to date.
.

Relevant Pages

  • Re: Will Linux become as vulnerable as MS ??
    ... > beeing vulnerable to viruses. ... > that they know are executable, and execute intentionally. ... >> Linux, each distro is a little different, and even within the distro, ... > Since clicking on a script is easier than typing it's name, ...
    (comp.os.linux.security)
  • Re: [Full-Disclosure] ColdFusion cross-site scripting security vulnerability of an error page
    ... > execute the arbitrary javascript and HTML code which the attacker ... > It is possible to display the contents transmitted from the client ... > cross-site scripting attack can be executed. ... the script will be executed when the script for an attack ...
    (Full-Disclosure)
  • CGIscript.net - csMailto.cgi - Remote Command Execution
    ... CGIscript.net - csMailto.cgi - Remote Command ... csMailto is a perl cgi formmail script developed by ... execute command on server and mail output to anyone ...
    (Bugtraq)
  • Re: Extracting data from an XML to put into a constant
    ... ExecuteGlobal "Const cnUB = 9" ... The following script causes the same error. ... Ordinary variables and constants defined with execute statements have ... no value until their defining statement is executed at run time. ...
    (microsoft.public.scripting.vbscript)