Changeset 11715 for lang/c

Timestamp:

05/17/08 06:52:58 (6 months ago)

Author:

mokehehe

Message:

Cからグローバルの関数を呼びだせるようにした

Location:

lang/c/misc/mlisp

Files:

• Rakefile (modified) (1 diff)
• core/inner.h (modified) (1 diff)
• core/s_util.cpp (modified) (1 diff)
• core/v_vm.cpp (modified) (3 diffs)
• core/v_vm.h (modified) (1 diff)
• inc/mlisp.h (modified) (1 diff)
• mlisp.vcproj (modified) (2 diffs)
• readme.txt (modified) (2 diffs)
• test/main.cpp (modified) (2 diffs)

lang/c/misc/mlisp/Rakefile

@@ -11 +11 @@
 
 
-OBJ_PATH = "objs"
+OBJ_PATH = "obj"
 OBJ_EXT = ".o"
 

lang/c/misc/mlisp/core/inner.h

@@ -6 +6 @@
 
 #include "sexp.h"
+#include "mlisp.h"
 
 #ifndef FALSE

lang/c/misc/mlisp/core/s_util.cpp

@@ -26 +26 @@
                 }
         }
+        va_end(ap);
         return head;
 }

lang/c/misc/mlisp/core/v_vm.cpp

@@ -178 +178 @@
 
 static SExp continuation(int s) {
-        SExp body = list(3, REFER_LOCAL, int2s(0), list(3, NUATE, save_stack(s), list(2, RETURN, int2s(0))));
+        SExp body = list(3, REFER_LOCAL, int2s(0), list(3, NUATE, save_stack(s), list(1, RETURN)));
         return closure(1, 1, body, 0, 0);
 }
@@ -206 +206 @@
         *px = index(ss, 0);     *pf = s2int(index(ss, 1));      *pc = index(ss, 2);
         return ss - 3;
+}
+
+
+static int apply(SExp fn, SExp argnum, int s, SExp* pa, SExp* px, sint* pf, SExp* pc, int* ps) {
+        int r = 0;
+        if (type_of(fn) == tProc) {
+                int ss = push(argnum, s);
+                int n = s2int(argnum);
+                Procedure* proc = (Procedure*)fn.ptr;
+                if (check_arg_num(proc, n)) {
+                        switch (proc->get_func_type()) {
+                        case Procedure::Builtin:
+                                {
+                                        SCFunc cfunc = proc->u.cfunc;
+                                        SExp res = (*cfunc)(ss);
+                                        *pa = res;
+                                        *ps = vm_return(px, pf, pc, ss);
+                                }
+                                break;
+                        case Procedure::Cell:
+                                {
+                                        modify_args(proc, n, s);
+                                        *px = closure_body(fn); *pf = ss;       *pc = fn;       *ps = ss;
+                                }
+                                r = 1;
+                                break;
+                        }
+                } else {
+                        runtime_error("wrong number of argument");
+                        r = -1;
+                }
+        } else {
+                runtime_error("can't call");
+                r = -1;
+        }
+        return r;
+}
+
+#include <malloc.h>             //<alloca.h>
+#include <stdarg.h>
+SExp vm_apply(SExp fn, int narg, ...) {
+        int s = 0;
+        SExp c = nil;
+        sint f = 0;
+        SExp ret = list(1, HALT);
+
+        // FRAME
+        s = push(ret, push(int2s(f), push(c, s)));
+
+        // argments
+        SExp* buf = (SExp*)alloca(sizeof(SExp) * narg);
+        va_list ap;
+        va_start(ap, narg);
+        for (int i=0; i<narg; ++i) {
+                buf[i] = va_arg(ap, SExp);
+        }
+        va_end(ap);
+        for (int i=narg; --i>=0; ) {
+                s = push(buf[i], s);
+        }
+
+        SExp a, x;
+        if (apply(fn, int2s(narg), s, &a, &x, &f, &c, &s) == 1) {
+                a = vm(a, x, f, c, s);
+        }
+        return a;
 }
 
@@ -273 +339 @@
                         x = xx;
                 } else if (op == APPLY) {
-                        if (type_of(a) == tProc) {
-                                SExp argnum = cadr(x);
-                                int ss = push(argnum, s);
-                                int n = s2int(argnum);
-                                Procedure* proc = (Procedure*)a.ptr;
-                                if (check_arg_num(proc, n)) {
-                                        modify_args(proc, n, s);
-                                        switch (proc->get_func_type()) {
-                                        case Procedure::Builtin:
-                                                {
-                                                        SCFunc cfunc = proc->u.cfunc;
-                                                        SExp res = (*cfunc)(ss);
-                                                        a = res;
-                                                        s = vm_return(&x, &f, &c, ss);
-                                                }
-                                                break;
-                                        case Procedure::Cell:
-                                                {
-                                                        x = closure_body(a);    f = ss; c = a;  s = ss;
-                                                }
-                                                break;
-                                        }
-                                } else {
-                                        runtime_error("wrong number of argument");
-                                }
-                        } else {
-                                runtime_error("can't call");
-                                break;
-                        }
+                        SExp argnum = cadr(x);
+                        apply(a, argnum, s, &a, &x, &f, &c, &s);
                 } else if (op == RETURN) {
                         s = vm_return(&x, &f, &c, s);

lang/c/misc/mlisp/core/v_vm.h

@@ -14 +14 @@
 SExp vm(SExp a, SExp x, sint f, SExp c, int s);
 
-void define_global(SExp sym, SExp val);
-
 #ifdef __cplusplus
 } //extern "C"

lang/c/misc/mlisp/inc/mlisp.h

@@ -27 +27 @@
 
 
+
+
+void define_global(SExp sym, SExp val);
+SExp refer_global(SExp sym);
+
+SExp vm_apply(SExp fn, int narg, ...);
+
+
 #ifdef __cplusplus
 } //extern "C"

lang/c/misc/mlisp/mlisp.vcproj

@@ -143 +143 @@
                                 RelativePath=".\core\sexp.cpp">
                         </File>
-                        <File
-                                RelativePath=".\core\sexp.h">
-                        </File>
                         <Filter
                                 Name="compiler"
@@ -193 +190 @@
                         </File>
                 </Filter>
+                <Filter
+                        Name="inc"
+                        Filter="">
+                        <File
+                                RelativePath=".\inc\mlisp.h">
+                        </File>
+                        <File
+                                RelativePath=".\inc\sexp.h">
+                        </File>
+                </Filter>
         </Files>
         <Globals>

lang/c/misc/mlisp/readme.txt

@@ -46 +46 @@
 -[v] �X�^�b�N�x�[�X�ɒu��������-[v] �C�ӌ‚̈��󂯎�
 -[x] �}�N�����
---[x] macroexpand ��- C �������[�o���̊֐���яo�������ɂ���- �unil�v�ut�v���V���{���Ȃ̂ŁA�R���p�C�������V���{���Q�ƂɂȂ�Ă��܂�
+--[x] macroexpand ��-[v] C �������[�o���̊֐���яo�������ɂ���- �unil�v�ut�v���V���{���Ȃ̂ŁA�R���p�C�������V���{���Q�ƂɂȂ�Ă��܂�
 - ��s���ɕϐ�������������Ƃ��̎�����
 - ��������
@@ -56 +56 @@
 --- �֐����ǂ����H
 --- ����������Ă邩�H�i��s����
+
+- �n�b�V�����
 
 - SDL �Ɨ��߂ĂȂ񂩍��i�e�g���X�j

lang/c/misc/mlisp/test/main.cpp

@@ -46 +46 @@
 
 
-int main(int argc, char* argv[])
-{
+void test_call() {
+        SExp src = read_from_string(
+                        "(define fib"
+                        "  (lambda (n)"
+                        "    (if (< n 2)"
+                        "        n"
+                        "      (+ (fib (- n 1))"
+                        "         (fib (- n 2))))))"
+                );
+
+        evaluate(src);
+
+        SExp r = vm_apply(refer_global(intern("fib")), 1, int2s(6));
+        print(r);
+}
+
+
+int main(int argc, char* argv[]) {
         mlisp_new(&vtbl);
+#if 1
         if (argc >= 2) {
                 if (setjmp(s_env) == 0) {
@@ -56 +73 @@
                 repl();
         }
+#else
+        test_call();
+#endif
         mlisp_delete();