From 8504d72bda94c3a1668ebbdd262ae8a4963a23c1 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sun, 29 Oct 2023 23:03:33 +0100
Subject: gc attempt 1 (to be cont'd)

---
 include/uskel.s | 79 +++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 49 insertions(+), 30 deletions(-)

(limited to 'include/uskel.s')

diff --git a/include/uskel.s b/include/uskel.s
index 34ee63a..bca33c9 100644
--- a/include/uskel.s
+++ b/include/uskel.s
@@ -8,41 +8,57 @@ _start:
 
 .include "include/macros.s"
 
+# this has globals
 .section .bss
-_memory_state:
-	cell 0 # bottom of allocation (grows down)
-	cell 0 # region start
-	cell 0 # region end
-	cell 0 # program entry rsp (aka the actual stack)
+_unix_rsp:
+	# back-up of program entry rsp (aka the actual stack given by the
+	# actual OS; we might like to use it at some point, maybe)
+	cell 0
+_write_region_start:
+	# begin of the active memory area
+	cell 0
+_write_region_end:
+	# end of the active memory area (%rsp kinda starts here and goes down
+	# towars the start)
+	cell 0
+_gc_last_size:
+	# how much data we evacuated last time
+	cell 0
+_gc_min_alloc:
+	# minimum possible allocation
+	cell 0x100000 # tunable constant
+_gc_min_expect_ratio:
+	# 256th's of the minimal amount of memory increment compared to the
+	# last time. New minimal amount is compared as:
+	# (ratio * last size) >> 8
+	cell 0x200 # tunable constant
+_gc_region_start:
+	# in GC, this region is being evacuated and will eventually disappear
+	cell 0
+_gc_region_end:
+	# end of the disappear region
+	cell 0
+_gc_backup_thunk:
+	# backup of %rsi so that we can use the register for other nonsense
+	cell 0
+_gc_backup_cont:
+	# backup of %rbp for same reason
+	cell 0
 
 .section .text
 
-_uskel_alloc_basic_mem:
-	mov $0x100000, %r15 # desired size
-
-	mov $9, %rax # mmap
-	mov $0, %rdi # addr = NULL
-	mov %r15, %rsi # len = %rcx
-	mov $0b11, %rdx # prot = PROT_READ 0b1 | PROT_WRITE 0b10
-	mov $0x22, %r10 # flags = MAP_PRIVATE 0x2 | MAP_ANONYMOUS 0x20
-	mov $-1, %r8 # fd = -1
-	mov $0, %r9 # off = 0
-	syscall
-	mov $_memory_state, %rdi
-	mov %rax, 010(%rdi)
-	add %r15, %rax
-	mov %rax, (%rdi)
-	mov %rax, 020(%rdi)
-	retq
+.include "include/gc.s"
 
 _uskel_start:
-	call _uskel_alloc_basic_mem
-	# use the stack pointer for easy writing to the heap,
-	# but back it up to memory state
-	mov $_memory_state, %rdi
-	mov %rsp, 030(%rdi)
-	mov 0(%rdi), %rsp
+	# we use the stack pointer for easy writing to the heap;
+	# back it up to memory state just if we ever needed it again.
+	mov %rsp, _unix_rsp
 
+	# allocate the initial chunk of memory
+	mov $_uskel_start_main, %rsi
+	jmp _uskel_alloc
+
+	_uskel_start_main:
 	# push a thunk for main
 	pushq $0
 	pushq $main
@@ -50,5 +66,8 @@ _uskel_start:
 	mov $0, %rsi # set continuation to exit
 	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)
-	# (needs validation)
+	# 
+	# A: No, stuff is either entered as return-continuation (takes res,
+	# cont has to be saved) or as forward call (takes cont)
+	#
+	# (A needs validation)
-- 
cgit v1.2.3


From 2bc3d9a3815a6cd172b3b4f7696c46a006021b13 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Tue, 31 Oct 2023 00:12:51 +0100
Subject: gc kinda almost there

---
 exit_123.s        |   1 +
 fibs.s            |   3 +
 include/data.s    | 189 ++++++++++++++++++++++++++++++++++++++----------------
 include/gc.s      | 173 ++++++++++++++++++++++++++++++++++++++++++-------
 include/io.s      |   1 +
 include/listops.s |   2 +
 include/primops.s |   2 +
 include/uskel.s   |  37 +----------
 print_123.s       |   1 +
 9 files changed, 298 insertions(+), 111 deletions(-)

(limited to 'include/uskel.s')

diff --git a/exit_123.s b/exit_123.s
index 1e7ba23..cf56f7d 100644
--- a/exit_123.s
+++ b/exit_123.s
@@ -5,6 +5,7 @@
 
 # || -> cont
 .thunkcode main
+	needs_alloc $0120
 	thunkto %r11, $INT_code, $100
 	thunkto %r12, $INT_code, $23
 	thunkto %r13, $plus, $2, %r11, %r12
diff --git a/fibs.s b/fibs.s
index 3d35544..f008dae 100644
--- a/fibs.s
+++ b/fibs.s
@@ -8,6 +8,7 @@
 
 # | lag1 | lag2 | -> cont
 .thunkcode fibs
+	needs_alloc $0140
 	# next value
 	thunkto %r11, $plus, $2, 020(%rbp), 030(%rbp)
 
@@ -28,12 +29,14 @@
 
 # || -> cont
 .thunkcode fibs0
+	needs_alloc $0100
 	thunkto %r12, $INT_code, $1
 	thunkto %r11, $INT_code, $0
 	thunkto %rbp, $fibs, $2, %r11, %r12
 	enter_rbp
 
 .thunkcode main
+	needs_alloc $0160
 	thunkto %r12, $fibs0, $0
 	thunkto %r11, $INT_code, $20
 	thunkto %r11, $list_int_index, $2, %r11, %r12
diff --git a/include/data.s b/include/data.s
index 43d2ba8..3ee8213 100644
--- a/include/data.s
+++ b/include/data.s
@@ -2,40 +2,104 @@
 .ifndef _data_s_file
 _data_s_file:
 
-# Simple values and boxed machine integers
-# | ptr | value |
-CON_evacuate1:
-	retq # TODO
-CON_scavenge1:
-	retq
-
 # Format of the info tables:
 # - code
 # ----- code pointer
 # - 8B helper information for eval/apply (generally this is 0, and only gets used for FUN/PAP)
 # - 8B pointer to scavenge
 # - 8B pointer to evacuate
+#
+# Evacuate interface:
+# in: %rsi continuation, %rbp what to evacuate
+# out: %rbp where the thing is now
+# Notes:
+#  - IND thunks skip themselves on evacuate
+#  - checking if whether stuff is already in write region are managed by _gc_evacuate prelude
+#
+# Scavenge interface:
+# in: %rsi continuation, %rbp what to scavenge
+# out: %rbp next thing to scavenge in memory
+#
+# Saved registers by evacuate and scavenge
+# - _uskel_gc needs to preserve %rdi now; that might increase
+# - scavenges use %r12-%r15
+# - %rax-%rdx is scratch and evacuate use
+
+# Simple values and boxed machine integers
+# | ptr | value |
+INT_evacuate:
+	pushq 010(%rbp)
+	pushq $INT_code
+	mov %rsp,%rbp
+	jmp *%rsi
+INT_scavenge:
+	add $020, %rbp
+	jmp *%rsi
 
 INT_info_table:
-	cell CON_evacuate1
-	cell CON_scavenge1
+	cell INT_evacuate
+	cell INT_scavenge
 	cell 0
 INT_code:
 	continue
 
+# Indirection
+# | ptr | indptr |
+IND_evacuate:
+	mov 010(%rbp), %rbp
+	jmp _gc_evacuate
+IND_scavenge:
+	jmp 0 # thou shalt not scavenge here
+
+IND_info:
+	cell IND_evacuate
+	cell IND_scavenge
+	cell 0
+IND_code:
+	enter 010(%rbp)
+
 # List
-# | ptr | 0 |
-# | ptr | 1 | a | b |
+# | ptr | 0 |           # [] case
+# | ptr | 1 | a | b |   # (a:b) case
 LIST_evacuate:
-	# [] | a : b
-	retq #TODO
+	cmpq $0, 010(%rbp)
+	je LIST_evacuate_nil
+	pushq 030(%rbp)
+	pushq 020(%rbp)
+	pushq $1
+	pushq $LIST_code
+	mov %rsp, %rbp
+	jmp *%rsi
+	LIST_evacuate_nil:
+	pushq $0
+	pushq $LIST_code
+	mov %rsp, %rbp
+	jmp *%rsi
 LIST_scavenge:
-	mov 010(%rbp), %rax
-	shl $1, %rax
-	add $2, %rax
-	shl $3, %rax
-	add %rax, %rsi
-	retq
+	cmpq $0, 010(%rbp)
+	je LIST_scavenge_nil
+	mov %rbp, %r15
+	mov %rsi, %r14
+	
+	mov $LIST_scavenge1, %rsi
+	mov 020(%r15), %rbp
+	jmp _gc_evacuate
+	LIST_scavenge1:
+	mov %rbp, 020(%r15)
+
+	mov $LIST_scavenge2, %rsi
+	mov 030(%r15), %rbp
+	jmp _gc_evacuate
+	LIST_scavenge2:
+	mov %rbp, 030(%r15)
+
+	mov %r15, %rbp
+	add $040, %rbp
+	jmp *%r14
+	LIST_scavenge_nil:
+	add $020, %rbp
+	jmp *%rsi
+
 LIST_info_table:
 	cell LIST_evacuate
 	cell LIST_scavenge
@@ -46,13 +110,14 @@ LIST_code:
 # FUN objects
 # | ptr | thunkptr | args | arg[0] | arg[1] | ... | arg[args] |
 FUN_evacuate:
-	retq #TODO
+	#TODO
 FUN_scavenge:
-	mov 020(%rbp), %rax
-	add $3, %rax
-	shl $3, %rax
-	add %rax, %rsi
-	retq
+	#TODO
+	#mov 020(%rbp), %rax
+	#add $3, %rax
+	#shl $3, %rax
+	#add %rax, %rsi
+	#retq
 
 # Info tables for FUN objects.
 FUN0_info_table:
@@ -89,39 +154,55 @@ FUN4_info_table:
 	cell 4
 FUN4_code:
 	continue
+# add more funN here as needed
 
-# TODO: add more funN here as needed
-
-# indirection (Q: how to recognize IND and THUNK on return?)
-# | ptr | indptr |
-IND_evacuate:
-	retq #TODO
-IND_scavenge:
-	add $020,%rsi
-	retq
-IND_info:
-	cell IND_evacuate
-	cell IND_scavenge
-	cell 0
-IND_code:
-	enter 010(%rbp)
-
-# THU objects (gc implementation only, actual THUs are defined by functions)
+# THU objects (gc implementation only, actual THU data are created by functions)
 # | ptr | args | arg[0] | arg[1] | ... | arg[args] |
 # args wouldn't need to be here but let's keep them for gc simplicity
 THU_evacuate:
-	retq #TODO
+	mov 010(%rbp), %rbx
+	mov %rbx,%rdx
+	mov %rbx,%rcx
+	add $2, %rdx
+	shl $3, %rdx
+	add %rbp, %rdx
+	THU_evacuate_one:
+	dec %rcx
+	cmp $0, %rcx
+	jl THU_evacuate_fini
+	sub $010, %rdx
+	pushq (%rdx)
+	jmp THU_evacuate_one
+	THU_evacuate_fini:
+	pushq %rbx
+	pushq 000(%rbp)
+	mov %rsp, %rbp
+	jmp *%rsi
 THU_scavenge:
-	mov 010(%rbp), %rax
-	add $2,%rax
-	shl $3,%rax
-	add %rax,%rsi
-	retq
+	mov 010(%rbp), %r12
+	mov %rbp, %r15
+	mov %rsi, %r14
+	mov %r12,%r13
+	add $2, %r13
+	shl $3, %r13
+	add %r15, %r13
+	THU_scavenge_one:
+	sub $010, %r13
+	sub $1, %r12
+	jl THU_scavenge_fini
+	mov (%r13), %rbp
+	mov $THU_scavenge_one_cont, %rsi
+	jmp _gc_evacuate
+	THU_scavenge_one_cont:
+	mov %rbp, (%r13)
+	jmp THU_scavenge_one
+
+	THU_scavenge_fini:
+	mov %r15, %rbp
+	mov 010(%rbp), %r13
+	add $2, %r13
+	shl $3, %r13
+	add %r13, %rbp
+	jmp *%r14
 
 .endif # _data_s_file
-
-# evacuate and scavenge:
-# - evacuate just copies the object
-# - scavenge evacuates all children (to the new location IF they are in the old
-#   location), changes the pointer, and moves the scavenge pointer to the next
-#   object (because everything needs to be scavenged)
diff --git a/include/gc.s b/include/gc.s
index bb32240..636a6a2 100644
--- a/include/gc.s
+++ b/include/gc.s
@@ -2,10 +2,53 @@
 .ifndef _gc_s_file
 _gc_s_file:
 
-.macro prealloc name amount
-	mov %rsp,%rax
+.section .bss
+_write_region_start:
+	# begin of the active memory area
+	cell 0
+_write_region_end:
+	# end of the active memory area (%rsp kinda starts here and goes down
+	# towars the start)
+	cell 0
+_gc_trigger:
+	# point in memory where the gc will trigger (we don't necessarily wait for the write region to fill up!)
+	cell 0
+
+_gc_last_size:
+	# how much data we evacuated last time
+	cell 0
+_gc_min_alloc:
+	# minimum possible allocation
+	cell 0 # tunable constant
+_gc_grow_ratio:
+	# 256th's of the minimal amount of memory increment compared to the
+	# last time. New minimal amount is compared as:
+	# (ratio * last size) >> 8
+	cell 0 # tunable constant
+_gc_shrink_ratio:
+	# 256th's of the ratio of post-gc still-free to-space that should be considered for discarding
+	cell 0
+
+_gc_region_start:
+	# in GC, this region is being evacuated and will eventually disappear
+	cell 0
+_gc_region_end:
+	# end of the disappear region
+	cell 0
+
+_gc_backup_thunk:
+	# backup of %rsi so that we can use the register for other nonsense
+	cell 0
+_gc_backup_cont:
+	# backup of %rbp for same reason
+	cell 0
+
+.section .text
+
+.macro needs_alloc amount
+	mov %rsp, %rax
 	sub _write_region_start, %rax
-	cmp $amount, %rax #TODO check direction
+	cmp \amount, %rax
 	jb _uskel_gc
 .endm
 
@@ -14,23 +57,24 @@ _uskel_alloc:
 
 	# calculate the desired size to %r14
 	mov _gc_min_alloc, %r14
+	#add _gc_region_end, %r14
+	#sub _gc_region_start, %r14
 
 	# check if the desired size isn't greater because of the last gc use
 	mov _gc_last_size, %rax
-	mul _gc_min_expect_ratio, %rax
-	shr 8, %rax
-	cmp %r14, %rax #TODO check direction
+	mulq _gc_grow_ratio
+	shr $8, %rax
+	add _gc_min_alloc, %rax
+	cmp %r14, %rax
 	cmova %rax, %r14
 
 	# check if we don't need even more space because we need to evacuate stuff
 	mov _gc_region_end, %rax
 	sub %rsp, %rax # trick -- if we counted from gc region start, allocated memory could never shrink
-	cmp %r14, %rax #TODO direction
+	cmp %r14, %rax
 	cmova %rax, %r14
-	#TODO add functionality to trigger the gc's a bit earlier than when
-	# they hit _write_region_start, to allow for faster compaction.
-	# maybe _write_region_trigger = 25%ish between _write_region_start and %rsp ?
 
+	alloc_goes_mmap:
 	mov $9, %rax # mmap
 	mov $0, %rdi # addr = NULL
 	mov %r14, %rsi # len = %r14
@@ -48,27 +92,110 @@ _uskel_alloc:
 
 	jmp *%r15
 
+_uskel_gc_init:
+	mov %rsi, %r13
+	movq $0x100, _gc_min_alloc
+	movq $0x180, _gc_grow_ratio
+	movq $0x40, _gc_shrink_ratio
+	mov $0, %rsp # fake original rsp for first alloc run
+	mov $_uskel_gc_init_cont, %rsi
+	jmp _uskel_alloc
+	_uskel_gc_init_cont:
+	mov _write_region_start, %rax
+	mov %rax, _gc_trigger
+	jmp *%r13
+
 _uskel_gc:
+	# save what we did before ending up here
 	mov %rbp, _gc_backup_thunk
 	mov %rsi, _gc_backup_cont
+
 	# first we need a new memory area
-	mov _write_region_start, _gc_region_start
-	mov _write_region_end, _gc_region_end
-	mov $_uskel_gc_evacuate, %r15
+	mov _write_region_start, %rbx
+	mov _write_region_end, %rcx
+	mov %rbx, _gc_region_start
+	mov %rcx, _gc_region_end
+	mov $_uskel_gc_evacuate, %rsi
 	jmp _uskel_alloc
 	_uskel_gc_evacuate:
-	# we may also need a scavenging queue! Or can that be solved by walking the write region?
-	# plan:
-	# evacuate thunk and cont, save them right away in _gc_backup_thunk and _cont
-	# scavenge from the top of the gc region, evacuating stuff en route
-	# (this is a little more complex because we grow down, so we have to
-	# scavenge up from %rsp to the last known scavenged position)
-	# finish when scavenge doesn't have anything more to scavenge
+
+	# point the writer to the new memory area
+	mov _write_region_end, %rsp
+	mov %rsp, %rdi # %rdi is "the last scavenged thing"
+	
+	# start by evacuating the thunk and cont
+	mov _gc_backup_thunk, %rbp
+	mov $_uskel_gc_evacuate_cont_thunk, %rsi
+	jmp _gc_evacuate
+	_uskel_gc_evacuate_cont_thunk:
+	mov %rbp, _gc_backup_thunk
+
+	mov _gc_backup_cont, %rbp
+	mov $_uskel_gc_evacuate_cont_cont, %rsi
+	jmp _gc_evacuate
+	_uskel_gc_evacuate_cont_cont:
+	mov %rbp, _gc_backup_cont
+
+	# scavenge everything
+	_uskel_gc_scavenge:
+	# start at what we wrote last
+	mov %rsp, %rbp
+
+	# if the thing is already scavenged, we didn't write anything, mark done.
+	cmp %rbp, %rdi
+	jbe _uskel_gc_scavenge_end
+
+	_uskel_gc_scavenge1:
+	# if all ok, scavenge one thing (moving %rbp) and recheck
+	mov $_uskel_gc_scavenge1_ret, %rsi
+	mov (%rbp), %rax
+	jmp *-020(%rax) # scavenge position in infotable
+	_uskel_gc_scavenge1_ret:
+	cmp %rbp, %rdi
+	ja _uskel_gc_scavenge1
+
+	# everything above rsp is now scavenged, continue with next round
+	mov %rsp, %rdi
+	jmp _uskel_gc_scavenge
+
+	_uskel_gc_scavenge_end:
+
+	# deallocate the old memory region
+	mov $11, %rax # munmap
+	mov _gc_region_end, %rsi
+	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
+	mulq _gc_shrink_ratio
+	shr $8, %rax
+	add _write_region_start, %rax
+	mov %rax, _gc_trigger
 
 	# save how much data we actually had at this point
-	mov _write_region_end, _gc_last_size
-	sub %rsp, _gc_last_size
+	mov _write_region_end, %rax
+	sub %rsp, %rax
+	mov %rax, _gc_last_size
+
+	# restore what we were doing
+	mov _gc_backup_thunk, %rbp
+	mov _gc_backup_cont, %rsi
+	enter_rbp # for simplicity just restart the thunk
 
-	enter_rbp # restart the thunk for simplicity
+_gc_evacuate:
+	# check if we are really out of the target region
+	cmp _write_region_start, %rbp
+	jb _gc_evacuate_ok
+	cmp _write_region_end, %rbp
+	jae _gc_evacuate_ok
+	# if not, let's just jump to cont and leave %rbp as result
+	jmp *%rsi
+	_gc_evacuate_ok:
+	# if we should evacuate, jump to the evac routine
+	mov (%rbp), %rax
+	jmp *-030(%rax)
 
 .endif #_gc_s_file
diff --git a/include/io.s b/include/io.s
index 205f144..0431dd0 100644
--- a/include/io.s
+++ b/include/io.s
@@ -4,6 +4,7 @@ _io_s_file:
 
 # | int | -> cont
 .thunkcode print
+	needs_alloc $040
 	thunkto %rsi, $print_fini, $2, %rbp, %rsi
 	enter 020(%rbp)
 
diff --git a/include/listops.s b/include/listops.s
index 447c125..0ee39ad 100644
--- a/include/listops.s
+++ b/include/listops.s
@@ -6,6 +6,8 @@ _listops_s_file:
 
 # | n | list | -> cont
 .primop2 list_int_index
+	needs_alloc $060
+
 	mov 010(%rsi), %rdx # the list constructor id, must be 1
 	cmp $1, %rdx
 	jne list_int_index_not_found
diff --git a/include/primops.s b/include/primops.s
index f532144..117bcca 100644
--- a/include/primops.s
+++ b/include/primops.s
@@ -9,6 +9,7 @@ _primops_s_file:
 .macro .primop1 name
 # | arg1 | -> cont
 .thunkcode \name
+	needs_alloc $040
 	# push a thunk for collecting the first arg and set it as continuation
 	thunkto %rsi, $\name\()_fini, $2, %rbp, %rsi
 	enter 020(%rbp) # evaluate arg1
@@ -39,6 +40,7 @@ _primops_s_file:
 .macro .primop2 name
 # | arg1 | arg2 | -> cont
 .thunkcode \name
+	needs_alloc $050
 	# push a thunk for collecting the first arg and set it as continuation
 	thunkto %rsi, $\name\()_step1, $3, 030(%rbp), %rbp, %rsi
 	enter 020(%rbp) # evaluate arg1
diff --git a/include/uskel.s b/include/uskel.s
index bca33c9..f59a1f7 100644
--- a/include/uskel.s
+++ b/include/uskel.s
@@ -8,47 +8,16 @@ _start:
 
 .include "include/macros.s"
 
-# this has globals
 .section .bss
 _unix_rsp:
 	# back-up of program entry rsp (aka the actual stack given by the
 	# actual OS; we might like to use it at some point, maybe)
 	cell 0
-_write_region_start:
-	# begin of the active memory area
-	cell 0
-_write_region_end:
-	# end of the active memory area (%rsp kinda starts here and goes down
-	# towars the start)
-	cell 0
-_gc_last_size:
-	# how much data we evacuated last time
-	cell 0
-_gc_min_alloc:
-	# minimum possible allocation
-	cell 0x100000 # tunable constant
-_gc_min_expect_ratio:
-	# 256th's of the minimal amount of memory increment compared to the
-	# last time. New minimal amount is compared as:
-	# (ratio * last size) >> 8
-	cell 0x200 # tunable constant
-_gc_region_start:
-	# in GC, this region is being evacuated and will eventually disappear
-	cell 0
-_gc_region_end:
-	# end of the disappear region
-	cell 0
-_gc_backup_thunk:
-	# backup of %rsi so that we can use the register for other nonsense
-	cell 0
-_gc_backup_cont:
-	# backup of %rbp for same reason
-	cell 0
-
-.section .text
 
 .include "include/gc.s"
 
+.section .text
+
 _uskel_start:
 	# we use the stack pointer for easy writing to the heap;
 	# back it up to memory state just if we ever needed it again.
@@ -56,7 +25,7 @@ _uskel_start:
 
 	# allocate the initial chunk of memory
 	mov $_uskel_start_main, %rsi
-	jmp _uskel_alloc
+	jmp _uskel_gc_init
 
 	_uskel_start_main:
 	# push a thunk for main
diff --git a/print_123.s b/print_123.s
index b87309b..35c9cbe 100644
--- a/print_123.s
+++ b/print_123.s
@@ -7,6 +7,7 @@
 
 # || -> cont
 .thunkcode main
+	needs_alloc $0160
 	# push a new integer
 	thunkto %r11, $INT_code, $100
 
-- 
cgit v1.2.3


From 970ffb4684dbd88bd54e909820bbc5a66a87b18d Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Wed, 1 Nov 2023 18:25:06 +0100
Subject: all looks ok

---
 include/data.s   | 60 ++++++++++++++++++++++++++++++++++++++++++++++++--
 include/gc.s     |  6 ++---
 include/intops.s |  6 ++---
 include/io.s     |  3 ++-
 include/uskel.s  |  4 ++--
 sumac.s          | 40 +++++++++++++++++++++++++++++++++
 zipfib.s         | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 175 insertions(+), 11 deletions(-)
 create mode 100644 sumac.s
 create mode 100644 zipfib.s

(limited to 'include/uskel.s')

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)
 	#
diff --git a/sumac.s b/sumac.s
new file mode 100644
index 0000000..d53382c
--- /dev/null
+++ b/sumac.s
@@ -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
-- 
cgit v1.2.3