C C F4P ONLINE DEBUGGER TOOL PRE-PROSSESOR C C THIS PROGRAM WILL LOCATE ALL MOV AND INC INSTRUCTIONS C THAT INCREMENT THE VALUE OF THE GLOBAL VARIABLE $SEQC. C THESE INSTRUCTIONS ARE REPLACED WITH TRAP INSTRUCTIONS, C AND THE OPERANDS ARE REPLACED WITH NOPS AND NUMERIC VALUES. C C THE RESTRICTIONS OF THIS PROGRAM IS THAT IT WILL NOT ACCEPT C A TASK IMAGE LARGER THAN 1000 BLOCKS. THE TASK MAY ONLY C HAVE A TOTAL OF 99 SUBROUTINES. C C OVERLAY CAPABILITES ARE LIMITED TO 100 OVERLAID SEGMENTS C C PROGRAMMER: WARREN FRIEDLAND C C DATE JANUARY 22, 1981 C BYTE LINE(80),MPFILE(11),SPACE,BLK(6),VARS(6) BYTE CODE(6),TKFILE(11),SPACE2,ALVC(6),INS(80) C INTEGER LENARY(100),SEQC,BLOCK(256),LENRY2(100) INTEGER OVER(100) C C BUFFERS FOR MAP AND TASK FILES DATA LINE/80*' '/ DATA BLOCK/256*0/ C DATA IONCE/0/ C C ARRAY CONTAINING MAP FILE NAME DATA MPFILE/6*' ','.','M','A','P',0/ C C ARRAY CONTAINING TASK FILE NAME DATA TKFILE/6*' ','.','T','S','K',0/ C C CODE PROGRAM SEGMENT DATA CODE/'$','C','O','D','E','1'/ C C UNDEFINED CODE PROGRAM SEGMENT DATA BLK/'.',' ','B','L','K','.'/ C C VARIABLE DATA PROGRAM SEGMENT DATA VARS/'$','V','A','R','S',' '/ C C ENTRY POINT FOR AUTO-LOAD OVERLAYS DATA ALVC/'$','$','A','L','V','C'/ C C ARRAY OF CODE LENGTHS DATA LENARY/100*0/ C C ARRAY OF OVERLAY LENGTHS DATA LENRY2/100*0/ C C KEY TO MAP FILE DATA KEY/1/ C C $$ALVC VARIABLE DATA IALVC/0/ C CALL GETMCR (INS,IRD) IF (IRD.LT.0) GOTO 602 C C GET FILE NAME JJ=0 DO 888 I=5,10 IF ((INS(I).EQ.' ').OR.(INS(I).EQ.0)) GOTO 889 JJ=JJ+1 888 CONTINUE C 889 IF (JJ.LT.6) JJ=JJ-1 JJJ=6-JJ C C C COMPLETE FILE NAME FOR MAP FILE C DO 3 I=1,JJ TKFILE(I+JJJ)=INS(4+I) 3 MPFILE(I+JJJ)=INS(4+I) C C OPEN MAP FILE C OPEN (UNIT=1,NAME=MPFILE,TYPE='OLD',ERR=600) C C SET LENGTH COUNTERS TO ZERO C ICOUNT=0 JCOUNT=0 5 READ (1,6,END=15,ERR=604) LINE 6 FORMAT (80A1) C GOTO (403,407,10,14,415,407,425) KEY C C FIND VARIABLE BASE 403 DO 404 K=1,6 IF (LINE(K).NE.BLK(K)) GOTO 407 404 CONTINUE DECODE (6,406,LINE(27),ERR=8000) IVARBS 406 FORMAT (O6) C VARIABLE BASE IVARBS=IVARBS+"20 KEY=2 GOTO 5 C C CHECK FOR BEGINING OF CODE PROGRAM SEGMENT 407 DO 7 I=1,6 IF (LINE(I).NE.CODE(I)) GOTO 5 7 CONTINUE IF (KEY.GT.3) GOTO 424 KEY=3 GOTO 5 C C C RECORD START AND LENGTHS OF $CODE1 AND IT'S SEGMENTS C 10 IONCE=IONCE+1 IF ((LINE(1).NE.' ').AND.(LINE(2).NE.' ')) GOTO 310 C C DECODE LOCATION AND LENGTH C 412 DECODE (13,11,LINE(27),ERR=8000) IBEGIN,LENGTH 11 FORMAT (O6,1X,O6) C IF (IONCE.EQ.1) IBECOD=IBEGIN ICOUNT=ICOUNT+1 LENARY(ICOUNT)=LENGTH GOTO 5 C WE ARE NOW DONE WITH THE $CODE1 PROGRAM SEGMENT C C WE ARE FINISHED WITH $CODE1 SEGMENTS NOW GO ON TO NEXT SEGMENT C 310 KEY=4 GOTO 5 C C C FIND ADDR. OF VARIABLE BASE C 14 DO 411 I=1,6 IF (VARS(I).NE.LINE(I)) GOTO 5 411 CONTINUE C DECODE (6,406,LINE(27),ERR=8000) IMMNT KEY=5 GOTO 5 C C CHECK FOR OVERLAYS C 415 DO 416 I=1,6 IF (LINE(I).NE.ALVC(I)) GOTO 5 416 CONTINUE C DECODE(6,406,LINE(27),ERR=8000) IALVC KEY=6 GOTO 5 C C THIS STATEMENT IS WHEN JUST A PLACE HOLDER WHEN THE PROGRAM C IS SHEARCHING FOR THE NEXT CODE PROGRAM SEGMENT C 423 KEY=6 GOTO 5 C C OVERLAY CODE SEGMENT FLAG 424 KEY=7 GOTO 5 C C C FIND OVERLAID SEGMENT LENGTHS C 425 IF((LINE(1).NE.' ').AND.(LINE(2).NE.' ')) GOTO 423 C DECODE (6,406,LINE(34),ERR=8000) LENGTH JCOUNT=JCOUNT+1 LENRY2(JCOUNT)=LENGTH GOTO 5 15 CLOSE (UNIT=1) C C C OPEN TASK-IMAGE FILE C OPEN (UNIT=2,NAME=TKFILE,TYPE='OLD',ERR=606 1,ACCESS='DIRECT',RECORDSIZE=128,MAXREC=1000) C 20 READ (2'1,ERR=608) BLOCK C ISTBLK=BLOCK(120)+1 ISAVE=ISTBLK C C LOCATE THE BEGINNING OF DEBUG.OBJ C C 22 READ (2'ISTBLK,ERR=608) BLOCK IF (IVARBS.LT.512) GOTO 33 IBECOD=IBECOD-512 IVARBS=IVARBS-512 ISTBLK=ISTBLK+1 GOTO 22 C C INPUT VARIABLE BASE 33 IVARBS=IVARBS/2+1 BLOCK(IVARBS)=IMMNT WRITE (2'ISTBLK,ERR=610) BLOCK C C LOCATE THE BEGINNING OF CODE C 222 READ (2'ISTBLK,ERR=608) BLOCK IF (IBECOD.LT.512) GOTO 333 ISTBLK=ISTBLK+1 IBECOD=IBECOD-512 GOTO 222 C 333 ISBSRC=IBECOD/2+1 IF (BLOCK(ISBSRC).EQ."4767) GOTO 35 C WRITE (5,34) 34 FORMAT (' SOMETHING WENT WRONG DUMMY') CLOSE (UNIT=2) GOTO 900 C 35 DO 36 M=1,10 ISBSRC=ISBSRC+1 IF (ISBSRC.NE.256) GOTO 36 C C IF SEQC IS STORED IN LAST WORD OF BLOCK, FIND VALUE FOR SEQC IF(M.EQ.10) SEQC=BLOCK(ISBSRC)+(ISBSRC*2-2) ISTBLK=ISTBLK+1 READ (2'ISTBLK,ERR=608) BLOCK ISBSRC=0 IF (M.EQ.10) GOTO 336 GOTO 36 C C WHEN SEQC IS STORED IN LAST WORD OF BLOCK, SET VARIABLES 336 NUMBLK=512 ISBSRC=1 GOTO 39 C 36 CONTINUE C C FIND VALUE FOR $SEQC C NUMBLK=0 SEQC=NUMBLK+BLOCK(ISBSRC)+(ISBSRC*2-2) C GO THOUGH THE REST OF THE ROOT AND INSERT TRAPS 39 LENARY(1)=LENARY(1)-22 C DO 277 LAP=1,ICOUNT C LEN=LENARY(LAP) C C INSERT TRAPS INTO CODE PREPRAM SEGMENT C CALL TRAP (ISBSRC,ISTBLK,NUMBLK,SEQC,LEN,BLOCK) C 277 CONTINUE C C C CHECK TO SEE IF THERE ARE OVERLAYS C IF (IALVC.EQ.0) GOTO 899 C IY=IALVC.AND."000777 IR=IALVC.AND."377000 IALVC=IY/2+3 IR=IR/"1000 C C GET BLOCK OF SEGMENT DESCRIPTOR DATA C ISTBLK=ISAVE+IR READ (2'ISTBLK,ERR=608) BLOCK C DO 800 L=1,100 OVER(L)=BLOCK(IALVC) IF (OVER(L).EQ.0) GOTO 810 C IF (IALVC.GT.252) GOTO 804 C IALVC=IALVC+4 GOTO 800 C 804 ISTBLK=ISTBLK+1 READ (2'ISTBLK,ERR=608) BLOCK IALVC=IALVC-256+4 C 800 CONTINUE C C C FIND LOCATION FOR SEGMENT DESCRIBTOR BLOCK C 810 DO 820 I=1,JCOUNT C IO=OVER(I) IN=IO.AND."377000 IP=IO.AND."000777 IN=IN/"1000 ISTBLK=ISAVE+IN C C READ IN BLOCK C READ (2'ISTBLK,ERR=608) BLOCK C IO=IP/2+1 C C FIND RELATIVE BLOCK NUMBER OF OVERLAID SEGMENTS C IN=BLOCK(IO) IV=IN.AND."007777 C ISTBLK=ISAVE+IV C READ (2'ISTBLK,ERR=608) BLOCK C SEQC=BLOCK(9)+16 NUMBLK=0 ISBSRC=1 LEN=LENRY2(I) C C INSERT TRAPS INTO OVERLAID CODE SEGMENTS C CALL TRAP (ISBSRC,ISTBLK,NUMBLK,SEQC,LEN,BLOCK) C 820 CONTINUE C CLOSE FILE AND EXIT C 899 CLOSE (UNIT=2) GOTO 900 600 WRITE (5,601) 601 FORMAT (' ERROR OPENING MAP FILE') GOTO 900 602 WRITE (5,603) IRD 603 FORMAT (' ERROR',I4,' USING GET COMMAND LINE') GOTO 900 604 WRITE (5,605) 605 FORMAT (' ERROR READING MAP FILE') GOTO 900 606 WRITE (5,607) 607 FORMAT (' ERROR OPENING TASK IMAGE') GOTO 900 608 WRITE (5,609) 609 FORMAT (' ERROR READING BLOCK FROM TASK IMAGE') GOTO 900 610 WRITE (5,611) 611 FORMAT (' ERROR WRITING BLOCK TO TASK IMAGE') GOTO 900 8000 WRITE (5,8001) 8001 FORMAT ( 'DECODER ERROR') 900 CONTINUE END SUBROUTINE TRAP (ISBSRC,ISTBLK,NUMBLK,SEQC,LEN,BLOCK) C INTEGER BLOCK(256),SEQC C DO 275 I=1,LEN,2 ISBSRC=ISBSRC+1 IF (ISBSRC.LT.256) GOTO 202 ISTBLK=ISTBLK+1 NUMBLK=NUMBLK+512 READ (2'ISTBLK,ERR=608) BLOCK ISBSRC=1 C C 202 IF (BLOCK(ISBSRC).EQ."12767) GOTO 225 IF (BLOCK(ISBSRC).EQ."5267) GOTO 250 GOTO 275 C C MOV INSTRUCTIONS C 225 IF (ISBSRC.EQ.256) GOTO 230 IF (ISBSRC.EQ.255) GOTO 235 C ISBSRC=ISBSRC+2 GOTO 240 C 230 ISTBLK=ISTBLK+1 READ (2'ISTBLK,ERR=608) BLOCK NUMBLK=NUMBLK+512 ISBSRC=2 ITYPE=1 GOTO 236 C 235 ISTBLK=ISTBLK+1 READ (2'ISTBLK,ERR=608) BLOCK NUMBLK=NUMBLK+512 ISBSRC=1 ITYPE=2 GOTO 236 C C CHECK TO SEE IF $SECQ SPANS BLOCKS C 236 ISUM=NUMBLK+BLOCK(ISBSRC)+(ISBSRC*2-2) IF (ISUM.EQ.SEQC) GOTO 237 GOTO 275 C C READ IN LAST BLOCK AND INSERT TRAP C 237 II=ISTBLK-1 READ (2'II,ERR=608) BLOCK IF (ITYPE.EQ.1) GOTO 238 IF (ITYPE.EQ.2) GOTO 239 C WRITE (5,234) ITYPE 234 FORMAT (' ERROR WHEN $SEQC SPANS BLOCKS',' ITYPE=',I4) GOTO 900 C C ISPBLK IS VARIABLE USED WHEN $SEQC SPANS BLOCKS C 238 ISPBLK=255 C INSERT SST TRAP BLOCK(ISPBLK)="104504 C SEQUENCE NUMBER LEAVE NEXT WORD ALONE C C WRITE BLOCK TO DISK C WRITE (2'II,ERR=610) BLOCK C C READ IN CURRENT BLOCK READ (2'ISTBLK,ERR=608) BLOCK C C INSERT NOP INTO NEXT WORD ISBSRC=1 BLOCK(ISBSRC)=160 C C WRITE NEW ENTRY INTO BLOCK WRITE (2'ISTBLK,ERR=610) BLOCK C GOTO 275 C 239 ISPBLK=256 C TRAP BLOCK(ISPBLK)="104504 C C WRITE BLOCK BACK TO DISK C WRITE (2'II,ERR=610) BLOCK C C READ CURRENT BLOCK BACK IN C READ (2'ISTBLK,ERR=608) BLOCK C C SEQUENCE NUMBER LEAVE NEXT WORD ALONE C C NOP ISPBLK=2 BLOCK(ISBSRC)=160 C GOTO 275 C C INCERT TRAP AND NOPS WITHIN THE SAME BLOCK C 240 ISUM=BLOCK(ISBSRC)+NUMBLK+(ISBSRC*2-2) C C IS THIS LOCATION $SEQC ? C IF (ISUM.NE.SEQC) GOTO 275 C N=ISBSRC-2 C BLOCK(N)="104504 C C SEQUENCE NUMBER LEAVE NEXT WORD ALONE C C NOP C BLOCK(ISBSRC)=160 C C C WRITE BLOCK BACK ONTO DISK C WRITE (2'ISTBLK,ERR=610) BLOCK C GOTO 275 C C INC INSTRUCTION C 250 IF (ISBSRC.EQ.256) GOTO 255 C ISBSRC=ISBSRC+1 C ISUM=BLOCK(ISBSRC)+(ISBSRC*2-2)+NUMBLK IF (ISUM.NE.SEQC) GOTO 275 C J=ISBSRC-1 BLOCK(J)="104504 C BLOCK(ISBSRC)=-1 C C WRITE BLOCK BACK ONTO DISK C WRITE (2'ISTBLK,ERR=610) BLOCK C GOTO 275 C C WHEN $SEQC SPANS BLOCKS C 255 II=ISTBLK-1 C READ LAST BLOCK READ (2'II,ERR=608) BLOCK C ISPBLK=256 BLOCK(ISPSBK)="104504 C C WRITE BLOCK TO DISK C WRITE (2'II,ERR=610) BLOCK C C READ CURRENT BLOCK BACK IN C 265 READ (2'ISTBLK,ERR=608) BLOCK ISBSRC=1 C INSERT A -1 TO SIGNAL A INC BLOCK(ISBSRC)=-1 C 275 CONTINUE 900 RETURN C 608 WRITE (5,609) 609 FORMAT (' ERROR READING TASK FILE') RETURN 610 WRITE (5,611) 611 FORMAT (' ERROR WRITING TO TASK FILE') RETURN END