Diff for /gforth/cross.fs between versions 1.95 and 1.100

version 1.95, 2001/03/17 21:36:41 version 1.100, 2001/07/10 20:47:09
Line 808  ghost (next) Line 808  ghost (next)
 ghost unloop    ghost ;S                        2drop  ghost unloop    ghost ;S                        2drop
 ghost lit       ghost (compile) ghost !         2drop drop  ghost lit       ghost (compile) ghost !         2drop drop
 ghost (does>)   ghost noop                      2drop  ghost (does>)   ghost noop                      2drop
 ghost (.")      ghost (S")      ghost (ABORT")  2drop drop ( " )  ghost (.")      ghost (S")      ghost (ABORT")  2drop drop
 ghost '                                         drop  ghost '                                         drop
 ghost :docol    ghost :doesjump ghost :dodoes   2drop drop  ghost :docol    ghost :doesjump ghost :dodoes   2drop drop
 ghost :dovar    ghost :dodefer  ghost :dofield  2drop drop  ghost :dovar    ghost :dodefer  ghost :dofield  2drop drop
Line 944  Variable user-vars 0 user-vars ! Line 944  Variable user-vars 0 user-vars !
 : target>bitmask-size ( u1 -- u2 )  : target>bitmask-size ( u1 -- u2 )
   1- tcell>bit rshift 1+ ;    1- tcell>bit rshift 1+ ;
   
 : allocatetarget ( size --- adr )  : allocatetarget ( size -- adr )
   dup allocate ABORT" CROSS: No memory for target"    dup allocate ABORT" CROSS: No memory for target"
   swap over swap erase ;    swap over swap erase ;
   
Line 1050  T has? rom H Line 1050  T has? rom H
 ' dictionary ALIAS rom-dictionary  ' dictionary ALIAS rom-dictionary
   
   
 : setup-target ( -- )   \G initialize targets memory space  : setup-target ( -- )   \G initialize target's memory space
   s" rom" T $has? H    s" rom" T $has? H
   IF  \ check for ram and rom...    IF  \ check for ram and rom...
       \ address-space area nip 0<>        \ address-space area nip 0<>
Line 1087  T has? rom H Line 1087  T has? rom H
         ELSE    r> drop THEN          ELSE    r> drop THEN
    REPEAT drop ;     REPEAT drop ;
   
 \ MakeKernal                                                    22feb99jaw  \ MakeKernel                                                    22feb99jaw
   
 : makekernel ( targetsize -- targetsize )  : makekernel ( targetsize -- targetsize )
   dup dictionary >rlen ! setup-target ;    dup dictionary >rlen ! setup-target ;
Line 1579  Variable to-doc  to-doc on Line 1579  Variable to-doc  to-doc on
     IF      IF
         s" " doc-file-id write-line throw          s" " doc-file-id write-line throw
         s" make-doc " doc-file-id write-file throw          s" make-doc " doc-file-id write-file throw
           Last-Header-Ghost @ >ghostname doc-file-id write-file throw
         tlast @ >image count 1F and doc-file-id write-file throw  
         >in @          >in @
         [char] ( parse 2drop          [char] ( parse 2drop
         [char] ) parse doc-file-id write-file throw          [char] ) parse doc-file-id write-file throw
Line 1777  Comment (       Comment \ Line 1776  Comment (       Comment \
   ELSE  postpone literal postpone gexecute  THEN ;    ELSE  postpone literal postpone gexecute  THEN ;
                                         immediate                                          immediate
   
   T has? peephole H [IF]
 : (cc) compile call T >body a, H ;              ' (cc) IS colon,  : (cc) compile call T >body a, H ;              ' (cc) IS colon,
   [ELSE]
       ' (prim) IS colon,
   [THEN]
   
 : [G']   : [G'] 
 \G ticks a ghost and returns its address  \G ticks a ghost and returns its address
Line 2043  Cond: DOES> restrict? Line 2046  Cond: DOES> restrict?
   executed-ghost @    executed-ghost @
   create-forward-warn    create-forward-warn
   IF ['] reswarn-forward IS resolve-warning THEN    IF ['] reswarn-forward IS resolve-warning THEN
   Theader >r dup gdoes,    Theader >r dup , dup gdoes,
 \ stores execution semantic in the built word  \ stores execution semantic in the built word
 \ if the word already has a semantic (concerns S", IS, .", DOES>)  \ if the word already has a semantic (concerns S", IS, .", DOES>)
 \ then keep it  \ then keep it
Line 2101  Cond: DOES> restrict? Line 2104  Cond: DOES> restrict?
   postpone ;    ( S addr xt )    postpone ;    ( S addr xt )
   over >exec ! ; immediate    over >exec ! ; immediate
   
   T has? peephole H [IF]
 : compile: ( ghost -- ghost [xt] [colon-sys] )  : compile: ( ghost -- ghost [xt] [colon-sys] )
     :noname  postpone g>body ;      :noname  postpone g>body ;
 : ;compile ( ghost [xt] [colon-sys] -- ghost )  : ;compile ( ghost [xt] [colon-sys] -- ghost )
     postpone ;  over >comp ! ; immediate      postpone ;  over >comp ! ; immediate
   [ELSE]
   : compile:  ( ghost -- ghost xt colon-sys )  :noname ;
   : ;compile ( ghost xt colon-sys -- ghost )
       postpone ; drop ['] prim-resolved over >comp ! ; immediate
   [THEN]
   
 : by      ( -- ghost ) \ Name  : by      ( -- ghost ) \ Name
   ghost >end @ ;    ghost >end @ ;
Line 2141  Builder Variable Line 2150  Builder Variable
 [ELSE]  [ELSE]
 Build: T 0 , H ;  Build: T 0 , H ;
 by Create  by Create
   \ compile: alit, ;compile
 Builder Variable  Builder Variable
 [THEN]  [THEN]
   
Line 2151  Builder 2Variable Line 2161  Builder 2Variable
 [ELSE]  [ELSE]
 Build: T 0 , 0 , H ;  Build: T 0 , 0 , H ;
 by Create  by Create
   \ compile: alit, ;compile
 Builder 2Variable  Builder 2Variable
 [THEN]  [THEN]
   
Line 2161  Builder AVariable Line 2172  Builder AVariable
 [ELSE]  [ELSE]
 Build: T 0 A, H ;  Build: T 0 A, H ;
 by Create  by Create
   \ compile: alit, ;compile
 Builder AVariable  Builder AVariable
 [THEN]  [THEN]
   
Line 2392  Cond: NEXT restrict? sys? next, ;Cond Line 2404  Cond: NEXT restrict? sys? next, ;Cond
   
 : ,"            [char] " parse T string, align H ;  : ,"            [char] " parse T string, align H ;
   
 Cond: ."        restrict? compile (.")     T ," H ;Cond ( " )  Cond: ."        restrict? compile (.")     T ," H ;Cond
 Cond: S"        restrict? compile (S")     T ," H ;Cond ( " )  Cond: S"        restrict? compile (S")     T ," H ;Cond
 Cond: ABORT"    restrict? compile (ABORT") T ," H ;Cond ( " )  Cond: ABORT"    restrict? compile (ABORT") T ," H ;Cond
   
 Cond: IS        T ' >body H compile ALiteral compile ! ;Cond  Cond: IS        T ' >body H compile ALiteral compile ! ;Cond
 : IS            T >address ' >body ! H ;  : IS            T >address ' >body ! H ;
Line 2686  previous Line 2698  previous
 : .s            .s ;  : .s            .s ;
 : bye           bye ;  : bye           bye ;
   
   \ dummy
   
   : group  source >in ! drop ;
   
 \ turnkey direction  \ turnkey direction
 : H forth ; immediate  : H forth ; immediate
 : T minimal ; immediate  : T minimal ; immediate

Removed from v.1.95  
changed lines
  Added in v.1.100


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>