 
{*****************************************************************
                        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 Init;
 
CONST
  orgSys = 7; {dummy value}
 
{$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;
 
{local definitions}
type
  demoLocals = record
    code      : ^^;
    stubRef   : ^^ ObjDir;
    stdin     : faoRefType;
    stdout    : faoRefType;
    stderror  : faoRefType;
  end;  {demoLocals}
 
program ImplAppl object Application with demoLocals;
 
procedure checkOk
  (res: resultType;
   text: shortId);
  var line: threeLines;
      i: integer;
begin
{#b#printVar('*** checkOK in Init ****, res= ',res);#e#}
  if res.main<>ok then begin
    putError(line,res,text,0);
    res:=termIo(stdError,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, used: integer;
    line : array [1..85] of char;
    res : resultType;
    masterFile: shortid;
begin
{#b#printVar('START OF TPDEMO, progrId= ',progrId);#e#}
  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,'Init  vers. 00.02   83-06-30');
      putNL(line);
      check(termIo(stdout,WriteSeq,line));
    { open file "text" }
    if not NextValArg(masterFile) then
      exception(retRes(-DataValueIllegal,Universal,-2));
{#b#printVar('OptiInit Nextvalarg= ',masterfile);#e#}
    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)]);
 
    { ignore exclude result }
    res :=  filsys.exclude(; masterFile[i+used-1..elements(masterfile)]);
    CheckOk(filsys.include(; masterFile[i+used-1..elements(masterfile)]),
                             masterFile[i+used-1..elements(masterfile)]);
  do begin
    res:=getException;
    res.orgNo:=0;
    res.orgSys:=7;
printVar('OptiInit exception= ',res);
    objReturn(res);
  end;
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 'init':
           stubRef 'objdir'
end.
