DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »tconsole«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »tconsole« 

TextFile

process console(var console_sem : semaphore; pu,inputlevel,outputlevel : integer);
(***********************************************************************)
(*                                                                     *)
(*          console driver                                             *)
(*                                                                     *)
(***********************************************************************)
const
(* functions *)
read = 1;
write = 2;
attention = read + 4;
 
(* results *)
ok = 0;
timeout = 2;
illegal_message = 4;

size = 512;
priority = -8;
outpriority = 0;

(* functions between driver and interrupt driver *)
input_code = 1;
output_code = 2;

enq = 5; (* delete input *)
bell = 7;
bs = 8; (* delete last char *)
lf = 10;  (* line feed  == newline *)
cr = 13;  (* carriage return *)
sp = 32;
esc = 27;
firstindex = 6;
linelength = 80;

var
mask : boolean := false;
msg : reference;
input_msg : reference;
output_msg : reference;
messages : pool 2;
input_sem : semaphore;
output_sem : semaphore;
debugin_sh : shadow;
att_hook: semaphore;
debugout_sh : shadow;
outputbusy : boolean;
go_on : boolean;
inchar : integer;
outchar : integer;
result : integer;
i : integer;

type
buffer_type = record
first : integer;
last : integer;
next : integer;
databuf : array(firstindex..linelength - 1 + firstindex + alfalength) of byte
end;

process debugin(var input_sem : semaphore; pu,level : integer);
external;

process debugout(var output_sem : semaphore; pu,level : integer);
external;

<*
procedure test(x : integer; mode : integer);
begin
if mask then
begin
case mode of
0: printtext(' input = #  ');
1: printtext(' output = # ')
end;
if (x < 32) or (x > 127) then
printnumber(x,3)
else
printchar(chr(x));
printnl;
end;
end;
*>


procedure putchar (ch: byte);
begin
output_msg^.u4 := ch;
signal(output_msg, output_sem);
wait (output_msg, console_sem);
(* the answer may be: input-answer or output-answer *)
while output_msg^.u1 = read do
begin (* test for esc , and repeat *)
if output_msg^.u2 = ok then
if output_msg^.u4 = esc then
begin
go_on := false;  (* force exit of any loops *)
result := attention;
end;
signal (output_msg (* i.e. input-msg !!! *), input_sem);
wait (output_msg, console_sem);  (* try again *)
end;
(* now, test for the output-result *)
if output_msg^.u2 <> ok then
begin
go_on := false;
result := timeout;
end;
end;



begin
platoninit;  (* to be removed *)

(* create console interrupt process incarnation *)
link('debugin     ',debugin);
i := create(debugin(input_sem,pu,inputlevel),debugin_sh,size,pu);
start(debugin_sh,priority);
link('debugout    ',debugout);
i := create(debugout(output_sem,pu,outputlevel),debugout_sh,size,pu);
start(debugout_sh,outpriority);


(* allocate messages *)
alloc(input_msg,messages,console_sem);
input_msg^.u1 := read;
alloc(output_msg,messages,console_sem);
output_msg^.u1 := write;

signal (input_msg, input_sem);

repeat
(* situation is: there is a message at input-driver *)
(* and any kind of messages may arrive from operator-process *)
wait(msg,console_sem);
result := ok;

if msg^.size = 0 then
case msg^.u1 of
attention: (* attention message from operator process *)
signal (msg, att_hook);  (* queue it up, until esc-character is typed *)
read: (* answer from input-process, in idle mode *)
begin
(* test for esc-character *)
if msg^.u2 = ok then
if (msg^.u4 = esc) or (msg^.u4 = cr) then
begin
sensesem (input_msg (* i.e. att-message *), att_hook);
if not nil (input_msg) then
begin
input_msg^.u2 := attention;
input_msg^.u4 := msg^.u4; (* transfer attention char *)
return (input_msg);
end;
end;
signal (msg, input_sem);  (* prepare for another character *)
end; (* read-answer *)
end (* case *)

else

begin (* data message *)
case msg^.u1 of


read:
begin  (* input message from operator process *)
lock msg as p : buffer_type do
with p do
begin
next := first;
go_on := true;

putchar (bell);
while (next <= last) and go_on do
begin
wait (input_msg, console_sem);  (* can only be: input-answer *)
case input_msg^.u2 of

ok:
begin
inchar := input_msg^.u4;
case inchar of

enq:
while next > first do
begin
next := next - 1;
putchar (bs);
putchar (sp);
putchar (bs);
end;
bs:
if next > first then
begin
next := next - 1;
putchar (bs);
putchar (sp);
putchar (bs);
end;
esc:
begin
go_on := false;
result := attention;
next := first;
end;
cr:
begin
putchar (cr); putchar (lf);
go_on := false
end;
otherwise
begin
databuf(next) := inchar;
next := next + 1;
(* echo inchar *)
putchar (inchar);
end;
end
end;
timeout:
begin
go_on := false;
result := timeout;
next := first
end;
end; (* case *)
signal (input_msg, input_sem);  (* prepare for another character *)
end; (* while *)
end; (* with *)
end;

write:
lock msg as p : buffer_type do
with p do
begin
next := first;
go_on := true;
while (next <= last) and go_on do
begin
outchar := databuf(next);
next := next + 1;
if outchar = lf then putchar(cr);  (* convert nl to: cr+lf *)
putchar (outchar);
end; (* while *)
end;

otherwise
begin
result := illegal_message;
end
end; (* case *)


<*
if mask then
begin
printtext(' result =   '); printnumber(result,3); printnl; (* to be removed *)
printtext('return msg  '); printnl; (* to be removed *)
end;
*>

if result = attention then
begin
sensesem (input_msg, att_hook);
if not nil (input_msg) then
begin
input_msg^.u2 := result;
input_msg^.u4 := esc; (* set escape-character *)
return (input_msg);
end;
end;

msg^.u2 := result;
return(msg)
end;
until false
end (* console driver *)
.
▶EOF◀