poke-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Patch] PVM low-level cleanup and optimization, good version [Was: R


From: Jose E. Marchesi
Subject: Re: [Patch] PVM low-level cleanup and optimization, good version [Was: Re: [Patch, first version] PVM low-level cleanup and optimization]
Date: Sun, 01 Dec 2019 13:14:59 +0100
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/26.1 (gnu/linux)

Hi Luca.

      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

This is OK.

               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

Likewise.

             .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

I don't really like this new version of gcd.

After pondering about it, I think I don't want to adopt slide and bulge
as PVM instructions.  They are too complicated for my taste.


      @@ -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

Nice, this is OK.
 
      @@ -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

OK.

      @@ -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

OK.

      @@ -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

OK.

      @@ -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

OK.

      @@ -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

OK for the quake part.

      @@ -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

OK.

      @@ -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

OK for quake, not for slide.

       .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]

Likewise.

       .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

OK to tuck, not to bulge.

      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

OK.

      @@ -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

OK.

      @@ -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

OK.

      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")

OK.

       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")

No bulge nor slide pls.

      +instruction rot () # ( A B C -- B C A )
      +  code
      +    JITTER_ROT_STACK ();
         end
       end

Ah yes, much better :)
 
       instruction nrot () # ( A B C -- C A B )
         code
      -   pvm_val a, b, c;
      +    JITTER_MROT_STACK ();
      +  end
      +end

Likewise.

      +instruction tuck () #  ( A B -- B A B )
      +  code
      +    JITTER_TUCK_STACK ();
      +  end
      +end

OK.

      +# 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

Nope too complicated.

 
      -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

Hm why this? JITTER_ARGU0?

      +rule swap-over-to-tuck rewrite
      +  swap; over
      +into
      +  tuck
      +end

OK.

      +# A B -- A A B
      +rule over-swap-to-bulge1 rewrite
      +  over; swap
      +into
      +  bulge 1
      +end

Nope.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]