Verified Commit e102e9b4 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Change name>view to use locs[]

parent 488136e5

cross.fs

+2 −0
Original line number Diff line number Diff line
@@ -2499,6 +2499,7 @@ Variable prim# 
  2dup >exec2 !

  ['] prim-resolved over >comp !

  dup >ghost-flags <primitive> set-flag

  T here cell- H gxt-location drop

  s" EC" T $has? H 0=

  IF

      T here H resolve-noforwards $8000 xor T A, H
@@ -3166,6 +3167,7 @@ ghost ?fold-to drop 
    [G'] a>int  gset->int

    [G'] a>comp gset->comp

    [G'] s-to   gset-to

    T here cell- H gxt-location drop

    over resolve [G'] :dodefer (doer,) T A, H ;



: interpret/compile: ( xt1 xt2 "name" -- )

kernel/comp.fs

+4 −3
Original line number Diff line number Diff line
@@ -292,11 +292,12 @@ Defer xt-location 
    current-sourceview dup r> 1+ locs[] $[] cell- 2! ;

' xt-location1 is xt-location



: addr>view ( addr -- view / 0 )

: name>view ( addr -- viewaddr )

    dup cell- locs-start here within locs-start and ?dup-IF

	over cell- swap - cell/ locs[] $[] @

	?dup-IF  nip  EXIT  THEN

	- cell/ 1- locs[] $[]  EXIT

    THEN  drop 0 ;

: addr>view ( addr -- view / 0 )

    name>view ?dup-IF  @  THEN ;



has? primcentric [IF]

    has? peephole [IF]

kernel/int.fs

+2 −2
Original line number Diff line number Diff line
@@ -437,8 +437,8 @@ defer compile, ( xt -- ) 
\    dup >namevt @ >vt>int @ ['] noop = IF  drop 0 0  EXIT  THEN

    >f+c dup @ lcount-mask and tuck - swap ;



: name>view ( nt -- addr ) \ gforth   name-to-view

    name>string drop cell negate and cell- ;

\ : name>view ( nt -- addr ) \ gforth   name-to-view

\     name>string drop cell negate and cell- ;



: default-name>int ( nt -- xt ) \ gforth paren-name-to-int

    \G @i{xt} represents the interpretation semantics of the word