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