home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume21 / p2c / part22 < prev    next >
Text File  |  1990-04-05  |  52KB  |  1,856 lines
  1. Subject:  v21i067:  Pascal to C translator, Part22/32
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: d6ced95e 591e403d fc229aa2 64ef719a
  5.  
  6. Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
  7. Posting-number: Volume 21, Issue 67
  8. Archive-name: p2c/part22
  9.  
  10. #! /bin/sh
  11. # This is a shell archive.  Remove anything before this line, then unpack
  12. # it by saving it into a file and typing "sh file".  To overwrite existing
  13. # files, type "sh file -c".  You can also feed this as standard input via
  14. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  15. # will see the following message at the end:
  16. #        "End of archive 22 (of 32)."
  17. # Contents:  src/funcs.c.2
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:45 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. if test -f 'src/funcs.c.2' -a "${1}" != "-c" ; then 
  21.   echo shar: Will not clobber existing file \"'src/funcs.c.2'\"
  22. else
  23. echo shar: Extracting \"'src/funcs.c.2'\" \(48594 characters\)
  24. sed "s/^X//" >'src/funcs.c.2' <<'END_OF_FILE'
  25. X    return makestmt_call(makeexpr_bicall_2(getname, tp_void, ex,
  26. X                           makeexpr_type(type->basetype->basetype)));
  27. X}
  28. X
  29. X
  30. X
  31. XStatic Stmt *proc_getmem(ex)
  32. XExpr *ex;
  33. X{
  34. X    Expr *vex, *ex2, *sz = NULL;
  35. X    Stmt *sp;
  36. X
  37. X    vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
  38. X    ex2 = ex->args[1];
  39. X    if (vex->val.type->kind == TK_POINTER)
  40. X        ex2 = convert_size(vex->val.type->basetype, ex2, "GETMEM");
  41. X    if (alloczeronil)
  42. X        sz = copyexpr(ex2);
  43. X    ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, ex2);
  44. X    sp = makestmt_assign(copyexpr(vex), ex2);
  45. X    if (malloccheck) {
  46. X        sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(vex), makeexpr_nil()),
  47. X                                          makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
  48. X                                          NULL));
  49. X    }
  50. X    if (sz && !isconstantexpr(sz)) {
  51. X        if (alloczeronil == 2)
  52. X            note("Called GETMEM with variable argument [189]");
  53. X        sp = makestmt_if(makeexpr_rel(EK_NE, sz, makeexpr_long(0)),
  54. X                         sp,
  55. X                         makestmt_assign(vex, makeexpr_nil()));
  56. X    } else
  57. X        freeexpr(vex);
  58. X    return sp;
  59. X}
  60. X
  61. X
  62. X
  63. XStatic Stmt *proc_gotoxy(ex)
  64. XExpr *ex;
  65. X{
  66. X    return makestmt_call(makeexpr_bicall_2("gotoxy", tp_void,
  67. X                                           makeexpr_arglong(ex->args[0], 0),
  68. X                                           makeexpr_arglong(ex->args[1], 0)));
  69. X}
  70. X
  71. X
  72. X
  73. XStatic Expr *handle_vax_hex(ex, fmt, scale)
  74. XExpr *ex;
  75. Xchar *fmt;
  76. Xint scale;
  77. X{
  78. X    Expr *lex, *dex, *vex;
  79. X    Meaning *tvar;
  80. X    Type *tp;
  81. X    long smin, smax;
  82. X    int bits;
  83. X
  84. X    if (!ex) {
  85. X    if (!skipopenparen())
  86. X        return NULL;
  87. X    ex = p_expr(tp_integer);
  88. X    }
  89. X    tp = true_type(ex);
  90. X    if (ord_range(tp, &smin, &smax))
  91. X    bits = typebits(smin, smax);
  92. X    else
  93. X    bits = 32;
  94. X    if (curtok == TOK_COMMA) {
  95. X    gettok();
  96. X    if (curtok != TOK_COMMA)
  97. X        lex = makeexpr_arglong(p_expr(tp_integer), 0);
  98. X    else
  99. X        lex = NULL;
  100. X    } else
  101. X    lex = NULL;
  102. X    if (!lex) {
  103. X    if (!scale)
  104. X        lex = makeexpr_long(11);
  105. X    else
  106. X        lex = makeexpr_long((bits+scale-1) / scale + 1);
  107. X    }
  108. X    if (curtok == TOK_COMMA) {
  109. X    gettok();
  110. X    dex = makeexpr_arglong(p_expr(tp_integer), 0);
  111. X    } else {
  112. X    if (!scale)
  113. X        dex = makeexpr_long(10);
  114. X    else
  115. X        dex = makeexpr_long((bits+scale-1) / scale);
  116. X    }
  117. X    if (lex->kind == EK_CONST && dex->kind == EK_CONST &&
  118. X    lex->val.i < dex->val.i)
  119. X    lex = NULL;
  120. X    skipcloseparen();
  121. X    tvar = makestmttempvar(tp_str255, name_STRING);
  122. X    vex = makeexpr_var(tvar);
  123. X    ex = makeexpr_forcelongness(ex);
  124. X    if (exprlongness(ex) > 0)
  125. X    fmt = format_s("l%s", fmt);
  126. X    if (checkconst(lex, 0) || checkconst(lex, 1))
  127. X    lex = NULL;
  128. X    if (checkconst(dex, 0) || checkconst(dex, 1))
  129. X    dex = NULL;
  130. X    if (lex) {
  131. X    if (dex)
  132. X        ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
  133. X                   makeexpr_string(format_s("%%*.*%s", fmt)),
  134. X                   lex, dex, ex);
  135. X    else
  136. X        ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
  137. X                   makeexpr_string(format_s("%%*%s", fmt)),
  138. X                   lex, ex);
  139. X    } else {
  140. X    if (dex)
  141. X        ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
  142. X                   makeexpr_string(format_s("%%.*%s", fmt)),
  143. X                   dex, ex);
  144. X    else
  145. X        ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
  146. X                   makeexpr_string(format_s("%%%s", fmt)),
  147. X                   ex);
  148. X    }
  149. X    return ex;
  150. X}
  151. X
  152. X
  153. X
  154. X
  155. XStatic Expr *func_hex()
  156. X{
  157. X    Expr *ex;
  158. X    char *cp;
  159. X
  160. X    if (!skipopenparen())
  161. X    return NULL;
  162. X    ex = makeexpr_stringcast(p_expr(tp_integer));
  163. X    if ((ex->val.type->kind == TK_STRING ||
  164. X     ex->val.type == tp_strptr) &&
  165. X    curtok != TOK_COMMA) {
  166. X    skipcloseparen();
  167. X    if (ex->kind == EK_CONST) {    /* HP Pascal */
  168. X        cp = getstring(ex);
  169. X        ex = makeexpr_long(my_strtol(cp, NULL, 16));
  170. X        insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
  171. X        return ex;
  172. X    } else {
  173. X        return makeexpr_bicall_3("strtol", tp_integer, 
  174. X                     ex, makeexpr_nil(), makeexpr_long(16));
  175. X    }
  176. X    } else {    /* VAX Pascal */
  177. X    return handle_vax_hex(ex, "x", 4);
  178. X    }
  179. X}
  180. X
  181. X
  182. X
  183. XStatic Expr *func_hi()
  184. X{
  185. X    Expr *ex;
  186. X
  187. X    ex = force_unsigned(p_parexpr(tp_integer));
  188. X    return makeexpr_bin(EK_RSH, tp_ubyte,
  189. X                        ex, makeexpr_long(8));
  190. X}
  191. X
  192. X
  193. X
  194. XStatic Expr *func_high()
  195. X{
  196. X    Expr *ex;
  197. X    Type *type;
  198. X
  199. X    ex = p_parexpr(tp_integer);
  200. X    type = ex->val.type;
  201. X    if (type->kind == TK_POINTER)
  202. X    type = type->basetype;
  203. X    if (type->kind == TK_ARRAY ||
  204. X    type->kind == TK_SMALLARRAY) {
  205. X    ex = makeexpr_minus(copyexpr(type->indextype->smax),
  206. X                copyexpr(type->indextype->smin));
  207. X    } else {
  208. X    warning("HIGH requires an array name parameter [210]");
  209. X    ex = makeexpr_bicall_1("HIGH", tp_int, ex);
  210. X    }
  211. X    return ex;
  212. X}
  213. X
  214. X
  215. X
  216. XStatic Expr *func_hiword()
  217. X{
  218. X    Expr *ex;
  219. X
  220. X    ex = force_unsigned(p_parexpr(tp_unsigned));
  221. X    return makeexpr_bin(EK_RSH, tp_unsigned,
  222. X                        ex, makeexpr_long(16));
  223. X}
  224. X
  225. X
  226. X
  227. XStatic Stmt *proc_inc()
  228. X{
  229. X    Expr *vex, *ex;
  230. X
  231. X    if (!skipopenparen())
  232. X    return NULL;
  233. X    vex = p_expr(NULL);
  234. X    if (curtok == TOK_COMMA) {
  235. X        gettok();
  236. X        ex = p_expr(tp_integer);
  237. X    } else
  238. X        ex = makeexpr_long(1);
  239. X    skipcloseparen();
  240. X    return makestmt_assign(vex, makeexpr_plus(copyexpr(vex), ex));
  241. X}
  242. X
  243. X
  244. X
  245. XStatic Stmt *proc_incl()
  246. X{
  247. X    Expr *vex, *ex;
  248. X
  249. X    if (!skipopenparen())
  250. X    return NULL;
  251. X    vex = p_expr(NULL);
  252. X    if (!skipcomma())
  253. X    return NULL;
  254. X    ex = p_expr(vex->val.type->indextype);
  255. X    skipcloseparen();
  256. X    if (vex->val.type->kind == TK_SMALLSET)
  257. X    return makestmt_assign(vex, makeexpr_bin(EK_BOR, vex->val.type,
  258. X                         copyexpr(vex),
  259. X                         makeexpr_bin(EK_LSH, vex->val.type,
  260. X                                  makeexpr_longcast(makeexpr_long(1), 1),
  261. X                                  ex)));
  262. X    else
  263. X    return makestmt_call(makeexpr_bicall_2(setaddname, tp_void, vex,
  264. X                           makeexpr_arglong(enum_to_int(ex), 0)));
  265. X}
  266. X
  267. X
  268. X
  269. XStatic Stmt *proc_insert(ex)
  270. XExpr *ex;
  271. X{
  272. X    return makestmt_call(makeexpr_bicall_3(strinsertname, tp_void,
  273. X                                           ex->args[0], 
  274. X                                           ex->args[1],
  275. X                                           makeexpr_arglong(ex->args[2], 0)));
  276. X}
  277. X
  278. X
  279. X
  280. XStatic Expr *func_int()
  281. X{
  282. X    Expr *ex;
  283. X    Meaning *tvar;
  284. X
  285. X    ex = p_parexpr(tp_integer);
  286. X    if (ex->val.type->kind == TK_REAL) {    /* Turbo Pascal INT */
  287. X    tvar = makestmttempvar(tp_longreal, name_TEMP);
  288. X    return makeexpr_comma(makeexpr_bicall_2("modf", tp_longreal,
  289. X                        grabarg(ex, 0),
  290. X                        makeexpr_addr(makeexpr_var(tvar))),
  291. X                  makeexpr_var(tvar));
  292. X    } else {     /* VAX Pascal INT */
  293. X    return makeexpr_ord(ex);
  294. X    }
  295. X}
  296. X
  297. X
  298. XStatic Expr *func_uint()
  299. X{
  300. X    Expr *ex;
  301. X
  302. X    ex = p_parexpr(tp_integer);
  303. X    return makeexpr_cast(ex, tp_unsigned);
  304. X}
  305. X
  306. X
  307. X
  308. XStatic Stmt *proc_leave()
  309. X{
  310. X    return makestmt(SK_BREAK);
  311. X}
  312. X
  313. X
  314. X
  315. XStatic Expr *func_lo()
  316. X{
  317. X    Expr *ex;
  318. X
  319. X    ex = gentle_cast(p_parexpr(tp_integer), tp_ushort);
  320. X    return makeexpr_bin(EK_BAND, tp_ubyte,
  321. X                        ex, makeexpr_long(255));
  322. X}
  323. X
  324. X
  325. XStatic Expr *func_loophole()
  326. X{
  327. X    Type *type;
  328. X    Expr *ex;
  329. X
  330. X    if (!skipopenparen())
  331. X    return NULL;
  332. X    type = p_type(NULL);
  333. X    if (!skipcomma())
  334. X    return NULL;
  335. X    ex = p_expr(tp_integer);
  336. X    skipcloseparen();
  337. X    return pascaltypecast(type, ex);
  338. X}
  339. X
  340. X
  341. X
  342. XStatic Expr *func_lower()
  343. X{
  344. X    Expr *ex;
  345. X    Value val;
  346. X
  347. X    if (!skipopenparen())
  348. X    return NULL;
  349. X    ex = p_expr(tp_integer);
  350. X    if (curtok == TOK_COMMA) {
  351. X    gettok();
  352. X    val = p_constant(tp_integer);
  353. X    if (!val.type || val.i != 1)
  354. X        note("LOWER(v,n) not supported for n>1 [190]");
  355. X    }
  356. X    skipcloseparen();
  357. X    return copyexpr(ex->val.type->indextype->smin);
  358. X}
  359. X
  360. X
  361. X
  362. XStatic Expr *func_loword()
  363. X{
  364. X    Expr *ex;
  365. X
  366. X    ex = p_parexpr(tp_integer);
  367. X    return makeexpr_bin(EK_BAND, tp_ushort,
  368. X                        ex, makeexpr_long(65535));
  369. X}
  370. X
  371. X
  372. X
  373. XStatic Expr *func_ln(ex)
  374. XExpr *ex;
  375. X{
  376. X    return makeexpr_bicall_1("log", tp_longreal, grabarg(ex, 0));
  377. X}
  378. X
  379. X
  380. X
  381. XStatic Expr *func_log(ex)
  382. XExpr *ex;
  383. X{
  384. X    return makeexpr_bicall_1("log10", tp_longreal, grabarg(ex, 0));
  385. X}
  386. X
  387. X
  388. X
  389. XStatic Expr *func_max()
  390. X{
  391. X    Type *tp;
  392. X    Expr *ex, *ex2;
  393. X
  394. X    if (!skipopenparen())
  395. X    return NULL;
  396. X    if (curtok == TOK_IDENT && curtokmeaning &&
  397. X    curtokmeaning->kind == MK_TYPE) {
  398. X    tp = curtokmeaning->type;
  399. X    gettok();
  400. X    skipcloseparen();
  401. X    return copyexpr(tp->smax);
  402. X    }
  403. X    ex = p_expr(tp_integer);
  404. X    while (curtok == TOK_COMMA) {
  405. X    gettok();
  406. X    ex2 = p_expr(ex->val.type);
  407. X    if (ex->val.type->kind == TK_REAL) {
  408. X        tp = ex->val.type;
  409. X        if (ex2->val.type->kind != TK_REAL)
  410. X        ex2 = makeexpr_cast(ex2, tp);
  411. X    } else {
  412. X        tp = ex2->val.type;
  413. X        if (ex->val.type->kind != TK_REAL)
  414. X        ex = makeexpr_cast(ex, tp);
  415. X    }
  416. X    ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmax" : "P_imax",
  417. X                   tp, ex, ex2);
  418. X    }                
  419. X    skipcloseparen();
  420. X    return ex;
  421. X}
  422. X
  423. X
  424. X
  425. XStatic Expr *func_maxavail(ex)
  426. XExpr *ex;
  427. X{
  428. X    freeexpr(ex);
  429. X    return makeexpr_bicall_0("maxavail", tp_integer);
  430. X}
  431. X
  432. X
  433. X
  434. XStatic Expr *func_maxpos()
  435. X{
  436. X    return file_iofunc(3, seek_base);
  437. X}
  438. X
  439. X
  440. X
  441. XStatic Expr *func_memavail(ex)
  442. XExpr *ex;
  443. X{
  444. X    freeexpr(ex);
  445. X    return makeexpr_bicall_0("memavail", tp_integer);
  446. X}
  447. X
  448. X
  449. X
  450. XStatic Expr *var_mem()
  451. X{
  452. X    Expr *ex, *ex2;
  453. X
  454. X    if (!wneedtok(TOK_LBR))
  455. X    return makeexpr_name("MEM", tp_integer);
  456. X    ex = p_expr(tp_integer);
  457. X    if (curtok == TOK_COLON) {
  458. X    gettok();
  459. X    ex2 = p_expr(tp_integer);
  460. X    ex = makeexpr_bicall_2("MEM", tp_ubyte, ex, ex2);
  461. X    } else {
  462. X    ex = makeexpr_bicall_1("MEM", tp_ubyte, ex);
  463. X    }
  464. X    if (!wneedtok(TOK_RBR))
  465. X    skippasttotoken(TOK_RBR, TOK_SEMI);
  466. X    note("Reference to MEM [191]");
  467. X    return ex;
  468. X}
  469. X
  470. X
  471. X
  472. XStatic Expr *var_memw()
  473. X{
  474. X    Expr *ex, *ex2;
  475. X
  476. X    if (!wneedtok(TOK_LBR))
  477. X    return makeexpr_name("MEMW", tp_integer);
  478. X    ex = p_expr(tp_integer);
  479. X    if (curtok == TOK_COLON) {
  480. X    gettok();
  481. X    ex2 = p_expr(tp_integer);
  482. X    ex = makeexpr_bicall_2("MEMW", tp_ushort, ex, ex2);
  483. X    } else {
  484. X    ex = makeexpr_bicall_1("MEMW", tp_ushort, ex);
  485. X    }
  486. X    if (!wneedtok(TOK_RBR))
  487. X    skippasttotoken(TOK_RBR, TOK_SEMI);
  488. X    note("Reference to MEMW [191]");
  489. X    return ex;
  490. X}
  491. X
  492. X
  493. X
  494. XStatic Expr *var_meml()
  495. X{
  496. X    Expr *ex, *ex2;
  497. X
  498. X    if (!wneedtok(TOK_LBR))
  499. X    return makeexpr_name("MEML", tp_integer);
  500. X    ex = p_expr(tp_integer);
  501. X    if (curtok == TOK_COLON) {
  502. X    gettok();
  503. X    ex2 = p_expr(tp_integer);
  504. X    ex = makeexpr_bicall_2("MEML", tp_integer, ex, ex2);
  505. X    } else {
  506. X    ex = makeexpr_bicall_1("MEML", tp_integer, ex);
  507. X    }
  508. X    if (!wneedtok(TOK_RBR))
  509. X    skippasttotoken(TOK_RBR, TOK_SEMI);
  510. X    note("Reference to MEML [191]");
  511. X    return ex;
  512. X}
  513. X
  514. X
  515. X
  516. XStatic Expr *func_min()
  517. X{
  518. X    Type *tp;
  519. X    Expr *ex, *ex2;
  520. X
  521. X    if (!skipopenparen())
  522. X    return NULL;
  523. X    if (curtok == TOK_IDENT && curtokmeaning &&
  524. X    curtokmeaning->kind == MK_TYPE) {
  525. X    tp = curtokmeaning->type;
  526. X    gettok();
  527. X    skipcloseparen();
  528. X    return copyexpr(tp->smin);
  529. X    }
  530. X    ex = p_expr(tp_integer);
  531. X    while (curtok == TOK_COMMA) {
  532. X    gettok();
  533. X    ex2 = p_expr(ex->val.type);
  534. X    if (ex->val.type->kind == TK_REAL) {
  535. X        tp = ex->val.type;
  536. X        if (ex2->val.type->kind != TK_REAL)
  537. X        ex2 = makeexpr_cast(ex2, tp);
  538. X    } else {
  539. X        tp = ex2->val.type;
  540. X        if (ex->val.type->kind != TK_REAL)
  541. X        ex = makeexpr_cast(ex, tp);
  542. X    }
  543. X    ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmin" : "P_imin",
  544. X                   tp, ex, ex2);
  545. X    }                
  546. X    skipcloseparen();
  547. X    return ex;
  548. X}
  549. X
  550. X
  551. X
  552. XStatic Stmt *proc_move(ex)
  553. XExpr *ex;
  554. X{
  555. X    ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);    /* source */
  556. X    ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);    /* dest */
  557. X    ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
  558. X                                          argbasetype(ex->args[1])), ex->args[2], "MOVE");
  559. X    return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
  560. X                                           ex->args[1],
  561. X                                           ex->args[0],
  562. X                                           makeexpr_arglong(ex->args[2], (size_t_long != 0))));
  563. X}
  564. X
  565. X
  566. X
  567. XStatic Stmt *proc_move_fast()
  568. X{
  569. X    Expr *ex, *ex2, *ex3, *ex4;
  570. X
  571. X    if (!skipopenparen())
  572. X    return NULL;
  573. X    ex = p_expr(tp_integer);
  574. X    if (!skipcomma())
  575. X    return NULL;
  576. X    ex2 = p_expr(tp_integer);
  577. X    if (!skipcomma())
  578. X    return NULL;
  579. X    ord_range_expr(ex2->val.type->indextype, &ex4, NULL);
  580. X    ex2 = makeexpr_index(ex2, p_expr(tp_integer), copyexpr(ex4));
  581. X    if (!skipcomma())
  582. X    return NULL;
  583. X    ex3 = p_expr(tp_integer);
  584. X    if (!skipcomma())
  585. X    return NULL;
  586. X    ord_range_expr(ex3->val.type->indextype, &ex4, NULL);
  587. X    ex3 = makeexpr_index(ex3, p_expr(tp_integer), copyexpr(ex4));
  588. X    skipcloseparen();
  589. X    ex = convert_size(choosetype(argbasetype(ex2),
  590. X                 argbasetype(ex3)), ex, "MOVE_FAST");
  591. X    return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
  592. X                       makeexpr_addr(ex3),
  593. X                       makeexpr_addr(ex2),
  594. X                       makeexpr_arglong(ex, (size_t_long != 0))));
  595. X}
  596. X
  597. X
  598. X
  599. XStatic Stmt *proc_new()
  600. X{
  601. X    Expr *ex, *ex2;
  602. X    Stmt *sp, **spp;
  603. X    Type *type;
  604. X    char *name, *name2 = NULL, vbuf[1000];
  605. X
  606. X    if (!skipopenparen())
  607. X    return NULL;
  608. X    ex = p_expr(tp_anyptr);
  609. X    type = ex->val.type;
  610. X    if (type->kind == TK_POINTER)
  611. X    type = type->basetype;
  612. X    parse_special_variant(type, vbuf);
  613. X    skipcloseparen();
  614. X    name = find_special_variant(vbuf, NULL, specialmallocs, 3);
  615. X    if (!name) {
  616. X        name2 = find_special_variant(vbuf, NULL, specialsizeofs, 3);
  617. X    if (!name2) {
  618. X        name = find_special_variant(vbuf, NULL, specialmallocs, 1);
  619. X        name2 = find_special_variant(vbuf, NULL, specialsizeofs, 1);
  620. X        if (name || !name2)
  621. X        name = find_special_variant(vbuf, "SpecialMalloc", specialmallocs, 1);
  622. X        else
  623. X        name2 = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
  624. X    }
  625. X    }
  626. X    if (name) {
  627. X    ex2 = makeexpr_bicall_0(name, ex->val.type);
  628. X    } else if (name2) {
  629. X    ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, pc_expr_str(name2));
  630. X    } else {
  631. X    ex2 = makeexpr_bicall_1(mallocname, tp_anyptr,
  632. X                makeexpr_sizeof(makeexpr_type(type), 1));
  633. X    }
  634. X    sp = makestmt_assign(copyexpr(ex), ex2);
  635. X    if (malloccheck) {
  636. X        sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ,
  637. X                               copyexpr(ex),
  638. X                               makeexpr_nil()),
  639. X                                          makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
  640. X                                          NULL));
  641. X    }
  642. X    spp = &sp->next;
  643. X    while (*spp)
  644. X    spp = &(*spp)->next;
  645. X    if (type->kind == TK_RECORD)
  646. X    initfilevars(type->fbase, &spp, makeexpr_hat(copyexpr(ex), 0));
  647. X    else if (isfiletype(type))
  648. X    sp = makestmt_seq(sp, makestmt_assign(makeexpr_hat(copyexpr(ex), 0),
  649. X                          makeexpr_nil()));
  650. X    freeexpr(ex);
  651. X    return sp;
  652. X}
  653. X
  654. X
  655. X
  656. XStatic Expr *func_oct()
  657. X{
  658. X    return handle_vax_hex(NULL, "o", 3);
  659. X}
  660. X
  661. X
  662. X
  663. XStatic Expr *func_octal(ex)
  664. XExpr *ex;
  665. X{
  666. X    char *cp;
  667. X
  668. X    ex = grabarg(ex, 0);
  669. X    if (ex->kind == EK_CONST) {
  670. X        cp = getstring(ex);
  671. X        ex = makeexpr_long(my_strtol(cp, NULL, 8));
  672. X        insertarg(&ex, 0, makeexpr_name("0%lo", tp_integer));
  673. X        return ex;
  674. X    } else {
  675. X        return makeexpr_bicall_3("strtol", tp_integer, 
  676. X                                 ex, makeexpr_nil(), makeexpr_long(8));
  677. X    }
  678. X}
  679. X
  680. X
  681. X
  682. XStatic Expr *func_odd(ex)
  683. XExpr *ex;
  684. X{
  685. X    ex = makeexpr_unlongcast(grabarg(ex, 0));
  686. X    if (*oddname)
  687. X        return makeexpr_bicall_1(oddname, tp_boolean, ex);
  688. X    else
  689. X        return makeexpr_bin(EK_BAND, tp_boolean, ex, makeexpr_long(1));
  690. X}
  691. X
  692. X
  693. X
  694. XStatic Stmt *proc_open()
  695. X{
  696. X    return handleopen(2);
  697. X}
  698. X
  699. X
  700. X
  701. XStatic Expr *func_ord()
  702. X{
  703. X    Expr *ex;
  704. X
  705. X    if (wneedtok(TOK_LPAR)) {
  706. X    ex = p_ord_expr();
  707. X    skipcloseparen();
  708. X    } else
  709. X    ex = p_ord_expr();
  710. X    return makeexpr_ord(ex);
  711. X}
  712. X
  713. X
  714. X
  715. XStatic Expr *func_ord4()
  716. X{
  717. X    Expr *ex;
  718. X
  719. X    if (wneedtok(TOK_LPAR)) {
  720. X    ex = p_ord_expr();
  721. X    skipcloseparen();
  722. X    } else
  723. X    ex = p_ord_expr();
  724. X    return makeexpr_longcast(makeexpr_ord(ex), 1);
  725. X}
  726. X
  727. X
  728. X
  729. XStatic Expr *func_pad(ex)
  730. XExpr *ex;
  731. X{
  732. X    if (checkconst(ex->args[1], 0) ||    /* "s" is null string */
  733. X    checkconst(ex->args[2], ' ')) {
  734. X        return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
  735. X                                 makeexpr_string("%*s"),
  736. X                                 makeexpr_longcast(ex->args[3], 0),
  737. X                                 makeexpr_string(""));
  738. X    }
  739. X    return makeexpr_bicall_4(strpadname, tp_strptr,
  740. X                 ex->args[0], ex->args[1], ex->args[2],
  741. X                 makeexpr_arglong(ex->args[3], 0));
  742. X}
  743. X
  744. X
  745. X
  746. XStatic Stmt *proc_page()
  747. X{
  748. X    Expr *fex, *ex;
  749. X
  750. X    if (curtok == TOK_LPAR) {
  751. X        fex = p_parexpr(tp_text);
  752. X        ex = makeexpr_bicall_2("fprintf", tp_int,
  753. X                               copyexpr(fex),
  754. X                               makeexpr_string("\f"));
  755. X    } else {
  756. X        fex = makeexpr_var(mp_output);
  757. X        ex = makeexpr_bicall_1("printf", tp_int,
  758. X                               makeexpr_string("\f"));
  759. X    }
  760. X    if (FCheck(checkfilewrite)) {
  761. X        ex = makeexpr_bicall_2("~SETIO", tp_void,
  762. X                               makeexpr_rel(EK_GE, ex, makeexpr_long(0)),
  763. X                   makeexpr_name(filewriteerrorname, tp_int));
  764. X    }
  765. X    return wrapopencheck(makestmt_call(ex), fex);
  766. X}
  767. X
  768. X
  769. X
  770. XStatic Expr *func_paramcount(ex)
  771. XExpr *ex;
  772. X{
  773. X    freeexpr(ex);
  774. X    return makeexpr_minus(makeexpr_name(name_ARGC, tp_int),
  775. X                          makeexpr_long(1));
  776. X}
  777. X
  778. X
  779. X
  780. XStatic Expr *func_paramstr(ex)
  781. XExpr *ex;
  782. X{
  783. X    Expr *ex2;
  784. X
  785. X    ex2 = makeexpr_index(makeexpr_name(name_ARGV,
  786. X                       makepointertype(tp_strptr)),
  787. X             makeexpr_unlongcast(ex->args[1]),
  788. X             makeexpr_long(0));
  789. X    ex2->val.type = tp_str255;
  790. X    return makeexpr_bicall_3("sprintf", tp_strptr,
  791. X                 ex->args[0],
  792. X                 makeexpr_string("%s"),
  793. X                 ex2);
  794. X}
  795. X
  796. X
  797. X
  798. XStatic Expr *func_pi()
  799. X{
  800. X    return makeexpr_name("M_PI", tp_longreal);
  801. X}
  802. X
  803. X
  804. X
  805. XStatic Expr *var_port()
  806. X{
  807. X    Expr *ex;
  808. X
  809. X    if (!wneedtok(TOK_LBR))
  810. X    return makeexpr_name("PORT", tp_integer);
  811. X    ex = p_expr(tp_integer);
  812. X    if (!wneedtok(TOK_RBR))
  813. X    skippasttotoken(TOK_RBR, TOK_SEMI);
  814. X    note("Reference to PORT [191]");
  815. X    return makeexpr_bicall_1("PORT", tp_ubyte, ex);
  816. X}
  817. X
  818. X
  819. X
  820. XStatic Expr *var_portw()
  821. X{
  822. X    Expr *ex;
  823. X
  824. X    if (!wneedtok(TOK_LBR))
  825. X    return makeexpr_name("PORTW", tp_integer);
  826. X    ex = p_expr(tp_integer);
  827. X    if (!wneedtok(TOK_RBR))
  828. X    skippasttotoken(TOK_RBR, TOK_SEMI);
  829. X    note("Reference to PORTW [191]");
  830. X    return makeexpr_bicall_1("PORTW", tp_ushort, ex);
  831. X}
  832. X
  833. X
  834. X
  835. XStatic Expr *func_pos(ex)
  836. XExpr *ex;
  837. X{
  838. X    char *cp;
  839. X
  840. X    cp = strposname;
  841. X    if (!*cp) {
  842. X        note("POS function used [192]");
  843. X        cp = "POS";
  844. X    } 
  845. X    return makeexpr_bicall_3(cp, tp_int,
  846. X                             ex->args[1], 
  847. X                             ex->args[0],
  848. X                             makeexpr_long(1));
  849. X}
  850. X
  851. X
  852. X
  853. XStatic Expr *func_ptr(ex)
  854. XExpr *ex;
  855. X{
  856. X    note("PTR function was used [193]");
  857. X    return ex;
  858. X}
  859. X
  860. X
  861. X
  862. XStatic Expr *func_position()
  863. X{
  864. X    return file_iofunc(2, seek_base);
  865. X}
  866. X
  867. X
  868. X
  869. XStatic Expr *func_pred()
  870. X{
  871. X    Expr *ex;
  872. X
  873. X    if (wneedtok(TOK_LPAR)) {
  874. X    ex = p_ord_expr();
  875. X    skipcloseparen();
  876. X    } else
  877. X    ex = p_ord_expr();
  878. X#if 1
  879. X    ex = makeexpr_inc(ex, makeexpr_long(-1));
  880. X#else
  881. X    ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(-1)), ex->val.type);
  882. X#endif
  883. X    return ex;
  884. X}
  885. X
  886. X
  887. X
  888. XStatic Stmt *proc_put()
  889. X{
  890. X    Expr *ex;
  891. X    Type *type;
  892. X
  893. X    if (curtok == TOK_LPAR)
  894. X    ex = p_parexpr(tp_text);
  895. X    else
  896. X    ex = makeexpr_var(mp_output);
  897. X    requirefilebuffer(ex);
  898. X    type = ex->val.type;
  899. X    if (isfiletype(type) && *charputname &&
  900. X    type->basetype->basetype->kind == TK_CHAR)
  901. X    return makestmt_call(makeexpr_bicall_1(charputname, tp_void, ex));
  902. X    else if (isfiletype(type) && *arrayputname &&
  903. X         type->basetype->basetype->kind == TK_ARRAY)
  904. X    return makestmt_call(makeexpr_bicall_2(arrayputname, tp_void, ex,
  905. X                           makeexpr_type(type->basetype->basetype)));
  906. X    else
  907. X    return makestmt_call(makeexpr_bicall_2(putname, tp_void, ex,
  908. X                           makeexpr_type(type->basetype->basetype)));
  909. X}
  910. X
  911. X
  912. X
  913. XStatic Expr *func_pwroften(ex)
  914. XExpr *ex;
  915. X{
  916. X    return makeexpr_bicall_2("pow", tp_longreal,
  917. X                 makeexpr_real("10.0"), grabarg(ex, 0));
  918. X}
  919. X
  920. X
  921. X
  922. XStatic Stmt *proc_reset()
  923. X{
  924. X    return handleopen(0);
  925. X}
  926. X
  927. X
  928. X
  929. XStatic Stmt *proc_rewrite()
  930. X{
  931. X    return handleopen(1);
  932. X}
  933. X
  934. X
  935. X
  936. X
  937. XStmt *doseek(fex, ex)
  938. XExpr *fex, *ex;
  939. X{
  940. X    Expr *ex2;
  941. X    Type *basetype = fex->val.type->basetype->basetype;
  942. X
  943. X    if (ansiC == 1)
  944. X        ex2 = makeexpr_name("SEEK_SET", tp_int);
  945. X    else
  946. X        ex2 = makeexpr_long(0);
  947. X    ex = makeexpr_bicall_3("fseek", tp_int, 
  948. X                           copyexpr(fex),
  949. X                           makeexpr_arglong(
  950. X                               makeexpr_times(makeexpr_minus(ex,
  951. X                                                             makeexpr_long(seek_base)),
  952. X                                              makeexpr_sizeof(makeexpr_type(basetype), 0)),
  953. X                               1),
  954. X                           ex2);
  955. X    if (FCheck(checkfileseek)) {
  956. X        ex = makeexpr_bicall_2("~SETIO", tp_void,
  957. X                               makeexpr_rel(EK_EQ, ex, makeexpr_long(0)),
  958. X                   makeexpr_name(endoffilename, tp_int));
  959. X    }
  960. X    return makestmt_call(ex);
  961. X}
  962. X
  963. X
  964. X
  965. X
  966. XStatic Expr *makegetchar(fex)
  967. XExpr *fex;
  968. X{
  969. X    if (isvar(fex, mp_input))
  970. X        return makeexpr_bicall_0("getchar", tp_char);
  971. X    else
  972. X        return makeexpr_bicall_1("getc", tp_char, copyexpr(fex));
  973. X}
  974. X
  975. X
  976. X
  977. XStatic Stmt *fixscanf(sp, fex)
  978. XStmt *sp;
  979. XExpr *fex;
  980. X{
  981. X    int nargs, i, isstrread;
  982. X    char *cp;
  983. X    Expr *ex;
  984. X    Stmt *sp2;
  985. X
  986. X    isstrread = (fex->val.type->kind == TK_STRING);
  987. X    if (sp->kind == SK_ASSIGN && sp->exp1->kind == EK_BICALL &&
  988. X        !strcmp(sp->exp1->val.s, "scanf")) {
  989. X        if (sp->exp1->args[0]->kind == EK_CONST &&
  990. X            !(sp->exp1->args[0]->val.i&1) && !isstrread) {
  991. X            cp = sp->exp1->args[0]->val.s;    /* scanf("%c%c") -> getchar;getchar */
  992. X            for (i = 0; cp[i] == '%' && cp[i+1] == 'c'; ) {
  993. X                i += 2;
  994. X                if (i == sp->exp1->args[0]->val.i) {
  995. X                    sp2 = NULL;
  996. X                    for (i = 1; i < sp->exp1->nargs; i++) {
  997. X                        ex = makeexpr_hat(sp->exp1->args[i], 0);
  998. X                        sp2 = makestmt_seq(sp2,
  999. X                                           makestmt_assign(copyexpr(ex),
  1000. X                                                           makegetchar(fex)));
  1001. X                        if (checkeof(fex)) {
  1002. X                            sp2 = makestmt_seq(sp2,
  1003. X                                makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
  1004. X                                                                makeexpr_rel(EK_NE,
  1005. X                                                                             ex,
  1006. X                                                                             makeexpr_name("EOF", tp_char)),
  1007. X                                makeexpr_name(endoffilename, tp_int))));
  1008. X                        } else
  1009. X                            freeexpr(ex);
  1010. X                    }
  1011. X                    return sp2;
  1012. X                }
  1013. X            }
  1014. X        }
  1015. X        nargs = sp->exp1->nargs - 1;
  1016. X        if (isstrread) {
  1017. X            strchange(&sp->exp1->val.s, "sscanf");
  1018. X            insertarg(&sp->exp1, 0, copyexpr(fex));
  1019. X        } else if (!isvar(fex, mp_input)) {
  1020. X            strchange(&sp->exp1->val.s, "fscanf");
  1021. X            insertarg(&sp->exp1, 0, copyexpr(fex));
  1022. X        }
  1023. X        if (FCheck(checkreadformat)) {
  1024. X            if (checkeof(fex) && !isstrread)
  1025. X                ex = makeexpr_cond(makeexpr_rel(EK_NE,
  1026. X                                                makeexpr_bicall_1("feof", tp_int, copyexpr(fex)),
  1027. X                                                makeexpr_long(0)),
  1028. X                   makeexpr_name(endoffilename, tp_int),
  1029. X                   makeexpr_name(badinputformatname, tp_int));
  1030. X            else
  1031. X        ex = makeexpr_name(badinputformatname, tp_int);
  1032. X            sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
  1033. X                                         makeexpr_rel(EK_EQ,
  1034. X                                                      sp->exp1,
  1035. X                                                      makeexpr_long(nargs)),
  1036. X                                         ex);
  1037. X        } else if (checkeof(fex) && !isstrread) {
  1038. X            sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
  1039. X                                         makeexpr_rel(EK_NE,
  1040. X                                                      sp->exp1,
  1041. X                                                      makeexpr_name("EOF", tp_int)),
  1042. X                     makeexpr_name(endoffilename, tp_int));
  1043. X        }
  1044. X    }
  1045. X    return sp;
  1046. X}
  1047. X
  1048. X
  1049. X
  1050. XStatic Expr *makefgets(vex, lex, fex)
  1051. XExpr *vex, *lex, *fex;
  1052. X{
  1053. X    Expr *ex;
  1054. X
  1055. X    ex = makeexpr_bicall_3("fgets", tp_strptr,
  1056. X                           vex,
  1057. X                           lex,
  1058. X                           copyexpr(fex));
  1059. X    if (checkeof(fex)) {
  1060. X        ex = makeexpr_bicall_2("~SETIO", tp_void,
  1061. X                               makeexpr_rel(EK_NE, ex, makeexpr_nil()),
  1062. X                   makeexpr_name(endoffilename, tp_int));
  1063. X    }
  1064. X    return ex;
  1065. X}
  1066. X
  1067. X
  1068. X
  1069. XStatic Stmt *skipeoln(fex)
  1070. XExpr *fex;
  1071. X{
  1072. X    Meaning *tvar;
  1073. X    Expr *ex;
  1074. X
  1075. X    if (!strcmp(readlnname, "fgets")) {
  1076. X        tvar = makestmttempvar(tp_str255, name_STRING);
  1077. X        return makestmt_call(makefgets(makeexpr_var(tvar),
  1078. X                                       makeexpr_long(stringceiling+1),
  1079. X                                       fex));
  1080. X    } else if (!strcmp(readlnname, "scanf") || !*readlnname) {
  1081. X        if (checkeof(fex))
  1082. X            ex = makeexpr_bicall_2("~SETIO", tp_void,
  1083. X                                   makeexpr_rel(EK_NE,
  1084. X                                                makegetchar(fex),
  1085. X                                                makeexpr_name("EOF", tp_char)),
  1086. X                   makeexpr_name(endoffilename, tp_int));
  1087. X        else
  1088. X            ex = makegetchar(fex);
  1089. X        return makestmt_seq(fixscanf(
  1090. X                    makestmt_call(makeexpr_bicall_1("scanf", tp_int,
  1091. X                                                    makeexpr_string("%*[^\n]"))), fex),
  1092. X                    makestmt_call(ex));
  1093. X    } else {
  1094. X        return makestmt_call(makeexpr_bicall_1(readlnname, tp_void,
  1095. X                                               copyexpr(fex)));
  1096. X    }
  1097. X}
  1098. X
  1099. X
  1100. X
  1101. XStatic Stmt *handleread_text(fex, var, isreadln)
  1102. XExpr *fex, *var;
  1103. Xint isreadln;
  1104. X{
  1105. X    Stmt *spbase, *spafter, *sp;
  1106. X    Expr *ex = NULL, *exj = NULL;
  1107. X    Type *type;
  1108. X    Meaning *tvar, *tempcp, *mp;
  1109. X    int i, isstrread, scanfmode, readlnflag, varstring, maxstring;
  1110. X    int longstrsize = (longstringsize > 0) ? longstringsize : stringceiling;
  1111. X    long rmin, rmax;
  1112. X    char *fmt;
  1113. X
  1114. X    spbase = NULL;
  1115. X    spafter = NULL;
  1116. X    sp = NULL;
  1117. X    tempcp = NULL;
  1118. X    isstrread = (fex->val.type->kind == TK_STRING);
  1119. X    if (isstrread) {
  1120. X        exj = var;
  1121. X        var = p_expr(NULL);
  1122. X    }
  1123. X    scanfmode = !strcmp(readlnname, "scanf") || !*readlnname || isstrread;
  1124. X    for (;;) {
  1125. X        readlnflag = isreadln && curtok == TOK_RPAR;
  1126. X        if (var->val.type->kind == TK_STRING && !isstrread) {
  1127. X            if (sp)
  1128. X                spbase = makestmt_seq(spbase, fixscanf(sp, fex));
  1129. X            spbase = makestmt_seq(spbase, spafter);
  1130. X            varstring = (varstrings && var->kind == EK_VAR &&
  1131. X                         (mp = (Meaning *)var->val.i)->kind == MK_VARPARAM &&
  1132. X                         mp->type == tp_strptr);
  1133. X            maxstring = (strmax(var) >= longstrsize && !varstring);
  1134. X            if (isvar(fex, mp_input) && maxstring && usegets && readlnflag) {
  1135. X                spbase = makestmt_seq(spbase,
  1136. X                                      makestmt_call(makeexpr_bicall_1("gets", tp_str255,
  1137. X                                                                      makeexpr_addr(var))));
  1138. X                isreadln = 0;
  1139. X            } else if (scanfmode && !varstring &&
  1140. X                       (*readlnname || !isreadln)) {
  1141. X                spbase = makestmt_seq(spbase, makestmt_assign(makeexpr_hat(copyexpr(var), 0),
  1142. X                                                              makeexpr_char(0)));
  1143. X                if (maxstring && usegets)
  1144. X                    ex = makeexpr_string("%[^\n]");
  1145. X                else
  1146. X                    ex = makeexpr_string(format_d("%%%d[^\n]", strmax(var)));
  1147. X                ex = makeexpr_bicall_2("scanf", tp_int, ex, makeexpr_addr(var));
  1148. X                spbase = makestmt_seq(spbase, fixscanf(makestmt_call(ex), fex));
  1149. X                if (readlnflag && maxstring && usegets) {
  1150. X                    spbase = makestmt_seq(spbase, makestmt_call(makegetchar(fex)));
  1151. X                    isreadln = 0;
  1152. X                }
  1153. X            } else {
  1154. X                ex = makeexpr_plus(strmax_func(var), makeexpr_long(1));
  1155. X                spbase = makestmt_seq(spbase,
  1156. X                                      makestmt_call(makefgets(makeexpr_addr(copyexpr(var)),
  1157. X                                                              ex,
  1158. X                                                              fex)));
  1159. X                if (!tempcp)
  1160. X                    tempcp = makestmttempvar(tp_charptr, name_TEMP);
  1161. X                spbase = makestmt_seq(spbase,
  1162. X                                      makestmt_assign(makeexpr_var(tempcp),
  1163. X                                                      makeexpr_bicall_2("strchr", tp_charptr,
  1164. X                                                                        makeexpr_addr(copyexpr(var)),
  1165. X                                                                        makeexpr_char('\n'))));
  1166. X                sp = makestmt_assign(makeexpr_hat(makeexpr_var(tempcp), 0),
  1167. X                                     makeexpr_long(0));
  1168. X                if (readlnflag)
  1169. X                    isreadln = 0;
  1170. X                else
  1171. X                    sp = makestmt_seq(sp,
  1172. X                                      makestmt_call(makeexpr_bicall_2("ungetc", tp_void,
  1173. X                                                                      makeexpr_char('\n'),
  1174. X                                                                      copyexpr(fex))));
  1175. X                spbase = makestmt_seq(spbase, makestmt_if(makeexpr_rel(EK_NE,
  1176. X                                                                       makeexpr_var(tempcp),
  1177. X                                                                       makeexpr_nil()),
  1178. X                                                          sp,
  1179. X                                                          NULL));
  1180. X            }
  1181. X            sp = NULL;
  1182. X            spafter = NULL;
  1183. X        } else if (var->val.type->kind == TK_ARRAY && !isstrread) {
  1184. X            if (sp)
  1185. X                spbase = makestmt_seq(spbase, fixscanf(sp, fex));
  1186. X            spbase = makestmt_seq(spbase, spafter);
  1187. X        ex = makeexpr_sizeof(copyexpr(var), 0);
  1188. X        if (readlnflag) {
  1189. X        spbase = makestmt_seq(spbase,
  1190. X             makestmt_call(
  1191. X             makeexpr_bicall_3("P_readlnpaoc", tp_void,
  1192. X                       copyexpr(fex),
  1193. X                       makeexpr_addr(var),
  1194. X                       makeexpr_arglong(ex, 0))));
  1195. X        isreadln = 0;
  1196. X        } else {
  1197. X        spbase = makestmt_seq(spbase,
  1198. X             makestmt_call(
  1199. X             makeexpr_bicall_3("P_readpaoc", tp_void,
  1200. X                       copyexpr(fex),
  1201. X                       makeexpr_addr(var),
  1202. X                       makeexpr_arglong(ex, 0))));
  1203. X        }
  1204. X            sp = NULL;
  1205. X            spafter = NULL;
  1206. X        } else {
  1207. X            switch (ord_type(var->val.type)->kind) {
  1208. X
  1209. X                case TK_INTEGER:
  1210. X            fmt = "d";
  1211. X            if (curtok == TOK_COLON) {
  1212. X            gettok();
  1213. X            if (curtok == TOK_IDENT &&
  1214. X                !strcicmp(curtokbuf, "HEX")) {
  1215. X                fmt = "x";
  1216. X            } else if (curtok == TOK_IDENT &&
  1217. X                !strcicmp(curtokbuf, "OCT")) {
  1218. X                fmt = "o";
  1219. X            } else if (curtok == TOK_IDENT &&
  1220. X                !strcicmp(curtokbuf, "BIN")) {
  1221. X                fmt = "b";
  1222. X                note("Using %b for binary format in scanf [194]");
  1223. X            } else
  1224. X                warning("Unrecognized format specified in READ [212]");
  1225. X            gettok();
  1226. X            }
  1227. X                    type = findbasetype(var->val.type, 0);
  1228. X                    if (exprlongness(var) > 0)
  1229. X                        ex = makeexpr_string(format_s("%%l%s", fmt));
  1230. X                    else if (type == tp_integer || type == tp_int ||
  1231. X                             type == tp_uint || type == tp_sint)
  1232. X                        ex = makeexpr_string(format_s("%%%s", fmt));
  1233. X                    else if (type == tp_sshort || type == tp_ushort)
  1234. X                        ex = makeexpr_string(format_s("%%h%s", fmt));
  1235. X                    else {
  1236. X                        tvar = makestmttempvar(tp_int, name_TEMP);
  1237. X                        spafter = makestmt_seq(spafter,
  1238. X                                               makestmt_assign(var,
  1239. X                                                               makeexpr_var(tvar)));
  1240. X                        var = makeexpr_var(tvar);
  1241. X                        ex = makeexpr_string(format_s("%%%s", fmt));
  1242. X                    }
  1243. X                    break;
  1244. X
  1245. X                case TK_CHAR:
  1246. X                    ex = makeexpr_string("%c");
  1247. X                    if (newlinespace && !isstrread) {
  1248. X                        spafter = makestmt_seq(spafter,
  1249. X                                               makestmt_if(makeexpr_rel(EK_EQ,
  1250. X                                                                        copyexpr(var),
  1251. X                                                                        makeexpr_char('\n')),
  1252. X                                                           makestmt_assign(copyexpr(var),
  1253. X                                                                           makeexpr_char(' ')),
  1254. X                                                           NULL));
  1255. X                    }
  1256. X                    break;
  1257. X
  1258. X                case TK_BOOLEAN:
  1259. X                    tvar = makestmttempvar(tp_str255, name_STRING);
  1260. X                    spafter = makestmt_seq(spafter,
  1261. X                        makestmt_assign(var,
  1262. X                                        makeexpr_or(makeexpr_rel(EK_EQ,
  1263. X                                                                 makeexpr_hat(makeexpr_var(tvar), 0),
  1264. X                                                                 makeexpr_char('T')),
  1265. X                                                    makeexpr_rel(EK_EQ,
  1266. X                                                                 makeexpr_hat(makeexpr_var(tvar), 0),
  1267. X                                                                 makeexpr_char('t')))));
  1268. X                    var = makeexpr_var(tvar);
  1269. X                    ex = makeexpr_string(" %[a-zA-Z]");
  1270. X                    break;
  1271. X
  1272. X                case TK_ENUM:
  1273. X                    warning("READ on enumerated types not yet supported [213]");
  1274. X                    if (useenum)
  1275. X                        ex = makeexpr_string("%d");
  1276. X                    else
  1277. X                        ex = makeexpr_string("%hd");
  1278. X                    break;
  1279. X
  1280. X                case TK_REAL:
  1281. X                    ex = makeexpr_string("%lg");
  1282. X                    break;
  1283. X
  1284. X                case TK_STRING:     /* strread only */
  1285. X                    ex = makeexpr_string(format_d("%%%dc", strmax(fex)));
  1286. X                    break;
  1287. X
  1288. X                case TK_ARRAY:      /* strread only */
  1289. X                    if (!ord_range(ex->val.type->indextype, &rmin, &rmax)) {
  1290. X                        rmin = 1;
  1291. X                        rmax = 1;
  1292. X                        note("Can't determine length of packed array of chars [195]");
  1293. X                    }
  1294. X                    ex = makeexpr_string(format_d("%%%ldc", rmax-rmin+1));
  1295. X                    break;
  1296. X
  1297. X                default:
  1298. X                    note("Element has wrong type for WRITE statement [196]");
  1299. X                    ex = NULL;
  1300. X                    break;
  1301. X
  1302. X            }
  1303. X            if (ex) {
  1304. X                var = makeexpr_addr(var);
  1305. X                if (sp) {
  1306. X                    sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0], ex, 0);
  1307. X                    insertarg(&sp->exp1, sp->exp1->nargs, var);
  1308. X                } else {
  1309. X                    sp = makestmt_call(makeexpr_bicall_2("scanf", tp_int, ex, var));
  1310. X                }
  1311. X            }
  1312. X        }
  1313. X        if (curtok == TOK_COMMA) {
  1314. X            gettok();
  1315. X            var = p_expr(NULL);
  1316. X        } else
  1317. X            break;
  1318. X    }
  1319. X    if (sp) {
  1320. X        if (isstrread && !FCheck(checkreadformat) &&
  1321. X            ((i=0, checkstring(sp->exp1->args[0], "%d")) ||
  1322. X             (i++, checkstring(sp->exp1->args[0], "%ld")) ||
  1323. X             (i++, checkstring(sp->exp1->args[0], "%hd")) ||
  1324. X             (i++, checkstring(sp->exp1->args[0], "%lg")))) {
  1325. X            if (fullstrread != 0 && exj) {
  1326. X                tvar = makestmttempvar(tp_strptr, name_STRING);
  1327. X                sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
  1328. X                                           (i == 3) ? makeexpr_bicall_2("strtod", tp_longreal,
  1329. X                                                                        copyexpr(fex),
  1330. X                                                                        makeexpr_addr(makeexpr_var(tvar)))
  1331. X                                                    : makeexpr_bicall_3("strtol", tp_integer,
  1332. X                                                                        copyexpr(fex),
  1333. X                                                                        makeexpr_addr(makeexpr_var(tvar)),
  1334. X                                                                        makeexpr_long(10)));
  1335. X        spafter = makestmt_seq(spafter,
  1336. X                       makestmt_assign(copyexpr(exj),
  1337. X                               makeexpr_minus(makeexpr_var(tvar),
  1338. X                                      makeexpr_addr(copyexpr(fex)))));
  1339. X            } else {
  1340. X                sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
  1341. X                                           makeexpr_bicall_1((i == 1) ? "atol" : (i == 3) ? "atof" : "atoi",
  1342. X                                                             (i == 1) ? tp_integer : (i == 3) ? tp_longreal : tp_int,
  1343. X                                                             copyexpr(fex)));
  1344. X            }
  1345. X        } else if (isstrread && fullstrread != 0 && exj) {
  1346. X            sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
  1347. X                                                makeexpr_string(sizeof_int >= 32 ? "%n" : "%ln"), 0);
  1348. X            insertarg(&sp->exp1, sp->exp1->nargs, makeexpr_addr(copyexpr(exj)));
  1349. X        } else if (isreadln && scanfmode && !FCheck(checkreadformat)) {
  1350. X            isreadln = 0;
  1351. X            sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
  1352. X                                                makeexpr_string("%*[^\n]"), 0);
  1353. X            spafter = makestmt_seq(makestmt_call(makegetchar(fex)), spafter);
  1354. X        }
  1355. X        spbase = makestmt_seq(spbase, fixscanf(sp, fex));
  1356. X    }
  1357. X    spbase = makestmt_seq(spbase, spafter);
  1358. X    if (isreadln)
  1359. X        spbase = makestmt_seq(spbase, skipeoln(fex));
  1360. X    return spbase;
  1361. X}
  1362. X
  1363. X
  1364. X
  1365. XStatic Stmt *handleread_bin(fex, var)
  1366. XExpr *fex, *var;
  1367. X{
  1368. X    Type *basetype;
  1369. X    Stmt *sp;
  1370. X    Expr *ex, *tvardef = NULL;
  1371. X
  1372. X    sp = NULL;
  1373. X    basetype = fex->val.type->basetype->basetype;
  1374. X    for (;;) {
  1375. X        ex = makeexpr_bicall_4("fread", tp_integer, makeexpr_addr(var),
  1376. X                                                    makeexpr_sizeof(makeexpr_type(basetype), 0),
  1377. X                                                    makeexpr_long(1),
  1378. X                                                    copyexpr(fex));
  1379. X        if (checkeof(fex)) {
  1380. X            ex = makeexpr_bicall_2("~SETIO", tp_void,
  1381. X                                   makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
  1382. X                   makeexpr_name(endoffilename, tp_int));
  1383. X        }
  1384. X        sp = makestmt_seq(sp, makestmt_call(ex));
  1385. X        if (curtok == TOK_COMMA) {
  1386. X            gettok();
  1387. X            var = p_expr(NULL);
  1388. X        } else
  1389. X            break;
  1390. X    }
  1391. X    freeexpr(tvardef);
  1392. X    return sp;
  1393. X}
  1394. X
  1395. X
  1396. X
  1397. XStatic Stmt *proc_read()
  1398. X{
  1399. X    Expr *fex, *ex;
  1400. X    Stmt *sp;
  1401. X
  1402. X    if (!skipopenparen())
  1403. X    return NULL;
  1404. X    ex = p_expr(NULL);
  1405. X    if (isfiletype(ex->val.type) && wneedtok(TOK_COMMA)) {
  1406. X        fex = ex;
  1407. X        ex = p_expr(NULL);
  1408. X    } else {
  1409. X        fex = makeexpr_var(mp_input);
  1410. X    }
  1411. X    if (fex->val.type == tp_text)
  1412. X        sp = handleread_text(fex, ex, 0);
  1413. X    else
  1414. X        sp = handleread_bin(fex, ex);
  1415. X    skipcloseparen();
  1416. X    return wrapopencheck(sp, fex);
  1417. X}
  1418. X
  1419. X
  1420. X
  1421. XStatic Stmt *proc_readdir()
  1422. X{
  1423. X    Expr *fex, *ex;
  1424. X    Stmt *sp;
  1425. X
  1426. X    if (!skipopenparen())
  1427. X    return NULL;
  1428. X    fex = p_expr(tp_text);
  1429. X    if (!skipcomma())
  1430. X    return NULL;
  1431. X    ex = p_expr(tp_integer);
  1432. X    sp = doseek(fex, ex);
  1433. X    if (!skipopenparen())
  1434. X    return sp;
  1435. X    sp = makestmt_seq(sp, handleread_bin(fex, p_expr(NULL)));
  1436. X    skipcloseparen();
  1437. X    return wrapopencheck(sp, fex);
  1438. X}
  1439. X
  1440. X
  1441. X
  1442. XStatic Stmt *proc_readln()
  1443. X{
  1444. X    Expr *fex, *ex;
  1445. X    Stmt *sp;
  1446. X
  1447. X    if (curtok != TOK_LPAR) {
  1448. X        fex = makeexpr_var(mp_input);
  1449. X        return wrapopencheck(skipeoln(copyexpr(fex)), fex);
  1450. X    } else {
  1451. X        gettok();
  1452. X        ex = p_expr(NULL);
  1453. X        if (isfiletype(ex->val.type)) {
  1454. X            fex = ex;
  1455. X            if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) {
  1456. X                skippasttotoken(TOK_RPAR, TOK_SEMI);
  1457. X                return wrapopencheck(skipeoln(copyexpr(fex)), fex);
  1458. X            } else {
  1459. X                ex = p_expr(NULL);
  1460. X            }
  1461. X        } else {
  1462. X            fex = makeexpr_var(mp_input);
  1463. X        }
  1464. X        sp = handleread_text(fex, ex, 1);
  1465. X        skipcloseparen();
  1466. X    }
  1467. X    return wrapopencheck(sp, fex);
  1468. X}
  1469. X
  1470. X
  1471. X
  1472. XStatic Stmt *proc_readv()
  1473. X{
  1474. X    Expr *vex;
  1475. X    Stmt *sp;
  1476. X
  1477. X    if (!skipopenparen())
  1478. X    return NULL;
  1479. X    vex = p_expr(tp_str255);
  1480. X    if (!skipcomma())
  1481. X    return NULL;
  1482. X    sp = handleread_text(vex, NULL, 0);
  1483. X    skipcloseparen();
  1484. X    return sp;
  1485. X}
  1486. X
  1487. X
  1488. X
  1489. XStatic Stmt *proc_strread()
  1490. X{
  1491. X    Expr *vex, *exi, *exj, *exjj, *ex;
  1492. X    Stmt *sp, *sp2;
  1493. X    Meaning *tvar, *jvar;
  1494. X
  1495. X    if (!skipopenparen())
  1496. X    return NULL;
  1497. X    vex = p_expr(tp_str255);
  1498. X    if (vex->kind != EK_VAR) {
  1499. X        tvar = makestmttempvar(tp_str255, name_STRING);
  1500. X        sp = makestmt_assign(makeexpr_var(tvar), vex);
  1501. X        vex = makeexpr_var(tvar);
  1502. X    } else
  1503. X        sp = NULL;
  1504. X    if (!skipcomma())
  1505. X    return NULL;
  1506. X    exi = p_expr(tp_integer);
  1507. X    if (!skipcomma())
  1508. X    return NULL;
  1509. X    exj = p_expr(tp_integer);
  1510. X    if (!skipcomma())
  1511. X    return NULL;
  1512. X    if (exprspeed(exi) >= 5 || !nosideeffects(exi, 0)) {
  1513. X        sp = makestmt_seq(sp, makestmt_assign(copyexpr(exj), exi));
  1514. X        exi = copyexpr(exj);
  1515. X    }
  1516. X    if (fullstrread != 0 &&
  1517. X        ((ex = singlevar(exj)) == NULL || exproccurs(exi, ex))) {
  1518. X        jvar = makestmttempvar(exj->val.type, name_TEMP);
  1519. X        exjj = makeexpr_var(jvar);
  1520. X    } else {
  1521. X        exjj = copyexpr(exj);
  1522. X        jvar = (exj->kind == EK_VAR) ? (Meaning *)exj->val.i : NULL;
  1523. X    }
  1524. X    sp2 = handleread_text(bumpstring(copyexpr(vex),
  1525. X                                     copyexpr(exi), 1),
  1526. X                          exjj, 0);
  1527. X    sp = makestmt_seq(sp, sp2);
  1528. X    skipcloseparen();
  1529. X    if (fullstrread == 0) {
  1530. X        sp = makestmt_seq(sp, makestmt_assign(exj,
  1531. X                                              makeexpr_plus(makeexpr_bicall_1("strlen", tp_int,
  1532. X                                                                              vex),
  1533. X                                                            makeexpr_long(1))));
  1534. X        freeexpr(exjj);
  1535. X        freeexpr(exi);
  1536. X    } else {
  1537. X        sp = makestmt_seq(sp, makestmt_assign(exj,
  1538. X                                              makeexpr_plus(exjj, exi)));
  1539. X        if (fullstrread == 2)
  1540. X            note("STRREAD was used [197]");
  1541. X        freeexpr(vex);
  1542. X    }
  1543. X    return mixassignments(sp, jvar);
  1544. X}
  1545. X
  1546. X
  1547. X
  1548. X
  1549. XStatic Expr *func_random()
  1550. X{
  1551. X    Expr *ex;
  1552. X
  1553. X    if (curtok == TOK_LPAR) {
  1554. X        gettok();
  1555. X        ex = p_expr(tp_integer);
  1556. X        skipcloseparen();
  1557. X        return makeexpr_bicall_1(randintname, tp_integer, makeexpr_arglong(ex, 1));
  1558. X    } else {
  1559. X        return makeexpr_bicall_0(randrealname, tp_longreal);
  1560. X    }
  1561. X}
  1562. X
  1563. X
  1564. X
  1565. XStatic Stmt *proc_randomize()
  1566. X{
  1567. X    if (*randomizename)
  1568. X        return makestmt_call(makeexpr_bicall_0(randomizename, tp_void));
  1569. X    else
  1570. X        return NULL;
  1571. X}
  1572. X
  1573. X
  1574. X
  1575. XStatic Expr *func_round(ex)
  1576. XExpr *ex;
  1577. X{
  1578. X    Meaning *tvar;
  1579. X
  1580. X    ex = grabarg(ex, 0);
  1581. X    if (ex->val.type->kind != TK_REAL)
  1582. X    return ex;
  1583. X    if (*roundname) {
  1584. X        if (*roundname != '*' || (exprspeed(ex) < 5 && nosideeffects(ex, 0))) {
  1585. X            return makeexpr_bicall_1(roundname, tp_integer, ex);
  1586. X        } else {
  1587. X            tvar = makestmttempvar(tp_longreal, name_TEMP);
  1588. X            return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex),
  1589. X                                  makeexpr_bicall_1(roundname, tp_integer, makeexpr_var(tvar)));
  1590. X        }
  1591. X    } else {
  1592. X        return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
  1593. X                          makeexpr_plus(ex, makeexpr_real("0.5"))),
  1594. X                                tp_integer);
  1595. X    }
  1596. X}
  1597. X
  1598. X
  1599. X
  1600. XStatic Expr *func_uround(ex)
  1601. XExpr *ex;
  1602. X{
  1603. X    ex = grabarg(ex, 0);
  1604. X    if (ex->val.type->kind != TK_REAL)
  1605. X    return ex;
  1606. X    return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
  1607. X                          makeexpr_plus(ex, makeexpr_real("0.5"))),
  1608. X                tp_unsigned);
  1609. X}
  1610. X
  1611. X
  1612. X
  1613. XStatic Expr *func_scan()
  1614. X{
  1615. X    Expr *ex, *ex2, *ex3;
  1616. X    char *name;
  1617. X
  1618. X    if (!skipopenparen())
  1619. X    return NULL;
  1620. X    ex = p_expr(tp_integer);
  1621. X    if (!skipcomma())
  1622. X    return NULL;
  1623. X    if (curtok == TOK_EQ)
  1624. X    name = "P_scaneq";
  1625. X    else 
  1626. X    name = "P_scanne";
  1627. X    gettok();
  1628. X    ex2 = p_expr(tp_char);
  1629. X    if (!skipcomma())
  1630. X    return NULL;
  1631. X    ex3 = p_expr(tp_str255);
  1632. X    skipcloseparen();
  1633. X    return makeexpr_bicall_3(name, tp_int,
  1634. X                 makeexpr_arglong(ex, 0),
  1635. X                 makeexpr_charcast(ex2), ex3);
  1636. X}
  1637. X
  1638. X
  1639. X
  1640. XStatic Expr *func_scaneq(ex)
  1641. XExpr *ex;
  1642. X{
  1643. X    return makeexpr_bicall_3("P_scaneq", tp_int,
  1644. X                 makeexpr_arglong(ex->args[0], 0),
  1645. X                 makeexpr_charcast(ex->args[1]),
  1646. X                 ex->args[2]);
  1647. X}
  1648. X
  1649. X
  1650. XStatic Expr *func_scanne(ex)
  1651. XExpr *ex;
  1652. X{
  1653. X    return makeexpr_bicall_3("P_scanne", tp_int,
  1654. X                 makeexpr_arglong(ex->args[0], 0),
  1655. X                 makeexpr_charcast(ex->args[1]),
  1656. X                 ex->args[2]);
  1657. X}
  1658. X
  1659. X
  1660. X
  1661. XStatic Stmt *proc_seek()
  1662. X{
  1663. X    Expr *fex, *ex;
  1664. X    Stmt *sp;
  1665. X
  1666. X    if (!skipopenparen())
  1667. X    return NULL;
  1668. X    fex = p_expr(tp_text);
  1669. X    if (!skipcomma())
  1670. X    return NULL;
  1671. X    ex = p_expr(tp_integer);
  1672. X    skipcloseparen();
  1673. X    sp = wrapopencheck(doseek(fex, ex), copyexpr(fex));
  1674. X    if (*setupbufname && isfilevar(fex))
  1675. X    sp = makestmt_seq(sp,
  1676. X         makestmt_call(
  1677. X             makeexpr_bicall_2(setupbufname, tp_void, fex,
  1678. X             makeexpr_type(fex->val.type->basetype->basetype))));
  1679. X    else
  1680. X    freeexpr(fex);
  1681. X    return sp;
  1682. X}
  1683. X
  1684. X
  1685. X
  1686. XStatic Expr *func_seekeof()
  1687. X{
  1688. X    Expr *ex;
  1689. X
  1690. X    if (curtok == TOK_LPAR)
  1691. X        ex = p_parexpr(tp_text);
  1692. X    else
  1693. X        ex = makeexpr_var(mp_input);
  1694. X    if (*skipspacename)
  1695. X        ex = makeexpr_bicall_1(skipspacename, tp_text, ex);
  1696. X    else
  1697. X        note("SEEKEOF was used [198]");
  1698. X    return iofunc(ex, 0);
  1699. X}
  1700. X
  1701. X
  1702. X
  1703. XStatic Expr *func_seekeoln()
  1704. X{
  1705. X    Expr *ex;
  1706. X
  1707. X    if (curtok == TOK_LPAR)
  1708. X        ex = p_parexpr(tp_text);
  1709. X    else
  1710. X        ex = makeexpr_var(mp_input);
  1711. X    if (*skipspacename)
  1712. X        ex = makeexpr_bicall_1(skipspacename, tp_text, ex);
  1713. X    else
  1714. X        note("SEEKEOLN was used [199]");
  1715. X    return iofunc(ex, 1);
  1716. X}
  1717. X
  1718. X
  1719. X
  1720. XStatic Stmt *proc_setstrlen()
  1721. X{
  1722. X    Expr *ex, *ex2;
  1723. X
  1724. X    if (!skipopenparen())
  1725. X    return NULL;
  1726. X    ex = p_expr(tp_str255);
  1727. X    if (!skipcomma())
  1728. X    return NULL;
  1729. X    ex2 = p_expr(tp_integer);
  1730. X    skipcloseparen();
  1731. X    return makestmt_assign(makeexpr_bicall_1("strlen", tp_int, ex),
  1732. X                           ex2);
  1733. X}
  1734. X
  1735. X
  1736. X
  1737. XStatic Stmt *proc_settextbuf()
  1738. X{
  1739. X    Expr *fex, *bex, *sex;
  1740. X
  1741. X    if (!skipopenparen())
  1742. X    return NULL;
  1743. X    fex = p_expr(tp_text);
  1744. X    if (!skipcomma())
  1745. X    return NULL;
  1746. X    bex = p_expr(NULL);
  1747. X    if (curtok == TOK_COMMA) {
  1748. X        gettok();
  1749. X        sex = p_expr(tp_integer);
  1750. X    } else
  1751. X        sex = makeexpr_sizeof(copyexpr(bex), 0);
  1752. X    skipcloseparen();
  1753. X    note("Make sure setvbuf() call occurs when file is open [200]");
  1754. X    return makestmt_call(makeexpr_bicall_4("setvbuf", tp_void,
  1755. X                                           fex,
  1756. X                                           makeexpr_addr(bex),
  1757. X                                           makeexpr_name("_IOFBF", tp_integer),
  1758. X                                           sex));
  1759. X}
  1760. X
  1761. X
  1762. X
  1763. XStatic Expr *func_sin(ex)
  1764. XExpr *ex;
  1765. X{
  1766. X    return makeexpr_bicall_1("sin", tp_longreal, grabarg(ex, 0));
  1767. X}
  1768. X
  1769. X
  1770. XStatic Expr *func_sinh(ex)
  1771. XExpr *ex;
  1772. X{
  1773. X    return makeexpr_bicall_1("sinh", tp_longreal, grabarg(ex, 0));
  1774. X}
  1775. X
  1776. X
  1777. X
  1778. XStatic Expr *func_sizeof()
  1779. X{
  1780. X    Expr *ex;
  1781. X    Type *type;
  1782. X    char *name, vbuf[1000];
  1783. X    int lpar;
  1784. X
  1785. X    lpar = (curtok == TOK_LPAR);
  1786. X    if (lpar)
  1787. X    gettok();
  1788. X    if (curtok == TOK_IDENT && curtokmeaning && curtokmeaning->kind == MK_TYPE) {
  1789. X        ex = makeexpr_type(curtokmeaning->type);
  1790. X        gettok();
  1791. X    } else
  1792. X        ex = p_expr(NULL);
  1793. X    type = ex->val.type;
  1794. X    parse_special_variant(type, vbuf);
  1795. X    if (lpar)
  1796. X    skipcloseparen();
  1797. X    name = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
  1798. X    if (name) {
  1799. X    freeexpr(ex);
  1800. X    return pc_expr_str(name);
  1801. X    } else
  1802. X    return makeexpr_sizeof(ex, 0);
  1803. X}
  1804. X
  1805. X
  1806. X
  1807. XStatic Expr *func_statusv()
  1808. X{
  1809. X    return makeexpr_name(name_IORESULT, tp_integer);
  1810. X}
  1811. X
  1812. X
  1813. X
  1814. XStatic Expr *func_str_hp(ex)
  1815. XExpr *ex;
  1816. X{
  1817. X    return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1], 
  1818. X                                            ex->args[2], ex->args[3]));
  1819. X}
  1820. X
  1821. X
  1822. X
  1823. XStatic Stmt *proc_strappend()
  1824. X{
  1825. X    Expr *ex, *ex2;
  1826. X
  1827. X    if (!skipopenparen())
  1828. X    return NULL;
  1829. X    ex = p_expr(tp_str255);
  1830. X    if (!skipcomma())
  1831. X    return NULL;
  1832. END_OF_FILE
  1833. if test 48594 -ne `wc -c <'src/funcs.c.2'`; then
  1834.     echo shar: \"'src/funcs.c.2'\" unpacked with wrong size!
  1835. fi
  1836. # end of 'src/funcs.c.2'
  1837. fi
  1838. echo shar: End of archive 22 \(of 32\).
  1839. cp /dev/null ark22isdone
  1840. MISSING=""
  1841. for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do
  1842.     if test ! -f ark${I}isdone ; then
  1843.     MISSING="${MISSING} ${I}"
  1844.     fi
  1845. done
  1846. if test "${MISSING}" = "" ; then
  1847.     echo You have unpacked all 32 archives.
  1848.     echo "Now see PACKNOTES and the README"
  1849.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1850. else
  1851.     echo You still need to unpack the following archives:
  1852.     echo "        " ${MISSING}
  1853. fi
  1854. ##  End of shell archive.
  1855. exit 0
  1856.