(*

 (c) Copyright Hewlett-Packard Company, 1982,1989.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


            RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)



$modcal$
$iocheck off$ $debug off$ $range off$ $ovflcheck off$
$heap_dispose off$
$ALLOW_PACKED ON $     { JWS 4/10/85}

program cmd(input,output,keyboard);

module ci;

$ALLOW_PACKED ON $     { SFB/JWH}

import
  sysglobals,fs,loader,asm,misc,sysdevs,ldr;

export


type
  sysfiles = (assembler,compiler,editor,filer,librarian,library);
  sysfilevols  = array [sysfiles] of string[6];
  sysfilenames = array [sysfiles] of fid;


  inforec = record                                         (*FILE INFORMATION*)
             errsym,errblk,errnum: integer;             (*ERROR STUFF IN EDIT*)
             gotsym,gotcode: boolean;                 (*TITLES ARE MEANINGFUL*)
             workfid,symfid,codefid,errfid: fid;         (*PERM&CUR WORKFILES*)
           end (*INFOREC*) ;

  inforecptr = ^inforec;
  cmdprocedure = procedure;
  cmdprocptr= ^cmdprocedure;

var streamfib: ^text;                                (*FOR SYSTEM STREAM FILE*)
    filename: sysfilenames;
    tioresult:integer; {to save previous ioresult}
    chainfile: fid;
    chaining: (nochain,progchain,streamchain);
    userinfo:  inforecptr;
    versionup: boolean;
    cmdcharhook : cmdprocptr;
    ci_idle: boolean;
    ci_cmd: char;
    keystream: boolean; { stream file is original file }
  
  procedure homecursor  ;
  procedure clearscreen  ;
  procedure clearline  ;
  procedure prompt (pl: string80);
  function  getchar (flushit: boolean): char;
  function  uppercase (ch: char): char;
  procedure chain(filename: fid);
  procedure startstream(filename: fid);
  function  streaming: boolean;


procedure systemstartup;

implement

type
  monthtype = array [0..15] of packed array [1..3] of char;
const
  months = monthtype [ '???','Jan','Feb','Mar','Apr','May','Jun',
                       'Jul','Aug','Sep','Oct','Nov','Dec','???',
                       '???','???' ];
    
var
  
  {export this hook, or put it in MISC or somewhere for any shipped version.
   We won't export it for this version, because we don't want to have to go
   to all the work of determining if it's there or not, and assuming it's
   there when it really isn't (e.g. in previous rev of CI) will be disastrous!}
   
  old_to_do : procedure(var to_do_datap:string; var no_output:boolean);
  {For Philips. Would make this a global of whatever program contains the
   to_do_ procedure, if we modularize this}
   
  old_out_am : amtype;  {to be able to restore output, if check_to_do redirected
                         it to null_dvr SFB/JWH}
  
  to_do_hook : procedure(var to_do_datap:string; var no_output:boolean);
  
  {For Philips. CI calls this hook before AUTOSTART processing, and from COMMAND
   loop each time through, before any key is processed. If you have a program 
   you wish to execute under this regime, pass back its name
   and any input in to_do_datap, and indicate in no_output whether you want
   OUTPUT redirected to "/dev/null". STARTUP will execute the program if it
   can, redirecting input from to_do_datatp, starting after the program name.
   
   E.g. Pass back "*HFSCK<CR>#11<CR>N<CR>", and FALSE to have *HFSCK executed,
   an provide #11 and "N" (Normal) and an empty string as input to HFSCK. The FALSE 
   says HFSCK's output is not to appear on file OUTPUT). Note that the EOLN character 
   for to_do is <CR> (carriage return). Also note that to_do stuff needs to decide if it
   wants to execute while streaming.
   
   SFB/JWH 6/14/1989
  }
  
  to_do_data:string255; {for Philips. Emulated data file, set up by to_do_hook
                         routine, processed by to_do_dvr. Never export or move to
                         another module. SFB/JWH}


procedure dummy_to_do(var to_do_datap:string; var no_output:boolean);
begin
end;

procedure HFSCK_to_do(var to_do_datap:string; var no_output:boolean);
var un:unitnum;
    p:integer;
begin
  if not streaming then
    begin
      un:=1;
      if h_unitable<> nil then
        with h_unitable^ do
          while (un<=50) and (strlen(to_do_datap)=0) do
            with tbl[un] do
              begin
                if is_hfsunit then
                  if (tbl[base_unum].fs_corrupt) or (tbl[un].fs_corrupt) then 
                    begin
                      
                      fs_corrupt:=false; {fix for using with old HFSCK, which cleared corrupt only 
                                          on base_unum entry}
                      tbl[base_unum].fs_corrupt:=false; {fix for infinite loop with unfixable disk}
                      
                      strwrite(to_do_datap,1,p,'*HFSCK'#13);    {file to execute}
                      strwrite(to_do_datap,p,p,'#',un:1,#13);   {answer unit question}
                      strwrite(to_do_datap,p,p,'N');            {choose Normal mode}
                      strwrite(to_do_datap,p,p,#13);            {use default superblock}
                    end;
                un:=un+1;
              end;
    end;
  if strlen(to_do_data)=0 then
    call(old_to_do, to_do_datap, no_output);
end;

procedure install_HFSCK_to_do;
begin
  old_to_do:=to_do_hook;
  to_do_hook:=HFSCK_to_do;
  {markuser;}
end;

function streaming: boolean;
begin with fibp(streamfib)^ do
  streaming := freadable and (fpos < fleof);
end;

procedure startstream(filename: fid);
begin
  chainfile := filename;
  chaining := streamchain;
  escape(0);
end;

procedure chain(filename: fid);
begin
  chainfile := filename;
  fixname(chainfile, codefile);
  chaining := progchain;
  escape(0);
end;

procedure disptime;
var time: timerec;
    date: daterec;
    x,y: integer;
    second, dayy: shortint;
begin
  second := -1;
  dayy := -1;
  setrunlight(chr(idle));
  with fibp(gfiles[0])^ do
    repeat
    call(am, fibp(gfiles[0]), unitstatus, gfiles[0], 0, 0);
    if fbusy and versionup then
      begin
      systime(time);
      sysdate(date);

      with time, date do
        if (centisecond div 100 <> second) or (day <> dayy) then
         begin
         second := centisecond div 100;
         fgetxy(output, x, y);
         fgotoxy(output, 25, 3);
         write(hour:2,':',minute:2,':',second:2);
         if day <> dayy then
           begin
           dayy := day;
           fgotoxy(output, 25, 2);
           {LAF 880101 added "mod 100"}
           writeln(day:2,'-',months[month],'-',year mod 100:2);
           end;
         fgotoxy(output, x, y);
         end;
      end;
      if fbusy and ci_idle then call(kbdwaithook);
    until not fbusy or (chaining<>nochain);
  ci_idle:=false;
end;

procedure dummycmdchar;
begin end;

procedure initdate;
var
  thedatetime   : datetimerec;
  ltime         : timerec;
begin
  with thedatetime, date do
    begin
      sysdate(date);
      {LAF 880211 1Mar00 is now a valid date}
      if {((year=0) and (month=3) and (day=1)) or}
         ((year=70) and (month=1) and (day=1)) then
        begin
          systime(ltime);
          time := ltime;
          call (unitable^[sysunit].dam, thedatetime, sysunit, getvolumedate);
          if ioresult = ord(inoerror) then
            begin
              setsysdate(date);
              with ltime do
                if (hour = 0) and (minute = 0) then
                  setsystime(time);
            end;
        end;
    end;
end; (*INITDATE*)

procedure dateset;
var
  gs: string80;
  changed: boolean;
  tzchanged: boolean;
  done: boolean;
  negative: boolean;
  tzsecs: integer;
  i: integer;
  clocktime: timerec;
  clockdate: daterec;
  tzrec:     timerec;
  ch:        char;
  clockdatetime: datetimerec;

  procedure identify;
  begin
    clearscreen;  writeln(output);
    writeln(output);
    writeln(output,'  System date is         ');
    writeln(output,'  Clock time is          ');
    writeln(output,'  Time zone  is          ');

    if timezone<0 then begin
      negative:=true;
      tzsecs:=-timezone;
    end
    else begin
      negative:=false;
      tzsecs:=timezone;
    end;
    with tzrec do begin
      hour:=tzsecs div 3600;
      minute:=(tzsecs-hour*3600) div 60;
      centisecond:=tzsecs mod 60;  {actually seconds here}
      fgotoxy(output, 24, 4);
      if negative then write('-') else write (' ');
      writeln(hour:2,':',minute:2,':',centisecond:2);
    end;

    writeln(output);
    writeln(output,'  Philips Workstation     Rev.  3.22PX 15-Jun-89');
    writeln(output);
    writeln(output,'  Available Global Space ',eglobal-(a5-32768):1,' bytes');
    writeln(output,'  Total Available Memory ',
       eglobal-integer(eheap):1,' bytes');
    writeln(output,'  System  volume:  ',syvid,':');
    writeln(output,'  Default volume:  ',dkvid,':');
    writeln;
    writeln(output,'Copyright Hewlett-Packard Company 1982,1989');
    writeln(output,'Copyright AT&T 1980,1984');
    writeln(output,'Copyright Regents Univ. of Calif. 1979,1980,1983');
    writeln(output,'       RESTRICTED RIGHTS LEGEND');
    writeln(output,'Use, duplication or disclosure by the U.S.');
    writeln(output,'Government is subject to restrictions as set');
    writeln(output,'forth in subdivison (b)(3)(ii) of the Rights in');
    writeln(output,'Technical Data and Computer Software clause at');
    writeln(output,'FAR 52.227-7013. Hewlett-Packard Company,');
    writeln(output,'3000 Hanover Street, Palo Alto, CA 94304');

    versionup := true;

  end;  {IDENTIFY}

  function readnumericfield
       (llimit,hlimit:integer; var field:integer): boolean;
  label 1;
  var  gotnum: boolean;  i: integer;  ch: char;
  begin  gotnum := false;  i := 0;
    while strlen(gs) > 0 do
      begin  ch := gs[1];
        if (ch>='0') and (ch<='9') then
          begin  gotnum := true;
            i := 10*i+ord(ch)-ord('0');
            if i>hlimit then i := hlimit+1;
          end
        else
          if gotnum or (ch='[') then goto 1;
        strdelete(gs,1,1);
      end;
1:    if gotnum and (i>=llimit) and (i<=hlimit) then
      begin  readnumericfield := true; field := i  end
    else
      readnumericfield := false;
  end; {READNUMERICFIELD}

  function readmonthabbrev (var monthnumber:integer): boolean;
  label 1;
  var  s3: packed array[1..3] of char;
       i: integer;  ch: char;
  begin  i := 0;  s3 := '   ';
    while strlen(gs) > 0 do
      begin  ch := gs[1];
        if ch in ['A'..'Z','a'..'z'] then
          begin  i := i+1;
            if (ch>='A') and (ch<='Z') then
              ch := chr(ord(ch)-ord('A')+ord('a'));
            if i<4 then s3[i] := ch;
          end
        else
          if i>0 then goto 1;
        strdelete(gs,1,1);
      end;
1:    s3[1] := uppercase(s3[1]);  readmonthabbrev := false;
    for i := 1 to 12 do
      if months[i] = s3 then
        begin  readmonthabbrev := true; monthnumber := i  end;
  end;  {READMONTHABBREV}

begin {DATESET}
  changed := false;
  sysdate(clockdate);
  systime(clocktime);
  identify;
  prompt('New system date ? '); disptime;
  readln(input,gs);
  if strlen(gs)>0 then with clockdate do
    if readnumericfield(1,31,i) then
      begin
      changed := true;
      day := i;
      if readmonthabbrev(i) then month := i;
      {LAF 880101 added "if i<28 then year:=i+100 else"}
      if readnumericfield(0,99,i) then if i<28 then year:=i+100 else year:=i;
      setsysdate(clockdate);
      end;
  prompt('New clock time [zone] ? '); disptime;

  readln(input,gs);

  {Find a number or a '[' -- jws 4/18/86}
  ch:=chr(0);
  done:=false;
  while (strlen(gs)>0) and not done do begin
    ch:=gs[1];
    if (ch='[') or ((ch>='0') and (ch<='9')) then
      done:=true
    else
      strdelete(gs,1,1);
  end;

  {Now get the time, if we didn't find a '[' first}
  if (strlen(gs)>0) and (ch<>'[') then with clocktime do
    if readnumericfield(0,23,i) then
      begin
      changed := true;
      hour := i;
      if readnumericfield(0,59,i) then minute := i
                                  else minute := 0;
      if readnumericfield(0,59,i) then centisecond := i*100
                                  else centisecond := 0;
      setsystime(clocktime);
      end;

  {At this point we have either got the time or we're looking
   for a timezone by itself}
  tzchanged:=false;
  done:=false;
  negative:=false;
  while (strlen(gs)>0) and not done do
       if gs[1]<>'[' then strdelete(gs,1,1)
       else done:=true;
  if strlen(gs)>0 {got a '['} then begin
    done:=false;
    strdelete(gs,1,1); { Drop the '[' }
    while (strlen(gs)>0) and not done do begin { look for '-' or digit }
      ch:=gs[1];
      if ch='-' then begin
        negative:=true;
        strdelete(gs,1,1);
        done:=true;
      end
      else if (ch>='0') and (ch<='9') then done:=true
           else strdelete(gs,1,1);
    end;

    { Now we should be able to get the number fields for timezone}
    with tzrec do
      if readnumericfield(0,23,i) then begin
        tzchanged:=true;
        hour:=i;
        if readnumericfield(0,59,i) then minute:=i
                                    else minute:=0;
        if readnumericfield(0,59,i) then centisecond:=i*100
                                    else centisecond:=0;
        tzsecs:=hour*3600+minute*60+centisecond div 100;
        if negative then tzsecs:=-tzsecs;
      end;
  end;

  if tzchanged then begin
    settimezone(tzsecs);
    if changed then begin
      setsysdate(clockdate);
      setsystime(clocktime);
    end;
    sysdate(clockdate); {tz setting may have changed this!}
    systime(clocktime);
  end;

  if changed or tzchanged then
    with clockdatetime do
      begin
        date    := clockdate;
        time    := clocktime;
        call (unitable^[sysunit].dam, clockdatetime, sysunit, setvolumedate);
        identify;
      end;
end; {DATESET}

procedure disableuserisrs;
var i:integer;
begin
    call(cleariohook);
    interrupttable:=perminttable;
end;

function uppercase {(CH: CHAR): CHAR};
  begin
    if (ch>='a') and (ch<='z')
      then uppercase := chr(ord(ch)-32)
      else uppercase := ch
  end;

procedure streamdvr(fp: fibp; request: amrequesttype; anyvar buffer: window;
                                                  bufsize, position: integer);
type str    =  record s: string255 end;
     strptr = ^str;

var buf: charptr;
    c: char;
    i: shortint;

  procedure checkctrl(var c:char);
  var
    ceoln : boolean;
  begin { check for control chars in keystream files }
    if (c=chr(255)) and keystream then
    begin
      ceoln:=eoln(streamfib^);
      read(streamfib^,c);
      if ceoln then c:=chr(13);
      c:=chr(ord(c) mod 32);
    end;
  end;  { checkctrl }

  procedure closedown;
  begin
    if keystream then close(streamfib^) { if keystream keep the file }
                 else close(streamfib^, 'PURGE');
    with fp^ do
    begin
      am := serialtextamhook;
      call(am, fp, request, buf^, bufsize, position);
    end;
  end;

begin   {STREAMDVR}
  ioresult := ord(inoerror);
  buf := addr(buffer);
  if eof(streamfib^) then closedown
  else
  with fp^, unitable^[funit] do
   case request of
   readbytes: while bufsize > 0 do
     begin
     feoln := eoln(streamfib^);
     read(streamfib^, buf^); checkctrl(buf^);
     if uisinteractive then
       if feoln then call(tm, fp, writeeol,   buf^, 1, 0)
                else call(tm, fp, writebytes, buf^, 1, 0); {echo}
     bufsize := bufsize - 1;
     if bufsize > 0 then
       begin
       buf := addr(buf^ , 1);
       if eof(streamfib^) then begin
                                 closedown;
                                 bufsize := 0;
                               end;
       end;
     end;
   readtoeol: with strptr(buf)^ do
     begin
     setstrlen(s, bufsize);
     i := 0;
     while (i < bufsize) and not eoln(streamfib^) do
        begin i := i + 1; read(streamfib^, s[i]); checkctrl(s[i]); end;
     setstrlen(s, i);
     {note there is no need to echo, since readtoeol isn't used interactively}
     if i < bufsize then
      if eof(streamfib^) then
        begin
        buf := addr(s[i]);
        c := s[i];
        bufsize := bufsize - i;
        closedown;
        setstrlen(s, i+ord(s[i]));
        s[i] := c;                      {note that i cannot be 0!}
        end;
     end;
   unitstatus: fbusy := false;
   otherwise call(tm, fp, request, buffer, bufsize, position);
   end;
end;    {STREAMDVR}

procedure streamopen(sfile: string80; report:boolean);
const
  parindex = ['0'..'9','A'..'Z'];
type
  stringptr = ^string255;
var
  parptr: array['0' .. 'Z'] of stringptr;
  lastior,i: integer;
  heap: ipointer;
  f: text;
  v:vid;
  t:fid;
  segs:integer;
  fk:filekind;


function streamsyntax : boolean;
label
  1;
var
  c, uc : char;
  s, instr : string80;
  ciseoln, needc, notendofparms : boolean;

  procedure getc;
  begin
    ciseoln := eoln(f);
    read(f,c);
    if strlen(instr) = 80 then strdelete(instr,1,10);
    setstrlen(instr,strlen(instr)+1);
    instr[strlen(instr)] := c;
  end;

  procedure testioresult;
  begin
    if ioresult <> ord(inoerror) then
      begin
        lastior := ioresult;
        writeln('Can''t create ',sfile);
        printerror(-10,lastior);
        goto 1;
      end;
  end;

begin   {STREAMSYNTAX}
  mark(heap);
  for uc := '0' to 'Z' do parptr[uc] := nil;

  streamsyntax := false;
  notendofparms := true;

  if not keystream then  { if keystream then forget this whole operation }
  while not eof(f) do
  begin

    instr := '';
    s := '';
    getc;
    needc := false;

    if (c = '=') and notendofparms then       {parm line}
    begin
      getc;
      uc := uppercase(c);
      readln(f,s);
      if uc in parindex then
      begin
        writeln(output,s);
        newbytes(parptr[uc],sizeof(string255));
        readln(input,parptr[uc]^);
      end
      else
      begin
        writeln(output,instr,s);
        writeln(output,'':strlen(instr)-1
                          mod syscom^.crtinfo.width,'^');
        printerror(-24,0);
        goto 1;
      end;
    end
    else                                      {line to process}
    begin
      if notendofparms then
      begin
        notendofparms := false;
        rewrite(streamfib^,sfile,'exclusive');
        testioresult;
      end;

      repeat
        if needc then getc;

        if c = chr(255) then                {control char}
        begin
          getc;
          if ciseoln then c := chr(13);
          c := chr(ord(c) mod 32);
          write(streamfib^,c);
        end
        else if c = '@' then                {macro expansion}
        begin
          getc;
          if ciseoln then
          begin                         {error: no char after @}
            writeln(output,instr);
            writeln(output,'':strlen(instr)-1
                              mod syscom^.crtinfo.width,'^');
            printerror(-25,0);
            goto 1;
          end;
          uc := uppercase(c);
          if uc in parindex then
            if parptr[uc] <> nil then write(streamfib^,parptr[uc]^)
            else
            begin
              if not ciseoln then readln(f,s);
              writeln(output,instr,s);
              writeln(output,'':(strlen(instr)-1)
                                 mod syscom^.crtinfo.width,'^');
              printerror(-25,0);
              goto 1;
            end
          else            {write char as is}
            write(streamfib^,c);
        end
        else if ciseoln then                {char is eoln}
        begin
          if not eof(f) then writeln(streamfib^);
        end

        else                                {normal char}
          write(streamfib^,c);

        testioresult;
        needc := true;

      until ciseoln or eof(f);

    end; {line to process}

  end; {while not eof(f)}

  testioresult;
  streamsyntax := true;

  1: release(heap);
end;    {STREAMSYNTAX}


begin {STREAMOPEN}
  reset (f,sfile,'shared');                            {OPEN THE STREAM FILE}
  if ioresult = ord (inoerror) then                    {SUCCESSFUL OPEN}
  begin                                       {OPEN THE SYSTEM STREAM FILE}
    if scantitle(sfile,v,t,segs,fk) then keystream:=segs<>0
                                    else keystream:=false;
    if not keystream then sfile := '*STREAM';
    if streamsyntax then             {SYNTAX AND WRITE TO SYSTEM FILE}
    begin                            {AVOID HOGGING THE DISK}
      if not keystream then close(streamfib^, 'CRUNCH');
      reset(streamfib^, sfile, 'shared');
      fibp(gfiles[0])^.am := streamdvr;       {INPUT   }
      fibp(gfiles[2])^.am := streamdvr;       {KEYBOARD}
    end
    else close (streamfib^, 'PURGE');        {REMOVE SYSTEM STREAM FILE}
    close (f);
  end
  else if report then writeln(output,'Can''t open file ',sfile);
end; {STREAMOPEN}

procedure homecursor;  begin write(homechar); end;

procedure clearscreen; begin write(clearscr); versionup := false; end;

procedure clearline;   begin write(cteol   ); end;

procedure prompt (*PL: STRING80*);
  begin  homecursor; clearline; write(output,pl)  end;

procedure zaptypeahead;
var x: integer;
begin call (fibp(gfiles[2])^.am, fibp(gfiles[2]), clearunit, x, 0, 0);
      reset(input); reset(gfiles[2]^ {KEYBOARD});
end;

function getchar(flushit: boolean): char;
var ch: char;
begin
  if flushit then zaptypeahead;
  read(input,ch);
  getchar := uppercase (ch);
end (*GETCHAR*) ;

procedure initfnames;

const sf = sysfilenames
               [ 'ASSEMBLER','COMPILER','EDITOR','FILER','LIBRARIAN','LIBRARY'];
      sysvolname = sysfilevols
              [ 'ASM','CMP','ACCESS','ACCESS','ACCESS','SYSVOL']; { js 8/5/83 }

var   f: sysfiles;
      find:  set of sysfiles;
      lunit: unitnum;

  procedure findem(var volume: vid);
  var f: sysfiles;
      l: file of integer;
      ltitle: string80;
  begin
    for f := assembler to library do
     if f in find then
      begin
        ltitle := volume+':'+sf[f];
        reset(l, ltitle,'shared');
        if ioresult = ord(inoerror) then
          begin
          filename[f] := ltitle;
          find := find - [f];
          close(l);
          end;
      end;
  end;  {findem}

begin   { initfnames }
  find := [assembler..library];
  findem(syvid);
  lunit := 1;
  while (lunit <= maxunit) and (find <> []) do with unitable^[lunit] do
  begin
    call (dam, uvid, lunit, getvolumename);
    if uisblkd and (uvid <> '') and (uvid <> syvid) then findem(uvid);
    lunit := lunit+1
  end;
  for f := assembler to library do
    if f in find then filename[f] := sysvolname[f]+':'+sf[f];
  syslibrary := filename[library];
end (*INITFNAMES*) ;

  procedure initworkfile;
  var ltitle: string80;
      workfile: file of integer;
  begin
    with userinfo^ do
      begin                                       (*INITIALIZE WORK FILES*)
        errnum := 0; errblk := 0; errsym := 0;
        symfid := ''; codefid := ''; workfid := ''; errfid := '';

        ltitle := '*WORK.TEXT';
        reset(workfile,ltitle,'shared');
        gotsym := ioresult = ord(inoerror);
        if gotsym then symfid := ltitle;
        close(workfile);

        ltitle := '*WORK.CODE';
        reset(workfile,ltitle,'shared');
        gotcode := ioresult = ord(inoerror);
        if gotcode then codefid := ltitle;
        close(workfile);
      end;
  end (*INITWORKFILE*) ;

procedure updatesysunit;
begin
  initdate;
  initfnames;
  initworkfile;
end;

procedure whatfiles;

var e: string[12];
    f: sysfiles;
    update: boolean; c: char;
    i: integer;

  procedure edit(f: sysfiles);
  var s: fid;
  begin
  fgotoxy(output, 12, 3+ord(f)); write(cteol); readln(s);
  fixname(s, codefile);
  if s <> '' then filename[f] := s;
  fgotoxy(output, 12, 3+ord(f)); write(filename[f], cteol);
  end;

  procedure volname(sysvol: boolean);
  var i: integer;
      s: fid;
  begin
  fgotoxy(output, 19, 11-ord(sysvol)); write(cteol); readln(s);
  zapspaces(s);
  if s<>'' then
    begin
    if sysvol then doprefix(s, syvid, sysunit, true)
              else doprefix(s, dkvid, i,       false);
    if ioresult<>ord(inoerror) then
      begin
      getioerrmsg(s,ioresult); fgotoxy(output, 0, 13);
      writeln(bellchar, s, cteol);
      end
    else if sysvol then begin updatesysunit; update := true; end;
    end;
  fgotoxy(output, 19, 11-ord(sysvol));
  if sysvol then write(syvid) else write(dkvid);
  write(':',cteol);
  end;

begin   { whatfiles}
 filename[library] := syslibrary; update := true;
 repeat
   if update then
     begin
     page;
     writeln; writeln; writeln;
     for f := assembler to library do
         begin
         e := '';
         strwrite(e, 1, i, f);
         writeln(e, '':12-strlen(e), filename[f]);
         end;
     writeln;
     writeln('* System  volume:  ', syvid,':');
     writeln(': Default volume:  ', dkvid,':');
     update := false;
     end;
   writeln(homechar,
               'Assembler  Compiler  Editor  Filer  Librarian' , cteol);
   write  (    'liBrary  System volume  Default volume   Quit ', cteol);
   c := getchar(false);
   fgotoxy(output, 0, 13); write(cteol);
   case c of
     'A':  edit(assembler);
     'B':  edit(library);
     'C':  edit(compiler);
     'D':  volname(false);      {prefix;}
     'E':  edit(editor);
     'F':  edit(filer);
     'L':  edit(librarian);
     'S':  volname(true);       {sysvol;}
     'Q':  ;
     otherwise write(bellchar);
   end;
 until c = 'Q';
 syslibrary := filename[library];
end;    { whatfiles }

procedure ramdriver(fp: fibp; request: amrequesttype; anyvar buffer: window;
                                                   length, position: integer);
begin
with fp^, unitable^[funit] do
 case request of
   flush:       ;
   writebytes: if length > 0 then
     fastmove(addr(buffer), ipointer(byteoffset + position + fileid), length);
   readbytes:  if length > 0 then
     fastmove(ipointer(byteoffset + position + fileid), addr(buffer), length);
   otherwise ioresult := ord(ibadrequest);
   end;
end;    { ramdriver }

function getvalue(low,high: integer; var value: integer;
                                              numsign, opt: boolean): boolean;
var s: string80;
    i: integer;
begin
  readln(s);
  if (strlen(s)=0) and opt then s := '0';
  strread(s,1,i,value);
  if ioresult<>ord(inoerror) then
   if i <= strlen(s) then
    if (s[i]='#') and numsign then
      begin
      strread(s,i+1,i,value);
      if ioresult<>0 then writeln(#7'integer required')
      end
    else writeln(#7'integer required');
  if ioresult=ord(inoerror) then
    if (value<low) or (value>high) then
      begin
      writeln(#7'value must be between ',
       low:1, ' and ', high:1);
      ioresult := ord(ibadformat);
      end;
  getvalue := ioresult=0;
end;    { getvalue }

procedure makeramvol;

const zero = direntry[
        dfirstblk: 0,           dlastblk: 6,
        dfkind: untypedfile,
        dvid:   'RAM',          deovblk: 6,
        dnumfiles: 0,           dloadtime: 0,
        dlastboot:  daterec    [year: 0,
        day: 0,                 month: 0]];


var  volsize:   integer;
     untnumb:   integer;
     entries:   integer;
     membytes:  integer;
     trick: record case integer of
        2: (ip: ipointer);
        3: (i:  integer);
        end;
     f: fib;
     cat: catentry;

begin   { makeramvol }
 writeln('*** CREATING A MEMORY VOLUME ***');
 writeln;
 write('What unit number?  ');
 if getvalue(7,maxunit,untnumb,true,false) then
   begin
   write('How many 512 byte BLOCKS?  ');
   if getvalue(1,maxint,volsize,false,false) then
    begin
    write('How many entries in directory?  ');
    if getvalue(0,maxint,entries,false,true) then
      begin
      releaseuser;
      membytes := blocksize*volsize;
      if integer(eheap)+membytes > userstack then escape(-2);
      newbytes(trick.ip, membytes);
      unitable^[untnumb] := unitable^[0];  {handles most fields correctly}
      with unitable^[untnumb] do  {fill in the rest}
        begin
          tm := ramdriver;
          byteoffset := trick.i;
          uvid := 'RAM';
          offline := false;
          umaxbytes := volsize*fblksize;

          with f, cat do
            begin
            fvid := ''; funit := untnumb; ftitle := '';
            fwindow := addr(cat);
            cname := 'RAM';
            cextra1 := entries;
            cpsize := umaxbytes;
            call (dam,  f, untnumb, makedirectory);
            end;
        end;

      if ioresult = ord(inoerror) then
        begin
        markuser;
        writeln;
        writeln('#',untnumb:1, ':  (RAM:)  zeroed');
        end
      else printerror(-10, ioresult);
      end
    end;
   end
end;    { makeramvol }

procedure newsysunit;
var newunit,i: integer;
    name: fid;
begin
  write('What new system unit number?  ');
  if getvalue(1, maxunit, newunit, true, false) then
    begin
    name := '#'; strwrite(name, 2, i, newunit:1, ':');
    doprefix(name, syvid, sysunit, true);
    if ioresult <> ord(inoerror) then printerror(-10,ioresult)
    else updatesysunit;
    end;
end;    { newsysunit }

procedure osinit;
var  iu: 1..maxunit;
     esccode: integer;
begin (*OSINIT*)
  esccode := sysescapecode;
  locklevel := 0; actionspending := 0;
  zaptypeahead;
  if keystream then close(streamfib^)
               else close(streamfib^,'PURGE') ;
  for iu := 1 to maxunit do  (* force directory cleanups on all vols *)
    unitable^[iu].umediavalid := false;
  sysescapecode := esccode;
end (*OSINIT*) ;

procedure go_prog (debugging: boolean);
var  stopgoing: boolean;
     lastioresult:integer;
     esccode:shortint;
     userheap: anyptr;
     modptr: moddescptr;
     done:   boolean;
begin {GO_PROG}
  repeat
    clearscreen;
    writeln(output);
    modptr := entrypoint;
    repeat
      done := modptr^.lastmodule;
      if modptr^.startaddr<>0 then
        begin
        call(debugger,1,entrypoint^.startaddr,ord(debugging));
        mark(userheap);
        userprogram(modptr^.startaddr,userstack); (*** ALL PROGRAMS ARE ENTERED HERE ****)
        esccode := escapecode; lastioresult:=ioresult;
        release(userheap);
        call(debugger,2,0,0);
        stopgoing := true;
        openfiles;
        if esccode <> 0 then
          begin
            done := true;
            disableuserisrs;
            osinit;                            {shuts off stream files}
            if (esccode <> -1) and (esccode<>-20) then
              begin
              printerror(esccode,lastioresult);
              prompt('Restart with debugger ? ');
              stopgoing := getchar(false) <> 'Y';
              end;
            debugging := not stopgoing;
          end;
        end;
      modptr := modptr^.link;
    until done;
  until stopgoing;
end;  {GO_PROG}

procedure loadandgo (var filetogo:fid; permanent, debugging: boolean);
label 1;
var vol: vid; name: fid;  segs: integer; kind: filekind;
    modp: moddescptr; upcname: tid;
begin
  if not permanent then
   if scantitle(filetogo,vol,name,segs,kind) then
    begin
    if strlen(name)<=tidleng then upcname := name else upcname := '';
    upc(upcname);
    modp := sysdefs;
    while modp <> nil do with modp^ do
      begin
      if startaddr<>0 then
       if (name = progname) or (ucase and (upcname = progname)) then
        begin
        if entrypoint<>modp then releaseuser;
        entrypoint := modp;
        go_prog(debugging);
        goto 1;
        end;
      modp := link;
      end;
    end;
  load(filetogo, permanent);
  if permanent then markuser
  else if entrypoint <> nil then go_prog(debugging);
1: end;  {LOADANDGO}

procedure initheap;
var   marker: anyptr;
begin                                          (*BASIC FILE AND HEAP SETTUP*)
  new(userinfo);
  new(streamfib);
  mark(marker);
  if integer(marker) > userstack then escape(-2);
  markuser;
end (*INITHEAP*) ;

procedure initunits;
var
  lunit: unitnum;
  f: fib;
begin
 f.fileid := 0;
 for lunit := 1 to maxunit do
   with unitable^[lunit] do
     begin
     offline := false;
     umediavalid := false;
     f.funit := lunit;
     call (tm, addr(f), clearunit, f, 0, 0);
     offline := uisblkd and (ioresult<>0);
     end;
end; (*INITUNITS*)


{For use only by initial call to check_to_do, before AUTOSTART streaming. SFB/JWH}

procedure mini_closedown_to_do;
const outindex=1;
begin
  fibp(gfiles[outindex])^.am:=old_out_am;
  call(maskopshook,kbdmask,0);    {reenable keyboard}
end;

{Substitute AM for INPUT and KEYBOARD that supplies data from to_do_data. For
 Philips. Modeled on streamdvr (somewhat). Installed by check_to_do. Uninstalled
 by closedown_to_do (in this procedure). SFB/JWH}
 
procedure to_do_dvr(fp: fibp; request: amrequesttype; anyvar buffer: window;
                                                  bufsize, position: integer);
const
   outindex = 1;

type str    =  record s: string255 end;
     strptr = ^str;

var buf: charptr;
    c: char;
    i: shortint;

  procedure closedown_to_do;
  begin
    with fp^ do
      begin
        am:=serialtextamhook;
        fibp(gfiles[outindex])^.am:=old_out_am;
        call(maskopshook,kbdmask,0);    {reenable keyboard}
        call(am, fp, request, buf^, bufsize, position);
      end;
  end;
  
  procedure delete_char;        {go to next character in input stream}
    begin
      setstrlen(to_do_data, strlen(to_do_data)-1);
      moveleft(to_do_data[2], to_do_data[1], strlen(to_do_data));
    end;
    
{Based on streamdvr. All references to streamfib are replaced by emulations
 which work on to_do_data}

begin
  ioresult:=0;
  buf:=addr(buffer);
  if strlen(to_do_data) = 0 then closedown_to_do
  else
  with fp^, unitable^[funit] do
    case request of
      readbytes : while bufsize>0 do
        begin
          feoln:=to_do_data[1]=chr(cr);
          buf^:=to_do_data[1];
          delete_char;
          if buf^=chr(cr) then buf^:=' ';
          if uisinteractive then
            if feoln then call(tm, fp, writeeol,    buf^, 1, 0)
                     else call(tm, fp, writebytes,  buf^, 1, 0);
          bufsize:=bufsize-1;
          if bufsize>0 then
            begin
              buf:=addr(buf,1);
              if strlen(to_do_data)=0 then 
                begin
                  closedown_to_do;
                  bufsize:=0;
                end;
            end;
        end;
      readtoeol: with strptr(buf)^ do
        begin
          setstrlen(s,bufsize);
          i:=0;
          while (i<bufsize) and (to_do_data[1]<>chr(cr)) do
            begin
              i:=i+1;
              s[i]:=to_do_data[1];
              delete_char;
              if strlen(to_do_data)=0 then
                to_do_data:=chr(cr);
            end;
          setstrlen(s,i);
          {note there is no need to echo, since readtoeol is not called interactively}
          if i<bufsize then
            if strlen(to_do_data) = 0  then
              begin
                buf:=addr(s[i]);
                c:=s[i];
                bufsize:=bufsize-i;
                closedown_to_do;
                setstrlen(s, i+ord(s[i]));
                s[i]:=c;
              end;
        end;
      unitstatus: fbusy:=false;
      otherwise call(tm, fp, request, buffer, bufsize, position);
    end;        {case}
end;    {to_do_dvr}

{Redirects OUTPUT to "/dev/null" Installed by check_to_do. Uninstalled by closedown_to_do
 in to_do_dvr. SFB/JWH}
 
procedure null_dvr(fp: fibp; request: amrequesttype; anyvar buffer: window;
                                                  bufsize, position: integer);
begin
end;

procedure check_to_do;  {dummy hook would leave to_do_data empty. Real hook should
                         put a filename and any input needed into to_do_data, and choose 
                         a value for no_output. 
                         We keep asking to_do_hook for stuff to do until it decides
                         there is nothing left to do, by leaving the string empty
                         SFB/JWH}
label 1;

const inindex=0;        {gfiles indices for output and input}
      outindex=1;
      kbdindex=2;

var no_output: boolean;
    title: fid;
    I:INTEGER;

begin
  old_out_am:=fibp(gfiles[outindex])^.am;
  repeat
    no_output:=false;
    setstrlen(to_do_data,0);
    call(to_do_hook, to_do_data, no_output);
    if strlen(to_do_data)=0 then goto 1;     {if hook didn't have anything for us to do}
    {else}
    clearscreen;
    fibp(gfiles[inindex])^.am:=to_do_dvr; {redirect all input to to_do_dvr}
    fibp(gfiles[kbdindex])^.am:=to_do_dvr;
    if no_output then                   {and send output to "/dev/null" iff hook requested it}
      fibp(gfiles[outindex])^.am:=null_dvr;
    call(maskopshook,0,kbdmask);        {disable keyboard}
    
    prompt('Automatically executing file ');
    readln(input,title);        {fake an "execute" (in "command") to start things happening}
    fixname(title, codefile);
    if strlen(title) > 0 then
      begin
        if strlen(title) > (sizeof(fid)-6)
        then setstrlen(title, sizeof(fid)-6);
        try
          loadandgo(title,false,false);
        recover
          if escapecode<>0 then
            to_do_data:='';       {force next input request to disconnect us}
      end;
  until false or (entrypoint=NIL);
  clearscreen;
  writeln;
  writeln('Could not automatically load and run ',title);
1:end;

procedure command;
type  prompttype=string[79];
const
      prompt1=prompttype
['Command: Cmplr Edit File Init Libr Run Xcut Ver ?'];
      prompt2=prompttype
['Command: Asm Dbg Memv New Perm Stream User What ?'];

      lprompt1=prompttype
['Command: Compiler Editor Filer Initialize Librarian Run eXecute Version ?'];
      lprompt2=prompttype
['Command: Assembler Debugger Memvol Newsysvol Permanent Stream User What ?'];

var   skipping: boolean;
      i : integer;
      pl : ^prompttype;
      plfirst : boolean;

  procedure execute(permanent: boolean; debugging: boolean);
  var  title: fid;
  begin
    if permanent then
         prompt('Load what code file? ')
    else if debugging then
         prompt('Debug what file? ')
    else prompt('Execute what file? ');
    readln(input,title);
    fixname(title, codefile);
    if strlen(title) > 0 then
      begin
      if strlen(title) > (sizeof(fid)-6)
      then setstrlen(title, sizeof(fid)-6);
      loadandgo(title,permanent,debugging);
      end;
  end (*EXECUTE*) ;

  procedure compileandedit;
  begin {COMPILEANDEDIT}
    with userinfo^ do
      begin
        errnum := 0; errblk := 0;
        loadandgo(filename[compiler],false,false);
        if entrypoint <> nil then if errnum <> 0 then
          loadandgo(filename[editor],false,false);
      end;
  end;  {COMPILEANDEDIT}

  procedure runworkfile (debugging:boolean);
  var title: fid;
  begin with userinfo^ do
   if not (gotsym or gotcode) then execute(false,debugging)
   else
     begin
     if not gotcode then compileandedit;
     if gotcode then
       begin
       title:=codefid;
       loadandgo(title,false,debugging);
       end;
     end;
  end (*RUNWORKFILE*) ;

  procedure stream;
  var
    sfile: string80;  i: integer;  done: boolean;
  begin
    if chaining = streamchain then
      begin
      chaining := nochain;
      sfile := chainfile;
      end
    else
      begin
      prompt('Stream what file ? ');
      readln(input,sfile);
      end;
    if strlen(sfile) <= 70 then             {too long of name can crash system}
      fixname(sfile,textfile)               { since SFILE is of type STRING80 }
    else
      begin
        sfile := '';
        writeln(output,'Stream file name too long');
      end;
    if strlen (sfile) > 0 then                  {GOT VALID NAME}
      begin
        if keystream then close(streamfib^)
                     else close(streamfib^, 'PURGE');
        streamopen(sfile,true);                 {TRY TO OPEN THE STREAM FILE}
      end;                                      {EXIT IF NO NAME GIVEN}
  end; (*STREAM*)

begin {COMMAND}
  skipping := false;
  plfirst:=true;
  ci_cmd:=' ';
  call(cmdcharhook^);
  repeat
   
   check_to_do;         {Philips hack. see if there's anything the to_do_hook wants to do SFB/JWH}
   
   if chaining=progchain then
     begin
     chaining := nochain;
     loadandgo(chainfile,false,false);
     end
   else if chaining=streamchain then stream
   else
     begin
      if skipping then
        begin
          while streaming and skipping do
            begin
              if eoln(input) then
                begin
                get(input);
                if streaming then skipping := input^ = '*';
                end
              else get(input);
            end;
          for i := 1 to 80000 do {nothing};
          skipping := false;
        end;

      if syscom^.crtinfo.width>=80 then
        if plfirst then pl:=addr(lprompt1) else pl:=addr(lprompt2)
      else
        if plfirst then pl:=addr(prompt1) else pl:=addr(prompt2);

      if ci_cmd<>chr(0) then prompt(pl^);

      ci_idle:=true;
      disptime;
      if chaining=nochain then
        begin
          ci_cmd := getchar(false); call(cmdcharhook^);
          if ci_cmd<>chr(0) then
          begin clearscreen; writeln(output); end;
        end;

      if ci_cmd = chr(3) then ci_cmd := 'X';

      setrunlight(ci_cmd);{set the run light to indicate command}

      if not ((ci_cmd=' ') or (ci_cmd=chr(0))) then
       case ci_cmd of
  '?':  plfirst := not plfirst;
  'A':  loadandgo(filename[assembler],false,false);
  'C':  compileandedit;
  'D':  runworkfile(true);
  'E':  begin
          userinfo^.errnum := 0;
          userinfo^.errblk := 0;
          loadandgo(filename[editor],false,false);
        end;
  'F':  loadandgo(filename[filer],false,false);

  'I':  begin
          lockup;
          releaseuser;
          lockfiles;
          initunits;
          openfiles;
          if h_unitable <> nil then
            call(h_unitable^.inval_cache_proc, -1);
          lockdown;
        end;
  'L':  loadandgo(filename[librarian],false,false);
  'M':  makeramvol;
  'N':  newsysunit;
  'P':  execute(true,false);
  'R':  runworkfile(false);
  'S':  stream;
  'U':  if entrypoint <> nil then go_prog(false)
        else execute(false, false);
  'V':  dateset;
  'W':  whatfiles;
  'X':  execute(false,false);
       otherwise
        if streaming then
          if ci_cmd = '*' then
            begin
              skipping := true;
              write(output,'*');
            end
          else
            begin
            osinit;
            if (ci_cmd > ' ') and (ord(ci_cmd)<127) then
              write(output,'"',ci_cmd,'"')
            else
              write(output,'Character #',ord(ci_cmd));
            write(output,' is not a command.');
            end;

       end; {CASES}
     end;
  until false;
end;  {COMMAND}


procedure systemstartup;
var done: boolean;
begin
initheap;                 (* point of final allocation of heap space *)
repeat
try
 call(debugger,2,0,0);  { log in with debugger }
 chaining := nochain;
 versionup := false;
 ci_idle:=false;
 if cmdcharhook=nil then begin
   new(cmdcharhook); markuser;
   cmdcharhook^ := dummycmdchar;
 end;
 
 to_do_hook:=dummy_to_do;
 
 install_HFSCK_to_do;  {Philips hack. Should be moved to to_do_ program when this is
                        properly modularized. SFB/JWH}
 
 check_to_do;         {Philips hack. see if there's anything the ci_todohook wants to do
                       before streaming AUTOSTART/AUTOKEYS. SFB/JWH}
 
 mini_closedown_to_do;  {Philips hack. Make sure that keyboard is reenabled, and output
                         reconnected. Needed because to_do_dvr doesn't get a chance here
                         to disconnect before streamopen('AUTOSTART.... Harmless even if 
                         to_do_hook never requested execution.
                         Not needed inside "command", as next input request for menu key
                         always triggers closedown before streamstart. SFB/JWH}
 
 
 initworkfile;
 initfnames;
 streamopen('*AUTOSTART',false);  {open autostart stream file before dateset}
 if ioresult<>ord(inoerror) then streamopen('*AUTOKEYS[*]',false);
 initdate;
 dateset;

 repeat
    try
      command
    recover
      repeat
        try
          tioresult:=ioresult;                    {save it}
          call(debugger,2,0,0);
          osinit;                                 {shut off stream files}
          if escapecode <> -1 then
            begin
            disableuserisrs;
            clearscreen;  writeln(output);
            printerror(escapecode,tioresult);
            writeln(output,'Trapped by outer level of OS.');
            end;
          done := true;
        recover done := false;
      until done;
 until false;
recover printerror(escapecode, ioresult);
until false;
end; (*systemstartup*)

end (*MODULE CI*);

import ci,asm;

begin
  ci_switch;
  systemstartup;
end. (*COMMAND INTERPRETER*)
 
 
