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.

1 files changed, 142 insertions, 19 deletions

diff --git a/sys/boot/forth/support.4th b/sys/boot/forth/support.4th
index 5b72b1c..0095ffc 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 !
 ;