10 REM > Startup
   20 REM 6502 Tube Emulator written in BASIC
   30 REM v0.10 Initial program based on PDP11Em
   40 REM v0.11 &x3 opcodes interface with host
   50 REM v0.12 Uses runpath for resources
   60 REM v0.13 Updated with same base code as PDPTube
   70 REM v0.14 Added more updates from PDPTube
   80 REM added some bits for BenEater
   90 :
  100 bugfix%=FALSE:REM Error in OS_GetEnv
  110 ON ERROR PROCpr:REPORT:PROCClose_All:PRINT" at line ";ERL:END
  120 A$=FNOS_GetEnv:ver$="0.14":debug%=0:PROCInit:A%=FN_DEBUG(STR$debug%)
  130 IFbugfix%:IFPAGE>&FFFFF:SYS "GetCommandLine" TO name%:IFINSTR($$name%,"bbcwin.exe")=0:A$="-"
  140 IF A$="-":A$=""
  150 quiet%=A$<>""
  160 IF A$="":PRINT"6502 Emulator v"ver$" (C)2006 J.G.Harston"'"Memory start:  &"FNh0(mem%,8)" MemSz: &"FNh0(mz%,6)
  170 IF A$="":PRINT"Program space: &"FNh0(mbot%,6)"-&"FNh0(mtop%,6)"  ";(mtop%-mbot%);" bytes"'
  180 ON ERROR PROCError:A$=""
  190 IF A$<>"":A%=FN_RUN(A$)
  200 IF run%:PROCGo
  210 IF quiet%:A%=FN_QUIT("")
  220 ON ERROR PROCError:A$=""
  230 quiet%=TRUE:REPEAT INPUT LINE"65Em> "A$:PROCcmd(A$,TRUE):UNTIL0
  240 END
  250 :
  260 DEFPROCInit
  270 d$=".":s$="/":IFos%>6:d$="/":s$=".":IFos%=32:d$="\"
  280 IFbugfix%:IFPAGE>&FFFFF:run$=@dir$+"*"
  290 runpath$=run$:IF LEFT$(runpath$,1)="""":runpath$=MID$(runpath$,2,LEN runpath$-2)
  300 REPEAT runpath$=LEFT$(runpath$):UNTIL INSTR(d$+":",RIGHT$(runpath$,1))
  310 IFos%=32:mx%=@vdu%!208:my%=@vdu%!212:mw%=@vdu%!216:mh%=@vdu%!220:mc%=@vdu%?73+1
  320 mz%=FNmemsize:mm%=mz%-1:mtop%=mz%:mbot%=0:run%=FALSE:trace0%=0:trace1%=&FFFF
  330 DIM ctrl% 31,name% 255,mem% mz%:zp%=name%:X%=ctrl%:Y%=X%DIV256
  340 ra%=0:rx%=0:ry%=0:rp%=0:rs%=&1FF:rpc%=0
  350 osw0%=FALSE:err%=&100:escflg%=&FF:prog%=&F800:iobase%=-1:memmax%=&F800
  360 REM Initial state:
  370 OSCLI"Load """+FNf_name(runpath$+"TOS64")+""" "+STR$~(mem%+&F800)
  380 A%=mem%!&FFB7 AND &FFFF:FOR B%=0 TO &35:mem%?(B%+&200)=mem%?(A%+B%):NEXT
  390 mem%!&F0=&800:mem%!&F4=&8000:mem%?escflg%=0
  400 PROCEscInit:ENDPROC
  410 :
  420 DEFFNmemsize:A%=2^INT(LN(HIMEM-LOMEM-1024)/LN2):IF A%<&10000:=A% ELSE =&10000
  430 :
  440 DEFPROCError:X%=ctrl%:Y%=X%DIV256:IF INKEY-1:run%=FALSE
  450 IF NOTrun%:PROCpr:REPORT:PROCClose_All:PRINTLEFT$(" at line "+STR$ERL,ERR<128 AND ERR<>17):IF INKEY-1:PROCRegDump
  460 IF ERR=25:IFrun%:IF os%=32:run%=FALSE:VDU 23,22,mx%;my%;mw%,mh%,mc%,128:run%=TRUE:ENDPROC
  470 IF ERR=17:mem%?255=255:rp%=rp%OR(osw0%AND1):osw0%=FALSE:ENDPROC
  480 IF run%:mem%!err%=ERR*256:A%=ERR<128 AND ERR<>17:$(mem%+err%+7)=LEFT$("PDPEm: ",A%)+REPORT$+LEFT$(" at line "+STR$ERL,A%AND(ERL>0))+CHR$0:rpc%=err%:IFERR=17:mem%?escflg%=&FF
  490 ENDPROC
  500 DEFPROCpr:IF?(TOP-3):ENDPROC ELSE PRINT:ENDPROC
  510 :
  520 DEFPROCcmd(A$,link%):REPEAT:A$=FNs(A$):IFLEFT$(A$,1)="*":A$=MID$(A$,2)
  530 UNTIL LEFT$(A$,1)<>"*" AND LEFT$(A$,1)<>" ":reset%=0
  540 IF A$=""ORLEFT$(A$,1)="|":ENDPROC
  550 REM IF LEFT$(A$,1)="*":OSCLI MID$(A$,2):ENDPROC
  560 IF LEFT$(A$,1)=".":OSCLI "."+MID$(A$,2)+LEFT$(LEFT$("\",LENA$>2)+"*.*",os%=32):ENDPROC
  570 IF LEFT$(A$,1)="/":A$="RUN "+MID$(A$,2)
  580 IF FNuc(LEFT$(A$,2))="FX":IF VALMID$(A$,3) OR (MID$(A$,3,1)="0"):OSCLIA$:ENDPROC
  590 A%=INSTR(A$+" "," "):C$=FNuc(LEFT$(A$,A%-1)):T$=MID$(A$,A%+1)
  600 A%=INSTR(" BASIC CORE DEBUG GO HELP LOAD MDUMP MDIS MEDIT QUIT RUN RESET SAVE BASE "," "+C$+" ")
  610 IF A%:A%=EVAL("FN_"+C$+"(T$)"):ENDPROC
  620 A%=FN_run(C$+" "+T$,link%):ENDPROC
  630 :
  640 DEFFN_HELP(A$):PRINT'"6502 Emulator ";ver$:IF FNuc(A$)<>"6502":=0
  650 PRINT"  BASIC"'"  CORE  <core>"'"  DEBUG (<value> (<lowaddr> <highaddr>))";CHR$8'"  GO    (<addr>)"'"  HELP"
  660 PRINT"  LOAD  <afsp> <addr>"'"  MDUMP <addr>"'"  MDIS  <addr>"'"  QUIT"'"  RESET (<afsp>)"'"  RUN   <afsp>"
  670 PRINT"  SAVE  <fsp> <start> <end>|+<length> (<exec> (<load>))"
  680 =0
  690 :
  700 DEFFN_BASE(A$):iobase%=EVAL("&"+FNuc(A$)):=0
  710 :
  720 DEFFN_MDIS(A$):LOCAL N%,P%,C%
  730 PROCaddrs:P%=start%:N%=16:IF num%<2:size%=256
  740 REPEAT:C%=16:REPEATPRINTFNo0(P%,6);" ";:A$=FNdis(P%)
  750     FOR A%=0 TO N%-1 STEP 2:PRINTFNo0(mem%!(P%+A%)AND&FFFF,6);" ";:NEXT
  760     PRINTSPC(21-3.5*N%);:FOR A%=0 TO N%-1:PRINTFNc(mem%?(P%+A%));:NEXT:PRINTSPC(7-N%);A$
  770   P%=(P%+N%)AND&FFFF:C%=C%-1:size%=size%-N%:UNTIL C%=0 OR size%<0:IF size%>0:A%=GET ELSE A%=0
  780 UNTIL A%=27 OR size%<0:=0
  790 :
  800 DEFFN_MDUMP(A$):LOCAL N%,P%,C%
  810 PROCaddrs:P%=start%:N%=16:IF num%<2:size%=256
  820 REPEAT:C%=16:REPEATPRINTFNh0(P%,4);" ";
  830     FOR A%=0 TO N%-1:PRINTFNh0(mem%?(P%+A%),2);" ";:NEXT
  840     FOR A%=0 TO N%-1:PRINTFNc(mem%?(P%+A%));:NEXT:PRINT
  850   P%=(P%+N%)AND&FFFF:C%=C%-1:size%=size%-N%:UNTIL C%=0 OR size%<0:IF size%>0:A%=GET ELSE A%=0
  860 UNTIL A%=27 OR size%<0:=0
  870 :
  880 DEFFN_MEDIT(A$):=0
  890 :
  900 DEFFN_SAVE(A$)
  910 PROCfname:PROCaddrs
  920 IF num%<2:ERROR 252,"Bad address"
  930 IF start%>=0:start%=mem%+(start%ANDmm%)
  940 OSCLI "SAVE """+FNf_name(F$)+""" "+STR$~start%+"+"+STR$~size%+" "+STR$~exec%+" "+STR$~load%
  950 =0
  960 :
  970 DEFFN_LOAD(A$)
  980 PROCfname:PROCaddrs:IF num%=0:load%=-1
  990 =FN_load(F$,load%,TRUE)
 1000 :
 1010 DEFFN_QUIT(A$):IF VAL A$:halt%=TRUE:=0
 1020 PROCClose_All:REM IF os%=32:PRINT"Press SPACE to exit";:A%=GET
 1030 OSCLI"QUIT":=0
 1040 :
 1050 DEFFN_BASIC(A$):REM =FN_RUN("<65Tube$Basic> "+A$)
 1060 PRINT"BASIC"':=FN_RUN(""""+runpath$+FNf_name("Basic")+"""")
 1070 :
 1080 DEFFN_RESET(A$):CLS:A%=-1
 1090 REM IF FNuc(A$)="TUBE":IF client$<>"":OSCLI"Load """+client$+""" "+STR$~(mem%+&F800):memmax%=&F500:A$=""
 1100 REM IF memmax%<&F800 THEN
 1110 REM PRINT'$(mem%+&F805):A%=mem%!&F5FC AND &FFFF
 1120 REM ELSE
 1130 PRINT'"6502 Tube Emulator":IF A$<>"":A%=FN_load(A$,-1,TRUE)
 1140 REM ENDIF
 1150 REM IF FNuc(A$)="NOTUBE":memmax%=&FF00:A$=""
 1160 PRINT'"Econet Station 128"':IF A%<0:=0
 1170 hdr%=mem%+A%:IF hdr%!(hdr%?7)=&29432800:B%=hdr%+9:REPEATVDU?B%:B%=B%+1:UNTIL?B%=0
 1180 IF hdr%-mem%=0:VDU11,11
 1190 PRINT':F$="":rp%=0:=FN_go
 1200 :
 1210 DEFFN_load(RETURN F$,A%,F%)
 1220 in%=0:size%=0:IF A%=-1 THEN
 1230   in%=FNf_openin(F$):IF in%=0:IF F%:F$=F$+s$:in%=FNf_openin(F$)
 1240   IF in% THEN
 1250     size%=EXT#in%:PROCgbpb(4,in%,hdr%,256,0)
 1260     IF hdr%!(hdr%?7)=&29432800 AND (hdr%?6 AND 32)<>0 THEN
 1270       A%=hdr%?7:REPEATA%=A%+1:UNTILhdr%?A%=0:A%=hdr%!(A%+1)
 1280     ELSE
 1290       IF A%<0:IF PAGE<&FFFFF:SYS"XOS_File",5,F$,-1 TO ,,A%
 1300     ENDIF
 1310   ELSE
 1320     A%=-2:REM Not found
 1330   ENDIF
 1340 ENDIF
 1350 REM IF A%<0:IF F%:IF in%=0:ERROR 214,"File not found"
 1360 REM IF A%<0 OR F%:IF in%:CLOSE#in%:in%=0
 1370 REM IF A%<0:IF F%:ERROR 252,"Bad address"
 1380 IF in%:IF F% OR A%=-1:CLOSE#in%:in%=0
 1390 IF A%=-2:IF F%:ERROR 214,"File not found"
 1400 IF A%=-1 OR (A%+size%>mm%):ERROR 252,"Bad address"
 1410 IF F%:OSCLI"Load """+FNf_name(F$)+""" "+STR$~(mem%+A%)
 1420 =A%
 1430 :
 1440 DEFPROCsyscmd(cli$):IF os%<>32:OSCLI cli$:ENDPROC
 1450 LOCAL ch%,err$,tmp$:tmp$=@tmp$+STR$TIME+"."
 1460 LOCAL ERROR:ON ERROR LOCAL:RESTORE ERROR:IF ERR=214:OSCLI cli$:ENDPROC ELSE ERROR ERR,REPORT$:ENDPROC
 1470 OSCLI cli$+" 2>"+tmp$:ch%=OPENIN(tmp$):IF ch%=0:ENDPROC
 1480 err$=GET$#ch%:CLOSE#ch%:OSCLI"Delete "+tmp$:IF RIGHT$(err$,1)=",":RIGHT$(err$,1)="."
 1490 ERROR 254,err$:ENDPROC
 1500 :
 1510 DEFFN_RUN(A$)
 1520 IF PAGE<&FFFFF:SYS"XOS_File",5,A$ TO ,,A%:A%=A%AND&FFF00:IF A%=&FFB00=FN_BASIC(A$)
 1530 IF PAGE<&FFFFF:IF A%=&BBC00:A%=&8000
 1540 =FN_run(A$,FALSE)
 1550 DEFFN_run(A$,osc%):A$=FNs(A$):IF A$="":=0
 1560 C$=A$:PROCfname:hdr%=zp%:A%=FN_load(F$,-1,FALSE):IF A%<0:IF osc%:PROCsyscmd(C$):=0
 1570 IF A%=-2:ERROR 214,"File not found"
 1580 rp%=1:=FN_go
 1590 DEFFN_go
 1600 REM A%  = entry address as 6502 address
 1610 REM hdr%=>Acorn ROM header in mem%+A% address
 1620 REM in% =open file being loaded
 1630 REM F$  =file being loaded or "" if already in memory
 1640 REM membot%=base%:err%=memmax%:escflg%=err%+255:B%=A%
 1650 membot%=&800:err%=&100:escflg%=&FF:B%=A%
 1660 IF hdr%!(hdr%?7)=&29432800 THEN
 1670   REM Acorn ROM header
 1680   IF (hdr%?6 AND 64)=0 :CLOSE#in%:in%=0:ERROR 249,"Not a language":=0
 1690   IF (hdr%?6 AND 15)>3:CLOSE#in%:in%=0:ERROR 249,"Not 6502 code":=0
 1700   IF (hdr%?6 AND 32)<>0:B%=hdr%?7:REPEATB%=B%+1:UNTILhdr%?B%=0:B%=A%+hdr%!(B%+5)
 1710 ENDIF
 1720 prog%=A%:IF prog%<&8000:memtop%=memmax% ELSE memtop%=prog%
 1730 load%=A%:rpc%=A%:IFin%:CLOSE#in%:in%=0
 1740 PROCGo:=0
 1750 :
 1760 DEFFN_GO(A$):IF A$="":=0
 1770 A%=INSTR(A$,";"):rpc%=FNhex(A$):IF A%:A$=MID$(A$,A%+1) ELSE A$=""
 1780 F$="":A%=rpc%:hdr%=mem%+A%:rp%=1:=FN_go
 1790 :
 1800 DEFFN_CORE(A$):REM Dump core
 1810 A$=FNf_name(FNs(LEFT$(A$,INSTR(A$+" "," ")-1))):IFA$="":A$="core"
 1820 OSCLI"Save "+A$+" "+STR$~mem%+"+"+STR$~mz%
 1830 PROCSetType(A$,&FFD)
 1840 =0
 1850 :
 1860 DEFFN_DEBUG(A$):IFA$="":PRINT"1=Register Dump"'"3=Single Step":=0
 1870 debug%=0:trace0%=0:trace1%=&FFFF:IF FNuc(A$)="OFF":=0
 1880 debug%=EVAL(A$):IF(debug%AND1):IF VPOS<9:REPEAT PRINT:UNTIL VPOS>8
 1890 A%=INSTR(A$," "):IF A%:trace0%=FNhex(MID$(A$,A%+1)):A$=MID$(A$,A%+1)
 1900 A%=INSTR(A$," "):IF A%:trace1%=FNhex(MID$(A$,A%+1))
 1910 =0
 1920 :
 1930 DEFPROCSetType(A$,A%):IF os%>8:ENDPROC
 1940 OSCLI"SetType "+A$+" "+STR$~A%
 1950 ENDPROC
 1960 :
 1970 DEFFNhex(A$)
 1980 IFFNuc(LEFT$(A$,2))="&O":=EVAL("&"+FNh0(FNoct(MID$(A$,3)),8)) ELSE =EVAL("&"+FNuc(A$))
 1990 DEFFNoct(A$):LOCAL A%:REPEAT
 2000   IF A$>"/" AND A$<":":A%=A%*8+VAL LEFT$(A$,1):A$=MID$(A$,2)
 2010 UNTIL NOT(A$>"/" AND A$<":"):=A%
 2020 :
 2030 DEFPROCfname
 2040 IFLEFT$(A$,1)="""":A%=INSTR(A$+"""","""",2):F$=MID$(A$,2,A%-2) ELSE A%=INSTR(A$+" "," "):F$=LEFT$(A$,A%-1)
 2050 A$=FNs(MID$(A$,A%+1)):ENDPROC
 2060 :
 2070 DEFPROCaddrs
 2080 num%=0:start%=0:size%=0:load%=0:exec%=0
 2090 A$=FNs(A$):IF A$="":ENDPROC
 2100 num%=INSTR(A$,"+"):IF num%=0:num%=INSTR(A$+" "," ")
 2110 start%=FNhex(LEFT$(A$,num%-1)):load%=start%:exec%=load%:A$=FNs(MID$(A$,num%)):num%=1:IF A$="":ENDPROC
 2120 IF LEFT$(A$,1)="+":size%=0:A$=FNs(MID$(A$,2)) ELSE size%=start%
 2130 num%=INSTR(A$+" "," "):size%=FNhex(LEFT$(A$,num%-1))-size%:A$=FNs(MID$(A$,num%+1)):num%=2:IF A$="":ENDPROC
 2140 num%=INSTR(A$+" "," "):exec%=FNhex(LEFT$(A$,num%-1)):A$=FNs(MID$(A$,num%+1)):num%=3:IF A$="":ENDPROC
 2150 num%=INSTR(A$+" "," "):load%=FNhex(LEFT$(A$,num%-1)):A$=FNs(MID$(A$,num%+1)):num%=4
 2160 ENDPROC
 2170 :
 2180 DEFPROCRegDump:PRINT"A=&"FNh0(ra%,2)" X=&"FNh0(rx%,2)" Y=&"FNh0(ry%,2)" P=&"FNh0(rp%,2);" ";
 2190 FOR A%=7 TO 0 STEP -1:PRINTMID$("-CZIDB5VN",(((rp%AND(2^A%))<>0)AND(A%+1))+1,1);:NEXT:PRINT"  "
 2200 PRINT "XY=&";:PROCDumpLine(rx%+256*ry%):PRINT
 2210 PRINT " S=&";:PROCDumpLine(rs%):PRINT
 2220 PRINT "PC=&";:PROCDumpLine(rpc%)
 2230 A%=FNDis_Code(65,rpc%,mem%+rpc%):PRINT$(X%+4);SPC(56-POS)
 2240 REM PRINT "2A=&";:PROCDumpLine(mem%!&2A AND&FFFF):PRINT
 2250 REM PRINT "0B=&";:PROCDumpLine(mem%!&0B AND&FFFF):PRINT
 2260 REM PRINT "39=&";:PROCDumpLine(mem%!&39 AND&FFFF):PRINT
 2270 REM PRINT "19=&";:PROCDumpLine(mem%!&19 AND&FFFF):PRINT
 2280 REM PRINT "15=&";FNh0(mem%?&15,2)
 2290 ENDPROC
 2300 :
 2310 DEFPROCDumpLine(m%):PRINT FNh0(m%,4)" ";
 2320 FOR B%=m% TO m%+7:PRINT FNc(mem%?B%);:NEXT:VDU32
 2330 FOR B%=m% TO m%+7:PRINT FNh0(mem%?(B%ANDmm%)AND&FF,2)" ";:NEXT
 2340 ENDPROC
 2350 :
 2360 DEFFNdis(A%):N%=FNDis_Code(65,A%,mem%+(A%ANDmm%)):=$(X%+4)
 2370 :
 2380 DEFFNc(A%):A%=A%AND255:IF A%<32 OR A%>126:="." ELSE =CHR$ A%
 2390 :
 2400 DEFPROCEscInit:esch%=esch%:IFesch%:ENDPROC
 2410 IFos%=32 THEN
 2420   DIM P% 36, L% -1:[OPT 8:.escyes:mov byte [edi-1],0:mov eax,-1:ret
 2430   .esch%:mov ecx,256:mov edi,[@vdu%-148]:mov al,27:cld
 2440   repnz scasb:jz escyes:xor eax,eax:ret:.escb%:dw 0:dw 0:]:ENDPROC
 2450 ENDIF
 2460 DIM esch% 31:FOR P=0 TO 1:P%=esch%:[OPT P*2:MOV R11,R11,LSL #1
 2470 LDR R12,escb%:STRB R11,[R12]:MOV PC,R14:.escb%:EQUD mem%+escflg%:]:NEXT:escho%=0:ENDPROC
 2480 DEFPROCEscOff:escho%=escho%:IFescho%:ENDPROC
 2490 IFos%<>32:SYS "OS_ChangeEnvironment",9,esch%,0,0 TO ,escho%,escRo%,escbo%:ENDPROC
 2500 OSCLI"ESC OFF":escho%=TRUE:ON TIME IFUSResch%:mem%?escflg%=&FF:RETURN ELSE RETURN
 2510 ENDPROC
 2520 DEFPROCEscOn:escho%=escho%:IFescho%=0:ENDPROC
 2530 IFos%<>32:SYS "OS_ChangeEnvironment",9,escho%,escRo%,escbo%:escho%=0:ENDPROC
 2540 ON TIME OFF:escho%=0:OSCLI"ESC ON":ENDPROC
 2550 :

Download Startup

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.