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


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

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

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

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

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

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

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

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

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

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

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

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

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

47.1
date     90.05.14.10.55.02;  author dew;  state Exp;
branches ;
next     46.2;

46.2
date     90.05.09.14.57.10;  author dew;  state Exp;
branches ;
next     46.1;

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

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

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

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

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

41.1
date     89.12.22.11.25.23;  author jwh;  state Exp;
branches ;
next     40.2;

40.2
date     89.12.14.15.45.36;  author dew;  state Exp;
branches ;
next     40.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

27.1
date     88.09.29.11.25.20;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.04.41;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.22.30;  author bayes;  state Exp;
branches ;
next     24.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1.1
date     86.06.30.14.28.26;  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
@					      (*

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


	    RESTRICTED RIGHTS LEGEND

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

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$modcal$
$debug off, range off, ovflcheck off$
$stackcheck off, iocheck off$

{{
$search 'KERNEL'$
{}
$search 'IOLIB:KERNEL','OSFS:SYSDEVS'$
{}

$page$
$copyright 'COPYRIGHT (C) 1984 BY HEWLETT-PACKARD COMPANY'$


module prtdvr;

import
  sysglobals,
  iodeclarations,
  asm, sysdevs, mini, misc, fs;

export
  procedure prtio (fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
implement  {prtdvr}

procedure bep;
  begin write(bellchar); end;

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

const
  uclr_timeout_const = 25;      {HPIB commands during unitclear}

  repeating_timeout  = 333;     {timeout constant after initial timeout}
  timeouts_per_beep  = 40;      {beep period in repeating timeout units}

  SDC      = 4;         {selective device clear}
  LAGbase  = 32;        {listen address group base}
  TAGbase  = 64;        {talk address group base}

  linefeed = chr(10);   {ASCII linefeed}
  formfeed = chr(12);   {ASCII formfeed}
  return   = chr(13);   {ASCII carriage return}

var

  select_code: type_isc;
  sc_table_entry_ptr: ^isc_table_type;
  previous_char_ptr: charptr;
  bus_address: byte;

  channel_is_setup: boolean;
  writing_previous_char: boolean;
  previously_timed_out: boolean;
  timeout_blanked: boolean;
  user_spec_timeout: integer;
  current_timeout: integer;
  timeout_counter: shortint;
  saved_line     : string[42];          { 3.0 bug fix -- 4/12/84 }
  line_needs_restoring : boolean;       { 4/12/84 }
  buf: charptr;
  saved_echo: boolean;                  { 5/9/84 }

$page$

procedure reset_card_and_confirm_timeout;
  var
    saved_escapecode: shortint;
    saved_ioe_sc: integer;
    saved_ioe_result: integer;
  begin {reset_card_and_confirm_timeout}
    saved_escapecode := escapecode;
    saved_ioe_sc := ioe_isc;
    saved_ioe_result := ioe_result;
    try
      with sc_table_entry_ptr^ do
	call(io_drv_ptr^.iod_init, io_tmp_ptr);
    recover
      if (escapecode<>ioescapecode) or (ioe_isc<>select_code) then
	escape(escapecode);
    ioe_isc := saved_ioe_sc;
    ioe_result := saved_ioe_result;
    if (saved_escapecode<>ioescapecode) or (ioe_isc<>select_code) then
      escape(saved_escapecode);
    if ioe_result<>ioe_timeout then
      ioresc(znodevice);
  end; {reset_card_and_confirm_timeout}

procedure clear_unit;
var w:io_word;
  procedure HPIBsdc;
    begin {HPIBsdc}
      with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^ do
	begin
	  call(iod_send, io_tmp_ptr, '?');
	  timeout := uclr_timeout_const;
	  call(iod_send, io_tmp_ptr, chr(LAGbase+bus_address));
	  call(iod_send, io_tmp_ptr, chr(SDC));
	end; {with}
    end; {HPIBsdc}
  begin {clear_unit}
    with sc_table_entry_ptr^ do
      if card_type=hpib_card then
	try
	  HPIBsdc;         {first attempt}
	recover
	  begin
	    reset_card_and_confirm_timeout;
	    try
	      HPIBsdc;       {second attempt}
	    recover
	      begin
		reset_card_and_confirm_timeout;
		ioresc(ztimeout);
	      end; {recover}
	  end {recover}
      else if card_type = serial_card then                      {12/89 dew - added pllel}
	try
	  call(io_drv_ptr^.iod_init, io_tmp_ptr);
	recover
	  if (escapecode<>ioescapecode) or (ioe_isc<>select_code) then escape(escapecode)
	  else ioresc(znodevice)
      else {parallel_card}                                      {12/89 dew - added pllel}
	try
	  io_tmp_ptr^.timeout := current_timeout;
	  call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 21, 0);  {set the reset type to not present}
	  call(io_drv_ptr^.iod_init, io_tmp_ptr);        {reset driver}
	  call(io_drv_ptr^.iod_rds, io_tmp_ptr, 20, w);  {get peripheral type}
	  if w = 1 then {OUTPUT_ONLY}
	  begin
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 20, 11); {set current type to user_spec_output_only}
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 21, 11); {set the reset type to same}
	  end
	  else {not a printer there}
		ioresc(znodevice);
	recover
	  begin
	    reset_card_and_confirm_timeout;
	    ioresc(ztimeout);
	  end; {recover}
  end; {clear_unit}

$page$

procedure wrtchar(character: char; last_char: boolean);

  var
    hs_successfully_initiated: boolean;
    previous_hs_completed    : boolean;


  procedure restore_line;
  var dummyc:char;
  begin
    if line_needs_restoring then { 4/12/84 }
    begin
      keybuffer^.echo:=saved_echo;
      keybufops(kdisplay,dummyc);
      line_needs_restoring:=false;
    end;
  end;

$page$

  procedure inform_operator;
  var lmstr : string[42];                      { 3.0 bug fix -- 4/12/84 }
    begin  {inform_operator}

      if not previously_timed_out then
      begin
	timeout_blanked := true;
	timeout_counter := 0;
      end;
      if not line_needs_restoring then
      begin
	saved_line := '* Printer timeout: fix or ';
	if intlevel=0 then saved_line:=saved_line+'<stop> aborts *'
		      else saved_line:=saved_line+'wait auto-abort*' ;
					       { 3.0 bug fix -- 4/12/84 }
	line_needs_restoring := true;
	if menustate=m_none then saved_echo:=keybuffer^.echo
			    else saved_echo:=true;
	menustate := m_none; { 4/12/84 }
	keybuffer^.echo :=false;
      end;
      if timeout_blanked then lmstr:= saved_line
			 else lmstr:= ' ';
      CALL(CRTLLHOOK,CLLDISPLAY,LMSTR,' ');
      timeout_blanked:= (timeout_counter mod 4)<>0;

      if timeout_counter<=1 then bep;
      timeout_counter := timeout_counter+1;
      if timeout_counter>=timeouts_per_beep then
	if intlevel=0 then timeout_counter := 0
	else
	  begin
	    bep;
	    restore_line;
	    ioresc(ztimeout);
	  end; {else}

    end;  {inform_operator}

$page$

  begin {wrtchar}
    try
      with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^  do
	repeat
	  try
	    previous_hs_completed := false;
	    if not channel_is_setup then
	      begin
		case card_type of
		  hpib_card:
		    begin
		      call(iod_send, io_tmp_ptr, '?');
		      previous_hs_completed := true;
		      timeout := current_timeout;
		      call(iod_send, io_tmp_ptr, chr(TAGbase+addressed));
		      call(iod_send, io_tmp_ptr, chr(LAGbase+bus_address));
		    end; {hpib_card}
		  serial_card:
		    if card_id=hp98626 then  {always set full duplex modem HS}
		      call(iod_wtc, io_tmp_ptr, 13, 1);
		  pllel_card:                                   {12/89 dew - added pllel}
		    begin
		      timeout := current_timeout;
		      call(iod_wtc, io_tmp_ptr, 24, 4); {write verify}
		    end;
		  otherwise
		    {do nothing};
		end; {case}
		channel_is_setup := true;
	      end; {if}
	    call(iod_wtb, io_tmp_ptr, character);
	    previous_char_ptr^ := character;
	    timeout := current_timeout;
	    if last_char then
	      if card_type=hpib_card then
		call(iod_send, io_tmp_ptr, '?');
	    if previously_timed_out then
	      if not writing_previous_char then
		begin
		  restore_line;
		  current_timeout := user_spec_timeout;
		  previously_timed_out := false;
		end; {if}
	    hs_successfully_initiated := true;
	  recover
	    begin
	      reset_card_and_confirm_timeout;
	      channel_is_setup := false;
	      inform_operator;
	      previously_timed_out := true;
	      current_timeout := repeating_timeout;
	      if not (writing_previous_char or previous_hs_completed) then
		begin
		  writing_previous_char := true;
		  wrtchar(previous_char_ptr^, false);
		  writing_previous_char := false;
		end; {if}
	      hs_successfully_initiated := false;
	    end; {recover}
	until hs_successfully_initiated;
    recover
      begin
	restore_line;   { 4/12/84 }
	escape(escapecode);
      end; {recover}
  end; {wrtchar}
$page$

  begin  {prtio}
    ioresult := ord(inoerror);                                 { scs 1/17/83 }
    with unitable^[fp^.funit] do
      begin
	select_code := sc;
	sc_table_entry_ptr := addr(isc_table[select_code]);
	bus_address := ba;
	previous_char_ptr := addr(dvrtemp);
	user_spec_timeout := devid;  {user-specified in CTABLE}
      end; {with}

    buf := addr(buffer);
    channel_is_setup := false;
    current_timeout := user_spec_timeout;
    previously_timed_out  := false;
    writing_previous_char := false;
    line_needs_restoring  := false; { 4/12/84 }

    try
      with sc_table_entry_ptr^, io_tmp_ptr^  do
	begin
	  if card_type=no_card then ioresc(znodevice);
	  while (in_bufptr<>nil) or (out_bufptr<>nil) do {nothing};
	end; {with}

      case request of
	flush:
	  {do nothing};
	clearunit:
	  clear_unit;
	writeeol:
	  begin
	    wrtchar(return, false);
	    wrtchar(linefeed, true)
	  end;
	writebytes:
	  while length>0 do
	    begin
	      wrtchar(buf^, length=1);
	      buf := addr(buf^, 1);
	      length := length-1;
	    end;
	otherwise
	  ioresc(zbadmode);
      end; {case}
    recover
      if (escapecode=-20) and previously_timed_out then
	ioresult := ord(ztimeout)
      else if escapecode<>-10 then
	escape(escapecode);

  end; {prtio}

end. {prtdvr}

@


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


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

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


	    RESTRICTED RIGHTS LEGEND

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

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$modcal$
$debug off, range off, ovflcheck off$
$stackcheck off, iocheck off$

{{
$search 'KERNEL'$
{}
$search 'IOLIB:KERNEL','OSFS:SYSDEVS'$
{}

$page$
$copyright 'COPYRIGHT (C) 1984 BY HEWLETT-PACKARD COMPANY'$


module prtdvr;

import
  sysglobals,
  iodeclarations,
  asm, sysdevs, mini, misc, fs;

export
  procedure prtio (fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
implement  {prtdvr}

procedure bep;
  begin write(bellchar); end;

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

const
  uclr_timeout_const = 25;      {HPIB commands during unitclear}

  repeating_timeout  = 333;     {timeout constant after initial timeout}
  timeouts_per_beep  = 40;      {beep period in repeating timeout units}

  SDC      = 4;         {selective device clear}
  LAGbase  = 32;        {listen address group base}
  TAGbase  = 64;        {talk address group base}

  linefeed = chr(10);   {ASCII linefeed}
  formfeed = chr(12);   {ASCII formfeed}
  return   = chr(13);   {ASCII carriage return}

var

  select_code: type_isc;
  sc_table_entry_ptr: ^isc_table_type;
  previous_char_ptr: charptr;
  bus_address: byte;

  channel_is_setup: boolean;
  writing_previous_char: boolean;
  previously_timed_out: boolean;
  timeout_blanked: boolean;
  user_spec_timeout: integer;
  current_timeout: integer;
  timeout_counter: shortint;
  saved_line     : string[42];          { 3.0 bug fix -- 4/12/84 }
  line_needs_restoring : boolean;       { 4/12/84 }
  buf: charptr;
  saved_echo: boolean;                  { 5/9/84 }

$page$

procedure reset_card_and_confirm_timeout;
  var
    saved_escapecode: shortint;
    saved_ioe_sc: integer;
    saved_ioe_result: integer;
  begin {reset_card_and_confirm_timeout}
    saved_escapecode := escapecode;
    saved_ioe_sc := ioe_isc;
    saved_ioe_result := ioe_result;
    try
      with sc_table_entry_ptr^ do
	call(io_drv_ptr^.iod_init, io_tmp_ptr);
    recover
      if (escapecode<>ioescapecode) or (ioe_isc<>select_code) then
	escape(escapecode);
    ioe_isc := saved_ioe_sc;
    ioe_result := saved_ioe_result;
    if (saved_escapecode<>ioescapecode) or (ioe_isc<>select_code) then
      escape(saved_escapecode);
    if ioe_result<>ioe_timeout then
      ioresc(znodevice);
  end; {reset_card_and_confirm_timeout}

procedure clear_unit;
var w:io_word;
  procedure HPIBsdc;
    begin {HPIBsdc}
      with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^ do
	begin
	  call(iod_send, io_tmp_ptr, '?');
	  timeout := uclr_timeout_const;
	  call(iod_send, io_tmp_ptr, chr(LAGbase+bus_address));
	  call(iod_send, io_tmp_ptr, chr(SDC));
	end; {with}
    end; {HPIBsdc}
  begin {clear_unit}
    with sc_table_entry_ptr^ do
      if card_type=hpib_card then
	try
	  HPIBsdc;         {first attempt}
	recover
	  begin
	    reset_card_and_confirm_timeout;
	    try
	      HPIBsdc;       {second attempt}
	    recover
	      begin
		reset_card_and_confirm_timeout;
		ioresc(ztimeout);
	      end; {recover}
	  end {recover}
      else if card_type = serial_card then                      {12/89 dew - added pllel}
	try
	  call(io_drv_ptr^.iod_init, io_tmp_ptr);
	recover
	  if (escapecode<>ioescapecode) or (ioe_isc<>select_code) then escape(escapecode)
	  else ioresc(znodevice)
      else {parallel_card}                                      {12/89 dew - added pllel}
	try
	  io_tmp_ptr^.timeout := current_timeout;
	  call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 21, 0);  {set the reset type to not present}
	  call(io_drv_ptr^.iod_init, io_tmp_ptr);        {reset driver}
	  call(io_drv_ptr^.iod_rds, io_tmp_ptr, 20, w);  {get peripheral type}
	  if w = 1 then {OUTPUT_ONLY}
	  begin
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 20, 11); {set current type to user_spec_output_only}
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 21, 11); {set the reset type to same}
	  end
	  else {not a printer there}
		ioresc(znodevice);
	recover
	  begin
	    reset_card_and_confirm_timeout;
	    ioresc(ztimeout);
	  end; {recover}
  end; {clear_unit}

$page$

procedure wrtchar(character: char; last_char: boolean);

  var
    hs_successfully_initiated: boolean;
    previous_hs_completed    : boolean;


  procedure restore_line;
  var dummyc:char;
  begin
    if line_needs_restoring then { 4/12/84 }
    begin
      keybuffer^.echo:=saved_echo;
      keybufops(kdisplay,dummyc);
      line_needs_restoring:=false;
    end;
  end;

$page$

  procedure inform_operator;
  var lmstr : string[42];                      { 3.0 bug fix -- 4/12/84 }
    begin  {inform_operator}

      if not previously_timed_out then
      begin
	timeout_blanked := true;
	timeout_counter := 0;
      end;
      if not line_needs_restoring then
      begin
	saved_line := '* Printer timeout: fix or ';
	if intlevel=0 then saved_line:=saved_line+'<stop> aborts *'
		      else saved_line:=saved_line+'wait auto-abort*' ;
					       { 3.0 bug fix -- 4/12/84 }
	line_needs_restoring := true;
	if menustate=m_none then saved_echo:=keybuffer^.echo
			    else saved_echo:=true;
	menustate := m_none; { 4/12/84 }
	keybuffer^.echo :=false;
      end;
      if timeout_blanked then lmstr:= saved_line
			 else lmstr:= ' ';
      CALL(CRTLLHOOK,CLLDISPLAY,LMSTR,' ');
      timeout_blanked:= (timeout_counter mod 4)<>0;

      if timeout_counter<=1 then bep;
      timeout_counter := timeout_counter+1;
      if timeout_counter>=timeouts_per_beep then
	if intlevel=0 then timeout_counter := 0
	else
	  begin
	    bep;
	    restore_line;
	    ioresc(ztimeout);
	  end; {else}

    end;  {inform_operator}

$page$

  begin {wrtchar}
    try
      with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^  do
	repeat
	  try
	    previous_hs_completed := false;
	    if not channel_is_setup then
	      begin
		case card_type of
		  hpib_card:
		    begin
		      call(iod_send, io_tmp_ptr, '?');
		      previous_hs_completed := true;
		      timeout := current_timeout;
		      call(iod_send, io_tmp_ptr, chr(TAGbase+addressed));
		      call(iod_send, io_tmp_ptr, chr(LAGbase+bus_address));
		    end; {hpib_card}
		  serial_card:
		    if card_id=hp98626 then  {always set full duplex modem HS}
		      call(iod_wtc, io_tmp_ptr, 13, 1);
		  pllel_card:                                   {12/89 dew - added pllel}
		    begin
		      timeout := current_timeout;
		      call(iod_wtc, io_tmp_ptr, 24, 4); {write verify}
		    end;
		  otherwise
		    {do nothing};
		end; {case}
		channel_is_setup := true;
	      end; {if}
	    call(iod_wtb, io_tmp_ptr, character);
	    previous_char_ptr^ := character;
	    timeout := current_timeout;
	    if last_char then
	      if card_type=hpib_card then
		call(iod_send, io_tmp_ptr, '?');
	    if previously_timed_out then
	      if not writing_previous_char then
		begin
		  restore_line;
		  current_timeout := user_spec_timeout;
		  previously_timed_out := false;
		end; {if}
	    hs_successfully_initiated := true;
	  recover
	    begin
	      reset_card_and_confirm_timeout;
	      channel_is_setup := false;
	      inform_operator;
	      previously_timed_out := true;
	      current_timeout := repeating_timeout;
	      if not (writing_previous_char or previous_hs_completed) then
		begin
		  writing_previous_char := true;
		  wrtchar(previous_char_ptr^, false);
		  writing_previous_char := false;
		end; {if}
	      hs_successfully_initiated := false;
	    end; {recover}
	until hs_successfully_initiated;
    recover
      begin
	restore_line;   { 4/12/84 }
	escape(escapecode);
      end; {recover}
  end; {wrtchar}
$page$

  begin  {prtio}
    ioresult := ord(inoerror);                                 { scs 1/17/83 }
    with unitable^[fp^.funit] do
      begin
	select_code := sc;
	sc_table_entry_ptr := addr(isc_table[select_code]);
	bus_address := ba;
	previous_char_ptr := addr(dvrtemp);
	user_spec_timeout := devid;  {user-specified in CTABLE}
      end; {with}

    buf := addr(buffer);
    channel_is_setup := false;
    current_timeout := user_spec_timeout;
    previously_timed_out  := false;
    writing_previous_char := false;
    line_needs_restoring  := false; { 4/12/84 }

    try
      with sc_table_entry_ptr^, io_tmp_ptr^  do
	begin
	  if card_type=no_card then ioresc(znodevice);
	  while (in_bufptr<>nil) or (out_bufptr<>nil) do {nothing};
	end; {with}

      case request of
	flush:
	  {do nothing};
	clearunit:
	  clear_unit;
	writeeol:
	  begin
	    wrtchar(return, false);
	    wrtchar(linefeed, true)
	  end;
	writebytes:
	  while length>0 do
	    begin
	      wrtchar(buf^, length=1);
	      buf := addr(buf^, 1);
	      length := length-1;
	    end;
	otherwise
	  ioresc(zbadmode);
      end; {case}
    recover
      if (escapecode=-20) and previously_timed_out then
	ioresult := ord(ztimeout)
      else if escapecode<>-10 then
	escape(escapecode);

  end; {prtio}

end. {prtdvr}

@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


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


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


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

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


	    RESTRICTED RIGHTS LEGEND

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

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$modcal$
$debug off, range off, ovflcheck off$
$stackcheck off, iocheck off$

{{
$search 'KERNEL'$
{}
$search 'IOLIB:KERNEL','OSFS:SYSDEVS'$
{}

$page$
$copyright 'COPYRIGHT (C) 1984 BY HEWLETT-PACKARD COMPANY'$


module prtdvr;

import
  sysglobals,
  iodeclarations,
  asm, sysdevs, mini, misc, fs;

export
  procedure prtio (fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
implement  {prtdvr}

procedure bep;
  begin write(bellchar); end;

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

const
  uclr_timeout_const = 25;      {HPIB commands during unitclear}

  repeating_timeout  = 333;     {timeout constant after initial timeout}
  timeouts_per_beep  = 40;      {beep period in repeating timeout units}

  SDC      = 4;         {selective device clear}
  LAGbase  = 32;        {listen address group base}
  TAGbase  = 64;        {talk address group base}

  linefeed = chr(10);   {ASCII linefeed}
  formfeed = chr(12);   {ASCII formfeed}
  return   = chr(13);   {ASCII carriage return}

var

  select_code: type_isc;
  sc_table_entry_ptr: ^isc_table_type;
  previous_char_ptr: charptr;
  bus_address: byte;

  channel_is_setup: boolean;
  writing_previous_char: boolean;
  previously_timed_out: boolean;
  timeout_blanked: boolean;
  user_spec_timeout: integer;
  current_timeout: integer;
  timeout_counter: shortint;
  saved_line     : string[42];          { 3.0 bug fix -- 4/12/84 }
  line_needs_restoring : boolean;       { 4/12/84 }
  buf: charptr;
  saved_echo: boolean;                  { 5/9/84 }

$page$

procedure reset_card_and_confirm_timeout;
  var
    saved_escapecode: shortint;
    saved_ioe_sc: integer;
    saved_ioe_result: integer;
  begin {reset_card_and_confirm_timeout}
    saved_escapecode := escapecode;
    saved_ioe_sc := ioe_isc;
    saved_ioe_result := ioe_result;
    try
      with sc_table_entry_ptr^ do
	call(io_drv_ptr^.iod_init, io_tmp_ptr);
    recover
      if (escapecode<>ioescapecode) or (ioe_isc<>select_code) then
	escape(escapecode);
    ioe_isc := saved_ioe_sc;
    ioe_result := saved_ioe_result;
    if (saved_escapecode<>ioescapecode) or (ioe_isc<>select_code) then
      escape(saved_escapecode);
    if ioe_result<>ioe_timeout then
      ioresc(znodevice);
  end; {reset_card_and_confirm_timeout}

procedure clear_unit;
var w:io_word;
  procedure HPIBsdc;
    begin {HPIBsdc}
      with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^ do
	begin
	  call(iod_send, io_tmp_ptr, '?');
	  timeout := uclr_timeout_const;
	  call(iod_send, io_tmp_ptr, chr(LAGbase+bus_address));
	  call(iod_send, io_tmp_ptr, chr(SDC));
	end; {with}
    end; {HPIBsdc}
  begin {clear_unit}
    with sc_table_entry_ptr^ do
      if card_type=hpib_card then
	try
	  HPIBsdc;         {first attempt}
	recover
	  begin
	    reset_card_and_confirm_timeout;
	    try
	      HPIBsdc;       {second attempt}
	    recover
	      begin
		reset_card_and_confirm_timeout;
		ioresc(ztimeout);
	      end; {recover}
	  end {recover}
      else if card_type = serial_card then                      {12/89 dew - added pllel}
	try
	  call(io_drv_ptr^.iod_init, io_tmp_ptr);
	recover
	  if (escapecode<>ioescapecode) or (ioe_isc<>select_code) then escape(escapecode)
	  else ioresc(znodevice)
      else {parallel_card}                                      {12/89 dew - added pllel}
	try
	  io_tmp_ptr^.timeout := current_timeout;
	  call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 21, 0);  {set the reset type to not present}
	  call(io_drv_ptr^.iod_init, io_tmp_ptr);        {reset driver}
	  call(io_drv_ptr^.iod_rds, io_tmp_ptr, 20, w);  {get peripheral type}
	  if w = 1 then {OUTPUT_ONLY}
	  begin
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 20, 11); {set current type to user_spec_output_only}
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 21, 11); {set the reset type to same}
	  end
	  else {not a printer there}
		ioresc(znodevice);
	recover
	  begin
	    reset_card_and_confirm_timeout;
	    ioresc(ztimeout);
	  end; {recover}
  end; {clear_unit}

$page$

procedure wrtchar(character: char; last_char: boolean);

  var
    hs_successfully_initiated: boolean;
    previous_hs_completed    : boolean;


  procedure restore_line;
  var dummyc:char;
  begin
    if line_needs_restoring then { 4/12/84 }
    begin
      keybuffer^.echo:=saved_echo;
      keybufops(kdisplay,dummyc);
      line_needs_restoring:=false;
    end;
  end;

$page$

  procedure inform_operator;
  var lmstr : string[42];                      { 3.0 bug fix -- 4/12/84 }
    begin  {inform_operator}

      if not previously_timed_out then
      begin
	timeout_blanked := true;
	timeout_counter := 0;
      end;
      if not line_needs_restoring then
      begin
	saved_line := '* Printer timeout: fix or ';
	if intlevel=0 then saved_line:=saved_line+'<stop> aborts *'
		      else saved_line:=saved_line+'wait auto-abort*' ;
					       { 3.0 bug fix -- 4/12/84 }
	line_needs_restoring := true;
	if menustate=m_none then saved_echo:=keybuffer^.echo
			    else saved_echo:=true;
	menustate := m_none; { 4/12/84 }
	keybuffer^.echo :=false;
      end;
      if timeout_blanked then lmstr:= saved_line
			 else lmstr:= ' ';
      CALL(CRTLLHOOK,CLLDISPLAY,LMSTR,' ');
      timeout_blanked:= (timeout_counter mod 4)<>0;

      if timeout_counter<=1 then bep;
      timeout_counter := timeout_counter+1;
      if timeout_counter>=timeouts_per_beep then
	if intlevel=0 then timeout_counter := 0
	else
	  begin
	    bep;
	    restore_line;
	    ioresc(ztimeout);
	  end; {else}

    end;  {inform_operator}

$page$

  begin {wrtchar}
    try
      with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^  do
	repeat
	  try
	    previous_hs_completed := false;
	    if not channel_is_setup then
	      begin
		case card_type of
		  hpib_card:
		    begin
		      call(iod_send, io_tmp_ptr, '?');
		      previous_hs_completed := true;
		      timeout := current_timeout;
		      call(iod_send, io_tmp_ptr, chr(TAGbase+addressed));
		      call(iod_send, io_tmp_ptr, chr(LAGbase+bus_address));
		    end; {hpib_card}
		  serial_card:
		    if card_id=hp98626 then  {always set full duplex modem HS}
		      call(iod_wtc, io_tmp_ptr, 13, 1);
		  pllel_card:                                   {12/89 dew - added pllel}
		    begin
		      timeout := current_timeout;
		      call(iod_wtc, io_tmp_ptr, 24, 4); {write verify}
		    end;
		  otherwise
		    {do nothing};
		end; {case}
		channel_is_setup := true;
	      end; {if}
	    call(iod_wtb, io_tmp_ptr, character);
	    previous_char_ptr^ := character;
	    timeout := current_timeout;
	    if last_char then
	      if card_type=hpib_card then
		call(iod_send, io_tmp_ptr, '?');
	    if previously_timed_out then
	      if not writing_previous_char then
		begin
		  restore_line;
		  current_timeout := user_spec_timeout;
		  previously_timed_out := false;
		end; {if}
	    hs_successfully_initiated := true;
	  recover
	    begin
	      reset_card_and_confirm_timeout;
	      channel_is_setup := false;
	      inform_operator;
	      previously_timed_out := true;
	      current_timeout := repeating_timeout;
	      if not (writing_previous_char or previous_hs_completed) then
		begin
		  writing_previous_char := true;
		  wrtchar(previous_char_ptr^, false);
		  writing_previous_char := false;
		end; {if}
	      hs_successfully_initiated := false;
	    end; {recover}
	until hs_successfully_initiated;
    recover
      begin
	restore_line;   { 4/12/84 }
	escape(escapecode);
      end; {recover}
  end; {wrtchar}
$page$

  begin  {prtio}
    ioresult := ord(inoerror);                                 { scs 1/17/83 }
    with unitable^[fp^.funit] do
      begin
	select_code := sc;
	sc_table_entry_ptr := addr(isc_table[select_code]);
	bus_address := ba;
	previous_char_ptr := addr(dvrtemp);
	user_spec_timeout := devid;  {user-specified in CTABLE}
      end; {with}

    buf := addr(buffer);
    channel_is_setup := false;
    current_timeout := user_spec_timeout;
    previously_timed_out  := false;
    writing_previous_char := false;
    line_needs_restoring  := false; { 4/12/84 }

    try
      with sc_table_entry_ptr^, io_tmp_ptr^  do
	begin
	  if card_type=no_card then ioresc(znodevice);
	  while (in_bufptr<>nil) or (out_bufptr<>nil) do {nothing};
	end; {with}

      case request of
	flush:
	  {do nothing};
	clearunit:
	  clear_unit;
	writeeol:
	  begin
	    wrtchar(return, false);
	    wrtchar(linefeed, true)
	  end;
	writebytes:
	  while length>0 do
	    begin
	      wrtchar(buf^, length=1);
	      buf := addr(buf^, 1);
	      length := length-1;
	    end;
	otherwise
	  ioresc(zbadmode);
      end; {case}
    recover
      if (escapecode=-20) and previously_timed_out then
	ioresult := ord(ztimeout)
      else if escapecode<>-10 then
	escape(escapecode);

  end; {prtio}

end. {prtdvr}

@


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.2
log
@
Fixed PRINTER to work with devices that have long reset times, such
as IBM compatible printers.
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@d113 1
d148 11
a158 3
	  io_tmp_ptr^.timeout := uclr_timeout_const;
	  call(io_drv_ptr^.iod_init, io_tmp_ptr);
	  call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 22, 0); {reset peripheral}
d250 4
a253 1
		    call(iod_wtc, io_tmp_ptr, 24, 4); {write verify}
@


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.2
log
@Added support for the PARALLEL interface.
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d26 3
d30 1
d139 1
a139 1
      else
d144 11
a154 1
	  else ioresc(znodevice);
d240 2
@


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.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
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
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
