Anubis / Anubis

Commit 742d8f325997f4d86adbd602f976548a995a34d3

Authored by Alain Prouté
1 parent 54a181da

literal strings are no more pemanent

Showing 8 changed files with 428 additions and 684 deletions   Show diff stats
Inline Side-by-side
anubis_dev/compiler/src/vminstr.c
  Show/Hide comments   View file @742d8f3
... ... @@ -329,11 +329,6 @@ int instruction_size(Expr instr, int offset)
329 329 case micro_peek_copy_push_mixed:
330 330 return 10;
331 331  
332   -#if 0
333   - case load_adm:
334   - return 9; /* 1 + 4 + 4 */
335   -#endif
336   -
337 332 case _switch:
338 333 case type_large_switch:
339 334 return 2 + 4*length(cdr(instr));
... ... @@ -376,7 +371,8 @@ int instruction_size(Expr instr, int offset)
376 371  
377 372 case string:
378 373 case string_push:
379   - return 1+4+4+strlen(string_content(compiled_strings[integer_value(cdr(instr))].string))+1;
  374 + /* new format since version 1.13 (see vm/vm.cpp) */
  375 + return 1+4+strlen(string_content(compiled_strings[integer_value(cdr(instr))].string));
380 376  
381 377 case program:
382 378 {
... ... @@ -971,11 +967,13 @@ void translate_instruction(U8 *code_addr,
971 967 *(((U32 *)(*ptr))) = len =
972 968 strlen(string_content(compiled_strings[integer_value(cdr(instr))].string));
973 969 *ptr += sizeof(U32);
974   - *(((U32 *)(*ptr))) = 0; /* null counter => permanent string */
975   - *ptr += sizeof(U32);
  970 + /* the two lines below eliminated since version 1.13 */
  971 + //*(((U32 *)(*ptr))) = 0; /* null counter => permanent string */
  972 + //*ptr += sizeof(U32);
976 973 for (i = 0; i < len; i++)
977 974 *((*ptr)++) = 172^((string_content(compiled_strings[integer_value(cdr(instr))].string))[i]);
978   - *((*ptr)++) = 172;
  975 + /* the line below eliminated since version 1.13 */
  976 + //*((*ptr)++) = 172;
979 977 break;
980 978  
981 979 case program: /* (program instruction ... instruction) */
... ... @@ -1682,22 +1680,6 @@ void translate_instruction(U8 *code_addr,
1682 1680 }
1683 1681 break;
1684 1682  
1685   -#if 0
1686   - case load_adm: /* (load_adm module_name, type_description) */
1687   - {
1688   - *((*ptr)++) = i_load_adm;
1689   - instr = cdr(instr);
1690   - *(((U32 *)(*ptr))) = length(instr);
1691   - *ptr += sizeof(U32);
1692   - while(consp(instr))
1693   - {
1694   - *((*ptr)++) = (U8)(integer_value(car(instr)));
1695   - instr = cdr(instr);
1696   - }
1697   - }
1698   - break;
1699   -#endif
1700   -
1701 1683 case begin_op:
1702 1684 *((*ptr)++) = i_begin_op;
1703 1685 {
... ...
anubis_dev/include/bytecode.h
  Show/Hide comments   View file @742d8f3
... ... @@ -222,7 +222,6 @@ typedef enum
222 222 item(get_mvar_monitors)\
223 223 item(xchg_mvv)\
224 224 item(get_mvv)\
225   - item(load_adm)\
226 225 item(load_int_small)\
227 226 item(load_int_big)\
228 227 item(begin_op)\
... ...
anubis_dev/vm/src/anbexec.cpp
  Show/Hide comments   View file @742d8f3
... ... @@ -244,7 +244,7 @@ U32 read32(FILE *fp)
244 244 void syntax(void)
245 245 {
246 246 LOGINFO("anbexec version %d.%d.%d.%d\n"
247   - " (Build date: %s )\n"
  247 + " (Build date: %s %s)\n"
248 248 #ifdef _WITH_SSL_
249 249 " (%s)\n"
250 250 #endif
... ... @@ -272,7 +272,7 @@ void syntax(void)
272 272 " --csv_sep:<sep> defines which separator to use when outputing profiling\n"
273 273 " data as CSV. Default is ',' (comma).\n"
274 274 " --perf activate performance computing (load average)\n"
275   - , maj_version, min_version, rel_version, build_version, __DATE__,
  275 + , maj_version, min_version, rel_version, build_version, __DATE__,__TIME__,
276 276 #ifdef _WITH_SSL_
277 277 OPENSSL_VERSION_TEXT,
278 278 #endif
... ... @@ -424,7 +424,7 @@ int load_module(struct Exec_Mod_struct *mod,
424 424 /* code segment must be aligned on 0 mod 4 */
425 425 assert((((U32)code)&3) == 0);
426 426  
427   - /* make the code apermanent byte array */
  427 + /* make the code a permanent byte array */
428 428 ((U32 *)code)[0] = 0;
429 429 /* put the size at its place */
430 430 ((U32 *)code)[1] = code_size;
... ...
anubis_dev/vm/src/dynamic_module.cpp
  Show/Hide comments   View file @742d8f3
... ... @@ -414,31 +414,30 @@ U32 number_of_module_slots = 0; /* total number
414 414 /* Note: the initial primary module is also recorded in this array, and counted */
415 415  
416 416 /* Resizing the modules array depending on the number of modules.
417   - We arrange so that there is always at least one free slot. Hence, we can
418   - store a new module, without worrying about resizing the modules array.
419   - Of course, after this operation we must eventually try to resize it.
420   - We also maybe resize it down when a module is collected.
421 417  
422 418 The precise policy is the following:
423 419  
424 420 - When anbexec starts, an array of 'module_slot_steps' slots is allocated.
425   - - when a module is added to the array, it is inserted so that the 'module_begin'
426   - fields remain in increasing order, and the array is resized if full.
  421 + - when a module is added to the array, it is inserted so that the 'byte_code'
  422 + fields remain in increasing order (and the array is previously resized if full).
427 423 - when a module is discarded, the modules above it are shifted down in the array,
428 424 so that the modules are all at the beginning of the array without any hole between them.
429 425 The number of modules currently present in the array is always 'number_of_modules'.
430 426  
431   - 'resize_module_array' is called when anbexec starts, so that there is at least one free
432   - slot at the beginning.
  427 + 'resize_module_array' is called when anbexec starts in order to put the primary module
  428 + in the array .
433 429  
434 430 */
435 431 int /* 0 = out of memory, 1 = ok */
436 432 resize_modules_array(void)
437 433 {
  434 +
  435 + printf("resize_modules_array: modules: %\ld slots: %ld\n",number_of_modules,number_of_module_slots); fflush(stdout);
  436 +
438 437 /**/
439 438 if (modules == NULL)
440 439 {
441   - printf("initial allocation of modules array.\n"); fflush(stdout);
  440 + printf("Initial allocation of modules array.\n"); fflush(stdout);
442 441 U32 seg = (U32)malloc(sizeof(struct Exec_Mod_struct)*module_slots_step);
443 442 if ((U32 *)seg == NULL) return 0;
444 443 modules = (struct Exec_Mod_struct *)seg;
... ... @@ -448,7 +447,7 @@ int /* 0 = out of memory, 1 = ok */
448 447 if (number_of_modules == number_of_module_slots)
449 448 {
450 449 /* the array needs to be enlarged */
451   - printf("enlarging modules array.\n"); fflush(stdout);
  450 + printf("Enlarging modules array.\n"); fflush(stdout);
452 451 U32 seg = (U32)realloc((void *)modules,
453 452 sizeof(struct Exec_Mod_struct)*(number_of_module_slots+module_slots_step));
454 453 if ((U32 *)seg == NULL) return 0; /* enlargement failed */
... ... @@ -546,18 +545,17 @@ int find_module_index(U8* reference)
546 545 'find_module_index' defined above.*/
547 546  
548 547  
549   - /*** Adding a module to the array. *****************************************************/
550   -
551   -void check_module_order()
  548 +void check_module_order() /* several verifications on the modules array */
552 549 {
553 550 U32 k;
554 551  
555 552 for (k = 0; k < number_of_modules; k++)
556 553 {
557   - printf("index %lu module address: %lu (cnt = %ld)\n",
  554 + printf("index %lu module address: %lu (cnt = %ld) %s\n",
558 555 k,
559 556 (U32)(modules[k].byte_code),
560   - ((U32 *)(modules[k].byte_code))[0]); fflush(stdout);
  557 + ((U32 *)(modules[k].byte_code))[0],
  558 + ((modules[k].flags)&mf_secondary_adm) ? "" : "(primary module)"); fflush(stdout);
561 559 }
562 560  
563 561 for (k = 0; k < number_of_modules - 1; k++)
... ... @@ -567,6 +565,8 @@ void check_module_order()
567 565 }
568 566  
569 567  
  568 + /*** Adding a module to the array. *****************************************************/
  569 +
570 570 int /* 0 = out of memory, 1 = ok */
571 571 add_module( U32 flags,
572 572 U8* byte_code,
... ... @@ -576,6 +576,26 @@ int /* 0 = out of memory, 1 = ok */
576 576 {
577 577 U32 index = find_module_index(byte_code);
578 578 U32 k;
  579 +
  580 + /* Resize the array if needed.
  581 +
  582 + Why we must do it before adding the module:
  583 +
  584 + - the first reason is that the array may be full.
  585 +
  586 + - but there is another reason. When I wrote this the first time I arranged so that
  587 + the modules array always has at least one free slot, so that it was possible
  588 + to add the module and enlarge the array only after this operation. But actually,
  589 + it does not work because the syscall 'relocate_code' (in syscall.cpp) is where we
  590 + add the new relocated module to the array (in other words, it calls 'add_module'),
  591 + and uses the 'duc_non_empty' register for knowing if the module has already
  592 + been relocated when it comes back after having given up because 'add_module'
  593 + returned 0 the first time. The second time, it calls 'add_module' again.
  594 + Hence, it is necessary that 'add_module' does not add the module if the array
  595 + cannot be enlarged. Otherwise, the module could be recorded several times.
  596 +
  597 + */
  598 + if (!resize_modules_array()) return 0;
579 599  
580 600 printf("add_module: index found: %lu\n",index); fflush(stdout);
581 601  
... ... @@ -610,9 +630,7 @@ int /* 0 = out of memory, 1 = ok */
610 630 number_of_modules++;
611 631  
612 632 check_module_order();
613   -
614   - /* resize the array if needed */
615   - return resize_modules_array();
  633 + return 1;
616 634 }
617 635  
618 636  
... ... @@ -626,7 +644,7 @@ void
626 644 if (show_module_loading) printf("Unloading module %d\n",index);
627 645  
628 646 /* free the module segment */
629   - allocator->FreeDataSegment((U32 *)((modules[index].byte_code)-8));
  647 + allocator->FreeDataSegment((U32 *)((modules[index].byte_code)));
630 648 number_of_modules--;
631 649  
632 650 /* shift next modules one slot down */
... ... @@ -645,7 +663,7 @@ void
645 663 // sizeof(struct Exec_Mod_struct)*(number_of_modules-index)); /* number of bytes to be moved */
646 664  
647 665 /* if possible reduce the size of the modules array */
648   - resize_modules_array();
  666 + resize_modules_array();
649 667 }
650 668  
651 669  
... ... @@ -653,9 +671,19 @@ void
653 671 void vcopy_module_ref(U8 *ref)
654 672 {
655 673 int index = find_module_index(ref);
  674 + return;
  675 + if ((modules[index].flags)&mf_secondary_adm) /* don't do anything for primary module */
  676 + {
  677 + (*((U32 *)((modules[index].byte_code))))++; /* increment counter of module */
  678 + }
  679 +}
  680 +
  681 +void multiple_vcopy_module_ref(U8 *ref,U32 n) /* in case we need to make n virtual copies */
  682 +{
  683 + int index = find_module_index(ref);
656 684 if ((modules[index].flags)&mf_secondary_adm) /* don't do anything for primary module */
657 685 {
658   - (*((U32 *)((modules[index].byte_code)-8)))++; /* increment counter of module */
  686 + (*((U32 *)((modules[index].byte_code)))) += n;
659 687 }
660 688 }
661 689  
... ... @@ -663,12 +691,14 @@ void vcopy_module_ref(U8 *ref)
663 691 void vdelete_module_ref(U8 *ref, AnubisAllocator *allocator)
664 692 {
665 693 int index = find_module_index(ref);
  694 + return;
666 695 if ((modules[index].flags)&mf_secondary_adm) /* don't do anything for primary module */
667 696 {
668   - (*((U32 *)((modules[index].byte_code)-8)))--; /* decrement counter of module */
669   - if (!(*((U32 *)((modules[index].byte_code)-8)))) /* if down to 0 */
  697 + if (*((U32 *)((modules[index].byte_code)))) /* beware of permanent modules */
  698 + (*((U32 *)((modules[index].byte_code))))--; /* decrement counter of module */
  699 + if (!(*((U32 *)((modules[index].byte_code))))) /* if down to 0 */
670 700 {
671   - remove_module(index, allocator);
  701 + //remove_module(index, allocator);
672 702 }
673 703 }
674 704 }
... ...
anubis_dev/vm/src/secondary_module.anubis
  Show/Hide comments   View file @742d8f3
... ... @@ -24,7 +24,7 @@
24 24 global define String
25 25 secondary_module
26 26 =
27   - "Bla bla blo.\n".
  27 + "Bla bla blu.\n".
28 28  
29 29  
30 30  
... ...
anubis_dev/vm/src/vm.cpp
  Show/Hide comments   View file @742d8f3
... ... @@ -5,8 +5,25 @@
5 5  
6 6 **************************************************************************************/
7 7  
  8 +
  9 +
  10 + /*
  11 +
  12 + This file contains:
  13 +
  14 + (1) Some global variables.
  15 + (2) Tools for exceptions.
  16 + (3) Tools for running virtual machines.
  17 + (4) Type description tools (serialize).
  18 + (5) All virtual machine instructions.
8 19  
9   -/* Serializing/unserializing stuff is in serialize.cpp */
  20 +
  21 + Serializing/unserializing stuff is in 'serialize.cpp'.
  22 +
  23 + */
  24 +
  25 +
  26 +
10 27  
11 28  
12 29  
... ... @@ -80,7 +97,6 @@ extern &quot;C&quot;
80 97  
81 98 USING_NAMESPACE(CM);
82 99  
83   -char *dummy_string;
84 100  
85 101  
86 102 /* Important change since version 1.6.5: virtual machine instructions are reached by a
... ... @@ -157,27 +173,71 @@ char *dummy_string;
157 173  
158 174 //extern int strcasecmp (const char *S1, const char *S2);
159 175  
  176 +
  177 + /******************************************************
  178 + * *
  179 + * (1) Some global variables. *
  180 + * *
  181 + ******************************************************/
  182 +
  183 +char * dummy_string;
  184 +U32 anubis_empty_string;
  185 +U32 anubis_empty_byte_array; // initialized at start
160 186  
161   -int counting_instructions = 0;
162   -int show_syscalls = 0;
  187 +int counting_instructions = 0;
  188 +int show_syscalls = 0;
  189 +
  190 +int start_end_debug = 0;
  191 +U32 start_debug = 0;
  192 +U32 end_debug = 0;
  193 +
  194 +#define vmbuf_size (2000)
  195 +char vmbuf[vmbuf_size];
  196 +
  197 +int jpeg_fatal_error = 0;
  198 +
  199 +fd_set descriptors_waited_for_input;
  200 +fd_set the_fd_set;
  201 +fd_set the_fd_read_set;
  202 +fd_set the_fd_write_set;
  203 +fd_set the_fd_except_set;
  204 +
  205 +struct timeval timeout_no_wait = {0,0};
  206 +
  207 +#define ptd_to_name_buf_size (1025)
  208 +char ptd_to_name_buf[ptd_to_name_buf_size];
  209 +
  210 +AnubisAllocator *the_default_ssl_allocator = NULL;
  211 +AnubisAllocator *current_ssl_allocator = NULL;
163 212  
164   -U32 anubis_empty_string;
165   -U32 anubis_empty_byte_array; // initialized at start
  213 +#ifdef record_allocations
  214 +int passed = 0;
  215 +U32* passed_seg;
  216 +U32 passed_cnt_old = 0;
  217 +U32 passed_seg_IP = 0;
  218 +#endif
  219 +
  220 +#ifdef debug_vm
  221 +U32 IPcode = 0;
  222 +#endif
166 223  
167   -int start_end_debug = 0;
168   -U32 start_debug = 0;
169   -U32 end_debug = 0;
  224 +
170 225  
171   -extern String anubis_directory;
172   -extern String my_anubis_directory;
173   -extern String trusted_certs_directory;
174   -extern int must_restart_flag;
  226 +extern String anubis_directory;
  227 +extern String my_anubis_directory;
  228 +extern String trusted_certs_directory;
  229 +extern int must_restart_flag;
  230 +
175 231  
176   -#define vmbuf_size (2000)
177   -char vmbuf[vmbuf_size];
178 232  
179   -int jpeg_fatal_error = 0;
180 233  
  234 + /*************************************************
  235 + * *
  236 + * (2) Tools for exceptions. *
  237 + * *
  238 + *************************************************/
  239 +
  240 +
181 241 void jpeg_anb_error_exit(j_common_ptr cinfo)
182 242 {
183 243 jpeg_fatal_error = 1;
... ... @@ -251,21 +311,17 @@ void compare_watched_code(U32 ip)
251 311 }
252 312 #endif
253 313  
254   -//U32 memory_seg_size = initial_memory_seg_size;
255 314  
256   -#define check_stack(n) do { if (MAM(m_SP)+(n) >= MAM(m_SP_end)) {\
257   - MAM(m_status) = need_bigger_stack; goto end; }} while(0)
258 315  
259   -fd_set descriptors_waited_for_input;
260   -fd_set the_fd_set;
261   -fd_set the_fd_read_set;
262   -fd_set the_fd_write_set;
263   -fd_set the_fd_except_set;
  316 + /*****************************************************************
  317 + * *
  318 + * (3) Tools for running virtual machines. *
  319 + * *
  320 + *****************************************************************/
264 321  
265   -struct timeval timeout_no_wait = {0,0};
  322 +#define check_stack(n) do { if (MAM(m_SP)+(n) >= MAM(m_SP_end)) {\
  323 + MAM(m_status) = need_bigger_stack; goto end; }} while(0)
266 324  
267   -#define ptd_to_name_buf_size (1025)
268   -char ptd_to_name_buf[ptd_to_name_buf_size];
269 325  
270 326 /*--------------------------------------------------------------*/
271 327 #define item(n) #n,
... ... @@ -291,6 +347,7 @@ char *syscall32_names[] = {
291 347 "dummy" };
292 348 #undef sc32_item
293 349  
  350 + /* getting the name of an instruction */
294 351 const char *instr_name(int i, int n)
295 352 {
296 353 if (i == i_syscall)
... ... @@ -301,18 +358,6 @@ const char *instr_name(int i, int n)
301 358 return instr_names[i];
302 359 }
303 360  
304   -//char *short_string(VMWorkSort ws)
305   -//{
306   -// switch (ws)
307   -// {
308   -// case computing: return "c";
309   -// case deleting: return "d";
310   -// case equaling: return "e";
311   -// case serializing: return "s";
312   -// case unserializing: return "u";
313   -// default: return "?";
314   -// }
315   -//}
316 361 #endif
317 362  
318 363  
... ... @@ -350,6 +395,13 @@ const char *instr_name(int i, int n)
350 395 #define serial_words_increment (1024)
351 396  
352 397  
  398 +
  399 +
  400 + /*******************************************************
  401 + * *
  402 + * (4) Type description tools (serialize). *
  403 + * *
  404 + *******************************************************/
353 405  
354 406  
355 407 /* Checking that a word represents a valid datum of a given small type. */
... ... @@ -524,28 +576,24 @@ int check_small_alt_datum(U32 datum, U32 *start_bit_a, U8 **alt_des_a)
524 576 return 1;
525 577 }
526 578  
527   -AnubisAllocator *the_default_ssl_allocator = NULL;
528   -AnubisAllocator *current_ssl_allocator = NULL;
529   -
530   -#ifdef record_allocations
531   - int passed = 0;
532   - U32* passed_seg;
533   - U32 passed_cnt_old = 0;
534   - U32 passed_seg_IP = 0;
535   -#endif
536 579  
537   -#ifdef debug_vm
538   -U32 IPcode = 0;
539   -#endif
540 580  
541   -
542   -
543   -
  581 + /**************************************************
  582 + * *
  583 + * (5) All virtual machine instructions. *
  584 + * *
  585 + **************************************************/
  586 +
544 587  
545 588 /* All instructions of the virtual machine as member functions of AnubisProcess ('mi' =
546 589 'member instruction'). */
547 590  
548 591  
  592 +
  593 +
  594 +
  595 +
  596 +
549 597 /* The 'invalid' instruction should never be executed. If the machine is led to execute
550 598 this instruction, this means that the code is probably corrupted. The action is
551 599 to stop the virtual machine, with an 'invalid_instruction' status. The scheduler will
... ... @@ -847,7 +895,15 @@ ci_decl(peek_copy_push_function)
847 895 /* peek d */
848 896 x = *(MAM(m_SP)-get32(1)-1);
849 897 /* copy_function */
850   - if (!(x&1)) if (*((U32 *)(x)) != 0) (*((U32 *)(x)))++;
  898 + if (x&1)
  899 + { /* top level function */
  900 + vcopy_module_ref((U8 *)x);
  901 + }
  902 + else
  903 + { /* closure function */
  904 + if (*((U32 *)(x)) != 0)
  905 + (*((U32 *)(x)))++;
  906 + }
851 907 /* push */
852 908 *(MAM(m_SP)++) = x;
853 909 MAM(m_R) = x;
... ... @@ -863,7 +919,15 @@ ci_decl(peek_copy_function)
863 919 /* peek d */
864 920 x = *(MAM(m_SP)-get32(1)-1);
865 921 /* copy_function */
866   - if (!(x&1)) if (*((U32 *)(x)) != 0) (*((U32 *)(x)))++;
  922 + if (x&1)
  923 + { /* top level function */
  924 + vcopy_module_ref((U8 *)x);
  925 + }
  926 + else
  927 + { /* closure function */
  928 + if (*((U32 *)(x)) != 0)
  929 + (*((U32 *)(x)))++;
  930 + }
867 931 MAM(m_R) = x;
868 932 MAM(m_IP) += 1+4;
869 933 }
... ... @@ -1062,9 +1126,15 @@ ci_decl(micro_peek_copy_function)
1062 1126 /* micro_peek */
1063 1127 MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
1064 1128 /* copy_function */
1065   - if (!(MAM(m_R)&1))
  1129 + if (MAM(m_R)&1)
  1130 + { /* top level function */
  1131 + vcopy_module_ref((U8 *)(MAM(m_R)));
  1132 + }
  1133 + else
  1134 + { /* closure function */
1066 1135 if (*((U32 *)(MAM(m_R))) != 0)
1067 1136 (*((U32 *)(MAM(m_R))))++;
  1137 + }
1068 1138 MAM(m_IP) += 1+4+4;
1069 1139 }
1070 1140  
... ... @@ -1078,9 +1148,15 @@ ci_decl(micro_peek_copy_push_function)
1078 1148 /* micro_peek */
1079 1149 MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
1080 1150 /* copy_function */
1081   - if (!(MAM(m_R)&1))
  1151 + if (MAM(m_R)&1)
  1152 + { /* top level function */
  1153 + vcopy_module_ref((U8 *)(MAM(m_R)));
  1154 + }
  1155 + else
  1156 + { /* closure function */
1082 1157 if (*((U32 *)(MAM(m_R))) != 0)
1083 1158 (*((U32 *)(MAM(m_R))))++;
  1159 + }
1084 1160 /* push */
1085 1161 *(MAM(m_SP)++) = MAM(m_R); /* push MAM(m_R) on top of stack */
1086 1162 MAM(m_IP) += 1+4+4;
... ... @@ -1451,11 +1527,11 @@ ci_decl(unstore_copy_function)
1451 1527 /* extract the function and put it on the stack */
1452 1528 *MAM(m_SP) = *((U32 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1)));
1453 1529 if ((*MAM(m_SP))&1)
1454   - {
1455   - /* no virtual copy for top level functions */
  1530 + { /* top level function */
  1531 + vcopy_module_ref((U8 *)(MAM(m_R)));
1456 1532 }
1457 1533 else
1458   - {
  1534 + { /* closure function */
1459 1535 if (*((U32 *)(*MAM(m_SP))) != 0)
1460 1536 (*((U32 *)(*MAM(m_SP))))++;
1461 1537 }
... ... @@ -1622,11 +1698,16 @@ ci_decl(jmp)
1622 1698 Size: 1+4
1623 1699  
1624 1700 The purpose of this instruction is to put the address contained in its operand into
1625   - MAM(m_R). The address is always the absolute address of a subroutine. */
  1701 + MAM(m_R). The address is always the absolute address of a top level function .
  1702 +
  1703 + Since version 1.13, the module containing this function has a counter which must be incremented.
  1704 + */
1626 1705 ci_decl(address)
1627 1706 {
1628 1707 trace
1629   - MAM(m_R) = get32(1);
  1708 + U32 code_addr = get32(1);
  1709 + MAM(m_R) = code_addr;
  1710 + vcopy_module_ref((U8 *)code_addr);
1630 1711 MAM(m_IP) += 1+4;
1631 1712 }
1632 1713  
... ... @@ -1828,9 +1909,15 @@ ci_decl(put_copy_function)
1828 1909 trace
1829 1910 U32 datum = *(MAM(m_SP)-get8(1)-1);
1830 1911 ((U32 *)MAM(m_R))[3+get8(2)] = datum;
1831   - if (!(datum&1))
  1912 + if (datum&1)
  1913 + { /* top level function */
  1914 + vcopy_module_ref((U8 *)datum);
  1915 + }
  1916 + else
  1917 + { /* closure function */
1832 1918 if (((U32 *)(datum))[0])
1833 1919 (((U32 *)(datum))[0])++;
  1920 + }
1834 1921 MAM(m_IP) += 1+1+1;
1835 1922 }
1836 1923  
... ... @@ -1868,9 +1955,15 @@ ci_decl(put_micro_copy_function)
1868 1955 trace
1869 1956 U32 datum = ((U32 *)(*(MAM(m_SP)-get8(1)-1)))[3+get8(2)];
1870 1957 ((U32 *)MAM(m_R))[3+get8(3)] = datum;
1871   - if (!(datum&1))
  1958 + if (datum&1)
  1959 + { /* top level function */
  1960 + vcopy_module_ref((U8 *)datum);
  1961 + }
  1962 + else
  1963 + { /* closure function */
1872 1964 if (((U32 *)(datum))[0])
1873 1965 (((U32 *)(datum))[0])++;
  1966 + }
1874 1967 MAM(m_IP) += 1+1+1+1;
1875 1968 }
1876 1969  
... ... @@ -1947,12 +2040,17 @@ ci_decl(put_micro_copy_mixed)
1947 2040 Size: 1+4+4
1948 2041  
1949 2042 A closure is currently under construction in MAM(m_R). This instruction must copy the two
1950   - addresses at byte offsets 4 and 8 in the closure. */
  2043 + addresses at byte offsets 4 and 8 in the closure.
  2044 +
  2045 + Since version 1.13, the module containing this function has a counter which must be incremented.
  2046 +*/
1951 2047 ci_decl(put_closure_labels)
1952 2048 {
1953 2049 trace
1954   - ((U32 *)MAM(m_R))[1] = get32(1);
  2050 + U32 code_addr = get32(1);
  2051 + ((U32 *)MAM(m_R))[1] = code_addr;
1955 2052 ((U32 *)MAM(m_R))[2] = get32(5);
  2053 + vcopy_module_ref((U8 *)code_addr);
1956 2054 MAM(m_IP) += 1+4+4;
1957 2055 }
1958 2056  
... ... @@ -2588,16 +2686,24 @@ ci_decl(mvar_slots_del_function)
2588 2686  
2589 2687 (*(MAM(m_SP)-1))--; /* decrement counter before using it as an index*/
2590 2688 datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))]; /* datum to be virtually deleted */
2591   - if (datum && /* beware of 0 pseudo datum */
2592   - !(datum&1) && /* and if function is a closure */
2593   - ((U32 *)datum)[0] && /* and of permanent data */
2594   - (!(--(((U32 *)datum)[0])))) /* and if counter becomes 0 */
2595   - {
2596   - /* call closure deletion code */
2597   - *(MAM(m_SP)++) = (U32)(MAM(m_IP));
2598   - *(MAM(m_SP)++) = datum;
2599   - MAM(m_IP) = (U8 *)(((U32 *)datum)[2]);
  2689 + if (datum) /* beware of 0 pseudo datum */
  2690 + {
  2691 + if (datum&1)
  2692 + { /* top level function */
  2693 + vdelete_module_ref((U8 *)datum,MAM(m_allocator));
2600 2694 }
  2695 + else
  2696 + { /* closure function */
  2697 + if (((U32 *)datum)[0] && /* and of permanent data */
  2698 + (!(--(((U32 *)datum)[0])))) /* and if counter becomes 0 */
  2699 + {
  2700 + /* call closure deletion code */
  2701 + *(MAM(m_SP)++) = (U32)(MAM(m_IP));
  2702 + *(MAM(m_SP)++) = datum;
  2703 + MAM(m_IP) = (U8 *)(((U32 *)datum)[2]);
  2704 + }
  2705 + }
  2706 + }
2601 2707 /* else do nothing, but just execute this instruction again */
2602 2708 }
2603 2709 }
... ... @@ -3185,13 +3291,26 @@ ci_decl(copy_ptr)
3185 3291 Size: 1
3186 3292  
3187 3293 This instruction is similar to i_copy_ptr. The sole difference is that it must not
3188   - perform the copy when the pointer to the function is odd (top level function). */
  3294 + perform the copy when the pointer to the function is odd (top level function).
  3295 +
  3296 + Since version 1.13 all functions are counted, even top level functions. For a closure,
  3297 + the counter is in the closure itself, but for a top level function the counter is that of
  3298 + the corresponding module.
  3299 +
  3300 + */
3189 3301 ci_decl(copy_function)
3190 3302 {
3191 3303 trace
3192   - if (!(MAM(m_R)&1))
3193   - if (*((U32 *)(MAM(m_R))) != 0)
  3304 + if (MAM(m_R)&1)
  3305 + { /* top level function */
  3306 + vcopy_module_ref((U8 *)(MAM(m_R)));
  3307 + }
  3308 + else
  3309 + { /* closure function */
  3310 + if (*((U32 *)(MAM(m_R))) != 0) /* avoid copying permanent functions
  3311 + (however, permanent closures do not exist until now) */
3194 3312 (*((U32 *)(MAM(m_R))))++;
  3313 + }
3195 3314 MAM(m_IP) += 1;
3196 3315 }
3197 3316  
... ... @@ -3227,9 +3346,16 @@ ci_decl(vcopy_ptr)
3227 3346 ci_decl(vcopy_function)
3228 3347 {
3229 3348 trace
  3349 + if (MAM(m_R)&1)
  3350 + { /* top */
  3351 + multiple_vcopy_module_ref((U8 *)MAM(m_R),*(MAM(m_SP)-1));
  3352 + }
  3353 + else
  3354 + {
3230 3355 if (*((U32 *)(MAM(m_R))) != 0)
3231 3356 (*((U32 *)(MAM(m_R)))) += *(MAM(m_SP)-1);
3232   - MAM(m_SP)--;
  3357 + }
  3358 + MAM(m_SP)--; /* this was the number of copies required */
3233 3359 MAM(m_IP) += 1;
3234 3360 }
3235 3361  
... ... @@ -3618,17 +3744,25 @@ ci_decl(del_stack_function)
3618 3744 */
3619 3745  
3620 3746 /* virtual deletion of function */
3621   - if (aux && /* beware of NULL pointers */
3622   - !(aux&1) && /* don't delete top level functions */
3623   - *((U32 *)aux) && /* don't delete if permanent */
3624   - !(--(*((U32 *)aux))))
3625   - {
3626   - /* call micro context deletion MAM(m_code_begin) */
  3747 + if (aux) /* beware of NULL pointers */
  3748 + {
  3749 + if (aux&1)
  3750 + { /* top level function */
  3751 + vdelete_module_ref((U8 *)aux,MAM(m_allocator));
  3752 + }
  3753 + else
  3754 + { /* closure function */
  3755 + if (*((U32 *)aux) && /* don't delete if permanent */
  3756 + !(--(*((U32 *)aux))))
  3757 + {
  3758 + /* call micro context deletion code */
3627 3759 *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4);
3628 3760 *(MAM(m_SP)++) = aux;
3629 3761 MAM(m_IP) = (U8 *)(((U32 *)aux)[2]);
3630 3762 return;
  3763 + }
3631 3764 }
  3765 + }
3632 3766 MAM(m_IP) += 1+4;
3633 3767 }
3634 3768  
... ... @@ -4144,17 +4278,25 @@ ci_decl(indirect_del_function)
4144 4278 {
4145 4279 trace
4146 4280 U32 aux = *((U32 *)*(MAM(m_SP)-1)); /* pointer (manipulation word) to function */
4147   - if (aux &&
4148   - !(aux&1) &&
4149   - *((U32 *)aux) &&
4150   - !(--(*((U32 *)aux))))
4151   - {
4152   - /* call closure deletion MAM(m_code_begin) */
4153   - *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1);
4154   - *(MAM(m_SP)++) = aux;
4155   - MAM(m_IP) = (U8 *)(((U32 *)aux)[2]);
4156   - return;
  4281 + if (aux)
  4282 + {
  4283 + if (aux&1)
  4284 + { /* top level function */
  4285 + vdelete_module_ref((U8 *)aux,MAM(m_allocator));
  4286 + }
  4287 + else
  4288 + { /* closure function */
  4289 + if (*((U32 *)aux) &&
  4290 + !(--(*((U32 *)aux))))
  4291 + {
  4292 + /* call closure deletion MAM(m_code_begin) */
  4293 + *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1);
  4294 + *(MAM(m_SP)++) = aux;
  4295 + MAM(m_IP) = (U8 *)(((U32 *)aux)[2]);
  4296 + return;
  4297 + }
4157 4298 }
  4299 + }
4158 4300 MAM(m_IP) += 1;
4159 4301 }
4160 4302  
... ... @@ -4171,17 +4313,25 @@ ci_decl(incr_indirect_del_function)
4171 4313 ((*(MAM(m_SP)-1))) += get8(1);
4172 4314  
4173 4315 U32 aux = *((U32 *)*(MAM(m_SP)-1)); /* pointer (manipulation word) to function */
4174   - if (aux &&
4175   - !(aux&1) &&
4176   - *((U32 *)aux) &&
4177   - !(--(*((U32 *)aux))))
4178   - {
  4316 + if (aux)
  4317 + {
  4318 + if (aux&1)
  4319 + { /* top level function */
  4320 + vdelete_module_ref((U8 *)aux,MAM(m_allocator));
  4321 + }
  4322 + else
  4323 + { /* closure function */
  4324 + if (*((U32 *)aux) &&
  4325 + !(--(*((U32 *)aux))))
  4326 + {
4179 4327 /* call closure deletion code */
4180 4328 *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+1);
4181 4329 *(MAM(m_SP)++) = aux;
4182 4330 MAM(m_IP) = (U8 *)(((U32 *)aux)[2]);
4183 4331 return;
  4332 + }
4184 4333 }
  4334 + }
4185 4335 MAM(m_IP) += 1+1;
4186 4336 }
4187 4337  
... ... @@ -4245,17 +4395,25 @@ ci_decl(incr_indirect_del_int)
4245 4395 ci_decl(del_function)
4246 4396 {
4247 4397 trace
4248   - if (MAM(m_R) &&
4249   - !(MAM(m_R)&1) &&
4250   - *((U32 *)MAM(m_R)) &&
4251   - !(--(*((U32 *)MAM(m_R)))))
4252   - {
4253   - /* call closure deletion code */
4254   - *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1);
4255   - *(MAM(m_SP)++) = MAM(m_R);
4256   - MAM(m_IP) = (U8 *)(((U32 *)MAM(m_R))[2]);
4257   - return;
  4398 + if (MAM(m_R)) /* avoid pseudo-datum 0 */
  4399 + {
  4400 + if (MAM(m_R)&1)
  4401 + { /* top level function */
  4402 + vdelete_module_ref((U8 *)(MAM(m_R)),MAM(m_allocator));
4258 4403 }
  4404 + else
  4405 + { /* closure function */
  4406 + if (*((U32 *)MAM(m_R)) &&
  4407 + !(--(*((U32 *)MAM(m_R)))))
  4408 + {
  4409 + /* call closure deletion code */
  4410 + *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1);
  4411 + *(MAM(m_SP)++) = MAM(m_R);
  4412 + MAM(m_IP) = (U8 *)(((U32 *)MAM(m_R))[2]);
  4413 + return;
  4414 + }
  4415 + }
  4416 + }
4259 4417 MAM(m_IP) += 1;
4260 4418 }
4261 4419  
... ... @@ -5115,7 +5273,9 @@ ci_decl(load_float)
5115 5273  
5116 5274  
5117 5275  
5118   -/* Format: string (U32)length (U32)counter (U8)...(U8) (U8)0
  5276 +/* Before version 1.13:
  5277 +
  5278 + Format: string (U32)length (U32)counter (U8)...(U8) (U8)0
5119 5279 Size: 1+4+4+length+1
5120 5280  
5121 5281 This instruction contains a character string. The first (U32) operand is the length of
... ... @@ -5123,13 +5283,34 @@ ci_decl(load_float)
5123 5283 value 0. This value will always remain 0, which means that the string is permanent. The
5124 5284 string itself follows this operand, and is delimited by a 0.
5125 5285  
5126   - The action of the instruction is to put the address of the null counter into MAM(m_R). */
  5286 + The action of the instruction is to put the address of the null counter into MAM(m_R).
  5287 +
  5288 + Since version 1.13:
  5289 +
  5290 + Format: string (U32)length (U8)...(U8) (no trailing 0)
  5291 + Size: 1+4+length
  5292 +
  5293 + The instruction string allocates a segment and copies the string into it. Since version
  5294 + 1.13 there are no more permanent strings.
  5295 +
  5296 + */
5127 5297 ci_decl(string)
5128 5298 {
5129 5299 trace
5130   - MAM(m_R) = (U32)(MAM(m_IP)+1+4); /* address of null counter */
5131   - assert(*((U32 *)(MAM(m_R))) == 0);
5132   - MAM(m_IP) += 1+4+4+get32(1)+1;
  5300 + int k;
  5301 + int len = get32(1);
  5302 +
  5303 + /* the two lines below replaced since version 1.13 */
  5304 + //MAM(m_R) = (U32)(MAM(m_IP)+1+4); /* address of null counter */
  5305 + //assert(*((U32 *)(MAM(m_R))) == 0);
  5306 +
  5307 + vm_alloc1(MAM(m_R),byte_size_to_word_size(4+len+1)); /* counter + string + trailing 0 */
  5308 + for (k = 0; k < len; k++) (((U8 *)(MAM(m_R)))+4)[k] = (((U8 *)(MAM(m_IP)))+5)[k];
  5309 + (((U8 *)(MAM(m_R)))+4)[k] = 0;
  5310 +
  5311 + /* the line below replaced since version 1.13 */
  5312 + //MAM(m_IP) += 1+4+4+get32(1)+1;
  5313 + MAM(m_IP) += 1+4+get32(1);
5133 5314 }
5134 5315  
5135 5316  
... ... @@ -5137,8 +5318,17 @@ ci_decl(string)
5137 5318 ci_decl(string_push)
5138 5319 {
5139 5320 trace
5140   - MAM(m_R) = *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4); /* address of null counter */
5141   - MAM(m_IP) += 1+4+4+get32(1)+1;
  5321 + int k;
  5322 + int len = get32(1);
  5323 +
  5324 + // the two lines below replaced since version 1.13 */
  5325 + //MAM(m_R) = *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4); /* address of null counter */
  5326 + //MAM(m_IP) += 1+4+4+get32(1)+1;
  5327 + vm_alloc1(MAM(m_R),byte_size_to_word_size(4+len+1));
  5328 + for (k = 0; k < len; k++) (((U8 *)(MAM(m_R)))+4)[k] = (((U8 *)(MAM(m_IP)))+5)[k];
  5329 + (((U8 *)(MAM(m_R)))+4)[k] = 0;
  5330 + *(MAM(m_SP)++) = MAM(m_R);
  5331 + MAM(m_IP) += 1+4+get32(1);
5142 5332 }
5143 5333  
5144 5334  
... ... @@ -5147,8 +5337,6 @@ ci_decl(string_push)
5147 5337  
5148 5338  
5149 5339  
5150   -
5151   -
5152 5340 /* Format: dec3 (U32)addr
5153 5341 Size: 1+4
5154 5342  
... ... @@ -5163,364 +5351,7 @@ ci_decl(dec3)
5163 5351 }
5164 5352  
5165 5353  
5166   -
5167   -
5168   -#if 0
5169   - the next 10 transformed into syscalls
5170   -/* Format: connect_file_R
5171   - connect_file_W
5172   - connect_file_RW
5173   - Size: 1
5174   -
5175   - This instruction receives a string at *(MAM(m_SP)-1), which is the name of a connection. The
5176   - purpose is to open the connection, and return a datum of type Maybe(?Addr(T)) for some
5177   - type T. However, the type T has no importance here, because it is used only statically
5178   - by the compiler. A connection is always a pointer to a data segment. The function
5179   - 'open_file_connection' returns 0 if the connection cannot be (immediately) opened, and
5180   - 1 otherwise. */
5181   -ci_decl(connect_file_R)
5182   -{
5183   - trace
5184   - U32 conn_seg;
5185   -
5186   - vm_alloc2(MAM(m_R), 2,
5187   - conn_seg, conn_word_size);
5188   -
5189   - /* open the connection */
5190   - if (!open_file_connection(conn_seg,(((char *)(*(MAM(m_SP)-1)))+4),conn_read,0))
5191   - {
5192   - vm_free2(MAM(m_R),conn_seg);
5193   - MAM(m_R) = 0; /* failure */
5194   - }
5195   - else
5196   - {
5197   - *(((U32 *)(MAM(m_R)))+1) = conn_seg;
5198   - MAM(m_R) |= 1; /* mixed index 1 */
5199   - }
5200   - MAM(m_IP) += 1;
5201   -}
5202   -
5203   -
5204   -
5205   -
5206   -ci_decl(connect_file_W)
5207   -{
5208   - trace
5209   - U32 conn_seg;
5210   -
5211   - vm_alloc2(MAM(m_R), 2,
5212   - conn_seg, conn_word_size);
5213   -
5214   - /* open the connection */
5215   - if (!open_file_connection(conn_seg,(((char *)(*(MAM(m_SP)-1)))+4),conn_write,0))
5216   - {
5217   - vm_free2(MAM(m_R),conn_seg);
5218   - MAM(m_R) = 0; /* failure */
5219   - }
5220   - else
5221   - {
5222   - *(((U32 *)(MAM(m_R)))+1) = conn_seg;
5223   - MAM(m_R) |= 1; /* mixed index 1 */
5224   - }
5225   - MAM(m_IP) += 1;
5226   -}
5227   -
5228   -
5229   -ci_decl(connect_file_RW)
5230   -{
5231   - trace
5232   - U32 conn_seg;
5233   -
5234   - vm_alloc2(MAM(m_R), 2,
5235   - conn_seg, conn_word_size);
5236   -
5237   - /* open the connection */
5238   - if (!open_file_connection(conn_seg,(((char *)(*(MAM(m_SP)-1)))+4),conn_write,0))
5239   - {
5240   - vm_free2(MAM(m_R),conn_seg);
5241   - MAM(m_R) = 0; /* failure */
5242   - }
5243   - else
5244   - {
5245   - *(((U32 *)(MAM(m_R)))+1) = conn_seg;
5246   - MAM(m_R) |= 1; /* mixed index 1 */
5247   - }
5248   - MAM(m_IP) += 1;
5249   -}
5250   -
5251   -
5252   -/* Format: i_connect_IP_RW
5253   - Size: 1
5254   -
5255   - This instruction is similar to i_connect_file_?, except that it receives two operands
5256   - which are of type Word32:
5257   -
5258   - at *(MAM(m_SP)-1): ip address
5259   - at *(MAM(m_SP)-2): ip port
5260   -
5261   - Opening a network connection may be non immediate. Hence, we open the connection using
5262   - 'connect', but we test its availability using 'select'. Each time 'select' returns the
5263   - answer that the connection is not yet established, we give up.
5264   -
5265   - So, we need to put our two segments in MAM(m_DUC1) and MAM(m_DUC2).
5266   -
5267   - The returned value has type Result(NetworkConnectError,?Addr(?)), hence is:
5268   -
5269   - 0 for error(cannot_create_the_socket)
5270   - 4 for error(address_port_not_available)
5271   - 8 for error(connection_refused)
5272   - 12 for error(network_unreachable)
5273   - 16 for error(address_port_already_in_use)
5274   - 20 for error(out_of_time)
5275   - ptr|1 for ok(conn)
5276   -
5277   - where ptr is a pointer to the connection data segment. */
5278   -ci_decl(connect_IP_RW)
5279   -{
5280   - trace
5281   - int i;
5282   -
5283   - if (!MAM(m_duc_non_empty))
5284   - {
5285   - vm_alloc2(MAM(m_DUC1), 2,
5286   - MAM(m_DUC2), conn_word_size);
5287   -
5288   - /* open the connection without waiting or verifying (only once !) */
5289   - if((i = open_IP_connection(MAM(m_DUC2),*(MAM(m_SP)-1),*(MAM(m_SP)-2),conn_read|conn_write)) != 0)
5290   - {
5291   - switch(i)
5292   - {
5293   - /* index bit width = 2 (mixed) */
5294   - case 1: MAM(m_R) = 0; break; // cannot create the socket
5295   - case 2: MAM(m_R) = 4; break; // address:port not available on remote machine
5296   - case 3: MAM(m_R) = 8; break; // connection refused by server
5297   - case 4: MAM(m_R) = 12; break; // network unreachable
5298   - case 5: MAM(m_R) = 16; break; // address:port already in use
5299   - default: MAM(m_R) = 0; break; // cannot create the socket
5300   - }
5301   - vm_free2(MAM(m_DUC1),MAM(m_DUC2));
5302   - MAM(m_IP) += 1;
5303   - return;
5304   - }
5305   -
5306   - /* the socket handle has been put in the connection segment */
5307   - MAM(m_duc_non_empty) = 1;
5308   - }
5309   -
5310   - /* check if connection ready */
5311   - i = is_IP_connection_ready(MAM(m_DUC2));
5312   -
5313   - if (i == 0) /* connection ready */
5314   - {
5315   - *(((U32 *)(MAM(m_DUC1)))+1) = MAM(m_DUC2);
5316   - MAM(m_R) = MAM(m_DUC1);
5317   - MAM(m_R) |= 1; /* mixed index 1 ('ok' of type 'Result') */
5318   - MAM(m_duc_non_empty) = 0;
5319   - //printf("Connection is ready\n"); fflush(stdout);
5320   - }
5321   - else if (i == 1) /* connection not yet ready */
5322   - {
5323   - /* wait until next try */
5324   - //printf("Waiting for connection to be ready\n"); fflush(stdout);
5325   - MAM(m_steps) = 0;
5326   - return;
5327   - }
5328   - else if (i == 2)/* time is out */
5329   - {
5330   - vm_free2(MAM(m_DUC1),MAM(m_DUC2));
5331   - MAM(m_duc_non_empty) = 0;
5332   - //printf("Time is out(2)\n"); fflush(stdout);
5333   - MAM(m_R) = 20; /* error(out_of_time) */
5334   - }
5335   - else if (i == 3)
5336   - {
5337   - vm_free2(MAM(m_DUC1),MAM(m_DUC2));
5338   - MAM(m_duc_non_empty) = 0;
5339   - MAM(m_R) = 4; /* address:port not available on remote machine */
5340   - }
5341   - else
5342   - {
5343   - //printf("i = %d\n",i); fflush(stdout);
5344   - assert(0);
5345   - }
5346   - MAM(m_IP) += 1;
5347   -}
5348   -
5349   -
5350   -/* Format: read_Word8
5351   - Size: 1
5352   -
5353   - This instruction reads a datum of type Word8 from the connection at *(MAM(m_SP)-1). The
5354   - result is of type Maybe(Word8). */
5355   -ci_decl(read_Word8)
5356   -{
5357   - trace
5358   - int c;
5359   -
5360   - c = read_byte((U8 *)(*(MAM(m_SP)-1)));
5361   -
5362   - if (c == 2*EOF)
5363   - {
5364   - MAM(m_status) = waiting_for_event;
5365   - MAM(m_steps) = 0; /* wait for input (network connection) */
5366   - return;
5367   - }
5368   - else if (c == EOF)
5369   - {
5370   - //printf("connection closed by peer\n"); fflush(stdout);
5371   - MAM(m_R) = 0; /* failure */
5372   - }
5373   - else
5374   - {
5375   - MAM(m_R) = (((U8)c)<<1)|1; /* index of width 1 (Maybe(Int8) has
5376   - width 9) */
5377   - }
5378   - MAM(m_IP) += 1;
5379   -}
5380   -
5381   -
5382   -
5383   -/* Format: write_Word8
5384   - Size: 1
5385   -
5386   - This instruction writes a datum of type Word8 to the connection at *(MAM(m_SP)-2). The
5387   - datum to be written is at *(MAM(m_SP)-1). The result is of type Maybe(One). */
5388   -ci_decl(write_Word8)
5389   -{
5390   - trace
5391   - MAM(m_R) = write_byte( (U8)(*(MAM(m_SP)-1)), /* Int8 to be written */
5392   - (U8 *)(*(MAM(m_SP)-2))); /* connection */
5393   - MAM(m_IP) += 1;
5394   -}
5395   -
5396   -
5397   -
5398   -/* Format: implode
5399   - Size: 1
5400   -
5401   - This instruction receives a datum of type List(Word8) at *(MAM(m_SP)-1) and constructs the
5402   - corresponding string. */
5403   -ci_decl(implode)
5404   -{
5405   - trace
5406   - int n = 0;
5407   - U32 l = *(MAM(m_SP)-1);
5408   - U32 str;
5409   -
5410   - /* compute length of list */
5411   - while (l&1) /* 0 is the empty List(Int8). */
5412   - {
5413   - n++;
5414   - l = *((U32 *)(((U8 *)(l&pointer_mask))+4+1));
5415   - }
5416   -
5417   - /* allocate 4+n+1 bytes for a string */
5418   - n += 4+1;
5419   - vm_alloc1(str,byte_size_to_word_size(n));
5420   -
5421   - /* initialize the string and copy its content */
5422   - l = *(MAM(m_SP)-1);
5423   - n = 4;
5424   - while (l&1)
5425   - {
5426   - ((U8 *)str)[n++] = (U8)(*(((U8 *)(l&pointer_mask))+4));
5427   - l = *((U32 *)(((U8 *)(l&pointer_mask))+4+1));
5428   - }
5429   - ((U8 *)str)[n] = 0;
5430   - MAM(m_R) = str;
5431   - MAM(m_IP) += 1;
5432   -}
5433   -
5434   -
5435   -
5436   -/* Format: explode
5437   - Size: 1
5438   -
5439   - This instruction receives a string at *(MAM(m_SP)-1) and constructs the list of its
5440   - characters in the form of a List(Int8). */
5441   -ci_decl(explode)
5442   -{
5443   - trace
5444   - char *str = ((char *)(*(MAM(m_SP)-1)))+4;
5445   - U32 aux;
5446   -
5447   - if (!MAM(m_duc_non_empty))
5448   - {
5449   - /* no datum under construction */
5450   - if (str[0] == 0) /* the string is empty */
5451   - {
5452   - MAM(m_R) = 0; /* empty List(Int8) */
5453   - MAM(m_IP) += 1;
5454   - return;
5455   - }
5456   - else
5457   - {
5458   - MAM(m_DUC1) = 0; /* start with an empty list */
5459   - MAM(m_DUC2) = 0; /* put the index of next character to be
5460   - 'paired' in MAM(m_DUC2). */
5461   - while (str[(MAM(m_DUC2))] != 0) MAM(m_DUC2)++;
5462   - (MAM(m_DUC2))--; /* index of last character in string */
5463   - MAM(m_duc_non_empty) = 1;
5464   - /* continue with 'datum under construction' */
5465   - }
5466   - }
5467   -
5468   - /* Here, there is a datum under construction. The list constructed
5469   - so far is in MAM(m_DUC1), and the index of the next character to be
5470   - put in a pair is in MAM(m_DUC2) (it may be zero, but in any case there
5471   - is still one character to be ''paired'').
5472   -
5473   - Note: the string is read from the end towards the beginning. */
5474   -
5475   - while (1)
5476   - {
5477   - vm_alloc1(aux,3);
5478   -
5479   - /* counter is already at 1 */
5480   - *(((U8 *)aux)+4) = str[MAM(m_DUC2)]; /* store the character as the head */
5481   - *((U32 *)(((U8 *)aux)+4+1)) = MAM(m_DUC1); /* store the tail of list */
5482   - aux |= 1; /* glue mixed index */
5483   -
5484   - if (MAM(m_DUC2) == 0) /* this was the last character to store */
5485   - {
5486   - MAM(m_duc_non_empty) = 0;
5487   - MAM(m_R) = aux;
5488   - break;
5489   - }
5490   - else
5491   - {
5492   - MAM(m_DUC1) = aux; /* new list under construction */
5493   - (MAM(m_DUC2))--; /* prepare for next character */
5494   - }
5495   - }
5496   - MAM(m_IP) += 1;
5497   -}
5498   -
5499   -
5500   -
5501   -
5502   -/* Format: truncate_to_word8
5503   - Size: 1
5504   - */
5505   -ci_decl(truncate_to_word8)
5506   -{
5507   - trace
5508   - int i = (int)(*(MAM(m_SP)-1));
5509   - if (i < 0)
5510   - MAM(m_R) = 0;
5511   - else if (i > 255)
5512   - MAM(m_R) = 255;
5513   - else
5514   - MAM(m_R) = i;
5515   - MAM(m_IP) += 1;
5516   -}
5517   -#endif
5518   -
5519   -
5520   -
5521   -
5522   -
5523   -
  5354 +
5524 5355  
5525 5356 /* Format: alt_number_direct (U8)index_width
5526 5357 Size: 1+1
... ... @@ -5551,42 +5382,6 @@ ci_decl(alt_number_indirect)
5551 5382  
5552 5383  
5553 5384  
5554   -
5555   -
5556   -
5557   -
5558   -
5559   -
5560   -
5561   -
5562   -
5563   -
5564   -
5565   -
5566   -
5567   -
5568   -
5569   -
5570   -
5571   -
5572   -
5573   -
5574   -
5575   -
5576   -
5577   -
5578   -
5579   -
5580   -
5581   -
5582   -
5583   -
5584   -
5585   -
5586   -
5587   -
5588   -
5589   -
5590 5385  
5591 5386 /* Format: start (U8)depth (U32)addr
5592 5387 Size: 6
... ... @@ -5710,11 +5505,15 @@ ci_decl(copy_stack_function)
5710 5505 {
5711 5506 trace
5712 5507 U32 f = (*(MAM(m_SP)-(1+get8(1))));
5713   - if (!(f&1))
5714   - {
5715   - assert(f);
5716   - if (*((U32 *)f) != 0) (*((U32 *)f))++;
5717   - }
  5508 + if (f&1)
  5509 + { /* top level function */
  5510 + vcopy_module_ref((U8 *)f);
  5511 + }
  5512 + else
  5513 + { /* closure function */
  5514 + assert(f);
  5515 + if (*((U32 *)f) != 0) (*((U32 *)f))++;
  5516 + }
5718 5517 MAM(m_IP) += 1+1;
5719 5518 }
5720 5519  
... ... @@ -5893,92 +5692,6 @@ ci_decl(del_gv)
5893 5692  
5894 5693  
5895 5694  
5896   -#if 0
5897   - transformed into a syscall
5898   -
5899   -
5900   -static U8 vm_hex_digit(int b)
5901   -{
5902   - if (b < 10) return '0'+b;
5903   - else return 'a'+b-10;
5904   -}
5905   -
5906   -
5907   -/* Format: byte_array_to_ascii
5908   - Size: 1
5909   -
5910   - Expect a 'ByteArray' on top of stack, and produces a string with a pair of hexadecimal
5911   - digits for each byte. */
5912   -ci_decl(byte_array_to_ascii)
5913   -{
5914   - trace
5915   - int i, j;
5916   - char *dest;
5917   - U8 *array = (U8 *)(*(MAM(m_SP)-1));
5918   - U32 n = *((U32 *)(array+4)); /* number of bytes */
5919   -
5920   - vm_alloc1(MAM(m_R),byte_size_to_word_size(4+(2*n)+1));
5921   -
5922   - array += 8; /* point to first byte */
5923   - dest = ((char *)MAM(m_R))+4; /* avoid counter in destination */
5924   - j = 0;
5925   -
5926   - for (i = 0 ; i < (int)n; i++)
5927   - {
5928   - dest[j++] = vm_hex_digit(((array[i])>>4)&0xF);
5929   - dest[j++] = vm_hex_digit((array[i])&0xF);
5930   - }
5931   - assert(j == (int)(2*n));
5932   - dest[j] = 0; /* end of string */
5933   - MAM(m_IP) += 1;
5934   -}
5935   -#endif
5936   -
5937   -
5938   -
5939   -
5940   -
5941   -
5942   -
5943   -
5944   -#if 0
5945   - transformed into a syscall
5946   -/* Format: byte_array_to_string
5947   - Size: 1
5948   -
5949   - Expects a byte array on the stack and produces the longuest string which is a prefix of
5950   - it. */
5951   -ci_decl(byte_array_to_string)
5952   -{
5953   - trace
5954   - int i, l;
5955   - U8 *array = (U8 *)(*(MAM(m_SP)-1));
5956   - U32 n = *((U32 *)(array+4)); /* length of byte array */
5957   -
5958   - array += 8;
5959   -
5960   - /* compute length of string */
5961   - for ( l = 0; l < (int)n; l++)
5962   - if (array[l] == 0) break;
5963   -
5964   - /* the length of the string is l */
5965   -
5966   - vm_alloc1(MAM(m_R),byte_size_to_word_size(4+l+1));
5967   -
5968   - for (i = 0; i < l; i++)
5969   - ((U8 *)MAM(m_R))[i+4] = array[i];
5970   - ((U8 *)MAM(m_R))[i+4] = 0;
5971   - MAM(m_IP) += 1;
5972   -}
5973   -
5974   -#endif
5975   -
5976   -
5977   -
5978   -
5979   -
5980   -
5981   -
5982 5695 /* Format: success (U8)bit_width
5983 5696 Size: 1+1
5984 5697  
... ... @@ -6104,10 +5817,6 @@ ci_decl(odd_align) /* this one is required but never executed */
6104 5817 trace
6105 5818 }
6106 5819  
6107   -ci_decl(load_adm)
6108   -{
6109   - trace
6110   -}
6111 5820  
6112 5821 ci_decl(dummy)
6113 5822 {
... ... @@ -6152,6 +5861,8 @@ ci_decl(begin_op)
6152 5861 function beginning followed by a single byte indicating if this call is terminal call
6153 5862 or not.
6154 5863 */
  5864 +
  5865 +
6155 5866 ci_decl(end_op)
6156 5867 {
6157 5868 trace
... ... @@ -6231,7 +5942,11 @@ U32 default_security_value = 0xffffffff;
6231 5942 U8* common_code_begin;
6232 5943 U8* current_IP;
6233 5944 #endif
6234   -
  5945 +
  5946 +
  5947 +
  5948 +
  5949 + /*** RunMachine (the function by which virtual machines work) ***/
6235 5950  
6236 5951 /* This function is independent */
6237 5952 int AnubisProcess::RunMachine(int steps)
... ... @@ -6281,8 +5996,7 @@ int AnubisProcess::RunMachine(int steps)
6281 5996 #ifdef WATCH_CODE
6282 5997 compare_watched_code(prev_IP-MAM(m_code_begin));
6283 5998 #endif
6284   -
6285   -
  5999 +
6286 6000 m_steps--;
6287 6001 }
6288 6002 #undef CARG
... ... @@ -6292,5 +6006,4 @@ int AnubisProcess::RunMachine(int steps)
6292 6006  
6293 6007  
6294 6008  
6295   -
6296 6009  
... ...
anubis_dev/vm/src/vm.h
  Show/Hide comments   View file @742d8f3
... ... @@ -18,6 +18,7 @@ extern U8 *duplicate_code;
18 18 extern U32 watched_code_size;
19 19 #endif
20 20  
  21 +#define debug_vm
21 22  
22 23 #ifdef DEBUG
23 24 // Only defines following macro on debug mode
... ... @@ -206,6 +207,11 @@ extern void serialize_float(double d, U8 *dest);
206 207  
207 208 #define inf(x,y) ((x)<(y) ? (x) : (y))
208 209 #define sup(x,y) ((x)<(y) ? (y) : (x))
  210 +
  211 +
  212 +
  213 +
  214 +
209 215  
210 216 struct Exec_Mod_struct {
211 217 U32 flags; /* also indicates is primary or secondary ('mf_secondary_adm' in 'bytecode.h') */
... ... @@ -228,27 +234,39 @@ struct Exec_Mod_struct {
228 234 };
229 235  
230 236  
231   -extern int /* 0 = out of memory, 1 = ok */
232   - add_module( U32 flags,
233   - U8* byte_code,
234   - int starting_point,
235   - AnubisAllocator *allocator
236   - );
237   -
238   -extern U32 number_of_modules;
239   -
240   -
241 237 /***************************************************
242 238 * *
243 239 * Dynamic modules stuff (added in version 1.13) *
244 240 * *
245 241 ***************************************************/
  242 +
  243 +extern U32 number_of_modules;
  244 +
246 245 /* Array of all modules, including the primary one ('the_primary_module' is kept anyway) */
247 246 extern struct Exec_Mod_struct * modules; /* (in dynamic_module.c) */
248 247 /* Initializing/resizing this array */
249 248 extern int resize_modules_array(void); /* 0 = out of memory, 1 = ok (initialization in anbexec.cpp) */
250 249  
251 250  
  251 +extern int /* 0 = out of memory, 1 = ok */
  252 + add_module( U32 flags,
  253 + U8* byte_code,
  254 + int starting_point,
  255 + AnubisAllocator *allocator
  256 + );
  257 +
  258 +/* garbage-collector tools for modules */
  259 +extern void vcopy_module_ref(U8 *ref);
  260 +extern void multiple_vcopy_module_ref(U8 *ref,U32 n);
  261 +extern void vdelete_module_ref(U8 *ref, AnubisAllocator *allocator);
  262 +
  263 +
  264 +
  265 +
  266 +
  267 +
  268 +
  269 +
252 270  
253 271  
254 272 extern void check_module_integrity(void);
... ...
anubis_dev/vm/src/vmtools.cpp
  Show/Hide comments   View file @742d8f3
... ... @@ -1116,17 +1116,19 @@ void link_globals_and_relocate(U8* code, int size)
1116 1116 case i_string_push:
1117 1117 if (nsc_file != NULL)
1118 1118 {
1119   - fprintf(nsc_file,"\n%8d | %s %ld %ld (\"",ptr-code,instr_names[*ptr],
1120   - *((U32 *)(ptr+1)),*((U32 *)(ptr+5)));
1121   - for (k = 0; k < (int)(*((U32 *)(ptr+5))); k++)
  1119 + fprintf(nsc_file,"\n%8d | %s %ld (\"",ptr-code,instr_names[*ptr],
  1120 + *((U32 *)(ptr+1)));
  1121 + for (k = 0; k < (int)(*((U32 *)(ptr+1))); k++)
1122 1122 {
1123   - fprintf(nsc_file,"%c",(*(ptr+9+k))^172);
  1123 + fprintf(nsc_file,"%c",(*(ptr+5+k))^172);
1124 1124 }
1125 1125 fprintf(nsc_file,"\")");
1126 1126 }
1127   - ptr += 1+4+4;
1128   - while (*ptr != 172) *(ptr++) ^= 172;
1129   - *(ptr++) ^= 172;
  1127 + for (k = 0; k < (int)(*((U32 *)(ptr+1))); k++)
  1128 + {
  1129 + *(ptr+k+5) ^= 172;
  1130 + }
  1131 + ptr += 5+(int)(*((U32 *)(ptr+1)));
1130 1132 break;
1131 1133  
1132 1134 /* (U8)instr (U8)dec [dec align bytes] (U32)counter
... ...