X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=ez.git;a=blobdiff_plain;f=ez.el;h=181a37a444a5f70a8c410bc11a431652c92c2dbd;hp=2fa15b717a50758a9257d5aeef3892c6e9cfbcad;hb=8455cb56b2ea86886949473c5e77175b9d713554;hpb=0bd73fc1b7524bf64d416f5d311e9775a8afb913 diff --git a/ez.el b/ez.el index 2fa15b7..181a37a 100644 --- a/ez.el +++ b/ez.el @@ -41,6 +41,11 @@ (defun ez-decode-signed-word (w) (ez-decode-signed-bits w 16)) +(defun ez-decode-signed-operand (operand operand-type) + (if (eq operand-type 'b) + (ez-decode-signed-byte operand) + (ez-decode-signed-word operand))) + (defun binformat (n &optional s) (unless s (setq s "")) @@ -99,6 +104,8 @@ ;; Global variables (defun ez-get-global-var (gvar) + (if (> gvar 239) + (error "Invalid global variable %d" gvar)) (ez-mem-ref-word (+ (* 2 gvar) ez-globalvartab-addr))) (defun ez-set-global-var (gvar val) @@ -234,28 +241,32 @@ (defun ez-get-zstring-chars (base-addr) (let ((addr base-addr) (chars nil) - (not-done t)) + (not-done t) + (word-count 0)) (while not-done (let ((components (ez-parse-zstring-word (ez-mem-ref-word addr)))) (setq chars (append chars (cdr components))) (setq addr (+ addr 2)) + (setq word-count (+ word-count 1)) (when (= (car components) 1) (setq not-done nil)))) - chars)) + (cons word-count chars))) (defun ez-get-zstring (base-addr) - (let ((chars (ez-get-zstring-chars base-addr)) - (cur 0) - (lock 0) - (abbrev-char nil) - (s "")) + (let* ((word-count-and-chars (ez-get-zstring-chars base-addr)) + (word-count (car word-count-and-chars)) + (chars (cdr word-count-and-chars)) + (cur 0) + (lock 0) + (abbrev-char nil) + (s "")) (dolist (char chars) (cond (abbrev-char (let ((abbrev-addr (* 2 (ez-mem-ref-word (+ ez-abbrevtab-addr (* 2 (+ (* (- abbrev-char 1) 32) char))))))) - (setq s (concat s (ez-get-zstring abbrev-addr)))) + (setq s (concat s (cdr (ez-get-zstring abbrev-addr))))) (setq abbrev-char nil)) ((memq char '(1 2 3)) ;Abbreviation (setq abbrev-char char)) @@ -267,7 +278,7 @@ (setq s (concat s (substring (elt ez-zstring-alphabets cur) char (+ char 1)))) (setq cur lock)))) - s)) + (cons word-count s))) ;; Call stack @@ -352,9 +363,7 @@ (defun ez-execute-instr () (let ((instr-pc (ez-get-pc)) (opbyte (ez-read-pc-byte-and-inc)) - (optype) - (opcode nil) - (operands)) + (optype) (opcode) (operands)) (cond ((<= #x0 opbyte #x1f) (setq optype '2op @@ -401,7 +410,11 @@ operands '() operand-types '())) ((<= #xC0 opbyte #xDF) - (error "Unsupported op %x" opbyte)) + (setq optype '2op + opcode (- opbyte #xc0)) + (let ((operands-and-types (ez-read-var-operands-and-inc))) + (setq operands (car operands-and-types) + operand-types (cdr operands-and-types)))) ((<= #xE0 opbyte #xFF) (setq optype 'var opcode (- opbyte #xe0)) @@ -481,8 +494,12 @@ '(((0op #x00) rtrue ez-op-rtrue) ((0op #x01) rfalse ez-op-rfalse) ((1op #x00) jz ez-op-jz) + ((1op #x05) inc ez-op-inc) + ((1op #x06) dec ez-op-dec) ((1op #x0B) ret ez-op-ret) ((1op #x0C) jump ez-op-jump) + ((2op #x05) inc_jg ez-op-inc-jg) + ((2op #x04) dec_jg ez-op-dec-jg) ((2op #x0D) store ez-op-store) ((1op #x0E) load ez-op-load) ((var #x01) storew ez-op-storew) @@ -501,7 +518,9 @@ ((1op #x03) get_parent ez-op-get-parent) ((2op #x0A) test_attr ez-op-test-attr) ((var #x03) put_prop ez-op-put-prop) - ((0op #x02) print ez-op-print))) + ((0op #x02) print ez-op-print) + ((0op #x0B) new_line ez-op-new-line) + ((var #x06) print_num ez-op-print-num))) (defun ez-op-ret (operands &optional operand-types) (let ((retval (car operands))) @@ -525,6 +544,31 @@ (ez-do-branch (memq (car operands) (cdr operands))) t) +(defun ez-op-jg (operands operand-types) + (let ((s1 (ez-decode-signed-operand (car operands) (car operand-types))) + (s2 (ez-decode-signed-operand (cadr operands) (cadr operand-types)))) + (ez-do-branch (> s1 s2))) + t) + +(defun ez-op-jl (operands operand-types) + (let ((s1 (ez-decode-signed-operand (car operands) (car operand-types))) + (s2 (ez-decode-signed-operand (cadr operands) (cadr operand-types)))) + (ez-do-branch (< s1 s2))) + t) + +(defun ez-op-inc-jg (operands operand-types) + (let ((var (car operands))) + (ez-op-inc (list var)) + (ez-op-jg (cons (ez-get-var var) (cdr operands)) (cons 'w (cdr operand-types)))) + t) + +(defun ez-op-dec-jl (operands operand-types) + (let ((var (car operands))) + (ez-op-dec (list var)) + (ez-op-jl (cons (ez-get-var var) (cdr operands)) (cons 'w (cdr operand-types)))) + t) + + (defun ez-op-jump (operands operand-types) (let ((offset (if (eq (car operand-types) 'b) (ez-decode-signed-byte (car operands)) @@ -532,6 +576,16 @@ (ez-set-pc (+ (ez-get-pc) offset -2))) t) +(defun ez-op-inc (operands &optional operand-types) + (let ((var (car operands))) + (ez-set-var var (mod (+ 1 (ez-get-var var)) #x10000))) + t) + +(defun ez-op-dec (operands &optional operand-types) + (let ((var (car operands))) + (ez-set-var var (mod (+ (ez-get-var var) 1) #x10000))) + t) + (defun ez-op-store (operands operand-types) (let ((var (car operands)) (a (cadr operands))) @@ -638,7 +692,20 @@ t)) (defun ez-op-print (operands operand-types) - (ez-print (ez-get-zstring (ez-get-pc))) + (let* ((word-count-and-string (ez-get-zstring (ez-get-pc))) + (word-count (car word-count-and-string)) + (string (cdr word-count-and-string))) + (ez-print string) + (ez-increment-pc (* 2 word-count))) + t) + +(defun ez-op-new-line (operands operand-types) + (ez-print "\n") + t) + +(defun ez-op-print-num (operands operand-types) + (let ((s (ez-decode-signed-operand (car operands) (car operand-types)))) + (ez-print (number-to-string s))) t)