Subversion Repositories Kolibri OS

Rev

Rev 7844 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  1. /*
  2.  * Author Pavel Iakovlev by PaulCodeman
  3. */
  4.  
  5. #define MEMSIZE 4096*10
  6.  
  7. #include "../lib/io.h"
  8. #include "../lib/obj/console.h"
  9.  
  10. #define TString 1
  11. #define TSymbol 2
  12. #define TNumber 3
  13. #define TList   4
  14. #define Proc    5
  15. #define Lambda  6
  16. #define TObject 7
  17.  
  18. #define sizeStruct 4*4
  19.  
  20. byte initConsole = 0;
  21. dword maxLoop = 100;
  22. dword buffer = 0;
  23. dword bufferSize = 1000;
  24. dword variable = 0;
  25. dword key = 0;
  26. dword treeItem = 0;
  27. dword NIL = 0;
  28.  
  29. void consoleInit()
  30. {
  31.         IF(!initConsole)
  32.         {
  33.                 load_dll(libConsole, #con_init, 0);
  34.                 con_init stdcall (-1, -1, -1, -1, "Lisp interpreter");
  35.                 initConsole = 0xFF;
  36.         }
  37. }
  38.  
  39. dword error_message(dword text)
  40. {
  41.         con_printf stdcall (text);
  42.         ExitProcess();
  43. }
  44.  
  45. dword crc32Table = 0;
  46. dword makeCRCTable(void)
  47. {
  48.         dword i = 0;
  49.         dword c = 0;
  50.         dword ii = 0;
  51.         dword crcTable = 0;
  52.         IF (crc32Table) RETURN 0;
  53.         crc32Table = malloc(4*256);
  54.         crcTable = crc32Table;
  55.         WHILE (i < 256)
  56.         {
  57.                 c = i;
  58.                 ii = 0;
  59.                 WHILE (ii < 8)
  60.                 {
  61.                         IF (c&1)
  62.                         {
  63.                                 c >>= 1;
  64.                                 c ^= 0xEDB88320;
  65.                         }
  66.                         ELSE c >>= 1;
  67.                         ii++;
  68.                 }
  69.                 DSDWORD[crcTable] = c;
  70.                 crcTable += 4;
  71.                 i++;
  72.         }
  73. }
  74. dword crc32(dword bytes)
  75. {
  76.         dword crc = 0;
  77.         byte b = 0;
  78.         IF (!crc32Table) makeCRCTable();
  79.         crc = 0xFFFFFFFF;
  80.         WHILE (DSBYTE[bytes])
  81.         {
  82.                 b = DSBYTE[bytes];
  83.                 bytes++;
  84.                 EDX = crc^b;
  85.                 EDX &= 0xFF;
  86.                 EDX <<= 2;
  87.                 EDX += crc32Table;
  88.                 crc >>= 8;
  89.                 crc ^= DSDWORD[EDX];
  90.         }
  91.         RETURN crc ^ 0xFFFFFFFF;
  92. }
  93.  
  94. dword indexArray(dword address, key)
  95. {
  96.         dword offset = key&11b;
  97.         dword offsetAddress = offset*4+address;
  98.         IF (key==offset) RETURN 4*4+offsetAddress;
  99.         IF (!DSDWORD[offsetAddress]) DSDWORD[offsetAddress] = malloc(4*4*2);
  100.         RETURN indexArray(DSDWORD[offsetAddress], key>>2);
  101. }
  102.  
  103. void set_procedure(dword name, address)
  104. {
  105.         dword data = 0;
  106.         data = malloc(sizeStruct);
  107.         DSDWORD[data] = Proc;
  108.         DSDWORD[data+4] = address;
  109.         indexArray(variable, crc32(name));
  110.         DSDWORD[EAX] = data;
  111. }
  112.  
  113. void set_variable(dword name, data)
  114. {
  115.         indexArray(variable, crc32(name));
  116.         DSDWORD[EAX] = data;
  117. }
  118.  
  119. dword string(dword lisp)
  120. {
  121.         dword buffer = 0;
  122.         if (DSDWORD[lisp] == TList)
  123.         {
  124.                
  125.                 return "";
  126.         }
  127.         switch (DSDWORD[lisp])
  128.         {
  129.                 case TString:
  130.                 case TSymbol:
  131.                         return DSDWORD[lisp+4];
  132.                 case TNumber:
  133.                        
  134.                         return itoa(DSDWORD[lisp+4]);
  135.                 case Lambda:
  136.                         return "[LAMBDA]";
  137.                 case Proc:
  138.                         return "[PROC]";
  139.                 case TObject:
  140.                         return "[OBJECT]";
  141.                 case TList:
  142.                         return "[LIST]";
  143.         }
  144. }
  145.  
  146. dword number(dword lisp)
  147. {
  148.         if (DSDWORD[lisp] == TNumber)
  149.         {
  150.                 return DSDWORD[lisp+4];
  151.         }
  152.         if (DSDWORD[lisp] == TString)
  153.         {
  154.                 //return atoi(DSDWORD[lisp+4]);
  155.         }
  156.         return 0;
  157. }
  158.  
  159. dword lexer(dword code)
  160. {
  161.         byte s = 0;
  162.         dword alloc = 0;
  163.         dword buffer = 0;
  164.         dword position = 0;
  165.         dword key = 0;
  166.         alloc = malloc(32);
  167.         //con_printf stdcall(code);
  168.         while(DSBYTE[code])
  169.         {
  170.                 s = DSBYTE[code];
  171.                 code++;
  172.                 if (s == ' ') || (s == '\n') || (s == '\t') || (s == '\r') continue;
  173.                 if (s == '(') || (s == ')')
  174.                 {
  175.                         buffer = malloc(2);
  176.                         DSBYTE[buffer] = s;
  177.                         indexArray(alloc, key);
  178.                         DSDWORD[EAX] = buffer;
  179.                         key++;
  180.                         continue;
  181.                 }
  182.                 buffer = malloc(25);
  183.                 position = buffer;
  184.                 DSBYTE[position] = s;
  185.                 if (s == '"')
  186.                 {
  187.                         while(DSBYTE[code])
  188.                         {
  189.                                 s = DSBYTE[code];
  190.                                 position++;
  191.                                 DSBYTE[position] = s;
  192.                                 code++;
  193.                                 if (s == '"') && (DSBYTE[code-2] != '\\') break;
  194.                         }
  195.                 }
  196.                 else
  197.                 {
  198.                         while(DSBYTE[code])
  199.                         {
  200.                                 s = DSBYTE[code];
  201.                                 if (s == ' ') || (s == '\n') || (s == '\t') || (s == '\r') || (s == '(') || (s == ')') break;
  202.                                 position++;
  203.                                 DSBYTE[position] = s;
  204.                                 code++;
  205.                         }
  206.                 }
  207.                 indexArray(alloc, key);
  208.                 DSDWORD[EAX] = buffer;
  209.                 key++;
  210.         }
  211.         indexArray(alloc, key);
  212.         DSDWORD[EAX] = 0;
  213.         /*key = 0;
  214.         do {
  215.         buffer = indexArray(alloc, key);
  216.         if (!DSDWORD[buffer]) break;
  217.         con_printf stdcall ("\r\n");
  218.         con_printf stdcall (DSDWORD[buffer]);key++;
  219.         } while(1);*/
  220.         return alloc;
  221. }
  222.  
  223.  
  224. dword tree(dword alloc)
  225. {
  226.         dword token = 0;
  227.         dword list = 0;
  228.         dword buffer = 0;
  229.         dword temp = 0;
  230.         dword listBuffer = 0;
  231.         dword i = 0;
  232.         token = indexArray(alloc, treeItem);
  233.         treeItem++;
  234.         buffer = DSDWORD[token];
  235.  
  236.         if (DSBYTE[buffer] == '(')
  237.         {
  238.                 list = malloc(32);
  239.                 while(1) {
  240.                         token = indexArray(alloc, treeItem);
  241.                         token = DSDWORD[token];
  242.                         if (!token) || (DSBYTE[token] == ')') break;
  243.                         buffer = indexArray(list, i);
  244.                         DSDWORD[buffer] = tree(alloc);
  245.                         i++;
  246.                 }
  247.                 treeItem++;
  248.                 indexArray(list, i);
  249.                 DSDWORD[EAX] = 0;
  250.                 malloc(sizeStruct);
  251.                 DSDWORD[EAX] = TList;
  252.                 DSDWORD[EAX+4] = list;
  253.                 return EAX;
  254.         }
  255.         return atom(DSDWORD[token]);
  256. }
  257.  
  258. dword hexdec2(dword buffer, length)
  259. {
  260.         dword r = 0;
  261.         length += buffer;
  262.         while (length != buffer)
  263.         {
  264.                 length--;
  265.                 r <<= 4;
  266.                 if (DSBYTE[length] >= 'A') && (DSBYTE[length] <= 'F') r |= DSBYTE[length]-'A'+10;
  267.                 else if (DSBYTE[length] >= 'a') && (DSBYTE[length] <= 'f') r |= DSBYTE[length]-'a'+10;
  268.                 else if (DSBYTE[length] >= '0') && (DSBYTE[length] <= '9') r |= '9'-DSBYTE[length];
  269.         }
  270.         return r;
  271. }
  272.  
  273. dword atom(dword token)
  274. {
  275.         dword buffer = 0;
  276.         dword pos = 0;
  277.         dword data = 0;
  278.         if (DSBYTE[token] == '-') && (DSBYTE[token+1] >= '0') && (DSBYTE[token+1] <= '9')
  279.         {
  280.                 malloc(sizeStruct);
  281.                 DSDWORD[EAX] = TNumber;
  282.                 DSDWORD[EAX+4] = atoi(token);
  283.                 return EAX;
  284.         }
  285.         if (DSBYTE[token] >= '0') && (DSBYTE[token] <= '9')
  286.         {
  287.                 while (DSBYTE[token]) && (DSBYTE[token] >= '0') && (DSBYTE[token] <= '9')
  288.                 {
  289.                         data *= 10;
  290.                         data += DSBYTE[token]-'0';
  291.                         token++;
  292.                 }
  293.  
  294.                 malloc(sizeStruct);
  295.                 DSDWORD[EAX] = TNumber;
  296.                 DSDWORD[EAX+4] = data;
  297.                 return EAX;
  298.         }
  299.         if (DSBYTE[token] == '"')
  300.         {      
  301.                 pos = token;
  302.                 buffer = token;
  303.                 pos++;
  304.                 while (DSBYTE[pos]) && (DSBYTE[pos] != '"')
  305.                 {
  306.                         if (DSBYTE[pos] == '\\')
  307.                         {
  308.                                 pos++;
  309.                                 switch (DSBYTE[pos])
  310.                                 {
  311.                                         case 'n': DSBYTE[buffer] = 13; break;
  312.                                         case 'r': DSBYTE[buffer] = 10; break;
  313.                                         case 't': DSBYTE[buffer] = 9;  break;
  314.                                         case 'x':
  315.                                                 pos++;
  316.                                                 DSBYTE[buffer] = hexdec2(pos, 2);
  317.                                                 pos++;
  318.                                         break;
  319.                                         default:
  320.                                                 DSBYTE[buffer] = DSBYTE[pos];
  321.                                 }
  322.                         }
  323.                         else DSBYTE[buffer] = DSBYTE[pos];
  324.                         buffer++;
  325.                         pos++;
  326.                 }
  327.                 DSBYTE[buffer] = 0;
  328.                 malloc(sizeStruct);
  329.                 DSDWORD[EAX] = TString;
  330.                 DSDWORD[EAX+4] = token;
  331.                 DSDWORD[EAX+8] = token-buffer;
  332.                 return EAX;
  333.         }
  334.         pos = token;
  335.         while (DSBYTE[pos])
  336.         {
  337.                 if (DSBYTE[pos] >= 'a') && (DSBYTE[pos] <= 'z') DSBYTE[pos] = DSBYTE[pos]-'a'+'A';
  338.                 pos++;
  339.         }
  340.         malloc(sizeStruct);
  341.         DSDWORD[EAX] = TSymbol;
  342.         DSDWORD[EAX+4] = token;
  343.         return EAX;
  344. }
  345.  
  346. dword lisp(dword tree)
  347. {
  348.         dword buffer = 0;
  349.         dword list = 0;
  350.         dword args = 0;
  351.         dword key = 0;
  352.         dword item = 0;
  353.  
  354.         switch (DSDWORD[tree])
  355.         {
  356.                 case TSymbol:
  357.                         buffer = indexArray(variable, crc32(DSDWORD[tree+4]));
  358.                         IF (!DSDWORD[buffer]) return tree;
  359.                         return DSDWORD[buffer];
  360.                 case TNumber:
  361.                 case TString:
  362.                         return tree;   
  363.                 case TList:
  364.                         list = DSDWORD[tree+4];
  365.                         buffer = indexArray(list, 0);
  366.                         if (!buffer) {
  367.                                 malloc(sizeStruct);
  368.                                 DSDWORD[buffer] = TSymbol;
  369.                                 DSDWORD[buffer+4] = NIL;
  370.                                 return buffer;
  371.                         }
  372.                        
  373.                         buffer = DSDWORD[buffer];
  374.                         if (DSDWORD[buffer] == TSymbol) || (DSDWORD[buffer] == TList)
  375.                         {
  376.                                 buffer = DSDWORD[buffer+4];
  377.                                 if (DSBYTE[buffer] == '\'') return tree;
  378.  
  379.                                 args = malloc(32);
  380.                                 key = 0;
  381.                                 while (1)
  382.                                 {
  383.                                         buffer = indexArray(list, key);
  384.                                         buffer = DSDWORD[buffer];
  385.                                         if (!buffer) break;
  386.                                         item = indexArray(args, key);
  387.                                         DSDWORD[item] = lisp(buffer);
  388.                                         key++;
  389.                                 }
  390.                                 item = indexArray(args, 0);
  391.                                 item = DSDWORD[item];
  392.                                 if (DSDWORD[item] == Proc)
  393.                                 {
  394.                                         EAX = DSDWORD[item+4];
  395.                                         EAX(args);
  396.                                         if (!EAX)
  397.                                         {
  398.                                                 malloc(sizeStruct);
  399.                                                 DSDWORD[EAX] = TSymbol;
  400.                                                 DSDWORD[EAX+4] = NIL;
  401.                                                 return EAX;
  402.                                         }
  403.                                         return EAX;
  404.                                 }
  405.                                 malloc(sizeStruct);
  406.                                 DSDWORD[EAX] = TSymbol;
  407.                                 DSDWORD[EAX+4] = NIL;
  408.                                 return EAX;
  409.                         }
  410.  
  411.                         malloc(sizeStruct);
  412.                                 DSDWORD[EAX] = TSymbol;
  413.                                 DSDWORD[EAX+4] = NIL;
  414.                                 return EAX;
  415.         }
  416. }
  417.  
  418. #include "stdcall.h"
  419.  
  420. void main()
  421. {
  422.         dword xxx = 0;
  423.         dword item = 0;
  424.         dword data = 0;
  425.        
  426.         buffer = malloc(bufferSize);
  427.  
  428.         variable = malloc(32);
  429.         NIL = "NIL";
  430.  
  431.         initFunctionLisp();
  432.        
  433.         if(DSBYTE[I_Param])
  434.         {
  435.                 IF(io.read(I_Param))
  436.                 {
  437.                         lisp(tree(lexer(EAX)));
  438.                 }
  439.         }
  440.         else
  441.         {
  442.                 consoleInit();
  443.                 con_printf stdcall ("Lisp v2.0\r\n");
  444.                 while(maxLoop)
  445.                 {
  446.                         treeItem = 0;
  447.                         con_printf stdcall ("\r\n$ ");
  448.                         con_gets stdcall(buffer+1, bufferSize);
  449.                         DSBYTE[buffer] = '(';
  450.                         xxx= lisp(tree(lexer(buffer)));
  451.                         con_printf stdcall (string(xxx));
  452.                         maxLoop--;
  453.                 }
  454.         }
  455.  
  456.         IF(initConsole) con_exit stdcall (1);
  457.         ExitProcess();
  458. }
  459.  
  460.