DataMuseum.dk

top - download

    Length: 5175 (0x1437)
    Types: TextFile
    Names: »file.c«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/gnu-31mar87/scheme/microcode/file.c« 

TextFile

/*          Hey EMACS, this is -*- C -*- code!                 */

/****************************************************************
*                                                               *
*                         Copyright (c) 1984                    *
*               Massachusetts Institute of Technology           *
*                                                               *
* This material was developed by the Scheme project at the      *
* Massachusetts Institute of Technology, Department of          *
* Electrical Engineering and Computer Science.  Permission to   *
* copy this software, to redistribute it, and to use it for any *
* purpose is granted, subject to the following restrictions and *
* understandings.                                               *
*                                                               *
* 1. Any copy made of this software must include this copyright *
* notice in full.                                               *
*                                                               *
* 2. Users of this software agree to make their best efforts (a)*
* to return to the MIT Scheme project any improvements or       *
* extensions that they make, so that these may be included in   *
* future releases; and (b) to inform MIT of noteworthy uses of  *
* this software.                                                *
*                                                               *
* 3.  All materials developed as a consequence of the use of    *
* this software shall duly acknowledge such use, in accordance  *
* with the usual standards of acknowledging credit in academic  *
* research.                                                     *
*                                                               *
* 4. MIT has made no warrantee or representation that the       *
* operation of this software will be error-free, and MIT is     *
* under no obligation to provide any services, by way of        *
* maintenance, update, or otherwise.                            *
*                                                               *
* 5.  In conjunction with products arising from the use of this *
* material, there shall be no use of the name of the            *
* Massachusetts Institute of Technology nor of any adaptation   *
* thereof in any advertising, promotional, or sales literature  *
* without prior written consent from MIT in each case.          *
*                                                               *
****************************************************************/

/* File: FILE.C

   Contains portable C file operations.
   It depends only on the standard C library.

*/

#include "scheme.h"
#include "primitive.h"
\f


/* Generic file utilities */

Built_In_Primitive(Prim_File_Exists, 1, "FILE-EXISTS?")
{ FILE *If_It_Works;
  Primitive_1_Arg();

  Arg_1_Type(TC_CHARACTER_STRING);
  if (Open_File(Arg1, "r", &If_It_Works))
  { fclose(If_It_Works);
    return TRUTH;
  }
  else return NIL;
}

Built_In_Primitive(Prim_Copy_File, 2, "COPY-FILE")
{ FILE *Source_File, *Destination_File;
  int c;
  Primitive_2_Args();

  Arg_1_Type(TC_CHARACTER_STRING);
  Arg_2_Type(TC_CHARACTER_STRING);
  printf("\nWarning: COPY-FILE may only work on TEXT files.");
  if (Open_File(Arg1, "r", &Source_File))
  { if (Open_File(Arg2, "w", &Destination_File))
    { while ((c = getc(Source_File)) != EOF)
	putc(c, Destination_File);
      fclose(Source_File);
      fclose(Destination_File);
      return TRUTH;
    }
    else { fclose(Source_File);
	   Primitive_Error(ERR_ARG_2_BAD_RANGE);
	 }
  }
  else Primitive_Error(ERR_ARG_1_BAD_RANGE);
}

Built_In_Primitive(Prim_Internal_Photo, 2, "INTERNAL-PHOTO")
{ Primitive_2_Args();

  Arg_1_Type(TC_CHARACTER_STRING);
  Touch_In_Primitive(Arg2, Arg2);
  if (Arg2 != NIL)
    if (Photo_Open) return NIL;
    else
    { if (Photo_Open = Open_File(Arg1, "w", &Photo_File_Handle))
	return TRUTH;
      Primitive_Error(ERR_ARG_1_BAD_RANGE);
    }
  else if (Photo_Open)
  { Close_File(Photo_File_Handle);
    Photo_Open = false;
    return TRUTH;
  }
  else return NIL;
}
\f


/* Scheme file io basic primitives */

Built_In_Primitive(Prim_Open_Channel, 2, "OPEN-CHANNEL")
/* Called with a file name and boolean "For Output", returns
   a "channel" for use by SCHEME or NIL on failure */
{ char *Mode_String;
  long i;
  Primitive_2_Args();

  Arg_1_Type(TC_CHARACTER_STRING);
  Touch_In_Primitive(Arg2, Arg2);
  Mode_String = (Arg2 == NIL) ? "r" : "w";
  for (i=1; i <= FILE_CHANNELS; i++)
    if (Channels[i]==NULL)
    { if (Open_File(Arg1, Mode_String, &(Channels[i])))
      { Open_File_Hook(i);
	return FIXNUM_0+i;
      }
      else
      { Channels[i] = NULL;
	Primitive_Error(ERR_ARG_1_BAD_RANGE);
      }
    }
  Primitive_Error(ERR_OUT_OF_FILE_HANDLES);
}

Built_In_Primitive(Prim_Close_Physical_Channel, 1, "CLOSE-PHYSICAL-CHANNEL")
{ int Channel;
  FILE *File_Block;
  Primitive_1_Arg();

  Arg_1_Type(TC_FIXNUM);
  Range_Check(Channel, Arg1, 0, FILE_CHANNELS, ERR_ARG_1_BAD_RANGE);
  File_Block = Channels[Channel];
  if (File_Block != NULL) fclose(File_Block);
  Channels[Channel] = NULL;
  Close_File_Hook();
  return TRUTH;
}