DataMuseum.dk

top - metrics - download

    Length: 3712 (0xe80)
    Types: TextFile
    Names: »ABORT.SA«

└─⟦909f4eb2b⟧ Bits:30009789/_.ft.Ibm2.50006622.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »ABORT.SA« 
└─⟦e12db5ad4⟧ Bits:30009789/_.ft.Ibm2.50007357.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »ABORT.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
*****************************************************************å
 
OBJECT PROGRAM Abort;
æ$H=0  no heap spaceå
 
CONST
  ProcId = 'Abort  vers 1.01  83-12-12   ';
 
æ
 
 
                 A B O R T
 
Changes:
  vers. 1.00  83-12-12, EAR  initial version
  vers. 1.07  83-12-12, EAR  initialize '/objdir'
 
This EOS program aborts an entry in the global Object directory
 
Program Call:
 
         abort Æ<objName>Å
 
å
 
CONST
  ResultId = 'ABORT:  sNo OrgSy Au Ar OrgNo Fa Ma';
  OrgSys   = 7018;
 
æ$Eå
æ$L-å
æ$F=FAMILY.UNIV.IDå
æ$F=FAMILY.KNEL.IDå
æ$F=FAMILY.ALLOC.IDå
æ$F=FAMILY.SCHED.IDå
æ$F=FAMILY.OBJDIR.IDå
æ$F=FAMILY.IOSYS.IDå
æ$F=FAMILY.APPLI.IDå
 
æ$F=PASINCLU.CHKPROCS.SAå
æ$F=PASINCLU.TERMTOOL.SAå
 
æ$L+å
æ*****     Local pointers     *****å
 
TYPE
 
  apLocals = RECORD
      code     : ^^;
      pobjDir  : ^^ObjDir;
      stdIn    : faoRefType;
      stdOut   : faoRefType;
      stdError : faoRefType;
   END;  æapLocalså
 
æ$Eå
 
PROGRAM iAbort OBJECT Application WITH apLocals;
 
ENTRY Run  æfileEnv, jobSys ; progId Æ, options...Åå
  WITH RECORD
         t   : ^^;
       END;
 
æ$Eå
 
CONST
  privFam = -1;
  noObjName = 1;
 
VAR
  i, used : integer;
  line : array Æ1..90Å of char;
  objName : fullId;
  res : resultType;
 
 
 
PROCEDURE printLine (line : shortId;
                     txt  : shortId);
BEGIN
  clearText (line);
  putText (line, txt);
  putNl (line);
  xCheck ( termIo (stdOut, WriteSeq, line));
END;  æprintLineå
 
æ$Eå
 
BEGIN
æ*b*   PS ('Start of ABORT ');   *e*å
 
  IN
    res := OkResult;
    xCheck ( Copy (fileEnv^^Æ1Å, stdIn));
    xCheck ( Copy (fileEnv^^Æ2Å, stdOut));
    xCheck ( Copy (fileEnv^^Æ3Å, stdError));
 
    æ take objName parameter å
    IF NOT nextValArg (objName) THEN
      exception (makeRes (noObjName, privFam, 0, 0));
æ*b*  printVar ('objName = ', objName);   *e*å
 
    xCheck ( pObjDir.AbortObj ( ; IN objName));
 
    clearText (line);
    putText (line, procId);
    putText (line, objName);
    putNl (line);
    xCheck ( termIo (stdOut, WriteSeq, line));
 
  DO
    BEGIN
      res := GetException;
æ*b*  ps ('abort error '); pr (res);   *e*å
      IF res.family = privFam THEN
      BEGIN
        clearText (line);
        putText (line, '***');
        CASE res.main OF
          noObjName:
               putText (line, 'no objName specified');
          otherwise
             BEGIN
               putText (line, 'unknown error');
               putInt  (line, res.main, 4);
             END;
        END;  æcaseå
        putNl (line);
        res.main := ok;
      END  æfamily = privFam, own error codeså
      ELSE
        putError (line, res, '', 0);
 
      res := call( termIo (stdError, writeSeq, line));
æ*b*  printVar ('error msg line = ', line);   *e*å
      ObjReturn (res);
    END;
END;  æentry Runå
 
OTHERWISE  unknown
  with record t : ^^; end;
BEGIN
  exception (makeRes (-EntryIllegal, Universal, 0, 0));
END;
 
END;  æprogram Abortå
 
INITIALIZE
  iAbort 'abort' :
  pObjDir  '/objdir'
 
END.  æ abort å
 
«eof»