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

   1 ;
   2 ; kernel.s
   3 ;
   4 ; Sapphire library kernel
   5 ;
   6 ; © 1994-1998 Straylight
   7 ;
   8
   9 ;----- Licensing note -------------------------------------------------------
  10 ;
  11 ; This file is part of Straylight's Sapphire library.
  12 ;
  13 ; Sapphire 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 ; Sapphire 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 Sapphire.  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                 [       :LNOT::DEF: sapphire__dynaLink
  37
  38                 IMPORT  |Image$$RW$$Base|,WEAK
  39                 IMPORT  |Image$$RW$$Limit|,WEAK
  40                 IMPORT  |Sapphire$$ClientData$$Base|,WEAK
  41                 IMPORT  |Sapphire$$ClientData$$Limit|,WEAK
  42                 IMPORT  |Sapphire$$ExtTable$$Base|,WEAK
  43                 IMPORT  |Sapphire$$ExtTable$$Limit|,WEAK
  44
  45                 ]
  46
  47                 IMPORT  |Sapphire$$LibData$$Base|,WEAK
  48                 IMPORT  |Sapphire$$LibData$$Limit|,WEAK
  49
  50 ;----- Main code ------------------------------------------------------------
  51
  52                 AREA    |Sapphire$$Code|,CODE,READONLY
  53
  54                 [       :LNOT::DEF: sapphire__dynaLink
  55
  56 ; --- sapphire_init ---
  57 ;
  58 ; On entry:     R0 == pointer to application name
  59 ;               R1 == application's workspace size
  60 ;               R2 == size of stack required
  61 ;
  62 ; On exit:      R10 == pointer to heap base
  63 ;               R11 == pointer to ScratchPad
  64 ;               R12 == pointer to application workspace
  65 ;               R13 == pointer to full descending stack
  66 ;               Other registers are corrupted
  67 ;
  68 ; Use:          Initialises the Sapphire kernel, sets up the memory map,
  69 ;               and allocates workspace for library and client units.  The
  70 ;               initialisation performed is fairly minimal; in particular,
  71 ;               the library units are not initialised -- you must call
  72 ;               sapphire_libInit for this to take place.  This allows you
  73 ;               to check command line arguments etc. before initialising
  74 ;               the Wimp.
  75
  76                 EXPORT  sapphire_init
  77 sapphire_init   ROUT
  78
  79                 ADR     R3,sapph__initTable     ;Point to initialisation tbl
  80                 B       sapphire_doInit         ;Do main initialisation
  81
  82                 LTORG
  83
  84 ; --- sapphire_libInit ---
  85 ;
  86 ; On entry:     --
  87 ;
  88 ; On exit:      --
  89 ;
  90 ; Use:          Initialises the Sapphire library and client units.
  91
  92                 EXPORT  sapphire_libInit
  93 sapphire_libInit ROUT
  94
  95                 STMFD   R13!,{R0,R14}           ;Save some registers
  96                 ADR     R0,sapph__initTable     ;Point to initialisation tbl
  97                 BL      sapphire_doLibInit      ;Do library initialisation
  98                 LDMFD   R13!,{R0,PC}^           ;Return to caller
  99
 100                 LTORG
 101
 102 ; --- sapphire_disable ---
 103 ;
 104 ; On entry:     R0 == pointer to 0-terminated list of initialise routines
 105 ;
 106 ; On exit:      --
 107 ;
 108 ; Use:          Prevents the given initialisation routines from being called.
 109 ;               This is mainly useful in the dynamic-linking environment,
 110 ;               where all Sapphire units are normally active.  This routine
 111 ;               allows you to inactivate units which for example do not
 112 ;               have the resources they require, or use up unnecesary
 113 ;               memory.
 114
 115                 EXPORT  sapphire_disable
 116 sapphire_disable ROUT
 117
 118                 STMFD   R13!,{R1,R14}           ;Save some registers
 119                 ADR     R1,sapph__initTable     ;Point to initialisation tbl
 120                 BL      sapphire_doDisable      ;Do the disabling bits
 121                 LDMFD   R13!,{R1,PC}^           ;Return to caller
 122
 123                 LTORG
 124
 125 sapph__initTable
 126
 127                 DCD     |Image$$RW$$Limit|
 128                 DCD     |Sapphire$$ClientData$$Base|
 129                 DCD     |Sapphire$$ClientData$$Limit|
 130                 DCD     -1
 131                 DCD     |Sapphire$$ExtTable$$Base|
 132                 DCD     |Sapphire$$ExtTable$$Limit|
 133
 134                 ]
 135
 136 ; --- sapphire_doInit ---
 137 ;
 138 ; On entry:     R0 == pointer to application name
 139 ;               R1 == client workspace size
 140 ;               R2 == requested stack size
 141 ;               R3 == pointer to initialisation table
 142 ;
 143 ; On exit:      R10 == base address of Sapphire heap
 144 ;               R11 == pointer to scratchpad and global data
 145 ;               R12 == pointer to client global workspace
 146 ;               R13 == pointer to a full descendion stack
 147 ;
 148 ; Use:          Performs initialisation of the Sapphire library and the
 149 ;               client's sections.  This is intended for use by the Sapphire
 150 ;               stub, while initialising the dynamically linked version of
 151 ;               Sapphire.
 152
 153                 EXPORT  sapphire_doInit
 154 sapphire_doInit ROUT
 155
 156                 ; --- Stash arguments in high registers ---
 157
 158                 MOV     R6,R0                   ;Pointer to application name
 159                 MOV     R5,R1                   ;Client's workspace size
 160                 MOV     R7,R2                   ;Client's stack size
 161                 MOV     R8,R3                   ;Pointer to intialise table
 162
 163                 ; --- Find the top of our memory area ---
 164
 165                 SWI     OS_GetEnv               ;Find the memory limit
 166                 MOV     R13,R1                  ;This will do as a stack
 167                 LDR     R12,[R8],#4             ;Load the application end
 168
 169                 ; --- Set up workspace allocation registers ---
 170
 171                 ADD     R9,R12,#sapph__wSize    ;Allocate my workspace
 172                 ADD     R7,R7,#3                ;Make sure stack size...
 173                 BIC     R7,R7,#3                ;... is word aligned
 174                 CMP     R7,#sapph__minStack     ;Is his stack big enough?
 175                 SUBCC   R10,R13,#sapph__minStack ;No -- allocate it big
 176                 SUBCS   R10,R13,R7              ;Yes -- allocate his amount
 177
 178                 CMP     R9,R10                  ;Do we have enough memory?
 179                 BCS     %90sapphire_doInit      ;No -- complain then
 180
 181                 ; --- Now find out how much we need ---
 182
 183                 STMFD   R13!,{R5,R6,R14}        ;Save some registers
 184                 ADD     R5,R5,#3                ;Amount of workspace required
 185                 BIC     R5,R5,#3                ;Make sure it's aligned
 186                 MOV     R6,#20                  ;Space below R11 used so far
 187                 MOV     R7,#256                 ;Force scratchpad to 256
 188
 189                 ADR     R4,sapph__ownTable      ;Point to the internal table
 190                 LDMIA   R4,{R0,R1}              ;Load the base and limit
 191                 BL      sapph__readSize         ;Work out sizes here
 192
 193                 MOV     R4,R8                   ;Point to init table
 194 00              LDMIA   R4!,{R0,R1}             ;Load the base and limit
 195                 CMP     R0,#-1                  ;Is it the end of the table?
 196                 BLNE    sapph__readSize         ;No -- work out the sizes
 197                 BNE     %00sapphire_doInit      ;And go back for more
 198
 199                 SUB     R4,R4,#4                ;We went a little too far
 200                 LDMIA   R4,{R3,R4}              ;Load these values out
 201 05              CMP     R3,R4                   ;Reached the end yet?
 202                 BCS     %09sapphire_doInit      ;Yes -- skip onwards
 203                 MOV     R14,PC                  ;Set up return address
 204                 LDR     PC,[R3],#4              ;Get next return address
 205                 CMP     R2,R6                   ;Need more space below R11?
 206                 MOVHI   R6,R2                   ;Yes -- then increase size
 207                 BL      sapph__readSize         ;Work out the sizes here
 208                 B       %05sapphire_doInit      ;And go back for more
 209
 210                 ; --- Make initial allocations ---
 211
 212 09              SUB     R11,R10,R7              ;Allocate the scratchpad
 213                 SUB     R10,R11,R6              ;And allocate workspace ptrs
 214
 215                 ADD     R1,R9,R5                ;Add on workspace reqments
 216                 SUBS    R3,R10,R1               ;Do we have enough memory?
 217                 BCC     %90sapphire_doInit      ;No -- make an error then
 218
 219                 ; --- Set up initial contents of magic area ---
 220
 221                 LDR     R0,[R13,#4]             ;Load application name ptr
 222                 ADD     R7,R13,#12              ;Find stack base address
 223                 STMDB   R11,{R0,R1,R7,R9}       ;Save values in the area
 224
 225                 ; --- Initialise the heap ---
 226
 227                 MOV     R0,#0                   ;Initialise a heap area
 228                 SWI     OS_Heap                 ;Set it up then
 229
 230                 ; --- Set up kernel workspace ---
 231
 232                 MOV     R0,#0                   ;No global areas allocated
 233                 STR     R0,sapph__globCnt       ;So clear the counter value
 234
 235                 ; --- Now start setting up workspace ---
 236
 237                 MOV     R7,#0                   ;Current workspace offset
 238                 MOV     R2,#4                   ;Current R11 negative offset
 239
 240                 ADR     R6,sapph__ownTable      ;Point to internal table
 241                 LDMIA   R6,{R0,R1}              ;Load the base and limit
 242                 BL      sapph__setWSpace        ;Set up the workspace for it
 243
 244 10              LDMIA   R8!,{R0,R1}             ;Load the base and limit
 245                 CMP     R0,#-1                  ;Is this the end yet?
 246                 BLNE    sapph__setWSpace        ;No -- set up workspace
 247                 BNE     %10sapphire_doInit      ;And go back round again
 248
 249                 ; --- Allocate the client's workspace ---
 250
 251                 ADD     R9,R9,R7                ;Find current workspace pos
 252                 LDMIA   R13!,{R5,R6}            ;Load workspace size back
 253                 STR     R9,sapph_clientWS       ;Save client workspace ptr
 254                 ADD     R9,R9,R5                ;Move past client work size
 255                 MOV     R7,#0                   ;Clear offset now
 256
 257                 ; --- Now allocate workspace for extensions ---
 258
 259                 SUB     R8,R8,#4                ;We overshot at the end
 260                 LDMIA   R8,{R5,R6}              ;Load the values out
 261 15              CMP     R5,R6                   ;Have we finished yet?
 262                 BCS     %19sapphire_doInit      ;Yes -- skip out then
 263                 MOV     R14,PC                  ;Set up return address
 264                 LDR     PC,[R5],#4              ;Call the routine
 265                 ADD     R9,R9,R7                ;Get updated workspace offset
 266                 STR     R9,[R11,-R2]            ;Save in magic place
 267                 MOV     R7,#0                   ;No offset set up yet
 268                 BL      sapph__setWSpace        ;Set up its workspace
 269                 B       %15sapphire_doInit      ;And go back round again
 270
 271                 ; --- That's it -- we're done ---
 272
 273 19              LDR     R12,sapph_clientWS      ;Load client's workspace
 274                 LDR     R10,sapph_heapBase      ;Load the heap base too
 275                 LDMFD   R13!,{PC}^              ;Return to caller
 276
 277                 ; --- Not enough memory to start up ---
 278
 279 90              ADR     R0,sapph__noMem         ;Point to the error message
 280                 SWI     OS_GenerateError        ;Generate the error
 281
 282 sapph__ownTable DCD     |Sapphire$$LibData$$Base|
 283                 DCD     |Sapphire$$LibData$$Limit|
 284
 285 sapph__noMem    DCD     0
 286                 DCB     "Not enough memory to initialise",0
 287
 288                 LTORG
 289
 290 ; --- sapph__readSize ---
 291 ;
 292 ; On entry:     R0 == base of initialisation block
 293 ;               R1 == limit of initialisation block
 294 ;               R5 == amount of workspace required so far
 295 ;               R7 == required size of scratchpad
 296 ;
 297 ; On exit:      R5, R7 updated as necessary
 298 ;
 299 ; Use:          Adjusts workspace parameters given an initialisation block.
 300
 301 sapph__readSize ROUT
 302
 303                 STMFD   R13!,{R0-R4,R14}        ;Save some registers
 304 00              CMP     R0,R1                   ;Have we finished yet?
 305                 LDMCSFD R13!,{R0-R4,PC}^        ;Yes -- then return
 306                 LDMIA   R0!,{R2-R4,R14}         ;Load values from block
 307                 ADD     R2,R2,#3                ;Make sure workspace is...
 308                 BIC     R2,R2,#3                ;... word aligned
 309                 ADD     R5,R5,R2                ;Incrment offset nicely
 310                 CMP     R4,R7                   ;Is scratchpad big enough?
 311                 MOVHI   R7,R4                   ;No -- make it bigger then
 312                 B       %00sapph__readSize      ;And go back for the rest
 313
 314                 LTORG
 315
 316 ; --- sapph__setWSpace ---
 317 ;
 318 ; On entry:     R0 == base of initialisation block
 319 ;               R1 == limit of initialisation block
 320 ;               R7 == current workspace offset
 321 ;               R9 == workspace chunk base address
 322 ;
 323 ; On exit:      R7 updated
 324 ;
 325 ; Use:          Lays out workspace and sets up workspace offsets.
 326
 327 sapph__setWSpace ROUT
 328
 329                 STMFD   R13!,{R0-R4,R14}        ;Save some registers
 330 00              CMP     R0,R1                   ;Have we finished yet?
 331                 LDMCSFD R13!,{R0-R4,PC}^        ;Yes -- then return
 332                 LDMIA   R0!,{R2-R4,R14}         ;Load values from block
 333                 ADD     R2,R2,#3                ;Make sure workspace is...
 334                 BICS    R2,R2,#3                ;... word aligned
 335                 STRNE   R7,[R3,#0]              ;If any wanted, save offset
 336                 MOVNE   R14,#0                  ;Zero the first word
 337                 STRNE   R14,[R7,R9]             ;Save that in there
 338                 ADD     R7,R7,R2                ;And move pointer on
 339                 B       %00sapph__setWSpace     ;And keep on going round
 340
 341                 LTORG
 342
 343 ; --- sapphire_doLibInit ---
 344 ;
 345 ; On entry:     R0 == address of library initialisation table
 346 ;
 347 ; On exit:      --
 348 ;
 349 ; Use:          Initialises all currently uninitialised library units.
 350
 351                 EXPORT  sapphire_doLibInit
 352 sapphire_doLibInit ROUT
 353
 354                 STMFD   R13!,{R0-R4,R14}        ;Save some registers
 355                 ADD     R4,R0,#4                ;Look after this pointer
 356
 357                 ADR     R0,sapph__ownTable      ;Point to our own init table
 358                 LDMIA   R0,{R0,R1}              ;Load base and limit
 359                 LDR     R2,sapph_workspace      ;Load workspace base address
 360                 BL      sapph__init             ;Initialise from block
 361
 362 00              LDMIA   R4!,{R0,R1}             ;Load values from the block
 363                 CMP     R0,#-1                  ;Have we reached the end yet?
 364                 BLNE    sapph__init             ;No -- do more initialising
 365                 BNE     %00sapphire_doLibInit   ;And go round again
 366
 367                 SUB     R4,R4,#4                ;We overshot a bit
 368                 LDMIA   R4,{R3,R4}              ;Load extension table values
 369 05              CMP     R3,R4                   ;Have we finished yet?
 370                 BCS     %09sapphire_doLibInit   ;Yes -- skip out then
 371                 MOV     R14,PC                  ;Set up return address
 372                 LDR     PC,[R3],#4              ;Call finding routine
 373                 LDR     R2,[R11,-R2]            ;Load workspace base address
 374                 BL      sapph__init             ;Do more initialising
 375                 B       %05sapphire_doLibInit   ;And go back round for more
 376
 377 09              LDMFD   R13!,{R0-R4,PC}^        ;And return to caller
 378
 379                 LTORG
 380
 381 ; --- sapph__init ---
 382 ;
 383 ; On entry:     R0 == pointer to base of initialise table
 384 ;               R1 == pointer to limit of initialise table
 385 ;               R2 == base of workspace chunk
 386 ;
 387 ; On exit:      --
 388 ;
 389 ; Use:          Initialises currently uninitialised library units.
 390
 391 sapph__init     ROUT
 392
 393                 STMFD   R13!,{R0-R7,R14}        ;Save some registers
 394                 MOV     R3,R0                   ;Look after this pointer
 395                 LDR     R0,sapph_appName        ;Find application's name
 396 00              CMP     R3,R1                   ;Have we finished yet?
 397                 LDMCSFD R13!,{R0-R7,PC}^        ;Yes -- then return
 398                 LDMIA   R3!,{R4-R7}             ;Load values from block
 399                 CMP     R7,#0                   ;Is there a init routine?
 400                 MOVNE   R14,PC                  ;Yes -- set up return address
 401                 MOVNE   PC,R7                   ;And call the routine
 402                 B       %00sapph__init          ;And go round again
 403
 404                 LTORG
 405
 406 ; --- sapphire_doDisable ---
 407 ;
 408 ; On entry:     R0 == pointer to list of initialise routines to disable
 409 ;               R1 == pointer to initialisation table
 410 ;
 411 ; On exit:      --
 412 ;
 413 ; Use:          Prevents the given initialisation routines from being
 414 ;               called.  This is mainly useful in a dynamically linked
 415 ;               environment.
 416
 417                 EXPORT  sapphire_doDisable
 418 sapphire_doDisable ROUT
 419
 420                 STMFD   R13!,{R0-R7,R14}        ;Save some registers
 421                 MOV     R7,R0                   ;Keep pointer safe
 422                 ADD     R6,R1,#4                ;Point to initialise table
 423
 424 00              LDR     R5,[R7],#4              ;Load next entry to remove
 425                 TEQ     R5,#0                   ;Is this the end yet?
 426                 BEQ     %90sapphire_doDisable   ;Yes -- then return
 427
 428                 LDR     R14,[R5,#0]             ;Load the first instruction
 429                 AND     R0,R14,#&FF000000       ;Get the opcode bits out
 430                 CMP     R0,#&EA000000           ;Is this a branch instruction
 431                 BICEQ   R14,R14,#&FF000000      ;Yes -- zap instruction bits
 432                 ADDEQ   R14,R14,#2              ;Compensate for pipeline
 433                 ADDEQ   R5,R5,R14,LSL #2        ;And work out destination
 434
 435                 ; --- Now find this routine somewhere ---
 436
 437                 ADR     R0,sapph__ownTable      ;Point to our own table
 438                 LDMIA   R0,{R0,R1}              ;Load base and limit pointers
 439                 LDR     R2,sapph_workspace      ;Load workspace base address
 440                 BL      sapph__disable          ;See if it's in there
 441                 BCS     %00sapphire_doDisable   ;If so, move to next routine
 442
 443                 ; --- Try the client table then ---
 444
 445                 MOV     R4,R6                   ;Point to init table
 446 05              LDMIA   R4!,{R0,R1}             ;Load the values out
 447                 CMP     R0,#0                   ;Have I finished here yet?
 448                 BEQ     %09sapphire_doDisable   ;Yes -- skip out then
 449                 BL      sapph__disable          ;See if it's in there
 450                 BCS     %00sapphire_doDisable   ;If so, move to next routine
 451                 B       %05sapphire_doDisable   ;Else try the next lot
 452
 453                 ; --- Now try the external table ---
 454
 455 09              SUB     R4,R4,#4                ;We overshot as usual
 456                 LDMIA   R4,{R3,R4}              ;Load base and limit out
 457 10              CMP     R3,R4                   ;Reached the end yet?
 458                 BEQ     %00sapphire_doDisable   ;If so, move to next routine
 459                 MOV     R14,PC                  ;Set up return address
 460                 LDR     PC,[R3],#4              ;Find next init table
 461                 LDR     R2,[R11,-R2]            ;Load the workspace base
 462                 BL      sapph__disable          ;See if it's in there
 463                 BCS     %00sapphire_doDisable   ;If so, move to next routine
 464                 B       %10sapphire_doDisable   ;Else try the next lot
 465
 466                 ; --- Finished all of them ---
 467
 468 90              LDMFD   R13!,{R0-R7,PC}^        ;Return to caller
 469
 470                 LTORG
 471
 472 ; --- sapph__disable ---
 473 ;
 474 ; On entry:     R0 == base of initialise table
 475 ;               R1 == limit of initialise table
 476 ;               R2 == base of workspace for table
 477 ;               R5 == address of init routine to match
 478 ;
 479 ; On exit:      CS if routine found, else CC
 480 ;               R0 corrupted
 481 ;
 482 ; Use:          Finds and disables a given initialise routine.
 483
 484 sapph__disable  ROUT
 485
 486                 BIC     R14,R14,#C_flag         ;Clear carry flag initially
 487                 STMFD   R13!,{R3,R4,R6,R14}     ;Save some registers
 488 00              CMP     R0,R1                   ;Reached the end yet?
 489                 LDMCSFD R13!,{R3,R4,R6,PC}^     ;Yes -- return sadly then
 490                 LDMIA   R0!,{R3,R4,R6,R14}      ;Load values from table
 491                 CMP     R3,#0                   ;Is there any workspace?
 492                 BEQ     %00sapph__disable       ;No -- ignore this entry
 493                 CMP     R14,R5                  ;Is this the routine?
 494                 BNE     %00sapph__disable       ;No -- ignore this entry
 495                 LDR     R4,[R4,#0]              ;Load workspace offset
 496                 MOV     R14,#-1                 ;Set all of the bits
 497                 STR     R14,[R2,R4]             ;Save it in workspace
 498                 LDMFD   R13!,{R3,R4,R6,R14}     ;Unstack the registers
 499                 ORRS    PC,R14,#C_flag          ;And return with C set
 500
 501                 LTORG
 502
 503 ; --- sapphire_heapAddr ---
 504 ;
 505 ; On entry:     --
 506 ;
 507 ; On exit:      R1 == pointer to the heap base (for passing to OS_Heap)
 508 ;
 509 ; Use:          Returns the address of the Sapphire heap.
 510
 511                 EXPORT  sapphire_heapAddr
 512 sapphire_heapAddr ROUT
 513
 514                 LDR     R1,sapph_heapBase
 515                 MOVS    PC,R14
 516
 517                 LTORG
 518
 519 ; --- sapphire_appName ---
 520 ;
 521 ; On entry:     --
 522 ;
 523 ; On exit:      R0 == pointer to application name (NULL terminated)
 524 ;
 525 ; Use:          Returns a pointer to the application's name.
 526
 527                 EXPORT  sapphire_appName
 528 sapphire_appName ROUT
 529
 530                 LDR     R0,sapph_appName
 531                 MOVS    PC,R14
 532
 533                 LTORG
 534
 535 ; --- sapphire_resetStack ---
 536 ;
 537 ; On entry:     --
 538 ;
 539 ; On exit:      R13 == stack pointer
 540 ;
 541 ; Use:          Resets R13 to point to the top of the stack.
 542
 543                 EXPORT  sapphire_resetStack
 544 sapphire_resetStack
 545                 ROUT
 546
 547                 LDR     R13,sapph_stackBase
 548                 MOVS    PC,R14
 549
 550                 LTORG
 551
 552 ; --- sapphire_global ---
 553 ;
 554 ; On entry:     R0 == magic identifier for global variable
 555 ;               R1 == size of area required
 556 ;
 557 ; On exit:      R0 == pointer to area
 558 ;               CS if the area already exists, CC otherwise
 559 ;
 560 ; Use:          Locates (and creates if necessary) a `named' global area
 561 ;               which can be used for inter-section communication without
 562 ;               the necessity for dependencies.
 563 ;
 564 ;               There is a limit on the number of global areas allowed, but
 565 ;               this can be raised fairly easily if necessary.
 566 ;
 567 ;               If an area can't be created, an error is generated.
 568
 569                 EXPORT  sapphire_global
 570 sapphire_global ROUT
 571
 572                 ORR     R14,R14,#C_flag         ;Clear C flag normally
 573                 STMFD   R13!,{R1-R4,R12,R14}    ;Save some registers
 574                 LDR     R12,sapph_workspace     ;Find workspace base address
 575                 SUB     R12,R12,#sapph__wSize   ;Subtract to get kernel space
 576
 577                 ; --- Try and find a matching global name ---
 578
 579                 ADR     R4,sapph__globals       ;Point to the globals block
 580                 LDR     R2,sapph__globCnt       ;Load my current pointer
 581                 MOVS    R3,R2                   ;Is it zero?
 582                 BEQ     %10sapphire_global      ;If not present, skip ahead
 583
 584 00              LDR     R14,[R4],#8             ;Load the name of this one
 585                 CMP     R0,R14                  ;Is this a match then?
 586                 LDREQ   R0,[R4,#-4]             ;Yes -- point to the block
 587                 LDMEQFD R13!,{R1-R4,R12,PC}^    ;Yes -- return the pointer
 588                 SUBS    R3,R3,#1                ;Decrement the counter
 589                 BGT     %00sapphire_global      ;If more left, check 'em
 590
 591                 ; --- No luck there -- allocate a new one ---
 592
 593 10              CMP     R3,#sapph__globMax      ;Are we at the limit?
 594                 ADRGE   R0,sapph__noGlob        ;Yes -- point to the limit
 595                 SWIGE   OS_GenerateError        ;And quit the proggy
 596
 597                 ADD     R2,R2,#1                ;Bump the global counter
 598                 STR     R2,sapph__globCnt       ;Store the counter away
 599                 STR     R0,[R4,#0]              ;Store the name of this one
 600
 601                 MOV     R3,R1                   ;Get the size in R3 nicely
 602                 MOV     R0,#2                   ;Allocate a new heap block
 603                 LDR     R1,sapph_heapBase       ;Load my heap pointer nicely
 604                 SWI     OS_Heap                 ;Allocate the memory now
 605                 STR     R2,[R4,#4]              ;Store the pointer for later
 606                 MOV     R0,R2                   ;Return the pointer now
 607
 608                 LDMFD   R13!,{R1-R4,R12,R14}    ;Return to caller
 609                 BICS    PC,R14,#C_flag          ;Explaining we had to create
 610
 611 sapph__noGlob   DCD     1
 612                 DCB     "Too many global areas",0
 613
 614                 LTORG
 615
 616 ;----- Workspace ------------------------------------------------------------
 617
 618 ; --- Data relative to R11 ---
 619
 620                 ^       0,R11
 621 sapph__R11      #       0                       ;Make a symbol for R11
 622
 623 sapph_scratchpad EQU    sapph__R11-0            ;Scratchpad data area
 624 sapph_workspace EQU     sapph__R11-4            ;Workspace base address
 625 sapph_stackBase EQU     sapph__R11-8            ;The top of the system stack
 626 sapph_heapBase  EQU     sapph__R11-12           ;Base address of the heap
 627 sapph_appName   EQU     sapph__R11-16           ;Pointer to application name
 628 sapph_clientWS  EQU     sapph__R11-20           ;Address of client's space
 629
 630 sapph__minStack EQU     2048                    ;Minimum acceptable stack
 631 sapph__globMax  EQU     5                       ;Maximum global areas allowed
 632
 633                 ^       0,R12
 634 sapph__wStart   #       0
 635
 636 sapph__globCnt  #       4                       ;Number of global areas
 637 sapph__globals  #       8*sapph__globMax        ;The actual global bits
 638
 639 sapph__wSize    EQU     {VAR}-sapph__wStart
 640
 641 ;----- That's all, folks ----------------------------------------------------
 642
 643                 END
 644