DataMuseum.dk

top - metrics - download

    Length: 7184 (0x1c10)
    Types: TextFile
    Names: »DEQ.S«

└─⟦881c1028e⟧ Bits:30005102 8" CR80 Floppy CR80FD_0061 ( VOL: SCC.V NSC Directory: Queue_test.D )
    └─⟦4f56469eb⟧ 
        └─⟦this⟧ »QUEUE_TEST.D!DEQ.S« 

TextFile

MAINMODULE DEQ;
%LIST
"---------------------------------------------------------------
"  DEQUEUE UTILITY
"---------------------------------------------------------------
"  READS ALL MTCB'S AND POSSIBLE
"  ASSOCIATED MESSAGE FILES FROM A
"  QUEUE SPECIFIED BY TERMINAL AND
"  QUEUE NUMBER. A READING FROM A TERMINAL
"  GROUP IS MADE IF QUE=-1;
"  CALL:
"       DEQ    MTCB: <MTCB_FILE>  MSG: <MESSAGE FILE>
"                    TER=XX       QUE=YY
"
%SOURCE @**GENS.D*SWELLPREFIX.D*GENERALPARAMS.S
%SOURCE @**GENS.D*SWELLPREFIX.D*MONITORNAMES.S
%SOURCE @**GENS.D*SWELLPREFIX.D*IOSPARAMS.S

%SOURCE @**SCCNAMES.D*SCCNAME.N
%SOURCE @**SCCNAMES.D*SCCDATA.N
%SOURCE @**SCCNAMES.D*NSSMTCB.N
%SOURCE @**SCCNAMES.D*SCC_PROCESS.N
%SOURCE @**NM_NAMES.D*SUPPORT.N
%SOURCE @**NM_NAMES.D*QACCESS_TYPES.S


IMPORT PROCEDURE MTCBMINIT(R3;R6):ERROR_DONE;

%SOURCE @**GENS.D*UTILITYHELP.D*UTH.I

%LIST
%PRINT

"     REDEFINITION OF MON INFILE,INELEMENT EXIT VALUES:
"
CONST
  INFIOERROR=      IF_ERROR;      
  INFSYNTAX=       IF_SYNTAX;

  INELERROR=       IE_ERROR;
  INELNUMBER=      IE_NUMBER;
  INELID=          IE_IDENTIFIER;
  INELSPECIAL=     IE_SPECIAL;

TYPE
  INFID_EXIT=      INFILEID_EXITS;
  INEL_EXIT=       INELEMENT_EXITS;


VAR
  Q_CTBL: QIOCB;
  MTCB_BUF: ARRAY[0..SIZE(REAL)-1] OF INTEGER;
  MTCB_INDX: INTEGER;
  TER_NO:    INTEGER;
  QUE_NO:    INTEGER;
  QUE_NO_DEL:INTEGER;
  MSGFILETYPE:   FILETYPE;
  QUEFILETYPE:   FILETYPE;
  MTCBFILETYPE:  FILETYPE;
  SIGNAL_NAME1:  PROCESS_NAME;
INIT
  QUEFILETYPE.NAME = 'Q MON CALL(:0:)(:0:)';

CONST
  Q_FIRSTENTRY = 1;

%SOURCE READUSERPARAMS.S

%SOURCE WRITEINTEGERS.S
"---------------------------------------------------------------
PROCEDURE DEQUEUED(R6);

VAR SAV6: INTEGER;
"---------------------------------------------------------------
BEGIN
  R6 => SAV6;
  ADDRESS(Q_CTBL) => R4;
  TER_NO => R0;
  QUE_NO => R1;
  R0 => R4@QIOCB.W1;
  R1 => R4@QIOCB.W2;
  IF R1 = -1
    THEN
      BEGIN "READ FROM GROUP
        SWITCH MON(QACCESS,READ_GR_EL,R4,R7): X2 TO
          ERR:
            FILEERROR(ADDRESS(QUEFILETYPE) => R4,ADDRESS('READ Q-GROUP(:0:)')=>R5,R7,R6); 
        END;
        R4@QIOCB.W5 => R1 => QUE_NO_DEL;
      END
    ELSE
      BEGIN
        R1 => QUE_NO_DEL;
        Q_FIRSTENTRY => R2 => R4@QIOCB.W3;
        SWITCH MON(QACCESS,READ_NON,R4,R7): X2 TO
          ERR: 
            FILEERROR(ADDRESS(QUEFILETYPE) => R4,ADDRESS('READ ELEMENT(:0:)')=>R5,R7,R6);
        END;
      END
  "END IF";
  R4@QIOCB.W1 => R2 => MTCB_INDX;
  EXIT(SAV6);
END;
"---------------------------------------------------------------
PROCEDURE DELETEQENTRY(R6);

VAR
  SAV6: INTEGER;
"---------------------------------------------------------------
BEGIN
  R6 => SAV6;
  ADDRESS(Q_CTBL) => R4;
  TER_NO => R0 => R4@QIOCB.W1;
  QUE_NO_DEL => R1 => R4@QIOCB.W2;
  Q_FIRSTENTRY => R2 => R4@QIOCB.W3;
  SWITCH MON(QACCESS,DEL,R4,R7): X2 TO
    ERR:
      FILEERROR(ADDRESS(QUEFILETYPE) => R4,ADDRESS('DELETE ELEMENT(:0:)')=>R5,R7,R6);
  END;
  EXIT(SAV6);
END;
"---------------------------------------------------------------
PROCEDURE WRITEMTCBD(R6);

VAR
  SAV6: INTEGER;
CONST
  LINE_INTEGER_COUNT = 10;
"---------------------------------------------------------------
BEGIN
  R6 => SAV6;
  MTCB_INDX => R0;
  ADDRESS(MTCB_BUF) => R1;
  SWITCH MON(MTCB,READ,R0,R1,R7): X2 TO
    ERR:
      FILEERROR(ADDRESS(QUEFILETYPE) => R4,ADDRESS('READMTCB(:0:)')=>R5,R7,R6);
  END;
  IF R1@INTEGER = MTCB_P
    THEN SIZE(PSEUDO) => R2
    ELSE SIZE(REAL) => R2
  "END IF";
  LINE_INTEGER_COUNT => R0;
  ADDRESS(MTCBFILETYPE) => R4;
  WHILE R2 >= R0 DO
    BEGIN
      WRITEINTEGERS(R0,R1,R4,R6);
      R1+R0;
      R2-R0;
    END
  "END WHILE";
  IF R2 >= 0
    THEN
      BEGIN
        R2 => R0;
        WRITEINTEGERS(R0,R1,R4,R6);
      END
  "END IF";
  R4@FILETYPE.S => R4;
  SWITCH MON(STREAM,OUTNL,R4,R7): X2 TO
    ERR:
      FILEERROR(ADDRESS(MTCBFILETYPE) => R4,ADDRESS('NL TO FILE (:0:)')=>R5,R7,R6);
  END;
  SWITCH MON(STREAM,FLUSH,R4,R7): X2 TO
    ERR:
      FILEERROR(ADDRESS(MTCBFILETYPE) => R4,ADDRESS('FLUSH (:0:)')=>R5,R7,R6);
  END;
  EXIT(SAV6);
END;
"---------------------------------------------------------------
PROCEDURE WRITEMSGD(R6);

VAR
  SAV6: INTEGER;
CONST
  BUF_SZ = 10;
  MAX_FILESIZE = 1000;            "  INTEGERS
VAR
  MSG_BUF: ARRAY[0..BUF_SZ-1] OF INTEGER;
  MTCB_FADDR: FILE_ADDRESS;
  INTEGER_CNT: INTEGER;
  READ_SWITCH: INTEGER;
CONST
  READING = 0;
  STOPREAD = 1;
"---------------------------------------------------------------
BEGIN
  R6 => SAV6;
  MTCB_INDX => R0;
  ADDRESS(MTCB_FADDR) => R1;
  SWITCH MON(MTCB,GETFILE,R0,R1,R7): X2 TO
    ERR:
      FILEERROR(ADDRESS(QUEFILETYPE) => R4,ADDRESS('GETFILE(:0:)')=>R5,R7,R6);
  END;
  R4 => QUEFILETYPE.F;
  ADDRESS(QUEFILETYPE) => R4;
  OPENSTREAM(R4,INPUT_MODE => R3,R6);
  ADDRESS(MTCB_FADDR) => R1;
  R4@FILETYPE.S => R4;
  SWITCH MON(STREAM,SETPOSITION,R1,R4,R7): X2 TO
    ERR:
      FILEERROR(ADDRESS(QUEFILETYPE) => R4,ADDRESS('SETPOSITION(:0:)')=>R5,R7,R6);
  END;
  READING => R0 => READ_SWITCH;
  MAX_FILESIZE => R0 => INTEGER_CNT;
  REPEAT
    ADDRESS(MSG_BUF) => R1;
    BUF_SZ*2 => R2;
    QUEFILETYPE.S => R4;
    SWITCH MON(STREAM,INREC,R1,R2,R4,R7): X2 TO
      ERR:
        IF R7 = EOF
          THEN STOPREAD => R0 => READ_SWITCH
          ELSE
            FILEERROR(ADDRESS(QUEFILETYPE) => R4,
            ADDRESS('READ RECORD(:0:)') => R5,R7,R6);
        "END IF";
    END;
    R2+1 SHIFTLL 1 => R0;
    ADDRESS(MSGFILETYPE) => R4;
    WRITEINTEGERS(R0,R1,R4,R6);
    INTEGER_CNT => R2-R0 => INTEGER_CNT;
    IF R2 < 0
      THEN STOPREAD => R2 => READ_SWITCH;
  UNTIL READ_SWITCH => R2 = STOPREAD;
  R4@FILETYPE.S => R4;
  SWITCH MON(STREAM,OUTNL,R4,R7): X2 TO
    ERR:
      FILEERROR(ADDRESS(MSGFILETYPE) => R4,ADDRESS('OUTPUT NL(:0:)')=>R5,R7,R6);
  END;
  SWITCH MON(STREAM,FLUSH,R4,R7): X2 TO
    ERR:
      FILEERROR(ADDRESS(MSGFILETYPE) => R4,ADDRESS('FLUSH(:0:)')=>R5,R7,R6);
  END;
  CLOSESTREAM(ADDRESS(MTCBFILETYPE)=>R4,R6);
  DISMANTLEFILE(R4,R6);
  EXIT(SAV6);
END;

LABEL DEQ_CONTINUE;
"---------------------------------------------------------------
BEGIN
  SWITCH MTCBMINIT(MAC_ALL => R3,R6):ERROR_DONE TO
    ERR:
      BEGIN
        R7 => R0;
        R6 => R1;
        SETS(R0,15);
        MON (TERMINATE,R0,R1,R7);
      END;
  END;
  ACCEPTFILES(R6);
  READSYSPARAMS(R6);
  ADDRESS(MTCBFILETYPE) => R4;
  ADDRESS(COUTFILETYPE) => R5;
  R5@FILETYPE.F => R3 => R4@FILETYPE.F;
  R5@FILETYPE.S => R3 => R4@FILETYPE.S;
  MOVM(SIZE(FILE_NAME), R5@FILE_NAME, R4@FILE_NAME);
  ADDRESS(MSGFILETYPE) => R4;
  ADDRESS(COUTFILETYPE) => R5;
  R5@FILETYPE.F => R3 => R4@FILETYPE.F;
  R5@FILETYPE.S => R3 => R4@FILETYPE.S;
  MOVM(SIZE(FILE_NAME), R5@FILE_NAME, R4@FILE_NAME);
  READUSERPARAMS(R6);
  CLOSESTREAM(ADDRESS(PFILETYPE) => R4,R6);
  DISMANTLEFILE(R4,R6);
  ADDRESS(MTCBFILETYPE) => R4;
  OPENSTREAM(R4,OUTPUT_MODE => R3,R6);
  ADDRESS(MSGFILETYPE) => R4;
  OPENSTREAM(R4,OUTPUT_MODE => R3,R6);
DEQ_CONTINUE:
  DEQUEUED(R6);
  WRITEMTCBD(R6);
  ADDRESS(MTCB_BUF) => R4;
  IF R4@INTEGER = MTCB_R
    THEN
      BEGIN
        WRITEMSGD(R6);
      END;
  DELETEQENTRY(R6);
  GOTO DEQ_CONTINUE
END;
ENDMODULE L