CBM Funet Archive/cbm-funet-archive-2003.iso/cbm/c64/utilities/PromShellv2b.sfx/decode.v2.0

Commodore BASIC | 1990-02-12 | 11.7 KB | 470 lines

1 dima$,q,p,r,z$,k,e,i,i$,l,z,p$,q$,j,m,h%,f,n,h$,o$,n$,e$,h,t$,v$,a,d,x%,x,c,o
3 dimf%,s,bc,w,l%,v,bf,bi,b,b$,m$,c$,d$,f$,g,be,b%,p%,r%,u,v%,y,j$,k$,g$,s$,u$
5 reado,a,h,t$,v$,b$,g,j$,k$,l$,r$,i$,bl$
7 dimof,hf,af,a%(o),m$(o),b(o),e(o),i(a),o(a):goto531
9 :
11 rem common subroutines
13 :
15 rem fetch opcode from ml file
17 :
19 get#1,a$:r=st:q=asc(a$+z$):p=p+1:return
21 :
23 rem get mnemonic and addressing mode
25 :
27 n$=m$(q):n=a%(q):return
29 :
31 rem fetch 1-byte operand
33 :
35 gosub19:k=q:h=1:goto51
37 :
39 rem fetch 2-byte operand
41 :
43 gosub19:z=q:gosub19:z=z+q*o:k=z:h=3
45 :
47 rem convert k to hex$
49 :
51 h$="":form=.toh:d=k:k=int(d/16):d=d-k*16:h$=chr$(d+48-7*(d>9))+h$:next
53 return
55 :
57 rem output subroutines
59 :
61 rem construct output string
63 :
65 l=l+1:ifl>gthenl=g
67 :
69 printl;:ifl>=sthenk=l:h=3:gosub51:printt$h$i$;
71 printp$:on-(o$="d")goto79:on-(o$="p")goto93:return
73 :
75 rem write output to disk file
77 :
79 iff%thenifl>=sthenp$=t$+h$+i$+p$
81 h%=l/o:f=l-h%*o:print#2,""chr$(f)chr$(h%)p$z$;
83 c=c+5+len(p$):ifc>athengosub477
85 goto103
87 :
89 rem write output to printer
91 :
93 ifl>=sthenp$=t$+h$+i$+p$
95 print#2,mid$(str$(l),2)i$p$
97 :
99 rem check command channel
101 :
103 input#3,k,e$,d,d:ifkthenprinte$:ifk=72goto113
105 return
107 :
109 rem disk full
111 :
113 c=.:p$=b$:l=l+1:h%=l/o:f=l-h%*o:print#2,""chr$(f)chr$(h%)p$z$;
115 g$=c$+mid$(str$(r%),2):p$=".file "+g$:l=l+1:h%=l/o:f=l-h%*o
117 print#2,""chr$(f)chr$(h%)p$z$z$z$;:close2:ifof=8thenclose1:close3:end
119 print"replace disk in"of"and press a key":poke198,0:wait197,64,64:goto479
121 :
123 rem clear/set flag for labelling outside addresses
125 :
127 x=.:if(x%)orn=2thenifj<>32andj<>76andj<>108thenx=1
129 return
131 :
133 rem increment pointer into table of byte blocks
135 :
137 ifp>b(w)thenw=w+1:goto137
139 return
141 :
143 rem pass 2 subroutines
145 :
147 rem discard bytes in byte table
149 :
151 gosub137:printr$"s"e(w)-b(w)+1;:ifp+1>e(w)thenreturn
153 fori=p+1toe(w):gosub19:next:return
155 :
157 rem 1-byte operands
159 :
161 gosub35:z=q:j=q:ifn=3thenz=p+q+(q>127)*o+1:k=z:h=3:gosub51:printt$h$"   ";
163 if(n=3)and(z<sorz>e)thenreturn
165 ifn<>3thenprintt$h$"     ";:goto197
167 goto183
169 :
171 rem 2-byte operands
173 :
175 gosub43:printt$h$"   ";:ifz<sorz>egoto197
177 :
179 rem locate or assign internal address label
181 :
183 fori=vto.step-1:ifz<i(i)goto189
185 ifz=i(i)theni=.:print"[186]i";:goto189
187 forq=v+1toi+2step-1:i(q)=i(q-1):next:i(q)=z:i=.:v=v+1:printv"internal";
189 next:return
191 :
193 rem locate or assign external address label
195 :
197 gosub127:onxgoto53:ifu=.ando(.)=.theno(u)=z
199 l%=1:fori=.tou:ifz>o(i)goto207
201 ifz=o(i)thenl%=.:i=u:print"[186]o";:goto207
203 forq=u+1toi+1step-1:o(q)=o(q-1):next:o(q)=z:i=u:u=u+1:l%=.
205 printu"external";
207 next:ifl%theno(i)=z:u=u+1:printu"external";
209 return
211 :
213 rem pass 4 subroutines
215 :
217 rem implied addressing
219 :
221 p$=left$(q$,len(q$)-1):goto69
223 :
225 rem immediate
227 :
229 gosub19:k=q:h=1:gosub51:p$=q$+"#$"+h$:goto69
231 :
233 rem relative
235 :
237 gosub19:z=p+q+(q>127)*o+1:k=z:h=3:gosub51:ifz<sorz>ethenp$=q$+t$+h$:goto69
239 p$=q$+v$+h$:goto69
241 :
243 rem zero page
245 :
247 gosub35:p$=q$+"z"+h$:goto69
249 :
251 rem zero page,x
253 :
255 gosub35:p$=q$+"z"+h$+",x":goto69
257 :
259 rem zero page,y
261 :
263 gosub35:p$=q$+"z"+h$+",y":goto69
265 :
267 rem absolute
269 :
271 gosub43:p$=q$+v$+h$:on-(z>=sandz<=e)goto69:gosub127:ifxthenp$=q$+t$+h$
273 goto69
275 :
277 rem absolute,x
279 :
281 gosub43:p$=q$+v$+h$+",x":ifz>=sandz<=egoto69
283 gosub127:ifxthenp$=q$+t$+h$+",x
285 [137]69
287 :
289 [143] absolute,y
291 :
293 [141]43:p$[178]q$[170]v$[170]h$[170]",y":[139]z[177][178]s[175]z[179][178]e[137]69
295 [141]127:[139]x[167]p$[178]q$[170]t$[170]h$[170]",y
297 goto69
299 :
301 rem indirect
303 :
305 gosub43:p$=q$+"(ad"+h$+")":goto69
307 :
309 rem indirect,x
311 :
313 gosub35:p$=q$+"(z"+h$+",x)":goto69
315 :
317 rem indirect,y
319 :
321 gosub35:p$=q$+"(z"+h$+"),y":goto69
323 :
325 rem byte tables
327 :
329 gosub137:k=j:h=1:gosub51:p$=q$+r$:af=.
331 b=p:q=j:s$=str$(q):m$=";47"+h$:u$="71"+chr$(34):gosub369:hf=q:goto359
333 gosub19:k=q:h=1:gosub51:s$=s$+str$(q):m$=m$+i$+h$:gosub369:hf=hf+q
335 ifp+1<i(i)goto349
337 l=b:p$=p$+s$:ifhfthenp$=p$+m$
339 ifafthenp$=p$+u$
341 gosub69
343 b=p+1:k=b:h=3:gosub51:i=i+1
345 p$=v$+h$+i$+r$:s$="":m$=";46":u$="71"+chr$(34):hf=.:af=.
347 ifb>e(w)theni=i-1:return
349 ifp<b+7goto359
351 l=b:p$=p$+s$:ifhfthenp$=p$+m$
353 ifafthenp$=p$+u$
355 gosub69
357 b=p+1:p$=r$:s$="":m$=";46":u$="71"+chr$(34):hf=.:af=.
359 ifp<e(w)goto333
361 l=b:p$=p$+s$:ifhfthenp$=p$+m$
363 ifafthenp$=p$+u$
365 on-(len(m$)>4)goto69:k=.:return
367 :
369 ifqthenifq>31andq<123orq>192andq<219thenu$=u$+chr$(q):af=af-(q<>32):return
371 u$=u$+".":return
373 :
375 rem pass 3 subroutines
377 :
379 rem discard bytes
381 :
383 gosub137:ifp+1>e(w)goto387
385 form=p+1toe(w):gosub19:next
387 w=w+1:return
389 :
391 rem check offset label for 1-byte operand
393 :
395 ifp+1=i(i)thengosub415
397 goto19
399 :
401 rem check offset label for 2-byte operand
403 :
405 ifp+1=i(i)orp+2=i(i)thengosub415:goto405
407 gosub19:goto19
409 :
411 rem add offset label to table
413 :
415 v%=v%+1:u=u+1:o(u)=i(i):printi(i)v%l$:i=i+1:return
417 :
419 rem pass 1 subroutines
421 :
423 rem construct byte tables
425 :
427 b=b-p*(b=.):gosub19:ifrthenb=p+(p>g):goto435
429 b=b-p*(b=.):gosub19:ifrthenb=p+(p>g):goto435
431 b=b-p*(b=.):ifrthenb=p+(p>g):goto435
433 bi=bi+1:ifbi<bethenreturn
435 b=b-p*(b=.):printb-1;b-b(w):e(w)=b+(r=.):bf=.:bi=.:b=.:w=w+1:return
437 :
439 rem byte:  reset tables
441 :
443 bi=.:b=.:on-(r<>.)goto435:return
445 :
447 rem start byte table, set flag
449 :
451 b(w)=p:bf=1:bi=.:b=.:printp;r$"s";:return
453 :
455 rem infrequent subroutines
457 :
459 rem new pass, get to start of code
461 :
463 p%=p%+1:print"pass"p%"":p=y-3
465 close1:open1,8,2,f$:gosub43:ifp%<1goto103
467 ifp<(s-1)thengosub19:goto467
469 goto103
471 :
473 rem close disk file and open another
475 :
477 c=.:p$=b$:gosub65:g$=c$+mid$(str$(r%),2):p$=".file "+g$:gosub65:gosub499
479 gosub487:print#2,"";:l=l-3:p$=b$+g$:goto69
481 :
483 rem open output file
485 :
487 ifo$="d"thenp$="0:"+g$+",p,w":r%=r%+1:open2,of,3,p$:c=2:goto103
489 ifo$="p"thenopen2,4,7:print#2,mid$(f$,3,len(f$)-6)":  [196]ecode v2.0
491 [142]
493 :
495 [143] close disk file
497 :
499 [152]2,z$z$;:[160]2:[137]103
501 :
503 [143] translate decimal or hex input
505 :
507 k[178].:[145][171]([200](d$,1)[178]t$)[137]515:k[178][197](d$):[142]
509 :
511 [143] hex input
513 :
515 d$[178][201](d$,[195](d$)[171]1):[139][195](d$)[178].[167][142]
517 :
519 [129]h[178]1[164][195](d$):d[178][198]([202](d$,h,1)):d[178]d[171]48[170]7[172](d[177]57):k[178]k[170]d[172](16[174]([195](d$)[171]h))
521 [130]:d$[178]"":[142]
523 :
525 :
527 [143] initialization
529 :
531 z$[178][199](.):r%[178]1:a[178]38000:of[178]8:j$[178]j$[170]i$:k$[178]k$[170]i$:l$[178]l$[170]i$:i$[178]" ":[129]i[178]1[164]151
533 [135]a$,q,p:m$(p)[178]a$:a%(p)[178]q:[130]:[153]"load"bl$bl$"        str$ecode v2.0 "
535 :
537 [143] get user options and data
539 :
541 [153]"assembler file to pwaitrinter"
543 [133]"or dwaitisk or to swaitcreen only  dcmdcmdcmd";o$
545 [139]o$[179][177]"p"[175]o$[179][177]"d"[175]o$[179][177]"s"[137]543
547 [139]o$[178]"d"[167][133]"output device number  8cmdcmdcmd";d$:of[178][197](d$):[139]of[179]8[167]of[178]8
549 [159]3,of,15,"i0"
551 [133]"decode program";c$:f$[178]"0:"[170]c$[170]",p,r":[141]465:y[178]z:[139]k[137]551
553 [153]"load address:"y;t$h$:[153]bl$bl$bl$"cmd"h$
555 [133]"onstart decoding at  $cmdcmdcmd";d$:[141]507:s[178]k[171]y[172](k[178].)
557 [133]"decode through to  endcmdcmdcmdcmdcmd";d$:[141]507:e[178]k[171]g[172](k[178].):h[178]3
559 [139]o$[178]"s"[137]567
561 [153]"  "bl$bl$[200](c$,10)"on":[133]"assembler file";c$
563 [139][195](c$)[177]10[137]561
565 [139]o$[178]"d"[167][133]"hex addrs to file  ncmdcmdcmd";d$:[139]d$[178]"y"[167]b%[178]1
567 [133]"label all outside  ycmdcmdcmd";d$:x%[178][171](d$[178]"n"):[153]"$2c = byte or skw:
569 input"change skw to bit  y[157][157][157]";d$:a%(44)=-7*(d$="y")
571 print"escape byte block":print"after how many op
573 [133]"codes encountered  15cmdcmdcmdcmd";d$:[141]507:be[178]k:[141]463
575 :
577 [143] pass 1
579 :
581 [143] count bytes, identify byte blocks
583 :
585 [145][171]((p[177][178]e)[176](r[179][177].))[137]613:[141]19:[141]27:[139]bf[137]603
587 :
589 [143] main loop evaluates opcodes and discards operands, flags non-opcode
591 :
593 [145]n[170]1[141]451,53,19,19,19,19,19,43,43,43,43,19,19
595 [137]585
597 :
599 [143] byte loop counts bytes, seeks sequence of properly spaced opcodes
601 :
603 [145]n[170]1[141]443,431,429,429,429,429,429,427,427,427,427,429,429
605 [137]585
607 :
609 [143] pass 1 complete, set pointers
611 :
613 t[178]p[170](p[177]g):k[178]t:[141]51:e[178]e[171](t[171]g)[172](e[178]g):e(w)[178]e(w)[171]t[172](e(w)[178].):[153]
615 [153]"high address:"t"($"h$")":[153]"program code:"t[171]y[170]1"bytes
617 ifs>=yands<tgoto623
619 k=y:gosub51:printbl$bl$bl$"[157]"h$
621 input"[145]start decoding at  $[157][157][157]";d$:gosub507:s=k-y*(k=.):goto617
623 ife>=yande<=tgoto633
625 input"decode through to  end[157][157][157][157][157]";d$:gosub507:e=k-t*(k=.):goto623
627 :
629 rem pass 2
631 :
633 gosub463:i(.)=s:v=1:i(v)=t:b(w+1)=g:e(w+1)=.:bc=w:w=.
635 :
637 rem construct label tables
639 :
641 on-(p>=e)goto653:gosub19:gosub27:j=q:k=p:h=3:gosub51:printp;t$h$i$n$i$;
643 onn+1gosub151,53,161,161,161,161,161,175,175,175,175,161,161
645 print:goto641
647 :
649 rem pass 2 complete
651 :
653 print:printv;j$:printu;k$:i(v+1)=g:o(u+1)=g
655 :
657 rem pass 3
659 :
661 rem locate offset addresses
663 :
665 gosub463:i=.:w=.:ifv<2goto709
667 :
669 rem step through label tables
671 :
673 on-((p>i(v))or(p>=e))goto697:gosub19:gosub27
675 :
677 ifp>i(i)theni=i+1:goto677
679 ifp=i(i)theni=i+1
681 :
683 rem main loop for pass 3
685 :
687 onn+1gosub383,53,395,395,395,395,395,405,405,405,405,395,395
689 goto673
691 :
693 rem pass 3 complete
695 :
697 ifv%thenprintv%l$
699 :
701 rem pass 4
703 :
705 rem open output file
707 :
709 gosub463:c$=c$+".src":g$=c$:gosub487:l=9:w=.:k=p+1:gosub51:h=1
711 :
713 rem screen or printer initialization
715 :
717 ifo$<>"d"thenp$="*= $"+h$+i$+c$:gosub69:on-(u=.)goto781:goto735
719 :
721 rem disk output initialization
723 :
725 print#2,"";:p$="[172]= $"+h$:gosub65:p$=b$+c$:gosub65:p$=b$:gosub65
727 p$=";.d r/"+mid$(f$,3,len(f$)-6):gosub65:p$=".s":gosub65:ifu=.goto781
729 :
731 rem label tables:  zero page
733 :
735 p$=b$:gosub65:p$=";zero page":gosub65
737 fori=.tou:k=o(i):ifk>=otheni=u:goto741
739 gosub51:p$="z"+h$+" = $"+h$:gosub65
741 next
743 :
745 rem label tables:  outside labels and offset labels
747 :
749 h=3:p$=b$:gosub65:p$=b$+k$:gosub65:x=.:fori=1tou:k=o(i):ifk<ogoto757
751 gosub51:ifi=u-v%+1thenp$=b$:gosub65:p$=b$+l$:gosub65:x=1
753 p$=v$+h$+" = $"+h$:ifxthenp$=p$+b$+str$(o(i))
755 gosub65
757 next:x=.
759 :
761 rem byte blocks
763 :
765 p$=b$:gosub65:ifbc=.goto781
767 p$=";byte blocks":gosub65:fori=.tobc-1:k=b(i):gosub51
769 p$="; $"+h$+"-$":k=e(i):gosub51
771 p$=p$+h$+" at"+str$(b(i))+" ("+mid$(str$(e(i)-b(i)+1),2)+")"
773 gosub65:next:p$=b$:gosub65
775 :
777 rem initialize indices
779 :
781 i=.:f%=b%
783 :
785 rem decode program
787 :
789 on-(p>=e)goto825:gosub19:j=q:gosub27:l=p:q$="":m$="
791 :
793 [143] check pointers to tables and start contructing output string
795 :
797 [139]p[177]i(i)[167]i[178]i[170]1:[137]797
799 [139]p[178]i(i)[167]k[178]p:h[178]3:[141]51:q$[178]v$[170]h$[170]i$:i[178]i[170]1
801 :
803 [143] add mnemonic to string
805 :
807 [139]n[167]q$[178]q$[170]n$[170]i$
809 :
811 [143] fetch operand and add to output string
813 :
815 [145]n[170]1[141]329,221,229,237,247,255,263,271,281,293,305,313,321
817 [137]789
819 :
821 [143] pass 4 complete, close output
823 :
825 p$[178]b$:[141]65:p$[178]".end "[170]c$:[139]o$[178]"d"[167]p$[178]"."[170][199](128)[170]i$[170]c$
827 [141]65:[145][171](o$[178]"d")[141]499:[160]1:[160]2:[160]3:[153]"complete
829 :
831 :
833 rem variable data:  o,a,h,t$,v$,b$,g,j$,k$,l$,r$,i$,bl$
835 :
837 data256,1600,3,$,ad,;,65535,inside,outside,offset,.byte," labels","       "
839 :
841 rem addressing mode assignments
843 :
845 rem  0 = byte data
847 rem  1 = implied
849 rem  2 = immediate
851 rem  3 = relative
853 rem  4 = zero page
855 rem  5 = zero page,x
857 rem  6 = zero page,y
859 rem  7 = absolute
861 rem  8 = absolute,x
863 rem  9 = absolute,y
865 rem 10 = indirect
867 rem 11 = indirect,x
869 rem 12 = indirect,y
871 :
873 rem mnemomic,addressing mode, opcode
875 :
877 databrk, 0,  0,ora,11,  1,ora, 4,  5,asl, 4,  6,php, 1,  8
879 dataora, 2,  9,asl, 1, 10,ora, 7, 13,asl, 7, 14,bpl, 3, 16
881 dataora,12, 17,ora, 5, 21,asl, 5, 22,clc, 1, 24,ora, 9, 25
883 dataora, 8, 29,asl, 8, 30,jsr, 7, 32,and,11, 33,bit, 4, 36
885 dataand, 4, 37,rol, 4, 38,plp, 1, 40,and, 2, 41,rol, 1, 42
887 databit, 0, 44,and, 7, 45,rol, 7, 46,bmi, 3, 48,and,12, 49
889 dataand, 5, 53,rol, 5, 54,sec, 1, 56,and, 9, 57,and, 8, 61
891 datarol, 8, 62,rti, 1, 64,eor,11, 65,eor, 4, 69,lsr, 4, 70
893 datapha, 1, 72,eor, 2, 73,lsr, 1, 74,jmp, 7, 76,eor, 7, 77
895 datalsr, 7, 78,bvc, 3, 80,eor,12, 81,eor, 5, 85,lsr, 5, 86
897 datacli, 1, 88,eor, 9, 89,eor, 8, 93,lsr, 8, 94,rts, 1, 96
899 dataadc,11, 97,adc, 4,101,ror, 4,102,pla, 1,104,adc, 2,105
901 dataror, 1,106,jmp,10,108,adc, 7,109,ror, 7,110,bvs, 3,112
903 dataadc,12,113,adc, 5,117,ror, 5,118,sei, 1,120,adc, 9,121
905 dataadc, 8,125,ror, 8,126,sta,11,129,sty, 4,132,sta, 4,133
907 datastx, 4,134,dey, 1,136,txa, 1,138,sty, 7,140,sta, 7,141
909 datastx, 7,142,bcc, 3,144,sta,12,145,sty, 5,148,sta, 5,149
911 datastx, 6,150,tya, 1,152,sta, 9,153,txs, 1,154,sta, 8,157
913 dataldy, 2,160,lda,11,161,ldx, 2,162,ldy, 4,164,lda, 4,165
915 dataldx, 4,166,tay, 1,168,lda, 2,169,tax, 1,170,ldy, 7,172
917 datalda, 7,173,ldx, 7,174,bcs, 3,176,lda,12,177,ldy, 5,180
919 datalda, 5,181,ldx, 6,182,clv, 1,184,lda, 9,185,tsx, 1,186
921 dataldy, 8,188,lda, 8,189,ldx, 9,190,cpy, 2,192,cmp,11,193
923 datacpy, 4,196,cmp, 4,197,dec, 4,198,iny, 1,200,cmp, 2,201
925 datadex, 1,202,cpy, 7,204,cmp, 7,205,dec, 7,206,bne, 3,208
927 datacmp,12,209,cmp, 5,213,dec, 5,214,cld, 1,216,cmp, 9,217
929 datacmp, 8,221,dec, 8,222,cpx, 2,224,sbc,11,225,cpx, 4,228
931 datasbc, 4,229,inc, 4,230,inx, 1,232,sbc, 2,233,nop, 1,234
933 datacpx, 7,236,sbc, 7,237,inc, 7,238,beq, 3,240,sbc,12,241
935 datasbc, 5,245,inc, 5,246,sed, 1,248,sbc, 9,249,sbc, 8,253
937 datainc, 8,254