1199767f8SToomas Soome\ Copyright (c) 1999 Daniel C. Sobral <dcs@FreeBSD.org> 233d05bc1SAndy Fiddaman\ Copyright 2019 OmniOS Community Edition (OmniOSce) Association. 3199767f8SToomas Soome\ All rights reserved. 433d05bc1SAndy Fiddaman\ 5199767f8SToomas Soome\ Redistribution and use in source and binary forms, with or without 6199767f8SToomas Soome\ modification, are permitted provided that the following conditions 7199767f8SToomas Soome\ are met: 8199767f8SToomas Soome\ 1. Redistributions of source code must retain the above copyright 9199767f8SToomas Soome\ notice, this list of conditions and the following disclaimer. 10199767f8SToomas Soome\ 2. Redistributions in binary form must reproduce the above copyright 11199767f8SToomas Soome\ notice, this list of conditions and the following disclaimer in the 12199767f8SToomas Soome\ documentation and/or other materials provided with the distribution. 13199767f8SToomas Soome\ 14199767f8SToomas Soome\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 15199767f8SToomas Soome\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16199767f8SToomas Soome\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17199767f8SToomas Soome\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 18199767f8SToomas Soome\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19199767f8SToomas Soome\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 20199767f8SToomas Soome\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 21199767f8SToomas Soome\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 22199767f8SToomas Soome\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 23199767f8SToomas Soome\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 24199767f8SToomas Soome\ SUCH DAMAGE. 25199767f8SToomas Soome 26199767f8SToomas Soome\ Loader.rc support functions: 27199767f8SToomas Soome\ 28199767f8SToomas Soome\ initialize ( addr len -- ) as above, plus load_conf_files 29199767f8SToomas Soome\ load_conf ( addr len -- ) load conf file given 30199767f8SToomas Soome\ include_bootenv ( -- ) load bootenv.rc 31199767f8SToomas Soome\ include_conf_files ( -- ) load all conf files in load_conf_files 32199767f8SToomas Soome\ print_syntax_error ( -- ) print line and marker of where a syntax 33199767f8SToomas Soome\ error was detected 34199767f8SToomas Soome\ print_line ( -- ) print last line processed 35199767f8SToomas Soome\ load_kernel ( -- ) load kernel 36199767f8SToomas Soome\ load_modules ( -- ) load modules flagged 37199767f8SToomas Soome\ 38199767f8SToomas Soome\ Exported structures: 39199767f8SToomas Soome\ 40199767f8SToomas Soome\ string counted string structure 41199767f8SToomas Soome\ cell .addr string address 42199767f8SToomas Soome\ cell .len string length 43199767f8SToomas Soome\ module module loading information structure 44199767f8SToomas Soome\ cell module.flag should we load it? 45199767f8SToomas Soome\ string module.name module's name 46199767f8SToomas Soome\ string module.loadname name to be used in loading the module 47199767f8SToomas Soome\ string module.type module's type (file | hash | rootfs) 48199767f8SToomas Soome\ string module.hash module's sha1 hash 49199767f8SToomas Soome\ string module.args flags to be passed during load 50199767f8SToomas Soome\ string module.largs internal argument list 51199767f8SToomas Soome\ string module.beforeload command to be executed before load 52199767f8SToomas Soome\ string module.afterload command to be executed after load 53199767f8SToomas Soome\ string module.loaderror command to be executed if load fails 54199767f8SToomas Soome\ cell module.next list chain 55199767f8SToomas Soome\ 56199767f8SToomas Soome\ Exported global variables; 57199767f8SToomas Soome\ 58199767f8SToomas Soome\ string conf_files configuration files to be loaded 59199767f8SToomas Soome\ cell modules_options pointer to first module information 60199767f8SToomas Soome\ value verbose? indicates if user wants a verbose loading 61288c4f44SToomas Soome\ value any_conf_read? indicates if a conf file was successfully read 62199767f8SToomas Soome\ 63199767f8SToomas Soome\ Other exported words: 64199767f8SToomas Soome\ note, strlen is internal 65199767f8SToomas Soome\ strdup ( addr len -- addr' len) similar to strdup(3) 66199767f8SToomas Soome\ strcat ( addr len addr' len' -- addr len+len' ) similar to strcat(3) 67199767f8SToomas Soome\ s' ( | string' -- addr len | ) similar to s" 68199767f8SToomas Soome\ rudimentary structure support 69199767f8SToomas Soome 70199767f8SToomas Soome\ Exception values 71199767f8SToomas Soome 72199767f8SToomas Soome1 constant ESYNTAX 73199767f8SToomas Soome2 constant ENOMEM 74199767f8SToomas Soome3 constant EFREE 75199767f8SToomas Soome4 constant ESETERROR \ error setting environment variable 76199767f8SToomas Soome5 constant EREAD \ error reading 77199767f8SToomas Soome6 constant EOPEN 78199767f8SToomas Soome7 constant EEXEC \ XXX never catched 79199767f8SToomas Soome8 constant EBEFORELOAD 80199767f8SToomas Soome9 constant EAFTERLOAD 81199767f8SToomas Soome 82199767f8SToomas Soome\ I/O constants 83199767f8SToomas Soome 84199767f8SToomas Soome0 constant SEEK_SET 85199767f8SToomas Soome1 constant SEEK_CUR 86199767f8SToomas Soome2 constant SEEK_END 87199767f8SToomas Soome 88199767f8SToomas Soome0 constant O_RDONLY 89199767f8SToomas Soome1 constant O_WRONLY 90199767f8SToomas Soome2 constant O_RDWR 91199767f8SToomas Soome 92199767f8SToomas Soome\ Crude structure support 93199767f8SToomas Soome 94199767f8SToomas Soome: structure: 95199767f8SToomas Soome create here 0 , ['] drop , 0 96199767f8SToomas Soome does> create here swap dup @ allot cell+ @ execute 97199767f8SToomas Soome; 98199767f8SToomas Soome: member: create dup , over , + does> cell+ @ + ; 99199767f8SToomas Soome: ;structure swap ! ; 100199767f8SToomas Soome: constructor! >body cell+ ! ; 101199767f8SToomas Soome: constructor: over :noname ; 102199767f8SToomas Soome: ;constructor postpone ; swap cell+ ! ; immediate 103199767f8SToomas Soome: sizeof ' >body @ state @ if postpone literal then ; immediate 104199767f8SToomas Soome: offsetof ' >body cell+ @ state @ if postpone literal then ; immediate 105199767f8SToomas Soome: ptr 1 cells member: ; 106199767f8SToomas Soome: int 1 cells member: ; 107199767f8SToomas Soome 108199767f8SToomas Soome\ String structure 109199767f8SToomas Soome 110199767f8SToomas Soomestructure: string 111199767f8SToomas Soome ptr .addr 112199767f8SToomas Soome int .len 113199767f8SToomas Soome constructor: 114199767f8SToomas Soome 0 over .addr ! 115199767f8SToomas Soome 0 swap .len ! 116199767f8SToomas Soome ;constructor 117199767f8SToomas Soome;structure 118199767f8SToomas Soome 119199767f8SToomas Soome 120199767f8SToomas Soome\ Module options linked list 121199767f8SToomas Soome 122199767f8SToomas Soomestructure: module 123199767f8SToomas Soome int module.flag 124199767f8SToomas Soome sizeof string member: module.name 125199767f8SToomas Soome sizeof string member: module.loadname 126199767f8SToomas Soome sizeof string member: module.type 127199767f8SToomas Soome sizeof string member: module.hash 128199767f8SToomas Soome sizeof string member: module.args 129199767f8SToomas Soome sizeof string member: module.largs 130199767f8SToomas Soome sizeof string member: module.beforeload 131199767f8SToomas Soome sizeof string member: module.afterload 132199767f8SToomas Soome sizeof string member: module.loaderror 133199767f8SToomas Soome ptr module.next 134199767f8SToomas Soome;structure 135199767f8SToomas Soome 136199767f8SToomas Soome\ Internal loader structures (preloaded_file, kernel_module, file_metadata) 137199767f8SToomas Soome\ must be in sync with the C struct in sys/boot/common/bootstrap.h 138199767f8SToomas Soomestructure: preloaded_file 139199767f8SToomas Soome ptr pf.name 140199767f8SToomas Soome ptr pf.type 141199767f8SToomas Soome ptr pf.args 142199767f8SToomas Soome ptr pf.metadata \ file_metadata 143199767f8SToomas Soome int pf.loader 144199767f8SToomas Soome int pf.addr 145199767f8SToomas Soome int pf.size 146199767f8SToomas Soome ptr pf.modules \ kernel_module 147199767f8SToomas Soome ptr pf.next \ preloaded_file 148199767f8SToomas Soome;structure 149199767f8SToomas Soome 150199767f8SToomas Soomestructure: kernel_module 151199767f8SToomas Soome ptr km.name 152199767f8SToomas Soome ptr km.args 153199767f8SToomas Soome ptr km.fp \ preloaded_file 154199767f8SToomas Soome ptr km.next \ kernel_module 155199767f8SToomas Soome;structure 156199767f8SToomas Soome 157199767f8SToomas Soomestructure: file_metadata 158199767f8SToomas Soome int md.size 159199767f8SToomas Soome 2 member: md.type \ this is not ANS Forth compatible (XXX) 160199767f8SToomas Soome ptr md.next \ file_metadata 161199767f8SToomas Soome 0 member: md.data \ variable size 162199767f8SToomas Soome;structure 163199767f8SToomas Soome 164199767f8SToomas Soome\ end of structures 165199767f8SToomas Soome 166199767f8SToomas Soome\ Global variables 167199767f8SToomas Soome 168199767f8SToomas Soomestring conf_files 169199767f8SToomas Soomecreate module_options sizeof module.next allot 0 module_options ! 170199767f8SToomas Soomecreate last_module_option sizeof module.next allot 0 last_module_option ! 171199767f8SToomas Soome0 value verbose? 172199767f8SToomas Soome 173199767f8SToomas Soome\ Support string functions 174199767f8SToomas Soome: strdup { addr len -- addr' len' } 175199767f8SToomas Soome len allocate if ENOMEM throw then 176199767f8SToomas Soome addr over len move len 177199767f8SToomas Soome; 178199767f8SToomas Soome 179199767f8SToomas Soome: strcat { addr len addr' len' -- addr len+len' } 180199767f8SToomas Soome addr' addr len + len' move 181199767f8SToomas Soome addr len len' + 182199767f8SToomas Soome; 183199767f8SToomas Soome 184199767f8SToomas Soome: strchr { addr len c -- addr' len' } 185199767f8SToomas Soome begin 186199767f8SToomas Soome len 187199767f8SToomas Soome while 188199767f8SToomas Soome addr c@ c = if addr len exit then 189199767f8SToomas Soome addr 1 + to addr 190199767f8SToomas Soome len 1 - to len 191199767f8SToomas Soome repeat 192199767f8SToomas Soome 0 0 193199767f8SToomas Soome; 194199767f8SToomas Soome 19563f9f2ffSToomas Soome: strspn { addr len addr1 len1 | paddr plen -- addr' len' } 19663f9f2ffSToomas Soome begin 19763f9f2ffSToomas Soome len 19863f9f2ffSToomas Soome while 19963f9f2ffSToomas Soome addr1 to paddr 20063f9f2ffSToomas Soome len1 to plen 20163f9f2ffSToomas Soome begin 20263f9f2ffSToomas Soome plen 20363f9f2ffSToomas Soome while 20463f9f2ffSToomas Soome addr c@ paddr c@ = if addr len exit then 20563f9f2ffSToomas Soome paddr 1+ to paddr 20663f9f2ffSToomas Soome plen 1- to plen 20763f9f2ffSToomas Soome repeat 20863f9f2ffSToomas Soome addr 1 + to addr 20963f9f2ffSToomas Soome len 1 - to len 21063f9f2ffSToomas Soome repeat 21163f9f2ffSToomas Soome 0 0 21263f9f2ffSToomas Soome; 21363f9f2ffSToomas Soome 214199767f8SToomas Soome: s' \ same as s", allows " in the string 215199767f8SToomas Soome [char] ' parse 216199767f8SToomas Soome state @ if postpone sliteral then 217199767f8SToomas Soome; immediate 218199767f8SToomas Soome 219199767f8SToomas Soome: 2>r postpone >r postpone >r ; immediate 220199767f8SToomas Soome: 2r> postpone r> postpone r> ; immediate 221199767f8SToomas Soome: 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate 222199767f8SToomas Soome 2231ea94c75SAndy Fiddaman\ Number to string 2241ea94c75SAndy Fiddaman: n2s ( n -- c-addr/u ) s>d <# #s #> ; 2251ea94c75SAndy Fiddaman\ String to number 2261ea94c75SAndy Fiddaman: s2n ( c-addr/u1 -- u2 | -1 ) ?number 0= if -1 then ; 2271ea94c75SAndy Fiddaman 2281ea94c75SAndy Fiddaman\ Test if an environment variable is set 229199767f8SToomas Soome: getenv? getenv -1 = if false else drop true then ; 230199767f8SToomas Soome 2311ea94c75SAndy Fiddaman\ Fetch a number from an environment variable, or a default if not set or does 2321ea94c75SAndy Fiddaman\ not parse (s2n returns -1). 2331ea94c75SAndy Fiddaman: getenvn ( n1 c-addr/u -- n1 | n2 ) 2341ea94c75SAndy Fiddaman getenv dup -1 = if 2351ea94c75SAndy Fiddaman \ environment variable not set 2361ea94c75SAndy Fiddaman drop ( n1 -1 -- n1 ) 2371ea94c75SAndy Fiddaman else 2381ea94c75SAndy Fiddaman s2n ( n1 c-addr/u1 -- n1 n2 ) 2391ea94c75SAndy Fiddaman dup -1 = if 2401ea94c75SAndy Fiddaman \ parse failed 2411ea94c75SAndy Fiddaman drop ( n1 n2 -- n1 ) 2421ea94c75SAndy Fiddaman else 2431ea94c75SAndy Fiddaman nip ( n1 n2 -- n2 ) 2441ea94c75SAndy Fiddaman then 2451ea94c75SAndy Fiddaman then 2461ea94c75SAndy Fiddaman; 2471ea94c75SAndy Fiddaman 24863f9f2ffSToomas Soome\ execute xt for each device listed in console variable. 24963f9f2ffSToomas Soome\ this allows us to have device specific output for logos, menu frames etc 25063f9f2ffSToomas Soome: console-iterate { xt | caddr clen taddr tlen -- } 25163f9f2ffSToomas Soome \ get current console and save it 25263f9f2ffSToomas Soome s" console" getenv 25363f9f2ffSToomas Soome ['] strdup catch if 2drop exit then 25463f9f2ffSToomas Soome to clen to caddr 25563f9f2ffSToomas Soome 25663f9f2ffSToomas Soome clen to tlen 25763f9f2ffSToomas Soome caddr to taddr 25863f9f2ffSToomas Soome begin 25963f9f2ffSToomas Soome tlen 26063f9f2ffSToomas Soome while 26163f9f2ffSToomas Soome taddr tlen s" , " strspn 26263f9f2ffSToomas Soome \ we need to handle 3 cases for addr len pairs on stack: 26363f9f2ffSToomas Soome \ addr len are 0 0 - there was no comma nor space 26463f9f2ffSToomas Soome \ addr len are x 0 - the first char is either comma or space 26563f9f2ffSToomas Soome \ addr len are x y. 26663f9f2ffSToomas Soome 2dup + 0= if 26763f9f2ffSToomas Soome \ there was no comma nor space. 26863f9f2ffSToomas Soome 2drop 26963f9f2ffSToomas Soome taddr tlen s" console" setenv 27063f9f2ffSToomas Soome xt execute 27163f9f2ffSToomas Soome 0 to tlen 27263f9f2ffSToomas Soome else dup 0= if 27363f9f2ffSToomas Soome 2drop 27463f9f2ffSToomas Soome else 27563f9f2ffSToomas Soome dup ( taddr' tlen' tlen' ) 27663f9f2ffSToomas Soome tlen swap - dup 27763f9f2ffSToomas Soome 0= if \ sequence of comma and space? 27863f9f2ffSToomas Soome drop 27963f9f2ffSToomas Soome else 28063f9f2ffSToomas Soome taddr swap s" console" setenv 28163f9f2ffSToomas Soome xt execute 28263f9f2ffSToomas Soome then 28363f9f2ffSToomas Soome to tlen 28463f9f2ffSToomas Soome to taddr 28563f9f2ffSToomas Soome then then 28663f9f2ffSToomas Soome tlen 0> if \ step over separator 28763f9f2ffSToomas Soome tlen 1- to tlen 28863f9f2ffSToomas Soome taddr 1+ to taddr 28963f9f2ffSToomas Soome then 29063f9f2ffSToomas Soome repeat 29163f9f2ffSToomas Soome caddr clen s" console" setenv \ restore console setup 29263f9f2ffSToomas Soome caddr free drop 29333d05bc1SAndy Fiddaman; 29433d05bc1SAndy Fiddaman 295a1625066SAndy Fiddaman\ Test if booted in an EFI environment 296a1625066SAndy Fiddaman: efi? ( -- flag ) 297a1625066SAndy Fiddaman s" efi-version" getenv? 298a1625066SAndy Fiddaman; 299a1625066SAndy Fiddaman 300199767f8SToomas Soome\ determine if a word appears in a string, case-insensitive 301199767f8SToomas Soome: contains? ( addr1 len1 addr2 len2 -- 0 | -1 ) 302199767f8SToomas Soome 2 pick 0= if 2drop 2drop true exit then 303199767f8SToomas Soome dup 0= if 2drop 2drop false exit then 304199767f8SToomas Soome begin 305199767f8SToomas Soome begin 306199767f8SToomas Soome swap dup c@ dup 32 = over 9 = or over 10 = or 307199767f8SToomas Soome over 13 = or over 44 = or swap drop 308199767f8SToomas Soome while 1+ swap 1- repeat 309199767f8SToomas Soome swap 2 pick 1- over < 310199767f8SToomas Soome while 311199767f8SToomas Soome 2over 2over drop over compare-insensitive 0= if 312199767f8SToomas Soome 2 pick over = if 2drop 2drop true exit then 313199767f8SToomas Soome 2 pick tuck - -rot + swap over c@ dup 32 = 314199767f8SToomas Soome over 9 = or over 10 = or over 13 = or over 44 = or 315199767f8SToomas Soome swap drop if 2drop 2drop true exit then 316199767f8SToomas Soome then begin 317199767f8SToomas Soome swap dup c@ dup 32 = over 9 = or over 10 = or 318199767f8SToomas Soome over 13 = or over 44 = or swap drop 319199767f8SToomas Soome if false else true then 2 pick 0> and 320199767f8SToomas Soome while 1+ swap 1- repeat 321199767f8SToomas Soome swap 322199767f8SToomas Soome repeat 323199767f8SToomas Soome 2drop 2drop false 324199767f8SToomas Soome; 325199767f8SToomas Soome 326199767f8SToomas Soome: boot_serial? ( -- 0 | -1 ) 327199767f8SToomas Soome s" console" getenv dup -1 <> if 328199767f8SToomas Soome 2dup 329199767f8SToomas Soome s" ttya" 2swap contains? ( addr len f ) 330199767f8SToomas Soome -rot 2dup ( f addr len addr len ) 331199767f8SToomas Soome s" ttyb" 2swap contains? ( f addr len f ) 332199767f8SToomas Soome -rot 2dup ( f f addr len addr len ) 333199767f8SToomas Soome s" ttyc" 2swap contains? ( f f addr len f ) 334199767f8SToomas Soome -rot ( f f f addr len ) 335199767f8SToomas Soome s" ttyd" 2swap contains? ( f f addr len f ) 336199767f8SToomas Soome or or or 337199767f8SToomas Soome else drop false then 338199767f8SToomas Soome s" boot_serial" getenv dup -1 <> if 339199767f8SToomas Soome swap drop 0> 340199767f8SToomas Soome else drop false then 341199767f8SToomas Soome or \ console contains tty ( or ) boot_serial 342199767f8SToomas Soome s" boot_multicons" getenv dup -1 <> if 343199767f8SToomas Soome swap drop 0> 344199767f8SToomas Soome else drop false then 345199767f8SToomas Soome or \ previous boolean ( or ) boot_multicons 346199767f8SToomas Soome; 347199767f8SToomas Soome 34863f9f2ffSToomas Soome: framebuffer? ( -- t ) 34963f9f2ffSToomas Soome s" console" getenv 35063f9f2ffSToomas Soome s" text" compare 0<> if 35163f9f2ffSToomas Soome FALSE exit 35263f9f2ffSToomas Soome then 35363f9f2ffSToomas Soome s" screen-width" getenv? 35463f9f2ffSToomas Soome; 35563f9f2ffSToomas Soome 356199767f8SToomas Soome\ Private definitions 357199767f8SToomas Soome 358199767f8SToomas Soomevocabulary support-functions 359199767f8SToomas Soomeonly forth also support-functions definitions 360199767f8SToomas Soome 361199767f8SToomas Soome\ Some control characters constants 362199767f8SToomas Soome 363199767f8SToomas Soome7 constant bell 364199767f8SToomas Soome8 constant backspace 365199767f8SToomas Soome9 constant tab 366199767f8SToomas Soome10 constant lf 367199767f8SToomas Soome13 constant <cr> 368199767f8SToomas Soome 369199767f8SToomas Soome\ Read buffer size 370199767f8SToomas Soome 371199767f8SToomas Soome80 constant read_buffer_size 372199767f8SToomas Soome 373199767f8SToomas Soome\ Standard suffixes 374199767f8SToomas Soome 375199767f8SToomas Soome: load_module_suffix s" _load" ; 376199767f8SToomas Soome: module_loadname_suffix s" _name" ; 377199767f8SToomas Soome: module_type_suffix s" _type" ; 378199767f8SToomas Soome: module_hash_suffix s" _hash" ; 379199767f8SToomas Soome: module_args_suffix s" _flags" ; 380199767f8SToomas Soome: module_beforeload_suffix s" _before" ; 381199767f8SToomas Soome: module_afterload_suffix s" _after" ; 382199767f8SToomas Soome: module_loaderror_suffix s" _error" ; 383199767f8SToomas Soome 384199767f8SToomas Soome\ Support operators 385199767f8SToomas Soome 386199767f8SToomas Soome: >= < 0= ; 387199767f8SToomas Soome: <= > 0= ; 388199767f8SToomas Soome 389199767f8SToomas Soome\ Assorted support functions 390199767f8SToomas Soome 391199767f8SToomas Soome: free-memory free if EFREE throw then ; 392199767f8SToomas Soome 393199767f8SToomas Soome: strget { var -- addr len } var .addr @ var .len @ ; 394199767f8SToomas Soome 395199767f8SToomas Soome\ assign addr len to variable. 396199767f8SToomas Soome: strset { addr len var -- } addr var .addr ! len var .len ! ; 397199767f8SToomas Soome 398199767f8SToomas Soome\ free memory and reset fields 399199767f8SToomas Soome: strfree { var -- } var .addr @ ?dup if free-memory 0 0 var strset then ; 400199767f8SToomas Soome 401199767f8SToomas Soome\ free old content, make a copy of the string and assign to variable 402199767f8SToomas Soome: string= { addr len var -- } var strfree addr len strdup var strset ; 403199767f8SToomas Soome 404199767f8SToomas Soome: strtype ( str -- ) strget type ; 405199767f8SToomas Soome 406199767f8SToomas Soome\ assign a reference to what is on the stack 407199767f8SToomas Soome: strref { addr len var -- addr len } 408199767f8SToomas Soome addr var .addr ! len var .len ! addr len 409199767f8SToomas Soome; 410199767f8SToomas Soome 411199767f8SToomas Soome\ unquote a string 412199767f8SToomas Soome: unquote ( addr len -- addr len ) 413199767f8SToomas Soome over c@ [char] " = if 2 chars - swap char+ swap then 414199767f8SToomas Soome; 415199767f8SToomas Soome 416199767f8SToomas Soome\ Assignment data temporary storage 417199767f8SToomas Soome 418199767f8SToomas Soomestring name_buffer 419199767f8SToomas Soomestring value_buffer 420199767f8SToomas Soome 421199767f8SToomas Soome\ Line by line file reading functions 422199767f8SToomas Soome\ 423199767f8SToomas Soome\ exported: 424199767f8SToomas Soome\ line_buffer 425199767f8SToomas Soome\ end_of_file? 426199767f8SToomas Soome\ fd 427199767f8SToomas Soome\ read_line 428199767f8SToomas Soome\ reset_line_reading 429199767f8SToomas Soome 430199767f8SToomas Soomevocabulary line-reading 431199767f8SToomas Soomealso line-reading definitions 432199767f8SToomas Soome 433199767f8SToomas Soome\ File data temporary storage 434199767f8SToomas Soome 435199767f8SToomas Soomestring read_buffer 436199767f8SToomas Soome0 value read_buffer_ptr 437199767f8SToomas Soome 438199767f8SToomas Soome\ File's line reading function 439199767f8SToomas Soome 440199767f8SToomas Soomeget-current ( -- wid ) previous definitions 441199767f8SToomas Soome 442199767f8SToomas Soomestring line_buffer 443199767f8SToomas Soome0 value end_of_file? 444199767f8SToomas Soomevariable fd 445199767f8SToomas Soome 446199767f8SToomas Soome>search ( wid -- ) definitions 447199767f8SToomas Soome 448199767f8SToomas Soome: skip_newlines 449199767f8SToomas Soome begin 450199767f8SToomas Soome read_buffer .len @ read_buffer_ptr > 451199767f8SToomas Soome while 452199767f8SToomas Soome read_buffer .addr @ read_buffer_ptr + c@ lf = if 453199767f8SToomas Soome read_buffer_ptr char+ to read_buffer_ptr 454199767f8SToomas Soome else 455199767f8SToomas Soome exit 456199767f8SToomas Soome then 457199767f8SToomas Soome repeat 458199767f8SToomas Soome; 459199767f8SToomas Soome 460199767f8SToomas Soome: scan_buffer ( -- addr len ) 461199767f8SToomas Soome read_buffer_ptr >r 462199767f8SToomas Soome begin 463199767f8SToomas Soome read_buffer .len @ r@ > 464199767f8SToomas Soome while 465199767f8SToomas Soome read_buffer .addr @ r@ + c@ lf = if 466199767f8SToomas Soome read_buffer .addr @ read_buffer_ptr + ( -- addr ) 467199767f8SToomas Soome r@ read_buffer_ptr - ( -- len ) 468199767f8SToomas Soome r> to read_buffer_ptr 469199767f8SToomas Soome exit 470199767f8SToomas Soome then 471199767f8SToomas Soome r> char+ >r 472199767f8SToomas Soome repeat 473199767f8SToomas Soome read_buffer .addr @ read_buffer_ptr + ( -- addr ) 474199767f8SToomas Soome r@ read_buffer_ptr - ( -- len ) 475199767f8SToomas Soome r> to read_buffer_ptr 476199767f8SToomas Soome; 477199767f8SToomas Soome 478199767f8SToomas Soome: line_buffer_resize ( len -- len ) 479e141bae1SToomas Soome dup 0= if exit then 480199767f8SToomas Soome >r 481199767f8SToomas Soome line_buffer .len @ if 482199767f8SToomas Soome line_buffer .addr @ 483199767f8SToomas Soome line_buffer .len @ r@ + 484199767f8SToomas Soome resize if ENOMEM throw then 485199767f8SToomas Soome else 486199767f8SToomas Soome r@ allocate if ENOMEM throw then 487199767f8SToomas Soome then 488199767f8SToomas Soome line_buffer .addr ! 489199767f8SToomas Soome r> 490199767f8SToomas Soome; 49133d05bc1SAndy Fiddaman 492199767f8SToomas Soome: append_to_line_buffer ( addr len -- ) 493e141bae1SToomas Soome dup 0= if 2drop exit then 494199767f8SToomas Soome line_buffer strget 495199767f8SToomas Soome 2swap strcat 496199767f8SToomas Soome line_buffer .len ! 497199767f8SToomas Soome drop 498199767f8SToomas Soome; 499199767f8SToomas Soome 500199767f8SToomas Soome: read_from_buffer 501199767f8SToomas Soome scan_buffer ( -- addr len ) 502199767f8SToomas Soome line_buffer_resize ( len -- len ) 503199767f8SToomas Soome append_to_line_buffer ( addr len -- ) 504199767f8SToomas Soome; 505199767f8SToomas Soome 506199767f8SToomas Soome: refill_required? 507199767f8SToomas Soome read_buffer .len @ read_buffer_ptr = 508199767f8SToomas Soome end_of_file? 0= and 509199767f8SToomas Soome; 510199767f8SToomas Soome 511199767f8SToomas Soome: refill_buffer 512199767f8SToomas Soome 0 to read_buffer_ptr 513199767f8SToomas Soome read_buffer .addr @ 0= if 514199767f8SToomas Soome read_buffer_size allocate if ENOMEM throw then 515199767f8SToomas Soome read_buffer .addr ! 516199767f8SToomas Soome then 517199767f8SToomas Soome fd @ read_buffer .addr @ read_buffer_size fread 518199767f8SToomas Soome dup -1 = if EREAD throw then 519199767f8SToomas Soome dup 0= if true to end_of_file? then 520199767f8SToomas Soome read_buffer .len ! 521199767f8SToomas Soome; 522199767f8SToomas Soome 523199767f8SToomas Soomeget-current ( -- wid ) previous definitions >search ( wid -- ) 524199767f8SToomas Soome 525199767f8SToomas Soome: reset_line_reading 526a0ff59d0SDan McDonald 0 to read_buffer_ptr 527199767f8SToomas Soome; 528199767f8SToomas Soome 529199767f8SToomas Soome: read_line 530199767f8SToomas Soome line_buffer strfree 531199767f8SToomas Soome skip_newlines 532199767f8SToomas Soome begin 533199767f8SToomas Soome read_from_buffer 534199767f8SToomas Soome refill_required? 535199767f8SToomas Soome while 536199767f8SToomas Soome refill_buffer 537199767f8SToomas Soome repeat 538199767f8SToomas Soome; 539199767f8SToomas Soome 540199767f8SToomas Soomeonly forth also support-functions definitions 541199767f8SToomas Soome 542199767f8SToomas Soome\ Conf file line parser: 543199767f8SToomas Soome\ <line> ::= <spaces><name><spaces>'='<spaces><value><spaces>[<comment>] | 544199767f8SToomas Soome\ <spaces>[<comment>] 545199767f8SToomas Soome\ <name> ::= <letter>{<letter>|<digit>|'_'|'-'} 546199767f8SToomas Soome\ <vname> ::= <letter>{<letter>|<digit>|'_'|'-'|','} 547199767f8SToomas Soome\ <value> ::= '"'{<character_set>|'\'<anything>}'"' | <vname> 548199767f8SToomas Soome\ <character_set> ::= ASCII 32 to 126, except '\' and '"' 549199767f8SToomas Soome\ <comment> ::= '#'{<anything>} 550199767f8SToomas Soome\ 551199767f8SToomas Soome\ bootenv line parser: 552199767f8SToomas Soome\ <line> ::= <spaces>setprop<spaces><name><spaces><value><spaces>[<comment>] | 553199767f8SToomas Soome\ <spaces>[<comment>] 554199767f8SToomas Soome\ 555199767f8SToomas Soome\ exported: 556199767f8SToomas Soome\ line_pointer 557199767f8SToomas Soome\ process_conf 558199767f8SToomas Soome\ process_conf 559199767f8SToomas Soome 560199767f8SToomas Soome0 value line_pointer 561199767f8SToomas Soome 562199767f8SToomas Soomevocabulary file-processing 563199767f8SToomas Soomealso file-processing definitions 564199767f8SToomas Soome 565199767f8SToomas Soome\ parser functions 566199767f8SToomas Soome\ 567199767f8SToomas Soome\ exported: 568199767f8SToomas Soome\ get_assignment 569199767f8SToomas Soome\ get_prop 570199767f8SToomas Soome 571199767f8SToomas Soomevocabulary parser 572199767f8SToomas Soomealso parser definitions 573199767f8SToomas Soome 574199767f8SToomas Soome0 value parsing_function 575199767f8SToomas Soome0 value end_of_line 576199767f8SToomas Soome 577199767f8SToomas Soome: end_of_line? line_pointer end_of_line = ; 578199767f8SToomas Soome 579199767f8SToomas Soome\ classifiers for various character classes in the input line 580199767f8SToomas Soome 581199767f8SToomas Soome: letter? 582199767f8SToomas Soome line_pointer c@ >r 583199767f8SToomas Soome r@ [char] A >= 584199767f8SToomas Soome r@ [char] Z <= and 585199767f8SToomas Soome r@ [char] a >= 586199767f8SToomas Soome r> [char] z <= and 587199767f8SToomas Soome or 588199767f8SToomas Soome; 589199767f8SToomas Soome 590199767f8SToomas Soome: digit? 591199767f8SToomas Soome line_pointer c@ >r 592199767f8SToomas Soome r@ [char] - = 593199767f8SToomas Soome r@ [char] 0 >= 594199767f8SToomas Soome r> [char] 9 <= and 595199767f8SToomas Soome or 596199767f8SToomas Soome; 597199767f8SToomas Soome 598199767f8SToomas Soome: "quote? line_pointer c@ [char] " = ; 599199767f8SToomas Soome 600199767f8SToomas Soome: 'quote? line_pointer c@ [char] ' = ; 601199767f8SToomas Soome 602199767f8SToomas Soome: assignment_sign? line_pointer c@ [char] = = ; 603199767f8SToomas Soome 604199767f8SToomas Soome: comment? line_pointer c@ [char] # = ; 605199767f8SToomas Soome 606199767f8SToomas Soome: space? line_pointer c@ bl = line_pointer c@ tab = or ; 607199767f8SToomas Soome 608199767f8SToomas Soome: backslash? line_pointer c@ [char] \ = ; 609199767f8SToomas Soome 610199767f8SToomas Soome: underscore? line_pointer c@ [char] _ = ; 611199767f8SToomas Soome 612199767f8SToomas Soome: dot? line_pointer c@ [char] . = ; 613199767f8SToomas Soome 614199767f8SToomas Soome: dash? line_pointer c@ [char] - = ; 615199767f8SToomas Soome 616199767f8SToomas Soome: comma? line_pointer c@ [char] , = ; 617199767f8SToomas Soome 61822cc5444SToomas Soome: at? line_pointer c@ [char] @ = ; 61922cc5444SToomas Soome 62022cc5444SToomas Soome: slash? line_pointer c@ [char] / = ; 62122cc5444SToomas Soome 62222cc5444SToomas Soome: colon? line_pointer c@ [char] : = ; 62322cc5444SToomas Soome 624199767f8SToomas Soome\ manipulation of input line 625199767f8SToomas Soome: skip_character line_pointer char+ to line_pointer ; 626199767f8SToomas Soome 627199767f8SToomas Soome: skip_to_end_of_line end_of_line to line_pointer ; 628199767f8SToomas Soome 629199767f8SToomas Soome: eat_space 630199767f8SToomas Soome begin 631199767f8SToomas Soome end_of_line? if 0 else space? then 632199767f8SToomas Soome while 633199767f8SToomas Soome skip_character 634199767f8SToomas Soome repeat 635199767f8SToomas Soome; 636199767f8SToomas Soome 637199767f8SToomas Soome: parse_name ( -- addr len ) 638199767f8SToomas Soome line_pointer 639199767f8SToomas Soome begin 640199767f8SToomas Soome end_of_line? if 0 else 641e10a6edaSToomas Soome letter? digit? underscore? dot? dash? comma? 642e10a6edaSToomas Soome or or or or or 643199767f8SToomas Soome then 644199767f8SToomas Soome while 645199767f8SToomas Soome skip_character 646199767f8SToomas Soome repeat 647199767f8SToomas Soome line_pointer over - 648199767f8SToomas Soome strdup 649199767f8SToomas Soome; 650199767f8SToomas Soome 651199767f8SToomas Soome: parse_value ( -- addr len ) 652199767f8SToomas Soome line_pointer 653199767f8SToomas Soome begin 654199767f8SToomas Soome end_of_line? if 0 else 65522cc5444SToomas Soome letter? digit? underscore? dot? comma? dash? at? slash? colon? 65622cc5444SToomas Soome or or or or or or or or 657199767f8SToomas Soome then 658199767f8SToomas Soome while 659199767f8SToomas Soome skip_character 660199767f8SToomas Soome repeat 661199767f8SToomas Soome line_pointer over - 662199767f8SToomas Soome strdup 663199767f8SToomas Soome; 664199767f8SToomas Soome 665199767f8SToomas Soome: remove_backslashes { addr len | addr' len' -- addr' len' } 666199767f8SToomas Soome len allocate if ENOMEM throw then 667199767f8SToomas Soome to addr' 668199767f8SToomas Soome addr >r 669199767f8SToomas Soome begin 670199767f8SToomas Soome addr c@ [char] \ <> if 671199767f8SToomas Soome addr c@ addr' len' + c! 672199767f8SToomas Soome len' char+ to len' 673199767f8SToomas Soome then 674199767f8SToomas Soome addr char+ to addr 675199767f8SToomas Soome r@ len + addr = 676199767f8SToomas Soome until 677199767f8SToomas Soome r> drop 678199767f8SToomas Soome addr' len' 679199767f8SToomas Soome; 680199767f8SToomas Soome 681199767f8SToomas Soome: parse_quote ( xt -- addr len ) 682199767f8SToomas Soome >r ( R: xt ) 683199767f8SToomas Soome line_pointer 684199767f8SToomas Soome skip_character 685199767f8SToomas Soome end_of_line? if ESYNTAX throw then 686199767f8SToomas Soome begin 687199767f8SToomas Soome r@ execute 0= 688199767f8SToomas Soome while 689199767f8SToomas Soome backslash? if 690199767f8SToomas Soome skip_character 691199767f8SToomas Soome end_of_line? if ESYNTAX throw then 692199767f8SToomas Soome then 693199767f8SToomas Soome skip_character 69433d05bc1SAndy Fiddaman end_of_line? if ESYNTAX throw then 695199767f8SToomas Soome repeat 696199767f8SToomas Soome r> drop 697199767f8SToomas Soome skip_character 698199767f8SToomas Soome line_pointer over - 699199767f8SToomas Soome remove_backslashes 700199767f8SToomas Soome; 701199767f8SToomas Soome 702199767f8SToomas Soome: read_name 703199767f8SToomas Soome parse_name ( -- addr len ) 704199767f8SToomas Soome name_buffer strset 705199767f8SToomas Soome; 706199767f8SToomas Soome 707199767f8SToomas Soome: read_value 708199767f8SToomas Soome "quote? if 709199767f8SToomas Soome ['] "quote? parse_quote ( -- addr len ) 710199767f8SToomas Soome else 711199767f8SToomas Soome 'quote? if 712199767f8SToomas Soome ['] 'quote? parse_quote ( -- addr len ) 713199767f8SToomas Soome else 714199767f8SToomas Soome parse_value ( -- addr len ) 715199767f8SToomas Soome then 716199767f8SToomas Soome then 717199767f8SToomas Soome value_buffer strset 718199767f8SToomas Soome; 719199767f8SToomas Soome 720199767f8SToomas Soome: comment 721199767f8SToomas Soome skip_to_end_of_line 722199767f8SToomas Soome; 723199767f8SToomas Soome 724199767f8SToomas Soome: white_space_4 725199767f8SToomas Soome eat_space 726199767f8SToomas Soome comment? if ['] comment to parsing_function exit then 727199767f8SToomas Soome end_of_line? 0= if ESYNTAX throw then 728199767f8SToomas Soome; 729199767f8SToomas Soome 730199767f8SToomas Soome: variable_value 731199767f8SToomas Soome read_value 732199767f8SToomas Soome ['] white_space_4 to parsing_function 733199767f8SToomas Soome; 734199767f8SToomas Soome 735199767f8SToomas Soome: white_space_3 736199767f8SToomas Soome eat_space 73722cc5444SToomas Soome slash? letter? digit? "quote? 'quote? or or or or if 738199767f8SToomas Soome ['] variable_value to parsing_function exit 739199767f8SToomas Soome then 740199767f8SToomas Soome ESYNTAX throw 741199767f8SToomas Soome; 742199767f8SToomas Soome 743199767f8SToomas Soome: assignment_sign 744199767f8SToomas Soome skip_character 745199767f8SToomas Soome ['] white_space_3 to parsing_function 746199767f8SToomas Soome; 747199767f8SToomas Soome 748199767f8SToomas Soome: white_space_2 749199767f8SToomas Soome eat_space 750199767f8SToomas Soome assignment_sign? if ['] assignment_sign to parsing_function exit then 751199767f8SToomas Soome ESYNTAX throw 752199767f8SToomas Soome; 753199767f8SToomas Soome 754199767f8SToomas Soome: variable_name 755199767f8SToomas Soome read_name 756199767f8SToomas Soome ['] white_space_2 to parsing_function 757199767f8SToomas Soome; 758199767f8SToomas Soome 759199767f8SToomas Soome: white_space_1 760199767f8SToomas Soome eat_space 761199767f8SToomas Soome letter? if ['] variable_name to parsing_function exit then 762199767f8SToomas Soome comment? if ['] comment to parsing_function exit then 763199767f8SToomas Soome end_of_line? 0= if ESYNTAX throw then 764199767f8SToomas Soome; 765199767f8SToomas Soome 766199767f8SToomas Soome: prop_name 767199767f8SToomas Soome eat_space 768199767f8SToomas Soome read_name 769199767f8SToomas Soome ['] white_space_3 to parsing_function 770199767f8SToomas Soome; 771199767f8SToomas Soome 772199767f8SToomas Soome: get_prop_cmd 773199767f8SToomas Soome eat_space 774199767f8SToomas Soome s" setprop" line_pointer over compare 0= 775199767f8SToomas Soome if line_pointer 7 + to line_pointer 776199767f8SToomas Soome ['] prop_name to parsing_function exit 777199767f8SToomas Soome then 778199767f8SToomas Soome comment? if ['] comment to parsing_function exit then 779199767f8SToomas Soome end_of_line? 0= if ESYNTAX throw then 780199767f8SToomas Soome; 781199767f8SToomas Soome 782199767f8SToomas Soomeget-current ( -- wid ) previous definitions >search ( wid -- ) 783199767f8SToomas Soome 784199767f8SToomas Soome: get_assignment 785199767f8SToomas Soome line_buffer strget + to end_of_line 786199767f8SToomas Soome line_buffer .addr @ to line_pointer 787199767f8SToomas Soome ['] white_space_1 to parsing_function 788199767f8SToomas Soome begin 789199767f8SToomas Soome end_of_line? 0= 790199767f8SToomas Soome while 791199767f8SToomas Soome parsing_function execute 792199767f8SToomas Soome repeat 793199767f8SToomas Soome parsing_function ['] comment = 794199767f8SToomas Soome parsing_function ['] white_space_1 = 795199767f8SToomas Soome parsing_function ['] white_space_4 = 796199767f8SToomas Soome or or 0= if ESYNTAX throw then 797199767f8SToomas Soome; 798199767f8SToomas Soome 799199767f8SToomas Soome: get_prop 800199767f8SToomas Soome line_buffer strget + to end_of_line 801199767f8SToomas Soome line_buffer .addr @ to line_pointer 802199767f8SToomas Soome ['] get_prop_cmd to parsing_function 803199767f8SToomas Soome begin 804199767f8SToomas Soome end_of_line? 0= 805199767f8SToomas Soome while 806199767f8SToomas Soome parsing_function execute 807199767f8SToomas Soome repeat 808199767f8SToomas Soome parsing_function ['] comment = 809199767f8SToomas Soome parsing_function ['] get_prop_cmd = 810199767f8SToomas Soome parsing_function ['] white_space_4 = 811199767f8SToomas Soome or or 0= if ESYNTAX throw then 812199767f8SToomas Soome; 813199767f8SToomas Soome 814199767f8SToomas Soomeonly forth also support-functions also file-processing definitions 815199767f8SToomas Soome 816199767f8SToomas Soome\ Process line 817199767f8SToomas Soome 818199767f8SToomas Soome: assignment_type? ( addr len -- flag ) 819199767f8SToomas Soome name_buffer strget 820199767f8SToomas Soome compare 0= 821199767f8SToomas Soome; 822199767f8SToomas Soome 823199767f8SToomas Soome: suffix_type? ( addr len -- flag ) 824199767f8SToomas Soome name_buffer .len @ over <= if 2drop false exit then 825199767f8SToomas Soome name_buffer .len @ over - name_buffer .addr @ + 826199767f8SToomas Soome over compare 0= 827199767f8SToomas Soome; 828199767f8SToomas Soome 829199767f8SToomas Soome: loader_conf_files? s" loader_conf_files" assignment_type? ; 830199767f8SToomas Soome 831199767f8SToomas Soome: verbose_flag? s" verbose_loading" assignment_type? ; 832199767f8SToomas Soome 833199767f8SToomas Soome: execute? s" exec" assignment_type? ; 834199767f8SToomas Soome 835199767f8SToomas Soome: module_load? load_module_suffix suffix_type? ; 836199767f8SToomas Soome 837199767f8SToomas Soome: module_loadname? module_loadname_suffix suffix_type? ; 838199767f8SToomas Soome 839199767f8SToomas Soome: module_type? module_type_suffix suffix_type? ; 840199767f8SToomas Soome 841199767f8SToomas Soome: module_hash? module_hash_suffix suffix_type? ; 842199767f8SToomas Soome 843199767f8SToomas Soome: module_args? module_args_suffix suffix_type? ; 844199767f8SToomas Soome 845199767f8SToomas Soome: module_beforeload? module_beforeload_suffix suffix_type? ; 846199767f8SToomas Soome 847199767f8SToomas Soome: module_afterload? module_afterload_suffix suffix_type? ; 848199767f8SToomas Soome 849199767f8SToomas Soome: module_loaderror? module_loaderror_suffix suffix_type? ; 850199767f8SToomas Soome 851199767f8SToomas Soome\ build a 'set' statement and execute it 852199767f8SToomas Soome: set_environment_variable 853199767f8SToomas Soome name_buffer .len @ value_buffer .len @ + 5 chars + \ size of result string 854199767f8SToomas Soome allocate if ENOMEM throw then 855199767f8SToomas Soome dup 0 \ start with an empty string and append the pieces 856199767f8SToomas Soome s" set " strcat 857199767f8SToomas Soome name_buffer strget strcat 858199767f8SToomas Soome s" =" strcat 859199767f8SToomas Soome value_buffer strget strcat 860199767f8SToomas Soome ['] evaluate catch if 861199767f8SToomas Soome 2drop free drop 862199767f8SToomas Soome ESETERROR throw 863199767f8SToomas Soome else 864199767f8SToomas Soome free-memory 865199767f8SToomas Soome then 866199767f8SToomas Soome; 867199767f8SToomas Soome 868199767f8SToomas Soome: set_conf_files 869199767f8SToomas Soome set_environment_variable 870199767f8SToomas Soome s" loader_conf_files" getenv conf_files string= 871199767f8SToomas Soome; 872199767f8SToomas Soome 873199767f8SToomas Soome: append_to_module_options_list ( addr -- ) 874199767f8SToomas Soome module_options @ 0= if 875199767f8SToomas Soome dup module_options ! 876199767f8SToomas Soome last_module_option ! 877199767f8SToomas Soome else 878199767f8SToomas Soome dup last_module_option @ module.next ! 879199767f8SToomas Soome last_module_option ! 880199767f8SToomas Soome then 881199767f8SToomas Soome; 882199767f8SToomas Soome 883199767f8SToomas Soome: set_module_name { addr -- } \ check leaks 884199767f8SToomas Soome name_buffer strget addr module.name string= 885199767f8SToomas Soome; 886199767f8SToomas Soome 887199767f8SToomas Soome: yes_value? 888199767f8SToomas Soome value_buffer strget unquote 889199767f8SToomas Soome s" yes" compare-insensitive 0= 890199767f8SToomas Soome; 891199767f8SToomas Soome 892199767f8SToomas Soome: find_module_option ( -- addr | 0 ) \ return ptr to entry matching name_buffer 893199767f8SToomas Soome module_options @ 894199767f8SToomas Soome begin 895199767f8SToomas Soome dup 896199767f8SToomas Soome while 897199767f8SToomas Soome dup module.name strget 898199767f8SToomas Soome name_buffer strget 899199767f8SToomas Soome compare 0= if exit then 900199767f8SToomas Soome module.next @ 901199767f8SToomas Soome repeat 902199767f8SToomas Soome; 903199767f8SToomas Soome 904199767f8SToomas Soome: new_module_option ( -- addr ) 905199767f8SToomas Soome sizeof module allocate if ENOMEM throw then 906199767f8SToomas Soome dup sizeof module erase 907199767f8SToomas Soome dup append_to_module_options_list 908199767f8SToomas Soome dup set_module_name 909199767f8SToomas Soome; 910199767f8SToomas Soome 911199767f8SToomas Soome: get_module_option ( -- addr ) 912199767f8SToomas Soome find_module_option 913199767f8SToomas Soome ?dup 0= if new_module_option then 914199767f8SToomas Soome; 915199767f8SToomas Soome 916199767f8SToomas Soome: set_module_flag 917199767f8SToomas Soome name_buffer .len @ load_module_suffix nip - name_buffer .len ! 918199767f8SToomas Soome yes_value? get_module_option module.flag ! 919199767f8SToomas Soome; 920199767f8SToomas Soome 921199767f8SToomas Soome: set_module_args 922199767f8SToomas Soome name_buffer .len @ module_args_suffix nip - name_buffer .len ! 923199767f8SToomas Soome value_buffer strget unquote 924199767f8SToomas Soome get_module_option module.args string= 925199767f8SToomas Soome; 926199767f8SToomas Soome 927199767f8SToomas Soome: set_module_loadname 928199767f8SToomas Soome name_buffer .len @ module_loadname_suffix nip - name_buffer .len ! 929199767f8SToomas Soome value_buffer strget unquote 930199767f8SToomas Soome get_module_option module.loadname string= 931199767f8SToomas Soome; 932199767f8SToomas Soome 933199767f8SToomas Soome: set_module_type 934199767f8SToomas Soome name_buffer .len @ module_type_suffix nip - name_buffer .len ! 935199767f8SToomas Soome value_buffer strget unquote 936199767f8SToomas Soome get_module_option module.type string= 937199767f8SToomas Soome; 938199767f8SToomas Soome 939199767f8SToomas Soome: set_module_hash 940199767f8SToomas Soome name_buffer .len @ module_hash_suffix nip - name_buffer .len ! 941199767f8SToomas Soome value_buffer strget unquote 942199767f8SToomas Soome get_module_option module.hash string= 943199767f8SToomas Soome; 944199767f8SToomas Soome 945199767f8SToomas Soome: set_module_beforeload 946199767f8SToomas Soome name_buffer .len @ module_beforeload_suffix nip - name_buffer .len ! 947199767f8SToomas Soome value_buffer strget unquote 948199767f8SToomas Soome get_module_option module.beforeload string= 949199767f8SToomas Soome; 950199767f8SToomas Soome 951199767f8SToomas Soome: set_module_afterload 952199767f8SToomas Soome name_buffer .len @ module_afterload_suffix nip - name_buffer .len ! 953199767f8SToomas Soome value_buffer strget unquote 954199767f8SToomas Soome get_module_option module.afterload string= 955199767f8SToomas Soome; 956199767f8SToomas Soome 957199767f8SToomas Soome: set_module_loaderror 958199767f8SToomas Soome name_buffer .len @ module_loaderror_suffix nip - name_buffer .len ! 959199767f8SToomas Soome value_buffer strget unquote 960199767f8SToomas Soome get_module_option module.loaderror string= 961199767f8SToomas Soome; 962199767f8SToomas Soome 963199767f8SToomas Soome: set_verbose 964199767f8SToomas Soome yes_value? to verbose? 965199767f8SToomas Soome; 966199767f8SToomas Soome 967199767f8SToomas Soome: execute_command 968199767f8SToomas Soome value_buffer strget unquote 969199767f8SToomas Soome ['] evaluate catch if EEXEC throw then 970199767f8SToomas Soome; 971199767f8SToomas Soome 972199767f8SToomas Soome: process_assignment 973199767f8SToomas Soome name_buffer .len @ 0= if exit then 974199767f8SToomas Soome loader_conf_files? if set_conf_files exit then 975199767f8SToomas Soome verbose_flag? if set_verbose exit then 976199767f8SToomas Soome execute? if execute_command exit then 977199767f8SToomas Soome module_load? if set_module_flag exit then 978199767f8SToomas Soome module_loadname? if set_module_loadname exit then 979199767f8SToomas Soome module_type? if set_module_type exit then 980199767f8SToomas Soome module_hash? if set_module_hash exit then 981199767f8SToomas Soome module_args? if set_module_args exit then 982199767f8SToomas Soome module_beforeload? if set_module_beforeload exit then 983199767f8SToomas Soome module_afterload? if set_module_afterload exit then 984199767f8SToomas Soome module_loaderror? if set_module_loaderror exit then 985199767f8SToomas Soome set_environment_variable 986199767f8SToomas Soome; 987199767f8SToomas Soome 988199767f8SToomas Soome\ free_buffer ( -- ) 989199767f8SToomas Soome\ 990199767f8SToomas Soome\ Free some pointers if needed. The code then tests for errors 991199767f8SToomas Soome\ in freeing, and throws an exception if needed. If a pointer is 992199767f8SToomas Soome\ not allocated, it's value (0) is used as flag. 993199767f8SToomas Soome 994199767f8SToomas Soome: free_buffers 995199767f8SToomas Soome name_buffer strfree 996199767f8SToomas Soome value_buffer strfree 997199767f8SToomas Soome; 998199767f8SToomas Soome 999199767f8SToomas Soome\ Higher level file processing 1000199767f8SToomas Soome 1001199767f8SToomas Soomeget-current ( -- wid ) previous definitions >search ( wid -- ) 1002199767f8SToomas Soome 1003199767f8SToomas Soome: process_bootenv 1004199767f8SToomas Soome begin 1005199767f8SToomas Soome end_of_file? 0= 1006199767f8SToomas Soome while 1007199767f8SToomas Soome free_buffers 1008199767f8SToomas Soome read_line 1009199767f8SToomas Soome get_prop 1010199767f8SToomas Soome ['] process_assignment catch 1011199767f8SToomas Soome ['] free_buffers catch 1012199767f8SToomas Soome swap throw throw 1013199767f8SToomas Soome repeat 1014199767f8SToomas Soome; 1015199767f8SToomas Soome 1016199767f8SToomas Soome: process_conf 1017199767f8SToomas Soome begin 1018199767f8SToomas Soome end_of_file? 0= 1019199767f8SToomas Soome while 1020199767f8SToomas Soome free_buffers 1021199767f8SToomas Soome read_line 1022199767f8SToomas Soome get_assignment 1023199767f8SToomas Soome ['] process_assignment catch 1024199767f8SToomas Soome ['] free_buffers catch 1025199767f8SToomas Soome swap throw throw 1026199767f8SToomas Soome repeat 1027199767f8SToomas Soome; 1028199767f8SToomas Soome 1029199767f8SToomas Soome: peek_file ( addr len -- ) 1030199767f8SToomas Soome 0 to end_of_file? 1031199767f8SToomas Soome reset_line_reading 1032199767f8SToomas Soome O_RDONLY fopen fd ! 1033199767f8SToomas Soome fd @ -1 = if EOPEN throw then 1034199767f8SToomas Soome free_buffers 1035199767f8SToomas Soome read_line 1036199767f8SToomas Soome get_assignment 1037199767f8SToomas Soome ['] process_assignment catch 1038199767f8SToomas Soome ['] free_buffers catch 1039199767f8SToomas Soome fd @ fclose 1040199767f8SToomas Soome swap throw throw 1041199767f8SToomas Soome; 104233d05bc1SAndy Fiddaman 1043199767f8SToomas Soomeonly forth also support-functions definitions 1044199767f8SToomas Soome 1045199767f8SToomas Soome\ Interface to loading conf files 1046199767f8SToomas Soome 1047199767f8SToomas Soome: load_conf ( addr len -- ) 1048199767f8SToomas Soome 0 to end_of_file? 1049199767f8SToomas Soome reset_line_reading 1050199767f8SToomas Soome O_RDONLY fopen fd ! 1051199767f8SToomas Soome fd @ -1 = if EOPEN throw then 1052199767f8SToomas Soome ['] process_conf catch 1053199767f8SToomas Soome fd @ fclose 1054199767f8SToomas Soome throw 1055199767f8SToomas Soome; 1056199767f8SToomas Soome 1057199767f8SToomas Soome: print_line line_buffer strtype cr ; 1058199767f8SToomas Soome 1059199767f8SToomas Soome: print_syntax_error 1060199767f8SToomas Soome line_buffer strtype cr 1061199767f8SToomas Soome line_buffer .addr @ 1062199767f8SToomas Soome begin 1063199767f8SToomas Soome line_pointer over <> 1064199767f8SToomas Soome while 1065199767f8SToomas Soome bl emit char+ 1066199767f8SToomas Soome repeat 1067199767f8SToomas Soome drop 1068199767f8SToomas Soome ." ^" cr 1069199767f8SToomas Soome; 1070199767f8SToomas Soome 1071199767f8SToomas Soome: load_bootenv ( addr len -- ) 1072199767f8SToomas Soome 0 to end_of_file? 1073199767f8SToomas Soome reset_line_reading 1074199767f8SToomas Soome O_RDONLY fopen fd ! 1075199767f8SToomas Soome fd @ -1 = if EOPEN throw then 1076199767f8SToomas Soome ['] process_bootenv catch 1077199767f8SToomas Soome fd @ fclose 1078199767f8SToomas Soome throw 1079199767f8SToomas Soome; 1080199767f8SToomas Soome 1081199767f8SToomas Soome\ Debugging support functions 1082199767f8SToomas Soome 1083199767f8SToomas Soomeonly forth definitions also support-functions 1084199767f8SToomas Soome 108533d05bc1SAndy Fiddaman: test-file 1086199767f8SToomas Soome ['] load_conf catch dup . 1087199767f8SToomas Soome ESYNTAX = if cr print_syntax_error then 1088199767f8SToomas Soome; 1089199767f8SToomas Soome 1090199767f8SToomas Soome\ find a module name, leave addr on the stack (0 if not found) 1091199767f8SToomas Soome: find-module ( <module> -- ptr | 0 ) 1092199767f8SToomas Soome bl parse ( addr len ) 1093f2aacf29SToomas Soome dup 0= if 2drop then ( parse did not find argument, try stack ) 1094f2aacf29SToomas Soome depth 2 < if 0 exit then 1095199767f8SToomas Soome module_options @ >r ( store current pointer ) 1096199767f8SToomas Soome begin 1097199767f8SToomas Soome r@ 1098199767f8SToomas Soome while 1099199767f8SToomas Soome 2dup ( addr len addr len ) 1100199767f8SToomas Soome r@ module.name strget 1101199767f8SToomas Soome compare 0= if drop drop r> exit then ( found it ) 1102199767f8SToomas Soome r> module.next @ >r 1103199767f8SToomas Soome repeat 1104199767f8SToomas Soome type ." was not found" cr r> 1105199767f8SToomas Soome; 1106199767f8SToomas Soome 1107199767f8SToomas Soome: show-nonempty ( addr len mod -- ) 1108199767f8SToomas Soome strget dup verbose? or if 1109199767f8SToomas Soome 2swap type type cr 1110199767f8SToomas Soome else 1111199767f8SToomas Soome drop drop drop drop 1112199767f8SToomas Soome then ; 1113199767f8SToomas Soome 1114199767f8SToomas Soome: show-one-module { addr -- addr } 1115199767f8SToomas Soome ." Name: " addr module.name strtype cr 1116199767f8SToomas Soome s" Path: " addr module.loadname show-nonempty 1117199767f8SToomas Soome s" Type: " addr module.type show-nonempty 1118199767f8SToomas Soome s" Hash: " addr module.hash show-nonempty 1119199767f8SToomas Soome s" Flags: " addr module.args show-nonempty 1120199767f8SToomas Soome s" Before load: " addr module.beforeload show-nonempty 1121199767f8SToomas Soome s" After load: " addr module.afterload show-nonempty 1122199767f8SToomas Soome s" Error: " addr module.loaderror show-nonempty 1123199767f8SToomas Soome ." Status: " addr module.flag @ if ." Load" else ." Don't load" then cr 1124199767f8SToomas Soome cr 1125199767f8SToomas Soome addr 1126199767f8SToomas Soome; 1127199767f8SToomas Soome 1128199767f8SToomas Soome: show-module-options 1129199767f8SToomas Soome module_options @ 1130199767f8SToomas Soome begin 1131199767f8SToomas Soome ?dup 1132199767f8SToomas Soome while 1133199767f8SToomas Soome show-one-module 1134199767f8SToomas Soome module.next @ 1135199767f8SToomas Soome repeat 1136199767f8SToomas Soome; 1137199767f8SToomas Soome 1138199767f8SToomas Soome: free-one-module { addr -- addr } 1139199767f8SToomas Soome addr module.name strfree 1140199767f8SToomas Soome addr module.loadname strfree 1141199767f8SToomas Soome addr module.type strfree 1142199767f8SToomas Soome addr module.hash strfree 1143199767f8SToomas Soome addr module.args strfree 1144199767f8SToomas Soome addr module.largs strfree 1145199767f8SToomas Soome addr module.beforeload strfree 1146199767f8SToomas Soome addr module.afterload strfree 1147199767f8SToomas Soome addr module.loaderror strfree 1148199767f8SToomas Soome addr 1149199767f8SToomas Soome; 1150199767f8SToomas Soome 1151199767f8SToomas Soome: free-module-options 1152199767f8SToomas Soome module_options @ 1153199767f8SToomas Soome begin 1154199767f8SToomas Soome ?dup 1155199767f8SToomas Soome while 1156199767f8SToomas Soome free-one-module 1157199767f8SToomas Soome dup module.next @ 1158199767f8SToomas Soome swap free-memory 1159199767f8SToomas Soome repeat 1160199767f8SToomas Soome 0 module_options ! 1161199767f8SToomas Soome 0 last_module_option ! 1162199767f8SToomas Soome; 1163199767f8SToomas Soome 1164199767f8SToomas Soomeonly forth also support-functions definitions 1165199767f8SToomas Soome 1166199767f8SToomas Soome\ Variables used for processing multiple conf files 1167199767f8SToomas Soome 1168199767f8SToomas Soomestring current_file_name_ref \ used to print the file name 1169199767f8SToomas Soome 1170288c4f44SToomas Soome\ Indicates if any conf file was successfully read 1171199767f8SToomas Soome 1172199767f8SToomas Soome0 value any_conf_read? 1173199767f8SToomas Soome 1174199767f8SToomas Soome\ loader_conf_files processing support functions 1175199767f8SToomas Soome 1176199767f8SToomas Soome\ true if string in addr1 is smaller than in addr2 1177199767f8SToomas Soome: compar ( addr1 addr2 -- flag ) 1178199767f8SToomas Soome swap ( addr2 addr1 ) 117933d05bc1SAndy Fiddaman dup cell+ ( addr2 addr1 addr ) 1180199767f8SToomas Soome swap @ ( addr2 addr len ) 1181199767f8SToomas Soome rot ( addr len addr2 ) 1182199767f8SToomas Soome dup cell+ ( addr len addr2 addr' ) 1183199767f8SToomas Soome swap @ ( addr len addr' len' ) 1184199767f8SToomas Soome compare -1 = 1185199767f8SToomas Soome; 1186199767f8SToomas Soome 1187199767f8SToomas Soome\ insertion sort algorithm. we dont expect large amounts of data to be 1188199767f8SToomas Soome\ sorted, so insert should be ok. compar needs to implement < operator. 1189199767f8SToomas Soome: insert ( start end -- start ) 1190199767f8SToomas Soome dup @ >r ( r: v ) \ v = a[i] 1191199767f8SToomas Soome begin 1192199767f8SToomas Soome 2dup < \ j>0 1193199767f8SToomas Soome while 1194199767f8SToomas Soome r@ over cell- @ compar \ a[j-1] > v 1195199767f8SToomas Soome while 1196199767f8SToomas Soome cell- \ j-- 1197199767f8SToomas Soome dup @ over cell+ ! \ a[j] = a[j-1] 1198199767f8SToomas Soome repeat then 1199199767f8SToomas Soome r> swap ! \ a[j] = v 1200199767f8SToomas Soome; 1201199767f8SToomas Soome 1202199767f8SToomas Soome: sort ( array len -- ) 1203199767f8SToomas Soome 1 ?do dup i cells + insert loop drop 1204199767f8SToomas Soome; 1205199767f8SToomas Soome 1206199767f8SToomas Soome: opendir 1207199767f8SToomas Soome s" /boot/conf.d" fopendir if fd ! else 1208199767f8SToomas Soome EOPEN throw 1209199767f8SToomas Soome then 1210199767f8SToomas Soome; 1211199767f8SToomas Soome 1212199767f8SToomas Soome: readdir ( addr len flag | flag ) 1213199767f8SToomas Soome fd @ freaddir 1214199767f8SToomas Soome; 1215199767f8SToomas Soome 1216199767f8SToomas Soome: closedir 1217199767f8SToomas Soome fd @ fclosedir 1218199767f8SToomas Soome; 1219199767f8SToomas Soome 1220199767f8SToomas Soome: entries ( -- n ) \ count directory entries 122133d05bc1SAndy Fiddaman ['] opendir catch ( n array ) 1222199767f8SToomas Soome throw 1223199767f8SToomas Soome 1224199767f8SToomas Soome 0 ( i ) 1225199767f8SToomas Soome begin \ count the entries 1226199767f8SToomas Soome readdir ( i addr len flag | i flag ) 1227199767f8SToomas Soome dup -1 = if 1228199767f8SToomas Soome -ROT 2drop 1229199767f8SToomas Soome swap 1+ swap 1230199767f8SToomas Soome then 1231199767f8SToomas Soome 0= 1232199767f8SToomas Soome until 1233199767f8SToomas Soome closedir 1234199767f8SToomas Soome; 1235199767f8SToomas Soome 1236199767f8SToomas Soome\ built-in prefix directory name; it must end with /, so we don't 1237199767f8SToomas Soome\ need to check and insert it. 1238199767f8SToomas Soome: make_cstring ( addr len -- addr' ) 1239199767f8SToomas Soome dup ( addr len len ) 124033d05bc1SAndy Fiddaman s" /boot/conf.d/" ( addr len len addr' len' ) 1241199767f8SToomas Soome rot ( addr len addr' len' len ) 1242199767f8SToomas Soome over + ( addr len addr' len' total ) \ space for prefix+str 1243199767f8SToomas Soome dup cell+ 1+ \ 1+ for '\0' 1244199767f8SToomas Soome allocate if 1245199767f8SToomas Soome -1 abort" malloc failed" 1246199767f8SToomas Soome then 1247199767f8SToomas Soome ( addr len addr' len' total taddr ) 1248199767f8SToomas Soome dup rot ( addr len addr' len' taddr taddr total ) 1249*28703145SToomas Soome swap ! ( addr len addr' len' taddr ) \ store length 1250*28703145SToomas Soome dup >r \ save reference 1251199767f8SToomas Soome cell+ \ point to string area 1252199767f8SToomas Soome 2dup 2>r ( addr len addr' len' taddr' ) ( R: taddr len' taddr' ) 1253199767f8SToomas Soome swap move ( addr len ) 1254199767f8SToomas Soome 2r> + ( addr len taddr' ) ( R: taddr ) 1255199767f8SToomas Soome swap 1+ move \ 1+ for '\0' 1256199767f8SToomas Soome r> ( taddr ) 1257199767f8SToomas Soome; 1258199767f8SToomas Soome 1259199767f8SToomas Soome: scan_conf_dir ( -- addr len -1 | 0 ) 126021293435SToomas Soome s" currdev" getenv -1 <> if 1261859472daSToomas Soome 3 \ we only need first 3 chars 1262859472daSToomas Soome s" net" compare 0= if 126321293435SToomas Soome s" boot.tftproot.server" getenv? if 126421293435SToomas Soome 0 exit \ readdir does not work on tftp 126521293435SToomas Soome then 126621293435SToomas Soome then 1267199767f8SToomas Soome then 1268199767f8SToomas Soome 1269199767f8SToomas Soome ['] entries catch if 1270199767f8SToomas Soome 0 exit 1271199767f8SToomas Soome then 1272199767f8SToomas Soome dup 0= if exit then \ nothing to do 1273199767f8SToomas Soome 1274199767f8SToomas Soome dup cells allocate ( n array flag ) \ allocate array 1275199767f8SToomas Soome if 0 exit then 1276199767f8SToomas Soome ['] opendir catch if ( n array ) 1277199767f8SToomas Soome free drop drop 1278199767f8SToomas Soome 0 exit 1279199767f8SToomas Soome then 1280199767f8SToomas Soome over 0 do 1281199767f8SToomas Soome readdir ( n array addr len flag | n array flag ) 1282199767f8SToomas Soome 0= if -1 abort" unexpected readdir error" then \ shouldnt happen 1283199767f8SToomas Soome ( n array addr len ) 1284199767f8SToomas Soome \ we have relative name, make it absolute and convert to counted string 1285199767f8SToomas Soome make_cstring ( n array addr ) 1286199767f8SToomas Soome over I cells + ! ( n array ) 1287199767f8SToomas Soome loop 1288199767f8SToomas Soome closedir 1289199767f8SToomas Soome 2dup swap sort 1290199767f8SToomas Soome \ we have now array of strings with directory entry names. 1291199767f8SToomas Soome \ calculate size of concatenated string 1292199767f8SToomas Soome over 0 swap 0 do ( n array 0 ) 129333d05bc1SAndy Fiddaman over I cells + @ ( n array total array[I] ) 1294199767f8SToomas Soome @ + 1+ ( n array total' ) 1295199767f8SToomas Soome loop 1296199767f8SToomas Soome dup allocate if drop free 2drop 0 exit then 1297199767f8SToomas Soome ( n array len addr ) 1298199767f8SToomas Soome \ now concatenate all entries. 1299199767f8SToomas Soome 2swap ( len addr n array ) 1300199767f8SToomas Soome over 0 swap 0 do ( len addr n array 0 ) 1301199767f8SToomas Soome over I cells + @ ( len addr n array total array[I] ) 1302199767f8SToomas Soome dup @ swap cell+ ( len addr n array total len addr' ) 130333d05bc1SAndy Fiddaman over ( len addr n array total len addr' len ) 1304199767f8SToomas Soome 6 pick ( len addr n array total len addr' len addr ) 1305199767f8SToomas Soome 4 pick + ( len addr n array total len addr' len addr+total ) 1306199767f8SToomas Soome swap move + ( len addr n array total+len ) 1307199767f8SToomas Soome 3 pick ( len addr n array total addr ) 1308199767f8SToomas Soome over + bl swap c! 1+ ( len addr n array total ) 1309199767f8SToomas Soome over I cells + @ free drop \ free array[I] 1310199767f8SToomas Soome loop 1311199767f8SToomas Soome drop free drop drop ( len addr ) 1312199767f8SToomas Soome swap ( addr len ) 1313199767f8SToomas Soome -1 1314199767f8SToomas Soome; 1315199767f8SToomas Soome 1316199767f8SToomas Soome: get_conf_files ( -- addr len ) \ put addr/len on stack, reset var 1317199767f8SToomas Soome \ ." -- starting on <" conf_files strtype ." >" cr \ debugging 1318199767f8SToomas Soome scan_conf_dir if \ concatenate with conf_files 1319199767f8SToomas Soome ( addr len ) 1320199767f8SToomas Soome dup conf_files .len @ + 2 + allocate abort" out of memory" ( addr len addr' ) 132133d05bc1SAndy Fiddaman dup conf_files strget ( addr len addr' caddr clen ) 1322199767f8SToomas Soome rot swap move ( addr len addr' ) 1323199767f8SToomas Soome \ add space 1324199767f8SToomas Soome dup conf_files .len @ + ( addr len addr' addr'+clen ) 1325199767f8SToomas Soome dup bl swap c! 1+ ( addr len addr' addr'' ) 1326199767f8SToomas Soome 3 pick swap ( addr len addr' addr addr'' ) 1327199767f8SToomas Soome 3 pick move ( addr len addr' ) 1328199767f8SToomas Soome rot ( len addr' addr ) 1329199767f8SToomas Soome free drop swap ( addr' len ) 1330199767f8SToomas Soome conf_files .len @ + 1+ ( addr len ) 1331199767f8SToomas Soome conf_files strfree 1332199767f8SToomas Soome else 1333199767f8SToomas Soome conf_files strget 0 0 conf_files strset 1334199767f8SToomas Soome then 1335199767f8SToomas Soome; 1336199767f8SToomas Soome 1337199767f8SToomas Soome: skip_leading_spaces { addr len pos -- addr len pos' } 1338199767f8SToomas Soome begin 1339199767f8SToomas Soome pos len = if 0 else addr pos + c@ bl = then 1340199767f8SToomas Soome while 1341199767f8SToomas Soome pos char+ to pos 1342199767f8SToomas Soome repeat 1343199767f8SToomas Soome addr len pos 1344199767f8SToomas Soome; 1345199767f8SToomas Soome 1346199767f8SToomas Soome\ return the file name at pos, or free the string if nothing left 1347199767f8SToomas Soome: get_file_name { addr len pos -- addr len pos' addr' len' || 0 } 134833d05bc1SAndy Fiddaman pos len = if 1349199767f8SToomas Soome addr free abort" Fatal error freeing memory" 1350199767f8SToomas Soome 0 exit 1351199767f8SToomas Soome then 1352199767f8SToomas Soome pos >r 1353199767f8SToomas Soome begin 1354199767f8SToomas Soome \ stay in the loop until have chars and they are not blank 1355199767f8SToomas Soome pos len = if 0 else addr pos + c@ bl <> then 1356199767f8SToomas Soome while 1357199767f8SToomas Soome pos char+ to pos 1358199767f8SToomas Soome repeat 1359199767f8SToomas Soome addr len pos addr r@ + pos r> - 1360199767f8SToomas Soome; 1361199767f8SToomas Soome 1362199767f8SToomas Soome: get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 ) 1363199767f8SToomas Soome skip_leading_spaces 1364199767f8SToomas Soome get_file_name 1365199767f8SToomas Soome; 1366199767f8SToomas Soome 1367199767f8SToomas Soome: print_current_file 1368199767f8SToomas Soome current_file_name_ref strtype 1369199767f8SToomas Soome; 1370199767f8SToomas Soome 1371199767f8SToomas Soome: process_conf_errors 1372199767f8SToomas Soome dup 0= if true to any_conf_read? drop exit then 1373199767f8SToomas Soome >r 2drop r> 1374199767f8SToomas Soome dup ESYNTAX = if 1375199767f8SToomas Soome ." Warning: syntax error on file " print_current_file cr 1376199767f8SToomas Soome print_syntax_error drop exit 1377199767f8SToomas Soome then 1378199767f8SToomas Soome dup ESETERROR = if 1379199767f8SToomas Soome ." Warning: bad definition on file " print_current_file cr 1380199767f8SToomas Soome print_line drop exit 1381199767f8SToomas Soome then 1382199767f8SToomas Soome dup EREAD = if 1383199767f8SToomas Soome ." Warning: error reading file " print_current_file cr drop exit 1384199767f8SToomas Soome then 1385199767f8SToomas Soome dup EOPEN = if 1386199767f8SToomas Soome verbose? if ." Warning: unable to open file " print_current_file cr then 1387199767f8SToomas Soome drop exit 1388199767f8SToomas Soome then 1389199767f8SToomas Soome dup EFREE = abort" Fatal error freeing memory" 1390199767f8SToomas Soome dup ENOMEM = abort" Out of memory" 1391199767f8SToomas Soome throw \ Unknown error -- pass ahead 1392199767f8SToomas Soome; 1393199767f8SToomas Soome 1394199767f8SToomas Soome\ Process loader_conf_files recursively 1395199767f8SToomas Soome\ Interface to loader_conf_files processing 1396199767f8SToomas Soome 1397199767f8SToomas Soome: include_bootenv 1398199767f8SToomas Soome s" /boot/solaris/bootenv.rc" 1399199767f8SToomas Soome ['] load_bootenv catch 1400199767f8SToomas Soome dup 0= if drop exit then 1401199767f8SToomas Soome >r 2drop r> 1402199767f8SToomas Soome dup ESYNTAX = if 1403199767f8SToomas Soome ." Warning: syntax error on /boot/solaris/bootenv.rc" cr drop exit 1404199767f8SToomas Soome then 1405199767f8SToomas Soome dup EREAD = if 1406199767f8SToomas Soome ." Warning: error reading /boot/solaris/bootenv.rc" cr drop exit 1407199767f8SToomas Soome then 1408199767f8SToomas Soome dup EOPEN = if 1409199767f8SToomas Soome verbose? if ." Warning: unable to open /boot/solaris/bootenv.rc" cr then 1410199767f8SToomas Soome drop exit 1411199767f8SToomas Soome then 1412199767f8SToomas Soome dup EFREE = abort" Fatal error freeing memory" 1413199767f8SToomas Soome dup ENOMEM = abort" Out of memory" 1414199767f8SToomas Soome throw \ Unknown error -- pass ahead 1415199767f8SToomas Soome; 1416199767f8SToomas Soome 1417199767f8SToomas Soome: include_transient 1418199767f8SToomas Soome s" /boot/transient.conf" ['] load_conf catch 1419199767f8SToomas Soome dup 0= if drop exit then \ no error 1420199767f8SToomas Soome >r 2drop r> 1421199767f8SToomas Soome dup ESYNTAX = if 1422199767f8SToomas Soome ." Warning: syntax error on file /boot/transient.conf" cr 1423199767f8SToomas Soome drop exit 1424199767f8SToomas Soome then 1425199767f8SToomas Soome dup ESETERROR = if 1426199767f8SToomas Soome ." Warning: bad definition on file /boot/transient.conf" cr 1427199767f8SToomas Soome drop exit 1428199767f8SToomas Soome then 1429199767f8SToomas Soome dup EREAD = if 1430199767f8SToomas Soome ." Warning: error reading file /boot/transient.conf" cr drop exit 1431199767f8SToomas Soome then 1432199767f8SToomas Soome dup EOPEN = if 1433199767f8SToomas Soome verbose? if ." Warning: unable to open file /boot/transient.conf" cr then 1434199767f8SToomas Soome drop exit 1435199767f8SToomas Soome then 1436199767f8SToomas Soome dup EFREE = abort" Fatal error freeing memory" 1437199767f8SToomas Soome dup ENOMEM = abort" Out of memory" 1438199767f8SToomas Soome throw \ Unknown error -- pass ahead 1439199767f8SToomas Soome; 1440199767f8SToomas Soome 1441199767f8SToomas Soome: include_conf_files 1442199767f8SToomas Soome get_conf_files 0 ( addr len offset ) 1443199767f8SToomas Soome begin 1444199767f8SToomas Soome get_next_file ?dup ( addr len 1 | 0 ) 1445199767f8SToomas Soome while 1446199767f8SToomas Soome current_file_name_ref strref 1447199767f8SToomas Soome ['] load_conf catch 1448199767f8SToomas Soome process_conf_errors 1449199767f8SToomas Soome conf_files .addr @ if recurse then 1450199767f8SToomas Soome repeat 1451199767f8SToomas Soome; 1452199767f8SToomas Soome 1453199767f8SToomas Soome\ Module loading functions 1454199767f8SToomas Soome 1455199767f8SToomas Soome\ concat two strings by allocating space 1456199767f8SToomas Soome: concat { a1 l1 a2 l2 -- a' l' } 1457199767f8SToomas Soome l1 l2 + allocate if ENOMEM throw then 1458199767f8SToomas Soome 0 a1 l1 strcat 1459199767f8SToomas Soome a2 l2 strcat 1460199767f8SToomas Soome; 1461199767f8SToomas Soome 1462199767f8SToomas Soome\ build module argument list as: "hash= name= module.args" 1463199767f8SToomas Soome\ if type is hash, name= will have module name without .hash suffix 1464199767f8SToomas Soome\ will free old largs and set new. 1465199767f8SToomas Soome 1466199767f8SToomas Soome: build_largs { addr -- addr } 1467199767f8SToomas Soome addr module.largs strfree 1468199767f8SToomas Soome addr module.hash .len @ 1469199767f8SToomas Soome if ( set hash= ) 1470199767f8SToomas Soome s" hash=" addr module.hash strget concat 1471199767f8SToomas Soome addr module.largs strset \ largs = "hash=" + module.hash 1472199767f8SToomas Soome then 1473199767f8SToomas Soome 1474199767f8SToomas Soome addr module.type strget s" hash" compare 0= 1475199767f8SToomas Soome if ( module.type == "hash" ) 1476199767f8SToomas Soome addr module.largs strget s" name=" concat 1477199767f8SToomas Soome 1478199767f8SToomas Soome addr module.loadname .len @ 1479199767f8SToomas Soome if ( module.loadname != NULL ) 1480199767f8SToomas Soome addr module.loadname strget concat 1481199767f8SToomas Soome else 1482199767f8SToomas Soome addr module.name strget concat 1483199767f8SToomas Soome then 1484199767f8SToomas Soome 1485199767f8SToomas Soome addr module.largs strfree 1486199767f8SToomas Soome addr module.largs strset \ largs = largs + name 1487199767f8SToomas Soome 1488199767f8SToomas Soome \ last thing to do is to strip off ".hash" suffix 1489199767f8SToomas Soome addr module.largs strget [char] . strchr 1490199767f8SToomas Soome dup if ( strchr module.largs '.' ) 1491199767f8SToomas Soome s" .hash" compare 0= 1492199767f8SToomas Soome if ( it is ".hash" ) 1493199767f8SToomas Soome addr module.largs .len @ 5 - 1494199767f8SToomas Soome addr module.largs .len ! 1495199767f8SToomas Soome then 1496199767f8SToomas Soome else 1497199767f8SToomas Soome 2drop 1498199767f8SToomas Soome then 1499199767f8SToomas Soome then 1500199767f8SToomas Soome \ and now add up the module.args 1501199767f8SToomas Soome addr module.largs strget s" " concat 1502199767f8SToomas Soome addr module.args strget concat 1503199767f8SToomas Soome addr module.largs strfree 1504199767f8SToomas Soome addr module.largs strset 1505199767f8SToomas Soome addr 1506199767f8SToomas Soome; 1507199767f8SToomas Soome 1508199767f8SToomas Soome: load_parameters { addr -- addr addrN lenN ... addr1 len1 N } 1509199767f8SToomas Soome addr build_largs 1510199767f8SToomas Soome addr module.largs strget 1511199767f8SToomas Soome addr module.loadname .len @ if 1512199767f8SToomas Soome addr module.loadname strget 1513199767f8SToomas Soome else 1514199767f8SToomas Soome addr module.name strget 1515199767f8SToomas Soome then 1516199767f8SToomas Soome addr module.type .len @ if 1517199767f8SToomas Soome addr module.type strget 1518199767f8SToomas Soome s" -t " 1519199767f8SToomas Soome 4 ( -t type name flags ) 1520199767f8SToomas Soome else 1521199767f8SToomas Soome 2 ( name flags ) 1522199767f8SToomas Soome then 1523199767f8SToomas Soome; 1524199767f8SToomas Soome 1525199767f8SToomas Soome: before_load ( addr -- addr ) 1526199767f8SToomas Soome dup module.beforeload .len @ if 1527199767f8SToomas Soome dup module.beforeload strget 1528199767f8SToomas Soome ['] evaluate catch if EBEFORELOAD throw then 1529199767f8SToomas Soome then 1530199767f8SToomas Soome; 1531199767f8SToomas Soome 1532199767f8SToomas Soome: after_load ( addr -- addr ) 1533199767f8SToomas Soome dup module.afterload .len @ if 1534199767f8SToomas Soome dup module.afterload strget 1535199767f8SToomas Soome ['] evaluate catch if EAFTERLOAD throw then 1536199767f8SToomas Soome then 1537199767f8SToomas Soome; 1538199767f8SToomas Soome 1539199767f8SToomas Soome: load_error ( addr -- addr ) 1540199767f8SToomas Soome dup module.loaderror .len @ if 1541199767f8SToomas Soome dup module.loaderror strget 1542199767f8SToomas Soome evaluate \ This we do not intercept so it can throw errors 1543199767f8SToomas Soome then 1544199767f8SToomas Soome; 1545199767f8SToomas Soome 1546199767f8SToomas Soome: pre_load_message ( addr -- addr ) 1547199767f8SToomas Soome verbose? if 1548199767f8SToomas Soome dup module.name strtype 1549199767f8SToomas Soome ." ..." 1550199767f8SToomas Soome then 1551199767f8SToomas Soome; 1552199767f8SToomas Soome 1553199767f8SToomas Soome: load_error_message verbose? if ." failed!" cr then ; 1554199767f8SToomas Soome 1555288c4f44SToomas Soome: load_successful_message verbose? if ." ok" cr then ; 1556199767f8SToomas Soome 1557199767f8SToomas Soome: load_module 1558199767f8SToomas Soome load_parameters load 1559199767f8SToomas Soome; 1560199767f8SToomas Soome 1561199767f8SToomas Soome: process_module ( addr -- addr ) 1562199767f8SToomas Soome pre_load_message 1563199767f8SToomas Soome before_load 1564199767f8SToomas Soome begin 1565199767f8SToomas Soome ['] load_module catch if 1566199767f8SToomas Soome dup module.loaderror .len @ if 1567199767f8SToomas Soome load_error \ Command should return a flag! 156833d05bc1SAndy Fiddaman else 1569199767f8SToomas Soome load_error_message true \ Do not retry 1570199767f8SToomas Soome then 1571199767f8SToomas Soome else 1572199767f8SToomas Soome after_load 1573288c4f44SToomas Soome load_successful_message true \ Successful, do not retry 1574199767f8SToomas Soome then 1575199767f8SToomas Soome until 1576199767f8SToomas Soome; 1577199767f8SToomas Soome 1578199767f8SToomas Soome: process_module_errors ( addr ior -- ) 1579199767f8SToomas Soome dup EBEFORELOAD = if 1580199767f8SToomas Soome drop 1581199767f8SToomas Soome ." Module " 1582199767f8SToomas Soome dup module.name strtype 1583199767f8SToomas Soome dup module.loadname .len @ if 1584199767f8SToomas Soome ." (" dup module.loadname strtype ." )" 1585199767f8SToomas Soome then 1586199767f8SToomas Soome cr 1587199767f8SToomas Soome ." Error executing " 1588199767f8SToomas Soome dup module.beforeload strtype cr \ XXX there was a typo here 1589199767f8SToomas Soome abort 1590199767f8SToomas Soome then 1591199767f8SToomas Soome 1592199767f8SToomas Soome dup EAFTERLOAD = if 1593199767f8SToomas Soome drop 1594199767f8SToomas Soome ." Module " 1595199767f8SToomas Soome dup module.name .addr @ over module.name .len @ type 1596199767f8SToomas Soome dup module.loadname .len @ if 1597199767f8SToomas Soome ." (" dup module.loadname strtype ." )" 1598199767f8SToomas Soome then 1599199767f8SToomas Soome cr 1600199767f8SToomas Soome ." Error executing " 1601199767f8SToomas Soome dup module.afterload strtype cr 1602199767f8SToomas Soome abort 1603199767f8SToomas Soome then 1604199767f8SToomas Soome 1605199767f8SToomas Soome throw \ Don't know what it is all about -- pass ahead 1606199767f8SToomas Soome; 1607199767f8SToomas Soome 1608199767f8SToomas Soome\ Module loading interface 1609199767f8SToomas Soome 1610199767f8SToomas Soome\ scan the list of modules, load enabled ones. 1611199767f8SToomas Soome: load_modules ( -- ) ( throws: abort & user-defined ) 1612199767f8SToomas Soome module_options @ ( list_head ) 1613199767f8SToomas Soome begin 1614199767f8SToomas Soome ?dup 1615199767f8SToomas Soome while 1616199767f8SToomas Soome dup module.flag @ if 1617199767f8SToomas Soome ['] process_module catch 1618199767f8SToomas Soome process_module_errors 1619199767f8SToomas Soome then 1620199767f8SToomas Soome module.next @ 1621199767f8SToomas Soome repeat 1622199767f8SToomas Soome; 1623199767f8SToomas Soome 1624199767f8SToomas Soome\ h00h00 magic used to try loading either a kernel with a given name, 1625199767f8SToomas Soome\ or a kernel with the default name in a directory of a given name 1626199767f8SToomas Soome\ (the pain!) 1627199767f8SToomas Soome 1628199767f8SToomas Soome: bootpath s" /platform/" ; 1629199767f8SToomas Soome: modulepath s" module_path" ; 1630199767f8SToomas Soome 1631199767f8SToomas Soome\ Functions used to save and restore module_path's value. 1632199767f8SToomas Soome: saveenv ( addr len | -1 -- addr' len | 0 -1 ) 1633199767f8SToomas Soome dup -1 = if 0 swap exit then 1634199767f8SToomas Soome strdup 1635199767f8SToomas Soome; 1636199767f8SToomas Soome: freeenv ( addr len | 0 -1 ) 1637199767f8SToomas Soome -1 = if drop else free abort" Freeing error" then 1638199767f8SToomas Soome; 1639199767f8SToomas Soome: restoreenv ( addr len | 0 -1 -- ) 1640199767f8SToomas Soome dup -1 = if ( it wasn't set ) 1641199767f8SToomas Soome 2drop 1642199767f8SToomas Soome modulepath unsetenv 1643199767f8SToomas Soome else 1644199767f8SToomas Soome over >r 1645199767f8SToomas Soome modulepath setenv 1646199767f8SToomas Soome r> free abort" Freeing error" 1647199767f8SToomas Soome then 1648199767f8SToomas Soome; 1649199767f8SToomas Soome 1650199767f8SToomas Soome: clip_args \ Drop second string if only one argument is passed 1651199767f8SToomas Soome 1 = if 1652199767f8SToomas Soome 2swap 2drop 1653199767f8SToomas Soome 1 1654199767f8SToomas Soome else 1655199767f8SToomas Soome 2 1656199767f8SToomas Soome then 1657199767f8SToomas Soome; 1658199767f8SToomas Soome 1659199767f8SToomas Soomealso builtins 1660199767f8SToomas Soome 1661199767f8SToomas Soome\ Parse filename from a semicolon-separated list 1662199767f8SToomas Soome 1663199767f8SToomas Soome: parse-; ( addr len -- addr' len-x addr x ) 1664199767f8SToomas Soome over 0 2swap ( addr 0 addr len ) 1665199767f8SToomas Soome begin 1666199767f8SToomas Soome dup 0 <> ( addr 0 addr len ) 1667199767f8SToomas Soome while 1668199767f8SToomas Soome over c@ [char] ; <> ( addr 0 addr len flag ) 1669199767f8SToomas Soome while 1670199767f8SToomas Soome 1- swap 1+ swap 1671199767f8SToomas Soome 2swap 1+ 2swap 1672199767f8SToomas Soome repeat then 1673199767f8SToomas Soome dup 0 <> if 1674199767f8SToomas Soome 1- swap 1+ swap 1675199767f8SToomas Soome then 1676199767f8SToomas Soome 2swap 1677199767f8SToomas Soome; 1678199767f8SToomas Soome 1679199767f8SToomas Soome\ Try loading one of multiple kernels specified 1680199767f8SToomas Soome 1681199767f8SToomas Soome: try_multiple_kernels ( addr len addr' len' args -- flag ) 1682199767f8SToomas Soome >r 1683199767f8SToomas Soome begin 1684199767f8SToomas Soome parse-; 2>r 1685199767f8SToomas Soome 2over 2r> 1686199767f8SToomas Soome r@ clip_args 1687199767f8SToomas Soome s" DEBUG" getenv? if 1688199767f8SToomas Soome s" echo Module_path: ${module_path}" evaluate 1689199767f8SToomas Soome ." Kernel : " >r 2dup type r> cr 1690199767f8SToomas Soome dup 2 = if ." Flags : " >r 2over type r> cr then 1691199767f8SToomas Soome then 1692199767f8SToomas Soome \ if it's xen, the xen kernel is loaded, unix needs to be loaded as module 16939aa2d72cSToomas Soome s" xen_kernel" getenv -1 <> if 16949aa2d72cSToomas Soome drop \ drop address from getenv 16959aa2d72cSToomas Soome >r \ argument count to R 16969aa2d72cSToomas Soome s" kernel" s" -t " \ push 2 strings into the stack 16979aa2d72cSToomas Soome r> 2 + \ increment argument count 16989aa2d72cSToomas Soome then 16999aa2d72cSToomas Soome 17009aa2d72cSToomas Soome 1 ['] load catch dup if 17019aa2d72cSToomas Soome ( addr0 len0 addr1 len1 ... args 1 error ) 17029aa2d72cSToomas Soome >r \ error code to R 1703*28703145SToomas Soome drop \ drop 1 17049aa2d72cSToomas Soome 0 do 2drop loop \ drop addr len pairs 1705*28703145SToomas Soome r> \ set flag for while 1706199767f8SToomas Soome then 1707199767f8SToomas Soome while 1708199767f8SToomas Soome dup 0= 1709199767f8SToomas Soome until 1710199767f8SToomas Soome 1 >r \ Failure 1711199767f8SToomas Soome else 1712199767f8SToomas Soome 0 >r \ Success 1713199767f8SToomas Soome then 1714199767f8SToomas Soome 2drop 2drop 1715199767f8SToomas Soome r> 1716199767f8SToomas Soome r> drop 1717199767f8SToomas Soome; 1718199767f8SToomas Soome 1719199767f8SToomas Soome\ Try to load a kernel; the kernel name is taken from one of 1720199767f8SToomas Soome\ the following lists, as ordered: 1721199767f8SToomas Soome\ 1722199767f8SToomas Soome\ 1. The "bootfile" environment variable 1723199767f8SToomas Soome\ 2. The "kernel" environment variable 1724199767f8SToomas Soome\ 1725199767f8SToomas Soome\ Flags are passed, if available. If not, dummy values must be given. 1726199767f8SToomas Soome\ 1727199767f8SToomas Soome\ The kernel gets loaded from the current module_path. 1728199767f8SToomas Soome 1729199767f8SToomas Soome: load_a_kernel ( flags len 1 | x x 0 -- flag ) 1730199767f8SToomas Soome local args 1731199767f8SToomas Soome 2local flags 1732199767f8SToomas Soome 0 0 2local kernel 1733199767f8SToomas Soome end-locals 1734199767f8SToomas Soome 1735199767f8SToomas Soome \ Check if a default kernel name exists at all, exits if not 1736199767f8SToomas Soome s" bootfile" getenv dup -1 <> if 1737199767f8SToomas Soome to kernel 1738199767f8SToomas Soome flags kernel args 1+ try_multiple_kernels 1739199767f8SToomas Soome dup 0= if exit then 1740199767f8SToomas Soome then 1741199767f8SToomas Soome drop 1742199767f8SToomas Soome 1743199767f8SToomas Soome s" kernel" getenv dup -1 <> if 1744199767f8SToomas Soome to kernel 1745199767f8SToomas Soome else 1746199767f8SToomas Soome drop 1747199767f8SToomas Soome 1 exit \ Failure 1748199767f8SToomas Soome then 1749199767f8SToomas Soome 1750199767f8SToomas Soome \ Try all default kernel names 1751199767f8SToomas Soome flags kernel args 1+ try_multiple_kernels 1752199767f8SToomas Soome; 1753199767f8SToomas Soome 1754199767f8SToomas Soome\ Try to load a kernel; the kernel name is taken from one of 1755199767f8SToomas Soome\ the following lists, as ordered: 1756199767f8SToomas Soome\ 1757199767f8SToomas Soome\ 1. The "bootfile" environment variable 1758199767f8SToomas Soome\ 2. The "kernel" environment variable 1759199767f8SToomas Soome\ 1760199767f8SToomas Soome\ Flags are passed, if provided. 1761199767f8SToomas Soome\ 1762199767f8SToomas Soome\ The kernel will be loaded from a directory computed from the 1763199767f8SToomas Soome\ path given. Two directories will be tried in the following order: 1764199767f8SToomas Soome\ 1765199767f8SToomas Soome\ 1. /boot/path 1766199767f8SToomas Soome\ 2. path 1767199767f8SToomas Soome\ 1768288c4f44SToomas Soome\ The module_path variable is overridden if load is successful, by 1769199767f8SToomas Soome\ prepending the successful path. 1770199767f8SToomas Soome 1771199767f8SToomas Soome: load_from_directory ( path len 1 | flags len' path len 2 -- flag ) 1772199767f8SToomas Soome local args 1773199767f8SToomas Soome 2local path 1774199767f8SToomas Soome args 1 = if 0 0 then 1775199767f8SToomas Soome 2local flags 1776199767f8SToomas Soome 0 0 2local oldmodulepath \ like a string 1777199767f8SToomas Soome 0 0 2local newmodulepath \ like a string 1778199767f8SToomas Soome end-locals 1779199767f8SToomas Soome 1780199767f8SToomas Soome \ Set the environment variable module_path, and try loading 1781199767f8SToomas Soome \ the kernel again. 1782199767f8SToomas Soome modulepath getenv saveenv to oldmodulepath 1783199767f8SToomas Soome 1784199767f8SToomas Soome \ Try prepending /boot/ first 178533d05bc1SAndy Fiddaman bootpath nip path nip + \ total length 1786199767f8SToomas Soome oldmodulepath nip dup -1 = if 1787199767f8SToomas Soome drop 1788199767f8SToomas Soome else 1789199767f8SToomas Soome 1+ + \ add oldpath -- XXX why the 1+ ? 1790199767f8SToomas Soome then 1791199767f8SToomas Soome allocate if ( out of memory ) 1 exit then \ XXX throw ? 1792199767f8SToomas Soome 1793199767f8SToomas Soome 0 1794199767f8SToomas Soome bootpath strcat 1795199767f8SToomas Soome path strcat 1796199767f8SToomas Soome 2dup to newmodulepath 1797199767f8SToomas Soome modulepath setenv 1798199767f8SToomas Soome 1799199767f8SToomas Soome \ Try all default kernel names 1800199767f8SToomas Soome flags args 1- load_a_kernel 1801199767f8SToomas Soome 0= if ( success ) 1802199767f8SToomas Soome oldmodulepath nip -1 <> if 1803199767f8SToomas Soome newmodulepath s" ;" strcat 1804199767f8SToomas Soome oldmodulepath strcat 1805199767f8SToomas Soome modulepath setenv 1806199767f8SToomas Soome newmodulepath drop free-memory 1807199767f8SToomas Soome oldmodulepath drop free-memory 1808199767f8SToomas Soome then 1809199767f8SToomas Soome 0 exit 1810199767f8SToomas Soome then 1811199767f8SToomas Soome 1812199767f8SToomas Soome \ Well, try without the prepended /boot/ 1813199767f8SToomas Soome path newmodulepath drop swap move 1814199767f8SToomas Soome newmodulepath drop path nip 1815199767f8SToomas Soome 2dup to newmodulepath 1816199767f8SToomas Soome modulepath setenv 1817199767f8SToomas Soome 1818199767f8SToomas Soome \ Try all default kernel names 1819199767f8SToomas Soome flags args 1- load_a_kernel 1820199767f8SToomas Soome if ( failed once more ) 1821199767f8SToomas Soome oldmodulepath restoreenv 1822199767f8SToomas Soome newmodulepath drop free-memory 1823199767f8SToomas Soome 1 1824199767f8SToomas Soome else 1825199767f8SToomas Soome oldmodulepath nip -1 <> if 1826199767f8SToomas Soome newmodulepath s" ;" strcat 1827199767f8SToomas Soome oldmodulepath strcat 1828199767f8SToomas Soome modulepath setenv 1829199767f8SToomas Soome newmodulepath drop free-memory 1830199767f8SToomas Soome oldmodulepath drop free-memory 1831199767f8SToomas Soome then 1832199767f8SToomas Soome 0 1833199767f8SToomas Soome then 1834199767f8SToomas Soome; 1835199767f8SToomas Soome 1836199767f8SToomas Soome\ Try to load a kernel; the kernel name is taken from one of 1837199767f8SToomas Soome\ the following lists, as ordered: 1838199767f8SToomas Soome\ 1839199767f8SToomas Soome\ 1. The "bootfile" environment variable 1840199767f8SToomas Soome\ 2. The "kernel" environment variable 1841199767f8SToomas Soome\ 3. The "path" argument 1842199767f8SToomas Soome\ 1843199767f8SToomas Soome\ Flags are passed, if provided. 1844199767f8SToomas Soome\ 1845199767f8SToomas Soome\ The kernel will be loaded from a directory computed from the 1846199767f8SToomas Soome\ path given. Two directories will be tried in the following order: 1847199767f8SToomas Soome\ 1848199767f8SToomas Soome\ 1. /boot/path 1849199767f8SToomas Soome\ 2. path 1850199767f8SToomas Soome\ 1851199767f8SToomas Soome\ Unless "path" is meant to be kernel name itself. In that case, it 1852199767f8SToomas Soome\ will first be tried as a full path, and, next, search on the 1853199767f8SToomas Soome\ directories pointed by module_path. 1854199767f8SToomas Soome\ 1855288c4f44SToomas Soome\ The module_path variable is overridden if load is successful, by 1856199767f8SToomas Soome\ prepending the successful path. 1857199767f8SToomas Soome 1858199767f8SToomas Soome: load_directory_or_file ( path len 1 | flags len' path len 2 -- flag ) 1859199767f8SToomas Soome local args 1860199767f8SToomas Soome 2local path 1861199767f8SToomas Soome args 1 = if 0 0 then 1862199767f8SToomas Soome 2local flags 1863199767f8SToomas Soome end-locals 1864199767f8SToomas Soome 1865199767f8SToomas Soome \ First, assume path is an absolute path to a directory 1866199767f8SToomas Soome flags path args clip_args load_from_directory 1867199767f8SToomas Soome dup 0= if exit else drop then 1868199767f8SToomas Soome 1869199767f8SToomas Soome \ Next, assume path points to the kernel 1870199767f8SToomas Soome flags path args try_multiple_kernels 1871199767f8SToomas Soome; 1872199767f8SToomas Soome 1873199767f8SToomas Soome: initialize ( addr len -- ) 1874199767f8SToomas Soome strdup conf_files strset 1875199767f8SToomas Soome; 1876199767f8SToomas Soome 1877199767f8SToomas Soome: boot-args ( -- addr len 1 | 0 ) 1878199767f8SToomas Soome s" boot-args" getenv 1879199767f8SToomas Soome dup -1 = if drop 0 else 1 then 1880199767f8SToomas Soome; 1881199767f8SToomas Soome 1882199767f8SToomas Soome: standard_kernel_search ( flags 1 | 0 -- flag ) 1883199767f8SToomas Soome local args 1884199767f8SToomas Soome args 0= if 0 0 then 1885199767f8SToomas Soome 2local flags 1886199767f8SToomas Soome s" kernel" getenv 1887199767f8SToomas Soome dup -1 = if 0 swap then 1888199767f8SToomas Soome 2local path 1889199767f8SToomas Soome end-locals 1890199767f8SToomas Soome 1891199767f8SToomas Soome path nip -1 = if ( there isn't a "kernel" environment variable ) 1892199767f8SToomas Soome flags args load_a_kernel 1893199767f8SToomas Soome else 1894199767f8SToomas Soome flags path args 1+ clip_args load_directory_or_file 1895199767f8SToomas Soome then 1896199767f8SToomas Soome; 1897199767f8SToomas Soome 1898199767f8SToomas Soome: load_kernel ( -- ) ( throws: abort ) 1899199767f8SToomas Soome s" xen_kernel" getenv -1 = if 1900199767f8SToomas Soome boot-args standard_kernel_search 1901199767f8SToomas Soome abort" Unable to load a kernel!" 1902199767f8SToomas Soome exit 1903199767f8SToomas Soome then 1904199767f8SToomas Soome 1905199767f8SToomas Soome drop 1906199767f8SToomas Soome \ we have loaded the xen kernel, load unix as module 1907199767f8SToomas Soome s" bootfile" getenv dup -1 <> if 1908199767f8SToomas Soome s" kernel" s" -t " 3 1 load 1909199767f8SToomas Soome then 1910199767f8SToomas Soome abort" Unable to load a kernel!" 1911199767f8SToomas Soome; 1912199767f8SToomas Soome 1913199767f8SToomas Soome: load_xen ( -- ) 1914199767f8SToomas Soome s" xen_kernel" getenv dup -1 <> if 1915199767f8SToomas Soome 1 1 load ( c-addr/u flag N -- flag ) 1916199767f8SToomas Soome else 1917199767f8SToomas Soome drop 1918199767f8SToomas Soome 0 ( -1 -- flag ) 1919199767f8SToomas Soome then 1920199767f8SToomas Soome; 1921199767f8SToomas Soome 1922199767f8SToomas Soome: load_xen_throw ( -- ) ( throws: abort ) 1923199767f8SToomas Soome load_xen 1924199767f8SToomas Soome abort" Unable to load Xen!" 1925199767f8SToomas Soome; 1926199767f8SToomas Soome 1927199767f8SToomas Soome: set_defaultoptions ( -- ) 1928199767f8SToomas Soome s" boot-args" getenv dup -1 = if 1929199767f8SToomas Soome drop 1930199767f8SToomas Soome else 1931199767f8SToomas Soome s" temp_options" setenv 1932199767f8SToomas Soome then 1933199767f8SToomas Soome; 1934199767f8SToomas Soome 1935199767f8SToomas Soome\ pick the i-th argument, i starts at 0 1936199767f8SToomas Soome: argv[] ( aN uN ... a1 u1 N i -- aN uN ... a1 u1 N ai+1 ui+1 ) 1937199767f8SToomas Soome 2dup = if 0 0 exit then \ out of range 1938199767f8SToomas Soome dup >r 1939199767f8SToomas Soome 1+ 2* ( skip N and ui ) 1940199767f8SToomas Soome pick 1941199767f8SToomas Soome r> 1942199767f8SToomas Soome 1+ 2* ( skip N and ai ) 1943199767f8SToomas Soome pick 1944199767f8SToomas Soome; 1945199767f8SToomas Soome 1946199767f8SToomas Soome: drop_args ( aN uN ... a1 u1 N -- ) 1947199767f8SToomas Soome 0 ?do 2drop loop 1948199767f8SToomas Soome; 1949199767f8SToomas Soome 1950199767f8SToomas Soome: argc 1951199767f8SToomas Soome dup 1952199767f8SToomas Soome; 1953199767f8SToomas Soome 1954199767f8SToomas Soome: queue_argv ( aN uN ... a1 u1 N a u -- a u aN uN ... a1 u1 N+1 ) 1955199767f8SToomas Soome >r 1956199767f8SToomas Soome over 2* 1+ -roll 1957199767f8SToomas Soome r> 1958199767f8SToomas Soome over 2* 1+ -roll 1959199767f8SToomas Soome 1+ 1960199767f8SToomas Soome; 1961199767f8SToomas Soome 1962199767f8SToomas Soome: unqueue_argv ( aN uN ... a1 u1 N -- aN uN ... a2 u2 N-1 a1 u1 ) 1963199767f8SToomas Soome 1- -rot 1964199767f8SToomas Soome; 1965199767f8SToomas Soome 1966199767f8SToomas Soome\ compute the length of the buffer including the spaces between words 1967199767f8SToomas Soome: strlen(argv) ( aN uN .. a1 u1 N -- aN uN .. a1 u1 N len ) 1968199767f8SToomas Soome dup 0= if 0 exit then 1969199767f8SToomas Soome 0 >r \ Size 1970199767f8SToomas Soome 0 >r \ Index 1971199767f8SToomas Soome begin 1972199767f8SToomas Soome argc r@ <> 1973199767f8SToomas Soome while 1974199767f8SToomas Soome r@ argv[] 1975199767f8SToomas Soome nip 1976199767f8SToomas Soome r> r> rot + 1+ 1977199767f8SToomas Soome >r 1+ >r 1978199767f8SToomas Soome repeat 1979199767f8SToomas Soome r> drop 1980199767f8SToomas Soome r> 1981199767f8SToomas Soome; 1982199767f8SToomas Soome 1983199767f8SToomas Soome: concat_argv ( aN uN ... a1 u1 N -- a u ) 1984199767f8SToomas Soome strlen(argv) allocate if ENOMEM throw then 1985199767f8SToomas Soome 0 2>r ( save addr 0 on return stack ) 1986199767f8SToomas Soome 1987199767f8SToomas Soome begin 1988199767f8SToomas Soome dup 1989199767f8SToomas Soome while 1990199767f8SToomas Soome unqueue_argv ( ... N a1 u1 ) 1991199767f8SToomas Soome 2r> 2swap ( old a1 u1 ) 1992199767f8SToomas Soome strcat 1993199767f8SToomas Soome s" " strcat ( append one space ) \ XXX this gives a trailing space 1994199767f8SToomas Soome 2>r ( store string on the result stack ) 1995199767f8SToomas Soome repeat 1996199767f8SToomas Soome drop_args 1997199767f8SToomas Soome 2r> 1998199767f8SToomas Soome; 1999199767f8SToomas Soome 2000199767f8SToomas Soome: set_tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 ) 2001199767f8SToomas Soome \ Save the first argument, if it exists and is not a flag 2002199767f8SToomas Soome argc if 2003199767f8SToomas Soome 0 argv[] drop c@ [char] - <> if 2004199767f8SToomas Soome unqueue_argv 2>r \ Filename 2005199767f8SToomas Soome 1 >r \ Filename present 2006199767f8SToomas Soome else 2007199767f8SToomas Soome 0 >r \ Filename not present 2008199767f8SToomas Soome then 2009199767f8SToomas Soome else 2010199767f8SToomas Soome 0 >r \ Filename not present 2011199767f8SToomas Soome then 2012199767f8SToomas Soome 2013199767f8SToomas Soome \ If there are other arguments, assume they are flags 2014199767f8SToomas Soome ?dup if 2015199767f8SToomas Soome concat_argv 2016199767f8SToomas Soome 2dup s" temp_options" setenv 2017199767f8SToomas Soome drop free if EFREE throw then 2018199767f8SToomas Soome else 2019199767f8SToomas Soome set_defaultoptions 2020199767f8SToomas Soome then 2021199767f8SToomas Soome 2022199767f8SToomas Soome \ Bring back the filename, if one was provided 2023199767f8SToomas Soome r> if 2r> 1 else 0 then 2024199767f8SToomas Soome; 2025199767f8SToomas Soome 2026199767f8SToomas Soome: get_arguments ( -- addrN lenN ... addr1 len1 N ) 2027199767f8SToomas Soome 0 2028199767f8SToomas Soome begin 2029199767f8SToomas Soome \ Get next word on the command line 2030199767f8SToomas Soome parse-word 2031199767f8SToomas Soome ?dup while 2032199767f8SToomas Soome queue_argv 2033199767f8SToomas Soome repeat 2034199767f8SToomas Soome drop ( empty string ) 2035199767f8SToomas Soome; 2036199767f8SToomas Soome 2037199767f8SToomas Soome: load_kernel_and_modules ( args -- flag ) 2038199767f8SToomas Soome set_tempoptions 2039199767f8SToomas Soome argc >r 2040199767f8SToomas Soome s" temp_options" getenv dup -1 <> if 2041199767f8SToomas Soome queue_argv 2042199767f8SToomas Soome else 2043199767f8SToomas Soome drop 2044199767f8SToomas Soome then 2045199767f8SToomas Soome load_xen 2046199767f8SToomas Soome ?dup 0= if ( success ) 2047199767f8SToomas Soome r> if ( a path was passed ) 2048199767f8SToomas Soome load_directory_or_file 2049199767f8SToomas Soome else 2050199767f8SToomas Soome standard_kernel_search 2051199767f8SToomas Soome then 2052199767f8SToomas Soome ?dup 0= if ['] load_modules catch then 2053199767f8SToomas Soome then 2054199767f8SToomas Soome; 2055199767f8SToomas Soome 2056199767f8SToomas Soomeonly forth definitions 2057