DataMuseum.dk

top - metrics - download

    Length: 4864 (0x1300)
    Types: TextFile
    Names: »CREATE.SA«

└─⟦909f4eb2b⟧ Bits:30009789/_.ft.Ibm2.50006622.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »CREATE.SA« 
└─⟦e12db5ad4⟧ Bits:30009789/_.ft.Ibm2.50007357.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »CREATE.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 Create;
æ$H=0  no heap spaceå
 
CONST
  ProcId = 'Create  vers  1.04  83-12-12 ';
 
æ
 
 
                 C R E A T E
 
Changes:
  vers. 1.00  83-12-06, EAR  initial version
  vers. 1.01  83-12-06, EAR  better handling of numParams
  vers. 1.02  83-12-07, EAR  remove handling of numParams
  vers. 1.03  83-12-07, EAR  extended loadName array
  vers. 1.04  83-12-12, EAR  initialize '/objdir'
 
This EOS program calls the Create entry of the local object directory
 
Program Call:
 
   create  <sourceName>  Æ<loadName>Å
 
å
 
CONST
  ResultId = 'CREATE:  sNo OrgSy Au Ar OrgNo Fa Ma';
  OrgSys   = 7016;
 
æ$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å
 
 
 
PROGRAM iCreate OBJECT Application WITH apLocals;
 
ENTRY Run  æfileEnv, jobSys ; progId Æ, options...Åå
  WITH RECORD
         t   : ^^;
         tmp : ^^;
       END;
 
 
 
CONST
æprivate error causeså
  privFam = -1;
 
  noSourceName     = 1;
  nameTooLong      = 2;
  notNumParam      = 3;
  numPSyntax       = 4;
 
VAR
  i, paramNo, used : integer;
  stop : boolean;
  line : array Æ1..90Å of char;
  loadName : array Æ1..50Å of char;
  sourceName, param : 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 CREATE ');   *e*å
 
  IN
    res := OkResult;
    xCheck ( Copy (fileEnv^^Æ1Å, stdIn));
    xCheck ( Copy (fileEnv^^Æ2Å, stdOut));
    xCheck ( Copy (fileEnv^^Æ3Å, stdError));
 
    æ Wellcome message on terminalå
    printLine (line, procId);
 
    paramNo := 1;
    IF NOT nextValArg (sourceName) THEN
      exception (makeRes (noSource, privFam, 0, 0));
 
    FOR i := 1 TO 50 DO loadNameÆiÅ := ' ';
    IF nextValArg (param) THEN stop := elements(param) = 0
                          ELSE stop := true;
    IF NOT stop THEN
    BEGIN
      used := elements(param);
      IF used > 50 THEN
        exception (makeRes (nameTooLong, privFam, paramNo, 0));
      FOR i := 1 TO used DO loadNameÆiÅ := paramÆiÅ;
    END;
æ*b*  printVar ('sourceName = ', sourceName);
      printVar ('loadName = ', loadName);       *e*å
 
    æ Create new object å
    xCheck ( pObjDir.Create (OUT tmp ; IN OUT loadName, IN sourceName));
 
    clearText (line);
    putText (line, loadName);
    putText (line, ' created');
    putNl   (line);
    xCheck (termIo (stdOut, WriteSeq, line));
  DO
    BEGIN
      res := GetException;
æ*b*  ps ('create error '); pr (res);   *e*å
      IF res.family = privFam THEN
      BEGIN
        clearText (line);
        putText (line, '***');
        CASE res.main OF
          noSourceName:
               putText (line, 'missing sourceName');
          nameTooLong:
             BEGIN
               putText (line, param);
               putText (line, ': loadName too long');
             END;
          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 createå
 
 
INITIALIZE
  iCreate 'create' :
  pObjDir  '/objdir'
 
END.  æ create å
 
«eof»