DataMuseum.dk

top - metrics - download

    Length: 6400 (0x1900)
    Types: TextFile
    Names: »INCLUDE.SA«

└─⟦909f4eb2b⟧ Bits:30009789/_.ft.Ibm2.50006622.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »INCLUDE.SA« 
└─⟦e12db5ad4⟧ Bits:30009789/_.ft.Ibm2.50007357.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »INCLUDE.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 Include;
æ$H=0  no heap spaceå
 
CONST
  ProcId = 'Include  vers  1.00  83-12-05 ';
 
æ
 
 
                E O S - I N C L U D E
 
Changes:
  vers. 1.00  83-12-01, EAR  initial version
              83-12-02, EAR  num.parameters allowed
              83-12-05, EAR  testprint off
 
This EOS program calls the Include entry of an io system
 
Program Call:
 
   include <ioSysName> <deviceName> Æ<text params>...Å Æ#<num params>...Å
 
å
 
CONST
  ResultId = 'INCLUDE: sNo OrgSy Au Ar OrgNo Fa Ma';
  OrgSys   = 7012;
 
æ$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 iInclude OBJECT Application WITH apLocals;
 
ENTRY Run  æfileEnv, jobSys ; progId Æ, options...Åå
  WITH RECORD
         t     : ^^;
         ioSys : iosysRefType;
       END;
 
æ$Eå
 
CONST
æprivate error causeså
  privFam = -1;
 
  noIoSysParam     = 1;
  noDevName        = 2;
  paramSequence    = 3;
  numPSyntax       = 4;
 
 
VAR
  i, numCount, paramNo, used : integer;
  line : array Æ1..90Å of char;
  devName, ioSysName, param : fullId;
  res : resultType;
 
 
æ$Eå
 
PROCEDURE printLine (line : shortId;
                     txt  : shortId);
BEGIN
  clearText (line);
  putText (line, txt);
  putNl (line);
  xCheck ( termIo (stdOut, WriteSeq, line));
END;  æprintLineå
 
 
FUNCTION numParam : boolean;
  VAR
    stop : boolean;
BEGIN
æ*b*  printVar ('numParam: paramNo = ', paramNo);  *e*å
  IF numCount = 1  THEN stop := false    æfirst num param read previouslyå
  ELSE
  IF numCount = -1 THEN stop := true     æparam list exhausted previouslyå
  ELSE
  IF nextValArg (param) THEN
  BEGIN
    stop := elements(param) = 0;
    paramNo := paramNo + 1;
  END
  ELSE
    stop := true;
æ*b*  printVar ('param = ', param);
      printVar ('numCount = ', numCount);
      if stop then printText ('stop ');     *e*å
 
  IF stop THEN     æparam list exhaustedå
  BEGIN
    IF numCount = 0 THEN    æstop text param loopå
    BEGIN
      numCount := -1;  numParam := true;
    END
    ELSE
      numParam := false;
  END  æstopå
  ELSE
  BEGIN
    IF paramÆ1Å = '#' THEN
    BEGIN
      numCount := numCount + 1; numParam := true;
    END
    ELSE
    BEGIN  ætext paramå
      IF numCount > 0 THEN
        exception (makeRes (paramSequence, privFam, paramNo, 0));
             ætext params not allowed after first num paramå
      numParam := false;
    END;  ætextå
  END;  ænot stopå
æ*b*  printVar ('end numParam, numCount= ', numCount);
      printVar ('paramNo = ', paramNo);                  *e*å
END;  ænumParamå
 
 
FUNCTION numVal (param : fullId) : integer;
  VAR
    i, k, num : integer;
BEGIN
  num := 0;
  FOR i := 2 TO elements(param) DO
  BEGIN
    k := ord (paramÆiÅ) - ord ('0');
    IF (k < 0) OR (k > 9) THEN
      exception (makeRes (numPSyntax, privFam, paramNo, 0));
    num := num * 10 + k;
  END;  æfor iå
  numVal := num;
æ*b*  pss ('numVal = ', num);   *e*å
END;  ænumValå
 
æ$Eå
 
BEGIN
æ*b*   PS ('Start of INCLUDE ');   *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);
 
    numCount := 0;
    paramNo := 2;
 
    IF NOT nextValArg (ioSysName) THEN
      exception (makeRes (noIoSysParam, privFam, 0, 0));
 
    IF NOT nextValArg (devName) THEN
      exception (makeRes (noDevName, privFam, 0, 0));
 
æ*b*  printVar ('ioSysName = ', ioSysName);
      printVar ('devName = ', devName);       *e*å
    xCheck ( pObjDir.GetRef (OUT ioSys ; IN ioSysName, OUT used, OUT i));
    xCheck ( ioSys.Include ( ; devName,
                     WHILE not numParam DO (IN OUT param),
                     WHILE numParam DO (IN numVal(param))));
 
  DO
    BEGIN
      res := GetException;
æ*b*  ps ('include error '); pr (res);   *e*å
      IF res.family = privFam THEN
      BEGIN
        clearText (line);
        putText (line, '***');
        CASE res.main OF
          noIoSysParam:
               putText (line, 'missing ioSysName');
          noDevName:
               putText (line, 'missing deviceName');
          paramSequence:
             BEGIN
               putText (line, 'text param after num param');
               putInt  (line, paramNo, 4);
             END;
          numPSyntax:
             BEGIN
               putText (line, 'syntax error in num param');
               putInt  (line, paramNo, 4);
             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 eosloadå
 
INITIALIZE
  iInclude 'include' :
  pObjDir  'objdir'
 
END.  æ include å
 
«eof»