poke-devel
[Top][All Lists]
Advanced

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

[COMMITTED] pkl,pvm: make offset types explicit in offset PVM values


From: Jose E. Marchesi
Subject: [COMMITTED] pkl,pvm: make offset types explicit in offset PVM values
Date: Sun, 12 Feb 2023 15:22:11 +0100
User-agent: Gnus/5.13 (Gnus v5.13)

2023-02-12  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/pkl-gen-attrs.pks (attr_size): Use mkoq.
        (attr_offset): Likewise.
        (attr_eoffset): Likewise.
        (attr_esize): Likewise.
        * libpoke/pkl-gen.pks (emit_tv_field_event): Likewise.
        (struct_mapper): Likewise.
        (struct_constructor): Likewise.
        (struct_field_extractor): Create offset type explicitly.
        (deint_extract_field_value): Likewise.
        (union_deintegrator): Likewise.
        * libpoke/pkl-gen.c (pkl_gen_pr_type_offset): Create offset type
        explicitly.
        (pkl_gen_ps_offset): Likewise.
        (pkl_gen_ps_op_div): Likewise.
        * libpoke/pkl-asm.c (pkl_asm_insn_binop): Use mkoq instead of mko.
        * libpoke/pkl-asm.pks (addo): Likewise.
        (subo): Likewise.
        (mulo): Likewise.
        (modo): Likewise.
        (offset_cast): Likewise.
        * libpoke/pkl-insn.def (PKL_INSN_MKOQ): New instruction.
        * libpoke/pvm.jitter (mkoq): New instruction.

2023-02-12  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/pvm-val.h (PVM_VAL_OFF_UNIT): Remove.
        (PVM_VAL_OFF_BASE_TYPE): Likewise.
        * libpoke/pvm-val.c (pvm_make_offset): Get an offset type as an
        argument.
        (pvm_typeof): Adjust accordingly.
        (pvm_val_equal_p): Likewise.
        (pvm_print_val_1): Likewise.
        * libpoke/pvm.jitter (iosetb): Likewise.
        (ogetu): Likewise.
        (ogetbt): Likewise.
        (iosize): Likewise.
        (iogetb): Likewise.
        * libpoke/pk-val.c (pk_offset_unit): Likewise.
        (pk_val_set_offset): Likewise.
        (pk_make_offset): Likewise.
        (pk_val_offset): Likewise.
        * libpoke/pkl-asm.c (pkl_asm_new): Remove old code involving the
        IO base register.
---
 ChangeLog                 | 51 +++++++++++++++++++++++++++++++
 libpoke/pk-val.c          | 27 +++++++++++------
 libpoke/pkl-asm.c         | 12 ++------
 libpoke/pkl-asm.pks       | 10 +++---
 libpoke/pkl-gen-attrs.pks | 10 +++---
 libpoke/pkl-gen.c         | 24 ++++++++++-----
 libpoke/pkl-gen.pks       | 29 ++++++++++--------
 libpoke/pkl-insn.def      |  1 +
 libpoke/pvm-val.c         | 18 ++++++-----
 libpoke/pvm-val.h         |  6 ++--
 libpoke/pvm.h             |  8 ++---
 libpoke/pvm.jitter        | 64 ++++++++++++++++++++++++++++++---------
 12 files changed, 180 insertions(+), 80 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 3af71776..bb382f12 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,54 @@
+2023-02-12  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl-gen-attrs.pks (attr_size): Use mkoq.
+       (attr_offset): Likewise.
+       (attr_eoffset): Likewise.
+       (attr_esize): Likewise.
+       * libpoke/pkl-gen.pks (emit_tv_field_event): Likewise.
+       (struct_mapper): Likewise.
+       (struct_constructor): Likewise.
+       (struct_field_extractor): Create offset type explicitly.
+       (deint_extract_field_value): Likewise.
+       (union_deintegrator): Likewise.
+       * libpoke/pkl-gen.c (pkl_gen_pr_type_offset): Create offset type
+       explicitly.
+       (pkl_gen_ps_offset): Likewise.
+       (pkl_gen_ps_op_div): Likewise.
+       * libpoke/pkl-asm.c (pkl_asm_insn_binop): Use mkoq instead of mko.
+       * libpoke/pkl-asm.pks (addo): Likewise.
+       (subo): Likewise.
+       (mulo): Likewise.
+       (modo): Likewise.
+       (offset_cast): Likewise.
+       * libpoke/pkl-insn.def (PKL_INSN_MKOQ): New instruction.
+       * libpoke/pvm.jitter (mkoq): New instruction.
+
+2023-02-12  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pvm-val.h (PVM_VAL_OFF_UNIT): Remove.
+       (PVM_VAL_OFF_BASE_TYPE): Likewise.
+       * libpoke/pvm-val.c (pvm_make_offset): Get an offset type as an
+       argument.
+       (pvm_typeof): Adjust accordingly.
+       (pvm_val_equal_p): Likewise.
+       (pvm_print_val_1): Likewise.
+       * libpoke/pvm.jitter (iosetb): Likewise.
+       (ogetu): Likewise.
+       (ogetbt): Likewise.
+       (iosize): Likewise.
+       (iogetb): Likewise.
+       * libpoke/pk-val.c (pk_offset_unit): Likewise.
+       (pk_val_set_offset): Likewise.
+       (pk_make_offset): Likewise.
+       (pk_val_offset): Likewise.
+       * libpoke/pkl-asm.c (pkl_asm_new): Remove old code involving the
+       IO base register.
+
+2023-02-12  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pvm.jitter (mktyo): Get the unit of the offset as an
+       ulong instead of an int.
+
 2023-02-08  Jose E. Marchesi  <jemarch@gnu.org>
 
        * pickles/btf.pk (BTF_Header): Add constraint to check hdr_len.
diff --git a/libpoke/pk-val.c b/libpoke/pk-val.c
index 405b5d93..9605eefe 100644
--- a/libpoke/pk-val.c
+++ b/libpoke/pk-val.c
@@ -92,7 +92,11 @@ pk_make_offset (pk_val magnitude, pk_val unit)
       || PVM_VAL_ULONG_SIZE (unit) != 64)
     return PK_NULL;
   else
-    return pvm_make_offset (magnitude, unit);
+    {
+      pvm_val type = pvm_make_offset_type (pvm_typeof (magnitude),
+                                           unit);
+      return pvm_make_offset (magnitude, type);
+    }
 }
 
 pk_val
@@ -104,7 +108,8 @@ pk_offset_magnitude (pk_val val)
 pk_val
 pk_offset_unit (pk_val val)
 {
-  return PVM_VAL_OFF_UNIT (val);
+  pvm_val val_type = PVM_VAL_OFF_TYPE (val);
+  return PVM_VAL_TYP_O_UNIT (val_type);
 }
 
 int
@@ -169,10 +174,10 @@ pk_val_offset (pk_val val)
   /* XXX "upunit" properly so we get a nice unit, not just bytes or
      bits.  */
   if (bit_offset % 8 == 0)
-    return pvm_make_offset (pvm_make_ulong (bit_offset / 8, 64),
-                            pvm_make_ulong (8, 64));
+    return pk_make_offset (pvm_make_ulong (bit_offset / 8, 64),
+                           pvm_make_ulong (8, 64));
   else
-    return pvm_make_offset (val_offset, pvm_make_ulong (1, 64));
+    return pk_make_offset (val_offset, pvm_make_ulong (1, 64));
 }
 
 void
@@ -180,12 +185,14 @@ pk_val_set_offset (pk_val val, pk_val off)
 {
   uint64_t boff;
 
-  if (!PVM_IS_OFF (off))
-    return;
+  if (PVM_IS_OFF (off))
+    {
+      pvm_val off_type = PVM_VAL_OFF_TYPE (off);
 
-  boff = PVM_VAL_INTEGRAL (PVM_VAL_OFF_MAGNITUDE (off))
-         * PVM_VAL_ULONG (PVM_VAL_OFF_UNIT (off));
-  PVM_VAL_SET_OFFSET (val, pvm_make_ulong (boff, 64));
+      boff = PVM_VAL_INTEGRAL (PVM_VAL_OFF_MAGNITUDE (off))
+        * PVM_VAL_ULONG (PVM_VAL_TYP_O_UNIT (off_type));
+      PVM_VAL_SET_OFFSET (val, pvm_make_ulong (boff, 64));
+    }
 }
 
 pk_val
diff --git a/libpoke/pkl-asm.c b/libpoke/pkl-asm.c
index b53180c9..27ba46f7 100644
--- a/libpoke/pkl-asm.c
+++ b/libpoke/pkl-asm.c
@@ -910,7 +910,7 @@ pkl_asm_insn_binop (pkl_asm pasm,
           pkl_asm_insn (pasm, PKL_INSN_PUSH,
                         pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
                                                       /* OFF NOMAG RUNIT */
-          pkl_asm_insn (pasm, PKL_INSN_MKO);          /* OFF ROFF */
+          pkl_asm_insn (pasm, PKL_INSN_MKOQ);         /* OFF ROFF */
         }
       else if (insn == PKL_INSN_SL
                || insn == PKL_INSN_SR
@@ -926,7 +926,7 @@ pkl_asm_insn_binop (pkl_asm pasm,
           pkl_asm_insn (pasm, PKL_INSN_PUSH,
                         pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
                                                       /* OFF UINT NOMAG RUNIT 
*/
-          pkl_asm_insn (pasm, PKL_INSN_MKO);          /* OFF1 OFF2 ROFF */
+          pkl_asm_insn (pasm, PKL_INSN_MKOQ);         /* OFF1 OFF2 ROFF */
         }
       else
         {
@@ -943,7 +943,7 @@ pkl_asm_insn_binop (pkl_asm pasm,
           pkl_asm_insn (pasm, PKL_INSN_PUSH,
                         pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
                                                       /* OFF1 OFF2 RMAG RUNIT 
*/
-          pkl_asm_insn (pasm, PKL_INSN_MKO);          /* OFF1 OFF2 ROFF */
+          pkl_asm_insn (pasm, PKL_INSN_MKOQ);         /* OFF1 OFF2 ROFF */
         }
     }
   else
@@ -1380,12 +1380,6 @@ pkl_asm_new (pkl_ast ast, pkl_compiler compiler,
       /* Install the stack canary.  */
       pkl_asm_insn (pasm, PKL_INSN_CANARY);
 
-      /* Initialize the IO base register to [0 b].  */
-      pkl_asm_insn (pasm, PKL_INSN_PUSH,
-                    pvm_make_offset (pvm_make_int (0, 32),
-                                     pvm_make_ulong (1, 64)));
-      pkl_asm_insn (pasm, PKL_INSN_POPR, 0);
-
       /* Install the default exception handler.  */
       pkl_asm_insn (pasm, PKL_INSN_PUSH,
                     pvm_make_exception (PVM_E_GENERIC, PVM_E_GENERIC_NAME,
diff --git a/libpoke/pkl-asm.pks b/libpoke/pkl-asm.pks
index b65dcdcd..150e0936 100644
--- a/libpoke/pkl-asm.pks
+++ b/libpoke/pkl-asm.pks
@@ -150,7 +150,7 @@
         nton @unit_type, @to_base_type          ; OFF (OFFMC*OFFUC/TOUNIT) OFFC
         nip2                                    ; OFFC
         pushvar $tounit                         ; OFFC TOUNIT
-        mko                                     ; OFFC
+        mkoq                                    ; OFFC XXX this should really 
use mko but that requires subpassing
         popf 1
         .end
 
@@ -200,7 +200,7 @@
         add @base_type
         nip2                    ; OFF1 OFF2 (OFF2M+OFF1M)
         push #unit              ; OFF1 OFF2 (OFF2M+OFF1M) UNIT
-        mko                     ; OFF1 OFF2 OFFR
+        mkoq                    ; OFF1 OFF2 OFFR
         .end
 
 ;;; SUBO unit_type base_type
@@ -224,7 +224,7 @@
         sub @base_type
         nip2                    ; OFF1 OFF2 (OFF1M+OFF2M)
         push #unit              ; OFF1 OFF2 (OFF1M+OFF2M) UNIT
-        mko                     ; OFF1 OFF2 OFFR
+        mkoq                    ; OFF1 OFF2 OFFR
         .end
 
 ;;; MULO base_type
@@ -248,7 +248,7 @@
         swap                    ; (OFFM*VAL) OFF
         ogetu                   ; (OFFM*VAL) OFF UNIT
         quake                   ; OFF (OFFM*VAL) UNIT
-        mko                     ; OFF OFFR
+        mkoq                    ; OFF OFFR
         fromr                   ; OFF OFFR VAL
         swap                    ; OFF VAL OFFR
         .end
@@ -296,7 +296,7 @@
         mod @base_type
         nip2                    ; OFF1 OFF2 (OFF1M%OFF2M)
         push #unit              ; OFF1 OFF2 (OFF1M%OFF2M) UNIT
-        mko                     ; OFF1 OFF2 OFFR
+        mkoq                    ; OFF1 OFF2 OFFR
         .end
 
 ;;; ACAT
diff --git a/libpoke/pkl-gen-attrs.pks b/libpoke/pkl-gen-attrs.pks
index 3ff468a2..29b51855 100644
--- a/libpoke/pkl-gen-attrs.pks
+++ b/libpoke/pkl-gen-attrs.pks
@@ -50,7 +50,7 @@
    .c }
         siz
         push ulong<64>1
-        mko
+        mkoq
         nip
         .end
 
@@ -83,7 +83,7 @@
         mgeto                   ; VAL BOFF
         nip                     ; BOFF
         push ulong<64>1
-        mko                     ; OFF
+        mkoq                    ; OFF
         .end
 
 ;;; RAS_MACRO_ATTR_IOS @type
@@ -192,7 +192,7 @@
         nip                     ; BOFF
         ;; Build an offset value from the bit-offset.
         push ulong<64>1         ; VAL BOFF UNIT
-        mko                     ; VAL OFF
+        mkoq                    ; VAL OFF
         .end
 
 ;;; RAS_MACRO_ATTR_ESIZE
@@ -243,13 +243,13 @@
         nip                     ; SIZ
         ;; Build an offset value from the bit-offset.
         push ulong<64>1         ; VAL SIZ UNIT
-        mko                     ; VAL OFF
+        mkoq                    ; VAL OFF
         ba .reallydone
 .isabsent:
         drop3                   ; _
         push ulong<64>0
         push ulong<64>1
-        mko                     ; 0#b
+        mkoq                    ; 0#b
 .reallydone:
         .end
 
diff --git a/libpoke/pkl-gen.c b/libpoke/pkl-gen.c
index 600aad78..af75dd10 100644
--- a/libpoke/pkl-gen.c
+++ b/libpoke/pkl-gen.c
@@ -2215,7 +2215,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_offset)
   else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER | 
PKL_GEN_CTX_IN_CONSTRUCTOR))
     {
       PKL_PASS_SUBPASS (PKL_AST_TYPE_O_BASE_TYPE (PKL_PASS_NODE)); /* VAL */
-      PKL_PASS_SUBPASS (PKL_AST_TYPE_O_UNIT (PKL_PASS_NODE));      /* VAL UNIT 
*/
+
+      PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
+      PKL_PASS_SUBPASS (PKL_AST_TYPE_O_BASE_TYPE (PKL_PASS_NODE)); /* VAL 
BASE_TYPE */
+      PKL_GEN_POP_CONTEXT;
+      PKL_PASS_SUBPASS (PKL_AST_TYPE_O_UNIT (PKL_PASS_NODE));      /* VAL 
BASE_TYPE UNIT */
+      pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYO);                  /* VAL TYPE 
*/
       pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKO);                    /* OFF */
       PKL_PASS_BREAK;
     }
@@ -2253,7 +2258,6 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_offset)
 PKL_PHASE_END_HANDLER
 
 /*
- * | TYPE
  * | MAGNITUDE
  * | UNIT
  * OFFSET
@@ -2262,7 +2266,13 @@ PKL_PHASE_END_HANDLER
 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_offset)
 {
   pkl_asm pasm = PKL_GEN_ASM;
+  pkl_ast_node offset_type = PKL_AST_TYPE (PKL_PASS_NODE);
 
+  PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
+  PKL_PASS_SUBPASS (PKL_AST_TYPE_O_BASE_TYPE (offset_type)); /* MAGNITUDE UNIT 
BASE_TYPE */
+  PKL_GEN_POP_CONTEXT;
+  pkl_asm_insn (pasm, PKL_INSN_SWAP); /* MAGNITUDE BASE_TYPE UNIT */
+  pkl_asm_insn (pasm, PKL_INSN_MKTYO); /* MAGNITUDE TYPE */
   pkl_asm_insn (pasm, PKL_INSN_MKO);
 }
 PKL_PHASE_END_HANDLER
@@ -4134,12 +4144,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_div)
         pkl_asm_insn (pasm, PKL_INSN_SWAP); /* OP2 OP1 */
         pkl_asm_insn (pasm, PKL_INSN_OGETM); /* OP2 OP1 OMAG1 */
         pkl_asm_insn (pasm, PKL_INSN_SWAP);
-        pkl_asm_insn (pasm, PKL_INSN_OGETU);
-        pkl_asm_insn (pasm, PKL_INSN_NIP); /* OP2 OMAG1 UNIT */
-        pkl_asm_insn (pasm, PKL_INSN_NROT); /* UNIT OP2 OMAG1 */
-        pkl_asm_insn (pasm, PKL_INSN_SWAP); /* UNIT OMAG1 OP2 */
+        pkl_asm_insn (pasm, PKL_INSN_TYPOF);
+        pkl_asm_insn (pasm, PKL_INSN_NIP); /* OP2 OMAG1 TYP */
+        pkl_asm_insn (pasm, PKL_INSN_NROT); /* TYP OP2 OMAG1 */
+        pkl_asm_insn (pasm, PKL_INSN_SWAP); /* TYP OMAG1 OP2 */
         pkl_asm_insn (pasm, div_insn, op2_type);
-        pkl_asm_insn (pasm, PKL_INSN_NIP2); /* UNIT (OMAG1/OP2) */
+        pkl_asm_insn (pasm, PKL_INSN_NIP2); /* TYP (OMAG1/OP2) */
         pkl_asm_insn (pasm, PKL_INSN_SWAP);
         pkl_asm_insn (pasm, PKL_INSN_MKO);
         break;
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index bb26bd8b..5ac111ad 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -670,7 +670,7 @@
         push ulong<64>3         ; EVENT BOFF ARGS 3UL
         rot                     ; EVENT ARGS 3UL BOFF
         push ulong<64>1
-        mko                     ; EVENT ARGS 3UL OFF
+        mkoq                    ; EVENT ARGS 3UL OFF
         ains                    ; EVENT ARGS
         .call _pkl_dispatch_tv  ; null
         drop                    ; _
@@ -960,9 +960,10 @@
         ;; or an integral struct.
    .c if (PKL_AST_TYPE_CODE (@field_type) == PKL_TYPE_OFFSET)
    .c {
-        .let @offset_unit = PKL_AST_TYPE_O_UNIT (@field_type)
-        .let #unit = pvm_make_ulong (PKL_AST_INTEGER_VALUE (@offset_unit), 64)
-        push #unit                      ; STRICT BOFF MVALC UNIT
+        .c PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
+        .c PKL_PASS_SUBPASS (@field_type);
+        .c PKL_GEN_POP_CONTEXT;
+                                        ; STRICT BOFF MVALC TYP
         mko                             ; STRICT BOFF VALC
    .c }
    .c else if (PKL_AST_TYPE_CODE (@field_type) == PKL_TYPE_STRUCT)
@@ -1191,7 +1192,7 @@
         regvar $ivalue
         push ulong<64>0
         push ulong<64>1
-        mko
+        mkoq
         regvar $OFFSET
         pushvar $boff           ; BOFF
         dup                     ; BOFF BOFF
@@ -1301,7 +1302,7 @@
         sublu
         nip2
         push ulong<64>1
-        mko
+        mkoq
         popvar $OFFSET
  .c   if (PKL_AST_TYPE_S_UNION_P (@type_struct))
  .c   {
@@ -1665,7 +1666,7 @@
         regvar $unused2
         push ulong<64>0
         push ulong<64>1
-        mko
+        mkoq
         regvar $OFFSET
         ;; This is the offset of struct (used in mksct instruction at
         ;; the end of this function), and because the struct is
@@ -1915,7 +1916,7 @@
         ;; Update OFFSET
         dup                    ; ... ENAME EVAL NEBOFF NEBOFF
         push ulong<64>1
-        mko                    ; ... ENAME EVAL NEBOFF NOFFSET
+        mkoq                   ; ... ENAME EVAL NEBOFF NOFFSET
         popvar $OFFSET
         popvar $boff           ; ... ENAME EVAL NEBOFF
         nrot                   ; ... NEBOFF ENAME EVAL
@@ -2490,9 +2491,9 @@
         nip
  .c if (PKL_AST_TYPE_CODE (@field_type) == PKL_TYPE_OFFSET)
  .c {
-        .let @offset_unit = PKL_AST_TYPE_O_UNIT (@field_type)
-        .let #unit = pvm_make_ulong (PKL_AST_INTEGER_VALUE (@offset_unit), 64)
-        push #unit
+        .c PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
+        .c PKL_PASS_SUBPASS (@field_type);
+        .c PKL_GEN_POP_CONTEXT;
         mko
  .c }
  .c else if (PKL_AST_TYPE_CODE (@field_type) == PKL_TYPE_STRUCT)
@@ -2666,8 +2667,10 @@
         nton @itype, @btype
         nip                     ; IVAL NUM
         .let @ounit = PKL_AST_TYPE_O_UNIT (@field_type)
-        .let #unit = pvm_make_ulong (PKL_AST_INTEGER_VALUE (@ounit), 64)
-        push #unit              ; IVAL MAG UNIT
+        .c PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
+        .c PKL_PASS_SUBPASS (@field_type);
+        .c PKL_GEN_POP_CONTEXT;
+                                ; IVAL MAG TYP
         mko                     ; IVAL OFF
   .c  }
   .c  else if (PKL_AST_TYPE_CODE (@field_type) == PKL_TYPE_STRUCT)
diff --git a/libpoke/pkl-insn.def b/libpoke/pkl-insn.def
index 814dfcd5..74cd90d1 100644
--- a/libpoke/pkl-insn.def
+++ b/libpoke/pkl-insn.def
@@ -275,6 +275,7 @@ PKL_DEF_INSN(PKL_INSN_FORMATF64,"n","formatf64")
 /* Offset instructions.  */
 
 PKL_DEF_INSN(PKL_INSN_MKO,"","mko")
+PKL_DEF_INSN(PKL_INSN_MKOQ,"","mkoq")
 PKL_DEF_INSN(PKL_INSN_OGETM,"","ogetm")
 PKL_DEF_INSN(PKL_INSN_OSETM,"","osetm")
 PKL_DEF_INSN(PKL_INSN_OGETU,"","ogetu")
diff --git a/libpoke/pvm-val.c b/libpoke/pvm-val.c
index 2903b1e5..f30c0b0f 100644
--- a/libpoke/pvm-val.c
+++ b/libpoke/pvm-val.c
@@ -581,14 +581,13 @@ pvm_make_cls (pvm_program program)
 }
 
 pvm_val
-pvm_make_offset (pvm_val magnitude, pvm_val unit)
+pvm_make_offset (pvm_val magnitude, pvm_val type)
 {
   pvm_val_box box = pvm_make_box (PVM_VAL_TAG_OFF);
   pvm_off off = pvm_alloc (sizeof (struct pvm_off));
 
-  off->base_type = pvm_typeof (magnitude);
+  off->type = type;
   off->magnitude = magnitude;
-  off->unit = unit;
 
   PVM_VAL_BOX_OFF (box) = off;
   return PVM_BOX (box);
@@ -615,12 +614,14 @@ pvm_val_equal_p (pvm_val val1, pvm_val val2)
     return STREQ (PVM_VAL_STR (val1), PVM_VAL_STR (val2));
   else if (PVM_IS_OFF (val1) && PVM_IS_OFF (val2))
     {
+      pvm_val val1_type = PVM_VAL_OFF_TYPE (val1);
+      pvm_val val2_type = PVM_VAL_OFF_TYPE (val2);
       int pvm_off_mag_equal, pvm_off_unit_equal;
 
       pvm_off_mag_equal = pvm_val_equal_p (PVM_VAL_OFF_MAGNITUDE (val1),
                                            PVM_VAL_OFF_MAGNITUDE (val2));
-      pvm_off_unit_equal = pvm_val_equal_p (PVM_VAL_OFF_UNIT (val1),
-                                            PVM_VAL_OFF_UNIT (val2));
+      pvm_off_unit_equal = pvm_val_equal_p (PVM_VAL_TYP_O_UNIT (val1_type),
+                                            PVM_VAL_TYP_O_UNIT (val2_type));
 
       return pvm_off_mag_equal && pvm_off_unit_equal;
     }
@@ -1569,10 +1570,12 @@ pvm_print_val_1 (pvm vm, int depth, int mode, int base, 
int indent,
     }
   else if (PVM_IS_OFF (val))
     {
+      pvm_val val_type = PVM_VAL_OFF_TYPE (val);
+
       pk_term_class ("offset");
       PVM_PRINT_VAL_1 (PVM_VAL_OFF_MAGNITUDE (val), ndepth);
       pk_puts ("#");
-      print_unit_name (PVM_VAL_ULONG (PVM_VAL_OFF_UNIT (val)));
+      print_unit_name (PVM_VAL_ULONG (PVM_VAL_TYP_O_UNIT (val_type)));
       pk_term_end_class ("offset");
     }
   else if (PVM_IS_CLS (val))
@@ -1640,8 +1643,7 @@ pvm_typeof (pvm_val val)
   else if (PVM_IS_STR (val))
     type = pvm_make_string_type ();
   else if (PVM_IS_OFF (val))
-    type = pvm_make_offset_type (PVM_VAL_OFF_BASE_TYPE (val),
-                                 PVM_VAL_OFF_UNIT (val));
+    type = PVM_VAL_OFF_TYPE (val);
   else if (PVM_IS_ARR (val))
     type = PVM_VAL_ARR_TYPE (val);
   else if (PVM_IS_SCT (val))
diff --git a/libpoke/pvm-val.h b/libpoke/pvm-val.h
index a98bc5d3..192a5741 100644
--- a/libpoke/pvm-val.h
+++ b/libpoke/pvm-val.h
@@ -517,9 +517,8 @@ typedef struct pvm_cls *pvm_cls;
 
 #define PVM_VAL_OFF(V) (PVM_VAL_BOX_OFF (PVM_VAL_BOX ((V))))
 
+#define PVM_VAL_OFF_TYPE(V) (PVM_VAL_OFF((V))->type)
 #define PVM_VAL_OFF_MAGNITUDE(V) (PVM_VAL_OFF((V))->magnitude)
-#define PVM_VAL_OFF_UNIT(V) (PVM_VAL_OFF((V))->unit)
-#define PVM_VAL_OFF_BASE_TYPE(V) (PVM_VAL_OFF((V))->base_type)
 
 #define PVM_VAL_OFF_UNIT_BITS 1
 #define PVM_VAL_OFF_UNIT_NIBBLES 4
@@ -541,9 +540,8 @@ typedef struct pvm_cls *pvm_cls;
 
 struct pvm_off
 {
-  pvm_val base_type;
+  pvm_val type;
   pvm_val magnitude;
-  pvm_val unit;
 };
 
 typedef struct pvm_off *pvm_off;
diff --git a/libpoke/pvm.h b/libpoke/pvm.h
index 37d6aa67..44a0d11c 100644
--- a/libpoke/pvm.h
+++ b/libpoke/pvm.h
@@ -229,12 +229,12 @@ pvm_val pvm_make_string_nodup (char *value);
 
 /* Make an offset PVM value.
 
-   MAGNITUDE is a PVM integral value.
+   MAGNITUDE is a PVM integral value.  It shall be of the same type
+   than the base type specified by TYPE.
 
-   UNIT is an ulong<64> PVM value specifying the unit of the offset,
-   in terms of the basic unit which is the bit.  */
+   TYPE is an offset PVM type.  */
 
-pvm_val pvm_make_offset (pvm_val magnitude, pvm_val unit);
+pvm_val pvm_make_offset (pvm_val magnitude, pvm_val type);
 
 /* Make an array PVM value.
 
diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
index 5bedced1..7f67eb9b 100644
--- a/libpoke/pvm.jitter
+++ b/libpoke/pvm.jitter
@@ -1626,9 +1626,13 @@ instruction iosize ()
 
     if (io == NULL)
       PVM_RAISE_DFL (PVM_E_NO_IOS);
-
-    JITTER_PUSH_STACK (pvm_make_offset (PVM_MAKE_ULONG (ios_size (io), 64),
-                                        PVM_MAKE_ULONG (8, 64)));
+    else
+      {
+        pvm_val magnitude = PVM_MAKE_ULONG (ios_size (io), 64);
+        pvm_val type = pvm_make_offset_type (pvm_typeof (magnitude),
+                                             PVM_MAKE_ULONG (8, 64));
+        JITTER_PUSH_STACK (pvm_make_offset (PVM_MAKE_ULONG (ios_size (io), 
64), type));
+      }
   end
 end
 
@@ -1711,6 +1715,7 @@ instruction iogetb ()
   non-relocatable
   branching # because of PVM_RAISE_DIRECT
   code
+    pvm_val type, magnitude, unit;
     ios io = ios_search_by_id (PVM_VAL_INT (JITTER_TOP_STACK ()));
 
     if (io == NULL)
@@ -1718,11 +1723,18 @@ instruction iogetb ()
 
     uint64_t bias = ios_get_bias (io);
     if (bias % 8 == 0)
-      JITTER_PUSH_STACK (pvm_make_offset (PVM_MAKE_ULONG (bias/8, 64),
-                                          PVM_MAKE_ULONG (8, 64)));
+    {
+      magnitude = PVM_MAKE_ULONG (bias/8, 64);
+      unit = PVM_MAKE_ULONG (8, 64);
+    }
     else
-      JITTER_PUSH_STACK (pvm_make_offset (PVM_MAKE_ULONG (bias, 64),
-                                          PVM_MAKE_ULONG (1, 64)));
+    {
+      magnitude = PVM_MAKE_ULONG (bias, 64);
+      unit = PVM_MAKE_ULONG (1, 64);
+    }
+
+    type = pvm_make_offset_type (pvm_typeof (magnitude), unit);
+    JITTER_PUSH_STACK (pvm_make_offset (magnitude, type));
   end
 end
 
@@ -1743,6 +1755,7 @@ instruction iosetb ()
   branching # because of PVM_RAISE_DIRECT
   code
     pvm_val bias = JITTER_UNDER_TOP_STACK();
+    pvm_val bias_type = PVM_VAL_OFF_TYPE (bias);
     ios io = ios_search_by_id (PVM_VAL_INT (JITTER_TOP_STACK ()));
 
     JITTER_DROP_STACK ();
@@ -1752,7 +1765,7 @@ instruction iosetb ()
 
     ios_set_bias (io,
                   (PVM_VAL_INTEGRAL (PVM_VAL_OFF_MAGNITUDE (bias))
-                   * PVM_VAL_INTEGRAL (PVM_VAL_OFF_UNIT (bias))));
+                   * PVM_VAL_INTEGRAL (PVM_VAL_TYP_O_UNIT (bias_type))));
   end
 end
 
@@ -5487,13 +5500,15 @@ end
 
 # Instruction: mko
 #
-# Given an integral magnitude VAL and an unit expressed in an ULONG,
-# make an offset value and push it on the stack.
+# Given an integral magnitude VAL and an offset type,
+# make an offset value of that type and push it on the stack.
 #
-# Stack: ( VAL ULONG -- OFF )
+# Stack: ( VAL TYP -- OFF )
 
 instruction mko ()
   code
+   PVM_ASSERT (PVM_IS_TYP (JITTER_TOP_STACK ())); /* XXX */
+
    pvm_val res = pvm_make_offset (JITTER_UNDER_TOP_STACK (),
                                   JITTER_TOP_STACK ());
    JITTER_DROP_STACK ();
@@ -5501,6 +5516,23 @@ instruction mko ()
   end
 end
 
+# Instruction: mkoq
+#
+# Given an integral magnitude VAL and an unit in an ULONG,
+# make an offset type and create an offset value with that type.
+#
+# Stack: ( VAL ULONG -- OFF )
+
+instruction mkoq ()
+  code
+   pvm_val type = pvm_make_offset_type (pvm_typeof (JITTER_UNDER_TOP_STACK ()),
+                                        JITTER_TOP_STACK ());
+   pvm_val res = pvm_make_offset (JITTER_UNDER_TOP_STACK (), type);
+   JITTER_DROP_STACK ();
+   JITTER_TOP_STACK () = res;
+  end
+end
+
 # Instruction: ogetm
 #
 # Given an offset OFF, push its magnitude on the stack.
@@ -5536,7 +5568,8 @@ end
 
 instruction ogetu ()
   code
-    JITTER_PUSH_STACK (PVM_VAL_OFF_UNIT (JITTER_TOP_STACK ()));
+    pvm_val otype = PVM_VAL_OFF_TYPE (JITTER_TOP_STACK ());
+    JITTER_PUSH_STACK (PVM_VAL_TYP_O_UNIT (otype));
   end
 end
 
@@ -5548,7 +5581,8 @@ end
 
 instruction ogetbt ()
   code
-    JITTER_PUSH_STACK (PVM_VAL_OFF_BASE_TYPE (JITTER_TOP_STACK ()));
+    pvm_val otype = PVM_VAL_OFF_TYPE (JITTER_TOP_STACK ());
+    JITTER_PUSH_STACK (PVM_VAL_TYP_O_BASE_TYPE (otype));
   end
 end
 
@@ -6152,11 +6186,11 @@ end
 
 # Instruction: mktyo
 #
-# Given a base integral type and an integer denoting an offset unit
+# Given a base integral type and an ulong denoting an offset unit
 # (multiple of the base unit) construct an offset type having these
 # features, and push it on the stack.
 #
-# Stack: ( TYPE INT -- TYPE )
+# Stack: ( TYPE ULONG -- TYPE )
 
 instruction mktyo ()
   code
-- 
2.30.2




reply via email to

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