fixed x86 instructions; improved wm with clipping and focus follows mouse

sledge/build_x86.sh

@@ -1,3 +1,4 @@
 
-gcc -g -o sledge --std=gnu99 -I. sledge.c reader.c writer.c alloc.c strmap.c stream.c ../devices/posixfs.c ../devices/sdl2.c -lm -lSDL2 -DCPU_X86 -DDEV_SDL -DDEV_POSIXFS
+gcc -m32 -g -o sledge --std=gnu99 -I. sledge.c reader.c writer.c alloc.c strmap.c stream.c ../devices/posixfs.c -lm -DCPU_X86 -DDEV_POSIXFS
 
+#  ../devices/sdl2.c -lSDL2 -DDEV_SDL

sledge/compiler_x86.c

@@ -1,4 +1,7 @@
+
+#ifndef WIN32
 #include <sys/mman.h>
+#endif
 
 Cell* execute_jitted(void* binary) {
   return (Cell*)((funcptr)binary)(0);
@@ -6,11 +9,15 @@ Cell* execute_jitted(void* binary) {
 
 //void memdump(void* start,uint32_t len,int raw);
 
-int compile_for_platform(Cell* expr, Cell** res) {
+Cell* compile_for_platform(Cell* expr, Cell** res) {
   int codesz = 8192;
-  
-  uint8_t* jit_binary = mmap(0, codesz, PROT_READ | PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
 
+#ifdef WIN32
+  uint8_t* jit_binary = malloc(codesz);
+#else
+  uint8_t* jit_binary = mmap(0, codesz, PROT_READ | PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
+#endif
+  
   printf("jit_binary: %p\r\n",jit_binary);
   
   memset(jit_binary, 0, codesz);
@@ -18,8 +25,15 @@ int compile_for_platform(Cell* expr, Cell** res) {
   jit_init(jit_binary, codesz);
   
   register void* sp asm ("sp");
-  Frame empty_frame = {NULL, 0, 0, sp};
-  int success = compile_expr(expr, &empty_frame, TAG_ANY);
+  Frame* empty_frame = malloc(sizeof(Frame)); // FIXME leak
+  empty_frame->f=NULL;
+  empty_frame->sp=0;
+  empty_frame->locals=0;
+  empty_frame->stack_end=sp;
+  empty_frame->parent_frame=NULL;
+
+  Cell* success = compile_expr(expr, empty_frame, prototype_any);
+  
   jit_ret();
 
   if (success) {
@@ -31,11 +45,10 @@ int compile_for_platform(Cell* expr, Cell** res) {
     //fwrite(code, 1, codesz, f);
     //fclose(f);
     
+#ifndef WIN32
     int mp_res = mprotect(jit_binary, codesz, PROT_EXEC|PROT_READ);
+#endif
     *res = execute_jitted(jit_binary);
-    //printf("res: %p\r\n",res);
-    success = 1;
-    
   }
   return success;
 }

sledge/jit_x86.c

@@ -241,7 +241,7 @@ void jit_divr(int dreg, int sreg) {
 
 void jit_ldr(int reg) {
   code[code_idx++] = 0x8b;
-  code[code_idx++] = (regi[reg]<<3) + regi[reg];
+  code[code_idx++] = (regi[reg]<<3) | regi[reg];
 }
 
 void jit_ldr_stack(int dreg, int offset) {
@@ -267,7 +267,18 @@ void jit_ldrb(int reg) {
   jit_movr(reg, R3);
 }
 
+void jit_ldrs(int reg) {
+  code[code_idx++] = 0x66; // movw (reg), %dx
+  code[code_idx++] = 0x8b;
+  code[code_idx++] = 0x10 | regi[reg];
+  
+  jit_andi(R3, 0xffff);
+  jit_movr(reg, R3);
+}
+
 void jit_ldrw(int reg) {
+  code[code_idx++] = 0x8b; // movl (reg), %dx
+  code[code_idx++] = 0x10 | regi[reg];
 }
 
 // 8 bit only from rdx!
@@ -277,6 +288,14 @@ void jit_strb(int reg) {
 }
 
 void jit_strw(int reg) {
+  code[code_idx++] = 0x89; // movl %edx, (reg)
+  code[code_idx++] = 0x10 | regi[reg];
+}
+
+void jit_strs(int reg) {
+  code[code_idx++] = 0x66;
+  code[code_idx++] = 0x89; // movw %dx, (reg)
+  code[code_idx++] = 0x10 | regi[reg];
 }
 
 #define jit_stra jit_strw

sledge/os/editor.l

@@ -49,8 +49,8 @@
   (let ln (car lines))
   (let pos 0)
   (let nextpos 0)
-  (let x 0)
-  (let y 0)
+  (let x 2)
+  (let y 20)
   (let maxx (sget surf width))
   (let maxy (sget surf height))
   (let cursor (sget this cursor))
@@ -63,7 +63,7 @@
   (if (or scroll-dirty (not (eq (sget this last-num-lines) (list-size lines)))) (do
       (let render-all 1)
       (print "editor boxfill")
-      (boxfill surf x y maxx maxy 0xffff)
+      (boxfill surf 0 0 maxx maxy 0xffff)
       (sput this scroll-dirty 0)
     )
   0)
@@ -88,7 +88,7 @@
 
       ; blank out the line
       ;(if only-current (do
-      ;  (boxfill buf-render-x term-y (- maxx buf-render-x) rune-h 0xffff)
+      ;  (boxfill surf x y maxx (sget font rune-h) 0xffff)
       ;) 0)
     ) 0)
     
@@ -130,8 +130,6 @@
   (let font (sget this font))
   (let rune (if (eq cursor-char 0) 32 cursor-char))
 
-  (print (list rune surf font))
-  
   (blit-char16 surf font rune term-x term-y)
 )))
 
@@ -237,9 +235,13 @@
   (if (lt cursor 0) (sput this cursor 0) 0)
   (if (gt cursor (size buf)) (sput this cursor (size buf)) 0)
 
-  (if (sget this buf-dirty) (do
+  (if (or (sget task-obj needs-redraw) (sget this buf-dirty)) (do
+                    (if (sget task-obj needs-redraw)
+                      (sput this scroll-dirty 1)
+                      0)
                     (buf-render surf this)
                     (sput this buf-dirty 0)
+                    (sput task-obj needs-redraw 0)
                     (sput task-obj redrawn 1)
                   ) 0)
 

sledge/os/gfx.l

@@ -209,6 +209,14 @@
 ;   res
 ; )))
 (def boxfill (fn (surf surface) x y w h color (do
+  (if (lt x 0) (let x 0) 0)
+  (if (lt y 0) (let y 0) 0)
+  
+  (let dw (sget surf width))
+  (let dh (sget surf height))
+  (if (gt (+ x w) (- dw 1)) (let w (- dw x)) 0)
+  (if (gt (+ y h) (- dh 1)) (let h (- dh y)) 0)
+  
   (let ofs 0)
   (let xi 0)
   (let yi 0)
@@ -216,6 +224,7 @@
   (let yi (+ y 0))
   (let xx (+ x w))
   (let yy (+ y h))
+
   (let ww (shl w 1))
   (let pitch (sget surf pitch))
   (let ofs (+ (* y pitch) (shl x 1)))
@@ -244,13 +253,39 @@
   (let yh (+ (sget from y) (sget from height)))
   (let to (sget dest pixels))
   (let shift (sget dest shift))
-  (let pitch (- (sget dest pitch) (shl (sget from width) shift)))
-  (let di (+ (shl (sget from x) shift) (* yy (sget dest pitch))))
+  (let w (sget from width))
   (let c 0)
   (let pixels (sget from pixels))
+
+  ;; clipping
+  (let x (sget from x))
+  (let xskip 0)
+  (if (lt yy 0) (do
+    (let si (+ si (* (abs yy) (shl w 1))))
+    (let yy 0)
+  ) 0)
+  (if (gt yh (- (sget dest height) 1)) (do
+    (let yh (- (sget dest height) 1))
+  ) 0)
+  (if (lt x 0) (do
+    (let xskip (abs x))
+    (let w (- w xskip))
+    (let x (+ x xskip))
+  ) 0)
+  (if (gt xw (- (sget dest width) 1)) (do
+    (let xskip (- xw (sget dest width)))
+    (let si (- si (shl xskip 1)))
+    (let xw (- xw xskip))
+    (let w (- w xskip))
+  ) 0)
+  
+  (let pitch (- (sget dest pitch) (shl w shift)))
+  (let di (+ (shl x shift) (* yy (sget dest pitch))))
   
   (while (lt yy yh) (do
-    (let xx (+ (sget from x) 0))
+    (let xx (+ x 0))
+    (let si (+ si (shl xskip 1)))
+    
     (while (lt xx xw) (do
       (let c (get16 pixels si))
       (put16 to di c)

sledge/os/repl.l

@@ -1,5 +1,11 @@
 (
 
+;; (def evbuf (alloc-str 4096))
+;; (def p (fn xp x y maxx maxy (do
+;;   (write xp evbuf)
+;;   (blit-str evbuf x y maxx maxy)
+ ;; )))
+ 
 (def repl-history-back (fn history future (do
   (let line (car history))
 
@@ -54,13 +60,7 @@
     (let c (get str 0))
   ) 0)
 
-  ; TODO (rect)
-  ;(line (pt win-x win-y) (pt (+ win-x maxx) win-y))
-  ;(line (pt (+ win-x maxx) win-y) (pt (+ win-x maxx) (+ win-y maxy)))
-  ;(line (pt win-x win-y) (pt win-x (+ win-y maxy)))
-  ;(line (pt win-x (+ win-y maxy)) (pt (+ win-x maxx) (+ win-y maxy)))
-
-  ; new strategy:
+  ; TODO new strategy:
   ; - list of lines
   ; - fn to render one line
   ; - fn to render all visible lines

sledge/os/shell.l

@@ -4,6 +4,7 @@
 )))
 
 (struct task
+  id 0
   name "untitled task"
   focused 0
   z 0
@@ -38,12 +39,6 @@
 
 (import "/sd/os/mouse.l")
 
-;; (def evbuf (alloc-str 4096))
-;; (def p (fn xp x y maxx maxy (do
-;;   (write xp evbuf)
-;;   (blit-str evbuf x y maxx maxy)
-;; )))
-
 (draw-logo (- (/ (sget fb width) 2) 140) (/ (sget fb height) 2))
 (blit-str fb unifont "hello" 100 100)
 
@@ -61,43 +56,58 @@
   (if (sget t redrawn)
     (do
       (let task-surf (sget t surface))
-      (blit fb task-surf)
-      (let x (- (sget task-surf x) 1))
-      (let y (- (sget task-surf y) 1))
-      (let w (+ (sget task-surf width) 2))
-      (let h (+ (sget task-surf height) 2))
-      (box fb x y (+ x w) (+ y h) 0)
-      (box fb x (- y 20) (+ x w) y 0)
-      (blit-str fb unifont (sget t name) (+ x 2) (- y 18))
+      (let x (sget task-surf x))
+      (let y (sget task-surf y))
+      (let w (sget task-surf width))
+      (let h (sget task-surf height))
+      (if (and (gt w 0) (gt h 0)) (do
+        (box task-surf 0 0 (- w 1) (- h 1) 0)
+        (box task-surf 0 0 (- w 1) 20 0)
+        (blit-str task-surf unifont (sget t name) 2 2)
+        (blit fb task-surf)
+      ) 0)
       (sput t redrawn 0))
     0)
   0
 )))
 
+(def null-task (task))
+(sput null-task id 0) ; "null" task
+(def focused-task null-task)
+
+(def point-in-rect (fn px py x y x2 y2 
+  (if (gt px x)
+    (if (gt py y)
+      (if (lt px x2)
+        (if (lt py y2)
+          1 0) 0) 0) 0)))
+
+(def mouse-resizing 0)
+(def focus-given 0)
+
 (def check-task-focus (fn (t task) (do
   (let surf  (sget t surface))
   (let x (sget surf x))
   (let y (sget surf y))
   (let x2 (+ x (sget surf width)))
   (let y2 (+ y (sget surf height)))
-
-  (let dbg "            ")
-  (write mouse-btn dbg)
-  (blit-str fb unifont dbg 0 0)
-
-  (sput t focused 0)
-  (if (gt mouse-x x)
-    (if (gt mouse-y y)
-      (if (lt mouse-x x2)
-        (if (lt mouse-y y2)
-          (do
-            (sput t focused 1)
-            (if mouse-dragging (do
-              (boxfill fb (- x 2) (- y 22) (+ (- x2 x) 4) (+ (- y2 y) 24) 0xffff)
-              (if (lt mouse-y (- y2 16))
-                (do ; move
-                  (sput surf x (+ mouse-dx x))
-                  (sput surf y (+ mouse-dy y)))
+  (let z (sget t z))
+
+  (if (not mouse-dragging) (do
+    (def mouse-resizing 0)
+    (let already-focused (sget t focused))
+    (if (point-in-rect mouse-x mouse-y x y x2 y2)
+      (if (not focus-given)
+        (do
+          (def focus-given 1)
+          (sput t focused 1)) 0) 
+      (sput t focused 0))) 0)
+
+  (if mouse-dragging
+    (if (sget t focused)
+      (do
+              (boxfill fb x y (- x2 x) (- y2 y) 0xffff)
+              (if (or mouse-resizing (and (gt mouse-x (- x2 16)) (gt mouse-y (- y2 16))))
                 (do ; resize
                   (let nw (+ (sget surf width) mouse-dx))
                   (let nh (+ (sget surf height) mouse-dy))
@@ -105,17 +115,40 @@
                   (sput surf height nh)
                   (sput surf pitch (* 2 nw))
                   (sput surf pixels (alloc (* 2 (* nw nh))))
-                  ))
-              (sput t redrawn 1)
-            ) 0)
-          ) 0) 0) 0) 0)
+                  (sput t needs-redraw 1)
+                  (def mouse-resizing 1) ; sticky
+                  )
+                (do ; move
+                  (sput surf x (+ mouse-dx x))
+                  (sput surf y (+ mouse-dy y))) )
+              (sput t redrawn 1) ) 0) 0)
   0
 )))
 
+(def focused-at-mouse (fn (t task) (do
+  (let surf  (sget t surface))
+  (let x (sget surf x))
+  (let y (sget surf y))
+  (let x2 (+ x (sget surf width)))
+  (let y2 (+ y (sget surf height)))
+  (if (point-in-rect mouse-x mouse-y x y x2 y2)
+    (sget t focused) 0)
+)))
+
 (def run-tasks (fn (do
   (let tl tasks)
   (let new-tl (list))
   (let i 0)
+  (let highest-z-at-mouse 0)
+
+  (def focus-given 0)
+  (while (car tl) (do
+    (let task-item  (car tl))
+    (let task-obj   (car (cdr task-item)))
+    (def focus-given (or focus-given (focused-at-mouse task-obj)))
+    (let tl (cdr tl))
+  ))
+  (let tl tasks)
   
   (while (car tl) (do
     (let task-item  (car tl))
@@ -154,9 +187,12 @@
 
 ;(add-task repl-task (repl-make 1 432 32 200 300))
 
+(def max-task-id 0)
+
 (def spawn-editor (fn x y title focused (do
   (let my-editor (new editor))
   (let my-editor-task (new task))
+  (sput my-editor-task id (+ max-task-id 1))
   (sput my-editor-task name title)
   (sput my-editor buffer " ")
   (sput my-editor-task focused focused)
@@ -168,9 +204,29 @@
 (spawn-editor 32 300 "editor               " 1)
 
 (def mouse-task (new task))
+(sput mouse-task id (+ max-task-id 1))
 (sput mouse-task name "mouse")
 (add-task mouse-func mouse-task 0)
 
+(def launched 0)
+
+(def launcher-func (fn (t task) dummy (do
+  (let f (sget t focused))
+  (if (* f (* (not launched) mouse-btn)) (do
+    (def launched 1)
+    (spawn-editor 100 100 "new editor" 0)
+  ) 0)
+  (if (not mouse-btn) (def launched 0) 0)
+  0
+)))
+
+(def launcher-task (new task))
+(sput launcher-task id (+ max-task-id 1))
+(sput launcher-task name "icon")
+(sput launcher-task surface (make-surface 0 0 32 32))
+(sput launcher-task redrawn 1)
+(add-task launcher-func launcher-task 0)
+
 (def main (fn (while 1 (do
   (run-tasks)
   (send screen 0)