From owner-svn-src-head@FreeBSD.ORG Mon Jan 5 20:09:55 2009 Return-Path: Delivered-To: svn-src-head@freebsd.org Received: from mx1.freebsd.org (mx1.freebsd.org [IPv6:2001:4f8:fff6::34]) by hub.freebsd.org (Postfix) with ESMTP id EBBCB106566B; Mon, 5 Jan 2009 20:09:54 +0000 (UTC) (envelope-from luigi@FreeBSD.org) Received: from svn.freebsd.org (svn.freebsd.org [IPv6:2001:4f8:fff6::2c]) by mx1.freebsd.org (Postfix) with ESMTP id D8CA08FC16; Mon, 5 Jan 2009 20:09:54 +0000 (UTC) (envelope-from luigi@FreeBSD.org) Received: from svn.freebsd.org (localhost [127.0.0.1]) by svn.freebsd.org (8.14.3/8.14.3) with ESMTP id n05K9sZj009624; Mon, 5 Jan 2009 20:09:54 GMT (envelope-from luigi@svn.freebsd.org) Received: (from luigi@localhost) by svn.freebsd.org (8.14.3/8.14.3/Submit) id n05K9soF009621; Mon, 5 Jan 2009 20:09:54 GMT (envelope-from luigi@svn.freebsd.org) Message-Id: <200901052009.n05K9soF009621@svn.freebsd.org> From: Luigi Rizzo Date: Mon, 5 Jan 2009 20:09:54 +0000 (UTC) To: src-committers@freebsd.org, svn-src-all@freebsd.org, svn-src-head@freebsd.org X-SVN-Group: head MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Cc: Subject: svn commit: r186789 - head/sys/boot/forth X-BeenThere: svn-src-head@freebsd.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: SVN commit messages for the src tree for head/-current List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 05 Jan 2009 20:09:55 -0000 Author: luigi Date: Mon Jan 5 20:09:54 2009 New Revision: 186789 URL: http://svn.freebsd.org/changeset/base/186789 Log: This patch introduces a number of simplifications to the Forth functions used in the bootloader. The goal is to make the code more readable and smaller (especially because we have size issues in the loader's environment). High level description of the changes: + define some string manipulation functions to improve readability; + create functions to manipulate module descriptors, removing some duplicated code; + rename the error codes to ESOMETHING; + consistently use set_environment_variable (which evaluates $variables) when interpreting variable=value assignments; I have tested the code, but there might be code paths that I have not traversed so please let me know of any issues. Details of this change: --- loader.4th --- + add some module operators, to remove duplicated code while parsing module-related commands: set-module-flag enable-module disable-module toggle-module show-module --- pnp.4th --- + move here the definition related to the pnp devices list, e.g. STAILQ_* , pnpident, pnpinfo --- support.4th --- + rename error codes to capital e.g. ENOMEM EFREE ... and do obvious changes related to the renaming; + remove unused structures (those relevant to pnp are moved to pnp.4th) + various string functions - strlen removed (it is an internal function) - strchr, defined as the C function - strtype -- type a string to output - strref -- assign a reference to the string on the stack - unquote -- remove quotes from a string + remove reset_line_buffer + move up the 'set_environment_variable' function (which now uses the interpreter, so $variables are evaluated). Use the function in various places + add a 'test_file function' for debugging purposes MFC after: 4 weeks Modified: head/sys/boot/forth/loader.4th head/sys/boot/forth/pnp.4th head/sys/boot/forth/support.4th Modified: head/sys/boot/forth/loader.4th ============================================================================== --- head/sys/boot/forth/loader.4th Mon Jan 5 20:02:12 2009 (r186788) +++ head/sys/boot/forth/loader.4th Mon Jan 5 20:09:54 2009 (r186789) @@ -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 ( -- ) - 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 ( -- ) - 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 ( -- ) - 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 ( -- ) - 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 ( -- ) find-module ?dup if show-one-module then ; \ Words to be used inside configuration files Modified: head/sys/boot/forth/pnp.4th ============================================================================== --- head/sys/boot/forth/pnp.4th Mon Jan 5 20:02:12 2009 (r186788) +++ head/sys/boot/forth/pnp.4th Mon Jan 5 20:09:54 2009 (r186789) @@ -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: head/sys/boot/forth/support.4th ============================================================================== --- head/sys/boot/forth/support.4th Mon Jan 5 20:02:12 2009 (r186788) +++ head/sys/boot/forth/support.4th Mon Jan 5 20:09:54 2009 (r186789) @@ -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,27 +222,27 @@ 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 free_error throw then ; +: 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 ! ; +: strset { addr len var -- } addr var .addr ! len var .len ! ; \ free memory and reset fields : strfree { var -- } var .addr @ ?dup if free-memory 0 0 var strset then ; @@ -299,6 +250,18 @@ only forth also support-functions defini \ 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 string name_buffer @@ -366,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 @@ -395,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 @@ -419,7 +374,7 @@ support-functions definitions ; : read_line - reset_line_buffer + line_buffer strfree skip_newlines begin read_from_buffer @@ -459,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 @@ -480,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 @@ -561,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 - @@ -579,8 +510,7 @@ also parser definitions also : read_name parse_name ( -- addr len ) - name_buffer .len ! - name_buffer .addr ! + name_buffer strset ; : read_value @@ -589,8 +519,7 @@ also parser definitions also else parse_name ( -- addr len ) then - value_buffer .len ! - value_buffer .addr ! + value_buffer strset ; : comment @@ -600,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 @@ -613,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 @@ -624,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 @@ -636,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 @@ -653,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 @@ -661,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= ; @@ -671,69 +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_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 - +\ 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 - 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 -- ) @@ -746,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 @@ -792,103 +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 -; - -: set_conf_files - set_environment_variable - s" loader_conf_files" getenv conf_files string= + value_buffer strget unquote + get_module_option module.loaderror string= ; : set_nextboot_flag @@ -900,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 ! + value_buffer strget unquote password string= ; : process_assignment @@ -944,16 +781,8 @@ only forth also support-functions also f \ not allocated, it's value (0) is used as flag. : free_buffers - name_buffer .addr @ dup if free then - value_buffer .addr @ dup if free then - or if free_error throw then -; - -: reset_assignment_buffers - 0 name_buffer .addr ! - 0 name_buffer .len ! - 0 value_buffer .addr ! - 0 value_buffer .len ! + name_buffer strfree + value_buffer strfree ; \ Higher level file processing @@ -964,7 +793,7 @@ support-functions definitions begin end_of_file? 0= while - reset_assignment_buffers + free_buffers read_line get_assignment ['] process_assignment catch @@ -977,8 +806,8 @@ support-functions definitions 0 to end_of_file? reset_line_reading O_RDONLY fopen fd ! - fd @ -1 = if open_error throw then - reset_assignment_buffers + fd @ -1 = if EOPEN throw then + free_buffers read_line get_assignment ['] process_assignment catch @@ -991,39 +820,73 @@ only forth also support-functions defini \ Interface to loading conf files : load_conf ( addr len -- ) + ." ----- Trying conf " 2dup type cr 0 to end_of_file? reset_line_reading O_RDONLY fopen fd ! - fd @ -1 = if open_error throw then + fd @ -1 = if EOPEN throw then ['] process_conf catch fd @ fclose throw *** DIFF OUTPUT TRUNCATED AT 1000 LINES ***