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;
 
 
 
© 2017 Turbo Pascal | Privacy Policy