From c632249474daab707a12569b423b85766fb29ed7 Mon Sep 17 00:00:00 2001 From: Carsten Strotmann Date: Sun, 26 Jul 2020 13:22:46 +0200 Subject: [PATCH] Atari 8bit: cleanup --- 6502/Atari8bit/3.81.4/{AS65.TXT => AS65.FTH} | 0 6502/Atari8bit/3.81.4/readme.org | 146 +++++++++++++++++ 6502/Atari8bit/source.3.81.3/4thker.prg | Bin 513 -> 0 bytes 6502/Atari8bit/source.3.81.3/bin2hex | Bin 11446 -> 0 bytes 6502/Atari8bit/source.3.81.3/bin2hex.c | 161 ------------------- sources/{ => 6502}/Apple1/2words.fth | 0 sources/{ => 6502}/Apple1/6502f83.fth | 0 sources/{ => 6502}/Apple1/as65.fth | 0 sources/{ => 6502}/Apple1/assemble.fth | 0 sources/{ => 6502}/Apple1/ccompile.fth | 0 sources/{ => 6502}/Apple1/crostarg.fth | 0 sources/{ => 6502}/Apple1/systemio.fth | 0 sources/{ => 6502}/Apple1/tasker.fth | 0 sources/{ => 6502}/Apple1/tools.fth | 0 sources/6502/Atari8bit/4th.fth | 15 ++ sources/6502/Atari8bit/as65.fs | 150 +++++++++++++++++ sources/6502/Atari8bit/as65.fth | 150 +++++++++++++++++ sources/6502/Atari8bit/call.fth | 17 ++ sources/6502/Atari8bit/dir.fth | 23 +++ sources/6502/Atari8bit/random.fth | 9 ++ sources/6502/Atari8bit/savesys.fth | 19 +++ sources/6502/Atari8bit/sound.fth | 9 ++ sources/6502/Atari8bit/tas65.fth | 20 +++ sources/6502/math.fth | 122 ++++++++++++++ sources/generic/array.fth | 19 +++ sources/generic/create.fth | 4 + sources/generic/double.fth | 9 ++ sources/generic/sieve.fth | 33 ++++ 28 files changed, 745 insertions(+), 161 deletions(-) rename 6502/Atari8bit/3.81.4/{AS65.TXT => AS65.FTH} (100%) create mode 100644 6502/Atari8bit/3.81.4/readme.org delete mode 100644 6502/Atari8bit/source.3.81.3/4thker.prg delete mode 100644 6502/Atari8bit/source.3.81.3/bin2hex delete mode 100644 6502/Atari8bit/source.3.81.3/bin2hex.c rename sources/{ => 6502}/Apple1/2words.fth (100%) rename sources/{ => 6502}/Apple1/6502f83.fth (100%) rename sources/{ => 6502}/Apple1/as65.fth (100%) rename sources/{ => 6502}/Apple1/assemble.fth (100%) rename sources/{ => 6502}/Apple1/ccompile.fth (100%) rename sources/{ => 6502}/Apple1/crostarg.fth (100%) rename sources/{ => 6502}/Apple1/systemio.fth (100%) rename sources/{ => 6502}/Apple1/tasker.fth (100%) rename sources/{ => 6502}/Apple1/tools.fth (100%) create mode 100644 sources/6502/Atari8bit/4th.fth create mode 100644 sources/6502/Atari8bit/as65.fs create mode 100644 sources/6502/Atari8bit/as65.fth create mode 100644 sources/6502/Atari8bit/call.fth create mode 100644 sources/6502/Atari8bit/dir.fth create mode 100644 sources/6502/Atari8bit/random.fth create mode 100644 sources/6502/Atari8bit/savesys.fth create mode 100644 sources/6502/Atari8bit/sound.fth create mode 100644 sources/6502/Atari8bit/tas65.fth create mode 100644 sources/6502/math.fth create mode 100644 sources/generic/array.fth create mode 100644 sources/generic/create.fth create mode 100644 sources/generic/double.fth create mode 100644 sources/generic/sieve.fth diff --git a/6502/Atari8bit/3.81.4/AS65.TXT b/6502/Atari8bit/3.81.4/AS65.FTH similarity index 100% rename from 6502/Atari8bit/3.81.4/AS65.TXT rename to 6502/Atari8bit/3.81.4/AS65.FTH diff --git a/6502/Atari8bit/3.81.4/readme.org b/6502/Atari8bit/3.81.4/readme.org new file mode 100644 index 0000000..1cc19fb --- /dev/null +++ b/6502/Atari8bit/3.81.4/readme.org @@ -0,0 +1,146 @@ +#+Title: VolksForth Atari 8-bit Readme Version 1.1 +#+Date: 13. August 2006 +#+Author: Carsten Strotmann + +VolksForth is a 16bit Forth System produced by the german Forth +Gesellschaft e.V. Main development of this system was done between +1985 until 1989. The VolksForth Project was revived in 2005 with the +goal to produce a managable Forthsystem for computer systems with +restricted system resources. + +Some modern Forth Systems were influenced by or were derived from +VolksForth (GNU-Forth, bigForth). + +The current Version of VolskForth is 3.81. Work on Version 3.90 has +been started. + +At this time VolksForth is available for this Systems: + + * VolksForth MS-DOS (Intel x86 Architecture i8086-ia64) + * VolksForth 6502 (Commodore 64, Commodore Plus 4, Atari 8bit, Apple I, Apple II) + * VolksForth Z80 (CP/M, Schneider CPC CP/M) + * VolksForth 68000 (Atari ST) + +VolksForth is in work for this Systems: + + * VolksForth MS-DOS (Atari Portfolio) + * VolksForth Z80 (Schneider CPC AMSDOS) + * VolksForth 68000 (Mac Classic, Amiga) + +Copyright + +The VolksForth Sources are made avail- able under the terms of the BSD +License http://www.opensource.org/licenses/bsd-license.php + +The Handbook is Copyright (c) 1985 - 2020 Forth Gesellschaft e.V. ( +Klaus Schleisiek, Ulrich Hoffmann, Bernd Pennemann, Georg Rehfeld and +Dietrich Weineck). + +The Handbook, binary Files and Source- code for VolksForth as well as +Informa- tion about Forth Gesellschaft are available on the Forth +Gesellschaft Webserver at http://www.forth-ev.de/ + +(most of the Information is still in german. We are planning to +provide future versions with full englisch documentation) + +Information and Help about the Program- ming Language Forth can be +found in the Internet, starting with the Website of the +Forthgesellschaft, or in the Usenet Forum de.comp.lang.forth (via +Google Groups: http://groups.google.de/group/de.comp.lang.forth ) + +** Details on VolksForth 6502 (Atari 8bit) + +*** Requirements + Atari 8bit with 48 KB RAM, Floppy Atari 800, 800XL, Atari 130 XE + 600XL (+ Atari 1064), + +*** Files + + This is list of VolksForth Files in this Distribution. + + #+begin_example + + DISK 1: + + DOS.SYS + DUP.SYS - Atari DOS 2.5 + VFORTH.COM - the plain volksForth + kernel + 4TH.COM - volksForth binary + STAR4TH.COM - volksForth with + SPARTA/REAL/BEWE + DOS Extensions + DEBUG.COM - volksForth with + Debug Tools + (Tracer etc) + CALL.F - Sourcecode for CALL, + to call Machine- + language Suproutines + CREATE.F - Sourcecode for CREATE + DIR.F - Sourcecode for DIR and + DIR" Commands, to list + Diskdirectories + AS65.F - Sourcecode for the + resident 6502 Assembler + TAS65.F - Sourcecode for the + transient 6502 Assembler + (living in HEAP) + SAVESYS.F - Sourcecode for + SAVE-SYSTEM command + SIEVE.F - Primes Sieve Benchmark + 4TH.F - Build volksForth binary + from plain kernel + README.TXT - This Text + COPYING - License Information + +Disk 2 + DOS.SYS + DUP.SYS - Atari DOS 2.5 + 4TH.COM - volksForth binary + COPYING - License Information + DEBUG.F - Script to build an + volksForth with + DEBUGGER + TAS65.F - Sourcecode for the + transient 6502 Assembler + (living in HEAP) + CREATE.F - Sourcecode for CREATE + TOOLS.F - Debugging Tools + TRACER.F - Interactive Tracer + DEBUGT.F - more Debugging Tools + SEE.F - build Decompiler without + Disassembler + SEE2.F - built Decompiler with + Disassembler + DISAS.F - 6502 Disassembler + DECOMP.F - volksForth Decompiler + DIS.F - build 6502 Disassembler + MTASK.F - volksForth Multitasker + MTDEMO.F - Multitask Demo + "RatRace" + CALL.F - Sourcecode for CALL, + to call Machine- + language Suproutines + SPARTA.F - Sparta/Real/BEWE-DOS + Support + LAUNCH.F - Sparta DOS CLI + Support + SPAR4TH.F - Build volksForth with + Sparta-DOS Support + TEST.F + TEST2.F + TEST3.F - Test Files for + nested INCLUDE" + #+end_example +*** Editor + This verion of volksForth for Atari 8bit does not contain an Editor + for Sourcecode. An Forth Editor will be supplied for Version 3.90. We + recommend Ken Siders KEDIT ( http://atari.ksiders.tzo.com/ ) or the + CompyShop Editor. + +*** Emulator + VolksForth 6502 Atari 8bit 3.81 has been tested in the Atari 8bit + Emulator "Atari800" (atari800.sourceforge.net) + +Have fun with VolksForth +the VolksForth Team diff --git a/6502/Atari8bit/source.3.81.3/4thker.prg b/6502/Atari8bit/source.3.81.3/4thker.prg deleted file mode 100644 index 7f4c7f24c9b482204d3ced52d5679d504a454d32..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 513 zcmZuuF-s#+5dJo5f-w<`6mlpI;kZJ$?48^Ni)h$2N=RUH<}55MG-0yYyUhl&?+SxO z64J*arT7nQto;L4ioKm&cbv5d>#Tx}4!k$t%s1c6Jl_5XK)b^`76i+c%n>Go`{foU z=`#}7XGqCei1tK-bn>RBYdZ9#Y3Fk&Sw`hQ610>?v@bLweFVVy1*QNmZ4SPnFo+Hi z1LT(6xUWYJM1XuunEcCz&v@N3c4ev^s;*vDvsvj&8<`F3 z*t9J}@|tDrj6$4@$G0lgog&rP8!N|F^mS$RH&qW>bWo#@-@k}ulJSDWK6l9E4m~U)j~fk-J)z%a{d&`N_*4p>pOGnVR$u=72~Mz$^#A|> diff --git a/6502/Atari8bit/source.3.81.3/bin2hex b/6502/Atari8bit/source.3.81.3/bin2hex deleted file mode 100644 index 8a50b6d7829148526d290bccc5ffd5d5e94ce435..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 11446 zcmeHNdz4ehc^^I2QPvx?JOVV>_{LrmIAOI~i~(=4%}YES%wt(FDY0d(bhVPvN^9wg zhwH~ud21{3CYuCW+CvgZ+=SCQJ^0k6IW?rfQWhMiXOHW~oYp=iJ+`Y2q{f8W#&*5^ z{bufHuLO>v$4URm=**q@ecw0V_svst=guR+<%?Y|m(am2Jc6jZ$LpJk^!R5KXQnWO zPfW%0I&l?99(|-~DN?c@dL@ zsY*vvGSS|Yj5a0{soWNSHtnCG=x|NeZOMwYvN-*uO}HXPBf@3zNkkp$?94TGT5G4D zK>8^=&tw!LbyEj*RR^{=ZRtRp&cJ$I?I8G&mu>B!F{@?1fINMjPa?tzMB+9AggJ=B zQwR`lL?oU}fbbF`@dU)<-}CzD&uE}VqznUy?5@9Qy6zMK2 zoata0E7TcIq(F&n0kn|m=uD?*4-Id<4445JeX3^9+`jy!4g61&B>$wYV%?Q#_c9Q&^Z1BmTdgMrHS zszHG#kbVLR`q^ZXND-|BVo%pZGwrSCxCd|w~h zVoeDJ#D;DC|9qVgtBU#e!Ra|~@N zICFQuDpL&l3X2-N5Hv8yO27JGczA@go1{}9ouKr#GsjUBwU+9q9UTasr>=qES(Thr z$%``SiK4D5#|Bop_2pcfojcaEhPh)sttwf~WT1xQR~A{+;QRj9&=$cudP&c`4W-HO z=<(niqxJ{im^+-S8TtuCNBubXM!s}=p=T*HqOcqF z5S%Z48#)GhmV?DQ4S6uZlngxCgt{mm=lRfoViN8dgqOv&zG+7agZX#d)>L%Pygukz z2R-G2w^kPXYhAE+oLmqo=dCXU&r5BGPq{t8I*cMX7CbwEri?&gF?gPhaXqUTEae|6 ziQFXE>ZYw9$E^)Q^nvZZQ_v;6C1$n4Zb)mdS!)&MRA9$xNMtg zcD0LZPxS_0cGcVJEnohj7Y)mOx^EyT7mZ@@<+lgtP2nt|Pr;Y9p+`pyox7l$PhjTH zf_vKzvSyrH58u}tJh@H&GY-h=su6KgtNF@^n!kdYV(?@^HE!^vY+0|e`jI}QP*}Cq zHiLF`cP=jXMRj-1r8()6ZBgbg?#`hPf`q{t}buFQBXRlq{;|--wp)BRjGV7Uha~qW`XS z&2OzKanah=|Ci&jXZX9f(Y!^p>~QZl`JDFL;dkA){485vcxib1-;k0&=DOvB%()Hs zg!=Pm>Iz@RthO3_rTJ1v3_9%Md0G7M;S27b6TSBj=SG*l36UaXizt&nTGwwYES$^# zm#gQ6+}YEw6t8XQ@5`U5FSa#Igk~-PSZ73`4F*oZ_O|{S7yx%1NZ!(S;VhKZ<&V}^ z{-3YOpYcA+_nsti#>n`)ZF>?8{~g+d9Uz;PYcmn`UUlJ zlR)u{0zFbY#EV#xFePg=8Vi=KnBV#(!%7>=QkI!CmIl`w+{hY{bZV2CvCNj8yA z8O{Dcpmu6x+Jc44jdfeI>5Zmw=T;P)5ePIJQ`^my8BJ`o<|Vu0;Y`#Yd0<+te(Slk z{k7R}huLDljSY?5T&Gia8|{gdv>rFNFs(HjlZLTit7T^CV#W+djaVk#Nx5)ltMn8y z3CN5P47t}%q&kdr3|n^#0%^lonX|fbma3bg8&fyO&5S9l91UAxRW3UX@|Ix)w?vY; zsA&XOE{5GmIuivwY#8&qu-A{$8z$+PVQxue@n+CbZaT=_Zy2j{3DYt<(@-%rm8Ncs za*?bNhE4fqVMeFbieyWoCEa3$@84A2O27I3skT^&gRQMATU(4f6WJ`Qmq?-gn$jc9 z=&u!-_R1m^$S%JyoJyrFgRe+RhwK9s-fUHfUj!~uzS25gp?+PcET1tk$lyYyie;>n z8Wh>Y1Lmz$lF{;@waY6Jd&u18sDgply$&m0D_Uj*rUYiL4+KQZl)#MjcAitdnxD zt5eeOS1lvYPj)`)_2G3<4C391`?fgFd$21O*XHs5iu8S8cGg}*o^S9)5X+(rT>HAQ zL*};cUc_;TJY(Ux#T@8mej-wyB^Zc2!=h98(@U42A3mk&%UPsHfswu9!1F6z=ooDM z4Dofuw-B$w8Qgfp&mqo2T#UF5F^0GaQI~s)I+iS4*kVk@(bF{JCjU+Tn;S8jZVoix z6adjoS?RPQ`!%^S(>&eCX1f}t^avT$u7ue*$3Gjt=4m)(`JLk5HN|gjR7}U9=6qBq zr)pkv9&(;@{yvFue*@WeXh7-~Pva@y+QjQv2RQ$K2zjMP3I0&ZG4JJ+6-}GMnI@~V ztEnrUv9QHx>fi}n;|xxnrp@Wh#-{dM0%yEYGZxMzt;WQxIkOtOBI?Yyu_KjJIV;ZX zMz$%E%{4_bR>HsLGBi6)p`gH|HRi7|aHw~)|CSm40M3(L-O6DuS6CCxo!OLiTixoBs`-8Lr9GC*L(W z>UP1hsBv>Zd2Rr)#a*K)99o{MZL!JG>C+oqCQIq( zOZg@I*{z*cxE-m5LCiF+b2yVWGhM=uU6tvdzhGG-2D$LZ!#J__N4KU>P^DHz_%WLO z_Wr#Bguu&~Ny@8CSJD#xL@I%&Wp2SU1^`x?J7eKDYYN79|0_@{!X*`DhNg)`w)he<6GV$Yw}`EYxC#@wV4KEs&k zq00-CAjZb!+91DA0q}oa2ifodHzMNLTFS}qNMIPiI;hn~h-MHt+NqCw51v(Xyl6gC z#@UEmzbMB&$@|oYC}#?2l;LE*9g+JI%5e{KEx=ynbwCjr`0a!H56W@xaTIb5$Wspk z>5OfN+^;atJxd940py)_0YwB6$MUia_dFA!$N<**m~z9BMAUL~AU6k$dqE?g_0w`W z0`9QVfEkedsd4wPZ+N7Ql$Aa?+A+>h&^b)Nu%_Gy=A@y8*@ajt`w`zH{n zPY22!mz|?1n)ec*&Xd!JBb4<@L_T$!zYgS-D?zT^LD1QARdRPs6vB|2)I-ZrSve2Z zeUNK)5OkJ%71mXU1HXrM(M%9^mZ_t9;`sGK9KwQwM65w%yRe-&*PQwu|GW@>-MQdt zeaK!ExW197zUZs(;R-9uT(1;X7Pu}cta^p(kHX5Je#i015vSG@#fRevTsIV!iF}7r zn6*&rfWqqane$y?t{g(%IZ#-QB+g%jF^L&CPZ2zvtO%TsOg-`oxtezhs}aWer7(L1 z-x|vplLSG(dwJ}C0L}~2J@QQu{*kn#&apR#tNC$c(U&{Uj z@Sk+pZvd9(22$T>(G0BTlMD0dc3`JJUj*K5&qwMH1M9&0eN_8b%ftP0_`kG&wZ3Po z{Q1W!JXnQK+V~6bf~!Hv#{9n`z5uM(htXIc-1Z_o$L5bC#(Kn+ax~VXNjCpRoA0+V z|F5WT9&$JJaf)zd z=M!msGU@Qg#atG{aYpJk5pGX3%GbloIkUJjYd8&|cD!@KBwrZ)k&nGbS90QV#opuC zCu_UTcU-t12`7_|t5`f@$XdBr46IOSVcW{q(DG$#+Cm|qMHT3dg=JQkKOoS}T}jh2 zqqxEq3PsbQj%2z$oD9i#c|uE46R?Ro(xqRLDY( zs>RJ@m*ByPtwP;EtSBN6X4J*Q5jqB(DbHI%As%P?aXT^86$x4KTxz4geTxV!S-x_? z{N=~|W>6xSq2gaa4fc62x&x?@wQ)$G7$ YPcySH8O~;L diff --git a/6502/Atari8bit/source.3.81.3/bin2hex.c b/6502/Atari8bit/source.3.81.3/bin2hex.c deleted file mode 100644 index e0ba19c..0000000 --- a/6502/Atari8bit/source.3.81.3/bin2hex.c +++ /dev/null @@ -1,161 +0,0 @@ -#include -#include -#include -#include -#include -#include - -void help(char *name) -{ - printf("%s - BINARY to Intel HEX file convertor version 1.00\n"\ - "(c)BCL Vysoke Myto 2001 (benedikt@lphard.cz)\n\n",name); - printf("Usage: %s [-option] binfile hexfile\n"\ - " -l Bytes to read from binary file\n"\ - " -i Binary file starting offset\n"\ - " -o Output file offset (where HEX data starts)\n"\ - " -t Exclude EOF record\n"\ - " -a Append to end of existing HEX file\n"\ - " -q Quiet mode (no statistics are printed)\n", name); -} - -int main(int argc,char *argv[])/*Main routine*/ -{ - char *ifile = NULL; - char *ofile = NULL; - char c; - FILE *inp, *outp; - int ch,csum; - int ofsa = 0; - int cnt = 0; - struct stat statbuf; - long int foffset = 0; - long int fsize = 0; - long int fsub; - long int fpoint = 0; - long int adrs = 0; - unsigned char quiet = 0; - unsigned char eofrec = 0; - unsigned char append = 0; - - opterr = 0; //print error message if unknown option - - while ((c = getopt (argc, argv, "l:i:o:taqv")) != -1) - switch (c) { - case 'l': - fsize = atol(optarg); - break; - case 'i': - foffset = atol(optarg); - break; - case 'o': - adrs = atol(optarg); - break; - case 't': - eofrec = 1; - break; - case 'a': - append = 1; - break; - case 'q': - quiet = 1; - break; - case 'v': - printf("%s - BINARY to Intel HEX file convertor version 1.00\n"\ - "(c)BCL Vysoke Myto 2001 (benedikt@lphard.cz)\n",argv[0]); - return 0; - case '?': - help (argv[0]); - return 1; - } - - if ((argc - optind) != 2) { - printf("ERROR: Missing input/output file.\n"); - help(argv[0]); - return 1; - } - ifile = argv[optind]; - ofile = argv[optind+1]; - - /*Open file check*/ - if((inp = fopen(ifile, "rb")) == NULL){ - printf("ERROR: Cannot open input file.\n"); - return 1; - } - fseek (inp, foffset, SEEK_SET); - - if (append == 0) { - if((outp = fopen(ofile, "wt")) == NULL){ - printf("ERROR: Cannot open output file.\n"); - return 1; - } - } else { - if((outp = fopen(ofile, "at")) == NULL){ - printf("ERROR: Cannot re-open output file.\n"); - return 1; - } - fseek (outp, 0, SEEK_END); - } - - fstat(fileno(inp), &statbuf); - if (quiet == 0) printf("Input file size=%ld\n",statbuf.st_size); - if (foffset > statbuf.st_size) { - printf("ERROR: Input offset > input file length\n"); - } - if ((fsize == 0) || (fsize > (statbuf.st_size - foffset))) - fsize = statbuf.st_size - foffset; - -// fprintf(outp,":020000020000FC\n");/*Start Header*/ - fsub = fsize - fpoint; - if (fsub > 0x20) { - fprintf(outp,":20%04X00",adrs);/*Hex line Header*/ - csum = 0x20 + (adrs>>8) + (adrs & 0xFF); - adrs += 0x20; - } - else { - fprintf(outp, ":%02X%04X00", fsub,adrs);/*Hex line Header*/ - csum = fsub + (adrs>>8) + (adrs & 0xFF); - adrs += fsub; - } - while (fsub > 0){ - ch = fgetc(inp); - fprintf(outp,"%02X",ch);/*Put data*/ - cnt++; fpoint++; - fsub = fsize - fpoint; - csum = ch + csum; - if((fsub == 0)||(cnt == 0x20)){ - cnt = 0; csum = 0xFF & (~csum + 1); - fprintf(outp,"%02X\n",csum);/*Put checksum*/ - if(fsub == 0) break; - if(adrs > 0xFFFF){ - ofsa = 0x1000 + ofsa; - adrs = 0; - fprintf(outp,":02000002%04X",ofsa);/*Change offset address*/ - csum = 0x02 + 0x02 + (ofsa>>8) + (ofsa & 0xFF); - csum = 0xFF & (~csum + 1); - fprintf(outp,"%02X\n", csum); - } - adrs = 0xFFFF & adrs; - if (fsub > 0x20) { - fprintf(outp,":20%04X00",adrs);/*Next Hex line Header*/ - csum = 0x20 + (adrs>>8) + (adrs & 0xFF); - adrs += 0x20; - } - else { - if(fsub > 0){ - fprintf(outp, ":%02X%04X00", fsub,adrs);/*Next Hex line Header*/ - csum = fsub + (adrs>>8) + (adrs & 0xFF); - adrs += fsub; - } - } - } - } - if (eofrec == 0) fprintf(outp,":00000001FF\n");/*End footer*/ - fflush (outp); - - fstat(fileno(outp), &statbuf); - if (quiet == 0) printf("Output file size=%ld\n",statbuf.st_size); - - fclose(inp); - fclose(outp); - return 0; -} diff --git a/sources/Apple1/2words.fth b/sources/6502/Apple1/2words.fth similarity index 100% rename from sources/Apple1/2words.fth rename to sources/6502/Apple1/2words.fth diff --git a/sources/Apple1/6502f83.fth b/sources/6502/Apple1/6502f83.fth similarity index 100% rename from sources/Apple1/6502f83.fth rename to sources/6502/Apple1/6502f83.fth diff --git a/sources/Apple1/as65.fth b/sources/6502/Apple1/as65.fth similarity index 100% rename from sources/Apple1/as65.fth rename to sources/6502/Apple1/as65.fth diff --git a/sources/Apple1/assemble.fth b/sources/6502/Apple1/assemble.fth similarity index 100% rename from sources/Apple1/assemble.fth rename to sources/6502/Apple1/assemble.fth diff --git a/sources/Apple1/ccompile.fth b/sources/6502/Apple1/ccompile.fth similarity index 100% rename from sources/Apple1/ccompile.fth rename to sources/6502/Apple1/ccompile.fth diff --git a/sources/Apple1/crostarg.fth b/sources/6502/Apple1/crostarg.fth similarity index 100% rename from sources/Apple1/crostarg.fth rename to sources/6502/Apple1/crostarg.fth diff --git a/sources/Apple1/systemio.fth b/sources/6502/Apple1/systemio.fth similarity index 100% rename from sources/Apple1/systemio.fth rename to sources/6502/Apple1/systemio.fth diff --git a/sources/Apple1/tasker.fth b/sources/6502/Apple1/tasker.fth similarity index 100% rename from sources/Apple1/tasker.fth rename to sources/6502/Apple1/tasker.fth diff --git a/sources/Apple1/tools.fth b/sources/6502/Apple1/tools.fth similarity index 100% rename from sources/Apple1/tools.fth rename to sources/6502/Apple1/tools.fth diff --git a/sources/6502/Atari8bit/4th.fth b/sources/6502/Atari8bit/4th.fth new file mode 100644 index 0000000..2fbd406 --- /dev/null +++ b/sources/6502/Atari8bit/4th.fth @@ -0,0 +1,15 @@ +CR +.( Build 4TH.COM from plain kernel ) + +\needs SAVESYSTEM INCLUDE" D:SAVESYS.F" +\needs CALL INCLUDE" D:CALL.F" +\needs S" INCLUDE" D:STRING.F" +\needs 2@ INCLUDE" D:2WORDS.F" +\needs DIR INCLUDE" D:DIR.F" +SAVE +SAVE-SYSTEM D:4TH.COM + +CR +.( 4TH.COM saved ) +CR + diff --git a/sources/6502/Atari8bit/as65.fs b/sources/6502/Atari8bit/as65.fs new file mode 100644 index 0000000..42c03f1 --- /dev/null +++ b/sources/6502/Atari8bit/as65.fs @@ -0,0 +1,150 @@ +\ 6502 Assembler clv10oct87 +\ Basis: Forth Dimensions VOL III No. 5) +\ internal loading 04may85BP/re) +\ Forth-6502 Assembler clv10oct87 +\ Basis: Forth Dimensions VOL III No. 5) + +CR .( Loading 6502 Assembler...) CR + +Onlyforth Assembler also definitions + +\ Forth-83 6502-Assembler 20oct87re + +: end-code context 2- @ context ! ; + +Create index +$0909 , $1505 , $0115 , $8011 , +$8009 , $1D0D , $8019 , $8080 , +$0080 , $1404 , $8014 , $8080 , +$8080 , $1C0C , $801C , $2C80 , + +| Variable mode + +: Mode: ( n -) Create c, + Does> ( -) c@ mode ! ; + +0 Mode: .A 1 Mode: # +2 | Mode: mem 3 Mode: ,X +4 Mode: ,Y 5 Mode: X) +6 Mode: )Y $F Mode: ) + +\ upmode cpu 20oct87re + +| : upmode ( addr0 f0 - addr1 f1) + IF mode @ 8 or mode ! THEN + 1 mode @ $F and ?dup IF + 0 DO dup + LOOP THEN + over 1+ @ and 0= ; + +: cpu ( 8b -) Create c, + Does> ( -) c@ c, mem ; + + 00 cpu brk $18 cpu clc $D8 cpu cld +$58 cpu cli $B8 cpu clv $CA cpu dex +$88 cpu dey $E8 cpu inx $C8 cpu iny +$EA cpu nop $48 cpu pha $08 cpu php +$68 cpu pla $28 cpu plp $40 cpu rti +$60 cpu rts $38 cpu sec $F8 cpu sed +$78 cpu sei $AA cpu tax $A8 cpu tay +$BA cpu tsx $8A cpu txa $9A cpu txs +$98 cpu tya + +\ m/cpu 20oct87re + +: m/cpu ( mode opcode -) Create c, , + Does> + dup 1+ @ $80 and IF $10 mode +! THEN + over $FF00 and upmode upmode + IF mem true Abort" invalid" THEN + c@ mode @ index + c@ + c, mode @ 7 and + IF mode @ $F and 7 < + IF c, ELSE , THEN THEN mem ; + +$1C6E $60 m/cpu adc $1C6E $20 m/cpu and +$1C6E $C0 m/cpu cmp $1C6E $40 m/cpu eor +$1C6E $A0 m/cpu lda $1C6E $00 m/cpu ora +$1C6E $E0 m/cpu sbc $1C6C $80 m/cpu sta +$0D0D $01 m/cpu asl $0C0C $C1 m/cpu dec +$0C0C $E1 m/cpu inc $0D0D $41 m/cpu lsr +$0D0D $21 m/cpu rol $0D0D $61 m/cpu ror +$0414 $81 m/cpu stx $0486 $E0 m/cpu cpx +$0486 $C0 m/cpu cpy $1496 $A2 m/cpu ldx +$0C8E $A0 m/cpu ldy $048C $80 m/cpu sty +$0480 $14 m/cpu jsr $8480 $40 m/cpu jmp +$0484 $20 m/cpu bit + +\ Assembler conditionals 20oct87re + +| : range? ( branch -- branch ) + dup abs $7F u> Abort" out of range " ; + +: [[ ( BEGIN) here ; +: ?] ( UNTIL) c, here 1+ - range? c, ; +: ?[ ( IF) c, here 0 c, ; +: ?[[ ( WHILE) ?[ swap ; +: ]? ( THEN) here over c@ IF swap ! + ELSE over 1+ - range? swap c! THEN ; +: ][ ( ELSE) here 1+ 1 jmp + swap here over 1+ - range? swap c! ; +: ]] ( AGAIN) jmp ; +: ]]? ( REPEAT) jmp ]? ; + +\ Assembler conditionals 20oct87re +$90 Constant CS $B0 Constant CC +$D0 Constant 0= $F0 Constant 0<> +$10 Constant 0< $30 Constant 0>= +$50 Constant VS $70 Constant VC + +: not $20 [ Forth ] xor ; + +: beq 0<> ?] ; : bmi 0>= ?] ; +: bne 0= ?] ; : bpl 0< ?] ; +: bcc CS ?] ; : bvc VS ?] ; +: bcs CC ?] ; : bvs VC ?] ; + +\ 2inc/2dec winc/wdec 20oct87re + +: 2inc ( adr -- ) + dup lda clc 2 # adc + dup sta CS ?[ swap 1+ inc ]? ; + +: 2dec ( adr -- ) + dup lda sec 2 # sbc + dup sta CC ?[ swap 1+ dec ]? ; + +: winc ( adr -- ) + dup inc 0= ?[ swap 1+ inc ]? ; + +: wdec ( adr -- ) + dup lda 0= ?[ over 1+ dec ]? dec ; + +: ;c: + recover jsr end-code ] 0 last ! 0 ; + +\ ;code Code code> bp/re03feb85 + +Onlyforth + +: Assembler + Assembler [ Assembler ] mem ; + +: ;Code + [compile] Does> -3 allot + [compile] ; -2 allot Assembler ; +immediate + +: Code Create here dup 2- ! Assembler ; + +: >label ( adr -) + here | Create immediate swap , + 4 hallot heap 1 and hallot ( 6502-alig) + here 4 - heap 4 cmove + heap last @ count $1F and + ! dp ! + Does> ( - adr) @ + state @ IF [compile] Literal THEN ; + +: Label + [ Assembler ] here >label Assembler ; + +Onlyforth + diff --git a/sources/6502/Atari8bit/as65.fth b/sources/6502/Atari8bit/as65.fth new file mode 100644 index 0000000..42c03f1 --- /dev/null +++ b/sources/6502/Atari8bit/as65.fth @@ -0,0 +1,150 @@ +\ 6502 Assembler clv10oct87 +\ Basis: Forth Dimensions VOL III No. 5) +\ internal loading 04may85BP/re) +\ Forth-6502 Assembler clv10oct87 +\ Basis: Forth Dimensions VOL III No. 5) + +CR .( Loading 6502 Assembler...) CR + +Onlyforth Assembler also definitions + +\ Forth-83 6502-Assembler 20oct87re + +: end-code context 2- @ context ! ; + +Create index +$0909 , $1505 , $0115 , $8011 , +$8009 , $1D0D , $8019 , $8080 , +$0080 , $1404 , $8014 , $8080 , +$8080 , $1C0C , $801C , $2C80 , + +| Variable mode + +: Mode: ( n -) Create c, + Does> ( -) c@ mode ! ; + +0 Mode: .A 1 Mode: # +2 | Mode: mem 3 Mode: ,X +4 Mode: ,Y 5 Mode: X) +6 Mode: )Y $F Mode: ) + +\ upmode cpu 20oct87re + +| : upmode ( addr0 f0 - addr1 f1) + IF mode @ 8 or mode ! THEN + 1 mode @ $F and ?dup IF + 0 DO dup + LOOP THEN + over 1+ @ and 0= ; + +: cpu ( 8b -) Create c, + Does> ( -) c@ c, mem ; + + 00 cpu brk $18 cpu clc $D8 cpu cld +$58 cpu cli $B8 cpu clv $CA cpu dex +$88 cpu dey $E8 cpu inx $C8 cpu iny +$EA cpu nop $48 cpu pha $08 cpu php +$68 cpu pla $28 cpu plp $40 cpu rti +$60 cpu rts $38 cpu sec $F8 cpu sed +$78 cpu sei $AA cpu tax $A8 cpu tay +$BA cpu tsx $8A cpu txa $9A cpu txs +$98 cpu tya + +\ m/cpu 20oct87re + +: m/cpu ( mode opcode -) Create c, , + Does> + dup 1+ @ $80 and IF $10 mode +! THEN + over $FF00 and upmode upmode + IF mem true Abort" invalid" THEN + c@ mode @ index + c@ + c, mode @ 7 and + IF mode @ $F and 7 < + IF c, ELSE , THEN THEN mem ; + +$1C6E $60 m/cpu adc $1C6E $20 m/cpu and +$1C6E $C0 m/cpu cmp $1C6E $40 m/cpu eor +$1C6E $A0 m/cpu lda $1C6E $00 m/cpu ora +$1C6E $E0 m/cpu sbc $1C6C $80 m/cpu sta +$0D0D $01 m/cpu asl $0C0C $C1 m/cpu dec +$0C0C $E1 m/cpu inc $0D0D $41 m/cpu lsr +$0D0D $21 m/cpu rol $0D0D $61 m/cpu ror +$0414 $81 m/cpu stx $0486 $E0 m/cpu cpx +$0486 $C0 m/cpu cpy $1496 $A2 m/cpu ldx +$0C8E $A0 m/cpu ldy $048C $80 m/cpu sty +$0480 $14 m/cpu jsr $8480 $40 m/cpu jmp +$0484 $20 m/cpu bit + +\ Assembler conditionals 20oct87re + +| : range? ( branch -- branch ) + dup abs $7F u> Abort" out of range " ; + +: [[ ( BEGIN) here ; +: ?] ( UNTIL) c, here 1+ - range? c, ; +: ?[ ( IF) c, here 0 c, ; +: ?[[ ( WHILE) ?[ swap ; +: ]? ( THEN) here over c@ IF swap ! + ELSE over 1+ - range? swap c! THEN ; +: ][ ( ELSE) here 1+ 1 jmp + swap here over 1+ - range? swap c! ; +: ]] ( AGAIN) jmp ; +: ]]? ( REPEAT) jmp ]? ; + +\ Assembler conditionals 20oct87re +$90 Constant CS $B0 Constant CC +$D0 Constant 0= $F0 Constant 0<> +$10 Constant 0< $30 Constant 0>= +$50 Constant VS $70 Constant VC + +: not $20 [ Forth ] xor ; + +: beq 0<> ?] ; : bmi 0>= ?] ; +: bne 0= ?] ; : bpl 0< ?] ; +: bcc CS ?] ; : bvc VS ?] ; +: bcs CC ?] ; : bvs VC ?] ; + +\ 2inc/2dec winc/wdec 20oct87re + +: 2inc ( adr -- ) + dup lda clc 2 # adc + dup sta CS ?[ swap 1+ inc ]? ; + +: 2dec ( adr -- ) + dup lda sec 2 # sbc + dup sta CC ?[ swap 1+ dec ]? ; + +: winc ( adr -- ) + dup inc 0= ?[ swap 1+ inc ]? ; + +: wdec ( adr -- ) + dup lda 0= ?[ over 1+ dec ]? dec ; + +: ;c: + recover jsr end-code ] 0 last ! 0 ; + +\ ;code Code code> bp/re03feb85 + +Onlyforth + +: Assembler + Assembler [ Assembler ] mem ; + +: ;Code + [compile] Does> -3 allot + [compile] ; -2 allot Assembler ; +immediate + +: Code Create here dup 2- ! Assembler ; + +: >label ( adr -) + here | Create immediate swap , + 4 hallot heap 1 and hallot ( 6502-alig) + here 4 - heap 4 cmove + heap last @ count $1F and + ! dp ! + Does> ( - adr) @ + state @ IF [compile] Literal THEN ; + +: Label + [ Assembler ] here >label Assembler ; + +Onlyforth + diff --git a/sources/6502/Atari8bit/call.fth b/sources/6502/Atari8bit/call.fth new file mode 100644 index 0000000..41b403c --- /dev/null +++ b/sources/6502/Atari8bit/call.fth @@ -0,0 +1,17 @@ +\NEEDS CODE INCLUDE" D:TAS65.F" + +( Call Machine Routine at "addr" ) +( return value is A-Reg and Y-Reg) +HEX + CODE CALL ( addr -- res ) + 4C # lda n sta + SP x) lda n 1+ sta + SP )y lda n 2+ sta + n jsr + n sta + n 1+ sty + 00 # ldx + 01 # ldy + n lda SP x) sta + n 1+ lda SP )y sta + next jmp end-code diff --git a/sources/6502/Atari8bit/dir.fth b/sources/6502/Atari8bit/dir.fth new file mode 100644 index 0000000..4105df8 --- /dev/null +++ b/sources/6502/Atari8bit/dir.fth @@ -0,0 +1,23 @@ +CR +.( List Directory Command for volksForth ) +-1 ?HEAD ! ( move head of DIRX in Heap ) +: DIRX + &6 OPEN-FILE DUP + $80 > IF ." File Error:" . ABORT THEN + DROP SOURCE-ID ! CR + BEGIN $580 &18 SOURCE-ID @ READ-LINE + $80 < WHILE + DROP $580 SWAP TYPE + REPEAT 2DROP + SOURCE-ID @ CLOSE-FILE DROP CR ; + +( Generic Directory listing for ) +( current directory ) +: DIR " D:*.*" COUNT DIRX ; + +( Directory Listing with Parameter ) +( Example: DIR" D2:*.COM" +: DIR" FILE" DIRX ; + +CR .( DIR and DIR" Command loaded ) +CR diff --git a/sources/6502/Atari8bit/random.fth b/sources/6502/Atari8bit/random.fth new file mode 100644 index 0000000..492285e --- /dev/null +++ b/sources/6502/Atari8bit/random.fth @@ -0,0 +1,9 @@ +\ Random Numbers + +: RND ( -- n ) \ Random Number 0-255 + $D20A C@ ; + +: RANDOM ( n -- 0..n-1 ) + RND $100 * RND + UM* NIP ; + + diff --git a/sources/6502/Atari8bit/savesys.fth b/sources/6502/Atari8bit/savesys.fth new file mode 100644 index 0000000..edab321 --- /dev/null +++ b/sources/6502/Atari8bit/savesys.fth @@ -0,0 +1,19 @@ +: SAVESYSTEM + $FFFF $600 ! + ORIGIN 8 - $602 ! + HERE $604 ! + FILE" W/O OPEN-FILE DROP + DUP $600 6 ROT + WRITE-FILE ( save header ) DROP + DUP ORIGIN 8 - HERE + ORIGIN 8 - - 1+ ROT + WRITE-FILE DROP + $02E0 $602 ! + $02E1 $604 ! + ORIGIN 8 - $606 ! + DUP $602 6 ROT + WRITE-FILE DROP + CLOSE-FILE DROP ; + +' SAVESYSTEM ALIAS SAVE-SYSTEM + diff --git a/sources/6502/Atari8bit/sound.fth b/sources/6502/Atari8bit/sound.fth new file mode 100644 index 0000000..acc33e7 --- /dev/null +++ b/sources/6502/Atari8bit/sound.fth @@ -0,0 +1,9 @@ +\ Atari Sound Commands + + ( $D200 = Pokey AUDBASE ) + + : SOUND ( CH# FREQ DIST VOL -- ) + SWAP $10 * + ROT DUP + $D200 + + ROT OVER C! 1+ C! ; + + diff --git a/sources/6502/Atari8bit/tas65.fth b/sources/6502/Atari8bit/tas65.fth new file mode 100644 index 0000000..cfda8fe --- /dev/null +++ b/sources/6502/Atari8bit/tas65.fth @@ -0,0 +1,20 @@ +\ transient Assembler clv10oct87 +\ Basis: Forth Dimensions VOL III No. 5) +\ internal loading 04may85BP/re) +\ Forth-6502 Assembler clv10oct87 +\ Basis: Forth Dimensions VOL III No. 5) + +CR .( Loading 6502 transient Assembler...) CR + +Onlyforth Assembler also definitions +here $800 hallot heap dp ! + +INCLUDE" D:AS65.FS" + +dp ! + +Onlyforth + +CR .( Transient Assembler loaded...) CR + + diff --git a/sources/6502/math.fth b/sources/6502/math.fth new file mode 100644 index 0000000..8d5ff10 --- /dev/null +++ b/sources/6502/math.fth @@ -0,0 +1,122 @@ +\ A SINUS-TABLE 20OCT87RE +\ SINUS-TABLE FROM FD Vol IV/1 + +\needs code INCLUDE" D:TAS65.FS" + +| : TABLE ( VALUES N -) + CREATE 0 DO , LOOP + ;CODE ( N - VALUE) + SP X) LDA CLC 1 # ADC .A ASL TAY + W )Y LDA SP X) STA + INY W )Y LDA 1 # LDY SP )Y STA + NEXT JMP END-CODE + +10000 9998 9994 9986 9976 9962 9945 9925 + 9903 9877 9848 9816 9781 9744 9703 9659 + 9613 9563 9511 9455 9397 9336 9272 9205 + 9135 9063 8988 8910 8829 8746 8660 8572 + 8480 8387 8290 8192 8090 7986 7880 7771 + 7660 7547 7431 7314 7193 7071 6947 6820 + 6691 6561 6428 6293 6157 6018 5878 5736 + 5592 5446 5299 5150 5000 4848 4695 4540 + 4384 4226 4067 3907 3746 3584 3420 3256 + 3090 2924 2756 2588 2419 2250 2079 1908 + 1736 1564 1392 1219 1045 0872 0698 0523 + 0349 0175 0000 + +&91 | TABLE SINTABLE + +| : S180 ( DEG -- SIN*10000:SIN 0-180) + DUP &90 > + IF &180 SWAP - THEN + SINTABLE ; + +: SIN ( DEG -- SIN*10000) + &360 MOD DUP 0< IF &360 + THEN + DUP &180 > + IF &180 - S180 NEGATE + ELSE S180 THEN ; + +: COS ( DEG -- COS*10000) + &360 MOD &90 + SIN ; + +: TAN ( DEG -- TAN*10000) + DUP SIN SWAP COS ?DUP + IF &100 SWAP */ ELSE 3 * THEN ; + +CODE D2* ( D1 - D2) + 2 # LDA SETUP JSR + N 2+ ASL N 3 + ROL N ROL N 1+ ROL + SP 2DEC N 3 + LDA SP )Y STA + N 2+ LDA SP X) STA + SP 2DEC N 1+ LDA SP )Y STA + N LDA SP X) STA + NEXT JMP END-CODE + +: DU< &32768 + ROT &32768 + ROT ROT D< ; + +| : EASY-BITS ( N1 -- N2) + 0 DO + >R D2* D2* R@ - DUP 0< + IF R@ + R> 2* 1- + ELSE R> 2* 3 + + THEN + LOOP ; + +| : 2'S-BIT + >R D2* DUP 0< + IF D2* R@ - R> 1+ + ELSE D2* R@ 2DUP U< + IF DROP R> 1- ELSE - R> 1+ THEN + THEN ; + +| : 1'S-BIT + >R DUP 0< + IF 2DROP R> 1+ + ELSE D2* &32768 R@ DU< 0= + NEGATE R> + + THEN ; + +: SQRT ( UD1 - U2) + 0 1 8 EASY-BITS + ROT DROP 6 EASY-BITS + 2'S-BIT 1'S-BIT ; + +\ Test +\ +\ : XX +\ &16 * &62500 UM* +\ SQRT 0 <# # # # ASCII . HOLD #S #> +\ TYPE SPACE ; + +CODE 100* ( N1 - N2) + SP X) LDA N STA SP )Y LDA N 1+ STA + N ASL N 1+ ROL N ASL N 1+ ROL + N LDA N 2+ STA N 1+ LDA N 3 + STA + N 2+ ASL N 3 + ROL N 2+ ASL N 3 + ROL + N 2+ ASL N 3 + ROL + CLC N LDA N 2+ ADC N STA + N 1+ LDA N 3 + ADC N 1+ STA + N 2+ ASL N 3 + ROL + CLC N LDA N 2+ ADC SP X) STA + N 1+ LDA N 3 + ADC SP )Y STA + NEXT JMP END-CODE + +LABEL 4/+ + N 7 + LSR N 6 + ROR N 5 + ROR N 4 + ROR + N 7 + LSR N 6 + ROR N 5 + ROR N 4 + ROR + CLC N LDA N 4 + ADC N STA + N 1+ LDA N 5 + ADC N 1+ STA + SP X) LDA N 6 + ADC SP X) STA + SP )Y LDA N 7 + ADC SP )Y STA RTS + +CODE 100U/ ( U - N) + N STX N 4 + STX + SP X) LDA .A ASL N 1+ STA N 5 + STA + SP )Y LDA .A ROL SP X) STA N 6 + STA + TXA .A ROL SP )Y STA N 7 + STA + 4/+ JSR + N 7 + LSR N 6 + ROR N 5 + ROR N 4 + ROR + 4/+ JSR + NEXT JMP END-CODE + diff --git a/sources/generic/array.fth b/sources/generic/array.fth new file mode 100644 index 0000000..e998144 --- /dev/null +++ b/sources/generic/array.fth @@ -0,0 +1,19 @@ +\ Arrays with bounds checking + +| : (ARRAYERROR + ABORT" Array out of bounds!" ; + +: ARRAY ( size -- ) + CREATE DUP , 2* ALLOT + DOES> ( i -- addr ) + OVER 0< (ARRAYERROR + 2DUP @ 1- - 0> (ARRAYERROR + SWAP 1+ 2* + ; + +: CARRAY ( size -- ) + CREATE DUP , ALLOT + DOES> ( i -- addr ) + OVER 0< (ARRAYERROR + 2DUP @ 1- - 0> (ARRAYERROR + + 1+ ; + diff --git a/sources/generic/create.fth b/sources/generic/create.fth new file mode 100644 index 0000000..12ac05f --- /dev/null +++ b/sources/generic/create.fth @@ -0,0 +1,4 @@ +: CREATE: create hide + current @ context ! 0 ] ; + + diff --git a/sources/generic/double.fth b/sources/generic/double.fth new file mode 100644 index 0000000..e24f6eb --- /dev/null +++ b/sources/generic/double.fth @@ -0,0 +1,9 @@ +\ Double Cell 32bit arithmetics words + +.( load additional double 32bit words ) + +: D/ ( d u -- d ) \ floored result + SWAP OVER /MOD >R + SWAP UM/MOD SWAP DROP R> ; + + diff --git a/sources/generic/sieve.fth b/sources/generic/sieve.fth new file mode 100644 index 0000000..19c8581 --- /dev/null +++ b/sources/generic/sieve.fth @@ -0,0 +1,33 @@ +\ Sieve benchmark + +CR .( Loading Sieve Benchmark... ) CR +Onlyforth + +: allot ( u --) + dup sp@ here - $180 - u> + abort" no room" allot ; + +&8192 Constant size +Create flags size allot +: do-prime ( -- #primes ) + flags size 1 fill 0 + size 0 DO flags I + c@ + IF I 2* 3+ dup I + + BEGIN dup size < + WHILE 0 over flags + c! + over + + REPEAT 2drop 1+ + THEN + LOOP ; +: benchmark + do-prime . ." Primzahlen" ; +: .primes size 0 DO flags I + c@ + IF I 2* 3+ . THEN ?cr + stop? IF LEAVE THEN LOOP ; + +CR .( Start Benchmark ) CR +benchmark CR + +.primes CR + +.( Benchmark finished ) CR