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 ;;; Copy line to PAD
 152 ;;; READ-STREAM-LINE ( stream -- n )
 153
 154         WORD p_read_stream_line,'READ-STREAM-LINE'
 155         ;; ( stream -- n )
 156         ;; Read stream until next newline
 157         dq p_gtR, p_pad
 158 p_read_stream_line_loop:
 159         dq p_Rget, p_read_stream_char
 160         dq p_dup, p_0less
 161         BRANCH 1,p_read_stream_line_done
 162         dq p_dup, p_nl, p_equal
 163         BRANCH 1,p_read_stream_line_done
 164         dq p_over, p_Cput, p_literal,1, p_plus
 165         BRANCH ,p_read_stream_line_loop
 166 p_read_stream_line_done:
 167         dq p_drop, p_literal,0, p_over, p_Cput
 168         dq p_pad, p_minus, p_Rgt, p_drop, p_return
 169
 170
 171 ;;; ========================================
 172 ;;; Stream reading
 173 ;;; READ-STREAM-CHAR ( stream -- ch )
 174
 175         WORD p_read_stream_char,'READ-STREAM-CHAR',fasm
 176         ;; ( stream -- ch )
 177         pushr rsi
 178         mov rax,qword [rsp]
 179         mov rbx,qword [rax+16]  ; fill
 180
 181 p_read_stream_char.READ:
 182         mov rcx,qword [rax+24]  ; current
 183         cmp rbx,rcx
 184         jg p_read_stream_char.CHAR
 185
 186         ;; pull in more from the source, if any
 187         cmp qword [rax+8],-1    ; fd == -1 for "no source"
 188         je p_read_stream_char.EOF
 189
 190         push qword [rax+8]      ; fd
 191         lea rbx,[rax+32]
 192         push rbx                ; buffer
 193         push qword [rax]        ; size
 194         mov qword[rax+16],0
 195         mov qword[rax+24],0
 196         DOFORTH sys_read
 197         pop rbx
 198         mov rax,qword [rsp]
 199         cmp rbx,0
 200         jle p_read_stream_char.EOF
 201         mov qword[rax+16],rbx
 202         jmp p_read_stream_char.READ
 203
 204 p_read_stream_char.EOF:
 205         mov qword [rsp],-1
 206         popr rsi
 207         next
 208
 209 p_read_stream_char.CHAR:
 210         inc qword [rax+24]
 211         add rcx,32
 212         mov qword [rsp],0
 213         mov bl,[rax+rcx]
 214         mov byte [rsp],bl
 215         popr rsi
 216         next
 217
 218 ;;; ========================================
 219 ;;; Input handling
 220
 221         WORD p_pad,'PAD',dovariable
 222         ;; A buffer for holding a word
 223         rb 1024
 224
 225         WORD p_read_word,'READ-WORD',fasm
 226         ;; ( stream -- char* length )
 227         ;; Read next word from the given stream into the PAD
 228         pushr rsi
 229         pop rax
 230         pushr rax ; the stream
 231         push qword p_pad_DFA
 232         push qword 0
 233
 234 p_read_word_skipblanks:
 235         DOFORTH p_Rget, p_read_stream_char
 236         pop rbx
 237         cmp bl,0
 238         jl p_read_word_nomore
 239         cmp bl,' '
 240         jle p_read_word_skipblanks
 241         cmp bl,'#'
 242         je p_read_word_skipline
 243 p_read_word_readword:
 244         ;; ( buffer length )
 245         mov rax,qword [rsp+8]
 246         mov rcx,qword [rsp]
 247         mov [rax+rcx],bl
 248         inc qword [rsp]
 249         DOFORTH p_Rget, p_read_stream_char ; ( -- buffer length char )
 250         pop rbx
 251         cmp bl,0
 252         jl p_read_word_nomore
 253         cmp bl,' '
 254         jg p_read_word_readword
 255
 256 p_read_word_nomore:
 257         xor rbx,rbx
 258         mov rax,qword [rsp+8]
 259         mov rcx,qword [rsp]
 260         mov [rax+rcx],bl ; add NUL ending
 261         inc qword [rsp]
 262         DOFORTH p_str2temp
 263         dec qword [rsp]
 264         popr rax
 265         popr rsi
 266         next
 267
 268 p_read_word_skipline:
 269         DOFORTH p_Rget, p_read_stream_char
 270         pop rbx
 271         cmp bl,0
 272         jl p_read_word_nomore
 273         cmp bl,10 ; newline
 274         je p_read_word_skipblanks
 275         jmp p_read_word_skipline
 276
 277         WORD p_double_quote,'"',fasm ;; " (fool emacs)
 278         ;; ( -- char* n )
 279         ;; Scan to double quote in stream buffer, putting the string
 280         ;; on PAD, plus an extra NUL, then copy that into a new temp
 281         ;; object, but exclude the NUL from the returned count, n.
 282         pushr rsi
 283         push p_pad_DFA
 284         push 0
 285 p_double_quote_loop:
 286         DOFORTH p_input, p_get, p_read_stream_char
 287         pop rax
 288         cmp rax,0
 289         jl p_double_quote_endstream
 290         cmp rax,'"'             ; " (fool emacs)
 291         je  p_double_quote_endquote
 292         lea rdi,[p_pad_DFA]
 293         add rdi,qword [rsp]
 294         stosb
 295         inc qword [rsp]
 296         jmp p_double_quote_loop
 297 p_double_quote_endquote:
 298 p_double_quote_endstream:
 299         lea rdi,[p_pad_DFA]
 300         add rdi,qword [rsp]
 301         mov byte [rdi],0
 302         ;; copy PAD string + NUL into new temp object
 303         inc qword [rsp]
 304         DOFORTH p_str2temp
 305         dec qword [rsp]
 306         popr rsi
 307         next
 308
 309         WORD p_fdtell,'FDTELL',
 310         ;; ( chars* n fd -- )
 311         ;; Write n bytes from chars* to fd
 312         dq p_rot, p_rot, sys_write, p_drop, p_return
 313
 314         WORD p_tell,'TELL'
 315         ;; ( chars* n -- )
 316         ;; Write n bytes from chars* to stdout
 317         dq p_literal,1,p_fdtell, p_return
 318
 319         WORD p_fdemit,'FDEMIT'
 320         ;; ( c fd -- )
 321         ;; Write byte to fd
 322         dq p_literal,1, p_dsp, p_literal,1, sys_write, p_2drop, p_return
 323
 324         WORD p_emit,'EMIT'
 325         ;; ( c -- )
 326         ;; Write byte to stdout
 327         dq p_literal,1, p_fdemit, p_return
 328
 329         WORD p_nl,'NL',dovalue
 330         ;; ( -- c )
 331         ;; Pushes a newline character on the stack
 332         dq 10
 333
 334         WORD p_sp,'SP',dovalue
 335         ;; ( -- c )
 336         ;; Pushes a space character on the stack
 337         dq 32
 338
 339         WORD p_digits,'DIGITS',dovariable
 340         db '0123456789abcdef'
 341
 342         WORD p_dot_temp,'.TEMP',fasm
 343         ;; ( v -- )
 344         ;; Print TOP value as unsigned BASE integer
 345         pushr rsi
 346         mov rdi,p_pad_DFA
 347         pop rax
 348         cmp rax,0
 349         jge p_dot_positive
 350         cmp qword [p_base_DFA],10
 351         jne p_dot_positive
 352         mov byte[rdi],'-'
 353         inc rdi
 354         neg rax
 355 p_dot_positive:
 356         call p_dot_pad_subr
 357         xor rax,rax
 358         stosb
 359         push p_pad_DFA
 360         sub rdi,p_pad_DFA
 361         push rdi
 362         DOFORTH p_str2temp
 363         dec qword [rsp] ; don't count the ending NUL
 364         popr rsi
 365         next
 366
 367 p_dot_pad_subr: ;
 368         xor rdx,rdx
 369         div qword [p_base_DFA]  ; rdx:rax / BASE => q=rax, r=rdx
 370         cmp rax,0
 371         je p_dot_remainder
 372         push rdx
 373         call p_dot_pad_subr
 374         pop rdx
 375 p_dot_remainder:
 376         xor rax,rax
 377         mov al,[p_digits_DFA+rdx]
 378         stosb
 379         ret
 380
 381         WORD p_dot,'.'
 382         ;; ( v -- )
 383         ;; Print value to stdout
 384         dq p_dot_temp, p_literal,1, p_fdtell, p_return