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

   1 ;
   2 ; termScript.s
   3 ;
   4 ; Coroutine handling for Termite Script
   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                 GET     sh.anchor
  19                 GET     sh.ctrl
  20                 GET     sh.interp
  21                 GET     sh.mem
  22                 GET     sh.strBucket
  23                 GET     sh.termite
  24                 GET     sh.tree
  25                 GET     sh.tokenise
  26                 GET     sh.var
  27
  28 ;----- Code header ----------------------------------------------------------
  29
  30                 AREA    |!!!TermScript$$Header|,CODE,READONLY
  31
  32                 MOVS    PC,R14                  ;No initialisation reqd
  33                 MOVS    PC,R14                  ;No finalisation either
  34                 B       sail__create            ;Create a new script
  35                 B       sail__poll              ;Continue execution
  36                 B       termite_remoteInput     ;Some input's come for us
  37                 B       sail__stop              ;Stop executing now
  38                 MOVS    PC,R14                  ;Misc operation
  39                 B       sail_execEnd            ;End of an EXEC
  40                 B       sail_getLine            ;Get line number
  41
  42 ;----- Main code ------------------------------------------------------------
  43
  44                 AREA    |TermScript$$Code|,CODE,READONLY
  45
  46 ; --- sail__create ---
  47 ;
  48 ; On entry:     R2 == pointer to anchor for script file
  49 ;               R3 == length of script file
  50 ;               R4 == block with A% to H%
  51 ;
  52 ; On exit:      R0 == pointer to script handle (stack block)
  53 ;
  54 ; Use:          Sets up a new script session.
  55
  56 sail__create    ROUT
  57
  58                 STMFD   R13!,{R1-R4,R12,R14}    ;Save some registers
  59
  60                 ; --- Allocate an anchor/stack block ---
  61
  62                 MOV     R0,#6                   ;Allocate memory
  63                 MOV     R3,#sail_blkSize                ;Get the block's size
  64                 SWI     XOS_Module              ;Try to allocate the memory
  65                 BVS     %99sail__create         ;If it failed, return error
  66                 MOV     R12,R2                  ;Point to block in R12
  67
  68                 ; --- Set up the coroutine ready to start ---
  69
  70                 ADD     R4,R12,#sail_blkSize    ;Point to the very top
  71                 ADR     R3,sail__start          ;Install a `return address'
  72                 MOV     R1,R11                  ;Pass upcall block pointer
  73                 STMFD   R4!,{R3}                ;Save `R11', `R12' and `R14'
  74                 SUB     R4,R4,#40               ;Leave `R1'-`R10' blank
  75                 STR     R4,sail_R13             ;Save the initial stack ptr
  76
  77                 ; --- Fill in the rest of the block ---
  78
  79                 LDMIB   R13,{R0,R1}             ;Load the anchor and length
  80                 STMIB   R12,{R0,R1}             ;Save them in my block
  81
  82                 MOV     R0,#512                 ;Initial size of var stack
  83                 STR     R0,sail_varSize         ;Size of current stack
  84                 BL      mem_alloc               ;Try to allocate it
  85                 BVS     %99sail__create         ;On error -- return
  86                 STR     R0,sail_varTree         ;Store this anchor pointer
  87                 MOV     R14,#7*4                ;A nice NULL value
  88                 STR     R14,sail_varPtr         ;Nothing on the stack yet
  89                 LDR     R0,[R0]                 ;Find block address
  90
  91                 MOV     R14,#0                  ;Zero out the tree roots
  92                 MOV     R1,#7                   ;Seven type trees to clear
  93 10sail__create  STR     R14,[R0],#4             ;Clear another one
  94                 SUBS    R1,R1,#1                ;Decrement the counter
  95                 BGT     %10sail__create         ;And keep on going
  96
  97                 MOV     R0,#256                 ;Space for the execution st.
  98                 BL      mem_alloc               ;Try to allocate it
  99                 BVS     %98sail__create         ;On error -- return
 100                 MOV     R1,#0                   ;Amount used so far
 101                 MOV     R2,#256                 ;Total size
 102                 ADR     R3,sail_execStack       ;Point to the stack data
 103                 STMIA   R3,{R0-R2}              ;Store the information
 104
 105                 MOV     R0,#256                 ;Space for the operators
 106                 BL      mem_alloc               ;Try to allocate it
 107                 BVS     %98sail__create         ;On error -- return
 108                 MOV     R1,#0                   ;Amount used so far
 109                 MOV     R2,#256                 ;Total size
 110                 ADR     R3,sail_opStack         ;Point to the stack data
 111                 STMIA   R3,{R0-R2}              ;Store the information
 112
 113                 MOV     R0,#256                 ;Space for the operands
 114                 BL      mem_alloc               ;Try to allocate it
 115                 BVS     %98sail__create         ;On error -- return
 116                 MOV     R1,#0                   ;Amount used so far
 117                 MOV     R2,#256                 ;Total size
 118                 ADR     R3,sail_calcStack       ;Point to the stack data
 119                 STMIA   R3,{R0-R2}              ;Store the information
 120
 121                 MOV     R0,#512                 ;Space for the operands
 122                 BL      mem_alloc               ;Try to allocate it
 123                 BVS     %98sail__create         ;On error -- return
 124                 MOV     R1,#0                   ;Amount used so far
 125                 MOV     R2,#512                 ;Total size
 126                 ADR     R3,sail_stracc          ;Point to the stack data
 127                 STMIA   R3,{R0-R2}              ;Store the information
 128
 129                 BL      strBucket_init          ;Set up the string handling
 130
 131                 MOV     R14,#tscFlag_nl+tscFlag_echoLR+tscFlag_echoRL
 132                 STR     R14,sail_flags          ;Store the new flags
 133                 MOV     R14,#0                  ;A NULL word
 134                 STR     R14,sail_rmaList                ;No DIMed blocks yet
 135                 STR     R14,sail_wForState      ;State of WATCHFOR
 136                 STR     R14,sail_wForNumber     ;No strings being watched for
 137                 STR     R14,sail_spool          ;No SPOOL handle
 138
 139                 ; --- Now tokenise the file ---
 140
 141                 LDR     R0,sail_scSize          ;Load the script size
 142                 ADD     R0,R0,#8                ;Put the size in R0
 143                 BL      mem_alloc               ;Allocate a block
 144                 BVS     %98sail__create         ;No -- return an error
 145                 STR     R0,sail_tokAnchor       ;Store this anchor pointer
 146                 STR     R0,sail_currAnchor      ;This is current anchor
 147                 STR     R0,sail_oldAnchor       ;This is the `previous' one
 148
 149                 LDR     R2,[R0,#0]              ;Get angry with WimpExt_Heap
 150                 ADR     R14,sail_anchor         ;Find untokenised script
 151                 LDMIA   R14,{R0,R1}             ;Load them out
 152                 LDR     R0,[R0,#0]              ;Grrrr...
 153                 MOV     R3,#1                   ;Tokenise the whole file
 154                 BL      tokenise                ;Tokenise the file
 155
 156         [ 1=0
 157                 STMFD   R13!,{R0-R5}
 158                 MOV     R0,#10
 159                 ADR     R1,name
 160                 LDR     r2,=&FFF
 161                 LDR     R4,sail_tokAnchor
 162                 LDR     R4,[R4]
 163                 LDR     R5,sail_scSize
 164                 ADD     R5,R4,R5
 165                 SWI     OS_File
 166                 LDMFD   R13!,{R0-R5}
 167         ]
 168
 169                 ; --- Zero-init the file array ---
 170
 171                 MOV     R14,#0                  ;Zero-init the array
 172                 MOV     R0,#8                   ;This many words to do
 173                 ADR     R1,sail_files           ;Point to the array
 174 00              STR     R14,[R1],#4             ;Store
 175                 SUBS    R0,R0,#1                ;Decrement the counter
 176                 BGT     %b00                    ;And loop
 177
 178                 ; --- Finsh setting up, and return ---
 179
 180                 SWI     OS_ReadMonotonicTime    ;Read start time of program
 181                 STR     R0,sail_timeOff         ;This is initial time offset
 182                 MOV     R1,#0                   ;Clear top bit
 183                 ADR     R14,sail_rndSeed                ;Point to seed buffer
 184                 STMIA   R14,{R0,R1}             ;Save that away
 185
 186                 STR     R1,sail_errorS          ;ERROR$=""
 187
 188                 MOV     R0,#2                   ;We want a string this big
 189                 BL      strBucket_alloc         ;Get it then
 190                 MOV     R14,#13                 ;Get char 13
 191                 STRB    R14,[R0],#1             ;Put in the string
 192                 MOV     R14,#10                 ;Get char 10
 193                 STRB    R14,[R0],#1             ;Put in the string
 194                 STR     R1,sail_lnewline                ;Store the offset away
 195
 196                 MOV     R0,#1                   ;We want a string this big
 197                 BL      strBucket_alloc         ;Get it then
 198                 MOV     R14,#13                 ;Get char 13
 199                 STRB    R14,[R0],#1             ;Put in the string
 200                 STR     R1,sail_rnewline                ;Store the offset away
 201
 202                 MOV     R14,#0                  ;Current data offset
 203                 STR     R14,sail_dataPtr                ;Store that
 204                 MOV     R14,#1                  ;Current data line
 205                 STR     R14,sail_dataLine       ;Store that too
 206                 BL      ctrl_findDATA           ;Set up the pointer
 207
 208                 ; --- Copy over the A%-H% values ---
 209
 210                 ADR     R1,sail__varNames       ;Point to the names
 211                 MOV     R4,#8                   ;Number of vars to transfer
 212                 LDR     R2,[R13,#12]            ;Load te block ptr
 213 00              MOV     R0,#vType_integer       ;It's an integer
 214                 BL      var_create              ;Try to create it
 215                 LDR     R14,[R2],#4             ;Load the value to transfer
 216                 STR     R14,[R0,#4]             ;Store the value
 217                 ADD     R1,R1,#3                ;Point to the next name
 218                 SUBS    R4,R4,#1                ;Reduce the count
 219                 BGT     %00                     ;And keep on looking
 220
 221                 MOV     R0,R12                  ;Return my block as handle
 222                 LDMFD   R13!,{R1-R4,R12,R14}    ;Unstack registers
 223                 BICS    PC,R14,#V_flag          ;And return without error
 224
 225                 ; --- An error occured ---
 226
 227 98sail__create  MOV     R4,R0
 228                 LDR     R0,sail_varTree         ;Load the stack anchor
 229                 BL      mem_free                ;Free it
 230                 MOV     R0,R4
 231 99sail__create  LDMFD   R13!,{R1-R4,R12,R14}    ;Unstack registers
 232                 ORRS    PC,R14,#V_flag          ;Return error to caller
 233
 234 sail__varNames  DCB     "A%",0,"B%",0,"C%",0,"D%",0
 235                 DCB     "E%",0,"F%",0,"G%",0,"H%",0
 236
 237                 LTORG
 238
 239 ; --- sail__start ---
 240 ;
 241 ; On entry:     R11 == pointer to upcall block
 242 ;               R12 == pointer to anchor block
 243 ;
 244 ; On exit:      via interpreter
 245 ;
 246 ; Use:          Starts the interpreter coroutine.
 247
 248 sail__start     ROUT
 249
 250                 BL      interp_start            ;Start the interpreter
 251                 MOV     R0,#0                   ;Terminate the script
 252                 B       sail_end                        ;By calling the closedown rtn
 253
 254                 LTORG
 255
 256 ; --- sail__stop ---
 257 ;
 258 ; On entry:     R0 == pointer to script anchor
 259 ;
 260 ; On exit:      --
 261 ;
 262 ; Use:          Stops a script from going.
 263
 264 sail__stop      ROUT
 265
 266                 STMFD   R13!,{R0-R2,R12,R14}    ;Save some registers
 267                 MOV     R12,R0                  ;Put block in R12
 268
 269                 ADR     R1,sail_rszBlocks       ;Find the resizing blocks
 270                 ADR     R2,sail_erszBlocks      ;Find the end of them
 271 10sail__stop    LDR     R0,[R1],#12             ;Load the anchor
 272                 BL      mem_free                ;Free this block
 273                 CMP     R1,R2                   ;Finished yet?
 274                 BCC     %10sail__stop           ;No -- loop
 275
 276                 ; --- Now free DIMed RMA blocks ---
 277
 278                 MOV     R0,#7                   ;Free blocks
 279                 LDR     R2,sail_rmaList         ;Load the head of the list
 280                 CMP     R2,#0                   ;Is there one here?
 281 00              LDRNE   R3,[R2,#0]              ;Yes -- load the next link
 282                 SWINE   OS_Module               ;...free the block
 283                 MOVNE   R2,R3                   ;...put the next in R2
 284                 CMP     R2,#0                   ;Are there more to go?
 285                 BNE     %b00                    ;Yes -- do them then
 286
 287                 ; --- Close any open files ---
 288
 289                 MOV     R0,#0                   ;Close these files
 290                 MOV     R1,#0                   ;Start at file 1
 291                 ADR     R2,sail_files           ;Point to file array
 292 00              TST     R1,#&1F                 ;Start new word?
 293                 LDREQ   R3,[R2],#4              ;Yes -- load new one then
 294                 MOVS    R3,R3,LSL #1            ;Shift word up by one
 295                 SWICS   OS_Find                 ;If set, close the file
 296                 ADD     R1,R1,#1                ;Increment file handle
 297                 CMP     R1,#&100                ;Finished yet?
 298                 BCC     %b00                    ;No -- keep looping
 299
 300                 ; --- Close the SPOOL file ---
 301
 302                 LDR     R1,sail_spool           ;Load the current handle
 303                 CMP     R1,#0                   ;Are we spooling?
 304                 MOVNE   R0,#0                   ;Yes -- close current file
 305                 SWINE   XOS_Find                ;So do that then
 306
 307                 ; --- Free the tokenised file ---
 308
 309                 LDR     R0,sail_tokAnchor       ;Load anchor of tok'ed file
 310                 BL      mem_free                ;Free that block
 311
 312                 ; --- Free the anchor block ---
 313
 314                 MOV     R2,R12                  ;Point to the anchor blk
 315                 MOV     R0,#7                   ;Free the anchor
 316                 SWI     XOS_Module              ;Do that then
 317                 LDMFD   R13!,{R0-R2,R12,PC}^    ;And return to caller
 318
 319                 LTORG
 320
 321 ; --- sail__poll ---
 322 ;
 323 ; On entry:     R0 == address of anchor block
 324 ;
 325 ; On exit:      R0 == event code
 326 ;
 327 ; Use:          Continues running the script for a while.
 328
 329 sail__poll      ROUT
 330
 331                 STMFD   R13!,{R12,R14}          ;Save some registers
 332                 MOV     R12,R0                  ;Put anchor block ptr away
 333                 BL      sail__resume            ;Switch to other coroutine
 334                 LDMFD   R13!,{R12,R14}          ;Restore registers
 335                 ORRVSS  PC,R14,#V_flag          ;If error, return that
 336                 BICVCS  PC,R14,#V_flag          ;Else return no error
 337
 338                 LTORG
 339
 340 ; --- sail__resume ---
 341 ;
 342 ; On entry:     R0 == event code to pass to interpreter
 343 ;               R1,R2 == other arguments to pass
 344 ;
 345 ; On exit:      R0, R1 == return values (passed to sail_wait)
 346 ;
 347 ; Use:          Resumes the interpreter, giving it an event.
 348
 349 sail__resume    ROUT
 350
 351                 STMFD   R13!,{R3-R12,R14}       ;Save main corout context
 352                 LDR     R14,sail_R13            ;Load interpreter's R13
 353                 STR     R13,sail_R13            ;Save our R13 away for a bit
 354                 MOV     R13,R14                 ;Switch to interpreter
 355                 LDMFD   R13!,{R1-R10,R14}       ;Restore interp registers
 356                 LDR     R0,sail_currAnchor      ;Load the token anchor
 357                 LDR     R0,[R0]                 ;Thump thump thump
 358                 ADD     R10,R0,R10              ;Turn offset into address
 359                 MOVS    PC,R14                  ;Return to caller
 360
 361                 LTORG
 362
 363 ; --- sail_wait ---
 364 ;
 365 ; On entry:     --
 366 ;
 367 ; On exit:      R0, R1, R2 == event and arguments from Termite
 368 ;
 369 ; Use:          Waits for some multitasking and gets something from Termite.
 370
 371                 EXPORT  sail_wait
 372 sail_wait       ROUT
 373
 374                 LDR     R0,sail_currAnchor      ;Find tokenised file anchor
 375                 LDR     R0,[R0]                 ;Grrrrrrrr
 376                 SUB     R10,R10,R0              ;Turn this into an offset
 377                 STMFD   R13!,{R1-R10,R14}       ;Save interpreter's context
 378                 LDR     R14,sail_R13            ;Load main routine's R13
 379                 STR     R13,sail_R13            ;Save our R13 away for a bit
 380                 MOV     R13,R14                 ;Switch back to main routine
 381                 MOV     R0,#0                   ;Just continue for a while
 382                 LDMFD   R13!,{R3-R12,R14}       ;Restore Termite's regs
 383                 BICS    PC,R14,#V_flag          ;And return with no error
 384
 385                 LTORG
 386
 387 ; --- sail_end ---
 388 ;
 389 ; On entry:     R0 == pointer to script to chain (bit 30 set for exec),
 390 ;                     0 to just end, or -1 to CLOSE
 391 ;
 392 ; On exit:      Doesn't, hopefully (except for exec?)
 393 ;
 394 ; Use:          Ends the script, optionally starting up another one.
 395
 396                 EXPORT  sail_end
 397 sail_end                ROUT
 398
 399                 STMFD   R13!,{R1-R10,R14}       ;Save interpreter's context
 400                 LDR     R14,sail_currAnchor     ;Find tokenised file anchor
 401                 LDR     R14,[R14]               ;Grrrrrrrr
 402                 SUB     R10,R10,R14             ;Turn this into an offset
 403                 STR     R10,[R13,#36]           ;Store R10 value
 404                 LDR     R14,sail_R13            ;Load main routine's R13
 405                 STR     R13,sail_R13            ;Save our R13 away (useless)
 406                 MOV     R13,R14                 ;Switch back to main routine
 407
 408                 MOV     R5,R0                   ;Look after the return type
 409
 410                 ; --- Copy across A% to H% ---
 411
 412                 ADR     R2,sail_misc            ;Point to a misc block
 413                 ADRL    R1,sail__varNames       ;Point to the names
 414                 MOV     R4,#8                   ;Number of vars to transfer
 415 00              MOV     R0,#vType_integer       ;It's an integer
 416                 BL      tree_find               ;Try to find it
 417                 MOVCC   R14,#0                  ;Not there -- use 0
 418                 LDRCS   R14,[R0,#4]             ;Otherwise load value
 419                 STR     R14,[R2],#4             ;Store the value
 420                 ADD     R1,R1,#3                ;Point tot he next name
 421                 SUBS    R4,R4,#1                ;Reduce the count
 422                 BGT     %00                     ;And keep on looking
 423                 ADR     R2,sail_misc            ;Point to the block again
 424                 MOV     R0,R5                   ;Put return type in R0
 425                 MOV     R1,R6                   ;And file name in R1
 426
 427                 ; --- Now return appropriately ---
 428
 429                 MOV     R1,R5                   ;Get the string in R1
 430                 CMP     R1,#0                   ;Is it >0?
 431                 BLE     %10sail_end             ;Nope -- jump ahead
 432
 433                 TST     R1,#(1<<30)             ;Are we EXECing?
 434                 MOVEQ   R0,#2                   ;If chaining, return 2
 435                 MOVNE   R0,#3                   ;Otherwise return 3
 436                 BIC     R1,R1,#(1<<30)          ;Clear bit 30
 437
 438                 B       %90sail_end             ;Just return now
 439
 440 10sail_end      MOVEQ   R0,#1                   ;Else just end the script
 441                 MOVLT   R0,#4                   ;Or maybe finish, even
 442 90sail_end      LDMFD   R13!,{R3-R12,R14}       ;Restore Termite's regs
 443                 BICS    PC,R14,#V_flag          ;And return with no error
 444
 445                 LTORG
 446
 447 ; --- sail_error ---
 448 ;
 449 ; On entry:     R0 == pointer to error block
 450 ;
 451 ; On exit:      Doesn't, probably
 452 ;
 453 ; Use:          Returns an error to Termite.
 454
 455                 EXPORT  sail_error
 456 sail_error      ROUT
 457
 458                 STMFD   R13!,{R1-R10,R14}       ;Save interpreter's context
 459                 LDR     R14,sail_R13            ;Load main routine's R13
 460                 STR     R13,sail_R13            ;Save our R13 away (useless)
 461                 MOV     R13,R14                 ;Switch back to main routine
 462                 LDMFD   R13!,{R3-R12,R14}       ;Restore Termite's registers
 463                 ORRS    PC,R14,#V_flag          ;And return with V set
 464
 465                 LTORG
 466
 467 ; --- sail_execEnd ---
 468 ;
 469 ; On entry:     R0 == parent handle
 470 ;               R4 == 8 word block of A%-H%
 471 ;               R11 == upcall block
 472 ;
 473 ; On exit:      --
 474 ;
 475 ; Use:          Update the parents A%-H%
 476
 477 sail_execEnd    ROUT
 478
 479                 STMFD   R13!,{R0-R4,R12,R14}    ;Stack registers
 480                 MOV     R12,R0                  ;Put anchor in R12
 481                 ADRL    R1,sail__varNames       ;Point to the names
 482                 MOV     R2,#8                   ;Number of vars to transfer
 483 00              MOV     R0,#vType_integer       ;It's an integer
 484                 BL      var_find                ;Try to create it
 485                 LDR     R14,[R4],#4             ;Load the value to transfer
 486                 STR     R14,[R0,#4]             ;Store the value
 487                 ADD     R1,R1,#3                ;Point to the next name
 488                 SUBS    R2,R2,#1                ;Reduce the count
 489                 BGT     %00                     ;And keep on looking
 490
 491                 LDMFD   R13!,{R0-R4,R12,PC}^    ;Return to caller
 492
 493                 LTORG
 494
 495 ; --- sail_getLine ---
 496 ;
 497 ; On entry:     R0 == handle
 498 ;
 499 ; On exit:      R0 == current line number
 500 ;
 501 ; Use:          Returns the current line number
 502
 503 sail_getLine    ROUT
 504
 505                 LDR     R0,[R0,#:INDEX:sail_line]
 506                 MOVS    PC,R14
 507
 508                 LTORG
 509
 510 ;----- That's all, folks ----------------------------------------------------
 511
 512                 END