diff options
author | Daniel C. Sobral <dcs@FreeBSD.org> | 2000-09-08 16:57:28 +0000 |
---|---|---|
committer | Daniel C. Sobral <dcs@FreeBSD.org> | 2000-09-08 16:57:28 +0000 |
commit | 297c9cab3e4c7d39401175fa79b5c8ef1573b38f (patch) | |
tree | 073f5983c14d5a1899a2a7b912a75d06c63ee041 /sys/boot/forth | |
parent | 3053524c8562c951a7623abcb9c23a945c66cc37 (diff) | |
download | src-297c9cab3e4c7d39401175fa79b5c8ef1573b38f.tar.gz src-297c9cab3e4c7d39401175fa79b5c8ef1573b38f.zip |
Add constructors to crude structure support. Rework some of the
code into a more modular interface, with hidden vocabularies and
such. Remove the need to a lot of ugly initialization.
Also, add a few structure definitions, from stuff used on the C
part of loader. Some of this will disappear, and the crude structure
support will most likely be replaced by full-blown OOP support
already present on FICL, but not installed by default. But it was
getting increasingly inconvenient to keep this separate on my tree,
and I already lost lots of work once because of the hurdles, so
commit this.
Anyway, it makes support.4th more structured, and I'm not proceeding
with the work on it any time soon, unfortunately.
Notes
Notes:
svn path=/head/; revision=65615
Diffstat (limited to 'sys/boot/forth')
-rw-r--r-- | sys/boot/forth/support.4th | 161 |
1 files changed, 142 insertions, 19 deletions
diff --git a/sys/boot/forth/support.4th b/sys/boot/forth/support.4th index 5b72b1c728f5..0095ffc9eb5d 100644 --- a/sys/boot/forth/support.4th +++ b/sys/boot/forth/support.4th @@ -82,9 +82,15 @@ \ Crude structure support -: structure: create here 0 , 0 does> create @ allot ; +: structure: + create here 0 , ['] drop , 0 + does> create here swap dup @ allot cell+ @ execute +; : member: create dup , over , + does> cell+ @ + ; : ;structure swap ! ; +: constructor! >body cell+ ! ; +: constructor: over :noname ; +: ;constructor postpone ; swap cell+ ! ; immediate : sizeof ' >body @ state @ if postpone literal then ; immediate : offsetof ' >body cell+ @ state @ if postpone literal then ; immediate : ptr 1 cells member: ; @@ -95,8 +101,13 @@ structure: string ptr .addr int .len + constructor: + 0 over .addr ! + 0 swap .len ! + ;constructor ;structure + \ Module options linked list structure: module @@ -111,12 +122,85 @@ structure: module ptr module.next ;structure +\ Internal loader structures +structure: preloaded_file + ptr pf.name + ptr pf.type + ptr pf.args + ptr pf.metadata \ file_metadata + int pf.loader + int pf.addr + int pf.size + ptr pf.modules \ kernel_module + ptr pf.next \ preloaded_file +;structure + +structure: kernel_module + ptr km.name + \ ptr km.args + ptr km.fp \ preloaded_file + ptr km.next \ kernel_module +;structure + +structure: file_metadata + int md.size + 2 member: md.type \ this is not ANS Forth compatible (XXX) + ptr md.next \ file_metadata + 0 member: md.data \ variable size +;structure + +structure: config_resource + ptr cf.name + int cf.type +0 constant RES_INT +1 constant RES_STRING +2 constant RES_LONG + 2 cells member: u +;structure + +structure: config_device + ptr cd.name + int cd.unit + int cd.resource_count + ptr cd.resources \ config_resource +;structure + +structure: STAILQ_HEAD + ptr stqh_first \ type* + ptr stqh_last \ type** +;structure + +structure: STAILQ_ENTRY + ptr stqe_next \ type* +;structure + +structure: pnphandler + ptr pnph.name + ptr pnph.enumerate +;structure + +structure: pnpident + ptr pnpid.ident \ char* + sizeof STAILQ_ENTRY cells member: pnpid.link \ pnpident +;structure + +structure: pnpinfo + ptr pnpi.desc + int pnpi.revision + ptr pnpi.module \ (char*) module args + int pnpi.argc + ptr pnpi.argv + ptr pnpi.handler \ pnphandler + sizeof STAILQ_HEAD member: pnpi.ident \ pnpident + sizeof STAILQ_ENTRY member: pnpi.link \ pnpinfo +;structure + \ Global variables string conf_files string password -create module_options sizeof module.next allot -create last_module_option sizeof module.next allot +create module_options sizeof module.next allot 0 module_options ! +create last_module_option sizeof module.next allot 0 last_module_option ! 0 value verbose? \ Support string functions @@ -191,17 +275,33 @@ only forth also support-functions definitions string name_buffer string value_buffer +\ Line by line file reading functions +\ +\ exported: +\ line_buffer +\ end_of_file? +\ fd +\ read_line +\ reset_line_reading + +vocabulary line-reading +also line-reading definitions also + \ File data temporary storage -string line_buffer string read_buffer 0 value read_buffer_ptr \ File's line reading function +support-functions definitions + +string line_buffer 0 value end_of_file? variable fd +line-reading definitions + : skip_newlines begin read_buffer .len @ read_buffer_ptr > @@ -276,10 +376,19 @@ variable fd ; : reset_line_buffer + line_buffer .addr @ ?dup if + free-memory + then 0 line_buffer .addr ! 0 line_buffer .len ! ; +support-functions definitions + +: reset_line_reading + 0 to read_buffer_ptr +; + : read_line reset_line_buffer skip_newlines @@ -291,6 +400,8 @@ variable fd repeat ; +only forth also support-functions definitions + \ Conf file line parser: \ <line> ::= <spaces><name><spaces>'='<spaces><value><spaces>[<comment>] | \ <spaces>[<comment>] @@ -298,11 +409,26 @@ variable fd \ <value> ::= '"'{<character_set>|'\'<anything>}'"' | <name> \ <character_set> ::= ASCII 32 to 126, except '\' and '"' \ <comment> ::= '#'{<anything>} +\ +\ exported: +\ line_pointer +\ process_conf -0 value parsing_function +0 value line_pointer + +vocabulary file-processing +also file-processing definitions +\ parser functions +\ +\ exported: +\ get_assignment + +vocabulary parser +also parser definitions also + +0 value parsing_function 0 value end_of_line -0 value line_pointer : end_of_line? line_pointer end_of_line = @@ -482,6 +608,8 @@ variable fd end_of_line? 0= if syntax_error throw then ; +file-processing definitions + : get_assignment line_buffer .addr @ line_buffer .len @ + to end_of_line line_buffer .addr @ to line_pointer @@ -497,6 +625,8 @@ variable fd or or 0= if syntax_error throw then ; +only forth also support-functions also file-processing definitions also + \ Process line : assignment_type? ( addr len -- flag ) @@ -764,10 +894,9 @@ variable fd \ not allocated, it's value (0) is used as flag. : free_buffers - line_buffer .addr @ dup if free then name_buffer .addr @ dup if free then value_buffer .addr @ dup if free then - or or if free_error throw then + or if free_error throw then ; : reset_assignment_buffers @@ -779,6 +908,8 @@ variable fd \ Higher level file processing +support-functions definitions + : process_conf begin end_of_file? 0= @@ -792,6 +923,8 @@ variable fd repeat ; +only forth also support-functions definitions + : create_null_terminated_string { addr len -- addr' len } len char+ allocate if out_of_memory throw then >r @@ -804,7 +937,7 @@ variable fd : load_conf ( addr len -- ) 0 to end_of_file? - 0 to read_buffer_ptr + reset_line_reading create_null_terminated_string over >r fopen fd ! @@ -815,15 +948,6 @@ variable fd throw ; -: initialize_support - 0 read_buffer .addr ! - 0 conf_files .addr ! - 0 password .addr ! - 0 module_options ! - 0 last_module_option ! - 0 to verbose? -; - : print_line line_buffer .addr @ line_buffer .len @ type cr ; @@ -1097,7 +1221,6 @@ variable current_conf_files \ Additional functions used in "start" : initialize ( addr len -- ) - initialize_support strdup conf_files .len ! conf_files .addr ! ; |