Rev 7693 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
| Rev 7693 | Rev 7696 | ||
|---|---|---|---|
| Line 1... | Line 1... | ||
| 1 | (* |
1 | (* |
| 2 | BSD 2-Clause License |
2 | BSD 2-Clause License |
| Line 3... | Line 3... | ||
| 3 | 3 | ||
| 4 | Copyright (c) 2018, 2019, Anton Krotov |
4 | Copyright (c) 2018-2019, Anton Krotov |
| 5 | All rights reserved. |
5 | All rights reserved. |
| Line 6... | Line 6... | ||
| 6 | *) |
6 | *) |
| Line 94... | Line 94... | ||
| 94 | opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19; |
94 | opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19; |
| 95 | opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23; |
95 | opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23; |
| 96 | opLADR_UNPK* = -24; |
96 | opLADR_UNPK* = -24; |
| Line 97... | Line 97... | ||
| 97 | 97 | ||
| 98 | 98 | ||
| 99 | _move *= 0; |
99 | _init *= 0; |
| 100 | _move2 *= 1; |
100 | _move *= 1; |
| 101 | _strcmpw *= 2; |
101 | _strcmpw *= 2; |
| 102 | _exit *= 3; |
102 | _exit *= 3; |
| 103 | _set *= 4; |
103 | _set *= 4; |
| 104 | _set2 *= 5; |
104 | _set1 *= 5; |
| 105 | _lengthw *= 6; |
105 | _lengthw *= 6; |
| 106 | _strcpy *= 7; |
106 | _strcpy *= 7; |
| 107 | _div *= 8; |
107 | _length *= 8; |
| 108 | _mod *= 9; |
108 | _divmod *= 9; |
| 109 | _div2 *= 10; |
109 | _dllentry *= 10; |
| 110 | _mod2 *= 11; |
110 | _sofinit *= 11; |
| 111 | _arrcpy *= 12; |
111 | _arrcpy *= 12; |
| 112 | _rot *= 13; |
112 | _rot *= 13; |
| 113 | _new *= 14; |
113 | _new *= 14; |
| 114 | _dispose *= 15; |
114 | _dispose *= 15; |
| 115 | _strcmp *= 16; |
115 | _strcmp *= 16; |
| 116 | _error *= 17; |
116 | _error *= 17; |
| 117 | _is *= 18; |
117 | _is *= 18; |
| 118 | _isrec *= 19; |
118 | _isrec *= 19; |
| 119 | _guard *= 20; |
- | |
| 120 | _guardrec *= 21; |
- | |
| 121 | _length *= 22; |
- | |
| 122 | _init *= 23; |
- | |
| Line 123... | Line 119... | ||
| 123 | _dllentry *= 24; |
119 | _guard *= 20; |
| Line 124... | Line 120... | ||
| 124 | _sofinit *= 25; |
120 | _guardrec *= 21; |
| Line 173... | Line 169... | ||
| 173 | count: INTEGER |
169 | count: INTEGER |
| Line 174... | Line 170... | ||
| 174 | 170 | ||
| Line 175... | Line 171... | ||
| 175 | END; |
171 | END; |
| Line 176... | Line 172... | ||
| 176 | 172 | ||
| 177 | 173 | ||
| 178 | CODES* = POINTER TO RECORD |
174 | CODES = RECORD |
| 179 | 175 | ||
| Line 186... | Line 182... | ||
| 186 | types*: CHL.INTLIST; |
182 | types*: CHL.INTLIST; |
| 187 | data*: CHL.BYTELIST; |
183 | data*: CHL.BYTELIST; |
| 188 | dmin*: INTEGER; |
184 | dmin*: INTEGER; |
| 189 | lcount*: INTEGER; |
185 | lcount*: INTEGER; |
| 190 | bss*: INTEGER; |
186 | bss*: INTEGER; |
| 191 | rtl*: ARRAY 26 OF INTEGER; |
187 | rtl*: ARRAY 22 OF INTEGER; |
| 192 | errlabels*: ARRAY 12 OF INTEGER; |
188 | errlabels*: ARRAY 12 OF INTEGER; |
| Line 193... | Line 189... | ||
| 193 | 189 | ||
| 194 | charoffs: ARRAY 256 OF INTEGER; |
190 | charoffs: ARRAY 256 OF INTEGER; |
| Line 206... | Line 202... | ||
| 206 | numRegsFloat: INTEGER; |
202 | numRegsFloat: INTEGER; |
| Line 207... | Line 203... | ||
| 207 | 203 | ||
| Line -... | Line 204... | ||
| - | 204 | commands, variables: C.COLLECTION; |
|
| - | 205 | ||
| - | 206 | ||
| - | 207 | PROCEDURE set_dmin* (value: INTEGER); |
|
| - | 208 | BEGIN |
|
| - | 209 | codes.dmin := value |
|
| - | 210 | END set_dmin; |
|
| - | 211 | ||
| - | 212 | ||
| - | 213 | PROCEDURE set_bss* (value: INTEGER); |
|
| - | 214 | BEGIN |
|
| - | 215 | codes.bss := value |
|
| - | 216 | END set_bss; |
|
| - | 217 | ||
| - | 218 | ||
| - | 219 | PROCEDURE set_rtl* (idx, label: INTEGER); |
|
| - | 220 | BEGIN |
|
| - | 221 | codes.rtl[idx] := label |
|
| 208 | commands, variables: C.COLLECTION; |
222 | END set_rtl; |
| 209 | 223 | ||
| 210 | 224 | ||
| 211 | PROCEDURE NewCmd (): COMMAND; |
225 | PROCEDURE NewCmd (): COMMAND; |
| Line 255... | Line 269... | ||
| 255 | PROCEDURE getlast* (): COMMAND; |
269 | PROCEDURE getlast* (): COMMAND; |
| 256 | RETURN codes.last |
270 | RETURN codes.last |
| 257 | END getlast; |
271 | END getlast; |
| Line 258... | Line 272... | ||
| 258 | 272 | ||
| 259 | 273 | ||
| 260 | PROCEDURE PutByte (codes: CODES; b: BYTE); |
274 | PROCEDURE PutByte (b: BYTE); |
| 261 | BEGIN |
275 | BEGIN |
| Line 270... | Line 284... | ||
| 270 | res := CHL.Length(codes.data); |
284 | res := CHL.Length(codes.data); |
| Line 271... | Line 285... | ||
| 271 | 285 | ||
| 272 | i := 0; |
286 | i := 0; |
| 273 | n := LENGTH(s); |
287 | n := LENGTH(s); |
| 274 | WHILE i < n DO |
288 | WHILE i < n DO |
| 275 | PutByte(codes, ORD(s[i])); |
289 | PutByte(ORD(s[i])); |
| 276 | INC(i) |
290 | INC(i) |
| Line 277... | Line 291... | ||
| 277 | END; |
291 | END; |
| Line 278... | Line 292... | ||
| 278 | 292 | ||
| 279 | PutByte(codes, 0) |
293 | PutByte(0) |
| Line 287... | Line 301... | ||
| 287 | res: INTEGER; |
301 | res: INTEGER; |
| Line 288... | Line 302... | ||
| 288 | 302 | ||
| 289 | BEGIN |
303 | BEGIN |
| 290 | IF codes.charoffs[c] = -1 THEN |
304 | IF codes.charoffs[c] = -1 THEN |
| 291 | res := CHL.Length(codes.data); |
305 | res := CHL.Length(codes.data); |
| 292 | PutByte(codes, c); |
306 | PutByte(c); |
| 293 | PutByte(codes, 0); |
307 | PutByte(0); |
| 294 | codes.charoffs[c] := res |
308 | codes.charoffs[c] := res |
| 295 | ELSE |
309 | ELSE |
| 296 | res := codes.charoffs[c] |
310 | res := codes.charoffs[c] |
| Line 306... | Line 320... | ||
| 306 | 320 | ||
| 307 | BEGIN |
321 | BEGIN |
| Line 308... | Line 322... | ||
| 308 | res := CHL.Length(codes.data); |
322 | res := CHL.Length(codes.data); |
| 309 | 323 | ||
| 310 | IF ODD(res) THEN |
324 | IF ODD(res) THEN |
| 311 | PutByte(codes, 0); |
325 | PutByte(0); |
| Line 312... | Line 326... | ||
| 312 | INC(res) |
326 | INC(res) |
| Line 313... | Line 327... | ||
| 313 | END; |
327 | END; |
| 314 | 328 | ||
| 315 | n := STRINGS.Utf8To16(s, codes.wstr); |
329 | n := STRINGS.Utf8To16(s, codes.wstr); |
| 316 | 330 | ||
| 317 | i := 0; |
331 | i := 0; |
| 318 | WHILE i < n DO |
332 | WHILE i < n DO |
| 319 | IF endianness = little_endian THEN |
333 | IF endianness = little_endian THEN |
| 320 | PutByte(codes, ORD(codes.wstr[i]) MOD 256); |
334 | PutByte(ORD(codes.wstr[i]) MOD 256); |
| 321 | PutByte(codes, ORD(codes.wstr[i]) DIV 256) |
335 | PutByte(ORD(codes.wstr[i]) DIV 256) |
| 322 | ELSIF endianness = big_endian THEN |
336 | ELSIF endianness = big_endian THEN |
| 323 | PutByte(codes, ORD(codes.wstr[i]) DIV 256); |
337 | PutByte(ORD(codes.wstr[i]) DIV 256); |
| Line 324... | Line 338... | ||
| 324 | PutByte(codes, ORD(codes.wstr[i]) MOD 256) |
338 | PutByte(ORD(codes.wstr[i]) MOD 256) |
| 325 | END; |
339 | END; |
| Line 326... | Line 340... | ||
| 326 | INC(i) |
340 | INC(i) |
| 327 | END; |
341 | END; |
| Line 340... | Line 354... | ||
| 340 | BEGIN |
354 | BEGIN |
| 341 | IF codes.wcharoffs[c] = -1 THEN |
355 | IF codes.wcharoffs[c] = -1 THEN |
| 342 | res := CHL.Length(codes.data); |
356 | res := CHL.Length(codes.data); |
| Line 343... | Line 357... | ||
| 343 | 357 | ||
| 344 | IF ODD(res) THEN |
358 | IF ODD(res) THEN |
| 345 | PutByte(codes, 0); |
359 | PutByte(0); |
| 346 | INC(res) |
360 | INC(res) |
| Line 347... | Line 361... | ||
| 347 | END; |
361 | END; |
| 348 | 362 | ||
| 349 | IF endianness = little_endian THEN |
363 | IF endianness = little_endian THEN |
| 350 | PutByte(codes, c MOD 256); |
364 | PutByte(c MOD 256); |
| 351 | PutByte(codes, c DIV 256) |
365 | PutByte(c DIV 256) |
| 352 | ELSIF endianness = big_endian THEN |
366 | ELSIF endianness = big_endian THEN |
| 353 | PutByte(codes, c DIV 256); |
367 | PutByte(c DIV 256); |
| Line 354... | Line 368... | ||
| 354 | PutByte(codes, c MOD 256) |
368 | PutByte(c MOD 256) |
| 355 | END; |
369 | END; |
| Line 356... | Line 370... | ||
| 356 | 370 | ||
| 357 | PutByte(codes, 0); |
371 | PutByte(0); |
| 358 | PutByte(codes, 0); |
372 | PutByte(0); |
| 359 | 373 | ||
| Line 933... | Line 947... | ||
| 933 | INC(codes.fregs) |
947 | INC(codes.fregs) |
| 934 | RETURN codes.fregs < numRegsFloat |
948 | RETURN codes.fregs < numRegsFloat |
| 935 | END flt; |
949 | END flt; |
| Line 936... | Line -... | ||
| 936 | - | ||
| 937 | - | ||
| 938 | PROCEDURE odd*; |
- | |
| 939 | BEGIN |
- | |
| 940 | AddCmd0(opODD) |
- | |
| 941 | END odd; |
- | |
| 942 | - | ||
| 943 | - | ||
| 944 | PROCEDURE ord*; |
- | |
| 945 | BEGIN |
- | |
| 946 | AddCmd0(opORD) |
- | |
| 947 | END ord; |
- | |
| 948 | 950 | ||
| 949 | 951 | ||
| 950 | PROCEDURE shift_minmax* (op: CHAR); |
952 | PROCEDURE shift_minmax* (op: CHAR); |
| 951 | BEGIN |
953 | BEGIN |
| 952 | CASE op OF |
954 | CASE op OF |
| Line 1145... | Line 1147... | ||
| 1145 | commands := C.create(); |
1147 | commands := C.create(); |
| 1146 | variables := C.create(); |
1148 | variables := C.create(); |
| 1147 | numRegsFloat := pNumRegsFloat; |
1149 | numRegsFloat := pNumRegsFloat; |
| 1148 | endianness := pEndianness; |
1150 | endianness := pEndianness; |
| Line 1149... | Line -... | ||
| 1149 | - | ||
| 1150 | NEW(codes); |
1151 | |
| 1151 | NEW(codes.begcall); |
1152 | NEW(codes.begcall); |
| 1152 | codes.begcall.top := -1; |
1153 | codes.begcall.top := -1; |
| 1153 | NEW(codes.endcall); |
1154 | NEW(codes.endcall); |
| 1154 | codes.endcall.top := -1; |
1155 | codes.endcall.top := -1; |