Modules.c 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506
  1. /* voc 2.1.0 [2017/07/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
  2. #define SHORTINT INT8
  3. #define INTEGER INT16
  4. #define LONGINT INT32
  5. #define SET UINT32
  6. #include "SYSTEM.h"
  7. #include "Heap.h"
  8. #include "Platform.h"
  9. export INT16 Modules_res;
  10. export CHAR Modules_resMsg[256];
  11. export Heap_ModuleName Modules_imported, Modules_importing;
  12. export INT32 Modules_MainStackFrame;
  13. export INT16 Modules_ArgCount;
  14. export INT32 Modules_ArgVector;
  15. export CHAR Modules_BinaryDir[1024];
  16. static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
  17. static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
  18. export INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
  19. export void Modules_AssertFail (INT32 code);
  20. static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
  21. static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len);
  22. static void Modules_DisplayHaltCode (INT32 code);
  23. static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len);
  24. static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len);
  25. export void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
  26. export void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
  27. export void Modules_GetIntArg (INT16 n, INT32 *val);
  28. export void Modules_Halt (INT32 code);
  29. export void Modules_Init (INT32 argc, INT32 argvadr);
  30. static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len);
  31. static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len);
  32. static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len);
  33. export Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
  34. export Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
  35. static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
  36. static void Modules_errch (CHAR c);
  37. static void Modules_errint (INT32 l);
  38. static void Modules_errstring (CHAR *s, ADDRESS s__len);
  39. extern void Heap_InitHeap();
  40. extern void *Modules__init(void);
  41. #define Modules_InitHeap() Heap_InitHeap()
  42. #define Modules_ModulesInit() Modules__init()
  43. #define Modules_modules() (Heap_Module)Heap_modules
  44. void Modules_Init (INT32 argc, INT32 argvadr)
  45. {
  46. Modules_MainStackFrame = argvadr;
  47. Modules_ArgCount = __VAL(INT16, argc);
  48. __GET(argvadr, Modules_ArgVector, INT32);
  49. Modules_InitHeap();
  50. Modules_ModulesInit();
  51. }
  52. typedef
  53. CHAR (*argptr__15)[1024];
  54. void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len)
  55. {
  56. argptr__15 arg = NIL;
  57. if (n < Modules_ArgCount) {
  58. __GET(Modules_ArgVector + __ASHL(n, 2), arg, argptr__15);
  59. __COPY(*arg, val, val__len);
  60. }
  61. }
  62. void Modules_GetIntArg (INT16 n, INT32 *val)
  63. {
  64. CHAR s[64];
  65. INT32 k, d, i;
  66. s[0] = 0x00;
  67. Modules_GetArg(n, (void*)s, 64);
  68. i = 0;
  69. if (s[0] == '-') {
  70. i = 1;
  71. }
  72. k = 0;
  73. d = (INT16)s[__X(i, 64)] - 48;
  74. while ((d >= 0 && d <= 9)) {
  75. k = k * 10 + d;
  76. i += 1;
  77. d = (INT16)s[__X(i, 64)] - 48;
  78. }
  79. if (s[0] == '-') {
  80. k = -k;
  81. i -= 1;
  82. }
  83. if (i > 0) {
  84. *val = k;
  85. }
  86. }
  87. INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
  88. {
  89. INT16 i;
  90. CHAR arg[256];
  91. __DUP(s, s__len, CHAR);
  92. i = 0;
  93. Modules_GetArg(i, (void*)arg, 256);
  94. while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
  95. i += 1;
  96. Modules_GetArg(i, (void*)arg, 256);
  97. }
  98. __DEL(s);
  99. return i;
  100. }
  101. static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
  102. {
  103. INT16 i;
  104. __DUP(s, s__len, CHAR);
  105. i = 0;
  106. while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
  107. i += 1;
  108. }
  109. __DEL(s);
  110. return i;
  111. }
  112. static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
  113. {
  114. INT16 i, j;
  115. __DUP(s, s__len, CHAR);
  116. i = 0;
  117. j = Modules_CharCount(d, d__len);
  118. while (s[__X(i, s__len)] != 0x00) {
  119. d[__X(j, d__len)] = s[__X(i, s__len)];
  120. i += 1;
  121. j += 1;
  122. }
  123. d[__X(j, d__len)] = 0x00;
  124. __DEL(s);
  125. }
  126. static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
  127. {
  128. INT16 i, j;
  129. __DUP(s, s__len, CHAR);
  130. i = 0;
  131. j = Modules_CharCount(d, d__len);
  132. if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
  133. d[__X(j, d__len)] = c;
  134. j += 1;
  135. }
  136. while (s[__X(i, s__len)] != 0x00) {
  137. d[__X(j, d__len)] = s[__X(i, s__len)];
  138. i += 1;
  139. j += 1;
  140. }
  141. d[__X(j, d__len)] = 0x00;
  142. __DEL(s);
  143. }
  144. static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
  145. {
  146. INT16 i;
  147. __DUP(s, s__len, CHAR);
  148. if (c == 0x00) {
  149. __DEL(s);
  150. return 0;
  151. }
  152. i = 0;
  153. while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
  154. i += 1;
  155. }
  156. __DEL(s);
  157. return s[__X(i, s__len)] == c;
  158. }
  159. static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
  160. {
  161. __DUP(d, d__len, CHAR);
  162. if (d[0] == 0x00) {
  163. __DEL(d);
  164. return 0;
  165. }
  166. if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
  167. __DEL(d);
  168. return 1;
  169. }
  170. if (d[__X(1, d__len)] == ':') {
  171. __DEL(d);
  172. return 1;
  173. }
  174. __DEL(d);
  175. return 0;
  176. }
  177. static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
  178. {
  179. __DUP(s, s__len, CHAR);
  180. if (Modules_IsAbsolute(s, s__len)) {
  181. __COPY(s, d, d__len);
  182. } else {
  183. __COPY(Platform_CWD, d, d__len);
  184. Modules_AppendPart('/', s, s__len, (void*)d, d__len);
  185. }
  186. __DEL(s);
  187. }
  188. static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
  189. {
  190. Platform_FileIdentity identity;
  191. __DUP(s, s__len, CHAR);
  192. __DEL(s);
  193. return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
  194. }
  195. static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
  196. {
  197. INT16 j;
  198. __DUP(s, s__len, CHAR);
  199. __DUP(p, p__len, CHAR);
  200. j = 0;
  201. while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
  202. d[__X(j, d__len)] = s[__X(*i, s__len)];
  203. *i += 1;
  204. j += 1;
  205. }
  206. d[__X(j, d__len)] = 0x00;
  207. while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
  208. *i += 1;
  209. }
  210. __DEL(s);
  211. __DEL(p);
  212. }
  213. static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
  214. {
  215. INT16 i, j;
  216. CHAR part[1024];
  217. __DUP(s, s__len, CHAR);
  218. i = 0;
  219. j = 0;
  220. while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
  221. i += 1;
  222. d[__X(j, d__len)] = '/';
  223. j += 1;
  224. }
  225. d[__X(j, d__len)] = 0x00;
  226. while (s[__X(i, s__len)] != 0x00) {
  227. Modules_ExtractPart(s, s__len, &i, (CHAR*)"/\\", 3, (void*)part, 1024);
  228. if ((part[0] != 0x00 && __STRCMP(part, ".") != 0)) {
  229. Modules_AppendPart('/', part, 1024, (void*)d, d__len);
  230. }
  231. }
  232. __DEL(s);
  233. }
  234. typedef
  235. CHAR pathstring__12[4096];
  236. static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len)
  237. {
  238. pathstring__12 arg0, pathlist, pathdir, tempstr;
  239. INT16 i, j, k;
  240. BOOLEAN present;
  241. if (Modules_ArgCount < 1) {
  242. binarydir[0] = 0x00;
  243. return;
  244. }
  245. Modules_GetArg(0, (void*)arg0, 4096);
  246. i = 0;
  247. while ((((arg0[__X(i, 4096)] != 0x00 && arg0[__X(i, 4096)] != '/')) && arg0[__X(i, 4096)] != '\\')) {
  248. i += 1;
  249. }
  250. if (arg0[__X(i, 4096)] == '/' || arg0[__X(i, 4096)] == '\\') {
  251. Modules_Trim(arg0, 4096, (void*)tempstr, 4096);
  252. Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
  253. present = Modules_IsFilePresent(binarydir, binarydir__len);
  254. } else {
  255. Platform_GetEnv((CHAR*)"PATH", 5, (void*)pathlist, 4096);
  256. i = 0;
  257. present = 0;
  258. while ((!present && pathlist[__X(i, 4096)] != 0x00)) {
  259. Modules_ExtractPart(pathlist, 4096, &i, (CHAR*)":;", 3, (void*)pathdir, 4096);
  260. Modules_AppendPart('/', arg0, 4096, (void*)pathdir, 4096);
  261. Modules_Trim(pathdir, 4096, (void*)tempstr, 4096);
  262. Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
  263. present = Modules_IsFilePresent(binarydir, binarydir__len);
  264. }
  265. }
  266. if (present) {
  267. k = Modules_CharCount(binarydir, binarydir__len);
  268. while ((k > 0 && !Modules_IsOneOf(binarydir[__X(k - 1, binarydir__len)], (CHAR*)"/\\", 3))) {
  269. k -= 1;
  270. }
  271. if (k == 0) {
  272. binarydir[__X(k, binarydir__len)] = 0x00;
  273. } else {
  274. binarydir[__X(k - 1, binarydir__len)] = 0x00;
  275. }
  276. } else {
  277. binarydir[0] = 0x00;
  278. }
  279. }
  280. Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
  281. {
  282. Heap_Module m = NIL;
  283. CHAR bodyname[64];
  284. Heap_Command body;
  285. __DUP(name, name__len, CHAR);
  286. m = Modules_modules();
  287. while ((m != NIL && __STRCMP(m->name, name) != 0)) {
  288. m = m->next;
  289. }
  290. if (m != NIL) {
  291. Modules_res = 0;
  292. Modules_resMsg[0] = 0x00;
  293. } else {
  294. Modules_res = 1;
  295. __COPY(name, Modules_importing, 20);
  296. __MOVE(" module \"", Modules_resMsg, 10);
  297. Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
  298. Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
  299. }
  300. __DEL(name);
  301. return m;
  302. }
  303. Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
  304. {
  305. Heap_Cmd c = NIL;
  306. __DUP(name, name__len, CHAR);
  307. c = mod->cmds;
  308. while ((c != NIL && __STRCMP(c->name, name) != 0)) {
  309. c = c->next;
  310. }
  311. if (c != NIL) {
  312. Modules_res = 0;
  313. Modules_resMsg[0] = 0x00;
  314. __DEL(name);
  315. return c->cmd;
  316. } else {
  317. Modules_res = 2;
  318. __MOVE(" command \"", Modules_resMsg, 11);
  319. __COPY(name, Modules_importing, 20);
  320. Modules_Append(mod->name, 20, (void*)Modules_resMsg, 256);
  321. Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
  322. Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
  323. Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
  324. __DEL(name);
  325. return NIL;
  326. }
  327. __RETCHK;
  328. }
  329. void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
  330. {
  331. Heap_Module m = NIL, p = NIL;
  332. INT32 refcount;
  333. __DUP(name, name__len, CHAR);
  334. m = Modules_modules();
  335. if (all) {
  336. Modules_res = 1;
  337. __MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
  338. } else {
  339. refcount = Heap_FreeModule(name, name__len);
  340. if (refcount == 0) {
  341. Modules_res = 0;
  342. } else {
  343. if (refcount < 0) {
  344. __MOVE("module not found", Modules_resMsg, 17);
  345. } else {
  346. __MOVE("clients of this module exist", Modules_resMsg, 29);
  347. }
  348. Modules_res = 1;
  349. }
  350. }
  351. __DEL(name);
  352. }
  353. static void Modules_errch (CHAR c)
  354. {
  355. INT16 e;
  356. e = Platform_Write(1, (ADDRESS)&c, 1);
  357. }
  358. static void Modules_errstring (CHAR *s, ADDRESS s__len)
  359. {
  360. INT32 i;
  361. __DUP(s, s__len, CHAR);
  362. i = 0;
  363. while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
  364. Modules_errch(s[__X(i, s__len)]);
  365. i += 1;
  366. }
  367. __DEL(s);
  368. }
  369. static void Modules_errint (INT32 l)
  370. {
  371. if (l < 0) {
  372. Modules_errch('-');
  373. l = -l;
  374. }
  375. if (l >= 10) {
  376. Modules_errint(__DIV(l, 10));
  377. }
  378. Modules_errch((CHAR)((int)__MOD(l, 10) + 48));
  379. }
  380. static void Modules_DisplayHaltCode (INT32 code)
  381. {
  382. switch (code) {
  383. case -1:
  384. Modules_errstring((CHAR*)"Assertion failure.", 19);
  385. break;
  386. case -2:
  387. Modules_errstring((CHAR*)"Index out of range.", 20);
  388. break;
  389. case -3:
  390. Modules_errstring((CHAR*)"Reached end of function without reaching RETURN.", 49);
  391. break;
  392. case -4:
  393. Modules_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", 47);
  394. break;
  395. case -5:
  396. Modules_errstring((CHAR*)"Type guard failed.", 19);
  397. break;
  398. case -6:
  399. Modules_errstring((CHAR*)"Implicit type guard in record assignment failed.", 49);
  400. break;
  401. case -7:
  402. Modules_errstring((CHAR*)"Invalid case in WITH statement.", 32);
  403. break;
  404. case -8:
  405. Modules_errstring((CHAR*)"Value out of range.", 20);
  406. break;
  407. case -9:
  408. Modules_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", 60);
  409. break;
  410. case -10:
  411. Modules_errstring((CHAR*)"NIL access.", 12);
  412. break;
  413. case -11:
  414. Modules_errstring((CHAR*)"Alignment error.", 17);
  415. break;
  416. case -12:
  417. Modules_errstring((CHAR*)"Divide by zero.", 16);
  418. break;
  419. case -13:
  420. Modules_errstring((CHAR*)"Arithmetic overflow/underflow.", 31);
  421. break;
  422. case -14:
  423. Modules_errstring((CHAR*)"Invalid function argument.", 27);
  424. break;
  425. case -15:
  426. Modules_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", 52);
  427. break;
  428. case -20:
  429. Modules_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", 60);
  430. break;
  431. default:
  432. break;
  433. }
  434. }
  435. void Modules_Halt (INT32 code)
  436. {
  437. Heap_FINALL();
  438. Modules_errstring((CHAR*)"Terminated by Halt(", 20);
  439. Modules_errint(code);
  440. Modules_errstring((CHAR*)"). ", 4);
  441. if (code < 0) {
  442. Modules_DisplayHaltCode(code);
  443. }
  444. Modules_errstring(Platform_NL, 3);
  445. Platform_Exit(code);
  446. }
  447. void Modules_AssertFail (INT32 code)
  448. {
  449. Heap_FINALL();
  450. Modules_errstring((CHAR*)"Assertion failure.", 19);
  451. if (code != 0) {
  452. Modules_errstring((CHAR*)" ASSERT code ", 14);
  453. Modules_errint(code);
  454. Modules_errstring((CHAR*)".", 2);
  455. }
  456. Modules_errstring(Platform_NL, 3);
  457. if (code > 0) {
  458. Platform_Exit(code);
  459. } else {
  460. Platform_Exit(-1);
  461. }
  462. }
  463. export void *Modules__init(void)
  464. {
  465. __DEFMOD;
  466. __MODULE_IMPORT(Heap);
  467. __MODULE_IMPORT(Platform);
  468. __REGMOD("Modules", 0);
  469. /* BEGIN */
  470. Modules_FindBinaryDir((void*)Modules_BinaryDir, 1024);
  471. __ENDMOD;
  472. }