|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 6912 (0x1b00)
Types: TextFile
Names: »tptrdriver«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦6b41451d2⟧
└─⟦this⟧ »tptrdriver«
job bbl 2 600 time 6 0 size 150000 perm mini 100 3
(
pascal80 stop.5
lookup pass5code pass5descr
if ok.yes
( head 1 cpu
platonpass6 codesize.12000 spacing.12000 list.yes print.no
head 1 cpu
bptrdriver = set 1 mini
bptrdriver = move pass6code
if ok.yes
scope user bptrdriver
finis
)
finis
)
process ptrdriver(var sem: semaphore; level : integer);
(*
driver to rc2500 and rc500 paper tape readers
version: 2
date : 80.11.17 , bbl
*)
const
nul= 0;
sub= 26;
space= 32;
bar= 33;
underline= 95;
delete= 127;
lc= 122; (* decimal flexo value inclusive parity *)
uc= 124; (* decimal flexo value inclusive parity *)
lower_case= 0;
upper_case= 128;
length_of_index= 6;
end_of_paper= 64;
(* result constants: *)
not_processed= 0;
processed= 1;
temp_error= 2;
perm_error= 3;
max = 127;
type
mess_data= record
first,last,next: integer;
databuf: packed array(0..max) of byte
end;
status_type= packed record
unused: 0..8191; (* 13 bits *)
paper_out: boolean;
reader_ready: boolean;
power_ok: boolean
end;
control_type= packed array(0..15) of boolean;
word_type = array(0..1) of byte;
var
ch_mess: reference;
level: integer;
control_word : control_type;
word : word_type;
statusin : status_type;
mess: reference;
func: byte;
result: byte;
old_mode: byte := 0;
mode: byte;
flexo_case: byte := lower_case;
underline_or_bar_met: boolean := false;
procedure controlclr(control_word : control_type; var ch_mess : reference);
external;
procedure sense(var statusin : status_type; status_out : status_type;
var ch_msg : reference);
external;
procedure inword(var word : word_type; var ch_msg : reference);
external;
function even_parity(var i: byte) : boolean;
(* returns the value true, if the parity of the actual parameter
is even and removes the paritybit *)
const a= (. 0,3,5,6,9,10,12,15,17,18,20,23,24,27,29,
30,33,34,36,39,40,43,45,46,48,51,53,54,
57,58,60,63,65,66,68,71,72,75,77,78,80,
83,85,86,89,90,92,95,96,99,101,102,105,
106,108,111,113,114,116,119,120,123,125,126 .);
begin
if i<128 then
even_parity:=i in a
else
begin
(* remove parity bit *)
i:=i-128;
even_parity:=not (i in a)
end
end (* even_parity *);
procedure flexo_to_iso(var i: byte; offset : byte);
type
a= array(0..256) of byte;
const
table=
a(
(*-----------------------------------------------------------------------*)
(* 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 *)
(*-----------------------------------------------------------------------*)
(* 0 *)127, 49, 50, 26, 52, 26, 26, 55, 56, 26, 26, 12, 26,125, 95, 26,
(* 16 *) 32, 26, 26, 51, 26, 53, 54, 26, 26, 57, 26, 26, 25, 26, 26, 26,
(* 32 *) 48, 26, 26,116, 26,118,119, 26, 26,122, 26, 26, 26, 26, 26, 26,
(* 48 *) 26, 60,115, 26,117, 26, 26,120,121, 26, 26, 44, 26, 26, 9, 26,
(* 64 *) 45, 26, 26,108, 26,110,111, 26, 26,114, 26, 26, 26, 26, 26, 26,
(* 80 *) 26,106,107, 26,109, 26, 26,112,113, 26, 26,124, 26, 26, 26, 26,
(* 96 *) 26, 97, 98, 26,100, 26, 26,103,104, 26, 26, 46, 26, 26, 26, 26,
(* 112 *)123, 26, 26, 99, 26,101,102, 26, 26,105, ?, 26, ?, 26, 26,127,
(* 128 *) 10, 33, 42, 26, 61, 26, 26, 93, 40, 26, 26, 12, 26, 93, 33, 26,
(* 144 *) 32, 26, 26, 47, 26, 59, 91, 26, 26, 41, 26, 26, 25, 26, 26, 26,
(* 160 *) 26, 26, 26, 84, 26, 86, 87, 26, 26, 90, 26, 26, 26, 26, 26, 26,
(* 176 *) 26, 62, 83, 26, 85, 26, 26, 88, 89, 26, 26, 39, 26, 26, 9, 26,
(* 192 *) 43, 26, 26, 76, 26, 78, 79, 26, 26, 82, 26, 26, 26, 26, 26, 26,
(* 208 *) 26, 74, 75, 26, 77, 26, 26, 80, 81, 26, 26, 92, 26, 26, 26, 26,
(* 224 *) 26, 65, 66, 26, 68, 26, 26, 71, 72, 26, 26, 58, 26, 26, 26, 26,
(* 240 *) 91, 26, 26, 67, 26, 69, 70, 26, 26, 73, ?, 26, ?, 26, 26,127, 10);
begin
i:=table(i+offset)
end (* flexo_to_iso *);
(************************************************************************)
(* *)
(* m a i n p r o g r a m *)
(* *)
(************************************************************************)
begin
if reservech(ch_mess, level, 0) = 0 then
while true do
begin
wait(mess,sem);
func:=mess^.u1;
(* set timer value *)
own.timer:=mess^.u3;
mode:=mess^.u4;
if old_mode<>mode then
flexo_case:=lower_case;
old_mode:=mode;
result:=processed;
statusin.power_ok:=true;
statusin.paper_out:=false;
case func of
0 , 1:
result:=perm_error;
2: (* read data operation *)
lock mess as a:mess_data do
with a do
begin
while (next <= last) and
(own.timer>0) and
statusin.power_ok and
not( statusin.paper_out ) do
begin
sense(statusin,statusin,ch_mess);
channel ch_mess do
begin
controlclr(control_word,ch_mess);
inword(word,ch_mess);
end;
case mode of
0: (* odd parity *)
if word(1) <> 0 then (* skip blanks *)
begin
if even_parity(word(1)) then word(1):=sub;
databuf(next):=word(1);
next:=next+1
end;
2: (* even parity *)
begin
if not even_parity(word(1)) then word(1):=sub;
databuf(next):=word(1);
next:=next+1
end;
4: (* no parity *)
begin
databuf(next):=word(1);
next:=next+1
end;
6: (* flexo *)
case word(1) of
nul: (* skip blanks *);
lc:
flexo_case:=lower_case;
uc:
flexo_case:=upper_case;
otherwise
begin
flexo_to_iso(word(1),flexo_case);
case word(1) of
delete: (* skip fill characters *);
bar, underline:
underline_or_bar_met:=true;
space:
begin
if underline_or_bar_met then
begin
if flexo_case=lower_case then
word(1):=underline
else
word(1):=bar;
underline_or_bar_met:=false
end;
databuf(next):=word(1);
next:=next+1
end;
otherwise
(* grafic *)
begin
if underline_or_bar_met then
begin
word(1):=sub;
underline_or_bar_met:=false
end;
databuf(next):=word(1);
next:=next+1
end
end
end
end;
otherwise
begin
result:=perm_error;
own.timer:=0
end;
end (* mode *);
end (* while *)
end (* with *);
3: (* sense *);
4..10:
result:=perm_error;
3 + 8: (* sense ready *)
begin
sense(statusin,statusin,ch_mess);
if statusin.power_ok then
channel ch_mess do
controlclr(control_word,ch_mess)
else
result:=temp_error
end;
otherwise
result:=perm_error
end;
sense(statusin,statusin,ch_mess);
if not statusin.power_ok then
result:=temp_error;
mess^.u2:=result;
mess^.u3:=0;
if statusin.paper_out then
mess^.u4:=end_of_paper
else
mess^.u4:=0;
return(mess)
end (* while *)
end (* reader_driver *) .
▶EOF◀