/* * Author Pavel Iakovlev by PaulCodeman */ #define MEMSIZE 4096*10 #include "../lib/io.h" #include "../lib/obj/console.h" #define TString 1 #define TSymbol 2 #define TNumber 3 #define TList 4 #define Proc 5 #define Lambda 6 #define TObject 7 #define sizeStruct 4*4 byte initConsole = 0; dword maxLoop = 100; dword buffer = 0; dword bufferSize = 1000; dword variable = 0; dword key = 0; dword treeItem = 0; dword NIL = 0; void consoleInit() { IF(!initConsole) { load_dll(libConsole, #con_init, 0); con_init stdcall (-1, -1, -1, -1, "Lisp interpreter"); initConsole = 0xFF; } } dword error_message(dword text) { con_printf stdcall (text); ExitProcess(); } dword crc32Table = 0; dword makeCRCTable(void) { dword i = 0; dword c = 0; dword ii = 0; dword crcTable = 0; IF (crc32Table) RETURN 0; crc32Table = malloc(4*256); crcTable = crc32Table; WHILE (i < 256) { c = i; ii = 0; WHILE (ii < 8) { IF (c&1) { c >>= 1; c ^= 0xEDB88320; } ELSE c >>= 1; ii++; } DSDWORD[crcTable] = c; crcTable += 4; i++; } } dword crc32(dword bytes) { dword crc = 0; byte b = 0; IF (!crc32Table) makeCRCTable(); crc = 0xFFFFFFFF; WHILE (DSBYTE[bytes]) { b = DSBYTE[bytes]; bytes++; EDX = crc^b; EDX &= 0xFF; EDX <<= 2; EDX += crc32Table; crc >>= 8; crc ^= DSDWORD[EDX]; } RETURN crc ^ 0xFFFFFFFF; } dword indexArray(dword address, key) { dword offset = key&11b; dword offsetAddress = offset*4+address; IF (key==offset) RETURN 4*4+offsetAddress; IF (!DSDWORD[offsetAddress]) DSDWORD[offsetAddress] = malloc(4*4*2); RETURN indexArray(DSDWORD[offsetAddress], key>>2); } void set_procedure(dword name, address) { dword data = 0; data = malloc(sizeStruct); DSDWORD[data] = Proc; DSDWORD[data+4] = address; indexArray(variable, crc32(name)); DSDWORD[EAX] = data; } void set_variable(dword name, data) { indexArray(variable, crc32(name)); DSDWORD[EAX] = data; } dword string(dword lisp) { dword buffer = 0; if (DSDWORD[lisp] == TList) { return ""; } switch (DSDWORD[lisp]) { case TString: case TSymbol: return DSDWORD[lisp+4]; case TNumber: return itoa(DSDWORD[lisp+4]); case Lambda: return "[LAMBDA]"; case Proc: return "[PROC]"; case TObject: return "[OBJECT]"; case TList: return "[LIST]"; } } dword number(dword lisp) { if (DSDWORD[lisp] == TNumber) { return DSDWORD[lisp+4]; } if (DSDWORD[lisp] == TString) { //return atoi(DSDWORD[lisp+4]); } return 0; } dword lexer(dword code) { byte s = 0; dword alloc = 0; dword buffer = 0; dword position = 0; dword key = 0; alloc = malloc(32); //con_printf stdcall(code); while(DSBYTE[code]) { s = DSBYTE[code]; code++; if (s == ' ') || (s == '\n') || (s == '\t') || (s == '\r') continue; if (s == '(') || (s == ')') { buffer = malloc(2); DSBYTE[buffer] = s; indexArray(alloc, key); DSDWORD[EAX] = buffer; key++; continue; } buffer = malloc(25); position = buffer; DSBYTE[position] = s; if (s == '"') { while(DSBYTE[code]) { s = DSBYTE[code]; position++; DSBYTE[position] = s; code++; if (s == '"') && (DSBYTE[code-2] != '\\') break; } } else { while(DSBYTE[code]) { s = DSBYTE[code]; if (s == ' ') || (s == '\n') || (s == '\t') || (s == '\r') || (s == '(') || (s == ')') break; position++; DSBYTE[position] = s; code++; } } indexArray(alloc, key); DSDWORD[EAX] = buffer; key++; } indexArray(alloc, key); DSDWORD[EAX] = 0; /*key = 0; do { buffer = indexArray(alloc, key); if (!DSDWORD[buffer]) break; con_printf stdcall ("\r\n"); con_printf stdcall (DSDWORD[buffer]);key++; } while(1);*/ return alloc; } dword tree(dword alloc) { dword token = 0; dword list = 0; dword buffer = 0; dword temp = 0; dword listBuffer = 0; dword i = 0; token = indexArray(alloc, treeItem); treeItem++; buffer = DSDWORD[token]; if (DSBYTE[buffer] == '(') { list = malloc(32); while(1) { token = indexArray(alloc, treeItem); token = DSDWORD[token]; if (!token) || (DSBYTE[token] == ')') break; buffer = indexArray(list, i); DSDWORD[buffer] = tree(alloc); i++; } treeItem++; indexArray(list, i); DSDWORD[EAX] = 0; malloc(sizeStruct); DSDWORD[EAX] = TList; DSDWORD[EAX+4] = list; return EAX; } return atom(DSDWORD[token]); } dword hexdec2(dword buffer, length) { dword r = 0; length += buffer; while (length != buffer) { length--; r <<= 4; if (DSBYTE[length] >= 'A') && (DSBYTE[length] <= 'F') r |= DSBYTE[length]-'A'+10; else if (DSBYTE[length] >= 'a') && (DSBYTE[length] <= 'f') r |= DSBYTE[length]-'a'+10; else if (DSBYTE[length] >= '0') && (DSBYTE[length] <= '9') r |= '9'-DSBYTE[length]; } return r; } dword atom(dword token) { dword buffer = 0; dword pos = 0; dword data = 0; if (DSBYTE[token] == '-') && (DSBYTE[token+1] >= '0') && (DSBYTE[token+1] <= '9') { malloc(sizeStruct); DSDWORD[EAX] = TNumber; DSDWORD[EAX+4] = atoi(token); return EAX; } if (DSBYTE[token] >= '0') && (DSBYTE[token] <= '9') { while (DSBYTE[token]) && (DSBYTE[token] >= '0') && (DSBYTE[token] <= '9') { data *= 10; data += DSBYTE[token]-'0'; token++; } malloc(sizeStruct); DSDWORD[EAX] = TNumber; DSDWORD[EAX+4] = data; return EAX; } if (DSBYTE[token] == '"') { pos = token; buffer = token; pos++; while (DSBYTE[pos]) && (DSBYTE[pos] != '"') { if (DSBYTE[pos] == '\\') { pos++; switch (DSBYTE[pos]) { case 'n': DSBYTE[buffer] = 13; break; case 'r': DSBYTE[buffer] = 10; break; case 't': DSBYTE[buffer] = 9; break; case 'x': pos++; DSBYTE[buffer] = hexdec2(pos, 2); pos++; break; default: DSBYTE[buffer] = DSBYTE[pos]; } } else DSBYTE[buffer] = DSBYTE[pos]; buffer++; pos++; } DSBYTE[buffer] = 0; malloc(sizeStruct); DSDWORD[EAX] = TString; DSDWORD[EAX+4] = token; DSDWORD[EAX+8] = token-buffer; return EAX; } pos = token; while (DSBYTE[pos]) { if (DSBYTE[pos] >= 'a') && (DSBYTE[pos] <= 'z') DSBYTE[pos] = DSBYTE[pos]-'a'+'A'; pos++; } malloc(sizeStruct); DSDWORD[EAX] = TSymbol; DSDWORD[EAX+4] = token; return EAX; } dword lisp(dword tree) { dword buffer = 0; dword list = 0; dword args = 0; dword key = 0; dword item = 0; switch (DSDWORD[tree]) { case TSymbol: buffer = indexArray(variable, crc32(DSDWORD[tree+4])); IF (!DSDWORD[buffer]) return tree; return DSDWORD[buffer]; case TNumber: case TString: return tree; case TList: list = DSDWORD[tree+4]; buffer = indexArray(list, 0); if (!buffer) { malloc(sizeStruct); DSDWORD[buffer] = TSymbol; DSDWORD[buffer+4] = NIL; return buffer; } buffer = DSDWORD[buffer]; if (DSDWORD[buffer] == TSymbol) || (DSDWORD[buffer] == TList) { buffer = DSDWORD[buffer+4]; if (DSBYTE[buffer] == '\'') return tree; args = malloc(32); key = 0; while (1) { buffer = indexArray(list, key); buffer = DSDWORD[buffer]; if (!buffer) break; item = indexArray(args, key); DSDWORD[item] = lisp(buffer); key++; } item = indexArray(args, 0); item = DSDWORD[item]; if (DSDWORD[item] == Proc) { EAX = DSDWORD[item+4]; EAX(args); if (!EAX) { malloc(sizeStruct); DSDWORD[EAX] = TSymbol; DSDWORD[EAX+4] = NIL; return EAX; } return EAX; } malloc(sizeStruct); DSDWORD[EAX] = TSymbol; DSDWORD[EAX+4] = NIL; return EAX; } malloc(sizeStruct); DSDWORD[EAX] = TSymbol; DSDWORD[EAX+4] = NIL; return EAX; } } #include "stdcall.h" void main() { dword xxx = 0; dword item = 0; dword data = 0; buffer = malloc(bufferSize); variable = malloc(32); NIL = "NIL"; initFunctionLisp(); if(DSBYTE[I_Param]) { IF(io.read(I_Param)) { lisp(tree(lexer(EAX))); } } else { consoleInit(); con_printf stdcall ("Lisp v2.0\r\n"); while(maxLoop) { treeItem = 0; con_printf stdcall ("\r\n$ "); con_gets stdcall(buffer+1, bufferSize); DSBYTE[buffer] = '('; xxx= lisp(tree(lexer(buffer))); con_printf stdcall (string(xxx)); maxLoop--; } } IF(initConsole) con_exit stdcall (1); ExitProcess(); }