-
Notifications
You must be signed in to change notification settings - Fork 65
/
forth.asm
5445 lines (4533 loc) · 122 KB
/
forth.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
; STM8EF for STM8S (Value line and Access Line devices)
;
; This is derived work based on
; http://www.forth.org/svfig/kk/07-2010.html
;
; Please refer to LICENSE.md for more information.
;
;--------------------------------------------------------
; Original author, and copyright:
; STM8EF, Version 2.1, 13jul10cht
; Copyright (c) 2000
; Dr. C. H. Ting
; 156 14th Avenue
; San Mateo, CA 94402
; (650) 571-7639
;
; Original main description:
; FORTH Virtual Machine:
; Subroutine threaded model
; SP Return stack pointer
; X Data stack pointer
; A,Y Scratch pad registers
;
;--------------------------------------------------------
; The latest version of this code is available at
; https://github.com/TG9541/stm8ef
;
;
; Docs for the SDCC integrated assembler are scarce, thus
; SDCC was used to write the sceleton for this file.
; Hoever, the assembly doesn't constitue SDCC code.
;--------------------------------------------------------
; File Created by SDCC : free open source ANSI-C Compiler
; Version 3.6.0 #9615 (Linux)
;--------------------------------------------------------
.module forth
.optsdcc -mstm8
;--------------------------------------------------------
; Public variables in this module
;--------------------------------------------------------
.globl _TRAP_Handler
.globl _EXTI0_IRQHandler
.globl _EXTI1_IRQHandler
.globl _EXTI2_IRQHandler
.globl _EXTI3_IRQHandler
.globl _TIM2_UO_IRQHandler
.globl _TIM4_IRQHandler
.globl _forth
;--------------------------------------------------------
; ram data
;--------------------------------------------------------
.area DATA
;--------------------------------------------------------
; ram data
;--------------------------------------------------------
.area INITIALIZED
;--------------------------------------------------------
; absolute external ram data
;--------------------------------------------------------
.area DABS (ABS)
;--------------------------------------------------------
; global & static initialisations
;--------------------------------------------------------
.area HOME
.area GSINIT
.area GSFINAL
.area GSINIT
;--------------------------------------------------------
; Home
;--------------------------------------------------------
.area HOME
.area HOME
;--------------------------------------------------------
; code
;--------------------------------------------------------
.area CODE
;************************************
;****** 1) General Constants ******
;************************************
VER = 2 ; Version major release version
EXT = 2 ; Version minor extension
TRUEE = 0xFFFF ; true flag
COMPO = 0x40 ; lexicon compile only bit
IMEDD = 0x80 ; lexicon immediate bit
MASKK = 0x1F7F ; lexicon bit mask
TIBLENGTH = 80 ; size of TIB (starting at TIBOFFS)
PADOFFS = 80 ; offset text buffer above dictionary
CELLL = 2 ; size of a cell
BASEE = 10 ; default radix
BKSPP = 8 ; backspace
LF = 10 ; line feed
PACE = 11 ; pace character for host handshake (ASCII VT)
CRR = 13 ; carriage return
ERR = 27 ; error escape
TIC = 39 ; tick
EXIT_OPC = 0x81 ; RET opcode
DOLIT_OPC = 0x83 ; TRAP opcode as DOLIT
CALLR_OPC = 0xAD ; CALLR opcode for relative addressing
BRAN_OPC = 0xCC ; JP opcode
CALL_OPC = 0xCD ; CALL opcode
STM8S003F3 = 103 ; 8K flash, 1K RAM, 128 EEPROM, UART1
STM8S103F3 = 103 ; like STM8S003F3, 640 EEPROM
STM8S105K4 = 105 ; 16K flash, 2K RAM, 1K EEPROM, UART2
STM8S105C6 = 105 ; 32K flash, 2K RAM, 1K EEPROM, UART2
;********************************************
;****** 2) Device hardware addresses ******
;********************************************
;****** STM8S memory addresses ******
RAMBASE = 0x0000 ; STM8S RAM start
EEPROMBASE = 0x4000 ; STM8S EEPROM start
; STM8 device specific include (provided by file in board folder)
; sets "TARGET" and memory layout
.include "target.inc"
; STM8 unified register addresses (depends on "TARGET")
.include "stm8device.inc"
;**********************************
;****** 3) Global defaults ******
;**********************************
; Note: add defaults for new features here but
; configure them in globconf.inc
TERM_LINUX = 1 ; LF terminates line
HALF_DUPLEX = 0 ; Use EMIT/?KEY in half duplex mode
HAS_TXUART = 1 ; Enable UART TXD, word TX!
HAS_RXUART = 1 ; Enable UART RXD, word ?RX
HAS_TXSIM = 0 ; Enable TxD via GPIO/TIM4, word TXGP!
HAS_RXSIM = 0 ; Enable RxD via GPIO/TIM4, word ?RXGP
PSIM = PORTX ; Port for UART simulation
PNRX = 1 ; Port GPIO# for HAS_RXDSIM
PNTX = 1 ; Port GPIO# for HAS_TXDSIM
EMIT_BG = DROP ; TODO: vectored NUL background EMIT vector
QKEY_BG = ZERO ; TODO: NUL background QKEY vector
HAS_LED7SEG = 0 ; 7-seg LED display, number of groups (0: none)
LEN_7SGROUP = 3 ; default: 3 dig. 7-seg LED
HAS_KEYS = 0 ; Board has keys
HAS_OUTPUTS = 0 ; Board outputs, e.g. relays
HAS_INPUTS = 0 ; Board digital inputs
HAS_ADC = 0 ; Board analog inputs
HAS_BACKGROUND = 0 ; Background Forth task (TIM2 ticker)
BG_TIM2_REL = 0x26DE ; Reload value for TIM2 background ticker (default 0x26DE @ 5ms HSE)
BG_RUNMASK = 0 ; BG task runs if "(BG_RUNMASK AND TICKCNT) equals 0"
HAS_CPNVM = 0 ; Can compile to Flash, always interpret to RAM
HAS_DOES = 0 ; DOES> extension
HAS_DOLOOP = 0 ; DO .. LOOP extension: DO LEAVE LOOP +LOOP
HAS_ALIAS = 0 ; NAME> resolves "alias" (RigTig style), aliases can be in RAM
USE_CALLDOLIT = 0 ; use CALL DOLIT instead of the DOLIT TRAP handler (deprecated)
CASEINSENSITIVE = 0 ; Case insensitive dictionary search
SPEEDOVERSIZE = 0 ; Speed-over-size in core words ROT - = < -1 0 1
BAREBONES = 0 ; Remove or unlink some more: hi HERE .R U.R SPACES @EXECUTE AHEAD CALL, EXIT COMPILE [COMPILE] DEPTH
NO_VARIABLE = 0 ; Disable VARIABLE and feature "VARIABLE in Flash allocates RAM"
WORDS_LINKINTER = 0 ; Link interpreter words: ACCEPT QUERY TAP kTAP hi 'BOOT tmp >IN 'TIB #TIB eval CONTEXT pars PARSE NUMBER? DIGIT? WORD TOKEN NAME> SAME? find ABORT aborq $INTERPRET INTER? .OK ?STACK EVAL PRESET QUIT $COMPILE
WORDS_LINKCOMP = 0 ; Link compiler words: cp last OVERT $"| ."| $,n
WORDS_LINKRUNTI = 0 ; Link runtime words: doLit do$ doVAR donxt dodoes ?branch branch
WORDS_LINKCHAR = 0 ; Link char out words: DIGIT <# # #S SIGN #> str hld HOLD PACK$
WORDS_LINKMISC = 0 ; Link composing words of SEE DUMP WORDS: >CHAR _TYPE dm+ .ID >NAME
WORDS_EXTRASTACK = 0 ; Link/include stack core words: rp@ rp! sp! sp@
WORDS_EXTRADEBUG = 0 ; Extra debug words: SEE
WORDS_EXTRACORE = 0 ; Extra core words: =0 I
WORDS_EXTRAMEM = 0 ; Extra memory words: B! 2C@ 2C!
WORDS_EXTRAEEPR = 0 ; Extra EEPROM lock/unlock words: LOCK ULOCK ULOCKF LOCKF
WORDS_HWREG = 0 ; Peripheral Register words
;**********************************************
;****** 4) Device dependent features ******
;**********************************************
; Define memory location for device dependent features here
.include "globconf.inc"
;************************************************
;****** 5) Board Driver Memory ******
;************************************************
; Memory for board related code, e.g. interrupt routines
RAMPOOL = FORTHRAM ; RAM for variables (growing up)
.macro RamByte varname
varname = RAMPOOL
RAMPOOL = RAMPOOL + 1
.endm
.macro RamWord varname
varname = RAMPOOL
RAMPOOL = RAMPOOL + 2
.endm
.macro RamBlck varname, size
varname = RAMPOOL
RAMPOOL = RAMPOOL + size
.endm
;****** Board variables ******
.ifne HAS_OUTPUTS
RamWord OUTPUTS ; outputs, like relays, LEDs, etc. (16 bit)
.endif
.ifne HAS_TXSIM ;+ HAS_RXSIM
RamByte TIM4TCNT ; TIM4 RX/TX interrupt counter
RamByte TIM4TXREG ; TIM4 TX transmit buffer and shift register
RamByte TIM4RXREG ; TIM4 RX shift register
RamByte TIM4RXBUF ; TIM4 RX receive buffer
.endif
.ifne HAS_BACKGROUND
.ifne HAS_LED7SEG
.if gt,(HAS_LED7SEG-1)
RamByte LED7GROUP ; index [0..(HAS_LED7SEG-1)] of 7-SEG digit group
.endif
DIGITS = HAS_LED7SEG*LEN_7SGROUP
RamBlck LED7FIRST,DIGITS ; leftmost 7S-LED digit
LED7LAST = RAMPOOL-1 ; save memory location of rightmost 7S-LED digit
.endif
RamWord BGADDR ; address of background routine (0: off)
RamWord TICKCNT ; 16 bit ticker (counts up)
.ifne HAS_KEYS
RamByte KEYREPET ; board key repetition control (8 bit)
.endif
BSPPSIZE = 32 ; Size of data stack for background tasks
PADBG = 0x5F ; PAD in background task growing down from here
.else
BSPPSIZE = 0 ; no background, no extra data stack
.endif
;**************************************************
;****** 6) General User & System Variables ******
;**************************************************
; ****** Indirect variables for code in NVM *****
.ifne HAS_CPNVM
ISPPSIZE = 16 ; Size of data stack for interrupt tasks
.else
ISPPSIZE = 0 ; no interrupt tasks without NVM
.endif
UPP = UPPLOC ; offset user area
CTOP = CTOPLOC ; dictionary start, growing up
; note: PAD is inbetween CTOP and SPP
SPP = ISPP-ISPPSIZE ; data stack, growing down (with SPP-1 first)
ISPP = SPPLOC-BSPPSIZE ; Interrupt data stack, growing down
BSPP = SPPLOC ; Background data stack, growing down
TIBB = SPPLOC ; Term. Input Buf. TIBLENGTH between SPPLOC and RPP
RPP = RPPLOC ; return stack, growing down
; Core variables (same order as 'BOOT initializer block)
USRRAMINIT = USREMIT
USREMIT = UPP+0 ; excection vector of EMIT
USRQKEY = UPP+2 ; excection vector of QKEY
USRBASE = UPP+4 ; radix base for numeric I/O
USREVAL = UPP+6 ; execution vector of EVAL
USRPROMPT = UPP+8 ; point to prompt word (default .OK)
USRCP = UPP+10 ; point to top of dictionary
USRLAST = UPP+12 ; currently last name in dictionary (init: to LASTN)
NVMCP = UPP+14 ; point to top of dictionary in Non Volatile Memory
; Null initialized core variables (growing down)
USRCTOP = UPP+16 ; point to the start of RAM dictionary
USRVAR = UPP+18 ; point to next free USR RAM location
NVMCONTEXT = UPP+20 ; point to top of dictionary in Non Volatile Memory
USRCONTEXT = UPP+22 ; start vocabulary search
USRHLD = UPP+24 ; hold a pointer of output string
USRNTIB = UPP+26 ; count in terminal input buffer
USR_IN = UPP+28 ; hold parsing pointer
YTEMP = UPP+30 ; extra working register for core words
;***********************
;****** 7) Code ******
;***********************
; TRAP handler for DOLIT
; Push the inline literal following the TRAP instruction
_TRAP_Handler:
.ifeq USE_CALLDOLIT
DECW X
DECW X
LDW (3,SP),X ; XH,XL
EXGW X,Y
LDW X,(8,SP) ; PC MSB/LSB
LDW X,(X)
LDW (Y),X
LDW (5,SP),X ; YH,YL
LDW X,(8,SP)
INCW X
INCW X
LDW (8,SP),X
IRET
; Macros for inline literals using the TRAP approach
.macro DoLitC c
TRAP
.dw c
.endm
.macro DoLitW w
TRAP
.dw w
.endm
.else
; Macros for inline literals using CALL DOLIT / CALL DOLITC
.macro DoLitC c
call DOLITC
.db c
.endm
.macro DoLitW w
call DOLIT
.dw w
.endm
.endif
; TIM2 interrupt handler for background task
_TIM2_UO_IRQHandler:
.ifne (HAS_LED7SEG + HAS_BACKGROUND)
BRES TIM2_SR1,#0 ; clear TIM2 UIF
.ifne HAS_LED7SEG
CALL LED_MPX ; board dependent code for 7Seg-LED-Displays
.endif
; Background operation saves & restores the context of the interactive task
; Cyclic context reset of Forth background task (stack, BASE, HLD, I/O vector)
.ifne HAS_BACKGROUND
LDW X,TICKCNT
INCW X
LDW TICKCNT,X
; fall through
.ifne BG_RUNMASK
LD A,XL ; Background task runs if "(BG_RUNMASK AND TICKCNT) equals 0"
AND A,#BG_RUNMASK
JRNE TIM2IRET
.endif
LDW Y,BGADDR ; address of background task
TNZW Y ; 0: background operation off
JREQ TIM2IRET
LDW X,YTEMP ; Save context
PUSHW X
PUSH USRBASE+1 ; 8bit since BASE should be < 36
MOV USRBASE+1,#10
LDW X,USREMIT ; save EMIT exection vector
PUSHW X
LDW X,#(EMIT_BG)
LDW USREMIT,X
LDW X,USRQKEY ; save QKEY exection vector
PUSHW X
LDW X,#(QKEY_BG)
LDW USRQKEY,X
LDW X,USRHLD
PUSHW X
LDW X,#(PADBG) ; in background task, alway start with an empty PAD
LDW USRHLD,X
LDW X,#(BSPP) ; init data stack for background task to BSPP
CALL (Y)
POPW X
LDW USRHLD,X
POPW X
LDW USRQKEY,X
POPW X
LDW USREMIT,X
POP USRBASE+1
POPW X
LDW YTEMP,X
TIM2IRET:
.endif
IRET
.endif
; ==============================================
; Main entry points and COLD start data
; COLD ( -- )
; The hilevel cold start sequence.
.dw 0
LINK = .
.db 4
.ascii "COLD"
_forth: ; SDCC entry
; Note: no return to main.c possible unless RAMEND equals SP,
; and RPP init skipped
COLD:
SIM ; disable interrupts
MOV CLK_CKDIVR,#0 ; Clock divider register
LDW X,#(RAMEND-FORTHRAM)
1$: CLR (FORTHRAM,X)
DECW X
JRPL 1$
LDW X,#RPP ; initialize return stack
LDW SP,X
CALLR BOARDINIT ; Board initialization (see "boardcore.inc")
.ifne HAS_BACKGROUND
; init BG timer interrupt
MOV ITC_SPR4,#0xF7 ; Interrupt prio. low for TIM2 (Int13)
MOV TIM2_PSCR,#0x03 ; prescaler 1/8
MOV TIM2_ARRH,#(BG_TIM2_REL/256) ; reload H
MOV TIM2_ARRL,#(BG_TIM2_REL%256) ; L
MOV TIM2_CR1,#0x01 ; enable TIM2
MOV TIM2_IER,#0x01 ; enable TIM2 interrupt
.endif
.ifne HAS_RXUART+HAS_TXUART
; Init RS232 communication port
; STM8S[01]003F3 init UART
LDW X,#0x6803 ; 9600 baud
LDW UART_BRR1,X ;
.ifne HAS_RXUART*HAS_TXUART
MOV UART_CR2,#0x0C ; Use UART1 full duplex
.else
.ifne HAS_TXUART
MOV UART_CR2,#0x08 ; UART1 enable tx
.endif
.ifne HAS_RXUART
MOV UART_CR2,#0x04 ; UART1 enable rx
.endif
.endif
.endif
.ifne HAS_RXSIM+HAS_TXSIM
; TIM4 based RXD or TXD: initialize timer
TIM4RELOAD = 0xCF ; reload 0.104 ms (9600 baud)
MOV TIM4_ARR,#TIM4RELOAD
MOV TIM4_PSCR,#0x03 ; prescaler 1/8
MOV TIM4_CR1,#0x01 ; enable TIM4
.ifne PNRX^PNTX
HALF_DUPLEX_SIM = 0 ; is there no better way to do "!=" in ASxxxx 2.x?
.else
HALF_DUPLEX_SIM = 1 ; Half-duplex RxTx if GPIO is shared
.endif
.endif
.ifne HAS_TXSIM*((PNRX-PNTX)+(1-HAS_RXSIM))
; init TxD through GPIO if not shared pin with PNRX
BSET PSIM+DDR,#PNTX ; PNTX GPIO output
BSET PSIM+CR1,#PNTX ; enable PNTX push-pull
.endif
.ifne (HAS_RXSIM)
; init RxD through GPIO
.ifeq (PSIM-PORTA)
BSET EXTI_CR1,#1 ; External interrupt Port A falling edge
.else
.ifeq (PSIM-PORTB)
BSET EXTI_CR1,#3 ; External interrupt Port B falling edge
.else
.ifeq (PSIM-PORTC)
BSET EXTI_CR1,#5 ; External interrupt Port C falling edge
.else
BSET EXTI_CR1,#7 ; External interrupt Port D falling edge
.endif
.endif
.endif
BRES PSIM+DDR,#PNRX ; 0: input (default)
BSET PD_CR1,#PNRX ; enable PNRX pull-up
BSET PSIM+CR2,#PNRX ; enable PNRX external interrupt
.endif
CALL PRESE ; initialize data stack, TIB
DoLitW UZERO
DoLitC USRRAMINIT
DoLitC (ULAST-UZERO)
CALL CMOVE ; initialize user area
.ifne HAS_CPNVM
EXGW X,Y
LDW X,USRCP ; reserve some space for user variable
LDW USRVAR,X
ADDW X,#32
LDW USRCP,X
LDW USRCTOP,X ; store new CTOP
EXGW X,Y
.endif
.ifne HAS_OUTPUTS
CALL ZERO
CALL OUTSTOR
.endif
.ifne HAS_LED7SEG
.if gt,(HAS_LED7SEG-1)
MOV LED7GROUP,#0 ; one of position HAS_LED7SEG 7-SEG digit groups
.endif
MOV LED7FIRST ,#0x66 ; 7S LEDs 4..
MOV LED7FIRST+1,#0x78 ; 7S LEDs .t.
MOV LED7FIRST+2,#0x74 ; 7S LEDs ..h
.endif
; Hardware initialization complete
RIM ; enable interrupts
CALL [TBOOT+3] ; application boot
CALL OVERT ; initialize CONTEXT from USRLAST
JP QUIT ; start interpretation
; ##############################################
; Include for board support code
; Board I/O initialization and E/E mapping code
; Hardware dependent words, e.g. BKEY, OUT!
.include "boardcore.inc"
; ##############################################
; 'BOOT ( -- a )
; The application startup vector and NVM USR setting array
.ifne (WORDS_LINKINTER + HAS_CPNVM)
.dw LINK
LINK = .
.db 5
.ascii "'BOOT"
.endif
TBOOT:
CALL DOVAR
UBOOT = .
.dw HI ;application to boot
; COLD start initiates these variables.
UZERO = .
.ifge (HAS_TXUART-HAS_TXSIM)
.dw TXSTOR ; TX! as EMIT vector
.dw QRX ; ?KEY as ?KEY vector
.else
.dw TXPSTOR ; TXP! as EMIT vector if (HAS_TXSIM > HAS_TXUART)
.dw QRXP ; ?RXP as ?KEY vector
.endif
.dw BASEE ; BASE
.dw INTER ; 'EVAL
.dw DOTOK ; 'PROMPT
COLDCTOP = .
.dw CTOP ; CP in RAM
COLDCONTEXT = .
.dw LASTN ; USRLAST
.ifne HAS_CPNVM
COLDNVMCP = .
.dw END_SDCC_FLASH ; CP in NVM
ULAST = .
; Second copy of USR setting for NVM reset
UDEFAULTS = .
.dw HI ; 'BOOT
.ifge (HAS_TXUART-HAS_TXSIM)
.dw TXSTOR ; TX! as EMIT vector
.dw QRX ; ?KEY as ?KEY vector
.else
.dw TXPSTOR ; TXP! as EMIT vector
.dw QRXP ; ?RXP as ?KEY vector
.endif
.dw BASEE ; BASE
.dw INTER ; 'EVAL
.dw DOTOK ; 'PROMPT
.dw CTOP ; CP in RAM
.dw LASTN ; CONTEXT pointer
.dw END_SDCC_FLASH ; CP in NVM
.else
ULAST = .
.endif
.ifeq BAREBONES
; hi ( -- )
; Display sign-on message.
.ifne (WORDS_LINKINTER + HAS_CPNVM)
.dw LINK
LINK = .
.db 2
.ascii "hi"
.endif
HI:
CALLR 1$ ; CR
CALL DOTQP ; initialize I/O
.db 15
.ascii "stm8eForth v"
.db (VER+'0')
.ascii "."
.db (EXT+'0') ; version
1$: JP CR
.endif
; ==============================================
; Device dependent I/O
.ifne HAS_RXUART
; ?RX ( -- c T | F ) ( TOS STM8: -- Y,Z,N )
; Return serial interface input char from and true, or false.
.ifeq BAREBONES
.dw LINK
LINK = .
.db 3
.ascii "?RX"
.endif
QRX:
CLR A ; A: flag false
BTJF UART_SR,#5,1$
LD A,UART_DR ; get char in A
1$: JP ATOKEY ; push char or flag false
.endif
.ifne HAS_TXUART
; TX! ( c -- )
; Send character c to the serial interface.
.ifeq BAREBONES
.dw LINK
LINK = .
.db 3
.ascii "TX!"
.endif
TXSTOR:
INCW X
LD A,(X)
INCW X
.ifne HALF_DUPLEX * (1-HAS_TXSIM)
; HALF_DUPLEX with normal UART (e.g. wired-or Rx and Tx)
BRES UART_CR2,#2 ; disable rx
1$: BTJF UART_SR,#7,1$ ; loop until tdre
LD UART_DR,A ; send A
2$: BTJF UART_SR,#6,2$ ; loop until tc
BSET UART_CR2,#2 ; enable rx
.else ; not HALF_DUPLEX
1$: BTJF UART_SR,#7,1$ ; loop until tdre
LD UART_DR,A ; send A
.endif
RET
.endif
.ifne HAS_RXSIM
; ?RXP ( -- c T | F ) ( TOS STM8: -- Y,Z,N )
; Return char from a simulated serial interface and true, or false.
.ifeq BAREBONES
.dw LINK
LINK = .
.ifne HAS_RXUART
.db 4
.ascii "?RXP"
.else
.db 3
.ascii "?RX"
.endif
.endif
.ifeq HAS_RXUART
QRX:
.endif
QRXP:
CLR A
EXG A,TIM4RXBUF ; read and consume char
JP ATOKEY
.endif
.ifne HAS_TXSIM
; TXP! ( c -- )
; Send character c to a simulated serial interface.
.ifeq BAREBONES
.dw LINK
LINK = .
.ifne HAS_TXUART
.db 4
.ascii "TXP!"
.else
.db 3
.ascii "TX!"
.endif
.endif
.ifeq HAS_TXUART
TXSTOR:
.endif
TXPSTOR:
INCW X
LD A,(X)
INCW X
1$: TNZ TIM4TCNT
JRNE 1$ ; wait for free TIM4 RX-TX
.ifne HALF_DUPLEX_SIM
BRES PSIM+CR2,#PNRX ; disable PNRX external interrupt
.endif
LD TIM4TXREG,A ; char to TXSIM output register
MOV TIM4TCNT,#10 ; init next transfer
CLR TIM4_CNTR ; reset TIM4, trigger update interrupt
BSET TIM4_IER,#0 ; enable TIM4 interrupt
RET
.endif
; RxD through GPIO start-bit interrupt handler
.ifne HAS_RXSIM
.ifeq PSIM-PORTA
_EXTI0_IRQHandler:
.endif
.ifeq PSIM-PORTB
_EXTI1_IRQHandler:
.endif
.ifeq PSIM-PORTC
_EXTI2_IRQHandler:
.endif
.ifeq PSIM-PORTD
_EXTI3_IRQHandler:
.endif
BRES PSIM+CR2,#PNRX ; disable PNRX external interrupt
; Set-up TIM4 for 8N1 Rx sampling at half bit time
MOV TIM4TCNT,#(-9) ; set sequence counter for RX
MOV TIM4_CNTR,#(TIM4RELOAD/2)
BRES TIM4_SR,#0 ; clear TIM4 UIF
BSET TIM4_IER,#0 ; enable TIM4 interrupt
IRET
.endif
_TIM4_IRQHandler:
; TODO: reset the µC if a unepected interrupt occurs?
.ifne HAS_RXSIM+HAS_TXSIM
; TIM4 interrupt handler for software Rx/Tx or half-duplex Rx+Tx
;BCPL PC_ODR,#4 ; pin debug
BRES TIM4_SR,#0 ; clear TIM4 UIF
LD A,TIM4TCNT ; TIM4CNT is the step counter
JRMI TIM4_RECVE ; negative index: receive
JRNE TIM4_TRANS ; positive index: transmit
; TIM4CNT is zero
TIM4_OFF:
.ifne HALF_DUPLEX_SIM
BSET PSIM+CR2,#PNRX ; enable PNRX external interrupt
BRES PSIM+DDR,#PNRX ; set shared GPIO to input
.endif
BRES TIM4_IER,#0 ; disable TIM4 interrupt
IRET
TIM4_RECVE:
BTJT PSIM+IDR,#PNRX,1$ ; dummy branch, copy GPIO to CF
1$: RRC TIM4RXREG
INC TIM4TCNT
JRNE TIM4_END
MOV TIM4RXBUF,TIM4RXREG ; save result (CF is now start-bit)
.ifeq HALF_DUPLEX_SIM
BSET PSIM+CR2,#PNRX ; enable PNRX external interrupt
.endif
JRA TIM4_OFF
TIM4_TRANS:
CP A,#10 ; test if startbit (coincidentially set CF)
JRNE TIM4_SER
.ifne HALF_DUPLEX_SIM
BSET PSIM+DDR,#PNRX ; port PD1=PNRX to output
.endif
JRA TIM4_BIT ; emit start bit (CF=0 from CP)
TIM4_SER:
RRC TIM4TXREG ; get data bit, shift in stop bit (CF=1 from CP)
; fall through
TIM4_BIT:
BCCM PSIM+ODR,#PNTX ; Set GPIO to CF
DEC TIM4TCNT ; next TXD TIM4 state
JREQ TIM4_OFF ; complete when TIM4CNT is zero
; fall through
TIM4_END:
IRET
.endif
; ?KEY ( -- c T | F ) ( TOS STM8: -- Y,Z,N )
; Return input char and true, or false.
.dw LINK
LINK = .
.db 4
.ascii "?KEY"
QKEY:
JP [USRQKEY]
; EMIT ( c -- )
; Send character c to output device.
.dw LINK
LINK = .
.db 4
.ascii "EMIT"
EMIT:
JP [USREMIT]
; ==============================================
; The kernel
; PUSHLIT ( -- C )
; Subroutine for DOLITC and CCOMMALIT
PUSHLIT:
LDW Y,(3,SP)
DECW X ; LSB = literal
LD A,(Y)
LD (X),A
DECW X ; MSB = 0
CLR A
LD (X),A
RET
; CCOMMALIT ( -- )
; Compile inline literall byte into code dictionary.
CCOMMALIT:
CALLR PUSHLIT
CALL CCOMMA
CSKIPRET:
POPW Y
JP (1,Y)
.ifne USE_CALLDOLIT
; DOLITC ( -- C )
; Push an inline literal character (8 bit).
DOLITC:
CALLR PUSHLIT
JRA CSKIPRET
; doLit ( -- w )
; Push an inline literal.
.ifne WORDS_LINKRUNTI
.dw LINK
LINK = .
.db (COMPO+5)
.ascii "doLit"
.endif
DOLIT:
DECW X ;SUBW X,#2
DECW X
LDW Y,(1,SP)
LDW Y,(Y)
LDW (X),Y
JRA POPYJPY
.endif
.ifne HAS_DOLOOP
; (+loop) ( +n -- )
; Add n to index R@ and test for lower than limit (R-CELL)@.
.ifne WORDS_LINKRUNTI
.dw LINK
LINK = .
.db (COMPO+7)
.ascii "(+loop)"
.endif
DOPLOOP:
LDW Y,(5,SP)
LDW YTEMP,Y
LDW Y,X
LDW Y,(Y)
LD A,YH
INCW X
INCW X
ADDW Y,(3,SP)
CPW Y,YTEMP
PUSH CC
TNZ A
JRMI 1$
POP CC
JRSGE LEAVE
JRA 2$
1$: POP CC
JRSLT LEAVE
2$: LDW (3,SP),Y
JRA BRAN
; LEAVE ( -- )
; Leave a DO .. LOOP/+LOOP loop.
.dw LINK
LINK = .
.db (COMPO+5)
.ascii "LEAVE"
LEAVE:
ADDW SP,#6
POPW Y ; DO leaves the address of +loop on the R-stack
JP (2,Y)
.endif
; next ( -- )
; Code for single index loop.
.ifne WORDS_LINKRUNTI
.dw LINK
LINK = .
.db (COMPO+5)
.ascii "donxt"
.endif
DONXT:
LDW Y,(3,SP)
DECW Y
JRPL NEX1
POPW Y
POP A
POP A
JP (2,Y)
NEX1: LDW (3,SP),Y
JRA BRAN
; QDQBRAN ( n -- n )
; QDUP QBRANCH phrase
QDQBRAN:
CALL QDUP
JRA QBRAN
; ?branch ( f -- )
; Branch if flag is zero.
.ifne WORDS_LINKRUNTI
.dw LINK
LINK = .
.db (COMPO+7)
.ascii "?branch"
.endif
QBRAN:
LDW Y,X
INCW X
INCW X
LDW Y,(Y)
JREQ BRAN
POPYJPY:
POPW Y
JP (2,Y)
; branch ( -- )
; Branch to an inline address.