X-Git-Url: https://git.distorted.org.uk/~mdw/ssr/blobdiff_plain/a3da4c116d4216fdec125d687dfc347e343a8b28..c1b567d833a004bb3d978f1f7c99f42cefa7845c:/StraySrc/Libraries/BAS/src/b/bas.bas diff --git a/StraySrc/Libraries/BAS/src/b/bas.bas b/StraySrc/Libraries/BAS/src/b/bas.bas new file mode 100644 index 0000000..5a371bc --- /dev/null +++ b/StraySrc/Libraries/BAS/src/b/bas.bas @@ -0,0 +1,382 @@ +REM Basic Assembler Supplement 1.00 © 1996-1998 Straylight +REMÂÁÓhack + +REM ----- Licensing note ---------------------------------------------------- +REM +REM This file is part of Straylight's BASIC Assembler Supplement (BAS) +REM +REM BAS is free software; you can redistribute it and/or modify +REM it under the terms of the GNU General Public License as published by +REM the Free Software Foundation; either version 2, or (at your option) +REM any later version +REM +REM BAS is distributed in the hope that it will be useful, +REM but WITHOUT ANY WARRANTY; without even the implied warranty of +REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +REM GNU General Public License for more details. +REM +REM You should have received a copy of the GNU General Public License +REM along with BAS. If not, write to the Free Software Foundation, +REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +REM --- Hacking warning --- +REM +REM That gorp on the second line is a magic marker word inserted by hand +REM (the three letters `BAS' with their top bits set) and space for an offset +REM word which marks the offset of the code section from the beginning of +REM the LIBRARY link block. Don't play with them unless you (a) know what +REM you're doing (and it should be perfectly clear by now that I don't have +REM a clue), and (b) want to seriously upset the library search code below. + +ERROR 0,"You can't run the Basic Assembler Supplement" + +REM --- A note --- +REM +REM To make this program particularly easy to strip down and transmogrify, +REM it contains directives which are picked up by a sed script during +REM munging. The directives currently are `del ... edel' which deletes +REM all the enclosed lines, and `hex' which inserts the generated hex version +REM of the library search code. Directives are enclosed in square brackets. +REM It's usual to put them in REM statements. + +REM ----- Initialisation ---------------------------------------------------- + +REM [del] +DEF FNbas_assign(RETURN d,v%):d=v%:=0 +DEF PROCbas_const(var$,val%) +IF bas_cf% THEN BPUT #bas_cf%,"/\<"+var$+"\>/s//"+STR$(val%)+"/g" +IF EVAL("FNbas_assign("+var$+",val%)") +ENDPROC + +DEF FNnext:R%+=4:=R%-4 + +DEF PROCbas_saveconst +bas_cf%=OPENOUT("work.basconst") + +DEF PROCbas_constants +bas_cf%=bas_cf% +R%=0 +PROCbas_const("bcode_wSize",FNnext) +PROCbas_const("bcode_init",FNnext) +PROCbas_const("bcode_aofInit",FNnext) +PROCbas_const("bcode_newPass",FNnext) +PROCbas_const("bcode_import",FNnext) +PROCbas_const("bcode_export",FNnext) +PROCbas_const("bcode_get",FNnext) +PROCbas_const("bcode_area",FNnext) +PROCbas_const("bcode_reloc",FNnext) +PROCbas_const("bcode_noReloc",FNnext) +PROCbas_const("bcode_entry",FNnext) +PROCbas_const("bcode_save",FNnext) +PROCbas_const("bcode_align",FNnext) +PROCbas_const("bcode_reserve",FNnext) +PROCbas_const("bcode_lit",FNnext) +PROCbas_const("bcode_ltorg",FNnext) +PROCbas_const("bcode_saveOpt",FNnext) +PROCbas_const("bcode_restoreOpt",FNnext) +IF bas_cf% THEN CLOSE #bas_cf% +ENDPROC +REM [edel] + +REM --- Unexplainable horridness --- +REM +REM Tim wants to be able to embed the code into this library file, so +REM that it doesn't have to be searched for. I'll therefore have to write +REM some code to scan the library list and locate this one, and find the +REM code tacked onto the end. Yuk. + +DEF PROCbas_init +LOCAL type%,size% :REM [dl] +LOCAL workSize%,H%,len%,f% +PROCbas_constants :REM [dl] + +REM --- Old code to load the library from disk --- + +REM [del] +IF TRUE THEN + DIM bas_scratch% 300 + SYS "OS_File",17,"libs:BAScode" TO type%,,,,size% + IF type%<>1 THEN ERROR 0,"BAS code not found" + DIM bas_code% size% + SYS "OS_File",16,"libs:BAScode",bas_code%,0 +ELSE +DEF PROCbas_dumpcode +REM [edel] + +REM --- New hacking to scan the library list --- +REM +REM This must be done in assembler, of course ;-) Time to put on my pointy +REM Rincewind hat... I've tried to do this in one pass because I'm lazy -- +REM I guess that's why it's unreadable. + + DIM bas_scratch% 300 + P%=bas_scratch% + [ opt 0 + + ; exit with r0 == pointer to code, or 0 if not found (erk!) + + ldr r2,[pc] ; load the magic marker word + mov pc,pc ; skip over the magic marker word + dcd &d3c1c2f4 ; this is `REMBAS', with the top bits set + + ldr r0,[r14,#&24] ; find offset of TIMEOF + add r0,r8,r0 ; add on ARGP to find TIMEOF + ldr r0,[r0,#&c] ; load the library list base + +;.loop + cmp r0,#0 ; is that the end of it all? + moveqs pc,r14 ; yes -- oh, well -- it was a nice try + + ldr r1,[r0,#&44] ; load mystic recognition word + cmp r1,r2 ; does it match? + ldrne r0,[r0] ; if not there, load the next link + subne pc,pc,#28 ; and jump back to `loop' (erk) + + ldr r1,[r0,#&48] ; load the code offset + add r0,r1,r0 ; and add it to the base address + movs pc,r14 + ] + + REM --- Now some code to dump that out as hex --- + + bas_code%=USR bas_scratch% + IF bas_code%=0 THEN ERROR 0,"BAS code not found: is the library corrupt?" + +REM [del] +ENDIF +REM [edel] + +REM --- Back to life as normal --- + +workSize%=USR(bas_code%+bcode_wSize) +DIM bas_workspace% workSize% +H%=bas_workspace% +CALL bas_code%+bcode_init +SYS "XOS_ReadVarVal","BAS$Output",bas_scratch%,256,3 TO ,,len%;f% +IF f% AND 1 THEN + bas_fileName$="" +ELSE + bas_scratch%?len%=13 + bas_fileName$=$bas_scratch% +ENDIF +ENDPROC + +DEF PROCbas_aofInit(size%) +LOCAL H% +IF size% THEN DIM bas_asmCode% size% ELSE bas_asmCode%=bas_asmCode% +IF bas_asmCode%=0 THEN ERROR 0,"No buffer allocated for assembler code" +H%=bas_workspace% +CALL bas_code%+bcode_aofInit,bas_asmCode% +ENDPROC + +REM This function saves a few bytes and tidies up the code a bit. + +DEF FNbas_call(offset%) +LOCAL H% +H%=bas_workspace% +=USR(bas_code%+offset%) + +REM ----- AOF code generation ----------------------------------------------- + +DEF PROCbas_aofSaveAs(name$) +LOCAL H% +H%=bas_workspace% +CALL bas_code%+bcode_save,name$ +ENDPROC + +DEF PROCbas_aofSave +IF bas_fileName$="" THEN ERROR 0,"No implicit filename" +PROCbas_aofSaveAs(bas_fileName$) +bas_fileName$="" +ENDPROC + +DEF FNpass=FNbas_call(bcode_newPass) + +DEF FNbas_port(offset%,A%,s$,t$) +LOCAL H% +H%=bas_workspace% +CALL bas_code%+offset%,s$,t$ +=0 + +DEF FNimport(var$)=FNbas_port(bcode_import,0,var$,var$) +DEF FNimportAs(sym$,var$)=FNbas_port(bcode_import,0,sym$,var$) +DEF FNimportWeak(var$)=FNbas_port(bcode_import,1,var$,var$) +DEF FNimportWeakAs(sym$,var$)=FNbas_port(bcode_import,1,sym$,var$) +DEF FNexport(var$)=FNbas_port(bcode_export,0,var$,var$) +DEF FNexportAs(var$,sym$)=FNbas_port(bcode_export,0,var$,sym$) +DEF FNexportStrong(var$)=FNbas_port(bcode_export,1,var$,var$) +DEF FNexportStrongAs(var$,sym$)=FNbas_port(bcode_export,1,var$,sym$) + +DEF FNget(file$) +LOCAL H% +H%=bas_workspace% +CALL bas_code%+bcode_get,file$ +=0 + +DEF FNbas_lib(lib$) +LOCAL err%,leaf$,lower$,i% +leaf$=lib$ +FOR i%=1 TO LEN(lib$) + IF INSTR(":.",MID$(lib$,i%,1)) THEN leaf$=MID$(lib$,i%+1) +NEXT +FOR i%=1 TO LEN(leaf$) + lower$+=CHR$(ASC(MID$(leaf$,i%,1)) OR &20) +NEXT +LOCAL ERROR +ON ERROR LOCAL err%=TRUE +IF err%=FALSE THEN + IF EVAL("FN"+lower$+"_test") +ENDIF +RESTORE ERROR +IF err%=TRUE THEN LIBRARY lib$ +=0 + +DEF FNarea(name$,attr$) +LOCAL A%,H% +A%=2 +IF INSTR(attr$,"CODE") THEN A%+=&200 +IF INSTR(attr$,"COMDEF") THEN A%+=&400 +IF INSTR(attr$,"COMMON") THEN A%+=&800 +IF INSTR(attr$,"NOINIT") THEN A%+=&1000 +IF INSTR(attr$,"READONLY") THEN A%+=&2000 +IF INSTR(attr$,"DEBUG") THEN A%+=&8000 +IF A% AND &800 THEN A%=A% OR &1000 +IF A% AND &200 THEN A%=A% OR &2000 +H%=bas_workspace% +CALL bas_code%+bcode_area,name$ +=0 + +DEF FNreloc=FNbas_call(bcode_reloc) +DEF FNnoReloc=FNbas_call(bcode_noReloc) + +DEF FNentry=FNbas_call(bcode_entry) + +REM ----- Literal handling -------------------------------------------------- + +DEF PROClitStart +bas_litStart%=P% +bas_savedOpt%=USR(bas_code%+bcode_saveOpt) +ENDPROC + +DEF FNlitw(val%) +PROClitStart +[ opt 4: dcd val%:] +=FNlitAlign + +DEF FNlits(str$) +PROClitStart +[ opt 4: equs str$:] +=FNlit + +DEF FNlitmagic(str$) +PROClitStart +[ opt 4: equs str$:] +=FNlitAlign + +DEF FNlitsz(str$) +PROClitStart +[ opt 4: equs str$+CHR$0:] +=FNliteral + +DEF FNliterr(err%,str$) +PROClitStart +[ opt 4: dcd err%: equs str$+CHR$0:] +=FNlitAlign + +DEF FNliteral +LOCAL A%,B%,C% +A%=bas_savedOpt% +CALL bas_code%+bcode_restoreOpt +B%=P%-bas_litStart% +A%=O%-B% +C%=0 +P%=bas_litStart% +O%=A% +=FNbas_call(bcode_lit) + +DEF FNlitAlign +LOCAL A%,B%,C% +A%=bas_savedOpt% +CALL bas_code%+bcode_restoreOpt +B%=P%-bas_litStart% +A%=O%-B% +C%=1 +P%=bas_litStart% +O%=A% +=FNbas_call(bcode_lit) + +DEF FNltorg=FNbas_call(bcode_ltorg) + +REM ----- Initialising areas ------------------------------------------------ + +DEF FNalign=FNbas_call(bcode_align) +DEF FNreserve(A%)=FNbas_call(bcode_reserve) + +DEF FNbin(file$) +LOCAL size% +IF FNbas_call(bcode_noReloc) +size%=FNfSize(file$) +SYS "OS_File",16,file$,O%,0 +O%+=size% +P%+=size% +IF FNbas_call(bcode_reloc) +=0 + +DEF FNfSize(file$) +LOCAL size% +SYS "OS_File",17,file$ TO ,,,,size% +=size% + +REM ----- Laying out storage areas ------------------------------------------ + +DEF PROCws_start +bas_R%=0 +ENDPROC + +DEF PROCws_base(start%) +bas_R%=start% +ENDPROC + +DEF FNws(size%) +bas_R%+=size% +=bas_R%-size% + +DEF PROCws_align +bas_R%=(bas_R%+3) AND -4 +ENDPROC + +DEF FNws_word +PROCws_align +=FNws(4) + +DEF FNws_byte=FNws(1) + +REM ----- Long directives --------------------------------------------------- + +DEF FNadrl(r%,adr%)=FNaddccl(14,r%,15,adr%-P%-8) +DEF FNadrccl(cc%,r%,adr%)=FNaddccl(cc%,r%,15,adr%-P%-8) +DEF FNaddl(r%,b%,off%)=FNaddccl(14,r%,b%,off%) +DEF FNaddccl(cc%,r%,b%,off%) +IF off%>0 THEN + [opt 4:addeq r%,b%,#off% AND 255:addeq r%,r%,#off% AND -256:] +ELSE + [opt 4:subeq r%,pc,#(-off%) AND 255:subeq r%,r%,#(-off%) AND -256:] +ENDIF +!(O%-8)=!(O%-8) OR (cc%<<28) +!(O%-4)=!(O%-4) OR (cc%<<28) +=0 + +DEF FNldrl(r%,adr%)=FNldrrccl(14,r%,15,adr%-P%-8) +DEF FNldrccl(cc%,r%,adr%)=FNldrrccl(cc%,r%,15,adr%-P%-8) +DEF FNldrrl(r%,b%,off%)=FNldrrccl(14,r%,b%,off%) +DEF FNldrrccl(cc%,r%,b%,off%) +IF off%>0 THEN + [opt 4:addeq r%,b%,#off% AND -256:ldreq r%,[r%,#off% AND 255]:] +ELSE + [opt 4:subeq r%,b%,#(-off%) AND -256:ldreq r%,[r%,#-((-off%) AND 255)]:] +ENDIF +!(O%-8)=!(O%-8) OR (cc%<<28) +!(O%-4)=!(O%-4) OR (cc%<<28) +=0 + +REM ----- That's all, folks -------------------------------------------------