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 -------------------------------------------------