[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Patch, first version] PVM low-level cleanup and optimization
|
From: |
Luca Saiu |
|
Subject: |
[Patch, first version] PVM low-level cleanup and optimization |
|
Date: |
Fri, 29 Nov 2019 02:20:20 +0100 |
|
User-agent: |
Gnus (Gnus v5.13), GNU Emacs 27.0.50, x86_64-pc-linux-gnu |
Hello José.
I am attaching the patch, almost finished. I remembered too late, at
the moment of using it, that I needed to implement bulge as well in
Jitter, and I am too tired now. Just tell me if you like this for the
time being, and I can add bulge as well and finish tomorrow, adding a
ChangeLog entry.
bulge will have effect ( a b -- a a b ), or (more likely) something more
general in the style of slide.
gcd
---
I changed the gcd macro to have a conditional branch at the end of the
loop, rather than an conditional branch at the beginning and another
unconditional branch at the end jumping to it. The new behavior is the
same as your original version, except if the second argument happens to
be zero -- which I believe should not be allowed anyway. If you really
want the old behavior on zero, I can do that and keep the optimization.
This of course is mostly cosmetic. The loop will roll very few times in
the typical case.
The test suite of course passes.
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".
Submodule jitter 6f53a42..91e135a:
> 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..bd528d5 100644
--- a/src/pkl-asm.pks
+++ b/src/pkl-asm.pks
@@ -156,11 +156,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 ; ... A B A%B
.endloop:
drop ; A B GCD
.end
@@ -184,10 +182,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 +205,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 +232,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 +254,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 +277,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 +344,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 +526,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,16 +575,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]
+ slide 1, 2 ; SEL VAL NIDX [ARR NRES]
+ revn 3 ; NIDX VAL SEL [ARR NRES]
rot ; 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]
+ slide 1, 2 ; SEL VAL IDX [ARR NRES]
tor ; SEL VAL [ARR NRES IDX]
swap ; VAL SEL [ARR NRES IDX]
fromr ; VAL SEL IDX [ARR NRES]
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..df66bd5 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,7 @@ 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_SLIDE, "nn", "slide")
/* Conversion instructions. */
diff --git a/src/pvm.jitter b/src/pvm.jitter
index 8421aac..1c2a204 100644
--- a/src/pvm.jitter
+++ b/src/pvm.jitter
@@ -953,31 +953,27 @@ end
instruction rot () # ( A B C -- B C A )
code
- pvm_val a, b, c;
-
- c = JITTER_TOP_STACK ();
- JITTER_DROP_STACK ();
- b = JITTER_TOP_STACK ();
- a = JITTER_UNDER_TOP_STACK ();
-
- JITTER_UNDER_TOP_STACK () = b;
- JITTER_TOP_STACK () = c;
- JITTER_PUSH_STACK (a);
+ 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 +1032,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 +2772,9 @@ rule rot-swap-to-quake rewrite
into
quake
end
+
+rule swap-over-to-tuck rewrite
+ swap; over
+into
+ tuck
+end
signature.asc
Description: PGP signature
- [Patch, first version] PVM low-level cleanup and optimization,
Luca Saiu <=