DataMuseum.dk

top - metrics - download

    Length: 6912 (0x1b00)
    Types: TextFileVerbose
    Names: »xtproc«

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

TextFileVerbose

prefix inc15;

(*------------------------------------------------------------*)
(*  procedure to increment cyclical 15-bit integer            *)
(*------------------------------------------------------------*)

procedure inc15 (var i: integer);
begin
if i= maxint then i:= 0 else i:= i+1;
end;


prefix inc16;

(*------------------------------------------------------------*)
(* procedure to increment cyclical 16-bit integer             *)
(*------------------------------------------------------------*)

procedure inc16 (var i: integer);
begin
if i= maxint then i:= minint else i:= i+1;
end;


prefix inc32;

(*------------------------------------------------------------*)
(* procedure to increment cyclical 32-bit integer             *)
(*------------------------------------------------------------*)

procedure inc32 (var i: int32);
begin
with i do
begin
if lsp= maxint then lsp:= minint else lsp:= lsp+1;
if lsp= 0 then
if msp= maxint then msp:= minint else msp:= msp+1;
end;
end;


prefix comp32;

(*-----------------------------------------------------------*)
(* function to relate two 32-bit values                      *)
(*-----------------------------------------------------------*)

function comp32 (i,j: int32): relation;
begin
comp32:= eq;
end;


prefix dif16;

function dif16(i,j: integer) : integer;
begin
dif16:= i-j;
end;



prefix timerbook;

procedure timerbook(var local_msg: reference;
var local_timer_msg: reference;
local_ticks: ! integer;
local_obj: ! integer;
var local_timeout_sem: semaphore;
var local_answer: semaphore);

(************************************************************************)
(*                                                                      *)
(*                            timerbook                                 *)
(*                                                                      *)
(* general procedure.                                                   *)
(* parameters:                                                          *)
(*   local_msg: reference to a booking and a timer update message.      *)
(*     at return it references the same message (call and return        *)
(*     parameter).                                                      *)
(*   local_timer_msg: reference to a timeout message. it is nil at      *)
(*     return (call parameter).                                         *)
(*   local_ticks: ticks before the timeout message is returned from     *)
(*     timeout module (call parameter).                                 *)
(*   local_obj: booking identification, used to identify the timeout    *)
(*     message, when returned from timeout module (call parameter).     *)
(*   local_timeout_sem: timeout module semaphore (call parameter)       *)
(*   local_answer: a passive semaphore that is to be used by the        *)
(*     procedure as answer semaphore. it is passive at return (call and *)
(*     return parameter).                                               *)
(* call of other procedures: none.                                      *)
(* use of global variables: none.                                       *)
(* waiting points: yes, one.                                            *)
(* function: this procedure makes a timerbook at the timeout module.    *)
(*   two messages (timerbook and timer update) are updated, pushed      *)
(*   together, and signalled to timeout module. the procedure waits     *)
(*   for the answer from timerbook.                                     *)
(*                                                                      *)
(************************************************************************)

const
writecontrol = 5;     (* function for timeout *)
rwcontrol = 7;        (* function for booking *)
message = 7;

type
opdates = record
index,
count,
obj: integer;
end;

begin
local_timer_msg^.u1:= rwcontrol;
local_timer_msg^.u2:= message;
local_msg^.u1:= writecontrol;
lock local_msg as data: opdates do
with data do
begin
count:= local_ticks;
obj:= local_obj;
end;     (* with data and lock local_msg *)
push(local_timer_msg, local_msg);
signal(local_msg, local_timeout_sem);
wait(local_msg, local_answer);
end;   (* timerbook *)



prefix timerupdate;

procedure timerupdate(var local_msg: reference;
local_ticks: ! integer;
var local_timeout_sem: semaphore;
var local_answer: semaphore);

(************************************************************************)
(*                                                                      *)
(*                            timerupdate                               *)
(*                                                                      *)
(* general procedure.                                                   *)
(* parameters:                                                          *)
(*   local_msg: reference to a timerupdate message. at return it        *)
(*     references the same message (call and return parameter).         *)
(*   local_ticks: new value of ticks before the corresponding timeout   *)
(*     message is returned from timeout module (call parameter).        *)
(*   local_timeout_sem: timeout module semaphore (call parameter).      *)
(*   loca_answer: a passive semaphore that is to be used by the         *)
(*     procedure as answer semaphore. it is passive at return (call     *)
(*     and return parameter).                                           *)
(*                                                                      *)
(************************************************************************)

const
write = 4;
message = 7;

type
opdates = record
index,
count,
obj: integer;
end;

begin
local_msg^.u1:= write;
local_msg^.u2:= message;
lock local_msg as data: opdates do
data.count:= local_ticks;
signal(local_msg, local_timeout_sem);
wait(local_msg, local_answer);
end;   (* timerupdate *)



prefix nameinit;

(*------------------------------------------------------------*)
(*  procedure to initialize a name in an alfa-variable        *)
(*------------------------------------------------------------*)

procedure nameinit (var name: alfa; a: alfa; pos, incno: integer);

begin
name:= a;
if incno >= 10 then
begin
name(pos):= chr (48 + (incno div 10));
name(pos+1):= chr (48 + (incno mod 10));
end else
name(pos):= chr (48 + (incno mod 10));
end; (* procedure nameinit *)

.
«eof»