DataMuseum.dk

top - metrics - download

    Length: 5504 (0x1580)
    Types: TextFile
    Names: »TPDEMO.SA«

└─⟦909f4eb2b⟧ Bits:30009789/_.ft.Ibm2.50006622.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »TPDEMO.SA« 
└─⟦e12db5ad4⟧ Bits:30009789/_.ft.Ibm2.50007357.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »TPDEMO.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
*****************************************************************å
 
æ$h=0å æ no heap space å
object program Appl;
CONST
  orgSys = 7; ædummy valyeå
æ$L-å
æ$F=FAMILY.UNIV.IDå
æ$F=FAMILY.KNEL.IDå
æ$F=FAMILY.IOSYS.IDå
æ$F=FAMILY.ALLOC.IDå
æ$F=FAMILY.SCHED.IDå
æ$F=FAMILY.OBJDIR.IDå
æ$F=FAMILY.APPLI.IDå
æ$F=PASINCLU.MIKTYPES.SAå
æ$F=PASINCLU.TERMTOOL.SAå
æ$L+å
 
function retRes
  (main,
   family,
   argNo: integer)
  : resultType;
  var res: resultType;
begin
  res.main:=main;
  res.family:=family;
  res.argNo:=argNo;
  res.orgNo:=0;
  res.orgSys:=7;
  retRes:=res;
end;
 
function random (var seed : integer ) : integer;
  const
    mult  = 50767;
    incr  = 49999;
    modul = 99991;
  begin
    random := abs(seed);
    seed := (mult * seed + incr) mod modul;
  end;
 
ælocal definitionså
type
  demoLocals = record
    code      : ^^;
    stubRef   : ^^ ObjDir;
    fao       : faoRefType;
    stdin     : faoRefType;
    stdout    : faoRefType;
    stderror  : faoRefType;
  end;  ædemoLocalså
 
program ImplAppl object Application with demoLocals;
 
procedure checkOk
  (res: resultType;
   text: shortId);
  var line: threeLines;
begin
  if res.main<>ok then begin
    putError(line,res,text,0);
    res:=termIo(stdout,WriteSeq,line);
    if res.main=ok then exception(retRes(GiveUp,Universal,0))
    else exception(res);
  end;
end æ***checkOk***å;
 
ENTRY Run æfileEnv, jobSys; progrId (,text...)å
    with record
      tt: ^^;
      filsys: ^^ IoSys;
    end;
  const
    bufsize = 256;
  var
    i: integer;
    filesize, used, no, seed, key, pos: integer;
    clearline: arrayÆ1..75Å of char;
    buf : array Æ1..bufsizeÅ of byte;
    line : array Æ1..85Å of char;
    res : resultType;
    masterFile: shortid;
    optionArg : shortid;
    oneline: boolean;
begin
  in
    CheckOk(Copy(fileEnv^^Æ1Å,stdin),'');
    CheckOk(Copy(fileEnv^^Æ2Å,stdout),'');
    CheckOk(Copy(fileEnv^^Æ3Å,stderror),'');
    æoutput welcome message on terminalå
      clearText(line);
      putText(line,'tpdemo  release 00.02   83-07-01');
      putNL(line);
      for i:=2 to 74 do clearlineÆiÅ:=' ';
      clearlineÆ1Å:=chr(13); clearlineÆ75Å:=chr(13);
      check(termIo(stdout,WriteSeq,line));
    æ open file "text" å
    if not NextValArg(masterFile) then
      exception(retRes(-DataValueIllegal,Universal,-2));
    if elements(masterfile)=0 then
      checkOk(retRes(DataValueIllegal,Universal,-1),'');
    i:=1;
    while masterfileÆiÅ=' ' do begin
      i:=i+1;
      if i>elements(masterfile) then
        checkOk(retRes(DataValueIllegal,Universal,-1),'');
    end;
    CheckOk(stubRef.GetRef(out filsys;
             masterFileÆi..elements(masterfile)Å,out used, 0),
             masterFileÆi..elements(masterfile)Å);
    used:=used+i-1;
    CheckOk(filsys.Assign(out fao;
                masterFileÆused+1..elements(masterFile)Å,ReadRight),
                masterFileÆused+1..elements(masterFile)Å);
 
    æ check echo option - "O(neline)" means echo on same line å
    oneline := false;
    if nextValArg(optionArg) then
      if elements(optionArg) > 0 then
        oneline := (optionArgÆ1Å='o') or (optionArgÆ1Å='O');
 
    æ read records randomly from file å
    filesize := wordmax;
    while true do
    begin
      clearText(line);
      if oneline then
        putText(line,clearline)
      else
        putNl(line);
      checkOk(termIo(stdOut,writeSeq,line),'');
      pos := 1;
      no := 0;
      repeat
        no := no+1;
        key := random(seed) mod filesize;
        res:=fao.ReadRandom (var in out buf ;
                                   out used, key,out key);
        if res.main=ok then begin
          clearText(line);
          putInt(line,key ,8);
          checkOk(termIo(stdout,WriteSeq,line),'');
        end else begin
          æ error in ReadRandom, if unknown block then reduce filesize
            and read again
          å
          if (res.Family=IoFamily) and (res.main=-PosOutsideRange) then
          begin
            filesize := key - 1;
            no := no-1;
          end else
            if (res.orgSys=Universal) and (res.Family=dummyfied-1) then begin
              clearText(line);
              putText(line,'***Program status: File System removed ');
              putNL(line);
              exception(termIo(stdout,WriteSeq,line));
            end else
              checkOk(res,'');
        end;  æ error in Read å
      until no = 9 ;
    end;  æ while true å
  do begin
    res:=getException;
    res.orgNo:=0;
    res.orgSys:=7;
  end;
  ObjReturn(res);
end;  æ Run å
 
entry pascalerror with record tt:^^ end;
begin end;
 
  otherwise unknownCall with record tt:^^; end;
  begin
    exception (retRes(-EntryIllegal,Universal,2));
  end;
 
end;  æ DemoImplement å
 
initialize ImplAppl 'tpdemo':
           stubRef 'objdir'
end.
«eof»