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 53672 1999-11-24 17:56:40Z dcs $ |
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\ string password password |
59\ cell modules_options pointer to first module information 60\ value verbose? indicates if user wants a verbose loading 61\ value any_conf_read? indicates if a conf file was succesfully read 62\ 63\ Other exported words: 64\ 65\ strdup ( addr len -- addr' len) similar to strdup(3) 66\ strcat ( addr len addr' len' -- addr len+len' ) similar to strcat(3) --- 41 unchanged lines hidden (view full) --- 108 sizeof string member: module.afterload 109 sizeof string member: module.loaderror 110 ptr module.next 111;structure 112 113\ Global variables 114 115string conf_files |
116string password |
117create module_options sizeof module.next allot 118create last_module_option sizeof module.next allot 1190 value verbose? 120 121\ Support string functions 122 123: strdup ( addr len -- addr' len ) 124 >r r@ allocate if out_of_memory throw then --- 8 unchanged lines hidden (view full) --- 133 134: s' 135 [char] ' parse 136 state @ if 137 postpone sliteral 138 then 139; immediate 140 |
141\ How come ficl doesn't have again? 142 143: again false postpone literal postpone until ; immediate 144 |
145\ Private definitions 146 147vocabulary support-functions 148only forth also support-functions definitions 149 150\ Some control characters constants 151 |
1527 constant bell 1538 constant backspace |
1549 constant tab 15510 constant lf |
15613 constant <cr> |
157 158\ Read buffer size 159 16080 constant read_buffer_size 161 162\ Standard suffixes 163 164: load_module_suffix s" _load" ; --- 344 unchanged lines hidden (view full) --- 509: verbose_flag? 510 s" verbose_loading" assignment_type? 511; 512 513: execute? 514 s" exec" assignment_type? 515; 516 |
517: password? 518 s" password" assignment_type? 519; 520 |
521: module_load? 522 load_module_suffix suffix_type? 523; 524 525: module_loadname? 526 module_loadname_suffix suffix_type? 527; 528 --- 182 unchanged lines hidden (view full) --- 711 712: set_verbose 713 yes_value? to verbose? 714; 715 716: execute_command 717 value_buffer .addr @ value_buffer .len @ 718 over c@ [char] " = if |
719 2 - swap char+ swap |
720 then 721 ['] evaluate catch if exec_error throw then 722; 723 |
724: set_password 725 password .addr @ ?dup if free if free_error throw then then 726 value_buffer .addr @ c@ [char] " = if 727 value_buffer .addr @ char+ value_buffer .len @ 2 - strdup 728 value_buffer .addr @ free if free_error throw then 729 else 730 value_buffer .addr @ value_buffer .len @ 731 then 732 password .len ! password .addr ! 733 0 value_buffer .addr ! 734; 735 |
736: process_assignment 737 name_buffer .len @ 0= if exit then 738 loader_conf_files? if set_conf_files exit then 739 verbose_flag? if set_verbose exit then 740 execute? if execute_command exit then |
741 password? if set_password exit then |
742 module_load? if set_module_flag exit then 743 module_loadname? if set_module_loadname exit then 744 module_type? if set_module_type exit then 745 module_args? if set_module_args exit then 746 module_beforeload? if set_module_beforeload exit then 747 module_afterload? if set_module_afterload exit then 748 module_loaderror? if set_module_loaderror exit then 749 set_environment_variable 750; 751 |
752\ free_buffer ( -- ) 753\ 754\ Free some pointers if needed. The code then tests for errors 755\ in freeing, and throws an exception if needed. If a pointer is 756\ not allocated, it's value (0) is used as flag. 757 |
758: free_buffers 759 line_buffer .addr @ dup if free then 760 name_buffer .addr @ dup if free then 761 value_buffer .addr @ dup if free then 762 or or if free_error throw then 763; 764 765: reset_assignment_buffers --- 39 unchanged lines hidden (view full) --- 805 ['] process_conf catch 806 fd @ fclose 807 throw 808; 809 810: initialize_support 811 0 read_buffer .addr ! 812 0 conf_files .addr ! |
813 0 password .addr ! |
814 0 module_options ! 815 0 last_module_option ! 816 0 to verbose? 817; 818 819: print_line 820 line_buffer .addr @ line_buffer .len @ type cr 821; --- 57 unchanged lines hidden (view full) --- 879: get_conf_files 880 conf_files .addr @ conf_files .len @ strdup 881; 882 883: recurse_on_conf_files? 884 current_conf_files @ conf_files .addr @ <> 885; 886 |
887: skip_leading_spaces { addr len pos -- addr len pos' } |
888 begin |
889 pos len = if addr len pos exit then 890 addr pos + c@ bl = |
891 while |
892 pos char+ to pos |
893 repeat |
894 addr len pos |
895; 896 |
897: get_file_name { addr len pos -- addr len pos' addr' len' || 0 } 898 pos len = if |
899 addr free abort" Fatal error freeing memory" 900 0 exit 901 then |
902 pos >r |
903 begin |
904 addr pos + c@ bl <> |
905 while |
906 pos char+ to pos 907 pos len = if 908 addr len pos addr r@ + pos r> - exit |
909 then 910 repeat |
911 addr len pos addr r@ + pos r> - |
912; 913 914: get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 ) 915 skip_leading_spaces 916 get_file_name 917; 918 919: set_current_file_name --- 173 unchanged lines hidden (view full) --- 1093 strdup conf_files .len ! conf_files .addr ! 1094; 1095 1096: load_kernel ( -- ) ( throws: abort ) 1097 s" load ${kernel} ${kernel_options}" ['] evaluate catch 1098 if s" echo Unable to load kernel: ${kernel_name}" evaluate abort then 1099; 1100 |
1101: read-password { size | buf len -- } 1102 size allocate if out_of_memory throw then 1103 to buf 1104 0 to len 1105 begin 1106 key 1107 dup backspace = if 1108 drop 1109 len if 1110 backspace emit bl emit backspace emit 1111 len 1 - to len 1112 else 1113 bell emit 1114 then 1115 else 1116 dup <cr> = if cr drop buf len exit then 1117 [char] * emit 1118 len size < if 1119 buf len chars + c! 1120 else 1121 drop 1122 then 1123 len 1+ to len 1124 then 1125 again 1126; 1127 |
1128\ Go back to straight forth vocabulary 1129 1130only forth also definitions 1131 |