forked from emptymalei/collapseos
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathblk.fs
More file actions
2958 lines (2855 loc) · 92.6 KB
/
blk.fs
File metadata and controls
2958 lines (2855 loc) · 92.6 KB
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
( ----- 000 )
MASTER INDEX
005 Z80 assembler 030 8086 assembler
050 AVR assembler 70-99 unused
100 Block editor 120 Visual Editor
150 Remote Shell
160 AVR SPI programmer 165 Sega ROM signer
170-259 unused 260 Cross compilation
280 Z80 boot code 350 Core words
400 AT28 EEPROM driver 401 Grid subsystem
410 PS/2 keyboard subsystem 418 Z80 SPI Relay driver
420 SD Card subsystem 440 8086 boot code
470 Z80 TMS9918 driver
480-519 unused 520 Fonts
( ----- 005 )
( Z80 Assembler
006 Variables & consts
007 Utils 008 OP1
010 OP1r 012 OP1d
013 OP1rr 015 OP2
016 OP2i 017 OP2ri
018 OP2br 019 OProt
020 OP2r 021 OP2d
022 OP3di 023 OP3i
024 Specials 025 Flow
028 Macros )
1 23 LOADR+
( ----- 006 )
CREATE ORG 0 ,
CREATE BIN( 0 ,
VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4
: A 7 ; : B 0 ; : C 1 ; : D 2 ;
: E 3 ; : H 4 ; : L 5 ; : (HL) 6 ;
: BC 0 ; : DE 1 ; : HL 2 ; : AF 3 ; : SP AF ;
: CNZ 0 ; : CZ 1 ; : CNC 2 ; : CC 3 ;
: CPO 4 ; : CPE 5 ; : CP 6 ; : CM 7 ;
( ----- 007 )
: PC H@ ORG @ - BIN( @ + ;
: <<3 3 LSHIFT ; : <<4 4 LSHIFT ;
( As a general rule, IX and IY are equivalent to spitting an
extra 0xdd / 0xfd and then spit the equivalent of HL )
: IX 0xdd C, HL ; : IY 0xfd C, HL ;
: _ix+- 0xff AND 0xdd C, (HL) ;
: _iy+- 0xff AND 0xfd C, (HL) ;
: IX+ _ix+- ; : IX- 0 -^ _ix+- ;
: IY+ _iy+- ; : IY- 0 -^ _iy+- ;
( ----- 008 )
: OP1 CREATE C, DOES> C@ C, ;
0xf3 OP1 DI, 0xfb OP1 EI,
0xeb OP1 EXDEHL, 0xd9 OP1 EXX,
0x08 OP1 EXAFAF', 0xe3 OP1 EX(SP)HL,
0x76 OP1 HALT, 0xe9 OP1 JP(HL),
0x12 OP1 LD(DE)A, 0x1a OP1 LDA(DE),
0x02 OP1 LD(BC)A, 0x0a OP1 LDA(BC),
0x00 OP1 NOP, 0xc9 OP1 RET,
0x17 OP1 RLA, 0x07 OP1 RLCA,
0x1f OP1 RRA, 0x0f OP1 RRCA,
0x37 OP1 SCF,
( ----- 009 )
( Relative jumps are a bit special. They're supposed to take
an argument, but they don't take it so they can work with
the label system. Therefore, relative jumps are an OP1 but
when you use them, you're expected to write the offset
afterwards yourself. )
0x18 OP1 JR, 0x10 OP1 DJNZ,
0x38 OP1 JRC, 0x30 OP1 JRNC,
0x28 OP1 JRZ, 0x20 OP1 JRNZ,
( ----- 010 )
( r -- )
: OP1r
CREATE C,
DOES>
C@ ( r op )
SWAP ( op r )
<<3 ( op r<<3 )
OR C,
;
0x04 OP1r INCr, 0x05 OP1r DECr,
: INC(IXY+), INCr, C, ;
: DEC(IXY+), DECr, C, ;
( also works for c )
0xc0 OP1r RETc,
( ----- 011 )
: OP1r0 ( r -- )
CREATE C, DOES>
C@ ( r op ) OR C, ;
0x80 OP1r0 ADDr, 0x88 OP1r0 ADCr,
0xa0 OP1r0 ANDr, 0xb8 OP1r0 CPr,
0xb0 OP1r0 ORr, 0x90 OP1r0 SUBr,
0x98 OP1r0 SBCr, 0xa8 OP1r0 XORr,
: CP(IXY+), CPr, C, ;
( ----- 012 )
: OP1d
CREATE C,
DOES>
C@ ( d op )
SWAP ( op d )
<<4 ( op d<<4 )
OR C,
;
0xc5 OP1d PUSH, 0xc1 OP1d POP,
0x03 OP1d INCd, 0x0b OP1d DECd,
0x09 OP1d ADDHLd,
: ADDIXd, 0xdd C, ADDHLd, ; : ADDIXIX, HL ADDIXd, ;
: ADDIYd, 0xfd C, ADDHLd, ; : ADDIYIY, HL ADDIYd, ;
( ----- 013 )
: _1rr
C@ ( rd rr op )
ROT ( rr op rd )
<<3 ( rr op rd<<3 )
OR OR C,
;
( rd rr )
: OP1rr
CREATE C,
DOES>
_1rr
;
0x40 OP1rr LDrr,
( ----- 014 )
( ixy+- HL rd )
: LDIXYr,
( dd/fd has already been spit )
LDrr, ( ixy+- )
C,
;
( rd ixy+- HL )
: LDrIXY,
ROT ( ixy+- HL rd )
SWAP ( ixy+- rd HL )
LDIXYr,
;
( ----- 015 )
: OP2 CREATE , DOES> @ |M C, C, ;
0xeda1 OP2 CPI, 0xedb1 OP2 CPIR,
0xeda9 OP2 CPD, 0xedb9 OP2 CPDR,
0xed46 OP2 IM0, 0xed56 OP2 IM1,
0xed5e OP2 IM2,
0xeda0 OP2 LDI, 0xedb0 OP2 LDIR,
0xeda8 OP2 LDD, 0xedb8 OP2 LDDR,
0xed44 OP2 NEG,
0xed4d OP2 RETI, 0xed45 OP2 RETN,
( ----- 016 )
: OP2i ( i -- )
CREATE C,
DOES>
C@ C, C,
;
0xd3 OP2i OUTiA,
0xdb OP2i INAi,
0xc6 OP2i ADDi,
0xe6 OP2i ANDi,
0xf6 OP2i ORi,
0xd6 OP2i SUBi,
0xee OP2i XORi,
0xfe OP2i CPi,
( ----- 017 )
: OP2ri ( r i -- )
CREATE C,
DOES>
C@ ( r i op )
ROT ( i op r )
<<3 ( i op r<<3 )
OR C, C,
;
0x06 OP2ri LDri,
( ----- 018 )
( b r -- )
: OP2br
CREATE C,
DOES>
0xcb C,
C@ ( b r op )
ROT ( r op b )
<<3 ( r op b<<3 )
OR OR C,
;
0xc0 OP2br SET,
0x80 OP2br RES,
0x40 OP2br BIT,
( ----- 019 )
( bitwise rotation ops have a similar sig )
: OProt ( r -- )
CREATE C,
DOES>
0xcb C,
C@ ( r op )
OR C,
;
0x10 OProt RL,
0x00 OProt RLC,
0x18 OProt RR,
0x08 OProt RRC,
0x20 OProt SLA,
0x38 OProt SRL,
( ----- 020 )
( cell contains both bytes. MSB is spit as-is, LSB is ORed
with r )
( r -- )
: OP2r
CREATE ,
DOES>
@ |M ( r lsb msb )
C, ( r lsb )
SWAP <<3 ( lsb r<<3 )
OR C,
;
0xed41 OP2r OUT(C)r,
0xed40 OP2r INr(C),
( ----- 021 )
: OP2d ( d -- )
CREATE C,
DOES>
0xed C,
C@ SWAP ( op d )
<<4 ( op d<< 4 )
OR C,
;
0x4a OP2d ADCHLd,
0x42 OP2d SBCHLd,
( ----- 022 )
( d i -- )
: OP3di
CREATE C,
DOES>
C@ ( d n op )
ROT ( n op d )
<<4 ( n op d<<4 )
OR C, ,
;
0x01 OP3di LDdi,
( ----- 023 )
( i -- )
: OP3i
CREATE C,
DOES>
C@ C, ,
;
0xcd OP3i CALL,
0xc3 OP3i JP,
0x22 OP3i LD(i)HL, 0x2a OP3i LDHL(i),
0x32 OP3i LD(i)A, 0x3a OP3i LDA(i),
( ----- 024 )
: LDd(i), ( d i -- )
0xed C,
SWAP <<4 0x4b OR C, ,
;
: LD(i)d, ( i d -- )
0xed C,
<<4 0x43 OR C, ,
;
: RST, 0xc7 OR C, ;
: JP(IX), IX DROP JP(HL), ;
: JP(IY), IY DROP JP(HL), ;
( ----- 025 )
: JPc, SWAP <<3 0xc2 OR C, , ;
: BCALL, BIN( @ + CALL, ;
: BJP, BIN( @ + JP, ;
: BJPc, BIN( @ + JPc, ;
CREATE lblchkPS 0 ,
: chkPS, lblchkPS @ CALL, ; ( chkPS, B305 )
CREATE lblnext 0 , ( stable ABI until set in B300 )
: JPNEXT, lblnext @ ?DUP IF JP, ELSE 0x1a BJP, THEN ;
: CODE ( same as CREATE, but with native word )
(entry) 0 C, ( 0 == native ) ;
: ;CODE JPNEXT, ;
( ----- 026 )
( Place BEGIN, where you want to jump back and AGAIN after
a relative jump operator. Just like BSET and BWR. )
: BEGIN,
PC DUP 0x8000 AND IF ABORT" PC must be < 0x8000" THEN ;
: BSET BEGIN, SWAP ! ;
( same as BSET, but we need to write a placeholder )
: FJR, BEGIN, 0 C, ;
: IFZ, JRNZ, FJR, ;
: IFNZ, JRZ, FJR, ;
: IFC, JRNC, FJR, ;
: IFNC, JRC, FJR, ;
: THEN,
DUP PC ( l l pc ) -^ 1- ( l off )
( warning: l is a PC offset, not a mem addr! )
SWAP ORG @ + BIN( @ - ( off addr ) C! ;
: ELSE, JR, FJR, SWAP THEN, ;
( ----- 027 )
: FWR BSET 0 C, ;
: FSET @ THEN, ;
: BREAK, FJR, 0x8000 OR ;
: BREAK?, DUP 0x8000 AND IF
0x7fff AND 1 ALLOT THEN, -1 ALLOT
THEN ;
: AGAIN, BREAK?, PC - 1- C, ;
: BWR @ AGAIN, ;
( ----- 028 )
( Macros )
( clear carry + SBC )
: SUBHLd, A ORr, SBCHLd, ;
: PUSH0, DE 0 LDdi, DE PUSH, ;
: PUSH1, DE 1 LDdi, DE PUSH, ;
: PUSHZ, DE 0 LDdi, IFZ, DE INCd, THEN, DE PUSH, ;
: PUSHA, D 0 LDri, E A LDrr, DE PUSH, ;
: HLZ, A H LDrr, L ORr, ;
: DEZ, A D LDrr, E ORr, ;
: LDDE(HL), E (HL) LDrr, HL INCd, D (HL) LDrr, ;
: OUTHL, DUP A H LDrr, OUTiA, A L LDrr, OUTiA, ;
: OUTDE, DUP A D LDrr, OUTiA, A E LDrr, OUTiA, ;
( ----- 030 )
( 8086 assembler. See doc/asm.txt )
1 13 LOADR+
( ----- 031 )
VARIABLE ORG
CREATE BIN( 0 , : BIN(+ BIN( @ + ;
VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4
: AL 0 ; : CL 1 ; : DL 2 ; : BL 3 ;
: AH 4 ; : CH 5 ; : DH 6 ; : BH 7 ;
: AX 0 ; : CX 1 ; : DX 2 ; : BX 3 ;
: SP 4 ; : BP 5 ; : SI 6 ; : DI 7 ;
: ES 0 ; : CS 1 ; : SS 2 ; : DS 3 ;
: [BX+SI] 0 ; : [BX+DI] 1 ; : [BP+SI] 2 ; : [BP+DI] 3 ;
: [SI] 4 ; : [DI] 5 ; : [BP] 6 ; : [BX] 7 ;
: <<3 3 LSHIFT ;
( ----- 032 )
: PC H@ ORG @ - BIN( @ + ;
( ----- 033 )
: OP1 CREATE C, DOES> C@ C, ;
0xc3 OP1 RET, 0xfa OP1 CLI, 0xfb OP1 STI,
0xf4 OP1 HLT, 0xfc OP1 CLD, 0xfd OP1 STD,
0x90 OP1 NOP, 0x98 OP1 CBW,
0xf3 OP1 REPZ, 0xf2 OP1 REPNZ, 0xac OP1 LODSB,
0xad OP1 LODSW, 0xa6 OP1 CMPSB, 0xa7 OP1 CMPSW,
0xa4 OP1 MOVSB, 0xa5 OP1 MOVSW, 0xae OP1 SCASB,
0xaf OP1 SCASW, 0xaa OP1 STOSB, 0xab OP1 STOSW,
( no argument, jumps with relative addrs are special )
0xeb OP1 JMPs, 0xe9 OP1 JMPn, 0x74 OP1 JZ,
0x75 OP1 JNZ, 0x72 OP1 JC, 0x73 OP1 JNC,
0xe8 OP1 CALL,
: OP1r CREATE C, DOES> C@ + C, ;
0x40 OP1r INCx, 0x48 OP1r DECx,
0x58 OP1r POPx, 0x50 OP1r PUSHx,
( ----- 034 )
: OPr0 ( reg op ) CREATE C, C, DOES>
C@+ C, C@ <<3 OR 0xc0 OR C, ;
0 0xd0 OPr0 ROLr1, 0 0xd1 OPr0 ROLx1, 4 0xf6 OPr0 MULr,
1 0xd0 OPr0 RORr1, 1 0xd1 OPr0 RORx1, 4 0xf7 OPr0 MULx,
4 0xd0 OPr0 SHLr1, 4 0xd1 OPr0 SHLx1, 6 0xf6 OPr0 DIVr,
5 0xd0 OPr0 SHRr1, 5 0xd1 OPr0 SHRx1, 6 0xf7 OPr0 DIVx,
0 0xd2 OPr0 ROLrCL, 0 0xd3 OPr0 ROLxCL, 1 0xfe OPr0 DECr,
1 0xd2 OPr0 RORrCL, 1 0xd3 OPr0 RORxCL, 0 0xfe OPr0 INCr,
4 0xd2 OPr0 SHLrCL, 4 0xd3 OPr0 SHLxCL,
5 0xd2 OPr0 SHRrCL, 5 0xd3 OPr0 SHRxCL,
( ----- 035 )
: OPrr CREATE C, DOES> C@ C, <<3 OR 0xc0 OR C, ;
0x31 OPrr XORxx, 0x30 OPrr XORrr,
0x88 OPrr MOVrr, 0x89 OPrr MOVxx, 0x28 OPrr SUBrr,
0x29 OPrr SUBxx, 0x08 OPrr ORrr, 0x09 OPrr ORxx,
0x38 OPrr CMPrr, 0x39 OPrr CMPxx, 0x00 OPrr ADDrr,
0x01 OPrr ADDxx, 0x20 OPrr ANDrr, 0x21 OPrr ANDxx,
( ----- 036 )
: OPm ( modrm op ) CREATE C, C, DOES> C@+ C, C@ OR C, ;
0 0xff OPm INC[w], 0 0xfe OPm INC[b],
0x8 0xff OPm DEC[w], 0x8 0xfe OPm DEC[b],
0x30 0xff OPm PUSH[w], 0 0x8f OPm POP[w],
: OPm+ ( modrm op ) CREATE C, C, DOES>
( m off ) C@+ C, C@ ROT OR C, C, ;
0x40 0xff OPm+ INC[w]+, 0x40 0xfe OPm+ INC[b]+,
0x48 0xff OPm+ DEC[w]+, 0x48 0xfe OPm+ DEC[b]+,
0x70 0xff OPm+ PUSH[w]+, 0x40 0x8f OPm+ POP[w]+,
( ----- 037 )
: OPrm CREATE C, DOES> C@ C, SWAP 3 LSHIFT OR C, ;
0x8a OPrm MOVr[], 0x8b OPrm MOVx[],
0x3a OPrm CMPr[], 0x3b OPrm CMPx[],
: OPmr CREATE C, DOES> C@ C, 3 LSHIFT OR C, ;
0x88 OPmr MOV[]r, 0x89 OPmr MOV[]x,
: OPrm+ ( r m off ) CREATE C, DOES>
C@ C, ROT 3 LSHIFT ROT OR 0x40 OR C, C, ;
0x8a OPrm+ MOVr[]+, 0x8b OPrm+ MOVx[]+,
0x3a OPrm+ CMPr[]+, 0x3b OPrm+ CMPx[]+,
: OPm+r ( m off r ) CREATE C, DOES>
C@ C, 3 LSHIFT ROT OR 0x40 OR C, C, ;
0x88 OPm+r MOV[]+r, 0x89 OPm+r MOV[]+x,
( ----- 038 )
: OPi CREATE C, DOES> C@ C, C, ;
0x04 OPi ADDALi, 0x24 OPi ANDALi, 0x2c OPi SUBALi,
0xcd OPi INT,
: OPI CREATE C, DOES> C@ C, , ;
0x05 OPI ADDAXI, 0x25 OPI ANDAXI, 0x2d OPI SUBAXI,
( ----- 040 )
: MOVri, SWAP 0xb0 OR C, C, ;
: MOVxI, SWAP 0xb8 OR C, , ;
: MOVsx, 0x8e C, SWAP <<3 OR 0xc0 OR C, ;
: MOVrm, 0x8a C, SWAP <<3 0x6 OR C, , ;
: MOVxm, 0x8b C, SWAP <<3 0x6 OR C, , ;
: MOVmr, 0x88 C, <<3 0x6 OR C, , ;
: MOVmx, 0x89 C, <<3 0x6 OR C, , ;
: PUSHs, <<3 0x06 OR C, ; : POPs, <<3 0x07 OR C, ;
: SUBxi, 0x83 C, SWAP 0xe8 OR C, C, ;
: ADDxi, 0x83 C, SWAP 0xc0 OR C, C, ;
: JMPr, 0xff C, 7 AND 0xe0 OR C, ;
: JMPf, ( seg off ) 0xea C, |L C, C, , ;
( ----- 041 )
( Place BEGIN, where you want to jump back and AGAIN after
a relative jump operator. Just like BSET and BWR. )
: BEGIN, PC ;
: BSET PC SWAP ! ;
( same as BSET, but we need to write a placeholder )
: FJR, PC 0 C, ;
: IFZ, JNZ, FJR, ;
: IFNZ, JZ, FJR, ;
: IFC, JNC, FJR, ;
: IFNC, JC, FJR, ;
: THEN,
DUP PC ( l l pc )
-^ 1- ( l off )
( warning: l is a PC offset, not a mem addr! )
SWAP ORG @ + BIN( @ - ( off addr )
C! ;
( ----- 042 )
: FWRs BSET 0 C, ;
: FSET @ THEN, ;
( TODO: add BREAK, )
: RPCs, PC - 1- DUP 128 + 0xff > IF ABORT" PC ovfl" THEN C, ;
: RPCn, PC - 2- , ;
: AGAIN, ( BREAK?, ) RPCs, ;
( Use RPCx with appropriate JMP/CALL op. Example:
JMPs, 0x42 RPCs, or CALL, 0x1234 RPCn, )
( ----- 043 )
: PUSHZ, CX 0 MOVxI, IFZ, CX INCx, THEN, CX PUSHx, ;
: CODE ( same as CREATE, but with native word )
(entry) 0 ( native ) C, ;
: ;CODE JMPn, 0x1a ( next ) RPCn, ;
VARIABLE lblchkPS
: chkPS, ( sz -- )
CX SWAP 2 * MOVxI, CALL, lblchkPS @ RPCn, ;
( ----- 050 )
1 12 LOADR+
( ----- 051 )
VARIABLE ORG
VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4
( We divide by 2 because each PC represents a word. )
: PC H@ ORG @ - 1 RSHIFT ;
( ----- 052 )
: _oor ." arg out of range: " .X SPC> ." PC: " PC .X NL> ABORT ;
: _r8c DUP 7 > IF _oor THEN ;
: _r32c DUP 31 > IF _oor THEN ;
: _r16+c _r32c DUP 16 < IF _oor THEN ;
: _r64c DUP 63 > IF _oor THEN ;
: _r256c DUP 255 > IF _oor THEN ;
: _Rdp ( op rd -- op', place Rd ) 4 LSHIFT OR ;
( ----- 053 )
( 0000 000d dddd 0000 )
: OPRd CREATE , DOES> @ SWAP _r32c _Rdp , ;
0b1001010000000101 OPRd ASR, 0b1001010000000000 OPRd COM,
0b1001010000001010 OPRd DEC, 0b1001010000000011 OPRd INC,
0b1001001000000110 OPRd LAC, 0b1001001000000101 OPRd LAS,
0b1001001000000111 OPRd LAT,
0b1001010000000110 OPRd LSR, 0b1001010000000001 OPRd NEG,
0b1001000000001111 OPRd POP, 0b1001001000001111 OPRd PUSH,
0b1001010000000111 OPRd ROR, 0b1001010000000010 OPRd SWAP,
0b1001001000000100 OPRd XCH,
( ----- 054 )
( 0000 00rd dddd rrrr )
: OPRdRr CREATE C, DOES> C@ ( rd rr op )
OVER _r32c 0x10 AND 3 RSHIFT OR ( rd rr op' )
8 LSHIFT OR 0xff0f AND ( rd op' )
SWAP _r32c _Rdp , ;
0x1c OPRdRr ADC, 0x0c OPRdRr ADD, 0x20 OPRdRr AND,
0x14 OPRdRr CP, 0x04 OPRdRr CPC, 0x10 OPRdRr CPSE,
0x24 OPRdRr EOR, 0x2c OPRdRr MOV, 0x9c OPRdRr MUL,
0x28 OPRdRr OR, 0x08 OPRdRr SBC, 0x18 OPRdRr SUB,
( 0000 0AAd dddd AAAA )
: OPRdA CREATE C, DOES> C@ ( rd A op )
OVER _r64c 0x30 AND 3 RSHIFT OR ( rd A op' )
8 LSHIFT OR 0xff0f AND ( rd op' ) SWAP _r32c _Rdp , ;
0xb0 OPRdA IN, 0xb8 OPRdA _ : OUT, SWAP _ ;
( ----- 055 )
( 0000 KKKK dddd KKKK )
: OPRdK CREATE C, DOES> C@ ( rd K op )
OVER _r256c 0xf0 AND 4 RSHIFT OR ( rd K op' )
ROT _r16+c 4 LSHIFT ROT 0x0f AND OR ( op' rdK ) C, C, ;
0x70 OPRdK ANDI, 0x30 OPRdK CPI, 0xe0 OPRdK LDI,
0x60 OPRdK ORI, 0x40 OPRdK SBCI, 0x60 OPRdK SBR,
0x50 OPRdK SUBI,
( 0000 0000 AAAA Abbb )
: OPAb CREATE C, DOES> C@ ( A b op )
ROT _r32c 3 LSHIFT ROT _r8c OR C, C, ;
0x98 OPAb CBI, 0x9a OPAb SBI, 0x99 OPAb SBIC,
0x9b OPAb SBIS,
( ----- 056 )
: OPNA CREATE , DOES> @ , ;
0x9598 OPNA BREAK, 0x9488 OPNA CLC, 0x94d8 OPNA CLH,
0x94f8 OPNA CLI, 0x94a8 OPNA CLN, 0x94c8 OPNA CLS,
0x94e8 OPNA CLT, 0x94b8 OPNA CLV, 0x9498 OPNA CLZ,
0x9419 OPNA EIJMP, 0x9509 OPNA ICALL, 0x9519 OPNA EICALL,
0x9409 OPNA IJMP, 0x0000 OPNA NOP, 0x9508 OPNA RET,
0x9518 OPNA RETI, 0x9408 OPNA SEC, 0x9458 OPNA SEH,
0x9478 OPNA SEI, 0x9428 OPNA SEN, 0x9448 OPNA SES,
0x9468 OPNA SET, 0x9438 OPNA SEV, 0x9418 OPNA SEZ,
0x9588 OPNA SLEEP, 0x95a8 OPNA WDR,
( ----- 057 )
( 0000 0000 0sss 0000 )
: OPb CREATE , DOES> @ ( b op )
SWAP _r8c _Rdp , ;
0b1001010010001000 OPb BCLR, 0b1001010000001000 OPb BSET,
( 0000 000d dddd 0bbb )
: OPRdb CREATE , DOES> @ ( rd b op )
ROT _r32c _Rdp SWAP _r8c OR , ;
0b1111100000000000 OPRdb BLD, 0b1111101000000000 OPRdb BST,
0b1111110000000000 OPRdb SBRC, 0b1111111000000000 OPRdb SBRS,
( special cases )
: CLR, DUP EOR, ; : TST, DUP AND, ; : LSL, DUP ADD, ;
( ----- 058 )
( a -- k12, absolute addr a, relative to PC in a k12 addr )
: _r7ffc DUP 0x7ff > IF _oor THEN ;
: _raddr12
PC - DUP 0< IF 0x800 + _r7ffc 0x800 OR ELSE _r7ffc THEN ;
: RJMP _raddr12 0xc000 OR ;
: RCALL _raddr12 0xd000 OR ;
: RJMP, RJMP , ; : RCALL, RCALL , ;
( ----- 059 )
( a -- k7, absolute addr a, relative to PC in a k7 addr )
: _r3fc DUP 0x3f > IF _oor THEN ;
: _raddr7
PC - DUP 0< IF 0x40 + _r3fc 0x40 OR ELSE _r3fc THEN ;
: _brbx ( a b op -- a ) OR SWAP _raddr7 3 LSHIFT OR ;
: BRBC 0xf400 _brbx ; : BRBS 0xf000 _brbx ; : BRCC 0 BRBC ;
: BRCS 0 BRBS ; : BREQ 1 BRBS ; : BRNE 1 BRBC ; : BRGE 4 BRBC ;
: BRHC 5 BRBC ; : BRHS 5 BRBS ; : BRID 7 BRBC ; : BRIE 7 BRBS ;
: BRLO BRCS ; : BRLT 4 BRBS ; : BRMI 2 BRBS ; : BRPL 2 BRBC ;
: BRSH BRCC ; : BRTC 6 BRBC ; : BRTS 6 BRBS ; : BRVC 3 BRBC ;
: BRVS 3 BRBS ;
( ----- 060 )
0b11100 CONSTANT X 0b01000 CONSTANT Y 0b00000 CONSTANT Z
0b11101 CONSTANT X+ 0b11001 CONSTANT Y+ 0b10001 CONSTANT Z+
0b11110 CONSTANT -X 0b11010 CONSTANT -Y 0b10010 CONSTANT -Z
: _ldst ( Rd XYZ op ) SWAP DUP 0x10 AND 8 LSHIFT SWAP 0xf AND
OR OR ( Rd op' ) SWAP _Rdp , ;
: LD, 0x8000 _ldst ; : ST, SWAP 0x8200 _ldst ;
( ----- 061 )
( L1 LBL! .. L1 ' RJMP LBL, )
: LBL! ( l -- ) PC SWAP ! ;
: LBL, ( l op -- ) SWAP @ 1- SWAP EXECUTE , ;
: SKIP, PC 0 , ;
: TO, ( opw pc ) ( TODO: use !* instead of ! )
( warning: pc is a PC offset, not a mem addr! )
2 * ORG @ + PC 1- H@ ( opw addr tgt hbkp )
ROT HERE ! ( opw tgt hbkp ) SWAP ROT EXECUTE H@ ! ( hbkp )
HERE ! ;
( L1 FLBL, .. L1 ' RJMP FLBL! )
: FLBL, ( l -- ) LBL! 0 , ;
: FLBL! ( l opw -- ) SWAP @ TO, ;
: BEGIN, PC ; : AGAIN?, ( op ) SWAP 1- SWAP EXECUTE , ;
: AGAIN, ['] RJMP AGAIN?, ;
: IF, ['] BREQ SKIP, ; : THEN, TO, ;
( ----- 062 )
( Constant common to all AVR models )
: R0 0 ; : R1 1 ; : R2 2 ; : R3 3 ; : R4 4 ; : R5 5 ; : R6 6 ;
: R7 7 ; : R8 8 ; : R9 9 ; : R10 10 ; : R11 11 ; : R12 12 ;
: R13 13 ; : R14 14 ; : R15 15 ; : R16 16 ; : R17 17 ;
: R18 18 ; : R19 19 ; : R20 20 ; : R21 21 ; : R22 22 ;
: R24 24 ; : R25 25 ; : R26 26 ; : R27 27 ; : R28 28 ;
: R29 29 ; : R30 30 ; : R31 31 ; : XL R26 ; : XH R27 ;
: YL R28 ; : YH R29 ; : ZL R30 ; : ZH R31 ;
( ----- 065 )
( ATmega328P definitions ) : > CONSTANT ;
0xc6 > UDR0 0xc4 > UBRR0L 0xc5 > UBRR0H 0xc2 > UCSR0C
0xc1 > UCSR0B 0xc0 > UCSR0A 0xbd > TWAMR 0xbc > TWCR
0xbb > TWDR 0xba > TWAR 0xb9 > TWSR 0xb8 > TWBR 0xb6 > ASSR
0xb4 > OCR2B 0xb3 > OCR2A 0xb2 > TCNT2 0xb1 > TCCR2B
0xb0 > TCCR2A 0x8a > OCR1BL 0x8b > OCR1BH 0x88 > OCR1AL
0x89 > OCR1AH 0x86 > ICR1L 0x87 > ICR1H 0x84 > TCNT1L
0x85 > TCNT1H 0x82 > TCCR1C 0x81 > TCCR1B 0x80 > TCCR1A
0x7f > DIDR1 0x7e > DIDR0 0x7c > ADMUX 0x7b > ADCSRB
0x7a > ADCSRA 0x79 > ADCH 0x78 > ADCL 0x70 > TIMSK2
0x6f > TIMSK1 0x6e > TIMSK0 0x6c > PCMSK1 0x6d > PCMSK2
0x6b > PCMSK0 0x69 > EICRA 0x68 > PCICR 0x66 > OSCCAL
0x64 > PRR 0x61 > CLKPR 0x60 > WDTCSR 0x3f > SREG 0x3d > SPL
0x3e > SPH 0x37 > SPMCSR 0x35 > MCUCR 0x34 > MCUSR 0x33 > SMCR
0x30 > ACSR 0x2e > SPDR 0x2d > SPSR 0x2c > SPCR 0x2b > GPIOR2
0x2a > GPIOR1 0x28 > OCR0B 0x27 > OCR0A 0x26 > TCNT0 ( cont. )
( ----- 066 )
( cont. ) 0x25 > TCCR0B 0x24 > TCCR0A 0x23 > GTCCR
0x22 > EEARH 0x21 > EEARL 0x20 > EEDR 0x1f > EECR
0x1e > GPIOR0 0x1d > EIMSK 0x1c > EIFR 0x1b > PCIFR
0x17 > TIFR2 0x16 > TIFR1 0x15 > TIFR0 0x0b > PORTD 0x0a > DDRD
0x09 > PIND 0x08 > PORTC 0x07 > DDRC 0x06 > PINC 0x05 > PORTB
0x04 > DDRB 0x03 > PINB
( ----- 100 )
Block editor
This is an application to conveniently browse the contents of
the disk blocks and edit them. You can load it with "105 LOAD".
See doc/ed.txt
( ----- 105 )
1 7 LOADR+
( ----- 106 )
CREATE ACC 0 ,
: _LIST ." Block " DUP . NL> LIST ;
: L BLK> @ _LIST ;
: B BLK> @ 1- BLK@ L ;
: N BLK> @ 1+ BLK@ L ;
( ----- 107 )
( Cursor position in buffer. EDPOS/64 is line number )
CREATE EDPOS 0 ,
CREATE IBUF 64 ALLOT0
CREATE FBUF 64 ALLOT0
: _cpos BLK( + ;
: _lpos 64 * _cpos ;
: _pln ( lineno -- )
DUP _lpos DUP 64 + SWAP DO ( lno )
I EDPOS @ _cpos = IF '^' EMIT THEN
I C@ DUP SPC < IF DROP SPC THEN
EMIT
LOOP ( lno ) 1+ . ;
: _zbuf 64 0 FILL ; ( buf -- )
( ----- 108 )
: _type ( buf -- )
C< DUP CR = IF 2DROP EXIT THEN SWAP DUP _zbuf ( c a )
BEGIN ( c a ) C!+ C< TUCK 0x0d = UNTIL ( c a ) C! ;
( user-facing lines are 1-based )
: T 1- DUP 64 * EDPOS ! _pln ;
: P IBUF _type IBUF EDPOS @ _cpos 64 MOVE BLK!! ;
: _mvln+ ( ln -- move ln 1 line down )
DUP 14 > IF DROP EXIT THEN
_lpos DUP 64 + 64 MOVE ;
: _mvln- ( ln -- move ln 1 line up )
DUP 14 > IF DROP 15 _lpos _zbuf
ELSE 1+ _lpos DUP 64 - 64 MOVE THEN ;
( ----- 109 )
: _U ( U without P, used in VE )
15 EDPOS @ 64 / - ?DUP IF
0 DO
14 I - _mvln+
LOOP THEN ;
: U _U P ;
( ----- 110 )
: _F ( F without _type and _pln. used in VE )
FBUF EDPOS @ _cpos 1+ ( a1 a2 )
BEGIN
C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 )
= NOT IF DROP FBUF THEN ( a2 a1 )
TUCK C@ CR = ( a1 a2 f1 )
OVER BLK) = OR ( a1 a2 f1|f2 )
UNTIL ( a1 a2 )
DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! ELSE DROP THEN ;
: F FBUF _type _F EDPOS @ 64 / _pln ;
( ----- 111 )
: _blen ( buf -- length of str in buf )
DUP BEGIN C@+ SPC < UNTIL -^ 1- ;
: _rbufsz ( size of linebuf to the right of curpos )
EDPOS @ 64 MOD 63 -^ ;
: _lnfix ( --, ensure no ctl chars in line before EDPOS )
EDPOS @ DUP 0xffc0 AND 2DUP = IF 2DROP EXIT THEN DO
I _cpos DUP C@ SPC < IF SPC SWAP C! ELSE DROP THEN LOOP ;
: _i ( i without _pln and _type. used in VE )
_rbufsz IBUF _blen 2DUP > IF
_lnfix TUCK - ( ilen chars-to-move )
SWAP EDPOS @ _cpos 2DUP + ( ctm ilen a a+ilen )
3 PICK MOVE- ( ctm ilen ) NIP ( ilen )
ELSE DROP 1+ ( ilen becomes rbuffsize+1 ) THEN
DUP IBUF EDPOS @ _cpos ROT MOVE ( ilen ) EDPOS +! BLK!! ;
: i IBUF _type _i EDPOS @ 64 / _pln ;
( ----- 112 )
: icpy ( n -- copy n chars from cursor to IBUF )
IBUF _zbuf EDPOS @ _cpos IBUF ( n a buf ) ROT MOVE ;
: _X ( n -- )
DUP icpy EDPOS @ _cpos 2DUP + ( n a1 a1+n )
SWAP _rbufsz MOVE ( n )
( get to next line - n )
DUP EDPOS @ 0xffc0 AND 0x40 + -^ _cpos ( n a )
SWAP 0 FILL BLK!! ;
: X _X EDPOS @ 64 / _pln ;
: _E FBUF _blen _X ;
: E FBUF _blen X ;
: Y FBUF _blen icpy ;
( ----- 120 )
Visual Editor
This editor, unlike the Block Editor (B100), is grid-based
instead of being command-based. It requires the AT-XY, COLS
and LINES words to be implemented. If you don't have those,
use the Block Editor.
It is loaded with "125 LOAD" and invoked with "VE". Note that
this also fully loads the Block Editor.
This editor uses 19 lines. The top line is the status line and
it's followed by 2 lines showing the contents of IBUF and
FBUF (see B100). There are then 16 contents lines. The contents
shown is that of the currently selected block.
(cont.)
( ----- 121 )
The status line displays the active block number, then the
"modifier" and then the cursor position. When the block is dir-
ty, an "*" is displayed next. At the right corner, a mode letter
can appear. 'R' for replace, 'I' for insert, 'F' for find.
(cont.)
( ----- 122 )
All keystrokes are directly interpreted by VE and have the
effect described below.
Pressing a 0-9 digit accumulates that digit into what is named
the "modifier". That modifier affects the behavior of many
keystrokes described below. The modifier starts at zero, but
most commands interpret a zero as a 1 so that they can have an
effect.
'G' selects the block specified by the modifier as the current
block. Any change made to the previously selected block is
saved beforehand.
'[' and ']' advances the selected block by "modifier". 't' opens
the previously opened block.
(cont.)
( ----- 123 )
'h' and 'l' move the cursor by "modifier" characters. 'j' and
'k', by lines. 'g' moves to "modifier" line.
'H' goes to the beginning of the line, 'L' to the end.
'w' moves forward by "modifier" words. 'b' moves backward.
'W' moves to end-of-word. 'B', backwards.
'I', 'F', 'Y', 'X' and 'E' invoke the corresponding command
'o' inserts a blank line after the cursor. 'O', before.
'D' deletes "modifier" lines at the cursor. The first of those
lines is copied to IBUF.
(cont.)
( ----- 124 )
'f' puts the contents of your previous cursor movement into
FBUF. If that movement was a forward movement, it brings the
cursor back where it was. This allows for an efficient combi-
nation of movements and 'E'. For example, if you want to delete
the next word, you type 'w', then 'f', then check your FBUF to
be sure, then press 'E'.
'R' goes into replace mode at current cursor position.
Following keystrokes replace current character and advance
cursor. Press return to return to normal mode.
'@' re-reads current block even if it's dirty, thus undoing
recent changes.
( ----- 125 )
-20 LOAD+ ( B105, block editor )
1 7 LOADR+
( ----- 126 )
CREATE CMD 2 C, '$' C, 0 C,
CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 ,
: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ;
: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ;
: large? COLS 67 > ; : col- 67 COLS MIN -^ ;
: width large? IF 64 ELSE COLS THEN ;
: acc@ ACC @ 1 MAX ; : pos@ ( x y -- ) EDPOS @ 64 /MOD ;
: num ACC @ SWAP _pdacc IF ACC ! ELSE DROP THEN ;
: nspcs ( n -- , spit n space ) 0 DO SPC> LOOP ;
: aty 0 SWAP AT-XY ;
: clrscr COLS LINES * 0 DO SPC I CELL! LOOP ;
: gutter ( ln n ) OVER + SWAP DO 67 I AT-XY '|' EMIT LOOP ;
: status 0 aty ." BLK" SPC> BLK> ? SPC> ACC ?
SPC> pos@ . ',' EMIT . xoff @ IF '>' EMIT THEN SPC>
BLKDTY @ IF '*' EMIT THEN 4 nspcs ;
: nums 17 1 DO 2 I + aty I . SPC> SPC> LOOP ;
( ----- 127 )
: mode! ( c -- ) 4 col- CELL! ;
: @emit C@ SPC MAX 0x7f MIN EMIT ;
: contents
16 0 DO
large? IF 3 ELSE 0 THEN I 3 + AT-XY
64 I * BLK( + ( lineaddr ) xoff @ + DUP width + SWAP
DO I @emit LOOP LOOP
large? IF 3 16 gutter THEN ;
: selblk BLK> @ PREVBLK ! BLK@ contents ;
: pos! ( newpos -- ) EDPOS @ PREVPOS !
DUP 0< IF DROP 0 THEN 1023 MIN EDPOS ! ;
: xoff? pos@ DROP ( x )
xoff @ ?DUP IF < IF 0 xoff ! contents THEN ELSE
width >= IF 64 COLS - xoff ! contents THEN THEN ;
: setpos ( -- ) pos@ 3 + ( header ) SWAP ( y x ) xoff @ -
large? IF 3 + ( gutter ) THEN SWAP AT-XY ;
( ----- 128 )
: cmv ( n -- , char movement ) acc@ * EDPOS @ + pos! ;
: buftype ( buf ln -- )
3 OVER AT-XY KEY DUP EMIT
DUP SPC < IF 2DROP DROP EXIT THEN
( buf ln c ) 4 col- nspcs SWAP 4 SWAP AT-XY ( buf c )
SWAP C!+ IN( _zbuf RDLN IN( SWAP 63 MOVE ;
: bufp ( buf -- )
DUP 3 col- + SWAP DO I @emit LOOP ;
: bufs
1 aty ." I: " IBUF bufp
2 aty ." F: " FBUF bufp
large? IF 0 3 gutter THEN ;
( ----- 129 )
: $G ACC @ selblk ;
: $[ BLK> @ acc@ - selblk ;
: $] BLK> @ acc@ + selblk ;
: $t PREVBLK @ selblk ;
: $I 'I' mode! IBUF 1 buftype _i bufs contents SPC mode! ;
: $F 'F' mode! FBUF 2 buftype _F bufs setpos SPC mode! ;
: $Y Y bufs ;
: $E _E bufs contents ;
: $X acc@ _X bufs contents ;
: $h -1 cmv ; : $l 1 cmv ; : $k -64 cmv ; : $j 64 cmv ;
: $H EDPOS @ 0x3c0 AND pos! ;
: $L EDPOS @ 0x3f OR pos! ;
: $g ACC @ 1 MAX 1- 64 * pos! ;
: $@ BLK> @ BLK@* 0 BLKDTY ! contents ;
( ----- 130 )
: $w EDPOS @ BLK( + acc@ 0 DO
BEGIN C@+ WS? UNTIL BEGIN C@+ WS? NOT UNTIL LOOP
1- BLK( - pos! ;
: $W EDPOS @ BLK( + acc@ 0 DO
1+ BEGIN C@+ WS? NOT UNTIL BEGIN C@+ WS? UNTIL LOOP
2- BLK( - pos! ;
: $b EDPOS @ BLK( + acc@ 0 DO
1- BEGIN C@- WS? NOT UNTIL BEGIN C@- WS? UNTIL LOOP
2+ BLK( - pos! ;
: $B EDPOS @ BLK( + acc@ 0 DO
BEGIN C@- WS? UNTIL BEGIN C@- WS? NOT UNTIL LOOP
1+ BLK( - pos! ;
( ----- 131 )
: $f EDPOS @ PREVPOS @ 2DUP = IF 2DROP EXIT THEN
2DUP > IF DUP pos! SWAP THEN
( p1 p2, p1 < p2 ) OVER - 64 MIN ( pos len ) FBUF _zbuf
SWAP _cpos FBUF ( len src dst ) ROT MOVE bufs ;
: $R ( replace mode )
'R' mode!
BEGIN setpos KEY DUP BS? IF -1 EDPOS +! DROP 0 THEN
DUP SPC >= IF
DUP EMIT EDPOS @ _cpos C! 1 EDPOS +! BLK!! 0
THEN UNTIL SPC mode! contents ;
: $O _U EDPOS @ 0x3c0 AND DUP pos! _cpos _zbuf BLK!! contents ;
: $o EDPOS @ 0x3c0 < IF EDPOS @ 64 + EDPOS ! $O THEN ;
: $D $H 64 icpy
acc@ 0 DO 16 EDPOS @ 64 / DO I _mvln- LOOP LOOP
BLK!! bufs contents ;
( ----- 132 )
: UPPER DUP 'a' 'z' =><= IF 32 - THEN ;
: handle ( c -- f )
DUP '0' '9' =><= IF num 0 EXIT THEN
DUP CMD 2+ C! CMD FIND IF EXECUTE ELSE DROP THEN
0 ACC ! UPPER 'Q' = ;
: VE
1 XYMODE C! clrscr 0 ACC ! 0 PREVPOS ! nums bufs contents
BEGIN xoff? status setpos KEY handle UNTIL
0 XYMODE C! 19 aty IN$ ;
( ----- 150 )
( Remote Shell )
0 :* rsh<? 0 :* rsh>
: rsh BEGIN
rsh<? IF
DUP 4 ( EOT ) = IF DROP EXIT THEN EMIT THEN
KEY? IF DUP 0x80 < IF rsh> ELSE DROP EXIT THEN THEN
AGAIN ;
( ----- 160 )
( AVR Programmer, load range 160-163. doc/avr.txt )
( page size in words, 64 is default on atmega328P )
CREATE aspfpgsz 64 ,
VARIABLE aspprevx
: _x ( a -- b ) DUP aspprevx ! (spix) ;
: _xc ( a -- b ) DUP (spix) ( a b )
DUP aspprevx @ = NOT IF ABORT" AVR err" THEN ( a b )
SWAP aspprevx ! ( b ) ;
: _cmd ( b4 b3 b2 b1 -- r4 ) _xc DROP _xc DROP _xc DROP _x ;
: asprdy ( -- ) BEGIN 0 0 0 0xf0 _cmd 1 AND NOT UNTIL ;
: asp$ ( spidevid -- )
( RESET pulse ) DUP (spie) 0 (spie) (spie)
( wait >20ms ) 220 TICKS
( enable prog ) 0xac (spix) DROP
0x53 _x DROP 0 _xc DROP 0 _x DROP ;
: asperase 0 0 0x80 0xac _cmd asprdy ;
( ----- 161 )
( fuse access. read/write one byte at a time )
: aspfl@ ( -- lfuse ) 0 0 0 0x50 _cmd ;
: aspfh@ ( -- hfuse ) 0 0 0x08 0x58 _cmd ;
: aspfe@ ( -- efuse ) 0 0 0x00 0x58 _cmd ;
: aspfl! ( lfuse -- ) 0 0xa0 0xac _cmd ;
: aspfh! ( hfuse -- ) 0 0xa8 0xac _cmd ;
: aspfe! ( efuse -- ) 0 0xa4 0xac _cmd ;
( ----- 162 )
: aspfb! ( n a --, write word n to flash buffer addr a )
SWAP |L ( a hi lo ) ROT ( hi lo a )
DUP ROT ( hi a a lo ) SWAP ( hi a lo a )
0 0x40 ( hi a lo a 0 0x40 ) _cmd DROP ( hi a )
0 0x48 _cmd DROP ;
: aspfp! ( page --, write buffer to page )
0 SWAP aspfpgsz @ * |M ( 0 lsb msb )
0x4c _cmd DROP asprdy ;
: aspf@ ( page a -- n, read word from flash )
SWAP aspfpgsz @ * OR ( addr ) |M ( lsb msb )
2DUP 0 ROT> ( lsb msb 0 lsb msb )
0x20 _cmd ( lsb msb low )
ROT> 0 ROT> ( low 0 lsb msb ) 0x28 _cmd 8 LSHIFT OR ;
( ----- 163 )
: aspe@ ( addr -- byte, read from EEPROM )
0 SWAP |L ( 0 msb lsb )
0xa0 ( 0 msb lsb 0xa0 ) _cmd ;
: aspe! ( byte addr --, write to EEPROM )
|L ( b msb lsb )
0xc0 ( b msb lsb 0xc0 ) _cmd DROP asprdy ;
( ----- 165 )
( Sega ROM signer. See doc/sega.txt )
: C!+^ ( a c -- a+1 ) OVER C! 1+ ;
: segasig ( addr size -- )
0x2000 OVER LSHIFT ( a sz bytesz )
ROT TUCK + 0x10 - ( sz a end )
TUCK SWAP 0 ROT> ( sz end sum end a ) DO ( sz end sum )
I C@ + LOOP ( sz end sum ) SWAP ( sz sum end )
'T' C!+^ 'M' C!+^ 'R' C!+^ SPC C!+^ 'S' C!+^
'E' C!+^ 'G' C!+^ 'A' C!+^ 0 C!+^ 0 C!+^
( sum's LSB ) OVER C!+^ ( MSB ) SWAP 8 RSHIFT OVER C! 1+
( sz end ) 0 C!+^ 0 C!+^ 0 C!+^ SWAP 0x4a + SWAP C! ;
( ----- 260 )
Cross compilation program
This programs allows cross compilation of boot binary and
core. Run "262 LOAD" right before your cross compilation and
then "270 LOAD" to apply xcomp overrides.
This unit depends on a properly initialized z80a with ORG and
BIN( set. That is how we determine compilation offsets.
This redefines defining words to achieve cross compilation.
The goal is two-fold:
1. Add an offset to all word references in definitions.
2. Don't shadow important words we need right now.
(cont.)
( ----- 261 )
Words overrides like ":", "IMMEDIATE" and "CODE" are not
automatically shadowed to allow the harmless inclusion of
this unit. This shadowing has to take place in your xcomp
configuration.
See /doc/cross.txt for details.
( ----- 262 )
1 3 LOADR+
( ----- 263 )
CREATE XCURRENT 0 ,
: XCON XCURRENT CURRENT* ! ; : XCOFF 0x02 RAM+ CURRENT* ! ;
: (xentry) XCON (entry) XCOFF ; : XCREATE (xentry) 2 C, ;
: X:** (xentry) 5 C, , ;
: XCODE XCON CODE XCOFF ; : XIMM XCON IMMEDIATE XCOFF ;
: _xapply ( a -- a-off )
DUP ORG @ > IF ORG @ - BIN( @ + THEN ;
: XFIND XCURRENT @ SWAP _find DROP _xapply ;
: XLITN LIT" (n)" XFIND , , ;
: X' XCON ' XCOFF ; : X'? XCON '? XCOFF ;
: X['] XCON ' _xapply XLITN XCOFF ;
: XCOMPILE XCON ' _xapply XLITN
LIT" ," FIND DROP _xapply , XCOFF ;
: X[COMPILE] XCON ' _xapply , XCOFF ;
( ----- 264 )
: XDO LIT" 2>R" XFIND , H@ ;
: XLOOP LIT" (loop)" XFIND , H@ - C, ;
: XIF LIT" (?br)" XFIND , H@ 1 ALLOT ;
: XELSE LIT" (br)" XFIND , 1 ALLOT [COMPILE] THEN H@ 1- ;
: XAGAIN LIT" (br)" XFIND , H@ - C, ;
: XUNTIL LIT" (?br)" XFIND , H@ - C, ;
: XLIT"
LIT" (s)" XFIND , H@ 0 C, ,"
DUP H@ -^ 1- SWAP C!
;
( ----- 265 )
: X:
(xentry) 1 ( compiled ) C,
BEGIN
WORD DUP LIT" ;" S= IF
DROP LIT" EXIT" XFIND , EXIT THEN