DataMuseum.dk

top - metrics - download

    Length: 7808 (0x1e80)
    Types: TextFile
    Names: »EOSLINK.SA«

└─⟦e12db5ad4⟧ Bits:30009789/_.ft.Ibm2.50007357.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »EOSLINK.SA« 

TextFile

 
æ*****************************************************************
                        Copyright 1984 by
                        NCR Corporation
                        Dayton, Ohio  U.S.A.
                        All Rights Reserved
******************************************************************
                        EOS Software produced by:
                        NCR Systems Engineering - Copenhagen
                        Copenhagen
                        DENMARK
*****************************************************************å
 
program eoslink (input,output);
label
  start, ask, stop;
 
const
  eprel = 16;
  csrel1 = 22;
  csrel2 = 32;
 
type
  hexdigit = 0..15;
  byte     = -128..127;
  word     = -32768..32767;
  long     = integer;
 
  longtype = (single, double, four);
 
  longfield =
    record
      case longtype of
        single : (l : long);
        double : (w : packed array Æ1..2Å of word);
        four   : (b : packed array Æ1..4Å of byte);
    end; ælongfieldå
 
  rectype = (librec, eoshead1, eoshead2, code);
 
  sad =
    record
      rsv, atr : word;
      segname  : packed array Æ1..4Å of char;
      segstart : longfield;
      segsize  : longfield;
    end;
 
  mid =
    record
      first   : word;
      last    : word;
    end;
 
  progrec =
    record
      case rectype of
        librec:
          (head1 : packed array Æ1..22Å of byte;
           entry : longfield;
           head2 : packed array Æ1..22Å of byte;
           sads  : array Æ1..8Å  of sad;
           mids  : array Æ1..20Å of mid);
        eoshead1:
          (headsize : word;
           progsize : long;
           progkind : word;
           progadr  : word;
           dummy    : packed array Æ5..127Å of word);
        eoshead2:
          (eos      : packed array Æ0..127Å of word);
        code :
          (data     : packed array Æ0..255Å of byte);
    end; æprogrecå
 
  progfile = file of progrec;
 
  fname    = stringÆ40Å;
 
var
  filename, inname, outname : fname;
 
  infile, outfile : progfile;
  prog, lib       : progrec;
 
  csizefld : longfield;
 
  terminate : boolean;
  c : char;
  i, pdadr, epadr, segadr, codesec, eossec, recno, error : word;
  csadr1, csadr2 : word;
  codesize, eossize, totalsize : long;
 
procedure printhex (var lng : longfield);
  type
    index = 1..8;
  var
    i, j : index;
    val : word;
    digit : array Æ1..2Å of hexdigit;
 
  begin
    write ('$');
    for i:= 1 to 4 do
    begin
      val := lng.bÆiÅ;
      if val < 0 then val := val + 256;
      digitÆ1Å := val div 16;
      digitÆ2Å := val mod 16;
      for j := 1 to 2 do
      begin
        if digitÆjÅ < 10 then
          write (digitÆjÅ:1)
        else
          write (chr (ord('A') + digitÆjÅ - 10));
      end; æjå
    end; æiå
  end; æprinthexå
 
procedure copyrec (var terminate : boolean);
  begin
    write (outfile, prog);
    terminate := eof (infile);
    if not terminate then
    begin
      recno := recno + 1;
      read (infile, prog);
    end;
  end;  æcopyrecå
 
procedure insertlong (var adr : word;
                      lng : longfield);
  begin
    if adr > 127 then  æinsert in later sectorå
    else
    if adr = 127 then  æinsert 1st word into this sectorå
      prog.eosÆadrÅ := lng.wÆ1Å
    else
    if adr >= 0 then   æinsert both words into this sectorå
    begin
      prog.eosÆadrÅ   := lng.wÆ1Å;
      prog.eosÆadr+1Å := lng.wÆ2Å;
    end
    else
    if adr = -1 then   æinsert 2nd word into this sectorå
      prog.eosÆ0Å := lng.wÆ2Å;
    æelse field has been inserted previouslyå
 
    adr := adr - 128;
  end;  æinsertlongå
 
 
begin
æ$A=2å
 
start:
  writeln ('Type filename:');
  readln (filename);
  inname := concat (filename, '.LO');
  outname:= concat (filename, '.EO;B');
  writeln ('EOS link from ', inname, ' to ', outname);
ask:
  writeln ('Ok (y/n)?');
  readln (c);
  if (c='n') or (c= 'N') then goto start;
  if (c<>'y') and (c<>'Y') then goto ask;
 
  reset (infile, inname);
  rewrite (outfile, outname);
 
æread and save LIB header block of infileå
  if eof (infile) then
  begin
    error := 4;
    goto stop;
  end;
  read (infile, lib);
 
ætest change entry point
lib.entry.l:=16#789ABCDE; å
 
æprint LIB headerå
  writeln;
  writeln ('Loader Information Block of file: ', inname);
  writeln;
  write ('Entry point: ');
  printhex (lib.entry);
  writeln;
 
  writeln ('Program segments:');
  writeln ('   Segment   Startaddr     Segsize   Sectors');
  i:= 1;
  repeat
    write (' ':5, lib.sadsÆiÅ.segname, ' ':4);
    printhex (lib.sadsÆiÅ.segstart);
    write (' ':4);
    printhex (lib.sadsÆiÅ.segsize);
    writeln (lib.sadsÆiÅ.segsize.l div 256);
    i:= i+1;
  until lib.sadsÆiÅ.segsize.l <= 0;
  writeln;
 
æcheck LIB headerå
  csizefld := lib.sadsÆ1Å.segsize;
  codesize := csizefld.l;
  codesec  := codesize div 256;
  eossize  := lib.sadsÆ2Å.segsize.l;
  eossec   := eossize div 256;
  totalsize := codesize + eossize;
  if (i <> 3) or
     (lib.sadsÆ1Å.segname <> 'SEG1') or
     (lib.sadsÆ2Å.segname <> 'SEG2') or
     (lib.sadsÆ2Å.segstart.l <> codesize)
  then
  begin
    error := 1;
    goto stop;
  end;
 
æskip code segmentå
  for i:= 1 to codesec do
  begin
    if eof(infile) then
    begin
      error := 2;
      goto stop;
    end
    else
      get (infile);
  end;
 
æcopy EOS head to output file, inserting program size and entrypointå
  read (infile, prog);
  recno := 1;
  prog.headsize := eossize;
  prog.progsize := totalsize;
 
  æfind addr of prog-descrå
  pdadr := prog.progadr;
  if (pdadr < 0) or (odd (pdadr)) then
  begin
    error := 5;
    goto stop;
  end;
 
  æfind addr of segment-descr relative to prog descrå
  while pdadr > 255 do
  begin
    copyrec (terminate);
    if terminate then
    begin
      error := 5;
      goto stop;
    end;
    pdadr := pdadr - 256;
  end;  æpdadr > 255å
  segadr := pdadr + prog.eosÆpdadr div 2Å;
  if (segadr < pdadr) or (odd (segadr)) then
  begin
    error := 6;
    goto stop;
  end;
 
  æinsert entry point and segment sizeå
  epadr  := (pdadr + eprel) div 2;
  csadr1 := (segadr + csrel1) div 2;
  csadr2 := (segadr + csrel2) div 2;
  writeln ('EOS-head: entry point inserted in addr', epadr*2);
  writeln ('          code size   inserted in addr', csadr1*2, csadr2*2);
 
  repeat
    insertlong (epadr, lib.entry);
    insertlong (csadr1, csizefld);
    insertlong (csadr2, csizefld);
    copyrec (terminate);
  until terminate;
 
  if recno <> eossec then
  begin
    error := 3;
    goto stop;
  end;
  if epadr >= 0 then
  begin
    error := 5;
    goto stop;
  end;
  if (csadr1 >= 0) or (csadr2 >= 0) then
  begin
    error := 6;
    goto stop;
  end;
  writeln (' ':9, recno, ' sectors moved to ', outname);
 
æcopy code segment to output fileå
  reset (infile);
  get (infile);  æskip LIB headerå
  for i:= 1 to codesec do
  begin
    read  (infile, prog);
    write (outfile, prog);
  end;
  writeln ('Program: ', codesec, ' sectors moved to ', outname);
 
  if false then
  begin
stop:   æerror messageså
    write (inname);
    case error of
      1:  writeln (' is not correct load format');
      2:  writeln (' size error in SEG1 ', i, codesec);
      3:  writeln (' size error in SEG2 ', recno,eossec);
      4:  writeln (' is empty');
      5:  writeln (' illegal prog-descr address ', pdadr);
      6:  writeln (' illegal segment-descr address ', segadr);
    end;
  end;
 
end.
 
«eof»