C C COPYRIGHT Warren K. Falls. 1984, 1985. C IMPLICIT INTEGER*2 (A-Z) INTEGER*2 SELPNT(22),SELECT(400),SELCT1(80),CHOPNT(2,22) INTEGER*2 LINPNT(22),TTSTAT(2),SUB(4),LUNDAT(6),BMASK(16) INTEGER*2 PARM1(6),PARM2(6),PARM3(6),PARM4(6),PARM5(6) INTEGER*2 PARM6(6),PARM7(6),PARM8(6),PARM9(6),SPSTAT(8) INTEGER*2 IMCR(40),PARM10(6),PARMS(6) INTEGER*2 RTURN,INIT1,SILNT,LENGX,LEVEL,CLIMOD,NOMCR,SCOPE INTEGER*2 DEBUG,CALLFL,READF1,READF2,SCOPEX INTEGER*4 CLI INTEGER*4 CLICLI INTEGER*4 CLIMCR INTEGER*4 SAVCLI BYTE BIT1(132),PASS1(50),PASS2(50),ONEFIL(30) BYTE BIT(132),BMCR(80),BILNAM(30),SCREEN(1000) BYTE STRING(2000),SELCMP(22),BSBUF(3),SUBBUF(100) BYTE HELP1(50),HELP2(38),BBMCR(79),LINSUB(6,30) BYTE SELBUF(20),CURBUF(17),BTBUF(2),BTSTAT(4),TTNUM(2) BYTE NUMS(2,22),HELP3(9),SCOPEP(2) BYTE NAMSAV(10,30) BYTE CNUMS(2,80),BLIBUF(18),LSTLST(30) BYTE FILPRE(8),LSTFIL(30),GRPHBF(80),ENDBUF(80) CHARACTER BUFFER*132,MCR*80,FILNAM*30,BCKSLH*1,YESNO*4 CHARACTER TTBUF*2,SLVBUF*14,NOSLVB*16,BUFF1*132,BYE*3 CHARACTER CLIBUF*18 EQUIVALENCE (CLIBUF,BLIBUF) EQUIVALENCE (LUNDAT,SPSTAT) EQUIVALENCE (BMCR(2),BBMCR(1)) EQUIVALENCE (TTSTAT,BTSTAT) EQUIVALENCE (BIT1,BUFF1) EQUIVALENCE (SCOPEX,SCOPEP) EQUIVALENCE (BIT,BUFFER) EQUIVALENCE (TTBUF,BTBUF) EQUIVALENCE (IMCR,BMCR) EQUIVALENCE (MCR,BMCR) EQUIVALENCE (FILNAM,BILNAM) DATA FILPRE /'L','B',':','[','1',',','3',']'/ DATA CLI /6RCLI.../ DATA CLICLI /6RCLI.../ DATA CLIMCR /6RMCR.../ DATA BMASK /1,2,4,8,16,32,64,128,256,512,1024,2048,4096, 9 8192,16384,32768/ DATA PARM1 /0,1,0,0,0,0/ DATA PARM2 /0,2,0,0,0,0/ DATA PARM3 /0,17,0,0,0,0/ DATA PARM4 /0,20,0,0,0,0/ DATA PARM5 /0,3,0,0,0,0/ DATA PARM7 /0,1,0,0,0,0/ DATA PARM8 /0,2,0,0,0,0/ DATA PARM9 /0,80,0,0,0,0/ DATA PARM10 /0,12,0,0,0,0/ DATA PARMS /0,2,0,0,0,0/ DATA BSBUF /8,32,8/ DATA SELBUF /32,32,32,27,'[',48,49,59,50,52,'r', 9 27,'[',0,0,';',0,0,'H',13/ DATA BCKSLH /'\'/ DATA BYE /'BYE'/ DATA SLVBUF /'SET /SLAVE=TI:'/ DATA NOSLVB /'SET /NOSLAVE=TI:'/ DATA CLIBUF /'SET /CLI=TI: '/ DATA PASS1 /80,87,68,32,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 9 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ DATA PASS2 /80,82,86,32,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 9 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ DATA HELP1 /72,69,76,80,32,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 9 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ DATA HELP2 /80,73,80,32,84,73,58,61,0,0,0,0,0,0,0,0,0,0,0,0, 9 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ DATA HELP3 /72,69,76,80,32,77,69,78,85/ DATA NUMS /32,49,32,50,32,51,32,52,32,53,32,54,32,55,32,56, 9 32,57,49,48,49,49,49,50,49,51,49,52,49,53,49,54,49,55,49, 9 56,49,57,50,48,50,49,50,50/ DATA CNUMS /48,49,48,50,48,51,48,52,48,53,48,54,48,55,48,56, 9 48,57,49,48,49,49,49,50,49,51,49,52,49,53,49,54,49,55,49, 9 56,49,57,50,48,50,49,50,50,50,51,50,52,50,53,50,54,50,55, 9 50,56,50,57,51,48,51,49,51,50,51,51,51,52,51,53,51,54,51, 9 55,51,56,51,57,52,48,52,49,52,50,52,51,52,52,52,53,52,54, 9 52,55,52,56,52,57,53,48,53,49,53,50,53,51,53,52,53,53,53, 9 54,53,55,53,56,53,57,54,48,54,49,54,50,54,51,54,52,54,53, 9 54,54,54,55,54,56,54,57,55,48,55,49,55,50,55,51,55,52,55, 9 53,55,54,55,55,55,56,55,57,56,48/ DATA CURBUF /19,32,32,32,27,'[',0,0,';','3','H','-', 9 '>',8,8,8,17/ DATA RTURN /0/ DATA INIT1 /1/ DATA SILNT /1/ DATA LENGX /0/ DATA LEVEL /1/ DATA CLIMOD /0/ DATA NOMCR /0/ DATA DEBUG /0/ DATA SCOPE /1/ DATA CALLFL /0/ DATA SCOPEP /'12'O,1/ DATA OVERID /1/ DATA READF1 /'1000'O/ DATA READF2 /'1030'O/ C ENTRY POINT INITIALIZATION CALL ERRSET (24,.TRUE.,.FALSE.,.TRUE.,.FALSE.) CALL ERRSET (29,.TRUE.,.FALSE.,.TRUE.,.FALSE.) CALL ERRSET (64,.TRUE.,.FALSE.,.TRUE.,.FALSE.) CALL GETADR (PARM1(1),TTBUF) CALL GETADR (PARM2(1),TTBUF) CALL GETADR (PARM3(1),CURBUF) CALL GETADR (PARM4(1),SELBUF) CALL GETADR (PARM5(1),BSBUF) CALL GETADR (PARM6(1),SCREEN) CALL GETADR (PARM7(1),TTBUF) CALL GETADR (PARM8(1),TTBUF) CALL GETADR (PARM9(1),MCR) CALL GETADR (PARM10(1),SCREEN) CALL GETADR (PARMS(1),SCOPEP) SPRM10=PARM10(1) CALL GETCII (SAVCLI,4) C DETERMINE IF SCOPE OR HARD_COPY HERE CALL WTQIO ('2560'O,6,2,,,PARMS) SCOPE=SCOPEP(2) C PRIVILEGE TERMINAL CHECK CALL GETLUN (6,LUNDAT) PRVMSK=0 IF (IAND(LUNDAT(4),'000010'O) .NE. 0) PRVMSK=1 C LOAD TERMINAL NUMBER INTO "\\0" SUBSTITUTION STRING FLAGEX=IAND(LUNDAT(2),'7'O) TTNUM(2)=48+FLAGEX FLAGEX=(IAND(LUNDAT(2),'70'O))/8 TTNUM(1)=48+FLAGEX C GET COMMAND LINE AND PARSE COMMAND INVOKE TO FIRST SPACE CALL GETMCR (MCR,DSW) IF (DSW .LT. 1) GOTO 87 MLENG=1 DSW=DSW-1 DO 10, I=1,DSW MLENG=MLENG+1 IF (BMCR(I) .EQ. ' ') GOTO 11 IF (BMCR(I) .EQ. 'H') THEN SCOPE=0 SCOPEP(2)=0 ENDIF IF (BMCR(I) .EQ. 'D') DEBUG=1 IF (BMCR(I) .EQ. 'N') NOMCR=1 DSW=DSW-1 10 CONTINUE C PARSE COMMAND LINE SUBSTITUTION STRINGS 11 CONTINUE IF (BMCR(MLENG) .NE. '"') GOTO 69 LENGX=LENGX+1 IF (LENGX .EQ. 9) GOTO 87 FILIND=0 MLENG=MLENG+1 DSW=DSW-1 DO 60, I=2,DSW IF (BMCR(MLENG) .NE. '"') THEN LINSUB(LENGX,I)=BMCR(MLENG) MLENG=MLENG+1 DSW=DSW-1 GOTO 60 ELSE MLENG=MLENG+2 DSW=DSW-2 GOTO 61 ENDIF 60 CONTINUE GOTO 87 61 CONTINUE GOTO 11 C COMMON SCRIPT FILENAME PARSE ROUTINE C COMMON ENTRY FOR ALL FILE PARSE FROM P-CODE 69 CONTINUE FILIND=1 FLAGEX=0 IF (BMCR(MLENG) .NE. '$') GOTO 14 DO 12, I=1,8 BILNAM(FILIND)=FILPRE(I) FILIND=FILIND+1 12 CONTINUE MLENG=MLENG+1 DSW=DSW-1 DO 13, I=1,DSW BILNAM(FILIND)=BMCR(MLENG) IF (BILNAM(FILIND) .EQ. '.') FLAGEX=1 MLENG=MLENG+1 FILIND=FILIND+1 13 CONTINUE GOTO 20 14 CONTINUE DO 15, I=1,DSW BILNAM(FILIND)=BMCR(MLENG) IF (BILNAM(FILIND) .EQ. '.') FLAGEX=1 MLENG=MLENG+1 FILIND=FILIND+1 15 CONTINUE 20 CONTINUE IF (FLAGEX .EQ. 1) GOTO 25 BILNAM(FILIND)='.' BILNAM(FILIND+1)='S' BILNAM(FILIND+2)='C' BILNAM(FILIND+3)='R' 25 CONTINUE C FIRST TIME THRU SAVE FILENAME FOR ZERO AND PF3 COMMANDS IF (INIT1 .EQ. 0) GOTO 50 INIT1=0 DO 30,I=1,30 ONEFIL(I)=BILNAM(I) 30 CONTINUE C OPEN THE FILE 50 CONTINUE IF ((SILNT .EQ. 0) .OR. (DEBUG .EQ. 1)) TYPE 1011,FILNAM OPEN (UNIT=1,ERR=80,NAME=FILNAM,TYPE='OLD',READONLY,SHARED) C INITIALIZATION EVERY NEW SCRIPT IF (OVERID .EQ. 1) THEN CLI=CLICLI LOGOFF=0 LOCK=0 CURSOR=1 ALLOW=0 CLEAR=1 STPER=1 SILNT=1 WHOLE=1 SPWN=1 CLEARD=1 STPERD=1 SILNTD=1 WHOLED=1 SPWND=1 ENDTSK=0 READF1='1000'O READF2='1030'O PARM1(3)=0 PARM9(3)=0 ELSE CLEAR=CLEARD STPER=STPERD SILNT=SILNTD WHOLE=WHOLED SPWN=SPWND ENDIF INITP=1 GRAPHC=0 SETFLG=0 PARM10(1)=SPRM10 TOPFLG=0 OFFSET=1 STATE=1 FIRST=0 LINE=1 SEL=0 SELOFF=1 STROFF=1 IF (NOMCR .EQ. 1) THEN SILNT=0 SILNTD=0 ENDIF SELBUF(6)=48 SELBUF(7)=49 IF (SCOPEP(2) .EQ. 1) THEN SCREEN(OFFSET)='33'O OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='2' OFFSET=OFFSET+1 SCREEN(OFFSET)='4' OFFSET=OFFSET+1 SCREEN(OFFSET)=';' OFFSET=OFFSET+1 SCREEN(OFFSET)='8' OFFSET=OFFSET+1 SCREEN(OFFSET)='0' OFFSET=OFFSET+1 SCREEN(OFFSET)='H' OFFSET=OFFSET+1 SCREEN(OFFSET)='33'O OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='1' OFFSET=OFFSET+1 SCREEN(OFFSET)='J' OFFSET=OFFSET+1 SCREEN(OFFSET)='33'O OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='0' OFFSET=OFFSET+1 SCREEN(OFFSET)='1' OFFSET=OFFSET+1 SCREEN(OFFSET)=';' OFFSET=OFFSET+1 SCREEN(OFFSET)='2' OFFSET=OFFSET+1 SCREEN(OFFSET)='4' OFFSET=OFFSET+1 SCREEN(OFFSET)='r' OFFSET=OFFSET+1 ELSE SCREEN(OFFSET)='15'O OFFSET=OFFSET+1 SCREEN(OFFSET)='12'O OFFSET=OFFSET+1 ENDIF C READ RECORD -- SCRIPT PARSING LOOP C GUARD RECORD GUARD RECORD GUARD RECORD GUARD RECORD C I = 0 C READ (1,2002,END=86)LENGX,BUFF1 C IF ((LENGX .NE. 1) .OR. (BIT1(1) .NE. ']')) GOTO 86 C GUARD RECORD GUARD RECORD GUARD RECORD GUARD RECORD DO 1, I=1,32000 READ (1,2002,END=90)LENGX,BUFF1 C SUBSTITUTION ROUTINE LENGTH=0 MLENG=1 62 CONTINUE IF (LENGX .EQ. 0) GOTO 68 IF ((BIT1(MLENG) .NE. '\') .OR. (BIT1(MLENG+1) .NE. 9 '\') .OR. (LENGX .LT. 3)) GOTO 67 FLAGEX=(BIT1(MLENG+2))-48 IF ((FLAGEX .LT. 0) .OR. (FLAGEX .GT. 6)) GOTO 67 IF (FLAGEX .EQ. 0) THEN LENGTH=LENGTH+1 BIT(LENGTH)=TTNUM(1) LENGTH=LENGTH+1 BIT(LENGTH)=TTNUM(2) ELSE DO 63 ,J=1,30 IF (LINSUB(FLAGEX,J) .EQ. 0) GOTO 63 LENGTH=LENGTH+1 BIT(LENGTH)=LINSUB(FLAGEX,J) 63 CONTINUE ENDIF MLENG=MLENG+3 LENGX=LENGX-3 IF (LENGX .EQ. 0) GOTO 68 GOTO 62 67 CONTINUE LENGTH=LENGTH+1 BIT(LENGTH)=BIT1(MLENG) MLENG=MLENG+1 LENGX=LENGX-1 GOTO 62 68 CONTINUE IF ((LENGTH .GE. 132) .OR. (LENGTH .LE. 0)) GOTO 66 DO 65, J=LENGTH+1,132 BIT(J)=0 65 CONTINUE C EOR DELIMITTER CHECK 66 CONTINUE LENGX=LENGTH IF (LENGTH .EQ. 0) THEN SCREEN(OFFSET)='12'O OFFSET=OFFSET+1 SCREEN(OFFSET)='15'O OFFSET=OFFSET+1 LINE=LINE+1 GOTO 1 ENDIF BOFF=1 C RETURN POINT FOR PARTIAL RECORD 2 CONTINUE ENDMRK=INDEX(BUFFER(BOFF:),BCKSLH(1:1)) IF (ENDMRK .EQ. 0) GOTO 101 LENSAV=LENGTH LENGTH=ENDMRK-1 LENGX=LENGTH IF (LENGTH .EQ. 0) THEN SCREEN(OFFSET)=012 OFFSET=OFFSET+1 SCREEN(OFFSET)=015 LINE=LINE+1 OFFSET=OFFSET+1 GOTO 190 ENDIF C CONTROL CHARACTER PARSE 101 BOFFX=BOFF LENGX=LENGTH DHDW=0 DH=0 DO 102,J=1,LENGTH IF ((BIT(BOFF) .NE. '40'O) .AND. (BIT(BOFF) .NE. '11'O)) 9 GOTO 103 BOFF=BOFF+1 LENGTH=LENGTH-1 102 CONTINUE GOTO 110 103 CONTINUE IF (BIT(BOFFX) .EQ. ';') GOTO 190 IF (BIT(BOFF) .EQ. '135'O) GOTO 160 IF ((BIT(BOFF) .NE. '44'O) .AND. (BIT(BOFF) .NE. '45'O)) 9 GOTO 110 IF (BIT(BOFF) .NE. '45'O) GOTO 120 C HERE ON CONTROL CHARACTER "%" LENGTH=LENGTH-1 BOFF=BOFF+1 DO 122,J=1,LENGTH IF ((BIT(BOFF) .NE. '40'O) .AND. (BIT(BOFF) .NE. '11'O)) 9 GOTO 133 BOFF=BOFF+1 LENGTH=LENGTH-1 122 CONTINUE GOTO 190 133 CONTINUE C LOWERCASE CHECK CONVERT DO 1133,J=1,LENGTH IF (BIT(BOFF-1+J) .LE. ' ') GOTO 2133 IF ((BIT(BOFF-1+J) .LT. '141'O) .OR. (BIT(BOFF-1+J) 9 .GT. '172'O)) GOTO 1133 BIT(BOFF-1+J)=BIT(BOFF-1+J)-'40'O 1133 CONTINUE 2133 CONTINUE C STATE DISPATCH FOR % GOTO (104,86,105,106,86)STATE C STATE 1 FOR % PCODE GENERATION OF SCRIPT INITIALIZTION 104 CONTINUE IF ((BIT(BOFF) .LT. 'A') .OR. (BIT(BOFF) .GT. 'X')) GOTO 109 FUNC=(BIT(BOFF)-64) GOTO (801,802,803,804,805,806,807,808,809,109,811,812,813, 9 814,815,816,817,818,819,820,821,822,823,824)FUNC 801 CONTINUE IF (BIT(BOFF+1) .EQ. 'L') THEN SELCT1(SELOFF)=29 !ALLOW GOTO 118 ELSEIF (BIT(BOFF+1) .NE. 'S') THEN GOTO 109 ELSEIF (BIT(BOFF+2) .NE. 'K') THEN GOTO 109 ELSEIF (BIT(BOFF+3) .EQ. 'S') THEN SELCT1(SELOFF)=16 !ASKS GOTO 108 ELSEIF ((BIT(BOFF+3) .EQ. 32) .OR. (BIT(BOFF+3) .EQ. 9)) THEN SELCT1(SELOFF)=15 !ASK GOTO 108 ELSEIF (BIT(BOFF+3) .EQ. '?') THEN SELCT1(SELOFF)=36 !ASK? GOTO 108 ELSE GOTO 109 ENDIF 802 CONTINUE IF (BIT(BOFF+1) .EQ. 'A') THEN SELCT1(SELOFF)=17 !BATCH GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'L') THEN SELCT1(SELOFF)=27 !BLOCK GOTO 118 ELSE GOTO 109 ENDIF 803 CONTINUE IF (BIT(BOFF+1) .EQ. 'O') THEN SELCT1(SELOFF)=26 !CONTINUE GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'H') THEN SELCT1(SELOFF)=56 !CHAIN GOTO 108 ELSEIF (BIT(BOFF+1) .NE. 'L') THEN GOTO 109 ELSEIF (BIT(BOFF+2) .EQ. 'E') THEN SELCT1(SELOFF)=7 !CLEAR GOTO 118 ELSEIF (BIT(BOFF+2) .EQ. 'I') THEN SELCT1(SELOFF)=24 !CLI GOTO 108 ELSE GOTO 109 ENDIF 804 CONTINUE IF (BIT(BOFF+1) .EQ. 'I') THEN SELCT1(SELOFF)=30 !DISALLOW GOTO 118 ELSEIF (BIT(BOFF+1) .NE. 'E') THEN GOTO 109 ELSEIF (BIT(BOFF+2) .EQ. 'B') THEN DEBUG=1 !DEBUG GOTO 190 ELSEIF (BIT(BOFF+2) .EQ. 'L') THEN SELCT1(SELOFF)=48 !DELAY GOTO 108 ELSE GOTO 109 ENDIF 805 CONTINUE IF (BIT(BOFF+1) .EQ. 'N') THEN SELCT1(SELOFF)=52 !END GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'X') THEN SELCT1(SELOFF)=20 !EXIT GOTO 118 ELSE GOTO 109 ENDIF 806 CONTINUE SELCT1(SELOFF)=32 !FREE GOTO 118 807 CONTINUE IF (BIT(BOFF+1) .NE. 'R') GOTO 8807 GRAPHC=1 !GRAPHIC FLAGEX=0 9807 CONTINUE !GRAPHIC/LAST COMMON CODE DO 1807, J=1,LENGTH IF ((BIT(BOFF) .EQ. '40'O) .OR. (BIT(BOFF) .EQ. '11'O)) 9 GOTO 2807 BOFF=BOFF+1 LENGTH=LENGTH-1 1807 CONTINUE GOTO 109 2807 CONTINUE DO 3807, J=1,LENGTH IF ((BIT(BOFF) .NE. '40'O) .AND. (BIT(BOFF) .NE. '11'O)) 9 GOTO 4807 BOFF=BOFF+1 LENGTH=LENGTH-1 3807 CONTINUE GOTO 109 4807 CONTINUE BOFF=BOFF-1 IF (FLAGEX .EQ. 0) THEN GRPHLN=LENGTH !GRAPHIC DO 5807, K=1,LENGTH GRPHBF(K)=BIT(BOFF+K) 5807 CONTINUE ELSE ENDLN=LENGTH !LAST DO 6807, K=1,LENGTH ENDBUF(K)=BIT(BOFF+K) 6807 CONTINUE ENDIF GOTO 190 8807 CONTINUE IF (BIT(BOFF+1) .NE. 'O') GOTO 109 SELECT1(SELOFF)=3 !GOTO GOTO 108 808 CONTINUE IF (BIT(BOFF+1) .EQ. 'O') THEN SELCT1(SELOFF)=6 !HOLD GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'A') THEN SELCT1(SELOFF)=54 !HALT GOTO 118 ELSE GOTO 109 ENDIF 809 CONTINUE IF (BIT(BOFF+1) .EQ. 'N') THEN SELCT1(SELOFF)=19 !INQUIRE GOTO 118 ELSEIF (BIT(BOFF+1) .NE. 'F') THEN GOTO 109 ELSEIF ((BIT(BOFF+2) .EQ. 32) .OR. (BIT(BOFF+2) .EQ. 9)) THEN SELCT1(SELOFF)=35 !IF GOTO 108 ELSEIF (BIT(BOFF+2) .EQ. 'N') THEN SELCT1(SELOFF)=49 !IFNOT GOTO 108 ELSE GOTO 109 ENDIF 811 CONTINUE SELCT1(SELOFF)=55 !KILL LAST GOTO 118 812 CONTINUE IF (BIT(BOFF+1) .EQ. 'O') THEN SELCT1(SELOFF)=40 !LOCK GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'A') THEN FLAGEX=1 !LAST ENDTSK=1 GOTO 9807 !GOTO LAST/GRAPHIC COMMON CODE ELSE GOTO 109 ENDIF 813 CONTINUE SELCT1(SELOFF)=47 !MAINTAIN GOTO 118 814 CONTINUE SELCT1(SELOFF)=8 !NO CLEAR GOTO 118 815 CONTINUE IF (BIT(BOFF+1) .EQ. 'N') THEN SELCT1(SELOFF)=42 !ON GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'F') THEN SELCT1(SELOFF)=43 !OFF GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'V') THEN SELCT1(SELOFF)=46 !OVERIDE GOTO 118 ELSE GOTO 109 ENDIF 816 CONTINUE IF (BIT(BOFF+1) .EQ. 'A') THEN SELCT1(SELOFF)=21 !PASSWORD GOTO 108 ELSEIF (BIT(BOFF+1) .NE. 'R') THEN GOTO 109 ELSEIF (BIT(BOFF+2) .EQ. 'I') THEN SELCT1(SELOFF)=34 !PRIVILEGE GOTO 118 ELSEIF (BIT(BOFF+2) .NE. 'O') THEN GOTO 109 ELSEIF (BIT(BOFF+3) .EQ. 'C') THEN SELCT1(SELOFF)=10 !PROCEED ON ERR GOTO 118 ELSEIF (BIT(BOFF+3) .EQ. 'M') THEN SELCT1(SELOFF)=28 !PROMPT GOTO 118 ELSEIF (BIT(BOFF+3) .EQ. 'T') THEN IF ((IAND(1,PRVMSK)) .EQ. 0) GOTO 186 !PROTECT GOTO 190 ELSE GOTO 109 ENDIF 817 CONTINUE SELCT1(SELOFF)=4 !QUERY GOTO 118 818 CONTINUE SELCT1(SELOFF)=14 !RETURN GOTO 118 819 CONTINUE IF (BIT(BOFF+1) .EQ. 'T') THEN SELCT1(SELOFF)=9 !STOP ON ERR GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'P') THEN SELCT1(SELOFF)=23 !SPLIT GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'I') THEN SELCT1(SELOFF)=11 !SILENT GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'L') THEN SELCT1(SELOFF)=31 !SLAVE GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'E') THEN SELCT1(SELOFF)=53 !SET GOTO 108 ELSEIF (BIT(BOFF+1) .EQ. 'H') THEN SELCT1(SELOFF)=57 !SHOW SCRIPT FILENAME GOTO 118 ELSE GOTO 109 ENDIF 820 CONTINUE IF (BIT(BOFF+1) .EQ. 'E') THEN SELCT1(SELOFF)=18 !TEXT GOTO 108 ELSEIF (BIT(BOFF+1) .EQ. 'I') THEN SELCT1(SELOFF)=33 !TIMEOUT GOTO 108 ELSE GOTO 109 ENDIF 821 CONTINUE SELCT1(SELOFF)=41 !UNLOCK GOTO 118 822 CONTINUE SELCT1(SELOFF)=12 !VERBOSE GOTO 118 823 CONTINUE IF (BIT(BOFF+1) .EQ. 'A') THEN SELCT1(SELOFF)=5 !WAIT GOTO 118 ELSEIF (BIT(BOFF+1) .EQ. 'H') THEN SELCT1(SELOFF)=22 !WHOLE GOTO 118 ELSE GOTO 109 ENDIF 824 CONTINUE SELCT1(SELOFF)=50 !XSTATUS GOTO 108 C STATE 1 PCODE STRING POINTER SETUP 118 CONTINUE SELOFF=SELOFF+1 SELCT1(SELOFF)=0 SELOFF=SELOFF+1 GOTO 190 108 CONTINUE SELOFF=SELOFF+1 SELCT1(SELOFF)=STROFF SELOFF=SELOFF+1 GOTO 107 C STATE 3/4 PCODE STRING POINTER SETUP 1118 CONTINUE SELOFF=SELOFF+1 SELECT(SELOFF)=0 SELOFF=SELOFF+1 GOTO 190 1108 CONTINUE SELOFF=SELOFF+1 SELECT(SELOFF)=STROFF SELOFF=SELOFF+1 GOTO 107 C STATE 3 PCODE 105 CONTINUE STATE=4 C STATE 3/4 PCODE PARSE FOR "%" 106 CONTINUE IF (BIT(BOFF) .EQ. '?') THEN 1106 SELECT(SELOFF)=2 !HELP GOTO 1108 ENDIF IF ((BIT(BOFF) .LT. 'A') .OR. (BIT(BOFF) .GT. 'Z')) GOTO 109 FUNC=(BIT(BOFF)-64) GOTO (901,902,903,904,905,906,907,908,909,109,911,109,109, 9 914,109,916,917,918,919,920,109,922,923,924,109,926)FUNC 901 CONTINUE IF (BIT(BOFF+1) .EQ. 'G') THEN SELECT(SELOFF)=25 !AGAIN GOTO 1118 ELSEIF (BIT(BOFF+1) .NE. 'S') THEN GOTO 109 ELSEIF (BIT(BOFF+2) .NE. 'K') THEN GOTO 109 ELSEIF (BIT(BOFF+3) .EQ. 'S') THEN SELECT(SELOFF)=16 !ASKS GOTO 1108 ELSEIF ((BIT(BOFF+3) .EQ. 32) .OR. (BIT(BOFF+3) .EQ. 9)) THEN SELECT(SELOFF)=15 !ASK GOTO 1108 ELSEIF (BIT(BOFF+3) .EQ. '?') THEN SELECT(SELOFF)=36 !ASK? GOTO 1108 ELSE GOTO 109 ENDIF 902 CONTINUE IF (BIT(BOFF+1) .EQ. 'A') THEN SELECT(SELOFF)=17 !BATCH GOTO 1118 ELSEIF (BIT(BOFF+1) .EQ. 'L') THEN SELECT(SELOFF)=27 !BLOCK GOTO 1118 ELSE GOTO 109 ENDIF 903 CONTINUE IF (BIT(BOFF+1) .EQ. 'L') THEN SELECT(SELOFF)=7 !CLEAR GOTO 1118 ELSEIF (BIT(BOFF+1) .EQ. 'A') THEN SELECT(SELOFF)=13 !CALL GOTO 1108 ELSEIF (BIT(BOFF+1) .EQ. 'H') THEN IF (BIT(BOFF+2) .EQ. 'O') THEN SELECT(SELOFF)=39 !CHOICE GOTO 1118 ELSEIF (BIT(BOFF+2) .EQ. 'A') THEN SELECT(SELOFF)=56 !CHAIN GOTO 1108 ELSE GOTO 109 ENDIF ELSEIF (BIT(BOFF+1) .EQ. 'O') THEN SELECT(SELOFF)=26 !CONTINUE GOTO 1118 ELSE GOTO 109 ENDIF 904 CONTINUE SELECT(SELOFF)=48 !DELAY GOTO 1108 905 CONTINUE IF (BIT(BOFF+1) .EQ. 'X') THEN SELECT(SELOFF)=20 !EXIT GOTO 1118 ELSEIF (BIT(BOFF+1) .EQ. 'R') THEN SELECT(SELOFF)=44 !ERASE GOTO 1118 ELSEIF (BIT(BOFF+1) .EQ. 'N') THEN SELECT(SELOFF)=52 !END GOTO 1118 ELSE GOTO 109 ENDIF 906 CONTINUE SELECT(SELOFF)=32 !FREE GOTO 1118 907 CONTINUE SELECT(SELOFF)=3 !GOTO GOTO 1108 908 CONTINUE IF (BIT(BOFF+1) .EQ. 'O') THEN SELECT(SELOFF)=6 !HOLD GOTO 1118 ELSEIF (BIT(BOFF+1) .EQ. 'E') THEN GOTO 1106 !HELP ELSE GOTO 109 ENDIF 909 CONTINUE IF (BIT(BOFF+1) .EQ. 'N') THEN SELECT(SELOFF)=19 !INQUIRE GOTO 1118 ELSEIF (BIT(BOFF+1) .NE. 'F') THEN GOTO 109 ELSEIF ((BIT(BOFF+2) .EQ. 32) .OR. (BIT(BOFF+2) .EQ. 9)) THEN SELECT(SELOFF)=35 !IF GOTO 1108 ELSEIF (BIT(BOFF+2) .EQ. 'N') THEN !IFNOT SELECT(SELOFF)=49 GOTO 1108 ELSE GOTO 109 ENDIF 911 CONTINUE SELECT(SELOFF)=55 !KILL LAST GOTO 1118 914 CONTINUE SELECT(SELOFF)=8 !NO CLEAR GOTO 1118 916 CONTINUE IF (BIT(BOFF+1) .EQ. 'A') THEN SELECT(SELOFF)=21 !PASSWORD GOTO 1108 ELSEIF (BIT(BOFF+1) .NE. 'R') THEN GOTO 109 ELSEIF (BIT(BOFF+2) .EQ. 'O') THEN SELECT(SELOFF)=10 !PROCEED ON ERR GOTO 1118 ELSEIF (BIT(BOFF+2) .EQ. 'I') THEN SELECT(SELOFF)=34 !PRIVILEGE GOTO 1118 ELSE GOTO 109 ENDIF 917 CONTINUE SELECT(SELOFF)=4 !QUERY GOTO 1118 918 CONTINUE IF (BIT(BOFF+1) .NE. 'E') THEN GOTO 109 ELSEIF (BIT(BOFF+2) .EQ. 'T') THEN SELECT(SELOFF)=14 !RETURN GOTO 1118 ELSEIF (BIT(BOFF+2) .EQ. 'S') THEN SELECT(SELOFF)=45 !RESET GOTO 1118 ELSE GOTO 109 ENDIF 919 CONTINUE IF (BIT(BOFF+1) .EQ. 'T') THEN SELECT(SELOFF)=9 !STOP ON ERR GOTO 1118 ELSEIF (BIT(BOFF+1) .EQ. 'I') THEN SELECT(SELOFF)=11 !SILENT GOTO 1118 ELSEIF (BIT(BOFF+1) .EQ. 'L') THEN SELECT(SELOFF)=31 !SLAVE GOTO 1118 ELSEIF (BIT(BOFF+1) .EQ. 'E') THEN SELECT(SELOFF)=53 !SET GOTO 1108 ELSEIF (BIT(BOFF+1) .EQ. 'H') THEN SELECT(SELOFF)=57 !SHOW SCRIPT FILENAME GOTO 1118 ELSE GOTO 109 ENDIF 920 CONTINUE IF (BIT(BOFF+1) .EQ. 'E') THEN SELECT(SELOFF)=18 !TEXT GOTO 1108 ELSEIF (BIT(BOFF+1) .EQ. 'I') THEN SELECT(SELOFF)=37 !TITLE GOTO 1108 ELSEIF (BIT(BOFF+1) .EQ. 'O') THEN SELECT(SELOFF)=38 !TOP GOTO 1118 ENDIF 922 CONTINUE SELECT(SELOFF)=12 !VERBOSE GOTO 1118 923 CONTINUE SELECT(SELOFF)=5 !WAIT GOTO 1118 924 CONTINUE SELECT(SELOFF)=50 !XSTATUS GOTO 1108 926 CONTINUE SELECT(SELOFF)=51 !ZERO GOTO 1118 C STRIP % COMMAND AND SPACES 107 CONTINUE DO 191, J=1,LENGTH IF ((BIT(BOFF) .EQ. '40'O) .OR. (BIT(BOFF) .EQ. '11'O)) 9 GOTO 192 BOFF=BOFF+1 LENGTH=LENGTH-1 191 CONTINUE GOTO 109 192 CONTINUE DO 193, J=1,LENGTH IF ((BIT(BOFF) .NE. '40'O) .AND. (BIT(BOFF) .NE. '11'O)) 9 GOTO 194 BOFF=BOFF+1 LENGTH=LENGTH-1 193 CONTINUE GOTO 109 C STORE THE STRING 194 CONTINUE STRING(STROFF)=LENGTH STROFF=STROFF+1 DO 195, K=BOFF,BOFF+LENGTH-1 STRING(STROFF)=BIT(K) STROFF=STROFF+1 195 CONTINUE GOTO 190 109 CONTINUE GOTO 86 C COMMAND "$" PARSING 120 CONTINUE BOFF=BOFF+1 LENGTH=LENGTH-1 DO 144,J=1,LENGTH IF ((BIT(BOFF) .NE. '40'O) .AND. (BIT(BOFF) .NE. '11'O)) 9 GOTO 155 BOFF=BOFF+1 LENGTH=LENGTH-1 144 CONTINUE GOTO 190 C STATE DISPATCH FOR "$" 155 CONTINUE GOTO (150,86,151,152,86)STATE C STATE 1 FOR "$" 150 CONTINUE SELCT1(SELOFF)=1 SELOFF=SELOFF+1 SELCT1(SELOFF)=STROFF GOTO 156 C STATE 3 FOR "$" 151 CONTINUE STATE=4 C STATE 4 FOR "$" 152 CONTINUE SELECT(SELOFF)=1 SELOFF=SELOFF+1 SELECT(SELOFF)=STROFF C COMMON CODE FOR "$" 156 CONTINUE SELOFF=SELOFF+1 STRING(STROFF)=LENGTH STROFF=STROFF+1 DO 157,J=BOFF,BOFF+LENGTH-1 STRING(STROFF)=BIT(J) STROFF=STROFF+1 157 CONTINUE GOTO 190 C TEXT RECORDS PROCESSING 110 CONTINUE BOFF=BOFFX LENGTH=LENGX SCREEN(OFFSET)='15'O OFFSET=OFFSET+1 IF (STATE .EQ. 5) THEN IF (FIRST .EQ. 1) THEN FIRST=0 ELSE SCREEN(OFFSET)='12'O OFFSET=OFFSET+1 LINE=LINE+1 ENDIF ENDIF C TEXT STATE DISPATCHING GOTO (111,112,113,112,111)STATE C TEXT STATE 1/5 111 CONTINUE FLAGEX=0 TTSEL=0 C TEXT COMMON CODE AND ATTRIBUTE PARSING 115 CONTINUE IF ((BIT(BOFF) .NE. '!') .OR. (LENGTH .LE. 2)) THEN 1115 CONTINUE SCREEN(OFFSET)=BIT(BOFF) OFFSET=OFFSET+1 BOFF=BOFF+1 LENGTH=LENGTH-1 IF (LENGTH .EQ. 0 ) GOTO 9115 GOTO 115 ELSEIF (BIT(BOFF+1) .EQ. 'A') THEN !ASCII CHARACTER SET IF (SCOPEP(2) .EQ. 1) THEN TTSEL=0 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='(' OFFSET=OFFSET+1 SCREEN(OFFSET)='B' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF (BIT(BOFF+1) .EQ. 'S') THEN !SPECAIL CHARACTER SET IF (SCOPEP(2) .EQ. 1) THEN TTSEL=1 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='(' OFFSET=OFFSET+1 SCREEN(OFFSET)='2' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF (BIT(BOFF+1) .EQ. 'G') THEN !GRAPHIC CHARACTER SET IF (SCOPEP(2) .EQ. 1) THEN TTSEL=1 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='(' OFFSET=OFFSET+1 SCREEN(OFFSET)='0' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF (BIT(BOFF+1) .EQ. 'N') THEN !NORMAL ATTRIBUTE IF (SCOPEP(2) .EQ. 1) THEN FLAGEX=0 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='0' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF (BIT(BOFF+1) .EQ. 'B') THEN !BOLD ATTRIBUTE IF (SCOPEP(2) .EQ. 1) THEN FLAGEX=1 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='1' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF (BIT(BOFF+1) .EQ. 'F') THEN !FLASH ATTRIBUTE IF (SCOPEP(2) .EQ. 1) THEN FLAGEX=1 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='5' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF (BIT(BOFF+1) .EQ. 'U') THEN !UNDERLINE ATTRIBUTE IF (SCOPEP(2) .EQ. 1) THEN FLAGEX=1 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='4' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF (BIT(BOFF+1) .EQ. 'R') THEN !REVERSE ATTRIBUTE IF (SCOPEP(2) .EQ. 1) THEN FLAGEX=1 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='7' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF ((BIT(BOFF+1) .EQ. 'H') .AND. (STATE .EQ. 1) 9 .AND. (DHDW .EQ. 0) .AND. (DH .EQ. 0)) THEN IF (SCOPEP(2) .EQ. 1) THEN DHDW=1 ! DOUBLE HEIGHT LINE SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='#' OFFSET=OFFSET+1 SCREEN(OFFSET)='3' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF ((BIT(BOFF+1) .EQ. 'H') .AND. (STATE .EQ. 1) 9 .AND. (DHDW .EQ. 1)) THEN IF (SCOPEP(2) .EQ. 1) THEN DHDW=0 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='#' OFFSET=OFFSET+1 SCREEN(OFFSET)='4' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF ((BIT(BOFF+1) .EQ. 'T') .AND. (STATE .EQ. 1) 9 .AND. (DH .EQ. 0) .AND. (DHDW .EQ. 0)) THEN IF (SCOPEP(2) .EQ. 1) THEN DH=1 !TALL LINE SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='#' OFFSET=OFFSET+1 SCREEN(OFFSET)=':' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF ((BIT(BOFF+1) .EQ. 'T') .AND. (STATE .EQ. 1) 9 .AND. (DH .EQ. 1)) THEN IF (SCOPEP(2) .EQ. 1) THEN DH=0 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='#' OFFSET=OFFSET+1 SCREEN(OFFSET)=';' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSEIF (BIT(BOFF+1) .EQ. 'W') THEN !WIDE LINE IF (SCOPEP(2) .EQ. 1) THEN SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='#' OFFSET=OFFSET+1 SCREEN(OFFSET)='6' OFFSET=OFFSET+1 ENDIF GOTO 2115 ELSE GOTO 1115 ENDIF C TEXT ATTRIBTE COMMON END CODE--REMOVE COMMAND 2115 CONTINUE BOFF=BOFF+2 LENGTH=LENGTH-2 3115 IF (LENGTH .LE. 0) GOTO 9115 BOFF=BOFF+1 LENGTH=LENGTH-1 IF ((BIT(BOFF-1) .EQ. 32) .OR. (BIT(BOFF-1) .EQ. 9)) THEN IF (LENGTH .EQ. 0) GOTO 9115 GOTO 115 ELSE GOTO 3115 ENDIF C LAST CHARACTER, ATTRIBUTE STATE CLOSE OUT 9115 CONTINUE IF (FLAGEX .NE. 0) THEN FLAGEX=0 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='0' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 ENDIF IF (TTSEL .NE. 0 ) THEN TTSEL=0 SCREEN(OFFSET)=27 OFFSET=OFFSET+1 SCREEN(OFFSET)='(' OFFSET=OFFSET+1 SCREEN(OFFSET)='B' OFFSET=OFFSET+1 ENDIF C TEXT STATE 1-4 CLOSE OUT IF (STATE .NE. 5) THEN SCREEN(OFFSET)='12'O OFFSET=OFFSET+1 LINE=LINE+1 ENDIF IF ((DHDW .EQ. 1) .OR. (DH .EQ. 1)) GOTO 110 GOTO 114 C TEXT STATE 2 AND 4 PROCESS 112 STATE=3 IF (SCRFOR .LT. 5) THEN SCREEN(OFFSET)='11'O OFFSET=OFFSET+1 ENDIF IF (SEL .NE. 0) THEN SELECT(SELOFF)=0 SELOFF=SELOFF+1 ENDIF SEL=SEL+1 SELPNT(SEL)=SELOFF LINPNT(SEL)=LINE CHOPNT(1,SEL)=OFFSET C SCREEN FORMAT DISPATCH FOR TEXT STATE 2/4 GOTO (180,181,182,183,185,1850)SCRFOR 180 CONTINUE !FORMAT 1 SELCMP(SEL)=SEL IF (SCOPEP(2) .EQ. 1) THEN SCREEN(OFFSET)='33'O OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='1' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 SCREEN(OFFSET)=NUMS(1,SEL) OFFSET=OFFSET+1 SCREEN(OFFSET)=NUMS(2,SEL) OFFSET=OFFSET+1 SCREEN(OFFSET)='33'O OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 ELSE SCREEN(OFFSET)=NUMS(1,SEL) OFFSET=OFFSET+1 SCREEN(OFFSET)=NUMS(2,SEL) OFFSET=OFFSET+1 ENDIF SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 GOTO 117 !FORMAT 2 181 CONTINUE SELCMP(SEL)=BIT(BOFF) LENGTH=LENGTH-1 BOFF=BOFF+1 GOTO 184 182 CONTINUE !FORMAT 3 SELCMP(SEL)=BIT(BOFF) GOTO 117 183 CONTINUE !FORMAT 4 SELCMP(SEL)=BIT(BOFF) 184 CONTINUE IF (SCOPEP(2) .EQ. 1) THEN SCREEN(OFFSET)='33'O !FORMAT 2 AND 4 COMMON OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='1' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 SCREEN(OFFSET)=SELCMP(SEL) OFFSET=OFFSET+1 SCREEN(OFFSET)='33'O OFFSET=OFFSET+1 SCREEN(OFFSET)='[' OFFSET=OFFSET+1 SCREEN(OFFSET)='m' OFFSET=OFFSET+1 ELSE SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 SCREEN(OFFSET)=SELCMP(SEL) OFFSET=OFFSET+1 ENDIF SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 GOTO 117 185 CONTINUE SELCMP(SEL)=SEL !FORMAT 5 GOTO 117 1850 CONTINUE SELCMP(SEL)=BIT(BOFF) !FORMAT 6 LENGTH=LENTH-1 BOFF=BOFF+1 GOTO 117 C TEXT STATE 3 PROCESS 113 CONTINUE SCREEN(OFFSET)='11'O OFFSET=OFFSET+1 IF (SCRFOR .EQ. 3) GOTO 111 SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 SCREEN(OFFSET)='40'O OFFSET=OFFSET+1 GOTO 111 C COMMON TEXT EXIT CODE FOR STATES 2 AND 4 117 CONTINUE CHOPNT(2,SEL)=LENGTH+12 IF (SCRFOR .EQ. 3) CHOPNT(2,SEL)=LENGTH+1 GOTO 111 114 CONTINUE GOTO 190 C FIELD SEPARTOR "]" PARSING 160 CONTINUE GOTO (161,86,86,162,86)STATE C "]" STATE 1 PROCESSING 161 LENGTH=LENGTH-1 BOFF=BOFF+1 SCRFOR=1 STATE=2 SELCT1(SELOFF)=0 SELOFF=1 IF (LENGTH .EQ. 0) GOTO 190 DO 164,J=1,LENGTH IF ((BIT(BOFF) .NE. '40'O) .AND. (BIT(BOFF) .NE. '11'O)) 9 GOTO 165 BOFF=BOFF+1 LENGTH=LENGTH-1 164 CONTINUE GOTO 190 165 CONTINUE IF (BIT(BOFF) .EQ. '116'O) GOTO 190 !NUMERIC IF (BIT(BOFF) .EQ. '101'O) THEN SCRFOR=2 !ALPHA/NUMERIC GOTO 190 ELSEIF (BIT(BOFF) .EQ. '102'O) THEN SCRFOR=3 !BLANK GOTO 190 ELSEIF (BIT(BOFF) .EQ. '122'O) THEN SCRFOR=4 !REPEAT CHARACTER GOTO 190 ELSEIF (BIT(BOFF) .EQ. '125'O) THEN !UNFORMATTED NUMERIC SCRFOR=5 CURSOR=0 GOTO 190 ELSEIF (BIT(BOFF) .EQ. '103'O) THEN !UNFORMATTED CHARACTER SCRFOR=6 CURSOR=0 GOTO 190 ELSE GOTO 86 ENDIF C "]" STATE 4 PROCESSING 162 CONTINUE STATE=5 SELECT(SELOFF)=0 FIRST=1 GOTO 190 C COMMON END OF RECORD FOR ALL RECORDS PROCESSING 190 CONTINUE IF (ENDMRK .EQ. 0) GOTO 1 BOFF=BOFF+LENGTH+1 LENGTH=LENSAV-ENDMRK GOTO 2 1 CONTINUE C SCRIPT FILE PROCESSING DONE, DO SOME INITIALIZATION 90 CONTINUE IF (CLEAR .EQ. 1) THEN CALL CLR (CLEAR,WHOLE,SCOPE) CLEAR=1 ENDIF CALLFL=0 DO 1925,I=1,30 LSTLST(I)=LSTFIL(I) 1925 CONTINUE DO 2925,I=1,30 LSTFIL(I)=BILNAM(I) 2925 CONTINUE LENGX=LENGX+1 SELBUF(14)=CNUMS(1,LINE) SELBUF(15)=CNUMS(2,LINE) SELBUF(17)=CNUMS(1,LENGX) SELBUF(18)=CNUMS(2,LENGX) SELFUN=1 CLOSE (UNIT=1) SUB(1)=0 SUB(2)=0 SUB(3)=0 SUB(4)=0 SUBPNT=1 SUBCNT=1 C EXECUTE INITIALIZATION PCODE DO 94, I=1,50 IF (SELCT1(SELFUN) .EQ. 0) GOTO 95 FUNC=SELCT1(SELFUN) LENGTH=0 IF (SELCT1(SELFUN+1) .EQ. 0 ) GOTO 96 SELSTR=SELCT1(SELFUN+1) LENGTH=STRING(SELSTR) 96 CONTINUE GOTO 93 94 CONTINUE C POST INITIALIZATION EXECUTE SETUP 95 CONTINUE FLAG1X=1 INITP=0 RTURN=0 SPWND=SPWN SILNTD=SILNT STPERD=STPER CLEARD=CLEAR IF ((CURSOR .NE. 0) .AND. (SCOPEP(2) .EQ. 1))THEN PARM10(1)=(PARM10(1)+OFFSET-1) SCREEN(OFFSET)='33'O OFFSET=OFFSET+1 SCREEN(OFFSET)='133'O OFFSET=OFFSET+1 SCREEN(OFFSET)=(CNUMS(1,(LINPNT(1)))) OFFSET=OFFSET+1 SCREEN(OFFSET)=(CNUMS(2,(LINPNT(1)))) OFFSET=OFFSET+1 SCREEN(OFFSET)='73'O OFFSET=OFFSET+1 SCREEN(OFFSET)='63'O OFFSET=OFFSET+1 SCREEN(OFFSET)='110'O OFFSET=OFFSET+1 SCREEN(OFFSET)='-' OFFSET=OFFSET+1 SCREEN(OFFSET)='>' OFFSET=OFFSET+1 SCREEN(OFFSET)='10'O OFFSET=OFFSET+1 SCREEN(OFFSET)='10'O OFFSET=OFFSET+1 SCREEN(OFFSET)='10'O OFFSET=OFFSET+1 ENDIF PARM6(2)=OFFSET-1 C BETWEEN SELECTION RE-SETUP 97 CONTINUE SUB(1)=0 SUB(2)=0 SUB(3)=0 SUB(4)=0 SUBPNT=1 SUBCNT=1 STPER=STPERD SPWN=SPWND CLEAR=CLEARD SILNT=SILNTD CALL WTQIO ('1400'O,6) IF ((SCOPEP(2) .EQ. 0) .AND. (FLAG1X .EQ. 0)) THEN WRITE (6) (10,10,13,'SCR>') GOTO 301 ELSE FLAG1X=0 ENDIF C WRITE-OUT MENU SCREEN 300 CONTINUE CALL WTQIO ('410'O,6,2,,,PARM6) IF (GRAPHC .EQ. 1) THEN C GRAPHIC OPTION SPAWN (EXECUTES AFTER MENU OUTPUT EVERYTIME) CALL WTQIO ('2000'O,6) CALL SPAWN (CLI,,,1,,SPSTAT,,GRPHBF,GRPHLN) CALL STOPFR (1) CALL WTQIO ('1400'O,6) IF ((CURSOR .NE. 0) .OR. (SCOPEP(2) .EQ. 1)) 9 CALL WTQIO ('410'O,6,2,,,PARM10) ENDIF C CURSOR INPUT PROCESSING 301 TTSEL=1 MLENG=1 IF ((CURSOR .EQ. 0) .OR. (SCOPEP(2) .EQ. 0)) THEN IF (SCOPEP(2) .EQ. 1) THEN PARM4(2)=19 CALL WTQIO('410'O,6,2,,,PARM4) PARM4(2)=20 ELSE PARM4(2)=3 CALL WTQIO('410'O,6,2,,,PARM4) ENDIF GOTO 351 ENDIF 302 CALL WTQIO (READF2,6,2,,TTSTAT,PARM1) IF (TTSTAT(1) .EQ. 2) GOTO 500 IF ((BTBUF(1) .EQ. 26) .OR. (BTBUF(1) .EQ. 3) .OR. (BTBUF(1) .EQ. 25)) 9 GOTO 376 IF (BTBUF(1) .EQ. 20) GOTO 357 IF (BTBUF(1) .EQ. '33'O) THEN CALL WTQIO ('1030'O,6,2,,TTSTAT,PARM2) IF ((BTBUF(1) .EQ. 26) .OR. (BTBUF(1) .EQ. 3) .OR. (BTBUF(1) .EQ. 25)) 9 GOTO 376 IF (BTBUF(1) .EQ. '[') THEN IF ((BTBUF(2) .EQ. 'A') .OR. (BTBUF(2) .EQ. 'C')) GOTO 370 !UP IF ((BTBUF(2) .EQ. 'B') .OR. (BTBUF(2) .EQ. 'D')) GOTO 371 !DOWN GOTO 372 ELSEIF (BTBUF(1) .EQ. 'O') THEN FUNC=BTBUF(2)-'117'O GOTO (373,374,375,376) FUNC !PF KEY DISPATCH GOTO 372 ELSE GOTO 372 ENDIF ELSEIF ((BTBUF(1) .EQ. ' ') .OR. (BTBUF(1) .EQ. '0') .OR. 9 (BTBUF(1) .EQ. '11'O)) THEN !DOWN GOTO 371 ELSEIF (BTBUF(1) .EQ. '10'O) THEN !UP GOTO 370 ELSEIF (BTBUF(1) .EQ. 13) THEN ! 1302 SELBUF(20)=13 CALL WTQIO ('410'O,6,2,,,PARM4) GOTO 399 ELSEIF (BTBUF(1) .EQ. '?') THEN !? TTSEL=TTSEL+100 GOTO 1302 ELSEIF ((BTBUF(1) .LT. 32) .OR. (BTBUF(1) .EQ. '177'O)) THEN GOTO 302 ELSE GOTO 350 !ALPHA/NUMERIC ENDIF 350 CONTINUE SELBUF(20)=BTBUF(1) BMCR(1)=BTBUF(1) MLENG=2 CALL WTQIO('410'O,6,2,,,PARM4) C PROMPT INPUT PROCESSING 351 CONTINUE CALL WTQIO (READF2,6,2,,TTSTAT,PARM1) IF (TTSTAT(1) .EQ. 2) GOTO 500 !TIMEOUT IF ((BTBUF(1) .EQ. 26) .AND. (LOCK .EQ. 0)) GOTO 99 !^Z IF ((BTBUF(1) .EQ. 25) .AND. (LOCK .EQ. 0)) GOTO 99 !^Y IF ((BTBUF(1) .EQ. 3) .AND. (LOCK .EQ. 0)) GOTO 99 !^C IF (BTBUF(1) .EQ. 13) GOTO 360 ! IF (BTBUF(1) .EQ. 20) GOTO 357 IF (BTBUF(1) .LT. 32) GOTO 359 !OTHER CTRL CHAR IF (BTBUF(1) .EQ. '177'O) GOTO 358 !DELETE BMCR(MLENG)=BTBUF(1) MLENG=MLENG+1 CALL WTQIO ('410'O,6,2,,TTSTAT,PARM7) !ECHO GOTO 351 357 CONTINUE TYPE 1014,FILNAM CALL DELAY GOTO 300 358 CONTINUE !DELETE PROCESS IF (MLENG .LT. 2) GOTO 351 MLENG=MLENG-1 CALL WTQIO ('410'O,6,2,,,PARM5) GOTO 351 359 CONTINUE !CONTROL CHAR PROCESS IF ((BTBUF(1) .EQ. 23) .OR. (BTBUF(1) .EQ. 3)) GOTO 300 !^W/^C IF ((BTBUF(1) .NE. 27) .OR. (SCOPEP(2) .EQ. 0)) GOTO 351 CALL WTQIO ('1030'O,6,2,,,PARM2) ! IF (BTBUF(1) .NE. 'O') GOTO 351 !PF KEY? FUNC=BTBUF(2)-'117'O GOTO (373,351,375,376) FUNC !PF KEY DISPATCH GOTO 351 C PROCESSING 360 CONTINUE IF (MLENG .EQ. 1) GOTO 300 MLENG=MLENG-1 CALL WTQIO ('410'O,6,2,,,PARM7) IF ((BMCR(1) .EQ. '!') .AND. (LOCK .EQ. 0)) GOTO 378 IF ((BMCR(1) .EQ. '@') .AND. (LOCK .EQ. 0)) GOTO 379 IF (BMCR(1) .EQ. '?') GOTO 700 IF (MLENG .GE. 4) THEN IF (((IMCR(1) .EQ. 'HE') .AND. (IMCR(2) .EQ. 'LP')) .OR. 9 ((IMCR(1) .EQ. 'he') .AND. (IMCR(2) .EQ. 'lp'))) GOTO 700 ENDIF IF ((SCRFOR .EQ. 1) .OR. (SCRFOR .EQ. 5)) THEN IF (MLENG .GT. 3) GOTO 377 IF (MLENG .EQ. 1) THEN TTSEL=BMCR(1)-48 IF ((TTSEL .GT. SEL) .OR. (TTSEL .LE. 0)) GOTO 377 GOTO 399 ELSEIF ((MLENG .EQ. 2) .AND. (BMCR(2) .EQ. '?')) THEN TTSEL=BMCR(1)-48 IF ((TTSEL .GT. SEL) .OR. (TTSEL .LE. 0)) GOTO 377 TTSEL=TTSEL+100 GOTO 399 ELSEIF ((MLENG .EQ. 2) .AND. (BMCR(2) .NE. '?')) THEN TTSEL=(((BMCR(1)-48)*10)+(BMCR(2)-48)) IF ((TTSEL .GT. SEL) .OR. (TTSEL .LE. 0)) GOTO 377 GOTO 399 ELSEIF ((MLENG .EQ. 3) .AND. (BMCR(3) .EQ. '?')) THEN TTSEL=(((BMCR(1)-48)*10)+(BMCR(2)-48)) IF ((TTSEL .GT. SEL) .OR. (TTSEL .LE. 0)) GOTO 377 TTSEL=TTSEL+100 GOTO 399 ELSE GOTO 377 ENDIF ELSE 365 CONTINUE IF (SELCMP(TTSEL) .EQ. BMCR(1)) GOTO 368 TTSEL=TTSEL+1 IF (TTSEL .LE. SEL) GOTO 365 GOTO 377 ENDIF 368 CONTINUE IF (BMCR(MLENG) .EQ. '?') TTSEL=TTSEL+100 GOTO 399 C CURSOR PROCESSING 370 CONTINUE IF (TTSEL .EQ. 1) TTSEL=SEL+1 TTSEL=TTSEL-1 1371 CONTINUE CURBUF(7)=(CNUMS(1,(LINPNT(TTSEL)))) CURBUF(8)=(CNUMS(2,(LINPNT(TTSEL)))) CALL WTQIO ('410'O,6,2,,,PARM3) GOTO 302 371 CONTINUE IF (TTSEL .EQ. SEL) TTSEL=0 TTSEL=TTSEL+1 GOTO 1371 C OUTPUT A BELL 372 CONTINUE BTBUF(1)=7 BTBUF(2)=7 CALL WTQIO ('410'O,6,2,,,PARM8) GOTO 302 C PF KEY PROCESSING 373 CONTINUE !PF1 GOTO 300 374 CONTINUE !PF2 CLEAR=1 TTSEL=TTSEL+100 GOTO 399 375 CONTINUE !PF3 IF (LOCK .EQ. 1) GOTO 302 CALL WTQIO ('2000'O,6) 1375 DO 2375,I=1,30 BILNAM(I)=ONEFIL(I) 2375 CONTINUE RTURN=1 LEVEL=1 GOTO 50 376 CONTINUE !PF4 IF (LOCK .EQ. 1) GOTO 302 SELBUF(20)=13 CALL WTQIO ('410'O,6,2,,,PARM4) GOTO 99 C OPTION NOT FOUND 377 CONTINUE TYPE 1003 CALL DELAY GOTO 300 C COMMAND LINE SPAWN 378 CONTINUE MLENG=MLENG-1 CALL WTQIO ('2000'O,6) CALL CLR (CLEAR,WHOLE,SCOPE) CALL SPAWN (CLI,,,1,,SPSTAT,,BBMCR,MLENG) CALL STOPFR (1) CALL WTQIO ('1400'O,6) TYPE 1001 IF (LOCK .EQ. 1) THEN READ (5,2001,END=300) YESNO ELSE READ (5,2001,END=99) YESNO ENDIF GOTO 300 C COMMAND LINE GOTO 379 CONTINUE DO 1379, J=1,30 BILNAM(J)=32 1379 CONTINUE DSW=MLENG-1 MLENG=2 GOTO 69 C SELECTION FOUND, DISPATCH FUNCTION OR HELP 399 CONTINUE IF (TTSEL .GT. 100) GOTO 400 SELFUN=SELPNT(TTSEL) IF (SELFUN .EQ. 0) GOTO 97 CALL WTQIO ('2000'O,6) C SELECTION PROCESSING DO 98, I=1,50 IF (SELECT(SELFUN) .EQ. 0) GOTO 92 931 FUNC=SELECT(SELFUN) LENGTH=0 IF (SELECT(SELFUN+1) .EQ. 0 ) GOTO 93 SELSTR=SELECT(SELFUN+1) LENGTH=STRING(SELSTR) 93 CONTINUE SELFUN=SELFUN+2 IF (DEBUG .EQ. 1) THEN TYPE 1012,CLEAR,SILNT,SCRFOR,SPWN,WHOLE,LOGOFF,LOCK, 9 CURSOR,CLIMOD TYPE 1013,ALLOW,STPER,OVERID,LEVEL,FUNC,TTSEL,LENGTH,PRVMSK READ (5,2001,END=99) YESNO ENDIF C PCODE DISPATCH GOTO (201,202,203,204,205,206,207,208,209,210,211,212,213, 9 214,215,216,217,218,219,220,221,222,223,224,225,226, 9 227,228,229,230,231,232,233,234,235,236,237,238,239, 9 240,241,242,243,244,245,246,247,248,249,250,251,252, 9 253,254,255,256,257)FUNC 91 CONTINUE IF (INITP .EQ. 1) GOTO 94 98 CONTINUE C FUNCTION DONE 92 CONTINUE IF (TOPFLG .EQ. 0) GOTO 97 WRITE (6) ('33'O,'[1;24r') TOPFLG=0 GOTO 97 C FILE PROCESSING ERROR 80 TYPE 1007,FILNAM CALL DELAY 88 CONTINUE ! TRY TO OPEN AN EARLIER SCRIPT IF (LSTFIL(1) .EQ. 0) GOTO 89 DO 81, I=1,30 BILNAM(I)=LSTFIL(I) 81 CONTINUE IF (CALLFL .EQ. 1) LEVEL=LEVEL-1 RTURN=1 CALLFL=0 GOTO 50 C SCRIPT SYNTAX ERROR 86 CONTINUE CLOSE (UNIT=1) TYPE 1008,I GOTO 88 C ACCESS DENIED ERROR 186 CONTINUE CLOSE (UNIT=1) TYPE 1006 CALL DELAY GOTO 88 C COMMAND LINE ERROR 87 CONTINUE TYPE 1009 C ERROR EXIT 89 CONTINUE FLAGEX=4 GOTO 1099 C NORMAL EXIT 99 CONTINUE FLAGEX=1 1099 CONTINUE IF ((WHOLE .EQ. 1) .AND. (SCOPEP(2) .EQ. 1)) 9 WRITE (6) (27,55,27,91,49,59,50,52,'r',27,56) CALL WTQIO ('2000'O,6,1) IF (ENDTSK .EQ. 1) THEN C EXIT TASK SPAWN CALL SPAWN (CLI,,,1,,SPSTAT,,ENDBUF,ENDLN) CALL STOPFR (1) ENDIF IF ((LOGOFF .EQ. 0) .AND. (CLIMOD .EQ. 1)) THEN CALL R50ASC (6,SAVCLI,BLIBUF(13)) CALL SPAWN (CLIMCR,,,1,,SPSTAT,,CLIBUF,18) ENDIF IF (LOGOFF .EQ. 1) 9 CALL SPAWN (CLIMCR,,,1,,SPSTAT,,BYE,3) CALL EXST (FLAGEX) C PCODE FUNCTION PROCESSING C ACTION 201 CONTINUE IF ((ALLOW .EQ. 0) .AND. (RTURN .EQ. 1)) GOTO 94 SELSTR=SELSTR+1 MLENG=1 LENGX=0 1201 CONTINUE IF ((STRING(SELSTR) .NE. '#') .OR. (STRING(SELSTR+1) .NE. 9 '#') .OR. (LENGTH .LT. 3)) GOTO 4201 LENG=(STRING(SELSTR+2)-48) IF ((LENG .LE. 0) .OR. (LENG .GT. 4)) GOTO 4201 SPNT=SUB(LENG) IF (SPNT .EQ. 0) GOTO 3201 LENG=SUBBUF(SPNT) SPNT=SPNT+1 2201 CONTINUE IF (LENG .EQ. 0) GOTO 3201 BMCR(MLENG)=SUBBUF(SPNT) LENGX=LENGX+1 MLENG=MLENG+1 SPNT=SPNT+1 LENG=LENG-1 GOTO 2201 3201 CONTINUE SELSTR=SELSTR+3 LENGTH=LENGTH-3 IF (LENGTH .EQ. 0) GOTO 5201 GOTO 1201 4201 CONTINUE BMCR(MLENG)=STRING(SELSTR) LENGX=LENGX+1 SELSTR=SELSTR+1 MLENG=MLENG+1 LENGTH=LENGTH-1 IF (LENGTH .NE. 0) GOTO 1201 5201 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) IF ((SILNT .EQ. 0) .OR. (DEBUG .EQ. 1)) 9 WRITE (6) ('15'O,'12'O,'>',(BMCR(J), J=1,LENGX),'15'O) 6201 CONTINUE IF (NOMCR .EQ. 0) CALL SPAWN (CLI,,,1,,SPSTAT,,BMCR,LENGX) IF (SPWN .EQ. 4) GOTO 91 IF (SPWN .EQ. -1) CALL EXST (1) IF (NOMCR .EQ. 1) THEN SPSTAT(1)=1 ELSE CALL STOPFR (1) ENDIF IF (SPWN .EQ. 5) GOTO 8201 7201 IF (SPSTAT(1) .EQ. 1) GOTO 8201 IF (SPWN .EQ. 3) THEN IF ((STPER .EQ. 0) .AND. (SELECT(SELFUN) .EQ. 0)) GOTO 227 GOTO 219 ENDIF IF (SPWN .EQ. 2) THEN IF (STPER .EQ. 0) GOTO 91 GOTO 92 ENDIF IF (SELECT(SELFUN) .EQ. 0) GOTO 227 GOTO 219 8201 IF (SPWN .EQ. 3) GOTO 227 IF ((SELECT(SELFUN) .NE. 0) .AND. (INITP .NE. 1)) GOTO 91 IF ((SELCT1(SELFUN) .NE. 0) .AND. (INITP .EQ. 1)) GOTO 94 CALL MARK (2,6,1) CALL STOPFR (2) GOTO 91 C HELP 202 CONTINUE GOTO 91 C GOTO 203 CONTINUE DO 1203,I=1,LENGTH BMCR(I+1)=STRING(SELSTR+I) 1203 CONTINUE MLENG=LENGTH+1 GOTO 379 C QUERY 204 CONTINUE SPWN=1 GOTO 91 C WAIT 205 CONTINUE SPWN=2 GOTO 91 C HOLD 206 CONTINUE SPWN=3 GOTO 91 C CLEAR 207 CONTINUE CLEAR=1 GOTO 91 C NO CLEAR 208 CONTINUE CLEAR=0 GOTO 91 C STOP ON ERR 209 CONTINUE STPER=1 GOTO 91 C PROCEED ON ERR 210 CONTINUE STPER=0 GOTO 91 C SILENT 211 CONTINUE IF (NOMCR .EQ. 0) SILNT=1 GOTO 91 C VERBOSE 212 CONTINUE SILNT=0 GOTO 91 C CALL 213 CONTINUE DO 1213, J=1,30 NAMSAV(LEVEL,J)=BILNAM(J) 1213 CONTINUE LEVEL=LEVEL+1 CALLFL=1 GOTO 203 C RETURN 214 CONTINUE LEVEL=LEVEL-1 IF (LEVEL .EQ. 0) GOTO 99 DO 1214, J=1,30 BILNAM(J)=NAMSAV(LEVEL,J) 1214 CONTINUE RTURN=1 GOTO 50 C ASK 215 CONTINUE IF (SUBCNT .EQ. 5) GOTO 91 MLENG=0 LENGTH=LENGTH-1 IF (LENGTH .LE. 0) GOTO 91 SELSTR=SELSTR+2 DO 1215, J=1,LENGTH IF (STRING(SELSTR) .EQ. ')') GOTO 2215 SUBBUF(SUBPNT+J)=STRING(SELSTR) MLENG=MLENG+1 SELSTR=SELSTR+1 1215 CONTINUE GOTO 91 2215 CONTINUE IF (MLENG .EQ. 0) GOTO 91 LENGTH=LENGTH-MLENG-2 IF (LENGTH .LE. 0) GOTO 91 SELSTR=SELSTR+1 CALL CLR (CLEAR,WHOLE,SCOPE) WRITE (6) ('15'O,'12'O,(STRING(SELSTR+J), J=1,LENGTH)) READ (5,2001,END=92) YESNO IF ((YESNO(1:1) .EQ. '?') .AND. (SELECT(SELFUN) .EQ. 36)) 9 GOTO 600 IF ((YESNO(1:1) .EQ. 'Y') .OR. (YESNO(1:1) .EQ. 'y')) GOTO 3215 GOTO 91 3215 CONTINUE SUB(SUBCNT)=SUBPNT SUBBUF(SUBPNT)=MLENG SUBCNT=SUBCNT+1 SUBPNT=SUBPNT+MLENG+1 GOTO 91 C ASKS 216 CONTINUE IF (SUBCNT .EQ. 5) GOTO 91 SUB(SUBCNT)=SUBPNT IF (STRING(SELSTR+1) .EQ. '(') THEN MLENG=0 LENGTH=LENGTH-1 IF (LENGTH .LE. 0) GOTO 91 SELSTR=SELSTR+2 DO 1216, J=1,LENGTH IF (STRING(SELSTR) .EQ. ')') GOTO 2216 SUBBUF(SUBPNT+J)=STRING(SELSTR) MLENG=MLENG+1 SELSTR=SELSTR+1 1216 CONTINUE GOTO 91 2216 CONTINUE LENGTH=LENGTH-MLENG-2 IF (LENGTH .LE. 0) GOTO 91 SELSTR=SELSTR+1 CALL CLR (CLEAR,WHOLE,SCOPE) WRITE (6) ('15'O,'12'O,(STRING(SELSTR+J), J=1,LENGTH)) CALL WTQIO (READF1,6,2,,TTSTAT,PARM9) IF (BTSTAT(2) .NE. 13) GOTO 92 LENGTH=TTSTAT(2) IF ((LENGTH .EQ. 1) .AND. (BMCR(1) .EQ. '?') .AND. 9 (SELECT(SELFUN) .EQ. 36)) GOTO 600 IF (LENGTH .EQ. 0) GOTO 4216 SUBBUF(SUBPNT)=LENGTH DO 3216, J=1,LENGTH SUBBUF(SUBPNT+J)=BMCR(J) SUBCNT=SUBCNT+1 3216 CONTINUE SUBPNT=SUBPNT+LENGTH+1 GOTO 91 4216 CONTINUE SUBBUF(SUBPNT)=MLENG SUBCNT=SUBCNT+1 SUBPNT=SUBPNT+MLENG+1 GOTO 91 ELSE CALL CLR (CLEAR,WHOLE,SCOPE) 5216 WRITE (6) ('15'O,'12'O,(STRING(SELSTR+J), J=1,LENGTH)) CALL WTQIO (READF1,6,2,,TTSTAT,PARM9) IF (BTSTAT(2) .NE. 13) GOTO 92 MLENG=TTSTAT(2) IF ((MLENG .EQ. 1) .AND. (BMCR(1) .EQ. '?') .AND. 9 (SELECT(SELFUN) .EQ. 36)) GOTO 600 IF (MLENG .EQ. 0) GOTO 5216 SUBBUF(SUBPNT)=MLENG DO 6216, J=1,MLENG SUBBUF(SUBPNT+J)=BMCR(J) 6216 CONTINUE SUBPNT=SUBPNT+MLENG+1 SUBCNT=SUBCNT+1 GOTO 91 ENDIF C BATCH 217 CONTINUE SPWN=4 GOTO 91 C TEXT 218 CONTINUE 237 CONTINUE SELSTR=SELSTR+1 MLENG=1 LENGX=0 1257 CONTINUE IF ((STRING(SELSTR) .NE. '#') .OR. (STRING(SELSTR+1) .NE. 9 '#') .OR. (LENGTH .LT. 3)) GOTO 4257 LENG=(STRING(SELSTR+2)-48) IF ((LENG .LE. 0) .OR. (LENG .GT. 4)) GOTO 4257 SPNT=SUB(LENG) IF (SPNT .EQ. 0) GOTO 3257 LENG=SUBBUF(SPNT) SPNT=SPNT+1 2257 CONTINUE IF (LENG .EQ. 0) GOTO 3257 BMCR(MLENG)=SUBBUF(SPNT) LENGX=LENGX+1 MLENG=MLENG+1 SPNT=SPNT+1 LENG=LENG-1 GOTO 2257 3257 CONTINUE SELSTR=SELSTR+3 LENGTH=LENGTH-3 IF (LENGTH .EQ. 0) GOTO 91 GOTO 1257 4257 CONTINUE BMCR(MLENG)=STRING(SELSTR) LENGX=LENGX+1 SELSTR=SELSTR+1 MLENG=MLENG+1 LENGTH=LENGTH-1 IF (LENGTH .NE. 0) GOTO 1257 IF (FUNC .EQ. 37) GOTO 1237 CALL CLR (CLEAR,WHOLE,SCOPE) IF (BMCR(1) .EQ. 34) THEN WRITE (6) ('15'O,'12'O,(BMCR(J), J=2,LENGX),'15'O) ELSE WRITE (6) ('15'O,'12'O,(BMCR(J), J=1,LENGX),'15'O) ENDIF GOTO 91 C INQUIRE 219 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) TYPE 1002 IF (LOCK .EQ. 1) THEN READ (5,2001,END=91) YESNO ELSE READ (5,2001,END=99) YESNO ENDIF IF ((YESNO(1:1) .EQ. 'Y') .OR. (YESNO(1:1) .EQ. 'y')) GOTO 92 GOTO 91 C EXIT 220 CONTINUE GOTO 99 C PASSWORD 221 CONTINUE IF (RTURN .EQ. 1) GOTO 91 CALL WTQIO ('2000'O,6) DO 1221, J=1,LENGTH PASS1(4+J)=(STRING(SELSTR+J)) 1221 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) CALL SPAWN (CLI,,,1,,SPSTAT,,PASS1,LENGTH+4) CALL STOPFR (1) IF (SPSTAT(1) .EQ. 1) GOTO 91 IF (INITP .EQ. 0) GOTO 97 TYPE 1006 IF (LSTLST(1) .EQ. 0) GOTO 89 CALL DELAY DO 2221,J=1,30 BILNAM(J)=LSTLST(J) 2221 CONTINUE RTURN=1 GOTO 50 C WHOLE 222 CONTINUE WHOLE=1 IF (SCOPEP(2) .EQ. 0) GOTO 91 SELBUF(6)=48 SELBUF(7)=49 SCREEN(3)=50 SCREEN(4)=52 SCREEN(15)=48 SCREEN(16)=49 GOTO 91 C SPLIT 223 CONTINUE IF (SCOPEP(2) .EQ. 0) GOTO 91 WHOLE=0 SCREEN(3)=CNUMS(1,LINE+1) SCREEN(4)=CNUMS(2,LINE+1) SCREEN(15)=CNUMS(1,LINE+1) SCREEN(16)=CNUMS(2,LINE+1) SELBUF(6)=CNUMS(1,LINE+1) SELBUF(7)=CNUMS(2,LINE+1) GOTO 91 C CLI 224 CONTINUE IF (LENGTH .GT. 6) GOTO 91 DO 1224, J=1,6 LENGTH=LENGTH-1 SELSTR=SELSTR+1 IF (LENGTH .GE. 0) THEN BLIBUF(12+J)=STRING(SELSTR) ELSE BLIBUF(12+J)=32 ENDIF 1224 CONTINUE CALL SPAWN (CLIMCR,,,1,,SPSTAT,,CLIBUF,18) CALL STOPFR (1) IF (SPSTAT(1) .NE. 1) GOTO 91 CLIMOD=1 GOTO 91 C AGAIN 225 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) TYPE 1000 IF (LOCK .EQ. 1) THEN READ (5,2001,END=91) YESNO ELSE READ (5,2001,END=99) YESNO ENDIF IF ((YESNO(1:1) .NE. 'Y') .AND. (YESNO(1:1) .NE. 'y')) GOTO 91 STPER=STPERD SPWN=SPWND CLEAR=CLEARD SILNT=SILNTD SELFUN=SELPNT(TTSEL) GOTO 91 C CONTINUE 226 CONTINUE SPWN=5 GOTO 91 C BLOCK 227 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) TYPE 1001 IF (LOCK .EQ. 1) THEN READ (5,2001,END=91) YESNO ELSE READ (5,2001,END=99) YESNO ENDIF GOTO 91 C PROMPT 228 CONTINUE CURSOR=0 GOTO 91 C DISALLOW 229 CONTINUE ALLOW=1 GOTO 91 C ALLOW 230 CONTINUE ALLOW=0 GOTO 91 C SLAVE 231 CONTINUE CALL SPAWN (CLIMCR,,,1,,SPSTAT,,SLVBUF,14) 1231 CALL STOPFR (1) GOTO 91 C FREE 232 CONTINUE CALL SPAWN (CLIMCR,,,1,,SPSTAT,,NOSLVB,16) GOTO 1231 C TIMEOUT 233 CONTINUE DECODE (LENGTH,2000,STRING(SELSTR+1)) FLAGEX IF ((FLAGEX .GT. 0) .AND. (FLAGEX .LT. 256)) THEN PARM1(3)=FLAGEX PARM9(3)=FLAGEX READF1='1200'O READF2='1230'O ELSE PARM1(3)=0 PARM9(3)=0 READF1='1000'O READF2='1030'O ENDIF GOTO 91 C PRIVILEGE 234 CONTINUE CALL WTQIO ('2000'O,6) DO 1234, J=1,LENGTH PASS2(4+J)=(STRING(SELSTR+J)) 1234 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) CALL SPAWN (CLI,,,1,,SPSTAT,,PASS2,LENGTH+4) CALL STOPFR (1) IF (IAND(SPSTAT(1),'000001'O) .EQ. 0) GOTO 91 FLAGEX=IAND(SPSTAT(1),'177776'O) IF (IAND(PRVMSK,1) .EQ. 1) FLAGEX=FLAGEX+1 PRVMSK=FLAGEX GOTO 91 C IF 235 CONTINUE IF ((LENGTH .GT. 2) .OR. (LENGTH .LE. 0)) GOTO 91 FLAGEX=0 IF (LENGTH .EQ. 2) THEN IF (STRING(SELSTR+1) .NE. 49) GOTO 91 FLAGEX=10 SELSTR=SELSTR+1 ENDIF IF ((STRING(SELSTR+1) .LE. 47) .OR. (STRING(SELSTR+1) .GT. 9 58)) GOTO 91 FLAGEX=FLAGEX+(STRING(SELSTR+1)-48) IF ((FLAGEX .LT. 0) .OR. (FLAGEX .GE. 17)) GOTO 91 IF (FLAGEX .EQ. 0) THEN IF ((SETFLG .EQ. 1) .AND. (FUNC .EQ. 35)) GOTO 91 IF ((SETFLG .EQ. 0) .AND. (FUNC .EQ. 49)) GOTO 91 ELSE IF ((IAND(BMASK(FLAGEX),PRVMSK) .NE. 0) .AND. 9 (FUNC .EQ. 35)) GOTO 91 IF ((IAND(BMASK(FLAGEX),PRVMSK) .EQ. 0) .AND. 9 (FUNC .EQ. 49)) GOTO 91 ENDIF IF ((INITP .EQ. 1) .AND. (SELCT1(SELFUN) .EQ. 0)) GOTO 95 IF ((INITP .EQ. 0) .AND. (SELECT(SELFUN) .EQ. 0)) GOTO 92 SELFUN=SELFUN+2 IF ((DEBUG .EQ. 0) .AND. (SILNT .EQ. 1)) GOTO 91 CALL CLR (CLEAR,WHOLE,SCOPE) TYPE 1005 CALL DELAY GOTO 91 C ASK? 236 CONTINUE GOTO 91 C TITLE 1237 CONTINUE IF (SCOPEP(2) .EQ. 0) GOTO 91 IF ((WHOLE .EQ. 0) .OR. (CLEAR .NE. 1)) GOTO 91 CALL CLR (CLEAR,WHOLE,SCOPE) WRITE (6) ('33'O,'[3;24r') IF (SILNT .EQ. 1) THEN WRITE (6) ((BMCR(J), J=1,LENGX),13,10,10) ELSE WRITE (6) ((BMCR(J), J=1,LENGX),13,10) ENDIF TOPFLG=1 GOTO 91 C TOP 238 CONTINUE IF (SCOPEP(2) .EQ. 0) GOTO 91 IF ((WHOLE .EQ. 0) .OR. (CLEAR .NE. 1)) GOTO 91 CALL CLR (CLEAR,WHOLE,SCOPE) WRITE (6) ('33'O,'[3;24r') TOPFLG=1 GOTO 91 C CHOICE 239 CONTINUE IF (SCOPEP(2) .EQ. 0) GOTO 91 IF ((WHOLE .EQ. 0) .OR. (CLEAR .NE. 1)) GOTO 91 CALL CLR (CLEAR,WHOLE,SCOPE) WRITE (6) ('33'O,'[3;24r') WRITE (6) ((SCREEN((CHOPNT(1,TTSEL))+J-1), 9 J=1,CHOPNT(2,TTSEL)),13,10) TOPFLG=1 GOTO 91 C LOCK 240 CONTINUE LOCK=1 GOTO 91 C UNLOCK 241 CONTINUE LOCK=0 GOTO 91 C ON 242 CONTINUE LOGOFF=0 GOTO 91 C OFF 243 CONTINUE LOGOFF=1 GOTO 91 C ERASE 244 CONTINUE IF (SCOPEP(2) .EQ. 0) GOTO 91 IF (WHOLE .EQ. 1) GOTO 245 CALL WTQIO('410'O,6,2,,,PARM4) WRITE (6) (27,'[J') GOTO 91 C RESET 245 CONTINUE IF (SCOPEP(2) .EQ. 0) GOTO 91 WRITE (6) (27,'[1,24r',27,'[J') GOTO 91 C MAINTAIN 246 CONTINUE OVERID=1 GOTO 91 C OVERRIDE 247 CONTINUE OVERID=0 GOTO 91 C DELAY 248 CONTINUE DECODE (LENGTH,2000,STRING(SELSTR+1)) FLAGEX IF (FLAGEX .EQ. 0) GOTO 91 CALL MARK (2,FLAGEX,2) CALL STOPFR (2) GOTO 91 C IFNOT 249 CONTINUE GOTO 235 C XSTATUS 250 CONTINUE DECODE (LENGTH,2000,STRING(SELSTR+1)) FLAGEX GOTO 1099 C ZERO 251 CONTINUE GOTO 1375 C END 252 CONTINUE IF (INITP .EQ. 1) GOTO 95 GOTO 92 C SET 253 CONTINUE DECODE (LENGTH,2000,STRING(SELSTR+1)) FLAGEX IF ((FLAGEX .EQ. 0) .OR. (FLAGEX .EQ. 1))THEN IF (FLAGEX .EQ. 0) SETFLG=0 IF (FLAGEX .EQ. 1) SETFLG=1 ELSE FLAGEX=IAND(FLAGEX,'177776'O) IF (IAND(PRVMSK,1) .EQ. 1) FLAGEX=FLAGEX+1 PRVMSK=FLAGEX ENDIF GOTO 91 C HALT INIT PROCESS 254 CONTINUE IF (RTURN .EQ. 0) GOTO 94 GOTO 95 C KILL LAST REQUEST 255 CONTINUE ENDTSK=0 GOTO 91 C CHAIN 256 CONTINUE SPWN = -1 GOTO 201 C SHOW SCRIPT FILENAME 257 CONTINUE TYPE 1014,FILNAM GOTO 91 C HELP FROM THE MENU 400 CONTINUE TTSEL=TTSEL-100 SELFUN=SELPNT(TTSEL) IF (SELFUN .EQ. 0) GOTO 444 CALL WTQIO ('2000'O,6) 401 IF (SELECT(SELFUN) .EQ. 0) GOTO 444 IF (SELECT(SELFUN) .EQ. 2) GOTO 410 SELFUN=SELFUN+2 GOTO 401 410 CONTINUE IF (SELECT(SELFUN+1) .EQ. 0 ) GOTO 444 SELSTR=SELECT(SELFUN+1) LENGTH=STRING(SELSTR) IF (STRING(SELSTR+1) .EQ. '(') GOTO 420 IF (STRING(SELSTR+1) .EQ. '"') GOTO 430 C PASS STRING TO "HELP" DO 415, J=1,LENGTH HELP1(5+J)=(STRING(SELSTR+J)) 415 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) IF ((SILNT .EQ. 0) .OR. (DEBUG .EQ. 1)) 9 WRITE (6) ('15'O,'12'O,(HELP1(J), J=1,LENGTH+5),'15'O) CALL SPAWN (CLI,,,1,,SPSTAT,,HELP1,LENGTH+5) GOTO 427 C PASS STRING TO "TYPE" 420 CONTINUE DO 425, J=1,LENGTH HELP2(8+J)=(STRING(SELSTR+J)) 425 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) IF ((SILNT .EQ. 0) .OR. (DEBUG .EQ. 1)) 9 WRITE (6) ('15'O,'12'O,(HELP2(J), J=1,LENGTH+8),'15'O) CALL SPAWN (CLI,,,1,,SPSTAT,,HELP2,LENGTH+8) 427 CONTINUE CALL STOPFR (1) TYPE 1001 IF (LOCK .EQ. 1) THEN READ (5,2001,END=97) YESNO ELSE READ (5,2001,END=99) YESNO ENDIF GOTO 97 C USE STRING AS HELP TEXT 430 CONTINUE SELSTR=SELSTR+1 LENGTH=LENGTH-2 WRITE (6) ('15'O,'12'O,(STRING(SELSTR+J), J=1,LENGTH),'15'O) TYPE 1001 IF (LOCK .EQ. 1) THEN READ (5,2001,END=97) YESNO ELSE READ (5,2001,END=99) YESNO ENDIF GOTO 97 444 CONTINUE TYPE 1004 CALL DELAY GOTO 97 C TIMEOUT PROCESSING 500 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) TYPE 1010 GOTO 89 C HELP FROM ASK/ASKS PROMPT 600 CONTINUE SELFUN=SELFUN-2 CALL WTQIO ('2000'O,6) 610 CONTINUE SELSTR=SELECT(SELFUN+1) LENGTH=STRING(SELSTR) IF (STRING(SELSTR+1) .EQ. '(') GOTO 620 IF (STRING(SELSTR+1) .EQ. '"') GOTO 630 C PASS STRING TO "HELP" DO 615, J=1,LENGTH HELP1(5+J)=(STRING(SELSTR+J)) 615 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) IF ((SILNT .EQ. 0) .OR. (DEBUG .EQ. 1)) 9 WRITE (6) ('15'O,'12'O,(HELP1(J), J=1,LENGTH+5),'15'O) CALL SPAWN (CLI,,,1,,SPSTAT,,HELP1,LENGTH+5) GOTO 627 C PASS STRING TO "TYPE" 620 CONTINUE DO 625, J=1,LENGTH HELP2(8+J)=(STRING(SELSTR+J)) 625 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) IF ((SILNT .EQ. 0) .OR. (DEBUG .EQ. 1)) 9 WRITE (6) ('15'O,'12'O,(HELP2(J), J=1,LENGTH+8),'15'O) CALL SPAWN (CLI,,,1,,SPSTAT,,HELP2,LENGTH+8) 627 CONTINUE CALL STOPFR (1) TYPE 1001 IF (LOCK .EQ. 1) THEN READ (5,2001,END=91) YESNO ELSE READ (5,2001,END=99) YESNO ENDIF GOTO 91 C USE STRING AS HELP TEXT 630 CONTINUE SELSTR=SELSTR+1 LENGTH=LENGTH-2 WRITE (6) ('15'O,'12'O,(STRING(SELSTR+J), J=1,LENGTH),'15'O) TYPE 1001 IF (LOCK .EQ. 1) THEN READ (5,2001,END=91) YESNO ELSE READ (5,2001,END=99) YESNO ENDIF GOTO 91 C HELP FROM MENU PROMPT 700 CONTINUE CALL WTQIO ('2000'O,6) IF ((BMCR(1) .EQ. '?') .AND. (MLENG .EQ. 1)) GOTO 720 IF ((BMCR(1) .NE. '?') .AND. (MLENG .EQ. 4)) GOTO 720 C HAS A STRING TO PASS TO HELP DO 705, J=1,MLENG MLENG=MLENG-1 FLAGEX=J IF ((BMCR(J) .EQ. 32) .OR. (BMCR(J) .EQ. 9)) GOTO 710 705 CONTINUE GOTO 97 710 CONTINUE DO 715, J=1,MLENG HELP1(5+J)=(BMCR(FLAGEX+J)) 715 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) IF ((SILNT .EQ. 0) .OR. (DEBUG .EQ. 1)) 9 WRITE (6) ('15'O,'12'O,(HELP1(J), J=1,MLENG+5),'15'O) CALL SPAWN (CLI,,,1,,SPSTAT,,HELP1,MLENG+5) GOTO 727 C NO STRING, USE A CANNED ONE 720 CONTINUE CALL CLR (CLEAR,WHOLE,SCOPE) IF ((SILNT .EQ. 0) .OR. (DEBUG .EQ. 1)) 9 WRITE (6) ('15'O,'12'O,(HELP3(J), J=1,9),'15'O) CALL SPAWN (CLI,,,1,,SPSTAT,,HELP3,9) 727 CONTINUE CALL STOPFR (1) TYPE 1001 IF (LOCK .EQ. 1) THEN READ (5,2001,END=97) YESNO ELSE READ (5,2001,END=99) YESNO ENDIF GOTO 300 C OUTPUT TEXT 1000 FORMAT(/,X,'Do you wish to repeat this selection: ',$) 1001 FORMAT(/,X,'Please press "RETURN" to continue: ',$) 1002 FORMAT(/,X,'Do you wish to halt this selection: ',$) 1003 FORMAT(/,X,'Selection Not Found') 1004 FORMAT(/,X,'No Help Found for This Selection') 1005 FORMAT(/,X,'Privileged Insufficent') 1006 FORMAT(/,X,'Access Denied') 1007 FORMAT(X,'File Process Error ',A) 1008 FORMAT(X,'Syntax Error on Line ',I) 1009 FORMAT(X,'Command Line Syntax Error') 1010 FORMAT(X,'Terminal Time-Out Exit') 1011 FORMAT(X,'Opening File ',A) 1012 FORMAT(X,'CLR ',I1,' SIL ',I1,' FOR ',I1,' SPN ',I1,' WHO ', 9 I1,' LOG ',I1,' LCK ',I1,' CUR ',I1,' CLI ',I1) 1013 FORMAT(X,'ALL ',I1,' STP ',I1,' OVR ',I1,' LEV ',I1,' FNC ', 9 I2,' SEL ',I2,' LEN ',I2,' PRVMSK ',I7.1) 1014 FORMAT(X,'Present menu script: 'A) C INPUT FORMATS 2000 FORMAT(I) 2001 FORMAT(A) 2002 FORMAT(Q,A) END C CLEAR SCREEN SUBROUTINE SUBROUTINE CLR (CLEAR,WHOLE,SCOPE) IMPLICIT INTEGER*2 (A-Z) IF ((CLEAR .EQ. 0) .AND. (WHOLE .EQ. 1)) RETURN IF (SCOPE .EQ. 0) THEN WRITE (6) (10,10,13) CLEAR=0 RETURN ENDIF IF (CLEAR .EQ. 0) THEN WRITE (6) (27,'[24;1H') RETURN ENDIF CLEAR=0 IF (WHOLE .EQ. 1) WRITE (6) (27,'[H',27,'[J') IF (WHOLE .EQ. 0) WRITE (6) (27,'[J') RETURN END C DELAY SUBROUTINE SUBROUTINE DELAY CALL MARK (2,2,2) CALL STOPFR (2) RETURN END