PDP11Em.bbc

10 REM > Startup

20 REM PDP11 Emulator with disassembler

30 REM v0.12 2004 Some more work

40 REM v0.13 2005 *Commands, RTS, EMT, TRAP

50 REM v0.14 01-Sep-2005 More EMTs and TRAPs, mode 7(pc) seems to work, works on PC/Windows

60 REM TRAP 3 and 4 work for STD*, FNsrc() sets address of source

70 REM v0.15 04-Mar-2006 Split out UNIX traps, allocated startup memory, branches fixed,

80 REM errors caught, flags change

90 REM v0.16 20-May-2006 Uses new Make system

100 REM v0.17 18-Mar-2007 prog% at &000 as per Unix expectations

110 REM - means hardware vectors must be somewhere else

120 REM stack frame created for files with headers

130 REM v0.18 13-Jan-2008 Uses updated disassembly API, stack frame includes null environment

140 REM v0.19 03-Feb-2008 Added some odd address checking

150 REM v0.20 02-Sep-2008 Tightened up filename extensions

160 REM v0.21 18-Feb-2009 Background handler sets Escape flag

170 REM v0.22 29-Sep-2009 Stack frame always word aligned

180 REM v0.23 17-Jun-2009 Errors can return via errvec%, abort restores saved PC

190 REM v0.24

200 REM v0.25 10-Jan-2014 Path to commands can contain quoted spaces, fixes "C:\My Documents\etc".

210 REM v0.26 27-Aug-2015 Added *RESET command

220 REM v0.27 29-Sep-2015 Added SOFT parameter to *RESET, *GO searches Client for EXECUTE routine.

230 REM v0.28 24-Oct-2015 *RUN uses Client EXECUTE routine, better checking of code header.

240 REM v0.29 27-Jul-2018 Rewrote MUL, shifts and rotates use << and >>

250 REM v0.29a 29-Apr-2020 Tweeks to FNload() and FNrun(), V fixed on CMP/SUB

260 REM v0.30 11-Mar-2021 Added *SAVE, start/len/exec/load address general parser

270 REM v0.30a 21-Apr-2021 OSCLI catches DOS errors, quiet exit from running from PDP11> prompt

280 REM v0.31 01-Nov-2023 Tweeks to work on SDL BASIC

290 :

300 slowfix%=TRUE:REM Don't use Client on slow systems

310 bugfix%=FALSE:REM Error in OS_GetEnv

320 ON ERROR PROCpr:REPORT:PROCClose_All:PRINT" at line ";ERL:END

330 IF(INKEY-256AND&DF)=83:A$="":run$="":cd$=@dir$:os%=32 ELSE A$=FNOS_GetEnv:cd$="":REM Workaround for SDL BASIC

340 ver$="0.31":debug%=0:PROCInit:A%=FN_DEBUG(STR$debug%)

350 IFbugfix%:IFPAGE>&FFFFF:SYS "GetCommandLine" TO name%:IFINSTR($$name%,"bbcwin.exe")=0:A$="-"

360 IF A$="":IFos%=32 OR (INKEY-256AND&DF)=83:in%=OPENIN(@dir$+"basic.rom"):IFin%:CLOSE#in%:in%=0:A$=""""+@dir$+"basic.rom"""

370 IF A$="-":A$=""

380 quiet%=A$<>""

400 IF A$="":PRINT"Memory start: &"FNh0(mem%,8)" MemSz: &"FNh0(mz%,6):REM " MemMsk: &"FNh0(mm%,6)

410 IF A$="":PRINT"base: &"FNh0(base%,4)" prog: &"FNh0(prog%,4)" err: &"FNh0(err%,4)

420 REM IF A$="":PRINT" sys: &";FNh0(sys%,4)" io: &"FNh0(io%,4)

430 IF A$="":PRINT"Program space: &"FNh0(membot%,4)"-&"FNh0(memtop%,4)" ";(memtop%-membot%);" bytes"

440 ON ERROR PROCError:A$=""

450 IF A$<>"":A%=FN_RUN(A$)

460 IF run%:PROCGo

470 IF quiet%:A%=FN_QUIT("")

480 ON ERROR PROCError:A$=""

490 quiet%=TRUE:REPEAT INPUT LINE"PDP11> "A$:PROCcmd(A$,TRUE):UNTIL0

500 END

510 :

520 DEFPROCInit

530 REM::IF(INKEY-256AND&DF)=83:IF(@platform%AND15):os%=8

540 d$=".":s$="/":fsnum%=0:IFos%AND40:d$="/":s$=".":fsnum%=24:IFos%AND32:d$="\":fsnum%=29:IF(INKEY-256AND&DF)=83:IF(@platform%AND15):d$="/":fsnum%=24

550 IFbugfix%:IFPAGE>&FFFFF:run$=@dir$+"*"

560 runpath$=run$:IF LEFT$(runpath$,1)="""":runpath$=MID$(runpath$,2,LEN runpath$-2)

570 REPEAT runpath$=LEFT$(runpath$):UNTIL INSTR(d$+":",RIGHT$(runpath$,1)) OR runpath$=""

580 IFos%=32:mx%=@vdu%!208:my%=@vdu%!212:mw%=@vdu%!216:mh%=@vdu%!220:mc%=@vdu%?73+1

590 mz%=FNmemsize:mm%=mz%-1:memmax%=mz%:run%=FALSE:trace0%=0:trace1%=&FFFF

600 DIM ctrl% 31,name% 255,r%(7),mem% mz%:zp%=name%:hdr%=zp%:psw%=0:X%=ctrl%:Y%=X%DIV256

610 basic$="":IF os%>31 OR (INKEY-256AND&DF)=83:basic$=@dir$+"basic.rom" ELSE IF os%=6:basic$="<PDP$Basic>"

620 PROCclient:IF client$<>"":OSCLI "Load """+client$+""" "+STR$~(mem%+&F800):memmax%=&F600

630 base%=FNmem(&100):base%=FNmem(0):prog%=base% :REM Allocate low memory

640 err%=FNmem(-&100):err0%=err%:mem%?err%=13:escflg%=err%+255 :REM Allocate high memory

650 memtop%=memmax%:membot%=base%:reset%=0:trapvec%=0:errvec%=0:emt%=0:ind%=0:r7%=0:pc%=0

660 PROCEscInit:ENDPROC

670 :

680 DEFFNmemsize:A%=2^INT(LN(HIMEM-LOMEM-1024)/LN2):IF A%<&10000:=A% ELSE =&10000

690 DEFFNmem(A%):IF A%<0:memmax%=memmax%+A%:=memmax% ELSE membot%=membot%+A%:=membot%-A%

700 DEFPROCclient:client$="":pc%=0:REPEAT

710 client$=MID$("Tube ClientSerial",pc%*6+1,6+2*(pc%=0))

720 IF os%>31:client$=FNf_name(runpath$+client$+"11.pdp") ELSE IF NOTslowfix%:client$=FNf_name(runpath$+client$+"11*")

730 in%=OPENIN(client$):pc%=pc%+1:UNTIL pc%=3 OR in%<>0

740 IF in%:CLOSE#in%:in%=0 ELSE client$=""

750 ENDPROC

760 :

770 DEFPROCError:X%=ctrl%:Y%=X%DIV256:IF INKEY-1:run%=FALSE

780 IF NOTrun%:PROCpr:REPORT:PROCClose_All:PRINTLEFT$(" at line "+STR$ERL,ERR<128 AND ERR<>17):IF INKEY-1:PROCRegDump

790 IF ERR=25:IFrun%:IF os%=32:run%=FALSE:VDU 23,22,mx%;my%;mw%,mh%,mc%,128:run%=TRUE:r%(7)=r7%+(r%(7)AND(r7%=0)):ENDPROC

800 REM IF ERR=17:mem%?escflg%=255:psw%=psw%OR(osw0%AND1):IFosw0%:osw0%=FALSE:ENDPROC

810 REM IF run%:mem%!err%=ERR:mem%!(err%+4)=&880F:mem%?(err%+6)=ERR:$(mem%+err%+7)=LEFT$("PDPEm: ",ERR<128 AND ERR<>17)+REPORT$+CHR$0:PROCpsw(0,0,TRUE,TRUE,ERR=17,ERR=17):r%(0)=err%+6:IFERR=17:mem%?escflg%=&FF

820 IF run%:mem%!err%=ERR:mem%!(err%+4)=&880F:mem%?(err%+6)=ERR:A%=ERR<128 AND ERR<>17:$(mem%+err%+7)=LEFT$("PDPEm: ",A%)+REPORT$+LEFT$(" at line "+STR$ERL,A%AND(ERL>0))+CHR$0:psw%=psw%OR3:r%(0)=err%+6:IFERR=17:mem%?escflg%=&FF

830 IF r7%:r%(7)=r7%

840 IF ind%:r%(7)=ind%

850 IF errvec%:r%(7)=errvec%

860 ENDPROC

870 DEFPROCpr:IF?(TOP-3):ENDPROC ELSE PRINT:ENDPROC

880 :

890 DEFPROCcmd(A$,link%):REPEAT:A$=FNs(A$):IFLEFT$(A$,1)="*":A$=MID$(A$,2)

900 UNTIL LEFT$(A$,1)<>"*" AND LEFT$(A$,1)<>" ":reset%=0

910 IF A$=""ORLEFT$(A$,1)="|":ENDPROC

920 IF LEFT$(A$+" ",3)="ls ":A$="."

930 REM IF LEFT$(A$,1)="*":OSCLI MID$(A$,2):ENDPROC

940 IF LEFT$(A$,1)=".":OSCLI "."+MID$(A$,2)+LEFT$(LEFT$("\",LENA$>2)+"*.*",os%=32):ENDPROC

950 IF LEFT$(A$,1)="/":A$="RUN "+MID$(A$,2)

960 IF FNuc(LEFT$(A$,2))="FX":IF VALMID$(A$,3) OR (MID$(A$,3,1)="0"):OSCLIA$:ENDPROC

970 A%=INSTR(A$+" "," "):C$=FNuc(LEFT$(A$,A%-1)):T$=MID$(A$,A%+1)

980 A%=INSTR(" BASIC CORE DEBUG GO HELP LOAD MDUMP MDIS MEDIT QUIT RUN RESET SAVE "," "+C$+" ")

990 IF A%:A%=EVAL("FN_"+C$+"(T$)"):ENDPROC

1000 A%=FN_run(C$+" "+T$,link%):ENDPROC

1010 :

1020 DEFFN_HELP(A$):PRINT'"PDP11 Emulator ";ver$:IF FNuc(A$)<>"PDP11":=0

1030 PRINT" BASIC"'" CORE <fsp>"'" DEBUG (<value> (<lowaddr> <highaddr>))";CHR$8'" GO (<addr>)"'" HELP"

1040 PRINT" LOAD <afsp> <addr>"'" MDUMP <addr>"'" MDIS <addr>"'" QUIT"'" RESET (<afsp>)"'" RUN <afsp>"

1050 PRINT" SAVE <fsp> <start> <end>|+<length> (<exec> (<load>))"

1060 =0

1070 :

1080 DEFFN_MDIS(A$):LOCAL N%,P%,C%

1090 PROCaddrs:P%=start%:N%=16:IF num%<2:size%=256

1100 REPEAT:C%=16:REPEATPRINTFNo0(P%,6);" ";:A$=FNdis(P%)

1110 FOR A%=0 TO N%-1 STEP 2:PRINTFNo0(mem%!(P%+A%)AND&FFFF,6);" ";:NEXT

1120 PRINTSPC(21-3.5*N%);:FOR A%=0 TO N%-1:PRINTFNc(mem%?(P%+A%));:NEXT:PRINTSPC(7-N%);A$

1130 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

1140 UNTIL A%=27 OR size%<0:=0

1150 :

1160 DEFFN_MDUMP(A$):LOCAL N%,P%,C%

1170 PROCaddrs:P%=start%:N%=16:IF num%<2:size%=256

1180 REPEAT:C%=16:REPEATPRINTFNh0(P%,4);" ";

1190 FOR A%=0 TO N%-1:PRINTFNh0(mem%?(P%+A%),2);" ";:NEXT

1200 FOR A%=0 TO N%-1:PRINTFNc(mem%?(P%+A%));:NEXT:PRINT

1210 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

1220 UNTIL A%=27 OR size%<0:=0

1230 :

1240 DEFFN_MEDIT(A$):=0

1250 :

1260 DEFFN_SAVE(A$)

1270 PROCfname:PROCaddrs

1280 IF num%<2:ERROR 252,"Bad address"

1290 IF start%>=0:start%=mem%+(start%ANDmm%)

1300 OSCLI "SAVE """+cd$+FNf_name(F$)+""" "+STR$~start%+"+"+STR$~size%+" "+STR$~exec%+" "+STR$~load%

1310 =0

1320 :

1330 DEFFN_LOAD(A$)

1340 PROCfname:PROCaddrs:IF num%=0:load%=-1

1350 =FN_load(F$,load%,TRUE)

1360 :

1370 DEFFN_QUIT(A$):IF VAL A$:halt%=TRUE:=0

1380 PROCClose_All:REM IF os%=32:PRINT"Press SPACE to exit";:A%=GET

1390 OSCLI"QUIT":=0

1400 :

1410 DEFFN_BASIC(A$)

1420 IF basic$<>"":=FN_RUN(basic$+" "+A$)

1430 =FN_RUN("basic "+A$)

1440 :

1450 DEFFN_RESET(A$):CLS:A%=-1

1460 IF FNuc(A$)="TUBE":IF client$<>"":OSCLI"Load """+client$+""" "+STR$~(mem%+&F800):memmax%=&F500:A$=""

1470 IF memmax%<&F800 THEN

1480 PRINT'$(mem%+&F805):A%=mem%!&F5FC AND &FFFF

1490 ELSE

1500 PRINT'"PDP11 Tube Emulator":IF A$<>"":A%=FN_load(A$,-1,TRUE)

1510 ENDIF

1520 IF FNuc(A$)="NOTUBE":memmax%=&FF00:A$=""

1530 PRINT'"Econet Station 128"':IF A%<0:=0

1540 hdr%=mem%+A%:IF hdr%!(hdr%?7)=&29432800:B%=hdr%+9:REPEATVDU?B%:B%=B%+1:UNTIL?B%=0

1550 IF hdr%-mem%=0:VDU11,11

1560 PRINT':F$="":psw%=0:=FN_go:REM Needs to ensure no stack frame

1570 :

1580 DEFFN_load(RETURN F$,A%,F%)

1590 in%=0:size%=0:IF A%=-1 THEN

1600 in%=FNf_openin(F$):IF in%=0:IF F%:F$=F$+s$+"pdp":in%=FNf_openin(F$)

1610 IF in% THEN

1620 size%=EXT#in%:PROCgbpb(4,in%,hdr%,256,0)

1630 magic%=!hdr% AND &FFFF:IF magic%<&105 OR magic%>&111:A%=-1 ELSE A%=0:REM No address

1640 REM This is duplicated in FNrun

1650 IF hdr%!(hdr%?7)=&29432800 AND (hdr%?6 AND 32)<>0 THEN

1660 A%=hdr%?7:REPEATA%=A%+1:UNTILhdr%?A%=0:A%=hdr%!(A%+1)

1670 ELSE

1680 IF A%<0:IF PAGE<&FFFFF:SYS"XOS_File",5,F$,-1 TO ,,A%

1690 ENDIF

1700 ELSE

1710 A%=-2:REM Not found

1720 ENDIF

1730 ENDIF

1740 REM IF A%<0:IF F%:IF in%=0:ERROR 214,"File not found"

1750 REM IF A%<0 OR F%:IF in%:CLOSE#in%:in%=0

1760 REM IF A%<0:IF F%:ERROR 252,"Bad address"

1770 IF in%:IF F% OR A%=-1:CLOSE#in%:in%=0

1780 IF A%=-2:IF F%:ERROR 214,"File not found"

1790 IF A%=-1 OR (A%+size%>mm%):ERROR 252,"Bad address"

1800 IF F%:OSCLI"Load """+FNf_name(F$)+""" "+STR$~(mem%+A%)

1810 =A%

1820 :

1830 DEFPROCsyscmd(cli$):IF os%<>32:OSCLI cli$:ENDPROC

1840 LOCAL ch%,err$,tmp$:tmp$=@tmp$+STR$TIME+"."

1850 LOCAL ERROR:ON ERROR LOCAL:RESTORE ERROR:IF ERR=214:OSCLI cli$:ENDPROC ELSE ERROR ERR,REPORT$:ENDPROC

1860 OSCLI cli$+" 2>"+tmp$:ch%=OPENIN(tmp$):IF ch%=0:ENDPROC

1870 err$=GET$#ch%:CLOSE#ch%:OSCLI"Delete "+tmp$:IF RIGHT$(err$,1)=",":RIGHT$(err$,1)="."

1880 ERROR 254,err$:ENDPROC

1890 :

1900 DEFFN_RUN(A$)

1910 IF PAGE<&FFFFF:SYS"XOS_File",5,A$ TO ,,A%:A%=A%AND&FFF00:IF A%=&FFB00 OR A%=&1C700:=FN_BASIC(A$)

1920 =FN_run(A$,FALSE)

1930 DEFFN_run(A$,osc%):A$=FNs(A$):IF A$="":=0

1940 C$=A$:PROCfname:hdr%=zp%:A%=FN_load(F$,-1,FALSE):IF A%<0:IF osc%:PROCsyscmd(C$):=0

1950 IF A%=-2:ERROR 214,"File not found"

1960 psw%=1:=FN_go

1970 DEFFN_go

1980 REM A% = entry address as PDP11 address

1990 REM hdr%=>Acorn ROM header in mem%+A% address

2000 REM in% =open file being loaded

2010 REM F$ =file being loaded or "" if already in memory

2020 membot%=base%:err%=memmax%:escflg%=err%+255

2030 IF memtop%<&F800 AND A%>&FF THEN

2040 REM Client present and entry address known

2050 IF F$<>"":CLOSE#in%:in%=0:OSCLI"Load """+FNf_name(F$)+""" "+STR$~(mem%+A%)

2060 prog%=A%:IF prog%<&8000:memtop%=memmax% ELSE memtop%=prog%

2070 B%=A%:hdr%=mem%+A%:IF hdr%!(hdr%?7)=&29432800:IF (hdr%?6 AND 32)<>0:B%=hdr%?7:REPEATB%=B%+1:UNTILhdr%?B%=0:B%=A%+hdr%!(B%+5)

2080 B%=mem%!B% AND &FFFF:IF B%<&105 OR B%>&111 ELSE memtop%=memmax%

2090 mem%!&F5F0=err%:$(mem%+err%)=A$ :REM LPTR=command tail

2100 mem%!&F5F4=membot% :REM MEMBOT=&0100

2110 mem%!&F5F6=memtop% :REM MEMTOP=&F500

2120 mem%!&F5F8=A%:r%(1)=A%:prog%=A% :REM ADDR=dest, R1=dest

2130 A%=&F800:REPEAT:A%=A%+2:UNTILmem%!A%=&9F700A1 :REM Look for CLC:JSR CLI_WAIT

2140 r%(7)=A%+(mem%!(A%+4)AND&FFFF)+12 :REM R7=EXECUTE

2150 PROCGo:=0

2160 ENDIF

2170 B%=A%

2180 REM This is duplicated in FNload

2190 IF hdr%!(hdr%?7)=&29432800 THEN

2200 REM Acorn ROM header

2210 IF (hdr%?6 AND 64)=0 :CLOSE#in%:in%=0:ERROR 249,"Not a language":=0

2220 IF (hdr%?6 AND 15)<>7:CLOSE#in%:in%=0:ERROR 249,"Not PDP11 code":=0

2230 IF (hdr%?6 AND 32)<>0:B%=hdr%?7:REPEATB%=B%+1:UNTILhdr%?B%=0:B%=A%+hdr%!(B%+5)

2240 ENDIF

2250 prog%=A%:IF prog%<&8000:memtop%=memmax% ELSE memtop%=prog%

2260 r%(6)=(memtop%-2)AND-2:IF(debug%AND16)=0:r%(5)=&0BBC

2270 IF F$="":r%(0)=1:r%(7)=A%:mem%?r%(6)=0:mem%?(r%(6)+1)=0:PROCGo:=0 :REM No Client, code already in memory

2280 load%=A%:exec%=B%:IF A%<>B%:PROCgbpb(3,in%,zp%,16,B%-A%)

2290 magic%=!zp% AND &FFFF:IF magic%<&105 OR magic%>&111:magic%=0 ELSE magic%=16:exec%=exec%-load%:load%=0:prog%=0

2300 IF magic%=0:PROCgbpb(3,in%,mem%+load%,EXT#in%,0)

2310 IF magic% :PROCgbpb(3,in%,mem%+load%,EXT#in%-(exec%-load%-magic%),exec%-load%+magic%)

2320 CLOSE#in%:in%=0:r%(7)=exec%:IF prog%<&8000:memtop%=memmax% ELSE memtop%=prog%

2330 IF magic%:PROCframe ELSE r%(6)=(r%(6)-LENC$-3)AND-2:$(mem%+r%(6)+2)=C$:r%(1)=r%(6)+2:mem%?0=0:mem%?1=0:mem%?r%(6)=0:mem%?(r%(6)+1)=0

2340 PROCGo:=0

2350 :

2360 REM When running code within Unix:

2370 REM r0-r5=0, r6=top of memory, r7=entry point

2380 REM (sp)=>argn, argv[], envv[], 0

2390 REM Code expects text segment at header+16 to be at address &0000

2400 REM Code entered at header!10

2410 REM Not relocatable if header!14<>0

2420 REM Cannot RTS to system, must exit

2430 REM If no header, &0000 pushed onto stack, [&0000]=halt

2440 :

2450 REM Set up entry from header

2460 REM Create stack frame with command parameters

2470 REM sp=>argn, ->arg[0], ->arg[1], .., 0, ->env[0], ->env[1], .., 0, arg[0], arg[1], .., env[0], env[1], .., 0

2480 REM eg 2, ->cat, ->file, 0, 0, "cat"+0, "file"+0, 0

2490 REM Need to:

2500 REM scan for <file >file >>file options

2510 DEFPROCframe

2520 REM Clear data area:

2530 A%=(zp%!6)AND&FFFF:IF A%:B%=(zp%!2 AND&FFFF)+(zp%!4 AND&FFFF):REPEAT mem%?B%=0:B%=B%+1:A%=A%-1:UNTIL A%=0

2540 REM Set membot to end of code+idata+udata:

2550 membot%=((zp%!2)AND&FFFF)+((zp%!4)AND&FFFF)+((zp%!6)AND&FFFF)+((zp%!8)AND&FFFF)

2560 r%(7)=zp%!10 AND &FFFF :REM Set PC to entry point

2570 REM Convert multiple spaces to single spaces:

2580 REPEAT:A%=INSTR(A$," "):IF A%:A$=LEFT$(A$,A%)+MID$(A$,A%+2)

2590 UNTIL A%=0:IF A$<>"":A$=A$+" "

2600 REM Convert spaces to nulls, and count them:

2610 C%=1:REPEAT:A%=INSTR(A$," "):IF A%:A$=LEFT$(A$,A%-1)+CHR$0+LEFT$(CHR$0,(A%AND1)<>0)+MID$(A$,A%+1):C%=C%+1

2620 UNTIL A%=0

2630 REM Put arguments at top of memory:

2640 A%=(memtop%-LENA$-3)AND-2

2650 B%=(A%-LENF$-1)AND-2

2660 $(mem%+B%)=F$+CHR$0+CHR$0

2670 $(mem%+A%)=A$+CHR$0+CHR$0

2680 A%=B%-C%*2-6:r%(6)=A% :REM Drop SP to make space for stack frame:

2690 mem%?A%=C%:mem%?(A%+1)=C%DIV256 :REM Put argn on stack

2700 A%=A%+2

2710 REM Point to strings on stack

2720 REPEAT

2730 mem%?A%=B%:mem%?(A%+1)=B%DIV256:A%=A%+2

2740 REPEAT:B%=B%+1:UNTILmem%?B%=0 OR B%>=memtop%-2:B%=(B%+2)AND-2

2750 UNTIL B%>=memtop%-2

2760 mem%!(A%-2)=0 :REM End of arg[] list and null env[] list:

2770 mem%?(memtop%-2)=0:mem%?(memtop%-1)=0 :REM terminating null at top of arguments

2780 REM P.~r%(6):A%=FN_MDUMP("FE00")

2790 ENDPROC

2800 :

2810 DEFFN_GO(A$):IF A$="":=0

2820 A%=INSTR(A$,";"):r%(7)=FNhex(A$):IF A%:A$=MID$(A$,A%+1) ELSE A$=""

2830 F$="":A%=r%(7):hdr%=mem%+A%:psw%=1:=FN_go

2840 :

2850 DEFFN_CORE(A$):REM Dump core

2860 A$=FNf_name(FNs(LEFT$(A$,INSTR(A$+" "," ")-1))):IFA$="":A$="core"

2870 OSCLI"Save "+cd$+A$+" "+STR$~mem%+"+"+STR$~mz%

2880 PROCSetType(A$,&FFD)

2890 =0

2900 :

2910 DEFFN_DEBUG(A$):IFA$="":PRINT" 1=Register Dump"'" 3=Single Step"'" 4=EMT/TRAP calls"'" 8=ignore odd word accesses"'"16=r5<>&BBC on startup":=0

2920 debug%=0:trace0%=0:trace1%=&FFFF:IF FNuc(A$)="OFF":=0

2930 debug%=EVAL(A$):IF(debug%AND1):IF VPOS<9:REPEAT PRINT:UNTIL VPOS>8

2940 A%=INSTR(A$," "):IF A%:trace0%=FNhex(MID$(A$,A%+1)):A$=MID$(A$,A%+1)

2950 A%=INSTR(A$," "):IF A%:trace1%=FNhex(MID$(A$,A%+1))

2960 =0

2970 :

2980 DEFPROCSetType(A$,A%):IF os%>8:ENDPROC

2990 OSCLI"SetType "+A$+" "+STR$~A%

3000 ENDPROC

3010 :

3020 DEFFNhex(A$)

3030 IFFNuc(LEFT$(A$,2))="&O":=EVAL("&"+FNh0(FNoct(MID$(A$,3)),8)) ELSE =EVAL("&"+FNuc(A$))

3040 DEFFNoct(A$):LOCAL A%:REPEAT

3050 IF A$>"/" AND A$<":":A%=A%*8+VAL LEFT$(A$,1):A$=MID$(A$,2)

3060 UNTIL NOT(A$>"/" AND A$<":"):=A%

3070 :

3080 DEFPROCfname

3090 IFLEFT$(A$,1)="""":A%=INSTR(A$+"""","""",2):F$=MID$(A$,2,A%-2) ELSE A%=INSTR(A$+" "," "):F$=LEFT$(A$,A%-1)

3100 A$=FNs(MID$(A$,A%+1)):ENDPROC

3110 :

3120 DEFPROCaddrs

3130 num%=0:start%=0:size%=0:load%=0:exec%=0

3140 A$=FNs(A$):IF A$="":ENDPROC

3150 num%=INSTR(A$,"+"):IF num%=0:num%=INSTR(A$+" "," ")

3160 start%=FNhex(LEFT$(A$,num%-1)):load%=start%:exec%=load%:A$=FNs(MID$(A$,num%)):num%=1:IF A$="":ENDPROC

3170 IF LEFT$(A$,1)="+":size%=0:A$=FNs(MID$(A$,2)) ELSE size%=start%

3180 num%=INSTR(A$+" "," "):size%=FNhex(LEFT$(A$,num%-1))-size%:A$=FNs(MID$(A$,num%+1)):num%=2:IF A$="":ENDPROC

3190 num%=INSTR(A$+" "," "):exec%=FNhex(LEFT$(A$,num%-1)):A$=FNs(MID$(A$,num%+1)):num%=3:IF A$="":ENDPROC

3200 num%=INSTR(A$+" "," "):load%=FNhex(LEFT$(A$,num%-1)):A$=FNs(MID$(A$,num%+1)):num%=4:IF A$="":ENDPROC

3210 num%=5:ENDPROC

3220 :

3230 DEFPROCRegDump:LOCAL N%:IF POS:PRINT

3240 FOR A%=0TO7:PRINT"R";A%;"= "FNo0(r%(A%)AND&FFFF,6)": ";FNc(r%(A%)DIV256);FNc(r%(A%));" ";

3250 FOR B%=r%(A%)TOr%(A%)+7:PRINT FNc(mem%?B%);:NEXT:VDU32

3260 FOR B%=r%(A%)TOr%(A%)+7 STEP2:PRINT FNo0(mem%!(B%ANDmm%)AND&FFFF,6)" ";:NEXT

3270 PRINT:NEXT:PRINT"PSW="FNo0(psw%,6);":";SPC(5);

3280 PRINT ;(psw%AND&E0)DIV32;":";MID$("T-",((psw%AND16)<>0)+2,1);

3290 PRINT MID$("M-",((psw%AND8)<>0)+2,1);MID$("Z-",((psw%AND4)<>0)+2,1);

3300 PRINT MID$("V-",((psw%AND2)<>0)+2,1);MID$("C-",((psw%AND1)<>0)+2,1);SPC1;FNdis(r%(7));SPC12

3310 ENDPROC

3320 :

3330 DEFFNdis(A%):N%=FNDis_Code(11,A%,mem%+(A%ANDmm%)):A$=$(X%+4):A%=INSTR(A$,"&"):IFA%=0:=A$

3340 B%=A%:REPEATB%=B%+1:UNTILINSTR("0123456789ABCDEF",MID$(A$,B%,1))=0 OR B%>LENA$

3350 A$=LEFT$(A$,A%)+"o"+FNo0(EVAL(MID$(A$,A%,B%-A%+1)),(B%-A%-1)*3/2)+MID$(A$,B%)

3360 =A$

3370 :

3380 DEFFNc(A%):A%=A%AND255:IF A%<32 OR A%>126:="." ELSE =CHR$ A%

3390 :

3400 DEFPROCEscInit:esch%=esch%:IFesch%:ENDPROC

3410 IF PAGE>&FFFFF THEN

3420 IF(INKEY-256AND&DF)=83 THEN

3430 !(^KbdQ$+4)=256:IF @platform% AND &40:PTR(KbdQ$)=]428 ELSE PTR(KbdQ$)=!428

3440 ENDPROC

3450 ENDIF

3460 DIM P% 36,L% -1:[OPT 8:.escyes:mov byte [edi-1],0:mov eax,-1:ret

3470 .esch%:mov ecx,256:mov edi,[@vdu%-148]:mov al,27:cld

3480 repnz scasb:jz escyes:xor eax,eax:ret:.escb%:dw 0:dw 0:]:ENDPROC

3490 ENDIF

3500 DIM esch% 31:FOR P=0 TO 1:P%=esch%:[OPT P*2:MOV R11,R11,LSL #1

3510 LDR R12,escb%:STRB R11,[R12]:MOV PC,R14:.escb%:EQUD mem%+escflg%:]:NEXT:escho%=0:ENDPROC

3520 DEFPROCEscOff:escho%=escho%:IFescho%:ENDPROC

3530 IF PAGE<&FFFFF:SYS "OS_ChangeEnvironment",9,esch%,0,0 TO ,escho%,escRo%,escbo%:ENDPROC

3540 OSCLI"ESC OFF":escho%=TRUE

3550 IF INKEY-256=87 THEN

3560 ON TIME IFUSResch%:mem%?escflg%=&FF:RETURN ELSE RETURN

3570 ENDPROC

3580 ENDIF

3590 IF(INKEY-256AND&DF)=83 THEN

3600 ON TIME IFINSTR(KbdQ$,CHR$&1B):KbdQ$=STRING$(LENKbdQ$,CHR$0):mem%?escflg%=&FF:RETURN ELSE RETURN

3610 ENDPROC

3620 ENDIF

3630 ON TIME IFINKEY-113:mem%?escflg%=&FF:RETURN ELSE RETURN

3640 ENDPROC

3650 DEFPROCEscOn:IF PAGE>&FFFFF:ON TIME OFF:escho%=0:OSCLI"ESC ON":ENDPROC

3660 SYS "OS_ChangeEnvironment",9,escho%,escRo%,escbo%:escho%=0:ENDPROC

3670 REM DEF FN_was_escape_pressed

3680 REM LOCAL I%, kbdq%%

3690 REM IF @platform% AND &40 kbdq%% = ]428 ELSE kbdq%% = !428

3700 REM FOR I%=0 TO 255 : IF kbdq%%?I% = &1B THEN = TRUE ELSE NEXT

3710 REM = FALSE

10 REM > PDP11

20 REM 08-Nov-2007: ops 1-7, SPL done

30 REM 12-Aug-2008: SXT, ASHC, SOB, ops 1-7, SPL, M[F|T]PS done

40 REM 17-Jun-2010: Entering code resets handlers

50 REM 17-Jul-2018: MUL sets Cy=(result>&FFFF)

60 REM 27-Jul-2018: Rewrote MUL, shifts and rotates use << and >>

70 REM 05-Aug-2018: PROCpsw(xxAND&FFFF/&FF in ADD/SUB

80 REM MOVB is only op that sets b8-b15 of dest. register

90 REM MUL treat arguments as signed, &FFFF x 100 = -100, fixed V on ASH(C)

100 :

110 DEFPROCGo:abort%=FALSE:halt%=0:run%=TRUE:r7%=0:ind%=0:PROCEscOff

120 REM err%=err0%:escflg%=err%+255:escvec%=0:errvec%=0

130 REPEAT:IF(debug%AND1):IF r%(7)>=trace0% AND r%(7)<=trace1%:x%=POS:y%=VPOS:VDU30:PROCRegDump:VDU31,x%,y%:IF(debug%AND2):IF GET

140 op%=mem%!(r%(7)ANDmm%):pc%=r%(7):r%(7)=(r%(7)+2)AND&FFFE

150 dd%=op%AND63:ss%=(op%AND&FC0)DIV64:op%=(op%AND&F000)DIV&1000:by%=op%DIV8

160 A%=EVAL("FN_"+STR$~(op%AND7)):UNTILhalt%:PROCEscOn:run%=FALSE:IFabort%:r%(7)=pc%

170 IF NOTquiet%:IF r%(0):abort%=TRUE

180 IF NOTquiet% AND abort%:PROCRegDump

190 ENDPROC

200 :

210 REM Opcodes are:

220 REM 00xxxx various 10xxxx various

230 REM 01xxxx MOV ss,dd 11xxxx MOVB ss,dd

240 REM 02xxxx CMP ss,dd 12xxxx CMPB ss,dd

250 REM 03xxxx BIT ss,dd 13xxxx BITB ss,dd

260 REM 04xxxx BIC ss,dd 14xxxx BICB ss,dd

270 REM 05xxxx BIS ss,dd 15xxxx BISB ss,dd

280 REM 06xxxx ADD ss,dd 16xxxx SUB ss,dd

290 REM 07xxxx various 17xxxx various

300 :

310 DEFFNsrc(ss%,b%):REM Fetch source value, sets D% to address of source

320 LOCAL m%,r%,a%:D%=0:a%=&FFFF:IF b%:a%=&FF

330 m%=ss%DIV8:r%=ss%AND7:b%=2-b%:IF r%>5:IF m%<6:b%=2:REM sp&pc always +2

340 IF m%=0:D%=0:=r%(r%)ANDa% :REM Rn

350 IF m%=1:D%=r%(r%) :REM (Rn)

360 IF m%=2:D%=r%(r%):r%(r%)=r%(r%)+b% :REM (Rn)+

370 IF m%=3:D%=mem%!(r%(r%)ANDmm%):r%(r%)=r%(r%)+2 :REM @(Rn)+

380 IF m%=4:r%(r%)=r%(r%)-b%:D%=r%(r%) :REM -(Rn)

390 IF m%=5:r%(r%)=r%(r%)-2:D%=mem%!(r%(r%)ANDmm%) :REM @-(Rn)

400 IF m%=6:D%=mem%!(r%(7)ANDmm%):r%(7)=r%(7)+2:D%=(r%(r%)+D%) :REM X(Rn)

410 IF m%=7:D%=mem%!(r%(7)ANDmm%):r%(7)=r%(7)+2:D%=mem%!((r%(r%)+D%)ANDmm%) :REM @X(Rn)

420 IF b%=2:IF(D%AND1):IF(debug%AND8)=0:PRINT"Bus error: word read from odd address (";m%;"/";r%;")":halt%=TRUE:abort%=TRUE

430 =mem%!(D%ANDmm%)ANDa%

440 :

450 DEFPROCpre(dd%,b%):REM Do pre-access register adjustment, sets D% to address of destination

460 LOCAL m%,r%:D%=0:m%=dd%DIV8:r%=dd%AND7:b%=2-b%:IF r%>5:IF m%<6:b%=2:REM sp&pc always +2

470 REM Pre always called, dst sometimes not, so D% must be set up here

480 IF m%=4:r%(r%)=r%(r%)-b% :REM -(Rn)

490 IF m%=5:r%(r%)=r%(r%)-2 :REM @-(Rn)

500 IF m%=1 OR m%=2 OR m%=4:D%=r%(r%) :REM (Rn), (Rn)+, -(Rn)

510 IF m%=3 OR m%=5:D%=mem%!(r%(r%)ANDmm%) :REM @(Rn)+, @-(Rn)

520 IF m%=6:D%=mem%!(r%(7)ANDmm%):r%(7)=r%(7)+2 :REM X(Rn)

530 IF m%=7:D%=mem%!(r%(7)ANDmm%):r%(7)=r%(7)+2 :REM @X(Rn)

540 ENDPROC

550 :

560 DEFFNdst(dd%,b%):REM Fetch destination value

570 LOCAL m%,r%,a%:m%=dd%DIV8:r%=dd%AND7:a%=&FFFF:IF b%:a%=&FF

580 IF m%=0:=r%(r%)ANDa% :REM Rn

590 IF m%=6:=mem%!((r%(r%)+D%)ANDmm%)ANDa% :REM X(Rn)

600 =mem%!(D%ANDmm%)ANDa%

610 :

620 DEFPROCdst2(dd%,v%,b%):REM Store dest value from MOV

630 IF b%=1:IF dd%<8:r%(dd%)=(v%AND&FF) OR (&FF00 AND (v%AND128)<>0):ENDPROC :REM MOVB ,Rn

640 DEFPROCdst(dd%,v%,b%):REM Store dest value and post-access reg adjust

650 REM Storing to mode 7 needs to double indirect

660 LOCAL m%,r%:m%=dd%DIV8:r%=dd%AND7:v%=v%AND&FFFF:b%=2-b%:IF r%>5:IF m%<6:b%=2

670 REM IF b%=2:IF(D%AND1):IF(debug%AND8)=0:PRINT"Bus error: word write to odd address (";m%;"/";r%;")":halt%=TRUE:abort%=TRUE

680 REM IF m%=0:IF b%=1:r%(r%)=(v%AND&FF) OR (&FF00 AND (v%AND128)<>0):ENDPROC :REM Rn

690 IF m%=0:IF b%=1:r%(r%)=(v%AND&FF) OR (&FF00 AND r%(r%)):ENDPROC :REM Rn

700 IF m%=0:r%(r%)=v%:ENDPROC :REM Rn

710 IF m%<6:mem%?(D%ANDmm%)=v%:IFb%=2:mem%?((D%+1)ANDmm%)=v%DIV256 :REM (Rn) [@]-(Rn) [@](Rn)+

720 IF m%=2:r%(r%)=r%(r%)+b%:ENDPROC :REM (Rn)+

730 IF m%=3:r%(r%)=r%(r%)+2:ENDPROC :REM @(Rn)+

740 IF m%=6:mem%?((r%(r%)+D%)ANDmm%)=v%:IF b%=2:mem%?((r%(r%)+D%+1)ANDmm%)=v%DIV256 :REM X(Rn)

750 IF m%=7:mem%?(mem%!((r%(r%)+D%)ANDmm%)ANDmm%)=v%:IF b%=2:mem%?(mem%!((r%(r%)+D%)ANDmm%+1)ANDmm%)=v%DIV256

760 ENDPROC

770 :

780 DEFPROCpsw(v%,b%,cv%,nv%,cc%,nc%):REM value, byte?, changeV?, newV, changeC?, newC

790 IF v%=0:psw%=psw%OR4 ELSE psw%=psw%AND&FFFB

800 IF b%=0:psw%=(psw%AND&FFF7)OR(((v%AND&8000)<>0)AND8)

810 IF b%:psw%=(psw%AND&FFF7)OR(((v%AND&80)<>0)AND8)

820 IF cv%:psw%=(psw%AND&FFFD)OR((nv%<>0)AND2)

830 IF cc%:psw%=(psw%AND&FFFE)OR((nc%<>0)AND1)

840 ENDPROC

850 :

860 DEFPROCcarry(c%):psw%=(psw%AND&FFFE)OR((c%<>0)AND1):ENDPROC

870 DEFFNsxt(A%):=A%OR((A%>&7FFF)AND&FFFF0000)

880 :

890 REM b1xxxx - MOV/MOVB:

900 DEFFN_1:V%=FNsrc(ss%,by%):PROCpre(dd%,by%):PROCdst2(dd%,V%,by%):PROCpsw(V%,by%,1,0,0,0):=0

910 :

920 REM b2xxxx - CMP/CMPB:

930 DEFFN_2:V%=FNsrc(ss%,by%):W%=FNsrc(dd%,by%):R%=V%-W%

940 IF by%:V%=((V%AND&80)<>(W%AND&80))AND((R%AND&80)=(W%AND&80)):PROCpsw(R%,0,1,V%,1,R%AND&FFFFFF00):=0

950 V%=((V%AND&8000)<>(W%AND&8000))AND((R%AND&8000)=(W%AND&8000)):PROCpsw(R%,0,1,V%,1,R%AND&FFFF0000):=0

960 :

970 REM b3xxxx - BIT/BITB:

980 DEFFN_3:V%=FNsrc(ss%,by%):W%=FNsrc(dd%,by%):PROCpsw(V%ANDW%,by%,1,0,0,0):=0

990 :

1000 REM b4xxxx - BIC/BICB:

1010 DEFFN_4:V%=FNsrc(ss%,by%):PROCpre(dd%,by%):W%=FNdst(dd%,by%)

1020 V%=NOTV%ANDW%:PROCdst(dd%,V%,by%):PROCpsw(V%,by%,1,0,0,0):=0

1030 :

1040 REM b5xxxx - BIS/BISB:

1050 DEFFN_5:V%=FNsrc(ss%,by%):PROCpre(dd%,by%):W%=FNdst(dd%,by%)

1060 V%=V%ORW%:PROCdst(dd%,V%,by%):PROCpsw(V%,by%,1,0,0,0):=0

1070 :

1080 REM b6xxxx - ADD/SUB:

1090 DEFFN_6:V%=FNsrc(ss%,0):PROCpre(dd%,0):W%=FNdst(dd%,0):IF by%:R%=W%-V% ELSE R%=W%+V%

1100 IFby%:V%=((V%AND&8000)<>(W%AND&8000))AND((R%AND&8000)=(V%AND&8000))

1110 IFby%=0:V%=((V%AND&8000)=(W%AND&8000))AND((R%AND&8000)<>(V%AND&8000))

1120 PROCdst(dd%,R%,0):PROCpsw(R%AND&FFFF,0,1,V%,1,R%AND&FFFF0000):=0

1130 :

1140 REM b7xxxx - MUL/DIV/ASH/ASHC/XOR/Fop/???/SOB

1150 DEFFN_7:IF by%:=0 ELSE =EVAL("FN_7"+STR$~(ss%DIV8))

1160 :

1170 REM b0xxxx - HALT/etc/Bxx/JSR/CLRetc/RORetc/und:

1180 DEFFN_0:IF(ss%AND&20)=0:IF ss%>3 OR by%:=FNbranch

1190 IF ss%DIV8=7:=0 :REM x07xxx - CSM/.../TSET/WLCK/.../.../.../...

1200 IF ss%DIV8=4:=FN_04 :REM x04rdd - JSR Rn,dst/EMT/TRAP

1210 =EVAL("FN_0"+FNo0(ss%,2)) :REM x0xxdd

1220 :

1230 DEFFNbranch:dist%=dd%+(ss%AND3)*64:op%=ss%DIV4+op%:REM IFINKEY-113:mem%?escflg%=&FF

1240 IF op%=1 :=FNrel(TRUE) :REM BR

1250 IF op%=2 :=FNrel((psw%AND4)=0) :REM BNE - Z=0

1260 IF op%=3 :=FNrel((psw%AND4)<>0) :REM BEQ - Z=1

1270 IF op%=4 :=FNrel(((psw%AND8)<>0)EOR((psw%AND2)<>0)=0) :REM BGE - N XOR V =0

1280 IF op%=5 :=FNrel(((psw%AND8)<>0)EOR((psw%AND2)<>0)<>0) :REM BLT - N XOR V =1

1290 IF op%=6 :=FNrel(((psw%AND4)<>0OR((psw%AND8)<>0EOR(psw%AND2)<>0))=0) :REM BGT - Z OR (N XOR V)=0

1300 IF op%=7 :=FNrel(((psw%AND4)<>0OR((psw%AND8)<>0EOR(psw%AND2)<>0))<>0):REM BLE - Z OR (N XOR V)=1

1310 IF op%=8 :=FNrel((psw%AND8)=0) :REM BPL - N=0

1320 IF op%=9 :=FNrel((psw%AND8)<>0) :REM BMI - N=1

1330 IF op%=10:=FNrel(((psw%AND1)<>0)OR((psw%AND4)<>0)=0) :REM BHI - C OR Z =0

1340 IF op%=11:=FNrel(((psw%AND1)<>0)OR((psw%AND4)<>0)<>0) :REM BLOS- C OR V =1

1350 IF op%=12:=FNrel((psw%AND2)=0) :REM BVC - V=0

1360 IF op%=13:=FNrel((psw%AND2)<>0) :REM BVS - V=1

1370 IF op%=14:=FNrel((psw%AND1)=0) :REM BCC - C=0

1380 IF op%=15:=FNrel((psw%AND1)<>0) :REM BCS - C=1

1390 =0

1400 :

1410 DEFFNrel(A%):IF NOTA%:=0

1420 IF dist%>127:r%(7)=r%(7)-(256-dist%)*2 ELSE r%(7)=r%(7)+dist%*2

1430 =0

1440 :

1450 REM 0000dd - HALT/WAIT/RTI/BPT/IOT/RESET/RTT/MFPT

1460 DEFFN_000

1470 IF dd%=0:halt%=TRUE:abort%=TRUE:=0:REM HALT

1480 IF dd%=1:=0 :REM WAIT

1490 IF dd%=2:=0 :REM RTI

1500 IF dd%=3:=0 :REM BPT

1510 IF dd%=4:=0 :REM IOT

1520 IF dd%=5:=0 :REM RESET

1530 IF dd%=6:=0 :REM RTT

1540 IF dd%=7:=0 :REM MFPT

1550 =0

1560 :

1570 REM 0001dd - JMP:

1580 DEFFN_001:IF(dd%AND&38)=0 OR dd%=&17:IF(debug%AND8)=0:PRINT"JMP fault":halt%=TRUE:abort%=TRUE:=0

1590 A%=FNsrc(dd%,0):IF(D%AND1):IF(debug%AND8)=0:PRINT"Bus error: JMP to odd address":halt%=TRUE:abort%=TRUE:=0

1600 r%(7)=D%AND&FFFF:=0

1610 :

1620 REM 0002xx - RTS/-/-/SPL/Clear flags/Set flags

1630 DEFFN_002

1640 IF dd%>47:psw%=psw%OR(dd%AND15):=0 :REM Sxx

1650 IF dd%>23:psw%=psw%ANDNOT(dd%AND15):=0 :REM Cxx

1660 IF(dd%DIV8)=3:=0 :REM SPL n

1670 IF(dd%DIV8)=2:=0 :REM -

1680 IF(dd%DIV8)=1:=0 :REM -

1690 r%=dd%AND7:r%(7)=r%(r%):W%=mem%?(r%(6)ANDmm%):r%(6)=r%(6)+1

1700 W%=mem%?(r%(6)ANDmm%)*256+W%:r%(6)=r%(6)+1:r%(r%)=W%:=0 :REM RTS r

1710 :

1720 REM 0003dd - SWAB:

1730 DEFFN_003:PROCpre(dd%,0):V%=FNdst(dd%,0):!zp%=V%:zp%!2=V%:R%=zp%!1:REM AND&FFFF

1740 PROCdst(dd%,R%,0):PROCpsw(V%,0,1,0,1,0):=0

1750 :

1760 REM 004rdd - JSR Rn,dst/EMT/TRAP:

1770 DEFFN_04:IF by%:=FN_TRAP

1780 IF(dd%AND&38)=0 OR dd%=&17:PRINT"JSR fault":halt%=TRUE:abort%=TRUE:=0

1790 A%=FNsrc(dd%,0):IF(D%AND1):PRINT"Bus error: JSR to odd address":halt%=TRUE:abort%=TRUE:=0

1800 r%=ss%AND7:W%=r%(r%):r%(6)=r%(6)-1:mem%?(r%(6)ANDmm%)=W%DIV256

1810 r%(6)=r%(6)-1:mem%?(r%(6)ANDmm%)=W%:r%(r%)=r%(7):r%(7)=D%AND&FFFE:=0 :REM JSR r,dd

1820 :

1830 REM b050dd - CLR:

1840 DEFFN_050:PROCpre(dd%,by%):PROCdst(dd%,0,by%):PROCpsw(0,by%,1,0,1,0):=0

1850 :

1860 REM b051dd - COM:

1870 DEFFN_051:PROCpre(dd%,by%):V%=NOTFNdst(dd%,by%):PROCdst(dd%,V%,by%)

1880 IF by%:PROCpsw(V%AND&FF,by%,1,0,1,1):=0 ELSE PROCpsw(V%AND&FFFF,by%,1,0,1,1):=0

1890 :

1900 REM b052dd - INC

1910 DEFFN_052:PROCpre(dd%,by%):V%=(FNdst(dd%,by%)+1)AND&FFFF:PROCdst(dd%,V%,by%)

1920 IF by%:PROCpsw(V%AND&FF,by%,1,(V%AND&FF)=&80,0,0):=0 ELSE PROCpsw(V%,by%,1,V%=&8000,0,0):=0

1930 :

1940 REM b053dd - DEC

1950 DEFFN_053:PROCpre(dd%,by%):V%=(FNdst(dd%,by%)-1)AND&FFFF:PROCdst(dd%,V%,by%)

1960 IF by%:PROCpsw(V%AND&FF,by%,1,(V%AND&FF)=&7F,0,0):=0 ELSE PROCpsw(V%,by%,1,V%=&7FFF,0,0):=0

1970 :

1980 REM b054dd - NEG:

1990 DEFFN_054:PROCpre(dd%,by%):V%=(NOTFNdst(dd%,by%)+1)AND&FFFF:PROCdst(dd%,V%,by%)

2000 IF by%:PROCpsw(V%AND&FF,by%,1,V%=&80,1,V%=0):=0 ELSE PROCpsw(V%,by%,1,V%=&8000,1,V%=0):=0

2010 :

2020 REM b055dd - ADC:

2030 DEFFN_055:PROCpre(dd%,by%):V%=FNdst(dd%,by%):W%=psw%AND1:PROCdst(dd%,V%+W%,by%)

2040 IF by%:PROCpsw((V%+W%)AND&FF,by%,1,V%=&7F AND W%,1,V%=&FF AND W%):=0

2050 PROCpsw((V%+W%)AND&FFFF,by%,1,V%=&7FFF AND W%,1,V%=&FFFF AND W%):=0

2060 :

2070 REM b056dd - SBC:

2080 DEFFN_056:PROCpre(dd%,by%):V%=FNdst(dd%,by%):W%=psw%AND1:PROCdst(dd%,V%-W%,by%)

2090 IF by%:PROCpsw((V%-W%)AND&FF,by%,1,(V%-W%)=&80 AND W%,1,V%=0 AND W%):=0

2100 PROCpsw((V%-W%)AND&FFFF,by%,1,(V%-W%)=&8000 AND W%,1,V%=0 AND W%):=0

2110 :

2120 REM b057dd - TST:

2130 DEFFN_057:V%=FNsrc(dd%,by%):PROCpsw(V%,by%,1,0,1,0):=0

2140 :

2150 REM b060dd - ROR:

2160 DEFFN_060:PROCpre(dd%,by%):V%=FNdst(dd%,by%):W%=psw%AND1

2170 IF by%=1:R%=((V%>>1)OR(W%<<7))AND&FF:PROCpsw(R%,by%,1,(R%>&7F)EOR((V%AND1)<>0),1,V%AND1)

2180 IF by%=0:R%=(V%>>1)OR(W%<<15):PROCpsw(R%,by%,1,(R%>&7FFF)EOR((V%AND1)<>0),1,V%AND1)

2190 PROCdst(dd%,R%,by%):=0

2200 :

2210 REM b061dd - ROL:

2220 DEFFN_061:PROCpre(dd%,by%):V%=FNdst(dd%,by%):W%=psw%AND1

2230 IF by%=1:R%=((V%<<1)ORW%)AND&FF:PROCpsw(R%,by%,1,(R%>&7F)EOR((V%AND&80)<>0),1,V%AND&80)

2240 IF by%=0:R%=((V%<<1)ORW%)AND&FFFF:PROCpsw(R%,by%,1,(R%>&7FFF)EOR((V%AND&8000)<>0),1,V%AND&8000)

2250 PROCdst(dd%,R%,by%):=0

2260 :

2270 REM b062dd - ASR:

2280 DEFFN_062:PROCpre(dd%,by%):V%=FNdst(dd%,by%)

2290 IF by%=1:R%=((V%>>1)OR(V%AND&80))AND&FF:PROCpsw(R%,by%,1,(R%>&7F)EOR((V%AND1)<>0),1,V%AND1)

2300 IF by%=0:R%=(V%>>1)OR(V%AND&8000):PROCpsw(R%,by%,1,(R%>&7FFF)EOR((V%AND1)<>0),1,V%AND1)

2310 PROCdst(dd%,R%,by%):=0

2320 :

2330 REM b063dd - ASL:

2340 DEFFN_063:PROCpre(dd%,by%):V%=FNdst(dd%,by%)

2350 IF by%=1:R%=(V%<<1)AND&FE:PROCpsw(R%,by%,1,(R%>&7F)EOR((V%AND&80)<>0),1,V%AND&80)

2360 IF by%=0:R%=(V%<<1)AND&FFFE:PROCpsw(R%,by%,1,(R%>&7FFF)EOR((V%AND&8000)<>0),1,V%AND&8000)

2370 PROCdst(dd%,R%,by%):=0

2380 :

2390 REM b064dd - MARK/MTPS:

2400 DEFFN_064:IFby%:psw%=FNsrc(dd%,0):=0 :REM MTPS

2410 PRINT"#"FNo0(r%(7)-2,6)":"FNo0(mem%!(r%(7)-2),6)"#";:=0:REM MARK

2420 :

2430 DEFFN_065:PRINT"#"FNo0(r%(7)-2,6)":"FNo0(mem%!(r%(7)-2),6)"#";:=0:REM MFPI/MFPD

2440 DEFFN_066:PRINT"#"FNo0(r%(7)-2,6)":"FNo0(mem%!(r%(7)-2),6)"#";:=0:REM MTPI/MTPD

2450 :

2460 REM b067dd - SXT/MFPS:

2470 DEFFN_067:IFby%:PROCpre(dd%,0):PROCdst(dd%,psw%,0):=0 :REM MFPS

2480 PROCpre(dd%,0):V%=((psw%AND8)<>0)AND&FFFF:PROCdst(dd%,V%,0):PROCpsw(V%,0,1,0,0,0):=0:REM SXT

2490 :

2500 REM 070rdd - MUL:

2510 DEFFN_70:r%=ss%AND7:V%=FNsxt(FNsrc(dd%,0)):W%=FNsxt(r%(r%))

2520 r=V%*W%:W%=r:r%(r%)=W%>>>16:r%(r%OR1)=W%AND&FFFF:PROCpsw(W%,0,1,0,1,W%>>>16)

2530 psw%=(psw%AND&FFF7)OR((W%<0)AND8):=0

2540 :

2550 REM 071rdd - DIV:

2560 DEFFN_71:r%=ss%AND7:V%=FNsrc(dd%,0):IF r%AND1:psw%=(psw%AND&FFFD)OR2:=0

2570 !zp%=r%(r%OR1):zp%!2=r%(r%):IF V%<>0:W%=!zp%DIVV%:R%=!zp%MODV%:r%(r%OR1)=R%:r%(r%)=W%

2580 PROCpsw(W%,0,1,V%=0 OR ABS(r%(r%))>ABS(V%),1,V%=0):=0

2590 :

2600 REM 072rdd - ASH:

2610 DEFFN_72:r%=ss%AND7:V%=FNsrc(dd%,0)AND63:W%=r%(r%)

2620 IF V%<32:R%=W%<<V%:PROCpsw(R%AND&FFFF,0,1,(R%EORW%)AND&8000,1,R%AND&10000)

2630 IF V%>31:R%=(W%<<16)>>(79-V%):PROCpsw(R%>>1,0,1,((R%>>1)EORW%)AND&8000,1,R%AND1):R%=R%>>1

2640 r%(r%)=R%AND&FFFF:=0

2650 :

2660 REM 073rdd - ASHC:

2670 DEFFN_73:r%=ss%AND7:V%=FNsrc(dd%,0)AND63:R%=(r%(r%)<<16)ORr%(r%OR1):W%=R%

2680 IF V%<32:C%=R%AND(1<<(32-V%)):R%=R%<<V%

2690 IF V%>31:IF(r%AND1)=0:C%=R%AND(1<<(63-V%)):R%=R%>>(64-V%)

2700 IF V%>31:IF(r%AND1)=1:R%=R%AND&FFFF:R%=R%OR(R%<<16):R%=(R%>>>(64-V%))AND&FFFF:C%=0

2710 PROCpsw(R%,0,1,(V%EORW%)AND&80000000,1,C%):psw%=(psw%AND&FFF7)OR((R%<0)AND8)

2720 r%(r%OR1)=R%>>>16:r%(r%)=R%AND&FFFF:=0

2730 :

2740 REM 074rdd - XOR:

2750 DEFFN_74:PROCpre(dd%,0):V%=FNdst(dd%,0):R%=V%EORr%(ss%AND7)

2760 PROCdst(dd%,R%,0):PROCpsw(R%,0,1,0,0,0):=0

2770 :

2780 REM 075rdd - FADD/FSUB/FMUL/FDIV

2790 DEFFN_75:PRINT"#"FNo0(r%(7)-2,6)":"FNo0(mem%!(r%(7)-2),6)"#";:=0

2800 :

2810 REM 076nnn - unused

2820 DEFFN_76:=0

2830 :

2840 REM 077rdd - SOB:

2850 DEFFN_77:dist%=dd%-192*(dd%>31):ss%=ss%AND7:V%=(r%(ss%)-1)AND&FFFF:r%(ss%)=V%:=FNrel(V%<>0)

2860 :

10 REM > EMT

20 REM EMT interface to host

30 REM v0.22 27-Sep-2009 OSBYTE 160 translated to host calls

40 REM v0.25 10-Jan-2014 Added OSWORD 190

50 REM v0.28 25-Oct-2015 Added more OSBYTE 160 translations, OSBYTE 135 returns shadow MODEs

60 REM v0.29a 10-May-2020 OSWORD optimised with X%!...

70 REM v0.30 11-Mar-2021 Windows OSFILE 5

80 REM v0.31 01-Nov-2023 Tweeks for SDL/Android

90 REM NB: Keyboard tested for with: kbd%=(os%<8):IF(INKEY-256AND&DB)=&53:kbd%=1

100 :

110 DEFFN_TRAP:dd%=dd%+(ss%AND7)*64:IF(debug%AND4):PROCDbTrap(dd%):REM &0xx=EMT, &1xx=TRAP

120 IFtrapvec%:IFdd%>255:r%(6)=r%(6)-4:mem%!r%(6)=psw%:mem%?(r%(6)+2)=r%(7):mem%?(r%(6)+3)=r%(7)DIV256:psw%=mem%!&1E AND &FFFF:r%(7)=mem%!&1C AND &FFFF:r7%=0:=0

130 IFdd%<16:psw%=psw%AND-4:A%=r%(0):=EVAL("FN_EMT"+STR$~dd%)

140 IFdd%<224:=EVAL("FN_EMT("+STR$dd%+")")

150 IFdd%<256:A%=r%(0):=EVAL("FN_EMT"+STR$~dd%)

160 dd%=dd%AND&FF:r7%=r%(7):IFdd%<&40:psw%=psw%AND-4:A%=EVAL("FN_TRAP"+STR$~dd%) ELSE A%=EVAL("FN_TRAP("+STR$dd%+")")

170 r%(7)=r7%:r7%=0:=A%

180 :

190 DEFPROCDbTrap(dd%):IF(dd%>3 AND dd%<7) OR (dd%>&102 AND dd%<&105 AND r%(0)<3):ENDPROC

200 IFdd%<16:PRINT"OS";MID$("QUITCLI BYTEWORDWRCHNEWLRDCHFILEARGSBGETBPUTGBPBFINDSYSTCTRLERR ",dd%*4+1,4);" r0=";~r%(0);" r1=";~r%(1);" r2=";~r%(2):ENDPROC:REM ;" ";:E.

210 IFdd%<256:ENDPROC:PRINT"EMT ";~dd%;" r0=";~r%(0):ENDPROC:REM EMT &10-&FF

220 A%=r%(7):IFdd%=&100:A%=mem%!r%(7)AND&FFFF:dd%=mem%?A%:A%=A%+2

230 IF(dd%AND&20)=&00:PRINT MID$("indir exit fork read write open close wait creat link unlinkexec chdir time mknod chmod chown brk stat lseek getpidmount umountsetuidgetuidstime ptrace[27] fstat pause utime stty ",(dd%AND31)*6+1,6);

240 IF(dd%AND&20)=&20:PRINT MID$("gtty [33] nice ftime sync kill switch[39] [40] dup2 pipe times profiltui setgidgetgidsignal[49] [50] acct phys lock ioctl [55] mpxchn[57] [58] exece umask chroot[62] [63] ",(dd%AND31)*6+1,6);

250 PRINT" r0=";FNh0(r%(0),4);" p1=";FNh0(mem%!A%,4);" p2=";FNh0(mem%!(A%+2),4);" p3=";FNh0(mem%!(A%+4),4)

260 ENDPROC

270 :

280 DEFFN_EMT0:halt%=TRUE:=0 :REM QUIT

290 DEFFN_EMT1:PROCEscOn:PROCcmd($(mem%+r%(0)),TRUE):r%(0)=0:PROCEscOff:=0 :REM OSCLI

300 DEFFN_EMT2:LOCAL X%,Y%:psw%=psw%AND-2 :REM OSBYTE

310 IF A%=&82:r%(1)=0:r%(2)=0:=0 :REM high order address

320 IF A%=&83:r%(1)=membot%:r%(2)=membot%DIV256:=0 :REM bottom of memory

330 IF A%=&84:r%(1)=memtop%:r%(2)=memtop%DIV256:=0 :REM top of memory

340 IF A%>123:IFA%<127:mem%?escflg%=128*(A%AND1):OSCLI"FX15" :REM Clear/Set/Ack Escape

350 IF A%=&7F:IFr%(1)=0 OR r%(1)=&FFFF:r%(1)=0:=0 :REM =EOF#0/-1:REM Should check keyboard

360 IF A%=&A0:IFos%=6:IFFNvdu:=0 :REM =VDU(n)

370 IF A%=&00:IFr%(1)=0:ERROR 247,"PDPTube "+ver$:=0

380 IF A%=&00:IF(INKEY-256AND&DF)=83:IF(@platform%AND15):r%(1)=8:=0

390 IF os%<32:X%=r%(1):Y%=r%(2):A%=USR&FFF4:r%(1)=(A%AND&FFFF00)DIV256:r%(2)=(A%AND&FF0000)DIV65536:PROCcarry(A%AND&1000000):IF(A%AND&FF)<>&87:=0

400 IF os%<32:X%=0:A%=&75:r%(2)=r%(2)OR(((USR&FFF4)AND&1000)DIV32):=0:REM OSBYTE &87 adjustment

410 REM Windows OSBYTE calls:

420 IF A%=128:IFr%(1)=7:MOUSE r%(1),A%,A%:r%(2)=A%DIV256:=0

430 IF A%=128:IFr%(1)=8:MOUSE A%,r%(1),A%:r%(2)=A%DIV256:=0

440 IF A%=128:IFr%(1)=9:MOUSE A%,A%,r%(1):r%(2)=A%DIV256:=0

450 CASE A% OF

460 WHEN 0:r%(1)=os%:=0

470 WHEN 127:r%(1)=EOF#r%(1):=0

480 REM If on Windows, ADVAL-1/-2 need to be 255-ADVAL - but client should do this as OSBYTE 0,1 returns DOS/Win

490 WHEN 128:A%=ADVAL((r%(1)AND255)+256*r%(2)OR((r%(2)>&7F)AND&FFFF0000)):r%(1)=A%:r%(2)=A%DIV256:=0

500 WHEN 129:A%=INKEY((r%(1)AND255)+256*r%(2)OR((r%(2)>&7F)AND&FFFF0000)):PROCcarry(A%=-1 AND r%(2)<&80):r%(1)=A%:r%(2)=A%DIV256:PROCcarry(A%=-1):=0

510 WHEN 134:r%(1)=POS:r%(2)=VPOS:=0

520 WHEN 135:r%(1)=GET(POS,VPOS):r%(2)=MODE:=0

530 WHEN 160:

540 CASE r%(1) OF

550 WHEN 0,128:SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=zp%!0

560 WHEN 1 :SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=zp%!1

570 WHEN 2,129:SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=zp%!4

580 WHEN 3 :SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=zp%!5

590 WHEN 4,130:SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=zp%!8-1

600 WHEN 5 :SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=(zp%!8-1)DIV256

610 WHEN 6,131:SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=zp%!12/2-1

620 WHEN 7 :SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=(zp%!12/2-1)DIV256

630 WHEN 8,132:r%(1)=@vdu%!24 DIV @vdu%!216

640 WHEN 9,133:r%(1)=@vdu%!36 DIV @vdu%!220-1

650 WHEN 10,134:r%(1)=@vdu%!28 DIV @vdu%!216-1

660 WHEN 11,135:r%(1)=@vdu%!32 DIV @vdu%!220

670 WHEN 12,136:r%(1)=2*@vdu%!0

680 WHEN 13 :r%(1)=2*@vdu%!0 DIV 256

690 WHEN 14,137:r%(1)=2*@vdu%!4

700 WHEN 15 :r%(1)=2*@vdu%!4 DIV 256

710 WHEN 16,138:r%(1)=2*@vdu%!8

720 WHEN 17 :r%(1)=2*@vdu%!8 DIV 256

730 WHEN 18,139:SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=2*(zp%!12-@vdu%!12-1)

740 WHEN 19 :SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=2*(zp%!12-@vdu%!12-1) DIV 256

750 WHEN 20,142:r%(1)=@vdu%!16

760 WHEN 21 :r%(1)=@vdu%!16 DIV 256

770 WHEN 22,143:SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=(zp%!12-@vdu%!20-1)

780 WHEN 23 :SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=(zp%!12-@vdu%!20-1) DIV 256

790 WHEN 24 :r%(1)=POS

800 WHEN 25 :r%(1)=VPOS

810 WHEN 36 :r%(1)=@vdu%!8

820 WHEN 37 :r%(1)=@vdu%!8 DIV 256

830 WHEN 38 :SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=(zp%!12-@vdu%!12-1)

840 WHEN 39 :SYS "GetRgnBox",@vdu%!60,zp%:r%(1)=(zp%!12-@vdu%!12-1) DIV 256

850 WHEN 85 :r%(1)=MODE

860 WHEN 87,155:r%(1)=8*@vdu%?70

870 WHEN 88,156:r%(1)=8*@vdu%?71

880 WHEN 89,153:r%(1)=8*@vdu%?65

890 WHEN 90,154:r%(1)=8*@vdu%?67

900 WHEN 91,151:r%(1)=3-(@vdu%?64-7)DIV2:IFr%(1)<0:r%(1)=1

910 WHEN 92,152:r%(1)=3-(@vdu%?66-7)DIV2:IFr%(1)<0:r%(1)=1

920 WHEN 96,3 :r%(1)=@vdu%?73

930 WHEN 98 :REM Left colour mask

940 WHEN 99 :REM Right colour mask

950 WHEN 109 :r%(1)=@vdu%?65

960 WHEN 110 :r%(1)=@vdu%?67

970 WHEN 155 :r%(1)=@vdu%?70

980 WHEN 156 :r%(1)=@vdu%?71

990 WHEN 153 :r%(1)=@vdu%?65

1000 WHEN 154 :r%(1)=@vdu%?67

1010 OTHERWISE

1020 r%(1)=0

1030 ENDCASE

1040 r%(2)=r%(1)DIV256:=0

1050 OTHERWISE

1060 X%=r%(1):Y%=r%(2):A%=USR&FFF4:r%(1)=(A%AND&FFFF00)DIV256:r%(2)=(A%AND&FF0000)DIV65536:PROCcarry(A%AND&1000000)

1070 ENDCASE

1080 =0

1090 DEFFNvdu:IF r%(1)<16:=0

1100 REM ARM and R1>15

1110 CASE r%(1) OF

1120 WHEN 16,17:A%=138

1130 WHEN 18,19:A%=139

1140 WHEN 20,21:A%=142

1150 WHEN 22,23:A%=143

1160 WHEN 24 :r%(1)=POS:=TRUE

1170 WHEN 25 :r%(1)=VPOS:=TRUE

1180 WHEN 36,37:A%=144

1190 WHEN 38,39:A%=145

1200 WHEN 78 :A%=148

1210 WHEN 80,81:A%=149

1220 WHEN 84 :A%=150:r%(1)=85

1230 WHEN 87 :A%=155:r%(1)=-1

1240 WHEN 88 :A%=156:r%(1)=-1

1250 WHEN 89 :A%=153:r%(1)=-1

1260 WHEN 90 :A%=154:r%(1)=-1

1270 WHEN 91 :A%=151:r%(1)=0

1280 WHEN 92 :A%=152:r%(1)=0

1290 WHEN 96 :A%=3

1300 WHEN 109 :A%=153:r%(1)=0

1310 WHEN 110 :A%=154:r%(1)=0

1320 OTHERWISE

1330 A%=r%(1):IF A%<128:r%(1)=0:r%(1)=0:=TRUE

1340 ENDCASE

1350 !zp%=A%:zp%!4=-1:SYS "OS_ReadVduVariables",zp%,zp%+8:IF r%(1)=-1:zp%!8=zp%!8*8 ELSE IF r%(1)AND1:zp%!8=zp%!8 DIV 256

1360 r%(1)=zp%!8:r%(2)=r%(1)DIV256

1370 =TRUE

1380 :

1390 DEFFN_EMT3:LOCAL X%,Y% :REM OSWORD

1400 X%=mem%+r%(1):Y%=X%DIV256

1410 IF A%=0:PROCEscOn:INPUT LINE""A$:$(mem%+(!X%AND&FFFF))=A$:PROCEscOff:=0

1420 IF A%=190:IF X%?2=11:IF ?X%>8:A%=FNDis_Code(11,X%!4,X%!8):=0

1430 IF A%=190:IF X%?2=11:IF ?X%<9:$(X%+4)=FNDis_Name(11):=0

1440 IF PAGE<&FFFF OR A%=10:CALL &FFF1:=0

1450 CASE A% OF

1460 WHEN 1:!X%=TIME:=0

1470 WHEN 2:TIME=!X%:=0

1480 WHEN 7:SOUND X%!0,X%!2,X%!4,X%!6:=0

1490 WHEN 8:ENVELOPE X%?0,X%?1,X%?2,X%?3,X%?4,X%?5,X%?6,X%?7,X%?8,X%?9,X%?10,X%?11,X%?12,X%?13:=0

1500 WHEN 9:X%?4=POINT(!X% AND &FFFF,X%!2 AND &FFFF):=0

1510 WHEN 14:IF?X%=0:$X%=TIME$:=0

1520 WHEN 15:X%?(?X%+1)=13:TIME$=$(X%+1):=0

1530 ENDCASE

1540 =0

1550 DEFFN_EMT4:VDU A%:=0 :REM OSWRCH

1560 DEFFN_EMT5:PRINT:r%(0)=13:=0 :REM OSNEWL

1570 DEFFN_EMT6:r%(0)=GET:PROCcarry(r%(0)=27):=0:REM OSRDCH

1580 DEFFN_EMT7 :REM OSFILE

1590 FOR A%=2 TO 14 STEP 4:X%!A%=mem%!(r%(1)+A%):NEXT

1600 IF r%(0)=255:PROCaddr(2)

1610 IF r%(0)=0 :PROCaddr(10):PROCaddr(14)

1620 fn%=mem%+(mem%!r%(1)AND&FFFF):A$="":IF PAGE>&FFFFF:A$=FNs($fn%)

1630 IF ASCA$=34:A$=MID$(A$,2,INSTR(A$,"""",2)-1) ELSE A$=LEFT$(A$,INSTR(A$+" "," ")-1)

1640 IF INKEY-256=87 AND r%(0)=5 THEN

1650 LOCALdir%,sh%:DIMdir%LOCAL319

1660 SYS"FindFirstFile",FNf_name(A$),dir%TOsh%:IFsh%=-1:r%(0)=0:=0

1670 SYS"FindClose",sh%:X%!10=dir%!32:IFdir%!28:X%!10=-1

1680 X%?14=(?dir%AND1)*8+(&33 AND ((?dir%AND16)=0)):r%(0)=(?dir%AND16)DIV16+1

1690 SYS"FileTimeToSystemTime",dir%+20,dir%

1700 A%=(!dir%AND&FFFF)-1981:X%?15=dir%?6+(A%AND&70)*2:X%?16=dir%?2+A%*16:X%?17=0

1710 FOR A%=2 TO 14 STEP 4:mem%!(r%(1)+A%)=X%!A%:NEXT:=0

1720 ENDIF

1730 IF PAGE<&FFFFF:SYS "OS_File",r%(0),$fn%,X%!2,X%!6,X%!10,X%!14 TO r%(0),,X%!2,X%!6,X%!10,X%!14 ELSE r%(0)=FNfile(cd$+A$,r%(0))

1740 REM IF r%(0)=0 OR r%(0)=255:PROCaddr(2):IF r%(0)=0:PROCaddr(6)

1750 FOR A%=2 TO 14 STEP 4:mem%!(r%(1)+A%)=X%!A%:NEXT:=0

1760 DEFPROCaddr(A%):IFX%!A%<&10000:X%!A%=mem%+A%!X%

1770 ENDPROC

1780 DEFFN_EMT8 :REM OSARGS

1790 IF os%>31:IF A%=0:IF r%(1)=0:r%(0)=fsnum%:=0

1800 IF A%=0:IF r%(1)=0:LOCAL Y%:r%(0)=(USR&FFDA)AND&FF:=0

1810 IF r%(1)=0 OR r%(1)=&FFFF THEN

1820 CASE A% OF

1830 REM Add EXT#-1=keyboard buffer, EOF#-1=keyboard buffer

1840 WHEN 0:mem%!r%(2)=0:=0 :REM =PTR#0/-1

1850 WHEN 1:=0 :REM PTR#0/-1=

1860 WHEN 2:mem%!r%(2)=0:=0 :REM =EXT#0/-1

1870 WHEN 3:=0 :REM EXT#0/-1=

1880 WHEN 4:mem%!r%(2)=0:=0 :REM =Alloc#0/-1

1890 WHEN 5:mem%!r%(2)=0:=0 :REM =EOF#0/-1

1900 WHEN 6:=0 :REM Alloc#0/-1=

1910 ENDCASE

1920 ENDIF

1930 CASE A% OF

1940 WHEN 0:mem%!r%(2)=PTR#r%(1):=0

1950 WHEN 1:PTR#r%(1)=mem%!r%(2):=0

1960 WHEN 2:mem%!r%(2)=EXT#r%(1):=0

1970 WHEN 3:EXT#r%(1)=mem%!r%(2):=0

1980 WHEN 4:mem%!r%(2)=EXT#r%(1):=0

1990 WHEN 5:mem%!r%(2)=EOF#r%(1):=0

2000 WHEN 6:EXT#r%(1)=mem%!r%(2):=0

2010 WHEN 255:IFos%>31:=0

2020 OTHERWISE

2030 mem%!r%(1)=FNargs(r%(0),r%(1),mem%!r%(2)):=0

2040 ENDCASE

2050 =0

2060 DEFFN_EMT9:IF r%(1)=0:r%(0)=GET:=0 :REM OSBGET

2070 IFos%=32:r%(0)=BGET#r%(1):PROCcarry(EOF#r%(1)AND&100):=0

2080 LOCAL Y%:Y%=r%(1):A%=USR&FFD7:r%(0)=A%AND&FF:PROCcarry(A%AND&1000000):=0

2090 DEFFN_EMTA:IFr%(1)=0:VDU A%:=0 ELSE BPUT#r%(1),A%:=0 :REM OSBPUT

2100 DEFFN_EMTB :REM OSGBPB

2110 FOR A%=0 TO 12:X%?A%=mem%?(r%(1)+A%):NEXT

2120 B%=(X%!1<&10000):PROCaddr(1):A%=r%(0)

2130 IF ?X%=0:IFA%=1ORA%=2:REPEATVDU?(X%!1):X%!5=X%!5-1:UNTILX%!5<1

2140 IF ?X%=0:IFA%=3ORA%=4:REPEAT?(X%!1)=GET:X%!5=X%!5-1:UNTILX%!5<1

2150 IF ?X%:PROCf_gbpb(r%(0),X%?0,X%!1,X%!5,X%!9)

2160 IF B%:X%!1=X%!1-mem%

2170 FOR A%=0 TO 12:mem%?(r%(1)+A%)=X%?A%:NEXT

2180 =0

2190 DEFFN_EMTC :REM OSFIND

2200 IF A%=0:CLOSE#r%(1):=0

2210 IF (A%AND&C0)=&40:r%(0)=FNf_openin(cd$+$(mem%+r%(1))):=0

2220 IF (A%AND&C0)=&80:r%(0)=FNf_openout(cd$+$(mem%+r%(1))):=0

2230 IF (A%AND&C0)=&C0:r%(0)=FNf_openup(cd$+$(mem%+r%(1))):=0

2240 =0

2250 DEFFN_EMTD :REM SYS

2260 IFA%=0:IFr%(1):=FN_BASIC($(mem%+r%(1))):=0

2270 IFA%=0:IFr%(1)=0:=FN_BASIC(""):=0

2280 IFA%=1:IFmemtop%<&F800:mem%!&F5FC=mem%!&F5FA AND &FFFF

2290 IFA%<5:err%=err0%:escflg%=err%+255:!escb%=mem%+escflg%:=0

2300 IFA%=&FFFF:trapvec%=NOTr%(1):=0

2310 =0

2320 DEFFN_EMTE:r1%=r%(1):r2%=r%(2) :REM HANDLER

2330 IF A%=&FFFE:r%(2)=escflg%:IFr2%:escflg%=r2%:!escb%=mem%+escflg% :REM Escape handler

2340 IF A%=&FFFD:r%(1)=errvec%:IFr1%:errvec%=r1% :REM Error handler

2350 IF A%=&FFFD:r%(2)=err% :IFr2%:err%=r2% :REM Error handler

2360 =0

2370 DEFFN_EMTF:=0 :REM ERROR

2380 DEFFN_EMT(A%):=0

2390 :

10 REM > Unix

20 REM PDP11 Unix Trap functions

30 REM v0.15 04-Mar-2006 Separated out from PDP11Em

40 REM 17-Mar-2006 read/write done, added exit,open,close

50 REM v0.16 20-May-2006 Added indir

60 REM v0.17 20-Feb-2009 Added rudimentary SIGINT capture

70 REM v0.23 17-Jun-2010 TRAP0 calls TRAPn instead of TRAPnn

80 REM v0.24 02-Jul-2010 TRAPB and TRAP3B execute commands

90 REM v0.25 20-Jan-2012 brk(), pipe() fetch correct parameters

100 REM v0.26 20-Jun-2012 Added ftime()

110 REM Note, different parameters for v7/pre-v7 for lseek(), ioctrl()

120 REM By ioctrl() returning CarryClear (via dispatcher), declares to be Unix V7

125 REM v0.31 01-Nov-2023 Tweeks for SDL/Android

130 :

140 DEFFN_TRAP0:REM indir - entry: (pc+0)=>TRAP instruction, parameters

150 r7%=mem%!r%(7)AND&FFFF :REM Address of ind'ed TRAP instruction

160 dd%=mem%!r7%AND255:r7%=r7%+2:ind%=r%(7)+2 :REM Get TRAP instruction

170 IF dd%<&40:A%=EVAL("FN_TRAP"+STR$~dd%) ELSE A%=EVAL("FN_TRAP("+STR$dd%+")")

180 r7%=r%(7)+2:ind%=0:=A%

190 :

200 DEFFN_TRAP1:REM exit - entry: r0=status

210 halt%=TRUE

220 =0

230 :

240 DEFFN_TRAP2:REM fork -

250 =0 :REM - exit: r0=new process ID

260 :

270 DEFFN_TRAP3:REM read - entry: r0=filedes, (pc+0)=buffer, (pc+2)=count

280 REM exit: r0=byte count

290 buffer%=mem%!r7%AND&FFFF:count%=mem%!(r7%+2)AND&FFFF:r7%=r7%+4

300 IFr%(0)<3:OSCLI"FX126":FORA%=0TOcount%-1:mem%?(buffer%+A%)=GET:NEXT:r%(0)=count%:=0

310 PROCgbpb(4,r%(0),mem%+buffer%,count%,0):r%(0)=count%-X%!5

320 =0

330 :

340 DEFFN_TRAP4:REM write - entry: r0=filedes, (pc+0)=buffer, (pc+2)=count

350 REM exit: r0=byte count

360 buffer%=mem%!r7%AND&FFFF:count%=mem%!(r7%+2)AND&FFFF:r7%=r7%+4

370 IFr%(0)<3:FORA%=0TOcount%-1:VDUmem%?(buffer%+A%):NEXT:r%(0)=count%:=0

380 PROCgbpb(2,r%(0),mem%+buffer%,count%,0):r%(0)=count%-X%!5

390 =0

400 :

410 DEFFN_TRAP5:REM open - entry: (pc+0)=>name, (pc+2)=mode

420 REM exit: r0=filedes

430 name%=mem%!r7%AND&FFFF:mode%=mem%!(r7%+2)AND&FFFF:r7%=r7%+4:r%(0)=0

440 IFmode%=0:r%(0)=FNf_openin(cd$+FNstr0(mem%+name%))

450 IFmode%=1:r%(0)=FNf_openout(cd$+FNstr0(mem%+name%))

460 IFmode%=2:r%(0)=FNf_openup(cd$+FNstr0(mem%+name%))

470 IFr%(0)=0:r%(0)=&FFFF:psw%=psw%OR1

480 =0

490 :

500 DEFFN_TRAP6:REM close - entry: r0=filedes

510 IFr%(0)>2:CLOSE#r%(0)

520 =0

530 :

540 DEFFN_TRAP7:REM wait -

550 =0 REM exit: r0=process ID, r1=status

560 :

570 DEFFN_TRAP8:REM creat - entry: (pc+0)=>name, (pc+2)=mode

580 REM exit: r0=filedes

590 name%=mem%!r7%AND&FFFF:mode%=mem%!(r7%+2)AND&FFFF:r7%=r7%+4

600 r%(0)=FNf_openout(cd$+FNstr0(mem%+name%)):IFr%(0)=0:r%(0)=&FFFF

610 =0

620 :

630 DEFFN_TRAP9:REM link - entry: (pc+0)=>name1, (pc+2)=>name2

640 r7%=r7%+4:r%(0)=&FFFF:=0

650 :

660 DEFFN_TRAPA:REM unlink - entry: (pc+0)=>name

670 name%=mem%!r7%AND&FFFF:r7%=r7%+2:r%(0)=0

680 A%=FNfile(7,cd$+FNf_name(FNstr0(mem%+name%))):IFA%=0:r%(0)=&FFFF

690 =0

700 :

710 DEFFN_TRAPB:REM exec - entry: (pc+0)=>name, (pc+2)=>argv

720 name%=mem%!r7%AND&FFFF:mode%=mem%!(r7%+2)AND&FFFF:r7%=r7%+4

730 IFFNstr0(mem%+(mem%!mode%AND&FFFF))="sh":PROCcmd(FNstr0(mem%+(mem%!(mode%+4)AND&FFFF)),TRUE):r%(0)=0:=0

740 =0

750 :

760 DEFFN_TRAPC:REM chdir - entry: (pc+0)=>dirname

770 name%=mem%!r7%AND&FFFF:r7%=r7%+2:r%(0)=0

780 IFos%<7:OSCLI"DIR "+FNstr0(mem%+name%) ELSE OSCLI"chdir "+cd$+FNstr0(mem%+name%)

790 =0

800 :

810 DEFFN_TRAPD:REM time -

820 REM exit: r0:r1=time since 1970 in seconds

830 !zp%=TIME DIV100:r%(1)=!zp%AND&FFFF:r%(0)=zp%!2AND&FFFF

840 =0

850 :

860 DEFFN_TRAPE:REM mknod - entry: (pc+0)=>name, (pc+2)=mode, (pc+4)=addr

870 name%=mem%!r7%AND&FFFF:mode%=mem%!(r7%+2)AND&FFFF:r7%=r7%+6

880 IF(mode%AND16384):A%=FNfile(8,cd$+FNf_name(FNstr0(mem%+name%)))

890 =0

900 :

910 DEFFN_TRAPF :r7%=r7%+4:=0:REM chmod - entry: (pc+0)=>name, (pc+2)=mode

920 DEFFN_TRAP10:r7%=r7%+6:=0:REM chown - entry: (pc+0)=>name, (pc+2)=owner, (pc+4)=group

930 :

940 DEFFN_TRAP11:REM brk - entry: (pc+0)=addr

950 addr%=mem%!r7%AND&FFFF:r7%=r7%+2:IFaddr%>memtop%:psw%=psw%OR1

960 =0

970 :

980 DEFFN_TRAP12:REM stat - entry: (pc+0)=>name, (pc+2)=>buf

990 name%=mem%!r7%AND&FFFF:buffer%=mem%!(r7%+2)AND&FFFF:r7%=r7%+4:r%(0)=0

1000 A%=FNfile(5,cd$+FNf_name(FNstr0(mem%+name%))):IFA%=0:r%(0)=&FFFF

1010 mem%!(buffer%+14)=X%!10

1020 =0

1030 :

1040 DEFFN_TRAP13:REM lseek - entry: r0=filedes, (pc+0)=>offsethi, (pc+2)=>offsetlo, (pc+4)=whence

1050 offset%=(mem%!(r7%+2)AND&FFFF)OR(mem%!(r7%-2)AND&FFFF0000):where%=mem%!(r7%+4)AND&FFFF:r7%=r7%+6

1060 IFr%(0)<3:r%(0)=0:r%(1)=0:=0

1070 IFwhere%=0:PTR#r%(0)=offset%

1080 IFwhere%=1:PTR#r%(0)=PTR#r%(0)+offset%

1090 IFwhere%=2:PTR#r%(0)=EXT#r%(0)+offset%

1100 r%(1)=PTR#r%(0):r%(0)=r%(1)DIV65536:r%(1)=r%(1)AND&FFFF

1110 =0

1120 :

1130 DEFFN_TRAP14:r7%=r7%+0:=0:REM getpid - exit: r0=process ID

1140 DEFFN_TRAP15:r7%=r7%+6:=0:REM mount - entry: (pc+0)=>special, (pc+2)=>name, (pc+4)=rwflag

1150 DEFFN_TRAP16:r7%=r7%+2:=0:REM umount - entry: (pc+0)=>special

1160 DEFFN_TRAP17:r7%=r7%+0:=0:REM setuid - entry: r0=uid

1170 DEFFN_TRAP18:r7%=r7%+0:=0:REM getuid - exit: r0=real uid, r1=effective uid

1180 DEFFN_TRAP19:r7%=r7%+0:=0:REM stime - entry: r0:r1=time since 1970

1190 DEFFN_TRAP1A:r7%=r7%+6:=0:REM ptrace - entry: r0=data, (pc+0)=pid, (pc+2)=addr, (pc+4)=request

1200 REM exit: r0=value

1210 DEFFN_TRAP1B:r7%=r7%+0:=0:REM [27]

1220 DEFFN_TRAP1C:r7%=r7%+2:=0:REM fstat - entry: r0=filedes, (pc+0)=>buff

1230 DEFFN_TRAP1D:r7%=r7%+0:=0:REM pause

1240 DEFFN_TRAP1E:r7%=r7%+4:=0:REM utime - entry: (pc+0)=>file, (pc+2)=timep

1250 DEFFN_TRAP1F:r7%=r7%+2:=0:REM stty - entry: r0=filedes, (pc+0)=argp

1260 DEFFN_TRAP20:r7%=r7%+2:=0:REM gtty - entry: r0=filedes, (pc+0)=argp

1270 DEFFN_TRAP21:r7%=r7%+0:=0:REM [33]

1280 DEFFN_TRAP22:r7%=r7%+0:=0:REM nice - entry: r0=priority

1290 :

1300 DEFFN_TRAP23:REM ftime - entry: (pc+0)=bufptr, read millisecond count

1310 addr%=mem%!r7%AND&FFFF:r7%=r7%+2

1320 !zp%=TIME:mem%!addr%=zp%!4 DIV 100 :REM seconds b16-b31

1330 mem%!(addr%+2)=!zp% DIV 100 :REM seconds b0-b15

1340 mem%!(addr%+4)=(mem%!(addr%+4)AND&FFFF0000) OR ((!zp%MOD100)*10):REM milliseconds

1350 =0

1360 :

1370 DEFFN_TRAP24:REM sync

1380 A%=&FF:=FN_EMT8

1390 :

1400 DEFFN_TRAP25:r7%=r7%+2:=0:REM kill - entry: r0=pid, (pc+0)=sig

1410 DEFFN_TRAP26:r%(0)=&FFFF:=0:REM switch - exit: r0=front panel switches

1420 DEFFN_TRAP27:r7%=r7%+0:=0:REM [39]

1430 DEFFN_TRAP28:r7%=r7%+0:=0:REM [40]

1440 DEFFN_TRAP29:r7%=r7%+0:=0:REM dup2 - entry: r0=filedes1, r1=filedes2

1450 REM exit: r0=new filedes

1460 DEFFN_TRAP2A:r7%=r7%+0:=0:REM pipe - exit: r0=read filedes, r1=write filedes

1470 DEFFN_TRAP2B:r7%=r7%+2:=0:REM times - entry: (pc+0)=buffer

1480 DEFFN_TRAP2C:r7%=r7%+8:=0:REM profil - entry: (pc+0)=buff, (pc+2)=bufsize, (pc+4)=offset, (pc+6)=scale

1490 DEFFN_TRAP2D:r7%=r7%+0:=0:REM tui - [null]

1500 DEFFN_TRAP2E:r7%=r7%+0:=0:REM setgid - entry: r0=gid

1510 DEFFN_TRAP2F:r7%=r7%+0:=0:REM getgid - exit: r0=real gid, r1=effective gid

1520 :

1530 DEFFN_TRAP30:REM signal - entry: (pc+0)=sig, (pc+2)=func

1540 REM exit: r0=old func

1550 IF(mem%!r7%AND&FFFF)=2:A%=mem%!(r7%+2)AND&FFFF:IF A%:IF mem%!(A%+4)=&FF95F7:escflg%=A%+10+mem%!(A%+8)AND&FFFF:!escb%=mem%+escflg%

1560 r7%=r7%+4:=0

1570 :

1580 DEFFN_TRAP31:r7%=r7%+0:=0:REM [49]

1590 DEFFN_TRAP32:r7%=r7%+0:=0:REM [50]

1600 DEFFN_TRAP33:r7%=r7%+2:=0:REM acct - entry: (pc+0)=file

1610 DEFFN_TRAP34:r7%=r7%+6:=0:REM phys - entry: (pc+0)=segreg, (pc+2)=size, (pc+4)=physadr

1620 DEFFN_TRAP35:r7%=r7%+2:=0:REM lock - entry: (pc+0)=flag

1630 DEFFN_TRAP36:r7%=r7%+6:=0:REM ioctl - entry: (pc+0)=filedes, (pc+2)=request, (pc+4)=argp

1640 DEFFN_TRAP37:r7%=r7%+0:=0:REM [55]

1650 DEFFN_TRAP38:r7%=r7%+8:=0:REM mpxchan- entry: (pc+0)=??, (pc+2)=??, (pc+4)=??, (pc+6)=??

1660 DEFFN_TRAP39:r7%=r7%+0:=0:REM [57]

1670 DEFFN_TRAP3A:r7%=r7%+0:=0:REM [58]

1680 :

1690 DEFFN_TRAP3B:REM exece - entry: (pc+0)=>name, (pc+2)=>argv, (pc+4)=>envp

1700 name%=mem%!r7%AND&FFFF:mode%=mem%!(r7%+2)AND&FFFF:r7%=r7%+6

1710 IFFNstr0(mem%+(mem%!mode%AND&FFFF))="sh":PROCcmd(FNstr0(mem%+(mem%!(mode%+4)AND&FFFF)),TRUE):r%(0)=0:=0

1720 =0

1730 :

1740 DEFFN_TRAP3C:r7%=r7%+2:=0:REM umask - entry: (pc+0)=complmode

1750 DEFFN_TRAP3D:r7%=r7%+2:=0:REM chroot - entry: (pc+0)=>dirname

1760 DEFFN_TRAP3E:r7%=r7%+0:=0:REM [62]

1770 DEFFN_TRAP3F:r7%=r7%+0:=0:REM [63]

1780 DEFFN_TRAP(A%):=0

1790 :

1800 DEFFNstr0(A%):A$="":REPEAT IF?A%>31:A$=A$+CHR$?A%:A%=A%+1

1810 UNTIL?A%<32 OR LEN A$>254:=A$

1820 DEFFNstr(A%):LOCAL B$,B%:REPEAT:B%=!A%AND&FFFF:IFB%:B$=B$+" "+FNstr0(mem%+B%)

1830 A%=A%+2:UNTILB%=0:=B$

1840 :

10 REM > RT11RSX

20 REM RT11 and RSX EMT function calls

30 REM v0.01 Initial version

40 :

50 DEFFN_EMTE0:r%(0)=INKEY(0):psw%=(psw%AND-2)OR(r%(0)=-1):=0 :REM &o340 CONIN R0=char, Cy=buffer empty

60 DEFFN_EMTE1:VDU A%:psw%=psw%AND-2:=0 :REM &o341 CONOUT R0=char, Cy=buffer full

70 DEFFN_EMTE2:=0:REM Get device status

80 DEFFN_EMTE3:=0:REM Load device handler

90 DEFFN_EMTE4:=0:REM Command String Interpreter general

100 DEFFN_EMTE5:=0:REM Command String Interpreter special GETLIN? Input line of text o345

110 DEFFN_EMTE6:=0:REM Lock USR in core

120 DEFFN_EMTE7:=0:REM Unlock USR in core

130 DEFFN_EMTE8:halt%=TRUE:=0:REM &o350 EXIT

140 DEFFN_EMTE9:REM &o351 PRINT Output ASCIZ string at R0

150 REPEAT:A%=mem%?r%(0):r%(0)=r%(0)+1:IFA%AND127:VDUA%

160 UNTIL(A%AND127)=0:IFA%=0:PRINT

170 psw%=psw%AND-2:=0

180 DEFFN_EMTEA:=0:REM &o352 Reset all channels

190 DEFFN_EMTEB:=0:REM &o353 Increase size of I/O queue

200 DEFFN_EMTEC:REM &o354 SETTOP Set top of user memory, In: R0=requested MEMTOP, Out: R0=actual MEMTOP

210 IF r%(0)>memtop%:r%(0)=memtop%

220 psw%=psw%AND-2:=0

230 DEFFN_EMTED:=0:REM Enable terminal output

240 DEFFN_EMTEE:=0:REM Unused

250 DEFFN_EMTEF:=0:REM Terminate I/O and reset channels

260 DEFFN_EMTF0:=0

270 DEFFN_EMTF1:=0

280 DEFFN_EMTF2:=0

290 DEFFN_EMTF3:=0

300 DEFFN_EMTF4:=0

310 DEFFN_EMTF5:=0

320 DEFFN_EMTF6:=0

330 DEFFN_EMTF7:=0

340 DEFFN_EMTF8:=0

350 DEFFN_EMTF9:=0

360 DEFFN_EMTFA:=0

370 DEFFN_EMTFB:=0:REM Call address in Kernal mode

380 DEFFN_EMTFC:=0:REM R0=function:channel

390 DEFFN_EMTFD:=0:REM R0=>argument block

400 DEFFN_EMTFE:=0

410 DEFFN_EMTFF:=0:REM RSX system call

420 :

10 REM > DisPDP 1.02 - PDP11 disassembly routines

20 DEFFNDis_Name(A%):X%?3=&14:="PDP11"

30 DEFFNDis_Code(A%,Ptr%,Data%):LOCAL s%,d%,c%:!X%=0:num%=2

40 c%=!Data%:s%=(c%AND&0FC0)DIV64:d%=c%AND63:c%=(c%AND&F000)DIV&1000

50 $(X%+4)=FNpdp:X%?3=num%:=num%

60 :

70 DEFFNpdp

80 IF(c%AND7)=0:IFs%>39:IFs%<52:=MID$("CLRCOMINCDECNEGADCSBCTSTRORROLASRASL",3*(s%-40)+1,3)+MID$(" B",c%DIV8+1,1)+" "+FNmr(d%)

90 IF((c%-1)AND7)<5:=MID$("MOVCMPBITBICBIS",(c%AND7)*3-2,3)+MID$(" B",c%DIV8+1,1)+" "+FNmr(s%)+","+FNmr(d%) ELSE =EVAL("FNpdp_"+STR$~c%)

100 :

110 DEFFNpdp_F:="FLOP "+FNmr(s%)+","+FNmr(d%)

120 :

130 DEFFNpdp_E:="SUB "+FNmr(s%)+","+FNmr(d%)

140 :

150 DEFFNpdp_8:IFs%<32:=MID$("BPLBMIBHIBLSBVCBVSBCCBCS",3*((s%DIV4))+1,3)+" "+FNjr(?Data%)

160 IFs%<40:=MID$("EMT TRAP",(s%AND&FC)-31,4)+" &"+FNh0(?Data%,2)

170 IF(s%AND&FC)=&34:=MID$("MTPSMFPDMTPDMFPS",4*s%-207,3)+" "+FNmr(d%)

180 X%?2=128:="EQUW &"+FNh0(!Data%,4)

190 :

200 DEFFNpdp_7

210 IFs%<32:=MID$("MUL DIV ASH ASHC",4*(s%DIV8)+1,4)+" "+FNmr(d%)+","+FNr(s%)

220 IFs%<40:="XOR "+FNr(s%)+","+FNmr(d%)

230 IFs%=40:IFd%<32:=MID$("FADDFSUBFMULFDIV",4*(d%DIV8)+1,4)+" "+FNr(d%)

240 IF(s%AND&38)=&38:="SOB "+FNr(s%)+","+FNjr(d%-192*(d%>31))

250 X%?2=128:="EQUW &"+FNh0(!Data%,4)

260 :

270 DEFFNpdp_6:="ADD "+FNmr(s%)+","+FNmr(d%)

280 :

290 DEFFNpdp_0:IFs%<32:IFs%>3:X%?2=(s%<8)AND64:=MID$("BR BNEBEQBGEBLTBGTBLE",3*(s%DIV4)-2,3)+" "+FNjr(?Data%)

300 IFs%=0:IFd%<7:=MID$("HALTWAITRTIBPTIOTRESETRTT",d%*4+1+(d%>2)+(d%>3)+(d%=5),4+(d%>1)-2*(d%>4))

310 IFs%=1:X%?2=64:="JMP "+FNmr(d%)

320 IFs%=2:IFd%<8:X%?2=64:="RTS "+FNr(d%)

330 IFs%=2:IF(d%AND&38)=&18:="SPL "+STR$(d%AND7)

340 IFs%=2:IF(d%AND&30)=&20:="CCC &"+FNh0(d%AND&F,2)

350 IFs%=2:IF(d%AND&30)=&30:="SCC &"+FNh0(d%AND&F,2)

360 IFs%=3:="SWAB "+FNmr(d%)

370 IF(s%AND&38)=&20:="JSR "+FNr(s%AND7)+","+FNmr(d%)

380 IFs%=52:="MARK &"+FNh0(d%,2)

390 IF(s%AND&FC)=&34:=MID$("MFPIMTPISXT ",4*s%-211,3)+" "+FNmr(d%)

400 X%?2=128:="EQUW &"+FNh0(!Data%,4)

410 :

420 DEFFNr(A%):A%=A%AND7:IFA%=7:="PC" ELSE IFA%=6:="SP" ELSE ="R"+STR$ A%

430 DEFFNmr(A%):LOCAL m%:m%=(A%AND&38)DIV8:IF(A%AND7)=7:=FNpc

440 IFm%<2:=MID$("("+FNr(A%)+")",2-m%,2*m%+2)

450 IFm%<6:=LEFT$("@",m%AND1)+LEFT$("-",m%DIV4)+"("+FNr(A%)+")"+LEFT$("+",m%<4)

460 num%=num%+2:=LEFT$("@",m%=7)+FNh0(Data%!(num%-2),4)+"("+FNr(A%)+")"

470 DEFFNpc

480 IFm%<2:=MID$("(PC)",2-m%,2*m%+2)

490 IFm%<5:num%=num%+2:=LEFT$("@",m%=3)+"#&"+FNh0(Data%!(num%-2),4)

500 IFm%<6:=MID$("@-(PC)",6-m%)

510 num%=num%+2:=LEFT$("@",m%=7)+"&"+FNh0(Ptr%+num%+Data%!(num%-2),4)

520 :

530 DEFFNjr(A%):IFA%<128:="&"+FNh0(Ptr%+A%*2+2,4) ELSE ="&"+FNh0(Ptr%+A%*2+2-512,4)

540 :

10 REM > BLib.Close 1.00 09Aug1998

20 :

30 REM Close Handling

40 REM ~~~~~~~~~~~~~~

50 :

60 DEFPROCClose_All

70 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%

80 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%

90 ENDPROC

10 REM > BLib.String 1.00 09Aug1998

20 :

30 REM String Manipulation Functions

40 REM =============================

50 :

60 REM FNs() - strip spaces from start and end of string

70 REM -------------------------------------------------

80 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "

90 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "

100 =A$

110 :

120 REM FNuc() - convert string to upper case

130 REM -------------------------------------

140 DEFFNuc(A$):LOCAL B$:IFA$="":=""

150 REPEATB$=B$+CHR$(ASCA$AND((A$<"@")OR&DF)):A$=MID$(A$,2):UNTILA$="":=B$

160 :

170 REM FNlc() - convert string to lower case

180 REM -------------------------------------

190 DEFFNlc(A$):LOCAL B$:IFA$="":=""

200 REPEATB$=B$+CHR$(ASCA$OR((A$<"_")AND&20)):A$=MID$(A$,2):UNTILA$="":=B$

210 :

10 REM > BLib.Number 1.01 09Aug1988

20 REM v1.00 09Aug1988 JGH: First version

30 REM v1.01 12Feb1992 JGH: Added Octal and Binary

40 REM v1.02 15Sep2009 JGH: Octal and Binary works for &8xxxxxxx

50 :

60 REM Number Output Routines

70 REM ~~~~~~~~~~~~~~~~~~~~~~

80 :

90 REM Hexadecimal padded with zeros

100 DEFFNh0(A%,N%):=RIGHT$("0000000"+STR$~A%,N%)

110 :

120 REM Hexadecimal padded with spaces

130 DEFFNh(A%,N%):=RIGHT$(" "+STR$~A%,N%)

140 :

150 REM Decimal padded with zeros

160 DEFFNd0(A%,N%):=RIGHT$("00000000"+STR$A%,N%)

170 :

180 REM Decimal padded with spaces

190 DEFFNd(A%,N%):=RIGHT$(" "+STR$A%,N%)

200 :

210 REM Octal padded with zeros

220 DEFFNo0(A%,N%):LOCAL A$,B%,L%:IFA%<0:B%=2:A%=A%AND&7FFFFFFF

230 REPEATA$=STR$(A%AND7)+A$:A%=A%DIV8:L%=L%+3:UNTILL%>27:=RIGHT$(STR$(A%+B%)+A$,N%)

240 :

250 REM Octal padded with spaces

260 DEFFNo(A%,N%):LOCAL A$:IFA%<0:=FNo0(A%,N%)

270 REPEATA$=STR$(A%AND7)+A$:A%=A%DIV8:UNTILA%=0:=RIGHT$(STRING$(N%," ")+A$,N%)

280 :

290 REM Binary padded with zeros

300 DEFFNb0(A%,N%):LOCAL A$,B$,L%:B$="0":IFA%<0:B$="1":A%=A%AND&7FFFFFFF

310 REPEATA$=STR$(A%AND1)+A$:A%=A%DIV2:L%=L%+1:UNTILL%>30:=RIGHT$(B$+A$,N%)

320 :

330 REM Binary padded with spaces

340 DEFFNb(A%,N%):LOCAL A$:IFA%<0:=FNb0(A%,N%)

350 REPEATA$=STR$(A%AND1)+A$:A%=A%DIV2:UNTILA%=0:=RIGHT$(STRING$(N%," ")+A$,N%)

360 :

370 REM Drive character for supplied number

380 DEFFNdrv(A%):=CHR$(48+A%-7*(A%>9))

390 :

400 REM Drive number for supplied character

410 DEFFNDrv(A$):=ASCA$-48+7*(A$>"9")AND31

420 :

10 REM > BLib.ProgEnv 1.06 20Apr2020

20 :

30 REM Program Environment Functions

40 REM =============================

50 :

60 REM Return command line tail, sets run$ to execution filename

70 REM Works on BBCIO,BBC09,T6502,T6809,TZ80,ZX80,PDP11,ARMEval,ARMCoPro,RISCOS,DOS,Windows

80 REM ------------------------------------------------------------------------------------

90 DEFFNOS_GetEnv:LOCALA$,A%,X%,Y%:X%=1:os%=((USR&FFF4)AND&FF00)DIV256

100 IFos%>31:IFPAGE>&FFFFF:DIMX%LOCAL256:SYS"GetModuleFileName",0,X%,255:run$=$$X%:=@cmd$

110 A%=&600-&7B00*(PAGE>&8000)-&3F00*(PAGE>&C000):IF!(PAGE-&100)=@%:A%=PAGE-&300

120 IF?(TOP-3)=0:A%=&100:IFHIMEM<&FFFF:A%=PAGE-&300:IF!(HIMEM+512)=@%:A%=HIMEM

130 A$=$A%:IFPAGE=&8F00:run$=A$:SYS16TOA$,,A%:SYS72,"",A%:A$=MID$(A$,1+INSTR(A$+" "," ",1+INSTR(A$," "))):IFLENA$=0:A$=run$

140 FORY%=-1TO0:A$=" "+A$:REPEATA$=MID$(A$,2):UNTILASCA$<>32:IFASCA$=34:A%=INSTR(A$,"""",2)+1 ELSE A%=INSTR(A$+" "," ")

150 IFY%:run$=MID$(A$,1-(ASCA$=34),A%-1+2*(ASCA$=34)):A$=MID$(A$,A%+1)

160 NEXT:=A$

170 :

180 REM Run a program, passing it a command line

190 REM If program is *Command, called with OSCLI, else CHAINed

200 REM -------------------------------------------------------

210 DEFPROCos(A$):IFASCA$=42:OSCLIA$ ELSE IFLENA$:CHAINA$

220 ENDPROC

230 :

240 REM Exit program, setting return value

250 REM ----------------------------------

260 DEFPROCexit(A%):OSCLI"FX1,"+STR$(A%AND255):quit$=quit$:A$=quit$:quit$="":PROCos(A$)

270 IFPAGE>&FFFFF:QUIT A% ELSE END

280 ENDPROC

290 :

10 REM > BLib.Generic.FileIO 1.05 22Mar2008

20 REM v1.05 22Mar2009 Optimised CDIR in FNfile()

30 REM v1.04 22Mar2008 FNf_scan strips spaces

40 REM v1.03 15Feb2008 Add veneer functions in f_ domain

50 REM v1.02 28Apr2007 Added functions to FNfile on DOS, PROCcdir, FNopenout

60 REM v1.01 07Sep2006 FNargs avoid zero page on RISC OS

70 REM v1.00 09Aug1988 Initial version

80 :

90 REM General File Interface Routines

100 REM ===============================

110 :

120 REM FNfile(), PROCgbpb(), FNfs are callable on Windows

130 REM --------------------------------------------------

140 :

150 REM Returns file type, file info in X%!...

160 REM --------------------------------------

170 DEFFNfile(A$,A%):IFA%<>8:IFPAGE<&FFFFF:$name%=A$:?X%=name%:X%?1=name%DIV256:=(USR&FFDD)AND&FF

180 A$=FNf_name(A$):IFA%=255 OR A%=5:X%!14=OPENIN(A$):IFX%!14:X%!10=EXT#X%!14:CLOSE#X%!14:X%!14=&33

190 IFA%=255:IFX%?6=0:OSCLI"LOAD """+A$+""" "+STR$~X%!2:=1

200 IFA%=5:IFX%!14:=1 ELSE IFA%=5:=0

210 IFA%=0:OSCLI"SAVE """+A$+""" "+STR$~X%!10+" "+STR$~X%!14:X%!10=X%!14-X%!10:=1

220 IFA%=7:OSCLI"SAVE """+A$+""" "+STR$~PAGE+"+"+STR$~X%!10:X%!10=X%!14-X%!10:=1

230 IFA%<>8:=0

240 IF(os%AND-24):A$="mkdir "+A$ ELSE A$="cdir "+A$

250 IFHIMEM>&FFFF:LOCAL ERROR:ON ERROR LOCAL:=0

260 OSCLIA$:=2

270 :

280 REM General OSGBPB call

290 REM -------------------

300 DEFPROCf_gbpb(A%,chn%,addr%,num%,ptr%)

310 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFFF:CALL&FFD1:ENDPROC

320 IFA%=1ORA%=3:PTR#?X%=X%!9

330 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%

340 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC

350 :

360 DEFPROCgbpb(A%,chn%,addr%,num%,ptr%)

370 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFFF:CALL&FFD1:ENDPROC

380 IFA%=1ORA%=3:PTR#?X%=X%!9

390 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%

400 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC

410 :

420 REM Return current disk (5), directory (6) or library (7) name

430 REM ----------------------------------------------------------

440 DEFFNgbpb(A%):IFPAGE>&FFFFF:=""

450 X%!1=name%:CALL&FFD1:A%=name%+((1+?name%)AND((A%AND-2)=6)):A%?(1+?A%)=13:=$(A%+1)

460 :

470 REM Returns entry in current directory, or null string if at end

480 REM ------------------------------------------------------------

490 DEFFNf_scan(ptr%):IFPAGE>&FFFFF:=""

500 X%!1=name%:X%!5=1:X%!9=ptr%:A%=8:CALL&FFD1:IFX%!5=1:=""

510 A%=name%+1:A%!(A%?-1)=&D20:A%?(INSTR($A%," ")-1)=13:=$A%

520 :

530 DEFFNgbpb8(ptr%):IFPAGE>&FFFFF:=""

540 X%!1=name%:X%!5=1:X%!9=ptr%:A%=8:CALL&FFD1:IFX%!5=1:=""

550 A%=name%+1:A%!(A%?-1)=&D20:A%?(INSTR($A%," ")-1)=13:=$A%

560 :

570 REM OSARGS call with data. Returns any returned data

580 REM -------------------------------------------------

590 DEFFNf_args(A%,Y%,ptr%):LOCAL X%,E%:IF?(TOP-3)=0:E%=Y%:Y%=0

600 IF FALSE THEN

610 LOCAL !&70:X%=&70:!X%=ptr%:CALL&FFDA:=!X%

620 ELSE

630 SYS"OS_Args",A%,Y%,ptr% TO ,,ptr%

640 SAVE:=ptr%

650 :

660 DEFFNargs(A%,Y%,ptr%):LOCAL X%,E%:IF?(TOP-3)=0:E%=Y%:Y%=0

670 IF FALSE THEN

680 LOCAL !&70:X%=&70:!X%=ptr%:CALL&FFDA:=!X%

690 ELSE

700 SYS"OS_Args",A%,Y%,ptr% TO ,,ptr%

710 SAVE:=ptr%

720 :

730 REM OSARGS call ignoring X, returns A

740 REM ---------------------------------

750 DEFFNf_argsA(A%):IF FALSE THEN

760 LOCAL X%,Y%,E%,!&70:X%=&70:=(USR&FFDA)AND&FF

770 ELSE

780 SYS"OS_Args",A% TO A%

790 SAVE:=A%

800 :

810 DEFFNargsA(A%):IF FALSE THEN

820 LOCAL X%,Y%,E%,!&70:X%=&70:=(USR&FFDA)AND&FF

830 ELSE

840 SYS"OS_Args",A% TO A%

850 SAVE:=A%

860 :

870 REM Get current filing system number

880 REM --------------------------------

890 DEFFNfs:IF(os%AND-32)=0:LOCAL A%,Y%,E%:=(USR&FFDA)AND&FF

900 =29

910 :

920 REM Delete an object

930 REM ----------------

940 DEFPROCf_delete(A$):IF(os%AND-24):A$="del "+A$ ELSE A$="delete "+A$

950 OSCLIA$:ENDPROC

960 :

970 REM Select a directory

980 REM ------------------

990 DEFPROCf_dir(A$):IF(os%AND-24):A$="cd "+A$ ELSE A$="dir "+A$

1000 OSCLIA$:ENDPROC

1010 :

1020 REM Create a directory only if it doesn't exist

1030 REM -------------------------------------------

1040 DEFPROCf_cdir(A$):

1050 IF(os%AND-24):A$="mkdir "+A$ ELSE A$="cdir "+A$

1060 IF FALSE THEN

1070 OSCLIA$:ENDPROC

1080 ENDIF

1090 LOCAL ERROR:ON ERROR LOCAL:ENDPROC

1100 OSCLIA$

1110 ENDPROC

1120 :

1130 REM Open an input file ensuring no extension

1140 REM ----------------------------------------

1150 DEFFNf_openin(A$)=OPENIN(FNf_name(A$))

1160 :

1170 REM Open an output file ensuring no extension

1180 REM -----------------------------------------

1190 DEFFNf_openout(A$)=OPENOUT(FNf_name(A$))

1200 :

1210 REM Open an update file ensuring no extension

1220 REM -----------------------------------------

1230 DEFFNf_openup(A$)=OPENUP(FNf_name(A$))

1240 :

1250 DEFFNf_name(A$):IFos%AND-32:LOCALA%,B%:REPEATB%=A%:A%=INSTR(A$,d$,A%+1):UNTILA%=0:IFINSTR(A$,".",B%)=0:A$=A$+"."

1260 =A$