Author: wmb Date: 2007-07-30 20:19:56 +0200 (Mon, 30 Jul 2007) New Revision: 504
Modified: forth/kernel/kernel.fth forth/kernel/sysio.fth forth/lib/loadcomm.fth forth/lib/stringop.fth ofw/core/ofwcore.fth Log: Added string macro expansion to the base build.
Modified: forth/kernel/kernel.fth =================================================================== --- forth/kernel/kernel.fth 2007-07-28 17:45:18 UTC (rev 503) +++ forth/kernel/kernel.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -38,6 +38,7 @@ defer resize ( adr #bytes -- adr' ior )
defer sync-cache ( adr len -- ) ' 2drop is sync-cache +defer $getenv ( adr len -- false | adr' len' true )
defer #out ( -- adr ) defer #line ( -- adr ) @@ -50,6 +51,8 @@ : default-type ( adr len -- ) 0 max bounds ?do pause i c@ (emit loop ; +: null-$getenv ( adr len -- true ) 2drop true ; + \ headerless \ from campus version nuser (#out \ number of characters emitted \ headers \ from campus version @@ -61,6 +64,7 @@ ' key1 is key ' (#out is #out ' (#line is #line +' null-$getenv is $getenv
decimal
Modified: forth/kernel/sysio.fth =================================================================== --- forth/kernel/sysio.fth 2007-07-28 17:45:18 UTC (rev 503) +++ forth/kernel/sysio.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -161,6 +161,10 @@
: sys-sync-cache ( adr len -- ) swap 116 syscall 2drop ;
+: sys-$getenv ( adr len -- true | adr' len' false ) + $cstr d# 84 syscall drop retval dup if cscount false else drop true then +; + : install-wrapper-alloc ( -- ) \ Don't use "is" in case a relocation map needs to be allocated first ['] sys-alloc-mem ['] alloc-mem >body >user token! @@ -185,6 +189,7 @@ install-wrapper-alloc \ init-relocation goes here, for versions that need it install-wrapper-key + ['] sys-$getenv is $getenv ;
headers
Modified: forth/lib/loadcomm.fth =================================================================== --- forth/lib/loadcomm.fth 2007-07-28 17:45:18 UTC (rev 503) +++ forth/lib/loadcomm.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -25,6 +25,7 @@ fload ${BP}/forth/kernel/endian.fth
fload ${BP}/forth/lib/strings.fth +fload ${BP}/forth/lib/stringop.fth
fload ${BP}/forth/lib/fastspac.fth
Modified: forth/lib/stringop.fth =================================================================== --- forth/lib/stringop.fth 2007-07-28 17:45:18 UTC (rev 503) +++ forth/lib/stringop.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -1,10 +1,6 @@ \ See license at end of file purpose: String tools to manipulate OS file pathnames
-: $getenv ( adr len -- false | adr' len' true ) - $cstr d# 84 syscall drop retval dup if cscount true then -; - \ head$ is the portion of str3 preceding str2, and tail$ is the portion \ of str3 following str2 : break$ ( str2 str3 -- head$ tail$ ) @@ -38,13 +34,25 @@ ; vocabulary macros
-: macro: ( "name" "value" -- ) - also macros definitions create previous definitions 0 parse ", +: $set-macro ( value$ name$ -- ) + warning @ warning off + also macros definitions $header create-cf previous definitions ( value$ ) + warning ! + ", does> ( -- adr len ) count ; +: $get-macro ( name$ -- true | value$ false ) + ['] macros search-wordlist if execute false else true then +; + +: macro: ( "name" "value" -- ) safe-parse-word 0 parse 2swap $set-macro ; + : expansion ( macro-name$ -- macro-value$ ) - 2dup ['] macros search-wordlist if nip nip execute exit then ( name$ ) - $getenv 0= if " " then + 2dup $get-macro if ( name$ ) + $getenv if " " then ( value$ ) + else ( name$ value$ ) + 2nip ( value$ ) + then ( value$ ) ;
\ Expand references to environment variables within str1 @@ -82,24 +90,25 @@ : remaining ( -- adr len ) source >in @ /string ; \ The complexity with last-delim is necessary in order to handle the \ case where files" is at the very end of a line. -0 value last-delim +variable last-delim : files" ( "strings" -- adr len ) - 0 to last-delim + last-delim off here begin #remaining if [char] " parse ( adr len ) $, - source drop >in @ + 1- c@ to last-delim + source drop >in @ + 1- c@ last-delim ! then #remaining 0= while - >in @ if last-delim [char] " <> else true then + >in @ if last-delim @ [char] " <> else true then while bl c, refill 0= until then then ( adr ) here over - ; + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \
Modified: ofw/core/ofwcore.fth =================================================================== --- ofw/core/ofwcore.fth 2007-07-28 17:45:18 UTC (rev 503) +++ ofw/core/ofwcore.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -501,7 +501,7 @@ config-ro ;
-: $getenv ( name$ -- true | value$ false ) +: ofw-$getenv ( name$ -- true | value$ false ) 2dup $find-option if ( name$ xt ) nip nip ( xt ) >r r@ get r> decode -null false ( prop$ false ) @@ -3717,6 +3717,7 @@ ['] heap-alloc-mem is alloc-mem ['] heap-free-mem is free-mem ['] resize-memory is resize + ['] ofw-$getenv is $getenv ; headers