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     render-globals screen, globals, 0/x, 0/y, 0x40/xmax, 0x2f/screen-height-without-menu
 14     render-sandbox screen, sandbox, 0x40/x, 0/y, 0x80/screen-width, 0x2f/screen-height-without-menu, globals
 15     {
 16       var key/eax: byte <- read-key keyboard
 17       compare key, 0
 18       loop-if-=
 19       # ctrl-r
 20       {
 21         compare key, 0x12/ctrl-r
 22         break-if-!=
 23         var tmp/eax: (addr handle cell) <- copy 0
 24         var nil: (handle cell)
 25         tmp <- address nil
 26         allocate-pair tmp
 27         # (main 0/real-screen 0/real-keyboard)
 28         # We're using the fact that 'screen' and 'keyboard' in this function are always 0.
 29         var real-keyboard: (handle cell)
 30         tmp <- address real-keyboard
 31         allocate-keyboard tmp
 32         # args = cons(real-keyboard, nil)
 33         var args: (handle cell)
 34         tmp <- address args
 35         new-pair tmp, real-keyboard, nil
 36         #
 37         var real-screen: (handle cell)
 38         tmp <- address real-screen
 39         allocate-screen tmp
 40         #  args = cons(real-screen, args)
 41         tmp <- address args
 42         new-pair tmp, real-screen, *tmp
 43         #
 44         var main: (handle cell)
 45         tmp <- address main
 46         new-symbol tmp, "main"
 47         # args = cons(main, args)
 48         tmp <- address args
 49         new-pair tmp, main, *tmp
 50         # clear real screen
 51         clear-screen screen
 52         set-cursor-position screen, 0, 0
 53         # run
 54         var out: (handle cell)
 55         var out-ah/ecx: (addr handle cell) <- address out
 56         evaluate tmp, out-ah, nil, globals, 0/trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number
 57         {
 58           var tmp/eax: byte <- read-key keyboard
 59           compare tmp, 0
 60           loop-if-=
 61         }
 62         #
 63         loop $main:loop
 64       }
 65       # no way to quit right now; just reboot
 66       edit-sandbox sandbox, key, globals, screen, keyboard, data-disk
 67     }
 68     loop
 69   }
 70 }
 71 
 72 # Gotcha: some saved state may not load.
 73 fn load-state data-disk: (addr disk), _sandbox: (addr sandbox), globals: (addr global-table) {
 74   var sandbox/eax: (addr sandbox) <- copy _sandbox
 75   var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
 76   var _data/eax: (addr gap-buffer) <- lookup *data-ah
 77   var data/esi: (addr gap-buffer) <- copy _data
 78   # data-disk -> stream
 79   var s-storage: (stream byte 0x1000)  # space for 8/sectors
 80   var s/ebx: (addr stream byte) <- address s-storage
 81   load-sectors data-disk, 0/lba, 8/sectors, s
 82 #?   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0/bg
 83   # stream -> gap-buffer
 84   load-gap-buffer-from-stream data, s
 85   clear-stream s
 86   # read: gap-buffer -> cell
 87   var initial-root-storage: (handle cell)
 88   var initial-root/ecx: (addr handle cell) <- address initial-root-storage
 89   read-cell data, initial-root, 0/no-trace
 90   clear-gap-buffer data
 91   #
 92   {
 93     var initial-root-addr/eax: (addr cell) <- lookup *initial-root
 94     compare initial-root-addr, 0
 95     break-if-!=
 96     return
 97   }
 98   # load globals from assoc(initial-root, 'globals)
 99   var globals-literal-storage: (handle cell)
100   var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
101   new-symbol globals-literal-ah, "globals"
102   var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
103   var globals-cell-storage: (handle cell)
104   var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
105   lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
106   var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
107   {
108     compare globals-cell, 0
109     break-if-=
110     load-globals globals-cell-ah, globals
111   }
112   # sandbox = assoc(initial-root, 'sandbox)
113   var sandbox-literal-storage: (handle cell)
114   var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
115   new-symbol sandbox-literal-ah, "sandbox"
116   var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
117   var sandbox-cell-storage: (handle cell)
118   var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
119   lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
120   var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
121   {
122     compare sandbox-cell, 0
123     break-if-=
124     # print: cell -> stream
125     print-cell sandbox-cell-ah, s, 0/no-trace
126     # stream -> gap-buffer
127     load-gap-buffer-from-stream data, s
128   }
129 }
130 
131 # Save state as an alist of alists:
132 #   ((globals . ((a . (fn ...))
133 #                ...))
134 #    (sandbox . ...))
135 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
136   compare data-disk, 0/no-disk
137   {
138     break-if-!=
139     return
140   }
141   var stream-storage: (stream byte 0x1000)  # space enough for 8/sectors
142   var stream/edi: (addr stream byte) <- address stream-storage
143   write stream, "(\n"
144   write-globals stream, globals
145   write-sandbox stream, sandbox
146   write stream, ")\n"
147   store-sectors data-disk, 0/lba, 8/sectors, stream
148 }