C PROMPT -- PROMPTS USER FOR INPUT, VALIDATES AND BUILDS DATA C TABLES AND QUALIFIER TABLES AND DOES C MOST OF THE MESSAGE OUTPUT. C PLACES DATA IN VERY NICE ORDER FOR C OTHER ROUTINE TO EXCUTE BY. C SUBROUTINE PROMPT(CDE,BEEFLG) INTEGER CMDTAB(7),QUETAB(8),QUAKEY(5,16),ARGKEY(8,16) INTEGER AGIOCT(6),AGASCI(3,6),IREG,CDE(40),FNC INTEGER BLANKS(18) BYTE CMD(80),SEGNM(6),MODNM(6),MESAGE(216),FSPEC(24) BYTE HIST(8),COMD(8) REAL*8 CMDLST(4),QUALST(3) INTEGER CLST(16),BEEFLG,RFLG REAL REALS(2) COMMON /CMDS/ CMDTAB,QUETAB,AGIOCT,AGASCI,IREG,FSPEC,FNC, + SEGNM,MODNM,REALS COMMON /MESBUF/MESAGE EQUIVALENCE (CMDLST,CLST) DATA BLANKS/18*' '/ DATA QUAKEY/1,2,0,1,1,2,2,0,1,1,3,0,0,0,0,4,2,0,1,1, + 5,1,0,1,0,6,1,0,1,0,7,1,0,1,0,8,1,1,0,0, + 9,0,0,0,0,10,0,0,0,0,11,0,0,0,0,12,1,0,0,1, + 13,1,0,0,1,14,0,0,0,0,15,1,0,1,0,16,0,0,0,0/ DATA ARGKEY/1,2,1,102,0,0,0,0, + 2,1,5,0,0,0,0,0, + 3,0,0,0,0,0,0,0, + 4,4,4,102,104,104,0,0, + 5,6,1,102,103,103,103,103, + 6,2,5,3,0,0,0,0, + 7,5,4,103,102,104,104,0, + 8,4,102,102,104,104,0,0, + 9,2,2,1,0,0,0,0, + 10,1,106,0,0,0,0,0, + 11,1,106,0,0,0,0,0, + 12,4,104,104,104,104,0,0, + 13,1,104,0,0,0,0,0, + 14,0,0,0,0,0,0,0, + 15,3,102,104,104,0,0,0, + 16,0,0,0,0,0,0,0/ DATA CMDLST /'EAEREPES','CACRCSPR','STCOHITA','HEEXCPSE'/ DATA QUALST /'/V/N/O ','/I/R/D/A','/P/G/F '/ C C C CHECK COMMAND FILE FLAG. C IF(BEEFLG.NE..TRUE.)GOTO1 CALL POSITN(2,19) TYPE 11111 11111 FORMAT(60(' ')) 1 RFLG=.FALSE. IF(BEEFLG.NE..TRUE.)GOTO4 CALL POSITN(0,1) CALL PUTBLK(HIST,8,1,8) CALL PUTBLK(COMD,8,1,8) IF(QUETAB(8).EQ.1)CALL STRMOV('HISTORY',1,7,HIST,1) IF(QUETAB(7).EQ.1)CALL STRMOV('COMMAND',1,7,COMD,1) TYPE 7777,COMD,HIST 7777 FORMAT(80(' ')/, + 15X,'********** SYMBOLIC DEBUGGING TOOL **********', + 1X,8A1,1X,8A1) CALL POSITN(6,1) TYPE 6666,(CDE(ICDE),ICDE=1,35) 6666 FORMAT(1X,35A2) TYPE 5555 5555 FORMAT(1X,72('-')) 4 IF(BEEFLG.EQ..TRUE.)CALL POSITN(3,1) TYPE 7,MESAGE 7 FORMAT(72A1/,72A1/,72A1) CALL PUTBLK(MESAGE,216,1,216) IF(BEEFLG.EQ..TRUE.)CALL POSITN(2,1) IF(QUETAB(7).EQ.1)GOTO20 5 TYPE 6,SEGNM,MODNM 6 FORMAT('$',6A1,1X,6A1,' SDT>') CALL CLRBUF(CMD,40,1,40) 10 READ(5,15,END=340)NCH,CMD 15 FORMAT(Q,80A) C PRINT 11,SEGNM,MODNM,CMD 11 FORMAT(1X,6A1,1X,6A1,1X,'SDT>',80A1) IF(NCH.EQ.0)GOTO4 GOTO100 20 READ(10,15,END=25)NCH,CMD TYPE 22,SEGNM,MODNM,(CMD(I),I=1,NCH) 22 FORMAT(1X,6A1,1X,6A1,' SDT>',A) IF(NCH.EQ.0)GOTO4 GOTO100 25 CLOSE(UNIT=10) QUETAB(7)=0 GOTO5 C C 100 FNC=NCH IF(BEEFLG.EQ..TRUE.)CALL POSITN(3,1) ISPOT=LSTRNG(CMDLST,1,32,CMD,1,2) IF(ISPOT.LE.0)GOTO103 DO 102 I=1,16 IF(KOMSTR(CMD,1,2,CLST(I),1,2).EQ.0)GOTO110 102 CONTINUE 103 ENCODE(20,105,MESAGE) 105 FORMAT(1X,'*COMMAND NOT FOUND*') GOTO1 110 CALL CLRBUF(QUETAB,8,1,6) A=ISPOT QUETAB(1)=INT(A/2+1) IF(QUETAB(1).EQ.14)GOTO340 C C CHECK FOR INVALID QUALIFIERS C ISPOT=LSTRNG(CMD,1,80,'/',1,1) IF(ISPOT.LE.0)GOTO170 ISPOT=1 111 ISPOT=LSTRNG(CMD,ISPOT,NCH-ISPOT,'/',1,1) IF(ISPOT.LE.0)GOTO114 ISPOT2=LSTRNG(QUALST,1,24,CMD,ISPOT,2) IF(ISPOT2.LE.0)GOTO112 ISPOT=ISPOT+1 IF(ISPOT.GE.NCH)GOTO114 GOTO111 112 IF(ISPOT.LE.0)ISPOT=1 ENCODE(ISPOT+20,113,MESAGE) 113 FORMAT(X,'^') ENCODE(24,115,MESAGE(74)) 115 FORMAT(1X,'* QUALIFER NOT LEGAL *') GOTO1 C C C SET UP CURRENT SELECTED QUALIFIERS TABLE C 114 ISPOT=LSTRNG(CMD,1,80,'/N',1,2) IF(ISPOT.GT.0)QUETAB(2)=1 ISPOT=LSTRNG(CMD,1,80,'/V',1,2) IF(ISPOT.GT.0.AND.QUETAB(2).GT.0)GOTO120 IF(ISPOT.GT.0)QUETAB(2)=2 ISPOT=LSTRNG(CMD,1,80,'/I',1,2) IF(ISPOT.GT.0.AND.QUETAB(3).GT.0)GOTO120 IF(ISPOT.GT.0)QUETAB(3)=1 ISPOT=LSTRNG(CMD,1,80,'/F',1,2) IF(ISPOT.GT.0.AND.QUETAB(3).GT.0)GOTO120 IF(ISPOT.GT.0)QUETAB(3)=2 ISPOT=LSTRNG(CMD,1,80,'/A',1,2) IF(ISPOT.GT.0.AND.QUETAB(3).GT.0)GOTO120 IF(ISPOT.GT.0)QUETAB(3)=3 ISPOT=LSTRNG(CMD,1,80,'/R',1,2) IF(ISPOT.GT.0.AND.QUETAB(3).GT.0)GOTO120 IF(ISPOT.GT.0)QUETAB(3)=4 ISPOT=LSTRNG(CMD,1,80,'/O',1,2) IF(ISPOT.GT.0.AND.QUETAB(3).GT.0)GOTO120 IF(ISPOT.GT.0)QUETAB(3)=5 ISPOT=LSTRNG(CMD,1,80,'/P',1,2) IF(ISPOT.GT.0)QUETAB(4)=2 ISPOT=LSTRNG(CMD,1,80,'/D',1,2) IF(ISPOT.GT.0.AND.QUETAB(4).GT.0)GOTO120 IF(ISPOT.GT.0)QUETAB(4)=3 ISPOT=LSTRNG(CMD,1,80,'/G',1,2) IF(ISPOT.GT.0.AND.QUETAB(4).GT.0)GOTO120 IF(ISPOT.GT.0)QUETAB(4)=4 GOTO130 120 IF(ISPOT.EQ.0)ISPOT=1 ENCODE(ISPOT+20,125,MESAGE) 125 FORMAT(X,'^') ENCODE(30,126,MESAGE(74)) 126 FORMAT(' * DUPULICATE QUALIFIER TYPE *') GOTO1 C C C CHECK TO SEE IF THE SELECTED QUALIFIERS ARE ALLOWABLE FOR THE C SELECTED COMMAND C 130 DO 131 I=3,6 IF(QUETAB(I-1).GT.0.AND.QUAKEY(I,QUETAB(1)).EQ.0)GOTO155 131 CONTINUE IF(QUETAB(1).EQ.6.AND.QUETAB(3).EQ.2)GOTO155 GOTO170 155 ENCODE(43,160,MESAGE) 160 FORMAT(' * QUALIFIER NOT ALLOWED FOR THIS COMMAND *') GOTO1 C C C VALIDATE ARGUMENTS C 170 CALL CLRBUF(AGIOCT,6,1,6) CALL PUTBLK(AGASCI,36,1,36) CALL PUTBLK(FSPEC,24,1,24) CALL CLRBUF(IREG,1,1,1) CALL CLRBUF(CMDTAB,7,1,7) IF(ARGKEY(2,QUETAB(1)).EQ.0)GOTO300 DO 180 IARG=1,ARGKEY(2,QUETAB(1)) ISPOT=0 IF(ARGKEY(2+IARG,QUETAB(1)).GT.100)GOTO174 DO 175 II=1,IARG ISPOT=LSTRNG(CMD,ISPOT+1,NCH-ISPOT,' ',1,1) IF(ISPOT.LE.0)GOTO176 175 CONTINUE I=ARGKEY(2+IARG,QUETAB(1)) 172 ISPOT2=LSTRNG(CMD,ISPOT+1,NCH-ISPOT-1,' ',1,1)-1 ISPOT3=LSTRNG(CMD,ISPOT+1,NCH-ISPOT-1,'/',1,1)-1 IF(ISPOT2.LE.0)ISPOT2=NCH IF(ISPOT3.LT.ISPOT2.AND.ISPOT3.GT.ISPOT)ISPOT2=ISPOT3 IF(QUETAB(3).EQ.5.AND.QUETAB(1).EQ.15)GOTO190 GOTO(190,200,210,220,230,240),I 174 DO 173 II=1,IARG ISPOT=LSTRNG(CMD,ISPOT+1,NCH-ISPOT,' ',1,1) IF(ISPOT.LE.0)GOTO178 173 CONTINUE I=ARGKEY(2+IARG,QUETAB(1))-100 GOTO172 178 IF(QUETAB(3).EQ.2.AND.QUETAB(1).GE.5.AND.QUETAB(1).LE.7 + .AND.RFLG.EQ..FALSE.)GOTO227 GOTO300 176 ENCODE(24,177,MESAGE) 177 FORMAT(' * ARGUMENT IS MISSING *') GOTO1 C C OCTAL ARGUMENT DESIRED C 190 DO 192 I=ISPOT+1,ISPOT2 IF(CMD(I).LT."60.OR.CMD(I).GT."67)GOTO195 192 CONTINUE IF(ISPOT2-ISPOT.GT.6)GOTO195 DECODE(ISPOT2-ISPOT,193,CMD(ISPOT+1)),AGIOCT(IARG) 193 FORMAT(O) CMDTAB(1)=CMDTAB(1)+1 CMDTAB(IARG+1)=1 ISPOT=ISPOT+1 GOTO180 195 ENCODE(34,196,MESAGE)IARG 196 FORMAT(' * ILLEGAL OCTAL ARGUMENT NO. ',I2,' *') GOTO1 C C INTEGER ARGUMENT DESIRED C 200 DO 202 I=ISPOT+1,ISPOT2 IF(CMD(I).LT."60.OR.CMD(I).GT."71)GOTO204 202 CONTINUE IF(ISPOT2-ISPOT.GT.5)GOTO204 DECODE(ISPOT2-ISPOT,203,CMD(ISPOT+1)),AGIOCT(IARG) 203 FORMAT(I) CMDTAB(1)=CMDTAB(1)+1 CMDTAB(IARG+1)=1 ISPOT=ISPOT+1 GOTO180 204 ENCODE(36,205,MESAGE)IARG 205 FORMAT(' * ILLEGAL INTEGER INPUT ARG NO. ',I2,'*') GOTO1 C C ASCII INTEGER OCTAL ARGUMENT DEPENDING ON C QUALIFIER NO. 3(QUETAB(2)). C 210 GOTO(200,227,220,220),QUETAB(3) GOTO190 220 IF(ISPOT2-ISPOT.GT.6)GOTO225 CALL STRMOV(CMD,ISPOT+1,ISPOT2-ISPOT,AGASCI(1,IARG),1) IF(ISPOT2-ISPOT.LT.6) + CALL STRMOV(' ',ISPOT2-ISPOT+1,6-(ISPOT2-ISPOT), + AGASCI(1,IARG),ISPOT2-ISPOT+1) CMDTAB(1)=CMDTAB(1)+1 CMDTAB(IARG+1)=2 ISPOT=ISPOT+1 GOTO180 225 ENCODE(34,226,MESAGE)IARG 226 FORMAT(' * ILLEGAL ASCII ARGUMENT NO. ',I2,' *') GOTO1 C C REAL NUMBER INPUT C 227 IF(QUETAB(1).EQ.6)GOTO155 DO 1228 IARG2=1,2 TYPE 1227,IARG2 1227 FORMAT('$ENTER REAL ARG NO.: ',I3,'>') READ(5,*)REALS(IARG2) IF(REALS(IARG2).EQ.0.0)GOTO1229 NBYTES=IARG2*4 CMDTAB(1)=CMDTAB(1)+1 CMDTAB(IARG2+2)=5 1228 CONTINUE 1229 IF(IARG2.EQ.1)GOTO1 AGIOCT(IARG)=NBYTES RFLG=.TRUE. GOTO180 C C C REGISTER INPUT C 230 IF(ISPOT2-ISPOT.GT.1)GOTO235 IF(CMD(ISPOT+1).LT."60.OR.CMD(ISPOT+1).GT."65)GOTO235 DECODE (1,233,CMD(ISPOT+1)),IREG 233 FORMAT(I1) CMDTAB(1)=CMDTAB(1)+1 CMDTAB(IARG+1)=3 ISPOT=ISPOT+1 GOTO180 235 ENCODE(41,236,MESAGE)IARG 236 FORMAT(' * ILLEGAL REGISTER NO. ARGUMENT NO. ',I2,' *') GOTO1 C C FILE SPEC ARGUMENT C 240 IF(ISPOT2-ISPOT.GT.24)GOTO245 CALL PUTBLK(FSPEC,24,1,24) CALL STRMOV(CMD(ISPOT+1),1,ISPOT2-ISPOT,FSPEC,1) CMDTAB(1)=CMDTAB(1)+1 CMDTAB(IARG+1)=4 ISPOT=ISPOT+1 GOTO180 245 ENCODE(33,246,MESAGE)IARG 246 FORMAT(' * ILLEGAL FILE SPEC ARG NO. ',I2,' *') GOTO1 C C C 180 CONTINUE 300 IF(QUETAB(8).EQ.1)GOTO310 GOTO330 310 IF(NCH.LE.0)GOTO330 WRITE(11,311)(CMD(I),I=1,NCH) 311 FORMAT(A1) 330 IF(BEEFLG.EQ..TRUE.)CALL POSITN(24,1) RETURN 340 QUETAB(1)=14 GOTO300 END