about summary refs log blame commit diff stats
path: root/shell/data.limg
blob: 3278af5dd4fa5b37e6f05485a664a4b0f1846190 (plain) (tree)
1
2
3
4
5
6
7
8
9

              

                                                          
                                            

                                     

                                    



                                                      



                                                      



                                               
                                                     







                               
                            












                               
                                               





                                      










                                                                   
                




                                       
                    
                                        
                            
                                                   










                                        
                     

              
                           
                                
                     

              
                           
                                   


                                                
                                 
                           

                                                             
                 
                         
                 
                         
                 
                         
                 
                         
                 
                         
                 
                         
                 
                         
                 
                         
                 
                             









                                                     
                                            


                                       
    
                     
 
(
  (globals . (
    (mac . [(def mac (litmac litfn () (name params . body)
  `(def ,name (litmac litfn () ,params ,@body))))])
    (do . [(mac do body `((fn () ,@body)))])
    (let . [(mac let (var val . body)
  `((fn (,var) ,@body) ,val))])
    (when . [(mac when (cond . body)
  `(if ,cond (do ,@body) ()))])
    (hline1 . [(def hline1 (fn (screen y x xmax color)
  (while (< x xmax)
    (pixel screen x y color)
    (set x (+ x 1)))))])
    (vline1 . [(def vline1 (fn (screen x y ymax color)
  (while (< y ymax)
    (pixel screen x y color)
    (set y (+ y 1)))))])
    (hline . [(def hline (fn (screen y color)
  (hline1 screen y 0 (width screen) color)))])
    (vline . [(def vline (fn (screen x color)
  (vline1 screen x 0 (height screen) color)))])
    (line . [(def line (fn (screen x0 y0 x1 y1 color)
  (let (x y) `(,x0 ,y0)
  (let dx (abs (- x1 x0))
  (let dy (- 0 (abs (- y1 y0)))
  (let sx (sgn (- x1 x0))
  (let sy (sgn (- y1 y0))
  (let err (+ dx dy)
  (while (not (and (= x x1)
                   (= y y1)))
    (pixel screen x y color)
    (let e2 (* err 2)
    (when (>= e2 dy)
      (set x (+ x sx)))
    (when (<= e2 dx)
      (set y (+ y sy)))
    (set err
      (+ err
         (+ (if (>= e2 dy)
              dy
              0)
            (if (<= e2 dx)
              dx
              0))))))))))))))])
    (read_line . [(def read_line (fn (keyboard)
  (let str (stream)
  (let c (key keyboard)
    (while (not (or (= c 0) (= c 10)))
      (write str c)
      (set c (key keyboard))))
  str)))])
    (fill_rect . [(def fill_rect (fn (screen x1 y1 x2 y2 color)
  (while (< y1 y2)
    (hline1 screen y1 x1 x2 color)
    (set y1 (+ y1 1)))))])
    (chessboard_row . [(def chessboard_row (fn (screen px y x xmax)
  (while (< x xmax)
    (fill_rect screen
               x        y
               (+ x px) (+ y px) 15)
    (set x (+ x (* px 2))))))])
    (chessboard . [(def chessboard (fn (screen px)
  (clear screen)
  (let xmax (width screen)
  (let ymax (height screen)
  (let y 0
  (while (< y ymax)
    (chessboard_row screen px y 0 xmax)
    (set y (+ y px))
    (chessboard_row screen px y px xmax)
    (set y (+ y px))))))))])
    (circle . [(def circle (fn (screen cx cy r clr)
  (let x (- 0 r)
  (let y 0
  (let err (- 2 (* 2 r))
  (let continue 1
  (while continue
    (pixel screen (- cx x) (+ cy y) clr)
    (pixel screen (- cx y) (- cy x) clr)
    (pixel screen (+ cx x) (- cy y) clr)
    (pixel screen (+ cx y) (+ cy x) clr)
    (set r err)
    (when (<= r y)
      (set y (+ y 1))
      (set err
        (+ err
           (+ 1 (* 2 y)))))
    (when (or (> r x) (> err y))
      (set x (+ x 1))
      (set err
        (+ err
           (+ 1 (* 2 x)))))
    (set continue (< x 0)))))))))])
    (ring . [(def ring (fn(screen cx cy r w clr)
    (let rmax (+ r w)
    (while (< r rmax)
      (circle screen cx cy r clr)
      (set r (+ r 1))))))])
    (circle_rainbow . [(def circle_rainbow (fn(scr cx cy r w)
  (ring scr cx cy r w 37)
  (set r (+ r w))
  (ring scr cx cy r w 33)
  (set r (+ r w))
  (ring scr cx cy r w 55)
  (set r (+ r w))
  (ring scr cx cy r w 52)
  (set r (+ r w))
  (ring scr cx cy r w 47)
  (set r (+ r w))
  (ring scr cx cy r w 45)
  (set r (+ r w))
  (ring scr cx cy r w 44)
  (set r (+ r w))
  (ring scr cx cy r w 42)
  (set r (+ r w))
  (ring scr cx cy r w 41)
  (set r (+ r w))
  (ring scr cx cy r w 40)))])
    (bowboard . [(def bowboard (fn (screen side)
  (let xmax (width screen)
  (let ymax (height screen)
  (let y side
    (while (< y ymax)
      (let x side
        (while (< x xmax)
          (circle_rainbow screen x y (- side 100) 10)
          (set x (+ x (* 2 side)))))
      (set y (+ y (* 2 side)))))))))])
    (main . [(def main (fn (screen keyboard)
  (circle_rainbow screen 90 90 8 1)))])
    (task . [(def task (fn (screen)
  (circle_rainbow screen 32 24 8 1)))])
  ))
  (sandbox . (+ 3 4))
)
eclaim locals 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # . restore registers 5f/pop-to-EDI 5e/pop-to-ESI 5b/pop-to-EBX 5a/pop-to-EDX 59/pop-to-ECX # . epilog 89/copy 3/mod/direct 4/rm32/ESP . . . 5/r32/EBP . . # copy EBP to ESP 5d/pop-to-EBP c3/return test-parse-array-of-ints: # . prolog 55/push-EBP 89/copy 3/mod/direct 5/rm32/EBP . . . 4/r32/ESP . . # copy ESP to EBP # var ECX = [1, 2, 3] 68/push 3/imm32 68/push 2/imm32 68/push 1/imm32 68/push 0xc/imm32/size 89/copy 3/mod/direct 1/rm32/ECX . . . 4/r32/ESP . . # copy ESP to ECX # EAX = parse-array-of-ints(Heap, "1 2 3") # . . push args 68/push "1 2 3"/imm32 68/push Heap/imm32 # . . call e8/call parse-array-of-ints/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # EAX = array-equal?(ECX, EAX) # . . push args 50/push-EAX 51/push-ECX # . . call e8/call array-equal?/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # check-ints-equal(EAX, 1, msg) # . . push args 68/push "F - test-parse-array-of-ints"/imm32 68/push 1/imm32/true 50/push-EAX # . . call e8/call check-ints-equal/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 0xc/imm32 # add to ESP # . epilog 89/copy 3/mod/direct 4/rm32/ESP . . . 5/r32/EBP . . # copy EBP to ESP 5d/pop-to-EBP c3/return test-parse-array-of-ints-empty: # - empty string = empty array # . prolog 55/push-EBP 89/copy 3/mod/direct 5/rm32/EBP . . . 4/r32/ESP . . # copy ESP to EBP # EAX = parse-array-of-ints(Heap, "") # . . push args 68/push ""/imm32 68/push Heap/imm32 # . . call e8/call parse-array-of-ints/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # check-ints-equal(*EAX, 0, msg) # . . push args 68/push "F - test-parse-array-of-ints-empty"/imm32 68/push 0/imm32/size ff 6/subop/push 0/mod/indirect 0/rm32/EAX . . . . . . # push *EAX # . . call e8/call check-ints-equal/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 0xc/imm32 # add to ESP # . epilog 89/copy 3/mod/direct 4/rm32/ESP . . . 5/r32/EBP . . # copy EBP to ESP 5d/pop-to-EBP c3/return test-parse-array-of-ints-just-whitespace: # - just whitespace = empty array # . prolog 55/push-EBP 89/copy 3/mod/direct 5/rm32/EBP . . . 4/r32/ESP . . # copy ESP to EBP # EAX = parse-array-of-ints(Heap, " ") # . . push args 68/push " "/imm32 68/push Heap/imm32 # . . call e8/call parse-array-of-ints/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # check-ints-equal(*EAX, 0, msg) # . . push args 68/push "F - test-parse-array-of-ints-empty"/imm32 68/push 0/imm32/size ff 6/subop/push 0/mod/indirect 0/rm32/EAX . . . . . . # push *EAX # . . call e8/call check-ints-equal/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 0xc/imm32 # add to ESP # . epilog 89/copy 3/mod/direct 4/rm32/ESP . . . 5/r32/EBP . . # copy EBP to ESP 5d/pop-to-EBP c3/return test-parse-array-of-ints-extra-whitespace: # . prolog 55/push-EBP 89/copy 3/mod/direct 5/rm32/EBP . . . 4/r32/ESP . . # copy ESP to EBP # var ECX = [1, 2, 3] 68/push 3/imm32 68/push 2/imm32 68/push 1/imm32 68/push 0xc/imm32/size 89/copy 3/mod/direct 1/rm32/ECX . . . 4/r32/ESP . . # copy ESP to ECX # EAX = parse-array-of-ints(Heap, " 1 2 3 ") # . . push args 68/push " 1 2 3 "/imm32 68/push Heap/imm32 # . . call e8/call parse-array-of-ints/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # EAX = array-equal?(ECX, EAX) # . . push args 50/push-EAX 51/push-ECX # . . call e8/call array-equal?/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # check-ints-equal(EAX, 1, msg) # . . push args 68/push "F - test-parse-array-of-ints-extra-whitespace"/imm32 68/push 1/imm32/true 50/push-EAX # . . call e8/call check-ints-equal/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 0xc/imm32 # add to ESP # . epilog 89/copy 3/mod/direct 4/rm32/ESP . . . 5/r32/EBP . . # copy EBP to ESP 5d/pop-to-EBP c3/return # helper for later tests # compare an array with a string representation of an array literal check-array-equal: # a : (address array int), expected : (address string), msg : (address string) # . prolog 55/push-EBP 89/copy 3/mod/direct 5/rm32/EBP . . . 4/r32/ESP . . # copy ESP to EBP # . save registers 50/push-EAX # var b/ECX = parse-array-of-ints(Heap, expected) # . EAX = parse-array-of-ints(Heap, expected) # . . push args ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 0xc/disp8 . # push *(EBP+12) 68/push Heap/imm32 # . . call e8/call parse-array-of-ints/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # . b = EAX 89/copy 3/mod/direct 1/rm32/ECX . . . 0/r32/EAX . . # copy EAX to ECX # EAX = array-equal?(a, b) # . . push args 51/push-ECX ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 8/disp8 . # push *(EBP+8) # . . call e8/call array-equal?/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # check-ints-equal(EAX, 1, msg) # . . push args ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 0x10/disp8 . # push *(EBP+16) 68/push 1/imm32 50/push-EAX # . . call e8/call check-ints-equal/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 0xc/imm32 # add to ESP $check-array-equal:end: # . restore registers 58/pop-to-EAX # . epilog 89/copy 3/mod/direct 4/rm32/ESP . . . 5/r32/EBP . . # copy EBP to ESP 5d/pop-to-EBP c3/return test-check-array-equal: # . prolog 55/push-EBP 89/copy 3/mod/direct 5/rm32/EBP . . . 4/r32/ESP . . # copy ESP to EBP # var ECX = [1, 2, 3] 68/push 3/imm32 68/push 2/imm32 68/push 1/imm32 68/push 0xc/imm32/size 89/copy 3/mod/direct 1/rm32/ECX . . . 4/r32/ESP . . # copy ESP to ECX # check-array-equal(ECX, "1 2 3", "msg") # . . push args 68/push "F - test-check-array-equal"/imm32 68/push "1 2 3"/imm32 51/push-ECX # . . call e8/call check-array-equal/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # . epilog 89/copy 3/mod/direct 4/rm32/ESP . . . 5/r32/EBP . . # copy EBP to ESP 5d/pop-to-EBP c3/return == data Heap: # curr 0/imm32 # limit 0/imm32 # . . vim:nowrap:textwidth=0