-
Notifications
You must be signed in to change notification settings - Fork 1
/
FISH_STM32F4_SLIBg.s
1334 lines (1193 loc) · 37 KB
/
FISH_STM32F4_SLIBg.s
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
// Created FISH_STM32F4_SLIB.s
// - To place :NONAME's before dynamic content to make their CFA addresses static.
//------------------------------------------------------------------------------
// SECTION HEADER TO ALIGN ALL HI LEVEL CODE - ASM SECTION AT END DIFFERS!
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
//------------------------------------------------------------------------------
//:NONAME BELL: ( -- ) Emit BELL char.
BELL:
DC32 DOCOL, LIT, 0x07, EMIT, SEMIS
//:NONAME EIGHT: ( -- n )
//:NONAME BACKSPACE_CHAR: ( -- n )
EIGHT:
BACKSPACE_CHAR:
DC32 DOCON, 8
//:NONAME BSOUT: ( -- ) Emit BACKSPACE char erasing it and maintain OUT.
BSOUT:
DC32 DOCOL
DC32 BACKSPACE_CHAR, EMIT
DC32 SPACE
DC32 BACKSPACE_CHAR, EMIT
DC32 LIT, -3, OUT_SV, PSTORE // Keep OUT in synch
DC32 SEMIS
//:NONAME zero_OUT: ( -- )
zero_OUT:
DC32 DOCOL, strva, 0, OUT, SEMIS
//:NONAME DOTSBASE: ( n -- ) Pass n as base to .S
DOTSBASE:
DC32 DOCOL
DC32 BASE_TO_R12 // Save current BASE
DC32 BASE_SV, STORE, DOTS
DC32 BASE_FROM_R12 // Restore BASE
DC32 SEMIS
//:NONAME PRINT_SUFFIX ( -- ) Print char representing BASE ( b d or h )
PRINT_SUFFIX:
DC32 DOCOL
DC32 BASE_SV, AT, DUP
DC32 TWO, EQUAL
DC32 ZBRAN
DC32 DEC_OR_HEX-.
IS_BIN:
DC32 LIT, 'b', EMIT, DROP
DC32 SEMIS
DEC_OR_HEX:
DC32 LIT, 10, EQUAL
DC32 ZBRAN
DC32 IS_HEX-.
IS_DECIMAL:
DC32 LIT, 'd', EMIT
DC32 SEMIS
IS_HEX:
DC32 LIT, 'h', EMIT
DC32 SEMIS
//:NONAME DOT_BASE_SUFFIX: ( n -- ) DOT with BASE suffix appended.
// USED IN . .D and .SD
DOT_BASE_SUFFIX:
DC32 DOCOL
DC32 STOD // Extend sign
DC32 ZERO // and no padding
DC32 DDOTR // in call to D.R
DC32 PRINT_SUFFIX // Read BASE and print suffix
DC32 SEMIS
//:NONAME UDOT_BASE_SUFFIX: ( n -- ) UDOT with BASE suffix appended.
// USED IN .B .H .SB AND .SH
UDOT_BASE_SUFFIX:
DC32 DOCOL
DC32 ZERO, ZERO // No sign and no padding
DC32 DDOTR // in call to D.R
DC32 PRINT_SUFFIX // Read BASE and print suffix
DC32 SEMIS
//:NONAME DOTBASE: ( n -- ) Use n as temporary BASE to output with.
// Save current BASE and use n as BASE for this DOT or U.
// Used by .B .D and .H
DOTBASE:
DC32 DOCOL
DC32 BASE_TO_R12 // Save current BASE
DC32 DUP, BASE_SV, STORE // Save and set BASE to use
// IF THIS IS ELIMINATED AND UDOT ONLY USED -1 .D IS 42432762367
DC32 LIT, 10, EQUAL // Use saved BASE for DECIMAL case
DC32 ZBRAN // Fall thru for DECIMAL Case
DC32 DBUSEDUDOT-. // Else handle BIN and HEX as unsigned.
DC32 DOT_BASE_SUFFIX
DC32 BRAN
DC32 DBASEDONE-. // Finish with space and reestoration of BASE.
DBUSEDUDOT:
DC32 UDOT_BASE_SUFFIX
DBASEDONE:
DC32 SPACE // Provide normal . formatting
DC32 BASE_FROM_R12 // Restore BASE
DC32 SEMIS
//:NONAME INITSO_SV: ( -- addr of INITSO )
// A system variable that contains the initial value for the stack pointer.
// Pronounced S-zero. See SP!
INITSO_SV:
DC32 DOCON, INITSO
//:NONAME INITRO_SV: ( -- addr of INITRO )
// A system variable containing the initial location of the return stack.
// Pronounced R-zero. See RP!
INITRO_SV:
DC32 DOCON, INITRO
//:NONAME CSP_SV: ( -- addr of CSP ) Stack address save for compile error checking
// A system variable temporarily storing the stack pointer position, for
// compilation error checking.
CSP_SV:
DC32 DOCON, CSP
//:NONAME HLD_SV: ( -- addr of NHLD ) Holds address of numeric output conversion
// A system variable that holds the address of the latest character of
// text during numeric output conversion. Usually pad relative.
HLD_SV:
DC32 DOCON, NHLD
//:NONAME DICTFULL_ABORT ( -- ) Issue Dictionary Full Message and ABORT
DICTFULL_ABORT:
DC32 DOCOL
DC32 LIT, msg_dictfull
DC32 NULLSTRLEN, TYPE
DC32 ABORT
//:NONAME ALLOT_PRIM: ( un -- ) ALLOT WITHOUT DICTIONARY CHECK
ALLOT_PRIM:
DC32 DOCOL
DC32 DP_SV
DC32 PSTORE
DC32 SEMIS
//:NONAME COMMA_PRIM ( CFA -- ) COMMA WITHOUT DICTSPACE TEST
COMMA_PRIM:
DC32 DOCOL
DC32 ALIGN32_DP_FF_PAD // ASM CANDIDATE
DC32 HERE // is NEW DP
DC32 STORE // CFA
DC32 FOUR
DC32 ALLOT_PRIM // ALLOT W/O DICTSPACE CHECK
DC32 SEMIS
//:NONAME QCOMP: ( -- ) Issue error message if not compiling.
QCOMP:
DC32 DOCOL
DC32 STATE_SV
DC32 AT
DC32 ZEQU
DC32 LIT, msg_qcomp
DC32 QERROR // ( f nullstr-addr -- )
DC32 SEMIS
//:NONAME QEXEC: ( -- ) Issue error message if not executing.
QEXEC:
DC32 DOCOL
DC32 STATE_SV
DC32 AT
DC32 LIT, msg_qexec
DC32 QERROR // ( f nullstr-addr -- )
DC32 SEMIS
//:NONAME QPAIR: ( n1 n2 -- ) Issue an error message if n1 does not equal n2.
// The message indicates that compiled conditionals do not match.
QPAIR:
DC32 DOCOL
DC32 SUBB
DC32 LIT, msg_qpair
DC32 QERROR // ( f nullstr-addr -- )
DC32 SEMIS
//:NONAME QSTACK: ( -- ) If Stack Error type error message then Abort.
// Issue an error message if the stack is out of bounds. This
// definition may be installation dependent.
QSTACK:
DC32 DOCOL
DC32 SPAT
DC32 INITSO_SV
DC32 AT
DC32 SWAP
DC32 ULESSTHAN // U< ( 2 1 -- 0 ) ( 1 2 -- 1 )
DC32 LIT, msg_qstack
DC32 QERROR // ( f nullstr-addr -- )
DC32 SEMIS
//:NONAME PDOTQ: ( -- ) DOTQ run-time
// The run-time proceedure, compiled by ." which transmits the
// following in-line text to the selected output device. See ."
// USE SINGLE QUOTES IN SOURCE USAGE!!!!
PDOTQ:
DC32 DOCOL
DC32 RFROM // Addr of string = aofstr
DC32 DUP, COUNT, TYPE
DC32 COUNT, PLUS
DC32 ALIGNED
DC32 TOR
DC32 SEMIS
//:NONAME QUERY: ( -- ) Use Expect to fill TIB
// Input characters into TIB as a NULL terminated string using EXPECT.
// TIB is filled until CR/EMTER or count argument to EXPECT is reached.
// IN is set to zero and the string in TIB is NULL terminated.
QUERY:
DC32 DOCOL
DC32 TIB_SV
DC32 LIT, IOBUFSIZE-2 // 96-2=94
DC32 EXPECT
DC32 strva, 1, IN
DC32 SEMIS
//:NONAME PNUMBER: ( 0 0 addr1 -- d addr2 )
// ( 0 0 addr1 -- LSW MSW addr2=addr1+chars )
// Convert the ascii text beginning at addr1+l
// with regard to BASE into a 64 bIt unsigned number d.
// Addr2 is the address of the first unconvertable digit, usually space
// or NULL.
// Used by NUMBER.
PNUMBER:
DC32 DOCOL
PNUM1: // Begin
DC32 ONEP // ( LSW MSW addr+1 -- )
DC32 DUP, TOR // ( LSW MSW addr+1 -- ) copy of addr+1 >r
DC32 CAT // ( LSW MSW c -- )
DC32 BASE_SV, AT // ( LSW MSW c base -- )
DC32 DIGIT // ( LSW MSW c base -- 0 0 digit 1 (ok)
// | ( 0 0 0 (bad))
// digit gets 0, 0x20 or 0x2E and returns 0 then branches to fromr semis...
DC32 ZBRAN //
DC32 PNUM2-. // If digit retuned 0 branch, else fall thru
DC32 SWAP // ( LSW MSW digit -- )
DC32 BASE_SV, AT // ( LSW digit MSW base -- )
// U* (un un -- ud=<LSW MSW> )
DC32 USTAR // ( LSW digit LSW MSW -- )
DC32 DROP
DC32 ROT
DC32 BASE_SV, AT // ( base*accn bn base -- )
DC32 USTAR // ( base*accn bn*base -- )
DC32 DPLUS // ( base*accn+bn*base -- )
DC32 DPL_SV, AT, ONEP
DC32 ZBRAN // IF true
DC32 PNUM3-. // else do
DC32 ONE, DPL_SV, PSTORE
PNUM3: // endif
// ( 0 0 <c | 0> -- )
DC32 RFROM // ( 0 0 <c | 0> addr+1 -- ) copy of addr+1 <r
DC32 BRAN
DC32 PNUM1-. // REPEAT
PNUM2:
DC32 RFROM // copy of addr+1 <r
DC32 SEMIS
//:NONAME DFIND: ( --- pfa len tf )(found)
// ( --- ff ) (not found)
// Accepts the next text word (delimited by blanks) in the input stream
// to HERE, and searches the CONTEXT and then CURRENT vocabularies
// for a matching entry. If found, the dictionary entry's parameter
// field address, its length byte, and a boolean true is left.
// Otherwise, only a boolean false is left.
// DFIND LEN HAS TO BE smudged header byte for INTERPRET.
DFIND:
DC32 DOCOL
#ifdef IO2TP
TIB_INPUT_HERE_IN_DFIND:
DC32 NOOP // R5 = @30A0h ENTER INTO TIB HERE
#endif
DC32 BLANK // ( ch -- )
DC32 WORD // ( cH-DELIM --- )
DC32 HERE // ( txt -- )
DC32 LATEST // ( txt nfa -- )
DC32 PFIND // ( txt nfa -- pfa wordlen 1 ) (ok)
// | ( txt nfa -- 0 ) (bad)
DC32 SEMIS
//:NONAME COMP: ( -- ) Compile CFA of word that follows inside a definition.
// DOTQ: DO: LOOP: PLOOP: LITERAL: DLITERALl COLON: SEMIS:
// DO DICTSPACE CHECK, AS DOES COMMA, CCOMMA and ALLOT
// SO COMMA_PRIM CREATED AND USED HERE FOR COMPILER SPEEDUP
// Compile CFA of word that follows.
// When the word containing COMPILE executes, the execution address of
// the word following COMPILE is copied (compiled) into the dictionary.
// This allows specific compilation situations to be handled in
// addition to simply compiling an execution address (which the
// interpreter already does).
COMP:
DC32 DOCOL
// DC32 QEXEC // QCOMP
DC32 RFROM // addr of next word in body of this word
DC32 DUP
DC32 FOURP // addr past next word...
DC32 TOR // that where execution resumes after
DC32 AT // compiling this word
// DC32 COMMA // ALIGNED, INCREMENTS DP REFLECTED by HERE
DC32 COMMA_PRIM // NO DICTSPACE CHECK HERE
DC32 SEMIS
//:NONAME MSMOD: ( ud1 n2 -- n3 ud4 )
// An unsigned mixed magnitude math operation which leaves a double
// quotient ud4 and remainder u3, from a double dividend ud1 and single
// divisor u2. Primarily used in pictured numeric output DIG
MSMOD:
DC32 DOCOL // EX 1 0 A
DC32 TOR // -- 1 0
DC32 ZERO // -- 1 0 0
DC32 R // -- 1 0 0 A
DC32 USLASH // ( uLSW uMSW u32 --- u32REMAINDER u32QUOTIENT )
DC32 RFROM
DC32 SWAP // -- 0 A 0 1 0
DC32 TOR
DC32 USLASH
DC32 RFROM
DC32 SEMIS
//:NONAME SCSP: ( -- ) Save the parameter stack position in CSP.
// Part of the compiler security.
// Means Store (save) Compile time stack position.
SCSP:
DC32 DOCOL
DC32 SPAT
DC32 CSP_SV
DC32 STORE
DC32 SEMIS
//:NONAME QCSP: ( -- ) Issue error message if stack and CSP don't match.
// Indicates unbalanced compilation. Part of compiler security
QCSP:
DC32 DOCOL
DC32 SPAT
DC32 CSP_SV
DC32 AT
DC32 SUBB
DC32 LIT, msg_qstack
DC32 QERROR // ( f nullstr-addr -- )
DC32 SEMIS
//:NONAME INTERPRET: ( -- ) The Inner Interpreter
// The outer text interpreter which sequentially executes or compiles
// text from the TIB depending on STATE. If
// the word name cannot be found after a search of CURRENT
// it is converted to a number according to the current base.
// That also failing, an error message will TYPE and ABORT.
// Text input will be taken according to the convention for WORD. If a
// decimal point is found as part of a number, a double number value
// will be left. The decimal point is saved in DPL but otherwise
// has no other purpose than to force this action.
// See NUMBER.
INTERPRET:
DC32 DOCOL
INTE1: // Begin
DC32 DFIND // IO2TP noop there for TIB entry
// -FIND ( --- pfa len tf )(found) ( --- ff ) (not found)
DC32 ZBRAN // IF not a word,
DC32 INTE2-. // TRY AS A NUMBER
DC32 STATE_SV // CSTATE 0 = INTERPRET, Cxh = COMPILING
DC32 AT // DFIND len has to be SMUDGED NFA count
DC32 LESSTHAN // for CSTATE to pass IMMEDIATE words
DC32 ZBRAN // To execute immdeiate words while compiling
DC32 INTE3-.
DC32 CFA
DC32 COMMA_PRIM // No DICTSPACE check, aligned.
DC32 BRAN //ELSE
DC32 INTE4-.
INTE3:
DC32 CFA //EXECUTE FOUND WORD
DC32 EXEC //endif
INTE4:
DC32 QSTACK // IF STACK error abort using qerr
DC32 BRAN //ELSE
DC32 INTE1-.
INTE2:
DC32 HERE
DC32 NUMBER //( addr --- 32LSW 32MSW ) IF error quit
DC32 DPL_SV
DC32 AT
DC32 ONEP
DC32 ZBRAN // IF 1+ = 0
DC32 INTE6-. // SINGLE NUMBER
DC32 DLITERAL // PUSH DOUBLE NUMBER TO STACK
DC32 BRAN // ELSE DOUBLE NUMBER
DC32 INTE7-.
INTE6:
DC32 DROP
DC32 LITERAL // PUSH SINGLE NUMBER TO STACK
INTE7:
DC32 QSTACK // endif // IF STACK error abort using qerr
INTE5:
DC32 BRAN // AGAIN
DC32 INTE1-.
//:NONAME QUIT: ( -- ) The Outer Interpreter.
// USE QUERY TO GET INPUT. IF INPUT = CR EXECUTE NULL TO RETURN
// THEN INTERPRET EXECUTES WORDS, CONVERTS NUMBERS OR RESTART THRU ABORT
QUIT:
DC32 DOCOL
DC32 LBRAC // Set CSTATE to zero - not compiling.
DC32 SPSTO // ADDED IN PAREN TEST
QUIT1: // Begin
DC32 RPSTO
DC32 QUERY // ( -- ) Input to TIB
DC32 INTERPRET // ( -- ) RETURN BY CR placing null in tib -> NULL:
#ifdef IO2TP
//BP1_QUIT:
// DC32 NOOP
DC32 CLRPAD // Resets OUT
#endif
// ISSUE ONLY CR IF COMPILING OR IF PROMPT: SET TO 0 WITH POFF(PROMPTOFF)
DC32 STATE_SV // 0xC0 is compiling
DC32 AT
DC32 ZEQU // NOT = TO ZERO IF COMPILING SO 0 IF COMPILING
DC32 ZBRAN // BRANCH IF 0 - CSTATE IS NON-ZERO = compiling
DC32 QUIT2-. // CR, LOOP AGAIN
// v1.7 new feature to vector the system prompt
// zero means only cr with every line - for download suppression of all but errs
DC32 LIT, PROMPT, AT
DC32 ZBRAN // IF PROMPT$ = 0
DC32 QUIT2-. // CR, LOOP AGAIN
// PROMPT$ is not zero
DC32 LIT, PROMPT, AT
// DC32 LIT, msg_MY_OK
DC32 NULLSTRLEN, TYPE
DC32 BASE_SV, AT
DC32 DOTDEC
#ifdef IO2TP
BP2_QUIT:
DC32 NOOP
DC32 CLRPAD // Resets OUT
DC32 CLRTIB // Resets IN
#endif
QUIT2:
DC32 CR // HERE FOR BOTH COMPILE AND INTERPRET
//BP23_QUIT:
// DC32 NOOP
DC32 BRAN // AGAIN
DC32 QUIT1-.
//:NONAME BACK: ( addr -- ) Branch back primitive
// Calculate the backward branch offset from HERE to addr and compile
// into the next available dictionary memory address.
BACK:
DC32 DOCOL
DC32 HERE
DC32 SUBB
DC32 COMMA
DC32 SEMIS
//:NONAME SEMIC_CREATE: ( -- ) Used after CREATE to reset CSDP
// Used in ; CON and VAR to reset CSDP which is used to auto forget
// Words that have errors during compilation.
SEMIC_CREATE:
DC32 DOCOL
DC32 strva, 0, CSDP // RESET AUTO FORGET WHEN CREATE ERROR
DC32 SEMIS
//:NONAME CSDP_SV ( -- addr of CSDP ) Holds where to reset if definition fails
CSDP_SV:
DC32 DOCON, CSDP
//:NONAME PM: ( n1 n2 -- n3 ) Apply the sign of n2 to n1, which is left as n3.
PM:
DC32 DOCOL
DC32 ZLESS
DC32 ZBRAN //IF
DC32 PM1-.
DC32 NEGATE //endif
PM1:
DC32 SEMIS
//:NONAME DPM: ( d1 n -- d2) Apply the sign of n to the double number d1.
DPM:
DC32 DOCOL
DC32 ZLESS
DC32 ZBRAN //IF
DC32 DPM1-.
DC32 DNEGATE //endif
DPM1:
DC32 SEMIS
//:NONAME SIGNON: ( -- ) type SIGNON message.
SIGNON:
DC32 DOCOL
#ifdef IO2TP
DC32 zero_OUT
#endif
DC32 CR, LIT, msg_FISH
DC32 NULLSTRLEN, TYPE
DC32 LIT, msg_FISH_TIMESTAMP
DC32 NULLSTRLEN, TYPE, CR
#ifdef IO2TP
SIGNON_BP1:
DC32 NOOP
DC32 CLRPAD // Resets OUT
#endif
DC32 SEMIS
//:NONAME WARM: ( -- ) Perform FWARM and FLASH_SCAN
// SYSTEM RAMVARSPACE INIT
// Patch in FLASH_SAVE'd Code.
WARM:
DC32 DOCOL
DC32 FWARM
DC32 FLASH_SCAN
DC32 SEMIS
//:NONAME TRAVERSE TRAVERSE: ( addr1 n -- addr2 ) Used in NFA and PFA
// USED only in NFA and PFA, padding alignment is done there.
// Move across a variable length padding aligned name field with smudged 1rst and last byte.
// addr1 is the address of either the length byte or the last letter.
// If n=1, the motion is toward nfa - hi memory, if n=-l, the motion is
// toward CFA - low memory. The addr2 resulting is address
// of the other end of the name.
TRAVERSE:
DC32 DOCOL
DC32 SWAP
TRAVERSE_BEGIN:
DC32 OVER // Begin
DC32 PLUS
DC32 LIT,0x7F
DC32 OVER
DC32 CAT
DC32 LESSTHAN
DC32 ZBRAN //until
DC32 TRAVERSE_BEGIN-.
DC32 SWAP
DC32 DROP
DC32 SEMIS
//------------------------------------------------------------------------------
// ASM CODE START - MUST BE ALLIGNED AGAIN
/* AS IN:
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
LABEL:
DC32 .+5
SECTION .text : CODE (2)
ASM CODE
*/
//------------------------------------------------------------------------------
//:NONAME SECTION:
// Upper case names are FISH model primitives.
// lower case names are v4th model primitives.
//:NONAME strva: ( -- ) GET VALUE THEN ADDR FROM NEXT 2 CELLS AND WRITE TO ADDR
// Use proper LABEL for values/addresses!!! EX: FPA vs FPADDR
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
strkk:
strva:
STRVA:
strda:
DC32 .+5
SECTION .text : CODE (2)
LDM i!, {n} // GET [i] TO n.
LDM i!, {w} // next [i] yp w.
STR n, [w] // n w ! w/o stack
NEXT
//:NONAME atk: ( -- ) get value at inline const address
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
atk: ; ( x1 -- x1, x2 )
DC32 .+5
SECTION .text : CODE (2)
// DUP
ILK t
ldr t, [t]
TPUSH
//:NONAME ork: ( x -- x' ) Get inline konstant to OR with TOS.
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
bisk:
ork:
DC32 .+5
SECTION .text : CODE (2)
ILK w
POP2t
orrs t,w
TPUSH
//:NONAME andk: ( x -- x' ) Get inline konstant to AND with TOS.
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
andk:
DC32 .+5
SECTION .text : CODE (2)
ILK w
POP2t
ands t,w
TPUSH
//:NONAME strk: ( n -- ) Get inline konstant and store it to TOS addr.
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
strk: ; ( x -- )
DC32 .+5
SECTION .text : CODE (2)
ILK x
POP2t
str t, [x]
// DROP
NEXT
//:NONAME RMWAMD: ( bitdata_ilk3, mask_ilk2, addr_ilk1 -- )
// ALIASES: rmwkkk AND rmwamd
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
RMWAMD:
DC32 .+5
SECTION .text : CODE (2)
POP2x // addr_ilk1
POP2n
POP2t
ldr w, [x]
bic w, w, n
and t, t, n
orr w, w, t
str w, [x]
NEXT
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
rmwkkk:
rmwamd: ; ( -- ) addr_ilk1, mask_ilk2, bitdata_ilk3
DC32 .+5
SECTION .text : CODE (2)
ILK x
ILK y
ILK k
ldr w, [x]
bic w, w, y
and k, k, y
orr w, w, k
str w, [x]
NEXT
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
begin: ; r:( -- addr )
DC32 .+5
SECTION .text : CODE (2)
str i, [r, #-4]!
NEXT
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
until: ; ( x -- )
DC32 .+5
SECTION .text : CODE (2)
POP2t
cmp t, #0
// DROP
ite eq
ldreq i, [r] ; r:( -- )
addne r, r, #4 ; r:( addr -- )
NEXT
//:NONAME SV_INIT_VALUES: Table of FISH SYSTEM VAR Iinitial values.
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
SV_INIT_VALUES:
// 4 words of System Variables
DC32 DEFAULT_BASE // NBASE
DC32 1 // IN
DC32 0 // OUT
DC32 0 // CSTATE
// 5 addresses of System Data Structures
DC32 PINIT // INITSO
DC32 RINIT // INITRO
DC32 TIB // INITTIB
DC32 RAMVARSPACE // UP
DC32 ORIG // DP
// 4 addresses of System Pointers
DC32 0 // CSDP
DC32 0 // FENCE
#ifdef FISH_PubRel_WORDSET
DC32 WC_FISH_PubRel_NFA // CURRENT
#endif
#ifdef FISH_NXP_M0_PRO_WORDCAT
DC32 WC_FISH_PRO_NFA // CURRENT
#endif
DC32 msg_MY_OK // PROMPT
// 13d WORDS TO COPY
//:NONAME FWARM ( -- ) FISH SYSTEM VAR Initialization primitive.
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
FWARM:
DC32 .+5
SECTION .text : CODE (2)
FWASM:
LDR t, = SV_INIT_VALUES
LDR n, = END_RAMVARSPACE_SV_START
LDR w, = 13d
FWBEGIN:
LDR x, [t]
STR x, [n]
ADDS t, t, #4
ADDS n, n, #4
SUBS w, w, #1
BNE FWBEGIN
NEXT
LTORG // Always outside of code, else data in words
//:NONAME DOCOL ( -- ) COMPILED VERSION OF COLON
SECTION .text : CODE (2)
ALIGNROM 2,0xFFFFFFFF
DOCOL: // no cfa for DOCOL!!!!! <<<<<<<<<<<<<<<<<<
PUSHi2r // save IP to Rstack
MOV i, w // jam new IP = cfa+4
NEXT
//:NONAME SEMIS: ( -- ) COMPILED VERSION OF SEMICOLON
// Terminate a colon-definition,
// : pushed the calling word return addr to the return stack
// This retrieves it and returns to calling word.
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
SEMIS:
DC32 .+5
SECTION .text : CODE (2)
POPr2i // pop docol saved IP from Rstack
NEXT
//:NONAME DOVAR ( -- ) COMPILED VERSION OF VAR
// VAR is a CON but DOVAR is 'duplicated' to allow search for it's CFA
// so FORGET can reclaim VAR space.
SECTION .text : CODE (2)
ALIGNROM 2,0xFFFFFFFF
DOVAR:
LDM w!, {t}
TPUSH
//:NONAME DOCON ( -- ) COMPILED VERSION OF CON
SECTION .text : CODE (2)
ALIGNROM 2,0xFFFFFFFF
DOCON:
LDM w!, {t}
TPUSH
//:NONAME LIT: ( -- n ) The primitive that pushes a number in a definition.
// Within a colon-definition, LIT is automatically compiled before each
// 32 bit literal number encountered in input text. Later execution of
// LIT causes the contents of the next dictionary address ( the LITERAL #)
// to be pushed to the stack.
// Use LITERAL
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
LIT:
DC32 .+5
SECTION .text : CODE (2)
LIT2t // LDM i!, {t}
// fetch memory i points to into {t}, inc i after
TPUSH
//:NONAME RLIT: ( -- n ) LIT primitive that can have it's value relocated.
// SEE LIT. ALLOWS RELOCATION OF THIS type OF LIT
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
RLIT:
DC32 .+5
SECTION .text : CODE (2)
LIT2t // LDM i!, {t}
// fetch memory i points to into {t}, inc i after
TPUSH
//:NONAME GOTO: ( cfa -- ) Redirect execution to cfa in another hi-level word.
// CAUTION!!!!!!! A SYSTEM WORD EXPOSED FOR THE BOLD AND BRAVE!!!!!!!
// Stack IN CURRENT WORD MUST BE CLEANED UP!
// AND STACK MUSTE BE SET UP as expected where you GOTO.
// YOU CANNOT VIOLATE controls structure (LOOPS, BEGINs IFs, etc).
// Unless you come from the same point in the same control structure!
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
GOTO:
DC32 .+5
SECTION .text : CODE (2)
POP2i // set i as pointer to cfa to start execution
NEXT
//:NONAME CREATE_DOES_GOTO: ( -- )
// PUSH ADDRESS OF CREATED WORDS PFA THEN
// Redirect execution to cfa of the CREATE DOES> word.
// THIS IS LIKE A DOCON IE NO DOCOL!!!!
// CAUTION!!!!!!! A SYSTEM WORD EXPOSED FOR THE BOLD AND BRAVE!!!!!!!
// Stack IN CURRENT WORD MUST BE CLEANED UP!
// AND STACK MUSTE BE SET UP as expected where you GOTO.
// YOU CANNOT VIOLATE controls structure (LOOPS, BEGINs IFs, etc).
// Unless you come from the same point in the same control structure!
CREATE_DOES_GOTO:
SECTION .text : CODE (2)
// WILL NEED A NEW CASE IN FLASH_SAVE!
// NO DOCOL - SO FUDGE ONE
// PUSH ADDR AFTER EXEC IN INTERPRET TO r:
PUSHi2r // save IP to Rstack
// AND THIS LOADS GOTO ADDR
LDR i, [t, #4] // GET GOTO ADDRESS
// THIS PUSHES PFA TO t
ADDS t, t, #8 // COMPUTE REAL PFA
PUSHt
NEXT
//:NONAME DICTSPACE: ( -- n ) Calculate and push dictionary space available
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
DICTSPACE:
DC32 .+5
SECTION .text : CODE (2)
LDR t, = DICTSPACE_END
LDR n, = DP
LDR n, [n]
SUBS t, t, n
TPUSH
// LTORG
//:NONAME VARSPACE: ( -- n ) Calculate and push VAR space available
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
VARSPACE:
DC32 .+5
SECTION .text : CODE (2)
LDR t, = END_RAMVARSPACE_SV_START
LDR n, = UP // UP IS ALLOCATION POINTER FOR VARS AND VARALLOT
LDR n, [n]
SUBS t, t, n
TPUSH
LTORG
// Rewrite for TOSCT interop?
//:NONAME PFIND: ( addr1 addr2 -- pfa b tf ) (ok)
// ( addr1 addr2 -- ff ) (bad)
// LEN HAS TO BE smudged header byte for INTERPRET.
// Header LEN BYTE REQUIRED by Interpret for immediate word execution
// Searches the dictionary starting at the name field address addr2,
// matching to the text at addr1. Returns parameter field address,
// length byte of name field and boolean true for a good match. If no
// match is found, only a boolean false is left.
//
// To step thru to a word set bp at :NONAME
// and watch r3 for match of word addr from symbol file
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
PFIND:
DC32 .+5
SECTION .text : CODE (2)
POP2x // R3 = Dict Name NFA
POP2w // R2 = String Addr usually at here
MOV rb, w // Save TXT String ADDR
// SEARCH LOOP
// nfa length test
// x must = Dict nfa
PFIN1: // ADDR-->char counted strings
MOV w, rb // restore txt str addr
LDRB t, [x] // GET nfa LENGTH
// LEN HAS TO BE smudged header byte for DFIND -> INTERPRET.
// ELSE DO THIS HERE TO MAKE IT ACTUAL & REMOVE SECTION BELOW
// MOVS y, #0x3F
// ANDS t, y
MOV k, t // Save search word length
LDRB n, [w] // TXT WORD LEN
EORS t, t, n
MOVS y, #0x3F
ANDS t, t, y
BNE PFIN5 // Len mismatch, GET NEXT LINK FIELD ADDR (lfa)
// LENGTHS MATCH - CHECK EACH CHARACTER IN NAME
// TEST FIRST CHAR AND DETERMINE IF LAST
PFIN2:
ADDS w, w, #1 // str
ADDS x, x, #1 // nfa
LDRB t, [x] // GET nfa 1RST CHAR
LDRB n, [w] // GET TXT 1RST CHAR
CMP t, n // eor was working but this make 0x80 subb
BEQ PFIN2 // matched try next char
MOVS y, #0x80
SUBS t, t, y // ascii only in t and n
cmp t, n
BNE PFIN51 // goto WORD MISMATCH
// FOUND END OF NAME (BIT 8 SET) - A MATCH
// GET to pfa of found word
PFIN21:
ADDS x, x, #1 // Dict addr
LDRB t, [x]
CMP t, #0xFF
BEQ PFIN21
thispfa:
ADDS x, x, #8 // at cfa -> pfa
PUSHx // PUSH pfa
MOVS t, #1 // TRUE VALUE
MOV w, k // RETURN Header Byte LENGTH
DPUSH
// NO NAME MATCH - TRY ANOTHER
// Set NEXT LINK FIELD ADDR (lfa) to x
// ( ZERO = FIRST WORD OF DICTIONARY )
// GET TO END OF NAME BEFORE Padding IF ANY
// ENTER HERE FROM LEN!= (RB->CNT)
PFIN5:
ADDS x, x, #1 // inc char in name addr
// ENTER HERE FROM WORD MISMATCH
PFIN51:
LDRB t, [x] // get Dict Word char
MOVS y, #0x80
TST t, y // is last char in word bit set
BEQ PFIN5
// UNMATCHED NAME - POINTING AT LAST CHAR BEFORE Padding IF ANY
// GET PAST FF Padding AND GET lfa
PFIN7:
// Code for ALIGNED
// ADDS x, x, #3
ADDS x, x, #4 // add 1 for entry
LDR t, =-4
ANDS x, x, t
LDR x, [x] // GET lfa to next word
CMP x, #0 // START OF DICT ( 0 ) ?
BEQ WORDNOTFOUND
// NOT A BRAN TARGET - This one used for breakpoint
PFIND_NEXT_NFA:
B PFIN1 // Search next word x must = Dict nfa
WORDNOTFOUND: // PFIND: DONE ( NO MATCH FOUND )
MOVS t, #0
TPUSH
LTORG
//:NONAME BRAN: ( -- ) Branch in definitions primitive
// In IAR branch target MUST BE ON Next LINE!!!<<<<<<<<<<<<<<<<<<<<<<<<
// The run-time proceedure to unconditionally branch. An in-line offset
// is added to the interpretive pointer IP to branch ahead or back.
// BRANCH is compiled by ELSE, AGAIN, REPEAT.
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
BRAN:
DC32 .+5
SECTION .text : CODE (2)
BRAN1:
LDR x, [i] // Get branck target
ADDS i, i, x // use as offset
NEXT
//:NONAME ZBRAN: ( f -- ) Branch if zero definition primitive.
// In IAR branch target MUST BE ON Next LINE!!!<<<<<<<<<<<<<<<<<<<<<<<<
// The run-time proceedure to conditionally branch. If f is false
// (zero), the following in-line parameter is added to the interpretive
// pointer to branch ahead or back. Compiled by IF, UNTIL, and WHILE.
SECTION .text : CONST (2)
ALIGNROM 2,0xFFFFFFFF
ZBRAN:
DC32 .+5
SECTION .text : CODE (2)
POP2t
CMP t, #0 // ZERO?
#ifdef TOSCT // CMP CONSUMES t
LDR t, [p] // REFRESH t
#endif
beq BRAN1 // YES, BRANCH