mdw@git.distorted.org.uk Git - ssr/blob - StraySrc/Libraries/Sapphire/sail/s/env

   1 ;
   2 ; env.s
   3 ;
   4 ; Environment handling for SAIL
   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     sapphire:subAlloc
  19
  20 ;----- Main code ------------------------------------------------------------
  21
  22                 AREA    |Sapphire$$Code|,CODE,READONLY
  23
  24 ; --- sail_createEnv ---
  25 ;
  26 ; On entry:     R0 == parent environment handle or 0
  27 ;               R1 == address of CALL table
  28 ;
  29 ; On exit:      R0 == environment handle
  30 ;               May return an error
  31 ;
  32 ; Use:          Creates an environment.
  33 ;
  34 ;               The CALL tabe format is as follows:
  35 ;
  36 ;               string          prefix
  37 ;               align
  38 ;               word            size of data for this prefix
  39 ;               align
  40 ;               string          name of call
  41 ;               word            address to call
  42 ;               ...
  43 ;               word            0
  44
  45                 EXPORT  sail_createEnv
  46
  47 sail_createEnv ROUT
  48
  49                 STMFD   R13!,{R1,R2,R14}        ;Stach registers
  50
  51                 MOV     R2,R0                   ;Look after handle
  52                 MOV     R0,#sEnv__size          ;Get the size
  53                 BL      sub_alloc               ;Allocate it then
  54                 BVS     %90                     ;Jump ahead with glum
  55
  56                 STR     R2,[R0,#sEnv__parent]   ;Store the parent handle
  57                 STR     R1,[R0,#sEnv__table]    ;Store call table address
  58                 MOV     R14,#0                  ;I like this value
  59                 STR     R14,[R0,#sEnv__next]    ;No next block yet
  60 90              LDMFD   R13!,{R1,R2,R14}        ;Load back registers
  61                 ORRVSS  PC,R14,#V_flag          ;Return with error
  62                 BICVCS  PC,R14,#V_flag          ;Return without error
  63
  64                 LTORG
  65
  66 ; --- sail_addCalls ---
  67 ;
  68 ; On entry:     R0 == environment handle
  69 ;               R1 == address of new call table
  70 ;
  71 ; On exit:      May return an error
  72 ;
  73 ; Use:          Adds an extra CALL table to an environment.  Useful
  74 ;               for extension DLLs.
  75
  76                 EXPORT  sail_addCalls
  77 sail_addCalls   ROUT
  78
  79                 ASSERT  sEnv__next=sCall__next
  80                 ASSERT  sEnv__table=sCall__table
  81
  82                 STMFD   R13!,{R0-R3,R14}        ;Stack register
  83                 MOV     R3,R1                   ;Look after the call table
  84                 ADD     R2,R0,#sEnv__next       ;Point to the next entry
  85 00              LDR     R14,[R2,#sCall__next]   ;Load the next pointer
  86                 CMP     R14,#0                  ;Is there one?
  87                 MOVNE   R2,R14                  ;No -- point to next one
  88                 BNE     %b00                    ;...and do this lots
  89
  90                 MOV     R0,#sEnv__callSize      ;Get the size to allocate
  91                 BL      sub_alloc               ;Allocate it then
  92                 BVS     %95                     ;Report possible error
  93
  94                 STR     R0,[R2,#sCall__next]    ;Store this as next pointer
  95                 STR     R3,[R0,#sCall__table]   ;Store the table pointer
  96                 MOV     R14,#0                  ;A NULL word
  97                 STR     R14,[R0,#sCall__next]   ;No next pointer yet
  98
  99                 LDMFD   R13!,{R0-R3,R14}        ;Load back register
 100                 BICS    PC,R14,#V_flag          ;Return without error
 101
 102 90              LDMFD   R13!,{R0-R3,R14}        ;Load back register
 103                 ORRS    PC,R14,#V_flag          ;Return with error
 104
 105                 LTORG
 106
 107 ;----- Workspace ------------------------------------------------------------
 108
 109 ; --- Environment block ---
 110
 111                 ^       0
 112 sEnv__start     #       0
 113 sEnv__next      #       4                       ;Pointer to next call table
 114 sEnv__table     #       4                       ;Pointer to the call table
 115 sEnv__parent    #       4                       ;Parent environment
 116 sEnv__size      #       0                       ;Size of the structure
 117
 118 ; --- The call block ---
 119
 120                 ^       0
 121 sCall__start    #       0
 122 sCall__next     #       4
 123 sCall__table    #       4
 124
 125 ;----- That's all, folks ----------------------------------------------------
 126
 127                 END