⟦24bb0d7a9⟧

TextFile

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

/****************************************************************
*                                                               *
*                         Copyright (c) 1985                    *
*               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: UNKNOWN.C

   Contains the operating system dependent primitives and routines
   that Scheme needs, written in portable C (most of them
   unimplemented).

*/

/* Fixnum multiplication. */
#include "mul.c"
\f


/* IO and file operations */

#define dump_output_buffer() fflush(stdout)
#define flush_input_buffer() 

NIY(Prim_Remove_File, 1, "REMOVE-FILE")
NIY(Prim_Delete_File, 1, "DELETE-FILE")
NIY(Prim_Link_File, 3, "LINK-FILE")
NIY(Prim_Rename_File, 3, "RENAME-FILE")
NIY(Prim_Make_Directory, 1, "MAKE-DIRECTORY")
NIY(Prim_Prefix_Volume, 1, "PREFIX-VOLUME")
NIY(Prim_Move_Cursor, 2, "MOVE-CURSOR")
NIY(Prim_Clear_To_End_Of_Line, 0, "CLEAR-TO-END-OF-LINE")

void OS_Flush_Output_Buffer()
{ dump_output_buffer();
}

/* These are faked, rather than make them unimplemented */

/* This may even work */

void OS_Clear_Screen()
{ putchar('\f');
}

long NColumns()
{ return 79;
}

long NLines()
{ return 24;
}

void Restartable_Exit()
{ fprintf(stderr, "\nUnimplemented utility: Restartable_Exit.");
  return;
}
\f


/* Date and time */

long System_Clock()
{ fprintf(stderr, "/nUnimplemented utility: System_Clock");
  return 0;
}

NIY(Prim_Current_Day, 0, "DAY")
NIY(Prim_Current_Hour, 0, "HOUR")
NIY(Prim_Current_Minute, 0, "MINUTE")
NIY(Prim_Current_Month, 0, "MONTH" + 1)
NIY(Prim_Current_Second, 0, "SECOND")
NIY(Prim_Current_Year, 0, "YEAR")
\f


/* Keyboard input */

extern char OS_tty_tyi();

char OS_tty_tyi(Immediate, Interrupted)
Boolean Immediate, *Interrupted;
{ *Interrupted = false;
  return (getchar() & MAX_CHAR);
}
\f


/* Keyboard Interrupts */

/* These are also faked.  They should never be called since there is
 * nothing to tell Scheme that it has been interrupted.
 */

Built_In_Primitive(Prim_Chk_And_Cln_Input_Channel, 2,
		 "CHECK-AND-CLEAN-UP-INPUT-CHANNEL")
{ return TRUTH;
}

char Int_Char;

Built_In_Primitive(Prim_Get_Next_Interrupt_Char, 0,
		 "GET-NEXT-INTERRUPT-CHARACTER")
{ Pointer Result = FIXNUM_0 + Int_Char;
  Int_Char = 0;
  IntCode &= ~INT_Character;
  return Result;
}
\f


/* Interrupt handler.  To be installed on ^A if possible.
 * Fix the h command when interrupts are installed.
 */

#define INTERRUPT	1
#define REDO		2

#define CONTROL_B       'B'
#define CONTROL_G       'G'
#define CONTROL_P       'P'
#define CONTROL_X       'X'
#define CONTROL_A	'A'
#define CONTROL_U	'U'
#define CONTROL_F	'F'
#define CONTROL_M	'M'

long Ask_Me()
{ char command;
  putchar('\007');
  putchar('\n');
Loop:
  printf("Interrupt character (? for help): ");
  command =  getchar();
  switch (command)
  { case 'B':
    case 'b': Int_Char = CONTROL_B; break;

    case 'D':
    case 'd': putchar('\n');
	      Handle_Debug_Flags();
	      goto exit_gracefully;
    case 'T':
    case 't': putchar('\n');
	      Back_Trace();
	      goto exit_gracefully;

    case 'G':
    case 'g': Int_Char = CONTROL_G; break;
\f


    case 'P':
    case 'p':
    case 'U':
    case 'u': Int_Char = CONTROL_U; break;

    case 'F':
    case 'f':
    case 'X':
    case 'x': Int_Char = CONTROL_X; break;

    case 'H':
    case 'h': printf("\nThe following control characters are available at");
              printf("\nany time in Scheme:\n");
              printf("\n^A: interactive choice of interrupt");
              printf("\n<returning to Scheme>\n");
              goto exit_gracefully;

    case 'Q':
    case 'q':
	      putchar('\n');
	      Microcode_Termination(TERM_HALT);

    case '\f': OS_Clear_Screen(); goto exit_gracefully;

    case 'I':
    case 'i': 	 printf("gnored.\n");
exit_gracefully: return REDO;

    default: putchar('\n');
             printf("B: Enter a breakpoint loop\n");
             printf("D: Debugging: change interpreter flags\n");
             printf("F or X: Abort to current REP loop\n");
             printf("G: Goto to top level read-eval-print (REP) loop\n");
	     printf("H: Print information about interrupt characters\n");
             printf("I: Ignore interrupt request\n");
             printf("P or U: Up to previous (lower numbered) REP loop\n");
             printf("Q: Quit instantly, killing Scheme\n");
             printf("T: Stack trace\n");
             printf("^L: Clear the screen\n");
             goto Loop;
  }
  IntCode |= INT_Character;
  New_Compiler_MemTop();
  return INTERRUPT;
}
\f


/* Initializes OS dependent information for Scheme */

void OS_Re_Init()
{ return;
}

void OS_Init()
{ OS_Name = "unknown";
  OS_Variant = NULL;
  printf("MIT Scheme, Unknown operating system version\n");
  printf("There are no Scheme interrupt characters on this system\n");
  /*
  printf("^AH (CTRL-A, then H) shows help on interrupt keys.\n");
  */
  Int_Char = 0;
  /* Split out to correspond to UNIX where we can suspend and continue */
  OS_Re_Init();
}

void OS_Quit()
{ return;
}
\f


/* Fasload and Fasdump use the following routines */

void Load_Data(Count, To_Where)
long Count;
char *To_Where;
{ fread(To_Where, sizeof(Pointer), Count, File_Handle);
}

Boolean Open_Dump_File(Name, flag)
char *Name, *flag;
{ return Open_File(Name, flag, &File_Handle);
}

void Write_Data(Count, From_Where)
long Count;
char *From_Where;
{ fwrite(From_Where, sizeof(Pointer), Count, File_Handle);
}

#ifdef COMPILE_FUTURES
void Clear_Timer()
{ fprintf(stderr, "\nCan't clear a timer under this OS.");
}

void Set_Timer()
{ fprintf(stderr, "\nCan't set a timer under this OS.");
}
#endif
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦24bb0d7a9⟧ TextFile

Derivation

TextFile
