[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Patch] PVM low-level cleanup and optimization, good version [Was: Re: [
|
From: |
Luca Saiu |
|
Subject: |
[Patch] PVM low-level cleanup and optimization, good version [Was: Re: [Patch, first version] PVM low-level cleanup and optimization] |
|
Date: |
Fri, 29 Nov 2019 18:28:02 +0100 |
|
User-agent: |
Gnus (Gnus v5.13), GNU Emacs 27.0.50, x86_64-pc-linux-gnu |
Hello José.
On 2019-11-29 at 02:34 +0100, Luca Saiu wrote:
> Again. Another minor simplification.
And now I am using bulge as well.
One thing that you might not like is how some of the new stack
operations (slide, bulge) are parametric. Intuitive as they are,
reading a number after the PVM instruction name interrupts the flow for
me.
I want to keep the generic stack operations in Jitter out of generality,
but you are not forced to use them in their full version: you could say,
for example, that on the PVM
slide
means
slide 1, 2
and
bulge
means
bulge 1
. Some versions are *much* more useful than others, particularly in
human-written code. I can do that change if you want. The current
version of the patch includes VM instruction parameters -- with the
common values always specialized for.
Before hearing from you I have chosen *not* to introduce the new
instruction whirl in the PVM (see Jitter v0.9.206 ).
There would be a lot of opportunities to use it, but it looks quite
counterintuitive. The common pattern in your code is
BINARY-OPERATION nip2 swap
which now could be rewritten into
BINARY-OPERATION whirl 2
The performance benefit of whirl is small with fast dispatches. If you
want I can add support for it in a rewrite rule only, as long as it does
not bother your reading of disassembled code -- which it might.
I am satisfied about the rest of the patch. Please tell me what you
think.
Regards,
--
Luca Saiu
* My personal web site: http://ageinghacker.net
* GNU epsilon: http://www.gnu.org/software/epsilon
* Jitter: http://ageinghacker.net/projects/jitter
I support everyone's freedom of mocking any opinion or belief, no
matter how deeply held, with open disrespect and the same unrelented
enthusiasm of a toddler who has just learned the word "poo".
commit d1ba6ed99e59d05cdab30160f6583d267adad406
Author: Luca Saiu <address@hidden>
Date: Fri Nov 29 08:12:36 2019 +0100
WIP PVM low-level optimization and simplification
Submodule jitter 6f53a42..e095305:
> new stack operation bulge
> stack header: move comment to a better position
> new stack operation whirl
> align snippet code to a conservatively safe power of 2
> new stack operation: slide
> stack macros: accept unsigned depths
> uninspired VM: make debugging instructions non-relocatable
> cosmetic changes
> comment changes
> jitterlisp bug fix
> add windows support
> rename misnamed feature macro
> build system sanity check
> lots of portability improvements
> manual change
> comment fix
> make support for .section .note.GNU-stack conditional even on GNU
> cosmetic change
> stack: tentative optimization for over in the TOS case
> new stack primitive: tuck
diff --git a/src/pkl-asm.pks b/src/pkl-asm.pks
index 5fef03d..7e07047 100644
--- a/src/pkl-asm.pks
+++ b/src/pkl-asm.pks
@@ -58,8 +58,7 @@
mgetsiz ; WCLS MCLS IOS OFF EBOUND VAL SBOUND
swap ; WCLS MCLS IOS OFF EBOUND SBOUND VAL
mgetm ; WCLS MCLS IOS OFF EBOUND SBOUND VAL MCLS
- swap ; WCLS MCLS IOS OFF EBOUND SBOUND MCLS VAL
- drop ; WCLS MCLS IOS OFF EBOUND SBOUND MCLS
+ nip ; WCLS MCLS IOS OFF EBOUND SBOUND MCLS
call ; WCLS MCLS NVAL
swap ; WCLS NVAL MCLS
msetm ; WCLS NVAL
@@ -88,7 +87,7 @@
nrot ; VAL IOS OFF VAL [WCLS]
fromr ; VAL IOS OFF VAL WCLS
call ; VAL null
- push null ; VAL null null
+ dup ; VAL null null
.label:
drop ; VAL (VAL|null)
drop ; VAL
@@ -156,11 +155,9 @@
over ; A B A
over ; A B A B
.loop:
- bz @type, .endloop ; ... A B
mod @type ; ... A B A%B
- rot ; ... B A%B A
- drop ; ... B A%B
- ba .loop
+ slide 1, 2 ; ... B A%B
+ bnz @type, .loop ; ... B A%B
.endloop:
drop ; A B GCD
.end
@@ -184,10 +181,9 @@
rot ; OFF1 OFF1M OFF2
ogetm ; OFF1 OFF1M OFF2 OFF2M
rot ; OFF1 OFF2 OFF2M OFF1M
- swap ; OFF1 OFF2 OFF1M OFF2M
add @base_type
- nip2 ; OFF1 OFF2 (OFF1M+OFF2M)
- push #unit ; OFF1 OFF2 (OFF1M+OFF2M) UNIT
+ nip2 ; OFF1 OFF2 (OFF2M+OFF1M)
+ push #unit ; OFF1 OFF2 (OFF2M+OFF1M) UNIT
mko ; OFF1 OFF2 OFFR
.end
@@ -208,8 +204,7 @@
ogetm ; OFF2 OFF1 OFF1M
rot ; OFF1 OFF1M OFF2
ogetm ; OFF1 OFF1M OFF2 OFF2M
- rot ; OFF1 OFF2 OFF2M OFF1M
- swap ; OFF1 OFF2 OFF1M OFF2M
+ quake ; OFF1 OFF2 OFF1M OFF2M
sub @base_type
nip2 ; OFF1 OFF2 (OFF1M+OFF2M)
push #unit ; OFF1 OFF2 (OFF1M+OFF2M) UNIT
@@ -236,8 +231,7 @@
nip2 ; OFF (OFFM*VAL)
swap ; (OFFM*VAL) OFF
ogetu ; (OFFM*VAL) OFF UNIT
- rot ; OFF UNIT (OFFM*VAL)
- swap ; OFF (OFFM*VAL) UNIT
+ quake ; OFF (OFFM*VAL) UNIT
mko ; OFF OFFR
fromr ; OFF OFFR VAL
swap ; OFF VAL OFFR
@@ -259,8 +253,7 @@
ogetm ; OFF2 OFF1 OFF1M
rot ; OFF1 OFF1M OFF2
ogetm ; OFF1 OFF1M OFF2 OFF2M
- rot ; OFF1 OFF2 OFF2M OFF1M
- swap ; OFF1 OFF2 OFF1M OFF2M
+ quake ; OFF1 OFF2 OFF1M OFF2M
div @base_type
nip2 ; OFF1 OFF2 (OFF1M/OFF2M)
.end
@@ -283,8 +276,7 @@
ogetm ; OFF2 OFF1 OFF1M
rot ; OFF1 OFF1M OFF2
ogetm ; OFF1 OFF1M OFF2 OFF2M
- rot ; OFF1 OFF2 OFF2M OFF1M
- swap ; OFF1 OFF2 OFF1M OFF2M
+ quake ; OFF1 OFF2 OFF1M OFF2M
mod @base_type
nip2 ; OFF1 OFF2 (OFF1M%OFF2M)
push #unit ; OFF1 OFF2 (OFF1M%OFF2M) UNIT
@@ -351,11 +343,9 @@
pushvar $array ; ... NULL IDX ARR
swap ; ... NULL ARR IDX
aref ; ... NULL ARR IDX EVAL
- rot ; ... NULL IDX EVAL ARR
- drop ; ... NULL IDX EVAL
+ slide 1, 2 ; ... NULL IDX EVAL
pushvar $from ; ... NULL IDX EVAL FROM
- rot ; ... NULL EVAL FROM IDX
- swap ; ... NULL EVAL IDX FROM
+ quake ; ... NULL EVAL IDX FROM
sublu
nip2 ; ... NULL EVAL (IDX-FROM)
swap ; ... NULL (IDX-FROM) EVAL
@@ -535,8 +525,7 @@
ogetm ; OFF2 OFF1 OFF1M
rot ; OFF1 OFF1M OFF2
ogetm ; OFF1 OFF1M OFF2 OFF2M
- rot ; OFF1 OFF2 OFF2M OFF1M
- swap ; OFF1 OFF2 OFF1M OFF2M
+ quake ; OFF1 OFF2 OFF1M OFF2M
cdiv @type
nip2 ; OFF1 OFF2 (OFF1M/^OFF2M)
.end
@@ -585,19 +574,13 @@
push ulong<64>1
addlu ; SEL ELEM VAL IDX 1UL (IDX+1UL) [ARR NRES]
nip2 ; SEL ELEM VAL NIDX [ARR NRES]
- rot ; SEL VAL NIDX ELEM [ARR NRES]
- drop ; SEL VAL NIDX [ARR NREGS]
- nrot ; NIDX SEL VAL [ARR NREGS]
- swap ; NIDX VAL SEL [ARR NRES]
- rot ; VAL SEL NIDX [ARR NRES]
+ slide 1, 2 ; SEL VAL NIDX [ARR NRES]
+ quake ; VAL SEL NIDX [ARR NRES]
ba .loop
.foundit:
tor ; SEL ELEM VAL IDX [ARR NRES]
- rot ; SEL VAL IDX ELEM [ARR NRES]
- drop ; SEL VAL IDX [ARR NRES]
- tor ; SEL VAL [ARR NRES IDX]
- swap ; VAL SEL [ARR NRES IDX]
- fromr ; VAL SEL IDX [ARR NRES]
+ slide 1, 2 ; SEL VAL IDX [ARR NRES]
+ quake ; VAL SEL IDX [ARR NRES]
dup ; VAL SEL IDX IDX [ARR NRES]
.endloop:
drop ; VAL SEL IDX [ARR RES]
@@ -625,10 +608,8 @@
;;; AST node with the type of the result.
.macro bconc #op2_type_size @op1_type @op2_type @res_type
- dup ; OP1 OP2 OP2
- rot ; OP2 OP2 OP1
- dup ; OP2 OP2 OP1 OP1
- rot ; OP2 OP1 OP1 OP2
+ tuck ; OP2 OP1 OP2
+ bulge 1 ; OP2 OP1 OP1 OP2
;; Convert the second operand to the result type.
nton @op2_type, @res_type ; ... OP1 OP2 OP2C
nip ; ... OP1 OP2C
diff --git a/src/pkl-gen.pks b/src/pkl-gen.pks
index bbc7453..9120323 100644
--- a/src/pkl-gen.pks
+++ b/src/pkl-gen.pks
@@ -94,8 +94,7 @@
ogetm ; OFF SBOUND SBOUNDM
swap ; OFF SBOUNDM SBOUND
ogetu ; OFF SBOUNDM SBOUND SBOUNDU
- swap ; OFF SBOUNDM SBOUNDU SBOUND
- drop ; OFF SOBUNDM SBOUNDU
+ nip ; OFF SOBUNDM SBOUNDU
mullu ; OFF SBOUNDM SBOUNDU (SBOUNDM*SBOUNDU)
nip2 ; OFF (SBOUNDM*SBOUNDU)
popvar $sboundm ; OFF
@@ -330,8 +329,7 @@
ogetm ; OFF SBOUND SBOUNDM
swap ; OFF SBOUNDM SBOUND
ogetu ; OFF SBOUNDM SBOUND SBOUNDU
- swap ; OFF SBOUNDM SBOUNDU SBOUND
- drop ; OFF SOBUNDM SBOUNDU
+ nip ; OFF SOBUNDM SBOUNDU
mullu ; OFF SBOUNDM SBOUNDU (SBOUNDM*SBOUNDU)
nip2 ; OFF (SBOUNDM*SBOUNDU)
popvar $sboundm ; OFF
@@ -556,8 +554,7 @@
.macro off_plus_sizeof
swap ; OFF VAL
siz ; OFF VAL ESIZ
- rot ; VAL ESIZ OFF
- swap ; VAL OFF ESIZ
+ quake ; VAL OFF ESIZ
ogetm ; VAL OFF ESIZ ESIZM
nip ; VAL OFF ESIZM
swap ; VAL ESIZM OFF
diff --git a/src/pkl-insn.def b/src/pkl-insn.def
index cd8a769..80013c2 100644
--- a/src/pkl-insn.def
+++ b/src/pkl-insn.def
@@ -55,6 +55,8 @@ PKL_DEF_INSN (PKL_INSN_DUP, "", "dup")
PKL_DEF_INSN (PKL_INSN_OVER, "", "over")
PKL_DEF_INSN (PKL_INSN_ROT, "", "rot")
PKL_DEF_INSN (PKL_INSN_NROT, "", "nrot")
+PKL_DEF_INSN (PKL_INSN_TUCK, "", "tuck")
+PKL_DEF_INSN (PKL_INSN_QUAKE, "", "quake")
PKL_DEF_INSN (PKL_INSN_SAVER, "r", "saver")
PKL_DEF_INSN (PKL_INSN_RESTORER, "r", "restorer")
PKL_DEF_INSN (PKL_INSN_TOR, "", "tor")
@@ -62,6 +64,8 @@ PKL_DEF_INSN (PKL_INSN_FROMR, "", "fromr")
PKL_DEF_INSN (PKL_INSN_ATR, "", "atr")
PKL_DEF_INSN (PKL_INSN_REVN, "n", "revn")
+PKL_DEF_INSN (PKL_INSN_BULGE, "n", "bulge")
+PKL_DEF_INSN (PKL_INSN_SLIDE, "nn", "slide")
/* Conversion instructions. */
diff --git a/src/pvm.jitter b/src/pvm.jitter
index 8421aac..78effe2 100644
--- a/src/pvm.jitter
+++ b/src/pvm.jitter
@@ -951,33 +951,35 @@ instruction quake () # ( A B -- B A B )
end
end
-instruction rot () # ( A B C -- B C A )
+instruction bulge (?n 1 2 3) # ( A B ) bulge 1 ( A A B )
code
- pvm_val a, b, c;
-
- c = JITTER_TOP_STACK ();
- JITTER_DROP_STACK ();
- b = JITTER_TOP_STACK ();
- a = JITTER_UNDER_TOP_STACK ();
+ JITTER_BULGE_STACK (JITTER_ARGU0);
+ end
+end
- JITTER_UNDER_TOP_STACK () = b;
- JITTER_TOP_STACK () = c;
- JITTER_PUSH_STACK (a);
+instruction rot () # ( A B C -- B C A )
+ code
+ JITTER_ROT_STACK ();
end
end
instruction nrot () # ( A B C -- C A B )
code
- pvm_val a, b, c;
+ JITTER_MROT_STACK ();
+ end
+end
- c = JITTER_TOP_STACK ();
- JITTER_DROP_STACK ();
- b = JITTER_TOP_STACK ();
- a = JITTER_UNDER_TOP_STACK ();
+instruction tuck () # ( A B -- B A B )
+ code
+ JITTER_TUCK_STACK ();
+ end
+end
- JITTER_UNDER_TOP_STACK () = c;
- JITTER_TOP_STACK () = a;
- JITTER_PUSH_STACK (b);
+# Remove JITTER_ARGU0 non-top elements from the stack, of which the deepest is
+# at depth JITTER_ARGU1 (where the top is at depth 0).
+instruction slide (?n 1 2 popf_printer, ?n 2 3 popf_printer)
+ code
+ JITTER_SLIDE_STACK (JITTER_ARGU0, JITTER_ARGU1);
end
end
@@ -1036,9 +1038,9 @@ instruction sel () # ( VAL -- VAL ULONG )
end
end
-instruction revn (?n popf_printer) # ( VAL{N} -- VAL{N} )
+instruction revn (?n 3 4 popf_printer) # ( VAL{N} -- VAL{N} )
code
- JITTER_REVERSE_STACK (JITTER_ARGN0);
+ JITTER_REVERSE_STACK (JITTER_ARGU0);
end
end
@@ -2776,3 +2778,16 @@ rule rot-swap-to-quake rewrite
into
quake
end
+
+rule swap-over-to-tuck rewrite
+ swap; over
+into
+ tuck
+end
+
+# A B -- A A B
+rule over-swap-to-bulge1 rewrite
+ over; swap
+into
+ bulge 1
+end
signature.asc
Description: PGP signature