FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 1   

TIRANL.FTN   	/TR:BLOCKS/WR


        C

        C

        C	TIRANL  -- TEXT AND INFORMATION RECORD ANALYSER

        C

        C

        C	COPYRIGHT (C) 1976,1977,1978

        C	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

        C

        C	THIS SOFTWARE IS FURNISHED UNDER  A LICENSE FOR USE ONLY  ON  A

        C	SINGLE COMPUTER SYSTEM AND MAY BE  COPIED ONLY WITH  THE INCLU-

        C	SION OF  THE  ABOVE  COPYRIGHT NOTICE.  THIS SOFTWARE,  OR  ANY

        C	OTHER COPIES THEREOF, MAY NOT BE  PROVIDED  OR  OTHERWISE  MADE

        C	AVAILABLE TO ANY OTHER PERSON EXCEPT  FOR  USE  ON  SUCH SYSTEM

        C	AND TO  ONE WHO AGREES  TO  THESE LICENSE  TERMS.  TITLE TO AND

        C	OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.

        C

        C	THE INFORMATION IN THIS SOFTWARE  IS  SUBJECT TO CHANGE WITHOUT

        C	NOTICE AND SHOULD NOT BE CONSTRUED  AS  A COMMITMENT BY DIGITAL

        C	EQUIPMENT CORPORATION.

        C

        C	DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS

        C	SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.

        C

        C

        C	T.J. PORTER 	01-AUG-76

        C

        C

        C

        C

        C		THIS SUBROUTINE ANALYSES THE VALIDITY AND

        C	CONTENT OF TEXT INFORMATION AND RELOCATION

        C	RECORDS.

        C

        C

        C

        C  MODIFICATIONS:

        C

        C

        C NO.		DATE		PROGRAMMER		PURPOSE

        C ---		----		----------		-------

        C

        C 01		15-AUG-76	K.D. MORSE		DELETE COMMANDS:

        C							STOADR,STOAR,STOLO.

        C 02		20-AUG-76	K.D. MORSE		OMIT PRMODE CHECKS

        C							AND TYPE VS WRITE CODE

        C 03		23-AUG-76	K.D. MORSE		ALTERED COMMANDS:

        C							INSV,STOV.

        C 04		25-AUG-76	K.D. MORSE		ADD STACK COUNTER

        C 05		01-SEP-76	K.D. MORSE		COMMANDS ADDED: 

        C							STOPIDR,STOPICR,STOB

        C							STOW,STORB,STORW,

        C							STABFI,STABFW,STABLI,

        C							STAEPM.

        C 06		12-NOV-76	K.D. MORSE		ADD OCTAL OUTPUT 

        C							TO ILLEGAL NAME CHAR.

        C 07		22-MAR-77	K.D. MORSE		FIX STAWFI BUG.

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 2   

TIRANL.FTN   	/TR:BLOCKS/WR


        C 08		2-FEB-78	K.D. MORSE		ADD TYPE 5 RECORDS, TBT.

        C 09		8-MAY-78	K.D. MORSE		ADD STKCKA (13) AND

        C							SELECT (64), AND

        C							REDEF (65).

        C

        C

        C

        C

        C

0001    	SUBROUTINE	TIRANL

        C

        C

0002    	LOGICAL*1	DUMPIT

        C

0003    	INTEGER SUBCNT

0004    	INTEGER		TIRLNG,RECNUM,CMDNUM,CMDPNT,FLDLNG,FLDPNT,DBG,TBT

0005    	INTEGER*4	VALUE

0006    	INTEGER		PSECT,PSGSD,PSTIR,PSCNT,WVALU,CMDINX,FLDWID

0007    	INTEGER		FLDPOS,COMAND,TIRMIN,TIRMAX,PRMODE,ERRCNT,WRTERR

0008    	INTEGER		PROCRC,TITLRC,COPYRC,STKCKA,SELECT,REDEFN,TIRCNT

        C

0009    	REAL*8	STAG,STASB,STASW,STAL,STPBB,STPBW,STPBL,STAUSB

0010    	REAL*8	STAUSW,STABFI,STAWFI,STALFI,STAEPM,STACKA

0011    	REAL*8	STOSB,STOSW,STOL,STOBD,STOWD,STOLD

0012    	REAL*8	STOLI,STOIDR,STOICR,STORSB,STORSW,STORL,STOVPS

0013    	REAL*8	STOUSB,STOUSW,STORUB,STORUW,STOB,STOW,STORB,STORW,NOP

0014    	REAL*8	ADD,SUB,MUL,DIV,AND,INOR,EXOR,NEG,COMPL

0015    	REAL*8	INSVPS,ASH,USH,ROT,SETRB,AUGRB,SEL,REDEF

        C

0016    	BYTE	RECORD(512),LSTREC,EOM,DUMMY(4),RECTYP

0017    	BYTE	STANMS(8,14),STONMS(8,21),OPNAMS(8,16)

0018    	BYTE	CTLNMS(8,2),STOVFD,INSVFD,AUGMNT,HEXARA(8)

0019    	BYTE	STAMIN,STAMAX,STOMIN,STOMAX,OPMIN,OPMAX

0020    	BYTE	CTLMIN,CTLMAX,BYTCNT,BLANK,ZERO,NINE

0021    	BYTE	STABFD,STAWFD,STALFD,STORSF,STOBLF,STORBF,STORWF

        C

0022    	COMMON	RECORD,TIRLNG,RECNUM,LSTREC,DUMPIT,PSCNT,PSGSD,PSTIR

0023    	COMMON	MXRLNG,PRMODE,ERRCNT,WRTERR,SUBCNT,ISTACK

0024    	COMMON	PROCRC,TITLRC,COPYRC,TIRCNT

        C

0025    	EQUIVALENCE (STAG,STANMS(1,1)),(STASB,STANMS(1,2))

0026    	EQUIVALENCE (STASW,STANMS(1,3)),(STAL,STANMS(1,4))

0027    	EQUIVALENCE (STPBB,STANMS(1,5)),(STPBW,STANMS(1,6))

0028    	EQUIVALENCE (STPBL,STANMS(1,7)),(STAUSB,STANMS(1,8))

0029    	EQUIVALENCE (STAUSW,STANMS(1,9)),(STABFI,STANMS(1,10))

0030    	EQUIVALENCE (STAWFI,STANMS(1,11)),(STALFI,STANMS(1,12))

0031    	EQUIVALENCE (STAEPM,STANMS(1,13)),(STACKA,STANMS(1,14))

        C

0032    	EQUIVALENCE (STOSB,STONMS(1,1)),(STOSW,STONMS(1,2))

0033    	EQUIVALENCE (STOL,STONMS(1,3)),(STOBD,STONMS(1,4))

0034    	EQUIVALENCE (STOWD,STONMS(1,5)),(STOLD,STONMS(1,6))

0035    	EQUIVALENCE (STOLI,STONMS(1,7)),(STOIDR,STONMS(1,8))

0036    	EQUIVALENCE (STOICR,STONMS(1,9)),(STORSB,STONMS(1,10))

0037    	EQUIVALENCE (STORSW,STONMS(1,11)),(STORL,STONMS(1,12))

0038    	EQUIVALENCE (STOVPS,STONMS(1,13)),(STOUSB,STONMS(1,14))

0039    	EQUIVALENCE (STOUSW,STONMS(1,15)),(STORUB,STONMS(1,16))

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 3   

TIRANL.FTN   	/TR:BLOCKS/WR


0040    	EQUIVALENCE (STORUW,STONMS(1,17)),(STOB,STONMS(1,18))

0041    	EQUIVALENCE (STOW,STONMS(1,19)),(STORB,STONMS(1,20))

0042    	EQUIVALENCE (STORW,STONMS(1,21))

        C

0043    	EQUIVALENCE (NOP,OPNAMS(1,1)),(ADD,OPNAMS(1,2))

0044    	EQUIVALENCE (SUB,OPNAMS(1,3)),(MUL,OPNAMS(1,4))

0045    	EQUIVALENCE (DIV,OPNAMS(1,5)),(AND,OPNAMS(1,6))

0046    	EQUIVALENCE (INOR,OPNAMS(1,7)),(EXOR,OPNAMS(1,8))

0047    	EQUIVALENCE (NEG,OPNAMS(1,9)),(COMPL,OPNAMS(1,10))

0048    	EQUIVALENCE (INSVPS,OPNAMS(1,11)),(ASH,OPNAMS(1,12))

0049    	EQUIVALENCE (USH,OPNAMS(1,13)),(ROT,OPNAMS(1,14))

0050    	EQUIVALENCE (SEL,OPNAMS(1,15)),(REDEF,OPNAMS(1,16))

        C

0051    	EQUIVALENCE (SETRB,CTLNMS(1,1)),(AUGRB,CTLNMS(1,2))

        C

0052    	EQUIVALENCE (DUMMY(1),VALUE),(DUMMY(1),WVALU)

0053    	EQUIVALENCE (PSECT,FLDWID),(FLDPOS,FLDLNG)

        C

0054    	EQUIVALENCE (RECORD(1),RECTYP)

        C

0055    	DATA	EOM/3/,TIRMIN,TIRMAX/2,512/,DBG/4/,TBT/5/

        C

0056    	DATA	STAG,STASB,STASW,STAL/' STAG   ','STASB   ','STASW   ',

        	1'STAL    '/

0057    	DATA	STPBB,STPBW,STPBL/'STPBB   ','STPBW   ','STPBL   '/

0058    	DATA	STAUSB,STAUSW/'STAUSB  ','STAUSW  '/

0059    	DATA	STABFI,STAWFI/'STABFI  ','STAWFI  '/

0060    	DATA	STALFI,STAEPM/'STALFI  ','STAEPM  '/

0061    	DATA	STACKA/'STKCKARG'/

        C

0062    	DATA	STOSB,STOSW,STOL/'STOSB   ','STOSW   ','STOL    '/

0063    	DATA	STOBD,STOWD,STOLD/'STOBD   ','STOWD   ','STOLD   '/

0064    	DATA	STOLI,STOIDR,STOICR/'STOLI   ','STOPIDR ','STOPICR '/

0065    	DATA	STORSB,STORSW,STORL/'STORSB  ','STORSW  ','STORL   '/

0066    	DATA	STOVPS,STOUSB,STOUSW/'STOVPS  ','STOUSB  ','STOUSW  '/

0067    	DATA	STORUB,STORUW,STOB/'STORUB  ','STORUW  ',' STOB   '/

0068    	DATA	STOW,STORB,STORW/' STOW   ','STORB   ','STORW   '/

        C

0069    	DATA	NOP,ADD,SUB,MUL,DIV/'NOP     ','ADD     ','SUB     ',

        	1'MUL     ','DIV     '/

0070    	DATA	AND,INOR,EXOR /'AND     ','IOR     ','EOR     '/

0071    	DATA	NEG,COMPL,INSVPS/'NEG     ','COM     ','INSVPS  '/

0072    	DATA	ASH,USH,ROT/'ASH     ','USH     ','ROTATE  '/

0073    	DATA	SEL,REDEF/'SELECT  ','REDEFINE'/

        C

0074    	DATA	SETRB,AUGRB/'SETRB   ','AUGRB   '/

        C

0075    	DATA	STAMIN,STAMAX/0,13/,STOVFD,INSVFD/32,60/

0076    	DATA	STABFD,STAWFD,STALFD,STORSF/9,10,11,29/

0077    	DATA	STOBLF,STORBF,STORWF/31,39,40/

0078    	DATA	STOMIN,STOMAX/20,40/

0079    	DATA	OPMIN,OPMAX/50,65/

0080    	DATA	MINARG,MAXARG/0,255/

0081    	DATA	CTLMIN,CTLMAX/80,81/,AUGMNT/81/

0082    	DATA	STKCKA,SELECT,REDEFN/13,64,65/

        C

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 4   

TIRANL.FTN   	/TR:BLOCKS/WR


0083    	DATA	NAMMAX/15/,BLANK,ZERO,NINE/' ','0','9'/

        C

        C

        C	FORMAT STATEMENTS

        C

        C

0084    10	FORMAT(/'>>>>>>>>>>> RECORD',I4,' IS A TEXT/RELOCATION ',

        	1I4,' BYTES LONG <<<<<<<<<<<<')

0085    20	FORMAT (T5'*****INVALID SEQUENCE - SHOULD NOT FOLLOW',

        	1' EOM'/,T15,'OR BEGIN A MODULE')

0086    30	FORMAT (T10'COMMAND',I5,' IS STORE IMMEDIATE,'I4,' (DEC) BYTES',

        	17X,'STACK=',I3)		!++04 INCLUDE STACK COUNTER

0087    40	FORMAT (T5,'*****BYTE COUNT GOES BEYOND END OF RECORD (',

        	1I4,' BYTES)')

0088    50	FORMAT (T5,'*****COMMAND',I5,' IS RESERVED (',I3,')',24X,

        	1'STACK=',I3)

0089    60	FORMAT (T10,'COMMAND',I5,' IS ',7A1,' (',I3,')',26X,'STACK=',I3) !++04 INCLUDE STACK

0090    70	FORMAT (T5,'*****GLOBAL SYMBOL FIELD LENGTH (',I4,')',/

        	1,T15,'ILLEGAL - SHOULD BE 1 TO',I3,' CHARACTERS')

0091    80	FORMAT (T5,'*****GLOBAL SYMBOL CONTAINS ILLEGAL',

        	1' CHARACTER',/,T15,' CHARACTER ',I3,' IS ',A1,'  (',I3,' OCTAL)') !++06 OCTAL TOO

0092    90	FORMAT (T5,'*****FIRST CHARACTER OF GLOBAL SYMBOL IS'

        	1,/,T15,'NUMERIC OR BLANK')

0093    100	FORMAT (T10,'GLOBAL SYMBOL IS "',<NAMLNG>A1,'"')

0094    110	FORMAT (T10,'VALUE STACKED =',I11,' (DEC) ',O11,' (OCTAL)',

        	1/T40,8A1,' (HEXADECIMAL)')

0095    120	FORMAT (T10,'P - SECTION NUMBER =',I3)

0096    140	FORMAT (T10,'FIELD WIDTH =',I3,' STARTING AT BIT',I3)

0097    150	FORMAT(T5'*****REQUIRED DATA NOT CONTAINED WITHIN RECORD')

0098    160	FORMAT(T5'*****ILLEGAL RECORD LENGTH (',I4,' NOT BETWEEN'/

        	1T15,I2,' AND',I4,' BYTES')

0099    170	FORMAT(T5'*****ILLEGAL FIELD WIDTH - NOT BETWEEN 1 AND 32')

0100    180	FORMAT(T5'*****ILLEGAL STARTING BIT POSITION - NOT 0 TO 31')

0101    190	FORMAT(T10'IMMEDIATE BYTE STREAM (IN HEX) FOLLOWS:'/)

0102    200	FORMAT(T10'LOC. COUNTER AUGMENTED BY',I11,' (DEC)',

        	1O12,' (OCTAL)',/,T40,8A1,' (HEXADECIMAL)')

0103    210	FORMAT(/'>>>>>>>>>> RECORD',I4,' IS DEBUGGER INFORMATION '

        	1,I4,' BYTES LONG ',10('<'))

0104    220	FORMAT(T5,'*****COMMAND',I5,' IS ILLEGAL TYPE ',I3)

0105    230	FORMAT(/'>>>>>>>>>>>>>>> RECORD',I4,' IS TRACEBACK '

        	1,I4,' BYTES LONG ',16('<'))

0106    235	FORMAT(T10,'ARGUMENT INDEX IS ',I3)

0107    240	FORMAT(T10,'ARGUMENT VALIDATION CONTROL BYTE PASSING MECHANISM:')

0108    250	FORMAT(T15,'ARG$K_UNKNOWN  -  UNSPECIFIED')

0109    260	FORMAT(T15,'ARG$K_VALUE    -  BY VALUE')

0110    270	FORMAT(T15,'ARG$K_REF      -  BY REFERENCE')

0111    280	FORMAT(T15,'ARG$K_DESC     - BY DESCRIPTOR')

0112    290	FORMAT(T10,'ARGUMENT DESCRIPTION BYTE COUNT OF ',I4,' FOLLOWS:')

0113    300	FORMAT(T5,'*****ARGUMENT DESCRIPTOR MISSING FOR FORMAL ARGUMENT #',

        	1I5)

0114    310	FORMAT(T5,'*****RESERVED BIT #',I2,' SET IN ARGUMENT VALIDATION'

        	1,' CONTROL BYTE')

0115    320	FORMAT(T5,'*****FORMAL ARGUMENT DESCRIPTOR IS MISSING REMAINING'

        	1,' BYTE COUNT')

0116    330	FORMAT (T5,'*****BYTE COUNT GOES BEYOND END OF RECORD BY'

        	1,I4,' BYTES')

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 5   

TIRANL.FTN   	/TR:BLOCKS/WR


0117    340	FORMAT(T5,'*****ARGUMENT INDEX IS MISSING')

0118    350	FORMAT(T5,'*****INVALID ARGUMENT INDEX OF',I5,' NOT BETWEEN',I5,

        	1' AND',I5)

        C

        C---->		ANNOUNCE TIR AND CHECK THAT IT IS

        C			IN CORRECT SEQUENCE

        C

0119    	IF( RECTYP .EQ. DBG ) GO TO 450

0120    	IF (RECTYP .EQ. TBT) GO TO 460

        C

        C---->		ANNOUNCE TEXT/INFORMATION RECORD.

        C

0121    	WRITE(2,10,ERR=9000) RECNUM,TIRLNG

0122    	GO TO 550

        C

        C---->		ANNOUNCE DEBUGGER RECORD.

        C

0123    450	WRITE(2,210,ERR=9000) RECNUM,TIRLNG

0124    	GO TO 550

        C

        C---->		ANNOUNCE TRACEBACK RECORD.

        C

0125    460	WRITE(2,230,ERR=9000) RECNUM,TIRLNG

        C

        C

        C---->		CHECK RECORD ORDER.

        C

0126    550	IF (LSTREC.NE.EOM) GO TO 1000

0127    		ERRCNT = ERRCNT + 1

0128    		WRITE(2,20,ERR=9000)

        C

        C---->		DO SOME INITIALIZATION

        C

0129    1000	CMDNUM = 1

0130    	CMDPNT = TIRMIN

        C

        C---->		CHECK RECORD LENGTH.

        C

0131    	IF(TIRLNG .GE. TIRMIN .AND.(TIRLNG .LE. TIRMAX)) GO TO 1050

        C

0132    		ERRCNT = ERRCNT + 1

0133    		WRITE(2,160,ERR=9000) TIRLNG,TIRMIN,TIRMAX

0134    1030		DUMPIT = .TRUE.

0135    		RETURN

        C

        C---->		NOW ANALYSE THE NEXT COMMAND - FIRST

        C			CHECK FOR LEGALITY

        C

0136    1050	IF (RECORD(CMDPNT)) 1100,1300,1300

        C

        C---->		HERE FOR STORE IMMEDIATE - CHECK BYTE COUNT

        C

0137    1100	IMBYTS = RECORD(CMDPNT)

0138    	IMBYTS = -IMBYTS

0139    	IMBYTS = IMBYTS .AND. 255

        C

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 6   

TIRANL.FTN   	/TR:BLOCKS/WR


0140    	WRITE(2,30,ERR=9000) CMDNUM,IMBYTS,ISTACK !++04 INCLUDE STACK

0141    	WRITE(2,190,ERR=9000)

0142    	FLDLNG = IMBYTS

0143    	IF((CMDPNT + FLDLNG) .LE. TIRLNG) GO TO 1150

0144    		FLDLNG = TIRLNG - CMDPNT

0145    1150	FLDPNT = CMDPNT + 1

0146    	CALL HEXDMP(RECORD,FLDPNT,FLDLNG,PRMODE)

0147    	IF ((CMDPNT+IMBYTS).LE.TIRLNG) GO TO 1200

        C

        C---->		ERROR IN STORE IMMEDIATE COMMAND.

        C

0148    		ERRCNT = ERRCNT + 1

        C

0149    		WRITE(2,40,ERR=9000) TIRLNG

0150    		DUMPIT = .TRUE.

0151    		RETURN

        C

0152    1200	CMDPNT = CMDPNT+IMBYTS+1

0153    	GO TO 5000

        C

        C---->		HERE FOR ALL EXCEPT STORE IMMEDIATE

        C			CHECK LEGAL

        C

0154    1300	COMAND = RECORD(CMDPNT)

0155    	FLDPNT = CMDPNT

0156    	IF (COMAND.GE.STAMIN .AND.(COMAND.LE.STAMAX)) GO TO 1400

0157    	IF (COMAND.GE.STOMIN .AND.(COMAND.LE.STOMAX)) GO TO 2000

0158    	IF (COMAND.GE.OPMIN .AND.(COMAND.LE.OPMAX)) GO TO 3000

0159    	IF (COMAND.GE.CTLMIN .AND.(COMAND.LE.CTLMAX)) GO TO 4000

        C

0160    		ERRCNT = ERRCNT + 1

0161    		WRITE(2,50,ERR=9000) CMDNUM,COMAND,ISTACK !++04 INCLUDE STACK

        C

0162    		CMDPNT = CMDPNT+1

0163    		GO TO 5000

        C

        C---->		COMMAND IS A STACK COMMAND

        C

0164    1400	IF ((COMAND.NE.STABFD) .AND. (COMAND.NE.STAWFD) .AND.

        	1 (COMAND.NE.STALFD)) ISTACK=ISTACK + 4 !++04 ADD TO STACK

0165    	WRITE(2,60,ERR=9000) CMDNUM,(STANMS(I,COMAND+1),I=1,7),COMAND,

        	1ISTACK				!++04 INCLUDE STACK

0166    	FLDLNG = 4

0167    	GO TO (1405,1530,1540,1550,1519,1519,1519,1530,1540,3100,3100

        	1,3100,1405) COMAND+1		!++07 BRANCHES TO 3100 NOT 5000

        C

        C---->		STACK A GLOBAL SYMBOL - VALIDATE

        C			THE SYMBOL

        C

0168    1405	IF(CMDPNT .LT. TIRLNG) GO TO 1410

0169    		ERRCNT = ERRCNT + 1

0170    		WRITE(2,150,ERR=9000)

0171    		DUMPIT = .TRUE.

0172    		RETURN

        C

0173    1410	FLDLNG = RECORD(CMDPNT+1)

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 7   

TIRANL.FTN   	/TR:BLOCKS/WR


0174    	FLDPNT = CMDPNT+2

0175    	NAMLNG = FLDLNG

0176    	IF((FLDPNT-1 + NAMLNG) .LE. TIRLNG) GO TO 1415

        C

0177    		ERRCNT = ERRCNT + 1

0178    		WRITE(2,150,ERR=9000)

        C

0179    		DUMPIT = .TRUE.

0180    		NAMLNG = TIRLNG - FLDPNT + 1

        C

0181    1415	K = FLDPNT

0182    1420	J = NAMLNG

0183    1430	CALL FLDCHK(J,K,RECORD,I)

0184    	IF (I) 1440,1470,1460

        C

        C---->		SYMBOL LENGTH IS INVALID

        C

0185    1440		ERRCNT = ERRCNT + 1

0186    		WRITE(2,70,ERR=9000) NAMLNG,NAMMAX

0187    		IF(NAMLNG .EQ. 0) GO TO 1505

0188    		NAMLNG = NAMMAX

0189    		DUMPIT = .TRUE.

0190    		GO TO 1420

        C

        C---->		SYMBOL CONTAINS ILLEGAL CHARACTER

        C

0191    1460	ERRCNT = ERRCNT + 1

0192    	WRITE(2,80,ERR=9000)I,RECORD(I),RECORD(I) !++06 OCTAL TOO

0193    1467		K = I+1

0194    		J = NAMLNG + FLDPNT - K

0195    		IF( J .GT. 0) GO TO 1430

        C

        C---->		SYMBOL IS CHECKED - EXCEPT NOW TO

        C			CHECK FIRST CHARACTER

        C

0196    1470	IF (RECORD(FLDPNT).EQ.BLANK) GO TO 1480

0197    	IF (RECORD(FLDPNT).LT.ZERO .OR.(RECORD(FLDPNT).GT.NINE))

        	1 GO TO 1495

        C

        C---->		FIRST CHARACTER IS NUMERIC

        C			OR BLANK

        C

        C

0198    1480		ERRCNT = ERRCNT + 1

0199    		WRITE(2,90,ERR=9000)

        C

        C---->		NOW JUST PRINT SYMBOL

        C

0200    1495	WRITE(2,100,ERR=9000) (RECORD(I),I=FLDPNT,FLDPNT+NAMLNG-1)

0201    1505	CMDPNT = FLDPNT + NAMLNG

0202    	IF (COMAND .NE. STKCKA) GOTO 5000

        C

        C---->		WRITE OUT THE ARGUMENT INDEX.

        C

0203    	IF (CMDPNT .LE. TIRLNG) GOTO 1506

0204    		ERRCNT = ERRCNT + 1

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 8   

TIRANL.FTN   	/TR:BLOCKS/WR


0205    		WRITE(2,340,ERR=9000)

0206    		GOTO 1508

0207    1506	IF ((RECORD(CMDPNT).GE.MINARG) .AND. (RECORD(CMDPNT).LE.MAXARG))

        	1 GOTO 1507

0208    		ERRCNT = ERRCNT + 1

0209    		WRITE(2,350,ERR=9000)RECORD(CMDPNT),MINARG,MAXARG

0210    		GOTO 1508

0211    1507	WRITE(2,235,ERR=9000)RECORD(CMDPNT)

0212    	CMDPNT = CMDPNT + 1

        C

        C---->		NOW WRITE OUT THE ACTUAL ARGUMENT DESCRIPTOR

        C

0213    1508	WRITE(2,240,ERR=9000)

0214    	IF (CMDPNT .LE. TIRLNG) GOTO 1509

0215    		ERRCNT = ERRCNT + 1

0216    		WRITE(2,300,ERR=9000)

0217    		GOTO 5000

0218    1509	IF (ISTATE(RECORD(CMDPNT),0)) GOTO 1511

0219    	IF (ISTATE(RECORD(CMDPNT),1)) GOTO 1510

0220    		WRITE(2,250,ERR=9000)

0221    		GOTO 1513

0222    1510	WRITE(2,270,ERR=9000)

0223    	GOTO 1513

0224    1511	IF (ISTATE(RECORD(CMDPNT),1)) GOTO 1512

0225    		WRITE(2,260,ERR=9000)

0226    		GOTO 1513

0227    1512	WRITE(2,280,ERR=9000)

0228    1513	DO 1514 I=2,7

0229    	IF (ISTATE(RECORD(CMDPNT),I)) GOTO 1521

0230    	GOTO 1514

0231    1521	ERRCNT = ERRCNT + 1

0232    	WRITE(2,310,ERR=9000)I

0233    1514	CONTINUE

0234    	CMDPNT = CMDPNT + 1

0235    	IF (CMDPNT .LE. TIRLNG) GOTO 1515

0236    		ERRCNT = ERRCNT + 1

0237    		WRITE(2,320,ERR=9000)

0238    		GOTO 1518

0239    1515	WRITE(2,290,ERR=9000)RECORD(CMDPNT)

0240    	IF (CMDPNT+RECORD(CMDPNT) .LE. TIRLNG) GOTO 1516

0241    		ERRCNT = ERRCNT + 1

0242    		LENGTH = TIRLNG - CMDPNT

0243    		WRITE(2,330,ERR=9000)RECORD(CMDPNT)-LENGTH

0244    		GOTO 1517

0245    1516	LENGTH = RECORD(CMDPNT)

0246    1517	IF (LENGTH .EQ. 0) GOTO 1522

0247    	CALL HEXDMP(RECORD,CMDPNT+1,LENGTH,PRMODE)

0248    1522	CMDPNT = CMDPNT + LENGTH + 1

0249    1518	CONTINUE

0250    	GO TO 5000

        C

        C---->		STACK OPERATION  ON P-SECTION PLUS BYTE, WORD

        C			LONGWORD OFFSET

        C

0251    1519	FLDPNT = FLDPNT+1

0252    	PSECT = RECORD(FLDPNT) .AND.255

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 9   

TIRANL.FTN   	/TR:BLOCKS/WR


0253    	WRITE(2,120,ERR=9000) PSECT

0254    	IF (PSECT.LE.PSTIR) GO TO 1520

0255    	PSTIR = PSECT

        C

        C---->		NOW GO PRINT THE BYTE WORD

        C			LONGWORD VALUE

        C

0256    1520	GO TO (1530,1540,1550) COMAND - 3

        C

        C---->

        C

0257    1530	FLDLNG = 1

0258    	GO TO 1550

0259    1540	FLDLNG = 2

0260    1550	DO 1560 I = 1,4

        C

0261    		DUMMY(I) = 0

        C

0262    1560	CONTINUE

        C

        C---->		CHECK THAT THE REQUIRED DATA IS CONTAINED

        C	WITHIN THE RECORD.

        C

0263    	IF((FLDPNT+FLDLNG) .LE. TIRLNG) GO TO 1565

0264    		ERRCNT = ERRCNT + 1

0265    		WRITE(2,150,ERR=9000)

0266    		DUMPIT = .TRUE.

0267    		CMDPNT = TIRLNG + 1

0268    		GO TO 5000

        C

0269    1565	FLDPNT = FLDPNT+1

0270    	DO 1570 I = FLDPNT,FLDPNT + FLDLNG-1

        C

0271    		J = I+1 - FLDPNT

0272    		DUMMY(J) = RECORD(I)

        C

0273    1570	CONTINUE

        C

        C---->		IF COMMAND IS STACK OF SIGNED

        C			BYTE OR WORD

        C		OR IS P-SECTION OFFSET, MAKE

        C		VALUE HAVE CORRECT SIGN

        C

0274    	IF (COMAND .EQ. 1 .OR. (COMAND .EQ. 4)) GO TO 1600

0275    	IF (COMAND .NE. 2  .AND.  (COMAND .NE. 5)) GO TO 1700

0276    	GO TO 1620

        C

0277    1600	IF (DUMMY(1)) 1610,1700,1700

0278    1610	J  =  2

0279    	GO TO 1650

        C

0280     1620	IF (WVALU) 1630,1700,1700

0281    1630	J  =  3

0282    1650	DO 1670 I  =  J,4

        C

0283    		DUMMY(I)  =  255

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 10  

TIRANL.FTN   	/TR:BLOCKS/WR


        C

0284    1670	CONTINUE

        C

        C---->		NOW PRINT VALUE

        C

0285    1700	CALL CVTOHX(VALUE,HEXARA)

0286    	WRITE(2,110,ERR=9000) VALUE,VALUE,HEXARA

0287    	CMDPNT  =  FLDPNT + FLDLNG

0288    	GO TO 5000

        C

        C---->		HERE FOR COMMANDS OF STORE GROUP

        C

0289    2000	CMDINX  =  COMAND - STOMIN + 1

0290    	ISTACK=ISTACK - 4		!++04 ADD TO STACK

0291    	IF ((COMAND.GE.STORSF) .AND. (COMAND.LE.STOBLF)) ISTACK=ISTACK-4 !++04 DECREMENT STACK

0292    	IF ((COMAND.EQ.STORBF) .OR. (COMAND.EQ.STORWF)) ISTACK=ISTACK-4 !++04 DECREMENT STACK

0293    	WRITE(2,60,ERR=9000) CMDNUM,(STONMS(I,CMDINX),I=1,7),COMAND

        	1,ISTACK			!++04 INCLUDE STACK

0294    	IF (COMAND .EQ. STOVFD) GO TO 3005

        C

0295    	CMDPNT  =  FLDPNT + 1

0296    	GO TO 5000

        C

        C---->		INVALID TIR COMMAND TYPE.

        C

0297    2150	ERRCNT=ERRCNT + 1

0298    	WRITE(2,220,ERR=9000)CMDNUM,COMAND

0299    	CMDPNT=FLDPNT + 1

0300    	GOTO 5000

        C

        C---->		HERE FOR OPERATORS

        C

0301    3000	CMDINX  =  COMAND  -  OPMIN + 1

0302    	IF ((COMAND.NE.50) .AND. (COMAND.NE.58) .AND. (COMAND.NE.59) .AND.

        	1(COMAND.NE.REDEFN)) ISTACK=ISTACK - 4		!++04 DECREMENT STACK

0303    	IF (COMAND.EQ.SELECT) ISTACK=ISTACK - 4

0304    	WRITE(2,60,ERR=9000) CMDNUM,(OPNAMS(I,CMDINX),I=1,7),COMAND

        	1,ISTACK			!++04 INCLUDE STACK

0305    	IF (COMAND .EQ. REDEFN) GOTO 1405

0306    	IF (COMAND .NE. INSVFD) GO TO 3100

0307    3005	FLDPNT  =  FLDPNT + 1

0308    	IF(FLDPNT .LE. TIRLNG) GO TO 3010

0309    		ERRCNT = ERRCNT + 1

0310    		WRITE(2,150,ERR=9000)

        C

0311    		GO TO 3100

        C

0312    3010	FLDPOS  =  RECORD(FLDPNT) .AND. 255

0313    	FLDPNT = FLDPNT + 1

0314    	IF(FLDPNT .LE. TIRLNG) GO TO 3020

0315    		ERRCNT = ERRCNT + 1

0316    		WRITE(2,150,ERR=9000)

0317    		GO TO 3100

        C

0318    3020	FLDWID = RECORD(FLDPNT) .AND. 255

0319    	WRITE(2,140,ERR=9000) FLDWID,FLDPOS

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 11  

TIRANL.FTN   	/TR:BLOCKS/WR


0320    	IF(FLDWID .GE. 1 .AND. (FLDWID .LE. 32)) GO TO 3050

0321    		ERRCNT = ERRCNT + 1

0322    		WRITE(2,170,ERR=9000)

0323    3050	IF(FLDPOS .GE. 0 .AND. (FLDPOS .LE. 31))GO TO 3100

0324    		ERRCNT = ERRCNT + 1

0325    		WRITE(2,180,ERR=9000)

0326    3100	CMDPNT  =  FLDPNT + 1

0327    	GO TO 5000

        C

        C---->		HERE FOR CONTROL GROUP COMMANDS

        C

0328    4000	CMDINX  =  COMAND  -  CTLMIN + 1

0329    	IF (COMAND.NE.AUGMNT) ISTACK=ISTACK - 4	!++04 DECREMENT STACK

0330    	WRITE(2,60,ERR=9000) CMDNUM,(CTLNMS(I,CMDINX),I=1,7),COMAND

        	1,ISTACK			!++04 INCLUDE STACK

0331    	CMDPNT  =  CMDPNT + 1

        C

        C---->		IF THIS IS AUGMENT RELOCATION BASE GET THE

        C			INCREMENT TO BE ADDED AND PRINT.

        C			CHECK THAT IT IS WITHIN THE RECORD.

        C

0332    	IF(COMAND .EQ. AUGMNT) GO TO 4050

0333    	GOTO 5000

        C

0334    4050	FLDPNT = CMDPNT

0335    	FLDLNG = 4

0336    	DO 4070 I = FLDPNT,FLDPNT+FLDLNG-1

        C

0337    		J = I + 1 - FLDPNT

0338    		DUMMY(J) = RECORD(I)

        C

0339    4070	CONTINUE

0340    	IF(( FLDPNT+FLDLNG-1) .LE. TIRLNG) GO TO 4150

        C

0341    		ERRCNT = ERRCNT + 1

0342    		DUMPIT = .TRUE.

0343    		CMDPNT = TIRLNG + 1

0344    		WRITE(2,150,ERR=9000)

0345    		GO TO 5000

        C

0346    4150	CALL CVTOHX(VALUE,HEXARA)

0347    	WRITE(2,200,ERR=9000) VALUE,VALUE,HEXARA

        C

0348    	CMDPNT = CMDPNT + FLDLNG

        C

        C---->		THAT'S ALL FOR THAT COMMAND

        C

0349    5000	CMDNUM  =  CMDNUM + 1

0350    	IF (CMDPNT .LE. TIRLNG) GO TO 1050

0351    	RETURN

        C

        C---->		HERE FOR ERRORS WRITING OUTPUT FILE

        C

0352    9000	WRTERR = 1

0353    	RETURN

        C

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 12  

TIRANL.FTN   	/TR:BLOCKS/WR


0354    	END

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 13  

TIRANL.FTN   	/TR:BLOCKS/WR


PROGRAM SECTIONS



NUMBER	 NAME	    SIZE		ATTRIBUTES



  1	$CODE1	007002  1793		RW,I,CON,LCL

  2	$PDATA	000054    22		RW,D,CON,LCL

  3	$IDATA	003722  1001		RW,D,CON,LCL

  4	$VARS	000772   253		RW,D,CON,LCL

  5	$TEMPS	000002     1		RW,D,CON,LCL

  6	.$$$$.	001040   272		RW,D,OVR,GBL





ENTRY POINTS



 NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS   



 TIRANL	      1-000000





VARIABLES



 NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS   



 ADD	R*8   4-000040	 AND	R*8   4-000100	 ASH	R*8   4-000160	 AUGMNT	L*1   4-000713	 AUGRB	R*8   4-000020

 BLANK	L*1   4-000735	 BYTCNT	L*1   4-000734	 CMDINX	I*2   4-000672	 CMDNUM	I*2   4-000660	 CMDPNT	I*2   4-000662

 COMAND	I*2   4-000674	 COMPL	R*8   4-000140	 COPYRC	I*2   6-001034	 CTLMAX	L*1   4-000733	 CTLMIN	L*1   4-000732

 DBG	I*2   4-000666	 DIV	R*8   4-000070	 DUMPIT	L*1   6-001005	 EOM	L*1   4-000710	 ERRCNT	I*2   6-001020

 EXOR	R*8   4-000120	 FLDLNG	I*2   4-000000	 FLDPNT	I*2   4-000664	 FLDPOS	I*2   4-000000	 FLDWID	I*2   4-000002

 I	I*2   4-000762	 IMBYTS	I*2   4-000760	 INOR	R*8   4-000110	 INSVFD	L*1   4-000712	 INSVPS	R*8   4-000150

 ISTACK	I*2   6-001026	 J	I*2   4-000766	 K	I*2   4-000764	 LENGTH	I*2   4-000770	 LSTREC	L*1   6-001004

 MAXARG	I*2   4-000752	 MINARG	I*2   4-000750	 MUL	R*8   4-000060	 MXRLNG	I*2   6-001014	 NAMLNG	I*2   4-000756

 NAMMAX	I*2   4-000754	 NEG	R*8   4-000130	 NINE	L*1   4-000737	 NOP	R*8   4-000030	 OPMAX	L*1   4-000731

 OPMIN	L*1   4-000730	 PRMODE	I*2   6-001016	 PROCRC	I*2   6-001030	 PSCNT	I*2   6-001006	 PSECT	I*2   4-000002

 PSGSD	I*2   6-001010	 PSTIR	I*2   6-001012	 RECNUM	I*2   6-001002	 RECTYP	L*1   6-000000	 REDEF	R*8   4-000220

 REDEFN	I*2   4-000706	 ROT	R*8   4-000200	 SEL	R*8   4-000210	 SELECT	I*2   4-000704	 SETRB	R*8   4-000010

 STABFD	L*1   4-000740	 STABFI	R*8   4-000610	 STACKA	R*8   4-000650	 STAEPM	R*8   4-000640	 STAG	R*8   4-000500

 STAL	R*8   4-000530	 STALFD	L*1   4-000742	 STALFI	R*8   4-000630	 STAMAX	L*1   4-000725	 STAMIN	L*1   4-000724

 STASB	R*8   4-000510	 STASW	R*8   4-000520	 STAUSB	R*8   4-000570	 STAUSW	R*8   4-000600	 STAWFD	L*1   4-000741

 STAWFI	R*8   4-000620	 STKCKA	I*2   4-000702	 STOB	R*8   4-000440	 STOBD	R*8   4-000260	 STOBLF	L*1   4-000744

 STOICR	R*8   4-000330	 STOIDR	R*8   4-000320	 STOL	R*8   4-000250	 STOLD	R*8   4-000300	 STOLI	R*8   4-000310

 STOMAX	L*1   4-000727	 STOMIN	L*1   4-000726	 STORB	R*8   4-000460	 STORBF	L*1   4-000745	 STORL	R*8   4-000360

 STORSB	R*8   4-000340	 STORSF	L*1   4-000743	 STORSW	R*8   4-000350	 STORUB	R*8   4-000420	 STORUW	R*8   4-000430

 STORW	R*8   4-000470	 STORWF	L*1   4-000746	 STOSB	R*8   4-000230	 STOSW	R*8   4-000240	 STOUSB	R*8   4-000400

 STOUSW	R*8   4-000410	 STOVFD	L*1   4-000711	 STOVPS	R*8   4-000370	 STOW	R*8   4-000450	 STOWD	R*8   4-000270

 STPBB	R*8   4-000540	 STPBL	R*8   4-000560	 STPBW	R*8   4-000550	 SUB	R*8   4-000050	 SUBCNT	I*2   6-001024

 TBT	I*2   4-000670	 TIRCNT	I*2   6-001036	 TIRLNG	I*2   6-001000	 TIRMAX	I*2   4-000700	 TIRMIN	I*2   4-000676

 TITLRC	I*2   6-001032	 USH	R*8   4-000170	 VALUE	I*4   4-000004	 WRTERR	I*2   6-001022	 WVALU	I*2   4-000004

 ZERO	L*1   4-000736





ARRAYS



 NAME   TYPE  ADDRESS	    SIZE 	DIMENSIONS



 CTLNMS	L*1   4-000010	000020     8	(8,2)

 DUMMY	L*1   4-000004	000004     2	(4)

FORTRAN IV-PLUS V02-51D		02:29:12    22-AUG-78		PAGE 14  

TIRANL.FTN   	/TR:BLOCKS/WR


 HEXARA	L*1   4-000714	000010     4	(8)

 OPNAMS	L*1   4-000030	000200    64	(8,16)

 RECORD	L*1   6-000000	001000   256	(512)

 STANMS	L*1   4-000500	000160    56	(8,14)

 STONMS	L*1   4-000230	000250    84	(8,21)





LABELS



 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	



 10'	 3-000000	 20'	 3-000114	 30'	 3-000226	 40'	 3-000326	 50'	 3-000422

 60'	 3-000506	 70'	 3-000562	 80'	 3-000710	 90'	 3-001046	 100'	 3-001150

 110'	 3-001206	 120'	 3-001310	 140'	 3-001344	 150'	 3-001414	 160'	 3-001500

 170'	 3-001606	 180'	 3-001672	 190'	 3-001760	 200'	 3-002036	 210'	 3-002150

 220'	 3-002260	 230'	 3-002330	 235'	 3-002432	 240'	 3-002464	 250'	 3-002554

 260'	 3-002616	 270'	 3-002656	 280'	 3-002722	 290'	 3-002766	 300'	 3-003054

 310'	 3-003152	 320'	 3-003260	 330'	 3-003366	 340'	 3-003462	 350'	 3-003526

 450	 1-000112	 460	 1-000170	 550	 1-000244	 1000	 1-000314	 1030	    **   

 1050	 1-000450	 1100	    **   	 1150	 1-000650	 1200	 1-000770	 1300	 1-001020

 1400	 1-001256	 1405	 1-001512	 1410	 1-001572	 1415	 1-001726	 1420	 1-001742

 1430	 1-001756	 1440	    **   	 1460	 1-002102	 1467	    **   	 1470	 1-002234

 1480	 1-002300	 1495	 1-002340	 1505	 1-002450	 1506	 1-002550	 1507	 1-002670

 1508	 1-002744	 1509	 1-003046	 1510	 1-003164	 1511	 1-003222	 1512	 1-003310

 1513	 1-003344	 1514	 1-003470	 1515	 1-003562	 1516	 1-003732	 1517	 1-003754

 1518	 1-004042	 1519	 1-004054	 1520	 1-004162	 1521	 1-003420	 1522	 1-004016

 1530	 1-004212	 1540	 1-004230	 1550	 1-004244	 1560	    **   	 1565	 1-004400

 1570	    **   	 1600	 1-004536	 1610	    **   	 1620	 1-004562	 1630	    **   

 1650	 1-004604	 1670	    **   	 1700	 1-004646	 2000	 1-004762	 2150	    **   

 3000	 1-005266	 3005	 1-005566	 3010	 1-005644	 3020	 1-005742	 3050	 1-006110

 3100	 1-006166	 4000	 1-006212	 4050	 1-006430	 4070	    **   	 4150	 1-006624

 5000	 1-006726	 9000	 1-006756





FUNCTIONS AND SUBROUTINES REFERENCED



 CVTOHX	 FLDCHK	 HEXDMP	 ISTATE





TOTAL SPACE ALLOCATED = 015034  3342



NO FPP INSTRUCTIONS GENERATED



OBJ$:TIRANL.OBI,LIS$:TIRANL.LST/-SP=SRC$:TIRANL

