листинг функции Val

[Desha]

глупый вопрос, конечно, но где я могу просмотреть листинг функции Val?

[eoln]

Выбирай что-нибудь из списка (модуль System)

function _ValLong(const s: string; var code: Integer): Longint;
function _ValExt(s: string; var code: Integer): Extended;
procedure _ValExt;
function _ValInt64L(const s: AnsiString; var code: Integer): Int64;
function _ValInt64(const s: string; var code: Integer): Int64;

и т.п.

[Serge_Bliznykov]

eoln, +1

позволю себе привести исходник одной из вышеназванных функций (взял из system.pas версии Delphi 2006):

function _ValLong(const s: String; var code: Integer): Longint;
{$IFDEF PUREPASCAL}
var
  I: Integer;
  Negative, Hex: Boolean;
begin
  I := 1;
  code := -1;
  Result := 0;
  Negative := False;
  Hex := False;
  while (I <= Length(s)) and (s[I] = ' ') do Inc(I);
  if I > Length(s) then Exit;
  case s[I] of
    '$',
    'x',
    'X': begin
           Hex := True;
           Inc(I);
         end;
    '0': begin
          Hex := (Length(s) > I) and (UpCase(s[I+1]) = 'X');
    if Hex then Inc(I,2);
         end;
    '-': begin
          Negative := True;
          Inc(I);
         end;
    '+': Inc(I);
  end;
  if Hex then
    while I <= Length(s) do
    begin
      if Result > (High(Result) div 16) then
      begin
        code := I;
        Exit;
      end;
      case s[I] of
        '0'..'9': Result := Result * 16 + Ord(s[I]) - Ord('0');
        'a'..'f': Result := Result * 16 + Ord(s[I]) - Ord('a') + 10;
        'A'..'F': Result := Result * 16 + Ord(s[I]) - Ord('A') + 10;
      else
        code := I;
        Exit;
      end;
    end
  else
    while I <= Length(s) do
    begin
      if Result > (High(Result) div 10) then
      begin
        code := I;
        Exit;
      end;
      Result := Result * 10 + Ord(s[I]) - Ord('0');
      Inc(I);
    end;
  if Negative then
    Result := -Result;
  code := 0;
end;
{$ELSE}
asm
{       FUNCTION _ValLong( s: AnsiString; VAR code: Integer ) : Longint;        }
{     ->EAX     Pointer to string       }
{       EDX     Pointer to code result  }
{     <-EAX     Result                  }

        PUSH    EBX
        PUSH    ESI
        PUSH    EDI

        MOV     ESI,EAX
        PUSH    EAX             { save for the error case       }

        TEST    EAX,EAX
        JE      @@empty

        XOR     EAX,EAX
        XOR     EBX,EBX
        MOV     EDI,07FFFFFFFH / 10     { limit }

@@blankLoop:
        MOV     BL,[ESI]
        INC     ESI
        CMP     BL,' '
        JE      @@blankLoop

@@endBlanks:
        MOV     CH,0
        CMP     BL,'-'
        JE      @@minus
        CMP     BL,'+'
        JE      @@plus

@@checkDollar:
        CMP     BL,'$'
        JE      @@dollar

        CMP     BL, 'x'
        JE      @@dollar
        CMP     BL, 'X'
        JE      @@dollar
        CMP     BL, '0'
        JNE     @@firstDigit
        MOV     BL, [ESI]
        INC     ESI
        CMP     BL, 'x'
        JE      @@dollar
        CMP     BL, 'X'
        JE      @@dollar
        TEST    BL, BL
        JE      @@endDigits
        JMP     @@digLoop

@@firstDigit:
        TEST    BL,BL
        JE      @@error

@@digLoop:
        SUB     BL,'0'
        CMP     BL,9
        JA      @@error
        CMP     EAX,EDI         { value > limit ?       }
        JA      @@overFlow
        LEA     EAX,[EAX+EAX*4]
        ADD     EAX,EAX
        ADD     EAX,EBX         { fortunately, we can't have a carry    }

        MOV     BL,[ESI]
        INC     ESI

        TEST    BL,BL
        JNE     @@digLoop

@@endDigits:
        DEC     CH
        JE      @@negate
        TEST    EAX,EAX
        JGE     @@successExit
        JMP     @@overFlow

@@empty:
        INC     ESI
        JMP     @@error

@@negate:
        NEG     EAX
        JLE     @@successExit
        JS      @@successExit           { to handle 2**31 correctly, where the negate overflows }

@@error:
@@overFlow:
        POP     EBX
        SUB     ESI,EBX
        JMP     @@exit

@@minus:
        INC     CH
@@plus:
        MOV     BL,[ESI]
        INC     ESI
        JMP     @@checkDollar

@@dollar:
        MOV     EDI,0FFFFFFFH

        MOV     BL,[ESI]
        INC     ESI
        TEST    BL,BL
        JZ      @@empty

@@hDigLoop:
        CMP     BL,'a'
        JB      @@upper
        SUB     BL,'a' - 'A'
@@upper:
        SUB     BL,'0'
        CMP     BL,9
        JBE     @@digOk
        SUB     BL,'A' - '0'
        CMP     BL,5
        JA      @@error
        ADD     BL,10
@@digOk:
        CMP     EAX,EDI
        JA      @@overFlow
        SHL     EAX,4
        ADD     EAX,EBX

        MOV     BL,[ESI]
        INC     ESI

        TEST    BL,BL
        JNE     @@hDigLoop

        DEC     CH
        JNE     @@successExit
        NEG     EAX

@@successExit:
        POP     ECX                     { saved copy of string pointer  }
        XOR     ESI,ESI         { signal no error to caller     }

@@exit:
        MOV     [EDX],ESI
        POP     EDI
        POP     ESI
        POP     EBX
end;
{$ENDIF}

[Stilet]

{$IFDEF PUREPASCAL}

Стесняюсь спросить это что за зверь такой?

[Serge_Bliznykov]

А кто его знает.. Бормандовцы придумали.
На мой взгляд, судя по имени, это условная компиляция, которая будет проходить используя исключительно код на Паскале (может быть полезно, если компилируется не под Intel процессор). А может быть, написано для упрощения понимания работы процедуры...
точно не скажу...

да. погуглил.
похоже, я не ошибся в своих предположениях.
Writing Delphi code for 64 bits compiler

purepascal

или вот пример с сайта эмбаркадеро: Delphi compiler directives

[Stilet]

Ох уж эти "Бормадновцы"