⟦0b2f1724c⟧

TextFileVerbose

job bbl 8 600 time 11 0 perm mini 100 1 size 92000
platonenv = set bs bblenv
(
; o consoleout
  head 1 cpu
  pascal80 codesize.12000 spacing.12000 ,
    stack.275,
    codelist.no,
    debugenvir
; o c
; convert consoleout
  bconsole = set 1 mini
  bconsole = move pass6code
  if ok.yes
    scope project bconsole
  finis
)


process console(var console_sem : semaphore; inputlevel,outputlevel : integer);
(***********************************************************************)
(*                                                                     *)
(*          console driver                                             *)
(*                                                                     *)
(***********************************************************************)
const

pu = 0;

(* functions *)
read = 1;
write = 2;
attention = read + 4;
 
(* results *)
ok = 0;
timeout = 2;
illegal_message = 4;

size = 192;
priority = 1;
outpriority = 1;

(* 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;

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


process debugin(var input_sem : semaphore; level : integer);
(***********************************************************************)
(*                                                                     *)
(*          debugin driver                                             *)
(*                                                                     *)
(***********************************************************************)
const
inputlevel_index = 2;
datain_index = 7;
pu = 0;

ok = 0;
timeout = 2;
mask = -1;
max_input_timeout = 20;

var
ch_msg : reference;
msg : reference;
result : integer;
data_in : byte;



begin
if reservech(ch_msg,level,mask) = 0 then
begin
writeram(inputlevel_index,level); (* init interrupt level *)
definetimer (true);

while true do
channel ch_msg do
repeat
own.timer := max_input_timeout;
clearlevel; (* wait interrupt *)

if own.timer = 0 then
begin
result := timeout;
data_in := 0;  (* just assign any legal value *)
end
else
begin
result := ok;
readram(data_in,datain_index)
end;
sensesem(msg,input_sem);
if not nil(msg) then
begin
with msg^ do
begin
u2 := result;
u3 := data_in
end;
return(msg)
end
until own.timer = 0;
end
end;


process debugout(var output_sem : semaphore; level : integer);
(***********************************************************************)
(*                                                                     *)
(*          debugout driver                                            *)
(*                                                                     *)
(***********************************************************************)
const
outputlevel_index = 1;
dataout_index = 8;
pu = 0;

ok = 0;
timeout = 2;
mask = -1;
max_output_timeout = 5;

var
ch_msg : reference;
msg : reference;
result : integer;
data_out : integer;


begin
if reservech(ch_msg,level,mask) = 0 then
begin
writeram(outputlevel_index,level); (* init interrupt level *)
definetimer (true);

while true do
channel ch_msg do
repeat
own.timer := 0;
wait(msg,output_sem);
data_out := msg^.u3;
own.timer := max_output_timeout;
writeramclr(dataout_index,data_out);

if own.timer = 0 then
result := timeout
else
result := ok;
msg^.u2 := result;
return(msg);
until own.timer = 0;
end
end;



<*
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^.u3 := 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^.u3 = 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
(* create console interrupt process incarnation *)
i := create('debugin     ',debugin(input_sem,inputlevel),debugin_sh,size);
start(debugin_sh,priority);
i := create('debugout    ',debugout(output_sem,outputlevel),debugout_sh,size);
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
(* all att input chars are echoed to operator while idling *)
if msg^.u2 = ok then
begin
sensesem (input_msg (* i.e. att-message *), att_hook);
if not nil (input_msg) then
begin
input_msg^.u3 := msg^.u3; (* 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 *)

if ult(16383,msg^.size) then
i := maxint
else
i := msg^.size * 2 - 1;

lock msg as p : record
first,last,next : integer;
databuf : array(firstindex .. i) of byte
end do

case msg^.u1 of

read:
begin  (* input message from operator process *)
with p do
begin
go_on := true;
echo := msg^.u3;

while (next <= last) and go_on do
begin
if echo = 0 then
begin
wait (input_msg, console_sem);  (* can only be: input-answer *)
inchar := input_msg^.u3;
switch := input_msg^.u2
end
else
begin
inchar := echo;
echo   := 0;
switch := ok
end;
case switch of
ok:
begin
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;
end;
cr:
begin
putchar (cr); putchar (lf);
for i := 1 to 6 do putchar(ord(del));
go_on := false
end;
otherwise
begin
(* echo inchar *)
putchar(inchar);
if ( 64 < inchar ) and ( inchar < 94 ) then
inchar := inchar + 32;
databuf(next) := inchar;
next := next + 1;
end;
end
end;
timeout:
begin
go_on := false;
result := timeout;
end;
end; (* case *)
if not nil(input_msg) then
signal (input_msg, input_sem);  (* prepare for another character *)
end; (* while *)
end; (* with *)
end;

write:
with p do
begin
next := first;
go_on := true;
outchar := lf;
while (next <= last) and go_on do
begin
outchar := databuf(next);
next := next + 1;
if outchar = lf then
begin
putchar(cr);
putchar(lf);
for i := 1 to 6 do
putchar(ord(del))
end
else
putchar (outchar);
end; (* while *)
msg^.u3 := outchar; (* report last char back to operator *)
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^.u3 := esc; (* set escape-character *)
return (input_msg);
end;
end;

msg^.u2 := result;
return(msg)
end;
until false
end (* console driver *)
.
«eof»
DataMuseum.dk

RC3500

⟦0b2f1724c⟧ TextFileVerbose

Derivation

TextFileVerbose
