System Procedures Close, Seek, Erase, Rename and Truncate
These functions process system procedures Close, Seek, Erase and Rename. The first function processes system procedure Close.
Function Proc_Close: Word; Far;
Var FileVariable: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  FileVariable.ExpectFileVariableAndPushPointerToMemory;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  StoreCode_icGoSub (FileVariable.IntermediateCodeOffset);
  Case FileVariable.TypeDefPtr^.BaseType of
    btFile: GenerateInstruction_CALL_FAR (SysProc_CloseFile);
    else GenerateInstruction_CALL_FAR (SysProc_CloseText);
  end;
  GenerateIOErrorCheckingCode;
  Proc_Close := EndSubroutine;
end;
This function processes system procedure Seek.
Function Proc_Seek: Word; Far;
Var FileVariable, Position: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  FileVariable.ExpectFileVariableAndPushPointerToMemory;
  If FileVariable.TypeDefPtr^.BaseType <> btFile then Error (InvalidFileType);
  ExpectTokenAndGetNext (Token_Comma);
  Position.ExpectIntegerExpression;
  Position.CheckOrdinalRange (Ptr (SystemUnitSegment, LongInt_TypeOffset));
  Position.PushExpression;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  StoreCode_icGoSub (FileVariable.IntermediateCodeOffset);
  StoreCode_icGoSub (Position.IntermediateCodeOffset);
  GenerateInstruction_CALL_FAR (SysProc_SeekFile);
  GenerateIOErrorCheckingCode;
  Proc_Seek := EndSubroutine;
end;
This function processes system procedure Erase.
Function Proc_Erase: Word; Far;
Var FileVariable: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  FileVariable.ExpectFileVariableAndPushPointerToMemory;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  StoreCode_icGoSub (FileVariable.IntermediateCodeOffset);
  GenerateInstruction_CALL_FAR (SysProc_EraseFile);
  GenerateIOErrorCheckingCode;
  Proc_Erase := EndSubroutine;
end;
This function processes system procedure Rename.
Function Proc_Rename: Word; Far;
Var FileVariable, NewName: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  FileVariable.ExpectFileVariableAndPushPointerToMemory;
  ExpectTokenAndGetNext (Token_Comma);
  NewName.ExpectAndStoreStringCompatibleExpressionAndPushPointer;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  StoreCode_icGoSub (FileVariable.IntermediateCodeOffset);
  StoreCode_icGoSub (NewName.IntermediateCodeOffset);
  Case NewName.TypeDefPtr^.BaseType of
    btString: GenerateInstruction_CALL_FAR (SysProc_RenameFile);
    else GenerateInstruction_CALL_FAR (SysProc_RenameFileC);
  end;
  GenerateIOErrorCheckingCode;
  Proc_Rename := EndSubroutine;
end;
This function processes system procedure Truncate.
Function Proc_Truncate: Word; Far;
Var FileVariable: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  FileVariable.ExpectFileVariableAndPushPointerToMemory;
  If FileVariable.TypeDefPtr^.BaseType <> btFile then Error (InvalidFileType);
  ExpectTokenAndGetNext (Token_RightParenthesis);
  StoreCode_icGoSub (FileVariable.IntermediateCodeOffset);
  GenerateInstruction_CALL_FAR (SysProc_TruncFile);
  GenerateIOErrorCheckingCode;
  Proc_Truncate := EndSubRoutine;
end;
 
 
 
© 2017 Turbo Pascal | Privacy Policy