diff options
| -rw-r--r-- | include/data.s | 60 | ||||
| -rw-r--r-- | include/gc.s | 6 | ||||
| -rw-r--r-- | include/intops.s | 6 | ||||
| -rw-r--r-- | include/io.s | 3 | ||||
| -rw-r--r-- | include/uskel.s | 4 | ||||
| -rw-r--r-- | sumac.s | 40 | ||||
| -rw-r--r-- | zipfib.s | 67 |
7 files changed, 175 insertions, 11 deletions
diff --git a/include/data.s b/include/data.s index 4a827e2..35c4c8d 100644 --- a/include/data.s +++ b/include/data.s @@ -1,7 +1,7 @@ .ifndef _data_s_file _data_s_file: - nop + nop # avoid confusing gdb # Format of the info tables: # - code @@ -64,6 +64,62 @@ IND_info: IND_code: enter 010(%rbp) +# Blackhole (contains the original thunkptr for debugging purposes) +# | ptr | orig_thunkptr | +BLE_evacuate: + jmp _gc_evacuate_ret +BLE_scavenge: + jmp _gc_scavenge_ret + +BLE_info_table: + cell BLE_evacuate + cell BLE_scavenge + cell 0 +BLE_code: + # if we hit this, we've got a pure loop in a program, and it is never + # going to actually progress. So let's just shoot it down with a + # helpful message or so. + mov 010(%rbp), %r15 + + mov $1, %rdi #stdout + + mov $14, %rdx + mov $BLE_msg, %rsi + mov $1, %rax #write + syscall + + mov $1, %rdx + BLE_loop: + mov %r15, %rcx + and $0xf, %rcx + mov $BLE_hex, %rsi + add %rcx, %rsi + mov $1, %rax + syscall + shr $4, %r15 + jnz BLE_loop + + mov $BLE_nl, %rsi + mov $1, %rax + syscall + + # shot self down (and retry if it doesn't succeed) + BLE_retry_sigkill: + mov $39, %rax + syscall # getpid + mov %rax, %rdi + mov $6, %rsi # SIGABRT + mov $62, %rax # kill + syscall + jmp BLE_retry_sigkill + +BLE_msg: + .ascii "diverged at 0x" +BLE_hex: + .ascii "0123456789abcdef" +BLE_nl: + .ascii "\n" + # List # | ptr | 0 | # [] case # | ptr | 1 | a | b | # (a:b) case @@ -86,7 +142,7 @@ LIST_scavenge: cmpq $0, 010(%rbp) je LIST_scavenge_nil mov %rbp, %r15 - + mov $LIST_scavenge1, %rsi mov 020(%r15), %rbp jmp _gc_evacuate diff --git a/include/gc.s b/include/gc.s index ae71d5c..b40ac95 100644 --- a/include/gc.s +++ b/include/gc.s @@ -96,7 +96,7 @@ _uskel_alloc: _uskel_gc_init: mov %rsi, %r13 - movq $0x100, _gc_min_alloc # must be higher than 2x the biggest thunk possible + movq $0x100000, _gc_min_alloc # must be higher than 2x the biggest thunk possible movq $0x180, _gc_grow_ratio movq $0x40, _gc_shrink_ratio mov $0, %rsp # fake original rsp for first alloc run @@ -124,7 +124,7 @@ _uskel_gc: # point the writer to the new memory area mov _write_region_end, %rsp mov %rsp, %r8 # % r8 is the "last thing that was scavenged" - + # start by evacuating the thunk and cont mov _gc_backup_thunk, %rbp mov $_uskel_gc_evacuate_cont_thunk, %rsi @@ -167,7 +167,7 @@ _uskel_gc: mov _gc_region_start, %rdi # addr = gc start sub %rdi, %rsi # len = gc end - gc start syscall - + # recalculate the gc trigger point mov %rsp, %rax sub _write_region_start, %rax diff --git a/include/intops.s b/include/intops.s index dbadb37..08b3300 100644 --- a/include/intops.s +++ b/include/intops.s @@ -5,13 +5,13 @@ _intops_s_file: .include "include/primops.s" .primop2 plus - mov 010(%rsi), %rax # arg 2 + mov 010(%rsi), %rax # arg 2 mov 020(%rbp), %rsi # location of arg1 add 010(%rsi), %rax # arg 1 primop2_ret_int %rax .primop2 mul - mov 010(%rsi), %rax # arg 2 + mov 010(%rsi), %rax # arg 2 mov 020(%rbp), %rsi # location of arg1 mulq 010(%rsi) # arg 1 (goes to %rax and %rdx) primop2_ret_int %rax @@ -19,7 +19,7 @@ _intops_s_file: .primop2 sub mov 020(%rbp), %rdi # location of arg1 mov 010(%rdx), %rax # arg 1 - sub 010(%rsi), %rax # arg 2 + sub 010(%rsi), %rax # arg 2 primop2_ret_int %rax .endif # _intops_s_file diff --git a/include/io.s b/include/io.s index 0431dd0..29a63c9 100644 --- a/include/io.s +++ b/include/io.s @@ -10,6 +10,7 @@ _io_s_file: # arg -> | ret | cont | .thunkcode print_fini + needs_alloc $0110 #64 bit characters + 8 backup mov 010(%rsi), %rax # make a string @@ -25,7 +26,7 @@ _io_s_file: shr $1, %rax jnz print_fini_loop - mov $0, %rdi #stdin + mov $1, %rdi #stdout mov %rsp, %rdx sub %r15, %rdx #size mov %r15, %rsi #buf diff --git a/include/uskel.s b/include/uskel.s index f59a1f7..0a21217 100644 --- a/include/uskel.s +++ b/include/uskel.s @@ -32,10 +32,10 @@ _uskel_start: pushq $0 pushq $main - mov $0, %rsi # set continuation to exit + # loop the continuation to itself (prevents gc trouble, should never be reached) + mov %rsp, %rsi enter %rsp # run the program # Q: are there gonna be functions that have both the argument AND the cont? - # # A: No, stuff is either entered as return-continuation (takes res, # cont has to be saved) or as forward call (takes cont) # @@ -0,0 +1,40 @@ + + +.include "include/uskel.s" + +.include "include/data.s" +.include "include/io.s" +.include "include/intops.s" + +.primop2 sumac + needs_alloc $0100 + + mov 020(%rbp), %rdi #1st arg + mov 010(%rdi), %rcx #1st arg val + mov 010(%rsi), %rax #2nd arg val + + cmp $0, %rcx + jz sumac_ret + + add %rcx, %rax + dec %rcx + thunkto %r10, $INT_code, %rcx + thunkto %r11, $INT_code, %rax + thunkto %r10, $sumac, $2, %r10, %r11 + primop2_cont_indirect %r10 + + sumac_ret: + primop2_ret_int %rax + +.thunkcode main + needs_alloc $0150 + + thunkto %r11, $INT_code, $10000000 + thunkto %r12, $INT_code, $0 + thunkto %r11, $sumac, $2, %r11, %r12 + + thunkto %r11, $print, $1, %r11 + thunkto %rsi, $main_exit, $0 + enter %r11 + +.include "include/main_exit.s" diff --git a/zipfib.s b/zipfib.s new file mode 100644 index 0000000..493a2ae --- /dev/null +++ b/zipfib.s @@ -0,0 +1,67 @@ + +.include "include/uskel.s" + +.include "include/listops.s" +.include "include/intops.s" +.include "include/io.s" +.include "include/main_exit.s" +.include "include/apply.s" + +# TODO this seems to fill the memory with plus_fini thunks; find out why. + +.thunkcode zipWith + needs_alloc $070 + thunkto %rsi, $zipWith_arg1, $5, 020(%rbp), 030(%rbp), 040(%rbp), %rbp, %rsi + enter 030(%rbp) + +.thunkcode zipWith_arg1 + movq $zipWith_fini, (%rbp) + mov %rsi, 030(%rbp) + mov %rbp, %rsi + mov 040(%rbp), %rbp + enter_rbp + +.thunkcode zipWith_fini + needs_alloc $0150 + mov 030(%rbp), %r8 # arg1 + mov %rsi, %r9 # arg2 + cmpq $0, 010(%r8) + je zipWith_null + cmpq $0, 010(%r9) + je zipWith_null + + # f (head arg1) (head arg2) : zipWith f (tail arg1) (tail arg2) + thunkto %r10, $zipWith, $3, 020(%rbp), 030(%r8), 030(%r9) + thunkto %r11, $apply, $3, 020(%rbp), 020(%r8), 020(%r9) + thunkto %rsi, $LIST_code, $1, %r11, %r10 + + zipWith_ret: + mov 050(%rbp), %r8 + movq $IND_code, 000(%r8) + mov %rsi, 010(%r8) + mov 060(%rbp), %rbp + enter_rbp + + zipWith_null: + thunkto %rsi, $LIST_code, $0 + jmp zipWith_ret + + +.thunkcode main + needs_alloc $0370 + # x = 0 : 1 : zipWith plus x (tail x) + thunkto %r8, $FUN2_code, $plus, $0 + thunkto %r8, $zipWith, $3, %r8, $0, $0 + thunkto %r9, $INT_code, $1 + thunkto %r9, $LIST_code, $1, %r9, %r8 + thunkto %r10, $INT_code, $0 + thunkto %r10, $LIST_code, $1, %r10, %r9 + # recurse args! + mov %r10, 030(%r8) + mov %r9, 040(%r8) + + thunkto %r8, $INT_code, $20 + thunkto %r8, $list_int_index, $2, %r8, %r10 + thunkto %r8, $print, $1, %r8 + thunkto %rsi, $main_exit, $0 + enter %r8 |