Update of /cvsroot/win32forth/win32forth/src/lib/fmacro
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12617/src/lib/fmacro
Modified Files:
FMACRO.F
Log Message:
- Jos: Removed a bug from begin while repeat
Index: FMACRO.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/fmacro/FMACRO.F,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FMACRO.F 21 Dec 2004 00:19:10 -0000 1.1
--- FMACRO.F 27 Dec 2004 22:12:58 -0000 1.2
***************
*** 1,5 ****
\ needs optimize.f \ load the optimizer here when you would like to see its effect.
! anew fmacro.f \ March 7th, 2004 by J.v.d.Ven
((
--- 1,5 ----
\ 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
((
***************
*** 156,160 ****
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.
))
--- 156,161 ----
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
))
***************
*** 207,216 ****
0 value poped_ebx
: push_ebx \ push ebx only when it is needed.
[ also forth ]
! code-here 1- poped_ebx =
if -1 cdp +! \ avoid a sequence like: pop ebx push ebx
! else $53 code-c, \ previous instruction was not pop ebx so push ebx
then
[ previous ]
--- 208,218 ----
0 value poped_ebx
+ 0 value opt_pop_adr
: push_ebx \ push ebx only when it is needed.
[ also forth ]
! code-here 1- poped_ebx = cdp @ opt_pop_adr > and
if -1 cdp +! \ avoid a sequence like: pop ebx push ebx
! else $53 code-c, \ previous instruction was not pop ebx so push ebx
then
[ previous ]
***************
*** 242,245 ****
--- 244,249 ----
: a@+ ( n -- n+a ) add ebx, ecx a;;
+ \ : r@a+a! ( r: r - r ) ( a: a - r+a) add ecx, 0 CELLS [ebp] a;;
+
: a@ ( -- n ) push_ebx
***************
*** 477,482 ****
push_ebx
$C7 code-c, $C3 code-c, code-,
-
[ previous ] a;;
: ass-lit+ ( <lit> - ) [ also forth ] $81 code-c, $C3 code-c, code-, [ previous ] a;;
--- 481,486 ----
push_ebx
$C7 code-c, $C3 code-c, code-,
[ previous ] a;;
+
: ass-lit+ ( <lit> - ) [ also forth ] $81 code-c, $C3 code-c, code-, [ previous ] a;;
***************
*** 687,690 ****
--- 691,695 ----
: then \ compiletime: ( adr-to-jmp-part - )
[ also forth ] code-here over - cell- swap !
+ code-here to opt_pop_adr
[ previous ]
a;;
***************
*** 718,730 ****
[ previous ]
add ebp, # 8 \ endloop
a;;
: begin \ compiletime: ( - adr-at-begin )
! [ also forth ] code-here [ previous ]
;
: while \ compiletime: ( adr-at-begin - put-adr-after-repeat adr-at-begin )
0= drop
! [ also forth ] $0F code-c, $85 code-c, code-here -1 code-, swap [ previous ]
a;;
--- 723,740 ----
[ previous ]
add ebp, # 8 \ endloop
+ code-here to opt_pop_adr
a;;
: begin \ compiletime: ( - adr-at-begin )
! [ also forth ] code-here
! dup to opt_pop_adr
! [ previous ]
;
: while \ compiletime: ( adr-at-begin - put-adr-after-repeat adr-at-begin )
0= drop
! [ also forth ] $0F code-c, $85 code-c, code-here -1 code-, swap
! code-here to opt_pop_adr
! [ previous ]
a;;
***************
*** 850,856 ****
: dup_b! ( n -- n ) dup b! ;
: b@+ ( n -- n+b ) b@ + ;
! : b>r ( Returnstack: -- b ) s" b@ >r" EVALUATE ; IMMEDIATE
! : r>b ( Returnstack: b -- ) s" r> b!" EVALUATE ; IMMEDIATE
: @to_b+ ( a - ) @ loc_b +! ;
(( >>> Disable or delete this line to run the following BM test
--- 860,867 ----
: dup_b! ( n -- n ) dup b! ;
: b@+ ( n -- n+b ) b@ + ;
! : b>r ( Returnstack: -- b ) s" b@ >r" EVALUATE ; IMMEDIATE
! : r>b ( Returnstack: b -- ) s" r> b!" EVALUATE ; IMMEDIATE
: @to_b+ ( a - ) @ loc_b +! ;
+ \ : 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
***************
*** 938,940 ****
\s
! |
