System Procedures Reset, Rewrite and SetTextBuf |
This function processes system procedures Reset and Rewrite.
Function Proc_Reset_Rewrite: Word; Far; Var FileExpression, RecordSizeExpression: TExpression; begin ExpectTokenAndGetNext (Token_LeftParenthesis); FileExpression.ExpectFileVariableAndPushPointerToMemory; RecordSizeExpression.IntermediateCodeOffset := 0; With PFileTypeDefinition (FileExpression.TypeDefPtr)^ do If BaseType <> btText then begin If BaseFileTypeOffset.TypeOffset <> 0 then begin GenerateCodeToPushWord (PTypeDefinition (PointerFromOffsets (BaseFileTypeOffset))^.Size); RecordSizeExpression.EndIntermediateCodeSubroutine; end else begin If CheckAndGetNextToken (Token_Comma) then begin RecordSizeExpression.ExpectIntegerExpression; RecordSizeExpression.CheckOrdinalRange (Ptr (SystemUnitSegment, Word_TypeOffset)); RecordSizeExpression.PushExpression; end else begin GenerateCodeToPushWord (128); RecordSizeExpression.EndIntermediateCodeSubroutine; end; end; end; ExpectTokenAndGetNext (Token_RightParenthesis); StoreCode_icGoSub (FileExpression.IntermediateCodeOffset); StoreCode_icGoSub (RecordSizeExpression.IntermediateCodeOffset); Case FileExpression.TypeDefPtr^.BaseType of btFile: GenerateInstruction_CALL_FAR (ProcParameter); else GenerateInstruction_CALL_FAR (ProcParameter - $0010); end; GenerateIOErrorCheckingCode; Proc_Reset_Rewrite := EndSubroutine; end; This function processes system procedure SetTextBuf. Function Proc_SetTextBuf: Word; Far; Var TextFile, Buffer, Size: TExpression; begin ExpectTokenAndGetNext (Token_LeftParenthesis); TextFile.ExpectFileVariableAndPushPointerToMemory; If TextFile.TypeDefPtr^.BaseType <> btText then Error (InvalidFileType); ExpectTokenAndGetNext (Token_Comma); Buffer.ExpectAssignableVariableReferenceExceptProcAndFuncAndPushPointerToMemory; With Size do If CheckAndGetNextToken (Token_Comma) then begin ExpectIntegerExpression; CheckOrdinalRange (Ptr (SystemUnitSegment, Word_TypeOffset)); PushExpression end else begin GenerateCodeToPushWord (Buffer.TypeDefPtr^.Size); EndIntermediateCodeSubroutine; end; ExpectTokenAndGetNext (Token_RightParenthesis); StoreCode_icGoSub (TextFile.IntermediateCodeOffset); StoreCode_icGoSub (Buffer.IntermediateCodeOffset); StoreCode_icGoSub (Size.IntermediateCodeOffset); GenerateInstruction_CALL_FAR (SysProc_BufferText); GenerateIOErrorCheckingCode; Proc_SetTextBuf := EndSubroutine; end; |