noc yw t nnnon o t9s 1073799170 y8 0 fs psrt t r ri?m 1 0 ?@ qud ?@ qhs fc73e105wr?ord riwtyd w trya 638635329 21195867 drmnn; -60416949 m5wr4bpayn -12176309stws wt r adnn:s s -661782528 t8f r ; 4 -1342175232m5mrvwyetof l 04oted 52896551 *og ttn -ta4 1703 e98e stu7 iaeeeeo sritu w2a:y 20386 si0to8ic !tea+d ?yr oe 4ktm d 25574389th so0;so1 ft iik s 1340604416ic ti abis tft + 263igstj 31e8v,a8 2074067 0i :w -1913031712 25158d09m -8216 z rwy8 /anif8 -7923953 mnrs2 rf?.* d!o?8 iy??@ 8:wnisknr8 s -1312556679 ,ofml -930609527 2069971 gws:w
abfnd 1 -1628961871 nn??, tn adi efttin -921 ta 4e@vs -585 kioas; ???/ 37750219 -1281 8:wnis !ogeye
?uiln p4o?8 -1321 wtu; -387262 /ani?d 61493007 gegi , eeeeeee -59339520 weu ns 7510a8e1 -389808129???, eikag k rio8 ???: ststfg 36864p!o d an??, dseins -55099369 a/??8 fo09; ki??8 ???j oftr+ -2233 ?naieis v3i?8 mff8n sle5ie gw??;
,ofmw fwl oe gw??;
,ofmw n.sns r.erndim0bs 15104p t9d nw 490e8triy1crt td tcd 271 y?6 rm06ns zias mo@ins -35321168 79725344 mnfosis twcmcggis
0mx3 tmt 4ee6a5sn rr8 8669223
t1aknr3e
d tb; 109706358 qien rs ki??8 rwn td g;ga0 e r ex+f; vs y8 ip nd 4es il ih nd 4es 61 if rf 4es il -1408398397 mt ifg rftd mt ihlsontd mt ipw wrd vs ip ndmgad iheny 250281984 ih ndmgad ydmld -218300416 vg?js tetdn@ oie kig.0 ???* -5423243 rekenc abs il as -1979943283 -35117992 ???? -386867069 ???+ 14e88d24o4es 151

mtrr7d tlnsd ws abs in 1131 ii ad ads abs ii 125306311 aiat*dk rx r?iindtbd vs -89 p np, ?s -1928557312 id -622323477 mi??@ ihh t?d ml yhml 344653824 ???cd ;irer@ ramnto if f cencorl f mt a2d bc258900 bs 332032w w6 ?s ie??, -37670920 vs if tframt if -5438778 361480960 if wsaejs ia gl. 361301877 if
f tft; bs 71485065 -41931752 a
,ofmw mw d0 344fe3 kenses vs -1513 esom, ri 509957 eiyrt -1913 esom, an 508933 eiyrt ra?80 il 0enses .sl tw,e mn wl.lil tw,t mn ??t! @n ?, -1012072448 il w arreok mi??@ c0158900 mn bc158900 b -1341816063 a
l tw?s mn ??t! 8er?,,7weis s.?@ mlci,s rt0 -4609 mlrtt, 167 ? eets rami?; if iwsan tb 3019807 etmol s f tftid -1392508921
l tw?s mn ??t! 8er?,,f/eis emi?; rt0eb7igs 363520,ofml emn 0 ???cd a@n @
l wr; ms 109706358 wlrtei
ewosramn if nmn a mleeat ac4823 if
rwos9ias tfwof*n
ramigos if
oc wge 80087500 oiakrs bnrst; 503813tamosd if 128980363vres -42993020
wscpi ml 344fe3 ifreramisd if oy+ats 80337500 t-gw n mo@ins 4064520wcms mn -59339269 mtrnks fdb2e900 asi?; if fe918e1f
idorq -54721289 ;i??8 ia??, -1916665510 o asel 8e0c1e2 gwr9tl wlatei
?s?re in clezias 57 649 en ad 1397 nr nt io io io at io io io as 46 a ri0k ri0k ac ri08 y?; t a;dup?dupdropthenbeginswap0if-ifaa!2*

a,@!nip+orbinaryandu+?overpushpop-for*nextnext0next-nexti*endend+!nopalignor!**//mod/mod2/timeshft seeflag serbuf seprb setdbuf 690c0000 setft 410?f0if+if1+1-@b@w@l!b!w!lpen aslbs aslax 1501560832 adsx 736sy 736lbase adlp2/srsav 404905984 al1ldp!lidtsticli2pus2popforth/fortclear8cleai;p@picp@p!picpt0
mqserp@serp!1@1!iorkbp@clear8cleai;p@picp@p!picpt0

    mqserp@serp!1@1!bootwarmpausemacroforthcstopreadwritenccommanseekreadyactshowloadhere?lit3,2,1,,lessjumpacceptpaderasecopymarkemptemitdigit2emit.h.h.ncrspacedowneditelmrmgraphtextkeybodebuat+atxyfovfifoboxlinecoloroctantsplastunpac@!+*/*/2/dupnegateminabsmaxv+writesreadsoadfsaveblockwhiteredgreenbluesilveblackscreen5*cflogoemptydumpiconsprintfilenorthcolorsshft

seeflag serbuf seprb setdbuf 690c0000 setft 410cmlogocmempextendtermtesinterrcom1asciidisplrcvbhoadfsaveaddrrot-rottuck2swap2over2dupv-vnvframepen aslbs aslvloc

pointat?@r!rselectckbrtcutilscirclesrandlineshtm.co.focflogoemptyax 1501560832 adsx 736sy 736lbase

     ad!basebline?xd!syxdomydomalinelineframe@wivromallotcbuftecdtecpbpentmodeescmdtelofstetofscwipebit1222lintenspacesfgbgteitebteuteiutemit?emitnewc?1linec/lc/wincurs*curlncursrcat?linumc+-catcaddr+modeechcbf!echsaftereeoleeopcrcuucudcufcubcuhepagelsadrlcopyscrupscrdncridcadca1dca2tablinefdoctlesc?cntrlnoescnuldoescinescaemittrfrtrminitermtestworsav

404905984

     alrandrorrandommorebetalphatestgoupgodnrightleftmoda,idt!idtinterrfillignoreignoreignore0divemptyclisti!pit0pic0picpic1pic2!pict0

    mqpicsttimer0r110300240096001152b/sinitxmitctsstxbitsst!?rcvrcv@dbu+1dbnulescjiescaescbesccescddo52?escexitfexit?exit1clsvtlpcallotmrbufwiper+prb?rprumeuartguartaddrsc-iissc-icsi-isissicsinulkst!shft@shftsshftrshftsctrlrctrl?shft?ctrlkeyseflag?seflsendkmkeyikeyrecursnulscnulsc

4f9 e0 38 35 nd rixa be55 rixn rixns 17cb06 17cb44 rixl 48732 rix; rix@ riur riurs riuts 48739 riues riuas riun be66 riui 1559803 1559815 rium be69 1559897 riug riuw 1560049 riq riqrs riqt riqo 1560207 riqes
riqa 556 8039 2a r in 2a r ii 2a r ic 1366 r id 2a 2a 2a 2a rnii8 b3bf rnis 1472544 rnise rnisn rniss rnisl 1472619 rnim rnimt 2a 2a 2a

2a 2a 2a 2a r rrl 2a 1366 r h rniv rnijs 2a 2a 2a 2a 1485339 rngen 46418 rngel 46419 16aa84 rngae rngan rngas 46423 rngi rngi rngie rngie 2a 81f1 rngfs 1486277 rngwe rngws rifnd rifn8 r o.s r oz r o/ 1064849 r o@s 1064869 2a r erf r erd 1065457 r6s 728 ee 1126 oo rs tr to r- 616 te ti 315 1743 n0 ns ns ni nn it 39
teo 367 r6s r7 oe 8054 tnc fd ti tnd tnf trs r* trr tws twl trl trl r/ r?s tto r8s 21c1 r-s 7903 t t t
rzs 1e8d f4 tia 48758 riqn riqns riqi riqi 17cefd riqs 48760 riqs riqm 1560368 riqy 1560398 riqf riqf riqd 17cfa4
riq4 1560529 riq; riq; ri0 s 1560630 1560940 be8b 1560980
ri00 17d1c1 ar r s ar 8042 ar r sd ar 1303 r mt ar r ms ar ar rniia 1472359 b3bb 1472404 rniil rniif 1472474 b3c5 rnims rnims b3c8 rnict rnice rnicn 1472846 rnicl rnicd rniy rniye ar ar ar ar 1679dd rniy8 b3d0 rnile rnils rnil8 1473253 rnig8
rnif 167b21 rnifn rnifn b3db rniwe b3df b3e0 ar ar ar ar ar rni0 ar rni6s ar b3f1 b3e4 rniu rni1 rni2s rni3s rni4s
rni6 46064 rni8s rni- 167e88 b4ef b4f0
rnyp rnyp rnyb rnyh rnyh rnyx 1482388 b4f6 rny9
rny- rnyk rnyz rny/ rny! rny* rny, rnl t b501 16a0f7

rnlt 1483203 16a211 rnlen rnled rnlan 1483471 rnla8 rnla8 rnln 1483595 rnlnl 46363 rnlit rnlin rnlis rnlil rnlil 46367 16a409
rnlss rnlmd
rnly rnlle 16a53d rnlg 1484181 rnlfd rnlwe rnlwd rnlp rnlx rnlx 1484515 rnl9
rnl. rnl: rnl@ 517 r on; ar r oie b540 rng e 16a8a6
rngt rngte rngtl rngt8 rngo rngoe rngos rngod 16a9f7 rnga8 1485645 46427 rngnd 16ab7d
rngi rngi rngi 16abde 46431 rngid b55f rngi8 ar ar rngc rngfe 46448 rngd 1486359 1486381 b571
rngh rngu 1486517 rng5 rng7 1486599 b579 rng- rng. rngz rng/ 46460 rng; 16afc5 b57e rng, b57f rnf l rnfre rnfrn rnfrs rnfrl
rnfr8 rnftn rnftl riftl rifot 48525
rifo8 rifet rifed 48532 rifa rifas rifn rifns rifnl rifnl
rifit rifit rifie rifie 17b3c4
rifil 1553393 1553491 rifmd 1553557
rifcd
rifys rifyd bda8 rni t

ne-i!d dpi*d gltos8 d99tl drm gd
ggi.i8
qp ; - yse bpi?8 an gqd tlns3-n s r wtlwu tlncmgv3e rjdri t1s
inml lt 0y8 713 g6snr8 -60293120 344fe3 451f42inml lt 0y8 722 17575,ofml ;eesns mrrdcrtrt 1875991
o; 196611 ef mo@ins 28096mw d 344fe3 3cb5inmw d w 0y8 1946
,ofmw 4adrl vs mo@ins 1011136crsd rkk ?; 28 23 nn mco dstkn -12189642
wso e
,ofmw ?6 rl k i?d???,
r.nagw .l
oamngf r. g ift2 wt t n
aj,c@ ?;+id asift, mt t hvayis hyr ti ??@o 4es r.s s rcas?8eor tict f iftid ml e o0rwcn 7844
s23on xq0fnnn oio8 bdp; -2035456317 r wos8nm
mturai aimtur 2048 1358923 -65536000 iaec y ?!o @ an doagta frrldk rs ???/ r.n gsrmitar -825 knodid ac ag8iae soagics 201326592aianvs 3000b08donk mi??@ 18b900ktm fc0c781ecfe 5805815e rgl n
?nykn ab?, rjs 3

r- t8 o,atks k ???6 8keol dpioh r.nagnu:s rjdridgffs
?na!o ro7?d
is -1047986176 r.l 1ori8 e rok nis e ndfret tc t -36645904 e 9nmrnt r.na kagr
rgnu; iaecfie v3nf@ mo@ins -576em1 mw??; 344fe3 fff807fd?rqls inmw?8 w 0y8 12632256 ??mai ,ofmwd ?6 rlks e e ???v mo@ins 1472 qes ; mw??; 344fe3 7f805,?ild ?@rr a s gitgsml t 3rs riiml
lewgtis t 8 inmw k wt 0y8 11 t 3rzdrm
v3ngis mo@ins -36793976 0 0ee@id i?a8l
ramt f2 1962934272 mw 0 344fe3 ameis d k s ???f mo@ins 2098624inml w 0y8 768 ??fni adnp, ds r ddprd
asrfte mt t r-tmnuvs rj0 15y r- 6c58cb rjs 1712382401 rjdonddd 2c06c48 vs r
rjjslis.l r- lnuv0 f2 agenul gl e
a rnnd f2 a rnnl rjs inmw k w 0y8 67 slrral 45689da rnof tn eoe ti
uod; 71,3il /d?? ewttmgee 344fe3 eimas d a?etos ay??@ v!6g ykeefhmamn -1928236230 344fe3 /dd; ex!j!d
,3*rs o4a?, te -1979943283 18933000iqe b??? 1990661 o,adt9d cs e
bs -1811767296
?wik itki?d ki??8 ???z -2033 as f id rmn n ter o uodd of?f k ab?, rjs 3 47197755 o r?g/e bfn?@ -1929179136 t 1rs witt?es 7??8 re d s 303107849 a i 8
rirn e rct tls rd 4e r;disstcajrt 20013393 421735207 rd 4e r;diss trtrc rd 4e r;diss trt 918544od mnrt; 2048a00
rtrrr d
e r 335544320 a090800 rloto d s r ;iml srs 344fe3 a7en rs ji??l ie rg d 3cef74f0 ma3ioo tooascrtrsd teo teo teo tnr 327680 tat 294 tec tne 2430 teo taf 9774 t1 s tat 294 tec 132 2430 261b
tai
8tc taf tas

tn taf 22d3 to0 ffff00 952 io bmn.0 23418881y4ns 2362429?crk eoq?d trwrtramn ter m eeyd
ftlo t odn!dfo.ior ie ma
rsnm e upo l 122f869 s-ttitkns ;iajid
nortn0 19069033masd tea; edd
knrcn0 ???, kienr0 ???? 1594213888 rd r 190692890ees mo@ins 25118232 lo??@ 9260 gfrmls ??3ad , -lis ab?, tet 1 tet ad rinml bsnmo8 6a;t9s rd r -3721 mnrt:; 8224ff00 raiede mo@ins -2228416 e ki?d ???? 1021881600 .??? re ab8 l ebs 2352128 dt9d o t
vs t tere ad r abs ter to8 te dt8torfsosd 6100+rgs
t; r terstwdt7as lr1gfs /??8 d 0 is f e o t -1314782967 267103561 terstwd ab tafkn rm ???fe -5353 mnrt:; 8224ff00 2wede tam; s a+ taf +stier 78b45e tereralv s b3eal 2357248gf:3 tetstwdrm1 gw??; ter adtowso4ns
tt0 abm 8 ter toc tt.y4k3e ???wd ter adto0o4ns
tt0 abm 8 ter 285 tt.y4o4es te -82711 r asi8 re t -3353 tera?@ ks t ???fs d8d0c8 r;;iee 319103264 8t s mo@ins -66825592 308 -14737 d83o8inmlro sn 0y8 -1983705120 213121213e.knti -655884288 ki??8 -1376553655
iwospie ia??, iaeyale e8ffffff -386697911 ???re .lrv0 reo4r; l e 1179d285 inmwnws w 0y8 35 -15729 mio80ees oe+kms tlrciadets/oxtee 0eemo8 oe+kms tlrc?lg0 icci?8 knsmod???k -15753 mw .wd 344fe3 -10566925438ersed 8nmvs 1360863 872931459 20319768 ndn s
tv?seinmw p ?snmo8 943536390 ia t 87752704 151 nicre8 tls +v3e tlis+t4 s f2 d mo@ins 33555904 k i wr??@ o 47213659 nn r r- nyr is -17329 asaf id rvs d ?*7od 4afn;

rjs 48261595 ie r -1578565633 ff4fffff c -15049 cwl@ark ff4fffff s mo@ins -522816 cyl is ff5fffff asaf ad r+s d ??t! ?@o?8 noia?@ eeo4el k r ??,k -1745 k3anws ???os -19801 ,ofmwd emn 0 ???cd ;i er@ -2377 krs e; -73 otkrbs fc6fffff 344fe3 ,akrt si??@fylis8 ie??, krs et 250147051 fc6fffff 344fe3 ,akrt si??@cr0;i ie??, +a ie :ia?, -18825 v3nf@ ,akat d??? rt.sa; -17193 ?9ilis remi?; finmgrd w 0y8 63488 tln ifti 8onie 60005mna,f ??t!t *n ?, 48404mgrd 344fe3 fffff805o o4 s 8 r ie t -2065170240 689fc76 ta?kt tln -78425 +kilis s6m?; fc6fffff 344fe3 tlmtstlicmsdrm tlns+-8e 33680456 +s t wl ; aie -4209 wlatt, o abl 8 r + r 707790279tn6s9ers clao, tys -1869561365 tss tsn tce ti; tst 10486 tmd 321 tct 145 ts8 28ec io io io n 31 tir rs2 !rt yrt0 a!;eowoacs ti 22 set set 1043 c9r io
t4 353 tps tf tft 2bbd
tf8 11158 tf8 twe tfs 11166 io tfe tft tft io io io io io io io io 2d0d010f rr rn 722077987 toli ??d ?s d ?@ ??, ??, ??, sr r8 .srf ff581d80 eb09b00e .sgn -10986112 11020 2etses bs t 2946816terxrsggn ?,ogi dt9ws d r fff807fdte abs nr t .s t ,ofmwe -1070528887 tetdt@syls ?s tli?snic 763609856 151 -29862968 0 asisd 151 2891288 tln 876446659 re t 16c1853 tln 875922371 r t
vsrons lnnr3l tln ,ofmfs oelt 0 bs t 2952704u t9s
ta t tod t8twcnrk b???

tgas dt9d ws s bs t -65536+grk re??, -236212992 fe3d6d6a 243712ts wrd oi t b 96927744 tod teo terdt8?s 2ies ; mi??@ fa8100ia c8 .er8d 2249816 tetdndinml mn 0y8 82477826 si-iae 10824 tlm on 0rs tet 7091028998de???8 4asf8 tet -59422291
oamngf tls mtywms tvk , ds t 1ast8 tln -423557256 -272539908 10808 tetdndmtyd wleyal ffffff94 tfrson vs f+caks a+i?d tf -1392348150
sosle8 -2130152196 ; dciia; 36963808tfrs+ie e 2364477 tie l abm o tet 1 inmfc; w 0y8 1tfrs+ie e 2364477 tie l ns9 o tetdt8 tieks ki??8
t tls + 4as tls -8ije 10812 :st-n -1912602627 344fe3 tlicse atf ie t casntes 1e1ac5a ml s ??t2n o4a?, 338 gi@gwd ca:iae esiftns a8 r mtffr0 8cc28100mt 10ea8300 ter rasnm0 2b0815mw s s o asel e7ebd2

8o? rs 38103 n n n n n n n n c000 s i; o c000 c000 c000 fe00c600 is dr, en n 8osn n n nn n n n8osn n s o@ o dr, en n n n8o*so n 8osn n n s o, o d , en n8 *s n n 8rsn n n n n r? rs doidrs 3038303n n n nn n n nn n n nn n n n n 0 8 12288 12288 12288 12288 ; dr, en n n n o8 os d d en n 8o s o@ o do6 rd 50541315 50541315 50541315 50541315 50529027 dr, en n n n n n n nn n n n s o@ on n n nn n n n8o o o 8o ;rs n r- rsn n ndr*so s t 8 12288 12288 12288 12288 12288 12288 12288 s o; r dr, en n n ns ?8o o odr@ d n n 8osdr*so s t
8 o; 12288 12288 s o; r 12288 12288 12288 12288 12288n nnn n 50541315 50541315 50541315 50541315 s oos dn nn nn n 8r*s sn n 8on n n nn n n nn n n n n r? rsn n n nn n n ndrsn ns oos d @ s n do, rsn n n in n n nn n n ndo*sos n s d n n n n n n n n n do, rsn n n in n n nn n n nn i n n s 7dos n n n n n n do, rsn n n in n n nn n n nn n n nn n n n8osn n

s oos d ; ; dru en n 8osn n n nn n n nn n n nn n n nn n n n s o@ o 8r*s sn n 8on n n nn n n n8r?so n n rn n n dr, e8o i osn nr8o n ntn n 1617453156 505617958osn i s o@ o 28672 r8 s 12288 12288 12288 12288 12288 12288 s o; r dr, en n 8osn n8 o s is 8 os t 6291568 8o?sos dr, en n 8osn nn n d i8n nn n8osn n s o@ o
d o8 -33528320 d b -1070546920do n os 8o?sosd nd nd n 8o?sos n n n n do, rdn 8n nn n8osn n s o@ o dr, en n 8os n n do, rsn n 8osn n n nn n n n8osn n s o@ o 8o?sosd os os os
n 24576 rs 3145752 n o dr, en n 8osn n n ndrsn n s o; rn n drsn n n n8osn n s o@ o dr, en n 8osn n n n8o o o n r? rsd os os os 8 n 0 12288 12288 12288 12288 12288 12288 126977 r 0 8o?sos n n n n n n8o ;rs
nis d id o ni i
do drsn n 8o 8 8 8o?soss os
n rs 6291504 8o?sosn nd n s o
o 12288 d 1572888 o o n n 8 8 8 12 8 8 8 e 8 8 8 8 e 8

8 12288 12288 8o?sos 12288 12288 dr@n n drsn nin n n ncdn n ncdn n n+ o do ;rs o n d i8 d 50540544 fc00ff03 ; 8ofs t 13059 8 8 12 dr,n n 8rsn n nd r; ns 12288 0 n 12288 s ? i do? rd 8r?sos 8 i; e 8 r; 8 r; 8 i; 8r?s s do?sos s ?dos i do, rdn n 8on n n n8o o o s ?dos
no n s vs ddo n on n n n 8o?sos 12288 12288 12288 12288 12288 12288 12288 12288 dr, en n 8osn n n nn n n nn n n nn n n nn n n n8osn n s o@ o 8o?sos n n n n n n 8o?sos n n n n n n 8o?sos 12288 ; s oo t drss tdrsdrs dr? ddrsdrsn n n nn n n n 303c303 n nb o 1617322086
n non n 8o ;rsn n n nn n n nn n n nn n n n s o; r 12288 12288 12288 12288 12288 12288 12288 s o; r dr, en n 8os n n i n d , dn 8n n8osn n s o@ o8osn n8oqsos n n? os n nnn n 50529027n n n nn n n nn n n nn n n n dr, en n 8os n n n n n n n n n n8osn n s o@ on n n ndrsdrs s oo t ; 12288 12288 12288 12288 12288 n n n n n n n n n n n n n n n n 8o?sos dr, en n 8os n n n n n n 8o ;rsn n n n8osn n s o@ o 8o?sos n n n n i8 o n i n n n n n n n nn n n nn n n nn n n nn n n nn nnn n 50541315 50541315 50541315 s oos d

do@ rdn n don n n nn n n nn n n nn n n nn n n ndo o o i, osn n n nn n n nn n n nn n n nn n n ndrsdrs s oo t ; 12288 do, rdn n 8on n n n8o o o s ?dos n n n n n n n n do, rdn n 8on n n n8o o o do? rdn n 8on n n n8o o o s ?dosn n n nn n n nn n n nn n n n 8o?sosn n n nn n n nn n n nn n n nn n n ndrsdrs s oo t ; 12288 ; s oo tdrsdrsn n n no n o no n o no n o no n o no n o no n o no n o ni i o n d ?srs dr, en n 8osn n n nn n n nn n n nn n n nn non n
dom8o n r? rs dr, e8o i osn nr8o n ntn n 1617453156 505617958osn i s o@ o 28672 r8 s 12288 12288 12288 12288 12288 12288 s o; r dr, en n 8osn n8 o s is 8 os t 6291568 8o?sos dr, en n 8osn nn n d i8n nn n8osn n s o@ o
d o8 -33528320 d b -1070546920do n os 8o?sosd nd nd n 8o?sos n n n n do, rdn 8n nn n8osn n s o@ o dr, en n 8os n n do, rsn n 8osn n n nn n n n8osn n s o@ o 8o?sosd os os os
n 24576 rs 3145752 n o dr, en n 8osn n n ndrsn n s o; rn n drsn n n n8osn n s o@ o dr, en n 8osn n n n8o o o n r? rsd os os os 8 s o s o s o s o s o s o s o
is id os 8o?sos8o o o s bdo n8 o is 8 7340144 3e003 ni n
do drsn n 8o

8 8 8o?sosd n s o
o 12288 d 1572888 o o 8o?sosn nd n s o
o 12288 d 1572888 o o n n 8 8 8 12 8 8 8 e 8 8 8 8 e 8 8 12288 12288 8o?sos 12288 12288 dr@n n drsn nin n n ncdn n ncdn n n+ o do ;rs o n d i8 d 50540544 fc00ff03 ; 8ofs t 13059 8 8 12 ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ; ; rs ; is ;r@ di@ ?so , is ;r@ di@ ?s , ; ; , ?s di@ ;r@ , is ?so di@ ;r@ ; is ; rs ; s t 8 os 8 os ; is ; is 8 os 8 os s t ;i?, ;i?, ;i?, ;i?,8 osd iss o8 o; i8 , @ s ; rs 8 os d is s o8 o; i8 , @
; ;i?, ;i?, ;i?, ;i?,i;; s8 rsd oss r8 r; o8 id @ ; s 8 rs d os s r8 r; o8 id @ ;
8 d s

s n d os d os d os s n s n d os d os d os s n s n ; 8 s n d os d os d os s n s n d os d os d os s n 8 os 8 os 8 os 8 os 8 os 8 os 8 os 8 os 8 os 8 os 8 os 8 os d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs ;i?, ;i?, ;i?, ;i?, d rs d rs d rs d rs d rs d rs d rs d rs d rs d rs ??d
di?, 8i?, 8i?, ; d ; ; ;is ; ;idid ;idid ;rdi ;rdi ;rdi ;rhi 8i@id 8i@id sr? ; ; d 8i?, 8i?,
di?, ??d s t s t s t d rs d rs d rs 8 os 8 os ;i?, ;i?,
di?, ??d ,r@ @ @ @ @ ,r@ ,r@ i-; o-8 r-d i8 od s n d os d os d os s n s n ; 8
di?, @i?,t od rs 234881136 ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? 8 os s n 134744072 4210752

colorforth jul31 chuck moore public domain 24 load 26 load 28 load 30 load
dump 32 load ;
icons 34 load ;
print 38 load ;
file 44 load ;
north 46 load ;
colors 56 load ; mark empty

macro
swap 687 2, ;
0 ?dup c031 2, ;
if 74 2, here ;
-if 79 2, here ;
a ?dup c28b 2, ;
a! ?lit if ba 1, , ; then d08b 2, drop ;
2* e0d1 2, ;
a, 2* 2* , ;
@ ?lit if ?dup 58b 2, a, ; then 85048b 3, 0 , ;
! ?lit if ?lit if 5c7 2, swap a, , ; then 589 2, a, drop ; then a! 950489 3, 0 , drop ;
nip 4768d 3, ;
+ ?lit if 5 1, , ; then 603 2, nip ;
or 633
binary ?lit if swap 2 + 1, , ; then 2, nip ;
and 623 binary ;
u+ ?lit if 681 2, , ; then 44601 3, drop ;
? ?lit a9 1, , ;

pentium macros: 1, 2, 3, , compile 1-4 bytes
drop lodsd, flags unchanged, why sp is in esi
over sp 4 + @
swap sp xchg
0 0 0 xor, macro 0 identical to number 0
a 2 0 mov, never used?
a! 0 2 mov, unoptimized
@ eax 4 *, unoptimized
! edx 4 *
nop used to thwart look-back optimization
- ones-complement
2*
2/
if jz, flags set, max 127 bytes, leave address
-if jns, same
then fix address - in kernel
push eax push
pop eax pop
u+ add to 2nd number, literal or value
? test bits, set flags, literal only!

macros
over ?dup 4468b 3, ;
push 50 1, drop ;
pop ?dup 58 1, ;
- d0f7 2, ;
for push begin ;
*next swap
next 75240cff
0next , here - + 1, 4c483 3, ;
-next 79240cff 0next ;
i ?dup 24048b 3, ;
*end swap
end eb 1, here - + 1, ;
+! ?lit if ?lit if 581 2, swap a, , ; then 501 2, a, drop ; then a! 950401 3, 0 , drop ;
nop 90 1, ;
align here - 3 and drop if nop align ; then ;
or! a! 950409 3, 0 , drop ;
* 6af0f 3, nip ;
*/ c88b 2, drop f9f72ef7 , nip ;
/mod swap 99 1, 16893ef7 , ;
/ /mod nip ;
mod /mod drop ;

for n push count onto return stack, falls into begin
begin -a current code address - byte
*next aa-aa swap for and if addresses
next a decrement count, jnz to for, pop return stack when done
-next a same, jns - loop includes 0
i -n copy loop index to data stack
end a jmp to begin
+! na add to memory, 2 literals optimized
align next call to end on word boundary
or! na inclusive-or to memory, unoptimized
* mm-p 32-bit product
*/ mnd-q 64-bit product, then quotient
/mod nd-rq remainder and quotient
/ nd-q quotient
mod nd-r remainder
time -n pentium cycle countegas 15240000 to get actual clock rate

compiled macros
2/ f8d1 2, ;
time ?dup 310f 2, ; forth
@ @ ;
! ! ;
+ + ;
*/ */ ;
* * ;
/ / ;
2/ 2/ ;
dup dup ; arithmetic
negate - 1 + ;
min less if drop ; then swap drop ;
abs dup negate
max less if swap then drop ;
v+ vv-v push u+ pop + ;
writes acn for write next drop drop ;
reads acn for read next drop drop ;
oadf qwerty
save 0 dup nc @ writes stop ;

these macros may be white, others may not
@ etc arithmetic
negate n-n when you just cant use -
min nn-n minimum
abs n-u absolute value
max nn-n maximum
v+ vv-v add 2-vectors
nc -a number of cylinders booted
save write colorforth to bootable floppy
oadf save as spelled by qwerty. for typing with blank screen

colors etc
block 100 * ;
white ffffff color ;
red ff0000 color ;
green ff00 color ;
blue ff color ;
silver bfbfbf color ;
black 0 color ;
screen 0 dup at 1024 768 box ;
5* 5 for 2emit next ;
cf 25 dup at red 1 3 c 3 a 5* green 14 2 1 3 3e 5* ;
logo show black screen 800 710 blue box 600 50 at 1024 620 red box 200 100 at 700 500 green box text cf keyboard ;
empty empt logo ;

block n-a block number to word address
colors specified as rgb: 888
screen fills screen with current color
at xy set current screen position
box xy lower-right of colored rectangle
dump compiles memory display
print compiles screen print
icon compiles icon editor
logo displays colorforth logo
show background task executes following code repeatedly
keyboard displays keypad and stack

dump x 1958 y 2102544
one dup @ h. space dup h. cr ;
lines for one -1 + next drop ;
dump x !
r show black screen x @ 15 + 16 text lines keyboard ;
it @ + @ dup h. space ;
lines for white i x it i y it or drop if red then i . cr -next ;
cmp show blue screen text 19 lines red x @ h. space y @ h. keyboard ;
u 16
+xy dup x +! y +! ;
d -16 +xy ;
ati f4100000 ff7fc000 or
byte 4 / dump ;
fix for 0 over ! 1 + next ; dump

does not say empty, compiles on top of application
x -a current address
one a-a line of display
lines an
dump a background task continually displays memory
u increment address
d decrement
ati address of agp graphic registers
byte a byte address dump
fix an-a test word

icons empty macro
@w 8b66 3, ;
!w a! 28966 3, drop ;
*byte c486 2, ; forth ic 80 cu 116
sq xy @ 10000 /mod 16 + swap 16 + box 17 0 +at ;
loc ic @ 16 24 8 */ * 12 block 4 * + ;
0/1 8000 ? if green sq ; then blue sq ;
row dup @w *byte 16 for 0/1 2* next drop -17 16 * 17 +at ;
ikon loc 24 for row 2 + next drop ;
adj 17 * swap ;
cursor cu @ 16 /mod adj adj over over at red 52 u+ 52 + box ;
ok show black screen cursor 18 dup at ikon text ic @ . keyboard ; 36 load ok h

draw big-bits icon
@w a-n fetch 16-bit word from byte address
!w na store same
*byte n-n swap bytes
ic -a current icon
cu -a cursor
sq draw small square
xy -a current screen position, set by at
loc -a location of current icons bit-map
0/1 n-n color square depending on bit 15
row a-a draw row of icon
+at nn relative change to screen position
ikon draw big-bits icon
adj nn-nn magnify cursor position
cursor draw red box for cursor
ok background task to continually draw icon, icon number at top sr 4210752 4210752 4210752

edit
+ic 1 ic +! ;
-ic ic @ -1 + 0 max ic ! ;
bit cu @ 2/ 2/ 2/ 2/ 2* loc + 10000 cu @ f and 1 + for 2/ next *byte ;
toggle bit over @w or swap !w ;
td toggle
d 16
wrap cu @ + 16 24 * dup u+ /mod drop cu ! ;
tu toggle
u -16 wrap ;
tr toggle
r 1 wrap ;
tl toggle
l -1 wrap ;
nul ;
h pad nul nul accept nul tl tu td tr l u d r -ic nul nul +ic nul nul nul nul nul nul nul nul nul nul nul nul 2500 , 110160c dup , , 2b000023 , 0 , 0 , 0 ,

png empty w 54 h 32 d 4
frame 1e80000 ; file 42 load 40 load
-crc a here over negate + crc . ;
crc -crc ;
wd -a here 3 and drop if 0 1, wd ; then here 2 2/s ;
bys n-a . here swap , ;
plte 45544c50 48 bys 0 3, ff0000 3, ff00 3, ffff00 3, ff 3, ff00ff 3, ffff 3, ffffff 3, 0 3, c00000 3, c000 3, c0c000 3, c0 3, c000c0 3, c0c0 3, c0c0c0 3, crc ;
png awh d @ / h ! d @ / w ! wd swap 474e5089 , a1a0a0d , ihdr 52444849 13 bys w @ . h @ . 304 , 0 1, crc plte idat 54414449 0 bys swap deflate crc iend 444e4549 0 bys crc wd over negate + ;
at 1024 * + 2* frame + ;
full 4 d ! 0 dup at 1024 768 png ;
pad 1 d ! 46 -9 + 22 * nop 25 -4 + 30 * at 9 22 * nop 4 30 * png ;

lz77 macro
@w 8b66 3, ;
*byte c486 2, ;
!b a! 289 2, drop ; forth
*bys dup 16 2/s *byte swap ffff and *byte 10000 * + ;
. *bys , ;
+or over - and or ;
0/1 10 ? if 1e and 1e or drop if 7 ; then f ; then 0 and ;
4b dup 0/1 9 and over 6 2/s 0/1 a and +or swap 11 2/s 0/1 c and +or 8 or ;
pix dup @w d @ 2* u+ 4b ;
row 1, dup w @ 2/ dup 1 + dup 2, - 2, 0 dup 1, +adl for pix 16 * push pix pop or dup 1, +adl next drop +mod d @ 1024 2 * * + ;
deflate 178 2, 1 0 adl! h @ -1 + for 0 row next 1 row drop ad2 @ *byte 2, ad1 @ *byte 2, here over 4 + negate + *bys over -4 + !b ;

crc macro
2/s ?lit e8c1 2, 1, ;
1@ 8a 2, ; forth ad1 48546 ad2 48600
array -a pop 2 2/s ;
bit n-n 1 ? if 1 2/s edb88320 or ; then 1 2/s ;
fill nn for dup 8 for bit next , 1 + next drop ;
table -a align array 0 256 fill
crc an-n -1 swap for over 1@ over or ff and table + @ swap 8 2/s or 1 u+ next - nip ;
+adl n ff and ad1 @ + dup ad2 @ +
adl! ad2 ! ad1 ! ;
+mod ad1 @ 65521 mod ad2 @ 65521 mod adl! ;

dos file
blks 256 * ;
w/c 18 blks ;
buffer 604 block ;
size -a buffer 0 1 reads buffer 98f + ;
set n ! buffer 0 1 writes ;
cyls n-nn 1 swap w/c -1 + + w/c / ;
put an dup 2* 2* size set cyls writes stop ;
get a size @ 3 + 2/ 2/ cyls reads stop ;
.com 0 63 blocks put ;

blks n-n size in blocks to words
w/c -n words per cylinder
buffer -a 1 cylinder required for floppy dma
size -a locate size of 2nd file. floppy has first filler then file allocated. filler is 2048 bytes, to fill out cylinder 0. names at most 8 letters, all caps. directory starts at buffer 980 +
set n size. file must be larger than your file.
cyls n-nn starting cylinder 1 and number of cylinders
put an write file from address
get a read file to address

north bridge empty macro
4@ dup ed 1, ;
4! ef 1, drop ; forth dev 15104
nb 0 dev ! ;
sb 3800 dev ! ;
agp 800 dev ! ;
ess 6800 dev ! ;
ric 7800 dev ! ;
win 8000 dev ! ;
ati 10000 dev ! ;
add cf8 a! 4! cfc a! ;
q 80000000 + add 4@ ;
en 8004 q -4 and or 4! ;
dv dup 800 * q swap 1 + ;
regs dev @ 19 4 * + 20 for dup q h. space dup h. cr -4 + next drop ;
devs 0 33 for dup q dup 1 + drop if dup h. space drop dup 8 + q dup h. space over h. cr then drop 800 + next drop ;
ok show black screen text regs keyboard ;
u 40 dev +! ;
d -64 dev +! ;
test ff00 + a! 4@ ; ok

ascii macro
1@ 8a 2, ; forth
string pop ;
cf-ii string 6f747200 , 696e6165 , 79636d73 , 7766676c , 62707664 , 71757868 , 336a7a6b , 37363534 , 2d313938 , 2f322e30 , 2b213a3b , 3f2c2a40 ,
ch fffffff0 and unpack cf-ii + 1@ ff and ;
ii-cf string 2a00 , 0 , 2b2d0000 , 2725232e , 1b262224 , 1f1e1d1c , 28292120 , 2f000000 , 3a43355c , 3d3e3440 , 484a3744 , 3336393c , 38314742 , 3f414632 , 493b45 , 0 , a13052c , d0e0410 , 181a0714 , 306090c , 8011712 , f111602 , 190b15 ,
chc ffffffe0 + ii-cf + 1@ ff and ;

clock macro
p@ ec 1, ;
p! ee 1, drop ; forth
ca 70 a! p! 71 a! ;
c@ ca 0 p@ ;
c! ca p! ;
hi 10 c@ 80 and drop if ; then hi ;
lo 0 p@ 80 and drop if lo ; then ;
bcd c@ 16 /mod 10 * + ;
hms0 4 bcd 100 * 2 bcd + 100 * 0 bcd + ;
hms hms0 2 ms dup hms0 or drop if drop hms ; then ;
ymd 9 bcd 100 * 8 bcd + 100 * 7 bcd + ;
day 6 c@ -1 + ;
cal hi lo time - hi lo time + 748 ;

lan empty 3f8 54 load init
no block 4 * 1024 ;
send no for dup 1@ xmit 1 + next drop ;
receive no for rcv over 1! 1 + next drop ;
no 18 7 18 * ;
backup no for dup send 1 + next drop ;
accept no for dup receive 1 + next drop ;

sr 4210752 4210752 4210752

serial 3f8 2e8 1050 macro
p@ a! dup ec 1, ;
p! a! ee 1, drop ;
1@ 8a 2, ;
1! a! 288 2, drop ; forth
r 0 + + ;
9600 12 ;
115200 1 ;
b/s 83 3 r p! 9600 0 r p! 0 1 r p! 3 3 r p! ;
init b/s 16550 1 2 r p! 0 4 r p! ;
xmit n 5 r p@ 20 and drop if 0 r p! ; then pause xmit ;
cts 6 r p@ 30 and 30 or drop if cts ; then xmit ;
st 6 r p@
xbits 30 and 10 / dup 1 and 2* 2* + 2/ ;
st! 4 r p! ;
?rcv 5 r p@ 1 and drop if 0 r p@ then ;
rcv ?rcv if ; then pause rcv ;

p@ p-n fetch byte from port
p! np store byte to port
1@ a-n fetch byte from byte address
1! na store byte to byte address
r n-p convert relative to absolute port address. base port on stack at compile time. compiled as literal at yellow-green transition
9600
115200 baud-rate divisors. these are names, not numbers
b/s set baud rate. edit to change
init initialize uart
xmit n wait for ready and transmit byte
cts n wait for clear-to-send then xmit
st -n fetch status byte
xbits n-n exchange status bits
st! n store control byte
?rcv fetch byte if ready. set flag to be tested by if
rcv -n wait for ready and fetch byte

hexagon empt col 4227200 del 4210752
lin dup 2/ 2/ dup 2* line ;
hex xy @ 7 and over 2/ for lin 7 + next over for lin next swap 2/ for -7 + lin next drop ;
+del del @ nop
petal and col @ + f8f8f8 and color 100 hex ;
-del del @ f8f8f8 or 80808 + ;
rose 0 +del -176 -200 +at f80000 -del petal 352 -200 +at f80000 +del -264 -349 +at f800 -del petal 176 -200 +at f8 +del -176 98 +at f8 -del petal 176 -200 +at f800 +del ;
ok show black screen 512 282 at rose text col @ h. space del @ ff and . keyboard ; 58 load ok h

draws 7 hexagons. colors differ along red, green and blue axes.
col color of center hexagon
del color difference
lin n draws 1 horizontal line of a hexagon
hex n draws top, center and bottom. slope 7 x to 4 y is 1.750 compared to 1.732
+del n increment color
-del n
petal n draw colored hexagon
rose draw 7 hexagons
ok describe screen. center color at top

pan
in del @ 2* 404040 min del ! ;
out del @ 2/ 80808 max del ! ;
r f80000
+del del @
+col and col @ + f8f8f8 and col ! ;
g f800 +del ;
b f8 +del ;
-r f80000 -del +col ;
-g f800 -del +col ;
-b f8 -del +col ;
nul ;
h pad nul nul accept nul -r -g -b nul r g b nul out nul nul in nul nul nul nul nul nul nul nul nul nul nul nul 250000 , 130d01 dup , , 2b000023 , 0 , 0 , 0 ,

in increment color difference
out decrement it
r
g
b increment center color
-r
-g
-b decrement it
+del redefine with ;
+col change center color
nul ignore
h describe keypad

timing empty macro
out e1e6 2, ; forth
tare time - 1000 for next time + ;
tare+ time - push 1000 for dup next c pop time + ;
test tare time + - 1000 for out next time + ; next 3 loop 5.7 /next 2 /swap 25 swap 7.2 macro
c! c88b 2, drop here ;
loop 49 1, 75 1, e2 here - + 1, ; forth
try time - 1000 c! loop time + ;

debug type dump 80 load macro
bswap c80f 2, ; forth x 17984
4al a- 4 for dup @b 7f and dup -32 + drop -if drop 2e then chc emit 1+ next drop ;
8alpha 4 * dup 4al 35 emit 4 + 4al ;
two a- dup @ bswap h. 35 emit 1+ @ bswap h. ;
one a-a dup 4 * 7 h.n 46 emit dup 256 / . space dup two space dup 8alpha 1+ 1+ cr ;
lines for one next drop ;
dump x !
r show black screen x @ 16 text lines keyboard ;
u -32 x +! ;
d 32 x +! ;

extend system 74 load macros 76 load fixes 88 load stack
rtc 82 load ;
utils 84 load copy ;
circles 86 load ;
rand 90 load random ;
lines 92 load ;
htm 102 load html ;

added macros macro
?f c021 2, ;
0if 75 2, here ;
+if 78 2, here ;
1+ 40 1, ;
1- 48 1, ;
@b 8a 2, ;
@w 8b66 3, ;
@l 8b 2, ;
!b a! 288 2, drop ;
!w a! 28966 3, drop ;
!l a! 289 2, drop ; forth

added macros
?f set flags to reflect tos
0if jnz aids in clarity
+if js, this complements the set
1+ increment tos
1- decrement tos
@b fetch byte from absolute addr.
@w fetch word from absolute addr.
@l fetch long from absolute addr.
!b store byte in absolute addr.
!w store word in absolute addr.
!l store long in absolute addr.

corrections
h sp 20 + ;
oadf qwerty
save h @ 100000 h ! 0 dup nc @ writes stop h ! ;

corrections
h -a address of dict pointer, see here also
oadf
save changed this to keep the dictionairy in the same area.

new logo
.co 1 3 c 3 a 5* ;
.fo 14 2 1 3 3e 5* ;
cf 27 dup at silver .co .fo 25 dup at red .co green .fo ;
logo show black screen text cf keyboard ;
empty empt logo ; mark
grads 0 128 for i 2* 1- color dup 10 at 5 + dup 120 box next -400 + 128 for 257 i 2* negate + dup 256 * + color dup 10 at 5 + dup 100 box next drop ; circles lines 106 load 94 load
lnes framed 20 for i 2* 40 + 250 584 ff07 circle next filled 30 250 584 f800 circle framed ffff pen ! art 620 120 at 1020 300 frame 5 120 at 405 300 frame ;
logo black screen grads lnes text cf show dotty fillit ckb keyboard ;
empty empt logo ;

new logo
logo defined twice. first empty shows the fancy logo second entered empty shows the plain one. this unloads circles and lines. purely to prevent name space crowding.

ascii
cf-ii addr 6f747200 , 696e6165 , 79636d73 , 7766676c , 62707664 , 71757868 , 33323130 , 37363534 , 2d6a3938 , 2f7a2e6b , 2b213a3b , 3f2c2a40 ,
ch fffffff0 and unpack cf-ii + @b ff and ;
ii-cf addr 2a00 , 0 , 2b2d0000 , 2725232e , 1b1a1918 , 1f1e1d1c , 28292120 , 2f000000 , 3a43352c , 3d3e3440 , 54523744 , 3336393c , 38314742 , 3f414632 , 563b45 , 0 , a130500 , d0e0410 , 24220714 , 306090c , 8011712 , f111602 , 260b15 ,
chc ffffffe0 + ii-cf + @b ff and ;

ascii corrections to
cf-ii and
ii-cf regarding the decimals and the letters k j z

rtc macro
p@ ec 1, ;
p! ee 1, drop ; forth
rtca 70 a! p! 71 a! ;
rtc@ rtca 0 p@ ;
rtc! rtca p! ;
hi 10 rtc@ 80 and drop 0if hi ; then ;
lo 10 rtc@ 80 and drop if lo ; then ;
bcd rtc@ 16 /mod 10 * + ;
hms lo 4 bcd 100 * 2 bcd + 100 * 0 bcd + ;
ymd lo 9 bcd 100 * 8 bcd + 100 * 7 bcd + ;
day lo 6 rtc@ 1- ;
cal hi lo time - hi lo time + ;

rtc real time clock
p@ -n compile: in al,dx
p! n- compile: out dx,al
rtca reg- set up rtc for acces to register
rtc@ reg-n fetch reg from rtc
rtc! n reg- store in rtc register
hi wait till update in progress bit is high
lo wait till uip bit is low
bcd bcd-n bcd to binary
hms -n hours+mins+secs
ymd -n year+month+day
day -n day of the week
cal -n number of cpu clocks per second

utils
copy sf st e7c1f88b , 368b560a , b90ae6c1 , 100 , ad5ea5f3 , c3ad 2,
rcopy sf sl st push dup push swap negate + pop swap pop over + swap for over over copy push 1- pop 1- -next drop drop ;

utils
copy from to- copy from to block numbers. unlike orig copy; no change to blk
rcopy first last to- multiple block copy routine

circles c-cd -8 c-ff 1
point4 4096 * swap 4 * 2dup + 2/ negate bs @ + pen @ over !w over push + pen @ over !w + pen @ over !w pop negate + pen @ swap !w ;
opnts 2dup point4 2dup swap point4 ;
d? c-cd @ ?f drop -if ; then dup - c-cd +! 1- 1 c-ff ! ;
cfl 1+ 1+ push pen @ swap pop 2/ for over over !w 1+ 1+ next drop drop ;
cfl4 4096 * swap 4 * 2dup + 2/ negate bs @ + swap 2dup cfl push + pop cfl ;
fvrt ?f drop if cfl4 0 c-ff ! ; then point4 ;
fpnts 2dup c-ff @ fvrt 2dup swap cfl4 ;
points opnts ;
pntst addr points opnts fpnts ;
framed pntst 1 select ;
filled pntst 2 select ;
circle 0 c-ff ! pen ! 1024 * + 2* vframe + bs ! 0 swap dup negate c-cd !
crcl less if points 1 u+ over c-cd +! d? crcl ; then points drop drop ;

circles
point4 .. all other words are internal.
points acts like a deferred word.
pntst table of calls to different point routines. select alters points
framed set circle to draw outlined circles.
filled set circle to draw filled circles.
circle rxyc- draw circle with radius r center xy in color c

stack juggling + misc.
addr pop ;
rot 8b045e8b , 46e892e , c38b0689 , c3 1,
-rot 8b045e8b , 446892e , c58b1e89 , c3 1,
tuck swap over ;
2swap 87085e8b , 85e891e , c3044687 ,
2over 89f8768d , 5e8b0446 , 8b1e8910 , c30c46 3,
2dup over over ;
v- push - 1+ u+ pop - 1+ + ;
vn push rot less if rot pop -rot ; then -rot pop ;
vframe 1e80000 ; pen 65535 bs 32461510
vloc 2048 * over + + vframe + ;
point vloc pen @ swap !w ;
at? xy @ 10000 /mod swap ;
@r 1+ dup 4 u+ @l + ;
!r 1+ dup push negate -4 + + pop !l ;
select 5 * over + @r swap @r !r ;
ckb black 0 740 at 1024 768 box 800 650 at 1023 740 box ;

stack juggling words. small and fast.
addr -a absolute address
rot abc-bca stack pictures are best ..
-rot abc-cab ..described with letters, in
tuck ab-bab ..this case.
2swap abxy-xyab
2over abxy-abxyab
2dup ab-abab
v- v1v2 - v1-v2 vector subtract.
vn vv-vv sort vectors so x1 is less x2
vframe -addr address of screen.
pen -addr current color.
bs -addr base for elements
vloc xy-a convert xy into addr.
point xy- set point at xy to current pen.
at? -xy return current screen location.
@r a-a get absolute addr from jump/call
!r aa- set jump/call to absolute addr.
select an- select call n from table a. store it in table call 0

random rsav 2107951961 rseed -526774649
rand time rsav ! e09a0e87 rseed ! ;
ror d3adc88b , c3c8 2,
random push rseed @ 0 32 for 2* swap 2* swap -if rsav @ or then next nip 15 ror dup rsav ! abs pop mod ; rand

random
rand - set random variables
ror nm-n rotate n m times right
random n-0..n-1 return a random number range 0..n-1 limited to a 16 bit number.

lines ax -1068 ay 0 sx 2048 sy 2 lbase 32014376 macro
lp 8b02e2c1 , c88bade8 , 205a8bad , 232b8966 , 30578c0 , 185a0302 , 3084203 , ece2105a , ; forth
!base 2048 * over + + vframe + lbase ! ;
bline abs 2* dup ay ! over 2* negate ax ! over negate + swap 1+ pen @ ax a! lp drop ;
?xd 2over 2over v- abs swap abs swap less drop drop -1 if 1+ then ?f drop ;
!sy push ?f pop -if negate then sy ! bline ;
xdom 2swap !base 2 sx ! 2048 !sy ;
ydom swap 2swap swap !base swap 2048 sx ! 2 !sy ;
aline ?xd if vn 2over v- xdom ; then push push swap pop pop swap vn 2over v- ydom ;
line at? 2over aline at ;
frame at? 2over drop over line 2over line 2swap push drop over pop line line ;

line drawing do not mess with variables. they are indexed by lp.
lp macro inner loop for speed. draws point and moves location.
!base x y -- set base address
bline dx dy -- draw a line using bresenham x dominant
?xd v1 v2 -- v1 v2 set flag if line is x-dominant
!sy dy n -- dy store n in sy set sign to match sign of dy
xdom x y dx dy draw an x-dominant line
ydom x y dx dy draw a y-dominant line
aline v1 v2 draw any straight line
line x y draw line from current at to xy. moves at to given xy.
frame xy- trace outline of rectangle with corners at and xy. pen position is not altered.

demos
xlate 384 + 512 u+ ;
xat xlate at ;
xline xlate line ;
4lines over 0 xat 0 over xline over - 1+ 0 xline - 1+ 0 swap xline 0 xline ;
art 70 for 71 i - 1+ + 5 * i 5 * 4lines next ; rand
radius 8 ;
lrc push dup dup + negate pop + random + ;
shade 2over 1+ 1+ 2over drop 1+ 1+ 1+ 0 circle circle ;
dotty filled 100 for radius random dup 397 lrc 621 + over 176 lrc 121 + ffff random shade next ;
blbx black 6 121 at 404 299 box ; xyzz -177
fillit -1 xyzz +! xyzz @ 200 + drop -if blbx 0 xyzz ! then framed 3 for 8 random 2 + dup 398 lrc 6 + over 178 lrc 121 + ffff circle next 6 210 fff0 random afill ;

html0 80 load h-dd 0 ppt 8 macro
2/s ?lit e8c1 2, 1, ; forth
temit h-dd @ !b 1 h-dd +! ;
tspc 20 temit ;
.dc ?f 1 -if - then swap abs
dcl 10 /mod swap 30 + push ?f 0if drop ?f drop -if 2d temit then pop temit ; then dcl pop temit nop ;
.hx 39 over 15 and 30 + less nip if 27 + then push 4 2/s 0if drop pop temit ; then .hx pop temit nop ;
strt dup @b ff and if temit 1+ strt ; then drop drop ;
str: pop strt ;
header str: 6d74683c , 3c0a3e6c , 6b6e696c , 6c657220 , 7974733d , 6873656c , 20746565 , 65707974 , 6574223d , 632f7478 , 20227373 , 66657268 , 3d 1, 6c6f6322 , 6f66726f , 2e687472 , 22737363 , 703c0a3e , a3e 3,
trailer str: 74682f3c , a3e6c6d , 0 1,

html0. block 80 has ascii conversion tables.
h-dd data destination. ppt pre- parsed type.
2/s macro, right shift by n.
temit c- emit char to target.
tspc emit space
.dc n- signed decimal print. recursive!
dcl dec print loop.
.hx n- unsigned hex print. also recursive. both routines have no leading zeroes.
strt a- print bytes from address until first null byte.
str: output what follows up to null byte.
header lay down html header to display blocks. the header is very minimal. it expects colorforth.css in the same directory.
trailer closing html stuff.

html1
.code 1- drop -if ; then str: 6f632f3c , 3e6564 ,
.all str: 646f633c , 6c632065 , 3d737361 , 0 1,
same? ppt @ over ppt ! swap over - 1+ + drop ;
comn same? 0if drop tspc pop drop ; then .code .all ;
.def str: 3e666564 , 20 2,
.com 2 comn str: 3e6d6f63 , 20 2,
.chx 3 comn str: 3e786863 , 20 2,
.exe 4 comn str: 3e657865 , 20 2,
.xhx 5 comn str: 3e786878 , 20 2,
.cpm 6 comn str: 3e6d7063 , 20 2,
.var 7 comn str: 3e726176 , 20 2,
.txt 8 comn str: 3e747874 , 20 2,
.txc 9 comn str: 3e637874 , 20 2,
.tac 10 comn str: 3e636174 , 20 2,

html1
.code n- output /code in brackets if n is larger then 0.
.all common part to start a new code tag.
same? n-o set ppt to the new type. return the old type with flags set from comparison.
comn n- if this is a new tag, close prev tag and print common part. if not: print space and exit caller
.def each of these words correspond to a
.com .. code tag as defined in colorforth.css
.chx .. the numbers are positional, and bare
.exe .. no correspondence to the pre parsed
.xhx .. types. they will output if a change
.cpm .. in tag is required. comn will exit
.var .. by doing a pop-drop if the tag is the
.txt .. same.
.txc
.tac

html2
.str ch if temit .str ; then drop drop ;
bs1 0 ppt ! str: 3e72683c , 6c627b0a , 206b636f , 0 1,
bs2 str: 643c0a7d , 63207669 , 7373616c , 786f623d , a3e 3,
bend ppt @ .code str: 69642f3c , a3e76 ,
.br 1- drop -if ; then str: 3e72623c , a 2,
pp0 .str ;
pp1 .exe .str ;
pp3 ppt @ dup .code .br 1 ppt ! .all .def .str ;
pp4 .com .str ;
pp7 .cpm .str ;
pp9 .txt .str ;
ppa .txc .str ;
ppb .tac .str ;
ppc .var .str 1+ dup @ .com .dc ;

html2
.str n- unpack n and print as ascii.
bs1 clear the type and print html stuff for the start of a block.
bs2 second half of block header.
bend block end html stuff.
.br n- html line break, if n larger then 0
pp0 the preparsed words in a block are
pp1 .. printed by the ppn words. eg pp0 is
pp3 .. word continuation pp1 is for executed
pp4 .. words, etc. they unpack and print.
pp7 .. they also print html tags.
pp9
ppa
ppb
ppc

html3 96 load 98 load 100 load
dbn push 1+ dup @ pop ?f drop ;
sln dup 2/ 2/ 2/ 2/ 2/ swap 16 and drop ;
xnb if .xhx .hx ; then .exe .dc ;
cnb if .chx .hx ; then .com .dc ;
pp2 dbn xnb ;
pp5 dbn cnb ;
pp6 sln cnb ;
pp8 sln xnb ;
ppdo jump pp0 pp1 pp2 pp3 pp4 pp5 pp6 pp7 pp8 pp9 ppa ppb ppc ;
index dup 15 and dup push or pop ;
dblk dup bs1 .dc bs2 block begin dup @ ?f 0if drop drop bend ; then index ppdo 1+ end
hbuf 2000 block ;
html hbuf 4 * h-dd ! header swap over for over i - 1+ + over + dblk next drop drop trailer hbuf h-dd @ 3 + 4 / over - 1+ + 3 for tspc next ;

html3
dbn an-an fetch next word. set hex flag.
sln n-n make full word and set hex flag.
xnb n- print n as hex/dec executed number.
cnb n- print n as hex/dec compiled number.
pp2 an-a a double executed number.
pp5 an-a a double compiled number.
pp6 n- a single compiled number.
pp8 n- a single executed number.
ppdo table of words. the index is the pre- parsed type type.
index n-ni extract index from n.
dblk b- print block b in html.
hbuf -a start of buffer.
html bn-al output n blocks starting with block b in html. leaves addr and length on the stack, so it can be saved using file put on a floppy.

simpler and slower bresenham line drawing. for reference. ax -360 ay 0 sy 2 sw 0
bpoint push 2dup sw @ ?f drop if swap then point pop ;
bline abs 2* dup ay ! over 2* negate ax ! over negate + swap 1+ for bpoint ?f +if sy @ u+ ax @ + then ay @ + push 1 u+ pop next drop drop drop ;
?xd 2over 2over v- abs swap abs swap less drop drop -1 if 1+ then ?f drop ;
!sy push ?f pop -if negate then sy ! bline ;
xdom 0 sw ! 1 !sy ;
ydom 1 sw ! 1 !sy ;
aline ?xd if vn 2over v- xdom ; then push push swap pop pop swap vn 2over v- ydom ;

area filling 108 load tfc 22461 fc 24071
pset dup dup @w ffff and tfc @ negate + drop if drop 0 ; then fc @ swap !w 0 1+ ;
bcup dup 2047 and 2- begin -if drop ; then push 2- pset drop pop if 2- *end then drop 2+ ;
ispan pset if ; then push enstak pop ;
xgr dup negate 3 pick + drop ;
nispan dlrlx xgr -if 5drop pop pop pop drop drop drop ; then pset if push nip dup pop then ;
dosp dlrlx jump nispan ispan dlrlxi ;
sha2 over rtre begin dlrlxic -if drop ; then push dosp 2 u+ pop 2- end
sha1 dlr over pset over dlrxil if bcup dlrxil then swap push swap 2+ pop dlrlxi sha2 ?f drop if enstak then 5drop ;
sha begin fst? if fpop sha1 *end then ;
fsln dup bcup swap dup rtre begin -if drop ; then push pset drop if 2+ pop 2- *end then pop drop 2- ;
afill fstini fc ! vloc dup @w ffff and tfc ! fsln over over -2048 u+ -2048 + -2048 -rot fpsh 2048 u+ 2048 + 2048 -rot fpsh sha ;

area filling
pset a-0/1 set pixel at a, if pixel equals tfc. return 0 if not, 1 if pixel was set.
bcup a-a adjust a until left edge is found. limited to screen edge.
ispan stack if the right edge is found.
xgr set neg flag if x is greater then parent-r
nispan exit if beyond right edge of span, else start a new span.
dosp dlrlx - dlrlxi jump table.
sha2 let x go over each pixel and set it or start/end new spans.
sha1 starting at left edge, find the new left edge and init x to next pixel. stack if run into right screen edge while in span.
sha pop the next span and color it.
fsln a-lr starting at screen address a, find the left edge and right edge of the seed line. color it in the process.
afill xyc starting with screen location xy, and color c, fill the color found there with c until the color found changes.

fillstack fstak 369818 fstakn 0
fstini here 2/ 2/ 1024 + fstak ! 0 fstakn ! ;
fpop fstak @ 3 for dup @ swap 1- next fstak ! -3 fstakn +! ;
fpsh 3 for 1 fstak +! fstak @ ! next 3 fstakn +! ;
fst? fstakn @ ?f drop ; fstini macro
pick 86048b 3, ;
2- 1- 1- ;
2+ 1+ 1+ ; forth
5drop drop drop drop drop drop ;
rtre 2047 and negate 2048 + ;
enstak dlrlr - dlrlr 2- 4 pick dup 3 pick + over 3 pick + fpsh over 4 pick negate + 2+ drop -if 4 pick negate dup 3 pick + over 6 pick 2- + fpsh then 2 pick over negate + drop -if 4 pick negate dup 4 pick 2+ + over 3 pick + fpsh then 2+ ;

fillstack: stack of spans to fill.
fstini initialize
fpop pop the next element from the stack
fpsh push element on the stack
fst? set 0 flag if emtpy.
pick copy n from the stack.
2- screen pixels are 2 bytes.
2+
5drop unload forth stack.
rtre a-n return remaining to right screen edge.
enstak dlrlr-dlrlr push a span or element onto the stack. also push a left hand direction reversal and a right hand reversal if needed.

110 term lines macro
2/s ?lit e8c1 2, 1, ; forth
@w @w ffff and ;
ivrom 22 2 * * 156 block 4 * + ;
allot align nop here push for 0 , next pop ; 4000 2 * 4 / allot
cbuf white ; 5 allot 4 / dup
tecd white ; 1 + dup
tecp white ; 1 + dup
bpen white ; 1 + dup
tmode white ; 1 +
escmd white ;
telofs 24 ;
tetofs 20 ;
cwipe at? 12 u+ 22 + black bpen @ ?f drop if white then box ;
bit12 @w 12 for 8000 ? if over pen @ swap !w then 2* 2 u+ next drop ;
22lin rs 22 for over i negate 22 + 2* + bit12 2048 -12 2 * + + next drop drop ;
ten c cwipe ivrom at? vloc 22lin
space 12 0 +at ;
sfgbg pen @ bpen @ pen ! bpen ! ;

111 term
2/s n shift tos n times right.
@w a-n absolute 16bit fetch. masked.
ivrom c-a index into virtual rom
allot n-a allot n 32b words, leaves byte addr.
cbuf constant addr of double buffer white is phoney. buffer is 16bit/char
tecd term emu cursor display location.
tecp cursor position.
bpen background color, used as a flag.
tmode mode, such as normal, inverse, bold etc
escmd flag for esc mode.
telofs term emu left offset
tetofs term emu top offset
cwipe erase char position to background.
bit12 one scan line of a char.
22lin rs display 22 lines from char rom addr r to screen addr s.
ten c display char c in pen color.
space advance screen loc one char.
sfgbg switch forground and background colors.

112 term
tei sfgbg ten sfgbg ;
teb dup push ivrom at? 1 u+ 1- vloc pop ten 22lin ;
teu push at? pop ten 20 + over 11 + over aline ;
teiu sfgbg teu sfgbg ;
temit cm jump ten tei teb teu teiu ten ten ten
?emit c if dup 7f and swap 8 2/s 7 and temit ; then drop space ;
newc? a-c dup @w swap push dup pop 4000 + over over @w or drop !w ;
1line n telofs over 22 * tetofs + at 80 2 * * cbuf + 80 for i negate 80 + 2* over + newc? ?emit next drop ;
c/l 80 ;
c/win c/l 24 * ;
curs* tecd @ c/l /mod push 12 * telofs + pop 22 * tetofs + 0 + ;
curln 2/ 2/ 6 for dup i negate 6 + + -1 over @ or swap ! next drop ;
cursr curs* vloc 18 for dup curln 2048 + next drop ;
cat? tecp @ c/l /mod swap ;
linum tecp @ c/l / ;
c+- n tecp @ + 0 max c/win -1 + min tecp ! ;
cat lc c/l -1 + min 0 max swap 23 min 0 max c/l * + tecp ! ;
caddr tecp @ 2* cbuf + ;

113
tei c display char c inverse color.
teb c display char c bold.
teu c display underlined char.
teiu c right. inverse underlined.
temit cm jump table into char display mode
?emit a display char at a if it was changed.
newc? a-c returns char c and sets flag if it was newly added.
1line n display one line of 80 chars. uses a double buffer to only update. buffer is 16b/char for mode info.
c/l 80 char per line
c/win 24 lines of 80 chars.
curs* -xy returns cursor diplay location.
curln a xors one line of the cursor on the screen.
cursr xors the screen info to display a cursor, or turn it off.
cat? -lc report cursor position.
linum -l return current linenumber.
c+- n add n to cursor position, wraps at edge.
cat lc direct cursor positioning.
caddr -a return cursor addr in buffer.

114 term
+mode c-n tmode @ 256 * or ;
ech 32
cbf! c +mode caddr !w ;
echs push 32 +mode caddr pop for over over !w 2 + next drop drop ;
after -n cat? nip - c/l + ;
eeol after 1+ echs ;
eeop 23 linum negate + 80 * after + 1+ echs ;
cr linum 0 cat ;
cuu cat? -1 u+ cat ;
cud cat? 1 u+ cat ;
cuf cat? 1+ cat ;
cub cat? 1- cat ;
cuh 0 tecp ! ;
epage cuh c/win echs ;
lsadr n-a c/l 2 * * cbuf + 2/ 2/ ;
lcopy ft push lsadr pop lsadr c/l 2/ for over @ over ! 1 u+ 1+ next drop drop ;
scrup linum dup for i negate over + dup 1+ swap lcopy next 0 cat eeol ;
scrdn linum dup negate 23 + for dup i + dup 1- swap lcopy next 0 cat eeol ;
cri linum ?f drop if cuu ; then cat? nip scrdn c+- ;

115
+mode c-n stick current mode in the high byte.
ech erase char at cursor, doesnt move cursor.
cbf! c put char c in char buffer.
echs n erase n char , as in ech.
after -n number of chars after cursor to right edge
eeol erase from cursor to eol without moving cursor.
eeop erase from cursor to end of display.
cr move to first column current line.
cuu cursor up one line.
cud cursor down one line.
cuf cursor fwd one char.
cub cursor back one char.
cuh home cursor.
epage moves to home and erase display.
lsadr n-a return cf addr of line n
lcopy ft copy line f to line t.
scrup scroll up from current line, erase current line .
scrdn scroll down.
cri same as cuu but scroll at the top.

116 term 110 load 112 load 114 load
dca 2 escmd ! ;
dca1 -32 + 4 escmd ! ;
dca2 -32 + 0 escmd ! cat ;
tab cat? dup 8 mod negate 8 + + cat ;
linef linum 1+ dup 0 cat -24 + drop -if ; then scrup ;
doctl jump cub tab linef linef linef cr
esc? c- dup 27 or drop if ; then drop escmd @ 1 or escmd ! pop drop ;
cntrl -8 + -if drop ; then dup negate d -8 + + drop -if drop ; then doctl ;
noesc dup -32 + drop -if cntrl ; then dup negate 126 + drop -if drop ; then cbf! 1 c+- ;
nul ;
doesc c jump cuu cud cuf cub epage nul nul cuh cri eeop eeol nul nul nul nul nul nul nul nul nul nul nul nul nul dca nul
inesc escmd @ 1 or escmd ! 90 min -65 + -if drop ; then doesc ;
aemit esc? escmd @ 7 and jump noesc inesc dca1 nul dca2 nul nul nul
trfr telofs -4 + tetofs -4 + at telofs 80 12 * + 4 + tetofs 22 24 * + 2 + frame ;
trmini black screen ffff pen ! trfr tecp @ tecd ! cursr ;
term cursr 24 for i negate 24 + 1line next tecp @ tecd ! cursr ckb ;

117 term
dca direct cursor addressing.
dca1 first dca parameter.
dca2 second dca parameter.
tab tab to next 8 char stop.
linef goto next line left margin, scroll if required.
doctl jump table for control chars.
esc? c handle esc char.
cntrl c handle control chars. cr returns to col 0. lf to next line col 0.
noesc c normal mode char processing. control char are handled del is ignored and dropped.
nul nothing.
doesc c jump table for esc mode chars. only char a to z are used. most are currently mapped to nul.
inesc esc mode char processing.
aemit c depending on esc mode process chars.
trfr draws frame around terminal.
trmini erase screen and draw term window frame.
term the interface word. use like in: :dada trmini show app term keyboard ; where app is the application.

cfvtlp empty shft 0 0 shft ! eflag 1 0 eflag ! rbuf 1487188 prb 1487264 dbuf 1487264 ncrs 24 ft 1 0 ft !
cmlogo logo ;
cmempty empty ;
extend 72 load ;
termtest 116 load ;
interrupt 142 load ;
com1 3f8 150 load ;
ascii 152 load ;
displaybuf 134 load 132 load ;
rcvbuf 144 load ; extend termtest interrupt com1 init ascii displaybuf rcvbuf
recurse pause vtlp ?exit 1 ft ! recurse ;
nulscr show 1cls term pause ; nulscr recurse

lp mode display words
exit cli cmempty cmlogo accept ;
fexit cli warm ;
?exit eflag @ 1 and drop if exit ; then ;
1cls ft @ 1 and drop if ; then trmini ;
vtlp ?exit dbuf @ prb @ negate + drop -if @dbuf aemit +1dbuf vtlp ; then ;

vt52 emulation
@dbuf dbuf @ @b ff and ;
+1dbuf 1 dbuf +! ;
nul ;
escji addr 0 , 0 , 1020304 , 0 , 0 , 0 , 0 , 0 , 0 ,
esca cat? swap -1 + swap cat ;
escb cat? swap 1 + swap cat ;
escc 1 c+- ;
escd -1 c+- ;
do52 jump nul esca escb escc escd nul nul nul nul nul nul nul nul nul nul nul nul nul nul ;
?esc 1b negate + drop if ; then +1dbuf @dbuf +1dbuf 60 negate + escji + @b 7 and do52 ;

interrupts
idt 200 block ; macro
1ld n ?lit b9 1, , ;
p! na a! ee 1, drop ;
lidt b 18010f 3, drop ;
sti fb 1, ; enable interrupts somewhere
cli fa 1, ; add to empty!
2push 5250 2, ;
2pop 585a 2, ;
forth 2push be5651 3, idt 100 + a, ;
/forth 595e 2, 2pop ;
clear 20e620b0 , ;
8clear a0e620b0 , 20e6 2, ;
i; cf 1, ; forth
!idt a lidt ; here 3b7 2, idt a, !idt
interrupt n 2* idt + here ffff and 80000 + over ! here ffff0000 and 8e00 + swap 1 + ! ;
fill an for dup interrupt 1 + next drop ; 0 70 fill
ignore i; 20 8 fill
ignore 2push clear 2pop i; 28 8 fill
ignore 2push 8clear 2pop i; 0 interrupt
0div 7fffffff 1ld i;

idt -a table of 2-word interrupts. edit convenient block number
1ld n load register 1 with literal
lidt load interrupt table register from byte address on stack
sti enable device interrupts
cli disable them
2push save registers 0 and 2
2pop restore 2 and 0
forth save 1 and 6, load 6 as stack. interrupt may occur while its a source address
/forth restore 6 and 1
clear store 20 to port 20 to clear irq 0-7
8clear also 20 to port a0 to clear irq 8-f
i; return from interrupt - restore flags
!idt b execute lidt
interrupt n construct interrupt to here. avoid yellow-green literal with red comment
fill an n entries in default interrupt table
ignore clear the interrupt. doesnt clear the device
0div make divisor +infinity, quotient 0

timer interrupt
a, a, ; 140 load
empty cli empt ;
cli cli ;
sti sti ; macro
p@
picp@ 0 ec 1, ;
p!
picp! ee 1, drop ; forth
!pit 43 a! 34 p! 40 a! 0 p! 0 p! ; !pit
0pic1! 20 a! p! ;
0pic2! a0 a! p! ;
pic1! 21 a! p! ;
pic2! a1 a! p! ;
!pic cli init 11 dup 20 a! p! a0 a! p! irq 20 pic1! 28 pic2! master 4 pic1! slave 2 pic2! 8086 mode 1 dup pic1! pic2! mask irqs ff pic2! ed pic1! ; !pic t0 153176999
picst white 700 650 at 21 a! picp@ h. space a1 a! picp@ h. 700 675 at a 0pic1! 20 a! picp@ h. space a 0pic2! a0 a! picp@ h. 700 700 at b 0pic1! 20 a! picp@ h. space b 0pic2! a0 a! picp@ h. ; 20 interrupt
timer0 forth 1 t0 +! clear /forth i; sti

a, n-
empty interrupt save version
cli disable interrupts
sti enable interrupts
p@ -n fetch byte
p! n- store byte
!pit init timer0 w/ 18.2 hz
!pic init pic
timer0 interrupt subroutine

recieve buffer also loads keyboard driver cli
callot for 0 1, next 1 ;
mrbuf here rbuf ! ffff callot ; rbuf @ prb ! rbuf @ dbuf !
wiperb ffff for 0 rbuf @ i + !b next ;
+prb 1 prb +! ;
?rprb prb @ rbuf @ negate + ffff or drop if ; then wiperb rbuf @ dup prb ! dbuf ! ;
um 0 pic1! 0 pic2! ;
euart 5 r serp@ 1 and drop if 0 r serp@ ff and prb @ !b +prb ?rprb euart ; then ; 24 interrupt
guart forth euart clear /forth i; 148 load sti

keyboard scan codes data
addr pop ;
sc-ii addr 32311b00 , 36353433 , 30393837 , 9083d2d , 72657771 , 69757974 , 5d5b706f , 7361000d , 68676664 , 3b6c6b6a , 5c006027 , 7663787a , 2c6d6e62 , 2a2f2e , 20202020 ,
ssc-ii addr 40211b00 , 5e252423 , 29282a26 , 82b5f , 52455751 , 49555954 , 7d7b504f , 5341000d , 48474644 , 3a4c4b4a , 7c007e22 , 5643585a , 3c4d4e42 , 3f3e ,
csi-ii addr 1b00 , 1e000000 , 0 , 7f001f , 12051711 , 9151914 , 1d1b100f , 1301000a , 8070604 , c0b0a , 1c000000 , 1603181a , d0e02 ,
si sc-ii + @b ff and ;
ssi ssc-ii + @b ff and ;
csi csi-ii + @b ff and ;

keyboard driver 146 load macro
ior 60b binary ;
kbp@ ?lit e4 1, 1, ; forth
nul ;
kst 0 64 kbp@ ;
!shft shft ! ;
@shft shft @ ;
sshft @shft 1 ior !shft ;
rshft @shft fffffffe and !shft ;
sctrl @shft 2 ior !shft ;
rctrl @shft fffffffd and !shft ;
?shft dup dup 7f and ffffffd6 + drop if drop ; then 80 and drop if rshft ; then sshft 80 or ;
?ctrl dup dup 7f and ffffffe3 + drop if drop ; then 80 and drop if rctrl ; then sctrl 80 or ;
key kst 1 and 1 or drop if key ; then 0 60 kbp@ ;
seflag 1 eflag ! ;
?seflag @shft 3 or drop if ; then seflag ;
sendk @shft jump si ssi csi nul ;
mkey key ?seflag ?shft ?ctrl dup 80 and drop if drop ; then sendk 0 r serp! ; 21 interrupt
ikey forth mkey clear /forth i;

serial 3f8 2e8 altered for interrupt useage macro
serp@ a! dup ec 1, ;
serp! a! ee 1, drop ;
1@ 8a 2, ;
1! a! 288 2, drop ; forth
r 0 + + ;
110 1047 ;
300 384 ;
2400 48 ;
9600 12 ;
115200 1 ;
b/s 83 3 r serp! 115200 0 r serp! 3 3 r serp! ;
init 1 1 r serp! 8 4 r serp! b/s 16550 1 2 r serp! 2 2 r serp! c1 2 r serp! ;
xmit n 5 r serp@ 20 and drop if 0 r serp! ; then pause xmit ;
cts 6 r serp@ 30 and 30 or drop if cts ; then xmit ;
st 6 r serp@
xbits 30 and 10 / dup 1 and 2* 2* + 2/ ;
st! 4 r serp! ;
?rcv 5 r serp@ 1 and drop if 0 r serp@ then ;
rcv ?rcv if ; then rcv ;