					       (*

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


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the U.S. Government
is subject to restrictions as set forth in
subdivision (b)(3)(ii) of the Rights in Technical
Data and Computer Software clause at 52.227-7013.
Hewlett-Packard Company, 3000 Hanover Street,
Palo Alto CA 94304
						 *)


$page, sysprog$
$ALLOW_PACKED ON$ { JWS 4/10/85 }
$partial_eval on$

(********************************************************)
(*                                                      *)
(*  Note: You will need to use one of the following     *)
(*  compiler directives if the 'INTERFACE'              *)
(*  file is not in your current LIBRARY.                *)
(*  Choose the appropriate volume name  for             *)
(*  your configuration. If you are using                *)
(*  double-sided 3-1/2" media, the INTERFACE            *)
(*  file will be found on the ACCESS: volume.           *)
(*                                                      *)
(*  $search  'CONFIG:INTERFACE.'$                       *)
(*  $search  'ACCESS:INTERFACE.'$                       *)
(*                                                      *)
(********************************************************)

program {self-configuring} ctable;

module options;

  (********************************************)
  (* Choose the desired configuration options *)
  (* by editing the CONSTant declarations in  *)
  (* this module.                             *)
  (********************************************)

import
  sysglobals;

export

{INTERNAL ONLY BEGIN}
{ All internal-only code begins and ends as above and below.
{ MKCTBETA creates customer version from this internal source,
{ and it requires exactly the same spacing and capitalization
{ as in this example.  If there is an external version of
{ some code, it is introduced in an internal block like this
{EXTERNAL VERSION
{INTERNAL ONLY END}

{two possible versions of TABLE}
  const
    hfsversion  = 2;    { LIF primary DAM, HFS secondary }
    ucsdversion = 1;    { LIF primary DAM, UCSD secondary }

{change this assignment to get different versions}
  const
    thisversion = hfsversion;

{power-up system unit}
  const
    specified_system_unit =
      0;  {<>0 overrides auto-assignment}


{floppy/harddisc unit number slot tradeoff's}
  const
    floppy_unit_pairs =  {[1..10]}
      3;
    first_harddisc_lun = {do not edit!}
      7+(floppy_unit_pairs-1)*2;
    last_harddisc_lun =
      40;

$page$

{local printer type option}
  type
    local_printer_type = (HPIB, RS232, PARALLEL); {12/89 DEW - added PARALLEL}
  const
    local_printer_option = HPIB;


{local printer timeout}
  {
    maximum allowed delay between any two bytes:
      >0  specifies milliseconds (up to one hour)
      =0  specifies infinite timeout

    recommended values:
      -  HP2630 series  (HP-IB)       3000
      -  HP2670 series  (HP-IB)       3000
      -  HP9876         (HP-IB)       7000
      -  HP82905        (HP-IB)      12000
    Note: the HP82905 is currently NOT supported
      due to its improper response to interface
      clear (IFC), and its incompatible graphics
      dump sequence.

      -  HP LaserJet    (PARALLEL)   10000
  }
  const
    local_printer_timeout =
      $IF local_printer_option=HPIB$
	12000;  {milliseconds}
      $END$
      $IF local_printer_option=RS232$
	0;      {infinite}
      $END$
      $IF local_printer_option=PARALLEL$
	10000;  {milliseconds}
      $END$


{default dav's for devices not found by scanning}
  type
    dav_type = {device address vector}
      packed record
	sc, ba, du, dv: -128..127;
      end;
  const
    HP9885_default_dav =
      dav_type[sc: 12, ba: -1, du:  0, dv: -1];
    SRM_default_dav =
      dav_type[sc: 21, ba: {node} 0,
	       du: {unit} 8, dv: -1];
    BUBBLE_default_dav =
      dav_type[sc: 30, ba:  0, du:  0, dv:  0];
    local_HPIB_printer_default_dav =
      dav_type[sc:  7, ba:  1, du: -1, dv: -1];
    local_RS232_printer_default_dav =
      dav_type[sc:  9, ba:  0, du: -1, dv: -1];
    local_PARALLEL_printer_default_dav =
      dav_type[sc:  23, ba:  0, du: -1, dv: -1];

$page$

{local hard disc partitioning parameters}
  type
    pp_type =  {partitioning parameters}
      record
	mvs: integer;   {min vol size in bytes}
	mnv: shortint;  {max number of volumes}
      end;
  {   In general, MNV puts an upper bound on the
    number of logical volumes that a physical
    volume can be partitioned into.  Depending
    upon MNV's range, however, several types of
    behavior can occur.
      If MNV=0, then no logical volumes will ever
    be assigned for the device.
      If abs(MNV)=1, then exactly one logical
    volume will be assigned per physical volume
    of the device.  This corresponds to the
    2.X CTABLE's "single_volume" mode.
      If MNV>1, then partitioning will always be
    performed, subject to meeting the minimum
    volume size restrictions.  This corresponds
    to the 2.X CTABLE's "multi_volume" mode.
      If MNV<-1, then partitioning will be
    performed, but afterwards any logical volume
    that does not contain a valid directory will
    be coalesced with a previous adjacent logical
    volume if that one DOES contain a valid
    directory. As an extreme case, if only a
    single directory exists, and it is at the
    beginning of the physical volume, then all
    following logical volumes will be coalesced
    with the first, providing the same behavior
    as the 2.X CTABLE's "auto_volume" mode. With
    the less extreme cases, a wide variety of
    partitioning options are now possible without
    modification to CTABLE.                     }
  const
    min_size = {in bytes [1..maxint]}
      1000000;
    max_vols = {[-30..30]; <0 means autocoalesce}
      -30;
    HP913X_A_pp =
      pp_type[mvs: min_size, mnv: max_vols];
    HP913X_B_pp =
      pp_type[mvs: min_size, mnv: max_vols];
    HP913X_C_pp =
      pp_type[mvs: min_size, mnv: max_vols];
{INTERNAL ONLY BEGIN}
    HP7905_pp =  {historical value of mvs}
      pp_type[mvs:   983040, mnv: max_vols];
    HP7906_pp =  {historical value of mvs}
      pp_type[mvs:   983040, mnv: max_vols];
    HP7920_pp =
      pp_type[mvs: min_size, mnv: max_vols];
    HP7925_pp =
      pp_type[mvs: min_size, mnv: max_vols];
{INTERNAL ONLY END}
    CS80disc_pp =
      pp_type[mvs: min_size, mnv: max_vols];
    SCSIdisc_pp =                                {DEW 9/89 - added SCSI support}
      pp_type[mvs: min_size, mnv: max_vols];
$page$

{system unit auto-search declarations}
  const
    sysunit_list_length =
      7;
  type
    sysunit_list_type =
      array[1..sysunit_list_length] of unitnum;
  const
    sysunit_list =
      sysunit_list_type[
	  first_harddisc_lun, {first hard disc logical unit number}
	  45,   {srm, prefixed to user's sysvol}
	  4,    {floppy unit 1, primary DAM}
	  44,   {floppy unit 1, secondary DAM}
	  3,    {floppy unit 0, primary DAM}
	  43,   {floppy unit 0, secondary DAM}
	  42];  {bubble}


{HP-IB select code scanning declarations}
  const
    sc_list_length =
      3;
  type
    sc_list_type =
      array[1..sc_list_length] of shortint;
  const
    sc_list =
      sc_list_type[
	  7,    {internal HP-IB}
	  8,    {default sc for HP98624 HP-IB}
	  14];  {default sc for HP98625 HP-IB}

{SCSI select code scanning declarations}
  const
    SCSIsc_list_length =
      3;
  type
    SCSIsc_list_type =
      array[1..SCSIsc_list_length] of shortint;
  const
    SCSIsc_list =
      SCSIsc_list_type[
	  14,    {default sc for HP98265A (internal) and HP98658A (external)}
	  15,    {external SCSI sc when internal HP-IB/SCSI present at sc 14}
	  28];   {internal SCSI on 340/345}

{
  SCSI removable media may be an optical disk which has capacities of
  greater than 300Meg!  Therefore removable media can be configured to
  be:
	1:  A Hard disk if it has a size greater than 10M.
	2:  A Hard disk always.
	3:  A Floppy disk always.


  Things to be aware of when SCSI removable media is being treated like a
  hard disk:

    1: If the removable media is not on line at the time CTABLE is executed,
       the size of the disk is not available.  If the AllAreHard option is
       being used, then a unit entry will NOT be created for it.  If the
       AllOver10MAreHard option is used, then a unit entry for a floppy disk
       will be created for it.

    2: CTABLE will attempt the PREVENT MEDIUM REMOVAL command.  Through the
       SCSI programmer's interface, the ALLOW MEDIUM REMOVAL command may be
       sent.

    3: If the removable media goes off line for any reason, such as removing
       the media, PWS will discontinue communication with that device until
       CTABLE has been rerun.
}
   type
	SCSIRemovableOptionsType = (AllOver10MAreHard,
				    AllAreHard,
				    AllAreFloppy);
   const
	SCSIRemovableOption = AllOver10MAreHard;



implement {options}

end; {options}
$page, range off, ovflcheck off, partial_eval on$

module ctr; {ctable routines}

  (********************************************)
  (*                                          *)
  (*               Warning:                   *)
  (*   This module should not be modified!    *)
  (*                                          *)
  (********************************************)

import
  sysglobals, loader, options, ldr, fs, bootdammodule;

export

  const {mass storage letter specifiers}
    INTERNAL  = 'M';
    HP8290X   = 'N';
    HP9885    = 'F';
    HP9895    = 'H';
    HP913X_A  = 'U';
    HP913X_B  = 'V';
    HP913X_C  = 'W';
{INTERNAL ONLY BEGIN}
    HP7905    = 'Y';
    HP7906    = 'C';
    HP7920    = 'P';
    HP7925    = 'X';
{INTERNAL ONLY END}
    CS80      = 'Q';
    SRM       = 'G';
    PRINTER   = 'J';
    RAM       = 'R';
    BUBBLE    = 'B';
    EPROM     = 'E';
    SCSI      = 'S';      {DEW 09/89 - added SCSI support}
    NODEVICE  = #255;


  type
    flpy_flags_type = {flags governing floppy unit pair assignments}
      packed record
	assign_even_unit, assign_odd_unit: boolean;
      end;

  const
    assign_neither_flpy_unit =
      flpy_flags_type[assign_even_unit: false, assign_odd_unit: false];
    assign_both_flpy_units =
      flpy_flags_type[assign_even_unit: true, assign_odd_unit: true];

  type
    MSUS_type = {Mass Storage Unit Specifier}
      record
	flpy_flags: flpy_flags_type;
	letter: char;  {from the above mass storage letter specifiers}
	dav: dav_type;
      end;
$page$

    mp_type =  {medium parameters}
      record
	tpm: integer;  {tracks per medium}
	bpt: integer;  {bytes per track}
      end;

    ds_type =  {Directory access method Specifier for local mass storage}
      ( primary_dam,     {normally LIF }
	secondary_dam,   {HFS or UCSD, depending on choice in options}
	LIF_dam,         {LIF, regardless of primary/secondary choice}
	UCSD_dam,        {UCSD, regardless of primary/secondary choice}
	HFS_dam   );     {HFS, regardless of primary/secondary choice}

  var
    bootdev_MSUS: MSUS_type;
    bootdev_lun: unitnum;
    hfs_installed: boolean;

  procedure create_temp_unitable;
  procedure assign_and_clear_unit(lunit: unitnum);
  procedure assign_temp_unitable;
  function sysunit_ok(system_unit: unitnum): boolean;
  procedure zap_assigned_unit(lunit: unitnum);
  function on_same_medium(lun1, lun2: unitnum): boolean;
  procedure remove_extraneous_volumes(first_lun, last_lun: unitnum);
  function medium_parameters(letter: char): mp_type;
  function partitioning_parameters(letter: char): pp_type;
  function number_vols(mp: mp_type; pp: pp_type): shortint;
  function svol_bytes(letter: char): integer;
  function vol_bytes(current_vol, number_vols: shortint; mp: mp_type): integer;
  function vol_offset(current_vol, number_vols: shortint; mp: mp_type): integer;
  function block_boundaries(mp: mp_type): mp_type;
  function value(symbol: string255): integer;
  function MSUSs_match(MSUS1, MSUS2: MSUS_type): boolean;
  procedure extra_HFS_unit(oldun, newun: unitnum; prefix: string255);
  procedure install_HFS(un: unitnum; force: boolean);



  { table entry assignment procedures }

  procedure tea_memory_volume_dam(ds:ds_type);
  procedure tea_boot(un:unitnum);
  procedure tea_srm(un:unitnum;sc,ba,du:shortint);
  procedure tea_crt(un:unitnum);
  procedure tea_kbd(un:unitnum);
  procedure tea_local_printer(un:unitnum;sc,ba:shortint;uvid:vid;bto:integer);
  procedure tea_mini(un:unitnum;ds:ds_type;du:shortint);
  procedure tea_HP9885(un:unitnum;ds:ds_type;sc,du,block_os:shortint);
  procedure tea_HP9895(un:unitnum;ds:ds_type;sc,ba,du,block_os:shortint);
  procedure tea_HP8290X(un:unitnum;ds:ds_type;sc,ba,du:shortint);
  procedure tea_flpy(un:unitnum;lr:char;ds:ds_type;sc,ba,du:shortint);
{INTERNAL ONLY BEGIN}
  procedure tea_amigo_mv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint;os:integer;lr:char;mb:integer);
{INTERNAL ONLY END}
  procedure tea_amigo_sv(un:unitnum;ds:ds_type;sc,ba,du:shortint;os:integer;lr:char;mb:integer);
  procedure tea_CS80_mv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint;
					    os,id,mb,disksize:integer);
  procedure tea_CS80_sv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint);
  procedure tea_BUBBLE(un:unitnum;ds:ds_type;sc:shortint);
  procedure tea_EPROM(un:unitnum;ds:ds_type;sn:shortint);
  procedure tea_SCSI_mv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint;
					    os,id,mb,disksize:integer); {DEW 09/89 - added SCSI support}
  procedure tea_SCSI_sv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint);    {DEW 09/89 - added SCSI support}
$page$

implement {ctr}

const  {abbreviation for tea procedure calls}
  T = true;
  F = false;

const  {actual driver entry point names}
  NO_DAM_name         = 'INITUNITS_NODAM';
  BOOT_DAM_name       = 'BOOTDAMMODULE_BOOTDAM';
  LIF_DAM_name        = 'LIFMODULE_LIFDAM';
  UCSD_DAM_name       = 'UCSDMODULE_UCSD_DAM';
  UNBLOCKED_DAM_name  = 'MISC_UNBLOCKEDDAM';
  SRM_DAM_name        = 'SRMDAMMODULE_SRMDAM';
  HFS_DAM_name        = 'HFS_DAM_MODULE_HFSDAM';

  NULL_TM_name        = 'INITUNITS_NOUNIT';
  BOOT_TM_name        = 'BOOTDAMMODULE_BOOTTM';
  CRT_TM_name         = 'SYSDEVS_CRTIO';
  KBD_TM_name         = 'SYSDEVS_KBDIO';
  MINI_TM_name        = 'MINI_MINIIO';
  SRM_TM_name         = 'SRMAMMODULE_SRMAM';
  PRINTER_TM_name     = 'PRTDVR_PRTIO';
  F9885_TM_name       = 'F9885DVR_F9885IO';
  AMIGO_TM_name       = 'AMIGODVR_AMIGOIO';
  CS80_TM_name        = 'CS80DVR_CS80IO';
  BUBBLE_TM_name      = 'BUBBLE_BUB_TM';
  EPROM_TM_name       = 'EPROMS_EPROM_TM';
  HFS_TM_name         = 'HFS_TM_MODULE_HFSTM';
  SCSIDSC_TM_name     = 'SCSIDISCMODULE_SCSIDISC';{09/89 DEW - added SCSI support}


var
  temp_unitable: unitableptr;
  temp_h_unitable: ^h_unitabletype;

procedure delay_timer(t:integer); external; {JWS 6/16/87}

procedure swap_h_units(u: unitnum);
  var
    t_unit: h_unittype;
  begin
    t_unit := h_unitable^.tbl[u];
    h_unitable^.tbl[u] := temp_h_unitable^.tbl[u];
    temp_h_unitable^.tbl[u] := t_unit;
  end;

procedure check(parameter, lower_bound, upper_bound: integer);
  begin
    if (parameter<lower_bound) or (parameter>upper_bound) then
      halt(-8) {value range error}
  end;

$page$

function value(symbol: string255): integer;
  var
    modp: moddescptr;
    ptr, valueptr: addrec;
    found: boolean;
  begin {value}
    value := 0;
    found := false;
    modp := sysdefs;
    while (modp<>nil) and not found do
      with modp^ do
	begin
	  ptr := defaddr;
	  while (ptr.a<defaddr.a+defsize) and not found do
	    begin
	      found := ptr.syp^=symbol;
	      ptr.a := ptr.a+strlen(ptr.syp^)+1;
	      ptr.a := ptr.a+ord(odd(ptr.a));
	      valueptr.a := ptr.a+2;
	      if found then
		value := valueptr.vep^.value;
	      ptr.a := ptr.a+ptr.gvp^.short;
	    end; {while}
	  modp := link;
	end; {with modp^}
  end; {value}


function MSUSs_match(MSUS1, MSUS2: MSUS_type): boolean;
  begin {MSUSs_match}
    MSUSs_match := (MSUS1.letter = MSUS2.letter) and
		   (MSUS1.dav.sc = MSUS2.dav.sc) and
		   (MSUS1.dav.ba = MSUS2.dav.ba) and
		   (MSUS1.dav.du = MSUS2.dav.du) and
		   (MSUS1.dav.dv = MSUS2.dav.dv);
  end; {MSUSs_match}

{
{ Make a new unit table entry at newun (must be free).
{ The medium is the same as oldun (must be HFS).
{ Prefix the new unit to the given directory name.
}
procedure extra_HFS_unit(oldun, newun: unitnum; prefix: string255);
  label
    999;
  var
    old_h_unit: h_unittype;
    old_unit: unitentry;
    i, un: integer;
    kvid: vid;
    dirname: fid;
  begin
    { new unit must be unused }
    if unitable^[newun].letter <> #0 then
      goto 999;

    { old unit must be HFS }
    if h_unitable = NIL then    {protect against ^nil. SFB}
     goto 999;

    if not h_unitable^.tbl[oldun].is_hfsunit then
      goto 999;

    { save unitable, h_unitable entries at new unit }
    old_unit := unitable^[newun];
    old_h_unit := h_unitable^.tbl[newun];

    { make newun and oldun look the same }
    unitable^[newun] := unitable^[oldun];
    h_unitable^.tbl[newun] := h_unitable^.tbl[oldun];

    { do the prefix }
    setstrlen(dirname, 0);
    strwrite(dirname, 1, i, '#', newun:1, ':', prefix);
    doprefix(dirname, kvid, un, true);

    { if it failed, reset the new unit }
    if ioresult <> ord(inoerror) then begin
      unitable^[newun] := old_unit;
      h_unitable^.tbl[newun] := old_h_unit;
    end;

  999:
  end;

{
{ Install HFS on this unit.
{ force -> install HFS always
{ not force -> install HFS if superblock is there
}
procedure install_HFS(un: unitnum; force: boolean);
  var
    dam_proc:
      packed record case integer of
	0: (dam: damtype);
	1: (value, slink: integer);
      end;

    tm_proc:
      packed record case integer of
	0: (tm: amtype);
	1: (value, slink: integer);
      end;
  begin
    if h_unitable <> nil then with h_unitable^ do begin
      call(init_unit_proc, un, force);
      { not force -> init_unit_proc sets is_hfsunit if recognized }
      if force or tbl[un].is_hfsunit then begin
	dam_proc.value := value(HFS_DAM_name);
	dam_proc.slink := 0;
	tm_proc.value := value(HFS_TM_name);
	tm_proc.slink := 0;
	with unitable^[un] do begin
	  dam := dam_proc.dam;
	  tm := tm_proc.tm;
	  uvid := '';
	end;
      end;
    end;
  end;


$page$

procedure tea {lowest-level Table Entry Assignment procedure}
    ( un:unitnum;                  {unit number}
      dam_name: string255;         {directory access method}
      tm_name: string255;          {transfer method (driver)}
      p_sc: shortint;              {select code}
      p_ba: shortint;              {bus address}
      p_du: shortint;              {disc unit}
      p_dv: shortint;              {disc volume}
      p_byteoffset: integer;       {physical starting byte of volume}
      p_devid: integer;            {device identifier (driver dependent)}
      p_uvid: vid;                 {volume id}
    { p_drvtemp: integer           {driver temp}
    { p_drvtemp2: shortint;        {second driver temp}
      p_letter: char;              {device specifier letter}
    { p_offline: boolean           {unit offline flag}
      p_uisinteractive: boolean;   {device echos input}
    { p_umediavalid: boolean;      {open files are valid}
    { p_uuppercase: boolean;       {volume name should be uppercased}
      p_uisfixed: boolean;         {medium not removable flag}
    { p_ureportchange: boolean;    {driver directive to report/ignore medium changes}
    { p_pad: 0..1                  {(not used)}
      p_uisblkd: boolean;          {blocked volume flag}
      p_umaxbytes: integer;        {volume size in bytes (unit)}
      p_disksize: integer  );      {volume size in bytes (disk)}

  var
    dam_proc:
      packed record case integer of
	0: (dam: damtype);
	1: (value, slink: integer);
      end;

    tm_proc:
      packed record case integer of
	0: (tm: amtype);
	1: (value, slink: integer);
      end;

    dam_ok: boolean;

    old_unit : unitentry;       {for "missing LIFDAM" bug fix. SFB}
		{This bug showed up when LIFDAM was not in INITLIB, but
		 HFSDAM was. If a superblock is on the disc, HFSDAM should
		 connect, but didn't, mainly because of the
		 'if (dam_proc.value <> 0)' test farther on.
		 We no longer do that test, but have to ensure the unit
		 doesn't get set up if the DAM is not available. SFB}

  procedure swap_temp_and_real_unit;
  var
     tmpunit: unitentry;
  begin
     tmpunit := unitable^[un];
     unitable^[un] := temp_unitable^[un];
     temp_unitable^[un] := tmpunit;
  end;

  begin {tea}
    if temp_unitable=nil then halt(-3); {unassigned pointer}

    { HFS only at beginning of disk (RAM units never tea'd) }
    if (dam_name = HFS_DAM_name) and (p_byteoffset <> 0) then
      dam_name := '';  {was LIF_DAM_name. Need value=0. SFB}

    dam_proc.value := value(dam_name);
    dam_proc.slink := 0;

    tm_proc.value := value(tm_name);
    tm_proc.slink := 0;

    old_unit := temp_unitable^[un]; {to restore later, if DAM not found. SFB}

    if
   { (dam_proc.value<>0) and           {removed. SFB}
     (tm_proc.value<>0) then  {assign the entry}
      begin

	with temp_unitable^[un] do
	  begin
	    dam             := dam_proc.dam;
	    tm              := tm_proc.tm;
	    sc              := p_sc;
	    ba              := p_ba;
	    du              := p_du;
	    dv              := p_dv;
	    byteoffset      := p_byteoffset;
	    devid           := p_devid;
	    uvid            := p_uvid;
	    dvrtemp         := 0;                 {always initially zero!}
	    dvrtemp2        := -1;                {always initially -1!}
	    letter          := p_letter;
	    offline         := false;             {always initially online!}
	    uisinteractive  := p_uisinteractive;
	    umediavalid     := false;             {never valid to start with}
	    uuppercase      := not p_uisblkd;     {assume case is significant}
	    uisfixed        := p_uisfixed;
	    ureportchange   := true;              {do report media changes}
	    pad             := 0;                 {not used}
	    uisblkd         := p_uisblkd;
	    if uisblkd then
	      umaxbytes     := p_umaxbytes;

	    if ( (tm_name = SCSIDSC_TM_name) and
		 ( (SCSIRemovableOption = AllAreHard) or
		   ( (SCSIRemovableOption = AllOver10MAreHard) and
		     (p_disksize >= hex('A00000'))
		   )
		 )
	       ) then
			pad := 1;
	  end; {with}


	if hfsbflg then
	  dam_ok := value(HFS_DAM_name)<>0      {SFB}
	else
	  if dam_proc.value <> 0 then           {SFB}
	    dam_ok := (dam_name=LIF_DAM_name) or (dam_name=SRM_DAM_name);

	with bootdev_MSUS, dav do {see if this entry points to it}
	  if (p_letter=letter) and  {wish we could use MSUSs_match function}
	     (p_sc=sc) and (p_ba=ba) and (p_du=du) and (p_dv=dv) and
	     dam_ok and
	     (p_byteoffset=0) then  {remember this unit number!}
	    bootdev_lun := un;

	if h_unitable <> nil then with h_unitable^ do begin
	  { temporarily swap temp and real unit entries }
	  swap_h_units(un);
	  swap_temp_and_real_unit;

	  if dam_name = HFS_DAM_name then
	    { force this unit to be HFS }
	    install_HFS(un, true)
	  else
	  if (p_byteoffset = 0)
	{ and (dam_name = LIF_DAM_name) {removed, as it blocks WS1.0, etc. SFB}
	  and (un >= first_harddisc_lun)
	  and (un <= last_harddisc_lun) then
	    { install HFS if disk has a superblock }
	    install_HFS(un, false);

	  if tbl[un].is_hfsunit then begin
	    { take up whole disk }
	    if p_disksize <> 0 then
	      unitable^[un].umaxbytes := p_disksize;
	    { prevent further units on this disk }
	    hfs_installed := true;
	  end;
	  swap_h_units(un);
	  swap_temp_and_real_unit;
	end;

      end; {if}

    {see if we found a dam for the unit. SFB}
    if temp_h_unitable <> NIL then
     with temp_h_unitable^ do   {was DAM found or HFS installed ?}
      begin
       if (not tbl[un].is_hfsunit) and (dam_proc.value=0) then
	temp_unitable^[un]:=old_unit  {if not, uninstall the entry. SFB}
      end
    else        {no possibility HFSDAM was installed}
     if dam_proc.value=0 then
      temp_unitable^[un]:=old_unit;   {if no dam, uninstall the entry. SFB}

  end; {tea}


function dam(ds: ds_type): string255;
  begin
    case ds of
$if thisversion = hfsversion$
      primary_dam:
	dam := LIF_DAM_name;
      secondary_dam:
	dam := HFS_DAM_name;
$end$
$if thisversion = ucsdversion$
      primary_dam:
	dam := LIF_DAM_name;
      secondary_dam:
	dam := UCSD_DAM_name;
$end$
      HFS_dam:
	dam := HFS_DAM_name;
      LIF_dam:
	dam := LIF_DAM_name;
      UCSD_dam:
	dam := UCSD_DAM_name;
    end; {case}
  end;
$page$

function medium_parameters(letter: char): mp_type;
  const {LOGICAL sizes unless otherwise noted}
    INTERNAL_mp = mp_type[tpm: 2* 33, bpt: 16*256];
    HP8290X_mp  = mp_type[tpm: 2* 33, bpt: 16*256];
    HP9885_mp   = mp_type[tpm: 1* 77, bpt: 30*256];  {physical size}
    HP9895_mp   = mp_type[tpm: 2* 77, bpt: 30*256];  {physical size}
    HP913X_A_mp = mp_type[tpm: 4*152, bpt: 31*256];
    HP913X_B_mp = mp_type[tpm: 4*305, bpt: 31*256];
    HP913X_C_mp = mp_type[tpm: 6*305, bpt: 31*256];
{INTERNAL ONLY BEGIN}
    HP7905_mp   = mp_type[tpm: 2*400, bpt: 48*256];  {fixed is half this size}
    HP7906_mp   = mp_type[tpm: 2*400, bpt: 48*256];  {fixed & remov same size}
    HP7920_mp   = mp_type[tpm: 5*800, bpt: 48*256];
    HP7925_mp   = mp_type[tpm: 9*800, bpt: 64*256];
{INTERNAL ONLY END}
    BUBBLE_mp   = mp_type[tpm: 1*512, bpt:  1*256];  {1 megabit unit}
   {BUBBLE_mp   = mp_type[tpm: 4*512, bpt:  1*256];} {4 megabit unit}
    null_mp     = mp_type[tpm:     0, bpt:      0];
  begin
    case letter of
      INTERNAL:  medium_parameters := INTERNAL_mp;
      HP8290X:   medium_parameters := HP8290X_mp;
      HP9885:    medium_parameters := HP9885_mp;
      HP9895:    medium_parameters := HP9895_mp;
      HP913X_A:  medium_parameters := HP913X_A_mp;
      HP913X_B:  medium_parameters := HP913X_B_mp;
      HP913X_C:  medium_parameters := HP913X_C_mp;
{INTERNAL ONLY BEGIN}
      HP7905:    medium_parameters := HP7905_mp;
      HP7906:    medium_parameters := HP7906_mp;
      HP7920:    medium_parameters := HP7920_mp;
      HP7925:    medium_parameters := HP7925_mp;
{INTERNAL ONLY END}
      BUBBLE:    medium_parameters := BUBBLE_mp;
      otherwise  medium_parameters := null_mp;
    end; {case}
  end;


function partitioning_parameters(letter: char): pp_type;
  const
    null_pp = pp_type[mvs: 0, mnv: 0];
  begin
    case letter of
      HP913X_A:  partitioning_parameters := HP913X_A_pp;
      HP913X_B:  partitioning_parameters := HP913X_B_pp;
      HP913X_C:  partitioning_parameters := HP913X_C_pp;
{INTERNAL ONLY BEGIN}
      HP7905:    partitioning_parameters := HP7905_pp;
      HP7906:    partitioning_parameters := HP7906_pp;
      HP7920:    partitioning_parameters := HP7920_pp;
      HP7925:    partitioning_parameters := HP7925_pp;
{INTERNAL ONLY END}
      CS80:      partitioning_parameters := CS80disc_pp;
      SCSI:      partitioning_parameters := SCSIdisc_pp;        {DEW 09/89 - added SCSI support}
      otherwise  partitioning_parameters := null_pp;
    end; {case}
  end;
$page$

function number_vols(mp: mp_type; pp: pp_type): shortint;
  var
    nvols: shortint;
  begin
    if pp.mnv<0 then  {negative implies autovolume feature; use absolute value}
      pp.mnv := -pp.mnv;
    if pp.mvs<=0 then pp.mvs := 1;  {guard against div's by 0}
    if mp.bpt<=0 then mp.bpt := 1;  {guard against div's by 0}
    nvols := mp.tpm div ((pp.mvs+mp.bpt-1) div mp.bpt);
    if (nvols=0) and (mp.tpm>0) then
      nvols := 1;  {physical vol smaller than the specified minimum vol size}
    if nvols>pp.mnv then  {cut back, even to zero if specified}
      nvols := pp.mnv;
    number_vols := nvols;
  end;


function svol_bytes(letter: char): integer;
  var
    mp: mp_type;
  begin
    mp := medium_parameters(letter);
    svol_bytes := mp.bpt*mp.tpm;  {single volume bytes}
  end;


function vol_bytes(current_vol, number_vols: shortint; mp: mp_type): integer;
  var
    tracks: integer;
  begin
    tracks := mp.tpm div number_vols;           {each vol gets this much}
    if current_vol=number_vols-1 then
      tracks := tracks+mp.tpm mod number_vols;  {last vol gets any extra}
    vol_bytes := tracks*mp.bpt;
  end;


function vol_offset(current_vol, number_vols: shortint; mp: mp_type): integer;
  begin
    vol_offset := (mp.tpm div number_vols)*current_vol*mp.bpt;
  end;


function block_boundaries(mp: mp_type): mp_type;
  begin
    block_boundaries.tpm := mp.tpm*mp.bpt div 512;
    block_boundaries.bpt := 512;
  end;
$page$

{ standard driver-oriented table entry assignment procedures }


procedure tea_nounit(un:unitnum);
  begin
    tea(un,NO_DAM_name,NULL_TM_name,0,0,0,0,0,0,'',#0,F,F,F,0,0);
  end;


procedure tea_memory_volume_dam(ds:ds_type);
  begin
    tea(0,dam(ds),NULL_TM_name,0,0,0,0,0,0,'',RAM,F,T,T,0,0);
  end;


procedure tea_crt(un:unitnum);
  begin
    tea(un,UNBLOCKED_DAM_name,CRT_TM_name,0,0,0,0,0,0,'CONSOLE',#0,T,T,F,0,0);
  end;


procedure tea_kbd(un:unitnum);
  begin
    tea(un,UNBLOCKED_DAM_name,KBD_TM_name,0,0,0,0,0,0,'SYSTERM',#0,F,T,F,0,0);
  end;


procedure tea_mini(un:unitnum;ds:ds_type;du:shortint);
  begin
    check(du, 0, 1);
    tea(un,dam(ds),MINI_TM_name,0,0,du,0,0,0,'',INTERNAL,
			      F,F,T,svol_bytes(INTERNAL),0);
  end;


procedure tea_boot(un: unitnum);
  begin
    tea(un,BOOT_DAM_name,BOOT_TM_name,0,0,0,0,0,0,'',#0,F,F,T,maxint,0);
  end;


procedure tea_srm(un:unitnum;sc,{node}ba,{unit}du:shortint);
  begin
    check(sc, 7, 31);
    check(ba, 0, 127);
    if du<>0 then check(du, 7, 26);
    tea(un,SRM_DAM_name,SRM_TM_name,sc,ba,du,0,0,0,'',SRM,F,T,T,maxint,0);
  end;


procedure tea_local_printer(un:unitnum;sc,ba:shortint;uvid:vid;bto:integer);
  begin
    check(sc, 7, 31);
    check(ba, 0, 30);
    check(bto, 0, 60*60*1000);  {one hour should be enough!}
    tea(un,UNBLOCKED_DAM_name,PRINTER_TM_name,sc,ba,0,0,0,bto,uvid,#0,
							    F,T,F,0,0);
  end;
$page$

procedure tea_HP9885(un:unitnum;ds:ds_type;sc,du,block_os:shortint);
  var
    os: integer;
  begin
    check(sc, 8, 31);
    check(du, 0, 3);
    os := block_os*512;
    check(os, 0, svol_bytes(HP9885)-1);
    tea(un,dam(ds),F9885_TM_name,sc,0,du,0,os,0,'',HP9885,
			    F,F,T,svol_bytes(HP9885)-os,0);
  end;


procedure tea_HP9895(un:unitnum;ds:ds_type;sc,ba,du,block_os:shortint);
  var
    os: integer;
  begin
    check(sc, 7, 31);
    check(ba, 0, 7);
    check(du, 0, 3);
    os := block_os*512;
    check(os, 0, svol_bytes(HP9895)-1);
    tea(un,dam(ds),AMIGO_TM_name,sc,ba,du,0,os,0,'',HP9895,
			       F,F,T,svol_bytes(HP9895)-os,0);
  end;


procedure tea_HP8290X(un:unitnum;ds:ds_type;sc,ba,du:shortint);
  begin
    check(sc, 7, 31);
    check(ba, 0, 7);
    check(du, 0, 3);
    tea(un,dam(ds),AMIGO_TM_name,sc,ba,du,0,0,0,'',HP8290X,
				  F,F,T,svol_bytes(HP8290X),0);
  end;


procedure tea_amigo_sv(un:unitnum;ds:ds_type;sc,ba,du:shortint;os:integer;lr:char;mb:integer);
  var
    medium_size: integer;
  begin
    check(sc, 7, 31);
    check(ba, 0, 7);
    check(du, 0, 7);
{INTERNAL ONLY BEGIN}
    if not (lr in [HP913X_A, HP913X_B, HP913X_C, HP7920, HP7925]) then
{EXTERNAL VERSION
    if not (lr in [HP913X_A, HP913X_B, HP913X_C]) then
{INTERNAL ONLY END}
      halt(-8); {value range error}
    medium_size := svol_bytes(lr);
    check(os, 0, medium_size-1);
    if os mod 256<>0 then halt(-8) {value range error};
    check(mb, 1, medium_size-os);
    tea(un,dam(ds),AMIGO_TM_name,sc,ba,du,0,os,0,'',lr,F,T,T,mb,medium_size);
  end;
$page$

{INTERNAL ONLY BEGIN}
procedure tea_amigo_mv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint;os:integer;lr:char;mb:integer);
  var
    medium_size: integer;
  begin
    check(sc, 7, 31);
    check(ba, 0, 7);
    check(du, 0, 7);
    check(dv, 0, 1);
    if not (lr in [HP7905, HP7906]) then halt(-8);  {value range error}
    medium_size := svol_bytes(lr);
    if (lr=HP7905) and (dv<>0) then
      medium_size := medium_size div 2;  {7905 fixed is half as big!}
    check(os, 0, medium_size-1);
    if os mod 256<>0 then halt(-8) {value range error};
    check(mb, 1, medium_size-os);
    tea(un,dam(ds),AMIGO_TM_name,sc,ba,du,dv,os,0,'',lr,F,T,T,mb,medium_size);
  end;
{INTERNAL ONLY END}
$page$

procedure tea_CS80_mv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint;os,id,
						   mb,disksize:integer);
  {
    CS80 multiple (logical) volume assignment procedure:
    1) devid must match the actual HP product number as found in describe
    2) offset and umaxbytes are fixed
    3) the uisfixed field is assigned by the driver in the clearunit procedure
  }
  begin
    check(sc, 7, 31);
    check(ba, 0, 7);
    check(du, 0, 14);
    check(dv, 0, 7);
    tea(un,dam(ds),CS80_TM_name,sc,ba,du,dv,os,id,'',CS80,F,F,T,mb,disksize);
  end;


procedure tea_CS80_sv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint);
  {
    CS80 single (logical) volume assignment procedure:
    1) byteoffset always assumed to be zero
    2) umaxbytes is dependent upon the media loaded, thus it is set by the
       driver at clearunit time and whenever it detects a media change.
       BOTTOM LINE: the medium CANNOT be partitioned into multiple volumes!
    3) the uisfixed field is assigned by the driver in the clearunit procedure
    4) device can either be a disc (presumably a floppy) or a tape
  }
  begin
    check(sc, 7, 31);
    check(ba, 0, 7);
    check(du, 0, 14);
    check(dv, 0, 7);
    tea(un,dam(ds),CS80_TM_name,sc,ba,du,dv,0,-1,'',CS80,F,F,T,0,0);
  end;


procedure tea_SCSI_mv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint;os,id,
						   mb,disksize:integer);
  {
    09/89 DEW - added SCSI support
    SCSI multiple (logical) volume assignment procedure:
    1) devid must match the actual HP product number as found in describe
    2) offset and umaxbytes are fixed
    3) the uisfixed field is assigned by the driver in the clearunit procedure
  }
  begin
    check(sc, 7, 31);
    check(ba, 0, 7);
    check(du, 0, 255);
    check(dv, 0, 0);   {SCSI Secondary Units not supported}
    tea(un,dam(ds),SCSIDSC_TM_name,sc,ba,du,dv,os,id,'',SCSI,F,F,T,mb,disksize);
  end;


procedure tea_SCSI_sv(un:unitnum;ds:ds_type;sc,ba,du,dv:shortint);
  {
    09/89 DEW - added SCSI support
    SCSI single (logical) volume assignment procedure:
    1) byteoffset always assumed to be zero
    2) umaxbytes is dependent upon the media loaded, thus it is set by the
       driver at clearunit time and whenever it detects a media change.
       BOTTOM LINE: the medium CANNOT be partitioned into multiple volumes!
    3) the uisfixed field is assigned by the driver in the clearunit procedure
    4) device can either be a disc (presumably a floppy) or a tape
  }
  begin
    check(sc, 7, 31);
    check(ba, 0, 7);
    check(du, 0, 255);
    check(dv, 0, 0);   {SCSI Secondary Units not supported}
    tea(un,dam(ds),SCSIDSC_TM_name,sc,ba,du,dv,0,-1,'',SCSI,F,F,T,0,0);
  end;


procedure tea_flpy(un:unitnum;lr:char;ds:ds_type;sc,ba,du:shortint);
  begin
    case lr of
      INTERNAL: tea_mini(un,ds,du);
      HP8290X:  tea_HP8290X(un,ds,sc,ba,du);
      CS80:     tea_CS80_sv(un,ds,sc,ba,du,0);
      SCSI:     tea_SCSI_sv(un,ds,sc,ba,du,0);  {DEW 09/89 - added SCSI support}
      HP9885:   tea_HP9885(un,ds,sc,du,0);
      HP9895:   tea_HP9895(un,ds,sc,ba,du,0);
      otherwise halt(-8) {value range error}
    end;  {case}
  end;

$page$

procedure tea_BUBBLE(un:unitnum;ds:ds_type;sc:shortint);
  begin
    { NOTE THAT UMAXBYTES IS ASSIGNED AT CLEARUNIT TIME }
    check(sc,7,31);
    tea(un,dam(ds),BUBBLE_TM_name,sc,0,0,0,0,0,'',BUBBLE,F,T,T,0,0);
  end;

procedure tea_EPROM(un:unitnum;ds:ds_type;sn:shortint);
  begin
    { NOTE THAT UMAXBYTES IS ASSIGNED AT CLEARUNIT TIME }
    check(sn,0,MAXUNIT);
    tea(un,dam(ds),EPROM_TM_name,0,0,0,sn,0,0,'',EPROM,F,T,T,0,0);
  end;

$page$

procedure create_temp_unitable;
  var
    lunit: unitnum;
  begin
    new(temp_unitable);
    tea_nounit(0);  {assign one dummy entry}
    for lunit := 1 to maxunit do  {copy others; avoid symbol table search each time!}
      temp_unitable^[lunit] := temp_unitable^[0];
    if h_unitable <> nil then begin
      new(temp_h_unitable);
      temp_h_unitable^ := h_unitable^;
      call(h_unitable^.init_cache_proc);
      for lunit := 0 to maxunit do
	swap_h_units(lunit);
      { now h_unitable is as before, temp_h_unitable is initialized }
    end;
  end;


procedure assign_and_clear_unit(lunit: unitnum);
  var
    f: fib;
  begin
    if temp_unitable=nil then halt(-3); {unassigned pointer}
    with unitable^[lunit], f do
      if (letter<>RAM) or (lunit=0) then
	begin
	  unitable^[lunit] := temp_unitable^[lunit];
	  funit := lunit;
	  delay_timer(1000); { Fix for SRM coax configuration }
	  if h_unitable <> nil then
	    h_unitable^.tbl[lunit] := temp_h_unitable^.tbl[lunit];
	  call(tm, addr(f), clearunit, lunit, 0, 0);
	  offline := uisblkd and (ioresult<>0);
	end
	else
	  { try to convert old RAM volumes to HFS }
	  install_HFS(lunit, false);
  end;

{----------------------------------------------------------------------}
{
{ set the base_unum fields in h_unitable
{ base_unum is the unit number of the LOWEST unit on this disk
{ e.g., if #11 and #12 share a disk, base_unum for both is 11.
}
procedure set_base_unums;
var
    i,j: unitnum;
begin
    if h_unitable <> nil then with h_unitable^ do
	for i := 1 to maxunit do
	    for j := i+1 to maxunit do
		{ HFS? }
		if tbl[j].is_hfsunit
		{ higher number not yet assigned? }
		and (tbl[j].base_unum = j)
		{ share disk? }
		and on_same_medium(i, j) then
		    tbl[j].base_unum := i;
end;

procedure assign_temp_unitable;
  var
    lunit: unitnum;
    i: integer;
  begin
    if temp_unitable=nil then halt(-3);  {unassigned pointer}
    lockfiles;  {close all standard system files}
    for lunit := 0 to maxunit do
      assign_and_clear_unit(lunit);
    set_base_unums;
    { configure HFS cache }
    if h_unitable <> nil then begin
      call(h_unitable^.config_cache_proc);
    end;

  end;


function sysunit_ok(system_unit: unitnum): boolean;
  begin
    sysunit := system_unit;
    initsysunit;
    with unitable^[system_unit] do
      sysunit_ok := uisblkd and not offline and (uvid<>'');
  end;


procedure zap_assigned_unit(lunit: unitnum);
  begin
    tea_nounit(lunit);  {zap the temp unitable entry}
    unitable^[lunit] := temp_unitable^[lunit];  {now zap the real one!}
  end;
$page$

function on_same_medium(lun1, lun2: unitnum): boolean;
  var
    uep: ^unitentry;
  begin {on_same_medium}
    uep := addr(unitable^[lun2]);
    with unitable^[lun1] do
      on_same_medium := (sc=uep^.sc) and (ba=uep^.ba) and
			(du=uep^.du) and (dv=uep^.dv) and
			(letter=uep^.letter) and (letter<>'R');
  end; {on_same_medium}


procedure remove_extraneous_volumes(first_lun, last_lun: unitnum);
  var
    first_lun_ok: boolean;
    lun: unitnum;
  begin {remove_extraneous_volumes}
    first_lun_ok := false;
    while first_lun<last_lun do
      if first_lun_ok then
	begin
	  lun := first_lun+1;
	  with unitable^[first_lun] do
	    while (lun<=last_lun) and not sysunit_ok(lun) do
	      begin
		if unitable^[lun].byteoffset = byteoffset+umaxbytes then
		  begin
		    umaxbytes := umaxbytes+unitable^[lun].umaxbytes;
		    zap_assigned_unit(lun);
		  end;
		lun := lun+1;
	      end;  {while}
	  first_lun := lun;
	end {then}
      else if sysunit_ok(first_lun) then
	first_lun_ok := true
      else
	first_lun := first_lun+1;
  end; {remove_extraneous_volumes}

end; {ctr}
$page$

module BRstuff;  {BOOTROM stuff}

  (********************************************)
  (*                                          *)
  (*               Warning:                   *)
  (*   This module should not be modified!    *)
  (*                                          *)
  (********************************************)

import
  sysglobals, options, ctr;

export
  const
    INTERNAL_MSUS = MSUS_type
      [ flpy_flags: assign_neither_flpy_unit, letter: INTERNAL,
	dav: dav_type[sc: -1, ba: -1, du:  0, dv: -1] ];

  function internal_mini_present: boolean;
  procedure get_bootdevice_MSUS(var MSUS: MSUS_type);

implement {BRstuff}

type
  signed4     = -8..7;
  signed8     = -128..127;

  fmt_type =  {format field in the msus byte}
    (f0,f1,f2,f3,f4,f5,f6,f7);

  dev_type =  {device field in the msus byte}
    ( d0, d1, d2, d3, d4, d5, d6, d7, d8, d9,d10,d11,d12,d13,d14,d15,
     d16,d17,d18,d19,d20,d21,d22,d23,d24,d25,d26,d27,d28,d29,d30,d31);

  BR_msus_type = {BOOTROM's mass storage unit specifier}
    packed record case boolean of
      false:  {8-bit unit number}
	( fmt: fmt_type;  {directory format}
	  dev: dev_type;  {device}
	  un: signed8;    {8-bit unit number}
	  sc: signed8;    {select code}
	  ba: signed8     {bus address}  );
      true:  {4-bit volume / 4-bit unit number for CS80 & 7905/06 discs}
	( pad: signed8;   {format/device byte}
	  vn4: signed4;   {4-bit volume number}
	  un4: signed4;   {4-bit unit number}  );
    end; {BR_msus_type}

var
  ROM_ID[16382]:  {BOOTROM identification word}
    shortint;

  ndrives[-296]:  {Maximum Unit for Internal Mini-Floppy}
    packed record  b: signed8;  end;

  default_msus[-292]:  {boot device's msus}
    BR_msus_type;
$page$

function internal_mini_present: boolean;
  begin
    if ROM_ID<0
      then internal_mini_present := true            {1.0 BOOTROM on 9826}
      else internal_mini_present := ndrives.b<>-1;  {2.0 or greater BOOTROM}
  end;


procedure get_bootdevice_MSUS(var MSUS: MSUS_type);
  type
    letter_table_type = array[dev_type] of char;
  const
    letter_table =  {BOOTROM dev to Pascal letter conversion table}
      letter_table_type
	[ INTERNAL, NODEVICE, NODEVICE, NODEVICE, HP9895,   HP8290X,  HP9885,   HP913X_A,
{INTERNAL ONLY BEGIN}
	  HP913X_B, HP913X_C, HP7905,   HP7906,   HP7920,   HP7925,   SCSI,     NODEVICE, {DEW - added SCSI}
{EXTERNAL VERSION
	  HP913X_B, HP913X_C, NODEVICE, NODEVICE, NODEVICE, NODEVICE, SCSI,     NODEVICE, {DEW - added SCSI}
{INTERNAL ONLY END}
	  CS80,     CS80,     NODEVICE, NODEVICE, NODEVICE, NODEVICE, BUBBLE  , NODEVICE,
	  NODEVICE, NODEVICE, NODEVICE, NODEVICE, NODEVICE, NODEVICE, NODEVICE, NODEVICE  ];
  begin
    if ROM_ID<0 then  {1.0 Boot ROM on 9826; internal minifloppy only}
      MSUS := INTERNAL_MSUS
    else  {2.0 or greater Boot ROM}
      with default_msus do
	begin
	  if fmt=f7 then  {non sector-oriented device}
	    if (dev=d1) OR (dev=d2)    {added dev=d2 to allow LANSRM. DEW/RDQ/SFB - 5/5/89}
	      then MSUS.letter := SRM
	      else MSUS.letter := NODEVICE
	  else  {sector-oriented device}
	    MSUS.letter := letter_table[dev];
	  MSUS.dav.sc := sc;
	  MSUS.dav.ba := ba;
{INTERNAL ONLY BEGIN}
	  if MSUS.letter in [HP7905, HP7906, CS80, SCSI] then   {DEW 09/89 - added SCSI support}
{EXTERNAL VERSION
	  if MSUS.letter in [CS80, SCSI] then                   {DEW 09/89 - added SCSI support}
{INTERNAL ONLY END}
	    begin
	      MSUS.dav.du := un4;
	      MSUS.dav.dv := vn4;
	    end  {then}
	  else
	    begin
	      MSUS.dav.du := un;
	      MSUS.dav.dv := 0;
	    end;  {else}
	end; {with}
  end;

end; {BRstuff}
$page$

module scanstuff;

  (********************************************)
  (*                                          *)
  (*               Warning:                   *)
  (*   This module should not be modified!    *)
  (*                                          *)
  (********************************************)

import
  sysglobals, options, ctr;

export

  procedure init_scanstuff;
  function scanneddevice_letter(scan_dav: dav_type): char;
  procedure get_CS80_parms(CS80dav: dav_type;
			   var CS80dt: byte; var CS80id: integer;
			   var CS80hardvols: shortint; var CS80mp: mp_type);

implement {scanstuff}


type
  uep_type = ^unitentry;

  uep_proc_type = procedure(uep: uep_type);
  HPIBget_amigo_ident_type = procedure(uep: uep_type; var ident: shortint);
  get_letter_type = procedure(uep: uep_type; ident: shortint; var letter: char);
  get_CS80_parms_type = procedure(var CS80dt: byte;
				  var CS80id: integer;
				  var CS80hardvols: shortint;
				  var CS80mp: mp_type);

  proc_type =
    packed record case integer of
      0: (value, slink: integer);
      1: (up: uep_proc_type);
      2: (gai: HPIBget_amigo_ident_type);
      3: (gl: get_letter_type);
      4: (gcp: get_CS80_parms_type);
    end;


var
  allocate_bkgnd_info_proc: proc_type;
  deallocate_bkgnd_info_proc: proc_type;
  abort_bkgnd_process_proc: proc_type;
  HPIBcheck_sc_proc: proc_type;
  HPIBget_amigo_ident_proc: proc_type;

  get_amigo_letter_proc: proc_type;
  get_CS80_letter_proc: proc_type;
  get_CS80_parms_proc: proc_type;

  bkgnd_and_dischpib_present: boolean;
$page$

function scanneddevice_letter(scan_dav: dav_type): char;

  type
    amigo_class_type = {upper three bits of the first ident byte}
      (storage, display, data_communication, processor,
       stimulus, mesasurement, unassigned6, unassigned7);

  var
    ue: unitentry;
    ident:
      packed record case integer of
	0: (word: shortint);
	1: (upper_byte, lower_byte: byte);
	2: (amigo_class: amigo_class_type);
      end;

  procedure set_scanneddevice_letter(get_letter_proc: proc_type);
    var
      device_letter: char;
    begin {set_scanneddevice_letter}
      if get_letter_proc.value<>0 then
	begin
	  call(get_letter_proc.gl, addr(ue), ident.word, device_letter);
	  scanneddevice_letter := device_letter;
	end; {if}
    end; {set_scanneddevice_letter}

  begin {scanneddevice_letter}
    scanneddevice_letter := NODEVICE;  {until proven otherwise}
    if bkgnd_and_dischpib_present then
      try
	ue.sc := scan_dav.sc;
	ue.ba := scan_dav.ba;
	ue.du := scan_dav.du;
	ue.dv := scan_dav.dv;
	call(allocate_bkgnd_info_proc.up, addr(ue));
	call(HPIBcheck_sc_proc.up, addr(ue));
	call(HPIBget_amigo_ident_proc.gai, addr(ue), ident.word);
	if ident.amigo_class=storage then
	    if ident.upper_byte=2
	      then set_scanneddevice_letter(get_CS80_letter_proc)
	      else set_scanneddevice_letter(get_amigo_letter_proc)
	else if ident.amigo_class=display then
	    scanneddevice_letter := PRINTER;
	call(deallocate_bkgnd_info_proc.up, addr(ue));
      recover
	call(abort_bkgnd_process_proc.up, addr(ue));
  end; {scanneddevice_letter}
$page$

procedure get_CS80_parms(CS80dav: dav_type;
			 var CS80dt: byte; var CS80id: integer;
			 var CS80hardvols: shortint; var CS80mp: mp_type);
  begin {get_CS80_parms}
    if (scanneddevice_letter(CS80dav)=CS80) and (get_CS80_parms_proc.value<>0) then
      call(get_CS80_parms_proc.gcp, CS80dt, CS80id, CS80hardvols, CS80mp)
    else
      begin
	CS80dt := 255;
	CS80id := 0;
	CS80hardvols := 0;
	CS80mp := medium_parameters(NODEVICE);
      end; {else}
  end; {get_CS80_parms}


procedure init_scanstuff;
  {
    NOTE: all procedure variables are GLOBAL, so their static links are
	  guaranteed to have been cleared @ load time
  }
  begin {init_scanstuff}
    allocate_bkgnd_info_proc.value   := value('BKGND_ALLOCATE_BKGND_INFO');
    deallocate_bkgnd_info_proc.value := value('BKGND_DEALLOCATE_BKGND_INFO');
    abort_bkgnd_process_proc.value   := value('BKGND_ABORT_BKGND_PROCESS');
    HPIBcheck_sc_proc.value          := value('DISCHPIB_HPIBCHECK_SC');
    HPIBget_amigo_ident_proc.value   := value('DISCHPIB_HPIBGET_AMIGO_IDENT');

    get_amigo_letter_proc.value      := value('AMIGODVR_GET_LETTER');
    get_CS80_letter_proc.value       := value('CS80DVR_GET_LETTER');
    get_CS80_parms_proc.value        := value('CS80DVR_GET_PARMS');

    bkgnd_and_dischpib_present := (allocate_bkgnd_info_proc.value<>0) and
				  (deallocate_bkgnd_info_proc.value<>0) and
				  (abort_bkgnd_process_proc.value<>0) and
				  (HPIBcheck_sc_proc.value<>0) and
				  (HPIBget_amigo_ident_proc.value<>0);
  end; {init_scanstuff}


end; {scanstuff}
$page$

module SCSIscanstuff;           {DEW 09/89 - added SCSI support}

  (********************************************)
  (*                                          *)
  (*               Warning:                   *)
  (*   This module should not be modified!    *)
  (*                                          *)
  (********************************************)


import sysglobals, asm, options, ctr;

export
	procedure init_SCSIscanstuff;
	function SCSIscanneddevice_letter(scan_dav: dav_type): char;
	procedure get_SCSI_parms(    SCSIdav:dav_type;
				 var SCSIdt:byte;
				 var SCSIRemovable:boolean;
				 var SCSImp:mp_type);


implement

type
	uep_type = ^unitentry;

	IsScsiCardType          = procedure(    sc:byte;
					    var yes:boolean);
	ScsiSBSizeType          = procedure(var size:integer);
	ScsiSBInitType          = procedure(    pSB:ANYPTR;  pUP:uep_type);
	ScsiCheckDevType        = procedure(    pSB:ANYPTR);
	ScsiDevInfoType         = procedure(    pSB:ANYPTR;
					    var DevType, AnsiVersion:integer;
					    var Removable:boolean;
					    var VendorString:String255);
	ScsiDiscSizeType        = procedure(    pSB:ANYPTR;
					    var NumBytesBlock, NumBlocksTrack,
						NumTracksCylinder, NumCylinders:integer);
	ScsiPreventType         = procedure(    pSB:ANYPTR);

	ScsiProcType            = packed record case integer of
						0:(value, slink:integer);
						1:(IsCard:IsScsiCardType);
						2:(SBSize:ScsiSBSizeType);
						3:(SBInit:ScsiSBInitType);
						4:(CheckDev:ScsiCheckDevType);
						5:(DevInfo:ScsiDevInfoType);
						6:(DiscSize:ScsiDiscSizeType);
						7:(Prevent:ScsiPreventType);
				  end;

var
	IsScsiCardProc,
	ScsiSBSizeProc,
	ScsiSBInitProc,
	ScsiCheckDevProc,
	ScsiDevInfoProc,
	ScsiDiscSizeProc,
	ScsiPreventProc:ScsiProcType;

	pSB:ANYPTR;
	pUnit:uep_type;
	SCSILIBinMemory:boolean;


procedure init_SCSIscanstuff;
var
	i:integer;
begin
	IsScsiCardProc.value            := value('SCSILIB_ISSCSICARD');
	ScsiSBSizeProc.value            := value('SCSILIB_SCSISBSIZE');
	ScsiSBInitProc.value            := value('SCSILIB_SCSISBINIT');
	ScsiCheckDevProc.value          := value('SCSILIB_SCSICHECKDEV');
	ScsiDevInfoProc.value           := value('SCSILIB_SCSIDEVINFO');
	ScsiDiscSizeProc.value          := value('SCSILIB_SCSIDISCSIZE');
	ScsiPreventProc.value           := value('SCSILIB_SCSIDISCPREVENT');

	SCSILIBinMemory :=      (IsScsiCardProc.value <> 0) and
				(ScsiSBSizeProc.value <> 0) and
				(ScsiSBInitProc.value <> 0) and
				(ScsiCheckDevProc.value <> 0) and
				(ScsiDevInfoProc.value <> 0) and
				(ScsiDiscSizeProc.value <> 0) and
				(ScsiPreventProc.value <> 0);

	if SCSILIBinMemory then
	begin
		call(ScsiSBSizeProc.SBSize, i);
		newbytes(pSB, i);
		newbytes(pUnit, sizeof(unitentry));
	end;
end;

procedure SetUnit(pUnit:uep_type; dav:dav_type);
begin
	with pUnit^ do
	begin
		sc := dav.sc;
		ba := dav.ba;
		du := dav.du;
		dv := dav.dv;
	end;
end;

function SCSIscanneddevice_letter(scan_dav: dav_type): char;
var
	b:boolean;
begin
	SCSIscanneddevice_letter := NODEVICE;  {until proven otherwise}
	if SCSILIBinMemory then
	begin
		call(IsScsiCardProc.IsCard, scan_dav.sc, b);
		if b then {this is a scsi card}
		begin
			SetUnit(pUnit, scan_dav);
			call(ScsiSBInitProc.SBInit, pSB, addr(scan_dav));
			call(ScsiCheckDevProc.CheckDev, pSB);
			if (ioresult = ord(inoerror)) or
			   (ioresult = ord(zmediumchanged)) or
			   (ioresult = ord(znotready)) then
				SCSIscanneddevice_letter := SCSI;
			ioresult := ord(inoerror);
		end;
	end;
end;


procedure get_SCSI_parms(    SCSIdav:dav_type;
			 var SCSIdt:byte;
			 var SCSIRemovable:boolean;
			 var SCSImp:mp_type);
label   1;
var
	dt, ansi:integer;
	s:string255;
	nbps, nspt, ntpc, nc:integer;
	DoPrevent:boolean;
begin
	DoPrevent := FALSE;
	if SCSIscanneddevice_letter(SCSIdav) = SCSI then
	begin
		call(ScsiDevInfoProc.DevInfo, pSB, dt, ansi, SCSIRemovable, s);
		if (ioresult <> ord(inoerror)) or (dt <> 0) then
			{error on communication or not a disk type}
			goto 1;
		SCSIdt := dt;
		if (SCSIRemovable) and (SCSIRemovableOption = AllAreHard) then
		begin
			SCSIRemovable := FALSE;
			DoPrevent := TRUE;
		end;
		call(ScsiDiscSizeProc.DiscSize, pSB, nbps, nspt, ntpc, nc);
		if ioresult = ord(inoerror) then
		begin
			SCSImp.tpm := ntpc * nc;
			SCSImp.bpt := nbps * nspt;
			if (SCSIRemovable) and
			   (SCSIRemovableOption = AllOver10MAreHard) and
			   ( (SCSImp.tpm * SCSImp.bpt) >= hex('A00000') ) then
			begin
				SCSIRemovable := FALSE;
				DoPrevent := TRUE;
			end;
		end
		else if SCSIRemovable then
		begin
			ioresult := ord(inoerror);
			SCSImp.tpm := 1;
			SCSImp.bpt := 256;
		end
		else
			goto 1;
	end
	else
	begin
		1:
		ioresult := ord(inoerror);
		DoPrevent := FALSE;
		SCSIdt := 255;
		SCSImp.tpm := 0;
		SCSImp.bpt := 0;
	end;

	if (DoPrevent) then
	begin
		call(ScsiPreventProc.Prevent, pSB);
		ioresult := ord(inoerror);
	end;
end;



end; {SCSIscanstuff}
$page$

{program ctable}

  (********************************************)
  (*               Caution:                   *)
  (* Modify this section only if the desired  *)
  (* configuration cannot be achieved by      *)
  (* modifying the OPTIONS module.            *)
  (********************************************)

import
  sysglobals, fs, ldr, options, ctr, BRstuff, scanstuff, SCSIscanstuff, bootDAMmodule;  {DEW - added SCSI}

const
  sysprefix = '/WORKSTATIONS/SYSTEM';
  null_dav =
    dav_type[sc: -1, ba: -1, du: -1, dv: -1];
  null_MSUS =
    MSUS_type[flpy_flags: assign_neither_flpy_unit, letter: NODEVICE, dav: null_dav];
  HP9885_default_MSUS =
    MSUS_type[flpy_flags: assign_neither_flpy_unit, letter: HP9885, dav: HP9885_default_dav];
  MSUS_array_size = 10;

type
  MSUS_array_type = array [1..MSUS_array_size] of MSUS_type;
  log_MSUS_options = (search_for_other_units, do_not_search_for_other_units);

var
  flpy_MSUS: MSUS_array_type;
  harddisc_MSUS: MSUS_array_type;
  CS80tape_MSUS: MSUS_array_type;
  scanner_MSUS: MSUS_type;

  local_printer_dav: dav_type;
  SRM_dav: dav_type;
  BUBBLE_dav: dav_type;

  index, select_code, bus_address, i, nvols: shortint; {LAF 870622}
  lun, lun1, lun2: unitnum;
  CS80dt: byte;
  CS80id: integer;
  CS80hardvols: shortint;
  SCSIdt: byte;
  SCSIRemovable:boolean;
  mp: mp_type;
  pp: pp_type;
  ok: boolean;



function increment_and_test_lun: boolean;
  begin {increment_and_test_lun}
    lun := lun+1;
    increment_and_test_lun := lun<=last_harddisc_lun;
  end; {increment_and_test_lun}
$page$

function unit_prefix_successful(dirname: fid): boolean;
  var
    unitnum: integer;
    kvid: vid;
  begin {unit_prefix_successful}
    doprefix(dirname, kvid, unitnum, true);
    unit_prefix_successful := ioresult=ord(inoerror);
  end; {unit_prefix_successful}


procedure zero_out_NA_fields(var device_MSUS: MSUS_type);
  const
    clear = true;
    retain = false;
  procedure zero_fields(sc, ba, du, dv: boolean);
    begin  {zero_fields}
      if sc then device_MSUS.dav.sc := 0;
      if ba then device_MSUS.dav.ba := 0;
      if du then device_MSUS.dav.du := 0;
      if dv then device_MSUS.dav.dv := 0;
    end;  {zero_fields}
  begin {zero_out_NA_fields}
    case device_MSUS.letter of
      INTERNAL:
	zero_fields({sc} clear , {ba} clear , {du} retain, {dv} clear );
      HP9885:
	zero_fields({sc} retain, {ba} clear , {du} retain, {dv} clear );
{INTERNAL ONLY BEGIN}
      HP9895, HP8290X, HP913X_A, HP913X_B, HP913X_C, HP7920, HP7925, SRM:
{EXTERNAL VERSION
      HP9895, HP8290X, HP913X_A, HP913X_B, HP913X_C, SRM:
{INTERNAL ONLY END}
	zero_fields({sc} retain, {ba} retain, {du} retain, {dv} clear );
      BUBBLE:
	zero_fields({sc} retain, {ba} clear , {du} clear , {dv} clear );
      EPROM:
	zero_fields({sc} clear , {ba} clear , {du} clear , {dv} retain);
      otherwise  {includes HP7905, HP7906, CS80, SCSI}
	{do nothing};
    end; {case}
  end; {zero_out_NA_fields}


procedure assign_flpy_unit_pair(lun: unitnum; dam: ds_type; index: shortint);
  begin {assign_flpy_unit_pair}
    with flpy_MSUS[index], flpy_flags, dav do
      begin
	if assign_even_unit then
	  begin
	    tea_flpy(lun, letter, dam, sc, ba, du);
	    lun := lun+1;
	  end; {if}
	if assign_odd_unit then
	  tea_flpy(lun, letter, dam, sc, ba, du+1);
      end; {with}
  end; {assign_flpy_unit_pair}
$page$

procedure log_MSUS(MSUS: MSUS_type; log_MSUS_option: log_MSUS_options);


  type
    log_flpy_MSUS_options = (assign_both_units, assign_only_this_unit);


  procedure log_specific_MSUS(var specific_MSUS: MSUS_array_type);
    var
      index: shortint;
      found: boolean;
    begin {log_specific_MSUS}
      index := 0;
      repeat
	index := index+1;
	found := MSUSs_match(specific_MSUS[index], MSUS);
      until found or (index=MSUS_array_size);
      if found
	then MSUS.flpy_flags := specific_MSUS[index].flpy_flags {preserve}
	else MSUS.flpy_flags := assign_neither_flpy_unit;       {initialize}
      while index>1 do
	begin
	  specific_MSUS[index] := specific_MSUS[index-1];
	  index := index-1;
	end;  {while}
      specific_MSUS[1] := MSUS;
    end; {log_specific_MSUS}


  procedure log_flpy_MSUS(log_flpy_MSUS_option: log_flpy_MSUS_options);
    var
      odd_unit: boolean;
    begin {log_flpy_MSUS}
      with MSUS.dav do
	begin  {since floppy units are assigned in pairs...}
	  odd_unit := odd(du);     {remember which unit this actually is...}
	  du := du-ord(odd_unit);  {but log only the even-numbered unit!}
	end; {with}
      log_specific_MSUS(flpy_MSUS);
      with flpy_MSUS[1] do  {update the flpy_flags}
	if log_flpy_MSUS_option=assign_both_units then
	  flpy_flags := assign_both_flpy_units
	else  {set only this unit's assignment flag}
	  if odd_unit
	    then flpy_flags.assign_odd_unit  := true
	    else flpy_flags.assign_even_unit := true;
    end; {log_flpy_MSUS}


  procedure log_harddisc_MSUS;
    begin {log_harddisc_MSUS}
      MSUS.dav.dv := 0;  {all vols will be assigned, so log only volume zero}
      log_specific_MSUS(harddisc_MSUS);
    end; {log_harddisc_MSUS}
$page$

  function any_9895_unit_missing: boolean;
    var
      temp_dav: dav_type;
      unit_missing: boolean;
    begin {any_9895_unit_missing}
      temp_dav := MSUS.dav;
      temp_dav.du := 3;  {start with unit 3 and work down}
      repeat  {see if all four units are present}
	unit_missing := scanneddevice_letter(temp_dav)<>HP9895;
	temp_dav.du := temp_dav.du-1;
      until (temp_dav.du<0) or unit_missing;
      any_9895_unit_missing := unit_missing;
    end; {any_9895_unit_missing}


  procedure search_higher_numbered_CS80_units;
    var
      temp_MSUS: MSUS_type;
    begin {search_higher_numbered_CS80_units}
      temp_MSUS := MSUS;
      with temp_MSUS, dav do
	if du<14 then  {potentially there are higher-numbered units}
	  begin
	    du := du+1;
	    dv := 0;  {always look for volume 0}
	    letter := scanneddevice_letter(dav);
	    log_MSUS(temp_MSUS, search_for_other_units);  {recurse!}
	  end; {if}
    end; {search_higher_numbered_CS80_units}


  procedure log_CS80_MSUS;
    var
      CS80dt: byte;             {device type}
      CS80id: integer;          {HP product number}
      CS80hardvols: shortint;   {number of volumes}
      CS80mp: mp_type;          {media parameters}
    const
      tape_dt = 2;
      min_hd_size = 10000000;  {bytes}
    begin {log_CS80_MSUS}
      get_CS80_parms(MSUS.dav, CS80dt, CS80id, CS80hardvols, CS80mp);
      if CS80dt=tape_dt then
	log_specific_MSUS(CS80tape_MSUS)
      else if (CS80hardvols=1) and (CS80mp.bpt*CS80mp.tpm<min_hd_size) then
	log_flpy_MSUS(assign_only_this_unit)
      else
	log_harddisc_MSUS;
    end; {log_CS80_MSUS}

  procedure search_higher_numbered_SCSI_units;          {DEW 09/89 - added SCSI support}
    var
      temp_MSUS: MSUS_type;
    begin {search_higher_numbered_SCSI_units}
      {
	search for multiple logical units on a given bus address
      }
      temp_MSUS := MSUS;
      with temp_MSUS, dav do
	if du<7 then
	  begin
	    du := du+1;
	    dv := 0;  {always look for volume 0}
	    letter := SCSIscanneddevice_letter(dav);
	    log_MSUS(temp_MSUS, search_for_other_units);  {recurse!}
	  end; {if}
    end; {search_higher_numbered_SCSI_units}


  procedure log_SCSI_MSUS;                              {DEW 09/89 - added SCSI support}
    var
      SCSIdt: byte;             {device type}
      SCSIRemovable: boolean;   {removable disk}
      SCSImp: mp_type;          {media parameters}
    begin {log_SCSI_MSUS}
      get_SCSI_parms(MSUS.dav, SCSIdt, SCSIRemovable, SCSImp);
      if SCSIdt = 0 then {disk type}
      begin
	if SCSIRemovable then
	  log_flpy_MSUS(assign_only_this_unit)
	else
	  log_harddisc_MSUS;
      end;
      {
	else tapes, printers, etc. not supported.
      }
    end; {log_SCSI_MSUS}
$page$

  begin {log_MSUS}

    zero_out_NA_fields(MSUS);

    case MSUS.letter of

      INTERNAL, HP8290X, HP9885:
	log_flpy_MSUS(assign_both_units);

{INTERNAL ONLY BEGIN}
      HP913X_A, HP913X_B, HP913X_C, HP7905, HP7906, HP7920, HP7925:
{EXTERNAL VERSION
      HP913X_A, HP913X_B, HP913X_C:
{INTERNAL ONLY END}
	log_harddisc_MSUS;

      HP9895:
	if any_9895_unit_missing then  {ultimately assign only two units }
	  log_flpy_MSUS(assign_both_units)
	else  {ultimately assign all four units (probably a 913X)}
	  begin
	    MSUS.dav.du := 0;  {log only unit zero}
	    log_harddisc_MSUS;
	  end;  {else}

      CS80:
	begin
	  if log_MSUS_option=search_for_other_units then
	    search_higher_numbered_CS80_units;
	  log_CS80_MSUS;  {distinguishes tapes, floppies, & hard discs!}
	end;

      SRM:
	SRM_dav := MSUS.dav;

      PRINTER:
	local_printer_dav := MSUS.dav;

      BUBBLE:
	BUBBLE_dav := MSUS.dav;

      SCSI:                                             {DEW 09/89 - added SCSI support}
	begin
	  if log_MSUS_option=search_for_other_units then
	    search_higher_numbered_SCSI_units;
	  log_SCSI_MSUS;  {only disks are supported right now}
	end;

      otherwise
	{do nothing};

    end; {case}

  end; {log_MSUS}
$page$

{
{ Return the suffix of the system we booted.
{ e.g. SYSTEM_xxx -> xxx
{      SYSxxxxxxx -> xxxxxxx
{ Used as suffix for sysprefix (/WORKSTATIONS/SYSTEM) when
{ setting system volume on HFS disks.
}
function syssuffix: string20;
begin
  syssuffix := bootname('', 0);
end;


{
{ determine whether a card at specified select code is 98629--SRM
{ added 870622 LAF to fix bug FSDat01185
{
{ added ability to connect up to SRMLAN support, if it exists and is
{ willing to support 98643A at select code sc. is_SRMcard will return
{ TRUE if it's SRM card, or 98643A with SRMLAN support. SFB/RDQ 1/19/89
}
function is_SRMcard(sc: integer): boolean;
const
  srmlan_symbol='LANSRM_LANSRM_OK';     {procedure in SRMLAN version of SRM}
type
  chararray = packed array [0..65535] of char;
  pchararray = ^chararray;
  proctrick_rectype = record case boolean of
	true  : (proc:procedure(var sc : integer));
	false : (entry, statlink: integer);
    end;
var
  card: pchararray;
  stat2addr: integer;
  kludgerec: record case integer of
    0: (int: integer);
    1: (adr: pchararray);
    end;
  proctrick : proctrick_rectype;
begin
try     (* recover if no card here or if not SRM *)
  is_SRMcard:=true;
  kludgerec.int := sc * hex('10000') + hex('600000');   (* card address *)
  card := kludgerec.adr;
  if ord(card^[1]) mod 128 = 52 then        (* datacomm ?? *)
    begin
      stat2addr := ord(card^[16395])*256 + ord(card^[16393]);
      if stat2addr >= 32768 then escape(0);
      if ord(card^[stat2addr*2+1]) mod 128 <> 1 then escape(0); (* not datacomm *)
      if ord(card^[hex('402f')]) <> 3 then escape(0);       (* not SRM *)
    end
  else
    begin
      proctrick.statlink:=0;
      proctrick.entry:=value(SRMLAN_SYMBOL);
      if proctrick.entry <> 0 then
	call(proctrick.proc, sc);       {SRMLAN_OK will set sc < 0 if will support
					 SRMLAN for this card.
					 Let SRMLAN_OK decide if card is 98643A}
      if sc >= 0 then escape(0);        {LANSRM will not support this sc}
    end;
recover
  is_SRMcard := false;
end;


begin {ctable}

  { various initializations }

  call(cleariohook); {init IO cards in case the BOOTROM drivers touched them}

  init_scanstuff;
  init_SCSIscanstuff;

  for index := 1 to MSUS_array_size do
    begin
      flpy_MSUS[index]     := null_MSUS;
      harddisc_MSUS[index] := null_MSUS;
      CS80tape_MSUS[index] := null_MSUS;
    end;  {for}

  SRM_dav                  := SRM_default_dav;     {overridden if bootdevice}

  BUBBLE_dav               := BUBBLE_default_dav;  {overridden if bootdevice}

  if local_printer_option=HPIB
    then local_printer_dav := local_HPIB_printer_default_dav   {scan may override}
    else if local_printer_option=RS232
    then local_printer_dav := local_RS232_printer_default_dav  {scan may override}
    else local_printer_dav := local_PARALLEL_printer_default_dav;  {scan may override}


  { log the default 9885 floppy pair, since HP-IB scanning won't include it }

  log_MSUS(HP9885_default_MSUS, search_for_other_units);


  { scan the HP-IB's for mass storage devices and possibly a local printer }

  with scanner_MSUS, dav do
    for index := 1 to sc_list_length do
      for bus_address := 0 to 7 do
	begin
	  sc := sc_list[index];
	  ba := bus_address;
	  du := 0;
	  dv := 0;
	  letter := scanneddevice_letter(dav);
	  log_MSUS(scanner_MSUS, search_for_other_units);
	end; {for}

  { scan the SCSI select codes for disks}

  with scanner_MSUS, dav do
    for index := 1 to SCSIsc_list_length do
      for bus_address := 0 to 7 do
	begin
	  sc := SCSIsc_list[index];
	  ba := bus_address;
	  du := 0;
	  dv := 0;
	  letter := SCSIscanneddevice_letter(dav);
	  log_MSUS(scanner_MSUS, search_for_other_units);
	end; {for}


  { log internal mini if present, since HP-IB scanning didn't include it }

  if internal_mini_present then
    log_MSUS(INTERNAL_MSUS, search_for_other_units);


  { check sc 21 for SRM, scan for it if it's not there, keep lowest sc }
  { added 870622 LAF to fix bug FSDat01185 }

  if not is_SRMcard(SRM_dav.sc) then
    for select_code:=31 downto 7 do
      if is_SRMcard(select_code) then
	SRM_dav.sc:=select_code;


  { get the bootdevice MSUS & log it }

  get_bootdevice_MSUS(bootdev_MSUS);
  zero_out_NA_fields(bootdev_MSUS);  {for tea routine comparisons}
  log_MSUS(bootdev_MSUS, do_not_search_for_other_units);
  bootdev_lun := 0;  {set otherwise if/when bootdevice is assigned in tea}
$page$

  { Create a temporary table & fill it with dummy entries }

  create_temp_unitable;


  { standard assignments: avoid changing }

  tea_memory_volume_dam(primary_dam);

  tea_crt( 1);
  tea_kbd( 2);

  assign_flpy_unit_pair( 3, primary_dam, {flpy_MSUS[]} 1);

  with SRM_dav do
    tea_srm( 5, sc, ba, du);

  with local_printer_dav do
    tea_local_printer( 6, sc, ba, {uvid} 'PRINTER', local_printer_timeout);


  { optional floppy unit pairs }

  for index := 2 to floppy_unit_pairs do
    assign_flpy_unit_pair(7+(index-2)*2, primary_dam, {flpy_MSUS[]} index);

$page$

  { local hard discs }

  $if true$

    lun := first_harddisc_lun-1;

    for index := 1 to MSUS_array_size do
      with harddisc_MSUS[index], dav do
	case letter of

	  HP9895: {9895 ident with all four units present; probably a HP913X}
	    for i := 0 to 3 do
	      if increment_and_test_lun then
		tea_HP9895(lun, primary_dam, sc, ba, {du} i, {block_offset} 0);

{INTERNAL ONLY BEGIN}
	  HP913X_A, HP913X_B, HP913X_C, HP7920, HP7925:
{EXTERNAL VERSION
	  HP913X_A, HP913X_B, HP913X_C:
{INTERNAL ONLY END}
	    begin
	      mp := medium_parameters(letter);
	      pp := partitioning_parameters(letter);
	      nvols := number_vols(mp, pp);
	      hfs_installed := false;
	      for i := 0 to nvols-1 do
		if not hfs_installed and increment_and_test_lun then
		  tea_amigo_sv(lun, primary_dam, sc, ba, du,
				    vol_offset(i, nvols, mp),
				    letter,
				    vol_bytes(i, nvols, mp));
	    end;

{INTERNAL ONLY BEGIN}
	  HP7905, HP7906:
	    begin
	      mp := medium_parameters(letter);
	      pp := partitioning_parameters(letter);
	      repeat
		nvols := number_vols(mp, pp);
		hfs_installed := false;
		for i := 0 to nvols-1 do
		  if not hfs_installed and increment_and_test_lun then
		    tea_amigo_mv(lun, primary_dam, sc, ba, du, dv,
				      vol_offset(i, nvols, mp),
				      letter,
				      vol_bytes(i, nvols, mp));
		if letter=HP7905 then  {adjust for its half-size fixed portion}
		  mp.tpm := mp.tpm div 2;
		dv := dv+1;
	      until dv>=2;
	    end;
{INTERNAL ONLY END}

	  CS80:
	    begin
	      pp := partitioning_parameters(letter);
	      repeat
		get_CS80_parms(dav, CS80dt, CS80id, CS80hardvols, mp);
		if mp.tpm=1 then  {track partitioning info unavailable...}
		  mp := block_boundaries(mp);  {will have to fake it!}
		nvols := number_vols(mp, pp);
		hfs_installed := false;
		for i := 0 to nvols-1 do
		  if not hfs_installed and increment_and_test_lun then
		    tea_CS80_mv(lun, primary_dam, sc, ba, du, dv,
				     vol_offset(i, nvols, mp),
				     {devid} CS80id,
				     vol_bytes(i, nvols, mp),
				     mp.tpm*mp.bpt);
		dv := dv+1;
	      until dv>=CS80hardvols;
	    end;

	  SCSI:
	    begin
		pp := partitioning_parameters(letter);
		get_SCSI_parms(dav, SCSIdt, SCSIRemovable, mp);
		nvols := number_vols(mp, pp);
		hfs_installed := false;
		for i := 0 to nvols-1 do
		  if not hfs_installed and increment_and_test_lun then
		    tea_SCSI_mv(lun, primary_dam, sc, ba, du, dv,
				     vol_offset(i, nvols, mp),
				     {devid} SCSIdt,
				     vol_bytes(i, nvols, mp),
				     mp.tpm*mp.bpt);
	    end;

	  otherwise
	    {no local hard disc logged};

	end; {case}

  $end$  { local hard discs }


  { CS80 tapes }

  $if true$

    with CS80tape_MSUS[1], dav do
      if letter=CS80 then
	tea_CS80_sv(41, LIF_dam, sc, ba, du, dv);

    with CS80tape_MSUS[2], dav do
      if letter=CS80 then
	tea_CS80_sv(42, LIF_dam, sc, ba, du, dv);

  $end$  { CS80 tapes }


  { secondary directory access method entries for highest priority floppies }

  assign_flpy_unit_pair(43, secondary_dam, {flpy_MSUS[]} 1);

  { secondary directory access method entries for additional floppies }

  assign_flpy_unit_pair(47, secondary_dam, {flpy_MSUS[]} 2);

  assign_flpy_unit_pair(49, secondary_dam, {flpy_MSUS[]} 3);



  { duplicate entries for prefixing down the SRM }

{INTERNAL ONLY BEGIN}
  (***********************************************************************)
  (*  NOTE:  Additional duplicate SRM entries may be assigned here, then *)
  (*    prefixed down below after assigning the temp_unitable.  However  *)
  (*    for correct behavior in assigning the system unit, specifically  *)
  (*    if booting off the SRM, unit #45 must be the assigned AFTER all  *)
  (*    the other SRM units have been assigned!                          *)
  (*                                                                     *)
  (*    You may assign both "real" SRM and SRM-UX units with this code.  *)
  (*    You must put in the correct unit number, select code, bus        *)
  (*    address (really SRM host node number), and du (really SRM disc   *)
  (*    volume number or SRM-UX emulated disc volume number.)            *)
  (*                                                                     *)
  (*    Unit numbers 46 through 50 are often available for use as        *)
  (*    additional SRM or SRM-UX entries, especially if you have no      *)
  (*    more than one floppy unit pair, and you are not booting from an  *)
  (*    HFS hard disc.                                                   *)
  (*                                                                     *)
  (*    SRM volume information is available from the SRM console.        *)
  (*    SRM-UX volume emulation information is available from the        *)
  (*    HP-UX file "/etc/srmconf" on the SRM-UX server machine.          *)
  (***********************************************************************)
{INTERNAL ONLY END}

  with SRM_dav do
    begin
      {  tea_srm(46, sc, ba, du);  {free unless booting from HFS hard disc}
      tea_srm(45, sc, ba, du);  {for possible use as the system unit}
    end; {with}

$page$

  { templates for "manually" specifying mass storage table entry assignments }


  $if false$ { internal minifloppy in a 9826/9836 }
    tea_mini( 3, primary_dam, {du} 0);
    tea_mini( 4, primary_dam, {du} 1);
  $end$

  $if false$ { HP8290X, HP9121, or the floppy in an HP913X }
    tea_HP8290X( 3, primary_dam, {sc}  7, {ba} 0, {du} 0);
    tea_HP8290X( 4, primary_dam, {sc}  7, {ba} 0, {du} 1);
  $end$

  $if false$ { HP9895 }
    tea_HP9895( 7, primary_dam, {sc}  7, {ba} 0, {du} 0, {block_offset} 0);
    tea_HP9895( 8, primary_dam, {sc}  7, {ba} 0, {du} 1, {block_offset} 0);
  $end$

  $if false$ { HP913X (four volume 9895 look-a-like version) }
    for i := 0 to 3 do
      tea_HP9895(11+i, primary_dam, {sc}  7, {ba} 0, {du} i, {block_offset} 0);
  $end$

  $if false$ { HP913X_A (5 Mbyte single volume version) }
    mp := medium_parameters(HP913X_A);
    nvols := 4;
    for i := 0 to nvols-1 do
      tea_amigo_sv(11+i, primary_dam, {sc}  7, {ba} 0, {du} 0,
			 vol_offset(i, nvols, mp),
			 HP913X_A,
			 vol_bytes(i, nvols, mp));
  $end$

  $if false$ { HP913X_B (10 Mbyte single volume version) }
    mp := medium_parameters(HP913X_B);
    nvols := 9;
    for i := 0 to nvols-1 do
      tea_amigo_sv(11+i, primary_dam, {sc}  7, {ba} 0, {du} 0,
			 vol_offset(i, nvols, mp),
			 HP913X_B,
			 vol_bytes(i, nvols, mp));
  $end$

  $if false$ { HP913X_C (15 Mbyte single volume version) }
    mp := medium_parameters(HP913X_C);
    nvols := 14;
    for i := 0 to nvols-1 do
      tea_amigo_sv(11+i, primary_dam, {sc}  7, {ba} 0, {du} 0,
			 vol_offset(i, nvols, mp),
			 HP913X_C,
			 vol_bytes(i, nvols, mp));
  $end$
$page$

{INTERNAL ONLY BEGIN}
  $if false$ { HP7905 }
    mp := medium_parameters(HP7905);
    { mp := block_boundaries(mp);  {override track boundary partitioning}
    nvols := 10;
    for i := 0 to nvols-1 do  {assign removable medium entries}
      tea_amigo_mv (11+i, primary_dam, {sc} 14, {ba} 0, {du} 0, {dv} 0,
			  {offset} vol_offset(i, nvols, mp),
			  {letter} HP7905,
			  {umaxbytes} vol_bytes(i, nvols, mp));
    mp.tpm := mp.tpm div 2;  {fixed only half size}
    nvols := 5;
    for i := 0 to nvols-1 do  {assign fixed medium entries}
      tea_amigo_mv (21+i, primary_dam, {sc} 14, {ba} 0, {du} 0, {dv} 1,
			  {offset} vol_offset(i, nvols, mp),
			  {letter} HP7905,
			  {umaxbytes} vol_bytes(i, nvols, mp));
  $end$

  $if false$ { HP7906 }
    mp := medium_parameters(HP7906);
    { mp := block_boundaries(mp);  {override track boundary partitioning}
    nvols := 10;
    for i := 0 to nvols-1 do  {assign removable medium entries}
      tea_amigo_mv (11+i, primary_dam, {sc} 14, {ba} 0, {du} 0, {dv} 0,
			  {offset} vol_offset(i, nvols, mp),
			  {letter} HP7906,
			  {umaxbytes} vol_bytes(i, nvols, mp));
    for i := 0 to nvols-1 do  {assign fixed medium entries}
      tea_amigo_mv (21+i, primary_dam, {sc} 14, {ba} 0, {du} 0, {dv} 1,
			  {offset} vol_offset(i, nvols, mp),
			  {letter} HP7906,
			  {umaxbytes} vol_bytes(i, nvols, mp));
  $end$

  $if false$ { HP7920 }
    mp := medium_parameters(HP7920);
    { mp := block_boundaries(mp);  {override track boundary partitioning}
    nvols := 30;
    for i := 0 to nvols-1 do
      tea_amigo_sv(11+i, primary_dam, {sc} 14, {ba} 0, {du} 0,
			 {offset} vol_offset(i, nvols, mp),
			 {letter} HP7920,
			 {umaxbytes} vol_bytes(i, nvols, mp));
  $end$

  $if false$ { HP7925 }
    mp := medium_parameters(HP7925);
    { mp := block_boundaries(mp);  {override track boundary partitioning}
    nvols := 30;
    for i := 0 to nvols-1 do
      tea_amigo_sv(11+i, primary_dam, {sc} 14, {ba} 0, {du} 0,
			 {offset} vol_offset(i, nvols, mp),
			 {letter} HP7925,
			 {umaxbytes} vol_bytes(i, nvols, mp));
  $end$
{INTERNAL ONLY END}
$page$

  $if false$ { current CS/80 discs "soft" partitioned by the host }
      CS80id := 7908; nvols := 16; mp.tpm :=  5* 370; mp.bpt := 35*256;  {7908}
    { CS80id := 7911; nvols := 27; mp.tpm :=  3* 572; mp.bpt := 64*256;  {7911}
    { CS80id := 7912; nvols := 30; mp.tpm :=  7* 572; mp.bpt := 64*256;  {7912}
    { CS80id := 7914; nvols := 30; mp.tpm :=  7*1152; mp.bpt := 64*256;  {7914}
    { CS80id := 7933; nvols := 30; mp.tpm := 13*1321; mp.bpt := 92*256;  {7933}
    { CS80id := 7935; nvols := 30; mp.tpm := 13*1321; mp.bpt := 92*256;  {7935}
    { mp := block_boundaries(mp);  {override track boundary partitioning}
    hfs_installed:=false;
    for i := 0 to nvols-1 do
      if not hfs_installed then
	tea_CS80_mv(11+i, primary_dam, {sc}  7, {ba} 0, {du} 0, {dv} 0,
			  vol_offset(i, nvols, mp),
			  {devid} CS80id,
			  vol_bytes(i, nvols, mp),
			  mp.tpm*mp.bpt);
  $end$


  $if false$ { current CS/80 discs "hard" partitioned by the device }
      CS80hardvols :=  3;
      for i := 0 to CS80hardvols-1 do
	tea_CS80_sv(11+i, primary_dam, {sc}  7, {ba} 0, {du} 0, {dv} i);
  $end$


  $if false$ { Command Set/80 floppy }
    tea_CS80_sv( 3, primary_dam, {sc}  7, {ba} 0, {du} 0, {dv} 0);
  $end$


  $if false$ { Command Set/80 tape }
    tea_CS80_sv(41, LIF_dam, {sc}  7, {ba} 0, {du} 1, {dv} 0);
  $end$


  $if false$ { BUBBLE memory }
    {watch for conflicting uses of unit 42}
    {BUBBLE_DAV.SC default is 30 but may have been changed to boot SC}
    tea_BUBBLE(42,primary_dam,BUBBLE_dav.SC);
  $end$


  $if false$ { EPROM DISC }
    {watch for conflicting uses of unit 42}
    tea_EPROM(42,primary_dam,{ sequence number } 0);
  $end$


  { end of templates }
$page$

  { assign the new unitable and unitclear all units }

  assign_temp_unitable;

  { prefix the primary and secondary SRM unit entries }

  if not unit_prefix_successful('#5:/') then
    {do nothing};  {tries to set up uvid for possible default unit assignment below}

  { if not unit_prefix_successful('#46:/?') then zap_assigned_unit(46);}
  {NOTE: DO NOT UNCOMMENT THE ABOVE LINE IF YOU BOOT FROM AN HFS DISC! }

  if not unit_prefix_successful('#45:'+sysprefix+srmnode(unitable^[45].sc)) then
    if not unit_prefix_successful('#45:'+sysprefix) then
      zap_assigned_unit(45);


  { remove extraneous local hard disc entries if necessary }

  lun2 := first_harddisc_lun;
  while lun2<last_harddisc_lun do
    begin
      lun1 := lun2;
      repeat
	lun2 := lun2+1;
      until (lun2>last_harddisc_lun) or not on_same_medium(lun1, lun2);
      pp := partitioning_parameters(unitable^[lun1].letter);
      if pp.mnv<-1 then
	remove_extraneous_volumes(lun1, lun2-1);
    end; {while}


  { assign the system unit }

  if specified_system_unit<>0 then
    ok := sysunit_ok(specified_system_unit)
  else if (bootdev_lun<>0) and (unitable^[bootdev_lun].umaxbytes>300000) then
    ok := sysunit_ok(bootdev_lun)
  else  {search for a more suitable system unit}
    begin
      index := 0;
      repeat
	index := index+1;
	ok := sysunit_ok(sysunit_list[index]);
      until ok or (index>=sysunit_list_length);
      if not ok then  {revert back to boot device, hoping it was identified}
	ok := sysunit_ok(bootdev_lun);
    end; {else}


  { special case for default unit assignment }

  if sysunit=45 then  {set the default unit to the primary SRM unit entry}
    dkvid := unitable^[5].uvid;
$page$
  { rearrange things for HFS }
  if h_unitable <> nil then with h_unitable^ do begin

      { if booted from HFS, need to reset syvid and dkvid       }
      { also, try to set sysvolume to #46:/WORKSTATIONS/SYSTEM*  }
      if unitable^[sysunit].uisfixed
      and tbl[sysunit].is_hfsunit
      and sysunit_ok(sysunit) then begin
	lun := sysunit;
	extra_HFS_unit(sysunit, 46, sysprefix+syssuffix);
	if not tbl[46].is_hfsunit then
	  extra_HFS_unit(sysunit, 46, sysprefix);
	if tbl[46].is_hfsunit and sysunit_ok(46) then
	  dkvid := unitable^[lun].uvid;
      end;

      { At this point, there is only one HFS unit per disc, except    }
      { on the system disc (if it's HFS), where there are two -- one  }
      { at /WORKSTATIONS/SYSTEM, the other at /.  Add more as         }
      { follows:                                                      }
      { extra_HFS_unit(old unit #, new unit #, prefix)                }
      { "new unit" then becomes a unit on the same disc as "old unit",}
      { which must already exist.  This fails unless new unit is not  }
      { yet used, or if the prefix fails.  The prefix should not in-  }
      { clude a volume name or number.                                }
      { Example:                                                      }
      {         extra_HFS_unit(11, 12, '/PROGS');                     }

  end;

  { re-open the standard system files }
  openfiles;

end. {ctable}
