https://github.com/akkartik/mu/blob/main/shell/main.mu

      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         evaluate tmp, out-ah, nil, globals, 0/trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number
     60         {
     61           var tmp/eax: byte <- read-key keyboard
     62           compare tmp, 0
     63           loop-if-=
     64         }
     65         #
     66         loop $main:loop
     67       }
     68       # no way to quit right now; just reboot
     69       edit-sandbox sandbox, key, globals, data-disk, screen, 1/tweak-real-screen
     70     }
     71     loop
     72   }
     73 }
     74
     75 # Gotcha: some saved state may not load.
     76 fn load-state data-disk: (addr disk), _sandbox: (addr sandbox), globals: (addr global-table) {
     77   var sandbox/eax: (addr sandbox) <- copy _sandbox
     78   var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
     79   var _data/eax: (addr gap-buffer) <- lookup *data-ah
     80   var data/esi: (addr gap-buffer) <- copy _data
     81   # data-disk -> stream
     82   var s-storage: (stream byte 0x1000)  # space for 8/sectors
     83   var s/ebx: (addr stream byte) <- address s-storage
     84   load-sectors data-disk, 0/lba, 8/sectors, s
     85 #?   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg
     86   # stream -> gap-buffer
     87   load-gap-buffer-from-stream data, s
     88   clear-stream s
     89   # read: gap-buffer -> cell
     90   var initial-root-storage: (handle cell)
     91   var initial-root/ecx: (addr handle cell) <- address initial-root-storage
     92   read-cell data, initial-root, 0/no-trace
     93   clear-gap-buffer data
     94   #
     95   {
     96     var initial-root-addr/eax: (addr cell) <- lookup *initial-root
     97     compare initial-root-addr, 0
     98     break-if-!=
     99     return
    100   }
    101   # load globals from assoc(initial-root, 'globals)
    102   var globals-literal-storage: (handle cell)
    103   var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
    104   new-symbol globals-literal-ah, "globals"
    105   var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
    106   var globals-cell-storage: (handle cell)
    107   var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
    108   lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
    109   var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
    110   {
    111     compare globals-cell, 0
    112     break-if-=
    113     load-globals globals-cell-ah, globals
    114   }
    115   # sandbox = assoc(initial-root, 'sandbox)
    116   var sandbox-literal-storage: (handle cell)
    117   var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
    118   new-symbol sandbox-literal-ah, "sandbox"
    119   var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
    120   var sandbox-cell-storage: (handle cell)
    121   var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
    122   lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
    123   var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
    124   {
    125     compare sandbox-cell, 0
    126     break-if-=
    127     # print: cell -> stream
    128     print-cell sandbox-cell-ah, s, 0/no-trace
    129     # stream -> gap-buffer
    130     load-gap-buffer-from-stream data, s
    131   }
    132 }
    133
    134 # Save state as an alist of alists:
    135 #   ((globals . ((a . (fn ...))
    136 #                ...))
    137 #    (sandbox . ...))
    138 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
    139   compare data-disk, 0/no-disk
    140   {
    141     break-if-!=
    142     return
    143   }
    144   var stream-storage: (stream byte 0x1000)  # space enough for 8/sectors
    145   var stream/edi: (addr stream byte) <- address stream-storage
    146   write stream, "(\n"
    147   write-globals stream, globals
    148   write-sandbox stream, sandbox
    149   write stream, ")\n"
    150   store-sectors data-disk, 0/lba, 8/sectors, stream
    151 }