Apple II

Apple II stuff.

Here are some links to a few of my favorite Apple II projects:

The disk image above contains source and object code for a few of my favorite assembly language, Pascal and Basic programs from bygone days. Here are a few samples.

Using the monitor in Kyan Pascal

Steve Wozniak's monitor is a familiar tool for debugging in Basic and Assembler. The ProDOS "mtr" command (or call -151) brings up a reassuring '*' prompt. I missed this feature in Kyan's Kix command line, so I wrote one. It hooks into control-Y, so you can easily return to the Kix prompt (%). Just run this code through AS and store the resulting binary in the Kix "bin" directory to create your own "mtr" command. It runs at $380, so it won't overwrite a previously loaded program.

;Enter monitor from Kix; J. Matthews; 26-Jul-03; GPL.

org $380

usradr equ $03F8 ;control-Y vector

mli equ $BF00

crout equ $FD8E

cout equ $FDED

monz equ $FF69

ldx #2 ;install control-Y vector

install lda vec,x

sta usradr,x

dex

bpl install

jsr crout

ldy msg

ldx #1

print lda msg,x

ora #$80

jsr cout

inx

dey

bne print

jsr crout

jmp monz

msg str 'Enter control-Y to resume.'

vec jmp exit

exit jsr mli

db $65

dw qlist

qlist db 4,0,0,0,0,0,0

This is pure assembly language, with no Kyan library loaded. There's not much to see, but it's handy for looking around ProDOS, tracing other code or doing a quick hex conversion.

More interestingly, it's possible to use the monitor to debug Pascal, as shown below. Each time the program does a "jsr break", it enters the monitor. Control-Y resumes normal execution until the next break, or the program ends. Zero page locations 4 and 5 hold the Kyan stack pointer, which grows downward from $9000, so you can use monitor commands to examine your stack variables. Locations $3F9 and $3FA hold the return address - 1, so you can examine your running code.

program DebugTest;

const MaxString = 16;

type String = array [1..MaxString] of char;

var s, t: String;

procedure SetDebug;

begin

usradr equ $03F8 ;control-Y vector

monz equ $FF69 ;monitor entry

lda #$4C

sta usradr

lda #>resume

sta usradr+1

lda #<resume

sta usradr+2

end;

break stx xreg

pla

sta pc

pla

sta pc+1

jmp monz

resume ldx xreg

lda pc+1

pha

lda pc

pha

rts

xreg db 0

pc dw 0

begin

SetDebug;

s := '****************';

t := '0123456789ABCDEF';

writeln(s, t);

jsr break

s := t;

jsr break

writeln(s, t);

end.

An hd command for Kix in Kyan Pascal

Although the Kyan Kix 'cat' command can produce a primitive hex dump for non-text files, I wanted something that could dump any file in both hex and ASCII. This version uses no parameters, but you can specify more than one file (or directory!) in the same command courtesy of the parseline function supplied by Kyan.

{10-Jul-03; J. Matthews; GPL}

program HD;

const MaxString = 127;

type String16 = array [1..16] of char;

String127 = array [1..MaxString] of char;

StrPointer = ^StrRecord;

StrRecord = record

StrFound: String127;

NextStr: StrPointer

end;

var sp: StrPointer;

#i other.lib/parseline.i

procedure HexByte(b: integer);

begin

prbyte equ $FDDA

stx _t

lda #$A0 ;space

jsr cout

ldy #5

lda (_sp),y

jsr prbyte

ldx _t

end;

procedure HexWord(w: integer);

begin

stx _t

ldy #6

lda (_sp),y

jsr prbyte

dey

lda (_sp),y

jsr prbyte

lda #$BA ;colon

jsr cout

ldx _t

end;

procedure Dump(name: String127);

var f: file of char;

i, j, k: integer;

s: String16;

begin

i := 1; j := 0;

reset(f, name);

while not eof(f) do begin

if i = 1 then HexWord(j);

k := ord(f^);

if (k > 31) and (k < 128) then

s[i] := chr(k)

else s[i] := '.';

HexByte(k);

i := i + 1;

if i > 16 then begin {line break}

writeln(' ', s);

i := 1;

j := j + 16

end;

get(f);

end;

if i > 1 then begin {partial line}

for k := i to 16 do write(' ');

write(' ');

for k := 1 to i - 1 do write(s[k]);

writeln

end

else writeln

end;

begin

sp := ParseLine;

sp := sp^.NextStr; {skip command name}

while sp <> nil do begin

Dump(sp^.StrFound);

sp := sp^.NextStr

end

end.

A df command for Kix in Kyan Pascal

Here's a 'df' command for the Kix command-line environment of Kyan Pascal. The program finds how much space is free on all mounted volumes; a similar result can be obtained in Kix with the 'ls -l /' command. The program uses the ProDOS MLI On_Line command ($C5) to find all mounted volumes. It then reads the directory header (block 2) to determine the volume's size. It also examines the volume bit map to find how much space is free. I especially like how easy it is to mix Pascal and assembly language. The version on the disk (above) was compiled as a system file, so you can run it even without Kix.

{25-Jul-03; J. Matthews; GPL}

program DF; {disk free space}

type VolumeName = array [0..15] of char;

VolumeNameArray = array [0..15] of VolumeName;

Buffer = array [0..511] of char;

var vna: VolumeNameArray;

buf: Buffer;

i, j, free, total, sumFree, sumTotal, sumVol,

unit, slot, drive, length: integer;

function BlockRead(u, b: Integer; var buf: Buffer): integer;

begin

BlockRead := 0;

ldy #7 ;buffer address

lda (_sp),y

sta blist+2

iny

lda (_sp),y

sta blist+3

iny ;block number

lda (_sp),y

sta blist+4

iny

lda (_sp),y

sta blist+5

iny ;unit number

lda (_sp),y

sta blist+1

jsr _mli ;read_block

db $80

dw blist

ldy #5 ;return error code

sta (_sp),y

end;

blist db 3,0,0,0,0,0

procedure OnLine(var v: VolumeNameArray);

begin

ldy #5 ;address of buffer

lda (_sp),y

sta onlist+2

iny

lda (_sp),y

sta onlist+3

jsr _mli

db $C5 ;on_line

dw onlist

end;

onlist db 2,0,0,0

function BitCount(var buf: Buffer): integer;

begin

BitCount := 0;

bptr equ _t

sum equ bptr+2

xsav equ sum+2

stx xsav

lda #0

sta sum ;init sum

sta sum+1

ldy #7 ;init buffer ptr

lda (_sp),y

sta bptr

iny

lda (_sp),y

sta bptr+1

jsr count ;first half

inc bptr+1

jsr count ;and second

ldy #5 ;store result

lda sum

sta (_sp),y

iny

lda sum+1

sta (_sp),y

ldx xsav

end;

count ldy #0 ;count a page

loop lda (bptr),y

beq count2 ;skip 0

cmp #$FF

bne count1

lda #8

bne add

count1 ldx #0

nxtbit lsr

pha

bcc skip

inx

skip pla

bne nxtbit

txa

add clc ;running total

adc sum

sta sum

bcc count2

inc sum+1

count2 iny

bne loop

rts

procedure FreeCount(u: integer; var f, t: integer; var buf: Buffer);

var i, firstMap, lastMap: integer;

begin

f := 0; t := 0;

if BlockRead(u, 2, buf) = 0 then begin

firstMap := ord(buf[39]) + (ord(buf[40]) * 256);

t := ord(buf[41]) + (ord(buf[42]) * 256);

lastMap := firstMap + (t div 4096);

for i := firstMap to lastMap do

if BlockRead(u, i, buf) = 0 then

f := f + BitCount(buf)

end

end;

procedure Decode(u: integer; var s, d, l: integer);

begin

s := (u div 16) mod 8;

d := (u div 128) + 1;

l := u mod 16;

end;

begin

sumFree := 0; sumTotal := 0; sumVol := 0;

OnLine(vna);

Writeln('Volumes on-line: free/total');

Writeln('---------------- ----------');

for i := 0 to 15 do begin

unit := ord(vna[i, 0]);

Decode(unit, slot, drive, length);

if length <> 0 then begin

sumVol := succ(sumVol);

FreeCount(unit, free, total, buf);

sumFree := sumFree + free;

sumTotal := sumTotal + total;

Write('S', slot, ',D', drive, ': /');

for j := 1 to length do Write(vna[i, j]);

for j := length to 16 do Write(' ');

Writeln(free, '/', total)

end

end;

Writeln;

Write(sumFree, '/', sumTotal, ' blocks free on ');

Writeln(sumVol, ' volumes.')

end.

Lo-res Library

A lo-res library for Kyan Pascal. Note that the 'plot' routine is optimized to use a lookup table rather than the monitor's 'gbascalc' code. The example below uses this code.

{07-Jul-03; J. Matthews; GPL}

{Set lo-res graphics, mixed mode, 40 column text}

procedure Gr;

begin

gbasl equ $26

h2 equ $2C

v2 equ $2D

mask equ $2E

color equ $30

plot1 equ $F80E

hline1 equ $F81C

scrn2 equ $F879

settxt equ $FB39

setgr equ $FB40

home equ $FC58

stx _t

lda #$11

jsr cout

jsr setgr

jsr home

ldx _t

end;

{Set lo-res graphics, 80 col text}

procedure Gr80;

begin

stx _t

lda #$12

jsr cout

jsr setgr

ldx _t

end;

{Set text mode, 80 column}

procedure Tx;

begin

stx _t

jsr settxt

lda #$12

jsr cout

ldx _t

end;

{Set color, 0 to 15}

procedure Color(c: integer);

begin

ldy #5

lda (_sp),y

and #$0F

sta color

asl a

ora color

sta color

end;

{Plot x, y with current color}

procedure Plot(x, y: integer);

begin

stx _t

ldy #5

lda (_sp),y

sta _t+1

ldy #7

lda (_sp),y

tay

lda _t+1

jsr plot

ldx _t

end;

{Get color of screen at x, y}

function Scrn(x, y: integer): integer;

begin

Scrn := 0;

stx _t

ldy #7

lda (_sp),y

sta _t+1

ldy #9

lda (_sp),y

tay

lda _t+1

jsr scrn

ldy #5

sta (_sp),y

ldx _t

end;

{Replace 'gbascalc' with lookup table}

plot lsr

tax

lda basl,x

sta gbasl

lda bash,x

sta gbasl+1

lda #$0F

bcc setmask

lda #$F0

setmask sta mask

jmp plot1

hline jsr plot

jmp hline1

vlinez adc #1

vline pha

jsr plot

pla

cmp v2

bcc vlinez

rts1 rts

scrn lsr

tax

lda basl,x

sta gbasl

lda bash,x

sta gbasl+1

lda (gbasl),y

jmp scrn2

basl db $00,$80,$00,$80,$00,$80,$00,$80

db $28,$A8,$28,$A8,$28,$A8,$28,$A8

db $50,$D0,$50,$D0,$50,$D0,$50,$D0

bash db $04,$04,$05,$05,$06,$06,$07,$07

db $04,$04,$05,$05,$06,$06,$07,$07

{Horizontal line from x1 to x2 at y}

procedure HLine(x1, x2, y: integer);

begin

stx _t

ldy #5

lda (_sp),y

sta _t+1

ldy #7

lda (_sp),y

sta h2

ldy #9

lda (_sp),y

tay

lda _t+1

jsr hline

ldx _t

end;

{Vertical line from y1 to y2 at x}

procedure VLine(y1, y2, x: integer);

begin

stx _t

ldy #9

lda (_sp),y

sta _t+1

ldy #7

lda (_sp),y

sta v2

ldy #5

lda (_sp),y

tay

lda _t+1

jsr vline

ldx _t

end;

{Return true if key pressed, character in ch}

function KeyPress(var ch: char):boolean;

begin

KeyPress := false;

bit $C000

bpl nokey

ldy #6

lda (_sp),y

sta _t

iny

lda (_sp),y

sta _t+1

lda $C000

and #$7F

ldy #0

sta (_t),y

sta $C010

ldy #5

lda #1

sta (_sp),y

nokey

end;

Rod's Color Pattern from the Red Book

Rod's Color Pattern, written in Basic by Randy Wigginton, originally appeared on page 55 of the Red Book distributed by Apple Computer, Inc. circa 1978. Running in just 4K of RAM, it was described as "a simple but eloquent program. It generates a continuous flow of colored mosaic-like patterns in a 40 high by 40 wide block matrix. Many of the patterns generated by this program are pleasing to the eye and will dazzle the mind for minutes at a time."

10 GR : ONERR GOTO 99

20 FOR W = 3 TO 50

30 FOR I = 1 TO 19

40 FOR J = 0 TO 19

50 K = I + J

60 COLOR= J * 3 / (I + 3) + I * W / 12

70 PLOT I,K: PLOT K,I: PLOT 40 - I,40 - K: PLOT 40 - K,40 - I

80 PLOT K,40 - I: PLOT 40 - I,K: PLOT I,40 - K: PLOT 40 - K,I

90 NEXT : NEXT : NEXT : GOTO 20

99 TEXT : HOME : END

Rod's Color Pattern in Java

Faster: In the ensuing years, the program has been migrated to other languages and platforms. Here's the same program in Java, adapted by David Schmenk to run on his virtual machine for the Apple II.

import apple2.*;

public class Rod {

public static void main(String args[]) {

int i, j, k, w, fmi, fmk, color;

AppleStuff.loRes();

while (true) {

for (w = 3; w <= 50; ++w) {

for (i = 1; i <= 19; ++i) {

for (j = 0; j <= 19; ++j) {

k = i + j;

color = (j * 3) / (i + 3) + i * w / 12;

fmi = 40 - i;

fmk = 40 - k;

AppleStuff.lrColor(color);

AppleStuff.lrPlot(i, k);

AppleStuff.lrPlot(k, i);

AppleStuff.lrPlot(fmi, fmk);

AppleStuff.lrPlot(fmk, fmi);

AppleStuff.lrPlot(k, fmi);

AppleStuff.lrPlot(fmi, k);

AppleStuff.lrPlot(i, fmk);

AppleStuff.lrPlot(fmk, i);

if (AppleStuff.keyPressed()) {

AppleStuff.text();

System.exit(0);

}

Rod's Color Pattern in Pascal

Faster: Here's the same program in Pascal (Kyan). It uses the lo-res library described above.

program Rod;

label 99;

var i, j, k, w: integer;

fmi, fmk: integer;

c: char;

#i lores.i

begin

Gr;

Writeln;

Writeln('Press any key to exit');

repeat

for w := 3 to 50 do begin

for i := 1 to 19 do begin

for j := 0 to 19 do begin

k := i + j;

Color(j * 3 div (i + 3) + i * w div 12);

fmi := 40 - i; fmk := 40 - k;

Plot(i, k); Plot(k, i);

Plot(fmi, fmk); Plot(fmk, fmi);

Plot(k, fmi); Plot(fmi, k);

Plot(i, fmk); Plot(fmk, i);

if KeyPress(c) then goto 99

end

end;

until false;

99: Tx;

end.

Rod's Color Pattern in C

#include <stdlib.h>

#include <conio.h>

#include <tgi.h>

extern char a2e_lo_install; // lo-res driver entry

unsigned char i, j, k, w, fmi, fmk;

unsigned int color;

int main(void) {

tgi_install(&a2e_lo_install);

tgi_init();

while (1) {

for (w = 3; w <= 50; ++w) {

for (i = 1; i <= 19; ++i) {

for (j = 0; j <= 19; ++j) {

k = i + j;

color = (j * 3) / (i + 3) + i * w / 12;

tgi_setcolor(color & 0x0f);

fmi = 40 - i; fmk = 40 - k;

tgi_setpixel(i, k); tgi_setpixel(k, i);

tgi_setpixel(fmi, fmk); tgi_setpixel(fmk, fmi);

tgi_setpixel(k, fmi); tgi_setpixel(fmi, k);

tgi_setpixel(i, fmk); tgi_setpixel(fmk, i);

if (kbhit() > 0) {

cgetc();

tgi_clear();

tgi_uninstall();

return EXIT_SUCCESS;

}

Rod's Color Pattern in Assembler

Fastest: here's the corresponding assembly language version I wrote for the Apple-Dayton Journal in March, 1982. It was re-published in Apple-Orchard in early 1983. Note that the plot routine (line 119) is optimized to use a lookup table rather than the monitor's 'gbascalc' code. Neil Parker describes several other optimizations to the original code; his page includes a delightful applet that recreates the original program.

0000: 1 LST ON,Gen

0000: 2 * ROD's Color Pattern by J. Matthews

----- NEXT OBJECT FILE NAME IS ROD.0

2000: 2000 3 org $2000

2000: 0028 4 forty equ $28

2000: 0026 5 gbasl equ $26

2000: 0030 6 color equ $30

2000: 003A 7 textpt equ $3A

2000: 003C 8 A1 equ $3C

2000: 003E 9 A2 equ $3E

2000: 0040 10 A3 equ $40

2000: 0042 11 A4 equ $42

2000: 0044 12 A5 equ $44

2000: 00E0 13 w equ $E0

2000: 00E1 14 i equ $E1

2000: 00E2 15 j equ $E2

2000: 00E3 16 k equ $E3

2000: 00E4 17 fmi equ $E4

2000: 00E5 18 fmk equ $E5

2000: C000 19 key equ $C000

2000: C010 20 strobe equ $C010

2000: FB1E 21 pread equ $FB1E

2000: FB39 22 settx equ $FB39

2000: FB40 23 setgr equ $FB40

2000: FB5B 24 vtab equ $FB5B

2000: FC58 25 clear equ $FC58

2000: FCA8 26 wait equ $FCA8

2000: FDF0 27 cout1 equ $FDF0

2000: 28 *

2000: 29 * Set lo-res, mixed graphics & text, page 1

2000: 30 *

2000:20 40 FB 31 jsr setgr

2003:20 58 FC 32 jsr clear

2006:A9 16 33 lda #$16

2008:20 5B FB 34 jsr vtab

200B:20 29 21 35 jsr prtext

200E:20 20 20 50 36 asc " PDL(0) controls speed of display"

2012:44 4C 28 30

2016:29 20 63 6F

201A:6E 74 72 6F

201E:6C 73 20 73

2022:70 65 65 64

2026:20 6F 66 20

202A:64 69 73 70

202E:6C 61 79

2031:8D 37 dfb $8D

2032:20 20 20 20 38 asc " Press any key to exit."

2036:20 20 20 20

203A:50 72 65 73

203E:73 20 61 6E

2042:79 20 6B 65

2046:79 20 74 6F

204A:20 65 78 69

204E:74 2E

2050:00 39 dfb $00

2051:A9 03 40 start lda #$03 ;init loop counters

2053:85 E0 41 sta w

2055:A9 01 42 nxtw lda #$01

2057:85 E1 43 sta i

2059:A9 00 44 nxti lda #$00

205B:85 E2 45 sta j

205D:18 46 nxtj clc

205E:A5 E1 47 lda i

2060:65 E2 48 adc j

2062:85 E3 49 sta k

2064:20 4A 21 50 jsr colsel

2067:A4 E1 51 ldy i ;plot i,k

2069:A5 E3 52 lda k

206B:20 E9 20 53 jsr plot

206E:A4 E3 54 ldy k ;plot k,i

2070:A5 E1 55 lda i

2072:20 E9 20 56 jsr plot

2075:38 57 sec ;plot 40-i, 40-k

2076:A9 28 58 lda #forty

2078:E5 E1 59 sbc i

207A:85 E4 60 sta fmi

207C:A8 61 tay

207D:38 62 sec

207E:A9 28 63 lda #forty

2080:E5 E3 64 sbc k

2082:85 E5 65 sta fmk

2084:20 E9 20 66 jsr plot

2087:A4 E5 67 ldy fmk ;plot 40-k, 40-i

2089:A5 E4 68 lda fmi

208B:20 E9 20 69 jsr plot

208E:A4 E3 70 ldy k ;plot k, 40-i

2090:A5 E4 71 lda fmi

2092:20 E9 20 72 jsr plot

2095:A4 E4 73 ldy fmi ;plot 40-i, k

2097:A5 E3 74 lda k

2099:20 E9 20 75 jsr plot

209C:A4 E1 76 ldy i ;plot i, 40-k

209E:A5 E5 77 lda fmk

20A0:20 E9 20 78 jsr plot

20A3:A4 E5 79 ldy fmk ;plot 40-k, i

20A5:A5 E1 80 lda i

20A7:20 E9 20 81 jsr plot

20AA:20 C8 20 82 jsr delay

20AD:E6 E2 83 inc j ;close loops

20AF:A5 E2 84 lda j

20B1:C9 14 85 cmp #$14

20B3:90 A8 205D 86 blt nxtj

20B5:E6 E1 87 inc i

20B7:A5 E1 88 lda i

20B9:C9 14 89 cmp #$14

20BB:90 9C 2059 90 blt nxti

20BD:E6 E0 91 inc w

20BF:A5 E0 92 lda w

20C1:C9 33 93 cmp #$33

20C3:90 90 2055 94 blt nxtw

20C5:4C 51 20 95 jmp start

20C8: 96 *

20C8: 97 * Delay by setting of PDL(0)

20C8: 98 *

20C8:A2 00 99 delay ldx #$00

20CA:20 1E FB 100 jsr pread ;read pdl(o)

20CD:98 101 tya

20CE:4A 102 lsr ;divide by 4

20CF:4A 103 lsr

20D0:F0 03 20D5 104 beq del1

20D2:20 A8 FC 105 jsr wait

20D5:2C 00 C0 106 del1 bit key ;key pressed

20D8:30 01 20DB 107 bmi exit

20DA:60 108 rts

20DB:68 109 exit pla ;pop stack

20DC:68 110 pla

20DD:2C 10 C0 111 bit strobe ;clear strobe

20E0:20 39 FB 112 jsr settx

20E3:20 58 FC 113 jsr clear

20E6:4C D0 03 114 jmp $3D0 ;exit via ProDOS

20E9: 115 *

20E9: 116 * Plot via table lookup

20E9: 117 * A = y coordinate; Y = x coordinate

20E9: 118 *

20E9:4A 119 plot lsr

20EA:08 120 php

20EB:AA 121 tax

20EC:BD F9 20 122 lda basl,x

20EF:85 26 123 sta gbasl

20F1:BD 11 21 124 lda bash,x

20F4:85 27 125 sta gbasl+1

20F6:4C 05 F8 126 jmp $F805

20F9:00 80 00 80 127 basl dfb $00,$80,$00,$80,$00,$80,$00,$80

20FD:00 80 00 80

2101:28 A8 28 A8 128 dfb $28,$A8,$28,$A8,$28,$A8,$28,$A8

2105:28 A8 28 A8

2109:50 D0 50 D0 129 dfb $50,$D0,$50,$D0,$50,$D0,$50,$D0

210D:50 D0 50 D0

2111:04 04 05 05 130 bash dfb $04,$04,$05,$05,$06,$06,$07,$07

2115:06 06 07 07

2119:04 04 05 05 131 dfb $04,$04,$05,$05,$06,$06,$07,$07

211D:06 06 07 07

2121:04 04 05 05 132 dfb $04,$04,$05,$05,$06,$06,$07,$07

2125:06 06 07 07

2129: 133 *

2129: 134 * Print text up to next null

2129: 135 *

2129:68 136 prtext pla

212A:85 3A 137 sta textpt

212C:68 138 pla

212D:85 3B 139 sta textpt+1

212F:A0 00 140 ldy #$00

2131:E6 3A 141 prt1 inc textpt

2133:D0 02 2137 142 bne prt2

2135:E6 3B 143 inc textpt+1

2137:B1 3A 144 prt2 lda (textpt),y

2139:F0 08 2143 145 beq prt3

213B:09 80 146 ora #$80

213D:20 F0 FD 147 jsr cout1

2140:4C 31 21 148 jmp prt1

2143:A5 3B 149 prt3 lda textpt+1

2145:48 150 pha

2146:A5 3A 151 lda textpt

2148:48 152 pha

2149:60 153 rts

214A: 154 *

214A: 155 * Color = j*3/(i+3)+i*w/12

214A: 156 *

214A:18 157 colsel clc ;A5 = j*3

214B:A5 E2 158 lda j

214D:65 E2 159 adc j

214F:65 E2 160 adc j

2151:85 44 161 sta A5

2153:A5 E1 162 lda i ;A4 = i+3

2155:69 03 163 adc #$03

2157:85 42 164 sta A4

2159:A0 FF 165 ldy #$FF ;A5 = A5/A4

215B:38 166 sec

215C:A5 44 167 lda A5

215E:E5 42 168 divi3 sbc A4

2160:C8 169 iny

2161:B0 FB 215E 170 bcs divi3

2163:84 44 171 sty A5

2165:A5 E1 172 lda i ;A1 = i

2167:85 3C 173 sta A1

2169:A5 E0 174 lda w ;A2 = w

216B:85 3E 175 sta A2

216D:A9 00 176 lda #$00 ;A3 = A1*A2

216F:85 41 177 sta A3+1

2171:A2 08 178 ldx #$08

2173:0A 179 shift asl

2174:26 41 180 rol A3+1

2176:06 3E 181 asl A2

2178:90 07 2181 182 bcc bitcnt

217A:18 183 clc

217B:65 3C 184 adc A1

217D:90 02 2181 185 bcc bitcnt

217F:E6 41 186 inc A3+1

2181:CA 187 bitcnt dex

2182:D0 EF 2173 188 bne shift

2184:85 40 189 sta A3

2186:A9 0C 190 lda #$0C ;A2 = 12

2188:85 3E 191 sta A2

218A:A2 08 192 ldx #$08

218C:A5 40 193 lda A3 ; A1 = A3

218E:85 3C 194 sta A1

2190:A5 41 195 lda A3+1 ;A1 = A1/A2

2192:06 3C 196 div asl A1

2194:2A 197 rol A

2195:C5 3E 198 cmp A2

2197:90 04 219D 199 bcc bcnt

2199:E5 3E 200 sbc A2

219B:E6 3C 201 inc A1

219D:CA 202 bcnt dex

219E:D0 F2 2192 203 bne div

21A0:18 204 clc ;A = A1+A5

21A1:A5 3C 205 lda A1

21A3:65 44 206 adc A5

21A5:29 0F 207 and #$0F ;copy to upper nibble

21A7:85 30 208 sta color

21A9:0A 209 asl

21AA:0A 210 asl

21AB:0A 211 asl

21AC:0A 212 asl

21AD:05 30 213 ora color

21AF:85 30 214 sta color

21B1:60 215 rts

Distribution permitted under the terms of the GNU Public License.

Last updated 1-Nov-2009