DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »tmacro«

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦162d2eb5b⟧ »talgprog« 
            └─⟦this⟧ 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »tmacro« 

TextFile

macro=set 40
global macro
macro=algol connect.no
80-07-30
Anders Lindgård
begin
integer i,j,p,res,c,char,fp,items,exm;
boolean missing,repl;
array FP,IN,OUT(1:3),d(1:2,1:9);
boolean array des(1:9);

procedure replace(NEW);
array NEW;
begin
  integer res,h8,pda,address,h8address,disp;
  array field in,nn;
  integer array fpc(1:1);
  disp:=26; h8:=92;
  h8address:=wordload(wordload(66)+22)+h8;
  if false then write(out,"nl",1,<:h8 :>,h8address,wordload(h8address));
  address:=wordload(h8address);
  for i:=byteload(address) while i>=4 do address:=address+byteload(address+1);
  if false then write(out,"nl",1,<:last command address :>,address);
  redefarray(fpc,address-disp,disp//2);
  for i:=disp//2 step -1 until 1 do fpc(i):=0;
  in:=4; nn:=14;
  fpc(1):=2 shift 12+2;
  fpc(2):=2 shift 12+10;
  movestring(fpc.in,1,<:i:>);
  fpc(7):=4 shift 12+10;
  for i:=1,2 do fpc.nn(i):=NEW(i);
  fpc(12):=2 shift 12+2;
  fpc(13):=-4 shift 12;
  res:=lookupentry(NEW);
  i:=1;
  if res<>0  then write(out,"nl",1,"*",3,<:lookup :>,
     string fpc.nn(increase(i)),res,"nl",1);
  wordstore(h8address,address-disp);
  fpproc(7,0,0,0);
end replace;

missing:=false;
exm:='!';
items:=0;
for i:=1 step 1 until 9 do des(i):=false;
if readparam(IN)<0 then fp:=readparam(IN);
fp:=readparam(IN);
if fp=2 then
begin
  for fp:=readparam(FP) while fp<>0 and items<9 and fp<>2 do
  begin
    if fp<3 then alarm("nl",1,"*",3,<:parameter error :>,fp);
    items:=items+1;
    if fp=3 then
    begin
      des(items):=true;
      d(1,items):=FP(1);
    end else for i:=1,2 do d(i,items):=FP(i);
  end for fp;

  if false then write(out,"nl",1,<:items:>,items);
  
  res:=connectcuri(IN);
  i:=1;
  if res<>0 then alarm("nl",1,"*",3,<:connect input :>,
    string(IN(increase(i))));
  connectlso;
  if -,readlsfp(OUT) then
  begin
    generaten(OUT);
    reservesegm(OUT,1);
    connectcuro(OUT);
  end;

  for c:=readchar(in,char) while char<>25 do
  begin
    if char<>exm then outchar(out,char) else
    begin
     repeat
     readchar(in,p);
     if p=exm then outchar(out,exm);
     until p<>exm;
     p:=p-48;
     missing:=p>0 and p>items and p<10;
     if p>0 and p<=items then
     begin
       i:=1;
       if des(p) then write(out,<<d>,round d(1,p)) else
         write(out,string d(increase(i),p));
     end p legal else write(out,false add char,1,false add (p+48),1);
     end !;
   end char;
 closeout;
  if missing then write(out,"nl",1,"*",2,<:parameters missing:>) else
  begin
   i:=1;
   if false then write(out,"nl",1,<:name :>,string OUT(increase(i)));
   readbfp(<:replace:>,repl,true);
   if repl then replace(OUT);
  end;
 end fp=2;
end;
m=assign macro
global m
lookup m macro
▶EOF◀