shim.c 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939
  1. /* m2compiler-V3 runtime shim (C).
  2. *
  3. * Bridges Modula-2 external procedures to the host. Memory layout
  4. * matches the compiler's: a STRING (ARRAY OF CHAR) value is a
  5. * descriptor [0] = LONGCARD element count, then the bytes; the
  6. * compiler passes the descriptor's address as an `l`.
  7. *
  8. * Linked with every V3 program image.
  9. */
  10. #define _GNU_SOURCE
  11. #include <unistd.h>
  12. #include <stdlib.h>
  13. #include <stdio.h>
  14. #include <string.h>
  15. #include <time.h>
  16. #include <ucontext.h>
  17. /* Write the contents of a string descriptor to fd 1. Returns the
  18. number of bytes written. */
  19. long m2write(long *desc)
  20. {
  21. /* desc[0] is the capacity; the string is NUL-terminated. */
  22. char *s = (char *)(desc + 1);
  23. size_t n = strnlen(s, (size_t)desc[0] + 1);
  24. if (n > 0)
  25. write(1, s, n);
  26. return (long)n;
  27. }
  28. /* Write a newline to fd 1. */
  29. long m2writeln(void)
  30. {
  31. write(1, "\n", 1);
  32. return 0;
  33. }
  34. /* Read one character from stdin (0 at EOF). */
  35. long m2readchar(void)
  36. {
  37. int c = getchar();
  38. return (c == EOF) ? 0 : c;
  39. }
  40. /* Read a signed decimal integer from stdin, skipping leading
  41. whitespace. The first non-digit after the number is consumed. */
  42. long m2readint(void)
  43. {
  44. long v = 0;
  45. int c;
  46. int neg = 0;
  47. do { c = getchar(); } while (c == ' ' || c == '\t' ||
  48. c == '\n' || c == '\r');
  49. if (c == '-') { neg = 1; c = getchar(); }
  50. while (c >= '0' && c <= '9') {
  51. v = v * 10 + (c - '0');
  52. c = getchar();
  53. }
  54. return neg ? -v : v;
  55. }
  56. /* ---------------- sequential files (stdio) ---------------- */
  57. /* Copy a descriptor string into a NUL-terminated buffer. */
  58. static void m2cstr(long *desc, char *buf, size_t cap)
  59. {
  60. char *s = (char *)(desc + 1);
  61. size_t n = strnlen(s, (size_t)desc[0] + 1);
  62. if (n >= cap) n = cap - 1;
  63. if (n > 0) memcpy(buf, s, n);
  64. buf[n] = 0;
  65. }
  66. long m2fopenread(long *desc)
  67. {
  68. char buf[4096];
  69. m2cstr(desc, buf, sizeof buf);
  70. return (long)fopen(buf, "r");
  71. }
  72. long m2fopenwrite(long *desc)
  73. {
  74. char buf[4096];
  75. m2cstr(desc, buf, sizeof buf);
  76. return (long)fopen(buf, "w");
  77. }
  78. long m2fclose(long h)
  79. {
  80. if (h != 0) fclose((FILE *)h);
  81. return 0;
  82. }
  83. /* A handle of 0 means the open failed (Modula-2 NIL). Every file
  84. operation degrades to a safe no-op instead of dereferencing NULL. */
  85. long m2fgetc(long h)
  86. {
  87. int c;
  88. if (h == 0) return 0;
  89. c = fgetc((FILE *)h);
  90. return (c == EOF) ? 0 : c;
  91. }
  92. long m2fputc(long h, long c)
  93. {
  94. if (h != 0) fputc((int)c, (FILE *)h);
  95. return 0;
  96. }
  97. long m2fputs(long h, long *desc)
  98. {
  99. char *s = (char *)(desc + 1);
  100. size_t n = strnlen(s, (size_t)desc[0] + 1);
  101. if (h == 0) return 0;
  102. if (n > 0) fwrite(s, 1, n, (FILE *)h);
  103. return (long)n;
  104. }
  105. long m2freadint(long h)
  106. {
  107. long v = 0;
  108. int c, neg = 0;
  109. if (h == 0) return 0;
  110. do { c = fgetc((FILE *)h); } while (c == ' ' || c == '\t' ||
  111. c == '\n' || c == '\r');
  112. if (c == '-') { neg = 1; c = fgetc((FILE *)h); }
  113. while (c >= '0' && c <= '9') {
  114. v = v * 10 + (c - '0');
  115. c = fgetc((FILE *)h);
  116. }
  117. return neg ? -v : v;
  118. }
  119. long m2fwriteint(long h, long v)
  120. {
  121. char buf[32];
  122. int i = 0, neg = 0;
  123. unsigned long u;
  124. if (h == 0) return 0;
  125. if (v < 0) { neg = 1; u = (unsigned long)(-v); }
  126. else u = (unsigned long)v;
  127. do { buf[i++] = (char)('0' + u % 10); u /= 10; } while (u != 0);
  128. if (neg) buf[i++] = '-';
  129. while (i > 0) fputc(buf[--i], (FILE *)h);
  130. return 0;
  131. }
  132. long m2fwriteln(long h)
  133. {
  134. if (h != 0) fputc('\n', (FILE *)h);
  135. return 0;
  136. }
  137. /* Read one line (up to and including '\n', or EOF) into the
  138. descriptor's data area, dropping the newline; NUL-terminated.
  139. The descriptor's capacity header is left intact (so a caller may
  140. keep using HIGH), and the number of bytes stored is returned.
  141. `max` is declared `int`: Modula-2 CARDINAL arguments arrive in a
  142. 32-bit register (QBE `w`), so only the low 32 bits are defined. */
  143. long m2freadline(long h, long *desc, int max)
  144. {
  145. char *dst = (char *)(desc + 1);
  146. long n = 0;
  147. int c;
  148. if (max < 0) max = 0;
  149. if (h == 0) { if (max > 0) dst[0] = 0; return 0; }
  150. while (n < max) {
  151. c = fgetc((FILE *)h);
  152. if (c == EOF) break;
  153. if (c == '\n') break;
  154. if (c == '\r') continue;
  155. dst[n++] = (char)c;
  156. }
  157. dst[n] = 0;
  158. return n;
  159. }
  160. /* Bulk read: up to max bytes into the descriptor's data area; the
  161. descriptor's header is set to the number actually read. */
  162. long m2fread(long h, long *desc, long max)
  163. {
  164. long n;
  165. if (max < 0) max = 0;
  166. if (h == 0) { desc[0] = 0; return 0; }
  167. n = (long)fread((char *)(desc + 1), 1, (size_t)max, (FILE *)h);
  168. desc[0] = n;
  169. return n;
  170. }
  171. /* Write a signed integer right-justified in a field of width `wid`.
  172. wid = 0 means exactly one leading space (FileIO convention). */
  173. long m2fwriteintw(long h, long v, long wid)
  174. {
  175. char buf[64];
  176. int n;
  177. if (h == 0) return 0;
  178. if (wid == 0)
  179. n = snprintf(buf, sizeof buf, " %ld", v);
  180. else
  181. n = snprintf(buf, sizeof buf, "%*ld", (int)wid, v);
  182. if (n > 0) fwrite(buf, 1, (size_t)n, (FILE *)h);
  183. return 0;
  184. }
  185. /* Byte offset of the current position in h (-1 on error). */
  186. long m2ftell(long h)
  187. {
  188. if (h == 0) return -1;
  189. return (long)ftell((FILE *)h);
  190. }
  191. /* Seek h to absolute byte offset pos; 1 on success, 0 on failure.
  192. Rewinding also clears the stdio error/EOF state. */
  193. long m2fseek(long h, long pos)
  194. {
  195. if (h == 0) return 0;
  196. if (fseek((FILE *)h, (long)pos, SEEK_SET) != 0) return 0;
  197. clearerr((FILE *)h);
  198. return 1;
  199. }
  200. /* Standard streams as file handles. */
  201. long m2stdout(void) { return (long)stdout; }
  202. long m2stderr(void) { return (long)stderr; }
  203. long m2stdin(void) { return (long)stdin; }
  204. /* Command-line arguments, read from /proc/self/cmdline (Linux). */
  205. static char *m2_args[1024];
  206. static long m2_nargs = -1;
  207. static void m2_argv_init(void)
  208. {
  209. static char cmd[65536];
  210. FILE *f;
  211. long i, n;
  212. int c;
  213. if (m2_nargs >= 0) return;
  214. m2_nargs = 0;
  215. f = fopen("/proc/self/cmdline", "rb");
  216. if (f == NULL) return;
  217. n = (long)fread(cmd, 1, sizeof cmd - 1, f);
  218. fclose(f);
  219. if (n <= 0) return;
  220. cmd[n] = 0;
  221. i = 0;
  222. while (i < n && m2_nargs < 1024) {
  223. while (i < n && cmd[i] == 0) i++; /* skip separators */
  224. if (i >= n) break;
  225. m2_args[m2_nargs++] = &cmd[i];
  226. while (i < n && cmd[i] != 0) i++; /* to end of arg */
  227. }
  228. }
  229. long m2argc(void)
  230. {
  231. m2_argv_init();
  232. return m2_nargs;
  233. }
  234. long m2arg(long i, long *desc, long cap)
  235. {
  236. const char *a;
  237. long n;
  238. m2_argv_init();
  239. if (i < 0 || i >= m2_nargs) { ((char *)(desc + 1))[0] = 0; return 0; }
  240. a = m2_args[i];
  241. n = (long)strlen(a);
  242. if (cap > 0 && n >= cap) n = cap - 1;
  243. if (n < 0) n = 0;
  244. memcpy((char *)(desc + 1), a, (size_t)n);
  245. if (n < cap) ((char *)(desc + 1))[n] = 0; /* NUL terminator */
  246. /* desc[0] (capacity) is left intact: length is derived by scanning */
  247. return 1;
  248. }
  249. /* Set a string descriptor's logical length (header). */
  250. long m2setlen(long *desc, long n)
  251. {
  252. desc[0] = n;
  253. return n;
  254. }
  255. /* Write a single character (byte) to fd 1. */
  256. long m2writechar(long c)
  257. {
  258. char ch = (char)c;
  259. write(1, &ch, 1);
  260. return 0;
  261. }
  262. /* Write a signed decimal integer to fd 1. */
  263. long m2writeint(long v)
  264. {
  265. char buf[32];
  266. int i = 0;
  267. int neg = 0;
  268. unsigned long u;
  269. if (v < 0) { neg = 1; u = (unsigned long)(-v); }
  270. else u = (unsigned long)v;
  271. do { buf[i++] = (char)('0' + (u % 10)); u /= 10; } while (u != 0);
  272. if (neg) buf[i++] = '-';
  273. while (i > 0)
  274. write(1, &buf[--i], 1);
  275. return 0;
  276. }
  277. /* Terminate the process. */
  278. long m2exit(long code)
  279. {
  280. exit((int)code);
  281. return 0;
  282. }
  283. /* ---------------- clock (SysClock) ---------------- */
  284. /* Wall-clock time in seconds since the Unix epoch. */
  285. long m2time(void)
  286. {
  287. return (long)time(NULL);
  288. }
  289. /* Processor time used so far, in clock ticks (CLOCKS_PER_SEC per
  290. second). The scaling is exposed as a constant by SysClock. */
  291. long m2clock(void)
  292. {
  293. return (long)clock();
  294. }
  295. /* String content equality: 1 when the NUL-terminated contents of the
  296. two descriptors match. */
  297. long m2streq(long *a, long *b)
  298. {
  299. return (strcmp((char *)(a + 1), (char *)(b + 1)) == 0) ? 1 : 0;
  300. }
  301. /* Number of characters before the NUL. */
  302. long m2strlen(long *s)
  303. {
  304. return (long)strlen((char *)(s + 1));
  305. }
  306. /* UString length: the codepoint count is the descriptor's header. */
  307. long m2ustrlen(long *s)
  308. {
  309. return s[0];
  310. }
  311. /* Build a 1-codepoint UString descriptor from a UCHAR value; returns
  312. its address. A small rotating pool lets an expression supply both
  313. operands to m2ustrcat before it reads them. */
  314. long m2ustrfrom(long cp)
  315. {
  316. static struct { long count; int cp; } pool[16];
  317. static int next = 0;
  318. long *d = (long *)&pool[next];
  319. pool[next].count = 1;
  320. pool[next].cp = (int)cp;
  321. next = (next + 1) & 15;
  322. return (long)d;
  323. }
  324. /* Concatenate two UString descriptors into a static buffer; returns
  325. the result descriptor address. The value is valid until the next
  326. m2ustrcat call. */
  327. long m2ustrcat(long *a, long *b)
  328. {
  329. static struct { long count; int cp[4096]; } buf;
  330. int *pa = (int *)(a + 1);
  331. int *pb = (int *)(b + 1);
  332. long na = a[0], nb = b[0], i;
  333. if (na < 0) na = 0;
  334. if (nb < 0) nb = 0;
  335. if (na > 4096) na = 4096;
  336. if (nb > 4096 - na) nb = 4096 - na;
  337. for (i = 0; i < na; i++) buf.cp[i] = pa[i];
  338. for (i = 0; i < nb; i++) buf.cp[na + i] = pb[i];
  339. buf.count = na + nb;
  340. return (long)&buf;
  341. }
  342. /* Copy a UString descriptor (count + 4-byte codepoints) into the
  343. UCHAR array at dst (capacity dst[0]): min(count, capacity)
  344. codepoints, followed by a 0 codepoint terminator. Returns the
  345. number of codepoints copied. */
  346. long m2uassign(long *dst, long *src)
  347. {
  348. /* Both descriptors are { l count, w codepoints... }: the header is
  349. 64-bit, each codepoint is 32-bit. */
  350. int *d = (int *)(dst + 1);
  351. int *s = (int *)(src + 1);
  352. long cap = dst[0];
  353. long n = src[0];
  354. long i;
  355. if (cap < 0) cap = 0;
  356. if (n > cap) n = cap;
  357. for (i = 0; i < n; i++) d[i] = s[i];
  358. d[n] = 0;
  359. return n;
  360. }
  361. /* Copy the content of src into the CHAR array at dst (capacity
  362. dst[0]); truncated to fit and NUL-terminated. A CHAR array has
  363. `cap` content slots plus a reserved terminator slot at index `cap`,
  364. so up to `cap` characters fit. Returns the length copied. */
  365. long m2strassign(long *dst, long *src)
  366. {
  367. char *d = (char *)(dst + 1);
  368. const char *s = (const char *)(src + 1);
  369. long cap = dst[0];
  370. size_t n;
  371. if (cap < 0) return 0;
  372. n = strlen(s);
  373. if (n > (size_t)cap) n = (size_t)cap;
  374. memmove(d, s, n);
  375. d[n] = 0;
  376. return (long)n;
  377. }
  378. /* Concatenate two string descriptors into a static buffer; returns the
  379. result descriptor address. The value is valid until the next
  380. m2strcat call (so copy it before concatenating again). */
  381. long m2strcat(long *a, long *b)
  382. {
  383. static struct { long count; char data[8192]; } buf;
  384. const char *sa = (const char *)(a + 1);
  385. const char *sb = (const char *)(b + 1);
  386. size_t na = strlen(sa), nb = strlen(sb);
  387. if (na > sizeof buf.data - 1) na = sizeof buf.data - 1;
  388. if (nb > sizeof buf.data - 1 - na)
  389. nb = sizeof buf.data - 1 - na;
  390. memmove(buf.data, sa, na);
  391. memmove(buf.data + na, sb, nb);
  392. buf.data[na + nb] = 0;
  393. buf.count = (long)(na + nb);
  394. return (long)&buf;
  395. }
  396. /* ---------------- reals (Conversions / RealIO) ---------------- */
  397. /* Format a REAL into a descriptor string (6 significant digits,
  398. scientific). desc[0] is the capacity; on return it holds the
  399. length. Returns the number of characters written. */
  400. long m2realstr(double x, long *desc)
  401. {
  402. char buf[64];
  403. char *dst = (char *)(desc + 1);
  404. long cap = desc[0];
  405. int n = snprintf(buf, sizeof buf, "%.6E", x);
  406. if (n < 0) n = 0;
  407. if (cap > 0 && n >= (int)cap) n = (int)cap - 1;
  408. if (n > 0) memcpy(dst, buf, (size_t)n);
  409. if (cap > 0) { dst[n] = 0; desc[0] = n; }
  410. return (long)n;
  411. }
  412. /* Parse a REAL from a descriptor string; *ok := 1 on success. */
  413. double m2strreal(long *desc, long *ok)
  414. {
  415. char buf[4096];
  416. char *end;
  417. double v;
  418. m2cstr(desc, buf, sizeof buf);
  419. v = strtod(buf, &end);
  420. while (*end == ' ' || *end == '\t' || *end == '\n' || *end == '\r') end++;
  421. *ok = (end != buf && *end == 0) ? 1 : 0;
  422. return v;
  423. }
  424. /* Write a REAL right-justified in a field of width `wid` (0 => one
  425. leading space), matching the integer convention. */
  426. long m2writerealf(double x, long wid)
  427. {
  428. char buf[128];
  429. int n;
  430. if (wid == 0)
  431. n = snprintf(buf, sizeof buf, "%.6E", x);
  432. else
  433. n = snprintf(buf, sizeof buf, "%*.*E", (int)wid, 6, x);
  434. if (n > 0) write(1, buf, (size_t)n);
  435. return 0;
  436. }
  437. long m2writereal(double x)
  438. {
  439. return m2writerealf(x, 0);
  440. }
  441. /* Read a REAL from stdin. */
  442. double m2readreal(void)
  443. {
  444. double v = 0.0;
  445. if (scanf("%lf", &v) != 1) v = 0.0;
  446. return v;
  447. }
  448. /* ---------------- PIM coroutines (SYSTEM.NEWPROCESS/TRANSFER/...) --------
  449. *
  450. * A PROCESS is a pointer to a ucontext_t. NEWPROCESS builds a context
  451. * over the caller-supplied workspace; TRANSFER saves the running
  452. * context into *a and resumes *b. Coroutine bodies are compiled with a
  453. * leading static-link argument; module-level bodies (the usual case for
  454. * NEWPROCESS) take 0. */
  455. void m2_newprocess(void *p, void *workspace, long size, void **c)
  456. {
  457. ucontext_t *uc;
  458. if (c == NULL) return;
  459. uc = (ucontext_t *)malloc(sizeof(ucontext_t));
  460. if (uc == NULL) { *c = NULL; return; }
  461. if (getcontext(uc) != 0) { free(uc); *c = NULL; return; }
  462. uc->uc_stack.ss_sp = workspace;
  463. uc->uc_stack.ss_size = (size_t)size;
  464. uc->uc_link = NULL;
  465. makecontext(uc, (void (*)(void))p, 1, (int)0);
  466. *c = uc;
  467. }
  468. void m2_transfer(void **a, void **b)
  469. {
  470. ucontext_t *save;
  471. ucontext_t *go;
  472. if ((a == NULL) || (b == NULL)) return;
  473. save = (ucontext_t *)*a;
  474. go = (ucontext_t *)*b;
  475. if (go == NULL) return;
  476. if (save == NULL) {
  477. save = (ucontext_t *)malloc(sizeof(ucontext_t));
  478. if (save == NULL) return;
  479. *a = save;
  480. }
  481. swapcontext(save, go);
  482. }
  483. /* IOTRANSFER: without a device-interrupt subsystem this degrades to a
  484. plain transfer to b (classic PIM resumes a when the interrupt
  485. fires). The interrupt number is accepted and ignored. */
  486. void m2_iotransfer(void **a, void **b, long interruptNo)
  487. {
  488. (void)interruptNo;
  489. m2_transfer(a, b);
  490. }
  491. /* ---------------- text-IO library support ---------------- */
  492. /* Read one line from stdin (newline dropped) into the string
  493. descriptor's data area; NUL-terminated. Returns the length. */
  494. long m2readline(long *desc, int max)
  495. {
  496. char *dst = (char *)(desc + 1);
  497. long n = 0;
  498. int c;
  499. if (max < 0) max = 0;
  500. while (n < max) {
  501. c = getchar();
  502. if (c == EOF) break;
  503. if (c == '\n') break;
  504. if (c == '\r') continue;
  505. dst[n++] = (char)c;
  506. }
  507. dst[n] = 0;
  508. return n;
  509. }
  510. /* Write a signed integer right-justified in a field of width `wid`
  511. to fd 1 (wid = 0 => exactly one leading space). */
  512. long m2writeintwidth(long v, int wid)
  513. {
  514. char buf[64];
  515. int n;
  516. if (wid == 0)
  517. n = snprintf(buf, sizeof buf, " %ld", v);
  518. else
  519. n = snprintf(buf, sizeof buf, "%*ld", wid, v);
  520. if (n > 0) write(1, buf, (size_t)n);
  521. return 0;
  522. }
  523. /* Format a REAL into a descriptor: mode 0 = fixed (prec = decimal
  524. places), 1 = floating (prec = significant figures), 2 = engineering
  525. (prec = significant figures, exponent a multiple of three).
  526. desc[0] is the capacity; on return it holds the length. */
  527. static long m2putstr(char *dst, long cap, const char *src)
  528. {
  529. long n = (long)strlen(src);
  530. if (cap <= 0) return 0;
  531. if (n > cap - 1) n = cap - 1;
  532. memcpy(dst, src, (size_t)n);
  533. dst[n] = 0;
  534. return n;
  535. }
  536. long m2realconv(double x, int mode, int prec, long *desc)
  537. {
  538. char buf[256];
  539. char *dst = (char *)(desc + 1);
  540. long cap = desc[0];
  541. int n = 0;
  542. if (prec < 0) prec = 0;
  543. if (prec > 40) prec = 40;
  544. if (mode == 0) {
  545. n = snprintf(buf, sizeof buf, "%.*f", prec, x);
  546. } else if (mode == 1) {
  547. n = snprintf(buf, sizeof buf, "%.*E",
  548. prec > 0 ? prec - 1 : 0, x);
  549. } else {
  550. /* engineering: mantissa in [1,1000), exponent multiple of 3 */
  551. int e;
  552. double m = x;
  553. if (m != 0.0) {
  554. e = 0;
  555. while (m >= 1000.0) { m /= 1000.0; e += 3; }
  556. while (m < 1.0) { m *= 1000.0; e -= 3; }
  557. } else {
  558. e = 0;
  559. }
  560. n = snprintf(buf, sizeof buf, "%.*fE%+d",
  561. prec > 0 ? prec - 1 : 0, m, e);
  562. }
  563. if (n < 0) n = 0;
  564. return m2putstr(dst, cap, buf);
  565. }
  566. /* Termination flags: HALT aborts the image, so neither is ever
  567. observably TRUE; provided so TERMINATION links. */
  568. long m2terminating(void) { return 0; }
  569. long m2hashalted(void) { return 0; }
  570. /* ---------------- DynamicStrings (heap C strings) ----------------
  571. *
  572. * A DynamicStrings.String is a malloc'd NUL-terminated char buffer.
  573. * Procedures that return a String return the buffer address; those
  574. * that take a String receive it in the first `long` argument. */
  575. static char *m2dsdup(const char *s)
  576. {
  577. size_t n;
  578. char *p;
  579. if (s == NULL) s = "";
  580. n = strlen(s);
  581. p = (char *)malloc(n + 1);
  582. if (p == NULL) return NULL;
  583. memcpy(p, s, n + 1);
  584. return p;
  585. }
  586. long m2dsinit(long *a) { return (long)m2dsdup((const char *)(a + 1)); }
  587. long m2dskill(char *s) { free(s); return 0; }
  588. long m2dslength(const char *s) { return s ? (long)strlen(s) : 0; }
  589. long m2dsdupstr(const char *s) { return (long)m2dsdup(s); }
  590. long m2dsconcat(char *a, const char *b)
  591. {
  592. size_t na, nb;
  593. char *p;
  594. if (b == NULL) b = "";
  595. na = a ? strlen(a) : 0;
  596. nb = strlen(b);
  597. p = (char *)realloc(a, na + nb + 1);
  598. if (p == NULL) return (long)a;
  599. memcpy(p + na, b, nb + 1);
  600. return (long)p;
  601. }
  602. long m2dsconcatchar(char *a, int ch)
  603. {
  604. size_t na = a ? strlen(a) : 0;
  605. char *p = (char *)realloc(a, na + 2);
  606. if (p == NULL) return (long)a;
  607. p[na] = (char)ch;
  608. p[na + 1] = 0;
  609. return (long)p;
  610. }
  611. long m2dsassign(char *a, const char *b)
  612. {
  613. size_t nb;
  614. char *p;
  615. if (b == NULL) b = "";
  616. nb = strlen(b);
  617. p = (char *)realloc(a, nb + 1);
  618. if (p == NULL) return (long)a;
  619. memcpy(p, b, nb + 1);
  620. return (long)p;
  621. }
  622. long m2dseq(const char *a, const char *b)
  623. {
  624. if (a == NULL) a = "";
  625. if (b == NULL) b = "";
  626. return strcmp(a, b) == 0;
  627. }
  628. /* EqualArray: the second operand arrives as the *descriptor* of a V3
  629. CHAR-array actual (V3 passes array actuals as their descriptor). */
  630. long m2dseqarr(const char *s, long *a)
  631. {
  632. return m2dseq(s, (const char *)(a + 1));
  633. }
  634. long m2dschar(const char *s, int i)
  635. {
  636. int n;
  637. if (s == NULL) return 0;
  638. n = (int)strlen(s);
  639. if (i < 0) i = n + i;
  640. if (i < 0 || i >= n) return 0;
  641. return (unsigned char)s[i];
  642. }
  643. long m2dscopyout(long *dst, const char *s)
  644. {
  645. char *d = (char *)(dst + 1);
  646. long cap = dst[0];
  647. size_t n;
  648. if (s == NULL) s = "";
  649. n = strlen(s);
  650. if (cap < 0) cap = 0;
  651. if (n > (size_t)cap) n = (size_t)cap;
  652. memcpy(d, s, n);
  653. d[n] = 0;
  654. return (long)n;
  655. }
  656. long m2dsslice(const char *s, int low, int high)
  657. {
  658. int n, lo, hi;
  659. char *p;
  660. if (s == NULL) s = "";
  661. n = (int)strlen(s);
  662. lo = low;
  663. hi = high;
  664. if (lo < 0) lo = n + lo;
  665. if (lo < 0) lo = 0;
  666. if (hi == 0) hi = n;
  667. else if (hi < 0) hi = n + hi;
  668. if (hi > n) hi = n;
  669. if (hi < lo) hi = lo;
  670. p = (char *)malloc((size_t)(hi - lo) + 1);
  671. if (p == NULL) return 0;
  672. memcpy(p, s + lo, (size_t)(hi - lo));
  673. p[hi - lo] = 0;
  674. return (long)p;
  675. }
  676. long m2dsindex(const char *s, int ch, int o)
  677. {
  678. int i;
  679. if (s == NULL) return -1;
  680. for (i = o; s[i] != 0; i++)
  681. if ((unsigned char)s[i] == (unsigned char)ch) return i;
  682. return -1;
  683. }
  684. long m2dsrindex(const char *s, int ch, int o)
  685. {
  686. int n, i;
  687. if (s == NULL) return -1;
  688. n = (int)strlen(s);
  689. if (o >= n) o = n - 1;
  690. for (i = o; i >= 0; i--)
  691. if ((unsigned char)s[i] == (unsigned char)ch) return i;
  692. return -1;
  693. }
  694. long m2dsmult(const char *s, int n)
  695. {
  696. size_t len, i;
  697. char *p;
  698. if (s == NULL) s = "";
  699. if (n <= 0) return (long)m2dsdup("");
  700. len = strlen(s);
  701. p = (char *)malloc(len * (size_t)n + 1);
  702. if (p == NULL) return 0;
  703. for (i = 0; i < (size_t)n; i++) memcpy(p + i * len, s, len);
  704. p[len * (size_t)n] = 0;
  705. return (long)p;
  706. }
  707. long m2dsreplacechar(char *s, int from, int to)
  708. {
  709. int i;
  710. if (s == NULL) return 0;
  711. for (i = 0; s[i] != 0; i++)
  712. if ((unsigned char)s[i] == (unsigned char)from) s[i] = (char)to;
  713. return (long)s;
  714. }
  715. long m2dsupper(char *s)
  716. {
  717. int i;
  718. if (s == NULL) return 0;
  719. for (i = 0; s[i] != 0; i++)
  720. if (s[i] >= 'a' && s[i] <= 'z') s[i] = (char)(s[i] - 32);
  721. return (long)s;
  722. }
  723. long m2dslower(char *s)
  724. {
  725. int i;
  726. if (s == NULL) return 0;
  727. for (i = 0; s[i] != 0; i++)
  728. if (s[i] >= 'A' && s[i] <= 'Z') s[i] = (char)(s[i] + 32);
  729. return (long)s;
  730. }
  731. long m2dstrimprefix(char *s)
  732. {
  733. char *p;
  734. if (s == NULL) return 0;
  735. p = s;
  736. while (*p == ' ' || *p == '\t' || *p == '\n' || *p == '\r') p++;
  737. if (p != s) memmove(s, p, strlen(p) + 1);
  738. return (long)s;
  739. }
  740. long m2dstrimpostfix(char *s)
  741. {
  742. size_t n;
  743. if (s == NULL) return 0;
  744. n = strlen(s);
  745. while (n > 0 && (s[n-1] == ' ' || s[n-1] == '\t' ||
  746. s[n-1] == '\n' || s[n-1] == '\r')) {
  747. s[--n] = 0;
  748. }
  749. return (long)s;
  750. }
  751. /* ---------------- TimeString / wrapclock / wraptime / wrapc -------- */
  752. #include <sys/stat.h>
  753. #include <sys/time.h>
  754. #include <pwd.h>
  755. #include <math.h>
  756. #include <fcntl.h>
  757. long m2timestring(long *desc)
  758. {
  759. char buf[128];
  760. char *dst = (char *)(desc + 1);
  761. long cap = desc[0], n;
  762. time_t t = time(NULL);
  763. struct tm tmv;
  764. localtime_r(&t, &tmv);
  765. if (strftime(buf, sizeof buf, "%c", &tmv) == 0) buf[0] = 0;
  766. n = (long)strlen(buf);
  767. if (cap < 0) cap = 0;
  768. if (n > cap) n = cap;
  769. memcpy(dst, buf, (size_t)n);
  770. dst[n] = 0;
  771. return n;
  772. }
  773. long m2wctimezone(void) { return (long)timezone; }
  774. long m2wcistimezone(void) { return 1; }
  775. long m2wcdaylight(void) { return (long)daylight; }
  776. long m2wcisdst(void) { return 1; }
  777. long m2wctzname(long d) { return (long)(d ? tzname[1] : tzname[0]); }
  778. void *m2wctsnew(void) { return calloc(1, sizeof(struct timespec)); }
  779. void *m2wctskill(void *ts){ free(ts); return NULL; }
  780. long m2wctsget(void *ts, long *sec, long *nano)
  781. {
  782. struct timespec *t = (struct timespec *)ts;
  783. if (t == NULL) return -1;
  784. *sec = (long)t->tv_sec; *nano = (long)t->tv_nsec; return 0;
  785. }
  786. long m2wctsset(void *ts, long sec, long nano)
  787. {
  788. struct timespec *t = (struct timespec *)ts;
  789. if (t == NULL) return -1;
  790. t->tv_sec = (time_t)sec; t->tv_nsec = (long)nano; return 0;
  791. }
  792. long m2wctsrealtime(void *ts)
  793. { return clock_gettime(CLOCK_REALTIME, (struct timespec *)ts); }
  794. long m2wctssetrealtime(void *ts)
  795. { return clock_settime(CLOCK_REALTIME, (struct timespec *)ts); }
  796. void *m2wttvnew(void) { return calloc(1, sizeof(struct timeval)); }
  797. void *m2wttvkill(void *p) { free(p); return NULL; }
  798. void *m2wttznew(void) { return calloc(1, sizeof(struct timezone)); }
  799. void *m2wttzkill(void *p) { free(p); return NULL; }
  800. void *m2wttmnew(void) { return calloc(1, sizeof(struct tm)); }
  801. void *m2wttmkill(void *p) { free(p); return NULL; }
  802. long m2wtgettimeofday(void *tv, void *tz)
  803. { return gettimeofday((struct timeval *)tv, (struct timezone *)tz); }
  804. long m2wtsettimeofday(void *tv, void *tz)
  805. { return settimeofday((struct timeval *)tv, (struct timezone *)tz); }
  806. long m2wtfractions(void *tv)
  807. { struct timeval *t = (struct timeval *)tv; return t ? (long)t->tv_usec : 0; }
  808. void *m2wtlocaltime(void *tv, void *tm)
  809. { struct timeval *t = (struct timeval *)tv; return localtime_r(&t->tv_sec, (struct tm *)tm); }
  810. long m2wtyear(void *m) { return ((struct tm *)m)->tm_year + 1900; }
  811. long m2wtmonth(void *m) { return ((struct tm *)m)->tm_mon + 1; }
  812. long m2wtday(void *m) { return ((struct tm *)m)->tm_mday; }
  813. long m2wthour(void *m) { return ((struct tm *)m)->tm_hour; }
  814. long m2wtminute(void *m) { return ((struct tm *)m)->tm_min; }
  815. long m2wtsecond(void *m) { return ((struct tm *)m)->tm_sec; }
  816. void m2wttvset(void *tv, long sec, long usec)
  817. { struct timeval *t = (struct timeval *)tv; t->tv_sec = (time_t)sec; t->tv_usec = (long)usec; }
  818. void m2wttzset(void *tz, long minuteswest, long dsttime)
  819. { struct timezone *z = (struct timezone *)tz; z->tz_minuteswest = (int)minuteswest; z->tz_dsttime = (int)dsttime; }
  820. long m2cstrtime(void) { time_t t = time(NULL); return (long)ctime(&t); }
  821. long m2cfilesize(long f, long *low, long *high)
  822. {
  823. struct stat st;
  824. if (fstat((int)f, &st) != 0) { *low = 0; *high = 0; return -1; }
  825. *low = (long)(st.st_size & 0xffffffffL);
  826. *high = (long)((unsigned long long)st.st_size >> 32);
  827. return 0;
  828. }
  829. long m2cfileinode(long f, long *low, long *high)
  830. {
  831. struct stat st;
  832. if (fstat((int)f, &st) != 0) { *low = 0; *high = 0; return -1; }
  833. *low = (long)(st.st_ino & 0xffffffffL);
  834. *high = (long)((unsigned long long)st.st_ino >> 32);
  835. return 0;
  836. }
  837. long m2cfilemtime(long f)
  838. { struct stat st; if (fstat((int)f, &st) != 0) return -1; return (long)st.st_mtime; }
  839. long m2cgetrand(long n) { return n <= 0 ? 0 : (long)(random() % n); }
  840. long m2cgetusername(void)
  841. { struct passwd *pw = getpwuid(getuid()); return pw ? (long)pw->pw_name : (long)""; }
  842. void m2cgetnameuidgid(long name, long *uid, long *gid)
  843. { struct passwd *pw = getpwnam((const char *)name);
  844. if (pw == NULL) { *uid = -1; *gid = -1; } else { *uid = (long)pw->pw_uid; *gid = (long)pw->pw_gid; } }
  845. long m2csignbit(double r) { return signbit(r) ? 1 : 0; }
  846. long m2cisfinite(double x) { return isfinite(x) ? 1 : 0; }
  847. long m2cisnan(double x) { return isnan(x) ? 1 : 0; }
  848. long m2cseekset(void) { return (long)SEEK_SET; }
  849. long m2cseekend(void) { return (long)SEEK_END; }
  850. long m2creadonly(void) { return (long)O_RDONLY; }
  851. long m2cwriteonly(void) { return (long)O_WRONLY; }