0 [IF] Forth to HTML converter Main contributors: Brad Eckert brad1NO@SPAMtinyboot.com Ed Beroset berosetNO@SPAMmindspring.com Dirk Busch dirkNO@SPAMschneider-busch.de Revision 7b. See bottom for revision history. This ANS Forth program is public domain. It translates ANS Forth to colorized HTML. Hyperlinks to the ANS Forth draft standard are inserted for all ANS standard words. Hyperlinks to user definitions are included. Usage: HTML FileName Generates HTML file from Forth source. Output file is Filename with .HTM extension. Q [forth code] Outputs HTML for 1 line to screen Q is for debugging. You can use "linenum ?" to show the line number if an ABORT occurs. The HTML is about 7 times as big as the Forth source because of all the links, color changes and whitespace. INCLUDEd files produce corresponding HTML pages. If the file can't be found, it is skipped. Otherwise it is nested. When you INCLUDE this file some redefinition complaints may occur. That's okay since you won't be loading an application on top of this. Users of specific Forths can extend the hyperlink table to point to words in a glossary for that particular Forth. The following ANS Forth wordsets are needed by this program: CORE, CORE-EXT, SEARCH-ORDER, SEARCH-ORDER-EXT, STRING, FILE, TOOLS-EXT. [THEN] ONLY FORTH ALSO DEFINITIONS : undefined ( -- f ) BL WORD FIND NIP 0= ; undefined BOUNDS [IF] : BOUNDS OVER + SWAP ; [THEN] undefined C+! [IF] : C+! SWAP OVER C@ + SWAP C! ; [THEN] undefined SCAN [IF] : SCAN ( addr len char -- addr' len' ) >R BEGIN DUP WHILE OVER C@ R@ <> WHILE 1 /STRING REPEAT THEN R> DROP ; [THEN] undefined SKIP [IF] : SKIP ( addr len char -- addr' len' ) >R BEGIN DUP WHILE OVER C@ R@ = WHILE 1 /STRING REPEAT THEN R> DROP ; [THEN] undefined +PLACE [IF] : +PLACE 2DUP 2>R COUNT CHARS + SWAP MOVE 2R> C+! ; [THEN] undefined PLACE [IF] : PLACE 0 OVER C! +PLACE ; [THEN] undefined FDROP [IF] : FDROP ; ( no floating point? fake it ) [THEN] undefined >FLOAT [IF] : >FLOAT DROP C@ [CHAR] 0 [CHAR] 9 1+ WITHIN ; [THEN] undefined UPC [IF] : UPC ( convert char to upper case ) DUP [CHAR] a [CHAR] z 1+ WITHIN AND IF 32 - THEN ; [THEN] : (,$) ( a len -- ) DUP C, BOUNDS ?DO I C@ C, LOOP ; \ text to dictionary : ,| ( -- ) [CHAR] | WORD COUNT -TRAILING (,$) ; \ ############################################################################## \ Configuration - You can change the options: 0 VALUE bold \ T if bold text 1 VALUE italic \ T if italic comments 1 VALUE nestable \ T if INCLUDE nested files 1 VALUE linksource \ T link to the org. file /4a/ \ path to the ANS-Files /4a/ \ create dpanspath ,| ./ANS/ | \ /7b/ \ create dpanspath ,| C:\Programme\Win32For\V609xx - CVS\htm\| create dpanspath ,| .\win32forth-defs\| 0 CONSTANT scheme \ Color scheme: 0 = light background \ 1 = black background create footer \ text to output at the bottom of the HTML-file /4a/ ,| This page was created with Forth to HTML. | \ ############################################################################## \ to avoid "****System word: <..> used in: <..> at file <..> line n" \ messages when using Win32Forth. /5a/ undefined sys-warning-off [IF] : sys-warning-off ; [THEN] undefined sys-warning-on [IF] : sys-warning-on ; [THEN] sys-warning-off 0 VALUE outf \ output to file 1 VALUE screen-only \ screen is for testing : werr ( n -- ) ABORT" Error writing file" ; : out ( a len -- ) screen-only IF TYPE ELSE outf WRITE-FILE werr THEN ; : outln ( a len -- ) screen-only IF TYPE CR ELSE outf WRITE-LINE werr THEN ; : boiler ( addr -- ) BEGIN COUNT DUP WHILE 2DUP + >R outln R> REPEAT 2DROP ; : (html-num) ( n -- a len ) BASE @ >R 0 HEX <# # # # # # # #> R> BASE ! ; : html-num ( a len -- ) (html-num) out ; \ create a named text string terminated by | \ when executed, emits the named text using out : ,named| ( -- ) CREATE [CHAR] | WORD COUNT BL SKIP -TRAILING (,$) \ /4c/ DOES> COUNT out ; ,named| _ "> | VARIABLE attrib : " out 0 attrib ! THEN ; : ( -- ) italic IF s" " out THEN ; : ( -- ) italic IF s" " out THEN ; : ( -- ) bold IF s" " out THEN ; : ( -- ) bold IF s" " out THEN ; :
( -- ) s"
" outln ; \ /5a/ VARIABLE color \ current color VARIABLE infont \ within tag : ( -- ) \ change font color color @ 1 infont ! ; : ( -- ) \ colse tag infont @ IF s" " out 0 infont ! THEN ; : fcol ( color -- ) \ define a font color CREATE , DOES> @ color ! ; HEX scheme 0 = [IF] \ light background 808080 fcol unknown 008000 fcol commentary 990000 fcol numeric FF0000 fcol errors 990080 fcol values 000000 fcol userwords 009999 fcol userdefiner CC00CC fcol variables 0000FF fcol core_ws \ core is slightly lighter blue 0000FF fcol core_ext_ws 0000FF fcol block_ws 0000FF fcol double_ws 0000FF fcol exception_ws 0000FF fcol facilities_ws 0000FF fcol file_ws 0000FF fcol fp_ws 0000FF fcol local_ws 0000FF fcol malloc_ws 0000FF fcol progtools_ws 0000FF fcol searchord_ws 0000FF fcol string_ws [ELSE] \ black background 808080 fcol unknown 00FF00 fcol commentary FF8080 fcol numeric FF0000 fcol errors FF00FF fcol values FFFFFF fcol userwords 00FFFF fcol userdefiner FF80FF fcol variables 8080FF fcol core_ws 8080FF fcol core_ext_ws 0000FF fcol block_ws 0000FF fcol double_ws 0000FF fcol exception_ws 0000FF fcol facilities_ws 0000FF fcol file_ws 0000FF fcol fp_ws 0000FF fcol local_ws 0000FF fcol malloc_ws 0000FF fcol progtools_ws 0000FF fcol searchord_ws 0000FF fcol string_ws [THEN] DECIMAL VARIABLE bltally : outh ( a n -- ) \ HTMLized text output 999 bltally ! BOUNDS ?DO I C@ CASE [CHAR] & OF S" &" out ENDOF [CHAR] < OF S" <" out ENDOF [CHAR] > OF S" >" out ENDOF [CHAR] " OF S" "" out ENDOF [CHAR] © OF S" ©" out ENDOF \ /4a/ BL OF bltally @ 0= IF S" " ELSE S"  " THEN out 1 bltally +! ENDOF I 1 out 0 bltally ! ENDCASE LOOP ; : outhattr ( a n -- ) \ HTMLized text output BOUNDS ?DO I C@ CASE [CHAR] & OF S" amp" out ENDOF [CHAR] < OF S" lt" out ENDOF [CHAR] > OF S" gt" out ENDOF [CHAR] " OF S" quot" out ENDOF [CHAR] + OF S" plus" out ENDOF [CHAR] ! OF S" bang" out ENDOF [CHAR] / OF S" slash" out ENDOF [CHAR] \ OF S" backslash" out ENDOF [CHAR] ' OF S" apos" out ENDOF [CHAR] = OF S" equal" out ENDOF [CHAR] - OF S" dash" out ENDOF [CHAR] @ OF S" at" out ENDOF [CHAR] ; OF S" semi" out ENDOF [CHAR] * OF S" star" out ENDOF [CHAR] ? OF S" question" out ENDOF [CHAR] ~ OF S" tilde" out ENDOF [CHAR] # OF S" pound" out ENDOF [CHAR] , OF S" comma" out ENDOF [CHAR] $ OF S" dollar" out ENDOF [CHAR] | OF S" bar" out ENDOF [CHAR] [ OF S" ltbracket" out ENDOF [CHAR] ( OF S" ltparen" out ENDOF [CHAR] { OF S" ltbrace" out ENDOF [CHAR] ] OF S" rtbracket" out ENDOF [CHAR] ) OF S" rtparen" out ENDOF [CHAR] } OF S" rtbrace" out ENDOF BL OF S" _" out ENDOF I 1 out ENDCASE LOOP ; CREATE begin_header \ begin of HTML file part 1 ,| | ,| | ,| | ,| | ,| | ,| | ,| | ,| | 0 C, : mid_header ( -- ) \ begin of HTML file part 2 ; : end_header ( -- ) \ end of HTML file /4a/ footer COUNT ?DUP IF

out

ELSE drop THEN ; : label ( addr len -- ) \ associate a label with a word ; VARIABLE nextlocal : locallabel ( addr len -- ) \ associate a label with a local ; \ Assuming this is running on a PC, we allocate enough storage that crashes from \ string overflows can't happen. /4/ CREATE inbuf 260 CHARS ALLOT \ current line from file CREATE token 260 CHARS ALLOT \ last blank delimited string CREATE XPAD 260 CHARS ALLOT \ temporary pad for word storage CREATE EPAD 260 CHARS ALLOT \ temporary pad for evaluation CREATE fn 260 CHARS ALLOT \ file name CREATE fn1 260 CHARS ALLOT \ file name backup CREATE "str" 260 CHARS ALLOT \ parsed string storage CREATE uname 260 CHARS ALLOT \ : definition name 0 VALUE inf VARIABLE nufile \ T if nesting a file VARIABLE utype \ type of defined word VARIABLE hstate VARIABLE linenum VARIABLE special \ special action, 0=none WORDLIST CONSTANT hyperlinks \ list of hyperlinks WORDLIST CONSTANT superlinks \ hyperlinks that can't change : std ( word 2nd_fn color filename label -- ) CREATE ' , ' , BL WORD COUNT (,$) BL WORD COUNT (,$) DOES> DUP >R 2 CELLS + R out S" #" out \ output file name /4/ R> COUNT out "> \ and anchor name R> 2@ SWAP EXECUTE EXECUTE ; \ extra attributes : genHTML ( -- ) \ generate pending HTML token COUNT DUP IF THEN outh 0 token ! ; : genHTML2 ( -- ) \ generate pending HTML /6a/ token COUNT outh 0 token ! ; : isnumber? ( addr len -- f ) \ string converts to number? 0 0 2SWAP >NUMBER NIP NIP NIP 0= ; : hparse ( a len char -- a' len' ) >R 2DUP R@ SKIP R> SCAN BL SCAN 2SWAP 2 PICK - token +PLACE ; : >XPAD ( -- ) token COUNT BL SKIP XPAD PLACE ; \ move to temporary pad : hint ( addr len -- ) \ interpret one line... BEGIN 0 token ! BL hparse token C@ WHILE unknown \ default color >XPAD XPAD COUNT superlinks SEARCH-WORDLIST 0= \ fixed hyperlink? IF >XPAD nextlocal @ (html-num) XPAD +PLACE \ local hyperlink? XPAD COUNT hyperlinks SEARCH-WORDLIST 0= IF >XPAD XPAD COUNT hyperlinks SEARCH-WORDLIST \ hyperlink? ELSE TRUE THEN ELSE TRUE THEN IF DEPTH >R EXECUTE R> DEPTH <> ABORT" stack depth change in HTML generator" ELSE XPAD COUNT BASE @ 10 = IF >FLOAT IF FDROP numeric THEN \ valid float or integer ELSE isnumber? IF numeric THEN THEN THEN genHTML REPEAT 2DROP
; \ new line : ofn ( -- addr len ) \ output file name fn COUNT 2DUP [CHAR] . SCAN NIP - EPAD PLACE S" .htm" EPAD +PLACE EPAD COUNT ; : hcreate ( addr len -- ) DUP 0= IF 2DROP S" fakename" THEN \ in case the name is missing S" CREATE " EPAD PLACE EPAD +PLACE GET-CURRENT >R hyperlinks SET-CURRENT EPAD COUNT EVALUATE R> SET-CURRENT ; \ create a hyperlink generator \ The user defined words use the following data structure: \ CELL xt of coloring word \ STRING name of reference word \ STRING name of file : deflink ( addr -- ) \ defined word makes hyperlink DUP @ EXECUTE CELL+ \ set color DUP COUNT + COUNT ofn COMPARE \ in an external file? IF ELSE \ no, just the label name THEN ; : defx ( a len xt -- a' len' ) >R genHTML BL hparse >XPAD \ output defining word XPAD COUNT 2DUP hcreate R> , (,$) ofn (,$) DOES> deflink ; : labelnow genHTML XPAD COUNT label ; \ /4/ : defdat ['] numeric defx numeric labelnow ; : defvar ['] variables defx variables labelnow ; : defusr ['] userwords defx userwords labelnow ; : defval ['] values defx values labelnow ; : defdef ['] userdefiner defx userdefiner labelnow ; : localcreate ( addr len -- ) DUP 0= IF 2DROP S" fakename" THEN \ in case the name is missing S" CREATE " EPAD PLACE EPAD +PLACE nextlocal @ (html-num) EPAD +PLACE GET-CURRENT >R hyperlinks SET-CURRENT EPAD COUNT EVALUATE R> SET-CURRENT ; \ create a hyperlink generator : localdeflink ( addr -- ) \ defined word makes hyperlink DUP @ EXECUTE CELL+ \ set color DUP COUNT + COUNT ofn COMPARE \ in an external file? IF ELSE THEN ; : localdefx ( a len xt -- a' len' ) >R genHTML BL hparse >XPAD \ output defining word XPAD COUNT 2DUP localcreate R> , (,$) ofn (,$) DOES> localdeflink ; : locallabelnow genHTML XPAD COUNT locallabel ; \ /7a/ : deflocal ['] values localdefx values locallabelnow ; \ /7a/ : hstate=0 ( -- ) 0 hstate ! ; : hstate=1 ( -- ) 1 hstate ! ; : spec=zero ( -- ) 1 special ! ; : spec=bl ( -- ) 2 special ! ; : NONE ( -- ) 0 special ! ; \ plain word : skip) ( a len -- a' len' ) [CHAR] ) hparse ; : skip} ( a len -- a' len' ) [CHAR] } hparse ; \ /4a/ : skipw ( a len -- a' len' ) BL hparse ; : skipc ( a len -- a len ) hstate @ 0= IF numeric skipw THEN ; : skip" ( a len -- a' len' ) \ copy string to "str" genHTML [CHAR] " hparse token COUNT 1- "str" PLACE ; \ ------------------------------------------------------------------------------ \ ":" definitions might be defining words, so they can't be assumed to be defusr \ types. ":" makes a label and saves the name for later use by ";" which makes \ a hyperlink or a hyperlink defining word. :NONAME \ normal : definition uname COUNT ['] userwords defx 2DROP 0 token ! ; CONSTANT normal_def :NONAME uname COUNT 2DUP hcreate ['] userwords , (,$) ofn (,$) DOES> deflink defdef ; CONSTANT defining_def : defunk ( a len -- a' len' ) \ starting unknown definition hstate=1 normal_def utype ! \ save name of : definition genHTML skipw userwords token COUNT BL SKIP 2DUP uname PLACE label ; : resunk ( -- ) \ resolve unknown defined word genHTML utype @ EXECUTE hstate=0 1 nextlocal +! ; \ next local number : created ( -- ) hstate @ IF defining_def utype ! \ make ; create a defining word ELSE defdat \ not compiling THEN ; : blword ( -- ) none ; \ last word was a BL? don't care \ ------------------------------------------------------------------------------ : .filename ( addr len -- ) \ output big header text /4b/

linksource IF 2dup outln ELSE outln THEN


; : _incfil ( addr -- ) \ trigger file nesting /4/ nestable 0= IF DROP EXIT THEN \ don't nest files if disabled COUNT BL SKIP 2DUP R/O OPEN-FILE \ can the file be opened? IF DROP 2DROP \ no ELSE CLOSE-FILE DROP \ yes fn COUNT fn1 PLACE fn PLACE 1 nufile ! THEN ; : incfile ( a len -- a' len' ) \ include a file genHTML skipw token _incfil ; : "incfil ( a len -- a' len' ) \ include file from S" filename" skipw "str" _incfil ; : hfill ( -- len ior ) \ read next line of file inbuf 256 BL FILL XPAD 256 inf READ-LINE ABORT" Error reading file" >R >R 0 XPAD R> BOUNDS ( idx . . ) ?DO I C@ 9 = IF 3 RSHIFT 1+ 3 LSHIFT \ tab ELSE I C@ OVER 255 AND CHARS inbuf + C! 1+ DUP 256 = IF CR ." Input line too long" THEN THEN LOOP R> 1 linenum +! ; : open ( -- ) CR ." Reading " fn COUNT TYPE ." at line " linenum @ . 0 linenum ! fn COUNT R/O OPEN-FILE ABORT" Error opening source file" TO inf ; : close ( -- ) CR ." closing " fn COUNT TYPE inf CLOSE-FILE ABORT" Error closing file" ; : .title ( addr len -- ) \ output as title string BOUNDS ?DO I C@ BL = IF S" %20" out ELSE I 1 out THEN LOOP ; : oopen ( -- ) ofn W/O CREATE-FILE ABORT" Error creating file" TO outf begin_header boiler \ begin boilerplate fn COUNT .title mid_header \ title and end boilerplate fn COUNT .filename ; : DeleteHyperlinks ( -- ) \ delete user hyperlinks S" /hyper-links/" hyperlinks SEARCH-WORDLIST IF EXECUTE THEN \ remove hyperlinks GET-CURRENT >R hyperlinks SET-CURRENT \ replace the fence S" MARKER /hyper-links/" EVALUATE R> SET-CURRENT 0 nextlocal ! ; \ no locals yet : HTML ( -- ) DeleteHyperlinks \ remove user hyperlinks 0 TO screen-only 0 nufile ! 1 linenum ! \ force usage of file 0 infont ! 0 attrib ! \ /4b/ /4d/ BL WORD COUNT fn PLACE open oopen \ open input and output files -1 DUP >R outf >R \ file nest uses stacks hstate=0 BEGIN BEGIN 0 special ! \ process line nufile @ \ nest a file? IF inf outf open oopen outf >R \ open new files 0 nufile ! THEN hfill WHILE inbuf SWAP hint REPEAT DROP close fn1 COUNT fn PLACE \ restore file name DUP -1 <> IF TO outf TO inf FALSE \ unnest files ELSE TRUE THEN UNTIL DROP BEGIN R> DUP -1 <> \ close all output files WHILE

\ /4b/ end_header \ finish up HTML CLOSE-FILE ABORT" Error closing file" REPEAT DROP ; : q ( -- ) 1 TO screen-only \ single line test -1 WORD COUNT inbuf PLACE inbuf COUNT hint ; \ 0 [IF] is often used as a comment. If it is used as a comment, scan the file \ for a [THEN]. [THEN] must be on the next line or beyond. : upp ( a n --) \ uppercase BOUNDS ?DO I C@ UPC I C! LOOP ; CREATE terminator 16 CHARS ALLOT \ terminator VARIABLE colorflag \ color the terminator? /5a/ : multicomment ( a len flag searchstring -- a' len' ) \ /5a/ /6a/ terminator PLACE DUP colorflag ! \ finish up this line IF commentary genHTML2 outh ELSE genHTML commentary outh THEN BEGIN hfill
WHILE >R inbuf EPAD R@ MOVE EPAD R@ upp \ uppercase for search EPAD R@ terminator COUNT SEARCH IF DROP colorflag @ IF terminator COUNT NIP + EPAD - inbuf OVER token PLACE ELSE EPAD - inbuf OVER token PLACE \ before terminator is comment THEN genHTML2 inbuf R> ROT /STRING
EXIT ELSE 2DROP inbuf R> outh \ whole line is comment THEN REPEAT inbuf SWAP
; \ EOF found : bigif ( a len -- a len ) special @ 1 = IF 0 S" [THEN]" multicomment THEN none ; \ /5a/ : singlecomment ( a len -- a' len' ) commentary \ /6a/ genHTML2 token PLACE genHTML2 token 0 ; : locals ( a len searchstring -- a' len' ) \ define locals terminator PLACE genHTML BEGIN BEGIN 2DUP BL hparse 2DROP token COUNT BL SKIP DUP WHILE terminator COUNT COMPARE 0 token ! IF deflocal ELSE local_ws EXIT THEN REPEAT 2DROP 2DROP hfill 0= IF ." Missing " terminator COUNT TYPE ." in locals list" ABORT THEN inbuf SWAP S" " outln AGAIN ; : _locals ( a len -- a' len' ) \ define locals to | s" |" locals ; \ ============================================================================= : _DEFINITIONS DEFINITIONS ; superlinks SET-CURRENT \ These hyperlinks cannot be overridden. \ The following words are not in the ANS standard but are very common. : VOCABULARY defusr ; : DEFER defusr ; : INCLUDE hstate @ 0= IF incfile THEN ; : FLOAD hstate @ 0= IF incfile THEN ; : BINARY 2 BASE ! ; : OCTAL 8 BASE ! ; : 0 numeric spec=zero ; : 1 numeric ; : -1 numeric ; : COMMENT: 1 S" COMMENT;" multicomment ; \ /5a/ : (( 1 S" ))" multicomment ; \ /5a/ \ The following words are not in the ANS standard but are used in Win32Forth : anew skipw ; \ /4a/ : callback: defunk ; \ /4a/ : callback defusr ; \ /4a/ : :m defunk ; \ /4a/ : ;m resunk ; \ /4a/ : z" numeric skip" ; \ /7/ : :class defunk ; \ /7a/ : ;class resunk ; \ /7a/ : int defvar ; \ /7a/ : bytes defvar ; \ /7a/ : byte defvar ; \ /7a/ : bits defvar ; \ /7a/ : short defvar ; \ /7a/ : dint defvar ; \ /7a/ : record: defunk ; \ /7a/ : ;record resunk ; \ /7a/ : ncode defunk ; \ /7a/ : cfa-code defunk ; \ /7a/ : c; resunk ; \ /7a/ : EQU defval ; \ /7a/ : // singlecomment ; \ /7a/ : |: defunk ; \ /7a/ : USER defvar ; \ /7a/ : alias created ; \ /7b/ \ Forth Inc uses { for comment while others use it for locals. } on the same \ line indicates locals. Otherwise a multiline comment. : { 2DUP [CHAR] } SCAN NIP \ /5a/ /7/ IF commentary s" --" locals commentary skip} ELSE 1 S" }" multicomment THEN ; \ The rest is ANS Forth standard : \ singlecomment ; : ( 2DUP [CHAR] ) SCAN NIP \ /7c/ IF commentary skip) \ single line ELSE 1 S" )" multicomment \ multiline THEN ; ( NAME ACTION COLOR FILENAME REFERENCE ) ( ------------------ ------ -------------- ----------- --------- ) std ." skip" numeric dpans6.htm 6.1.0190 std : defunk core_ws dpans6.htm 6.1.0450 std ; resunk core_ws dpans6.htm 6.1.0460 std ABORT" skip" errors dpans6.htm 6.1.0680 std CHAR skipc core_ws dpans6.htm 6.1.0895 std CONSTANT defdat core_ws dpans6.htm 6.1.0950 std CREATE created core_ws dpans6.htm 6.1.1000 std DECIMAL DECIMAL core_ws dpans6.htm 6.1.1170 std S" skip" numeric dpans6.htm 6.1.2165 std VARIABLE defvar core_ws dpans6.htm 6.1.2410 std [ hstate=0 core_ws dpans6.htm 6.1.2500 std ['] NONE numeric dpans6.htm 6.1.2510 std [CHAR] skipw numeric dpans6.htm 6.1.2520 std ] hstate=1 core_ws dpans6.htm 6.1.2540 std .( skip) commentary dpans6.htm 6.2.0200 std C" skip" numeric dpans6.htm 6.2.0855 std FALSE spec=zero numeric dpans6.htm 6.2.1485 std HEX HEX core_ext_ws dpans6.htm 6.2.1660 std MARKER defusr core_ext_ws dpans6.htm 6.2.1850 std VALUE defval core_ext_ws dpans6.htm 6.2.2405 std 2CONSTANT defdat double_ws dpans8.htm 8.6.1.0360 std 2VARIABLE defvar double_ws dpans8.htm 8.6.1.0440 std INCLUDED "incfil file_ws dpans11.htm 11.6.1.1718 std FCONSTANT defdat fp_ws dpans12.htm 12.6.1.1492 std FVARIABLE defvar fp_ws dpans12.htm 12.6.1.1630 std ;CODE resunk progtools_ws dpans15.htm 15.6.2.0470 std CODE defusr progtools_ws dpans15.htm 15.6.2.0930 std [IF] bigif progtools_ws dpans15.htm 15.6.2.2532 std LOCALS| _locals local_ws dpans13.htm 13.6.2.1795 std | NONE local_ws dpans13.htm 13.6.2.1795 std BL spec=bl numeric dpans6.htm 6.1.0770 \ /7b/ std WORD blword core_ws dpans6.htm 6.1.2450 std PARSE blword core_ext_ws dpans6.htm 6.2.2008 hyperlinks SET-CURRENT \ These hyperlinks can be overridden. std ! NONE core_ws dpans6.htm 6.1.0010 std # NONE core_ws dpans6.htm 6.1.0030 std #> NONE core_ws dpans6.htm 6.1.0040 std #S NONE core_ws dpans6.htm 6.1.0050 std ' NONE core_ws dpans6.htm 6.1.0070 std * NONE core_ws dpans6.htm 6.1.0090 std */ NONE core_ws dpans6.htm 6.1.0100 std */MOD NONE core_ws dpans6.htm 6.1.0110 std + NONE core_ws dpans6.htm 6.1.0120 std +! NONE core_ws dpans6.htm 6.1.0130 std +LOOP NONE core_ws dpans6.htm 6.1.0140 std , NONE core_ws dpans6.htm 6.1.0150 std - NONE core_ws dpans6.htm 6.1.0160 std . NONE core_ws dpans6.htm 6.1.0180 std / NONE core_ws dpans6.htm 6.1.0230 std /MOD NONE core_ws dpans6.htm 6.1.0240 std 0< NONE core_ws dpans6.htm 6.1.0250 std 0= NONE core_ws dpans6.htm 6.1.0270 std 1+ NONE core_ws dpans6.htm 6.1.0290 std 1- NONE core_ws dpans6.htm 6.1.0300 std 2! NONE core_ws dpans6.htm 6.1.0310 std 2* NONE core_ws dpans6.htm 6.1.0320 std 2/ NONE core_ws dpans6.htm 6.1.0330 std 2@ NONE core_ws dpans6.htm 6.1.0350 std 2DROP NONE core_ws dpans6.htm 6.1.0370 std 2DUP NONE core_ws dpans6.htm 6.1.0380 std 2OVER NONE core_ws dpans6.htm 6.1.0400 std 2SWAP NONE core_ws dpans6.htm 6.1.0430 std < NONE core_ws dpans6.htm 6.1.0480 std <# NONE core_ws dpans6.htm 6.1.0490 std = NONE core_ws dpans6.htm 6.1.0530 std > NONE core_ws dpans6.htm 6.1.0540 std >BODY NONE core_ws dpans6.htm 6.1.0550 std >IN NONE core_ws dpans6.htm 6.1.0560 std >NUMBER NONE core_ws dpans6.htm 6.1.0570 std >R NONE core_ws dpans6.htm 6.1.0580 std ?DUP NONE core_ws dpans6.htm 6.1.0630 std @ NONE core_ws dpans6.htm 6.1.0650 std ABORT NONE core_ws dpans6.htm 6.1.0670 std ABS NONE core_ws dpans6.htm 6.1.0690 std ACCEPT NONE core_ws dpans6.htm 6.1.0695 std ALIGN NONE core_ws dpans6.htm 6.1.0705 std ALIGNED NONE core_ws dpans6.htm 6.1.0706 std ALLOT NONE core_ws dpans6.htm 6.1.0710 std AND NONE core_ws dpans6.htm 6.1.0720 std BASE NONE core_ws dpans6.htm 6.1.0750 std BEGIN NONE core_ws dpans6.htm 6.1.0760 std C! NONE core_ws dpans6.htm 6.1.0850 std C, NONE core_ws dpans6.htm 6.1.0860 std C@ NONE core_ws dpans6.htm 6.1.0870 std CELL+ NONE core_ws dpans6.htm 6.1.0880 std CELLS NONE core_ws dpans6.htm 6.1.0890 std CHAR+ NONE core_ws dpans6.htm 6.1.0897 std CHARS NONE core_ws dpans6.htm 6.1.0898 std COUNT NONE core_ws dpans6.htm 6.1.0980 std CR NONE core_ws dpans6.htm 6.1.0990 std DEPTH NONE core_ws dpans6.htm 6.1.1200 std DO NONE core_ws dpans6.htm 6.1.1240 std DOES> NONE core_ws dpans6.htm 6.1.1250 std DROP NONE core_ws dpans6.htm 6.1.1260 std DUP NONE core_ws dpans6.htm 6.1.1290 std ELSE NONE core_ws dpans6.htm 6.1.1310 std EMIT NONE core_ws dpans6.htm 6.1.1320 std ENVIRONMENT? NONE core_ws dpans6.htm 6.1.1345 std EVALUATE NONE core_ws dpans6.htm 6.1.1360 std EXECUTE NONE core_ws dpans6.htm 6.1.1370 std EXIT NONE core_ws dpans6.htm 6.1.1380 std FILL NONE core_ws dpans6.htm 6.1.1540 std FIND NONE core_ws dpans6.htm 6.1.1550 std FM/MOD NONE core_ws dpans6.htm 6.1.1561 std HERE NONE core_ws dpans6.htm 6.1.1650 std HOLD NONE core_ws dpans6.htm 6.1.1670 std I NONE core_ws dpans6.htm 6.1.1680 std IF NONE core_ws dpans6.htm 6.1.1700 std IMMEDIATE NONE core_ws dpans6.htm 6.1.1710 std INVERT NONE core_ws dpans6.htm 6.1.1720 std J NONE core_ws dpans6.htm 6.1.1730 std KEY NONE core_ws dpans6.htm 6.1.1750 std LEAVE NONE core_ws dpans6.htm 6.1.1760 std LITERAL NONE core_ws dpans6.htm 6.1.1780 std LOOP NONE core_ws dpans6.htm 6.1.1800 std LSHIFT NONE core_ws dpans6.htm 6.1.1805 std M* NONE core_ws dpans6.htm 6.1.1810 std MAX NONE core_ws dpans6.htm 6.1.1870 std MIN NONE core_ws dpans6.htm 6.1.1880 std MOD NONE core_ws dpans6.htm 6.1.1890 std MOVE NONE core_ws dpans6.htm 6.1.1900 std NEGATE NONE core_ws dpans6.htm 6.1.1910 std OR NONE core_ws dpans6.htm 6.1.1980 std OVER NONE core_ws dpans6.htm 6.1.1990 std POSTPONE NONE core_ws dpans6.htm 6.1.2033 std QUIT NONE core_ws dpans6.htm 6.1.2050 std R> NONE core_ws dpans6.htm 6.1.2060 std R@ NONE core_ws dpans6.htm 6.1.2070 std RECURSE NONE core_ws dpans6.htm 6.1.2120 std REPEAT NONE core_ws dpans6.htm 6.1.2140 std ROT NONE core_ws dpans6.htm 6.1.2160 std RSHIFT NONE core_ws dpans6.htm 6.1.2162 std S>D NONE core_ws dpans6.htm 6.1.2170 std SIGN NONE core_ws dpans6.htm 6.1.2210 std SM/REM NONE core_ws dpans6.htm 6.1.2214 std SOURCE NONE core_ws dpans6.htm 6.1.2216 std SPACE NONE core_ws dpans6.htm 6.1.2220 std SPACES NONE core_ws dpans6.htm 6.1.2230 std STATE NONE core_ws dpans6.htm 6.1.2250 std SWAP NONE core_ws dpans6.htm 6.1.2260 std THEN NONE core_ws dpans6.htm 6.1.2270 std TYPE NONE core_ws dpans6.htm 6.1.2310 std U. NONE core_ws dpans6.htm 6.1.2320 std U< NONE core_ws dpans6.htm 6.1.2340 std UM* NONE core_ws dpans6.htm 6.1.2360 std UM/MOD NONE core_ws dpans6.htm 6.1.2370 std UNLOOP NONE core_ws dpans6.htm 6.1.2380 std UNTIL NONE core_ws dpans6.htm 6.1.2390 std WHILE NONE core_ws dpans6.htm 6.1.2430 std XOR NONE core_ws dpans6.htm 6.1.2490 std #TIB NONE core_ext_ws dpans6.htm 6.2.0060 std .R NONE core_ext_ws dpans6.htm 6.2.0210 std 0<> NONE core_ext_ws dpans6.htm 6.2.0260 std 0> NONE core_ext_ws dpans6.htm 6.2.0280 std 2>R NONE core_ext_ws dpans6.htm 6.2.0340 std 2R> NONE core_ext_ws dpans6.htm 6.2.0410 std 2R@ NONE core_ext_ws dpans6.htm 6.2.0415 std :NONAME NONE core_ext_ws dpans6.htm 6.2.0455 std <> NONE core_ext_ws dpans6.htm 6.2.0500 std ?DO NONE core_ext_ws dpans6.htm 6.2.0620 std AGAIN NONE core_ext_ws dpans6.htm 6.2.0700 std CASE NONE core_ext_ws dpans6.htm 6.2.0873 std COMPILE, NONE core_ext_ws dpans6.htm 6.2.0945 std CONVERT NONE core_ext_ws dpans6.htm 6.2.0970 std ENDCASE NONE core_ext_ws dpans6.htm 6.2.1342 std ENDOF NONE core_ext_ws dpans6.htm 6.2.1343 std ERASE NONE core_ext_ws dpans6.htm 6.2.1350 std EXPECT NONE core_ext_ws dpans6.htm 6.2.1390 std NIP NONE core_ext_ws dpans6.htm 6.2.1930 std OF NONE core_ext_ws dpans6.htm 6.2.1950 std PAD NONE core_ext_ws dpans6.htm 6.2.2000 std PICK NONE core_ext_ws dpans6.htm 6.2.2030 std QUERY NONE core_ext_ws dpans6.htm 6.2.2040 std REFILL NONE core_ext_ws dpans6.htm 6.2.2125 std RESTORE-INPUT NONE core_ext_ws dpans6.htm 6.2.2148 std ROLL NONE core_ext_ws dpans6.htm 6.2.2150 std SAVE-INPUT NONE core_ext_ws dpans6.htm 6.2.2182 std SOURCE-ID NONE core_ext_ws dpans6.htm 6.2.2218 std SPAN NONE core_ext_ws dpans6.htm 6.2.2240 std TIB NONE core_ext_ws dpans6.htm 6.2.2290 std TO NONE core_ext_ws dpans6.htm 6.2.2295 std TRUE NONE numeric dpans6.htm 6.2.2298 std TUCK NONE core_ext_ws dpans6.htm 6.2.2300 std U.R NONE core_ext_ws dpans6.htm 6.2.2330 std U> NONE core_ext_ws dpans6.htm 6.2.2350 std UNUSED NONE core_ext_ws dpans6.htm 6.2.2395 std WITHIN NONE core_ext_ws dpans6.htm 6.2.2440 std [COMPILE] NONE core_ext_ws dpans6.htm 6.2.2530 std BLK NONE block_ws dpans7.htm 7.6.1.0790 std BLOCK NONE block_ws dpans7.htm 7.6.1.0800 std BUFFER NONE block_ws dpans7.htm 7.6.1.0820 std FLUSH NONE block_ws dpans7.htm 7.6.1.1559 std LOAD NONE block_ws dpans7.htm 7.6.1.1790 std SAVE-BUFFERS NONE block_ws dpans7.htm 7.6.1.2180 std UPDATE NONE block_ws dpans7.htm 7.6.1.2400 std EMPTY-BUFFERS NONE block_ws dpans7.htm 7.6.2.1330 std LIST NONE block_ws dpans7.htm 7.6.2.1770 std SCR NONE block_ws dpans7.htm 7.6.2.2190 std THRU NONE block_ws dpans7.htm 7.6.2.2280 std 2LITERAL NONE double_ws dpans8.htm 8.6.1.0390 std D+ NONE double_ws dpans8.htm 8.6.1.1040 std D- NONE double_ws dpans8.htm 8.6.1.1050 std D. NONE double_ws dpans8.htm 8.6.1.1060 std D.R NONE double_ws dpans8.htm 8.6.1.1070 std D0< NONE double_ws dpans8.htm 8.6.1.1075 std D0= NONE double_ws dpans8.htm 8.6.1.1080 std D2* NONE double_ws dpans8.htm 8.6.1.1090 std D2/ NONE double_ws dpans8.htm 8.6.1.1100 std D< NONE double_ws dpans8.htm 8.6.1.1110 std D= NONE double_ws dpans8.htm 8.6.1.1120 std D>S NONE double_ws dpans8.htm 8.6.1.1140 std DABS NONE double_ws dpans8.htm 8.6.1.1160 std DMAX NONE double_ws dpans8.htm 8.6.1.1210 std DMIN NONE double_ws dpans8.htm 8.6.1.1220 std DNEGATE NONE double_ws dpans8.htm 8.6.1.1230 std M*/ NONE double_ws dpans8.htm 8.6.1.1820 std M+ NONE double_ws dpans8.htm 8.6.1.1830 std 2ROT NONE double_ws dpans8.htm 8.6.2.0420 std DU< NONE double_ws dpans8.htm 8.6.2.1270 std CATCH NONE exception_ws dpans9.htm 9.6.1.0875 std THROW NONE exception_ws dpans9.htm 9.6.1.2275 std AT-XY NONE facilities_ws dpans10.htm 10.6.1.0742 std KEY? NONE facilities_ws dpans10.htm 10.6.1.1755 std PAGE NONE facilities_ws dpans10.htm 10.6.1.2005 std EKEY NONE facilities_ws dpans10.htm 10.6.2.1305 std EKEY>CHAR NONE facilities_ws dpans10.htm 10.6.2.1306 std EKEY? NONE facilities_ws dpans10.htm 10.6.2.1307 std EMIT? NONE facilities_ws dpans10.htm 10.6.2.1325 std MS NONE facilities_ws dpans10.htm 10.6.2.1905 std TIME&DATE NONE facilities_ws dpans10.htm 10.6.2.2292 std BIN NONE file_ws dpans11.htm 11.6.1.0765 std CLOSE-FILE NONE file_ws dpans11.htm 11.6.1.0900 std CREATE-FILE NONE file_ws dpans11.htm 11.6.1.1010 std DELETE-FILE NONE file_ws dpans11.htm 11.6.1.1190 std FILE-POSITION NONE file_ws dpans11.htm 11.6.1.1520 std FILE-SIZE NONE file_ws dpans11.htm 11.6.1.1522 std INCLUDE-FILE NONE file_ws dpans11.htm 11.6.1.1717 std OPEN-FILE NONE file_ws dpans11.htm 11.6.1.1970 std R/O NONE file_ws dpans11.htm 11.6.1.2054 std R/W NONE file_ws dpans11.htm 11.6.1.2056 std READ-FILE NONE file_ws dpans11.htm 11.6.1.2080 std READ-LINE NONE file_ws dpans11.htm 11.6.1.2090 std REPOSITION-FILE NONE file_ws dpans11.htm 11.6.1.2142 std RESIZE-FILE NONE file_ws dpans11.htm 11.6.1.2147 std W/O NONE file_ws dpans11.htm 11.6.1.2425 std WRITE-FILE NONE file_ws dpans11.htm 11.6.1.2480 std WRITE-LINE NONE file_ws dpans11.htm 11.6.1.2485 std FILE-STATUS NONE file_ws dpans11.htm 11.6.2.1524 std FLUSH-FILE NONE file_ws dpans11.htm 11.6.2.1560 std RENAME-FILE NONE file_ws dpans11.htm 11.6.2.2130 std >FLOAT NONE fp_ws dpans12.htm 12.6.1.0558 std D>F NONE fp_ws dpans12.htm 12.6.1.1130 std F! NONE fp_ws dpans12.htm 12.6.1.1400 std F* NONE fp_ws dpans12.htm 12.6.1.1410 std F+ NONE fp_ws dpans12.htm 12.6.1.1420 std F- NONE fp_ws dpans12.htm 12.6.1.1425 std F/ NONE fp_ws dpans12.htm 12.6.1.1430 std F0< NONE fp_ws dpans12.htm 12.6.1.1440 std F0= NONE fp_ws dpans12.htm 12.6.1.1450 std F< NONE fp_ws dpans12.htm 12.6.1.1460 std F>D NONE fp_ws dpans12.htm 12.6.1.1460 std F@ NONE fp_ws dpans12.htm 12.6.1.1472 std FALIGN NONE fp_ws dpans12.htm 12.6.1.1479 std FALIGNED NONE fp_ws dpans12.htm 12.6.1.1483 std FDEPTH NONE fp_ws dpans12.htm 12.6.1.1497 std FDROP NONE fp_ws dpans12.htm 12.6.1.1500 std FDUP NONE fp_ws dpans12.htm 12.6.1.1510 std FLITERAL NONE fp_ws dpans12.htm 12.6.1.1552 std FLOAT+ NONE fp_ws dpans12.htm 12.6.1.1555 std FLOATS NONE fp_ws dpans12.htm 12.6.1.1556 std FLOOR NONE fp_ws dpans12.htm 12.6.1.1558 std FMAX NONE fp_ws dpans12.htm 12.6.1.1562 std FMIN NONE fp_ws dpans12.htm 12.6.1.1565 std FNEGATE NONE fp_ws dpans12.htm 12.6.1.1567 std FOVER NONE fp_ws dpans12.htm 12.6.1.1600 std FROT NONE fp_ws dpans12.htm 12.6.1.1610 std FROUND NONE fp_ws dpans12.htm 12.6.1.1612 std FSWAP NONE fp_ws dpans12.htm 12.6.1.1620 std REPRESENT NONE fp_ws dpans12.htm 12.6.1.2143 std DF! NONE fp_ws dpans12.htm 12.6.2.1203 std DF@ NONE fp_ws dpans12.htm 12.6.2.1204 std DFALIGN NONE fp_ws dpans12.htm 12.6.2.1205 std DFALIGNED NONE fp_ws dpans12.htm 12.6.2.1207 std DFLOAT+ NONE fp_ws dpans12.htm 12.6.2.1208 std DFLOATS NONE fp_ws dpans12.htm 12.6.2.1209 std F** NONE fp_ws dpans12.htm 12.6.2.1415 std F. NONE fp_ws dpans12.htm 12.6.2.1427 std FABS NONE fp_ws dpans12.htm 12.6.2.1474 std FACOS NONE fp_ws dpans12.htm 12.6.2.1476 std FACOSH NONE fp_ws dpans12.htm 12.6.2.1477 std FALOG NONE fp_ws dpans12.htm 12.6.2.1484 std FASIN NONE fp_ws dpans12.htm 12.6.2.1486 std FASINH NONE fp_ws dpans12.htm 12.6.2.1487 std FATAN NONE fp_ws dpans12.htm 12.6.2.1488 std FATAN2 NONE fp_ws dpans12.htm 12.6.2.1489 std FATANH NONE fp_ws dpans12.htm 12.6.2.1491 std FCOS NONE fp_ws dpans12.htm 12.6.2.1493 std FCOSH NONE fp_ws dpans12.htm 12.6.2.1494 std FE. NONE fp_ws dpans12.htm 12.6.2.1513 std FEXP NONE fp_ws dpans12.htm 12.6.2.1515 std FEXPM1 NONE fp_ws dpans12.htm 12.6.2.1516 std FLN NONE fp_ws dpans12.htm 12.6.2.1553 std FLNP1 NONE fp_ws dpans12.htm 12.6.2.1554 std FLOG NONE fp_ws dpans12.htm 12.6.2.1557 std FS. NONE fp_ws dpans12.htm 12.6.2.1613 std FSIN NONE fp_ws dpans12.htm 12.6.2.1614 std FSINCOS NONE fp_ws dpans12.htm 12.6.2.1616 std FSINH NONE fp_ws dpans12.htm 12.6.2.1617 std FSQRT NONE fp_ws dpans12.htm 12.6.2.1618 std FTAN NONE fp_ws dpans12.htm 12.6.2.1625 std FTANH NONE fp_ws dpans12.htm 12.6.2.1626 std F~ NONE fp_ws dpans12.htm 12.6.2.1640 std PRECISION NONE fp_ws dpans12.htm 12.6.2.2035 std SET-PRECISION NONE fp_ws dpans12.htm 12.6.2.2200 std SF! NONE fp_ws dpans12.htm 12.6.2.2202 std SF@ NONE fp_ws dpans12.htm 12.6.2.2203 std SFALIGN NONE fp_ws dpans12.htm 12.6.2.2204 std SFALIGNED NONE fp_ws dpans12.htm 12.6.2.2206 std SFLOAT+ NONE fp_ws dpans12.htm 12.6.2.2207 std SFLOATS NONE fp_ws dpans12.htm 12.6.2.2208 std (LOCAL) NONE local_ws dpans13.htm 13.6.1.0086 std ALLOCATE NONE malloc_ws dpans14.htm 14.6.1.0707 std FREE NONE malloc_ws dpans14.htm 14.6.1.1605 std RESIZE NONE malloc_ws dpans14.htm 14.6.1.2145 std .S NONE progtools_ws dpans15.htm 15.6.1.0220 std ? NONE progtools_ws dpans15.htm 15.6.1.0600 std DUMP NONE progtools_ws dpans15.htm 15.6.1.1280 std SEE NONE progtools_ws dpans15.htm 15.6.1.2194 std WORDS NONE progtools_ws dpans15.htm 15.6.1.2465 std AHEAD NONE progtools_ws dpans15.htm 15.6.2.0702 std ASSEMBLER NONE progtools_ws dpans15.htm 15.6.2.0740 std BYE NONE progtools_ws dpans15.htm 15.6.2.0830 std CS-PICK NONE progtools_ws dpans15.htm 15.6.2.1015 std CS-ROLL NONE progtools_ws dpans15.htm 15.6.2.1020 std EDITOR NONE progtools_ws dpans15.htm 15.6.2.1300 std FORGET NONE progtools_ws dpans15.htm 15.6.2.1580 std [ELSE] NONE progtools_ws dpans15.htm 15.6.2.2531 std [THEN] NONE progtools_ws dpans15.htm 15.6.2.2533 std DEFINITIONS NONE searchord_ws dpans16.htm 16.6.1.1180 std FORTH-WORDLIST NONE searchord_ws dpans16.htm 16.6.1.1595 std GET-CURRENT NONE searchord_ws dpans16.htm 16.6.1.1643 std GET-ORDER NONE searchord_ws dpans16.htm 16.6.1.1647 std SEARCH-WORDLIST NONE searchord_ws dpans16.htm 16.6.1.2192 std SET-CURRENT NONE searchord_ws dpans16.htm 16.6.1.2195 std SET-ORDER NONE searchord_ws dpans16.htm 16.6.1.2197 std WORDLIST NONE searchord_ws dpans16.htm 16.6.1.2460 std ALSO NONE searchord_ws dpans16.htm 16.6.2.0715 std FORTH NONE searchord_ws dpans16.htm 16.6.2.1590 std ONLY NONE searchord_ws dpans16.htm 16.6.2.1965 std ORDER NONE searchord_ws dpans16.htm 16.6.2.1985 std PREVIOUS NONE searchord_ws dpans16.htm 16.6.2.2037 std -TRAILING NONE string_ws dpans17.htm 17.6.1.0170 std /STRING NONE string_ws dpans17.htm 17.6.1.0245 std BLANK NONE string_ws dpans17.htm 17.6.1.0780 std CMOVE NONE string_ws dpans17.htm 17.6.1.0910 std CMOVE> NONE string_ws dpans17.htm 17.6.1.0920 std COMPARE NONE string_ws dpans17.htm 17.6.1.0935 std SEARCH NONE string_ws dpans17.htm 17.6.1.2191 std SLITERAL NONE string_ws dpans17.htm 17.6.1.2212 sys-warning-on \ /5a/ _DEFINITIONS \ Revision history \ 0. 1st release to guinea pigs via comp.lang.forth \ 1. Added multi-line comment 0 [IF]. Colored CHAR outside definitions. \ 2. (EJB) Added missing definitions for common but nonstandard words \ and cleaned up to account for case sensitivity. \ 3. (EJB) Fixed up to create conforming XHTML 1.0 Strict \ 4. (BNE) File check before nesting, moved file names to the hyperlink table, \ added some option flags, cleared hyperlink list for each run. Added more \ multiline comment words. Expands tabs to spaces. Title uses %20 for blanks. \ 4a. (DBU) Added dpanspath to configure the path to the dpans-files. Added \ linksource to output a hyperlink to the original source file. Added \ some words used in Win32Forth. Added footer to output a text at the bottom \ of the HTML-file. \ 4b. (DBU) Fixed some HTML-Error's found with "CSE HTML Validator Lite v3.50" \ 4c. (EJB/DBU) Consolidated some strings \ 4d. (DBU) Cleanup of 4c. \ 5. (BNE) Added multiline { comment. Replaced -1 WORD with [CHAR] |. \ Put hyperlinks that should not be overridden in a separate wordlist. \ 5a. (DBU) - Merged Rev 5 with 4d \ - Changed { to work as a multicoment and for locals. \ - Changed multicomment to color the terminator of the comments (( )) \ - and comment: comment; { } too. \ - Renamed col ,$ and header because they are used in Win32Forth \ - Added sys-warning-off & sys-warning-on to avoid "****System word: \ used in: at file..." messages when using Win32Forth. \ 6. (BNE) Limited text to 80 columns, cleaned up comments a bit. Added option \ for different color schemes. \ 6a. (DBU) - Merged Rev 6 with 5a \ - Minimized color changes in HTML output for comments. \ 7. (BNE) - Added some of Dirk's changes \ 7a. (DBU) - Merged Rev 7 with 6a \ - Added more words used in Win32Forth. \ - Added support for locals. \ 7b. (BNE) - Made ALIAS a defining word. \ 7c. (BNE) - Made ( multi-line.