forked from KolibriOS/kolibrios
LISP: update version
git-svn-id: svn://kolibrios.org@7844 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
pavelyakov
parent
3aee626ccb
commit
da33359efc
@ -1 +0,0 @@
|
||||
(set var1 "test string")(print (get var1))
|
||||
@ -1,38 +1,30 @@
|
||||
/*
|
||||
* Author Pavel Iakovlev
|
||||
* Author Pavel Iakovlev by PaulCodeman
|
||||
*/
|
||||
|
||||
#define MEMSIZE 4096*10
|
||||
|
||||
#include "../lib/io.h"
|
||||
#include "../lib/obj/console.h"
|
||||
#include "../lib/array.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;
|
||||
Dictionary functions = {0};
|
||||
Dictionary variables = {0};
|
||||
|
||||
#include "stdcall.h"
|
||||
|
||||
#define bufferSize 10000;
|
||||
#define memoryBrainfuck 30000*4
|
||||
#define memoryByteBF 1
|
||||
#define stackBrainFuck 4*1024
|
||||
|
||||
#define TStr 1
|
||||
#define TInt 2
|
||||
#define TSym 3
|
||||
#define TBol 4
|
||||
|
||||
#define TLen 4*5
|
||||
|
||||
dword maxLoop = 100;
|
||||
dword buffer = 0;
|
||||
word bufferSymbol = 0;
|
||||
dword memory = 0;
|
||||
|
||||
dword stack = 0;
|
||||
dword code = 0;
|
||||
byte tempBuffer[100] = {0};
|
||||
dword bufferSize = 1000;
|
||||
dword variable = 0;
|
||||
dword key = 0;
|
||||
dword treeItem = 0;
|
||||
dword NIL = 0;
|
||||
|
||||
void consoleInit()
|
||||
{
|
||||
@ -44,188 +36,419 @@ void consoleInit()
|
||||
}
|
||||
}
|
||||
|
||||
dword evalLisp()
|
||||
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;
|
||||
byte args = 0;
|
||||
dword pos = 0;
|
||||
dword name = 0;
|
||||
dword tmp = 0;
|
||||
dword tmp2 = 0;
|
||||
dword dataArgs = 0;
|
||||
dword posArgs = 0;
|
||||
dword ret = 0;
|
||||
dword p = 0;
|
||||
dword i = 0;
|
||||
dword ii = 0;
|
||||
dataArgs = malloc(16*4);
|
||||
posArgs = dataArgs;
|
||||
|
||||
loop()
|
||||
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];
|
||||
while (s == ' ') || (s == 9) || (s == 10) || (s == 13)
|
||||
code++;
|
||||
if (s == ' ') || (s == '\n') || (s == '\t') || (s == '\r') continue;
|
||||
if (s == '(') || (s == ')')
|
||||
{
|
||||
code++;
|
||||
s = DSBYTE[code];
|
||||
}
|
||||
if (!s) return 0;
|
||||
if (s==')')
|
||||
{
|
||||
code++;
|
||||
args--;
|
||||
ret = StdCall(args, name, dataArgs);
|
||||
free(name);
|
||||
//free(dataArgs);
|
||||
return ret;
|
||||
}
|
||||
if(s == '(')
|
||||
{
|
||||
code++;
|
||||
DSDWORD[posArgs] = evalLisp();
|
||||
args++;
|
||||
posArgs += 4;
|
||||
buffer = malloc(2);
|
||||
DSBYTE[buffer] = s;
|
||||
indexArray(alloc, key);
|
||||
DSDWORD[EAX] = buffer;
|
||||
key++;
|
||||
continue;
|
||||
}
|
||||
else if (!args)
|
||||
buffer = malloc(25);
|
||||
position = buffer;
|
||||
DSBYTE[position] = s;
|
||||
if (s == '"')
|
||||
{
|
||||
if (s != ')') // name function
|
||||
while(DSBYTE[code])
|
||||
{
|
||||
name = malloc(100);
|
||||
pos = name;
|
||||
while (s) && (s != ' ') && (s != ')')
|
||||
{
|
||||
DSBYTE[pos] = s;
|
||||
pos++;
|
||||
code++;
|
||||
s = DSBYTE[code];
|
||||
}
|
||||
DSBYTE[pos] = 0;
|
||||
args++;
|
||||
continue;
|
||||
s = DSBYTE[code];
|
||||
position++;
|
||||
DSBYTE[position] = s;
|
||||
code++;
|
||||
if (s == '"') && (DSBYTE[code-2] != '\\') break;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if (s >= '0') && (s <= '9')
|
||||
while(DSBYTE[code])
|
||||
{
|
||||
tmp = 0;
|
||||
while (s >= '0') && (s <= '9')
|
||||
{
|
||||
tmp *= 10;
|
||||
tmp += s-'0';
|
||||
code++;
|
||||
s = DSBYTE[code];
|
||||
}
|
||||
args++;
|
||||
EDX = malloc(TLen);
|
||||
DSDWORD[EDX] = tmp;
|
||||
DSDWORD[EDX+4] = TInt;
|
||||
DSDWORD[posArgs] = EDX;
|
||||
posArgs += 4;
|
||||
continue;
|
||||
}
|
||||
else if (s == '"')
|
||||
{
|
||||
i = 1;
|
||||
tmp = malloc(1<<i);
|
||||
p = tmp;
|
||||
code++;
|
||||
s = DSBYTE[code];
|
||||
ii = 0;
|
||||
while (s != '"') && (s)
|
||||
{
|
||||
ii++;
|
||||
if (1<<i < ii)
|
||||
{
|
||||
i++;
|
||||
tmp2 = p-tmp;
|
||||
tmp = realloc(tmp, 1<<i);
|
||||
p = tmp+tmp2;
|
||||
}
|
||||
DSBYTE[p] = s;
|
||||
p++;
|
||||
|
||||
code++;
|
||||
s = DSBYTE[code];
|
||||
}
|
||||
DSBYTE[p] = 0;
|
||||
EDX = malloc(TLen);
|
||||
DSDWORD[EDX] = tmp;
|
||||
DSDWORD[EDX+4] = TStr;
|
||||
DSDWORD[EDX+8] = p-tmp;
|
||||
DSDWORD[posArgs] = EDX;
|
||||
posArgs += 4;
|
||||
if (s == ' ') || (s == '\n') || (s == '\t') || (s == '\r') || (s == '(') || (s == ')') break;
|
||||
position++;
|
||||
DSBYTE[position] = s;
|
||||
code++;
|
||||
args++;
|
||||
continue;
|
||||
}
|
||||
else
|
||||
}
|
||||
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] == '\\')
|
||||
{
|
||||
tmp = malloc(20);
|
||||
p = tmp;
|
||||
while (s) && (s != ')') && (s != '(') && (s != ' ') && (s != 10) && (s != 13)
|
||||
pos++;
|
||||
switch (DSBYTE[pos])
|
||||
{
|
||||
DSBYTE[p] = s;
|
||||
p++;
|
||||
code++;
|
||||
s = DSBYTE[code];
|
||||
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];
|
||||
}
|
||||
DSBYTE[p] = 0;
|
||||
args++;
|
||||
EDX = malloc(TLen);
|
||||
DSDWORD[EDX] = tmp;
|
||||
DSDWORD[EDX+4] = TSym;
|
||||
DSDWORD[posArgs] = EDX;
|
||||
posArgs += 4;
|
||||
continue;
|
||||
}
|
||||
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;
|
||||
}
|
||||
|
||||
DSDWORD[posArgs] = tmp;
|
||||
posArgs += 4;
|
||||
}
|
||||
code++;
|
||||
args++;
|
||||
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;
|
||||
}
|
||||
args--;
|
||||
ret = StdCall(args, name, dataArgs);
|
||||
free(name);
|
||||
//free(dataArgs);
|
||||
return ret;
|
||||
}
|
||||
|
||||
#include "stdcall.h"
|
||||
|
||||
void main()
|
||||
{
|
||||
dword brainFuckCode = 0;
|
||||
word maxLoop = 1000;
|
||||
dword txt = "(set name (input \"Enter you name: \"))(print \"You name \" (get name))";
|
||||
dword xxx = 0;
|
||||
dword item = 0;
|
||||
dword data = 0;
|
||||
|
||||
buffer = malloc(bufferSize);
|
||||
memory = malloc(memoryBrainfuck);
|
||||
stack = malloc(stackBrainFuck);
|
||||
|
||||
Init();
|
||||
variable = malloc(32);
|
||||
NIL = "NIL";
|
||||
|
||||
IF(DSBYTE[I_Param])
|
||||
initFunctionLisp();
|
||||
|
||||
if(DSBYTE[I_Param])
|
||||
{
|
||||
IF(io.read(I_Param))
|
||||
{
|
||||
code = EAX;
|
||||
evalLisp();
|
||||
lisp(tree(lexer(EAX)));
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
consoleInit();
|
||||
con_printf stdcall ("Lisp interpreter v1.5\r\n");
|
||||
con_printf stdcall ("Lisp v2.0\r\n");
|
||||
while(maxLoop)
|
||||
{
|
||||
treeItem = 0;
|
||||
con_printf stdcall ("\r\n$ ");
|
||||
con_gets stdcall(buffer, bufferSize);
|
||||
code = EAX;
|
||||
//code = txt;
|
||||
con_printf stdcall ("Output: ");
|
||||
evalLisp();
|
||||
con_gets stdcall(buffer+1, bufferSize);
|
||||
DSBYTE[buffer] = '(';
|
||||
xxx= lisp(tree(lexer(buffer)));
|
||||
con_printf stdcall (string(xxx));
|
||||
maxLoop--;
|
||||
}
|
||||
}
|
||||
|
||||
@ -1,293 +1,193 @@
|
||||
/*
|
||||
STDCALL function
|
||||
Author: PaulCodeman
|
||||
*/
|
||||
|
||||
/* Lisp functions */
|
||||
|
||||
:dword std_sleep(dword count, args)
|
||||
void initFunctionLisp()
|
||||
{
|
||||
dword ret = 0;
|
||||
dword arg = 0;
|
||||
dword val = 0;
|
||||
WHILE(count)
|
||||
{
|
||||
arg = DSDWORD[args];
|
||||
REPEAT1:
|
||||
IF (DSDWORD[arg+4] == TSym)
|
||||
{
|
||||
arg = std_get(1, args);
|
||||
goto REPEAT1;
|
||||
}
|
||||
IF (DSDWORD[arg+4] == TInt)
|
||||
{
|
||||
EAX = 5;
|
||||
EBX = DSDWORD[arg];
|
||||
$int 0x40
|
||||
}
|
||||
args+=4;
|
||||
count--;
|
||||
}
|
||||
RETURN ret;
|
||||
set_procedure("TEST", #lisp_test);
|
||||
set_procedure("SLEEP", #lisp_sleep);
|
||||
set_procedure("PRINT", #lisp_print);
|
||||
set_procedure("INPUT", #lisp_input);
|
||||
set_procedure("STDCALL", #lisp_stdcall);
|
||||
set_procedure("SETQ", #lisp_setq);
|
||||
set_procedure("DEFVAR", #lisp_setq);
|
||||
set_procedure("+", #lisp_add);
|
||||
set_procedure("-", #lisp_sub);
|
||||
set_procedure("=", #lisp_cmp);
|
||||
}
|
||||
|
||||
:dword std_set(dword count, args)
|
||||
dword lisp_test(dword args)
|
||||
{
|
||||
malloc(sizeStruct);
|
||||
DSDWORD[EAX] = TString;
|
||||
DSDWORD[EAX+4] = "ZZZ";
|
||||
return EAX;
|
||||
}
|
||||
|
||||
dword lisp_setq(dword args)
|
||||
{
|
||||
dword i = 0;
|
||||
dword name = 0;
|
||||
dword value = 0;
|
||||
WHILE(count > 0)
|
||||
dword data = 0;
|
||||
while(1)
|
||||
{
|
||||
name = DSDWORD[args];
|
||||
IF (DSDWORD[name+4] == TSym) name = DSDWORD[name];
|
||||
ELSE
|
||||
i++;
|
||||
data = indexArray(args, i);
|
||||
data = DSDWORD[data];
|
||||
IF (!data) break;
|
||||
|
||||
if (i&1)
|
||||
{
|
||||
con_printf stdcall ("Error variable!");
|
||||
ExitProcess();
|
||||
name = DSDWORD[data+4];
|
||||
}
|
||||
args += 4;
|
||||
value = DSDWORD[args];
|
||||
args += 4;
|
||||
variables.set(name, value);
|
||||
count -= 2;
|
||||
}
|
||||
}
|
||||
|
||||
:dword std_get(dword count, args)
|
||||
{
|
||||
dword name = 0;
|
||||
IF(!count) RETURN 0;
|
||||
name = DSDWORD[args];
|
||||
IF (DSDWORD[name+4] != TSym)
|
||||
{
|
||||
con_printf stdcall ("Error variable!");
|
||||
ExitProcess();
|
||||
}
|
||||
RETURN variables.get(DSDWORD[name]);
|
||||
}
|
||||
|
||||
:dword std_str(dword count, args)
|
||||
{
|
||||
dword tmp = 0;
|
||||
IF(!count) RETURN "";
|
||||
tmp = malloc(15);
|
||||
itoa_(tmp,DSDWORD[args]);
|
||||
RETURN tmp;
|
||||
}
|
||||
|
||||
/* Math functions */
|
||||
:dword std_add(dword count, args)
|
||||
{
|
||||
dword ret = 0;
|
||||
WHILE(count)
|
||||
{
|
||||
ret += DSDWORD[args];
|
||||
args+=4;
|
||||
count--;
|
||||
}
|
||||
RETURN ret;
|
||||
}
|
||||
|
||||
:dword std_exit(dword count, args)
|
||||
{
|
||||
IF(initConsole) con_exit stdcall (1);
|
||||
ExitProcess();
|
||||
}
|
||||
|
||||
:dword std_sub(dword count, args)
|
||||
{
|
||||
dword ret = 0;
|
||||
IF(count)
|
||||
{
|
||||
ret = DSDWORD[args];
|
||||
count--;
|
||||
args+=4;
|
||||
}
|
||||
WHILE(count)
|
||||
{
|
||||
ret -= DSDWORD[args];
|
||||
args += 4;
|
||||
count--;
|
||||
}
|
||||
RETURN ret;
|
||||
}
|
||||
|
||||
:dword std_type(dword count, args)
|
||||
{
|
||||
dword ret = 0;
|
||||
dword arg = 0;
|
||||
dword val = 0;
|
||||
ret = malloc(TLen);
|
||||
DSDWORD[ret] = "nil";
|
||||
DSDWORD[ret+4] = TStr;
|
||||
WHILE(count)
|
||||
{
|
||||
arg = DSDWORD[args];
|
||||
REPEAT1:
|
||||
IF (DSDWORD[arg+4] == TSym)
|
||||
else
|
||||
{
|
||||
arg = std_get(1, args);
|
||||
goto REPEAT1;
|
||||
set_variable(name, data);
|
||||
}
|
||||
switch (DSDWORD[arg+4])
|
||||
{
|
||||
case TStr:
|
||||
DSDWORD[ret] = "string";
|
||||
break;
|
||||
case TInt:
|
||||
DSDWORD[ret] = "integer";
|
||||
break;
|
||||
}
|
||||
args+=4;
|
||||
count--;
|
||||
}
|
||||
RETURN ret;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Console functions */
|
||||
:dword std_print(dword count, args)
|
||||
dword lisp_print(dword args)
|
||||
{
|
||||
dword ret = 0;
|
||||
dword arg = 0;
|
||||
dword val = 0;
|
||||
dword i = 0;
|
||||
consoleInit();
|
||||
IF (!count) con_printf stdcall ("nil");
|
||||
WHILE(count)
|
||||
while(1)
|
||||
{
|
||||
arg = DSDWORD[args];
|
||||
REPEAT1:
|
||||
IF (DSDWORD[arg+4] == TInt) val = itoa(DSDWORD[arg]);
|
||||
ELSE IF (DSDWORD[arg+4] == TStr) val = DSDWORD[arg];
|
||||
ELSE IF (DSDWORD[arg+4] == TSym)
|
||||
{
|
||||
arg = std_get(1, args);
|
||||
goto REPEAT1;
|
||||
}
|
||||
IF(!arg) con_printf stdcall ("nil");
|
||||
ELSE con_printf stdcall (val);
|
||||
args+=4;
|
||||
count--;
|
||||
i++;
|
||||
indexArray(args, i);
|
||||
IF (!DSDWORD[EAX]) break;
|
||||
con_printf stdcall (string(DSDWORD[EAX]));
|
||||
}
|
||||
RETURN ret;
|
||||
con_printf stdcall ("\r\n");
|
||||
return 0;
|
||||
}
|
||||
|
||||
:dword std_len(dword count, args)
|
||||
dword lisp_stdcall(dword args)
|
||||
{
|
||||
dword ret = 0;
|
||||
dword arg = 0;
|
||||
dword val = 0;
|
||||
ret = malloc(TLen);
|
||||
DSDWORD[ret] = 0;
|
||||
DSDWORD[ret+4] = TInt;
|
||||
WHILE(count)
|
||||
dword i = 0;
|
||||
dword buffer = 0;
|
||||
while(1)
|
||||
{
|
||||
arg = DSDWORD[args];
|
||||
REPEAT1:
|
||||
IF (DSDWORD[arg+4] == TStr) val = DSDWORD[arg];
|
||||
ELSE IF (DSDWORD[arg+4] == TSym)
|
||||
{
|
||||
arg = std_get(1, args);
|
||||
goto REPEAT1;
|
||||
}
|
||||
ELSE return ret;
|
||||
DSDWORD[ret] += DSDWORD[arg+8];
|
||||
args+=4;
|
||||
count--;
|
||||
i++;
|
||||
indexArray(args, i);
|
||||
buffer = DSDWORD[EAX];
|
||||
IF (!buffer) break;
|
||||
$push DSDWORD[buffer+4];
|
||||
}
|
||||
RETURN ret;
|
||||
IF (i == 2) $pop eax
|
||||
IF (i == 3) $pop ebx
|
||||
IF (i == 4) $pop ecx
|
||||
$int 0x40
|
||||
return EAX;
|
||||
}
|
||||
|
||||
:dword std_cmp(dword count, args)
|
||||
dword lisp_input(dword args)
|
||||
{
|
||||
dword ret = 0;
|
||||
dword arg = 0;
|
||||
dword val = 0;
|
||||
dword tmp = 0;
|
||||
dword x = 0;
|
||||
dword y = 0;
|
||||
byte start = 0;
|
||||
ret = malloc(TLen);
|
||||
DSDWORD[ret] = 0;
|
||||
DSDWORD[ret+4] = TInt;
|
||||
IF (!count) return ret;
|
||||
while(count)
|
||||
{
|
||||
arg = DSDWORD[args];
|
||||
REPEAT2:
|
||||
IF (DSDWORD[arg+4] == TSym)
|
||||
{
|
||||
arg = std_get(1, args);
|
||||
goto REPEAT2;
|
||||
}
|
||||
IF (!start)
|
||||
{
|
||||
start = 1;
|
||||
tmp = arg;
|
||||
args+=4;
|
||||
count--;
|
||||
continue;
|
||||
}
|
||||
IF (DSDWORD[tmp+4] != DSDWORD[arg+4]) return ret;
|
||||
IF (DSDWORD[tmp+4] == TInt)
|
||||
{
|
||||
IF (DSDWORD[tmp] != DSDWORD[arg]) return ret;
|
||||
}
|
||||
ELSE IF (DSDWORD[tmp+4] == TStr)
|
||||
{
|
||||
/*IF (!DSDWORD[tmp+8]) DSDWORD[tmp+8] = crc32(DSDWORD[tmp]);
|
||||
IF (!DSDWORD[arg+8]) DSDWORD[arg+8] = crc32(DSDWORD[arg]);
|
||||
IF (DSDWORD[tmp+8] != DSDWORD[arg+8]) return ret;*/
|
||||
IF (strcmp(DSDWORD[tmp], DSDWORD[arg])) return ret;
|
||||
}
|
||||
args+=4;
|
||||
count--;
|
||||
}
|
||||
DSDWORD[ret] = 1;
|
||||
return ret;
|
||||
}
|
||||
|
||||
:dword std_input(dword count, args)
|
||||
{
|
||||
dword buf = 0;
|
||||
dword buffer = 0;
|
||||
consoleInit();
|
||||
buf = malloc(100);
|
||||
IF (count) std_print(count, args);
|
||||
con_gets stdcall(buf, 100);
|
||||
EDX = malloc(TLen);
|
||||
DSDWORD[EDX] = buf;
|
||||
DSDWORD[EDX+4] = TStr;
|
||||
RETURN EDX;
|
||||
buffer = malloc(100);
|
||||
con_gets stdcall(buffer, 100);
|
||||
malloc(sizeStruct);
|
||||
DSDWORD[EAX] = TString;
|
||||
DSDWORD[EAX+4] = buffer;
|
||||
return EAX;
|
||||
}
|
||||
|
||||
void Init()
|
||||
dword lisp_inc(dword args)
|
||||
{
|
||||
functions.init(100);
|
||||
|
||||
/* Console functions */
|
||||
functions.set("print", #std_print);
|
||||
functions.set("input", #std_input);
|
||||
|
||||
/* String functions */
|
||||
functions.set("str", #std_str);
|
||||
functions.set("len", #std_len);
|
||||
|
||||
/* System functions */
|
||||
functions.set("exit", #std_exit);
|
||||
|
||||
/* Math functions */
|
||||
functions.set("+", #std_add);
|
||||
functions.set("-", #std_sub);
|
||||
functions.set("==", #std_cmp);
|
||||
|
||||
/* Lisp functions */
|
||||
functions.set("set", #std_set);
|
||||
functions.set("get", #std_get);
|
||||
functions.set("type", #std_type);
|
||||
functions.set("sleep", #std_sleep);
|
||||
|
||||
|
||||
variables.init(100);
|
||||
dword i = 0;
|
||||
dword sum = 0;
|
||||
dword buffer = 0;
|
||||
while(1)
|
||||
{
|
||||
i++;
|
||||
buffer = indexArray(args, i);
|
||||
IF (!DSDWORD[buffer]) break;
|
||||
buffer = DSDWORD[buffer];
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
dword StdCall(dword count, name, args)
|
||||
dword lisp_add(dword args)
|
||||
{
|
||||
functions.get(name);
|
||||
IF(EAX) RETURN EAX(count, args);
|
||||
RETURN 0;
|
||||
dword i = 0;
|
||||
dword sum = 0;
|
||||
dword buffer = 0;
|
||||
while(1)
|
||||
{
|
||||
i++;
|
||||
buffer = indexArray(args, i);
|
||||
IF (!DSDWORD[buffer]) break;
|
||||
buffer = DSDWORD[buffer];
|
||||
|
||||
sum += number(buffer);
|
||||
}
|
||||
malloc(sizeStruct);
|
||||
DSDWORD[EAX] = TNumber;
|
||||
DSDWORD[EAX+4] = sum;
|
||||
return EAX;
|
||||
}
|
||||
|
||||
dword lisp_sub(dword args)
|
||||
{
|
||||
dword i = 0;
|
||||
dword sum = 0;
|
||||
while(1)
|
||||
{
|
||||
i++;
|
||||
indexArray(args, i);
|
||||
IF (!DSDWORD[EAX]) break;
|
||||
sum -= number(DSDWORD[EAX]);
|
||||
}
|
||||
malloc(sizeStruct);
|
||||
DSDWORD[EAX] = TNumber;
|
||||
DSDWORD[EAX+4] = sum;
|
||||
return EAX;
|
||||
}
|
||||
|
||||
dword lisp_cmp(dword args)
|
||||
{
|
||||
dword i = 0;
|
||||
dword first = 0;
|
||||
dword buffer = 0;
|
||||
|
||||
while(1)
|
||||
{
|
||||
i++;
|
||||
buffer = indexArray(args, i);
|
||||
buffer = DSDWORD[buffer];
|
||||
IF (!buffer) break;
|
||||
if (i == 1)
|
||||
{
|
||||
first = buffer;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (DSDWORD[first+4] != DSDWORD[buffer+4])
|
||||
{
|
||||
malloc(sizeStruct);
|
||||
DSDWORD[EAX] = TSymbol;
|
||||
DSDWORD[EAX+4] = NIL;
|
||||
return EAX;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (i == 1) error_message("*** - EVAL: too few arguments given to =: (=)");
|
||||
malloc(sizeStruct);
|
||||
DSDWORD[EAX] = TSymbol;
|
||||
DSDWORD[EAX+4] = "T";
|
||||
return EAX;
|
||||
}
|
||||
|
||||
dword lisp_sleep(dword args)
|
||||
{
|
||||
dword time = 0;
|
||||
indexArray(args, 1);
|
||||
time = number(DSDWORD[EAX]);
|
||||
EAX = 5;
|
||||
EBX = time;
|
||||
$int 0x40
|
||||
return 0;
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user