-
Notifications
You must be signed in to change notification settings - Fork 8
/
sample.html
2260 lines (2038 loc) · 122 KB
/
sample.html
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
<!DOCTYPE html>
<html>
<head>
<title id=appname>jeforth demo of the project-k kernel -- FigTaiwan H.C.Chen 2015-2020</title>
<meta charset="utf-8" />
<link rel="stylesheet" type="text/css" href="common.css">
<style id=styleTextareaFocus type="text/css">
textarea:focus {
background:#E0E0E0;
}
</style>
<script type="text/javascript" src="https://ajax.microsoft.com/ajax/jQuery/jquery-1.11.2.js"></script>
<script src="https://hcchengithub.github.io/project-k/projectk.js"></script>
<Script type="text/javascript" src="projectk.js"></Script>
<script>
window.vm = new jeForth();
// vm is now the jeforth virtual machine object. It has no idea about the outside world
// that can be variant applications: HTML, HTA, Node.js, Node-webkit, .. etc.
// We need to help it a little as the following example:
(function(){
// version
// minor version specified by application, major version is from projectk.js kernel.
vm.minor_version = 1;
var version = parseFloat(vm.major_version+"."+vm.minor_version);
// I/O
// Forth vm doesn't know how to 'type'.
vm.screenbuffer=""; // for self-test
vm.selftest_visible=true;
var type = vm.type = function (s) {
try {
var ss = s + ''; // Print-able test
} catch(err) {
ss = Object.prototype.toString.apply(s);
}
vm.screenbuffer+=ss;
if(vm.selftest_visible) $('#outputbox').append(plain(ss)); // jquery makes it simple, will be a lot of work otherwise.
};
var panic = vm.panic = function(state){vm.type(state.msg);if(state.serious)debugger;}
// The Forth traditional prompt 'OK' is defined and used in this application main program.
// Forth vm has no idea about vm.prompt but your program may want to know.
// In that case, as an example, use vm property to store the vm global variables and functions.
vm.prompt = "OK";
vm.greeting = function () {
vm.type(appname.innerText + " -- r" + version + "\n");
vm.type("source code http://github.com/hcchengithub/project-k\n");
return(version);
};
// The Forth vm has no idea how to clear the display. This is the good place to define
// application dependent functions. Use the same function name for all different applications
// so the same forth.f source code doesn't need to change.
function clearScreen(){
outputbox.innerHTML="";
vm.screenbuffer="";
}
vm.clearScreen = clearScreen;
// System initialization
jQuery(document).ready(
function() {
document.onkeydown = hotKeyHandler; // Must be using onkeydown so as to grab the control.
// vm.dictate() is the only Forth command interface.
// Send a command line string, or an entire source code file into the Forth VM through
// this interface.
vm.dictate(source_code.value);
}
);
function forthConsoleHandler(cmd) {
type((cmd?'\n> ':"")+cmd+'\n');
vm.dictate(cmd); // Pass the command line to jeForth VM
type(" " + vm.prompt + " ");
window.scrollTo(0,endofinputbox.offsetTop); inputbox.focus();
}
// onkeydown,onkeypress,onkeyup
// event.shiftKey event.ctrlKey event.altKey event.metaKey
// KeyCode test page http://www.asquare.net/javascript/tests/KeyCode.html
function hotKeyHandler(e) {
e = (e) ? e : event; var keyCode = (e.keyCode) ? e.keyCode : (e.which) ? e.which : false;
switch(keyCode) {
case 13: /* Enter */
if(event.ctrlKey) {
vm.inputbox = inputbox.value; // w/o the '\n' character ($10).
inputbox.value = ""; // To avoid repeating the last command line when long press 'enter'.
forthConsoleHandler(vm.inputbox);
return(false);
}
}
return (true); // pass down to following handlers
}
// Take care of HTML special characters
var plain = vm.plain = function (s) {
var ss = s + ""; // avoid numbers to fail at s.replace()
ss = ss.replace(/\t/g,' ');
ss = ss.replace(/ /g,' ');
ss = ss.replace(/</g,'<');
ss = ss.replace(/>/g,'>');
ss = ss.replace(/\n/g,'<br>');
return ss;
}
})();
</script>
</head>
<body>
<div><b id=appname2></b></div><hr>
<script>appname2.innerText=appname.innerText</script>
<div id="outputbox"><i>Output area, 'cls' command to clear</i>
<div id="source_box">Source code of basic words. Scroll to view all of them. This area is disposable because definitions are read already.<textarea id="source_code" cols=100 rows=10>
code // last().help = nexttoken('\n|\r'); end-code
// ( <comment> -- ) Give help message to the new word.
code stop reset();debugger; end-code // ( -- ) Stop the TIB loop
code parse-help var ss = " " + pop() + " ", comment = "";
var stackDiagram = ss.match(/^\s+(\(\s.*\s\))\s+(.*)/); // null or [0] entire line, [1] (...), [2] the rest.
if(stackDiagram) {
comment = (" "+stackDiagram[2]+" ").match(/^\s+\\\s+(.*\S)\s+/); // null or [0] entire line, [1] comment
if(comment){
push(stackDiagram[1]+" "+comment[1]);
push("");
} else {
push(stackDiagram[1]);
push(stackDiagram[2]);
}
} else {
comment = ss.match(/^\s+\\\s+(.*\S)\s+/); // null or [0] entire line, [1] comment
if(comment){
push(comment[1]);
push("");
} else {
push("( ?? ) No help message. Use // to add one.");
push(ss);
}
}
end-code
// ( "line" -- "helpmsg" "rests" ) Parse "( -- ) \ help foo baa" from 1st input line
code code push(nexttoken()); // name of the word
push(nexttoken('\n|\r')); // rest of the first line
execute("parse-help"); // ( "name" "helpmsg" "rests" )
tib = " " + pop() + tib.slice(ntib); // "rests" + tib(ntib)
ntib = 0;
newhelp = pop();
tib = pop() + " " + tib; // "name" + tib
execute(words.forth[1]); // execute the old version 'code'.
end-code
// ( <name ..code..> -- ) Start composing a code word.
code init ( -- ) \ Initialize vm.g.members that are moved out from projectk.js which is thus kept pure.
// An array's length is array.length but there's no such thing of hash.length for hash{}.
// memberCount(object) gets the given object's member count which is also a hash table's length.
vm.g = {}; // The global hash
vm.g.memberCount = function (obj) {
var i=0;
for(var members in obj) i++;
return i;
}
// This is a useful common tool. Compare two arrays.
vm.g.isSameArray = function (a,b) {
if (a.length != b.length) {
return false;
} else {
for (var i=0; i < a.length; i++){
var ta = typeof(a[i]);
var tb = typeof(b[i]);
if (ta == tb) {
if (ta == "number"){
if (isNaN(a[i]) && isNaN(b[i])) continue; // because (NaN == NaN) 的結果是 false 所以要特別處理。
}
if (ta == "object") { // 怎麼比較 obj? v2.05 之後用 memberCount()
if (vm.g.memberCount(a[i]) != vm.g.memberCount(b[i])) return false;
} else if (a[i] != b[i]) return false;
} else if (a[i] != b[i]) return false;
}
return true;
}
}
// Tool, check if the item exists in the array or is it a member in the hash.
// return {flag, key}
vm.g.isMember = function (item, thing){
var result = {flag:false, key:0};
if (mytypeof(thing) == "array") {
for (var i in thing) {
if (item == thing[i]) {
result.flag = true;
result.key = parseInt(i); // array 被 JavaScript 當作 object 而 i 是個 string, 所以要轉換!
break;
}
}
} else { // if obj is not an array then assume it's an object
for (var i in thing) {
if (item == i) {
result.flag = true;
result.key = thing[i];
break;
}
}
}
return result; // {flag:boolean, value:(index of the array or value of the obj member)}
}
// How to clear all setInterval() and setTimeOut() without knowing their ID?
// http://stackoverflow.com/questions/8769598/how-to-clear-all-setinterval-and-settimeout-without-knowing-their-id
// 缺點是 vm.g.setTimeout.registered() 會大量堆積，需 delete(vm.g.setTimeout.registered()[id.toString()]) 既然還得記住
// timeoutId 使得 vm.g.setTimeout() 的好處大打折扣。 查看： js> vm.g.setTimeout.registered() (see)
// setInterval 比較不會大量堆積，最好還是要適時 delete。查看：js> vm.g.setInterval.registered() (see)
vm.g.setInterval = (function(){
var registered={};
f = function(a,b){
var id = setInterval(a,b);
registered[id.toString()] = id;
return id;
};
f.clearAll = function(){
for(var r in registered){clearInterval( registered[r] )}
registered={};
};
f.registered = function(){return(registered)};
return f;
})();
vm.g.setTimeout = (function(){
var registered={};
f = function(a,b){
var id = setTimeout(a,b);
registered[id.toString()] = id;
return id;
};
f.clearAll = function(){
for(var r in registered){clearTimeout( registered[r] )}
registered={};
};
f.registered = function(){return(registered)};
return f;
})();
// This is a useful common tool. Help to recursively see an object or forth Word.
// For forth Words, view the briefing. For other objects, try to see into it.
vm.g.see = function (obj,tab){
if (tab==undefined) tab = " "; else tab += " ";
switch(mytypeof(obj)){
case "object" :
case "array" :
if (obj.constructor != Word) {
if (obj&&obj.toString) // is toString() defined?
type(obj.toString() + '\n');
else
type(Object.prototype.toString.apply(obj) + '\n');
for(var i in obj) {
type(tab + i + " : "); // Entire array already printed here.
if (obj[i] && obj[i].toString || obj[i]===0)
type(tab + obj[i].toString() + '\n');
else
type(tab + Object.prototype.toString.apply(obj[i]) + '\n');
}
break; // if is Word then do default
}
default : // Word(), Constant(), number, string, null, undefined
var ss = obj + ''; // Print-able test
type(ss + " (" + mytypeof(obj) + ")\n");
}
}
vm.g.debugInner = function (entry, resuming) {
var w = phaseA(entry); // 翻譯成恰當的 w.
do{
while(w) { // 這裡是 forth inner loop 決戰速度之所在，奮力衝鋒！
// 可用 bp=ip 設斷點, debug colon words.
if(vm.jsc.bp<0||vm.jsc.bp==ip){
if (vm.jsc.enable){ // 需要這個 flag 因為若已經進了 debugInner, 換掉 inner 也出不來。
vm.jsc.prompt=" jsc>";
eval(vm.jsc.xt);
}
};
ip++; // Forth 的通例，inner loop 準備 execute 這個 word 之前，IP 先指到下一個 word.
phaseB(w); // 針對不同種類的 w 採取正確方式執行它。
w = dictionary[ip];
}
if(w===0) break; else ip = rstack.pop(); // w==0 is suspend, abort inner but reserve rstack
if(resuming) w = dictionary[ip];
} while(ip && resuming); // ip==0 means resuming has done
}
end-code init
code version ( -- revision ) \ print the greeting message and return the revision code
push(vm.greeting()) end-code
code <selftest> ( <statements> -- ) \ Collect self-test statements. interpret-only
push(nexttoken("</selftest>"));
end-code
code </selftest> ( "selftest" -- ) \ Save the self-test statements to <selftest>.buffer. interpret-only
var my = tick("<selftest>");
my.buffer = my.buffer || ""; // initialize my.buffer
my.buffer += pop();
end-code
<selftest>
<comment>
程式只要稍微大一點點，就得附上一些 self-test 讓它伺機檢查自身。隨便有做，穩定性
就會提升一大步。 Forth 的結構全部都是 global words， 改動的時候自由無限，難以一
一去檢討影響到了哪些 words, 不讓它全面自動測試十分令人擔憂。與其努力抓 bug 不如
早點把 self-test 做進去。
Self-test 的執行時機是程式開始時，或開機時。沒有特定任務就做 self-test.
include 各個 modules 時，循序就做 self-test。藉由 forth 的 marker , (forget) 等
self-test 用過即丟， 只花時間，不佔空間。花平時的開發時間不要緊，有特定任務時就
跳過 self-test，是則完全不佔執行系統任何時間空間，只佔 source code 的篇幅。
我嘗試了種種的 self-test 寫法。有的很醜，混在正常程式裡面相當有礙視線；不醜的很
累，佔很大 source code 篇幅。
以下是發展到目前最好的方法，projectk.js kernel 裡只有 code end-code 兩個基本
words, 剛進到 jeforth.f 只憑這兩個基本 words 就馬上要為每個 word 都做 self-test
原本是很困難的。 然而，jeforth.f 是整個檔案一次讀進來成為大大的一個 TIB 的， 所
以其中已經含有 jeforth.f 的全部功能。如果 self-test 安排在所有的 words 都 load
好以後做，資源充分就不覺有困難。好玩的是，進一步，利用〈selftest〉〈/selftest〉這
對「文字蒐集器」在任意處所蒐集「測試程式的本文」，最後再一次把它當成 TIB 執行。實
用上〈selftest〉〈/selftest〉出現在每個 word 定義處，裡頭可以放心自由地使用尚未出
生的「未來 words」, 對寫程式時的頭腦有很大的幫助。
</comment>
"" value description // ( -- "text" ) description of a selftest section
[] value expected_rstack // ( -- [..] ) an array to compare rstack
[] value expected_stack // ( -- [..] ) an array to compare data stack
0 value test-result // ( -- boolean ) selftest result from [d .. d]
[] value [all-pass] // ( -- ["words"] ) array of words for all-pass.
: *** ( <description> -- ) \ Start a selftest section
char \n|\r word trim
<js> "*** " + pop() + " ... " </jsV> to description
depth if
description . ." aborted" cr
." *** Warning, Data stack is not empty." cr
stop
then ;
code all-pass ( ["name",...] -- ) \ Pass-mark all these word's selftest flag
var a=pop();
for (var i in a) {
var w = tick(a[i]);
if(!w) panic("Error! " + a[i] + "?\n");
else w.selftest='pass';
}
end-code
: [r ( <"text"> -- ) \ Prepare an array of data to compare with rstack.
char r] word js> eval("["+pop()+"]") to expected_rstack ;
: r] ( -- boolean ) \ compare rstack and expected_rstack
js> vm.g.isSameArray(rstack,vm.g.expected_rstack) ;
: [d ( <"text"> -- ) \ Prepare an array to compare with data stack. End of a selftest section.
char d] word js> eval("["+pop()+"]") to expected_stack ;
/// Data stack will be clean after check
: d] ( -- boolean ) \ compare data stack and expected_stack
js> vm.g.isSameArray(stack,vm.g.expected_stack) to test-result
description . test-result if ." pass" cr dropall
else ." fail" cr stop then ;
/// Data stack will be clean after check
: [p ( <"text"> -- ) \ Prepare an array ([all-pass]) of words for all-pass if test-result
char p] word js> eval("["+pop()+"]") to [all-pass] ;
: p] ( -- boolean ) \ all-pass if test-result
test-result if [all-pass] all-pass then ;
marker ~~selftest~~ // ( -- ) marker, clean selftest garbage
.( *** Start self-test ) cr
*** Data stack should be empty
depth [d 0 d]
[p 'code','end-code','.', '."', '.(', ':', ';', 'if', 'else', 'then',
'js>', 'parse-help','cr','depth','<selftest>','</self'+'test>','word',
'<js>', '</'+'jsV>' p]
*** Rreturn stack should have less than 2 cells
description .
js> rstack.length dup . space 2 <= [if] .( pass) cr [else] .( failed!) cr stop [then]
[p 'dup','<=','[if]', '[else]', '[then]' p]
*** // adds help to the last word
' // :> help.indexOf("message")!=-1 [d true d] [p "//", ":>", "'" p]
*** version should return a number
js: vm.selftest_visible=false;vm.screenbuffer=""
version
js: vm.selftest_visible=true
js> typeof(pop())=="number" ( true )
<js> vm.screenbuffer.indexOf('http://github.com/hcchengithub/project-k')!=-1 </jsV> ( true )
[d true,true d]
[p 'version' p]
</selftest>
code execute ( Word|"name"|address|empty -- ... ) \ Execute the given word or the last() if stack is empty.
execute(pop()); end-code
<selftest>
*** "drop" drops the TOS
321 123 s" drop" execute \ 321
654 456 ' drop execute \ 321 654
[d 321,654 d] [p 'drop', "'", "execute", '\\' p]
</selftest>
code interpret-only ( -- ) \ Make the last new word an interpret-only.
last().interpretonly=true;
end-code interpret-only
<selftest>
*** interpret-only marks the last word as an interpret-only word
' execute :> interpretonly==true ( false )
' interpret-only :> interpretonly==true ( true )
[d false,true d] [p "interpret-only" p]
</selftest>
code immediate ( -- ) \ Make the last new word an immediate.
last().immediate=true
end-code
<selftest>
*** immediate marks the last word as an immediate word
' execute :> immediate==true ( false )
' \ :> immediate==true ( true )
[d false,true d] [p "immediate" p]
</selftest>
code .(( ( <str> -- ) \ Print string that has ')' in it down to '))' immediately.
type(nexttoken('\\)\\)'));ntib+=2; end-code immediate
code \ ( <comment> -- ) \ Comment down to the next '\n'.
nexttoken('\n') end-code immediate
<selftest>
*** TIB lines after \ should be ignored
111 \ 222
: dummy
999
\ 333 444 555
;
last execute [d 111,999 d] [p '\\' p]
(forget)
</selftest>
code \s ( -- ) \ Stop outer loop which may be loading forth source files.
stop=true;
ntib=tib.length; // 可能沒用，雙重保險。
end-code
code compile-only ( -- ) \ Make the last new word a compile-only.
last().compileonly=true
end-code interpret-only
<selftest>
*** compile-only marks last word as a compile-only word
' execute :> compileonly==true ( false )
' if :> compileonly==true ( true )
[d false,true d] [p "compile-only" p]
</selftest>
\ ------------------ Fundamental words ------------------------------------------------------
code (create) ( "name" -- ) \ Create a code word that has a dummy xt, not added into wordhash{} yet
if(!(newname=pop())) panic("Create what?\n", tib.length-ntib>100);
if(isReDef(newname)) type("reDef "+newname+"\n"); // 若用 tick(newname) 就錯了
current_word_list().push(new Word([newname,function(){}]));
last().vid = current; // vocabulary ID
last().wid = current_word_list().length-1; // word ID
last().type = "colon-create";
// push(nexttoken('\n|\r')); // rest of the first line
// execute("parse-help"); // ( "helpmsg" "rests" )
// tib = " " + pop() + tib.slice(ntib); ntib = 0; // "rests" + tib(ntib)
// newhelp = pop();
// last().help = newname + " " + newhelp; // help messages packed
end-code
code reveal ( -- ) \ Add the last word into wordhash
wordhash[last().name]=last() end-code
\ We don't want the last word to be seen during its colon definition.
\ So reveal is done in ';' command.
<selftest>
*** (create) creates a new word
marker ---
char ~(create)~ (create)
js> last().name ---
[d "~(create)~" d] [p "(create)","char" p]
</selftest>
code /// ( <comment> -- ) \ Add comment to the new word, it appears in 'see'.
var ss = nexttoken('\n|\r');
ss = ss.replace(/^/,"\t"); // Add leading \t to each line.
ss = ss.replace(/\s*$/,'\n'); // trim tailing white spaces
last().comment = typeof(last().comment) == "undefined" ? ss : last().comment + ss;
end-code interpret-only
<selftest>
*** /// adds comment to the last word
1234 constant x
/// comment-line-111
/// comment-line-222
js> last().comment.indexOf("comment-line-111")==-1
js> last().comment.indexOf("comment-line-222")==-1
x [d false,false,1234 d] [p "///","constant" p]
(forget)
</selftest>
code (space) push(" ") end-code // ( -- " " ) Put a space on TOS.
code BL push("\\s") end-code // ( -- "\s" ) RegEx white space.
code CR push("\n") end-code // ( -- '\n' ) NewLine is ASCII 10(0x0A)
/// Also String.fromCharCode(10) in JavaScript
<selftest>
*** (space) puts a 0x20 on TOS
(space) js> String.fromCharCode(32) =
[d true d] [p "(space)","=" p]
*** BL should return the string '\s' literally
BL [d "\\s" d] [p "BL" p]
*** CR should return a new line character
CR js> String.fromCharCode(10) =
[d true d] [p "CR","=" p]
</selftest>
code jsEval ( "js code" -- result ) \ Evaluate the given JavaScript statements, return the last statement's value.
try {
push(eval(pop()));
} catch(err) {
panic("JavaScript error : "+err.message+"\n", "error");
};
end-code
<selftest>
*** jsEval should eval(tos) and return the last statement's value
456 char pop()+1 jsEval [d 457 d] [p "jsEval" p]
</selftest>
code jsEvalNo ( "js code" -- ) \ Evaluate the given JavaScript statements, w/o return value.
try {
eval(pop());
} catch(err) {
panic("JavaScript error : "+err.message+"\n", "error");
};
end-code
<selftest>
*** jsEvalNo should eval(tos) but won't return any value
456 char 123 jsEvalNo [d 456 d] [p "jsEvalNo" p]
</selftest>
code jsFunc ( "js code" -- function ) \ Compile JavaScript to a function() that returns last statement
var ss=pop();
ss = ss.replace(/(^( |\t)*)|(( |\t)*$)/mg,''); // remove 頭尾 white spaces
ss = ss.replace(/\s*\/\/.*$/gm,''); // remove // comments
ss = ss.replace(/(\n|\r)*/gm,''); // merge to one line
ss = ss.replace(/\s*\/\*.*?\*\/\s*/gm,''); // remove /* */ comments
ss = ss.replace(/;*\s*$/,''); // remove ending ';' from the last statement
var parsed=ss.match(/^(.*;)(.*)$/); // [entire string,fore part,last statement]|NULL
if (parsed){
eval("push(function(){" + parsed[1] + "push(" + parsed[2] + ")})");
}else{
eval("push(function(){push(" + ss + ")})");
}
end-code
code jsFuncNo ( "js code" -- function ) \ Compile JavaScript to a function()
eval("push(function(){" + pop() + "})");
end-code
code [ compiling=false end-code immediate // ( -- ) 進入直譯狀態, 輸入指令將會直接執行 *** 20111224 sam
code ] compiling=true end-code // ( -- ) 進入編譯狀態, 輸入指令將會編碼到系統 dictionary *** 20111224 sam
code compiling push(compiling) end-code // ( -- boolean ) Get system state
code last push(last()) end-code // ( -- word ) Get the word that was last defined.
<selftest>
*** last should return the last word
0 constant xxx
last :> name [d "xxx" d] [p "last" p]
(forget)
</selftest>
code exit ( -- ) \ Exit this colon word.
comma(EXIT) end-code immediate compile-only
<selftest>
*** exit should stop a colon word
: dummy 123 exit 456 ;
last execute [d 123 d] [p "exit" p]
(forget)
</selftest>
code ret ( -- ) \ Mark at the end of a colon word.
comma(RET) end-code immediate compile-only
code rescan-word-hash ( -- ) \ Rescan all word-lists in the order[] to rebuild wordhash{}
wordhash = {};
for (var j=0; j<order.length; j++) { // 越後面的 priority 越高
for (var i=1; i<words[order[j]].length; i++){ // 從舊到新，以新蓋舊,重建 wordhash{} hash table.
if (compiling) if (last()==words[order[j]][i]) continue; // skip the last() avoid of an unexpected 'reveal'.
wordhash[words[order[j]][i].name] = words[order[j]][i];
}
}
end-code
/// Used in (forget) and vocabulary words.
code (forget) ( -- ) \ Forget the last word
if (last().cfa) here = last().cfa;
words[current].pop(); // drop the last word
execute("rescan-word-hash");
end-code
<selftest>
*** (forget) should forget the last word
: remember-me ; (forget)
last :> name=="remember-me" [d false d]
[p "(forget)","rescan-word-hash" p]
</selftest>
code : ( <name> -- ) \ Begin a forth colon definition.
newname = nexttoken();
push(nexttoken('\n|\r')); // rest of the first line
execute("parse-help"); // ( "helpmsg" "rests" )
tib = " " + pop() + tib.slice(ntib); ntib = 0; // "rests" + tib(ntib)
newhelp = /* newname + " " + */ pop(); // help messages packed
push(newname); execute("(create)"); // 故 colon definition 裡有 last or last() 可用來取得本身。
compiling=true;
tick(':').stackwas = stack.slice(0); // Should not be changed, ';' will check.
last().type = "colon";
last().cfa = here;
last().help = newhelp;
last().xt = colonxt = function(){
rstack.push(ip);
inner(this.cfa);
}
end-code
code ; ( -- ) \ End of the colon definition.
if (!vm.g.isSameArray(tick(':').stackwas,stack)) {
panic("Stack changed during colon definition, it must be a mistake!\n", "error");
words[current].pop();
} else {
comma(RET);
}
compiling = false;
execute('reveal');
end-code immediate compile-only
code (') ( "name" -- Word ) \ name>Word like tick but the name is from TOS.
push(tick(pop())) end-code
code ' ( <name> -- Word ) \ Tick, get word name from TIB, leave the Word object on TOS.
push(tick(nexttoken())) end-code
<selftest>
*** ' tick and (') should return a word object
' code :> name char end-code (') :> name
[d "code","end-code" d] [p "'","(')" p]
</selftest>
code #tib push(ntib) end-code // ( -- n ) Get ntib
code #tib! ntib = pop() end-code // ( n -- ) Set ntib
\ ------------------ eforth code words ----------------------------------------------------------------------
code branch ip=dictionary[ip] end-code compile-only // ( -- ) 將當前 ip 內數值當作 ip *** 20111224 sam
<selftest>
*** branch should jump to run hello
marker ---
: sum 0 1 begin 2dup + -rot nip 1+ dup 10 > if drop exit then again ;
: test sum 55 = ;
test [d true d] [p '2dup', '-rot', 'nip', '1+', '>', '0branch' p]
---
</selftest>
code 0branch if(pop())ip++;else ip=dictionary[ip] end-code compile-only // ( n -- ) 若 n!==0 就將當前 ip 內數值當作 ip, 否則將 ip 進位 *** 20111224 sam
code ! dictionary[pop()]=pop() end-code // ( n a -- ) 將 n 存入位址 a
code @ push(dictionary[pop()]) end-code // ( a -- n ) 從位址 a 取出 n
code >r rstack.push(pop()) end-code // ( n -- ) Push n into the return stack.
code r> push(rstack.pop()) end-code // ( -- n ) Pop the return stack
code r@ push(rstack[rstack.length-1 ]) end-code // ( -- r0 ) Get a copy of the TOS of return stack
code drop pop(); end-code // ( x -- ) Remove TOS.
code dup push(tos()); end-code // ( a -- a a ) Duplicate TOS.
code swap var t=stack.length-1;var b=stack[t];stack[t]=stack[t-1];stack[t-1]=b end-code // ( a b -- b a ) stack operation
code over push(stack[stack.length-2]); end-code // ( a b -- a b a ) Stack operation.
code 0< push(pop()<0) end-code // ( a -- f ) 比較 a 是否小於 0
<selftest>
*** ! @ >r r> r@ drop dup swap over 0<
marker ---
variable x 123 x ! x @ 123 = \ true
111 dup >r r@ r> + swap 2 * = and \ true
333 444 drop 333 = and \ true
555 666 swap 555 = \ true 666 true
rot and swap \ true 666
0< not and \ true
-1 0< and \ true
false over \ true
[d true, false, true d] [p '!', '@', '>r', 'r>', 'r@', 'swap', 'drop',
'dup', 'over', '0<', '2drop','marker' p]
---
</selftest>
code here! here=pop() end-code // ( a -- ) 設定系統 dictionary 編碼位址
code here push(here) end-code // ( -- a ) 系統 dictionary 編碼位址 a
<selftest>
*** here! here, forth dictionary pointer
marker ~~~
marker ---
10000 here! here ( 10000 )
: dummy ; ' dummy js> pop().cfa 10000 >= ( true )
(forget)
---
: dummy ; ' dummy js> pop().cfa 888 < ( true )
[d 10000,true,true d] [p 'here', 'here!', ">=", "<" p]
(forget)
~~~
</selftest>
\ JavaScript logical operations can be confusing
\ 在處理邏輯 operator 時我決定用 JavaScript 自己的 Boolean() 來 logicalize 所有的
\ operands, 這類共有 and or not 三者。為了保留 JavaScript && || 的功能 (邏輯一旦確
\ 立隨即傳回該 operand 之值) 另外定義 && || 遵照之，結果變成很奇特的功能。Forth 傳
\ 統的 AND OR NOT XOR 是 bitwise operators, 正好用傳統的大寫給它們。
code boolean push(Boolean(pop())) end-code // ( x -- boolean(x) ) Cast TOS to boolean.
code and var b=pop(),a=pop();push(Boolean(a)&&Boolean(b)) end-code // ( a b == a and b ) Logical and. See also '&&' and 'AND'.
code or var b=pop(),a=pop();push(Boolean(a)||Boolean(b)) end-code // ( a b == a or b ) Logical or. See also '||' and 'OR'.
code not push(!Boolean(pop())) end-code // ( x == !x ) Logical not. Capital NOT is for bitwise.
code && push(pop(1)&&pop()) end-code // ( a b == a && b ) if a then b else swap endif
code || push(pop(1)||pop()) end-code // ( a b == a || b ) if a then swap else b endif
code AND push(pop() & pop()) end-code // ( a b -- a & b ) Bitwise AND. See also 'and' and '&&'.
code OR push(pop() | pop()) end-code // ( a b -- a | b ) Bitwise OR. See also 'or' and '||'.
code NOT push(~pop()) end-code // ( a -- ~a ) Bitwise NOT. Small 'not' is for logical.
code XOR push(pop() ^ pop()) end-code // ( a b -- a ^ b ) Bitwise exclusive OR.
code true push(true) end-code // ( -- true ) boolean true.
code false push(false) end-code // ( -- false ) boolean false.
code "" push("") end-code // ( -- "" ) empty string.
code [] push([]) end-code // ( -- [] ) empty array.
code {} push({}) end-code // ( -- {} ) empty object.
code undefined push(undefined) end-code // ( -- undefined ) Get an undefined value.
code null push(null) end-code // ( -- null ) Get a null value.
/// 'Null' can be used in functions to check whether an argument is given.
<selftest>
*** boolean and or && || not AND OR NOT XOR
undefined not \ true
"" boolean \ true false
and \ false
false and \ false
false or \ false
true or \ true
true and \ true
true or \ true
false or \ true
{} [] || \ true [] {}
&& \ true []
|| \ [] true
&& \ true
"" && \ true ""
not \ false
1 2 AND \ true 0
2 OR NOT \ true -3
-3 = \ true true
1 2 XOR \ true true 3
0 XOR 3 = \ true true true
and and \ true
<js> function test(x){ return x }; test() </jsV> null = \ true true
[d true,true d] [p 'and', 'or', 'not', '||', '&&', 'AND', 'OR', 'NOT', 'XOR',
'true', 'false', '""', '[]', '{}', 'undefined', 'boolean', 'null' p]
</selftest>
\ Not eforth code words
\ 以下照理都可以用 eforth 的基本 code words 組合而成 colon words, 我覺得 jeforth 裡適合用 code word 來定義。
code + push(pop(1)+pop()) end-code // ( a b -- a+b) Add two numbers or concatenate two strings.
code * push(pop()*pop()) end-code // ( a b -- a*b ) Multiplex.
code - push(pop(1)-pop()) end-code // ( a b -- a-b ) a-b
code / push(pop(1)/pop()) end-code // ( a b -- c ) 計算 a 與 b 兩數相除的商 c
code 1+ push(pop()+1) end-code // ( a -- a++ ) a += 1
code 2+ push(pop()+2) end-code // ( a -- a+2 )
code 1- push(pop()-1) end-code // ( a -- a-1 ) TOS - 1
code 2- push(pop()-2) end-code // ( a -- a-2 ) TOS - 2
<selftest>
*** + * - / 1+ 2+ 1- 2-
1 1 + 2 * 1 - 3 / 1+ 2+ 1- 2- 1 = [d true d]
[p '+', '*', '-', '/', '1+', '2+', '1-', '2-' p]
</selftest>
code mod push(pop(1)%pop()) end-code // ( a b -- c ) 計算 a 與 b 兩數相除的餘 c
code div var b=pop();var a=pop();push((a-(a%b))/b) end-code // ( a b -- c ) 計算 a 與 b 兩數相除的整數商 c
<selftest>
*** mod 7 mod 3 is 1
7 3 mod [d 1 d] [p "mod" p]
*** div 7 div 3 is 2
7 3 div [d 2 d] [p "div" p]
</selftest>
code >> var n=pop();push(pop()>>n) end-code // ( data n -- data>>n ) Singed right shift
code << var n=pop();push(pop()<<n) end-code // ( data n -- data<<n ) Singed left shift
code >>> var n=pop();push(pop()>>>n) end-code // ( data n -- data>>>n ) Unsinged right shift. Note! There's no <<<.
<selftest>
*** >> -1 signed right shift n times will be still -1
-1 9 >> [d -1 d] [p ">>" p]
*** >> -4 signed right shift becomes -2
-4 1 >> [d -2 d] [p ">>" p]
*** << -1 signed left shift 63 times become the smallest int number
-1 63 << 0x80000000 -1 * = [d true d] [p "<<" p]
*** >>> -1 >>> 1 become 7fffffff
-1 1 >>> 0x7fffffff = [d true d] [p ">>>" p]
</selftest>
code 0= push(pop()==0) end-code // ( a -- f ) 比較 a 是否等於 0
code 0> push(pop()>0) end-code // ( a -- f ) 比較 a 是否大於 0
code 0<> push(pop()!=0) end-code // ( a -- f ) 比較 a 是否不等於 0
code 0<= push(pop()<=0) end-code // ( a -- f ) 比較 a 是否小於等於 0
code 0>= push(pop()>=0) end-code // ( a -- f ) 比較 a 是否大於等於 0
code = push(pop()==pop()) end-code // ( a b -- a=b ) 經轉換後比較 a 是否等於 b, "123" = 123.
<selftest>
*** 0= 0> 0<> 0 <= 0>=
"" 0= \ true
undefined 0= \ true false
1 0> \ true false true
0 0> \ true false true false
XOR -rot XOR + 2 = \ true
0<> \ false
0= \ true
0<> \ true
0<= \ true
0>= \ true
99 && \ 99
0= \ false
99 || 0<> \ true
-1 0<= \ true true
1 0>= \ true true true
s" 123" 123 = \ \ true true true true
[d true,true,true,true d]
[p '0=', '0>', '0<>', '0<=', '0>=', '=' p]
</selftest>
code == push(Boolean(pop())==Boolean(pop())) end-code // ( a b -- f ) 比較 a 與 b 的邏輯
code === push(pop()===pop()) end-code // ( a b -- a===b ) 比較 a 是否全等於 b
code > var b=pop();push(pop()>b) end-code // ( a b -- f ) 比較 a 是否大於 b
code < var b=pop(); push(pop()<b) end-code // ( a b -- f ) 比較 a 是否小於 b
code != push(pop()!=pop()) end-code // ( a b -- f ) 比較 a 是否不等於 b
code !== push(pop()!==pop()) end-code // ( a b -- f ) 比較 a 是否不全等於 b
code >= var b=pop();push(pop()>=b) end-code // ( a b -- f ) 比較 a 是否大於等於 b
code <= var b=pop();push(pop()<=b) end-code // ( a b -- f ) 比較 a 是否小於等於 b
<selftest>
*** == compares after booleanized
{} [] == \ true
"" null == \ true
"" undefined == \ true
s" 123" 123 == \ true
[d true,true,true,true d] [p "==",'""',"null", "undefined" p]
*** === compares the type also
"" 0 = \ true
"" 0 == \ true
"" 0 === \ false
s" 123" 123 = \ true
s" 123" 123 == \ true
s" 123" 123 === \ false
[d true,true,false,true,true,false d]
[p "===" p]
*** > < >= <= != !== <>
1 2 > \ false
1 1 > \ false
2 1 > \ true
1 2 < \ true
1 1 < \ false
2 1 < \ fasle
1 2 >= \ false
1 1 >= \ true
2 1 >= \ true
1 2 <= \ true
1 1 <= \ true
2 1 <= \ fasle
1 1 <> \ false
0 1 <> \ true
[d false,false,true,true,false,false,false,true,true,true,true,false,false,true d]
[p '<', '>=', '<=', '!=', '!==', '<>' p]
</selftest>
code abs push(Math.abs(pop())) end-code // ( n -- |n| ) Absolute value of n.
code max push(Math.max(pop(),pop())) end-code // ( a b -- max(a,b) ) The maximum.
code min push(Math.min(pop(),pop())) end-code // ( a b -- min(a,b) ) The minimum.
<selftest>
*** abs makes negative positive
1 63 << abs [d 0x80000000 d] [p "abs" p]
*** max min
1 -2 3 max max ( 3 )
1 -2 3 min min ( -2 )
[d 3,-2 d] [p "max","min" p]
</selftest>
code doVar push(ip); ip=rstack.pop(); end-code compile-only // ( -- a ) 取隨後位址 a , runtime of created words
code doNext var i=rstack.pop()-1;if(i>0){ip=dictionary[ip]; rstack.push(i);}else ip++ end-code compile-only // ( -- ) next's runtime.
code , comma(pop()) end-code // ( n -- ) Compile TOS to dictionary.
<selftest>
*** doVar doNext
marker ---
variable x
: tt for x @ . x @ 1+ x ! next ;
js: vm.selftest_visible=false;vm.screenbuffer=""
10 tt space \ "0123456789 "
x @ ( 10 )
js: vm.selftest_visible=true
<js> vm.screenbuffer.slice(-11)=="0123456789 "</jsV> ( true )
[d 10,true d]
[p 'doNext','space', ',', 'colon-word', 'create',
'for', 'next' p]
---
</selftest>
\ 目前 Base 切換只影響 .r .0r 的輸出結果。
\ JavaScript 輸入用外顯的 0xFFFF 形式，用不著 hex decimal 切換。
code hex vm.base=16 end-code // ( -- ) 設定數值以十六進制印出 *** 20111224 sam
code decimal vm.base=10 end-code // ( -- ) 設定數值以十進制印出 *** 20111224 sam
code base@ push(vm.base) end-code // ( -- n ) 取得 base 值 n *** 20111224 sam
code base! vm.base=pop() end-code // ( n -- ) 設定 n 為 base 值 *** 20111224 sam
10 base! // 沒有經過宣告的 variable base 就是 vm.base
<selftest>
*** hex decimal base@ base!
decimal base@ 0x0A = \ true
10 0x10 = \ false
hex base@ 0x10 = \ true
10 0x10 = \ false !!!! JavaScript 輸入用外顯的表達 10 就是十不會變，這好！
0x0A base!
base@ 10 = \ true
[d true,false,true,false,true d]
[p 'decimal','base@', 'base!' p]
</selftest>
code depth ( -- depth ) \ Data stack depth
push(stack.length) end-code
code pick ( nj ... n1 n0 j -- nj ... n1 n0 nj ) \ Get a copy of a cell in stack.
push(tos(pop())) end-code
/// see rot -rot roll pick
code roll ( ... n3 n2 n1 n0 3 -- ... n2 n1 n0 n3 )
push(pop(pop())) end-code
/// see rot -rot roll pick
<selftest>
*** pick 2 from 1 2 3 gets 1 2 3 1
1 2 3 0 pick 3 = depth 4 = and >r 3 drops \ true
1 2 3 1 pick 2 = depth 4 = and >r 3 drops \ true
1 2 3 2 pick 1 = depth 4 = and >r 3 drops \ true
r> r> r> [d true,true,true d] [p "pick",">r","r>" p]
*** roll 2 from 1 2 3 gets 2 3 1
1 2 3 0 roll 3 = depth 3 = and >r 2 drops \ true
1 2 3 1 roll 2 = depth 3 = and >r 2 drops \ true
1 2 3 2 roll 1 = depth 3 = and >r 2 drops \ true
r> r> r> [d true,true,true d] [p "roll" p]
</selftest>
code . type(pop()); end-code // ( sth -- ) Print number or string on TOS.
: space (space) . ; // ( -- ) Print a space.
code word ( "delimiter" -- "token" <delimiter> ) \ Get next "token" from TIB.
push(nexttoken(pop())) end-code
/// First character after 'word' will always be skipped first, token separator.
/// If delimiter is RegEx '\s' then white spaces before the "token"
/// will be removed. Otherwise, return TIB[ntib] up to but not include the delimiter.
/// If delimiter not found then return the entire remaining TIB (can be multiple lines!).
<selftest>
*** word reads "string" from TIB
marker ---
char \s word 111 222 222 === >r s" 111" === r> and \ true , whitespace 會切掉
char 2 word 111 222 222 === >r s" 111 " === r> and \ true , whitespace 照收
: </div> ;
char </div> word 此後到 </ div> 之
前都被收進，可
以跨行！ come-find-me-!!
</div> js> pop().indexOf("come-find-me-!!")!=-1 \ true
[d true,true,true d] [p "word" p]
---
</selftest>
: [compile] ' , ; immediate // ( <string> -- ) Compile the next immediate word.
/// 把下個 word 當成「非立即詞」進行正常 compile, 等於是把它變成正常 word 使用。
: compile ( -- ) \ Compile the next word at dictionary[ip] to dictionary[here].
r> dup @ , 1+ >r ; compile-only
<selftest>
*** [compile] compile [ ]
marker ---
: iii ; immediate
: jjj ;
: test [compile] iii compile jjj ; \ 正常執行 iii，把 jjj 放進 dictionary
: use [ test ] ; \ 如果 jjj 是 immediate 就可以不要 [ ... ]
' use js> pop().cfa @ ' jjj = [d true d]
[p "[compile]",'compile', '[', ']' p]
---
</selftest>
code colon-word ( -- ) \ Decorate the last() as a colon word.
// last().type = "colon";
last().cfa = here;
last().xt = colonxt;
end-code
: create ( <name> -- ) \ Create a new word. The new word is a variable by default.