From ff60f5320b4e303e5aca4bf13d61c00de30e3a18 Mon Sep 17 00:00:00 2001
From: ketmar <ketmar@ketmar.no-ip.org>
Date: Thu, 2 Nov 2023 06:29:19 +0000
Subject: [PATCH] UrForth: accessors now call optimiser when compiling access
 code

FossilOrigin-Name: ad126be9276585fd873158941acbe047fdac06e7a8b9ff44f4ee43ad7a26d7cc
---
 urflibs/stdlib/70-pseudostructs.f | 29 +++++------------------------
 1 file changed, 5 insertions(+), 24 deletions(-)

diff --git a/urflibs/stdlib/70-pseudostructs.f b/urflibs/stdlib/70-pseudostructs.f
index 36a8e94..96fb469 100644
--- a/urflibs/stdlib/70-pseudostructs.f
+++ b/urflibs/stdlib/70-pseudostructs.f
@@ -23,7 +23,6 @@ have "rec->field" (offset), "rec->field@" and "rec->field!" accessors.
 simple-vocabulary (struct-accs-internal)
 also-defs: (struct-accs-internal)
 
-$IF HAS-WORD("FORTH:(DIRECT:+:@)") AND HAS-WORD("FORTH:(DIRECT:+:!)")
 ;; create "record->name"
 : (create-ofs-accessor)  ( addr count ofs-in-bytes -- ofs-in-bytes )
   dup >r
@@ -34,7 +33,9 @@ $IF HAS-WORD("FORTH:(DIRECT:+:@)") AND HAS-WORD("FORTH:(DIRECT:+:!)")
  does> ( info-addr pfa -- info-addr-with-offset )
   @  ;; offset
   ?dup if
-    compiler:comp? if literal compile +
+    compiler:comp? if
+      here >r literal r> compiler:(after-compile-lit)
+      here >r compile + r> compiler:(after-compile-word)
     else + endif
   endif
 ;
@@ -51,34 +52,14 @@ $IF HAS-WORD("FORTH:(DIRECT:+:@)") AND HAS-WORD("FORTH:(DIRECT:+:!)")
   immediate
  does> ( base pfa )
   compiler:comp? if
-    dup @ ?dup if swap cell+ @ compile, ,
-    else 2 +cells @ compile, endif
+    dup @ ?dup if swap cell+ @ here >r compile, , r> compiler:(after-compile-word)
+    else 2 +cells @ here >r compile, r> compiler:(after-compile-word) endif
   else dup @ rot + swap 2 +cells @execute-tail
   endif
 ;
 
 : (create-peek-accessor)  ( addr count ofs -- )  false [char] @ (create-accessor) ;
 : (create-poke-accessor)  ( addr count ofs -- )  true [char] ! (create-accessor) ;
-$ELSE
-;; create "record->name"
-: (create-ofs-accessor)  ( addr count ofs-in-bytes -- ofs-acc-cfa )
-  pad @ >r nrot " ->" string:pad+cc string:pad+cc
-  string:pad-cc@ (create) latest-cfa swap ,
-  r> pad !
-  does> ( info-addr pfa -- info-addr-with-offset ) @ +
-;
-
-;; create "record->nameX"
-: (create-accessor)  ( addr count ofs-acc-cfa cfa-r/w char -- )
-  pad @ >r " ->" string:pad+cc >r 2swap string:pad+cc r> string:pad+char
-  string:pad-cc@ compiler:(create-forth-header)
-  swap compile, compile, compile forth:(exit) compiler:smudge
-  r> pad !
-;
-
-: (create-peek-accessor)  ( addr count ofs-acc-cfa -- )  ['] @ [char] @ (create-accessor) ;
-: (create-poke-accessor)  ( addr count ofs-acc-cfa -- )  ['] ! [char] ! (create-accessor) ;
-$ENDIF
 
 prev-defs
 
-- 
2.11.4.GIT