From 1b027d58f015ab3f8718b4c3d92d3725b05f7cee Mon Sep 17 00:00:00 2001
From: ketmar <ketmar@ketmar.no-ip.org>
Date: Tue, 11 Aug 2020 15:57:31 +0000
Subject: [PATCH] urforth: added simple stack operations optimiser

FossilOrigin-Name: cc90e5fbcdf61abe80fefc19ed357b7c123f5cd192342f1787af1a05b6676358
---
 libs/ufe/optimiser_zx.f | 90 +++++++++++++++++++++++++++++++++++++++++++++++--
 libs/ufe/stdlib.f       |  5 +++
 libs/ufe/zxtrace_lib.f  |  4 +--
 3 files changed, 95 insertions(+), 4 deletions(-)

diff --git a/libs/ufe/optimiser_zx.f b/libs/ufe/optimiser_zx.f
index a85bb37..e677938 100644
--- a/libs/ufe/optimiser_zx.f
+++ b/libs/ufe/optimiser_zx.f
@@ -1,6 +1,7 @@
 \ ." loading dsForth word optimiser...\n"
 
 \ $DEFINE DEBUG-ZX-OPTIMISER
+\ $DEFINE DEBUG-ZX-OPTIMISER-STACK-COMBINER
 
 $DEFINE ENABLE-ZX-OPTIMISER
 
@@ -102,10 +103,23 @@ $DEFINE ENABLE-ZX-OPTIMISER
 ;
 
 
+$IFDEF ENABLE-ZX-OPTIMISER
 ;; ////////////////////////////////////////////////////////////////////////// //
+0 VALUE (ZX-OPT-LIT-CFA)
+0 VALUE (ZX-OPT-SWAP-CFA)
+0 VALUE (ZX-OPT-DUP-CFA)
+0 VALUE (ZX-OPT-OVER-CFA)
+0 VALUE (ZX-OPT-DROP-CFA)
+0 VALUE (ZX-OPT-2DROP-CFA)
+0 VALUE (ZX-OPT-NIP-CFA)
+0 VALUE (ZX-OPT-TUCK-CFA)
+
+
 ;; optimise literals to superinstructions
 : (ZX-OPT-LITERAL)  ( stpfa pfa -- diditflag )
   DUP @  ;; ( stpfa pfa cfa )
+  ;; early exit
+  DUP (ZX-OPT-LIT-CFA) = IFNOT 2DROP DROP 0 EXIT ENDIF
   UR-ZX-WORD-NAME-BY-CFA IFNOT " WTF??!" UFE-FATAL ENDIF
   ;; ( stpfa pfa naddr ncount )
   2DUP " LIT" STR= IF
@@ -142,17 +156,89 @@ $DEFINE ENABLE-ZX-OPTIMISER
 ;
 
 
+;; optimise some stack operations to superunstructions
+: (ZX-OPT-STACK)  ( stpfa pfa -- diditflag )
+  DUP @  ;; ( stpfa pfa cfa )
+  CASE
+    (ZX-OPT-SWAP-CFA) OF
+      ;; ( stpfa pfa )
+      DUP 2+ @
+      CASE
+        (ZX-OPT-DROP-CFA) OF  ;; SWAP DROP -> NIP
+          $IFDEF DEBUG-ZX-OPTIMISER-STACK-COMBINER
+            ." \nCOMBINE: SWAP DROP -> NIP\n"
+          $ENDIF
+          (ZX-OPT-NIP-CFA) (ZX-OPT-COMBINE)
+          1 EXIT
+        ENDOF
+        (ZX-OPT-OVER-CFA) OF  ;; SWAP OVER -> TUCK
+          $IFDEF DEBUG-ZX-OPTIMISER-STACK-COMBINER
+            ." \nCOMBINE: SWAP OVER -> TUCK\n"
+          $ENDIF
+          (ZX-OPT-TUCK-CFA) (ZX-OPT-COMBINE)
+          1 EXIT
+        ENDOF
+      ENDCASE
+    ENDOF
+    (ZX-OPT-DROP-CFA) OF
+      DUP 2+ @ (ZX-OPT-DROP-CFA) = IF  ;; DROP DROP -> 2DROP
+        $IFDEF DEBUG-ZX-OPTIMISER-STACK-COMBINER
+          ." \nCOMBINE: DROP DROP -> 2DROP\n"
+        $ENDIF
+        (ZX-OPT-2DROP-CFA) (ZX-OPT-COMBINE)
+        1 EXIT
+      ENDIF
+    ENDOF
+  ENDCASE
+  2DROP 0
+;
+
+
+;; ////////////////////////////////////////////////////////////////////////// //
+: (ZX-CALL-OPTIMISERS)  ( stpfa pfa -- diditflag )
+  2DUP (ZX-OPT-LITERAL) IF 2DROP 1 EXIT ENDIF
+  (ZX-OPT-STACK)
+;
+
+
+;; ////////////////////////////////////////////////////////////////////////// //
 ;; checks if we can combine
 ;; we cannot do that if any label points to the next instruction
+;; also, we cannot optimise the last instruction (just in case)
 : (ZX-OPT-CAN-COMBINE) ( pfa -- flag )
   ZX-TRACE-SKIP-INSTR
+  DUP TOZX ZX-TRACER-WORD-END U< IFNOT DROP 0 ENDIF
   ZX-HAS-LABEL-AT NOT
 ;
 
 
 ;; ////////////////////////////////////////////////////////////////////////// //
-$IFDEF ENABLE-ZX-OPTIMISER
+: (ZX-CACHE-WORD-CFA)  ( addr count -- )  \ toname
+  2DUP UR-ZX-FIND-WORD IFNOT ." NOT FOUND: <" TYPE ." >!\n" " WTF?!" UFE-FATAL ENDIF
+  FROMZX >R  ;; save cfa; we need it as non-zx address for comparisons and such
+  ;; build string
+  " (ZX-OPT-" STR-TO-PAD
+  2SWAP STR-CAT
+  " -CFA)" STR-CAT
+  R> NROT STRTO
+;
+
+
+;; cache some addresses
+: (ZX-INIT-OPTIMISER)  ( -- )
+  " LIT"   (ZX-CACHE-WORD-CFA)
+  " SWAP"  (ZX-CACHE-WORD-CFA)
+  " DUP"   (ZX-CACHE-WORD-CFA)
+  " OVER"  (ZX-CACHE-WORD-CFA)
+  " DROP"  (ZX-CACHE-WORD-CFA)
+  " 2DROP" (ZX-CACHE-WORD-CFA)
+  " NIP"   (ZX-CACHE-WORD-CFA)
+  " TUCK"  (ZX-CACHE-WORD-CFA)
+;
+
+
 : OPTIMISE-ZX-WORD  ( addr count pfa -- )
+  (ZX-INIT-OPTIMISER)
 
   $IFDEF DEBUG-ZX-OPTIMISER
     DUP >R
@@ -179,7 +265,7 @@ $IFDEF ENABLE-ZX-OPTIMISER
   WHILE
     ;; ( stpfa pfa )
     DUP (ZX-OPT-CAN-COMBINE) IF
-      2DUP (ZX-OPT-LITERAL)  ;; ( stpfa pfa diditflag )
+      2DUP (ZX-CALL-OPTIMISERS)  ;; ( stpfa pfa diditflag )
       ;; if we did some optimisation, process optimised instruction again
     ELSE
       0 ;; do not process this instruction again
diff --git a/libs/ufe/stdlib.f b/libs/ufe/stdlib.f
index fd5c422..96b2a8f 100644
--- a/libs/ufe/stdlib.f
+++ b/libs/ufe/stdlib.f
@@ -69,6 +69,11 @@
   ENDIF
 ;
 
+;; copy string to PAD (count is not set)
+: STR-TO-PAD  ( addr count -- pad+1 count )
+  PAD 1+ 0 2SWAP STR-CAT
+;
+
 
 ;; ////////////////////////////////////////////////////////////////////////// //
 0 VARIABLE (#BUF-CURR-OFS)
diff --git a/libs/ufe/zxtrace_lib.f b/libs/ufe/zxtrace_lib.f
index 8b7fdd8..56fe54a 100644
--- a/libs/ufe/zxtrace_lib.f
+++ b/libs/ufe/zxtrace_lib.f
@@ -1,7 +1,7 @@
 ;; ////////////////////////////////////////////////////////////////////////// //
 0 VALUE ZX-TRACER-SAVED-DP
-0 VALUE ZX-TRACER-WORD-START
-0 VALUE ZX-TRACER-WORD-END
+0 VALUE ZX-TRACER-WORD-START  ;; always ZX address
+0 VALUE ZX-TRACER-WORD-END    ;; always ZX address
 
 ;; flags
 ;;   bit 0: branch
-- 
2.11.4.GIT