DataMuseum.dk

Presents historical artifacts from the history of:

RC3500

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC3500

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦2697b14f6⟧ TextFileVerbose

    Length: 3840 (0xf00)
    Types: TextFileVerbose
    Names: »konsoljob«

Derivation

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

TextFileVerbose

job hj 3 200 time 11 0 size 100000 area 9
( message konsol
source = copy 25.1
konsollst = set 1 disc1
konsollst = indent source mark lc
listc = cross konsollst
o errors
message konsol
pascal80 spacing.1000 codesize.1000 alarmenv source
o c
lookup pass6code
if ok.yes
  konsolbin = move pass6code
konsollst = copy listc errors
scope user konsollst
convert errors
finis 
)
\f



process konsol (
  var main : !ts_pointer;           (*  main semaphore   *)
  var driv : !sempointer            (*  lam driver       *)
 );

const

 version = "vers 0.00  / ";

type

 ttybuffer = record
  first, last, next : integer;
  text : array (1..80) of byte;
 end;

 atbuffer = record
  b0, b1 : byte
 end;

 ttyzone = record
  free : semaphore;
  cur : reference;
  next, top : integer
 end;


const

 end_of_line = 10;
 ibufs = 1;
 obufs = 2;
 book = #hc3;

\f



var
 inchn,          (*  input kanal nr  *)
 outchn: byte:=16;   (*  output kanal nr  *)
 h: integer;
 data0,
 data1: byte;        (*  from debug cable  *)
 msg : reference;
 ipool : pool ibufs of atbuffer;
 opool : pool obufs of ttybuffer;
 tty : ttyzone;

\f



procedure openfile ( 
  var f: ttyzone;
  bufs : integer;
  var reso: pool 1;
  v1: byte
  );
begin
 with f do
 begin
  while bufs > 0 do
  begin
   alloc ( cur, reso, free);
   cur^.u1:= v1;
   cur^.u3:= lam_route;
   cur^.u4:= #h40 + v1;
   signal ( cur, free);
   bufs:= bufs-1
  end
 end
end;

\f



procedure outblock ( var f: ttyzone);
begin
with f do
begin
 lock cur as buf: ttybuffer do
 begin
  buf.first:= 1;
  buf.last:= next-1
 end;
 cur^.u2:= outchn;         (*  channel no   *)
 signal ( cur, driv^)
end;
end;





procedure printchar ( var f: ttyzone;  ch: byte );
begin
with f do
begin

 if nil ( cur) then      (*  get a new free buffer  *)
 begin
  wait ( cur, free);
  next:= 1;
 end;

 lock cur as buf: ttybuffer do  buf.text(next):= ch;
 next:= next+1;
 if ( next > top ) or
   ( ch = end_of_line ) then outblock ( f);
end
end;



\f


(*------------------------- main program ---------------------------*)

begin

 openfile ( tty, obufs, opool, write_tty );
 
 inchn:= 16;
 repeat
  wait ( msg, main.w^);
  if msg^.u4 = book then
  lock msg as at: atbuffer do
  begin
    inchn:= at.b0 mod 16;
    outchn:= at.b1 mod 16;
  end;
  return ( msg)
 until inchn < 16;

for h:= 1 to ibufs do
begin
 alloc ( msg, ipool, main.s^);
 msg^.u1:= read_at;
 msg^.u3:= lam_route;
 msg^.u4:= #h40 + read_at;
 signal ( msg, driv^);
end;

\f



(*------ main loop ------------*)

repeat
 wait ( msg, main.w^);
 case msg^.u3 of

lam_route:
 begin
  lock msg as at: atbuffer do
  begin
   data0:= at.b0;
   data1:= at.b1;
  end;
  msg^.u2:= inchn;
  signal ( msg, driv^);
  printchar ( tty, data0);
  printchar ( tty, data1);
 end
 otherwise
 begin
  if msg^.u4 = book then
  lock msg as at: atbuffer do
  begin
   inchn:= at.b0 mod 16;
   outchn:= at.b1 mod 16;
  end;
  return ( msg)
 end

 end  (* case  *)
 
until false

end  .  (*  of konsol converter    *)


«eof»