forked from jlongster/dcpu-lisp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
lib.ol
115 lines (94 loc) · 2.1 KB
/
lib.ol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
(define-macro (return)
`(SET PC POP))
(define-macro (not exp)
`(begin
,exp
(IFE J 0)
(SET J 1)
(SET J 0)))
(define-macro (exit)
`(SET PC __exit))
;; arithmetic
(define-inline (+ t x y)
(SET t x)
(ADD t y))
(define-inline (- t x y)
(SET t x)
(SUB t y))
(define-inline (* t x y)
(SET t x)
(MUL t y))
(define-inline (/ t x y)
(SET t x)
(DIV t y))
(define-inline (% t x y)
(SET t x)
(MOD t y))
(define-inline (<< t x y)
(SET t x)
(SHL t y))
(define-inline (>> t x y)
(SET t x)
(SHR t y))
;; predicates
;; we must branch on the instruction after the test, and jump to a
;; unique place and return a success value. do this by creating an
;; internal function and using `SET PC` to jump right to it.
;; TODO: make these inlinable
(define (< x y)
(define (ret) (SET J 0))
(IFG x y)
(SET PC ret)
(IFE x y)
(SET PC ret)
(SET J 1))
(define (<= x y)
(define (ret) (SET J 0))
(IFG x y)
(SET PC ret)
(SET J 1))
(define (> x y)
(define (ret) (SET J 1))
(IFG x y)
(SET PC ret)
(SET J 0))
(define (>= x y)
(define (ret) (SET J 1))
(IFG x y)
(SET PC ret)
(IFE x y)
(SET PC ret)
(SET J 0))
(define (= x y)
(define (ret) (SET J 1))
(IFE x y)
(SET PC ret)
(SET J 0))
;; looping
;; TODO: this is a quick hack, and is recursive, while it should be
;; iterative. need to convert it into optimized assembly.
(define-macro (do act . body)
(if (not (symbol? (car act)))
(throw (str "do requires a variable name as "
" the first element: " act)))
(let ((var (car act)))
(cond
((== (length act) 3)
`(do (,var ,(cadr act)
(+ ,var 1)
(< ,var ,(caddr act)))
,@body))
((== (length act) 4)
(let ((name (gensym))
(start (cadr act))
(step (caddr act))
(cnd (car (cdddr act))))
`(begin
(define (,name ,var)
(if ,cnd
(begin
,@body
(,name ,step))))
(,name ,start))))
(else
(throw (str "invalid do: " `(do ,act ...)))))))