1\ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org>
2\ All rights reserved.
3\
4\ Redistribution and use in source and binary forms, with or without
5\ modification, are permitted provided that the following conditions
6\ are met:
7\ 1. Redistributions of source code must retain the above copyright
8\ notice, this list of conditions and the following disclaimer.
--- 8 unchanged lines hidden (view full) ---
17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
23\ SUCH DAMAGE.
24\
25\ $FreeBSD: head/sys/boot/forth/support.4th 50477 1999-08-28 01:08:13Z peter $
26
27\ Loader.rc support functions:
28\
29\ initialize_support ( -- ) initialize global variables
30\ initialize ( addr len -- ) as above, plus load_conf_files
31\ load_conf ( addr len -- ) load conf file given
32\ include_conf_files ( -- ) load all conf files in load_conf_files
33\ print_syntax_error ( -- ) print line and marker of where a syntax
--- 16 unchanged lines hidden (view full) ---
50\ string module.beforeload command to be executed before load
51\ string module.afterload command to be executed after load
52\ string module.loaderror command to be executed if load fails
53\ cell module.next list chain
54\
55\ Exported global variables;
56\
57\ string conf_files configuration files to be loaded
58\ cell modules_options pointer to first module information
59\ value verbose? indicates if user wants a verbose loading
60\ value any_conf_read? indicates if a conf file was succesfully read
61\
62\ Other exported words:
63\
64\ strdup ( addr len -- addr' len) similar to strdup(3)
65\ strcat ( addr len addr' len' -- addr len+len' ) similar to strcat(3)
--- 41 unchanged lines hidden (view full) ---
107 sizeof string member: module.afterload
108 sizeof string member: module.loaderror
109 ptr module.next
110;structure
111
112\ Global variables
113
114string conf_files
115create module_options sizeof module.next allot
116create last_module_option sizeof module.next allot
1170 value verbose?
118
119\ Support string functions
120
121: strdup ( addr len -- addr' len )
122 >r r@ allocate if out_of_memory throw then
--- 8 unchanged lines hidden (view full) ---
131
132: s'
133 [char] ' parse
134 state @ if
135 postpone sliteral
136 then
137; immediate
138
139\ Private definitions
140
141vocabulary support-functions
142only forth also support-functions definitions
143
144\ Some control characters constants
145
1469 constant tab
14710 constant lf
148
149\ Read buffer size
150
15180 constant read_buffer_size
152
153\ Standard suffixes
154
155: load_module_suffix s" _load" ;
--- 344 unchanged lines hidden (view full) ---
500: verbose_flag?
501 s" verbose_loading" assignment_type?
502;
503
504: execute?
505 s" exec" assignment_type?
506;
507
508: module_load?
509 load_module_suffix suffix_type?
510;
511
512: module_loadname?
513 module_loadname_suffix suffix_type?
514;
515
--- 182 unchanged lines hidden (view full) ---
698
699: set_verbose
700 yes_value? to verbose?
701;
702
703: execute_command
704 value_buffer .addr @ value_buffer .len @
705 over c@ [char] " = if
706 2 chars - swap char+ swap
707 then
708 ['] evaluate catch if exec_error throw then
709;
710
711: process_assignment
712 name_buffer .len @ 0= if exit then
713 loader_conf_files? if set_conf_files exit then
714 verbose_flag? if set_verbose exit then
715 execute? if execute_command exit then
716 module_load? if set_module_flag exit then
717 module_loadname? if set_module_loadname exit then
718 module_type? if set_module_type exit then
719 module_args? if set_module_args exit then
720 module_beforeload? if set_module_beforeload exit then
721 module_afterload? if set_module_afterload exit then
722 module_loaderror? if set_module_loaderror exit then
723 set_environment_variable
724;
725
726: free_buffers
727 line_buffer .addr @ dup if free then
728 name_buffer .addr @ dup if free then
729 value_buffer .addr @ dup if free then
730 or or if free_error throw then
731;
732
733: reset_assignment_buffers
--- 39 unchanged lines hidden (view full) ---
773 ['] process_conf catch
774 fd @ fclose
775 throw
776;
777
778: initialize_support
779 0 read_buffer .addr !
780 0 conf_files .addr !
781 0 module_options !
782 0 last_module_option !
783 0 to verbose?
784;
785
786: print_line
787 line_buffer .addr @ line_buffer .len @ type cr
788;
--- 57 unchanged lines hidden (view full) ---
846: get_conf_files
847 conf_files .addr @ conf_files .len @ strdup
848;
849
850: recurse_on_conf_files?
851 current_conf_files @ conf_files .addr @ <>
852;
853
854: skip_leading_spaces { addr len ptr -- addr len ptr' }
855 begin
856 ptr len = if addr len ptr exit then
857 addr ptr + c@ bl =
858 while
859 ptr char+ to ptr
860 repeat
861 addr len ptr
862;
863
864: get_file_name { addr len ptr -- addr len ptr' addr' len' || 0 }
865 ptr len = if
866 addr free abort" Fatal error freeing memory"
867 0 exit
868 then
869 ptr >r
870 begin
871 addr ptr + c@ bl <>
872 while
873 ptr char+ to ptr
874 ptr len = if
875 addr len ptr addr r@ + ptr r> - exit
876 then
877 repeat
878 addr len ptr addr r@ + ptr r> -
879;
880
881: get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 )
882 skip_leading_spaces
883 get_file_name
884;
885
886: set_current_file_name
--- 173 unchanged lines hidden (view full) ---
1060 strdup conf_files .len ! conf_files .addr !
1061;
1062
1063: load_kernel ( -- ) ( throws: abort )
1064 s" load ${kernel} ${kernel_options}" ['] evaluate catch
1065 if s" echo Unable to load kernel: ${kernel_name}" evaluate abort then
1066;
1067
1068\ Go back to straight forth vocabulary
1069
1070only forth also definitions
1071
2\ All rights reserved.
3\
4\ Redistribution and use in source and binary forms, with or without
5\ modification, are permitted provided that the following conditions
6\ are met:
7\ 1. Redistributions of source code must retain the above copyright
8\ notice, this list of conditions and the following disclaimer.
--- 8 unchanged lines hidden (view full) ---
17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
23\ SUCH DAMAGE.
24\
25\ $FreeBSD: head/sys/boot/forth/support.4th 50477 1999-08-28 01:08:13Z peter $
26
27\ Loader.rc support functions:
28\
29\ initialize_support ( -- ) initialize global variables
30\ initialize ( addr len -- ) as above, plus load_conf_files
31\ load_conf ( addr len -- ) load conf file given
32\ include_conf_files ( -- ) load all conf files in load_conf_files
33\ print_syntax_error ( -- ) print line and marker of where a syntax
--- 16 unchanged lines hidden (view full) ---
50\ string module.beforeload command to be executed before load
51\ string module.afterload command to be executed after load
52\ string module.loaderror command to be executed if load fails
53\ cell module.next list chain
54\
55\ Exported global variables;
56\
57\ string conf_files configuration files to be loaded
58\ cell modules_options pointer to first module information
59\ value verbose? indicates if user wants a verbose loading
60\ value any_conf_read? indicates if a conf file was succesfully read
61\
62\ Other exported words:
63\
64\ strdup ( addr len -- addr' len) similar to strdup(3)
65\ strcat ( addr len addr' len' -- addr len+len' ) similar to strcat(3)
--- 41 unchanged lines hidden (view full) ---
107 sizeof string member: module.afterload
108 sizeof string member: module.loaderror
109 ptr module.next
110;structure
111
112\ Global variables
113
114string conf_files
115create module_options sizeof module.next allot
116create last_module_option sizeof module.next allot
1170 value verbose?
118
119\ Support string functions
120
121: strdup ( addr len -- addr' len )
122 >r r@ allocate if out_of_memory throw then
--- 8 unchanged lines hidden (view full) ---
131
132: s'
133 [char] ' parse
134 state @ if
135 postpone sliteral
136 then
137; immediate
138
139\ Private definitions
140
141vocabulary support-functions
142only forth also support-functions definitions
143
144\ Some control characters constants
145
1469 constant tab
14710 constant lf
148
149\ Read buffer size
150
15180 constant read_buffer_size
152
153\ Standard suffixes
154
155: load_module_suffix s" _load" ;
--- 344 unchanged lines hidden (view full) ---
500: verbose_flag?
501 s" verbose_loading" assignment_type?
502;
503
504: execute?
505 s" exec" assignment_type?
506;
507
508: module_load?
509 load_module_suffix suffix_type?
510;
511
512: module_loadname?
513 module_loadname_suffix suffix_type?
514;
515
--- 182 unchanged lines hidden (view full) ---
698
699: set_verbose
700 yes_value? to verbose?
701;
702
703: execute_command
704 value_buffer .addr @ value_buffer .len @
705 over c@ [char] " = if
706 2 chars - swap char+ swap
707 then
708 ['] evaluate catch if exec_error throw then
709;
710
711: process_assignment
712 name_buffer .len @ 0= if exit then
713 loader_conf_files? if set_conf_files exit then
714 verbose_flag? if set_verbose exit then
715 execute? if execute_command exit then
716 module_load? if set_module_flag exit then
717 module_loadname? if set_module_loadname exit then
718 module_type? if set_module_type exit then
719 module_args? if set_module_args exit then
720 module_beforeload? if set_module_beforeload exit then
721 module_afterload? if set_module_afterload exit then
722 module_loaderror? if set_module_loaderror exit then
723 set_environment_variable
724;
725
726: free_buffers
727 line_buffer .addr @ dup if free then
728 name_buffer .addr @ dup if free then
729 value_buffer .addr @ dup if free then
730 or or if free_error throw then
731;
732
733: reset_assignment_buffers
--- 39 unchanged lines hidden (view full) ---
773 ['] process_conf catch
774 fd @ fclose
775 throw
776;
777
778: initialize_support
779 0 read_buffer .addr !
780 0 conf_files .addr !
781 0 module_options !
782 0 last_module_option !
783 0 to verbose?
784;
785
786: print_line
787 line_buffer .addr @ line_buffer .len @ type cr
788;
--- 57 unchanged lines hidden (view full) ---
846: get_conf_files
847 conf_files .addr @ conf_files .len @ strdup
848;
849
850: recurse_on_conf_files?
851 current_conf_files @ conf_files .addr @ <>
852;
853
854: skip_leading_spaces { addr len ptr -- addr len ptr' }
855 begin
856 ptr len = if addr len ptr exit then
857 addr ptr + c@ bl =
858 while
859 ptr char+ to ptr
860 repeat
861 addr len ptr
862;
863
864: get_file_name { addr len ptr -- addr len ptr' addr' len' || 0 }
865 ptr len = if
866 addr free abort" Fatal error freeing memory"
867 0 exit
868 then
869 ptr >r
870 begin
871 addr ptr + c@ bl <>
872 while
873 ptr char+ to ptr
874 ptr len = if
875 addr len ptr addr r@ + ptr r> - exit
876 then
877 repeat
878 addr len ptr addr r@ + ptr r> -
879;
880
881: get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 )
882 skip_leading_spaces
883 get_file_name
884;
885
886: set_current_file_name
--- 173 unchanged lines hidden (view full) ---
1060 strdup conf_files .len ! conf_files .addr !
1061;
1062
1063: load_kernel ( -- ) ( throws: abort )
1064 s" load ${kernel} ${kernel_options}" ['] evaluate catch
1065 if s" echo Unable to load kernel: ${kernel_name}" evaluate abort then
1066;
1067
1068\ Go back to straight forth vocabulary
1069
1070only forth also definitions
1071