1 # Experimental Mu shell
  2 # A Lisp with indent-sensitivity and infix.
  3 
  4 fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) {
  5   var globals-storage: global-table
  6   var globals/edi: (addr global-table) <- address globals-storage
  7   initialize-globals globals
  8   var sandbox-storage: sandbox
  9   var sandbox/esi: (addr sandbox) <- address sandbox-storage
 10   initialize-sandbox sandbox, 1/with-screen
 11   load-state data-disk, sandbox, globals
 12   $main:loop: {
 13     # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding =  85
 14     # sandbox layout: 1 padding, 41 code, 1 padding                          =  43
 15     #                                                                  total = 128 chars
 16     render-globals screen, globals
 17     render-sandbox screen, sandbox, 0x55/sandbox-left-margin, 0/sandbox-top-margin, 0x80/screen-width, 0x2f/screen-height-without-menu
 18     {
 19       var key/eax: byte <- read-key keyboard
 20       compare key, 0
 21       loop-if-=
 22       # ctrl-r
 23       {
 24         compare key, 0x12/ctrl-r
 25         break-if-!=
 26         var tmp/eax: (addr handle cell) <- copy 0
 27         var nil: (handle cell)
 28         tmp <- address nil
 29         allocate-pair tmp
 30         # (main 0/real-screen 0/real-keyboard)
 31         # We're using the fact that 'screen' and 'keyboard' in this function are always 0.
 32         var real-keyboard: (handle cell)
 33         tmp <- address real-keyboard
 34         allocate-keyboard tmp
 35         # args = cons(real-keyboard, nil)
 36         var args: (handle cell)
 37         tmp <- address args
 38         new-pair tmp, real-keyboard, nil
 39         #
 40         var real-screen: (handle cell)
 41         tmp <- address real-screen
 42         allocate-screen tmp
 43         #  args = cons(real-screen, args)
 44         tmp <- address args
 45         new-pair tmp, real-screen, *tmp
 46         #
 47         var main: (handle cell)
 48         tmp <- address main
 49         new-symbol tmp, "main"
 50         # args = cons(main, args)
 51         tmp <- address args
 52         new-pair tmp, main, *tmp
 53         # clear real screen
 54         clear-screen screen
 55         set-cursor-position screen, 0, 0
 56         # run
 57         var out: (handle cell)
 58         var out-ah/ecx: (addr handle cell) <- address out
 59         var trace-storage: trace
 60         var trace/ebx: (addr trace) <- address trace-storage
 61         initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 62         evaluate tmp, out-ah, nil, globals, trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number
 63         {
 64           var tmp/eax: byte <- read-key keyboard
 65           compare tmp, 0
 66           loop-if-=
 67         }
 68         #
 69         loop $main:loop
 70       }
 71       # no way to quit right now; just reboot
 72       edit-sandbox sandbox, key, globals, data-disk, screen, 1/tweak-real-screen
 73     }
 74     loop
 75   }
 76 }
 77 
 78 # Gotcha: some saved state may not load.
 79 fn load-state data-disk: (addr disk), _sandbox: (addr sandbox), globals: (addr global-table) {
 80   var sandbox/eax: (addr sandbox) <- copy _sandbox
 81   var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
 82   var _data/eax: (addr gap-buffer) <- lookup *data-ah
 83   var data/esi: (addr gap-buffer) <- copy _data
 84   # data-disk -> stream
 85   var s-storage: (stream byte 0x1000)  # space for 8/sectors
 86   var s/ebx: (addr stream byte) <- address s-storage
 87   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sectors from data disk", 3/fg, 0/bg
 88   move-cursor-to-left-margin-of-next-line 0/screen
 89   load-sectors data-disk, 0/lba, 8/sectors, s
 90 #?   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg
 91   # stream -> gap-buffer
 92   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "parsing", 3/fg, 0/bg
 93   move-cursor-to-left-margin-of-next-line 0/screen
 94   load-gap-buffer-from-stream data, s
 95   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into gap buffer", 3/fg, 0/bg
 96   move-cursor-to-left-margin-of-next-line 0/screen
 97   clear-stream s
 98   # read: gap-buffer -> cell
 99   var initial-root-storage: (handle cell)
100   var initial-root/ecx: (addr handle cell) <- address initial-root-storage
101   var trace-storage: trace
102   var trace/edi: (addr trace) <- address trace-storage
103   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
104   read-cell data, initial-root, trace
105   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into s-expressions", 3/fg, 0/bg
106   move-cursor-to-left-margin-of-next-line 0/screen
107   clear-gap-buffer data
108   #
109   {
110     var initial-root-addr/eax: (addr cell) <- lookup *initial-root
111     compare initial-root-addr, 0
112     break-if-!=
113     return
114   }
115   # load globals from assoc(initial-root, 'globals)
116   var globals-literal-storage: (handle cell)
117   var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
118   new-symbol globals-literal-ah, "globals"
119   var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
120   var globals-cell-storage: (handle cell)
121   var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
122   clear-trace trace
123   lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
124   var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
125   {
126     compare globals-cell, 0
127     break-if-=
128     load-globals globals-cell-ah, globals
129   }
130   # sandbox = assoc(initial-root, 'sandbox)
131   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sandbox", 3/fg, 0/bg
132   var sandbox-literal-storage: (handle cell)
133   var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
134   new-symbol sandbox-literal-ah, "sandbox"
135   var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
136   var sandbox-cell-storage: (handle cell)
137   var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
138   clear-trace trace
139   lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
140   var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
141   {
142     compare sandbox-cell, 0
143     break-if-=
144     # print: cell -> stream
145     clear-trace trace
146     print-cell sandbox-cell-ah, s, trace
147     # stream -> gap-buffer
148     load-gap-buffer-from-stream data, s
149   }
150 }
151 
152 # Save state as an alist of alists:
153 #   ((globals . ((a . (fn ...))
154 #                ...))
155 #    (sandbox . ...))
156 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
157   compare data-disk, 0/no-disk
158   {
159     break-if-!=
160     return
161   }
162   var stream-storage: (stream byte 0x1000)  # space enough for 8/sectors
163   var stream/edi: (addr stream byte) <- address stream-storage
164   write stream, "(\n"
165   write-globals stream, globals
166   write-sandbox stream, sandbox
167   write stream, ")\n"
168   store-sectors data-disk, 0/lba, 8/sectors, stream
169 }