diff options
Diffstat (limited to 'vor.S')
| -rw-r--r-- | vor.S | 433 |
1 files changed, 433 insertions, 0 deletions
diff --git a/vor.S b/vor.S new file mode 100644 index 0000000..7525cf1 --- /dev/null +++ b/vor.S @@ -0,0 +1,433 @@ + .arch armv6m + .syntax unified + .text + .global _start + .thumb_func +_start: + /* Preserve call stack pointer. */ + ldr r1, =sp_initial_value + mov r0, sp + str r0, [r1] + /* Perform memory allocations. */ + ldr r0, =input_buffer_size + ldr r1, [r0] + movs r0, #0 /* NULL */ + movs r2, #3 /* R|W */ + movs r3, #0x22 /* private (0x2) anonymous (0x20) mapping */ + movs r4, #1 + negs r4, r4 /* fd = -1 */ + movs r5, #0 /* offset = 0 */ + movs r7, #0xC0 /* sys_mmap2 */ + svc #0 + bl check_error + /* Assign input buffer. */ + ldr r1, =input_buffer + ldr r2, =input_buffer_ptr + str r0, [r1] + str r0, [r2] + /* Allocate data stack. */ + ldr r0, =data_stack_size + ldr r1, [r0] + movs r0, #0 + movs r2, #3 + svc #0 + bl check_error + ldr r2, =data_stack_start + str r0, [r2] + /* Data stack grows downwards to take advantage of ldm/sdm instructions. */ + add r0, r0, r1 + ldr r2, =data_stack_ptr + str r0, [r2] + /* Allocate expanse. */ + ldr r0, =expanse_size + ldr r1, [r0] + movs r0, #0 + movs r2, #7 /* R|W|X */ + svc #0 + bl check_error + ldr r1, =expanse_start + ldr r2, =expanse_ptr + str r0, [r1] + str r0, [r2] + /* Setup. */ + ldr r1, =data_stack_ptr + ldr r0, [r1] + bl vor_start + /* Exit with success. */ + movs r0, #0 +_exit: + movs r7, #1 + svc #0 + .size _start, . - _start + + .macro .fnsize name + .size \name , . - \name + .endm + + .thumb_func +check_error: + push {r0-r2, lr} + movs r1, #0 + mvns r1, r1 + movs r2, #12 + lsls r1, r2 + cmp r0, r1 + bhi .L_got_error + pop {r0-r2, pc} +.L_got_error: + negs r0, r0 + b _exit + .fnsize check_error + + .thumb_func +fill_input_buffer: + /* Read from the standard input to fill the input buffer. */ + ldr r1, =input_buffer + ldr r2, =input_buffer_size + ldr r1, [r1] + ldr r2, [r2] + movs r0, #0 /* stdin */ + movs r7, #3 /* sys_read */ + svc #0 + bl check_error + /* Negative return value from the system call indicates read error. */ + ldr r2, =input_buffer_length + ldr r3, =input_buffer_ptr + ldr r4, =input_buffer_end + str r0, [r2] + str r1, [r3] + add r1, r1, r0 + str r1, [r4] + bx lr +.L_read_error: + movs r0, #2 + b _exit + .fnsize fill_input_buffer + + .thumb_func +read_byte: + /* Read a byte from the input buffer filled from the standard input. -1 is returned when no input is available to read. */ + push {lr} + bl input_available + cmp r0, #0 + beq .L_not_at_end + bx lr +.L_not_at_end: + ldr r2, =input_buffer_ptr + ldr r1, [r2] + ldrb r0, [r1] + adds r1, r1, #1 + str r1, [r2] + pop {pc} + .fnsize read_byte + + .thumb_func +input_available: + /* Returns 0 if there is input left to be read from the input buffer or from the standard input, -1 otherwise. */ + ldr r0, =input_buffer_ptr + ldr r1, =input_buffer_end + ldr r0, [r0] + ldr r1, [r1] + cmp r0, r1 + blo .L_available + bl fill_input_buffer + ldr r0, =input_buffer_ptr + ldr r1, =input_buffer_end + ldr r0, [r0] + ldr r1, [r1] + cmp r0, r1 + bhs .L_not_available +.L_available: + movs r0, #0 + bx lr +.L_not_available: + movs r0, #1 + negs r0, r0 /* EOF (-1) */ + bx lr + .fnsize input_available + + .thumb_func +is_space: + cmp r0, #' ' + beq .L_is_space + cmp r0, #'\t' + beq .L_is_space + cmp r0, #'\r' + beq .L_is_space + cmp r0, #'\n' + beq .L_is_space + movs r0, #0 + bx lr +.L_is_space: + movs r0, #1 + bx lr + .fnsize is_space + + .thumb_func +read_word: + /* Returns word length and pointer to word in r0 and r1. Word length is zero when no word is available on input. */ + push {lr} +.L_skip_space: + bl read_byte + movs r4, r0 + adds r3, r0, #1 + beq .L_word_finish + bl is_space + cmp r0, #1 + beq .L_skip_space + ldr r2, =expanse_ptr + ldr r1, [r2] +.L_word_loop: + strb r4, [r1] + adds r1, #1 + mov r8, r1 + bl read_byte + movs r4, r0 + mov r1, r8 + adds r3, r0, #1 + beq .L_word_finish + bl is_space + cmp r0, #1 + bne .L_word_loop +.L_word_finish: + ldr r2, =expanse_ptr + ldr r4, [r2] + subs r0, r1, r4 + cmp r0, #0 + beq .L_no_word + str r1, [r2] + movs r1, r4 +.L_no_word: + pop {pc} + .fnsize read_word + + .data + .balign 4 +sp_initial_value: .4byte 0 + + .set KiB, 1 << 10 + .set MiB, 1 << 20 + +input_buffer: .4byte 0 +input_buffer_size: .4byte 4 * KiB +input_buffer_ptr: .4byte 0 +input_buffer_end: .4byte 0 +input_buffer_length: .4byte 0 + +data_stack_start: .4byte 0 +data_stack_size: .4byte 64 * KiB +data_stack_ptr: .4byte 0 + +expanse_start: .4byte 0 +expanse_size: .4byte 8 * MiB +expanse_ptr: .4byte 0 + +last_created_word: .4byte 0 + + /* + .set vor_last_word, 0 + .macro .defword name str flags=0 + .rodata +vor_word_\name\(): + .4byte vor_last_word + .set vor_last_word, vor_word_\name + .4byte vor_\name + .2byte \flags + .2byte vor_wordstrsize_\name +vor_wordstr_\name\(): + .ascii "\str" + .set vor_wordstrsize_\name\(), . - vor_wordstr_\name + .endm + + The word definition thus have the following structure: + struct vor_word { + struct vor_word *prev; + // Takes and returns the data stack pointer. + cell *(*word_definition)(cell *); + uint16_t flags, name_size; + char name[]; + }; + */ + + .defvar expanse_ptr "exptr" + .defvar data_stack_ptr "dsptr" + .defvar input_buffer "ibuf" + .defvar input_buffer_length "ibuflen" + .defvar input_buffer_ptr "ibufptr" + .defvar input_buffer_end "ibufend" + .defvar last_created_word "latest-word" + + .section .text.vor + .thumb_func +vor_add: + ldm r0!, {r1, r2} + adds r1, r2 + subs r0, #4 + str r1, [r0] + bx lr + + .thumb_func +vor_bit_inv: + ldr r1, [r0] + mvns r1, r1 + str r1, [r0] + bx lr + + .thumb_func +vor_mul: + ldm r0!, {r1, r2} + muls r2, r1, r2 + subs r0, #4 + str r2, [r0] + bx lr + + .thumb_func +vor_lsl: + /* a b -> (a << b) */ + ldm r0!, {r1, r2} + lsls r2, r1 + subs r0, #4 + str r2, [r0] + bx lr + + .thumb_func +vor_bit_or: + ldm r0!, {r1, r2} + orrs r1, r2 + subs r0, #4 + str r1, [r0] + bx lr + + .thumb_func +vor_less_than: + ldm r0!, {r1, r2} + movs r3, #0 + cmp r2, r1 + bge .L_not_less + adds r3, #1 +.L_not_less: + subs r0, #4 + str r3, [r0] + bx lr + + .thumb_func +vor_load_cell: + ldm r0!, {r1} + ldr r2, [r1] + subs r0, #4 + str r2, [r0] + bx lr + + .thumb_func +vor_store_cell: + /* v addr -> { *(cell *)addr <- v } */ + ldm r0!, {r1, r2} + str r2, [r1] + bx lr + + .thumb_func +vor_load_byte: + ldm r0!, {r1} + ldrb r2, [r1] + subs r0, #4 + str r2, [r0] + bx lr + + .thumb_func +vor_store_byte: + /* v addr -> { *(byte *)addr <- v&0xff } */ + ldm r0!, {r1, r2} + strb r2, [r1] + bx lr + + .thumb_func +vor_read_word: + push {lr} + mov r8, r0 + bl read_word + mov r2, r8 + subs r2, #4 + str r1, [r2] + subs r2, #4 + str r0, [r2] + movs r0, r2 + pop {pc} + + .thumb_func +vor_lit: + mov r1, lr + subs r1, #1 /* undo interworking */ + ldr r2, [r1] + subs r0, #4 + str r2, [r0] + adds r1, #4 + mov pc, r1 + + .thumb_func +vor_zskip: + mov r1, lr + subs r1, #1 /* undo interworking */ + ldm r0!, {r2} + cmp r2, #0 + bne .L_no_skip + ldr r3, [r1] + adds r1, r3 + mov pc, r1 +.L_no_skip: + adds r1, #4 + mov pc, r1 + + + .defword add "+" + .defword bit_inv "~" + .defword mul "*" + .defword lsl "lsl" + .defword bit_or + .defword less_than "<" + .defword load_cell "v" + .defword store_cell "^" + .defword load_byte "vb" + .defword store_byte "^b" + .defword read_word + .defword lit + .defword zskip + @.defword "" + + .defwort swap + ldm r0!, {r1, r2} + subs r0, #4 + str r1, [r0] + subs r0, #4 + str r2, [r0] + .wortende + + .defwort pick + ldm r0!, {r1} + movs r2, #2 + lsls r1, r2 + adds r3, r0, r1 + ldr r2, [r0] + subs r0, #4 + str r2, [r0] + .wortende + + .dkw dup #0 pick + .dkw over #1 pick + .dkws "2dup" two_dup over over + + .dkws "1+" incr #1 add + .dkw negate bit_inv incr + .dkws "-" subtract negate add + .dkw bit_nor bit_or bit_inv + .dkw bit_and bit_inv swap bit_inv bit_nor + .dkw bit_xor two_dup bit_nor bit_and bit_or + + .dkws "vh" load_half_word dup load_byte incr load_byte #8 lsl bit_or + + /* Adds 2 for the name length field; adds 3 in the process of making the address cell size (- 4 bytes) aligned. */ + .dkw get_past_word_header #10 add dup load_half_word add #2 add #3 add #-4 bit_and + .dkw get_variable_address get_past_word_header load_cell + .dkw get_constant_value get_past_word_header load_cell + + .dkw start #expanse_ptr load_cell #2 #2 add swap store_byte + |