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

   1 ;
   2 ; bas.s
   3 ;
   4 ; Base code for BAS
   5 ;
   6 ; © 1994-1998 Straylight
   7 ;
   8
   9 ;----- Licensing note -------------------------------------------------------
  10 ;
  11 ; This file is part of Straylight's BASIC Assembler Supplement.
  12 ;
  13 ; BAS is free software; you can redistribute it and/or modify
  14 ; it under the terms of the GNU General Public License as published by
  15 ; the Free Software Foundation; either version 2, or (at your option)
  16 ; any later version.
  17 ;
  18 ; BAS is distributed in the hope that it will be useful,
  19 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ; GNU General Public License for more details.
  22 ;
  23 ; You should have received a copy of the GNU General Public License
  24 ; along with BAS.  If not, write to the Free Software Foundation,
  25 ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  26
  27 ;----- Standard Header ------------------------------------------------------
  28
  29                 GET     libs:header
  30                 GET     libs:swis
  31
  32                 GET     libs:stream
  33
  34 ;----- External dependencies ------------------------------------------------
  35
  36                 GET     sh.aofGen
  37                 GET     sh.basicEnv
  38                 GET     sh.basTalk
  39                 GET     sh.fastMove
  40                 GET     sh.flex
  41                 GET     sh.get
  42                 GET     sh.insert
  43                 GET     sh.lit
  44                 GET     sh.messages
  45                 GET     sh.string
  46                 GET     sh.vars
  47                 GET     sh.workspace
  48
  49 ;----- Branch table header --------------------------------------------------
  50
  51                 AREA    |!BAS$$Header|,CODE,READONLY
  52
  53                 B       bas__workSize           ;Find workspace requirements
  54                 B       bas__init               ;Initialise workspace
  55                 B       aof_init                ;Initialise AOF generation
  56                 B       aof_pass                ;Signal start of new pass
  57                 B       aof_iImport             ;Import a symbol
  58                 B       aof_export              ;Export a symbol
  59                 B       get                     ;Read in a header file
  60                 B       aof_area                ;Define start of new area
  61                 B       aof_reloc               ;Mark start of reloc area
  62                 B       aof_noReloc             ;Mark start of non-reloc area
  63                 B       aof_entry               ;Define entry point of image
  64                 B       aof_save                ;Save AOF file
  65                 B       insert_align            ;Align and add zeroes
  66                 B       insert_reserve          ;Reserve lots of zeroes
  67                 B       lit_add                 ;Add data to literal pool
  68                 B       lit_ltorg               ;Insert a literal pool
  69                 B       bas__saveOpt            ;Read the current OPT value
  70                 B       bas__restoreOpt         ;Restore the OPT value
  71
  72 ;----- Main code ------------------------------------------------------------
  73
  74                 AREA    |BAS$$Code|,CODE,READONLY
  75
  76 ; --- bas__workSize ---
  77 ;
  78 ; On entry:     --
  79 ;
  80 ; On exit:      R0 == size of workspace required (picked up by USR())
  81 ;
  82 ; Use:          Allows the BASIC component to allocate a workspace block of
  83 ;               the right size.  This will then be passed to us in R7 when
  84 ;               we get called later.
  85
  86 bas__workSize   ROUT
  87
  88                 LDR     R0,=bas_wSize           ;Get the workspace size
  89                 MOVS    PC,R14                  ;And return to caller
  90
  91                 LTORG
  92
  93 ; --- bas__init ---
  94 ;
  95 ; On entry:     R7 == address of workspace
  96 ;               R8-R14 from BASIC's CALL
  97 ;
  98 ; On exit:      --
  99 ;
 100 ; Use:          Initialises the code component of BAS.
 101
 102 bas__init       ROUT
 103
 104                 STMFD   R13!,{R12,R14}          ;Save some registers
 105                 STR     R12,[R7,#:INDEX:be__line] ;Store line value
 106                 MOV     R12,R7                  ;Point to my workspace
 107
 108                 ; --- Fill in the BASIC environment things ---
 109
 110                 STR     R8,be__argp             ;Save BASIC's workspace addr
 111                 STR     R14,be__interface       ;And save the interface ptr
 112
 113                 ; --- Set up some special bits ---
 114
 115                 MOV     R14,#0                  ;Set up string's buffer
 116                 STR     R14,str__buffNum        ;Tell it to use the first one
 117                 STR     R14,aof__objHead        ;We're not generating AOF
 118
 119                 ; --- Work out address of A% ---
 120
 121                 ADR     R0,bas__aPercent        ;Find the variable name
 122                 BL      bTalk_lvblnk            ;Find the address of it
 123                 STR     R0,be__percents         ;Save this address
 124
 125                 ; --- Start up our memory manager ---
 126
 127                 BL      flex_init               ;Initialise flex
 128                 BL      vars_set                ;Set up register names etc.
 129
 130                 LDMFD   R13!,{R12,PC}^          ;And return to caller
 131
 132 bas__aPercent   DCB     "A%",0
 133
 134                 LTORG
 135
 136 ; --- bas__saveOpt ---
 137 ;
 138 ; On entry:     R8 == BASIC's ARGP pointer
 139 ;
 140 ; On exit:      R0 == current value of OPT
 141 ;
 142 ; Use:          Returns the current value of BASIC's assembler options.  This
 143 ;               is handy, because BASIC doesn't seem terribly good at
 144 ;               handling this by itself.  The value -38 used here is stolen
 145 ;               from BAX.
 146
 147 bas__saveOpt    ROUT
 148
 149                 LDRB    R0,[R8,#-38]            ;Load the OPT value
 150                 MOVS    PC,R14                  ;And return to caller
 151
 152                 LTORG
 153
 154 ; --- bas__restoreOpt ---
 155 ;
 156 ; On entry:     R0 == OPT value to restore
 157 ;               R8 == BASIC's ARGP pointer
 158 ;
 159 ; On exit:      --
 160 ;
 161 ; Use:          Sets the value of BASIC's assembler options to the given
 162 ;               value.  This is necessary because BASIC isn't terribly good
 163 ;               at nesting the option values.
 164
 165 bas__restoreOpt ROUT
 166
 167                 STRB    R0,[R8,#-38]            ;Store the OPT value
 168                 MOVS    PC,R14                  ;And return to caller
 169
 170                 LTORG
 171
 172 ; --- bas_argString ---
 173 ;
 174 ; On entry:     R1 == address of destination buffer
 175 ;               R9 == pointer to argument entry
 176 ;               R10 == number of arguments left
 177 ;
 178 ; On exit:      R9 increased by 8
 179 ;               R10 decreased by 1
 180 ;
 181 ; Use:          Reads a string argument into a buffer and null terminates
 182 ;               it sensibly so we can use it.
 183
 184                 EXPORT  bas_argString
 185 bas_argString   ROUT
 186
 187                 STMFD   R13!,{R0-R3,R14}        ;Save some registers
 188                 SUBS    R10,R10,#1              ;Decrement R10 as promised
 189                 BCC     bas_badCall             ;If there wasn't one, die
 190                 LDR     R14,[R9,#4]             ;Load the argument type
 191                 CMP     R14,#&81                ;Is this a $(addr) string?
 192                 BEQ     %50bas_argString        ;Yes -- handle that then
 193                 CMP     R14,#&80                ;Is it a normal string?
 194                 BNE     bas_badCall             ;No -- the make an error
 195
 196                 ; --- Handle a normal string variable ---
 197
 198                 MOV     R0,R1                   ;Point to caller's buffer
 199                 LDR     R3,[R9],#8              ;Load the string pointer
 200                 ANDS    R14,R3,#3               ;Get non-word-alignedness
 201                 BIC     R1,R3,#3                ;Word align anyway
 202                 LDMIA   R1,{R1,R2}              ;Load the possible bytes
 203                 MOV     R14,R14,LSL #3          ;Convert bytes to bits
 204                 MOVNE   R1,R1,LSR R14           ;Shove the bytes down
 205                 RSB     R14,R14,#32             ;Get the other shift size
 206                 ORRNE   R1,R1,R2,LSL R14        ;And work that out
 207                 LDRB    R2,[R3,#4]              ;Load the string length
 208                 BL      fastMove                ;(This is overkill)
 209                 MOV     R14,#0                  ;Terminate the string
 210                 STRB    R14,[R0,R2]             ;Do this nicely
 211                 B       %90bas_argString        ;And return to caller
 212
 213                 ; --- Handle a $(addr) type string ---
 214
 215 50bas_argString MOV     R2,R1                   ;Keep the buffer pointer
 216                 MOV     R0,R1                   ;And point to it for str_cpy
 217                 LDR     R1,[R9],#8              ;Point to caller's string
 218                 BL      str_cpy                 ;Copy it over (and null term)
 219
 220 90bas_argString LDMFD   R13!,{R0-R3,PC}^        ;Return to caller
 221
 222                 LTORG
 223
 224 ; --- bas_badCall ---
 225 ;
 226 ; On entry:     --
 227 ;
 228 ; On exit:      Generates an error
 229 ;
 230 ; Use:          Generates an error about bad arguments.  It saves space to
 231 ;               just have this here.
 232
 233                 EXPORT  bas_badCall
 234 bas_badCall     ROUT
 235
 236                 ADRL    R0,msg_errBadArg
 237                 SWI     OS_GenerateError
 238
 239                 LTORG
 240
 241 ; --- bas_noMem ---
 242 ;
 243 ; On entry:     --
 244 ;
 245 ; On exit:      Generates an error
 246 ;
 247 ; Use:          Generates an error about not having any memory left.
 248
 249
 250                 EXPORT  bas_noMem
 251 bas_noMem       ROUT
 252
 253                 ADRL    R0,msg_errNoMoreMem
 254                 SWI     OS_GenerateError
 255
 256                 LTORG
 257
 258 ;----- That's all, folks ----------------------------------------------------
 259
 260                 END