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;