temp.asm

   1 ;;; Managing a memory area for temporary objects
   2 ;;;
   3 ;;; A temporary object space is allocated from the current usage
   4 ;;; level, or cycling back to be from the lowest space address when
   5 ;;; the requested size exceeds the space edge.
   6 ;;;
   7
   8         WORD p_objectspace,'TEMPSPACE',dovariable
   9         ;; Holds size and address of the object space.
  10         dq 104857600 ; [0] Total object space size (request size)
  11         dq 0 ; [8] Object space base address
  12         dq 0 ; [16] Currently used.
  13
  14         WORD p_temp,'TEMP',fasm
  15         ;; ( size -- addr )
  16         ;; Allocate an object of given size
  17         pushr rsi
  18         cmp qword [p_objectspace_DFA+8],0
  19         jg p_objecthole_initialized
  20         ;; initialize object space
  21         push qword [p_objectspace_DFA]
  22         DOFORTH p_malloc
  23         pop qword [p_objectspace_DFA+8]
  24 p_objecthole_initialized:
  25         mov rax,qword [rsp]
  26         add rax,qword [p_objectspace_DFA+16]
  27         cmp rax,qword [p_objectspace_DFA]
  28         jl p_objecthole_from_tail
  29         mov qword [p_objectspace_DFA+16],0
  30         mov rax,qword [rsp]
  31 p_objecthole_from_tail:
  32         mov rbx,qword [p_objectspace_DFA+16]
  33         mov qword [p_objectspace_DFA+16],rax
  34         add rbx,qword [p_objectspace_DFA+8]
  35         mov qword [rsp],rbx
  36         popr rsi
  37         next
  38
  39         WORD p_str2temp,'STR>TEMP'
  40         ;; ( char* n -- char* n )
  41         ;; Capture a given [n:char*] string as a new temp object with
  42         ;; leading size cell.
  43         dq p_dup, p_gtR                 ; ( -- char* n ) [ n ]
  44         dq p_dup, p_literal, 8, p_plus  ; ( -- char* n n+8 )
  45         dq p_temp                       ; ( -- char* n  addr )
  46         dq p_2dup, p_put
  47         dq p_literal, 8, p_plus         ; ( -- char* n  addr+8 ) [ n ]
  48         dq p_dup, p_gtR                 ; ( -- char* n  addr+8 ) [ n addr+8 ]
  49         dq p_swap, p_strncpy            ; ( -- ) [ n addr+8 ]
  50         dq p_Rgt, p_Rgt                 ; ( -- addr+8 n ) [ ]
  51         dq p_return