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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

38.1
date     89.08.29.11.28.43;  author jwh;  state Exp;
branches ;
next     37.2;

37.2
date     89.08.23.14.33.32;  author jwh;  state Exp;
branches ;
next     37.1;

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

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

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

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

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

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

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

30.1
date     88.12.09.13.48.04;  author dew;  state Exp;
branches ;
next     29.3;

29.3
date     88.12.09.10.23.44;  author dew;  state Exp;
branches ;
next     29.2;

29.2
date     88.12.09.10.22.40;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.33.04;  author bayes;  state Exp;
branches ;
next     1.2;

1.2
date     88.10.31.10.55.55;  author bayes;  state Exp;
branches ;
next     1.1;

1.1
date     88.10.27.10.45.11;  author dew;  state Exp;
branches ;
next     ;


desc
@Driver support for multiplexed I/O.
@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@$MODCAL$
PROGRAM IOMPX_PROG(INPUT,OUTPUT);
$DEBUG OFF$ $RANGE OFF$ $STACKCHECK OFF$ $OVFLCHECK OFF$
{ Bug fix/Changes history
  3.22c
    .added compiler optimization directives
    .changed IOMPX_INIT to return TRUE only if it allocated space
    .inverted sense of boolean arg on OPS_PROC call
}

MODULE IOMPX;
$SEARCH 'IOLIB:KERNEL.CODE'$
IMPORT IODECLARATIONS,ASM;
EXPORT
  function iompx_init(var ehp:anyptr):boolean;
IMPLEMENT
$INCLUDE 'IOLIB:IOMPXDECS.TEXT'$
$LINENUM 4000$
type
  cp = ^char;
var
  iompx_info : iompx_info_ptr;
  old_errlink: errlnk_type;

  procedure register_buffer(device        : type_device;
			    t_dir         : dir_of_tfr;
			    VAR b_info    : buf_info_type;
			    VAR reg_rec   : iompx_rec;          { registration record }
			    front         : boolean;            { register first or last }
			    user_temps    : anyptr;
			    operations    : io_proc_vb);
    var
      old_level : integer;
      bhead,
      btail     : ^iompx_rec_ptr;
      sc        : type_isc;
    begin
      if device>iomaxisc then sc := device div 100
			 else sc := device;
      if isc_table[sc].io_tmp_ptr=nil then
	 io_escape(ioe_no_driver,sc);

      with iompx_info^.isc_iompx_table[sc] do
	if not capable then io_escape(ioe_no_driver,sc)
	else
	if t_dir = to_memory then
	begin
	  bhead := addr(checkers);
	  btail:= addr(ctail);
	end
	else
	begin
	  bhead := addr(wrappers);
	  btail:= addr(wtail);
	end;

      with reg_rec do
      begin
	user_buffer := addr(b_info);
	user_area   := user_temps;
	scode       := sc;
	in_buffer   := nil;
	ops_proc := operations;
      end;

      old_level := intlevel;
      setintlevel(6);
	{ head insertion or empty list }
	if front or (bhead^=nil) then
	begin
	  reg_rec.next := bhead^;
	  bhead^ := addr(reg_rec);
	  if btail^=nil then btail^ := bhead^;
	end
	else
	begin { tail insertion into non empty list }
	  reg_rec.next := nil;
	  btail^^.next  := addr(reg_rec);
	  btail^ := addr(reg_rec);
	end;
      setintlevel(old_level);
    end; { register_buffer }

  procedure unregister_buffer(device      : type_device;
			      t_dir       : dir_of_tfr;
			      VAR b_info  : buf_info_type);
    label 1;
    var
      io_isc : type_isc;
      old_level : integer;
      back, now : iompx_rec_ptr;
      bhead,
      btail     : ^iompx_rec_ptr;
      sc        : type_isc;
    begin
      if device>iomaxisc then sc := device div 100
			 else sc := device;
      if isc_table[sc].io_tmp_ptr=nil then
	 io_escape(ioe_no_driver,sc);

      with iompx_info^.isc_iompx_table[sc] do
	if t_dir = to_memory then
	begin
	  bhead := addr(checkers);
	  btail:= addr(ctail);
	end
	else
	begin
	  bhead := addr(wrappers);
	  btail:= addr(wtail);
	end;
      back := nil;

      old_level := intlevel;
      setintlevel(6);

      now := bhead^;
      while now <> nil do
      begin
	if now^.user_buffer = addr(b_info) then
	begin
	  if back=nil then bhead^ := now^.next
		      else back^.next := now^.next;
	  if now=btail^ then btail^ := back;
	  goto 1;
	end
	else
	begin
	  back := now; now := now^.next;
	end;
      end;
     1:
      setintlevel(old_level);
    end; { unregister_buffer }

 procedure copy_buffer_data(var src,dest  : buf_info_type;
				move : integer);
    var
      size : integer;
    begin
      size := src.term_count;
      if move>size then move := size;
      if move>dest.term_count then move := dest.term_count;
      moveleft(cp(src.buf_empty)^,cp(dest.buf_fill)^,move);
      src.term_count := src.term_count - move;
      src.buf_empty := ADDR(cp(src.buf_empty)^,move);
      dest.term_count := move;
      dest.buf_fill := ADDR(cp(dest.buf_fill)^,move);
    end; { copy_buffer_data }

  procedure scanner(working    : BUFxINFOxPTR;
		    VAR target : BUFxINFOxPTR);
    var
      sc     : type_isc;
      regp,
      nxtp   : iompx_rec_ptr;
      reject : boolean;
      size   : integer;
    begin
      target := nil;
      sc := working^.active_isc;
      regp := iompx_info^.isc_iompx_table[sc].checkers;
      while regp<>nil do
      begin
	with regp^ do
	begin
	  nxtp        := next;  { chain now }
	  if user_buffer^.active_isc=sc then
	  begin
	    in_buffer   := working;
	    call(ops_proc,regp,reject);
	    if not reject then
	    begin
	      regp := nil; target := user_buffer;
	    end;
	  end; { if }
	end; { with }
	if regp<>nil then regp := nxtp;
      end; { while }

      if target=nil then
      with isc_table[sc].io_tmp_ptr^ do
      begin
	if in_bufptr<>nil then
	  if BUFxINFOxPTR(in_bufptr)^.active_isc<>no_isc then
	  begin
	    target := in_bufptr;
	    copy_buffer_data(working^,target^,working^.term_count);
	  end;
      end;
    end; { scanner }


  procedure find_registered_buf(device     : type_device;
				t_dir      : dir_of_tfr;
				VAR b_info : buf_info_type;
				VAR reg_rec: iompx_rec_ptr);
    label 1;
    var
      sc : type_isc;
    begin
      if device>iomaxisc then sc := device div 100
			 else sc := device;
      if t_dir=from_memory then
	reg_rec := iompx_info^.isc_iompx_table[sc].wrappers
      else
	reg_rec := iompx_info^.isc_iompx_table[sc].checkers;

      while reg_rec<>nil do
      with reg_rec^ do
      begin
	if user_buffer = ADDR(b_info) then goto 1;
	reg_rec := next;
      end;
     1:
    end; { find_registered_buf }

  procedure iompxerr(errorcode : integer;
		     VAR s     : io_string);
    var
      spp : iompx_ans_ptr;
    begin
      if errorcode <> iompx_request then
	call(old_errlink,errorcode,s)
      else
      begin
	s   := iompx_answer;
	spp := addr(s);
	spp^.ptr:= iompx_info;
      end;
    end; { iompxerr }

  function iompx_init(var ehp:anyptr):boolean;
    var i : integer;
    begin
      iompx_init := iompx_info=nil;
      if iompx_info=nil then
      begin
	mark(iompx_info);
	if ord(iompx_info)<ord(ehp) then release(ehp);

	new(iompx_info);
	with iompx_info^ do
	begin
	  for i := minrealisc to maxrealisc do
	  with isc_iompx_table[i] do
	  begin
	    wrappers := nil; wtail := nil;
	    checkers := nil; ctail := nil;
	    capable  := false; { default }
	  end;

	  register_iompx_buf   := register_buffer;
	  unregister_iompx_buf := unregister_buffer;
	  iompx_scanner        := scanner;
	  find_iompx_buf       := find_registered_buf;
	end;
	old_errlink:= io_error_link;
	io_error_link := iompxerr;
      end;
    end; {iompx_init}

END; { MODULE iompx }

IMPORT IOMPX, LOADER;
BEGIN
  if iompx_init(eheap) then markuser;
END. { iompx_BODY }

@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 269
$MODCAL$
PROGRAM IOMPX_PROG(INPUT,OUTPUT);
$DEBUG OFF$ $RANGE OFF$ $STACKCHECK OFF$ $OVFLCHECK OFF$
{ Bug fix/Changes history
  3.22c
    .added compiler optimization directives
    .changed IOMPX_INIT to return TRUE only if it allocated space
    .inverted sense of boolean arg on OPS_PROC call
}

MODULE IOMPX;
$SEARCH 'IOLIB:KERNEL.CODE'$
IMPORT IODECLARATIONS,ASM;
EXPORT
  function iompx_init(var ehp:anyptr):boolean;
IMPLEMENT
$INCLUDE 'IOLIB:IOMPXDECS.TEXT'$
$LINENUM 4000$
type
  cp = ^char;
var
  iompx_info : iompx_info_ptr;
  old_errlink: errlnk_type;

  procedure register_buffer(device        : type_device;
			    t_dir         : dir_of_tfr;
			    VAR b_info    : buf_info_type;
			    VAR reg_rec   : iompx_rec;          { registration record }
			    front         : boolean;            { register first or last }
			    user_temps    : anyptr;
			    operations    : io_proc_vb);
    var
      old_level : integer;
      bhead,
      btail     : ^iompx_rec_ptr;
      sc        : type_isc;
    begin
      if device>iomaxisc then sc := device div 100
			 else sc := device;
      if isc_table[sc].io_tmp_ptr=nil then
	 io_escape(ioe_no_driver,sc);

      with iompx_info^.isc_iompx_table[sc] do
	if not capable then io_escape(ioe_no_driver,sc)
	else
	if t_dir = to_memory then
	begin
	  bhead := addr(checkers);
	  btail:= addr(ctail);
	end
	else
	begin
	  bhead := addr(wrappers);
	  btail:= addr(wtail);
	end;

      with reg_rec do
      begin
	user_buffer := addr(b_info);
	user_area   := user_temps;
	scode       := sc;
	in_buffer   := nil;
	ops_proc := operations;
      end;

      old_level := intlevel;
      setintlevel(6);
	{ head insertion or empty list }
	if front or (bhead^=nil) then
	begin
	  reg_rec.next := bhead^;
	  bhead^ := addr(reg_rec);
	  if btail^=nil then btail^ := bhead^;
	end
	else
	begin { tail insertion into non empty list }
	  reg_rec.next := nil;
	  btail^^.next  := addr(reg_rec);
	  btail^ := addr(reg_rec);
	end;
      setintlevel(old_level);
    end; { register_buffer }

  procedure unregister_buffer(device      : type_device;
			      t_dir       : dir_of_tfr;
			      VAR b_info  : buf_info_type);
    label 1;
    var
      io_isc : type_isc;
      old_level : integer;
      back, now : iompx_rec_ptr;
      bhead,
      btail     : ^iompx_rec_ptr;
      sc        : type_isc;
    begin
      if device>iomaxisc then sc := device div 100
			 else sc := device;
      if isc_table[sc].io_tmp_ptr=nil then
	 io_escape(ioe_no_driver,sc);

      with iompx_info^.isc_iompx_table[sc] do
	if t_dir = to_memory then
	begin
	  bhead := addr(checkers);
	  btail:= addr(ctail);
	end
	else
	begin
	  bhead := addr(wrappers);
	  btail:= addr(wtail);
	end;
      back := nil;

      old_level := intlevel;
      setintlevel(6);

      now := bhead^;
      while now <> nil do
      begin
	if now^.user_buffer = addr(b_info) then
	begin
	  if back=nil then bhead^ := now^.next
		      else back^.next := now^.next;
	  if now=btail^ then btail^ := back;
	  goto 1;
	end
	else
	begin
	  back := now; now := now^.next;
	end;
      end;
     1:
      setintlevel(old_level);
    end; { unregister_buffer }

 procedure copy_buffer_data(var src,dest  : buf_info_type;
				move : integer);
    var
      size : integer;
    begin
      size := src.term_count;
      if move>size then move := size;
      if move>dest.term_count then move := dest.term_count;
      moveleft(cp(src.buf_empty)^,cp(dest.buf_fill)^,move);
      src.term_count := src.term_count - move;
      src.buf_empty := ADDR(cp(src.buf_empty)^,move);
      dest.term_count := move;
      dest.buf_fill := ADDR(cp(dest.buf_fill)^,move);
    end; { copy_buffer_data }

  procedure scanner(working    : BUFxINFOxPTR;
		    VAR target : BUFxINFOxPTR);
    var
      sc     : type_isc;
      regp,
      nxtp   : iompx_rec_ptr;
      reject : boolean;
      size   : integer;
    begin
      target := nil;
      sc := working^.active_isc;
      regp := iompx_info^.isc_iompx_table[sc].checkers;
      while regp<>nil do
      begin
	with regp^ do
	begin
	  nxtp        := next;  { chain now }
	  if user_buffer^.active_isc=sc then
	  begin
	    in_buffer   := working;
	    call(ops_proc,regp,reject);
	    if not reject then
	    begin
	      regp := nil; target := user_buffer;
	    end;
	  end; { if }
	end; { with }
	if regp<>nil then regp := nxtp;
      end; { while }

      if target=nil then
      with isc_table[sc].io_tmp_ptr^ do
      begin
	if in_bufptr<>nil then
	  if BUFxINFOxPTR(in_bufptr)^.active_isc<>no_isc then
	  begin
	    target := in_bufptr;
	    copy_buffer_data(working^,target^,working^.term_count);
	  end;
      end;
    end; { scanner }


  procedure find_registered_buf(device     : type_device;
				t_dir      : dir_of_tfr;
				VAR b_info : buf_info_type;
				VAR reg_rec: iompx_rec_ptr);
    label 1;
    var
      sc : type_isc;
    begin
      if device>iomaxisc then sc := device div 100
			 else sc := device;
      if t_dir=from_memory then
	reg_rec := iompx_info^.isc_iompx_table[sc].wrappers
      else
	reg_rec := iompx_info^.isc_iompx_table[sc].checkers;

      while reg_rec<>nil do
      with reg_rec^ do
      begin
	if user_buffer = ADDR(b_info) then goto 1;
	reg_rec := next;
      end;
     1:
    end; { find_registered_buf }

  procedure iompxerr(errorcode : integer;
		     VAR s     : io_string);
    var
      spp : iompx_ans_ptr;
    begin
      if errorcode <> iompx_request then
	call(old_errlink,errorcode,s)
      else
      begin
	s   := iompx_answer;
	spp := addr(s);
	spp^.ptr:= iompx_info;
      end;
    end; { iompxerr }

  function iompx_init(var ehp:anyptr):boolean;
    var i : integer;
    begin
      iompx_init := iompx_info=nil;
      if iompx_info=nil then
      begin
	mark(iompx_info);
	if ord(iompx_info)<ord(ehp) then release(ehp);

	new(iompx_info);
	with iompx_info^ do
	begin
	  for i := minrealisc to maxrealisc do
	  with isc_iompx_table[i] do
	  begin
	    wrappers := nil; wtail := nil;
	    checkers := nil; ctail := nil;
	    capable  := false; { default }
	  end;

	  register_iompx_buf   := register_buffer;
	  unregister_iompx_buf := unregister_buffer;
	  iompx_scanner        := scanner;
	  find_iompx_buf       := find_registered_buf;
	end;
	old_errlink:= io_error_link;
	io_error_link := iompxerr;
      end;
    end; {iompx_init}

END; { MODULE iompx }

IMPORT IOMPX, LOADER;
BEGIN
  if iompx_init(eheap) then markuser;
END. { iompx_BODY }

@


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


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


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


37.2
log
@SRM-UX changes.
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d17 1
a17 1
$INCLUDE 'IOMPXDECS.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.3
log
@
pws2rcs automatic delta on Thu Dec  8 15:31:09 MST 1988
Actually, just a search directive was changed.

(This was done because of the newci/ci massive diff problem).
@
text
@@


29.2
log
@
bug fixes to register & unregister
change to scanner args, see comments in file
QUIST

(This was done because of the newci/ci massive diff problems).
@
text
@d12 1
a12 1
{$SEARCH 'IOLIB:KERNEL.CODE'$}
@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@a1 2
$DEBUG OFF$
$LINENUM 1000$
d3 7
d12 1
a12 1
$SEARCH 'IOLIB:KERNEL.CODE'$
d15 1
a15 1
   function iompx_init:boolean;
d18 3
d49 1
a49 1
	  btail:= addr(dtail);
d105 1
a105 1
	  btail:= addr(dtail);
d122 1
a122 1
	  if back=nil then bhead^ := now
a124 1
	  if btail^=nil then bhead^ := nil;
d136 15
a152 2
    type
      cp = ^char;
d157 1
a157 1
      wantit : boolean;
a165 1
	if user_buffer^.active_isc=sc then
a166 1
	  in_buffer   := working;
d168 1
a168 2
	  call(ops_proc,regp,wantit);
	  if wantit then
d170 8
a177 3
	    regp := nil; target := user_buffer;
	  end;
	end;
d179 1
a179 1
      end;
d188 1
a188 8
	    with target^ do
	    begin
	      size := working^.term_count;
	      if term_count<size then size := term_count;
	      moveleft(cp(working^.buf_empty)^,cp(buf_fill)^,size);
	      buf_fill := ADDR(cp(buf_fill)^,size);
	      term_count := size;
	    end;
d193 1
d233 1
a233 1
  function iompx_init:boolean;
d239 3
d249 1
a249 1
	    checkers := nil; dtail := nil;
a260 1
      iompx_init := true;
d267 1
a267 1
  if iompx_init then markuser;
@


1.2
log
@
ipws2rcs automatic delta on Mon Oct 31 10:34:17 MST 1988
:w
:q
@
text
@@


1.1
log
@Initial revision
@
text
@d7 1
@
