[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Patch, first version] PVM low-level cleanup and optimization
|
From: |
Luca Saiu |
|
Subject: |
Re: [Patch, first version] PVM low-level cleanup and optimization |
|
Date: |
Fri, 29 Nov 2019 02:23:49 +0100 |
|
User-agent: |
Gnus (Gnus v5.13), GNU Emacs 27.0.50, x86_64-pc-linux-gnu |
On 2019-11-29 at 02:20 +0100, Luca Saiu wrote:
> I am attaching the patch [...]
New version. Fixed a comment mistake.
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..3425b44 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 ; ... 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