Interpreter: Outer

This functionality is provided by the “QUIT” word.

Quit

Reproduced from mecrisp-stellaris-2.5.2/mecrisp-stellaris-source/common/interpreter.s

~/projects/programming-languages/forth/mecrisp-stellaris/mecrisp-unofficial-doc/kernel-source/quit.s.html
 1 @------------------------------------------------------------------------------
 2   Wortbirne Flag_visible|Flag_variable, "hook-quit" @ ( -- addr )
 3   CoreVariable hook_quit
 4 @------------------------------------------------------------------------------
 5   pushdatos
 6   ldr tos, =hook_quit
 7   bx lr
 8   .word quit_innenschleife  @ Simple loop for default
 9 
10 @ -----------------------------------------------------------------------------
11   Wortbirne Flag_visible, "quit" @ ( -- )
12 quit:
13 @ -----------------------------------------------------------------------------
14   @ Endlosschleife - muss LR nicht sichern.  No need for saving LR as this is an endless loop.
15   @ Stacks zurücksetzen
16   @ Clear stacks and tidy up.
17   .ifdef m0core
18   ldr r0, =returnstackanfang
19   mov sp, r0
20   .else
21   ldr sp, =returnstackanfang
22   .endif
23 
24   ldr psp, =datenstackanfang
25 
26   .ifdef initflash
27    bl initflash
28   .endif
29 
30   @ Base und State setzen
31 
32   ldr r0, =base
33   movs r1, #10   @ Base decimal
34   str r1, [r0]
35 
36   ldr r0, =state
37   movs r1, #0    @ Execute mode
38   str r1, [r0]
39 
40   ldr r0, =konstantenfaltungszeiger
41   @ movs r1, #0  @ Clear constant folding pointer
42   str r1, [r0]
43 
44   ldr r0, =Pufferstand
45   @ movs r1, #0  @ Set >IN to 0
46   str r1, [r0]
47 
48   ldr r0, =current_source
49   @ movs r1, #0  @ Empty TIB is source
50   str r1, [r0]
51   ldr r1, =Eingabepuffer
52   str r1, [r0, #4]
53 
54 quit_intern:
55   ldr r0, =hook_quit
56   ldr r0, [r0]
57   mov pc, r0
58 
59 quit_innenschleife:  @ Main loop of Forth system.
60   bl query
61   bl interpret
62 
63   .ifdef color
64 
65   @ Check state
66   ldr r0, =state
67   ldr r0, [r0]
68   cmp r0, #0
69   beq 1f
70     write " \x1B[34m"
71     b 2f
72 1:  write " \x1B[36m"
73 2:
74 
75   @ Check memory target
76   ldr r0, =Dictionarypointer
77   ldr r0, [r0]
78 
79   ldr r1, =Backlinkgrenze
80   cmp r0, r1
81   bhs.n 1f
82 
83     writeln "ok'\x1B[0m"
84     b.n quit_innenschleife
85 1:  writeln "ok.\x1B[0m"
86     b.n quit_innenschleife
87 
88   .else
89 
90     writeln " ok."
91     b.n quit_innenschleife
92 
93   .endif