svn commit: r187222 - in stable/7/sys/boot: common forth

Luigi Rizzo luigi at FreeBSD.org
Wed Jan 14 06:55:12 PST 2009


Author: luigi
Date: Wed Jan 14 14:55:10 2009
New Revision: 187222
URL: http://svn.freebsd.org/changeset/base/187222

Log:
  MFC: 185746 186789 187143
  
  misc fixes and cleanup of the Forth scripts used by the loader,
  see the original commits for details.
  The only visible change is that now setting
  
  	loader_conf_files="foo bar ${some.var}"
  
  works as expected, and expands variables correctly.
  Also, ${variables} can be used consistently in all assignments
  in *.conf files managed by the loader.
  
  NOTE: this commit has nothing to do with the pxeboot and /boot/loader
  problems that people are seeing on 6.4 and 7.2 -- those are related
  to issues with the loader code, not with the scripts that the
  loader processes.

Modified:
  stable/7/sys/boot/common/interp.c
  stable/7/sys/boot/forth/loader.4th
  stable/7/sys/boot/forth/pnp.4th
  stable/7/sys/boot/forth/support.4th

Modified: stable/7/sys/boot/common/interp.c
==============================================================================
--- stable/7/sys/boot/common/interp.c	Wed Jan 14 14:20:08 2009	(r187221)
+++ stable/7/sys/boot/common/interp.c	Wed Jan 14 14:55:10 2009	(r187222)
@@ -92,7 +92,7 @@ perform(int argc, char *argv[])
 void
 interact(void)
 {
-    char	input[256];			/* big enough? */
+    static char	input[256];			/* big enough? */
 #ifndef BOOT_FORTH
     int		argc;
     char	**argv;
@@ -178,14 +178,21 @@ command_include(int argc, char *argv[])
     return(res);
 }
 
+/*
+ * Header prepended to each line. The text immediately follows the header.
+ * We try to make this short in order to save memory -- the loader has
+ * limited memory available, and some of the forth files are very long.
+ */
 struct includeline 
 {
-    char		*text;
+    struct includeline	*next;
+#ifndef BOOT_FORTH
     int			flags;
     int			line;
 #define SL_QUIET	(1<<0)
 #define SL_IGNOREERR	(1<<1)
-    struct includeline	*next;
+#endif
+    char		text[0];
 };
 
 int
@@ -236,13 +243,14 @@ include(const char *filename)
 	}
 #endif
 	/* Allocate script line structure and copy line, flags */
+	if (*cp == '\0')
+		continue;	/* ignore empty line, save memory */
 	sp = malloc(sizeof(struct includeline) + strlen(cp) + 1);
-	sp->text = (char *)sp + sizeof(struct includeline);
 	strcpy(sp->text, cp);
 #ifndef BOOT_FORTH
 	sp->flags = flags;
-#endif
 	sp->line = line;
+#endif
 	sp->next = NULL;
 	    
 	if (script == NULL) {

Modified: stable/7/sys/boot/forth/loader.4th
==============================================================================
--- stable/7/sys/boot/forth/loader.4th	Wed Jan 14 14:20:08 2009	(r187221)
+++ stable/7/sys/boot/forth/loader.4th	Wed Jan 14 14:55:10 2009	(r187222)
@@ -93,6 +93,7 @@ only forth definitions also support-func
 \
 \	If a password was defined, execute autoboot and ask for
 \	password if autoboot returns.
+\	Do not exit unless the right password is given.
 
 : check-password
   password .addr @ if
@@ -150,8 +151,7 @@ only forth definitions also support-func
 \	line, if interpreted, or given on the stack, if compiled in.
 
 : (read-conf)  ( addr len -- )
-  conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
-  strdup conf_files .len ! conf_files .addr !
+  conf_files string=
   include_conf_files \ Will recurse on new loader_conf_files definitions
 ;
 
@@ -165,110 +165,26 @@ only forth definitions also support-func
   then
 ; immediate
 
-\ ***** enable-module
-\
-\       Turn a module loading on.
+\ show, enable, disable, toggle module loading. They all take module from
+\ the next word
 
-: enable-module ( <module> -- )
-  bl parse module_options @ >r
-  begin
-    r@
-  while
-    2dup
-    r@ module.name dup .addr @ swap .len @
-    compare 0= if
-      2drop
-      r@ module.name dup .addr @ swap .len @ type
-      true r> module.flag !
-      ."  will be loaded." cr
-      exit
-    then
-    r> module.next @ >r
-  repeat
-  r> drop
-  type ."  wasn't found." cr
+: set-module-flag ( module_addr val -- ) \ set and print flag
+  over module.flag !
+  dup module.name strtype
+  module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
 ;
 
-\ ***** disable-module
-\
-\       Turn a module loading off.
-
-: disable-module ( <module> -- )
-  bl parse module_options @ >r
-  begin
-    r@
-  while
-    2dup
-    r@ module.name dup .addr @ swap .len @
-    compare 0= if
-      2drop
-      r@ module.name dup .addr @ swap .len @ type
-      false r> module.flag !
-      ."  will not be loaded." cr
-      exit
-    then
-    r> module.next @ >r
-  repeat
-  r> drop
-  type ."  wasn't found." cr
-;
+: enable-module find-module ?dup if true set-module-flag then ;
 
-\ ***** toggle-module
-\
-\       Turn a module loading on/off.
+: disable-module find-module ?dup if false set-module-flag then ;
 
-: toggle-module ( <module> -- )
-  bl parse module_options @ >r
-  begin
-    r@
-  while
-    2dup
-    r@ module.name dup .addr @ swap .len @
-    compare 0= if
-      2drop
-      r@ module.name dup .addr @ swap .len @ type
-      r@ module.flag @ 0= dup r> module.flag !
-      if
-        ."  will be loaded." cr
-      else
-        ."  will not be loaded." cr
-      then
-      exit
-    then
-    r> module.next @ >r
-  repeat
-  r> drop
-  type ."  wasn't found." cr
-;
+: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
 
 \ ***** show-module
 \
 \	Show loading information about a module.
 
-: show-module ( <module> -- )
-  bl parse module_options @ >r
-  begin
-    r@
-  while
-    2dup
-    r@ module.name dup .addr @ swap .len @
-    compare 0= if
-      2drop
-      ." Name: " r@ module.name dup .addr @ swap .len @ type cr
-      ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
-      ." Type: " r@ module.type dup .addr @ swap .len @ type cr
-      ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
-      ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
-      ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
-      ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
-      ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
-      exit
-    then
-    r> module.next @ >r
-  repeat
-  r> drop
-  type ."  wasn't found." cr
-;
+: show-module ( <module> -- ) find-module ?dup if show-one-module then ;
 
 \ Words to be used inside configuration files
 

Modified: stable/7/sys/boot/forth/pnp.4th
==============================================================================
--- stable/7/sys/boot/forth/pnp.4th	Wed Jan 14 14:20:08 2009	(r187221)
+++ stable/7/sys/boot/forth/pnp.4th	Wed Jan 14 14:55:10 2009	(r187222)
@@ -24,6 +24,39 @@
 \
 \ $FreeBSD$
 
+
+\ The following pnp code is used in pnp.4th and pnp.c
+structure: STAILQ_HEAD
+	ptr stqh_first	\ type*
+	ptr stqh_last	\ type**
+;structure
+
+structure: STAILQ_ENTRY
+	ptr stqe_next	\ type*
+;structure
+
+structure: pnphandler
+	ptr pnph.name
+	ptr pnph.enumerate
+;structure
+
+structure: pnpident
+	ptr pnpid.ident					\ char*
+	sizeof STAILQ_ENTRY cells member: pnpid.link	\ pnpident
+;structure
+
+structure: pnpinfo \ sync with sys/boot/config/bootstrap.h
+	ptr pnpi.desc
+	int pnpi.revision
+	ptr pnpi.module				\ (char*) module args
+	int pnpi.argc
+	ptr pnpi.argv
+	ptr pnpi.handler			\ pnphandler
+	sizeof STAILQ_HEAD member: pnpi.ident	\ pnpident
+	sizeof STAILQ_ENTRY member: pnpi.link	\ pnpinfo
+;structure
+\ end of pnp support
+
 pnpdevices drop
 
 : enumerate

Modified: stable/7/sys/boot/forth/support.4th
==============================================================================
--- stable/7/sys/boot/forth/support.4th	Wed Jan 14 14:20:08 2009	(r187221)
+++ stable/7/sys/boot/forth/support.4th	Wed Jan 14 14:55:10 2009	(r187222)
@@ -26,7 +26,6 @@
 
 \ Loader.rc support functions:
 \
-\ initialize_support ( -- )	initialize global variables
 \ initialize ( addr len -- )	as above, plus load_conf_files
 \ load_conf ( addr len -- )	load conf file given
 \ include_conf_files ( -- )	load all conf files in load_conf_files
@@ -61,24 +60,23 @@
 \ value any_conf_read?		indicates if a conf file was succesfully read
 \
 \ Other exported words:
-\
+\    note, strlen is internal
 \ strdup ( addr len -- addr' len)			similar to strdup(3)
 \ strcat ( addr len addr' len' -- addr len+len' )	similar to strcat(3)
-\ strlen ( addr -- len )				similar to strlen(3)
 \ s' ( | string' -- addr len | )			similar to s"
 \ rudimentary structure support
 
 \ Exception values
 
-1 constant syntax_error
-2 constant out_of_memory
-3 constant free_error
-4 constant set_error
-5 constant read_error
-6 constant open_error
-7 constant exec_error
-8 constant before_load_error
-9 constant after_load_error
+1 constant ESYNTAX
+2 constant ENOMEM
+3 constant EFREE
+4 constant ESETERROR	\ error setting environment variable
+5 constant EREAD	\ error reading
+6 constant EOPEN
+7 constant EEXEC	\ XXX never catched
+8 constant EBEFORELOAD
+9 constant EAFTERLOAD
 
 \ I/O constants
 
@@ -132,7 +130,8 @@ structure: module
 	ptr module.next
 ;structure
 
-\ Internal loader structures
+\ Internal loader structures (preloaded_file, kernel_module, file_metadata)
+\ must be in sync with the C struct in sys/boot/common/bootstrap.h
 structure: preloaded_file
 	ptr pf.name
 	ptr pf.type
@@ -159,51 +158,7 @@ structure: file_metadata
 	0 member:	md.data	\ variable size
 ;structure
 
-structure: config_resource
-	ptr cf.name
-	int cf.type
-0 constant RES_INT
-1 constant RES_STRING
-2 constant RES_LONG
-	2 cells member: u
-;structure
-
-structure: config_device
-	ptr cd.name
-	int cd.unit
-	int cd.resource_count
-	ptr cd.resources	\ config_resource
-;structure
-
-structure: STAILQ_HEAD
-	ptr stqh_first	\ type*
-	ptr stqh_last	\ type**
-;structure
-
-structure: STAILQ_ENTRY
-	ptr stqe_next	\ type*
-;structure
-
-structure: pnphandler
-	ptr pnph.name
-	ptr pnph.enumerate
-;structure
-
-structure: pnpident
-	ptr pnpid.ident					\ char*
-	sizeof STAILQ_ENTRY cells member: pnpid.link	\ pnpident
-;structure
-
-structure: pnpinfo
-	ptr pnpi.desc
-	int pnpi.revision
-	ptr pnpi.module				\ (char*) module args
-	int pnpi.argc
-	ptr pnpi.argv
-	ptr pnpi.handler			\ pnphandler
-	sizeof STAILQ_HEAD member: pnpi.ident	\ pnpident
-	sizeof STAILQ_ENTRY member: pnpi.link	\ pnpinfo
-;structure
+\ end of structures
 
 \ Global variables
 
@@ -216,11 +171,9 @@ create last_module_option sizeof module.
 0 value nextboot?
 
 \ Support string functions
-
-: strdup  ( addr len -- addr' len )
-  >r r@ allocate if out_of_memory throw then
-  tuck r@ move
-  r>
+: strdup { addr len -- addr' len' }
+  len allocate if ENOMEM throw then
+  addr over len move len
 ;
 
 : strcat  { addr len addr' len' -- addr len+len' }
@@ -228,29 +181,27 @@ create last_module_option sizeof module.
   addr len len' +
 ;
 
-: strlen ( addr -- len )
-  0 >r
+: strchr { addr len c -- addr' len' }
   begin
-    dup c@ while
-    1+ r> 1+ >r repeat
-  drop r>
+    len
+  while
+    addr c@ c = if addr len exit then
+    addr 1 + to addr
+    len 1 - to len
+  repeat
+  0 0
 ;
 
-: s' 
+: s' \ same as s", allows " in the string
   [char] ' parse
-  state @ if
-    postpone sliteral
-  then
+  state @ if postpone sliteral then
 ; immediate
 
 : 2>r postpone >r postpone >r ; immediate
 : 2r> postpone r> postpone r> ; immediate
 : 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate
 
-: getenv?
-  getenv
-  -1 = if false else drop true then
-;
+: getenv?  getenv -1 = if false else drop true then ;
 
 \ Private definitions
 
@@ -271,22 +222,45 @@ only forth also support-functions defini
 
 \ Standard suffixes
 
-: load_module_suffix s" _load" ;
-: module_loadname_suffix s" _name" ;
-: module_type_suffix s" _type" ;
-: module_args_suffix s" _flags" ;
-: module_beforeload_suffix s" _before" ;
-: module_afterload_suffix s" _after" ;
-: module_loaderror_suffix s" _error" ;
+: load_module_suffix		s" _load" ;
+: module_loadname_suffix	s" _name" ;
+: module_type_suffix		s" _type" ;
+: module_args_suffix		s" _flags" ;
+: module_beforeload_suffix	s" _before" ;
+: module_afterload_suffix	s" _after" ;
+: module_loaderror_suffix	s" _error" ;
 
 \ Support operators
 
 : >= < 0= ;
 : <= > 0= ;
 
-\ Assorted support funcitons
+\ Assorted support functions
+
+: free-memory free if EFREE throw then ;
+
+: strget { var -- addr len } var .addr @ var .len @ ;
+
+\ assign addr len to variable.
+: strset  { addr len var -- } addr var .addr !  len var .len !  ;
 
-: free-memory free if free_error throw then ;
+\ free memory and reset fields
+: strfree { var -- } var .addr @ ?dup if free-memory 0 0 var strset then ;
+
+\ free old content, make a copy of the string and assign to variable
+: string= { addr len var -- } var strfree addr len strdup var strset ;
+
+: strtype ( str -- ) strget type ;
+
+\ assign a reference to what is on the stack
+: strref { addr len var -- addr len }
+  addr var .addr ! len var .len ! addr len
+;
+
+\ unquote a string
+: unquote ( addr len -- addr len )
+  over c@ [char] " = if 2 chars - swap char+ swap then
+;
 
 \ Assignment data temporary storage
 
@@ -355,16 +329,16 @@ line-reading definitions
   line_buffer .len @ if
     line_buffer .addr @
     line_buffer .len @ r@ +
-    resize if out_of_memory throw then
+    resize if ENOMEM throw then
   else
-    r@ allocate if out_of_memory throw then
+    r@ allocate if ENOMEM throw then
   then
   line_buffer .addr !
   r>
 ;
     
 : append_to_line_buffer  ( addr len -- )
-  line_buffer .addr @ line_buffer .len @
+  line_buffer strget
   2swap strcat
   line_buffer .len !
   drop
@@ -384,23 +358,15 @@ line-reading definitions
 : refill_buffer
   0 to read_buffer_ptr
   read_buffer .addr @ 0= if
-    read_buffer_size allocate if out_of_memory throw then
+    read_buffer_size allocate if ENOMEM throw then
     read_buffer .addr !
   then
   fd @ read_buffer .addr @ read_buffer_size fread
-  dup -1 = if read_error throw then
+  dup -1 = if EREAD throw then
   dup 0= if true to end_of_file? then
   read_buffer .len !
 ;
 
-: reset_line_buffer
-  line_buffer .addr @ ?dup if
-    free-memory
-  then
-  0 line_buffer .addr !
-  0 line_buffer .len !
-;
-
 support-functions definitions
 
 : reset_line_reading
@@ -408,7 +374,7 @@ support-functions definitions
 ;
 
 : read_line
-  reset_line_buffer
+  line_buffer strfree
   skip_newlines
   begin
     read_from_buffer
@@ -448,9 +414,9 @@ also parser definitions also
 0 value parsing_function
 0 value end_of_line
 
-: end_of_line?
-  line_pointer end_of_line =
-;
+: end_of_line?  line_pointer end_of_line = ;
+
+\ classifiers for various character classes in the input line
 
 : letter?
   line_pointer c@ >r
@@ -469,70 +435,46 @@ also parser definitions also
   or
 ;
 
-: quote?
-  line_pointer c@ [char] " =
-;
+: quote?  line_pointer c@ [char] " = ;
 
-: assignment_sign?
-  line_pointer c@ [char] = =
-;
+: assignment_sign?  line_pointer c@ [char] = = ;
 
-: comment?
-  line_pointer c@ [char] # =
-;
+: comment?  line_pointer c@ [char] # = ;
 
-: space?
-  line_pointer c@ bl =
-  line_pointer c@ tab = or
-;
+: space?  line_pointer c@ bl = line_pointer c@ tab = or ;
 
-: backslash?
-  line_pointer c@ [char] \ =
-;
+: backslash?  line_pointer c@ [char] \ = ;
 
-: underscore?
-  line_pointer c@ [char] _ =
-;
+: underscore?  line_pointer c@ [char] _ = ;
 
-: dot?
-  line_pointer c@ [char] . =
-;
+: dot?  line_pointer c@ [char] . = ;
 
-: skip_character
-  line_pointer char+ to line_pointer
-;
+\ manipulation of input line
+: skip_character line_pointer char+ to line_pointer ;
 
-: skip_to_end_of_line
-  end_of_line to line_pointer
-;
+: skip_to_end_of_line end_of_line to line_pointer ;
 
 : eat_space
   begin
-    space?
+    end_of_line? if 0 else space? then
   while
     skip_character
-    end_of_line? if exit then
   repeat
 ;
 
 : parse_name  ( -- addr len )
   line_pointer
   begin
-    letter? digit? underscore? dot? or or or
+    end_of_line? if 0 else letter? digit? underscore? dot? or or or then
   while
     skip_character
-    end_of_line? if 
-      line_pointer over -
-      strdup
-      exit
-    then
   repeat
   line_pointer over -
   strdup
 ;
 
 : remove_backslashes  { addr len | addr' len' -- addr' len' }
-  len allocate if out_of_memory throw then
+  len allocate if ENOMEM throw then
   to addr'
   addr >r
   begin
@@ -550,16 +492,16 @@ also parser definitions also
 : parse_quote  ( -- addr len )
   line_pointer
   skip_character
-  end_of_line? if syntax_error throw then
+  end_of_line? if ESYNTAX throw then
   begin
     quote? 0=
   while
     backslash? if
       skip_character
-      end_of_line? if syntax_error throw then
+      end_of_line? if ESYNTAX throw then
     then
     skip_character
-    end_of_line? if syntax_error throw then 
+    end_of_line? if ESYNTAX throw then 
   repeat
   skip_character
   line_pointer over -
@@ -568,8 +510,7 @@ also parser definitions also
 
 : read_name
   parse_name		( -- addr len )
-  name_buffer .len !
-  name_buffer .addr !
+  name_buffer strset
 ;
 
 : read_value
@@ -578,8 +519,7 @@ also parser definitions also
   else
     parse_name		( -- addr len )
   then
-  value_buffer .len !
-  value_buffer .addr !
+  value_buffer strset
 ;
 
 : comment
@@ -589,7 +529,7 @@ also parser definitions also
 : white_space_4
   eat_space
   comment? if ['] comment to parsing_function exit then
-  end_of_line? 0= if syntax_error throw then
+  end_of_line? 0= if ESYNTAX throw then
 ;
 
 : variable_value
@@ -602,7 +542,7 @@ also parser definitions also
   letter? digit? quote? or or if
     ['] variable_value to parsing_function exit
   then
-  syntax_error throw
+  ESYNTAX throw
 ;
 
 : assignment_sign
@@ -613,7 +553,7 @@ also parser definitions also
 : white_space_2
   eat_space
   assignment_sign? if ['] assignment_sign to parsing_function exit then
-  syntax_error throw
+  ESYNTAX throw
 ;
 
 : variable_name
@@ -625,13 +565,13 @@ also parser definitions also
   eat_space
   letter?  if ['] variable_name to parsing_function exit then
   comment? if ['] comment to parsing_function exit then
-  end_of_line? 0= if syntax_error throw then
+  end_of_line? 0= if ESYNTAX throw then
 ;
 
 file-processing definitions
 
 : get_assignment
-  line_buffer .addr @ line_buffer .len @ + to end_of_line
+  line_buffer strget + to end_of_line
   line_buffer .addr @ to line_pointer
   ['] white_space_1 to parsing_function
   begin
@@ -642,7 +582,7 @@ file-processing definitions
   parsing_function ['] comment =
   parsing_function ['] white_space_1 =
   parsing_function ['] white_space_4 =
-  or or 0= if syntax_error throw then
+  or or 0= if ESYNTAX throw then
 ;
 
 only forth also support-functions also file-processing definitions also
@@ -650,7 +590,7 @@ only forth also support-functions also f
 \ Process line
 
 : assignment_type?  ( addr len -- flag )
-  name_buffer .addr @ name_buffer .len @
+  name_buffer strget
   compare 0=
 ;
 
@@ -660,82 +600,56 @@ only forth also support-functions also f
   over compare 0=
 ;
 
-: loader_conf_files?
-  s" loader_conf_files" assignment_type?
-;
+: loader_conf_files?  s" loader_conf_files" assignment_type?  ;
 
-: nextboot_flag?
-  s" nextboot_enable" assignment_type?
-;
+: nextboot_flag?  s" nextboot_enable" assignment_type?  ;
 
-: nextboot_conf?
-  s" nextboot_conf" assignment_type?
-;
+: nextboot_conf? s" nextboot_conf" assignment_type?  ;
 
-: verbose_flag?
-  s" verbose_loading" assignment_type?
-;
+: verbose_flag? s" verbose_loading" assignment_type?  ;
 
-: execute?
-  s" exec" assignment_type?
-;
+: execute? s" exec" assignment_type?  ;
 
-: password?
-  s" password" assignment_type?
-;
+: password? s" password" assignment_type?  ;
 
-: module_load?
-  load_module_suffix suffix_type?
-;
+: module_load? load_module_suffix suffix_type? ;
 
-: module_loadname?
-  module_loadname_suffix suffix_type?
-;
+: module_loadname?  module_loadname_suffix suffix_type?  ;
 
-: module_type?
-  module_type_suffix suffix_type?
-;
+: module_type?  module_type_suffix suffix_type?  ;
 
-: module_args?
-  module_args_suffix suffix_type?
-;
+: module_args?  module_args_suffix suffix_type?  ;
 
-: module_beforeload?
-  module_beforeload_suffix suffix_type?
-;
+: module_beforeload?  module_beforeload_suffix suffix_type?  ;
 
-: module_afterload?
-  module_afterload_suffix suffix_type?
-;
+: module_afterload?  module_afterload_suffix suffix_type?  ;
 
-: module_loaderror?
-  module_loaderror_suffix suffix_type?
-;
+: module_loaderror?  module_loaderror_suffix suffix_type?  ;
 
-: set_conf_files
-  conf_files .addr @ ?dup if
-    free-memory
-  then
-  value_buffer .addr @ c@ [char] " = if
-    value_buffer .addr @ char+ value_buffer .len @ 2 chars -
+\ build a 'set' statement and execute it
+: set_environment_variable
+  name_buffer .len @ value_buffer .len @ + 5 chars + \ size of result string
+  allocate if ENOMEM throw then
+  dup 0  \ start with an empty string and append the pieces
+  s" set " strcat
+  name_buffer strget strcat
+  s" =" strcat
+  value_buffer strget strcat
+  ['] evaluate catch if
+    2drop free drop
+    ESETERROR throw
   else
-    value_buffer .addr @ value_buffer .len @
+    free-memory
   then
-  strdup
-  conf_files .len ! conf_files .addr !
 ;
 
-: set_nextboot_conf
-  nextboot_conf_file .addr @ ?dup if
-    free-memory
-  then
-  value_buffer .addr @ c@ [char] " = if
-    value_buffer .addr @ char+ value_buffer .len @ 2 chars -
-  else
-    value_buffer .addr @ value_buffer .len @
-  then
-  strdup
-  nextboot_conf_file .len ! nextboot_conf_file .addr !
+: set_conf_files
+  set_environment_variable
+  s" loader_conf_files" getenv conf_files string=
+;
+
+: set_nextboot_conf \ XXX maybe do as set_conf_files ?
+  value_buffer strget unquote nextboot_conf_file string=
 ;
 
 : append_to_module_options_list  ( addr -- )
@@ -748,35 +662,32 @@ only forth also support-functions also f
   then
 ;
 
-: set_module_name  ( addr -- )
-  name_buffer .addr @ name_buffer .len @
-  strdup
-  >r over module.name .addr !
-  r> swap module.name .len !
+: set_module_name  { addr -- }	\ check leaks
+  name_buffer strget addr module.name string=
 ;
 
 : yes_value?
-  value_buffer .addr @ value_buffer .len @
+  value_buffer strget	\ XXX could use unquote
   2dup s' "YES"' compare >r
   2dup s' "yes"' compare >r
   2dup s" YES" compare >r
   s" yes" compare r> r> r> and and and 0=
 ;
 
-: find_module_option  ( -- addr | 0 )
+: find_module_option  ( -- addr | 0 ) \ return ptr to entry matching name_buffer
   module_options @
   begin
     dup
   while
-    dup module.name dup .addr @ swap .len @
-    name_buffer .addr @ name_buffer .len @
+    dup module.name strget
+    name_buffer strget
     compare 0= if exit then
     module.next @
   repeat
 ;
 
 : new_module_option  ( -- addr )
-  sizeof module allocate if out_of_memory throw then
+  sizeof module allocate if ENOMEM throw then
   dup sizeof module erase
   dup append_to_module_options_list
   dup set_module_name
@@ -794,98 +705,38 @@ only forth also support-functions also f
 
 : set_module_args
   name_buffer .len @ module_args_suffix nip - name_buffer .len !
-  get_module_option module.args
-  dup .addr @ ?dup if free-memory then
-  value_buffer .addr @ value_buffer .len @
-  over c@ [char] " = if
-    2 chars - swap char+ swap
-  then
-  strdup
-  >r over .addr !
-  r> swap .len !
+  value_buffer strget unquote
+  get_module_option module.args string=
 ;
 
 : set_module_loadname
   name_buffer .len @ module_loadname_suffix nip - name_buffer .len !
-  get_module_option module.loadname
-  dup .addr @ ?dup if free-memory then
-  value_buffer .addr @ value_buffer .len @
-  over c@ [char] " = if
-    2 chars - swap char+ swap
-  then
-  strdup
-  >r over .addr !
-  r> swap .len !
+  value_buffer strget unquote
+  get_module_option module.loadname string=
 ;
 
 : set_module_type
   name_buffer .len @ module_type_suffix nip - name_buffer .len !
-  get_module_option module.type
-  dup .addr @ ?dup if free-memory then
-  value_buffer .addr @ value_buffer .len @
-  over c@ [char] " = if
-    2 chars - swap char+ swap
-  then
-  strdup
-  >r over .addr !
-  r> swap .len !
+  value_buffer strget unquote
+  get_module_option module.type string=
 ;
 
 : set_module_beforeload
   name_buffer .len @ module_beforeload_suffix nip - name_buffer .len !
-  get_module_option module.beforeload
-  dup .addr @ ?dup if free-memory then
-  value_buffer .addr @ value_buffer .len @
-  over c@ [char] " = if
-    2 chars - swap char+ swap
-  then
-  strdup
-  >r over .addr !
-  r> swap .len !
+  value_buffer strget unquote
+  get_module_option module.beforeload string=
 ;
 
 : set_module_afterload
   name_buffer .len @ module_afterload_suffix nip - name_buffer .len !
-  get_module_option module.afterload
-  dup .addr @ ?dup if free-memory then
-  value_buffer .addr @ value_buffer .len @
-  over c@ [char] " = if
-    2 chars - swap char+ swap
-  then
-  strdup
-  >r over .addr !
-  r> swap .len !
+  value_buffer strget unquote
+  get_module_option module.afterload string=
 ;
 
 : set_module_loaderror
   name_buffer .len @ module_loaderror_suffix nip - name_buffer .len !
-  get_module_option module.loaderror
-  dup .addr @ ?dup if free-memory then
-  value_buffer .addr @ value_buffer .len @
-  over c@ [char] " = if
-    2 chars - swap char+ swap
-  then
-  strdup
-  >r over .addr !
-  r> swap .len !
-;
-
-: set_environment_variable
-  name_buffer .len @
-  value_buffer .len @ +
-  5 chars +
-  allocate if out_of_memory throw then
-  dup 0  ( addr -- addr addr len )
-  s" set " strcat
-  name_buffer .addr @ name_buffer .len @ strcat
-  s" =" strcat
-  value_buffer .addr @ value_buffer .len @ strcat
-  ['] evaluate catch if
-    2drop free drop
-    set_error throw
-  else
-    free-memory
-  then
+  value_buffer strget unquote
+  get_module_option module.loaderror string=
 ;
 
 : set_nextboot_flag
@@ -897,23 +748,12 @@ only forth also support-functions also f
 ;
 
 : execute_command
-  value_buffer .addr @ value_buffer .len @
-  over c@ [char] " = if
-    2 - swap char+ swap
-  then
-  ['] evaluate catch if exec_error throw then
+  value_buffer strget unquote
+  ['] evaluate catch if EEXEC throw then
 ;
 
 : set_password
-  password .addr @ ?dup if free if free_error throw then then
-  value_buffer .addr @ c@ [char] " = if
-    value_buffer .addr @ char+ value_buffer .len @ 2 - strdup
-    value_buffer .addr @ free if free_error throw then
-  else
-    value_buffer .addr @ value_buffer .len @
-  then
-  password .len ! password .addr !
-  0 value_buffer .addr !

*** DIFF OUTPUT TRUNCATED AT 1000 LINES ***


More information about the svn-src-stable mailing list