System Procedures Append, Flush, BlockRead and BlockWrite

This function processes system procedures Append and Flush.
Function Proc_Append_Flush: Word; Far;
Var FileExpression: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  FileExpression.ExpectFileVariableAndPushPointerToMemory;
  If FileExpression.TypeDefPtr^.BaseType <> btText then Error (InvalidFileType);
  ExpectTokenAndGetNext (Token_RightParenthesis);
  StoreCode_icGoSub (FileExpression.IntermediateCodeOffset);
  GenerateInstruction_CALL_FAR (ProcParameter);
  GenerateIOErrorCheckingCode;
  Proc_Append_Flush := EndSubroutine;
end;
This function processes system procedures BlockRead and BlockWrite.
Function Proc_BlockRead_BlockWrite: Word; Far;
Var FileVariable, Count, Buffer, ErrorVariable: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  FileVariable.ExpectFileVariableAndPushPointerToMemory;
  If PFileTypeDefinition (FileVariable.TypeDefPtr)^.BaseType <> btFile then Error (InvalidFileType);
  If PFileTypeDefinition (FileVariable.TypeDefPtr)^.BaseFileTypeOffset.TypeOffset <> 0 then Error (InvalidFileType);
  ExpectTokenAndGetNext (Token_Comma);
  Buffer.ExpectAssignableVariableReferenceExceptProcAndFuncAndPushPointerToMemory;
  ExpectTokenAndGetNext (Token_Comma);
  Count.ExpectIntegerExpression;
  Count.CheckOrdinalRange (Ptr (SystemUnitSegment, Word_TypeOffset));
  Count.PushExpression;
  If not CheckAndGetNextToken (Token_Comma) then
    begin
      GenerateInstruction_TwoBytes ($31, $C0);
      GenerateInstruction_TwoBytes ($50, $50);
      ErrorVariable.EndIntermediateCodeSubroutine;
    end else ErrorVariable.Expect16BitIntegerVariable;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  StoreCode_icGoSub (FileVariable.IntermediateCodeOffset);
  StoreCode_icGoSub (Buffer.IntermediateCodeOffset);
  StoreCode_icGoSub (Count.IntermediateCodeOffset);
  StoreCode_icGoSub (ErrorVariable.IntermediateCodeOffset);
  GenerateInstruction_CALL_FAR (ProcParameter);
  GenerateIOErrorCheckingCode;
  Proc_BlockRead_BlockWrite := EndSubroutine;
end;
 
 
 
© 2017 Turbo Pascal | Privacy Policy