--- gforth/cross.fs 2003/05/11 17:17:13 1.139 +++ gforth/cross.fs 2004/08/26 15:50:44 1.146 @@ -447,7 +447,7 @@ sourcepath value fpath \G Make a complete new Forth search path; the path separator is |. fpath path= ; -: path>counted cell+ dup cell+ swap @ ; +: path>string cell+ dup cell+ swap @ ; : next-path ( adr len -- adr2 len2 ) 2dup 0 scan @@ -456,12 +456,12 @@ sourcepath value fpath r> - ; : previous-path ( path^ -- ) - dup path>counted + dup path>string BEGIN tuck dup WHILE repeat ; : .path ( path-addr -- ) \ gforth \G Display the contents of the search path @var{path-addr}. - path>counted + path>string BEGIN next-path dup WHILE type space REPEAT 2drop 2drop ; : .fpath ( -- ) \ gforth @@ -546,7 +546,7 @@ Create tfile 0 c, 255 chars allot IF rdrop ofile place open-ofile dup 0= IF >r ofile count r> THEN EXIT - ELSE r> path>counted + ELSE r> path>string BEGIN next-path dup WHILE 5 pick 5 pick check-path 0= IF >r 2drop 2drop r> ofile count 0 EXIT ELSE drop THEN @@ -1177,7 +1177,7 @@ false DefaultValue new-input false DefaultValue peephole false DefaultValue abranch true DefaultValue f83headerstring -true DefaultValue control-rack +true DefaultValue control-rack [THEN] true DefaultValue gforthcross @@ -1722,7 +1722,8 @@ Ghost (do) Ghost (?do) Ghost (for) drop Ghost (loop) Ghost (+loop) 2drop Ghost (next) drop -Ghost (does>) Ghost (compile) 2drop +Ghost (does>) Ghost (does>1) Ghost (does>2) 2drop drop +Ghost compile, drop Ghost (.") Ghost (S") Ghost (ABORT") 2drop drop Ghost (C") Ghost c(abort") Ghost type 2drop drop Ghost ' drop @@ -2026,7 +2027,7 @@ variable ResolveFlag \ Header states 12dec92py \ : flag! ( 8b -- ) tlast @ dup >r T c@ xor r> c! H ; -bigendian [IF] 0 [ELSE] tcell 1- [THEN] Constant flag+ +X has? f83headerstring bigendian or [IF] 0 [ELSE] tcell 1- [THEN] Constant flag+ : flag! ( w -- ) tlast @ flag+ + dup >r T c@ xor r> c! H ; VARIABLE ^imm @@ -2296,6 +2297,7 @@ Defer setup-prim-semantics Variable prim# : first-primitive ( n -- ) prim# ! ; : group 0 word drop prim# @ 1- -$200 and prim# ! ; +: groupadd ( n -- ) drop ; : Primitive ( -- ) \ name >in @ skip? IF drop EXIT THEN >in ! s" prims" T $has? H 0= @@ -2630,8 +2632,8 @@ T has? peephole H [IF] >TARGET Cond: DOES> - compile (does>) doeshandler, - resolve-does>-part + T here 5 cells H + alit, compile (does>2) compile ;s + doeshandler, resolve-does>-part ;Cond : DOES> @@ -3246,7 +3248,7 @@ Cond: postpone ( -- ) \ name ABORT" CROSS: Can't postpone on forward declaration" dup >magic @ = IF (gexecute) - ELSE compile (compile) addr, THEN ;Cond + ELSE >link @ alit, compile compile, THEN ;Cond \ save-cross 17mar93py