From 8e6fe7258c30c04997eb660a4dfb673cec7af95f Mon Sep 17 00:00:00 2001 From: ceriel Date: Tue, 6 Mar 1990 13:22:30 +0000 Subject: [PATCH] fix: ARRAY type of itself caused crash; better implementation of ranges in CASE labels --- lang/m2/comp/casestat.C | 68 ++++++++++++++++++----------------- lang/m2/comp/declar.g | 80 +++++++++++++++++++++-------------------- 2 files changed, 78 insertions(+), 70 deletions(-) diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C index 1ffec8c0e..531f60454 100644 --- a/lang/m2/comp/casestat.C +++ b/lang/m2/comp/casestat.C @@ -52,7 +52,7 @@ struct switch_hdr { struct case_entry { struct case_entry *ce_next; /* next in list */ label ce_label; /* generated label */ - arith ce_value; /* value of case label */ + arith ce_low, ce_up; /* lower and upper bound of range */ }; /* STATICALLOCDEF "case_entry" 20 */ @@ -147,14 +147,20 @@ CaseCode(nd, exitlabel, end_reached) if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) { /* CSA */ + int gen = 1; + ce = sh->sh_entries; C_rom_cst((arith) 0); C_rom_cst(sh->sh_upperbd - sh->sh_lowerbd); for (val = sh->sh_lowerbd; val <= sh->sh_upperbd; val++) { assert(ce); - if (val == ce->ce_value) { + if (gen || val == ce->ce_low) { + gen = 1; C_rom_ilb(ce->ce_label); - ce = ce->ce_next; + if (val == ce->ce_up) { + gen = 0; + ce = ce->ce_next; + } } else if (sh->sh_default) C_rom_ilb(sh->sh_default); else C_rom_ucon("0", pointer_size); @@ -171,8 +177,11 @@ CaseCode(nd, exitlabel, end_reached) for (ce = sh->sh_entries; ce; ce = ce->ce_next) { /* generate the entries: value + prog.label */ - C_rom_cst(ce->ce_value); - C_rom_ilb(ce->ce_label); + val = ce->ce_low; + do { + C_rom_cst(val); + C_rom_ilb(ce->ce_label); + } while (val++ != ce->ce_up); } c_lae_dlb(CaseDescrLab); /* perform the switch */ C_csb(word_size); @@ -238,15 +247,7 @@ AddCases(sh, node, lbl) assert(node->nd_left->nd_class == Value); assert(node->nd_right->nd_class == Value); - node->nd_type = node->nd_left->nd_type; - node->nd_INT = node->nd_left->nd_INT; - for (;;) { - AddOneCase(sh, node, lbl); - if (node->nd_INT == node->nd_right->nd_INT) { - break; - } - node->nd_INT++; - } + AddOneCase(sh, node->nd_left, node->nd_right, lbl); return; } @@ -257,12 +258,12 @@ AddCases(sh, node, lbl) } assert(node->nd_class == Value); - AddOneCase(sh, node, lbl); + AddOneCase(sh, node, node, lbl); } -AddOneCase(sh, node, lbl) +AddOneCase(sh, lnode, rnode, lbl) register struct switch_hdr *sh; - t_node *node; + t_node *lnode, *rnode; label lbl; { register struct case_entry *ce = new_case_entry(); @@ -270,29 +271,30 @@ AddOneCase(sh, node, lbl) int fund = sh->sh_type->tp_fund; ce->ce_label = lbl; - ce->ce_value = node->nd_INT; - if (! ChkCompat(&node, sh->sh_type, "case")) { + ce->ce_low = lnode->nd_INT; + ce->ce_up = rnode->nd_INT; + if (! ChkCompat(&lnode, sh->sh_type, "case") || + ! ChkCompat(&rnode, sh->sh_type, "case")) { } if (sh->sh_entries == 0) { /* first case entry */ - ce->ce_next = (struct case_entry *) 0; sh->sh_entries = ce; - sh->sh_lowerbd = sh->sh_upperbd = ce->ce_value; - sh->sh_nrofentries = 1; + sh->sh_lowerbd = ce->ce_low; + sh->sh_upperbd = ce->ce_up; } else { /* second etc. case entry find the proper place to put ce into the list */ - if (chk_bounds(ce->ce_value, sh->sh_lowerbd, fund)) { - sh->sh_lowerbd = ce->ce_value; + if (chk_bounds(ce->ce_low, sh->sh_lowerbd, fund)) { + sh->sh_lowerbd = ce->ce_low; } - else if (! chk_bounds(ce->ce_value, sh->sh_upperbd, fund)) { - sh->sh_upperbd = ce->ce_value; + if (! chk_bounds(ce->ce_up, sh->sh_upperbd, fund)) { + sh->sh_upperbd = ce->ce_up; } - while (c1 && !chk_bounds(ce->ce_value, c1->ce_value, fund)) { + while (c1 &&! chk_bounds(ce->ce_up, c1->ce_low, fund)) { c2 = c1; c1 = c1->ce_next; } @@ -306,11 +308,14 @@ AddOneCase(sh, node, lbl) The case c1 == 0 && c2 == 0 cannot occur, since the list is guaranteed not to be empty. */ - if (c1) { - if (c1->ce_value == ce->ce_value) { -node_error(node, "multiple case entry for value %ld", ce->ce_value); + if (c2) { + if ( chk_bounds(ce->ce_low, c2->ce_up, fund)) { +node_error(rnode, "multiple case entry for value %ld", (long)(ce->ce_low)); free_case_entry(ce); + return; } + } + if (c1) { if (c2) { ce->ce_next = c2->ce_next; c2->ce_next = ce; @@ -323,9 +328,8 @@ node_error(node, "multiple case entry for value %ld", ce->ce_value); else { assert(c2); - ce->ce_next = (struct case_entry *) 0; c2->ce_next = ce; } - (sh->sh_nrofentries)++; } + sh->sh_nrofentries += ce->ce_up - ce->ce_low + 1; } diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 654401cf0..668ea3f61 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -150,16 +150,17 @@ FPSection(t_param **ppr; arith *parmaddr;) { EnterParamList(ppr, FPList, tp, VARp, parmaddr); } ; -FormalType(t_type **ptp;) : - ARRAY OF qualtype(ptp) - { /* index type of conformant array is "CARDINAL". - Recognize a conformant array by size 0. - */ - register t_type *tp = construct_type(T_ARRAY, card_type); - - tp->arr_elem = *ptp; +FormalType(t_type **ptp;) + /* index type of conformant array is "CARDINAL". + Recognize a conformant array by size 0. + */ +{ register t_type *tp; +} : + ARRAY OF + { tp = construct_type(T_ARRAY, card_type); } + qualtype(&(tp->arr_elem)) + { ArrayElSize(tp); *ptp = tp; - ArrayElSize(tp); } | qualtype(ptp) @@ -206,7 +207,7 @@ SimpleType(register t_type **ptp;) : ] | enumeration(ptp) -| { *ptp = 0; } +| { *ptp = 0; /* no qualification */ } SubrangeType(ptp) ; @@ -252,10 +253,10 @@ SubrangeType(t_type **ptp;) ArrayType(t_type **ptp;) { t_type *tp; - register t_type *tp2; + register t_type *tp1, *tp2; } : ARRAY SimpleType(&tp) - { *ptp = tp2 = construct_type(T_ARRAY, tp); } + { tp1 = tp2 = construct_type(T_ARRAY, tp); } [ ',' SimpleType(&tp) { tp2->arr_elem = construct_type(T_ARRAY, tp); @@ -263,7 +264,8 @@ ArrayType(t_type **ptp;) } ]* OF type(&tp) { tp2->arr_elem = tp; - ArraySizes(*ptp); + ArraySizes(tp1); + *ptp = tp1; } ; @@ -437,23 +439,28 @@ CaseLabels(t_type **ptp; register t_node **pnd;) } ; -SetType(t_type **ptp;) : - SET OF SimpleType(ptp) - { *ptp = set_type(*ptp); } +SetType(t_type **ptp;) +{ t_type *tp; +} : + SET OF SimpleType(&tp) + { *ptp = set_type(tp); } ; /* In a pointer type definition, the type pointed at does not have to be declared yet, so be careful about identifying - type-identifiers + type-identifiers. */ -PointerType(register t_type **ptp;) : - { *ptp = construct_type(T_POINTER, NULLTYPE); } +PointerType(register t_type **ptp;) +{ register t_type *tp; +} : + { tp = construct_type(T_POINTER, NULLTYPE); } POINTER TO - [ %if (type_or_forward(ptp)) - type(&((*ptp)->tp_next)) + [ %if (type_or_forward(tp)) + type(&(tp->tp_next)) | IDENT ] + { *ptp = tp; } ; qualtype(t_type **ptp;) @@ -464,46 +471,43 @@ qualtype(t_type **ptp;) { *ptp = qualified_type(nd); } ; -ProcedureType(t_type **ptp;) : +ProcedureType(t_type **ptp;) +{ + t_param *pr = 0; + arith parmaddr = 0; + t_type *tp = 0; +} : PROCEDURE [ - FormalTypeList(ptp) + FormalTypeList(&pr, &parmaddr, &tp) | - { *ptp = proc_type((t_type *) 0, - (t_param *) 0, - (arith) 0); - } ] + { *ptp = proc_type(tp, pr, parmaddr); } ; -FormalTypeList(t_type **ptp;) -{ - t_param *pr = 0; - arith parmaddr = 0; -} : +FormalTypeList(t_param **ppr; arith *pparmaddr; t_type **ptp;) : '(' [ - VarFormalType(&pr, &parmaddr) + VarFormalType(ppr, pparmaddr) [ - ',' VarFormalType(&pr, &parmaddr) + ',' VarFormalType(ppr, pparmaddr) ]* | ] ')' [ ':' qualtype(ptp) - | { *ptp = 0; } + | ] - { *ptp = proc_type(*ptp, pr, parmaddr); } ; -VarFormalType(t_param **ppr; arith *parmaddr;) +VarFormalType(t_param **ppr; arith *pparmaddr;) { t_type *tp; int isvar; } : var(&isvar) FormalType(&tp) - { EnterParamList(ppr,NULLNODE,tp,isvar,parmaddr); } + { EnterParamList(ppr,NULLNODE,tp,isvar,pparmaddr); } ; var(int *VARp;) : -- 2.34.1