-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathOptiForth56d.asm
8471 lines (7417 loc) · 175 KB
/
OptiForth56d.asm
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
;***********************************************************************************
; *
; Filename: OptiForth56d.asm *
; Date: 10.01.2022 *
; File Version: 5.6d *
; MCU: Atmega328/P *
; Copyright: bitflipser *
; Author: bitflipser *
; *
;***********************************************************************************
; MIT License *
; *
; Copyright (c) 2021 bitflipser *
; *
; Permission is hereby granted, free of charge, to any person obtaining a copy *
; of this software and associated documentation files (the "Software"), to deal *
; in the Software without restriction, including without limitation the rights *
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell *
; copies of the Software, and to permit persons to whom the Software is *
; furnished to do so, subject to the following conditions: *
; *
; The above copyright notice and this permission notice shall be included in all *
; copies or substantial portions of the Software. *
; *
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE *
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE *
; SOFTWARE. *
; *
;***********************************************************************************
; *
; OptiForth is a standalone Forth system for AVR ATmega microcontrollers that can *
; flash their own flash memory. *
; *
; It is based on Mikael Nordman's FlashForth 5.0 (https://flashforth.com) *
; *
; OptiForth includes a bootloader, that is fully Optiboot-compatible and therefore *
; capable of loading Arduino sketches as well. *
; *
; Optimized and tested for the ATmega328P/Arduino UNO R3 ONLY !! *
; *
; Modified versions of OptiForth must be clearly marked as such, in the name of *
; this file, and in the identification displayed when OptiForth starts. *
;***********************************************************************************
; define the OF version date string
#define DATE "10.01.2022"
; include the OptiForth configuration file
.include "of56d_config.inc"
.NOLIST
; include the OptiForth macro library
.include "of_macros.inc"
.LIST
; Register definitions
.def UP = R2 ; not in interrupt
.def upL = R2 ; not in interrupt
.def upH = R3 ; not in interrupt
.def r_one = R6 ; read only one
.def r_zero = R7 ; read only zero
.def #hold = R8 ; not in interrupt (used by <# # #s #>)
.def t8 = R8 ; not in interrupt
.def wflags = R9 ; not in interrupt
.if CPU_LOAD == 1
.def loadreg = R18
.else
.def t9 = R18 ; free for use
.endif
.def intSafe16 = R4 ; 16 bit, interrupt only !
; .def intSafe16L = R4 ; interrupt only !
; .def intSafe16H = R5 ; interrupt only !
.def INTvector = R19 ; interrupt only !
.def SREG_intSafe = R19 ; interrupt only !
.def IBASE = R12 ; not in interrupt
.def ibaseL = R12 ; not in interrupt
.def ibaseH = R13 ; not in interrupt
.def MS_COUNT = R14 ; not in interrupt
.def ms_countL = R14 ; not in interrupt
.def ms_countH = R15 ; not in interrupt
.def t0 = R16 .equ regt0 = 0x00
.def t1 = R17 .equ regt1 = 0x10
.def t2 = R0 ; not in interrupt (see 'OF_ISR' and 'OF_ISR_EXIT')
.def t3 = R1 ; not in interrupt (------------------------------)
.def t4 = R26 ; XL
.def t5 = R27 ; XH
.def t6 = R30 ; ZL
.def t7 = R31 ; ZH
.def t1t0 = R16 .equ regt1t0 = 0x00 ; 16-bit
.def t3t2 = R0 ; 16-bit
.def t5t4 = R26 .equ regt5t4 = 0xa0 ; 16-bit (=X)
.def t7t6 = R30 .equ regt7t6 = 0xe0 ; 16-bit (=Z)
.def A = R10 ; A register
.def al = R10
.def ah = R11
.def P = R20 ; P register and FOR..LOOP INDEX variable
.def pl = R20
.def ph = R21 .equ regP = 0x40
.def TOP = R24 .equ regTOP = 0x80
.def tosl = R24 .equ regtosl= 0x80
.def tosh = R25 .equ regtosh= 0x90
.equ regX = 0xa0
.equ regZ = 0xe0
.def FLAGS1 = R22 ; not in interrupt
.def FLAGS2 = R23 ; not in interrupt - used in COMPILE state only
.equ FLAGS3 = GPIOR0
; symbol naming compatibility
; UART0 symbols for Atmega32
.ifndef UCSR0A
.equ UCSR0A=UCSRA
.equ UDR0_=UDR
.equ UCSR0B=UCSRB
.equ UCSR0C=UCSRC
.equ RXEN0=RXEN
.equ TXEN0=TXEN
.equ RXCIE0=RXCIE
.equ UCSZ00=UCSZ0
.equ USBS0=USBS
.equ UBRR0H=UBRRH
.equ UBRR0L=UBRRL
.equ URSEL_=0x80
.else
.equ UDR0_=UDR0
.equ URSEL_=0
.endif
.ifndef SPMCSR
.equ SPMCSR=SPMCR
.endif
.ifndef SPMEN
.equ SPMEN=SELFPRGEN
.endif
.ifndef EEWE
.equ EEWE=EEPE
.endif
.ifndef EEMWE
.equ EEMWE=EEMPE
.endif
.if OPERATOR_UART == 1
.equ OP_TX_=TX1_
.equ OP_RX_=RX1_
.equ OP_RXQ=RX1Q
.elif OPERATOR_UART == 0
.equ OP_TX_=TX0_
.equ OP_RX_=RX0_
.equ OP_RXQ=RX0Q
.endif
#define ubrr0val (FREQ_OSC/ 8/BAUDRATE0) - 1 ; double speed mode
#define ubrr1val (FREQ_OSC/16/BAUDRATE1) - 1
.if FREQ_OSC < 16384000 ; Hz
.equ ms_value_tmr0 = ((FREQ_OSC/1000/64) - 1)
.equ ms_value_tmr1 = ((FREQ_OSC/1000) - 1)
.equ ms_value_tmr2 = ((FREQ_OSC/1000/64) - 1)
.ifdef TCCR0B
.equ ms_pre_tmr0 = 3
.endif
.ifdef TCCR0
.equ ms_pre_tmr0 = 4
.endif
.ifdef TCCR2B
.equ ms_pre_tmr2 = 4
.endif
.ifdef TCCR2
.equ ms_pre_tmr2 = 3
.endif
.else ; FREQ_OSC >= 16384000 Hz
.equ ms_value_tmr0 = ((FREQ_OSC/1000/256) - 1)
.equ ms_value_tmr1 = ((FREQ_OSC/1000) - 1)
.equ ms_value_tmr2 = ((FREQ_OSC/1000/128) - 1)
.ifdef TCCR0B
.equ ms_pre_tmr0 = 4
.endif
.ifdef TCCR0
.equ ms_pre_tmr0 = 6
.endif
.ifdef TCCR2B
.equ ms_pre_tmr2 = 5
.endif
.ifdef TCCR2
.equ ms_pre_tmr2 = 4
.endif
.endif
.equ CPU_LOAD_VAL = (FREQ_OSC*128/100000)
;..............................................................................
;program specific constants (literals used in code)
;..............................................................................
; flash page size
.equ PAGESIZEB = PAGESIZE*2 ; page size in bytes
; forth word header flags
.equ NFA = 0x80 ; name field mask
.equ IMMED = 0x40 ; immediate mask
.equ INLINE = 0x20 ; inline mask for 1, 2 and 3 cell code
.equ COMPILE = 0x10 ; compile only mask
.equ NFAmask = 0x0f ; name field length mask
.if optimizingCOMPILER == 1
.equ INLINE4 = 0x20 ; inline mask for 4 cell code
.equ INLINE5 = 0x20 ; inline mask for 5+ cell code
.else
.equ INLINE4 = 0x00
.equ INLINE5 = 0x00
.endif
.equ NFAbit = 7
.equ IMMEDbit = 6
.equ INLINEbit = 5
.equ COMPILEbit = 4
; FLAGS3 (GPIOR0)
;----------------
; = 7
; = 6
; = 5
; = 4
.equ fLEAVE = 3 ; LEAVE encountered in DO..LOOP
.equ fLOCK = 2 ; write protect EEPROM and FLASH
.equ idirty = 1 ; flash write buffer modified
.equ fFLASH_PAGE_CLEAR = 0 ; actual flash page in erased state -> no need to erase before flushing buffer
; FLAGS2 (R23)
;-------------
.equ fSTATE = 7 ; 0 = interpret, 1 = compile
;+++++++++++++ do not change the following two bit positions ++++++++++++
.equ fIMMED = IMMEDbit ; (6) create an IMMEDIATE-marked word
.equ fINLINE = INLINEbit ; (5) create an INLINE-marked word
;+++++++++++++ do not change the upper two bit positions ++++++++++++++++
.equ fDOTsign = 4 ; write '-' sign
.equ fWORDSall = 3 ; list all in WORDS
.equ fDUMPxxx = 3 ; DUMP 3-digit numbers (for base < 16)
.if IDLE_MODE == 1
.equ fTX0pending= 2 ; waiting for UDRE0 (enable UDRIE0 in 'IDLE_LOAD')
.equ fIDLE = 1 ; 0 = busy, 1 = idle
.endif
.equ fLOADled = 0 ; 0 = no load-LED, 1 = load-LED on
; FLAGS1 (R22) ; used in COMPILE-state only
;-------------
.equ fLIT = 7 ; literal compiled
;.equ noclear = 6 ; dont clear optimisation flags (replaced by doclear to save space in 'constant')
.equ doclear = 6 ; clear optimization flags
.equ idup = 5 ; use dupzeroequal instead of zeroequal
.equ izeroeq = 4 ; use brne instead of breq if zeroequal
.equ f2LIT = 3 ; 2 subsequent literals (used by '!', 'c!', 'mtst', 'mtst0', 'mset', 'mclr')
.equ iLITeq = 2 ; 'LIT =' compiled
.equ fTAILC = 1 ; prevent tail jump optimization
.equ icarryeq = 0 ; use brcs instead of brne
;;; for flow Control - not in use
;.equ XON = 0x11
;.equ XOFF = 0x13
.equ CTRL_O = 0x0f
.equ CR_ = 0x0d
.equ LF_ = 0x0a
.equ BS_ = 0x08
.equ TAB_ = 0x09
;;; memory mapping prefixes
.equ PRAM = 0x0000 ; 2 kBytes of RAM (ATmega328)
.equ PEEPROM = RAMEND+1 ; 1 kBytes of EEPROM (ATmega328)
.if (FLASHEND == 0x1ffff) ; 128 kWords FLASH
.equ OFLASH = PEEPROM+EEPROMEND+1 ; 52 kBytes available for OptiForth(atm2560)
.equ PFLASH = 0
.equ RAMPZV = 3
.equ KERNEL_SIZE=0x0d80
.elif (FLASHEND == 0xffff) ; 64 kWords FLASH
.equ OFLASH = PEEPROM+EEPROMEND+1 ; 56 kBytes available for OptiForth(atm128)
.equ PFLASH = 0
.equ RAMPZV = 1
.equ KERNEL_SIZE=0x0d00
.elif (FLASHEND == 0x7fff) ; 32 kWords FLASH
.equ OFLASH = PEEPROM+EEPROMEND+1 ; 56 kBytes available for OptiForth
.equ PFLASH = 0
.equ RAMPZV = 0
.equ KERNEL_SIZE=0x0d00
.elif (FLASHEND == 0x1fff) ; 8 kWords FLASH
.equ OFLASH = 0xC000 ; 16 kBytes available for OptiForth
.equ PFLASH = OFLASH
.equ RAMPZV = 0
.equ KERNEL_SIZE=0x0c80
;=========================ATmega328/Arduino UNO===================================
.elif (FLASHEND == 0x3fff) ; 16 kWords FLASH (ATmega328)
.equ OFLASH = 0x8000 ; 32 kBytes available for OptiForth
.equ PFLASH = OFLASH
.equ RAMPZV = 0
.set KERNEL_SIZE = 0x1100
;=================================================================================
.endif
.ifdef RAMPZ
.set KERNEL_SIZE = KERNEL_SIZE + ????? ; ###### set when porting to another AVR-controller ######
.endif
.if CR_with_LF == 1
.set KERNEL_SIZE = KERNEL_SIZE + 0x02
.endif
.if CPU_LOAD_LED == 1
.set KERNEL_SIZE = KERNEL_SIZE + 0x13
.endif
.if CPU_LOAD == 1
.set KERNEL_SIZE = KERNEL_SIZE + 0x22
.endif
.if IDLE_MODE == 1
.set KERNEL_SIZE = KERNEL_SIZE + 0x1f
.endif
.if DEBUG_FLASH == 1
.set KERNEL_SIZE = KERNEL_SIZE + 0x0d
.endif
.if optimizeNUM == 1
.set KERNEL_SIZE = KERNEL_SIZE + 0xd4
.endif
.if optimizingCOMPILER == 1
.set KERNEL_SIZE = KERNEL_SIZE + 0x159
.endif
.equ BOOT_SIZE =0x100
.equ BOOT_START =FLASHEND - BOOT_SIZE + 1 ; atm128: 0xff00, atm328: 0x3f00
.equ KERNEL_START=BOOT_START - KERNEL_SIZE
;;; high values for memory areas
.equ FLASH_HI = 0xffff - (BOOT_SIZE*2) - (KERNEL_SIZE*2)
.equ EEPROM_HI = PEEPROM + EEPROMEND
.equ RAM_HI = RAMEND
;;; USER AREA for the OPERATOR task
.equ ursize= RETURN_STACK_SIZE
.equ ussize= PARAMETER_STACK_SIZE
.equ utibsize= TIB_SIZE
;;; user variables and area
.equ us0= -28 ; start of parameter stack
.equ ur0= -26 ; start of ret stack
.equ uemit= -24 ; user EMIT vector
.equ ukey= -22 ; user KEY vector
.equ ukeyq= -20 ; user KEY? vector
.equ ubase= -18 ; number Base
.equ utib= -16 ; TIB address
.equ utask= -14 ; task area pointer
.equ ulink= -12 ; task link
.equ ustatus= -10
.equ uflg= -9
.equ usource= -8 ; two cells
.equ utoin= -4 ; input stream
.equ ursave= -2 ; saved ret stack pointer
.equ uhp= 0 ; hold pointer
;;; variables in EEPROM
.equ eeprom= PEEPROM
.equ dp_start= eeprom + 0x0000 ; TURNKEY
.equ dp_flash= eeprom + 0x0002 ; FLASH dictionary pointer
.equ dp_eeprom= eeprom + 0x0004 ; EEPROM dictionary pointer
.equ dp_ram= eeprom + 0x0006 ; RAM dictionary pointer
.equ latest= eeprom + 0x0008 ; pointer to latest dictionary word
.equ prompt= eeprom + 0x000a ; deferred prompt
.equ ehere= eeprom + 0x000c
;****************************************************
.dseg
.org SRAM_START
rbuf0: .byte RX0_BUF_SIZE ; do not move rbuf0 away from SRAM_START
ibuf: .byte PAGESIZEB ; must (!!) be placed on page boundary (0x..00)
ivec: .byte INT_VECTORS_SIZE ; must not (!!) reach into next page
;rx0queue:
rbuf0_wr: .byte 1
rbuf0_rd: .byte 1
rbuf0_lv: .byte 1
.ifdef UCSR1A
rx1queue:
rbuf1_wr: .byte 1
rbuf1_rd: .byte 1
rbuf1_lv: .byte 1
rbuf1: .byte RX1_BUF_SIZE
.endif
RAMvarBase:
dpSTART: .byte 2 .equ _dpSTART =dpSTART -RAMvarBase
; DP's and LATEST in RAM
dpFLASH: .byte 2 .equ _dpFLASH =dpFLASH -RAMvarBase
dpEEPROM: .byte 2 .equ _dpEEPROM =dpEEPROM-RAMvarBase
dpRAM: .byte 2 .equ _dpRAM =dpRAM -RAMvarBase
dpLATEST: .byte 2 .equ _dpLATEST =dpLATEST-RAMvarBase
iaddrl: .byte 1
iaddrh: .byte 1
.ifdef RAMPZ
iaddru: .byte 1
ibaseu: .byte 1
.endif
.if CPU_LOAD == 1
load_res: .byte 1 ; load result [%]
.endif
litbuf0: .byte 1 ; used in COMPILE-state only
.equ litbuf1 = GPIOR2 ; used in COMPILE-state only
LEAVEadr: .byte 2 ; used in COMPILE-state only
.equ _LEAVEadr =LEAVEadr -RAMvarBase
;cse: .byte 1 ; current data section: 0 = FLASH, 2 = EEPROM, 4 = RAM
.equ cse = GPIOR1
;state: .byte 1 ; compilation state: 0 = interpret, 1 = compile
;++ moved to fSTATE in FLAGS2
uvars: .byte (-us0)
up0: .byte 2
urbuf: .byte ursize
usbuf: .byte ussize
utibbuf: .byte utibsize
dpdata:
.eseg
.org 0
.dw 0xffff ; force first cell of EEPROM to 0xffff
.cseg
.org 0 ; entry from bootloader
; rjmp WARM_VECTOR ; relative jump backwards with addr wrap around
.dw 0xcefe ; .. from 0x0000 to 0x3fff (ATmega328 ONLY)
;*******************************************************************
; Start of kernel
;*******************************************************************
.org KERNEL_START
FLASHHI:
.dw FLASH_HI
.dw EEPROM_HI
.dw RAM_HI
MEMQADDR_N:
fdw ROM_N
fdw EROM_N
fdw FRAM_N
;;; ************************************************
;;; WARM user area data
.equ warmlitsize= 20
WARMLIT:
.dw utibbuf-4 ; S0
.dw usbuf-1 ; R0
fdw OP_TX_
fdw OP_RX_
fdw OP_RXQ
.dw BASE_DEFAULT ; BASE
.dw utibbuf ; TIB
fdw OPERATOR_AREA ; TASK
.dw up0 ; Task link
;;; ************************************************
;;; EMPTY dictionary data
.equ coldlitsize=12
COLDLIT:
STARTV: .dw 0
DPC: .dw OFLASH + 2
DPE: .dw ehere
DPD: .dw dpdata
LW: fdw lastword
STAT: fdw DOTSTATUS
;*******************************************************************
.if (FLASHEND == 0x1ffff)
fdw PAUSE_L ; ### check ###
WDON_L:
.db NFA|3,"wd+"
WDON:
cli
wdr
in_ tosh,WDTCSR
ori tosh,(1<<WDCE)|(1<<WDE)
out_ WDTCSR,tosh
andi tosl,7
ori tosl,(1<<WDE)
out_ WDTCSR,tosl
sei
rjmp DROP
; WD- ( -- ) stop the watchdog
fdw WDON_L
WDOFF_L:
.db NFA|3,"wd-"
WDOFF:
cli
wdr
.ifdef MCUSR
out_ MCUSR,r_zero
.else
out_ MCUCSR,r_zero
.endif
ldi t0,(1<<WDCE)|(1<<WDE)
out_ WDTCSR,t0
out_ WDTCSR,r_zero
sei
ret
.endif
fdw DZEROLESS_L
; cwd ( -- ) kick watchdog
CWD_L:
.db NFA|INLINE|3,"cwd"
;CWD:
wdr
ret
fdw SCAN_L
; RX0? ( -- n ) return the number of characters in queue
RX0Q_L:
.db NFA|INLINE4|4,"rx0?",0xff
RX0Q:
pushtos
lds tosl,rbuf0_lv
ldi tosh,0 ; 5 / 7
ret
fdw NONAME_L
; /STRING ( a u n -- a+n u-n ) trim string
; swap over - >r + r> ;
SLASHSTRING_L:
.db NFA|7,"/string"
;SLASHSTRING:
movw t5t4,TOP ; n
poptos ; u
pop_t1t0 ; a
sub tosl,t4 ; u-n
sbc tosh,t5
add t0,t4 ; a+n
adc t1,t5
push_t1t0 ; 11 / 17
ret
fdw DINVERT_L
; DECIMAL ( -- ) set number base to decimal
; #10 BASE ! ;
DECIMAL_L:
.db NFA|7,"decimal"
;DECIMAL:
ldi t0,0x0a
BASE_STORE:
movw Z,UP
sbiw Z,(-ubase)
st Z+,t0
st Z+,r_zero ; 5 / 8
ret
fdw ICCOMMA_L
; HEX ( -- ) set number base to hex
; #16 BASE ! ;
HEX_L:
.db NFA|3,"hex"
;HEX:
ldi t0,0x10
rjmp BASE_STORE
fdw CTON_L
; BIN ( -- ) set number base to binary
; #2 BASE ! ;
BIN_L:
.db NFA|3,"bin"
;BIN:
ldi t0,2
rjmp BASE_STORE
fdw USLASHMOD_L
; ticks ( -- u ) system ticks (0-ffff) in milliseconds
TICKS_L:
.db NFA|INLINE|5,"ticks"
;TICKS:
pushtos
;TICKS_0:
movw TOP,MS_COUNT ; 3 / 5
ret
fdw USSMOD_L
; ticks= ( u -- t ) leave time in ms from u to actual ms_count
TICKSCOMPUTE_L:
.db NFA|INLINE4|6,"ticks=",0xff
;TICKSCOMPUTE:
movw t1t0,TOP
movw TOP,MS_COUNT
sub tosl,t0
sbc tosh,t1 ; 4 / 4
ret
fdw TURNKEY_L
; ticks>n ( x -- u x ) push system ticks to NEXT
TICKStoNEXT_L:
.db NFA|INLINE|7,"ticks>n"
;TICKStoNEXT:
movw t1t0,MS_COUNT
push_t1t0 ; 3 / 5
ret
.dw 0
; us ( u -- ) pause for u microseconds, u > 0
; begin 1- dup while waste9 waste2 repeat drop ;
; for ATmega328/p with 16 MHz
MICROS_L:
.db NFA|2,"us",0xff
MICROS: ; CPU ticks
sbiw TOP,1 ; 2(2)
MICROS_loop:
breq MICROS_xxx ; 1(2)
rcall waste9 ; 9 (does: 'adiw TOP,1')
wdr wdr ; 2
sbiw TOP,2 ; 2
rjmp MICROS_loop ; 2______________16 ticks (= 1 us) per loop
MICROS_xxx:
poptos ; (4)
ret ;(4+4) call/ret__16 ticks for entry+exit
fdw TIBSIZE_L
; SQR ( u -- u^2 ) 16-bit square
; valid results for u < 256 only
SQUARE_L:
.db NFA|INLINE|3,"sqr"
;SQUARE:
mul tosl,tosl
movw TOP,R1:R0 ; 2 / 3
ret
fdw SWOP_L
; SQRT ( u -- u' ) 16-bit square root
; no rounding, no remainder on stack
SQUAREROOT_L:
.db NFA|4,"sqrt",0xff
;SQUAREROOT:
movw t1t0,TOP
clr tosl
ldi tosh,0x80
SQRT_loop:
eor tosl,tosh
mul tosl,tosl
cp t0,R0
cpc t1,R1
brcc PC+2
eor tosl,tosh
lsr tosh
brne SQRT_loop
ret
.if optimizingCOMPILER == 1
cSTAR_0: ; inline code for 'cLIT *'
movw t7t6,TOP
mul t0,t6
movw TOP,R1:R0
mul t0,t7
add tosh,R0 ; 5 / 7
ret
.endif
fdw PLUS_L
; 16 x 16 bit to 16 bit multiply
STAR_L:
.db NFA|INLINE5|1,"*"
STAR:
pop_t1t0
STAR_0:
movw t7t6,TOP
mul t0,t6
movw TOP,R1:R0
mul t1,t6
add tosh,R0
mul t0,t7 ; 7 / 10 for 'LIT *'
add tosh,R0 ; 9 / 14
ret
fdw outerINDEX_L
; i ( -- index R: limit index -- limit index )
innerINDEX_L:
.db NFA|0x20|1,"i"
;innerINDEX: ; ++++ must be inlined ++++
pushtos
in ZL,SPL
in ZH,SPH
ldd tosl,Z+2 ; index
ldd tosh,Z+1 ; 6 / 10
ret
fdw LEFTBRACKET_L
; j ( -- index' R: limit' index' limit index -- limit' index' limit index )
outerINDEX_L:
.db NFA|0x20|1,"j"
;outerINDEX: ; ++++ must be inlined ++++
pushtos
in ZL,SPL
in ZH,SPH
ldd tosl,Z+6 ; index'
ldd tosh,Z+5 ; 6 / 10
ret
fdw SPACE_L
; SIGN? ( addr n -- addr' n' f ) get optional sign (n<0x100)
; + leaves $0000 flag
; - leaves $0002 flag
SIGNQ_L:
.db NFA|5,"sign?"
;SIGNQ:
ldd ZL,Y+0 ; addr
ldd ZH,Y+1
mov t0,tosl ; n
pushtos ; OVER c@
;call CFETCH_Zplus
ld tosl,Z+ ; in RAM
subi tosl,'+'
breq SIGNQIS
cpi tosl,2 ; '-'
breq SIGNQIS
clr tosl
;ldi tosh,0x00 ; (unchanged)
ret
SIGNQIS:
std Y+3,ZH ; addr'
std Y+2,ZL
dec t0
;std Y+1,r_zero ; (unchanged)
std Y+0,t0 ; n'
;ldi tosh,0x00 ; (unchanged)
ret
fdw TOR_L
TO_A_L:
.db NFA|INLINE|2, ">a",0xff
TO_A:
movw A,TOP
poptos ; 3 / 5
ret
fdw BL_L
A_FROM_L:
.db NFA|INLINE|2, "a>",0xff
;A_FROM:
pushtos
;A_FROM_0:
movw TOP,A ; 3 / 5
ret
; .db NFA|INLINE|3,"?0="
ZEROSENSE:
or tosh,tosl
poptos ; 3 / 5
ret
; PAD ( -- a-addr ) user pad buffer
fdw PCSTORE_L
PAD_L:
.db NFA|3,"pad"
;PAD:
pushtos
rcall PAD_pushed
movw TOP,t1t0
ret
PAD_pushed:
movw X,UP ; TIB
sbiw X,(-utib) ; ( TIU @ )
ld t0,X+
ld t1,X+
ld ZL,X+ ; TIBSIZE
ld ZH,X+ ; ( TASK @ 8 + @ )
adiw Z,8
sub_pflash_z
lpm t4,Z+
lpm t5,Z+
add t0,t4 ; +
adc t1,t5
ret ; 13 / 22+4
fdw BSLASH_L
; [ ( -- ) enter interpretive state
LEFTBRACKET_L:
.db NFA|IMMED|1,"["
;LEFTBRACKET:
cbr FLAGS2,(1<<fSTATE)
ret
fdw RX0_L
; RP@ fetch the return stack pointer
RPFETCH_L:
.db NFA|INLINE|COMPILE|3,"rp@"
;RPFETCH:
pushtos
in tosl,spl
in tosh,sph ; 4 / 6
ret
fdw CHAR_L
; CELL ( -- n ) size of one cell
CELL_L:
.db NFA|INLINE4|4,"cell",0xff
;CELL:
pushtos
;CELL_0:
ldi tosl,2
ldi tosh,0 ; 4 / 6
ret
fdw DECIMAL_L
; ALIGNED ( addr -- a-addr ) align given addr
ALIGNED_L:
.db NFA|INLINE|7,"aligned"
;ALIGNED:
adiw TOP,1
cbr tosl,1 ; 2 / 3
ret
fdw CELLS_L
; CELL+ ( a-addr1 -- a-addr2 ) add cell size
; 2 + ;
CELLPLUS_L:
.db NFA|INLINE|5,"cell+"
;CELLPLUS:
adiw TOP,2 ; 1 / 2
ret
fdw CHARPLUS_L
; CELLS ( n1 -- n2 ) cells->adrs units
CELLS_L:
.db NFA|INLINE|5,"cells"
;CELLS:
lsl tosl
rol tosh ; 2 / 2
ret
fdw CHARS_L
; CHAR+ ( c-addr1 -- c-addr2 ) add char size
CHARPLUS_L:
.db NFA|INLINE|5,"char+"
;CHARPLUS:
adiw TOP,1 ; 1 / 2
ret
fdw CMOVE_L
; CHARS ( n1 -- n2 ) chars->adrs units
CHARS_L:
.db NFA|INLINE|5,"chars"
;CHARS:
ret
fdw RIGHTBRACKET_L
; \ skip the rest of the line
BSLASH_L:
.db NFA|IMMED|1,0x5c
;BSLASH:
movw Z,UP
sbiw Z,(-(usource+2))
ld t0,Z+
ld t1,Z+
;adiw Z,<..utoin> ; Z already at utoin
st Z+,t0
st Z+,t1
cbr FLAGS1,(1<<doclear) ; don't clear flags in case of \
ret
fdw MEMHI_L
; ei ( -- ) enable interrupts
EI_L:
.db NFA|INLINE|2,"ei",0xff
sei ; 1 / 1
ret
fdw DO_L
; di ( -- ) disable interrupts
DI_L:
.db NFA|INLINE|2,"di",0xff
cli ; 1 / 1
ret
fdw SIGNQ_L
; RSAVE ( -- a-addr ) saved return stack pointer
RSAVE_L:
.db NFA|INLINE4|5,"rsave"
;RSAVE_:
inline_DOUSER ursave ; 4 / 7
ret
fdw UNTIL_L
; ULINK ( -- a-addr ) link to next task
ULINK_L:
.db NFA|INLINE4|5,"ulink"
;ULINK_:
inline_DOUSER ulink ; 4 / 7
ret
fdw THEN_L
; TASK ( -- a-addr ) TASK pointer
TASK_L:
.db NFA|INLINE4|4,"task",0xff
;TASK:
inline_DOUSER utask ; 4 / 7
ret
fdw ICOMMA_L
; HP ( -- a-addr ) HOLD pointer
HP_L:
.db NFA|INLINE|2,"hp",0xff
;HP:
pushtos
movw TOP,UP ; 3 / 5
;sbiw TOP,(-uhp) ; uhp = 0
ret
fdw DOTS_L
DOTQUOTE_L:
.db NFA|IMMED|COMPILE|2,".",0x22,0xff
;DOTQUOTE:
rcall SQUOTE
rcall DOCOMMAXT
fdw TYPE
ret
.if IDLE_MODE == 0
fdw CELL_L
.elif IDLE_MODE == 1
fdw BUSY_L
.else .error "illegal value: IDLE_MODE"
.endif
; BASE ( -- a-addr ) holds conversion radix
BASE_L:
.db NFA|INLINE4|4,"base",0xff
;BASE:
inline_DOUSER ubase ; 4 / 7
ret
fdw USER_L
; umin ( u1 u2 -- u ) unsigned minimum
; 2DUP U> IF SWAP THEN DROP ;
UMIN_L:
.db NFA|INLINE5|4,"umin",0xff
UMIN:
pop_t1t0
UMIN_0:
cp tosl,t0
cpc tosh,t1
brcs PC+2