WebSVN – Kolibri OS – Diff – /programs/cmm/lisp/stdcall.h

+/*
+	STDCALL function
+	Author: PaulCodeman
+*/
-/* Lisp functions */
-:dword std_sleep(dword count, args)
-{
-	dword ret = 0;
-	dword arg = 0;
-	dword val = 0;
-	WHILE(count)
 void initFunctionLisp()
-		arg = DSDWORD[args];
+{
+	set_procedure("TEST",  #lisp_test);
-		REPEAT1:
+	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);
-		IF (DSDWORD[arg+4] == TSym)
+	set_procedure("DEFVAR", #lisp_setq);
-		{
-			arg = std_get(1, args);
+	set_procedure("+",     #lisp_add);
-			goto REPEAT1;
+	set_procedure("-",     #lisp_sub);
 	set_procedure("=",     #lisp_cmp);
+}
-		IF (DSDWORD[arg+4] == TInt)
 dword lisp_test(dword args)
-			EAX = 5;
+{
-			EBX = DSDWORD[arg];
+	malloc(sizeStruct);
-			$int 0x40
-		}
-		args+=4;
+	DSDWORD[EAX] = TString;
-		count--;
+	DSDWORD[EAX+4] = "ZZZ";
-	}
-	RETURN ret;
 	return EAX;
+}
 :dword std_set(dword count, args)
+dword lisp_setq(dword args)
+{
-	dword name = 0;
+	dword i = 0;
+	dword name = 0;
+	dword data = 0;
+	while(1)
+	{
+		i++;
-	dword value = 0;
+		data = indexArray(args, i);
+		data = DSDWORD[data];
+		IF (!data) break;
 	WHILE(count > 0)
-	{
+		if (i&1)
-		name = DSDWORD[args];
+		{
-		IF (DSDWORD[name+4] == TSym) name = DSDWORD[name];
+			name = DSDWORD[data+4];
 		ELSE
-		{
+		else
-			con_printf stdcall ("Error variable!");
 			ExitProcess();
-		}
-		args += 4;
-		value = DSDWORD[args];
-		args += 4;
-		variables.set(name, value);
-		count -= 2;
+			set_variable(name, data);
+		}
+	}
-}
+	return 0;
+}
-:dword std_get(dword count, args)
-{
+dword lisp_print(dword args)
-	dword name = 0;
+{
-	IF(!count) RETURN 0;
-	name = DSDWORD[args];
+	dword i = 0;
+	consoleInit();
-	IF (DSDWORD[name+4] != TSym)
+	while(1)
 	{
+		i++;
-		con_printf stdcall ("Error variable!");
+		indexArray(args, i);
-		ExitProcess();
+		IF (!DSDWORD[EAX]) break;
+		con_printf stdcall (string(DSDWORD[EAX]));
+	}
-	RETURN variables.get(DSDWORD[name]);
+	con_printf stdcall ("\r\n");
 	return 0;
+}
-: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 lisp_stdcall(dword args)
+{
+	dword i = 0;
+	dword buffer = 0;
-	dword ret = 0;
+	while(1)
-	WHILE(count)
+	{
-	{
+		i++;
-		ret += DSDWORD[args];
+		indexArray(args, i);
+		buffer = DSDWORD[EAX];
+		IF (!buffer) break;
+		$push DSDWORD[buffer+4];
+	}
-		args+=4;
+	IF (i == 2) $pop eax
-		count--;
+	IF (i == 3) $pop ebx
-	}
+	IF (i == 4) $pop ecx
-	RETURN ret;
+	$int 0x40
+	return EAX;
+}
-}
+dword lisp_input(dword args)
+{
+	dword buffer = 0;
+	consoleInit();
+	buffer = malloc(100);
-:dword std_exit(dword count, args)
+	con_gets stdcall(buffer, 100);
-{
+	malloc(sizeStruct);
-	IF(initConsole) con_exit stdcall (1);
+	DSDWORD[EAX] = TString;
+	DSDWORD[EAX+4] = buffer;
-	ExitProcess();
+	return EAX;
+}
-}
 dword lisp_inc(dword args)
+{
-:dword std_sub(dword count, args)
+	dword i = 0;
-{
+	dword sum = 0;
-	dword ret = 0;
+	dword buffer = 0;
-	IF(count)
+	while(1)
-	{
-		ret = DSDWORD[args];
-		count--;
-		args+=4;
-	}
+	{
-	WHILE(count)
-	{
-		ret -= DSDWORD[args];
+		i++;
-		args += 4;
+		buffer = indexArray(args, i);
-		count--;
-	}
-	RETURN ret;
-}
-:dword std_type(dword count, args)
-{
-	dword ret = 0;
-	dword arg = 0;
+		IF (!DSDWORD[buffer]) break;
-	dword val = 0;
+		buffer = DSDWORD[buffer];
-	ret = malloc(TLen);
+	}
-	DSDWORD[ret] = "nil";
+	return 0;
+}
 	DSDWORD[ret+4] = TStr;
-	WHILE(count)
-	{
-		arg = DSDWORD[args];
+dword lisp_add(dword args)
-		REPEAT1:
+{
-		IF (DSDWORD[arg+4] == TSym)
-		{
-			arg = std_get(1, args);
+	dword i = 0;
-			goto REPEAT1;
-		}
-		switch (DSDWORD[arg+4])
+	dword sum = 0;
-		{
-			case TStr:
-				DSDWORD[ret] = "string";
-			break;
-			case TInt:
-				DSDWORD[ret] = "integer";
-			break;
-		}
-		args+=4;
-		count--;
-	}
-	RETURN ret;
-}
-/* Console functions */
-:dword std_print(dword count, args)
-{
-	dword ret = 0;
-	dword arg = 0;
-	dword val = 0;
-	consoleInit();
-	IF (!count) con_printf stdcall ("nil");
-	WHILE(count)
-	{
+	dword buffer = 0;
-		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);
+	while(1)
+	{
+		i++;
+		buffer = indexArray(args, i);
-			goto REPEAT1;
+		IF (!DSDWORD[buffer]) break;
 		buffer = DSDWORD[buffer];
-		IF(!arg) con_printf stdcall ("nil");
-		ELSE con_printf stdcall (val);
+		sum += number(buffer);
-		args+=4;
-		count--;
+	}
-	}
+	malloc(sizeStruct);
-	RETURN ret;
-}
-:dword std_len(dword count, args)
+	DSDWORD[EAX] = TNumber;
 	DSDWORD[EAX+4] = sum;
-	dword ret = 0;
-	dword arg = 0;
-	dword val = 0;
-	ret = malloc(TLen);
-	DSDWORD[ret] = 0;
+	return EAX;
-	DSDWORD[ret+4] = TInt;
+}
-	WHILE(count)
-	{
-		arg = DSDWORD[args];
-		REPEAT1:
+dword lisp_sub(dword args)
-		IF (DSDWORD[arg+4] == TStr) val = DSDWORD[arg];
-		ELSE IF (DSDWORD[arg+4] == TSym)
+{
+	dword i = 0;
+	dword sum = 0;
+	while(1)
-			arg = std_get(1, args);
+	{
-			goto REPEAT1;
+		i++;
-		}
+		indexArray(args, i);
-		ELSE return ret;
-		DSDWORD[ret] += DSDWORD[arg+8];
-		args+=4;
-		count--;
-	}
-	RETURN ret;
-}
-:dword std_cmp(dword count, args)
-{
-	dword ret = 0;
-	dword arg = 0;
-	dword val = 0;
-	dword tmp = 0;
+		IF (!DSDWORD[EAX]) break;
-	dword x = 0;
+		sum -= number(DSDWORD[EAX]);
-	dword y = 0;
+	}
-	byte start = 0;
+	malloc(sizeStruct);
+	DSDWORD[EAX] = TNumber;
+	DSDWORD[EAX+4] = sum;
-	ret = malloc(TLen);
+	return EAX;
+}
-	DSDWORD[ret] = 0;
-	DSDWORD[ret+4] = TInt;
+dword lisp_cmp(dword args)
-	IF (!count) return ret;
+{
-	while(count)
+	dword i = 0;
 	dword first = 0;
-		arg = DSDWORD[args];
+	dword buffer = 0;
-		REPEAT2:
-		IF (DSDWORD[arg+4] == TSym)
-		{
-			arg = std_get(1, args);
 			goto REPEAT2;
-		}
-		IF (!start)
+	while(1)
+	{
-			start = 1;
+		i++;
-			tmp = arg;
-			args+=4;
-			count--;
+		buffer = indexArray(args, i);
-			continue;
+		buffer = DSDWORD[buffer];
-		}
+		IF (!buffer) break;
-		IF (DSDWORD[tmp+4] != DSDWORD[arg+4]) return ret;
+		if (i == 1)
-		IF (DSDWORD[tmp+4] == TInt)
+		{
 			first = buffer;
-			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;
+		else
-	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;
+		{
-}
-void Init()
+			if (DSDWORD[first+4] != DSDWORD[buffer+4])
-{
-	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);
+				malloc(sizeStruct);
-	/* System functions */
-	functions.set("exit", #std_exit);
-	/* Math functions */
-	functions.set("+", #std_add);
-	functions.set("-", #std_sub);
-	functions.set("==", #std_cmp);
+				DSDWORD[EAX] = TSymbol;
 				DSDWORD[EAX+4] = NIL;
-	/* Lisp functions */
+				return EAX;
 	functions.set("set", #std_set);
+		}
-	functions.set("get", #std_get);
+	}
-	functions.set("type", #std_type);
+	if (i == 1) error_message("*** - EVAL: too few arguments given to =: (=)");
+	malloc(sizeStruct);
+	DSDWORD[EAX] = TSymbol;
+	DSDWORD[EAX+4] = "T";
-	functions.set("sleep", #std_sleep);
+	return EAX;
+}

Subversion Repositories Kolibri OS

(root)/programs/cmm/lisp/stdcall.h – Rev 7745 → 7844