\ reserves one byte for the length and stores the type
\ addr is the position of the length byte
: start-descriptor ( type -- addr )
here 0 c, swap c,
;
\ stores the length
: end-descriptor ( addr -- )
dup here swap -
swap c!
;
\ some example types
1 constant type-1
2 constant type-2
\ start of the descriptor table
create descriptors
\ this is a type-1 descriptor
type-1 start-descriptor
111 , 64335 , 23432 , 8734 ,
end-descriptor
\ another one
type-1 start-descriptor
222 , 32423 , 2342 ,
end-descriptor
\ and a type-2 descriptor
type-2 start-descriptor
333 , 9723 , 3432 , 32432 , 23456 ,
end-descriptor
\ finally a type-1 descriptor
type-1 start-descriptor
444 , 2345 ,
end-descriptor
\ length 0 means end of descriptor table
0 c,
\ returns the start of the descriptor of the speficied type
\ skip descriptors of the specified type "index" times
\ returns 0, if not found
: search-descriptor ( type index -- addr 1 | 0 )
locals| index type |
descriptors
begin true while
dup c@ 0= if drop 0 exit then
dup char+ c@ type = if
index 0= if
1 exit
else
index 1- to index
then
then
dup c@ +
repeat
;
\ usage sample
: print-descriptor ( addr -- )
cr
." length: " dup c@ . cr
." type: " char+ dup c@ . cr
." first cell: " char+ @ . cr
;
type-1 0 search-descriptor drop print-descriptor
type-1 1 search-descriptor drop print-descriptor
type-1 2 search-descriptor drop print-descriptor
type-2 0 search-descriptor drop print-descriptor
type-2 1 search-descriptor .
\ output:
type-1 0 search-descriptor drop print-descriptor
length: 18
type: 1
first cell: 111
ok
type-1 1 search-descriptor drop print-descriptor
length: 14
type: 1
first cell: 222
ok
type-1 2 search-descriptor drop print-descriptor
length: 10
type: 1
first cell: 444
ok
type-2 0 search-descriptor drop print-descriptor
length: 22
type: 2
first cell: 333
ok
type-2 1 search-descriptor . 0 ok