From c1b567d833a004bb3d978f1f7c99f42cefa7845c Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Fri, 26 Jun 2020 16:38:19 +0100 Subject: [PATCH] Create readable text `.bas' for each tokenized BASIC `,ffb' file. --- StraySrc/Libraries/BAS/src/b/bas.bas | 382 +++++ StraySrc/Libraries/Core/TearSupt/UnLoad.bas | 18 + StraySrc/Libraries/Core/TearSupt/bs/tearSupt.bas | 812 +++++++++ StraySrc/Libraries/Sapphire/bs/fixedPt.bas | 451 +++++ StraySrc/Libraries/Sapphire/bsh/banner.bas | 46 + StraySrc/Libraries/Sapphire/bsh/dbx.bas | 75 + StraySrc/Libraries/Sapphire/bsh/flex.bas | 62 + StraySrc/Libraries/Sapphire/bsh/libOpts.bas | 22 + StraySrc/Libraries/Sapphire/bsh/menuDefs.bas | 147 ++ StraySrc/Libraries/Sapphire/bsh/options.bas | 58 + StraySrc/Libraries/Sapphire/bsh/stdDbox.bas | 43 + StraySrc/Libraries/Sapphire/sail/errgen.bas | 167 ++ StraySrc/Libraries/Sapphire/sail/tableGen.bas | 350 ++++ StraySrc/MiscToys/PlainError/b/plainError.bas | 101 ++ StraySrc/MiscToys/PlainError/testit.bas | 1 + StraySrc/SapphToys/!SWIlist/bs/swiList.bas | 1964 ++++++++++++++++++++++ StraySrc/Utilities/b/buildstub.bas | 164 ++ StraySrc/Utilities/b/fixlink.bas | 64 + StraySrc/Utilities/b/msgaof.bas | 206 +++ StraySrc/Utilities/b/resgen.bas | 487 ++++++ StraySrc/Utilities/b/templaof.bas | 396 +++++ StraySrc/Utilities/buildstub.bas | 31 + StraySrc/Utilities/fixlink.bas | 5 + StraySrc/Utilities/msgaof.bas | 45 + StraySrc/Utilities/resgen.bas | 37 + StraySrc/Utilities/templaof.bas | 33 + StraySrc/gplnote/basic.bas | 18 + 27 files changed, 6185 insertions(+) create mode 100644 StraySrc/Libraries/BAS/src/b/bas.bas create mode 100644 StraySrc/Libraries/Core/TearSupt/UnLoad.bas create mode 100644 StraySrc/Libraries/Core/TearSupt/bs/tearSupt.bas create mode 100644 StraySrc/Libraries/Sapphire/bs/fixedPt.bas create mode 100644 StraySrc/Libraries/Sapphire/bsh/banner.bas create mode 100644 StraySrc/Libraries/Sapphire/bsh/dbx.bas create mode 100644 StraySrc/Libraries/Sapphire/bsh/flex.bas create mode 100644 StraySrc/Libraries/Sapphire/bsh/libOpts.bas create mode 100644 StraySrc/Libraries/Sapphire/bsh/menuDefs.bas create mode 100644 StraySrc/Libraries/Sapphire/bsh/options.bas create mode 100644 StraySrc/Libraries/Sapphire/bsh/stdDbox.bas create mode 100644 StraySrc/Libraries/Sapphire/sail/errgen.bas create mode 100644 StraySrc/Libraries/Sapphire/sail/tableGen.bas create mode 100644 StraySrc/MiscToys/PlainError/b/plainError.bas create mode 100644 StraySrc/MiscToys/PlainError/testit.bas create mode 100644 StraySrc/SapphToys/!SWIlist/bs/swiList.bas create mode 100644 StraySrc/Utilities/b/buildstub.bas create mode 100644 StraySrc/Utilities/b/fixlink.bas create mode 100644 StraySrc/Utilities/b/msgaof.bas create mode 100644 StraySrc/Utilities/b/resgen.bas create mode 100644 StraySrc/Utilities/b/templaof.bas create mode 100644 StraySrc/Utilities/buildstub.bas create mode 100644 StraySrc/Utilities/fixlink.bas create mode 100644 StraySrc/Utilities/msgaof.bas create mode 100644 StraySrc/Utilities/resgen.bas create mode 100644 StraySrc/Utilities/templaof.bas create mode 100644 StraySrc/gplnote/basic.bas diff --git a/StraySrc/Libraries/BAS/src/b/bas.bas b/StraySrc/Libraries/BAS/src/b/bas.bas new file mode 100644 index 0000000..5a371bc --- /dev/null +++ b/StraySrc/Libraries/BAS/src/b/bas.bas @@ -0,0 +1,382 @@ +REM Basic Assembler Supplement 1.00 © 1996-1998 Straylight +REMÂÁÓhack + +REM ----- Licensing note ---------------------------------------------------- +REM +REM This file is part of Straylight's BASIC Assembler Supplement (BAS) +REM +REM BAS is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM BAS is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with BAS. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +REM --- Hacking warning --- +REM +REM That gorp on the second line is a magic marker word inserted by hand +REM (the three letters `BAS' with their top bits set) and space for an offset +REM word which marks the offset of the code section from the beginning of +REM the LIBRARY link block. Don't play with them unless you (a) know what +REM you're doing (and it should be perfectly clear by now that I don't have +REM a clue), and (b) want to seriously upset the library search code below. + +ERROR 0,"You can't run the Basic Assembler Supplement" + +REM --- A note --- +REM +REM To make this program particularly easy to strip down and transmogrify, +REM it contains directives which are picked up by a sed script during +REM munging. The directives currently are `del ... edel' which deletes +REM all the enclosed lines, and `hex' which inserts the generated hex version +REM of the library search code. Directives are enclosed in square brackets. +REM It's usual to put them in REM statements. + +REM ----- Initialisation ---------------------------------------------------- + +REM [del] +DEF FNbas_assign(RETURN d,v%):d=v%:=0 +DEF PROCbas_const(var$,val%) +IF bas_cf% THEN BPUT #bas_cf%,"/\<"+var$+"\>/s//"+STR$(val%)+"/g" +IF EVAL("FNbas_assign("+var$+",val%)") +ENDPROC + +DEF FNnext:R%+=4:=R%-4 + +DEF PROCbas_saveconst +bas_cf%=OPENOUT("work.basconst") + +DEF PROCbas_constants +bas_cf%=bas_cf% +R%=0 +PROCbas_const("bcode_wSize",FNnext) +PROCbas_const("bcode_init",FNnext) +PROCbas_const("bcode_aofInit",FNnext) +PROCbas_const("bcode_newPass",FNnext) +PROCbas_const("bcode_import",FNnext) +PROCbas_const("bcode_export",FNnext) +PROCbas_const("bcode_get",FNnext) +PROCbas_const("bcode_area",FNnext) +PROCbas_const("bcode_reloc",FNnext) +PROCbas_const("bcode_noReloc",FNnext) +PROCbas_const("bcode_entry",FNnext) +PROCbas_const("bcode_save",FNnext) +PROCbas_const("bcode_align",FNnext) +PROCbas_const("bcode_reserve",FNnext) +PROCbas_const("bcode_lit",FNnext) +PROCbas_const("bcode_ltorg",FNnext) +PROCbas_const("bcode_saveOpt",FNnext) +PROCbas_const("bcode_restoreOpt",FNnext) +IF bas_cf% THEN CLOSE #bas_cf% +ENDPROC +REM [edel] + +REM --- Unexplainable horridness --- +REM +REM Tim wants to be able to embed the code into this library file, so +REM that it doesn't have to be searched for. I'll therefore have to write +REM some code to scan the library list and locate this one, and find the +REM code tacked onto the end. Yuk. + +DEF PROCbas_init +LOCAL type%,size% :REM [dl] +LOCAL workSize%,H%,len%,f% +PROCbas_constants :REM [dl] + +REM --- Old code to load the library from disk --- + +REM [del] +IF TRUE THEN + DIM bas_scratch% 300 + SYS "OS_File",17,"libs:BAScode" TO type%,,,,size% + IF type%<>1 THEN ERROR 0,"BAS code not found" + DIM bas_code% size% + SYS "OS_File",16,"libs:BAScode",bas_code%,0 +ELSE +DEF PROCbas_dumpcode +REM [edel] + +REM --- New hacking to scan the library list --- +REM +REM This must be done in assembler, of course ;-) Time to put on my pointy +REM Rincewind hat... I've tried to do this in one pass because I'm lazy -- +REM I guess that's why it's unreadable. + + DIM bas_scratch% 300 + P%=bas_scratch% + [ opt 0 + + ; exit with r0 == pointer to code, or 0 if not found (erk!) + + ldr r2,[pc] ; load the magic marker word + mov pc,pc ; skip over the magic marker word + dcd &d3c1c2f4 ; this is `REMBAS', with the top bits set + + ldr r0,[r14,#&24] ; find offset of TIMEOF + add r0,r8,r0 ; add on ARGP to find TIMEOF + ldr r0,[r0,#&c] ; load the library list base + +;.loop + cmp r0,#0 ; is that the end of it all? + moveqs pc,r14 ; yes -- oh, well -- it was a nice try + + ldr r1,[r0,#&44] ; load mystic recognition word + cmp r1,r2 ; does it match? + ldrne r0,[r0] ; if not there, load the next link + subne pc,pc,#28 ; and jump back to `loop' (erk) + + ldr r1,[r0,#&48] ; load the code offset + add r0,r1,r0 ; and add it to the base address + movs pc,r14 + ] + + REM --- Now some code to dump that out as hex --- + + bas_code%=USR bas_scratch% + IF bas_code%=0 THEN ERROR 0,"BAS code not found: is the library corrupt?" + +REM [del] +ENDIF +REM [edel] + +REM --- Back to life as normal --- + +workSize%=USR(bas_code%+bcode_wSize) +DIM bas_workspace% workSize% +H%=bas_workspace% +CALL bas_code%+bcode_init +SYS "XOS_ReadVarVal","BAS$Output",bas_scratch%,256,3 TO ,,len%;f% +IF f% AND 1 THEN + bas_fileName$="" +ELSE + bas_scratch%?len%=13 + bas_fileName$=$bas_scratch% +ENDIF +ENDPROC + +DEF PROCbas_aofInit(size%) +LOCAL H% +IF size% THEN DIM bas_asmCode% size% ELSE bas_asmCode%=bas_asmCode% +IF bas_asmCode%=0 THEN ERROR 0,"No buffer allocated for assembler code" +H%=bas_workspace% +CALL bas_code%+bcode_aofInit,bas_asmCode% +ENDPROC + +REM This function saves a few bytes and tidies up the code a bit. + +DEF FNbas_call(offset%) +LOCAL H% +H%=bas_workspace% +=USR(bas_code%+offset%) + +REM ----- AOF code generation ----------------------------------------------- + +DEF PROCbas_aofSaveAs(name$) +LOCAL H% +H%=bas_workspace% +CALL bas_code%+bcode_save,name$ +ENDPROC + +DEF PROCbas_aofSave +IF bas_fileName$="" THEN ERROR 0,"No implicit filename" +PROCbas_aofSaveAs(bas_fileName$) +bas_fileName$="" +ENDPROC + +DEF FNpass=FNbas_call(bcode_newPass) + +DEF FNbas_port(offset%,A%,s$,t$) +LOCAL H% +H%=bas_workspace% +CALL bas_code%+offset%,s$,t$ +=0 + +DEF FNimport(var$)=FNbas_port(bcode_import,0,var$,var$) +DEF FNimportAs(sym$,var$)=FNbas_port(bcode_import,0,sym$,var$) +DEF FNimportWeak(var$)=FNbas_port(bcode_import,1,var$,var$) +DEF FNimportWeakAs(sym$,var$)=FNbas_port(bcode_import,1,sym$,var$) +DEF FNexport(var$)=FNbas_port(bcode_export,0,var$,var$) +DEF FNexportAs(var$,sym$)=FNbas_port(bcode_export,0,var$,sym$) +DEF FNexportStrong(var$)=FNbas_port(bcode_export,1,var$,var$) +DEF FNexportStrongAs(var$,sym$)=FNbas_port(bcode_export,1,var$,sym$) + +DEF FNget(file$) +LOCAL H% +H%=bas_workspace% +CALL bas_code%+bcode_get,file$ +=0 + +DEF FNbas_lib(lib$) +LOCAL err%,leaf$,lower$,i% +leaf$=lib$ +FOR i%=1 TO LEN(lib$) + IF INSTR(":.",MID$(lib$,i%,1)) THEN leaf$=MID$(lib$,i%+1) +NEXT +FOR i%=1 TO LEN(leaf$) + lower$+=CHR$(ASC(MID$(leaf$,i%,1)) OR &20) +NEXT +LOCAL ERROR +ON ERROR LOCAL err%=TRUE +IF err%=FALSE THEN + IF EVAL("FN"+lower$+"_test") +ENDIF +RESTORE ERROR +IF err%=TRUE THEN LIBRARY lib$ +=0 + +DEF FNarea(name$,attr$) +LOCAL A%,H% +A%=2 +IF INSTR(attr$,"CODE") THEN A%+=&200 +IF INSTR(attr$,"COMDEF") THEN A%+=&400 +IF INSTR(attr$,"COMMON") THEN A%+=&800 +IF INSTR(attr$,"NOINIT") THEN A%+=&1000 +IF INSTR(attr$,"READONLY") THEN A%+=&2000 +IF INSTR(attr$,"DEBUG") THEN A%+=&8000 +IF A% AND &800 THEN A%=A% OR &1000 +IF A% AND &200 THEN A%=A% OR &2000 +H%=bas_workspace% +CALL bas_code%+bcode_area,name$ +=0 + +DEF FNreloc=FNbas_call(bcode_reloc) +DEF FNnoReloc=FNbas_call(bcode_noReloc) + +DEF FNentry=FNbas_call(bcode_entry) + +REM ----- Literal handling -------------------------------------------------- + +DEF PROClitStart +bas_litStart%=P% +bas_savedOpt%=USR(bas_code%+bcode_saveOpt) +ENDPROC + +DEF FNlitw(val%) +PROClitStart +[ opt 4: dcd val%:] +=FNlitAlign + +DEF FNlits(str$) +PROClitStart +[ opt 4: equs str$:] +=FNlit + +DEF FNlitmagic(str$) +PROClitStart +[ opt 4: equs str$:] +=FNlitAlign + +DEF FNlitsz(str$) +PROClitStart +[ opt 4: equs str$+CHR$0:] +=FNliteral + +DEF FNliterr(err%,str$) +PROClitStart +[ opt 4: dcd err%: equs str$+CHR$0:] +=FNlitAlign + +DEF FNliteral +LOCAL A%,B%,C% +A%=bas_savedOpt% +CALL bas_code%+bcode_restoreOpt +B%=P%-bas_litStart% +A%=O%-B% +C%=0 +P%=bas_litStart% +O%=A% +=FNbas_call(bcode_lit) + +DEF FNlitAlign +LOCAL A%,B%,C% +A%=bas_savedOpt% +CALL bas_code%+bcode_restoreOpt +B%=P%-bas_litStart% +A%=O%-B% +C%=1 +P%=bas_litStart% +O%=A% +=FNbas_call(bcode_lit) + +DEF FNltorg=FNbas_call(bcode_ltorg) + +REM ----- Initialising areas ------------------------------------------------ + +DEF FNalign=FNbas_call(bcode_align) +DEF FNreserve(A%)=FNbas_call(bcode_reserve) + +DEF FNbin(file$) +LOCAL size% +IF FNbas_call(bcode_noReloc) +size%=FNfSize(file$) +SYS "OS_File",16,file$,O%,0 +O%+=size% +P%+=size% +IF FNbas_call(bcode_reloc) +=0 + +DEF FNfSize(file$) +LOCAL size% +SYS "OS_File",17,file$ TO ,,,,size% +=size% + +REM ----- Laying out storage areas ------------------------------------------ + +DEF PROCws_start +bas_R%=0 +ENDPROC + +DEF PROCws_base(start%) +bas_R%=start% +ENDPROC + +DEF FNws(size%) +bas_R%+=size% +=bas_R%-size% + +DEF PROCws_align +bas_R%=(bas_R%+3) AND -4 +ENDPROC + +DEF FNws_word +PROCws_align +=FNws(4) + +DEF FNws_byte=FNws(1) + +REM ----- Long directives --------------------------------------------------- + +DEF FNadrl(r%,adr%)=FNaddccl(14,r%,15,adr%-P%-8) +DEF FNadrccl(cc%,r%,adr%)=FNaddccl(cc%,r%,15,adr%-P%-8) +DEF FNaddl(r%,b%,off%)=FNaddccl(14,r%,b%,off%) +DEF FNaddccl(cc%,r%,b%,off%) +IF off%>0 THEN + [opt 4:addeq r%,b%,#off% AND 255:addeq r%,r%,#off% AND -256:] +ELSE + [opt 4:subeq r%,pc,#(-off%) AND 255:subeq r%,r%,#(-off%) AND -256:] +ENDIF +!(O%-8)=!(O%-8) OR (cc%<<28) +!(O%-4)=!(O%-4) OR (cc%<<28) +=0 + +DEF FNldrl(r%,adr%)=FNldrrccl(14,r%,15,adr%-P%-8) +DEF FNldrccl(cc%,r%,adr%)=FNldrrccl(cc%,r%,15,adr%-P%-8) +DEF FNldrrl(r%,b%,off%)=FNldrrccl(14,r%,b%,off%) +DEF FNldrrccl(cc%,r%,b%,off%) +IF off%>0 THEN + [opt 4:addeq r%,b%,#off% AND -256:ldreq r%,[r%,#off% AND 255]:] +ELSE + [opt 4:subeq r%,b%,#(-off%) AND -256:ldreq r%,[r%,#-((-off%) AND 255)]:] +ENDIF +!(O%-8)=!(O%-8) OR (cc%<<28) +!(O%-4)=!(O%-4) OR (cc%<<28) +=0 + +REM ----- That's all, folks ------------------------------------------------- diff --git a/StraySrc/Libraries/Core/TearSupt/UnLoad.bas b/StraySrc/Libraries/Core/TearSupt/UnLoad.bas new file mode 100644 index 0000000..3f1dbb1 --- /dev/null +++ b/StraySrc/Libraries/Core/TearSupt/UnLoad.bas @@ -0,0 +1,18 @@ +DIM code% 2048 +P%=code% +[ opt 2 + +.unload + stmfd r13!,{r1-r12,r14} + mvn r0,#0 + swi "XOS_ChangeEnvironment" + movvc r14,pc + addvc pc,r1,#16 + movvc r0,#0 + movvs r0,#1 + ldmfd r13!,{r1-r12,pc}^ + +] + +IF USR(unload) THEN ERROR 1,"TearSupport not present/broken beyond redemption" ELSE ERROR 1,"TearSupprt unloaded OK" +END diff --git a/StraySrc/Libraries/Core/TearSupt/bs/tearSupt.bas b/StraySrc/Libraries/Core/TearSupt/bs/tearSupt.bas new file mode 100644 index 0000000..20b3426 --- /dev/null +++ b/StraySrc/Libraries/Core/TearSupt/bs/tearSupt.bas @@ -0,0 +1,812 @@ +REM +REM tearSupt.bs +REM +REM TearoffSupport code (encrypted) +REM +REM © 1994-1998 Straylight +REM + +REM ----- Licensing note ---------------------------------------------------- +REM +REM This file is part of Straylight's Tearoff Menu System (TMS), but it's +REM distributed with Straylight's core libraries (corelib). +REM +REM TMS is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM TMS is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with Corelib. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +LIBRARY "libs:BAS" + +ON ERROR ERROR 0,REPORT$+" ["+STR$(ERL)+"]" +PROCbas_init +PROCbas_aofInit(&4000) + +XOS_ClaimProcessorVector=&20069 +XOS_SynchroniseCodeAreas=&2006E + +PRINT "Assembling..."; + +ts_version=110 + +FOR o=4 TO 6 STEP 2 +[ opt o + FNpass + +;----- TearoffSupport interface code ---------------------------------------- + + FNarea("Asm$$Code","CODE,READONLY") + +; --- tearSupport_init --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Initialises tearSupport + + FNexport("tearSupport_init") +.tearSupport_init + + stmfd r13!,{r0-r4,r12,r14} ;Save some registers + mvn r0,#0 ;Find address of TearSupport + swi "XOS_ChangeEnvironment" ;Find the address then + bvc tSupt_init10 ;If resident, skip install + + ; --- We need to set up the RMA block --- + +.tSupt_init00 ldr r3,ts__image ;Load RMA block size wanted + mov r0,#6 ;Allocate RMA space + swi "OS_Module" ;Try to allocate anyway + mov r1,r2 ;Keep pointer to RMA block + + ; --- Copy the program across and decrypt it --- + + adr r0,ts__image+4 ;Point to encrypted image + ldr r3,FNlitw(ts__imageEnd-ts__image-4) + ldr r12,FNlitw(&1b9a7f83) ;IV for decryption process + +.tSupt_init05 ldr r4,[r0],#4 ;Get a word from the image + eor r14,r12,r4,ror #24 ;Decrypt the word + str r14,[r2],#4 ;Store the word in the block + mov r12,r4 ;Update IV from ciphertext + subs r3,r3,#4 ;Decrement the size counter + bgt tSupt_init05 ;More to do -- loop + + ; --- Be friendly to StrongARM --- + ; + ; By spooky coincidence, these registers are set up already. + + mov r0,#1 ;Synchronise address range + sub r2,r2,#4 ;Because Acorn are weird... + swi XOS_SynchroniseCodeAreas ;Go and do that, please + + ; --- Initialise the image --- + + mov r14,pc ;Get return address + add pc,r1,#0 ;Call the initialise routine + str r1,ts__image ;Store base address away + ldmfd r13!,{r0-r4,r12,pc}^ ;Return to caller + + ; --- It's already resident --- + +.tSupt_init10 cmp r2,#ts_version ;Which version is in there? + strcs r1,ts__image ;New enough -- store base + ldmcsfd r13!,{r0-r4,r12,pc}^ ;And return to caller + + adr r0,ts__tooOld ;Point to error message + swi "OS_GenerateError" ;And raise merry hell + ldmfd r13!,{r0-r4,r12,pc}^ ;Return to caller + +.ts__tooOld dcd 1 + dcb "Tearoff support code is too old" + dcb 0 + + FNltorg + +; --- tearSupport_opened --- +; +; On entry; R0 == task handle of task which opened tearoff menu +; +; On exit; -- +; +; Use; Informs TearSupport that a transient tearoff menu has been +; opened, and which task owns the menu. + + FNexport("tearSupport_opened") +.tearSupport_opened + + stmfd r13!,{r12,r14} + ldr r12,ts__image + mov r14,pc + add pc,r12,#4 + ldmfd r13!,{r12,pc}^ + +; --- tearSupport_closed --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Informs TearSupport that a transient tearoff menu has been +; closed, and that support is no longer required for it. + + FNexport("tearSupport_closed") +.tearSupport_closed + + stmfd r13!,{r12,r14} + ldr r12,ts__image + mov r14,pc + add pc,r12,#8 + ldmfd r13!,{r12,pc}^ + +; --- tearSupport_switch --- +; +; On entry; R0 == 1 to disable, 0 to enable trapping +; +; On exit; -- +; +; Use; Enables or disables trapping of Wimp_CreateMenu while a +; transient tearoff menu is open. This is intended to allow +; use of Wimp_CreateMenu by the transient tearoff owner while +; a transient tearoff is open (e.g. to close Wimp menus). + + FNexport("tearSupport_switch") +.tearSupport_switch + + stmfd r13!,{r12,r14} + ldr r12,ts__image + mov r14,pc + add pc,r12,#12 + ldmfd r13!,{r12,pc}^ + +;----- The actual TearoffSupport code --------------------------------------- + +; --- Structure of the code --- +; +; Since this chunk is going to be copied into the RMA, we need to be able to +; interface with it. We stick a branch table on the beginning and encrypt +; everything else. + + FNnoReloc + +.ts__image dcd ts__wSize+ts__wSpace-ts__image-4 + b ts_init + b ts_opened + b ts_closed + b ts_switch + b ts_unload + +;----- Initialisation ------------------------------------------------------- + +; --- ts_init --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Initialises the TearSupport system. + +.ts_init stmfd r13!,{r0-r2,r14} ;Stack link register nicely + FNadrl (r12,ts__wSpace) ;Find workspace address + mov r0,#0 ;A nice 0 value + str r0,[r12,#ts_useCount] ;Stuff it in the usage count + str r0,[r12,#ts_owner] ;No task using me yet + strb r0,[r12,#ts_swiCaught] ;Remember we're not on SWIV + + mov r0,#ChangeEnvV ;Trap OS_ChangeEnvironment + adr r1,ts_changeEnv ;Point to my handler + mov r2,r12 ;Pass my workspace pointer + swi "XOS_Claim" ;Claim the vector nicely + + ; --- Read the OS version --- + + mov r0,#129 ;Load the OS version number + mov r1,#0 ;Set up OS_Byte arguments + mov r2,#255 ;For most obscure OS call + swi "OS_Byte" ;Read the version number + strb r1,[r12,#ts_osVersion] ;Save this away for later + + ; --- I think that's it --- + + ldmfd r13!,{r0-r2,pc}^ ;Return to caller happy + + FNltorg + +; --- ts_unload --- +; +; On entry; -- +; +; On exit; V clear if unloaded OK, otherwise V set +; +; Use; Attempts to remove TearSupt from memory, to replace it with +; a later version. If we can't close down, because we're in +; use, we return an error. + +.ts_unload bic r14,r14,#&10000000 ;Clear the V flag + stmfd r13!,{r0-r2,r14} ;Save some registers + FNadrl (r12,ts__wSpace) ;Find the workspace address + + ; --- Free all the vectors --- + + mov r0,#ChangeEnvV ;Trap OS_ChangeEnvironment + adr r1,ts_changeEnv ;Point to my handler + mov r2,r12 ;Pass my workspace pointer + swi "XOS_Release" ;Let go of that + + bl ts_closed ;Pretend the transient closed + + ; --- Deallocate my memory --- + ; + ; This is a bit tricky, because I'm in it. I have to + ; copy a bit of myself onto the stack, and call that. Yuk. + + adr r14,ts__return ;Point to return code + ldmia r14,{r0-r2} ;Load the code out + stmfd r13!,{r0-r2} ;Save it onto the stack + + adr r2,ts__image+4 ;Point to the block base + mov r0,#7 ;Deallocate an RMA block + mov pc,r13 ;Call return code + +.ts__return swi "OS_Module" ;Deallocate the memory + add r13,r13,#12 ;Point to stack frame + ldmfd r13!,{r0-r2,pc}^ ;Return without mishap + + FNltorg + +; --- Vector numbers --- +] +MouseV = &1A +InsV = &14 +ChangeEnvV = &1E +[ opt o + +; --- ts_opened --- +; +; On entry; R0 == task handle attempting to open tearoff transient +; +; On exit; -- +; +; Use; Informs the TearSupt system that a task is opening a +; transient tearoff menu. + + +.ts_opened stmfd r13!,{r0-r2,r11,r12,r14} + mov r11,r0 ;Look after the task handle + FNadrl (r12,ts__wSpace) ;Find my workspace address + + ; --- Make sure we need to do this --- + + ldr r0,[r12,#ts_useCount] ;Get the counter + cmp r0,#0 ;Am I currently running? + bne ts_opened00 ;Yes -- skip this little bit + + ; --- Claim event vector --- + + swi "XOS_Mouse" ;Get the current mouse pos + str r2,[r12,#ts_mouseState] ;Store it in workspace + + mov r0,#MouseV ;Vector number + adr r1,ts_mouse ;Point to event handler + mov r2,r12 ;Point to workspace + swi "XOS_Claim" ;Try it and see + + mov r0,#InsV ;Vector number + adr r1,ts_insert ;Point to event handler + mov r2,r12 ;Point to workspace + swi "XOS_Claim" ;Try it and see + + addvs r13,r13,#4 + ldmvsfd r13!,{r1,r2,r11,r12,pc} ;Can't see this failing, but + + bl ts_swiClaim + + ; --- Update my tables and leave --- + +.ts_opened00 ldr r0,[r12,#ts_owner] ;Who's using me at the mo? + cmp r0,r11 ;Is it someone else? + cmpne r0,#0 ;Make sure s'not a ghost + blne ts_escape_cb ;Tell the appl to close + str r11,[r12,#ts_owner] ;Store the new handle + + ldr r0,[r12,#ts_useCount] ;Find my usage counter + add r0,r0,#1 ;Bump it + str r0,[r12,#ts_useCount] ;And store it back for later + + ldmfd r13!,{r0-r2,r11,r12,pc}^ + + FNltorg + +; --- ts_closed --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Informs TearSupt that the transient tearoff has been closed. +; If no transient is open, no action is performed. + +.ts_closed stmfd r13!,{r12,r14} ;Save some registers + adr r12,ts__wSpace ;Find my workspace address + ldr r14,[r12,#ts_useCount] ;Find out my counter thing + cmp r14,#0 ;Is it zero? + ldmeqfd r13!,{r12,pc}^ ;Someone's being silly + subs r14,r14,#1 ;Decrement the counter + str r14,[r12,#ts_useCount] ;Store for later + ldmnefd r13!,{r12,pc}^ ;Return if still nonzero + + ; --- Remove handlers and things --- + + stmfd r13!,{r0-r2} ;Save some more registers + bl ts_swiRelease ;Release SWI vector patch + + mov r0,#InsV ;Vector number + adr r1,ts_insert ;Point to handler code + mov r2,r12 ;Point to workspace + swi "XOS_Release" ;Let go of the vector + + mov r0,#MouseV ;Vector number + adr r1,ts_mouse ;Point to handler code + mov r2,r12 ;Point to workspace + swi "XOS_Release" ;Let go of the vector + + ldmfd r13!,{r0-r2,r12,pc}^ ;Return to caller + + FNltorg + +; --- ts_switch --- +; +; On entry; R0 == 1 to suspend trapping, 0 to unsuspend +; +; On exit; -- +; +; Use; Enables or disables trapping of Wimp_CreateMenu, to enable +; TMS implementations to close Wimp menus where necessary. + +.ts_switch stmfd r13!,{r12,r14} ;Save some registers + adr r12,ts__wSpace ;Find my workspace + strb r0,[r12,#ts_swiThreaded] ;Disable the SWI patch + ldmfd r13!,{r12,pc}^ ;And return to caller + + FNltorg + +;----- The handlers and callbacks ------------------------------------------- + +; --- ts_changeEnv --- +; +; On entry; As for OS_ChangeEnvironment +; +; On exit; R0 == address of TearSupt, if R0 == -1 on entry +; +; Use; Traps odd calls to OS_ChangeEnvironment to allow TearSupt +; to be located. + +.ts_changeEnv cmn r0,#1 ;Is it our special env code? + adreq r1,ts__image+4 ;Yes -- return ptr to base + moveq r2,#ts_version ;And get the version number + ldmeqfd r13!,{pc}^ ;And claim the vector + movs pc,r14 ;Otherwise pass on vector + +; --- ts_insert --- +; +; On entry; R0 == byte inserted into buffer +; R1 == buffer number +; +; On exit; -- +; +; Use; Inspects all insertions into buffers, and traps attempts +; to insert escape keypresses, converting these to requests +; to close the current transient tearoff. + +.ts_insert cmp r0,#27 ;Make sure it's an escape + cmpeq r1,#0 ;And it's from the keyboard + movnes pc,r14 ;If not, give up and leave + stmfd r13!,{r14} ;Save a register + ldr r14,[r12,#ts_owner] ;Get my owner's ID + cmn r14,#1 ;Is it valid? + ldmeqfd r13!,{pc}^ ;No -- then return to caller + + ; --- Mess about with the processor status --- + + stmfd r13!,{r0,r1,r8} ;Store registers away + mov r8,pc ;Get PC with PSR + teqp pc,#3 ;Enter SVC mode + mov r0,r0 ;Avoid contention of R13/R14 + stmfd r13!,{r14} ;Stack return address + adr r0,ts_escape_cb ;Point to callback routine + mov r1,r12 ;Point to workspace + swi "XOS_AddCallBack" ;Add the callback routine + ldmfd r13!,{r14} ;Restore R14_svc + teqp r8,#0 ;Restore old PSR values + mov r0,r0 ;No-op to keep ARM happy + ldmfd r13!,{r0,r1,r8,pc}^ ;Return to caller + + FNltorg + +; --- ts_mouse --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Inspects all mouse positions returned by OS_Mouse, and sends +; them to the current transient owner. + +.ts_mouse stmfd r13!,{r10-r12,r14} ;Stack some registers + + ; --- Pass on the vector, leaving ourself on the stack --- + ; + ; Modified from Acorn's code to avoid dependency on + ; possibly non-compatible PC+12 behaviour. + + mov r14,pc ;Get current program counter + add r14,r14,#12 ;Point at our processing code + stmfd r13!,{r14} ;Make us get called back + add r12,r13,#4 ;Point to saved R10 on stack + ldmia r12,{r10-r12,pc} ;Call next routine on vector + + ; --- The vector has now completed nicely --- + + ldr r12,[r13,#8] ;Get my stacked r12 + + stmfd r13!,{r0-r3} ;Stack some registers for me + ldr r0,[r12,#ts_mouseState] ;Get old mouse state + str r2,[r12,#ts_mouseState] ;Store as the old state + bics r2,r2,r0 ;Find out what changed + ldmeqfd r13!,{r0-r3,r10-r12,r14,pc} ;If nothing then return + + ; --- A button was clicked -- tell our client --- + + add r1,r12,#ts_message+20 ;Point to message buffer + swi "XWimp_GetPointerInfo" ;Get pointer info + sub r1,r1,#20 ;Point to base of message + mov r0,#40 ;Length of message + str r0,[r1,#0] ;Store in message block + mov r0,#0 ;This isn't a reply + str r0,[r1,#12] ;So zero the your_ref + ldr r0,FNlitw(&4A340) ;The magic message number + str r0,[r1,#16] ;Fill it in + mov r0,#17 ;Don't want it bouncing + ldr r2,[r12,#ts_owner] ;Find my owner application + swi "XWimp_SendMessage" ;Send it the message + + ldmfd r13!,{r0-r3,r10-r12,r14,pc} ;We're a happy bunny + + FNltorg + +; --- ts_escape_cb --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Sends a message to the transient tearoff owner, to tell +; it to close the transient. This is usually as a result of +; the user pressing escape or another task calling +; Wimp_CreateMenu. + +.ts_escape_cb stmfd r13!,{r0-r3,r14} ;Save some registers + add r1,r12,#ts_message ;Point to message buffer + mov r0,#20 ;Length of message + str r0,[r1,#0] ;Store in message block + mov r0,#0 ;This isn't a reply + str r0,[r1,#12] ;So zero the your_ref + ldr r0,FNlitw(&4A341) ;The magic message number + str r0,[r1,#16] ;Fill it in + mov r0,#17 ;Don't want it bouncing + ldr r2,[r12,#ts_owner] ;Find my owner application + swi "XWimp_SendMessage" ;Send it the message + mvn r0,#0 ;Stop it happening again + str r0,[r12,#ts_owner] ;Won't happen now! + ldmfd r13!,{r0-r3,pc}^ ;Don't worry. Be happy. + + FNltorg + +;----- SWI vector handling -------------------------------------------------- +; +; Warning; this section contains some really heavy stuff. If you're nervous, +; you may wish to seek medical advice before looking at this code. We can't +; accept any responsibility for any loss or disability incurred as a result +; of reading this source. + +; --- ts_swiClaim --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Sets up the SWI vector patch. + +.ts_swiClaim stmfd r13!,{r0-r3,r14} ;Stack some registers + ldrb r0,[r12,#ts_swiCaught] ;Have we done it already? + cmp r0,#0 ;Just check + ldmnefd r13!,{r0-r3,pc}^ ;If so, just carry on + + ldrb r14,[r12,#ts_osVersion] ;Get the OS version + cmp r14,#&a5 ;Is this a RISC PC? + bcs ts_swiClaim50 ;Yes -- do special things + + mov r0,#0 ;Point to hardware vectors + ldr r1,[r0,#&08] ;Get the SWIV instruction + str r1,[r12,#ts_oldSWIinstr] ;Remember this instruction + and r2,r1,#&0F000000 ;Get the basic instruction + cmp r2,#&0A000000 ;Is it a branch? + beq ts_swiClaim00 ;Yes -- handle that + + ; --- Mangle an LDR PC,[PC,#...] --- + + ldr r2,FNlitw(&FFF) ;Mask off LDR bits + and r2,r1,r2 ;Get the offset of LDR + tst r1,#1<<23 ;Check the sign bit + addne r3,r2,#&10 ;If additive, then add offset + rsbeq r3,r2,#&10 ;If subtractive, subtract ;-) + str r3,[r12,#ts_oldSWIaddr] ;Store this address away + b ts_swiClaim01 ;Now insert our branch code + + ; --- Mangle a B ... --- + +.ts_swiClaim00 bic r2,r1,#&FF000000 ;Clear instruction bits + add r2,r2,#4 ;Take pipeline into account + mov r2,r2,lsl #2 ;Word align the result + bic r2,r2,#&FC000003 ;Turn it into a real address + str r2,[r12,#ts_dummySWIptr] ;Store this in our pointer + add r3,r12,#ts_dummySWIptr ;Point to this pointer + str r3,[r12,#ts_oldSWIaddr] ;Store *this* address away + + ; --- Now insert our own instruction --- + +.ts_swiClaim01 adr r1,ts_swiClaimer ;Point to the routine + mov r1,r1,lsr #2 ;Shift off bottom zero bits + sub r1,r1,#4 ;Adjust the address of branch + orr r1,r1,#&EA000000 ;Make it a branch instr + str r1,[r12,#ts_newSWIinstr] ;Store this new instruction + swi "OS_EnterOS" ;We're messing with SWI vect + str r1,[r0,#8] ;This is now the SWI vector + teqp pc,#0 ;Back to user mode + mov r0,r0 ;No-op for strange reasons + mov r0,#1 ;We've now patched SWIV + strb r0,[r12,#ts_swiCaught] ;So remember this + mov r0,#0 ;Not yet threaded, though + strb r0,[r12,#ts_swiThreaded] + ldmfd r13!,{r0-r3,pc}^ ;Return to caller + + ; --- We have an OS call to do this --- + +.ts_swiClaim50 mov r0,#2 ;Claim SWI vector + orr r0,r0,#256 ;Set the `claim' flag + adr r1,ts_swi610 ;Point to handler routine + swi "XOS_IntOff" ;Stop all SWIs for a bit + swi XOS_ClaimProcessorVector + str r1,[r12,#ts_dummySWIptr] ;Save old handler address + add r3,r12,#ts_dummySWIptr ;Point to this pointer + str r3,[r12,#ts_oldSWIaddr] ;And store *this* address + swi "XOS_IntOn" ;We can handle SWIs again now + + mov r0,#1 ;We've now patched SWIV + strb r0,[r12,#ts_swiCaught] ;So remember this + mov r0,#0 ;Not yet threaded, though + strb r0,[r12,#ts_swiThreaded] + + ldmfd r13!,{r0-r3,pc}^ ;Return to caller + + FNltorg + +; --- ts_swiRelease --- +; +; On entry; -- +; +; On exit; CS if patch removed OK, else CC +; +; Use; Attempts to remove the SWI vector patch. If this can't be +; done, then the patch is left in. + +.ts_swiRelease stmfd r13!,{r0-r2,r14} ;Stack registers + ldrb r0,[r12,#ts_swiCaught] ;Is the vector trapped? + cmp r0,#0 ;Quick check... + ldmeqfd r13!,{r0-r2,pc}^ ;No -- return then + + ; --- Check if this is a RISC PC --- + + ldrb r0,[r12,#ts_osVersion] ;Load the OS version + cmp r0,#&a5 ;Is this a RISC PC + bcs ts_swiRel50 ;Yes -- do different things + + mov r0,#0 ;Point to hardware vectors + ldr r1,[r0,#8] ;Get SWI vector instruction + ldr r2,[r12,#ts_newSWIinstr] ;Get our one + cmp r1,r2 ;Are they the same? + bne ts_swiRel90 ;No -- couldn't reset it + + ldr r1,[r12,#ts_oldSWIinstr] ;Get the old version then + swi "OS_EnterOS" ;We're messing with SWI vect + str r1,[r0,#8] ;Reinstate the old vector + teqp pc,#0 ;Back to user mode + mov r0,r0 ;Wait for things to settle + strb r0,[r12,#ts_swiCaught] ;SWIV no longer patched + ldmfd r13!,{r0-r2,r14} ;Return to caller + orrs pc,r14,#1<<29 ;Setting C to say *YES* + + ; --- Release SWI vector using OS call --- + +.ts_swiRel50 mov r0,#2 ;Releasing the SWI vector + ldr r1,[r12,#ts_dummySWIptr] ;Load address of old claimer + adr r2,ts_swi610 ;Point to expected handler + swi XOS_ClaimProcessorVector + bvs ts_swiRel90 ;Error -- couldn't do it + + mov r14,#0 ;Clear claimed flag + strb r14,[r12,#ts_swiCaught] ;SWIV no longer patched + ldmfd r13!,{r0-r2,r14} ;Return to caller + orrs pc,r14,#1<<29 ;Setting C to say *YES* + + ; --- Couldn't do it --- + +.ts_swiRel90 ldmfd r13!,{r0-r2,r14} ;Restore registers + bics pc,r14,#1<<29 ;But clear C on exit + + FNltorg + +; --- ts_swi610 --- +; +; On entry; R0-R8 == arguments to SWI +; R9-R12 == random values from the OS +; R13 == supervisor stack pointer +; R14 == return address from client +; +; On exit; R0-R8 == returned from SWI +; R9-R13 *AND SPSR_svc* preserved +; +; Use; Intercepts all SWI calls in the system, catching +; Wimp_CreateMenus and informing the transient owner of them. + +.ts_swi610 stmfd r13!,{r10-r12,r14,pc} ;Stack some registers + + ; --- Move into 26 bit mode --- + + dcd &e14fb000 ;mrs r11,spsr_all + stmfd r13!,{r11} ;Save this on the stack + and r12,r11,#&f0000003 ;Get the processor status + orr r14,r14,r12 ;Add it to the R14 value + and r12,r11,#&c0 ;Get the interrupt flags + orr r14,r14,r12,lsl #20 ;Put them into R14 too + dcd &e10fb000 ;mrs r11,cpsr_all + bic r11,r11,#&1f ;Clear all the mode bits + orr r11,r11,#&03 ;Set SVC_26 + dcd &e129f00b ;msr cpsr_all,r11 + + ; --- Now find out about the SWI --- + + adr r12,ts__wSpace ;Point to workspace pointer + ldrb r10,[r12,#ts_swiThreaded] ;Is this routine threaded? + cmp r10,#0 ;Check now, or forever... + bne ts_swi610_00 ;If so, skip onwards + bic r10,r14,#&FC000003 ;Mask off saved PSR bits + ldr r11,[r10,#-4] ;Get SWI instruction + ldr r10,FNlitw(&FFF20000) ;Mask off silly SWI bits + bic r11,r11,r10 ;Get the pure SWI number + ldr r10,FNlitw(FNswiNum("Wimp_CreateMenu")) + cmp r10,r11 ;See if it's interesting + beq ts_swi610_10 ;Yes -- process it nicely + +.ts_swi610_00 ldmfd r13!,{r14} ;Load the saved SPSR + dcd &e169f00e ;msr spsr_all,r14 + + ldr r14,[r12,#ts_oldSWIaddr] ;Point to old pointer + ldr r14,[r14,#0] ;Dereference the pointer + str r14,[r13,#16] ;Overwrite PC on the stack + ldmfd r13!,{r10-r12,r14,pc} ;Pass on to real SWI routine + + ; --- Wimp_CreateMenu handling --- + +.ts_swi610_10 mov r10,#1 ;Set the threaded flag + strb r10,[r12,#ts_swiThreaded] ;Remember we're in here + + bl ts_escape_cb ;Send out the close message + +.ts_swi610_01 mov r10,#0 ;Not threaded any more + strb r10,[r12,#ts_swiThreaded] ;Store this for others + b ts_swi610_00 ;And continue main thread + + FNltorg + +; --- ts_swiClaimer --- +; +; On entry; R0-R8 == arguments to SWI +; R9-R12 == random values from the OS +; R13 == supervisor stack pointer +; R14 == return address from client +; +; On exit; R0-R8 == returned from SWI +; R9-R13 preserved +; +; Use; Intercepts all SWI calls in the system, catching +; Wimp_CreateMenus and informing the transient owner of them. + +.ts_swiClaimer stmfd r13!,{r10-r12,r14,pc} ;Stack some registers + adr r12,ts__wSpace ;Point to workspace pointer + ldrb r10,[r12,#ts_swiThreaded] ;Is this routine threaded? + cmp r10,#0 ;Check now, or forever... + bne ts_swiClaimer00 ;If so, skip onwards + bic r10,r14,#&FC000003 ;Mask off saved PSR bits + ldr r11,[r10,#-4] ;Get SWI instruction + ldr r10,FNlitw(&FFF20000) ;Mask off silly SWI bits + bic r11,r11,r10 ;Get the pure SWI number + ldr r10,FNlitw(FNswiNum("Wimp_CreateMenu")) + cmp r10,r11 ;See if it's interesting + beq ts_swiClaimer10 ;Yes -- process it nicely + +.ts_swiClaimer00 + ldr r14,[r12,#ts_oldSWIaddr] ;Point to old pointer + ldr r14,[r14,#0] ;Dereference the pointer + str r14,[r13,#16] ;Overwrite PC on the stack + ldmfd r13!,{r10-r12,r14,pc} ;Pass on to real SWI routine + + ; --- Wimp_CreateMenu handling --- + +.ts_swiClaimer10 + mov r10,#1 ;Set the threaded flag + strb r10,[r12,#ts_swiThreaded] ;Remember we're in here + + bl ts_escape_cb ;Send out the close message + +.ts_swiClaimer01 + mov r10,#0 ;Not threaded any more + strb r10,[r12,#ts_swiThreaded] ;Store this for others + b ts_swiClaimer00 ;And continue main thread + + FNltorg + +.ts__wSpace +.ts__imageEnd +] + + PROCws_start +ts_useCount =FNws_word +ts_owner =FNws_word +ts_mouseState =FNws_word +ts_newMouse =FNws_word +ts_oldSWIaddr =FNws_word +ts_dummySWIptr =FNws_word +ts_oldSWIinstr =FNws_word +ts_newSWIinstr =FNws_word +ts_swiCaught =FNws_byte +ts_swiThreaded =FNws_byte +ts_osVersion =FNws_byte + PROCws_align +ts_message =FNws (40) +ts__wSize =FNws (0) + +NEXT + +PRINT '"Encrypting..."; + +REM --- Encrypt the RMA resident section --- + +iv%=&1b9a7f83 +FOR i%=ts__image+4 TO ts__imageEnd STEP 4 + x%=i%!(O%-P%) EOR iv% + x%=(x%>>>8) OR (x%<<24) + i%!(O%-P%)=x% + iv%=x% +NEXT + +PRINT '"Saving..."; +PROCbas_aofSave +PRINT '"Done" +END + +DEF FNswiNum(swi$) +LOCAL swin% +SYS "OS_SWINumberFromString",,swi$ TO swin% +=swin% + diff --git a/StraySrc/Libraries/Sapphire/bs/fixedPt.bas b/StraySrc/Libraries/Sapphire/bs/fixedPt.bas new file mode 100644 index 0000000..29917b1 --- /dev/null +++ b/StraySrc/Libraries/Sapphire/bs/fixedPt.bas @@ -0,0 +1,451 @@ +REM +REM fixedPt.bs +REM +REM Table-based trig functions +REM +REM © 1995-1998 Straylight +REM + +REM ----- Licensing note ---------------------------------------------------- +REM +REM This file is part of Straylight's Sapphire library. +REM +REM Sapphire is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM Sapphire is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with Sapphire. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +REM --- How the table works --- +REM +REM We represent a number in 16.16 fixed point. We set up a table of +REM arctan values for values of x between 0 and 1. All the others may be +REM calculated from this, hopefully. Certainly, this is enough for +REM calculating polar angles, which is the really interesting bit. +REM +REM For niceness purposes, the values are actually stored in degrees, rather +REM than radians. Division by 360 isn't a major difficulty, so it's not +REM hard to convert back again. + +REM --- Set up some variables --- + +ON ERROR ERROR 0,REPORT$+" ["+STR$(ERL)+"]" +bas%=TRUE :REM Generate BAS code +bas%=bas% + +REM --- BAS library --- + +IF bas% THEN + LIBRARY "libs:bas" + PROCbas_init +ENDIF + +REM --- A little bit of test code --- + +IF bas% THEN + PROCbas_aofInit(&10000) + o_base%=4 + o_lim%=6 +ELSE + DIM code% 10240 + o_base%=0 + o_lim%=2 +ENDIF + +REM --- General parameters --- + +scalebits% = 16 :REM Avoiding tweaking this: it's part of the interface +scale% = 1 << scalebits% + +REM --- Parameters for the tan table -- + +atn_tblbits% = 7 :REM TWEAK ME! +atn_entries% = 1 << atn_tblbits% +atn_shift% = scalebits% - atn_tblbits% +atn_revshift% = 32 - atn_shift% +atn_interpoff% = 1 << (atn_shift% - 1) + +REM --- Parameters for the sin table --- + +sin_tblbits% = 6 :REM TWEAK ME! sin_tblbits may be at most 8 +sin_entries% = 1 << sin_tblbits% +sin_shift% = 30 - sin_tblbits% +sin_modmask% = (sin_entries% - 1) << sin_shift% +sin_interpoff% = 1 << (sin_shift% - 1) + +REM --- Start the assembly --- + +FOR o%=o_base% TO o_lim% STEP 2 :REM Standard two-pass assembly loop + IF bas%=0 THEN P%=code% :REM Start generating code in buffer + + IF bas% THEN + [ OPT o% + FNpass + + FNarea("Sapphire$$Code","CODE,READONLY") + + FNimport("div_unsigned") + FNimport("div_u64x32") + ] + ENDIF + + [ OPT o% :REM Start assembly + + ; --- arctan --- + ; + ; On entry R0 == x, in 16.16 fixed point form + ; + ; On exit R0 == arctan x, in degrees, in 16.16 fixed point + ; + ; Use Calculates arctan x, hopefully fairly swiftly. The + ; accuracy of the result is open to doubt, although + ; it's usually good to about 3 significant figures. + ; It uses a small lookup table and linear interpolation + ; to calculate the result. + + .arctan STMFD R13!,{R1-R3,R14} ;Save some work registers + + ; --- Set some initial things up --- + + MOV R3,#0 ;Clear out my flags register + + ; --- Now sort out the argument --- + + CMP R0,#0 ;Is the argument negative? + ORRLT R3,R3,#1 ;Yes -- set the `negative' bit + RSBLT R0,R0,#0 ;And make the argument positive + + CMP R0,#scale% ;Is the argument bigger than 1? + BLE atn_skip ;No; skip ahead a bit + + ORR R3,R3,#2 ;Set the `reciprocal' bit + ] + IF scalebits% < 16 THEN + [ OPT o% + MOV R1,R0 ;Stand by to do some division + MOV R0,#1 << (scalebits% * 2) + BL div_unsigned + ] + ELSE + [ OPT o% + MOV R2,R0 ;Stand by to do some division + MOV R0,#0 + MOV R1,#1 << (scalebits% * 2 - 32) + BL div_u64x32 + ] + ENDIF + [ OPT o% + + ; --- Look up the arctan value --- + + .atn_skip ADR R14,atn_table ;Load the address of the table + MOV R1,R0,LSL #atn_revshift% ;Get bottom bits in R1 + MOV R1,R1,LSR #atn_revshift% ;Shift back to bit 0 + MOV R0,R0,LSR #atn_shift% ;Get the table index + ADD R14,R14,R0,LSL #2 ;Get the address of the item + LDR R2,[R14,#0] ;Locate the lower entry and load + LDR R0,[R14,#4] ;Locate the upper entry and load + SUB R0,R0,R2 ;Get the difference between them + MUL R0,R1,R0 ;Multiply this by the x offset + ADD R0,R0,#atn_interpoff% ;Round to nearest + ADD R0,R2,R0,LSR #atn_shift% ;Do interpolation + + ; --- Now postprocess this result nicely --- + + TST R3,#2 ;Did I have to reciprocal it? + RSBNE R0,R0,#90*scale% ;Yes -- work out the correct one + TST R3,#1 ;Did I have to negate the value? + RSBNE R0,R0,#0 ;Yes -- negate the result + + LDMFD R13!,{R1-R3,PC}^ ;Return to caller + + ; --- pol --- + ; + ; On entry R0 == x coordinate + ; R1 == y coordinate + ; + ; On exit R0 == angle in degrees, in 16.16 form + ; + ; Use Calculates the angle a vector makes with the +ve x axis. + ; The angle is given in degrees, rather than radians, + ; although this isn't really overly significant, it just + ; makes it slightly easier to work with, because it's + ; bigger. + ; + ; This routine uses the arctan table and linear + ; interpolation, so it's fairly quick, but the accuracy + ; of its results is questionable. + + .pol STMFD R13!,{R1-R3,R14} ;Save some registers away + MOV R3,#0 ;Clear out my status flags + + ; --- Preprocess the arguments --- + + CMP R0,#0 ;Is x less than zero? + RSBLT R0,R0,#0 ;Yes -- make it positive + ORRLT R3,R3,#1 ;And remember that we did this + + CMP R1,#0 ;Is y less than zero? + RSBLT R1,R1,#0 ;Yes -- make it positive + ORRLT R3,R3,#2 ;And remember we did this + + CMP R0,R1 ;Is x bigger than y? + EORGT R0,R0,R1 ;Yes -- then swap them round + EORGT R1,R0,R1 + EORGT R0,R0,R1 + ORRGT R3,R3,#4 ;And remember we did this + + ; --- Handle silly case where point is at (0,0) --- + + CMP R1,#0 ;Are we about to divide by 0? + LDMEQFD R13!,{R1-R3,PC}^ ;Yes -- return now -- R0 is 0 + + ; --- Now work out arctan(R0/R1) --- + + MOV R2,R1 ;Get the divisor + MOV R1,R0,LSR #32 - scalebits% ;Sort out dividend + MOV R0,R0,LSL #scalebits% + BL div_u64x32 ;Work out the ratio nicely + + ADR R14,atn_table ;Load the address of the table + MOV R1,R0,LSL #atn_revshift% ;Get bottom bits in R1 + MOV R1,R1,LSR #atn_revshift% ;Shift back to bit 0 + MOV R0,R0,LSR #atn_shift% ;Get correct table index + ADD R14,R14,R0,LSL #2 ;Get the address of the item + LDR R2,[R14,#0] ;Locate the lower entry and load + LDR R0,[R14,#4] ;Locate the upper entry and load + SUB R0,R0,R2 ;Get the difference between them + MUL R0,R1,R0 ;Multiply this by the x offset + ADD R0,R0,#atn_interpoff% ;Just round to nearest + ADD R0,R2,R0,LSR #atn_shift% ;And add to the base + + ; --- arctan is now in R0 -- process it for angle --- + + TST R3,#4 ;Did we swap x and y round? + RSBEQ R0,R0,#90*scale% ;No -- compensate for this + TST R3,#1 ;Was x negative? + RSBNE R0,R0,#180*scale% ;Yes -- push it to left side + TST R3,#2 ;Was y negative? + RSBNE R0,R0,#360*scale% ;Yes -- push it to bottom + + LDMFD R13!,{R1-R3,PC}^ ;Return to caller + + ; --- arctan table --- + + .atn_table + ] + + FOR i%=0 TO atn_entries% :REM Go through each index value + a=DEG ATN(i%/atn_entries%) :REM Calculate the arctan value + [opt o%:dcd a*scale%:] :REM Store it in the table nicely + NEXT + + [ OPT o% + + ; --- sin --- + ; + ; On entry R0 == angle in degrees, in 16.16 form + ; + ; On exit R0 == sin of angle, in 16.16 form + ; + ; Use Calculates a sin of an angle with a degree of swiftness + ; and a lot less accuracy. + + .cos RSB R0,R0,#90*scale% + + .sin STMFD R13!,{R1-R3,R14} ;Save a job load of registers + + ; --- How it all works --- + ; + ; Having angles in degrees imposes inconvenient units + ; on use, forcing us to do all sorts of horrible things + ; with division by 360. + ; + ; Hence, we translate the degree units into nice things + ; which represent a right angle as a power of two, + ; say 2^16. + + MOV R1,R0,LSR #26 ;Keep the top half somewhere + MOV R0,R0,LSL #6 ;Shift up so as not to lose + MOV R2,#45 ;Divide by 360 to translate units + BL div_u64x32 ;Now we have Internal Angle Units + MOV R0,R0,LSL #32 - 9 - scalebits% + ;Shift extra revolutions off + + ; --- Now fix it into the first quadrant --- + + AND R3,R0,#&C0000000 ;Get quadrant number in R3 + BIC R0,R0,#&C0000000 ;And angle within quadrant here + TST R3,#&40000000 ;Is it on the left hand side? + RSBNE R0,R0,#&40000000 ;Yes; reflect across the circle + + ; --- Look up the angle in the table --- + + BIC R2,R0,#sin_modmask% ;Get remainder for interp + MOV R0,R0,LSR #sin_shift% ;Convert to a nice index + ADR R14,sin_table ;Find the sin table + ADD R14,R14,R0,LSL #2 ;Find the item to read + LDR R1,[R14,#0] ;Load the lower entry + LDR R0,[R14,#4] ;Load the upper entry too + SUB R0,R0,R1 ;Get the difference out + MUL R0,R2,R0 ;Multiply this by the x offset + ADD R0,R0,#sin_interpoff% ;Add on for rounding + ADD R0,R1,R0,LSR #sin_shift% ;Do linear interp + + ; --- Now postprocess as usual --- + + TST R3,#&80000000 ;Are we down at the bottom there? + RSBNE R0,R0,#0 ;Yes -- negate the sin value + + LDMFD R13!,{R1-R3,PC}^ + + ; --- sin table --- + + .sin_table + ] + + FOR i%=0 TO sin_entries% :REM Go through each index value + index=RAD(i%*90/sin_entries%) :REM Convert to a value in radians + [opt o%:dcd SIN(index)*scale%:] :REM Fill in the sin value nicely + NEXT + + IF bas% THEN + [ opt o% + FNexportAs("arctan","fxp_atan") + FNexportAs("pol","fxp_pol") + FNexportAs("sin","fxp_sin") + FNexportAs("cos","fxp_cos") + ] + ELSE + [ OPT o% + + ; --- divide --- + ; + ; On entry R0 == dividend + ; R1 == divisor + ; + ; On exit R0 == quotient + ; R1 == remainder + ; + ; Use Divides on number by another in a vaguely slow way + + .divide CMP R1,#0 ;Is this a division by zero? + MOVEQ PC,#0 ;Yes -- cause an exception + STMFD R13!,{R2,R14} ;Save some working registers + + ; --- Multiply up the divisor --- + + MOV R14,R1 ;Take a copy of the divisor + CMP R14,R0,LSR #1 ;Is this almost big enough? + .a MOVLS R14,R14,LSL #1 ;No -- shift the divisor up + CMP R14,R0,LSR #1 ;Is this almost big enough? + BLS a ;No -- loop round again + + ; --- Now we can start dividing properly --- + + MOV R2,#0 ;Start the quotient at 0 + .a CMP R0,R14 ;Can we divide here? + SUBCS R0,R0,R14 ;Yes -- subtract the divisor + ADC R2,R2,R2 ;Add with carry nicely + MOV R14,R14,LSR #1 ;Shift divisor back down + CMP R14,R1 ;Have we finished this loop? + BCS a ;And go round again + + ; --- Set up the return values --- + + MOV R1,R0 ;Return remainder in R1 + MOV R0,R2 ;Return quotient in R2 + LDMFD R13!,{R2,PC}^ ;Return to caller + + ; --- div_u64x32 --- + ; + ; On entry R0,R1 = dividend + ; R2 = divisor + ; + ; On exit R0 = quotient + ; R1 = remainder + ; + ; Use Does long division. + + .div_u64x32 STMFD R13!,{R14} + MOV R14,#8 + .a + ] + FOR i% = 1 TO 4 + [ OPT o% + CMP R1,R2 + SUBCS R1,R1,R2 + ADCS R0,R0,R0 + ADC R1,R1,R1 + ] + NEXT + [ OPT o% + SUBS R14,R14,#1 + BGT a + CMP R1,R2 + SUBCS R1,R1,R2 + ADCS R0,R0,R0 + LDMFD R13!,{PC}^ + + .testpol stmfd r13!,{r14} + bl pol + str r0,result + ldmfd r13!,{pc}^ + + .testatn stmfd r13!,{r14} + bl arctan + str r0,result + ldmfd r13!,{pc}^ + + .testsin stmfd r13!,{r14} + bl sin + str r0,result + ldmfd r13!,{pc}^ + + .result dcd 0 + + ] :REM End assembly + ENDIF + +NEXT :REM End current pass + +IF bas% THEN + PROCbas_aofSave +ELSE + + REM --- Test the divide routine --- + + REPEAT :REM Go into a nice loop + INPUT a$, A, B :REM Read the divide arguments + A%=A*scale% + B%=B*scale% + CASE a$ OF + WHEN "sin": CALL testsin: r=SINRAD(A) + WHEN "atn": CALL testatn: r=DEGATN(A) + WHEN "pol": CALL testpol: r=DEGFNpol(A, B) + OTHERWISE: PRINT "wtf?" + ENDCASE + PRINT !result/scale%'r + UNTIL FALSE :REM Keep on looping until bored + +ENDIF +END + +DEF FNpol(x,y) +LOCAL a + +IF x=0 THEN a=PI/2 ELSE a=ATN(ABS(y/x)) +IF y<0 THEN + IF x<0 THEN a=PI+a ELSE a=2*PI-a +ELSE + IF x<0 THEN a=PI-a +ENDIF +=a diff --git a/StraySrc/Libraries/Sapphire/bsh/banner.bas b/StraySrc/Libraries/Sapphire/bsh/banner.bas new file mode 100644 index 0000000..2e31777 --- /dev/null +++ b/StraySrc/Libraries/Sapphire/bsh/banner.bas @@ -0,0 +1,46 @@ +REM Sapphire banner macro library -- © 1995 Straylight + +DEF FNbanner_test=0 + +DEF FNbanner +[ opt 4 + FNalign +.bnr__l + dcd 0 +] +=0 + +DEF FNbnr__f(f%) +IF !(bnr__l+O%-P%)>=f% THEN ERROR 1,"Banner flags built in wrong order" +!(bnr__l+O%-P%)=!(bnr__l+O%-P%) OR f% +=0 + +DEF FNbanner_slider(i%) +[ opt 4 + FNbnr__f(bFlag_slider) + dcd i% +] +=0 + +DEF FNbanner_count(i%) +[ opt 4 + FNbnr__f(bFlag_counter) + dcd i% +] +=0 + +DEF FNbanner_setup(r%) +[ opt 4 + FNbnr__f(bFlag_setup) + dcd r% +] +=0 + +DEF FNbanner_sprites(s$) +[ opt 4 + FNbnr__f(bFlag_sprites) + equs s$+CHR$(0) + FNalign +] + +DEF FNbanner_end=FNalign diff --git a/StraySrc/Libraries/Sapphire/bsh/dbx.bas b/StraySrc/Libraries/Sapphire/bsh/dbx.bas new file mode 100644 index 0000000..43c5639 --- /dev/null +++ b/StraySrc/Libraries/Sapphire/bsh/dbx.bas @@ -0,0 +1,75 @@ +REM Sapphire dbx macro library -- © 1994 Straylight + +DEF FNdbx_test=0 + +DEF FNdbx_ctrl(i%,c%,b%,f%,d%) +IF b%=12 THEN f%=f% OR dbxFlag_dataR12 +IF b%=10 THEN f%=f% OR dbxFlag_dataR10 +[ opt 4 +.dbx__l + dcd i% + dcd c% + dcd f% + dcd 0 +] +IF f% AND 3 THEN [opt 4:dcd d%:] +=0 + +DEF FNdbx_ectrl +!(dbx__l+12+O%-P%)=P%-dbx__l +=0 + +DEF FNdbx_end +[ opt 4 + dcd -1 +] +=0 + +DEF FNarrow(i%,n%) +[ opt 4 + FNimport("arrow") + FNdbx_ctrl(i%,arrow,0,0,0) + dcd n% + FNdbx_ectrl +] +=0 + +DEF FNfileIcon(i%,b%,d%) +[ opt 4 + FNimport("fileIcon") + FNdbx_ctrl(i%,fileIcon,b%,0,d%) + FNdbx_ectrl +] +=0 + +DEF FNnumWrite(i%,n%,x%) +[ opt 4 + FNimport("numWrite") + FNdbx_ctrl(i%,fileIcon,0,0,0) + dcd n% + dcd x% + FNdbx_ectrl +] +=0 + +DEF FNslider(i%,b%,d%,f%,m%,n%,o%,x%) +[ opt 4 + FNimport("slider") + FNdbx_ctrl(i%,slider,b%,f%,d%) + dcb m% + dcb n% + dcb o% + FNalign + dcd x% + FNdbx_ectrl +] +=0 + +DEF FNcolourPot(i%,b%,d%,f%,t$) +[ opt 4 + FNimport("colourPot") + FNdbx_ctrl(i%,colourPot,b%,f%,d%) + equs t$+CHR$(0) + FNdbx_ectrl +] +=0 diff --git a/StraySrc/Libraries/Sapphire/bsh/flex.bas b/StraySrc/Libraries/Sapphire/bsh/flex.bas new file mode 100644 index 0000000..9602136 --- /dev/null +++ b/StraySrc/Libraries/Sapphire/bsh/flex.bas @@ -0,0 +1,62 @@ +REM Sapphire flex macro library -- © 1994 Straylight + +DEF FNflex_test=0 + +REM --- Support functions --- + +DEF FNflex__m(mask$) +LOCAL reg$,sep$,mask%,r%,s%,i% +mask%=0 +WHILE FNflex__g(mask$,reg$,sep$) + IF reg$="" THEN ERROR 1,"Expected register, found `"+sep$+"'" + r%=EVAL(reg$) + IF sep$="-" THEN + IF FNflex__g(mask$,reg$,sep$) THEN + IF reg$="" THEN ERROR 1,"Expected register, found `"+sep$+"'" + IF sep$="-" THEN ERROR 1,"Unexpected `-' in register list" + s%=EVAL(reg$) + IF s%>1 +ENDWHILE +[ opt 4 + dcd (o%<<5) OR (m%) +] +=m% + +DEF FNmenu__s(f%) +IF (!(menu__l+O%-P%) AND &FFFF) >= (f% AND &FFFF) AND (f% AND &FFFF)<>0 THEN ERROR 0,"Flags built in wrong order in menuDefs" +!(menu__l+O%-P%)=!(menu__l+O%-P%) OR f% +=0 + +DEF FNmenu__n +[ opt 4 + FNalign +.menu__l + dcd 0 +] +=0 + +DEF FNmenu__1(f%,a%) +[ opt 4 + FNmenu__s(f%) + dcd a% +] +=0 + +DEF FNmenu__2(f%,a%,b%) +[ opt 4 + FNmenu__s(f%) + dcd a% + dcd b% +] +=0 + +DEF FNmenu__ob(f%,o%,b%) +[ opt 4 + FNmenu__s(f%) + FNmenu__b(o%,b%) +] +=0 + +REM --- Creating menu headers --- + +DEF FNmenu(t$) +[ opt 4 + FNmenu__n + dcb t$+CHR$(0) + FNalign +] +=0 + +DEF FNmenu_ind(t%) +[ opt 4 + FNmenu__n + FNmenu__s(mFlag_indirect) + dcd t% +] +=0 + +DEF FNtearoff(t$) +[ opt 4 + FNmenu__n + FNmenu__s(mFlag_tearoff) + dcb t$+CHR$(0) + FNalign +] +=0 + +DEF FNtearoff_ind(t%) +[ opt 4 + FNmenu__n + FNmenu__s(mFlag_indirect) + FNmenu__s(mFlag_tearoff) + dcd t% +] +=0 + +REM --- Flags for menus and items --- + +DEF FNmenu_r12Data=FNmenu__s(mFlag_R12) + +DEF FNmenu_makeMe(p%)=FNmenu__1(mFlag_makeMe,p%) + +DEF FNmenu_mHeight(h%)=FNmenu__1(mFlag_maxHeight,h%) + +REM --- Menu items --- + +DEF FNmenu_item(t$) +[ opt 4 + FNmenu__n + dcb t$+CHR$(0) + FNalign +] +=0 + +DEF FNmenu_itemInd(t%) +[ opt 4 + FNmenu__n + FNmenu__s(mFlag_indirect) + dcd t% +] +=0 + +DEF FNmenu_shade(o%,b%)=FNmenu__ob(mFlag_shade,o%,b%) + +DEF FNmenu_iShade(o%,b%)=FNmenu__ob(mFlag_invShade,o%,b%) + +DEF FNmenu_switch(o%,b%)=FNmenu__ob(mFlag_switch,o%,b%) + +DEF FNmenu_radio(g%,s%)=FNmenu__2(mFlag_radio,g%,s%) + +DEF FNmenu_sprite(s%,a%) +[ opt 4 + FNmenu__s(mFlag_sprite) + dcd s% +] +IF a%<>0 THEN [opt 4:dcd a%:] +=0 + +DEF FNmenu_halfSize=FNmenu__s(mFlag_halfSize) + +DEF FNmenu_subWarn=FNmenu__s(mFlag_subWarn) + +DEF FNmenu_subMenu(s%,h%)=FNmenu__2(mFlag_subMenu,s%,h%) + +DEF FNmenu_noWarn=FNmenu__s(mFlag_noWarn) + +DEF FNmenu_ruleOff=FNmenu__s(mFlag_ruleOff) + +DEF FNmenu_end +[ opt o + dcd mFlag_end +] +=0 diff --git a/StraySrc/Libraries/Sapphire/bsh/options.bas b/StraySrc/Libraries/Sapphire/bsh/options.bas new file mode 100644 index 0000000..889559e --- /dev/null +++ b/StraySrc/Libraries/Sapphire/bsh/options.bas @@ -0,0 +1,58 @@ +REM Sapphire options macro library -- © 1995 Straylight + +DEF FNoptions_test=0 + +DEF FNoption(o%,t%,n$) +IF FNalign +opt__l=opt__l +IF opt__l THEN !(opt__l+O%-P%+4)=P%-opt__l +[ opt 4 +.opt__l + dcd 0 + dcd 0 + dcd o% + dcd t% + equs n$+CHR$(0) + FNalign +] +=0 + +DEF FNopt__f(f%) +!(opt__l+O%-P%)=!(opt__l+O%-P%) OR f% +=0 + +DEF FNoptions_end +[ opt 4 + FNopt__f(optFlag_last) + FNalign +] +!(opt__l+O%-P%+4)=P%-opt__l +=0 + +DEF FNoptions_string(o%,n$,s%) +[ opt 4 + FNoption(o%,optType_string,n$) + dcd s% +] +=0 + +DEF FNoptions_integer(o%,n$,b%) +IF FNoption(o%,optType_integer,n$) +IF b% THEN [opt 4:dcd b%:] +=0 + +DEF FNoptions_literal +IF FNoption(0,optType_literal,"") +IF FNopt__f(optFlag_ignore) +=0 + +DEF FNoptions_enum(o%,n$)=FNoption(o%,optType_enum,n$) + +DEF FNoptions_bool(o%,n$,f%) +[ opt 4 + FNoption(o%,optType_bool,n$) + dcd f% +] +=0 + +DEF FNoptions_version(o%,n$)=FNoption(o%,optType_version,n$) diff --git a/StraySrc/Libraries/Sapphire/bsh/stdDbox.bas b/StraySrc/Libraries/Sapphire/bsh/stdDbox.bas new file mode 100644 index 0000000..6a250c0 --- /dev/null +++ b/StraySrc/Libraries/Sapphire/bsh/stdDbox.bas @@ -0,0 +1,43 @@ +REM Sapphire stddbox macro library -- © 1994 Straylight + +DEF FNstddbox_test=0 + +REM --- Buttons --- + +DEF FNbutton(m$) +[ opt 4 +.but__l + dcd bFlag_text + equs m$+CHR$(0) + FNalign +] +=0 + +DEF FNbuttons_cancel +[ opt 4 +.but__l + dcd bFlag_cancel +] +=0 + +DEF FNbuttons_gap +[ opt 4 +.but__l + dcd 0 +] +=0 + +DEF FNbuttons_end +!(but__l+O%-P%)=!(but__l+O%-P%) OR bFlag_last +=0 + +REM --- Writable dialogue box --- + +DEF FNwritable(l%,f%,v$,t$) +[ opt 4 + dcd l% OR f% + dcb v$+CHR$(0) + dcb t$+CHR$(0) + FNalign +] +=0 diff --git a/StraySrc/Libraries/Sapphire/sail/errgen.bas b/StraySrc/Libraries/Sapphire/sail/errgen.bas new file mode 100644 index 0000000..1a37cba --- /dev/null +++ b/StraySrc/Libraries/Sapphire/sail/errgen.bas @@ -0,0 +1,167 @@ +REM >ErrorGen +REM +REM Generation of error tables +REM +REM © 1995 Straylight +REM + +ON ERROR PRINTREPORT$;" ["+STR$ERL+"]":CLOSE #0:END + +DIM errMsg$(256),errName$(256) +tab$=CHR$(9) + +REM --- Generate the token table --- + +RESTORE +curr%=0 +READ errMsg$(curr%),errName$(curr%) +WHILE errMsg$(curr%)<>"***" + curr%+=1 + READ errMsg$(curr%),errName$(curr%) +ENDWHILE + +C=OPENOUT("sh.errTable") +BPUT#C,";" +BPUT#C,"; errTable.sh" +BPUT#C,";" +BPUT#C,"; Define error messages table (generated)" +BPUT#C,";" +BPUT#C,"; © 1995 Straylight" +BPUT#C,";" +BPUT#C,"" +BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:errTable__dfn" +BPUT#C,tab$+tab$+"GBLL"+tab$+"errTable__dfn" +BPUT#C,"" + +curr%=0 +BPUT#C,"errTable" +WHILE errMsg$(curr%)<>"***" + BPUT#C,tab$+tab$+"DCD"+tab$+"err__msg"+STR$curr%+"-errTable" + curr%+=1 +ENDWHILE +BPUT#C,"" + +curr%=0 +WHILE errMsg$(curr%)<>"***" + BPUT#C,"err__msg"+STR$curr%+tab$+"DCB"+tab$+""""+errMsg$(curr%)+""",0" + curr%+=1 +ENDWHILE +BPUT#C,"" +BPUT#C,tab$+tab$+"]" +BPUT#C,"" +BPUT#C,tab$+tab$+"END" +CLOSE#C +OSCLI "Settype sh.errTable FFF" + +REM -- Generate the error numbers --- + +RESTORE +C=OPENOUT("sh.errNum") +BPUT#C,";" +BPUT#C,"; errNum.sh" +BPUT#C,";" +BPUT#C,"; Define error numbers (generated)" +BPUT#C,";" +BPUT#C,"; © 1995 Straylight" +BPUT#C,";" +BPUT#C,"" +BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:errNum__dfn" +BPUT#C,tab$+tab$+"GBLL"+tab$+"errNum__dfn" +BPUT#C,"" + +curr%=0 +BPUT#C,tab$+tab$+"^"+tab$+"0" +WHILE errMsg$(curr%)<>"***" + BPUT#C,errName$(curr%); + IF LEN(errName$(curr%))>7 THEN BPUT#C,tab$; ELSE BPUT#C,tab$+tab$; + BPUT#C,"#"+tab$+"1" + curr%+=1 +ENDWHILE +BPUT#C,"" +BPUT#C,tab$+tab$+"]" +BPUT#C,"" +BPUT#C,tab$+tab$+"END" +CLOSE#C +OSCLI "Settype sh.errNum FFF" + +END + +DATA "Type mismatch: Number needed",err_numNeeded +DATA "Type mismatch: String needed",err_strNeeded +DATA "Whole array reference is invalid in this context",err_arrayBad +DATA "Missing )",err_expBracket +DATA "Missing #",err_expHash +DATA "Missing """"",err_expQuote +DATA "Missing =",err_expEq +DATA "Missing ,",err_expComma +DATA "Bad hex",err_badHex +DATA "Bad binary",err_badBinary +DATA "Unknown or missing variable",err_unknown +DATA "Division by zero",err_divZero +DATA "Out of memory",err_noMem +DATA "Syntax error",err_syntax +DATA "Mistake",err_mistake +DATA "String too long",err_strTooLong + +DATA "Missing = in FOR",err_eqInFor +DATA "Bad FOR control variable",err_badForVar +DATA "Missing TO",err_expTo +DATA "The step cannot be zero",err_zStep +DATA "Not in a FOR loop",err_noFor + +DATA "Not in a REPEAT loop",err_noRepeat + +DATA "Missing ENDWHILE",err_expEndwhile +DATA "Not in a WHILE loop",err_noWhile + +DATA "Missing ENDIF",err_expEndif + +DATA "Missing OF",err_expOf +DATA "CASE..OF statement must be the last thing on a line",err_afterCase +DATA "Missing ENDCASE",err_expEndcase + +DATA "Missing label",err_expLabel +DATA "Unknown label",err_noLabel + +DATA "Bad DIM statement",err_badDim +DATA "No end of dimension list )",err_dimKet +DATA "Arrays cannot be redimensioned",err_reDim +DATA "Incorrect number of subscripts",err_numSubs +DATA "Subscript out of range",err_subRange +DATA "Unknown array",err_ukArray + +DATA "Can't use RGET while in a WATCHFOR state",err_rgetInWatch +DATA "Can't use RGET$ while in a WATCHFOR state",err_rgetSInWatch +DATA "Can't use LGET while in a WATCHFOR state",err_lgetInWatch +DATA "Can't use LGET$ while in a WATCHFOR state",err_lgetSInWatch +DATA "Can't use RINKEY while in a WATCHFOR state",err_rinkeyInWatch +DATA "Can't use RINKEY$ while in a WATCHFOR state",err_rinkeySInWatch +DATA "Can't use LINKEY while in a WATCHFOR state",err_linkeyInWatch +DATA "Can't use LINKEY$ while in a WATCHFOR state",err_linkeySInWatch + +DATA "Wrong number of arguments passed to STRING$",err_stringSArgs +DATA "Wrong number of arguments passed to LEFT$",err_leftSArgs +DATA "Wrong number of arguments passed to RIGHT$",err_rightSArgs +DATA "Wrong number of arguments passed to MID$",err_midSArgs +DATA "Wrong number of arguments passed to INSTR",err_instrSArgs + +DATA "Arguments of function/procedure incorrect",err_badArgs +DATA "No such function/procedure",err_noProc +DATA "Bad call of function/procedure",err_badCall + +DATA "Not in a subroutine",err_notInSub +DATA "Not in a procedure",err_notInProc +DATA "Not in a function",err_notInFn + +DATA "Too many strings passed to WATCHFOR",err_WFTooMany + +DATA "Too many input parameters to SYS/SYSCALL",err_sysTooManyI +DATA "Too many output parameters to SYS/SYSCALL",err_sysTooManyO + +DATA "Out of DATA",err_outOfDATA + +DATA "mem_realloc not implemented",err_realloc +DATA "Not yet implemented",err_lazy +DATA "The script interpreter has gone wrong",err_erk +DATA ***,*** + diff --git a/StraySrc/Libraries/Sapphire/sail/tableGen.bas b/StraySrc/Libraries/Sapphire/sail/tableGen.bas new file mode 100644 index 0000000..393e861 --- /dev/null +++ b/StraySrc/Libraries/Sapphire/sail/tableGen.bas @@ -0,0 +1,350 @@ +REM >tableGen +REM +REM Generates a lex table for BASIC keywords, and outputs it in +REM objasm syntax +REM +REM © 1995 Straylight +REM +: +PROCinit +tab$=CHR$(9) +PROCgetClasses +PROCoutputTokens +PROCoutputNames +PROCoutputTable +END +: +DEFPROCinit +ONERROR PRINTREPORT$;" [";STR$(ERL);"]":CLOSE#0:END +DIM block% 20240 +DIM tokenClass%(256) +DIM classNames$(256) +DIM tokenCount%(256) +tokenClass%()=-1 +nClass%=1 +ptr%=block% +ptr%!0=0 +ptr%!4=0 +ptr%!8=0 +ntable%=1 +ENDPROC +: +DEFPROCgetClasses +LOCAL i%,k$,c$,c%,t%,this%,C +RESTORE +READ k$,c$ +t%=128 +WHILE k$<>"***" + c%=-1 + FOR i%=0 TO nClass% + IF classNames$(i%)=c$ THEN c%=i% + NEXT + IF c%=-1 THEN + c%=nClass% + nClass%+=1 + classNames$(c%)=c$ + ENDIF + IF LEN(k$)=1 THEN + this%=ASC(k$) + ELSE + this%=t% + t%+=1 + ENDIF + tokenClass%(this%)=c%+(tokenCount%(c%)<<16) + tokenCount%(c%)+=1 + READ k$,c$ +ENDWHILE + +C=OPENOUT("sh.tokClasses") +BPUT#C,";" +BPUT#C,"; tokClasses.sh" +BPUT#C,";" +BPUT#C,"; Token class and index tables (generated)" +BPUT#C,";" +BPUT#C,"; © 1995 Straylight" +BPUT#C,";" +BPUT#C,"" +BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:tokClasses__dfn" +BPUT#C,tab$+tab$+"GBLL"+tab$+"tokClasses__dfn" +BPUT#C,"" +BPUT#C,"tokClasses" +FOR i%=0 TO 255 + IF tokenClass%(i%)=-1 THEN + BPUT#C,tab$+tab$+"DCB"+tab$+"0,0" + ELSE + BPUT#C,tab$+tab$+"DCB"+tab$+STR$(tokenClass%(i%) AND &FFFF)+","; + BPUT#C,STR$(tokenClass%(i%) >> 16) + ENDIF +NEXT +BPUT#C,"" +BPUT#C,tab$+tab$+"]" +BPUT#C,"" +BPUT#C,tab$+tab$+"END" +CLOSE#C +OSCLI "SetType sh.tokClasses text" +ENDPROC +: +DEFPROCoutputTokens +LOCAL C,key$ +C=OPENOUT("sh.tokens") +BPUT#C,";" +BPUT#C,"; tokens.sh" +BPUT#C,";" +BPUT#C,"; Define constants for the tokens (generated)" +BPUT#C,";" +BPUT#C,"; © 1995 Straylight" +BPUT#C,";" +BPUT#C,"" +BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:tokens__dfn" +BPUT#C,tab$+tab$+"GBLL"+tab$+"tokens__dfn" +BPUT#C,"" +BPUT#C,tab$+tab$+"^"+tab$+"&80" +RESTORE +READ key$,c$ +WHILE key$<>"***" + IF LEN(key$)>1 THEN + key$=FNnice(key$) + BPUT#C,key$; + IF LEN(key$)>7 THEN BPUT#C,tab$; ELSE BPUT#C,tab$+tab$; + BPUT#C,"#"+tab$+"1" + ENDIF + READ key$,c$ +ENDWHILE +BPUT#C,"" +BPUT#C,tab$+tab$+"^"+tab$+"1" +FOR i%=1 TO nClass%-1 + c$="tClass_"+classNames$(i%) + BPUT#C,c$; + IF LEN(c$)<8 THEN BPUT#C,tab$+tab$; ELSE BPUT#C,tab$; + BPUT#C,"#"+tab$+"1" +NEXT +BPUT#C,"" +BPUT#C,tab$+tab$+"]" +BPUT#C,"" +BPUT#C,tab$+tab$+"END" +CLOSE#C +OSCLI("Settype sh.tokens text") +ENDPROC +: +DEFPROCoutputNames +LOCAL C,key$,i% +C=OPENOUT("sh.tokNames") +BPUT#C,";" +BPUT#C,"; tokNames.sh" +BPUT#C,";" +BPUT#C,"; Number-to-name table for tokens (generated)" +BPUT#C,";" +BPUT#C,"; © 1995 Straylight" +BPUT#C,";" +BPUT#C,"" +BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:tokNames__dfn" +BPUT#C,tab$+tab$+"GBLL"+tab$+"tokNames__dfn" +BPUT#C,"" +BPUT#C,"tokNames"; + +i%=0 +RESTORE +READ key$,c$ +WHILE key$<>"***" + IF LEN(key$)>1 THEN + IF i%=0 THEN BPUT#C,tab$; ELSE BPUT#C,tab$+tab$; + BPUT#C,"DCD"+tab$+"tn__"+STR$(i%) + i%+=1 + ENDIF + READ key$,c$ +ENDWHILE +BPUT#C,"" +RESTORE +READ key$,c$ +i%=0 +WHILE key$<>"***" + IF LEN(key$)>1 THEN + BPUT#C,"tn__"+STR$(i%)+tab$+tab$+"DCB"+tab$+""""+key$+""",0" + i%+=1 + ENDIF + READ key$,c$ +ENDWHILE +BPUT#C,"" +BPUT#C,tab$+tab$+"]" +BPUT#C,"" +BPUT#C,tab$+tab$+"END" +CLOSE#C +OSCLI("Settype sh.tokNames text") +ENDPROC +: +DEFPROCoutputTable +RESTORE +READ key$,c$ +root%=0 +WHILE key$<>"***" + PROCaddAcross(root%,key$) + READ key$,c$ +ENDWHILE +C=OPENOUT"sh.tokTable" +BPUT#C,";" +BPUT#C,"; tokTable.sh" +BPUT#C,";" +BPUT#C,"; State table for lexical analysis (generated)" +BPUT#C,";" +BPUT#C,"; © 1995 Straylight" +BPUT#C,";" +BPUT#C,"" +BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:tokTable__dfn" +BPUT#C,tab$+tab$+"GBLL"+tab$+"tokTable__dfn" +BPUT#C,"" +BPUT#C,tab$+tab$+"MACRO" +BPUT#C,"$label"+tab$+tab$+"TOKTBL"+tab$+"$char,$next,$token" +BPUT#C,"$label" +BPUT#C,tab$+tab$+"["+tab$+"""$next""=""0""" +BPUT#C,tab$+tab$+"DCW"+tab$+"0" +BPUT#C,tab$+tab$+"|" +BPUT#C,tab$+tab$+"DCW"+tab$+"$next-kt0" +BPUT#C,tab$+tab$+"]" +BPUT#C,tab$+tab$+"["+tab$+"""$token""<>""""" +BPUT#C,tab$+tab$+"DCB"+tab$+"$token" +BPUT#C,tab$+tab$+"|" +BPUT#C,tab$+tab$+"DCB"+tab$+"0" +BPUT#C,tab$+tab$+"]" +BPUT#C,tab$+tab$+"DCB"+tab$+"$char" +BPUT#C,tab$+tab$+"MEND" +BPUT#C,"" +BPUT#C,"tokTable" +PROCoutputBlock(C,block%,0,"") +BPUT#C,tab$+tab$+"]" +BPUT#C,"" +BPUT#C,tab$+tab$+"END" +CLOSE#C +OSCLI("Settype sh.tokTable text") +ENDPROC +: +DEFFNnice(s$) +LOCAL nice$,c% +IF LEN(s$)=1 THEN ="'"+s$+"'" +nice$="tok_" +WHILE s$<>"" + c%=ASC(LEFT$(s$,1)) + c%=c% OR &20 + IF c%>&60 AND c%<&7B THEN + nice$+=CHR$(c%) + ELSE + CASE CHR$(c%) OF + WHEN "+": nice$+="P" + WHEN "-": nice$+="M" + WHEN "*": nice$+="T" + WHEN "/": nice$+="D" + WHEN "=": nice$+="E" + WHEN "<": nice$+="L" + WHEN ">": nice$+="G" + WHEN "$": nice$+="S" + WHEN "#": nice$+="H" + ENDCASE + ENDIF + s$=MID$(s$,2) +ENDWHILE +=nice$ +: +DEF PROCaddAcross(p%,s$) +old%=0 +last%=0 +WHILE s$<>"" + c%=ASC(LEFT$(s$,1)) + IF p%=0 THEN + IF old% THEN old%!0=ptr% ELSE root%=ptr% + p%=ptr% + ptr%!0=c% + ptr%!4=0 + ptr%!8=0 + ptr%+=12 + s$=MID$(s$,2) + old%=p%+8 + last%=p% + p%=p%!8 + ELSE + IF c%=?p% THEN + old%=p%+8 + last%=p% + p%=p%!8 + s$=MID$(s$,2) + ELSE + old%=p%+4 + p%=p%!4 + ENDIF + ENDIF +ENDWHILE +last%!0=last%!0 OR (1<<31) +ENDPROC +: +DEFPROCdisplayBlock(blk%,indent%) +IF blk%<>0 THEN + PRINT CHR$(blk%!0); + PROCdisplayBlock(blk%!8,indent%+1) + IF blk%!4 THEN + PRINT SPC(indent%); + PROCdisplayBlock(blk%!4,indent%) + ENDIF +ELSE + PRINT +ENDIF +ENDPROC +: +DEFPROCoutputBlock(C,blk%,n%,prefix$) +BPUT#C,"kt"+STR$(n%); +PROCoutputAcross(C,blk%,prefix$) +ENDPROC +: +DEFPROCoutputAcross(C,p%,prefix$) +LOCAL n% +n%=ntable% +IF p%<>0 THEN + BPUT#C,tab$+tab$+"TOKTBL"+tab$+"'"+CHR$(p%?0)+"'"; + IF p%!8 THEN + BPUT#C,",kt"+STR$(n%); + ntable%+=1 + ELSE + BPUT#C,",0"; + ENDIF + IF (p%!0 AND (1<<31)) THEN + BPUT#C,","+FNnice(prefix$+CHR$(?p%)); + ENDIF + BPUT#C,"" + PROCoutputAcross(C,p%!4,prefix$) + IF p%!8 THEN PROCoutputBlock(C,p%!8,n%,prefix$+CHR$(?p%)) +ELSE + BPUT#C,tab$+tab$+"TOKTBL"+tab$+"0,0" + BPUT#C,"" +ENDIF +ENDPROC +: +DATA AND,andOp,ABS,fn,ASC,fn +DATA BGET,streamOp,BPUT,instr, +DATA CASE,instr,CHR$,fn,CLOSE,instr +DATA CALL,instr +DATA DATA,instr,DEF,instr,DIV,multOp,DIM,instr +DATA END,instr,ENDPROC,instr,ENDWHILE,instr,ENDIF,instr,ENDCASE,instr +DATA ELSE,instr,EVAL,fn,ERROR,instr,EOF,streamOp,EOR,orOp +DATA EXT,streamOp +DATA FOR,instr,FALSE,pseud,FN,odd,GOTO,instr +DATA GET$,streamOp,GOSUB,instr +DATA IF,instr,INSTR(,multArg,LEFT$(,multArg,LEN,fn +DATA LET,instr +DATA LOCAL,instr +DATA MID$(,multArg,MOD,multOp +DATA NEXT,instr,NOT,fn +DATA OF,noise,OFF,option,ON,noise,OR,orOp,OPENIN,fn,OPENOUT,fn,OPENUP,fn +DATA OSCLI,instr,OTHERWISE,instr +DATA PTR,streamOp,PROC,instr +DATA RETURN,instr,REPEAT,instr,READ,instr +DATA REM,noise,RESTORE,instr +DATA RIGHT$(,multArg,RND,odd +DATA STEP,noise,SGN,fn,STR$,fn,STRING$(,multArg,SWAP,instr +DATA SYS,instr +DATA THEN,noise,TIME,pseud,TIME$,pseud,TO,noise,TRUE,pseud +DATA UNTIL,instr +DATA VAL,fn +DATA WHILE,instr,WHEN,instr +DATA =,relOp,<,relOp,<=,relOp,<>,relOp,>,relOp,>=,relOp +DATA <<,relOp,>>,relOp,>>>,relOp +DATA /,multOp,/*,noise,//,noise +DATA +,addOp,-,addOp,*,multOp,+=,assign,-=,assign,*=,assign,^,powOp +DATA /=,assign +DATA ***,*** diff --git a/StraySrc/MiscToys/PlainError/b/plainError.bas b/StraySrc/MiscToys/PlainError/b/plainError.bas new file mode 100644 index 0000000..bfd2ed6 --- /dev/null +++ b/StraySrc/MiscToys/PlainError/b/plainError.bas @@ -0,0 +1,101 @@ +REM +REM plainError +REM +REM Remove the irritating `Application has gone wrong' message. +REM +REM © 1996-1998 Mark Wooding +REM + +REM ----- Licensing note ---------------------------------------------------- +REM +REM PlainError is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM PlainError is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with PlainError. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +help$="PlainError"+CHR$(9)+"1.02 (%dy %m3 %ce%yr) © %ce%yr Mark Wooding" + +DIM code% 1024 +!code%=3 +SYS "OS_Word",14,code% +SYS "OS_ConvertDateAndTime",code%,code%+8,256,help$ +SYS "XOS_GenerateError",code%+8 TO help$ + + +FOR o=4 TO 6 STEP 2 +O%=code% +P%=0 + +[ opt o + + dcd 0 + dcd init + dcd final + dcd service + dcd title + dcd help + dcd 0 + +.title + equz "PlainError" + align + +.init + stmfd r13!,{r14} + mov r0,#6 + mov r3,#256 + swi "XOS_Module" + strvc r2,[r12,#0] + ldmfd r13!,{pc} + +.final + stmfd r13!,{r14} + mov r0,#7 + ldr r2,[r12,#0] + swi "XOS_Module" + mov r14,#0 + str r14,[r12,#0] + ldmfd r13!,{pc}^ + +.service + stmfd r13!,{r14} + eor r14,r1,#&40000 + teq r14,#&c0 + ldmnefd r13!,{pc}^ + + stmfd r13!,{r0,r1} + ldr r12,[r12,#0] + + mov r14,#0 + str r14,[r12,#0] + + add r0,r12,#4 + add r2,r2,#4 +.a + ldrb r14,[r2],#1 + cmp r14,#&20 + movcc r14,#0 + strb r14,[r0],#1 + bcs a + + mov r2,r12 + ldmfd r13!,{r0,r1,pc}^ + +.help + equz help$ + align + +] +NEXT + +SYS "OS_File",10,"PlainError",&FFA,,code%,O% +END diff --git a/StraySrc/MiscToys/PlainError/testit.bas b/StraySrc/MiscToys/PlainError/testit.bas new file mode 100644 index 0000000..9fc1297 --- /dev/null +++ b/StraySrc/MiscToys/PlainError/testit.bas @@ -0,0 +1 @@ +CALL 0 diff --git a/StraySrc/SapphToys/!SWIlist/bs/swiList.bas b/StraySrc/SapphToys/!SWIlist/bs/swiList.bas new file mode 100644 index 0000000..2edda84 --- /dev/null +++ b/StraySrc/SapphToys/!SWIlist/bs/swiList.bas @@ -0,0 +1,1964 @@ +REM +REM swiList.bs +REM +REM Build SWI name include files +REM +REM © 1995 Straylight +REM + +REM -- Standard header ------------------------------------------------------ + +ON ERROR ERROR 0,"*** ERROR: "+REPORT$+" ["+STR$(ERL)+"]" + +LIBRARY "libs:BAS" +PROCbas_init + +PROCbas_aofInit(&8000) + +V_flag=1<<28 +C_flag=1<<29 + +FOR o=4 TO 6 STEP 2 + +[ opt o + FNpass + +;----- Revision history ----------------------------------------------------- +; +; Version By Change +; +; 1.xx MDW Old version written in C using STEEL. +; +; 2.00 MDW Rewrite from scratch in assembler using Sapphire. +; Keep SWI names in flex block, allow user format +; files, and add SWIs from modules dropped onto icon. +; +; 2.01 MDW Replaced format file loading with a chunk file, to +; support multiple programming languages. Added +; submenu to `Save list' for selecting which language +; to use. +; +; 2.02 MDW Added %d format specifier to output generation time/ +; date in given style. Also added revision history ;-) +; +; 2.03 MDW Added confirm on quit option, and prevented saving +; a dump from SWIList back into itself. +; +; 2.04 MDW Tidied up initialisation a little, and made it +; register the heap routines as allocators for smaller +; WimpSlot. +; +; 2.05 MDW Fiddled help message generation a little to (a) +; do message translation of the format names and (b) +; use %0 rather than the less pretty %9 in the help +; skeleton. +; +; 2.06 MDW Added full pathname for dump save, so you don't have +; to dig up the application to save the dump each time. +; +; 2.07 MDW Used SEH for error handling, instead of raw except- +; level stuff. + +;----- External dependencies ------------------------------------------------ + + ; --- Sapphire library --- + + FNget ("sapphire:alloc") + FNget ("sapphire:buttons") + FNget ("sapphire:chunk") + FNget ("sapphire:defHandler") + FNget ("sapphire:errorBox") + FNget ("sapphire:event") + FNget ("sapphire:fastMove") + FNget ("sapphire:flex") + FNget ("sapphire:heap") + FNget ("sapphire:help") + FNget ("sapphire:hour") + FNget ("sapphire:ibicon") + FNget ("sapphire:libOpts") + FNget ("sapphire:menu") + FNget ("sapphire:menuDefs") + FNget ("sapphire:msgs") + FNget ("sapphire:note") + FNget ("sapphire:progInfo") + FNget ("sapphire:ptr") + FNget ("sapphire:report") + FNget ("sapphire:res") + FNget ("sapphire:resources") + FNget ("sapphire:sapphire") + FNget ("sapphire:seh") + FNget ("sapphire:string") + FNget ("sapphire:warning") + + FNget ("sapphire:choices.choices") + + FNget ("sapphire:xfer.load") + FNget ("sapphire:xfer.saveAs") + FNget ("sapphire:xfer.save") + FNget ("sapphire:xfer.xsave") + + ; --- Link-time generated strings --- + + FNimport("cright") + FNimport("version") + +;----- Initialisation ------------------------------------------------------- + + FNarea ("Client$$Code","CODE,READONLY") + +; --- main --- +; +; On entry; -- +; +; On exit; Via OS_Exit +; +; Use; Allows saving of header files containing SWI name-number +; mappings. + +.main FNentry + + adr r0,FNlitsz("SWIList") ;Point to application name + mov r1,#sl__wSize ;Get my workspace size + mov r2,#0 ;Default stack size + bl sapphire_init ;Start up the library + bl sl__preInit ;Do pre-initialisation stuff + bl sapphire_libInit ;Initialise rest of library + bl sl__init ;Initialise me + + bl seh_throwErrors ;Make errors throw exceptions + bl report_catchAll ;And catch exceptions + +.sl__pollLoop mov r0,#1 ;Don't have idle events + add r1,r12,#sl__pollBlock ;Point to the poll block + bl event_poll ;Handle an event + blcc sl__unknowns ;Handle unknown events + blcc defHandler ;Pass it on if unrecognised + b sl__pollLoop ;And carry on round forever + + FNltorg + +; --- sl__preInit --- +; +; On entry; -- +; +; On exit; R0-R10 corrupted +; +; Use; Does initialisation of things before the main Sapphire +; library awakes. + +.sl__preInit stmfd r13!,{r14} ;Save a register away + bl resources_init ;Use shared resource DLL + bl hour_init ;Wake up the hourglass system + bl hour_on ;And turn it on + ldr r0,[r11,#sapph_appName] ;Find the application name + bl heap_init ;Initialise the resizing heap + bl heap_useHeap ;Register it as an allocator + adr r0,sl__sapphOpts ;Point to options block + bl libOpts_register ;Register the options + ldmfd r13!,{pc}^ ;Return to caller when done + +.sl__sapphOpts FNlibOpt("MENU") + dcd 8192 + FNlibOpts_end + + FNltorg + +; --- sl__init --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Initialises SWIList's workspace. + +.sl__init stmfd r13!,{r14} ;Save some registers + bl sl__initWS ;Set up my workspace + bl sl__loadFormat ;Load the user's format file + bl sl__initList ;Create the SWI list + bl sl__iconBar ;Create my icon + bl sl__setFlags ;Finally set the flags up + ldmfd r13!,{pc}^ ;And return to caller + + FNltorg + +; --- sl__initWS --- +; +; On entry; -- +; +; On exit; R0-R10 corrupted +; +; Use; Initialises the application's workspace. + +.sl__initWS stmfd r13!,{r14} ;Save the link register + mov r14,#0 ;Zero the anchor pointer + str r14,[r12,#sl__flags] ;Clear the flags initially + str r14,[r12,#sl__anchor] ;Say we have no block yet + str r14,[r12,#sl__modNames] ;No module name table + str r14,[r12,#sl__format] ;No format loaded yet + ldmfd r13!,{pc}^ ;And return to caller + + FNltorg + +; --- sl__loadFormat --- +; +; On entry; -- +; +; On exit; R0-R10 corrupted +; +; Use; Loads SWIList's format file. + +.sl__loadFormat stmfd r13!,{r14} ;Save the link register + + ; --- Enable the Choices support --- + + mov r0,#1 ;Enable `Choices' support + bl choices_useChoices ;Allow read-only use nicely + + ; --- Create the format chunk file --- + + bl chunk_create ;Create a chunk file + swivs "OS_GenerateError" ;Be unhappy if it fails + str r0,[r12,#sl__format] ;Save this away + + ; --- Now do the actual load operation --- + + adr r0,FNlitsz("Format") ;Point to the leafname + mov r1,r11 ;Build name in scratchpad + mov r2,#0 ;I want to read the file + bl choices_find ;Translate the name + mov r1,r0 ;Point to the name + sub r13,r13,#4 ;Make a flex anchor + mov r2,r13 ;Point to this anchor + bl load_file ;Load the file into it + ldrvc r0,[r12,#sl__format] ;Find the format handle + movvc r1,r13 ;And point to the anchor + blvc chunk_read ;Add that to the chunks + mov r0,r13 ;Point to that anchor again + bl flex_free ;Get rid of the block + add r13,r13,#4 ;And restore the stack + + ; --- Set flag if any format chunks found --- + + ldr r0,[r12,#sl__format] ;Find the format handle + mov r1,#0 ;Start enumerating + bl chunk_enum ;Are there any chunks? + ldrcc r14,[r12,#sl__flags] ;Yes -- get the flags + orrcc r14,r14,#slFlag__format ;Set the format flag + strcc r14,[r12,#sl__flags] ;And save them back again + ldmfd r13!,{pc}^ ;Return to caller when done + + FNltorg + +; --- sl__initList --- +; +; On entry; -- +; +; On exit; R0-R10 corrupted +; +; Use; Initialises the SWI table, either by loading a saved dump +; or by scanning the modules in memory. + +.sl__initList stmfd r13!,{r14} ;Save the link register + adr r0,FNlitsz("SWIDump") ;Point to the leafname + mov r1,r11 ;Build name in scratchpad + mov r2,#0 ;I want to read the file + bl choices_find ;Translate the name + mov r1,r0 ;Point to the name + bl sl__loadDmp ;Load the default dump + blvc sl__doneDmp ;If OK, set the rest up + blvs sl__initBlock ;Otherwise, scan the modules + ldmfd r13!,{pc}^ ;Return to caller when done + + FNltorg + +; --- sl__iconBar --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Sets up the icon bar icon. + +.sl__iconBar stmfd r13!,{r0-r6,r14} ;Save some registers + adr r0,FNlitsz("!swilist") ;Point to sprite to use + mov r1,#0 ;No text buffer here + mvn r2,#NOT(-1) ;Put icon on the left + mov r3,#0 ;Normal priority please + adr r4,sl__ibEvents ;Point to event handler + mov r5,#0 ;Pass no document handle + mov r6,r12 ;Pass workspace pointer + bl ibicon_create ;Create the icon nicely + swivs "OS_GenerateError" ;If it failed, halt program + ldmfd r13!,{r0-r6,pc}^ ;And return to caller + + FNltorg + +; --- sl__ibEvents --- +; +; On entry; R0 == event code +; +; On exit; -- +; +; Use; Handles events for the icon bar icon. + +.sl__ibEvents cmp r0,#(sl__ibe10-sl__ibe00)/4 + addcc pc,pc,r0,lsl #2 ;Dispatch through branch tbl + movs pc,r14 ;Ignore unknown events + +.sl__ibe00 movs pc,r14 ;Ignore Select clicks + b sl__ibMenu ;Handle a menu click + movs pc,r14 ;Ignore Adjust clicks + b sl__ibLoad ;Handle a load/save request + b sl__ibLoad ;We treat them all the same + b sl__ibHelp ;Handle a help request +.sl__ibe10 + ; --- Handle a menu click --- + +.sl__ibMenu stmfd r13!,{r0-r3,r14} ;Save some registers + adr r0,sl__imDef ;Point to the menu definition + adr r1,sl__imEvents ;Point to menu handler code + mov r2,r10 ;Pass it the doc handle + mov r3,r12 ;And my workspace address + bl menu_create ;Display the menu nicely + ldmfd r13!,{r0-r3,pc}^ ;And return to caller + +.sl__imDef FNmenu("SWIList") + FNmenu_item("slINF") + FNmenu_subWarn + FNmenu_ruleOff + FNmenu_item("slSVL") + FNmenu_r12Data + FNmenu_iShade(sl__flags,slFlag__savable) + FNmenu_subWarn + FNmenu_noWarn + FNmenu_item("slSVD") + FNmenu_r12Data + FNmenu_iShade(sl__flags,slFlag__block) + FNmenu_subWarn + FNmenu_noWarn + FNmenu_item("slSCN") + FNmenu_item("slRFM") + FNmenu_subWarn + FNmenu_ruleOff + FNmenu_item("slQUT") + FNmenu_end + + ; --- Handle a help request --- + +.sl__ibHelp stmfd r13!,{r0,r14} ;Save some registers + adr r0,FNlitsz("slhIB") ;Point to a message tag + bl msgs_lookup ;Translate the tag + bl help_add ;And add it to the help + ldmfd r13!,{r0,pc}^ ;Return to caller + + ; --- Handle a load event --- + +.sl__ibLoad stmfd r13!,{r0-r2,r14} ;Save some registers + bl event_last ;Find the last event + ldr r0,[r1,#40] ;Load the filetype + ldr r14,FNlitw(&FFA) ;Get the module filetype + cmp r0,r14 ;Do these match + beq sl__ibLdMod ;Yes -- handle that then + ldr r14,FNlitw(&FFD) ;Get the data filetype + cmp r0,r14 ;Do these match + beq sl__ibLdDump ;Yes -- handle that then + ldmfd r13!,{r0-r2,pc}^ ;Return to caller + + ; --- Handle loading a module --- + +.sl__ibLdMod adr r0,sl__lMod ;Point to load block + mov r1,r10 ;Get document handle + mov r2,r12 ;And workspace address + bl load ;Do the load operation + ldmfd r13!,{r0-r2,pc}^ ;And return when done + +.sl__lMod b sl__ibMod + b load_killBuf + b load_extendBuf + b load_doneBuf + b sl__loadMod + b sl__doneMod + b sl__lfMod + + ; --- Handle loading a dump --- + +.sl__ibLdDump ldr r14,[r12,#sl__flags] ;Load the flags word + tst r14,#slFlag__saving ;Are we saving currently? + bne sl__ild50 ;Yes -- moan at user then + + adr r0,sl__lDmp ;Point to load block + mov r1,r10 ;Get document handle + mov r2,r12 ;And workspace address + bl load ;Yes -- start a load op + ldmfd r13!,{r0-r2,pc}^ ;And return to caller + +.sl__ild50 adr r0,FNliterr(1,"slCSII") ;Point to error block + bl msgs_error ;Translate the message + mov r1,#1 ;Only display OK button + bl errorBox ;Display the error + ldmfd r13!,{r0-r2,pc}^ ;And return to caller + +.sl__lDmp b sl__ibDmp + b load_killBuf + b load_extendBuf + b load_doneBuf + b sl__loadDmp + b sl__doneDmp + b sl__lfDmp + + FNltorg + +; --- sl__imEvents --- +; +; On entry; R0 == event code +; R1 == item number +; +; On exit; -- +; +; Use; Handles events from the icon bar menu. + +.sl__imEvents cmp r0,#mEvent_help ;A help request, perchance? + beq sl__imHelp ;Yes -- deliver help on it + cmp r0,#mEvent_select ;Is this a select event? + cmpne r0,#mEvent_subMenu ;Or a submenu opening? + movnes pc,r14 ;No -- ignore the event + + cmp r1,#(sl__ime10-sl__ime00)/4 + addcc pc,pc,r1,lsl #2 ;Dispatch by item number + movs pc,r14 ;Ignore unknown item numbers + +.sl__ime00 b sl__imInfo ;Display the info box + b sl__imSave ;Save the SWI list + b sl__imDump ;Save a SWI dump + b sl__initBlock ;Reset the block + b sl__imRefresh ;Refresh a particular module + b sl__imQuit ;Close down the program +.sl__ime10 + + ; --- Send a help message --- + +.sl__imHelp stmfd r13!,{r0,r14} ;Save some registers + adr r0,FNlitsz("slhIM") ;Find the message base tag + bl menu_help ;Give help on the item + ldmfd r13!,{r0,pc}^ ;And return to caller + + ; --- Display the info window --- + +.sl__imInfo stmfd r13!,{r0-r2,r14} ;Save some registers + adr r0,FNlitsz("slPUR") ;Point to purpose message + bl msgs_lookup ;Translate message tag + ldr r1,FNlitw(cright) ;Find the copyright string + ldr r2,FNlitw(version) ;And the version string + bl progInfo ;Display the box + movvs r1,#1 ;If it failed, display error + blvs errorBox ;In a pretty error box + ldmfd r13!,{r0-r2,pc}^ ;And return to caller + + FNltorg + + ; --- Dislplay the menu of formats --- + +.sl__imSave cmp r0,#mEvent_subMenu ;Make sure this is a submenu + movnes pc,r14 ;No -- not interested + + stmfd r13!,{r0-r5,r14} ;Save some registers + adr r0,sl__fmtTitle ;Point to the title + mov r1,#0 ;No handler for that + bl menu_create ;Set that up to display + + ldr r4,[r12,#sl__format] ;Load the format chunk file + mov r1,#0 ;Read first chunk name +.loop mov r0,r4 ;Pop it in R0 for a bit + bl chunk_enum ;Get the next chunk + ldmcsfd r13!,{r0-r5,pc}^ ;Return when finished + str r2,[r1,#4] ;Save pointer to name + mov r2,r1 ;Point to the anchor + mov r5,r1 ;Look after continuation + adr r0,sl__fmtMenu ;Point to menu skeleton + adr r1,sl__fmtHandler ;Point to handler routine + mov r3,r12 ;Pass workspace in R12 + bl menu_create ;Add that to the list + mov r1,r5 ;Get the continuation value + b loop ;And go back to the loop + +.sl__fmtTitle FNmenu("slSVFT") + FNmenu_end + +.sl__fmtMenu FNmenu_itemInd(4) + FNmenu_subWarn + FNmenu_end + + FNltorg + + ; --- Dislplay the dump box --- + +.sl__imDump stmfd r13!,{r0-r5,r14} ;Save some registers + ldr r0,[r12,#sl__used] ;Load the actual block size + ldr r1,FNlitw(&ffd) ;Output as a data file + add r2,r12,#sl__dumpFile ;Point to the dump file name + adr r3,sl__dumpDef ;Point to handler block + mov r4,r10 ;Pass document handle + mov r5,r12 ;And pass the workspace addr + bl saveAs ;Try to do the save op + bvs sl__imd90 ;Tidy up if it failed + ldr r14,[r12,#sl__flags] ;Load the current flags + orr r14,r14,#slFlag__saving ;Say we're now saving + str r14,[r12,#sl__flags] ;Save the flags back again + ldmfd r13!,{r0-r5,pc}^ ;And return to caller + +.sl__imd90 mov r1,#1 ;If it failed, report error + bl errorBox ;In a nice error box + ldmfd r13!,{r0-r5,pc}^ ;And return to caller + +.sl__dumpDef FNs ("slSDT") ;Title for the save box + b sl__svdDone ;Handle box closing + b sl__saveDump ;Save to a disk file + b sl__sendDump ;Send to another application + movs pc,r14 ;Ignore completion + b sl__svdFail ;Tidy up after a failure + + FNltorg + + ; --- Display a menu of modules to refresh --- + +.sl__imRefresh cmp r0,#mEvent_subMenu ;Is this a submenu? + movnes pc,r14 ;No -- go away then + stmfd r13!,{r0-r7,r14} ;Save some registers + + ; --- Free the old title block --- + + ldr r0,[r12,#sl__modNames] ;Load the pointer + cmp r0,#0 ;Is the block allocated? + blne free ;Yes -- deallocate it them + movne r14,#0 ;And clear the pointer out + strne r14,[r12,#sl__modNames] ;Done that + + ; --- Enumerate interesting modules --- + + mov r6,#0 ;Size of block required + mov r1,#0 ;Start at the beginning + + ; --- Read the next module --- + +.loop mov r0,#12 ;Enumerate module names + mov r2,#0 ;Not interested in instances + swi "XOS_Module" ;Read the next module + bvs sl__imRefAlloc ;No more -- go to next phase + + ; --- Update the arguments for next call --- + + cmp r2,#0 ;Is there another instance? + addne r1,r1,#1 ;No -- update manually + + ; --- See whether this module was interesting --- + + ldr r14,[r3,#&20] ;Load the SWI handler offset + cmp r14,#0 ;Does this look sensible? + addne r6,r6,#8 ;Yes -- add another word + b loop ;Get more modules + + ; --- Allocate the block --- + +.sl__imRefAlloc mov r0,r6 ;Get the required size + bl alloc ;Allocate the block + blcs alloc_error ;If it failed, point to error + bcs sl__imRefError ;And handle that + str r0,[r12,#sl__modNames] ;Store pointer for later + mov r7,r0 ;Point to the block start + + ; --- Set up the title block --- + + adr r0,sl__rfmTitle ;Point to the title block + adr r1,sl__rfmKernel ;Point to event handler + mov r2,r10 ;Pass my R10 value + mov r3,r12 ;And my R12 value + bl menu_create ;Create the title + + ; --- Initialise for module scanning --- + + mov r6,#0 ;Current module number + + ; --- Read the next module --- + +.loop mov r0,#12 ;Enumerate module names + mov r1,r6 ;Get next module number + mov r2,#0 ;And next module name + swi "XOS_Module" ;Read the next module + ldmvsfd r13!,{r0-r7,pc}^ ;Return when done + + ; --- Update the arguments for next call --- + + cmp r2,#0 ;Is there another instance? + moveq r6,r1 ;Yes -- store it normally + addne r6,r1,#1 ;No -- update manually + + ; --- See whether this module was interesting --- + + ldr r14,[r3,#&20] ;Load the SWI handler offset + cmp r14,#0 ;Does this look sensible? + beq loop ;No -- loop round for more + + ; --- Add the menu item for this module --- + + ldr r14,[r3,#&10] ;Load the module name offset + add r14,r3,r14 ;Add this on to the base + stmia r7!,{r3,r14} ;Store base and name string + adr r0,sl__rfmItem ;Point to the menu block + adr r1,sl__rfmModule ;Point to the handler + sub r2,r7,#8 ;Point to name pointer + mov r3,r12 ;And get my workspace addr + bl menu_create ;Add to the current menu + b loop ;Keep on looping + + ; --- Report an error --- + +.sl__imRefError add r2,r0,#4 ;Point to error message + adr r0,FNliterr(1,"slMLE") ;Point to skeleton + bl str_error ;Mangle the message + mov r1,#1 ;Just an OK button + bl errorBox ;Report the message + ldmfd r13!,{r0-r7,pc}^ ;And return to caller + + ; --- Refresh module title --- + +.sl__rfmTitle FNmenu("slMDS") + ;FNmenu_item("slKNL") ;Not implemented + FNmenu_end + + ; --- Refresh module items --- + +.sl__rfmItem FNmenu_itemInd(4) + FNmenu_end + + FNltorg + + ; --- Quit the application --- + +.sl__imQuit stmfd r13!,{r14} ;Save return address away + bl sl__okToQuit ;Make sure it's all right + swics "OS_Exit" ;Yes -- just kill everything + ldmfd r13!,{pc}^ ;Otherwise ignore the request + + FNltorg + +; --- sl__rfmKernel --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Refreshes the kernel SWIs table. + +.sl__rfmKernel movs pc,r14 ;Not implemented + + FNltorg + +; --- sl__rfmModule --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Refreshes a particular module. + +.sl__rfmModule stmfd r13!,{r0,r1,r14} ;Save link + ldr r0,[r10,#0] ;Load module base + bl sl__scanMod ;Scan the module + movvs r1,#1 ;If it failed + blvs errorBox ;Report the error + ldmfd r13!,{r0,r1,pc}^ ;And return to caller + + FNltorg + +; --- sl__setFlags --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Sets up the flags from the flex anchors we have. + +.sl__setFlags stmfd r13!,{r0,r14} ;Save some registers + ldr r0,[r12,#sl__flags] ;Load the flags word + ldr r14,[r12,#sl__anchor] ;Load the block anchor + cmp r14,#0 ;Is that defined? + orrne r0,r0,#slFlag__block ;Yes -- set the flag + biceq r0,r0,#slFlag__block ;No -- clear it + tstne r0,#slFlag__format ;Is there a format chunk? + orrne r0,r0,#slFlag__savable ;Yes -- set savable flag + biceq r0,r0,#slFlag__savable ;No -- clear it then + str r0,[r12,#sl__flags] ;Save modified flags + ldmfd r13!,{r0,pc}^ ;And return to caller + + FNltorg + +; --- sl__unknowns --- +; +; On entry; R0 == event code +; R1 == pointer to event data +; +; On exit; CS if event interesting, else CC +; R2-R10 corrupted +; +; Use; Handles interesting messages (e.g. PreQuit) + +.sl__unknowns cmp r0,#17 ;Is this a User_Message? + cmpne r0,#18 ;Or a User_Message_Recorded? + movnes pc,r14 ;No -- ignore it then + + ldr r2,[r1,#16] ;Load the event code + cmp r2,#8 ;Is this a pre-quit message? + movnes pc,r14 ;No -- not interested then + + ; --- Handle a PreQuit message --- + + orrs r14,r14,#C_flag ;We claim this event now + stmfd r13!,{r14} ;Save return address + bl sl__okToQuit ;Ask user if required + ldmcsfd r13!,{pc}^ ;If OK then continue normally + + stmfd r13!,{r0-r2} ;Save some more registers + mov r0,r11 ;Point to scratchpad + ldr r2,[r1,#0] ;Load the message size + bl fastMove ;Copy the message data over + ldr r14,[r0,#8] ;Load his reference number + str r14,[r0,#12] ;Set this as a reply to it + mov r1,r0 ;Point to my copy + mov r0,#19 ;Send this as an acknowledge + ldr r2,[r1,#4] ;Load his task handle out + swi "Wimp_SendMessage" ;Send the message back + ldmfd r13!,{r0-r2,pc}^ ;Now return to caller + + FNltorg + +; --- sl__okToQuit --- +; +; On entry; -- +; +; On exit; CS if we're allowed to quit, else CC +; +; Use; Works out if we're allowed to quit the application. If it +; isn't sure, it pops up a warning box and asks. + +.sl__okToQuit stmfd r13!,{r0,r1,r14} ;Save some registers + ldr r14,[r12,#sl__flags] ;Load the flags word out + tst r14,#slFlag__modified ;Has the block been changed? + beq sl__otq90 ;No -- then skip onwards + + adr r0,FNlitsz("slOTQ") ;Point to warning messae + bl msgs_lookup ;Translate the tag + adr r1,sl__quitButts ;Point to buttons block + bl warning ;Pop up the warning box + ldmfd r13!,{r0,r1,r14} ;Unstack the registers + orrcss pc,r14,#C_flag ;If OK, set the C flag + bicccs pc,r14,#C_flag ;Otherwise clear it + +.sl__otq90 ldmfd r13!,{r0,r1,r14} ;Unstack the registers + orrs pc,r14,#C_flag ;Set C -- we're OK + +.sl__quitButts FNbutton("slQUTB") + FNbuttons_cancel + FNbuttons_end + + FNltorg + +;----- Save a SWI file ------------------------------------------------------ + +; --- sl__fmtHandler --- +; +; On entry; R0 == menu event +; R1 == menu item +; R10 == pointer to chunk name +; +; On exit; -- +; +; Use; Handles events on the save menu. + +.sl__fmtHandler cmp r0,#mEvent_help ;Is this a help request? + beq sl__fmtHelp ;Yes -- give help then + cmp r0,#mEvent_subMenu ;Is this a submenu? + cmpne r0,#mEvent_select ;Or a click? + movnes pc,r14 ;No -- ignore this + + stmfd r13!,{r0-r5,r14} ;Save some registers + ldr r0,[r12,#sl__used] ;Load the actual block size + ldr r1,FNlitw(&fff) ;Output as a data file + adr r2,FNlitsz("swis") ;Point to the dummy name + adr r3,sl__saveDef ;Point to handler block + mov r4,r10 ;Pass document handle + mov r5,r12 ;And pass the workspace addr + bl saveAs ;Try to do the save op + movvs r1,#1 ;If it failed, report error + blvs errorBox ;In a nice error box + ldmfd r13!,{r0-r5,pc}^ ;And return to caller + +.sl__saveDef FNs ("slSVT") ;Title for the save box + movs pc,r14 ;Don't care when it closes + b sl__saveFile ;Save to a disk file + b sl__send ;Send to another application + b xsave_done ;Tell xsave it's all done + b sl__failed ;Tidy up after a failure + +.sl__fmtHelp stmfd r13!,{r0-r2,r14} ;Save some registers + ldr r0,[r10,#4] ;Find the format chunk name + bl msgs_lookup ;Translate in case of tag + mov r1,r0 ;Point to the result + mov r0,r11 ;Point to scratchpad + bl str_cpy ;Copy the string over +.loop ldrb r14,[r0,#-1]! ;Load last byte of string + subs r14,r14,#ASC(".") ;Is it part of an ellipsis? + streqb r14,[r0,#0] ;Yes -- nobble that byte + beq loop ;And try again + adr r0,FNlitsz("slhSVF") ;Point to help message tag + bl msgs_lookup ;Translate the message + bl str_buffer ;Find an output buffer + mov r2,r11 ;Point to scratchpad string + bl str_subst ;And build the help string + bl help_add ;Add this to help message + ldmfd r13!,{r0-r2,pc}^ ;Return to caller + + FNltorg + +; --- sl__saveFile --- +; +; On entry; R0 == pointer to file name +; R1 == safe flag +; +; On exit; -- +; +; Use; Saves the SWI block to a file. + +.sl__saveFile stmfd r13!,{r0-r5,r14} ;Save some registers + mov r2,#0 ;No current name for this + bl sl__replace ;Do we replace the file? + movcc r0,#0 ;No -- return null error + bcc sl__sf20 ;But cancel the save op + + ; --- Get on with saving the file --- + +.sl__sf10 mov r3,r0 ;Look after the file name + adr r0,sl__writeList ;Point to saver routine + mov r1,r10 ;Pass it the document handle + mov r2,r12 ;And my workspace pointer + ldr r4,FNlitw(&FFF) ;Pass the filetype over + bl xsave_save ;Try to save the file + bvs sl__sf20 ;If failed, abort now + + ; --- Now retrostamp the file --- + + mov r0,#17 ;Read info on the file + mov r1,r3 ;Point to the filename + swi "XOS_File" ;Read info on the file + movvc r0,#1 ;Now we set the info + bicvc r2,r2,#&FF ;Leave filetype alone + orrvc r2,r2,#&3A ;Put in our dummy datestamp + ldrvc r3,FNlitw(&BD896000) ;Set up rest of datestamp + swivc "XOS_File" ;Now retrostamp it nicely + ldmvcfd r13!,{r0-r5,pc}^ ;If it worked OK, return + + ; --- It failed --- + +.sl__sf20 add r13,r13,#4 ;Don't restore R0 on exit + ldmfd r13!,{r1-r5,r14} ;Unstack saved registers + orrs pc,r14,#V_flag ;And return to caller + + FNltorg + +; --- sl__send --- +; +; On entry; R2 == accumulator value (initially 0) +; +; On exit; R0 == pointer to block to send +; R1 == size of block to send +; CS if this is the last block, else CC +; +; Use; Sends a block of data to another application. + +.sl__send adr r0,sl__writeList ;Point to my saver routine + mov r1,r10 ;Pass the document handle + mov r2,r12 ;Pass my workspace too + b xsave_send ;And get another block + + FNltorg + +; --- sl__failed --- +; +; On entry; R0 == pointer to error, or 0 +; R1 == 1 +; +; On exit; -- +; +; Use; Terminates a save job, and reports an error. + +.sl__failed stmfd r13!,{r0-r2,r14} ;Save some registers + bl xsave_failed ;Tell xsave it's finished + cmp r0,#0 ;Is there an actual error? + addne r2,r0,#4 ;Point to error text + adrne r0,FNliterr(1,"slSFE") + blne msgs_error ;Translate and substitute + movne r1,#1 ;Display just an OK button + blne errorBox ;Yes -- report it then + ldmfd r13!,{r0-r2,pc}^ ;Return to caller + + FNltorg + +; --- sl__replace --- +; +; On entry; R0 == filename +; R1 == safeness flag +; R2 == pointer to current name, or 0 +; +; On exit; -- +; +; Use; CS to save, CC to cancel + +.sl__replace stmfd r13!,{r0-r2,r14} ;Save some registers + cmp r1,#0 ;Is the file marked as safe? + beq sl__replace10 ;No -- then don't ask + + movs r1,r2 ;Is there a current name? + beq sl__replace05 ;No -- can't do this check + bl str_icmp ;Compare the file names + beq sl__replace10 ;The same name -- don't ask + +.sl__replace05 bl res_exists ;Does the file exist? + bcc sl__replace10 ;No -- then don't ask + + ; --- Ask the user if this is right --- + + mov r2,r0 ;Get the filename pointer + adr r0,FNlitsz("slRPP") ;Point to the prompt message + bl msgs_lookup ;Translate the message + bl str_buffer ;Find a handy string buffer + bl str_subst ;Build the prompt string + adr r1,sl__exWarn ;Point to the buttons def + bl warning ;Display the warning box + ldmccfd r13!,{r0-r2,r14} ;If no, abort the job + bicccs pc,r14,#C_flag ;Tell caller it's all off + +.sl__replace10 ldmfd r13!,{r0-r2,r14} ;Restore registers + orrs pc,r14,#C_flag ;And let it all go ahead + +.sl__exWarn FNbutton("slRPL") + FNbuttons_cancel + FNbuttons_end + + FNltorg + +;----- Write out a dump file ------------------------------------------------ + +; --- sl__svdDone --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Handles the save box closing. We allow loads of dump files +; again. + +.sl__svdDone stmfd r13!,{r14} ;Save some registers + ldr r14,[r12,#sl__flags] ;Load the flags word + bic r14,r14,#slFlag__saving ;Turn off the saving flag + str r14,[r12,#sl__flags] ;Save the flags back + ldmfd r13!,{pc}^ ;And return to caller + + FNltorg + +; --- sl__saveDump --- +; +; On entry; R0 == pointer to file name +; R1 == safeness flag +; +; On exit; -- +; +; Use; Saves a dump of the current SWI names + +.sl__saveDump stmfd r13!,{r0-r5,r14} ;Save some registers + add r2,r12,#sl__dumpFile ;Point to current name + bl sl__replace ;Do we actually do this? + movcc r0,#0 ;If not, return null error + bcc sl__saved90 ;To cancel the save op + + mov r1,r0 ;Point to the filename + mov r0,#10 ;Save memory as a file + ldr r2,FNlitw(&FFD) ;Save as a data file + add r14,r12,#sl__anchor ;Point to dump anchor + ldmia r14,{r4,r5} ;Load base and size + add r5,r4,r5 ;Turn size into limit + swi "XOS_File" ;Try to save the file + bvs sl__saved90 ;If it failed, abort + + ldr r14,[r13,#4] ;Load the safeness flag + cmp r14,#0 ;Is the flag safe? + beq sl__saved50 ;No -- skip onwards then + + ; --- Do special things when file saved properly --- + + ldr r14,[r12,#sl__flags] ;Yes -- load flags then + bic r14,r14,#slFlag__modified ;Clear the modified bit + str r14,[r12,#sl__flags] ;And store the flags back + + bl sl__setDumpName ;Go and set the name + +.sl__saved50 ldmfd r13!,{r0-r5,pc}^ ;Return to caller + +.sl__saved90 add r13,r13,#4 ;Don't restore R0 on exit + ldmfd r13!,{r1-r5,r14} ;Restore registers + orrs pc,r14,#V_flag ;And return with V set + + FNltorg + +; --- sl__sendDump --- +; +; On entry; -- +; +; On exit; R0 == pointer to block to send +; R1 == size of block +; CS for last block, CC otherwise +; +; Use; Sends the SWI dump block to another application + +.sl__sendDump add r0,r12,#sl__anchor ;Find the anchor block + ldmia r0,{r0,r1} ;Load the values out + orrs pc,r14,#C_flag ;And return the only block + + FNltorg + +; --- sl__svdFail --- +; +; On entry; R0 == pointer to error, or 0 +; R1 == 1 +; +; On exit; -- +; +; Use; Terminates a save job, and reports an error. + +.sl__svdFail stmfd r13!,{r0-r2,r14} ;Save some registers + cmp r0,#0 ;Is there an actual error? + addne r2,r0,#4 ;Point to error text + adrne r0,FNliterr(1,"slSDE") + blne msgs_error ;Translate and substitute + movne r1,#1 ;Display just an OK button + blne errorBox ;Yes -- report it then + ldmfd r13!,{r0-r2,pc}^ ;Return to caller + + FNltorg + +;----- Writing out a list of SWIs ------------------------------------------- + +; --- sl__writeList --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Writes the list of SWIs to the current xsave output. + +.sl__writeList stmfd r13!,{r0-r10,r14} ;Save some registers + + ; --- Make sure we can do this --- + + ldr r14,[r12,#sl__anchor] ;Load the block anchor + cmp r14,#0 ;Is it created currently? + adreq r0,FNliterr(1,"slNSS") + bleq msgs_error ;Translate the error + beq sl__wl90 ;And return the error + ldr r14,[r12,#sl__format] ;Load the format anchor + cmp r14,#0 ;Is it created currently? + adreq r0,FNliterr(1,"slNFD") + bleq msgs_error ;Translate the error + beq sl__wl90 ;And return the error + + ; --- Get on with saving then --- + + swi "Hourglass_On" ;Start an hourglass going + + ; --- Set up initial registers --- + + ldr r9,[r10,#0] ;Load the block base + mov r0,r10 ;Point to the anchor + bl flex_size ;Get the block size + add r10,r9,r0 ;Find the format limit + adr r8,FNlitsz("*UNDEFINED*") ;No module name defined yet + mov r7,r8 ;No prefix string yet either + mov r6,r8 ;And no actual SWI name + mvn r5,#NOT(-1) ;No SWI number defined either + + ; --- Write out the preamble --- + + bl sl__doString ;Write out this format + bvs sl__wl90 ;If it failed, bail out + + ; --- We've found the module header --- + ; + ; Now we set up for the main loop, by remembering the index + ; into the format string; we then embark on the first item + ; in the SWI list. + + mov r4,r9 ;Remember this position + ldr r3,[r12,#sl__anchor] ;Load the anchor base address + mov r2,#0 ;Start at the beginning + + ; --- The main output loop --- + +.sl__wl15 add r1,r3,r2 ;Work out address of block + ldr r5,[r1,#4] ;Load the SWI chunk number + bic r5,r5,#&ff000000 ;Clear the flags bits + add r8,r1,#8 ;Point to the module name + mov r9,r4 ;Start from preamble position + bl sl__doString ;Write out this format string + bvs sl__wl90 ;If it failed, bail out + + ; --- Written the header -- now do the SWIs --- + + mov r2,r9 ;Remeber format index + mov r7,r8 ;Work out prefix string pos +.sl__wl20 ldrb r14,[r7],#1 ;Load next byte + cmp r14,#0 ;Is this end of module name? + bne sl__wl20 ;No -- keep going round + + mov r6,r7 ;Work out SWI name position +.sl__wl25 ldrb r14,[r6],#1 ;Load next byte from string + cmp r14,#0 ;Is this the end yet? + bne sl__wl25 ;No -- keep going +.sl__wl26 ldrb r14,[r6,#0] ;Load the first byte + cmp r14,#0 ;Is it a null string? + beq sl__wl30 ;Yes -- move on to next mod + cmp r14,#1 ;Is this a dummy SWI? + addeq r6,r6,#1 ;Yes -- move pointer on + addeq r5,r5,#1 ;And move on the SWI counter + beq sl__wl26 ;And start again + + mov r9,r2 ;Point to format string + bl sl__doString ;Write this string out + bvs sl__wl90 ;If it failed, bail out + add r5,r5,#1 ;Bump up the SWI number + b sl__wl25 ;And go round for more + + ; --- Finished a module --- + +.sl__wl30 ldr r2,[r1,#0] ;Load the size word + sub r14,r1,r3 ;Work out old offset + add r2,r14,r2 ;Add it onto previous offset + ldr r14,[r12,#sl__used] ;Load current size of block + cmp r2,r14 ;Is this the last one? + bcc sl__wl15 ;No -- do this module too + + ; --- Do the end bit of the file --- + + bl sl__doString ;Write out the postamble + bvs sl__wl90 ;If it failed, bail out + + swi "Hourglass_Off" ;Turn off the hourglass + ldmfd r13!,{r0-r10,pc}^ ;Return to caller + + ; --- It failed -- return an error + +.sl__wl90 swi "Hourglass_Off" ;Turn off the hourglass + add r13,r13,#4 ;Don't restore R0 + ldmfd r13!,{r1-r10,r14} ;Restore registers + orrs pc,r14,#V_flag ;And return the error + + FNltorg + +; --- sl__doString --- +; +; On entry; R5 == current SWI number +; R6 == pointer to current SWI postfix +; R7 == pointer to current SWI prefix +; R8 == pointer to current module name +; R9 == pointer to format string input +; R10 == pointer to end of format string +; +; On exit; R1, R2, R4 and R6-R10 may be flex relocated +; R0 corrupted +; R9 == pointer to format string when processing stopped +; May return an error +; +; Use; Outputs a string, based on a format with the following +; syntax: +; +; All characters are echoed directly except `%' which is +; an escape for the following character. Escape codes defined +; are: +; +; %s == current SWI name +; %m == current module name +; %n == current SWI number +; %x == current X SWI number (i.e. SWI number OR &20000) +; %% == end of formatting section + +.sl__doString stmfd r13!,{r3,r14} ;Save some registers + FNflex_save("r1,r2,r4") ;Save caller's registers + sub r13,r13,#128 ;Make a small buffer + orr r3,r5,#&20000 ;Get the X version number + +.sl__dostr10 cmp r9,r10 ;Are we at the end yet? + bcs sl__dostr50 ;Yes -- return then + ldrb r0,[r9],#1 ;Load next byte from string + cmp r0,#ASC("%") ;Is this a magic `%' sign? + beq sl__dostr20 ;Yes -- do clever things + + bl sl__byte ;Write this byte out + b sl__dostr10 ;And continue formatting + + ; --- Handle an escape character --- + +.sl__dostr20 ldrb r0,[r9],#1 ;Load next byte from string + orr r0,r0,#&20 ;Make sure char is lowercase + cmp r0,#ASC("s") ;Is this a SWI name? + adreq r0,FNlitsz("%5_%4") ;Yes -- point to skeleton + cmp r0,#ASC("m") ;Or the module name? + adreq r0,FNlitsz("%6") ;Yes -- point to skeleton + cmp r0,#ASC("n") ;Or the SWI number? + adreq r0,FNlitsz("%x3") ;Yes -- point to skeleton + cmp r0,#ASC("x") ;Or the SWI X number? + adreq r0,FNlitsz("%x1") ;Yes -- point to skeleton + cmp r0,#ASC("d") ;Or a date string? + beq sl__dostr40 ;Yes -- process specially + cmp r0,#ASC("p") ;Or a literal percent? + adreq r0,FNlitsz("%%") ;Yes -- point to skeleton + cmp r0,#ASC("%") ;Or a percent sign? + addeq r9,r9,#1 ;Yes -- skip a newline char + beq sl__dostr50 ;Yes -- handle that + + cmp r0,#256 ;Do we have an address? + bcc sl__dostr10 ;No -- go round for more then + + mov r1,r13 ;Build string in it + bl str_subst ;Build output string + mov r2,r0 ;Point to the string +.sl__dostr30 ldrb r0,[r2],#1 ;Load next byte + cmp r0,#32 ;Is it the terminator? + blcs sl__byte ;No -- output it then + bcs sl__dostr30 ;And loop back round again + b sl__dostr10 ;Carry on with the string + + FNltorg + + ; --- Handle a date format string --- + +.sl__dostr40 stmfd r13!,{r3} ;I need this register + sub r13,r13,#8 ;Make time buffer on stack + mov r14,#3 ;Get the subreason code + strb r14,[r13,#0] ;Save that in the block + mov r1,r13 ;Point to the buffer + mov r0,#14 ;Get the main reason code + swi "OS_Word" ;Read the current time + + ldrb r0,[r9,#0] ;Load the next byte ready + cmp r0,#ASC("[") ;Is this an argument? + adrne r0,FNlitsz("slDFMT") ;No -- point to default + blne msgs_lookup ;Translate nicely + movne r3,r0 ;And put it in the right reg + bne sl__dostr45 ;And skip onwards a bit + + ; --- Read the format string argument --- + + mov r1,r11 ;Point to a spare buffer + add r9,r9,#1 ;Skip past the `[' char +.a ldrb r14,[r9],#1 ;Load the next byte + cmp r14,#ASC("]") ;Is that the end yet? + cmpne r14,#&0D ;Check return for safety + moveq r14,#0 ;Yes -- terminate string + strb r14,[r1],#1 ;Store the byte away + bne a ;Loop until all done + mov r3,r11 ;Point to the format string + + ; --- Now read the actual string --- + +.sl__dostr45 mov r0,r13 ;Point to the time block + add r1,r13,#12 ;Point to output buffer + mov r2,#128 ;Get the buffer size + swi "OS_ConvertDateAndTime" ;Translate the string + add r13,r13,#8 ;Don't need the time any more + ldmfd r13!,{r3} ;Restore register I saved + mov r2,r13 ;Point to buffer start + b sl__dostr30 ;Now output this string + + ; --- Finished reading the input --- + +.sl__dostr50 add r13,r13,#128 ;Reclaim my little buffer + FNflex_load("r1,r2,r4") ;Restore caller's pointers + ldmfd r13!,{r3,r14} ;Restore other registers + bics pc,r14,#V_flag ;Return without an error + + ; --- Write byte in R0 to output --- + +.sl__byte mov r1,r14 ;Look after return address + FNflex_save("r6-r10") ;Save lots of values + bl xsave_byte ;Write this byte out + FNflex_load("r6-r10") ;Restore our registers + movvcs pc,r1 ;If OK, return to caller + + add r13,r13,#128 ;Reclaim my little buffer + FNflex_load("r1,r2,r4") ;Restore caller's pointers + ldmfd r13!,{r3,r14} ;Restore other registers + orrs pc,r14,#V_flag ;And return the error + + FNltorg + +;----- Loading modules ------------------------------------------------------ + +; --- sl__loadMod --- +; +; On entry; R1 == pointer to filename +; +; On exit; May return an error +; +; Use; Loads a module and adds its SWIs to the current list. + +.sl__loadMod stmfd r13!,{r0-r2,r14} ;Save some registers + add r2,r12,#sl__module ;Point to anchor for this + bl load_file ;Try to load the file + strvs r0,[r13,#0] ;If failed, return error + ldmfd r13!,{r0-r2,pc} ;Return to caller + + FNltorg + +; --- sl__ibMod --- +; +; On entry; R1 == estimated file size +; +; On exit; May return an error +; +; Use; Sets up a buffer for RAM loading. + +.sl__ibMod add r2,r12,#sl__module ;Point to anchor + b load_initBuf ;Start the load op + + FNltorg + +; --- sl__doneMod --- +; +; On entry; -- +; +; On exit; -- +; +; Use; Adds a module to the SWI list. + +.sl__doneMod stmfd r13!,{r0-r2,r14} ;Save some registers + ldr r0,[r12,#sl__module] ;Load the flex anchor + bl sl__scanMod ;Scan the module + bvs sl__doneMod50 ;If it failed, quit now + add r0,r12,#sl__module ;Point to the anchor + bl flex_free ;Free the block + ldmfd r13!,{r0-r2,pc}^ ;And return to caller + +.sl__doneMod50 add r2,r0,#4 ;Look after the error + add r0,r12,#sl__module ;Point to the anchor + bl flex_free ;Free the block + adr r0,FNliterr(1,"slMAA") + bl msgs_error ;Translate and substitute + mov r1,#1 ;Only have one button + bl errorBox ;Report the error + ldmfd r13!,{r0-r2,pc}^ ;And return to caller + + FNltorg + +; --- sl__lfMod --- +; +; On entry; R0 == pointer to error +; R1 == 1 +; +; On exit; -- +; +; Use; Reports an error when an attemt to load a module failed. + +.sl__lfMod stmfd r13!,{r0-r2,r14} ;Save some registers + cmp r0,#0 ;Is there a real error? + addne r2,r0,#4 ;Point to error text + adrne r0,FNliterr(1,"slLFM") + blne msgs_error ;Translate and substitute + movne r1,#1 ;Only use one button + blne errorBox ;Report the error + ldmfd r13!,{r0-r2,pc}^ ;And return to caller + + FNltorg + +;----- Loading dump files --------------------------------------------------- + +; --- sl__loadDmp --- +; +; On entry; R1 == pointer to filename +; +; On exit; May return an error +; +; Use; Loads a module and adds its SWIs to the current list. + +.sl__loadDmp stmfd r13!,{r0-r2,r14} ;Save some registers + add r0,r12,#sl__anchor ;Point to the anchor + ldr r14,[r12,#sl__anchor] ;Load the current anchor + cmp r14,#0 ;Is it defined currently? + blne flex_free ;Yes -- free the block + add r2,r12,#sl__anchor ;Point to anchor for this + bl load_file ;Try to load the file + strvs r0,[r13,#0] ;On error, return pointer + ldmfd r13!,{r0-r2,pc} ;And return to caller + + FNltorg + +; --- sl__ibDmp --- +; +; On entry; R1 == estimated file size +; +; On exit; May return an error +; +; Use; Sets up a buffer for RAM loading. + +.sl__ibDmp stmfd r13!,{r0,r14} ;Save some registers + add r0,r12,#sl__anchor ;Point to the anchor + ldr r14,[r12,#sl__anchor] ;Load the current anchor + cmp r14,#0 ;Is it defined currently? + blne flex_free ;Yes -- free the block + ldmfd r13!,{r0,r14} ;Unstack the registers + add r2,r12,#sl__anchor ;Point to anchor + b load_initBuf ;Start the load op + + FNltorg + +; --- sl__doneDmp --- +; +; On entry; R0 == pointer to `filename' +; +; On exit; -- +; +; Use; Handles a completed load of a dump file. + +.sl__doneDmp stmfd r13!,{r0,r1,r14} ;Save some registers + mov r1,r0 ;Point to the file's name + bl sl__setDumpName ;Set the name up correctly + add r0,r12,#sl__anchor ;Point to the anchor block + bl flex_size ;Read the block's size + str r0,[r12,#sl__used] ;Save the size as used value + str r0,[r12,#sl__size] ;And as the size value + ldr r14,[r12,#sl__flags] ;Load the flags word + bic r14,r14,#slFlag__modified ;Got it from someone else + str r14,[r12,#sl__flags] ;Store the flags back + bl sl__setFlags ;Reset the flags nicely + ldmfd r13!,{r0,r1,pc}^ ;Return to caller + + FNltorg + +; --- sl__lfDmp --- +; +; On entry; R0 == pointer to error +; R1 == 1 +; +; On exit; -- +; +; Use; Reports an error when an attemt to load a module failed. + +.sl__lfDmp stmfd r13!,{r0-r2,r14} ;Save some registers + bl sl__setFlags ;Update the flags + cmp r0,#0 ;Is there a real error? + addne r2,r0,#4 ;Point to error text + adrne r0,FNliterr(1,"slLFM") + blne msgs_error ;Translate and substitute + movne r1,#1 ;Only use one button + blne errorBox ;Report the error + ldmfd r13!,{r0-r2,pc}^ ;And return to caller + + FNltorg + +;----- Format of the SWI table ---------------------------------------------- +; +; In order to speed things up, we maintain a table of SWI names in memory, +; and write this out to a file when the user wants us to. This also means +; that we can build up a list of SWIs over a period of time, by the user +; dropping module files onto our icon or window -- this saves having to load +; large numbers of modules into the RMA. +; +; The format is fairly simple. We keep a linked list of module blocks in +; a flex block. The blocks are sorted by ascending order of SWI chunk base +; numbers. Each module block looks like this; +; +; word; size of this link block +; word; SWI chunk base number for module and flags in top 8 bits +; string; name of module which provides these SWIs (null-terminated) +; string; SWI prefix for following SWI names (null-terminated) +; string; name of first SWI provided by module (null-terminated) +; string; name of second SWI provided by module (null-terminated) +; ... ... +; string; name of last SWI provided by module (null-terminated) +; byte; 0 (list terminator) +; align; to word boundary + +; --- sl__setDumpName --- +; +; On entry; R1 == 0 for default `SWIDump' or pointer to name +; +; On exit; -- +; +; Use; Sets the name of the current dump file. + +.sl__setDumpName stmfd r13!,{r0-r2,r14} ;Save some registers + movs r0,r1 ;Point to the source string + adreq r0,FNlitsz("SWIDump") ;No string -- use default + add r1,r12,#sl__dumpFile ;Point to the name buffer + mov r2,#256 ;The buffer size + orr r2,r2,#&C0000000 ;Don't do `|'s or `""'s + swi "OS_GSTrans" ;Expand system variables + ldmfd r13!,{r0-r2,pc}^ ;And return to caller + + FNltorg + +; --- sl__initBlock --- +; +; On entry; -- +; +; On exit; May return an error +; +; Use; Initialises the SWI list block with the currently recognised +; OS SWIs. + +.sl__initBlock stmfd r13!,{r0-r3,r14} ;Save some registers + + add r0,r12,#sl__anchor ;Point to the anchor + ldr r14,[r12,#sl__anchor] ;Load the current anchor + cmp r14,#0 ;Is it defined currently? + blne flex_free ;Yes -- free the block + + ; --- Reset the dump file name --- + + mov r1,#0 ;Use the default name + bl sl__setDumpName ;Go and do that please + + ; --- Create the flex block --- + + mov r1,#1024 ;Initially make it 1K + bl flex_alloc ;Allocate the block + blcs alloc_error ;If it failed, get an error + bcs sl__initBlk90 ;And abort now + + mov r14,r1 ;Get the size created + mov r1,#0 ;Start output at beginning + stmib r0,{r1,r14} ;Store sizes after anchor + + ; --- Now build the kernel SWIs --- + ; + ; First do OS_WriteI. Then we do the kernel SWIs lower than + ; &100. + + adr r0,FNlitsz("Kernel") ;Point to string `Kernel' + adr r1,FNlitsz("OS") ;Point to string `OS' + mov r2,#&100 ;Get SWI chunk number + bl sl__newLink ;Add in a new link block + bvs sl__initBlk89 ;If it failed, stop going + bcs sl__initBlk05 ;If already done, skip + add r0,r12,#sl__anchor ;Point to the anchor + adr r1,FNlitsz("WriteI") ;Point to string `WriteI' + bl sl__string ;Add it to the block + blvc sl__endLink ;Terminate this link + bvs sl__initBlk89 ;If it failed, stop going + + ; --- Now do the kernel SWIs --- + +.sl__initBlk05 adr r0,FNlitsz("Kernel") ;Point to string `Kernel' + adr r1,FNlitsz("OS") ;Point to string `OS' + mov r2,#&0 ;Get SWI chunk number + bl sl__newLink ;Add in a new link block + bvs sl__initBlk89 ;If it failed, stop going + bcs sl__initBlk17 ;Already there -- skip on + mov r3,#0 ;Start at SWI number 0 + +.sl__initBlk10 mov r0,r3 ;Get the SWI number + mov r1,r11 ;Build string in scratchpad + mov r2,#256 ;And give the block size + swi "OS_SWINumberToString" ;Read the SWI name + swi "XOS_SWINumberFromString" ;Try to convert back + cmp r0,r3 ;Is this what we expected? + bne sl__initBlk13 ;No -- skip to end of loop + + add r0,r12,#sl__anchor ;Point to the anchor + add r1,r11,#3 ;Skip past `OS_' prefix + bl sl__string ;Add it to the list + bvs sl__initBlk89 ;If it failed, stop going + b sl__initBlk15 ;Skip past the next bit + +.sl__initBlk13 add r0,r12,#sl__anchor ;Point to the anchor + mov r1,#1 ;Want one extra byte + bl sl__ensure ;Make sure I've got it + bvs sl__initBlk89 ;If it failed, stop going + mov r14,#1 ;Mark this as nonexistant + strb r14,[r0],#1 ;Store it in the block + +.sl__initBlk15 add r3,r3,#1 ;Bump the SWI number + cmp r3,#&100 ;Reached the end yet? + blt sl__initBlk10 ;No -- go back round then + + ; --- Finished that; end the link block --- + + bl sl__endLink ;Terminate the link block + bvs sl__initBlk89 ;If it failed, stop going + + ; --- Now go through the module list --- + +.sl__initBlk17 mov r1,#0 ;Start on first module +.sl__initBlk20 mov r2,#0 ;Start on first instance + mov r0,#12 ;Enumerate module addresses + swi "XOS_Module" ;Read next module number + bvs sl__initBlk30 ;If error must have finished + mov r0,r3 ;Point to module base address + bl sl__scanMod ;Scan module for SWIs + bvs sl__initBlk90 ;If it failed, stop going + cmp r2,#0 ;Are there more instances? + addne r1,r1,#1 ;Yes -- move to next module + b sl__initBlk20 ;Go handle the next module + + ; --- Finished the module list --- + +.sl__initBlk30 bl sl__setFlags ;Reset the flags + ldmfd r13!,{r0-r3,r14} ;Unstack the registers + bics pc,r14,#V_flag ;And return without error + + ; --- Something went wrong --- + +.sl__initBlk89 mov r3,r0 ;Look after error pointer + add r0,r12,#sl__anchor ;Point to the anchor + bl flex_free ;Free the block + mov r1,#0 ;Clear the anchor pointer + str r1,[r12,#sl__anchor] ;Save it in the block + bl sl__setFlags ;Reset the flags nicely + mov r0,r3 ;And restore error pointer + +.sl__initBlk90 add r13,r13,#4 ;Don't restore R0 on exit + ldmfd r13!,{r1-r3,r14} ;Restore registers + orrs pc,r14,#V_flag ;And return the error + + FNltorg + +; --- sl__scanMod --- +; +; On entry; R0 == pointer to module +; +; On exit; May return an error +; +; Use; Scans a module, and adds its SWIs to the list. + +.sl__scanMod stmfd r13!,{r0-r4,r14} ;Save some registers + mov r3,r0 ;Look after module base + + ; --- Make sure this module's OK --- + + ldr r0,[r3,#16] ;Load the name offset + ldr r1,[r3,#36] ;Load the SWI name table + ldr r2,[r3,#28] ;And the SWI chunk number + cmp r0,#256*1024 ;Make sure these are valid + cmpcc r1,#256*1024 ;Both offsets please + bcs sl__scanMod80 ;If not, ignore this module + + tst r2,#&FF000000 ;Make sure SWI chunk's OK + tsteq r2,#&0000003f + tsteq r2,#&00020000 + bne sl__scanMod80 ;If not, ignore this module + cmp r2,#&200 ;Is chunk in user range? + bcc sl__scanMod80 ;No -- ignore this module + + ; --- Set the file modified flag --- + + ldr r14,[r12,#sl__flags] ;Load the flags word + orr r14,r14,#slFlag__modified ;Set the flag + str r14,[r12,#sl__flags] ;Save the flags back again + + ; --- We now have a module to add --- + ; + ; For error recovery, we read the current block sizes, so + ; we can reset them if all goes wrong. + + add r0,r3,r0 ;Translate offset to address + add r1,r3,r1 ;For both offsets + add r14,r12,#sl__used ;Point to block size info + ldmia r14,{r3,r4} ;Load the size counts + FNflex_save("r1") ;Look after this pointer + bl sl__newLink ;Add a new link in + FNflex_load("r1") ;Restore pointer afterwards + bvs sl__scanMod90 ;If it failed, return error + + ; --- Now just add the SWI names in --- + +.sl__scanMod10 ldrb r14,[r1],#1 ;Load a SWI prefix byte + cmp r14,#0 ;Is this the end yet? + bne sl__scanMod10 ;No -- keep on going + + ldrb r14,[r1],#0 ;Load the next byte out + cmp r14,#0 ;Is this the double-0? + beq sl__scanMod15 ;Yes -- end right now + add r0,r12,#sl__anchor ;Point to anchor block + FNflex_save("r1") ;Save this pointer away + bl sl__string ;Add string to the list + FNflex_load("r1") ;Restore this pointer + bvs sl__scanMod89 ;If it failed, report error + b sl__scanMod10 ;Keep on adding names + + ; --- Finished that -- wrap everything up --- + +.sl__scanMod15 bl sl__endLink ;Terminate this block + bvs sl__scanMod89 ;If it failed, tidy up +.sl__scanMod80 ldmfd r13!,{r0-r4,r14} ;Restore registers + bics pc,r14,#V_flag ;And return with V clear + + ; --- Failed to do the job --- + +.sl__scanMod89 mov r2,r0 ;Save the error pointer + add r0,r12,#sl__anchor ;Point to the flex anchor + mov r1,r4 ;Get the old size value + bl flex_extend ;Reset the size + stmib r0,{r3,r4} ;Save old index values + mov r0,r2 ;Restore the error pointer + +.sl__scanMod90 add r13,r13,#4 ;Don't restore R0 on exit + ldmfd r13!,{r1-r4,r14} ;Restore the other registers + orrs pc,r14,#V_flag ;And return to caller + + FNltorg + +; --- sl__newLink --- +; +; On entry; R0 == pointer to module name +; R1 == pointer to SWI prefix +; R2 == SWI chunk number +; +; On exit; May return an error +; +; Use; Ensures that a link block for the given module exists. If +; it doesn't exist already, it is created at the end of the +; flex block. The index of the last link is returned, so it +; can be cleared if the actual SWI names can't be added. + +.sl__newLink stmfd r13!,{r0-r7,r14} ;Save some registers + + ; --- Set up for checking loop --- + + mov r3,r0 ;Look after module name + mov r4,r1 ;And the SWI prefix string + FNflex_save("r1,r3") ;Save these for relocation + add r14,r12,#sl__anchor ;Point to the anchor + ldmia r14,{r5,r6} ;Load base and size + + ; --- Wade on through the block --- + + mov r7,#0 ;Start at offset 0 +.sl__newl10 cmp r7,r6 ;Reached the end yet? + bcs sl__newl30 ;Yes -- better stop then + + ; --- See if this is a match --- + + add r14,r5,r7 ;Find current address + ldr r0,[r14,#4] ;Load the SWI chunk number + bic r0,r0,#&ff000000 ;Clear the flags byte + cmp r0,r2 ;Does this match our one? + bne sl__newl15 ;No -- move along then + + add r0,r14,#8 ;Point to the module name + mov r1,r3 ;Point to our module name + bl str_cmp ;Compare the strings + bne sl__newl15 ;No match -- move along then + +.sl__newl13 ldrb r14,[r0],#1 ;Load module name byte + cmp r14,#32 ;Is this the end? + bcs sl__newl13 ;No -- keep going + + mov r1,r4 ;Point to the SWI prefix + bl str_cmp ;Do these match? + beq sl__newl20 ;Yes -- remove this chunk + +.sl__newl15 ldr r14,[r5,r7] ;Load the length of this one + add r7,r7,r14 ;Move on to the next block + b sl__newl10 ;And keep on going + + ; --- Found a match -- remove a chunk --- + +.sl__newl20 add r0,r12,#sl__anchor ;Point to the anchor + ldr r2,[r5,r7] ;Get the block's size + add r1,r7,r2 ;Start at the end of it + rsb r2,r2,#0 ;And reduce block by this + bl flex_midExtend ;Remove this chunk of data + add r6,r6,r2 ;Modify the block size + str r6,[r12,#sl__used] ;Save this size back + ldr r14,[r12,#sl__size] ;Load the total block size + add r14,r14,r2 ;Adjust that value too + str r14,[r12,#sl__size] ;Store my modified value back + ldr r2,[r13,#8] ;Restore caller's SWI base + + ; --- Add a new chunk onto the block --- + +.sl__newl30 str r6,[r12,#sl__last] ;Save the base of this block + ldr r7,[r12,#sl__size] ;Get the block total size + + add r0,r12,#sl__anchor ;Point to anchor and info + mov r1,#8 ;Add in fixed size info + bl sl__ensure ;Make sure there's enough + strvc r2,[r0,#4] ;Save the SWI chunk number + + addvc r0,r12,#sl__anchor ;Point to anchor and info + FNflex_load("r1") ;Unstack module name pointer + blvc sl__string ;Add the string in + FNflex_load("r1") ;Unstack SWI prefix string + blvc sl__string ;Add the string in + + ldmvcfd r13!,{r0-r7,r14} ;Unstack registers + bicvcs pc,r14,#V_flag ;And return to caller + + ; --- It failed -- better tidy up --- + + mov r2,r0 ;Look after error number + add r0,r12,#sl__anchor ;Point to the anchor + mov r1,r7 ;Get the old size back + bl flex_extend ;Reset the block size + stmib r0,{r6,r7} ;Save the old values back + mov r0,r2 ;Get the error pointer + add r13,r13,#4 ;Don't restore R0 on exit + ldmfd r13!,{r1-r7,r14} ;Restore registers + orrs pc,r14,#V_flag ;Return the error + + FNltorg + +; --- sl__endLink --- +; +; On entry; -- +; +; On exit; May return an error +; +; Use; Terminates a link block. + +.sl__endLink stmfd r13!,{r0,r1,r14} ;Save some registers + add r0,r12,#sl__anchor ;Find the flex block + mov r1,#1 ;Want to add a single byte + bl sl__ensure ;Make sure we've got enough + bvs sl__endl90 ;If it failed, return + + mov r14,#0 ;Get the NULL byte ready + strb r14,[r0,#0] ;Save it at the end nicely + add r0,r12,#sl__anchor ;Find the flex block again + bl sl__align ;Word align output pointer + + ldmia r0,{r0,r14} ;Load block base and size + ldr r1,[r12,#sl__last] ;Load the offset of the block + sub r14,r14,r1 ;Get the last chunk size? + str r14,[r0,r1] ;Save the length word + + ldmfd r13!,{r0,r1,r14} ;And return to caller + bics pc,r14,#V_flag ;Return without error + +.sl__endl90 add r13,r13,#4 ;Don't return R0 on exit + ldmfd r13!,{r1,r14} ;Restore registers + orrs pc,r14,#V_flag ;And return the error + + FNltorg + +;----- Block management routines -------------------------------------------- + +; --- sl__ensure --- +; +; On entry; R0 == pointer to anchor/size block +; R1 == number of bytes to add +; +; On exit; R0 == pointer to allocated area +; May return an error +; +; Use; Ensures that there are R1 bytes free at the end of the given +; flex block. + +.sl__ensure stmfd r13!,{r1,r2,r14} ;Save some registers + ldmib r0,{r2,r14} ;Load the base and sizes + add r1,r1,r2 ;Find new total size + str r1,[r0,#4] ;Save this back + add r1,r1,#255 ;Align up to next 256 + bic r1,r1,#255 ;For niceness's sake + cmp r1,r14 ;Do we already have enough + bhi sl__ensure50 ;No -- allocate some more +.sl__ensure10 str r1,[r0,#8] ;Save new total size + ldr r0,[r0,#0] ;Load address of block + add r0,r0,r2 ;Point to first free byte + ldmfd r13!,{r1,r2,r14} ;Unstack registers + bics pc,r14,#V_flag ;And return without error + +.sl__ensure50 bl flex_extend ;Extend the block nicely + bcc sl__ensure10 ;Rejoin program if OK + bl alloc_error ;Get the error message + ldmfd r13!,{r1,r2,pc} ;Return error to caller + + FNltorg + +; --- sl__string --- +; +; On entry; R0 == pointer to flex block and size information +; R1 == pointer to string +; +; On exit; May return an error +; +; Use; Adds a string to a flex block. + +.sl__string stmfd r13!,{r0-r3,r14} ;Save some registers + mov r2,r0 ;Look after anchor address + FNflex_save("r1") ;Save the string address + mov r0,r1 ;Point to the string + bl str_len ;Work out the length + add r1,r0,#1 ;Get the required size + mov r0,r2 ;Point to anchor and sizes + bl sl__ensure ;Make sure the space is OK + FNflex_load("r1") ;Restore R1 from stack + blvc str_cpy ;And copy it into the block + strvs r0,[r13,#0] ;Otherwise store the error + ldmfd r13!,{r0-r3,pc} ;And return to caller + + FNltorg + +; --- sl__align --- +; +; On entry; R0 == pointer to flex anchor and size info +; +; On exit; -- +; +; Use; Word aligns the output pointer of a flex block. + +.sl__align stmfd r13!,{r14} ;Save a register + ldr r14,[r0,#4] ;Load the output offset + add r14,r14,#3 ;Word align this offset + bic r14,r14,#3 ;Mask off bottom bits + str r14,[r0,#4] ;Store new offset back + ldmfd r13!,{pc}^ ;And return to caller + + FNltorg + +;----- Workspace ------------------------------------------------------------ +] + PROCws_start + +sl__flags =FNws_word :REM ;Various flags bits +sl__anchor =FNws_word :REM ;Flex anchor for SWI table +sl__used =FNws_word :REM ;Size used in flex block +sl__size =FNws_word :REM ;Actual size of flex block +sl__last =FNws_word :REM ;Offset of last block +sl__modNames =FNws_word :REM ;Block for module names +sl__format =FNws_word :REM ;Format chunk handle +sl__module =FNws_word :REM ;Anchor for loading modules +sl__pollBlock =FNws (256) :REM ;Wimp_Poll data block +sl__dumpFile =FNws (256) :REM ;Full pathname of dump file + +sl__wSize =FNws (0) + +slFlag__block = (1<<0) :REM ;We have a SWI block +slFlag__format = (1<<1) :REM ;There is a format +slFlag__savable = (1<<2) :REM ;We can save a SWI list +slFlag__modified= (1<<3) :REM ;SWI block is unsaved +slFlag__saving = (1<<4) :REM ;We're saving a dump + +[ opt o + +] +NEXT + +PROCbas_aofSave +END + +REM -- Macros --------------------------------------------------------------- + +DEF FNs(s$) +[ opt 4 + equs s$ + dcb 0 +] +=0 +DEFFNP(i%):PRINT~i%:=0 diff --git a/StraySrc/Utilities/b/buildstub.bas b/StraySrc/Utilities/b/buildstub.bas new file mode 100644 index 0000000..3cf476c --- /dev/null +++ b/StraySrc/Utilities/b/buildstub.bas @@ -0,0 +1,164 @@ +REM +REM SapphStub +REM +REM Build Sapphire extension stub entries +REM +REM © 1994-1998 Straylight +REM + +REM ----- Licensing note ---------------------------------------------------- +REM +REM This file is part of Straylight's core utilities (coreutils) +REM +REM Coreutils is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM Coreutils is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with Coreutils. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +REM --- Parse arguments --- + +ON ERROR ERROR EXT 0,REPORT$+"["+STR$(ERL)+"]" +PROCinit +PROCparse(FNreadCommandLine) +END + +DEF PROCinit +DIM q% 256 +LIBRARY "libs:bas" +PROCbas_init +ENDPROC + +REM --- Read a command line --- + +DEF FNreadCommandLine +LOCAL comm$ +SYS "OS_GetEnv" TO comm$ +IF INSTR(comm$,"-quit")=0 THEN ERROR 1,"SapphStub must be started using *Run" +comm$=MID$(comm$,INSTR(comm$,"""")+1) +comm$=MID$(comm$,INSTR(comm$," ")+1) +comm$=LEFT$(comm$,INSTR(comm$,"""")-1) +=comm$ + +REM --- Remove a word from a command line --- + +DEF FNword(RETURN line$) +LOCAL word$ +IF INSTR(line$," ") THEN + word$=LEFT$(line$,INSTR(line$," ")-1) + line$=MID$(line$,INSTR(line$," ")+1) +ELSE + word$=line$ + line$="" +ENDIF +=word$ + +REM --- Convert a string to upper case --- + +DEF FNupper(line$) +LOCAL i% +$q%=line$ +FOR i%=0 TO LEN(line$)-1 + IF q%?i%>=97 AND q%?i%<=122 THEN q%?i%-=32 +NEXT +=$q% + +REM --- Do the command line parsing --- + +DEF PROCparse(line$) +LOCAL libfn$,stub$,lib$,off%,helped%,word$ +REPEAT + word$=FNword(line$) + CASE FNupper(word$) OF + WHEN "-HELP" + PROCshowHelp + helped%=TRUE + WHEN "-LIBFN" + libfn$=FNword(line$) + WHEN "-LIB" + lib$=FNword(line$) + WHEN "-STUB" + stub$=FNword(line$) + WHEN "-OFFSET" + off%=VAL(FNword(line$)) + OTHERWISE + CASE TRUE OF + WHEN lib$="" + lib$=word$ + WHEN stub$="" + stub$=word$ + WHEN libfn$="" + libfn$=word$ + WHEN off%=0 + off%=VAL(word$) + ENDCASE + ENDCASE +UNTIL line$="" +IF helped% THEN END +IF libfn$="" OR lib$="" OR stub$="" THEN ERROR 0,"Bad arguments" +PROCbuild(lib$,stub$,libfn$,off%) +ENDPROC + +DEF PROCbuild(lib$,stub$,libfn$,off%) + +REM --- Build library section --- + +zero=0 + +PROCbas_aofInit(&1000) +FOR o=4 TO 6 STEP 2 +[ opt o + FNpass + + FNimportAs("Sapphire$$LibData$$Base","sapph_base") + FNimportAs("Sapphire$$LibData$$Limit","sapph_limit") + + FNarea("!Stub$$Code","CODE,READONLY") + + FNexportAs("stubfn",libfn$) +.stubfn + adr r0,stubBlock + ldmia r0,{r0-2} + movs pc,r14 + +.stubBlock + dcd sapph_base + dcd sapph_limit + dcd off% + + FNexportAs("zero","sapphire_init") + FNexportAs("zero","sapphire_libInit") + FNexportAs("zero","sapphire_disable") +] +offDiff%=off%-4 +[ opt o + FNexportAs("offDiff%","__sph_workoff") +] +NEXT +PROCbas_aofSaveAs(lib$) + +REM --- Build stub section --- + +PROCbas_aofInit(0) +FOR o=4 TO 6 STEP 2 +[ opt o + FNpass + + FNimportAs(libfn$,"stubfn") + + FNarea("Sapphire$$ExtTable","CODE,READONLY") + + dcd stubfn +] +NEXT +PROCbas_aofSaveAs(stub$) + +ENDPROC diff --git a/StraySrc/Utilities/b/fixlink.bas b/StraySrc/Utilities/b/fixlink.bas new file mode 100644 index 0000000..3322e50 --- /dev/null +++ b/StraySrc/Utilities/b/fixlink.bas @@ -0,0 +1,64 @@ +REM +REM fixLink +REM +REM Fix object files output by partial AOF linking +REM +REM © 1995-1998 Straylight +REM + +REM ----- Licensing note ---------------------------------------------------- +REM +REM This file is part of Straylight's core utilities (coreutils) +REM +REM Coreutils is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM Coreutils is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with Coreutils. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +SYS "OS_GetEnv" TO comm$ +IF INSTR(comm$,"-quit")=0 THEN ERROR 1,"fixLink must be started using *Run" +comm$=MID$(comm$,INSTR(comm$,"""")+1) +comm$=MID$(comm$,INSTR(comm$," ")+1) +comm$=LEFT$(comm$,INSTR(comm$,"""")-1) + +SYS "OS_File",17,comm$ TO ,,,,size% +DIM b% size% +SYS "OS_File",16,comm$,b%,0 + +REM --- Find header --- + +DIM q% 8 +$q%="OBJ_HEAD" +A%=q%!0 +B%=q%!4 +c%=b%!4 +x%=b%+12 +o%=0 +FOR i%=1 TO c% + IF x%!0=A% AND x%!4=B% THEN o%=x%!8 + x%+=16 +NEXT +IF o%=0 THEN ERROR 0,"Erk!" + +REM --- Now munge attributes --- + +x%=b%+o%+24 +a%=!(b%+o%+8) +FOR i%=1 TO a% + x%!4=x%!4 AND &FFFF + x%+=20 +NEXT + +REM --- Save AOF file back --- + +SYS "OS_File",10,comm$,&FFD,,b%,b%+size% +END diff --git a/StraySrc/Utilities/b/msgaof.bas b/StraySrc/Utilities/b/msgaof.bas new file mode 100644 index 0000000..42777aa --- /dev/null +++ b/StraySrc/Utilities/b/msgaof.bas @@ -0,0 +1,206 @@ +REM +REM msgAOF +REM +REM Convert message files to an AOF format +REM +REM © 1995-1998 Straylight +REM + +REM ----- Licensing note ---------------------------------------------------- +REM +REM This file is part of Straylight's core utilities (coreutils) +REM +REM Coreutils is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM Coreutils is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with Coreutils. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +ON ERROR ERROR EXT 0,REPORT$+" ["+STR$(ERL)+"]" + +DIM q% 256 +SYS "OS_GetEnv" TO comm$ +IF INSTR(comm$,"-quit")=0 THEN ERROR 1,"msgAOF must be started using *Run" +comm$=MID$(comm$,INSTR(comm$,"""")+1) +comm$=MID$(comm$,INSTR(comm$," ")+1) +comm$=LEFT$(comm$,INSTR(comm$,"""")-1) + +table%=FALSE +file$=FNword(comm$) +out$=FNword(comm$) +header$=FNword(comm$) +IF file$="" OR out$="" THEN ERROR 0,"Syntax: msgAOF [
]" +IF header$<>"" THEN + hdr%=OPENOUT(header$) + BPUT #hdr%,";" + BPUT #hdr%,"; Message symbols [generated by msgAOF]" + BPUT #hdr%,";" + BPUT #hdr%,"" + BPUT #hdr%,CHR$(9)+CHR$(9)+"["+CHR$(9)+":LNOT::DEF:msg__dfn" + BPUT #hdr%,CHR$(9)+CHR$(9)+"GBLL"+CHR$(9)+"msg__dfn" + BPUT #hdr%,"" +ELSE + hdr%=0 +ENDIF + +LIBRARY "libs:bas" +PROCbas_init + +in%=OPENIN(file$) +ON ERROR CLOSE #in%:IF hdr% THEN CLOSE #hdr%:IF0ELSE:ERROR EXT 0,REPORT$+" ["+STR$(ERL)+"]" + +PROCbas_aofInit(64*1024) +FOR o=4 TO 6 STEP 2 + [ opt o + FNpass + + FNarea("Resources$$Data","CODE,READONLY") + ] + + PTR #in%=0 + REPEAT + line$=FNstrip(GET$#in%) + + CASE LEFT$(line$,1) OF + WHEN ";","#",":","" + REM Ignore comment lines + OTHERWISE + col%=INSTR(line$,":") + IF col%=0 THEN + CLOSE #in%:IF hdr% THEN CLOSE #hdr%:IF0ELSE:ERROR 0,"Bad message line" + ENDIF + tag$=FNstrip(LEFT$(line$,col%-1)) + msg$=FNstrip(MID$(line$,col%+1)) + CASE LEFT$(msg$,1) OF + WHEN "{" + [ opt o + .help + .syntax ;Just make sure of this + ] + REPEAT + msg$=FNstrip(GET$#in%) + CASE msg$ OF + WHEN "|" + [ opt o + .syntax + ] + WHEN "}" + REM Do nothing + OTHERWISE + IF RIGHT$(msg$,1)="\" THEN + [ opt o + dcb FNgsTrans(LEFT$(msg$,LEN(msg$)-1)) + ] + ELSE + [ opt o + dcb FNgsTrans(msg$) + dcb 13 + ] + ENDIF + ENDCASE + UNTIL msg$="}" + [ opt o + dcb 0 + FNdoExport("help","help_"+tag$) + FNdoExport("syntax","synt_"+tag$) + ] + WHEN "[" + msg$=MID$(msg$,2) + col%=INSTR(msg$,"]") + err%=EVAL(LEFT$(msg$,col%-1)) + msg$=FNstrip(MID$(msg$,col%+1)) + msg$=FNgsTrans(msg$) + [ opt o + FNalign + .label + dcd err% + dcb msg$ + dcb 0 + FNdoExport("label","msg_"+tag$) + ] + OTHERWISE + msg$=FNgsTrans(msg$) + [ opt o + .label + dcb msg$ + dcb 0 + FNdoExport("label","msg_"+tag$) + ] + ENDCASE + ENDCASE + + UNTIL EOF #in% +NEXT + +CLOSE #in% +IF hdr% THEN + BPUT #hdr%,"" + BPUT #hdr%,CHR$(9)+CHR$(9)+"]" + BPUT #hdr%,"" + BPUT #hdr%,CHR$(9)+CHR$(9)+"END" + CLOSE #hdr% + SYS "OS_File",1,header$,&FFFFFF3A,&BD896000,,3 +ENDIF +ON ERROR ERROR EXT 0,REPORT$+" ["+STR$(ERL)+"]" +PROCbas_aofSaveAs(out$) +END + +DEF FNdoExport(alias$,name$) +IF FNexportAs(alias$,name$) +IF hdr%<>0 AND o=6 THEN BPUT #hdr%,CHR$(9)+CHR$(9)+"IMPORT"+CHR$(9)+name$ +=0 + +DEF FNword(RETURN line$) +LOCAL word$ +IF INSTR(line$," ") THEN + word$=LEFT$(line$,INSTR(line$," ")-1) + line$=MID$(line$,INSTR(line$," ")+1) +ELSE + word$=line$ + line$="" +ENDIF +=word$ + +DEF FNstrip(line$) +LOCAL x$,f%,s% +WHILE line$<>"" + IF LEFT$(line$,1)=" " THEN + s%+=1 + ELSE + IF (f% AND 1) THEN + x$+=STRING$(s%," ")+LEFT$(line$,1) + ELSE + x$+=LEFT$(line$,1) + ENDIF + s%=0 + f%=f% OR 1 + ENDIF + line$=MID$(line$,2) +ENDWHILE +=x$ + +DEF FNupper(line$) +LOCAL i% +$q%=line$ +FOR i%=0 TO LEN(line$)-1 + IF q%?i%>=97 AND q%?i%<=122 THEN q%?i%-=32 +NEXT +=$q% + +DEF FNgsTrans(s$) +LOCAL p%,t$ +SYS "OS_GSTrans",s$,q%,256 TO ,,len% +p%=q% +WHILE p% " + +LIBRARY "libs:bas" +PROCbas_init + +PROCassembleAux + +PROCbas_aofInit(256*1024) +FOR pass=4 TO 6 STEP 2 +[ opt pass + FNpass + FNarea("Resources$$Data","CODE,READONLY") +] + +PROCsprites(res$+".Sprites") +PROCmessages(res$+".Messages") +PROCtemplates(res$+".Templates") + +NEXT +PROCbas_aofSaveAs(out$) +END + +REM ----- Sprites ----------------------------------------------------------- + +DEF PROCsprites(spr$) +[ opt pass + FNexport("rsc_sprites") +.rsc_sprites + dcd (FNfSize(spr$)+4+3) AND -4 + FNbin(spr$) + FNalign +] +ENDPROC + +REM ----- Messages ---------------------------------------------------------- + +DEF PROCmessages(msg$) +[ opt pass + FNexport("rsc_msgBase") +.rsc_msgBase +] +A%=O% +B%=A%+FNfSize(msg$) +SYS "OS_File",16,msg$,A%,0 +l%=USR(msgs)-A% +O%+=l% +P%+=l% +[ opt pass + dcb 0 + FNexport("rsc_msgLimit") +.rsc_msgLimit + FNalign +] +ENDPROC + +REM ----- Templates --------------------------------------------------------- + +DEF FNlabel(l$)=EVAL("FNassign("+l$+","+STR$(P%)+")") +DEF FNref(l$)=EVAL(l$) +DEF FNassign(RETURN x%,y%) +x%=y% +=0 + +DEF PROCtemplates(tpl$) +IF pass=4 THEN + SYS "OS_File",17,tpl$ TO ,,,,tsize% + DIM tfile% tsize% + SYS "OS_File",16,tpl$,tfile%,0 +ENDIF + +REM --- Build the name table --- + +[ opt pass + FNexport("rsc_tplBase") +.rsc_tplBase +] + +index%=tfile%+16 +WHILE index%!0 + CASE index%!8 OF + WHEN 1 + name$=FNgetString(index%+12) + [ opt pass + dcb name$ + dcb 0 + FNalign + dcd FNref("__"+name$) + ] + OTHERWISE + ERROR 1,"Template type "+STR$(index%!0)+" unrecognised" + ENDCASE + index%+=24 +ENDWHILE + +[ opt pass + FNexport("rsc_tplLimit") +.rsc_tplLimit +] + +REM --- Now write out the window definitions --- + +B%=tfile%+16 +C%=tfile% +WHILE B%!0 + CASE B%!8 OF + WHEN 1 + name$=FNgetString(B%+12) + [ opt pass + FNlabel("__"+name$) + ] + A%=O% + l%=USR(tpl_window)-A% + P%+=l% + O%+=l% + [ opt pass + FNalign + ] + OTHERWISE + ERROR 1,"Template type "+STR$(index%!0)+" unrecognised" + ENDCASE + B%+=24 +ENDWHILE +ENDPROC + +REM ----- Other useful functions -------------------------------------------- + +DEF FNgetString(a%) +LOCAL s$ +WHILE ?a%>=32 + s$+=CHR$(?a%) + a%+=1 +ENDWHILE +=s$ + +DEF FNword(RETURN line$) +LOCAL word$ +IF INSTR(line$," ") THEN + word$=LEFT$(line$,INSTR(line$," ")-1) + line$=MID$(line$,INSTR(line$," ")+1) +ELSE + word$=line$ + line$="" +ENDIF +=word$ + +DEF FNupper(line$) +LOCAL i% +$q%=line$ +FOR i%=0 TO LEN(line$)-1 + IF q%?i%>=97 AND q%?i%<=122 THEN q%?i%-=32 +NEXT +=$q% + +REM ----- Auxiliary assembler bits ------------------------------------------ + +DEF PROCassembleAux +DIM aux% 4096 +FOR o=0 TO 2 STEP 2 +P%=aux% +[ opt o + +; --- msgs --- +; +; entry; r0 == pointer to file +; r1 == limit of file +; exit; r0 == new output pointer + +.msgs + stmfd r13!,{r14} + mov r2,r0 + +.msgs_newline + cmp r2,r1 + bcs msgs_end + ldrb r14,[r2],#1 + cmp r14,#&21 + bcc msgs_newline + + cmp r14,#ASC(";") + cmpne r14,#ASC("#") + cmpne r14,#ASC("|") + beq msgs_skipline + +.msgs_writeline + cmp r14,#&20 + movcc r14,#0 + strb r14,[r0],#1 + ldrcsb r14,[r2],#1 + bcs msgs_writeline + + b msgs_newline + +.msgs_skipline + ldrb r14,[r2],#1 + cmp r14,#&20 + bcs msgs_skipline + + b msgs_newline + +.msgs_end + ldmfd r13!,{pc}^ + + +; --- tpl_window --- +; +; entry; r0 == output pointer +; r1 == pointer to index entry +; r2 == pointer to template file base +; exit; r0 == new output pointer + +.tpl_window + stmfd r13!,{r14} + add r11,r0,#12 + mov r10,r0 + mov r9,r2 + ldr r14,[r1,#0] + add r8,r9,r14 + + ; --- Build relocation table --- + + mov r14,#64 + orr r14,r14,#1<<28 + str r14,[r11],#4 + + ldr r0,[r8,#56] + add r1,r8,#72 + bl tpl_doReloc + + ldr r7,[r8,#84] + add r6,r8,#88 + +.loop + subs r7,r7,#1 + ldrcs r0,[r6,#16] + addcs r1,r6,#20 + blcs tpl_doReloc + addcs r6,r6,#32 + bcs loop + + ; --- Add in offset entry for window definition --- + + sub r14,r11,r10 + str r14,[r10,#0] + + ; --- Now copy over the window definition --- + + mov r14,r8 + mov r7,#72 + +.loop + subs r7,r7,#16 + ldmcsia r14!,{r0-r3} + stmcsia r11!,{r0-r3} + bcs loop + ldmia r14!,{r0,r1} + stmia r11!,{r0,r1} + + ldr r0,[r8,#56] + add r1,r8,#72 + mov r5,#0 + bl tpl_writeData + + ldr r7,[r8,#84] + str r7,[r11],#4 + add r6,r8,#88 + +.loop + subs r7,r7,#1 + ldmcsia r6,{r0-r3,r14} + stmcsia r11!,{r0-r3,r14} + ldrcs r0,[r6,#16] + addcs r1,r6,#20 + blcs tpl_writeData + addcs r6,r6,#32 + bcs loop + + ; --- Add in offset for this --- + + sub r14,r11,r10 + str r14,[r10,#4] + + ; --- Finally copy over the indirected data --- + + ldr r0,[r8,#56] + add r1,r8,#72 + bl tpl_copyData + + ldr r7,[r8,#84] + add r6,r8,#88 + +.loop + subs r7,r7,#1 + ldrcs r0,[r6,#16] + addcs r1,r6,#20 + blcs tpl_copyData + addcs r6,r6,#32 + bcs loop + + ; --- Put in the last offset and return --- + + sub r14,r11,r10 + str r14,[r10,#8] + + mov r0,r11 + ldmfd r13!,{pc}^ + + +; --- tpl_doReloc --- +; +; entry; r0 == icon flags word +; r1 == pointer to icon data +; r8 == base of window definition +; r11 == output pointer +; exit; r0-r5 corrupted + +.tpl_doReloc + tst r0,#&100 + moveqs pc,r14 + + stmfd r13!,{r14} + sub r14,r1,r8 + str r14,[r11],#4 + + and r14,r0,#&3 + cmp r14,#&2 + beq tpl_drSprite + + ldr r14,[r1,#4] + cmn r14,#-(-1) + subne r14,r1,r8 + addne r14,r14,#4 + strne r14,[r11],#4 + ldmfd r13!,{pc}^ + +.tpl_drSprite + sub r14,r8,r1 + add r14,r14,#4 + orr r14,r14,#(2<<28) + str r14,[r11],#4 + ldmfd r13!,{pc}^ + + +; --- tpl_writeData --- +; +; entry; r0 == icon flags word +; r1 == pointer to icon data +; r5 == indirection offset +; r8 == base of window definition +; r11 == output pointer +; exit; r5 updated +; r0-r4 corrupted + +.tpl_writeData + tst r0,#&100 + beq tpl_wdNotInd + + stmfd r13!,{r14} + str r5,[r11],#4 + ldr r14,[r1,#8] + add r5,r5,r14 + + and r14,r0,#&3 + cmp r14,#&2 + beq tpl_wdSprite + ldr r14,[r1,#4] + cmn r14,#-(-1) + beq tpl_wdNoValid + + str r5,[r11],#4 + add r2,r8,r14 + +.loop + ldrb r14,[r2],#1 + add r5,r5,#1 + cmp r14,#&20 + bcs loop + + b tpl_wdCont + +.tpl_wdSprite + mov r14,#1 +.tpl_wdNoValid + str r14,[r11],#4 + +.tpl_wdCont + ldr r14,[r1,#8] + str r14,[r11],#4 + + ldmfd r13!,{pc}^ + +.tpl_wdNotInd + ldmia r1,{r0-r2} + stmia r11!,{r0-r2} + movs pc,r14 + + +; --- tpl_copyData --- +; +; entry; r0 == icon flags +; r1 == pointer to icon data +; r8 == base of window definition +; r11 == output pointer +; exit; r0-r5 corrupted + +.tpl_copyData + tst r0,#&100 + moveqs pc,r14 + + stmfd r13!,{r14} + mov r2,r11 + ldr r14,[r1,#0] + add r3,r8,r14 + +.loop + ldrb r14,[r3],#1 + cmp r14,#&20 + movcc r14,#0 + strb r14,[r2],#1 + bcs loop + + ldr r14,[r1,#8] + add r11,r11,r14 + mov r14,#0 + +.loop + cmp r2,r11 + strccb r14,[r2],#1 + bcc loop + + tst r0,#1 + ldrne r14,[r1,#4] + cmnne r14,#-(-1) + beq tpl_cdSkip + + add r2,r8,r14 + +.loop + ldrb r14,[r2],#1 + cmp r14,#&20 + movcc r14,#0 + strb r14,[r11],#1 + bcs loop + +.tpl_cdSkip + ldmfd r13!,{pc}^ + +] +NEXT +ENDPROC diff --git a/StraySrc/Utilities/b/templaof.bas b/StraySrc/Utilities/b/templaof.bas new file mode 100644 index 0000000..37cf705 --- /dev/null +++ b/StraySrc/Utilities/b/templaof.bas @@ -0,0 +1,396 @@ +REM +REM templAOF +REM +REM Mangle template files into an easily extractable form +REM +REM © 1995-1998 Straylight +REM + +REM ----- Licensing note ---------------------------------------------------- +REM +REM This file is part of Straylight's core utilities (coreutils) +REM +REM Coreutils is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM Coreutils is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with Coreutils. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +ON ERROR ERROR EXT 0,REPORT$+" ["+STR$(ERL)+"]" + +SYS "OS_GetEnv" TO comm$ +IF INSTR(comm$,"-quit")=0 THEN ERROR 1,"templAOF must be started using *Run" +comm$=MID$(comm$,INSTR(comm$,"""")+1) +comm$=MID$(comm$,INSTR(comm$," ")+1) +comm$=LEFT$(comm$,INSTR(comm$,"""")-1) + +tfile$=FNword(comm$) +out$=FNword(comm$) +header$=FNword(comm$) +IF tfile$="" OR out$="" THEN ERROR 0,"Syntax: templAOF [
]" + +IF header$<>"" THEN + hdr%=OPENOUT(header$) + BPUT #hdr%,";" + BPUT #hdr%,"; Template symbols [generated by templAOF]" + BPUT #hdr%,";" + BPUT #hdr%,"" + BPUT #hdr%,CHR$(9)+CHR$(9)+"["+CHR$(9)+":LNOT::DEF:tpl__dfn" + BPUT #hdr%,CHR$(9)+CHR$(9)+"GBLL"+CHR$(9)+"tpl__dfn" + BPUT #hdr%,"" + ON ERROR CLOSE #hdr%:ERROR EXT 0,REPORT$+" ["+STR$(ERL)+"]" +ELSE + hdr%=0 +ENDIF + +PROCassemble + +LIBRARY "libs:bas" +PROCbas_init + +SYS "OS_File",17,tfile$ TO ,,,,tsize% +DIM tfile% tsize% +SYS "OS_File",16,tfile$,tfile%,0 + +PROCbas_aofInit(tsize%*5) +FOR pass=4 TO 6 STEP 2 + [ opt pass + FNpass + FNarea("Resources$$Data","CODE,READONLY") + ] + index%=tfile%+16 + WHILE index%!0 + CASE index%!8 OF + WHEN 1 + PROCloadWindow(index%!0+tfile%,index%) + OTHERWISE + IF hdr% THEN CLOSE #hdr% + ERROR 1,"Template type "+STR$(index%!0)+" unrecognised" + ENDCASE + index%+=24 + ENDWHILE +NEXT + +PROCbas_aofSaveAs(out$) +IF hdr% THEN + BPUT #hdr%,"" + BPUT #hdr%,CHR$(9)+CHR$(9)+"]" + BPUT #hdr%,"" + BPUT #hdr%,CHR$(9)+CHR$(9)+"END" + CLOSE #hdr% + SYS "OS_File",1,header$,&FFFFFF3A,&BD896000,,3 +ENDIF +END + +DEF PROCloadWindow(addr%,index%) +name$=FNgetString(index%+12) + +REM --- Build template info block --- + +[ opt pass +.template +] + +A%=O% +B%=index% +C%=tfile% +l%=USR(tpl_window)-A% +P%+=l% +O%+=l% + +[ opt pass + FNalign + FNexportAs("template","tpl_"+name$) +] +IF hdr%<>0 AND pass=6 THEN BPUT #hdr%,CHR$(9)+CHR$(9)+"IMPORT"+CHR$(9)+"tpl_"+name$ +ENDPROC + +DEF FNgetString(a%) +LOCAL s$ +WHILE ?a%>=32 + s$+=CHR$(?a%) + a%+=1 +ENDWHILE +=s$ + +DEF FNword(RETURN line$) +LOCAL word$ +IF INSTR(line$," ") THEN + word$=LEFT$(line$,INSTR(line$," ")-1) + line$=MID$(line$,INSTR(line$," ")+1) +ELSE + word$=line$ + line$="" +ENDIF +=word$ + +DEF FNupper(line$) +LOCAL i% +$q%=line$ +FOR i%=0 TO LEN(line$)-1 + IF q%?i%>=97 AND q%?i%<=122 THEN q%?i%-=32 +NEXT +=$q% + +DEF PROCassemble +DIM code% 4096 +FOR o=0 TO 2 STEP 2 +P%=code% +[ opt o + + +; --- tpl_window --- +; +; entry; r0 == output pointer +; r1 == pointer to index entry +; r2 == pointer to template file base +; exit; r0 == new output pointer + +.tpl_window + stmfd r13!,{r14} + add r11,r0,#12 + mov r10,r0 + mov r9,r2 + ldr r14,[r1,#0] + add r8,r9,r14 + + ; --- Build relocation table --- + + mov r14,#64 + orr r14,r14,#1<<28 + str r14,[r11],#4 + + ldr r0,[r8,#56] + add r1,r8,#72 + bl tpl_doReloc + + ldr r7,[r8,#84] + add r6,r8,#88 + +.loop + subs r7,r7,#1 + ldrcs r0,[r6,#16] + addcs r1,r6,#20 + blcs tpl_doReloc + addcs r6,r6,#32 + bcs loop + + ; --- Add in offset entry for window definition --- + + sub r14,r11,r10 + str r14,[r10,#0] + + ; --- Now copy over the window definition --- + + mov r14,r8 + mov r7,#72 + +.loop + subs r7,r7,#16 + ldmcsia r14!,{r0-r3} + stmcsia r11!,{r0-r3} + bcs loop + ldmia r14!,{r0,r1} + stmia r11!,{r0,r1} + + ldr r0,[r8,#56] + add r1,r8,#72 + mov r5,#0 + bl tpl_writeData + + ldr r7,[r8,#84] + str r7,[r11],#4 + add r6,r8,#88 + +.loop + subs r7,r7,#1 + ldmcsia r6,{r0-r3,r14} + stmcsia r11!,{r0-r3,r14} + ldrcs r0,[r6,#16] + addcs r1,r6,#20 + blcs tpl_writeData + addcs r6,r6,#32 + bcs loop + + ; --- Add in offset for this --- + + sub r14,r11,r10 + str r14,[r10,#4] + + ; --- Finally copy over the indirected data --- + + ldr r0,[r8,#56] + add r1,r8,#72 + bl tpl_copyData + + ldr r7,[r8,#84] + add r6,r8,#88 + +.loop + subs r7,r7,#1 + ldrcs r0,[r6,#16] + addcs r1,r6,#20 + blcs tpl_copyData + addcs r6,r6,#32 + bcs loop + + ; --- Put in the last offset and return --- + + sub r14,r11,r10 + str r14,[r10,#8] + + mov r0,r11 + ldmfd r13!,{pc}^ + + +; --- tpl_doReloc --- +; +; entry; r0 == icon flags word +; r1 == pointer to icon data +; r8 == base of window definition +; r11 == output pointer +; exit; r0-r5 corrupted + +.tpl_doReloc + tst r0,#&100 + moveqs pc,r14 + + stmfd r13!,{r14} + sub r14,r1,r8 + str r14,[r11],#4 + + and r14,r0,#&3 + cmp r14,#&2 + beq tpl_drSprite + + ldr r14,[r1,#4] + cmn r14,#-(-1) + subne r14,r1,r8 + addne r14,r14,#4 + strne r14,[r11],#4 + ldmfd r13!,{pc}^ + +.tpl_drSprite + sub r14,r8,r1 + add r14,r14,#4 + orr r14,r14,#(2<<28) + str r14,[r11],#4 + ldmfd r13!,{pc}^ + + +; --- tpl_writeData --- +; +; entry; r0 == icon flags word +; r1 == pointer to icon data +; r5 == indirection offset +; r8 == base of window definition +; r11 == output pointer +; exit; r5 updated +; r0-r4 corrupted + +.tpl_writeData + tst r0,#&100 + beq tpl_wdNotInd + + stmfd r13!,{r14} + str r5,[r11],#4 + ldr r14,[r1,#8] + add r5,r5,r14 + + and r14,r0,#&3 + cmp r14,#&2 + beq tpl_wdSprite + ldr r14,[r1,#4] + cmn r14,#-(-1) + beq tpl_wdNoValid + + str r5,[r11],#4 + add r2,r8,r14 + +.loop + ldrb r14,[r2],#1 + add r5,r5,#1 + cmp r14,#&20 + bcs loop + + b tpl_wdCont + +.tpl_wdSprite + mov r14,#1 +.tpl_wdNoValid + str r14,[r11],#4 + +.tpl_wdCont + ldr r14,[r1,#8] + str r14,[r11],#4 + + ldmfd r13!,{pc}^ + +.tpl_wdNotInd + ldmia r1,{r0-r2} + stmia r11!,{r0-r2} + movs pc,r14 + + +; --- tpl_copyData --- +; +; entry; r0 == icon flags +; r1 == pointer to icon data +; r8 == base of window definition +; r11 == output pointer +; exit; r0-r5 corrupted + +.tpl_copyData + tst r0,#&100 + moveqs pc,r14 + + stmfd r13!,{r14} + mov r2,r11 + ldr r14,[r1,#0] + add r3,r8,r14 + +.loop + ldrb r14,[r3],#1 + cmp r14,#&20 + movcc r14,#0 + strb r14,[r2],#1 + bcs loop + + ldr r14,[r1,#8] + add r11,r11,r14 + mov r14,#0 + +.loop + cmp r2,r11 + strccb r14,[r2],#1 + bcc loop + + tst r0,#1 + ldrne r14,[r1,#4] + cmnne r14,#-(-1) + beq tpl_cdSkip + + add r2,r8,r14 + +.loop + ldrb r14,[r2],#1 + cmp r14,#&20 + movcc r14,#0 + strb r14,[r11],#1 + bcs loop + +.tpl_cdSkip + ldmfd r13!,{pc}^ + +] +NEXT +ENDPROC + diff --git a/StraySrc/Utilities/buildstub.bas b/StraySrc/Utilities/buildstub.bas new file mode 100644 index 0000000..6c0e792 --- /dev/null +++ b/StraySrc/Utilities/buildstub.bas @@ -0,0 +1,31 @@ +REM crunched "b.buildstub" +ONERRORERROREXT0,REPORT$+"["+STR$(ERL)+"]" +PROCA_:PROCB_(FNC_):END +DEFPROCA_:DIMq% 256:LIBRARY"libs:bas":PROCbas_init:ENDPROC +DEFFNC_:LOCALD_$:SYS16TOD_$:IFINSTR(D_$,"-quit")=0THENERROR1,"SapphStub must be started using *Run" +D_$=MID$(D_$,INSTR(D_$,"""")+1):D_$=MID$(D_$,INSTR(D_$," ")+1):D_$=LEFT$(D_$,INSTR(D_$,"""")-1):=D_$ +DEFFNE_(RETURNF_$):LOCALE_$:IFINSTR(F_$," ")THEN +E_$=LEFT$(F_$,INSTR(F_$," ")-1):F_$=MID$(F_$,INSTR(F_$," ")+1) +ELSE:E_$=F_$:F_$="" +ENDIF:=E_$ +DEFFNG_(F_$):LOCALi%:$q%=F_$:FORi%=0TOLEN(F_$)-1:IFq%?i%>=97ANDq%?i%<=122THENq%?i%-=32 +NEXT:=$q% +DEFPROCB_(F_$):LOCALH_$,I_$,J_$,K_%,L_%,E_$:REPEAT:E_$=FNE_(F_$):CASEFNG_(E_$)OF +WHEN"-HELP":PROCM_:L_%=TRUE +WHEN"-LIBFN":H_$=FNE_(F_$) +WHEN"-LIB":J_$=FNE_(F_$) +WHEN"-STUB":I_$=FNE_(F_$) +WHEN"-OFFSET":K_%=VAL(FNE_(F_$)) +OTHERWISE:CASETRUEOF +WHENJ_$="":J_$=E_$ +WHENI_$="":I_$=E_$ +WHENH_$="":H_$=E_$ +WHENK_%=0:K_%=VAL(E_$) +ENDCASE +ENDCASE:UNTILF_$="":IFL_%THENEND +IFH_$=""ORJ_$=""ORI_$=""THENERROR0,"Bad arguments" +PROCN_(J_$,I_$,H_$,K_%):ENDPROC +DEFPROCN_(J_$,I_$,H_$,K_%):zero=0:PROCbas_aofInit(&1000):FORo=4TO6STEP2:[opt o:FNpass:FNimportAs("Sapphire$$LibData$$Base","sapph_base"):FNimportAs("Sapphire$$LibData$$Limit","sapph_limit"):FNarea("!Stub$$Code","CODE,READONLY") +FNexportAs("stubfn",H_$):.stubfn:adr r0,O_:ldmia r0,{r0-2}:movs pc,r14:.O_:dcd sapph_base:dcd sapph_limit:dcd K_%:FNexportAs("zero","sapphire_init"):FNexportAs("zero","sapphire_libInit"):FNexportAs("zero","sapphire_disable"):] +offDiff%=K_%-4:[opt o:FNexportAs("offDiff%","__sph_workoff"):]:NEXT:PROCbas_aofSaveAs(J_$):PROCbas_aofInit(0):FORo=4TO6STEP2:[opt o:FNpass:FNimportAs(H_$,"stubfn"):FNarea("Sapphire$$ExtTable","CODE,READONLY"):dcd stubfn:]:NEXT:PROCbas_aofSaveAs(I_$) +ENDPROC diff --git a/StraySrc/Utilities/fixlink.bas b/StraySrc/Utilities/fixlink.bas new file mode 100644 index 0000000..0b605c1 --- /dev/null +++ b/StraySrc/Utilities/fixlink.bas @@ -0,0 +1,5 @@ +REM crunched "b.fixlink" +SYS16TOA_$:IFINSTR(A_$,"-quit")=0THENERROR1,"fixLink must be started using *Run" +A_$=MID$(A_$,INSTR(A_$,"""")+1):A_$=MID$(A_$,INSTR(A_$," ")+1):A_$=LEFT$(A_$,INSTR(A_$,"""")-1):SYS8,17,A_$TO,,,,B_%:DIMb% B_%:SYS8,16,A_$,b%,0:DIMq% 8:$q%="OBJ_HEAD":A%=q%!0:B%=q%!4:c%=b%!4:x%=b%+12:o%=0:FORi%=1TOc%:IFx%!0=A%ANDx%!4=B%THENo%=x%!8 +x%+=16:NEXT:IFo%=0THENERROR0,"Erk!" +x%=b%+o%+24:a%=!(b%+o%+8):FORi%=1TOa%:x%!4=x%!4AND&FFFF:x%+=20:NEXT:SYS8,10,A_$,&FFD,,b%,b%+B_%:END diff --git a/StraySrc/Utilities/msgaof.bas b/StraySrc/Utilities/msgaof.bas new file mode 100644 index 0000000..0b578ec --- /dev/null +++ b/StraySrc/Utilities/msgaof.bas @@ -0,0 +1,45 @@ +REM crunched "b.msgaof" +ONERRORERROREXT0,REPORT$+" ["+STR$(ERL)+"]" +DIMq% 256:SYS16TOA_$:IFINSTR(A_$,"-quit")=0THENERROR1,"msgAOF must be started using *Run" +A_$=MID$(A_$,INSTR(A_$,"""")+1):A_$=MID$(A_$,INSTR(A_$," ")+1):A_$=LEFT$(A_$,INSTR(A_$,"""")-1):B_%=FALSE:C_$=FND_(A_$):E_$=FND_(A_$):F_$=FND_(A_$):IFC_$=""ORE_$=""THENERROR0,"Syntax: msgAOF [
]" +IFF_$<>""THEN +G_%=OPENOUT(F_$):BPUT#G_%,";":BPUT#G_%,"; Message symbols [generated by msgAOF]":BPUT#G_%,";":BPUT#G_%,"":BPUT#G_%,CHR$(9)+CHR$(9)+"["+CHR$(9)+":LNOT::DEF:msg__dfn":BPUT#G_%,CHR$(9)+CHR$(9)+"GBLL"+CHR$(9)+"msg__dfn":BPUT#G_%,"" +ELSE:G_%=0 +ENDIF:LIBRARY"libs:bas":PROCbas_init:H_%=OPENIN(C_$):ONERRORCLOSE#H_%:IFG_%THENCLOSE#G_%:IF0ELSE:ERROREXT0,REPORT$+" ["+STR$(ERL)+"]" +PROCbas_aofInit(64*1024):FORo=4TO6STEP2:[opt o:FNpass:FNarea("Resources$$Data","CODE,READONLY"):]:PTR#H_%=0:REPEAT:I_$=FNJ_(GET$#H_%):CASELEFT$(I_$,1)OF +WHEN";","#",":","" +OTHERWISE:K_%=INSTR(I_$,":"):IFK_%=0THEN +CLOSE#H_%:IFG_%THENCLOSE#G_%:IF0ELSE:ERROR0,"Bad message line" +ENDIF:L_$=FNJ_(LEFT$(I_$,K_%-1)):M_$=FNJ_(MID$(I_$,K_%+1)):CASELEFT$(M_$,1)OF +WHEN"{":[opt o:.help:.syntax:]:REPEAT:M_$=FNJ_(GET$#H_%):CASEM_$OF +WHEN"|":[opt o:.syntax:] +WHEN"}" +OTHERWISE:IFRIGHT$(M_$,1)="\"THEN +[opt o:dcbFNN_(LEFT$(M_$,LEN(M_$)-1)):] +ELSE:[opt o:dcbFNN_(M_$):dcb 13:] +ENDIF +ENDCASE:UNTILM_$="}":[opt o:dcb 0:FNO_("help","help_"+L_$):FNO_("syntax","synt_"+L_$):] +WHEN"[":M_$=MID$(M_$,2):K_%=INSTR(M_$,"]"):P_%=EVAL(LEFT$(M_$,K_%-1)):M_$=FNJ_(MID$(M_$,K_%+1)):M_$=FNN_(M_$):[opt o:FNalign:.label:dcd P_%:dcb M_$:dcb 0:FNO_("label","msg_"+L_$):] +OTHERWISE:M_$=FNN_(M_$):[opt o:.label:dcb M_$:dcb 0:FNO_("label","msg_"+L_$):] +ENDCASE +ENDCASE:UNTILEOF#H_%:NEXT:CLOSE#H_%:IFG_%THEN +BPUT#G_%,"":BPUT#G_%,CHR$(9)+CHR$(9)+"]":BPUT#G_%,"":BPUT#G_%,CHR$(9)+CHR$(9)+"END":CLOSE#G_%:SYS8,1,F_$,&FFFFFF3A,&BD896000,,3 +ENDIF:ONERRORERROREXT0,REPORT$+" ["+STR$(ERL)+"]" +PROCbas_aofSaveAs(E_$):END +DEFFNO_(Q_$,R_$):IFFNexportAs(Q_$,R_$) +IFG_%<>0ANDo=6THENBPUT#G_%,CHR$(9)+CHR$(9)+"IMPORT"+CHR$(9)+R_$ +=0 +DEFFND_(RETURNI_$):LOCALD_$:IFINSTR(I_$," ")THEN +D_$=LEFT$(I_$,INSTR(I_$," ")-1):I_$=MID$(I_$,INSTR(I_$," ")+1) +ELSE:D_$=I_$:I_$="" +ENDIF:=D_$ +DEFFNJ_(I_$):LOCALx$,f%,s%:WHILEI_$<>"":IFLEFT$(I_$,1)=" "THEN +s%+=1 +ELSE:IF(f%AND1)THEN +x$+=STRING$(s%," ")+LEFT$(I_$,1) +ELSE:x$+=LEFT$(I_$,1) +ENDIF:s%=0:f%=f%OR1 +ENDIF:I_$=MID$(I_$,2):ENDWHILE:=x$ +DEFFNS_(I_$):LOCALi%:$q%=I_$:FORi%=0TOLEN(I_$)-1:IFq%?i%>=97ANDq%?i%<=122THENq%?i%-=32 +NEXT:=$q% +DEFFNN_(s$):LOCALp%,t$:SYS39,s$,q%,256TO,,T_%:p%=q%:WHILEp% " +LIBRARY"libs:bas":PROCbas_init:PROCE_:PROCbas_aofInit(256*1024):FORpass=4TO6STEP2:[opt pass:FNpass:FNarea("Resources$$Data","CODE,READONLY"):]:PROCF_(B_$+".Sprites"):PROCG_(B_$+".Messages"):PROCH_(B_$+".Templates"):NEXT:PROCbas_aofSaveAs(D_$):END +DEFPROCF_(I_$):[opt pass:FNexport("rsc_sprites"):.rsc_sprites:dcd (FNfSize(I_$)+4+3)AND-4:FNbin(I_$):FNalign:]:ENDPROC +DEFPROCG_(J_$):[opt pass:FNexport("rsc_msgBase"):.rsc_msgBase:]:A%=O%:B%=A%+FNfSize(J_$):SYS8,16,J_$,A%,0:l%=USR(K_)-A%:O%+=l%:P%+=l%:[opt pass:dcb 0:FNexport("rsc_msgLimit"):.rsc_msgLimit:FNalign:]:ENDPROC +DEFFNL_(l$)=EVAL("FNassign("+l$+","+STR$(P%)+")") +DEFFNM_(l$)=EVAL(l$) +DEFFNassign(RETURNx%,y%):x%=y%:=0 +DEFPROCH_(N_$):IFpass=4THEN +SYS8,17,N_$TO,,,,O_%:DIMP_% O_%:SYS8,16,N_$,P_%,0 +ENDIF:[opt pass:FNexport("rsc_tplBase"):.rsc_tplBase:]:Q_%=P_%+16:WHILEQ_%!0:CASEQ_%!8OF +WHEN1:R_$=FNS_(Q_%+12):[opt pass:dcb R_$:dcb 0:FNalign:dcdFNM_("__"+R_$):] +OTHERWISE:ERROR1,"Template type "+STR$(Q_%!0)+" unrecognised" +ENDCASE:Q_%+=24:ENDWHILE:[opt pass:FNexport("rsc_tplLimit"):.rsc_tplLimit:]:B%=P_%+16:C%=P_%:WHILEB%!0:CASEB%!8OF +WHEN1:R_$=FNS_(B%+12):[opt pass:FNL_("__"+R_$):]:A%=O%:l%=USR(T_)-A%:P%+=l%:O%+=l%:[opt pass:FNalign:] +OTHERWISE:ERROR1,"Template type "+STR$(Q_%!0)+" unrecognised" +ENDCASE:B%+=24:ENDWHILE:ENDPROC +DEFFNS_(a%):LOCALs$:WHILE?a%>=32:s$+=CHR$(?a%):a%+=1:ENDWHILE:=s$ +DEFFNC_(RETURNU_$):LOCALC_$:IFINSTR(U_$," ")THEN +C_$=LEFT$(U_$,INSTR(U_$," ")-1):U_$=MID$(U_$,INSTR(U_$," ")+1) +ELSE:C_$=U_$:U_$="" +ENDIF:=C_$ +DEFFNV_(U_$):LOCALi%:$q%=U_$:FORi%=0TOLEN(U_$)-1:IFq%?i%>=97ANDq%?i%<=122THENq%?i%-=32 +NEXT:=$q% +DEFPROCE_:DIMW_% 4096:FORo=0TO2STEP2:P%=W_%:[opt o:.K_:stmfd r13!,{r14}:mov r2,r0:.X_:cmp r2,r1:bcs Y_:ldrb r14,[r2],#1:cmp r14,#&21:bcc X_:cmp r14,#ASC(";"):cmpne r14,#ASC("#"):cmpne r14,#ASC("|"):beq Z_:.a_:cmp r14,#&20:movcc r14,#0 +strb r14,[r0],#1:ldrcsb r14,[r2],#1:bcs a_:b X_:.Z_:ldrb r14,[r2],#1:cmp r14,#&20:bcs Z_:b X_:.Y_:ldmfd r13!,{pc}^:.T_:stmfd r13!,{r14}:add r11,r0,#12:mov r10,r0:mov r9,r2:ldr r14,[r1,#0]:add r8,r9,r14:mov r14,#64 +orr r14,r14,#1<<28:str r14,[r11],#4:ldr r0,[r8,#56]:add r1,r8,#72:bl b_:ldr r7,[r8,#84]:add r6,r8,#88:.c_:subs r7,r7,#1:ldrcs r0,[r6,#16]:addcs r1,r6,#20:blcs b_:addcs r6,r6,#32:bcs c_:sub r14,r11,r10:str r14,[r10,#0] +mov r14,r8:mov r7,#72:.c_:subs r7,r7,#16:ldmcsia r14!,{r0-r3}:stmcsia r11!,{r0-r3}:bcs c_:ldmia r14!,{r0,r1}:stmia r11!,{r0,r1}:ldr r0,[r8,#56]:add r1,r8,#72:mov r5,#0:bl d_:ldr r7,[r8,#84]:str r7,[r11],#4:add r6,r8,#88:.c_ +subs r7,r7,#1:ldmcsia r6,{r0-r3,r14}:stmcsia r11!,{r0-r3,r14}:ldrcs r0,[r6,#16]:addcs r1,r6,#20:blcs d_:addcs r6,r6,#32:bcs c_:sub r14,r11,r10:str r14,[r10,#4]:ldr r0,[r8,#56]:add r1,r8,#72:bl e_:ldr r7,[r8,#84]:add r6,r8,#88 +.c_:subs r7,r7,#1:ldrcs r0,[r6,#16]:addcs r1,r6,#20:blcs e_:addcs r6,r6,#32:bcs c_:sub r14,r11,r10:str r14,[r10,#8]:mov r0,r11:ldmfd r13!,{pc}^:.b_:tst r0,#&100:moveqs pc,r14:stmfd r13!,{r14}:sub r14,r1,r8:str r14,[r11],#4 +and r14,r0,#&3:cmp r14,#&2:beq f_:ldr r14,[r1,#4]:cmn r14,#-(-1):subne r14,r1,r8:addne r14,r14,#4:strne r14,[r11],#4:ldmfd r13!,{pc}^:.f_:sub r14,r8,r1:add r14,r14,#4:orr r14,r14,#(2<<28):str r14,[r11],#4:ldmfd r13!,{pc}^:.d_ +tst r0,#&100:beq g_:stmfd r13!,{r14}:str r5,[r11],#4:ldr r14,[r1,#8]:add r5,r5,r14:and r14,r0,#&3:cmp r14,#&2:beq h_:ldr r14,[r1,#4]:cmn r14,#-(-1):beq i_:str r5,[r11],#4:add r2,r8,r14:.c_:ldrb r14,[r2],#1:add r5,r5,#1 +cmp r14,#&20:bcs c_:b j_:.h_:mov r14,#1:.i_:str r14,[r11],#4:.j_:ldr r14,[r1,#8]:str r14,[r11],#4:ldmfd r13!,{pc}^:.g_:ldmia r1,{r0-r2}:stmia r11!,{r0-r2}:movs pc,r14:.e_:tst r0,#&100:moveqs pc,r14:stmfd r13!,{r14}:mov r2,r11 +ldr r14,[r1,#0]:add r3,r8,r14:.c_:ldrb r14,[r3],#1:cmp r14,#&20:movcc r14,#0:strb r14,[r2],#1:bcs c_:ldr r14,[r1,#8]:add r11,r11,r14:mov r14,#0:.c_:cmp r2,r11:strccb r14,[r2],#1:bcc c_:tst r0,#1:ldrne r14,[r1,#4] +cmnne r14,#-(-1):beq k_:add r2,r8,r14:.c_:ldrb r14,[r2],#1:cmp r14,#&20:movcc r14,#0:strb r14,[r11],#1:bcs c_:.k_:ldmfd r13!,{pc}^:]:NEXT:ENDPROC diff --git a/StraySrc/Utilities/templaof.bas b/StraySrc/Utilities/templaof.bas new file mode 100644 index 0000000..254f4c1 --- /dev/null +++ b/StraySrc/Utilities/templaof.bas @@ -0,0 +1,33 @@ +REM crunched "b.templaof" +ONERRORERROREXT0,REPORT$+" ["+STR$(ERL)+"]" +SYS16TOA_$:IFINSTR(A_$,"-quit")=0THENERROR1,"templAOF must be started using *Run" +A_$=MID$(A_$,INSTR(A_$,"""")+1):A_$=MID$(A_$,INSTR(A_$," ")+1):A_$=LEFT$(A_$,INSTR(A_$,"""")-1):B_$=FNC_(A_$):D_$=FNC_(A_$):E_$=FNC_(A_$):IFB_$=""ORD_$=""THENERROR0,"Syntax: templAOF [
]" +IFE_$<>""THEN +F_%=OPENOUT(E_$):BPUT#F_%,";":BPUT#F_%,"; Template symbols [generated by templAOF]":BPUT#F_%,";":BPUT#F_%,"":BPUT#F_%,CHR$(9)+CHR$(9)+"["+CHR$(9)+":LNOT::DEF:tpl__dfn":BPUT#F_%,CHR$(9)+CHR$(9)+"GBLL"+CHR$(9)+"tpl__dfn":BPUT#F_%,"":ONERRORCLOSE#F_%:ERROREXT0,REPORT$+" ["+STR$(ERL)+"]" +ELSE:F_%=0 +ENDIF:PROCG_:LIBRARY"libs:bas":PROCbas_init:SYS8,17,B_$TO,,,,H_%:DIMB_% H_%:SYS8,16,B_$,B_%,0:PROCbas_aofInit(H_%*5):FORpass=4TO6STEP2:[opt pass:FNpass:FNarea("Resources$$Data","CODE,READONLY"):]:I_%=B_%+16:WHILEI_%!0:CASEI_%!8OF +WHEN1:PROCJ_(I_%!0+B_%,I_%) +OTHERWISE:IFF_%THENCLOSE#F_% +ERROR1,"Template type "+STR$(I_%!0)+" unrecognised" +ENDCASE:I_%+=24:ENDWHILE:NEXT:PROCbas_aofSaveAs(D_$):IFF_%THEN +BPUT#F_%,"":BPUT#F_%,CHR$(9)+CHR$(9)+"]":BPUT#F_%,"":BPUT#F_%,CHR$(9)+CHR$(9)+"END":CLOSE#F_%:SYS8,1,E_$,&FFFFFF3A,&BD896000,,3 +ENDIF:END +DEFPROCJ_(K_%,I_%):L_$=FNM_(I_%+12):[opt pass:.template:]:A%=O%:B%=I_%:C%=B_%:l%=USR(N_)-A%:P%+=l%:O%+=l%:[opt pass:FNalign:FNexportAs("template","tpl_"+L_$):]:IFF_%<>0ANDpass=6THENBPUT#F_%,CHR$(9)+CHR$(9)+"IMPORT"+CHR$(9)+"tpl_"+L_$ +ENDPROC +DEFFNM_(a%):LOCALs$:WHILE?a%>=32:s$+=CHR$(?a%):a%+=1:ENDWHILE:=s$ +DEFFNC_(RETURNO_$):LOCALC_$:IFINSTR(O_$," ")THEN +C_$=LEFT$(O_$,INSTR(O_$," ")-1):O_$=MID$(O_$,INSTR(O_$," ")+1) +ELSE:C_$=O_$:O_$="" +ENDIF:=C_$ +DEFFNP_(O_$):LOCALi%:$q%=O_$:FORi%=0TOLEN(O_$)-1:IFq%?i%>=97ANDq%?i%<=122THENq%?i%-=32 +NEXT:=$q% +DEFPROCG_:DIMQ_% 4096:FORo=0TO2STEP2:P%=Q_%:[opt o:.N_:stmfd r13!,{r14}:add r11,r0,#12:mov r10,r0:mov r9,r2:ldr r14,[r1,#0]:add r8,r9,r14:mov r14,#64:orr r14,r14,#1<<28:str r14,[r11],#4:ldr r0,[r8,#56]:add r1,r8,#72:bl R_:ldr r7,[r8,#84] +add r6,r8,#88:.S_:subs r7,r7,#1:ldrcs r0,[r6,#16]:addcs r1,r6,#20:blcs R_:addcs r6,r6,#32:bcs S_:sub r14,r11,r10:str r14,[r10,#0]:mov r14,r8:mov r7,#72:.S_:subs r7,r7,#16:ldmcsia r14!,{r0-r3}:stmcsia r11!,{r0-r3}:bcs S_ +ldmia r14!,{r0,r1}:stmia r11!,{r0,r1}:ldr r0,[r8,#56]:add r1,r8,#72:mov r5,#0:bl T_:ldr r7,[r8,#84]:str r7,[r11],#4:add r6,r8,#88:.S_:subs r7,r7,#1:ldmcsia r6,{r0-r3,r14}:stmcsia r11!,{r0-r3,r14}:ldrcs r0,[r6,#16] +addcs r1,r6,#20:blcs T_:addcs r6,r6,#32:bcs S_:sub r14,r11,r10:str r14,[r10,#4]:ldr r0,[r8,#56]:add r1,r8,#72:bl U_:ldr r7,[r8,#84]:add r6,r8,#88:.S_:subs r7,r7,#1:ldrcs r0,[r6,#16]:addcs r1,r6,#20:blcs U_:addcs r6,r6,#32 +bcs S_:sub r14,r11,r10:str r14,[r10,#8]:mov r0,r11:ldmfd r13!,{pc}^:.R_:tst r0,#&100:moveqs pc,r14:stmfd r13!,{r14}:sub r14,r1,r8:str r14,[r11],#4:and r14,r0,#&3:cmp r14,#&2:beq V_:ldr r14,[r1,#4]:cmn r14,#-(-1) +subne r14,r1,r8:addne r14,r14,#4:strne r14,[r11],#4:ldmfd r13!,{pc}^:.V_:sub r14,r8,r1:add r14,r14,#4:orr r14,r14,#(2<<28):str r14,[r11],#4:ldmfd r13!,{pc}^:.T_:tst r0,#&100:beq W_:stmfd r13!,{r14}:str r5,[r11],#4 +ldr r14,[r1,#8]:add r5,r5,r14:and r14,r0,#&3:cmp r14,#&2:beq X_:ldr r14,[r1,#4]:cmn r14,#-(-1):beq Y_:str r5,[r11],#4:add r2,r8,r14:.S_:ldrb r14,[r2],#1:add r5,r5,#1:cmp r14,#&20:bcs S_:b Z_:.X_:mov r14,#1:.Y_ +str r14,[r11],#4:.Z_:ldr r14,[r1,#8]:str r14,[r11],#4:ldmfd r13!,{pc}^:.W_:ldmia r1,{r0-r2}:stmia r11!,{r0-r2}:movs pc,r14:.U_:tst r0,#&100:moveqs pc,r14:stmfd r13!,{r14}:mov r2,r11:ldr r14,[r1,#0]:add r3,r8,r14:.S_ +ldrb r14,[r3],#1:cmp r14,#&20:movcc r14,#0:strb r14,[r2],#1:bcs S_:ldr r14,[r1,#8]:add r11,r11,r14:mov r14,#0:.S_:cmp r2,r11:strccb r14,[r2],#1:bcc S_:tst r0,#1:ldrne r14,[r1,#4]:cmnne r14,#-(-1):beq a_:add r2,r8,r14:.S_ +ldrb r14,[r2],#1:cmp r14,#&20:movcc r14,#0:strb r14,[r11],#1:bcs S_:.a_:ldmfd r13!,{pc}^:]:NEXT:ENDPROC diff --git a/StraySrc/gplnote/basic.bas b/StraySrc/gplnote/basic.bas new file mode 100644 index 0000000..7e1cb2a --- /dev/null +++ b/StraySrc/gplnote/basic.bas @@ -0,0 +1,18 @@ +REM ----- Licensing note ---------------------------------------------------- +REM +REM This file is part of Straylight's <...> +REM +REM <...> is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM <...> is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with <...>. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + -- 2.11.0