program LispKit(Input, Output, InFile, OutFile);

(*-----------------------------------------------------------------*)
(*                                                                 *)
(*   Reference model lazy interactive SECD machine, 3              *)
(*      -- version 3a                                    April 83  *)
(*      -- IMPLODE and EXPLODE instructions, version 3b    May 83  *)
(*                                                                 *)
(*   Modifications specific to UCSD pascal  gaj          April 83  *)
(*                                                                 *)
(*-----------------------------------------------------------------*)
(*                                                                 *)
(*    (c)  Copyright  P Henderson, G A Jones, S B Jones            *)
(*                    Oxford University Computing Laboratory       *)
(*                    Programming Research Group                   *)
(*                    8-11 Keble Road                              *)
(*                    OXFORD  OX1 3QD                              *)
(*                                                                 *)
(*-----------------------------------------------------------------*)
(*                                                                 *)
(*   Documentation:                                                *)
(*                                                                 *)
(*     P Henderson, G A Jones, S B Jones                           *)
(*         The LispKit Manual                                      *)
(*         Oxford University Computing Laboratory                  *)
(*         Programming Research Group technical monograph PRG-32   *)
(*         Oxford, August 1983                                     *)
(*                                                                 *)
(*     P Henderson                                                 *)
(*         Functional Programming: Application and Implementation. *)
(*         Prentice-Hall International, London, 1980               *)
(*                                                                 *)
(*-----------------------------------------------------------------*)

(*------------------ Machine dependent constants ------------------*)

label 99;

const TopCell = 8000;                (*    size of heap storage    *)

(*--------------- Machine dependent file management ---------------*)

var InOpen : boolean;
    InFile : interactive;
    OutFile : text;

procedure OpenInFile;
var s : string;
begin writeln(Output);
      write(Output, 'Take input from where? ');
      readln(Input, s);
      if s = '' then s := 'CONSOLE:';
      {$I-} reset(InFile, s) {$I^};
      InOpen := IOResult = 0;
      if not InOpen then write(Output, 'Cannot find ', s)
end {OpenInFile};

procedure CloseInFile; begin close(InFile, NORMAL); InOpen := false end;

procedure ChangeOutFile;
var s : string;
    ok : boolean;
begin close(OutFile, LOCK);
      repeat writeln(Output);
             write(Output, 'Send output to where? ');
             readln(Input, s);
             if s = '' then s := 'CONSOLE:';
             {$I-} rewrite(OutFile, s) {$I^};
             ok := IOResult = 0;
             if not ok then write(Output, 'Cannot write to ', s)
      until ok
end {ChangeOutFile};

(*------------------- Character input and output ------------------*)

procedure GetChar(var ch : char);
const EM = 25;
begin while not InOpen do OpenInFile;
      if eof(InFile) then begin CloseInFile; ch := ' ' end
      else
        if eoln(InFile) then begin readln(InFile); ch := ' ' end
      else
        begin read(InFile, ch);
              if ch = chr(EM) then
                   begin readln(InFile); ChangeOutFile; ch := ' ' end
        end
end {GetChar};

procedure PutChar(ch : char);
const CR = 13;
begin if ch = chr(CR) then writeln(OutFile) else write(OutFile, ch)
end {PutChar};

(*------- Machine dependent initialisation and finalisation -------*)

procedure Initialise(Version, SubVersion : char);
begin writeln(Output, 'Sage Pascal SECD machine ', Version, SubVersion);
      {$I-} reset(InFile, '*SECD.BOOT') {$I^};
      InOpen := IOResult = 0;
      if not InOpen then writeln(Output, 'No file *SECD.BOOT');
      rewrite(OutFile, 'CONSOLE:')
end {Initialise};

procedure Terminate; begin close(OutFile); exit(PROGRAM) end {Terminate};
                               
(*------------------ Machine independent code ---------------------*)

; procedure Machine; { omitted }

; begin Machine; 99: end {LispKit}.