Anubis / Anubis

Commit 9263e56f63f06abb4a455969d54fd47a2611edd7

Authored by Alain Prouté
1 parent 4fcbfe8c

The following instructions have been modified: 

type_8 type_16 type_32
  indirect_type_8 indirect_type_16 indirect_type_32
  type_small_alt

  The length of the type description is now coded on 32 bits (instead of 8).
Showing 9 changed files with 72 additions and 46 deletions   Show diff stats
Inline Side-by-side
anubis_dev/compiler/src/implem.c
  Show/Hide comments   View file @9263e56
... ... @@ -511,6 +511,21 @@ static Expr addr_of_implem(Expr implem)
511 511 <small type descr> := <iw> <na> <alt descr> ... (as many <alt descr> as <na>)
512 512  
513 513 <alt descr> := <nc> <small type descr> ... (as many as <nc>)
  514 +
  515 + Hence a small type description is a list of 8 bits integers. These integers become part
  516 + of serialization/unserialization instructions like 'type_8', 'type_16' etc... (see
  517 + 'vminstr.c'). One question is: `how long this description may be ?'. The answer is not
  518 + so obvious ! Remember that the number of alternatives is limited to 256, and likewise
  519 + for the number of components in an alternative. Now, if 'iw' is the number of bits
  520 + required for the index, the total width of the components is at most: 'bw - iw' where
  521 + 'bw' is the bit width of our type. So, let 'dl(iw,bw)' be the maximal length for a
  522 + description of a type of index width 'iw' and bit width 'bw'. We have,
  523 +
  524 + dl(iw1,bw1) =< 2 + (2^iw1 * (1 + bl(iw2,bw1 - iw1)))
  525 +
  526 +
  527 +
  528 +
514 529  
515 530 The next function computes the description for a small type.
516 531 */
... ...
anubis_dev/compiler/src/predef.dat
View file @9263e56
No preview for this file type
anubis_dev/compiler/src/symcode.c
  Show/Hide comments   View file @9263e56
... ... @@ -74,7 +74,7 @@ void print_symbolic_code(FILE *fp, Expr code, U32 *offset_addr,
74 74 {
75 75 fprintf(fp,"\n%8d | variables_deletion_address %d",*offset_addr,integer_value(var_del_addr_val));
76 76 }
77   - else if (consp(car(code)) && car(code) == jmp_neq) /* (jmp_neq <byte width> . <addr>) */
  77 + else if (consp(car(code)) && car(car(code)) == jmp_neq) /* (jmp_neq <byte width> . <addr>) */
78 78 {
79 79 fprintf(fp,"\n%8d | jmp_neq_%d %d",*offset_addr,
80 80 integer_value(second(car(code))),
... ...
anubis_dev/compiler/src/vminstr.c
  Show/Hide comments   View file @9263e56
... ... @@ -303,14 +303,14 @@ int instruction_size(Expr instr, int offset)
303 303 case type_mixed_switch:
304 304 return 3 + 4*length(cdr2(instr));
305 305  
306   - case type_small_alt: /* (type_small_alt n_1 ... n_k) ==> 1+1+k */
  306 + case type_small_alt: /* (type_small_alt n_1 ... n_k) ==> 1+4+k */
307 307 case type_8:
308 308 case type_16:
309 309 case type_32:
310 310 case indirect_type_8:
311 311 case indirect_type_16:
312 312 case indirect_type_32:
313   - return 1+1+length(cdr(instr));
  313 + return 1+4+length(cdr(instr));
314 314  
315 315 case string:
316 316 return 1+4+4+strlen(string_content(compiled_strings[integer_value(cdr(instr))].string))+1;
... ... @@ -765,9 +765,9 @@ void translate_instruction(U8 **ptr,
765 765 *((*ptr)++) = integer_value(cdr(instr));
766 766 break;
767 767  
768   - case type_small_alt: /* (type_small_alt n1 ... n_k) -> i_type_small_alt k n1 ... nk (all bytes) */
  768 + case type_small_alt: /* (type_small_alt n1 ... n_k) -> i_type_small_alt (U32)k n1 ... nk */
769 769 *((*ptr)++) = i_type_small_alt;
770   - *((*ptr)++) = (U8)length(cdr(instr));
  770 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
771 771 {
772 772 aux = cdr(instr);
773 773 while (consp(aux))
... ... @@ -780,7 +780,7 @@ void translate_instruction(U8 **ptr,
780 780  
781 781 case type_8: /* idem */
782 782 *((*ptr)++) = i_type_8;
783   - *((*ptr)++) = (U8)length(cdr(instr));
  783 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
784 784 //debug(instr);
785 785 {
786 786 aux = cdr(instr);
... ... @@ -794,7 +794,7 @@ void translate_instruction(U8 **ptr,
794 794  
795 795 case type_16: /* idem */
796 796 *((*ptr)++) = i_type_16;
797   - *((*ptr)++) = (U8)length(cdr(instr));
  797 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
798 798 {
799 799 aux = cdr(instr);
800 800 while (consp(aux))
... ... @@ -807,7 +807,7 @@ void translate_instruction(U8 **ptr,
807 807  
808 808 case type_32: /* idem */
809 809 *((*ptr)++) = i_type_32;
810   - *((*ptr)++) = (U8)length(cdr(instr));
  810 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
811 811 {
812 812 aux = cdr(instr);
813 813 while (consp(aux))
... ... @@ -820,7 +820,7 @@ void translate_instruction(U8 **ptr,
820 820  
821 821 case indirect_type_8: /* idem */
822 822 *((*ptr)++) = i_indirect_type_8;
823   - *((*ptr)++) = (U8)length(cdr(instr));
  823 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
824 824 {
825 825 aux = cdr(instr);
826 826 while (consp(aux))
... ... @@ -833,7 +833,7 @@ void translate_instruction(U8 **ptr,
833 833  
834 834 case indirect_type_16: /* idem */
835 835 *((*ptr)++) = i_indirect_type_16;
836   - *((*ptr)++) = (U8)length(cdr(instr));
  836 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
837 837 {
838 838 aux = cdr(instr);
839 839 while (consp(aux))
... ... @@ -846,7 +846,7 @@ void translate_instruction(U8 **ptr,
846 846  
847 847 case indirect_type_32: /* idem */
848 848 *((*ptr)++) = i_indirect_type_32;
849   - *((*ptr)++) = (U8)length(cdr(instr));
  849 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
850 850 {
851 851 aux = cdr(instr);
852 852 while (consp(aux))
... ...
anubis_dev/include/minver.h
  Show/Hide comments   View file @9263e56
1   -#define min_version (203)
  1 +#define min_version (204)
... ...
anubis_dev/library/mail/send_mail.anubis
  Show/Hide comments   View file @9263e56
... ... @@ -45,7 +45,7 @@ public define SendMailResult
45 45  
46 46  
47 47 read tools/basis.anubis
48   -read web/http_get_common.anubis
  48 + read web/http_get_common.anubis
49 49  
50 50 Sending a mail (e-mail) to someone, amounts to send appropriate commands to an
51 51 'outgoing mail server' using the SMTP (Simple Mail Transfer Protocol). This protocol
... ...
anubis_dev/library/web/making_a_web_site.anubis
  Show/Hide comments   View file @9263e56
... ... @@ -325,6 +325,7 @@ public define Web_Site
325 325 make_web_site_description
326 326 (
327 327 String common_name, // for example: "www.our-business.com"
  328 + $State initial_state,
328 329 ($State expired,
329 330 HTTP_Info,
330 331 List(Web_arg),
... ... @@ -366,7 +367,8 @@ public define Web_Site
366 367 for example for producing the expiration message in the language chosen by the user.
367 368 You can also (and this may be much smarter) send a 'ticket prolongation page'
368 369 (including a new login for example), and resume the same conversation, since you have
369   - all the pertinent informations at hand.
  370 + all the pertinent informations at hand. In the case the ticket is definitely lost, the
  371 + second fonction 'ticket_lost_state' is used.
370 372  
371 373 Notice that despite the fact that the parameter $State is involved in the arguments of
372 374 the above function, the type 'Web_Site' does not depend on this parameter. This allows
... ... @@ -1397,6 +1399,7 @@ public define Web_Site
1397 1399 make_web_site_description
1398 1400 (
1399 1401 String common_name, // for example: "www.our-business.com"
  1402 + $State initial_state,
1400 1403 ($State expired,
1401 1404 HTTP_Info,
1402 1405 List(Web_arg),
... ... @@ -1455,7 +1458,12 @@ public define Web_Site
1455 1458 with new_state = if mb_previous_state is
1456 1459 {
1457 1460 not_found then
1458   - ticket_lost_state(http_info,lwa,is_https),
  1461 + if mb_action_name is
  1462 + {
  1463 + failure then initial_state,
  1464 + success(_) then
  1465 + ticket_lost_state(http_info,lwa,is_https)
  1466 + },
1459 1467  
1460 1468 out_of_date(state) then
1461 1469 ticket_expired_state(state,http_info,lwa,is_https),
... ...
anubis_dev/vm/src/vm.c
  Show/Hide comments   View file @9263e56
... ... @@ -3636,8 +3636,10 @@ if (debugging ||
3636 3636 performed if they are non equal, and 0 (false) is put in R.
3637 3637 If they are equal, the next instruction is executed. */
3638 3638 do_case(i_jmp_neq_0)
  3639 + {
3639 3640 /* zero bits wide words are always equal */
3640   - IP += 1+4;
  3641 + }
  3642 + IP += 1+4;
3641 3643 goto do_computing;
3642 3644  
3643 3645 do_case(i_jmp_neq_1)
... ... @@ -5874,7 +5876,7 @@ if (debugging ||
5874 5876 check_serial(1);
5875 5877 put_serial_8(*(SP-1));
5876 5878 }
5877   - IP += 1+1+get8(1);
  5879 + IP += 1+4+get32(1);
5878 5880 goto do_serializing;
5879 5881  
5880 5882 do_case(i_type_16)
... ... @@ -5882,7 +5884,7 @@ if (debugging ||
5882 5884 check_serial(2);
5883 5885 put_serial_16(*(SP-1));
5884 5886 }
5885   - IP += 1+1+get8(1);
  5887 + IP += 1+4+get32(1);
5886 5888 goto do_serializing;
5887 5889  
5888 5890 do_case(i_type_32)
... ... @@ -5890,7 +5892,7 @@ if (debugging ||
5890 5892 check_serial(4);
5891 5893 put_serial_32(*(SP-1));
5892 5894 }
5893   - IP += 1+1+get8(1);
  5895 + IP += 1+4+get32(1);
5894 5896 goto do_serializing;
5895 5897  
5896 5898 do_case(i_type_small_alt)
... ... @@ -5898,7 +5900,7 @@ if (debugging ||
5898 5900 check_serial(4);
5899 5901 put_serial_32(*(SP-1));
5900 5902 }
5901   - IP += 1+1+get8(1);
  5903 + IP += 1+4+get32(1);
5902 5904 goto do_serializing;
5903 5905  
5904 5906 do_case(i_indirect_type_0)
... ... @@ -5913,7 +5915,7 @@ if (debugging ||
5913 5915 put_serial_8(*((U8 *)(*(SP-1))));
5914 5916 (*(SP-1)) += 1;
5915 5917 }
5916   - IP += 1+1+get8(1);
  5918 + IP += 1+4+get32(1);
5917 5919 goto do_serializing;
5918 5920  
5919 5921 do_case(i_indirect_type_16)
... ... @@ -5922,7 +5924,7 @@ if (debugging ||
5922 5924 put_serial_16(*((U16 *)(*(SP-1))));
5923 5925 (*(SP-1)) += 2;
5924 5926 }
5925   - IP += 1+1+get8(1);
  5927 + IP += 1+4+get32(1);
5926 5928 goto do_serializing;
5927 5929  
5928 5930 do_case(i_indirect_type_32)
... ... @@ -5931,7 +5933,7 @@ if (debugging ||
5931 5933 put_serial_32(*((U32 *)(*(SP-1))));
5932 5934 (*(SP-1)) += 4;
5933 5935 }
5934   - IP += 1+1+get8(1);
  5936 + IP += 1+4+get32(1);
5935 5937 goto do_serializing;
5936 5938  
5937 5939  
... ... @@ -6880,7 +6882,7 @@ large type: Printable_tree (defined in basis.anubis)
6880 6882 }
6881 6883 else
6882 6884 {
6883   - U8 *type_des = IP+2;
  6885 + U8 *type_des = IP+5;
6884 6886 U32 start_bit = 0;
6885 6887 get_serial_8(R);
6886 6888 if (!check_small_datum(R,&start_bit,&type_des))
... ... @@ -6891,7 +6893,7 @@ large type: Printable_tree (defined in basis.anubis)
6891 6893 }
6892 6894 }
6893 6895 }
6894   - IP += 1+1+get8(1);
  6896 + IP += 1+4+get32(1);
6895 6897 goto do_unserializing;
6896 6898  
6897 6899 do_case(i_indirect_type_8)
... ... @@ -6917,7 +6919,7 @@ large type: Printable_tree (defined in basis.anubis)
6917 6919 }
6918 6920 else
6919 6921 {
6920   - U8 *type_des = IP+2;
  6922 + U8 *type_des = IP+5;
6921 6923 U32 start_bit = 0;
6922 6924 get_serial_8((U8)aux);
6923 6925 if (!check_small_datum(aux,&start_bit,&type_des))
... ... @@ -6933,7 +6935,7 @@ large type: Printable_tree (defined in basis.anubis)
6933 6935 }
6934 6936 }
6935 6937 }
6936   - IP += 1+1+get8(1);
  6938 + IP += 1+4+get32(1);
6937 6939 goto do_unserializing;
6938 6940  
6939 6941 do_case(i_type_16)
... ... @@ -6951,7 +6953,7 @@ large type: Printable_tree (defined in basis.anubis)
6951 6953 }
6952 6954 else
6953 6955 {
6954   - U8 *type_des = IP+2;
  6956 + U8 *type_des = IP+5;
6955 6957 U32 start_bit = 0;
6956 6958 get_serial_16(R);
6957 6959 if (!check_small_datum(R,&start_bit,&type_des))
... ... @@ -6962,7 +6964,7 @@ large type: Printable_tree (defined in basis.anubis)
6962 6964 }
6963 6965 }
6964 6966 }
6965   - IP += 1+1+get8(1);
  6967 + IP += 1+4+get32(1);
6966 6968 goto do_unserializing;
6967 6969  
6968 6970 do_case(i_indirect_type_16)
... ... @@ -6988,7 +6990,7 @@ large type: Printable_tree (defined in basis.anubis)
6988 6990 }
6989 6991 else
6990 6992 {
6991   - U8 *type_des = IP+2;
  6993 + U8 *type_des = IP+5;
6992 6994 U32 start_bit = 0;
6993 6995 get_serial_16((U16)aux);
6994 6996 if (!check_small_datum(aux,&start_bit,&type_des))
... ... @@ -7004,7 +7006,7 @@ large type: Printable_tree (defined in basis.anubis)
7004 7006 }
7005 7007 }
7006 7008 }
7007   - IP += 1+1+get8(1);
  7009 + IP += 1+4+get32(1);
7008 7010 goto do_unserializing;
7009 7011  
7010 7012 do_case(i_type_32)
... ... @@ -7022,7 +7024,7 @@ large type: Printable_tree (defined in basis.anubis)
7022 7024 }
7023 7025 else
7024 7026 {
7025   - U8 *type_des = IP+2;
  7027 + U8 *type_des = IP+5;
7026 7028 U32 start_bit = 0;
7027 7029 get_serial_32(R);
7028 7030 if (!check_small_datum(R,&start_bit,&type_des))
... ... @@ -7033,7 +7035,7 @@ large type: Printable_tree (defined in basis.anubis)
7033 7035 }
7034 7036 }
7035 7037 }
7036   - IP += 1+1+get8(1);
  7038 + IP += 1+4+get32(1);
7037 7039 goto do_unserializing;
7038 7040  
7039 7041  
... ... @@ -7052,14 +7054,14 @@ large type: Printable_tree (defined in basis.anubis)
7052 7054 }
7053 7055 else
7054 7056 {
7055   - U8 *alt_des = IP+4;
7056   - /* type_small_alt (U8)n (U8)index_width (U8)index (U8)nc <components>
  7057 + U8 *alt_des = IP+7;
  7058 + /* type_small_alt (U32)n (U8)index_width (U8)index (U8)nc <components>
7057 7059 alt description begins at nc */
7058   - U32 start_bit = IP[2]; /* index width (in fact always 2, because type is mixed) */
  7060 + U32 start_bit = IP[5]; /* index width (in fact always 2, because type is mixed) */
7059 7061  
7060 7062 get_serial_32(R);
7061 7063 /* check the index and the components */
7062   - if ((R & ((1<<start_bit)-1)) != IP[3] ||
  7064 + if ((R & ((1<<start_bit)-1)) != IP[6] ||
7063 7065 !check_small_alt_datum(R,&start_bit,&alt_des))
7064 7066 {
7065 7067 ufflag = 1;
... ... @@ -7072,7 +7074,7 @@ large type: Printable_tree (defined in basis.anubis)
7072 7074 }
7073 7075 }
7074 7076 }
7075   - IP += 1+1+get8(1);
  7077 + IP += 1+4+get32(1);
7076 7078 goto do_unserializing;
7077 7079  
7078 7080  
... ... @@ -7099,7 +7101,7 @@ large type: Printable_tree (defined in basis.anubis)
7099 7101 }
7100 7102 else
7101 7103 {
7102   - U8 *type_des = IP+2;
  7104 + U8 *type_des = IP+5;
7103 7105 U32 start_bit = 0;
7104 7106 get_serial_32(aux);
7105 7107 if (!check_small_datum(aux,&start_bit,&type_des))
... ... @@ -7115,7 +7117,7 @@ large type: Printable_tree (defined in basis.anubis)
7115 7117 }
7116 7118 }
7117 7119 }
7118   - IP += 1+1+get8(1);
  7120 + IP += 1+4+get32(1);
7119 7121 goto do_unserializing;
7120 7122  
7121 7123  
... ...
anubis_dev/vm/src/vmtools.c
  Show/Hide comments   View file @9263e56
... ... @@ -544,7 +544,7 @@ void link_globals_and_relocate(U8* code, int size)
544 544  
545 545 while (ptr-code < size)
546 546 {
547   - //#define never_defined
  547 +//#define never_defined
548 548 #ifdef never_defined
549 549 LOGINFO("relocating instr '%s' (%d) at offset %d\n",instr_names[*ptr],*ptr,ptr-code);
550 550 fflush(stdout);
... ... @@ -723,6 +723,7 @@ void link_globals_and_relocate(U8* code, int size)
723 723 case i_jmp:
724 724 case i_jmp_eq_stack:
725 725 case i_jmp_false:
  726 + case i_jmp_neq_0:
726 727 case i_jmp_neq_1:
727 728 case i_jmp_neq_2:
728 729 case i_jmp_neq_4:
... ... @@ -926,15 +927,15 @@ void link_globals_and_relocate(U8* code, int size)
926 927 if (nsc_file != NULL)
927 928 {
928 929 fprintf(nsc_file,"\n%8d | %s %d",ptr-code,instr_names[*ptr],
929   - *(ptr+1));
930   - for (k = 0; k < *(ptr+1); k++)
  930 + *((U32 *)(ptr+1)));
  931 + for (k = 0; k < *((U32 *)(ptr+1)); k++)
931 932 {
932   - fprintf(nsc_file,"%d",*(ptr+2+k));
  933 + fprintf(nsc_file,"%d ",*(ptr+5+k));
933 934 }
934 935 }
935 936 ptr++;
936   - k = (int)(*ptr);
937   - ptr += 1+k;
  937 + k = *(((U32 *)(ptr))++);
  938 + ptr += k;
938 939 break;
939 940  
940 941 default:
... ...