(*

 (c) Copyright Hewlett-Packard Company, 1982,1991.
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$
$search 'INITLOAD', 'ASM', 'INIT', 'SYSDEVS'$
$ALLOW_PACKED ON $     { JWS 4/10/85}

program cmd(input,output,keyboard);

module ci;

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','???',
		       '???','???' ];

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,'  Workstation            ',fsidc);
    writeln(output {internal, pre release version
		  ,'***PRERELEASE VERSION. FOR INTERNAL USE ONLY***'});
    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; } { JWH 10/22/91 }
    writeln(output,'Copyright Hewlett-Packard Company 1982,1991');
    writeln(output,'Copyright AT&T 1980,1984');
    writeln(output,'Copyright Regents Univ. of Calif. 1979,1980,1983');
    writeln(output,'Copyright Motorola, Inc. 1990');
    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'); }
    { Rights Legend updated 10/22/91 JWH }
writeln(output,'Use, duplication, or disclosure by the U.S.');
writeln(output,'Government is subject to restrictions in');
writeln(output,'sub-paragraph (c)(1)(ii) of DFARS 252.227-7013.');
writeln(output,'Hewlett-Packard Co., Palo Alto, CA 94304 U.S.A.');
writeln(output,'Rights for non-DOD U.S. Government Departments');
writeln(output,'and Agencies are as in FAR 52.227-19(c)(1,2).');

    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*)


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
   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;
 initworkfile;
 initfnames;
 streamopen('*AUTOSTART',false);  {open autostart stream file before dateset}
 if ioresult<>ord(inoerror) then streamopen('*AUTOKEYS[*]',false);
 initdate;
 dateset;
 arm_copyback; { 68040 support JWH 2/17/91 }

 repeat
    try
      command
    recover
      repeat
	try
	  copy_off; { 68040 support JWH 2/11/91 }
	  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*)

