/* ff kernel -*- fundamental -*- Register usage: TOS: r0 SP: r13 RP: r14 AP: r12 W: r11 */ .equ HEAP_SIZE,10000000.equ SSTACK_SIZE, 4096.equ RSTACK_SIZE, 4096 .text .global _start_start: ldr r1, =v_dp ldr r1, [r1, #4] ldr r1, [r1] add r0, r1, #8 ldrb r2, [r1, #4] add r0, r0, r2 bic r0, r0, #3 add r12, r0, #4 @ align and add 1 ldr r0, =heaptop str r13, [r0, #-4] .macro NEXT ldr r11, [r12], #4 ldr pc, [r11].endm NEXT reset: ldr r14, =rstack NEXT clear: ldr r13, =sstack_end NEXT colon: str r12, [r14], #4 add r12, r11, #4 NEXT dodoes: @ ( -- a ) str r12, [r14], #4 ldr r12, [r11, #4] str r0, [r13, #-4]! add r0, r11, #8 NEXT jump: @ ( -- ) ldr r12, [r12] NEXT cjump: @ ( f -- ) ldr r1, [r12], #4 tst r0, r0 bne cjump_1 mov r12, r1cjump_1: ldr r0, [r13], #4 NEXT fetch: @ ( a -- n ) ldr r0, [r0] NEXT store: @ ( n a -- ) ldr r1, [r13], #4 str r1, [r0] ldr r0, [r13], #4 NEXT cfetch: @ ( a -- c ) ldrb r0, [r0] NEXT cstore: @ ( c a -- ) ldr r1, [r13], #4 strb r1, [r0] ldr r0, [r13], #4 NEXT terminate: @ ( n -- ) mov r1, r0 @ code mov r7, #1 @ sys_exit swi 0 fsopen: @ ( cstr flags mode -- fd ) mov r2, r0 @ mode ldr r1, [r13], #4 @ flags ldr r0, [r13], #4 @ name mov r7, #5 @ sys_open swi 0 NEXT fsclose: @ ( fd -- n ) mov r7, #6 @ sys_close swi 0 NEXT fsread: @ ( a n fd -- n2 ) ldr r2, [r13], #4 @ size ldr r1, [r13], #4 @ buf mov r7, #3 @ sys_read swi 0 NEXT fswrite: @ ( a n fd -- n2 ) ldr r2, [r13], #4 @ size ldr r1, [r13], #4 @ buf mov r7, #4 @ sys_write swi 0 NEXT fsseek: @ ( pos fd -- n ) ldr r1, [r13], #4 @ offset mov r2, #0 @ SEEK_SET mov r7, #19 @ sys_lseek swi 0 NEXT mmap: @ ( a1 -- a2 ) mov r7, #90 @ old_mmap swi 0 NEXT variable: @ ( -- a ) str r0, [r13, #-4]! add r0, r11, #4 NEXT constant: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r11, #4] NEXT literal: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r12], #4 NEXT sliteral: @ ( -- a n ) str r0, [r13, #-4]! ldrb r0, [r12], #1 str r12, [r13, #-4]! add r12, r12, r0 add r12, r12, #3 bic r12, r12, #3 NEXT exit: ldr r12, [r14, #-4]! NEXT doinit: @ ( hi lo -- ) str r0, [r14], #4 ldr r0, [r13], #4 str r0, [r14], #4 ldr r0, [r13], #4 NEXT doloop: ldr r1, [r14, #-8] add r1, r1, #1doloop1: ldr r2, [r14, #-4] cmp r1, r2 bge doloop2 str r1, [r14, #-8] ldr r12, [r12] NEXTdoloop2: add r12, r12, #4 sub r14, r14, #8 NEXT doploop: @ ( n -- ) ldr r1, [r14, #-8] add r1, r1, r0 ldr r0, [r13], #4 b doloop1 rfetch: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r14, #-4] NEXT rpush: @ ( n -- ) str r0, [r14], #4 ldr r0, [r13], #4 NEXT rpop: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r14, #-4]! NEXT i: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r14, #-8] NEXT j: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r14, #-16] NEXT plus: @ ( n1 n2 -- n ) ldr r1, [r13], #4 add r0, r0, r1 NEXT minus: @ ( n1 n2 -- n ) ldr r1, [r13], #4 sub r0, r1, r0 NEXT multiply: @ ( n1 n2 -- n ) ldr r1, [r13], #4 mul r0, r1, r0 NEXT slashmod: @ ( n1 n2 -- n3 n4 ) mov r1, r0 ldr r0, [r13] @ from: http://www.peter-cockerell.net/aalp/html/ch-6.html: sdiv32: @ r0 = lhs, r1 = rhs -> r2 = div, r3 = mod eors r5, r0, r1 @ divsgn movs r6, r0 @ modsgn rsbmi r0, r0, #0 teq r1, #0 rsbmi r1, r1, #0 b udiv32sdiv32r: teq r5, #0 rsbmi r2, r2, #0 teq r6, #0 rsbmi r3, r3, #0 str r3, [r13] mov r0, r2 NEXTudiv32: @ r0 = lhs, r1 = rhs -> r2 = div, r3 = mod @ teq r1, #0 @ beq div_error mov r2, #0 mov r3, #0 mov r4, #32 @ countudiv32_1: subs r4, r4, #1 beq sdiv32r movs r0, r0, asl #1 bpl udiv32_2udiv32_2: movs r0, r0, asl #1 adc r3, r3, r3 cmp r3, r1 subcs r3, r3, r1 adc r2, r2, r2 subs r4, r4, #1 bne udiv32_2 b sdiv32r @ uses a different algorithm, as the code above doesn't do a full unsigned 32 bit divideuslashmod: @ ( u1 u2 -- u3 u4 ) ldr r5, [r13] mov r4, r0 mov r2, r4 cmp r2, r5, lsr #1usm1: movls r2, r2, lsl #1 cmp r2, r5, lsr #1 bls usm1 mov r0, #0usm2: cmp r5, r2 subcs r5, r5, r2 adc r0, r0, r0 mov r2, r2, lsr #1 cmp r2, r4 bhs usm2 str r5, [r13] NEXT binand: @ ( n1 n2 -- n ) ldr r1, [r13], #4 and r0, r0, r1 NEXT binor: @ ( n1 n2 -- n ) ldr r1, [r13], #4 orr r0, r0, r1 NEXT binxor: @ ( n1 n2 -- n ) ldr r1, [r13], #4 eor r0, r0, r1 NEXT xswap: @ ( x y -- y x ) ldr r1, [r13] str r0, [r13] mov r0, r1 NEXT drop: @ ( x -- ) ldr r0, [r13], #4 NEXT dup: @ ( x -- x x ) str r0, [r13, #-4]! NEXT over: @ ( x y -- x y x ) str r0, [r13, #-4]! ldr r0, [r13, #4] NEXT equal: @ ( x y -- f ) ldr r1, [r13], #4 mov r2, r0 mov r0, #0 cmp r1, r2 moveq r0, #-1 NEXT greater: @ ( x y -- f ) ldr r1, [r13], #4 mov r2, r0 mov r0, #0 cmp r1, r2 movgt r0, #-1 NEXT less: @ ( x y -- f ) ldr r1, [r13], #4 mov r2, r0 mov r0, #0 cmp r1, r2 movlt r0, #-1 NEXT stackptr: @ ( -- a ) does not include TOS! str r0, [r13, #-4]! mov r0, r13 NEXT lshift: @ ( n1 n2 -- n ) ldr r1, [r13], #4 lsl r0, r1, r0 NEXT rshift: @ ( n1 n2 -- n ) ldr r1, [r13], #4 lsr r0, r1, r0 NEXT rshifta: @ ( n1 n2 -- n ) ldr r1, [r13], #4 asr r0, r1, r0 NEXT execute: @ ( ... a -- ... ) mov r11, r0 ldr r0, [r13], #4 ldr pc, [r11] deferred: ldr r11, [r11, #4] ldr pc, [r11] unloop: sub r14, r14, #8 NEXT cmove: @ ( a1 a2 n -- ) ldr r2, [r13], #4 ldr r1, [r13], #4 movs r3, r0 ldr r0, [r13], #4 beq cmove_ncmove_1: ldrb r4, [r1], #1 strb r4, [r2], #1 subs r3, r3, #1 bne cmove_1cmove_n: NEXT cmoveb: @ ( a1 a2 n -- ) ldr r2, [r13], #4 ldr r1, [r13], #4 add r1, r1, r0 add r2, r2, r0 movs r3, r0 ldr r0, [r13], #4 beq cmoveb_ncmoveb_1: ldrb r4, [r1, #1]! strb r4, [r2, #1]! subs r3, r3, #1 bne cmoveb_1cmoveb_n: NEXT cas: @ ( a old new -- f ) mov r1, r0 @ new ldr r2, [r13], #4 @ old ldr r3, [r13], #4 @ addr ldrex r0, [r3] cmp r2, r0 strexeq r0, r1, [r3] cmpeq r0, #0 moveq r0, #-1 NEXT .ltorg _end: @@@ dictionary .data .equ LAST, 0 .macro MENTRY name, label, lenlink\@: .word LAST .equ LAST, link\@ .byte \len .ascii "\name" .balign 4m_\label : .word \label.endm .macro CENTRY name, label, lenlink\@: .word LAST .equ LAST, link\@ .byte \len .ascii "\name" .balign 4\label : .word colon.endm .macro CIENTRY name, label, lenlink\@: .word LAST .equ LAST, link\@ .byte \len | 0x80 .ascii "\name" .balign 4\label : .word colon.endm .macro MVENTRY name, label, val, lenlink\@: .word LAST .equ LAST, link\@ .byte \len .ascii "\name" .balign 4v_\label : .word constant .word \val.endm .macro VENTRY name, label, lenlink\@: .word LAST .equ LAST, link\@ .byte \len .ascii "\name" .balign 4\label : .word variable .word 0.endm .include "primitives.s".include "words-gas.s" .balign 4 htop: .word heapLines 1–500 of 513. Load more
/* ff kernel -*- fundamental -*- Register usage: TOS: r0 SP: r13 RP: r14 AP: r12 W: r11 */ .equ HEAP_SIZE,10000000 .equ SSTACK_SIZE, 4096 .equ RSTACK_SIZE, 4096 .text .global _start _start: ldr r1, =v_dp ldr r1, [r1, #4] ldr r1, [r1] add r0, r1, #8 ldrb r2, [r1, #4] add r0, r0, r2 bic r0, r0, #3 add r12, r0, #4 @ align and add 1 ldr r0, =heaptop str r13, [r0, #-4] .macro NEXT ldr r11, [r12], #4 ldr pc, [r11] .endm NEXT reset: ldr r14, =rstack NEXT clear: ldr r13, =sstack_end NEXT colon: str r12, [r14], #4 add r12, r11, #4 NEXT dodoes: @ ( -- a ) str r12, [r14], #4 ldr r12, [r11, #4] str r0, [r13, #-4]! add r0, r11, #8 NEXT jump: @ ( -- ) ldr r12, [r12] NEXT cjump: @ ( f -- ) ldr r1, [r12], #4 tst r0, r0 bne cjump_1 mov r12, r1 cjump_1: ldr r0, [r13], #4 NEXT fetch: @ ( a -- n ) ldr r0, [r0] NEXT store: @ ( n a -- ) ldr r1, [r13], #4 str r1, [r0] ldr r0, [r13], #4 NEXT cfetch: @ ( a -- c ) ldrb r0, [r0] NEXT cstore: @ ( c a -- ) ldr r1, [r13], #4 strb r1, [r0] ldr r0, [r13], #4 NEXT terminate: @ ( n -- ) mov r1, r0 @ code mov r7, #1 @ sys_exit swi 0 fsopen: @ ( cstr flags mode -- fd ) mov r2, r0 @ mode ldr r1, [r13], #4 @ flags ldr r0, [r13], #4 @ name mov r7, #5 @ sys_open swi 0 NEXT fsclose: @ ( fd -- n ) mov r7, #6 @ sys_close swi 0 NEXT fsread: @ ( a n fd -- n2 ) ldr r2, [r13], #4 @ size ldr r1, [r13], #4 @ buf mov r7, #3 @ sys_read swi 0 NEXT fswrite: @ ( a n fd -- n2 ) ldr r2, [r13], #4 @ size ldr r1, [r13], #4 @ buf mov r7, #4 @ sys_write swi 0 NEXT fsseek: @ ( pos fd -- n ) ldr r1, [r13], #4 @ offset mov r2, #0 @ SEEK_SET mov r7, #19 @ sys_lseek swi 0 NEXT mmap: @ ( a1 -- a2 ) mov r7, #90 @ old_mmap swi 0 NEXT variable: @ ( -- a ) str r0, [r13, #-4]! add r0, r11, #4 NEXT constant: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r11, #4] NEXT literal: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r12], #4 NEXT sliteral: @ ( -- a n ) str r0, [r13, #-4]! ldrb r0, [r12], #1 str r12, [r13, #-4]! add r12, r12, r0 add r12, r12, #3 bic r12, r12, #3 NEXT exit: ldr r12, [r14, #-4]! NEXT doinit: @ ( hi lo -- ) str r0, [r14], #4 ldr r0, [r13], #4 str r0, [r14], #4 ldr r0, [r13], #4 NEXT doloop: ldr r1, [r14, #-8] add r1, r1, #1 doloop1: ldr r2, [r14, #-4] cmp r1, r2 bge doloop2 str r1, [r14, #-8] ldr r12, [r12] NEXT doloop2: add r12, r12, #4 sub r14, r14, #8 NEXT doploop: @ ( n -- ) ldr r1, [r14, #-8] add r1, r1, r0 ldr r0, [r13], #4 b doloop1 rfetch: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r14, #-4] NEXT rpush: @ ( n -- ) str r0, [r14], #4 ldr r0, [r13], #4 NEXT rpop: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r14, #-4]! NEXT i: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r14, #-8] NEXT j: @ ( -- n ) str r0, [r13, #-4]! ldr r0, [r14, #-16] NEXT plus: @ ( n1 n2 -- n ) ldr r1, [r13], #4 add r0, r0, r1 NEXT minus: @ ( n1 n2 -- n ) ldr r1, [r13], #4 sub r0, r1, r0 NEXT multiply: @ ( n1 n2 -- n ) ldr r1, [r13], #4 mul r0, r1, r0 NEXT slashmod: @ ( n1 n2 -- n3 n4 ) mov r1, r0 ldr r0, [r13] @ from: http://www.peter-cockerell.net/aalp/html/ch-6.html: sdiv32: @ r0 = lhs, r1 = rhs -> r2 = div, r3 = mod eors r5, r0, r1 @ divsgn movs r6, r0 @ modsgn rsbmi r0, r0, #0 teq r1, #0 rsbmi r1, r1, #0 b udiv32 sdiv32r: teq r5, #0 rsbmi r2, r2, #0 teq r6, #0 rsbmi r3, r3, #0 str r3, [r13] mov r0, r2 NEXT udiv32: @ r0 = lhs, r1 = rhs -> r2 = div, r3 = mod @ teq r1, #0 @ beq div_error mov r2, #0 mov r3, #0 mov r4, #32 @ count udiv32_1: subs r4, r4, #1 beq sdiv32r movs r0, r0, asl #1 bpl udiv32_2 udiv32_2: movs r0, r0, asl #1 adc r3, r3, r3 cmp r3, r1 subcs r3, r3, r1 adc r2, r2, r2 subs r4, r4, #1 bne udiv32_2 b sdiv32r @ uses a different algorithm, as the code above doesn't do a full unsigned 32 bit divide uslashmod: @ ( u1 u2 -- u3 u4 ) ldr r5, [r13] mov r4, r0 mov r2, r4 cmp r2, r5, lsr #1 usm1: movls r2, r2, lsl #1 cmp r2, r5, lsr #1 bls usm1 mov r0, #0 usm2: cmp r5, r2 subcs r5, r5, r2 adc r0, r0, r0 mov r2, r2, lsr #1 cmp r2, r4 bhs usm2 str r5, [r13] NEXT binand: @ ( n1 n2 -- n ) ldr r1, [r13], #4 and r0, r0, r1 NEXT binor: @ ( n1 n2 -- n ) ldr r1, [r13], #4 orr r0, r0, r1 NEXT binxor: @ ( n1 n2 -- n ) ldr r1, [r13], #4 eor r0, r0, r1 NEXT xswap: @ ( x y -- y x ) ldr r1, [r13] str r0, [r13] mov r0, r1 NEXT drop: @ ( x -- ) ldr r0, [r13], #4 NEXT dup: @ ( x -- x x ) str r0, [r13, #-4]! NEXT over: @ ( x y -- x y x ) str r0, [r13, #-4]! ldr r0, [r13, #4] NEXT equal: @ ( x y -- f ) ldr r1, [r13], #4 mov r2, r0 mov r0, #0 cmp r1, r2 moveq r0, #-1 NEXT greater: @ ( x y -- f ) ldr r1, [r13], #4 mov r2, r0 mov r0, #0 cmp r1, r2 movgt r0, #-1 NEXT less: @ ( x y -- f ) ldr r1, [r13], #4 mov r2, r0 mov r0, #0 cmp r1, r2 movlt r0, #-1 NEXT stackptr: @ ( -- a ) does not include TOS! str r0, [r13, #-4]! mov r0, r13 NEXT lshift: @ ( n1 n2 -- n ) ldr r1, [r13], #4 lsl r0, r1, r0 NEXT rshift: @ ( n1 n2 -- n ) ldr r1, [r13], #4 lsr r0, r1, r0 NEXT rshifta: @ ( n1 n2 -- n ) ldr r1, [r13], #4 asr r0, r1, r0 NEXT execute: @ ( ... a -- ... ) mov r11, r0 ldr r0, [r13], #4 ldr pc, [r11] deferred: ldr r11, [r11, #4] ldr pc, [r11] unloop: sub r14, r14, #8 NEXT cmove: @ ( a1 a2 n -- ) ldr r2, [r13], #4 ldr r1, [r13], #4 movs r3, r0 ldr r0, [r13], #4 beq cmove_n cmove_1: ldrb r4, [r1], #1 strb r4, [r2], #1 subs r3, r3, #1 bne cmove_1 cmove_n: NEXT cmoveb: @ ( a1 a2 n -- ) ldr r2, [r13], #4 ldr r1, [r13], #4 add r1, r1, r0 add r2, r2, r0 movs r3, r0 ldr r0, [r13], #4 beq cmoveb_n cmoveb_1: ldrb r4, [r1, #1]! strb r4, [r2, #1]! subs r3, r3, #1 bne cmoveb_1 cmoveb_n: NEXT cas: @ ( a old new -- f ) mov r1, r0 @ new ldr r2, [r13], #4 @ old ldr r3, [r13], #4 @ addr ldrex r0, [r3] cmp r2, r0 strexeq r0, r1, [r3] cmpeq r0, #0 moveq r0, #-1 NEXT .ltorg _end: @@@ dictionary .data .equ LAST, 0 .macro MENTRY name, label, len link\@: .word LAST .equ LAST, link\@ .byte \len .ascii "\name" .balign 4 m_\label : .word \label .endm .macro CENTRY name, label, len link\@: .word LAST .equ LAST, link\@ .byte \len .ascii "\name" .balign 4 \label : .word colon .endm .macro CIENTRY name, label, len link\@: .word LAST .equ LAST, link\@ .byte \len | 0x80 .ascii "\name" .balign 4 \label : .word colon .endm .macro MVENTRY name, label, val, len link\@: .word LAST .equ LAST, link\@ .byte \len .ascii "\name" .balign 4 v_\label : .word constant .word \val .endm .macro VENTRY name, label, len link\@: .word LAST .equ LAST, link\@ .byte \len .ascii "\name" .balign 4 \label : .word variable .word 0 .endm .include "primitives.s" .include "words-gas.s" .balign 4 htop: .word heap