Extracting Assembler Tokens |
This procedure scans assembler instruction and returns next assembler token.
Procedure GetNextAsmToken; Procedure SeparateAsmWord; Var C: Char; Function IsLetterOrNumberOrSpecialCharacter: Boolean; begin Case C of '0'..'9', 'A'..'Z', 'a'..'z', '_', '$', '@', '&', '?' : IsLetterOrNumberOrSpecialCharacter := True; else IsLetterOrNumberOrSpecialCharacter := False; end; end; Function IsString: Boolean; Var StringChar, StringDelimiter: Char; begin IsString := False; If not (C in ['''', '"']) then Exit; StringDelimiter := C; AsmString := ''; IsString := True; Repeat StringChar := GetNextChar; If StringChar = #0 then AsmError (StringConstantExceedsLine); If StringChar = StringDelimiter then begin StringChar := GetNextChar; If StringChar <> StringDelimiter then Exit; end; If Byte (AsmString [0]) = 127 then AsmError (StringConstantExceedsLine); Inc (AsmString [0]); AsmString [Length (AsmString)] := StringChar; until False; end; begin AsmTokenString := ''; AsmTokenUpCaseString := ''; AsmWordHash := 0; C := GetFirstNonBlankCharacter; AsmSourceErrorPosition := AsmCharacterPointer; If C <> #0 then begin If IsLetterOrNumberOrSpecialCharacter then begin Repeat If Length (AsmTokenString) < 32 then begin Inc (AsmTokenString [0]); Inc (AsmTokenUpCaseString [0]); AsmTokenString [Byte (AsmTokenString [0])] := C; AsmTokenUpCaseString [Byte (AsmTokenUpCaseString [0])] := UpCase (C); Inc (AsmWordHash, Ord (UpCase (C)) - 1); end; C := GetNextChar; until (C = #0) or not IsLetterOrNumberOrSpecialCharacter; AsmWordType := 1; If AsmTokenUpCaseString <> 'END' then Exit; end else begin AsmWordType := 2; If IsString then Exit; AsmWordType := 0; AsmTokenString := C; Case C of ';', '{': {$B+} else If (C <> '(') or (GetNextChar <> '*') then Exit; {$B-} end; end; end; AsmWordType := 0; AsmTokenString := ';'; LineCharacterCounter := 0; AsmCharacterPointer := AsmSourceErrorPosition; end; Function FindAsmWord (AsmList: PIdentifierList; Var AsmWordData: Pointer): Boolean; Var AsmWord: PAsmWord absolute AsmWordData; AsmWordOffset: Word absolute AsmWordData; begin FindAsmWord := False; If AsmWordType <> 1 then Exit; AsmWord := Ptr (DSeg, AsmList^.Offset [AsmWordHash and AsmList^.Mask]); While AsmWordOffset <> 0 do begin AsmToken := AsmToken_00; If AsmWord^.Str = AsmTokenUpCaseString then begin Inc (AsmWordOffset, Length (AsmWord^.Str) + 3); FindAsmWord := True; Exit; end; AsmWordOffset := AsmWord^.NextWordOffset; end; end; Function IsAsmInstruction: Boolean; begin If FindAsmWord (@AsmInstructions, Pointer (InstructionData)) then begin AsmToken := AsmToken_Instruction; IsAsmInstruction := True; end else IsAsmInstruction := False; end; Function IsSymbolToken: Boolean; begin IsSymbolToken := False; If AsmWordType = 0 then begin AsmToken := TAsmToken (AsmTokenString [1]); If (Length (AsmTokenString) = 1) and (AsmTokenString [1] <> #0) then IsSymbolToken := True; end; end; Function IsAsmOperand: Boolean; Var OperandData: POperandData; begin If FindAsmWord (@AsmOperands, Pointer (OperandData)) then begin AsmToken := OperandData^.Token; OperandRegisterType := OperandData^.RegisterType; OperandRegister := OperandData^.Register; NumericAsmConstant.Long := OperandData^.W1; IsAsmOperand := True; end else IsAsmOperand := False; end; Function IsAsmConstant: Boolean; Var StartIndex, EndIndex: Byte; Index: Integer; Constant: LongRec; Procedure ProcessHexNumber; Var Index: Integer; begin For Index := StartIndex to EndIndex do begin If NumericAsmConstant.WordH > $0FFF then AsmError (ConstantOutOfRange); NumericAsmConstant.Long := NumericAsmConstant.Long * 16; If (NumericAsmConstant.WordH = $FFFF) and (NumericAsmConstant.WordL > $FFF0) then AsmError (ConstantOutOfRange); If AsmTokenUpCaseString [Index] in ['0'..'9'] then Inc (NumericAsmConstant.Long, Ord (AsmTokenUpCaseString [Index]) - Ord ('0')) else If AsmTokenUpCaseString [Index] in ['A'..'F'] then Inc (NumericAsmConstant.Long, Ord (AsmTokenUpCaseString [Index]) - Ord ('A') + 10) else AsmError (ErrorInIntegerConstant); end; end; Procedure ProcessDecNumber; Var Index: Integer; begin For Index := StartIndex to EndIndex do begin If NumericAsmConstant.WordH > $1999 then AsmError (ConstantOutOfRange); If (NumericAsmConstant.WordH = $1999) and (NumericAsmConstant.WordL > $9999) then AsmError (ConstantOutOfRange); NumericAsmConstant.Long := NumericAsmConstant.Long * 10; If (NumericAsmConstant.WordH = $FFFF) and (NumericAsmConstant.WordL > $FFFF - 9) then AsmError (ConstantOutOfRange); If AsmTokenUpCaseString [Index] in ['0'..'9'] then Inc (NumericAsmConstant.Long, Ord (AsmTokenUpCaseString [Index]) - Ord ('0')) else AsmError (ErrorInIntegerConstant); end; end; Procedure ProcessOctNumber; Var Index: Integer; begin For Index := StartIndex to EndIndex do begin If NumericAsmConstant.WordH > $1FFF then AsmError (ConstantOutOfRange); NumericAsmConstant.Long := NumericAsmConstant.Long * 8; If (NumericAsmConstant.WordH = $FFFF) and (NumericAsmConstant.WordL > $FFFF - 7) then AsmError (ConstantOutOfRange); If AsmTokenUpCaseString [Index] in ['0'..'7'] then Inc (NumericAsmConstant.Long, Ord (AsmTokenUpCaseString [Index]) - Ord ('0')) else AsmError (ErrorInIntegerConstant); end; end; Procedure ProcessBinNumber; Var Index: Integer; begin For Index := StartIndex to EndIndex do begin If NumericAsmConstant.WordH > $7FFF then AsmError (ConstantOutOfRange); NumericAsmConstant.Long := NumericAsmConstant.Long * 2; If (NumericAsmConstant.WordH = $FFFF) and (NumericAsmConstant.WordL > $FFFF - 1) then AsmError (ConstantOutOfRange); If AsmTokenUpCaseString [Index] in ['0'..'1'] then Inc (NumericAsmConstant.Long, Ord (AsmTokenUpCaseString [Index]) - Ord ('0')) else AsmError (ErrorInIntegerConstant); end; end; begin IsAsmConstant := False; NumericAsmConstant.Long := 0; Case AsmWordType of 1: begin AsmString := ''; StartIndex := 2; EndIndex := Length (AsmTokenUpCaseString); If AsmTokenUpCaseString [1] = '$' then ProcessHexNumber else If AsmTokenUpCaseString [1] in ['0'..'9'] then begin StartIndex := 1; If AsmTokenUpCaseString [Length (AsmTokenUpCaseString)] in ['0'..'9'] then ProcessDecNumber else begin Dec (EndIndex); Case AsmTokenUpCaseString [Length (AsmTokenUpCaseString)] of 'D': ProcessDecNumber; 'B': ProcessBinNumber; 'O': ProcessOctNumber; 'H': ProcessHexNumber; else AsmError (ErrorInIntegerConstant); end; end; end else Exit; AsmToken := AsmToken_Constant; IsAsmConstant := True; end; 2: begin For Index := 1 to Length (AsmString) do begin NumericAsmConstant.WordH := NumericAsmConstant.WordH and $00FF; NumericAsmConstant.Long := NumericAsmConstant.Long shl 8 + Byte (AsmString [Index]); end; AsmToken := AsmToken_Constant; IsAsmConstant := True; end; end; end; Procedure ProcessAsmIdentifier; Var IdToken: TToken; IdentifierDataPointer: Pointer; TypeDefinition: PTypeDefinition; VariableIdentifierData: PVariableIdentifierData; Procedure SetAsmVariableIdentifierData; begin With AsmIdentifierData do If vfVar in VariableIdentifierData^.Flags then begin AdditionalPointer := nil; Size := 4; end else begin TypeDefinition := PointerFromOffsets (PVariableIdentifierData ( IdentifierDataPointer)^.UnitTypeOffsets); Case TypeDefinition^.BaseType of btRecord, btObject: AdditionalPointer := TypeDefinition; else AdditionalPointer := nil; end; Size := TypeDefinition^.Size; end; end; begin If AsmTokenString [1] = '&' then begin If Length (AsmTokenString) = 1 then AsmError (SyntaxError); Delete (AsmTokenString, 1, 1); end; CopyStringToCurrentIdentifier (AsmTokenString); AsmIdentifierData.AdditionalPointer := AsmIdentifierAdditionalData; If not IsValidAsmIdentifier (Pointer (Pointer (@AsmIdentifierData)^), IdToken, IdentifierDataPointer, CurrentIdentifierOffset) then AsmError (UnknownIdentifier); With AsmIdentifierData do begin ReferencedData.Long := $FFFFFFFF; Value_Lo := 0; Value_Hi := 0; Case IdToken of Token_ConstantIdentifier: Case PTypeDefinition (PointerFromOffsets (PConstantIdentifierData (IdentifierDataPointer)^. UnitTypeOffsets))^.BaseType of btPointer, btInteger..btEnumeration: begin AdditionalPointer := nil; Value_Lo := PConstantIdentifierData (IdentifierDataPointer)^.OrdinalValue; Value_Hi := PConstantIdentifierData (IdentifierDataPointer)^.W2; Size := 0; end; else AsmError (InvalidSymbolReference); end; Token_TypeIdentifier: begin TypeDefinition := PointerFromOffsets (PTypeIdentifierData (IdentifierDataPointer)^.UnitTypeOffsets); begin Case TypeDefinition^.BaseType of btRecord, btObject: AdditionalPointer := TypeDefinition; else AdditionalPointer := nil; end; Size := TypeDefinition^.Size; end; end; Token_VariableIdentifier: begin VariableIdentifierData := IdentifierDataPointer; While vfAbsoluteVar in VariableIdentifierData^.Flags do VariableIdentifierData := PVariableIdentifierData (PointerFromOffsets (VariableIdentifierData^.AbsoluteVarDataOffsets)); If Field in VariableIdentifierData^.Flags then begin Value_Lo := VariableIdentifierData^.W1.Ofs; Value_Hi := 0; SetAsmVariableIdentifierData; end else If VariableIdentifierData^.Flags * VariableTypeMask = VariableAbsoluteAddress then begin Dec (ReferencedData.WordL); Value_Lo := VariableIdentifierData^.W1.Ofs; Value_Hi := VariableIdentifierData^.W1.Seg; SetAsmVariableIdentifierData; end else If VariableIdentifierData^.Flags * VariableTypeMask = LocalStackVariable then begin Dec (ReferencedData.WordL, 2); Value_Lo := VariableIdentifierData^.W1.Ofs; Value_Hi := 0; SetAsmVariableIdentifierData; end else begin ReferencedData.WordL := VariableIdentifierData^.W1.Seg; If VariableIdentifierData^.Flags = [] then ReferencedData.WordH := $8000 else ReferencedData.WordH := $C000; ReferencedData.WordH := ReferencedData.WordH or AddReferencedModule (Seg (VariableIdentifierData^)); Value_Lo := VariableIdentifierData^.W1.Ofs; Value_Hi := 0; SetAsmVariableIdentifierData; end; end; Token_ProcedureIdentifier: begin If pfInline in PProcedureIdentifierData (IdentifierDataPointer)^.Flags then AsmError (InvalidSymbolReference); ReferencedData.WordL := PProcedureIdentifierData (IdentifierDataPointer)^.ProceduresRecordOffset; ReferencedData.WordH := AddReferencedModule (Seg (IdentifierDataPointer^)); If pfFar in PProcedureIdentifierData (IdentifierDataPointer)^.Flags then Size := $FFFE else Size := $FFFF; AdditionalPointer := nil; end; Token_UnitIdentifier: begin AdditionalPointer := Ptr (PUnitIdentifierData (IdentifierDataPointer)^.UnitSegment, 0); Size := 0; end; Token_LabelIdentifier: begin If CurrentIdentifierOffset < Ofs (CurrentScopeIdentifierTableAddress^) then AsmError (LabelNotWithinCurrentBlock); ReferencedData.WordL := CurrentIdentifierOffset; ReferencedData.WordH := $4000 or AddReferencedModule (Seg (IdentifierDataPointer^)); AdditionalPointer := nil; Size := $FFFD; end; Token_AsmSegmentReference: begin ReferencedData.WordL := 0; ReferencedData.WordH := Swap (Byte (IdentifierDataPointer^)) or AddReferencedModule (SymbolTable [stMain].Segment); AdditionalPointer := nil; Size := $FFF0; end; Token_AsmOffsetReference: begin If ProcedureIdentifierDataOffset = 0 then AsmError (InvalidSymbolReference); Case Byte (IdentifierDataPointer^) of { In TPC only one byte, in TPC16 word } 0: begin { @LOCALS } AdditionalPointer := nil; Value_Lo := - (ProgramBlockMaxStackFrameOffset and $FFFE); Value_Hi := 0; Size := 0; end; 1: begin { @PARAMS } AdditionalPointer := nil; Value_Lo := PushedParametersSize; Value_Hi := 0; Size := 0; end; 2: begin { @RESULT } TypeDefinition := PointerFromOffsets (PProcedureIdentifierData (Ptr (SymbolTable [stMain].Segment, ProcedureIdentifierDataOffset))^.ProcedureTypeDefinition.ResultTypeOffset); If Ofs (TypeDefinition^) = 0 then AsmError (InvalidSymbolReference); Value_Lo := OffsetAfterLastParameter; Value_Hi := 0; Size := 4; If TypeDefinition^.BaseType <> btString then begin If pfAssembler in PProcedureIdentifierData (Ptr (SymbolTable [stMain].Segment, ProcedureIdentifierDataOffset))^.Flags then AsmError (InvalidSymbolReference); Value_Lo := FunctionResultNegativeSize; Size := TypeDefinition^.Size; end; ReferencedData.Long := $FFFFFFFD; AdditionalPointer := nil; end; end; end; else AsmError (InvalidSymbolReference); end; If Size >= $FFFD then CodeIdentifierReference := True else CodeIdentifierReference := False; end; AsmIdentifierAdditionalData := AsmIdentifierData.AdditionalPointer; AsmToken := AsmToken_Identifier; end; begin AsmToken := AsmToken_Semicolon; If LineCharacterCounter <> 0 then begin SeparateAsmWord; If not BeforeOperands or not IsAsmInstruction then begin If not IsSymbolToken then If not IsAsmOperand then If not IsAsmConstant then If not BeforeOperands then ProcessAsmIdentifier; end; end; If AsmToken = AsmToken_00 then AsmToken := AsmToken_01; end; If AsmToken is expected assembler token this procedure gets next one, otherwise it reports error.
Procedure ExpectAsmTokenAndGetNext (ExpectedAsmToken: TAsmToken); begin If AsmToken <> ExpectedAsmToken then AsmError (SyntaxError); GetNextAsmToken; end; If assembler token is AsmTokenToCheck this function gets next token and returns True otherwise it returns False.
Function CheckAndGetNextAsmToken (AsmTokenToCheck: TAsmToken): Boolean; begin CheckAndGetNextAsmToken := True; If AsmToken = AsmTokenToCheck then GetNextAsmToken else CheckAndGetNextAsmToken := False; end; This function finds AsmToken in table of operator procedures and returns its procedure and True, if token is not found it returnsFalse. Function FindAsmTokenInTable (Table: POperatorProc; Var ExpressionProc: TExpressionProc): Boolean; begin FindAsmTokenInTable := False; While Ord (Table^.Token) <> 0 do begin If Table^.Token = AsmToken then begin ExpressionProc := Table^.Proc; GetNextAsmToken; FindAsmTokenInTable := True; Exit; end; Inc (Table); end; end; |