PROGRAM Asm8080;

{R-}
{$M 16384,0,655360}

CONST
   maxSymLen    = 16;
   maxOpcdLen   = 4;

   alphaNumeric = '1234567890$ABCDEFGHIJKLMNOPQRSTUVWXYZ_';
   numeric      = '1234567890';
   hex          = '0123456789ABCDEF';
   white        = #9' ';  { A tab plus a space }

   o_Illegal  =   0;  { Opcode not found in FindOpcode }
   o_None     =   1;  { No operands }
   o_One      =   2;  { One byte immediate operand }
   o_Two      =   3;  { Two byte immediate operand }
   o_InrDcr   =   4;  { INR or DCR instruction }
   o_Arith    =   5;  { Register to accumulator arithmetic }
   o_MOV      =   6;  { MOV instruction }
   o_MVI      =   7;  { MVI instruction }
   o_LXI      =   8;  { LXI instruction }
   o_InxDcx   =   9;  { INX, DCX, and DAD instructions }
   o_PushPop  =  10;  { PUSH and POP instructions }
   o_StaxLdax =  11;  { STAX and LDAX instructions }
   o_RST      =  12;  { RST instruction }
   o_DB       =  13;  { DB pseudo-op }
   o_DW       =  14;  { DW pseudo-op }
   o_DS       =  15;  { DS pseudo-op }
   o_EQU      = -16;  { EQU and SET pseudo-ops }
   o_ORG      = -17;  { ORG pseudo-op }
   o_END      =  18;  { END pseudo-op }
   o_LIST     = -19;  { LIST pseudo-op }
   o_OPT      = -20;  { OPT pseudo-op }

   regs         = ' B C D E H L M A ';
   regVals      = ' 0 1 2 3 4 5 6 7 ';

   regPairs     = ' B D H SP BC DE HL ';
   regPairVals  = ' 0 1 2 3  0  1  2  ';

   pushRegs     = ' B D H PSW BC DE HL AF ';
   pushRegVals  = ' 0 1 2 3   0  1  2  3  ';

   staxRegs     = ' B D BC DE ';
   staxRegVals  = ' 0 1 0  1  ';

TYPE
   SymStr  = String[maxSymLen];

   SymPtr  = ^SymRec;
   SymRec  = RECORD
                name:     SymStr;   { Symbol name }
                value:    Integer;  { Symbol value }
                next:     SymPtr;   { Pointer to next symtab entry }
                defined:  Boolean;  { TRUE if defined }
                multiDef: Boolean;  { TRUE if multiply defined }
                isSet:    Boolean;  { TRUE if defined with SET pseudo }
                equ:      Boolean;  { TRUE if defined with EQU pseudo }
             END;

   OpcdStr = String[maxOpcdLen];

   OpcdPtr = ^OpcdRec;
   OpcdRec = RECORD
                name:   OpcdStr;    { Opcode name }
                typ:    Integer;    { Opcode type }
                parm:   Integer;    { Opcode parameter }
                next:   OpcdPtr;    { Pointer to next opcode entry }
             END;

VAR
   symTab:       SymPtr;      { Pointer to first entry in symtab }
   opcdTab:      OpcdPtr;     { Opcode table }

   locPtr:       Integer;     { Current program address }
   pass:         Integer;     { Current assembler pass }
   errFlag:      Boolean;     { TRUE if error occurred this line }
   errCount:     Integer;     { Total number of errors }

   line:         String;      { Current line from input file }
   listLine:     String;      { Current listing line }
   listFlag:     Boolean;     { FALSE to suppress listing source }
   listThisLine: Boolean;     { TRUE to force listing this line }
   sourceEnd:    Boolean;     { TRUE when END pseudo encountered }

   instr:        ARRAY[1..3] OF Integer; { Current instruction word }
   instrLen:     Integer;                { Current instruction length }

   bytStr:       String;      { Buffer for long DB statements }
   showAddr:     Boolean;     { TRUE to show LocPtr on listing }
   xferAddr:     Integer;     { Transfer address from END pseudo }
   xferFound:    Boolean;     { TRUE if xfer addr defined w/ END }

   { Command line parameters }
   cl_SrcName:   String;      { Source file name }
   cl_ListName:  String;      { Listing file name }
   cl_ObjName:   String;      { Object file name }
   cl_Err:       Boolean;     { TRUE for errors to screen }


   source:       Text;
   object:       Text;
   listing:      Text;


FUNCTION Deblank(s: String): String;

VAR
   i: Integer;

BEGIN
   i := Length(s);
   WHILE (i>0) AND (s[i] IN [#9,' ']) DO
      Dec(i);

   s[0] := CHR(i);

   i := 1;
   WHILE (i<=Length(s)) AND (s[i] IN [#9,' ']) DO
      Inc(i);
   Delete(s,1,i-1);

   Deblank := s;
END;


FUNCTION UprCase(s: String): String;

VAR
   i: Integer;

BEGIN
   FOR i := 1 TO Length(s) DO
      IF s[i] IN ['a'..'z'] THEN
         s[i] := UpCase(s[i]);

   UprCase := s;
END;


FUNCTION Hex2(i: Integer): String;

BEGIN
   i := i AND 255;
   Hex2 := Copy(hex,(i SHR  4)+1,1) + Copy(hex,(i AND 15)+1,1);
END;


FUNCTION Hex4(i: Integer): String;

BEGIN
   Hex4 := Hex2(i SHR 8) + Hex2(i AND 255);
END;


PROCEDURE Error(message: String);

BEGIN
   errFlag := TRUE;
   Inc(errCount);

   IF pass<>1 THEN BEGIN
      listThisLine := TRUE;
      WriteLn(listing,'*** Error:  ',Message,' ***');
      IF cl_Err THEN WriteLn('*** Error:  ',Message,' ***');
   END;
END;



PROCEDURE AddOpcode(name: OpcdStr; typ,parm: Integer);

VAR
   p: OpcdPtr;

BEGIN
   New(p);

   p^.name := name;
   p^.typ  := typ;
   p^.parm := parm;
   p^.next := opcdTab;

   opcdTab := p;
END;


PROCEDURE FindOpcode(name: OpcdStr; VAR typ,parm: Integer);

VAR
   p:     OpcdPtr;
   found: Boolean;

BEGIN
   found := FALSE;
   p := opcdTab;

   WHILE (p<>NIL) AND NOT found DO BEGIN
      found := (p^.name = name);
      IF NOT found THEN
         p := p^.next;
   END;

   IF NOT found THEN BEGIN
      typ  := o_Illegal;
      parm := 0;
   END
   ELSE BEGIN
      typ  := p^.typ;
      parm := p^.parm;
   END;
END;


PROCEDURE InitOpcodes;

BEGIN
   opcdTab := NIL;

   AddOpcode('NOP' ,o_None,0);
   AddOpcode('RLC' ,o_None,7);
   AddOpcode('RRC' ,o_None,15);
   AddOpcode('RAL' ,o_None,23);
   AddOpcode('RAR' ,o_None,31);
   AddOpcode('DAA' ,o_None,39);
   AddOpcode('CMA' ,o_None,47);
   AddOpcode('RIM' ,o_None,48);
   AddOpcode('STC' ,o_None,55);
   AddOpcode('SIM' ,o_None,56);
   AddOpcode('CMC' ,o_None,63);
   AddOpcode('HLT' ,o_None,118);
   AddOpcode('RNZ' ,o_None,192);
   AddOpcode('RZ'  ,o_None,200);
   AddOpcode('RET' ,o_None,201);
   AddOpcode('RNC' ,o_None,208);
   AddOpcode('RC'  ,o_None,216);
   AddOpcode('RPO' ,o_None,224);
   AddOpcode('XTHL',o_None,227);
   AddOpcode('RPE' ,o_None,232);
   AddOpcode('PCHL',o_None,233);
   AddOpcode('XCHG',o_None,235);
   AddOpcode('RP'  ,o_None,240);
   AddOpcode('DI'  ,o_None,243);
   AddOpcode('RM'  ,o_None,248);
   AddOpcode('SPHL',o_None,249);
   AddOpcode('EI'  ,o_None,251);

   AddOpcode('ADI' ,o_One,198);
   AddOpcode('ACI' ,o_One,206);
   AddOpcode('OUT' ,o_One,211);
   AddOpcode('SUI' ,o_One,214);
   AddOpcode('IN'  ,o_One,219);
   AddOpcode('SBI' ,o_One,222);
   AddOpcode('ANI' ,o_One,230);
   AddOpcode('XRI' ,o_One,238);
   AddOpcode('ORI' ,o_One,246);
   AddOpcode('CPI' ,o_One,254);

   AddOpcode('SHLD',o_Two,34);
   AddOpcode('LHLD',o_Two,42);
   AddOpcode('STA' ,o_Two,50);
   AddOpcode('LDA' ,o_Two,58);
   AddOpcode('JNZ' ,o_Two,194);
   AddOpcode('JMP' ,o_Two,195);
   AddOpcode('CNZ' ,o_Two,196);
   AddOpcode('JZ'  ,o_Two,202);
   AddOpcode('CZ'  ,o_Two,204);
   AddOpcode('CALL',o_Two,205);
   AddOpcode('JNC' ,o_Two,210);
   AddOpcode('CNC' ,o_Two,212);
   AddOpcode('JC'  ,o_Two,218);
   AddOpcode('CC'  ,o_Two,220);
   AddOpcode('JPO' ,o_Two,226);
   AddOpcode('CPO' ,o_Two,228);
   AddOpcode('JPE' ,o_Two,234);
   AddOpcode('CPE' ,o_Two,236);
   AddOpcode('JP'  ,o_Two,242);
   AddOpcode('CP'  ,o_Two,244);
   AddOpcode('JM'  ,o_Two,250);
   AddOpcode('CM'  ,o_Two,252);

   AddOpcode('INR' ,o_InrDcr,4);
   AddOpcode('DCR' ,o_InrDcr,5);

   AddOpcode('ADD' ,o_Arith,128);
   AddOpcode('ADC' ,o_Arith,136);
   AddOpcode('SUB' ,o_Arith,144);
   AddOpcode('SBB' ,o_Arith,152);
   AddOpcode('ANA' ,o_Arith,160);
   AddOpcode('XRA' ,o_Arith,168);
   AddOpcode('ORA' ,o_Arith,176);
   AddOpcode('CMP' ,o_Arith,184);

   AddOpcode('MOV' ,o_MOV,64);

   AddOpcode('MVI' ,o_MVI,6);

   AddOpcode('LXI' ,o_LXI,1);

   AddOpcode('INX' ,o_InxDcx,3);
   AddOpcode('DAD' ,o_InxDcx,9);
   AddOpcode('DCX' ,o_InxDcx,11);

   AddOpcode('POP' ,o_PushPop,193);
   AddOpcode('PUSH',o_PushPop,197);

   AddOpcode('STAX',o_StaxLdax,2);
   AddOpcode('LDAX',o_StaxLdax,10);

   AddOpcode('RST' ,o_RST,199);

   AddOpcode('DB'  ,o_DB,0);
   AddOpcode('DW'  ,o_DW,0);
   AddOpcode('DS'  ,o_DS,0);

   AddOpcode('='   ,o_EQU,0);
   AddOpcode('EQU' ,o_EQU,0);
   AddOpcode('SET' ,o_EQU,1);

   AddOpcode('ORG' ,o_ORG,0);
   AddOpcode('END' ,o_END,0);
   AddOpcode('LIST',o_LIST,0);
   AddOpcode('OPT' ,o_OPT,0);
END;


FUNCTION FindSym(symName: SymStr): SymPtr;

VAR
   p:     SymPtr;
   found: Boolean;

BEGIN
   found := FALSE;
   p     := SymTab;
   WHILE (p<>NIL) AND NOT Found DO BEGIN
      found := (p^.name = symName);
      IF NOT found THEN
         p := p^.next;
   END;

   FindSym := p;
END;


FUNCTION AddSym(symName: SymStr): SymPtr;

VAR
   p: SymPtr;

BEGIN
   New(p);

   WITH p^ DO BEGIN
      name     := SymName;
      value    := 0;
      next     := SymTab;
      defined  := FALSE;
      multiDef := FALSE;
      isSet    := FALSE;
      equ      := FALSE;
   END;

   symTab := p;

   AddSym := p;
END;


FUNCTION RefSym(symName: SymStr): Integer;

VAR
   p: SymPtr;

BEGIN
   p := FindSym(symName);
   IF p=NIL THEN p := AddSym(symName);

   IF NOT p^.defined THEN
      Error('Symbol "' + symName + '" undefined');

   RefSym := p^.value;
END;


PROCEDURE DefSym(symName: SymStr; val: Integer; setSym,equSym: Boolean);

VAR
   p: SymPtr;

BEGIN
   IF Length(symName)<>0 THEN BEGIN

      p := FindSym(symName);
      IF p=NIL THEN p := AddSym(symName);

      IF (NOT p^.defined) OR (p^.isSet AND setSym) THEN BEGIN
         p^.value   := val;
         p^.defined := TRUE;
         p^.isSet   := setSym;
         p^.equ     := equSym;
      END
      ELSE IF p^.value <> val THEN BEGIN
         p^.multiDef := TRUE;
         Error('Symbol "' + symName + '" multiply defined');
      END;
   END;
END;


FUNCTION GetWord: String;

VAR
   word: String;
   done: Boolean;

BEGIN
   line := Deblank(line);
   word := '';

   IF Length(line)>0 THEN
      IF (line[1]=#12) OR (line[1]=';') THEN
         line := '';

   IF Length(line)>0 THEN BEGIN
      IF Pos(Upcase(line[1]),alphaNumeric)=0 THEN BEGIN
         word := Copy(Line,1,1);
         Delete(line,1,1);
      END
      ELSE BEGIN
         done := FALSE;
         WHILE (Length(line)>0) AND NOT done DO BEGIN
	    word := word + Upcase(line[1]);
            Delete(line,1,1);
	    IF Length(line)>0 THEN
               done := Pos(Upcase(line[1]),AlphaNumeric)=0;
         END;
      END;
   END;

   GetWord := word;
END;


PROCEDURE Expect(expected: String);

BEGIN
   IF GetWord<>expected THEN
      Error('"' + expected + '" expected');
END;


PROCEDURE Comma;

BEGIN
   Expect(',');
END;


FUNCTION EvalOct(octStr: String): Integer;

VAR
   octVal:  Integer;
   evalErr: Boolean;
   i,n:     Integer;

BEGIN
   evalErr := FALSE;
   octVal  := 0;

   FOR i := 1 TO Length(octStr) DO BEGIN
      n := Pos(octStr[i],'01234567');
      IF n=0 THEN evalErr := TRUE
             ELSE octVal  := octVal*8 + n-1;
   END;

   IF evalErr THEN BEGIN
      octVal := 0;
      Error('Invalid octal number');
   END;

   EvalOct := octVal;
END;


FUNCTION EvalDec(decStr: String): Integer;

VAR
   decVal:  Integer;
   evalErr: Boolean;
   i,n:     Integer;

BEGIN
   evalErr := FALSE;
   decVal  := 0;

   FOR i := 1 TO Length(decStr) DO BEGIN
      n := Pos(decStr[i],'0123456789');
      IF n=0 THEN evalErr := TRUE
             ELSE decVal  := decVal*10 + n-1;
   END;

   IF evalErr THEN BEGIN
      decVal := 0;
      Error('Invalid decimal number');
   END;

   EvalDec := decVal;
END;


FUNCTION EvalHex(hexStr: String): Integer;

VAR
   hexVal:  Integer;
   evalErr: Boolean;
   i,n:     Integer;

BEGIN
   evalErr := FALSE;
   hexVal  := 0;

   FOR i := 1 TO Length(hexStr) DO BEGIN
      n := Pos(Upcase(hexStr[i]),'0123456789ABCDEF');
      IF n=0 THEN evalErr := TRUE
             ELSE hexVal  := hexVal*16 + n-1;
   END;

   IF evalErr THEN BEGIN
      hexVal := 0;
      Error('Invalid hexadecimal number');
   END;

   EvalHex := hexVal;
END;


FUNCTION Eval: Integer; FORWARD;


FUNCTION Factor: Integer;

VAR
   word: String;
   val:  Integer;

BEGIN
   word := GetWord;
   val  := 0;
        IF Length(word)=0           THEN Error('Missing operand')
   ELSE IF (word='.') OR (word='*') THEN val := locPtr
   ELSE IF  word='-'                THEN val := -Factor
   ELSE IF  word='+'                THEN val := Factor
   ELSE IF  word='~'                THEN val := -Factor-1
   ELSE IF  word='('                THEN BEGIN
                                            val := Eval;
                                            Expect(')');
                                         END
   ELSE IF  word=''''               THEN BEGIN
                                            IF Length(line)=0 THEN
                                               Error('Missing operand')
                                            ELSE BEGIN
                                               val := Ord(line[1]);
                                               Delete(line,1,1);
                                               Expect('''');
                                            END;
                                         END
   ELSE IF Pos(word[1],numeric)>0   THEN BEGIN
                  CASE word[Length(word)] OF
                     'O': val := EvalOct(Copy(word,1,Length(word)-1));
                     'D': val := EvalDec(Copy(word,1,Length(word)-1));
                     'H': val := EvalHex(Copy(word,1,Length(word)-1));
                     ELSE val := EvalDec(word);
                  END;
                                         END
   ELSE                                  val := RefSym(word);

   Factor := val;
END;


FUNCTION Term: Integer;

VAR
   word:    String;
   val:     Integer;
   oldLine: String;

BEGIN
   val := Factor;

   oldLine := line;
   word := GetWord;
   WHILE (word='*') OR (word='/') OR (word='%') DO BEGIN
      CASE word[1] OF
         '*': val := val  *  Factor;
         '/': val := val DIV Factor;
         '%': val := val MOD Factor;
      END;
      oldLine := line;
      word := GetWord;
   END;
   line := oldLine;

   Term := val;
END;


FUNCTION Eval: Integer;

VAR
   word:    String;
   val:     Integer;
   oldLine: String;

BEGIN
   val := Term;

   oldLine := line;
   word := GetWord;
   WHILE (word='+') OR (word='-') {OR (word='*') OR (word='/')} DO BEGIN
      CASE word[1] OF
         '+': val := val + Term;
         '-': val := val - Term;
      END;
      oldLine := line;
      word := GetWord;
   END;
   line := oldLine;

   Eval := val;
END;


FUNCTION EvalByte: Integer;

VAR
   val: Integer;

BEGIN
   val := Eval;

   IF (val<-128) OR (val>255) THEN
      Error('Byte out of range');

   EvalByte := val AND 255;
END;


FUNCTION FindReg(regName,regList,valList: String): Integer;

VAR
   p:    Integer;
   reg:  Integer;
   code: Integer;

BEGIN
   p := Pos(' ' + Deblank(regName) + ' ',regList);

   IF p=0 THEN BEGIN
      reg := 0;
      Error('Illegal register "' + Deblank(RegName) + '"');
   END
   ELSE
      Val(Copy(valList,p,2),reg,code);

   FindReg := reg;
END;


PROCEDURE CodeOut(byte: Integer);

BEGIN
   IF pass=2 THEN
      WriteLn(object,Hex2(byte));
END;


PROCEDURE CodeOrg(addr: Integer);

BEGIN
   locPtr := addr;

   IF pass=2 THEN
      WriteLn(object,':',Hex4(addr));
END;


PROCEDURE CodeFlush;

BEGIN
    { Object file format does not use buffering; no flush needed }
END;


PROCEDURE CodeEnd;

BEGIN
   CodeFlush;

   IF (pass=2) AND xferFound THEN BEGIN
      WriteLn(object,'$',Hex4(xferAddr));
   END;
END;


PROCEDURE CodeXfer(addr: Integer);

BEGIN
   xferAddr  := addr;
   xferFound := TRUE;
END;


PROCEDURE DoOpcode(typ,parm: Integer);

VAR
   val:     Integer;
   reg1:    Integer;
   reg2:    Integer;
   word:    String;
   oldLine: String;

BEGIN
   CASE typ OF
      o_None:     BEGIN
                     instr[1] := parm;
                     instrLen := 1;
                  END;

      o_One:      BEGIN
                     instr[1] := parm;
                     instr[2] := EvalByte;
                     instrLen := 2;
                  END;

      o_Two:      BEGIN
                     val := Eval;
                     instr[1] := parm;
                     instr[2] := val AND 255;
                     instr[3] := val SHR 8;
                     instrLen := 3;
                  END;

      o_InrDcr:   BEGIN
                     reg1     := FindReg(GetWord,regs,regVals);
                     instr[1] := parm + reg1*8;
                     instrLen := 1;
                  END;

      o_Arith:    BEGIN
                     reg1     := FindReg(GetWord,regs,regVals);
                     instr[1] := parm + reg1;
                     instrLen := 1;
                  END;

      o_MOV:      BEGIN
                     reg1     := FindReg(GetWord,regs,regVals);
                     Comma;
                     reg2     := FindReg(GetWord,regs,regVals);
                     instr[1] := parm + reg1*8 + reg2;
                     instrLen := 1;
                  END;

      o_MVI:      BEGIN
                     reg1     := FindReg(GetWord,regs,regVals);
                     Comma;
                     instr[1] := parm + reg1*8;
                     instr[2] := EvalByte;
                     instrLen := 2;
                  END;

      o_LXI:      BEGIN
                     reg1     := FindReg(GetWord,regPairs,regPairVals);
                     Comma;
                     val      := Eval;
                     instr[1] := parm + reg1*16;
                     instr[2] := val AND 255;
                     instr[3] := val SHR 8;
                     instrLen := 3;
                  END;

      o_InxDcx:   BEGIN
                     reg1     := FindReg(GetWord,regPairs,regPairVals);
                     instr[1] := parm + reg1*16;
                     instrLen := 1;
                  END;

      o_PushPop:  BEGIN
                     reg1     := FindReg(GetWord,pushRegs,pushRegVals);
                     instr[1] := parm + reg1*16;
                     instrLen := 1;
                  END;

      o_StaxLdax: BEGIN
                     reg1     := FindReg(GetWord,staxRegs,staxRegVals);
                     instr[1] := parm + reg1*16;
                     instrLen := 1;
                  END;

      o_RST:      BEGIN
                     val := Eval;
                     CASE val OF
                        0,1,2,3,4,5,6,7:     val := val * 8;
                        8,16,24,32,40,48,56: ;
                        ELSE BEGIN
                           Error('Illegal restart number');
                           val := 0;
                        END;
                     END;
                     instr[1] := parm + val;
                     instrLen := 1;
                  END;

      o_DB:       BEGIN
                     oldLine := line;
                     word := GetWord;
                     IF word='''' THEN BEGIN
                        val := Pos('''',line);
                        IF val=0 THEN BEGIN
                           bytStr := line;
                           line   := '';
                        END
                        ELSE BEGIN
                           bytStr := Copy(line,1,val-1);
                           Delete(line,1,val);
                        END;
                        instrLen := -Length(bytStr);
                     END
                     ELSE BEGIN
                        line     := oldLine;
                        instr[1] := EvalByte;
                        instrLen := 1;
                     END;
                  END;

      o_DW:       BEGIN
                     val      := Eval;
                     instr[1] := val AND 255;
                     instr[2] := val SHR 8;
                     instrLen := 2;
                  END;

      o_DS:       BEGIN
                     val := Eval;

                     IF pass=2 THEN BEGIN
                        showAddr := FALSE;
                        Delete(listLine,1,13);
                        listLine := Hex4(locPtr) + ':  (' + Hex4(val) + ')'
                                                 + listLine;
                     END;

                     val := val + locPtr;
                     CodeOrg(val);
                  END;

      o_END:     BEGIN
                    oldLine := line;

                    IF Length(GetWord)<>0 THEN BEGIN
                       line := oldLine;
                       val  := Eval;
                       CodeXfer(val);
                       line := Copy(line,1,7) + '(' + Hex4(val) + ')' +
                               Copy(line,14,255);
                    END;

                    sourceEnd := TRUE;
                 END;

      ELSE Error('Unknown opcode');
   END;
END;


PROCEDURE DoLabelOp(typ,parm: Integer; labl: SymStr);

VAR
   val:  Integer;
   word: String;

BEGIN
   CASE typ OF
      o_EQU:   BEGIN
                  IF Length(labl)=0 THEN
                     Error('Missing label')
                  ELSE BEGIN
                     val := Eval;

                     listLine := Copy(listLine,1,6) + '= ' + Hex4(val) +
                                 Copy(listLine,13,255);

                     DefSym(labl,val,parm=1,parm=0);
                  END;
               END;


      o_ORG:   BEGIN
                  CodeOrg(Eval);
                  DefSym(labl,locPtr,FALSE,FALSE);
                  showAddr := TRUE;
               END;

      o_LIST:  BEGIN
                  listThisLine := TRUE;

                  IF Length(labl)<>0 THEN
                     Error('Label not allowed');

                  word := GetWord;
                       IF word='ON'  THEN listFlag := TRUE
                  ELSE IF word='OFF' THEN listFlag := FALSE
                  ELSE                    Error('Illegal operand');
               END;

      o_OPT:   BEGIN
                  listThisLine := TRUE;

                  IF Length(labl)<>0 THEN
                     Error('Label not allowed');

                  word := GetWord;
                       IF word='LIST'   THEN listFlag := TRUE
                  ELSE IF word='NOLIST' THEN listFlag := FALSE
                  ELSE                       Error('Illegal option');
               END;

      ELSE Error('Unknown opcode');
   END;
END;


PROCEDURE ListOut;

VAR
   i: Integer;

BEGIN
   IF Deblank(listLine) = #12 THEN
      WriteLn(listing,#12)

   ELSE IF Deblank(listLine)='' THEN
      WriteLn(listing)

   ELSE BEGIN
      i := Length(listLine);
      WHILE (i>0) AND (listLine[i]=' ') DO
         Dec(i);
      listLine[0] := CHR(i);

      WriteLn(listing,listLine);
      IF errFlag AND cl_Err THEN
         WriteLn(listLine);
   END;
END;


PROCEDURE DoPass;

VAR
   labl:    SymStr;
   opcode:  OpcdStr;
   typ:     Integer;
   parm:    Integer;
   i:       Integer;
   word:    String;

BEGIN
   Assign(source,cl_SrcName);
   Reset(source);
   sourceEnd := FALSE;

   WriteLn('Pass ',pass);

   CodeOrg(0);
   errCount := 0;
   listFlag := TRUE;

   WHILE (NOT Eof(source)) AND (NOT SourceEnd) DO BEGIN
      ReadLn(source,line);

      errFlag      := FALSE;
      instrLen     := 0;
      showAddr     := FALSE;
      listThisLine := ListFlag;
      listLine     := '                '; { 16 blanks }

      IF Pass=2 THEN listLine := Copy(listLine,1,16) + line;

      labl := '';

      IF Length(line)>0 THEN
         IF Pos(line[1],white)=0 THEN BEGIN
            labl := GetWord;
            showAddr := (Length(labl)<>0);

            IF Length(line)>0 THEN
               IF line[1]=':' THEN
                  Delete(line,1,1);

         END;

      opcode := GetWord;
      IF Length(opcode)=0 THEN BEGIN
         typ := 0;
         DefSym(labl,locPtr,FALSE,FALSE);
      END
      ELSE BEGIN
         FindOpcode(opcode,typ,parm);

              IF typ=o_Illegal THEN Error('Illegal opcode "' +
                                          Deblank(opcode) + '"')
         ELSE IF typ<0         THEN BEGIN
                                       showAddr := FALSE;
                                       DoLabelOp(typ,parm,labl);
                                    END
         ELSE                       BEGIN
                                       showAddr := TRUE;
                                       DefSym(labl,locPtr,FALSE,FALSE);
                                       DoOpcode(typ,parm);
                                    END;

         IF typ<>o_Illegal THEN
            IF Length(GetWord)>0 THEN
               Error('Too many operands');
      END;

      IF Pass=2 THEN BEGIN
         IF ShowAddr THEN
            listLine := Hex4(locPtr) + ':' + Copy(listLine,6,255);

         IF instrLen>0 THEN
            FOR i := 1 TO instrLen DO BEGIN
               word := Hex2(instr[i]);
               listLine[i*3+4] := word[1];
               listLine[i*3+5] := word[2];
               CodeOut(instr[I]);
            END
         ELSE FOR i := 1 TO -instrLen DO BEGIN
            IF I<=3 THEN BEGIN
               word := Hex2(ORD(bytStr[i]));
               listLine[i*3+4] := word[1];
               listLine[i*3+5] := word[2];
            END;
            CodeOut(ORD(bytStr[i]));
         END;

         IF listThisLine THEN ListOut;
      END;

      locPtr := locPtr + ABS(instrLen);
   END;

   IF Pass=2 THEN CodeEnd;

   { Put the lines after the END statement into the listing file   }
   { while still checking for listing control statements.  Ignore  }
   { any lines which have invalid syntax, etc., because whatever   }
   { is found after an END statement should esentially be ignored. }

   IF Pass=2 THEN
      WHILE NOT Eof(source) DO BEGIN
         listThisLine := listFlag;
         listLine := '                ' + line; { 16 blanks }

         IF Length(line)>0 THEN
            IF Pos(line[1],white)<>0 THEN BEGIN
               word := GetWord;
               IF Length(word)<>0 THEN BEGIN
                   IF word='LIST' THEN
                      BEGIN
                         listThisLine := TRUE;
                         word := GetWord;

                              IF word='ON'  THEN listFlag := TRUE
                         ELSE IF word='OFF' THEN listFlag := FALSE
                         ELSE                    listThisLine := listFlag;
                      END

                   ELSE IF word='OPT' THEN
                      BEGIN
                         listThisLine := TRUE;
                         word := GetWord;

                              IF word='LIST'   THEN listFlag := TRUE
                         ELSE IF word='NOLIST' THEN listFlag := FALSE
                         ELSE                       listThisLine := listFlag;
                      END;
               END;
            END;

         IF listThisLine THEN ListOut;
      END;

   Close(source);
END;


PROCEDURE SortSymTab;

VAR
   i,j,t:  SymPtr;
   sorted: Boolean;
   temp:   SymRec;

BEGIN
   IF symTab<>NIL THEN BEGIN

      i := symTab;
      j := i^.next;
      WHILE (j<>NIL) DO BEGIN
         sorted := TRUE;

         WHILE (j<>NIL) DO BEGIN
            IF j^.name < i^.name THEN BEGIN
               temp := i^;
               i^   := j^;
               j^   := temp;

               t       := i^.next;
               i^.next := j^.next;
               j^.next := t;

               sorted := FALSE;
            END;
            j := j^.next;
         END;
         i := i^.next;
         j := i^.next;
      END;
   END;
END;


PROCEDURE DumpSym(p: SymPtr);

BEGIN
   Write(listing,p^.name:maxSymLen,' ',Hex4(p^.value));

   IF NOT p^.defined  THEN Write(listing,' U');
   IF     p^.multiDef THEN Write(listing,' M');
   IF     p^.isSet    THEN Write(listing,' S');
   IF     p^.equ      THEN Write(listing,' E');

   WriteLn(listing);
END;


PROCEDURE DumpSymTab;

VAR
   p: SymPtr;

BEGIN
   SortSymTab;

   p := symTab;
   WHILE (p<>NIL) DO BEGIN
      DumpSym(p);
      p := p^.next;
   END;
END;


PROCEDURE ShowOptions;

BEGIN
   WriteLn;
   WriteLn('  Command line syntax:');
   WriteLn;
   WriteLn('  ASM8080 [options] src [options]');
   WriteLn;
   WriteLn('  Valid options:');
   WriteLn;
   WriteLn('    -E  Show errors to screen');
   WriteLn('    -L  Make a listing file to src.LIS');
   WriteLn('    -L=name');
   WriteLn('    -O  Make an object file to src.OBJ');
   WriteLn('    -O=name');
   WriteLn;
END;


FUNCTION GetOption(VAR optStr: String): String;

VAR
   option: String[80];
   p:      Integer;

BEGIN
   optStr := Deblank(optStr);

   p := Pos(' ',optStr);

   IF p=0 THEN BEGIN
      option := optStr;
      optStr := '';
   END
   ELSE BEGIN
      option := Copy(optStr,1,p-1);
      optStr := Copy(optStr,p+1,255);
   END;

   optStr := UprCase(Deblank(optStr));

   GetOption := option;
END;


FUNCTION GetOptions(VAR cl_SrcName, cl_ListName,cl_ObjName: String;
                     VAR cl_Err: Boolean): Boolean;

VAR
   s:       String;
   len:     Integer;
   optStr:  String;
   option:  String;
   optParm: String;
   prefix:  String;
   p:       Integer;
   err:     Integer;
   optErr:  Boolean;
   i:       Integer;

BEGIN
   cl_SrcName  := '';
   cl_ListName := 'NUL';
   cl_ObjName  := 'NUL';
   cl_Err      := FALSE;

   optErr := FALSE;
   optStr := ParamStr(1);
   FOR i := 2 TO ParamCount DO
      optStr := optStr + ' ' + ParamStr(i);

   option := GetOption(optStr);
   WHILE Length(option)<>0 DO BEGIN
      optParm := '';

      p := Pos('=',option);
      IF p>0 THEN BEGIN
         optParm := Copy(option,p+1,255);
         option  := Copy(option,1,p-1);
      END;

           IF option = '-L' THEN cl_ListName := optParm
      ELSE IF option = '-O' THEN cl_ObjName  := optParm
      ELSE IF option = '-E' THEN cl_Err      := TRUE
      ELSE IF option = '?'  THEN optErr      := TRUE
      ELSE BEGIN
         IF (Copy(option,1,1)='-') OR (Length(cl_SrcName)<>0) OR
            (Length(optParm)<>0) THEN BEGIN
            optErr := TRUE;
            WriteLn('Illegal command line option:  ',option);
         END
         ELSE BEGIN
            cl_SrcName := option;
            IF Pos('.',cl_SrcName)=0 THEN
               IF p=0 THEN cl_SrcName := cl_SrcName + '.ASM';

            p := Pos('.',option);
            IF p=0 THEN prefix := option
                   ELSE prefix := Copy(option,1,p-1);
         END;
      END;

      option := GetOption(optStr);
   END;

   IF cl_SrcName = '' THEN BEGIN
      optErr := TRUE;
      WriteLn('Source file not specified')
   END;

   IF cl_ListName = '' THEN cl_ListName := prefix + '.LIS';
   IF cl_ObjName  = '' THEN cl_ObjName  := prefix + '.DAT';
   IF Copy(cl_ListName,1,1)='.' THEN cl_ListName := prefix + cl_ListName;
   IF Copy(cl_ObjName ,1,1)='.' THEN cl_ObjName  := prefix + cl_ObjName;

   GetOptions := optErr;
END;


BEGIN
   IF GetOptions(cl_SrcName,cl_ListName,cl_ObjName,cl_Err) THEN BEGIN
      ShowOptions;
      Halt;
   END;

   Assign(listing,cl_ListName);
   Rewrite(listing);
   Assign(object,cl_ObjName);
   Rewrite(object);

   symTab    := NIL;
   xferAddr  := 0;
   xferFound := FALSE;
   InitOpcodes;

   pass := 1;
   DoPass;

   pass := 2;
   DoPass;

   WriteLn(listing);
   WriteLn(listing,errCount:5,' Total Error(s)');
   WriteLn(listing);

   IF cl_Err THEN BEGIN
      WriteLn;
      WriteLn(errCount:5,' Total Error(s)');
   END;

   DumpSymTab;

   Close(listing);
   Close(object);
END.