-
Notifications
You must be signed in to change notification settings - Fork 30
/
ulisp-arm.ino
8063 lines (7388 loc) · 255 KB
/
ulisp-arm.ino
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
/* uLisp ARM Release 4.7 - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - 3rd November 2024
Licensed under the MIT license: https://opensource.org/licenses/MIT
*/
// Lisp Library
const char LispLibrary[] = "";
// Compile options
// #define resetautorun
#define printfreespace
// #define printgcs
// #define sdcardsupport
// #define gfxsupport
// #define lisplibrary
#define assemblerlist
// #define lineeditor
// #define vt100
// #define extensions
// Includes
// #include "LispLibrary.h"
#include <setjmp.h>
#include <SPI.h>
#include <Wire.h>
#include <limits.h>
#if defined(sdcardsupport)
#include <SD.h>
#define SDSIZE 720
#else
#define SDSIZE 0
#endif
// Platform specific settings
#define WORDALIGNED __attribute__((aligned (4)))
#define BUFFERSIZE 36 // Number of bits+4
#define RAMFUNC __attribute__ ((section (".ramfunctions")))
#define MEMBANK
// ATSAMD21 boards ***************************************************************
#if defined(ARDUINO_GEMMA_M0) || defined(ARDUINO_SEEED_XIAO_M0) || defined(ARDUINO_QTPY_M0)
#define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */
#define CPUFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define CPU_ATSAMD21
#elif defined(ARDUINO_ITSYBITSY_M0) || defined(ARDUINO_SAMD_FEATHER_M0_EXPRESS)
#define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define SDCARD_SS_PIN 4
#define CPU_ATSAMD21
#elif defined(ADAFRUIT_FEATHER_M0) /* Feather M0 without DataFlash */
#define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */
#define CPUFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define SDCARD_SS_PIN 4
#define CPU_ATSAMD21
#elif defined(ARDUINO_SAMD_MKRZERO)
#define WORKSPACESIZE (2640-SDSIZE) /* Objects (8*bytes) */
#define CPUFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 840
#define CPU_ATSAMD21
#elif defined(ARDUINO_SAMD_ZERO) /* Put this last, otherwise overrides the Adafruit boards */
#define WORKSPACESIZE (2640-SDSIZE) /* Objects (8*bytes) */
#define CPUFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define SDCARD_SS_PIN 10
#define CPU_ATSAMD21
// ATSAMD51 boards ***************************************************************
#elif defined(ARDUINO_METRO_M4) || defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4)
#define WORKSPACESIZE (20608-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 400
#define SDCARD_SS_PIN 10
#define CPU_ATSAMD51
#elif defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4)
#define WORKSPACESIZE (20608-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 400
#define SDCARD_SS_PIN 10
#define CPU_ATSAMD51
#if defined(gfxsupport)
const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0, TFT_BACKLIGHT = 47;
#include <Adafruit_GFX.h> // Core graphics library
#include <Adafruit_ST7735.h> // Hardware-specific library for ST7735
Adafruit_ST7735 tft = Adafruit_ST7735(44, 45, 41, 42, 46);
#endif
#elif defined(ARDUINO_WIO_TERMINAL)
#define WORKSPACESIZE (20480-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 400
#define CPU_ATSAMD51
#define EXTERNAL_FLASH_USE_QSPI
#if defined(gfxsupport)
const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0;
#include <TFT_eSPI.h> // Hardware-specific library
TFT_eSPI tft = TFT_eSPI();
#endif
#elif defined(ARDUINO_GRAND_CENTRAL_M4)
#define WORKSPACESIZE (28800-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 8192000 /* 8 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 440
#define CPU_ATSAMD51
// nRF51 boards ***************************************************************
#elif defined(ARDUINO_BBC_MICROBIT) || defined(ARDUINO_SINOBIT)
#define WORKSPACESIZE 1344 /* Objects (8*bytes) */
#define CODESIZE 64 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF51822
#elif defined(ARDUINO_CALLIOPE_MINI)
#define WORKSPACESIZE 3392 /* Objects (8*bytes) */
#define CODESIZE 64 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF51822
// nRF52 boards ***************************************************************
#elif defined(ARDUINO_BBC_MICROBIT_V2)
#define WORKSPACESIZE 12928 /* Objects (8*bytes) */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF52833
#elif defined(ARDUINO_NRF52840_ITSYBITSY) || defined(ARDUINO_Seeed_XIAO_nRF52840) \
|| defined(ARDUINO_Seeed_XIAO_nRF52840_Sense) || defined(ARDUINO_NRF52840_CIRCUITPLAY)
#define WORKSPACESIZE (21120-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 8
#define CPU_NRF52840
#elif defined(ARDUINO_NRF52840_CLUE)
#define WORKSPACESIZE (21120-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 8
#define CPU_NRF52840
#if defined(gfxsupport)
const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0;
#include <Adafruit_GFX.h>
#include <Adafruit_ST7789.h>
Adafruit_ST7789 tft = Adafruit_ST7789(&SPI1, PIN_TFT_CS, PIN_TFT_DC, PIN_TFT_RST);
#endif
// MAX32620 boards ***************************************************************
#elif defined(MAX32620)
#define WORKSPACESIZE (24704-SDSIZE) /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 320
#define CPU_MAX32620
#define Wire1 Wire2
// iMXRT1062 boards ***************************************************************
#elif defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41)
#define WORKSPACESIZE 60000 /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 15000
#define LITTLEFS (960 * 1024)
#include <LittleFS.h>
LittleFS_Program LittleFS;
#define FS_FILE_WRITE FILE_WRITE_BEGIN
#define FS_FILE_READ FILE_READ
#define CPU_iMXRT1062
#define SDCARD_SS_PIN BUILTIN_SDCARD
#define BitOrder uint8_t
#undef RAMFUNC
#define RAMFUNC FASTRUN
#undef MEMBANK
#define MEMBANK DMAMEM
// RP2040 boards ***************************************************************
#elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) \
|| defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_SEEED_XIAO_RP2040)
#define WORKSPACESIZE (23000-SDSIZE) /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 480
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define CPU_RP2040
#if defined(gfxsupport)
const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0;
#include <Adafruit_GFX.h> // Core graphics library
#include <Adafruit_ST7789.h> // Hardware-specific library for ST7789
Adafruit_ST7789 tft = Adafruit_ST7789(5, 1, 3, 2, 0); // TTGO RP2040 TFT
#define TFT_BACKLIGHT 4
#define TFT_I2C_POWER 22
#endif
#elif defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER)
#define WORKSPACESIZE 23000 /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 480
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define SDCARD_SS_PIN 23
#define CPU_RP2040
#elif defined(ARDUINO_RASPBERRY_PI_PICO_W)
#define WORKSPACESIZE (15536-SDSIZE) /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 480
#define LITTLEFS
#include <WiFi.h>
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define CPU_RP2040
// RP2350 boards ***************************************************************
#elif defined(ARDUINO_RASPBERRY_PI_PICO_2)
#if defined(__riscv)
#define WORKSPACESIZE (42500-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 580
#else
#define WORKSPACESIZE (47000-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 520
#endif
#define CODESIZE 256 /* Bytes */
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define CPU_RP2350
#elif defined(ARDUINO_PIMORONI_PICO_PLUS_2)
//#define BOARD_HAS_PSRAM /* Uncomment to use PSRAM */
#if defined(BOARD_HAS_PSRAM)
#undef MEMBANK
#define MEMBANK PSRAM
#define WORKSPACESIZE 1000000 /* Objects (8*bytes) */
#define STACKDIFF 580
#elif defined(__riscv)
#define WORKSPACESIZE (42000-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 580
#else
#define WORKSPACESIZE (46500-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 520
#endif
#define CODESIZE 256 /* Bytes */
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define SDCARD_SS_PIN 10
#define CPU_RP2350
#elif defined(ARDUINO_PIMORONI_TINY2350)
#if defined(__riscv)
#define WORKSPACESIZE (42500-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 580
#else
#define WORKSPACESIZE (47000-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 520
#endif
#define CODESIZE 256 /* Bytes */
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define CPU_RP2350
// RA4M1 boards ***************************************************************
#elif defined(ARDUINO_MINIMA)
#define WORKSPACESIZE (2032-SDSIZE) /* Objects (8*bytes) */
#include <EEPROM.h>
#define EEPROMFLASH
#define FLASHSIZE 8192 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define eAnalogReference ar_aref
#define CPU_RA4M1
#define SDCARD_SS_PIN 10
#elif defined(ARDUINO_UNOWIFIR4)
#define WORKSPACESIZE (1610-SDSIZE) /* Objects (8*bytes) */
#include <EEPROM.h>
#include "WiFiS3.h"
#define EEPROMFLASH
#define FLASHSIZE 8192 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define eAnalogReference ar_aref
#define CPU_RA4M1
#define SDCARD_SS_PIN 10
#else
#error "Board not supported!"
#endif
// C Macros
#define nil NULL
#define car(x) (((object *) (x))->car)
#define cdr(x) (((object *) (x))->cdr)
#define first(x) car(x)
#define rest(x) cdr(x)
#define second(x) first(rest(x))
#define cddr(x) cdr(cdr(x))
#define third(x) first(cddr(x))
#define push(x, y) ((y) = cons((x),(y)))
#define pop(y) ((y) = cdr(y))
#define protect(y) push((y), GCStack)
#define unprotect() pop(GCStack)
#define integerp(x) ((x) != NULL && (x)->type == NUMBER)
#define floatp(x) ((x) != NULL && (x)->type == FLOAT)
#define symbolp(x) ((x) != NULL && (x)->type == SYMBOL)
#define stringp(x) ((x) != NULL && (x)->type == STRING)
#define characterp(x) ((x) != NULL && (x)->type == CHARACTER)
#define arrayp(x) ((x) != NULL && (x)->type == ARRAY)
#define streamp(x) ((x) != NULL && (x)->type == STREAM)
#define mark(x) (car(x) = (object *)(((uintptr_t)(car(x))) | MARKBIT))
#define unmark(x) (car(x) = (object *)(((uintptr_t)(car(x))) & ~MARKBIT))
#define marked(x) ((((uintptr_t)(car(x))) & MARKBIT) != 0)
#define MARKBIT 1
#define setflag(x) (Flags = Flags | 1<<(x))
#define clrflag(x) (Flags = Flags & ~(1<<(x)))
#define tstflag(x) (Flags & 1<<(x))
#define issp(x) (x == ' ' || x == '\n' || x == '\r' || x == '\t')
#define isbr(x) (x == ')' || x == '(' || x == '"' || x == '#' || x == '\'')
#define fntype(x) (getminmax((uint16_t)(x))>>6)
#define longsymbolp(x) (((x)->name & 0x03) == 0)
#define longnamep(x) (((x) & 0x03) == 0)
#define twist(x) ((uint32_t)((x)<<2) | (((x) & 0xC0000000)>>30))
#define untwist(x) (((x)>>2 & 0x3FFFFFFF) | ((x) & 0x03)<<30)
#define arraysize(x) (sizeof(x) / sizeof(x[0]))
#define stringifyX(x) #x
#define stringify(x) stringifyX(x)
#define PACKEDS 0x43238000
#define BUILTINS 0xF4240000
#define ENDFUNCTIONS 0x0BDC0000
// Code marker stores start and end of code block
#define startblock(x) ((x->integer) & 0xFFFF)
#define endblock(x) ((x->integer) >> 16 & 0xFFFF)
// Constants
#define TRACEMAX 3 // Maximum number of traced functions
enum type { ZZERO=0, SYMBOL=2, CODE=4, NUMBER=6, STREAM=8, CHARACTER=10, FLOAT=12, ARRAY=14, STRING=16, PAIR=18 }; // ARRAY STRING and PAIR must be last
enum token { UNUSED, BRA, KET, QUO, DOT };
enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, WIFISTREAM, STRINGSTREAM, GFXSTREAM };
enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS };
// Stream names used by printobject
const char serialstream[] = "serial";
const char i2cstream[] = "i2c";
const char spistream[] = "spi";
const char sdstream[] = "sd";
const char wifistream[] = "wifi";
const char stringstream[] = "string";
const char gfxstream[] = "gfx";
const char *const streamname[] = {serialstream, i2cstream, spistream, sdstream, wifistream, stringstream, gfxstream};
// Typedefs
typedef uint32_t symbol_t;
typedef uint32_t builtin_t;
typedef uint32_t chars_t;
typedef struct sobject {
union {
struct {
sobject *car;
sobject *cdr;
};
struct {
unsigned int type;
union {
symbol_t name;
int integer;
chars_t chars; // For strings
float single_float;
};
};
};
} object;
typedef object *(*fn_ptr_type)(object *, object *);
typedef void (*mapfun_t)(object *, object **);
typedef int (*intfn_ptr_type)(int w, int x, int y, int z);
typedef const struct {
const char *string;
fn_ptr_type fptr;
uint8_t minmax;
const char *doc;
} tbl_entry_t;
typedef int (*gfun_t)();
typedef void (*pfun_t)(char);
enum builtins: builtin_t { NIL, TEE, NOTHING, OPTIONAL, FEATURES, INITIALELEMENT, ELEMENTTYPE, TEST, COLONA, COLONB,
COLONC, BIT, AMPREST, LAMBDA, LET, LETSTAR, CLOSURE, PSTAR, QUOTE, DEFUN, DEFVAR, DEFCODE, EQ, CAR, FIRST,
CDR, REST, NTH, AREF, CHAR, STRINGFN, PINMODE, DIGITALWRITE, ANALOGREAD, ANALOGREFERENCE, REGISTER,
FORMAT,
};
// Global variables
object Workspace[WORKSPACESIZE] WORDALIGNED MEMBANK;
#if defined(CODESIZE)
RAMFUNC uint8_t MyCode[CODESIZE] WORDALIGNED;
#endif
jmp_buf toplevel_handler;
jmp_buf *handler = &toplevel_handler;
unsigned int Freespace = 0;
object *Freelist;
unsigned int I2Ccount;
unsigned int TraceFn[TRACEMAX];
unsigned int TraceDepth[TRACEMAX];
builtin_t Context;
#define BACKTRACESIZE 8
uint8_t TraceStart = 0, TraceTop = 0;
symbol_t Backtrace[BACKTRACESIZE];
object *GlobalEnv;
object *GCStack = NULL;
object *GlobalString;
object *GlobalStringTail;
int GlobalStringIndex = 0;
uint8_t PrintCount = 0;
uint8_t BreakLevel = 0;
char LastChar = 0;
char LastPrint = 0;
// Flags
enum flag { PRINTREADABLY, RETURNFLAG, ESCAPE, EXITEDITOR, LIBRARYLOADED, NOESC, NOECHO, MUFFLEERRORS, BACKTRACE };
typedef uint16_t flags_t;
volatile flags_t Flags = 1<<PRINTREADABLY; // Set by default
// Forward references
object *tee;
void pfstring (const char *s, pfun_t pfun);
// Error handling
int modbacktrace (int n) {
return (n+BACKTRACESIZE) % BACKTRACESIZE;
}
void printbacktrace () {
if (TraceStart != TraceTop) pserial('[');
int tracesize = modbacktrace(TraceTop-TraceStart);
for (int i=1; i<=tracesize; i++) {
printsymbol(symbol(Backtrace[modbacktrace(TraceTop-i)]), pserial);
if (i!=tracesize) pfstring(" <- ", pserial);
}
if (TraceStart != TraceTop) pserial(']');
}
void errorsub (symbol_t fname, const char *string) {
pfl(pserial); pfstring("Error", pserial);
if (TraceStart != TraceTop) pserial(' ');
printbacktrace();
pfstring(": ", pserial);
if (fname != sym(NIL)) {
pserial('\'');
psymbol(fname, pserial);
pserial('\''); pserial(' ');
}
pfstring(string, pserial);
}
void errorend () { GCStack = NULL; longjmp(*handler, 1); }
void errorsym (symbol_t fname, const char *string, object *symbol) {
if (!tstflag(MUFFLEERRORS)) {
errorsub(fname, string);
pserial(':'); pserial(' ');
printobject(symbol, pserial);
pln(pserial);
}
errorend();
}
void errorsym2 (symbol_t fname, const char *string) {
if (!tstflag(MUFFLEERRORS)) {
errorsub(fname, string);
pln(pserial);
}
errorend();
}
void error (const char *string, object *symbol) {
errorsym(sym(Context), string, symbol);
}
void error2 (const char *string) {
errorsym2(sym(Context), string);
}
void formaterr (object *formatstr, const char *string, uint8_t p) {
pln(pserial); indent(4, ' ', pserial); printstring(formatstr, pserial); pln(pserial);
indent(p+5, ' ', pserial); pserial('^');
error2(string);
pln(pserial);
errorend();
}
// Save space as these are used multiple times
const char notanumber[] = "argument is not a number";
const char notaninteger[] = "argument is not an integer";
const char notastring[] = "argument is not a string";
const char notalist[] = "argument is not a list";
const char notasymbol[] = "argument is not a symbol";
const char notproper[] = "argument is not a proper list";
const char toomanyargs[] = "too many arguments";
const char toofewargs[] = "too few arguments";
const char noargument[] = "missing argument";
const char nostream[] = "missing stream argument";
const char overflow[] = "arithmetic overflow";
const char divisionbyzero[] = "division by zero";
const char indexnegative[] = "index can't be negative";
const char invalidarg[] = "invalid argument";
const char invalidkey[] = "invalid keyword";
const char illegalclause[] = "illegal clause";
const char illegalfn[] = "illegal function";
const char invalidpin[] = "invalid pin";
const char oddargs[] = "odd number of arguments";
const char indexrange[] = "index out of range";
const char canttakecar[] = "can't take car";
const char canttakecdr[] = "can't take cdr";
const char unknownstreamtype[] = "unknown stream type";
// Set up workspace
void initworkspace () {
Freelist = NULL;
for (int i=WORKSPACESIZE-1; i>=0; i--) {
object *obj = &Workspace[i];
car(obj) = NULL;
cdr(obj) = Freelist;
Freelist = obj;
Freespace++;
}
}
object *myalloc () {
if (Freespace == 0) { Context = NIL; error2("no room"); }
object *temp = Freelist;
Freelist = cdr(Freelist);
Freespace--;
return temp;
}
inline void myfree (object *obj) {
car(obj) = NULL;
cdr(obj) = Freelist;
Freelist = obj;
Freespace++;
}
// Make each type of object
object *number (int n) {
object *ptr = myalloc();
ptr->type = NUMBER;
ptr->integer = n;
return ptr;
}
object *makefloat (float f) {
object *ptr = myalloc();
ptr->type = FLOAT;
ptr->single_float = f;
return ptr;
}
object *character (uint8_t c) {
object *ptr = myalloc();
ptr->type = CHARACTER;
ptr->chars = c;
return ptr;
}
object *cons (object *arg1, object *arg2) {
object *ptr = myalloc();
ptr->car = arg1;
ptr->cdr = arg2;
return ptr;
}
object *symbol (symbol_t name) {
object *ptr = myalloc();
ptr->type = SYMBOL;
ptr->name = name;
return ptr;
}
inline object *bsymbol (builtin_t name) {
return intern(twist(name+BUILTINS));
}
object *codehead (int entry) {
object *ptr = myalloc();
ptr->type = CODE;
ptr->integer = entry;
return ptr;
}
object *intern (symbol_t name) {
#if !defined(BOARD_HAS_PSRAM)
for (int i=0; i<WORKSPACESIZE; i++) {
object *obj = &Workspace[i];
if (obj->type == SYMBOL && obj->name == name) return obj;
}
#endif
return symbol(name);
}
bool eqsymbols (object *obj, char *buffer) {
object *arg = cdr(obj);
int i = 0;
while (!(arg == NULL && buffer[i] == 0)) {
if (arg == NULL || buffer[i] == 0) return false;
chars_t test = 0; int shift = 24;
for (int j=0; j<4; j++, i++) {
if (buffer[i] == 0) break;
test = test | buffer[i]<<shift;
shift = shift - 8;
}
if (arg->chars != test) return false;
arg = car(arg);
}
return true;
}
object *internlong (char *buffer) {
#if !defined(BOARD_HAS_PSRAM)
for (int i=0; i<WORKSPACESIZE; i++) {
object *obj = &Workspace[i];
if (obj->type == SYMBOL && longsymbolp(obj) && eqsymbols(obj, buffer)) return obj;
}
#endif
object *obj = lispstring(buffer);
obj->type = SYMBOL;
return obj;
}
object *stream (uint8_t streamtype, uint8_t address) {
object *ptr = myalloc();
ptr->type = STREAM;
ptr->integer = streamtype<<8 | address;
return ptr;
}
object *newstring () {
object *ptr = myalloc();
ptr->type = STRING;
ptr->chars = 0;
return ptr;
}
// Features
const char floatingpoint[] = ":floating-point";
const char arrays[] = ":arrays";
const char doc[] = ":documentation";
const char machinecode[] = ":machine-code";
const char errorhandling[] = ":error-handling";
const char wifi[] = ":wi-fi";
const char gfx[] = ":gfx";
const char sdcard[] = ":sd-card";
const char arm[] = ":arm";
const char riscv[] = ":risc-v";
object *features () {
object *result = NULL;
#if defined(__riscv)
push(internlong((char *)riscv), result);
#else
push(internlong((char *)arm), result);
#endif
#if defined(sdcardsupport)
push(internlong((char *)sdcard), result);
#endif
push(internlong((char *)gfx), result);
push(internlong((char *)wifi), result);
push(internlong((char *)errorhandling), result);
push(internlong((char *)machinecode), result);
push(internlong((char *)doc), result);
push(internlong((char *)arrays), result);
push(internlong((char *)floatingpoint), result);
return result;
}
// Garbage collection
void markobject (object *obj) {
MARK:
if (obj == NULL) return;
if (marked(obj)) return;
object* arg = car(obj);
unsigned int type = obj->type;
mark(obj);
if (type >= PAIR || type == ZZERO) { // cons
markobject(arg);
obj = cdr(obj);
goto MARK;
}
if (type == ARRAY) {
obj = cdr(obj);
goto MARK;
}
if ((type == STRING) || (type == SYMBOL && longsymbolp(obj))) {
obj = cdr(obj);
while (obj != NULL) {
arg = car(obj);
mark(obj);
obj = arg;
}
}
}
void sweep () {
Freelist = NULL;
Freespace = 0;
for (int i=WORKSPACESIZE-1; i>=0; i--) {
object *obj = &Workspace[i];
if (!marked(obj)) myfree(obj); else unmark(obj);
}
}
void gc (object *form, object *env) {
#if defined(printgcs)
int start = Freespace;
#endif
markobject(tee);
markobject(GlobalEnv);
markobject(GCStack);
markobject(form);
markobject(env);
sweep();
#if defined(printgcs)
pfl(pserial); pserial('{'); pint(Freespace - start, pserial); pserial('}');
#endif
}
// Compact image
void movepointer (object *from, object *to) {
uintptr_t limit = ((uintptr_t)(from) - (uintptr_t)(Workspace))/sizeof(uintptr_t);
for (uintptr_t i=0; i<limit; i++) {
object *obj = &Workspace[i];
unsigned int type = (obj->type) & ~MARKBIT;
if (marked(obj) && (type >= ARRAY || type==ZZERO || (type == SYMBOL && longsymbolp(obj)))) {
if (car(obj) == (object *)((uintptr_t)from | MARKBIT))
car(obj) = (object *)((uintptr_t)to | MARKBIT);
if (cdr(obj) == from) cdr(obj) = to;
}
}
// Fix strings and long symbols
for (uintptr_t i=0; i<limit; i++) {
object *obj = &Workspace[i];
if (marked(obj)) {
unsigned int type = (obj->type) & ~MARKBIT;
if (type == STRING || (type == SYMBOL && longsymbolp(obj))) {
obj = cdr(obj);
while (obj != NULL) {
if (cdr(obj) == to) cdr(obj) = from;
obj = (object *)((uintptr_t)(car(obj)) & ~MARKBIT);
}
}
}
}
}
uintptr_t compactimage (object **arg) {
markobject(tee);
markobject(GlobalEnv);
markobject(GCStack);
object *firstfree = Workspace;
while (marked(firstfree)) firstfree++;
object *obj = &Workspace[WORKSPACESIZE-1];
while (firstfree < obj) {
if (marked(obj)) {
car(firstfree) = car(obj);
cdr(firstfree) = cdr(obj);
unmark(obj);
movepointer(obj, firstfree);
if (GlobalEnv == obj) GlobalEnv = firstfree;
if (GCStack == obj) GCStack = firstfree;
if (*arg == obj) *arg = firstfree;
while (marked(firstfree)) firstfree++;
}
obj--;
}
sweep();
return firstfree - Workspace;
}
// Make SD card filename
char *MakeFilename (object *arg, char *buffer) {
int max = BUFFERSIZE-1;
buffer[0]='/';
int i = 1;
do {
char c = nthchar(arg, i-1);
if (c == '\0') break;
buffer[i++] = c;
} while (i<max);
buffer[i] = '\0';
return buffer;
}
// Save-image and load-image
#if defined(sdcardsupport)
void SDBegin() {
#if defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER)
SD.begin(SDCARD_SS_PIN, SPI1);
#else
SD.begin(SDCARD_SS_PIN);
#endif
}
void SDWrite32 (File file, int data) {
file.write(data & 0xFF); file.write(data>>8 & 0xFF);
file.write(data>>16 & 0xFF); file.write(data>>24 & 0xFF);
}
int SDRead32 (File file) {
uintptr_t b0 = file.read(); uintptr_t b1 = file.read();
uintptr_t b2 = file.read(); uintptr_t b3 = file.read();
return b0 | b1<<8 | b2<<16 | b3<<24;
}
#elif defined(LITTLEFS)
void FSWrite32 (File file, uint32_t data) {
union { uint32_t data2; uint8_t u8[4]; };
data2 = data;
if (file.write(u8, 4) != 4) error2("not enough room");
}
uint32_t FSRead32 (File file) {
union { uint32_t data; uint8_t u8[4]; };
file.read(u8, 4);
return data;
}
#elif defined(DATAFLASH)
// Winbond DataFlash support for Adafruit M4 Express boards
#define PAGEPROG 0x02
#define READSTATUS 0x05
#define READDATA 0x03
#define WRITEENABLE 0x06
#define BLOCK64K 0xD8
#define READID 0x90
// Arduino pins used for dataflash
#if defined(ARDUINO_ITSYBITSY_M0) || defined(ARDUINO_SAMD_FEATHER_M0_EXPRESS)
const int sck = 38, ssel = 39, mosi = 37, miso = 36;
#elif defined(EXTERNAL_FLASH_USE_QSPI)
const int sck = PIN_QSPI_SCK, ssel = PIN_QSPI_CS, mosi = PIN_QSPI_IO0, miso = PIN_QSPI_IO1;
#endif
void FlashBusy () {
digitalWrite(ssel, 0);
FlashWrite(READSTATUS);
while ((FlashReadByte() & 1) != 0);
digitalWrite(ssel, 1);
}
inline void FlashWrite (uint8_t data) {
shiftOut(mosi, sck, MSBFIRST, data);
}
inline uint8_t FlashReadByte () {
return shiftIn(miso, sck, MSBFIRST);
}
void FlashWriteByte (uint32_t *addr, uint8_t data) {
// New page
if (((*addr) & 0xFF) == 0) {
digitalWrite(ssel, 1);
FlashBusy();
FlashWriteEnable();
digitalWrite(ssel, 0);
FlashWrite(PAGEPROG);
FlashWrite((*addr)>>16);
FlashWrite((*addr)>>8);
FlashWrite(0);
}
FlashWrite(data);
(*addr)++;
}
void FlashWriteEnable () {
digitalWrite(ssel, 0);
FlashWrite(WRITEENABLE);
digitalWrite(ssel, 1);
}
bool FlashCheck () {
uint8_t devID;
digitalWrite(ssel, HIGH); pinMode(ssel, OUTPUT);
pinMode(sck, OUTPUT);
pinMode(mosi, OUTPUT);
pinMode(miso, INPUT);
digitalWrite(sck, LOW); digitalWrite(mosi, HIGH);
digitalWrite(ssel, LOW);
FlashWrite(READID);
for (uint8_t i=0; i<4; i++) FlashReadByte();
devID = FlashReadByte();
digitalWrite(ssel, HIGH);
return (devID >= 0x14 && devID <= 0x17); // true = found correct device
}
void FlashBeginWrite (uint32_t *addr, uint32_t bytes) {
*addr = 0;
uint8_t blocks = (bytes+65535)/65536;
// Erase 64K
for (uint8_t b=0; b<blocks; b++) {
FlashWriteEnable();
digitalWrite(ssel, 0);
FlashWrite(BLOCK64K);
FlashWrite(b); FlashWrite(0); FlashWrite(0);
digitalWrite(ssel, 1);
FlashBusy();
}
}
void FlashWrite32 (uint32_t *addr, uint32_t data) {
FlashWriteByte(addr, data & 0xFF); FlashWriteByte(addr, data>>8 & 0xFF);
FlashWriteByte(addr, data>>16 & 0xFF); FlashWriteByte(addr, data>>24 & 0xFF);
}
inline void FlashEndWrite (uint32_t *addr) {
(void) addr;
digitalWrite(ssel, 1);
FlashBusy();
}
void FlashBeginRead (uint32_t *addr) {
*addr = 0;
FlashBusy();
digitalWrite(ssel, 0);
FlashWrite(READDATA);
FlashWrite(0); FlashWrite(0); FlashWrite(0);
}