⟦7c47363f5⟧

TextFileVerbose

job oer 9 200 time 11 0 size 100000 area 10
( mode list.yes
source = copy 25.1
o c
tslamlst=set 1 disc1
if ok.yes
(message lam116 compile
o lam116err
pascal80 codesize.8000 alarmenv source;
o c
lookup pass6code
if ok.yes
( tslambin=set 1 disc1
tslambin= move pass6code
scope user tslambin
message lam116 ok
)
liste=indent source lc mark
lst=cross liste
tslamlst = copy lst lam116err
scope user tslamlst
message lam116 liste
)
finis )
\f


process lam(
opsem: sempointer;
pu: integer;
level:integer;
var mainsem: !ts_pointer
);

(*********************************************************
*                                                        *
*   lam-driver                                           *
*   programmed by oer                                    *
**********************************************************)

(*-------------------------------------------------------
. terms
.
. port     refers to a port on the physical lam
. channel  refers to a channel in the lamdriver
.          where there are two channels for each port
.          i e one for output and one for input
.
.--------------------------------------------------------*)

const

version = "vers  2.10 /";

max_port_no=15;
max_channel_no= 2*max_port_no+1;

(*---  values used when creating high level lam-driver ---*)
mask = 0;
      prio  = 0;
      store = 200;
(*--- number of lambuffers, one is used as channelmessage ---*)
no_of_lambufs = 11;

ttylength = 80;           (*  num of bytes in tty text          *)
it_buf_length = 80;
ttysize = 3+ttylength div 2;     (*  size of tty message with 80 bytes   *)
itsize= (it_buf_length+1) div 2;

long_time = 10;
normal_time = 7;
short_time = 4;
no_time = 1;

forever = false;


(*       controlebits to lam *)
requesttosend = 7*32;
readytoread = 5*32;

(*       statuswords from lam *)
write_read_ok = 40;
overrun=41;
parity=44;
overrun_and_parity=45;
readytosend = 24;
\f


(*---  channelkinds  ---*)

not_created = 0;
at_write_channel = 1;
at_write_wait = 2;
at_read_channel = 3;
at_read_wait = 4;
it_write_channel = 5;
it_read_channel = 6;
tty_write_channel = 7;
tty_read_channel = 8;
echo_nl_on_channel = 9;
tty_wait_cr = 10;
tty_wait_nl = 11;
tty_wait_input = 12;


(*---  delays used on at-channels  ---*)

rts_delay_u3 = 10;
rts_delay_u4 = 5;

rtr_delay_u3 = 13;
rtr_delay_u4 = 5;


(*---  byte-compatible values for special characters  ---*)

bs = 8;
nl = 10;
cr = 13;
cs = 19;       (*  crtl + small s   *)
esc = 27;
sp = 32;
del = 127;
\f



(*  result codes  *)
(*  specified in u2 overwriting portno *)
(*  other resultcodes are given in alarmenv *)

transient_error = transi_err;
persistent_error = persi_err;
illegal_function = ill_func;
write_error = transient_error;
write_read_mixed = create_done;
buffer_too_small = illegal_function;
go_on_read = 6▶07◀;

(****************************************
*
*  params that should be used in create channel
*
*  +0  odd parity
*      1 stop element
*      5 databits/char
*      110 bps
*  +1  no parity
*  +2  even parity
*  +3  no parity
*  +4  2 stop elements
*  +8  6 databits
*  +16 7 databits
*  +24 8 databits
*  +32 300 bps
*  +64 600 bps
*  +96 1200 bps
*
****************************************)
\f


type
(*      no of input+output devices on one lam-driver *)
channelset   = 0..max_channel_no;

portset = 0..max_port_no;

(*      format of a buffer send to/from a vcit *)
itbuffer
= array(0..it_buf_length-1) of byte;
(*      format of a buffer send to/from a vcat or at *)
atbuffer
= array(0..1)   of byte;

ttybuffer
= packed record                   (*  for tty      *)
first, last, nextfree : integer;
text : array (1..ttylength) of byte
end;

(*      one word to write in writeword *)

lamword
= packed record
data : byte;
std : 0..7;
port_and_bit15 : channelset;
end;

(*      one description for each device *)

channelrecord
= record
request:reference;           (*  current message     *)
channel_kind : 0..15;
old_result : 0..15;
interruptable : boolean;
reading_tty : boolean;
checksum: integer;
timeout,
next,
top: integer;
end;
\f


var
(*        ref for channelmsg *)
  channelmessage,ref:   reference;
(*        shadow for lam at high level *)
      driver:    shadow;

lamsem : semaphore;
(*---  pools  ---*)

delaypool : pool 16;
      timerpool: pool 1;
(*        buffers for handling interrupts *) 
      lampool:   pool no_of_lambufs;

(*        devicenumber *)
      channel_no:     integer;
(*        zone used by testopen and testout *)
      opzone:    zone;
(*        all devicedescriptors in one array *)

      channel_descriptor:  array(channelset) of channelrecord;

queue : array(channelset) of semaphore;

(*        timeoutperiode and controlword for each device *)
      time,controle_byte: array(portset)of byte;

i : integer;
test_b : boolean;
read_checksum : integer;
\f


(***************   externals   ***********************************)

function  copychm(var x,y: reference): integer; external;
(* makes a copy of a channelmessage *)

procedure testopen(var x:zone; y:alfa; z:^semaphore); external; 
(* opens testmode *)

 procedure testout(var x:zone; y:alfa; z:integer); external; 
(* writes text for test *)

procedure control( x: integer; var y: reference); external;
(* writes one controlword *)

procedure outword( x: lamword; var y: reference); external;
(* writes one word *)


procedure sense(var x:integer; y:integer; var z:reference); external;


(***************   procedures  ***********************************)

procedure stop_actual_request
 ( result: byte;  channel_no: channelset );
forward;


\f


procedure start_rts_delay(channel_no : integer);
(*********************************************
*   rts-delay                                *
**********************************************)

var ref:reference;
begin
alloc(ref, delaypool, mainsem.s^);
ref^.u3 := rts_delay_u3;
ref^.u4 := rts_delay_u4;
ref^.u1 := channel_no*2;
(*q if test_b then
testout( opzone, "rts-delay   ", ref^.u1); q*)
sendtimer(ref);
end;





procedure start_rtr_delay(channel_no : integer);
(*********************************************
*   rtr-delay                                *
**********************************************)

var ref:reference;
begin
alloc(ref, delaypool, mainsem.s^);
ref^.u3:=rtr_delay_u3;
ref^.u4:=rtr_delay_u4;
ref^.u1 :=channel_no*2+1;
(*q if test_b then
testout( opzone, "rtr-delay   ", ref^.u1); q*)
sendtimer(ref);
end;

\f


procedure createchannel( w_kind, r_kind: 0..15 );
(***********************************************
*   createchannel                              *
************************************************)

var i: integer;
begin
i:=ref^.u2;
channel_descriptor(i*2).channel_kind:=w_kind;
channel_descriptor(i*2+1).channel_kind:=r_kind;

lock ref as buf:atbuffer do
begin
controle_byte(i):=buf(0) mod 128;
time(i):=buf(1);
end;

ref^.u2:=ok_result;
return(ref);

(*q if test_b then
begin
testout( opzone, "chn created ", i);
testout( opzone, "controlebyte", controle_byte(i));
end; q*)
end;
\f



(*******************************************************
*   start_next_request                                        *

*   initializes   next,  top,  and  timeout  in        *
*                 channeldescriptor(channel_no)             *
*           and   channel if it is used for output     *
*                                                      *
*   called when - not finished with write/read         *
*               - more requests after stop_actual_request
*               - timeout on write                     *
*               - no requests when a new userbuffer    *
*                 is comming                           *
********************************************************)


procedure start_next_request( channel_no:channelset);
var c : integer;
begin
with channel_descriptor(channel_no) do
begin

timeout:= time(channel_no div 2);

(*q if test_b then
begin
testout( opzone,"sta-nxt-req ", channel_no);
testout( opzone,"chn-kind    ",channel_kind);
end; q*)

if channel_kind = at_write_channel then
begin
(*                set up for output  *)
c:=controle_byte(channel_no div 2)*256+requesttosend+channel_no;
control(c,channelmessage);
(*q if test_b then
testout(opzone,"rts-init    ",c); q*)
start_rts_delay(channel_no);
channel_kind := at_write_wait;
end
\f


else
begin
if channel_kind = tty_read_channel then
channel_descriptor(channel_no-1).reading_tty:=true;
interruptable:=true;
end;

if request^.u1 > write_read_it then
begin
lock request as buf: ttybuffer do
begin
next:= buf.nextfree;
top:= buf.last+1;
end;
if ( next<1 ) or ( top>ttylength+1) or ( next>=top) then
stop_actual_request
( illegal_function, channel_no);
end

else
begin
next:=0;
if request^.u1 <= write_read_at then top:=2
else
begin
top:=it_buf_length;
checksum:=0;
end;
end;
end;
end;
\f


(*******************************************************
*   stop_actual_request
                                             *
*   sends answer back to user
*   if we shall go on read the request is send to      *
*   queue at channel_no+1                                  *
********************************************************)

procedure stop_actual_request
( result:byte; channel_no:channelset);

var c : integer;


begin

with channel_descriptor(channel_no) do

case channel_kind of

at_write_channel:
begin
start_rtr_delay(channel_no);
channel_kind := at_read_wait;
old_result := result;
end;

at_read_wait:
begin
c:=controle_byte(channel_no div 2)*256+readytoread+channel_no;
control(c,channelmessage);
channel_kind := at_write_channel;
result:= old_result;
(*q if test_b then
testout( opzone,"rtr-answer  ", c); q*)
end
otherwise;
end;
\f


if channel_descriptor(channel_no).channel_kind <> at_read_wait then
begin

if result = go_on_read then
begin

(*q if test_b then
testout( opzone,"go on read  ", channel_no); q*)

while not nil( channel_descriptor(channel_no+1).request) do
with channel_descriptor(channel_no+1) do
begin
request^.u2:=write_read_mixed;
return(request);
sensesem( request, queue(channel_no+1));
end;
channel_descriptor(channel_no+1).request:=:channel_descriptor(channel_no).request;
start_next_request(channel_no+1);
end
else
begin
channel_descriptor(channel_no).request^.u2:=result;

(*q if test_b then
testout( opzone, "returning   ", channel_no); q*)
return(channel_descriptor(channel_no).request);
end;
\f


with channel_descriptor(channel_no) do
begin
timeout:=0;
       sensesem(request,queue(channel_no));
if channel_kind = tty_read_channel then
begin
if nil(channel_descriptor(channel_no-1).request) then
begin      (*   no writes are waiting  *)
if nil(request) then
channel_descriptor(channel_no-1).reading_tty := false
else
start_next_request( channel_no)
end
else
begin      (*   writes are waiting   *)
channel_descriptor(channel_no-1).reading_tty:=false;
start_next_request(channel_no-1);
end
end
else
if channel_kind = tty_write_channel then
begin
if nil( request) then
begin      (*   no more writes look for reads  *)
if not nil(channel_descriptor(channel_no+1).request) then
start_next_request(channel_no+1)
end
else
start_next_request(channel_no);
end
else
if nil(request) then interruptable:=false
else start_next_request(channel_no);
end;
end;
end;
\f



function packed_word ( databits: byte; channel_no: channelset): lamword;
(********************************************************
*   makes a word ready for outword                      *
*********************************************************)
var   w: lamword;
begin
w.data:= databits;
w.std := 0;
w.port_and_bit15:=channel_no;
 packed_word:= w
end;
\f


procedure start_new_channel(channel_no: channelset);
(********************************************************
*   start_new_channel                                               *
*   called when - channel is created                    *
*               - persistent status error               *
*               - timeout on write or write/read        *
*********************************************************)

var c : integer;
begin
channel_no:=channel_no - channel_no mod 2;
c:= controle_byte(channel_no div 2)*256+channel_no ;
if channel_descriptor(channel_no).channel_kind=at_write_channel then c:=c+readytoread
else c:=c+requesttosend;
control(c,channelmessage);

with channel_descriptor(channel_no) do
while not nil(request) do
stop_actual_request
(create_done, channel_no);

channel_no:= channel_no+1;
with channel_descriptor(channel_no) do
while not nil(request) do
stop_actual_request
(create_done, channel_no);
end;
\f


function ready_to_send( channel_no:channelset):boolean;
(********************************************************
*   ready-to-send                                         *
*********************************************************)

var status : integer;
begin
with channel_descriptor(channel_no) do
begin
sense( status, channel_no, channelmessage);

if status mod 32 div 8 = 3 then
ready_to_send := true
else
ready_to_send:=false
end;
end;
\f


procedure handle_ok_lam_int(data_byte: byte; channel_no: channelset);
(********************************************************
*   handle_ok_lam_int                                             *
*   handles the buffer pointed to by request                *
*                                                       *
*   if it is a writebuffer the byte pointed to by next  *
*   is output                                           *
*                                                       *
*   if it is a readbuffer the data_byte is put into       *
*   the buffer at the byte pointed to by next           *
*                                                       *
*********************************************************)


begin
(*q if test_b then
testout(opzone, "hndl-o-l-int", channel_no); q*)

with channel_descriptor(channel_no) do

case channel_kind of
\f


at_write_channel :

if next >= top then
begin
(*q if test_b then
testout( opzone, "next = top  ", 0); q*)
if request^.u1 = write_read_at then
stop_actual_request
( go_on_read, channel_no)
else stop_actual_request
( ok_result, channel_no);
end
else
begin
if ready_to_send(channel_no) then
lock request as buf:atbuffer do
begin

(*q if test_b then
begin
testout( opzone, "at-w-next   ", next);
testout( opzone, "at-w-ch     ", buf(next)); 
end; q*)

outword( packed_word( buf(next), channel_no), channelmessage);
next:=next+1;
end
else
stop_actual_request
( write_error, channel_no)
end;
\f


at_read_channel :

begin
lock request as buf:atbuffer do
buf(next):=data_byte;
(*q if test_b then
begin
testout( opzone, "at-r-next   ", next);
testout( opzone,"at-r-ch     ", data_byte); 
end; q*)
next:=next+1;
if next >= top then
stop_actual_request
( ok_result, channel_no);
end;
\f


it_read_channel :

begin
lock request as buf:itbuffer do
begin
buf(next):=data_byte;
if next=1 then top:=buf(next)+3;
if next<top-1 then
checksum:=checksum+buf(next);

(*q if test_b then
begin
testout( opzone,"it-r-next   ", next);
testout( opzone,"it-r-ch     ", buf(next));
end; q*)

if next>=top-1 then
begin
read_checksum:=buf(next);
(* buf(next):=0; *)
end;
end;

if next>=top-1 then
if read_checksum<>(checksum mod 256) then
stop_actual_request
( transient_error, channel_no)
else
stop_actual_request
( ok_result, channel_no)
else
next:=next+1;
end;
\f


it_write_channel :

if ready_to_send(channel_no) then
begin
lock request as buf:itbuffer do
begin
outword( packed_word(buf(next), channel_no), channelmessage);

if next=1 then top:=buf(next)+3;
checksum:=checksum+buf(next);

(*q if test_b then
begin
testout( opzone,"it-w-next   ", next);
testout( opzone,"it-w-ch     ", buf(next));
end; q*)

if next=top-2 then buf(top-1):=checksum mod 256;
end;

if next>=top-1 then
if request^.u1=write_read_it then
stop_actual_request
( go_on_read, channel_no)
else
stop_actual_request
( ok_result, channel_no)
else
next:=next+1;
end
else
stop_actual_request
( write_error, channel_no);
\f


tty_read_channel :

begin

(*q if test_b then
begin
testout( opzone,"tty-r-next  ", next);
testout( opzone,"tty-r-ch    ", data_byte);
end; q*)


case data_byte of

esc :
begin
with channel_descriptor( channel_no-1) do
if not reading_tty then
begin
timeout:=0;
channel_kind:=tty_wait_cr;
lock request as buf:ttybuffer do
if next > 1 then
buf.nextfree:=next-1
else
buf.nextfree:=next;
end
else
channel_kind := tty_wait_nl;
outword( packed_word( cr, channel_no), channelmessage);
start_next_request( channel_no);
(*ttestout(opzone,"esc         ",timeout);t*)
end;

cs :
with channel_descriptor(channel_no-1) do
if not reading_tty then
begin
while not nil(request) do
begin
request^.u2:=create_done;
return(request);
sensesem(request,queue(channel_no-1))
end;
timeout:=0;
if not nil(channel_descriptor(channel_no).request) then
start_next_request(channel_no);
end
else  (*  reading tty  *)
begin
with channel_descriptor( channel_no) do
begin
lock request as buf:ttybuffer do
begin
if next>ttylength then next:=ttylength;
buf.text(next):=cs;
next:=next+1;
if next>=top then
buf.nextfree:=next;
end;
if next>=top then
stop_actual_request
( ok_result, channel_no);
end;
outword(packed_word(cr,channel_no), channelmessage);
(*ttestout(opzone,"cs          ",timeout);t*)
channel_kind:=echo_nl_on_channel;
end;

del,bs :
if channel_descriptor(channel_no-1).reading_tty then
begin
lock request as buf:ttybuffer do
if next > buf.first then       (*  erase  *)
next:=next-1;
outword( packed_word( bs, channel_no), channelmessage);
end;
cr:          (*  return   works as line-end    *)
if channel_descriptor(channel_no-1).reading_tty then
lock request as buf:ttybuffer do
begin
channel_descriptor(channel_no-1).channel_kind:=echo_nl_on_channel;
buf.text(next):=data_byte;
if next<top-1 then
begin
buf.text(next+1):=nl;
buf.nextfree:=next+2
end
else
buf.nextfree:=next+1;
outword( packed_word( cr, channel_no), channelmessage);
(*ttestout(opzone,"cr          ",timeout);t*)
end
\f


otherwise      (*  packed_word character   *)

if channel_descriptor(channel_no-1).reading_tty then
begin
lock request as buf:ttybuffer do
begin
            (*  index error has been seen here,  next=81    *)
 if next > ttylength then next:= ttylength;
buf.text(next):=data_byte;
next:=next+1;
if next >= top then
buf.nextfree:=next;
end;
if next>=top then
stop_actual_request
( ok_result, channel_no);
outword( packed_word( data_byte, channel_no), channelmessage);
end
end;
if channel_descriptor(channel_no-1).reading_tty then
if timeout<normal_time then
timeout:=normal_time;
end;    (*  case read_tty  *)
\f


tty_write_channel :

if not reading_tty then
if ready_to_send(channel_no) then
begin
lock request as buf: ttybuffer do
begin

(*q if test_b then
begin
testout( opzone, "tty-w-next  ", next);
testout( opzone, "tty-w-ch    ", buf.text(next));
end; q*)

outword ( packed_word( buf.text(next), channel_no), channelmessage);
next:= next+1;
if next>= top then    (*  terminate  *)
buf.nextfree:= next;
end;
if next>=top then
stop_actual_request
 ( ok_result, channel_no)
end
else
stop_actual_request
( write_error, channel_no);

\f


echo_nl_on_channel :
begin
(*ttestout(opzone,"nl          ",timeout);t*)
outword( packed_word( nl, channel_no), channelmessage);
if reading_tty then
stop_actual_request( ok_result, channel_no+1);
channel_kind:=tty_write_channel;
end;

tty_wait_cr :
begin
outword(packed_word(cr,channel_no),channelmessage);
channel_kind:=tty_wait_nl;
(*ttestout(opzone,"esc cr      ",timeout);t*)
end;

tty_wait_nl :
begin
outword(packed_word(nl,channel_no),channelmessage);
channel_kind:=tty_wait_input;
(*ttestout(opzone,"esc nl      ",timeout);t*)
end;

tty_wait_input :
begin
end;
otherwise
testout ( opzone, "ill-ch-kind ", channel_no);
        end;
end;
\f


(***********************************************************
*                                                          *
*   high level lam-driver                                  *
*                                                          *
*  converts an interrupt to a signal to the level-0-driver *
*                                                          *
*   handles input only                                     *
************************************************************)

process highlevellamdriver( var lamsem: semaphore);

const
readytosend= 24;
startscanner = -1;
interrupt_ok=40;
no_input=255;

type
dataword
= packed record
data:byte;
unused:0..3;
error:boolean;
port_and_bit15: 0..31;
end;

var
 channelmessage,ref:  reference;
     indata:   dataword;
     status:   integer;

procedure controlclr(x:integer; var y:reference); external;
(*        writes controle and clears interrupt *)

procedure inword( var x: dataword; var y: reference); external;
(*         reads one word *)

procedure sense( var x:integer; y:integer; var z:reference); external;
(*         gets status *)
\f


begin

wait(channelmessage,lamsem);
(*            wait for a channelmessage to arrive *)

channel channelmessage do
while true do
begin
controlclr(startscanner,channelmessage);
(*            write control and clear interrupt *)
        inword(indata,channelmessage);
(*            read one word of input *)
        wait(ref,lamsem);
(*            wait for inputbuffer at lamsem *)
        with indata,ref^ do
begin
u2:=interrupt_ok;
if (port_and_bit15 mod 2) = 0 then
(*          it is an outputinterrupt *)
u3:=no_input
else
if error then
begin
sense(status, port_and_bit15, channelmessage);
u2 := status mod 64;
end
else
u3:=data;
u4:=port_and_bit15;

(*******************************
*                      +1 overrun
*                      +2 framing error
*  status = 0          +4 parity error
*                      +8 data set ready
*                     +16 ready for sending
*                     +32 data carrier detector
********************************)

        end;
        return(ref);
  end
end;
\f


(********************************************************
*   initialization                                      *
*********************************************************)

begin

  testopen(opzone, own.incname, opsem); 

testout( opzone, version, al_env_version);

(*             create and start high level lamdriver *)
  if create( "highlevellam", highlevellamdriver(lamsem), driver, store ) = 0
     then start(driver,prio)
(*q else
if test_b then
 testout(opzone,"create error",0) q*) ;

(*             first buffer from lampool is used as a copy of channelmess *)
(*q if test_b then
testout(opzone, "lam-h start ", 0); q*)

  alloc(ref,lampool,mainsem.s^);

  if (reservech(channelmessage, level,mask) + copychm(ref,channelmessage) <> 1) and test_b then
(*q      testout(opzone,"res.ch error",reservech(channelmessage, level,mask)) q*) ; 
(*             if reservation of channel went well, send copy of channelmess to lamdriver *)
  signal(ref,lamsem);

(*             get one timeoutbuffer *)
  alloc(ref,timerpool,mainsem.s^);
(*             delay is set to u3*2**u4 = 1 sec   *)
  ref^.u3:=250; ref^.u4:=2;
(*             send to systemtimer *)
  sendtimer(ref);
\f


(*             get rest of inputbuffers and send them to lamdriver *)

  for channel_no:=2 to no_of_lambufs do
begin
alloc(ref, lampool, mainsem.s^);
signal(ref,lamsem);
end;

(*             all devicedescriptors are initialized *)

for channel_no:=0 to max_channel_no do
with channel_descriptor( channel_no) do
begin
timeout := 0;
channel_kind := not_created;
interruptable := false;
reading_tty := false;
end;
\f


(********************************************************
*   level-0-lam                                         *
*                                                       *
*    sends output directly to the channel               *
*    handles inputbuffers from highlevel lamdriver      *
*                                                       *
*********************************************************)

 repeat     (*  main loop  *)
(*                  wait for buffer on inputsemaphore *)

  wait(ref,mainsem.w^);
\f


  if ownertest(lampool,ref) then
begin
(*q if test_b then
testout( opzone, "interrupt on", ref^.u4); q*)

with channel_descriptor(ref^.u4) do

if interruptable then
if (not nil(request)) or (channel_kind>=echo_nl_on_channel) then
case ref^.u2 of
write_read_ok:
handle_ok_lam_int(ref^.u3, ref^.u4);
overrun, parity, overrun_and_parity :
stop_actual_request
(transient_error,ref^.u4);
otherwise
begin
stop_actual_request
(persistent_error, ref^.u4);
start_new_channel(ref^.u4);
(*q if test_b then
          testout(opzone,"hwstatus= 8.",((ref^.u2 div 8)*10+(ref^.u2 mod 8))*100+ref^.u4); q*)
               end;
    end;

    signal(ref,lamsem);
  end
\f


  else
(*          it is a timeoutbuffer from systemtimer *)
  if ownertest(timerpool,ref) then
  begin
    ref^.u3:=1; ref^.u4:=10;
    sendtimer(ref);
    for channel_no:=0 to 31 do with channel_descriptor(channel_no) do
    if timeout>0 then 
begin
timeout:=timeout-1;
if timeout=0 then
if (request^.u1=read_tty) and (not nil(channel_descriptor(channel_no-1).request)) then
begin
channel_descriptor(channel_no-1).reading_tty := false;
start_next_request(channel_no-1);

lock request as buf:ttybuffer do
begin
if channel_descriptor(channel_no).next>buf.first then
outword( packed_word( 60, channel_no), channelmessage)
else
outword( packed_word(del, channel_no), channelmessage);
end
end
else
begin
stop_actual_request
 ( timeout_err, channel_no);
if channel_no mod 2 = 0 then start_new_channel ( channel_no)
end;
    end;
   end
\f


else
(*                   it is a delaybuffer from systemtimer *)
if ownertest( delaypool, ref) then
begin
channel_no:=ref^.u1 div 2;
with channel_descriptor(channel_no) do
begin

case (ref^.u1 mod 2) of
0:
begin
(*q if test_b then
testout( opzone, "end-rts-dlay", channel_no); q*)
channel_kind:=at_write_channel;
interruptable := true;
handle_ok_lam_int( 0,channel_no);
end;
1:
begin
(*q if test_b then
testout( opzone, "end-rtr-dlay", channel_no); q*)
if request^.u1 = write_at then stop_actual_request
( ok_result, channel_no)
else stop_actual_request
( go_on_read, channel_no);
end;
otherwise (*q testout( opzone, "timer fault ", channel_no) q*);
end;

release(ref);
end
end

else
if ref^.u3 = dummy_route then  return ( ref)
\f


  else
(*       it is a userbuffer *)

  begin
(*       devicenumber is equal to portno *2  *)
    channel_no:=ref^.u2 * 2;

(*       if command is pure read the devicenumber is uneven *)
    if ref^.u1 mod 4 = 1 then channel_no:=channel_no+1;

    case ref^.u1 of

create_at_ch:
begin
createchannel(at_write_channel, at_read_channel);
start_new_channel(channel_no);
end;

create_it_ch:
begin
createchannel(it_write_channel, it_read_channel);
start_new_channel(channel_no);
end;

create_tty_ch:
begin
createchannel(tty_write_channel, tty_read_channel);
channel_descriptor(channel_no).interruptable:=true;
channel_descriptor(channel_no+1).interruptable:=true;
start_new_channel(channel_no);
end;


\f


read_at, write_at, write_read_at :

with channel_descriptor(channel_no) do
if (channel_kind<at_write_channel) or (channel_kind > at_read_wait) then
begin
ref^.u2 := illegal_function;
return( ref)
end
else
     if not nil(request) then signal(ref,queue(channel_no))
else
begin
request:=:ref;
start_next_request(channel_no);
     end;
\f


read_it, write_it, write_read_it :

if ref^.size<itsize then
begin
(*q if test_b then
testout( opzone,"buffer small", ref^.size); q*)
ref^.u2:=buffer_too_small;
return( ref);
end
else

with channel_descriptor(channel_no) do
if (channel_kind<it_write_channel) or (channel_kind>it_read_channel) then
begin
ref^.u2:=illegal_function;
return( ref);
end
else
if not nil(request) then signal( ref, queue(channel_no))
else
begin
request :=: ref;
start_next_request(channel_no);
if channel_kind=it_write_channel then handle_ok_lam_int(0,channel_no);
end;
\f


read_tty:

if ref^.size < ttysize then
begin
(*q if test_b then
testout( opzone, "buffer small", ref^.size); q*)
ref^.u2:=buffer_too_small;
return( ref);
end
else
with channel_descriptor(channel_no) do
if channel_kind < tty_write_channel then
begin
ref^.u2:=illegal_function;
return(ref);
end
else
if not nil ( request) then signal ( ref, queue(channel_no)) 
else
begin   (*  start now  *)
request :=: ref;
(*   look if write_tty is going on  *)
if nil(channel_descriptor(channel_no-1).request) then
start_next_request(channel_no)
end;
\f


write_tty:

if ref^.size < ttysize then
begin
(*q if test_b then
testout( opzone, "buffer small", ref^.size); q*)
ref^.u2:=buffer_too_small;
return( ref);
end
else
with channel_descriptor(channel_no) do
if channel_kind<tty_write_channel then
begin
ref^.u2:=illegal_function;
return(ref);
end
else
begin
lock ref as buf : ttybuffer do
buf.nextfree:=buf.first;
if not nil ( request) then
signal ( ref, queue(channel_no))
else
begin
request :=: ref;
(*   look if read_tty is going on   *)

if channel_kind <> tty_wait_input then
if reading_tty then
with channel_descriptor(channel_no+1) do
lock request as buf:ttybuffer do
begin
if next>buf.first then
timeout:=normal_time
else
timeout:=no_time
end
else
begin
start_next_request(channel_no);
handle_ok_lam_int ( 0, channel_no);
end;
end
end
\f


otherwise
begin
(*q if test_b then
testout ( opzone, "unknown     ", ref^.u1); q*)
ref^.u2:=illegal_function;
return(ref);
end
  end;

end   (*  user request  *)

 until  forever

end.     (*  lam driver   *)   
«eof»
DataMuseum.dk

RC3500

⟦7c47363f5⟧ TextFileVerbose

Derivation

TextFileVerbose
