⟦b47203c64⟧

TextFile



;       multi-program         * page 1    5 01 82, 13.09;  

if listing.yes
char nl ff nl

multiprog=set 1
multiprog=algol connect.no
;  multi program generering
begin
<*
Programmet laver en jobfil til 'multi-program generering',
dvs. en jobfil, der udtrækker en række programtekster fra
en contractfil og oversætter dem i et stort algolprogram.

Kald:
<wrk>=multiprog from.<con-fil> (scope.<scope>(.<doc>)) ,
_  (<start.(start-fil>)1-50)  (slut.(<slut-fil>)1-50)   (connect.(yes!no)) ,
_ <main>  (<subentry>)1-49

<con-fil> er navnet på en contract fil.
<scope> er det scope det oversatte program skal ligge på
<doc> er det document hvorpå det skal ligge
(std. scope.temp.disc)

<start-fil> er navnet på en (eller flere) filer, der indeholder
fælles erklæringer, procedurer eller initaliseringskode. 
<start-fil> skal ligge synligt for jobbet, der
oversætter. <start-fil> lægges ind forrest i det oversatte program,
og kan evt. afsluttes med noget fælles initialiserings-kode.

<slut-fil> er navnet på en fil, der bliver lagt ind i programmet,
lige før det sidste 'end'. Den skal være synlig for jobbet der oversætter.

connect.no giver oversættelse med connect.no (dvs. 1. parameter efter
programnavnet IKKE er navnet på 'current input').
(std.   connect.yes).

<main> er navnet på det oversatte program
<subentry> er det's pseudonymer

De tekstfiler, hvorfra programteksten samles SKAL have navn
på formen:  <de første max 9 tegn af oversat navn>tx
fx. fromstreg -> fromstregtx
_   selectlines -> selectlintx

Selve oversættelsen fås ved at skrive fp-kommandoen 'i <wrk>',
der slutter af med at fjerne filen <wrk>.

Hvis der er sket fejl under oversættelsen, sættes 
modebit 0
*>

\f



comment multi-program         * page 2    5 01 82, 13.09
0 1 2 3 4 5 6 7 8 9 ;  

real array
_ start_name,     <* entry navne, procedurer etc. *>
_ slut_name,      <* entry navne, afslutning *>
_ name,          <* entry navne, oversatte programmer *>
_ name_tx(1:100), <*    do.      tekster *>
_ scope_doc(1:4), <* scope og dokument *>
_ con_fil,        <* contract_file_navn *>
_ wrk_name(1:2);  <* <wrk>'s navn *>

boolean
_ connect;  _      <* connect.(yes!no) *>

integer
_ i,              <* hjælpe var. *>
_ ant_start,      <* 8*antal entries til procedurer etc. *>
_ ant_slut,       <* 8*antal entries til afslutning *>
_ max;  _         <* 8*antal entries *>

long array field
_ n_f,            <* bruges til at løbe igennem name og name_tx *>
_ f_f,            <* peger på de første 2 elementer af et array *>
_ scope_f,        <* scope fra scope_doc *>
_ doc_f;  _       <* doc   fra scope_doc *>

zone
_ z(128, 1, stderror);  <* til wrk *>

procedure isæt_tx(n, n_tx);  
long array        n, n_tx;  
begin
  integer pos;  
  <* proceduren indsætter 'tx' i halen på navnet i 'n' *>
  putchar(n_tx, 1, 'nul', 12);  <* p.g.a. fejl i algol *>
  pos:= 1;  
  puttext(n_tx, pos, n, -9);  
  putchar(n_tx, pos, 't');  
  putchar(n_tx, pos, 'x');  
  putchar(n_tx, pos, 'nul');  
end <**isæt_tx**>;  

\f



comment multi-program         * page 3    5 01 82, 13.09
0 1 2 3 4 5 6 7 8 9 ;  

begin <* blok til fp *>
  integer array desc(1:51);  
  integer item;  

  if -, check_fp_call(item) then system(9, item, <:<10>fp-err:>);  

  <* <wrk>= *>
  if -, fp_res_file(wrk_name) then
  _ system(9, 0, <:<10>-wrk:>);  

  <* from.<con_fil> *>
  if -, fp_name_param(<:fr:>, con_fil, <::>) or con_fil(1)=real <::> then
  _ system(9, 0, <:<10>-from:>);  

  <* scope.<scope>(.<doc>) *>
  if -, fp_param(<:sc:>, desc, scope_doc) then
  begin <* std. værdier *>
    movestring(scope_doc, 1, <:temp:>);  
    movestring(scope_doc, 3, <:disc:>);  
  end
  else if desc(1)<>1 and desc(1)<>2 then
  _ system(9, desc(1), <:<10># of scope:>)
  else
  begin
    for i:= 1 step 1 until desc(1) do
    _ if desc(i+1)<>2 then system(9, i, <:<10>scope type:>);  
    if desc(1)=1 then movestring(scope_doc, 3, <:disc:>);  
  end;  

  <* start.<start-fil>....  *>
  if -, fp_param(<:start:>, desc, start_name) then ant_start:= -1
  else if desc(1)<0 then system(9, 0, <:<10># of start:>) else
  begin
    for i:= 2 step 1 until desc(1)+1 do
    _ if desc(i) <> name_type then
    _ _ system(9, i-1, <:<10>start type:>);  
    ant_start:= desc(1)*8 - 8;  
  end;  

  <* slut.<slutfil>..... *>
  if -, fp_param(<:slut:>, desc, slut_name) then ant_slut:= -1
  else if desc(1)<=0 then system(9, 0, <:<10># of slut:>) else
  begin
    for i:= 2 step 1 until desc(1)+1 do
    _  if desc(i)<>name_type then
    _  _ system(9, i-1, <:<10>slut type:>);  
    ant_slut:= desc(1)*8 - 8;  
  end;  

  <* connect *>
  if -, fp_bool_param(<:con:>, connect, true) then
  _  system(9, 0, <:<10>connect:>);  

  <* <main>  (<subentry>) *>
  max:= fp_free_names(name, false);  
  if max<0 then system(9, -max, <:<10>free-names:>);  
  max:= max*8 - 8;  

end <* fp *>;  

\f



comment multi-program         * page 4    5 01 82, 13.09
0 1 2 3 4 5 6 7 8 9 ;  

<* lav 'tx' udgaver af navne *>
for n_f:= 0 step 8 until max do isæt_tx(name.n_f, name_tx.n_f);  

<* initialiser de øvrige felter *>
f_f:= scope_f:= 0;  
doc_f:= 8;  

open_output(z, wrk_name, 0);  

<* contract filer ud af con_file *>
write(z, "nl", 1, <:contract set.:>, con_fil.f_f);  
for n_f:= 0 step 8 until max do
_ write(z, "sp", 1, name_tx.n_f);  
for n_f:= 0 step 8 until ant_start do
_  write(z, "sp", 1, start_name.n_f);
for n_f:= 0 step 8 until ant_slut do
_  write(z, "sp", 1, slut_name.n_f);

<* opret oversat program *>
write(z, "nl", 1, name.f_f, <: = set 1 :>, scope_doc.doc_f, 
_        "nl", 1, <:if 0.no:>,
_        "nl", 1, name.f_f, <: = algol :>, 
_         if connect then <::> else <:connect.no:>);  

<* lav algol programmet *>
write(z, "nl", 1, <:begin:>, 
_        "nl", 1, <:integer prnr;:>);  

<* læg procedurer etc. ind *>
for n_f:= 0 step 8 until ant_start do
_ write(z, "nl", 1, <:algol copy.:>, start_name.n_f, ";", 1);  

<* selve kroppen (en stor case_sætning) *>
write(z, "nl", 1, <:case progentry(prnr,:>, max//8+1, <:, case prnr of (:>);  
for n_f:= 0 step 8 until max do
_ write(z, "nl", 1, "<", 1, ":", 1, name.n_f, ":", 1, ">", 1, 
_      ",", if n_f=max then 0 else 1);  
write(z, "nl", 1, <: )) of:>, 
_        "nl", 1, <:begin:>);  
for n_f:= 0 step 8 until max do
_ write(z, "nl", 1, <:algol copy.:>, name_tx.n_f, ";", 1);  
write(z, "nl", 1, <:end;:>);  

<* afslutning *>
for n_f:= 0 step 8 until ant_slut do
write(z, "nl", 1, <:algol copy.:>, slut_name.n_f, ";", 1);  
write(z, "nl", 1, <:trapmode:= 1 shift 10;:>, 
_        "nl", 1, <:outchar(out, 'nl');:>, 
_        "nl", 1, <:end;:>);  

write(z, "nl", 1, <:if warning.yes:>, 
_        "nl", 1, <:   mode 0.yes:>, 
_        "nl", 1, <:if ok.no:>, 
_        "nl", 1, <:   mode 0.yes:>);  

\f



comment multi-program         * page 5    5 01 82, 13.09
0 1 2 3 4 5 6 7 8 9 ;  

<* fjern text-entries *>
write(z, "nl", 2, <:clear temp :>);  
for n_f:= 0 step 8 until max do
_ write(z, ",", 1, "nl", 1, name_tx.n_f);  
for n_f:= 0 step 8 until ant_start do
_ write(z, ",", 1, "nl", 1, start_name.n_f);
for n_f:= 0 step 8 until ant_slut do
_ write(z, ",", 1, "nl", 1, slut_name.n_f);

<* opret subentries til programmet *>
write(z, "nl", 1, <:if 0.no:>, 
_        "nl", 1, <:(:>);  
for n_f:= 8 step 8 until max do
_ write(z, "nl", 1, name.n_f, <:= assign :>, name.f_f);  

<* scope alle entries *>
write(z, "nl", 2, <:scope :>, scope_doc.scope_f, <:.:>, scope_doc.doc_f);  
for n_f:= 0 step 8 until max do
_ write(z, "sp", 1, name.n_f);  

<* 'lookup' *>
write(z, "nl", 2, <:lookup:>);  
for n_f:= 0 step 8 until max do
_ write(z, "sp", 1, name.n_f);  

write(z, "nl", 2, <:message:>, max//8+1, <: programs translated:>);  

<* evt fejl-udskrift *>
write(z, "nl", 1, <:):>, 
_        "nl", 2, <:if 0.yes:>, 
_        "nl", 1, <: message fejl i :>, name.f_f);  

<* ryd op!!! *>
write(z, "nl", 2, <:( clear temp :>, wrk_name.f_f,  
_        "nl", 1, <:end):>, "nl", 1, "em", 3);  

close(z, true);  

trapmode:= 1 shift 10;  
outchar(out, 'nl');  
end;  

scope project multiprog
end
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦b47203c64⟧ TextFile

Derivation

TextFile
