DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

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

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦711a83932⟧ TextFile

    Length: 15360 (0x3c00)
    Types: TextFile
    Names: »htsys       «

Derivation

└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
    └─⟦6a563b143⟧ 
        └─ ⟦this⟧ »htsys       « 

TextFile

systemmodul.
:1: sys: parametererklæringer
\f

message sys_parametererklæringer side 1 - 810127/cl;

boolean testbit0 ,testbit1 ,testbit2 ,testbit3 ,testbit4 ,testbit5 ,
        testbit6 ,testbit7 ,testbit8 ,testbit9 ,testbit10,testbit11,
        testbit12,testbit13,testbit14,testbit15,testbit16,testbit17,
        testbit18,testbit19,testbit20,testbit21,testbit22,testbit23,
        testbit24,testbit25,testbit26,testbit27,testbit28,testbit29,
        testbit30,testbit31,testbit32,testbit33,testbit34,testbit35,
        testbit36,testbit37,testbit38,testbit39,testbit40,testbit41,
        testbit42,testbit43,testbit44,testbit45,testbit46,testbit47;
boolean cl_overvåget,out_tw_lp,
        cm_test;

integer låsning;
\f

message sys_parametererklæringer side 2 - 810310.hko;

<* hjælpevariable *>

integer i,j,k;
integer array ia(1:32);
integer array field iaf,ref;

real r;
real array ra(1:3);
real array field raf;

long array la(1:2);
long array field laf;

procedure ud;
begin
  outchar(out,'nl');
  if out_tw_lp then setposition(out,0,0);
end;
\f

message sys_parametererklæringer side 3 - 810310/hko;

<* hovedmodul_parametre *>

integer
  sys_mod,
  io_mod,
  op_mod,
  gar_mod,
  rad_mod,
  vt_mod;

<* operations_parametre *>

integer field
  kilde,
  retur,
  resultat,
  opkode;

real field
  tid;

integer array field
  data;

boolean
  sys_optype,
  io_optype,
  op_optype,
  gar_optype,
  rad_optype,
  vt_optype,
  gen_optype;
\f

message sys_parametererklæringer side 4 - 820301/hko,cl;

<* trimme-variable *>

integer
  max_antal_operatører,
  max_antal_garageterminaler,
  max_antal_garager,
  max_antal_områder,
  max_antal_radiokanaler,
  max_antal_pabx,
  max_antal_kanaler,
  max_antal_mobilopkald,
  min_antal_nødopkald,
  max_antal_grupper,
  max_antal_gruppeopkald,
  max_antal_spring,
  max_antal_busser,
  max_antal_linie_løb,
  max_antal_fejltekster,
  max_linienr;

integer array
  konsol_navn,
  terminal_navn,
  garage_terminal_navn,
  radio_fr_in_navn, radio_fr_out_navn,
  radio_rf_in_navn, radio_rf_out_navn(1:4),

  alfabet(0:127);

boolean
  garage_auto_include;

integer tf_systællere;
:2: sys: parameterinitialisering
\f

message sys_parameterinitialisering side 1 - 810305/hko;

cl_overvåget:= false;
  getzone6(out,ia);
  out_tw_lp:= ia(1) extract 12 = 8 or ia(1) extract 12 = 14;

testbit0 :=testbit( 0);
testbit1 :=testbit( 1);
testbit2 :=testbit( 2);
testbit3 :=testbit( 3);
testbit4 :=testbit( 4);
testbit5 :=testbit( 5);
testbit6 :=testbit( 6);
testbit7 :=testbit( 7);
testbit8 :=testbit( 8);
testbit9 :=testbit( 9);
testbit10:=testbit(10);
testbit11:=testbit(11);
testbit12:=testbit(12);
testbit13:=testbit(13);
testbit14:=testbit(14);
testbit15:=testbit(15);
testbit16:=testbit(16);
testbit17:=testbit(17);
testbit18:=testbit(18);
testbit19:=testbit(19);
testbit20:=testbit(20);
testbit21:=testbit(21);
testbit22:=testbit(22);
testbit23:=testbit(23);
\f

message sys_parameterinitialisering side 2 - 810316/cl;

testbit24:=testbit(24);
testbit25:=testbit(25);
testbit26:=testbit(26);
testbit27:=testbit(27);
testbit28:=testbit(28);
testbit29:=testbit(29);
testbit30:=testbit(30);
testbit31:=testbit(31);
testbit32:=testbit(32);
testbit33:=testbit(33);
testbit34:=testbit(34);
testbit35:=testbit(35);
testbit36:=testbit(36);
testbit37:=testbit(37);
testbit38:=testbit(38);
testbit39:=testbit(39);
testbit40:=testbit(40);
testbit41:=testbit(41);
testbit42:=testbit(42);
testbit43:=testbit(43);
testbit44:=testbit(44);
testbit45:=testbit(45);
testbit46:=testbit(46);
testbit47:=testbit(47);
cm_test:= false;
<*+1*>
  cm_test:= true;
<*-1*>
\f

message sys_parameterinitialisering side 3 - 810409/cl,hko;

  timeinterval:=1; <* tidsinterval for cmon's timeoutinspection *>

  if findfpparam(<:låsning:>,true,ia) > 0 then låsning:= ia(1)
  else låsning:= 0;
  if findfpparam(<:garager:>,false,ia) > 0 then
    garage_auto_include:= ia(1)<>long<:nej:> shift (-24) extract 24
  else
    garage_auto_include:= true;
\f

message sys_parameterinitialisering side 4 - 820301/hko/cl;

<* initialisering af hovedmodul_parametre *>

  i:=0;   sys_mod:=i;
  i:=i+1; io_mod:=i;
  i:=i+1; op_mod:=i;
  i:=i+1; gar_mod:=i;
  i:=i+1; rad_mod:=i;
  i:=i+1; vt_mod:=i;

<* initialisering af operationstyper *>

  sys_optype:=false add (1 shift sys_mod);
  io_optype:= false add (1 shift io_mod);
  op_optype:= false add (1 shift op_mod);
  gar_optype:=false add (1 shift gar_mod);
  rad_optype:=false add (1 shift rad_mod);
  vt_optype:= false add (1 shift vt_mod);
  gen_optype:=false add (1 shift 11);

<* initialisering af fieldvariable for operationer *>

  i:=2;    kilde:=i;
  i:=i+4;  tid:=i;
  i:=i+2;  retur:=i;
  i:=i+2;  opkode:=i;
  i:=i+2;  resultat:=i;
  i:=i+0;  data:=i;

<* initialisering af trimme-variable *>

  max_antal_operatører:=8;
  max_antal_garageterminaler:=7;
  max_antal_garager:=99;
  max_antal_radiokanaler:=16;
  max_antal_pabx:= 2;
  max_antal_kanaler:= 14; <* 1 pabx + 13 radio *>
  max_antal_områder:= 11;
  max_antal_mobilopkald:= 32;
  min_antal_nødopkald:= 6;
  max_antal_grupper:= 16;
  max_antal_gruppeopkald:= 16;
  max_antal_spring:= 16;
  max_antal_busser:= 2000;
  max_antal_linie_løb:= 2000;
  max_antal_fejltekster:=20;
  max_linienr:= 999; <*<=999*>
\f

message sys_parameterinitialisering side 5 - 880901/cl;

<* initialisering af konsol-navn *>
  raf:= 0;
  if findfpparam(<:io:>,false,ia)>0 then
  begin
    for i:= 1 step 1 until 4 do konsol_navn(i):= ia(i);
  end
  else
    movestring(konsol_navn.raf,1,<:console1:>);

<* initialisering af terminalnavn med ikke eksisterende 'terminal0' *>

  raf:= 0;
  movestring(terminal_navn.raf,1,<:terminal0:>);

<* initialisering af garageterminalnavn med ikke eksisterende 'garage0' *>

  movestring(garage_terminal_navn.raf,1,<:garage0:>);

<* initialisering af radiokanalnavne *>

  movestring(radio_fr_in_navn.raf,1,<:frinput:>);
  movestring(radio_fr_out_navn.raf,1,<:froutput:>);
  movestring(radio_rf_in_navn.raf,1,<:rfinput:>);
  movestring(radio_rf_out_navn.raf,1,<:rfoutput:>);

<* initialisering af 'input'-alfabet *>

  isotable(alfabet);
  alfabet('esc'):= 8 shift 12 + 'esc';
  <* for i:='a' step 1 until 'å' do alfabet(i):=alfabet(i)-32; *>
  intable(alfabet);

<* initialsering af tf_systællere *>

tf_systællere:= 1024<*tabelfil*> + 8;

:4: sys: erklæringer
\f

message sys_erklæringer side 1 - 810406/cl,hko;

zone
  zdummy(1,1,stderror),
  zbillede(128,1,stderror);

real array fejltekst(1:max_antal_fejltekster);

integer array område_id(1:max_antal_områder,1:2),
              pabx_id(1:max_antal_pabx),
              radio_id(1:max_antal_radiokanaler),
              kanal_id(1:max_antal_kanaler),
              opkalds_tællere(1:(max_antal_områder*3));
boolean array
  operatør_auto_include(1:max_antal_operatører);

long array område_navn(1:max_antal_områder),
           kanal_navn(1:max_antal_kanaler);
\f

message procedure findområde side 1 - 880901/cl;

integer procedure findområde(omr);
  value                      omr;
  integer                    omr;
begin
  integer i;

  if omr = '*' shift 16 then findområde:= -1 else
  begin
    findområde:= 0;
    for i:= 1 step 1 until max_antal_områder do
      if (extend omr) shift 24=område_navn(i) then findområde:= i;
  end;
end;
\f

message procedure tæl_opkald side 1 - 880926/cl;

procedure tæl_opkald(område,type);
  value              område,type;
  integer            område,type;
begin
  integer zi;
  integer array field iaf;

  iaf:= 0;
  increase(opkalds_tællere((område-1)*3+type));

  disable begin
    skrivfil(tf_systællere,1,zi);
    tofrom(fil(zi).iaf,opkalds_tællere,max_antal_områder*6);
    setposition(fil(zi),0,0);
  end;
end;

procedure skriv_opkaldstællere(z);
  zone                         z;
begin
  integer omr,typ;

  write(z,"nl",2,<:+++++ opkaldstællere +++++:>,"nl",2,
    <:omr          ud ind-alm ind-nød:>,"nl",1);
  for omr:= 1 step 1 until max_antal_områder do
  begin
    write(z,true,6,string område_navn(omr),":",1);
    for typ:= 1 step 1 until 3 do
      write(z,<< ddddddd>,opkalds_tællere((omr-1)*3+typ));
    outchar(z,'nl');
  end;
end;
\f

message procedure start_operation side 1 - 810521/hko;

  procedure start_operation(op_ref,kor,ret_sem,kode);
    value                          kor,ret_sem,kode;
    integer array field     op_ref;
    integer                        kor,ret_sem,kode;
<*
      op_ref:  kald, reference til operation

      kor:     kald, kilde= hovedmodulnr*100 +løbenr
                          = korutineident.
      ret_sem: kald, retursemafor

      kode:    kald, suppl shift 12 + operationskode

      proceduren initialiserer  en operations hoved med
      parameterværdierne samt tidfeltet med aktueltid.
      resultatfelt og datafelter nulstilles.

*>
    begin
      integer i;
      d.op_ref.kilde:= kor;
      systime(1,0,d.op_ref.tid);
      d.op_ref.retur:=ret_sem;
      d.op_ref.op_kode:=kode;
      d.op_ref.resultat:=0;
      for i:=(d.op_ref.opsize-data)//2 step -1 until 1 do
        d.op_ref.data(i):=0;
    end start_operation;
\f

message procedure afslut_operation  side 1 - 810331/hko;

procedure afslut_operation(op_ref,sem);
  value                    op_ref,sem;
  integer                  op_ref,sem;
  begin
    integer array field op;
    op:=op_ref;
    if sem>0 then signal_ch(sem,op,d.op.optype) else
    if sem=-1 then signal_ch(d.op.retur,op,d.op.optype) else
    ;
  end afslut_operation;
\f

message procedure fejlreaktion - side 1 - 810424/cl,hko;

procedure fejlreaktion(nr,værdi,str,måde);
  value nr,værdi,måde;
  integer nr,værdi,måde;
  string str;
begin
disable begin
  write(out,<:<10>!!! :>);
  if nr>0 and nr <=max_antal_fejltekster then
      write(out,string fejltekst(nr))
  else write(out,<:fejl nr.:>,nr);
  outchar(out,'sp');
  if måde shift (-12) extract 2=1 then outintbits(out,værdi)
  else write(out,værdi);
  write(out,"sp",1,str,"nl",1,<< zddddd>,systime(5,0,r),r,
            <: korutine nr=:>,<<d>, abs curr_coruno,
            <: ident=:>,curr_coruid,"nl",0);
  if testbit27 and måde extract 12=1 then
    trace(1);
  ud;
end;<*disable*>
  if måde extract 12 =2 then trapmode:=1 shift 13;
  if måde extract 12= 0 then trap(-1)
  else if måde extract 12 = 2 then trap(-2);
end fejlreaktion;

procedure trace(n);
  value         n;
  integer       n;
  begin
    trap(finis);
    trap(n);
finis:
  end trace;
\f

message procedure overvåget side 1 - 810413/cl;

boolean procedure overvåget;
begin
  disable begin
    integer i,måde;
    integer array field cor;
    integer array ia(1:12);

    i:= system(12,0,ia);
    if i > 0 then
    begin
      i:= system(12,1,ia);
      måde:= ia(3);
    end
    else måde:= 0;

    if måde<>0 then
    begin
      cor:= coroutine(abs ia(3));
      overvåget:= d.cor.corutestmask shift (-11);
    end
    else overvåget:= cl_overvåget;
  end;
end;
\f

message procedure trunk_til_omr side 1 - 881006/cl;

integer procedure trunk_til_omr(trunk);
  value trunk; integer trunk;
begin
  integer i,j;

  j:=0;
  for i:= 1 step 1 until max_antal_områder do
    if område_id(i,2) extract 12 = trunk extract 12 then j:=i;
  trunk_til_omr:=j;
end;

integer procedure omr_til_trunk(omr);
  value omr; integer omr;
begin
  omr_til_trunk:= område_id(omr,2) extract 12;
end;

integer procedure port_til_omr(port);
  value port; integer port;
begin
  if port shift (-6) extract 6 = 2 then
    port_til_omr:= pabx_id(port extract 6)
  else
  if port shift (-6) extract 6 = 3 then
    port_til_omr:= radio_id(port extract 6)
  else
    port_til_omr:= 0;
end;

integer procedure kanal_til_port(kanal);
  value kanal; integer kanal;
begin
  kanal_til_port:= kanal_id(kanal) shift (-5) extract 3 shift 6 +
                   kanal_id(kanal) extract 5;
end;

integer procedure port_til_kanal(port);
  value port; integer port;
begin
  integer i,j;

  j:=0;
  for i:= 1 step 1 until max_antal_kanaler do
    if kanal_id(i) = port shift (-6) shift 5 + port extract 5 then j:=i;
  port_til_kanal:= j;
end;

integer procedure kanal_til_omr(kanal);
  value kanal; integer kanal;
begin
  kanal_til_omr:= port_til_omr( kanal_til_port(kanal) );
end;

:5: sys: initialisering
\f

message sys_initialisering side 1 - 810601/hko;

  trapmode:= 1 shift 15;
  trap(coru_term);

  open(zbillede,4,<:billede:>,0);
  write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
        <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);

  for i:=1 step 1 until max_antal_fejltekster do
    fejltekst(i):= real (case i of (
<* 1*><:filsystem:>,
<* 2*><:operationskode:>,
<* 3*><:programfejl:>,
<* 4*><:monitor<'_'>resultat=:>,
<* 5*><:læs<'_'>fil:>,
<* 6*><:skriv<'_'>fil:>,
<* 7*><:modif<'_'>fil:>,
<* 8*><:hent<'_'>fil<'_'>dim:>,
<* 9*><:sæt<'_'>fil<'_'>dim:>,
<*10*><:vogntabel:>,
<*11*><:fremmed operation:>,
<*12*><:operationstype:>,
<*13*><:opret<'_'>fil:>,
<*14*><:tilknyt<'_'>fil:>,
<*15*><:frigiv<'_'>fil:>,
<*16*><:slet<'_'>fil:>,
<*17*><:ydre enhed, status=:>,
<*18*><:tabelfil:>,
<*19*><:radio:>,
<*20*><:mobilopkald, bus:>,
<*99*><:ftslut:>));

for i:= 1 step 1 until max_antal_områder do
begin
  område_navn(i):= long (case i of
    (<:TLF:>,<:VHF:>,<:TCT:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
     <:KJ:>,<:HI:>,<:HG:>,<:BA:>) ); 
  område_id(i,1):= område_navn(i) shift (-24) extract 24;
  område_id(i,2):= 
    (case i of ( 2,  3, 13,  3,  3,  3,  3,  3,  3,  3,  3)) shift 6 add
    (case i of ( 2,  5,  2,  9, 10, 11, 12, 13, 14, 15, 16));
end;

pabx_id(1):= -1;
pabx_id(2):= 1;

for i:= 1 step 1 until max_antal_radiokanaler do
begin
  radio_id(i):= 
    case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
end;

for i:=1 step 1 until max_antal_kanaler do
begin
  kanal_navn(i):= long (case i of (
    <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
    <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
  kanal_id(i):= 
    (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
    (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
end;

for i:= 1 step 1 until max_antal_operatører do
  operatør_auto_include(i):= false;
for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
  operatør_auto_include(ia(i)):= true;

:6: sys: trapaktion
\f

message sys trapaktion side 1 - 810521/hko/cl;

  trap(finale);
  write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
  for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
  begin
    k:= 0;
    write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
      <:timerqueue->:>));
    iaf:= i;
    for iaf:= d.iaf.next while iaf<>i do
    begin
      ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
      write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
      k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
    end;
  end;
  outchar(zbillede,'nl');

  skriv_opkaldstællere(zbillede);


:7: sys: finale
\f

message sys_finale side 1 - 810428/hko;

finale:

algol_pause:=algol_pause shift 24 shift (-24);
<* endaction:=0; *>
▶EOF◀