Changeset 55 for branches


Ignore:
Timestamp:
Nov 22, 2023, 10:09:35 PM (12 months ago)
Author:
chronos
Message:
  • Modified: Extended BigInt type implementation.
Location:
branches/ByteArray
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • branches/ByteArray/Assembler.pas

    r46 r55  
    245245        end else Error('Expected register name starting with R character.', Token.Pos);
    246246        Parser.Expect(tkSpecialSymbol, ')');
    247       end else
    248       if InstructionInfo.Params[I] = ptRegIndirectGroup then begin
    249         Parser.Expect(tkSpecialSymbol, '(');
    250         Token := Parser.ReadNext;
    251         if (Token.Value <> '') and (Token.Value[1] = 'R') then begin
    252           Token.Value := Copy(Token.Value, 2, MaxInt);
    253           if TryStrToInt(Token.Value, Number) then begin
    254             Memory.WritePos(1, Number);
    255             Parser.Expect(tkSpecialSymbol, ':');
    256             Token := Parser.ReadNext;
    257             if (Token.Value <> '') and (Token.Value[1] = 'R') then begin
    258               Token.Value := Copy(Token.Value, 2, MaxInt);
    259               if TryStrToInt(Token.Value, Number) then begin
    260                 Memory.WritePos(1, Number);
    261               end else Error('Expected numeric register index error', Token.Pos);
    262             end else Error('Expected register name starting with R character.', Token.Pos);
    263           end else Error('Expected numeric register index error', Token.Pos);
    264         end else Error('Expected register name starting with R character.', Token.Pos);
    265         Parser.Expect(tkSpecialSymbol, ')');
    266       end else
     247      end else Error('Unsupported parameter type', Token.Pos);
    267248    end;
    268249  end;

  • branches/ByteArray/BigInt.pas

    r52 r55  
    3636    class operator Implicit(A: TBigInt): Int64;
    3737    class operator Implicit(A: TBigInt): PByte;
     38    class operator Negative(A: TBigInt): TBigInt;
    3839    class operator Inc(A: TBigInt) : TBigInt;
    3940    class operator Dec(A: TBigInt) : TBigInt;
    … …  
    4647    class operator GreaterThan(A, B: TBigInt): Boolean;
    4748    class operator GreaterThanOrEqual(A, B: TBigInt): Boolean;
     49    class operator BitwiseXor(A, B: TBigInt): TBigInt;
     50    class operator BitwiseAnd(A, B: TBigInt): TBigInt;
     51    class operator BitwiseOr(A, B: TBigInt): TBigInt;
     52    class operator LeftShift(A: TBigInt; B: Integer): TBigInt;
     53    class operator RightShift(A: TBigInt; B: Integer): TBigInt;
     54    class operator Modulus(A, B: TBigInt): TBigInt;
     55    class operator IntDivide(A, B: TBigInt): TBigInt;
    4856    procedure Shrink;
    4957    function IsNegative: Boolean;
    5058    function IsZero: Boolean;
    5159    function IsPositive: Boolean;
     60    procedure Invert;
    5261    procedure SetByteArray(AData: TArrayOfByte; ASize: TBigIntSize);
    5362    procedure GetByteArray(var AData: TArrayOfByte; ASize: TBigIntSize);
    54     function Copy(Size: TBigIntSize): TBigInt;
     63    function Copy(Size: TBigIntSize): TBigInt; overload;
     64    function Copy: TBigInt; overload;
    5565    property Size: TBigIntSize read GetSize write SetSize;
    5666    property Data[Index: TBigIntSize]: Byte read GetData write SetData;
    … …  
    5868
    5969function TryStrToBigInt(const S: string; out I: TBigInt): Boolean;
     70function IntToStr(Value: TBigInt): string; overload;
     71function IntToHex(Value: TBigInt): string; overload;
     72function IntToHex(Value: TBigInt; Digits: Integer): string; overload;
    6073
    6174
    … …  
    6477resourcestring
    6578  SUnsupportedByteSize = 'Unsupported byte size';
     79  SOutOfRange = 'Out of range';
     80
     81const
     82   HexDigits: array[0..15] of Char = '0123456789ABCDEF';
    6683
    6784function TryStrToBigInt(const S: string; out I: TBigInt): Boolean;
    … …  
    7390end;
    7491
     92function IntToHex(Value: TBigInt): string;
     93begin
     94  Result := '';
     95  while Value <> 0 do begin
     96    Result := HexDigits[Value and 15] + Result;
     97    Value := Value shr 4;
     98  end;
     99  if Result = '' then Result := '0';
     100end;
     101
     102function IntToHex(Value: TBigInt; Digits: Integer): string;
     103var
     104  I: Integer;
     105begin
     106  if Digits = 0 then
     107    Digits := 1;
     108  Result := '';
     109  SetLength(Result, Digits);
     110  for I := 0 to Digits - 1 do
     111  begin
     112    Result[Digits - I] := HexDigits[Value and 15];
     113    Value := Value shr 4;
     114  end ;
     115  while Value <> 0 do begin
     116    Result := HexDigits[Value and 15] + Result;
     117    Value := Value shr 4;
     118  end;
     119end;
     120
     121function IntToStr(Value: TBigInt): string;
     122begin
     123  Result := '';
     124  if Value < 0 then begin
     125    Value := -Value;
     126    while Value > 9 do begin
     127      Result := Chr(Ord('0') + (Value mod 10)) + Result;
     128      Value := Value div 10;
     129    end;
     130    Result := '-' + Chr(Ord('0') + (Value mod 10)) + Result;
     131  end else begin
     132    while Value > 9 do begin
     133      Result := Chr(Ord('0') + (Value mod 10)) + Result;
     134      Value := Value div 10;
     135    end;
     136    Result := Chr(Ord('0') + Value) + Result;
     137  end;
     138end;
     139
    75140{ TBigInt }
    76141
    … …  
    88153procedure TBigInt.SetData(Index: TBigIntSize; AValue: Byte);
    89154begin
    90   if Index > Integer(Size) - 1 then Size := Index + 1;
     155  if Index >= Integer(Size) then raise Exception.Create(SOutOfRange);
    91156  FData[Index] := AValue;
    92157end;
    … …  
    209274end;
    210275
     276class operator TBigInt.Negative(A: TBigInt): TBigInt;
     277begin
     278  Result := A.Copy(A.Size);
     279  Result.Invert;
     280  Result := Result + 1;
     281end;
     282
    211283class operator TBigInt.Inc(A: TBigInt): TBigInt;
    212284begin
    … …  
    224296  V: SmallInt;
    225297  Carry: Byte;
    226 begin
    227   Result.Size := Max(A.Size, B.Size);
     298  Size: Byte;
     299begin
     300  Size := Max(A.Size, B.Size);
     301  Result.Size := Size;
    228302  Carry := 0;
    229303  I := 0;
    230   while (I < Result.Size) or (Carry > 0) do begin
     304  while (I < Size) or (Carry > 0) do begin
     305    if I >= Result.Size then Result.Size := I + 1;
    231306    V := A.Data[I] + B.Data[I] + Carry;
    232307    if V >= 256 then begin
    … …  
    240315class operator TBigInt.Subtract(A, B: TBigInt): TBigInt;
    241316var
    242   I: Integer;
    243   V: SmallInt;
    244   Carry: Byte;
    245 begin
    246   Result.Size := Max(A.Size, B.Size);
    247   Carry := 0;
    248   I := 0;
    249   while (I < Result.Size) or (Carry > 0) do begin
    250     V := A.Data[I] - B.Data[I] - Carry;
    251     if V < 0 then begin
    252       Carry := 1;
    253     end else Carry := 0;
    254     Result.Data[I] := V and $ff;
    255     Inc(I);
    256   end;
     317  Size: TBigIntSize;
     318begin
     319  Size := Max(A.Size, B.Size);
     320  Result := A + -B;
     321  Result.Size := Size;
     322  Result.Shrink;
    257323end;
    258324
    … …  
    316382end;
    317383
     384class operator TBigInt.BitwiseXor(A, B: TBigInt): TBigInt;
     385var
     386  I: TBigIntSize;
     387begin
     388  Result.Size := Max(A.Size, B.Size);
     389  for I := 0 to Result.Size - 1 do
     390    Result.Data[I] := A.Data[I] xor B.Data[I];
     391  Result.Shrink;
     392end;
     393
     394class operator TBigInt.BitwiseAnd(A, B: TBigInt): TBigInt;
     395var
     396  I: TBigIntSize;
     397begin
     398  Result.Size := Max(A.Size, B.Size);
     399  for I := 0 to Result.Size - 1 do
     400    Result.Data[I] := A.Data[I] and B.Data[I];
     401  Result.Shrink;
     402end;
     403
     404class operator TBigInt.BitwiseOr(A, B: TBigInt): TBigInt;
     405var
     406  I: TBigIntSize;
     407begin
     408  Result.Size := Max(A.Size, B.Size);
     409  for I := 0 to Result.Size - 1 do
     410    Result.Data[I] := A.Data[I] or B.Data[I];
     411  Result.Shrink;
     412end;
     413
     414class operator TBigInt.LeftShift(A: TBigInt; B: Integer): TBigInt;
     415var
     416  ByteShift: TBigIntSize;
     417  BitShift: Byte;
     418  I: Integer;
     419begin
     420  if (B and 7) = 0 then begin
     421    // Full byte shift
     422    ByteShift := B shr 3;
     423    Result.Size := A.Size + ByteShift;
     424    Move(A.FData[0], Result.FData[ByteShift], A.Size);
     425    FillChar(Result.FData[0], ByteShift, 0);
     426  end else begin
     427    // Partial byte shift
     428    ByteShift := B shr 3;
     429    BitShift := B - ByteShift;
     430    Result.Size := Result.Size + ByteShift + 1;
     431    for I := 0 to A.Size - 1 do begin
     432      Result.FData[I + ByteShift] := (A.FData[I] shl BitShift) and $ff;
     433      if I > 0 then Result.FData[I + ByteShift] := Result.FData[I + ByteShift] or (A.FData[I] shl BitShift shl 8);
     434    end;
     435  end;
     436  Result.Shrink;
     437end;
     438
     439class operator TBigInt.RightShift(A: TBigInt; B: Integer): TBigInt;
     440var
     441  ByteShift: TBigIntSize;
     442  BitShift: Byte;
     443  I: Integer;
     444begin
     445  if (B and 7) = 0 then begin
     446    // Full byte shift
     447    ByteShift := B shr 3;
     448    Result.Size := A.Size - ByteShift;
     449    Move(A.FData[ByteShift], Result.FData[0], A.Size);
     450  end else begin
     451    // Partial byte shift
     452    ByteShift := B shr 3;
     453    BitShift := B - ByteShift;
     454    Result.Size := Result.Size - ByteShift;
     455    for I := 0 to A.Size - 1 do begin
     456      Result.FData[I] := (A.FData[I + ByteShift] shr BitShift) and $ff;
     457      if I < (A.Size - 1) then Result.FData[I] := Result.FData[I] or (((A.FData[I + ByteShift] shl 8) shr BitShift) and $ff);
     458    end;
     459  end;
     460  Result.Shrink;
     461end;
     462
     463class operator TBigInt.Modulus(A, B: TBigInt): TBigInt;
     464begin
     465
     466end;
     467
     468class operator TBigInt.IntDivide(A, B: TBigInt): TBigInt;
     469begin
     470
     471end;
     472
    318473procedure TBigInt.Shrink;
    319474var
    … …  
    346501begin
    347502  Result := (FData[Size - 1] and $80) = 0;
     503end;
     504
     505procedure TBigInt.Invert;
     506var
     507  I: Byte;
     508begin
     509  for I := 0 to Size - 1 do
     510    FData[I] := FData[I] xor $ff;
    348511end;
    349512
    … …  
    372535end;
    373536
     537function TBigInt.Copy: TBigInt;
     538begin
     539  Result := Copy(Size);
     540end;
     541
    374542end.
    375543

  • branches/ByteArray/Cpu.pas

    r52 r55  
    269269  RegIndex := ReadRegIndex;
    270270  Address := Read(AddressWidth);
    271   if Byte(Regs[RegIndex]) <> 0 then
     271  if Regs[RegIndex] <> 0 then
    272272    PC := Address;
    273273end;
    … …  
    284284  RegIndex := ReadRegIndex;
    285285  Address := Read(AddressSize);
    286   if Int64(Regs[RegIndex].Copy(DataSize)) <> 0 then
     286  if Regs[RegIndex].Copy(DataSize) <> 0 then
    287287    PC := Address;
    288288end;
    … …  
    295295  RegIndex := ReadRegIndex;
    296296  Address := Read(AddressWidth);
    297   if Byte(Regs[RegIndex]) = 0 then
     297  if Regs[RegIndex] = 0 then
    298298    PC := Address;
    299299end;
    … …  
    310310  RegIndex := ReadRegIndex;
    311311  Address := Read(AddressSize);
    312   if Int64(Regs[RegIndex].Copy(DataSize)) = 0 then
     312  if Regs[RegIndex].Copy(DataSize) = 0 then
    313313    PC := Address;
    314314end;

  • branches/ByteArray/Devices/Memory.pas

    r51 r55  
    1212  TMemory = class(TDevice)
    1313  private
     14    FSize: Integer;
    1415    FData: PByte;
    1516    function GetSize: Integer;
    … …  
    2728    procedure SetChannel(Channel: TChannel); override;
    2829    procedure Clean;
    29     property Size: Integer read GetSize write SetSize;
     30    property Size: Integer read FSize write SetSize;
    3031    destructor Destroy; override;
    3132  end;
    … …  
    3536
    3637resourcestring
    37   SOutOfRange = 'Out of range';
     38  SOutOfRange = 'Address out of range.';
    3839
    3940{ TMemory }
    … …  
    4647procedure TMemory.SetSize(AValue: Integer);
    4748begin
     49  FSize := AValue;
    4850  FData := ReAllocMem(FData, AValue);
    4951end;
    … …  
    5254begin
    5355  Size := Source.Size;
    54   if Size > 0 then
    55     Move(Source.FData[0], FData[0], Size);
     56  if FSize > 0 then
     57    Move(Source.FData[0], FData[0], FSize);
    5658  Position := Source.Position;
    5759end;
    … …  
    5961function TMemory.Read(Address: TBigInt; ASize: TBigIntSize): TBigInt;
    6062begin
    61   if Address + ASize >= Size then raise Exception.Create(SOutOfRange);
     63  if Address + ASize > FSize then raise Exception.Create(SOutOfRange);
    6264  case ASize of
    6365    1: Result := PByte(FData + Integer(Address))^;
    … …  
    7678procedure TMemory.Write(Address: TBigInt; ASize: TBigIntSize; Value: TBigInt);
    7779begin
    78   if Address + ASize >= Size then raise Exception.Create(SOutOfRange);
     80  if Address + ASize > FSize then raise Exception.Create(SOutOfRange);
    7981  case ASize of
    8082    1: PByte(FData + Integer(Address))^ := Value;
    … …  
    9698begin
    9799  if Length(Value) > 0 then begin
    98     if Position + Length(Value) > Size then Size := Position + Length(Value);
     100    if Position + Length(Value) > FSize then Size := Position + Length(Value);
    99101    for I := 0 to Length(Value) - 1 do
    100102      Write(Position + I, 1, Ord(Value[I + 1]));
    … …  
    106108begin
    107109  if Memory.Size > 0 then begin
    108     if Position + Memory.Size > Size then Size := Position + Memory.Size;
     110    if Position + Memory.Size > FSize then Size := Position + Memory.Size;
    109111    Move(Memory.FData[0], FData[Position], Memory.Size);
    110112    Inc(Position, Memory.Size);
    … …  
    114116function TMemory.GetAddressCount: Integer;
    115117begin
    116   Result := Size;
     118  Result := FSize;
    117119end;
    118120
    … …  
    125127procedure TMemory.Clean;
    126128begin
    127   FillChar(FData^, Size, 0);
     129  FillChar(FData^, FSize, 0);
    128130end;
    129131

  • branches/ByteArray/Disassembler.pas

    r52 r55  
    1111
    1212  TDisassembler = class
     13  private
     14    function RegToStr(RegIndex: Byte): string;
     15  public
    1316    InstructionSet: TInstructionSet;
    1417    Memory: TMemory;
    … …  
    2528  BigInt;
    2629
    27 function IntToHex(Value: TBigInt; Digits: Integer): string; overload;
     30function TDisassembler.RegToStr(RegIndex: Byte): string;
    2831begin
    29   Result := IntToHex(UInt64(Value), Digits);
    30 end;
    31 
    32 function IntToStr(Value: TBigInt): string; overload;
    33 begin
    34   Result := IntToStr(UInt64(Value));
     32  Result := Chr(Ord('A') + RegIndex);
    3533end;
    3634
    … …  
    6462            InstText := InstText + ' ';
    6563          if InstructionInfo.Params[J] = ptNumber then begin
    66             InstText := InstText + IntToHex(Value, 8);
     64            InstText := InstText + IntToHex(Value) + 'h';
    6765          end else
    6866          if InstructionInfo.Params[J] = ptReg then begin
    69             InstText := InstText + 'R' + IntToStr(Value);
     67            InstText := InstText + RegToStr(Value);
    7068          end else
    7169          if InstructionInfo.Params[J] = ptRegIndirect then begin
    72             InstText := InstText + '(R' + IntToStr(Value) + ')';
     70            InstText := InstText + '(' + RegToStr(Value) + ')';
    7371          end else
    7472          if InstructionInfo.Params[J] = ptRegIndirectIndex then begin
    75             InstText := InstText + '(R' + IntToStr(Value);
     73            InstText := InstText + '(' + RegToStr(Value);
    7674            Value := Memory.ReadPos(1);
    7775            InstBytes := InstBytes + IntToHex(Value, 2) + ' ';
    7876            InstText := InstText + ' + ' + IntToStr(Value) + ')';
    79           end else
    80           if InstructionInfo.Params[J] = ptRegIndirectGroup then begin
    81             InstText := InstText + '(R' + IntToStr(Value);
    82             Value := Memory.ReadPos(1);
    83             InstBytes := InstBytes + IntToHex(Value, 2) + ' ';
    84             InstText := InstText + ': R' + IntToStr(Value) + ')';
    8577          end;
    8678        end;

  • branches/ByteArray/Instructions.pas

    r46 r55  
    77
    88type
    9   TParamType = (ptNone, ptNumber, ptReg, ptRegIndirect, ptRegIndirectIndex,
    10     ptRegIndirectGroup);
     9  TParamType = (ptNone, ptNumber, ptReg, ptRegIndirect, ptRegIndirectIndex);
    1110  TParamTypeArray = array of TParamType;
    1211
    … …  
    8079  AddNew(inAdd, 'ADD', [ptReg, ptReg], 'Adds second register to first register.');
    8180  AddNew(inSub, 'SUB', [ptReg, ptReg], 'Subtracts second register from first register.');
    82   AddNew(inInput, 'IN', [ptReg, ptRegIndirectGroup], 'Reads value from input port to register.');
    83   AddNew(inOutput, 'OUT', [ptRegIndirectGroup, ptReg], 'Writes value from register to output port.');
     81  AddNew(inInput, 'IN', [ptReg, ptRegIndirect], 'Reads value from input port to register.');
     82  AddNew(inOutput, 'OUT', [ptRegIndirect, ptReg], 'Writes value from register to output port.');
    8483  AddNew(inJumpZero, 'JZ', [ptReg, ptNumber], 'Jumps to given address if value of register is zero');
    8584  AddNew(inJumpNotZero, 'JNZ', [ptReg, ptNumber], 'Jumps to given address if value of register is not zero');

  • branches/ByteArray/Languages/ByteArray.cs.po

    r51 r55  
    1212"X-Generator: Poedit 3.0.1\n"
    1313
     14#: bigint.soutofrange
     15msgctxt "bigint.soutofrange"
     16msgid "Out of range"
     17msgstr "Mimo rozsah"
     18
    1419#: bigint.sunsupportedbytesize
    1520msgid "Unsupported byte size"
    … …  
    4853
    4954#: memory.soutofrange
    50 msgid "Out of range"
    51 msgstr "Mimo rozsah"
     55msgctxt "memory.soutofrange"
     56msgid "Address out of range."
     57msgstr "Adresa mimo rozsah."
    5258
    5359#: parser.sunknowncharacter

  • branches/ByteArray/Languages/ByteArray.pot

    r51 r55  
    11msgid ""
    22msgstr "Content-Type: text/plain; charset=UTF-8"
     3
     4#: bigint.soutofrange
     5msgctxt "bigint.soutofrange"
     6msgid "Out of range"
     7msgstr ""
    38
    49#: bigint.sunsupportedbytesize
    … …  
    3843
    3944#: memory.soutofrange
    40 msgid "Out of range"
     45msgctxt "memory.soutofrange"
     46msgid "Address out of range."
    4147msgstr ""
    4248
Note: See TracChangeset for help on using the changeset viewer.