Update of /cvsroot/win32forth/win32forth-stc/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10561
Modified Files:
dis486.f primutil.f
Log Message:
arm: improve see based on type system
Index: primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** primutil.f 24 Jan 2007 11:48:55 -0000 1.20
--- primutil.f 1 Feb 2007 23:01:39 -0000 1.21
***************
*** 101,105 ****
: 2constant ( n m "name" )
! >system create , , dp>
does> 2@ ;
--- 101,105 ----
: 2constant ( n m "name" )
! create , ,
does> 2@ ;
***************
*** 237,266 ****
\ ------------------------------------------------------------------------
\ ------------------------------------------------------------------------
in-system
- : (viewinfo) ( nfa -- line# addr )
- \ *G Find source for word.
- dup >vfa@ swap >ffa@ \ fetch line #, file name
- over 1 < \ view < 1
- over -1 = or \ or file = -1
- if drop (file-console) \ must be console
- else dup 0= \ if it's a zero, it's kernel
- if drop (file-kernel) then
- then ;
-
- : .viewinfo ( nfa -- )
- \ *G Print file & line #
- (viewinfo)
- ." loaded from " count type 15 ?cr
- dup 0<> if
- ." at line " 10.
- else drop then ;
-
- \ ------------------------------------------------------------------------
- \ Conditional compiling
- \ ------------------------------------------------------------------------
-
: \- ( "word" -- )
\ *G Interpret the rest of the line if "word" isn't defined.
--- 237,245 ----
\ ------------------------------------------------------------------------
+ \ Conditional compiling
\ ------------------------------------------------------------------------
in-system
: \- ( "word" -- )
\ *G Interpret the rest of the line if "word" isn't defined.
Index: dis486.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** dis486.f 24 Jan 2007 23:48:17 -0000 1.11
--- dis486.f 1 Feb 2007 23:01:39 -0000 1.12
***************
*** 546,550 ****
: .shift ( n -- ) bits0-2 S" rolrorrclrcrshlshrxxxsar" 3 .ss ;
-
: shf ( addr op -- addr' )
>r count
--- 546,549 ----
***************
*** 1074,1077 ****
--- 1073,1078 ----
: describe ( xt -- )
dup>r >name cr
+
+ \ do the header piece
dup dup n>tfa c@
case
***************
*** 1084,1098 ****
tvoc of ." vocabulary " .id endof
toff of 0 r@ execute . ." offset " .id endof
! swap ." : " .id
endcase
dup (in/out@) swap
." ( " desc-stack
." -- " desc-stack
! dup ." ) " oper-col ." \ len=" n>ofa w@ .
dup ." type=" n>tfa c@ .
dup ." flag=" n>flg c@ h.2
! dup cr oper-col ." \ file=" >ffa@ .id
! dup >vfa@ 10.
! r>drop drop
;
--- 1085,1122 ----
tvoc of ." vocabulary " .id endof
toff of 0 r@ execute . ." offset " .id endof
! swap ." : " .id ." ( no type )"
endcase
+
+ \ stack effects
dup (in/out@) swap
." ( " desc-stack
." -- " desc-stack
! dup ." ) "
!
! \ compile information
! oper-col ." \ "
! r> \ get the xt
! dup >comp @ dup \ fetch the comp xt
! case
! ['] xt-call, of ." call compiled" endof
! ['] xt-inline, of ." compiled inline" endof
! dup show-name ." optimises"
! endcase drop
!
! >ct 2@ dup \ get the xts of the compile words
! case
! ['] compile, of endof
! ['] execute of ." , immediate" endof
! dup ." , " show-name ." is non-std compilation part"
! endcase drop
! drop
!
! \ misc head info
! cr oper-col ." \ len=" n>ofa w@ .
dup ." type=" n>tfa c@ .
dup ." flag=" n>flg c@ h.2
!
! \ tell user where the word was loaded
! cr oper-col ." \ " .viewinfo
;
|
