X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=ez.git;a=blobdiff_plain;f=ez.el;h=22a4c78fd739fec9166a24e3f89136bccfe927c9;hp=4cea0751162b39b6cbb55bfbdf5d7f5e6f182d97;hb=d8227335527231b5d5205aca8113c54fa5dd2423;hpb=9ac00a55f5cf3053b2224fb6d1a6189905e51587 diff --git a/ez.el b/ez.el index 4cea075..22a4c78 100644 --- a/ez.el +++ b/ez.el @@ -28,7 +28,10 @@ ;;; Code: -;; Character set tables +;; Utility functions + +(defun ez-decode-signed-byte (b) + (lsh b )) ;; Memory @@ -236,7 +239,7 @@ ((= var 0) (ez-routine-stack-pop)) ((< var 16) - (ez-get-local-var (- var 1))) + (ez-get-local-var var)) (t (ez-get-global-var (- var 16))))) @@ -245,7 +248,7 @@ ((= var 0) (ez-routine-stack-push val)) ((< var 16) - (ez-set-local-var (- var 1) val)) + (ez-set-local-var var val)) (t (ez-set-global-var (- var 16) val)))) @@ -253,7 +256,8 @@ (ez-get-var (ez-read-pc-byte-and-inc))) (defun ez-execute-instr () - (let ((opbyte (ez-read-pc-byte-and-inc)) + (let ((instr-pc (ez-get-pc)) + (opbyte (ez-read-pc-byte-and-inc)) (optype) (opcode nil) (operands)) @@ -262,34 +266,41 @@ (setq optype '2op opcode opbyte operands (list (ez-read-pc-byte-and-inc) - (ez-read-pc-byte-and-inc)))) + (ez-read-pc-byte-and-inc)) + operand-types '(b b))) ((<= #x20 opbyte #x3F) (setq optype '2op opcode (- opbyte #x20) operands (list (ez-read-pc-byte-and-inc) - (ez-read-pc-var-and-inc)))) + (ez-read-pc-var-and-inc)) + operand-types '(b w))) ((<= #x40 opbyte #x5F) (setq optype '2op opcode (- opbyte #x40) operands (list (ez-read-pc-var-and-inc) - (ez-read-pc-byte-and-inc)))) + (ez-read-pc-byte-and-inc)) + operand-types '(w b))) ((<= #x60 opbyte #x7F) (setq optype '2op opcode (- opbyte #x60) operands (list (ez-read-pc-var-and-inc) - (ez-read-pc-var-and-inc)))) + (ez-read-pc-var-and-inc)) + operand-types '(w w))) ((<= #x80 opbyte #x8F) (setq optype '1op opcode (- opbyte #x80) - operands (list (ez-read-pc-word-and-inc)))) + operands (list (ez-read-pc-word-and-inc)) + operand-types '(w))) ((<= #x90 opbyte #x9F) (setq optype '1op opcode (- opbyte #x90) - operands (list (ez-read-pc-byte-and-inc)))) + operands (list (ez-read-pc-byte-and-inc)) + operand-types '(b))) ((<= #xA0 opbyte #xAF) (setq optype '1op opcode (- opbyte #xa0) - operands (list (ez-read-pc-var-and-inc)))) + operands (list (ez-read-pc-var-and-inc)) + operand-types '(w))) ((<= #xB0 opbyte #xBF) (setq optype '0op opcode (- opbyte #xb0))) @@ -297,16 +308,17 @@ (error "Unsupported op" opbyte)) ((<= #xE0 opbyte #xFF) (setq optype 'var - opcode (- opbyte #xe0) - operands (ez-read-var-operands-and-inc)))) + opcode (- opbyte #xe0)) + (let ((operands-and-types (ez-read-var-operands-and-inc))) + (setq operands (car operands-and-types) + operand-types (cdr operands-and-types))))) (let ((table-row (assoc (list optype opcode) ez-op-table))) (unless table-row (error "Unsupported op" optype opcode)) (let ((mnemonic (elt table-row 1))) - (message "Optype:%s Opcode:%x Operands:%s" - (symbol-name optype) - opcode operands)) - (apply (elt table-row 2) operands)))) + (message "PC:%x Optype:%s Opcode:%x Mnemonic:%s Operands:%s" + instr-pc optype opcode mnemonic operands)) + (funcall (elt table-row 2) operands operand-types)))) (defun ez-read-var-operands-and-inc () (let* ((type-byte (ez-read-pc-byte-and-inc)) @@ -328,27 +340,60 @@ nil (list type4))))))))))))) (operands nil)) - (mapcar - (lambda (type) - (cond - ((= type 0) (ez-read-pc-word-and-inc)) - ((= type 1) (ez-read-pc-byte-and-inc)) - ((= type 2) (ez-read-pc-var-and-inc)))) - types))) + (cons + (mapcar + (lambda (type) + (cond + ((= type 0) (ez-read-pc-word-and-inc)) + ((= type 1) (ez-read-pc-byte-and-inc)) + ((= type 2) (ez-read-pc-var-and-inc)))) + types) + (mapcar + (lambda (type) + (if (= type 1) + 'b + 'w)) + types))))) (defvar ez-op-table - '(((var #x0) call_fv ez-op-callf))) - -(defun ez-op-callf (raddr &rest operands) - (let* ((r (* 2 raddr)) + '(((2op #x14) add ez-op-add) + ((2op #x15) sub ez-op-sub) + ((2op #x16) mul ez-op-mul) + ((2op #x17) div ez-op-div) + ((2op #x18) mod ez-op-mod) + ((var #x00) call_fv ez-op-callf))) + +(defun ez-op-add (operands operand-types) + (let ((a (car operands)) + (b (cadr operands))) + (ez-set-var (ez-read-pc-byte-and-inc) (mod (+ a b) #x10000)))) + +(defun ez-op-sub (operands operand-types) + (let ((a (car operands)) + (b (cadr operands))) + (ez-set-var (ez-read-pc-byte-and-inc) (mod (+ (- a b) #x10000) #x10000)))) + +(defun ez-op-mul (a b) + (let ((a (car operands)) + (b (cadr operands))) + (ez-set-var (ez-read-pc-byte-and-inc) (mod (* a b) #x10000)))) + +(defun ez-op-div (a b)) + +(defun ez-op-mod (a b)) + +(defun ez-op-callf (operands operand-types) + (let* ((raddr (car operands)) + (call-operands (cdr operands)) + (r (* 2 raddr)) (L (ez-mem-ref-byte r)) - (n (length operands)) + (n (length call-operands)) (new-pc (+ r 1 (* L 2)))) (ez-add-call-stack-frame new-pc) (dotimes (i L) (if (< i n) - (ez-set-local-var (+ i 1) (elt operands i)) - (ez-set-local-var (+ i 1) (ez-mem-ref-byte (+ r 1 (* 2 i))))))) + (ez-set-local-var (+ i 1) (elt call-operands i)) + (ez-set-local-var (+ i 1) (ez-mem-ref-word (+ r 1 (* 2 i))))))) t) ;; Main @@ -366,26 +411,8 @@ (ez-parse-header) (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc))) (ez-execute-instr) - -(binformat #x9b) -"10 01 10 11" - -(* 2 #x2b07) - -"10011011" - -#b00101111 -(lsh #x2f) - ez-call-stack -(binformat #x2f) -"10 11 11" -(* 2 #x2b07) - - -(ez-get-obj 1) - (defun binformat (n &optional s) (unless s (setq s ""))