10 !                  Program : Decmpl.bas
20 !                  Version : V9.03
30 !                   Author : Christopher T. Klein
40 ! &
   ! This program takes a compiled BASIC-PLUS program and provides &
   ! a readable file from it. &
   !
1030 v0$="V9.5-00"
1040 print "DECOMPILE - Version ";v0$
1050 PRINT "Input Compiled Program <*.BAC>"; &
	\ input line i$ &
	\ i$=cvt$$(i$,-1%) &
	\ open i$+".bac" for input as file 1%
1060 print "Output Listing <*.PPC>"; &
	\ input line o$ &
	\ o$=cvt$$(o$,-1%) &
	\ o$="kb:" unless len(o$) &
	\ o$=o$+'.ppc' if instr(1%,o$,'.')=0% &
	\ open o$ for output as file 4%
1065 input'Do you want to detach <YES>';D5$ &
	\ if ascii(d5$)=89% or d5$='' then &
	Print'Detaching...';CHR$(12%) &
	\ S$=SYS(CHR$(6%)+CHR$(7%))
1070 f0%=0% &
	\ on error go to 1100
1080 ! open basic source file used to be here.
1090 goto 1110
1100 resume 1110
1110 on error goto
1120 OPEN '(117,6)decomp.MAT' FOR INPUT AS FILE 3%
1130 dim a%(500%),a$(500%) &
	\ dim #1%, p%(32767%) &
	\ dim #3%, u$(255%)=38%
1140 !  fetch a word from the 'bac' file
1150 def fnw%(w%)=p%(w%/2%-256%)
1160 ! &
     !
1170 def fni%(i%)=cvt$%(chr$(fnb%(i%+p2%+l1%))+chr$(fnb%(p2%+l1%+1%+i%)))
1180 !  fetch a byte from the 'bac' file
1190 def fnb%(b0%) &
	\ b1%=p%(b0%/2%-256%) &
	\ fnb%=ascii(chr$(b1%)) &
	\ fnb%=ascii(cvt%$(b1%)) if b0% and 1% &
	\ fnend
1200 ! &
     !
1210 def fnr$(r%) &
	\ r%=fni%(r%) &
	\ if r%=0% then fnr$='0' else fnr$= &
	fns$(int(fnw%(r%+s1%+10%)))
1220 fnend
1230 ! &
     !
1240 def fnv$(r%,t%) &
	\ on t%-t%/8%*8% goto 1250,1260,1270,1280
1250 fnv$=fns$(int(fnw%(s0%+r%)))+"%" &
	\ goto 1290
1260 v$=string$(m2%,0%) &
	\ v$=v$+cvt%$(fnw%(s0%+r%+i%*2%)) for i%=m1% to 0% step -1%
1265 v$=fns$(cvt$f(v$)/m0) &
	\ v$=v$+'.' unless instr(1%,v$,'.') &
	\ fnv$=v$ &
	\ goto 1290
1270 stop
1280 l%=fnw%(s0%+r%+4%) &
	\ r%=fnw%(s0%+r%+2%)+s0%+r% &
	\ v$='' &
	\ v$=v$+chr$(fnb%(r%+q%)) for q%=0% to l%-1% &
	\ if instr(1%,v$,'"') &
	then fnv$="'"+v$+"'" else fnv$='"'+v$+'"'
1290  fnend
1300 ! & 
     !
1310 def fnl$(n%,t%) &
	\ n%=n%-1% if n% and 1% &
	\ for a0%=0% to a%-1% &
	\ if a%(a0%) then fnl$=a$(a0%) &
	\ goto 1340
1320 next a0% &
	\ if u%=13% then a%(a%)=n% &
	\ a$(a%)=".l"+fns$(l9%) &
	\ l9%=l9%+1% &
	\ a$(a%)=a$(a%)+"%" if t% and 1% &
	\ a%=a%+1% &
	\ fnl$=a$(a%-1%) &
	\ goto 1340
1330 fnl$=fnv$(n%,t%)
1340 fnend
1350 !  make a three character octal string of the byte b%.
1360 def fnb$(b%) &
	\ b$="" &
	\ b%=ascii(chr$(b%)) &
	\ for b0%=2% to 1% step -1% &
	\ b1%=b%/o%(b0%) &
	\ b$=b$+chr$(48%+b1%) &
	\ b%=b%-b1%*o%(b0%) &
	\ next b0% &
	! &
	\ fnb$=b$+chr$(48%+b%) &
	\ fnend
1370 !  make a string of the number s with blanks removed.
1380 def fns$(s) &
	\ s$=num$(s) &
	\ fns$=left(s$,len(s$)-1%) &
	\ fns$=mid(s$,2%,len(s$)-2%) if s>=0 &
	\ fnend
1390 !  make a six character octal string of the word o%.
1400 def fno$(o%) &
	\ if o%>=0% then o$="0" else o$="1" &
	\ o%=o%+32767%+1%
1410 for o0%=4% to 1% step -1% &
	\ o1%=o%/o%(o0%) &
	\ o$=o$+chr$(48%+o1%) &
	\ o%=o%-o1%*o%(o0%) &
	\ next o0% &
	\ fno$=o$+chr$(48%+o%) &
	\ fnend
1420 ! &
     !
1430 def fnt% &
	\ t$=right(u1$,len(u1$)) &
	\ if t$='x' then t$=mid(u1$,3%,1%)
1440 if t$='i' then fnt%=1% else if t$='f' then fnt%=2% else fnt%=4%
1450 fnend
1480 !end of functions &

1490 t9$='      dim   fnend next  data  error mldef for   def   enddim'
1500 q0$=chr$(13%)+chr$(10%) &
	\ q1$=" "
1520 !  calculate the checksum of the .bac file.
1530 f%=swap%(cvt$%(right(sys(chr$(6%)+chr$(-8%)+chr$(1%)),7%)))
1540 h%=0% &
	\ h%=h%+p%(p%) for p%=1% to 256%*f%-1%
1550 if h%<>p%(0%) then print "Checksum error!" &
	\ goto 2450
1560 s%=fnw%(514%)		! stack pointer
1565 m0%=fnb%(s%+38%)		! math precision
1566 m1%,m4%=len(cvtf$(0%))/2%-1% &
	\ m2%=0% &
	\ if m1%=3% and m0%=2% then m1%=1% &
	\ m2%=4% &
				! setup for getting numeric literals
1567 m0=10.^(255% and (256%-fnb%(s%+39%))) &
				! scaling factor
1570 s0%=fnw%(s%+28%)		! 'spda'
1580 s1%=fnw%(s%+30%)		! 'spta'
1590 dim o%(4%) &
	\ o%(o0%)=8%^o0% for o0%=1% to 4%
1600 s2%=fnw%(s%+32%)		! 'scth'
1610 v0%=s0%+1214%		! variable table
1620 p0%=s1%+fnw%(s1%)
1630 a%=9%  ! initial symbol table contains 9 symbols.
1640 a%(0%)=-24% &
	\ a$(0%)='det' &
	\ a%(1%)=-60% &
	\ a$(1%)='erl' &
	\ a%(2%)=-26% &
	\ a$(2%)='err' &
	\ a%(3%)=-58% &
	\ a$(3%)='line' &
	\ a%(4%)=-34% &
	\ a$(4%)='num2' &
	\ a%(5%)=-30% &
	\ a$(5%)='num' &
	\ a%(6%)=-16% &
	\ a$(6%)='pi' &
	\ a%(7%)=-54% &
	\ a$(7%)='recount'
1645 a%(8%)=-62% &
	\ a$(8%)='status'
1650 !  look up all user symbols in the symbol table.
1660 for v%=v0% to v0%+50% step 2% &
	\ p%=fnw%(v%) &
	\ if p%=0% then 1730
1670 q%,q1%=v%+p%
1680 a$=chr$((v%-v0%)/2%+65%)
1685 q1%=q1%-1% &
	\ x%=fnb%(q1%) &
	\ if (x% and 128%)=0% then a$=a$+chr$(x%) if x% &
	\ goto 1685
1687 a0$=a$
1690 q1%=q1% and -2% &
	\ t%=fnb%(q1%) &
	\ a$="fn"+a$ if t% and 16% &
	\ a$=a$+"%" if t% and 1% &
	\ a$=a$+"$" if t% and 4% &
	\ a$(a%)=a$
1693 if t% and 8% then a$=a$+"("+fns$(fnw%(q1%-6%)) &
	\ a$=a$+","+fns$(fnw%(q1%-4%)) if fnw%(q1%-4%) &
	\ a$=a$+")" &
	\ a$=a$+"="+fns$(2%*fnw%(q1%-8%)) if &
	fnb%(q1%-18%)<>0% and (t% and 4%)<>0% &
	\ a$(a%)=a$
1694 if t% and 8% then if fnb%(q1%-18%) then &
	a$="#"+fns$(fnb%(q1%-18%)/2%)+", "+a$ &
	\ a$(a%)=a$
1695 if t% and 8% then f9%=30%-2% else if t% and 4% then f9%=10%-2% &
	else if t% and 2% then f9%=4%+2%*m0%-2% else f9%=6%-2%
1697 a%(a%)=q1%-f9%-s0% &
	\ a%=a%+1%
1700 if t% and 16% then a%(a%)=a%(a%-1%)-4% &
	\ a$(a%)=a$(a%-1%) &
	\ a%=a%+1%
1710 z%=fnw%(q1%-2%) &
	\ if z% then q1%=z%+q1%-1% &
	\ a$=a0$ &
	\ goto 1690
1720 z%=fnw%(q%) &
	\ if z% then q%,q1%=z%+q% &
	\ goto 1680
1730 next v%
1740 print #4%, tab(24%); 'DISASSEMBLY LISTING OF '; i$ &
	\ print #4%
1743 print #4%, m0%;'Word Math'; &
	\ print #4%, ' with scale factor';log10(m0) if m0<>1. &
	\ print #4% &
	\ print #4%
1745 print #4%, 'Symbol Table:' &
	\ print #4%, a$(a0%) unless a$(a0%)=a$(a0%+1%) for a0%=0% to a%-1%
1747 print #4% &
	\ if f0% then input line #5%, d$
1750 p0%=p0%+fnw%(p0%)
1760 p3%=fnw%(p0%+6%) &
	\ l3%,l4%=fnb%(p0%+8%)
1770 if not f0% then 1810
1780 if l3%=0% or m3%=fnw%(p0%+10%) then 1810
1790 print #4%, d$;
1800 d$="" &
	\ on error goto 1805 &
	\ input line #5%, d$ &
	\ on error goto 0
1803 goto 1790 unless ascii(d$)>=48% and ascii(d$)<=57%
1805 m3%=fnw%(p0%+10%) : resume 1810
1810 print #4% using "\    \  #####: \    \", fno$(p0%);fnw%(p0%+10%); &
	mid(t9$,fnb%(p0%+9%)*6%+1%,6%)
1820 l0%=fnw%(p0%+4%) &
	\ p2%=fnw%(p0%+2%)+p0%
1830 l1%=0% &
	\ if fnb%(p0%+9%)=4% then l0%=1%
1840 if l0%=0% then l0%=-1% &
	\ goto 2440
1850 p1%=fnb%(p2%+l1%) &
	\ p9%=p2%+l1%+1%
1855 u$=u$(p1%) &
	\ u%=cvt$%(u$) &
	\ u1$=cvt$$(mid(u$,3%,4%),4%)
1860 if p1%=0% then if fnb%(p9%)=220% then print #4%, fno$(p9%-1%);q1$; &
	fnb$(p1%);space$(37%);";Historical" &
	\ l2%=0% &
	\ goto 2440
1870 d9$=fnb$(p1%) &
	\ d8$='' &
	\ l1$=''
1880 on u%+1% go to 1890, 1910, 1940, 1970, 2000, 2030, 2060, 2090, &
	2120, 2150, 2170, 2200, 2260, 1910, 1985
1890 !	no args
1900 l2%=0% &
	\ gosub 2290 &
	\ goto 2360
1910 !	one spda
1920 l1$=fnl$(fni%(1%),fnt%) &
	\ l2%=2% &
	\ gosub 2290
1930 print #4%, fno$(p9%);q1$;fno$(fni%(1%)+s0%) &
	\ goto 2360
1940 !	one spta
1950 l1$=fnr$(1%) &
	\ l2%=2% &
	\ gosub 2290
1960 print #4%, fno$(p9%);q1$;fno$(fni%(1%)+s1%) &
	\ goto 2360
1970 !	constants
1980 l1$=fns$(fni%(1%))+"%" &
	\ goto 1990
1985 l1$=fns$(cvt$f(string$(m4%*2%,0%)+cvt%$(fni%(1%)))) &
	\ l1$=l1$+"." unless instr(1%,l1$,".")
1990 l2%=2% &
	\ gosub 2290 &
	\ print #4%, fno$(p9%);q1$;fno$(fni%(1%)) &
	\ goto 2360
2000 !	on go
2010 j6%=fnb%(p9%) &
	\ l1$=l1$+fnr$(j7%)+"," for j7%=j6% to 2% step -2% &
	\ l1$=left(l1$,len(l1$)-1%) &
	\ d9$=d9$+q1$+fnb$(j6%) &
	\ l2%=j6%+1% &
	\ gosub 2290
2020 print #4%, fno$(p9%+j7%-1%);q1$;fno$(fni%(j7%)+s1%) for j7%=2% to &
	j6% step 2% &
	\ goto 2360
2030 !	two spda
2040 p3%=fnt% &
	\ p4%=fni%(1%) &
	\ p5%=fni%(3%) &
	\ l1$=fnl$(p4%,p3%)+","+fnl$(p5%,p3%) &
	\ l2%=4% &
	\ gosub 2290
2050 print #4%, fno$(p9%);q1$;fno$(p4%+s0%);q0$;fno$(p9%+2%);q1$;fno$(p5%+s0%) &
	\ goto 2360
2060 !	three spda
2070 p3%=fnt% &
	\ p4%=fni%(1%) &
	\ p5%=fni%(3%) &
	\ p6%=fni%(5%) &
	\ l2%=6% &
	\ l1$=fnl$(p4%,p3%)+","+fnl$(p5%,p3%)+","+fnl$(p6%,p3%) &
	\ gosub 2290
2080 print #4%, fno$(p9%);q1$;fno$(p4%+s0%);q0$;fno$(p9%+2%);q1$; &
	fno$(p5%+s0%);q0$;fno$(p9%+4%);q1$;fno$(p6%+s0%) &
	\ goto 2360
2090 !  spda relative byte
2100 stop ! spda relative byte not implemented
2110 goto 32767
2120 !	word ipc rel
2130 p3%=fni%(1%) &
	\ l1$=fno$(p3%+p9%+2%) &
	\ l2%=2% &
	\ gosub 2290
2140 print #4%, fno$(p9%);q1$;fno$(p3%) &
	\ goto 2360
2150 !	byte ipc rel
2160 p3%=fnb%(p9%) &
	\ l1$=fno$(p3%+p9%+1%) &
	\ l2%=1% &
	\ d9$=d9$+q1$+fnb$(p3%) &
	\ gosub 2290 &
	\ goto 2360
2170 !  machine code
2180 stop ! machine code not yet implemented.
2190 goto 32767
2200 !	enter
2210 j6%=fnw%(fni%(1%)+s0%+2%) &
	\ j7%=0%
2220 if j6% and 3% then j6%=j6%/4% &
	\ j7%=j7%+1% &
	\ goto 2220
2230 l1$=fnl$(fni%(1%),0%)+"(" &
	\ l1$=l1$+fnl$(fni%(j6%),0%)+"," for j6%=2%*j7%+2% to 4% step -2% &
	\ l1$=left(l1$,len(l1$)-1%) if j7% &
	\ l1$=l1$+")" &
	\ l2%=j7%*2%+3% &
	\ gosub 2290
2240 print #4%, fno$(p9%);q1$;fno$(fni%(1%)+s0%);q0$;fno$(p9%+2%);q1$; &
	fnb$(fnb%(p9%+2%))
2250 print #4%, fno$(p9%+j6%-1%);q1$;fno$(fni%(j6%)+s0%) for j6%=4% to &
	j7%*2%+2% step 2% &
	\ goto 2360
2260 !  for-next type
2270 q$=right(u1$,4%) &
	\ p3%=fnt% &
	\ p4%=fni%(1%) &
	\ p5%=fni%(3%) &
	\ p6%=fni%(5%) &
	\ l1$=fnl$(p4%,p3%)+","+fnl$(p5%,p3%)+"," &
	\ l1$=l1$+fnr$(5%) if q$="x" &
	\ l1$=l1$+fno$(p6%+p9%+6%) if q$<>"x" &
	\ l2%=6% &
	\ gosub 2290
2280 print #4%, fno$(p9%);q1$;fno$(p4%+s0%);q0$;fno$(p9%+2%);q1$; &
	fno$(p5%+s0%);q0$;fno$(p9%+4%);q1$; &
	\ print #4%, fno$(p6%+s1%) if q$="x" &
	\ print #4%, fno$(p6%) if q$<>"x" &
	\ goto 2360
2290 !  op-code line listing subroutine
2300 print #4% using "\    \ \     \ pp\  \ ", fno$(p2%+l1%);d9$;u1$;
2310 q8%=len(l1$) &
	\ q9%=23% &
	\ if q8%<25% then 2330
2320 q7%=instr(1%,l1$,",") &
	\ q8%=q7% if q7% &
	\ if q8%+q9%>80% then &
	  if q9%=23% then q8%=58% else print #4%, q0$;space$(22%); &
	\ q9%=23% &
	\ q8%=58% if q8%>58%
2330 print #4%, left(l1$,q8%); &
	\ q9%=q9%+q8% &
	\ l1$=right(l1$,q8%+1%) &
	\ q8%=len(l1$) &
	\ goto 2320 if q8%
2340 if q9%>47% then print #4%, q0$;space$(47%); else &
	print #4%, space$(48%-q9%);
2345 print #4%, ";"; right(u$,7%)
2350 return
2360 if fnb%(p0%+9%)<>4% then 2410
2370 print #4%, fno$(p2%+l1%+1%);" "; &
	\ j6%=1% &
	\ j9%=fnw%(p0%+4%)
2380 if j9%-j6%>38% then j8%=j6%+72% &
	\ j8%=j9% if j9%<j8% &
	\ print #4%,chr$(fnb%(p2%+l1%+j7%)); for j7%=j6% to j8% &
	\ j6%=j8%+1% &
	\ print #4%, q0$;space$(7%); &
	\ goto 2380
2390 if j6%<=j9% then &
	print #4%, chr$(fnb%(p2%+l1%+j7%)); for j7%=j6% to j9%
2400 print #4%, space$(39%-j9%+j6%);";data statement"
2410 if fnb%(p0%+9%)<>1% then 2440
2420 print #4%, fno$(p9%);q1$;fnb$(fnb%(p9%));space$(37%);";for eveness"
2430 print #4%, fno$(p9%+j6%-1%);q1$;fno$(fni%(j6%)+s0%);q1$; &
	fnl$(fni%(j6%),0%) for j6%=2% to l0%-3% step 2% &
	\ l2%=l0% &
	\ print #4%, fno$(p9%+l0%-2%);q1$;fnb$(fnb%(p9%+l0%-2%));space$(37%);";historical"
2440 l1%=l1%+l2%+1% &
	\ if l1%<l0% then 1850 else print #4% &
	\ goto 1750 if fnw%(p0%)
2450 close 1%, 2%, 4%
32767 on error goto 0 &
	\ end