diff options
Diffstat (limited to 'sys')
| -rw-r--r-- | sys/boot/forth/loader.4th | 106 | ||||
| -rw-r--r-- | sys/boot/forth/support.4th | 162 |
2 files changed, 152 insertions, 116 deletions
diff --git a/sys/boot/forth/loader.4th b/sys/boot/forth/loader.4th index 7a4dbcd..a125e70 100644 --- a/sys/boot/forth/loader.4th +++ b/sys/boot/forth/loader.4th @@ -50,130 +50,42 @@ s" arch-i386" environment? [if] [if] include /boot/support.4th -only forth definitions also support-functions - \ ***** boot-conf \ \ Prepares to boot as specified by loaded configuration files. -also support-functions definitions - -: set-tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 ) - \ No options, set the default ones - dup 0= if - s" kernel_options" getenv dup -1 = if - drop - else - s" temp_options" setenv - then - exit - then - - \ Skip filename - 2 pick - c@ - [char] - <> if - swap >r swap >r - 1 >r \ Filename present - 1 - \ One less argument - else - 0 >r \ Filename not present - then - - \ If no other arguments exist, use default options - ?dup 0= if - s" kernel_options" getenv dup -1 = if - drop - else - s" temp_options" setenv - then - \ Put filename back on the stack, if necessary - r> if r> r> 1 else 0 then - exit - then - - \ Concatenate remaining arguments into a single string - >r strdup r> - 1 ?do - \ Allocate new buffer - 2over nip over + 1+ - allocate if out_of_memory throw then - \ Copy old buffer over - 0 2swap over >r strcat - \ Free old buffer - r> free if free_error throw then - \ Copy a space - s" " strcat - \ Copy next string (do not free) - 2swap strcat - loop - - \ Set temp_options variable, free whatever memory that needs freeing - over >r - s" temp_options" setenv - r> free if free_error throw then - - \ Put filename back on the stack, if necessary - r> if r> r> 1 else 0 then -; - -: get-arguments ( -- addrN lenN ... addr1 len1 N ) - 0 - begin - \ Get next word on the command line - parse-word - ?dup while - 2>r ( push to the rstack, so we can retrieve in the correct order ) - 1+ - repeat - drop ( empty string ) - dup - begin - dup - while - 2r> rot - >r rot r> - 1 - - repeat - drop -; - -also builtins - -: load-conf ( args 1 | 0 "args" -- flag ) - 0= if ( interpreted ) get-arguments then - set-tempoptions - s" temp_options" getenv -1 <> if 2swap 2 else 1 then - load_kernel_and_modules -; - only forth also support-functions also builtins definitions : boot + 0= if ( interpreted ) get-arguments then + \ Unload only if a path was passed - >in @ parse-word rot >in ! - if + dup if + >r over r> swap c@ [char] - <> if 0 1 unload drop else - get-arguments 1 boot exit + 1 boot exit then else - 0 1 boot exit + 1 boot exit then load-conf ?dup 0= if 0 1 boot then ; : boot-conf + 0= if ( interpreted ) get-arguments then 0 1 unload drop load-conf ?dup 0= if 0 1 autoboot then ; also forth definitions also builtins + builtin: boot builtin: boot-conf + only forth definitions also support-functions \ ***** check-password diff --git a/sys/boot/forth/support.4th b/sys/boot/forth/support.4th index 2bfc7e9..131ce5d 100644 --- a/sys/boot/forth/support.4th +++ b/sys/boot/forth/support.4th @@ -233,6 +233,7 @@ create last_module_option sizeof module.next allot 0 last_module_option ! : 2>r postpone >r postpone >r ; immediate : 2r> postpone r> postpone r> ; immediate +: 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate \ Private definitions @@ -1299,14 +1300,13 @@ also builtins \ 1. The "bootfile" environment variable \ 2. The "kernel" environment variable \ -\ Flags are passed, if available. The parameter args must be 2 -\ if flags are being passed, or 1 if they should be ignored. -\ Dummy flags and len must be passed in the latter case. +\ Flags are passed, if available. \ \ The kernel gets loaded from the current module_path. -: load_a_kernel ( flags len args -- flag ) +: load_a_kernel ( flags len 1 | 0 -- flag ) local args + args 0= if 0 0 then 2local flags 0 0 2local kernel end-locals @@ -1314,7 +1314,7 @@ also builtins \ Check if a default kernel name exists at all, exits if not s" bootfile" getenv dup -1 <> if to kernel - flags kernel args try_multiple_kernels + flags kernel args 1+ try_multiple_kernels dup 0= if exit then then drop @@ -1327,7 +1327,7 @@ also builtins then \ Try all default kernel names - flags kernel args try_multiple_kernels + flags kernel args 1+ try_multiple_kernels ; \ Try to load a kernel; the kernel name is taken from one of @@ -1379,7 +1379,8 @@ also builtins modulepath setenv \ Try all default kernel names - flags args load_a_kernel + args 2 = if flags 1 else 0 then + load_a_kernel 0= if ( success ) oldmodulepath nip -1 <> if newmodulepath s" ;" strcat @@ -1393,12 +1394,13 @@ also builtins \ Well, try without the prepended /boot/ path newmodulepath drop swap move - path nip + newmodulepath drop path nip 2dup to newmodulepath modulepath setenv \ Try all default kernel names - flags args load_a_kernel + args 2 = if flags 1 else 0 then + load_a_kernel if ( failed once more ) oldmodulepath restoreenv newmodulepath drop free-memory @@ -1454,32 +1456,30 @@ also builtins : load_kernel_and_modules ( flags len path len' 2 | path len' 1 -- flag ) load_directory_or_file - 0= if ['] load_modules catch then + ?dup 0= if ['] load_modules catch then ; : initialize ( addr len -- ) strdup conf_files .len ! conf_files .addr ! ; -: kernel_options ( -- addr len 2 | 0 0 1 ) +: kernel_options ( -- addr len 1 | 0 ) s" kernel_options" getenv - dup -1 = if 0 0 1 else 2 then + dup -1 = if drop 0 else 1 then ; -: kernel_and_options +: kernel_and_options ( a u 1 | 0 -- a u a' u' 2 | a' u' 1 ) kernel_options s" kernel" getenv - rot + rot 1+ ; : load_kernel ( -- ) ( throws: abort ) s" kernel" getenv - dup -1 = if - \ If unset, try any kernel + dup -1 = if ( there isn't a "kernel" environment variable, try bootfile ) drop kernel_options load_a_kernel - else - \ If set, try first directory, next file name + else ( try finding a kernel using ${kernel} in various ways ) kernel_options >r 2swap r> clip_args load_from_directory dup if drop @@ -1488,7 +1488,131 @@ also builtins then abort" Unable to load a kernel!" ; - + +: set-defaultoptions ( -- ) + s" kernel_options" getenv dup -1 = if + drop + else + s" temp_options" setenv + then +; + +: argv[] ( aN uN ... a1 u1 N i -- aN uN ... a1 u1 N ai+1 ui+1 ) + 2dup = if 0 0 exit then + dup >r + 1+ 2* ( skip N and ui ) + pick + r> + 1+ 2* ( skip N and ai ) + pick +; + +: drop-args ( aN uN ... a1 u1 N -- ) + 0 ?do 2drop loop +; + +: argc + dup +; + +: queue-argv ( aN uN ... a1 u1 N a u -- a u aN uN ... a1 u1 N+1 ) + >r + over 2* 1+ -roll + r> + over 2* 1+ -roll + 1+ +; + +: unqueue-argv ( aN uN ... a1 u1 N -- aN uN ... a2 u2 N-1 a1 u1 ) + 1- -rot +; + +: strlen(argv) + dup 0= if 0 exit then + 0 >r \ Size + 0 >r \ Index + begin + argc r@ <> + while + r@ argv[] + nip + r> r> rot + 1+ + >r 1+ >r + repeat + r> drop + r> +; + +: concat-argv ( aN uN ... a1 u1 N -- a u ) + strlen(argv) allocate if out_of_memory throw then + 0 2>r + + begin + argc + while + unqueue-argv + 2r> 2swap + strcat + s" " strcat + 2>r + repeat + drop-args + 2r> +; + +: set-tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 ) + \ Save the first argument, if it exists and is not a flag + argc if + 0 argv[] drop c@ [char] - <> if + unqueue-argv 2>r \ Filename + 1 >r \ Filename present + else + 0 >r \ Filename not present + then + else + 0 >r \ Filename not present + then + + \ If there are other arguments, assume they are flags + ?dup if + concat-argv + 2dup s" temp_options" setenv + drop free if free_error throw then + else + set-defaultoptions + then + + \ Bring back the filename, if one was provided + r> if 2r> 1 else 0 then +; + +: get-arguments ( -- addrN lenN ... addr1 len1 N ) + 0 + begin + \ Get next word on the command line + parse-word + ?dup while + queue-argv + repeat + drop ( empty string ) +; + +: load-conf ( args -- flag ) + set-tempoptions + argc >r + s" temp_options" getenv dup -1 <> if + queue-argv + else + drop + then + r> if ( a path was passed ) + load_kernel_and_modules + else + load_a_kernel + ?dup 0= if ['] load_modules catch then + then +; + : read-password { size | buf len -- } size allocate if out_of_memory throw then to buf |
