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

   1 ;
   2 ; var.s
   3 ;
   4 ; Variable handling
   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.errNum
  20                 GET     sh.error
  21                 GET     sh.tree
  22
  23 ;----- Other definitions ----------------------------------------------------
  24
  25 var__chunkSize  EQU     256                     ;Chunck size of var stack
  26
  27 ;----- Main code ------------------------------------------------------------
  28
  29                 AREA    |TermScript$$Code|,CODE,READONLY
  30
  31 ; --- var_create ---
  32 ;
  33 ; On entry:     R0 == type of variable
  34 ;               R1 == pointer to variable name
  35 ;               R12 == pointer to the anchor block
  36 ;               Other registers depend on the type
  37 ;               vType_label, vType_proc, vType_fn:
  38 ;                 R2 == file offset of label of DEF
  39 ;                 R3 == line number of label or DEF
  40 ;               vType_dimInt, vType_dimStr:
  41 ;                 R2 == pointer to subscript block (in *reverse* order)
  42 ;                 R3 == number of subscripts
  43 ;                 R4 == number of items to create
  44 ;
  45 ; On exit:      R0 == pointer to the variable
  46 ;
  47 ; Use:          Tries to find the variable given, and return a pointer
  48 ;               to it if it is found. Otherwise it will try to create the
  49 ;               variable and return a pointer to the new one.
  50
  51                 EXPORT  var_create
  52 var_create      ROUT
  53
  54                 ADD     PC,PC,R0,LSL #2         ;Branch to correct dispatcher
  55                 DCB     "TMA!"                  ;A little padding
  56
  57                 B       var__normal
  58                 B       var__normal
  59                 B       var__dim
  60                 B       var__dim
  61                 B       var__label
  62                 B       var__label
  63                 B       var__label
  64
  65                 LTORG
  66
  67 ; --- var_find ---
  68 ;
  69 ; On entry:     R0 == type of the variable
  70 ;               R1 == name of the variable
  71 ;
  72 ; On exit:      CS if the variable was found, and
  73 ;                 R0 == pointer to the variable block
  74 ;               else CC and
  75 ;                 R0 corrupted
  76 ;
  77 ; Use:          Tries to find the given variable in the current tree.
  78
  79                 EXPORT  var_find
  80 var_find        ROUT
  81
  82                 STMFD   R13!,{R2,R14}           ;Save some registers
  83                 MOV     R2,R0                   ;Look after the type
  84                 BL      tree_find               ;Find the variable
  85                 LDMCSFD R13!,{R2,PC}^           ;If found, return now
  86                 CMP     R2,#vType_dimInt        ;Is it an integer array?
  87                 CMPNE   R2,#vType_dimStr        ;Or a string array?
  88                 MOVEQ   R0,#err_ukArray         ;Yes -- find `unknown array'
  89                 MOVNE   R0,#err_unknown         ;No -- use `unknown var'
  90                 B       error_report            ;And report it to the world
  91
  92                 LTORG
  93
  94 ;----- Variable creation routines -------------------------------------------
  95 ;
  96 ; On entry:     R0 == variable type
  97 ;               R1 == address of variable name
  98
  99 ; --- var__normal ---
 100
 101 var__normal     ROUT
 102
 103                 STMFD   R13!,{R1-R4,R14}        ;Stack registers
 104
 105                 ; --- Allocate space for the variable ---
 106
 107                 MOV     R2,#8                   ;Variable requires 16 bytes
 108                 BL      tree_add                ;Add it to the symbol table
 109                 BVS     var__error              ;Return possible error
 110
 111                 MOV     R14,#0                  ;Initialise the value
 112                 STRCC   R14,[R0,#4]             ;Set this up nicely
 113                 LDMFD   R13!,{R1-R4,PC}^        ;And return to caller
 114
 115 ; --- var__dim ---
 116
 117 var__dim        ROUT
 118
 119                 STMFD   R13!,{R1-R6,R14}        ;Stack registers
 120                 ADD     R5,R2,R3,LSL #2         ;Look after subscript block
 121                 MOV     R2,#12                  ;Room for name + num of subs
 122                 ADD     R2,R2,R3,LSL #2         ;Add room for sizes
 123                 ADD     R2,R2,R4,LSL #2         ;And subscripts themselves
 124                 BL      tree_add                ;Try to allocate space
 125                 BVS     var__error              ;Barf on error
 126                 STR     R3,[R0,#4]              ;Store number of subscripts
 127                 STR     R4,[R0,#8]              ;Store total number of items
 128                 ADD     R6,R0,#12               ;Point to the first size
 129
 130                 ; --- Set up the subscript sizes ---
 131
 132 00              LDR     R14,[R5,#-4]!           ;Load the subscript size
 133                 STR     R14,[R6],#4             ;Store that in the block
 134                 SUBS    R3,R3,#1                ;Reduce subscript count
 135                 BGT     %b00                    ;Keep filling in block
 136
 137                 ; --- Initialise all the entries ---
 138
 139                 MOV     R14,#0                  ;Initialiser
 140 00              STR     R14,[R6],#4             ;Set entry to 0
 141                 SUBS    R4,R4,#1                ;Reduce the item count
 142                 BGT     %b00                    ;Keep on initialising
 143
 144                 LDMFD   R13!,{R1-R6,PC}^        ;Return to caller
 145
 146                 LTORG
 147
 148 ; --- var__label ---
 149
 150 var__label      ROUT
 151
 152                 STMFD   R13!,{R1-R4,R14}        ;Stack registers
 153                 LDR     R14,sail_tokAnchor      ;Find anchor of t'ised file
 154                 LDR     R14,[R14]               ;I hate WimpExt_Heap
 155                 SUB     R4,R2,R14               ;Make the address an offset
 156
 157                 ; --- Allocate space for the variable ---
 158
 159                 MOV     R2,#12                  ;Variable requires 16 bytes
 160                 BL      tree_add                ;Add it to the symbol table
 161                 BVS     var__error              ;Return possible error
 162
 163                 ; --- Fill in the block ---
 164
 165                 MOV     R2,R4                   ;Get the file offset
 166                 STMIB   R0,{R2,R3}              ;Store the informtion
 167                 LDMFD   R13!,{R1-R4,PC}^        ;Unstack registers
 168
 169 var__error      MOV     R0,#err_noMem           ;Get the error number
 170                 B       error_report            ;And report the error
 171
 172                 LTORG
 173
 174 ;----- Workspace ------------------------------------------------------------
 175
 176                 ; --- Variable types ---
 177
 178                 ^       0
 179 vType_integer   #       1                       ;Integer
 180 vType_string    #       1                       ;String
 181 vType_dimInt    #       1                       ;DIM of integers
 182 vType_dimStr    #       1                       ;DIM of strings
 183 vType_label     #       1                       ;Label
 184 vType_proc      #       1                       ;Procedure name
 185 vType_fn        #       1                       ;Function name
 186
 187 ;----- That's all, folks ----------------------------------------------------
 188
 189                 END