"SfR Fresh" - the SfR Freeware/Shareware Archive 
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 '
2 ' ####################
3 ' ##### PROLOG #####
4 ' ####################
5 '
6 PROGRAM "aarray"
7 VERSION "0.0000"
8 '
9 IMPORT "xst"
10 '
11 DECLARE FUNCTION Entry ()
12 DECLARE FUNCTION PrintArray (ANY array[])
13 DECLARE FUNCTION TypeNumberToName (type, type$)
14
15 $$HIGHER_DIMENSION = 0x20000000
16 '
17 '
18 ' ######################
19 ' ##### Entry () #####
20 ' ######################
21 '
22 FUNCTION Entry ()
23 USHORT array[]
24 USHORT data[]
25 '
26 XstClearConsole()
27 GOSUB TestOne
28 GOSUB TestTwo
29 RETURN
30 '
31 '
32 ' ***** TestOne *****
33 '
34 SUB TestOne
35 PRINT
36 PRINT "######################"
37 PRINT "##### test one #####"
38 PRINT "######################"
39 DIM array$[3]
40 array$[0] = "zero"
41 array$[1] = "one"
42 array$[2] = "two"
43 array$[3] = "three"
44 PrintArray (@array$[])
45 END SUB
46 '
47 '
48 ' ***** TestTwo *****
49 '
50 SUB TestTwo
51 PRINT
52 PRINT "######################"
53 PRINT "##### test two #####"
54 PRINT "######################"
55 '
56 DIM array[3,2,]
57 ' DIM array[2,] ' create upper dimension of 2D array
58 '
59 DIM data[0] ' create array with 1 USHORT element
60 data[0] = 10
61 ATTACH data[] TO array[1,0,] ' attach 1 element array to array[0,]
62 '
63 DIM data[2] ' create array with 3 USHORT elements
64 data[0] = 20
65 data[1] = 21
66 data[2] = 22
67 ATTACH data[] TO array[1,1,] ' attach 3 element array to array[1,]
68 '
69 DIM data[7] ' create array with 8 USHORT elements
70 data[0] = 30
71 data[1] = 31
72 data[2] = 32
73 data[3] = 33
74 data[4] = 34
75 data[5] = 35
76 data[6] = 36
77 data[7] = 37
78 ATTACH data[] TO array[1,2,] ' attach 8 element array to array[2,]
79 '
80 ' pass array to function
81 '
82 PrintArray (@array[]) ' pass 2D array to function PrintArray()
83 END SUB
84 END FUNCTION
85 '
86 '
87 ' ###########################
88 ' ##### PrintArray () #####
89 ' ###########################
90 '
91 FUNCTION PrintArray (array[])
92 STATIC dimension
93 SBYTE sbyte[]
94 UBYTE ubyte[]
95 SSHORT sshort[]
96 USHORT ushort[]
97 SLONG slong[]
98 ULONG ulong[]
99 XLONG xlong[]
100 '
101 IFZ array[] THEN RETURN
102 '
103 type = TYPE (array[])
104 IF ((type < $$SBYTE) OR (type > $$DCOMPLEX)) THEN RETURN ' not handled
105 '
106 ' next dimension (increase from left to right)
107 '
108 INC dimension
109 '
110 ' print header of this array
111 '
112 PRINT
113 PRINT "######## dimension = "; dimension
114 higher = $$FALSE
115 address = &array[]
116 GOSUB PrintArrayHeader
117 reason$ = " ::: this lowest dimension holds data"
118 IF (head3 AND $$HIGHER_DIMENSION) THEN reason$ = " ::: because this higher dimension holds addresses"
119 '
120 ' print datatype of this array
121 '
122 TypeNumberToName (type, @type$)
123 PRINT "the datatype of this array = "; type$; reason$
124 '
125 ' process higher dimensions
126 '
127 IF (head3 AND $$HIGHER_DIMENSION) THEN
128 upper = UBOUND (array[])
129 PRINT "upper bound of this dimension = "; upper
130 FOR i = 0 TO upper
131 ATTACH array[i,] TO temp[]
132 PrintArray (@temp[])
133 ATTACH temp[] TO array[i,]
134 NEXT i
135 DEC dimension
136 RETURN
137 END IF
138 '
139 ' process lowest = data dimension
140 '
141 upper = UBOUND (array[])
142 upper$ = STRING$(upper)
143 length = LEN(upper$)
144 '
145 '
146 ' process each datatype separately
147 '
148 SELECT CASE type
149 CASE $$SBYTE : GOSUB sbyte
150 CASE $$UBYTE : GOSUB ubyte
151 CASE $$SSHORT : GOSUB sshort
152 CASE $$USHORT : GOSUB ushort
153 ' CASE $$SLONG : GOSUB slong
154 ' CASE $$ULONG : GOSUB ulong
155 ' CASE $$XLONG : GOSUB xlong
156 ' CASE $$GOADDR : GOSUB goaddr
157 ' CASE $$SUBADDR : GOSUB subaddr
158 ' CASE $$FUNCADDR : GOSUB funcaddr
159 ' CASE $$GIANT : GOSUB giant
160 ' CASE $$SINGLE : GOSUB single
161 ' CASE $$DOUBLE : GOSUB double
162 CASE $$STRING : GOSUB string
163 ' CASE $$SCOMPLEX : GOSUB scomplex
164 ' CASE $$DCOMPLEX : GOSUB dcomplex
165 END SELECT
166 DEC dimension
167 RETURN
168 '
169 '
170 ' ***** sbyte *****
171 '
172 SUB sbyte
173 PRINT "sbyte"
174 END SUB
175 '
176 '
177 ' ***** ubyte *****
178 '
179 SUB ubyte
180 PRINT "ubyte"
181 END SUB
182 '
183 '
184 ' ***** sshort *****
185 '
186 SUB sshort
187 PRINT "sshort"
188 END SUB
189 '
190 '
191 ' ***** ushort *****
192 '
193 SUB ushort
194 ATTACH array[] TO ushort[]
195 '
196 FOR i = 0 TO upper
197 PRINT " ushort [ ... "; RJUST$(STRING$(i),length); " ] = "; STRING$(ushort[i])
198 NEXT i
199 END SUB
200 '
201 '
202 ' ***** string *****
203 '
204 SUB string
205 ATTACH array[] TO string$[]
206 '
207 FOR i = 0 TO upper
208 PRINT " string$ [ ... "; RJUST$(STRING$(i),length); " ] = "; string$[i]
209 NEXT i
210 END SUB
211
212 '
213 '
214 ' ***** PrintArrayHeader *****
215 '
216 SUB PrintArrayHeader
217 head0 = XLONGAT(address-0x10)
218 head1 = XLONGAT(address-0x0C)
219 head2 = XLONGAT(address-0x08)
220 head3 = XLONGAT(address-0x04)
221 IF (head3 AND $$HIGHER_DIMENSION) THEN header$ = " = higher dimension" ELSE header$ = " = lowest dimension = data"
222 PRINT HEX$(head0,8);; HEX$(head1,8);; HEX$(head2,8);; HEX$(head3,8);; header$
223 END SUB
224 END FUNCTION
225 '
226 '
227 ' #################################
228 ' ##### TypeNumberToName () #####
229 ' #################################
230 '
231 FUNCTION TypeNumberToName (type, type$)
232 '
233 type$ = ""
234 '
235 SELECT CASE type
236 CASE 0 : type$ = "NONE"
237 CASE 1 : type$ = "VOID"
238 CASE $$SBYTE : type$ = "SBYTE"
239 CASE $$UBYTE : type$ = "UBYTE"
240 CASE $$SSHORT : type$ = "SSHORT"
241 CASE $$USHORT : type$ = "USHORT"
242 CASE $$SLONG : type$ = "SLONG"
243 CASE $$ULONG : type$ = "ULONG"
244 CASE $$XLONG : type$ = "XLONG"
245 CASE $$GOADDR : type$ = "GOADDR"
246 CASE $$SUBADDR : type$ = "SUBADDR"
247 CASE $$FUNCADDR : type$ = "FUNCADDR"
248 CASE $$GIANT : type$ = "GIANT"
249 CASE $$SINGLE : type$ = "SINGLE"
250 CASE $$DOUBLE : type$ = "DOUBLE"
251 CASE $$STRING : type$ = "STRING"
252 CASE $$SCOMPLEX : type$ = "SCOMPLEX"
253 CASE $$DCOMPLEX : type$ = "DCOMPLEX"
254 END SELECT
255 END FUNCTION
256 END PROGRAM