/src/asm8080.pas
Pascal | 1283 lines | 1007 code | 268 blank | 8 comment | 0 complexity | 8fec3d8b3935361b2002758cfd5a618f MD5 | raw file
1PROGRAM Asm8080; 2 3{R-} 4{$M 16384,0,655360} 5 6CONST 7 maxSymLen = 16; 8 maxOpcdLen = 4; 9 10 alphaNumeric = '1234567890$ABCDEFGHIJKLMNOPQRSTUVWXYZ_'; 11 numeric = '1234567890'; 12 hex = '0123456789ABCDEF'; 13 white = #9' '; { A tab plus a space } 14 15 o_Illegal = 0; { Opcode not found in FindOpcode } 16 o_None = 1; { No operands } 17 o_One = 2; { One byte immediate operand } 18 o_Two = 3; { Two byte immediate operand } 19 o_InrDcr = 4; { INR or DCR instruction } 20 o_Arith = 5; { Register to accumulator arithmetic } 21 o_MOV = 6; { MOV instruction } 22 o_MVI = 7; { MVI instruction } 23 o_LXI = 8; { LXI instruction } 24 o_InxDcx = 9; { INX, DCX, and DAD instructions } 25 o_PushPop = 10; { PUSH and POP instructions } 26 o_StaxLdax = 11; { STAX and LDAX instructions } 27 o_RST = 12; { RST instruction } 28 o_DB = 13; { DB pseudo-op } 29 o_DW = 14; { DW pseudo-op } 30 o_DS = 15; { DS pseudo-op } 31 o_EQU = -16; { EQU and SET pseudo-ops } 32 o_ORG = -17; { ORG pseudo-op } 33 o_END = 18; { END pseudo-op } 34 o_LIST = -19; { LIST pseudo-op } 35 o_OPT = -20; { OPT pseudo-op } 36 37 regs = ' B C D E H L M A '; 38 regVals = ' 0 1 2 3 4 5 6 7 '; 39 40 regPairs = ' B D H SP BC DE HL '; 41 regPairVals = ' 0 1 2 3 0 1 2 '; 42 43 pushRegs = ' B D H PSW BC DE HL AF '; 44 pushRegVals = ' 0 1 2 3 0 1 2 3 '; 45 46 staxRegs = ' B D BC DE '; 47 staxRegVals = ' 0 1 0 1 '; 48 49TYPE 50 SymStr = String[maxSymLen]; 51 52 SymPtr = ^SymRec; 53 SymRec = RECORD 54 name: SymStr; { Symbol name } 55 value: Integer; { Symbol value } 56 next: SymPtr; { Pointer to next symtab entry } 57 defined: Boolean; { TRUE if defined } 58 multiDef: Boolean; { TRUE if multiply defined } 59 isSet: Boolean; { TRUE if defined with SET pseudo } 60 equ: Boolean; { TRUE if defined with EQU pseudo } 61 END; 62 63 OpcdStr = String[maxOpcdLen]; 64 65 OpcdPtr = ^OpcdRec; 66 OpcdRec = RECORD 67 name: OpcdStr; { Opcode name } 68 typ: Integer; { Opcode type } 69 parm: Integer; { Opcode parameter } 70 next: OpcdPtr; { Pointer to next opcode entry } 71 END; 72 73VAR 74 symTab: SymPtr; { Pointer to first entry in symtab } 75 opcdTab: OpcdPtr; { Opcode table } 76 77 locPtr: Integer; { Current program address } 78 pass: Integer; { Current assembler pass } 79 errFlag: Boolean; { TRUE if error occurred this line } 80 errCount: Integer; { Total number of errors } 81 82 line: String; { Current line from input file } 83 listLine: String; { Current listing line } 84 listFlag: Boolean; { FALSE to suppress listing source } 85 listThisLine: Boolean; { TRUE to force listing this line } 86 sourceEnd: Boolean; { TRUE when END pseudo encountered } 87 88 instr: ARRAY[1..3] OF Integer; { Current instruction word } 89 instrLen: Integer; { Current instruction length } 90 91 bytStr: String; { Buffer for long DB statements } 92 showAddr: Boolean; { TRUE to show LocPtr on listing } 93 xferAddr: Integer; { Transfer address from END pseudo } 94 xferFound: Boolean; { TRUE if xfer addr defined w/ END } 95 96 { Command line parameters } 97 cl_SrcName: String; { Source file name } 98 cl_ListName: String; { Listing file name } 99 cl_ObjName: String; { Object file name } 100 cl_Err: Boolean; { TRUE for errors to screen } 101 102 103 source: Text; 104 object: Text; 105 listing: Text; 106 107 108FUNCTION Deblank(s: String): String; 109VAR 110 i: Integer; 111 112BEGIN 113 i := Length(s); 114 WHILE (i>0) AND (s[i] IN [#9,' ']) DO 115 Dec(i); 116 117 s[0] := CHR(i); 118 119 i := 1; 120 WHILE (i<=Length(s)) AND (s[i] IN [#9,' ']) DO 121 Inc(i); 122 Delete(s,1,i-1); 123 124 Deblank := s; 125END; 126 127 128FUNCTION UprCase(s: String): String; 129VAR 130 i: Integer; 131 132BEGIN 133 FOR i := 1 TO Length(s) DO 134 IF s[i] IN ['a'..'z'] THEN 135 s[i] := UpCase(s[i]); 136 137 UprCase := s; 138END; 139 140 141FUNCTION Hex2(i: Integer): String; 142BEGIN 143 i := i AND 255; 144 Hex2 := Copy(hex,(i SHR 4)+1,1) + Copy(hex,(i AND 15)+1,1); 145END; 146 147 148FUNCTION Hex4(i: Integer): String; 149BEGIN 150 Hex4 := Hex2(i SHR 8) + Hex2(i AND 255); 151END; 152 153 154PROCEDURE Error(message: String); 155BEGIN 156 errFlag := TRUE; 157 Inc(errCount); 158 159 IF pass<>1 THEN BEGIN 160 listThisLine := TRUE; 161 WriteLn(listing,'*** Error: ',Message,' ***'); 162 IF cl_Err THEN WriteLn('*** Error: ',Message,' ***'); 163 END; 164END; 165 166 167 168PROCEDURE AddOpcode(name: OpcdStr; typ,parm: Integer); 169VAR 170 p: OpcdPtr; 171 172BEGIN 173 New(p); 174 175 p^.name := name; 176 p^.typ := typ; 177 p^.parm := parm; 178 p^.next := opcdTab; 179 180 opcdTab := p; 181END; 182 183 184PROCEDURE FindOpcode(name: OpcdStr; VAR typ,parm: Integer); 185VAR 186 p: OpcdPtr; 187 found: Boolean; 188 189BEGIN 190 found := FALSE; 191 p := opcdTab; 192 193 WHILE (p<>NIL) AND NOT found DO BEGIN 194 found := (p^.name = name); 195 IF NOT found THEN 196 p := p^.next; 197 END; 198 199 IF NOT found THEN BEGIN 200 typ := o_Illegal; 201 parm := 0; 202 END 203 ELSE BEGIN 204 typ := p^.typ; 205 parm := p^.parm; 206 END; 207END; 208 209 210PROCEDURE InitOpcodes; 211BEGIN 212 opcdTab := NIL; 213 214 AddOpcode('NOP' ,o_None,0); 215 AddOpcode('RLC' ,o_None,7); 216 AddOpcode('RRC' ,o_None,15); 217 AddOpcode('RAL' ,o_None,23); 218 AddOpcode('RAR' ,o_None,31); 219 AddOpcode('DAA' ,o_None,39); 220 AddOpcode('CMA' ,o_None,47); 221 AddOpcode('RIM' ,o_None,48); 222 AddOpcode('STC' ,o_None,55); 223 AddOpcode('SIM' ,o_None,56); 224 AddOpcode('CMC' ,o_None,63); 225 AddOpcode('HLT' ,o_None,118); 226 AddOpcode('RNZ' ,o_None,192); 227 AddOpcode('RZ' ,o_None,200); 228 AddOpcode('RET' ,o_None,201); 229 AddOpcode('RNC' ,o_None,208); 230 AddOpcode('RC' ,o_None,216); 231 AddOpcode('RPO' ,o_None,224); 232 AddOpcode('XTHL',o_None,227); 233 AddOpcode('RPE' ,o_None,232); 234 AddOpcode('PCHL',o_None,233); 235 AddOpcode('XCHG',o_None,235); 236 AddOpcode('RP' ,o_None,240); 237 AddOpcode('DI' ,o_None,243); 238 AddOpcode('RM' ,o_None,248); 239 AddOpcode('SPHL',o_None,249); 240 AddOpcode('EI' ,o_None,251); 241 242 AddOpcode('ADI' ,o_One,198); 243 AddOpcode('ACI' ,o_One,206); 244 AddOpcode('OUT' ,o_One,211); 245 AddOpcode('SUI' ,o_One,214); 246 AddOpcode('IN' ,o_One,219); 247 AddOpcode('SBI' ,o_One,222); 248 AddOpcode('ANI' ,o_One,230); 249 AddOpcode('XRI' ,o_One,238); 250 AddOpcode('ORI' ,o_One,246); 251 AddOpcode('CPI' ,o_One,254); 252 253 AddOpcode('SHLD',o_Two,34); 254 AddOpcode('LHLD',o_Two,42); 255 AddOpcode('STA' ,o_Two,50); 256 AddOpcode('LDA' ,o_Two,58); 257 AddOpcode('JNZ' ,o_Two,194); 258 AddOpcode('JMP' ,o_Two,195); 259 AddOpcode('CNZ' ,o_Two,196); 260 AddOpcode('JZ' ,o_Two,202); 261 AddOpcode('CZ' ,o_Two,204); 262 AddOpcode('CALL',o_Two,205); 263 AddOpcode('JNC' ,o_Two,210); 264 AddOpcode('CNC' ,o_Two,212); 265 AddOpcode('JC' ,o_Two,218); 266 AddOpcode('CC' ,o_Two,220); 267 AddOpcode('JPO' ,o_Two,226); 268 AddOpcode('CPO' ,o_Two,228); 269 AddOpcode('JPE' ,o_Two,234); 270 AddOpcode('CPE' ,o_Two,236); 271 AddOpcode('JP' ,o_Two,242); 272 AddOpcode('CP' ,o_Two,244); 273 AddOpcode('JM' ,o_Two,250); 274 AddOpcode('CM' ,o_Two,252); 275 276 AddOpcode('INR' ,o_InrDcr,4); 277 AddOpcode('DCR' ,o_InrDcr,5); 278 279 AddOpcode('ADD' ,o_Arith,128); 280 AddOpcode('ADC' ,o_Arith,136); 281 AddOpcode('SUB' ,o_Arith,144); 282 AddOpcode('SBB' ,o_Arith,152); 283 AddOpcode('ANA' ,o_Arith,160); 284 AddOpcode('XRA' ,o_Arith,168); 285 AddOpcode('ORA' ,o_Arith,176); 286 AddOpcode('CMP' ,o_Arith,184); 287 288 AddOpcode('MOV' ,o_MOV,64); 289 290 AddOpcode('MVI' ,o_MVI,6); 291 292 AddOpcode('LXI' ,o_LXI,1); 293 294 AddOpcode('INX' ,o_InxDcx,3); 295 AddOpcode('DAD' ,o_InxDcx,9); 296 AddOpcode('DCX' ,o_InxDcx,11); 297 298 AddOpcode('POP' ,o_PushPop,193); 299 AddOpcode('PUSH',o_PushPop,197); 300 301 AddOpcode('STAX',o_StaxLdax,2); 302 AddOpcode('LDAX',o_StaxLdax,10); 303 304 AddOpcode('RST' ,o_RST,199); 305 306 AddOpcode('DB' ,o_DB,0); 307 AddOpcode('DW' ,o_DW,0); 308 AddOpcode('DS' ,o_DS,0); 309 310 AddOpcode('=' ,o_EQU,0); 311 AddOpcode('EQU' ,o_EQU,0); 312 AddOpcode('SET' ,o_EQU,1); 313 314 AddOpcode('ORG' ,o_ORG,0); 315 AddOpcode('END' ,o_END,0); 316 AddOpcode('LIST',o_LIST,0); 317 AddOpcode('OPT' ,o_OPT,0); 318END; 319 320 321FUNCTION FindSym(symName: SymStr): SymPtr; 322VAR 323 p: SymPtr; 324 found: Boolean; 325 326BEGIN 327 found := FALSE; 328 p := SymTab; 329 WHILE (p<>NIL) AND NOT Found DO BEGIN 330 found := (p^.name = symName); 331 IF NOT found THEN 332 p := p^.next; 333 END; 334 335 FindSym := p; 336END; 337 338 339FUNCTION AddSym(symName: SymStr): SymPtr; 340VAR 341 p: SymPtr; 342 343BEGIN 344 New(p); 345 346 WITH p^ DO BEGIN 347 name := SymName; 348 value := 0; 349 next := SymTab; 350 defined := FALSE; 351 multiDef := FALSE; 352 isSet := FALSE; 353 equ := FALSE; 354 END; 355 356 symTab := p; 357 358 AddSym := p; 359END; 360 361 362FUNCTION RefSym(symName: SymStr): Integer; 363VAR 364 p: SymPtr; 365 366BEGIN 367 p := FindSym(symName); 368 IF p=NIL THEN p := AddSym(symName); 369 370 IF NOT p^.defined THEN 371 Error('Symbol "' + symName + '" undefined'); 372 373 RefSym := p^.value; 374END; 375 376 377PROCEDURE DefSym(symName: SymStr; val: Integer; setSym,equSym: Boolean); 378VAR 379 p: SymPtr; 380 381BEGIN 382 IF Length(symName)<>0 THEN BEGIN 383 384 p := FindSym(symName); 385 IF p=NIL THEN p := AddSym(symName); 386 387 IF (NOT p^.defined) OR (p^.isSet AND setSym) THEN BEGIN 388 p^.value := val; 389 p^.defined := TRUE; 390 p^.isSet := setSym; 391 p^.equ := equSym; 392 END 393 ELSE IF p^.value <> val THEN BEGIN 394 p^.multiDef := TRUE; 395 Error('Symbol "' + symName + '" multiply defined'); 396 END; 397 END; 398END; 399 400 401FUNCTION GetWord: String; 402VAR 403 word: String; 404 done: Boolean; 405 406BEGIN 407 line := Deblank(line); 408 word := ''; 409 410 IF Length(line)>0 THEN 411 IF (line[1]=#12) OR (line[1]=';') THEN 412 line := ''; 413 414 IF Length(line)>0 THEN BEGIN 415 IF Pos(Upcase(line[1]),alphaNumeric)=0 THEN BEGIN 416 word := Copy(Line,1,1); 417 Delete(line,1,1); 418 END 419 ELSE BEGIN 420 done := FALSE; 421 WHILE (Length(line)>0) AND NOT done DO BEGIN 422 word := word + Upcase(line[1]); 423 Delete(line,1,1); 424 IF Length(line)>0 THEN 425 done := Pos(Upcase(line[1]),AlphaNumeric)=0; 426 END; 427 END; 428 END; 429 430 GetWord := word; 431END; 432 433 434PROCEDURE Expect(expected: String); 435BEGIN 436 IF GetWord<>expected THEN 437 Error('"' + expected + '" expected'); 438END; 439 440 441PROCEDURE Comma; 442BEGIN 443 Expect(','); 444END; 445 446 447FUNCTION EvalOct(octStr: String): Integer; 448VAR 449 octVal: Integer; 450 evalErr: Boolean; 451 i,n: Integer; 452 453BEGIN 454 evalErr := FALSE; 455 octVal := 0; 456 457 FOR i := 1 TO Length(octStr) DO BEGIN 458 n := Pos(octStr[i],'01234567'); 459 IF n=0 THEN evalErr := TRUE 460 ELSE octVal := octVal*8 + n-1; 461 END; 462 463 IF evalErr THEN BEGIN 464 octVal := 0; 465 Error('Invalid octal number'); 466 END; 467 468 EvalOct := octVal; 469END; 470 471 472FUNCTION EvalDec(decStr: String): Integer; 473VAR 474 decVal: Integer; 475 evalErr: Boolean; 476 i,n: Integer; 477 478BEGIN 479 evalErr := FALSE; 480 decVal := 0; 481 482 FOR i := 1 TO Length(decStr) DO BEGIN 483 n := Pos(decStr[i],'0123456789'); 484 IF n=0 THEN evalErr := TRUE 485 ELSE decVal := decVal*10 + n-1; 486 END; 487 488 IF evalErr THEN BEGIN 489 decVal := 0; 490 Error('Invalid decimal number'); 491 END; 492 493 EvalDec := decVal; 494END; 495 496 497FUNCTION EvalHex(hexStr: String): Integer; 498VAR 499 hexVal: Integer; 500 evalErr: Boolean; 501 i,n: Integer; 502 503BEGIN 504 evalErr := FALSE; 505 hexVal := 0; 506 507 FOR i := 1 TO Length(hexStr) DO BEGIN 508 n := Pos(Upcase(hexStr[i]),'0123456789ABCDEF'); 509 IF n=0 THEN evalErr := TRUE 510 ELSE hexVal := hexVal*16 + n-1; 511 END; 512 513 IF evalErr THEN BEGIN 514 hexVal := 0; 515 Error('Invalid hexadecimal number'); 516 END; 517 518 EvalHex := hexVal; 519END; 520 521 522FUNCTION Eval: Integer; FORWARD; 523 524 525FUNCTION Factor: Integer; 526VAR 527 word: String; 528 val: Integer; 529 530BEGIN 531 word := GetWord; 532 val := 0; 533 IF Length(word)=0 THEN Error('Missing operand') 534 ELSE IF (word='.') OR (word='*') THEN val := locPtr 535 ELSE IF word='-' THEN val := -Factor 536 ELSE IF word='+' THEN val := Factor 537 ELSE IF word='~' THEN val := -Factor-1 538 ELSE IF word='(' THEN BEGIN 539 val := Eval; 540 Expect(')'); 541 END 542 ELSE IF word='''' THEN BEGIN 543 IF Length(line)=0 THEN 544 Error('Missing operand') 545 ELSE BEGIN 546 val := Ord(line[1]); 547 Delete(line,1,1); 548 Expect(''''); 549 END; 550 END 551 ELSE IF Pos(word[1],numeric)>0 THEN BEGIN 552 CASE word[Length(word)] OF 553 'O': val := EvalOct(Copy(word,1,Length(word)-1)); 554 'D': val := EvalDec(Copy(word,1,Length(word)-1)); 555 'H': val := EvalHex(Copy(word,1,Length(word)-1)); 556 ELSE val := EvalDec(word); 557 END; 558 END 559 ELSE val := RefSym(word); 560 561 Factor := val; 562END; 563 564 565FUNCTION Term: Integer; 566VAR 567 word: String; 568 val: Integer; 569 oldLine: String; 570 571BEGIN 572 val := Factor; 573 574 oldLine := line; 575 word := GetWord; 576 WHILE (word='*') OR (word='/') OR (word='%') DO BEGIN 577 CASE word[1] OF 578 '*': val := val * Factor; 579 '/': val := val DIV Factor; 580 '%': val := val MOD Factor; 581 END; 582 oldLine := line; 583 word := GetWord; 584 END; 585 line := oldLine; 586 587 Term := val; 588END; 589 590 591FUNCTION Eval: Integer; 592VAR 593 word: String; 594 val: Integer; 595 oldLine: String; 596 597BEGIN 598 val := Term; 599 600 oldLine := line; 601 word := GetWord; 602 WHILE (word='+') OR (word='-') {OR (word='*') OR (word='/')} DO BEGIN 603 CASE word[1] OF 604 '+': val := val + Term; 605 '-': val := val - Term; 606 END; 607 oldLine := line; 608 word := GetWord; 609 END; 610 line := oldLine; 611 612 Eval := val; 613END; 614 615 616FUNCTION EvalByte: Integer; 617VAR 618 val: Integer; 619 620BEGIN 621 val := Eval; 622 623 IF (val<-128) OR (val>255) THEN 624 Error('Byte out of range'); 625 626 EvalByte := val AND 255; 627END; 628 629 630FUNCTION FindReg(regName,regList,valList: String): Integer; 631VAR 632 p: Integer; 633 reg: Integer; 634 code: Integer; 635 636BEGIN 637 p := Pos(' ' + Deblank(regName) + ' ',regList); 638 639 IF p=0 THEN BEGIN 640 reg := 0; 641 Error('Illegal register "' + Deblank(RegName) + '"'); 642 END 643 ELSE 644 Val(Copy(valList,p,2),reg,code); 645 646 FindReg := reg; 647END; 648 649 650PROCEDURE CodeOut(byte: Integer); 651BEGIN 652 IF pass=2 THEN 653 WriteLn(object,Hex2(byte)); 654END; 655 656 657PROCEDURE CodeOrg(addr: Integer); 658BEGIN 659 locPtr := addr; 660 661 IF pass=2 THEN 662 WriteLn(object,':',Hex4(addr)); 663END; 664 665 666PROCEDURE CodeFlush; 667BEGIN 668 { Object file format does not use buffering; no flush needed } 669END; 670 671 672PROCEDURE CodeEnd; 673BEGIN 674 CodeFlush; 675 676 IF (pass=2) AND xferFound THEN BEGIN 677 WriteLn(object,'$',Hex4(xferAddr)); 678 END; 679END; 680 681 682PROCEDURE CodeXfer(addr: Integer); 683BEGIN 684 xferAddr := addr; 685 xferFound := TRUE; 686END; 687 688 689PROCEDURE DoOpcode(typ,parm: Integer); 690VAR 691 val: Integer; 692 reg1: Integer; 693 reg2: Integer; 694 word: String; 695 oldLine: String; 696 697BEGIN 698 CASE typ OF 699 o_None: BEGIN 700 instr[1] := parm; 701 instrLen := 1; 702 END; 703 704 o_One: BEGIN 705 instr[1] := parm; 706 instr[2] := EvalByte; 707 instrLen := 2; 708 END; 709 710 o_Two: BEGIN 711 val := Eval; 712 instr[1] := parm; 713 instr[2] := val AND 255; 714 instr[3] := val SHR 8; 715 instrLen := 3; 716 END; 717 718 o_InrDcr: BEGIN 719 reg1 := FindReg(GetWord,regs,regVals); 720 instr[1] := parm + reg1*8; 721 instrLen := 1; 722 END; 723 724 o_Arith: BEGIN 725 reg1 := FindReg(GetWord,regs,regVals); 726 instr[1] := parm + reg1; 727 instrLen := 1; 728 END; 729 730 o_MOV: BEGIN 731 reg1 := FindReg(GetWord,regs,regVals); 732 Comma; 733 reg2 := FindReg(GetWord,regs,regVals); 734 instr[1] := parm + reg1*8 + reg2; 735 instrLen := 1; 736 END; 737 738 o_MVI: BEGIN 739 reg1 := FindReg(GetWord,regs,regVals); 740 Comma; 741 instr[1] := parm + reg1*8; 742 instr[2] := EvalByte; 743 instrLen := 2; 744 END; 745 746 o_LXI: BEGIN 747 reg1 := FindReg(GetWord,regPairs,regPairVals); 748 Comma; 749 val := Eval; 750 instr[1] := parm + reg1*16; 751 instr[2] := val AND 255; 752 instr[3] := val SHR 8; 753 instrLen := 3; 754 END; 755 756 o_InxDcx: BEGIN 757 reg1 := FindReg(GetWord,regPairs,regPairVals); 758 instr[1] := parm + reg1*16; 759 instrLen := 1; 760 END; 761 762 o_PushPop: BEGIN 763 reg1 := FindReg(GetWord,pushRegs,pushRegVals); 764 instr[1] := parm + reg1*16; 765 instrLen := 1; 766 END; 767 768 o_StaxLdax: BEGIN 769 reg1 := FindReg(GetWord,staxRegs,staxRegVals); 770 instr[1] := parm + reg1*16; 771 instrLen := 1; 772 END; 773 774 o_RST: BEGIN 775 val := Eval; 776 CASE val OF 777 0,1,2,3,4,5,6,7: val := val * 8; 778 8,16,24,32,40,48,56: ; 779 ELSE BEGIN 780 Error('Illegal restart number'); 781 val := 0; 782 END; 783 END; 784 instr[1] := parm + val; 785 instrLen := 1; 786 END; 787 788 o_DB: BEGIN 789 oldLine := line; 790 word := GetWord; 791 IF word='''' THEN BEGIN 792 val := Pos('''',line); 793 IF val=0 THEN BEGIN 794 bytStr := line; 795 line := ''; 796 END 797 ELSE BEGIN 798 bytStr := Copy(line,1,val-1); 799 Delete(line,1,val); 800 END; 801 instrLen := -Length(bytStr); 802 END 803 ELSE BEGIN 804 line := oldLine; 805 instr[1] := EvalByte; 806 instrLen := 1; 807 END; 808 END; 809 810 o_DW: BEGIN 811 val := Eval; 812 instr[1] := val AND 255; 813 instr[2] := val SHR 8; 814 instrLen := 2; 815 END; 816 817 o_DS: BEGIN 818 val := Eval; 819 820 IF pass=2 THEN BEGIN 821 showAddr := FALSE; 822 Delete(listLine,1,13); 823 listLine := Hex4(locPtr) + ': (' + Hex4(val) + ')' 824 + listLine; 825 END; 826 827 val := val + locPtr; 828 CodeOrg(val); 829 END; 830 831 o_END: BEGIN 832 oldLine := line; 833 834 IF Length(GetWord)<>0 THEN BEGIN 835 line := oldLine; 836 val := Eval; 837 CodeXfer(val); 838 line := Copy(line,1,7) + '(' + Hex4(val) + ')' + 839 Copy(line,14,255); 840 END; 841 842 sourceEnd := TRUE; 843 END; 844 845 ELSE Error('Unknown opcode'); 846 END; 847END; 848 849 850PROCEDURE DoLabelOp(typ,parm: Integer; labl: SymStr); 851VAR 852 val: Integer; 853 word: String; 854 855BEGIN 856 CASE typ OF 857 o_EQU: BEGIN 858 IF Length(labl)=0 THEN 859 Error('Missing label') 860 ELSE BEGIN 861 val := Eval; 862 863 listLine := Copy(listLine,1,6) + '= ' + Hex4(val) + 864 Copy(listLine,13,255); 865 866 DefSym(labl,val,parm=1,parm=0); 867 END; 868 END; 869 870 871 o_ORG: BEGIN 872 CodeOrg(Eval); 873 DefSym(labl,locPtr,FALSE,FALSE); 874 showAddr := TRUE; 875 END; 876 877 o_LIST: BEGIN 878 listThisLine := TRUE; 879 880 IF Length(labl)<>0 THEN 881 Error('Label not allowed'); 882 883 word := GetWord; 884 IF word='ON' THEN listFlag := TRUE 885 ELSE IF word='OFF' THEN listFlag := FALSE 886 ELSE Error('Illegal operand'); 887 END; 888 889 o_OPT: BEGIN 890 listThisLine := TRUE; 891 892 IF Length(labl)<>0 THEN 893 Error('Label not allowed'); 894 895 word := GetWord; 896 IF word='LIST' THEN listFlag := TRUE 897 ELSE IF word='NOLIST' THEN listFlag := FALSE 898 ELSE Error('Illegal option'); 899 END; 900 901 ELSE Error('Unknown opcode'); 902 END; 903END; 904 905 906PROCEDURE ListOut; 907VAR 908 i: Integer; 909 910BEGIN 911 IF Deblank(listLine) = #12 THEN 912 WriteLn(listing,#12) 913 914 ELSE IF Deblank(listLine)='' THEN 915 WriteLn(listing) 916 917 ELSE BEGIN 918 i := Length(listLine); 919 WHILE (i>0) AND (listLine[i]=' ') DO 920 Dec(i); 921 listLine[0] := CHR(i); 922 923 WriteLn(listing,listLine); 924 IF errFlag AND cl_Err THEN 925 WriteLn(listLine); 926 END; 927END; 928 929 930PROCEDURE DoPass; 931VAR 932 labl: SymStr; 933 opcode: OpcdStr; 934 typ: Integer; 935 parm: Integer; 936 i: Integer; 937 word: String; 938 939BEGIN 940 Assign(source,cl_SrcName); 941 Reset(source); 942 sourceEnd := FALSE; 943 944 WriteLn('Pass ',pass); 945 946 CodeOrg(0); 947 errCount := 0; 948 listFlag := TRUE; 949 950 WHILE (NOT Eof(source)) AND (NOT SourceEnd) DO BEGIN 951 ReadLn(source,line); 952 953 errFlag := FALSE; 954 instrLen := 0; 955 showAddr := FALSE; 956 listThisLine := ListFlag; 957 listLine := ' '; { 16 blanks } 958 959 IF Pass=2 THEN listLine := Copy(listLine,1,16) + line; 960 961 labl := ''; 962 963 IF Length(line)>0 THEN 964 IF Pos(line[1],white)=0 THEN BEGIN 965 labl := GetWord; 966 showAddr := (Length(labl)<>0); 967 968 IF Length(line)>0 THEN 969 IF line[1]=':' THEN 970 Delete(line,1,1); 971 972 END; 973 974 opcode := GetWord; 975 IF Length(opcode)=0 THEN BEGIN 976 typ := 0; 977 DefSym(labl,locPtr,FALSE,FALSE); 978 END 979 ELSE BEGIN 980 FindOpcode(opcode,typ,parm); 981 982 IF typ=o_Illegal THEN Error('Illegal opcode "' + 983 Deblank(opcode) + '"') 984 ELSE IF typ<0 THEN BEGIN 985 showAddr := FALSE; 986 DoLabelOp(typ,parm,labl); 987 END 988 ELSE BEGIN 989 showAddr := TRUE; 990 DefSym(labl,locPtr,FALSE,FALSE); 991 DoOpcode(typ,parm); 992 END; 993 994 IF typ<>o_Illegal THEN 995 IF Length(GetWord)>0 THEN 996 Error('Too many operands'); 997 END; 998 999 IF Pass=2 THEN BEGIN 1000 IF ShowAddr THEN 1001 listLine := Hex4(locPtr) + ':' + Copy(listLine,6,255); 1002 1003 IF instrLen>0 THEN 1004 FOR i := 1 TO instrLen DO BEGIN 1005 word := Hex2(instr[i]); 1006 listLine[i*3+4] := word[1]; 1007 listLine[i*3+5] := word[2]; 1008 CodeOut(instr[I]); 1009 END 1010 ELSE FOR i := 1 TO -instrLen DO BEGIN 1011 IF I<=3 THEN BEGIN 1012 word := Hex2(ORD(bytStr[i])); 1013 listLine[i*3+4] := word[1]; 1014 listLine[i*3+5] := word[2]; 1015 END; 1016 CodeOut(ORD(bytStr[i])); 1017 END; 1018 1019 IF listThisLine THEN ListOut; 1020 END; 1021 1022 locPtr := locPtr + ABS(instrLen); 1023 END; 1024 1025 IF Pass=2 THEN CodeEnd; 1026 1027 { Put the lines after the END statement into the listing file } 1028 { while still checking for listing control statements. Ignore } 1029 { any lines which have invalid syntax, etc., because whatever } 1030 { is found after an END statement should esentially be ignored. } 1031 1032 IF Pass=2 THEN 1033 WHILE NOT Eof(source) DO BEGIN 1034 listThisLine := listFlag; 1035 listLine := ' ' + line; { 16 blanks } 1036 1037 IF Length(line)>0 THEN 1038 IF Pos(line[1],white)<>0 THEN BEGIN 1039 word := GetWord; 1040 IF Length(word)<>0 THEN BEGIN 1041 IF word='LIST' THEN 1042 BEGIN 1043 listThisLine := TRUE; 1044 word := GetWord; 1045 1046 IF word='ON' THEN listFlag := TRUE 1047 ELSE IF word='OFF' THEN listFlag := FALSE 1048 ELSE listThisLine := listFlag; 1049 END 1050 1051 ELSE IF word='OPT' THEN 1052 BEGIN 1053 listThisLine := TRUE; 1054 word := GetWord; 1055 1056 IF word='LIST' THEN listFlag := TRUE 1057 ELSE IF word='NOLIST' THEN listFlag := FALSE 1058 ELSE listThisLine := listFlag; 1059 END; 1060 END; 1061 END; 1062 1063 IF listThisLine THEN ListOut; 1064 END; 1065 1066 Close(source); 1067END; 1068 1069 1070PROCEDURE SortSymTab; 1071VAR 1072 i,j,t: SymPtr; 1073 sorted: Boolean; 1074 temp: SymRec; 1075 1076BEGIN 1077 IF symTab<>NIL THEN BEGIN 1078 1079 i := symTab; 1080 j := i^.next; 1081 WHILE (j<>NIL) DO BEGIN 1082 sorted := TRUE; 1083 1084 WHILE (j<>NIL) DO BEGIN 1085 IF j^.name < i^.name THEN BEGIN 1086 temp := i^; 1087 i^ := j^; 1088 j^ := temp; 1089 1090 t := i^.next; 1091 i^.next := j^.next; 1092 j^.next := t; 1093 1094 sorted := FALSE; 1095 END; 1096 j := j^.next; 1097 END; 1098 i := i^.next; 1099 j := i^.next; 1100 END; 1101 END; 1102END; 1103 1104 1105PROCEDURE DumpSym(p: SymPtr); 1106BEGIN 1107 Write(listing,p^.name:maxSymLen,' ',Hex4(p^.value)); 1108 1109 IF NOT p^.defined THEN Write(listing,' U'); 1110 IF p^.multiDef THEN Write(listing,' M'); 1111 IF p^.isSet THEN Write(listing,' S'); 1112 IF p^.equ THEN Write(listing,' E'); 1113 1114 WriteLn(listing); 1115END; 1116 1117 1118PROCEDURE DumpSymTab; 1119VAR 1120 p: SymPtr; 1121 1122BEGIN 1123 SortSymTab; 1124 1125 p := symTab; 1126 WHILE (p<>NIL) DO BEGIN 1127 DumpSym(p); 1128 p := p^.next; 1129 END; 1130END; 1131 1132 1133PROCEDURE ShowOptions; 1134BEGIN 1135 WriteLn; 1136 WriteLn(' Command line syntax:'); 1137 WriteLn; 1138 WriteLn(' ASM8080 [options] src [options]'); 1139 WriteLn; 1140 WriteLn(' Valid options:'); 1141 WriteLn; 1142 WriteLn(' -E Show errors to screen'); 1143 WriteLn(' -L Make a listing file to src.LIS'); 1144 WriteLn(' -L=name'); 1145 WriteLn(' -O Make an object file to src.OBJ'); 1146 WriteLn(' -O=name'); 1147 WriteLn; 1148END; 1149 1150 1151FUNCTION GetOption(VAR optStr: String): String; 1152VAR 1153 option: String[80]; 1154 p: Integer; 1155 1156BEGIN 1157 optStr := Deblank(optStr); 1158 1159 p := Pos(' ',optStr); 1160 1161 IF p=0 THEN BEGIN 1162 option := optStr; 1163 optStr := ''; 1164 END 1165 ELSE BEGIN 1166 option := Copy(optStr,1,p-1); 1167 optStr := Copy(optStr,p+1,255); 1168 END; 1169 1170 optStr := UprCase(Deblank(optStr)); 1171 1172 GetOption := option; 1173END; 1174 1175 1176FUNCTION GetOptions(VAR cl_SrcName, cl_ListName,cl_ObjName: String; VAR cl_Err: Boolean): Boolean; 1177VAR 1178 s: String; 1179 len: Integer; 1180 optStr: String; 1181 option: String; 1182 optParm: String; 1183 prefix: String; 1184 p: Integer; 1185 err: Integer; 1186 optErr: Boolean; 1187 i: Integer; 1188 1189BEGIN 1190 cl_SrcName := ''; 1191 cl_ListName := 'NUL'; 1192 cl_ObjName := 'NUL'; 1193 cl_Err := FALSE; 1194 1195 optErr := FALSE; 1196 optStr := ParamStr(1); 1197 FOR i := 2 TO ParamCount DO 1198 optStr := optStr + ' ' + ParamStr(i); 1199 1200 option := GetOption(optStr); 1201 WHILE Length(option)<>0 DO BEGIN 1202 optParm := ''; 1203 1204 p := Pos('=',option); 1205 IF p>0 THEN BEGIN 1206 optParm := Copy(option,p+1,255); 1207 option := Copy(option,1,p-1); 1208 END; 1209 1210 IF option = '-L' THEN cl_ListName := optParm 1211 ELSE IF option = '-O' THEN cl_ObjName := optParm 1212 ELSE IF option = '-E' THEN cl_Err := TRUE 1213 ELSE IF option = '?' THEN optErr := TRUE 1214 ELSE BEGIN 1215 IF (Copy(option,1,1)='-') OR (Length(cl_SrcName)<>0) OR 1216 (Length(optParm)<>0) THEN BEGIN 1217 optErr := TRUE; 1218 WriteLn('Illegal command line option: ',option); 1219 END 1220 ELSE BEGIN 1221 cl_SrcName := option; 1222 IF Pos('.',cl_SrcName)=0 THEN 1223 IF p=0 THEN cl_SrcName := cl_SrcName + '.ASM'; 1224 1225 p := Pos('.',option); 1226 IF p=0 THEN prefix := option 1227 ELSE prefix := Copy(option,1,p-1); 1228 END; 1229 END; 1230 1231 option := GetOption(optStr); 1232 END; 1233 1234 IF cl_SrcName = '' THEN BEGIN 1235 optErr := TRUE; 1236 WriteLn('Source file not specified') 1237 END; 1238 1239 IF cl_ListName = '' THEN cl_ListName := prefix + '.LIS'; 1240 IF cl_ObjName = '' THEN cl_ObjName := prefix + '.DAT'; 1241 IF Copy(cl_ListName,1,1)='.' THEN cl_ListName := prefix + cl_ListName; 1242 IF Copy(cl_ObjName ,1,1)='.' THEN cl_ObjName := prefix + cl_ObjName; 1243 1244 GetOptions := optErr; 1245END; 1246 1247 1248BEGIN 1249 IF GetOptions(cl_SrcName,cl_ListName,cl_ObjName,cl_Err) THEN BEGIN 1250 ShowOptions; 1251 Halt; 1252 END; 1253 1254 Assign(listing,cl_ListName); 1255 Rewrite(listing); 1256 Assign(object,cl_ObjName); 1257 Rewrite(object); 1258 1259 symTab := NIL; 1260 xferAddr := 0; 1261 xferFound := FALSE; 1262 InitOpcodes; 1263 1264 pass := 1; 1265 DoPass; 1266 1267 pass := 2; 1268 DoPass; 1269 1270 WriteLn(listing); 1271 WriteLn(listing,errCount:5,' Total Error(s)'); 1272 WriteLn(listing); 1273 1274 IF cl_Err THEN BEGIN 1275 WriteLn; 1276 WriteLn(errCount:5,' Total Error(s)'); 1277 END; 1278 1279 DumpSymTab; 1280 1281 Close(listing); 1282 Close(object); 1283END.