Processing Procedure Declarations |
Turbo Pascal uses few procedures to process declaration of procedures and functions. The same code is also used to process methods, constructors and destructors.
The first procedure processes header.
Procedure ProcessProcedureDeclaration; Var IdentifierDataPtr: Pointer; ProcedureIdentifierDataPtr: PProcedureIdentifierData absolute IdentifierDataPtr; InlineCodeSize: Word; TypePointer: PTypeDefinition; NewIdentifier: PIdentifier; IdentifierOffset: Word absolute NewIdentifier; IdentifierToken: TToken; Saved_TemporarySymbolTablePosition: Word; ProcTypeDef: PTypeDefinition; Flags: TProcedureFlagsSet; Label SetProcedureFlags; begin SavedToken := Token; ProcedureStartLineNumber := CurrentSourceFile^.LineCounter; GetNextToken; ExpectIdentifier; If CurrentIdentifierDeclaredInCurrentScope (IdentifierOffset, IdentifierDataPtr, IdentifierToken) then begin If SourceType = stUnitInterface then Error (DuplicateIdentifier); If IdentifierToken = Token_ProcedureIdentifier then begin If pfMethod in ProcedureIdentifierDataPtr^.Flags then Error (DuplicateIdentifier); ProcessAlreadyDeclaredProcedure; Exit; end; If IdentifierToken = Token_TypeIdentifier then begin TypePointer := PointerFromOffsets (PTypeIdentifierData (ProcedureIdentifierDataPtr)^.UnitTypeOffsets); If TypePointer^.BaseType = btObject then begin GetNextToken; ExpectTokenAndGetNext (TOKEN_Period); ExpectIdentifier; If not IsIdentifierInSymbolTable (Ptr (Seg (TypePointer^), PObjectTypeDefinition (TypePointer)^.FieldsListOffset), IdentifierToken, IdentifierDataPtr, IdentifierOffset) then Error (MethodIdentifierExpected); If IdentifierToken <> Token_ProcedureIdentifier then Error (MethodIdentifierExpected); ProcessAlreadyDeclaredProcedure; Exit; end; end; Case SavedToken of Token_CONSTRUCTOR, Token_DESTRUCTOR: Error (ObjectTypeExpected); else Error (DuplicateIdentifier); end; end; Case SavedToken of Token_CONSTRUCTOR, Token_DESTRUCTOR: Error (ObjectTypeExpected); end; ProcedureIdentifierDataPtr := StoreCurrentIdentifierToSymbolTable (CurrentScopeIdentifierTableAddress, 10, NewIdentifier); NewIdentifier^.Token := Token_ProcedureIdentifier; GetNextToken; Saved_TemporarySymbolTablePosition := SymbolTable [stTemporary].NextRecordOffset; ProcTypeDef := ProcessProcedureHeader (SavedToken); ExpectTokenAndGetNext (TOKEN_Semicolon); If CheckAndGetNextToken (TOKEN_INLINE) then begin Process_INLINE (InlineCodeSize); Include (ProcedureIdentifierDataPtr^.Flags, pfInline); ProcedureIdentifierDataPtr^.ProceduresRecordOffset := InlineCodeSize; ExpectTokenAndGetNext (TOKEN_Semicolon); Exit; end; ProcedureIdentifierDataPtr^.LocalIdentifiersList := Saved_TemporarySymbolTablePosition; CreateProcedureRecord (NewIdentifier, ProcedureIdentifierDataPtr); ProcedureIdentifierDataPtr^.OuterBlockProcedureIdentifier := CurrentProcedureIdentifier; If CurrentProcedureIdentifier = 0 then begin Flags := [pfInterrupt]; If CompareIdentifierToDireciveAndSkipSemicolon (_INTERRUPT) then GoTo SetProcedureFlags; end; Flags := [pfFar]; If CompareIdentifierToDireciveAndSkipSemicolon (_FAR) then GoTo SetProcedureFlags; If SourceType <> stUnitInterface then begin Flags := []; If CompareIdentifierToDireciveAndSkipSemicolon (_NEAR) then GoTo SetProcedureFlags; If ForceFarCalls in StatementCompilerSwitches then Flags := [pfFar]; end; SetProcedureFlags: ProcedureIdentifierDataPtr^.Flags := ProcedureIdentifierDataPtr^.Flags + Flags; If SourceType = stUnitInterface then Exit; If CompareIdentifierToDireciveAndSkipSemicolon (_FORWARD) then Exit; ProcessProcedureDeclaractionsAndProgramBlock; end; This procedure processes declarations and program block.
Procedure ProcessProcedureDeclaractionsAndProgramBlock; Var Saved_PushedParametersSize, Saved_OffsetAfterLastParameter, Saved_FunctionResultNegativeSize, Saved_MaxStackFrameOffset, SavedProcedureIdentifierDataOffset: Word; SavedCurrentProcedureIdentifier, SavedProceduresNextRecordOffset: Word; Saved_ProcedureStartLineNumber: Word; begin With ProcedureIdentifierDataPtr^ do begin If (CurrentProcedureIdentifier = 0) and CompareIdentifierToDirectiveAndGetNextToken (_EXTERNAL) then begin Include (Flags, pfExternal); LocalIdentifiersList := 0; ExpectTokenAndGetNext (TOKEN_Semicolon); Exit; end; If CompareIdentifierToDireciveAndSkipSemicolon (_ASSEMBLER) then Include (Flags, pfAssembler); Saved_PushedParametersSize := PushedParametersSize; Saved_OffsetAfterLastParameter := OffsetAfterLastParameter; Saved_FunctionResultNegativeSize := FunctionResultNegativeSize; Saved_MaxStackFrameOffset := ProgramBlockMaxStackFrameOffset; SavedProcedureIdentifierDataOffset := ProcedureIdentifierDataOffset; SavedCurrentProcedureIdentifier := CurrentProcedureIdentifier; SavedProceduresNextRecordOffset := SymbolTable [stProcedures].UsedSize; CurrentProcedureIdentifier := IdentifierOffset; ProcedureIdentifierDataOffset := Ofs (ProcedureIdentifierDataPtr^); TemporaryStoredParameters := LocalIdentifiersList; LocalIdentifiersList := SymbolTable [stMain].UsedSize; With PProceduresBlockRecord (Ptr (SymbolTable [stProcedures].Segment, ProceduresRecordOffset))^ do ProgramCodeBlockRecordOffset := $FFFE; CreateSymbolTable (4); CreateParametersAsLocalVariables; Saved_ProcedureStartLineNumber := ProcedureStartLineNumber; ProcessDeclarations; ProcedureStartLineNumber := Saved_ProcedureStartLineNumber; PProceduresBlockRecord (Ptr (SymbolTable [stProcedures].Segment, ProceduresRecordOffset))^.SizeOfConstants := ProcessProgramBlock; { SymbolTable [stProcedures].Segment might change } PProceduresBlockRecord (Ptr (SymbolTable [stProcedures].Segment, ProceduresRecordOffset))^.ProgramCodeBlockRecordOffset := SymbolTable [stCodeBlocks].UsedSize; CreateProgramCodeBlockRecord; CreateTypedConstantsBlockRecord; CheckForUndefined_FORWARD_Or_EXTERNAL (Ptr (SymbolTable [stProcedures].Segment, SavedProceduresNextRecordOffset)); PushedParametersSize := Saved_PushedParametersSize; OffsetAfterLastParameter := Saved_OffsetAfterLastParameter; FunctionResultNegativeSize := Saved_FunctionResultNegativeSize; ProgramBlockMaxStackFrameOffset := Saved_MaxStackFrameOffset; ProcedureIdentifierDataOffset := SavedProcedureIdentifierDataOffset; CurrentProcedureIdentifier := SavedCurrentProcedureIdentifier; If not (LocalDebugSymbols in ModuleCompilerSwitches) then begin SymbolTable [stMain].UsedSize := LocalIdentifiersList; LocalIdentifiersList := 0; end; ExpectTokenAndGetNext (TOKEN_Semicolon); end; end; This procedure creates parameters as local variables. For methods also the implicit parameter Self is added.
Procedure CreateParametersAsLocalVariables; Var ProcedureIdentifierData: PProcedureIdentifierData; ProcedureParameterData: PProcedureParameterData absolute ProcedureIdentifierData; ProcedureParameterDataOfs: Word absolute ProcedureParameterData; AssemblerProcedure: Boolean; CurrentParameterOffset: Integer; Saved_TemporaryStoredParameters, Parameter, NumberOfParameters: Word; SelfIdentifier: PIdentifier; SelfIdentifierData: PVariableIdentifierData; begin ProcedureIdentifierData := Ptr (SymbolTable [stMain].Segment, ProcedureIdentifierDataOffset); AssemblerProcedure := pfAssembler in ProcedureIdentifierData^.Flags; PushedParametersSize := SizeOfPushedParameters (ProcedureIdentifierData, OffsetAfterLastParameter); CurrentParameterOffset := OffsetAfterLastParameter; FunctionResultNegativeSize := FunctionResultStackFrameSize; ProgramBlockMaxStackFrameOffset := FunctionResultNegativeSize; Saved_TemporaryStoredParameters := TemporaryStoredParameters; NumberOfParameters := ProcedureIdentifierData^.ProcedureTypeDefinition.NumberOfParameters; Inc (ProcedureParameterDataOfs, 24); For Parameter := 1 to NumberOfParameters do begin CreateParameterAsLocalVariable; Inc (ProcedureParameterData); end; ProcedureParameterDataOfs := ProcedureIdentifierDataOffset; If pfMethod in ProcedureIdentifierData^.Flags then begin VariableData_Flags := [vfVar, vf1]; RecordTypeDefinitionOffset.TypeOffset := $0006; RecordTypeDefinitionOffset.UnitIdentifierData := CurrentProcedureIdentifier; VariableData_NextMemberOffset := 0; GetTypeAndUnitIdentifierOffsets (Ptr (Seg (ProcedureIdentifierData^), ProcedureIdentifierData^.OuterBlockProcedureIdentifier), CurrentVarUnitTypeOffsets); CopyStringToCurrentIdentifier ('Self'); SelfIdentifierData := StoreNewIdentifierToSymbolTable (11, SelfIdentifier); SelfIdentifier^.Token := Token_VariableIdentifier; Move (VariableData_Flags, SelfIdentifierData^, 11); end; If TemporaryStoredParameters = SymbolTable [stTemporary].UsedSize then SymbolTable [stTemporary].UsedSize := Saved_TemporaryStoredParameters; end; Function FunctionResultStackFrameSize: Integer; Var ResultSize: Integer; begin ResultSize := 0; With ProcedureIdentifierData^ do If (ProcedureTypeDefinition.ResultTypeOffset.UnitIdentifierData <> 0) and not (pfAssembler in Flags) then With PTypeDefinition (PointerFromOffsets (ProcedureIdentifierData^.ProcedureTypeDefinition.ResultTypeOffset))^ do If BaseType <> btString then Dec (ResultSize, Size); FunctionResultStackFrameSize := ResultSize; end; Procedure CreateParameterAsLocalVariable; Var ParameterTypeDef: PTypeDefinition; ArrayTypeDefinition: PArrayTypeDefinition; ProcedureParameterVarFlags: TVarFlagsSet; ValueParameterCopySize, StackFrameSizeOfPassedParameter: Word; ParameterIdentifier: PIdentifier; ParameterIdentifierData: PVariableIdentifierData; Offset: Integer; begin ParameterTypeDef := PointerFromOffsets (ProcedureParameterData^.UnitTypeOffsets); ProcedureParameterVarFlags := ProcedureParameterData^.VarFlags; If vfArray in ProcedureParameterVarFlags then begin ArrayTypeDefinition := CreateTypeDefinition (16, 0, [], btArray); With ArrayTypeDefinition^ do begin GetTypeAndUnitIdentifierOffsets (ParameterTypeDef, ElementTypeOffset); GetTypeAndUnitIdentifierOffsets (Ptr (SystemUnitSegment, Word_TypeOffset), IndexTypeOffset); end; ParameterTypeDef := ArrayTypeDefinition; end; StackFrameSizeOfPassedParameter := SizeOfPassedParameter (ParameterTypeDef, ProcedureParameterVarFlags, ValueParameterCopySize, AssemblerProcedure); Include (ProcedureParameterVarFlags, vfArray); VariableData_Flags := ProcedureParameterVarFlags; GetTypeAndUnitIdentifierOffsets (ParameterTypeDef, CurrentVarUnitTypeOffsets); Dec (CurrentParameterOffset, StackFrameSizeOfPassedParameter); If ValueParameterCopySize <> 0 then begin Offset := ProgramBlockMaxStackFrameOffset - ValueParameterCopySize; If (WordAlignment in ModuleCompilerSwitches) and (ValueParameterCopySize <> 1) then Offset := Offset and $FFFE; ProgramBlockMaxStackFrameOffset := Offset; end else begin Offset := CurrentParameterOffset; If vfOpenParameter in VariableData_Flags then Inc (Offset, 2); end; RecordTypeDefinitionOffset.TypeOffset := Offset; RecordTypeDefinitionOffset.UnitIdentifierData := CurrentProcedureIdentifier; VariableData_NextMemberOffset := 0; CopyStringFromTemporaryBlockToCurrentIdentifier (TemporaryStoredParameters); Inc (TemporaryStoredParameters, Length (CurrentIdentifier) + 3); ParameterIdentifierData := StoreNewIdentifierToSymbolTable (11, ParameterIdentifier); ParameterIdentifier^.Token := Token_VariableIdentifier; Move (VariableData_Flags, ParameterIdentifierData^, 11); end; Procedures can be declared in the Interface part of the unit, in the Object declaration or with the Forward directive. Such cases are handled with this procedure. Of course, header must match previous declaration. Procedure ProcessAlreadyDeclaredProcedure; Var SavedTempSymbolTableCurrentPointerOfs: Word; ProcTypeDefAndParametersSize: Word; N, NewTempSymbolTableCurrentPointerOfs: Word; ExpectedToken: TToken; DIPtr, SIPtr: PChar; ProceduresRecord: PProceduresBlockRecord; begin ProceduresRecord := Ptr (SymbolTable [stProcedures].Segment, ProcedureIdentifierDataPtr^.ProceduresRecordOffset); If ProceduresRecord^.ProgramCodeBlockRecordOffset <> $FFFF then Error (DuplicateIdentifier); GetNextToken; If Word (Ptr (Seg (ProcedureIdentifierDataPtr^), Ofs (ProcedureIdentifierDataPtr^) + 18)^) = 0 then begin If pfConstructor in ProcedureIdentifierDataPtr^.Flags then ExpectedToken := Token_CONSTRUCTOR else If pfDestructor in ProcedureIdentifierDataPtr^.Flags then ExpectedToken := Token_DESTRUCTOR else ExpectedToken := Token_PROCEDURE; end else ExpectedToken := Token_FUNCTION; If SavedToken <> ExpectedToken then Error (HeaderDoesNotMatchPreviousDefinition); If (Token = Token_LeftParenthesis) or (Token = Token_Colon) then begin SavedTempSymbolTableCurrentPointerOfs := SymbolTable [stTemporary].NextRecordOffset; ProcTypeDef := ProcessProcedureHeader (SavedToken); ProcTypeDefAndParametersSize := SymbolTable [stMain].UsedSize - Ofs (ProcTypeDef^); SymbolTable [stMain].UsedSize := Ofs (ProcTypeDef^); ProcTypeDef^.Size := ProcedureIdentifierDataPtr^.ProcedureTypeDefinition.Size; ProcTypeDef^.W06_ := ProcedureIdentifierDataPtr^.ProcedureTypeDefinition.W06_; For N := 0 to ProcTypeDefAndParametersSize - 1 do If PChar (ProcTypeDef)^ <> PChar (@ProcedureIdentifierDataPtr^.ProcedureTypeDefinition)^ then Error (HeaderDoesNotMatchPreviousDefinition); NewTempSymbolTableCurrentPointerOfs := SymbolTable [stTemporary].UsedSize; SymbolTable [stTemporary].UsedSize := SavedTempSymbolTableCurrentPointerOfs; DIPtr := Ptr (SymbolTable [stTemporary].Segment, ProcedureIdentifierDataPtr^.LocalIdentifiersList); SIPtr := Ptr (SymbolTable [stTemporary].Segment, SavedTempSymbolTableCurrentPointerOfs); While Ofs (SIPtr^) <> NewTempSymbolTableCurrentPointerOfs do begin Inc (SIPtr, 2); Inc (DIPtr, 2); If not IdentifiersEqual (PString (DIPtr), PString (SIPtr)) then Error (HeaderDoesNotMatchPreviousDefinition); Inc (DIPtr, Length (PString (DIPtr)^) + 1); end; end; ExpectTokenAndGetNext (TOKEN_Semicolon); ProcessProcedureDeclaractionsAndProgramBlock; end; |