1 | PROGRAM Compiler;
|
---|
2 |
|
---|
3 | {$APPTYPE CONSOLE}
|
---|
4 |
|
---|
5 |
|
---|
6 | {R-}
|
---|
7 | { $M 16384,0,655360 }
|
---|
8 |
|
---|
9 | CONST
|
---|
10 | maxSymLen = 16;
|
---|
11 | maxOpcdLen = 4;
|
---|
12 |
|
---|
13 | alphaNumeric = '1234567890$ABCDEFGHIJKLMNOPQRSTUVWXYZ_';
|
---|
14 | numeric = '1234567890';
|
---|
15 | hex = '0123456789ABCDEF';
|
---|
16 | white = #9' '; { A tab plus a space }
|
---|
17 |
|
---|
18 | o_Illegal = 0; { Opcode not found in FindOpcode }
|
---|
19 | o_None = 1; { No operands }
|
---|
20 | o_LD = 2; { Generic LD opcode }
|
---|
21 | o_EX = 3; { Generic EX opcode }
|
---|
22 | o_ADD = 4; { Generic ADD opcode }
|
---|
23 | o_ADC_SBC = 5; { Generic ADC and SBC opcodes }
|
---|
24 | o_INC_DEC = 6; { Generic INC and DEC opcodes }
|
---|
25 | o_JP_CALL = 7; { Generic JP and CALL opcodes }
|
---|
26 | o_JR = 8; { Generic JR opcode }
|
---|
27 | o_RET = 9; { Generic RET opcode }
|
---|
28 | o_IN = 10; { Generic IN opcode }
|
---|
29 | o_OUT = 11; { Generic OUT opcode }
|
---|
30 |
|
---|
31 | o_PushPop = 12; { PUSH and POP instructions }
|
---|
32 | o_Arith = 13; { Arithmetic instructions }
|
---|
33 | o_Rotate = 14; { Z-80 rotate instructions }
|
---|
34 | o_Bit = 15; { BIT, RES, and SET instructions }
|
---|
35 | o_IM = 16; { IM instruction }
|
---|
36 | o_DJNZ = 17; { DJNZ instruction }
|
---|
37 | o_RST = 18; { RST instruction }
|
---|
38 |
|
---|
39 | o_DB = 19; { DB pseudo-op }
|
---|
40 | o_DW = 20; { DW pseudo-op }
|
---|
41 | o_DS = 21; { DS pseudo-op }
|
---|
42 | o_EQU = -22; { EQU and SET pseudo-ops }
|
---|
43 | o_ORG = -23; { ORG pseudo-op }
|
---|
44 | o_END = 24; { END pseudo-op }
|
---|
45 | o_LIST = -25; { LIST pseudo-op }
|
---|
46 | o_OPT = -26; { OPT pseudo-op }
|
---|
47 |
|
---|
48 | regs = ' B C D E H L A I R BC DE HL SP IX IY AF ( ';
|
---|
49 | regVals = ' 0 1 2 3 4 5 7 8 9 10 11 12 13 14 15 16 17 ';
|
---|
50 |
|
---|
51 | reg_None = -1;
|
---|
52 | reg_B = 0;
|
---|
53 | reg_C = 1;
|
---|
54 | reg_D = 2;
|
---|
55 | reg_E = 3;
|
---|
56 | reg_H = 4;
|
---|
57 | reg_L = 5;
|
---|
58 | reg_M = 6;
|
---|
59 | reg_A = 7;
|
---|
60 | { reg_Byte = [reg_B..reg_A]; }
|
---|
61 | reg_I = 8;
|
---|
62 | reg_R = 9;
|
---|
63 | reg_BC = 10;
|
---|
64 | reg_DE = 11;
|
---|
65 | reg_HL = 12;
|
---|
66 | reg_SP = 13;
|
---|
67 | { reg_Word = [reg_BC..reg_SP]; }
|
---|
68 | reg_IX = 14;
|
---|
69 | reg_IY = 15;
|
---|
70 | reg_AF = 16;
|
---|
71 | reg_Paren = 17;
|
---|
72 |
|
---|
73 | conds = ' NZ Z NC C PO PE P M ';
|
---|
74 | condVals = ' 0 1 2 3 4 5 6 7 ';
|
---|
75 |
|
---|
76 | TYPE
|
---|
77 | SymStr = String[maxSymLen];
|
---|
78 |
|
---|
79 | SymPtr = ^SymRec;
|
---|
80 | SymRec = RECORD
|
---|
81 | name: SymStr; { Symbol name }
|
---|
82 | value: Integer; { Symbol value }
|
---|
83 | next: SymPtr; { Pointer to next symtab entry }
|
---|
84 | defined: Boolean; { TRUE if defined }
|
---|
85 | multiDef: Boolean; { TRUE if multiply defined }
|
---|
86 | isSet: Boolean; { TRUE if defined with SET pseudo }
|
---|
87 | equ: Boolean; { TRUE if defined with EQU pseudo }
|
---|
88 | END;
|
---|
89 |
|
---|
90 | OpcdStr = String[maxOpcdLen];
|
---|
91 |
|
---|
92 | OpcdPtr = ^OpcdRec;
|
---|
93 | OpcdRec = RECORD
|
---|
94 | name: OpcdStr; { Opcode name }
|
---|
95 | typ: Integer; { Opcode type }
|
---|
96 | parm: Integer; { Opcode parameter }
|
---|
97 | next: OpcdPtr; { Pointer to next opcode entry }
|
---|
98 | END;
|
---|
99 | { TP 3.0 does not know any length-less string variable }
|
---|
100 | string_tp = String[128];
|
---|
101 | { TP 3.0 does not know any machine dependant variable like 'word' }
|
---|
102 | word = integer;
|
---|
103 |
|
---|
104 | VAR
|
---|
105 | symTab: SymPtr; { Pointer to first entry in symtab }
|
---|
106 | opcdTab: OpcdPtr; { Opcode table }
|
---|
107 |
|
---|
108 | locPtr: Integer; { Current program address }
|
---|
109 | newLoc: Integer; { New program address }
|
---|
110 | updLoc: Boolean; { TRUE if newLoc needs to be written to file }
|
---|
111 | pass: Integer; { Current assembler pass }
|
---|
112 | errFlag: Boolean; { TRUE if error occurred this line }
|
---|
113 | errCount: Integer; { Total number of errors }
|
---|
114 |
|
---|
115 | line: string_tp; { Current line from input file }
|
---|
116 | listLine: string_tp; { Current listing line }
|
---|
117 | listFlag: Boolean; { FALSE to suppress listing source }
|
---|
118 | listThisLine: Boolean; { TRUE to force listing this line }
|
---|
119 | sourceEnd: Boolean; { TRUE when END pseudo encountered }
|
---|
120 |
|
---|
121 | instr: ARRAY[1..5] OF Integer; { Current instruction word }
|
---|
122 | instrLen: Integer; { Current instruction length }
|
---|
123 |
|
---|
124 | bytStr: string_tp; { Buffer for long DB statements }
|
---|
125 | showAddr: Boolean; { TRUE to show LocPtr on listing }
|
---|
126 | xferAddr: Integer; { Transfer address from END pseudo }
|
---|
127 | xferFound: Boolean; { TRUE if xfer addr defined w/ END }
|
---|
128 |
|
---|
129 | { Command line parameters }
|
---|
130 | cl_SrcName: string_tp; { Source file name }
|
---|
131 | cl_ListName: string_tp; { Listing file name }
|
---|
132 | cl_ObjName: string_tp; { objectt file name }
|
---|
133 | cl_Err: Boolean; { TRUE for errors to screen }
|
---|
134 |
|
---|
135 |
|
---|
136 | source: Text;
|
---|
137 | objectt: Text;
|
---|
138 | listing: Text;
|
---|
139 |
|
---|
140 |
|
---|
141 | FUNCTION Deblank(s: string_tp): string_tp;
|
---|
142 |
|
---|
143 | VAR
|
---|
144 | i: Integer;
|
---|
145 |
|
---|
146 | BEGIN
|
---|
147 | i := Length(s);
|
---|
148 | WHILE (i>0) AND (s[i] IN [#9,' ']) DO
|
---|
149 | i:=i-1;
|
---|
150 |
|
---|
151 | s[0] := CHR(i);
|
---|
152 |
|
---|
153 | i := 1;
|
---|
154 | WHILE (i<=Length(s)) AND (s[i] IN [#9,' ']) DO
|
---|
155 | i:=i+1;
|
---|
156 | Delete(s,1,i-1);
|
---|
157 |
|
---|
158 | Deblank := s;
|
---|
159 | END;
|
---|
160 |
|
---|
161 |
|
---|
162 | FUNCTION UprCase(s: string_tp): string_tp;
|
---|
163 |
|
---|
164 | VAR
|
---|
165 | i: Integer;
|
---|
166 |
|
---|
167 | BEGIN
|
---|
168 | FOR i := 1 TO Length(s) DO
|
---|
169 | IF s[i] IN ['a'..'z'] THEN
|
---|
170 | s[i] := UpCase(s[i]);
|
---|
171 |
|
---|
172 | UprCase := s;
|
---|
173 | END;
|
---|
174 |
|
---|
175 |
|
---|
176 | FUNCTION Hex2(i: Integer): string_tp;
|
---|
177 |
|
---|
178 | BEGIN
|
---|
179 | i := i AND 255;
|
---|
180 | Hex2 := Copy(hex,(i SHR 4)+1,1) + Copy(hex,(i AND 15)+1,1);
|
---|
181 | END;
|
---|
182 |
|
---|
183 |
|
---|
184 | FUNCTION Hex4(i: Integer): string_tp;
|
---|
185 |
|
---|
186 | BEGIN
|
---|
187 | Hex4 := Hex2(i SHR 8) + Hex2(i AND 255);
|
---|
188 | END;
|
---|
189 |
|
---|
190 |
|
---|
191 | PROCEDURE Error(message: string_tp);
|
---|
192 |
|
---|
193 | BEGIN
|
---|
194 | errFlag := TRUE;
|
---|
195 | errCount:=errCount+1;
|
---|
196 |
|
---|
197 | IF pass<>1 THEN BEGIN
|
---|
198 | listThisLine := TRUE;
|
---|
199 | WriteLn(listing,'*** Error: ',Message,' ***');
|
---|
200 | IF cl_Err THEN WriteLn('*** Error: ',Message,' ***');
|
---|
201 | END;
|
---|
202 | END;
|
---|
203 |
|
---|
204 |
|
---|
205 | PROCEDURE IllegalOperand;
|
---|
206 |
|
---|
207 | BEGIN
|
---|
208 | Error('Illegal operand');
|
---|
209 | line := '';
|
---|
210 | END;
|
---|
211 |
|
---|
212 |
|
---|
213 | PROCEDURE AddOpcode(name: OpcdStr; typ: Integer; parm: Word);
|
---|
214 | VAR
|
---|
215 | p: OpcdPtr;
|
---|
216 | BEGIN
|
---|
217 | New(p);
|
---|
218 |
|
---|
219 | p^.name := name;
|
---|
220 | p^.typ := typ;
|
---|
221 | p^.parm := parm;
|
---|
222 | p^.next := opcdTab;
|
---|
223 |
|
---|
224 | opcdTab := p;
|
---|
225 | END;
|
---|
226 |
|
---|
227 |
|
---|
228 | PROCEDURE FindOpcode(name: OpcdStr; VAR typ,parm: Integer);
|
---|
229 | VAR
|
---|
230 | p: OpcdPtr;
|
---|
231 | found: Boolean;
|
---|
232 |
|
---|
233 | BEGIN
|
---|
234 | found := FALSE;
|
---|
235 | p := opcdTab;
|
---|
236 |
|
---|
237 | WHILE (p<>NIL) AND NOT found DO BEGIN
|
---|
238 | found := (p^.name = name);
|
---|
239 | IF NOT found THEN
|
---|
240 | p := p^.next;
|
---|
241 | END;
|
---|
242 |
|
---|
243 | IF NOT found THEN BEGIN
|
---|
244 | typ := o_Illegal;
|
---|
245 | parm := 0;
|
---|
246 | END
|
---|
247 | ELSE BEGIN
|
---|
248 | typ := p^.typ;
|
---|
249 | parm := p^.parm;
|
---|
250 | END;
|
---|
251 | END;
|
---|
252 |
|
---|
253 |
|
---|
254 | PROCEDURE InitOpcodes;
|
---|
255 |
|
---|
256 | BEGIN
|
---|
257 | opcdTab := NIL;
|
---|
258 |
|
---|
259 | AddOpcode('EXX', o_None, $D9);
|
---|
260 | AddOpcode('LDI', o_None, $EDA0);
|
---|
261 | AddOpcode('LDIR', o_None, $EDB0);
|
---|
262 | AddOpcode('LDD', o_None, $EDA8);
|
---|
263 | AddOpcode('LDDR', o_None, $EDB8);
|
---|
264 | AddOpcode('CPI',o_None,$EDA1);
|
---|
265 | AddOpcode('CPIR',o_None,$EDB1);
|
---|
266 | AddOpcode('CPD' ,o_None,$EDA9);
|
---|
267 | AddOpcode('CPDR',o_None,$EDB9);
|
---|
268 | AddOpcode('DAA' ,o_None,$27);
|
---|
269 | AddOpcode('CPL' ,o_None,$2F);
|
---|
270 | AddOpcode('NEG' ,o_None,$ED44);
|
---|
271 | AddOpcode('CCF' ,o_None,$3F);
|
---|
272 | AddOpcode('SCF' ,o_None,$37);
|
---|
273 | AddOpcode('NOP' ,o_None,$00);
|
---|
274 | AddOpcode('HALT',o_None,$76);
|
---|
275 | AddOpcode('DI' ,o_None,$F3);
|
---|
276 | AddOpcode('EI' ,o_None,$FB);
|
---|
277 | AddOpcode('RLCA',o_None,$07);
|
---|
278 | AddOpcode('RLA' ,o_None,$17);
|
---|
279 | AddOpcode('RRCA',o_None,$0F);
|
---|
280 | AddOpcode('RRA' ,o_None,$1F);
|
---|
281 | AddOpcode('RLD' ,o_None,$ED6F);
|
---|
282 | AddOpcode('RRD' ,o_None,$ED67);
|
---|
283 | AddOpcode('RET' ,o_None,$C9);
|
---|
284 | AddOpcode('RETI',o_None,$ED4D);
|
---|
285 | AddOpcode('RETN',o_None,$ED45);
|
---|
286 | AddOpcode('INI' ,o_None,$EDA2);
|
---|
287 | AddOpcode('INIR',o_None,$EDB2);
|
---|
288 | AddOpcode('IND' ,o_None,$EDAA);
|
---|
289 | AddOpcode('INDR',o_None,$EDBA);
|
---|
290 | AddOpcode('OUTI',o_None,$EDA3);
|
---|
291 | AddOpcode('OTIR',o_None,$EDB3);
|
---|
292 | AddOpcode('OUTD',o_None,$EDAB);
|
---|
293 | AddOpcode('OTDR',o_None,$EDBB);
|
---|
294 |
|
---|
295 | AddOpcode('LD' ,o_LD,0);
|
---|
296 | AddOpcode('EX' ,o_EX,0);
|
---|
297 | AddOpcode('ADD' ,o_ADD,0);
|
---|
298 | AddOpcode('ADC' ,o_ADC_SBC,0);
|
---|
299 | AddOpcode('SBC' ,o_ADC_SBC,1);
|
---|
300 | AddOpcode('INC' ,o_INC_DEC,0);
|
---|
301 | AddOpcode('DEC' ,o_INC_DEC,1);
|
---|
302 | AddOpcode('JP' ,o_JP_CALL,$C3C2);
|
---|
303 | AddOpcode('CALL',o_JP_CALL,$CDC4);
|
---|
304 | AddOpcode('JR' ,o_JR,0);
|
---|
305 | AddOpcode('RET' ,o_RET,0);
|
---|
306 |
|
---|
307 | AddOpcode('PUSH',o_PushPop,$C5);
|
---|
308 | AddOpcode('POP' ,o_PushPop,$C1);
|
---|
309 |
|
---|
310 | AddOpcode('SUB' ,o_Arith,$D690);
|
---|
311 | AddOpcode('AND' ,o_Arith,$E6A0);
|
---|
312 | AddOpcode('XOR' ,o_Arith,$EEA8);
|
---|
313 | AddOpcode('OR' ,o_Arith,$F6B0);
|
---|
314 | AddOpcode('CP' ,o_Arith,$FEB8);
|
---|
315 |
|
---|
316 | AddOpcode('RLC' ,o_Rotate,$00);
|
---|
317 | AddOpcode('RRC' ,o_Rotate,$08);
|
---|
318 | AddOpcode('RL' ,o_Rotate,$10);
|
---|
319 | AddOpcode('RR' ,o_Rotate,$18);
|
---|
320 | AddOpcode('SLA' ,o_Rotate,$20);
|
---|
321 | AddOpcode('SRA' ,o_Rotate,$28);
|
---|
322 | AddOpcode('SRL' ,o_Rotate,$38);
|
---|
323 |
|
---|
324 | AddOpcode('BIT' ,o_Bit,$40);
|
---|
325 | AddOpcode('RES' ,o_Bit,$80);
|
---|
326 | AddOpcode('SET' ,o_Bit,$C0);
|
---|
327 |
|
---|
328 | AddOpcode('IM' ,o_IM,0);
|
---|
329 |
|
---|
330 | AddOpcode('DJNZ',o_DJNZ,0);
|
---|
331 |
|
---|
332 | AddOpcode('IN' ,o_IN,0);
|
---|
333 |
|
---|
334 | AddOpcode('OUT' ,o_OUT,0);
|
---|
335 |
|
---|
336 | AddOpcode('RST' ,o_RST,0);
|
---|
337 |
|
---|
338 | AddOpcode('DB' ,o_DB,0);
|
---|
339 | AddOpcode('DW' ,o_DW,0);
|
---|
340 | AddOpcode('DS' ,o_DS,0);
|
---|
341 |
|
---|
342 | AddOpcode('=' ,o_EQU,0);
|
---|
343 | AddOpcode('EQU' ,o_EQU,0);
|
---|
344 | {AddOpcode('SET' ,o_EQU,1);}
|
---|
345 | AddOpcode('DEFL',o_EQU,1);
|
---|
346 |
|
---|
347 | AddOpcode('ORG' ,o_ORG,0);
|
---|
348 | AddOpcode('END' ,o_END,0);
|
---|
349 | AddOpcode('LIST',o_LIST,0);
|
---|
350 | AddOpcode('OPT' ,o_OPT,0);
|
---|
351 | END;
|
---|
352 |
|
---|
353 |
|
---|
354 | FUNCTION FindSym(symName: SymStr): SymPtr;
|
---|
355 |
|
---|
356 | VAR
|
---|
357 | p: SymPtr;
|
---|
358 | found: Boolean;
|
---|
359 |
|
---|
360 | BEGIN
|
---|
361 | found := FALSE;
|
---|
362 | p := SymTab;
|
---|
363 | WHILE (p<>NIL) AND NOT Found DO BEGIN
|
---|
364 | found := (p^.name = symName);
|
---|
365 | IF NOT found THEN
|
---|
366 | p := p^.next;
|
---|
367 | END;
|
---|
368 |
|
---|
369 | FindSym := p;
|
---|
370 | END;
|
---|
371 |
|
---|
372 |
|
---|
373 | FUNCTION AddSym(symName: SymStr): SymPtr;
|
---|
374 | VAR
|
---|
375 | p: SymPtr;
|
---|
376 | BEGIN
|
---|
377 | New(p);
|
---|
378 |
|
---|
379 | WITH p^ DO BEGIN
|
---|
380 | name := SymName;
|
---|
381 | value := 0;
|
---|
382 | next := SymTab;
|
---|
383 | defined := FALSE;
|
---|
384 | multiDef := FALSE;
|
---|
385 | isSet := FALSE;
|
---|
386 | equ := FALSE;
|
---|
387 | END;
|
---|
388 |
|
---|
389 | symTab := p;
|
---|
390 | AddSym := p;
|
---|
391 | END;
|
---|
392 |
|
---|
393 | FUNCTION RefSym(symName: SymStr): Integer;
|
---|
394 | VAR
|
---|
395 | p: SymPtr;
|
---|
396 | BEGIN
|
---|
397 | p := FindSym(symName);
|
---|
398 | IF p=NIL THEN p := AddSym(symName);
|
---|
399 |
|
---|
400 | IF NOT p^.defined THEN
|
---|
401 | Error('Symbol "' + symName + '" undefined');
|
---|
402 |
|
---|
403 | RefSym := p^.value;
|
---|
404 | END;
|
---|
405 |
|
---|
406 |
|
---|
407 | PROCEDURE DefSym(symName: SymStr; val: Integer; setSym,equSym: Boolean);
|
---|
408 |
|
---|
409 | VAR
|
---|
410 | p: SymPtr;
|
---|
411 |
|
---|
412 | BEGIN
|
---|
413 | IF Length(symName)<>0 THEN BEGIN
|
---|
414 |
|
---|
415 | p := FindSym(symName);
|
---|
416 | IF p=NIL THEN p := AddSym(symName);
|
---|
417 |
|
---|
418 | IF (NOT p^.defined) OR (p^.isSet AND setSym) THEN BEGIN
|
---|
419 | p^.value := val;
|
---|
420 | p^.defined := TRUE;
|
---|
421 | p^.isSet := setSym;
|
---|
422 | p^.equ := equSym;
|
---|
423 | END
|
---|
424 | ELSE IF p^.value <> val THEN BEGIN
|
---|
425 | p^.multiDef := TRUE;
|
---|
426 | Error('Symbol "' + symName + '" multiply defined');
|
---|
427 | END;
|
---|
428 | END;
|
---|
429 | END;
|
---|
430 |
|
---|
431 |
|
---|
432 | FUNCTION GetWord: string_tp;
|
---|
433 |
|
---|
434 | VAR
|
---|
435 | word: string_tp;
|
---|
436 | done: Boolean;
|
---|
437 |
|
---|
438 | BEGIN
|
---|
439 | line := Deblank(line);
|
---|
440 | word := '';
|
---|
441 |
|
---|
442 | IF Length(line)>0 THEN
|
---|
443 | IF (line[1]=#12) OR (line[1]=';') THEN
|
---|
444 | line := '';
|
---|
445 |
|
---|
446 | IF Length(line)>0 THEN BEGIN
|
---|
447 | IF Pos(Upcase(line[1]),alphaNumeric)=0 THEN BEGIN
|
---|
448 | word := Copy(Line,1,1);
|
---|
449 | Delete(line,1,1);
|
---|
450 | END
|
---|
451 | ELSE BEGIN
|
---|
452 | done := FALSE;
|
---|
453 | WHILE (Length(line)>0) AND NOT done DO BEGIN
|
---|
454 | word := word + Upcase(line[1]);
|
---|
455 | Delete(line,1,1);
|
---|
456 | IF Length(line)>0 THEN
|
---|
457 | done := Pos(Upcase(line[1]),AlphaNumeric)=0;
|
---|
458 | END;
|
---|
459 | END;
|
---|
460 | END;
|
---|
461 |
|
---|
462 | GetWord := word;
|
---|
463 | END;
|
---|
464 |
|
---|
465 |
|
---|
466 | PROCEDURE Expect(expected: string_tp);
|
---|
467 |
|
---|
468 | BEGIN
|
---|
469 | IF GetWord<>expected THEN
|
---|
470 | Error('"' + expected + '" expected');
|
---|
471 | END;
|
---|
472 |
|
---|
473 |
|
---|
474 | PROCEDURE Comma;
|
---|
475 |
|
---|
476 | BEGIN
|
---|
477 | Expect(',');
|
---|
478 | END;
|
---|
479 |
|
---|
480 |
|
---|
481 | PROCEDURE RParen;
|
---|
482 |
|
---|
483 | BEGIN
|
---|
484 | Expect(')');
|
---|
485 | END;
|
---|
486 |
|
---|
487 |
|
---|
488 | FUNCTION EvalOct(octStr: string_tp): Integer;
|
---|
489 |
|
---|
490 | VAR
|
---|
491 | octVal: Integer;
|
---|
492 | evalErr: Boolean;
|
---|
493 | i,n: Integer;
|
---|
494 |
|
---|
495 | BEGIN
|
---|
496 | evalErr := FALSE;
|
---|
497 | octVal := 0;
|
---|
498 |
|
---|
499 | FOR i := 1 TO Length(octStr) DO BEGIN
|
---|
500 | n := Pos(octStr[i],'01234567');
|
---|
501 | IF n=0 THEN evalErr := TRUE
|
---|
502 | ELSE octVal := octVal*8 + n-1;
|
---|
503 | END;
|
---|
504 |
|
---|
505 | IF evalErr THEN BEGIN
|
---|
506 | octVal := 0;
|
---|
507 | Error('Invalid octal number');
|
---|
508 | END;
|
---|
509 |
|
---|
510 | EvalOct := octVal;
|
---|
511 | END;
|
---|
512 |
|
---|
513 |
|
---|
514 | FUNCTION EvalDec(decStr: string_tp): Integer;
|
---|
515 | VAR
|
---|
516 | decVal: Integer;
|
---|
517 | evalErr: Boolean;
|
---|
518 | i, n: Integer;
|
---|
519 | BEGIN
|
---|
520 | evalErr := FALSE;
|
---|
521 | decVal := 0;
|
---|
522 |
|
---|
523 | FOR i := 1 TO Length(decStr) DO BEGIN
|
---|
524 | n := Pos(decStr[i], '0123456789');
|
---|
525 | IF n = 0 THEN evalErr := TRUE
|
---|
526 | ELSE decVal := decVal*10 + n - 1;
|
---|
527 | END;
|
---|
528 |
|
---|
529 | IF evalErr THEN BEGIN
|
---|
530 | decVal := 0;
|
---|
531 | Error('Invalid decimal number');
|
---|
532 | END;
|
---|
533 |
|
---|
534 | EvalDec := decVal;
|
---|
535 | END;
|
---|
536 |
|
---|
537 |
|
---|
538 | FUNCTION EvalHex(hexStr: string_tp): Integer;
|
---|
539 |
|
---|
540 | VAR
|
---|
541 | hexVal: Integer;
|
---|
542 | evalErr: Boolean;
|
---|
543 | i,n: Integer;
|
---|
544 |
|
---|
545 | BEGIN
|
---|
546 | evalErr := FALSE;
|
---|
547 | hexVal := 0;
|
---|
548 |
|
---|
549 | FOR i := 1 TO Length(hexStr) DO BEGIN
|
---|
550 | n := Pos(Upcase(hexStr[i]),'0123456789ABCDEF');
|
---|
551 | IF n=0 THEN evalErr := TRUE
|
---|
552 | ELSE hexVal := hexVal*16 + n-1;
|
---|
553 | END;
|
---|
554 |
|
---|
555 | IF evalErr THEN BEGIN
|
---|
556 | hexVal := 0;
|
---|
557 | Error('Invalid hexadecimal number');
|
---|
558 | END;
|
---|
559 |
|
---|
560 | EvalHex := hexVal;
|
---|
561 | END;
|
---|
562 |
|
---|
563 | FUNCTION Factor: Integer; FORWARD;
|
---|
564 |
|
---|
565 | FUNCTION Term: Integer;
|
---|
566 |
|
---|
567 | VAR
|
---|
568 | word: string_tp;
|
---|
569 | val: Integer;
|
---|
570 | oldLine: string_tp;
|
---|
571 |
|
---|
572 | BEGIN
|
---|
573 | val := Factor;
|
---|
574 |
|
---|
575 | { oldLine := line;
|
---|
576 | word := GetWord;
|
---|
577 | WHILE ( word = '*' ) OR ( word = '/' ) OR ( word = '%' ) DO
|
---|
578 | BEGIN
|
---|
579 | CASE word[1] OF
|
---|
580 | '*': val := val * Factor;
|
---|
581 | '/': val := val DIV Factor;
|
---|
582 | '%': val := val MOD Factor;
|
---|
583 | END;
|
---|
584 | oldLine := line;
|
---|
585 | word := GetWord;
|
---|
586 | END;
|
---|
587 | line := oldLine;
|
---|
588 | }
|
---|
589 | Term := val;
|
---|
590 | END;
|
---|
591 |
|
---|
592 | FUNCTION Eval: Integer;
|
---|
593 |
|
---|
594 | VAR
|
---|
595 | word: string_tp;
|
---|
596 | val: Integer;
|
---|
597 | oldLine: string_tp;
|
---|
598 |
|
---|
599 | BEGIN
|
---|
600 | val := Term;
|
---|
601 |
|
---|
602 | oldLine := line;
|
---|
603 | word := GetWord;
|
---|
604 | WHILE (word='+') OR (word='-') {OR (word='*') OR (word='/')} DO BEGIN
|
---|
605 | CASE word[1] OF
|
---|
606 | '+': val := val + Term;
|
---|
607 | '-': val := val - Term;
|
---|
608 | END;
|
---|
609 | oldLine := line;
|
---|
610 | word := GetWord;
|
---|
611 | END;
|
---|
612 | line := oldLine;
|
---|
613 |
|
---|
614 | Eval := val;
|
---|
615 | END;
|
---|
616 |
|
---|
617 |
|
---|
618 | FUNCTION Factor;
|
---|
619 |
|
---|
620 | VAR
|
---|
621 | word: string_tp;
|
---|
622 | val: Integer;
|
---|
623 |
|
---|
624 | BEGIN
|
---|
625 | word := GetWord;
|
---|
626 | val := 0;
|
---|
627 | IF Length(word)=0 THEN Error('Missing operand')
|
---|
628 | ELSE IF (word='.') OR (word='*') THEN val := locPtr
|
---|
629 | ELSE IF word='$' THEN val := locPtr
|
---|
630 | ELSE IF word='-' THEN val := -Factor
|
---|
631 | ELSE IF word='+' THEN val := Factor
|
---|
632 | ELSE IF word='~' THEN val := -Factor-1
|
---|
633 | ELSE IF word='(' THEN BEGIN
|
---|
634 | val := Eval;
|
---|
635 | RParen;
|
---|
636 | END
|
---|
637 | ELSE IF word='''' THEN BEGIN
|
---|
638 | IF Length(line)=0 THEN
|
---|
639 | Error('Missing operand')
|
---|
640 | ELSE BEGIN
|
---|
641 | val := Ord(line[1]);
|
---|
642 | Delete(line,1,1);
|
---|
643 | Expect('''');
|
---|
644 | END;
|
---|
645 | END
|
---|
646 | ELSE IF Pos(word[1],numeric)>0 THEN BEGIN
|
---|
647 | CASE word[Length(word)] OF
|
---|
648 | 'O': val := EvalOct(Copy(word,1,Length(word)-1));
|
---|
649 | 'D': val := EvalDec(Copy(word,1,Length(word)-1));
|
---|
650 | 'H': val := EvalHex(Copy(word,1,Length(word)-1));
|
---|
651 | ELSE val := EvalDec(word);
|
---|
652 | END;
|
---|
653 | END
|
---|
654 | ELSE val := RefSym(word);
|
---|
655 |
|
---|
656 | Factor := val;
|
---|
657 | END;
|
---|
658 |
|
---|
659 |
|
---|
660 | FUNCTION EvalByte: Integer;
|
---|
661 |
|
---|
662 | VAR
|
---|
663 | val: Integer;
|
---|
664 |
|
---|
665 | BEGIN
|
---|
666 | val := Eval;
|
---|
667 |
|
---|
668 | IF (val<-128) OR (val>255) THEN
|
---|
669 | Error('Byte out of range');
|
---|
670 |
|
---|
671 | EvalByte := val AND 255;
|
---|
672 | END;
|
---|
673 |
|
---|
674 |
|
---|
675 | FUNCTION FindReg(regName,regList,valList: string_tp): Integer;
|
---|
676 |
|
---|
677 | VAR
|
---|
678 | p: Integer;
|
---|
679 | reg: Integer;
|
---|
680 | code: Integer;
|
---|
681 |
|
---|
682 | BEGIN
|
---|
683 | p := Pos(' ' + Deblank(regName) + ' ',regList);
|
---|
684 |
|
---|
685 | IF p=0 THEN reg := -1
|
---|
686 | ELSE IF valList[p+2]=' ' THEN Val(Copy(valList,p+1,1),reg,code)
|
---|
687 | ELSE Val(Copy(valList,p+1,2),reg,code);
|
---|
688 |
|
---|
689 | FindReg := reg;
|
---|
690 | END;
|
---|
691 |
|
---|
692 |
|
---|
693 | PROCEDURE CodeOut(byte: Integer);
|
---|
694 |
|
---|
695 | BEGIN
|
---|
696 | IF (pass=2) AND updLoc THEN BEGIN
|
---|
697 | WriteLn(objectt,':',Hex4(newLoc));
|
---|
698 | updLoc := FALSE;
|
---|
699 | END;
|
---|
700 |
|
---|
701 | IF pass=2 THEN
|
---|
702 | WriteLn(objectt,Hex2(byte));
|
---|
703 | END;
|
---|
704 |
|
---|
705 |
|
---|
706 | PROCEDURE CodeOrg(addr: Integer);
|
---|
707 |
|
---|
708 | BEGIN
|
---|
709 | locPtr := addr;
|
---|
710 | newLoc := locPtr;
|
---|
711 | updLoc := TRUE;
|
---|
712 | END;
|
---|
713 |
|
---|
714 |
|
---|
715 | PROCEDURE CodeFlush;
|
---|
716 |
|
---|
717 | BEGIN
|
---|
718 | { objectt file format does not use buffering; no flush needed }
|
---|
719 | END;
|
---|
720 |
|
---|
721 |
|
---|
722 | PROCEDURE CodeEnd;
|
---|
723 |
|
---|
724 | BEGIN
|
---|
725 | CodeFlush;
|
---|
726 |
|
---|
727 | IF (pass=2) AND xferFound THEN BEGIN
|
---|
728 | WriteLn(objectt,'$',Hex4(xferAddr));
|
---|
729 | END;
|
---|
730 | END;
|
---|
731 |
|
---|
732 |
|
---|
733 | PROCEDURE CodeXfer(addr: Integer);
|
---|
734 |
|
---|
735 | BEGIN
|
---|
736 | xferAddr := addr;
|
---|
737 | xferFound := TRUE;
|
---|
738 | END;
|
---|
739 |
|
---|
740 |
|
---|
741 | PROCEDURE Instr1(b: Byte);
|
---|
742 |
|
---|
743 | BEGIN
|
---|
744 | instr[1] := b;
|
---|
745 | instrLen := 1;
|
---|
746 | END;
|
---|
747 |
|
---|
748 |
|
---|
749 | PROCEDURE Instr2(b1,b2: Byte);
|
---|
750 |
|
---|
751 | BEGIN
|
---|
752 | instr[1] := b1;
|
---|
753 | instr[2] := b2;
|
---|
754 | instrLen := 2;
|
---|
755 | END;
|
---|
756 |
|
---|
757 |
|
---|
758 | PROCEDURE Instr3(b1,b2,b3: Byte);
|
---|
759 |
|
---|
760 | BEGIN
|
---|
761 | instr[1] := b1;
|
---|
762 | instr[2] := b2;
|
---|
763 | instr[3] := b3;
|
---|
764 | instrLen := 3;
|
---|
765 | END;
|
---|
766 |
|
---|
767 |
|
---|
768 | PROCEDURE Instr3W(b: Byte; w: Word);
|
---|
769 |
|
---|
770 | BEGIN
|
---|
771 | Instr3(b,w AND 255,w SHR 8);
|
---|
772 | END;
|
---|
773 |
|
---|
774 |
|
---|
775 | PROCEDURE Instr4(b1,b2,b3,b4: Byte);
|
---|
776 |
|
---|
777 | BEGIN
|
---|
778 | instr[1] := b1;
|
---|
779 | instr[2] := b2;
|
---|
780 | instr[3] := b3;
|
---|
781 | instr[4] := b4;
|
---|
782 | instrLen := 4;
|
---|
783 | END;
|
---|
784 |
|
---|
785 |
|
---|
786 | PROCEDURE Instr4W(b1,b2: Byte; w: Word);
|
---|
787 |
|
---|
788 | BEGIN
|
---|
789 | Instr4(b1,b2,w AND 255,w SHR 8);
|
---|
790 | END;
|
---|
791 |
|
---|
792 |
|
---|
793 | PROCEDURE DoOpcode(typ: Integer; parm: Word);
|
---|
794 |
|
---|
795 | VAR
|
---|
796 | val: Integer;
|
---|
797 | reg1: Integer;
|
---|
798 | reg2: Integer;
|
---|
799 | word: string_tp;
|
---|
800 | oldLine: string_tp;
|
---|
801 |
|
---|
802 | PROCEDURE IXOffset;
|
---|
803 | BEGIN
|
---|
804 | word := GetWord;
|
---|
805 | IF word=')' THEN val := 0
|
---|
806 | ELSE IF (word='+') OR (word='-') THEN BEGIN
|
---|
807 | val := Eval;
|
---|
808 | IF word='-' THEN val := -val;
|
---|
809 | RParen;
|
---|
810 | END;
|
---|
811 | END;
|
---|
812 |
|
---|
813 | PROCEDURE DoArith(imm,reg: Integer);
|
---|
814 | BEGIN
|
---|
815 | oldLine := line;
|
---|
816 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
817 | CASE reg2 OF
|
---|
818 | reg_None: { ADD A,nn }
|
---|
819 | BEGIN
|
---|
820 | line := oldLine;
|
---|
821 | val := Eval;
|
---|
822 | Instr2(imm,val);
|
---|
823 | END;
|
---|
824 |
|
---|
825 | reg_B,
|
---|
826 | reg_C,
|
---|
827 | reg_D,
|
---|
828 | reg_E,
|
---|
829 | reg_H,
|
---|
830 | reg_L,
|
---|
831 | reg_A: { ADD A,r }
|
---|
832 | Instr1(reg + reg2);
|
---|
833 |
|
---|
834 | reg_Paren:
|
---|
835 | BEGIN
|
---|
836 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
837 | CASE reg2 OF
|
---|
838 | reg_HL:
|
---|
839 | BEGIN
|
---|
840 | RParen;
|
---|
841 | Instr1(reg+reg_M);
|
---|
842 | END;
|
---|
843 |
|
---|
844 | reg_IX,
|
---|
845 | reg_IY:
|
---|
846 | BEGIN
|
---|
847 | IXOffset;
|
---|
848 | IF reg2=reg_IX
|
---|
849 | THEN Instr3($DD,reg+reg_M,val)
|
---|
850 | ELSE Instr3($FD,reg+reg_M,val);
|
---|
851 | END;
|
---|
852 |
|
---|
853 | ELSE IllegalOperand;
|
---|
854 | END;
|
---|
855 | END;
|
---|
856 |
|
---|
857 | ELSE IllegalOperand;
|
---|
858 | END;
|
---|
859 | END;
|
---|
860 |
|
---|
861 | BEGIN
|
---|
862 | CASE typ OF
|
---|
863 | o_None:
|
---|
864 | IF parm>255 THEN Instr2(parm SHR 8,parm AND 255)
|
---|
865 | ELSE Instr1(parm);
|
---|
866 |
|
---|
867 | o_LD:
|
---|
868 | BEGIN
|
---|
869 | word := GetWord;
|
---|
870 | reg1 := FindReg(word,regs,regVals);
|
---|
871 |
|
---|
872 | CASE reg1 OF
|
---|
873 | reg_None: { LD nnnn,? }
|
---|
874 | IllegalOperand;
|
---|
875 |
|
---|
876 | reg_B,
|
---|
877 | reg_C,
|
---|
878 | reg_D,
|
---|
879 | reg_E,
|
---|
880 | reg_H,
|
---|
881 | reg_L,
|
---|
882 | reg_A: { LD r,? }
|
---|
883 | BEGIN
|
---|
884 | Comma;
|
---|
885 | oldLine := line;
|
---|
886 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
887 |
|
---|
888 | CASE reg2 OF
|
---|
889 | reg_B,
|
---|
890 | reg_C,
|
---|
891 | reg_D,
|
---|
892 | reg_E,
|
---|
893 | reg_H,
|
---|
894 | reg_L,
|
---|
895 | reg_A: { LD r,r }
|
---|
896 | Instr1($40 + reg1*8 + reg2);
|
---|
897 |
|
---|
898 | reg_I: { LD A,I }
|
---|
899 | Instr2($ED,$57);
|
---|
900 |
|
---|
901 | reg_R: { LD A,R }
|
---|
902 | Instr2($ED,$5F);
|
---|
903 |
|
---|
904 | reg_Paren: { LD r,(?) }
|
---|
905 | BEGIN
|
---|
906 | oldLine := line;
|
---|
907 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
908 |
|
---|
909 | CASE reg2 OF
|
---|
910 | reg_BC, { LD A,(BC) }
|
---|
911 | reg_DE: { LD A,(DE) }
|
---|
912 | IF reg1<>reg_A THEN IllegalOperand
|
---|
913 | ELSE BEGIN
|
---|
914 | RParen;
|
---|
915 | Instr1($0A + (reg2-reg_BC)*16);
|
---|
916 | END;
|
---|
917 |
|
---|
918 | reg_HL: { LD r,(HL) }
|
---|
919 | BEGIN
|
---|
920 | RParen;
|
---|
921 | Instr1($40 + reg1*8 + reg_M);
|
---|
922 | END;
|
---|
923 |
|
---|
924 | reg_IX, { LD r,(IX+d) }
|
---|
925 | reg_IY: { LD r,(IY+d) }
|
---|
926 | BEGIN
|
---|
927 | IXOffset;
|
---|
928 | IF reg2=reg_IX
|
---|
929 | THEN Instr3($DD,$46 + reg1*8,val)
|
---|
930 | ELSE Instr3($FD,$46 + reg1*8,val);
|
---|
931 | END;
|
---|
932 |
|
---|
933 | reg_None: { LD A,(nnnn) }
|
---|
934 | IF reg1<>reg_A THEN IllegalOperand
|
---|
935 | ELSE BEGIN
|
---|
936 | line := oldLine;
|
---|
937 | val := Eval;
|
---|
938 | RParen;
|
---|
939 | Instr3W($3A,val);
|
---|
940 | END;
|
---|
941 |
|
---|
942 | ELSE IllegalOperand;
|
---|
943 | END;
|
---|
944 | END;
|
---|
945 |
|
---|
946 | reg_None: { LD r,nn }
|
---|
947 | BEGIN
|
---|
948 | line := oldLine;
|
---|
949 | Instr2($06 + reg1*8,Eval);
|
---|
950 | END;
|
---|
951 |
|
---|
952 | ELSE IllegalOperand;
|
---|
953 | END; { CASE reg2 }
|
---|
954 | END; { reg_Byte }
|
---|
955 |
|
---|
956 | reg_I:
|
---|
957 | BEGIN { LD I,A }
|
---|
958 | Comma;
|
---|
959 | Expect('A');
|
---|
960 | Instr2($ED,$47);
|
---|
961 | END;
|
---|
962 |
|
---|
963 | reg_R:
|
---|
964 | BEGIN { LD R,A }
|
---|
965 | Comma;
|
---|
966 | Expect('A');
|
---|
967 | Instr2($ED,$4F);
|
---|
968 | END;
|
---|
969 |
|
---|
970 | reg_BC,
|
---|
971 | reg_DE,
|
---|
972 | reg_HL,
|
---|
973 | reg_SP:
|
---|
974 | BEGIN { LD rr,? }
|
---|
975 | Comma;
|
---|
976 | oldLine := line;
|
---|
977 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
978 |
|
---|
979 | IF (reg1=reg_SP) AND { LD SP,HL }
|
---|
980 | (reg2 IN [reg_HL,reg_IX,reg_IY]) THEN BEGIN
|
---|
981 | CASE reg2 OF
|
---|
982 | reg_HL: Instr1($F9);
|
---|
983 | reg_IX: Instr2($DD,$F9);
|
---|
984 | reg_IY: Instr2($FD,$F9);
|
---|
985 | END;
|
---|
986 | END
|
---|
987 |
|
---|
988 | ELSE IF (reg1=reg_HL) AND (reg2=reg_Paren) THEN BEGIN
|
---|
989 | val := Eval; { LD HL,(nnnn) }
|
---|
990 | RParen;
|
---|
991 | Instr3W($2A,val);
|
---|
992 | END
|
---|
993 |
|
---|
994 | ELSE IF reg2=reg_Paren THEN BEGIN
|
---|
995 | val := Eval; { LD BC,(nnnn) }
|
---|
996 | RParen;
|
---|
997 | Instr4W($ED,$4B + (reg1-reg_BC)*16,val);
|
---|
998 | END
|
---|
999 |
|
---|
1000 | ELSE IF reg2=reg_None THEN BEGIN { LD rr,nnnn }
|
---|
1001 | line := oldLine;
|
---|
1002 | val := Eval;
|
---|
1003 | Instr3W($01 + (reg1-reg_BC)*16,val);
|
---|
1004 | END
|
---|
1005 |
|
---|
1006 | ELSE IllegalOperand;
|
---|
1007 | END;
|
---|
1008 |
|
---|
1009 | reg_IX, { LD IX,? }
|
---|
1010 | reg_IY: { LD IY,? }
|
---|
1011 | BEGIN
|
---|
1012 | Comma;
|
---|
1013 | oldLine := line;
|
---|
1014 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1015 |
|
---|
1016 | CASE reg2 OF
|
---|
1017 | reg_None: { LD IX,nnnn }
|
---|
1018 | BEGIN
|
---|
1019 | line := oldLine;
|
---|
1020 | val := Eval;
|
---|
1021 | IF reg1=reg_IX THEN Instr4W($DD,$21,val)
|
---|
1022 | ELSE Instr4W($FD,$21,val);
|
---|
1023 | END;
|
---|
1024 |
|
---|
1025 | reg_Paren: { LD IX,(nnnn) }
|
---|
1026 | BEGIN
|
---|
1027 | val := Eval;
|
---|
1028 | RParen;
|
---|
1029 | IF reg1=reg_IX THEN Instr4W($DD,$2A,val)
|
---|
1030 | ELSE Instr4W($FD,$2A,val);
|
---|
1031 | END;
|
---|
1032 |
|
---|
1033 | ELSE IllegalOperand;
|
---|
1034 | END;
|
---|
1035 | END;
|
---|
1036 |
|
---|
1037 | reg_Paren: { LD (?),? }
|
---|
1038 | BEGIN
|
---|
1039 | oldLine := line;
|
---|
1040 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1041 |
|
---|
1042 | CASE reg1 OF
|
---|
1043 | reg_None: { LD (nnnn),? }
|
---|
1044 | BEGIN
|
---|
1045 | line := oldLine;
|
---|
1046 | val := Eval;
|
---|
1047 | RParen;
|
---|
1048 | Comma;
|
---|
1049 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1050 |
|
---|
1051 | CASE reg2 OF
|
---|
1052 | reg_A: Instr3W($32,val);
|
---|
1053 | reg_HL: Instr3W($22,val);
|
---|
1054 | reg_BC,
|
---|
1055 | reg_DE,
|
---|
1056 | reg_SP: Instr4W($ED,$43+(reg2-reg_BC)*16,val);
|
---|
1057 | reg_IX: Instr4W($DD,$22,val);
|
---|
1058 | reg_IY: Instr4W($FD,$22,val);
|
---|
1059 | ELSE IllegalOperand;
|
---|
1060 | END; { CASE reg2 }
|
---|
1061 | END;
|
---|
1062 |
|
---|
1063 | reg_BC,
|
---|
1064 | reg_DE:
|
---|
1065 | BEGIN
|
---|
1066 | RParen;
|
---|
1067 | Comma;
|
---|
1068 | Expect('A');
|
---|
1069 | Instr1($02+(reg1-reg_BC)*16);
|
---|
1070 | END;
|
---|
1071 |
|
---|
1072 | reg_HL: { LD (HL),? }
|
---|
1073 | BEGIN
|
---|
1074 | RParen;
|
---|
1075 | Comma;
|
---|
1076 | oldLine := line;
|
---|
1077 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1078 | IF reg2=reg_None THEN BEGIN
|
---|
1079 | line := oldLine;
|
---|
1080 | val := Eval;
|
---|
1081 | Instr2($36,val);
|
---|
1082 | END
|
---|
1083 | ELSE IF reg2 IN [ 0..7 ] THEN
|
---|
1084 | Instr1($70 + reg2)
|
---|
1085 | ELSE IllegalOperand;
|
---|
1086 | END;
|
---|
1087 |
|
---|
1088 | reg_IX,
|
---|
1089 | reg_IY: { LD (IX),? }
|
---|
1090 | BEGIN
|
---|
1091 | IXOffset;
|
---|
1092 | Comma;
|
---|
1093 | oldLine := line;
|
---|
1094 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1095 | IF reg2=reg_None THEN BEGIN
|
---|
1096 | line := oldLine;
|
---|
1097 | reg2 := Eval;
|
---|
1098 | IF reg1=reg_IX
|
---|
1099 | THEN Instr4($DD,$36,val,reg2)
|
---|
1100 | ELSE Instr4($FD,$36,val,reg2);
|
---|
1101 | END
|
---|
1102 | ELSE IF reg2 IN [ 0..7 ] THEN
|
---|
1103 | IF reg1=reg_IX
|
---|
1104 | THEN Instr3($DD,$70 + reg2,val)
|
---|
1105 | ELSE Instr3($FD,$70 + reg2,val)
|
---|
1106 | ELSE IllegalOperand;
|
---|
1107 | END;
|
---|
1108 | END; { CASE reg1 }
|
---|
1109 | END; { reg_Paren }
|
---|
1110 |
|
---|
1111 | ELSE IllegalOperand;
|
---|
1112 |
|
---|
1113 | END; { CASE reg1 }
|
---|
1114 | END; { o_LD }
|
---|
1115 |
|
---|
1116 | o_EX:
|
---|
1117 | BEGIN
|
---|
1118 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1119 | CASE reg1 OF
|
---|
1120 | reg_DE: { EX DE,HL }
|
---|
1121 | BEGIN
|
---|
1122 | Comma;
|
---|
1123 | Expect('HL');
|
---|
1124 | Instr1($EB);
|
---|
1125 | END;
|
---|
1126 |
|
---|
1127 | reg_AF: { EX AF,AF' }
|
---|
1128 | BEGIN
|
---|
1129 | Comma;
|
---|
1130 | Expect('AF');
|
---|
1131 | Expect('''');
|
---|
1132 | Instr1($08);
|
---|
1133 | END;
|
---|
1134 |
|
---|
1135 | reg_Paren: { EX (SP),? }
|
---|
1136 | BEGIN
|
---|
1137 | Expect('SP');
|
---|
1138 | RParen;
|
---|
1139 | Comma;
|
---|
1140 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1141 | CASE reg2 OF
|
---|
1142 | reg_HL: Instr1($E3);
|
---|
1143 | reg_IX: Instr2($DD,$E3);
|
---|
1144 | reg_IY: Instr2($FD,$E3);
|
---|
1145 | ELSE IllegalOperand;
|
---|
1146 | END;
|
---|
1147 | END;
|
---|
1148 |
|
---|
1149 | ELSE IllegalOperand;
|
---|
1150 | END; { CASE reg1 }
|
---|
1151 | END; { o_EX }
|
---|
1152 |
|
---|
1153 | o_ADD:
|
---|
1154 | BEGIN
|
---|
1155 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1156 | CASE reg1 OF
|
---|
1157 | reg_A:
|
---|
1158 | BEGIN
|
---|
1159 | Comma;
|
---|
1160 | DoArith($C6,$80);
|
---|
1161 | END;
|
---|
1162 |
|
---|
1163 | reg_HL,
|
---|
1164 | reg_IX,
|
---|
1165 | reg_IY:
|
---|
1166 | BEGIN
|
---|
1167 | Comma;
|
---|
1168 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1169 | IF reg2=reg1 THEN reg2 := reg_HL;
|
---|
1170 | IF reg2 IN [ 10..13 ] THEN BEGIN
|
---|
1171 | CASE reg1 OF
|
---|
1172 | reg_HL: Instr1($09 + (reg2-reg_BC)*16);
|
---|
1173 | reg_IX: Instr2($DD,$09 + (reg2-reg_BC)*16);
|
---|
1174 | reg_IY: Instr2($FD,$09 + (reg2-reg_BC)*16);
|
---|
1175 | END;
|
---|
1176 | END
|
---|
1177 | ELSE IllegalOperand;
|
---|
1178 | END;
|
---|
1179 | ELSE IllegalOperand;
|
---|
1180 | END; { CASE reg1 }
|
---|
1181 | END; { o_ADD }
|
---|
1182 |
|
---|
1183 | o_ADC_SBC:
|
---|
1184 | BEGIN
|
---|
1185 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1186 | CASE reg1 OF
|
---|
1187 | reg_A:
|
---|
1188 | BEGIN
|
---|
1189 | Comma;
|
---|
1190 | DoArith($CE+parm*16,$88+parm*16);
|
---|
1191 | END;
|
---|
1192 |
|
---|
1193 | reg_HL:
|
---|
1194 | BEGIN
|
---|
1195 | Comma;
|
---|
1196 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1197 | IF reg2 IN [ 10..13 ]
|
---|
1198 | THEN Instr2($ED,$4A + (reg2-reg_BC)*16 - parm*8)
|
---|
1199 | ELSE IllegalOperand;
|
---|
1200 | END;
|
---|
1201 |
|
---|
1202 | ELSE IllegalOperand;
|
---|
1203 | END; { CASE reg1 }
|
---|
1204 | END; { o_ADC_SBC }
|
---|
1205 |
|
---|
1206 | o_INC_DEC:
|
---|
1207 | BEGIN
|
---|
1208 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1209 | CASE reg1 OF
|
---|
1210 | reg_B,
|
---|
1211 | reg_C,
|
---|
1212 | reg_D,
|
---|
1213 | reg_E,
|
---|
1214 | reg_H,
|
---|
1215 | reg_L,
|
---|
1216 | reg_A: { INC r }
|
---|
1217 | Instr1($04 + reg1*8 + parm);
|
---|
1218 |
|
---|
1219 | reg_BC,
|
---|
1220 | reg_DE,
|
---|
1221 | reg_HL,
|
---|
1222 | reg_SP: { INC rr }
|
---|
1223 | Instr1($03 + (reg1-reg_BC)*16 + parm*8);
|
---|
1224 |
|
---|
1225 | reg_IX: Instr2($DD,$23 + parm*8);
|
---|
1226 | reg_IY: Instr2($FD,$23 + parm*8);
|
---|
1227 |
|
---|
1228 | reg_Paren: { INC (HL) }
|
---|
1229 | BEGIN
|
---|
1230 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1231 | CASE reg1 OF
|
---|
1232 | reg_HL:
|
---|
1233 | BEGIN
|
---|
1234 | RParen;
|
---|
1235 | Instr1($34 + parm);
|
---|
1236 | END;
|
---|
1237 |
|
---|
1238 | reg_IX,
|
---|
1239 | reg_IY:
|
---|
1240 | BEGIN
|
---|
1241 | IXOffset;
|
---|
1242 | IF reg1=reg_IX
|
---|
1243 | THEN Instr3($DD,$34 + parm,val)
|
---|
1244 | ELSE Instr3($FD,$34 + parm,val);
|
---|
1245 | END;
|
---|
1246 |
|
---|
1247 | ELSE IllegalOperand;
|
---|
1248 | END;
|
---|
1249 | END;
|
---|
1250 | END;
|
---|
1251 | END; { o_INC_DEC }
|
---|
1252 |
|
---|
1253 | o_JP_CALL:
|
---|
1254 | BEGIN
|
---|
1255 | oldLine := line;
|
---|
1256 | word := GetWord;
|
---|
1257 | IF word='(' THEN BEGIN
|
---|
1258 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1259 | RParen;
|
---|
1260 | CASE reg1 OF
|
---|
1261 | reg_HL: Instr1($E9);
|
---|
1262 | reg_IX: Instr2($DD,$E9);
|
---|
1263 | reg_IY: Instr2($FD,$E9);
|
---|
1264 | ELSE IllegalOperand;
|
---|
1265 | END;
|
---|
1266 | END
|
---|
1267 | ELSE BEGIN
|
---|
1268 | reg1 := FindReg(word,conds,condVals);
|
---|
1269 | IF reg1=reg_None THEN BEGIN
|
---|
1270 | line := oldLine;
|
---|
1271 | val := Eval;
|
---|
1272 | Instr3W(parm SHR 8,val);
|
---|
1273 | END
|
---|
1274 | ELSE BEGIN
|
---|
1275 | Comma;
|
---|
1276 | val := Eval;
|
---|
1277 | Instr3W((parm AND 255) + reg1*8,val);
|
---|
1278 | END;
|
---|
1279 | END;
|
---|
1280 | END; { o_JP_CALL }
|
---|
1281 |
|
---|
1282 | o_JR:
|
---|
1283 | BEGIN
|
---|
1284 | oldLine := line;
|
---|
1285 | reg1 := FindReg(GetWord,conds,condVals);
|
---|
1286 | IF reg1=reg_None THEN BEGIN
|
---|
1287 | line := oldLine;
|
---|
1288 | val := Eval;
|
---|
1289 | val := val - locPtr - 2;
|
---|
1290 | IF (val<-128) OR (val>127) THEN
|
---|
1291 | Error('Branch out of range');
|
---|
1292 | Instr2($18,val);
|
---|
1293 | END
|
---|
1294 | ELSE IF reg1>=4 THEN
|
---|
1295 | IllegalOperand
|
---|
1296 | ELSE BEGIN
|
---|
1297 | Comma;
|
---|
1298 | val := Eval;
|
---|
1299 | val := val - locPtr - 2;
|
---|
1300 | IF (val<-128) OR (val>127) THEN
|
---|
1301 | Error('Branch out of range');
|
---|
1302 | Instr2($20 + reg1*8,val);
|
---|
1303 | END;
|
---|
1304 | END; { o_JR }
|
---|
1305 |
|
---|
1306 | o_RET:
|
---|
1307 | BEGIN
|
---|
1308 | reg1 := FindReg(GetWord,conds,condVals);
|
---|
1309 | IF reg1=reg_None THEN Instr1($C9)
|
---|
1310 | ELSE Instr1($C0 + reg1*8);
|
---|
1311 | END; { o_RET }
|
---|
1312 |
|
---|
1313 | o_IN:
|
---|
1314 | BEGIN
|
---|
1315 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1316 | IF NOT (reg1 IN [reg_B..reg_A]) THEN
|
---|
1317 | IllegalOperand
|
---|
1318 | ELSE BEGIN
|
---|
1319 | Comma;
|
---|
1320 | Expect('(');
|
---|
1321 | oldLine := line;
|
---|
1322 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1323 |
|
---|
1324 | IF (reg1=reg_A) AND (reg2=reg_none) THEN BEGIN
|
---|
1325 | line := oldLine;
|
---|
1326 | val := Eval;
|
---|
1327 | RParen;
|
---|
1328 | Instr2($DB,val);
|
---|
1329 | END
|
---|
1330 | ELSE IF reg2=reg_C THEN BEGIN
|
---|
1331 | RParen;
|
---|
1332 | Instr2($ED,$40 + reg1*8)
|
---|
1333 | END
|
---|
1334 | ELSE IllegalOperand;
|
---|
1335 | END;
|
---|
1336 | END; { o_IN }
|
---|
1337 |
|
---|
1338 | o_OUT:
|
---|
1339 | BEGIN
|
---|
1340 | Expect('(');
|
---|
1341 | oldLine := line;
|
---|
1342 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1343 |
|
---|
1344 | IF reg1=reg_None THEN BEGIN
|
---|
1345 | line := oldLine;
|
---|
1346 | val := Eval;
|
---|
1347 | RParen;
|
---|
1348 | Comma;
|
---|
1349 | Expect('A');
|
---|
1350 | Instr2($D3,val);
|
---|
1351 | END
|
---|
1352 | ELSE IF reg1=reg_C THEN BEGIN
|
---|
1353 | RParen;
|
---|
1354 | Comma;
|
---|
1355 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1356 | IF reg2 IN [reg_B..reg_A] THEN BEGIN
|
---|
1357 | Instr2($ED,$41 + reg2*8);
|
---|
1358 | END
|
---|
1359 | ELSE IllegalOperand;
|
---|
1360 | END
|
---|
1361 | ELSE IllegalOperand;
|
---|
1362 | END; { o_OUT }
|
---|
1363 |
|
---|
1364 | o_PushPop:
|
---|
1365 | BEGIN
|
---|
1366 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1367 | CASE reg1 OF
|
---|
1368 | reg_BC,
|
---|
1369 | reg_DE,
|
---|
1370 | reg_HL: Instr1(parm + (reg1-reg_BC)*16);
|
---|
1371 | reg_AF: Instr1(parm + $30);
|
---|
1372 | reg_IX: Instr2($DD,parm + $20);
|
---|
1373 | reg_IY: Instr2($FD,parm + $20);
|
---|
1374 | ELSE IllegalOperand;
|
---|
1375 | END;
|
---|
1376 | END;
|
---|
1377 |
|
---|
1378 | o_Arith:
|
---|
1379 | DoArith(parm SHR 8,parm AND 255);
|
---|
1380 |
|
---|
1381 | o_Rotate:
|
---|
1382 | BEGIN
|
---|
1383 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1384 | CASE reg1 OF
|
---|
1385 | reg_B,
|
---|
1386 | reg_C,
|
---|
1387 | reg_D,
|
---|
1388 | reg_E,
|
---|
1389 | reg_H,
|
---|
1390 | reg_L,
|
---|
1391 | reg_A: { RLC r }
|
---|
1392 | Instr2($CB,parm+reg1);
|
---|
1393 |
|
---|
1394 | reg_Paren:
|
---|
1395 | BEGIN
|
---|
1396 | reg1 := FindReg(GetWord,regs,regVals);
|
---|
1397 | CASE reg1 OF
|
---|
1398 | reg_HL:
|
---|
1399 | BEGIN
|
---|
1400 | RParen;
|
---|
1401 | Instr2($CB,parm+reg_M);
|
---|
1402 | END;
|
---|
1403 |
|
---|
1404 | reg_IX,
|
---|
1405 | reg_IY:
|
---|
1406 | BEGIN
|
---|
1407 | IXOffset;
|
---|
1408 | IF reg1=reg_IX
|
---|
1409 | THEN Instr4($DD,$CB,val,parm+reg_M)
|
---|
1410 | ELSE Instr4($FD,$CB,val,parm+reg_M);
|
---|
1411 | END;
|
---|
1412 |
|
---|
1413 | ELSE IllegalOperand;
|
---|
1414 | END;
|
---|
1415 | END;
|
---|
1416 |
|
---|
1417 | ELSE IllegalOperand;
|
---|
1418 | END; { CASE reg1 }
|
---|
1419 | END; { o_Rotate }
|
---|
1420 |
|
---|
1421 | o_Bit:
|
---|
1422 | BEGIN
|
---|
1423 | reg1 := Eval;
|
---|
1424 | Comma;
|
---|
1425 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1426 | CASE reg2 OF
|
---|
1427 | reg_B,
|
---|
1428 | reg_C,
|
---|
1429 | reg_D,
|
---|
1430 | reg_E,
|
---|
1431 | reg_H,
|
---|
1432 | reg_L,
|
---|
1433 | reg_A: { BIT n,r }
|
---|
1434 | Instr2($CB,parm + reg1*8 + reg2);
|
---|
1435 |
|
---|
1436 | reg_Paren: { BIT n,(HL) }
|
---|
1437 | BEGIN
|
---|
1438 | reg2 := FindReg(GetWord,regs,regVals);
|
---|
1439 | CASE reg2 OF
|
---|
1440 | reg_HL:
|
---|
1441 | BEGIN
|
---|
1442 | RParen;
|
---|
1443 | Instr2($CB,parm + reg1*8 + reg_M);
|
---|
1444 | END;
|
---|
1445 |
|
---|
1446 | reg_IX,
|
---|
1447 | reg_IY:
|
---|
1448 | BEGIN
|
---|
1449 | IXOffset;
|
---|
1450 | IF reg1=reg_IX
|
---|
1451 | THEN Instr4($DD,$CB,val,parm + reg1*8 + reg_M)
|
---|
1452 | ELSE Instr4($FD,$CB,val,parm + reg1*8 + reg_M);
|
---|
1453 | END;
|
---|
1454 |
|
---|
1455 | ELSE IllegalOperand;
|
---|
1456 | END;
|
---|
1457 | END;
|
---|
1458 | END; { CASE reg2 }
|
---|
1459 | END; { o_Bit }
|
---|
1460 |
|
---|
1461 | o_IM:
|
---|
1462 | BEGIN
|
---|
1463 | word := GetWord;
|
---|
1464 | IF word='0' THEN Instr2($ED,$46)
|
---|
1465 | ELSE IF word='1' THEN Instr2($ED,$56)
|
---|
1466 | ELSE IF word='2' THEN Instr2($ED,$5E)
|
---|
1467 | ELSE IllegalOperand;
|
---|
1468 | END;
|
---|
1469 |
|
---|
1470 | o_DJNZ:
|
---|
1471 | BEGIN
|
---|
1472 | val := Eval;
|
---|
1473 | val := val - locPtr - 2;
|
---|
1474 | IF (val < -128) OR (val > 127) THEN
|
---|
1475 | Error('Branch out of range');
|
---|
1476 | Instr2($10, val);
|
---|
1477 | END;
|
---|
1478 |
|
---|
1479 | o_RST:
|
---|
1480 | BEGIN
|
---|
1481 | val := Eval;
|
---|
1482 | IF val IN [0..7] THEN
|
---|
1483 | Instr1($C7 + val*8)
|
---|
1484 | ELSE IF val IN [$08,$10,$18,$20,$28,$30,$38] THEN
|
---|
1485 | Instr1($C7 + val)
|
---|
1486 | ELSE IllegalOperand;
|
---|
1487 | END;
|
---|
1488 |
|
---|
1489 | o_DB:
|
---|
1490 | BEGIN
|
---|
1491 | bytStr := '';
|
---|
1492 |
|
---|
1493 | oldLine := line;
|
---|
1494 | word := GetWord;
|
---|
1495 |
|
---|
1496 | IF (word='') OR (word=';') THEN
|
---|
1497 | Error('Missing operand');
|
---|
1498 |
|
---|
1499 | WHILE (word<>'') AND (word<>';') DO BEGIN
|
---|
1500 | IF word='''' THEN
|
---|
1501 | WHILE word='''' DO BEGIN
|
---|
1502 | val := Pos('''',line);
|
---|
1503 | IF val=0 THEN BEGIN
|
---|
1504 | bytStr := bytStr + line;
|
---|
1505 | line := '';
|
---|
1506 | word := '';
|
---|
1507 | END
|
---|
1508 | ELSE BEGIN
|
---|
1509 | bytStr := bytStr + Copy(line,1,val-1);
|
---|
1510 | Delete(line,1,val);
|
---|
1511 | word := GetWord;
|
---|
1512 | IF word='''' THEN bytStr := bytStr + '''';
|
---|
1513 | END;
|
---|
1514 | END
|
---|
1515 |
|
---|
1516 | ELSE BEGIN
|
---|
1517 | line := oldLine;
|
---|
1518 | bytStr := bytStr + CHR(EvalByte);
|
---|
1519 | END;
|
---|
1520 |
|
---|
1521 | word := GetWord;
|
---|
1522 | oldLine := line;
|
---|
1523 |
|
---|
1524 | IF word=',' THEN BEGIN
|
---|
1525 | word := GetWord;
|
---|
1526 | IF (word='') OR (word=';') THEN
|
---|
1527 | Error('Missing operand');
|
---|
1528 | END;
|
---|
1529 | END;
|
---|
1530 | instrLen := -Length(bytStr);
|
---|
1531 | END;
|
---|
1532 |
|
---|
1533 | o_DW:
|
---|
1534 | BEGIN
|
---|
1535 | bytStr := '';
|
---|
1536 |
|
---|
1537 | oldLine := line;
|
---|
1538 | word := GetWord;
|
---|
1539 |
|
---|
1540 | IF (word='') OR (word=';') THEN
|
---|
1541 | Error('Missing operand');
|
---|
1542 |
|
---|
1543 | WHILE (word<>'') AND (word<>';') DO BEGIN
|
---|
1544 | line := oldLine;
|
---|
1545 | val := Eval;
|
---|
1546 | bytStr := bytStr + CHR(val AND 255) + CHR(val SHR 8);
|
---|
1547 |
|
---|
1548 | word := GetWord;
|
---|
1549 | oldLine := line;
|
---|
1550 |
|
---|
1551 | IF word=',' THEN BEGIN
|
---|
1552 | word := GetWord;
|
---|
1553 | IF (word='') OR (word=';') THEN
|
---|
1554 | Error('Missing operand');
|
---|
1555 | END;
|
---|
1556 | END;
|
---|
1557 | instrLen := -Length(bytStr);
|
---|
1558 | END;
|
---|
1559 |
|
---|
1560 | o_DS: BEGIN
|
---|
1561 | val := Eval;
|
---|
1562 |
|
---|
1563 | IF pass=2 THEN BEGIN
|
---|
1564 | showAddr := FALSE;
|
---|
1565 | Delete(listLine,1,12);
|
---|
1566 | listLine := Hex4(locPtr) + ' (' + Hex4(val) + ')'
|
---|
1567 | + listLine;
|
---|
1568 | END;
|
---|
1569 |
|
---|
1570 | val := val + locPtr;
|
---|
1571 | CodeOrg(val);
|
---|
1572 | END;
|
---|
1573 |
|
---|
1574 | o_END: BEGIN
|
---|
1575 | oldLine := line;
|
---|
1576 |
|
---|
1577 | IF Length(GetWord)<>0 THEN BEGIN
|
---|
1578 | line := oldLine;
|
---|
1579 | val := Eval;
|
---|
1580 | CodeXfer(val);
|
---|
1581 | line := Copy(line,1,6) + '(' + Hex4(val) + ')' +
|
---|
1582 | Copy(line,13,255);
|
---|
1583 | END;
|
---|
1584 |
|
---|
1585 | sourceEnd := TRUE;
|
---|
1586 | END;
|
---|
1587 |
|
---|
1588 | ELSE Error('Unknown opcode');
|
---|
1589 | END;
|
---|
1590 | END;
|
---|
1591 |
|
---|
1592 |
|
---|
1593 | PROCEDURE DoLabelOp(typ,parm: Integer; labl: SymStr);
|
---|
1594 |
|
---|
1595 | VAR
|
---|
1596 | val: Integer;
|
---|
1597 | word: string_tp;
|
---|
1598 |
|
---|
1599 | BEGIN
|
---|
1600 | CASE typ OF
|
---|
1601 | o_EQU: BEGIN
|
---|
1602 | IF Length(labl)=0 THEN
|
---|
1603 | Error('Missing label')
|
---|
1604 | ELSE BEGIN
|
---|
1605 | val := Eval;
|
---|
1606 |
|
---|
1607 | listLine := Copy(listLine,1,5) + '= ' + Hex4(val) +
|
---|
1608 | Copy(listLine,12,255);
|
---|
1609 |
|
---|
1610 | DefSym(labl,val,parm=1,parm=0);
|
---|
1611 | END;
|
---|
1612 | END;
|
---|
1613 |
|
---|
1614 |
|
---|
1615 | o_ORG: BEGIN
|
---|
1616 | CodeOrg(Eval);
|
---|
1617 | DefSym(labl,locPtr,FALSE,FALSE);
|
---|
1618 | showAddr := TRUE;
|
---|
1619 | END;
|
---|
1620 |
|
---|
1621 | o_LIST: BEGIN
|
---|
1622 | listThisLine := TRUE;
|
---|
1623 |
|
---|
1624 | IF Length(labl)<>0 THEN
|
---|
1625 | Error('Label not allowed');
|
---|
1626 |
|
---|
1627 | word := GetWord;
|
---|
1628 | IF word='ON' THEN listFlag := TRUE
|
---|
1629 | ELSE IF word='OFF' THEN listFlag := FALSE
|
---|
1630 | ELSE IllegalOperand;
|
---|
1631 | END;
|
---|
1632 |
|
---|
1633 | o_OPT: BEGIN
|
---|
1634 | listThisLine := TRUE;
|
---|
1635 |
|
---|
1636 | IF Length(labl)<>0 THEN
|
---|
1637 | Error('Label not allowed');
|
---|
1638 |
|
---|
1639 | word := GetWord;
|
---|
1640 | IF word='LIST' THEN listFlag := TRUE
|
---|
1641 | ELSE IF word='NOLIST' THEN listFlag := FALSE
|
---|
1642 | ELSE Error('Illegal option');
|
---|
1643 | END;
|
---|
1644 |
|
---|
1645 | ELSE Error('Unknown opcode');
|
---|
1646 | END;
|
---|
1647 | END;
|
---|
1648 |
|
---|
1649 |
|
---|
1650 | PROCEDURE ListOut;
|
---|
1651 |
|
---|
1652 | VAR
|
---|
1653 | i: Integer;
|
---|
1654 |
|
---|
1655 | BEGIN
|
---|
1656 | IF Deblank(listLine) = #12 THEN
|
---|
1657 | WriteLn(listing,#12)
|
---|
1658 |
|
---|
1659 | ELSE IF Deblank(listLine)='' THEN
|
---|
1660 | WriteLn(listing)
|
---|
1661 |
|
---|
1662 | ELSE BEGIN
|
---|
1663 | i := Length(listLine);
|
---|
1664 | WHILE (i>0) AND (listLine[i]=' ') DO
|
---|
1665 | i:=i-1;
|
---|
1666 | listLine[0] := CHR(i);
|
---|
1667 |
|
---|
1668 | WriteLn(listing,listLine);
|
---|
1669 | IF errFlag AND cl_Err THEN
|
---|
1670 | WriteLn(listLine);
|
---|
1671 | END;
|
---|
1672 | END;
|
---|
1673 |
|
---|
1674 |
|
---|
1675 | PROCEDURE DoPass;
|
---|
1676 |
|
---|
1677 | VAR
|
---|
1678 | labl: SymStr;
|
---|
1679 | opcode: OpcdStr;
|
---|
1680 | typ: Integer;
|
---|
1681 | parm: Integer;
|
---|
1682 | i: Integer;
|
---|
1683 | word: string_tp;
|
---|
1684 |
|
---|
1685 | BEGIN
|
---|
1686 | Assign(source, cl_SrcName);
|
---|
1687 | Reset(source);
|
---|
1688 | sourceEnd := FALSE;
|
---|
1689 |
|
---|
1690 | WriteLn('Pass ',pass);
|
---|
1691 |
|
---|
1692 | CodeOrg(0);
|
---|
1693 | errCount := 0;
|
---|
1694 | listFlag := TRUE;
|
---|
1695 |
|
---|
1696 | WHILE (NOT Eof(source)) AND (NOT SourceEnd) DO BEGIN
|
---|
1697 | ReadLn(source,line);
|
---|
1698 |
|
---|
1699 | errFlag := FALSE;
|
---|
1700 | instrLen := 0;
|
---|
1701 | showAddr := FALSE;
|
---|
1702 | listThisLine := ListFlag;
|
---|
1703 | listLine := ' '; { 16 blanks }
|
---|
1704 |
|
---|
1705 | IF Pass=2 THEN listLine := Copy(listLine, 1, 16) + line;
|
---|
1706 |
|
---|
1707 | labl := '';
|
---|
1708 |
|
---|
1709 | IF Length(line) > 0 THEN
|
---|
1710 | IF Pos(line[1], white) = 0 THEN BEGIN
|
---|
1711 | labl := GetWord;
|
---|
1712 | showAddr := (Length(labl) <> 0);
|
---|
1713 |
|
---|
1714 | IF Length(line) > 0 THEN
|
---|
1715 | IF line[1] = ':' THEN
|
---|
1716 | Delete(line, 1, 1);
|
---|
1717 |
|
---|
1718 | END;
|
---|
1719 |
|
---|
1720 | opcode := GetWord;
|
---|
1721 | IF Length(opcode) = 0 THEN BEGIN
|
---|
1722 | typ := 0;
|
---|
1723 | DefSym(labl, locPtr, FALSE, FALSE);
|
---|
1724 | END
|
---|
1725 | ELSE BEGIN
|
---|
1726 | FindOpcode(opcode, typ, parm);
|
---|
1727 |
|
---|
1728 | IF typ = o_Illegal THEN Error('Illegal opcode "' +
|
---|
1729 | Deblank(opcode) + '"')
|
---|
1730 | ELSE IF typ < 0 THEN BEGIN
|
---|
1731 | showAddr := FALSE;
|
---|
1732 | DoLabelOp(typ, parm, labl);
|
---|
1733 | END
|
---|
1734 | ELSE BEGIN
|
---|
1735 | showAddr := TRUE;
|
---|
1736 | DefSym(labl, locPtr, FALSE, FALSE);
|
---|
1737 | DoOpcode(typ, parm);
|
---|
1738 | END;
|
---|
1739 |
|
---|
1740 | IF typ <> o_Illegal THEN
|
---|
1741 | IF Length(GetWord) > 0 THEN
|
---|
1742 | Error('Too many operands');
|
---|
1743 | END;
|
---|
1744 |
|
---|
1745 | IF Pass = 2 THEN BEGIN
|
---|
1746 | IF ShowAddr THEN
|
---|
1747 | listLine := Hex4(locPtr) + Copy(listLine, 5, 255);
|
---|
1748 |
|
---|
1749 | IF instrLen > 0 THEN
|
---|
1750 | FOR i := 1 TO instrLen DO BEGIN
|
---|
1751 | word := Hex2(instr[i]);
|
---|
1752 | listLine[i * 2 + 4] := word[1];
|
---|
1753 | listLine[i * 2 + 5] := word[2];
|
---|
1754 | CodeOut(instr[I]);
|
---|
1755 | END
|
---|
1756 | ELSE FOR i := 1 TO -instrLen DO BEGIN
|
---|
1757 | IF I <= 5 THEN BEGIN
|
---|
1758 | word := Hex2(ORD(bytStr[i]));
|
---|
1759 | listLine[i * 2 + 4] := word[1];
|
---|
1760 | listLine[i * 2 + 5] := word[2];
|
---|
1761 | END;
|
---|
1762 | CodeOut(ORD(bytStr[i]));
|
---|
1763 | END;
|
---|
1764 |
|
---|
1765 | IF listThisLine THEN ListOut;
|
---|
1766 | END;
|
---|
1767 |
|
---|
1768 | locPtr := locPtr + ABS(instrLen);
|
---|
1769 | END;
|
---|
1770 |
|
---|
1771 | IF Pass=2 THEN CodeEnd;
|
---|
1772 |
|
---|
1773 | { Put the lines after the END statement into the listing file }
|
---|
1774 | { while still checking for listing control statements. Ignore }
|
---|
1775 | { any lines which have invalid syntax, etc., because whatever }
|
---|
1776 | { is found after an END statement should esentially be ignored. }
|
---|
1777 |
|
---|
1778 | IF Pass = 2 THEN
|
---|
1779 | WHILE NOT Eof(source) DO BEGIN
|
---|
1780 | listThisLine := listFlag;
|
---|
1781 | listLine := ' ' + line; { 16 blanks }
|
---|
1782 |
|
---|
1783 | IF Length(line)>0 THEN
|
---|
1784 | IF Pos(line[1],white)<>0 THEN BEGIN
|
---|
1785 | word := GetWord;
|
---|
1786 | IF Length(word)<>0 THEN BEGIN
|
---|
1787 | IF word='LIST' THEN
|
---|
1788 | BEGIN
|
---|
1789 | listThisLine := TRUE;
|
---|
1790 | word := GetWord;
|
---|
1791 |
|
---|
1792 | IF word='ON' THEN listFlag := TRUE
|
---|
1793 | ELSE IF word='OFF' THEN listFlag := FALSE
|
---|
1794 | ELSE listThisLine := listFlag;
|
---|
1795 | END
|
---|
1796 |
|
---|
1797 | ELSE IF word='OPT' THEN
|
---|
1798 | BEGIN
|
---|
1799 | listThisLine := TRUE;
|
---|
1800 | word := GetWord;
|
---|
1801 |
|
---|
1802 | IF word='LIST' THEN listFlag := TRUE
|
---|
1803 | ELSE IF word='NOLIST' THEN listFlag := FALSE
|
---|
1804 | ELSE listThisLine := listFlag;
|
---|
1805 | END;
|
---|
1806 | END;
|
---|
1807 | END;
|
---|
1808 |
|
---|
1809 | IF listThisLine THEN ListOut;
|
---|
1810 | END;
|
---|
1811 |
|
---|
1812 | Close(source);
|
---|
1813 | END;
|
---|
1814 |
|
---|
1815 |
|
---|
1816 | PROCEDURE SortSymTab;
|
---|
1817 |
|
---|
1818 | VAR
|
---|
1819 | i,j,t: SymPtr;
|
---|
1820 | sorted: Boolean;
|
---|
1821 | temp: SymRec;
|
---|
1822 |
|
---|
1823 | BEGIN
|
---|
1824 | IF symTab <> NIL THEN BEGIN
|
---|
1825 |
|
---|
1826 | i := symTab;
|
---|
1827 | j := i^.next;
|
---|
1828 | WHILE (j<>NIL) DO BEGIN
|
---|
1829 | sorted := TRUE;
|
---|
1830 |
|
---|
1831 | WHILE (j<>NIL) DO BEGIN
|
---|
1832 | IF j^.name < i^.name THEN BEGIN
|
---|
1833 | temp := i^;
|
---|
1834 | i^ := j^;
|
---|
1835 | j^ := temp;
|
---|
1836 |
|
---|
1837 | t := i^.next;
|
---|
1838 | i^.next := j^.next;
|
---|
1839 | j^.next := t;
|
---|
1840 |
|
---|
1841 | sorted := FALSE;
|
---|
1842 | END;
|
---|
1843 | j := j^.next;
|
---|
1844 | END;
|
---|
1845 | i := i^.next;
|
---|
1846 | j := i^.next;
|
---|
1847 | END;
|
---|
1848 | END;
|
---|
1849 | END;
|
---|
1850 |
|
---|
1851 |
|
---|
1852 | PROCEDURE DumpSym(p: SymPtr);
|
---|
1853 |
|
---|
1854 | BEGIN
|
---|
1855 | Write(listing,p^.name:maxSymLen,' ',Hex4(p^.value));
|
---|
1856 |
|
---|
1857 | IF NOT p^.defined THEN Write(listing,' U');
|
---|
1858 | IF p^.multiDef THEN Write(listing,' M');
|
---|
1859 | IF p^.isSet THEN Write(listing,' S');
|
---|
1860 | IF p^.equ THEN Write(listing,' E');
|
---|
1861 |
|
---|
1862 | WriteLn(listing);
|
---|
1863 | END;
|
---|
1864 |
|
---|
1865 |
|
---|
1866 | PROCEDURE DumpSymTab;
|
---|
1867 |
|
---|
1868 | VAR
|
---|
1869 | p: SymPtr;
|
---|
1870 |
|
---|
1871 | BEGIN
|
---|
1872 | SortSymTab;
|
---|
1873 |
|
---|
1874 | p := symTab;
|
---|
1875 | WHILE (p<>NIL) DO BEGIN
|
---|
1876 | DumpSym(p);
|
---|
1877 | p := p^.next;
|
---|
1878 | END;
|
---|
1879 | END;
|
---|
1880 |
|
---|
1881 |
|
---|
1882 | PROCEDURE ShowOptions;
|
---|
1883 |
|
---|
1884 | BEGIN
|
---|
1885 | WriteLn;
|
---|
1886 | WriteLn(' Command line syntax:');
|
---|
1887 | WriteLn;
|
---|
1888 | WriteLn(' ASM8080 [options] src [options]');
|
---|
1889 | WriteLn;
|
---|
1890 | WriteLn(' Valid options:');
|
---|
1891 | WriteLn;
|
---|
1892 | WriteLn(' -E Show errors to screen');
|
---|
1893 | WriteLn(' -L Make a listing file to src.LIS');
|
---|
1894 | WriteLn(' -L=name');
|
---|
1895 | WriteLn(' -O Make an objectt file to src.OBJ');
|
---|
1896 | WriteLn(' -O=name');
|
---|
1897 | WriteLn;
|
---|
1898 | END;
|
---|
1899 |
|
---|
1900 |
|
---|
1901 | FUNCTION GetOption(VAR optStr: String_tp): String_tp;
|
---|
1902 |
|
---|
1903 | VAR
|
---|
1904 | option: String[80];
|
---|
1905 | p: Integer;
|
---|
1906 |
|
---|
1907 | BEGIN
|
---|
1908 | optStr := Deblank(optStr);
|
---|
1909 |
|
---|
1910 | p := Pos(' ',optStr);
|
---|
1911 |
|
---|
1912 | IF p=0 THEN BEGIN
|
---|
1913 | option := optStr;
|
---|
1914 | optStr := '';
|
---|
1915 | END
|
---|
1916 | ELSE BEGIN
|
---|
1917 | option := Copy(optStr,1,p-1);
|
---|
1918 | optStr := Copy(optStr,p+1,255);
|
---|
1919 | END;
|
---|
1920 |
|
---|
1921 | optStr := UprCase(Deblank(optStr));
|
---|
1922 |
|
---|
1923 | GetOption := option;
|
---|
1924 | END;
|
---|
1925 |
|
---|
1926 |
|
---|
1927 | FUNCTION GetOptions(VAR cl_SrcName, cl_ListName,cl_ObjName: String_tp;
|
---|
1928 | VAR cl_Err: Boolean): Boolean;
|
---|
1929 |
|
---|
1930 | VAR
|
---|
1931 | s: String_tp;
|
---|
1932 | len: Integer;
|
---|
1933 | optStr: String_tp;
|
---|
1934 | option: String_tp;
|
---|
1935 | optParm: String_tp;
|
---|
1936 | prefix: String_tp;
|
---|
1937 | p: Integer;
|
---|
1938 | err: Integer;
|
---|
1939 | optErr: Boolean;
|
---|
1940 | i: Integer;
|
---|
1941 |
|
---|
1942 | BEGIN
|
---|
1943 | cl_SrcName := '';
|
---|
1944 | cl_ListName := 'NUL';
|
---|
1945 | cl_ObjName := 'NUL';
|
---|
1946 | cl_Err := FALSE;
|
---|
1947 |
|
---|
1948 | optErr := FALSE;
|
---|
1949 | optStr := ParamStr(1);
|
---|
1950 | FOR i := 2 TO ParamCount DO
|
---|
1951 | optStr := optStr + ' ' + ParamStr(i);
|
---|
1952 |
|
---|
1953 | option := GetOption(optStr);
|
---|
1954 | WHILE Length(option)<>0 DO BEGIN
|
---|
1955 | optParm := '';
|
---|
1956 |
|
---|
1957 | p := Pos('=',option);
|
---|
1958 | IF p>0 THEN BEGIN
|
---|
1959 | optParm := Copy(option,p+1,255);
|
---|
1960 | option := Copy(option,1,p-1);
|
---|
1961 | END;
|
---|
1962 |
|
---|
1963 | IF option = '-L' THEN cl_ListName := optParm
|
---|
1964 | ELSE IF option = '-O' THEN cl_ObjName := optParm
|
---|
1965 | ELSE IF option = '-E' THEN cl_Err := TRUE
|
---|
1966 | ELSE IF option = '?' THEN optErr := TRUE
|
---|
1967 | ELSE BEGIN
|
---|
1968 | IF (Copy(option,1,1)='-') OR (Length(cl_SrcName)<>0) OR
|
---|
1969 | (Length(optParm)<>0) THEN BEGIN
|
---|
1970 | optErr := TRUE;
|
---|
1971 | WriteLn('Illegal command line option: ',option);
|
---|
1972 | END
|
---|
1973 | ELSE BEGIN
|
---|
1974 | cl_SrcName := option;
|
---|
1975 | IF Pos('.',cl_SrcName)=0 THEN
|
---|
1976 | IF p=0 THEN cl_SrcName := cl_SrcName + '.ASM';
|
---|
1977 |
|
---|
1978 | p := Pos('.',option);
|
---|
1979 | IF p=0 THEN prefix := option
|
---|
1980 | ELSE prefix := Copy(option,1,p-1);
|
---|
1981 | END;
|
---|
1982 | END;
|
---|
1983 |
|
---|
1984 | option := GetOption(optStr);
|
---|
1985 | END;
|
---|
1986 |
|
---|
1987 | IF cl_SrcName = '' THEN BEGIN
|
---|
1988 | optErr := TRUE;
|
---|
1989 | WriteLn('Source file not specified')
|
---|
1990 | END;
|
---|
1991 |
|
---|
1992 | IF cl_ListName = '' THEN cl_ListName := prefix + '.LIS';
|
---|
1993 | IF cl_ObjName = '' THEN cl_ObjName := prefix + '.DAT';
|
---|
1994 | IF Copy(cl_ListName,1,1)='.' THEN cl_ListName := prefix + cl_ListName;
|
---|
1995 | IF Copy(cl_ObjName ,1,1)='.' THEN cl_ObjName := prefix + cl_ObjName;
|
---|
1996 |
|
---|
1997 | GetOptions := optErr;
|
---|
1998 | END;
|
---|
1999 |
|
---|
2000 |
|
---|
2001 | BEGIN
|
---|
2002 | IF GetOptions(cl_SrcName,cl_ListName,cl_ObjName,cl_Err) THEN BEGIN
|
---|
2003 | ShowOptions;
|
---|
2004 | ReadLn;
|
---|
2005 | Halt;
|
---|
2006 | END;
|
---|
2007 |
|
---|
2008 | Assign(listing,cl_ListName);
|
---|
2009 | Rewrite(listing);
|
---|
2010 | Assign(objectt,cl_ObjName);
|
---|
2011 | Rewrite(objectt);
|
---|
2012 |
|
---|
2013 | symTab := NIL;
|
---|
2014 | xferAddr := 0;
|
---|
2015 | xferFound := FALSE;
|
---|
2016 | InitOpcodes;
|
---|
2017 |
|
---|
2018 | pass := 1;
|
---|
2019 | DoPass;
|
---|
2020 |
|
---|
2021 | pass := 2;
|
---|
2022 | DoPass;
|
---|
2023 |
|
---|
2024 | WriteLn(listing);
|
---|
2025 | WriteLn(listing,errCount:5,' Total Error(s)');
|
---|
2026 | WriteLn(listing);
|
---|
2027 |
|
---|
2028 | IF cl_Err THEN BEGIN
|
---|
2029 | WriteLn;
|
---|
2030 | WriteLn(errCount:5,' Total Error(s)');
|
---|
2031 | END;
|
---|
2032 |
|
---|
2033 | DumpSymTab;
|
---|
2034 |
|
---|
2035 | Close(listing);
|
---|
2036 | Close(objectt);
|
---|
2037 | ReadLn;
|
---|
2038 | END.
|
---|