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


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

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

56.1
date     91.11.05.10.00.20;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.35.10;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.35.53;  author jwh;  state Exp;
branches ;
next     53.1;

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

52.1
date     91.02.19.09.21.00;  author jwh;  state Exp;
branches ;
next     51.1;

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

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

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

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

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

46.1
date     90.05.07.08.56.55;  author jwh;  state Exp;
branches ;
next     45.1;

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

44.1
date     90.04.01.22.23.07;  author jwh;  state Exp;
branches ;
next     43.1;

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

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

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

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

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

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

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

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

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

34.1
date     89.01.23.16.22.00;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.52.28;  author dew;  state Exp;
branches ;
next     32.1;

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

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

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

29.1
date     88.10.31.15.44.57;  author bayes;  state Exp;
branches ;
next     28.1;

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

27.1
date     88.09.29.11.54.33;  author bayes;  state Exp;
branches ;
next     26.3;

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

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

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

24.1
date     87.08.31.10.26.00;  author jws;  state Exp;
branches ;
next     23.1;

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

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

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

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

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

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

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

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

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

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

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

12.1
date     87.02.02.13.57.21;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.23.27;  author jws;  state Exp;
branches ;
next     10.1;

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

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

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

7.1
date     86.11.20.14.49.48;  author hal;  state Exp;
branches ;
next     6.1;

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

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

4.1
date     86.09.30.20.22.05;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.12.50.44;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.15.21.25;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.17.29.23;  author danm;  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
@.2
Remote Console Driver


.3
Introduction


This section is intended to show, by example, how to replace the
system keyboard/crt drivers and install drivers for a remote
console.  Included are two functional examples by which you can
totally replace the existing console drivers with a remote console
on an HP terminal connected via an RS-232 interface (either the
98626 or 98628 interface).

The first example is the 'simpler' approach.  It supports the use
of both the remote console or built console use.  The use of a
remote console in this example is enabled by the use of the remote
console jumper, the lack of a built-in console, or by setting the
select code field in CTABLE.  This approach works well and is easy
to set up.  It also allows you to have the same boot files for a
variety of machines and configurations.  It does, however take
slightly more memory (and therefore boot disk space).

The second example is the 'internals' approach.  This approach
allows you to configure your console exactly as you want.  The
drawbacks are that it is more complicated to understand and unless
you put in the effort, it will be less flexable.  It is smaller in
memory requirements.

If you want to do something other than these sample approachs, you
should have familiarity with:

.step 1
KBD modules in INITLIB.
.step 2
Access methods.
.step 3
I/O drivers and their structure.
.step 4
CTABLE.
.step 5
MISCINFO.
.exit


Before you do ANYTHING discussed in this section be sure you make
back up copies of your BOOT disc (with INITLIB and TABLE) and of
your CTABLE source.

It is recommended that you use the 'simple' approach and do not use
the 'remote jumper'.  This will require you to change the console
select code in CTABLE.  It will, however, allow you to change back
and forth between consoles merely by executing a CTABLE and it will
also allow you to use the debugger.

.newpage
.3
Generic Information


.4
New/Modified Drivers

The existing keyboard/CRT modules are actually a set of 5 modules.
Each module is a separate program and exported module.  The program
part takes care of initializing the exported module.  The modules
are:

.suspend
   module       purpose                                 normally
							requires
   -------------------------------------------------------------

   KBD          fundamental support of the
		'keyboard' 8041 uP including
		interrupt handling

   KEYS         support of the keyboard part            KBD
		of the keyboard

   CRT          support of the CRT                      KBD,KEYS

   BAT          support of the battery                  KBD
		part of the 'keyboard'

   CLOCK        support of the timers                   KBD
		part of the 'keyboard'

.resume

If CLOCK and BAT are intended to work normally (and actually
function with clock and battery operations), then the KBD module
needs to be fully functional.  If battery and clock functions are
not necessary (or are provided by some other means), then almost
all of the modules could be replaced by dummy modules.  The
'internals' example at the end of this section shows the case where
all five modules have been replaced.



.4
Strange Aspects of the New Drivers

There are some aspects of the new KEYS and CRT modules that are a
little strange and need some explanation.  The first is the
EOL_LYING_AROUND array in the KEYS module.  The original code has
an operation called READTOEOL.  This operation is supposed to read
all characters from the keyboard up to but NOT INCLUDING the EOL
character (which is a carriage return).  In the original code,
there is a keyboard buffer that contains the characters. To read to
EOL with the buffer you just look into the buffer until you find an
EOL and back up one character.  It is very difficult to push a
character back into an interface.  To accommodate this, the remote
KEYS module will detect when a READTOEOL operation is in effect and
an EOL is encountered and then set a flag.  When the next input
operation occurs, it checks to see if the EOL_LYING_AROUND flag is
set.  The EOL_LYING_AROUND flag is an array so that you can use
these drivers for more than just the SYSTERM and CONSOLE volumes of
the system.

The second strange aspect of the code is the NEWDRIVERS variable in
KEYS and in CRT.  This driver table contains a set of modified I/O
drivers.  The intent is to take the normal I/O drivers and remove
the ability to reset the interface.  This is necessary because many
of the RS-232 line characteristics are set up via software but
modified if a reset occurs.  As a case in point, the 98628
interface needs to have control register 28 set to 0 to specify
that there are no inbound eol characters.  If you did not do this,
the interface would use the default of 2 characters for eol with
those characters being <CR> and <LF>. Whenever a <CR> would come
in from the terminal, the 98628 interface will NOT pass the <CR> on
to the desktop computer because it is waiting to see if the next
character is a <LF> and thereby completing the eol sequence.  The
interface must never be reset or the card will go back to its
default 2 character eol sequence.  The drivers must be modified
because you can not depend on when a reset will occur - the
IOINITIALIZE, IOUNINITIALIZE, and IORESET procedures and the STOP
and CLR I/O keys will case this type of reset.


.4
Installing Drivers in INITLIB

The modules, once they are compiled, need to be placed into
INITLIB.  The console modules should be in linked form to minimize
the space they consume on the boot disk.  For each of the modules
that you are replacing (KBD, KEYS, CRT, BAT and/or CLOCK), go into
the LIBRARIAN and link the compiled object file into a single
module.  For example for the KBD module you would go through the
following steps:

.suspend
   step            keystrokes              meaning
   -----------------------------------------------------------

   1.              CNEWKBD <cr>            Go into the compiler
		   N <cr>                  and compile the source
					   NEWKBD with no listing
					   and put object code
					   into NEWKBD.CODE

   2.              LONEWKBD <cr>           Go into the librarian
		   LINEWKBD <cr>           and specify an output
		   ALKQ                    file of NEWKBD.CODE
					   link together all the
					   modules of input file
					   NEWKBD.CODE
					   finishing linking,
					   keep the output file
					   and quit

.resume

Once you have all the modules you wish to replace in this linked
form, you need to put them into INITLIB.  To do this, it works best
to create a temporary INITLIB (with a name of something like
'MYINIT.CODE') on a larger mass storage device. Go through and
replace (or add) the modules with the LIBRARIAN. The KBD, KEYS,
etc. modules are some of the first modules in INITLIB. When you
have replaced (or added) the appropriate modules, then keep the new
temporary MYINIT and exit the LIBRARIAN.  Go into the FILER and
transfer the temporary MYINIT onto the BOOT disk with a file name
of 'INITLIB.'




.4
Other Possibilities

It is also possible to use interfaces other than the serial
interfaces shown in this example.  Appropriate changes in KEYS and
CRT will be necessary for the IOSTATUS and IOCONTROL usage.  If you
use an addressed interface (like HP-IB) it will also be
necessary to preface the operations with a talk address or listen
address sequence (assuming your interface is system/active
controller).

In addition to using interfaces, it is possible to use no interface
for the keyboard/crt device.  This might be useful in a stand-alone
application where no user interaction occurs.  It is even possible
to have the KEYS module contain sufficient information to send
characters to the system (i.e. it sends a sequence of characters
like '<cr><cr>FP#3<cr>QXmyprog<cr>' which would prefix the system
to volume #3 and then execute the file 'myprog' on #3).


.4
Problems and Trouble Spots

There are some potential problems with dealing with a remote
console.  Some of these are:

.suspend
   Area         Problem
   ---------------------------------------------------------------

   DEBUGGER     The debugger is hardwired to the internal CRT and
		keyboard of the 9826/36.  You must leave the old
		KEYS and CRT module installed in the system if you
		intend to use the debugger and it must be used on
		the normal keyboard and CRT.  Without re-writing the
		debugger, it is impossible to use from the remote
		console.

   Stop key     The stop key can be supported in a limited way with
		the KEYS module.  Currently, no support is included.
		It is possible to add stop key facilities in two
		ways.  The first is to do an ESCAPE(-20) whenever
		a specific key is read from the interface.  This
		approach depends on the keystrokes being read before
		the stop action occurs.  The second approach is to
		use the SERIAL_5 interrupt facilities described
		elsewhere in this document to generate an interrupt
		when a BREAK occurs from the terminal.  The ISR
		procedure that you install will then do an
		ESCAPE(-20) to cause the stop action.

   Graphics     It is not intended the Pascal system be able to do
		remote console (on the terminal screen) graphics
		via the normal graphics library.  It would be possible
		to create your own routines to do this.


.resume

One note about 'break' stop key interrupts: only the 98628
interface supports interrupts.  The 98626 does not support
interrupts.


.4
Getting the Remote Console Working

There are some potential problems involved in trying to bring up
the remote console examples.  Some of these are:


.suspend
   1.      AUTO LF should be OFF

	   HP terminals respond to cursor sense differently when
	   AUTO LF is enabled.

   2.      RS-232 CHARACTERISTICS

	   Make sure RS-232 line characteristics are the same.  This
	   includes:

	   baud rate
	   parity
	   stop bits
	   character or hardware handshakes (probably none)

   3.      ELECTRICAL CONNECTIONS

	   In most RS-232 hardware the lines are connected properly.
	   However, just because the male and female RS-232 connectors
	   can be connected physically does not mean they are
	   electrically connected.  A case in point is the HP 2382
	   terminal and the HP 98626/98628 option 001 RS-232 cable.
	   The option 001 cable and terminal connected physically
	   but pins 2 and 3 were turned around.  It was necessary to
	   wire up a special connector or purchase a connector.

	   In general, the interface pins 1, 2, 3, and 7 are the
	   fundamental lines (unless you are doing hardware
	   handshaking).


   4.      TERMINAL TYPE

	   The examples are written with HP terminals in mind.
	   The primary facility that is depended upon is the
	   cursor sensing and cursor positioning facilities.
	   If your terminal does not support the SAME mechanisms
	   you will have to modify the programs appropriately.

.resume


.need 22
.4
Standard ASCII Keystroke Meanings

The remote console examples work to a terminal.  This is very
nice, but try to find an 'EXECUTE' key on the terminal.  The
following table lists the primarily usefull keys and their
ASCII equivalents.


.suspend
   internal keyboard       ASCII           HP terminal keyboard

   ---------------------------------------------------------

   ENTER                   CR              RETURN

   up arrow                US              CTRL DEL
   down arrow              LF              CTRL J
   left arrow              BS              CTRL H
   right arrow             FS              CTRL \

   BACKSPACE               BS              BACKSPACE
   space bar                               space bar

   EXECUTE                                 CTRL C
   shift EXECUTE           ESC             ESC



.newpage
.3
Simple approach


This first example is the 'simpler' approach.  It supports the use
of both the remote console or built console use.  It does this by
having both types of console code co-exist in the driver modules.
The use of a remote console in this example is enabled by the use
of the remote console jumper, the lack of a built-in console, or by
setting the select code field in CTABLE.  This approach works well
and is easy to set up.  It also allows you to have the same boot
files for a variety of machines and configurations.  It does,
however take slightly more memory (and therefore boot disk space).

This approach to remote console does not choose which type of
console you wish to use.  Both the built-in and remote console
drivers are included in the console modules.



.4
Steps to Modify Drivers

There are a specific set of operations that need to happen to
create a Pascal system with a remote console.  These steps are:


.step 1
BACK UP

Back up your BOOT disk and your CTABLE source.

.step 2
CREATE NEW DRIVERS

Create a set of remote console driver modules (via the EDITOR and
COMPILER). These modules will consist of FINDC, KBD, KEYS, CRT,
BAT, and CLOCK.

.step 3
INSTALL DRIVERS IN INITLIB

Install these modules in INITLIB on your boot disk (via the
LIBRARIAN).  FINDC will be a new module and must go before the
rest of the other remote console modules.  These other modules
(KBD, KEYS, CRT, BAT and CLOCK) will replace the existing INITLIB
modules.

.suspend
   module       purpose                                 requires
   -------------------------------------------------------------

   FINDC        automatic configuration

   KBD          fundamental support of the              FINDC
		'keyboard' 8041 uP including
		interrupt handling

   KEYS         support of the keyboard part            FINDC,KBD
		of the keyboard

   CRT          support of the CRT                      FINDC,KBD,KEYS

   BAT          support of the battery                  FINDC,KBD
		part of the 'keyboard'

   CLOCK        support of the timers                   FINDC,KBD
		part of the 'keyboard'

.resume


.step 4
MODIFY CTABLE

Change the CTABLE file if you want to specify which interface is
the remote console rather than using the automatic search feature
of FINDC.  This is done by editing CTABLE and compiling it and then
copying the object file onto the TABLE file on the boot disk.

.need 7
.step 5
ADD MISCINFO TO BOOT

This should only be necessary if you want to have different screen
dimensions from what the Series 200 mainframe you are booting from
has as screen dimensions (i.e. a 9826 with a 50 character wide
screen).  Change the system information about the console device
with a MISCINFO file.  This is done by compiling and running the
MISCINFO program.  This program will put a MISCINFO data file onto
the boot disk.  Refer to the MISCINFO information elsewhere in this
manual.

.exit


.4
Modifying CTABLE

The CTABLE file might need to be modified to allow the remote
console to work.  The normal CTABLE (as shipped with the default
system) will specify where the default CONSOLE and SYSTERM volumes
exist and what type of units they are.  You should change the
CTABLE file if you want to specify which interface is the remote
console rather than using the automatic search feature of FINDC.

The CTABLE changes to allow for the placement of the remote
console drivers at an arbitrary select code look like the
following:

.suspend
   procedure tea_crt(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM','CRT_CRTIO',
	   21,                                 { change isc }
	   0,0,0,0,0,'CONSOLE',#0,T,T,F,0);
     end;


   procedure tea_kbd(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM',
	   'KEYS_KBDIO',
	   21,                                 { change isc }
	   0,0,0,0,0,'SYSTERM',#0,F,T,F,0);
     end;

.resume

The CTABLE also has an alternate field that can be used for
optional paramters (like baud rate or whatever).  The alternate
parameter is the parameter right before the volume name (e.g.
'SYSTERM').

The approach taken with the remote console is such that these
drivers can be used with other volumes in the system.  Whether or
not you wish to use the drivers as a remote console, it is possible
to use the new KEYS and CRT modules as a general remote interface.
Once the modules are placed in INITLIB, add the volumes to CTABLE
source (and TABLE object file on the boot device).  The following
procedure could be added (near tea_kbd) and then in the main
execution loop of CTABLE put in a call to tea_terminal like
'tea_terminal(50);'.

.suspend
   procedure tea_terminal(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM','CRT_CRTIO',
	   21,                                 { new volume isc }
	   0,0,0,0,0,'TERMINAL',#0,T,T,F,0);
     end;

.resume


.4
Comments on the Code

This simple approach depends on the FINDC module.  This module is
the piece of code that performs an automatic search for built-in or
remote consoles.  The search pattern is as follows:

.step 1
SEARCH FOR REMOTE

Look through the interface cards for either a 98626 or a 98628
RS232 interface (from select codes 8 through 31) with its 'remote'
jumper set.  On the 98626 this is a jumper soldered on the
interface board (cutting this jumper does invalidate the interface
warranty).  On the 98628 interface this is a switch in the 'select
code' switch block (setting the switch does not invalidate the
warranty).

.step 2
SEARCH FOR BUILT IN CONSOLE

If no 'remote' interface was found, then look for the built-in
console.  Both the keyboard hardware and display hardware (from the
CPU's view) must exist.  It is possible on the HP 9920 to set up
with only the keyboard or only the display hardware.

.step 3
SEARCH FOR ANY RS232 INTERFACE

If no 'remote' interface and no 'built-in' interface was found,
then search from select codes 8 through 31 for any 98626 or 98628
RS232 interface.  (The 'remote' jumper does not need to be set.)

.step 4
HOPE FOR BUILT IN CONSOLE

If no 'remote' interface and no 'built-in' console and no
non-'remote' interface was found, then hope that enough of the
built-in interface exists and use it.

.exit

One thing to note about the 98626 card with the remote jumper set
is that the boot ROM supports the 98626 as a remote interface.
This means that when the 98626 has the remote jumper cut, the
system boot messages and the Pascal system messages will all come
out to the remote console.

In addition to accessing the system console, the console driver
code supports the use of remote terminal volumes (as described in
the CTABLE part of this discription).



.resume
.need 55
.suspend
					       (*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)

(* REMOTE CONSOLE - 7/01/1983 *)


$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

program findconsole;

MODULE findc;

IMPORT sysglobals,asm;

EXPORT

VAR internal_console : BOOLEAN;
    console_isc      : INTEGER;

PROCEDURE findit;

IMPLEMENT

PROCEDURE findit;
TYPE char_ptr     = ^CHAR;
VAR  skip         : BOOLEAN;
     found_remote : BOOLEAN;
     value,isc    : INTEGER;
     keyboard,crt : BOOLEAN;
BEGIN

  console_isc := -1;
  internal_console := FALSE;
  found_remote := FALSE;

  { search for 98626 or 98628 with 'remote' switch set - isc 0,8-31 }
  FOR isc:=0 TO 31 DO BEGIN
    IF ( (isc>0) AND (isc<8) ) OR skip
      THEN BEGIN
	skip := FALSE;
	{ skip isc 1..7 and double wide cards }
      END
      ELSE BEGIN
	TRY

	  value := ORD(char_ptr(HEX('600001')+isc*65536)^);

	  IF (value=28) OR (value=29) THEN skip:=TRUE;
	      { skip double wide cards }

	  IF value=(128+2)
	    THEN BEGIN
	      { remote bit set on a 98626 card }
	      console_isc := isc;
	      found_remote := TRUE;
	    END;

	  IF (value=(128+52)) AND
	     ((ORD(char_ptr(HEX('60400D')+isc*65536)^))=0)     { card alive? }
	    THEN BEGIN
	      { remote bit set on a 98628 card }
	      value := ORD(char_ptr(HEX('600000')+isc*65536+16395)^)*256+
		       ORD(char_ptr(HEX('600000')+isc*65536+16393)^);
	      IF value < 32768
		THEN BEGIN
		  value := ORD(char_ptr(HEX('600000')+isc*65536+value*2+1)^);
		  IF value MOD 128 = 1
		    THEN BEGIN
		      value := ORD(char_ptr(HEX('600000')+
					    isc*65536+HEX('402F'))^);
		      IF value = 1
			THEN BEGIN
			  console_isc := isc;
			  found_remote := TRUE;
			END; { of IF value = 1 THEN }
		    END; { of IF value MOD 128 =1 THEN }
		END; { of IF value<32768 THEN }
	    END; { of IF value=(128+52) THEN }

	RECOVER BEGIN
	  { bus error, I hope }
	END;

      END; { of IF }
  END; { of FOR TO BEGIN }



  { search for keyboard and crt hardware }
  TRY
    crt := TRUE;
    value := ORD(char_ptr(HEX('512001'))^);
  RECOVER crt := FALSE;

  value := ORD(char_ptr(HEX('FFFED3'))^);
  IF value MOD 16 > 7 THEN keyboard := FALSE
		      ELSE keyboard := TRUE;

  IF keyboard AND crt AND NOT found_remote
    THEN BEGIN
      internal_console := TRUE;
    END;




  { search for 98626 or 98628 without 'remote' switch set - isc 0,8-31 }
  IF NOT found_remote AND NOT internal_console
    THEN BEGIN
      { search again }
      FOR isc:=0 TO 31 DO BEGIN
	IF ( (isc>0) AND (isc<8) ) OR skip
	  THEN BEGIN
	    skip := FALSE;
	    { skip isc 1..7 and double wide cards }
	  END
	  ELSE BEGIN
	    TRY

	      value := ORD(char_ptr(HEX('600001')+isc*65536)^);

	      IF (value=28) OR (value=29) THEN skip:=TRUE;
		  { skip double wide cards }

	      IF value=(2)
		THEN BEGIN
		  { no remote bit set on a 98626 card }
		  console_isc := isc;
		END;

	      IF (value=52) AND
		 ((ORD(char_ptr(HEX('60400D')+isc*65536)^))=0) { card alive? }
		THEN BEGIN
		  { no remote bit set on a 98628 card }
		  value := ORD(char_ptr(HEX('600000')+isc*65536+16395)^)*256+
			   ORD(char_ptr(HEX('600000')+isc*65536+16393)^);
		  IF value < 32768
		    THEN BEGIN
		      value:=ORD(char_ptr(HEX('600000')+isc*65536+value*2+1)^);
		      IF value MOD 128 = 1
			THEN BEGIN
			  value := ORD(char_ptr(HEX('600000')+
						isc*65536+HEX('402F'))^);
			  IF value = 1
			    THEN BEGIN
			      console_isc := isc;
			    END; { IF value=1 THEN }
			END; { of IF value MOD 128=1 THEN }
		    END; { of IF value<32768 THEN }
		END; { of IF value=(52) THEN }

	    RECOVER BEGIN
	      { bus error, I hope }
	    END;

	  END; { of IF }
      END { of FOR TO BEGIN }
    END; { of IF NOT internal_console AND NOT found_remote }

  IF (console_isc=-1) AND NOT internal_console
    THEN BEGIN
      { panic - no console }
      internal_console := TRUE;
      { hope some part of the hardware is there }
    END;


END; { of PROCEDURE findit }


END; { of MODULE findc }

IMPORT findc,loader;

BEGIN
  findit;
  markuser;
END.


.resume
.need 55
.suspend

(*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)


(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)


$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'FINDC'$

program initkbd;

module kbd;

import sysglobals,asm,bootdammodule,isr,misc, FINDC;

export
  type

  crtconsttype = packed array [0..11] of byte;

  crtfrec = packed record
	       nobreak,stupid,slowterm,hasxycrt,
	       haslccrt{built in crt},hasclock,
	       canupscroll,candownscroll      :    boolean;
	     end;

  b9 = packed array[0..8] of boolean;
  b14= packed array[0..13] of boolean;
  crtcrec = packed record                               (* CRT CONTROL CHARS *)
	       rlf,ndfs,eraseeol,
	       eraseeos,home,
	       escape             : char;
	       backspace          : char;
	       fillcount          : 0..255;
	       clearscreen,
	       clearline          : char;
	       prefixed           : b9
	    end;

  crtirec = packed record                          (* CRT INFO & INPUT CHARS *)
	       width,height      : shortint;
	       crtmemaddr,crtcontroladdr,
	       keybufferaddr,progstateinfoaddr:integer;
	       keybuffersize: shortint;
	       crtcon            : crtconsttype;
	       right,left,down,up: char;
	       badch,chardel,stop,
	       break,flush,eof   : char;
	       altmode,linedel   : char;
	       backspace,
	       etx,prefix        : char;
	       prefixed          : b14 ;
	       cursormask        : integer;
	       spare             : integer;
	    end;

  environ = record
	      miscinfo: crtfrec;
	      crttype: integer;
	      crtctrl: crtcrec;
	      crtinfo: crtirec;
	    end;

  environptr    = ^environ;
  keybufptrtype = ^keybuffertype;

  stat8041 = packed record
	       case integer of
	     0: (pad1: 0..63; busy: boolean;readready:boolean);
	     1: (statchar: char);
	     end;
  crtword=   record case integer of
	       1:(highlightbyte,character:char;);
	       2:(wholeword: shortint);
	     end;
  kbdhooktype = procedure(var statbyte,databyte: byte;
		     var dokey: boolean);

  timerhooktype = procedure(statbyte,databyte: byte;
		     var dotimer: boolean);

  keybuffertype= array[0..maxint] of crtword;

var

    syscom: environptr;
    changehardware: boolean;
    progstateinfo: keybufptrtype;

    kbd8041datareg  [4358145 { 428001 } ]: char;
    kbd8041statusreg[4358147 { 428003 } ]: char;

    alphastate['ALPHAFLAG']:boolean;
    graphicstate['GRAPHICSFLAG']:boolean;

    kbdhook: kbdhooktype;
    timerhook: timerhooktype;
    dumpalphahook: procedure;
    dumpgraphicshook: procedure;
    togglealphahook: procedure;
    togglegraphicshook: procedure;

    kbeepfreq,
    kbeepdur: byte;

    procedure beep;
    procedure beeper(frequency, duration: byte);

    procedure kbdinit;
    procedure lockedaction(a: action);

    procedure kbdcommand(cmd: byte; numdata: integer; b1, b2, b3: byte);
    function read8041byte:byte;

implement

var kbdreg: byte;
    kbdisrib : isrib;

const
  b9826info=crtirec[
	   width :80,height:24,
	   crtmemaddr:5316608          { + 416},
	   crtcontroladdr:5341185,
	   keybufferaddr: 5320448         {  + 416},
	   progstateinfoaddr: 5320592         {  + 416},
	   keybuffersize: 72,
	   crtcon:
	   crtconsttype [114,80,76,7,26,10,25,25,0,14,76,13],
	   right{FS}:chr(28),
	   left{BS}:chr(8),
	   down{LF}:chr(10),    up{US}:chr(31),
	   badch{?}:chr(63),
	   chardel{BS}:chr(8),stop{DC3} :chr(19),
	   break{DLE}:chr(16),
	   flush{ACK}:chr(6),  eof{ETX}:chr(3),
	   altmode{ESC}:chr(27),
	   linedel{DEL}:chr(127),
	   backspace{BS}:chr(8),
	   etx:chr(3),prefix:chr(0),
	   prefixed:b14[14 of false],
	   cursormask : 0,     spare : 0];

{defaultcrtcon = crtconsttype [64,50,49,10,25,9,25,25,0,11,74,11];}

var   kbd8041cmdreg   [4358147 { 428003 } ]: char;
      read8041record:packed record
	  bytereceived:byte;
	  receivedbyte:boolean;
	end;

const
  environc=environ[miscinfo:crtfrec[
				    nobreak:false,
				    stupid :false,
				    slowterm:false,
				    hasxycrt:true,
				    haslccrt:true,  {?}
				    hasclock:true,
				    canupscroll:true,
				    candownscroll:true],
		   crttype:0,
		   crtctrl:crtcrec[
				    rlf:chr(31),
				    ndfs:chr(28),
				    eraseeol:chr(9),
				    eraseeos:chr(11),
				    home:chr(1),
				    escape:chr(0),
				    backspace:chr(8),
				    fillcount:10,
				    clearscreen:chr(0),
				    clearline:chr(0),
				    prefixed:b9[9 of false]],
		   crtinfo:crtirec[
				    width :50,height:24,
				    crtmemaddr:5316608,
				    crtcontroladdr:5308417,
				    keybufferaddr: 5319008,
				    progstateinfoaddr: 5319092,
				    keybuffersize: 42,
				    crtcon: crtconsttype [64,50,49,10,25,9,25,
							  25,0,11,74,11],
				    right{FS}:chr(28),
				    left{BS}:chr(8),
				    down{LF}:chr(10),    up{US}:chr(31),
				    badch{?}:chr(63),
				    chardel{BS}:chr(8),stop{DC3} :chr(19),
				    break{DLE}:chr(16),
				    flush{ACK}:chr(6),  eof{ETX}:chr(3),
				    altmode{ESC}:chr(27),
				    linedel{DEL}:chr(127),
				    backspace{BS}:chr(8),
				    etx:chr(3),prefix:chr(0),
				    prefixed:b14[14 of false],
				    cursormask : 0,     spare : 0]];


procedure beep;
begin
  IF internal_console
    THEN BEGIN
      beeper(kbeepfreq, kbeepdur);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure lockedaction(a: action);
label 1;
var i: integer;
begin
 if locklevel = 0 then call(a)
 else
   begin
   i := actionspending;
   while i>0 do if deferredaction[i]=a then goto 1 else i := i - 1;
   if actionspending = 10 then beep
   else begin
	actionspending := actionspending + 1;
	deferredaction[actionspending] := a;
	end;
   end;
1:
end;

function read8041byte:byte;
begin
  IF internal_console
    THEN BEGIN
      with read8041record do
	begin
	  repeat until receivedbyte;
	  read8041byte:=bytereceived;
	end;
    END
    ELSE BEGIN
      read8041byte:=0;
    END;
end;

procedure wait4kbdready;
var  kbdstatus: stat8041;
begin
  IF internal_console
    THEN BEGIN
      repeat
	kbdstatus.statchar:=kbd8041statusreg;
      until not kbdstatus.busy;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure kbdcommand(cmd: byte; numdata: integer; b1, b2, b3: byte);
var kbdstatus: stat8041;

  procedure dataout(d: byte);
  begin wait4kbdready; kbd8041datareg := chr(d); end;

begin
  IF internal_console
    THEN BEGIN
      wait4kbdready;
      read8041record.receivedbyte:=false;
      if (cmd < 64) or (cmd >= 96) then
	begin
	kbd8041cmdreg := chr(cmd);
	if numdata >= 1 then dataout(b1);
	if numdata >= 2 then dataout(b2);
	if numdata >= 3 then dataout(b3);
	end
      else
	begin
	kbdreg := ior(cmd, iand(kbdreg,-1-b1));
	kbd8041cmdreg := chr(kbdreg);
	end;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure beeper(frequency, duration: byte);
begin
  IF internal_console
    THEN BEGIN
      kbdcommand(163, 2, (256-duration) mod 256, frequency, 0);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure kbdisr(isribptr : pisrib);
var kbdstatus: byte;
    kbddata:  byte;
    dokey: boolean;
    dotimer: boolean;

begin(*kbdisr*)
  kbdstatus :=  ord(kbd8041statusreg);
  kbddata   :=    ord(kbd8041datareg);
  dokey := true;
   case (kbdstatus div 64) of
    0: begin
	 dotimer := true;
	 call(timerhook,kbdstatus,kbddata,dotimer);
	 if dotimer then
	   beep;  {no default timer interrupt handler implemented}
       end;

    1: begin{byte requested by 68000}
	 with read8041record do
	 begin
	   bytereceived:=kbddata;
	   receivedbyte:=true;
	 end;
       end;

    2,3: call (kbdhook, kbdstatus, kbddata, dokey);

    end;
end;

procedure dummykbdhook(var stat, data: byte;
		       var doit: boolean);
begin
end;

procedure dummytimerhook(stat, data: byte;
			 var doit: boolean);
begin
end;

procedure initsyscom;
var f: file of environ;
    dcrtinfo['dcrtinfo']: anyptr;
begin
new(syscom);  syscom^ := environc;
with syscom^ do
  begin
  if not sysflag.alpha50 then crtinfo := b9826info;
  reset(f, nodestr+'MISCINFO','shared');
  if ioresult = ord(inoerror) then read(f, syscom^);
  changehardware := ioresult = ord(inoerror);
  dcrtinfo := addr(crtinfo);
  progstateinfo:=anyptr(crtinfo.progstateinfoaddr);
  end;
end; {INITSYSCOM}

procedure kbdinit;
begin
  IF internal_console
    THEN BEGIN
      kbeepfreq := 8;        {frequency = 8 * 104.17 Hz}
      kbeepdur  := 8;        {duration  = 8 * 10 ms}
      kbdreg := 0;
      kbdhook := dummykbdhook;
      timerhook := dummytimerhook;
      permisrlink(kbdisr,charptr(4358147){428003HEX},1,1,1,addr(kbdisrib));
      setintlevel(0);
      kbdcommand(95, 0, 31, 0, 0); {disable all keyboard interrupts}
      initsyscom;
    END
    ELSE BEGIN
      kbdhook := dummykbdhook;
      timerhook := dummytimerhook;
      initsyscom;
    END;

end;  {kbdinit}

end;

import kbd, loader;

begin
  kbdinit;
  markuser;
end.


.resume
.need 55
.suspend
					      (*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)



(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)


$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$
$SEARCH  'KBD','FINDC'$

program keysinit;

module keys;
import sysglobals, asm, misc, kbd, IODECLARATIONS, GENERAL_0, FINDC;
export
  const
  yencode = 92; { Yen symbol overlays USASCII backslash (\) in Kana machines }

  type
  langtype = (gringo,french,german,swedish{,finnish},spanish,katakana);

  var
  kbdlangjumper: record case byte of
		   0: (b:packed record dummy,jnum:byte end);
		   1: (jlang:langtype); {16 bit}
		 end;
  kbdwaithook: procedure;
  kbdreleasehook: procedure;

  keybuffer:^keybuffertype;
  keybufsize:shortint;
  keybuflength: shortint;
  capslock: boolean;
  kanaflag: boolean;

  procedure kbdio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
  procedure initkeys;

implement

var
  marmot        : boolean;
  anychar       : boolean;
  buildchar     : integer;
  buildcount    : 0..4;
  anycharsavehook : kbdhooktype;

const
  xmitlang  =18;
  xmitconfig=17;

type
  t1 = packed array[boolean, 60..99] of char;
  t2 = packed array[langtype] of t1;
  t4 = packed array[boolean, 100..125] of char;
  aa = packed array['' .. ''] of char;                      { scs 25-jan-83 }

const
  alphabet       = t4['opklqwertyuiasdfghjmzxcvbn',
		      'OPKLQWERTYUIASDFGHJMZXCVBN'];

  keylookup = t2[
  {gringo}
     t1['0.,+123-456*789/E()^1234567890-=[];'',./ ',
     '0.,+123-456*789/`|\~!@@#$%^&*()_+{}:"<>? '],                {shifted}
  {french}
  t1['0.,+123-456*789/E()^1234567890'''#170#200'&'#197#203',.- ',
     '0.|~123`456@@789\<[]>!"#$%+/()=?'#171#181'*'#201#179';:_ '],
  { german }
  t1['0.,+123-456*789/E()^1234567890'#222''''#207'+'#206#204',.- ',
     '0.|~123'#179'456@@789\<[]>!"#$%&/()=?`'#219'*'#218#216';:_ '],
  { swedish }
  t1['0.,+123-456*789/E()^1234567890+'#197#212#207#206#204',.- ',
     '0.|~123''456@@789\<[]>!"#$%&/()=?'#220#208#219#218#216';:_ '],
  { spanish }
  t1['0.,+123-456*789/E()^1234567890+'#168#179'#'#183'*,.- ',
     '0.|+123''456*789\<[]>!"'#185'$%&'#184'()=?/{}'#182'@@;:_ '],
  { katakana }
  t1[
'0.,+123-456*789/E()^'#199#204#177#179#180#181#212#213#214#220#206#205#209#219#218#185#200#217#210#32,
'0.,+123-456*789/`|\~'#199#204#167#169#170#171#172#173#174#166#176#205#222#223#218#185#164#161#165#32]

		 ];    {end of keylookup}

  ala = aa[''];                                           { scs 25-jan-83 }
  ale = aa[''];                                           { scs 25-jan-83 }
  ali = aa[''];                                           { scs 25-jan-83 }
  alo = aa[''];                                           { scs 25-jan-83 }
  alu = aa[''];                                           { scs 08-feb-83 }
  aua = aa['AAA'];                                           { scs 25-jan-83 }
  aue = aa['EEE'];                                           { scs 25-jan-83 }
  auo = aa['OOO'];                                           { scs 25-jan-83 }
  auu = aa['UUU'];                                           { scs 25-jan-83 }

type
  k2 = packed array [100..125] of byte;
  kanaalphabettype = packed array [boolean] of k2;

const
  kanaalphabet = kanaalphabettype
		     [k2[ 215,190,201,216,192,195,178,189,182,221,197,198,
			  193,196,188,202,183,184,207,211,194,187,191,203,
			  186,208 ],
		      k2[ 215,190,201,216,192,195,168,189,182,221,197,198,
			  193,196,188,202,183,184,207,211,175,187,191,203,
			  186,208]];


  VAR  eol_lying_around : PACKED ARRAY[type_isc] OF BOOLEAN;
       myisc            : shortint;

       newdrivers       : drv_table_type;




{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset( mytemp : ANYPTR );
BEGIN
  { do nothing so that the configuration stays the same }
END;




PROCEDURE myinit;

{This procedure was modified to do DC1/DC3 handshaking. 9/21/83}

VAR status_reg:                  {variant record to change upper two bits only}
	record case integer of
	  0:      (whole:
		     packed record
			     byte: 0..255;             {gets inital status}
			    end);
	  1:      (part:
		      packed record
			     upper_two_bits: 0..3;       {gets new bits}
			     end);
	end;

BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
	iocontrol(myisc,28,0);                         { no EOL characters }
	iocontrol(myisc,22,3);                         { DC1/DC3 hndshk-host }
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
	status_reg.whole.byte := iostatus(myisc,4);    {read status reg 4}
	status_reg.part.upper_two_bits := 1;           {change upper two bits}
	iocontrol(myisc,4,status_reg.whole.byte);      {use DC1/DC3 hndshk}
    END;
  iocontrol(myisc,12,1);                               { connect the card }
  newdrivers := isc_table[myisc].io_drv_ptr^;          { copy 628 card dvrs }
  newdrivers.iod_init := new_reset;                    { put in new reset   }
  isc_table[myisc].io_drv_ptr := ADDR( newdrivers );   { install drivers    }
END;


FUNCTION inchar : CHAR;
VAR     x       : CHAR;
BEGIN
  IF eol_lying_around[myisc]
    THEN BEGIN
      inchar := eol;
      eol_lying_around[myisc] := FALSE;
    END
    ELSE BEGIN
      WITH isc_table[myisc] DO
      CALL ( io_drv_ptr^.iod_rdb ,
	     io_tmp_ptr ,
	     x );
      inchar:=x;
    END;
END;

FUNCTION kbdbusy : BOOLEAN;
VAR     x       : INTEGER;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
      { check inbound queue for data }
      x:=iostatus(myisc,5);
      IF (x=1) OR (x=3) OR eol_lying_around[myisc]  THEN kbdbusy:=FALSE
						    ELSE kbdbusy:=TRUE;
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
      x:=iostatus(myisc,10);
      { check character buffer for data }
      IF ((x MOD 2)=0) OR eol_lying_around[myisc]    THEN kbdbusy:=FALSE
						     ELSE kbdbusy:=TRUE;
    END;
END;






procedure setrunlight $alias 'CRT_SETRUNLIGHT'$ (x: char); external;

procedure stopaction;
begin
  actionspending := 0;
  escape(-20);
end;

procedure cntrlpausekey;
type strin = string[1];
const qm = strin['?'];
begin
call(debugger,4,integer(addr(qm)),0)
end;

procedure pausekey;
begin
call(debugger,6,0,0);
end;

procedure kbdio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
var   interruptlevel: integer;
      ch1,ch2:char; kbl: shortint;
      commandinprogress: char;
      buf: charptr;
      extra: shortint;                                        { scs 25-jan-83 }
begin
  myisc := unitable^[fp^.funit].sc;
  IF internal_console AND (myisc=0)
    THEN BEGIN
      ioresult := ord(inoerror);
      buf := addr(buffer);
      case request of
       flush:  {do nothing};
       unitstatus:  fp^.fbusy := keybuflength = 0;
       {uwait:  begin
	       if progstateinfo^[7].character<>chr(idle) then
		 commandinprogress:=progstateinfo^[7].character;
	       while keybuflength = 0 do call(kbdwaithook);
	       setrunlight(commandinprogress);
	       end; }
       clearunit:  begin interruptlevel := intlevel;
		 if interruptlevel <1 then setintlevel(1);
		 for kbl := 0 to keybufsize - 1 do
		   keybuffer^[kbl].wholeword := ord(' ');
		 keybuflength := 0;
		 setintlevel(interruptlevel);
	       end;

       $if false$
       writeeol,
       startwrite,
       writebytes: crtio(fp, request, buffer, length, 0);
       $end$

       readtoeol,
       readbytes,
       startread:
	begin
	if request = readtoeol then
	  begin
	  buf := addr(buf^, 1);
	  buffer[0] := chr(0);
	  end;
	while length>0 do
	 begin
	   if progstateinfo^[7].character<>chr(idle) then
			      commandinprogress:=progstateinfo^[7].character;
	   interruptlevel := intlevel;
	   repeat
	     while keybuflength = 0 do call(kbdwaithook);
	     setintlevel(7);         {disable interrupts}
	     if keybuflength = 0 then setintlevel(interruptlevel);
	   until keybuflength > 0;
	   setrunlight(commandinprogress);
	   buf^ := keybuffer^[0].character;
	   if buf^ = chr(etx) then length := 0 else length := length-1;
	   if (buf^=eol) and (request=readtoeol) then length := 0
	   else
	     begin
	     fp^.feoln := false;
	     buf := addr(buf^, 1);
	     if keybuflength < keybufsize then              { scs 25-jan-83 }
	       extra := ord(keybuffer^[keybuflength].character <> ' ')
	     else extra := 0;
	     keybuflength := keybuflength - 1;
	     moveleft(keybuffer^[1], keybuffer^[0], (keybuflength+extra)*2);
								     { scs }
	     keybuffer^[keybuflength+extra].character := ' ';        { scs }
	     if request = readtoeol then buffer[0] := chr(ord(buffer[0])+1);
	     end;
	   setintlevel(interruptlevel);            {restore keyboard interrupt}
	 end;
	if request = startread then call(fp^.feot, fp);
	end;
       otherwise ioresult := ord(ibadrequest);
      end;
    END
    ELSE BEGIN
      IF (myisc>=0) AND (myisc<=7)
	THEN BEGIN
	  { 0 is default and 1..7 are not allowed }
	  myisc := console_isc;
	END
	ELSE BEGIN
	  { -isc and isc>7 allows a CTABLE entry
	     to override all of this garbage }
	  IF myisc < 0  THEN myisc := -myisc;
	  IF myisc > 31 THEN myisc := myisc MOD 32;
	END;
      ioresult := ORD(inoerror);
      buf := ADDR(buffer);
      CASE request OF

	flush:       BEGIN
		       myinit;
		     END;

	unitstatus:  BEGIN
		       fp^.fbusy := kbdbusy  ;
		     END;

	clearunit:   BEGIN
		       myinit;
		     END;

	readtoeol,
	readbytes,
	startread:   BEGIN
		       IF request = readtoeol
			 THEN BEGIN
			   { the buffer is a string - so set it to empty }
			   buf := ADDR(buf^, 1);
			   buffer[0] := chr(0);
			 END;
		       while length>0 DO BEGIN
			 buf^ := inchar;
			 IF buf^ = chr(etx)
			   THEN length := 0
			   ELSE length := length-1;
			 IF (buf^=eol) and (request=readtoeol)
			   THEN BEGIN
			     eol_lying_around[myisc] := TRUE;
			     length := 0
			   END
			   ELSE BEGIN
			     fp^.feoln := false;
			     buf := ADDR(buf^, 1);
			     IF request = readtoeol
			       THEN buffer[0] := CHR(ORD(buffer[0])+1);
			   END;
		       END; { of WHILE DO }
		       IF request = startread THEN CALL(fp^.feot, fp);
		     END;

	OTHERWISE    BEGIN
		       ioresult := ORD(ibadrequest);
		     END;

      END; { of CASE }

    END;
end;

procedure keyservice(var kbdstatus, kbddata: byte; var dokey: boolean);

var shift, control, done:  boolean;
    key: char;
    lang: langtype;

    procedure morealpha;
    begin
      done := true;
      if not alphastate then call(togglealphahook)
      else if graphicstate then call(togglegraphicshook);
    end;

    procedure moregraphics;
    begin
      done := true;
      if not graphicstate then call(togglegraphicshook)
      else if alphastate then call(togglealphahook);
    end;

    procedure dumpalpha;
    begin
     done := true;
     lockedaction(dumpalphahook);
    end;

    procedure dumpgraphics;
    begin
     done := true;
     lockedaction(dumpgraphicshook);
    end;

    procedure remove(all: boolean);           { scs 25-jan-83 for diacriticals}
    var i,n:  integer;
    begin
      if keybuflength < keybufsize then
	if keybuffer^[keybuflength].character <> ' '    {non-advancing key}
	then keybuflength := keybuflength + 1;
      if keybuflength > 0 then
	begin
	if all then n := 0 else n := keybuflength-1;
	for i:=n to keybuflength-1 do keybuffer^[i].wholeword := ord(' ');
	keybuflength:=n;
	end;
    end;

    procedure  unrecognized; begin beep; done := true; end;

    procedure clearanychar;
    begin
      if anychar then
	begin
	  anychar := false;
	  kbdhook := anycharsavehook;
	end;
    end;

   procedure rpghandler;
   var key: char;
   begin
     case kbdstatus div 16 of
 14: {shifted}
	if kbddata >= 128 then key:=chr(lf) else key:=chr(us);
 15: {unshifted}
	if kbddata >= 128 then key:=chr(fsp) else key:=chr(bs);
     otherwise
	beep;  key := ' ';
     end;
     if keybuflength=0 then
       begin  keybuflength := 1;
	 keybuffer^[0].character := key;
	 call(kbdreleasehook);
       end;
   end;

begin
  IF internal_console AND (myisc=0)     { STILL A PROBLEM FOR ISC 0 }
    THEN BEGIN
      if dokey then
       if kbdstatus>=192 then rpghandler
       else
	begin
	done:=false;{done indicates that key is handled immediately}
	control := not odd(kbdstatus div 32);
	shift   := not odd(kbdstatus div 16);
	if (kbdlangjumper.jlang=katakana) and not kanaflag then lang := gringo
	else lang := kbdlangjumper.jlang;
	if odd(kbdstatus) then
	 if kbddata < 60 then
	    case kbddata of
	      24:                     begin
					capslock := not capslock;
					done := true end;
	      25:                     key := chr(tab);        {tab}
	      34:                     key := chr(lf);         {down arrow}
	      35:                     key := chr(us);         {up arrow}
	      38,46: if control then begin remove(false); done:=true; end
		     else             key := chr(bs);         {left arrow,
								 backspace}
	      39:                     key := chr(fsp);        {right arrow}
	      40,43:                  key := 'I';             {insert mode}
	      41: if marmot then moregraphics else
				      key := 'D';             {delete mode}
	      42: if shift and marmot then morealpha else unrecognized;
							      {recall}
	      44:                     key := 'D';             {delete mode}
	      45:                     unrecognized;           {cleartoend}
	      47:                     key := 'R';             {RUN  key}
	      48:                     key := 'E';             {EDIT key}
	      49: if shift then dumpalpha else morealpha;
	      50: if shift then dumpgraphics else moregraphics;
	      51: begin
		  done := true;
		  if shift then begin anychar:=true;
				      anycharsavehook := kbdhook;
				      kbdhook := keyservice;
				      buildcount:=1;
				      buildchar:=0;
				end
		  else call(debugger,3,kbdstatus,kbddata);
		  end;
	      52: if control then begin remove(true); done:=true; end
		  else if shift then  key := chr(ff)          {clear screen}
		  else                key := chr(del);        {clear line}
	      53: if shift and marmot then dumpalpha else unrecognized;
							    {result, set tab}
	      54: if shift and marmot then dumpgraphics else unrecognized;
							    {prt all, clr tab}
	      55: begin {stop} {clear I/O}
		    done := true;
		    clearanychar;
		    lockedaction(stopaction);
		  end;
	      56: begin {pause}
		    done := true;
		    if locklevel=0 then call(debugger, 3, kbdstatus, kbddata)
		    else if control then lockedaction(cntrlpausekey)
				    else lockedaction(pausekey);
		  end;
	      57:                     key := chr(cr);         {ENTER}
	      58: begin done := true; call(debugger,3,kbdstatus,kbddata); end;
	      59: if    control then  begin
				      key := chr(cntrl);      {'control' char}
				      control := false;
				      end
		  else if shift then  key := chr(esc)         {escape}
		  else                key := chr(etx);        {EXECUTE}
	      otherwise unrecognized; {no such code}
	    end  {case kbddata < 60}
	 else if kbddata < 100 then
	  begin
	  if capslock then
	    if      lang=german  then shift := shift<>(kbddata in [92,94..95])
	    else if lang=swedish then shift := shift<>((kbddata>=91) and
						       (kbddata <= 95))
	    else if lang=spanish then shift := shift<>(kbddata = 94);
	  key := keylookup[lang, shift, kbddata];
	  if kbdlangjumper.jlang = katakana then
	     begin
	     if control then
	       if      kbddata = 96 then begin
					 done := true; kanaflag := false end
	       else if kbddata = 97 then begin
					 done := true; kanaflag := true  end;
	     if ((kbddata=92) or (kbddata=93)) and shift and not kanaflag then
	       if control then key := chr(fsp)
	       else if kbddata = 92 then key := chr(yencode)
	       else                      key := '|';
	     end;
	  end
	 else if kbddata < 126 then
	   if lang = katakana
	     then key:=chr(kanaalphabet[          shift, kbddata])
	     else begin
		  key:=        alphabet[capslock<>shift, kbddata];
		  if lang = german then
		    if      key = 'y' then key := 'z'
		    else if key = 'z' then key := 'y'
		    else if key = 'Y' then key := 'Z'
		    else if key = 'Z' then key := 'Y';
		  end
	 else unrecognized
	else {kbdstatus is even}
	 begin
	 key := chr(kbddata);
	 control := false;
	 end;

	if anychar then
	    if done then
	      begin
	       if not (shift and (kbddata = 51)) then
		 clearanychar;
	      end
	    else
	      begin
	       if (key < '0') or (key > '9') then
		 begin
		 clearanychar;
		 unrecognized;
		 end
	       else
		 begin
		 buildchar:=buildchar*10+(ord(key)-ORD('0'));
		 buildcount:=buildcount+1;
		 done := buildcount <= 3;
		 if not done then
		   begin
		     clearanychar;
		     key:=chr(buildchar mod 256);
		   end;
		 end;
	      end;

	if not done then
	    begin
	    if control then
	      if lang<>katakana
		then key:=chr(ord(key) mod 32);
	    if keybuflength>=keybufsize then beep
	    else
	      begin
		with keybuffer^[keybuflength] do              { scs 25-Jan-83 }
		  if character = ' ' then character := key    { scs 25-Jan-83 }
		  else if (key<>' ') and (key<>chr(fsp)) then { scs 25-Jan-83 }
		    if character = '' then                   { scs 25-Jan-83 }
		      if      key = 'n' then character := '' { scs 25-Jan-83 }
		      else if key = 'N' then character := '' { scs 25-Jan-83 }
					else character := key { scs 25-Jan-83 }
		    else case key of                          { scs 25-Jan-83 }
		      'a': character := ala[character];       { scs 25-Jan-83 }
		      'e': character := ale[character];       { scs 25-Jan-83 }
		      'i': character := ali[character];       { scs 25-Jan-83 }
		      'o': character := alo[character];       { scs 25-Jan-83 }
		      'u': character := alu[character];       { scs 25-Jan-83 }
		      'A': character := aua[character];       { scs 25-Jan-83 }
		      'E': character := aue[character];       { scs 25-Jan-83 }
		      'O': character := auo[character];       { scs 25-Jan-83 }
		      'U': character := auu[character];       { scs 25-Jan-83 }
		      otherwise character:=key;               { scs 25-Jan-83 }
		      end;                                    { scs 25-Jan-83 }
		if (key<'') or (key>'') or kanaflag then    { scs 14-Feb-83 }
		  begin
		  keybuflength:=keybuflength+1;
		  call(kbdreleasehook);
		  end;
	      end;
	    end;
	end;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end; {keyservice}

procedure wait4kbdreadready;
var  kbdstatus: stat8041;
begin
  IF internal_console AND (myisc=0)     { STILL A PROBLEM FOR ISC 0 }
    THEN BEGIN
      repeat
	kbdstatus.statchar:=kbd8041statusreg;
      until  kbdstatus.readready;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure dummykbdwait;
begin
  setrunlight(chr(idle));
end;

procedure dummykbdrelease;
begin
end;

procedure initkeys;
var kbddata   : byte;
    localisc : INTEGER;
begin
  IF internal_console
    THEN BEGIN
      with syscom^.crtinfo do
	begin
	keybuffer:=anyptr(keybufferaddr);
	keybufsize:=keybuffersize;
	kbdwaithook := dummykbdwait;
	kbdreleasehook := dummykbdrelease;
	kbdhook := keyservice;
	anychar:=false;
	kanaflag:=false;
	capslock:=true;
	kbdcommand(162, 1, 256- 4, 0, 0);{auto repeat period = 40 ms}
	kbdcommand(160, 1, 256-30, 0, 0);{auto repeat delay  = 300 ms}
	kbdcommand(166,1,1,0,0);
	end;
	with kbdlangjumper do
	  begin
	    jlang:=gringo;{default in case of timeout}
	    setintlevel(7);{raise processor above device
	     interrupt level}
	    kbdcommand(xmitlang,0,0,0,0); {request language jumper code}
	    wait4kbdreadready;
	    kbddata:=ord(kbd8041datareg);
	    b.dummy:=0;b.jnum:=kbddata;
	    if (jlang>katakana) then jlang:=gringo;
	  end;
	kbdcommand(xmitconfig,0,0,0,0); {request language jumper code}
	wait4kbdreadready;
	kbddata:=ord(kbd8041datareg);
	marmot := odd(kbddata);
    END
    ELSE BEGIN
      FOR localisc := 0 TO 31 DO eol_lying_around[localisc] := FALSE;
      WITH syscom^.crtinfo DO BEGIN
	keybuffer:=NIL;
	keybufsize:=1;
	kanaflag:=false;
	capslock:=true;
      END;
    END;
end;

end;

import keys, loader;

begin
  initkeys;
  markuser;
end.

.resume
.need 55
.suspend
(*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)



(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)



$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'KBD','KEYS','FINDC'$

program initcrt;

module crt;
import sysglobals, asm, misc, kbd, keys, IODECLARATIONS, GENERAL_0, FINDC;
export
  type
  scrtype = packed array[0..maxint] of crtword;
  scrptr=^scrtype;

  var
  screenwidth,screenheight:shortint;
  maxx,maxy,screensize:shortint;
  xpos: shortint;
  ypos: shortint;
  screen:scrptr;
  defaulthighlight: shortint;

  procedure crtinit;
  procedure crtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						 length, position: integer);
  procedure updatecursor;
  procedure setrunlight(x:char);

implement

const
minkana = 161;
maxkana = 223;
yenromlocation = 128; { location of Yen symbol in CRT rom }

type
kanatocrtlookuptype = packed array [minkana..maxkana] of 128..255;
romtokanatype = packed array[#128..#238] of 0..255;

crtregtype = 0..15;
crtcmdwrd = packed record case integer of
		0: (topbyte, botbyte: byte);
		1: (longword: shortint);
		2: (p1,p2, textfield, softfield: boolean);
	      end;

const
kanatocrtlookup = kanatocrtlookuptype [
    { code 161 }      129,130,131,132,133,134,135,
    { code 168 }  136,137,138,139,140,141,142,143,
    { code 176 }  144,145,146,147,148,149,150,151,
    { code 184 }  152,153,154,155,156,157,158,159,
    { code 192 }  160,161,162,163,164,165,166,167,
    { code 200 }  173,174,177,178,180,188,190,191,
    { code 208 }  224,225,226,227,228,229,230,231,
    { code 216 }  232,233,234,235,236,237,238,179  ];

  romtokanamap = romtokanatype         [  92, 161, 162,
      163, 164, 165, 166, 167, 168, 169, 170, 171, 172,
      173, 174, 175, 176, 177, 178, 179, 180, 181, 182,
      183, 184, 185, 186, 187, 188, 189, 190, 191, 192,
      193, 194, 195, 196, 197, 198, 199, 168, 169, 170,
      171, 172, 200, 201, 175, 176, 202, 203, 223, 204,
      181, 182, 183, 184, 185, 186, 187, 205, 189, 206,
      207, 192, 193, 194, 195, 196, 197, 198, 199, 200,
      201, 202, 203, 204, 205, 206, 207, 208, 209, 210,
      211, 212, 213, 214, 215, 216, 217, 218, 219, 220,
      221, 222, 223, 208, 209, 210, 211, 212, 213, 214,
      215, 216, 217, 218, 219, 220, 221, 222];

var
highlight:  shortint;
hascolor: boolean;
pm6845addrreg:^char;
pm6845comdreg:^char;
crtidreg[hex('51FFFE')]: packed record
      b15,b14,b13: boolean;
      colorinfo: (cinfo0, cinfo1, cinfo2, cinfo3);
      b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0: boolean;
      end;

CONST dc1           = 17 ;                   {control-S}
VAR   myisc         : shortint;
      newdrivers    : drv_table_type;




{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset( mytemp : ANYPTR );
BEGIN
  { do nothing so that the configuration stays the same }
END;






PROCEDURE myinit;

{This procedure was modified by Anny Randel to do DC1/DC3 handshaking. 9-21-83}

VAR status_reg:                  {variant record to change upper two bits only}
	record case integer of
	  0:      (whole:
		     packed record
			     byte: 0..255;             {gets inital status}
			    end);
	  1:      (part:
		     packed record
			     upper_two_bits: 0..3;       {gets new bits}
			    end);
	end;

BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
	iocontrol(myisc,28,0);                         { no EOL characters }
	iocontrol(myisc,22,3);                         { use DC1/DC3 hndshk }
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
	status_reg.whole.byte := iostatus(myisc,4); {read status reg 4}
	status_reg.part.upper_two_bits := 1;        {change upper two bits}
	iocontrol(myisc,4,status_reg.whole.byte);   {use DC1/DC3 hndshk}
     END;
  iocontrol(myisc,12,1);                               { connect the card }
  newdrivers := isc_table[myisc].io_drv_ptr^;          { copy 628 card dvrs }
  newdrivers.iod_init := new_reset;                    { put in new reset   }
  isc_table[myisc].io_drv_ptr := ADDR( newdrivers );   { install drivers    }
END;




FUNCTION inchar : CHAR;
VAR  x          : CHAR;
BEGIN
  WITH isc_table[myisc] DO
  CALL ( io_drv_ptr^.iod_rdb ,
	 io_tmp_ptr ,
	 x );
  inchar:=x;
END;

PROCEDURE out(x:CHAR);
BEGIN
  WITH isc_table[myisc] DO
  CALL ( io_drv_ptr^.iod_wtb ,
	 io_tmp_ptr ,
	 x );
END;


PROCEDURE output(s    :io_STRING);
VAR i:INTEGER;
BEGIN
  FOR i:=1 to STRLEN(s) DO out(s[i]);
END;



PROCEDURE localbeep;
BEGIN
   out(CHR(7));        { send beep to card }
END;



procedure setrunlight(x:char);
begin
  IF internal_console  AND (myisc=0)            { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
  progstateinfo^[7].character:=x;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure dumpa;
label 1;
var   row, column:integer;
      c: char;
      line: string[100];
begin with syscom^.crtinfo do
  begin
  setstrlen(line, width);
  for row := 0 to height-1 do
    begin
    for column := 0 to width-1 do
      begin
      c := screen^[row*width+column].character;
      if (c >= #128) and (c <= #238) then c := chr(romtokanamap[c]);
      line[column+1] := c;
      end;
    column := width;
    while (column > 1) and (line[column]= ' ') do column := column - 1;
    writeln(gfiles[4]^, line:column);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  end;
1: end;

procedure toggleg;
var gon [5439488{530000 HEX}]:shortint;
    goff[5472256{538000 HEX}]:shortint;
    gbase['GRAPHICSBASE']: ^shortint;

begin
  graphicstate:=not graphicstate;
  if graphicstate then gbase:=addr(gon)
		  else gbase:=addr(goff);
  gbase^ := gbase^;
end;

procedure dumpg;
label 1;
const gheight = 300;    gheightb = 390;
      gwidth = 50;      gwidthb  = 64;
      gbuffersize=gwidthb+6;
type  gword=packed record
	     dummy,growbyte:char;
	     end;
gdotrow=packed array[1..gwidth] of gword;
type gmemtype =  packed array [1..gheight] of gdotrow;
     gmembtype = packed array [1..gheightb, 1..gwidthb] of char;
     gmem =  ^gmemtype;
     gmemb = ^gmembtype;
var   graphicsbase['GRAPHICSBASE']:  anyptr;
      gbuffer:packed array[1..gbuffersize] of char;
      i,j,rows,buffersize,pindex:integer;
      busy:boolean;
begin
  gbuffer[1]:=chr(esc) {escape sequence for graphics};
  gbuffer[2]:='*';
  gbuffer[3]:='b';
  gbuffer[6]:='W';
  if sysflag.biggraphics then
       begin
       gbuffer[4]:='6';
       gbuffer[5]:='4';
       rows := gheightb;
       buffersize := gwidthb+6;
       end
  else begin
       gbuffer[4]:='5';
       gbuffer[5]:='0';
       rows := gheight;
       buffersize := gwidth+6;
       end;
  for i:= 1 to rows do
    begin
    if sysflag.biggraphics then
     for j:=1 to gwidthb do gbuffer[j+6]:=gmemb(graphicsbase)^[i,j] else
       for j:=1 to gwidth  do gbuffer[j+6]:=gmem(graphicsbase)^[i,j].growbyte;
    write(gfiles[4]^, gbuffer:buffersize);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  write(gfiles[4]^, #27'*rB'); {terminate graphics sequence};
1:
end;

procedure crtcommand(reg: crtregtype; data: byte);
begin
  IF internal_console  AND (myisc=0)            { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
    pm6845addrreg^ := chr(reg);
    pm6845comdreg^ := chr(data);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure togglea;
var   lcursaddr:crtcmdwrd;

begin
  alphastate:=not(alphastate);
  lcursaddr.longword:=integer(screen) mod 8192 div 2;
  lcursaddr.textfield:=alphastate;
  lcursaddr.softfield:=alphastate;
  crtcommand(12, lcursaddr.topbyte);
  crtcommand(13, lcursaddr.botbyte);
  updatecursor;
end;

procedure updatecursor;
var cursaddr: crtcmdwrd;
begin
  IF internal_console  AND (myisc=0)            { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
  cursaddr.longword:=integer(screen) mod 8192 div 2 + ypos*screenwidth+xpos;
  cursaddr.textfield := alphastate;
  cursaddr.softfield:=alphastate;
  crtcommand(14, cursaddr.topbyte);
  crtcommand(15, cursaddr.botbyte);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure getxy(var x,y: integer);
VAR dummy : CHAR;
begin
  IF internal_console  AND (myisc=0)            { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
      x := xpos;      y := ypos;
    END
    ELSE BEGIN
      x:=0;  y:=0;
      { go thru sequence to get actual position }
      out(CHR(esc));        out('`');       { send cursor sense absolute }
      out(CHR(dc1));                        { tell terminal I am ready }
      dummy := inchar;                      { get esc }
      dummy := inchar;                      { get &   }
      dummy := inchar;                      { get '   }
      x     := ORD(inchar)-48;              { get column digit 1 }
      x     := ORD(inchar)-48+x*10;         { get column digit 2 }
      x     := ORD(inchar)-48+x*10;         { get column digit 3 }
      dummy := inchar;                      { get c   }
      y     := ORD(inchar)-48;              { get row    digit 1 }
      y     := ORD(inchar)-48+y*10;         { get row    digit 2 }
      y     := ORD(inchar)-48+y*10;         { get row    digit 3 }
      dummy := inchar;                      { get Y   }
      dummy := inchar;                      { get cr  }

      xpos := x;      ypos := y;
    END;
end;

procedure setxy(x, y: shortint);
VAR s : string[9];
    p : INTEGER;
begin
  IF internal_console AND (myisc=0)             { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
      if x>=screenwidth then xpos:=maxx
      else if x<0 then xpos:=0
      else xpos := x;
      if y>=screenheight then ypos:=maxy
      else if y<0 then ypos:=0
      else ypos := y;
    END
    ELSE BEGIN
      IF x>=screenwidth  THEN xpos:=maxx
			 ELSE IF x<0 THEN xpos:=0
				     ELSE xpos := x;
      IF y>=screenheight THEN ypos:=maxy
			 ELSE IF y<0 THEN ypos:=0
				     ELSE ypos := y;

      { send xpos/ypos via escape esc & a xx y yy C }
      SETSTRLEN(s,9);
      STRWRITE (s,1,p,CHR(esc),'&a',ypos:2,'y',xpos:2,'C');
      output   (s);
    END;
end;

procedure gotoxy(x,y: integer);
begin
    setxy(x,y);
    updatecursor;
end;


procedure clear(number: shortint);
var x,y: shortint;
begin
  x:=xpos; y:=ypos;
  while number>0 do
    begin
      screen^[y*screenwidth+x].wholeword:= ord(' ');
      number:=number-1;
      if x<maxx then x:=x+1
      else begin x:=0; if y<maxy then y:=y+1 end;
    end;
end;

procedure scrollup;
var i: shortint;
begin
  moveleft(screen^[screenwidth{1, 0}],
	   screen^[0{0, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do
    screen^[maxy*screenwidth+i].wholeword:=ord(' ');
end;

procedure scrolldown;{new  4/30/81}
var i: shortint;
begin
  moveright(screen^[0{0, 0}],
	   screen^[screenwidth{1, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do screen^[i].wholeword := ord(' ');
end;

(*Insert test file RS232:RSWRITE here...RAM*)

function maptocrt(c:char):char;

const illegalchar = #223;
		     { char to disp for illegal internal codes; looks like hp }
procedure mapromextocrt;
const
      minromex = 168; { lookup table ranges }
      maxromex = 255;
type  romexsettype = set of minromex..maxromex;
const romexset = romexsettype [168..172,175,176,179,181..187,189,192..222,255];
							  { legal Romex codes }
begin
    if (ord(c) < 128) or (ord(c) in romexset) then
      maptocrt:=c   else maptocrt:=illegalchar;
end;


procedure mapkanatocrt ;

{ Converts Katakana codes to their correct CRT rom location codes; also,
  converts "illegal" Kana chars to the "hp" char.  Note that the Yen symbol
  overlays the USASCII backslash (\), and that code 255 is left unconverted. }


begin
    if ord(c) = yencode then maptocrt := chr(yenromlocation)
    else if (ord(c) < 128) or (ord(c) = 255) then maptocrt:= c
    else begin
      if (ord(c) < minkana) or (ord(c) > maxkana) then maptocrt := illegalchar
      else maptocrt := chr(kanatocrtlookup[ord(c)]);
    end;
end; { mapkanatocrt }

begin
  if kbdlangjumper.jlang = katakana then mapkanatocrt
  else mapromextocrt;
end;

procedure crtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
var c: char;
    s: string[1];
    buf: charptr;
    d,e : INTEGER;
begin
  myisc := unitable^[fp^.funit].sc;
  IF internal_console AND (myisc=0)
    THEN BEGIN
      ioresult := ord(inoerror);
      buf := addr(buffer);
      case request of
       {uwait: ;              }
       setcursor: gotoxy(fp^.fxpos, fp^.fypos);
       getcursor: getxy (fp^.fxpos, fp^.fypos);
       flush:  {do nothing};
       unitstatus:  kbdio(fp, request, buffer, length, position);
       clearunit: highlight := defaulthighlight;
       readtoeol:
	 begin
	 buf := addr(buf^, 1);
	 buffer[0] := chr(0);
	 while length>0 do
	   begin
	   kbdio(fp, readtoeol,  s, 1, 0);
	   if      strlen(s)=0     then length := 0
	 { else if s[1] = chr(etx) then length := 0 }
	   else  begin
		 length := length - 1;
		 crtio(fp, writebytes, s[1], 1, 0);
		 buf := addr(buf^, 1);
		 buffer[0] := chr(ord(buffer[0])+1);
		 end;
	   end;
	 end;
       startread,
       readbytes:
	 begin
	 while length>0 do
	   begin
	   kbdio(fp, readbytes,  buf^, 1, 0);
	   if buf^ = chr(etx) then length := 0
			      else length := length - 1;
	   if buf^ = eol then crtio(fp, writeeol,   buf^, 1, 0)
			 else crtio(fp, writebytes, buf^, 1, 0);
	   buf := addr(buf^, 1);
	   end;
	 if request = startread then call(fp^.feot, fp);
	 end;
       writeeol:   begin
		     if ypos=maxy then scrollup;
		     gotoxy(0, ypos+1);

     (*Insert test file RS232:RSWRITECR here...RAM*)

		   end;
       startwrite,
       writebytes:
	 begin
	 while length>0 do
	  begin
	    c:=buf^; buf:=addr(buf^,1); length:=length-1;

     (*Insert test file RS232:RSWRITEC here...RAM*)

	    case c of
	    homechar:   setxy(0,0);
	    leftchar:   if (xpos = 0) and (ypos>0) then setxy(maxx, ypos-1)
			else setxy(xpos-1, ypos);
	    rightchar:  if (xpos = maxx) and (ypos<maxy) then setxy(0, ypos+1)
			else setxy(xpos+1, ypos);
	    upchar:     begin if ypos <= 1  then scrolldown;
			      if ypos>0 then setxy(xpos, ypos-1);
			end;
	    downchar:   if ypos=maxy then scrollup
			else setxy(xpos, ypos+1);
	    bellchar:   beep;
	    cteos:     clear(screensize-(ypos*screenwidth+xpos));
	    cteol:     clear(screenwidth-xpos);
	    clearscr:  begin setxy(0,0); clear(screensize); end;
	    eol:       setxy(0, ypos);
	    chr(etx):   length:=0;
	    otherwise   if (ord(c)>=128) and (ord(c)< 144) then
			  if hascolor then
			    if ord(c) >= 136 then highlight :=
					 highlight mod 2048 + (ord(c)-136)*4096
			    else highlight :=
				    (highlight div 2048 * 8 + (ord(c)-128))*256
			  else highlight := (ord(c)-128)*256
			else with screen^[ypos*screenwidth+xpos] do
			  begin
			   wholeword:=highlight+ ord(maptocrt(c));
			   if xpos = maxx then
			     begin
			       if ypos = maxy then scrollup;
			       setxy(0, ypos+1);
			     end
			   else setxy(xpos+1, ypos);
			  end;
	    end;
	  updatecursor;
	  end; {while}
	 if request = startwrite then call(fp^.feot, fp);
	 end;
       otherwise ioresult := ord(ibadrequest);
      end; {case}
    END
    ELSE BEGIN
      IF (myisc>=0) AND (myisc<=7)
	THEN BEGIN
	  { 0 is default and 1..7 are not allowed }
	  myisc := console_isc;
	END
	ELSE BEGIN
	  { -isc and isc>7 allows a CTABLE entry
	     to override all of this garbage }
	  IF myisc < 0  THEN myisc := -myisc;
	  IF myisc > 31 THEN myisc := myisc MOD 32;
	END;
      ioresult := ORD(inoerror);
      buf := addr(buffer);
      CASE request OF

       setcursor:    BEGIN
		       gotoxy(fp^.fxpos, fp^.fypos);
		     END;

       getcursor:    BEGIN
		       getxy (fp^.fxpos, fp^.fypos);
		     END;

       flush:        BEGIN
		       myinit;
		     END;

       unitstatus:   BEGIN
			kbdio(fp, unitstatus,buffer,length,position);
		     END;

       clearunit:    BEGIN
		       myinit;
		     END;

       readtoeol:    BEGIN
		       buf := addr(buf^, 1);
		       buffer[0] := CHR(0);
		       WHILE length>0 DO BEGIN
			 kbdio(fp, readtoeol,  s, 1, 0);
			 IF  STRLEN(s)=0
			   THEN BEGIN
			     length := 0
			   END
			   ELSE BEGIN
			     length := length - 1;
			     crtio(fp, writebytes, s[1], 1, 0);
			     buf := addr(buf^, 1);
			     buffer[0] := CHR(ORD(buffer[0])+1);
			   END; { of IF }
		       END;     { of WHILE DO BEGIN }
		     END;       { of BEGIN }

       startread,
       readbytes:    BEGIN
		       while length>0 DO
			 BEGIN
			 kbdio(fp, readbytes,  buf^, 1, 0);
			 IF buf^ = CHR(etx) THEN length := 0
					    ELSE length := length - 1;
			 IF buf^ = eol THEN crtio(fp, writeeol,   buf^, 1, 0)
				       ELSE crtio(fp, writebytes, buf^, 1, 0);
			 buf := addr(buf^, 1);
			 END;
		       IF request = startread THEN call(fp^.feot, fp);
		       END;

       writeeol:     BEGIN
		       IF ypos=maxy THEN BEGIN out(CHR(esc));
					       out('S');   { scroll up 1 line }
					 END;
		       gotoxy(0, ypos+1);
		     END;

       startwrite,
       writebytes:   BEGIN
		       WHILE length>0 DO BEGIN
			 c:=buf^; buf:=addr(buf^,1); length:=length-1;
			 CASE c OF

			   homechar: BEGIN
				       setxy(0,0);
				     END;

			   leftchar: BEGIN
				       out(CHR(bs));
				     END;

			   rightchar:BEGIN
				       getxy(d,e);
				       IF (xpos = maxx) and (ypos<maxy)
					 THEN setxy(0, ypos+1)
					 ELSE setxy(xpos+1, ypos);
				     END;

			   upchar:   BEGIN
				       IF (ypos<=1)
					 THEN BEGIN
					   out(CHR(esc));
					   out('L');      { insert line }
					 END;
				       IF (ypos>0)
					 THEN BEGIN
					   { out(CHR(esc));
					   out('A'); }
					   setxy(xpos,ypos-1);
					 END;
				     END;

			   downchar: BEGIN
				       IF (ypos=maxy)
					 THEN BEGIN
					   out(CHR(esc));
					   out('S');      { scroll up 1 line }
					 END
					 ELSE BEGIN
					   { out(CHR(esc));
					   out('B'); }
					   setxy(xpos,ypos+1);
					 END;
				     END;

			   bellchar: BEGIN
				       localbeep;
				     END;

			   cteos:   BEGIN
				      out(CHR(esc));
				      out('J');
				    END;

			   cteol:   BEGIN
				      out(CHR(esc));
				      out('K');
				    END;

			   clearscr:BEGIN
				      setxy(0,0);
				      out(CHR(esc));
				      out('J');
				    END;

			   eol:      BEGIN
				       out(CHR(cr));
				       out(CHR(lf));
				     END;

			   CHR(etx): BEGIN
				       length:=0;
				     END;

			   OTHERWISE BEGIN
				       out(c);
				       IF xpos = maxx
					 THEN BEGIN
					   IF ypos = maxy
					     THEN BEGIN
					       out(CHR(esc));
					       out('S');   { scroll up 1 line }
					     END;
					   setxy(0,ypos+1);
					 END
					 ELSE BEGIN
					   { setxy(xpos+1,ypos); }
					   xpos := xpos + 1;
					 END; { of IF }
				     END;

			 END; { of CASE c OF }
			 updatecursor;
		       END; { of WHILE DO BEGIN }
		       IF request = startwrite THEN call(fp^.feot, fp);
		     END; { of startwrite, writebytes case }

       OTHERWISE     BEGIN
		       ioresult := ORD(ibadrequest);
		     END;

      END; { of CASE request OF }
    END;
end;


PROCEDURE dummyproc;
BEGIN
END;


procedure crtinit;
 var cursaddr: crtcmdwrd; i,k: integer;
 begin
 IF internal_console
    THEN BEGIN
      with syscom^.crtinfo do
	 begin
	 screen:=anyptr(crtmemaddr);
	 screenwidth:=width;
	 screenheight:=height;
	 maxx:=width-1;
	 maxy:=height-1;
	 screensize:=width*height;

	 for i:=0 to screensize-1
		  do screen^[i].wholeword:=ord(' ');  {clear screen}
	 pm6845addrreg:=anyptr(crtcontroladdr);
	 pm6845comdreg:=anyptr(crtcontroladdr+2);
	 cursaddr.longword:=integer(screen) mod 8192 div 2;
	 cursaddr.textfield:=alphastate;
	 cursaddr.softfield:=alphastate;
	 crtcommand(12, cursaddr.topbyte);
	 crtcommand(13, cursaddr.botbyte);
	 defaulthighlight := 0; highlight := 0;
	 if sysflag.crtconfigreg then hascolor := crtidreg.colorinfo > cinfo0
				 else hascolor := false;
	 if changehardware then for k := 0 to 11 do crtcommand(k,crtcon[k]);
	 gotoxy(0,0);
	 dumpalphahook := dumpa;
	 dumpgraphicshook := dumpg;
	 togglealphahook := togglea;
	 togglegraphicshook := toggleg;
	 end;
    END
    ELSE BEGIN
      WITH syscom^.crtinfo DO BEGIN
	screen     :=NIL;
	screenwidth:=width;
	screenheight:=height;
	screensize :=width*height;
	maxx       :=width-1;
	maxy       :=height-1;
	xpos       :=0;
	ypos       :=0;
	defaulthighlight := 0;
	dumpalphahook    := dummyproc;
	dumpgraphicshook := dummyproc;
	togglealphahook  := dummyproc;
	togglegraphicshook := dummyproc;
	ALPHASTATE := TRUE;
      END; { of WITH DO BEGIN }
    END;
 end;

end;

import crt, loader;

begin
  crtinit;
  markuser;
end.



.resume
.need 55
.suspend
					       (*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)

(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)


$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$
$SEARCH  'KBD','FINDC'$

program initbat(OUTPUT);

module bat;
import sysglobals, kbd, FINDC;
export
var batterypresent[-563]: boolean;

    procedure batcommand(cmd:byte; numdata:integer; b1, b2, b3, b4, b5: byte);
    function  batbytereceived:byte;
    procedure batinit;

implement

var bat8041statusreg[4554785 { 458001 } ]: char;
    bat8041cmdreg   [4554785 { 458001 } ]: char;
    bat8041datareg  [4554753 { 458021 } ]: char;

procedure wait4batready;
var batstatus: stat8041;
begin
  IF internal_console
    THEN BEGIN
      repeat
	batstatus.statchar:=bat8041statusreg;
      until not batstatus.busy;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure wait4batreadready;
var batstatus: stat8041;
begin
  IF internal_console
    THEN BEGIN
      repeat
	batstatus.statchar:=bat8041statusreg;
      until batstatus.readready;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;


procedure batcommand(cmd: byte; numdata: integer; b1, b2, b3, b4, b5: byte);

  procedure batdataout(d: byte);
  begin wait4batready; bat8041datareg := chr(d); end;

begin
  IF internal_console
    THEN BEGIN
      if batterypresent then
	begin
	wait4batready;
	bat8041cmdreg := chr(cmd);
	if numdata >= 1 then batdataout(b1);
	if numdata >= 2 then batdataout(b2);
	if numdata >= 3 then batdataout(b3);
	if numdata >= 4 then batdataout(b4);
	if numdata >= 5 then batdataout(b5);
	end;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

function batbytereceived:byte;
begin
  IF internal_console
    THEN BEGIN
      wait4batreadready;
      batbytereceived:=ord(bat8041datareg);
    END
    ELSE BEGIN
      batbytereceived:=0;   { return dummy byte }
    END;
end;

procedure batinit;
begin
  IF internal_console
    THEN BEGIN
      batcommand(167,2,23,112,0,0,0); {set power fail to 60 seconds}
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

end;

import bat, loader;

begin
  batinit;
  markuser;
end.


.resume
.need 55
.suspend
(*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)


(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)



$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'KBD','BAT','FINDC'$

program clockinit;

module clock;
import sysglobals, asm, misc, kbd, bat, FINDC;
export
  type
  rtctime = packed record
	       packedtime,packeddate:integer;
	    end;

  function  sysclock: integer;   {centiseconds from midnight}
  procedure sysdate (var thedate: daterec);
  procedure systime (var thetime: timerec);
  procedure setsysdate ( thedate: daterec);
  procedure setsystime ( thetime: timerec);
  procedure initclock;

implement

type trickint = packed record
		   case integer of
		0: ( ipart: integer );
		1: ( byte3: byte;
		     byte2: byte;
		     byte1: byte;
		     byte0: byte  )
	       end;
var  boottype[-576]: shortint;

procedure readtime (var thetime: rtctime);
const
  cmmd31=49;                   {31 hex to load timer output buffer with time}
  cmmd13=19;                   {13 hex to load data buffer with first byte}
  cmmd14=20;                   {14 hex to load data buffer with second byte}
  cmmd15=21;                   {15 hex to load data buffer with third  byte}
  cmmd16=22;                   {16 hex to load data buffer with fourth byte}
  cmmd17=23;                   {17 hex to load data buffer with fifth  byte}
var
  t: trickint;
begin
IF internal_console
    THEN BEGIN
      with t do
	begin
	  lockup;
	  ipart := 0;
	  kbdcommand(cmmd31,0,0,0,0);
	  kbdcommand(cmmd13,0,0,0,0);  byte0 := read8041byte;
	  kbdcommand(cmmd14,0,0,0,0);  byte1 := read8041byte;
	  kbdcommand(cmmd15,0,0,0,0);  byte2 := read8041byte;
	  thetime.packedtime := ipart;
	  ipart := 0;
	  kbdcommand(cmmd16,0,0,0,0);  byte0 := read8041byte;
	  kbdcommand(cmmd17,0,0,0,0);  byte1 := read8041byte;
	  thetime.packeddate := ipart;
	  lockdown;
	end;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure sysdate(var thedate: daterec);
var yr,dd,mm,k,k1,k2: integer;
    ltime:  rtctime;
begin
IF internal_console
    THEN BEGIN
      readtime(ltime);
      k:=ltime.packeddate+1;
      k1:= k*4-1;
      yr:= k1 div 1461;
      dd:= (k1-(1461*yr)+4) div 4;
      k2:=(5*dd-3);
      mm:=k2 div 153;
      dd:=k2-153*mm;
      dd:=(dd+5) div 5;
      if  mm<10 then mm:=mm+3
      else
	begin mm:=mm-9;yr:=yr+1; end;
      with thedate do
	begin
	  {LAF 880101 year range is now 0..127}
	  {year:=yr mod 100;{to protect our file}
	  month:=mm;
	  day:=dd;
	end;
    END
    ELSE BEGIN
      WITH THEDATE DO
	BEGIN
	  YEAR:=00;
	  MONTH:=01;
	  DAY:=01;
	END;
    END;
end;

function sysclock: integer;
var ltime: rtctime;
begin
IF internal_console
    THEN BEGIN
      readtime(ltime);
      sysclock := ltime.packedtime;
    END
    ELSE BEGIN
      sysclock := 0;
    END;
end;

procedure systime(var thetime: timerec);
var t: integer;
begin
IF internal_console
    THEN BEGIN
      t:=sysclock mod (24*360000);
      with thetime do
	begin
	  hour := t div 360000;
	  minute := (t-(hour*360000)) div 6000;
	  centisecond := t mod 6000;
	end;
    END
    ELSE BEGIN
      WITH THETIME DO
	BEGIN
	  HOUR        := 00;
	  MINUTE      := 00;
	  CENTISECOND := 0000;
	END;
    END;
end;

procedure setrtctime(thetime: rtctime);
const
  cmmdb7=183;
  cmmd40=64;
  cmmdad=173;          {AD hex is the command to set the time of day}
  cmmdaf=175;          {AF hex is the command to set the day portion of time}
var
  t1,t2: trickint;
begin
IF internal_console
    THEN BEGIN
      t1.ipart := thetime.packeddate;
      t2.ipart := thetime.packedtime;
      kbdcommand(cmmdad,3,t2.byte0,t2.byte1,t2.byte2);
      kbdcommand(cmmdaf,2,t1.byte0,t1.byte1,0);
      batcommand(cmmdb7,5,t1.byte1,t1.byte0,t2.byte2,t2.byte1,t2.byte0);
      batcommand(cmmd40,0,0,0,0,0,0);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure setsysdate(thedate: daterec);
var   ltime: rtctime;  yr,mth,dy: integer;
begin
IF internal_console
    THEN BEGIN
      readtime(ltime);
      with ltime,thedate do
	begin
	  yr := year;  mth := month;  dy := day;
	  if mth>2 then mth:=mth-3
		   else begin  mth:=mth+9; yr:=yr-1; end;
	  packeddate:=((1461* yr) div 4 +(153*mth+2) div 5)+dy-1;
	end;
      setrtctime(ltime);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure setsystime(thetime: timerec);
var   ltime: rtctime;  hr,min,ctsec: integer;
begin
IF internal_console
    THEN BEGIN
      readtime(ltime);
      with ltime, thetime do
	begin
	  hr := hour;  min := minute;  ctsec := centisecond;
	  packedtime:=((hr*3600)+min*60)*100+ctsec;
	end;
      setrtctime(ltime);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure inittime;
var thetime:rtctime;
const
  cmmd41=65;                    {65 hex to load timer output buffer with time}
  cmmdf7=247;                   {F7 hex to load data buffer with first byte}
  cmmdf6=246;                   {F6 hex to load data buffer with second byte}
  cmmdf5=245;                   {F5 hex to load data buffer with third  byte}
  cmmdf4=244;                   {F4 hex to load data buffer with fourth byte}
  cmmdf3=243;                   {F3 hex to load data buffer with fifth  byte}
  cmmdf2=242;                   {F2 hex to load a letter 'B',or'P', or'H' for
					 Basic, or Pascal, or HPL respectively}
var  t: trickint;
begin
IF internal_console
    THEN BEGIN
      thetime.packedtime := 0;
      thetime.packeddate := 0;
      if batterypresent then
       with t do
	begin
	setintlevel(2);

	ipart := 0;
	batcommand(cmmd41,0,0,0,0,0,0);
	batcommand(cmmdf7,0,0,0,0,0,0);   byte1 := batbytereceived;
	batcommand(cmmdf6,0,0,0,0,0,0);   byte0 := batbytereceived;
	thetime.packeddate := ipart;

	ipart := 0;
	batcommand(cmmdf5,0,0,0,0,0,0);   byte2 := batbytereceived;
	batcommand(cmmdf4,0,0,0,0,0,0);   byte1 := batbytereceived;
	batcommand(cmmdf3,0,0,0,0,0,0);   byte0 := batbytereceived;
	thetime.packedtime := ipart;

	setintlevel(0);{lower cpu int level}
	end;
      setrtctime(thetime);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure initclock;
begin
IF internal_console
    THEN BEGIN
      if boottype = 0 {powerup} then inittime;
      boottype := 18;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

end;

import clock, loader;

begin
  initclock;
  markuser;
end.

.newpage
.3
Internals approach


This second example is the 'internals' approach.  This approach
allows you to configure your console exactly as you want.  The
drawbacks are that it is more complicated to understand and unless
you put in the effort, it will be less flexable.  It is smaller in
memory requirements.

There are two main approaches to putting in this type of remote
console driver.  The first is to merely add two new modules to the
console part of INITLIB.  This has the advantage of still allowing
some Series 200 interaction on the normal keyboard.  The other
approach is to replace part of the console modules with new
drivers. This approach has the advantage of being less code in
INITLIB but it does not allow ANY use of the normal keyboard.



.4
Steps to Modify Drivers

There are a specific set of operations that need to happen to
create a Pascal system with a remote console.  These steps are:

.step 1
BACK UP

Back up your BOOT disk and your CTABLE source.

.step 2
CREATE NEW DRIVERS

Create a remote console (input and output) set of access modules
(via the EDITOR and COMPILER). These modules correspond to the
KEYS and CRT modules that contain the routines KBDIO and CRTIO.

.step 3
INSTALL DRIVERS IN INITLIB

Install these modules in INITLIB on your boot disk (via the
LIBRARIAN).  The modules can either be added to the existing
INITLIB modules or they can replace the current modules (i.e.
KEYS and CRT).

.suspend
   module       purpose                                 normally
							requires
   -------------------------------------------------------------

   KBD          fundamental support of the
		'keyboard' 8041 uP including
		interrupt handling

   KEYS         support of the keyboard part            KBD
		of the keyboard

   CRT          support of the CRT                      KBD,KEYS

   BAT          support of the battery                  KBD
		part of the 'keyboard'

   CLOCK        support of the timers                   KBD
		part of the 'keyboard'

.resume

.step 4
MODIFY CTABLE

Change the TABLE file on your boot disk to make use of these new
modules.  This is done by editing CTABLE and compiling it and then
copying the object file onto the TABLE file on the boot disk.

.need 7
.step 5
ADD MISCINFO TO BOOT

Change the system information about the console device with a
MISCINFO file.  This is done by compiling and running the MISCINFO
program.  This program will put a MISCINFO data file onto the boot
disk.
.exit

.4
Unusual Aspects

There is a strange aspect of the 'internals' approach drivers
relates to CTABLE and INITUNITS.  Before TABLE has had a chance to
execute, messages are written to the CRT.  The module INITUNITS
initializes a minimum TABLE (CTABLE) to handle the definitions.  It
would be possible to change this module to specify the correct
interface.  In the example drivers a different approach was taken.
The default TABLE (CTABLE) and INITUNITS specifies a select code of
0 for the CONSOLE and SYSTERM devices.  The example drivers make
use of this and the fact that external interface cards can only be
on select codes of 8 and above.  The code contains a line:

|C   IF myisc <= 7 THEN myisc := 20;|A

This line will re-direct the I/O to select code 20.  If you think
about this for a bit, you will notice that you do not need to
change CTABLE unless you are going to use more than one device as
a remote volume.


.4
Modifying CTABLE

The CTABLE file needs to be modified to allow the remote console to
work.  The normal CTABLE (as shipped with the default system) will
specify where the default CONSOLE and SYSTERM volumes exist and
what type of units they are.

The CTABLE changes to allow for the addition of the new remote
console drivers look like the following:

.suspend
   procedure tea_crt(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM',
	   'REMC_CRTIO',                       { change drv }
	   21,                                 { change isc }
	   0,0,0,0,0,'CONSOLE',#0,T,T,F,0);
     end;

   procedure tea_kbd(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM',
	   'REMK_KBDIO',                       { change drv }
	   21,                                 { change isc }
	   0,0,0,0,0,'SYSTERM',#0,F,T,F,0);
     end;

.resume
The CTABLE changes to allow for the replacement of the remote
console drivers look like the following:

.suspend
   procedure tea_crt(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM','CRT_CRTIO',
	   21,                                 { change isc }
	   0,0,0,0,0,'CONSOLE',#0,T,T,F,0);
     end;


   procedure tea_kbd(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM',
	   'KEYS_KBDIO',
	   21,                                 { change isc }
	   0,0,0,0,0,'SYSTERM',#0,F,T,F,0);
     end;

.resume

The CTABLE also has an alternate field that can be used for
optional paramters (like baud rate or whatever).  The alternate
parameter is the parameter right before the volume name (e.g.
'SYSTERM').

The approach taken with the remote console is such that these
drivers can be used with other volumes in the system.  Whether or
not you wish to use the drivers as a remote console, it is possible
to use the new KEYS and CRT modules as a general remote interface.
Once the modules are placed in INITLIB, add the volumes to CTABLE
source (and TABLE object file on the boot device).


.4
Add MISCINFO to BOOT

The MISCINFO file needs to exist and specify an external CRT. Refer
to the section on MISCINFO for more information.



.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installkbd;

MODULE kbd;

IMPORT sysglobals,asm,bootdammodule,isr,misc;

EXPORT
  TYPE

  crtconsttype = PACKED ARRAY [0..11] of BYTE;

  CRTFREC = PACKED RECORD
	       NOBREAK,STUPID,SLOWTERM,HASXYCRT,
	       HASLCCRT{built in crt},HASCLOCK,
	       canupscroll,candownscroll      :    BOOLEAN;
	     END;

  B9 = PACKED ARRAY[0..8]  OF BOOLEAN;
  B14= PACKED ARRAY[0..13] OF BOOLEAN;
  CRTCREC = PACKED RECORD         (* CRT CONTROL CHARS *)
	       RLF,NDFS,ERASEEOL,
	       ERASEEOS,HOME,
	       ESCAPE             : CHAR;
	       BACKSPACE          : CHAR;
	       FILLCOUNT          : 0..255;
	       CLEARSCREEN,
	       CLEARLINE          : CHAR;
	       PREFIXED           : B9
	    END;

  CRTIREC = PACKED RECORD        (* CRT INFO & INPUT CHARS *)
	       WIDTH,HEIGHT      : shortint;
	       crtmemaddr,crtcontroladdr,
	       keybufferaddr,progstateinfoaddr:INTEGER;
	       keybuffersize: shortint;
	       crtcon            : crtconsttype;
	       RIGHT,LEFT,DOWN,UP: CHAR;
	       BADCH,CHARDEL,STOP,
	       BREAK,FLUSH,EOF   : CHAR;
	       ALTMODE,LINEDEL   : CHAR;
	       BACKSPACE,
	       ETX,PREFIX        : CHAR;
	       PREFIXED          : B14 ;
	       CURSORMASK        : INTEGER;
	       SPARE             : INTEGER;
	    END;

  ENVIRON = RECORD
	      MISCINFO: CRTFREC;
	      CRTTYPE:  INTEGER;
	      CRTCTRL:  CRTCREC;
	      CRTINFO:  CRTIREC;
	    END;

    stat8041 = PACKED RECORD
		 case INTEGER of
	       0: (pad1:     0..63;
		   busy:     BOOLEAN;
		   readready:BOOLEAN);
	       1: (statchar: CHAR);
	       END;
    crtword=   RECORD case INTEGER of
		 1:(highlightbyte,character:CHAR;);
		 2:(wholeword: shortint);
	       END;
    kbdhooktype = PROCEDURE(VAR statbyte,databyte: BYTE;
			    VAR dokey: BOOLEAN);

    timerhooktype = PROCEDURE(statbyte,databyte: BYTE;
			      VAR dotimer: BOOLEAN);

    keybuffertype= ARRAY[0..maxint] of crtword;

VAR

    SYSCOM: ^ENVIRON;
    changehardware: BOOLEAN;
    progstateinfo:^keybuffertype;

    ALPHASTATE['ALPHAFLAG']:BOOLEAN;
    GRAPHICSTATE['GRAPHICSFLAG']:BOOLEAN;

    kbdhook: kbdhooktype;
    timerhook: timerhooktype;
    dumpalphahook: PROCEDURE;
    dumpgraphicshook: PROCEDURE;
    togglealphahook: PROCEDURE;
    togglegraphicshook: PROCEDURE;

    kbeepfreq, kbeepdur : BYTE;

    PROCEDURE beep;
    PROCEDURE beeper(frequency,duration : BYTE);

    PROCEDURE kbdinit;
    PROCEDURE lockedaction(a: action);

    PROCEDURE kbdcommand(cmd        : BYTE;
			 numdata    : INTEGER;
			 b1, b2, b3 : BYTE);
    FUNCTION read8041byte : BYTE;

IMPLEMENT


CONST
  B9826INFO=CRTIREC[
	   WIDTH             : 80,HEIGHT:24,
	   crtmemaddr        : 5316608,
	   crtcontroladdr    : 5341185,
	   keybufferaddr     : 5320448,
	   progstateinfoaddr : 5320592,
	   keybuffersize     : 72,
	   crtcon            : crtconsttype [114,80,76,7,
					     26,10,25,25,
					     0,14,76,13],
	   RIGHT{FS}         : CHR(28),
	   LEFT{BS}          : CHR(8),
	   DOWN{LF}          : CHR(10),
	   UP{US}            : CHR(31),
	   BADCH{?}          : CHR(63),
	   CHARDEL{BS}       : CHR(8),
	   STOP{DC3}         : CHR(19),
	   BREAK{DLE}        : CHR(16),
	   FLUSH{ACK}        : CHR(6),
	   EOF{ETX}          : CHR(3),
	   ALTMODE{ESC}      : CHR(27),
	   LINEDEL{DEL}      : CHR(127),
	   BACKSPACE{BS}     : CHR(8),
	   ETX               : CHR(3),
	   PREFIX            : CHR(0),
	   PREFIXED          : B14[14 OF FALSE],
	   CURSORMASK        : 0,
	   SPARE             : 0];


CONST
  ENVIRONC=ENVIRON[MISCINFO:CRTFREC[
			    NOBREAK  : FALSE,
			    STUPID   : FALSE,
			    SLOWTERM : FALSE,
			    HASXYCRT : TRUE,
			    HASLCCRT : TRUE,  {?}
			    HASCLOCK : TRUE,
			    canupscroll   : TRUE,
			    candownscroll : TRUE],
		   CRTTYPE:0,
		   CRTCTRL : CRTCREC[
			    RLF      : CHR(31),
			    NDFS     : CHR(28),
			    ERASEEOL : CHR(9),
			    ERASEEOS : CHR(11),
			    HOME     : CHR(1),
			    ESCAPE   : CHR(0),
			    BACKSPACE: CHR(8),
			    FILLCOUNT: 10,
			    CLEARSCREEN:   CHR(0),
			    CLEARLINE:     CHR(0),
			    PREFIXED : B9[9 OF FALSE]],
		    CRTINFO : CRTIREC [
			    WIDTH            : 50,
			    HEIGHT           : 24,
			    crtmemaddr       : 5316608,
			    crtcontroladdr   : 5308417,
			    keybufferaddr    : 5319008,
			    progstateinfoaddr: 5319092,
			    keybuffersize    : 42,
			    crtcon: crtconsttype [64,50,49,10,25,9,
						  25,25,0,11,74,11],
			    RIGHT{FS}        : CHR(28),
			    LEFT{BS}         : CHR(8),
			    DOWN{LF}         : CHR(10),
			    UP{US}           : CHR(31),
			    BADCH{?}         : CHR(63),
			    CHARDEL{BS}      : CHR(8),
			    STOP{DC3}        : CHR(19),
			    BREAK{DLE}       : CHR(16),
			    FLUSH{ACK}       : CHR(6),
			    EOF{ETX}         : CHR(3),
			    ALTMODE{ESC}     : CHR(27),
			    LINEDEL{DEL}     : CHR(127),
			    BACKSPACE{BS}    : CHR(8),
			    ETX              : CHR(3),
			    PREFIX           : CHR(0),
			    PREFIXED         : B14[14 OF FALSE],
			    CURSORMASK       : 0,
			    SPARE            : 0]];


PROCEDURE lockedaction(a: action);
label 1;
VAR i: INTEGER;
BEGIN
 IF locklevel = 0 THEN call(a)
 ELSE
   BEGIN
   i := actionspending;
   WHILE i>0 DO IF deferredaction[i]=a THEN goto 1 ELSE i := i - 1;
   IF actionspending = 10 THEN beep
   ELSE BEGIN
	actionspending := actionspending + 1;
	deferredaction[actionspending] := a;
	END;
   END;
1:
END;

FUNCTION read8041byte:BYTE;
BEGIN
  read8041byte:=0;
END;

PROCEDURE wait4kbdready;
BEGIN
END;

PROCEDURE kbdcommand(cmd        : BYTE;
		     numdata    : INTEGER;
		     b1, b2, b3 : BYTE);
BEGIN
END;

PROCEDURE beep;
BEGIN
END;

PROCEDURE beeper(frequency,duration : BYTE);
BEGIN
END;



PROCEDURE dummykbdhook(VAR stat, data: BYTE;
		       VAR doit: BOOLEAN);
BEGIN
END;

PROCEDURE dummytimerhook(stat, data: BYTE;
			 VAR doit: BOOLEAN);
BEGIN
END;


PROCEDURE INITSYSCOM;
VAR f: file of ENVIRON;
    dcrtinfo['dcrtinfo']: anyptr;
BEGIN
NEW(SYSCOM);  SYSCOM^ := ENVIRONC;
WITH syscom^ DO
  BEGIN
  IF not sysflag.alpha50 THEN crtinfo := B9826info;
  RESET(F, NODESTR+'MISCINFO','shared');
  IF IORESULT = ORD(INOERROR) THEN READ(F, SYSCOM^);
  changehardware := IORESULT = ORD(INOERROR);
  dcrtinfo := ADDR(crtinfo);
  END;
END; {INITSYSCOM}

PROCEDURE kbdinit;
BEGIN
  kbdhook := dummykbdhook;
  timerhook := dummytimerhook;
  initsyscom;
END;  {kbdinit}

END;    { of module }


IMPORT kbd;

BEGIN
  kbdinit;
END.

.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installkeys;

MODULE keys;
IMPORT sysglobals,asm,misc,kbd, iodeclarations,general_0,iocomasm;

EXPORT
  CONST
    yencode = 92; { Yen symbol overlays USASCII
		    backslash (\) in Kana machines }

  TYPE
    langtype = (gringo,french,german,swedish{,finnish},
		spanish,katakana);

  VAR
    kbdlangjumper: RECORD CASE BYTE of
		     0: (b:PACKED RECORD
			     dummy,jnum:BYTE
			   END);
		     1: (jlang:langtype); {16 bit}
		   END;
    kbdwaithook         : PROCEDURE;
    kbdreleasehook      : PROCEDURE;

    keybuffer           : ^keybuffertype;
    keybufsize          : shortint;
    keybuflength        : shortint;
    capslock            : BOOLEAN;
    kanaflag            : BOOLEAN;

  PROCEDURE kbdio (     fp              : fibp;
			request         : amrequesttype;
			ANYVAR buffer   : window;
			length          : INTEGER ;
			position        : INTEGER);
  PROCEDURE initkeys;

IMPLEMENT


  VAR  eol_lying_around : PACKED ARRAY[type_isc] OF BOOLEAN;
       myisc            : shortint;

       newdrivers       : drv_table_type;




{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset(mytemp : ANYPTR);
BEGIN
  { do nothing so that the configuration stays the same }
END;




PROCEDURE myinit;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN iocontrol(myisc,28,0);               { no EOL characters }
  iocontrol(myisc,12,1);                      { connect the card  }

  newdrivers := isc_table[myisc].io_drv_ptr^; { copy card dvrs    }
  newdrivers.iod_init := new_reset;           { put in new reset  }
  isc_table[myisc].io_drv_ptr := ADDR(newdrivers); { install drvs }
END;


FUNCTION inchar : CHAR;
VAR     x       : CHAR;
BEGIN
  IF eol_lying_around[myisc]
    THEN BEGIN
      inchar := eol;
      eol_lying_around[myisc] := FALSE;
    END
    ELSE BEGIN
      WITH isc_table[myisc] DO
      CALL (io_drv_ptr^.iod_rdb ,
	     io_tmp_ptr ,
	     x);
      inchar:=x;
    END;
END;




FUNCTION kbdbusy : BOOLEAN;
VAR     x       : INTEGER;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
      { check inbound queue for data }
      x:=iostatus(myisc,5);
      IF (x=1) OR (x=3) OR eol_lying_around[myisc]
	THEN kbdbusy:=FALSE
	ELSE kbdbusy:=TRUE;
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
      x:=iostatus(myisc,10);
      { check character buffer for data }
      IF bit_set(x,0) OR eol_lying_around[myisc]
	THEN kbdbusy:=FALSE
	ELSE kbdbusy:=TRUE;
    END;
END;




PROCEDURE kbdio (       fp              : fibp;
			request         : amrequesttype;
			ANYVAR buffer   : window;
			length          : INTEGER ;
			position        : INTEGER);

VAR   buf               : charptr;
BEGIN
 myisc := unitable^[fp^.funit].sc;
 IF myisc <= 7 THEN myisc := 20;
 ioresult := ORD(inoerror);
 buf := ADDR(buffer);
 CASE request OF

   flush:       BEGIN
		  myinit;
		END;

   unitstatus:  BEGIN
		  fp^.fbusy := kbdbusy  ;
		END;

   clearunit:   BEGIN
		  myinit;
		END;

   readtoeol,
   readbytes,
   startread:   BEGIN
		  IF request = readtoeol
		    THEN BEGIN
		      { the buffer is a string, so set it to empty }
		      buf := ADDR(buf^, 1);
		      buffer[0] := chr(0);
		    END;
		  WHILE length>0 DO BEGIN
		    buf^ := inchar;
		    IF buf^ = chr(etx)
		      THEN length := 0
		      ELSE length := length-1;
		    IF (buf^=eol) and (request=readtoeol)
		      THEN BEGIN
			eol_lying_around[myisc] := TRUE;
			length := 0
		      END
		      ELSE BEGIN
			fp^.feoln := FALSE;
			buf := ADDR(buf^, 1);
			IF request = readtoeol
			  THEN buffer[0] := CHR(ORD(buffer[0])+1);
		      END;
		  END; { of WHILE DO }
		  IF request = startread THEN CALL(fp^.feot, fp);
		END;

   OTHERWISE    BEGIN
		  ioresult := ORD(ibadrequest);
		END;

 END; { of CASE }
END; { of PROCEDURE }




PROCEDURE dummyproc;
BEGIN
  { nothing }
END;




PROCEDURE initkeys;
VAR localisc  : shortint;
BEGIN
  FOR localisc := 0 TO 31 DO eol_lying_around[localisc] := FALSE;
  WITH syscom^.crtinfo DO BEGIN
    keybuffer:=NIL;
    keybufsize:=1;
    kanaflag:=FALSE;
    capslock:=TRUE;
  END;
END;

END;{ of module }


IMPORT keys;

BEGIN
  initkeys;
END.

.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installcrt;


MODULE crt;
IMPORT sysglobals,asm,misc,kbd,keys, iodeclarations,general_0 ;
EXPORT
  TYPE scrtype  = PACKED ARRAY[0..maxint] OF crtword;
       scrptr   = ^scrtype;

  VAR screenwidth       : shortint;
      screenheight      : shortint;
      maxx,maxy         : shortint;
      screensize        : shortint;
      xpos,ypos         : shortint;
      screen            : scrptr;
      defaulthighlight  : shortint;

  PROCEDURE crtinit;
  PROCEDURE crtio (    fp              : fibp;
			request         : amrequesttype;
			ANYVAR buffer   : window;
			length          : INTEGER;
			position        : INTEGER);

  PROCEDURE updatecursor;

  PROCEDURE setrunlight(x:CHAR);

IMPLEMENT


CONST dc1           = 17 ;
VAR   myisc         : shortint;
      newdrivers    : drv_table_type;




{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset(mytemp : ANYPTR);
BEGIN
  { do nothing so that the configuration stays the same }
END;






PROCEDURE myinit;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN iocontrol(myisc,28,0);               { no EOL characters }
  iocontrol(myisc,12,1);                      { connect the card  }

  newdrivers := isc_table[myisc].io_drv_ptr^; { copy card dvrs    }
  newdrivers.iod_init := new_reset;           { put in new reset  }
  isc_table[myisc].io_drv_ptr := ADDR(newdrivers); { install drvs }
END;




FUNCTION inchar : CHAR;
VAR  x          : CHAR;
BEGIN
  WITH isc_table[myisc] DO
  CALL (io_drv_ptr^.iod_rdb ,
	 io_tmp_ptr ,
	 x);
  inchar:=x;
END;

PROCEDURE out(x:CHAR);
BEGIN
  WITH isc_table[myisc] DO
  CALL (io_drv_ptr^.iod_wtb ,
	 io_tmp_ptr ,
	 x);
END;


PROCEDURE output(s    :io_STRING);
VAR i:INTEGER;
BEGIN
  FOR i:=1 to STRLEN(s) DO out(s[i]);
END;



PROCEDURE localbeep;
BEGIN
   out(CHR(7));        { send beep to card }
END;




PROCEDURE setrunlight(x:CHAR);
BEGIN
  { DO nothing at all but have an exported PROCEDURE }
END;



PROCEDURE updatecursor;
BEGIN
  { DO nothing at all but have an exported PROCEDURE }
END;

PROCEDURE getxy(VAR x,y: INTEGER);
VAR dummy : CHAR;
BEGIN
  x:=0;  y:=0;
  { go thru sequence to get actual position }
  out(CHR(esc));        out('`');       { send cursor sense abse   }
  out(CHR(dc1));                        { tell terminal I am ready }
  dummy := inchar;                      { get esc }
  dummy := inchar;                      { get &   }
  dummy := inchar;                      { get '   }
  x     := ORD(inchar)-48;              { get column digit 1 }
  x     := ORD(inchar)-48+x*10;         { get column digit 2 }
  x     := ORD(inchar)-48+x*10;         { get column digit 3 }
  dummy := inchar;                      { get c   }
  y     := ORD(inchar)-48;              { get row    digit 1 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 2 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 3 }
  dummy := inchar;                      { get Y   }
  dummy := inchar;                      { get cr  }

  xpos := x;      ypos := y;
END;

PROCEDURE setxy(x, y: shortint);
VAR s : string[9];
    p : INTEGER;
BEGIN
  IF x>=screenwidth  THEN xpos:=maxx
		     ELSE IF x<0 THEN xpos:=0
				 ELSE xpos := x;
  IF y>=screenheight THEN ypos:=maxy
		     ELSE IF y<0 THEN ypos:=0
				 ELSE ypos := y;

  { send xpos/ypos via escape esc & a xx y yy C }
  SETSTRLEN(s,9);
  STRWRITE (s,1,p,CHR(esc),'&a',ypos:2,'y',xpos:2,'C');
  output   (s);
END;


PROCEDURE gotoxy(x,y: INTEGER);
BEGIN
  setxy(x,y);
  updatecursor;
END;





PROCEDURE crtio (     fp              : fibp;
		      request         : amrequesttype;
		      ANYVAR buffer   : window;
		      length          : INTEGER;
		      position        : INTEGER);
VAR c   : CHAR;
    s   : STRING[1];
    buf : charptr;
    d,e : INTEGER;
BEGIN
 myisc := unitable^[fp^.funit].sc;
 IF myisc <= 7 THEN myisc := 20;
 ioresult := ORD(inoerror);
 buf := ADDR(buffer);
 CASE request OF

  setcursor:    BEGIN
		  gotoxy(fp^.fxpos, fp^.fypos);
		END;

  getcursor:    BEGIN
		  getxy (fp^.fxpos, fp^.fypos);
		END;

  flush:        BEGIN
		  myinit;
		END;

  unitstatus:   BEGIN
		   kbdio(fp, unitstatus,buffer,length,position);
		END;

  clearunit:    BEGIN
		  myinit;
		END;

  readtoeol:    BEGIN
		  buf := ADDR(buf^, 1);
		  buffer[0] := CHR(0);
		  WHILE length>0 DO BEGIN
		    kbdio(fp, readtoeol,  s, 1, 0);
		    IF  STRLEN(s)=0
		      THEN BEGIN
			length := 0
		      END
		      ELSE BEGIN
			length := length - 1;
			crtio(fp, writebytes, s[1], 1, 0);
			buf := ADDR(buf^, 1);
			buffer[0] := CHR(ORD(buffer[0])+1);
		      END; { of IF }
		  END;     { of WHILE DO BEGIN }
		END;       { of BEGIN }

  startread,
  readbytes:    BEGIN
		  WHILE length>0 DO
		    BEGIN
		    kbdio(fp, readbytes,  buf^, 1, 0);
		    IF buf^ = CHR(etx) THEN length := 0
				       ELSE length := length - 1;
		    IF buf^ = eol
		      THEN crtio(fp, writeeol,   buf^, 1, 0)
		      ELSE crtio(fp, writebytes, buf^, 1, 0);
		    buf := ADDR(buf^, 1);
		    END;
		  IF request = startread THEN call(fp^.feot, fp);
		  END;

  writeeol:     BEGIN
		  IF ypos=maxy
		    THEN BEGIN
		       out(CHR(esc));
		       out('S');             { scroll up 1 line }
		  END;
		  gotoxy(0, ypos+1);
		END;

  startwrite,
  writebytes:   BEGIN
		  WHILE length>0 DO BEGIN
		    c:=buf^; buf:=ADDR(buf^,1); length:=length-1;
		    CASE c OF

		      homechar: BEGIN
				  setxy(0,0);
				END;

		      leftchar: BEGIN
				  out(CHR(bs));
				END;

		      rightchar:BEGIN
				  getxy(d,e);
				  IF (xpos = maxx) and (ypos<maxy)
				    THEN setxy(0, ypos+1)
				    ELSE setxy(xpos+1, ypos);
				END;

		      upchar:   BEGIN
				  IF (ypos<=1)
				    THEN BEGIN
				      out(CHR(esc));
				      out('L');      { insert line }
				    END;
				  IF (ypos>0)
				    THEN BEGIN
				      { out(CHR(esc));
				      out('A'); }
				      setxy(xpos,ypos-1);
				    END;
				END;

		      downchar: BEGIN
				  IF (ypos=maxy)
				    THEN BEGIN
				      out(CHR(esc));
				      out('S'); { scroll up 1 line }
				    END
				    ELSE BEGIN
				      { out(CHR(esc));
				      out('B'); }
				      setxy(xpos,ypos+1);
				    END;
				END;

		      bellchar: BEGIN
				  localbeep;
				END;

		      cteos:   BEGIN
				 out(CHR(esc));
				 out('J');
			       END;

		      cteol:   BEGIN
				 out(CHR(esc));
				 out('K');
			       END;

		      clearscr:BEGIN
				 setxy(0,0);
				 out(CHR(esc));
				 out('J');
			       END;

		      eol:      BEGIN
				  out(CHR(cr));
				  out(CHR(lf));
				END;

		      CHR(etx): BEGIN
				  length:=0;
				END;

		      OTHERWISE BEGIN
				  out(c);
				  IF xpos = maxx
				    THEN BEGIN
				      IF ypos = maxy
					THEN BEGIN
					  out(CHR(esc));
					  out('S'); { scroll up 1 line }
					END;
				      setxy(0,ypos+1);
				    END
				    ELSE BEGIN
				      { setxy(xpos+1,ypos); }
				      xpos := xpos + 1;
				    END; { of IF }
				END;

		    END; { of CASE c OF }
		    updatecursor;
		  END; { of WHILE DO BEGIN }
		  IF request = startwrite THEN call(fp^.feot, fp);
		END; { of startwrite, writebytes case }

  OTHERWISE     BEGIN
		  ioresult := ORD(ibadrequest);
		END;

 END; { of CASE request OF }
END;  { of PROCEDURE crtio }



PROCEDURE dummyproc;
BEGIN
  { nothing }
END;



PROCEDURE crtinit;
 BEGIN
   WITH syscom^.crtinfo DO BEGIN
     screen     :=NIL;
     screenwidth:=width;
     screenheight:=height;
     screensize :=width*height;
     maxx       :=width-1;
     maxy       :=height-1;
     xpos       :=0;
     ypos       :=0;
     defaulthighlight := 0;
     dumpalphahook    := dummyproc;
     dumpgraphicshook := dummyproc;
     togglealphahook  := dummyproc;
     togglegraphicshook := dummyproc;
     ALPHASTATE := TRUE;
   END; { of WITH DO BEGIN }
 END;   { of PROCEDURE crtinit }

END;   { of MODULE crt }

IMPORT crt;

BEGIN
  crtinit;
END.

.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installbat;

MODULE bat;
IMPORT sysglobals, kbd;
EXPORT
VAR batterypresent[-563]: BOOLEAN;

    PROCEDURE batcommand(cmd                : BYTE;
			 numdata            : INTEGER;
			 b1, b2, b3, b4, b5 : BYTE);
    FUNCTION  batbytereceived:BYTE;
    PROCEDURE batinit;

IMPLEMENT



PROCEDURE batcommand(cmd                : BYTE;
		     numdata            : INTEGER;
		     b1, b2, b3, b4, b5 : BYTE);
BEGIN
END;

FUNCTION batbytereceived : BYTE;
BEGIN
  batbytereceived := 0;
END;

PROCEDURE batinit;
BEGIN
END;

END;  { of MODULE }

IMPORT bat;

BEGIN
  batinit;
END.


.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installclock;

MODULE clock;
IMPORT sysglobals, asm, kbd, bat;
EXPORT
  TYPE
  RTCTIME = PACKED RECORD
	       PACKEDTIME,PACKEDDATE:INTEGER;
	    END;

  FUNCTION  sysclock: INTEGER;   {centiseconds from midnight}
  PROCEDURE sysdate (VAR thedate: daterec);
  PROCEDURE systime (VAR thetime: timerec);
  PROCEDURE setsysdate (thedate: daterec);
  PROCEDURE setsystime (thetime: timerec);
  PROCEDURE initclock;

implement



PROCEDURE SYSDATE(VAR THEDATE: DATEREC);
BEGIN
  WITH THEDATE DO
    BEGIN
      YEAR:=00;
      MONTH:=01;
      DAY:=01;
    END;
END;

FUNCTION sysclock: INTEGER;
BEGIN
 sysclock := 0;
END;

PROCEDURE SYSTIME(VAR THETIME: TIMEREC);
BEGIN
  WITH THETIME DO
    BEGIN
      HOUR        := 00;
      MINUTE      := 00;
      CENTISECOND := 0000;
    END;
END;


PROCEDURE setsysdate(thedate: daterec);
BEGIN
END;

PROCEDURE setsystime(thetime: timerec);
BEGIN
END;

PROCEDURE inittime;
BEGIN
END;

PROCEDURE initclock;
BEGIN
END;

END;

IMPORT clock;

BEGIN
  initclock;
END.

.resume
.need 55

@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 4375
.2
Remote Console Driver


.3
Introduction


This section is intended to show, by example, how to replace the
system keyboard/crt drivers and install drivers for a remote
console.  Included are two functional examples by which you can
totally replace the existing console drivers with a remote console
on an HP terminal connected via an RS-232 interface (either the
98626 or 98628 interface).

The first example is the 'simpler' approach.  It supports the use
of both the remote console or built console use.  The use of a
remote console in this example is enabled by the use of the remote
console jumper, the lack of a built-in console, or by setting the
select code field in CTABLE.  This approach works well and is easy
to set up.  It also allows you to have the same boot files for a
variety of machines and configurations.  It does, however take
slightly more memory (and therefore boot disk space).

The second example is the 'internals' approach.  This approach
allows you to configure your console exactly as you want.  The
drawbacks are that it is more complicated to understand and unless
you put in the effort, it will be less flexable.  It is smaller in
memory requirements.

If you want to do something other than these sample approachs, you
should have familiarity with:

.step 1
KBD modules in INITLIB.
.step 2
Access methods.
.step 3
I/O drivers and their structure.
.step 4
CTABLE.
.step 5
MISCINFO.
.exit


Before you do ANYTHING discussed in this section be sure you make
back up copies of your BOOT disc (with INITLIB and TABLE) and of
your CTABLE source.

It is recommended that you use the 'simple' approach and do not use
the 'remote jumper'.  This will require you to change the console
select code in CTABLE.  It will, however, allow you to change back
and forth between consoles merely by executing a CTABLE and it will
also allow you to use the debugger.

.newpage
.3
Generic Information


.4
New/Modified Drivers

The existing keyboard/CRT modules are actually a set of 5 modules.
Each module is a separate program and exported module.  The program
part takes care of initializing the exported module.  The modules
are:

.suspend
   module       purpose                                 normally
							requires
   -------------------------------------------------------------

   KBD          fundamental support of the
		'keyboard' 8041 uP including
		interrupt handling

   KEYS         support of the keyboard part            KBD
		of the keyboard

   CRT          support of the CRT                      KBD,KEYS

   BAT          support of the battery                  KBD
		part of the 'keyboard'

   CLOCK        support of the timers                   KBD
		part of the 'keyboard'

.resume

If CLOCK and BAT are intended to work normally (and actually
function with clock and battery operations), then the KBD module
needs to be fully functional.  If battery and clock functions are
not necessary (or are provided by some other means), then almost
all of the modules could be replaced by dummy modules.  The
'internals' example at the end of this section shows the case where
all five modules have been replaced.



.4
Strange Aspects of the New Drivers

There are some aspects of the new KEYS and CRT modules that are a
little strange and need some explanation.  The first is the
EOL_LYING_AROUND array in the KEYS module.  The original code has
an operation called READTOEOL.  This operation is supposed to read
all characters from the keyboard up to but NOT INCLUDING the EOL
character (which is a carriage return).  In the original code,
there is a keyboard buffer that contains the characters. To read to
EOL with the buffer you just look into the buffer until you find an
EOL and back up one character.  It is very difficult to push a
character back into an interface.  To accommodate this, the remote
KEYS module will detect when a READTOEOL operation is in effect and
an EOL is encountered and then set a flag.  When the next input
operation occurs, it checks to see if the EOL_LYING_AROUND flag is
set.  The EOL_LYING_AROUND flag is an array so that you can use
these drivers for more than just the SYSTERM and CONSOLE volumes of
the system.

The second strange aspect of the code is the NEWDRIVERS variable in
KEYS and in CRT.  This driver table contains a set of modified I/O
drivers.  The intent is to take the normal I/O drivers and remove
the ability to reset the interface.  This is necessary because many
of the RS-232 line characteristics are set up via software but
modified if a reset occurs.  As a case in point, the 98628
interface needs to have control register 28 set to 0 to specify
that there are no inbound eol characters.  If you did not do this,
the interface would use the default of 2 characters for eol with
those characters being <CR> and <LF>. Whenever a <CR> would come
in from the terminal, the 98628 interface will NOT pass the <CR> on
to the desktop computer because it is waiting to see if the next
character is a <LF> and thereby completing the eol sequence.  The
interface must never be reset or the card will go back to its
default 2 character eol sequence.  The drivers must be modified
because you can not depend on when a reset will occur - the
IOINITIALIZE, IOUNINITIALIZE, and IORESET procedures and the STOP
and CLR I/O keys will case this type of reset.


.4
Installing Drivers in INITLIB

The modules, once they are compiled, need to be placed into
INITLIB.  The console modules should be in linked form to minimize
the space they consume on the boot disk.  For each of the modules
that you are replacing (KBD, KEYS, CRT, BAT and/or CLOCK), go into
the LIBRARIAN and link the compiled object file into a single
module.  For example for the KBD module you would go through the
following steps:

.suspend
   step            keystrokes              meaning
   -----------------------------------------------------------

   1.              CNEWKBD <cr>            Go into the compiler
		   N <cr>                  and compile the source
					   NEWKBD with no listing
					   and put object code
					   into NEWKBD.CODE

   2.              LONEWKBD <cr>           Go into the librarian
		   LINEWKBD <cr>           and specify an output
		   ALKQ                    file of NEWKBD.CODE
					   link together all the
					   modules of input file
					   NEWKBD.CODE
					   finishing linking,
					   keep the output file
					   and quit

.resume

Once you have all the modules you wish to replace in this linked
form, you need to put them into INITLIB.  To do this, it works best
to create a temporary INITLIB (with a name of something like
'MYINIT.CODE') on a larger mass storage device. Go through and
replace (or add) the modules with the LIBRARIAN. The KBD, KEYS,
etc. modules are some of the first modules in INITLIB. When you
have replaced (or added) the appropriate modules, then keep the new
temporary MYINIT and exit the LIBRARIAN.  Go into the FILER and
transfer the temporary MYINIT onto the BOOT disk with a file name
of 'INITLIB.'




.4
Other Possibilities

It is also possible to use interfaces other than the serial
interfaces shown in this example.  Appropriate changes in KEYS and
CRT will be necessary for the IOSTATUS and IOCONTROL usage.  If you
use an addressed interface (like HP-IB) it will also be
necessary to preface the operations with a talk address or listen
address sequence (assuming your interface is system/active
controller).

In addition to using interfaces, it is possible to use no interface
for the keyboard/crt device.  This might be useful in a stand-alone
application where no user interaction occurs.  It is even possible
to have the KEYS module contain sufficient information to send
characters to the system (i.e. it sends a sequence of characters
like '<cr><cr>FP#3<cr>QXmyprog<cr>' which would prefix the system
to volume #3 and then execute the file 'myprog' on #3).


.4
Problems and Trouble Spots

There are some potential problems with dealing with a remote
console.  Some of these are:

.suspend
   Area         Problem
   ---------------------------------------------------------------

   DEBUGGER     The debugger is hardwired to the internal CRT and
		keyboard of the 9826/36.  You must leave the old
		KEYS and CRT module installed in the system if you
		intend to use the debugger and it must be used on
		the normal keyboard and CRT.  Without re-writing the
		debugger, it is impossible to use from the remote
		console.

   Stop key     The stop key can be supported in a limited way with
		the KEYS module.  Currently, no support is included.
		It is possible to add stop key facilities in two
		ways.  The first is to do an ESCAPE(-20) whenever
		a specific key is read from the interface.  This
		approach depends on the keystrokes being read before
		the stop action occurs.  The second approach is to
		use the SERIAL_5 interrupt facilities described
		elsewhere in this document to generate an interrupt
		when a BREAK occurs from the terminal.  The ISR
		procedure that you install will then do an
		ESCAPE(-20) to cause the stop action.

   Graphics     It is not intended the Pascal system be able to do
		remote console (on the terminal screen) graphics
		via the normal graphics library.  It would be possible
		to create your own routines to do this.


.resume

One note about 'break' stop key interrupts: only the 98628
interface supports interrupts.  The 98626 does not support
interrupts.


.4
Getting the Remote Console Working

There are some potential problems involved in trying to bring up
the remote console examples.  Some of these are:


.suspend
   1.      AUTO LF should be OFF

	   HP terminals respond to cursor sense differently when
	   AUTO LF is enabled.

   2.      RS-232 CHARACTERISTICS

	   Make sure RS-232 line characteristics are the same.  This
	   includes:

	   baud rate
	   parity
	   stop bits
	   character or hardware handshakes (probably none)

   3.      ELECTRICAL CONNECTIONS

	   In most RS-232 hardware the lines are connected properly.
	   However, just because the male and female RS-232 connectors
	   can be connected physically does not mean they are
	   electrically connected.  A case in point is the HP 2382
	   terminal and the HP 98626/98628 option 001 RS-232 cable.
	   The option 001 cable and terminal connected physically
	   but pins 2 and 3 were turned around.  It was necessary to
	   wire up a special connector or purchase a connector.

	   In general, the interface pins 1, 2, 3, and 7 are the
	   fundamental lines (unless you are doing hardware
	   handshaking).


   4.      TERMINAL TYPE

	   The examples are written with HP terminals in mind.
	   The primary facility that is depended upon is the
	   cursor sensing and cursor positioning facilities.
	   If your terminal does not support the SAME mechanisms
	   you will have to modify the programs appropriately.

.resume


.need 22
.4
Standard ASCII Keystroke Meanings

The remote console examples work to a terminal.  This is very
nice, but try to find an 'EXECUTE' key on the terminal.  The
following table lists the primarily usefull keys and their
ASCII equivalents.


.suspend
   internal keyboard       ASCII           HP terminal keyboard

   ---------------------------------------------------------

   ENTER                   CR              RETURN

   up arrow                US              CTRL DEL
   down arrow              LF              CTRL J
   left arrow              BS              CTRL H
   right arrow             FS              CTRL \

   BACKSPACE               BS              BACKSPACE
   space bar                               space bar

   EXECUTE                                 CTRL C
   shift EXECUTE           ESC             ESC



.newpage
.3
Simple approach


This first example is the 'simpler' approach.  It supports the use
of both the remote console or built console use.  It does this by
having both types of console code co-exist in the driver modules.
The use of a remote console in this example is enabled by the use
of the remote console jumper, the lack of a built-in console, or by
setting the select code field in CTABLE.  This approach works well
and is easy to set up.  It also allows you to have the same boot
files for a variety of machines and configurations.  It does,
however take slightly more memory (and therefore boot disk space).

This approach to remote console does not choose which type of
console you wish to use.  Both the built-in and remote console
drivers are included in the console modules.



.4
Steps to Modify Drivers

There are a specific set of operations that need to happen to
create a Pascal system with a remote console.  These steps are:


.step 1
BACK UP

Back up your BOOT disk and your CTABLE source.

.step 2
CREATE NEW DRIVERS

Create a set of remote console driver modules (via the EDITOR and
COMPILER). These modules will consist of FINDC, KBD, KEYS, CRT,
BAT, and CLOCK.

.step 3
INSTALL DRIVERS IN INITLIB

Install these modules in INITLIB on your boot disk (via the
LIBRARIAN).  FINDC will be a new module and must go before the
rest of the other remote console modules.  These other modules
(KBD, KEYS, CRT, BAT and CLOCK) will replace the existing INITLIB
modules.

.suspend
   module       purpose                                 requires
   -------------------------------------------------------------

   FINDC        automatic configuration

   KBD          fundamental support of the              FINDC
		'keyboard' 8041 uP including
		interrupt handling

   KEYS         support of the keyboard part            FINDC,KBD
		of the keyboard

   CRT          support of the CRT                      FINDC,KBD,KEYS

   BAT          support of the battery                  FINDC,KBD
		part of the 'keyboard'

   CLOCK        support of the timers                   FINDC,KBD
		part of the 'keyboard'

.resume


.step 4
MODIFY CTABLE

Change the CTABLE file if you want to specify which interface is
the remote console rather than using the automatic search feature
of FINDC.  This is done by editing CTABLE and compiling it and then
copying the object file onto the TABLE file on the boot disk.

.need 7
.step 5
ADD MISCINFO TO BOOT

This should only be necessary if you want to have different screen
dimensions from what the Series 200 mainframe you are booting from
has as screen dimensions (i.e. a 9826 with a 50 character wide
screen).  Change the system information about the console device
with a MISCINFO file.  This is done by compiling and running the
MISCINFO program.  This program will put a MISCINFO data file onto
the boot disk.  Refer to the MISCINFO information elsewhere in this
manual.

.exit


.4
Modifying CTABLE

The CTABLE file might need to be modified to allow the remote
console to work.  The normal CTABLE (as shipped with the default
system) will specify where the default CONSOLE and SYSTERM volumes
exist and what type of units they are.  You should change the
CTABLE file if you want to specify which interface is the remote
console rather than using the automatic search feature of FINDC.

The CTABLE changes to allow for the placement of the remote
console drivers at an arbitrary select code look like the
following:

.suspend
   procedure tea_crt(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM','CRT_CRTIO',
	   21,                                 { change isc }
	   0,0,0,0,0,'CONSOLE',#0,T,T,F,0);
     end;


   procedure tea_kbd(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM',
	   'KEYS_KBDIO',
	   21,                                 { change isc }
	   0,0,0,0,0,'SYSTERM',#0,F,T,F,0);
     end;

.resume

The CTABLE also has an alternate field that can be used for
optional paramters (like baud rate or whatever).  The alternate
parameter is the parameter right before the volume name (e.g.
'SYSTERM').

The approach taken with the remote console is such that these
drivers can be used with other volumes in the system.  Whether or
not you wish to use the drivers as a remote console, it is possible
to use the new KEYS and CRT modules as a general remote interface.
Once the modules are placed in INITLIB, add the volumes to CTABLE
source (and TABLE object file on the boot device).  The following
procedure could be added (near tea_kbd) and then in the main
execution loop of CTABLE put in a call to tea_terminal like
'tea_terminal(50);'.

.suspend
   procedure tea_terminal(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM','CRT_CRTIO',
	   21,                                 { new volume isc }
	   0,0,0,0,0,'TERMINAL',#0,T,T,F,0);
     end;

.resume


.4
Comments on the Code

This simple approach depends on the FINDC module.  This module is
the piece of code that performs an automatic search for built-in or
remote consoles.  The search pattern is as follows:

.step 1
SEARCH FOR REMOTE

Look through the interface cards for either a 98626 or a 98628
RS232 interface (from select codes 8 through 31) with its 'remote'
jumper set.  On the 98626 this is a jumper soldered on the
interface board (cutting this jumper does invalidate the interface
warranty).  On the 98628 interface this is a switch in the 'select
code' switch block (setting the switch does not invalidate the
warranty).

.step 2
SEARCH FOR BUILT IN CONSOLE

If no 'remote' interface was found, then look for the built-in
console.  Both the keyboard hardware and display hardware (from the
CPU's view) must exist.  It is possible on the HP 9920 to set up
with only the keyboard or only the display hardware.

.step 3
SEARCH FOR ANY RS232 INTERFACE

If no 'remote' interface and no 'built-in' interface was found,
then search from select codes 8 through 31 for any 98626 or 98628
RS232 interface.  (The 'remote' jumper does not need to be set.)

.step 4
HOPE FOR BUILT IN CONSOLE

If no 'remote' interface and no 'built-in' console and no
non-'remote' interface was found, then hope that enough of the
built-in interface exists and use it.

.exit

One thing to note about the 98626 card with the remote jumper set
is that the boot ROM supports the 98626 as a remote interface.
This means that when the 98626 has the remote jumper cut, the
system boot messages and the Pascal system messages will all come
out to the remote console.

In addition to accessing the system console, the console driver
code supports the use of remote terminal volumes (as described in
the CTABLE part of this discription).



.resume
.need 55
.suspend
					       (*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)

(* REMOTE CONSOLE - 7/01/1983 *)


$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

program findconsole;

MODULE findc;

IMPORT sysglobals,asm;

EXPORT

VAR internal_console : BOOLEAN;
    console_isc      : INTEGER;

PROCEDURE findit;

IMPLEMENT

PROCEDURE findit;
TYPE char_ptr     = ^CHAR;
VAR  skip         : BOOLEAN;
     found_remote : BOOLEAN;
     value,isc    : INTEGER;
     keyboard,crt : BOOLEAN;
BEGIN

  console_isc := -1;
  internal_console := FALSE;
  found_remote := FALSE;

  { search for 98626 or 98628 with 'remote' switch set - isc 0,8-31 }
  FOR isc:=0 TO 31 DO BEGIN
    IF ( (isc>0) AND (isc<8) ) OR skip
      THEN BEGIN
	skip := FALSE;
	{ skip isc 1..7 and double wide cards }
      END
      ELSE BEGIN
	TRY

	  value := ORD(char_ptr(HEX('600001')+isc*65536)^);

	  IF (value=28) OR (value=29) THEN skip:=TRUE;
	      { skip double wide cards }

	  IF value=(128+2)
	    THEN BEGIN
	      { remote bit set on a 98626 card }
	      console_isc := isc;
	      found_remote := TRUE;
	    END;

	  IF (value=(128+52)) AND
	     ((ORD(char_ptr(HEX('60400D')+isc*65536)^))=0)     { card alive? }
	    THEN BEGIN
	      { remote bit set on a 98628 card }
	      value := ORD(char_ptr(HEX('600000')+isc*65536+16395)^)*256+
		       ORD(char_ptr(HEX('600000')+isc*65536+16393)^);
	      IF value < 32768
		THEN BEGIN
		  value := ORD(char_ptr(HEX('600000')+isc*65536+value*2+1)^);
		  IF value MOD 128 = 1
		    THEN BEGIN
		      value := ORD(char_ptr(HEX('600000')+
					    isc*65536+HEX('402F'))^);
		      IF value = 1
			THEN BEGIN
			  console_isc := isc;
			  found_remote := TRUE;
			END; { of IF value = 1 THEN }
		    END; { of IF value MOD 128 =1 THEN }
		END; { of IF value<32768 THEN }
	    END; { of IF value=(128+52) THEN }

	RECOVER BEGIN
	  { bus error, I hope }
	END;

      END; { of IF }
  END; { of FOR TO BEGIN }



  { search for keyboard and crt hardware }
  TRY
    crt := TRUE;
    value := ORD(char_ptr(HEX('512001'))^);
  RECOVER crt := FALSE;

  value := ORD(char_ptr(HEX('FFFED3'))^);
  IF value MOD 16 > 7 THEN keyboard := FALSE
		      ELSE keyboard := TRUE;

  IF keyboard AND crt AND NOT found_remote
    THEN BEGIN
      internal_console := TRUE;
    END;




  { search for 98626 or 98628 without 'remote' switch set - isc 0,8-31 }
  IF NOT found_remote AND NOT internal_console
    THEN BEGIN
      { search again }
      FOR isc:=0 TO 31 DO BEGIN
	IF ( (isc>0) AND (isc<8) ) OR skip
	  THEN BEGIN
	    skip := FALSE;
	    { skip isc 1..7 and double wide cards }
	  END
	  ELSE BEGIN
	    TRY

	      value := ORD(char_ptr(HEX('600001')+isc*65536)^);

	      IF (value=28) OR (value=29) THEN skip:=TRUE;
		  { skip double wide cards }

	      IF value=(2)
		THEN BEGIN
		  { no remote bit set on a 98626 card }
		  console_isc := isc;
		END;

	      IF (value=52) AND
		 ((ORD(char_ptr(HEX('60400D')+isc*65536)^))=0) { card alive? }
		THEN BEGIN
		  { no remote bit set on a 98628 card }
		  value := ORD(char_ptr(HEX('600000')+isc*65536+16395)^)*256+
			   ORD(char_ptr(HEX('600000')+isc*65536+16393)^);
		  IF value < 32768
		    THEN BEGIN
		      value:=ORD(char_ptr(HEX('600000')+isc*65536+value*2+1)^);
		      IF value MOD 128 = 1
			THEN BEGIN
			  value := ORD(char_ptr(HEX('600000')+
						isc*65536+HEX('402F'))^);
			  IF value = 1
			    THEN BEGIN
			      console_isc := isc;
			    END; { IF value=1 THEN }
			END; { of IF value MOD 128=1 THEN }
		    END; { of IF value<32768 THEN }
		END; { of IF value=(52) THEN }

	    RECOVER BEGIN
	      { bus error, I hope }
	    END;

	  END; { of IF }
      END { of FOR TO BEGIN }
    END; { of IF NOT internal_console AND NOT found_remote }

  IF (console_isc=-1) AND NOT internal_console
    THEN BEGIN
      { panic - no console }
      internal_console := TRUE;
      { hope some part of the hardware is there }
    END;


END; { of PROCEDURE findit }


END; { of MODULE findc }

IMPORT findc,loader;

BEGIN
  findit;
  markuser;
END.


.resume
.need 55
.suspend

(*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)


(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)


$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'FINDC'$

program initkbd;

module kbd;

import sysglobals,asm,bootdammodule,isr,misc, FINDC;

export
  type

  crtconsttype = packed array [0..11] of byte;

  crtfrec = packed record
	       nobreak,stupid,slowterm,hasxycrt,
	       haslccrt{built in crt},hasclock,
	       canupscroll,candownscroll      :    boolean;
	     end;

  b9 = packed array[0..8] of boolean;
  b14= packed array[0..13] of boolean;
  crtcrec = packed record                               (* CRT CONTROL CHARS *)
	       rlf,ndfs,eraseeol,
	       eraseeos,home,
	       escape             : char;
	       backspace          : char;
	       fillcount          : 0..255;
	       clearscreen,
	       clearline          : char;
	       prefixed           : b9
	    end;

  crtirec = packed record                          (* CRT INFO & INPUT CHARS *)
	       width,height      : shortint;
	       crtmemaddr,crtcontroladdr,
	       keybufferaddr,progstateinfoaddr:integer;
	       keybuffersize: shortint;
	       crtcon            : crtconsttype;
	       right,left,down,up: char;
	       badch,chardel,stop,
	       break,flush,eof   : char;
	       altmode,linedel   : char;
	       backspace,
	       etx,prefix        : char;
	       prefixed          : b14 ;
	       cursormask        : integer;
	       spare             : integer;
	    end;

  environ = record
	      miscinfo: crtfrec;
	      crttype: integer;
	      crtctrl: crtcrec;
	      crtinfo: crtirec;
	    end;

  environptr    = ^environ;
  keybufptrtype = ^keybuffertype;

  stat8041 = packed record
	       case integer of
	     0: (pad1: 0..63; busy: boolean;readready:boolean);
	     1: (statchar: char);
	     end;
  crtword=   record case integer of
	       1:(highlightbyte,character:char;);
	       2:(wholeword: shortint);
	     end;
  kbdhooktype = procedure(var statbyte,databyte: byte;
		     var dokey: boolean);

  timerhooktype = procedure(statbyte,databyte: byte;
		     var dotimer: boolean);

  keybuffertype= array[0..maxint] of crtword;

var

    syscom: environptr;
    changehardware: boolean;
    progstateinfo: keybufptrtype;

    kbd8041datareg  [4358145 { 428001 } ]: char;
    kbd8041statusreg[4358147 { 428003 } ]: char;

    alphastate['ALPHAFLAG']:boolean;
    graphicstate['GRAPHICSFLAG']:boolean;

    kbdhook: kbdhooktype;
    timerhook: timerhooktype;
    dumpalphahook: procedure;
    dumpgraphicshook: procedure;
    togglealphahook: procedure;
    togglegraphicshook: procedure;

    kbeepfreq,
    kbeepdur: byte;

    procedure beep;
    procedure beeper(frequency, duration: byte);

    procedure kbdinit;
    procedure lockedaction(a: action);

    procedure kbdcommand(cmd: byte; numdata: integer; b1, b2, b3: byte);
    function read8041byte:byte;

implement

var kbdreg: byte;
    kbdisrib : isrib;

const
  b9826info=crtirec[
	   width :80,height:24,
	   crtmemaddr:5316608          { + 416},
	   crtcontroladdr:5341185,
	   keybufferaddr: 5320448         {  + 416},
	   progstateinfoaddr: 5320592         {  + 416},
	   keybuffersize: 72,
	   crtcon:
	   crtconsttype [114,80,76,7,26,10,25,25,0,14,76,13],
	   right{FS}:chr(28),
	   left{BS}:chr(8),
	   down{LF}:chr(10),    up{US}:chr(31),
	   badch{?}:chr(63),
	   chardel{BS}:chr(8),stop{DC3} :chr(19),
	   break{DLE}:chr(16),
	   flush{ACK}:chr(6),  eof{ETX}:chr(3),
	   altmode{ESC}:chr(27),
	   linedel{DEL}:chr(127),
	   backspace{BS}:chr(8),
	   etx:chr(3),prefix:chr(0),
	   prefixed:b14[14 of false],
	   cursormask : 0,     spare : 0];

{defaultcrtcon = crtconsttype [64,50,49,10,25,9,25,25,0,11,74,11];}

var   kbd8041cmdreg   [4358147 { 428003 } ]: char;
      read8041record:packed record
	  bytereceived:byte;
	  receivedbyte:boolean;
	end;

const
  environc=environ[miscinfo:crtfrec[
				    nobreak:false,
				    stupid :false,
				    slowterm:false,
				    hasxycrt:true,
				    haslccrt:true,  {?}
				    hasclock:true,
				    canupscroll:true,
				    candownscroll:true],
		   crttype:0,
		   crtctrl:crtcrec[
				    rlf:chr(31),
				    ndfs:chr(28),
				    eraseeol:chr(9),
				    eraseeos:chr(11),
				    home:chr(1),
				    escape:chr(0),
				    backspace:chr(8),
				    fillcount:10,
				    clearscreen:chr(0),
				    clearline:chr(0),
				    prefixed:b9[9 of false]],
		   crtinfo:crtirec[
				    width :50,height:24,
				    crtmemaddr:5316608,
				    crtcontroladdr:5308417,
				    keybufferaddr: 5319008,
				    progstateinfoaddr: 5319092,
				    keybuffersize: 42,
				    crtcon: crtconsttype [64,50,49,10,25,9,25,
							  25,0,11,74,11],
				    right{FS}:chr(28),
				    left{BS}:chr(8),
				    down{LF}:chr(10),    up{US}:chr(31),
				    badch{?}:chr(63),
				    chardel{BS}:chr(8),stop{DC3} :chr(19),
				    break{DLE}:chr(16),
				    flush{ACK}:chr(6),  eof{ETX}:chr(3),
				    altmode{ESC}:chr(27),
				    linedel{DEL}:chr(127),
				    backspace{BS}:chr(8),
				    etx:chr(3),prefix:chr(0),
				    prefixed:b14[14 of false],
				    cursormask : 0,     spare : 0]];


procedure beep;
begin
  IF internal_console
    THEN BEGIN
      beeper(kbeepfreq, kbeepdur);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure lockedaction(a: action);
label 1;
var i: integer;
begin
 if locklevel = 0 then call(a)
 else
   begin
   i := actionspending;
   while i>0 do if deferredaction[i]=a then goto 1 else i := i - 1;
   if actionspending = 10 then beep
   else begin
	actionspending := actionspending + 1;
	deferredaction[actionspending] := a;
	end;
   end;
1:
end;

function read8041byte:byte;
begin
  IF internal_console
    THEN BEGIN
      with read8041record do
	begin
	  repeat until receivedbyte;
	  read8041byte:=bytereceived;
	end;
    END
    ELSE BEGIN
      read8041byte:=0;
    END;
end;

procedure wait4kbdready;
var  kbdstatus: stat8041;
begin
  IF internal_console
    THEN BEGIN
      repeat
	kbdstatus.statchar:=kbd8041statusreg;
      until not kbdstatus.busy;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure kbdcommand(cmd: byte; numdata: integer; b1, b2, b3: byte);
var kbdstatus: stat8041;

  procedure dataout(d: byte);
  begin wait4kbdready; kbd8041datareg := chr(d); end;

begin
  IF internal_console
    THEN BEGIN
      wait4kbdready;
      read8041record.receivedbyte:=false;
      if (cmd < 64) or (cmd >= 96) then
	begin
	kbd8041cmdreg := chr(cmd);
	if numdata >= 1 then dataout(b1);
	if numdata >= 2 then dataout(b2);
	if numdata >= 3 then dataout(b3);
	end
      else
	begin
	kbdreg := ior(cmd, iand(kbdreg,-1-b1));
	kbd8041cmdreg := chr(kbdreg);
	end;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure beeper(frequency, duration: byte);
begin
  IF internal_console
    THEN BEGIN
      kbdcommand(163, 2, (256-duration) mod 256, frequency, 0);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure kbdisr(isribptr : pisrib);
var kbdstatus: byte;
    kbddata:  byte;
    dokey: boolean;
    dotimer: boolean;

begin(*kbdisr*)
  kbdstatus :=  ord(kbd8041statusreg);
  kbddata   :=    ord(kbd8041datareg);
  dokey := true;
   case (kbdstatus div 64) of
    0: begin
	 dotimer := true;
	 call(timerhook,kbdstatus,kbddata,dotimer);
	 if dotimer then
	   beep;  {no default timer interrupt handler implemented}
       end;

    1: begin{byte requested by 68000}
	 with read8041record do
	 begin
	   bytereceived:=kbddata;
	   receivedbyte:=true;
	 end;
       end;

    2,3: call (kbdhook, kbdstatus, kbddata, dokey);

    end;
end;

procedure dummykbdhook(var stat, data: byte;
		       var doit: boolean);
begin
end;

procedure dummytimerhook(stat, data: byte;
			 var doit: boolean);
begin
end;

procedure initsyscom;
var f: file of environ;
    dcrtinfo['dcrtinfo']: anyptr;
begin
new(syscom);  syscom^ := environc;
with syscom^ do
  begin
  if not sysflag.alpha50 then crtinfo := b9826info;
  reset(f, nodestr+'MISCINFO','shared');
  if ioresult = ord(inoerror) then read(f, syscom^);
  changehardware := ioresult = ord(inoerror);
  dcrtinfo := addr(crtinfo);
  progstateinfo:=anyptr(crtinfo.progstateinfoaddr);
  end;
end; {INITSYSCOM}

procedure kbdinit;
begin
  IF internal_console
    THEN BEGIN
      kbeepfreq := 8;        {frequency = 8 * 104.17 Hz}
      kbeepdur  := 8;        {duration  = 8 * 10 ms}
      kbdreg := 0;
      kbdhook := dummykbdhook;
      timerhook := dummytimerhook;
      permisrlink(kbdisr,charptr(4358147){428003HEX},1,1,1,addr(kbdisrib));
      setintlevel(0);
      kbdcommand(95, 0, 31, 0, 0); {disable all keyboard interrupts}
      initsyscom;
    END
    ELSE BEGIN
      kbdhook := dummykbdhook;
      timerhook := dummytimerhook;
      initsyscom;
    END;

end;  {kbdinit}

end;

import kbd, loader;

begin
  kbdinit;
  markuser;
end.


.resume
.need 55
.suspend
					      (*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)



(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)


$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$
$SEARCH  'KBD','FINDC'$

program keysinit;

module keys;
import sysglobals, asm, misc, kbd, IODECLARATIONS, GENERAL_0, FINDC;
export
  const
  yencode = 92; { Yen symbol overlays USASCII backslash (\) in Kana machines }

  type
  langtype = (gringo,french,german,swedish{,finnish},spanish,katakana);

  var
  kbdlangjumper: record case byte of
		   0: (b:packed record dummy,jnum:byte end);
		   1: (jlang:langtype); {16 bit}
		 end;
  kbdwaithook: procedure;
  kbdreleasehook: procedure;

  keybuffer:^keybuffertype;
  keybufsize:shortint;
  keybuflength: shortint;
  capslock: boolean;
  kanaflag: boolean;

  procedure kbdio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
  procedure initkeys;

implement

var
  marmot        : boolean;
  anychar       : boolean;
  buildchar     : integer;
  buildcount    : 0..4;
  anycharsavehook : kbdhooktype;

const
  xmitlang  =18;
  xmitconfig=17;

type
  t1 = packed array[boolean, 60..99] of char;
  t2 = packed array[langtype] of t1;
  t4 = packed array[boolean, 100..125] of char;
  aa = packed array['' .. ''] of char;                      { scs 25-jan-83 }

const
  alphabet       = t4['opklqwertyuiasdfghjmzxcvbn',
		      'OPKLQWERTYUIASDFGHJMZXCVBN'];

  keylookup = t2[
  {gringo}
     t1['0.,+123-456*789/E()^1234567890-=[];'',./ ',
     '0.,+123-456*789/`|\~!@@#$%^&*()_+{}:"<>? '],                {shifted}
  {french}
  t1['0.,+123-456*789/E()^1234567890'''#170#200'&'#197#203',.- ',
     '0.|~123`456@@789\<[]>!"#$%+/()=?'#171#181'*'#201#179';:_ '],
  { german }
  t1['0.,+123-456*789/E()^1234567890'#222''''#207'+'#206#204',.- ',
     '0.|~123'#179'456@@789\<[]>!"#$%&/()=?`'#219'*'#218#216';:_ '],
  { swedish }
  t1['0.,+123-456*789/E()^1234567890+'#197#212#207#206#204',.- ',
     '0.|~123''456@@789\<[]>!"#$%&/()=?'#220#208#219#218#216';:_ '],
  { spanish }
  t1['0.,+123-456*789/E()^1234567890+'#168#179'#'#183'*,.- ',
     '0.|+123''456*789\<[]>!"'#185'$%&'#184'()=?/{}'#182'@@;:_ '],
  { katakana }
  t1[
'0.,+123-456*789/E()^'#199#204#177#179#180#181#212#213#214#220#206#205#209#219#218#185#200#217#210#32,
'0.,+123-456*789/`|\~'#199#204#167#169#170#171#172#173#174#166#176#205#222#223#218#185#164#161#165#32]

		 ];    {end of keylookup}

  ala = aa[''];                                           { scs 25-jan-83 }
  ale = aa[''];                                           { scs 25-jan-83 }
  ali = aa[''];                                           { scs 25-jan-83 }
  alo = aa[''];                                           { scs 25-jan-83 }
  alu = aa[''];                                           { scs 08-feb-83 }
  aua = aa['AAA'];                                           { scs 25-jan-83 }
  aue = aa['EEE'];                                           { scs 25-jan-83 }
  auo = aa['OOO'];                                           { scs 25-jan-83 }
  auu = aa['UUU'];                                           { scs 25-jan-83 }

type
  k2 = packed array [100..125] of byte;
  kanaalphabettype = packed array [boolean] of k2;

const
  kanaalphabet = kanaalphabettype
		     [k2[ 215,190,201,216,192,195,178,189,182,221,197,198,
			  193,196,188,202,183,184,207,211,194,187,191,203,
			  186,208 ],
		      k2[ 215,190,201,216,192,195,168,189,182,221,197,198,
			  193,196,188,202,183,184,207,211,175,187,191,203,
			  186,208]];


  VAR  eol_lying_around : PACKED ARRAY[type_isc] OF BOOLEAN;
       myisc            : shortint;

       newdrivers       : drv_table_type;




{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset( mytemp : ANYPTR );
BEGIN
  { do nothing so that the configuration stays the same }
END;




PROCEDURE myinit;

{This procedure was modified to do DC1/DC3 handshaking. 9/21/83}

VAR status_reg:                  {variant record to change upper two bits only}
	record case integer of
	  0:      (whole:
		     packed record
			     byte: 0..255;             {gets inital status}
			    end);
	  1:      (part:
		      packed record
			     upper_two_bits: 0..3;       {gets new bits}
			     end);
	end;

BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
	iocontrol(myisc,28,0);                         { no EOL characters }
	iocontrol(myisc,22,3);                         { DC1/DC3 hndshk-host }
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
	status_reg.whole.byte := iostatus(myisc,4);    {read status reg 4}
	status_reg.part.upper_two_bits := 1;           {change upper two bits}
	iocontrol(myisc,4,status_reg.whole.byte);      {use DC1/DC3 hndshk}
    END;
  iocontrol(myisc,12,1);                               { connect the card }
  newdrivers := isc_table[myisc].io_drv_ptr^;          { copy 628 card dvrs }
  newdrivers.iod_init := new_reset;                    { put in new reset   }
  isc_table[myisc].io_drv_ptr := ADDR( newdrivers );   { install drivers    }
END;


FUNCTION inchar : CHAR;
VAR     x       : CHAR;
BEGIN
  IF eol_lying_around[myisc]
    THEN BEGIN
      inchar := eol;
      eol_lying_around[myisc] := FALSE;
    END
    ELSE BEGIN
      WITH isc_table[myisc] DO
      CALL ( io_drv_ptr^.iod_rdb ,
	     io_tmp_ptr ,
	     x );
      inchar:=x;
    END;
END;

FUNCTION kbdbusy : BOOLEAN;
VAR     x       : INTEGER;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
      { check inbound queue for data }
      x:=iostatus(myisc,5);
      IF (x=1) OR (x=3) OR eol_lying_around[myisc]  THEN kbdbusy:=FALSE
						    ELSE kbdbusy:=TRUE;
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
      x:=iostatus(myisc,10);
      { check character buffer for data }
      IF ((x MOD 2)=0) OR eol_lying_around[myisc]    THEN kbdbusy:=FALSE
						     ELSE kbdbusy:=TRUE;
    END;
END;






procedure setrunlight $alias 'CRT_SETRUNLIGHT'$ (x: char); external;

procedure stopaction;
begin
  actionspending := 0;
  escape(-20);
end;

procedure cntrlpausekey;
type strin = string[1];
const qm = strin['?'];
begin
call(debugger,4,integer(addr(qm)),0)
end;

procedure pausekey;
begin
call(debugger,6,0,0);
end;

procedure kbdio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
var   interruptlevel: integer;
      ch1,ch2:char; kbl: shortint;
      commandinprogress: char;
      buf: charptr;
      extra: shortint;                                        { scs 25-jan-83 }
begin
  myisc := unitable^[fp^.funit].sc;
  IF internal_console AND (myisc=0)
    THEN BEGIN
      ioresult := ord(inoerror);
      buf := addr(buffer);
      case request of
       flush:  {do nothing};
       unitstatus:  fp^.fbusy := keybuflength = 0;
       {uwait:  begin
	       if progstateinfo^[7].character<>chr(idle) then
		 commandinprogress:=progstateinfo^[7].character;
	       while keybuflength = 0 do call(kbdwaithook);
	       setrunlight(commandinprogress);
	       end; }
       clearunit:  begin interruptlevel := intlevel;
		 if interruptlevel <1 then setintlevel(1);
		 for kbl := 0 to keybufsize - 1 do
		   keybuffer^[kbl].wholeword := ord(' ');
		 keybuflength := 0;
		 setintlevel(interruptlevel);
	       end;

       $if false$
       writeeol,
       startwrite,
       writebytes: crtio(fp, request, buffer, length, 0);
       $end$

       readtoeol,
       readbytes,
       startread:
	begin
	if request = readtoeol then
	  begin
	  buf := addr(buf^, 1);
	  buffer[0] := chr(0);
	  end;
	while length>0 do
	 begin
	   if progstateinfo^[7].character<>chr(idle) then
			      commandinprogress:=progstateinfo^[7].character;
	   interruptlevel := intlevel;
	   repeat
	     while keybuflength = 0 do call(kbdwaithook);
	     setintlevel(7);         {disable interrupts}
	     if keybuflength = 0 then setintlevel(interruptlevel);
	   until keybuflength > 0;
	   setrunlight(commandinprogress);
	   buf^ := keybuffer^[0].character;
	   if buf^ = chr(etx) then length := 0 else length := length-1;
	   if (buf^=eol) and (request=readtoeol) then length := 0
	   else
	     begin
	     fp^.feoln := false;
	     buf := addr(buf^, 1);
	     if keybuflength < keybufsize then              { scs 25-jan-83 }
	       extra := ord(keybuffer^[keybuflength].character <> ' ')
	     else extra := 0;
	     keybuflength := keybuflength - 1;
	     moveleft(keybuffer^[1], keybuffer^[0], (keybuflength+extra)*2);
								     { scs }
	     keybuffer^[keybuflength+extra].character := ' ';        { scs }
	     if request = readtoeol then buffer[0] := chr(ord(buffer[0])+1);
	     end;
	   setintlevel(interruptlevel);            {restore keyboard interrupt}
	 end;
	if request = startread then call(fp^.feot, fp);
	end;
       otherwise ioresult := ord(ibadrequest);
      end;
    END
    ELSE BEGIN
      IF (myisc>=0) AND (myisc<=7)
	THEN BEGIN
	  { 0 is default and 1..7 are not allowed }
	  myisc := console_isc;
	END
	ELSE BEGIN
	  { -isc and isc>7 allows a CTABLE entry
	     to override all of this garbage }
	  IF myisc < 0  THEN myisc := -myisc;
	  IF myisc > 31 THEN myisc := myisc MOD 32;
	END;
      ioresult := ORD(inoerror);
      buf := ADDR(buffer);
      CASE request OF

	flush:       BEGIN
		       myinit;
		     END;

	unitstatus:  BEGIN
		       fp^.fbusy := kbdbusy  ;
		     END;

	clearunit:   BEGIN
		       myinit;
		     END;

	readtoeol,
	readbytes,
	startread:   BEGIN
		       IF request = readtoeol
			 THEN BEGIN
			   { the buffer is a string - so set it to empty }
			   buf := ADDR(buf^, 1);
			   buffer[0] := chr(0);
			 END;
		       while length>0 DO BEGIN
			 buf^ := inchar;
			 IF buf^ = chr(etx)
			   THEN length := 0
			   ELSE length := length-1;
			 IF (buf^=eol) and (request=readtoeol)
			   THEN BEGIN
			     eol_lying_around[myisc] := TRUE;
			     length := 0
			   END
			   ELSE BEGIN
			     fp^.feoln := false;
			     buf := ADDR(buf^, 1);
			     IF request = readtoeol
			       THEN buffer[0] := CHR(ORD(buffer[0])+1);
			   END;
		       END; { of WHILE DO }
		       IF request = startread THEN CALL(fp^.feot, fp);
		     END;

	OTHERWISE    BEGIN
		       ioresult := ORD(ibadrequest);
		     END;

      END; { of CASE }

    END;
end;

procedure keyservice(var kbdstatus, kbddata: byte; var dokey: boolean);

var shift, control, done:  boolean;
    key: char;
    lang: langtype;

    procedure morealpha;
    begin
      done := true;
      if not alphastate then call(togglealphahook)
      else if graphicstate then call(togglegraphicshook);
    end;

    procedure moregraphics;
    begin
      done := true;
      if not graphicstate then call(togglegraphicshook)
      else if alphastate then call(togglealphahook);
    end;

    procedure dumpalpha;
    begin
     done := true;
     lockedaction(dumpalphahook);
    end;

    procedure dumpgraphics;
    begin
     done := true;
     lockedaction(dumpgraphicshook);
    end;

    procedure remove(all: boolean);           { scs 25-jan-83 for diacriticals}
    var i,n:  integer;
    begin
      if keybuflength < keybufsize then
	if keybuffer^[keybuflength].character <> ' '    {non-advancing key}
	then keybuflength := keybuflength + 1;
      if keybuflength > 0 then
	begin
	if all then n := 0 else n := keybuflength-1;
	for i:=n to keybuflength-1 do keybuffer^[i].wholeword := ord(' ');
	keybuflength:=n;
	end;
    end;

    procedure  unrecognized; begin beep; done := true; end;

    procedure clearanychar;
    begin
      if anychar then
	begin
	  anychar := false;
	  kbdhook := anycharsavehook;
	end;
    end;

   procedure rpghandler;
   var key: char;
   begin
     case kbdstatus div 16 of
 14: {shifted}
	if kbddata >= 128 then key:=chr(lf) else key:=chr(us);
 15: {unshifted}
	if kbddata >= 128 then key:=chr(fsp) else key:=chr(bs);
     otherwise
	beep;  key := ' ';
     end;
     if keybuflength=0 then
       begin  keybuflength := 1;
	 keybuffer^[0].character := key;
	 call(kbdreleasehook);
       end;
   end;

begin
  IF internal_console AND (myisc=0)     { STILL A PROBLEM FOR ISC 0 }
    THEN BEGIN
      if dokey then
       if kbdstatus>=192 then rpghandler
       else
	begin
	done:=false;{done indicates that key is handled immediately}
	control := not odd(kbdstatus div 32);
	shift   := not odd(kbdstatus div 16);
	if (kbdlangjumper.jlang=katakana) and not kanaflag then lang := gringo
	else lang := kbdlangjumper.jlang;
	if odd(kbdstatus) then
	 if kbddata < 60 then
	    case kbddata of
	      24:                     begin
					capslock := not capslock;
					done := true end;
	      25:                     key := chr(tab);        {tab}
	      34:                     key := chr(lf);         {down arrow}
	      35:                     key := chr(us);         {up arrow}
	      38,46: if control then begin remove(false); done:=true; end
		     else             key := chr(bs);         {left arrow,
								 backspace}
	      39:                     key := chr(fsp);        {right arrow}
	      40,43:                  key := 'I';             {insert mode}
	      41: if marmot then moregraphics else
				      key := 'D';             {delete mode}
	      42: if shift and marmot then morealpha else unrecognized;
							      {recall}
	      44:                     key := 'D';             {delete mode}
	      45:                     unrecognized;           {cleartoend}
	      47:                     key := 'R';             {RUN  key}
	      48:                     key := 'E';             {EDIT key}
	      49: if shift then dumpalpha else morealpha;
	      50: if shift then dumpgraphics else moregraphics;
	      51: begin
		  done := true;
		  if shift then begin anychar:=true;
				      anycharsavehook := kbdhook;
				      kbdhook := keyservice;
				      buildcount:=1;
				      buildchar:=0;
				end
		  else call(debugger,3,kbdstatus,kbddata);
		  end;
	      52: if control then begin remove(true); done:=true; end
		  else if shift then  key := chr(ff)          {clear screen}
		  else                key := chr(del);        {clear line}
	      53: if shift and marmot then dumpalpha else unrecognized;
							    {result, set tab}
	      54: if shift and marmot then dumpgraphics else unrecognized;
							    {prt all, clr tab}
	      55: begin {stop} {clear I/O}
		    done := true;
		    clearanychar;
		    lockedaction(stopaction);
		  end;
	      56: begin {pause}
		    done := true;
		    if locklevel=0 then call(debugger, 3, kbdstatus, kbddata)
		    else if control then lockedaction(cntrlpausekey)
				    else lockedaction(pausekey);
		  end;
	      57:                     key := chr(cr);         {ENTER}
	      58: begin done := true; call(debugger,3,kbdstatus,kbddata); end;
	      59: if    control then  begin
				      key := chr(cntrl);      {'control' char}
				      control := false;
				      end
		  else if shift then  key := chr(esc)         {escape}
		  else                key := chr(etx);        {EXECUTE}
	      otherwise unrecognized; {no such code}
	    end  {case kbddata < 60}
	 else if kbddata < 100 then
	  begin
	  if capslock then
	    if      lang=german  then shift := shift<>(kbddata in [92,94..95])
	    else if lang=swedish then shift := shift<>((kbddata>=91) and
						       (kbddata <= 95))
	    else if lang=spanish then shift := shift<>(kbddata = 94);
	  key := keylookup[lang, shift, kbddata];
	  if kbdlangjumper.jlang = katakana then
	     begin
	     if control then
	       if      kbddata = 96 then begin
					 done := true; kanaflag := false end
	       else if kbddata = 97 then begin
					 done := true; kanaflag := true  end;
	     if ((kbddata=92) or (kbddata=93)) and shift and not kanaflag then
	       if control then key := chr(fsp)
	       else if kbddata = 92 then key := chr(yencode)
	       else                      key := '|';
	     end;
	  end
	 else if kbddata < 126 then
	   if lang = katakana
	     then key:=chr(kanaalphabet[          shift, kbddata])
	     else begin
		  key:=        alphabet[capslock<>shift, kbddata];
		  if lang = german then
		    if      key = 'y' then key := 'z'
		    else if key = 'z' then key := 'y'
		    else if key = 'Y' then key := 'Z'
		    else if key = 'Z' then key := 'Y';
		  end
	 else unrecognized
	else {kbdstatus is even}
	 begin
	 key := chr(kbddata);
	 control := false;
	 end;

	if anychar then
	    if done then
	      begin
	       if not (shift and (kbddata = 51)) then
		 clearanychar;
	      end
	    else
	      begin
	       if (key < '0') or (key > '9') then
		 begin
		 clearanychar;
		 unrecognized;
		 end
	       else
		 begin
		 buildchar:=buildchar*10+(ord(key)-ORD('0'));
		 buildcount:=buildcount+1;
		 done := buildcount <= 3;
		 if not done then
		   begin
		     clearanychar;
		     key:=chr(buildchar mod 256);
		   end;
		 end;
	      end;

	if not done then
	    begin
	    if control then
	      if lang<>katakana
		then key:=chr(ord(key) mod 32);
	    if keybuflength>=keybufsize then beep
	    else
	      begin
		with keybuffer^[keybuflength] do              { scs 25-Jan-83 }
		  if character = ' ' then character := key    { scs 25-Jan-83 }
		  else if (key<>' ') and (key<>chr(fsp)) then { scs 25-Jan-83 }
		    if character = '' then                   { scs 25-Jan-83 }
		      if      key = 'n' then character := '' { scs 25-Jan-83 }
		      else if key = 'N' then character := '' { scs 25-Jan-83 }
					else character := key { scs 25-Jan-83 }
		    else case key of                          { scs 25-Jan-83 }
		      'a': character := ala[character];       { scs 25-Jan-83 }
		      'e': character := ale[character];       { scs 25-Jan-83 }
		      'i': character := ali[character];       { scs 25-Jan-83 }
		      'o': character := alo[character];       { scs 25-Jan-83 }
		      'u': character := alu[character];       { scs 25-Jan-83 }
		      'A': character := aua[character];       { scs 25-Jan-83 }
		      'E': character := aue[character];       { scs 25-Jan-83 }
		      'O': character := auo[character];       { scs 25-Jan-83 }
		      'U': character := auu[character];       { scs 25-Jan-83 }
		      otherwise character:=key;               { scs 25-Jan-83 }
		      end;                                    { scs 25-Jan-83 }
		if (key<'') or (key>'') or kanaflag then    { scs 14-Feb-83 }
		  begin
		  keybuflength:=keybuflength+1;
		  call(kbdreleasehook);
		  end;
	      end;
	    end;
	end;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end; {keyservice}

procedure wait4kbdreadready;
var  kbdstatus: stat8041;
begin
  IF internal_console AND (myisc=0)     { STILL A PROBLEM FOR ISC 0 }
    THEN BEGIN
      repeat
	kbdstatus.statchar:=kbd8041statusreg;
      until  kbdstatus.readready;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure dummykbdwait;
begin
  setrunlight(chr(idle));
end;

procedure dummykbdrelease;
begin
end;

procedure initkeys;
var kbddata   : byte;
    localisc : INTEGER;
begin
  IF internal_console
    THEN BEGIN
      with syscom^.crtinfo do
	begin
	keybuffer:=anyptr(keybufferaddr);
	keybufsize:=keybuffersize;
	kbdwaithook := dummykbdwait;
	kbdreleasehook := dummykbdrelease;
	kbdhook := keyservice;
	anychar:=false;
	kanaflag:=false;
	capslock:=true;
	kbdcommand(162, 1, 256- 4, 0, 0);{auto repeat period = 40 ms}
	kbdcommand(160, 1, 256-30, 0, 0);{auto repeat delay  = 300 ms}
	kbdcommand(166,1,1,0,0);
	end;
	with kbdlangjumper do
	  begin
	    jlang:=gringo;{default in case of timeout}
	    setintlevel(7);{raise processor above device
	     interrupt level}
	    kbdcommand(xmitlang,0,0,0,0); {request language jumper code}
	    wait4kbdreadready;
	    kbddata:=ord(kbd8041datareg);
	    b.dummy:=0;b.jnum:=kbddata;
	    if (jlang>katakana) then jlang:=gringo;
	  end;
	kbdcommand(xmitconfig,0,0,0,0); {request language jumper code}
	wait4kbdreadready;
	kbddata:=ord(kbd8041datareg);
	marmot := odd(kbddata);
    END
    ELSE BEGIN
      FOR localisc := 0 TO 31 DO eol_lying_around[localisc] := FALSE;
      WITH syscom^.crtinfo DO BEGIN
	keybuffer:=NIL;
	keybufsize:=1;
	kanaflag:=false;
	capslock:=true;
      END;
    END;
end;

end;

import keys, loader;

begin
  initkeys;
  markuser;
end.

.resume
.need 55
.suspend
(*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)



(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)



$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'KBD','KEYS','FINDC'$

program initcrt;

module crt;
import sysglobals, asm, misc, kbd, keys, IODECLARATIONS, GENERAL_0, FINDC;
export
  type
  scrtype = packed array[0..maxint] of crtword;
  scrptr=^scrtype;

  var
  screenwidth,screenheight:shortint;
  maxx,maxy,screensize:shortint;
  xpos: shortint;
  ypos: shortint;
  screen:scrptr;
  defaulthighlight: shortint;

  procedure crtinit;
  procedure crtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						 length, position: integer);
  procedure updatecursor;
  procedure setrunlight(x:char);

implement

const
minkana = 161;
maxkana = 223;
yenromlocation = 128; { location of Yen symbol in CRT rom }

type
kanatocrtlookuptype = packed array [minkana..maxkana] of 128..255;
romtokanatype = packed array[#128..#238] of 0..255;

crtregtype = 0..15;
crtcmdwrd = packed record case integer of
		0: (topbyte, botbyte: byte);
		1: (longword: shortint);
		2: (p1,p2, textfield, softfield: boolean);
	      end;

const
kanatocrtlookup = kanatocrtlookuptype [
    { code 161 }      129,130,131,132,133,134,135,
    { code 168 }  136,137,138,139,140,141,142,143,
    { code 176 }  144,145,146,147,148,149,150,151,
    { code 184 }  152,153,154,155,156,157,158,159,
    { code 192 }  160,161,162,163,164,165,166,167,
    { code 200 }  173,174,177,178,180,188,190,191,
    { code 208 }  224,225,226,227,228,229,230,231,
    { code 216 }  232,233,234,235,236,237,238,179  ];

  romtokanamap = romtokanatype         [  92, 161, 162,
      163, 164, 165, 166, 167, 168, 169, 170, 171, 172,
      173, 174, 175, 176, 177, 178, 179, 180, 181, 182,
      183, 184, 185, 186, 187, 188, 189, 190, 191, 192,
      193, 194, 195, 196, 197, 198, 199, 168, 169, 170,
      171, 172, 200, 201, 175, 176, 202, 203, 223, 204,
      181, 182, 183, 184, 185, 186, 187, 205, 189, 206,
      207, 192, 193, 194, 195, 196, 197, 198, 199, 200,
      201, 202, 203, 204, 205, 206, 207, 208, 209, 210,
      211, 212, 213, 214, 215, 216, 217, 218, 219, 220,
      221, 222, 223, 208, 209, 210, 211, 212, 213, 214,
      215, 216, 217, 218, 219, 220, 221, 222];

var
highlight:  shortint;
hascolor: boolean;
pm6845addrreg:^char;
pm6845comdreg:^char;
crtidreg[hex('51FFFE')]: packed record
      b15,b14,b13: boolean;
      colorinfo: (cinfo0, cinfo1, cinfo2, cinfo3);
      b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0: boolean;
      end;

CONST dc1           = 17 ;                   {control-S}
VAR   myisc         : shortint;
      newdrivers    : drv_table_type;




{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset( mytemp : ANYPTR );
BEGIN
  { do nothing so that the configuration stays the same }
END;






PROCEDURE myinit;

{This procedure was modified by Anny Randel to do DC1/DC3 handshaking. 9-21-83}

VAR status_reg:                  {variant record to change upper two bits only}
	record case integer of
	  0:      (whole:
		     packed record
			     byte: 0..255;             {gets inital status}
			    end);
	  1:      (part:
		     packed record
			     upper_two_bits: 0..3;       {gets new bits}
			    end);
	end;

BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
	iocontrol(myisc,28,0);                         { no EOL characters }
	iocontrol(myisc,22,3);                         { use DC1/DC3 hndshk }
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
	status_reg.whole.byte := iostatus(myisc,4); {read status reg 4}
	status_reg.part.upper_two_bits := 1;        {change upper two bits}
	iocontrol(myisc,4,status_reg.whole.byte);   {use DC1/DC3 hndshk}
     END;
  iocontrol(myisc,12,1);                               { connect the card }
  newdrivers := isc_table[myisc].io_drv_ptr^;          { copy 628 card dvrs }
  newdrivers.iod_init := new_reset;                    { put in new reset   }
  isc_table[myisc].io_drv_ptr := ADDR( newdrivers );   { install drivers    }
END;




FUNCTION inchar : CHAR;
VAR  x          : CHAR;
BEGIN
  WITH isc_table[myisc] DO
  CALL ( io_drv_ptr^.iod_rdb ,
	 io_tmp_ptr ,
	 x );
  inchar:=x;
END;

PROCEDURE out(x:CHAR);
BEGIN
  WITH isc_table[myisc] DO
  CALL ( io_drv_ptr^.iod_wtb ,
	 io_tmp_ptr ,
	 x );
END;


PROCEDURE output(s    :io_STRING);
VAR i:INTEGER;
BEGIN
  FOR i:=1 to STRLEN(s) DO out(s[i]);
END;



PROCEDURE localbeep;
BEGIN
   out(CHR(7));        { send beep to card }
END;



procedure setrunlight(x:char);
begin
  IF internal_console  AND (myisc=0)            { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
  progstateinfo^[7].character:=x;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure dumpa;
label 1;
var   row, column:integer;
      c: char;
      line: string[100];
begin with syscom^.crtinfo do
  begin
  setstrlen(line, width);
  for row := 0 to height-1 do
    begin
    for column := 0 to width-1 do
      begin
      c := screen^[row*width+column].character;
      if (c >= #128) and (c <= #238) then c := chr(romtokanamap[c]);
      line[column+1] := c;
      end;
    column := width;
    while (column > 1) and (line[column]= ' ') do column := column - 1;
    writeln(gfiles[4]^, line:column);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  end;
1: end;

procedure toggleg;
var gon [5439488{530000 HEX}]:shortint;
    goff[5472256{538000 HEX}]:shortint;
    gbase['GRAPHICSBASE']: ^shortint;

begin
  graphicstate:=not graphicstate;
  if graphicstate then gbase:=addr(gon)
		  else gbase:=addr(goff);
  gbase^ := gbase^;
end;

procedure dumpg;
label 1;
const gheight = 300;    gheightb = 390;
      gwidth = 50;      gwidthb  = 64;
      gbuffersize=gwidthb+6;
type  gword=packed record
	     dummy,growbyte:char;
	     end;
gdotrow=packed array[1..gwidth] of gword;
type gmemtype =  packed array [1..gheight] of gdotrow;
     gmembtype = packed array [1..gheightb, 1..gwidthb] of char;
     gmem =  ^gmemtype;
     gmemb = ^gmembtype;
var   graphicsbase['GRAPHICSBASE']:  anyptr;
      gbuffer:packed array[1..gbuffersize] of char;
      i,j,rows,buffersize,pindex:integer;
      busy:boolean;
begin
  gbuffer[1]:=chr(esc) {escape sequence for graphics};
  gbuffer[2]:='*';
  gbuffer[3]:='b';
  gbuffer[6]:='W';
  if sysflag.biggraphics then
       begin
       gbuffer[4]:='6';
       gbuffer[5]:='4';
       rows := gheightb;
       buffersize := gwidthb+6;
       end
  else begin
       gbuffer[4]:='5';
       gbuffer[5]:='0';
       rows := gheight;
       buffersize := gwidth+6;
       end;
  for i:= 1 to rows do
    begin
    if sysflag.biggraphics then
     for j:=1 to gwidthb do gbuffer[j+6]:=gmemb(graphicsbase)^[i,j] else
       for j:=1 to gwidth  do gbuffer[j+6]:=gmem(graphicsbase)^[i,j].growbyte;
    write(gfiles[4]^, gbuffer:buffersize);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  write(gfiles[4]^, #27'*rB'); {terminate graphics sequence};
1:
end;

procedure crtcommand(reg: crtregtype; data: byte);
begin
  IF internal_console  AND (myisc=0)            { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
    pm6845addrreg^ := chr(reg);
    pm6845comdreg^ := chr(data);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure togglea;
var   lcursaddr:crtcmdwrd;

begin
  alphastate:=not(alphastate);
  lcursaddr.longword:=integer(screen) mod 8192 div 2;
  lcursaddr.textfield:=alphastate;
  lcursaddr.softfield:=alphastate;
  crtcommand(12, lcursaddr.topbyte);
  crtcommand(13, lcursaddr.botbyte);
  updatecursor;
end;

procedure updatecursor;
var cursaddr: crtcmdwrd;
begin
  IF internal_console  AND (myisc=0)            { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
  cursaddr.longword:=integer(screen) mod 8192 div 2 + ypos*screenwidth+xpos;
  cursaddr.textfield := alphastate;
  cursaddr.softfield:=alphastate;
  crtcommand(14, cursaddr.topbyte);
  crtcommand(15, cursaddr.botbyte);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure getxy(var x,y: integer);
VAR dummy : CHAR;
begin
  IF internal_console  AND (myisc=0)            { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
      x := xpos;      y := ypos;
    END
    ELSE BEGIN
      x:=0;  y:=0;
      { go thru sequence to get actual position }
      out(CHR(esc));        out('`');       { send cursor sense absolute }
      out(CHR(dc1));                        { tell terminal I am ready }
      dummy := inchar;                      { get esc }
      dummy := inchar;                      { get &   }
      dummy := inchar;                      { get '   }
      x     := ORD(inchar)-48;              { get column digit 1 }
      x     := ORD(inchar)-48+x*10;         { get column digit 2 }
      x     := ORD(inchar)-48+x*10;         { get column digit 3 }
      dummy := inchar;                      { get c   }
      y     := ORD(inchar)-48;              { get row    digit 1 }
      y     := ORD(inchar)-48+y*10;         { get row    digit 2 }
      y     := ORD(inchar)-48+y*10;         { get row    digit 3 }
      dummy := inchar;                      { get Y   }
      dummy := inchar;                      { get cr  }

      xpos := x;      ypos := y;
    END;
end;

procedure setxy(x, y: shortint);
VAR s : string[9];
    p : INTEGER;
begin
  IF internal_console AND (myisc=0)             { STILL A PROBLEM FOR ISC 0 !}
    THEN BEGIN
      if x>=screenwidth then xpos:=maxx
      else if x<0 then xpos:=0
      else xpos := x;
      if y>=screenheight then ypos:=maxy
      else if y<0 then ypos:=0
      else ypos := y;
    END
    ELSE BEGIN
      IF x>=screenwidth  THEN xpos:=maxx
			 ELSE IF x<0 THEN xpos:=0
				     ELSE xpos := x;
      IF y>=screenheight THEN ypos:=maxy
			 ELSE IF y<0 THEN ypos:=0
				     ELSE ypos := y;

      { send xpos/ypos via escape esc & a xx y yy C }
      SETSTRLEN(s,9);
      STRWRITE (s,1,p,CHR(esc),'&a',ypos:2,'y',xpos:2,'C');
      output   (s);
    END;
end;

procedure gotoxy(x,y: integer);
begin
    setxy(x,y);
    updatecursor;
end;


procedure clear(number: shortint);
var x,y: shortint;
begin
  x:=xpos; y:=ypos;
  while number>0 do
    begin
      screen^[y*screenwidth+x].wholeword:= ord(' ');
      number:=number-1;
      if x<maxx then x:=x+1
      else begin x:=0; if y<maxy then y:=y+1 end;
    end;
end;

procedure scrollup;
var i: shortint;
begin
  moveleft(screen^[screenwidth{1, 0}],
	   screen^[0{0, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do
    screen^[maxy*screenwidth+i].wholeword:=ord(' ');
end;

procedure scrolldown;{new  4/30/81}
var i: shortint;
begin
  moveright(screen^[0{0, 0}],
	   screen^[screenwidth{1, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do screen^[i].wholeword := ord(' ');
end;

(*Insert test file RS232:RSWRITE here...RAM*)

function maptocrt(c:char):char;

const illegalchar = #223;
		     { char to disp for illegal internal codes; looks like hp }
procedure mapromextocrt;
const
      minromex = 168; { lookup table ranges }
      maxromex = 255;
type  romexsettype = set of minromex..maxromex;
const romexset = romexsettype [168..172,175,176,179,181..187,189,192..222,255];
							  { legal Romex codes }
begin
    if (ord(c) < 128) or (ord(c) in romexset) then
      maptocrt:=c   else maptocrt:=illegalchar;
end;


procedure mapkanatocrt ;

{ Converts Katakana codes to their correct CRT rom location codes; also,
  converts "illegal" Kana chars to the "hp" char.  Note that the Yen symbol
  overlays the USASCII backslash (\), and that code 255 is left unconverted. }


begin
    if ord(c) = yencode then maptocrt := chr(yenromlocation)
    else if (ord(c) < 128) or (ord(c) = 255) then maptocrt:= c
    else begin
      if (ord(c) < minkana) or (ord(c) > maxkana) then maptocrt := illegalchar
      else maptocrt := chr(kanatocrtlookup[ord(c)]);
    end;
end; { mapkanatocrt }

begin
  if kbdlangjumper.jlang = katakana then mapkanatocrt
  else mapromextocrt;
end;

procedure crtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
var c: char;
    s: string[1];
    buf: charptr;
    d,e : INTEGER;
begin
  myisc := unitable^[fp^.funit].sc;
  IF internal_console AND (myisc=0)
    THEN BEGIN
      ioresult := ord(inoerror);
      buf := addr(buffer);
      case request of
       {uwait: ;              }
       setcursor: gotoxy(fp^.fxpos, fp^.fypos);
       getcursor: getxy (fp^.fxpos, fp^.fypos);
       flush:  {do nothing};
       unitstatus:  kbdio(fp, request, buffer, length, position);
       clearunit: highlight := defaulthighlight;
       readtoeol:
	 begin
	 buf := addr(buf^, 1);
	 buffer[0] := chr(0);
	 while length>0 do
	   begin
	   kbdio(fp, readtoeol,  s, 1, 0);
	   if      strlen(s)=0     then length := 0
	 { else if s[1] = chr(etx) then length := 0 }
	   else  begin
		 length := length - 1;
		 crtio(fp, writebytes, s[1], 1, 0);
		 buf := addr(buf^, 1);
		 buffer[0] := chr(ord(buffer[0])+1);
		 end;
	   end;
	 end;
       startread,
       readbytes:
	 begin
	 while length>0 do
	   begin
	   kbdio(fp, readbytes,  buf^, 1, 0);
	   if buf^ = chr(etx) then length := 0
			      else length := length - 1;
	   if buf^ = eol then crtio(fp, writeeol,   buf^, 1, 0)
			 else crtio(fp, writebytes, buf^, 1, 0);
	   buf := addr(buf^, 1);
	   end;
	 if request = startread then call(fp^.feot, fp);
	 end;
       writeeol:   begin
		     if ypos=maxy then scrollup;
		     gotoxy(0, ypos+1);

     (*Insert test file RS232:RSWRITECR here...RAM*)

		   end;
       startwrite,
       writebytes:
	 begin
	 while length>0 do
	  begin
	    c:=buf^; buf:=addr(buf^,1); length:=length-1;

     (*Insert test file RS232:RSWRITEC here...RAM*)

	    case c of
	    homechar:   setxy(0,0);
	    leftchar:   if (xpos = 0) and (ypos>0) then setxy(maxx, ypos-1)
			else setxy(xpos-1, ypos);
	    rightchar:  if (xpos = maxx) and (ypos<maxy) then setxy(0, ypos+1)
			else setxy(xpos+1, ypos);
	    upchar:     begin if ypos <= 1  then scrolldown;
			      if ypos>0 then setxy(xpos, ypos-1);
			end;
	    downchar:   if ypos=maxy then scrollup
			else setxy(xpos, ypos+1);
	    bellchar:   beep;
	    cteos:     clear(screensize-(ypos*screenwidth+xpos));
	    cteol:     clear(screenwidth-xpos);
	    clearscr:  begin setxy(0,0); clear(screensize); end;
	    eol:       setxy(0, ypos);
	    chr(etx):   length:=0;
	    otherwise   if (ord(c)>=128) and (ord(c)< 144) then
			  if hascolor then
			    if ord(c) >= 136 then highlight :=
					 highlight mod 2048 + (ord(c)-136)*4096
			    else highlight :=
				    (highlight div 2048 * 8 + (ord(c)-128))*256
			  else highlight := (ord(c)-128)*256
			else with screen^[ypos*screenwidth+xpos] do
			  begin
			   wholeword:=highlight+ ord(maptocrt(c));
			   if xpos = maxx then
			     begin
			       if ypos = maxy then scrollup;
			       setxy(0, ypos+1);
			     end
			   else setxy(xpos+1, ypos);
			  end;
	    end;
	  updatecursor;
	  end; {while}
	 if request = startwrite then call(fp^.feot, fp);
	 end;
       otherwise ioresult := ord(ibadrequest);
      end; {case}
    END
    ELSE BEGIN
      IF (myisc>=0) AND (myisc<=7)
	THEN BEGIN
	  { 0 is default and 1..7 are not allowed }
	  myisc := console_isc;
	END
	ELSE BEGIN
	  { -isc and isc>7 allows a CTABLE entry
	     to override all of this garbage }
	  IF myisc < 0  THEN myisc := -myisc;
	  IF myisc > 31 THEN myisc := myisc MOD 32;
	END;
      ioresult := ORD(inoerror);
      buf := addr(buffer);
      CASE request OF

       setcursor:    BEGIN
		       gotoxy(fp^.fxpos, fp^.fypos);
		     END;

       getcursor:    BEGIN
		       getxy (fp^.fxpos, fp^.fypos);
		     END;

       flush:        BEGIN
		       myinit;
		     END;

       unitstatus:   BEGIN
			kbdio(fp, unitstatus,buffer,length,position);
		     END;

       clearunit:    BEGIN
		       myinit;
		     END;

       readtoeol:    BEGIN
		       buf := addr(buf^, 1);
		       buffer[0] := CHR(0);
		       WHILE length>0 DO BEGIN
			 kbdio(fp, readtoeol,  s, 1, 0);
			 IF  STRLEN(s)=0
			   THEN BEGIN
			     length := 0
			   END
			   ELSE BEGIN
			     length := length - 1;
			     crtio(fp, writebytes, s[1], 1, 0);
			     buf := addr(buf^, 1);
			     buffer[0] := CHR(ORD(buffer[0])+1);
			   END; { of IF }
		       END;     { of WHILE DO BEGIN }
		     END;       { of BEGIN }

       startread,
       readbytes:    BEGIN
		       while length>0 DO
			 BEGIN
			 kbdio(fp, readbytes,  buf^, 1, 0);
			 IF buf^ = CHR(etx) THEN length := 0
					    ELSE length := length - 1;
			 IF buf^ = eol THEN crtio(fp, writeeol,   buf^, 1, 0)
				       ELSE crtio(fp, writebytes, buf^, 1, 0);
			 buf := addr(buf^, 1);
			 END;
		       IF request = startread THEN call(fp^.feot, fp);
		       END;

       writeeol:     BEGIN
		       IF ypos=maxy THEN BEGIN out(CHR(esc));
					       out('S');   { scroll up 1 line }
					 END;
		       gotoxy(0, ypos+1);
		     END;

       startwrite,
       writebytes:   BEGIN
		       WHILE length>0 DO BEGIN
			 c:=buf^; buf:=addr(buf^,1); length:=length-1;
			 CASE c OF

			   homechar: BEGIN
				       setxy(0,0);
				     END;

			   leftchar: BEGIN
				       out(CHR(bs));
				     END;

			   rightchar:BEGIN
				       getxy(d,e);
				       IF (xpos = maxx) and (ypos<maxy)
					 THEN setxy(0, ypos+1)
					 ELSE setxy(xpos+1, ypos);
				     END;

			   upchar:   BEGIN
				       IF (ypos<=1)
					 THEN BEGIN
					   out(CHR(esc));
					   out('L');      { insert line }
					 END;
				       IF (ypos>0)
					 THEN BEGIN
					   { out(CHR(esc));
					   out('A'); }
					   setxy(xpos,ypos-1);
					 END;
				     END;

			   downchar: BEGIN
				       IF (ypos=maxy)
					 THEN BEGIN
					   out(CHR(esc));
					   out('S');      { scroll up 1 line }
					 END
					 ELSE BEGIN
					   { out(CHR(esc));
					   out('B'); }
					   setxy(xpos,ypos+1);
					 END;
				     END;

			   bellchar: BEGIN
				       localbeep;
				     END;

			   cteos:   BEGIN
				      out(CHR(esc));
				      out('J');
				    END;

			   cteol:   BEGIN
				      out(CHR(esc));
				      out('K');
				    END;

			   clearscr:BEGIN
				      setxy(0,0);
				      out(CHR(esc));
				      out('J');
				    END;

			   eol:      BEGIN
				       out(CHR(cr));
				       out(CHR(lf));
				     END;

			   CHR(etx): BEGIN
				       length:=0;
				     END;

			   OTHERWISE BEGIN
				       out(c);
				       IF xpos = maxx
					 THEN BEGIN
					   IF ypos = maxy
					     THEN BEGIN
					       out(CHR(esc));
					       out('S');   { scroll up 1 line }
					     END;
					   setxy(0,ypos+1);
					 END
					 ELSE BEGIN
					   { setxy(xpos+1,ypos); }
					   xpos := xpos + 1;
					 END; { of IF }
				     END;

			 END; { of CASE c OF }
			 updatecursor;
		       END; { of WHILE DO BEGIN }
		       IF request = startwrite THEN call(fp^.feot, fp);
		     END; { of startwrite, writebytes case }

       OTHERWISE     BEGIN
		       ioresult := ORD(ibadrequest);
		     END;

      END; { of CASE request OF }
    END;
end;


PROCEDURE dummyproc;
BEGIN
END;


procedure crtinit;
 var cursaddr: crtcmdwrd; i,k: integer;
 begin
 IF internal_console
    THEN BEGIN
      with syscom^.crtinfo do
	 begin
	 screen:=anyptr(crtmemaddr);
	 screenwidth:=width;
	 screenheight:=height;
	 maxx:=width-1;
	 maxy:=height-1;
	 screensize:=width*height;

	 for i:=0 to screensize-1
		  do screen^[i].wholeword:=ord(' ');  {clear screen}
	 pm6845addrreg:=anyptr(crtcontroladdr);
	 pm6845comdreg:=anyptr(crtcontroladdr+2);
	 cursaddr.longword:=integer(screen) mod 8192 div 2;
	 cursaddr.textfield:=alphastate;
	 cursaddr.softfield:=alphastate;
	 crtcommand(12, cursaddr.topbyte);
	 crtcommand(13, cursaddr.botbyte);
	 defaulthighlight := 0; highlight := 0;
	 if sysflag.crtconfigreg then hascolor := crtidreg.colorinfo > cinfo0
				 else hascolor := false;
	 if changehardware then for k := 0 to 11 do crtcommand(k,crtcon[k]);
	 gotoxy(0,0);
	 dumpalphahook := dumpa;
	 dumpgraphicshook := dumpg;
	 togglealphahook := togglea;
	 togglegraphicshook := toggleg;
	 end;
    END
    ELSE BEGIN
      WITH syscom^.crtinfo DO BEGIN
	screen     :=NIL;
	screenwidth:=width;
	screenheight:=height;
	screensize :=width*height;
	maxx       :=width-1;
	maxy       :=height-1;
	xpos       :=0;
	ypos       :=0;
	defaulthighlight := 0;
	dumpalphahook    := dummyproc;
	dumpgraphicshook := dummyproc;
	togglealphahook  := dummyproc;
	togglegraphicshook := dummyproc;
	ALPHASTATE := TRUE;
      END; { of WITH DO BEGIN }
    END;
 end;

end;

import crt, loader;

begin
  crtinit;
  markuser;
end.



.resume
.need 55
.suspend
					       (*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)

(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)


$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$
$SEARCH  'KBD','FINDC'$

program initbat(OUTPUT);

module bat;
import sysglobals, kbd, FINDC;
export
var batterypresent[-563]: boolean;

    procedure batcommand(cmd:byte; numdata:integer; b1, b2, b3, b4, b5: byte);
    function  batbytereceived:byte;
    procedure batinit;

implement

var bat8041statusreg[4554785 { 458001 } ]: char;
    bat8041cmdreg   [4554785 { 458001 } ]: char;
    bat8041datareg  [4554753 { 458021 } ]: char;

procedure wait4batready;
var batstatus: stat8041;
begin
  IF internal_console
    THEN BEGIN
      repeat
	batstatus.statchar:=bat8041statusreg;
      until not batstatus.busy;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure wait4batreadready;
var batstatus: stat8041;
begin
  IF internal_console
    THEN BEGIN
      repeat
	batstatus.statchar:=bat8041statusreg;
      until batstatus.readready;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;


procedure batcommand(cmd: byte; numdata: integer; b1, b2, b3, b4, b5: byte);

  procedure batdataout(d: byte);
  begin wait4batready; bat8041datareg := chr(d); end;

begin
  IF internal_console
    THEN BEGIN
      if batterypresent then
	begin
	wait4batready;
	bat8041cmdreg := chr(cmd);
	if numdata >= 1 then batdataout(b1);
	if numdata >= 2 then batdataout(b2);
	if numdata >= 3 then batdataout(b3);
	if numdata >= 4 then batdataout(b4);
	if numdata >= 5 then batdataout(b5);
	end;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

function batbytereceived:byte;
begin
  IF internal_console
    THEN BEGIN
      wait4batreadready;
      batbytereceived:=ord(bat8041datareg);
    END
    ELSE BEGIN
      batbytereceived:=0;   { return dummy byte }
    END;
end;

procedure batinit;
begin
  IF internal_console
    THEN BEGIN
      batcommand(167,2,23,112,0,0,0); {set power fail to 60 seconds}
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

end;

import bat, loader;

begin
  batinit;
  markuser;
end.


.resume
.need 55
.suspend
(*

 (c) Copyright Hewlett-Packard Company, 1983.
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                         *)


(* REMOTE CONSOLE MODIFICATION - 6/27/1983 *)



$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'KBD','BAT','FINDC'$

program clockinit;

module clock;
import sysglobals, asm, misc, kbd, bat, FINDC;
export
  type
  rtctime = packed record
	       packedtime,packeddate:integer;
	    end;

  function  sysclock: integer;   {centiseconds from midnight}
  procedure sysdate (var thedate: daterec);
  procedure systime (var thetime: timerec);
  procedure setsysdate ( thedate: daterec);
  procedure setsystime ( thetime: timerec);
  procedure initclock;

implement

type trickint = packed record
		   case integer of
		0: ( ipart: integer );
		1: ( byte3: byte;
		     byte2: byte;
		     byte1: byte;
		     byte0: byte  )
	       end;
var  boottype[-576]: shortint;

procedure readtime (var thetime: rtctime);
const
  cmmd31=49;                   {31 hex to load timer output buffer with time}
  cmmd13=19;                   {13 hex to load data buffer with first byte}
  cmmd14=20;                   {14 hex to load data buffer with second byte}
  cmmd15=21;                   {15 hex to load data buffer with third  byte}
  cmmd16=22;                   {16 hex to load data buffer with fourth byte}
  cmmd17=23;                   {17 hex to load data buffer with fifth  byte}
var
  t: trickint;
begin
IF internal_console
    THEN BEGIN
      with t do
	begin
	  lockup;
	  ipart := 0;
	  kbdcommand(cmmd31,0,0,0,0);
	  kbdcommand(cmmd13,0,0,0,0);  byte0 := read8041byte;
	  kbdcommand(cmmd14,0,0,0,0);  byte1 := read8041byte;
	  kbdcommand(cmmd15,0,0,0,0);  byte2 := read8041byte;
	  thetime.packedtime := ipart;
	  ipart := 0;
	  kbdcommand(cmmd16,0,0,0,0);  byte0 := read8041byte;
	  kbdcommand(cmmd17,0,0,0,0);  byte1 := read8041byte;
	  thetime.packeddate := ipart;
	  lockdown;
	end;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure sysdate(var thedate: daterec);
var yr,dd,mm,k,k1,k2: integer;
    ltime:  rtctime;
begin
IF internal_console
    THEN BEGIN
      readtime(ltime);
      k:=ltime.packeddate+1;
      k1:= k*4-1;
      yr:= k1 div 1461;
      dd:= (k1-(1461*yr)+4) div 4;
      k2:=(5*dd-3);
      mm:=k2 div 153;
      dd:=k2-153*mm;
      dd:=(dd+5) div 5;
      if  mm<10 then mm:=mm+3
      else
	begin mm:=mm-9;yr:=yr+1; end;
      with thedate do
	begin
	  {LAF 880101 year range is now 0..127}
	  {year:=yr mod 100;{to protect our file}
	  month:=mm;
	  day:=dd;
	end;
    END
    ELSE BEGIN
      WITH THEDATE DO
	BEGIN
	  YEAR:=00;
	  MONTH:=01;
	  DAY:=01;
	END;
    END;
end;

function sysclock: integer;
var ltime: rtctime;
begin
IF internal_console
    THEN BEGIN
      readtime(ltime);
      sysclock := ltime.packedtime;
    END
    ELSE BEGIN
      sysclock := 0;
    END;
end;

procedure systime(var thetime: timerec);
var t: integer;
begin
IF internal_console
    THEN BEGIN
      t:=sysclock mod (24*360000);
      with thetime do
	begin
	  hour := t div 360000;
	  minute := (t-(hour*360000)) div 6000;
	  centisecond := t mod 6000;
	end;
    END
    ELSE BEGIN
      WITH THETIME DO
	BEGIN
	  HOUR        := 00;
	  MINUTE      := 00;
	  CENTISECOND := 0000;
	END;
    END;
end;

procedure setrtctime(thetime: rtctime);
const
  cmmdb7=183;
  cmmd40=64;
  cmmdad=173;          {AD hex is the command to set the time of day}
  cmmdaf=175;          {AF hex is the command to set the day portion of time}
var
  t1,t2: trickint;
begin
IF internal_console
    THEN BEGIN
      t1.ipart := thetime.packeddate;
      t2.ipart := thetime.packedtime;
      kbdcommand(cmmdad,3,t2.byte0,t2.byte1,t2.byte2);
      kbdcommand(cmmdaf,2,t1.byte0,t1.byte1,0);
      batcommand(cmmdb7,5,t1.byte1,t1.byte0,t2.byte2,t2.byte1,t2.byte0);
      batcommand(cmmd40,0,0,0,0,0,0);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure setsysdate(thedate: daterec);
var   ltime: rtctime;  yr,mth,dy: integer;
begin
IF internal_console
    THEN BEGIN
      readtime(ltime);
      with ltime,thedate do
	begin
	  yr := year;  mth := month;  dy := day;
	  if mth>2 then mth:=mth-3
		   else begin  mth:=mth+9; yr:=yr-1; end;
	  packeddate:=((1461* yr) div 4 +(153*mth+2) div 5)+dy-1;
	end;
      setrtctime(ltime);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure setsystime(thetime: timerec);
var   ltime: rtctime;  hr,min,ctsec: integer;
begin
IF internal_console
    THEN BEGIN
      readtime(ltime);
      with ltime, thetime do
	begin
	  hr := hour;  min := minute;  ctsec := centisecond;
	  packedtime:=((hr*3600)+min*60)*100+ctsec;
	end;
      setrtctime(ltime);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure inittime;
var thetime:rtctime;
const
  cmmd41=65;                    {65 hex to load timer output buffer with time}
  cmmdf7=247;                   {F7 hex to load data buffer with first byte}
  cmmdf6=246;                   {F6 hex to load data buffer with second byte}
  cmmdf5=245;                   {F5 hex to load data buffer with third  byte}
  cmmdf4=244;                   {F4 hex to load data buffer with fourth byte}
  cmmdf3=243;                   {F3 hex to load data buffer with fifth  byte}
  cmmdf2=242;                   {F2 hex to load a letter 'B',or'P', or'H' for
					 Basic, or Pascal, or HPL respectively}
var  t: trickint;
begin
IF internal_console
    THEN BEGIN
      thetime.packedtime := 0;
      thetime.packeddate := 0;
      if batterypresent then
       with t do
	begin
	setintlevel(2);

	ipart := 0;
	batcommand(cmmd41,0,0,0,0,0,0);
	batcommand(cmmdf7,0,0,0,0,0,0);   byte1 := batbytereceived;
	batcommand(cmmdf6,0,0,0,0,0,0);   byte0 := batbytereceived;
	thetime.packeddate := ipart;

	ipart := 0;
	batcommand(cmmdf5,0,0,0,0,0,0);   byte2 := batbytereceived;
	batcommand(cmmdf4,0,0,0,0,0,0);   byte1 := batbytereceived;
	batcommand(cmmdf3,0,0,0,0,0,0);   byte0 := batbytereceived;
	thetime.packedtime := ipart;

	setintlevel(0);{lower cpu int level}
	end;
      setrtctime(thetime);
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

procedure initclock;
begin
IF internal_console
    THEN BEGIN
      if boottype = 0 {powerup} then inittime;
      boottype := 18;
    END
    ELSE BEGIN
      { absolutely nothing }
    END;
end;

end;

import clock, loader;

begin
  initclock;
  markuser;
end.

.newpage
.3
Internals approach


This second example is the 'internals' approach.  This approach
allows you to configure your console exactly as you want.  The
drawbacks are that it is more complicated to understand and unless
you put in the effort, it will be less flexable.  It is smaller in
memory requirements.

There are two main approaches to putting in this type of remote
console driver.  The first is to merely add two new modules to the
console part of INITLIB.  This has the advantage of still allowing
some Series 200 interaction on the normal keyboard.  The other
approach is to replace part of the console modules with new
drivers. This approach has the advantage of being less code in
INITLIB but it does not allow ANY use of the normal keyboard.



.4
Steps to Modify Drivers

There are a specific set of operations that need to happen to
create a Pascal system with a remote console.  These steps are:

.step 1
BACK UP

Back up your BOOT disk and your CTABLE source.

.step 2
CREATE NEW DRIVERS

Create a remote console (input and output) set of access modules
(via the EDITOR and COMPILER). These modules correspond to the
KEYS and CRT modules that contain the routines KBDIO and CRTIO.

.step 3
INSTALL DRIVERS IN INITLIB

Install these modules in INITLIB on your boot disk (via the
LIBRARIAN).  The modules can either be added to the existing
INITLIB modules or they can replace the current modules (i.e.
KEYS and CRT).

.suspend
   module       purpose                                 normally
							requires
   -------------------------------------------------------------

   KBD          fundamental support of the
		'keyboard' 8041 uP including
		interrupt handling

   KEYS         support of the keyboard part            KBD
		of the keyboard

   CRT          support of the CRT                      KBD,KEYS

   BAT          support of the battery                  KBD
		part of the 'keyboard'

   CLOCK        support of the timers                   KBD
		part of the 'keyboard'

.resume

.step 4
MODIFY CTABLE

Change the TABLE file on your boot disk to make use of these new
modules.  This is done by editing CTABLE and compiling it and then
copying the object file onto the TABLE file on the boot disk.

.need 7
.step 5
ADD MISCINFO TO BOOT

Change the system information about the console device with a
MISCINFO file.  This is done by compiling and running the MISCINFO
program.  This program will put a MISCINFO data file onto the boot
disk.
.exit

.4
Unusual Aspects

There is a strange aspect of the 'internals' approach drivers
relates to CTABLE and INITUNITS.  Before TABLE has had a chance to
execute, messages are written to the CRT.  The module INITUNITS
initializes a minimum TABLE (CTABLE) to handle the definitions.  It
would be possible to change this module to specify the correct
interface.  In the example drivers a different approach was taken.
The default TABLE (CTABLE) and INITUNITS specifies a select code of
0 for the CONSOLE and SYSTERM devices.  The example drivers make
use of this and the fact that external interface cards can only be
on select codes of 8 and above.  The code contains a line:

|C   IF myisc <= 7 THEN myisc := 20;|A

This line will re-direct the I/O to select code 20.  If you think
about this for a bit, you will notice that you do not need to
change CTABLE unless you are going to use more than one device as
a remote volume.


.4
Modifying CTABLE

The CTABLE file needs to be modified to allow the remote console to
work.  The normal CTABLE (as shipped with the default system) will
specify where the default CONSOLE and SYSTERM volumes exist and
what type of units they are.

The CTABLE changes to allow for the addition of the new remote
console drivers look like the following:

.suspend
   procedure tea_crt(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM',
	   'REMC_CRTIO',                       { change drv }
	   21,                                 { change isc }
	   0,0,0,0,0,'CONSOLE',#0,T,T,F,0);
     end;

   procedure tea_kbd(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM',
	   'REMK_KBDIO',                       { change drv }
	   21,                                 { change isc }
	   0,0,0,0,0,'SYSTERM',#0,F,T,F,0);
     end;

.resume
The CTABLE changes to allow for the replacement of the remote
console drivers look like the following:

.suspend
   procedure tea_crt(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM','CRT_CRTIO',
	   21,                                 { change isc }
	   0,0,0,0,0,'CONSOLE',#0,T,T,F,0);
     end;


   procedure tea_kbd(un:unitnum);
     begin
       tea(un,'MISC_UNBLOCKEDDAM',
	   'KEYS_KBDIO',
	   21,                                 { change isc }
	   0,0,0,0,0,'SYSTERM',#0,F,T,F,0);
     end;

.resume

The CTABLE also has an alternate field that can be used for
optional paramters (like baud rate or whatever).  The alternate
parameter is the parameter right before the volume name (e.g.
'SYSTERM').

The approach taken with the remote console is such that these
drivers can be used with other volumes in the system.  Whether or
not you wish to use the drivers as a remote console, it is possible
to use the new KEYS and CRT modules as a general remote interface.
Once the modules are placed in INITLIB, add the volumes to CTABLE
source (and TABLE object file on the boot device).


.4
Add MISCINFO to BOOT

The MISCINFO file needs to exist and specify an external CRT. Refer
to the section on MISCINFO for more information.



.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installkbd;

MODULE kbd;

IMPORT sysglobals,asm,bootdammodule,isr,misc;

EXPORT
  TYPE

  crtconsttype = PACKED ARRAY [0..11] of BYTE;

  CRTFREC = PACKED RECORD
	       NOBREAK,STUPID,SLOWTERM,HASXYCRT,
	       HASLCCRT{built in crt},HASCLOCK,
	       canupscroll,candownscroll      :    BOOLEAN;
	     END;

  B9 = PACKED ARRAY[0..8]  OF BOOLEAN;
  B14= PACKED ARRAY[0..13] OF BOOLEAN;
  CRTCREC = PACKED RECORD         (* CRT CONTROL CHARS *)
	       RLF,NDFS,ERASEEOL,
	       ERASEEOS,HOME,
	       ESCAPE             : CHAR;
	       BACKSPACE          : CHAR;
	       FILLCOUNT          : 0..255;
	       CLEARSCREEN,
	       CLEARLINE          : CHAR;
	       PREFIXED           : B9
	    END;

  CRTIREC = PACKED RECORD        (* CRT INFO & INPUT CHARS *)
	       WIDTH,HEIGHT      : shortint;
	       crtmemaddr,crtcontroladdr,
	       keybufferaddr,progstateinfoaddr:INTEGER;
	       keybuffersize: shortint;
	       crtcon            : crtconsttype;
	       RIGHT,LEFT,DOWN,UP: CHAR;
	       BADCH,CHARDEL,STOP,
	       BREAK,FLUSH,EOF   : CHAR;
	       ALTMODE,LINEDEL   : CHAR;
	       BACKSPACE,
	       ETX,PREFIX        : CHAR;
	       PREFIXED          : B14 ;
	       CURSORMASK        : INTEGER;
	       SPARE             : INTEGER;
	    END;

  ENVIRON = RECORD
	      MISCINFO: CRTFREC;
	      CRTTYPE:  INTEGER;
	      CRTCTRL:  CRTCREC;
	      CRTINFO:  CRTIREC;
	    END;

    stat8041 = PACKED RECORD
		 case INTEGER of
	       0: (pad1:     0..63;
		   busy:     BOOLEAN;
		   readready:BOOLEAN);
	       1: (statchar: CHAR);
	       END;
    crtword=   RECORD case INTEGER of
		 1:(highlightbyte,character:CHAR;);
		 2:(wholeword: shortint);
	       END;
    kbdhooktype = PROCEDURE(VAR statbyte,databyte: BYTE;
			    VAR dokey: BOOLEAN);

    timerhooktype = PROCEDURE(statbyte,databyte: BYTE;
			      VAR dotimer: BOOLEAN);

    keybuffertype= ARRAY[0..maxint] of crtword;

VAR

    SYSCOM: ^ENVIRON;
    changehardware: BOOLEAN;
    progstateinfo:^keybuffertype;

    ALPHASTATE['ALPHAFLAG']:BOOLEAN;
    GRAPHICSTATE['GRAPHICSFLAG']:BOOLEAN;

    kbdhook: kbdhooktype;
    timerhook: timerhooktype;
    dumpalphahook: PROCEDURE;
    dumpgraphicshook: PROCEDURE;
    togglealphahook: PROCEDURE;
    togglegraphicshook: PROCEDURE;

    kbeepfreq, kbeepdur : BYTE;

    PROCEDURE beep;
    PROCEDURE beeper(frequency,duration : BYTE);

    PROCEDURE kbdinit;
    PROCEDURE lockedaction(a: action);

    PROCEDURE kbdcommand(cmd        : BYTE;
			 numdata    : INTEGER;
			 b1, b2, b3 : BYTE);
    FUNCTION read8041byte : BYTE;

IMPLEMENT


CONST
  B9826INFO=CRTIREC[
	   WIDTH             : 80,HEIGHT:24,
	   crtmemaddr        : 5316608,
	   crtcontroladdr    : 5341185,
	   keybufferaddr     : 5320448,
	   progstateinfoaddr : 5320592,
	   keybuffersize     : 72,
	   crtcon            : crtconsttype [114,80,76,7,
					     26,10,25,25,
					     0,14,76,13],
	   RIGHT{FS}         : CHR(28),
	   LEFT{BS}          : CHR(8),
	   DOWN{LF}          : CHR(10),
	   UP{US}            : CHR(31),
	   BADCH{?}          : CHR(63),
	   CHARDEL{BS}       : CHR(8),
	   STOP{DC3}         : CHR(19),
	   BREAK{DLE}        : CHR(16),
	   FLUSH{ACK}        : CHR(6),
	   EOF{ETX}          : CHR(3),
	   ALTMODE{ESC}      : CHR(27),
	   LINEDEL{DEL}      : CHR(127),
	   BACKSPACE{BS}     : CHR(8),
	   ETX               : CHR(3),
	   PREFIX            : CHR(0),
	   PREFIXED          : B14[14 OF FALSE],
	   CURSORMASK        : 0,
	   SPARE             : 0];


CONST
  ENVIRONC=ENVIRON[MISCINFO:CRTFREC[
			    NOBREAK  : FALSE,
			    STUPID   : FALSE,
			    SLOWTERM : FALSE,
			    HASXYCRT : TRUE,
			    HASLCCRT : TRUE,  {?}
			    HASCLOCK : TRUE,
			    canupscroll   : TRUE,
			    candownscroll : TRUE],
		   CRTTYPE:0,
		   CRTCTRL : CRTCREC[
			    RLF      : CHR(31),
			    NDFS     : CHR(28),
			    ERASEEOL : CHR(9),
			    ERASEEOS : CHR(11),
			    HOME     : CHR(1),
			    ESCAPE   : CHR(0),
			    BACKSPACE: CHR(8),
			    FILLCOUNT: 10,
			    CLEARSCREEN:   CHR(0),
			    CLEARLINE:     CHR(0),
			    PREFIXED : B9[9 OF FALSE]],
		    CRTINFO : CRTIREC [
			    WIDTH            : 50,
			    HEIGHT           : 24,
			    crtmemaddr       : 5316608,
			    crtcontroladdr   : 5308417,
			    keybufferaddr    : 5319008,
			    progstateinfoaddr: 5319092,
			    keybuffersize    : 42,
			    crtcon: crtconsttype [64,50,49,10,25,9,
						  25,25,0,11,74,11],
			    RIGHT{FS}        : CHR(28),
			    LEFT{BS}         : CHR(8),
			    DOWN{LF}         : CHR(10),
			    UP{US}           : CHR(31),
			    BADCH{?}         : CHR(63),
			    CHARDEL{BS}      : CHR(8),
			    STOP{DC3}        : CHR(19),
			    BREAK{DLE}       : CHR(16),
			    FLUSH{ACK}       : CHR(6),
			    EOF{ETX}         : CHR(3),
			    ALTMODE{ESC}     : CHR(27),
			    LINEDEL{DEL}     : CHR(127),
			    BACKSPACE{BS}    : CHR(8),
			    ETX              : CHR(3),
			    PREFIX           : CHR(0),
			    PREFIXED         : B14[14 OF FALSE],
			    CURSORMASK       : 0,
			    SPARE            : 0]];


PROCEDURE lockedaction(a: action);
label 1;
VAR i: INTEGER;
BEGIN
 IF locklevel = 0 THEN call(a)
 ELSE
   BEGIN
   i := actionspending;
   WHILE i>0 DO IF deferredaction[i]=a THEN goto 1 ELSE i := i - 1;
   IF actionspending = 10 THEN beep
   ELSE BEGIN
	actionspending := actionspending + 1;
	deferredaction[actionspending] := a;
	END;
   END;
1:
END;

FUNCTION read8041byte:BYTE;
BEGIN
  read8041byte:=0;
END;

PROCEDURE wait4kbdready;
BEGIN
END;

PROCEDURE kbdcommand(cmd        : BYTE;
		     numdata    : INTEGER;
		     b1, b2, b3 : BYTE);
BEGIN
END;

PROCEDURE beep;
BEGIN
END;

PROCEDURE beeper(frequency,duration : BYTE);
BEGIN
END;



PROCEDURE dummykbdhook(VAR stat, data: BYTE;
		       VAR doit: BOOLEAN);
BEGIN
END;

PROCEDURE dummytimerhook(stat, data: BYTE;
			 VAR doit: BOOLEAN);
BEGIN
END;


PROCEDURE INITSYSCOM;
VAR f: file of ENVIRON;
    dcrtinfo['dcrtinfo']: anyptr;
BEGIN
NEW(SYSCOM);  SYSCOM^ := ENVIRONC;
WITH syscom^ DO
  BEGIN
  IF not sysflag.alpha50 THEN crtinfo := B9826info;
  RESET(F, NODESTR+'MISCINFO','shared');
  IF IORESULT = ORD(INOERROR) THEN READ(F, SYSCOM^);
  changehardware := IORESULT = ORD(INOERROR);
  dcrtinfo := ADDR(crtinfo);
  END;
END; {INITSYSCOM}

PROCEDURE kbdinit;
BEGIN
  kbdhook := dummykbdhook;
  timerhook := dummytimerhook;
  initsyscom;
END;  {kbdinit}

END;    { of module }


IMPORT kbd;

BEGIN
  kbdinit;
END.

.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installkeys;

MODULE keys;
IMPORT sysglobals,asm,misc,kbd, iodeclarations,general_0,iocomasm;

EXPORT
  CONST
    yencode = 92; { Yen symbol overlays USASCII
		    backslash (\) in Kana machines }

  TYPE
    langtype = (gringo,french,german,swedish{,finnish},
		spanish,katakana);

  VAR
    kbdlangjumper: RECORD CASE BYTE of
		     0: (b:PACKED RECORD
			     dummy,jnum:BYTE
			   END);
		     1: (jlang:langtype); {16 bit}
		   END;
    kbdwaithook         : PROCEDURE;
    kbdreleasehook      : PROCEDURE;

    keybuffer           : ^keybuffertype;
    keybufsize          : shortint;
    keybuflength        : shortint;
    capslock            : BOOLEAN;
    kanaflag            : BOOLEAN;

  PROCEDURE kbdio (     fp              : fibp;
			request         : amrequesttype;
			ANYVAR buffer   : window;
			length          : INTEGER ;
			position        : INTEGER);
  PROCEDURE initkeys;

IMPLEMENT


  VAR  eol_lying_around : PACKED ARRAY[type_isc] OF BOOLEAN;
       myisc            : shortint;

       newdrivers       : drv_table_type;




{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset(mytemp : ANYPTR);
BEGIN
  { do nothing so that the configuration stays the same }
END;




PROCEDURE myinit;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN iocontrol(myisc,28,0);               { no EOL characters }
  iocontrol(myisc,12,1);                      { connect the card  }

  newdrivers := isc_table[myisc].io_drv_ptr^; { copy card dvrs    }
  newdrivers.iod_init := new_reset;           { put in new reset  }
  isc_table[myisc].io_drv_ptr := ADDR(newdrivers); { install drvs }
END;


FUNCTION inchar : CHAR;
VAR     x       : CHAR;
BEGIN
  IF eol_lying_around[myisc]
    THEN BEGIN
      inchar := eol;
      eol_lying_around[myisc] := FALSE;
    END
    ELSE BEGIN
      WITH isc_table[myisc] DO
      CALL (io_drv_ptr^.iod_rdb ,
	     io_tmp_ptr ,
	     x);
      inchar:=x;
    END;
END;




FUNCTION kbdbusy : BOOLEAN;
VAR     x       : INTEGER;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
      { check inbound queue for data }
      x:=iostatus(myisc,5);
      IF (x=1) OR (x=3) OR eol_lying_around[myisc]
	THEN kbdbusy:=FALSE
	ELSE kbdbusy:=TRUE;
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
      x:=iostatus(myisc,10);
      { check character buffer for data }
      IF bit_set(x,0) OR eol_lying_around[myisc]
	THEN kbdbusy:=FALSE
	ELSE kbdbusy:=TRUE;
    END;
END;




PROCEDURE kbdio (       fp              : fibp;
			request         : amrequesttype;
			ANYVAR buffer   : window;
			length          : INTEGER ;
			position        : INTEGER);

VAR   buf               : charptr;
BEGIN
 myisc := unitable^[fp^.funit].sc;
 IF myisc <= 7 THEN myisc := 20;
 ioresult := ORD(inoerror);
 buf := ADDR(buffer);
 CASE request OF

   flush:       BEGIN
		  myinit;
		END;

   unitstatus:  BEGIN
		  fp^.fbusy := kbdbusy  ;
		END;

   clearunit:   BEGIN
		  myinit;
		END;

   readtoeol,
   readbytes,
   startread:   BEGIN
		  IF request = readtoeol
		    THEN BEGIN
		      { the buffer is a string, so set it to empty }
		      buf := ADDR(buf^, 1);
		      buffer[0] := chr(0);
		    END;
		  WHILE length>0 DO BEGIN
		    buf^ := inchar;
		    IF buf^ = chr(etx)
		      THEN length := 0
		      ELSE length := length-1;
		    IF (buf^=eol) and (request=readtoeol)
		      THEN BEGIN
			eol_lying_around[myisc] := TRUE;
			length := 0
		      END
		      ELSE BEGIN
			fp^.feoln := FALSE;
			buf := ADDR(buf^, 1);
			IF request = readtoeol
			  THEN buffer[0] := CHR(ORD(buffer[0])+1);
		      END;
		  END; { of WHILE DO }
		  IF request = startread THEN CALL(fp^.feot, fp);
		END;

   OTHERWISE    BEGIN
		  ioresult := ORD(ibadrequest);
		END;

 END; { of CASE }
END; { of PROCEDURE }




PROCEDURE dummyproc;
BEGIN
  { nothing }
END;




PROCEDURE initkeys;
VAR localisc  : shortint;
BEGIN
  FOR localisc := 0 TO 31 DO eol_lying_around[localisc] := FALSE;
  WITH syscom^.crtinfo DO BEGIN
    keybuffer:=NIL;
    keybufsize:=1;
    kanaflag:=FALSE;
    capslock:=TRUE;
  END;
END;

END;{ of module }


IMPORT keys;

BEGIN
  initkeys;
END.

.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installcrt;


MODULE crt;
IMPORT sysglobals,asm,misc,kbd,keys, iodeclarations,general_0 ;
EXPORT
  TYPE scrtype  = PACKED ARRAY[0..maxint] OF crtword;
       scrptr   = ^scrtype;

  VAR screenwidth       : shortint;
      screenheight      : shortint;
      maxx,maxy         : shortint;
      screensize        : shortint;
      xpos,ypos         : shortint;
      screen            : scrptr;
      defaulthighlight  : shortint;

  PROCEDURE crtinit;
  PROCEDURE crtio (    fp              : fibp;
			request         : amrequesttype;
			ANYVAR buffer   : window;
			length          : INTEGER;
			position        : INTEGER);

  PROCEDURE updatecursor;

  PROCEDURE setrunlight(x:CHAR);

IMPLEMENT


CONST dc1           = 17 ;
VAR   myisc         : shortint;
      newdrivers    : drv_table_type;




{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset(mytemp : ANYPTR);
BEGIN
  { do nothing so that the configuration stays the same }
END;






PROCEDURE myinit;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN iocontrol(myisc,28,0);               { no EOL characters }
  iocontrol(myisc,12,1);                      { connect the card  }

  newdrivers := isc_table[myisc].io_drv_ptr^; { copy card dvrs    }
  newdrivers.iod_init := new_reset;           { put in new reset  }
  isc_table[myisc].io_drv_ptr := ADDR(newdrivers); { install drvs }
END;




FUNCTION inchar : CHAR;
VAR  x          : CHAR;
BEGIN
  WITH isc_table[myisc] DO
  CALL (io_drv_ptr^.iod_rdb ,
	 io_tmp_ptr ,
	 x);
  inchar:=x;
END;

PROCEDURE out(x:CHAR);
BEGIN
  WITH isc_table[myisc] DO
  CALL (io_drv_ptr^.iod_wtb ,
	 io_tmp_ptr ,
	 x);
END;


PROCEDURE output(s    :io_STRING);
VAR i:INTEGER;
BEGIN
  FOR i:=1 to STRLEN(s) DO out(s[i]);
END;



PROCEDURE localbeep;
BEGIN
   out(CHR(7));        { send beep to card }
END;




PROCEDURE setrunlight(x:CHAR);
BEGIN
  { DO nothing at all but have an exported PROCEDURE }
END;



PROCEDURE updatecursor;
BEGIN
  { DO nothing at all but have an exported PROCEDURE }
END;

PROCEDURE getxy(VAR x,y: INTEGER);
VAR dummy : CHAR;
BEGIN
  x:=0;  y:=0;
  { go thru sequence to get actual position }
  out(CHR(esc));        out('`');       { send cursor sense abse   }
  out(CHR(dc1));                        { tell terminal I am ready }
  dummy := inchar;                      { get esc }
  dummy := inchar;                      { get &   }
  dummy := inchar;                      { get '   }
  x     := ORD(inchar)-48;              { get column digit 1 }
  x     := ORD(inchar)-48+x*10;         { get column digit 2 }
  x     := ORD(inchar)-48+x*10;         { get column digit 3 }
  dummy := inchar;                      { get c   }
  y     := ORD(inchar)-48;              { get row    digit 1 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 2 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 3 }
  dummy := inchar;                      { get Y   }
  dummy := inchar;                      { get cr  }

  xpos := x;      ypos := y;
END;

PROCEDURE setxy(x, y: shortint);
VAR s : string[9];
    p : INTEGER;
BEGIN
  IF x>=screenwidth  THEN xpos:=maxx
		     ELSE IF x<0 THEN xpos:=0
				 ELSE xpos := x;
  IF y>=screenheight THEN ypos:=maxy
		     ELSE IF y<0 THEN ypos:=0
				 ELSE ypos := y;

  { send xpos/ypos via escape esc & a xx y yy C }
  SETSTRLEN(s,9);
  STRWRITE (s,1,p,CHR(esc),'&a',ypos:2,'y',xpos:2,'C');
  output   (s);
END;


PROCEDURE gotoxy(x,y: INTEGER);
BEGIN
  setxy(x,y);
  updatecursor;
END;





PROCEDURE crtio (     fp              : fibp;
		      request         : amrequesttype;
		      ANYVAR buffer   : window;
		      length          : INTEGER;
		      position        : INTEGER);
VAR c   : CHAR;
    s   : STRING[1];
    buf : charptr;
    d,e : INTEGER;
BEGIN
 myisc := unitable^[fp^.funit].sc;
 IF myisc <= 7 THEN myisc := 20;
 ioresult := ORD(inoerror);
 buf := ADDR(buffer);
 CASE request OF

  setcursor:    BEGIN
		  gotoxy(fp^.fxpos, fp^.fypos);
		END;

  getcursor:    BEGIN
		  getxy (fp^.fxpos, fp^.fypos);
		END;

  flush:        BEGIN
		  myinit;
		END;

  unitstatus:   BEGIN
		   kbdio(fp, unitstatus,buffer,length,position);
		END;

  clearunit:    BEGIN
		  myinit;
		END;

  readtoeol:    BEGIN
		  buf := ADDR(buf^, 1);
		  buffer[0] := CHR(0);
		  WHILE length>0 DO BEGIN
		    kbdio(fp, readtoeol,  s, 1, 0);
		    IF  STRLEN(s)=0
		      THEN BEGIN
			length := 0
		      END
		      ELSE BEGIN
			length := length - 1;
			crtio(fp, writebytes, s[1], 1, 0);
			buf := ADDR(buf^, 1);
			buffer[0] := CHR(ORD(buffer[0])+1);
		      END; { of IF }
		  END;     { of WHILE DO BEGIN }
		END;       { of BEGIN }

  startread,
  readbytes:    BEGIN
		  WHILE length>0 DO
		    BEGIN
		    kbdio(fp, readbytes,  buf^, 1, 0);
		    IF buf^ = CHR(etx) THEN length := 0
				       ELSE length := length - 1;
		    IF buf^ = eol
		      THEN crtio(fp, writeeol,   buf^, 1, 0)
		      ELSE crtio(fp, writebytes, buf^, 1, 0);
		    buf := ADDR(buf^, 1);
		    END;
		  IF request = startread THEN call(fp^.feot, fp);
		  END;

  writeeol:     BEGIN
		  IF ypos=maxy
		    THEN BEGIN
		       out(CHR(esc));
		       out('S');             { scroll up 1 line }
		  END;
		  gotoxy(0, ypos+1);
		END;

  startwrite,
  writebytes:   BEGIN
		  WHILE length>0 DO BEGIN
		    c:=buf^; buf:=ADDR(buf^,1); length:=length-1;
		    CASE c OF

		      homechar: BEGIN
				  setxy(0,0);
				END;

		      leftchar: BEGIN
				  out(CHR(bs));
				END;

		      rightchar:BEGIN
				  getxy(d,e);
				  IF (xpos = maxx) and (ypos<maxy)
				    THEN setxy(0, ypos+1)
				    ELSE setxy(xpos+1, ypos);
				END;

		      upchar:   BEGIN
				  IF (ypos<=1)
				    THEN BEGIN
				      out(CHR(esc));
				      out('L');      { insert line }
				    END;
				  IF (ypos>0)
				    THEN BEGIN
				      { out(CHR(esc));
				      out('A'); }
				      setxy(xpos,ypos-1);
				    END;
				END;

		      downchar: BEGIN
				  IF (ypos=maxy)
				    THEN BEGIN
				      out(CHR(esc));
				      out('S'); { scroll up 1 line }
				    END
				    ELSE BEGIN
				      { out(CHR(esc));
				      out('B'); }
				      setxy(xpos,ypos+1);
				    END;
				END;

		      bellchar: BEGIN
				  localbeep;
				END;

		      cteos:   BEGIN
				 out(CHR(esc));
				 out('J');
			       END;

		      cteol:   BEGIN
				 out(CHR(esc));
				 out('K');
			       END;

		      clearscr:BEGIN
				 setxy(0,0);
				 out(CHR(esc));
				 out('J');
			       END;

		      eol:      BEGIN
				  out(CHR(cr));
				  out(CHR(lf));
				END;

		      CHR(etx): BEGIN
				  length:=0;
				END;

		      OTHERWISE BEGIN
				  out(c);
				  IF xpos = maxx
				    THEN BEGIN
				      IF ypos = maxy
					THEN BEGIN
					  out(CHR(esc));
					  out('S'); { scroll up 1 line }
					END;
				      setxy(0,ypos+1);
				    END
				    ELSE BEGIN
				      { setxy(xpos+1,ypos); }
				      xpos := xpos + 1;
				    END; { of IF }
				END;

		    END; { of CASE c OF }
		    updatecursor;
		  END; { of WHILE DO BEGIN }
		  IF request = startwrite THEN call(fp^.feot, fp);
		END; { of startwrite, writebytes case }

  OTHERWISE     BEGIN
		  ioresult := ORD(ibadrequest);
		END;

 END; { of CASE request OF }
END;  { of PROCEDURE crtio }



PROCEDURE dummyproc;
BEGIN
  { nothing }
END;



PROCEDURE crtinit;
 BEGIN
   WITH syscom^.crtinfo DO BEGIN
     screen     :=NIL;
     screenwidth:=width;
     screenheight:=height;
     screensize :=width*height;
     maxx       :=width-1;
     maxy       :=height-1;
     xpos       :=0;
     ypos       :=0;
     defaulthighlight := 0;
     dumpalphahook    := dummyproc;
     dumpgraphicshook := dummyproc;
     togglealphahook  := dummyproc;
     togglegraphicshook := dummyproc;
     ALPHASTATE := TRUE;
   END; { of WITH DO BEGIN }
 END;   { of PROCEDURE crtinit }

END;   { of MODULE crt }

IMPORT crt;

BEGIN
  crtinit;
END.

.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installbat;

MODULE bat;
IMPORT sysglobals, kbd;
EXPORT
VAR batterypresent[-563]: BOOLEAN;

    PROCEDURE batcommand(cmd                : BYTE;
			 numdata            : INTEGER;
			 b1, b2, b3, b4, b5 : BYTE);
    FUNCTION  batbytereceived:BYTE;
    PROCEDURE batinit;

IMPLEMENT



PROCEDURE batcommand(cmd                : BYTE;
		     numdata            : INTEGER;
		     b1, b2, b3, b4, b5 : BYTE);
BEGIN
END;

FUNCTION batbytereceived : BYTE;
BEGIN
  batbytereceived := 0;
END;

PROCEDURE batinit;
BEGIN
END;

END;  { of MODULE }

IMPORT bat;

BEGIN
  batinit;
END.


.resume
.need 55
.suspend
$SYSPROG ON$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$STACKCHECK OFF$

PROGRAM installclock;

MODULE clock;
IMPORT sysglobals, asm, kbd, bat;
EXPORT
  TYPE
  RTCTIME = PACKED RECORD
	       PACKEDTIME,PACKEDDATE:INTEGER;
	    END;

  FUNCTION  sysclock: INTEGER;   {centiseconds from midnight}
  PROCEDURE sysdate (VAR thedate: daterec);
  PROCEDURE systime (VAR thetime: timerec);
  PROCEDURE setsysdate (thedate: daterec);
  PROCEDURE setsystime (thetime: timerec);
  PROCEDURE initclock;

implement



PROCEDURE SYSDATE(VAR THEDATE: DATEREC);
BEGIN
  WITH THEDATE DO
    BEGIN
      YEAR:=00;
      MONTH:=01;
      DAY:=01;
    END;
END;

FUNCTION sysclock: INTEGER;
BEGIN
 sysclock := 0;
END;

PROCEDURE SYSTIME(VAR THETIME: TIMEREC);
BEGIN
  WITH THETIME DO
    BEGIN
      HOUR        := 00;
      MINUTE      := 00;
      CENTISECOND := 0000;
    END;
END;


PROCEDURE setsysdate(thedate: daterec);
BEGIN
END;

PROCEDURE setsystime(thetime: timerec);
BEGIN
END;

PROCEDURE inittime;
BEGIN
END;

PROCEDURE initclock;
BEGIN
END;

END;

IMPORT clock;

BEGIN
  initclock;
END.

.resume
.need 55

@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


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


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


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


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


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.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


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


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


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.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


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


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.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


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


26.3
log
@
Comment from auto synch of clock fix:
date: 88/03/02 17:32:03;  author: quist;  state: Exp;  lines added/del: 2/1
SYSDATE fixes, RDQ
@
text
@@


26.2
log
@
Comment from auto synch of clock fix:
date: 88/03/02 09:50:58;  author: bayes;  state: Exp;  lines added/del: 0/0
Automatic bump of revision number for PWS version 3.2Y
@
text
@d2984 2
a2985 1
	  year:=yr mod 100;{to protect our file}
@


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.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


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.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


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


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.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


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


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


3.1
log
@Auto bump revision for PAWS 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
