about summary refs log tree commit diff stats
path: root/075channel.mu
Commit message (Collapse)AuthorAgeFilesLines
* 4261 - start using literals for 'true' and 'false'Kartik Agaram2018-06-171-5/+5
| | | | | | | | | They uncovered one bug: in edit/003-shortcuts.mu <scroll-down> was returning 0 for an address in one place where I thought it was returning 0 for a boolean. Now we've eliminated this bad interaction between tangling and punning literals.
* 4242 - get rid of refcounts entirelyKartik Agaram2018-05-121-13/+5
| | | | | | | | | We're going to lean back into the experiment of commit 4179 back in Jan. If we delete memory it's up to us to ensure no pointers into it survive. Since deep-copy depends on our refcounting infrastructure, it's gone as well. So we're going to have to start watching out for pointers shared over channels.
* 4134 - 'input' = 'ingredient'Kartik K. Agaram2017-12-031-13/+13
|
* 3933Kartik K. Agaram2017-06-201-12/+12
|
* 3932Kartik K. Agaram2017-06-201-5/+25
| | | | | Some corrections and one bugfix to channels after reviewing their implementation with Caleb Couch.
* 3828 - make buffers shape-shifting (generic)Kartik K. Agaram2017-04-181-2/+2
|
* 3688Kartik K. Agaram2016-11-251-0/+3
| | | | | | | Move my todos over the past couple of years into the codebase now that it might be going dormant. Surprising how few todos left undone!
* 3608 - concurrent writes to fake file systemKartik K. Agaram2016-10-291-0/+4
|
* 3552Kartik K. Agaram2016-10-221-1/+1
| | | | | | | | | | | | | | | | | | Stop requiring jump instructions to explicitly provide a ':label' type for jump targets. This has been a source of repeated confusion for my students: a) They'd add the ':label' to the label definition rather than the jump target (label use) b) They'd spend time thinking about whether the initial '+' prefix was part of the label name. In the process I cleaned up a couple of things: - the space of names is more cleanly partitioned into labels and non-labels (clarifying that '_' and '-' are non-label prefixes) - you can't use label names as regular variables anymore - you can infer the type of a label just from its name
* 3527Kartik K. Agaram2016-10-201-1/+15
|
* 3429 - standardize Mu scenariosKartik K. Agaram2016-09-281-21/+22
| | | | | | | | | | | | | A long-standing problem has been that I couldn't spread code across 'run' blocks because they were separate scopes, so I've ended up making them effectively comments. Running code inside a 'run' block is identical in every way to simply running the code directly. The 'run' block is merely a visual aid to separate setup from the component under test. In the process I've also standardized all Mu scenarios to always run in a local scope, and only use (raw) numeric addresses for values they want to check later.
* 3392Kartik K. Agaram2016-09-171-2/+2
| | | | Bugfix for the "remaining bug" mentioned in commit 3391.
* 3390Kartik K. Agaram2016-09-171-5/+5
|
* 3389Kartik K. Agaram2016-09-171-46/+46
|
* 3387Kartik K. Agaram2016-09-171-31/+31
|
* 3385Kartik K. Agaram2016-09-171-45/+45
|
* 3379Kartik K. Agaram2016-09-171-6/+6
| | | | Can't use type abbreviations inside 'memory-should-contain'.
* 3353Kartik K. Agaram2016-09-151-0/+5
| | | | | | | | | | | | | Fix failing scenarios in channel layer. We do so by introducing a kludgy new instruction to explicitly signal when a routine is stuck ('blocked') and waiting on another. All this locking and blocking may well be a crap design. We'll see if we find ourselves using these primitives again. Ideally we don't need them for anything else now that we're done building channels. Still some failing scenarios left in chessboard.mu. Let's see how that goes.
* 3351 - new but incomplete synchronization setupKartik K. Agaram2016-09-141-21/+39
| | | | | | | | | | | | | Previously our channels were based on an unconventional `wait-for-location` primitive that waits for a specific address to change its contents. This only works as long as a channel has a single reader and a single writer routine. To support multiple readers and writers we switch to a more conventional compare-and-set primitive. There's still a couple of failing scenarios, though -- the ones using `wait-for-routine-to-block`, because the new approach never blocks on an empty or full channel, just yields CPU for a time before polling. Hmm, how to fix this?
* 3337 - first use of type abbreviations: textKartik K. Agaram2016-09-121-1/+1
| | | | | In the process I've uncover a couple of situations we don't support type abbreviations yet. They're next.
* 3258Kartik K. Agaram2016-08-261-4/+4
| | | | | | | | | | | | | In the process of debugging the last couple of commits (though I no longer remember exactly how) I noticed that 'wait-for-routine' only waits until the target routine stops running for any reason, including when it blocks on something. That's not the synchronization primitive we want in production code, even if it's necessary for some scenarios like 'buffer-lines-blocks-until-newline'. So we rename the old 'wait-for-routine' primitive to 'wait-for-routine-to-block', and create a new version of 'wait-for-routine' that say callers of 'start-writing' can safely use, because it waits until a target routine actually completes (either successfully or not).
* 3231 - reading from fake files in scenariosKartik K. Agaram2016-08-201-0/+2
|
* 3225 - testable interface for writing filesKartik K. Agaram2016-08-181-1/+0
| | | | | | | | For example usage of file operations, see filesystem.mu. Is it ugly that we don't actually write to disk unless we wait for the writing routine to exit? Maybe there's a nice way to wrap it. At any rate, all buffering is explicit, which seems a win compared to *nix.
* 3194Kartik K. Agaram2016-08-161-2/+2
|
* 3154 - reorg before making 'random' more testableKartik K. Agaram2016-07-271-0/+452
rtik K. Agaram <vc@akkartik.com> 2014-08-21 19:55:16 -0700 62' href='/akkartik/mu/commit/mu.arc?h=main&id=baf61345bfa68d6457a9300e0d3e3aefe5196c30'>baf61345 ^
0a8858db ^

baf61345 ^



c532f0ab ^
d95ed21d ^
c532f0ab ^

d95ed21d ^
c532f0ab ^

d95ed21d ^
c532f0ab ^

















d95ed21d ^










c532f0ab ^
d95ed21d ^


c532f0ab ^
d95ed21d ^


c140d9cc ^
c532f0ab ^





c140d9cc ^
c532f0ab ^
d95ed21d ^
fbe15a98 ^
d95ed21d ^
c140d9cc ^
c532f0ab ^





d95ed21d ^
c532f0ab ^
d95ed21d ^

d90d6629 ^



d90d6629 ^
d90d6629 ^






92819aa5 ^

d90d6629 ^




















c532f0ab ^

d95ed21d ^
c532f0ab ^

2ee76bda ^
c532f0ab ^
d90d6629 ^
c532f0ab ^
d90d6629 ^
c532f0ab ^

d90d6629 ^


c532f0ab ^

b83c85c8 ^
d90d6629 ^

f9dd51f6 ^
baf61345 ^

6da81a3e ^












6a2edbe8 ^

d90d6629 ^
c532f0ab ^


d95ed21d ^

c532f0ab ^




d95ed21d ^
230415b4 ^




d90d6629 ^
c532f0ab ^
d95ed21d ^
d90d6629 ^
817b7e0b ^
d95ed21d ^
d90d6629 ^


d90d6629 ^


d95ed21d ^
c532f0ab ^
c140d9cc ^
e74ff413
230415b4 ^


















6215fec2 ^








b794da7f ^



6215fec2 ^

























b794da7f ^



b90a10d2 ^
6215fec2 ^


b794da7f ^
b90a10d2 ^
b794da7f ^



b90a10d2 ^
b794da7f ^



b90a10d2 ^
6215fec2 ^























1f18a4fd ^
c72d8310 ^
f37b3ab4 ^
d95ed21d ^
e74ff413
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379

                                                               




                                       



                                             
             
                
                                                                    

                                                  
                                                                          


                                                                                                  


                                   

                                                                                         
                                                                                      
                                                                                      

                                                                                              
                                                                                  

                                                                                              
                                                                 
                

                        
                               



                             
 

                             
 

                       
 

                                                                                    
 


                       
                 
                        
                                  
                        

                                            
 



                                 






                 
                                                
                              



                                                        
 







                                                      
 


                            
                            

                                         



                                        
                                                                        
 

                                      
 

                              
 

















                                                         










                                            
                                                                  


                                             
                                                                   


                  
               





                                                                        
 
                                            
                
               
                  
                                                      





                                                                                       
                           
                                                                 

                                       



                       
                                         






                                                

                                                     




















                                           

                                                             
                                

                                                
                    
                                                  
                     
                                                   
                   

                                                               


                                        

                                                             
                               

                           
                   

                                                                                              












                                                                                      

                                             
                     


                                                                                      

                                                                




                                                               
                                 




                                                
                                            
                                             
                                 
                 
                                                            
                                             


                                                          


                                            
               
                         
                         
 


















                                                                 








                                                                    



                                                                             

























                                                  



                                          
                                                                      


                                                
                                          
                                                                             



                                          
                                                              



                                                   
                                                                     























                                                                   
       
               
                           
             
                
; things that a future assembler will need separate memory for:
;   code; types; args channel
(= initialization-fns* (queue))
(def reset ()
  (each f (as cons initialization-fns*)
    (f)))

(mac init-fn (name . body)
  `(enq (fn () (= (function* ',name) ',body))
        initialization-fns*))

(def clear ()
  (= types* (obj
              ; must be scalar or array, sum or product or primitive
              type (obj size 1)
              type-array (obj array t  elem 'type)
              type-array-address (obj size 1  address t  elem 'type-array)
              typeinfo (obj size 5  record t  elems '(integer boolean boolean boolean type-array))
              typeinfo-address (obj size 1  address t  elem 'typeinfo)
              typeinfo-address-array (obj array t  elem 'typeinfo-address)
              location (obj size 1)
              integer (obj size 1)
              boolean (obj size 1)
              ; arrays consist of an integer length followed by the right number of elems
              integer-array (obj array t  elem 'integer)
              integer-address (obj size 1  address t  elem 'integer)  ; pointer to int
              ; records consist of a series of elems, corresponding to a list of types
              integer-boolean-pair (obj size 2  record t  elems '(integer boolean))
              integer-boolean-pair-address (obj size 1  address t  elem 'integer-boolean-pair)
              integer-boolean-pair-array (obj array t  elem 'integer-boolean-pair)
              integer-integer-pair (obj size 2  record t  elems '(integer integer))
              integer-point-pair (obj size 2  record t  elems '(integer integer-integer-pair))
              custodian  (obj size 1  record t  elems '(integer))
              ))
  (= memory* (table))
  (= function* (table)))
(enq clear initialization-fns*)

(def add-fns (fns)
  (each (name . body) fns
    (= function*.name body)))

(def v (operand)  ; for value
  operand.0)

(def metadata (operand)
  cdr.operand)

(def ty (operand)
  operand.1)  ; assume type is always first bit of metadata, and it's always present

(def typeinfo (operand)
  (types* ty.operand))

(def sz (operand)
;?   (prn "sz " operand)
  ; todo: override this for arrays
  typeinfo.operand!size)
(defextend sz (typename) (isa typename 'sym)
  types*.typename!size)

(def addr (loc)
  (if (pos 'deref (metadata loc))
    (memory* (v loc))
    (v loc)))

(def addrs (n sz)
  (accum yield
    (repeat sz
      (yield n)
      (++ n))))

(def m (loc)  ; read memory, respecting metadata
;?   (prn "m " loc " " sz.loc)
  (if (is 1 sz.loc)
    (memory* (addr loc))
    (annotate 'record
              (map memory* (addrs (addr loc) sz.loc)))))

(def setm (loc val)  ; set memory, respecting metadata
;?   (prn "setm " loc " " val)
  (assert sz.loc)
  (if (is 1 sz.loc)
    (= (memory* addr.loc) val)
    (each (dest src) (zip (addrs addr.loc sz.loc)
                          (rep val))
      (= (memory* dest) src))))

(def array-len (operand)
  (m `(,v.operand integer)))

(def array-ref (operand idx)
  (assert typeinfo.operand!array)
  (assert (< -1 idx (array-len operand)))
  (withs (elem  typeinfo.operand!elem
          offset  (+ 1 (* idx sz.elem)))
    (m `(,(+ v.operand offset) ,elem))))

; context contains the call-stack of functions that haven't yet returned

(defextend empty (x)  (isa x 'context)
  (no rep.x!call-stack))

(def stack (context)
  ((rep context) 'call-stack))

(mac push-stack (context op)
  `(push (obj fn-name ,op  pc 0  caller-arg-idx 0)
         ((rep ,context) 'call-stack)))

(mac pop-stack (context)
  `(pop ((rep ,context) 'call-stack)))

(def top (context)
  stack.context.0)

(def body (context (o idx 0))
  (function* stack.context.idx!fn-name))

(mac pc (context (o idx 0))  ; assignable
  `((((rep ,context) 'call-stack) ,idx) 'pc))

(mac caller-arg-idx (context (o idx 0))  ; assignable
  `((((rep ,context) 'call-stack) ,idx) 'caller-arg-idx))

(= scheduling-interval* 500)

(def parse-instr (instr)
  (iflet delim (pos '<- instr)
    (list (cut instr 0 delim)  ; oargs
          (instr (+ delim 1))  ; op
          (cut instr (+ delim 2)))  ; args
    (list nil instr.0 cdr.instr)))

(def caller-args (context)  ; not assignable
  (let (_ _ args)  (parse-instr ((body context 1) (pc context 1)))
    args))

(def caller-oargs (context)  ; not assignable
  (let (oargs _ _)  (parse-instr ((body context 1) (pc context 1)))
    oargs))

(def run (fn-name)
  (ret result 0
    (let context (annotate 'context (obj call-stack (list
                     (obj fn-name fn-name  pc 0  caller-arg-idx 0))))
      (while (~empty context)
;?         (prn "== " context)
        (let insts-run (run-for-time-slice context scheduling-interval*)
          (= result (+ result insts-run)))))))

(def run-for-time-slice (context time-slice)
;?   (prn "AAA")
  (point return
;?     (prn "BBB")
    (for ninstrs 0 (< ninstrs time-slice) (++ ninstrs)
;?       (prn "CCC " pc.context " " context " " (len body.context))
      (while (>= pc.context (len body.context))
        (pop-stack context)
        (if empty.context (return ninstrs))
        (++ pc.context))
;?       (prn "--- " top.context!fn-name " " pc.context ": " (body.context pc.context))
;?       (prn "  " memory*)
      (let (oarg op arg)  (parse-instr (body.context pc.context))
;?         (prn op " " arg " -> " oarg)
        (let tmp
              (case op
                literal
                  arg.0
                add
                  (+ (m arg.0) (m arg.1))
                sub
                  (- (m arg.0) (m arg.1))
                mul
                  (* (m arg.0) (m arg.1))
                div
                  (/ (real (m arg.0)) (m arg.1))
                idiv
                  (list (trunc:/ (m arg.0) (m arg.1))
                        (mod (m arg.0) (m arg.1)))
                and
                  (and (m arg.0) (m arg.1))
                or
                  (or (m arg.0) (m arg.1))
                not
                  (not (m arg.0))
                eq
                  (is (m arg.0) (m arg.1))
                neq
                  (~is (m arg.0) (m arg.1))
                lt
                  (< (m arg.0) (m arg.1))
                gt
                  (> (m arg.0) (m arg.1))
                le
                  (<= (m arg.0) (m arg.1))
                ge
                  (>= (m arg.0) (m arg.1))
                arg
                  (let idx (if arg
                             arg.0
                             (do1 caller-arg-idx.context
                                (++ caller-arg-idx.context)))
;?                     (prn idx)
;?                     (prn caller-args.context)
                    (m caller-args.context.idx))
                type
                  (ty (caller-args.context arg.0))
                otype
                  (ty (caller-oargs.context arg.0))
                jmp
                  (do (= pc.context (+ 1 pc.context (v arg.0)))
;?                       (prn "jumping to " pc.context)
                      (continue))
                jif
                  (when (is t (m arg.0))
                    (= pc.context (+ 1 pc.context (v arg.1)))
;?                     (prn "jumping to " pc.context)
                    (continue))
                copy
                  (m arg.0)
                get
                  (with (base arg.0  ; integer (non-symbol) memory location including metadata
                         idx (v arg.1))  ; literal integer
                    (if
                      typeinfo.base!array
                        (do (assert (is 0 idx))  ; 'get' can only lookup array length
                            (array-len base))
                      typeinfo.base!record
                        ; field index
                        (do (assert (< -1 idx (len typeinfo.base!elems)))
                            (m `(,(+ v.base
                                     (apply + (map sz
                                                   (firstn idx typeinfo.base!elems))))
                                 ,typeinfo.base!elems.idx)))
                      'else
                        (assert nil "get on invalid type @base")))
                aref
                  (array-ref arg.0 (v arg.1))
                reply
                  (do (pop-stack context)
                      (if empty.context (return ninstrs))
                      (let (caller-oargs _ _)  (parse-instr (body.context pc.context))
                        (each (dest src)  (zip caller-oargs arg)
                          (setm dest  (m src))))
                      (++ pc.context)
                      (while (>= pc.context (len body.context))
                        (pop-stack context)
                        (if empty.context (return ninstrs))
                        (++ pc.context))
                      (continue))
                new
                  (let type (v arg.0)
                    (if types*.type!array
                      (new-array type (v arg.1))
                      (new-scalar type)))
                ; else user-defined function
                  (do (push-stack context op)
                      (continue))
                )
              ; opcode generated some value, stored in 'tmp'
;?               (prn "store: " tmp " " oarg)
              (if (acons tmp)
                (for i 0 (< i (min len.tmp len.oarg)) ++.i
                  (setm oarg.i tmp.i))
                (when oarg  ; must be a list
;?                   (prn oarg.0)
                  (setm oarg.0 tmp)))
              )
        (++ pc.context)))
    (return time-slice)))

(enq (fn () (= Memory-in-use-until 1000))
     initialization-fns*)
(def new-scalar (type)
  (ret result Memory-in-use-until
    (++ Memory-in-use-until sizeof.type)))

(def new-array (type size)
  (ret result Memory-in-use-until
    (++ Memory-in-use-until (* (sizeof types*.type!elem) size))))

(def sizeof (type)
  (if (~or types*.type!record types*.type!array)
        types*.type!size
      types*.type!record
        (sum idfn
          (accum yield
            (each elem types*.type!elems
              (yield sizeof.elem))))))

(def convert-braces (instrs)
  (let locs ()  ; list of information on each brace: (open/close pc)
    (let pc 0
      (loop (instrs instrs)
        (each instr instrs
          (if (~is 'begin instr.0)
            (do
;?               (prn pc " " instr)
              (++ pc))
            ; hack: racket replaces curlies with parens, so we need the
            ; keyword begin to delimit blocks.
            ; ultimately there'll be no nesting and curlies will just be in a
            ; line by themselves.
            (do
;?               (prn `(open ,pc))
              (push `(open ,pc) locs)
              (recur cdr.instr)
;?               (prn `(close ,pc))
              (push `(close ,pc) locs))))))
    (zap rev locs)
;?     (prn locs)
    (with (pc  0
           stack  ())  ; elems are pcs
      (accum yield
        (loop (instrs instrs)
          (each instr instrs
            (let delim (or (pos '<- instr) -1)
              (with (oarg  (if (>= delim 0)
                             (cut instr 0 delim))
                     op  (instr (+ delim 1))
                     arg  (cut instr (+ delim 2)))
;?                 (prn op " " oarg)
                (case op
                  begin
                    (do
                      (push pc stack)
                      (assert:is oarg nil)
                      (recur arg)
                      (pop stack))
                  break
                    (do
                      (assert:is oarg nil)
                      (assert:is arg nil)
                      (yield `(jmp (,(close-offset pc locs) offset))))
                  breakif
                    (do
;?                       (prn "breakif: " instr)
                      (assert:is oarg nil)
                      (yield `(jif ,arg.0 (,(close-offset pc locs) offset))))
                  continue
                    (do
                      (assert:is oarg nil)
                      (assert:is arg nil)
                      (yield `(jmp (,(- stack.0 pc) offset))))
                  continueif
                    (do
;?                       (prn "continueif: " instr)
                      (assert:is oarg nil)
                      (yield `(jif ,arg.0 (,(- stack.0 pc) offset))))
                  ;else
                    (yield instr))))
            (++ pc)))))))

(def close-offset (pc locs)
  (let close 0
    (with (stacksize 0
           done nil)
      (each (state loc) locs
;?         (prn "  :" close " " state " - " loc)
        (if (< loc pc)
              nil  ; do nothing
            (no done)
              (do
                ; first time
                (when (and (is 0 stacksize) (~is loc pc))
                  (++ stacksize))
                (if (is 'open state) (++ stacksize) (-- stacksize))
                ; last time
                (when (is 0 stacksize)
                  (= close loc)
                  (set done))))))
    (- close pc 1)))

(reset)
(awhen cdr.argv
  (map add-fns:readfile it)
  (run 'main)
  (prn memory*))