From 81ea4a44109852b08f62b93b77ec0986be9d1a57 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Wed, 11 Aug 2021 23:54:37 -0400 Subject: [PATCH] bitwise ops, unary negation --- neutgs/init.fnl | 17 +++-------------- ssc/init.fnl | 39 +++++++++++++++++++++++---------------- 2 files changed, 26 insertions(+), 30 deletions(-) diff --git a/neutgs/init.fnl b/neutgs/init.fnl index 030c807..f111cf9 100644 --- a/neutgs/init.fnl +++ b/neutgs/init.fnl @@ -20,20 +20,9 @@ (IMStartUp) (TextStartUp) - (let (x 1 dx 2 lim (if (> dx 0) 10 -10) break [ssc.FALSE]) - (while (and (< x lim) (not break)) - (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))) + (printnum (& (- 10) 0xff)) + (printnum (| 10 0x8000)) + (TextShutDown) (IMShutDown) (MMShutDown UserID) diff --git a/ssc/init.fnl b/ssc/init.fnl index c032a00..ad488cb 100644 --- a/ssc/init.fnl +++ b/ssc/init.fnl @@ -123,6 +123,12 @@ cleanup (icollect [_ {: cleanup} (ipairs args)] (when cleanup (cleanup)))] (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. ; 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, @@ -245,24 +251,25 @@ (values (lume.concat block [c-body [:bra :-loop-top-] :-exit-loop-]) :void))) :+ (lambda [self first ...] (self:accumulation-op - (fn [etype {: lo : hi : const}] - (match etype - :word (if (= const 1) [:inc] (= const 2) [:block [:inc] [:inc]] - (= const -1) [:dec] (= const -2) [:block [:dec] [:dec]] - [:block [:clc] (lo :adc)]) - :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]])) + (fn [etype opgen] + (if (and (= etype :word) opgen.const (>= opgen.const -2) (<= opgen.const 2)) + (match opgen.const 1 [:inc] 2 [:block [:inc] [:inc]] + -1 [:dec] -2 [:block [:dec] [:dec]]) + [:block [:clc] (self:simple-accumulator :adc etype opgen)])) first ...)) :- (lambda [self first ...] - (self:accumulation-op - (fn [etype {: lo : hi : const}] - (match etype - :word (if (= const 1) [:dec] (= const 2) [:block [:dec] [:dec]] - (= const -1) [:inc] (= const -2) [:block [:inc] [:inc]] - [:block [:sec] (lo :sbc)]) - :long [:block [:sec] (lo :lda) [:sbc self.LONG_LO] [:sta self.LONG_LO] - (if hi (hi :lda) [:lda 0]) [:sbc self.LONG_HI] [:sta self.LONG_HI]])) - first ...)) + (if (= (select :# ...) 0) + (match (self:type-expr first) :word [:block (self:expr-word first) [:eor 0xffff] [:inc]] ; negate with two's complement + :long (self:expr-poly [:- 0 first])) ; just subtract from 0 + (self:accumulation-op + (fn [etype opgen] + (if (and (= etype :word) (>= opgen.const -2) (<= opgen.const 2)) + (match opgen.const -1 [:inc] -2 [:block [:inc] [:inc]] + 1 [:dec] 2 [:block [:dec] [:dec]]) + [: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)) :not= (lambda [self lhs rhs] (self:cmp-to-bool :not= lhs rhs)) :< (lambda [self lhs rhs] (self:cmp-to-bool :< lhs rhs))