compile.asm

   1 ;;; Words for adding words
   2
   3         WORD p_here,'HERE',dovariable
   4         ;; The heap
   5         dq heap_start
   6
   7         WORD p_create,'CREATE',fasm
   8         ;; CREATE ( chars* n -- tfa )
   9         ;; Add the pstring as a new word in the current wordlist.
  10         pushr rsi
  11         mov rax,qword [p_wordlist_DFA] ; Current word list
  12         mov rax,[rax]           ; last word of current wordlist
  13         mov rbx,qword [p_here_DFA]
  14         mov [rbx],rax           ; TFA of new word
  15         mov qword [rbx+16],0    ; flags field
  16         ;; copy pname
  17         pop rcx                 ; n
  18         mov qword [rbx+24],rcx  ; PFA (length)
  19         pop rsi                 ; chars* (source)
  20         lea rdi,[rbx+32]        ; (dest)
  21         ;; clear DF
  22 p_create_COPY:
  23         movsb
  24         dec rcx
  25         jge p_create_COPY
  26         mov byte [rdi],0        ; extra NUL
  27         inc rdi
  28         mov qword [rdi],rbx     ; pTFA
  29         add rdi,8
  30         mov qword [rdi],rbx     ; OFF
  31         add rdi,8
  32         mov qword [rbx+8],rdi   ; pCFA
  33         add rdi,8
  34         mov qword [rdi],dovalue ;CFA
  35         add rdi,8
  36         mov qword [rax],rbx     ; Install new word
  37         mov qword [p_here_DFA],rdi ; allocate the space
  38         push rbx
  39         popr rsi
  40         next
  41
  42         WORD p_allot,'ALLOT',fasm
  43         ;; ( n -- )
  44         ;; Allocate n bytes on the heap
  45         pop rax
  46         add rax,qword [p_here_DFA]
  47         mov qword [p_here_DFA],rax
  48         next
  49
  50         WORD p_comma,',',fasm
  51         ;; ( v -- )
  52         ;; Put cell value onto the heap and advance "HERE"
  53         mov rax,qword [p_here_DFA]
  54         pop rbx
  55         mov qword [rax],rbx
  56         add rax,8
  57         mov qword [p_here_DFA],rax
  58         next
  59
  60         WORD p_Ccomma,'C,',fasm
  61         ;; ( c -- )
  62         ;; Put byte value onto the heap and advance "HERE"
  63         mov rax,qword [p_here_DFA]
  64         pop rbx
  65         mov byte [rax],bl
  66         inc rax
  67         mov qword [p_here_DFA],rax
  68         next
  69
  70         WORD p_does,'DOES>',fasm,IMMEDIATE
  71         ;; ( -- )
  72         ;; Change the "DOES offset" of latest compilation and assign
  73         ;; it the "dodoes" execution semantics,
  74         mov rax,qword [p_wordlist_DFA]
  75         mov rax,[rax]           ; last word of current wordlist
  76         tfa2does rax            ; *rax is the DOES offset field
  77         ;; offset = qword [p_here_DFA]) - (rax+2*8)
  78         mov rbx,qword [p_here_DFA]
  79         sub rbx,rax
  80         sub rbx,16
  81         mov qword [rax],rbx
  82         mov qword [rax+8],dodoes
  83         next
  84
  85         WORD p_literal,'LIT',fasm
  86         ;; ( -- v )
  87         ;; Push the value of successor cell onto stack, and skip it
  88         push qword [rsi]
  89         add rsi,8
  90         next
  91
  92         WORD p_literal_string,'S"',fasm
  93                                       ;; " (fool emacs)
  94         ;; ( -- chars* n )
  95         ;; Push the value of successor cell onto stack, and skip it
  96         mov rax,qword [rsi]
  97         add rsi,8
  98         push rsi
  99         push rax
 100         add rsi,rax
 101         next
 102
 103 ;;; ========================================
 104 ;;; The text interpreter
 105
 106         WORD p_state,'STATE',dovariable
 107         ;; Interpretation state (0=interpreting, 1=compiling)
 108         dq 0
 109
 110         WORD p_left_bracket,'[',fasm,IMMEDIATE
 111         ;; ( -- )
 112         ;; Change state to interpretation state.
 113         mov qword[p_state_DFA],0
 114         next
 115
 116         WORD p_right_bracket,']',fasm
 117         ;; ( -- )
 118         ;; Change state to compilation state.
 119         mov qword[p_state_DFA],1
 120         next
 121
 122         WORD p_number,'NUMBER'
 123         ;; ( chars* n -- [ 0 ]/[ v 1 ] )
 124
 125         WORD p_this_word,'THIS-WORD',dovariable
 126         dq 0,0                  ; ( n chars* )
 127
 128         WORD p_evaluate_stream,'EVALUATE-STREAM'
 129         ;; ( stream -- *?* flag )
 130         ;; Execute the words from the given stream
 131         ;; returns 1 if stream ends and 0 if an unknown word is found
 132
 133 p_evaluate_stream_LOOP:
 134         dq p_read_word          ; ( -- chars* n )
 135         dq p_zero_branch
 136         dq   p_evaluate_stream_END - $ - 8
 137
 138         dq p_2dup
 139         dq p_this_word
 140         dq p_2put
 141         dq p_find
 142         dq p_dup
 143         dq p_zero_branch
 144         dq   p_evaluate_stream_NOTWORD - $ - 8
 145         dq p_execute
 146         dq p_branch
 147         dq   p_evaluate_stream_LOOP - $ - 8
 148
 149 p_evaluate_stream_NOTWORD:
 150         dq p_this_word
 151         dq p_2get
 152         dq p_number
 153         dq p_not
 154         dq p_zero_branch
 155         dq   p_evaluate_stream_LOOP - $ - 8
 156
 157         dq 0
 158         dq p_exit
 159
 160 p_evaluate_stream_END:
 161         dq 1
 162         dq p_exit