[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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [COMMITTED] pkl,pvm: make offset types explicit in offset PVM values,
Jose E. Marchesi <=