DUMPLIST: PROC OPTIONS(MAIN);
    /* MAILINE FOR SVXLIST -- T DOW 9/18/81.
       INVOKE AS FOREIGN COMMAND
    	DUMPLIST /FOLDSIZE=NNN /UPPER /LOWER NN[:MM]
    	DEFAULTS FOLDSIZE=100 UPPER 1:LARGEST_NO */

    %REPLACE LARGEST_NO BY 2147483646;

    DCL BUFF CHAR(32767);
    DCL CHAN FIXED BIN(31) INIT(0) /*INIT(0) BECAUSE $ASSGN GIVES ONLY WORD*/;
    DCL DEVNAME CHAR(4) INIT('TAPE');
    DCL RETSTAT FIXED BIN(31);
    DCL MSG_LEN FIXED BIN(15) INIT(0);
    DCL SYSMSG CHAR(300);
    DCL P PTR;
    P = ADDR(BUFF);
    DCL ID FIXED BIN(31) INIT(0);
    DCL IDC CHAR(5);
    DCL EOF BIT(1) INIT('0'B);
    DCL EOQ BIT(1) INIT('0'B);

    %INCLUDE $STSDEF;
    DCL PARSVXLST ENTRY(CHAR(*),PTR,PTR) RETURNS (FIXED BIN(31));
    DCL LIB$GET_FOREIGN ENTRY(CHAR(*),CHAR(*),FIXED BIN(15))
    	RETURNS(FIXED BIN(31)) OPTIONS(VARIABLE);
    DCL COMMAND_STRING CHAR(500),
    	RETURN_LENGTH FIXED BIN(15);
    DCL SVXLIST ENTRY(PTR,FIXED BIN(31),CHAR(5));
 
    DCL LIB$SYS_GETMSG ENTRY(FIXED BIN(31),FIXED BIN(15),CHAR(*),
    		FIXED BIN(31)) RETURNS(FIXED BIN(31)) OPTIONS(VARIABLE);
    DCL MTRDCNT ENTRY(FIXED BIN(31),CHAR(*),FIXED BIN(31))
    		RETURNS(FIXED BIN(31)) OPTIONS(VARIABLE);
    DCL SYS$ASSIGN ENTRY(CHAR(*),FIXED BIN(31),FIXED BIN(31) VALUE,CHAR(*))
    		RETURNS(FIXED BIN(31)) OPTIONS(VARIABLE);
    DCL SYS$DASSGN ENTRY(FIXED BIN(31) VALUE) RETURNS(FIXED BIN(31));

    DCL 1 LIST_CONTROL,
    	2 RECSIZE FIXED BIN(31) INIT(80),
    	2 NRANG   FIXED BIN(31) INIT(1),
    	2 LO	  FIXED BIN(31) INIT(1),
    	2 HI	  FIXED BIN(31) INIT(LARGEST_NO);
    DCL 1 SVX_COM EXTERNAL,
    	2 LINESLEFT  FIXED BIN(31) INIT(0),
    	2 PAGESIZE   FIXED BIN(31) INIT(60),
    	2 FOLDSIZE   FIXED BIN(31) INIT(100),
    	2 UPPER      BIT(1) INIT('1'B);

    RECSIZE = 80;
    NRANG = 1;
    LO = 1;
    HI = LARGEST_NO;
    LINESLEFT = 0;
    PAGESIZE = 60;
    FOLDSIZE = 100;
    UPPER = '1'B;
    
    STS$VALUE = LIB$GET_FOREIGN(COMMAND_STRING,,RETURN_LENGTH);
    IF STS$SUCCESS THEN DO;	
	STS$VALUE = PARSVXLST(COMMAND_STRING,ADDR(LINESLEFT),ADDR(RECSIZE));
	IF STS$SUCCESS THEN DO;
	    STS$VALUE = SYS$ASSIGN(DEVNAME,CHAN,3,);
	    IF STS$SUCCESS THEN DO;
	        CALL DOIT;
	        RETSTAT = SYS$DASSGN(CHAN);
	    END;
	    ELSE CALL ERROR;
	END;
	ELSE CALL ERROR;
    END;
    ELSE CALL ERROR;

  ERROR: PROC;
    IF STS$VALUE = 0 THEN PUT SKIP EDIT (' INVALID PARAMS')(A);
    ELSE DO;
	RETSTAT = LIB$SYS_GETMSG(STS$VALUE,MSG_LEN,SYSMSG,);
	PUT SKIP EDIT(SUBSTR(SYSMSG,1,MSG_LEN))(A);
    END;
  END ERROR;

  DOIT: PROC;
    
    CALL READER;
    DO WHILE (^EOF & ^EOQ);
      IF ID >= LO & ID <= HI THEN DO;
    	PUT STRING(IDC) EDIT(ID)(F(5));
    	CALL SVXLIST(P,RECSIZE,IDC);
      END;
      IF ID = HI THEN EOQ = '1'B;
      ELSE CALL READER;
    END;
  END DOIT;

  READER: PROC;
    STS$VALUE = MTRDCNT(CHAN,BUFF,RECSIZE);
    IF STS$VALUE ^= 1 THEN DO;
        EOF = '1'B;
        IF STS$VALUE ^= 2160 /*ENDOFFILE*/ THEN CALL ERROR;
    END;
    IF ^EOF THEN ID = ID +1;
  END READER;

  END DUMPLIST;