SayoriOS 0.3.3

forth.c
1 // https://github.com/mak4444/gnu-efi-code-forth/blob/main/apps/Forth64S/Meta_x86_64/Mak64Forth.cpp
2 #include <kernel.h>
3 #include "drv/ps2.h"
4
5 //extern bool echo; ///< Включен ли вывод?
6 extern uint8_t kbdstatus;
7 extern char G_CLI_PATH[];
8 extern uint32_t tty_pos_x;
9 extern uint32_t tty_pos_y;
10 extern uint32_t tty_text_color;
11 extern uint32_t tty_bg_color;
12 extern uint32_t tty_off_pos_x;
13 extern uint32_t tty_off_pos_h;
14
15 char* input_buffer[256];
16
17 #define STACK_SIZE 1000 /* cells reserved for the stack */
18 #define RSTACK_SIZE 1000 /* cells reserved for the return stack */
19 #define HERE_SIZE1 0x10000
20
21 typedef long unsigned Cell;
22 typedef long sCell;
23 typedef void (*proc)(void);
24
25 #define pp(cName) const sCell p##cName = (sCell)cName;
26 #define PP(cName) const sCell P##cName = (sCell)cName;
27
28 static int forth_run;
29 sCell * HereArea;
30 sCell * StackArea;
31 sCell * RStackArea;
32 sCell * here;
33 sCell *Stack;
34 sCell *rStack;
35 sCell * ip ;
36 sCell ireg;
37 sCell Tos;
38 sCell * Handler = NULL;
39
40 Cell numericBase = 10;
41
42 void Co( sCell cod ){ *here++ = cod ;}
43 void Co2( sCell cod1,sCell cod2 ){Co(cod1); Co(cod2); }
44 void Co3( sCell cod1,sCell cod2,sCell cod3 ){Co2(cod1,cod2); ; Co(cod3); }
45 void Co4( sCell cod1,sCell cod2,sCell cod3,sCell cod4 ){ Co3(cod1,cod2,cod3); ; Co(cod4); }
46 void Co5( sCell cod1,sCell cod2,sCell cod3,sCell cod4,sCell cod5 )
47 { Co4(cod1,cod2,cod3,cod4); ; Co(cod5); }
48 void Co6( sCell cod1,sCell cod2,sCell cod3,sCell cod4,sCell cod5,sCell cod6 )
49 { Co5(cod1,cod2,cod3,cod4,cod5); Co(cod6); }
50 void Co7( sCell cod1,sCell cod2,sCell cod3,sCell cod4,sCell cod5,sCell cod6,sCell cod7 )
51 { Co6(cod1,cod2,cod3,cod4,cod5,cod6); Co(cod7);}
52
53 void Noop(void) {} pp(Noop)
54
55 void DoVar(void){ *--Stack= Tos; Tos =(sCell)ip; ip = (sCell*)*rStack++; } pp(DoVar)
56 void DoConst(void){ *--Stack= Tos; Tos = *ip; ip = (sCell*)*rStack++; } pp(DoConst)
57 void Execute()
58 {
59 // tty_printf("Execute\n");
60 ireg =Tos; Tos=*Stack++;
61 if ( (ireg<0) ^ (pNoop<0) ) {
62 ((proc) (~ireg))();
63 return;
64 }
65 *--rStack = (sCell) ip;
66 ip = (sCell *) ireg;
67 } pp(Execute)
68
69 void DoDefer(){
70 // tty_printf("DoDefer\n");
71 ireg = *ip;
72 if ( (ireg<0) ^ (pNoop<0) ) {
73 ip = (sCell*)*rStack++; // exit
74 ((proc)(~ireg))();
75 return;
76 }
77 ip = (sCell *) ireg;
78
79 } pp(DoDefer)
80
81 void Lit_(){ *--Stack = Tos; Tos = *ip++; } pp(Lit_)
82 void Lit( sCell val) {Co(~pLit_); *here++ = val; }
83 void Compile(){ *here++ = Tos; Tos = *Stack++; } pp(Compile)
84 void LitCo(){ Co(~pLit_); Compile();} pp(LitCo)
85 void Allot(){ *(sCell*)&here += Tos; Tos = *Stack++; } pp(Allot)
86
87 void Exit() {
88 // tty_printf("Exit %x ",ip); // addresses area
89 ip = (sCell*)*rStack++;
90 // tty_printf("-> %x \n",ip); // addresses area
91 } pp(Exit)
92 void Here(void){ *--Stack = Tos; Tos = (sCell)here; } pp(Here)
93
94 void Branch(){
95 // tty_printf("Branch %x ",ip); // addresses area
96 ip = *(sCell**)ip;
97 // tty_printf("-> %x \n",ip); // addresses area
98 } pp(Branch)
99
100 void QBranch(){
101 // tty_printf("QBranch %x ",ip); // addresses area
102 if(Tos) ip++;
103 else ip = *(sCell**)ip;
104 Tos = *Stack++;
105 // tty_printf("-> %x \n",ip); // addresses area
106 } pp(QBranch)
107
108 void Str() {
109 *--Stack = Tos;
110 *--Stack = (Cell)ip+1;
111 Tos = *(char unsigned *)ip;
112 ip = (sCell*) ((Cell)ip + Tos + 1);
113 ip = (sCell*) ( ( (Cell)ip + sizeof(Cell) - 1 ) & (-sizeof(Cell) ) );
114
115 } pp(Str)
116
117 void Dup(){ *--Stack= Tos; } pp(Dup)
118 void Drop(){ Tos = *Stack++; } pp(Drop)
119 void Nip(){ Stack++; } pp(Nip)
120 void QDup(){ if(Tos) *--Stack= Tos; } pp(QDup)
121 void Over(){ *--Stack= Tos; Tos = Stack[1]; } pp(Over)
122 void Tuck(){ sCell tt=*Stack; *Stack=Tos; *--Stack=tt; } pp(Tuck)
123 void Pick(){ Tos = Stack[Tos]; } pp(Pick)
124 void i2dup(){ *--Stack= Tos; *--Stack= Stack[1]; } pp(i2dup)
125 void i2over(){ *--Stack= Tos; *--Stack= Stack[3]; Tos= Stack[3]; } pp(i2over)
126 void i2drop(){ Stack++; Tos = *Stack++; } pp(i2drop)
127 void Swap(){ sCell tt=Tos; Tos=Stack[0]; Stack[0]=tt; } pp(Swap)
128 void i2Swap(){
129 sCell tt=Tos; Tos=Stack[1]; Stack[1]=tt;
130 tt=Stack[0]; Stack[0]=Stack[2]; Stack[2]=tt; } pp(i2Swap)
131 void Rot(){ Cell tt=Stack[1]; Stack[1]=Stack[0]; Stack[0]=Tos; Tos=tt; } pp(Rot)
132 void Add(){ Tos += *Stack++; } pp(Add)
133 void Sub(){ Tos = -Tos; Tos += *Stack++; } pp(Sub)
134 void Negate(){ Tos = -Tos; } pp(Negate)
135 void Invert(){ Tos = ~Tos; } pp(Invert)
136 void i1Add(){ Tos++; } pp(i1Add)
137 void i1Sub(){ Tos--; } pp(i1Sub)
138 void i2Add(){ Tos +=2; } pp(i2Add)
139 void i2Sub(){ Tos -=2; } pp(i2Sub)
140 void Mul(){ Tos *= *Stack++; } pp(Mul)
141 void Div(){ sCell tt=*Stack++; Tos = tt/Tos; } pp(Div)
142 void i2Mul(){ Tos *= 2; } pp(i2Mul)
143 void i2Div(){ Tos /= 2; } pp(i2Div)
144 void Mod(){ sCell tt=*Stack++; Tos = tt%Tos; } pp(Mod)
145 void UMul(){ Tos = (Cell) Tos * (Cell) *Stack++; } pp(UMul)
146 void UDiv(){ Cell tt=*Stack++; Tos = tt/(Cell)Tos; } pp(UDiv)
147 void And(){ Tos &= *Stack++; } pp(And)
148 void AndC(){ Tos = ~Tos & *Stack++; } pp(AndC)
149 void Or(){ Tos |= *Stack++; } pp(Or)
150 void Xor(){ Tos ^= *Stack++; } pp(Xor)
151 void ARshift(){ Tos = *Stack++ >> Tos ; } pp(ARshift)
152 void Rshift(){ Tos = *(Cell*)Stack++ >> Tos ; } pp(Rshift)
153 void Lshift(){ Tos = *Stack++ << Tos ; } pp(Lshift)
154
155 void HDot(){
156 tty_printf("%x ",Tos);
157 Tos = *Stack++;
158 } pp(HDot)
159
160 void UDot() {
161 __uint8_t buffer [44];
162 __uint8_t* p = &buffer;
163
164 size_t s = Tos;
165
166 do {
167 ++p;
168 s = s / numericBase;
169 } while(s);
170
171 *p = ' ';
172 p[1] = '\0';
173
174 do {
175 __uint8_t nn= (Tos % numericBase);
176 if(nn<10) *--p = '0' + nn;
177 else *--p = 'A' + nn - 10 ;
178 Tos = Tos / numericBase;
179 } while(Tos);
180 tty_puts(&buffer);
181 Tos = *Stack++;
182 } pp(UDot)
183
184 void Dot() {
185 if(Tos<0){_tty_putchar('-',0); Negate();}
186 UDot();
187 } pp(Dot)
188
189 void Load(){ Tos = *(Cell*)Tos; } pp(Load)
190 void Store(){ *(Cell*)Tos = *Stack++; Tos = *Stack++;} pp(Store)
191 void CLoad(){ Tos = (Cell)*(__uint8_t*) Tos; } pp(CLoad)
192 void CStore(){ *(__uint8_t*)Tos = (__uint8_t)*Stack++; Tos = *Stack++; } pp(CStore)
193 void CAddStore(){ *(__uint8_t*)Tos += (__uint8_t)*Stack++; Tos = *Stack++; } pp(CAddStore)
194 void CStoreA(){ *(__uint8_t*)Tos = (__uint8_t)*Stack++; } pp(CStoreA)
195 void WLoad(){ Tos = (Cell)*(__uint16_t*) Tos; } pp(WLoad)
196 void WStore(){ *(__uint16_t*)Tos = (__uint16_t)*Stack++; Tos = *Stack++; } pp(WStore)
197
198 void i2Store(){
199 __uint64_t val = ((__uint64_t)(Cell)Stack[1]<<32) + (__uint64_t)(Cell)Stack[0];
200 *(__uint64_t*)Tos = val;
201 Stack += 2 ; Tos = *Stack++;} pp(i2Store)
202
203 void i2Load(){ __uint64_t val = *(__uint64_t*)Tos; Tos= val; *--Stack=val>>32;} pp(i2Load)
204
205 void AddStore(){ *(Cell*)Tos += *Stack++; Tos = *Stack++;} pp(AddStore)
206 void Count(){ *--Stack = Tos+1; Tos = (sCell) *(char *)Tos; } pp(Count)
207 void On(){ *(Cell*)Tos = -1; Tos = *Stack++; } pp(On)
208 void Off(){ *(Cell*)Tos = 0; Tos = *Stack++; } pp(Off)
209 void Incr(){ *(Cell*)Tos += 1; Tos = *Stack++; } pp(Incr)
210 void ZEqual(){ Tos = -(Tos==0); } pp(ZEqual)
211 void ZNEqual(){ Tos = -(Tos!=0); } pp(ZNEqual)
212 void DZEqual(){ Tos = -( (Tos | *Stack++) == 0); } pp(DZEqual)
213 void ZLess(){ Tos = -(Tos<0); } pp(ZLess)
214 void Equal(){ Tos = -(*Stack++==Tos); } pp(Equal)
215 void NEqual(){ Tos = -(*Stack++!=Tos); } pp(NEqual)
216 void Less(){ Tos = -(*Stack++<Tos); } pp(Less)
217 void Great(){ Tos = -(*Stack++>Tos); } pp(Great)
218 void ULess(){ Tos = -((Cell)*Stack++ < (Cell)Tos); } pp(ULess)
219 void UGreat(){ Tos = -((Cell)*Stack++ > (Cell)Tos); } pp(UGreat)
220
221 void Max(){ sCell tt = *Stack++; if(tt>Tos) Tos=tt; } pp(Max)
222 void Min(){ sCell tt = *Stack++; if(tt<Tos) Tos=tt; } pp(Min)
223 void i0Max(){ if(Tos<0) Tos=0; } pp(i0Max)
224
225 void ToR(){ *--rStack = Tos; Tos = *Stack++; } pp(ToR)
226 void RLoad(){ *--Stack = Tos; Tos = *rStack; } pp(RLoad)
227 void FromR(){ *--Stack = Tos; Tos = *rStack++; } pp(FromR)
228 void i2ToR(){ *--rStack = *Stack++; *--rStack = Tos ; Tos = *Stack++; } pp(i2ToR)
229 void i2RLoad(){ *--Stack = Tos; Tos = *rStack; *--Stack = rStack[1]; } pp(i2RLoad)
230 void i2FromR(){ *--Stack = Tos; Tos = *rStack++; *--Stack = *rStack++; } pp(i2FromR)
231 void RDrop(){ *rStack++; } pp(RDrop)
232 void RPGet(){ *--Stack = Tos; Tos = (Cell) rStack; } pp(RPGet)
233 void SPGet(){ *--Stack = Tos; Tos = (Cell) Stack ; } pp(SPGet)
234 void RPSet(){ rStack = (sCell*)Tos; Tos = *Stack++; } pp(RPSet)
235 void SPSet(){ Stack = (sCell*)(Tos+sizeof(sCell)); Tos = Stack[-1]; } pp(SPSet)
236
237 void ZCount(){ *--Stack= Tos; Tos = strlen((char *)Tos); } pp(ZCount)
238
239 void Punch() {punch();} pp(Punch)
240
241 void Emit() {
242 drawRect(tty_pos_x, tty_pos_y, tty_off_pos_x, tty_off_pos_h, tty_bg_color);
243 _tty_putchar((char)Tos,0); // punch();
244 Tos = *Stack++; } pp(Emit)
245
246 void Space() {
247 drawRect(tty_pos_x, tty_pos_y, tty_off_pos_x, tty_off_pos_h, tty_bg_color); // punch();
248 tty_pos_x += tty_off_pos_x;
249 } pp(Space)
250
251 void Cr() { tty_putchar('\n',0); } pp(Cr)
252
253 void Type() {
254 char * str = (char *) *Stack;
255 drawRect(tty_pos_x, tty_pos_y, tty_off_pos_x*Tos, tty_off_pos_h, tty_bg_color);
256
257 for (size_t i = 0; i < Tos; i++) {
258 _tty_putchar(str[i], str[i+1]);
259 if (isUTF(str[i])){
260 i++;
261 }
262 } // punch();
263 *Stack++;
264 Tos = *Stack++;
265 } pp(Type)
266
267 void ZType() {_tty_puts((const char*)Tos); Tos = *Stack++;} pp(ZType)
268
269 void SetXY() // ( x y -- )
270 { tty_pos_y = Tos*tty_off_pos_h;
271 tty_pos_x = *Stack++ * tty_off_pos_x ;
272 Tos = *Stack++;
273 } pp(SetXY)
274
275 void GetXY() // ( -- x y )
276 { *--Stack = Tos;
277 Tos = tty_pos_y / tty_off_pos_h ;
278 *--Stack = tty_pos_x / tty_off_pos_x ;
279 } pp(GetXY)
280
281 extern uint32_t tty_pos_x;
282 extern uint32_t tty_pos_y;
283
284 void Ahead(){ Co(~pBranch); *--Stack = Tos; Tos = (sCell)here; Co(0);} pp(Ahead)
285 void If(){ Co(~pQBranch); *--Stack = Tos; Tos= (sCell)here; Co(0);} pp(If)
286 void Then(){ *(sCell**)Tos++ = here; Tos = *Stack++; } pp(Then)
287 void Else(){ Ahead(); Swap(); Then(); } pp(Else)
288 void Begin(){ *--Stack = Tos; Tos = (sCell)here; } pp(Begin)
289 void Until(){ Co(~pQBranch); *here++ = (sCell)Tos; Tos = *Stack++; } pp(Until)
290 void Again(){ Co(~pBranch); *here++ = (sCell)Tos; Tos = *Stack++; } pp(Again)
291 void While(){ If(); Swap(); } pp(While)
292 void Repeat(){ Again(); Then(); } pp(Repeat)
293
294 void DNegate(){ __int64_t val =
295 -(__int64_t)( ((__uint64_t)(Cell)Tos<<32) + (__uint64_t)(Cell)Stack[0] ) ;
296 Tos= val>>32;
297 Stack[0]=val;
298 } pp(DNegate)
299
300 void DAbs(){ if(Tos<0) DNegate(); } pp(DAbs)
301
302 void DAdd()
303 { __uint32_t sum= ((__uint64_t)(Cell)Tos<<32) + (__uint64_t)(Cell)Stack[0] +
304 ((__uint64_t)(Cell)Stack[1]<<32) + (__uint64_t)(Cell)Stack[2];
305 Stack += 2 ;
306 Tos= sum>>32;
307 Stack[0]=sum;
308 } pp(DAdd)
309
310 void UMMul()
311 { __uint64_t mul= (__uint64_t)(Cell)Tos * (__uint64_t)(Cell)Stack[0] ;
312 Tos= mul>>32;
313 Stack[0]=mul;
314 } pp(UMMul)
315
316 /* Divide 64-bit unsigned number (high half *b, low half *c) by
317 32-bit unsigend number in *a. Quotient in *b, remainder in *c.
318 */
319 static void udiv(__uint32_t a,__uint32_t *b,__uint32_t *c)
320 {
321 __uint32_t d,qh,ql;
322 int i,cy;
323 qh=*b;ql=*c;d=a;
324 if(qh==0) {
325 *b=ql/d;
326 *c=ql%d;
327 } else {
328 for(i=0;i<32;i++) {
329 cy=qh&0x80000000;
330 qh<<=1;
331 if(ql&0x80000000)qh++;
332 ql<<=1;
333 if(qh>=d||cy) {
334 qh-=d;
335 ql++;
336 cy=0;
337 }
338 *c=qh;
339 *b=ql;
340 }
341 }
342 }
343 void UMMOD()
344 { if(Tos<=*Stack) { /*overflow */
345 *++Stack=-1;
346 Tos = -1; return;
347 }
348 udiv(Tos,Stack,&Stack[1]);
349 Tos = *Stack++;
350 } pp(UMMOD)
351
352 void DIVMOD() // n1 n2 -- rem quot
353 { sCell tt=*Stack;
354 *Stack = tt%Tos ;
355 Tos = tt/Tos;
356 } pp(DIVMOD)
357
358 void Align()
359 { Cell sz = ( sizeof (Cell) - 1 ) ;
360 char * chere = (char *)here;
361 while( (Cell) chere & sz ) *chere++ = 0 ;
362 here = (sCell *)chere;
363 }
364 // CODE FILL ( c-addr u char -- ) \ 94
365 void Fill()
366 { Cell len = *Stack++;
367 __uint8_t *adr = (__uint8_t *) *Stack++;
368 while (len-- > 0) *adr++ = (__uint8_t)Tos;
369 Tos = *Stack++;
370 } pp(Fill)
371
372 void Cmove()
373 {
374 __uint8_t *c_to = (__uint8_t *) *Stack++;
375 __uint8_t *c_from =(__uint8_t *) *Stack++;
376 while (Tos-- > 0)
377 *c_to++ = *c_from++;
378 Tos = *Stack++;
379 } pp(Cmove)
380
381 void Cmove_up()
382 {
383 __uint8_t *c_to = (__uint8_t *) *Stack++;
384 __uint8_t *c_from =(__uint8_t *) *Stack++;
385 while (Tos-- > 0)
386 c_to[Tos] = c_from[Tos];
387 Tos = *Stack++;
388 } pp(Cmove_up)
389
390 void StrComp(const char * s, sCell len)
391 { char * chere = (char *)here;
392 len &= 0xff ;
393 *chere++ = (char)len; /* store count byte */
394 while (--len >= 0) /* store string */
395 *chere++ = *s++;
396
397 here = (sCell *)chere;
398 Align();
399 }
400
401 void StrCmp(){ StrComp((char *) *Stack++, Tos); Tos = *Stack++; } pp(StrCmp)
402
403 void Tp(const char * s) {
404 Co(~pStr);
405 StrComp(s, strlen(s));
406 Co(~pType);
407 }
408
409 void SpSet(){ Stack = (sCell*)*Stack; } pp(SpSet)
410
411 sCell ForthWordlist[] = {0,0,0};
412
413 const Cell ContextSize = 10;
414 sCell * Context[ContextSize] = {ForthWordlist};
415 sCell * Current[] = {ForthWordlist};
416
417 sCell * Last;
418 sCell * LastCFA;
419
420
421 void WordBuild (const char * name, sCell cfa )
422 {
423 LastCFA=here;
424 Co(cfa);
425 Co(0); // flg
426 Co(** (sCell **) Current);
427 Last=here;
428 StrComp(name, strlen(name));
429 }
430
431 void Smudge(){ **(sCell***) Current=Last; } pp(Smudge)
432
433 void Immediate(){ Last[-2] |= 1; } pp(Immediate)
434
435 void FthItem (const char * name, sCell cfa ){
436 WordBuild (name, cfa );
437 Smudge();
438 }
439
440 sCell Header(const char * name) {
441 FthItem (name,0);
442 *(sCell **)LastCFA = here;
443 return *(sCell *)LastCFA;
444 }
445
446 sCell Variable (const char * name ) {
447 FthItem(name,0);
448 *(sCell **) LastCFA = here;
449 *here++ = pDoVar;
450 *here++ = 0;
451 return *(sCell *)LastCFA;
452 }
453
454 sCell VVariable (const char * name, sCell val ) {
455 FthItem(name,0);
456 *(sCell **) LastCFA = here;
457 *here++ = ~pDoVar;
458 *here++ = val;
459 return *(sCell *)LastCFA;
460 }
461
462 sCell Constant (const char * name, sCell val ) {
463 FthItem(name,0);
464 *(sCell **) LastCFA = here;
465 *here++ = ~pDoConst;
466 *here++ = val;
467 return *(sCell *)LastCFA;
468 }
469 char atib[256]={"atib atib qwerty"};
470 sCell tib[]={0,(sCell)&atib}; PP(tib)
471 sCell ntib;
472 void Source(){
473 *--Stack = Tos;
474 *--Stack = tib[1];
475 Tos = ntib;
476 } pp(Source)
477
478 void SourceSet(){
479 ntib = Tos;
480 tib[1] = *Stack++;
481 Tos = *Stack++;
482 } pp(SourceSet)
483
484 // ALLOCATE ( u -- a-addr ior )
485 void Allocate()
486 {
487 *--Stack= Tos;
488
489 *Stack= (sCell) malloc(Tos);
490 Tos=0;
491 if(*Stack==0) Tos=-59;
492
493 } pp(Allocate)
494
495 void Free()
496 {
497 kfree((void*)Tos);
498 Tos=0;
499
500 } pp(Free)
501
502 sCell i2in[] = {0 , 0 }; PP(i2in)
503 sCell *v2in = (sCell *) &i2in[1];
504
505 sCell SourceId[] = { 0, 0 }; PP(SourceId)
506
507 void Accept() // ( c-addr +n -- +n' )
508 { keyboardctl(KEYBOARD_ECHO, true);
509 *(char *)*Stack=0;
510 gets_max((char *)*Stack,Tos);
511 Tos=strlen((char *)*Stack);
512 Stack++;
513 } pp(Accept)
514
515 void ParseName() {
516 Cell addr,Waddr,Eaddr;
517 addr= tib[1] + *v2in;
518 Eaddr= tib[1] + ntib;
519
520 *--Stack = Tos;
521 while ( addr<Eaddr ) { if( *(__uint8_t*)addr > ' ') break;
522 addr++; }
523 *--Stack=Waddr=addr;
524 *v2in = addr - tib[1];
525 while ( addr<=Eaddr ) { (*v2in)++; if( *(__uint8_t*)addr <= ' ') break;
526 addr++; }
527 Tos=addr-Waddr;
528 } pp(ParseName)
529
530 void Parse() {
531 Cell addr,Waddr,Eaddr;
532 if(((__uint8_t*)tib[1])[ntib] == '\r' ) ntib--;
533 addr= tib[1] + *v2in;
534 Eaddr= tib[1] + ntib;
535
536 char cc = (char)Tos;
537 *--Stack=Waddr=addr;
538 while ( addr<=Eaddr ) { (*v2in)++; if(*(__uint8_t*)addr == cc ) break;
539 addr++;}
540 Tos=addr-Waddr;
541 } pp(Parse)
542
543 #ifndef islower
544 __uint8_t islower (__uint8_t c)
545 {
546 if ( c >= 'a' && c <= 'z' ) return 1;
547 return 0;
548 }
549 #endif
550
551 #ifndef toupper
552 __uint8_t toupper(__uint8_t c)
553 {
554 return islower (c) ? c - 'a' + 'A' : c;
555 }
556 #endif
557
558 #ifndef memcasecmp
559
560 Cell memcasecmp (const void *vs1, const void *vs2, Cell n)
561 {
562 unsigned int i;
563 __uint8_t const *s1 = (__uint8_t const *) vs1;
564 __uint8_t const *s2 = (__uint8_t const *) vs2;
565 for (i = 0; i < n; i++)
566 {
567 __uint8_t u1 = *s1++;
568 __uint8_t u2 = *s2++;
569 if (toupper (u1) != toupper (u2))
570 return toupper (u1) - toupper (u2);
571 }
572 return 0;
573 }
574 #endif
575
576 Cell CCompare( void * caddr1 , Cell len1 , void * caddr2 , Cell len2) {
577 if (len1 < len2) return -1;
578 if (len1 > len2) return 1;
579
580 // auto cmpResult = std::memcmp(caddr1, caddr2, len1);
581
582 Cell cmpResult = memcasecmp(caddr1, caddr2, len1);
583
584 if (cmpResult < 0) return -1;
585 if (cmpResult > 0) return 1;
586 return 0;
587 }
588
589 void UCompare(){
590 char * caddr1 = (char *) *Stack++;
591 sCell len1 = *Stack++;
592 char * caddr2 = (char *) *Stack++;
593
594 if (len1 != Tos) { Tos -= len1; return; }
595
596 Tos = memcasecmp(caddr1, caddr2, Tos); } pp(UCompare)
597
598 char *SEARCH(char **wid, char * word , Cell len)
599 { char * addr= (char *) *wid;
600 for(;;)
601 { if(!addr) return NULL;
602 char * caddr = addr ;
603 if( !CCompare(word, len, caddr+1, *caddr ))
604 return addr;
605 addr = ((char **)addr)[-1];
606 }
607 }
608
609 void FromName(){ Tos=((sCell *)Tos)[-3]; } pp(FromName)
610
611 void SearchWordList() // ( c-addr u wid --- 0 | xt 1 xt -1 )
612 {
613 char ** addr= (char **) Tos;
614 Cell len=Stack[0];
615 char * word= (char * ) Stack[1];
616
617 if(!addr) { Stack+=2; Tos=0; return; }
618 Cell * nfa= (Cell*) SEARCH(addr,word,len);
619 if(!nfa) {
620 Stack+=2; Tos=0;
621 return;
622 }
623 Stack++;
624 Stack[0]=nfa[-3];
625 Tos = nfa[-2]&1 ? 1 : -1;
626
627 } pp(SearchWordList)
628
629 void SFind()
630 { sCell * voc= (sCell *) Context;
631 *--Stack = Tos;
632 while( *voc )
633 { *--Stack = Stack[1];
634 *--Stack = Stack[1]; Tos=*voc;
635 SearchWordList();
636 if(Tos)
637 { Stack[2]=Stack[0]; Stack+=2; // 2nip
638 return;
639 } voc++;
640 }
641
642 } pp(SFind)
643
644 Cell State;
645
646 void StateQ(){ *--Stack= Tos; Tos = State; } pp(StateQ)
647
648 void IMode(){ State = 0;} pp(IMode)
649 void CMode(){ State = -1;} pp(CMode)
650
651 sCell * YDP;
652 sCell * YDP0;
653
654 sCell YDPFL[] = { pDoConst, 0 }; pp(YDPFL)
655
656 void QYDpDp()
657 {
658 if(YDPFL[1] == 0) return;
659 sCell * tmp = YDP ;
660 YDP = here ;
661 here = tmp ;
662 }
663
664 void SBuild()
665 { char * name = (char * ) *Stack++ ;
666 QYDpDp();
667 LastCFA=here;
668 Co(0);
669 Co(0); // flg
670 Co(** (sCell **) Current);
671 Last=here;
672 StrComp(name, Tos);
673 Tos = *Stack++;
674 QYDpDp();
675 *(sCell **)LastCFA = here;
676 }
677
678 void Build()
679 { // *--Stack = Tos; Tos=(sCell)pNoop;
680 ParseName();
681 SBuild();
682 } pp(Build)
683
684 void SHeader()
685 {
686 SBuild();
687 Smudge();
688 } pp(SHeader)
689
690 void SNumber0() // ( str len -- m flg )
691 {
692 char* rez;
693 char NumStr[44];
694 sCell signedFlg = 1;
695 Cell len = Tos;
696 char * caddr = (char*) Stack[0];
697 if(caddr[0]=='-') { len--; caddr++; signedFlg = -1; }
698 NumStr[len]=0;
699 while(len){ --len; NumStr[len] = caddr[len]; }
700 *Stack = strtoul( NumStr, &rez, numericBase) * signedFlg;
701 Tos = strlen(rez);
702 } pp(SNumber0)
703
704 void Colon(){
705 Build();
706 CMode(); } pp( Colon)
707 void Semicolon(){ Co(~pExit); Smudge(); IMode(); } pp(Semicolon)
708
709 void to_catch(){
710 *--rStack = (sCell)Handler;
711 *--rStack = (sCell)Stack;
712 Handler = rStack;
713 Execute();
714 } pp(to_catch)
715
716 void from_catch(){
717 rStack++;
718 Handler = (sCell*)*rStack++;
719 *--Stack = Tos; Tos = 0;
720 ip = (sCell*)*rStack++; // exit
721 } pp(from_catch)
722
723 sCell Catch[] = { 0,0 }; PP(Catch)
724
725 void FThrowDo()
726 { *--Stack = Tos;
727 if (Handler == NULL); // TODO("Handler=0")
728 rStack = Handler ;
729 Stack = (sCell*)*rStack++;
730 Handler = (sCell*)*rStack++;
731 ip = (sCell * ) *rStack++;
732 }
733
734 void FThrow(){
735 if (Tos == 0){ Tos = *Stack++; return; }
736 FThrowDo();
737 } pp(FThrow)
738
739 sCell Lastin =0;
740 sCell SaveErrQ = -1;
741 sCell ErrIn;
742
743 void SaveErr0()
744 { if(SaveErrQ & Tos )
745 { SaveErrQ = 0;
746 ErrIn = *v2in ;
747 }
748
749 } pp(SaveErr0)
750
751
752 void PrintErr0()
753 { numericBase = 10;
754 _tty_printf("Err=%d\n",Tos);
755 Tos = *Stack++;
756 SaveErrQ=-1;
757 } pp(PrintErr0)
758
759 // R/O ( -- fam )
760 void readOnly() { *--Stack = Tos; Tos = O_READ; } pp(readOnly)
761
762 // R/W ( -- fam )
763 void readWrite() { *--Stack = Tos; Tos = O_WRITE | O_READ; } pp(readWrite)
764
765 // W/O ( -- fam )
766 void writeOnly() { *--Stack = Tos; Tos = O_WRITE ; } pp(writeOnly)
767
768
769
773 typedef struct FILEID {
774 FILE fl;
775 char filename[0];
776 } FILEID;
777
778
779 // OPEN-FILE ( c-addr u fam -- fileid ior )
780
781 void openFile() {
782 Cell flen = *Stack++;
783 Cell plen = 0;
784 char * caddr = (char*) *Stack;
785
786 if(caddr[1]!=':') plen = strlen(&G_CLI_PATH);
787
788 FILE* file = kcalloc(sizeof(FILE)+plen+flen+1, 1);
789
790 char * filename =&((FILEID*)file)->filename[0];
791
792 filename[plen+flen]=0;
793
794 while(flen){ --flen; filename[plen+flen] = caddr[flen]; }
795
796 while(plen){ --plen; filename[plen] = G_CLI_PATH[plen]; }
797
798 if(Tos & 0x8000 ) nvfs_create(filename, 0);
799 FSM_FILE finfo = nvfs_info(filename);
800 if (finfo.Ready == 0) {
801 //kfree(file);
802 qemu_err("Failed to open file: %s (Exists: %d)",
803 filename,
804 finfo.Ready);
805 Tos = -69;
806 return ;
807 }
808
809 file->open = 1; // Файл успешно открыт
810 file->fmode = Tos; // Режим работы с файлом
811 file->size = finfo.Size;// Размер файла
812 file->path = filename; // Полный путь к файлу
813 file->pos = 0; // Установка указателя в самое начало
814 file->err = 0; // Ошибок в работе нет
815
816 *Stack =(sCell)file;
817 Tos = 0;
818
819 } pp(openFile)
820
821
822
823 // CLOSE-FILE ( fileid -- ior )
824 void closeFile() { fclose((FILE*)Tos); Tos = 0; } pp(closeFile)
825
826 // READ-FILE ( c-addr u1 fileid -- u2 ior )
827 void readFile() {
828
829 Cell len = *Stack++;
830 char * buffer = (char*) *Stack;
831 FILE* file = (FILE*) Tos;
832 if( len > (file->size - file->pos)) len = file->size - file->pos;
833 if(!len) { *Stack=0; Tos = 0; return; }
834
835 *Stack = fread( file , 1, len, buffer);
836 Tos = 0;
837 if(*Stack==-1) Tos = -70;
838
839 } pp(readFile)
840
841 // READ-LINE ( c-addr u1 fileid -- u2 flag ior )
842 void readLine() {
843
844 FILE* file = (FILE*) Tos;
845
846 if(file->pos == file->size){ Stack[1]=*Stack=Tos=0; return;}
847
848 Cell len = *Stack;
849 char * buffer = (char*) Stack[1];
850 if( len > (file->size+1 - file->pos)) len = file->size+1 - file->pos;
851
852 *Stack = fread( file , 1, len, buffer);
853 Tos = 0;
854 if(*Stack==-1){ Tos = -71; return; }
855 file->pos -= len;
856 len = 0;
857 while(file->size > file->pos)
858 { file->pos++;
859 if(buffer[len]=='\n'){ break;}
860 len++;
861 }
862 if(buffer[len]=='\r') len--;
863 Stack[1]=len;
864 *Stack=-1;
865 Tos=0;
866
867 } pp(readLine)
868
869 // WRITE-FILE ( c-addr u1 fileid -- ior )
870 void writeFile() {
871
872 Cell len = *Stack++;
873 char * buffer = (char*) *Stack++;
874 FILE* file = (FILE*) Tos;
875
876 Tos = fwrite( file , len, 1, buffer);
877 Tos = 0; // &= -70;
878
879 } pp(writeFile)
880
881 // RESIZE-FILE ( ud fileid -- ior )
882
883 void resizeFile() {
884 FILE* file = (FILE*) Tos;
885 file->size = *Stack++;
886 Tos=0;
887 } pp(resizeFile)
888
889
890 char filename[111];
891
892 //int tshell();
893 void Test1(void) {
894 // tshell();
895 } pp(Test1)
896
897 void Test2(void) {
898
899 const char* filename = "T:/filename.txt";
900 if(touch(filename))
901 { FILE* file;
902 file = fopen(filename, "r");
903 if(file)
904 { fwrite(file, 5 , 1, "bytes");
905 fclose(file);
906 }
907 else
908 { tty_printf("fopen %s err\n",filename);
909 }
910 }
911 else
912 { tty_printf("touch err\n");
913 }
914
915 filename = "T:/filenameq.txt";
916 if(touch(filename))
917 { FILE* file;
918 file = fopen(filename, "r");
919 if(file)
920 { fwrite(file, 5 , 1, "bytes");
921 fclose(file);
922 }
923 else
924 { tty_printf("fopen %s err\n",filename);
925 }
926 }
927 else
928 { tty_printf("touch err\n");
929 }
930
931 tty_printf("Test2\n"); } pp(Test2)
932
933 void Test3(void) {
934
935
936 FILE* file_ = (FILE*)Tos;
937
938
939 size_t filesize = fsize(file_);
940
941 uint8_t* buffer = kcalloc(1,filesize + 1);
942
943 fread(file_, 1, filesize, buffer);
944
945 tty_printf("%s", buffer);
946
947 fclose(file_);
948
949 kfree(buffer);
950
951 Drop();
952
953 } pp(Test3)
954
955
956
957 void Bye(void) {forth_run=0;} pp(Bye)
958
959 const char *initScript =
960 " : 2NIP 2SWAP 2DROP ;\n"
961 " : COMPILE, , ;\n"
962 " : HEX 16 BASE ! ;\n"
963 ": DECIMAL 10 BASE ! ;\n"
964 ": HEADER BUILD SMUDGE ;\n"
965 ": CONSTANT HEADER DOCONST , , ;\n"
966 ": CREATE HEADER DOVAR , ;\n"
967 ": VARIABLE CREATE 0 , ;\n"
968 ": [COMPILE] ' , ; IMMEDIATE\n"
969 ": CELL+ CELL + ;\n"
970 ": CELL- CELL - ;\n"
971 ": CELLS CELL * ;\n"
972 ": >BODY CELL+ ;\n"
973 ": COMPILE R> DUP @ , CELL+ >R ;\n"
974 ": CHAR PARSE-NAME DROP C@ ;\n"
975 ": [CHAR] CHAR LIT, ; IMMEDIATE\n"
976 ": ['] ' LIT, ; IMMEDIATE\n"
977 ": .( [CHAR] ) PARSE TYPE ; IMMEDIATE\n"
978 ": ( [CHAR] ) PARSE 2DROP ; IMMEDIATE\n"
979 ": SLIT, ( string -- ) COMPILE <$> $, ;\n"
980 ": \\ 10 PARSE 2DROP ; IMMEDIATE\n"
981 ": .\\ 10 PARSE TYPE cr ; IMMEDIATE\n"
982 ": .\" [CHAR] \" PARSE SLIT, COMPILE TYPE ; IMMEDIATE\n"
983 ": S\" [CHAR] \" PARSE ?STATE IF SLIT, THEN ; IMMEDIATE\n"
984 ": ABORT -1 THROW ;\n"
985 ": POSTPONE\n" // 94
986 " PARSE-NAME SFIND DUP\n"
987 " 0= IF -321 THROW THEN \n"
988 " 1 = IF COMPILE,\n"
989 " ELSE LIT, ['] COMPILE, COMPILE, THEN\n"
990 "; IMMEDIATE\n"
991 ": TO '\n"
992 " ?STATE 0= IF >BODY ! EXIT THEN\n"
993 " >BODY LIT, POSTPONE ! ; IMMEDIATE\n"
994 ": ERASE 0 FILL ;\n"
995 ": $!\n" // ( addr len dest -- )
996 "SWAP 255 AND SWAP 2DUP C! 1+ SWAP CMOVE ;\n"
997 ": DEFER@ ( xt1 -- xt2 ) >BODY @ ;\n"
998 ": VALUE CONSTANT ;\n"
999 ": (DO) ( n1 n2 ---)\n"
1000 // Runtime part of DO.
1001 " R> ROT ROT SWAP >R >R >R ;\n"
1002 ": (?DO) ( n1 n2 ---)\n"
1003 // Runtime part of ?DO
1004 " OVER OVER - IF R> ROT ROT SWAP >R >R CELL+ >R \n"
1005 " ELSE DROP DROP R> @ >R\n" // Jump to leave address if equal
1006 " THEN ;\n"
1007 ": I ( --- n )\n"
1008 // Return the counter (index) of the innermost DO LOOP
1009 " POSTPONE R@ ; IMMEDIATE\n"
1010 ": z\\ 10 PARSE h. h. ; IMMEDIATE\n"
1011
1012 ": J ( --- n)\n"
1013 // Return the counter (index) of the next loop outer to the innermost DO LOOP
1014 " RP@ 3 CELLS + @ ;\n"
1015 "VARIABLE 'LEAVE ( --- a-addr)\n" // This variable is used for LEAVE address resolution.
1016
1017 ": (LEAVE) ( --- )\n"
1018 // Runtime part of LEAVE
1019 " R> @ R> DROP R> DROP >R ;\n" // Remove loop parameters and replace top of ret\n"
1020 // stack by leave address.\n"
1021
1022 ": UNLOOP ( --- )\n"
1023 // Remove one set of loop parameters from the return stack.
1024 " R> R> DROP R> DROP >R ;\n"
1025
1026 ": (LOOP) ( ---)\n"
1027 // Runtime part of LOOP
1028 " R> R> 1+ DUP R@ = \n" // Add 1 to count and compare to limit.
1029 " IF \n"
1030 " R> DROP DROP CELL+ >R\n" // Discard parameters and skip leave address.
1031 " ELSE \n"
1032 " >R @ >R\n" // Repush counter and jump to loop start address.
1033 " THEN ;\n"
1034
1035 ": (+LOOP) ( n ---)\n"
1036 // Runtime part of +LOOP
1037 // Very similar to (LOOP), but the compare condition is different.
1038 // exit if ( oldcount - lim < 0) xor ( newcount - lim < 0).
1039 " R> SWAP R> DUP R@ - ROT ROT + DUP R@ - ROT XOR 0 < \n"
1040 " IF R> DROP DROP CELL+ >R\n"
1041 " ELSE >R @ >R THEN ;\n"
1042
1043 ": DO ( --- x)\n"
1044 // Start a DO LOOP.
1045 // Runtime: ( n1 n2 --- ) start a loop with initial count n2 and
1046 // limit n1.
1047 " POSTPONE (DO) 'LEAVE @ HERE 0 'LEAVE ! \n"
1048 " ; IMMEDIATE\n"
1049
1050 ": ?DO ( --- x )\n"
1051 // Start a ?DO LOOP.\n"
1052 // Runtime: ( n1 n2 --- ) start a loop with initial count n2 and
1053 // limit n1. Exit immediately if n1 = n2.
1054 " POSTPONE (?DO) 'LEAVE @ HERE 'LEAVE ! 0 , HERE ; IMMEDIATE\n"
1055
1056 ": LEAVE ( --- )\n"
1057 // Runtime: leave the matching DO LOOP immediately.
1058 // All places where a leave address for the loop is needed are in a linked\n"
1059 // list, starting with 'LEAVE variable, the other links in the cells where
1060 // the leave addresses will come.
1061 " POSTPONE (LEAVE) HERE 'LEAVE @ , 'LEAVE ! ; IMMEDIATE\n"
1062 ": RESOLVE-LEAVE\n"
1063 // Resolve the references to the leave addresses of the loop.
1064 " 'LEAVE @\n"
1065 " BEGIN DUP WHILE DUP @ HERE ROT ! REPEAT DROP ;\n"
1066
1067 ": LOOP ( x --- )\n"
1068 // End a DO LOOP.
1069 // Runtime: Add 1 to the count and if it is equal to the limit leave the loop.
1070 " POSTPONE (LOOP) , RESOLVE-LEAVE 'LEAVE ! ; IMMEDIATE\n"
1071
1072 ": +LOOP ( x --- )\n"
1073 // End a DO +LOOP
1074 // Runtime: ( n ---) Add n to the count and exit if this crosses the
1075 // boundary between limit-1 and limit.
1076 " POSTPONE (+LOOP) , RESOLVE-LEAVE 'LEAVE ! ; IMMEDIATE\n"
1077
1078 ": (;CODE) ( --- )\n"
1079 // Runtime for DOES>, exit calling definition and make last defined word
1080 // execute the calling definition after (;CODE)
1081 " R> LAST @ NAME> ! ;\n"
1082
1083 ": DOES> ( --- )\n"
1084 // Word that contains DOES> will change the behavior of the last created
1085 // word such that it pushes its parameter field address onto the stack
1086 // and then executes whatever comes after DOES>
1087 " POSTPONE (;CODE) \n"
1088 " POSTPONE R>\n" // Compile the R> primitive, which is the first
1089 // instruction that the defined word performs.
1090 "; IMMEDIATE\n"
1091
1092 ": SET-CURRENT ( wid -- )\n" // 94 SEARCH
1093 " CURRENT ! ;\n"
1094
1095 ": GET-CURRENT ( -- wid )\n" // 94 SEARCH
1096 " CURRENT @ ;\n"
1097
1098 ": GET-ORDER ( -- widn ... wid1 n )\n" // 94 SEARCH
1099 " SP@ >R 0 >R\n"
1100 " CONTEXT\n"
1101 " BEGIN DUP @ ?DUP\n"
1102 " WHILE >R CELL+\n"
1103 " REPEAT DROP\n"
1104 " BEGIN R> DUP 0=\n"
1105 " UNTIL DROP\n"
1106 "R> SP@ - CELL / 1- ; \n"
1107
1108 " HERE S\" FORTH\" $, FORTH-WORDLIST CELL+ !\n"
1109
1110 ": VOC-NAME. ( wid -- )\n"
1111 "DUP CELL+ @ DUP IF COUNT TYPE BL EMIT DROP ELSE DROP .\" <NONAME>:\" U. THEN ;\n"
1112
1113 ": ORDER ( -- )\n" // 94 SEARCH EXT
1114 "GET-ORDER .\" Context: \" \n"
1115 "0 ?DO ( DUP .) VOC-NAME. SPACE LOOP CR\n"
1116 ".\" Current: \" GET-CURRENT VOC-NAME. CR ;\n"
1117
1118 ": SET-ORDER ( wid1 ... widn n -- )\n"
1119 "DUP -1 = IF\n"
1120 "DROP FORTH-WORDLIST 1\n"
1121 "THEN\n"
1122 "DUP CONTEXT-SIZE U> IF -49 THROW THEN\n"
1123 "DUP CELLS context + 0!\n"
1124 "0 ?DO I CELLS context + ! LOOP ;\n"
1125 "CREATE VOC-LIST FORTH-WORDLIST CELL+ CELL+ ,\n"
1126
1127 ": FORTH FORTH-WORDLIST CONTEXT ! ;\n"
1128 ": DEFINITIONS CONTEXT @ CURRENT ! ;\n"
1129
1130 ": WORDLIST ( -- wid )\n" // 94 SEARCH
1131 " HERE 0 , 0 , \n"
1132 " HERE VOC-LIST @ , .\" W=\" DUP H. VOC-LIST ! ;\n"
1133
1134 ": ONLY ( -- ) -1 SET-ORDER ;\n"
1135 ": ALSO ( -- ) GET-ORDER OVER SWAP 1+ SET-ORDER ;\n"
1136 ": PREVIOUS ( -- ) GET-ORDER NIP 1- SET-ORDER ;\n"
1137
1138
1139 ": LATEST ( -> NFA ) CURRENT @ @ ;\n"
1140
1141 ": VOCABULARY ( <spaces>name -- )\n"
1142 "WORDLIST CREATE DUP ,\n"
1143 "LATEST SWAP CELL+ !\n"
1144 "DOES> @ CONTEXT ! ;\n"
1145 " VARIABLE CURSTR\n"
1146
1147 ": ->DEFER ( cfa <name> -- ) HEADER DODEFER , , ;\n"
1148 ": DEFER ( <name> -- ) ['] ABORT ->DEFER ;\n"
1149
1150 ": VECT DEFER ;\n"
1151
1152 ": FQUIT BEGIN REFILL WHILE CURSTR 1+!\n"
1153 " INTERPRET REPEAT ;\n"
1154
1155 ": LALIGNED 3 + 3 ANDC ;\n"
1156
1157 " 255 CONSTANT TC/L\n"
1158
1159 ": INCLUDE-FILE\n" // ( fid --- )
1160 // Read lines from the file identified by fid and interpret them.
1161 // INCLUDE and EVALUATE nest in arbitrary order.
1162 "SOURCE-ID >R >IN @ >R LASTIN @ >R CURSTR @ >R CURSTR 0!\n"
1163 "SOURCE 2>R\n"
1164 " TC/L ALLOCATE THROW TC/L SOURCE!\n"
1165 "TO SOURCE-ID\n"
1166 "['] FQUIT CATCH SAVEERR\n"
1167 "TIB FREE DROP\n"
1168 "2R> SOURCE!\n"
1169
1170 "R> CURSTR ! R> LASTIN ! R> >IN ! R> TO SOURCE-ID\n"
1171 "THROW ;\n"
1172
1173 ": FREFILL0\n" // ( -- flag )
1174 " TIB TC/L SOURCE-ID READ-LINE THROW\n"
1175 " SWAP #TIB ! 0 >IN ! CURSTR 1+!\n"
1176 " 0 SOURCE + C! ;\n"
1177 "' FREFILL0 TO FREFILL\n"
1178
1179 "444 CONSTANT CFNAME_SIZE\n"
1180 "CREATE CURFILENAME CFNAME_SIZE 255 + 1+ ALLOT\n"
1181 "CURFILENAME CFNAME_SIZE 255 + 1+ ERASE\n"
1182
1183 ": CFNAME-SET\n" // ( adr len -- )
1184 "DUP 1+ >R CURFILENAME CURFILENAME R@ + CFNAME_SIZE R> - CMOVE>\n"
1185 "CURFILENAME $! ;\n"
1186
1187 ": CFNAME-FREE\n" // ( -- )
1188 "CURFILENAME COUNT + CURFILENAME\n"
1189 "CFNAME_SIZE CURFILENAME C@ - 255 + CMOVE ;\n"
1190
1191 ": INCLUDED\n" // ( c-addr u ---- )
1192 "2DUP CFNAME-SET\n"
1193 "R/O OPEN-FILE THROW\n"
1194 "DUP >R ['] INCLUDE-FILE CATCH\n"
1195 "DUP IF cr .\" in <\" CURFILENAME COUNT TYPE .\" >\" CURSTR @ . THEN CFNAME-FREE\n"
1196 "R> CLOSE-FILE DROP THROW ;\n"
1197
1198 ": EVALUATE\n" // ( i*x c-addr u -- j*x ) \ 94
1199 "SOURCE-ID >R SOURCE 2>R >IN @ >R\n"
1200 "-1 TO SOURCE-ID\n"
1201 "SOURCE! >IN 0!\n"
1202 "['] INTERPRET CATCH\n"
1203 "R> >IN ! 2R> SOURCE! R> TO SOURCE-ID\n"
1204 "THROW ;\n"
1205
1206 ": FLOAD PARSE-NAME INCLUDED ;\n"
1207
1208 ": [DEFINED]\n" // ( -- f ) \ "name"
1209 "PARSE-NAME SFIND IF DROP -1 ELSE 2DROP 0 THEN ; IMMEDIATE\n"
1210
1211 ": [UNDEFINED]\n" // ( -- f ) \ "name"
1212 "POSTPONE [DEFINED] 0= ; IMMEDIATE\n"
1213
1214 ": \\+ POSTPONE [UNDEFINED] IF POSTPONE \\ THEN ; IMMEDIATE\n"
1215 ": \\- POSTPONE [DEFINED] IF POSTPONE \\ THEN ; IMMEDIATE\n"
1216
1217 ": BREAK POSTPONE EXIT POSTPONE THEN ; IMMEDIATE\n"
1218
1219 ": PRIM? 0< ['] DUP 0< = ;\n"
1220
1221 ": ?CONST\n" // ( cfa -- cfa flag )
1222 "DUP PRIM? IF 0 BREAK\n"
1223 "DUP @ DOCONST = ;\n"
1224
1225 ": ?VARIABLE\n" // ( cfa -- cfa flag )
1226 "DUP PRIM? IF 0 BREAK\n"
1227 "DUP @ DOVAR = ;\n"
1228
1229 "S\" autoexec.4th\" INCLUDED"
1230 ;
1231
1232 void InitStringSet()
1233 { tib[1]=(__uint32_t)initScript;
1234 ntib=strlen(initScript);
1235 *v2in = 0;
1236 } pp(InitStringSet)
1237
1238
1239 void pek()
1240 { kbdstatus=0;
1241 while(!kbdstatus);
1242 }
1243
1244
1245 void KeyQ()
1246 { *--Stack= Tos;
1247 Tos = inb(PS2_STATE_REG)&1;
1248 } pp(KeyQ)
1249
1250 void Key()
1251 { __uint8_t cc[1];
1252 keyboardctl(KEYBOARD_ECHO, false);
1253 *--Stack= Tos;
1254 gets_max(&cc,1);
1255 Tos= (Cell) cc[0] ;
1256
1257 } pp(Key)
1258
1259 void LastKey()
1260 {
1261 *--Stack= Tos;
1262 Tos = getCharRaw();
1263 } pp(LastKey)
1264
1265 void ChLastKey()
1266 {
1267 static int lgetCharRaw = 0;
1268 *--Stack= Tos;
1269 do{
1270 while(Tos==lgetCharRaw) Tos = getCharRaw() ;
1271 lgetCharRaw=Tos;
1272 }while(!Tos);
1273
1274 } pp(ChLastKey)
1275
1276 void KBctl()
1277 {
1278 keyboardctl(Tos,*Stack++);
1279 Tos = *Stack++;
1280 } pp(KBctl)
1281
1282 extern int lastKey;
1283
1284 void ScanKey()
1285 {
1286
1287 static bool kmutex = false;
1288 mutex_get(&kmutex, true);
1289
1290 // keyboardctl(KEYBOARD_ECHO, false);
1291
1292 *--Stack= Tos;
1293
1294 while(lastKey==0 || (lastKey & 0x80)) { sleep_ms(11); }
1295 Tos = lastKey;
1296 lastKey = 0;
1297
1298 // keyboardctl(KEYBOARD_ECHO, true);
1299 mutex_release(&kmutex);
1300
1301 } pp(ScanKey)
1302
1303 void Scan2Un()
1304 {
1305 Tos = *(uint16_t*)getCharKeyboard(Tos, false);
1306
1307 } pp(Scan2Un)
1308
1309
1310 extern bool SHIFT,key_alt;
1311
1312 void QShift()
1313 {
1314 *--Stack= Tos;
1315 Tos = SHIFT;
1316 } pp(QShift);
1317
1318 void QCtrl()
1319 {
1320 *--Stack= Tos;
1321 Tos = is_lctrl_key();
1322 } pp(QCtrl);
1323
1324 void QAlt()
1325 {
1326 *--Stack= Tos;
1327 Tos = key_alt;
1328 } pp(QAlt);
1329
1330 extern uint32_t framebuffer_height;
1331
1332 uint32_t CursorHSize = 5;
1333
1334 void Cursor()
1335 {
1336 int ox = 0, oy = 0;
1337 oy = getPosY();
1338 if( (oy+tty_off_pos_h-3) > framebuffer_height ) return;
1339 ox = getPosX();
1340 uint8_t* pixels = framebuffer_addr + (ox * (framebuffer_bpp >> 3)) + (oy+tty_off_pos_h-3) * framebuffer_pitch;
1341
1342 uint32_t ii = framebuffer_bpp;
1343 while(ii--) pixels[ii] ^= 255;
1344
1345 uint32_t jj = CursorHSize;
1346 while(jj--)
1347 { pixels -= framebuffer_pitch;
1348 ii = framebuffer_bpp;
1349 while(ii--) pixels[ii] ^= 255;
1350 }
1351
1352 } pp(Cursor)
1353
1354
1355 void OpenDir() // ( c-addr lem -- dir-id flag )
1356 { Cell dlen = Tos;
1357 Cell plen = 0;
1358 char * caddr = (char*) *Stack;
1359
1360 if(caddr[1]!=':') plen = strlen(&G_CLI_PATH);
1361
1362 char * path = kcalloc(plen+dlen+1, 1);
1363
1364 path[plen+dlen]=0;
1365
1366 while(dlen){ --dlen; path[plen+dlen] = caddr[dlen]; }
1367
1368 while(plen){ --plen; path[plen] = G_CLI_PATH[plen]; }
1369
1370 FSM_DIR* Dir = nvfs_dir(path);
1371 Tos = -(Dir->Ready != 1) ;
1372 *Stack = (Cell)Dir;
1373
1374 } pp(OpenDir)
1375
1376 void DirI2Name() // ( dir-id n -- z-addr )
1377 { Tos = (Cell)((FSM_DIR*)*Stack++)->Files[Tos].Name ;
1378 } pp(DirI2Name)
1379
1380 void DirI2Type() // ( dir-id n -- n )
1381 { Tos = ((FSM_DIR*)*Stack++)->Files[Tos].Type ;
1382 } pp(DirI2Type)
1383
1384 void Dir2Count() // ( dir-id -- n )
1385 { Tos = (Cell)((FSM_DIR*)Tos)->Count ;
1386 } pp(Dir2Count)
1387
1388 void CloseDir() // ( dir-id -- flg )
1389 { FSM_DIR* Dir = (FSM_DIR*)Tos;
1391 kfree(Dir->Files);
1393 kfree(Dir);
1394 Tos = 0;
1395 } pp(CloseDir)
1396
1397 void ZCli()
1398 { cli_handler( (char*) Tos);
1399 Tos = *Stack++;
1400 } pp(ZCli)
1401
1402
1403
1404 void MakeImag(void)
1405 {
1406 // tty_printf("MakeImag run\n");
1407 FthItem("NOOP",~pNoop );
1408 FthItem("+",~pAdd );
1409 FthItem("-",~pSub );
1410 FthItem("D+",~pDAdd );
1411 FthItem("1+",~pi1Add );
1412 FthItem("1-",~pi1Sub );
1413 FthItem("2+",~pi2Add );
1414 FthItem("2-",~pi2Sub );
1415 FthItem("INVERT",~pInvert);
1416 FthItem("NEGATE",~pNegate);
1417 FthItem("DNEGATE",~pDNegate);
1418 FthItem("DABS",~pDAbs);
1419 FthItem("*",~pMul);
1420 FthItem("/",~pDiv);
1421 FthItem("2*",~pi2Mul);
1422 FthItem("2/",~pi2Div);
1423 FthItem("MOD",~pMod);
1424 FthItem("U*",~pUMul);
1425 FthItem("U/",~pUDiv);
1426 FthItem("UM*",~pUMMul);
1427 FthItem("UM/MOD",~pUMMOD);
1428 FthItem("/MOD",~pDIVMOD);
1429 FthItem("AND",~pAnd);
1430 FthItem("ANDC",~pAndC);
1431 FthItem("OR",~pOr);
1432 FthItem("XOR",~pXor);
1433 FthItem("ARSHIFT",~pARshift);
1434 FthItem("RSHIFT",~pRshift);
1435 FthItem("LSHIFT",~pLshift);
1436 FthItem("DUP",~pDup );
1437 FthItem("CS-DUP",~pDup );
1438 FthItem("?DUP",~pQDup );
1439 FthItem("OVER",~pOver );
1440 FthItem("CS-OVER",~pOver );
1441 FthItem("TUCK",~pTuck );
1442 FthItem("PICK",~pPick );
1443 FthItem("CS-PICK",~pPick );
1444 FthItem("SWAP",~pSwap );
1445 FthItem("CS-SWAP",~pSwap );
1446 FthItem("2SWAP",~pi2Swap );
1447 FthItem("ROT",~pRot );
1448 FthItem("DROP",~pDrop );
1449 FthItem("NIP",~pNip );
1450 FthItem("2DROP",~pi2drop );
1451 FthItem("2DUP",~pi2dup );
1452 FthItem("2OVER",~pi2over);
1453 FthItem(".",~pDot);
1454 FthItem("U.",~pUDot);
1455 FthItem("H.",~pHDot);
1456 FthItem("CATCH",PCatch);
1457 FthItem("THROW",~pFThrow);
1458 FthItem("[",~pIMode); Immediate();
1459 FthItem("]",~pCMode);
1460 FthItem("@",~pLoad);
1461 FthItem("C@",~pCLoad);
1462 FthItem("C!",~pCStore);
1463 FthItem("C+!",~pCAddStore);
1464 FthItem("C!A",~pCStoreA);
1465 FthItem("W@",~pWLoad);
1466 FthItem("W!",~pWStore);
1467 FthItem("2!",~pi2Store);
1468 FthItem("2@",~pi2Load);
1469 FthItem("COUNT",~pCount);
1470 FthItem("!",~pStore);
1471 FthItem("+!",~pAddStore);
1472 FthItem("1+!",~pIncr);
1473 FthItem("0!",~pOff);
1474 FthItem("OFF",~pOff);
1475 FthItem("ON",~pOn);
1476 FthItem("=",~pEqual);
1477 FthItem("<>",~pNEqual);
1478 FthItem("0<",~pZLess);
1479 FthItem("0=",~pZEqual);
1480 FthItem("0<>",~pZNEqual);
1481 FthItem("D0=",~pDZEqual);
1482 FthItem("<",~pLess);
1483 FthItem(">",~pGreat);
1484 FthItem("U<",~pULess);
1485 FthItem("U>",~pUGreat);
1486 FthItem("MAX",~pMax);
1487 FthItem("MIN",~pMin);
1488 FthItem("0MAX",~pi0Max);
1489 FthItem(">R",~pToR);
1490 FthItem("R>",~pFromR);
1491 FthItem("RDROP",~pRDrop);
1492 FthItem("R@",~pRLoad);
1493 FthItem("2>R",~pi2ToR);
1494 FthItem("2R>",~pi2FromR);
1495 FthItem("2R@",~pi2RLoad);
1496 FthItem("RP@",~pRLoad);
1497 FthItem("RP@",~pRPGet);
1498 FthItem("SP@",~pSPGet);
1499 FthItem("RP!",~pRPSet);
1500 FthItem("SP!",~pSPSet);
1501 FthItem(",",~pCompile);
1502 FthItem("ALLOT",~pAllot);
1503 FthItem("$,",~pStrCmp);
1504 FthItem("<$>",~pStr);
1505 FthItem("EXECUTE",~pExecute);
1506 FthItem("SMUDGE",~pSmudge);
1507 FthItem("TYPE",~pType);
1508 FthItem("ZTYPE",~pZType);
1509 FthItem("CR",~pCr);
1510 FthItem("SPACE",~pSpace);
1511 FthItem("EMIT",~pEmit);
1512 FthItem("PUNCH",~pPunch);
1513 FthItem(">IN",Pi2in);
1514 FthItem("PARSE-NAME",~pParseName);
1515 FthItem("PARSE",~pParse);
1516 FthItem("SHEADER",~pSHeader);
1517 FthItem("BUILD",~pBuild);
1518 FthItem("SFIND",~pSFind);
1519 FthItem("SEARCH-WORDLIST",~pSearchWordList);
1520 FthItem("UCOMPARE",~pUCompare);
1521 FthItem("FILL",~pFill);
1522 FthItem("CMOVE",~pCmove);
1523 FthItem("CMOVE>",~pCmove_up);
1524 FthItem("ZCOUNT",~pZCount);
1525
1526 FthItem("KEY?",~pKeyQ);
1527 FthItem("KEY",~pKey);
1528 sCell PKey = Header("KEY"); Co2(~pDoDefer,~pKey);
1529
1530 FthItem("LASTKEY",~pLastKey);
1531 FthItem("CHLASTKEY",~pChLastKey);
1532 FthItem("SCANKEY",~pScanKey);
1533 FthItem("KEYBCTL",~pKBctl);
1534 FthItem("SCAN2UN",~pScan2Un);
1535 FthItem("CURSOR",~pCursor);
1536 Constant("CURSOR%",(sCell)&CursorHSize);
1537
1538
1539 FthItem("SHIFT?",~pQShift);
1540 FthItem("CTL?",~pQCtrl);
1541 FthItem("ALT?",~pQAlt);
1542
1543
1544 FthItem("TEST1",~pTest1);
1545 FthItem("TEST2",~pTest2);
1546 FthItem("TEST3",~pTest3);
1547
1548 FthItem("IMMEDIATE",~pImmediate);
1549 FthItem(":",~pColon);
1550 FthItem(";",~pSemicolon); Immediate();
1551 FthItem("IF",~pIf); Immediate();
1552 FthItem("ELSE",~pElse); Immediate();
1553 FthItem("THEN",~pThen); Immediate();
1554 FthItem("BEGIN",~pBegin); Immediate();
1555 FthItem("UNTIL",~pUntil); Immediate();
1556 FthItem("AGAIN",~pAgain); Immediate();
1557 FthItem("WHILE",~pWhile); Immediate();
1558 FthItem("REPEAT",~pRepeat); Immediate();
1559
1560 sCell PTrue = Constant("TRUE",-1);
1561
1562 FthItem("EXIT",~pExit );
1563 Constant("STATE",(sCell) &State );
1564 FthItem("?STATE",~pStateQ);
1565
1566 Constant("DOVAR",~pDoVar );
1567 Constant("DOCONST",~pDoConst );
1568 Constant("DODEFER",~pDoDefer );
1569 Constant("DP", (sCell)&here );
1570 Constant("LAST", (sCell)&Last );
1571 Constant("LASTCFA", (sCell)&LastCFA );
1572 VVariable("WARNING",-1);
1573 FthItem("HERE",~pHere);
1574 Constant("BL",(sCell)' ' );
1575 sCell PCell = Constant("CELL",sizeof(Cell) );
1576
1577 FthItem("NAME>",~pFromName);
1578 Constant("BASE",(sCell)&numericBase);
1579
1580 Header("'"); Co5(~pParseName,~pSFind,~pZEqual,~pFThrow,~pExit);
1581
1582 Constant("STATE",(sCell) &State );
1583 sCell PHi = Header("HI"); Tp("Hello!!!"); Co(~pExit);
1584 sCell PLastin = Constant("LASTIN", (sCell)&Lastin );
1585 sCell PSaveErrQ = Constant("SAVEERR?", (sCell)&SaveErrQ );
1586
1587 FthItem("SAVEERR0",~pSaveErr0);
1588 sCell PSaveErr = Header("SAVEERR"); Co2(~pDoDefer,~pSaveErr0);
1589 FthItem("PRINTERR0",~pPrintErr0);
1590
1591 sCell PContext = Constant("CONTEXT",(sCell) &Context );
1592 Constant("CURRENT",(sCell) &Current );
1593 Constant("IMAGE-BEGIN",(sCell)HereArea );
1594 Constant("FORTH-WORDLIST",(sCell) &ForthWordlist );
1595 Constant("CONTEXT-SIZE",ContextSize );
1596 sCell PSP0 = VVariable("SP0",(sCell) &StackArea[STACK_SIZE-9] );
1597
1598 FthItem("R/O",~preadOnly);
1599 FthItem("R/W",~preadWrite);
1600 FthItem("W/O",~pwriteOnly);
1601
1602 FthItem("OPEN-FILE",~popenFile);
1603 FthItem("READ-FILE",~preadFile);
1604 FthItem("READ-LINE",~preadLine);
1605 FthItem("WRITE-FILE",~pwriteFile);
1606 FthItem("RESIZE-FILE",~presizeFile);
1607
1608
1609 FthItem("CLOSE-FILE",~pcloseFile);
1610
1611 FthItem("OPEN-DIR",~pOpenDir);
1612 FthItem("DIRI2NAME",~pDirI2Name);
1613 FthItem("DIRI2TYPE",~pDirI2Type);
1614 FthItem("DIR2COUNT",~pDir2Count);
1615 FthItem("CLOSE-DIR",~pCloseDir);
1616 Constant("G_CLI_PATH",(sCell)&G_CLI_PATH);
1617
1618 FthItem("ZCLI",~pZCli);
1619
1620 FthItem("TIB",Ptib);
1621 sCell PATib = Constant("ATIB",(sCell)&atib);
1622 sCell Pntib = Constant("#TIB",(sCell)&ntib);
1623
1624 FthItem("SOURCE",~pSource);
1625 FthItem("SOURCE!",~pSourceSet);
1626 FthItem("SOURCE-ID",PSourceId);
1627
1628 FthItem("ALLOCATE",~pAllocate);
1629 FthItem("FREE",~pFree);
1630
1631 Constant("YDP", (sCell)&YDP);
1632 Constant("YDP0", (sCell)&YDP0);
1633 FthItem("YDP_FL",~pYDPFL);
1634
1635 Constant("&XPOS", (sCell)&tty_pos_x);
1636 Constant("&YPOS", (sCell)&tty_pos_y);
1637 FthItem("SETXY",~pSetXY);
1638 FthItem("GETXY",~pGetXY);
1639
1640 Constant("&COLOR", (sCell)&tty_text_color);
1641 Constant("&BGCOLOR", (sCell)&tty_bg_color);
1642 FthItem("PAGE",~(Cell)clean_tty_screen );
1643
1644 sCell PErrDO1 = Header("ERROR_DO1"); Co3(PSaveErr,~pPrintErr0,~pExit);
1645 sCell PErrDO = Header("ERROR_DO"); Co2(~pDoDefer,PErrDO1);
1646
1647 sCell PAccept = Header("ACCEPT"); Co2(~pDoDefer,~pAccept);
1648 sCell PQuery = Header("QUERY");
1649 Co4(Ptib,~pLit_,256,PAccept);
1650 Co5(Pntib,~pStore,Pi2in,~pOff,~pExit);
1651
1652
1653 // FthItem("QUERY",~pQuery);
1654
1655 sCell PBye = Header("BYE"); Co2(~pBye,PBye);
1656
1657 sCell PLitC = Header("LIT,"); Co2(~pDoDefer,~pLitCo);
1658 sCell PPre = Header("<PRE>"); Co2(~pDoDefer,~pNoop);
1659 sCell PFileRefill = Header("FREFILL"); Co2(~pDoDefer,~pNoop);
1660 sCell PQStack = Header("?STACK"); Co2(~pDoDefer,~pNoop);
1661
1662 sCell PRefill = Header("REFILL");
1663 Co(PSourceId);
1664 If(); Co2(PFileRefill,~pDup); If(); Co(PPre); Then();
1665 Else(); Co2(PQuery,PTrue);
1666 Then(); Co(~pExit);
1667
1668 FthItem("SNUMBER0",~pSNumber0);
1669
1670 sCell PSNumber = Header("SNUMBER"); Co2(~pDoDefer,~pSNumber0 );
1671
1672 sCell PQSLiteral0 = Header("?SLITERAL0");
1673 Co(PSNumber);
1674 If(); Lit(-13); Co(~pFThrow);
1675 Else(); Co(~pStateQ); If(); Co(PLitC); Then();
1676 Then();
1677 Co(~pExit);
1678
1679 sCell PQSLiteral = Header("?SLITERAL");
1680 Co2(~pDoDefer,PQSLiteral0);
1681
1682 sCell PInterpret1 = Header("INTERPRET1");
1683 Begin();
1684 Co6(Pi2in,~pLoad,PLastin,~pStore,PSaveErrQ,~pOn);
1685 Co2(~pParseName,~pDup);
1686 While(); Co2(~pSFind,~pQDup);
1687 If();
1688 Co2(~pStateQ,~pEqual);
1689 If(); Co(~pCompile );
1690 Else(); Co(~pExecute );
1691 Then();
1692 Else(); Co(PQSLiteral);
1693 Then(); Co(PQStack);
1694 Repeat();
1695 Co2(~pi2drop,~pExit);
1696
1697 sCell PInterpret = Header("INTERPRET");
1698 Co2(~pDoDefer,PInterpret1 );
1699
1700 sCell PQuit = Header("QUIT");
1701 Begin(); Co(PRefill);
1702 While(); Co(PInterpret); Tp(" ok\n>");
1703 Repeat(); Co(~pExit);
1704
1705 sCell PWords = Header("WORDS");
1706 Co3(PContext,~pLoad,~pLoad);
1707 Begin(); Co(~pDup);
1708 While(); Co7(~pDup,~pCount,~pType,~pSpace,PCell,~pSub,~pLoad );
1709 Repeat(); Co2(~pDrop,~pExit );
1710
1711 ip = here; // SYS START
1712
1713 Tp("Forth\n");
1714
1715 Co(~pInitStringSet);
1716 Co5(~pIMode,~pLit_,PInterpret,PCatch,~pQDup );
1717 If(); Co5(PErrDO,PSP0,~pLoad,~pSPSet,~pCr ) ;
1718 Then();
1719
1720 Begin();
1721 Co4(PATib,~pLit_,(sCell)&tib[1],~pStore);
1722 Co5(~pIMode,~pLit_,PQuit,PCatch,PErrDO);
1723 Co4(PSP0,~pLoad,~pSPSet,~pCr ) ;
1724 Again();
1725 }
1726
1727
1728 uint32_t forth_sys(uint32_t argc, char** argv) {
1729
1730 forth_run=1;
1731
1732 tty_printf("Hello from Forth!!!\n");
1733
1734 set_cursor_enabled(false);
1735 // pek();
1736 tib[0]=~pDoConst;
1737 i2in[0]=~pDoVar;
1738 SourceId[0]=~pDoConst;
1739 tib[0]=~pDoConst;
1740 Catch[0] = ~pto_catch;
1741 Catch[1] = ~pfrom_catch;
1742 memset(input_buffer, 0, 256);
1743
1744 HereArea = kcalloc(sizeof(sCell), HERE_SIZE1);
1745 StackArea = kcalloc(sizeof(sCell), STACK_SIZE);
1746 RStackArea = kcalloc(sizeof(sCell), RSTACK_SIZE);
1747
1748 here = HereArea ;
1749 Stack = &StackArea[STACK_SIZE-8] ;
1750 rStack = &RStackArea[RSTACK_SIZE-8] ;
1751
1752 ForthWordlist[0] = 0;
1753 ForthWordlist[1] = 0;
1754 ForthWordlist[2] = 0;
1755
1756 Context[0] = ForthWordlist;
1757 Context[1] = 0;
1758 Current[0] = ForthWordlist;
1759 ireg = ~(sCell)MakeImag;
1760 if(pNoop>0){
1761 _tty_printf("positiv\n"); // addresses area
1762
1763 while (forth_run)
1764 { do{
1765 ((proc) (~ireg) )();
1766 ireg = *ip++;
1767 }while ( ireg<0);
1768 do{
1769 *--rStack = (sCell) ip; ip = (sCell *) ireg;
1770 ireg = *ip++;
1771 }while ( ireg>0);
1772 }
1773 }
1774 else{
1775 _tty_printf("negative\n"); // addresses area
1776 while (forth_run)
1777 { do{
1778 ((proc) (~ireg) )();
1779 ireg = *ip++;
1780 }while ( ireg>0);
1781 do{
1782 *--rStack = (sCell) ip; ip = (sCell *) ireg;
1783 ireg = *ip++;
1784 }while ( ireg<0);
1785 }
1786 }
1787
1788 keyboardctl(KEYBOARD_ECHO, true);
1789
1790 }
getCharKeyboard
char * getCharKeyboard(int key, bool mode)
Выводит символ, в зависимости от кода полученного с клавиатуры
Definition: keyboard.c:67
kbdstatus
uint8_t kbdstatus
Статус клавиатуры
Definition: keyboard.c:36
SHIFT
bool SHIFT
Включен ли SHIFT.
Definition: keyboard.c:33
lastKey
volatile int lastKey
Последний индекс клавишы
Definition: keyboard.c:35
filesize
size_t filesize(const char *Path)
[FileIO] Возвращает размер указанного файла
Definition: fileio.c:67
touch
bool touch(const char *Path)
[FileIO] Создает файл
Definition: fileio.c:180
strlen
size_t strlen(const char *str)
Возращает длину строки
Definition: string.c:88
memset
void * memset(void *ptr, char value, size_t num)
Заполнение массива указанными символами
Definition: string.c:203
isUTF
bool isUTF(char c)
Проверяет, является ли символ формата UTF-8.
Definition: string.c:27
drawRect
void drawRect(uint32_t x, uint32_t y, uint32_t w, uint32_t h, uint32_t color)
Рисуем залитый прямоугольник
Definition: pixel.c:25
fclose
void fclose(FILE *stream)
Закончить работу с файлом
Definition: stdio.c:213
fwrite
size_t fwrite(FILE *stream, size_t size, size_t count, const void *ptr)
Запись файла
Definition: stdio.c:381
fopen
FILE * fopen(const char *filename, const char *_mode)
Открывает файл
Definition: stdio.c:166
fsize
int fsize(FILE *stream)
Получение размера файла в байтах
Definition: stdio.c:227
fread
int fread(FILE *stream, size_t count, size_t size, void *buffer)
Чтение файла
Definition: stdio.c:250
FILE
Структура файла. Требуется для работы с VFS.
Definition: stdio.h:21
mutex_get
bool mutex_get(mutex_t *mutex, bool wait)
Получить мьютекс
Definition: sync.c:19
mutex_release
void mutex_release(mutex_t *mutex)
Получить ближайщий свободный блок
Definition: sync.c:36
sleep_ms
void sleep_ms(uint32_t milliseconds)
Ожидание по миллисекундам
Definition: timer.c:68
getPosY
uint32_t getPosY()
Получение позиции по y.
Definition: tty.c:95
tty_off_pos_h
uint32_t tty_off_pos_h
...
Definition: tty.c:33
getPosX
uint32_t getPosX()
Получение позиции по x.
Definition: tty.c:85
tty_bg_color
uint32_t tty_bg_color
Текущий задний фон
Definition: tty.c:35
_tty_putchar
void _tty_putchar(char c, char c1)
Вывод одного символа
Definition: tty.c:193
tty_off_pos_x
int32_t tty_off_pos_x
...
Definition: tty.c:31
_tty_puts
void _tty_puts(const char str[])
Вывод строки
Definition: tty.c:245
tty_pos_y
uint32_t tty_pos_y
Позиция на экране по Y.
Definition: tty.c:30
tty_text_color
uint32_t tty_text_color
Текущий цвет шрифта
Definition: tty.c:34
tty_pos_x
uint32_t tty_pos_x
Позиция на экране по X.
Definition: tty.c:29