bitwise ops, unary negation
This commit is contained in:
parent
65101ad21d
commit
81ea4a4410
|
@ -20,20 +20,9 @@
|
||||||
(IMStartUp)
|
(IMStartUp)
|
||||||
(TextStartUp)
|
(TextStartUp)
|
||||||
|
|
||||||
(let (x 1 dx 2 lim (if (> dx 0) 10 -10) break [ssc.FALSE])
|
(printnum (& (- 10) 0xff))
|
||||||
(while (and (< x lim) (not break))
|
(printnum (| 10 0x8000))
|
||||||
(printnum x)
|
|
||||||
(set! x (+ x dx))
|
|
||||||
(if (= x 6) (set! break [ssc.TRUE]))))
|
|
||||||
|
|
||||||
(if (> (+ 1 2) (+ 3 4)) (printnum 0x1212) (printnum 0x3434))
|
|
||||||
(if (and (or (= 1 2) (< 3 4)) ;
|
|
||||||
(not (or (> 10 3) (<= 6 5))))
|
|
||||||
(printnum 0xdead) (printnum 0xbeef))
|
|
||||||
(let (x 5 y 10 test1 (< x y) test2 (> x y))
|
|
||||||
(printnum test1) (printnum test2)
|
|
||||||
(if test1 (printnum 0x1234) (printnum 0x5678))
|
|
||||||
(if test2 (printnum 0x1234) (printnum 0x5678)))
|
|
||||||
(TextShutDown)
|
(TextShutDown)
|
||||||
(IMShutDown)
|
(IMShutDown)
|
||||||
(MMShutDown UserID)
|
(MMShutDown UserID)
|
||||||
|
|
39
ssc/init.fnl
39
ssc/init.fnl
|
@ -123,6 +123,12 @@
|
||||||
cleanup (icollect [_ {: cleanup} (ipairs args)] (when cleanup (cleanup)))]
|
cleanup (icollect [_ {: cleanup} (ipairs args)] (when cleanup (cleanup)))]
|
||||||
(values (lume.concat [:block] setup [acc] operations cleanup) etype)))
|
(values (lume.concat [:block] setup [acc] operations cleanup) etype)))
|
||||||
|
|
||||||
|
(fn Ssc.simple-accumulator [self op etype {: lo : hi} ?defaulthi]
|
||||||
|
(match etype
|
||||||
|
:word (lo op)
|
||||||
|
:long [:block [:lda self.LONG_LO] (lo op) [:sta self.LONG_LO]
|
||||||
|
[:lda self.LONG_HI] (if hi (hi op) [op (or ?defaulthi 0)]) [:sta self.LONG_HI]]))
|
||||||
|
|
||||||
; comparisons assume left-hand side was in accumulator and cmp (right-hand side) was just executed.
|
; comparisons assume left-hand side was in accumulator and cmp (right-hand side) was just executed.
|
||||||
; For lobranch, the branch should execute if the comparison is FALSE; the label passed is for the false branch.
|
; For lobranch, the branch should execute if the comparison is FALSE; the label passed is for the false branch.
|
||||||
; For hibranch, the branch should not execute if the low word still needs to be compared; otherwise, $1 is the true branch,
|
; For hibranch, the branch should not execute if the low word still needs to be compared; otherwise, $1 is the true branch,
|
||||||
|
@ -245,24 +251,25 @@
|
||||||
(values (lume.concat block [c-body [:bra :-loop-top-] :-exit-loop-]) :void)))
|
(values (lume.concat block [c-body [:bra :-loop-top-] :-exit-loop-]) :void)))
|
||||||
:+ (lambda [self first ...]
|
:+ (lambda [self first ...]
|
||||||
(self:accumulation-op
|
(self:accumulation-op
|
||||||
(fn [etype {: lo : hi : const}]
|
(fn [etype opgen]
|
||||||
(match etype
|
(if (and (= etype :word) opgen.const (>= opgen.const -2) (<= opgen.const 2))
|
||||||
:word (if (= const 1) [:inc] (= const 2) [:block [:inc] [:inc]]
|
(match opgen.const 1 [:inc] 2 [:block [:inc] [:inc]]
|
||||||
(= const -1) [:dec] (= const -2) [:block [:dec] [:dec]]
|
-1 [:dec] -2 [:block [:dec] [:dec]])
|
||||||
[:block [:clc] (lo :adc)])
|
[:block [:clc] (self:simple-accumulator :adc etype opgen)]))
|
||||||
:long [:block [:clc] (lo :lda) [:adc self.LONG_LO] [:sta self.LONG_LO]
|
|
||||||
(if hi (hi :lda) [:lda 0]) [:adc self.LONG_HI] [:sta self.LONG_HI]]))
|
|
||||||
first ...))
|
first ...))
|
||||||
:- (lambda [self first ...]
|
:- (lambda [self first ...]
|
||||||
(self:accumulation-op
|
(if (= (select :# ...) 0)
|
||||||
(fn [etype {: lo : hi : const}]
|
(match (self:type-expr first) :word [:block (self:expr-word first) [:eor 0xffff] [:inc]] ; negate with two's complement
|
||||||
(match etype
|
:long (self:expr-poly [:- 0 first])) ; just subtract from 0
|
||||||
:word (if (= const 1) [:dec] (= const 2) [:block [:dec] [:dec]]
|
(self:accumulation-op
|
||||||
(= const -1) [:inc] (= const -2) [:block [:inc] [:inc]]
|
(fn [etype opgen]
|
||||||
[:block [:sec] (lo :sbc)])
|
(if (and (= etype :word) (>= opgen.const -2) (<= opgen.const 2))
|
||||||
:long [:block [:sec] (lo :lda) [:sbc self.LONG_LO] [:sta self.LONG_LO]
|
(match opgen.const -1 [:inc] -2 [:block [:inc] [:inc]]
|
||||||
(if hi (hi :lda) [:lda 0]) [:sbc self.LONG_HI] [:sta self.LONG_HI]]))
|
1 [:dec] 2 [:block [:dec] [:dec]])
|
||||||
first ...))
|
[:block [:clc] (self:simple-accumulator :adc etype opgen)]))
|
||||||
|
first ...)))
|
||||||
|
:| (lambda [self first ...] (self:accumulation-op #(self:simple-accumulator :ora $...) first ...))
|
||||||
|
:& (lambda [self first ...] (self:accumulation-op #(self:simple-accumulator :and $...) first ...))
|
||||||
:= (lambda [self lhs rhs] (self:cmp-to-bool := lhs rhs))
|
:= (lambda [self lhs rhs] (self:cmp-to-bool := lhs rhs))
|
||||||
:not= (lambda [self lhs rhs] (self:cmp-to-bool :not= lhs rhs))
|
:not= (lambda [self lhs rhs] (self:cmp-to-bool :not= lhs rhs))
|
||||||
:< (lambda [self lhs rhs] (self:cmp-to-bool :< lhs rhs))
|
:< (lambda [self lhs rhs] (self:cmp-to-bool :< lhs rhs))
|
||||||
|
|
Loading…
Reference in a new issue