SUBROUTINE NEST(NCMD,NARGS,IARGS) C C This routine interprets the $REPT & $ENDR program directives C adjusting buffer pointers to accomplish duplication of input C text. Nine levels of input nesting are supported. C INTEGER NCMD,NARGS,IARGS(1),FSPEC(4),FSW3,I,IBLK,OLEVEL INTEGER LEVEL,NREPT,OCHAN,OBLK,OBP,LNECNT LOGICAL*1 TTIN,TTOUT BYTE OBUF,LINE COMMON /TXTW01/ LEVEL,NREPT(10),OCHAN(10),OBLK(10),OBP(10), # OBUF(512,10),TTIN,TTOUT COMMON /TXTW02/ LNECNT,LINE(135) DATA FSPEC /3RDK ,3RTXT,0,3RTMP/, FSW3/3RWR / IF(NCMD .NE. -1) GO TO 20 C C Command $REPT(?) encountered C IF(LEVEL .GE. 10) GO TO 91 !Nesting level limit exceeded LEVEL = LEVEL + 1 IF(OCHAN(LEVEL) .GE. 0) GO TO 10 OCHAN(LEVEL) = IGETC() IF(OCHAN(LEVEL) .LT. 0) GO TO 92 !Unable to allocate channel 10 OBLK(LEVEL) = 0 OBP(LEVEL) = 1 FSPEC(3) = FSW3 + LEVEL IF(IENTER(OCHAN(LEVEL),FSPEC,0) .LT. 0) GO TO 93 !ENTER failure IF(NARGS .GT. 1) GO TO 94 !Too many arguments NREPT(LEVEL) = 1 !Default - one pass IF(NARGS .EQ. 0) GO TO 15 NREPT(LEVEL) = IARGS(1) 15 RETURN C C Command $ENDR encountered C 20 IF(NCMD .NE. -2) GO TO 89 IF(NARGS .NE. 0) GO TO 94 !Too many arguments IF(LEVEL .LE. 1) GO TO 90 !Nesting underflow OLEVEL = LEVEL LEVEL = LEVEL - 1 IF(NREPT(OLEVEL) .LE. 0) GO TO 50 OBUF(OBP(OLEVEL),OLEVEL) = 0 !Install null terminator IF(OBLK(OLEVEL) .EQ. 0) GO TO 35 I = IWRITW(256,OBUF(1,OLEVEL),OBLK(OLEVEL),OCHAN(OLEVEL)) IF(I .LT. 0) GO TO 97 35 DO 1000 J = 1,NREPT(OLEVEL) IBLK = 0 IF(OBLK(OLEVEL) .EQ. 0) GO TO 45 40 I = IREADW(256,OBUF(1,OLEVEL),IBLK,OCHAN(OLEVEL)) IF(I .LT. 0) GO TO 95 45 I = KPYOUT(OBUF(1,OLEVEL)) IF(I .LT. 0) GO TO 97 IBLK = IBLK + 1 IF(IBLK .LE. OBLK(OLEVEL)) GO TO 40 1000 CONTINUE 50 CALL PURGE(OCHAN(OLEVEL)) RETURN 89 TYPE 150,LNECNT 150 FORMAT(1H0,'?TXTWRT-NEST error processing input line #',I5,':',/) CALL PRINT(LINE) STOP ' Unrecognized TXTWRT directive' 90 TYPE 150,LNECNT CALL PRINT(LINE) STOP ' Nesting level underflow' 91 TYPE 150,LNECNT CALL PRINT(LINE) STOP ' Nesting level limit exceeded' 92 TYPE 150,LNECNT CALL PRINT(LINE) STOP ' Unable to allocate channel' 93 TYPE 150,LNECNT CALL PRINT(LINE) STOP ' ENTER failure' 94 TYPE 150,LNECNT CALL PRINT(LINE) STOP ' Too many arguments' 95 TYPE 150,LNECNT CALL PRINT(LINE) GO TO (96,99,100) ,-I 96 STOP ' Attempt to read past end-of-file' 97 TYPE 150,LNECNT CALL PRINT(LINE) GO TO (98,99,100) ,-I 98 STOP ' Attempt to write past end-of-file' 99 STOP ' Hardware error occurred on specified I/O channel' 100 STOP ' Specified I/O channel is not open' END