Menu
▾
▴
[Win32forth-cvs] win32forth/src/lib/fmacro FMACRO.F,1.3,1.4
|
From: Jos v.d.V. <jo...@us...> - 2011-12-14 13:47:04
|
Update of /cvsroot/win32forth/win32forth/src/lib/fmacro
In directory vz-cvs-4.sog:/tmp/cvs-serv27995
Modified Files:
FMACRO.F
Log Message:
Jos: Made the user-area accessible and adapted fmacro.f for Win32Forth version 6.14/6.15
Index: FMACRO.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/fmacro/FMACRO.F,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** FMACRO.F 20 May 2009 15:05:15 -0000 1.3
--- FMACRO.F 14 Dec 2011 13:47:01 -0000 1.4
***************
*** 1,3 ****
! \ needs optimize.f \ load the optimizer here when you would like to see its effect.
anew fmacro.f \ December 26th, 2004 by J.v.d.Ven
--- 1,3 ----
! \ needs src\old\optimize.f \ load the optimizer here when you would like to see its effect.
anew fmacro.f \ December 26th, 2004 by J.v.d.Ven
***************
*** 16,22 ****
Conditions:
! A P400
! using Win32forth Version: 6.09.04 Build: 156
! under XP
Results of the tests when optimize.f IS loaded:
--- 16,20 ----
Conditions:
! A P400 using Win32forth Version: 6.09.04 Build: 156 under XP:
Results of the tests when optimize.f IS loaded:
***************
*** 32,35 ****
--- 30,45 ----
Test4 using the macro code bypassing the stack:.Elapsed time: 00:00:00.851
+ The "memory" effect is almost gone under Windows 7 with an iCore7.
+ Under Windows 7 using Win32forth Version: 6.15.00 Build: 40 when optimize.f IS loaded::
+ Test1 normal:...................................Elapsed time: 00:00:00.203
+ Test2 with the optimizer :......................Elapsed time: 00:00:00.188
+ Test3 using the macro code:.....................Elapsed time: 00:00:00.124
+ Test4 using the macro code bypassing the stack:.Elapsed time: 00:00:00.113
+
+ When optimize.f is NOT loaded I get:
+ Test3 using the macro code:.....................Elapsed time: 00:00:00.119
+ Test4 using the macro code bypassing the stack:.Elapsed time: 00:00:00.106
+
+
The floating point part uses the hardware stack of the CPU
The size of the hardware floating point stack is limited to 8 floats.
***************
*** 76,84 ****
As soon as you are used to Forth you might like it since it
is possible to translate Forth like statements into code which might be
! 5 times faster than high level Win32Forth depending on your code.
Variables and fvariables of Forth can be used.
They are faster in this pack than value or fvalue.
- fdump shows the hardware stack.
Only words that I needed are done.
--- 86,94 ----
As soon as you are used to Forth you might like it since it
is possible to translate Forth like statements into code which might be
! 2 till 5 times faster than high level Win32Forth depending on your code and
! your PC.
Variables and fvariables of Forth can be used.
They are faster in this pack than value or fvalue.
Only words that I needed are done.
***************
*** 155,178 ****
pop ebx push ebx
! December 9th, 2004 Added: r_nos_c!, r_nos_!, b_nos_c!, b_nos_!, a_nos_c! and a_nos_!
to avoid using the parameter stack.
December 27th, 2004 Removed a bug from begin while repeat
! May 20th, 2009 Removed a bug from - added: swap- and j
))
defined code-c, nip not [IF]
! synonym code-c, c,
synonym code-w, w,
! synonym code-, ,
synonym code-here here
synonym cdp dp
[then]
SYS-WARNING-OFF
! : qalign code-here -11 and 12 + code-here - allot ;
: 32align code-here -31 and 32 + code-here - allot ;
: fvariable ( -<name>- ) \ compile time
( -- a1 ) \ runtime
--- 165,195 ----
pop ebx push ebx
! December 9th, 2004 Added: r_nos_c!, r_nos_!, b_nos_c!, b_nos_!, a_nos_c! and a_nos_!
to avoid using the parameter stack.
December 27th, 2004 Removed a bug from begin while repeat
! May 20th, 2009 Removed a bug from - added: swap- and j
! December 14th, 2011 Made the user-area accessible and adapted it for Win32Forth version 6.14
! the user-area is handled by EDX so you should not use the local B
! when you are using the user-area.
))
+
defined code-c, nip not [IF]
! synonym code-c, c,
synonym code-w, w,
! synonym code-, ,
synonym code-here here
synonym cdp dp
[then]
+
SYS-WARNING-OFF
! : qalign code-here -11 and 12 + code-here - allot ;
: 32align code-here -31 and 32 + code-here - allot ;
+ DUP-WARNING-OFF
+
: fvariable ( -<name>- ) \ compile time
( -- a1 ) \ runtime
***************
*** 180,189 ****
create B/FLOAT allot ; \ Uses 4 bytes in runtime
0e fvariable fzero fzero f!
0 variable _zero _zero !
0 constant zero
! fsp b/float - constant fsp-
! up@ constant _up
also assembler definitions
--- 197,208 ----
create B/FLOAT allot ; \ Uses 4 bytes in runtime
+ DUP-WARNING-ON
+
0e fvariable fzero fzero f!
0 variable _zero _zero !
0 constant zero
! : user? ( adr - adr flag ) dup rp0 dup usersize + between ;
!
also assembler definitions
***************
*** 198,205 ****
0 value FLD_extended|double
0 value FSTP_extended|double
B/FLOAT 10 =
! [IF] $AFDB to FLD_extended|double $BFDB to FSTP_extended|double
! [ELSE] $87DD to FLD_extended|double $9FDD to FSTP_extended|double
[THEN]
--- 217,229 ----
0 value FLD_extended|double
0 value FSTP_extended|double
+ 0 value FLD_extended|double_[edx]
+ 0 value FSTP_extended|double_[edx]
B/FLOAT 10 =
! [IF] $AFDB to FLD_extended|double $BFDB to FSTP_extended|double
! $AADD to FLD_extended|double_[edx] $BADD to FSTP_extended|double_[edx]
! [ELSE] $87DD to FLD_extended|double $9FDD to FSTP_extended|double
! $82DD to FLD_extended|double_[edx] $9ADD to FSTP_extended|double_[edx]
!
[THEN]
***************
*** 505,508 ****
--- 529,551 ----
: ass-lit+ ( <lit> - ) [ also forth ] $81 code-c, $C3 code-c, code-, [ previous ] a;;
+
+ : user! \ Compiletime: ( name-user - ) ( n -- )
+ [ also forth ] $89 code-c, $9A code-c, TCB - code-, $5B code-c, [ previous ]
+ a;;
+
+ : user@ \ Compiletime: ( name-user - ) ( - n )
+ [ also forth ] $53 code-c, $8B code-c, $9A code-c, TCB - code-, [ previous ]
+ a;;
+
+
+ : fuser! \ Compiletime: ( name-fuser - ) Runtime: ( fhw: r -- )
+ [ also forth ] FSTP_extended|double_[edx] code-w, TCB - code-, [ previous ]
+ a;;
+
+ : fuser@ \ Compiletime: ( name-fuser - ) Runtime: ( fhw: -- r )
+ [ also forth ] FLD_extended|double_[edx] code-w, TCB - code-, [ previous ]
+ a;;
+
+
: f@ ( addr -- ) ( fhw: -- r )
fld FSIZE DATASTACK_MEMORY
***************
*** 555,562 ****
a;;
! : faddr! \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: r -- )
[ also forth ] FSTP_extended|double code-w, code-, [ previous ]
a;;
: fdup ( hw: r -- r r ) fld st(0) a;;
: fover ( hw: r1 r2 -- r1 r2 r1 ) fld st(1) a;;
--- 598,611 ----
a;;
! : (faddr! \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: r -- )
[ also forth ] FSTP_extended|double code-w, code-, [ previous ]
a;;
+ : faddr! \ Compiletime: ( name-fuser|addr - ) Runtime: ( fhw: -- addrf@ )
+ user?
+ IF fuser!
+ ELSE (faddr!
+ THEN a;;
+
: fdup ( hw: r -- r r ) fld st(0) a;;
: fover ( hw: r1 r2 -- r1 r2 r1 ) fld st(1) a;;
***************
*** 577,581 ****
mov eax, FSP_MEMORY
sub eax, # B/FLOAT
! fld FSIZE FSTACK [eax] [edx]
mov FSP_MEMORY , eax
a;;
--- 626,630 ----
mov eax, FSP_MEMORY
sub eax, # B/FLOAT
! fld FSIZE floatstack [eax] [up]
mov FSP_MEMORY , eax
a;;
***************
*** 600,608 ****
))
! : faddr@ \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- addrf@ )
[ also forth ] FLD_extended|double code-w, code-, [ previous ]
a;;
! : faddr@+ \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- ftos+addrf@ )
[ B/FLOAT 8 = ]
[IF] [ also forth ] $87DC code-w, code-, [ previous ]
--- 649,664 ----
))
!
! : (faddr@ \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- addrf@ )
[ also forth ] FLD_extended|double code-w, code-, [ previous ]
a;;
! : faddr@ \ Compiletime: ( name-fuser|addr - ) Runtime: ( fhw: -- addrf@ )
! user?
! IF fuser@
! ELSE (faddr@
! THEN a;;
!
! : (faddr@+ \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- ftos+addrf@ )
[ B/FLOAT 8 = ]
[IF] [ also forth ] $87DC code-w, code-, [ previous ]
***************
*** 610,615 ****
[THEN] a;;
! : faddr@- \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- ftos-addrf@ )
[ B/FLOAT 8 = ]
[IF] [ also forth ] $AFDC code-w, code-, [ previous ]
--- 666,684 ----
[THEN] a;;
+ : fuser@+ \ Compiletime: ( name-fuser - ) Runtime: ( fhw: -- ftos+addrf@ )
+ [ B/FLOAT 8 = ]
+ [IF] [ also forth ] $82DC code-w, tcb - code-, [ previous ]
+ [ELSE] faddr@ f+
+ [THEN] a;;
!
! : faddr@+ \ Compiletime: ( name-fuser|addr - ) Runtime: ( fhw: -- addrf@ )
! user?
! IF fuser@+
! ELSE (faddr@+
! THEN a;;
!
!
! : (faddr@- \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- ftos-addrf@ )
[ B/FLOAT 8 = ]
[IF] [ also forth ] $AFDC code-w, code-, [ previous ]
***************
*** 618,622 ****
! : faddr@/ \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- ftos/addrf@ )
[ B/FLOAT 8 = ]
[IF] [ also forth ] $BFDC code-w, code-, [ previous ]
--- 687,704 ----
! : fuser@- \ Compiletime: ( name-fuser - ) Runtime: ( fhw: -- ftos+addrf@ )
! [ B/FLOAT 8 = ]
! [IF] [ also forth ] $AADC code-w, tcb - code-, [ previous ]
! [ELSE] faddr@ f-
! [THEN] a;;
!
!
! : faddr@- \ Compiletime: ( name-fuser|addr - ) Runtime: ( fhw: -- addrf@ )
! user?
! IF fuser@-
! ELSE (faddr@-
! THEN a;;
!
! : (faddr@/ \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- ftos/addrf@ )
[ B/FLOAT 8 = ]
[IF] [ also forth ] $BFDC code-w, code-, [ previous ]
***************
*** 624,628 ****
[THEN] a;;
! : faddr@* \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- ftos-addrf@ )
[ B/FLOAT 8 = ]
[IF] [ also forth ] $8FDC code-w, code-, [ previous ]
--- 706,724 ----
[THEN] a;;
! : fuser@/ \ Compiletime: ( name-fuser - ) Runtime: ( fhw: -- ftos/addrf@ )
! [ B/FLOAT 8 = ]
! [IF] [ also forth ] $BADC code-w, tcb - code-, [ previous ]
! [ELSE] faddr@ f/
! [THEN] a;;
!
!
!
! : faddr@/ \ Compiletime: ( name-fuser|addr - ) Runtime: ( fhw: -- addrf@ )
! user?
! IF fuser@/
! ELSE (faddr@/
! THEN a;;
!
! : (faddr@* \ Compiletime: ( name-fvariable|addr - ) Runtime: ( fhw: -- ftos-addrf@ )
[ B/FLOAT 8 = ]
[IF] [ also forth ] $8FDC code-w, code-, [ previous ]
***************
*** 630,633 ****
--- 726,743 ----
[THEN] a;;
+
+ : fuser@* \ Compiletime: ( name-fuser - ) Runtime: ( fhw: -- ftos-addrf@ )
+ [ B/FLOAT 8 = ]
+ [IF] [ also forth ] $8ADC code-w, tcb - code-, [ previous ]
+ [ELSE] faddr@ f*
+ [THEN] a;;
+
+
+ : faddr@* \ Compiletime: ( name-fuser|addr - ) Runtime: ( fhw: -- addrf@ )
+ user?
+ IF fuser@*
+ ELSE (faddr@*
+ THEN a;;
+
: c0c3? ( -- flag ) ( hw: -- )
push ebx
***************
*** 732,735 ****
--- 842,847 ----
a;;
+ DUP-WARNING-OFF
+
: leave \ compiletime: ( - ) ( fs: - leave-flag|adr )
[ also forth ] $e9 code-c, fdrop code-here s>f -1 code-, [ previous ]
***************
*** 750,753 ****
--- 862,867 ----
a;;
+ DUP-WARNING-ON
+
: begin \ compiletime: ( - adr-at-begin )
[ also forth ] code-here
***************
*** 822,825 ****
--- 936,942 ----
a;;
+
+
+
\ Use: variable t1 code x1 t1 addr@< next, end-code
***************
*** 833,844 ****
in-application SYS-WARNING-ON \ End of added macro's
- only forth definitions also hidden
-
- : fdump ( - ) fdump ;
-
only forth also definitions
code df@>hw ( addr -- ) ( hw: -- r )
! fld double DATASTACK_MEMORY
drop
next,
--- 950,957 ----
in-application SYS-WARNING-ON \ End of added macro's
only forth also definitions
code df@>hw ( addr -- ) ( hw: -- r )
! fld double DATASTACK_MEMORY
drop
next,
***************
*** 861,865 ****
: faddr@* ( - faddr@ ) ( f: -- ftos+addrf@ ) f@ f* ;
: faddr@/ ( - faddr@ ) ( f: -- ftos+addrf@ ) f@ f/ ;
! : execute_exit ( xt - ) postpone execute postpone exit ; immediate
variable loc_a variable loc_b
--- 974,978 ----
: faddr@* ( - faddr@ ) ( f: -- ftos+addrf@ ) f@ f* ;
: faddr@/ ( - faddr@ ) ( f: -- ftos+addrf@ ) f@ f/ ;
! \IN-SYSTEM-OK : execute_exit ( xt - ) postpone execute postpone exit ; immediate
variable loc_a variable loc_b
***************
*** 889,911 ****
\ : r@a+a! ( r: - r: ) ( a - r+a) s" r@ a@ + a!" EVALUATE ; IMMEDIATE
! (( >>> Disable or delete this line to run the following BM test
\ needs profiler.f
! fvariable t1
fvariable t2
fvariable t3
! code BM \ This test section is disabled
next, end-code
! : x11 2 0 4e bm ;
! cr 10e t1 f!
! see BM x11 .s
abort
--- 1002,1034 ----
\ : r@a+a! ( r: - r: ) ( a - r+a) s" r@ a@ + a!" EVALUATE ; IMMEDIATE
!
!
! (( >>> Disable or delete this line to run the following BM test
\ needs profiler.f
! B/FLOAT newuser t1
! \ fvariable t1
fvariable t2
fvariable t3
! 99e t1 f!
! 20001e t2 f!
!
+ code BM
+ t1 faddr@
+ t1 faddr@+
+ t1 faddr!
next, end-code
+ see t1
+ see bm
! : x11 9e bm t1 f@ f. ;
! cr x11 .s
abort
|
