[BACK]Return to cross.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/cross.fs between versions 1.84 and 1.90

version 1.84, 2000/05/04 09:31:16 version 1.90, 2001/01/28 22:43:39
Line 1 Line 1
 \ CROSS.FS     The Cross-Compiler                      06oct92py  \ CROSS.FS     The Cross-Compiler                      06oct92py
 \ Idea and implementation: Bernd Paysan (py)  \ Idea and implementation: Bernd Paysan (py)
   
 \ Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 17 Line 17
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   
 0   0 
 [IF]  [IF]
Line 474  Create tfile 0 c, 255 chars allot Line 474  Create tfile 0 c, 255 chars allot
     THEN ;      THEN ;
   
 : compact.. ( adr len -- adr2 len2 )  : compact.. ( adr len -- adr2 len2 )
 \ deletes phrases like "xy/.." out of our directory name 2dec97jaw      \ deletes phrases like "xy/.." out of our directory name 2dec97jaw
   over >r -1 >r      over swap
   BEGIN dup WHILE      BEGIN  dup  WHILE
         over c@ pathsep?           dup >r '/ scan 2dup 4 min s" /../" compare 0=
         IF      r@ -1 =          IF
                 IF      r> drop dup >r              dup r> - >r 4 /string over r> + 4 -
                 ELSE    2dup 1 /string               swap 2dup + >r move dup r> over -
                         3 min s" ../" compare          ELSE
                         0=              rdrop dup 1 min /string
                         IF      r@ over - ( diff )          THEN
                                 2 pick swap - ( dest-adr )      REPEAT  drop over - ;
                                 >r 3 /string r> swap 2dup >r >r  
                                 move r> r>  
                         ELSE    r> drop dup >r  
                         THEN  
                 THEN  
         THEN  
         1 /string  
   REPEAT   
   r> drop   
   drop r> tuck - ;  
   
 : reworkdir ( -- )  : reworkdir ( -- )
   remove~+    remove~+
Line 812  false DefaultValue dcomps Line 802  false DefaultValue dcomps
 false DefaultValue hash  false DefaultValue hash
 false DefaultValue xconds  false DefaultValue xconds
 false DefaultValue header  false DefaultValue header
   false DefaultValue new-input
 [THEN]  [THEN]
   
 true DefaultValue interpreter  true DefaultValue interpreter
Line 1525  variable ResolveFlag Line 1516  variable ResolveFlag
 >CROSS  >CROSS
 \ Header states                                        12dec92py  \ Header states                                        12dec92py
   
 : flag! ( 8b -- )   tlast @ dup >r T c@ xor r> c! H ;  bigendian [IF] 0 [ELSE] tcell 1- [THEN] Constant flag+
   : flag! ( w -- )   tlast @ flag+ + dup >r T c@ xor r> c! H ;
   
 VARIABLE ^imm  VARIABLE ^imm
   
   \ !! should be target wordsize specific
   $80 constant alias-mask
   $40 constant immediate-mask
   $20 constant restrict-mask
   
 >TARGET  >TARGET
 : immediate     40 flag!  : immediate     immediate-mask flag!
                 ^imm @ @ dup <imm> = IF  drop  EXIT  THEN                  ^imm @ @ dup <imm> = IF  drop  EXIT  THEN
                 <res> <> ABORT" CROSS: Cannot immediate a unresolved word"                  <res> <> ABORT" CROSS: Cannot immediate a unresolved word"
                 <imm> ^imm @ ! ;                  <imm> ^imm @ ! ;
 : restrict      20 flag! ;  : restrict      restrict-mask flag! ;
   
 : isdoer          : isdoer        
 \G define a forth word as doer, this makes obviously only sence on  \G define a forth word as doer, this makes obviously only sence on
Line 1546  VARIABLE ^imm Line 1543  VARIABLE ^imm
   
 >TARGET  >TARGET
 : string,  ( addr count -- )  : string,  ( addr count -- )
   dup T c, H bounds  ?DO  I c@ T c, H  LOOP ;       dup T c, H bounds  ?DO  I c@ T c, H  LOOP ;
 : name,  ( "name" -- )  bl word count T string, cfalign H ;  : lstring, ( addr count -- )
       dup T , H bounds  ?DO  I c@ T c, H  LOOP ;
   : name,  ( "name" -- )  bl word count T lstring, cfalign H ;
 : view,   ( -- ) ( dummy ) ;  : view,   ( -- ) ( dummy ) ;
 >CROSS  >CROSS
   
Line 1702  NoHeaderFlag off Line 1701  NoHeaderFlag off
     IF  dup >end tdoes !      IF  dup >end tdoes !
     ELSE 0 tdoes !      ELSE 0 tdoes !
     THEN      THEN
     80 flag!      alias-mask flag!
     cross-doc-entry cross-tag-entry ;      cross-doc-entry cross-tag-entry ;
   
 VARIABLE ;Resolve 1 cells allot  VARIABLE ;Resolve 1 cells allot
Line 1719  VARIABLE ;Resolve 1 cells allot Line 1718  VARIABLE ;Resolve 1 cells allot
     IF      IF
         .sourcepos ." needs prim: " >in @ bl word count type >in ! cr          .sourcepos ." needs prim: " >in @ bl word count type >in ! cr
     THEN      THEN
     (THeader over resolve T A, H 80 flag! ;      (THeader over resolve T A, H alias-mask flag! ;
 : Alias:   ( cfa -- ) \ name  : Alias:   ( cfa -- ) \ name
     >in @ skip? IF  2drop  EXIT  THEN  >in !      >in @ skip? IF  2drop  EXIT  THEN  >in !
     dup 0< s" prims" T $has? H 0= and      dup 0< s" prims" T $has? H 0= and
Line 2043  Cond: DOES> restrict? Line 2042  Cond: DOES> restrict?
   create-forward-warn    create-forward-warn
   IF ['] reswarn-forward IS resolve-warning THEN    IF ['] reswarn-forward IS resolve-warning THEN
   \ make Alias    \ make Alias
   (THeader there 0 T a, H 80 flag! ( S executed-ghost new-ghost )    (THeader there 0 T a, H alias-mask flag! ( S executed-ghost new-ghost )
   \ store  poiter to code-field    \ store  poiter to code-field
   switchram T cfalign H    switchram T cfalign H
   there swap T ! H    there swap T ! H
Line 2212  Builder Field Line 2211  Builder Field
 : cell% ( n -- size align )  : cell% ( n -- size align )
     T 1 cells H dup ;      T 1 cells H dup ;
   
   Build: ( m v -- m' v )  dup T , H cell+ ;
   DO:  abort" Not in cross mode" ;DO
   Builder input-method
   
   Build: ( m v size -- m v' )  over T , H + ;
   DO:  abort" Not in cross mode" ;DO
   Builder input-var
   
 \ structural conditionals                              17dec92py  \ structural conditionals                              17dec92py
   
 >CROSS  >CROSS
Removed from v.1.84  
changed lines
  Added in v.1.90

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