--- /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 -------------------------------------------------
~mdw / ssr / blobdiff