Author: stepan Date: 2006-10-30 17:25:35 +0100 (Mon, 30 Oct 2006) New Revision: 107
Added: fcode-utils/testsuite/TokBrack/TokBrkTst_04.fth fcode-utils/testsuite/TokMisc/ContErr0.fth fcode-utils/testsuite/TokMisc/DtkVSFcTst.scr fcode-utils/testsuite/TokMisc/VSFCtest.fth fcode-utils/testsuite/TokMisc/VendSpecFCodes fcode-utils/testsuite/TokeErrs/DecodProp.fth fcode-utils/testsuite/TokoLoco/GlobalLocalValuesDevel.fth fcode-utils/testsuite/TokoLoco/LocalValuesDevelSupport.fth fcode-utils/testsuite/TokoLoco/LocalValuesSupport.fth fcode-utils/testsuite/TokoLoco/TotalLocalValuesSupport.fth Removed: fcode-utils/testsuite/TokMisc/OldTkzr/ Modified: fcode-utils/testsuite/TokBrack/TestArgs fcode-utils/testsuite/TokCondl/CondMacAlias_01.fth fcode-utils/testsuite/TokCondl/TestArgs fcode-utils/testsuite/TokMisc/AllBiFCTypes.fth fcode-utils/testsuite/TokMisc/ContErr3.fth fcode-utils/testsuite/TokMisc/MiscFeatures.DOS.fth fcode-utils/testsuite/TokMisc/MiscFeatures.fth fcode-utils/testsuite/TokMisc/StringsGenl.fth fcode-utils/testsuite/TokMisc/TestArgs fcode-utils/testsuite/TokeErrs/DevImbal.fth fcode-utils/testsuite/TokeErrs/DupNams.fth fcode-utils/testsuite/TokeErrs/MiscFeatErrs.fth fcode-utils/testsuite/TokeErrs/TestArgs fcode-utils/testsuite/TokoLoco/GlobalLocalValues.fth fcode-utils/testsuite/TokoLoco/TestArgs Log: update testsuite to 1.0.2
Modified: fcode-utils/testsuite/TokBrack/TestArgs =================================================================== --- fcode-utils/testsuite/TokBrack/TestArgs 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokBrack/TestArgs 2006-10-30 16:25:35 UTC (rev 107) @@ -10,7 +10,7 @@ # Lines that have no label, no switches, and no script # do not need any commas.
-# Updated Wed, 08 Mar 2006 at 19:11 PST by David L. Paktor +# Updated Wed, 11 Oct 2006 at 24:44 PDT by David L. Paktor
# Might as well get the date-and-time one out of the way first... TokBrkTst_02 , , -i -l @@ -18,3 +18,4 @@ TokBrkTst_01 , alwyshdr , -i -f ALWays-heADers TokBrkTst_03 TokBrkErrTst_01 , , -i +TokBrkTst_04 , , -i -T pele_yoetz_ne-ema-an_anochi_hu_ha-omer_v-oseh_v-ain_c-moni_bchol_ha_aretz -T whatsis
Added: fcode-utils/testsuite/TokBrack/TokBrkTst_04.fth =================================================================== --- fcode-utils/testsuite/TokBrack/TokBrkTst_04.fth (rev 0) +++ fcode-utils/testsuite/TokBrack/TokBrkTst_04.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,76 @@ +\ Test of long names and duplication of names and maybe Tracing +\ Updated Wed, 18 Oct 2006 at 13:34 PDT by David L. Paktor + +fcode-version2 + +global-definitions + +true constant flunky? + +alias whoosis whatsis +alias whatsis whoosis + +external +decimal + +100 constant pele_yoetz_ne-ema-an_anochi_hu_ha-omer_v-oseh_v-ain_c-moni_bchol_ha_aretz + +device-definitions + +headers + +h# 3760 constant whatsis + +#message" Sync Up Diffs w/ prev. release."n" +alias whoosis pele_yoetz_ne-ema-an_anochi_hu_ha-omer_v-oseh_v-ain_c-moni_bchol_ha_aretz +#message" +Sync Up again."n" +headerless +: pele_yoetz_ne-ema-an_anochi_hu_ha-omer_v-oseh_v-ain_c-moni_bchol_ha_aretz + 100 +; +pele_yoetz_ne-ema-an_anochi_hu_ha-omer_v-oseh_v-ain_c-moni_bchol_ha_aretz 2 * constant clone + +\ Make sure the matching goes all the way... +instance +: pele_yoetz_ne-ema-an_anochi_hu_ha-omer_v-oseh_v-ain_c-moni_bchol_ha_oilum + clone + ['] whoosis execute +; + +new-device +80 constant this_name_has_a_whole_lot_of_syllables_and_so_would_not_be_a_good_ingredient_in_ice_cream_but_at_least_you_know_what_it_means + +headers + f[ 1cec6ea3 constant a_name_with_too_many_letters_should_not_matter_in_tokenizer_escape_mode + ]f + +: brand-x-ice-cream \ Because it uses ingredients with too many syllables + pele_yoetz_ne-ema-an_anochi_hu_ha-omer_v-oseh_v-ain_c-moni_bchol_ha_aretz dup 20 - do i . loop cr + ." Nameless one..." this_name_has_a_whole_lot_of_syllables_and_so_would_not_be_a_good_ingredient_in_ice_cream_but_at_least_you_know_what_it_means ." equals " . cr + ." But everyone likes an " + f[ a_name_with_too_many_letters_should_not_matter_in_tokenizer_escape_mode + f] fliteral . + clone . cr +; + +flunky? if + d# 3760 constant whatsis +else + d# 374 constant whatsis +then + + +finish-device + +overload : clone + pele_yoetz_ne-ema-an_anochi_hu_ha-omer_v-oseh_v-ain_c-moni_bchol_ha_aretz + pele_yoetz_ne-ema-an_anochi_hu_ha-omer_v-oseh_v-ain_c-moni_bchol_ha_oilum + whatsis + whoosis +; + +end0 + + +
Modified: fcode-utils/testsuite/TokCondl/CondMacAlias_01.fth =================================================================== --- fcode-utils/testsuite/TokCondl/CondMacAlias_01.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokCondl/CondMacAlias_01.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -76,7 +76,7 @@ f[ ." Let's try some spurious [else] action, whaddya say?" ]f : [else] ." Don't do it" ; [message] Fake [else] got through create [else] [message] Fake [else] got through - h# defeca8e constant [else] [message] Fake [else] got through + h# DeFeCA8e constant [else] [message] Fake [else] got through h# -41100132 value [else] [message] Fake [else] got through d# 64 buffer: [else] [message] Fake [else] got through struct
Modified: fcode-utils/testsuite/TokCondl/TestArgs =================================================================== --- fcode-utils/testsuite/TokCondl/TestArgs 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokCondl/TestArgs 2006-10-30 16:25:35 UTC (rev 107) @@ -10,7 +10,7 @@ # Lines that have no label, no switches, and no script # do not need any commas.
-# Updated Thu, 27 Jul 2006 at 15:20 PDT by David L. Paktor +# Updated Fri, 13 Oct 2006 at 16:19 PDT by David L. Paktor
TokExstCondTstY , , -l TokExstCondTstN , , -l
Modified: fcode-utils/testsuite/TokMisc/AllBiFCTypes.fth =================================================================== --- fcode-utils/testsuite/TokMisc/AllBiFCTypes.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokMisc/AllBiFCTypes.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -1,7 +1,7 @@ \ Test all the known Built-In FCode tokens \ that have specific definition Types
-\ Updated Wed, 16 Aug 2006 at 14:30 PDT by David L. Paktor +\ Updated Tue, 10 Oct 2006 at 11:00 PDT by David L. Paktor
\ Applying "TO" to them ought to generate errors \ except for the ones that legitimately take "TO", @@ -9,7 +9,6 @@
fcode-version2
- [message] Constants. Should generate errors d# 10 to -1 ( CONST ) d# 10 to -1 ( CONST ) @@ -61,4 +60,12 @@ h# 12 to span ( VRBLE ) h# 12 to state ( VRBLE )
+multi-line #message" Using ['] on words that are both FWords and FCodes "\ + should generate no errors" +['] new-device drop +['] finish-device drop +['] offset16 drop +['] instance drop +['] end0 drop + fcode-end
Added: fcode-utils/testsuite/TokMisc/ContErr0.fth =================================================================== --- fcode-utils/testsuite/TokMisc/ContErr0.fth (rev 0) +++ fcode-utils/testsuite/TokMisc/ContErr0.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,73 @@ +\ Test Erroneous Control Constructs, cunningly contrived +\ to pass the "Old" tokenizer, which doesn't have the +\ check for Control-Structure matching. + +\ Updated Thu, 29 Jun 2006 at 14:52 PDT by David L. Paktor + + +fcode-version2 + +headers + +: garfield + ." if" if + ." begin" begin + \ \ Leave this out because Old tokenizer duzzent dew it rite.... + \ ." Question-Leave?" ?leave + ." 0 if unloop exit then" 0 if unloop exit then + ." Would you be leave..." leave + ." loop?" loop + ." Done with garfield" +; + +: odie + ." 0 0 ?do" 0 0 ?do + ." i drop" i drop + ." zero if unloop exit then" 0 if unloop exit then + ." Who would be leave..." leave + ." again" again + ." then" then + ." Done with odie" +; + +." Outside of colon" +." 1 0 do" 1 0 do + i constant what? ." This is actually supposed to be legit..." +." again" again +." then" then +." Was that awful or what?" + +\ Snippet similar to something in Firmworks manual + +h# 5000 constant /DHCP-SCRATCH + +/DHCP-SCRATCH ( size ) ['] alloc-mem +." dhcp-scratch alloc-mem" cr .s cr +catch +." catch dhcp-scratch alloc-mem" cr .s cr +?dup if + ." alloc-mem Failed!!!" cr .s cr + throw + ." This is also worng..." exit +else + ." alloc-mem okay." .s cr + ( vaddr ) + ( vaddr ) constant DHCP-SCRATCH +then + +\ A CASE statement where the ENDOFs are missing +\ still passes the "Old" tokenizer. + +: crazy-aces ( n -- ) + case + 0 of ." And a-nutt'n'" + 1 of ." And a-won" + 2 of ." And a-too" + 3 of ." And a-tree" + 4 of ." and afford" + 5 of ." Dat's enuff" + ( default ) ." It's not my default!" + endcase ." Just in case you end up here..." +; + +fcode-end
Modified: fcode-utils/testsuite/TokMisc/ContErr3.fth =================================================================== --- fcode-utils/testsuite/TokMisc/ContErr3.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokMisc/ContErr3.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -132,8 +132,8 @@ then loop
-#message" Same line as a loop" ." ...Same line as a loop" - +#message" + Same line as a loop" ." ...Same line as a loop" 4 0 do i test_something if to targ : runny_stuff begin 1 0 do targ u. #message" Error here, too..." j #message" But not here either" 1 0 do j . loop
Added: fcode-utils/testsuite/TokMisc/DtkVSFcTst.scr =================================================================== --- fcode-utils/testsuite/TokMisc/DtkVSFcTst.scr (rev 0) +++ fcode-utils/testsuite/TokMisc/DtkVSFcTst.scr 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,41 @@ +#! /bin/csh -f +# +# Script to run detokenizer with Vendor-Specific FCodes. +# This worked just fine on the TestArgs command line, in the "script" field +# on CygWin and GNU_Linux, but gets jammed-up on AI +# So we have to pump it into a separate script. Fooey! +# +# Well, in for a penny and all that...X +# Let's make it a bit more general. +# First param is the base-name of both the input .fc file +# and the output .DeTok file +# Second param is the name of the Vendor-Specific FCodes file + +# If it's already a script, might as well error-check +alias onecr 'echo "" ; alias onecr true' +if ( $#argv < 1 ) then + onecr + echo $0 Missing First arg, Base-name of input .fc and output .DeTok files + set ERROR +endif +if ( $#argv < 2 ) then + onecr + echo $0 Missing Second arg, Name of the Vendor-Specific FCodes file + set ERROR +endif +if ( $?ERROR ) exit 1 + +if ( ! -r $1.fc ) then + onecr + echo $0 Cannot read input file $1.fc + set ERROR +endif +if ( ! -r $2 ) then + onecr + echo $0 Cannot read Vendor-Specific FCodes file $2 + set ERROR +endif +if ( $?ERROR ) exit 2 + + +../detok -v -o -f $2 $1.fc > $1.DeTok
Property changes on: fcode-utils/testsuite/TokMisc/DtkVSFcTst.scr ___________________________________________________________________ Name: svn:executable + *
Modified: fcode-utils/testsuite/TokMisc/MiscFeatures.DOS.fth =================================================================== --- fcode-utils/testsuite/TokMisc/MiscFeatures.DOS.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokMisc/MiscFeatures.DOS.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -1,7 +1,6 @@ \ Obvious pun intended... -\ Updated Tue, 31 May 2005 at 12:07 by David L. Paktor +\ Updated Tue, 17 Oct 2006 at 12:57 PDT by David L. Paktor
- alias // \ fcode-version2
@@ -12,21 +11,41 @@ char G emit control G emit control [ emit +global-definitions +\ Each dev-node will create its own debug-flag and alias it to debug-me? +\ Each dev-node will create a macro called my-dev-name giving its device-name + [macro] .fname&dev [function-name] type ." in " my-dev-name type + [macro] name-my-dev my-dev-name device-name + [macro] .dbg-enter debug-me? @ if ." Entering " .fname&dev cr then + [macro] .dbg-leave debug-me? @ if ." Leaving " .fname&dev cr then +device-definitions + +\ Top-most device, named billy +[macro] my-dev-name " billy" +name-my-dev + +variable debug-bell? debug-bell? off alias debug-me? debug-bell? : bell + .dbg-enter [char] G dup control G 3drop + .dbg-leave ;
: factl recursive ( n -- n! ) + ." Entering First vers. of " [function-name] type cr ?dup 0= if 1 - else dup 1- * factl + else dup 1- factl * then + ." Leaving First vers. of " [function-name] type cr ;
: factl ( n -- n! ) + ." Entering Second vers. of " [function-name] type cr ?dup 0= if 1 factl else dup 1- recurse * then + ." Leaving Second vers. of " [function-name] type cr ;
variable naught @@ -41,31 +60,88 @@ constant /four
: peril + .dbg-enter ['] noop is do-nothing 100 is thirty 5 is naught thirty dup - abort" Never Happen" + .dbg-leave ;
: thirty ( new-val -- ) + .dbg-enter dup to thirty alias .dec .d \ Should this be allowed? ." Dirty" .dec + .dbg-leave ; tokenizer[ alias fliteral1 fliteral // This should be a harmless remark. h# deadc0de ]tokenizer fliteral1
+\ First subsidiary device, "child" of billy +new-device + instance variable cheryl + [macro] my-dev-name " cheryl" + name-my-dev + + instance + \ Third-level device, "grandchild" of billy + new-device + [macro] my-dev-name " meryl" + name-my-dev + + variable beryl + + variable debug-meryl? debug-meryl? off + alias debug-me? debug-meryl? + : meryl + .dbg-enter + cheryl + alias .deck .dec + alias feral cheryl + alias .heck .h + .dbg-leave + ; + finish-device + + \ Now we're back to "cheryl" + + variable debug-cheryl? debug-cheryl? off + alias debug-me? debug-cheryl? + : queryl + .dbg-enter + over rot dup nip drop swap \ Not the most useful code... ;-} + .dbg-leave + ; +finish-device + +\ Some interpretation-time after the fact markers... +alias colon : +overload [macro] : ." Cleared " [input-file-name] type ." line " [line-number] .d cr colon + +alias semicolon ; +overload [macro] ; semicolon ." Finished defining " [function-name] type cr + +\ And we're back to billy. : droop ( -- ) + .dbg-enter \ This will display Entering droop in billy twenty tokenizer[ alias .x .h \ Should this generate a warning? + [function-name] ]tokenizer 0 ?do i .x loop -; + .dbg-leave +; f[ [function-name] ]f +headerless : ploop ( -- ) + .dbg-enter fifty 0 do i drop 2 +loop + .dbg-leave ; +overload alias : colon +overload alias ; semicolon
fcode-end
Modified: fcode-utils/testsuite/TokMisc/MiscFeatures.fth =================================================================== --- fcode-utils/testsuite/TokMisc/MiscFeatures.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokMisc/MiscFeatures.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -1,5 +1,5 @@ \ Obvious pun intended... -\ Updated Fri, 10 Feb 2006 at 15:53 PST by David L. Paktor +\ Updated Tue, 17 Oct 2006 at 12:57 PDT by David L. Paktor
alias // \ fcode-version2 @@ -116,22 +116,32 @@ ; finish-device
+\ Some interpretation-time after the fact markers... +alias colon : +overload [macro] : ." Cleared " [input-file-name] type ." line " [line-number] .d cr colon + +alias semicolon ; +overload [macro] ; semicolon ." Finished defining " [function-name] type cr + \ And we're back to billy. : droop ( -- ) .dbg-enter \ This will display Entering droop in billy twenty tokenizer[ alias .x .h \ Should this generate a warning? + [function-name] ]tokenizer 0 ?do i .x loop .dbg-leave -; +; f[ [function-name] ]f headerless : ploop ( -- ) .dbg-enter fifty 0 do i drop 2 +loop .dbg-leave ; +overload alias : colon +overload alias ; semicolon
fcode-end
Modified: fcode-utils/testsuite/TokMisc/StringsGenl.fth =================================================================== --- fcode-utils/testsuite/TokMisc/StringsGenl.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokMisc/StringsGenl.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -1,6 +1,6 @@ \ Test of various formats of strings
-\ Updated Mon, 06 Mar 2006 at 17:39 PST by David L. Paktor +\ Updated Tue, 10 Oct 2006 at 11:46 PDT by David L. Paktor
fcode-version2
@@ -9,13 +9,14 @@ ." Empty string next." ." " -." BSlashes: \t\1fea9\abdc\n\1f\fece" +." BSlashes#1: \t\1fea9\abdc\n\1f\fece" decimal -." BSlashes: \t\a7\c01a" +." BSlashes#2: \t\a7\c01a" +." Dec 1193176 = 0x1234D8 Dec 176 = 0xB0 \1193176" hex -." BSlashes: \n\a7\c01a" -." BSlashes: \t\a7\c0\1a" -." BSlashes: \t\a7\c0\1a"( feedface)" +." BSlashes#3: \n\a7\c01a" +." BSlashes#4: \t\a7\c0\1a" +." BSlashes#5: \t\a7\c0\1a"( feedface)" ." 3 BSlashes, then QOpen. \t\Q\n"(090abcdefeca8e beeffece b020)Zoh. "(1 23 4 567 8 9 0 1 2 3 0 a b c 30)" .( Dot-Paren-NoSpace)cr cr .( Dot-Paren Space) cr cr
Modified: fcode-utils/testsuite/TokMisc/TestArgs =================================================================== --- fcode-utils/testsuite/TokMisc/TestArgs 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokMisc/TestArgs 2006-10-30 16:25:35 UTC (rev 107) @@ -7,8 +7,9 @@ # A script-command with arguments (but no commas). # Lines that have no label, no switches, and no script # do not need any commas. +# A leading +V in the script-command field will suppress -v
-# Updated Thu, 07 Sep 2006 at 11:49 PDT by David L. Paktor +# Updated Mon, 16 Oct 2006 at 17:22 PDT by David L. Paktor
MiscFeatures , , -i MiscFeatures , applabq , -i -f NOSUN-ABORT-Quote @@ -23,15 +24,15 @@ StringsGenl , noqbsrmk , -f NOSTRING-REMARK-ESCAPE BasicCont ExtCont -OldTkzr/ContErr0 , , -i +ContErr0 , , -i ContErr1 , , -i ContErr2 , , -i ContErr3 , , -i MulDev , , -i MulDev_01 , , -i MulDev_02 , , -i -T jeeky -T kinky +MulDev_02 , NoV , -T jeeky -T kinky , +V MinPCIHtst -OldTkzr/SimplStrEscs StrEscs StrEscs_01 FlagSet , , -i @@ -72,3 +73,7 @@ BatchTst , Help , -I. -I../TokeCommon -l -h , rm *_cpy*
CaseTkns + +# Vendor-Specific FCodes, just a little... +VSFCtest +VSFCtest , VSfc , , DtkVSFcTst.scr VSFCtest.VSfc VendSpecFCodes
Added: fcode-utils/testsuite/TokMisc/VSFCtest.fth =================================================================== --- fcode-utils/testsuite/TokMisc/VSFCtest.fth (rev 0) +++ fcode-utils/testsuite/TokMisc/VSFCtest.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,62 @@ +\ Generate something that looks like FCode generated by a Very Custom Tokenizer + + +fcode-version1 + +headers +hex + +F[ + \ If we want to test this against the previous release, + \ we can't do this: 341 emit-fcode + \ Instead, we have to do it in two parts: + + 03 emit-byte 41 emit-byte \ 0341 = "Simple" Vendor-specific FCode" + ]F +-1 +dup 0> if +F[ + \ Likewise here 369 emit-fcode + 03 emit-byte 69 emit-byte \ 0369 = "double(lit)" + ff emit-byte + ff emit-byte + ff emit-byte + ff emit-byte + 00 emit-byte + 00 emit-byte + 00 emit-byte + 00 emit-byte + ]F +then +dup 0= if +F[ + \ Here, too 369 emit-fcode + 03 emit-byte 69 emit-byte \ 0369 = "double(lit)" + ff emit-byte + ff emit-byte + ff emit-byte + f0 emit-byte + 00 emit-byte + 00 emit-byte + 00 emit-byte + 00 emit-byte + ]F +then + +0< if +F[ + \ Last one 369 emit-fcode + 03 emit-byte 69 emit-byte \ 0369 = "double(lit)" + de emit-byte + fe emit-byte + ca emit-byte + 8e emit-byte + be emit-byte + ef emit-byte + fe emit-byte + ce emit-byte + ]F +then +constant moochie + +fcode-end
Added: fcode-utils/testsuite/TokMisc/VendSpecFCodes =================================================================== --- fcode-utils/testsuite/TokMisc/VendSpecFCodes (rev 0) +++ fcode-utils/testsuite/TokMisc/VendSpecFCodes 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,4 @@ +# Sample of Vendor-Specific FCodes for test + + 0x341 Three-for-One,aBargain! + 0x369 double(lit) Special-Function pre-defined name
Added: fcode-utils/testsuite/TokeErrs/DecodProp.fth =================================================================== --- fcode-utils/testsuite/TokeErrs/DecodProp.fth (rev 0) +++ fcode-utils/testsuite/TokeErrs/DecodProp.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,26 @@ +\ Updated Tue, 17 Oct 2006 at 15:32 PDT by David L. Paktor + + +fcode-version2 + +\ The classic definition, using the return-stack +[macro] decade-bites >r over r@ + swap r@ - rot r> + +" grubby-nit-picker" device-name +" bloated lackey of the capitalist toy-mongers" + encode-bytes " santa-claus" property + +" name" get-my-property if ." Sorry, Charlie!" +else + 6 decade-bites ." Starts with: " type + 2drop +then cr + + +" santa-claus" get-my-property if ." Eat flaming death!" +else + 7 decode-bytes ." Starts with: " type + 2drop +then cr + +fcode-end
Modified: fcode-utils/testsuite/TokeErrs/DevImbal.fth =================================================================== --- fcode-utils/testsuite/TokeErrs/DevImbal.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokeErrs/DevImbal.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -22,7 +22,12 @@ new-device create eek! 18 c, 17 c, 80 c, 79 c, : freek eek! 4 bounds ?do i c@ . 1 +loop ; -: greek -1 if freek then ; +: greek + recursive -1 if ." By name" greek + ." other name" freek + else ." Re-Curse you!" recurse + then +; [message] About to access method from parent node : hierareek eek!
Modified: fcode-utils/testsuite/TokeErrs/DupNams.fth =================================================================== --- fcode-utils/testsuite/TokeErrs/DupNams.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokeErrs/DupNams.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -1,10 +1,39 @@ \ Let's make a batch of duplicate definitions in various scopes...
-\ Updated Fri, 02 Jun 2006 at 09:48 PDT by David L. Paktor +\ Updated Thu, 12 Oct 2006 at 13:17 PDT by David L. Paktor
+\ Tracing: alley-oop boop croop doop drop dup foop +\ gloop _harpo hoop koop loop noop poop +\ shtoop zoop +\ fontbytes blink-screen base bell + +\ alley-oop +\ boop +\ croop Global Macro +\ doop +\ drop Built-in word, aliased, invoked +\ dup Built-in word +\ foop Global alias to dup +\ floop Global Macro, Alias to flop (alias to drop), +\ redefined in subordinate device +\ gloop Undefined, invoked +\ _harpo Local, in subordinate device +\ hoop +\ koop +\ loop Built-in word +\ noop Built-in word, redefined in second FCode block +\ poop +\ shtoop +\ zoop +\ fontbytes Built-in VALUE +\ blink-screen Built-in DEFER +\ base Built-in VARIABLE +\ bell Built-in CONSTANT + + alias foop dup
-[macro] croop foop message" Using FOOP " +[macro] croop foop #message" Using FOOP "
alias dup croop
@@ -22,7 +51,8 @@ global-definitions
alias flop drop -[macro] floop flop message" Using FLOOP " +#message" Sync Up Diffs w/ prev. Release."n"n" +[macro] floop flop #message" Using FLOOP " alias drop floop
device-definitions @@ -32,13 +62,15 @@ fcode-version2
: noop ." Op? No!" ; -[macro] zoop noop message" I Care." +[macro] zoop noop #message" I Care." : poop h# -21013572 ;
new-device : zoop ." Nothing like the other zoop" croop ; : croop ." Sort of like F-Troop with a higher GPA..." foop + drop + floop ; : foop ." Shop bop-a-looma, a-lop bam boom!" ; : floop ." Oh, Jiggly!" ; @@ -46,6 +78,7 @@ f[ 127 constant _harpo ]f poop -> _cheeko f[ _cheeko constant a__gent ]f + floop ;
alias droop drop @@ -59,6 +92,8 @@ _harpo droop drupe + boop + floop ; alias shoop encode-int
@@ -73,6 +108,18 @@
finish-device
+ : stoop + floop + gloop + shoop + ; + alias coop floop + : troop + shoop + coop + poop + ; + finish-device start4 \ Let's just stick in an extra, and another error besides... fcode-end
Modified: fcode-utils/testsuite/TokeErrs/MiscFeatErrs.fth =================================================================== --- fcode-utils/testsuite/TokeErrs/MiscFeatErrs.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokeErrs/MiscFeatErrs.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -1,11 +1,17 @@ \ Obvious pun intended... -\ Updated Fri, 14 Jul 2006 at 12:50 PDT by David L. Paktor +\ Updated Mon, 09 Oct 2006 at 09:57 PDT by David L. Paktor
[flag] Local-Values f[ ." This is a test" ]f fcode-version1
-fload LocalValuesSupport.fth +global-definitions + headers + h# 130 constant _local-storage-size_ + headerless +device-definitions + +fload TotalLocalValuesSupport.fth noop noop noop headers
@@ -59,10 +65,16 @@ _a _b + i * dup -> d _c * to _e j . loop + ['] _a + f['] _e + f[ f['] _b + f['] dup emit-fcode + h# 0f emit-fcode ]f + _a _b + _c * ['] + factl catch if ." Run in circles, scream and shout!" then ;
- : DMA-ALLOC ( n -- vaddr ) " dma-alloc" $call-parent ; : HOOBARTH ( n -- vaddr ) " hoobarth" $call-parent ; : MY-END0 ( -- n ) ['] end0 ;
Modified: fcode-utils/testsuite/TokeErrs/TestArgs =================================================================== --- fcode-utils/testsuite/TokeErrs/TestArgs 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokeErrs/TestArgs 2006-10-30 16:25:35 UTC (rev 107) @@ -13,21 +13,26 @@ # Most files in this category need the -i switch # Some may have additional variants.
-# Updated Thu, 07 Sep 2006 at 11:49 PDT by David L. Paktor +# Updated Wed, 18 Oct 2006 at 11:44 PDT by David L. Paktor
MiscFeatErrs , , -i -I. -I.. -LocalTest , NoLvSupp , -i -f Local-Values -I. -I.. -LocalTest , , -i -f Local-Values -I. -I.. -f Always-Headers -d dont_omit_support -LocalTest1 , , -f Local-Values -f noLV-Legacy-Message -I. -I.. +MiscFeatErrs , GLoc , -i -I. -I.. -d Global-Locals +MiscFeatErrs , LocR , -i -I. -I.. -d Locals-Release +MiscFeatErrs , GlLr , -i -I. -I.. -d Global-Locals -d Locals-Release +MiscFeatErrs , Lss , -i -I. -I.. -d _local-storage-size_=3022 +MiscFeatErrs , NoLss , -i -I. -I.. -d _local-storage-size_ +LocalTest , NoLvSupp , -i -f Local-Values -I. -I../TokoLoco +LocalTest , , -i -f Local-Values -I. -I../TokoLoco -f Always-Headers -d dont_omit_support +LocalTest1 , , -f Local-Values -f noLV-Legacy-Message -I. -I../TokoLoco ControlMismatch , , -i -SuppLocErrTest4 , , -i -f Local-Values -l -I. -I.. -testLocDevSupG , , -i -f Local-Values -I. -I.. -testLocDevSupG , SymSiz , -i -f Local-Values -d "_local-storage-size_= d# 120" -I. -I.. +SuppLocErrTest4 , , -i -f Local-Values -l -I. -I../TokoLoco +testLocDevSupG , , -i -f Local-Values -I. -I../TokoLoco +testLocDevSupG , SymSiz , -i -f Local-Values -d "_local-storage-size_= d# 120" -I. -I../TokoLoco PCIhdrErrs , , -i FCShdrErrs , , -i PCI_FCShdrErrs , , -i CommOvrRun , , -i -l -LocOvrRun , , -i -f Local-Values -l -I. -I.. +LocOvrRun , , -i -f Local-Values -l -I. -I../TokoLoco SplitImbal , , -i -l TokCondUnconcF , , -i -l TokCondUnconcT , , -i -l @@ -46,13 +51,13 @@ UserMacroErrors , , -i CStrEscOvflw , , -i -l DevImbal , , -i -DevNodAli , , -i -l -I. -I.. -DevNodAli_01 , , -i -l -I. -I.. -GlobScopErrTst , NoI , -f Local-Values -I. -I.. -GlobScopErrTst , , -i -f Local-Values -I. -I.. -GlobScopErrTst_01 , , -i -f Local-Values -I. -I.. -GlobScopErrTst_02 , , -i -f Local-Values -I. -I.. -GlobScopErrTst_03 , , -i -f Local-Values -I. -I.. +DevNodAli , , -i -l -I. -I../TokoLoco +DevNodAli_01 , , -i -l -I. -I../TokoLoco +GlobScopErrTst , NoI , -f Local-Values -I. -I../TokoLoco +GlobScopErrTst , , -i -f Local-Values -I. -I../TokoLoco +GlobScopErrTst_01 , , -i -f Local-Values -I. -I../TokoLoco +GlobScopErrTst_02 , , -i -f Local-Values -I. -I../TokoLoco +GlobScopErrTst_03 , , -i -f Local-Values -I. -I../TokoLoco # The script-fields below prepare for the ExpPath InclLst and DePList tests Frinstnce , , -i , touch ExpPath.NoV.{P,f{c,l{,.missing}}} Frinstnce , NoI , , chmod a-rw ../TokeCommon/{MyBeerAndYouCannotHaveIt.fth,NoRead.bin} ExpPath.NoV.{P,f{c,l{,.missing}}} @@ -69,7 +74,7 @@
# Done with the ExpPath and InclLst tests ToAtEnd , , -i -ToAtEnd , WLocSup , -i -I . -I .. +ToAtEnd , WLocSup , -i -I . -I ../TokoLoco ObsoFCodes , , -i ObsoFCodes , NoWarn , -f NoObsolete-FCode-Warning
@@ -84,7 +89,7 @@ AbrtWQuotStr , , -i
# The new "Trace" feature, and handling of duplicate and mis-scoped names... -DupNams , , -f Local-Values -T croop -T drop -T _harpo -T dup -T noop -T zoop -T foop +DupNams , , -f Local-Values -T alley-oop -T boop -T croop -T doop -T drop -T dup -T foop -T floop -T gloop -T _harpo -T koop -T loop -T noop -T poop -T shtoop -T zoop -T fontbytes -T blink-screen -T base -T bell
TooManyFCodes , , -l -o TooManyFCodes.fl TooManyFCodes , Reg , -i @@ -98,3 +103,6 @@
RetStkDep , , -i CondlDefn , , -i + +DecodProp +DecodProp , nrsi , -f noRet-Stk-Interp
Modified: fcode-utils/testsuite/TokoLoco/GlobalLocalValues.fth =================================================================== --- fcode-utils/testsuite/TokoLoco/GlobalLocalValues.fth 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokoLoco/GlobalLocalValues.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -1,7 +1,13 @@ +\ %Z%%M% %I% %W% %G% %U% +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + \ Load Locals Support under Global-Definitions. Bypass Instance warning
-\ Updated Fri, 10 Mar 2006 at 14:47 PST by David L. Paktor - \ Make sure this option is turned on. [flag] Local-Values
Added: fcode-utils/testsuite/TokoLoco/GlobalLocalValuesDevel.fth =================================================================== --- fcode-utils/testsuite/TokoLoco/GlobalLocalValuesDevel.fth (rev 0) +++ fcode-utils/testsuite/TokoLoco/GlobalLocalValuesDevel.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,31 @@ +\ %Z%%M% %I% %W% %G% %U% +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ Load Support file for development of FCode that uses Local Values +\ under Global-Definitions. Bypass Instance warning. +\ Replace this with GlobalLocalValues.fth in your final product. + +\ Make sure this option is turned on. +[flag] Local-Values + +global-definitions + +\ Bypass warning about Instance without altering LocalValuesSupport file +alias generic-instance instance +[macro] bypass-instance f[ noop .( Bypassed instance!) f] + +overload alias instance bypass-instance + +fload LocalValuesSupport.fth +fload LocalValuesDevelSupport.fth + +\ Replace normal meaning of Instance, still in Global scope. +overload alias instance generic-instance + +\ Restore Device-Definitions scope. +device-definitions
Added: fcode-utils/testsuite/TokoLoco/LocalValuesDevelSupport.fth =================================================================== --- fcode-utils/testsuite/TokoLoco/LocalValuesDevelSupport.fth (rev 0) +++ fcode-utils/testsuite/TokoLoco/LocalValuesDevelSupport.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,46 @@ +\ %Z%%M% %I% %W% %G% %U% +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ Support file for development of FCode that uses Local Values +\ FLoad this right after LocalValuesSupport.fth +\ Remove it from your final product. + +\ Exported Function: max-local-storage-size ( -- n ) +\ Returns the measured maximum size of storage for Local Values +\ used by any given test run. This number can be used to guide +\ the declaration of _local-storage-size_ +\ +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ Count the current depth on a per-instance basis, +\ but collect the maximum depth over all instances. + +headers +0 instance value local-storage-depth + +external +0 value max-local-storage-size +headers + +\ Overload the {push-locals} and {pop-locals} routines to do this. +\ Do not suppress the overload warnings; they'll serve as a reminder. +: {pop-locals} ( #locals -- ) + local-storage-depth over - to local-storage-depth + {pop-locals} +; + +: {push-locals} ( #ilocals #ulocals -- ) + 2dup + local-storage-depth + + dup to local-storage-depth + max-local-storage-size max + to max-local-storage-size + {push-locals} +; + +
Added: fcode-utils/testsuite/TokoLoco/LocalValuesSupport.fth =================================================================== --- fcode-utils/testsuite/TokoLoco/LocalValuesSupport.fth (rev 0) +++ fcode-utils/testsuite/TokoLoco/LocalValuesSupport.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,134 @@ +\ %Z%%M% %I% %W% %G% %U% +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ The support routines for Local Values in FCode. + +\ Function imported +\ _local-storage-size_ \ Size, in cells, of backing store for locals +\ \ A constant. If not supplied, default value of d# 64 will be used. +\ +\ Functions exported: +\ {push-locals} ( #ilocals #ulocals -- ) +\ {pop-locals} ( #locals -- ) +\ _{local} ( local-var# -- addr ) +\ +\ Additional overloaded function: +\ catch \ Restore Locals after a throw + +\ The user is responsible for declaring the maximum depth of the +\ run-time Locals stack, in storage units, by defining the +\ constant _local-storage-size_ before floading this file. +\ The definition may be created either by defining it as a constant +\ in the startup-file that FLOADs this and other files in the +\ source program, or via a command-line user-symbol definition +\ of a form resembling: -d '_local-storage-size_=d# 42' +\ (be sure to enclose it within quotes so that the shell treats +\ it as a single string, and, of course, replace the "42" with +\ the actual number you need...) +\ If both forms are present, the command-line user-symbol value will +\ be used to create a duplicate definition of the named constant, +\ which will prevail over the earlier definition, and will remain +\ available for examination during development and testing. The +\ duplicate-name warning, which will not be suppressed, will also +\ act to alert the developer of this condition. +\ To measure the actual usage (in a test run), use the separate tool +\ found in the file LocalValuesDevelSupport.fth . +\ If the user omits defining _local-storage-size_ the following +\ ten-line sequence will supply a default: + +[ifdef] _local-storage-size_ + f[ [defined] _local-storage-size_ true ]f +[else] + [ifexist] _local-storage-size_ + f[ false ]f + [else] + f[ d# 64 true ]f + [then] +[then] ( Compile-time: size true | false ) +[if] fliteral constant _local-storage-size_ [then] + +_local-storage-size_ \ The number of storage units to allocate + cells \ Convert to address units + dup \ Keep a copy around... + ( n ) instance buffer: locals-storage \ Use one of the copies + +\ The Locals Pointer, added to the base address of locals-storage +\ points to the base-address of the currently active set of Locals. +\ Locals will be accessed as a positive offset from there. +\ Start the Locals Pointer at end of the buffer. +\ A copy of ( N ), the number of address units that were allocated +\ for the buffer, is still on the stack. Use it here. + ( n ) instance value locals-pointer + +\ Support for {push-locals} + +\ Error-check. +: not-enough-locals? ( #ilocals #ulocals -- error? ) + + cells locals-pointer swap - 0< +; + +\ Error message. +: .not-enough-locals ( -- ) + cr ." FATAL ERROR: Local Values Usage exceeds allocation." cr +; + +\ Detect, announce and handle error. +: check-enough-locals ( #ilocals #ulocals -- | <ABORT> ) + not-enough-locals? if + .not-enough-locals + abort + then +; + +\ The uninitialized locals can be allocated in a single batch +: push-uninitted-locals ( #ulocals -- ) + cells locals-pointer swap - to locals-pointer +; + +\ The Initialized locals are initted from the items on top of the stack +\ at the start of the routine. If we allocate them one at a time, +\ we get them into the right order. I.e., the last-one named gets +\ the top item, the earlier ones get successively lower items. +: push-one-initted-local ( pstack-item -- ) + locals-pointer 1 cells - + dup to locals-pointer + locals-storage + ! +; + +\ Push all the Initialized locals. +: push-initted-locals ( N_#ilocals-1 ... N_0 #ilocals -- ) + 0 ?do push-one-initted-local loop +; + +: {push-locals} ( N_#ilocals ... N_1 #ilocals #ulocals -- ) + 2dup check-enough-locals + push-uninitted-locals ( ..... #i ) + push-initted-locals ( ) +; + +\ Pop all the locals. +\ The param is the number to pop. +: {pop-locals} ( total#locals -- ) + cells locals-pointer + to locals-pointer +; + +\ The address from/to which values will be moved, given the local-var# +: _{local} ( local-var# -- addr ) + cells locals-pointer + locals-storage + +; + +\ We need to overload catch such that the state of the Locals Pointer +\ will be preserved and restored after a throw . +overload : catch ( ??? xt -- ???' false | ???'' throw-code ) + locals-pointer >r ( ??? xt ) ( R: old-locals-ptr ) + catch ( ???' false | ???'' throw-code ) ( R: old-locals-ptr ) + \ No need to inspect the throw-code. + \ If catch returned a zero, the Locals Pointer + \ is valid anyway, so restoring it is harmless. + r> to locals-pointer +;
Modified: fcode-utils/testsuite/TokoLoco/TestArgs =================================================================== --- fcode-utils/testsuite/TokoLoco/TestArgs 2006-10-30 13:26:11 UTC (rev 106) +++ fcode-utils/testsuite/TokoLoco/TestArgs 2006-10-30 16:25:35 UTC (rev 107) @@ -12,18 +12,18 @@ # All files in this category need the -f Local-Values switch # Some will have additional variants.
-# Updated Mon, 20 Mar 2006 at 11:18 PST by David L. Paktor +# Updated Fri, 13 Oct 2006 at 16:19 PDT by David L. Paktor
-testNest , , -f Local-Values -l -I. -I.. -SupportedLocalTest , , -f LOCAL-Values -l -I. -I.. -SupportedLocalTest3 , , -f Local-VALUES -l -I. -I.. -SupportedLocalTest4 , , -f Local-Values -l -I. -I.. -testDevelSupport , , -f local-values -I. -I.. +testNest , , -f Local-Values -l +SupportedLocalTest , , -f LOCAL-Values -l +SupportedLocalTest3 , , -f Local-VALUES -l +SupportedLocalTest4 , , -f Local-Values -l +testDevelSupport , , -f local-values
# Additional variants: -SupportedLocalTest , nodupwrn , -f Local-VALUES -f NOWarn-if-DUPLicate -l -I. -I.. -SupportedLocalTest , nolegacy , -f LoCAL-VALUes -f NoLV-Legacy-Separator -l -I. -I.. -SupportedLocalTest , nolgcmsg , -f Local-ValUES -f NOLV-LEGAcy-Message -l -I. -I.. -SupportedLocalTest , nolocals , -i -f noLocal-Values -l -I. -I.. -SupportedLocalTest3 , DefLocStgSiz , -f Local-VALUes -d '_loCAL-STORagE-SIZe_=h# 42' -l -I. -I.. +SupportedLocalTest , nodupwrn , -f Local-VALUES -f NOWarn-if-DUPLicate -l +SupportedLocalTest , nolegacy , -f LoCAL-VALUes -f NoLV-Legacy-Separator -l +SupportedLocalTest , nolgcmsg , -f Local-ValUES -f NOLV-LEGAcy-Message -l +SupportedLocalTest , nolocals , -i -f noLocal-Values -l +SupportedLocalTest3 , DefLocStgSiz , -f Local-VALUes -d '_loCAL-STORagE-SIZe_=h# 42' -l
Added: fcode-utils/testsuite/TokoLoco/TotalLocalValuesSupport.fth =================================================================== --- fcode-utils/testsuite/TokoLoco/TotalLocalValuesSupport.fth (rev 0) +++ fcode-utils/testsuite/TokoLoco/TotalLocalValuesSupport.fth 2006-10-30 16:25:35 UTC (rev 107) @@ -0,0 +1,52 @@ +\ %Z%%M% %I% %W% %G% %U% +\ (C) Copyright 2005-2006 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ Control file for loading of Local Values Support file with variants. +\ Command-line Symbol-definitions select whether the support will +\ be under Global-Definitions, and whether to include the extra +\ Development-time support features. +\ +\ The command-line symbols are: +\ Global-Locals +\ and +\ Locals-Release +\ +\ The default is device-node-specific support in a Development-time setting. +\ +\ If Global-Locals is defined, support will be under Global-Definitions +\ If Locals-Release is defined, this is a final production release run, +\ and the Development-time support features will be removed. + +\ Make sure this option is turned on. +[flag] Local-Values + +[ifdef] Global-Locals + \ Load Support file under Global-Definitions. + global-definitions + + \ Bypass warning about Instance without altering LocalValuesSupport file + alias generic-instance instance + [macro] bypass-instance f[ noop .( Bypassed instance!) f] + + overload alias instance bypass-instance +[endif] \ Global-Locals + +fload LocalValuesSupport.fth + +[ifndef] Locals-Release + \ Load Development-time support features + fload LocalValuesDevelSupport.fth +[endif] \ not Locals-Release + +[ifdef] Global-Locals + \ Replace normal meaning of Instance, still in Global scope. + overload alias instance generic-instance + + \ Restore Device-Definitions scope. + device-definitions +[endif] \ Global-Locals
-
svn＠openbios.org