BYTE IBSTAT(2),IB(2048),NAME(80) INTEGER IC(2049) INTEGER*4 EQUTBL(402) COMMON /CLIST/ISIZE,ICMAX,IC COMMON /ERRORS/IERR,LERR,JERR COMMON /EQU/ IEMAX,IBMAX COMMON /EQUTBL/IEQMAX,EQUTBL COMMON /STACK/ IS,ISMAX,ISTACK(200) ICMAX = 2048 IEMAX = 400 IBMAX = 2047 ISMAX = 200 IMCR = 0 ! If zero no mcr commandline CALL GETMCR(NAME,ISIZ) IF(ISIZ .LE. 0) GO TO 1 ! NO MCR input line found DO 21 I = 1,ISIZ ! Find first blank char 21 IF(NAME(I) .EQ. ' ') GO TO 22 ! Found a blank GO TO 1 ! None so prompt 22 MIN = I DO 23 I = MIN,ISIZ 23 IF(NAME(I) .NE. ' ') GO TO 24 GO TO 1 24 IMCR = ISIZ - I + 1 CALL MOVEB(NAME(I),NAME,IMCR) ! Move down the string DO 25 K = IMCR+1,80 25 NAME(K) = ' ' GO TO 20 1 WRITE(5,1000) READ(5,1002,END=500) NAME ISIZ = 6 ! Potential input line size 20 CONTINUE CALL MOVEB('.CLS',NAME(7),4) NAME(11) = 0 CALL ASSIGN(1,NAME) CALL MOVEB('.LST',NAME(7),4) CALL ASSIGN(6,NAME) WRITE(6,1003) (NAME(J),J=1,6) CALL CLIST WRITE(5,1001) JERR IF(JERR .NE. 0) GO TO 100 CALL MOVEB('.OBJ',NAME(7),4) CALL CLOUT(NAME) 100 CALL CLOSE(6) IF(IMCR .GT. 0) GO TO 500 ! MCR input line so exit GO TO 1 500 CALL EXIT 1000 FORMAT('$ ENTER CLIST NAME:') 1001 FORMAT(I8' ERRORS IN COMMAND LIST') 1002 FORMAT(80A1) 1003 FORMAT(' COMMAND LIST ' 6A1//) END