PageRenderTime 53ms CodeModel.GetById 46ms app.highlight 3ms RepoModel.GetById 0ms app.codeStats 0ms

/src/asm8080.pas

https://github.com/fitzer8/Z80Asm
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.