mdw@git.distorted.org.uk Git - ssr/blob - StraySrc/Libraries/BAS/src/b/bas.bas

   1 REM Basic Assembler Supplement 1.00 © 1996-1998 Straylight
   2 REMÂÁÓhack
   3
   4 REM ----- Licensing note ----------------------------------------------------
   5 REM
   6 REM This file is part of Straylight's BASIC Assembler Supplement (BAS)
   7 REM
   8 REM BAS is free software; you can redistribute it and/or modify
   9 REM it under the terms of the GNU General Public License as published by
  10 REM the Free Software Foundation; either version 2, or (at your option)
  11 REM any later version
  12 REM
  13 REM BAS is distributed in the hope that it will be useful,
  14 REM but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 REM GNU General Public License for more details.
  17 REM
  18 REM You should have received a copy of the GNU General Public License
  19 REM along with BAS.  If not, write to the Free Software Foundation,
  20 REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  21
  22 REM --- Hacking warning ---
  23 REM
  24 REM That gorp on the second line is a magic marker word inserted by hand
  25 REM (the three letters `BAS' with their top bits set) and space for an offset
  26 REM word which marks the offset of the code section from the beginning of
  27 REM the LIBRARY link block.  Don't play with them unless you (a) know what
  28 REM you're doing (and it should be perfectly clear by now that I don't have
  29 REM a clue), and (b) want to seriously upset the library search code below.
  30
  31 ERROR 0,"You can't run the Basic Assembler Supplement"
  32
  33 REM --- A note ---
  34 REM
  35 REM To make this program particularly easy to strip down and transmogrify,
  36 REM it contains directives which are picked up by a sed script during
  37 REM munging.  The directives currently are `del ... edel' which deletes
  38 REM all the enclosed lines, and `hex' which inserts the generated hex version
  39 REM of the library search code.  Directives are enclosed in square brackets.
  40 REM It's usual to put them in REM statements.
  41
  42 REM ----- Initialisation ----------------------------------------------------
  43
  44 REM [del]
  45 DEF FNbas_assign(RETURN d,v%):d=v%:=0
  46 DEF PROCbas_const(var$,val%)
  47 IF bas_cf% THEN BPUT #bas_cf%,"/\<"+var$+"\>/s//"+STR$(val%)+"/g"
  48 IF EVAL("FNbas_assign("+var$+",val%)")
  49 ENDPROC
  50
  51 DEF FNnext:R%+=4:=R%-4
  52
  53 DEF PROCbas_saveconst
  54 bas_cf%=OPENOUT("work.basconst")
  55
  56 DEF PROCbas_constants
  57 bas_cf%=bas_cf%
  58 R%=0
  59 PROCbas_const("bcode_wSize",FNnext)
  60 PROCbas_const("bcode_init",FNnext)
  61 PROCbas_const("bcode_aofInit",FNnext)
  62 PROCbas_const("bcode_newPass",FNnext)
  63 PROCbas_const("bcode_import",FNnext)
  64 PROCbas_const("bcode_export",FNnext)
  65 PROCbas_const("bcode_get",FNnext)
  66 PROCbas_const("bcode_area",FNnext)
  67 PROCbas_const("bcode_reloc",FNnext)
  68 PROCbas_const("bcode_noReloc",FNnext)
  69 PROCbas_const("bcode_entry",FNnext)
  70 PROCbas_const("bcode_save",FNnext)
  71 PROCbas_const("bcode_align",FNnext)
  72 PROCbas_const("bcode_reserve",FNnext)
  73 PROCbas_const("bcode_lit",FNnext)
  74 PROCbas_const("bcode_ltorg",FNnext)
  75 PROCbas_const("bcode_saveOpt",FNnext)
  76 PROCbas_const("bcode_restoreOpt",FNnext)
  77 IF bas_cf% THEN CLOSE #bas_cf%
  78 ENDPROC
  79 REM [edel]
  80
  81 REM --- Unexplainable horridness ---
  82 REM
  83 REM Tim wants to be able to embed the code into this library file, so
  84 REM that it doesn't have to be searched for.  I'll therefore have to write
  85 REM some code to scan the library list and locate this one, and find the
  86 REM code tacked onto the end.  Yuk.
  87
  88 DEF PROCbas_init
  89 LOCAL type%,size%                               :REM [dl]
  90 LOCAL workSize%,H%,len%,f%
  91 PROCbas_constants                               :REM [dl]
  92
  93 REM --- Old code to load the library from disk ---
  94
  95 REM [del]
  96 IF TRUE THEN
  97   DIM bas_scratch% 300
  98   SYS "OS_File",17,"libs:BAScode" TO type%,,,,size%
  99   IF type%<>1 THEN ERROR 0,"BAS code not found"
 100   DIM bas_code% size%
 101   SYS "OS_File",16,"libs:BAScode",bas_code%,0
 102 ELSE
 103 DEF PROCbas_dumpcode
 104 REM [edel]
 105
 106 REM --- New hacking to scan the library list ---
 107 REM
 108 REM This must be done in assembler, of course ;-)  Time to put on my pointy
 109 REM Rincewind hat...  I've tried to do this in one pass because I'm lazy --
 110 REM I guess that's why it's unreadable.
 111
 112   DIM bas_scratch% 300
 113   P%=bas_scratch%
 114   [ opt 0
 115
 116     ; exit with r0 == pointer to code, or 0 if not found (erk!)
 117
 118     ldr r2,[pc]              ; load the magic marker word
 119     mov pc,pc                ; skip over the magic marker word
 120     dcd &d3c1c2f4            ; this is `REMBAS', with the top bits set
 121
 122     ldr r0,[r14,#&24]        ; find offset of TIMEOF
 123     add r0,r8,r0             ; add on ARGP to find TIMEOF
 124     ldr r0,[r0,#&c]          ; load the library list base
 125
 126 ;.loop
 127     cmp r0,#0                ; is that the end of it all?
 128     moveqs pc,r14            ; yes -- oh, well -- it was a nice try
 129
 130     ldr r1,[r0,#&44]         ; load mystic recognition word
 131     cmp r1,r2                ; does it match?
 132     ldrne r0,[r0]            ; if not there, load the next link
 133     subne pc,pc,#28          ; and jump back to `loop' (erk)
 134
 135     ldr r1,[r0,#&48]         ; load the code offset
 136     add r0,r1,r0             ; and add it to the base address
 137     movs pc,r14
 138   ]
 139
 140   REM --- Now some code to dump that out as hex ---
 141
 142   bas_code%=USR bas_scratch%
 143   IF bas_code%=0 THEN ERROR 0,"BAS code not found: is the library corrupt?"
 144
 145 REM [del]
 146 ENDIF
 147 REM [edel]
 148
 149 REM --- Back to life as normal ---
 150
 151 workSize%=USR(bas_code%+bcode_wSize)
 152 DIM bas_workspace% workSize%
 153 H%=bas_workspace%
 154 CALL bas_code%+bcode_init
 155 SYS "XOS_ReadVarVal","BAS$Output",bas_scratch%,256,3 TO ,,len%;f%
 156 IF f% AND 1 THEN
 157   bas_fileName$=""
 158 ELSE
 159   bas_scratch%?len%=13
 160   bas_fileName$=$bas_scratch%
 161 ENDIF
 162 ENDPROC
 163
 164 DEF PROCbas_aofInit(size%)
 165 LOCAL H%
 166 IF size% THEN DIM bas_asmCode% size% ELSE bas_asmCode%=bas_asmCode%
 167 IF bas_asmCode%=0 THEN ERROR 0,"No buffer allocated for assembler code"
 168 H%=bas_workspace%
 169 CALL bas_code%+bcode_aofInit,bas_asmCode%
 170 ENDPROC
 171
 172 REM This function saves a few bytes and tidies up the code a bit.
 173
 174 DEF FNbas_call(offset%)
 175 LOCAL H%
 176 H%=bas_workspace%
 177 =USR(bas_code%+offset%)
 178
 179 REM ----- AOF code generation -----------------------------------------------
 180
 181 DEF PROCbas_aofSaveAs(name$)
 182 LOCAL H%
 183 H%=bas_workspace%
 184 CALL bas_code%+bcode_save,name$
 185 ENDPROC
 186
 187 DEF PROCbas_aofSave
 188 IF bas_fileName$="" THEN ERROR 0,"No implicit filename"
 189 PROCbas_aofSaveAs(bas_fileName$)
 190 bas_fileName$=""
 191 ENDPROC
 192
 193 DEF FNpass=FNbas_call(bcode_newPass)
 194
 195 DEF FNbas_port(offset%,A%,s$,t$)
 196 LOCAL H%
 197 H%=bas_workspace%
 198 CALL bas_code%+offset%,s$,t$
 199 =0
 200
 201 DEF FNimport(var$)=FNbas_port(bcode_import,0,var$,var$)
 202 DEF FNimportAs(sym$,var$)=FNbas_port(bcode_import,0,sym$,var$)
 203 DEF FNimportWeak(var$)=FNbas_port(bcode_import,1,var$,var$)
 204 DEF FNimportWeakAs(sym$,var$)=FNbas_port(bcode_import,1,sym$,var$)
 205 DEF FNexport(var$)=FNbas_port(bcode_export,0,var$,var$)
 206 DEF FNexportAs(var$,sym$)=FNbas_port(bcode_export,0,var$,sym$)
 207 DEF FNexportStrong(var$)=FNbas_port(bcode_export,1,var$,var$)
 208 DEF FNexportStrongAs(var$,sym$)=FNbas_port(bcode_export,1,var$,sym$)
 209
 210 DEF FNget(file$)
 211 LOCAL H%
 212 H%=bas_workspace%
 213 CALL bas_code%+bcode_get,file$
 214 =0
 215
 216 DEF FNbas_lib(lib$)
 217 LOCAL err%,leaf$,lower$,i%
 218 leaf$=lib$
 219 FOR i%=1 TO LEN(lib$)
 220   IF INSTR(":.",MID$(lib$,i%,1)) THEN leaf$=MID$(lib$,i%+1)
 221 NEXT
 222 FOR i%=1 TO LEN(leaf$)
 223   lower$+=CHR$(ASC(MID$(leaf$,i%,1)) OR &20)
 224 NEXT
 225 LOCAL ERROR
 226 ON ERROR LOCAL err%=TRUE
 227 IF err%=FALSE THEN
 228   IF EVAL("FN"+lower$+"_test")
 229 ENDIF
 230 RESTORE ERROR
 231 IF err%=TRUE THEN LIBRARY lib$
 232 =0
 233
 234 DEF FNarea(name$,attr$)
 235 LOCAL A%,H%
 236 A%=2
 237 IF INSTR(attr$,"CODE") THEN A%+=&200
 238 IF INSTR(attr$,"COMDEF") THEN A%+=&400
 239 IF INSTR(attr$,"COMMON") THEN A%+=&800
 240 IF INSTR(attr$,"NOINIT") THEN A%+=&1000
 241 IF INSTR(attr$,"READONLY") THEN A%+=&2000
 242 IF INSTR(attr$,"DEBUG") THEN A%+=&8000
 243 IF A% AND &800 THEN A%=A% OR &1000
 244 IF A% AND &200 THEN A%=A% OR &2000
 245 H%=bas_workspace%
 246 CALL bas_code%+bcode_area,name$
 247 =0
 248
 249 DEF FNreloc=FNbas_call(bcode_reloc)
 250 DEF FNnoReloc=FNbas_call(bcode_noReloc)
 251
 252 DEF FNentry=FNbas_call(bcode_entry)
 253
 254 REM ----- Literal handling --------------------------------------------------
 255
 256 DEF PROClitStart
 257 bas_litStart%=P%
 258 bas_savedOpt%=USR(bas_code%+bcode_saveOpt)
 259 ENDPROC
 260
 261 DEF FNlitw(val%)
 262 PROClitStart
 263 [ opt 4: dcd val%:]
 264 =FNlitAlign
 265
 266 DEF FNlits(str$)
 267 PROClitStart
 268 [ opt 4: equs str$:]
 269 =FNlit
 270
 271 DEF FNlitmagic(str$)
 272 PROClitStart
 273 [ opt 4: equs str$:]
 274 =FNlitAlign
 275
 276 DEF FNlitsz(str$)
 277 PROClitStart
 278 [ opt 4: equs str$+CHR$0:]
 279 =FNliteral
 280
 281 DEF FNliterr(err%,str$)
 282 PROClitStart
 283 [ opt 4: dcd err%: equs str$+CHR$0:]
 284 =FNlitAlign
 285
 286 DEF FNliteral
 287 LOCAL A%,B%,C%
 288 A%=bas_savedOpt%
 289 CALL bas_code%+bcode_restoreOpt
 290 B%=P%-bas_litStart%
 291 A%=O%-B%
 292 C%=0
 293 P%=bas_litStart%
 294 O%=A%
 295 =FNbas_call(bcode_lit)
 296
 297 DEF FNlitAlign
 298 LOCAL A%,B%,C%
 299 A%=bas_savedOpt%
 300 CALL bas_code%+bcode_restoreOpt
 301 B%=P%-bas_litStart%
 302 A%=O%-B%
 303 C%=1
 304 P%=bas_litStart%
 305 O%=A%
 306 =FNbas_call(bcode_lit)
 307
 308 DEF FNltorg=FNbas_call(bcode_ltorg)
 309
 310 REM ----- Initialising areas ------------------------------------------------
 311
 312 DEF FNalign=FNbas_call(bcode_align)
 313 DEF FNreserve(A%)=FNbas_call(bcode_reserve)
 314
 315 DEF FNbin(file$)
 316 LOCAL size%
 317 IF FNbas_call(bcode_noReloc)
 318 size%=FNfSize(file$)
 319 SYS "OS_File",16,file$,O%,0
 320 O%+=size%
 321 P%+=size%
 322 IF FNbas_call(bcode_reloc)
 323 =0
 324
 325 DEF FNfSize(file$)
 326 LOCAL size%
 327 SYS "OS_File",17,file$ TO ,,,,size%
 328 =size%
 329
 330 REM ----- Laying out storage areas ------------------------------------------
 331
 332 DEF PROCws_start
 333 bas_R%=0
 334 ENDPROC
 335
 336 DEF PROCws_base(start%)
 337 bas_R%=start%
 338 ENDPROC
 339
 340 DEF FNws(size%)
 341 bas_R%+=size%
 342 =bas_R%-size%
 343
 344 DEF PROCws_align
 345 bas_R%=(bas_R%+3) AND -4
 346 ENDPROC
 347
 348 DEF FNws_word
 349 PROCws_align
 350 =FNws(4)
 351
 352 DEF FNws_byte=FNws(1)
 353
 354 REM ----- Long directives ---------------------------------------------------
 355
 356 DEF FNadrl(r%,adr%)=FNaddccl(14,r%,15,adr%-P%-8)
 357 DEF FNadrccl(cc%,r%,adr%)=FNaddccl(cc%,r%,15,adr%-P%-8)
 358 DEF FNaddl(r%,b%,off%)=FNaddccl(14,r%,b%,off%)
 359 DEF FNaddccl(cc%,r%,b%,off%)
 360 IF off%>0 THEN
 361   [opt 4:addeq r%,b%,#off% AND 255:addeq r%,r%,#off% AND -256:]
 362 ELSE
 363   [opt 4:subeq r%,pc,#(-off%) AND 255:subeq r%,r%,#(-off%) AND -256:]
 364 ENDIF
 365 !(O%-8)=!(O%-8) OR (cc%<<28)
 366 !(O%-4)=!(O%-4) OR (cc%<<28)
 367 =0
 368
 369 DEF FNldrl(r%,adr%)=FNldrrccl(14,r%,15,adr%-P%-8)
 370 DEF FNldrccl(cc%,r%,adr%)=FNldrrccl(cc%,r%,15,adr%-P%-8)
 371 DEF FNldrrl(r%,b%,off%)=FNldrrccl(14,r%,b%,off%)
 372 DEF FNldrrccl(cc%,r%,b%,off%)
 373 IF off%>0 THEN
 374   [opt 4:addeq r%,b%,#off% AND -256:ldreq r%,[r%,#off% AND 255]:]
 375 ELSE
 376   [opt 4:subeq r%,b%,#(-off%) AND -256:ldreq r%,[r%,#-((-off%) AND 255)]:]
 377 ENDIF
 378 !(O%-8)=!(O%-8) OR (cc%<<28)
 379 !(O%-4)=!(O%-4) OR (cc%<<28)
 380 =0
 381
 382 REM ----- That's all, folks -------------------------------------------------