[gforth] / gforth / cross.fs  

gforth: gforth/cross.fs

Diff for /gforth/cross.fs between version 1.47 and 1.48

version 1.47, Thu Apr 10 21:32:08 1997 UTC version 1.48, Wed May 21 20:39:21 1997 UTC
Line 37 
Line 37 
 \             targets                         09jun93jaw  \             targets                         09jun93jaw
 \       added: 2user and value                11jun93jaw  \       added: 2user and value                11jun93jaw
   
   \       needed? works better now!!!             01mar97jaw
   \       mach file is only loaded into target
   \       cell corrected
   
   
 \ include other.fs       \ ansforth extentions for cross  \ include other.fs       \ ansforth extentions for cross
   
 : string, ( c-addr u -- )  : string, ( c-addr u -- )
Line 93 
Line 98 
   
 \ Parameter for target systems                         06oct92py  \ Parameter for target systems                         06oct92py
   
   >TARGET
 mach-file count included  mach-file count included
   
   [IFUNDEF] has-interpreter true CONSTANT has-interpreter [THEN]
   
 also Forth definitions  also Forth definitions
   
 [IFDEF] asm-include asm-include [THEN]  [IFDEF] asm-include asm-include [THEN]
Line 104 
Line 112 
   
 >CROSS  >CROSS
   
 \ Variables                                            06oct92py  
   
 Variable image  
 Variable tlast    NIL tlast !  \ Last name field  
 Variable tlastcfa \ Last code field  
 Variable tdoes    \ Resolve does> calls  
 Variable bit$  
 Variable tdp  
 : there  tdp @ ;  
   
 \ Create additional parameters                         19jan95py  \ Create additional parameters                         19jan95py
   
 T  T
   NIL                Constant TNIL
 cell               Constant tcell  cell               Constant tcell
 cell<<             Constant tcell<<  cell<<             Constant tcell<<
 cell>bit           Constant tcell>bit  cell>bit           Constant tcell>bit
Line 125 
Line 124 
 1 bits/byte lshift Constant maxbyte  1 bits/byte lshift Constant maxbyte
 H  H
   
   \ Variables                                            06oct92py
   
   Variable image
   Variable tlast    TNIL tlast !  \ Last name field
   Variable tlastcfa \ Last code field
   Variable tdoes    \ Resolve does> calls
   Variable bit$
   Variable tdp
   : there  tdp @ ;
   
   
 >TARGET  >TARGET
   
 \ Byte ordering and cell size                          06oct92py  \ Byte ordering and cell size                          06oct92py
Line 132 
Line 142 
 : cell+         tcell + ;  : cell+         tcell + ;
 : cells         tcell<< lshift ;  : cells         tcell<< lshift ;
 : chars         ;  : chars         ;
   : char+         1 + ;
 : floats        tfloat * ;  : floats        tfloat * ;
   
 >CROSS  >CROSS
 : cell/         tcell<< rshift ;  : cell/         tcell<< rshift ;
 >TARGET  >TARGET
 20 CONSTANT bl  20 CONSTANT bl
 -1 Constant NIL  TNIL Constant NIL
   
 >CROSS  >CROSS
   
Line 174 
Line 185 
   
 >MINIMAL  >MINIMAL
 : makekernel ( targetsize -- targetsize )  : makekernel ( targetsize -- targetsize )
   bit$  over 1- cell>bit rshift 1+ initmem    bit$  over 1- tcell>bit rshift 1+ initmem
   image over initmem tdp off ;    image over initmem tdp off ;
   
 >CROSS  >CROSS
Line 192 
Line 203 
 \ Target memory access                                 06oct92py  \ Target memory access                                 06oct92py
   
 : align+  ( taddr -- rest )  : align+  ( taddr -- rest )
     cell tuck 1- and - [ cell 1- ] Literal and ;      tcell tuck 1- and - [ tcell 1- ] Literal and ;
 : cfalign+  ( taddr -- rest )  : cfalign+  ( taddr -- rest )
     \ see kernel.fs:cfaligned      \ see kernel.fs:cfaligned
     /maxalign tuck 1- and - [ /maxalign 1- ] Literal and ;      /maxalign tuck 1- and - [ /maxalign 1- ] Literal and ;
Line 220 
Line 231 
   
 : here  ( -- there )    there ;  : here  ( -- there )    there ;
 : allot ( n -- )        tdp +! ;  : allot ( n -- )        tdp +! ;
 : ,     ( w -- )        T here H cell T allot  ! H ;  : ,     ( w -- )        T here H tcell T allot  ! H ;
 : c,    ( char -- )     T here    1 allot c! H ;  : c,    ( char -- )     T here    1 allot c! H ;
 : align ( -- )          T here H align+ 0 ?DO  bl T c, H LOOP ;  : align ( -- )          T here H align+ 0 ?DO  bl T c, H LOOP ;
 : cfalign ( -- )  : cfalign ( -- )
Line 271 
Line 282 
   here tuck swap ! ghostheader T>    here tuck swap ! ghostheader T>
   DOES> dup last-ghost ! >exec @ execute ;    DOES> dup last-ghost ! >exec @ execute ;
   
   variable cfalist 0 cfalist !
   
   : markcfa
     cfalist here over @ , swap ! , ;
   
 \ ghost words                                          14oct92py  \ ghost words                                          14oct92py
 \                                          changed:    10may93py/jaw  \                                          changed:    10may93py/jaw
   
Line 340 
Line 356 
   WHILE dup ?resolved    WHILE dup ?resolved
   REPEAT drop ResolveFlag @    REPEAT drop ResolveFlag @
   IF    IF
       abort" Unresolved words!"        -1 abort" Unresolved words!"
   ELSE    ELSE
       ." Nothing!"        ." Nothing!"
   THEN    THEN
Line 376 
Line 392 
   
 \ Target Document Creation (goes to crossdoc.fd)       05jul95py  \ Target Document Creation (goes to crossdoc.fd)       05jul95py
   
 s" crossdoc.fd" r/w create-file throw value doc-file-id  s" doc/crossdoc.fd" r/w create-file throw value doc-file-id
 \ contains the file-id of the documentation file  \ contains the file-id of the documentation file
   
 : T-\G ( -- )  : T-\G ( -- )
Line 443 
Line 459 
     ghost >magic @ <fwd> <> ;      ghost >magic @ <fwd> <> ;
   
 : needed? ( -- flag ) \ name  : needed? ( -- flag ) \ name
     ghost dup >magic @ <fwd> =  \G returns a false flag when
     IF  >link @ 0<>  ELSE  drop false  THEN ;  \G a word is not defined
   \G a forward reference exists
   \G so the definition is not skipped!
       bl word gfind
       IF dup >magic @ <fwd> =
           \ swap >link @ 0<> and
           nip
           0=
       ELSE  drop true  THEN ;
   
 : doer? ( -- flag ) \ name  : doer? ( -- flag ) \ name
     ghost >magic @ <do:> = ;      ghost >magic @ <do:> = ;
Line 552 
Line 576 
 Defer (end-code)  Defer (end-code)
 [THEN]  [THEN]
   
   [IFUNDEF] ca>native
   defer ca>native
   [THEN]
   
 >TARGET  >TARGET
 : Code  : Code
     (THeader there resolve      (THeader there resolve
     [ has-prims 0= [IF] ITC [ELSE] true [THEN] ] [IF]      [ has-prims 0= [IF] ITC [ELSE] true [THEN] ] [IF]
         there 2 T cells H + T a, 0 , H    there 2 T cells H + ca>native T a, 0 , H
     [THEN]      [THEN]
     depth (code) ;      depth (code) ;
   
 : Code:  : Code:
     ghost dup there resolve  <do:> swap >magic !      ghost dup there ca>native resolve  <do:> swap >magic !
     depth (code) ;      depth (code) ;
   
 : end-code  : end-code
Line 878 
Line 906 
 \ Structural Conditionals                              12dec92py  \ Structural Conditionals                              12dec92py
   
 Cond: DO        restrict? compile (do)   T here H ;Cond  Cond: DO        restrict? compile (do)   T here H ;Cond
 Cond: ?DO       restrict? compile (?do)  (leave T here H ;Cond  Cond: ?DO       restrict? compile (?do)  T (leave here H ;Cond
 Cond: FOR       restrict? compile (for)  T here H ;Cond  Cond: FOR       restrict? compile (for)  T here H ;Cond
   
 >CROSS  >CROSS
 : loop]   dup <resolve cell - compile DONE compile unloop ;  : loop]   dup <resolve tcell - compile DONE compile unloop ;
 >TARGET  >TARGET
   
 Cond: LOOP      restrict? sys? compile (loop)  loop] ;Cond  Cond: LOOP      restrict? sys? compile (loop)  loop] ;Cond
Line 962 
Line 990 
   
 also minimal  also minimal
   
   \G interprets the line if word is not defined
 : \- defined? IF postpone \ THEN ;  : \- defined? IF postpone \ THEN ;
   
   \G interprets the line if word is defined
 : \+ defined? 0= IF postpone \ THEN ;  : \+ defined? 0= IF postpone \ THEN ;
   
   Cond: \- \- ;Cond
   Cond: \+ \+ ;Cond
   
   : ?? bl word find IF execute ELSE drop 0 THEN ;
   
   : needed:
   \G defines ghost for words that we want to be compiled
     BEGIN >in @ bl word c@ WHILE >in ! ghost drop REPEAT drop ;
   
 : [IF]   postpone [IF] ;  : [IF]   postpone [IF] ;
 : [THEN] postpone [THEN] ;  : [THEN] postpone [THEN] ;
 : [ELSE] postpone [ELSE] ;  : [ELSE] postpone [ELSE] ;
Line 975 
Line 1015 
 Cond: [THEN]    [THEN] ;Cond  Cond: [THEN]    [THEN] ;Cond
 Cond: [ELSE]    [ELSE] ;Cond  Cond: [ELSE]    [ELSE] ;Cond
   
 \ save-cross                                           17mar93py  previous
   
 \ i'm not interested in bigforth features this time    10may93jaw  
 \ [IFDEF] file  
 \ also file  
 \ [THEN]  
 \ included throw after create-file                     11may93jaw  
   
 bigendian Constant bigendian  \ save-cross                                           17mar93py
   
   >CROSS
 Create magic  s" Gforth10" here over allot swap move  Create magic  s" Gforth10" here over allot swap move
   
 char 1 bigendian + cell + magic 7 + c!  char 1 bigendian + tcell + magic 7 + c!
   
 : save-cross ( "image-name" "binary-name" -- )  : save-cross ( "image-name" "binary-name" -- )
   bl parse ." Saving to " 2dup type cr    bl parse ." Saving to " 2dup type cr
   w/o bin create-file throw >r    w/o bin create-file throw >r
   NIL IF    TNIL IF
       s" #! "   r@ write-file throw        s" #! "   r@ write-file throw
       bl parse  r@ write-file throw        bl parse  r@ write-file throw
       s"  -i"   r@ write-file throw        s"  -i"   r@ write-file throw
Line 1007 
Line 1042 
       bl parse 2drop        bl parse 2drop
   THEN    THEN
   image @ there r@ write-file throw \ write image    image @ there r@ write-file throw \ write image
   NIL IF    TNIL IF
       bit$  @ there 1- cell>bit rshift 1+        bit$  @ there 1- tcell>bit rshift 1+
                 r@ write-file throw \ write tags                  r@ write-file throw \ write tags
   THEN    THEN
   r> close-file throw ;    r> close-file throw ;
   
 \ words that should be in minimal  \ words that should be in minimal
   >MINIMAL
   also minimal
   
   bigendian Constant bigendian
   : save-cross save-cross ;
 : here there ;  : here there ;
 also forth [IFDEF] Label : Label Label ; [THEN] previous  also forth
   [IFDEF] Label : Label Label ; [THEN]
   [IFDEF] start-macros : start-macros start-macros ; [THEN]
   previous
   
 : + + ;  : + + ;
 : or or ;  : or or ;
 : 1- 1- ;  : 1- 1- ;
Line 1035 
Line 1078 
 : 2/ 2/ ;  : 2/ 2/ ;
 : . . ;  : . . ;
   
 mach-file count included  \ mach-file count included
   
 : all-words    ['] false    IS skip? ;  : all-words    ['] false    IS skip? ;
 : needed-words ['] needed?  IS skip? ;  : needed-words ['] needed?  IS skip? ;

Generate output suitable for use with a patch program
Legend:
Removed from v.1.47  
changed lines
  Added in v.1.48
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help