Commit 1d6c9641 authored by bp's avatar bp
Browse files

More work on vfxforth port 


git-svn-id: https://forth-ev.de/repos/bigforth@779 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 05e82e91

minos.fs

+2 −0
Original line number Diff line number Diff line
@@ -30,6 +30,7 @@ 
    include vfx-minos/string.fs

    include vfx-minos/xchar.fs

    include i18n.fs

    include vfx-minos/struct.fs

[ELSE]

\needs {        include locals.fs

\needs object   include oof.fb
@@ -84,6 +85,7 @@ Patch .class 


    [defined] VFXFORTH [IF]

	include vfx-minos/x11.fs

	include vfx-minos/xrender.fs

    [ELSE]

	\needs x11      include x11.fs

	\needs xrender  include xrender.fs

png.fs

+1 −1
Original line number Diff line number Diff line
@@ -73,7 +73,7 @@ byte interlace_type 
byte channels

byte pixel_depth

byte spare_byte

8 signature

8 string signature

} png_info_struct



Variable color_type

struct.fs

+3 −2
Original line number Diff line number Diff line
@@ -33,8 +33,8 @@ also (struct definitions 
previous definitions



| : struct-parse

    find dup IF    >r execute r> 0> ?exit

             ELSE  drop number drop  THEN

    find dup IF    >r execute r> 0> ?EXIT

             ELSE  drop number drop  EXIT  THEN

    >in @ name w@ $5C01 = IF drop + ELSE >in ! .struct' THEN

    [ lastcfa @ ] ALiteral IS parser ;

: struct{ ( -- )
@@ -46,3 +46,4 @@ previous definitions 
\ 4 constant cell

cell constant ptr

8 constant double

: string ;
 
 No newline at end of file

vfx-minos/helper.fs

+5 −1
Original line number Diff line number Diff line
@@ -68,3 +68,7 @@ Variable (i) 
[THEN]



: \needs postpone [defined] IF postpone \ THEN ;



: ,0"   ( -- )  '"' parse  here swap dup allot move 0 c, ;



: onlyforth  only forth ;

vfx-minos/struct.fs

0 → 100644
+47 −0
Original line number Diff line number Diff line 
\ bigForth structure creation                          18aug96py



: align-by ( w l -- w' ) dup 1- swap invert and invert negate

  cell min >r 1- r@ / 1+ r> * ;



: struct: ( w+ length -- w+ )

    dup >r align-by r>

    swap Create dup , +

    DOES> @ + ;



: ?lit, ( -- ) state @ IF postpone Literal THEN ;

  

: struct ( -- length ) ' >body @ ;

: sizeof ( -- length ) struct ?lit, ; immediate



Variable #struct

Vocabulary (struct



also (struct definitions



: { ( len -- len len len ) dup dup 1 #struct +! ;     immediate

: | ( len +len actlen -- len maxlen len ) max over ;  immediate

: } #struct @  IF  -1 #struct +! max nip EXIT  THEN

  get-current previous definitions previous

  Create immediate swap , ,

  DOES> cell+ @ >r get-order r> swap 1+ set-order '

    state @ IF  compile,  ELSE  execute  THEN

    previous ;     immediate



: byte 1 struct: ;

: short 2 struct: ;

: cell 1 cells struct: ;

: ptr cell ;

: double 2 cells struct: ;

: string chars struct: ;



previous definitions



: struct{ ( -- )

  get-order get-current swap 1+ set-order  wordlist set-current

  also (struct #struct off 0 ;



1 constant byte

2 constant short

\ 4 constant cell

cell constant ptr

8 constant double