📄 other.pas
字号:
S := V;
end;
function FloatToText(BufferArg: PChar; const Value; ValueType: TFloatValue;
Format: TFloatFormat; Precision, Digits: Integer): Integer;
begin
end;
function FormatBuf(var Buffer; BufLen: Cardinal; const Format;
FmtLen: Cardinal; const Args: array of const): Cardinal;
var
ArgIndex, Width, Prec: Integer;
BufferOrg, FormatOrg, FormatPtr, TempStr: PChar;
JustFlag: Byte;
StrBuf: array[0..64] of Char;
TempAnsiStr: string;
TempInt64 : int64;
SaveGOT: Integer;
{ in: eax <-> Buffer }
{ in: edx <-> BufLen }
{ in: ecx <-> Format }
asm
PUSH EBX
PUSH ESI
PUSH EDI
MOV EDI,EAX
MOV ESI,ECX
{$IFDEF PIC}
PUSH ECX
CALL GetGOT
POP ECX
{$ELSE}
XOR EAX,EAX
{$ENDIF}
MOV SaveGOT,EAX
ADD ECX,FmtLen
MOV BufferOrg,EDI
XOR EAX,EAX
MOV ArgIndex,EAX
MOV TempStr,EAX
MOV TempAnsiStr,EAX
@Loop:
OR EDX,EDX
JE @Done
@NextChar:
CMP ESI,ECX
JE @Done
LODSB
CMP AL,'%'
JE @Format
@StoreChar:
STOSB
DEC EDX
JNE @NextChar
@Done:
MOV EAX,EDI
SUB EAX,BufferOrg
JMP @Exit
@Format:
CMP ESI,ECX
JE @Done
LODSB
CMP AL,'%'
JE @StoreChar
LEA EBX,[ESI-2]
MOV FormatOrg,EBX
@A0: MOV JustFlag,AL
CMP AL,'-'
JNE @A1
CMP ESI,ECX
JE @Done
LODSB
@A1: CALL @Specifier
CMP AL,':'
JNE @A2
MOV ArgIndex,EBX
CMP ESI,ECX
JE @Done
LODSB
JMP @A0
@A2: MOV Width,EBX
MOV EBX,-1
CMP AL,'.'
JNE @A3
CMP ESI,ECX
JE @Done
LODSB
CALL @Specifier
@A3: MOV Prec,EBX
MOV FormatPtr,ESI
PUSH ECX
PUSH EDX
CALL @Convert
POP EDX
MOV EBX,Width
SUB EBX,ECX //(* ECX <=> number of characters output *)
JAE @A4 //(* jump -> output smaller than width *)
XOR EBX,EBX
@A4: CMP JustFlag,'-'
JNE @A6
SUB EDX,ECX
JAE @A5
ADD ECX,EDX
XOR EDX,EDX
@A5: REP MOVSB
@A6: XCHG EBX,ECX
SUB EDX,ECX
JAE @A7
ADD ECX,EDX
XOR EDX,EDX
@A7: MOV AL,' '
REP STOSB
XCHG EBX,ECX
SUB EDX,ECX
JAE @A8
ADD ECX,EDX
XOR EDX,EDX
@A8: REP MOVSB
CMP TempStr,0
JE @A9
PUSH EDX
LEA EAX,TempStr
// PUSH EBX // GOT setup unnecessary for
// MOV EBX, SaveGOT // same-unit calls to Pascal procedures
CALL FormatClearStr
// POP EBX
POP EDX
@A9: POP ECX
MOV ESI,FormatPtr
JMP @Loop
@Specifier:
XOR EBX,EBX
CMP AL,'*'
JE @B3
@B1: CMP AL,'0'
JB @B5
CMP AL,'9'
JA @B5
IMUL EBX,EBX,10
SUB AL,'0'
MOVZX EAX,AL
ADD EBX,EAX
CMP ESI,ECX
JE @B2
LODSB
JMP @B1
@B2: POP EAX
JMP @Done
@B3: MOV EAX,ArgIndex
CMP EAX,Args.Integer[-4]
JA @B4
INC ArgIndex
MOV EBX,Args
CMP [EBX+EAX*8].Byte[4],vtInteger
MOV EBX,[EBX+EAX*8]
JE @B4
XOR EBX,EBX
@B4: CMP ESI,ECX
JE @B2
LODSB
@B5: RET
@Convert:
AND AL,0DFH
MOV CL,AL
MOV EAX,1
MOV EBX,ArgIndex
CMP EBX,Args.Integer[-4]
JA @ErrorExit
INC ArgIndex
MOV ESI,Args
LEA ESI,[ESI+EBX*8]
MOV EAX,[ESI].Integer[0] // TVarRec.data
MOVZX EDX,[ESI].Byte[4] // TVarRec.VType
{$IFDEF PIC}
MOV EBX, SaveGOT
ADD EBX, offset @CvtVector
MOV EBX, [EBX+EDX*4]
ADD EBX, SaveGOT
JMP EBX
{$ELSE}
JMP @CvtVector.Pointer[EDX*4]
{$ENDIF}
@CvtVector:
DD @CvtInteger // vtInteger
DD @CvtBoolean // vtBoolean
DD @CvtChar // vtChar
DD @CvtExtended // vtExtended
DD @CvtShortStr // vtString
DD @CvtPointer // vtPointer
DD @CvtPChar // vtPChar
DD @CvtObject // vtObject
DD @CvtClass // vtClass
DD @CvtWideChar // vtWideChar
DD @CvtPWideChar // vtPWideChar
DD @CvtAnsiStr // vtAnsiString
DD @CvtCurrency // vtCurrency
DD @CvtVariant // vtVariant
DD @CvtInterface // vtInterface
DD @CvtWideString // vtWideString
DD @CvtInt64 // vtInt64
@CvtBoolean:
@CvtObject:
@CvtClass:
@CvtWideChar:
@CvtInterface:
@CvtError:
XOR EAX,EAX
@ErrorExit:
CALL @ClearTmpAnsiStr
MOV EDX,FormatOrg
MOV ECX,FormatPtr
SUB ECX,EDX
{$IFDEF PC_MAPPED_EXCEPTIONS}
// Because of all the assembly code here, we can't call a routine
// that throws an exception if it looks like we're still on the
// stack. The static disassembler cannot give sufficient unwind
// frame info to unwind the confusion that is generated from the
// assembly code above. So before we throw the exception, we
// go to some lengths to excise ourselves from the stack chain.
// We were passed 12 bytes of parameters on the stack, and we have
// to make sure that we get rid of those, too.
MOV EBX, SaveGOT
MOV ESP, EBP // Ditch everthing to the frame
MOV EBP, [ESP + 4] // Get the return addr
MOV [ESP + 16], EBP // Move the ret addr up in the stack
POP EBP // Ditch the rest of the frame
ADD ESP, 12 // Ditch the space that was taken by params
JMP FormatError // Off to FormatErr
{$ELSE}
MOV EBX, SaveGOT
CALL FormatError
{$ENDIF}
// The above call raises an exception and does not return
@CvtInt64:
// CL <= format character
// EAX <= address of int64
// EBX <= TVarRec.VType
LEA EBX, TempInt64 // (input is array of const; save original)
MOV EDX, [EAX]
MOV [EBX], EDX
MOV EDX, [EAX + 4]
MOV [EBX + 4], EDX
// EBX <= address of TempInt64
CMP CL,'D'
JE @DecI64
CMP CL,'U'
JE @DecI64_2
CMP CL,'X'
JNE @CvtError
@HexI64:
MOV ECX,16 // hex divisor
JMP @CvtI64
@DecI64:
TEST DWORD PTR [EBX + 4], $80000000 // sign bit set?
JE @DecI64_2 // no -> bypass '-' output
NEG DWORD PTR [EBX] // negate lo-order, then hi-order
ADC DWORD PTR [EBX+4], 0
NEG DWORD PTR [EBX+4]
CALL @DecI64_2
MOV AL,'-'
INC ECX
DEC ESI
MOV [ESI],AL
RET
@DecI64_2: // unsigned int64 output
MOV ECX,10 // decimal divisor
@CvtI64:
LEA ESI,StrBuf[32]
@CvtI64_1:
PUSH EBX
PUSH ECX // save radix
PUSH 0
PUSH ECX // radix divisor (10 or 16 only)
MOV EAX, [EBX]
MOV EDX, [EBX + 4]
MOV EBX, SaveGOT
CALL System.@_llumod
POP ECX // saved radix
POP EBX
XCHG EAX, EDX // lo-value to EDX for character output
ADD DL,'0'
CMP DL,'0'+10
JB @CvtI64_2
ADD DL,('A'-'0')-10
@CvtI64_2:
DEC ESI
MOV [ESI],DL
PUSH EBX
PUSH ECX // save radix
PUSH 0
PUSH ECX // radix divisor (10 or 16 only)
MOV EAX, [EBX] // value := value DIV radix
MOV EDX, [EBX + 4]
MOV EBX, SaveGOT
CALL System.@_lludiv
POP ECX // saved radix
POP EBX
MOV [EBX], EAX
MOV [EBX + 4], EDX
OR EAX,EDX // anything left to output?
JNE @CvtI64_1 // no jump => EDX:EAX = 0
LEA ECX,StrBuf[32]
SUB ECX,ESI
MOV EDX,Prec
CMP EDX,16
JBE @CvtI64_3
RET
@CvtI64_3:
SUB EDX,ECX
JBE @CvtI64_5
ADD ECX,EDX
MOV AL,'0'
@CvtI64_4:
DEC ESI
MOV [ESI],AL
DEC EDX
JNE @CvtI64_4
@CvtI64_5:
RET
////////////////////////////////////////////////
@CvtInteger:
CMP CL,'D'
JE @C1
CMP CL,'U'
JE @C2
CMP CL,'X'
JNE @CvtError
MOV ECX,16
JMP @CvtLong
@C1: OR EAX,EAX
JNS @C2
NEG EAX
CALL @C2
MOV AL,'-'
INC ECX
DEC ESI
MOV [ESI],AL
RET
@C2: MOV ECX,10
@CvtLong:
LEA ESI,StrBuf[16]
@D1: XOR EDX,EDX
DIV ECX
ADD DL,'0'
CMP DL,'0'+10
JB @D2
ADD DL,('A'-'0')-10
@D2: DEC ESI
MOV [ESI],DL
OR EAX,EAX
JNE @D1
LEA ECX,StrBuf[16]
SUB ECX,ESI
MOV EDX,Prec
CMP EDX,16
JBE @D3
RET
@D3: SUB EDX,ECX
JBE @D5
ADD ECX,EDX
MOV AL,'0'
@D4: DEC ESI
MOV [ESI],AL
DEC EDX
JNE @D4
@D5: RET
@CvtChar:
CMP CL,'S'
JNE @CvtError
MOV ECX,1
RET
@CvtVariant:
CMP CL,'S'
JNE @CvtError
CMP [EAX].TVarData.VType,varNull
JBE @CvtEmptyStr
MOV EDX,EAX
LEA EAX,TempStr
// PUSH EBX // GOT setup unnecessary for
// MOV EBX, SaveGOT // same-unit calls to Pascal procedures
CALL FormatVarToStr
// POP EBX
MOV ESI,TempStr
JMP @CvtStrRef
@CvtEmptyStr:
XOR ECX,ECX
RET
@CvtShortStr:
CMP CL,'S'
JNE @CvtError
MOV ESI,EAX
LODSB
MOVZX ECX,AL
JMP @CvtStrLen
@CvtPWideChar:
MOV ESI,OFFSET System.@LStrFromPWChar
JMP @CvtWideThing
@CvtWideString:
MOV ESI,OFFSET System.@LStrFromWStr
@CvtWideThing:
ADD ESI, SaveGOT
CMP CL,'S'
JNE @CvtError
MOV EDX,EAX
LEA EAX,TempAnsiStr
PUSH EBX
MOV EBX, SaveGOT
CALL ESI
POP EBX
MOV ESI,TempAnsiStr
MOV EAX,ESI
JMP @CvtStrRef
@CvtAnsiStr:
CMP CL,'S'
JNE @CvtError
MOV ESI,EAX
@CvtStrRef:
OR ESI,ESI
JE @CvtEmptyStr
MOV ECX,[ESI-4]
@CvtStrLen:
CMP ECX,Prec
JA @E1
RET
@E1: MOV ECX,Prec
RET
@CvtPChar:
CMP CL,'S'
JNE @CvtError
MOV ESI,EAX
PUSH EDI
MOV EDI,EAX
XOR AL,AL
MOV ECX,Prec
JECXZ @F1
REPNE SCASB
JNE @F1
DEC EDI
@F1: MOV ECX,EDI
SUB ECX,ESI
POP EDI
RET
@CvtPointer:
CMP CL,'P'
JNE @CvtError
MOV Prec,8
MOV ECX,16
JMP @CvtLong
@CvtCurrency:
MOV BH,fvCurrency
JMP @CvtFloat
@CvtExtended:
MOV BH,fvExtended
@CvtFloat:
MOV ESI,EAX
MOV BL,ffGeneral
CMP CL,'G'
JE @G2
MOV BL,ffExponent
CMP CL,'E'
JE @G2
MOV BL,ffFixed
CMP CL,'F'
JE @G1
MOV BL,ffNumber
CMP CL,'N'
JE @G1
CMP CL,'M'
JNE @CvtError
MOV BL,ffCurrency
@G1: MOV EAX,18
MOV EDX,Prec
CMP EDX,EAX
JBE @G3
MOV EDX,2
CMP CL,'M'
JNE @G3
MOVZX EDX,CurrencyDecimals
JMP @G3
@G2: MOV EAX,Prec
MOV EDX,3
CMP EAX,18
JBE @G3
MOV EAX,15
@G3: PUSH EBX
PUSH EAX
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -