scanf_c.pas

delphi 实现的 sscanf 函数

(* E. Sorokin  2001, Ver 1.4 *)
(* Version for Delphi 4 and above *)
(* Assembler-level scanner routines and core functions for scanf and DeFormat *)
{$WRITEABLECONST OFF} {$EXTENDEDSYNTAX ON}

// {$DEFINE SCANF_CASE_SENSITIVE}  // uncomment to make scanf case-insensitive.
{$DEFINE DEFORMAT_CASE_SENSITIVE}  // comment out to make DeFormat case-insensitive
// {$DEFINE SCANF_EXCEPTIONS}      // uncomment to generate exceptions in scanf_core
// {$DEFINE DEFORMAT_EXCEPTIONS}   // uncomment to generate exceptions in DeFormat_core
unit Scanf_c;

interface

uses Classes;

const  scOK       = 1;
       scOverflow = 8;
       scEOF = -1;

function Scanf_core(var Buffer: PChar; var Format : PChar;
                    Pointers : array of Pointer) : Integer;

function Scanf_stream(Inp : TStream; var Format : PChar;
                      Pointers : array of Pointer)
                      : Integer;

function DeFormat_core(var Buffer : PChar; BufLen: Cardinal;
                       var Format : PChar; FmtLen: Cardinal;
                       Args: array of const;
                       DecSep, ThSep : char): Cardinal;

function StrToCurrF_core(var Buffer : PChar; BufLen : Cardinal;
                         var Res : Currency;
                         CurrStr : PChar; CurrF, NegCurrF : byte;
                         DecSep, ThSep : char) : Integer;

// Scans Str, assuming it starts with first digit or decimal point (no sign!)
// EShift is the integer, added to the decimal exponent
// (should be 4 for Currency and 0 otherwise, but may be used for any other purpose).
// On success returns scOK, conversion result on st(0)
// On error returns 0, st(0) undefined.
// In $Q+ mode, returns scOverflow bit is set on overflow, conversion result on st(0).
function Ext_scanner(var Str : PChar; Width : cardinal; EShift : integer; DecSep, ThSep : char) : integer;

  resourcestring
  SInvalidInteger = '''%s'' is not a valid integer value';
  SInvalidFloat = '''%s'' is not a valid floating point value';
  SInvalidFormat = 'Format ''%s'' invalid or incompatible with argument';
  SArgumentMissing = 'No argument for format ''%s''';
  SOverflow = 'Floating point overflow';
  SIntOverflow = 'Integer overflow';
  SInvalidCurrency = '''%s'' is not a valid currency value';

implementation

uses SysUtils;

function Hex_scanner(var Str : PChar; var P : int64; Width : cardinal) : integer; register;
asm
// Validity checks
        JECXZ   @@ret           {Width was 0}
        PUSH    EBX             {Save registers to be preserved}
        PUSH    ESI
        PUSH    EDI
//  Initialize
{$IFOPT Q+}
            PUSH    EBP
            XOR     EBP,EBP     {EBP used for overflow tracking}
{$ENDIF}
        PUSH    EAX             {Put @Str on stack }
        MOV     EAX,[EAX]
        OR      EAX,EAX
        JE      @@Str0          {Str was NIL, quit}
        XOR     EBX,EBX
        XOR     ESI,ESI         {EDI:ESI will be a 64-bit accumulator}
        XOR     EDI,EDI

// Main loop start
@@Loop: MOV     BL,[EAX]         {Get char}
        CMP     BL,'a'
        JB      @@upcase
        SUB     BL,'a' - 'A'
@@upcase:
        SUB     BL,'0'
        CMP     BL, 9
        JBE     @@digOk
        SUB     BL,'A' - '0'
        CMP     BL,5
        JA      @@StopScan       {found illegal char}
        ADD     BL,10
//-------- Multiply and add start
@@digOk:
        SHLD    EDI,ESI,4        {64-bit unsigned multiplication by 16}
{$IFOPT Q+}
            ADC     EBP,0        {If CF was set at least once, EDX > 0}
{$ENDIF}
        SHL     ESI,4
        OR      ESI,EBX          {Add BL}
//-------- Multiply and add end
        INC     EAX
        DEC     ECX
        JNZ     @@Loop
// Main loop end

@@StopScan:
        POP     EBX               {Original @Str}
        XOR     ECX,ECX
        CMP     [EBX],EAX         {Were there valid chars?}
        JE      @@Exit            {No valid characters found}
        MOV     [EBX],EAX         {Store new Str}
        INC     ECX               {Set 1 as Result}
        OR      EDX,EDX
        JZ      @@Exit            {Pointer was NIL, no assignment}
        MOV     [EDX+4],EDI       {store high dword of _int64}
        MOV     [EDX],ESI         {store low  dword}
@@Exit:
{$IFOPT Q+}
            OR      EBP,EBP
            POP     EBP
            JNA     @@NoOverflow
            OR      ECX,scOverflow
@@NoOverflow:
{$ENDIF}
        POP     EDI               {restore registers to be preserved}
        POP     ESI
        POP     EBX
@@ret:
        MOV     EAX,ECX           {set return code to Result}
        RET
@@Str0:
        XOR     ECX,ECX
        POP     EBX
        JMP     @@Exit
end;

function Oct_scanner(var Str : PChar; var P : int64; Width : cardinal) : integer; register;
asm
// Validity checks
        JECXZ   @@ret           {Width was 0}
        PUSH    EBX             {Save registers to be preserved}
        PUSH    ESI
        PUSH    EDI
//  Initialize
{$IFOPT Q+}
            PUSH    EBP
            XOR     EBP,EBP     {EBP used for overflow tracking}
{$ENDIF}
        PUSH    EAX             {Put @Str on stack }
        MOV     EAX,[EAX]
        OR      EAX,EAX
        JE      @@Str0          {Str was NIL, quit}
        XOR     EBX,EBX
        XOR     ESI,ESI         {EDI:ESI will be a 64-bit accumulator}
        XOR     EDI,EDI

// Main loop start
@@loop: MOV     BL,[EAX]          {Get char}
        SUB     BL,'0'+8
        ADD     BL,8
        JNC     @@StopScan        {found illegal char}

        SHLD    EDI,ESI,3         {64-bit unsigned multiplication by 8}
{$IFOPT Q+}
            ADC     EBP,0         {Once CF set, EDX > 0}
{$ENDIF}
        SHL     ESI,3
        OR      ESI,EBX           {Add BL}

        INC     EAX
        DEC     ECX
        JNZ     @@loop
// Main loop end

@@StopScan:
        POP     EBX               {Original @Str}
        XOR     ECX,ECX
        CMP     [EBX],EAX         {Were there valid chars?}
        JE      @@Exit            {No valid characters found}
        MOV     [EBX],EAX         {Store new Str}
        INC     ECX               {Set 1 as Result}
        OR      EDX,EDX
        JZ      @@Exit            {Pointer was NIL, no assignment}
        MOV     [EDX+4],EDI       {store high dword of _int64}
        MOV     [EDX],ESI         {store low  dword}
@@Exit:
{$IFOPT Q+}
            OR      EBP,EBP
            POP     EBP
            JNA     @@NoOverflow
            OR      ECX,scOverflow
@@NoOverflow:
{$ENDIF}
        POP     EDI               {restore registers to be preserved}
        POP     ESI
        POP     EBX
@@ret:
        MOV     EAX,ECX           {set return code to Result}
        RET
@@Str0:
        XOR     ECX,ECX
        POP     EBX
        JMP     @@Exit
end;


function Dec_scanner(var Str : PChar; var P : int64; Width : cardinal) : integer; register;
asm
// Validity checks
        JECXZ   @@ret           {Width was 0}
        PUSH    EBX             {Save registers to be preserved}
        PUSH    ESI
        PUSH    EDI
//  Initialize
{$IFOPT Q+}
            PUSH    EBP
            XOR     EBP,EBP     {EBP used for overflow tracking}
{$ENDIF}
        PUSH    EAX             {Put @Str on stack }
        MOV     EAX,[EAX]
        OR      EAX,EAX
        JE      @@Str0          {Str was NIL, quit}
        PUSH    EDX             {Put P on stack }
        MOV     ESI,EAX         {use ESI for Str}
        XOR     EBX,EBX
        XOR     EDI,EDI         {EDI:EAX will be a 64-bit accumulator}
        XOR     EAX,EAX

// Main loop start
@@loop: MOV     BL,[ESI]        {Get char}
        SUB     BL,'0'+10
        ADD     BL,10
        JNC     @@StopScan      {found illegal char}
//=== Unsigned multiplication by 10 start
{$IFOPT Q+}
        CMP     EDI,$33333333   { $FFFFFFFF div 5}
        JNA     @@Less
        INC     EBP
@@Less:
{$ENDIF}
        LEA     EDI,[EDI+4*EDI]
        MOV     EDX,10
        MUL     EDX
        ADD     EAX,EBX         {Add BL}
        ADC     EDX,0
{$IFOPT Q+}
            SHL     EDI,1
            ADC     EBP,0
            ADD     EDI,EDX
            ADC     EBP,0
{$ELSE}
        LEA     EDI,[EDI*2+EDX]
{$ENDIF}
//=== Unsigned multiplication by 10 end
        INC     ESI
        DEC     ECX
        JNZ     @@loop
// Main loop end

@@StopScan:
        POP     EDX               {Get back P}
        POP     EBX               {Original @Str}
        XOR     ECX,ECX
        CMP     [EBX],ESI         {Were there valid chars?}
        JE      @@Exit            {No valid characters found}
        MOV     [EBX],ESI         {Store new Str}
        INC     ECX               {Set 1 as Result}
        OR      EDX,EDX
        JZ      @@Exit            {Pointer was NIL, no assignment}
        MOV     [EDX+4],EDI       {store high dword of _int64}
        MOV     [EDX],EAX         {store low  dword}
@@Exit:
{$IFOPT Q+}
            OR      EBP,EBP
            POP     EBP
            JNA     @@NoOverflow
            OR      ECX,scOverflow
@@NoOverflow:
{$ENDIF}
        POP     EDI               {restore registers to be preserved}
        POP     ESI
        POP     EBX
@@ret:
        MOV     EAX,ECX           {set return code to Result}
        RET
@@Str0:
        XOR     ECX,ECX
        POP     EBX
        JMP     @@Exit
end;


const single10   : single =   10.0;
      single1000 : single = 1000.0;
      // 10.0 and 1000.0 have exact representations, single precision is sufficient
      // FMUL with single is the fastest [The 386 Book].

function Ext_scanner(var Str : PChar; Width : cardinal; EShift : integer; DecSep, ThSep : char) : integer; register;
var Tmp : integer;
    SaveCW : word;
    NewCW : word;
asm
// Initialization start
  or    edx,edx      // check Width
  jz    @@ret
  fnstcw SaveCW      // Save FPU control word
  push  edi
  push  esi
  push  ebx
  fnclex             // just in case some garbage is there
  mov   NewCW,$33f   // full precision, ignore errors
  push  eax          // remember @str point on stack
  mov   esi,[eax]    // ESI will be Str
  fldcw NewCW
  fldz               // initialize accumulator
  push  ecx          // remember EFactor

  xor   ecx,ecx      // fractional part length
  xor   edi,edi      // exponent
  xor   ebx,ebx      // general pusrpose
// Initialization end

// Integer part start
  xor	  eax,eax      // inititate integer loop
@@intloop:
	mov   al,[esi]
	sub 	al,'0'+10
	add	  al,10
	jnc 	@@ThSep      // two checks in one!
  inc   esi          // accept
	fmul	single10
  inc   ebx          // use ebx as digit counter
	mov 	Tmp,eax
	fiadd	Tmp
	dec   edx
  jnz   @@intloop
  jmp   @@OK
// Integer part end

//============ ThSep block ========================
// edi counts thousand groups, edi=0 means no thousand groups
@@ThSep:
  cmp   ThSep,0
  je    @@DecSep     // ThSep=#0, forget it
  sub   ebx,1+3      // ebx must be 1, 2 or 3
  add   ebx,3
  jnc   @@bDecSep
  sub   edx,4
  jc    @@ThDecSep   // Less than 4 characters left, ThSep not allowed
  mov   ebx,[esi]
@@Thloop:
  xor   eax,eax
  cmp   bl, ThSep
  jne   @@ThDecSep
  inc   edi
  shr   ebx,8         // first digit in bl
  inc   esi
	sub 	bl,'0'+10
	add	  bl,10
	jnc 	@@error
  mov   al,bl
  shr   ebx,8         // second digit in bl
  inc   esi
	sub 	bl,'0'+10
	add	  bl,10
  jnc   @@error
  lea   eax,[eax+eax*4]
  add   eax,eax
  add   al,bl        // al <= 90, no carry possible
  shr   ebx,8        // third digit in bl