tag:blogger.com,1999:blog-47571184467689199002024-03-14T08:39:05.645-07:00Retro ProgrammingJohn Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.comBlogger79125tag:blogger.com,1999:blog-4757118446768919900.post-66247640860385538432017-07-22T18:40:00.000-07:002017-07-22T18:42:02.256-07:0016-Bit Xorshift Pseudorandom Numbers in Z80 Assembly<p><strong>Xorshift</strong> is a simple, fast pseudorandom number generator developed by George Marsaglia. The generator combines three xorshift operations where a number is exclusive-ored with a shifted copy of itself:</p>
<pre><code>/* 16-bit xorshift PRNG */
unsigned xs = 1;
unsigned xorshift( )
{
xs ^= xs << 7;
xs ^= xs >> 9;
xs ^= xs << 8;
return xs;
}
</code></pre>
<p>There are 60 shift triplets with the maximum period 2<sup>16</sup>-1. Four triplets pass a series of lightweight randomness tests including randomly plotting various <i>n</i> × <i>n</i> matrices using the high bits, low bits, reversed bits, etc. These are: 6, 7, 13; 7, 9, 8; 7, 9, 13; 9, 7, 13.</p>
<p>7, 9, 8 is the most efficient when implemented in Z80, generating a number in 86 cycles. For comparison the example in C takes approx ~1200 cycles when compiled with HiSoft C v1.3.</p>
<pre><code>; 16-bit xorshift pseudorandom number generator
; 20 bytes, 86 cycles (excluding ret)
; returns hl = pseudorandom number
; corrupts a
xrnd:
ld hl,1 ; seed must not be 0
ld a,h
rra
ld a,l
rra
xor h
ld h,a
ld a,l
rra
ld a,h
rra
xor l
ld l,a
xor h
ld h,a
ld (xrnd+1),hl
ret
</code></pre>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEinbk0kzZRa_r5YsonhoaWQWBlhjNKKAb4MnL27jchIVsQQb_qJ3pIHQcISr6bpvyVxWwtmkoBa8L5Id04kClNGk7V_7kz229ijmB8llzegXwuI_Jyz4hBuj3PgBHwazfFFI7lbFK8pCV4/s1600/prng798.png" data-original-width="320" data-original-height="240" alt="z80 xorshift" /></span></div>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com5tag:blogger.com,1999:blog-4757118446768919900.post-52101811483285901192017-07-19T14:14:00.001-07:002017-07-22T18:43:22.154-07:00A Fast Z80 Integer Square Root<p>A project I'm working on needs a fast square root but I couldn't find anything suitable online. After implementing several versions of the bit-by-bit algorithm I discovered the following code is particularly efficient when unrolled:</p>
<pre><code>/* Return the square root of numb */
int isqrt( numb )
{
int root = 0, bit = 04000h;
while ( bit != 0 )
{
if ( numb >= root + bit )
{
numb = numb - root - bit;
root = root / 2 + bit;
}
else
root = root / 2;
bit = bit / 4;
}
return root;
}
</code></pre>
<br />
<h3>First Make It Work</h3>
<p>The looping version is small but clunky. It spends almost 400 t-states shifting bits. We'll be able to eliminate most of the shifting by hard-coding the bit positions when the loop is unrolled:</p>
<pre><code>; 16-bit integer square root
; 34 bytes, 1005-1101 cycles (average 1053)
; call with de = number to square root
; returns hl = square root
; corrupts bc, de
ld bc,08000h
ld h,c
ld l,c
sqrloop:
srl b
rr c
add hl,bc
ex de,hl
sbc hl,de
jr c,sqrbit
ex de,hl
add hl,bc
jr sqrfi
sqrbit:
add hl,de
ex de,hl
or a
sbc hl,bc
sqrfi:
srl h
rr l
srl b
rr c
jr nc,sqrloop
</code></pre>
<br />
<h3>Then Make It Work Faster</h3>
<p>First the loop is unrolled. The first 4 iterations are optimized to work on 8-bit values and bit positions are hard-coded. The first and last iteration are optimized as a special case, we work with the bitwise complement of the root instead of the root and small jumps are replace with overlapping code. The final code finds the root in an average of 362 t-states:</p>
<pre><code>; fast 16-bit integer square root
; 92 bytes, 344-379 cycles (average 362)
; v2 - 3 t-state optimization spotted by Russ McNulty
; call with hl = number to square root
; returns a = square root
; corrupts hl, de
ld a,h
ld de,0B0C0h
add a,e
jr c,sq7
ld a,h
ld d,0F0h
sq7:
; ----------
add a,d
jr nc,sq6
res 5,d
db 254
sq6:
sub d
sra d
; ----------
set 2,d
add a,d
jr nc,sq5
res 3,d
db 254
sq5:
sub d
sra d
; ----------
inc d
add a,d
jr nc,sq4
res 1,d
db 254
sq4:
sub d
sra d
ld h,a
; ----------
add hl,de
jr nc,sq3
ld e,040h
db 210
sq3:
sbc hl,de
sra d
ld a,e
rra
; ----------
or 010h
ld e,a
add hl,de
jr nc,sq2
and 0DFh
db 218
sq2:
sbc hl,de
sra d
rra
; ----------
or 04h
ld e,a
add hl,de
jr nc,sq1
and 0F7h
db 218
sq1:
sbc hl,de
sra d
rra
; ----------
inc a
ld e,a
add hl,de
jr nc,sq0
and 0FDh
sq0:
sra d
rra
cpl
</code></pre>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com3tag:blogger.com,1999:blog-4757118446768919900.post-22827253085783429182017-05-20T05:45:00.000-07:002017-06-27T23:36:56.743-07:00ZX Spectrum BASIC ChallengesRecently I've entered a few of the programming challenges in the <a href="https://www.facebook.com/groups/ZXBasic/">BASIC on the ZX Spectrum</a> group on Facebook. They vary in difficultly but it's possible to write a program for most in under 30 minutes. If you're looking for a quick challenge or the opportunity to improve you BASIC, why not take a look.<br />
<br />
Here are some examples of the challenges:<br />
<br />
<h3>
Japanese Pattern</h3>
Uwe Geiken asked us to recreate an intricate Japanese pattern. By mirroring, rotating and repeating a 4 line candy cane shape I squeezed this into 156 bytes.<br />
<br />
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgweH1tJ5Phnf8XmWHhmdBdX3HLzikDn3IBdFqM3SxmVltNtt4_uztjNurbpxTYfZds1RDVNr6IeMKeb8uBgBKh8rNk7MTtn93GA6ltzgsf1h2-NPO_EcJibh3GkGYpdX036TaIQMesUd4/s1600/japx156.png" data-original-width="320" data-original-height="240" /></span></div>
<br />
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhBRwnCpBNf6WCFnkT1axj4UbtSO20Hs97VPkw2EwSLkrGCU_ZswEn3QrFcl2q1J-zVkeDXLvVV7oJxbL3ZRUcYoWDTd6QaWLhwAc03aFZVf6iYo0IMI1fO3Ofmh6vqJ84mcheplo8l0ow/s1600/JAPCODE156.PNG" data-original-width="320" data-original-height="240" /></span></div>
<br />
<h3>
Earth/Venus Orbits</h3>
David Saphier challenged us to write the fastest code to display the Earth and Venus orbit pattern in BASIC. Being a bit of a rebel I aimed to write the shortest code and managed to completely botch it before coming up with this working version:<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjn9trj-lglRFFnNVlOEjwkKy2XxrHo_bjt3r68G2RC8gpkSXJsa0HXbg3y4IghHVd_ru9ley4ZERRo39uKfp28Hxv9GQUPnEIXXXSsqWCdYDtHwLwOZnjMS96TmppFz2yboBHbujWP9vw/s1600/ve81.png" /></span></div>
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjJczUUFX1i3DCWaeVBtk-xZvfexwYILPeH0r6DtUo0pZdjEOiRxAhPYZUgFfeado38KxmhFXcjt4MqJwoPG6pJotZwJFpdPd4rm7bQa_UWRMD7Tv7pDbBoXmfV17DxZsogfvn6K2392TM/s1600/vecode.png" /></span></div>
<br />
<h3>
Greenlandic Flag</h3>
Matthew Logue issued a challenge to accurately display the flag of Greenland. The flag is simple enough to be reduced to a formula <code>x²+y² < 54² ⊻ y > 0</code>:<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEivpldSmUi5fr2ewbW9LqArtio6k4aqXWhnRGVSqz85ai-vOOoyYlf2xcATfBDgLXq11SSTpmfZuTVTOcTzXolp2qs1fpylIDr8v3BYEpAUwinEcL1qHvvY14YtJMVHr4Wfr8n4gFn8uO8/s1600/greenland65pic.png" data-original-width="320" data-original-height="240" /></span></div>
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEi1F6FODmBsrACHmkcBigdGH0fIJpomkx_GCdS1ZVsLgR5MBanvLKHas3stawyEZC99Co7a04f8HilvwxQMk3LN_LcDEzyITChh4pVwG9PAXIJzZzjdEaSkhoxVaEXveZ_QCzFDSB7WWPg/s1600/greenland65code.png" data-original-width="320" data-original-height="240" /></span></div>
<br />
<h3>
Triangles</h3>
Uke Geiken showed a pattern of triangles and asked for the shortest code. The shortest implementation I found uses <acronym title="User-Defined Graphics">UDGs</acronym>:<br />
<br />
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiMOwmMmPPpTbRunawMLZDwQ3njHp5cXTauA9vfj5If0jeChg4Sl_tYFYVugkysSILtcRN-fCttdPPGQUM-i_hH_PaMxn6Af9ZPLpeiNxJe0bwJOKVJz4BbmHVWtMZemOGr9_pBnmodgM8/s1600/triangle151.png" data-original-width="320" data-original-height="240" /></span></div>
<br />
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhc0zDdr_9JhWXhHEGGKLyRbZfw704hG_gIjSa7CwqPfUdPBhp_A0NZPeJtuTSZ4ttWuiwQ4FsRntuiM7egGaXMM0wrfCDcYsY0ufGERw7aCTnQkvOGyzDh9npL8bd7nmjhLowqqIPNAIU/s1600/triangle151code.png" data-original-width="320" data-original-height="240" /></span></div>
<br />
<h3>
Grid</h3>
Matthew Logue asked us recreate a grid-like pattern with the shortest code. Surprisingly I actually managed to discover the smallest program:<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgGY3MqMK6pGOZZWIW4-6GITc7LOa6y3yScSp3EtqJs_YaYfH6ZVVGl4iEljz2l2AwLtRlmWE8iL87JnWmEMU6unAm3tdCNkunpdSZ2A_RsrdG4VCpCD4_Xpp-KYc3S8QdVQjkYxv_va8g/s1600/grid65.png" /></span></div>
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjut-r2puL_U4Gvc6xExE3pc4Il1rEiFD4EAvZwK4wjZWAsfHq8CUvm7Q6iyjtumWUY0ShUblw1Rh-WmsVRAXOwrsQuMuRQyxGAZFmmz0IFQj66H4doZCY3LuT8czSNiPMrTwSN9FLrKgY/s1600/grid65code.png" /></span></div>
<br />
<h3>
Weaving</h3>
Uwe Geiken challenged us to recreate a pattern of weaving attributes. I found this one pretty tricky to reduce in size, but finally got it down to 109 bytes:<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhzawdP58d-kqQhgAyYd6k_zqZ9gu8J42aDQk5Bz91vgB41NrH6mUm7FzhnyQab6n_rulQeS85YZ3zxfhDP4uzBroC874zlhicHhpJn4R3YJ1yVMssE008z_lvw96mJjw-rQin6X-qzCf0/s1600/weave109.png" /></span></div>
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjPV5A2tne9SPWmuIYY_olprTSNVP8jMhO5-JI3rEAzO4u8jQ6efweOxbxKW6NCXyhJmjvD4fL7hYArHVId7LZQgF2jG8-4r-BSkQe43YSVgg9bnAKfgf5fLRqJq18qLaHQsNTAOEqtDzE/s1600/weave109prog.png" /></span></div>
<br />
<h3>
Flag</h3>
Matthew Logue asked for the shortest code to recreate a 31×21 attribute flag-like pattern. Uwe Geiken solved this is 67 bytes, easily beating my 74:<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjj1rq1P_UwvrkbQKL2RHwMOFgg2zqra7vRrjAcXJxUTttIFg0h0PKvGO79AVj1Cpir4XPg32t3o8I3lxphAlk3ACaL6kY_XTKuPJdeeAokxkfNXevJrPqz0o-Ff_t0D-5JEmFjAOFERQ0/s1600/flag74.png" /></span></div>
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjL32LjUJXBiuqOsUxxWmYB-rpUODyaQxq0mC-AXGr1oe0k3vCIkxS_GI7PIushu4DH-7_upgnH0kAmPMIprbUCWE1BHDaEM7SWhZlpEWMP-CFoRdAWXWgeHMdYcYur85eldlIOkkk_Qjo/s1600/flag74prog.png" /></span></div>
<br />
<h3>
Rudimentary Gear</h3>
Matthew Logue challenged us again, this time to draw a rudimentary gear with 10 teeth and a circular radius. Here's what I came up with:<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhUwmibEeX1ORuX6WauK6uKJJmuE8T3U1Xk_HpDAqWtNUPjxCwfbc8KUhoGGIytHyCYcGzhDDX9KlfgDzW2hMvD8IWkmij-nKzsckGyMR_zahfo5koLfr0mfhfZ-ApP0kOILuTcxAFhWEE/s1600/cog98.png" /></span></div>
<div class="separator" style="clear: both; text-align: center;">
<br /></div>
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh26utqmAnQtxgqdKn_-Svk2ScCSf8Wj68JBt-H7OTr40SCI_XwlrB-LK5gQn8QripFEITPVEU44Ttuq45VZyn3NPvZGg_Lv0dUpNntb-8HGIp9eRHEUJs9jogtdU6-tpR6vsID7HcMSpk/s1600/cog98code.png" /></span></div>
<br />John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com1tag:blogger.com,1999:blog-4757118446768919900.post-88184191231837593562017-04-29T07:20:00.000-07:002017-05-20T07:22:42.211-07:00ZX Spectrum Scanline Flood FillA flood fill is a graphical algorithm to colour an area of screen bounded by pixels of another colour. The scanline technique is a fast, stack-efficient flood fill which can be implemented in 99 bytes of Z80, as demonstrated below:
<pre><code>; scanline fill by John Metcalf
; call with d=x-coord, e=y-coord
; set end marker
fill:
ld l,255
push hl
; calculate bit position of pixel
nextrun:
ld a,d
and 7
inc a
ld b,a
ld a,1
bitpos:
rrca
djnz bitpos
ld c,b
ld b,a
; move left until hitting a set pixel or the screen edge
seekleft:
ld a,d
or a
jr z,goright
dec d
rlc b
call scrpos
jr nz,seekleft
; move right until hitting a set pixel or the screen edge,
; setting pixels as we go. Check rows above and below and
; save their coordinates to fill later if necessary
seekright:
rrc b
inc d
jr z,rightedge
goright:
call scrpos
jr z,rightedge
ld (hl),a
inc e
call checkadj
dec e
dec e
call checkadj
inc e
jr seekright
; check to see if there's another row waiting to be filled
rightedge:
pop de
ld a,e
inc a
jr nz,nextrun
ret
; calculate the pixel address and whether or not it's set
scrpos:
ld a,e
and 248
rra
scf
rra
rra
ld l,a
xor e
and 248
xor e
ld h,a
ld a,l
xor d
and 7
xor d
rrca
rrca
rrca
ld l,a
ld a,b
or (hl)
cp (hl)
ret
; check and save the coordinates of an adjacent row
checkadj:
sla c
ld a,e
cp 192
ret nc
call scrpos+1
ret z
inc c
bit 2,c
ret nz
pop hl
push de
jp (hl)
</code></pre>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com2tag:blogger.com,1999:blog-4757118446768919900.post-50382026037647327612016-05-29T01:19:00.000-07:002016-05-29T01:22:16.975-07:00Divide and Conquer Line Algorithm for the ZX Spectrum<p>While attempting to write a game in 256 bytes I needed a routine to draw lines, but Bresenham's line algorithm weighs in at approx ~120 bytes. The only suitable alternative I'm aware of is recursive divide and conquer: divide a line into two smaller lines and call the draw routine with each in turn:</p>
<pre><code>/* Draw a line from (ax,ay) to (bx,by) */
int draw ( ax, ay, bx, by )
{
int midx, midy;
midx = ( ax+bx ) / 2;
midy = ( ay+by ) / 2;
if ( midx != ax && midy != ay )
{
draw( midx, midy, ax, ay );
draw( bx, by, midx, midy );
plot( midx, midy );
}
}
</code></pre>
<p>This is significantly smaller thank Bresenham's, 32 byte of Z80. However, there are a couple of compromises: it's slower and the lines aren't perfect because the rounding errors accumulate.</p>
<pre><code>; draw lines using recursive divide and conquer
; from de = end1 (d = x-axis, e = y-axis)
; to hl = end2 (h = x-axis, l = y-axis)
DRAW:
call PLOT
push hl
; calculate hl = centre pixel
ld a,l
add a,e
rra
ld l,a
ld a,h
add a,d
rra
ld h,a
; if de (end1) = hl (centre) then we're done
or a
sbc hl,de
jr z,EXIT
add hl,de
ex de,hl
call DRAW ; de = centre, hl = end1
ex (sp),hl
ex de,hl
call DRAW ; de = end2, hl = centre
ex de,hl
pop de
ret
EXIT:
pop hl
ret
; ---------------------------
; plot d = x-axis, e = y-axis
PLOT:
push hl
ld a,d
and 7
ld b,a
inc b
ld a,e
rra
scf
rra
or a
rra
ld l,a
xor e
and 248
xor e
ld h,a
ld a,l
xor d
and 7
xor d
rrca
rrca
rrca
ld l,a
ld a,1
PLOTBIT:
rrca
djnz PLOTBIT
or (hl)
ld (hl),a
pop hl
ret
</code></pre>
<p>Alternatively the <code>de(end1) = hl(centre)</code> test can be replaced with a recursion depth count to create an even slower 28 byte routine:</p>
<pre><code>; draw lines using recursive divide and conquer
; from de = end1 (d = x-axis, e = y-axis)
; to hl = end2 (h = x-axis, l = y-axis)
DRAW:
ld c,8
DRAW2:
dec c
jr z,EXIT
push de
; calculate de = centre pixel
ld a,l
add a,e
rra
ld e,a
ld a,h
add a,d
rra
ld d,a
call DRAW2 ; de = centre, hl = end1
ex (sp),hl
call DRAW2 ; de = centre, hl = end2
call PLOT
ex de,hl
pop hl
EXIT:
inc c
ret
</code></pre>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEir-Pm-gl1SzSrmFgQr0UjH7KOz-w3I22rrdgGMxkOaZWL7RpxjKOcecwMwOgC1IiDwnAMiZwFPvyIT1gOaWYUbk8ExP5WDTcz6832tPdDjhgybHy4I-jTkIKg-MOkTNZca58cw34UXwXU/s1600/maze_straight.png" /></span></div>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com4tag:blogger.com,1999:blog-4757118446768919900.post-55378704848163823732016-05-27T13:31:00.000-07:002016-05-28T18:38:41.223-07:00Langton's Ant for the ZX Spectrum<p><strong>Langton's Ant</strong> is an automata which creates a complex pattern by following a couple of simple rules:</p>
<ul>
<li>If the ant is on an empty pixel, turn 90° right, set the pixel then move forward</li>
<li>If the ant is on a set pixel, turn 90° left, reset the pixel then move forward</li>
</ul>
<p>The ant's path appears chaotic at first before falling into a repetitive “highway” pattern, moving 2 pixels diagonally every 104 cycles.</p>
<p>Here's the code to display Langton's Ant on the ZX Spectrum in 61 bytes. It runs in just over a second so you might want to add a <code>halt</code> to slow things down:</p>
<pre><code> org 65472
ld de,128*256+96
ANT:
; halt
ld a,c ; check direction
and 3
rrca
add a,a
dec a
jr nc,XMOVE
add a,e ; adjust y position +/-1
ld e,a
cp 192
ret nc
xor a
XMOVE:
add a,d ; adjust x position +/-1
ld d,a
; ----------
and 7 ; calculate screen address
ld b,a
inc b
ld a,e
rra
scf
rra
or a
rra
ld l,a
xor e
and 248
xor e
ld h,a
ld a,d
xor l
and 7
xor d
rrca
rrca
rrca
ld l,a
ld a,1
PLOTBIT:
rrca
djnz PLOTBIT
; ----------
ld b,a ; test pixel
and (hl)
jr nz,LEFT ; turn left/right
inc c
inc c
LEFT:
dec c
ld a,b ; flip pixel
xor (hl)
ld (hl),a
jr ANT
</code></pre>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgiQSVYm1uyPR7HndnwoykQdQTNNx7wrn_0cOTfRBkbaHe4kangYwnV5v7Gg1d1a-9sYqRcxiiCfY7l1aXxgyqcN7LuVRxGpowc-N471EVRbJ-HN_CMcBaFZGztMWwl_lxSNrjU4EFjYFk/s1600/langtons_ant_zx.png" /></span></div>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com0tag:blogger.com,1999:blog-4757118446768919900.post-376488552918045962015-10-03T17:56:00.000-07:002015-10-03T17:59:13.605-07:00The Matrix Digital Rain for the ZX Spectrum<p>A few days ago I coded The Matrix digital rain effect, a fictional representation of the code for the virtual reality of The Matrix. The technique is simple: fill the screen with random characters and scroll down columns of attributes, occasionally switching between black and green.</p>
<p>Here's the final code - 147 bytes of Z80 using the default Sinclair font:</p>
<pre><code> org 08000h
; black border / black attributes
xor a
out (0FEh),a
ld hl,05AFFh
attr: ld (hl),a
dec hl
bit 2,h
jr z,attr
; fill screen with random characters
ld e,a
fillscr:ld d,040h
fill: call rndchar
ld a,d
cp 058h
jr nz,fill
inc e
jr nz,fillscr
; digital rain loop
frame: ld b,06h
halt
column: push bc
; randomize one character
call random
and 018h
jr z,docol
add a,038h
ld d,a
call random
ld e,a
call rndchar
; select a random column
docol: call random
and 01Fh
ld l,a
ld h,058h
; ~1% chance black -> white
ld a,(hl)
or a
ld bc,0247h
jr z,check
; white -> bright green
white: cp c
ld c,044h
jr z,movecol
; bright green -> green
cp c
ld c,04h
jr z,movecol
; ~6% chance green -> black
ld bc,0F00h
check: call random
cp b
jr c,movecol
ld c,(hl)
; move column down
movecol:ld de,020h
ld b,018h
down: ld a,(hl)
ld (hl),c
ld c,a
add hl,de
djnz down
pop bc
djnz column
; test for keypress
ld bc,07FFEh
in a,(c)
rrca
jr c,frame
ret
; display a random glyph
rndchar:call random
crange: sub 05Fh
jr nc,crange
add a,a
ld l,a
ld h,0
add hl,hl
add hl,hl
ld bc,(05C36h)
add hl,bc
ld b,8
char: ld a,(hl)
ld (de),a
inc d
inc hl
djnz char
ret
; get a byte from the ROM
random: push hl
ld hl,(seed)
inc hl
ld a,h
and 01Fh
ld h,a
ld (seed),hl
ld a,(hl)
pop hl
ret
seed:
</code></pre>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEizWYZBUMfys-zgs1u_HjthEQ-RouNLZ3pj5hXe0RhRFGWGPn5Gz3YrLznrx4o2s2MawvSJTIftk_bfr1POrNiRzWYvz6H-QdoeWvbth27gJDwjm8S92ptqDMXwlgBUe0mZJm1KRvIIL30/s1600/zxmatrix.png" /></span></div>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com3tag:blogger.com,1999:blog-4757118446768919900.post-39901812408312410702015-07-26T23:18:00.000-07:002015-08-01T01:17:11.787-07:00Z80 Size Programming Challenge #5<p>Recently I issued the fifth Z80 challenge for the Sinclair Spectrum:</p>
<div style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;"><p>This time the challenge is to write a solid flood fill routine to fill a region of unset pixels, bounded in 4 directions (up, down, left, right) by set pixels or the screen edge. The routine should be called with the X and Y coordinates in a register. There's no need to set the screen attributes.</p>
<p>Scoring is multi-objective: a routine will be judged by the code size and stack space required to fill a test image. Your routine will be awarded one point for each competing routine it is smaller *and* uses less stack space than. The routine(s) with the most points will be declared winner(s).</p>
<p>The deadline is Wednesday 22nd July, midday (GMT).</p>
<ol>
<li>The X and Y coordinates are in pixels with 0,0 at the top left.</li>
<li>No memory other than the screen, stack and your routine can be written.</li>
<li>If you call a ROM routine it's size will be added to your code size.</li>
<li>Programs must return. The RET instruction is included in the size.</li>
<li>So everyone has a fair chance comment with the code size not code.</li>
<li>There are no prizes, just the chance to show off your coding skills.</li>
</ol>
</div>
<p>The test image is designed to check correct behaviour at the screen boundary and to be pathological — triggering suboptimal behaviour in some common flood fill algorithms:</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhZexae31GFpOL-vnn-phCvtap6gUqX_ZhI6dn5sKB5jXvg9kEFgTvSTGk99EjOfJLP-dlv6D6HjLyLtuWAWpSsXUIpdOyoOSP6-T_lVnE6m_xB-XCvWcxi_x9jZW1L6bmUoAOb-FRoLu0/s1600/testscreen.png" /></span></div>
<h3>Final Results</h3>
<p>Congratulations to everyone who coded a working flood fill and to Dworkin Z Amberu who claimed first place by being shorter and using less memory than competing entries.</p>
<p>Entries have been plotted on this genuine fake Spectrum screenshot. If the graph is empty below and to the left of an entry, that entry is in first place:</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjdA4qsYBjuv0q97iA1zfBSRskuzgmHbOiHAZsqHkF6ROLBocF2Sqir67Y1gk0yBe9SpC7OahbqeZ2GxJocAtwXkZRs_2Tl2LOgZiEMo8u9MsQOKYCYTfXLiF0ULMf_xIXms7_EEbB_gXk/s1600/GRAPH2.PNG" /></span></div>
<br><table style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;">
<thead>
<tr><th scope="col" style="text-align:left;">Colour</th><th scope="col" style="text-align:left;">Coder</th><th scope="col" style="text-align:left;">Code</th><th scope="col" style="text-align:left;">Memory</th><th scope="col" style="text-align:left;">Time</th>
</tr>
</thead>
<tbody>
<tr><td><span style="color:red;">Red</span></td><td>John Metcalf</td><td>98</td><td>~2K</td><td>2.1 seconds</td></tr>
<tr><td><span style="color:orange;">Orange</span></td><td>Paul Rhodes</td><td>102</td><td>~1.8K</td><td>3.2 seconds</td></tr>
<tr><td><span style="color:yellow;">Yellow</span></td><td>Ralph Becket</td><td>109</td><td>~2K</td><td>8.8 seconds</td></tr>
<tr><td><span style="color:limegreen;">Green</span></td><td>Miguel Jódar</td><td>166</td><td>~800 bytes</td><td>4.8 seconds</td></tr>
<tr><td><span style="color:silver;">White</span></td><td>Dworkin Z Amberu</td><td>58</td><td>~9.8K</td><td>28.6 seconds</td></tr>
<tr><td><span style="color:cyan;">Cyan</span></td><td>John Metcalf</td><td>54</td><td>~6.1K</td><td>28.6 seconds</td></tr>
<tr><td><span style="color:black;">Black</span></td><td>Dworkin Z Amberu</td><td>84</td><td>~270 bytes</td><td>40 seconds</td></tr>
<tr><td><span style="color:blue;">Blue</span></td><td>Dworkin Z Amberu</td><td>192</td><td>8 bytes</td><td>~40 minutes</td></tr>
<tr><td><span style="color:magenta;">Purple</span></td><td>Adrian Brown</td><td>199</td><td>12 bytes</td><td>~3 hours?</td></tr>
</tbody>
</table>
<br><h3>Shortest Entry</h3>
<p>The simplest entry is a recursive routine weighing in at 54 bytes. Despite being too heavy on the stack to score well it's one of the easiest to understand. Each time the routine is called it checks whether or not the pixel at X,Y is set. If not the pixel will be set then the fill routine is called recursively with the pixels up, down, left and right of the current pixel:</p>
<pre><code>; called with e = X horizontal, d = Y vertical
FILL:
ld b,e
ld a,d
and 248
rra
cp 96
ret nc
rra
rra
ld l,a
xor d
and 248
xor d
ld h,a
ld a,e
xor l
and 7
xor e
rrca
rrca
rrca
ld l,a
ld a,128
PLOTBIT:
rrca
djnz PLOTBIT
or (hl)
cp (hl)
ret z
ld (hl),a
inc e
call nz,FILL
dec e
dec de
call ZFILL
inc de
call FILL
inc d
inc d
ZFILL:
call nz,FILL
dec d
ret
</code></pre>
<p>The winning entries will be available shortly.</p>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com3tag:blogger.com,1999:blog-4757118446768919900.post-39265165262491992652015-04-06T15:16:00.000-07:002015-04-06T09:34:24.132-07:00Z80 Size Programming Challenge #4<p>The fourth Z80 challenge for the ZX Spectrum was issued last week:</p>
<div style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;">
<p>Back to something simple for the next challenge, a diagonal fade-to-white CLS. Write the shortest code to wipe the screen by increasing the ink colour of each character until it reaches white.</p>
<p>The clear should start at the top left and move one character across the screen per frame. The initial screen can be assumed to be monochrome — black text, white background, flash off, bright off. There's no need to clear the screen bitmap. Here's a demonstration of the clear in slow motion:</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj3gXq8nitA_DXsNoXBUZa_4DZgoktDEp_ha09mFauOBCs-uLFk0dXCFzN6LOcuEWTNzCoUFBAGt_poJDn-4wuKg6Xl-sfQ-wxzU6LopeO-NRYCUzzStdTLSejPogIDO2Qz6R8SGxI7kws/s1600/cls4.gif" /></span></div>
<p>Target: under 50 bytes.</p>
<p>The deadline is Monday 6th April, midday (GMT).</p>
<ol>
<li>Your program shouldn't rely on the initial contents of registers.</li>
<li>Programs must halt between frames. The HALT is included in the size.</li>
<li>No RAM/ROM other than the attribute memory should be written to.</li>
<li>Programs must return. The RET instruction is included in the size.</li>
<li>So everyone has a fair chance comment with the code size not code.</li>
<li>There are no prizes, just the chance to show off your coding skills.</li>
</ol>
</div>
<br><h3>Final Results</h3>
<p>Congratulations to everyone who entered and Arcadiy Gobuzov who claimed first place with a solution in 26 bytes. Most of the solutions use <code>LDDR</code> to move the attribute data with anonymous and Ralph Becket being the two exceptions. Here are the final results:</p>
<table style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;">
<thead>
<tr><th scope="col" style="text-align:left;">Coder</th><th scope="col" style="text-align:left;">Size</th></tr>
</thead>
<tbody>
<tr><td>Arcadiy Gobuzov</td><td>26</td></tr>
<tr><td>ub880d</td><td>27</td></tr>
<tr><td>Bohumil Novacek</td><td>27</td></tr>
<tr><td>anonymous</td><td>27</td></tr>
<tr><td>Adrian Brown</td><td>27</td></tr>
<tr><td>John Metcalf</td><td>27</td></tr>
<tr><td>Ralph Becket</td><td>30</td></tr>
<tr><td>Jim Bagley</td><td>31</td></tr>
<tr><td>Paul Rhodes</td><td>31</td></tr>
</tbody>
</table>
<br><h3>Winning Entry</h3>
<p>Here's Arcadiy's winning entry in 26 bytes:</p>
<pre><code> xor a ; if comment then 25, but exit if a==56 on start
loop:
ld hl,#5ADF ;
cp (hl) ;
ld bc,#02E0 ; 23 lines of attributes
ld de,#5AFF ;
lddr ; move down attributes
ld c,e ; e = #1F
add hl,bc ;
lddr ; roll upper line of attributes to right
halt
ret z
ld a,(de) ; de = first address of attibutes
cp #3F ;
adc a,c ; add 0 or 1 (carry)
ld (de),a ; now a in range [38..3f]
jr loop
</code></pre>
<p>Here's my own solution in 27 bytes. Unfortunately I missed the final <code>CP (HL)</code> to squeeze out the last byte:</p>
<pre><code>fadetowhite:
ld de,23295 ; 90 255
ld a,(de)
cp 63
ret z
ld hl,23263 ; 90 223
ld bc,736 ; 2 224
halt
lddr
ld c,e
add hl,bc
lddr
ld a,(de)
cp 63
adc a,c
ld (de),a
jr fadetowhite
</code></pre>
<p>Here's an alternative — a fade-to-black wipe (from white ink, black paper, no bright, no flash) in 25 bytes:</p>
<pre><code>fadetoblack:
ld de,23295 ; 90 255
ld a,(de)
or a
ret z
ld hl,23263 ; 90 223
ld bc,736 ; 2 224
halt
lddr
ld c,e
add hl,bc
lddr
ld a,(de)
add a,l
sbc a,l
ld (de),a
jr fadetoblack
</code></pre>
John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com12tag:blogger.com,1999:blog-4757118446768919900.post-50547285804945679962015-03-30T08:29:00.000-07:002015-03-31T15:17:52.121-07:00Z80 Size Programming Challenge #3<p>Recently I issued the third Z80 programming challenge for the ZX Spectrum:</p>
<div style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;"><div>This time the challenge is to write the shortest code to display a masked 16×16 pixel sprite. The routine should be called with the address of the sprite data in one register and the X and Y screen coordinates in another. There's no need to save the screen area being overwritten or set the colours / attributes. This is somewhat trickier than previous challenges but more likely to be of practical use.</div>
<p>The deadline is Monday 30th March, midday (GMT).</p>
<p>Target: under 125 bytes.</p>
<ol>
<li>The X and Y coordinates are in pixels with 0,0 at the top left.</li>
<li>The sprite needs to be clipped if it goes over the screen edge.</li>
<li>Sprite data can be formatted however you like within 64 bytes.</li>
<li>Programs must return. The <code>RET</code> instruction is included in the size.</li>
<li>So everyone has a fair chance comment with the code size not code.</li>
<li>There are no prizes, just the chance to show off your coding skills.</li>
</ol>
<p>Solutions can be emailed to digital.wilderness@googlemail.com or posted here after the deadline.</p>
</div>
<br><h3>Final Results</h3>
<p>Congratulations to everyone who rose to the challenge, this was a tough one. Adrian claimed an impressive victory with a neat piece of self-modifying code. Here are the final results:</p>
<table style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;">
<thead>
<tr><th scope="col" style="text-align:left;">Coder</th><th scope="col" style="text-align:left;">Size</th></tr>
</thead>
<tbody>
<tr><td>Adrian Brown</td><td>68</td></tr>
<tr><td>John Metcalf</td><td>88</td></tr>
<tr><td>Ralph Becket</td><td>97</td></tr>
<tr><td>Arcadiy Gobuzov</td><td>99</td></tr>
</tbody>
</table>
<br><h3>Winning Entry</h3>
<p>Adrian Brown submitted an ingenious solution in only 68 byte. The code displays a sprite pixel by pixel in approx 18ms. The instruction at <code>DS_SetResOp</code> is modified to set, reset or leave the appropriate bit.
<pre><code>DrawSprite:
; At most we want to draw 16 lines (lets store
; the 4 onto c as well as its saves a byte)
ld bc, 01004h
DS_YLoop:
; Gotta be able to stop doing all this push/pop
; with exx at some point - but hey ho
push bc
push de
; Splitting is actually helpful as it gives us
; the byte increase on clipping :D
DS_XLoop1:
; Lets get that data byte
ld b, 4
DS_XLoop2:
; Bit cheaty, roll the actual data, it will end
; up back as it started so thats fine
ld a, (hl)
rlca
rlca
ld (hl), a
; Store the data pointer
push hl
; See if we want to draw or not, bit sneaky
; because of data layout
or %10011111
ld l,a
; Now calculate the screen address, start it
; here so carry is clear
ld a,e
rra
; Lets use the check to set the C flag
cp 96
jr nc, DS_SkipPixel
rra
or a
rra
push af
xor e
and %11111000
xor e
ld h,a
; Now work out the opcode for set/res bit (we need
; 01 for bit, 10 for res and 11 for set - so data
; needs to be 10 for bit, 01 for res and 00 for set)
ld a,d
and %00000111
rlca
rlca
; Thats nice, this will do the cpl for us on the
; bit number ;)
xor l
rla
ld (DS_SetResOp + 1),a
pop af
xor d
and %00000111
xor d
; Move across - check for clipping, do it here so
; we can use a as a value > 192
inc d
jr nz, DS_NoClipX
; Stick Y off the bottom so the rest of the line is clipped
; we can use a at this point as its got to be > 192
ld e, a
DS_NoClipX:
rrca
rrca
rrca
ld l,a
; Go set/res the bit
DS_SetResOp:
set 0, (hl)
DS_SkipPixel:
; Store the data pointer
pop hl
; Go do the byte of data
djnz DS_XLoop2
; Now we need to move to the next bytes
inc hl
dec c
jr nz, DS_XLoop1
pop de
pop bc
; Just increase down
inc e
djnz DS_YLoop
ret
;***********************************************************
; Sprite Data twiddled a bit, Mask/Data/Mask/Data
; Mask = 0 we want the screen, set data to 1 means we convert
; the set/res into a bit which is fine, All rolled right
; three bit to get the pixel data i want in bits 3+4
;***********************************************************
SpriteData:
db %10101010, %01001011, %10110100, %10101010
db %10101010, %11110101, %01011111, %10101010
db %11001010, %01011111, %11110101, %10110010
db %01101011, %01010101, %01010101, %10111100
db %11001101, %11010101, %01010101, %00110111
db %11001101, %11110111, %01010101, %00110111
db %01010111, %11010101, %01110101, %11010101
db %01010111, %01010101, %01010101, %11011101
db %01010111, %01010101, %01110101, %11010101
db %01010111, %01010101, %11010101, %11011101
db %11001101, %01010101, %01110111, %00110111
db %11001101, %11010101, %11011101, %00110111
db %01101011, %01110101, %01010111, %10111100
db %11001010, %01011111, %11110101, %10110010
db %10101010, %11110101, %01011111, %10101010
db %10101010, %01001011, %10110100, %10101010
</code></pre>
<p>Here my own solution in 88 bytes. This displays the sprite row by row and is slightly faster, taking approx 5ms.
<pre><code>; called with hl = address of sprite, de = position on screen
putsprite:
ld c,16
nextline:
ld a,d
and 7
inc a
ld b,a
ld a,e
rra
cp 96
ret nc
rra
or a
rra
push de
push hl
ld l,a
xor e
and 248
xor e
ld h,a
ld a,l
xor d
and 7
xor d
rrca
rrca
rrca
ld l,a
ld e,255
spd:
ex (sp),hl
ld a,(hl)
inc hl
ld d,(hl)
inc hl
ex (sp),hl
push bc
rrc e
jr noshift
shiftspr:
rra
rr d
rr e
noshift:
djnz shiftspr
push hl
ld b,3
mask:
bit 0,e
jr z,bm1
and (hl)
db 254 ; jr bm2
bm1:
xor (hl)
bm2:
ld (hl),a
inc l
ld a,l
and 31
ld a,d
ld d,e
jr z,clip
djnz mask
clip:
bit 0,e
ld e,0
pop hl
pop bc
jr nz,spd
pop hl
pop de
inc e
dec c
jr nz,nextline
ret
sprite:
db %11111100, %00111111, %00000000, %00000000
db %11110000, %00001111, %00000011, %11000000
db %11100000, %00000111, %00001100, %00110000
db %11000000, %00000011, %00010000, %00001000
db %10000000, %00000001, %00100010, %00000100
db %10000000, %00000001, %00100111, %00000100
db %00000000, %00000000, %01000010, %00010010
db %00000000, %00000000, %01000000, %00001010
db %00000000, %00000000, %01000000, %00010010
db %00000000, %00000000, %01000000, %00101010
db %10000000, %00000001, %00100000, %01010100
db %10000000, %00000001, %00100010, %10100100
db %11000000, %00000011, %00010001, %01001000
db %11100000, %00000111, %00001100, %00110000
db %11110000, %00001111, %00000011, %11000000
db %11111100, %00111111, %00000000, %00000000
</code></pre>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiccmuHF68oGXmZ2adx6LsYGI0lxMlIMjgRtgK3Sbl-tlF5MVfeCh-rFfrIfRIvQtwgv79ewVcezkt0felEdNLGo61PxZX2GI2hegn6WNSC3gxHA9psDXktK-C1rzF8s80dcucKH9Zp2t0/s1600/spritedemo.png" /></span></div>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com5tag:blogger.com,1999:blog-4757118446768919900.post-24988192246500904482014-12-15T14:09:00.000-08:002015-03-19T15:15:28.719-07:00Z80 Size Programming Challenge #2<p>Last week I issued the second Z80 programming challenge:</p>
<div style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;"><div>Something slightly more complex this time. Write the shortest code to mirror the entire Sinclair Spectrum screen (256×192 pixels) left to right including the colours / attributes. The deadline is Monday 15th, midday (GMT).</div>
<p>Target: under 50 bytes.</p>
<ol>
<li>Your program shouldn't rely on the initial contents of registers.</li>
<li>No <acronym title="random access memory">RAM</acronym>/<acronym title="read only memory">ROM</acronym> other than the screen memory should be written to.</li>
<li>Programs must return. The <code>RET</code> instruction is included in the size.</li>
<li>So everyone has a fair chance comment with the code size not code.</li>
<li>There are no prizes, just the chance to show off your coding skills.</li>
</ol>
</div>
<br>
<h3>Final Results</h3>
<p>We stepped up the difficultly for the second challenge so congratulations to everyone who entered. Introspec ZX and Tim Webber discovered the shortest solutions. Here are the final results:</p>
<table style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;">
<thead>
<tr><th scope="col" style="text-align:left;">Coder</th><th scope="col" style="text-align:left;">Size</th></tr>
</thead>
<tbody>
<tr><td>Introspec Zx</td><td>34</td></tr>
<tr><td>Tim Webber</td><td>34</td></tr>
<tr><td>John Metcalf</td><td>34</td></tr>
<tr><td>Paul Rhodes</td><td>35</td></tr>
<tr><td>Simon Brattel</td><td>35</td></tr>
<tr><td>Jim Bagley</td><td>36</td></tr>
<tr><td>Steve Wetherill</td><td>38</td></tr>
<tr><td>John Young</td><td>49</td></tr>
<tr><td>Chris Walsh</td><td>49</td></tr>
<tr><td>Dariusz EM</td><td>50</td></tr>
</tbody>
</table>
<br>
<h3>Winning Entries</h3>
<p>Introspec submitted the first 34 byte solution using a couple of neat tricks. Note the use of <code>CP L</code> to check which side of the screen it's working on and the byte saved by setting <code>B</code> to <code>#58</code>:</p>
<pre><code> ld hl,16384+6912
screenflip: ld d,h
ld a,l
xor #1F
ld e,a
cp l
jr nc,noflip
ld a,(de)
ld c,(hl)
ld (hl),a
ld a,c
ld (de),a
noflip: ld b,#58
ld a,h
cp b
jr nc,skipattr
byteflip: rlc (hl)
rra
djnz byteflip
ld (hl),a
skipattr: dec hl
bit 6,h
jr nz,screenflip
ret
</code></pre>
<p>Tim Webber's solution saves a series of addresses on the stack to be used later:</p>
<pre><code>start: ld hl,23296
loop1: dec hl
bit 6, h
ret z
ld a, 87
cp h
jr c, noinv
ld b,8
doinv: rl (hl)
rra
djnz doinv
ld (hl), a
noinv: push hl
bit 4,l
jr nz, loop1
pop de
pop hl
ld a,(de)
ld c, (hl)
ld (hl), a
ex de, hl
ld (hl), c
jr loop1
</code></pre>
<p>Although I didn't enter I also found a couple of 34 byte solutions. The first mirrors two bytes in the inner loop:</p>
<pre><code> ld hl,16384
mirror: ld d,h
ld a,l
xor 31
ld e,a
ld a,h
cp 91
ret z
cp 88
ld a,(de)
ld c,a
jr nc,attrib
ld b,8
rrca
mirrorbits: rl (hl)
rra
djnz mirrorbits
db 1 ; skip the next two instructions
attrib: ld a,(hl)
ld (hl),c
ld (de),a
inc l
inc hl
jr mirror
</code></pre>
<p>My second has two separate loops. The first loop mirrors bytes, the second mirrors the screen:</p>
<pre><code> ld hl,22527
mir: ld a,128
mirrorbits: rl (hl)
rra
jr nc,mirrorbits
ld (hl),a
dec hl
bit 6,h
jr nz,mir
mirror: inc hl
ld d,h
ld a,l
xor 31
ld e,a
ld a,h
cp 91
ret z
ld a,(de)
ld c,a
ld a,(hl)
ld (hl),c
ld (de),a
inc l
jr mirror
</code></pre>
<br>
<h3>Is 34 Bytes Optimal?</h3>
<p>Definitely not! After the deadline a solution was discovered that combines code from Tim Webber and Introspec's entries to mirror the screen in 33 bytes:</p>
<pre><code>start: ld hl,23296 ; Tim Webber/Introspec
loop1: dec hl
bit 6, h
ret z
ld a, h
ld b,88
cp b
jr nc, noinv
doinv: rlc (hl)
rra
djnz doinv
ld (hl), a
noinv: push hl
bit 4,l
jr nz, loop1
pop de
pop hl
ld a,(de)
ld c, (hl)
ld (hl), a
ex de, hl
ld (hl), c
jr loop1
</code></pre>
<p>Another 33 byte solution combines the code from Tim Webber and Simon Brattel's entries:</p>
<pre><code>start: ld hl,23296 ; Tim Webber/Simon Brattel
loop1: dec hl
ld a,h
cp 88
jr nc, noinv
and 64
ret z
add a,a
doinv: rlc (hl)
rra
jr nc,doinv
ld (hl), a
noinv: push hl
bit 4,l
jr nz, loop1
pop de
pop hl
ld a,(de)
ld c, (hl)
ld (hl), a
ex de, hl
ld (hl), c
jr loop1
</code></pre>
<p>Entries will be available shortly on <a href="http://zx-speccy.co.uk/z80.html">John Young's website</a>. Thanks to everyone who entered for making the contest a success :-)</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjMIgQyp_uYOxNd3A047qfxo0ircVVoesVg4D-cwhn4GdVunh0Q2pZAah9H_ToMYpvbIWWtEUM1rYVKBY2TlFP2obrZ4djtTSHrdSjIw81MwUecl8XP2qKrP5la3ppuzd3jLsPCdSAgnBE/s1600/mir.png" /></span></div>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com0tag:blogger.com,1999:blog-4757118446768919900.post-18383847378135896732014-12-08T13:29:00.000-08:002014-12-15T13:39:44.663-08:00Z80 Size Programming Challenge #1<p>A few days ago I issued a Z80 programming challenge for the ZX Spectrum:</p>
<div style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;"><div>Something simple for the first challenge. Write the shortest code to fill the screen with a chequerboard pattern of 1 pixel squares. No <acronym title="random access memory">RAM</acronym>/<acronym title="read only memory">ROM</acronym> other than the 6144 byte bitmap screen memory should be written to.</div>
<p>Target: under 25 bytes.</p>
<ol>
<li>Your program shouldn't rely on the initial contents of registers.</li>
<li>Programs must return. The <code>RET</code> instruction is included in the size.</li>
<li>So everyone has a fair chance comment with the code size not code.</li>
<li>There are no prizes, just the chance to show off your coding skill.</li>
</ol>
</div>
<br>
<h3>Final Results</h3>
<p>Congratulations to all who entered, especially Allan Høiberg and Introspec Zx who both discovered a 15-byte solution. The final results are as follows:</p>
<table style="border: solid 1px #eee; margin-left: 8px; margin-right: 8px;padding:4px;">
<thead>
<tr><th scope="col" style="text-align:left;">Coder</th><th scope="col" style="text-align:left;">Size</th></tr>
</thead>
<tbody>
<tr><td>Allan Høiberg</td><td>15</td></tr>
<tr><td>Introspec Zx</td><td>15</td></tr>
<tr><td>Jim Bagley</td><td>16</td></tr>
<tr><td>Paul Rhodes</td><td>16</td></tr>
<tr><td>Krystian Włosek</td><td>16</td></tr>
<tr><td>Tim Webber</td><td>16</td></tr>
<tr><td>Steve Wetherill</td><td>16</td></tr>
<tr><td>John Young</td><td>16</td></tr>
<tr><td>Simon Brattel</td><td>16</td></tr>
<tr><td>John Metcalf</td><td>16</td></tr>
<tr><td>Dariusz EM</td><td>17</td></tr>
<tr><td>Chris Walsh</td><td>23</td></tr>
</tbody>
</table>
<br>
<h3>Winning Entries</h3>
<p>Allan was the first to discover a 15-byte solution:</p>
<pre><code> LD BC,22272
LD A,85
LoopB: BIT 6,B
RET Z
LoopC: DEC C
LD (BC),A
JR NZ,LoopC
CPL
DJNZ loopB
</code></pre>
<p>Introspec found a 15-byte solution with only one loop:</p>
<pre><code> ld hl,16384+6143
filloop5: ld a,h
rra
sbc a,a
xor %01010101
ld (hl),a
dec hl
bit 6,h
jr nz,filloop5
ret
</code></pre>
<p>My own attempts all fell short at 16 bytes:</p>
<pre><code> ld hl,22528-256
ld bc,24*256+170
fill: dec l
ld (hl),c
jr nz,fill
rrc c
dec h
djnz fill
ret
</code></pre>
<p>Entries are archived on <a href="http://zx-speccy.co.uk/ch1.html">John Young's website</a>. Thanks to everyone who entered or otherwise supported the challenge. :-)</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjMTP9IAF0K1HwHBsROSALlrtjGmsNaMkGJsN1HpI946D7IikjC_mVGE5_K2wXsuCsLu1VjcLOax3lNiM3P9o3XBw1zkp1XtdQgIxLL0Tk5-6EeFE7a1cpDVFlUWYn2HL_rNK0AK5yHg6s/s1600/cb.png" /></span></div>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com1tag:blogger.com,1999:blog-4757118446768919900.post-65188419446495543412014-03-15T17:05:00.000-07:002018-02-15T12:23:53.949-08:00Plotting the Mandelbrot Set on the ZX Spectrum<div class="separator" style="clear: both; text-align: center;"><span style="clear: left; float: left; margin-bottom: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEi6dXqjOyfANX6safZ_FQX1o9v7kfnc3J2kcd_By1E7334NAM0VaVcCGnqf8proTKJO0eXsOr5avb8Pn0Bd3Y9O_CqlssM6F9Gl5HXRx1LvmYwbunxcCF1XSK3DIHRbET1t1vAJpfLAFfY/s1600/z80mand1.png" alt="ZX Spectrum Mandelbrot" /></span><span style="float: left; margin-bottom: 1em; margin-right: 1px;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhozaosc3GTUJhYzE6TYETmROekRFbXRny2o-NniROTBS1x79NdVm4zY2DoV738X7Oslb0SdA5VyIam3xzT1O0OyKj-DtOCAvofAVxHa9cnWX_ibxtCroICFeCsbyFrFnX1T4e9KoDBnwU/s1600/z80mand2.png" alt="ZX Spectrum Mandelbrot" /></span></div>
<p style="clear: both;"><strong>The Mandelbrot set</strong> is a fractal which iterates the equation <i>z<sub>n+1</sub> = z<sub>n</sub>² + c</i> in the complex plane and plots which points tend to infinity. Plotting the set with Sinclair BASIC takes over 24 hours so I was curious how much faster it would be in assembly.</p>
<p>It turns out if we use fast 16-bit fixed-point arithmetic we can plot the Mandelbrot in about 5 minutes. To minimise multiplications each iteration is calculated as:
<blockquote><i>r<sub>n+1</sub> = ( r<sub>n</sub> + i<sub>n</sub> ) × ( r<sub>n</sub> - i<sub>n</sub> ) + x</i><br /><br />
<i>i<sub>n+1</sub> = 2 × i<sub>n</sub> × r<sub>n</sub> + y</i></blockquote>
<p>The following test is used to detect points which tend to infinity:</p>
<blockquote>|<i>i<sub>n</sub></i>| + |<i>r<sub>n</sub></i>| ≥ 2 × √ 2.</blockquote>
<pre> org 60000
ld de,255*256+191
XLOOP:
push de
ld hl,-180 ; x-coordinate
ld e,d
call SCALE
ld (XPOS),bc
pop de
YLOOP:
push de
ld hl,-96 ; y-coordinate
call SCALE
ld (YPOS),bc
ld hl,0
ld (IMAG),hl
ld (REAL),hl
ld b,15 ; iterations
ITER:
push bc
ld bc,(IMAG)
ld hl,(REAL)
or a
sbc hl,bc
ld d,h
ld e,l
add hl,bc
add hl,bc
call FIXMUL
ld de,(XPOS)
add hl,de
ld de,(REAL)
ld (REAL),hl
ld hl,(IMAG)
call FIXMUL
rla
adc hl,hl
ld de,(YPOS)
add hl,de
ld (IMAG),hl
call ABSVAL
ex de,hl
ld hl,(REAL)
call ABSVAL
add hl,de
ld a,h
cp 46 ; 46 ≅ 2 × √ 2 << 4
pop bc
jr nc,ESCAPE
djnz ITER
pop de
call PLOT
db 254 ; trick to skip next instruction
ESCAPE:
pop de
dec e
jr nz,YLOOP
dec d
jr nz,XLOOP
ret
FIXMUL: ; hl = hl × de >> 24
call MULT16BY16
ld a,b
ld b,4
FMSHIFT:
rla
adc hl,hl
djnz FMSHIFT
ret
SCALE: ; bc = (hl + e) × zoom
ld d,0
add hl,de
ld de,48 ; zoom
MULT16BY16: ; hl:bc (signed 32 bit) = hl × de
xor a
call ABSVAL
ex de,hl
call ABSVAL
push af
ld c,h
ld a,l
call MULT8BY16
ld b,a
ld a,c
ld c,h
push bc
ld c,l
call MULT8BY16
pop de
add hl,de
adc a,b
ld b,l
ld l,h
ld h,a
pop af
rra
ret nc
ex de,hl
xor a
ld h,a
ld l,a
sbc hl,bc
ld b,h
ld c,l
ld h,a
ld l,a
sbc hl,de
ret
MULT8BY16: ; returns a:hl (24 bit) = a × de
ld hl,0
ld b,8
M816LOOP:
add hl,hl
rla
jr nc,M816SKIP
add hl,de
adc a,0
M816SKIP:
djnz M816LOOP
ret
PLOT: ; plot d = x-axis, e = y-axis
ld a,7
and d
ld b,a
inc b
ld a,e
rra
scf
rra
or a
rra
ld l,a
xor e
and 248
xor e
ld h,a
ld a,d
xor l
and 7
xor d
rrca
rrca
rrca
ld l,a
ld a,1
PLOTBIT:
rrca
djnz PLOTBIT
or (hl)
ld (hl),a
ret
ABSVAL: ; returns hl = |hl| and increments
bit 7,h ; a if the sign bit changed
ret z
ld b,h
ld c,l
ld hl,0
or a
sbc hl,bc
inc a
ret
XPOS:dw 0
YPOS:dw 0
REAL:dw 0
IMAG:dw 0
</pre>
John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com3tag:blogger.com,1999:blog-4757118446768919900.post-57488916617439279922014-02-09T14:46:00.000-08:002014-02-13T14:59:24.779-08:00The Spring 2014 Core War Tournament<p>In May 1984 A K Dewdney introduced Core War, a game played between two or more computer programs in the memory of a virtual computer. The aim of the game is to disable all opponents and survive the longest. A variety of strategies have evolved for Core War, each with their own strengths and weaknesses.</p>
<div class="separator" style="clear: both; text-align: center;"><span style="clear: right; float: right; margin-bottom: 0; margin-left: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhVIGyYuuz3YJzIhFDWx2kdMlecBhhNKLtEZHC7xyTyvP6ptuRgy6l9iGuisWRaDnD6v2vYTRX0InvwuZJmD52wmzjCDLKBzTE5wS3KA3aMuvGvWfA-8XraVX6LDM7wSQXKuk93nDzUOuM/s1600/inv.png" /></span></div>
<p>To celebrate the 30th anniversary in May, <em>The Spring Core War Tournament</em> will be held at <em>The Centre for Computing History</em> in Cambridge UK. The Centre was established to tell the story of the Information Age and presents an interactive collection of computers and artifacts.</p>
<p style="clear:both;">Entries can be up to 25 instructions and will compete in three different core sizes, 800 (tiny), 8000 (standard) and 55440 (large). A program's final score will be calculated as follows:</p>
<p> <tt>final_score = 2 × standard_score + tiny_score + large_score</tt></p>
<p>The program with the highest final score will be awarded the first prize, $50 and a signed copy of <em>The Armchair Universe</em> by A K Dewdney. The top program in each core size will be awarded a signed copy of <em>Life As It Could Be</em> by Thure Etzold, a technothriller which explores the possibility of programs escaping the confines of the Core War virtual computer.</p>
<p>Entries can be sent via email or delivered to The Centre on the day of the tournament (date tbc). Players can submit up to two entries. All entries will be published at the end of the tournament.</p>
<p>The provisional deadline is 01 May 2014. Updates will be posted on <a href="https://groups.google.com/forum/#!forum/rec.games.corewar">news:rec.games.corewar</a>, <a href="http://corewar.eu">http://corewar.eu</a>, <a href="irc://irc.freenode.net/#COREWARS">#corewars</a> on <a href="irc://irc.freenode.net/#COREWARS">irc.freenode.net</a> and on twitter using the hashtag <a href="https://twitter.com/search?q=corewar%20OR%20corewars%20OR%20%22core%20war%22%20OR%20%22core%20wars%22%20OR%20%23corewar&src=typd&f=realtime">#corewar</a>. Good Luck!</p>
<h3>Technical Details:</h3>
<p>Players may enter up to two programs. Programs face each other in a one-on-one round robin, no p-space, no self-fights, no read/write limits. Entries must be your own work. Extended ICWS'94 Draft Redcode applies with the following settings:</p>
<ul>
<li><tt>pmars -s 800 -p 800 -c 8000 -l 25 -d 25</tt></li>
<li><tt>pmars -s 8000 -p 8000 -c 80000 -l 25 -d 100</tt></li>
<li><tt>pmars -s 55440 -p 10000 -c 500000 -l 25 -d 200</tt></li>
</ul>
<p>Entries may use the run-time variables (<tt>CORESIZE</tt>, <tt>MAXPROCESSES</tt>, etc) to tailor the program for each core size, but the program must still behave essentially the same. Some allowed examples include:</p>
<ul>
<li>tweaking the steps / constants</li>
<li>adding an extra bombing line to the core clear</li>
<li>including an extra <tt>SPL/MOV</tt> pair to a paper</li>
</ul>
<p>Completely changing the program's behaviour or swapping / adding extra components for each core size is not allowed.</p>
<h3>Further Details:</h3>
<p>More information about Core War can be found at:</p>
<ul>
<li><a href="http://corewar.co.uk">http://corewar.co.uk</a></li>
<li><a href="http://www.corewar.info">http://www.corewar.info</a></li>
<li><a href="http://users.obs.carnegiescience.edu/birk/COREWAR/">http://users.obs.carnegiescience.edu/birk/COREWAR/</a></li>
</ul>
<p>Software is available from:</p>
<ul>
<li><a href="http://corewar.co.uk/pmars">http://corewar.co.uk/pmars</a></li>
<li><a href="http://corewar.co.uk/wendell">http://corewar.co.uk/wendell</a></li>
<li><a href="http://harald.ist.org/ares">http://harald.ist.org/ares</a></li>
</ul>
<p>Core War can be played online at:</p>
<ul>
<li><a href="http://koth.org">http://koth.org</a></li>
<li><a href="http://sal.discontinuity.info">http://sal.discontinuity.info</a></li>
</ul>
<p>For help, advice and updates see:</p>
<ul>
<li>news:rec.games.corewar</li>
<li><a href="http://corewar.eu">http://corewar.eu</a></li>
<li><a href="irc://irc.freenode.net/#COREWARS">irc://irc.freenode.net/#COREWARS</a></li>
</ul>
<p>The Centre for Computing History has a website at:</p>
<ul>
<li><a href="http://computinghistory.org.uk">http://computinghistory.org.uk</a></li>
</ul>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com2tag:blogger.com,1999:blog-4757118446768919900.post-29472702904919931472014-01-03T06:00:00.000-08:002014-04-03T06:04:06.126-07:00Fast Z80 Bit Reversal<p>For years I've been using the following simple code to reverse the bits in the A register by rotating the bits left out of one register and right into another:</p>
<pre><code>; reverse bits in A
; 8 bytes / 206 cycles
ld b,8
ld l,a
REVLOOP:
rl l
rra
djnz REVLOOP
</code></pre>
<p>Recently I wondered if it's possible to save a few cycles. It turns out the bits are at most 3 rotations away from their position in the reverse:</p>
<table style="border: solid #333 1px; text-align: center; margin: 0 auto;">
<tr><td>7</td><td>6</td><td>5</td><td>4</td><td>3</td><td>2</td><td>1</td><td>0</td></tr>
<tr><td style="padding: 0 15px;">⇐1</td><td style="padding: 0 15px;">⇐3</td><td style="padding: 0 15px;">3⇒</td><td style="padding: 0 15px;">1⇒</td><td style="padding: 0 15px;">⇐1</td><td style="padding: 0 15px;">⇐3</td><td style="padding: 0 15px;">3⇒</td><td style="padding: 0 15px;">1⇒</td></tr>
<tr><td>0</td><td>1</td><td>2</td><td>3</td><td>4</td><td>5</td><td>6</td><td>7</td></tr></table>
<p>With this in mind I devised a bit-twiddling hack to reverse the bits in about a third of the time using only 6 rotates and a bit of logic to recombine the rotated bits. Here's the code, which no doubt has been done many times before:</p>
<pre><code>; reverse bits in A
; 17 bytes / 66 cycles
ld l,a ; a = 76543210
rlca
rlca ; a = 54321076
xor l
and 0xAA
xor l ; a = 56341270
ld l,a
rlca
rlca
rlca ; a = 41270563
rrc l ; l = 05634127
xor l
and 0x66
xor l ; a = 01234567
</code></pre>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com3tag:blogger.com,1999:blog-4757118446768919900.post-9658187469789750722013-11-11T15:35:00.000-08:002013-11-11T15:35:12.901-08:00The Centre for Computing History in Cambridge<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEghAC8vw8pvQjbWyG6XZLeijjLKgZ_KIm6c-awXwdbw39DUWgBwDlncJicG5S_0hkybufYUfIx_TvBIbJKxubK5W7xztjDcwqzkuAcFj2MIZIDLmKclb3eahDSr7silp4YgHxDBFPBspIc/s1600/centre_for_computing_history.jpg" alt="The Centre for Computing History in Cambridge" /></span></div>
<p><strong><a href="http://www.computinghistory.org.uk">The Centre for Computing History</a></strong> is a short walk from Cambridge city centre and is home to a sizeable collection of computers. The museum actively encourages visitors to sit down, try out a few games and even have a go at BASIC programming.</p>
<p>The museum's collection ranges from mechanical calculators and mainframes to home computers and games consoles. Most of the home computers and consoles are switched on and running classic games.</p>
<p>If you're interested in the history of computing (particularly home computing), the centre is the perfect place for a day out.</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjrwPJPFqsElyaN80YBaaIc2DW_8cH0b80zth6AjmnO6eeFeY6r08S5VLYKEPcXQkhCRwwJj5e5huSNdi2ebiGD2V0RKJ0rQWxnc5p84cxx_2KxgbiXkljYe3fuO6uXk-OTgkP-vzgA8bg/s1600/altair_8800.jpg" alt="MITS Altair 8800 computer" /></span></div>
<p style="text-align: center;"><em>Relaxen und watschen der Blinkenlights</em> - the MITS Altair 8800</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjSf3ZDp6SGCppOmVcta3pwtzDfbumbl8HJ6O30xUiodE5kLcblr0Ow24njjqFEQElaCGP5S4LCwRvk545oXeXkcoXt9kYrfS92pZFMhG-fKmEy0A4WumtOplvd-qScsUBGsMuzf-i503A/s1600/commodore_pet_2001.jpg" alt="Commodore PET 2001" /></span></div>
<p style="text-align: center;"><strong>PRINT CHR$(205.5+RND(1));</strong> - Commodore PET 2001</p>
<p style="text-align: center;">
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjIrcpBl4BicXsPdzMYkHYzfFMnlvg4S9_0D6bjlCtq-nXI_xw_SOTFpp6GaQS_l1q47ya1FiWoV7kl3mYMJ3HbgIIpY5ZNgV4FzRl-rfler1V2jLpJ0FfZYagjDUYZKbvuLeiDU2OqK_o/s1600/zx_spectrum.jpg" alt="ZX Spectrum 48K" /></span></div>
<p style="text-align: center;"><strong>PLOT 48,56:DRAW 160,0,65536</strong> - ZX Spectrum 48K</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEifol9gubODZcQ8osu6E5noID5ZsuMMChYduSG_tgzw0k9Z3dTeCN-w3nbRDR0tSh5E4uC3xKp91PMITFFxq0MHepfhXpe1sW0hpvum9AUkKbsIq9xRuaeTCFGE0war7bhaA87J_wsdxuU/s1600/intel_mds_80.jpg" alt="Intel MDS 80 Microprocessor Development System" /></span></div>
<p style="text-align: center;">Intel MDS 80 Microprocessor Development System</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhaAZvGgtpq8-MscZmvTKlgJ9UTNPQ-OkX3f79mW_a560H0WgTko98pReybFa8f6PBuMLURPvT1St9pSyHtAksk-5u1gC-U3YP0UVEaSzFZBOysEVDk5rhEvFf351g2YM5uMiT32_527w8/s1600/hp1000.jpg" alt="HP1000 F Series minicomputer" /></span></div>
<p style="text-align: center;">HP1000 F Series minicomputer</p>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com1tag:blogger.com,1999:blog-4757118446768919900.post-65762311371565471912013-10-18T16:45:00.000-07:002013-10-18T16:50:01.428-07:00Video Gaming 1979-1989 at the NCCD<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiW0ZEVawI5wDoverLi5BBaY6tF-1sbWlD8rkZ1jR0rv2KuEWFRHUC5lGJMrTPGExt1Uh3EoQg1lahlwEQKJe8urRahKJpNaaOhvGqpj7HRmmJ4ncDCRwgxvsJ4a3ohKXUsQjGuNeL9cKg/s1600/sleaford_nccd_video_games.png" alt="Video Gaming 1979-1989 exhibition at The National Centre for Craft and Design" /></span></div>
<p><a href="http://www.nationalcraftanddesign.org.uk">The National Centre for Craft & Design</a> is hosting an event to celebrate the golden age of video games, "<em>Revolution in the Bedroom, War in the Playground: Video Gaming 1979-1989</em>". The exhibition runs from 19th October to 5th January in the main gallery.</p>
<p>The exhibition focuses on bedroom programmers, 8-bit games design and magazine cover art with classic games running on several computers. If you're in the Sleaford area, it's definitely worth a visit.</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh5DWlEathA6zfubuB6m2Ilc2EZtR1bJ0ZAH4BUJlnRsApKFOoUh_4GSPnSOvSmQNB3t0kRawPvsUqjA4hddur5xexvW5Xb8zD3mERLD1dhrvlkHwupuzRmZlAvJmnHNr0OmMoF9ICjwOs/s1600/video_games_nccd_sleaford_3.jpg" alt="ZX Spectrum circuit schematic diagram by Simon Patterson" /></span></div>
<p style="text-align: center;">Detail from Simon Patterson's 15 metre chalkboard circuit diagram</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgQvI5fVzc3u63wiGb9TDaHHDyKzEziWIfZd1VL5fvaThEgkjeuEWkk2gzYf7eL14uR3aS9PZqvsfaXMAGzcAADqN65dunQChPEWE9nIBKOjFz7_qjfuwnLsIL5R2zFpggLVUlQNgZClFw/s1600/video_games_nccd_sleaford_2.jpg" alt="artwork by Oliver Frey" /></span></div>
<p style="text-align: center;">Cover artwork by Oliver Frey</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjs-68RveymWs2ipnvF8KH7XO8aWnQPbnW66CI7Gg4vcbkrwRbzzoOXtNjY0Ka8Nqnx2k-BAuntYCntxCxyUXjPd7R2PGwJcQpQC6mLT58A3q1sf9gxc_ATqQvCveGCf8tQ9x2VT9EmDKw/s1600/video_games_nccd_sleaford_1.jpg" alt="Video Gaming 1979-1989 exhibition" /></span></div>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com0tag:blogger.com,1999:blog-4757118446768919900.post-33272716837897578032013-08-01T11:24:00.003-07:002013-08-01T11:24:55.194-07:00ZX Spectrum Koch (Lévy C) Curve<div class="separator" style="clear: both; text-align: center;"><span style="clear: left; float: left; margin-bottom: 5px; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhNvFnyh6_nvCPosaTj7FDg_Hx3B5rbXJIgs_Wq5A4_VargA51y5ZOZjiIooQYoT0fHzGGVoOX_bd9ssB846Qd1O4UYPzmj9u4ZPHLrmJsRoQmuq5QVKxkIB43y9-5HB50urt-IfHB7bVo/s1600/koch.png" alt="ZX Spectrum Koch (Lévy C) Curve" /></span></div><p>A few years ago I submitted a couple of type-in programs (<a href="http://www.worldofspectrum.org/infoseekid.cgi?id=0024101">C-Curve</a> and <a href="http://www.worldofspectrum.org/infoseekid.cgi?id=0024112">Curtains</a>) to <cite>Your Sinclair</cite> and they featured in the penultimate issue (August 1993).</p>
<p>Encouraged by a shiny new <i><acronym title="Your Sinclair">YS</acronym></i> badge I sent off a new batch of programs. Unfortunately it was too late. The September issue would be <i>Your Sinclair</i>'s "Big Final Issue".</p>
<p style="clear:both;"><strong>C-Curve</strong> is one of the simplest fractal curves. It starts with a straight line. To find the next iteration, each line is replaced by two lines at 90°:</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEje8IQi5rC5_VY0CxU0NWl02EONFNRvPQRDAu41PPbWkto_inKL-k0yC1DDNF5p3LTfFXpsutJ8mJkymoHmIrBv0bUQ7G01JtXii5pmv28EuKJ1GI_XZHuQ6jX7GA8sK8PpwXmq6B8KsmM/s1600/levy_c_curve.png" alt="C Curve fractal" /></span></div>
<p>Here's a later 69 byte version of the program which plots the fractal in approximately 1.52 seconds! Assemble with <a href="http://pasmo.speccy.org">Pasmo</a> (<code>pasmo ccurve.asm ccurve.bin</code>), load the binary to address 65467 in your favourite emulator and run using <code>RANDOMIZE USR 65467</code> :-)</p>
<code><pre> org 65467
ld de,49023 ; d = position on x axis
; e = position on y axis
ld bc,3840 ; b = number of iterations
; c = initial direction
RECURSE:
djnz DOWN
ld a,6 ; check direction
and c ; c=0, left
rrca ; c=2, up
rrca ; c=4, right
add a,a ; c=6, down
dec a
jr nc,XMOVE
add a,e ; adjust y position +/-1
ld e,a ; calculate high byte of screen pos
rrca
scf
rra
rrca
xor e
and 88
xor e
and 95
ld h,a
sub h
XMOVE:
add a,d ; adjust x position +/-1
ld d,a ; calculate low byte of screen pos
rlca
rlca
rlca
xor e
and 199
xor e
rlca
rlca
ld l,a
ld a,7 ; calculate bit position of pixel
and d
ld b,a
inc b
ld a,1
SHIFTBIT:
rrca
djnz SHIFTBIT
xor (hl) ; plot
ld (hl),a
ret
DOWN:
inc c ; turn 45° clockwise
call RECURSE
inc b
dec c ; turn 90° anti-clockwise
dec c
call RECURSE
inc b
inc c ; turn 45° clockwise
ret
</pre></code>
<p>Finally here's a short type-in program to poke the code into a real Spectrum!</p>
<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhcwIGn_M6973mFwA0WTAiQPeRKtzxp5EpFBVizP8o6ycfafr9oVflqzRoT6eZxiYobmJt0tPFXlEItT6b-NA8YDDyvgRfmEA886je6aK0soT2J1riEEAhfVrDbxaDGWR9DYidGDKaASAY/s1600/kochprog.png" /></span></div>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com2tag:blogger.com,1999:blog-4757118446768919900.post-43363582332201740662013-07-04T16:56:00.000-07:002013-07-07T17:18:09.845-07:00Silicon Dreams & The Vintage Computer Festival<div class="separator" style="clear: both; text-align: center;"><span style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh3AMk1Mx2bG0MfRSz9m_uKbUAfNH3sSvp9BOrOjNQ7EGrOTVZIgxJ-oa0Gp91UNhhglPNBQXz2fBVC1cncglQlzcL0X4KRYTJgZYjqymHCB-wDoMwbGeADnnEH2eTEHe83QEnrKzGUcN0/s1600/vcf.jpg" alt="The Centre For Computing History at Silicon Dreams" /></span></div>
<p>This weekend the biggest event in the U.K.'s retro computing calendar will be hosted at the <a href="http://www.snibston.org.uk">Snibston Discovery Museum</a> in Leicestershire. The <a href="http://www.vintagecomputerfestival.org.uk">Vintage Computer Festival</a> follows 2010's highly successful event with most of the main exhibitors returning. Some of the highlights include:</p>
<ul><li>Raspberry Jam - a hands-on workshop for the Raspberry Pi single board computer organised by the Centre for Computing History.</li>
<li>The Amiga is well represented at the show with demonstrations of MorphOS 3.2 and the latest AmigaOne X1000.</li>
<li>15+ exhibitors will be displaying a wide range of historic / unusual computers including RISC OS running on the Raspberry Pi.</li>
<li>Look out for the Spectranet ethernet board in action. Tweet direct from a ZX Spectrum complete with nixie tube tweetometer!</li>
</ul>
<p>The event runs from 5th - 7th July. Tickets are £15 for the day, or £20 for the weekend. We'll be there when the gates open at 10am. Is anyone else planning to attend?</p>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com0tag:blogger.com,1999:blog-4757118446768919900.post-84956780044060341962012-09-18T15:10:00.001-07:002012-09-18T15:14:56.488-07:00Programming Editors for Android on the Nexus 7<p>A few days ago I received a Nexus 7 for programming on the go. The Nexus features a 1.3 <abbr title="Gigahertz">GHz</abbr> quad-core <acronym title="central processing unit">CPU</acronym>, 1 <abbr title="Gigabyte">GB</abbr> <acronym title="random access memory">RAM</acronym> and runs Android 4.1 (Jelly Bean).</p>
<p>The Nexus is supplied without a text editor so I started searching for the perfect programming editor. After experimenting with dozens, here are the top candidates:
<hr style="clear: left;" /><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgyRkFsHY4GUYPH5sL3m8xcIS-rBaUL-r7QW1Z2vMqj_8-KVc8SoNPd99g0dsPN4uufEqr7KPaSmzb8Nei2cH93fy58ld4dPmqHdl39fDwr0WWQQ4qRmgcR6u2JvK_ZCpqrdtUQqc9qHmE/s1600/920_text_editor.png" imageanchor="1" style="clear: left; float: left; margin-bottom: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhXI845oE1q9UU162CyrYq8gEo0T5mM3DEf6IxMisYHCgD7fbV-l8MN4tIlANLdKc8CokUxxj0Nh2vQvuHkWUz6pt_UczfiVAAWH2gR9teEL2TvdkklgsKz4zEvEmQY2Ew2XXh8bMHCBAA/s1600/920_text_editor_thumb.png" /></a>
<br>The <a href="https://play.google.com/store/apps/details?id=com.jecelyin.editor">920 Text Editor</a> supports multiple open files and syntax highlighting for 35 languages.<br><br>
<small style="color: grey;">(click thumbnail for the full screenshot)</small>
<hr style="clear: left;" /><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjDFqtdN73wP79av0JQBCkX94QuJCDw0jNHHZza8l1Az9HFZ0dc6GqZKHISVa6Iph0BBVkd_Rp5BRDZdtlGSTprqeiVnHJbPwj2QIrgO7_YQcxowyDrWwmlHBId0GByQ8aF5rcy3ODCTts/s1600/droidedit_free.png" imageanchor="1" style="clear: left; float: left; margin-bottom: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhbB1j-RCdlNcBOXMFxxbmMWVm_2o3vlJHAgaQRLlMabbdjoBSnynpAA7AWEURARMSe7pqBC0hDaIkQdOO8VLGB8I3PW5lWDEe6P98RrhDT-KnP64XB2kh-KkT1EAmcMa7uGL2-QoTJGAA/s1600/droidedit_free_thumb.png" /></a>
<br><a href="https://play.google.com/store/apps/details?id=com.aor.droidedit">DroidEdit</a> is ad-supported and features syntax highlighting for 26 languages and multiple open files. Upgrading to DroidEdit Pro adds support for FTP and Dropbox.
<hr style="clear: left;" /><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEi26GEXLhJ-p2kz2JIQoWlK-UUEtGF1M4EnISF5jciWraWkCorm1-HMZD0nm38108pA-JSpWAc8WQfdUqh8KJyXfvD4MLsqCu4XpJiWu0Eb48T6AoAZpmH9u2Nq2a7Cj9oNd1fCWAxK9UQ/s1600/jota_text_editor.png" imageanchor="1" style="clear: left; float: left; margin-bottom: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiqC5AnVNy7XqpZ1GEheIROCjjr5PnOSLYx8IGequQRxJYvncoV96qzt-Vt7Jx1CQdsdp0CvPSQYloquX2l0ooeZg5ip2cVoLVFPX6Sqml5O-qF0LMF2iFNU84G04djXtblZTspkXe94mU/s1600/jota_text_editor_thumb.png" /></a>
<br><a href="https://play.google.com/store/apps/details?id=jp.sblo.pandora.jota">Jota</a> is a freeware editor with syntax highlighting for 20+ languages, regular expression search and the ability to share directly to Twitter, Facebook, etc.
<hr style="clear: left;" /><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj1BSPPzVbZgNv-Gc_4peqPdFliBDTia88f-iaj2QDlcKCUyWec8SX0TPmgAfgRv93zXSBERb3t99Ac9rtCf1loMAIV4pjmnAArpYaWF9P_ZxRWS4UFb5EGnhyphenhyphenrKCD7dQB6KMy1zMa5Pg4/s1600/jota_plus.png" imageanchor="1" style="clear: left; float: left; margin-bottom: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjnDCr8TsEkhZlXNGlLnUuseevvniipevtSpZ7XsFJu6xhfI_9BZM6rmquaqILdxddd9riKZ5kfSFQXHtq-Pn25Ao4ZrwYjlONdmwMvsNUz8qsrsAMGm9hw2Sv-1Gghrm6d0W2IIOzey48/s1600/jota_plus_thumb.png" /></a>
<br><a href="https://play.google.com/store/apps/details?id=jp.sblo.pandora.jota.plus">Jota+</a> allows two open files and has syntax highlighting for 20+ file formats. Jota+ Pro adds support for multiple open files, Dropbox, Box and SkyDrive.
<hr style="clear: left;" /><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjoIXEEiP5Pr5UC6XcZuBqQRuMyQIk9pkuTn4_LyHBoKdkb0LAOAwMrQrMvLJw73qMZSqapsttU5XkvuzMitcWkn6E3E_z0wc9Dks0WRf3hcTd3S3v5Svs-sEf80RSG5M7vBMZ133Ku1Ac/s1600/touchqode.png" imageanchor="1" style="clear: left; float: left; margin-bottom: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhSKrZ69QXGhJ0wp2tq9HKCtJbp5_tGUspHHQS8mvXR-sKzyjJJ1vy__f3F2_kP3uz6k8ajHxLLcmrTFOG0gUzx8iIc635eupGN3_dtkLqmNjtiSVmuGwtBvuVC6AjK50gdpW2-kK95abw/s1600/touchqode_thumb.png" /></a>
<br><a href="https://play.google.com/store/apps/details?id=com.touchqode.editor">Touchqode</a> supports highlighting for 8 languages, has built in FTP access and a custom keyboard. Upgrading to Touchqode Pro adds several features including a GitHub viewer.
<hr style="clear: left;" />
<p>Unfortunately none of the above supports code folding which would be really handy on the 7″ screen. In the end I've settled for Jota+ with <a href="https://play.google.com/store/apps/details?id=com.myopicmobile.codewhisk">CodeWhisk</a>, a replacement keyboard with faster access to numbers and symbols. Which editor / keyboard combo are you using on Android? :-)John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com1tag:blogger.com,1999:blog-4757118446768919900.post-84749217584622905162012-09-04T17:30:00.001-07:002012-09-29T05:30:30.049-07:00Itsy: Documenting the Bit-Twiddling & Voodoo Magic<p>Over the last few months I've been developing Itsy, a tiny interpreter for a subset of Forth. An overview can be found in the following posts:</p>
<ul>
<li><a href="http://www.retroprogramming.com/2012/03/itsy-forth-1k-tiny-compiler.html">Itsy-Forth: the Outer Interpreter of a 1K Tiny Compiler</a></li>
<li><a href="http://www.retroprogramming.com/2012/04/itsy-forth-dictionary-and-inner.html">Itsy-Forth: the Dictionary and Inner Interpreter</a></li>
<li><a href="http://www.retroprogramming.com/2012/04/itsy-forth-primitives.html">Itsy Forth: Implementing the Primitives</a></li>
<li><a href="http://www.retroprogramming.com/2012/06/itsy-forth-compiler.html">Itsy Forth: The Compiler</a></li>
</ul>
<p>To save time I've described the system as a whole while skipping some of the implementation details. Mike Adams noticed my omission and performed a complete analysis of Itsy, fully commenting the code.</p>
<p>Mike's analysis will make it much easier to change the threading model and port Itsy to a microcontroller when I finally get round to it. Thanks Mike.</p>
<p>Here's Itsy with all the bit-twiddling hacks and voodoo magic documented by Mike:</p>
<h3>macros.asm</h3>
<pre style='font-size: 10.5px;'>
<span style='color: olive; font-weight: bold;'>; Itsy Forth - Macros</span>
<span style='color: olive;'>; Written by John Metcalf</span>
<span style='color: olive;'>; Commentary by Mike Adams</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; Itsy Forth was written for use with NASM, the "Netwide Assembler"</span>
<span style='color: olive;'>; (http://www.nasm.us/). It uses a number of macros to deal with the tedium</span>
<span style='color: olive;'>; of generating the headers for the words that are defined in Itsy's source</span>
<span style='color: olive;'>; code file. The macros, and the explanations of what they're doing, are</span>
<span style='color: olive;'>; listed below:</span>
<span style='color: olive;'>;--------------------------------------------------------------------------</span>
<span style='color: olive;'>; First, two variables are defined for use by the macros:</span>
<span style='color: olive;'>; link is the initial value for the first link field that'll</span>
<span style='color: olive;'>; be defined. It's value will be updated with each header</span>
<span style='color: olive;'>; that's created.</span>
<span style='color: teal;'>%define</span> link <span style='color: teal;'>0</span>
<span style='color: olive;'>; A bitmask that'll be called "immediate" will be used to</span>
<span style='color: olive;'>; encode the flag into the length bytes of word names in order</span>
<span style='color: olive;'>; to indicate that the word will be of the immediate type.</span>
<span style='color: teal;'>%define</span> immediate <span style='color: teal;'>080h</span>
<span style='color: olive;'>;--------------------------------------------------------------------------</span>
<span style='color: olive;'>; The first macro defined is the primary one used by the others, "head".</span>
<span style='color: olive;'>; It does the lion's share of the work for the other macros that'll be</span>
<span style='color: olive;'>; defined afterwards. Its commands perform the following operations:</span>
<span style='color: olive;'>; The first line of the macro declares it's name as "head".</span>
<span style='color: olive;'>; The 4 in this line signifies that it expects to receive</span>
<span style='color: olive;'>; 4 parameters when it's invoked: the string that will be the</span>
<span style='color: olive;'>; word's name and will be encoded into the header along with</span>
<span style='color: olive;'>; the string's name; an "execution tag" name that will have the</span>
<span style='color: olive;'>; prefix "xt_" attached to it and will be used as a label for</span>
<span style='color: olive;'>; the word's code field; a flag that will be 080h if the word</span>
<span style='color: olive;'>; will be immediate and a 0 otherwise; and the label for the</span>
<span style='color: olive;'>; word's runtime code, whose address will be put into the</span>
<span style='color: olive;'>; word's code field.</span>
<span style='color: teal;'>%macro</span> head <span style='color: teal;'>4</span>
<span style='color: olive;'>; Okay, what we're doing in this odd-looking bit of code is</span>
<span style='color: olive;'>; declaring a variable called "%%link" that's local only to this</span>
<span style='color: olive;'>; macro and is independent of the earlier variable we declared</span>
<span style='color: olive;'>; as "link". It's a label that will represent the current</span>
<span style='color: olive;'>; location in the object code we're creating. Then we lay down</span>
<span style='color: olive;'>; some actual object code, using the "dw" command to write the</span>
<span style='color: olive;'>; current value of "link" into the executable file.</span>
%%link <span style='color: teal;'>dw</span> link
<span style='color: olive;'>; Here's one of the tricky parts. We now redefine the value of</span>
<span style='color: olive;'>; "link" to be whatever the current value of "%%link" is, which</span>
<span style='color: olive;'>; is basically the address of the link field that was created</span>
<span style='color: olive;'>; during this particular use of this macro. That way, the next</span>
<span style='color: olive;'>; time head is called, the value that will be written into the</span>
<span style='color: olive;'>; code in the "dw" command above will be whatever the value of</span>
<span style='color: olive;'>; "%%link" was during THIS use of the macro. This way, each time</span>
<span style='color: olive;'>; head is called, the value that'll be written into the new</span>
<span style='color: olive;'>; link field will be the address that was used for the link</span>
<span style='color: olive;'>; field the previous time head was called, which is just how</span>
<span style='color: olive;'>; we want the link fields to be in a Forth dictionary. Note that</span>
<span style='color: olive;'>; the first time that head is called, the value of link was</span>
<span style='color: olive;'>; predefined as 0, so that the link field of the first word in</span>
<span style='color: olive;'>; the dictionary will contain the value of 0 to mark it as</span>
<span style='color: olive;'>; being the first word in the dictionary.</span>
<span style='color: teal;'>%define</span> link %%link
<span style='color: olive;'>; Now the name field. The first argument passed to head is the</span>
<span style='color: olive;'>; string defining the new word's name. The next line in the macro</span>
<span style='color: olive;'>; measures the length of the string (the "%1" tells it that it's</span>
<span style='color: olive;'>; supposed to look at argument #1) and assigns it to a macro-local</span>
<span style='color: olive;'>; variable called "%%count".</span>
<span style='color: teal;'>%strlen</span> %%count <span style='color: purple;'>%1</span>
<span style='color: olive;'>; In this next line, we're writing data into the object code on</span>
<span style='color: olive;'>; a byte-by-byte basis. We first write a byte consisting of the</span>
<span style='color: olive;'>; value of argument 3 (which is 080h if we're writing the header</span>
<span style='color: olive;'>; for an immediate word or a 0 otherwise) added to the length of</span>
<span style='color: olive;'>; the name string to produce the length byte in the header. Then</span>
<span style='color: olive;'>; we write the name string itself into the file.</span>
<span style='color: teal;'>db</span> <span style='color: purple;'>%3</span> + %%count,%<span style='color: teal;'>1</span>
<span style='color: olive;'>; Okay, don't get confused by the "+" in this next line. Take</span>
<span style='color: olive;'>; careful note of the spaces; the actual command is "%+", which</span>
<span style='color: olive;'>; is string concatenation, not numeric addition. We're going to</span>
<span style='color: olive;'>; splice a string together. The first part consists of the "xt_",</span>
<span style='color: olive;'>; then we splice the macro's 2nd argument onto it. The resulting</span>
<span style='color: olive;'>; string is used as the head's "execution tag", the address of</span>
<span style='color: olive;'>; it's code field. This label is then used for the "dw" command</span>
<span style='color: olive;'>; that writes the value of argument #4 (the address of the word's</span>
<span style='color: olive;'>; runtime code) into the header's code field.</span>
xt_ %+ <span style='color: purple;'>%2</span> <span style='color: teal;'>dw</span> <span style='color: purple;'>%4</span>
<span style='color: olive;'>; As you might guess, the next line marks the end of the</span>
<span style='color: olive;'>; macro's definition. The entire header's been defined at this</span>
<span style='color: olive;'>; point, and we're now ready for the data field, whether it's</span>
<span style='color: olive;'>; composed of assembly code, a list of Forth words, or the</span>
<span style='color: olive;'>; numeric data for a variable or constant.</span>
<span style='color: teal;'>%endmacro</span>
<span style='color: olive;'>; For example, calling head with the following line:</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; head,'does>',does,080h,docolon</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; will produce the following header code...</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; dw (address of link of previous header)</span>
<span style='color: olive;'>; db 085h,'does>'</span>
<span style='color: olive;'>; xt_does dw docolon</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; ...and records the address of this header's link field so that it can</span>
<span style='color: olive;'>; be written into the link field of the next word, just as the address</span>
<span style='color: olive;'>; of the previous link field was written into this header.</span>
<span style='color: olive;'>; This method saves the programmer a lot of tedium in manually generating</span>
<span style='color: olive;'>; the code for word headers when writing a Forth system's kernel in</span>
<span style='color: olive;'>; assembly language. Note that argument #2 is surrounded by single quotes.</span>
<span style='color: olive;'>; That's the format that the assembler expects to see when being told to</span>
<span style='color: olive;'>; lay down a string of characters byte-by-byte in a db command, so they</span>
<span style='color: olive;'>; have to be present when they're given as an arg to this macro so that</span>
<span style='color: olive;'>; the macro puts them in their proper place.</span>
<span style='color: olive;'>;--------------------------------------------------------------------------</span>
<span style='color: olive;'>; The next macro is called "primitive", and is used for setting up a header</span>
<span style='color: olive;'>; for a word written in assembly language.</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; Here we declare the definition of the macro called "primitive".</span>
<span style='color: olive;'>; Note, though, the odd manner in which the number of required</span>
<span style='color: olive;'>; arguments is stated. Yes, that really does mean that it can</span>
<span style='color: olive;'>; take from 2 to 3 arguments. Well, what does it do if the user</span>
<span style='color: olive;'>; only gives it 2? That's what that 0 is: the default value that's</span>
<span style='color: olive;'>; to be used for argument #3 if the user doesn't specify it. Most</span>
<span style='color: olive;'>; of the time he won't; the only time arg #3 will be specifically</span>
<span style='color: olive;'>; given will be if the user is defining an immediate word.</span>
<span style='color: teal;'>%macro</span> primitive <span style='color: teal;'>2</span>-<span style='color: teal;'>3</span> <span style='color: teal;'>0</span>
<span style='color: olive;'>; All primitive does is to pass its arguments on to head, which</span>
<span style='color: olive;'>; does most of the actual work. It passes on the word name and</span>
<span style='color: olive;'>; the execution tag name as-is. Parameter #3 will be given the</span>
<span style='color: olive;'>; default value of 0 unless the user specifically states it.</span>
<span style='color: olive;'>; This is meant to allow the user to add "immediate" to the</span>
<span style='color: olive;'>; macro invocation to create an immediate word. The 4th arg,</span>
<span style='color: olive;'>; "$+2", means that when head goes to write the address of the</span>
<span style='color: olive;'>; run-time code into the code field, the address it's going to</span>
<span style='color: olive;'>; use will be 2 bytes further along than the code field address,</span>
<span style='color: olive;'>; i.e. the address of the start of the code immediately after</span>
<span style='color: olive;'>; the code field. (The "$" symbol is used by most assemblers</span>
<span style='color: olive;'>; to represent the address of the code that's currently being</span>
<span style='color: olive;'>; assembled.)</span>
head <span style='color: purple;'>%1</span>,%<span style='color: teal;'>2</span>,%<span style='color: teal;'>3</span>,<span style='color: purple;'>$</span>+<span style='color: teal;'>2</span>
<span style='color: olive;'>; End of the macro definition.</span>
<span style='color: teal;'>%endmacro</span>
<span style='color: olive;'>;--------------------------------------------------------------------------</span>
<span style='color: olive;'>; The macro "colon" operates very similarly to "primitive", except that</span>
<span style='color: olive;'>; it's used for colon definitions:</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; Declare the macro, with 2 to 3 arguments, using 0 for the default</span>
<span style='color: olive;'>; value of arg #3 if one isn't specifically given.</span>
<span style='color: teal;'>%macro</span> colon <span style='color: teal;'>2</span>-<span style='color: teal;'>3</span> <span style='color: teal;'>0</span>
<span style='color: olive;'>; Pass the args on to head, using docolon as the runtime code.</span>
head <span style='color: purple;'>%1</span>,%<span style='color: teal;'>2</span>,%<span style='color: teal;'>3</span>,docolon
<span style='color: olive;'>; End of macro definition.</span>
<span style='color: teal;'>%endmacro</span>
<span style='color: olive;'>;--------------------------------------------------------------------------</span>
<span style='color: olive;'>; The rest of the macros all require a specific number of arguments, since</span>
<span style='color: olive;'>; none of them have the option of being immediate. This one defines</span>
<span style='color: olive;'>; a constant:</span>
<span style='color: olive;'>; Macro name is, unsurprisingly, "constant", and gets 3 arguments.</span>
<span style='color: olive;'>; As with head and primitive, the first 2 are the word's name and</span>
<span style='color: olive;'>; the label name that'll be used for the word. The third argument</span>
<span style='color: olive;'>; is the value that we want the constant to hold.</span>
<span style='color: teal;'>%macro</span> constant <span style='color: teal;'>3</span>
<span style='color: olive;'>; Use the head macro. Args 1 and 2, the names, get passed on as-is.</span>
<span style='color: olive;'>; Constants are never defined as immediate (though it's an intriguing</span>
<span style='color: olive;'>; idea; a constant whose value is one thing when compiling and</span>
<span style='color: olive;'>; another when interpreting might be useful for something), so arg #3</span>
<span style='color: olive;'>; passed on to head is always a 0, and arg #4 will always be doconst,</span>
<span style='color: olive;'>; the address of the runtime code for constants.</span>
head <span style='color: purple;'>%1</span>,%<span style='color: teal;'>2</span>,<span style='color: teal;'>0</span>,doconst
<span style='color: olive;'>; Similar to the way that the label is created for the execution</span>
<span style='color: olive;'>; tags, here we create a label for the data field of the constant,</span>
<span style='color: olive;'>; though this time we're prefixing the name with "val_" instead</span>
<span style='color: olive;'>; of the "xt_" used for the execution tags. Then we use a dw to</span>
<span style='color: olive;'>; write constant's arg #3, the constant's value, into the code.</span>
val_ %+ <span style='color: purple;'>%2</span> <span style='color: teal;'>dw</span> <span style='color: purple;'>%3</span>
<span style='color: olive;'>; End of the definition.</span>
<span style='color: teal;'>%endmacro</span>
<span style='color: olive;'>;--------------------------------------------------------------------------</span>
<span style='color: olive;'>; The macro for variables is very similar to the one for constants.</span>
<span style='color: olive;'>; Macro name "variable", 3 arguments, with arg #3 being the</span>
<span style='color: olive;'>; initial value that will be given to the variable.</span>
<span style='color: teal;'>%macro</span> variable <span style='color: teal;'>3</span>
<span style='color: olive;'>; Just like in "constant", except that the runtime code is dovar.</span>
head <span style='color: purple;'>%1</span>,%<span style='color: teal;'>2</span>,<span style='color: teal;'>0</span>,dovar
<span style='color: olive;'>; Exact same line as used in "constant", with the same effects.</span>
val_ %+ <span style='color: purple;'>%2</span> <span style='color: teal;'>dw</span> <span style='color: purple;'>%3</span>
<span style='color: olive;'>; End of the definition.</span>
<span style='color: teal;'>%endmacro</span>
<span style='color: olive;'>;--------------------------------------------------------------------------</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; That's the last of the macros. They're accessed through the</span>
<span style='color: olive;'>; "%include macros.asm" command near the beginning of Itsy's</span>
<span style='color: olive;'>; source code file. Or, if you prefer, you can remove the</span>
<span style='color: olive;'>; %include command and splice the above code directly</span>
<span style='color: olive;'>; into itsy.asm in its place.</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>;--------------------------------------------------------------------------</span>
</pre>
<h3>itsy.asm</h3>
<pre style='font-size: 10.5px;'>
<span style='color: olive; font-weight: bold;'>; Itsy Forth</span>
<span style='color: olive;'>; Written by John Metcalf</span>
<span style='color: olive;'>; Commentary by John Metcalf and Mike Adams</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; Itsy Forth was written for use with NASM, the "Netwide Assembler"</span>
<span style='color: olive;'>; that's available for free download (http://www.nasm.us/).</span>
<span style='color: olive;'>; The command line for assembling Itsy is:</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; nasm itsy.asm -fbin -o itsy.com</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; If you wish to have an assembly listing, give it this command:</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; nasm itsy.asm -fbin -l itsy.lst -o itsy.com</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>;--------------------------------------------------------------------------</span>
<span style='color: olive;'>; Implementation notes:</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; Register Usage:</span>
<span style='color: olive;'>; sp - data stack pointer.</span>
<span style='color: olive;'>; bp - return stack pointer.</span>
<span style='color: olive;'>; si - Forth instruction pointer.</span>
<span style='color: olive;'>; di - pointer to current XT (CFA of word currently being executed).</span>
<span style='color: olive;'>; bx - TOS (top of data stack). The top value on the data stack is not</span>
<span style='color: olive;'>; actually kept on the CPU's data stack. It's kept in the BX register.</span>
<span style='color: olive;'>; Having it in a register like this speeds up the operation of</span>
<span style='color: olive;'>; the primitive words. They don't have to take the time to pull a</span>
<span style='color: olive;'>; value off of the stack; it's already in a register where it can</span>
<span style='color: olive;'>; be used right away!</span>
<span style='color: olive;'>; ax, cd, dx - Can all be freely used for processing data. The other</span>
<span style='color: olive;'>; registers can still be used also, but only with caution. Their</span>
<span style='color: olive;'>; contents must be pushed to the stack and then restored before</span>
<span style='color: olive;'>; exiting from the word or calling any other Forth words. LOTS of</span>
<span style='color: olive;'>; potential for program crashes if you don't do this correctly.</span>
<span style='color: olive;'>; The notable exception is the DI register, which can (and is, below)</span>
<span style='color: olive;'>; used pretty freely in assembly code, since the concept of a pointer</span>
<span style='color: olive;'>; to the current CFA is rather irrelevant in assembly.</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; Structure of an Itsy word definition:</span>
<span style='color: olive;'>; # of</span>
<span style='color: olive;'>; Bytes: Description:</span>
<span style='color: olive;'>; ------ ---------------------------------------------------------</span>
<span style='color: olive;'>; 2 Link Field. Contains the address of the link field of the</span>
<span style='color: olive;'>; definition preceding this one in the dictionary. The link</span>
<span style='color: olive;'>; field of the first def in the dictionary contains 0.</span>
<span style='color: olive;'>; Varies Name Field. The first byte of the name field contains the length</span>
<span style='color: olive;'>; of the name; succeeding bytes contain the ASCII characters of</span>
<span style='color: olive;'>; the name itself. If the high bit of the length is set, the</span>
<span style='color: olive;'>; definition is tagged as being an "immediate" word.</span>
<span style='color: olive;'>; 2 Code Field. Contains the address of the executable code for</span>
<span style='color: olive;'>; the word. For primitives, this will likely be the address</span>
<span style='color: olive;'>; of the word's own data field. Note that the header creation</span>
<span style='color: olive;'>; macros automatically generate labels for the code field</span>
<span style='color: olive;'>; addresses of the words they're used to define, though the</span>
<span style='color: olive;'>; CFA labels aren't visible in the code shown below. The</span>
<span style='color: olive;'>; assembler macros create labels, known as "execution tags"</span>
<span style='color: olive;'>; or XTs, for the code field of each word.</span>
<span style='color: olive;'>; Varies Data Field. Contains either a list of the code field addresses</span>
<span style='color: olive;'>; of the words that make up this definition, or assembly-</span>
<span style='color: olive;'>; language code for primitives, or numeric data for variables</span>
<span style='color: olive;'>; and constants and such.</span>
<span style='color: olive;'>;-----------------------------------------------------------------------------</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; Beginning of actual code.</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; Include the definitions of the macros that are used in NASM to create</span>
<span style='color: olive;'>; the headers of the words. See macros.asm for more details.</span>
<span style='color: olive;'>;-----------------------------------------------------------------------------</span>
<span style='color: teal;'>%include</span> <span style='color: orange; font-weight: bold;'>"macros.asm"</span>
<span style='color: olive;'>;-----------------------------------------------------------------------------</span>
<span style='color: olive;'>; Define the location for the stack. -256 decimal = 0ff00h</span>
<span style='color: olive;'>;-----------------------------------------------------------------------------</span>
stack0 <span style='color: teal;'>equ</span> -<span style='color: teal;'>256</span>
<span style='color: olive;'>;-----------------------------------------------------------------------------</span>
<span style='color: olive;'>; Set the starting point for the executable code. 0100h is the standard</span>
<span style='color: olive;'>; origin for programs running under MS-DOS or its equivalents.</span>
<span style='color: olive;'>;-----------------------------------------------------------------------------</span>
<span style='color: teal;'>org</span> <span style='color: teal;'>0100h</span>
<span style='color: olive;'>;-----------------------------------------------------------------------------</span>
<span style='color: olive;'>; Jump to the location of the start of Itsy's initialization code.</span>
<span style='color: olive;'>;-----------------------------------------------------------------------------</span>
<span style='color: navy;'>jmp</span> xt_abort+<span style='color: teal;'>2</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; System Variables</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; state - ( -- addr ) true = compiling, false = interpreting</span>
variable <span style='color: maroon; font-weight: bold;'>'state'</span>,state,<span style='color: teal;'>0</span>
<span style='color: olive;'>; >in - ( -- addr ) next character in input buffer</span>
variable <span style='color: maroon; font-weight: bold;'>'>in'</span>,to_in,<span style='color: teal;'>0</span>
<span style='color: olive;'>; #tib - ( -- addr ) number of characters in the input buffer</span>
variable <span style='color: maroon; font-weight: bold;'>'#tib'</span>,number_t_i_b,<span style='color: teal;'>0</span>
<span style='color: olive;'>; dp - ( -- addr ) first free cell in the dictionary</span>
variable <span style='color: maroon; font-weight: bold;'>'dp'</span>,dp,freemem
<span style='color: olive;'>; base - ( -- addr ) number base</span>
variable <span style='color: maroon; font-weight: bold;'>'base'</span>,base,<span style='color: teal;'>10</span>
<span style='color: olive;'>; last - ( -- addr ) the last word to be defined</span>
<span style='color: olive;'>; NOTE: The label "final:" must be placed immediately before</span>
<span style='color: olive;'>; the last word defined in this file. If new words are added,</span>
<span style='color: olive;'>; make sure they're either added before the "final:" label</span>
<span style='color: olive;'>; or the "final:" label is moved to the position immediately</span>
<span style='color: olive;'>; before the last word added.</span>
variable <span style='color: maroon; font-weight: bold;'>'last'</span>,last,final
<span style='color: olive;'>; tib - ( -- addr ) address of the input buffer</span>
constant <span style='color: maroon; font-weight: bold;'>'tib'</span>,t_i_b,<span style='color: teal;'>32768</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; Initialisation</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; abort - ( -- ) initialise Itsy then jump to interpret</span>
primitive <span style='color: maroon; font-weight: bold;'>'abort'</span>,abort
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: purple;'>word</span>[val_number_t_i_b] <span style='color: olive;'>; Load AX with the value contained</span>
<span style='color: olive;'>; in the data field of #tib (which</span>
<span style='color: olive;'>; was pre-defined above as 0).</span>
<span style='color: navy;'>mov</span> <span style='color: purple;'>word</span>[val_to_in],<span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Save the same number to >in.</span>
<span style='color: navy;'>xor</span> <span style='color: green; font-weight: bold;'>bp</span>,<span style='color: green; font-weight: bold;'>bp</span> <span style='color: olive;'>; Clear the bp register, which is going</span>
<span style='color: olive;'>; to be used as the return stack</span>
<span style='color: olive;'>; pointer. Since it'll first be</span>
<span style='color: olive;'>; decremented when a value is pushed</span>
<span style='color: olive;'>; onto it, this means that the first</span>
<span style='color: olive;'>; value pushed onto the return stack</span>
<span style='color: olive;'>; will be stored at 0FFFEh and 0FFFFh,</span>
<span style='color: olive;'>; the very end of memory space, and</span>
<span style='color: olive;'>; the stack will grow downward from</span>
<span style='color: olive;'>; there.</span>
<span style='color: navy;'>mov</span> <span style='color: purple;'>word</span>[val_state],<span style='color: green; font-weight: bold;'>bp</span> <span style='color: olive;'>; Clear the value of state.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>sp</span>,stack0 <span style='color: olive;'>; Set the stack pointer to the value</span>
<span style='color: olive;'>; defined above.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>si</span>,xt_interpret+<span style='color: teal;'>2</span> <span style='color: olive;'>; Initialize Itsy's instruction pointer</span>
<span style='color: olive;'>; to the outer interpreter loop.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Jump to the inner interpreter and</span>
<span style='color: olive;'>; actually start running Itsy.</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; Compilation</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; , - ( x -- ) compile x to the current definition.</span>
<span style='color: olive;'>; Stores the number on the stack to the memory location currently</span>
<span style='color: olive;'>; pointed to by dp.</span>
primitive <span style='color: maroon; font-weight: bold;'>','</span>,comma
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>di</span>,<span style='color: purple;'>word</span>[val_dp] <span style='color: olive;'>; Put the value of dp into the DI register.</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Move the top of the stack into AX.</span>
<span style='color: navy;'>stosw</span> <span style='color: olive;'>; Store the 16-bit value in AX directly</span>
<span style='color: olive;'>; into the address pointed to by DI, and</span>
<span style='color: olive;'>; automatically increment DI in the</span>
<span style='color: olive;'>; process.</span>
<span style='color: navy;'>mov</span> <span style='color: purple;'>word</span>[val_dp],<span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Store the incremented value in DI as the</span>
<span style='color: olive;'>; new value for the dictionary pointer.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Pop the new stack top into its proper place.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; lit - ( -- ) push the value in the cell straight after lit.</span>
<span style='color: olive;'>; lit is the word that is compiled into a definition when you put a</span>
<span style='color: olive;'>; "literal" number in a Forth definition. When your word is compiled,</span>
<span style='color: olive;'>; the CFA of lit gets stored in the definition followed immediately</span>
<span style='color: olive;'>; by the value of the number you put into the code. At run time, lit</span>
<span style='color: olive;'>; pushes the value of your number onto the stack.</span>
primitive <span style='color: maroon; font-weight: bold;'>'lit'</span>,lit
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Push the value in BX to the stack, so that now it'll</span>
<span style='color: olive;'>; be 2nd from the top on the stack. The old value is</span>
<span style='color: olive;'>; still in BX, though. Now we need to get the new</span>
<span style='color: olive;'>; value into BX.</span>
<span style='color: navy;'>lodsw</span> <span style='color: olive;'>; Load into the AX register the 16-bit value pointed</span>
<span style='color: olive;'>; to by the SI register (Itsy's instruction pointer,</span>
<span style='color: olive;'>; which this op then automatically increments SI by 2).</span>
<span style='color: olive;'>; The net result is that we just loaded into AX the</span>
<span style='color: olive;'>; 16-bit data immediately following the call to lit,</span>
<span style='color: olive;'>; which'll be the data that lit is supposed to load.</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Now swap the contents of the AX and BX registers.</span>
<span style='color: olive;'>; lit's data is now in BX, the top of the stack, where</span>
<span style='color: olive;'>; we want it. Slick, eh?</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; Stack</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; rot - ( x y z -- y z x ) rotate x, y and z.</span>
<span style='color: olive;'>; Standard Forth word that extracts number 3rd from the top of the stack</span>
<span style='color: olive;'>; and puts it on the top, effectively rotating the top 3 values.</span>
primitive <span style='color: maroon; font-weight: bold;'>'rot'</span>,rote
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>dx</span> <span style='color: olive;'>; Unload "y" from the stack.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Unload "x" from the stack. Remember that "z" is</span>
<span style='color: olive;'>; already in BX.</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>dx</span> <span style='color: olive;'>; Push "y" back onto the stack.</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Push "z" down into the stack on top of "y".</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Swap "x" into the BX register so that it's now</span>
<span style='color: olive;'>; at the top of the stack.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; drop - ( x -- ) remove x from the stack.</span>
primitive <span style='color: maroon; font-weight: bold;'>'drop'</span>,drop
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Pop the 2nd item on the stack into the BX register,</span>
<span style='color: olive;'>; writing over the item that was already at the top</span>
<span style='color: olive;'>; of the stack in BX. It's that simple.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; dup - ( x -- x x ) add a copy of x to the stack</span>
primitive <span style='color: maroon; font-weight: bold;'>'dup'</span>,dupe
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Remember that BX is the top of the stack. Push an</span>
<span style='color: olive;'>; extra copy of what's in BX onto the stack.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; # swap - ( x y -- y x ) exchange x and y</span>
primitive <span style='color: maroon; font-weight: bold;'>'swap'</span>,swap
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Pop "x", the number 2nd from the top, into AX.</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Push "y", the former top of the stack.</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Swap "x" into BX to become the new stack top. We</span>
<span style='color: olive;'>; don't care what happens to the value of "y" that</span>
<span style='color: olive;'>; ends up in AX because that value is now safely</span>
<span style='color: olive;'>; in the stack.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; Maths / Logic</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; + - ( x y -- z) calculate z=x+y then return z</span>
primitive <span style='color: maroon; font-weight: bold;'>'+'</span>,plus
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Pop the value of "x" off of the stack.</span>
<span style='color: navy;'>add</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Add "x" to the value of "y" that's at the top of the</span>
<span style='color: olive;'>; stack in the BX register. The way the opcode is</span>
<span style='color: olive;'>; written, the result is left in the BX register,</span>
<span style='color: olive;'>; conveniently at the top of the stack.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; = - ( x y -- flag ) return true if x=y</span>
primitive <span style='color: maroon; font-weight: bold;'>'='</span>,equals
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Get the "x" value into a register.</span>
<span style='color: navy;'>sub</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Perform BX-AX (or y-x)and leave result in BX. If x and</span>
<span style='color: olive;'>; y are equal, this will result in a 0 in BX. But a zero</span>
<span style='color: olive;'>; is a false flag in just about all Forth systems, and we</span>
<span style='color: olive;'>; want a TRUE flag if the numbers are equal. So...</span>
<span style='color: navy;'>sub</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: teal;'>1</span> <span style='color: olive;'>; Subtract 1 from it. If we had a zero before, now we've</span>
<span style='color: olive;'>; got a -1 (or 0ffffh), and a carry flag was generated.</span>
<span style='color: olive;'>; Any other value in BX will not generate a carry.</span>
<span style='color: navy;'>sbb</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; This has the effect of moving the carry bit into the BX</span>
<span style='color: olive;'>; register. So, if the numbers were not equal, then the</span>
<span style='color: olive;'>; "sub bx,1" didn't generate a carry, so the result will</span>
<span style='color: olive;'>; be a 0 in the BX (numbers were not equal, result is</span>
<span style='color: olive;'>; false). If the original numbers on the stack were equal,</span>
<span style='color: olive;'>; though, then the carry bit was set and then copied</span>
<span style='color: olive;'>; into the BX register to act as our true flag.</span>
<span style='color: olive;'>; This may seem a bit cryptic, but it produces smaller</span>
<span style='color: olive;'>; code and runs faster than a bunch of conditional jumps</span>
<span style='color: olive;'>; and immediate loads would.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; Peek and Poke</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; @ - ( addr -- x ) read x from addr</span>
<span style='color: olive;'>; "Fetch", as the name of this word is pronounced, reads a 16-bit number from</span>
<span style='color: olive;'>; a given memory address, the way the Basic "peek" command does, and leaves</span>
<span style='color: olive;'>; it at the top of the stack.</span>
primitive <span style='color: maroon; font-weight: bold;'>'@'</span>,fetch
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>bx</span>] <span style='color: olive;'>; Read the value in the memory address pointed to by</span>
<span style='color: olive;'>; the BX register and move that value directly into</span>
<span style='color: olive;'>; BX, replacing the address at the top of the stack.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; ! - ( x addr -- ) store x at addr</span>
<span style='color: olive;'>; Similar to @, ! ("store") writes a value directly to a memory address, like</span>
<span style='color: olive;'>; the Basic "poke" command.</span>
primitive <span style='color: maroon; font-weight: bold;'>'!'</span>,store
<span style='color: navy;'>pop</span> <span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>bx</span>] <span style='color: olive;'>; Okay, this is a bit slick. All in one opcode, we pop</span>
<span style='color: olive;'>; the number that's 2nd from the top of the stack</span>
<span style='color: olive;'>; (i.e. "x" in the argument list) and send it directly</span>
<span style='color: olive;'>; to the memory address pointed to by BX (the address</span>
<span style='color: olive;'>; at the top of the stack).</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Pop whatever was 3rd from the top of the stack into</span>
<span style='color: olive;'>; the BX register to become the new TOS.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Go do the next word.</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; Inner Interpreter</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; This routine is the very heart of the Forth system. After execution, all</span>
<span style='color: olive;'>; Forth words jump to this routine, which pulls up the code field address</span>
<span style='color: olive;'>; of the next word to be executed and then executes it. Note that next</span>
<span style='color: olive;'>; doesn't have a header of its own.</span>
next <span style='color: navy;'>lodsw</span> <span style='color: olive;'>; Load into the AX register the 16-bit value pointed</span>
<span style='color: olive;'>; to by the SI register (Itsy's instruction pointer,</span>
<span style='color: olive;'>; which this op then automatically increments SI by 2).</span>
<span style='color: olive;'>; The net result is that we just loaded into AX the</span>
<span style='color: olive;'>; CFA of the next word to be executed and left the</span>
<span style='color: olive;'>; instruction pointer pointing to the word that</span>
<span style='color: olive;'>; follows the next one.</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>di</span>,<span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Move the CFA of the next word into the DI register.</span>
<span style='color: olive;'>; We have to do this because the 8086 doesn't have</span>
<span style='color: olive;'>; an opcode for "jmp [ax]".</span>
<span style='color: navy;'>jmp</span> <span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>di</span>] <span style='color: olive;'>; Jump and start executing code at the address pointed</span>
<span style='color: olive;'>; to by the value in the DI register.</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; Flow Control</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; 0branch - ( x -- ) jump if x is zero</span>
<span style='color: olive;'>; This is the primitive word that's compiled as the runtime code in</span>
<span style='color: olive;'>; an IF...THEN statement. The number compiled into the word's definition</span>
<span style='color: olive;'>; immediately after 0branch is the address of the word in the definition</span>
<span style='color: olive;'>; that we're branching to. That address gets loaded into the instruction</span>
<span style='color: olive;'>; pointer. In essence, this word sees a false flag (i.e. a zero) and</span>
<span style='color: olive;'>; then jumps over the words that comprise the "do this if true" clause</span>
<span style='color: olive;'>; of an IF...ELSE...THEN statement.</span>
primitive <span style='color: maroon; font-weight: bold;'>'0branch'</span>,zero_branch
<span style='color: navy;'>lodsw</span> <span style='color: olive;'>; Load into the AX register the 16-bit value pointed</span>
<span style='color: olive;'>; to by the SI register (Itsy's instruction pointer,</span>
<span style='color: olive;'>; which this op then automatically increments SI by 2).</span>
<span style='color: olive;'>; The net result is that we just loaded into AX the</span>
<span style='color: olive;'>; CFA of the next word to be executed and left the</span>
<span style='color: olive;'>; instruction pointer pointing to the word that</span>
<span style='color: olive;'>; follows the next one.</span>
<span style='color: navy;'>test</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; See if there's a 0 at the top of the stack.</span>
<span style='color: navy;'>jne</span> zerob_z <span style='color: olive;'>; If it's not zero, jump.</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>si</span> <span style='color: olive;'>; If the flag is a zero, we want to move the CFA of</span>
<span style='color: olive;'>; the word we want to branch to into the Forth</span>
<span style='color: olive;'>; instruction pointer. If the TOS was non-zero, the</span>
<span style='color: olive;'>; instruction pointer is left still pointing to the CFA</span>
<span style='color: olive;'>; of the word that follows the branch reference.</span>
zerob_z <span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Throw away the flag and move everything on the stack</span>
<span style='color: olive;'>; up by one spot.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Oh, you know what this does by now...</span>
<span style='color: olive;'>; branch - ( addr -- ) unconditional jump</span>
<span style='color: olive;'>; This is one of the pieces of runtime code that's compiled by</span>
<span style='color: olive;'>; BEGIN/WHILE/REPEAT, BEGIN/AGAIN, and BEGIN/UNTIL loops. As with 0branch,</span>
<span style='color: olive;'>; the number compiled into the dictionary immediately after the branch is</span>
<span style='color: olive;'>; the address of the word in the definition that we're branching to.</span>
primitive <span style='color: maroon; font-weight: bold;'>'branch'</span>,branch
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>si</span>,<span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>si</span>] <span style='color: olive;'>; The instruction pointer has already been</span>
<span style='color: olive;'>; incremented to point to the address immediately</span>
<span style='color: olive;'>; following the branch statement, which means it's</span>
<span style='color: olive;'>; pointing to where our branch-to address is</span>
<span style='color: olive;'>; stored. This opcode takes the value pointed to</span>
<span style='color: olive;'>; by the SI register and loads it directly into</span>
<span style='color: olive;'>; the SI, which is used as Forth's instruction</span>
<span style='color: olive;'>; pointer.</span>
<span style='color: navy;'>jmp</span> next
<span style='color: olive;'>; execute - ( xt -- ) call the word at xt</span>
primitive <span style='color: maroon; font-weight: bold;'>'execute'</span>,execute
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>di</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Move the jump-to address to the DI register.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Pop the next number on the stack into the TOS.</span>
<span style='color: navy;'>jmp</span> <span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>di</span>] <span style='color: olive;'>; Jump to the address pointed to by the DI register.</span>
<span style='color: olive;'>; exit - ( -- ) return from the current word</span>
primitive <span style='color: maroon; font-weight: bold;'>'exit'</span>,exit
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>si</span>,<span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>bp</span>] <span style='color: olive;'>; The BP register is used as Itsy's return stack</span>
<span style='color: olive;'>; pointer. The value at its top is the address of</span>
<span style='color: olive;'>; the instruction being pointed to before the word</span>
<span style='color: olive;'>; currently being executed was called. This opcode</span>
<span style='color: olive;'>; loads that address into the SI register.</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>bp</span> <span style='color: olive;'>; Now we have to increment BP twice to do a manual</span>
<span style='color: olive;'>; "pop" of the return stack pointer.</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>bp</span> <span style='color: olive;'>; </span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; We jump to next with the SI now having the address</span>
<span style='color: olive;'>; pointing into the word that called the one we're</span>
<span style='color: olive;'>; finishing up now. The result is that next will go</span>
<span style='color: olive;'>; back into that calling word and pick up where it</span>
<span style='color: olive;'>; left off earlier.</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; String</span>
<span style='color: olive;'>; -------------------</span>
<span style='color: olive;'>; count - ( addr -- addr2 len )</span>
<span style='color: olive;'>; count is given the address of a counted string (like the name field of a</span>
<span style='color: olive;'>; word definition in Forth, with the first byte being the number of</span>
<span style='color: olive;'>; characters in the string and immediately followed by the characters</span>
<span style='color: olive;'>; themselves). It returns the length of the string and a pointer to the</span>
<span style='color: olive;'>; first actual character in the string.</span>
primitive <span style='color: maroon; font-weight: bold;'>'count'</span>,count
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Increment the address past the length byte so</span>
<span style='color: olive;'>; it now points to the actual string.</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Push the new address onto the stack.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>bl</span>,<span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>bx</span>-<span style='color: teal;'>1</span>] <span style='color: olive;'>; Move the length byte into the lower half of</span>
<span style='color: olive;'>; the BX register.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>bh</span>,<span style='color: teal;'>0</span> <span style='color: olive;'>; Load a 0 into the upper half of the BX reg.</span>
<span style='color: navy;'>jmp</span> next
<span style='color: olive;'>; >number - ( double addr len -- double2 addr2 zero ) if successful, or</span>
<span style='color: olive;'>; ( double addr len -- int addr2 nonzero ) on error.</span>
<span style='color: olive;'>; Convert a string to an unsigned double-precision integer.</span>
<span style='color: olive;'>; addr points to a string of len characters which >number attempts to</span>
<span style='color: olive;'>; convert to a number using the current number base. >number returns</span>
<span style='color: olive;'>; the portion of the string which can't be converted, if any.</span>
<span style='color: olive;'>; Note that, as is standard for most Forths, >number attempts to</span>
<span style='color: olive;'>; convert a number into a double (most Forths also leave it as a double</span>
<span style='color: olive;'>; if they find a decimal point, but >number doesn't check for that) and</span>
<span style='color: olive;'>; that it's called with a dummy double value already on the stack.</span>
<span style='color: olive;'>; On return, if the top of the stack is 0, the number was successfully</span>
<span style='color: olive;'>; converted. If the top of the stack is non-zero, there was an error.</span>
primitive <span style='color: maroon; font-weight: bold;'>'>number'</span>,to_number
<span style='color: olive;'>; Start out by loading values from the stack</span>
<span style='color: olive;'>; into various registers. Remember that the</span>
<span style='color: olive;'>; top of the stack, the string length, is</span>
<span style='color: olive;'>; already in bx.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Put the address into di.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>cx</span> <span style='color: olive;'>; Put the high word of the double value into cx</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; and the low word of the double value into ax.</span>
to_numl <span style='color: navy;'>test</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Test the length byte.</span>
<span style='color: navy;'>je</span> to_numz <span style='color: olive;'>; If the string's length is zero, we're done.</span>
<span style='color: olive;'>; Jump to end.</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Push the contents of ax (low word) so we can</span>
<span style='color: olive;'>; use it for other things.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>di</span>] <span style='color: olive;'>; Get the next byte in the string.</span>
<span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: maroon; font-weight: bold;'>'a'</span> <span style='color: olive;'>; Compare it to a lower-case 'a'.</span>
<span style='color: navy;'>jc</span> to_nums <span style='color: olive;'>; "jc", "jump if carry", is a little cryptic.</span>
<span style='color: olive;'>; I think a better choice of mnemonic would be</span>
<span style='color: olive;'>; "jb", "jump if below", for understanding</span>
<span style='color: olive;'>; what's going on here. Jump if the next byte</span>
<span style='color: olive;'>; in the string is less than 'a'. If the chr</span>
<span style='color: olive;'>; is greater than or equal to 'a', then it may</span>
<span style='color: olive;'>; be a digit larger than 9 in a hex number.</span>
<span style='color: navy;'>sub</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>32</span> <span style='color: olive;'>; Subtract 32 from the character. If we're</span>
<span style='color: olive;'>; converting hexadecimal input, this'll have</span>
<span style='color: olive;'>; the effect of converting lower case to</span>
<span style='color: olive;'>; upper case.</span>
to_nums <span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: maroon; font-weight: bold;'>'9'</span>+<span style='color: teal;'>1</span> <span style='color: olive;'>; Compare the character to whatever character</span>
<span style='color: olive;'>; comes after '9'.</span>
<span style='color: navy;'>jc</span> to_numg <span style='color: olive;'>; If it's '9' or less, it's possibly a decimal</span>
<span style='color: olive;'>; digit. Jump for further testing.</span>
<span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: maroon; font-weight: bold;'>'A'</span> <span style='color: olive;'>; Compare the character with 'A'.</span>
<span style='color: navy;'>jc</span> to_numh <span style='color: olive;'>; If it's one of those punctuation marks</span>
<span style='color: olive;'>; between '9' and 'A', we've got an error.</span>
<span style='color: olive;'>; Jump to the end.</span>
<span style='color: navy;'>sub</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>7</span> <span style='color: olive;'>; The character is a potentially valid digit</span>
<span style='color: olive;'>; for a base larger than 10. Resize it so</span>
<span style='color: olive;'>; that 'A' becomes the digit for 11, 'B'</span>
<span style='color: olive;'>; signifies a 11, etc.</span>
to_numg <span style='color: navy;'>sub</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>48</span> <span style='color: olive;'>; Convert the digit to its corresponding</span>
<span style='color: olive;'>; number. This op could also have been</span>
<span style='color: olive;'>; written as "sub al,'0'"</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>ah</span>,<span style='color: teal;'>0</span> <span style='color: olive;'>; Clear the ah register. The AX reg now</span>
<span style='color: olive;'>; contains the numeric value of the new digit.</span>
<span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: purple;'>byte</span>[val_base] <span style='color: olive;'>; Compare the digit's value to the base.</span>
<span style='color: navy;'>jnc</span> to_numh <span style='color: olive;'>; If the digit's value is above or equal to</span>
<span style='color: olive;'>; to the base, we've got an error. Jump to end.</span>
<span style='color: olive;'>; (I think using "jae" would be less cryptic.)</span>
<span style='color: olive;'>; (NASM's documentation doesn't list jae as a</span>
<span style='color: olive;'>; valid opcode, but then again, it doesn't</span>
<span style='color: olive;'>; list jnc in its opcode list either.)</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>dx</span> <span style='color: olive;'>; Save the digit value in AX by swapping it</span>
<span style='color: olive;'>; the contents of DX. (We don't care what's</span>
<span style='color: olive;'>; in DX; it's scratchpad.)</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Recall the low word of our accumulated</span>
<span style='color: olive;'>; double number and load it into AX.</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>dx</span> <span style='color: olive;'>; Save the digit value. (The DX register</span>
<span style='color: olive;'>; will get clobbered by the upcoming mul.)</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>cx</span> <span style='color: olive;'>; Swap the low and high words of our double</span>
<span style='color: olive;'>; number. AX now holds the high word, and</span>
<span style='color: olive;'>; CX the low.</span>
<span style='color: navy;'>mul</span> <span style='color: purple;'>word</span>[val_base] <span style='color: olive;'>; 16-bit multiply the high word by the base.</span>
<span style='color: olive;'>; High word of product is in DX, low in AX.</span>
<span style='color: olive;'>; But we don't need the high word. It's going</span>
<span style='color: olive;'>; to get overwritten by the next mul.</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>cx</span> <span style='color: olive;'>; Save the product of the first mul to the CX</span>
<span style='color: olive;'>; register and put the low word of our double</span>
<span style='color: olive;'>; number back into AX.</span>
<span style='color: navy;'>mul</span> <span style='color: purple;'>word</span>[val_base] <span style='color: olive;'>; 16-bit multiply the low word of our converted</span>
<span style='color: olive;'>; double number by the base, then add the high</span>
<span style='color: navy;'>add</span> <span style='color: green; font-weight: bold;'>cx</span>,<span style='color: green; font-weight: bold;'>dx</span> <span style='color: olive;'>; word of the product to the low word of the</span>
<span style='color: olive;'>; first mul (i.e. do the carry).</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>dx</span> <span style='color: olive;'>; Recall the digit value, then add it in to</span>
<span style='color: navy;'>add</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>dx</span> <span style='color: olive;'>; the low word of our accumulated double-</span>
<span style='color: olive;'>; precision total.</span>
<span style='color: olive;'>; NOTE: One might think, as I did at first,</span>
<span style='color: olive;'>; that we need to deal with the carry from</span>
<span style='color: olive;'>; this operation. But we just multiplied</span>
<span style='color: olive;'>; the number by the base, and then added a</span>
<span style='color: olive;'>; number that's already been checked to be</span>
<span style='color: olive;'>; smaller than the base. In that case, there</span>
<span style='color: olive;'>; will never be a carry out from this</span>
<span style='color: olive;'>; addition. Think about it: You multiply a</span>
<span style='color: olive;'>; number by 10 and get a new number whose</span>
<span style='color: olive;'>; lowest digit is a zero. Then you add another</span>
<span style='color: olive;'>; number less than 10 to it. You'll NEVER get</span>
<span style='color: olive;'>; a carry from adding zero and a number less</span>
<span style='color: olive;'>; than 10.</span>
<span style='color: navy;'>dec</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Decrement the length.</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Inc the address pointer to the next byte</span>
<span style='color: olive;'>; of the string we're converting.</span>
<span style='color: navy;'>jmp</span> to_numl <span style='color: olive;'>; Jump back and convert any remaining</span>
<span style='color: olive;'>; characters in the string.</span>
to_numz <span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Push the low word of the accumulated total</span>
<span style='color: olive;'>; back onto the stack.</span>
to_numh <span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>cx</span> <span style='color: olive;'>; Push the high word of the accumulated total</span>
<span style='color: olive;'>; back onto the stack.</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Push the string address back onto the stack.</span>
<span style='color: olive;'>; Note that the character count is still in</span>
<span style='color: olive;'>; BX and is therefore already at the top of</span>
<span style='color: olive;'>; the stack. If BX is zero at this point,</span>
<span style='color: olive;'>; we've successfully converted the number.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Done. Return to caller.</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; Terminal Input / Output</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; accept - ( addr len -- len2 ) read a string from the terminal</span>
<span style='color: olive;'>; accept reads a string of characters from the terminal. The string</span>
<span style='color: olive;'>; is stored at addr and can be up to len characters long.</span>
<span style='color: olive;'>; accept returns the actual length of the string.</span>
primitive <span style='color: maroon; font-weight: bold;'>'accept'</span>,accept
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Pop the address of the string buffer into DI.</span>
<span style='color: navy;'>xor</span> <span style='color: green; font-weight: bold;'>cx</span>,<span style='color: green; font-weight: bold;'>cx</span> <span style='color: olive;'>; Clear the CX register.</span>
acceptl <span style='color: navy;'>call</span> getchar <span style='color: olive;'>; Do the bios call to get a chr from the keyboard.</span>
<span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>8</span> <span style='color: olive;'>; See if it's a backspace (ASCII character 08h).</span>
<span style='color: navy;'>jne</span> acceptn <span style='color: olive;'>; If not, jump for more testing.</span>
<span style='color: navy;'>jcxz</span> acceptb <span style='color: olive;'>; "Jump if CX=0". If the user typed a backspace but</span>
<span style='color: olive;'>; there isn't anything in the buffer to erase, jump</span>
<span style='color: olive;'>; to the code that'll beep at him to let him know.</span>
<span style='color: navy;'>call</span> outchar <span style='color: olive;'>; User typed a backspace. Go ahead and output it.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: maroon; font-weight: bold;'>' '</span> <span style='color: olive;'>; Then output a space to wipe out the character that</span>
<span style='color: navy;'>call</span> outchar <span style='color: olive;'>; the user had just typed.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>8</span> <span style='color: olive;'>; Then output another backspace to put the cursor</span>
<span style='color: navy;'>call</span> outchar <span style='color: olive;'>; back into position to read another character.</span>
<span style='color: navy;'>dec</span> <span style='color: green; font-weight: bold;'>cx</span> <span style='color: olive;'>; We just deleted a character. Now we need to decrement</span>
<span style='color: navy;'>dec</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; both the counter and the buffer pointer.</span>
<span style='color: navy;'>jmp</span> acceptl <span style='color: olive;'>; Then go back for another character.</span>
acceptn <span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>13</span> <span style='color: olive;'>; See if the input chr is a carriage return.</span>
<span style='color: navy;'>je</span> acceptz <span style='color: olive;'>; If so, we're done. jump to the end of the routine.</span>
<span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>cx</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Compare current string length to the maximum allowed.</span>
<span style='color: navy;'>jne</span> accepts <span style='color: olive;'>; If the string's not too long, jump.</span>
acceptb <span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>7</span> <span style='color: olive;'>; User's input is unusable in some way. Send the</span>
<span style='color: navy;'>call</span> outchar <span style='color: olive;'>; BEL chr to make a beep sound to let him know.</span>
<span style='color: navy;'>jmp</span> acceptl <span style='color: olive;'>; Then go back and let him try again.</span>
accepts <span style='color: navy;'>stosb</span> <span style='color: olive;'>; Save the input character into the buffer. Note that</span>
<span style='color: olive;'>; this opcode automatically increments the pointer</span>
<span style='color: olive;'>; in the DI register.</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>cx</span> <span style='color: olive;'>; But we have to increment the length counter manually.</span>
<span style='color: navy;'>call</span> outchar <span style='color: olive;'>; Echo the input character back to the display.</span>
<span style='color: navy;'>jmp</span> acceptl <span style='color: olive;'>; Go back for another character.</span>
acceptz <span style='color: navy;'>jcxz</span> acceptb <span style='color: olive;'>; If the buffer is empty, beep at the user and go</span>
<span style='color: olive;'>; back for more input.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>13</span> <span style='color: olive;'>; Send a carriage return to the display...</span>
<span style='color: navy;'>call</span> outchar <span style='color: olive;'>; </span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>10</span> <span style='color: olive;'>; ...followed by a linefeed.</span>
<span style='color: navy;'>call</span> outchar <span style='color: olive;'>; </span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: green; font-weight: bold;'>cx</span> <span style='color: olive;'>; Move the count to the top of the stack.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; </span>
<span style='color: olive;'>; word - ( char -- addr ) parse the next word in the input buffer</span>
<span style='color: olive;'>; word scans the "terminal input buffer" (whose address is given by the</span>
<span style='color: olive;'>; system constant tib) for words to execute, starting at the current</span>
<span style='color: olive;'>; address stored in the input buffer pointer >in. The character on the</span>
<span style='color: olive;'>; stack when word is called is the one that the code will look for as</span>
<span style='color: olive;'>; the separator between words. 999 times out of 1000,; this is going to</span>
<span style='color: olive;'>; be a space.</span>
primitive <span style='color: maroon; font-weight: bold;'>'word'</span>,<span style='color: purple;'>word</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>di</span>,<span style='color: purple;'>word</span>[val_dp] <span style='color: olive;'>; Load the dictionary pointer into DI.</span>
<span style='color: olive;'>; This is going to be the address that</span>
<span style='color: olive;'>; we copy the input word to. For the</span>
<span style='color: olive;'>; sake of tradition, let's call this</span>
<span style='color: olive;'>; scratchpad area the "pad".</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Save the pad pointer to the stack.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>dx</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Copy the word separator to DX.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: purple;'>word</span>[val_t_i_b] <span style='color: olive;'>; Load the address of the input buffer</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>cx</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; into BX, and save a copy to CX.</span>
<span style='color: navy;'>add</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: purple;'>word</span>[val_to_in] <span style='color: olive;'>; Add the value of >in to the address</span>
<span style='color: olive;'>; of tib to get a pointer into the</span>
<span style='color: olive;'>; buffer.</span>
<span style='color: navy;'>add</span> <span style='color: green; font-weight: bold;'>cx</span>,<span style='color: purple;'>word</span>[val_number_t_i_b] <span style='color: olive;'>; Add the value of #tib to the address</span>
<span style='color: olive;'>; of tib to get a pointer to the last</span>
<span style='color: olive;'>; chr in the input buffer.</span>
wordf <span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>cx</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Compare the current buffer pointer to</span>
<span style='color: olive;'>; the end-of-buffer pointer.</span>
<span style='color: navy;'>je</span> wordz <span style='color: olive;'>; If we've reached the end, jump.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>bx</span>] <span style='color: olive;'>; Get the next chr from the buffer</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; and increment the pointer.</span>
<span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: green; font-weight: bold;'>dl</span> <span style='color: olive;'>; See if it's the separator.</span>
<span style='color: navy;'>je</span> wordf <span style='color: olive;'>; If so, jump.</span>
wordc <span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Increment our pad pointer. Note that</span>
<span style='color: olive;'>; if this is our first time through the</span>
<span style='color: olive;'>; routine, we're incrementing to the</span>
<span style='color: olive;'>; 2nd address in the pad, leaving the</span>
<span style='color: olive;'>; first byte of it empty.</span>
<span style='color: navy;'>mov</span> <span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>di</span>],<span style='color: green; font-weight: bold;'>al</span> <span style='color: olive;'>; Write the new chr to the pad.</span>
<span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>cx</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Have we reached the end of the</span>
<span style='color: olive;'>; input buffer?</span>
<span style='color: navy;'>je</span> wordz <span style='color: olive;'>; If so, jump.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>bx</span>] <span style='color: olive;'>; Get another byte from the input</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; buffer and increment the pointer.</span>
<span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: green; font-weight: bold;'>dl</span> <span style='color: olive;'>; Is the new chr a separator?</span>
<span style='color: navy;'>jne</span> wordc <span style='color: olive;'>; If not, go back for more.</span>
wordz <span style='color: navy;'>mov</span> <span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>di</span>+<span style='color: teal;'>1</span>],<span style='color: teal;'>32</span> <span style='color: olive;'>; Write a space at the end of the text</span>
<span style='color: olive;'>; we've written so far to the pad.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: purple;'>word</span>[val_dp] <span style='color: olive;'>; Load the address of the pad into AX.</span>
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Swap the pad address with the pad</span>
<span style='color: navy;'>sub</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; pointer then subtract to get the</span>
<span style='color: olive;'>; length of the text in the pad.</span>
<span style='color: olive;'>; The result goes into AX, leaving the</span>
<span style='color: olive;'>; pad address in DI.</span>
<span style='color: navy;'>mov</span> <span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>di</span>],<span style='color: green; font-weight: bold;'>al</span> <span style='color: olive;'>; Save the length byte into the first</span>
<span style='color: olive;'>; byte of the pad.</span>
<span style='color: navy;'>sub</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: purple;'>word</span>[val_t_i_b] <span style='color: olive;'>; Subtract the base address of the</span>
<span style='color: olive;'>; input buffer from the pointer value</span>
<span style='color: olive;'>; to get the new value of >in...</span>
<span style='color: navy;'>mov</span> <span style='color: purple;'>word</span>[val_to_in],<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; ...then save it to its variable.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Pop the value of the pad address</span>
<span style='color: olive;'>; that we saved earlier back out to</span>
<span style='color: olive;'>; the top of the stack as our return</span>
<span style='color: olive;'>; value.</span>
<span style='color: navy;'>jmp</span> next
<span style='color: olive;'>; emit - ( char -- ) display char on the terminal</span>
primitive <span style='color: maroon; font-weight: bold;'>'emit'</span>,emit
<span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Move our output character to the AX register.</span>
<span style='color: navy;'>call</span> outchar <span style='color: olive;'>; Send it to the display.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Pop the argument off the stack.</span>
<span style='color: navy;'>jmp</span> next
getchar <span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>ah</span>,<span style='color: teal;'>7</span> <span style='color: olive;'>; This headerless routine does an MS-DOS Int 21h call,</span>
<span style='color: navy;'>int</span> <span style='color: teal;'>021h</span> <span style='color: olive;'>; reading a character from the standard input device into</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>ah</span>,<span style='color: teal;'>0</span> <span style='color: olive;'>; the AL register. We start out by putting a 7 into AH to</span>
<span style='color: navy;'>ret</span> <span style='color: olive;'>; identify the function we want to perform. The character</span>
<span style='color: olive;'>; gets returned in AL, and then we manually clear out</span>
<span style='color: olive;'>; AH so that we can have a 16-bit result in AX.</span>
outchar <span style='color: navy;'>xchg</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: green; font-weight: bold;'>dx</span> <span style='color: olive;'>; This headerless routine does an MS-DOS Int 21h call,</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>ah</span>,<span style='color: teal;'>2</span> <span style='color: olive;'>; sending a character in the DL register to the standard</span>
<span style='color: navy;'>int</span> <span style='color: teal;'>021h</span> <span style='color: olive;'>; output device. The 2 in the AH register identifies what</span>
<span style='color: navy;'>ret</span> <span style='color: olive;'>; function we want to perform.</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; Dictionary Search</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; find - ( addr -- addr2 flag ) look up word in the dictionary</span>
<span style='color: olive;'>; find looks in the Forth dictionary for a word with the name given in the</span>
<span style='color: olive;'>; counted string at addr. One of the following will be returned:</span>
<span style='color: olive;'>; flag = 0, addr2 = counted string --> word was not found</span>
<span style='color: olive;'>; flag = 1, addr2 = call address --> word is immediate</span>
<span style='color: olive;'>; flag = -1, addr2 = call address --> word is not immediate</span>
primitive <span style='color: maroon; font-weight: bold;'>'find'</span>,find
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>di</span>,val_last <span style='color: olive;'>; Get the address of the link field of the last</span>
<span style='color: olive;'>; word in the dictionary. Put it in DI.</span>
findl <span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Save the link field pointer.</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Save the address of the name we're looking for.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>cl</span>,<span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>bx</span>] <span style='color: olive;'>; Copy the length of the string into CL</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>ch</span>,<span style='color: teal;'>0</span> <span style='color: olive;'>; Clear CH to make a 16 bit counter.</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>cx</span> <span style='color: olive;'>; Increment the counter.</span>
findc <span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>di</span>+<span style='color: teal;'>2</span>] <span style='color: olive;'>; Get the length byte of whatever word in the</span>
<span style='color: olive;'>; dictionary we're currently looking at.</span>
<span style='color: navy;'>and</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>07Fh</span> <span style='color: olive;'>; Mask off the immediate bit.</span>
<span style='color: navy;'>cmp</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>bx</span>] <span style='color: olive;'>; Compare it with the length of the string.</span>
<span style='color: navy;'>je</span> findm <span style='color: olive;'>; If they're the same, jump.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Nope, can't be the same if the lengths are</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; different. Pop the saved values back to regs.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>di</span>,<span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>di</span>] <span style='color: olive;'>; Get the next link address.</span>
<span style='color: navy;'>test</span> <span style='color: green; font-weight: bold;'>di</span>,<span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; See if it's zero. If it's not, then we've not</span>
<span style='color: navy;'>jne</span> findl <span style='color: olive;'>; hit the end of the dictionary yet. Then jump</span>
<span style='color: olive;'>; back and check the next word in the dictionary.</span>
findnf <span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; End of dictionary. Word wasn't found. Push the</span>
<span style='color: olive;'>; string address to the stack.</span>
<span style='color: navy;'>xor</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Clear the BX register (make a "false" flag).</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Return to caller.</span>
findm <span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; The lengths match, but do the chrs? Increment</span>
<span style='color: olive;'>; the link field pointer. (That may sound weird,</span>
<span style='color: olive;'>; especially on the first time through this loop.</span>
<span style='color: olive;'>; But remember that, earlier in the loop, we</span>
<span style='color: olive;'>; loaded the length byte out the dictionary by an</span>
<span style='color: olive;'>; indirect reference to DI+2. We'll do that again</span>
<span style='color: olive;'>; in a moment, so what in effect we're actually</span>
<span style='color: olive;'>; doing here is incrementing what's now going to</span>
<span style='color: olive;'>; be treated as a string pointer for the name in</span>
<span style='color: olive;'>; the dictionary as we compare the characters</span>
<span style='color: olive;'>; in the strings.)</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Increment the pointer to the string we're</span>
<span style='color: olive;'>; checking.</span>
<span style='color: navy;'>loop</span> findc <span style='color: olive;'>; Decrements the counter in CX and, if it's not</span>
<span style='color: olive;'>; zero yet, loops back. The same code that started</span>
<span style='color: olive;'>; out comparing the length bytes will go through</span>
<span style='color: olive;'>; and compare the characters in the string with</span>
<span style='color: olive;'>; the chrs in the dictionary name we're pointing</span>
<span style='color: olive;'>; at.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; If we got here, then the strings match. The</span>
<span style='color: olive;'>; word is in the dictionary. Pop the string's</span>
<span style='color: olive;'>; starting address and throw it away. We don't</span>
<span style='color: olive;'>; need it now that we know we're looking at a</span>
<span style='color: olive;'>; defined word.</span>
<span style='color: navy;'>pop</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Restore the link field address for the dictionary</span>
<span style='color: olive;'>; word whose name we just looked at.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: teal;'>1</span> <span style='color: olive;'>; Put a 1 at the top of the stack.</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Increment the pointer past the link field to the</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; name field.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>di</span>] <span style='color: olive;'>; Get the length of the word's name.</span>
<span style='color: navy;'>test</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: teal;'>080h</span> <span style='color: olive;'>; See if it's an immediate.</span>
<span style='color: navy;'>jne</span> findi <span style='color: olive;'>; "test" basically performs an AND without</span>
<span style='color: olive;'>; actually changing the register. If the</span>
<span style='color: olive;'>; immediate bit is set, we'll have a non-zero</span>
<span style='color: olive;'>; result and we'll skip the next instruction,</span>
<span style='color: olive;'>; leaving a 1 in BX to represent that we found</span>
<span style='color: olive;'>; an immediate word.</span>
<span style='color: navy;'>neg</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; But if it's not an immediate word, we fall</span>
<span style='color: olive;'>; through and generate a -1 instead to get the</span>
<span style='color: olive;'>; flag for a non-immediate word.</span>
findi <span style='color: navy;'>and</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: teal;'>31</span> <span style='color: olive;'>; Mask off all but the valid part of the name's</span>
<span style='color: olive;'>; length byte.</span>
<span style='color: navy;'>add</span> <span style='color: green; font-weight: bold;'>di</span>,<span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Add the length to the name field address then</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; add 1 to get the address of the code field.</span>
<span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>di</span> <span style='color: olive;'>; Push the CFA onto the stack.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; We're done.</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; Colon Definition</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; : - ( -- ) define a new Forth word, taking the name from the input buffer.</span>
<span style='color: olive;'>; Ah! We've finally found a word that's actually defined as a Forth colon</span>
<span style='color: olive;'>; definition rather than an assembly language routine! Partly, anyway; the</span>
<span style='color: olive;'>; first part is Forth code, but the end is the assembly language run-time</span>
<span style='color: olive;'>; routine that, incidentally, executes Forth colon definitions. Notice that</span>
<span style='color: olive;'>; the first part is not a sequence of opcodes, but rather is a list of</span>
<span style='color: olive;'>; code field addresses for the words used in the definition. In each code</span>
<span style='color: olive;'>; field of each defined word is an "execution tag", or "xt", a pointer to</span>
<span style='color: olive;'>; the runtime code that executes the word. In a Forth colon definition, this</span>
<span style='color: olive;'>; is going to be a pointer to the docolon routine we see in the second part</span>
<span style='color: olive;'>; of the definition of colon itself below.</span>
colon <span style='color: maroon; font-weight: bold;'>':'</span>,colon
<span style='color: teal;'>dw</span> xt_lit,-<span style='color: teal;'>1</span> <span style='color: olive;'>; If you write a Forth routine where you put an</span>
<span style='color: olive;'>; integer number right in the code, such as the</span>
<span style='color: olive;'>; 2 in the phrase, "dp @ 2 +", lit is the name</span>
<span style='color: olive;'>; of the routine that's called at runtime to put</span>
<span style='color: olive;'>; that integer on the stack. Here, lit pushes</span>
<span style='color: olive;'>; the -1 stored immediately after it onto the</span>
<span style='color: olive;'>; stack.</span>
<span style='color: teal;'>dw</span> xt_state <span style='color: olive;'>; The runtime code for a variable leaves its</span>
<span style='color: olive;'>; address on the stack. The address of state,</span>
<span style='color: olive;'>; in this case.</span>
<span style='color: teal;'>dw</span> xt_store <span style='color: olive;'>; Store that -1 into state to tell the system</span>
<span style='color: olive;'>; that we're switching from interpret mode into</span>
<span style='color: olive;'>; compile mode. Other than creating the header,</span>
<span style='color: olive;'>; colon doesn't actually compile the words into</span>
<span style='color: olive;'>; the new word. That task is performed in</span>
<span style='color: olive;'>; interpret, but it needs this new value stored</span>
<span style='color: olive;'>; into state to tell it to do so.</span>
<span style='color: teal;'>dw</span> xt_create <span style='color: olive;'>; Now we call the word that's going to create the</span>
<span style='color: olive;'>; header for the new colon definition we're going</span>
<span style='color: olive;'>; to compile.</span>
<span style='color: teal;'>dw</span> xt_do_semi_code <span style='color: olive;'>; Write, into the code field of the header we just</span>
<span style='color: olive;'>; created, the address that immediately follows</span>
<span style='color: olive;'>; this statement: the address of the docolon</span>
<span style='color: olive;'>; routine, which is the code that's responsible</span>
<span style='color: olive;'>; for executing the colon definition we're</span>
<span style='color: olive;'>; creating.</span>
docolon <span style='color: navy;'>dec</span> <span style='color: green; font-weight: bold;'>bp</span> <span style='color: olive;'>; Here's the runtime code for colon words.</span>
<span style='color: navy;'>dec</span> <span style='color: green; font-weight: bold;'>bp</span> <span style='color: olive;'>; Basically, what docolon does is similar to</span>
<span style='color: olive;'>; calling a subroutine, in that we have to push</span>
<span style='color: olive;'>; the return address to the stack. Since the 80x86</span>
<span style='color: olive;'>; doesn't directly support more than one stack and</span>
<span style='color: olive;'>; the "real" stack is used for data, we have to</span>
<span style='color: olive;'>; operate the Forth virtual machine's return stack</span>
<span style='color: olive;'>; manually. So, first, we manually decrement the</span>
<span style='color: olive;'>; return stack pointer twice to point to where</span>
<span style='color: olive;'>; we're going to save the return address.</span>
<span style='color: navy;'>mov</span> <span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>bp</span>],<span style='color: green; font-weight: bold;'>si</span> <span style='color: olive;'>; Then we write that address directly from the</span>
<span style='color: olive;'>; instruction pointer to that location.</span>
<span style='color: navy;'>lea</span> <span style='color: green; font-weight: bold;'>si</span>,[<span style='color: green; font-weight: bold;'>di</span>+<span style='color: teal;'>2</span>] <span style='color: olive;'>; We now have to tell Forth to start running the</span>
<span style='color: olive;'>; words in the colon definition we just started.</span>
<span style='color: olive;'>; The value in DI was left pointing at the code</span>
<span style='color: olive;'>; field of the word that we just started that just</span>
<span style='color: olive;'>; jumped into docolon. By loading into the</span>
<span style='color: olive;'>; instruction pointer the value that's 2 bytes</span>
<span style='color: olive;'>; later, at the start of the data field, we're</span>
<span style='color: olive;'>; loading into the IP the address of the first</span>
<span style='color: olive;'>; word in that definition. Execution of the other</span>
<span style='color: olive;'>; words in that definition will occur in sequence</span>
<span style='color: olive;'>; from here on.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Now that we're pointing to the correct</span>
<span style='color: olive;'>; instruction, go do it.</span>
<span style='color: olive;'>; ; - ( -- ) complete the Forth word being compiled</span>
colon <span style='color: maroon; font-weight: bold;'>';'</span>,semicolon,immediate
<span style='color: olive;'>; Note above that ; is immediate, the first such</span>
<span style='color: olive;'>; word we've seen here. It needs to be so because</span>
<span style='color: olive;'>; it's used only during the compilation of a colon</span>
<span style='color: olive;'>; definition and we want it to execute rather than</span>
<span style='color: olive;'>; just being stored in the definition.</span>
<span style='color: teal;'>dw</span> xt_lit,xt_exit <span style='color: olive;'>; Put the address of the code field of exit onto</span>
<span style='color: olive;'>; the stack.</span>
<span style='color: teal;'>dw</span> xt_comma <span style='color: olive;'>; Store it into the dictionary.</span>
<span style='color: teal;'>dw</span> xt_lit,<span style='color: teal;'>0</span> <span style='color: olive;'>; Now put a zero on the stack...</span>
<span style='color: teal;'>dw</span> xt_state <span style='color: olive;'>; along with the address of the state variable.</span>
<span style='color: teal;'>dw</span> xt_store <span style='color: olive;'>; Store the 0 into state to indicate that we're</span>
<span style='color: olive;'>; done compiling a word and are now back into</span>
<span style='color: olive;'>; interpret mode.</span>
<span style='color: teal;'>dw</span> xt_exit <span style='color: olive;'>; exit is the routine that finishes up the</span>
<span style='color: olive;'>; execution of a colon definition and jumps to</span>
<span style='color: olive;'>; next in order to start execution of the next</span>
<span style='color: olive;'>; word.</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; Headers</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; create - ( -- ) build a header for a new word in the dictionary, taking</span>
<span style='color: olive;'>; the name from the input buffer</span>
colon <span style='color: maroon; font-weight: bold;'>'create'</span>,create
<span style='color: teal;'>dw</span> xt_dp,xt_fetch <span style='color: olive;'>; Get the current dictionary pointer.</span>
<span style='color: teal;'>dw</span> xt_last,xt_fetch <span style='color: olive;'>; Get the LFA of the last word in the dictionary.</span>
<span style='color: teal;'>dw</span> xt_comma <span style='color: olive;'>; Save the value of last at the current point in</span>
<span style='color: olive;'>; the dictionary to become the link field for</span>
<span style='color: olive;'>; the header we're creating. Remember that comma</span>
<span style='color: olive;'>; automatically increments the value of dp.</span>
<span style='color: teal;'>dw</span> xt_last,xt_store <span style='color: olive;'>; Save the address of the link field we just</span>
<span style='color: olive;'>; created as the new value of last.</span>
<span style='color: teal;'>dw</span> xt_lit,<span style='color: teal;'>32</span> <span style='color: olive;'>; Parse the input buffer for the name of the</span>
<span style='color: teal;'>dw</span> xt_word <span style='color: olive;'>; word we're creating, using a space for the</span>
<span style='color: olive;'>; separation character when we invoke word.</span>
<span style='color: olive;'>; Remember that word copies the parsed name</span>
<span style='color: olive;'>; as a counted string to the location pointed</span>
<span style='color: olive;'>; to by dp, which not coincidentally is</span>
<span style='color: olive;'>; exactly what and where we need it for the</span>
<span style='color: olive;'>; header we're creating.</span>
<span style='color: teal;'>dw</span> xt_count <span style='color: olive;'>; Get the address of the first character of the</span>
<span style='color: olive;'>; word's name, and the name's length.</span>
<span style='color: teal;'>dw</span> xt_plus <span style='color: olive;'>; Add the length to the address to get the addr</span>
<span style='color: olive;'>; of the first byte after the name, then store</span>
<span style='color: teal;'>dw</span> xt_dp,xt_store <span style='color: olive;'>; that address as the new value of dp.</span>
<span style='color: teal;'>dw</span> xt_lit,<span style='color: teal;'>0</span> <span style='color: olive;'>; Put a 0 on the stack, and store it as a dummy</span>
<span style='color: teal;'>dw</span> xt_comma <span style='color: olive;'>; placeholder in the new header's CFA.</span>
<span style='color: teal;'>dw</span> xt_do_semi_code <span style='color: olive;'>; Write, into the code field of the header we just</span>
<span style='color: olive;'>; created, the address that immediately follows</span>
<span style='color: olive;'>; this statement: the address of the dovar</span>
<span style='color: olive;'>; routine, which is the code that's responsible</span>
<span style='color: olive;'>; for pushing onto the stack the data field</span>
<span style='color: olive;'>; address of the word whose header we just</span>
<span style='color: olive;'>; created when it's executed.</span>
dovar <span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Push the stack to make room for the new value</span>
<span style='color: olive;'>; we're about to put on top.</span>
<span style='color: navy;'>lea</span> <span style='color: green; font-weight: bold;'>bx</span>,[<span style='color: green; font-weight: bold;'>di</span>+<span style='color: teal;'>2</span>] <span style='color: olive;'>; This opcode loads into bx whatever two plus the</span>
<span style='color: olive;'>; value of the contents of DI might be, as opposed</span>
<span style='color: olive;'>; to a "mov bx,[di+2]", which would move into BX</span>
<span style='color: olive;'>; the value stored in memory at that location.</span>
<span style='color: olive;'>; What we're actually doing here is calculating</span>
<span style='color: olive;'>; the address of the data field that follows</span>
<span style='color: olive;'>; this header so we can leave it on the stack.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; </span>
<span style='color: olive;'>; # (;code) - ( -- ) replace the xt of the word being defined with a pointer</span>
<span style='color: olive;'>; to the code immediately following (;code)</span>
<span style='color: olive;'>; The idea behind this compiler word is that you may have a word that does</span>
<span style='color: olive;'>; various compiling/accounting tasks that are defined in terms of Forth code</span>
<span style='color: olive;'>; when its being used to compile another word, but afterward, when the new</span>
<span style='color: olive;'>; word is executed in interpreter mode, you want your compiling word to do</span>
<span style='color: olive;'>; something else that needs to be coded in assembly. (;code) is the word that</span>
<span style='color: olive;'>; says, "Okay, that's what you do when you're compiling, but THIS is what</span>
<span style='color: olive;'>; you're going to do while executing, so look sharp, it's in assembly!"</span>
<span style='color: olive;'>; Somewhat like the word DOES>, which is used in a similar manner to define</span>
<span style='color: olive;'>; run-time code in terms of Forth words.</span>
primitive <span style='color: maroon; font-weight: bold;'>'(;code)'</span>,do_semi_code
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>di</span>,<span style='color: purple;'>word</span>[val_last] <span style='color: olive;'>; Get the LFA of the last word in dictionary</span>
<span style='color: olive;'>; (i.e. the word we're currently in the middle</span>
<span style='color: olive;'>; of compiling) and put it in DI. </span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>al</span>,<span style='color: purple;'>byte</span>[<span style='color: green; font-weight: bold;'>di</span>+<span style='color: teal;'>2</span>] <span style='color: olive;'>; Get the length byte from the name field.</span>
<span style='color: navy;'>and</span> <span style='color: green; font-weight: bold;'>ax</span>,<span style='color: teal;'>31</span> <span style='color: olive;'>; Mask off the immediate bit and leave only</span>
<span style='color: olive;'>; the 5-bit integer length.</span>
<span style='color: navy;'>add</span> <span style='color: green; font-weight: bold;'>di</span>,<span style='color: green; font-weight: bold;'>ax</span> <span style='color: olive;'>; Add the length to the pointer. If we add 3</span>
<span style='color: olive;'>; to the value in DI at this point, we'll</span>
<span style='color: olive;'>; have a pointer to the code field.</span>
<span style='color: navy;'>mov</span> <span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>di</span>+<span style='color: teal;'>3</span>],<span style='color: green; font-weight: bold;'>si</span> <span style='color: olive;'>; Store the current value of the instruction</span>
<span style='color: olive;'>; pointer into the code field. That value is</span>
<span style='color: olive;'>; going to point to whatever follows (;code) in</span>
<span style='color: olive;'>; the word being compiled, which in the case</span>
<span style='color: olive;'>; of (;code) had better be assembly code.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>si</span>,<span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>bp</span>] <span style='color: olive;'>; Okay, we just did something funky with the</span>
<span style='color: olive;'>; instruction pointer; now we have to fix it.</span>
<span style='color: olive;'>; Directly load into the instruction pointer</span>
<span style='color: olive;'>; the value that's currently at the top of</span>
<span style='color: olive;'>; the return stack.</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>bp</span> <span style='color: olive;'>; Then manually increment the return stack</span>
<span style='color: navy;'>inc</span> <span style='color: green; font-weight: bold;'>bp</span> <span style='color: olive;'>; pointer.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; Done. Go do another word.</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; Constants</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; constant - ( x -- ) create a new constant with the value x, taking the name</span>
<span style='color: olive;'>; from the input buffer</span>
colon <span style='color: maroon; font-weight: bold;'>'constant'</span>,constant
<span style='color: teal;'>dw</span> xt_create <span style='color: olive;'>; Create the constant's header.</span>
<span style='color: teal;'>dw</span> xt_comma <span style='color: olive;'>; Store the constant's value into the word's</span>
<span style='color: olive;'>; data field.</span>
<span style='color: teal;'>dw</span> xt_do_semi_code <span style='color: olive;'>; Write, into the code field of the header we just</span>
<span style='color: olive;'>; created, the address that immediately follows</span>
<span style='color: olive;'>; this statement: the address of the doconst</span>
<span style='color: olive;'>; routine, which is the code that's responsible</span>
<span style='color: olive;'>; for pushing onto the stack the value that's</span>
<span style='color: olive;'>; contained in the data field of the word whose</span>
<span style='color: olive;'>; header we just created when that word is</span>
<span style='color: olive;'>; invoked.</span>
doconst <span style='color: navy;'>push</span> <span style='color: green; font-weight: bold;'>bx</span> <span style='color: olive;'>; Push the stack down.</span>
<span style='color: navy;'>mov</span> <span style='color: green; font-weight: bold;'>bx</span>,<span style='color: purple;'>word</span>[<span style='color: green; font-weight: bold;'>di</span>+<span style='color: teal;'>2</span>] <span style='color: olive;'>; DI should be pointing to the constant's code</span>
<span style='color: olive;'>; field. Load into the top of the stack the</span>
<span style='color: olive;'>; value 2 bytes further down from the code field,</span>
<span style='color: olive;'>; i.e. the constant's actual value.</span>
<span style='color: navy;'>jmp</span> next <span style='color: olive;'>; </span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; Outer Interpreter</span>
<span style='color: olive;'>; -----------------------</span>
<span style='color: olive;'>; -------------------------------------------------------</span>
<span style='color: olive;'>; NOTE! The following line with the final: label MUST be</span>
<span style='color: olive;'>; immediately before the final word definition!</span>
<span style='color: olive;'>; -------------------------------------------------------</span>
final:
colon <span style='color: maroon; font-weight: bold;'>'interpret'</span>,interpret
interpt <span style='color: teal;'>dw</span> xt_number_t_i_b <span style='color: olive;'>; Get the number of characters in the input</span>
<span style='color: teal;'>dw</span> xt_fetch <span style='color: olive;'>; buffer.</span>
<span style='color: teal;'>dw</span> xt_to_in <span style='color: olive;'>; Get the index into the input buffer.</span>
<span style='color: teal;'>dw</span> xt_fetch <span style='color: olive;'>; </span>
<span style='color: teal;'>dw</span> xt_equals <span style='color: olive;'>; See if they're the same.</span>
<span style='color: teal;'>dw</span> xt_zero_branch <span style='color: olive;'>; If not, it means there's still some text in</span>
<span style='color: teal;'>dw</span> intpar <span style='color: olive;'>; the buffer. Go process it.</span>
<span style='color: teal;'>dw</span> xt_t_i_b <span style='color: olive;'>; if #tib = >in, we're out of text and need to</span>
<span style='color: teal;'>dw</span> xt_lit <span style='color: olive;'>; read some more. Put a 50 on the stack to tell</span>
<span style='color: teal;'>dw</span> <span style='color: teal;'>50</span> <span style='color: olive;'>; accept to read up to 50 more characters.</span>
<span style='color: teal;'>dw</span> xt_accept <span style='color: olive;'>; Go get more input.</span>
<span style='color: teal;'>dw</span> xt_number_t_i_b <span style='color: olive;'>; Store into #tib the actual number of characters</span>
<span style='color: teal;'>dw</span> xt_store <span style='color: olive;'>; that accept read.</span>
<span style='color: teal;'>dw</span> xt_lit <span style='color: olive;'>; Reposition >in to index the 0th byte in the</span>
<span style='color: teal;'>dw</span> <span style='color: teal;'>0</span> <span style='color: olive;'>; input buffer.</span>
<span style='color: teal;'>dw</span> xt_to_in <span style='color: olive;'>; </span>
<span style='color: teal;'>dw</span> xt_store <span style='color: olive;'>; </span>
intpar <span style='color: teal;'>dw</span> xt_lit <span style='color: olive;'>; Put a 32 on the stack to represent an ASCII</span>
<span style='color: teal;'>dw</span> <span style='color: teal;'>32</span> <span style='color: olive;'>; space character. Then tell word to scan the</span>
<span style='color: teal;'>dw</span> xt_word <span style='color: olive;'>; buffer looking for that character.</span>
<span style='color: teal;'>dw</span> xt_find <span style='color: olive;'>; Once word has parsed out a string, have find</span>
<span style='color: olive;'>; see if that string matches the name of any</span>
<span style='color: olive;'>; words already defined in the dictionary.</span>
<span style='color: teal;'>dw</span> xt_dupe <span style='color: olive;'>; Copy the flag returned by find, then jump if</span>
<span style='color: teal;'>dw</span> xt_zero_branch <span style='color: olive;'>; it's a zero, meaning that the string doesn't</span>
<span style='color: teal;'>dw</span> intnf <span style='color: olive;'>; match any defined word names.</span>
<span style='color: teal;'>dw</span> xt_state <span style='color: olive;'>; We've got a word match. Are we interpreting or</span>
<span style='color: teal;'>dw</span> xt_fetch <span style='color: olive;'>; do we want to compile it? See if find's flag</span>
<span style='color: teal;'>dw</span> xt_equals <span style='color: olive;'>; matches the current value of state.</span>
<span style='color: teal;'>dw</span> xt_zero_branch <span style='color: olive;'>; If so, we've got an immediate. Jump.</span>
<span style='color: teal;'>dw</span> intexc <span style='color: olive;'>; </span>
<span style='color: teal;'>dw</span> xt_comma <span style='color: olive;'>; Not immediate. Store the word's CFA in the</span>
<span style='color: teal;'>dw</span> xt_branch <span style='color: olive;'>; dictionary then jump to the end of the loop.</span>
<span style='color: teal;'>dw</span> intdone <span style='color: olive;'>; </span>
intexc <span style='color: teal;'>dw</span> xt_execute <span style='color: olive;'>; We found an immediate word. Execute it then</span>
<span style='color: teal;'>dw</span> xt_branch <span style='color: olive;'>; jump to the end of the loop.</span>
<span style='color: teal;'>dw</span> intdone <span style='color: olive;'>; </span>
intnf <span style='color: teal;'>dw</span> xt_dupe <span style='color: olive;'>; Okay, it's not a word. Is it a number? Copy</span>
<span style='color: olive;'>; the flag, which we've already proved is 0,</span>
<span style='color: olive;'>; thereby creating a double-precision value of</span>
<span style='color: olive;'>; 0 at the top of the stack. We'll need this</span>
<span style='color: olive;'>; shortly when we call >number.</span>
<span style='color: teal;'>dw</span> xt_rote <span style='color: olive;'>; Rotate the string's address to the top of</span>
<span style='color: olive;'>; the stack. Note that it's still a counted</span>
<span style='color: olive;'>; string.</span>
<span style='color: teal;'>dw</span> xt_count <span style='color: olive;'>; Use count to split the string's length byte</span>
<span style='color: olive;'>; apart from its text.</span>
<span style='color: teal;'>dw</span> xt_to_number <span style='color: olive;'>; See if we can convert the text into a number.</span>
<span style='color: teal;'>dw</span> xt_zero_branch <span style='color: olive;'>; If we get a 0 from 0branch, we got a good</span>
<span style='color: teal;'>dw</span> intskip <span style='color: olive;'>; conversion. Jump and continue.</span>
<span style='color: teal;'>dw</span> xt_state <span style='color: olive;'>; We had a conversion error. Find out whether</span>
<span style='color: teal;'>dw</span> xt_fetch <span style='color: olive;'>; we're interpreting or compiling.</span>
<span style='color: teal;'>dw</span> xt_zero_branch <span style='color: olive;'>; If state=0, we're interpreting. Jump</span>
<span style='color: teal;'>dw</span> intnc <span style='color: olive;'>; further down.</span>
<span style='color: teal;'>dw</span> xt_last <span style='color: olive;'>; We're compiling. Shut the compiler down in an</span>
<span style='color: teal;'>dw</span> xt_fetch <span style='color: olive;'>; orderly manner. Get the LFA of the word we</span>
<span style='color: teal;'>dw</span> xt_dupe <span style='color: olive;'>; were trying to compile. Set aside a copy of it,</span>
<span style='color: teal;'>dw</span> xt_fetch <span style='color: olive;'>; then retrieve from it the LFA of the old "last</span>
<span style='color: teal;'>dw</span> xt_last <span style='color: olive;'>; word" and resave that as the current last word.</span>
<span style='color: teal;'>dw</span> xt_store <span style='color: olive;'>; </span>
<span style='color: teal;'>dw</span> xt_dp <span style='color: olive;'>; Now we have to save the LFA of the word we just</span>
<span style='color: teal;'>dw</span> xt_store <span style='color: olive;'>; tried to compile back into the dictionary</span>
<span style='color: olive;'>; pointer.</span>
intnc <span style='color: teal;'>dw</span> xt_abort <span style='color: olive;'>; Whether we were compiling or interpreting,</span>
<span style='color: olive;'>; either way we end up here if we had an</span>
<span style='color: olive;'>; unsuccessful number conversion. Call abort</span>
<span style='color: olive;'>; and reset the system.</span>
intskip <span style='color: teal;'>dw</span> xt_drop <span style='color: olive;'>; >number was successful! Drop the address and</span>
<span style='color: teal;'>dw</span> xt_drop <span style='color: olive;'>; the high word of the double-precision numeric</span>
<span style='color: olive;'>; value it returned. We don't need either. What's</span>
<span style='color: olive;'>; left on the stack is the single-precision</span>
<span style='color: olive;'>; number we just converted.</span>
<span style='color: teal;'>dw</span> xt_state <span style='color: olive;'>; Are we compiling or interpreting?</span>
<span style='color: teal;'>dw</span> xt_fetch <span style='color: olive;'>; </span>
<span style='color: teal;'>dw</span> xt_zero_branch <span style='color: olive;'>; If we're interpreting, jump on down.</span>
<span style='color: teal;'>dw</span> intdone <span style='color: olive;'>; </span>
<span style='color: teal;'>dw</span> xt_lit <span style='color: olive;'>; No, John didn't stutter here. These 4 lines are</span>
<span style='color: teal;'>dw</span> xt_lit <span style='color: olive;'>; how "['] lit , ," get encoded. We need to store</span>
<span style='color: teal;'>dw</span> xt_comma <span style='color: olive;'>; lit's own CFA into the word, followed by the</span>
<span style='color: teal;'>dw</span> xt_comma <span style='color: olive;'>; number we just converted from text input.</span>
intdone <span style='color: teal;'>dw</span> xt_branch <span style='color: olive;'>; Jump back to the beginning of the interpreter</span>
<span style='color: teal;'>dw</span> interpt <span style='color: olive;'>; loop and process more input.</span>
freemem:
<span style='color: olive;'>; That's it! So, there you have it! Only 33 named Forth words...</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; , @ >in dup base word abort 0branch interpret</span>
<span style='color: olive;'>; + ! lit swap last find create constant (;code)</span>
<span style='color: olive;'>; = ; tib drop emit state accept >number</span>
<span style='color: olive;'>; : dp rot #tib exit count execute</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; ...plus 6 pieces of headerless code and run-time routines...</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; getchar outchar docolon dovar doconst next</span>
<span style='color: olive;'>;</span>
<span style='color: olive;'>; ...are all that's required to produce a functional Forth interpreter</span>
<span style='color: olive;'>; capable of compiling colon definitions, only 978 bytes long! Granted,</span>
<span style='color: olive;'>; it's lacking a number of key critical words that make it nigh unto</span>
<span style='color: olive;'>; impossible to do anything useful, but this just goes to show just</span>
<span style='color: olive;'>; how small a functioning Forth system can be made.</span>
</pre>
John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com7tag:blogger.com,1999:blog-4757118446768919900.post-79383420821967943812012-08-23T13:35:00.000-07:002012-08-23T13:35:11.021-07:00Mouse: a Language for Microcomputers by Peter Grogono<div class="separator" style="clear: both; text-align: center;">
<span style="clear: left; float: left; margin-bottom: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEheTXzvOHYCuBHvCALevifM1dikQA4TybeGtbzFl13WP-dXv4_wJyvXc6QXGr0qWgPr50F5BO85Noq69EFza6WDMVTflkKnPTW-RIqyUOGfzdWaohvaECCspT-J0GHvFui5x05zGlJsPOo/s1600/mouse_a_language_for_microcomputers.jpg" alt="Mouse: a Language for Microcomputers by Peter Grogono" /></span></div>
<p><strong>Mouse</strong> is a stack-based interpreted programming language descended from MUSYS, an earlier language for a DEC PDP/8 with 4096 words of memory.</p>
<p>In <strong>Mouse: a Language for Microcomputers</strong>, Grogono defines the language and develops an intepreter step-by-step as he introduces each feature of the language.</p>
<p>The first few chapters cover the basics: postfix expressions, variables, control structures, pointers and macros. Later chapters include two complete Mouse interpreters, one in Pascal, the other in Z80 assembly language.</p>
<p>Here's a brief summary of the Mouse language. Instructions pop their operands from and push their result on the stack. ( before -- after ) shows the stack effects of each operation.</p>
<h3>Maths / Logic</h3>
<p>Mouse is looking pretty Forthlike so far! <code>\</code> is the equivalent of <code>MOD</code> in Forth:</p>
<ul>
<li><code>+</code> - ( x y -- z ) calculate <i>z</i>, the sum of <i>x</i>+<i>y</i></li>
<li><code>-</code> - ( x y -- z ) calculate <i>z</i>, the difference of <i>x</i>-<i>y</i></li>
<li><code>*</code> - ( x y -- z ) calculate <i>z</i>, the product of <i>x</i>×<i>y</i></li>
<li><code>/</code> - ( x y -- z ) calculate <i>z</i>, the quotient of <i>x</i>/<i>y</i></li>
<li><code>\</code> - ( x y -- z ) calculate <i>z</i>, the remainder of <i>x</i>/<i>y</i></li>
<li><code><</code> - ( x y -- z ) if <i>x</i><<i>y</i> then <i>z</i> is true, otherwise false</li>
<li><code>=</code> - ( x y -- z ) if <i>x</i>=<i>y</i> then <i>z</i> is true, otherwise false</li>
<li><code>></code> - ( x y -- z ) if <i>x</i>><i>y</i> then <i>z</i> is true, otherwise false</li>
</ul>
<h3>Input / Output</h3>
<p>Only <code>?</code> doesn't have an exact equivalent in Forth. <code>?'</code> is the same as Forth's <code>KEY</code>. <code>!'</code> is the same as <code>EMIT</code> and <code>!</code> is <code>.</code>:</p>
<ul>
<li><code>?</code> - ( -- x ) read a number <i>x</i> from the keyboard</li>
<li><code>?'</code> - ( -- x ) read a character <i>x</i> from the keyboard</li>
<li><code>!</code> - ( x -- ) display a number <i>x</i></li>
<li><code>!'</code> - ( x -- ) display a character <i>x</i></li>
<li><code>"…"</code> - ( -- ) display the quoted string</li>
</ul>
<h3>Peek and Poke</h3>
<p><code>:</code> is the equivalent of <code>!</code> in Forth. <code>.</code> is the equivalent of <code>@</code>:
<ul>
<li><code>:</code> - ( x addr -- ) store <i>x</i> in address <i>addr</i></li>
<li><code>.</code> - ( addr -- x ) read <i>x</i> from address <i>addr</i></li>
</ul>
<h3>Control Structures</h3>
<p><code>[ … | … ]</code> is similar to Forth's <code>IF … ELSE … THEN</code>.</p>
<p><code>( … ↑ … )</code> is similar to Forth's <code>BEGIN … WHILE … REPEAT</code>:</p>
<ul>
<li><code>[</code> - ( x -- ) if <i>x</i> is false, jump to the matching <code>|</code> or <code>]</code></li>
<li><code>|</code> - ( -- ) jump to the matching <code>]</code> (not always implemented)</li>
<li><code>]</code> - ( -- ) end a <code>[ … | … ]</code> structure</li>
<li><code>(</code> - ( -- ) start a loop</li>
<li><code>↑</code> - ( x -- ) exit loop if <i>x</i> is false (often rendered as <code>^</code>)</li>
<li><code>)</code> - ( -- ) end loop, jump back to matching <code>(</code></li>
<li><code>~</code> - ( -- ) the remainder of the line is a comment</li>
</ul>
<h3>Macro Definitions</h3>
<ul>
<li><code>#<i>x</i>;</code> - ( -- ) call macro <i>x</i></li>
<li><code>$<i>x</i></code> - ( -- ) define macro <i>x</i></li>
<li><code>@</code> - ( -- ) end macro definition</li>
<li><code>%</code> - ( x -- z ) access macro parameter</li>
</ul>
<p>Macros are the Mouse equivalent of subroutines. A macro is defined by <code>$<i>x</i> … @</code> and called with <code>#<i>x</i>;</code>. Parameters can be passed between the macro name and semicolon. For example <code>#<i>x</i>,7,5,9;</code> will pass the parameters 7, 5 and 9 to <i>x</i>.</p>
<p>A macro accesses it's parameters using <code>%</code>: <code>1%</code> for the first, <code>2%</code> for the second, etc. A parameter is evaluated every time it's accessed and can be almost any valid Mouse code.</p>
<p>A macro has 26 local variables, A to Z. 26 macro names are available, A to Z.</p>
<h3>Example Code</h3>
<p>Here are a few classic examples:</p>
<ul>
<li>Hello World (which recently celebrated it's 40th birthday)</li>
<li>Fibonacci Numbers (the typical bad example of recursion)</li>
<li>Greatest Common Divisor (a better example of recursion)</li>
</ul>
<h4>Hello, World</h4>
<code><pre>"Hello, World!"$
</pre></code>
<p>Displays the string <i>Hello, World</i>. The exclamation mark isn't printed. An exclamation in a string instructs the interpreter to print a line break. All Mouse programs end with <code>$</code>.</p>
<h4>Fibonacci Numbers</h4>
<code><pre>
$F
1% N: ~ store parameter in N
N. 2 < [ N. ] ~ if N < 2 then return N
N. 1 > [ #F, N. 1 - ; ~ otherwise calculate F(N-1)
#F, N. 2 - ; ~ | and F(N-2)
+ ] ~ | and return their sum
@
</pre></code>
<p><code>F</code> calculates Fibonacci numbers using the recurrence relation <i>F</i><sub><i>n</i></sub> = <i>F</i><sub><i>n</i>-1</sub> + <i>F</i><sub><i>n</i>-2</sub> with <i>F</i><sub>0</sub> = 0, <i>F</i><sub>1</sub> =1. Note this is really slow, Ο(φ<sup><i>n</i></sup>). Calculating <i>F</i><sub>40</sub> takes 6 minutes. There are better ways to calculate Fibonacci numbers!</p>
<h4>Greatest Common Divisor</h4>
<code><pre>
$G
1% X: 2% Y: ~ store parameters
X. Y. = [ X. ] ~ if X = Y then GCD = X
X. Y. > [ #G, X. Y. - , Y. ; ] ~ otherwise subtract the
X. Y. < [ #G, Y. X. - , X. ; ] ~ | smallest from the
@ ~ | largest and recurse
</pre></code>
<p>Another example of recursion. <code>G</code> calculates the <acronym title="greatest common divisor">GCD</acronym> using Dijkstra's method.</p>
<h3>Further Reading</h3>
<ul>
<li>
<b>Grogono, Peter</b>
<cite>Mouse: A Language for Microcomputers</cite>.<br>
New York: Petrocelli Books, 1983.
</li>
<li>David G Simpson has published several
<a href="http://mouse.davidgsimpson.com">interpreters for Mouse</a>.</li>
</ul>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com6tag:blogger.com,1999:blog-4757118446768919900.post-36794063152163724902012-06-23T13:55:00.001-07:002012-08-25T11:58:12.065-07:00Itsy Forth: The Compiler<p><strong>Itsy Forth</strong> is a 1<acronym title="kilobyte">kB</acronym> subset of the Forth programming language. Itsy was developed top-down,
implementing only the functions required to get the compiler up and running. So far we've looked at the following:</p>
<ul>
<li><a href="http://www.retroprogramming.com/2012/03/itsy-forth-1k-tiny-compiler.html">The Outer (text) Interpreter</a></li>
<li><a href="http://www.retroprogramming.com/2012/04/itsy-forth-dictionary-and-inner.html">The Inner (address) Interpreter and Dictionary</a></li>
<li><a href="http://www.retroprogramming.com/2012/04/itsy-forth-primitives.html">The Primitives</a></li>
</ul>
<p>Next we'll define the words to complete the compiler.</p>
<h3>Colon Definitions</h3>
<ul>
<li><code>:</code> - ( -- ) define a new Forth word, taking the name from the input buffer</li>
<li><code>;</code> - ( -- ) complete the Forth word being compiled</li>
</ul>
<p><code>:</code> sets <code>state</code> to true to enter compile mode then creates a header for the new word. <code>;</code> adds
<code>exit</code> to the end of the word then sets <code>state</code> to false to end compile mode.</p>
<p>For example, <code>: here dp @ ;</code> creates a new Forth word which returns the contents of the variable <code>dp</code>.</p>
<code><pre>: :
-1 state !
create
(;code)
docolon dec bp
dec bp
mov word[bp],si
lea si,[di+2]
jmp next
: ;
['] exit ,
0 state !
; immediate
</pre></code>
<h3>Creating Headers</h3>
<ul>
<li><code>create</code> - ( -- ) build a header for a new word in the dictionary, taking the name from the input buffer</li>
<li><code>(;code)</code> - ( -- ) replace the <i>xt</i> of the word being defined with a pointer to the code immediately following
<code>(;code)</code></li>
</ul>
<p><code>create</code> adds a new header to the dictionary which includes a link to the previous entry, a name and execution token (<i>xt</i>).
The <i>xt</i> initially points to <code>dovar</code> but can be modified using <code>(;code).</code></p>
<p>For example, <code>: variable create 0 , ;</code> creates a new Forth word to define variables (<code>dovar</code> is the
default <i>xt</i> for created words).</p>
<code><pre>: create
dp @ last @ , last !
32 word count
+ dp ! 0 ,
(;code)
dovar push bx
lea bx,[di+2]
jmp next
primitive '(;code)',do_semi_code
mov di,word[val_last]
mov al,byte[di+2]
and ax,31
add di,ax
mov word[di+3],si
mov si,word[bp]
inc bp
inc bp
jmp next
</pre></code>
<h3>Constants</h3>
<ul>
<li><code>constant</code> - ( x -- ) create a new constant with the value <i>x</i>, taking the name from the input buffer</li>
</ul>
<p>For example, <code>0 constant false</code> adds a new constant to the dictionary. When executed, <code>false</code> will push 0 on the
stack.</p>
<code><pre>: constant
create ,
(;code)
doconst push bx
mov bx,word[di+2]
jmp next
</pre></code>
<h3>Testing the Compiler</h3>
<br />
<div class="separator" style="clear: both; text-align: center;">
<img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiQ8sRAhyhaIuzAQqtX7PXrA3BgdoU579cP6Pn1sDj5UzK69g2mtjEv3l9w8nvimDmJTAbrjRNXYnJrgSS1BhtVI9PuIZqXDCKqmdawCjwq8yG7plZNyhqIoVOvnf91R4Wjs5Ff0hkxcCM/s1600/itsy2.png" /></div>
<p>It's time to give Itsy a quick test run. First we implement a few standard words: <code>hex</code> to switch to base 16, <code>cr</code> to move the cursor to the next line and <code>variable</code> to define new variables.</p>
<p>Next a simple test. We add a variable <code>itest</code> initialised to 041h (ASCII 'A') and a procedure to display and increment <code>itest</code>. Then the moment of truth... A B C it works!</p>
<h3>Itsy Forth: The Next Step</h3>
<p>What's next for Itsy Forth? First I'd like to implement the ANS core wordset from the Itsy prompt, then perhaps experiment with compiling to native code. In the meantime, here's the code for the current version of Itsy:</p>
<h3>macros.asm</h3>
<code><pre> %define link 0
%define immediate 080h
%macro head 4
%%link dw link
%define link %%link
%strlen %%count %1
db %3 + %%count,%1
xt_ %+ %2 dw %4
%endmacro
%macro primitive 2-3 0
head %1,%2,%3,$+2
%endmacro
%macro colon 2-3 0
head %1,%2,%3,docolon
%endmacro
%macro constant 3
head %1,%2,0,doconst
val_ %+ %2 dw %3
%endmacro
%macro variable 3
head %1,%2,0,dovar
val_ %+ %2 dw %3
%endmacro
</pre></code>
<h3>itsy.asm</h3>
<code><pre>%include "macros.asm"
org 0100h
jmp xt_abort+2
; -------------------
; Variables
; -------------------
variable 'state',state,0
variable '>in',to_in,0
variable '#tib',number_t_i_b,0
variable 'dp',dp,freemem
variable 'base',base,10
variable 'last',last,final
constant 'tib',t_i_b,32768
; -------------------
; Initialisation
; -------------------
primitive 'abort',abort
mov ax,word[val_number_t_i_b]
mov word[val_to_in],ax
xor bp,bp
mov word[val_state],bp
mov sp,-256
mov si,xt_interpret+2
jmp next
; -------------------
; Compilation
; -------------------
primitive ',',comma
mov di,word[val_dp]
xchg ax,bx
stosw
mov word[val_dp],di
pop bx
jmp next
primitive 'lit',lit
push bx
lodsw
xchg ax,bx
jmp next
; -------------------
; Stack
; -------------------
primitive 'rot',rote
pop dx
pop ax
push dx
push bx
xchg ax,bx
jmp next
primitive 'drop',drop
pop bx
jmp next
primitive 'dup',dupe
push bx
jmp next
primitive 'swap',swap
pop ax
push bx
xchg ax,bx
jmp next
; -------------------
; Maths / Logic
; -------------------
primitive '+',plus
pop ax
add bx,ax
jmp next
primitive '=',equals
pop ax
sub bx,ax
sub bx,1
sbb bx,bx
jmp next
; -------------------
; Peek and Poke
; -------------------
primitive '@',fetch
mov bx,word[bx]
jmp next
primitive '!',store
pop word[bx]
pop bx
jmp next
; -------------------
; Inner Interpreter
; -------------------
next lodsw
xchg di,ax
jmp word[di]
; -------------------
; Flow Control
; -------------------
primitive '0branch',zero_branch
lodsw
test bx,bx
jne zerob_z
xchg ax,si
zerob_z pop bx
jmp next
primitive 'branch',branch
mov si,word[si]
jmp next
primitive 'execute',execute
mov di,bx
pop bx
jmp word[di]
primitive 'exit',exit
mov si,word[bp]
inc bp
inc bp
jmp next
; -------------------
; String
; -------------------
primitive 'count',count
inc bx
push bx
mov bl,byte[bx-1]
mov bh,0
jmp next
primitive '>number',to_number
pop di
pop cx
pop ax
to_numl test bx,bx
je to_numz
push ax
mov al,byte[di]
cmp al,'a'
jc to_nums
sub al,32
to_nums cmp al,'9'+1
jc to_numg
cmp al,'A'
jc to_numh
sub al,7
to_numg sub al,48
mov ah,0
cmp al,byte[val_base]
jnc to_numh
xchg ax,dx
pop ax
push dx
xchg ax,cx
mul word[val_base]
xchg ax,cx
mul word[val_base]
add cx,dx
pop dx
add ax,dx
dec bx
inc di
jmp to_numl
to_numz push ax
to_numh push cx
push di
jmp next
; -----------------------
; Terminal Input / Output
; -----------------------
primitive 'accept',accept
pop di
xor cx,cx
acceptl call getchar
cmp al,8
jne acceptn
jcxz acceptb
call outchar
mov al,' '
call outchar
mov al,8
call outchar
dec cx
dec di
jmp acceptl
acceptn cmp al,13
je acceptz
cmp cx,bx
jne accepts
acceptb mov al,7
call outchar
jmp acceptl
accepts stosb
inc cx
call outchar
jmp acceptl
acceptz jcxz acceptb
mov al,13
call outchar
mov al,10
call outchar
mov bx,cx
jmp next
primitive 'word',word
mov di,word[val_dp]
push di
mov dx,bx
mov bx,word[val_t_i_b]
mov cx,bx
add bx,word[val_to_in]
add cx,word[val_number_t_i_b]
wordf cmp cx,bx
je wordz
mov al,byte[bx]
inc bx
cmp al,dl
je wordf
wordc inc di
mov byte[di],al
cmp cx,bx
je wordz
mov al,byte[bx]
inc bx
cmp al,dl
jne wordc
wordz mov byte[di+1],32
mov ax,word[val_dp]
xchg ax,di
sub ax,di
mov byte[di],al
sub bx,word[val_t_i_b]
mov word[val_to_in],bx
pop bx
jmp next
primitive 'emit',emit
xchg ax,bx
call outchar
pop bx
jmp next
getchar mov ah,7
int 021h
mov ah,0
ret
outchar xchg ax,dx
mov ah,2
int 021h
ret
; -----------------------
; Dictionary Search
; -----------------------
primitive 'find',find
mov di,val_last
findl push di
push bx
mov cl,byte[bx]
mov ch,0
inc cx
findc mov al,byte[di+2]
and al,07Fh
cmp al,byte[bx]
je findm
pop bx
pop di
mov di,word[di]
test di,di
jne findl
findnf push bx
xor bx,bx
jmp next
findm inc di
inc bx
loop findc
pop bx
pop di
mov bx,1
inc di
inc di
mov al,byte[di]
test al,080h
jne findi
neg bx
findi and ax,31
add di,ax
inc di
push di
jmp next
; -----------------------
; Colon Definition
; -----------------------
colon ':',colon
dw xt_lit,-1,xt_state,xt_store,xt_create
dw xt_do_semi_code
docolon dec bp
dec bp
mov word[bp],si
lea si,[di+2]
jmp next
colon ';',semicolon,immediate
dw xt_lit,xt_exit,xt_comma,xt_lit,0,xt_state
dw xt_store,xt_exit
; -----------------------
; Headers
; -----------------------
colon 'create',create
dw xt_dp,xt_fetch,xt_last,xt_fetch,xt_comma
dw xt_last,xt_store,xt_lit,32,xt_word,xt_count
dw xt_plus,xt_dp,xt_store,xt_lit,0,xt_comma
dw xt_do_semi_code
dovar push bx
lea bx,[di+2]
jmp next
primitive '(;code)',do_semi_code
mov di,word[val_last]
mov al,byte[di+2]
and ax,31
add di,ax
mov word[di+3],si
mov si,word[bp]
inc bp
inc bp
jmp next
; -----------------------
; Constants
; -----------------------
colon 'constant',constant
dw xt_create,xt_comma,xt_do_semi_code
doconst push bx
mov bx,word[di+2]
jmp next
; -----------------------
; Outer Interpreter
; -----------------------
final:
colon 'interpret',interpret
interpt dw xt_number_t_i_b,xt_fetch,xt_to_in,xt_fetch
dw xt_equals,xt_zero_branch,intpar,xt_t_i_b
dw xt_lit,50,xt_accept,xt_number_t_i_b,xt_store
dw xt_lit,0,xt_to_in,xt_store
intpar dw xt_lit,32,xt_word,xt_find,xt_dupe
dw xt_zero_branch,intnf,xt_state,xt_fetch
dw xt_equals,xt_zero_branch,intexc,xt_comma
dw xt_branch,intdone
intexc dw xt_execute,xt_branch,intdone
intnf dw xt_dupe,xt_rote,xt_count,xt_to_number
dw xt_zero_branch,intskip,xt_state,xt_fetch
dw xt_zero_branch,intnc,xt_last,xt_fetch,xt_dupe
dw xt_fetch,xt_last,xt_store,xt_dp,xt_store
intnc dw xt_abort
intskip dw xt_drop, xt_drop, xt_state, xt_fetch
dw xt_zero_branch,intdone,xt_lit,xt_lit,xt_comma
dw xt_comma
intdone dw xt_branch,interpt
freemem:
</pre></code>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com5tag:blogger.com,1999:blog-4757118446768919900.post-88930038547086120642012-04-15T12:37:00.002-07:002012-08-25T11:58:41.859-07:00Itsy Forth: Implementing the Primitives<b>Itsy Forth</b> is a tiny subset of the Forth programming language.
So far we've looked at the
<a href="http://www.retroprogramming.com/2012/03/itsy-forth-1k-tiny-compiler.html">Forth
outer interpreter</a>,
<a href="http://www.retroprogramming.com/2012/04/itsy-forth-dictionary-and-inner.html">inner
interpreter and dictionary</a>. This time we'll define the words required to complete the
interpreter.<br />
<h3>
Peek and Poke</h3>
The Forth words to read and write memory are <code>@</code> and <code>!</code>:<br />
<ul>
<li><code>@</code> - ( addr -- x ) read <i>x</i> from <i>addr</i></li>
<li><code>!</code> - ( x addr -- ) store <i>x</i> at <i>addr</i></li>
<li><code>c@</code> - ( addr -- char ) read <i>char</i> from <i>addr</i></li>
</ul>
( before -- after ) shows the contents of the stack before and after the word executes. Here's
how <code>@</code>, <code>c@</code> and <code>!</code> are implemented. Remember we're keeping the
top element of the data stack in the <code>bx</code> register.<br />
<code></code><br />
<pre><code> primitive '@',fetch
mov bx,word[bx]
jmp next
primitive '!',store
pop word[bx]
pop bx
jmp next
primitive 'c@',c_fetch
mov bl,byte[bx]
mov bh,0
jmp next
</code></pre>
<br />
<h3>
Manipulating the Stack</h3>
<ul>
<li><code>drop</code> - ( x -- ) remove <i>x</i> from the stack</li>
<li><code>dup</code> - ( x -- x x ) add a copy of <i>x</i> to the stack</li>
<li><code>swap</code> - ( x y -- y x ) exchange <i>x</i> and <i>y</i></li>
<li><code>rot</code> - ( x y z -- y z x ) rotate <i>x</i>, <i>y</i> and <i>z</i></li>
</ul>
<code></code><br />
<pre><code> primitive 'drop',drop
pop bx
jmp next
primitive 'dup',dupe
push bx
jmp next
primitive 'swap',swap
pop ax
push bx
xchg ax,bx
jmp next
primitive 'rot',rote
pop dx
pop ax
push dx
push bx
xchg ax,bx
jmp next
</code></pre>
<br />
<h3>
Flow Control</h3>
<code>if</code>, <code>else</code>, <code>then</code>, <code>begin</code> and
<code>again</code> all compile to <code>branch</code> or <code>0branch</code>.<br />
<ul>
<li><code>0branch</code> - ( x -- ) jump if <i>x</i> is zero</li>
<li><code>branch</code> - ( -- ) unconditional jump</li>
<li><code>execute</code> - ( xt -- ) call the word at <i>xt</i></li>
<li><code>exit</code> - ( -- ) return from the current word</li>
</ul>
The destination address for the jump is compiled in the cell straight after the
<code>branch</code> or <code>0branch</code> instruction.
<code>execute</code> stores the return address on the return stack and <code>exit</code> removes it.<br />
<code></code><br />
<pre><code> primitive '0branch',zero_branch
lodsw
test bx,bx
jne zerob_z
xchg ax,si
zerob_z pop bx
jmp next
primitive 'branch',branch
mov si,word[si]
jmp next
primitive 'execute',execute
mov di,bx
pop bx
jmp word[di]
primitive 'exit',exit
mov si,word[bp]
inc bp
inc bp
jmp next
</code></pre>
<br />
<h3>
Variables and Constants</h3>
<ul>
<li><code>tib</code> - ( -- addr ) address of the input buffer</li>
<li><code>#tib</code> - ( -- addr ) number of characters in the input buffer</li>
<li><code>>in</code> - ( -- addr ) next character in input buffer</li>
<li><code>state</code> - ( -- addr ) true = compiling, false = interpreting</li>
<li><code>dp</code> - ( -- addr ) first free cell in the dictionary</li>
<li><code>base</code> - ( -- addr ) number base</li>
<li><code>last</code> - ( -- addr ) the last word to be defined</li>
</ul>
<code></code><br />
<pre><code> constant 'tib',t_i_b,32768
variable '#tib',number_t_i_b,0
variable '>in',to_in,0
variable 'state',state,0
variable 'dp',dp,freemem
variable 'base',base,10
variable 'last',last,final
; execution token for constants
doconst push bx
mov bx,word[di+2]
jmp next
; execution token for variables
dovar push bx
lea bx,[di+2]
jmp next
</code></pre>
<br />
<h3>
Compilation</h3>
<ul>
<li><code>,</code> - ( x -- ) compile <i>x</i> to the current definition</li>
<li><code>c,</code> - ( char -- ) compile <i>char</i> to the current definition</li>
<li><code>lit</code> - ( -- ) push the value in the cell straight after <code>lit</code></li>
</ul>
<code></code><br />
<pre><code> primitive ',',comma
mov ax,word[val_dp]
xchg ax,bx
add word[val_dp],2
mov word[bx],ax
pop bx
jmp next
primitive 'c,',c_comma
mov ax,word[val_dp]
xchg ax,bx
inc word[val_dp]
mov byte[bx],al
pop bx
jmp next
primitive 'lit',lit
push bx
lodsw
xchg ax,bx
jmp next
</code></pre>
<br />
<h3>
Maths / Logic</h3>
<ul>
<li><code>+</code> - ( x y -- z) calculate <i>z</i>=<i>x</i>+<i>y</i> then return <i>z</i></li>
<li><code>=</code> - ( x y -- flag ) return true if <i>x</i>=<i>y</i></li>
</ul>
<code></code><br />
<pre><code> primitive '+',plus
pop ax
add bx,ax
jmp next
primitive '=',equals
pop ax
sub bx,ax
sub bx,1
sbb bx,bx
jmp next
</code></pre>
<br />
<h3>
Handling Strings</h3>
<ul>
<li><code>count</code> - ( addr -- addr2 len ) <i>addr</i> contains a counted string. Return the address of the first character and the string's length</li>
<li><code>>number</code> - ( double addr len -- double2 addr2 len2 ) convert string to number</li>
</ul>
<i>addr</i> contains a string of <i>len</i> characters which <code>>number</code> attempts to
convert to a number using the current number <code>base</code>. <code>>number</code> returns
the portion of the string which can't be converted, if any. If you're a Forth purist this is
where Itsy starts to get ugly :-)<br />
<code></code><br />
<pre><code> primitive 'count',count
inc bx
push bx
mov bl,byte[bx-1]
mov bh,0
jmp next
primitive '>number',to_number
pop di
pop cx
pop ax
to_numl test bx,bx
je to_numz
push ax
mov al,byte[di]
cmp al,'a'
jc to_nums
sub al,32
to_nums cmp al,'9'+1
jc to_numg
cmp al,'A'
jc to_numh
sub al,7
to_numg sub al,48
mov ah,0
cmp al,byte[val_base]
jnc to_numh
xchg ax,dx
pop ax
push dx
xchg ax,cx
mul word[val_base]
xchg ax,cx
mul word[val_base]
add cx,dx
pop dx
add ax,dx
dec bx
inc di
jmp to_numl
to_numz push ax
to_numh push cx
push di
jmp next
</code></pre>
<br />
<h3>
Terminal Input / Output</h3>
<ul>
<li><code>accept</code> - ( addr len -- len2 ) read a string from the terminal</li>
<li><code>emit</code> - ( char -- ) display <i>char</i> on the terminal</li>
<li><code>word</code> - ( char -- addr ) parse the next word in the input buffer</li>
</ul>
<code>accept</code> reads a string of characters from the terminal. The string is
stored at <i>addr</i> and can be up to <i>len</i> characters long.
<code>accept</code> returns the actual length of the string.<br />
<code>word</code> reads the next word from the terminal input buffer, delimited
by <i>char</i>. The address of a counted string is returned. The string length will
be 0 if the input buffer is empty.<br />
<code></code><br />
<pre><code> primitive 'accept',accept
pop di
xor cx,cx
acceptl call getchar
cmp al,8
jne acceptn
jcxz acceptb
call outchar
mov al,' '
call outchar
mov al,8
call outchar
dec cx
dec di
jmp acceptl
acceptn cmp al,13
je acceptz
cmp cx,bx
jne accepts
acceptb mov al,7
call outchar
jmp acceptl
accepts stosb
inc cx
call outchar
jmp acceptl
acceptz jcxz acceptb
mov al,13
call outchar
mov al,10
call outchar
mov bx,cx
jmp next
getchar mov ah,7
int 021h
mov ah,0
ret
outchar xchg ax,dx
mov ah,2
int 021h
ret
primitive 'word',word
mov di,word[val_dp]
push di
mov dx,bx
mov bx,word[val_t_i_b]
mov cx,bx
add bx,word[val_to_in]
add cx,word[val_number_t_i_b]
wordf cmp cx,bx
je wordz
mov al,byte[bx]
inc bx
cmp al,dl
je wordf
wordc inc di
mov byte[di],al
cmp cx,bx
je wordz
mov al,byte[bx]
inc bx
cmp al,dl
jne wordc
wordz mov byte[di+1],32
mov ax,word[val_dp]
xchg ax,di
sub ax,di
mov byte[di],al
sub bx,word[val_t_i_b]
mov word[val_to_in],bx
pop bx
jmp next
primitive 'emit',emit
xchg ax,bx
call outchar
pop bx
jmp next
</code></pre>
<br />
<h3>
Searching the Dictionary</h3>
<ul>
<li><code>find</code> - ( addr -- addr2 flag ) look up word in the dictionary</li>
</ul>
<code>find</code> looks in the Forth dictionary for the word in the counted
string at <i>addr</i>. One of the following will be returned:<br />
<ul>
<li>flag = 0, addr2 = counted string - if word not found</li>
<li>flag = 1, addr2 = call address if word is immediate</li>
<li>flag = -1, addr2 = call address if word is not immediate</li>
</ul>
<code></code><br />
<pre><code> primitive 'find',find
mov di,val_last
findl push di
push bx
mov cl,byte[bx]
mov ch,0
inc cx
findc mov al,byte[di+2]
and al,07Fh
cmp al,byte[bx]
je findm
pop bx
pop di
mov di,word[di]
test di,di
jne findl
findnf push bx
xor bx,bx
jmp next
findm inc di
inc bx
loop findc
pop bx
pop di
mov bx,1
inc di
inc di
mov al,byte[di]
test al,080h
jne findi
neg bx
findi and ax,31
add di,ax
inc di
push di
jmp next
</code></pre>
<br />
<h3>
Initialisation</h3>
<ul>
<li><code>abort</code> - ( -- ) initialise Itsy then jump to <code>interpret</code></li>
</ul>
<code>abort</code> initialises the stacks and a few variables before running the outer interpreter.
When Itsy first runs it jumps to <code>abort</code> to set up the system.<br />
<code></code><br />
<pre><code> primitive 'abort',abort
xor ax,ax
mov word[val_state],ax
mov word[val_to_in],ax
mov word[val_number_t_i_b],ax
xchg ax,bp
mov sp,-256
mov si,xt_interpret+2
jmp next
</code></pre>
<br />
<h3>
Up and Running?</h3>
Itsy is now around 900 bytes and it's time to give the interpreter a quick test run:<br />
<div class="separator" style="clear: both; text-align: center;">
<span style="margin-left: 1em; margin-right: 1em;"><img alt="Itsy Forth" border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjC-ZfZ5wR6jsrEfUBYlWCq2x0_vTkpGzkayXmY-q4lfvdYpyzuxg1thqWW2q62UeCcs-spK9pzbROR21okH_ZCSCuTHSjvDPy6k-Pavdmw5qSemDGpno0IPYnyNjsADnsAY-_s2NkBAgM/s1600/itsy.png" /></span></div>
Everything seems to be working fine. Next we'll define the compiler so we can continue building Itsy from the Itsy prompt :-)John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com24tag:blogger.com,1999:blog-4757118446768919900.post-45385187690512257002012-04-03T14:47:00.000-07:002012-04-15T13:18:47.310-07:00Itsy-Forth: the Dictionary and Inner Interpreter<p><strong>Itsy Forth</strong> is a minimal Forth compiler implemented in under
1<acronym title="kilobyte">kB</acronym>. Earlier we examined
<a href="http://www.retroprogramming.com/2012/03/itsy-forth-1k-tiny-compiler.html">Itsy's outer interpreter</a>.
Now we take a closer look at the dictionary and inner interpreter.</p>
<h3>Forth Dictionary</h3>
<p>Itsy's dictionary is a linked list holding the name and code for each word (subroutine).
Each entry in the list has a header containing a link, counted string and
<acronym title="execution token">XT</acronym> (execution token).
For example here's the dictionary entry for <code>nip</code>:</p>
<code><pre>
; header
dw <i>link_to_previous_word</i>
db 3, 'nip'
xt_nip dw docolon
; body
dw xt_swap
dw xt_drop
dw xt_exit
</pre></code>
<p>The first line of the header links to the previous word in the dictionary. The second line
holds the word's name preceded by its length. The final line contains the
<acronym title="execution token">XT</acronym>, a pointer to the routine which performs the
actual operation of the word. Itsy uses four different <acronym title="execution token">XT</acronym>s:</p>
<ul>
<li><code>docolon</code> - The word is a list of pointers to <acronym title="execution token">XT</acronym>s.
Call each in turn.</li>
<li><code>doconst</code> - The word is a constant. Place its value on the data stack.</li>
<li><code>dovar</code> - The word is a variable. Place its address on the data stack.</li>
<li><i>pointer to body</i> - The word is a primitive (machine code). Execute it.</li>
</ul>
<h3>Macros</h3>
<p>I'm not a big fan of macros. They're ugly and lock the code to a particular assembler.
On the other hand they can add flexibility and make the code less prone to errors. Compare
the definition of <code>+</code> with and without macros:</p>
<p>Without macros:</p>
<code><pre>
dw <i>link_to_previous_word</i>
db 1, '+'
xt_plus dw mc_plus
mc_plus pop ax
add bx,ax
jmp next
</pre></code>
<p>With macros:</p>
<code><pre>
primitive '+',plus
pop ax
add bx,ax
jmp next
</pre></code>
<p>The <abbr title="netwide assembler">NASM</abbr> macros to set up headers and maintain the linked list are pretty simple:</p>
<code><pre>
%define link 0
%define immediate 080h
%macro head 4
%%link dw link
%define link %%link
%strlen %%count %1
db %3 + %%count,%1
xt_ %+ %2 dw %4
%endmacro
%macro primitive 2-3 0
head %1,%2,%3,$+2
%endmacro
%macro colon 2-3 0
head %1,%2,%3,docolon
%endmacro
%macro constant 3
head %1,%2,0,doconst
val_ %+ %2 dw %3
%endmacro
%macro variable 3
head %1,%2,0,dovar
val_ %+ %2 dw %3
%endmacro
</pre></code>
<h3>Macro Examples</h3>
<p><code>constant</code> is used to define a Forth constant. E.g. to define <code>false</code> = 0:</p>
<code><pre>
constant 'false',false,0
</pre></code>
<p><code>variable</code> creates a Forth variable. E.g. to create <code>base</code> and initialise to 10:</p>
<code><pre>
variable 'base',base,10
</pre></code>
<p><code>primitive</code> sets up an assembly language word. E.g. to create <code>drop</code>:</p>
<code><pre>
primitive 'drop',drop
pop bx
jmp next
</pre></code>
<p><code>colon</code> defines a compiled Forth word. E.g. to define <code>nip</code>:</p>
<code><pre>
colon 'nip',nip
dw xt_swap
dw xt_drop
dw xt_exit
</pre></code>
<h3>Register Allocation</h3>
<p>Itsy's use of the registers is similar to most 8086 Forths. The system stack is used
for the data stack while a register is used for the return stack. Note the top element
of the data stack is kept in a register to enhance performance:</p>
<ul>
<li><code>sp</code> - data stack pointer</li>
<li><code>bp</code> - return stack pointer</li>
<li><code>si</code> - Forth instruction pointer</li>
<li><code>di</code> - pointer to current <acronym title="execution token">XT</acronym></li>
<li><code>bx</code> - <acronym title="top of stack">TOS</acronym> (top of data stack)</li>
</ul>
<h3>Itsy's Inner Interpreter</h3>
<p>The Forth inner interpreter needs only three simple routines:</p>
<ul>
<li><code>docolon</code> - the <acronym title="execution token">XT</acronym> to enter a Forth word.
Save the Forth <acronym title="instruction pointer">IP</acronym> on the return stack then point it
to the word being entered.</li>
<li><code>exit</code> - return from a compiled Forth word. <code>exit</code> recovers the
Forth <acronym title="instruction pointer">IP</acronym> from the return stack.</li>
<li><code>next</code> - return from a primitive (machine code) word and call the next <acronym title="execution token">XT</acronym>.</li>
</ul>
<code><pre>
docolon dec bp
dec bp
mov word[bp],si
lea si,[di+2]
next lodsw
xchg di,ax
jmp word[di]
primitive 'exit',exit
mov si,word[bp]
inc bp
inc bp
jmp next
</pre></code>
<p>Next we'll define approx 30 words and finally get the <a href="http://www.retroprogramming.com/2012/04/itsy-forth-primitives.html">interpreter up and running</a>.
In the meantime I'd love to hear any comments on the code so far :-)</p>John Metcalfhttp://www.blogger.com/profile/09108374348083307900noreply@blogger.com4