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