{ $DEFINE SETEST}
{* S Shell interpreter, ver 1.00.
   Copyright (C) 1994, Henri LESOURD.

   This software is free software; you can redistribute it and/or
   modify it under the terms of the GNU Library General Public License as
   published by the Free Software Foundation; either version 2 of the
   License, or (at your option) any later version.

   This compiler is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Library General Public License for more details.

   You should have received a copy of the GNU Library General Public
   License along with the GNU C Library; see the file COPYING.LIB.  If not,
   write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, USA.  *}
Program SE;

{ $M 50000 0 655360}

{$IFDEF SETEST}
Uses
    Crt,
    Dos,
    Errorify,
    Editify;
{$ELSE}
Uses
    Crt,
    Dos,
    Errorify,
    Editify,
    Symbolize,
    Lexify,
    Writify,
    Digitizify,
    Assemblify,
    Addressify,
    Expressify,
    Compilify,
    Loadify;
{$ENDIF}

Var
   J : JumpBuf;
   LiCour,ColWriteCR,ColorMenu,ColorCommand : Word;
   ExecReady,HasBeenCompiled : Boolean;
   Heap0Limit : Pointer;

{$F+}
Procedure CRChanged(NbCR : Word);
Begin
  Locate(LiCour,ColWriteCR);
  Write(NbCR+1);
End;
{$F-}

{$IFDEF SETEST}
Procedure ResetAll;
Begin
End;
{$ELSE}
Procedure ResetAll;
Begin
  ResetHash;
  InitPredefSymbs;
  Envir0:=Nil;
  Touched:=False;
  ExecReady:=False;
  HasBeenCompiled:=False;
  Release(Heap0Limit);
End;
{$ENDIF}

Procedure CompileCurrent;
{$IFDEF SETEST}
Begin
  Writeln('  Test');
End;
{$ELSE}
Var
   I : Integer;
   S : String;
   B : BoxPtr;
Begin
  ResetAll;
  WaitOnError:=False;
  FT:=OBJ;
  StartLexify0;
  Write('  Parsing : 1');
  ColWriteCR:=13;
  B:=DigitizePackage;
{ More:=False;
  Lisp:=True;
  NbCarriages:=1;
  SetColorMode;
  AnalogizePackage(B);}
  TextAttr:=ColorMenu;
  Writeln;
  If LiCour<25 Then Inc(LiCour);
  EndLexify0;
  For I:=AX To rSS Do RegFree[I]:=False;
  Init;
  S:=TextName;
  If (Length(S)<=2) Or (S[Length(S)]<>'S') Or (S[Length(S)-1]<>'.')
  Then
    Error('Bad file name : ".S" expected')
  Else
    Dec(Byte(S[0]),2)
  ;
  StartAssemblify(S);
  NewLabel(EnterLab);
  Write('  Compiling : 1');
  ColWriteCR:=15;
  CompilePackage(B);
  EndAssemblify;
  Writeln;
  If LiCour<25 Then Inc(LiCour);
  ResetAll;
  HasBeenCompiled:=True;
End;
{$ENDIF}

{$IFDEF SETEST}
Procedure RunCurrent;
Begin
  Writeln('  Test');
End;
{$ELSE}
Const
     Digit : Array[$0..$F] Of Char=(
                                      '0','1','2','3','4','5','6','7',
                                      '8','9','A','B','C','D','E','F'
                                   );
Procedure WriteByte(B : Byte);
Begin
  Write(Digit[B Shr 4]);
  Write(Digit[B And $0F]);
End;

Procedure RunCurrent;
Var
   A : AccessPtr;
Begin
  If Touched Then ResetAll;
  If Not ExecReady Then
  Begin
    If Not HasBeenCompiled Then CompileCurrent;
    HasBeenCompiled:=False;
    IgnoreCBreak:=False;
    LinkPak(@EnvirCour);
    HasBeenCompiled:=True;
  End;
  ExecReady:=True;
  IgnoreCBreak:=False;
  StartPak(@EnvirCour);
  IgnoreCBreak:=True;
End;
{$ENDIF}

{$F+}
Procedure Handler(S : String);
Var
   Touche : Word;
Begin
  PrintMessage(LiCour,3,S);
  Writeln;
  LongJump(J,1);
End;

Procedure AdjustFName(Var S : String);
Var
   Length,I,J : Word;
Begin
  UpCaseString(S);

  Length:=Byte(S[0]);
  If Length=0 Then Exit;

  J:=0; For I:=1 To Length Do
  Begin
    If S[I]='.' Then J:=I;
  End;

  If J<>0 Then
  Begin
    If J=Length Then Dec(Byte(S[0]));
  End
  Else
    S:=Concat(S,'.S');
End;
{$F-}

Procedure InitSE;
Var
   P : Pointer;
Begin
{ Alloc buffer edit }
  GetMem(P,$FFFE);
  If P=Nil Then
  Begin
    Write('Out of memory');
    Halt;
  End;
{ Init scr }
  TextMode(3);
  SetCursShape($0008);
  ColorMenu:=7;
  ColorCommand:=2;
  DirectVideo:=False;
  SetBuffer(P,$FFFE);
  EditErrorHandler:=Handler;
  AdjustFileName:=AdjustFName;
  TextName:='UNNAMED.S';
{ Init CallBackCR }
{$IFNDEF SETEST}
  CallBackCR:=CRChanged;
{$ENDIF}
{ Init assembleur }
  CompileToDisk:=False;
  GetBlock(EnvirCour.CS,$FFE0);
  If EnvirCour.CS.BA=Nil Then Error('Init : alloc ByteCode : out of memory');
  SetByteCode(EnvirCour.CS.BA,$FFE0);
{ Init SE }
  Mark(Heap0Limit);
  ResetAll;
  GetCBreakControl;
End;

Procedure ExitSE;
Begin
  ActUpModified(LiCour,3);
  RestoreCBreakControl;
  ResetRuntime;
End;

Procedure PrintMenu;
Begin
  ClrScr;
  Writeln('Current : ',TextName{,' SPtr=',SPtr});
  Writeln;
  Writeln('Rename(F1)   Load(F3)   Save(F4)   Edit');
  Writeln;
  Write('Mode(');
  If CompileToDisk Then Write('Disk)   ') Else Write('Mem)    ');
  Writeln('Compile    Run        Quit');
  Writeln;
  Writeln(MemAvail,' bytes free');
  Writeln;
End;

Label
     EnterEdit,AfterEdit,Others,EnterCommand,ExecAltCom;
Var
   Touche,Resu : Word;
   LigneDeComTorchee,FromEditor : Boolean;
   Command : String;

Function ExecutableAltCom(Resu : Word) : Boolean;
Begin
  Case Resu Of
    T_F1,T_F4,T_F3,T_ALT_Q,T_ALT_C,T_ALT_R,T_ALT_M: ExecutableAltCom:=True;
    Else
      ExecutableAltCom:=False;
  End;
End;

Function GetEndPtr : Pointer;
Var
   P,HeapPtr0 : Pointer;
   M : LongInt;
   I : Integer;
Begin
  Mark(HeapPtr0);
  M:=MaxAvail;
  For I:=1 To M Div $8000 Do GetMem(P,$8000);
  GetMem(P,MaxAvail);
  GetEndPtr:=HeapPtr;
  Release(HeapPtr0);
End;

Var
   EndPtr : Pointer;

Function Spawn(Var Command : String) : Word;
Var
   R : Registers;
   MaxSize : Word;
   OLib : LongInt;
Begin
  OLib:=MemL[0:$200];
  MemL[0:$200]:=0;
  SwapVectors;
  R.AX:=$4A00;
  R.BX:=$FFFF;
  R.ES:=PrefixSeg;
  Intr($21,R);
  MaxSize:=R.BX;
  R.AX:=$4A00;
  R.BX:=MaxSize-((LongInt(EndPtr) Shr 16)-(LongInt(HeapPtr) Shr 16))+1;
  R.ES:=PrefixSeg;
  Intr($21,R);
  Exec('C:\COMMAND.COM','/C'+Command);
  Spawn:=DosError;
  R.AX:=$4A00;
  R.BX:=MaxSize;
  R.ES:=PrefixSeg;
  Intr($21,R);
  SwapVectors;
  MemL[0:$200]:=OLib;
End;

Begin
  InitSE;
  EndPtr:=GetEndPtr;
  LigneDeComTorchee:=False;
  TextAttr:=ColorMenu;
  PrintMenu;
  Resu:=SetJump(J);
  ResetAll;
  ErrorReturn:=J;
  ErrorReturnInitialized:=True;
  If ErrorMessage<>'' Then
  Begin
    LiToGo:=NbCR+1;
    EnterMessage:=ErrorMessage;
    Resu:=EditText(1,25);
    ErrorMessage:='';
    Goto AfterEdit;
  End;
  If SetJump(CBreakReturn)<>0 Then
  Begin
    IgnoreCBreak:=True;
    If GetCurPos And $FF<>0 Then Writeln;
    PrintMessage((GetCurPos Shr 8)+1,1,'User Break');
  End;
  If Not LigneDeComTorchee Then
  Begin
    LigneDeComTorchee:=True;
    If ParamCount>1 Then Error('SE [FicName] expected');
    If ParamCount=1 Then
    Begin
      TextName:=ParamStr(1);
      AdjustFileName(TextName);
      LoadText(TextName);
      Goto EnterEdit;
    End;
  End;
  Repeat
    TextAttr:=ColorMenu;
    If GetCurPos And $FF<>0 Then Writeln;
    Write('> ');
    Touche:=GetCar;
    Writeln;
    LiCour:=(GetCurPos Shr 8)+1;
ExecAltCom:
    Case Touche Of
      T_CR,T_CTRL_CR,T_ESC: PrintMenu;
      T_F1: Begin
              ActUpRename(LiCour,3);
              TextAttr:=ColorMenu;
              PrintMenu;
            End;
      T_F4: Begin
              ActUpSave(LiCour,3);
              Writeln;
            End;
      T_F3: Begin
              ActUpLoad(LiCour,3);
              TextAttr:=ColorMenu;
              Goto EnterEdit;
            End;
      T_ALT_Q: Touche:=Ord('Q');
      T_ALT_C: CompileCurrent;
      T_ALT_R: RunCurrent;
      T_ALT_M: Begin
                 CompileToDisk:=Not CompileToDisk;
                 PrintMenu;
               End;
      T_ALT_E:
      Begin
      EnterEdit:
        Resu:=EditText(1,25);
      AfterEdit:
        FromEditor:=True;
        TextAttr:=ColorMenu;
        If (Resu=T_ESC) Or (Resu=T_CTRL_CR) Or (ExecutableAltCom(Resu)) Then
        Begin
          Locate(25,1);
          Writeln;
          LiCour:=25;
        End;
Others:
        If Resu Shr 8<>0 Then
          If ExecutableAltCom(Resu) Then
            Begin
              Touche:=Resu;
              Goto ExecAltCom;
            End
          Else
            If FromEditor Then
              Begin
                RefreshFlag:=False;
                Goto EnterEdit;
              End
            Else
              Begin
                Command:='';
                Goto EnterCommand;
              End
        Else
        Begin
        EnterCommand:
          If (Resu Shr 8=0) And
             (Resu<>T_ESC) And
             (Resu<>T_CR) And
             (Resu<>T_CTRL_CR) Then
          Begin
            Command:=Char(Lo(Resu));
            If FromEditor Then Write('> ');
            Repeat
              Resu:=LCInput(LiCour,3,60,ColorCommand,Command,250);
              If (Resu=T_ALT_E) Or ExecutableAltCom(Resu) Then
              Begin
                TextAttr:=ColorMenu;
                Locate(LiCour,1);
                ClrEOL;
                Touche:=Resu;
                Goto ExecAltCom;
              End;
            Until Resu=T_CR;
            If Spawn(Command)<>0 Then Writeln('Erreur');
            Touche:=0;
            Writeln;
          End;
        End;
      End;
      Else
      Begin
        Resu:=Touche;
        FromEditor:=False;
        Goto Others;
      End;
    End;
    TextAttr:=ColorMenu;
  Until (Touche And $FF00=0) And (UpCase(Chr(Touche And $FF))='Q');
  ExitSE;
  SetCursShape($0708);
End.