simx86p.pas

汇编编程艺术

    { Zero out the allocated memory }

    for i := 0 to $ffef do
    	Memory^[i] := 0;

    MemAdrs := 0;
    MemWS := 0;
    IntAdrs := $FFFF;
    Adrs := 0;
    AX := 0;
    BX := 0;
    CX := 0;
    DX := 0;
    IP := 0;

    MemEntry[0,0] := Mem00;
    MemEntry[0,1] := Mem01;
    MemEntry[0,2] := Mem02;
    MemEntry[0,3] := Mem03;
    MemEntry[0,4] := Mem04;
    MemEntry[0,5] := Mem05;
    MemEntry[0,6] := Mem06;
    MemEntry[0,7] := Mem07;

    MemEntry[1,0] := Mem10;
    MemEntry[1,1] := Mem11;
    MemEntry[1,2] := Mem12;
    MemEntry[1,3] := Mem13;
    MemEntry[1,4] := Mem14;
    MemEntry[1,5] := Mem15;
    MemEntry[1,6] := Mem16;
    MemEntry[1,7] := Mem17;

    MemEntry[2,0] := Mem20;
    MemEntry[2,1] := Mem21;
    MemEntry[2,2] := Mem22;
    MemEntry[2,3] := Mem23;
    MemEntry[2,4] := Mem24;
    MemEntry[2,5] := Mem25;
    MemEntry[2,6] := Mem26;
    MemEntry[2,7] := Mem27;

    MemEntry[3,0] := Mem30;
    MemEntry[3,1] := Mem31;
    MemEntry[3,2] := Mem32;
    MemEntry[3,3] := Mem33;
    MemEntry[3,4] := Mem34;
    MemEntry[3,5] := Mem35;
    MemEntry[3,6] := Mem36;
    MemEntry[3,7] := Mem37;

    MemEntry[4,0] := Mem40;
    MemEntry[4,1] := Mem41;
    MemEntry[4,2] := Mem42;
    MemEntry[4,3] := Mem43;
    MemEntry[4,4] := Mem44;
    MemEntry[4,5] := Mem45;
    MemEntry[4,6] := Mem46;
    MemEntry[4,7] := Mem47;

    MemEntry[5,0] := Mem50;
    MemEntry[5,1] := Mem51;
    MemEntry[5,2] := Mem52;
    MemEntry[5,3] := Mem53;
    MemEntry[5,4] := Mem54;
    MemEntry[5,5] := Mem55;
    MemEntry[5,6] := Mem56;
    MemEntry[5,7] := Mem57;

    MemEntry[6,0] := Mem60;
    MemEntry[6,1] := Mem61;
    MemEntry[6,2] := Mem62;
    MemEntry[6,3] := Mem63;
    MemEntry[6,4] := Mem64;
    MemEntry[6,5] := Mem65;
    MemEntry[6,6] := Mem66;
    MemEntry[6,7] := Mem67;

    MemEntry[7,0] := Mem70;
    MemEntry[7,1] := Mem71;
    MemEntry[7,2] := Mem72;
    MemEntry[7,3] := Mem73;
    MemEntry[7,4] := Mem74;
    MemEntry[7,5] := Mem75;
    MemEntry[7,6] := Mem76;
    MemEntry[7,7] := Mem77;

    { See if there were any command-line parameters }

    if (ParamCount = 1) then
    begin

        SourceCode.Lines.LoadFromFile(ParamStr(1));
        Filename := ParamStr(1);

    end
    else Filename := '';


end;






(****************************************************************************)


{$R *.DFM}


{ Read a byte from memory.  Also handles memory-mapped I/O (locations	}
{ $FFF0.$FFFF are memory-mapped I/O locations).				}
{									}
{ $FFF0 (bit 0)-	Switch zero.					}
{ $FFF2 (bit 0)-	Switch one.					}
{ $FFF4 (bit 0)-	Switch two.					}
{ $FFF6 (bit 0)-	Switch three.					}
{ 	All other bit positions return zero in the above words.		}
{									}
{	Locations $FFF8..$FFFF are write-only locations and return	}
{	random garbage.							}

function ReadMem(adrs:word):byte;
begin

	if (adrs < $fff0) then Result := Memory^[adrs]
        else begin

            with SIMx86Form do begin

        	if (Adrs = $fff0) then Result := ord(Inport0.pOn)
                else if (Adrs = $fff2) then Result := ord(Inport2.pOn)
                else if (Adrs = $fff4) then Result := ord(Inport4.pOn)
                else if (Adrs = $fff6) then Result := ord(Inport6.pOn)
                else if (Adrs = $fff1) or (Adrs=$FFF3) or
                	(Adrs = $fff5) or (Adrs=$fff7) then Result := 0;

            end;

        end;

end;



{ WriteMem-	Write a byte to memory.  Note that locations	}
{		$FFF0..$FFFF are memory mapped I/O locations	}
{		and must be handled specially.  Only the low-	}
{		order bit of locations $FFF8, $FFFA, $FFFC, and	}
{		$FFFE are active outputs;  these bits cor-	}
{		respond to the four LEDs.  The other memory-	}
{		mapped I/O locations ignore data written to them}

procedure WriteMem(Adrs:word; Value:word);
begin

	if (Adrs < $fff0) then
        	Memory^[Adrs] := Value
        else begin

            with SIMx86Form do begin

        	if (Adrs = $fff8) then
                	if (odd(Value)) then Outport8.Brush.Color := clRed
                        else Outport8.Brush.Color := clWhite
                else if (Adrs = $fffa) then
                	if (odd(Value)) then OutportA.Brush.Color := clRed
                        else OutportA.Brush.Color := clWhite
                else if (Adrs = $fffC) then
                	if (odd(Value)) then OutportC.Brush.Color := clRed
                        else OutportC.Brush.Color := clWhite
                else if (Adrs = $fffe) then
                	if (odd(Value)) then OutportE.Brush.Color := clRed
                        else OutportE.Brush.Color := clWhite;

            end;
        end;

end;



{ Print an error message dialog box for the assembler. }

procedure ErrorMsg(const msg, Stmt:string);
begin

     AbortAsm := MessageDlg(msg+': '+Stmt,
                            mtWarning,[mbOK, mbCancel],0) = mrCancel;
     NoError := false;

end;


{ The following function converts a string of characters representing a	}
{ hexadecimal number into the binary equivalent.			}

function HexToWord(const s:string):word;
var i:integer;
begin

     Result := 0;
     for i := 1 to length(s) do
         if (s[i] in ['0'..'9']) then
            Result := (Result shl 4) + ord(s[i]) - ord('0')
         else
            Result := (Result shl 4) + ord(upcase(s[i])) -
                              ord('A') + 10;
end;




{ CheckHex-	This procedure checks a TEdit object to see if its text	}
{		field contains a valid hexadecimal value.  It turns the	}
{		background red if invalid.				}

procedure CheckHex(var s:TEdit);
var i:integer;
begin

    s.Color := clWindow;
    for i := 1 to length(s.Text) do
    	if not (s.Text[i] in ['0'..'9','A'..'F','a'..'f']) then
        begin

           s.Color := clRed;
           MessageBeep($FFFF);

        end;

end;






{$F+}

{ Whenever the assembler encounters a label at the beginning of a line,	}
{ the following function checks to see if it is a legal label and adds	}
{ it to the symbol table along with its address.  It also backpatches	}
{ any previous references to that symbol if there are any.		}

function ProcessLbl(Pat:TPatPtr):boolean;
var id:	char;
    i,
    tmp:word;
begin

     id :=upcase(Pat^.EndPattern^);

     { See if this is a legal label }

     if (id in ['A'..'Z']) and ((Pat^.EndPattern+1)^ = ':') then
     begin

     	  {See if this symbol is already in the symbol table.	}

          if SymTbl[id].Defined then
          begin

             ErrorMsg('Duplicate Identifier',
                   SIMx86Form.SourceCode.lines[LineNum]);

          end
          else begin

               { See if this symbol was used already.	}
               { If so, we need to backpatch some	}
               { addresses in memory.			}

               if (SymTbl[id].Value <> 0) then
               begin

                  i := SymTbl[id].Value;
                  repeat

                   	tmp := Memory^[i] + (Memory^[i+1] shl 8);
                   	Memory^[i] := Adrs and $ff;
                        Memory^[i+1] := Adrs shr 8;
                        i := tmp;

                   until i = 0;

               end;

               { Put all the necessary information into the symbol table. }

               SymTbl[id].Defined := true;
               SymTbl[id].Value := adrs;
               Result := true;

               { Skip over any white space following this label. }

               Pat^.EndPattern := Pat^.EndPattern + 2;
               While (Pat^.EndPattern^ in [' ',#9]) do
                     inc(Pat^.EndPattern);

          end;


     end
     else Result := false;

end;


{ ConvertHex-	Converts the text field of a PChar object into a binary	}
{		value and return true if the result is successful.	}
{		This routine shoves the binary result into the global	}
{		variable OperandValue.  The assembler uses this func	}
{		to process hexadecimal instruction operands.		}

function ConvertHex(Pat:TPatPtr):Boolean;
var i:integer;
begin

     OperandValue := 0;
     Result := Pat^.EndPattern^ in ['0'..'9', 'a'..'f', 'A'..'F'];
     HasValue := true;
     while (Pat^.EndPattern^ in ['0'..'9', 'a'..'f', 'A'..'F']) do
     begin

         if (Pat^.EndPattern^  in ['0'..'9']) then
            OperandValue := (OperandValue shl 4) +
            		     ord(Pat^.EndPattern^) - ord('0')
         else
            OperandValue := ( OperandValue shl 4) +
            		      ord(upcase(Pat^.EndPattern^ )) -
                              ord('A') + 10;

         inc(Pat^.EndPattern);

     end;
end;



{ GetLbl-	The assembler uses this function to process labels it	}
{		finds in the operand field of a jump instruction.	}

function GetLbl(Pat:TPatPtr):boolean;
var id:char;
begin

     id :=upcase(Pat^.EndPattern^);
     Result := false;

     { If the operand begins with a decimal digit, it's a hexadecimal	}
     { number, not a label.						}

     if (id in ['0'..'9']) then
     begin

        HasValue := ConvertHex(Pat);
        while (Pat^.EndPattern^ in [' ',#9]) do inc(Pat^.EndPattern);
        Result := Pat^.EndPattern^ = #0;

     end

     { If the operand begins with an alphabetic character, then we've	}
     { got a label.							}

     else if (id in ['A'..'Z']) then
     begin

     	  HasValue := true;
     	  if (not SymTbl[id].Defined) then
          begin

          	{ If the symbol is not defined yet, create a linked }
                { list of undefined items for this symbol.	    }

          	OperandValue := SymTbl[id].Value;
                SymTbl[id].Value := adrs+1;

          end
          else OperandValue := SymTbl[id].Value;

          repeat

                inc(Pat^.EndPattern);

          until not (Pat^.EndPattern^ in [' ',#9]);
          Result := Pat^.EndPattern^ = #0;

     end
     else begin

          ErrorMsg('Expected label operand',
                   SIMx86Form.SourceCode.lines[LineNum]);

     end;


end;







{ The assembler calls the following procedure whenever it encounters	}
{ the corresponding procedure or operand.  These procedures set up the	}
{ global opcode and operand values so the assembler can emit the ap-	}
{ propriate object code later.						}

Procedure SetJmp(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $8;
     HasOperand := true;
     OperandCode := $6;

end;

Procedure SetJa(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $8;
     HasOperand := true;
     OperandCode := $4;

end;

Procedure SetJae(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $8;
     HasOperand := true;
     OperandCode := $5;

end;

Procedure SetJb(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $8;
     HasOperand := true;
     OperandCode := $2;

end;

Procedure SetJbe(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $8;
     HasOperand := true;
     OperandCode := $3;

end;

Procedure SetJe(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $8;
     HasOperand := true;
     OperandCode := $0;

end;

Procedure SetJne(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $8;
     HasOperand := true;
     OperandCode := $1;

end;


Procedure SetNot(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $10;

end;

Procedure SetOr(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $20;

end;

Procedure SetAnd(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $40;

end;

Procedure SetCmp(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $60;

end;

Procedure SetSub(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $80;

end;

Procedure SetAdd(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $A0;

end;

Procedure SetMovReg(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $C0;

end;

Procedure SetMovMem(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $E0;

end;

Procedure SetBRK(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $0;
     HasOperand := true;
     OperandCode := $3;

end;

Procedure SetIret(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $0;
     HasOperand := true;
     OperandCode := $4;

end;

Procedure SetHalt(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $0;
     HasOperand := true;
     OperandCode := $5;

end;

Procedure SetPut(Pat:TPatPtr);
begin

     HasOpcode := True;
     Opcode := $0;
     HasReg := true;
     RegCode := $0;
     HasOperand := true;
     OperandCode := $7;