stdio.asm

   1 ;;; ========================================
   2 ;;; Dynamic memory management. Allocated with MALLOC and released with
   3 ;;; MUNMAP (see below)
   4
   5         WORD p_malloc,'MALLOC',fasm
   6         ;; ( size -- addr )
   7         ;; Allocates memory (using mmap)
   8         pushr rsi               ; pretend it's a FORTH word since it
   9                                 ; ends via sys_mmap_asm
  10         pop rax
  11         push qword 0            ; address of mapping (suggestion)
  12         push rax                ; length of mapping
  13         push qword 3            ; protection mode PROT_READ | PROT_WRITE
  14         push qword 34           ; flags PRIVATE | ANONYMOUS
  15         push qword -1           ; fd -1
  16         push qword 0            ; offset
  17         jmp sys_mmap_asm        ; exit via sys_mmap
  18
  19         WORD p_realloc,'REALLOC',fasm
  20         ;; ( addr old new -- )
  21         ;; Try remapping a given MMAP region of old size to a new size
  22         ;; mremap(void *old_address, size_t old_size,
  23         ;;        size_t new_size, int flags, ... /* void *new_address */);
  24         pushr rsi
  25         push 1                  ; MREMAP_MAYMOVE
  26         jmp sys_mmap_asm        ; exit via sys_mmap
  27
  28 ;;; ========================================
  29 ;;; Input stream handling.
  30 ;;;
  31 ;;; An input stream for a file descriptor has a stream buffer that is
  32 ;;; gradually filled on needs basis. The stream buffer includes a
  33 ;;; header portion with:
  34 ;;; * size of buffer (excluding the 32 byte head)
  35 ;;; * source file descriptor (or -1 for pure in-core data)
  36 ;;; * current fill
  37 ;;; * current read position
  38 ;;;
  39 ;;; An input stream for a memory block as a "detached" stream head
  40 ;;; with:
  41 ;;; * block address
  42 ;;; * -1
  43 ;;; * size of block
  44 ;;; * current read position
  45
  46         WORD p_stream,'STREAM',fasm
  47         ;; ( fd size -- addr ) or ( block -1 -- addr )
  48         ;; Allocates a stream buffer of the given size and initializes
  49         ;; it to be filled from the given input file descriptor.
  50         pushr rsi
  51         mov rax,[rsp]
  52         cmp rax,-1
  53         je p_stream_MEM
  54         push rax
  55         DOFORTH p_malloc        ; ( fd size addr )
  56         push qword [rsp]
  57         push qword [rsp+16]     ; ( fd size addr addr size )
  58         DOFORTH p_erase         ; ( fd size addr )
  59         pop rax                 ; addr ( fd size )
  60         pop rbx                 ; size ( fd )
  61         sub rbx,32              ; reduce by header size
  62         mov [rax],rbx
  63         pop rbx
  64         mov [rax+8],rbx
  65         push rax
  66         jmp exit
  67
  68 p_stream_MEM:
  69         push 32                 ; size of detached header (wastefull?)
  70         DOFORTH p_malloc        ; ( block addr )
  71         pop rax                 ; header address
  72         pop rbx                 ; block address
  73         mov rcx,[rbx]           ; block content size (excludes size field)
  74         add rbx,8               ; block content address
  75         mov qword [rax],rbx     ; save block content address
  76         mov qword [rax+8],-1    ; -1 = memblock flag
  77         mov qword [rax+16],rcx  ; save block content size
  78         mov qword [rax+24],0    ; current position
  79         push rax
  80         jmp exit
  81
  82         WORD p_unstream,'UNSTREAM',fasm
  83         ;; ( stream -- )
  84         ;; Release mmap-ed memory
  85         pushr rsi
  86         mov rax,qword [rsp]
  87         mov rbx,qword [rax+8]
  88         cmp rbx,0
  89         jl p_unstream_incore
  90         ;; unstream fd stream
  91         push rbx
  92         DOFORTH sys_close
  93         pop rax
  94         mov rax,qword [rsp]
  95         push qword [rax+16]
  96         add qword [rax+16],32
  97         DOFORTH sys_munmap
  98         pop rax
  99         popr rsi
 100         next
 101 p_unstream_incore:
 102         mov rbx,qword [rax+16]
 103         mov rax,qword [rax]
 104         mov qword [rsp],rax
 105         push rbx
 106         DOFORTH sys_munmap
 107         pop rax
 108         popr rsi
 109         next
 110
 111         WORD p_clear_stream,'CLEAR-STREAM',fasm
 112         ;; ( stream -- )
 113         ;; "Clear" the stream by moving its "current position" to the
 114         ;; "fill position".
 115         pop rax
 116         mov rbx,qword [rax+16]  ; copy fill
 117         mov qword [rax+24],rbx  ; into current
 118         next
 119
 120         WORD p_stream_nchars,'STREAM-NCHARS',fasm
 121         ;; ( stream -- n )
 122         ;; Scan over whitespace in the stream buffer (without actually
 123         ;; consuming) and tell how much then remains.
 124         pushr rsi
 125         mov rcx,qword [rsp]
 126         mov rbx,qword [rcx+16] ; fill
 127         sub rbx,qword [rcx+24] ; current
 128         cmp qword [rcx+8],-1
 129         je p_stream_nchars_memblock
 130         mov rsi,rcx
 131         add rsi,32
 132         jmp p_stream_nchars_skipblanks
 133 p_stream_nchars_memblock:
 134         mov rsi,qword [rcx]
 135 p_stream_nchars_skipblanks:
 136         add rsi,qword [rcx+24] ;
 137         cmp rbx,0
 138         je p_stream_nchars_done
 139 p_stream_nchars_loop:
 140         lodsb
 141         cmp al,32
 142         jg p_stream_nchars_done
 143         dec rbx
 144         jg p_stream_nchars_loop
 145 p_stream_nchars_done:
 146         mov qword [rsp],rbx
 147         popr rsi
 148         next
 149
 150 ;;; ========================================
 151 ;;; Stream reading
 152 ;;; READ-STREAM-CHAR ( stream -- ch )
 153
 154         WORD p_read_stream_char,'READ-STREAM-CHAR',fasm
 155         ;; ( stream -- ch )
 156         pushr rsi
 157         mov rax,qword [rsp]
 158         mov rbx,qword [rax+16]  ; fill
 159
 160 p_read_stream_char.READ:
 161         mov rcx,qword [rax+24]  ; current
 162         cmp rbx,rcx
 163         jg p_read_stream_char.CHAR
 164
 165         ;; pull in more from the source, if any
 166         cmp qword [rax+8],-1    ; fd == -1 for "no source"
 167         je p_read_stream_char.EOF
 168
 169         push qword [rax+8]      ; fd
 170         lea rbx,[rax+32]
 171         push rbx                ; buffer
 172         push qword [rax]        ; size
 173         mov qword[rax+16],0
 174         mov qword[rax+24],0
 175         DOFORTH sys_read
 176         pop rbx
 177         mov rax,qword [rsp]
 178         cmp rbx,0
 179         jle p_read_stream_char.EOF
 180         mov qword[rax+16],rbx
 181         jmp p_read_stream_char.READ
 182
 183 p_read_stream_char.EOF:
 184         mov qword [rsp],-1
 185         popr rsi
 186         next
 187
 188 p_read_stream_char.CHAR:
 189         inc qword [rax+24]
 190         add rcx,32
 191         mov qword [rsp],0
 192         mov bl,[rax+rcx]
 193         mov byte [rsp],bl
 194         popr rsi
 195         next
 196
 197 ;;; ========================================
 198 ;;; Input handling
 199
 200         WORD p_pad,'PAD',dovariable
 201         ;; A buffer for holding a word
 202         rb 1024
 203
 204         WORD p_read_word,'READ-WORD',fasm
 205         ;; ( stream -- char* length )
 206         ;; Read next word from the given stream into the PAD
 207         pushr rsi
 208         pop rax
 209         push qword p_pad_DFA
 210         push qword 0
 211         push rax
 212
 213 p_read_word_skipblanks:
 214         DOFORTH p_dup, p_read_stream_char
 215         pop rbx
 216         cmp bl,0
 217         jl p_read_word_nomore
 218         cmp bl,' '
 219         jle p_read_word_skipblanks
 220         cmp bl,'#'
 221         je p_read_word_skipline
 222 p_read_word_readword:
 223         ;; ( buffer length stream )
 224         mov rax,qword [rsp+16]
 225         mov rcx,qword [rsp+8]
 226         mov [rax+rcx],bl
 227         inc qword [rsp+8]
 228         DOFORTH p_dup, p_read_stream_char
 229         pop rbx
 230         cmp bl,0
 231         jl p_read_word_nomore
 232         cmp bl,' '
 233         jg p_read_word_readword
 234
 235 p_read_word_nomore:
 236         pop rax
 237         popr rsi
 238         next
 239
 240 p_read_word_skipline:
 241         DOFORTH p_dup, p_read_stream_char
 242         pop rbx
 243         cmp bl,0
 244         jl p_read_word_nomore
 245         cmp bl,10 ; newline
 246         je p_read_word_skipblanks
 247         jmp p_read_word_skipline
 248
 249         WORD p_double_quote,'"',fasm ;; " (fool emacs)
 250         ;; ( -- char* n )
 251         ;; Scan to double quote in stream buffer, putting the string
 252         ;; on PAD, plus an extra NUL, then copy that into a new temp
 253         ;; object, but exclude the NUL from the returned count, n.
 254         pushr rsi
 255         push p_pad_DFA
 256         push 0
 257 p_double_quote_loop:
 258         DOFORTH p_input, p_get, p_read_stream_char
 259         pop rax
 260         cmp rax,0
 261         jl p_double_quote_endstream
 262         cmp rax,'"'             ; " (fool emacs)
 263         je  p_double_quote_endquote
 264         lea rdi,[p_pad_DFA]
 265         add rdi,qword [rsp]
 266         stosb
 267         inc qword [rsp]
 268         jmp p_double_quote_loop
 269 p_double_quote_endquote:
 270 p_double_quote_endstream:
 271         lea rdi,[p_pad_DFA]
 272         add rdi,qword [rsp]
 273         mov byte [rdi],0
 274         ;; copy PAD string into new temp object
 275         inc qword [rsp]
 276         DOFORTH p_str2temp
 277         dec qword [rsp]
 278         add qword [rsp+8],8     ; adjust pointer
 279         popr rsi
 280         next
 281
 282         WORD p_fdtell,'FDTELL',
 283         ;; ( chars* n fd -- )
 284         ;; Write n bytes from chars* to fd
 285         dq p_rot, p_rot, sys_write, p_drop, p_exit
 286
 287         WORD p_tell,'TELL'
 288         ;; ( chars* n -- )
 289         ;; Write n bytes from chars* to stdout
 290         dq p_literal,1,p_fdtell, p_exit
 291
 292         WORD p_fdemit,'FDEMIT'
 293         ;; ( c fd -- )
 294         ;; Write byte to fd
 295         dq p_literal,1, p_dsp, p_literal,1, sys_write, p_2drop, p_exit
 296
 297         WORD p_emit,'EMIT'
 298         ;; ( c -- )
 299         ;; Write byte to stdout
 300         dq p_literal,1, p_fdemit, p_exit
 301
 302         WORD p_nl,'NL',dovalue
 303         ;; ( -- c )
 304         ;; Pushes a newline character on the stack
 305         dq 10
 306
 307         WORD p_sp,'SP',dovalue
 308         ;; ( -- c )
 309         ;; Pushes a space character on the stack
 310         dq 32
 311
 312         WORD p_digits,'DIGITS',dovariable
 313         db '0123456789abcdef'
 314
 315         WORD p_dot_temp,'.TEMP',fasm
 316         ;; ( v -- )
 317         ;; Print TOP value as unsigned BASE integer
 318         pushr rsi
 319         mov rdi,p_pad_DFA
 320         pop rax
 321         cmp rax,0
 322         jge p_dot_positive
 323         cmp qword [p_base_DFA],10
 324         jne p_dot_positive
 325         mov byte[rdi],'-'
 326         inc rdi
 327         neg rax
 328 p_dot_positive:
 329         call p_dot_pad_subr
 330         xor rax,rax
 331         stosb
 332         push p_pad_DFA
 333         sub rdi,p_pad_DFA
 334         push rdi
 335         DOFORTH p_str2temp
 336         dec qword [rsp] ; don't count the ending NUL
 337         popr rsi
 338         next
 339
 340 p_dot_pad_subr: ;
 341         xor rdx,rdx
 342         div qword [p_base_DFA]  ; rdx:rax / BASE => q=rax, r=rdx
 343         cmp rax,0
 344         je p_dot_remainder
 345         push rdx
 346         call p_dot_pad_subr
 347         pop rdx
 348 p_dot_remainder:
 349         xor rax,rax
 350         mov al,[p_digits_DFA+rdx]
 351         stosb
 352         ret
 353
 354         WORD p_dot,'.'
 355         ;; ( v -- )
 356         ;; Print value to stdout
 357         dq p_dot_temp, p_literal,1, p_fdtell, p_exit