#
source:
trunk/third/enscript/states/utils.c
@
17620

Revision 17620, 24.8 KB checked in by ghudson, 22 years ago (diff) |
---|

Line | |
---|---|

1 | /* |

2 | * General helper utilities. |

3 | * Copyright (c) 1997 Markku Rossi. |

4 | * |

5 | * Author: Markku Rossi <mtr@iki.fi> |

6 | */ |

7 | |

8 | /* |

9 | * This file is part of GNU enscript. |

10 | * |

11 | * This program is free software; you can redistribute it and/or modify |

12 | * it under the terms of the GNU General Public License as published by |

13 | * the Free Software Foundation; either version 2, or (at your option) |

14 | * any later version. |

15 | * |

16 | * This program is distributed in the hope that it will be useful, |

17 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |

18 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |

19 | * GNU General Public License for more details. |

20 | * |

21 | * You should have received a copy of the GNU General Public License |

22 | * along with this program; see the file COPYING. If not, write to |

23 | * the Free Software Foundation, 59 Temple Place - Suite 330, |

24 | * Boston, MA 02111-1307, USA. |

25 | */ |

26 | |

27 | #include "defs.h" |

28 | |

29 | /* |

30 | * Static variables. |

31 | */ |

32 | |

33 | static RE_TRANSLATE_TYPE case_insensitive_translate = NULL; |

34 | |

35 | |

36 | /* |

37 | * Global functions. |

38 | */ |

39 | |

40 | /* Generic linked list. */ |

41 | |

42 | List * |

43 | list () |

44 | { |

45 | return (List *) xcalloc (1, sizeof (List)); |

46 | } |

47 | |

48 | |

49 | void |

50 | list_prepend (list, data) |

51 | List *list; |

52 | void *data; |

53 | { |

54 | ListItem *item; |

55 | |

56 | item = (ListItem *) xmalloc (sizeof (*item)); |

57 | item->data = data; |

58 | |

59 | item->next = list->head; |

60 | list->head = item; |

61 | |

62 | if (list->tail == NULL) |

63 | list->tail = item; |

64 | } |

65 | |

66 | |

67 | void |

68 | list_append (list, data) |

69 | List *list; |

70 | void *data; |

71 | { |

72 | ListItem *item; |

73 | |

74 | item = (ListItem *) xcalloc (1, sizeof (*item)); |

75 | item->data = data; |

76 | |

77 | if (list->tail) |

78 | list->tail->next = item; |

79 | else |

80 | list->head = item; |

81 | list->tail = item; |

82 | } |

83 | |

84 | /* |

85 | * Node manipulators. |

86 | */ |

87 | |

88 | Node * |

89 | node_alloc (type) |

90 | NodeType type; |

91 | { |

92 | Node *n; |

93 | |

94 | n = (Node *) xcalloc (1, sizeof (*n)); |

95 | n->type = type; |

96 | n->refcount = 1; |

97 | n->linenum = linenum; |

98 | |

99 | if (type == nREGEXP) |

100 | n->u.re.compiled.fastmap = xmalloc (256); |

101 | |

102 | return n; |

103 | } |

104 | |

105 | |

106 | Node * |

107 | node_copy (n) |

108 | Node *n; |

109 | { |

110 | Node *n2; |

111 | int i; |

112 | |

113 | n2 = node_alloc (n->type); |

114 | n2->linenum = n->linenum; |

115 | |

116 | switch (n->type) |

117 | { |

118 | case nVOID: |

119 | /* All done. */ |

120 | break; |

121 | |

122 | case nSTRING: |

123 | n2->u.str.len = n->u.str.len; |

124 | /* +1 to avoid zero allocation. */ |

125 | n2->u.str.data = (char *) xmalloc (n2->u.str.len + 1); |

126 | memcpy (n2->u.str.data, n->u.str.data, n->u.str.len); |

127 | break; |

128 | |

129 | case nREGEXP: |

130 | n2->u.re.data = xstrdup (n->u.re.data); |

131 | n2->u.re.len = n->u.re.len; |

132 | break; |

133 | |

134 | case nINTEGER: |

135 | n2->u.integer = n->u.integer; |

136 | break; |

137 | |

138 | case nREAL: |

139 | n2->u.real = n->u.real; |

140 | break; |

141 | |

142 | case nSYMBOL: |

143 | n2->u.sym = xstrdup (n->u.sym); |

144 | break; |

145 | |

146 | case nARRAY: |

147 | n2->u.array.len = n->u.array.len; |

148 | n2->u.array.allocated = n2->u.array.len + 1; |

149 | n2->u.array.array = (Node **) xcalloc (n2->u.array.allocated, |

150 | sizeof (Node *)); |

151 | for (i = 0; i < n->u.array.len; i++) |

152 | n2->u.array.array[i] = node_copy (n->u.array.array[i]); |

153 | break; |

154 | } |

155 | |

156 | return n2; |

157 | } |

158 | |

159 | |

160 | void |

161 | node_reference (node) |

162 | Node *node; |

163 | { |

164 | node->refcount++; |

165 | } |

166 | |

167 | |

168 | void |

169 | node_free (node) |

170 | Node *node; |

171 | { |

172 | unsigned int i; |

173 | |

174 | if (node == NULL) |

175 | return; |

176 | |

177 | if (--node->refcount > 0) |

178 | return; |

179 | |

180 | /* This was the last reference, free the node. */ |

181 | switch (node->type) |

182 | { |

183 | case nVOID: |

184 | /* There is only nVOID node, do not free it. */ |

185 | return; |

186 | break; |

187 | |

188 | case nSTRING: |

189 | xfree (node->u.str.data); |

190 | break; |

191 | |

192 | case nREGEXP: |

193 | free (node->u.re.data); |

194 | xfree (node->u.re.compiled.fastmap); |

195 | break; |

196 | |

197 | case nINTEGER: |

198 | case nREAL: |

199 | case nSYMBOL: |

200 | /* Nothing here. */ |

201 | break; |

202 | |

203 | case nARRAY: |

204 | for (i = 0; i < node->u.array.len; i++) |

205 | node_free (node->u.array.array[i]); |

206 | |

207 | xfree (node->u.array.array); |

208 | break; |

209 | } |

210 | |

211 | xfree (node); |

212 | } |

213 | |

214 | |

215 | void |

216 | enter_system_variable (name, value) |

217 | char *name; |

218 | char *value; |

219 | { |

220 | Node *n, *old_val; |

221 | |

222 | n = node_alloc (nSTRING); |

223 | n->u.str.len = strlen (value); |

224 | n->u.str.data = xstrdup (value); |

225 | if (!strhash_put (ns_vars, name, strlen (name), n, (void **) &old_val)) |

226 | { |

227 | fprintf (stderr, _("%s: out of memory\n"), program); |

228 | exit (1); |

229 | } |

230 | node_free (old_val); |

231 | } |

232 | |

233 | |

234 | void |

235 | compile_regexp (re) |

236 | Node *re; |

237 | { |

238 | const char *msg; |

239 | |

240 | if (case_insensitive_translate == NULL) |

241 | { |

242 | int i; |

243 | |

244 | case_insensitive_translate = xmalloc (256); |

245 | |

246 | for (i = 0; i < 256; i++) |

247 | if (isupper (i)) |

248 | case_insensitive_translate[i] = tolower (i); |

249 | else |

250 | case_insensitive_translate[i] = i; |

251 | } |

252 | |

253 | if (re->u.re.flags & fRE_CASE_INSENSITIVE) |

254 | re->u.re.compiled.translate = case_insensitive_translate; |

255 | |

256 | msg = re_compile_pattern (re->u.re.data, re->u.re.len, &re->u.re.compiled); |

257 | if (msg) |

258 | { |

259 | fprintf (stderr, |

260 | _("%s:%d: couldn't compile regular expression \"%s\": %s\n"), |

261 | defs_file, re->linenum, re->u.re.data, msg); |

262 | exit (1); |

263 | } |

264 | |

265 | re_compile_fastmap (&re->u.re.compiled); |

266 | } |

267 | |

268 | |

269 | /* |

270 | * Grammar constructors. |

271 | */ |

272 | |

273 | Stmt * |

274 | mk_stmt (type, arg1, arg2, arg3, arg4) |

275 | StmtType type; |

276 | void *arg1; |

277 | void *arg2; |

278 | void *arg3; |

279 | void *arg4; |

280 | { |

281 | Stmt *stmt; |

282 | |

283 | stmt = (Stmt *) xcalloc (1, sizeof (*stmt)); |

284 | stmt->type = type; |

285 | stmt->linenum = linenum; |

286 | |

287 | switch (type) |

288 | { |

289 | case sEXPR: |

290 | case sRETURN: |

291 | stmt->u.expr = arg1; |

292 | break; |

293 | |

294 | case sDEFSUB: |

295 | stmt->u.defsub.name = arg1; |

296 | stmt->u.defsub.closure = arg2; |

297 | break; |

298 | |

299 | case sBLOCK: |

300 | stmt->u.block = arg1; /* Statement list. */ |

301 | break; |

302 | |

303 | case sIF: |

304 | stmt->u.stmt_if.expr = arg1; |

305 | stmt->u.stmt_if.then_stmt = arg2; |

306 | stmt->u.stmt_if.else_stmt = arg3; |

307 | break; |

308 | |

309 | case sWHILE: |

310 | stmt->u.stmt_while.expr = arg1; |

311 | stmt->u.stmt_while.body = arg2; |

312 | break; |

313 | |

314 | case sFOR: |

315 | stmt->u.stmt_for.init = arg1; |

316 | stmt->u.stmt_for.cond = arg2; |

317 | stmt->u.stmt_for.incr = arg3; |

318 | stmt->u.stmt_for.body = arg4; |

319 | break; |

320 | } |

321 | |

322 | return stmt; |

323 | } |

324 | |

325 | |

326 | Expr * |

327 | mk_expr (type, arg1, arg2, arg3) |

328 | ExprType type; |

329 | void *arg1; |

330 | void *arg2; |

331 | void *arg3; |

332 | { |

333 | Expr *expr; |

334 | |

335 | expr = (Expr *) xcalloc (1, sizeof (*expr)); |

336 | expr->type = type; |

337 | expr->linenum = linenum; |

338 | |

339 | switch (type) |

340 | { |

341 | case eSTRING: |

342 | case eREGEXP: |

343 | case eINTEGER: |

344 | case eREAL: |

345 | case eSYMBOL: |

346 | expr->u.node = arg1; |

347 | break; |

348 | |

349 | case eNOT: |

350 | expr->u.not = arg1; |

351 | break; |

352 | |

353 | case eFCALL: |

354 | expr->u.fcall.name = arg1; |

355 | expr->u.fcall.args = arg2; |

356 | break; |

357 | |

358 | case eASSIGN: |

359 | case eADDASSIGN: |

360 | case eSUBASSIGN: |

361 | case eMULASSIGN: |

362 | case eDIVASSIGN: |

363 | expr->u.assign.sym = arg1; |

364 | expr->u.assign.expr = arg2; |

365 | break; |

366 | |

367 | case ePOSTFIXADD: |

368 | case ePOSTFIXSUB: |

369 | case ePREFIXADD: |

370 | case ePREFIXSUB: |

371 | expr->u.node = arg1; |

372 | break; |

373 | |

374 | case eARRAYASSIGN: |

375 | expr->u.arrayassign.expr1 = arg1; |

376 | expr->u.arrayassign.expr2 = arg2; |

377 | expr->u.arrayassign.expr3 = arg3; |

378 | break; |

379 | |

380 | case eARRAYREF: |

381 | expr->u.arrayref.expr1 = arg1; |

382 | expr->u.arrayref.expr2 = arg2; |

383 | break; |

384 | |

385 | case eQUESTCOLON: |

386 | expr->u.questcolon.cond = arg1; |

387 | expr->u.questcolon.expr1 = arg2; |

388 | expr->u.questcolon.expr2 = arg3; |

389 | break; |

390 | |

391 | case eMULT: |

392 | case eDIV: |

393 | case ePLUS: |

394 | case eMINUS: |

395 | case eLT: |

396 | case eGT: |

397 | case eEQ: |

398 | case eNE: |

399 | case eGE: |

400 | case eLE: |

401 | case eAND: |

402 | case eOR: |

403 | expr->u.op.left = arg1; |

404 | expr->u.op.right = arg2; |

405 | break; |

406 | } |

407 | |

408 | return expr; |

409 | } |

410 | |

411 | |

412 | Cons * |

413 | cons (car, cdr) |

414 | void *car; |

415 | void *cdr; |

416 | { |

417 | Cons *c; |

418 | |

419 | c = (Cons *) xmalloc (sizeof (*c)); |

420 | c->car = car; |

421 | c->cdr = cdr; |

422 | |

423 | return c; |

424 | } |

425 | |

426 | |

427 | void |

428 | define_state (sym, rules) |

429 | Node *sym; |

430 | List *rules; |

431 | { |

432 | void *old_rules; |

433 | char msg[512]; |

434 | |

435 | if (!strhash_put (ns_states, sym->u.sym, strlen (sym->u.sym), rules, |

436 | &old_rules)) |

437 | { |

438 | fprintf (stderr, _("%s: ouf of memory"), program); |

439 | exit (1); |

440 | } |

441 | if (old_rules) |

442 | { |

443 | sprintf (msg, _("warning: redefining state `%s'"), sym->u.sym); |

444 | yyerror (msg); |

445 | } |

446 | } |

447 | |

448 | |

449 | /* |

450 | * Expression evaluation. |

451 | */ |

452 | |

453 | static void |

454 | define_sub (sym, args_body, linenum) |

455 | Node *sym; |

456 | Cons *args_body; |

457 | unsigned int linenum; |

458 | { |

459 | void *old_data; |

460 | |

461 | if (!strhash_put (ns_subs, sym->u.sym, strlen (sym->u.sym), args_body, |

462 | &old_data)) |

463 | { |

464 | fprintf (stderr, _("%s: ouf of memory"), program); |

465 | exit (1); |

466 | } |

467 | if (old_data && warning_level >= WARN_ALL) |

468 | fprintf (stderr, _("%s:%d: warning: redefining subroutine `%s'\n"), |

469 | defs_file, linenum, sym->u.sym); |

470 | } |

471 | |

472 | extern unsigned int current_linenum; |

473 | |

474 | static Node * |

475 | lookup_var (env, ns, sym, linenum) |

476 | Environment *env; |

477 | StringHashPtr ns; |

478 | Node *sym; |

479 | unsigned int linenum; |

480 | { |

481 | Node *n; |

482 | Environment *e; |

483 | |

484 | /* Special variables. */ |

485 | if (sym->u.sym[0] == '$' && sym->u.sym[1] && sym->u.sym[2] == '\0') |

486 | { |

487 | /* Regexp sub expression reference. */ |

488 | if (sym->u.sym[1] >= '0' && sym->u.sym[1] <= '9') |

489 | { |

490 | int i; |

491 | int len; |

492 | |

493 | /* Matched text. */ |

494 | i = sym->u.sym[1] - '0'; |

495 | |

496 | n = node_alloc (nSTRING); |

497 | if (current_match == NULL || current_match->start[i] < 0 |

498 | || current_match_buf == NULL) |

499 | { |

500 | n->u.str.data = (char *) xmalloc (1); |

501 | n->u.str.len = 0; |

502 | } |

503 | else |

504 | { |

505 | len = current_match->end[i] - current_match->start[i]; |

506 | n->u.str.data = (char *) xmalloc (len + 1); |

507 | memcpy (n->u.str.data, |

508 | current_match_buf + current_match->start[i], len); |

509 | n->u.str.len = len; |

510 | } |

511 | |

512 | return n; |

513 | } |

514 | |

515 | /* Everything before the matched expression. */ |

516 | if (sym->u.sym[1] == '`' || sym->u.sym[1] == 'B') |

517 | { |

518 | n = node_alloc (nSTRING); |

519 | if (current_match == NULL || current_match->start[0] < 0 |

520 | || current_match_buf == NULL) |

521 | { |

522 | n->u.str.data = (char *) xmalloc (1); |

523 | n->u.str.len = 0; |

524 | } |

525 | else |

526 | { |

527 | n->u.str.len = current_match->start[0]; |

528 | n->u.str.data = (char *) xmalloc (n->u.str.len + 1); |

529 | memcpy (n->u.str.data, current_match_buf, n->u.str.len); |

530 | } |

531 | |

532 | return n; |

533 | } |

534 | |

535 | /* Current input line number. */ |

536 | if (sym->u.sym[1] == '.') |

537 | { |

538 | n = node_alloc (nINTEGER); |

539 | n->u.integer = current_linenum; |

540 | return n; |

541 | } |

542 | } |

543 | |

544 | /* Local variables. */ |

545 | for (e = env; e; e = e->next) |

546 | if (strcmp (e->name, sym->u.sym) == 0) |

547 | return e->val; |

548 | |

549 | /* Global variables. */ |

550 | if (strhash_get (ns, sym->u.sym, strlen (sym->u.sym), (void **) &n)) |

551 | return n; |

552 | |

553 | /* Undefined variable. */ |

554 | fprintf (stderr, _("%s:%d: error: undefined variable `%s'\n"), |

555 | defs_file, linenum, sym->u.sym); |

556 | exit (1); |

557 | |

558 | /* NOTREACHED */ |

559 | return NULL; |

560 | } |

561 | |

562 | |

563 | static void |

564 | set_var (env, ns, sym, val, linenum) |

565 | Environment *env; |

566 | StringHashPtr ns; |

567 | Node *sym; |

568 | Node *val; |

569 | unsigned int linenum; |

570 | { |

571 | Node *n; |

572 | Environment *e; |

573 | |

574 | /* Local variables. */ |

575 | for (e = env; e; e = e->next) |

576 | if (strcmp (e->name, sym->u.sym) == 0) |

577 | { |

578 | node_free (e->val); |

579 | e->val = val; |

580 | return; |

581 | } |

582 | |

583 | /* Global variables. */ |

584 | if (strhash_put (ns, sym->u.sym, strlen (sym->u.sym), val, (void **) &n)) |

585 | { |

586 | node_free (n); |

587 | return; |

588 | } |

589 | |

590 | /* Couldn't set value for variable. */ |

591 | fprintf (stderr, _("%s:%d: error: couldn't set variable `%s'\n"), |

592 | defs_file, linenum, sym->u.sym); |

593 | exit (1); |

594 | /* NOTREACHED */ |

595 | } |

596 | |

597 | |

598 | static Node * |

599 | calculate_binary (l, r, type, linenum) |

600 | Node *l; |

601 | Node *r; |

602 | ExprType type; |

603 | unsigned int linenum; |

604 | { |

605 | Node *n = NULL; |

606 | |

607 | switch (type) |

608 | { |

609 | case eMULT: |

610 | case eDIV: |

611 | case ePLUS: |

612 | case eMINUS: |

613 | case eLT: |

614 | case eGT: |

615 | case eEQ: |

616 | case eNE: |

617 | case eGE: |

618 | case eLE: |

619 | if (l->type == r->type && l->type == nINTEGER) |

620 | { |

621 | n = node_alloc (nINTEGER); |

622 | switch (type) |

623 | { |

624 | case eMULT: |

625 | n->u.integer = (l->u.integer * r->u.integer); |

626 | break; |

627 | |

628 | case eDIV: |

629 | n->u.integer = (l->u.integer / r->u.integer); |

630 | break; |

631 | |

632 | case ePLUS: |

633 | n->u.integer = (l->u.integer + r->u.integer); |

634 | break; |

635 | |

636 | case eMINUS: |

637 | n->u.integer = (l->u.integer - r->u.integer); |

638 | break; |

639 | |

640 | case eLT: |

641 | n->u.integer = (l->u.integer < r->u.integer); |

642 | break; |

643 | |

644 | case eGT: |

645 | n->u.integer = (l->u.integer > r->u.integer); |

646 | break; |

647 | |

648 | case eEQ: |

649 | n->u.integer = (l->u.integer == r->u.integer); |

650 | break; |

651 | |

652 | case eNE: |

653 | n->u.integer = (l->u.integer != r->u.integer); |

654 | break; |

655 | |

656 | case eGE: |

657 | n->u.integer = (l->u.integer >= r->u.integer); |

658 | break; |

659 | |

660 | case eLE: |

661 | n->u.integer = (l->u.integer <= r->u.integer); |

662 | break; |

663 | |

664 | default: |

665 | /* NOTREACHED */ |

666 | break; |

667 | } |

668 | } |

669 | else if ((l->type == nINTEGER || l->type == nREAL) |

670 | && (r->type == nINTEGER || r->type == nREAL)) |

671 | { |

672 | double dl, dr; |

673 | |

674 | if (l->type == nINTEGER) |

675 | dl = (double) l->u.integer; |

676 | else |

677 | dl = l->u.real; |

678 | |

679 | if (r->type == nINTEGER) |

680 | dr = (double) r->u.integer; |

681 | else |

682 | dr = r->u.real; |

683 | |

684 | n = node_alloc (nREAL); |

685 | switch (type) |

686 | { |

687 | case eMULT: |

688 | n->u.real = (dl * dr); |

689 | break; |

690 | |

691 | case eDIV: |

692 | n->u.real = (dl / dr); |

693 | break; |

694 | |

695 | case ePLUS: |

696 | n->u.real = (dl + dr); |

697 | break; |

698 | |

699 | case eMINUS: |

700 | n->u.real = (dl - dr); |

701 | break; |

702 | |

703 | case eLT: |

704 | n->type = nINTEGER; |

705 | n->u.integer = (dl < dr); |

706 | break; |

707 | |

708 | case eGT: |

709 | n->type = nINTEGER; |

710 | n->u.integer = (dl > dr); |

711 | break; |

712 | |

713 | case eEQ: |

714 | n->type = nINTEGER; |

715 | n->u.integer = (dl == dr); |

716 | break; |

717 | |

718 | case eNE: |

719 | n->type = nINTEGER; |

720 | n->u.integer = (dl != dr); |

721 | break; |

722 | |

723 | case eGE: |

724 | n->type = nINTEGER; |

725 | n->u.integer = (dl >= dr); |

726 | break; |

727 | |

728 | case eLE: |

729 | n->type = nINTEGER; |

730 | n->u.integer = (dl <= dr); |

731 | break; |

732 | |

733 | default: |

734 | /* NOTREACHED */ |

735 | break; |

736 | } |

737 | } |

738 | else |

739 | { |

740 | fprintf (stderr, |

741 | _("%s:%d: error: expression between illegal types\n"), |

742 | defs_file, linenum); |

743 | exit (1); |

744 | } |

745 | break; |

746 | |

747 | default: |

748 | /* This is definitely a bug. */ |

749 | abort (); |

750 | break; |

751 | } |

752 | |

753 | return n; |

754 | } |

755 | |

756 | |

757 | Node * |

758 | eval_expr (expr, env) |

759 | Expr *expr; |

760 | Environment *env; |

761 | { |

762 | Node *n = nvoid; |

763 | Node *n2; |

764 | Node *l, *r; |

765 | Cons *c; |

766 | Primitive prim; |

767 | int return_seen; |

768 | Environment *ei, *ei2; |

769 | int i; |

770 | Node sn; |

771 | |

772 | if (expr == NULL) |

773 | return nvoid; |

774 | |

775 | switch (expr->type) |

776 | { |

777 | case eSTRING: |

778 | case eREGEXP: |

779 | case eINTEGER: |

780 | case eREAL: |

781 | node_reference (expr->u.node); |

782 | return expr->u.node; |

783 | break; |

784 | |

785 | case eSYMBOL: |

786 | n = lookup_var (env, ns_vars, expr->u.node, expr->linenum); |

787 | node_reference (n); |

788 | return n; |

789 | break; |

790 | |

791 | case eNOT: |

792 | n = eval_expr (expr->u.not, env); |

793 | i = !IS_TRUE (n); |

794 | node_free (n); |

795 | |

796 | n = node_alloc (nINTEGER); |

797 | n->u.integer = i; |

798 | return n; |

799 | break; |

800 | |

801 | case eFCALL: |

802 | n = expr->u.fcall.name; |

803 | /* User-defined subroutine? */ |

804 | if (strhash_get (ns_subs, n->u.sym, strlen (n->u.sym), |

805 | (void **) &c)) |

806 | { |

807 | Environment *nenv = NULL; |

808 | ListItem *i, *e; |

809 | List *stmts; |

810 | List *lst; |

811 | Cons *args_locals; |

812 | |

813 | /* Found it, now bind arguments. */ |

814 | args_locals = (Cons *) c->car; |

815 | stmts = (List *) c->cdr; |

816 | |

817 | lst = (List *) args_locals->car; |

818 | |

819 | for (i = lst->head, e = expr->u.fcall.args->head; i && e; |

820 | i = i->next, e = e->next) |

821 | { |

822 | Node *sym; |

823 | |

824 | sym = (Node *) i->data; |

825 | |

826 | n = eval_expr ((Expr *) e->data, env); |

827 | |

828 | ei = (Environment *) xcalloc (1, sizeof (*ei)); |

829 | ei->name = sym->u.sym; |

830 | ei->val = n; |

831 | ei->next = nenv; |

832 | nenv = ei; |

833 | } |

834 | /* Check that we had correct amount of arguments. */ |

835 | if (i) |

836 | { |

837 | fprintf (stderr, _("%s: too few arguments for subroutine\n"), |

838 | program); |

839 | exit (1); |

840 | } |

841 | if (e) |

842 | { |

843 | fprintf (stderr, _("%s: too many arguments for subroutine\n"), |

844 | program); |

845 | exit (1); |

846 | } |

847 | |

848 | /* Enter local variables. */ |

849 | lst = (List *) args_locals->cdr; |

850 | for (i = lst->head; i; i = i->next) |

851 | { |

852 | Cons *c; |

853 | Node *sym; |

854 | Expr *init; |

855 | |

856 | c = (Cons *) i->data; |

857 | sym = (Node *) c->car; |

858 | init = (Expr *) c->cdr; |

859 | |

860 | ei = (Environment *) xcalloc (1, sizeof (*ei)); |

861 | ei->name = sym->u.sym; |

862 | |

863 | if (init) |

864 | ei->val = eval_expr (init, nenv); |

865 | else |

866 | ei->val = nvoid; |

867 | |

868 | ei->next = nenv; |

869 | nenv = ei; |

870 | } |

871 | |

872 | /* Eval statement list. */ |

873 | return_seen = 0; |

874 | n = eval_statement_list ((List *) c->cdr, nenv, &return_seen); |

875 | |

876 | /* Cleanup env. */ |

877 | for (ei = nenv; ei; ei = ei2) |

878 | { |

879 | ei2 = ei->next; |

880 | node_free (ei->val); |

881 | xfree (ei); |

882 | } |

883 | |

884 | return n; |

885 | } |

886 | /* Primitives. */ |

887 | else if (strhash_get (ns_prims, n->u.sym, strlen (n->u.sym), |

888 | (void **) &prim)) |

889 | { |

890 | n = (*prim) (n->u.sym, expr->u.fcall.args, env, expr->linenum); |

891 | return n; |

892 | } |

893 | else |

894 | { |

895 | fprintf (stderr, _("%s: undefined procedure `%s'\n"), |

896 | program, n->u.sym); |

897 | exit (1); |

898 | } |

899 | break; |

900 | |

901 | case eASSIGN: |

902 | n = eval_expr (expr->u.assign.expr, env); |

903 | set_var (env, ns_vars, expr->u.assign.sym, n, expr->linenum); |

904 | |

905 | node_reference (n); |

906 | return n; |

907 | break; |

908 | |

909 | case eADDASSIGN: |

910 | case eSUBASSIGN: |

911 | case eMULASSIGN: |

912 | case eDIVASSIGN: |

913 | n = eval_expr (expr->u.assign.expr, env); |

914 | n2 = lookup_var (env, ns_vars, expr->u.assign.sym, expr->linenum); |

915 | |

916 | switch (expr->type) |

917 | { |

918 | case eADDASSIGN: |

919 | n2 = calculate_binary (n2, n, ePLUS, expr->linenum); |

920 | break; |

921 | |

922 | case eSUBASSIGN: |

923 | n2 = calculate_binary (n2, n, eMINUS, expr->linenum); |

924 | break; |

925 | |

926 | case eMULASSIGN: |

927 | n2 = calculate_binary (n2, n, eMULT, expr->linenum); |

928 | break; |

929 | |

930 | case eDIVASSIGN: |

931 | n2 = calculate_binary (n2, n, eDIV, expr->linenum); |

932 | break; |

933 | |

934 | default: |

935 | /* NOTREACHED */ |

936 | abort (); |

937 | break; |

938 | } |

939 | set_var (env, ns_vars, expr->u.assign.sym, n2, expr->linenum); |

940 | |

941 | node_free (n); |

942 | node_reference (n2); |

943 | return n2; |

944 | break; |

945 | |

946 | case ePOSTFIXADD: |

947 | case ePOSTFIXSUB: |

948 | sn.type = nINTEGER; |

949 | sn.u.integer = 1; |

950 | |

951 | n2 = lookup_var (env, ns_vars, expr->u.node, expr->linenum); |

952 | node_reference (n2); |

953 | |

954 | n = calculate_binary (n2, &sn, |

955 | expr->type == ePOSTFIXADD ? ePLUS : eMINUS, |

956 | expr->linenum); |

957 | set_var (env, ns_vars, expr->u.node, n, expr->linenum); |

958 | |

959 | return n2; |

960 | break; |

961 | |

962 | case ePREFIXADD: |

963 | case ePREFIXSUB: |

964 | sn.type = nINTEGER; |

965 | sn.u.integer = 1; |

966 | |

967 | n = lookup_var (env, ns_vars, expr->u.node, expr->linenum); |

968 | n = calculate_binary (n, &sn, |

969 | expr->type == ePREFIXADD ? ePLUS : eMINUS, |

970 | expr->linenum); |

971 | set_var (env, ns_vars, expr->u.node, n, expr->linenum); |

972 | |

973 | node_reference (n); |

974 | return n; |

975 | break; |

976 | |

977 | case eARRAYASSIGN: |

978 | n = eval_expr (expr->u.arrayassign.expr1, env); |

979 | if (n->type != nARRAY && n->type != nSTRING) |

980 | { |

981 | fprintf (stderr, |

982 | _("%s:%d: error: illegal lvalue for assignment\n"), |

983 | defs_file, expr->linenum); |

984 | exit (1); |

985 | } |

986 | n2 = eval_expr (expr->u.arrayassign.expr2, env); |

987 | if (n2->type != nINTEGER) |

988 | { |

989 | fprintf (stderr, |

990 | _("%s:%d: error: array reference index is not integer\n"), |

991 | defs_file, expr->linenum); |

992 | exit (1); |

993 | } |

994 | if (n2->u.integer < 0) |

995 | { |

996 | fprintf (stderr, _("%s:%d: error: negative array reference index\n"), |

997 | defs_file, expr->linenum); |

998 | exit (1); |

999 | } |

1000 | |

1001 | /* Do the assignment. */ |

1002 | if (n->type == nARRAY) |

1003 | { |

1004 | if (n2->u.integer >= n->u.array.len) |

1005 | { |

1006 | if (n2->u.integer >= n->u.array.allocated) |

1007 | { |

1008 | /* Allocate more space. */ |

1009 | n->u.array.allocated = n2->u.integer + 100; |

1010 | n->u.array.array = (Node **) xrealloc (n->u.array.array, |

1011 | n->u.array.allocated |

1012 | * sizeof (Node *)); |

1013 | } |

1014 | /* Fill the possible gap. */ |

1015 | for (i = n->u.array.len; i <= n2->u.integer; i++) |

1016 | n->u.array.array[i] = nvoid; |

1017 | |

1018 | /* Updated expanded array length. */ |

1019 | n->u.array.len = n2->u.integer + 1; |

1020 | } |

1021 | node_free (n->u.array.array[n2->u.integer]); |

1022 | |

1023 | l = eval_expr (expr->u.arrayassign.expr3, env); |

1024 | |

1025 | /* +1 for the return value. */ |

1026 | node_reference (l); |

1027 | |

1028 | n->u.array.array[n2->u.integer] = l; |

1029 | } |

1030 | else |

1031 | { |

1032 | if (n2->u.integer >= n->u.str.len) |

1033 | { |

1034 | i = n->u.str.len; |

1035 | n->u.str.len = n2->u.integer + 1; |

1036 | n->u.str.data = (char *) xrealloc (n->u.str.data, |

1037 | n->u.str.len); |

1038 | |

1039 | /* Init the expanded string with ' ' character. */ |

1040 | for (; i < n->u.str.len; i++) |

1041 | n->u.str.data[i] = ' '; |

1042 | } |

1043 | l = eval_expr (expr->u.arrayassign.expr3, env); |

1044 | if (l->type != nINTEGER) |

1045 | { |

1046 | fprintf (stderr, |

1047 | _("%s:%d: error: illegal rvalue for string assignment\n"), |

1048 | defs_file, expr->linenum); |

1049 | exit (1); |

1050 | } |

1051 | |

1052 | n->u.str.data[n2->u.integer] = l->u.integer; |

1053 | } |

1054 | |

1055 | node_free (n); |

1056 | node_free (n2); |

1057 | |

1058 | return l; |

1059 | break; |

1060 | |

1061 | case eARRAYREF: |

1062 | n = eval_expr (expr->u.arrayref.expr1, env); |

1063 | if (n->type != nARRAY && n->type != nSTRING) |

1064 | { |

1065 | fprintf (stderr, |

1066 | _("%s:%d: error: illegal type for array reference\n"), |

1067 | defs_file, expr->linenum); |

1068 | exit (1); |

1069 | } |

1070 | n2 = eval_expr (expr->u.arrayref.expr2, env); |

1071 | if (n2->type != nINTEGER) |

1072 | { |

1073 | fprintf (stderr, |

1074 | _("%s:%d: error: array reference index is not integer\n"), |

1075 | defs_file, expr->linenum); |

1076 | exit (1); |

1077 | } |

1078 | if (n2->u.integer < 0 |

1079 | || (n->type == nARRAY && n2->u.integer >= n->u.array.len) |

1080 | || (n->type == nSTRING && n2->u.integer >= n->u.str.len)) |

1081 | { |

1082 | fprintf (stderr, |

1083 | _("%s:%d: error: array reference index out of rance\n"), |

1084 | defs_file, expr->linenum); |

1085 | exit (1); |

1086 | } |

1087 | |

1088 | /* Do the reference. */ |

1089 | if (n->type == nARRAY) |

1090 | { |

1091 | l = n->u.array.array[n2->u.integer]; |

1092 | node_reference (l); |

1093 | } |

1094 | else |

1095 | { |

1096 | l = node_alloc (nINTEGER); |

1097 | l->u.integer |

1098 | = (int) ((unsigned char *) n->u.str.data)[n2->u.integer]; |

1099 | } |

1100 | node_free (n); |

1101 | node_free (n2); |

1102 | return l; |

1103 | break; |

1104 | |

1105 | case eQUESTCOLON: |

1106 | n = eval_expr (expr->u.questcolon.cond, env); |

1107 | i = IS_TRUE (n); |

1108 | node_free (n); |

1109 | |

1110 | if (i) |

1111 | n = eval_expr (expr->u.questcolon.expr1, env); |

1112 | else |

1113 | n = eval_expr (expr->u.questcolon.expr2, env); |

1114 | |

1115 | return n; |

1116 | break; |

1117 | |

1118 | case eAND: |

1119 | n = eval_expr (expr->u.op.left, env); |

1120 | if (!IS_TRUE (n)) |

1121 | return n; |

1122 | node_free (n); |

1123 | return eval_expr (expr->u.op.right, env); |

1124 | break; |

1125 | |

1126 | case eOR: |

1127 | n = eval_expr (expr->u.op.left, env); |

1128 | if (IS_TRUE (n)) |

1129 | return n; |

1130 | node_free (n); |

1131 | return eval_expr (expr->u.op.right, env); |

1132 | break; |

1133 | |

1134 | /* Arithmetics. */ |

1135 | case eMULT: |

1136 | case eDIV: |

1137 | case ePLUS: |

1138 | case eMINUS: |

1139 | case eLT: |

1140 | case eGT: |

1141 | case eEQ: |

1142 | case eNE: |

1143 | case eGE: |

1144 | case eLE: |

1145 | /* Eval sub-expressions. */ |

1146 | l = eval_expr (expr->u.op.left, env); |

1147 | r = eval_expr (expr->u.op.right, env); |

1148 | |

1149 | n = calculate_binary (l, r, expr->type, expr->linenum); |

1150 | |

1151 | node_free (l); |

1152 | node_free (r); |

1153 | return n; |

1154 | break; |

1155 | } |

1156 | |

1157 | /* NOTREACHED */ |

1158 | return n; |

1159 | } |

1160 | |

1161 | |

1162 | Node * |

1163 | eval_statement (stmt, env, return_seen) |

1164 | Stmt *stmt; |

1165 | Environment *env; |

1166 | int *return_seen; |

1167 | { |

1168 | Node *n = nvoid; |

1169 | Node *n2; |

1170 | int i; |

1171 | |

1172 | switch (stmt->type) |

1173 | { |

1174 | case sRETURN: |

1175 | n = eval_expr (stmt->u.expr, env); |

1176 | *return_seen = 1; |

1177 | break; |

1178 | |

1179 | case sDEFSUB: |

1180 | define_sub (stmt->u.defsub.name, stmt->u.defsub.closure, stmt->linenum); |

1181 | break; |

1182 | |

1183 | case sBLOCK: |

1184 | n = eval_statement_list (stmt->u.block, env, return_seen); |

1185 | break; |

1186 | |

1187 | case sIF: |

1188 | n = eval_expr (stmt->u.stmt_if.expr, env); |

1189 | i = IS_TRUE (n); |

1190 | node_free (n); |

1191 | |

1192 | if (i) |

1193 | /* Then branch. */ |

1194 | n = eval_statement (stmt->u.stmt_if.then_stmt, env, return_seen); |

1195 | else |

1196 | { |

1197 | /* Optional else branch. */ |

1198 | if (stmt->u.stmt_if.else_stmt) |

1199 | n = eval_statement (stmt->u.stmt_if.else_stmt, env, return_seen); |

1200 | else |

1201 | n = nvoid; |

1202 | } |

1203 | break; |

1204 | |

1205 | case sWHILE: |

1206 | while (1) |

1207 | { |

1208 | n2 = eval_expr (stmt->u.stmt_while.expr, env); |

1209 | i = IS_TRUE (n2); |

1210 | node_free (n2); |

1211 | |

1212 | if (!i) |

1213 | break; |

1214 | |

1215 | node_free (n); |

1216 | |

1217 | /* Eval body. */ |

1218 | n = eval_statement (stmt->u.stmt_while.body, env, return_seen); |

1219 | if (*return_seen) |

1220 | break; |

1221 | } |

1222 | break; |

1223 | |

1224 | case sFOR: |

1225 | /* Init. */ |

1226 | if (stmt->u.stmt_for.init) |

1227 | { |

1228 | n2 = eval_expr (stmt->u.stmt_for.init, env); |

1229 | node_free (n2); |

1230 | } |

1231 | |

1232 | /* Body. */ |

1233 | while (1) |

1234 | { |

1235 | n2 = eval_expr (stmt->u.stmt_for.cond, env); |

1236 | i = IS_TRUE (n2); |

1237 | node_free (n2); |

1238 | |

1239 | if (!i) |

1240 | break; |

1241 | |

1242 | node_free (n); |

1243 | |

1244 | /* Eval body. */ |

1245 | n = eval_statement (stmt->u.stmt_for.body, env, return_seen); |

1246 | if (*return_seen) |

1247 | break; |

1248 | |

1249 | /* Increment. */ |

1250 | if (stmt->u.stmt_for.incr) |

1251 | { |

1252 | n2 = eval_expr (stmt->u.stmt_for.incr, env); |

1253 | node_free (n2); |

1254 | } |

1255 | } |

1256 | break; |

1257 | |

1258 | case sEXPR: |

1259 | n = eval_expr (stmt->u.expr, env); |

1260 | break; |

1261 | } |

1262 | |

1263 | return n; |

1264 | } |

1265 | |

1266 | |

1267 | Node * |

1268 | eval_statement_list (lst, env, return_seen) |

1269 | List *lst; |

1270 | Environment *env; |

1271 | int *return_seen; |

1272 | { |

1273 | ListItem *i; |

1274 | Stmt *stmt; |

1275 | Node *n = nvoid; |

1276 | |

1277 | if (lst == NULL) |

1278 | return nvoid; |

1279 | |

1280 | for (i = lst->head; i; i = i->next) |

1281 | { |

1282 | node_free (n); |

1283 | |

1284 | stmt = (Stmt *) i->data; |

1285 | |

1286 | n = eval_statement (stmt, env, return_seen); |

1287 | if (*return_seen) |

1288 | return n; |

1289 | } |

1290 | |

1291 | return n; |

1292 | } |

**Note:**See TracBrowser for help on using the repository browser.