head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.18.11;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.11.59.22;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.55.22;  author jwh;  state Exp;
branches ;
next     55.2;

55.2
date     91.11.04.13.59.12;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.30.53;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.10.37.05;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.21.09.41.10;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.32.30;  author jwh;  state Exp;
branches ;
next     53.2;

53.2
date     91.03.15.15.26.28;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.32.22;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.17.17;  author jwh;  state Exp;
branches ;
next     51.3;

51.3
date     91.02.18.20.44.27;  author jwh;  state Exp;
branches ;
next     51.2;

51.2
date     91.02.10.15.45.37;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.16.51;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.31.02;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.14.47;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.21.12;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.11.06.00;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.52.56;  author jwh;  state Exp;
branches ;
next     45.2;

45.2
date     90.05.02.14.40.21;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.16.00.54;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.18.05;  author jwh;  state Exp;
branches ;
next     43.2;

43.2
date     90.03.22.10.56.05;  author dew;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.10.35;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.55.00;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.37.13;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.58.15;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.43.01;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.35.03;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.48.47;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.26.25;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.41.57;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.17.10;  author jwh;  state Exp;
branches ;
next     33.2;

33.2
date     89.01.19.14.47.49;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.48.36;  author dew;  state Exp;
branches ;
next     32.2;

32.2
date     89.01.11.09.39.23;  author jws;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.57.52;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.18.44;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.55.46;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.40.23;  author bayes;  state Exp;
branches ;
next     28.2;

28.2
date     88.10.27.10.00.23;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.06.39;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.49.23;  author bayes;  state Exp;
branches ;
next     26.4;

26.4
date     88.09.28.13.37.52;  author bayes;  state Exp;
branches ;
next     26.3;

26.3
date     88.09.28.13.37.36;  author bayes;  state Exp;
branches ;
next     26.2;

26.2
date     88.09.28.13.37.19;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.37.03;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.10.14.00;  author jws;  state Exp;
branches ;
next     23.3;

23.3
date     87.08.30.16.18.54;  author jws;  state Exp;
branches ;
next     23.2;

23.2
date     87.08.28.13.08.28;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.58.55;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.38.58;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.14.22.55;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.34.41;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.48.49;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.54.13;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.58.08;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.16.08.32;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.48.47;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.15.57.51;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.51.54;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.45.15;  author jws;  state Exp;
branches ;
next     11.2;

11.2
date     87.01.27.09.49.09;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.11.30;  author jws;  state Exp;
branches ;
next     10.4;

10.4
date     87.01.18.20.03.43;  author jws;  state Exp;
branches ;
next     10.3;

10.3
date     87.01.17.12.31.45;  author jws;  state Exp;
branches ;
next     10.2;

10.2
date     87.01.17.12.29.59;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.11.26.30;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.15.09.50;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.12.19.55;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.14.30.48;  author hal;  state Exp;
branches ;
next     6.2;

6.2
date     86.11.05.16.32.45;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.25.21;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.17.14.31;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.10.13.15.40.01;  author geli;  state Exp;
branches ;
next     3.1;

3.1
date     86.10.13.15.38.30;  author geli;  state Exp;
branches ;
next     2.1;

2.1
date     86.10.13.15.36.39;  author geli;  state Exp;
branches ;
next     1.2;

1.2
date     86.10.13.15.34.15;  author geli;  state Exp;
branches ;
next     1.1;

1.1
date     86.10.13.15.32.06;  author geli;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@(*

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

@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 1325
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1325
(*

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

@


55.2
log
@
pws2rcs automatic delta on Mon Nov  4 13:45:04 MST 1991
@
text
@@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@d226 1
a226 1
    writeln;
d230 1
d232 1
a232 1
    writeln(output,'Use, duplication or disclosure by the U.S.');
d237 8
a244 1
    writeln(output,'3000 Hanover Street, Palo Alto, CA 94304');
@


54.3
log
@
pws2rcs automatic delta on Wed Aug 21 10:27:27 MDT 1991
@
text
@@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 1317
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 1317
(*

 (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;
    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,'       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*)


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

@


53.2
log
@Updated copyright message.
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@d3 1
a3 1
 (c) Copyright Hewlett-Packard Company, 1982,1990.
d227 1
a227 1
    writeln(output,'Copyright Hewlett-Packard Company 1982,1990');
@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.3
log
@
pws2rcs automatic delta on Mon Feb 18 20:38:36 MST 1991
@
text
@@


51.2
log
@Added a call to ASM_COPY_OFF in the O/S recover block. JWH 2/11/91.
@
text
@d1282 1
@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@d1289 1
@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.2
log
@Removed pre-release message as this is our final turn.
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@d219 2
a220 2
    writeln(output {internal, pre release version{}
		  ,'***PRERELEASE VERSION. FOR INTERNAL USE ONLY***'{});
@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.2
log
@Added prerelease version info for QA bits.
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@d3 1
a3 1
 (c) Copyright Hewlett-Packard Company, 1982,1989.
d219 2
a220 1
    writeln(output);
d227 1
a227 1
    writeln(output,'Copyright Hewlett-Packard Company 1982,1989');
@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.2
log
@Removed the INTERNAL USE ONLY MESSAGE as we anticipate
this will be the last turn.
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@d219 1
a219 1
    writeln(output,'***PRERELEASE VERSION. FOR INTERNAL USE ONLY***');
@


32.2
log
@Fixed copyright dates.
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@d3 1
a3 1
 (c) Copyright Hewlett-Packard Company, 1982,1988.
d226 1
a226 1
    writeln(output,'Copyright Hewlett-Packard Company 1982,1988');
@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.2
log
@Added 1988 Copyright dates and PRELEASE... notice.
Scott
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@d3 1
a3 1
 (c) Copyright Hewlett-Packard Company, 1982,1987.
d219 1
a219 1
    writeln;
d226 1
a226 1
    writeln(output,'Copyright Hewlett-Packard Company 1982,1987');
@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.4
log
@
Comment from auto synch of clock fix:
date: 88/03/15 13:58:41;  author: jws;  state: Exp;  lines added/del: 3/3
Fixed copyright notice.
@
text
@@


26.3
log
@
Comment from auto synch of clock fix:
date: 88/03/02 17:14:34;  author: quist;  state: Exp;  lines added/del: 6/3
SYSDATE fixes. RDQ
@
text
@d226 3
a228 3
    writeln(output,'Copyright Hewlett-Packard Company 1982,1983,');
    writeln(output,'1984,1985,1987.  Copyright AT&T 1980,1984.');
    writeln(output,'Copyright University of California 1979,1980,1983');
@


26.2
log
@
Comment from auto synch of clock fix:
date: 88/03/02 09:43:35;  author: bayes;  state: Exp;  lines added/del: 0/0
Automatic bump of revision number for PWS version 3.2Y
@
text
@d137 2
a138 1
	   writeln(day:2,'-',months[month],'-',year:2);
d159 2
a160 1
      if ((year=0) and (month=3) and (day=1)) or
d299 2
a300 1
      if readnumericfield(0,99,i) then year := i;
@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.3
log
@Pws2unix automatic delta on Sun Aug 30 14:43:47 MDT 1987
@
text
@@


23.2
log
@Slight revisions of copyright messages.
@
text
@d3 1
a3 1
 (c) Copyright Hewlett-Packard Company, 1986.
d224 2
a225 2
    writeln(output,'Copyright Hewlett-Packard 1982,1983,1984,1985,1987');
    writeln(output,'Copyright AT&T 1980,1984');
@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@d225 2
a226 2
    writeln(output,'Copyright A.T.& T. 1980,1984');
    writeln(output,'Copyright Univ. of California 1979,1980,1983');
d232 1
a232 1
    writeln(output,'52.227-7013. Hewlett-Packard Company,');
@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.2
log
@Correction of copyright dates.
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@d224 2
a225 2
    writeln(output,'Copyright Hewlett-Packard 1983,1984,1985,1986,1987');
    writeln(output,'Copyright  A.T.& T. 1980,1984');
@


10.4
log
@Pws2unix automatic delta on Sun Jan 18 18:33:43 MST 1987
@
text
@@


10.3
log
@Fixed search directive before 3.2D turn.
@
text
@d229 1
a229 1
    writeln(output,'Govenment is subject to restrictions as set');
d232 2
a233 2
    writeln(output,'52.227-7013. Hewlett-Packard Company, 3000');
    writeln(output,'Hanover Street, Palo Alto, California 94304');
@


10.2
log
@Fix for startup date handling, ugly new copyright notices
@
text
@d26 1
a26 1
{$search 'INITLOAD', 'ASM', 'INIT', 'SYSDEVS'$}
@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@d26 1
a26 1
$search 'INITLOAD', 'ASM', 'INIT', 'SYSDEVS'$
d158 2
a159 1
      if (year=0) and (month=3) and (day=1) then
a220 1
    writeln;
d224 10
a233 14
    writeln;

    writeln('Copyright 1986 Hewlett-Packard Company.');

    writeln('***************************************');
    writeln('  PRELIMINARY SOFTWARE -- DO NOT COPY  ');
    writeln('  OR DISTRIBUTE WITHOUT PERMISSION     ');
    writeln('***************************************');

    {writeln('All rights are reserved.  Copying or other');
    writeln('reproduction of this program except for archival');
    writeln('purposes is prohibited without the prior');
    writeln('written consent of Hewlett-Packard Company.'); }

@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.2
log
@Invalidate cache when user presses 'I'.
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@d1224 2
@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@actual check in:
date: 86/09/30 20:08:35; author: hal; state: Exp
Automatic bump of revision number for PWS 3.2i
@
text
@@


3.1
log
@actual check in:
date: 86/09/01; author: hal; state: Exp
Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@actual check in:
date: 86/07/30 15:08:06; author hal; state: Exp
Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.2
log
@actual check in:
date: 86/06/30 16:41:33; author: danm; state: tmp
Changes made by John Schmidt; timezone 
@
text
@@


1.1
log
@Initial revision
@
text
@d3 1
a3 1
 (c) Copyright Hewlett-Packard Company, 1985.
d125 1
d178 4
d185 2
d195 19
a222 1
    writeln; writeln;
d224 1
d226 8
a233 2
    writeln('Copyright 1985 Hewlett-Packard Company.');
    writeln('All rights are reserved.  Copying or other');
d236 1
a236 1
    writeln('written consent of Hewlett-Packard Company.');
d256 1
a256 1
	  if gotnum then goto 1;
d304 2
a305 1
  prompt('New system clock time ? '); disptime;
d307 14
a320 1
  if strlen(gs)>0 then with clocktime do
d331 48
a378 1
  if changed then
@
