all looks ok
This commit is contained in:
parent
d1a4eb56cc
commit
970ffb4684
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
#
|
||||
|
|
40
sumac.s
Normal file
40
sumac.s
Normal file
|
@ -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"
|
67
zipfib.s
Normal file
67
zipfib.s
Normal file
|
@ -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
|
Loading…
Reference in a new issue