6502.org Forum  Projects  Code  Documents  Tools  Forum
It is currently Mon Apr 29, 2024 8:02 am

All times are UTC




Post new topic Reply to topic  [ 25 posts ]  Go to page 1, 2  Next
Author Message
PostPosted: Thu Sep 23, 2021 12:47 pm 
Offline

Joined: Tue Jul 24, 2012 2:27 am
Posts: 672
Here's a little novelty I banged up. 86 lines of BASIC (3314 bytes tokenized) for a decently featured assembling/disassembling monitor.

I tried to write something like this back when I was a wee little ember with a C64, some docs, and no dev tools, but couldn't hack it back then. After recently seeing an old book with a type-in monitor (and screaming internally about its performance & size issues), I decided to take another crack at it, many decades later when it's wholly, utterly unnecessary. ;)

If anybody actually decides to try this, let me know if there are any edge case bugs still lurking and I'll still get 'em fixed. (The INPUT statement is horrible and requires hackish workarounds.) Here's a .prg version: https://white-flame.com/heymon.prg

Documentation:
Code:
;; Commands:
;;  a [address] = assemble
;;  d [address] = disassemble
;;  m [address] = display memory
;;  w [address] = write memory, one byte or word at a time
;;  g [address] = go run machine code, RTS returns to the monitor
;;  s = save
;;  l = load
;;  +<dec> = dec->hex
;;  $<hex> = hex->dec
;;  r = display regs
;;  r <reg> <val> = set a, x, or y
;;
;; Numbers default to hex, but prefixes $ff and +255 are supported everywhere


Just the BASICs:
Code:
    0 goto998
   10 data1brk,2ora(x),,,,2ora,2asl,,1php,2ora#,1asl,,,3ora,3asl,
   11 data2bpl,2ora()y,,,,2orax,2aslx,,1clc,3oray,,,,3orax,3aslx,
   12 data3jsr,2and(x),,,2bit,2and,2rol,,1plp,2and#,1rol,,3bit,3and,3rol,
   13 data2bmi,2and()y,,,,2andx,2rolx,,1sec,3andy,,,,3andx,3rolx,
   14 data1rti,2eor(x),,,,2eor,2lsr,,1pha,2eor#,1lsr,,3jmp,3eor,3lsr,
   15 data2bvc,2eor()y,,,,2eorx,2lsrx,,1cli,3eory,,,,3eorx,3lsrx,
   16 data1rts,2adc(x),,,,2adc,2ror,,1pla,2adc#,1ror,,3jmp(),3adc,3ror,
   17 data2bvs,2adc()y,,,,2adcx,2rorx,,1sei,3adcy,,,,3adcx,3rorx,
   18 data,2sta(x),,,2sty,2sta,2stx,,1dey,,1txa,,3sty,3sta,3stx,
   19 data2bcc,2sta()y,,,2styx,2stax,2stxy,,1tya,3stay,1txs,,,3stax,,
   20 data2ldy#,2lda(x),2ldx#,,2ldy,2lda,2ldx,,1tay,2lda#,1tax,,3ldy,3lda,3ldx,
   21 data2bcs,2lda()y,,,2ldyx,2ldax,2ldxy,,1clv,3lday,1tsx,,3ldyx,3ldax,3ldxy,
   22 data2cpy#,2cmp(x),,,2cpy,2cmp,2dec,,1iny,2cmp#,1dex,,3cpy,3cmp,3dec,
   23 data2bne,2cmp()y,,,,2cmpx,2decx,,1cld,3cmpy,,,,3cmpx,3decx,
   24 data2cpx#,2sbc(x),,,2cpx,2sbc,2inc,,1inx,2sbc#,1nop,,3cpx,3sbc,3inc,
   25 data2beq,2sbc()y,,,,2sbcx,2incx,,1sed,3sbcy,,,,3sbcx,3incx,
   49 i=1
   50 ba=16:t$=mid$(h$,i,1):ift$="+"ort$="$"thenba=16+6*(t$="+"):i=i+1
   51 ifi>len(h$)thend=-1:return
   52 d=.:nd=.:fori=itolen(h$):t=asc(mid$(h$,i,1))-48:ift>10thent=t-7
   53 ift>=0andt<bathend=d*ba+t:nd=nd+1:next
   54 ifnd=0thend=-1:return
   55 h=int(d/256):l=d-h*256:ifba=10thennd=2:ifhthennd=4
   56 return
   60 t=4096:j=1:goto62
   61 t=16:j=3
   62 forj=jto4:e=(d/t)and15:printchr$(48+e-(e>9)*7);:d=d-e*t:t=t/16:next:return
   70 d=p:gosub60:poke631,34:poke198,1:input#5,h$:return
  100 gosub70:ifh$=""thenprint:return
  101 t=fre(0):iflen(h$)=3thenk$=h$:d=-1:b=1:goto108
  102 k$=left$(h$,3):ifmid$(h$,4,1)<>" "thenprint"!!bad syntax":goto100
  103 i=5:t$=mid$(h$,5,1):ift$="#"ort$="("thenk$=k$+t$:i=6
  104 gosub50:ifd<0ord>65535thenprint"!!bad operand":goto100
  105 fori=itolen(h$):t$=mid$(h$,i,1):ift$<>","thenk$=k$+t$
  106 next:b=2-(nd>2)
  107 ifleft$(k$,1)="b"andleft$(k$,3)<>"brk"thengosub113
  108 k$=chr$(48+b)+k$:restore:t=-1:fori=0to255:readt$:ift$<>k$thennext
  109 ift$=k$thent=i:i=255:next
  110 ift<0thenprint"!!bad instruction":goto100
  111 pokep,t:ifb>1thenpokep+1,l:ifb>2thenpokep+2,h
  112 p=p+b:print"  ok":goto100
  113 d=d-p-2:ifd<-128ord>127thenprint"!!bad branch range":goto100
  114 l=dand255:b=2:return
  150 fork=1to12:t=peek(p):restore:fori=0tot:readk$:next:ifk$=""thenk$="1???"
  151 b=val(left$(k$,1)):d=p:gosub60
  152 fori=1tob:d=peek(p+i-1):print" ";:gosub61:next
  153 printspc(10-b*3);mid$(k$,2,3);" ";
  154 i=5:t$=mid$(k$,i,1):ift$="("ort$="#"thenprintt$;:i=6
  155 ifb>1thenprint"$";:d=peek(p+1):ifb=3thend=d+256*peek(p+2):gosub60:goto158
  156 ifmid$(k$,2,1)="b"andpeek(p)thend=d+2+p+256*(d>=128):gosub60:goto158
  157 ifb=2thengosub61
  158 fori=itolen(k$):t$=mid$(k$,i,1):ift$="x"ort$="y"thenprint",";
  159 printt$;:next:p=p+b:print:next:return
  200 fork=1to8:d=p:gosub60:fori=0to7:print" ";:d=peek(p+i):gosub61:next
  201 print" ";:fori=0to7:d=peek(p+i):if(dand127)>31thenprintchr$(d);:next
  202 if(dand127)<32thenprint"{rvon}";chr$((dand31)+64);"{rvof}";:next
  203 print:p=p+8:next:return
  250 gosub70:print:ifh$=""thenreturn
  251 gosub49:ifd<0ord>65535thenprint" bad number":goto250
  252 pokep,l:p=p+1:ifnd>2thenpokep,h:p=p+1
  253 goto250
  300 sysp:goto354
  350 iflen(h$)=1then354
  351 i=5:gosub50:ifd<0ord>255thenprint" bad number":return
  352 t$=mid$(h$,3,1):fori=1to3:ift$=mid$("axy",i,1)thenpoke(779+i),d
  353 next
  354 print" a  x  y":fori=0to2:print" ";:d=peek(780+i):gosub61:next:print:return
  400 input"filename,sa,ea";k$,h$,t2$:ifk$=""thenreturn
  401 open15,8,15,"s:"+k$:close15:gosub49:sa=d
  402 open1,8,1,k$+",p,w":print#1,chr$(l);chr$(h);:h$=t2$:gosub49
  403 fori=satod:print#1,chr$(peek(i));:next:close1
  404 open15,8,15:input#15,n,m$,t,s:printn;m$;t;s:close15:return
  450 input"filename";k$:ifk$=""thenreturn
  451 close5:loadk$,8,1:open5,0:goto404
  500 gosub49:gosub60:print:return
  550 gosub49:printd:return
  998 clr:open5,0:p=49152:print"{down}heymon v1 - white flame 2021"
  999 h$="r":goto1001
 1000 d=p:gosub60:print"> ";:input#5,h$:print
 1001 t$=left$(h$,1):k=0:k$="xadmwgrsl+$"
 1002 k=0:fori=1tolen(k$):ift$=mid$(k$,i,1)thenk=i:i=99
 1003 next:ifk<=6theni=3:gosub50:ifd>=0thenp=d
 1004 onkgosub9999,100,150,200,250,300,350,400,450,500,550
 1005 goto1000
 9999 end


Full documented source:
Code:
;; HeyMon, a monitor written in C64 BASIC
;; by White Flame, 2021

;; Snip lines at 80 chars to eliminate the rhs comments, and trim whitespace:
;;  cut -c -80 heymon.txt | sed 's/ *$//' | petcat -w2 -o heymon.prg

;; Commands:
;;  a [address] = assemble
;;  d [address] = disassemble
;;  m [address] = display memory
;;  w [address] = write memory, one byte or word at a time
;;  g [address] = go run machine code, RTS returns to the monitor
;;  s = save
;;  l = load
;;  +<dec> = dec->hex
;;  $<hex> = hex->dec
;;  r = display regs
;;  r <reg> <val> = set a, x, or y
;;
;; Numbers default to hex, but prefixes $ff and +255 are supported everywhere


; A minimal set of variables are generally reused:
;  P = program counter
;  H$ = hex/main input string
;  D = numeric value of H$, number to print as hex
;  H,L = high/low bytes of D
;  B = number of bytes in the current instruction
;  K$ = instruction key from DATA statements
;  T,T$ = temporaries
;  I,J,K = iteration counters, I often traverses H$


0 goto998                                                                       ;; Jump to main code at end, so data & subroutines are at the top

;;-----------------------
;; Instruction reference

;; Concatenated num bytes, mnemonic, operand prefix char, operand suffix (without commas)

10 data1brk,2ora(x),,,,2ora,2asl,,1php,2ora#,1asl,,,3ora,3asl,
11 data2bpl,2ora()y,,,,2orax,2aslx,,1clc,3oray,,,,3orax,3aslx,
12 data3jsr,2and(x),,,2bit,2and,2rol,,1plp,2and#,1rol,,3bit,3and,3rol,
13 data2bmi,2and()y,,,,2andx,2rolx,,1sec,3andy,,,,3andx,3rolx,
14 data1rti,2eor(x),,,,2eor,2lsr,,1pha,2eor#,1lsr,,3jmp,3eor,3lsr,
15 data2bvc,2eor()y,,,,2eorx,2lsrx,,1cli,3eory,,,,3eorx,3lsrx,
16 data1rts,2adc(x),,,,2adc,2ror,,1pla,2adc#,1ror,,3jmp(),3adc,3ror,
17 data2bvs,2adc()y,,,,2adcx,2rorx,,1sei,3adcy,,,,3adcx,3rorx,
18 data,2sta(x),,,2sty,2sta,2stx,,1dey,,1txa,,3sty,3sta,3stx,
19 data2bcc,2sta()y,,,2styx,2stax,2stxy,,1tya,3stay,1txs,,,3stax,,
20 data2ldy#,2lda(x),2ldx#,,2ldy,2lda,2ldx,,1tay,2lda#,1tax,,3ldy,3lda,3ldx,
21 data2bcs,2lda()y,,,2ldyx,2ldax,2ldxy,,1clv,3lday,1tsx,,3ldyx,3ldax,3ldxy,
22 data2cpy#,2cmp(x),,,2cpy,2cmp,2dec,,1iny,2cmp#,1dex,,3cpy,3cmp,3dec,
23 data2bne,2cmp()y,,,,2cmpx,2decx,,1cld,3cmpy,,,,3cmpx,3decx,
24 data2cpx#,2sbc(x),,,2cpx,2sbc,2inc,,1inx,2sbc#,1nop,,3cpx,3sbc,3inc,
25 data2beq,2sbc()y,,,,2sbcx,2incx,,1sed,3sbcy,,,,3sbcx,3incx,


;;--------------
;; Parse number

;; Parse H$ starting from character I into D/H/L, from "+255", "FF", or "$FF", any number of digits
;; Stops at end of string or at any non-numeric character, leaves I intact on return
;; D = -1 if no digits
;; ND = number of actual digits processed, to distinguish zp $ff from abs $00ff.  In dec this fakes 2 or 4 digits based on the number being >255
;; BA = base, either 16 or 10

49 i=1                                                                          ;; Force start from the beginning of the string
50 ba=16:t$=mid$(h$,i,1):ift$="+"ort$="$"thenba=16+6*(t$="+"):i=i+1             ;; Calculate base & skip over optional prefix
51 ifi>len(h$)thend=-1:return                                                   ;; Empty string fails
52 d=.:nd=.:fori=itolen(h$):t=asc(mid$(h$,i,1))-48:ift>10thent=t-7              ;; Loop through the string, always trying hex digits
53 ift>=0andt<bathend=d*ba+t:nd=nd+1:next                                       ;; Compare with base, loop.  If we hit the end of the string, flag with I=-1
54 ifnd=0thend=-1:return                                                        ;; No actual digits means exit
55 h=int(d/256):l=d-h*256:ifba=10thennd=2:ifhthennd=4                           ;; Exit, keep I and D where they are, calc L and H, calc ND if in decimal mode
56 return


;;---------------------
;; Print hex number

;; Print D has a hex number
;; GOSUB 60 for 16 bit
;; GOSUB 61 for 8 bit
;; We can't use bitwise AND if the number is >32768, so that sucks.  Need to whittle down the value of D as we go

60 t=4096:j=1:goto62                                                            ;; Divide by T to get the current hex digit, J=iteration up to 4
61 t=16:j=3
62 forj=jto4:e=(d/t)and15:printchr$(48+e-(e>9)*7);:d=d-e*t:t=t/16:next:return


;;--------------
;; Input a line

70 d=p:gosub60:poke631,34:poke198,1:input#5,h$:return                           ;; Inject a " into the input buffer, to contain commas and allow empty input


;;-------------
;; Assembler

100 gosub70:ifh$=""thenprint:return                                             ;; Print prompt, input, exit on blank line.
101 t=fre(0):iflen(h$)=3thenk$=h$:d=-1:b=1:goto108                              ;; Simple 1 byte instruction, no operand.
                                                                                ;;  The FRE prevents ?FORMULA TOO COMPLEX on line 102 after a few instructions?
102 k$=left$(h$,3):ifmid$(h$,4,1)<>" "thenprint"!!bad syntax":goto100           ;; Extract mnemonic into key (K$) & check space
103 i=5:t$=mid$(h$,5,1):ift$="#"ort$="("thenk$=k$+t$:i=6                        ;; Check for operand prefix character, append to key
104 gosub50:ifd<0ord>65535thenprint"!!bad operand":goto100                      ;; Parse operand
105 fori=itolen(h$):t$=mid$(h$,i,1):ift$<>","thenk$=k$+t$                       ;; Add suffix to key, but skipping any commas
106 next:b=2-(nd>2)                                                             ;; Calc number of bytes
107 ifleft$(k$,1)="b"andleft$(k$,3)<>"brk"thengosub113                          ;; Fixup branch address for all "Bxx" instructions, except BRK
108 k$=chr$(48+b)+k$:restore:t=-1:fori=0to255:readt$:ift$<>k$thennext           ;; Search for key in DATA statements, (T=opcode)
109 ift$=k$thent=i:i=255:next
110 ift<0thenprint"!!bad instruction":goto100
111 pokep,t:ifb>1thenpokep+1,l:ifb>2thenpokep+2,h                               ;; Store instruction into memory
112 p=p+b:print"  ok":goto100                                                   ;; Advance
113 d=d-p-2:ifd<-128ord>127thenprint"!!bad branch range":goto100                ;; Subroutine, calc & range check branch destination
114 l=dand255:b=2:return                                                        ;; compute operand byte and set instruction length to 2




;;---------------
;; Disassembler

150 fork=1to12:t=peek(p):restore:fori=0tot:readk$:next:ifk$=""thenk$="1???"     ;; Get spec string for this opcode byte into K$
151 b=val(left$(k$,1)):d=p:gosub60                                              ;; Extract number of bytes, print PC
152 fori=1tob:d=peek(p+i-1):print" ";:gosub61:next                              ;; Print hex dump
153 printspc(10-b*3);mid$(k$,2,3);" ";                                          ;; Print mnemonic
154 i=5:t$=mid$(k$,i,1):ift$="("ort$="#"thenprintt$;:i=6                        ;; Print prefix
155 ifb>1thenprint"$";:d=peek(p+1):ifb=3thend=d+256*peek(p+2):gosub60:goto158   ;; Calculate & print operand (16bit)
156 ifmid$(k$,2,1)="b"andpeek(p)thend=d+2+p+256*(d>=128):gosub60:goto158        ;;   branch
157 ifb=2thengosub61                                                            ;;   8bit
158 fori=itolen(k$):t$=mid$(k$,i,1):ift$="x"ort$="y"thenprint",";               ;; Print suffix, adding in commas before X or Y
159 printt$;:next:p=p+b:print:next:return                                       ;; Advance


;;--------------
;; Memory dump

200 fork=1to8:d=p:gosub60:fori=0to7:print" ";:d=peek(p+i):gosub61:next          ;; Dump byte values
201 print" ";:fori=0to7:d=peek(p+i):if(dand127)>31thenprintchr$(d);:next        ;; Dump characters
202 if(dand127)<32thenprint"{rvon}";chr$((dand31)+64);"{rvof}";:next
203 print:p=p+8:next:return                                                     ;; Loop


;;----------------
;; Memory write

250 gosub70:print:ifh$=""thenreturn                                             ;; Line input
251 gosub49:ifd<0ord>65535thenprint" bad number":goto250                        ;; Convert & check
252 pokep,l:p=p+1:ifnd>2thenpokep,h:p=p+1                                       ;; Poke either 1 or 2 bytes depending on size
253 goto250


;;------------
;; Execute

300 sysp:goto354                                                                ;; Show regs after ML routine finishes


;;-----------------
;; Set or Show Registers

350 iflen(h$)=1then354                                                          ;; If more than just "r", set a register
351 i=5:gosub50:ifd<0ord>255thenprint" bad number":return                       ;; Parse the numeric parameter
352 t$=mid$(h$,3,1):fori=1to3:ift$=mid$("axy",i,1)thenpoke(779+i),d             ;; Set a/x/y by poking into BASIC register buffer
353 next
354 print" a  x  y":fori=0to2:print" ";:d=peek(780+i):gosub61:next:print:return ;; Register dump

;;--------
;; Save

400 input"filename,sa,ea";k$,h$,t2$:ifk$=""thenreturn
401 open15,8,15,"s:"+k$:close15:gosub49:sa=d
402 open1,8,1,k$+",p,w":print#1,chr$(l);chr$(h);:h$=t2$:gosub49
403 fori=satod:print#1,chr$(peek(i));:next:close1
404 open15,8,15:input#15,n,m$,t,s:printn;m$;t;s:close15:return


;;--------
;; Load

450 input"filename";k$:ifk$=""thenreturn
451 close5:loadk$,8,1:open5,0:goto404                                           ;; If the load succees, program restarts.  Else, reopen keyboard & display error

;;-----------
;; Dec->Hex

500 gosub49:gosub60:print:return

;;-----------
;; Hex->Dec

550 gosub49:printd:return

;;-----------
;; Main loop

998 clr:open5,0:p=49152:print"{down}heymon v1 - white flame 2021"               ;; This can re-run after LOAD, so ready for that.  Open keyboard for INPUT#
999 h$="r":goto1001                                                             ;; Run the register display on startup, for no good reason
1000 d=p:gosub60:print"> ";:input#5,h$:print                                    ;; Show PC and get input
1001 t$=left$(h$,1):k=0:k$="xadmwgrsl+$"                                        ;; Convert 1st character to an offset in this string
1002 k=0:fori=1tolen(k$):ift$=mid$(k$,i,1)thenk=i:i=99             
1003 next:ifk<=6theni=3:gosub50:ifd>=0thenp=d                                   ;; The first few instructions all take an optional param to set the PC
1004 onkgosub9999,100,150,200,250,300,350,400,450,500,550                       ;; Dispatch
1005 goto1000                                                                   ;; Loop

9999 end

_________________
WFDis Interactive 6502 Disassembler
AcheronVM: A Reconfigurable 16-bit Virtual CPU for the 6502 Microprocessor


Last edited by White Flame on Thu Sep 23, 2021 8:59 pm, edited 2 times in total.

Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 23, 2021 2:48 pm 
Offline
User avatar

Joined: Thu Dec 11, 2008 1:28 pm
Posts: 10793
Location: England
Splendid!


Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 23, 2021 6:32 pm 
Offline
User avatar

Joined: Thu May 28, 2009 9:46 pm
Posts: 8155
Location: Midwestern USA
The BASIC input statement is pretty lame in Microsoft BASIC. In the timesharing Business BASIC dialects, INPUT is very sophisticated and includes options such as input size limitation, data type qualification and cursor addressing. The equivalent behavior in MS BASIC almost necessitates the use of a machine language sub to attain—doing it in BASIC using GET would be cumbersome and not very responsive at lower clock speeds. At least the C-64 has the kernel PLOT function to address the cursor. Enabling and disabling the cursor is another matter. :D

_________________
x86?  We ain't got no x86.  We don't NEED no stinking x86!


Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 23, 2021 6:49 pm 
Offline
User avatar

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1927
Location: Sacramento, CA, USA
The 2sty(x) and 2stx()y in line 19 somehow don't look quite right. And you already have a 2sta(x) in line 18.

_________________
Got a kilobyte lying fallow in your 65xx's memory map? Sprinkle some VTL02C on it and see how it grows on you!

Mike B. (about me) (learning how to github)


Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 23, 2021 8:25 pm 
Offline

Joined: Tue Jul 24, 2012 2:27 am
Posts: 672
Good catch. I'll re-proofread the instruction table again and edit the top post. Typing in that sort of stuff can drive you a bit batty!

_________________
WFDis Interactive 6502 Disassembler
AcheronVM: A Reconfigurable 16-bit Virtual CPU for the 6502 Microprocessor


Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 23, 2021 8:31 pm 
Offline
User avatar

Joined: Thu Dec 11, 2008 1:28 pm
Posts: 10793
Location: England
Thanks for providing both the condensed and the commented versions.

I wonder how many C64 specific bits of mechanism are in there - how portable might this be?


Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 23, 2021 8:41 pm 
Offline
User avatar

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1927
Location: Sacramento, CA, USA
Other than the ability to include cursor commands inside PRINTed strings, C64 BASIC is a very typical example of the MS BASICs of the time. So it should port almost effortlessly to e.g. Applesoft. Porting it to the TRS-80 Model 1 Level 2 should be equally effortless, but it may run into some issues assembling and disassembling Z80 machine language. :D

_________________
Got a kilobyte lying fallow in your 65xx's memory map? Sprinkle some VTL02C on it and see how it grows on you!

Mike B. (about me) (learning how to github)


Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 23, 2021 8:48 pm 
Offline

Joined: Tue Jul 24, 2012 2:27 am
Posts: 672
There, I fixed up the instruction set. Found 3 or 4 other typos, with the wrong digit, and accidentally spelled "SBC" as "SPC" a few times :-P

As far as C64-isms go:
  • There are POKEs to stuff a doublequote into the keyboard buffer in line 70. This is to allow INPUT to accept commas in a single input string, and because INPUT won't let you enter a blank line (empty INPUT returns the last input data, and INPUT# does not return unless you give it something, even if just an open doublequote).
  • The memory dump prints control codes as reversed characters.
  • The title string cursors down 1 line.
  • Save and load. It also assumes floppy drive 8.

Everything else should be portable.

Another idea I had would be to self-relocate the program at runtime, updating all the BASIC pointers, as well as adjusting the size of the BASIC heap, to free up some other address regions besides the default $C000-CFFF. That would all be C64 specific POKEing, but I'll probably not bother with that. Given the speed of this, you don't want to be working with anything larger than what fits at C000. ;)

_________________
WFDis Interactive 6502 Disassembler
AcheronVM: A Reconfigurable 16-bit Virtual CPU for the 6502 Microprocessor


Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 23, 2021 10:59 pm 
Offline
User avatar

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1927
Location: Sacramento, CA, USA
If I ever finish my 65m32a and 65m36, I'm gonna name my ML monitor Hegemon. 8)

_________________
Got a kilobyte lying fallow in your 65xx's memory map? Sprinkle some VTL02C on it and see how it grows on you!

Mike B. (about me) (learning how to github)


Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 23, 2021 11:12 pm 
Offline
User avatar

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1927
Location: Sacramento, CA, USA
Code:
b=val(left$(k$,1))

A very minor optimization might be to just go with val(k$), because your data set shouldn't confuse val() ... even "2eor" returns 2.

Attachment:
petval.PNG
petval.PNG [ 27.12 KiB | Viewed 1443 times ]

_________________
Got a kilobyte lying fallow in your 65xx's memory map? Sprinkle some VTL02C on it and see how it grows on you!

Mike B. (about me) (learning how to github)


Top
 Profile  
Reply with quote  
PostPosted: Fri Sep 24, 2021 2:37 am 
Offline

Joined: Thu Mar 12, 2020 10:04 pm
Posts: 690
Location: North Tejas
Back when I was working on a compiler for BASIC, I wrote this skeleton of a monitor.

It is not great code; it is probably not even good code. But it was helpful to test my compiler.

Hopefully, someone can get some use out of it. The dialect is TSC Extended BASIC for the 6800.

Code:
10 PRINT 'Command';
20 INPUT LINE A$
30 GOSUB 1000:REM Strip leading spaces from A$
40 B$=LEFT$(A$,1):A$=MID$(A$,2):GOSUB 1000:GOSUB 1100
50 IF B$ = 'D' THEN 10000
60 IF B$ = 'U' THEN 12000
90 IF B$ = 'Q' THEN END
95 PRINT 'Unrecognized command.':GOTO 10
1000 REM Strip leading spaces from A$
1010 IF ASC(A$) = 32 THEN A$=MID$(A$,2) ELSE RETURN
1020 GOTO 1010
1100 REM Convert B$ to upper case
1110 IF ASC(B$) >= ASC('a') AND ASC(B$) <= ASC('z') THEN B$=CHR$(ASC(B$)-32)
1120 RETURN
1200 REM Convert N0% to hex digit and concat to O$
1210 O$=O$+MID$('0123456789ABCDEF',N0%+1,1)
1220 RETURN
1300 REM Convert N1% to hex and concat to O$
1310 N0%=N1%/16:N1%=N1% AND 15
1320 GOSUB 1200:N0%=N1%:GOTO 1200
1400 REM Convert N2% to hex and concat to O$
1410 N1%=N2%/256:N2%=N2% AND 255
1420 GOSUB 1300:N1%=N2%:GOTO 1300
1500 REM GET HEX NUMBER N% FROM STRING C$
1510 N%=0
1512 D$=LEFT$(C$,1):C$=MID$(C$,2):N1%=ASC(D$)
1514 IF N1%<ASC('0') GOTO 1528
1516 IF N1%<=ASC('9') GOTO 1528
1518 IF N1%<ASC('A') GOTO 1530
1520 IF N1%<=ASC('Z') GOTO 1530
1522 IF N1%<ASC('a') GOTO 1532
1524 IF N1%<=ASC('z') GOTO 1532
1526 PRINT LEFT$(D$,1); ' out of range':GOTO 10
1528 N1%=N1%-ASC('0'):GOTO 1534
1530 N1%=N1%-ASC('A')+10:GOTO 1534
1532 N1%=N1%-ASC('a')+10:GOTO 1534
1534 N%=N%*16+N1%
1536 IF C$='' THEN RETURN
1538 GOTO 1512
10000 REM DUMP
10002 IF A$='' GOTO 10010
10004 C$=A$:N%=INSTR(1,A$,' '):IF N%=0 THEN 10008
10006 C$=LEFT$(A$,N%-1):A$=MID$(A$,N%)
10008 GOSUB 1500:D0%=N%
10010 J%=0
10015 GOSUB 10100:J%=J%+1:IF J% <= 7 THEN GOTO 10015
10020 GOTO 10
10100 REM DUMP one line
10110 O$='':N2%=D0%:GOSUB 1400:O$=O$+':'
10120 I%=0
10125 O$=O$+' ':N1%=PEEK(D0%+I%):GOSUB 1300:I%=I%+1:IF I%<=7 THEN 10125
10130 O$=O$+'-'
10140 I%=0
10145 N1%=PEEK(D0%+I%+8):GOSUB 1300:O$=O$+' ':I%=I%+1:IF I%<=7 THEN 10145
10150 O$=O$+'|'
10160 I%=0
10165 N1%=PEEK(D0%+I%):IF N1%<32 OR N1%>126 THEN O$=O$+'.' ELSE O$=O$+CHR$(N1%)
10170 I%=I%+1:IF I%<=15 THEN 10165
10180 O$=O$+'|'
10190 PRINT O$:D0%=D0%+16:RETURN
12000 REM UNASSEMBLE
12002 IF A$='' GOTO 12010
12004 C$=A$:N%=INSTR(1,A$,' '):IF N%=0 THEN 12008
12006 C$=LEFT$(A$,N%-1):A$=MID$(A$,N%)
12008 GOSUB 1500:U%=N%
12010 I%=0
12020 O$='':N2%=U%:GOSUB 1400:O$=O$+': ':N%=PEEK(U%):N1%=N%:GOSUB 1300
12030 LO%=N% AND 15:HI%=N%/16
12032 IF HI%=11 OR HI%=15 THEN 12200
12034 IF HI%=9 OR HI%=10 OR HI%=13 OR HI%=14 THEN 12300
12036 IF HI%=8 OR HI%=12 THEN GOTO 12400
12038 IF HI%>=4 AND HI%<=7 THEN GOTO 12560
12040 IF HI%=2 THEN GOTO 12720
12042 IF HI%=3 THEN GOTO 12810
12044 IF HI%=1 THEN GOTO 12850
12046 IF HI%=0 THEN GOTO 12890
12160 GOTO 12990
12170 PRINT O$
12180 I%=I%+1:IF I%<=7 THEN 12020
12190 GOTO 10
12200 REM Rows B and F
12210 IF LO%=3 THEN GOTO 12990
12220 IF HI%=15 AND (LO%=12 OR LO%=13) THEN GOTO 12990
12230 N5%=PEEK(U%+1):N6%=PEEK(U%+2):N1%=N5%:GOSUB 1300:N1%=N6%:GOSUB 1300:O$=O$+'  '
12240 IF LO%=13 THEN O$=O$+'j'
12250 GOSUB 13000
12255 IF HI%<>11 OR LO%<14 THEN 12265:REM Not LDS or STS
12260 O$=LEFT$(O$,LEN(O$)-1)+'s'
12265 IF LO%<12 THEN GOTO 12275
12270 O$=O$+'  $':GOTO 12280
12275 IF HI%<12 THEN O$=O$+'a $' ELSE O$=O$+'b $'
12280 N1%=N5%:GOSUB 1300:N1%=N6%:GOSUB 1300:U%=U%+3
12290 GOTO 12170
12300 REM Rows 9..A, D..E
12310 IF HI%>12 AND (LO%=3 OR LO%=12 OR LO%=13) THEN GOTO 12990
12320 IF HI%=10 AND LO%=3 THEN GOTO 12990
12330 IF HI%=9 AND (LO%=3 OR LO%=13) THEN GOTO 12990
12340 N5%=PEEK(U%+1):N1%=N5%:GOSUB 1300:O$=O$+'    '
12345 IF LO%=13 THEN O$=O$+'j'
12350 GOSUB 13000
12355 IF HI%>=11 OR LO%<14 THEN 12365:REM Not LDS or STS
12360 O$=LEFT$(O$,LEN(O$)-1)+'s'
12365 IF LO%<12 THEN GOTO 12375
12370 O$=O$+'  $':GOTO 12380
12375 IF HI%<12 THEN O$=O$+'a $' ELSE O$=O$+'b $'
12380 N1%=N5%:GOSUB 1300:U%=U%+2
12390 IF (HI%=10 OR HI%=14) THEN O$=O$+',X'
12395 GOTO 12170
12400 REM Rows 8 and C
12410 IF LO%=3 OR LO%=7 OR LO%=15 THEN GOTO 12990
12420 IF HI%=12 AND (LO%=12 OR LO%=13) THEN GOTO 12990
12430 N5%=PEEK(U%+1):N1%=N5%:GOSUB 1300
12440 IF HI%<>8 OR LO%<>13 THEN GOTO 12490
12450 O$=O$+'    bsr  $'
12460 IF N5%<128 THEN GOTO 12480
12470 N5%=N5% OR -256
12480 N2%=U%+2+N5%:GOSUB 1400:U%=U%+2:GOTO 12170
12490 IF LO%<12 THEN GOTO 12500
12492 N6%=PEEK(U%+2):N1%=N6%:GOSUB 1300:O$=O$+'  ':GOTO 12510
12500 O$=O$+'    '
12510 GOSUB 13000
12515 IF HI%<>8 OR LO%<14 THEN 12525:REM Not LDS or STS
12520 O$=LEFT$(O$,LEN(O$)-1)+'s'
12525 IF LO%<12 THEN GOTO 12540
12530 O$=O$+'  #$':N1%=N5%:GOSUB 1300:N1%=N6%:GOSUB 1300:U%=U%+3:GOTO 12550
12540 IF HI%<12 THEN O$=O$+'a #$' ELSE O$=O$+'b #$'
12545 N1%=N5%:GOSUB 1300:U%=U%+2
12550 GOTO 12170
12560 REM Rows 4..7
12570 IF LO%=1 OR LO%=2 OR LO%=5 OR LO%=11 THEN GOTO 12990
12580 IF (HI%=4 OR HI%=5) AND LO%=14 THEN GOTO 12990
12590 IF HI%<7 THEN GOTO 12610
12600 N5%=PEEK(U%+1):N1%=N5%:GOSUB 1300:N6%=PEEK(U%+2):N1%=N6%:GOSUB 1300:O$=O$+'  ':GOTO 12640
12610 IF HI%<6 THEN GOTO 12630
12620 N5%=PEEK(U%+1):N1%=N5%:GOSUB 1300:O$=O$+'    ':GOTO 12640
12630 O$=O$+'      '
12640 GOSUB 13200
12650 IF HI%<6 THEN GOTO 12700
12660 O$=O$+'  $'
12670 IF HI%<7 THEN GOTO 12690
12680 N1%=N5%:GOSUB 1300:N1%=N6%:GOSUB 1300:U%=U%+3:GOTO 12710
12690 N1%=N5%:GOSUB 1300:O$=O$+',X':U%=U%+2:GOTO 12710
12700 U%=U%+1:IF HI%=4 THEN O$=O$+'a' ELSE O$=O$+'b'
12710 GOTO 12170
12720 REM Row 2
12730 IF LO%=1 THEN GOTO 12990
12740 N5%=PEEK(U%+1):N1%=N5%:GOSUB 1300:O$=O$+'    '
12750 GOSUB 13400
12760 O$=O$+'  $'
12770 IF N5%<128 THEN GOTO 12790
12780 N5%=N5% OR -256
12790 N2%=U%+2+N5%:GOSUB 1400:U%=U%+2
12800 GOTO 12170
12810 REM Row 3
12820 IF LO%=8 OR LO%=10 OR LO%=12 OR LO%=13 THEN GOTO 12990
12830 O$=O$+'      ':GOSUB 13600:U%=U%+1
12840 GOTO 12170
12850 REM Row 1
12860 IF (LO%>=2 AND LO%<=5) OR LO%=8 OR LO%=10 OR LO%>=12 THEN GOTO 12990
12870 O$=O$+'      ':GOSUB 13740:U%=U%+1
12880 GOTO 12170
12890 REM Row 0
12900 IF LO%=0 OR (LO%>=2 AND LO%<=5) THEN GOTO 12990
12910 O$=O$+'      ':GOSUB 13820:U%=U%+1
12920 GOTO 12170
12990 REM INVALID INSTRUCTION
12992 O$=O$+'      fcb  $':N1%=N%:GOSUB 1300
12994 U%=U%+1
12996 GOTO 12170
13000 REM Mnemonics for most of rows 8..F
13005 P$=''
13010 IF LO%=0 THEN P$='sub'
13020 IF LO%=1 THEN P$='cmp'
13030 IF LO%=2 THEN P$='sbc'
13040 IF LO%=4 THEN P$='and'
13050 IF LO%=5 THEN P$='bit'
13060 IF LO%=6 THEN P$='lda'
13070 IF LO%=7 THEN P$='sta'
13080 IF LO%=8 THEN P$='eor'
13090 IF LO%=9 THEN P$='adc'
13100 IF LO%=10 THEN P$='ora'
13110 IF LO%=11 THEN P$='add'
13120 IF LO%=12 THEN P$='cpx'
13130 IF LO%=13 THEN P$='sr'
13140 IF LO%=14 THEN P$='ldx'
13150 IF LO%=15 THEN P$='stx'
13155 O$=O$+P$
13160 RETURN
13200 REM Mnemonics for rows 4..7
13205 P$=''
13210 IF LO%=0 THEN P$='neg'
13220 IF LO%=3 THEN P$='com'
13230 IF LO%=4 THEN P$='lsr'
13240 IF LO%=6 THEN P$='ror'
13250 IF LO%=7 THEN P$='asr'
13260 IF LO%=8 THEN P$='asl'
13270 IF LO%=9 THEN P$='rol'
13280 IF LO%=10 THEN P$='dec'
13290 IF LO%=12 THEN P$='inc'
13300 IF LO%=13 THEN P$='tst'
13310 IF LO%=14 THEN P$='jmp'
13320 IF LO%=15 THEN P$='clr'
13325 O$=O$+P$
13330 RETURN
13400 REM Mnemonics for row 2
13405 P$=''
13410 IF LO%=0 THEN P$='bra'
13420 IF LO%=2 THEN P$='bhi'
13430 IF LO%=3 THEN P$='bls'
13440 IF LO%=4 THEN P$='bcc'
13450 IF LO%=5 THEN P$='bcs'
13460 IF LO%=6 THEN P$='bne'
13470 IF LO%=7 THEN P$='beq'
13480 IF LO%=8 THEN P$='bvc'
13490 IF LO%=9 THEN P$='bvs'
13500 IF LO%=10 THEN P$='bpl'
13510 IF LO%=11 THEN P$='bmi'
13520 IF LO%=12 THEN P$='bge'
13530 IF LO%=13 THEN P$='blt'
13540 IF LO%=14 THEN P$='bgt'
13550 IF LO%=15 THEN P$='ble'
13555 O$=O$+P$
13560 RETURN
13600 REM Mnemonics for row 3
13605 P$=''
13610 IF LO%=0 THEN P$='tsx'
13620 IF LO%=1 THEN P$='ins'
13630 IF LO%=2 THEN P$='pula'
13640 IF LO%=3 THEN P$='pulb'
13650 IF LO%=4 THEN P$='des'
13660 IF LO%=5 THEN P$='txs'
13670 IF LO%=6 THEN P$='psha'
13680 IF LO%=7 THEN P$='pshb'
13690 IF LO%=9 THEN P$='rts'
13700 IF LO%=11 THEN P$='rti'
13710 IF LO%=14 THEN P$='wai'
13720 IF LO%=15 THEN P$='swi'
13725 O$=O$+P$
13730 RETURN
13740 REM Mnemonics for row 1
13745 P$=''
13750 IF LO%=0 THEN P$='sba'
13760 IF LO%=1 THEN P$='cba'
13770 IF LO%=6 THEN P$='tab'
13780 IF LO%=7 THEN P$='tba'
13790 IF LO%=9 THEN P$='daa'
13800 IF LO%=11 THEN P$='aba'
13805 O$=O$+P$
13810 RETURN
13820 REM Mnemonics for row 0
13825 P$=''
13830 IF LO%=1 THEN P$='nop'
13840 IF LO%=6 THEN P$='tap'
13850 IF LO%=7 THEN P$='tpa'
13860 IF LO%=8 THEN P$='inx'
13870 IF LO%=9 THEN P$='dex'
13880 IF LO%=10 THEN P$='clv'
13890 IF LO%=11 THEN P$='sev'
13900 IF LO%=12 THEN P$='clc'
13910 IF LO%=13 THEN P$='sec'
13920 IF LO%=14 THEN P$='cli'
13930 IF LO%=15 THEN P$='sei'
13935 O$=O$+P$
13940 RETURN


Edit: I uploaded a faulty version. Here it is again...


Top
 Profile  
Reply with quote  
PostPosted: Fri Sep 24, 2021 7:07 am 
Offline
User avatar

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1927
Location: Sacramento, CA, USA
Code:
1512 D$=LEFT$(C$,1):C$=MID$(C$,2):N1%=ASC(D$)
1514 IF N1%<ASC('0') GOTO 1528
1516 IF N1%<=ASC('9') GOTO 1528
1518 IF N1%<ASC('A') GOTO 1530
1520 IF N1%<=ASC('Z') GOTO 1530
1522 IF N1%<ASC('a') GOTO 1532
1524 IF N1%<=ASC('z') GOTO 1532
In MS BASIC you can compare strings directly without all those ASC() calls:
Attachment:
stringcmp.PNG
stringcmp.PNG [ 22.28 KiB | Viewed 1415 times ]

_________________
Got a kilobyte lying fallow in your 65xx's memory map? Sprinkle some VTL02C on it and see how it grows on you!

Mike B. (about me) (learning how to github)


Top
 Profile  
Reply with quote  
PostPosted: Fri Sep 24, 2021 8:03 am 
Offline

Joined: Thu Mar 12, 2020 10:04 pm
Posts: 690
Location: North Tejas
In TSC Extended BASIC, N1% is an integer variable. In this case, the ASC "function" is like "chr" in Pascal - a type conversion. At least in my compiler it is when the argument is a constant string of length one. I presume it is that way in the interpreter as well. It cannot directly compare an integer with a single character string.

When I get around to implementing floating point, I will reserve one of the NaN (Not a Number) values to denote that the "floating point number" is just a thin wrapper around an integer. Assigning an integer to a floating point number results in one of these special integers. It stays that way until it is involved in arithmetic with an actual floating point number or any kind of division.


Top
 Profile  
Reply with quote  
PostPosted: Fri Sep 24, 2021 8:10 am 
Offline
User avatar

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1927
Location: Sacramento, CA, USA
I didn't explain my point well enough:
Code:
N1%=ASC(D$): IF N1%<ASC("0") GOTO 1528
can be directly replaced with
Code:
IF D$ < "0" GOTO 1528
at least in the MS BASICs I know.

Attachment:
petstring.PNG
petstring.PNG [ 34.96 KiB | Viewed 1311 times ]

_________________
Got a kilobyte lying fallow in your 65xx's memory map? Sprinkle some VTL02C on it and see how it grows on you!

Mike B. (about me) (learning how to github)


Last edited by barrym95838 on Mon Sep 27, 2021 11:48 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
PostPosted: Fri Sep 24, 2021 8:18 am 
Offline

Joined: Thu Mar 12, 2020 10:04 pm
Posts: 690
Location: North Tejas
I see what you mean.

In TSC Extended BASIC, ASC(A$) returns the numeric value of the first character of the string.

So I can rewrite

Code:
1512 D$=LEFT$(C$,1):C$=MID$(C$,2):N1%=ASC(D$)
1514 IF N1%<ASC('0') GOTO 1528


as

Code:
1512 N1%=ASC(C$):C$=MID$(C$,2)
1514 IF N1%<ASC('0') GOTO 1528


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 25 posts ]  Go to page 1, 2  Next

All times are UTC


Who is online

Users browsing this forum: Google [Bot] and 18 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to: