From e7e29d34ff53680248f4b733b80bff7a83d2a213 Mon Sep 17 00:00:00 2001 From: David Given Date: Sun, 15 Jan 2017 22:28:14 +0100 Subject: [PATCH] Add a test (currently failing) to check that Pascal char sets can store all 256 possible values. Add the PowerPC ncg and mcg backend support to let the test actually run, including modifying a bunch of PowrePC libem functions so that they can be called from both ncg and mcg. --- mach/powerpc/libem/ior.s | 6 +- mach/powerpc/libem/rck.s | 22 ++++ mach/powerpc/libem/set.s | 7 +- mach/powerpc/libem/zer.s | 6 +- mach/powerpc/ncg/table | 58 +++++------ mach/proto/mcg/treebuilder.c | 191 +++++++++++++++++++--------------- plat/linuxppc/libsys/trap.s | 25 +++-- plat/qemuppc/libsys/trap.s | 7 +- tests/plat/charsignedness_p.p | 28 +++++ tests/plat/newdispose_p.p | 4 +- 10 files changed, 221 insertions(+), 133 deletions(-) create mode 100644 mach/powerpc/libem/rck.s create mode 100644 tests/plat/charsignedness_p.p diff --git a/mach/powerpc/libem/ior.s b/mach/powerpc/libem/ior.s index 61e099934..b3ebf81e9 100644 --- a/mach/powerpc/libem/ior.s +++ b/mach/powerpc/libem/ior.s @@ -3,11 +3,13 @@ .sect .text ! Set union. -! Stack: ( b a -- a+b ) -! With r3 = size of set +! Stack: ( size b a -- a+b ) .define .ior .ior: + lwz r3, 0 (sp) + addi sp, sp, 4 + mr r4, sp ! r4 = ptr to set a add r5, sp, r3 ! r5 = ptr to set b rlwinm r6, r3, 30, 2, 31 diff --git a/mach/powerpc/libem/rck.s b/mach/powerpc/libem/rck.s new file mode 100644 index 000000000..b716e5091 --- /dev/null +++ b/mach/powerpc/libem/rck.s @@ -0,0 +1,22 @@ +#include "powerpc.h" + +.sect .text + +! Bounds check. Traps if the value is out of range. +! Stack: ( descriptor value -- ) + +.define .rck +.rck: + lwz r3, 0 (sp) + lwz r4, 4 (sp) + addi sp, sp, 8 + + lwz r5, 0 (r3) + cmp cr0, 0, r4, r5 + bc IFTRUE, LT, .trap_erange + + lwz r5, 4 (r3) + cmp cr0, 0, r4, r5 + bc IFTRUE, GT, .trap_erange + + bclr ALWAYS, 0, 0 diff --git a/mach/powerpc/libem/set.s b/mach/powerpc/libem/set.s index 18ad877e8..daffb9c3d 100644 --- a/mach/powerpc/libem/set.s +++ b/mach/powerpc/libem/set.s @@ -3,11 +3,14 @@ .sect .text ! Create singleton set. -! Stack: ( -- set ) -! With r3 = size of set, r4 = bit number +! Stack: ( size bitnumber -- set ) .define .set .set: + lwz r3, 0 (sp) + lwz r4, 4 (sp) + addi sp, sp, 8 + rlwinm r7, r3, 30, 2, 31 neg r5, r3 add sp, sp, r5 ! allocate set diff --git a/mach/powerpc/libem/zer.s b/mach/powerpc/libem/zer.s index ba978ba3e..697a5715f 100644 --- a/mach/powerpc/libem/zer.s +++ b/mach/powerpc/libem/zer.s @@ -3,11 +3,13 @@ .sect .text ! Create empty set. -! Stack: ( -- set ) -! With r3 = size of set +! Stack: ( size -- set ) .define .zer .zer: + lwz r3, 0(sp) + addi sp, sp, 4 + rlwinm r7, r3, 30, 2, 31 addi r4, r0, 0 ! r4 = zero neg r5, r3 diff --git a/mach/powerpc/ncg/table b/mach/powerpc/ncg/table index 52f335c3d..6498c591c 100644 --- a/mach/powerpc/ncg/table +++ b/mach/powerpc/ncg/table @@ -1503,18 +1503,14 @@ PATTERNS yields {OR_RC, %2, lo(%1.val)} pat ior defined($1) /* OR set */ - with STACK - kills ALL - gen - move {CONST, $1}, R3 - bl {LABEL, ".ior"} + leaving + loc $1 + cal ".ior" /* OR set (variable), used in lang/m2/libm2/LtoUset.e */ pat ior !defined($1) - with GPR3 STACK - kills ALL - gen - bl {LABEL, ".ior"} + leaving + cal ".ior" pat xor $1==4 /* XOR word */ with REG REG @@ -1572,12 +1568,10 @@ PATTERNS leaving loc 0 - pat zer defined($1) /* Create empty set */ - with STACK - kills ALL - gen - move {CONST, $1}, R3 - bl {LABEL, ".zer"} + pat zer defined($1) /* Create empty set */ + leaving + loc $1 + cal ".zer" pat sli $1==4 /* Shift left (second << top) */ with CONST_ALL GPR @@ -1655,27 +1649,19 @@ PATTERNS /* Sets */ pat set defined($1) /* Create singleton set */ - with GPR4 STACK - kills ALL - gen - move {CONST, $1}, R3 - bl {LABEL, ".set"} + leaving + loc $1 + cal ".set" /* Create set (variable), used in lang/m2/libm2/LtoUset.e */ pat set !defined($1) - with GPR3 GPR4 STACK - kills ALL - gen - bl {LABEL, ".set"} + leaving + cal ".set" pat inn defined($1) /* Test for set bit */ - with STACK - kills ALL - uses REG - gen - li32 %a, {CONST, $1} - stwu %a, {GPRINDIRECT, SP, 0-4} - bl {LABEL, ".inn"} + leaving + loc $1 + cal ".inn" /* Boolean resolutions */ @@ -2066,6 +2052,16 @@ PATTERNS loc $1 ass 4 + pat lae rck $2==4 /* Range check */ + with GPR + uses CR0 + gen + cmpli %a, {CONST, 0}, %1, {CONST, rom($1, 1)} + bc IFTRUE, LT, {LABEL, ".trap_erange"} + cmpli %a, {CONST, 0}, %1, {CONST, rom($1, 2)} + bc IFTRUE, GT, {LABEL, ".trap_erange"} + + /* Floating point support */ diff --git a/mach/proto/mcg/treebuilder.c b/mach/proto/mcg/treebuilder.c index 667562e8d..ba4f7198f 100644 --- a/mach/proto/mcg/treebuilder.c +++ b/mach/proto/mcg/treebuilder.c @@ -66,7 +66,7 @@ static struct ir* pop(int size) #if 0 /* If we try to pop something which is smaller than a word, convert it first. */ - + if (size < EM_wordsize) ir = convertu(ir, size); #endif @@ -200,7 +200,7 @@ static struct ir* address_of_external(const char* label, arith offset) static struct ir* convert(struct ir* src, int srcsize, int destsize, int opcode) { - if (srcsize == 1) + if (srcsize == 1) { if ((opcode == IR_FROMSI) || (opcode == IR_FROMSL)) { @@ -433,7 +433,7 @@ static void insn_simple(int opcode) ); break; } - + case op_cii: simple_convert(IR_FROMSI); break; case op_ciu: simple_convert(IR_FROMSI); break; case op_cui: simple_convert(IR_FROMUI); break; @@ -528,10 +528,12 @@ static void insn_simple(int opcode) } /* FIXME: These instructions are really complex and barely used - * (Modula-2 bitset support, I believe). Leave them until later. */ + * (Modula-2 and Pascal set support, I believe). Leave them until + * later. */ case op_set: helper_function(".unimplemented_set"); break; case op_ior: helper_function(".unimplemented_ior"); break; + case op_dch: push( new_ir1( @@ -540,7 +542,7 @@ static void insn_simple(int opcode) ) ); break; - + case op_lpb: push( new_ir1( @@ -607,29 +609,53 @@ static void insn_bvalue(int opcode, struct basicblock* leftbb, struct basicblock } } -static void simple_alu1(int opcode, int size, int irop) +static void simple_alu1(int opcode, int size, int irop, const char* fallback) { - struct ir* val = pop(size); + if (size > (2*EM_wordsize)) + { + if (!fallback) + fatal("treebuilder: can't do opcode %d with size %d", opcode, size); + push( + new_wordir(size) + ); + helper_function(fallback); + } + else + { + struct ir* val = pop(size); - push( - new_ir1( - irop, size, - val - ) - ); + push( + new_ir1( + irop, size, + val + ) + ); + } } -static void simple_alu2(int opcode, int size, int irop) +static void simple_alu2(int opcode, int size, int irop, const char* fallback) { - struct ir* right = pop(size); - struct ir* left = pop(size); + if (size > (2*EM_wordsize)) + { + if (!fallback) + fatal("treebuilder: can't do opcode %d with size %d", opcode, size); + push( + new_wordir(size) + ); + helper_function(fallback); + } + else + { + struct ir* right = pop(size); + struct ir* left = pop(size); - push( - new_ir2( - irop, size, - left, right - ) - ); + push( + new_ir2( + irop, size, + left, right + ) + ); + } } static struct ir* extract_block_refs(struct basicblock* bb) @@ -708,39 +734,43 @@ static void insn_ivalue(int opcode, arith value) { switch (opcode) { - case op_adi: simple_alu2(opcode, value, IR_ADD); break; - case op_sbi: simple_alu2(opcode, value, IR_SUB); break; - case op_mli: simple_alu2(opcode, value, IR_MUL); break; - case op_dvi: simple_alu2(opcode, value, IR_DIV); break; - case op_rmi: simple_alu2(opcode, value, IR_MOD); break; - case op_sli: simple_alu2(opcode, value, IR_ASL); break; - case op_sri: simple_alu2(opcode, value, IR_ASR); break; - case op_ngi: simple_alu1(opcode, value, IR_NEG); break; - - case op_adu: simple_alu2(opcode, value, IR_ADD); break; - case op_sbu: simple_alu2(opcode, value, IR_SUB); break; - case op_mlu: simple_alu2(opcode, value, IR_MUL); break; - case op_slu: simple_alu2(opcode, value, IR_LSL); break; - case op_sru: simple_alu2(opcode, value, IR_LSR); break; - case op_rmu: simple_alu2(opcode, value, IR_MODU); break; - case op_dvu: simple_alu2(opcode, value, IR_DIVU); break; - - case op_and: simple_alu2(opcode, value, IR_AND); break; - case op_ior: simple_alu2(opcode, value, IR_OR); break; - case op_xor: simple_alu2(opcode, value, IR_EOR); break; - case op_com: simple_alu1(opcode, value, IR_NOT); break; - - case op_adf: simple_alu2(opcode, value, IR_ADDF); break; - case op_sbf: simple_alu2(opcode, value, IR_SUBF); break; - case op_mlf: simple_alu2(opcode, value, IR_MULF); break; - case op_dvf: simple_alu2(opcode, value, IR_DIVF); break; - case op_ngf: simple_alu1(opcode, value, IR_NEGF); break; + case op_adi: simple_alu2(opcode, value, IR_ADD, NULL); break; + case op_sbi: simple_alu2(opcode, value, IR_SUB, NULL); break; + case op_mli: simple_alu2(opcode, value, IR_MUL, NULL); break; + case op_dvi: simple_alu2(opcode, value, IR_DIV, NULL); break; + case op_rmi: simple_alu2(opcode, value, IR_MOD, NULL); break; + case op_sli: simple_alu2(opcode, value, IR_ASL, NULL); break; + case op_sri: simple_alu2(opcode, value, IR_ASR, NULL); break; + case op_ngi: simple_alu1(opcode, value, IR_NEG, NULL); break; + + case op_adu: simple_alu2(opcode, value, IR_ADD, NULL); break; + case op_sbu: simple_alu2(opcode, value, IR_SUB, NULL); break; + case op_mlu: simple_alu2(opcode, value, IR_MUL, NULL); break; + case op_slu: simple_alu2(opcode, value, IR_LSL, NULL); break; + case op_sru: simple_alu2(opcode, value, IR_LSR, NULL); break; + case op_rmu: simple_alu2(opcode, value, IR_MODU, NULL); break; + case op_dvu: simple_alu2(opcode, value, IR_DIVU, NULL); break; + + case op_and: simple_alu2(opcode, value, IR_AND, NULL); break; + case op_ior: simple_alu2(opcode, value, IR_OR, ".ior"); break; + case op_xor: simple_alu2(opcode, value, IR_EOR, NULL); break; + case op_com: simple_alu1(opcode, value, IR_NOT, NULL); break; + + case op_adf: simple_alu2(opcode, value, IR_ADDF, NULL); break; + case op_sbf: simple_alu2(opcode, value, IR_SUBF, NULL); break; + case op_mlf: simple_alu2(opcode, value, IR_MULF, NULL); break; + case op_dvf: simple_alu2(opcode, value, IR_DIVF, NULL); break; + case op_ngf: simple_alu1(opcode, value, IR_NEGF, NULL); break; case op_cmu: /* fall through */ case op_cms: push(tristate_compare(value, IR_COMPAREUI)); break; case op_cmi: push(tristate_compare(value, IR_COMPARESI)); break; case op_cmf: push(tristate_compare(value, IR_COMPAREF)); break; + case op_rck: helper_function(".rck"); break; + case op_set: push(new_wordir(value)); helper_function(".set"); break; + case op_inn: push(new_wordir(value)); helper_function(".inn"); break; + case op_lol: push( load( @@ -874,7 +904,7 @@ static void insn_ivalue(int opcode, arith value) ) ); break; - + case op_loc: push( new_wordir(value) @@ -1041,7 +1071,7 @@ static void insn_ivalue(int opcode, arith value) struct ir* right = pop(EM_pointersize); struct ir* left = pop(EM_pointersize); - struct ir* delta = + struct ir* delta = new_ir2( IR_SUB, EM_pointersize, left, right @@ -1053,7 +1083,7 @@ static void insn_ivalue(int opcode, arith value) push(delta); break; } - + case op_dup: { sequence_point(); @@ -1084,6 +1114,18 @@ static void insn_ivalue(int opcode, arith value) break; } + case op_zer: + { + if (value <= EM_wordsize) + push(new_constir(value, 0)); + else + { + push(new_wordir(value)); + helper_function(".zer"); + } + break; + } + case op_asp: { switch (value) @@ -1108,15 +1150,12 @@ static void insn_ivalue(int opcode, arith value) value -= s; } - if (value != 0) - { - appendir( - new_ir1( - IR_STACKADJUST, EM_pointersize, - new_wordir(value) - ) - ); - } + appendir( + new_ir1( + IR_STACKADJUST, EM_pointersize, + new_wordir(value) + ) + ); break; } break; @@ -1169,7 +1208,7 @@ static void insn_ivalue(int opcode, arith value) ); break; } - + case op_lfr: { push( @@ -1300,11 +1339,11 @@ static void insn_ivalue(int opcode, arith value) new_labelir((value == 4) ? ".fef4" : ".fef8") ) ); - + /* exit, leaving an int and then a float (or double) on the stack. */ break; } - + case op_fif: { /* fif is implemented by calling a helper function which then mutates @@ -1320,11 +1359,11 @@ static void insn_ivalue(int opcode, arith value) new_labelir((value == 4) ? ".fif4" : ".fif8") ) ); - + /* exit, leaving two floats (or doubles) on the stack. */ break; } - + case op_lor: { switch (value) @@ -1341,7 +1380,7 @@ static void insn_ivalue(int opcode, arith value) ) ); break; - + case 1: push( appendir( @@ -1492,18 +1531,6 @@ static void insn_ivalue(int opcode, arith value) break; } - /* FIXME: These instructions are really complex and barely used - * (Modula-2 bitset support, I believe). Leave them until leter. */ - case op_inn: - { - push( - new_wordir(value) - ); - - helper_function(".inn"); - break; - } - case op_lin: { /* Set line number --- ignore. */ @@ -1577,7 +1604,7 @@ static void insn_lvalue(int opcode, const char* label, arith offset) ) ); break; - + case op_ine: sequence_point(); appendir( @@ -1666,7 +1693,7 @@ static void insn_lvalue(int opcode, const char* label, arith offset) /* Set filename --- ignore. */ break; } - + default: fatal("treebuilder: unknown lvalue instruction '%s'", em_mnem[opcode - sp_fmnem]); @@ -1699,7 +1726,7 @@ static void generate_tree(struct basicblock* bb) break; case PARAM_LVALUE: - tracef('E', "label=%s offset=%d\n", + tracef('E', "label=%s offset=%d\n", em->u.lvalue.label, em->u.lvalue.offset); insn_lvalue(em->opcode, em->u.lvalue.label, em->u.lvalue.offset); break; diff --git a/plat/linuxppc/libsys/trap.s b/plat/linuxppc/libsys/trap.s index 09d3b0b21..296f17391 100644 --- a/plat/linuxppc/libsys/trap.s +++ b/plat/linuxppc/libsys/trap.s @@ -52,43 +52,48 @@ EUNIMPL = 63 ! unimplemented em-instruction called .trap_ecase: addi r3, r0, ECASE b .trap - + .define .trap_earray .trap_earray: addi r3, r0, EARRAY b .trap - + +.define .trap_erange +.trap_erange: + addi r3, r0, ERANGE + b .trap + .define .trap .trap: cmpi cr0, 0, r3, 15 ! traps >15 can't be ignored bc IFTRUE, LT, 1f - + addi r4, r0, 1 rlwnm r4, r4, r3, 0, 31 ! calculate trap bit li32 r5, .ignmask lwz r5, 0(r5) ! load ignore mask and. r4, r4, r5 ! compare bclr IFFALSE, EQ, 0 ! return if non-zero - + 1: li32 r4, .trppc lwz r5, 0(r4) ! load user trap routine or. r5, r5, r5 ! test bc IFTRUE, EQ, fatal ! if no user trap routine, bail out - + addi r0, r0, 0 stw r0, 0(r4) ! reset trap routine - + mfspr r0, lr stwu r0, -4(sp) ! save old lr - + stwu r3, -4(sp) mtspr ctr, r5 bcctrl ALWAYS, 0, 0 ! call trap routine - + lwz r0, 4(sp) ! load old lr again addi sp, sp, 8 ! retract over stack usage - bclr ALWAYS, 0, 0 ! return + bclr ALWAYS, 0, 0 ! return fatal: addi r3, r0, 1 @@ -96,7 +101,7 @@ fatal: addi r5, r0, 6 addi r0, r0, 4 ! write() sc 0 - + addi r0, r0, 1 ! exit() sc 0 diff --git a/plat/qemuppc/libsys/trap.s b/plat/qemuppc/libsys/trap.s index f05b907d0..280adc33b 100644 --- a/plat/qemuppc/libsys/trap.s +++ b/plat/qemuppc/libsys/trap.s @@ -49,11 +49,15 @@ EUNIMPL = 63 ! unimplemented em-instruction called .define .trap_ecase .trap_ecase: b .trp - + .define .trap_earray .trap_earray: b .trp +.define .trap_erange +.trap_erange: + b .trap + .define .trp .define .trap .trp: @@ -66,4 +70,3 @@ EUNIMPL = 63 ! unimplemented em-instruction called li32 r4, .trppc stw r3, 0(r4) bclr ALWAYS, 0, 0 ! return - \ No newline at end of file diff --git a/tests/plat/charsignedness_p.p b/tests/plat/charsignedness_p.p new file mode 100644 index 000000000..6263111ce --- /dev/null +++ b/tests/plat/charsignedness_p.p @@ -0,0 +1,28 @@ +# +(*$U+ -- enables underscores in identifiers *) + +program markrelease; + +type + charset = set of char; + +var + s : charset; + i : integer; + +procedure finished; + extern; + +procedure fail(line: integer); + extern; + +#define ASSERT(cond) \ + if (not (cond)) then fail(__LINE__) + +begin + s := []; + for i := 0 to 255 do + s := s + [chr(i)]; + + finished +end. diff --git a/tests/plat/newdispose_p.p b/tests/plat/newdispose_p.p index 36f09e99b..aa3be5a46 100644 --- a/tests/plat/newdispose_p.p +++ b/tests/plat/newdispose_p.p @@ -9,13 +9,13 @@ type var ptr1 : iptr; ptr2 : iptr; - + procedure finished; extern; procedure fail(line: integer); extern; - + #define ASSERT(cond) \ if (not (cond)) then fail(__LINE__)