chiark - git - mdw - ssr/blob - StraySrc/Libraries/Sapphire/sail/s/sail

   1 ;
   2 ; sail.s
   3 ;
   4 ; Main SAIL API
   5 ;
   6 ; © 1995 Straylight
   7 ;
   8
   9 ;----- Standard header ------------------------------------------------------
  10
  11                 GET     libs:header
  12                 GET     libs:swis
  13
  14                 GET     libs:stream
  15
  16 ;----- External dependencies ------------------------------------------------
  17
  18 ;----- Main code ------------------------------------------------------------
  19
  20                 AREA    |Sapphire$$Code|,CODE,READONLY
  21
  22 ; --- sail_initScript ---
  23 ;
  24 ; On entry:     R0 == flex block handle of file
  25 ;               R1 == environment handle to attach script to
  26 ;               R2 == flex anchor of global variable pool
  27 ;               R3 == how often to pre-empt the script (-1 == don't)
  28 ;
  29 ; On exit:      R0 == script handle
  30 ;               May return an error
  31 ;
  32 ; Use:          Tokenises the script, set up global labels etc.
  33
  34                 EXPORT  sail_initScript
  35 sail_initScript ROUT
  36
  37
  38                 STMFD   R13!,{R1-R4,R12,R14}    ;Save some registers
  39
  40                 ; --- Find the size of the file ---
  41
  42                 MOV     R4,R0                   ;Look after the anchor
  43                 BL      flex_size               ;Find the file size
  44                 MOV     R1,R0                   ;Look after this value
  45
  46                 ; --- Allocate an anchor/stack block ---
  47
  48                 MOV     R0,#sail_blkSize        ;Get the block's size
  49                 BL      alloc                   ;Try to allocate memory
  50                 BLCS    alloc_error             ;Allocate memory
  51                 BCS     %99                     ;If it failed, return error
  52                 MOV     R12,R0                  ;Point to block in R12
  53
  54                 ; --- Fill in the rest of the block ---
  55
  56                 LDMIB   R13,{R0-R2}             ;Load other inforamtion
  57                 STR     R0,sail_env             ;Store environment handle
  58                 STR     R1,sail_global          ;Store ptr to global anchor
  59                 STR     R2,sail_preempt         ;Store the pre-empt time
  60
  61                 MOV     R1,#512                 ;Initial size of var stack
  62                 STR     R1,sail_varSize         ;Size of current stack
  63                 ADR     R0,sail_varTree         ;Point tothe anchor
  64                 BL      flex_alloc              ;Try to allocate it
  65                 BLCS    alloc_error             ;Get the error message
  66                 BCS     %99                     ;On error -- return
  67                 MOV     R14,#7*4                ;A nice NULL value
  68                 STR     R14,sail_varPtr         ;Nothing on the stack yet
  69                 LDR     R0,sail_varTree         ;Find block address
  70
  71                 MOV     R14,#0                  ;Zero out the tree roots
  72                 MOV     R1,#7                   ;Seven type trees to clear
  73 10              STR     R14,[R0],#4             ;Clear another one
  74                 SUBS    R1,R1,#1                ;Decrement the counter
  75                 BGT     %10                     ;And keep on going
  76
  77                 ADR     R0,sail_execStack       ;Point to the anchor
  78                 MOV     R1,#256                 ;Space for the execution st.
  79                 BL      flex_alloc              ;Try to allocate it
  80                 BVS     %98                     ;On error -- return
  81                 MOV     R1,#0                   ;Amount used so far
  82                 MOV     R2,#256                 ;Total size
  83                 ADR     R3,sail_execStack       ;Point to the stack data
  84                 STMIB   R3,{R1,R2}              ;Store the information
  85
  86                 ADR     R0,sail_opStack         ;Point to the anchor
  87                 MOV     R1,#256                 ;Space for the operators
  88                 BL      flex_alloc              ;Try to allocate it
  89                 BVS     %97                     ;On error -- return
  90                 MOV     R1,#0                   ;Amount used so far
  91                 MOV     R2,#256                 ;Total size
  92                 ADR     R3,sail_opStack         ;Point to the stack data
  93                 STMIB   R3,{R1,R2}              ;Store the information
  94
  95                 ADR     R0,sail_calcStack       ;Point to the anchor
  96                 MOV     R1,#256                 ;Space for the operands
  97                 BL      flex_alloc              ;Try to allocate it
  98                 BVS     %96                     ;On error -- return
  99                 MOV     R1,#0                   ;Amount used so far
 100                 MOV     R2,#256                 ;Total size
 101                 ADR     R3,sail_calcStack       ;Point to the stack data
 102                 STMIB   R3,{R1,R2}              ;Store the information
 103
 104                 ADR     R0,sail_stracc          ;POint tothe anchor
 105                 MOV     R1,#512                 ;Space for the operands
 106                 BL      flex_alloc              ;Try to allocate it
 107                 BVS     %95                     ;On error -- return
 108                 MOV     R1,#0                   ;Amount used so far
 109                 MOV     R2,#512                 ;Total size
 110                 ADR     R3,sail_stracc          ;Point to the stack data
 111                 STMIB   R3,{R1,R2}              ;Store the information
 112
 113                 BL      strBucket_init          ;Set up the string handling
 114
 115                 MOV     R14,#tscFlag_nl         ;Start with this flags word
 116                 STR     R14,sail_flags          ;Store the new flags
 117                 MOV     R14,#0                  ;A NULL word
 118                 STR     R14,sail_rmaList        ;No DIMed blocks yet
 119
 120                 ; --- Now tokenise the file ---
 121
 122                 LDR     R2,[R13,#0]             ;Load the flex address
 123                 MOV     R0,R1                   ;Put it in R0
 124                 BL      flex_size               ;Get the file size
 125                 ADD     R1,R0,#8                ;Put the size in R1
 126                 ADR     R0,sail_tokAnchor       ;Point to the anchor
 127                 BL      flex_alloc              ;Allocate a block
 128                 BLCS    alloc_error             ;Get the error message
 129                 BCS     %94                     ;No -- return an error
 130                 ADR     R0,sail_tokAnchor       ;Point to the anchor again
 131                 STR     R0,sail_currAnchor      ;This is current anchor
 132                 STR     R0,sail_oldAnchor       ;This is the `previous' one
 133
 134                 LDR     R0,[R2,#0]              ;POint to the text file
 135                 LDR     R2,sail_tokAnchor       ;Point to the output buffer
 136                 MOV     R3,#1                   ;Tokenise the whole file
 137                 BL      tokenise                ;Tokenise the file
 138                 BVS     %94                     ;Report possible error
 139
 140                 ; --- Zero-init the file array ---
 141
 142                 MOV     R14,#0                  ;Zero-init the array
 143                 MOV     R0,#8                   ;This many words to do
 144                 ADR     R1,sail_files           ;Point to the array
 145 00              STR     R14,[R1],#4             ;Store
 146                 SUBS    R0,R0,#1                ;Decrement the counter
 147                 BGT     %b00                    ;And loop
 148
 149                 ; --- Finish setting up, and return ---
 150
 151                 SWI     OS_ReadMonotonicTime    ;Read start time of program
 152                 STR     R0,sail_timeOff         ;This is initial time offset
 153                 MOV     R1,#0                   ;Clear top bit
 154                 ADR     R14,sail_rndSeed        ;Point to seed buffer
 155                 STMIA   R14,{R0,R1}             ;Save that away
 156
 157                 MOV     R14,#0                  ;Current data offset
 158                 STR     R14,sail_dataPtr        ;Store that
 159                 MOV     R14,#1                  ;Current data line
 160                 STR     R14,sail_dataLine       ;Store that too
 161                 BL      ctrl_findDATA           ;Set up the pointer
 162
 163                 MOV     R0,R12                  ;Return my block as handle
 164                 LDMFD   R13!,{R1-R4,R12,R14}    ;Unstack registers
 165                 BICS    PC,R14,#V_flag          ;And return without error
 166
 167                 ; --- An error occured ---
 168
 169 94              MOV     R4,R0
 170                 ADR     R0,sail_straccStack     ;Load the stack anchor
 171                 BL      flex_free               ;Free it
 172                 MOV     R0,R4
 173 95              MOV     R4,R0
 174                 ADR     R0,sail_calcStack       ;Load the stack anchor
 175                 BL      flex_free               ;Free it
 176                 MOV     R0,R4
 177 96              MOV     R4,R0
 178                 ADR     R0,sail_opStack         ;Load the stack anchor
 179                 BL      flex_free               ;Free it
 180                 MOV     R0,R4
 181 97              MOV     R4,R0
 182                 ADR     R0,sail_execStack       ;Load the stack anchor
 183                 BL      flex_free               ;Free it
 184                 MOV     R0,R4
 185 98              MOV     R4,R0
 186                 ADR     R0,sail_varTree         ;Load the stack anchor
 187                 BL      flex_free               ;Free it
 188                 MOV     R0,R4
 189 99              LDMFD   R13!,{R1-R4,R12,R14}    ;Unstack registers
 190                 ORRS    PC,R14,#V_flag          ;Return error to caller
 191
 192                 LTORG
 193
 194 ; --- sail_killScript ---
 195 ;
 196 ; On entry:     R0 == handle of the script
 197 ;
 198 ; On exit:      --
 199 ;
 200 ; Use:          Removes all the information associates with a given
 201 ;               script.
 202
 203                 EXPORT  sail_killScript
 204 sail_killScript ROUT
 205
 206                 STMFD   R13!,{{R0-R2,R12,R14}   ;Save some register
 207                 MOV     R12,R0                  ;Put block in R12
 208
 209                 ADR     R0,sail_rszBlocks       ;Find the resizing blocks
 210                 ADR     R1,sail_erszBlocks      ;Find the end of them
 211 00              BL      flex_free               ;Free this block
 212                 ADD     R0,R0,#12               ;Point to the next one
 213                 CMP     R0,R1                   ;Finished yet?
 214                 BCC     %b00                    ;No -- loop
 215
 216                 ; --- Now free DIMed RMA blocks ---
 217
 218                 MOV     R0,#7                   ;Free blocks
 219                 LDR     R2,sail_rmaList         ;Load the head of the list
 220                 CMP     R2,#0                   ;Is there one here?
 221 00              LDRNE   R3,[R2,#0]              ;Yes -- load the next link
 222                 SWINE   OS_Module               ;...free the block
 223                 MOVNE   R2,R3                   ;...put the next in R2
 224                 CMP     R2,#0                   ;Are there more to go?
 225                 BNE     %b00                    ;Yes -- do them then
 226
 227                 ; --- Close any open files ---
 228
 229                 MOV     R0,#0                   ;Close these files
 230                 MOV     R1,#0                   ;Start at file 1
 231                 ADR     R2,sail_files           ;Point to file array
 232 00              TST     R1,#&1F                 ;Start new word?
 233                 LDREQ   R3,[R2],#4              ;Yes -- load new one then
 234                 MOVS    R3,R3,LSL #1            ;Shift word up by one
 235                 SWICS   OS_Find                 ;If set, close the file
 236                 ADD     R1,R1,#1                ;Increment file handle
 237                 CMP     R1,#&100                ;Finished yet?
 238                 BCC     %b00                    ;No -- keep looping
 239
 240                 ; --- Free the tokenised file ---
 241
 242                 ADR     R0,sail_tokAnchor       ;Load anchor of tok'ed file
 243                 BL      flex_free               ;Free that block
 244
 245                 ; --- Free the anchor block ---
 246
 247                 MOV     R0,R12                  ;Point to the anchor blk
 248                 BL      free                    ;Free it nicely
 249                 LDMFD   R13!,{R0-R2,R12,PC}^    ;And return to caller
 250
 251                 LTORG
 252
 253 ; --- sail_error ---
 254 ;
 255 ; On entry:     R0 == pointer to error block
 256 ;
 257 ; On exit:      Doesn't, probably
 258 ;
 259 ; Use:          Returns an error to the caller.
 260
 261                 EXPORT  sail_error
 262 sail_error      ROUT
 263
 264                 ORRS    PC,R14,#V_flag          ;And return with V set
 265
 266                 LTORG
 267
 268 ; --- sail_goto ---
 269 ;
 270 ; On entry:     R0 == script handle
 271 ;               R1 == pointer to lable name, or 0 for start
 272 ;
 273 ; On exit:      R1 == 0 if finished, else more to go
 274 ;
 275 ; Use:          Starts executing the script from the given label.
 276
 277                 ; --- This routine is rather incomplete at the moment ---
 278
 279                 EXPORT  sail_goto
 280 sail_goto       ROUT
 281
 282                 STMFD   R13!,{R0,R2-R12,R14}    ;Stack registers
 283                 MOV     R12,R0                  ;Put anchor in R12
 284                 B       interp_start            ;Start execution
 285
 286                 LTORG
 287
 288 ; --- sail_continue ---
 289 ;
 290 ; On entry:     R0 == handle of the script
 291 ;
 292 ; On exit:      --
 293 ;
 294 ; Use:          Executes the script from where it left off.
 295
 296                 EXPORT  sail_continue
 297 sail_continue   ROUT
 298
 299                 STMFD   R13!,{R0,R2-R12,R14}    ;Stack registers
 300                 MOV     R12,R0                  ;Put anchor in R12
 301                 B       interp_resume           ;Start execution
 302
 303                 LTORG
 304
 305 ; --- sail_wait ---
 306 ;
 307 ; On entry:     --
 308 ;
 309 ; On exit:      R1 <> 0
 310 ;
 311 ; Use:          Returns to the caller indication that we have *not* yet
 312 ;               finished.
 313
 314                 EXPORT  sail_wait
 315 sail_wait       ROUT
 316
 317                 MOV     R1,#1                   ;More to go
 318                 LDMFD   R13!,{R0,R2-R12,R14}    ;Load back registers
 319                 BICS    PC,R14,#V_flag          ;Return happily
 320
 321                 LTORG
 322
 323 ; --- sail_return ---
 324 ;
 325 ; On entry:     --
 326 ;
 327 ; On exit:      --
 328 ;
 329 ; Use:          Returns to caller once the script has finished.
 330
 331                 EXPORT  sail_return
 332 sail_return     ROUT
 333
 334                 MOV     R1,#0                   ;No more to do
 335                 LDMFD   R13!,{R0,R2-R12,R14}    ;Load back registers
 336                 BICS    PC,R14,#V_flag          ;Return happily
 337
 338                 LTORG
 339
 340 ;----- That's all, folks ----------------------------------------------------
 341
 342                 END