--- /dev/null
+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 -------------------------------------------------
--- /dev/null
+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
--- /dev/null
+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%
+
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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%<r% THEN SWAP s%,r%
+ FOR i%=r% TO s%
+ mask%=mask% OR (1<<i%)
+ NEXT
+ ELSE
+ ERROR 1,"Missing register name"
+ ENDIF
+ ELSE
+ mask%=mask% OR (1<<r%)
+ ENDIF
+ENDWHILE
+=mask%
+
+DEF FNflex__g(RETURN mask$,RETURN reg$,RETURN sep$)
+IF mask$="" THEN =FALSE
+reg$=""
+sep$=""
+REPEAT
+ reg$+=sep$
+ sep$=LEFT$(mask$,1)
+ mask$=MID$(mask$,2)
+UNTIL mask$="" OR INSTR("-,",sep$)
+IF INSTR("-,",sep$)=0 THEN
+ reg$+=sep$
+ sep$=""
+ENDIF
+=TRUE
+
+REM --- Macros ---
+
+DEF FNflex_save(r$)
+[ opt 4
+ FNimport("flex_save")
+ bl flex_save
+ dcd FNflex__m(r$) OR &e8ae0000
+]
+=0
+
+DEF FNflex_load(r$)
+[ opt 4
+ FNimport("flex_load")
+ bl flex_load
+ dcd FNflex__m(r$) OR &e93e0000
+]
+=0
--- /dev/null
+REM Sapphire libOpts macro library -- © 1994 Straylight
+
+DEF FNlibOpts_test=0
+
+DEF FNlibOpt(n$)
+IF FNalign
+lo__l=lo__l
+IF lo__l THEN !(lo__l+O%-P%-4)=P%-lo__l
+[ opt 4
+ equs n$
+ dcd 0
+.lo__l
+]
+=0
+
+DEF FNlibOpts_end
+IF FNalign
+!(lo__l+O%-P%-4)=P%-lo__l
+[ opt 4
+ dcd -1
+]
+=0
--- /dev/null
+REM Sapphire menu macro library -- © 1994 Straylight
+
+DEF FNmenudefs_test=0
+
+REM --- Support functions ---
+
+DEF FNmenu__b(o%,b%)
+LOCAL m%
+IF b%=0 THEN ERROR 1,"Bit mask 0 passed to menuDefs"
+m%=0
+WHILE (b% AND 1)=0
+ m%+=1
+ b%=b%>>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
--- /dev/null
+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$)
--- /dev/null
+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
--- /dev/null
+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 ***,***
+
--- /dev/null
+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 ***,***
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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 <in> <out> [<header>]"
+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%<q%+len%
+ t$+=CHR$(?p%)
+ p%+=1
+ENDWHILE
+=t$
--- /dev/null
+REM
+REM resGen
+REM
+REM Convert resource files into linkable 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% 1024
+
+SYS "OS_GetEnv" TO comm$
+IF INSTR(comm$,"-quit")=0 THEN ERROR 1,"resGen must be started using *Run"
+comm$=MID$(comm$,INSTR(comm$,"""")+1)
+comm$=MID$(comm$,INSTR(comm$," ")+1)
+comm$=LEFT$(comm$,INSTR(comm$,"""")-1)
+
+res$=FNword(comm$)
+out$=FNword(comm$)
+IF res$="" OR out$="" THEN ERROR 0,"Syntax: resGen <resDir> <aofFile>"
+
+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
--- /dev/null
+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 <in> <out> [<header>]"
+
+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
+
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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 <in> <out> [<header>]"
+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%<q%+T_%:t$+=CHR$(?p%):p%+=1:ENDWHILE:=t$
--- /dev/null
+REM crunched "b.resgen"
+ONERRORERROREXT0,REPORT$+" ["+STR$(ERL)+"]"
+DIMq% 1024:SYS16TOA_$:IFINSTR(A_$,"-quit")=0THENERROR1,"resGen 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_$):IFB_$=""ORD_$=""THENERROR0,"Syntax: resGen <resDir> <aofFile>"
+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
--- /dev/null
+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 <in> <out> [<header>]"
+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
--- /dev/null
+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.
+
~mdw / ssr / commitdiff