From 116c6734e69436cd29f06d74c29b896b99ce5425 Mon Sep 17 00:00:00 2001
From: FeralChild64 <you@example.com>
Date: Thu, 2 Jul 2020 22:02:39 +0200
Subject: [PATCH] string allocation routine complete, dealloc and garbage
 collection still to do

---
 src/basic/engine/varstr_alloc.s        | 70 ++++++++++++++------------
 src/basic/engine/varstr_alloc_fretop.s | 31 ++++++++++++
 2 files changed, 68 insertions(+), 33 deletions(-)
 create mode 100644 src/basic/engine/varstr_alloc_fretop.s

diff --git a/src/basic/engine/varstr_alloc.s b/src/basic/engine/varstr_alloc.s
index b44efd1e..35880328 100644
--- a/src/basic/engine/varstr_alloc.s
+++ b/src/basic/engine/varstr_alloc.s
@@ -18,6 +18,8 @@
 // - DSCPNT+0, DSCPNT+1 - pointer to string descriptor, first pointed byte should contain desired length
 //
 
+// XXX test this routine
+
 varstr_alloc:
 
 	// Mark garbage collector as not run yet
@@ -44,21 +46,45 @@ varstr_alloc_retry:
 	lda #$02
 	jsr varstr_FRETOP_down 
 
-#else // HAS_OPCODES_65CE02
+#else // HAS_OPCODES_65CE02 - this time code is slightly longer, but faster
 
 	dew FRETOP
 	dew FRETOP
 
+	jsr varstr_FRETOP_check
+
 #endif
 
-	jsr varstr_FRETOP_check
 	bcs varstr_alloc_fail
 
-	// XXX finish this
+	// Create the back-pointer to the string descriptor
 
+	ldy #$00
+	lda DSCPNT+0
+	sta (FRETOP), y
+	iny
+	lda DSCPNT+1
+	sta (FRETOP), y
 
+	// Now lower FRETOP again to make space for the string content
 
+	dey                                          // $01 -> $00
+	lda (DSCPNT), y
+	jsr varstr_FRETOP_down
+	bcs varstr_alloc_fail
 
+	// Success - fill in the string descriptor
+
+	iny                                          // $00 -> $01
+	lda FRETOP+0
+	sta (DSCPNT), y
+	iny
+	lda FRETOP+1
+	sta (DSCPNT), y
+
+	// The end
+
+	rts
 
 varstr_alloc_fail:
 
@@ -72,35 +98,13 @@ varstr_alloc_fail:
 	// Check if it is worth to perform garbage collection and retry
 
 	bit GARBFL
+	bpl_16 do_OUT_OF_MEMORY_error
 
-	// XXX finish this
+	dec GARBFL                                   // $00 -> $FF
+	jsr varstr_garbage_collect
 
-
-
-
-// XXX move these helper routines to a better place
-
-
-varstr_FRETOP_down: // memmove__tmp - length to lower FRETOP
-
-	sec
-	lda FRETOP+0
-	sbc memmove__tmp
-	sta FRETOP+0
-	bcs !+
-	dec FRETOP+1
-!:
-	rts
-
-varstr_FRETOP_check:
-
-	// Check if FRETOP > STREND, Carry set if not
-
-	lda STREND+1
-	cmp FRETOP+1
-	beq !+
-	rts
-!:
-	lda STREND+0
-	cmp FRETOP+0
-	rts
+#if HAS_OPCODES_65C02
+	bra varstr_alloc_retry
+#else
+	jmp varstr_alloc_retry
+#endif
diff --git a/src/basic/engine/varstr_alloc_fretop.s b/src/basic/engine/varstr_alloc_fretop.s
new file mode 100644
index 00000000..09f033bc
--- /dev/null
+++ b/src/basic/engine/varstr_alloc_fretop.s
@@ -0,0 +1,31 @@
+// #LAYOUT# STD *       #TAKE
+// #LAYOUT# *   BASIC_0 #TAKE
+// #LAYOUT# *   *       #IGNORE
+
+//
+// Helper routines for 'varstr_alloc'
+//
+
+varstr_FRETOP_down:                    // .A - bytes to lower FRETOP, uses memmove__tmp
+
+	sta memmove__tmp
+
+	sec
+	lda FRETOP+0
+	sbc memmove__tmp
+	sta FRETOP+0
+	bcs !+
+	dec FRETOP+1
+!:
+	// FALLTROUGH
+
+varstr_FRETOP_check:                   // check if FRETOP > STREND, Carry set if not
+
+	lda STREND+1
+	cmp FRETOP+1
+	beq !+
+	rts
+!:
+	lda STREND+0
+	cmp FRETOP+0
+	rts