chiark - git - mdw - ssr/blob - StraySrc/Libraries/BAS/src/s/basTalk

   1 ;
   2 ; basTalk.s
   3 ;
   4 ; Interface to BASIC's weird routines
   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.basicEnv
  37                 GET     sh.messages
  38                 GET     sh.string
  39                 GET     sh.workspace
  40
  41 ;----- Main code ------------------------------------------------------------
  42
  43                 AREA    |BAS$$Code|,CODE,READONLY
  44
  45 ; --- bTalk_lvblnk ---
  46 ;
  47 ; On entry:     R0 == pointer to variable name to find (not tokenised)
  48 ;
  49 ; On exit:      R0 == address of lvalue
  50 ;               R1 == type of lvalue
  51 ;
  52 ; Use:          Tries to locate the given BASIC variable.
  53
  54                 EXPORT  bTalk_lvblnk
  55 bTalk_lvblnk    ROUT
  56
  57                 STMFD   R13!,{R0-R12,R14}       ;Save some registers
  58
  59                 ; --- Make sure name is tokenised ---
  60
  61                 BL      str_buffer              ;Get a string buffer nicely
  62                 MOV     R2,R1                   ;This is the destination
  63                 MOV     R11,R2                  ;Keep a pointer to it
  64                 MOV     R1,R0                   ;Point to his source string
  65                 BL      bTalk_match             ;Tokenise the variable name
  66
  67                 ; --- Find the lvalue ---
  68
  69                 LDR     R7,be__interface        ;Point to EIB
  70                 LDR     R8,be__argp             ;Get argp pointer
  71                 LDR     R12,be__line            ;Get line pointer
  72                 MOV     R14,PC                  ;Set up return address
  73                 ADD     PC,R7,#bEnv_lvblnk      ;Call BASIC's strange routine
  74                 MOVNE   R1,R9                   ;Get variable type in R1
  75                 ADDNE   R13,R13,#8              ;Don't keep R0, R1 saved
  76                 LDMNEFD R13!,{R2-R12,PC}^       ;Return if found
  77
  78                 ; --- Complain about duff variable names ---
  79
  80 bTalk__badName  LDR     R12,[R13,#48]           ;Find workspace (good plan)
  81                 LDR     R2,[R13,#0]             ;Point to the variable name
  82                 ADRCSL  R0,msg_errBadLValue     ;If very bad, point to error
  83                 ADRCCL  R0,msg_errVarNotFound   ;Otherwise say couldn't find
  84                 BL      str_error               ;Build appropriate error
  85                 SWI     OS_GenerateError        ;And report it nicely
  86
  87                 LTORG
  88
  89 ; --- bTalk_create ---
  90 ;
  91 ; On entry:     R0 == pointer to name of variable
  92 ;
  93 ; On exit:      R0 == address of variable lvalue
  94 ;               R1 == type of variable created
  95 ;
  96 ; Use:          Creates a variable, if it doesn't already exist.  Otherwise
  97 ;               a pointer to the existing variable is returned.
  98
  99                 EXPORT  bTalk_create
 100 bTalk_create    ROUT
 101
 102                 STMFD   R13!,{R0-R12,R14}       ;Save too many registers
 103
 104                 ; --- Make sure name is tokenised ---
 105
 106                 BL      str_buffer              ;Get a string buffer nicely
 107                 MOV     R2,R1                   ;This is the destination
 108                 MOV     R11,R2                  ;Keep a pointer to it
 109                 MOV     R1,R0                   ;Point to his source string
 110                 BL      bTalk_match             ;Tokenise the variable name
 111
 112                 ; --- Find the lvalue ---
 113
 114                 LDR     R7,be__interface        ;Point to EIB
 115                 LDR     R8,be__argp             ;Get argp pointer
 116                 LDR     R12,be__line            ;Get line pointer
 117                 MOV     R14,PC                  ;Set up return address
 118                 ADD     PC,R7,#bEnv_lvblnk      ;Call BASIC's strange routine
 119                 MOVNE   R1,R9                   ;Get variable type in R1
 120                 ADDNE   R13,R13,#8              ;Don't keep R0, R1 saved
 121                 LDMNEFD R13!,{R2-R12,PC}^       ;Return if found
 122                 BCS     bTalk__badName          ;Contort rampantly on error
 123
 124                 ; --- Wasn't there -- try to create it ---
 125
 126                 MOV     R14,PC                  ;Set up return address
 127                 ADD     PC,R7,#bEnv_create      ;Call CREATE routine
 128                 MOV     R1,R9                   ;Get the variable type
 129                 ADD     R13,R13,#8              ;Don't keep R0, R1 saved
 130                 LDMFD   R13!,{R2-R12,PC}^       ;Return pristine variable
 131
 132                 LTORG
 133
 134 ; --- bTalk_store ---
 135 ;
 136 ; On entry:     R0 == lvalue in which to store
 137 ;               R1 == type of lvalue
 138 ;               R2 == (integer) value to store
 139 ;
 140 ; On exit:      --
 141 ;
 142 ; Use:          Stores an integer value in a BASIC variable.  The value is
 143 ;               converted to floating point if required (without loss of
 144 ;               precision).
 145
 146                 EXPORT  bTalk_store
 147 bTalk_store     ROUT
 148
 149                 STMFD   R13!,{R0-R12,R14}       ;Save too many registers
 150                 MOV     R4,R0                   ;Point to the lvalue
 151                 MOV     R5,R1                   ;Get the lvalue's type
 152                 MOV     R0,R2                   ;Put value in R0
 153                 MOV     R9,#&40000000           ;It's an integer, Jim
 154                 LDR     R7,be__interface        ;Find the EIB
 155                 LDR     R8,be__argp             ;Get BASIC's workspace
 156                 LDR     R12,be__line            ;Tell it which line we're on
 157                 MOV     R14,PC                  ;Set up return address
 158                 ADD     PC,R7,#bEnv_storea      ;Save the values away
 159                 LDMFD   R13!,{R0-R12,PC}^       ;Return to caller
 160
 161                 LTORG
 162
 163 ; --- bTalk_load ---
 164 ;
 165 ; On entry:     R0 == address of lvalue
 166 ;               R1 == type of lvalue
 167 ;
 168 ; On exit:      R2 == integer value of lvalue
 169 ;
 170 ; Use:          Loads an integer variable from an lvalue.
 171
 172                 EXPORT  bTalk_load
 173 bTalk_load      ROUT
 174
 175                 STMFD   R13!,{R0,R1,R3-R12,R14} ;Save lots of registers
 176
 177                 ; --- Load value from register ---
 178
 179                 LDR     R8,be__argp             ;Load BASIC's workspace
 180                 LDR     R7,be__interface        ;Find the EIB
 181                 LDR     R12,be__line            ;And get the current LINE
 182
 183                 MOV     R9,R1                   ;Get the lvalue's type
 184                 MOV     R14,PC                  ;Set up return address
 185                 ADD     PC,R7,#bEnv_varind      ;Load the variable value
 186                 TEQ     R9,#0                   ;Was it a string?
 187                 BEQ     %80bTalk_load           ;Yes -- this is evil
 188
 189                 ; --- Now convert floating point to integer ---
 190
 191                 MOVMI   R14,PC                  ;Set up return address
 192                 ADDMI   PC,R7,#bEnv_fix         ;And fix it into R0
 193
 194                 ; --- Return the value ---
 195
 196                 MOV     R2,R0                   ;Put value in R2 nicely
 197                 LDMFD   R13!,{R0,R1,R3-R12,PC}^ ;Return to caller
 198
 199                 ; --- Silly user gave us a string ---
 200
 201 80bTalk_load    ADRL    R0,msg_errOddString     ;Point to error
 202                 SWI     OS_GenerateError        ;And tell the world
 203
 204                 LTORG
 205
 206 ; --- bTalk_eval ---
 207 ;
 208 ; On entry:     R1 == pointer to a control-terminated string
 209 ;
 210 ; On exit:      R0 == value of expression
 211 ;
 212 ; Use:          Evaluates a BASIC expression.
 213
 214                 EXPORT  bTalk_eval
 215 bTalk_eval      ROUT
 216
 217                 STMFD   R13!,{R1-R12,R14}       ;Save some registers
 218                 MOV     R0,R1                   ;Look after string address
 219                 BL      str_buffer              ;Get a string buffer
 220                 MOV     R2,R1                   ;This is destination buffer
 221                 MOV     R1,R0                   ;Point to source buffer
 222                 BL      bTalk_match             ;Tokenise the string nicely
 223
 224                 ; --- Evaluate the expression ---
 225
 226                 LDR     R8,be__argp             ;Load BASIC's workspace
 227                 LDR     R7,be__interface        ;Find the interface block
 228                 LDR     R12,be__line            ;Load current LINE value
 229                 MOV     R11,R2                  ;Point to tokenised expr
 230                 STMFD   R13!,{R7}               ;Save environment pointer
 231                 MOV     R14,PC                  ;Set up return address
 232                 ADD     PC,R7,#bEnv_expr        ;Get BASIC to evaluate it
 233                 LDMFD   R13!,{R7}               ;Restore environment pointer
 234                 BEQ     %80bTalk_eval           ;If string, make an error
 235
 236                 MOVMI   R14,PC                  ;If floating point, fix it
 237                 ADDMI   PC,R7,#bEnv_fix         ;To get an integer
 238
 239                 LDMFD   R13!,{R1-R12,PC}^       ;And return value to caller
 240
 241                 ; --- Expression gave us a string ---
 242
 243 80bTalk_eval    ADRL    R0,msg_errOddString     ;Point to error message
 244                 SWI     OS_GenerateError        ;And raise an error nicely
 245
 246                 LTORG
 247
 248 ; --- bTalk_match ---
 249 ;
 250 ; On entry:     R1 == ctrl terminated string
 251 ;               R2 == destination pointer
 252 ;
 253 ; On exit:      --
 254 ;
 255 ; Use:          Tokenises the given sting, and puts the result in the
 256 ;               destination buffer given.
 257
 258                 EXPORT  bTalk_match
 259 bTalk_match     ROUT
 260
 261                 STMFD   R13!,{R0-R5,R14}        ;Store some registers
 262
 263                 ; --- BASIC wants string CR terminated ---
 264
 265                 MOV     R3,R1                   ;Point to source string
 266 00bTalk_match   LDRB    R14,[R3],#1             ;Load the next byte
 267                 CMP     R14,#32                 ;Is this the end of it?
 268                 BCS     %00bTalk_match          ;No -- go round again then
 269                 MOV     R14,#13                 ;Want it CR terminated
 270                 STRB    R14,[R3,#-1]            ;Save over terminator
 271
 272                 ; --- Get BASIC to do tokenising ---
 273
 274                 MOV     R3,#0                   ;Parse an lvalue
 275                 MOV     R4,#0                   ;Without line numbers
 276                 LDR     R5,be__interface        ;Get the EIB
 277                 MOV     R14,PC                  ;Set up return address
 278                 ADD     PC,R5,#bEnv_match       ;Call match routine
 279                 LDMFD   R13!,{R0-R5,PC}^        ;Return with gleefulness
 280
 281                 LTORG
 282
 283 ;----- That's all, folks ----------------------------------------------------
 284
 285                 END