int indirection(oprtype *a) { char c; oprtype *sb1, *sb2, subs[MAX_INDSUBSCRIPTS], x; triple *next, *ref; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; assert(TK_ATSIGN == TREF(window_token)); if (!(TREF(expr_depth))++) TREF(expr_start) = TREF(expr_start_orig) = NULL; advancewindow(); if (!expratom(a)) { TREF(expr_depth) = 0; return FALSE; } coerce(a, OCT_MVAL); ex_tail(a); if (!(--(TREF(expr_depth)))) TREF(shift_side_effects) = FALSE; TREF(saw_side_effect) = TREF(shift_side_effects); /* TRUE or FALSE, at this point they're the same */ if (TK_ATSIGN == TREF(window_token)) { advancewindow(); if (TK_LPAREN != TREF(window_token)) { stx_error(ERR_LPARENMISSING); return FALSE; } ref = maketriple(OC_INDNAME); sb1 = sb2 = subs; for (;;) { if (ARRAYTOP(subs) <= sb1) { stx_error(ERR_MAXNRSUBSCRIPTS); return FALSE; } advancewindow(); if (EXPR_FAIL == expr(sb1++, MUMPS_EXPR)) return FALSE; if (TK_RPAREN == (c = TREF(window_token))) /* NOTE assignment */ { advancewindow(); break; } if (TK_COMMA != c) { stx_error(ERR_RPARENMISSING); return FALSE; } } /* store argument count...n args plus the name plus the dst*/ ref->operand[0] = put_ilit((mint)(sb1 - sb2) + 2); ins_triple(ref); next = newtriple(OC_PARAMETER); next->operand[0] = *a; ref->operand[1] = put_tref(next); *a = put_tref(ref); while (sb2 < sb1) { ref = newtriple(OC_PARAMETER); next->operand[1] = put_tref(ref); ref->operand[0] = *sb2++; next = ref; } } return TRUE; }
int gvn(void) { triple *ref, *t1, *oldchain, tmpchain, *triptr, *s; oprtype subscripts[MAX_GVSUBSCRIPTS], *sb1, *sb2; boolean_t shifting, vbar, parse_status; opctype ox; char x; error_def(ERR_MAXNRSUBSCRIPTS); error_def(ERR_RPARENMISSING); error_def(ERR_GBLNAME); error_def(ERR_EXTGBLDEL); error_def(ERR_GVNAKEDEXTNM); error_def(ERR_EXPR); DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; assert(window_token == TK_CIRCUMFLEX); advancewindow(); sb1 = sb2 = subscripts; ox = 0; if (shifting = TREF(shift_side_effects)) { dqinit(&tmpchain, exorder); oldchain = setcurtchain(&tmpchain); } if (window_token == TK_LBRACKET || window_token == TK_VBAR) { vbar = (window_token == TK_VBAR); advancewindow(); if (vbar) parse_status = expr(sb1++); else parse_status = expratom(sb1++); if (!parse_status) { stx_error(ERR_EXPR); if (shifting) setcurtchain(oldchain); return FALSE; } if (window_token == TK_COMMA) { advancewindow(); if (vbar) parse_status = expr(sb1++); else parse_status = expratom(sb1++); if (!parse_status) { stx_error(ERR_EXPR); if (shifting) setcurtchain(oldchain); return FALSE; } } else *sb1++ = put_str(0,0); if ((!vbar && window_token != TK_RBRACKET) || (vbar && window_token != TK_VBAR)) { stx_error(ERR_EXTGBLDEL); if (shifting) setcurtchain(oldchain); return FALSE; } advancewindow(); ox = OC_GVEXTNAM; } if (window_token == TK_IDENT) { if (!ox) ox = OC_GVNAME; *sb1++ = put_str(window_ident.addr, window_ident.len); advancewindow(); } else { if (ox) { stx_error(ERR_GVNAKEDEXTNM); if (shifting) setcurtchain(oldchain); return FALSE; } if (window_token != TK_LPAREN) { stx_error(ERR_GBLNAME); if (shifting) setcurtchain(oldchain); return FALSE; } ox = OC_GVNAKED; } if (window_token == TK_LPAREN) for (;;) { if (sb1 >= ARRAYTOP(subscripts)) { stx_error(ERR_MAXNRSUBSCRIPTS); if (shifting) setcurtchain(oldchain); return FALSE; } advancewindow(); if (!expr(sb1)) { if (shifting) setcurtchain(oldchain); return FALSE; } assert(sb1->oprclass == TRIP_REF); s = sb1->oprval.tref; if (s->opcode == OC_LIT) *sb1 = make_gvsubsc(&s->operand[0].oprval.mlit->v); sb1++; if ((x = window_token) == TK_RPAREN) { advancewindow(); break; } if (x != TK_COMMA) { stx_error(ERR_RPARENMISSING); if (shifting) setcurtchain(oldchain); return FALSE; } } ref = newtriple(ox); ref->operand[0] = put_ilit((mint)(sb1 - sb2)); for ( ; sb2 < sb1 ; sb2++) { t1 = newtriple(OC_PARAMETER); ref->operand[1] = put_tref(t1); ref = t1; ref->operand[0] = *sb2; } if (shifting) { newtriple(OC_GVSAVTARG); setcurtchain(oldchain); dqadd(TREF(expr_start), &tmpchain, exorder); TREF(expr_start) = tmpchain.exorder.bl; triptr = newtriple(OC_GVRECTARG); triptr->operand[0] = put_tref(TREF(expr_start)); } return TRUE; }