C   
C 
C 
C     META-ASSEMBLER PROM FORMATTING PROGRAM VER 2.0S
C     COPYRIGHT 1978
C     MICROTEC
C     SUNNYVALE, CALIFORNIA 94088 
C 
C 
C 
C     THE VARIABLES PASSED IN COMMON ARE DEFINED BELOW
C 
C     IADDR - HEXADECIMAL CHARACTER ARRAY 
C     IAST  - CHARACTER ASTERISK
C     IBAT  - INTERACTIVE/BATCH FLAG
C     IBITE - ENDING BIT INDEX FOR PROM OUTPUT
C     IBITS - STARTING BIT INDEX FOR PROM OUTPUT
C     IBLNK - BLANK CHARACTER 
C     ICHAR - GENERALIZED CHARACTER VARIABLE
C     ICHBT - NUMBER OF BITS PER COMPUTER CHARACTER 
C     ICHR0 - CHARACTER ZERO
C     ICHR1 - CHARACTER ONE 
C     ICHRA - CHARACTER A 
C     ICHRB - CHARACTER B
C     ICHRC - CHARACTER C 
C     ICHRD - CHARACTER D 
C     ICHRF - CHARACTER F 
C     ICHRR - CHARACTER R 
C     ICHRX - CHARACTER X 
C     ICHWD - NUMBER OF CHARACTERS PER COMPUTER WORD
C     ICNT  - GENERALIZED VARIABLE
C     ICOL  - INPUT BUFFER POINTER
C     ICOMM - COMMA CHARACTER 
C     ICRD  - LOGICAL DEVICE NUMBER FOR COMMAND INPUT 
C     IDOLR - CHARACTER $
C     IEND  - PROM OUTPUT END FLAG
C     IEQUL - CHARACTER = 
C     IERR  - GENERALIZED ERROR FLAG
C     IFIL  - DEVICE NUMBER USED EQUAT ROUTINE
C     IFREC - OBJECT MODULE INPUT RECORD NUMBER 
C     ILBUF - LISTING OUTPUT BUFFER 
C     ILLEN - LISTING BUFFER POINTER
C     IMBUF - SIMULATED MEMORY FILE BUFFER
C     IMFLE - LOGICAL DEVICE NUMBER OF SIMULATED MEMORY FILE
C     IMIN  - CHARACTER - 
C     IMREC - SIMULATED MEMORY FILE RECORD NUMBER 
C     IN    - INPUT BUFFER
C     INDEX - GENERALIZED POINTER 
C     INSCT - INSTRUCTION COUNTER 
C     INVRT - BIT INVERSION FLAG
C     IVAL  - GENERALIZED VARIABLE
C     IVAL1 - GENERALIZED VARIABLE
C     IVAL2 - GENERALIZED VARIABLE
C     IPASS - PUNCH OUTPUT PASS FLAG
C     IPBUF - PUNCH DEVICE OUTPUT BUFFER
C     IPE   - ENDING PROM OUTPUT BIT
C     IPFLE - LOGICAL DEVICE NUMBER OF OUTPUT PUNCH DEVICE
C     IPLEN - PUNCH OUTPUT RECORD NUMBER
C     IPREC - RECORD LENGTH OF PUNCH OUTPUT 
C     IPROM - PROM NUMBER TO OUTPUT 
C     IPRT  - LOGICAL DEVICE NUMBER FOR LISTING OUTPUT
C     IPS   - STARTING PROM OUTPUT BIT
C     IRDR  - LOGICAL DEVICE NUMBER FOR OBJECT MODULE INPUT 
C     IROW  - ROW NUMBER FOR GIVEN PROM NUMBER
C     ISBIT - BIT SIZE FOR INTERNAL PROCESSING
C     ITERM - LOGICAL DEVICE NUMBER FROM INTERACTIVE OUTPUT
C     IWBUF - PROM WORKING BUFFER
C     IWSEC - STARTING SECTOR NUMBER OF PROM
C     LCOLE - STARTING COLUMN NUMBER FOR MAP
C     LCOLE - ENDING COLUMN NUMBER FOR MAP
C     LCTL  - LIST/PUNCH CONTROL FLAG 
C     LFILE - OBJECT MODULE FILE INPUT FLAG 
C     LHEX  - USE HEXADECIMAL PROM FORMAT FLAG
C     LLIST - LIST LISTING FLAG 
C     LMAP  - LIST MAP FLAG 
C     LODLC - PROM OUTPUT LOAD FLAG 
C     LPCH  - OUTPUT PROM FORMAT FLAG 
C     MSEC  - NUMBER OF MICROWORDS PER DISK SECTOR
C     MSIZE - DISK SECTOR SIZE IN WORDS 
C     MCOL  - MAXIMUM INPUT COLUMN TO PROCESS 
C     MESSF - ERROR MESSAGE FLAG
C     MESSN - MESSAGE NUMBER
C     MXREC - MAXIMUM NUMBER OF RECORDS USED FOR SIMULATED MEMORY 
C     NAMEF - FILE NAME ARRAY FOR EQUATE ROUTINE
C     NBIT  - NUMBER OF BITS PER MICROWORD
C     NBITT - TOTAL NUMBER OF PROM BITS SPECIFIED 
C     NCOL  - NUMBER OF PROM COLUMNS
C     NDONT - DONT CARE VALUE 
C     NINST - NUMBER OF MICROWORDS
C     NPCNT - OUTPUT PUNCH COUNTER
C     NPDEP - PROM DEPTHS 
C     NPLIN - NUMBER OF PROM OUTPUTS PER LINE 
C     NPWID - PROM WIDTHS
C     NROW  - NUMBER OF PROM ROWS 
C     NOFF  - ADDRESS OFFSET VALUE
C     NTDEP - STARTING ADDRESS OF PROMS 
C     NTWID - STARTING BIT NUMBER FOR PROM
C     NUMS  - ALPHANUMERIC CHARACTER ARRAY
C     NVAL  - GENERALIZED VARIABLE
C     NWORD - NUMBER OF 16 BIT WORDS TO STORE EACH MICROWORD
C 
C 
      REAL IVAL,IVAL1,IVAL2,NOFF,NTDEP(64),NINST,INSCT
      DIMENSION LISTS(6),IOPT(7)
      COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMREC,IMFLE,IPFLE,IPREC,ITERM
      COMMON IMBUF(128),IPBUF(80),IN(128),ILBUF(80),IWBUF(128),IFREC
      COMMON ISBIT,ICHBT,ICHWD,NBIT,NINST,NDONT,NCOL,NROW,NOFF,IBAT 
      COMMON LODLC,IEND,NBITT,IPS,IPE,IPLEN,IPASS,IROW,LCTL,MXREC 
      COMMON NPLIN,IWSEC,MSEC,IPROM,INDEX,IBITS,IBITE,LCOLS,LCOLE 
      COMMON INSCT,IVAL,IVAL1,IVAL2,MCOL,NPCNT,ICHAR,MSIZE,NWORD,ILLEN
      COMMON LMAP,LLIST,LPCH,INVRT,LHEX,LFILE,NAMEF(4),IERR,ICOL,ICNT 
      COMMON NPWID(32),NTWID(32),NPDEP(64),NTDEP,NVAL,MESSN,MESSF 
      COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRF,ICHRN,ICHRR,ICHR0,ICHR1
      COMMON ICHRX,IBLNK,ICOMM,IAST,IDOLR,IEQUL,IMIN,IADDR(4),NUMS(16)
      EQUIVALENCE (LISTS(1),LMAP)
      DATA IOPT(1),IOPT(2),IOPT(3),IOPT(4) /1HM,1HL,1HP,1HI/
      DATA IOPT(5),IOPT(6),IOPT(7)         /1HH,1HH,1HS/
C   
C   
C   
      CALL INIT
C     CALL OPEN(ICRD,0)
C     CALL OPEN(IMFLE,'IMFLE.TMP',0)
      WRITE(ITERM,10010)
10010 FORMAT(///,' META-ASSEMBLER PROM FORMATTER VER 2.0S',/)
      CALL FOPEN
C
C     PROCESS OPTIONS
C   
500   WRITE(ITERM,10000)
10000 FORMAT(/,12H OPTIONS?   )
C     SET LISTING CONTROL FLAG
      DO 505 I=1,6
      LISTS(I) = 1
505   CONTINUE
      CALL INOUT(1) 
C     SCAN TO ARGUMENT
      DO 510 I=1,72 
      IF(IN(I)-IBLNK) 520,510,520
510   CONTINUE
      GO TO 800 
C     GET OPTIONS 
520   ICOL = I
      DO 530 I=1,7
      IF(IN(ICOL)-IOPT(I)) 530,540,530
530   CONTINUE
      GO TO 790 
540   LISTS(I) = 0
      ICOL = ICOL+1 
      IF(I-6) 700,600,550 
550   LISTS(5) = 2
      GO TO 700 
C     GET DEVICE NUMBER OR FILE NAME
600   IF(IN(ICOL)-IEQUL) 790,610,790
610   ICOL = ICOL+1 
      LL = ICOL 
      CALL SCAN 
      IF(IERR) 620,620,650
C     READ MODULE FROM I/O DEVICE 
620   IRDR = NVAL 
      GO TO 700 
C     GET FILENAME
650   ICOL = LL 
      CALL EQUAT
      IF(IERR) 780,660,780
660   IRDR = -IRDR
700   I = ICOL+1
      IF(IN(ICOL)-ICOMM) 710,520,710
710   IF(IN(ICOL)-IBLNK) 790,800,790
C     FILE NOT FOUND
780   MESSN = 12
      GO TO 795 
C     INVALID OPTION
790   MESSN = 9 
795   CALL MESS 
      IF(IBAT) 800,500,800
C 
C     READ OBJECT INFO
C 
800   NBIT = 64 
      I = IFREC 
      CALL INOUT(2) 
      IFREC = I+1 
      IF(IERR .EQ. 1) GO TO 9120
      IF(IN(1)-IAST) 9100,900,9100
900   IF(IN(2)-IDOLR) 9100,910,9100 
910   ICOL = 3
C     GET BIT LENGTH
      CALL SCAN 
      IF(IERR) 9100,920,9100
920   NBIT = NVAL 
      IF(NBIT-128) 925,925,9100 
925   CALL SCAN 
      IF(IERR) 9100,930,9100
930   NINST = IVAL
      NWORD = 1+(NBIT-1)/16 
      MSEC = MSIZE/NWORD
C     GET OFFSET ADDRESS
      CALL SCAN 
      IF(IERR) 9100,940,9100
940   IF(IVAL-65536.) 950,9100,9100 
950   NOFF = IVAL 
      IF(NBIT-70) 1000,1000,960 
C     DO DUMMY READ 
960   CALL INOUT(6) 
      IF(IERR .EQ. 1) GO TO 9120
C 
C     READ DONT CARE VALUE
C 
1000  WRITE(ITERM,10001)
10001 FORMAT(/,16H DON'T CARES?   )
      CALL INOUT(1) 
      IF(IERR .EQ. 1) GO TO 9110
      CALL SCAN 
      IF(IERR) 1010,1020,1010 
1010  MESSN = 1 
      GO TO 1040
1020  IF(NVAL-1) 1100,1100,1030 
C     VALUE OUT OF RANGE
1030  MESSN = 3 
1040  CALL MESS 
      IF(IBAT) 2000,1000,2000 
1100  NDONT = NVAL
C 
C     READ PROM WIDTHS
C 
2000  LL = 0
      IF(LHEX .EQ. 2) GO TO 5000
      NBITT = 0 
      NCOL = 0
      WRITE(ITERM,10002)
10002 FORMAT(/,24H ENTER PROM WIDTH(S)?   )
      IF(IERR .EQ. 1) GO TO 9110
      CALL INOUT(1) 
2050  CALL SCAN 
      IF(IERR) 2800,2060,2800 
2060  IF(ICHAR-IMIN) 2100,2800,2100
C     CHECK IF N OR I*B FORMAT
2100  MESSN = 3 
      IF(LL) 2200,2110,2200 
2110  IF(ICHAR-IBLNK) 2200,2120,2200
C     HAVE SINGLE SPECIFICATION - CALCULATE NUMBER OF PROMS 
2120  IF(NVAL) 2900,2900,2130 
2130  N = 1+(NBIT-1)/NVAL 
      IF(N-32) 2140,2140,2700 
2140  NCOL = N
      DO 2150 I=1,N 
      NPWID(I) = NVAL 
      NTWID(I) = NBITT+1
      NBITT = NBITT+NVAL
2150  CONTINUE
      IF(NVAL-64) 3000,3000,2750
C     HAVE I*B SPECIFICATION
2200  LL = 1
      IT = 1
      IF(ICHAR-IAST) 2240,2220,2240
2220  IT = NVAL 
      IF(IT) 2900,2900,2230 
2230  ICOL = ICOL+1 
      CALL SCAN 
      IF(IERR) 2800,2235,2800 
2235  IF(ICHAR-IMIN) 2240,2800,2240
2240  IF(NVAL) 2900,2900,2250 
2250  IF((NCOL+IT)-32) 2260,2260,2700 
2260  IF(NVAL-64) 2270,2270,2750
2270  DO 2280 I=1,IT
      NCOL = NCOL+1 
      NPWID(NCOL) = NVAL
      NTWID(NCOL) = NBITT+1 
      NBITT = NBITT+NVAL
2280  CONTINUE
      ICOL = ICOL+1 
      IF(ICHAR-IBLNK) 2050,2300,2050
C     CHECK IF TOO MANY PROMS SPECIFIED 
2300  MESSN = 5 
      IF(NBITT-NBIT) 2900,2320,2320 
2320  I = NBITT-NPWID(NCOL)
      IF(I-NBIT) 3000,2900,2900 
C 
C     TOO MANY PROM COLUMNS 
2700  MESSN = 4 
      GO TO 2900
C     WIDTH TOO LARGE 
2750  MESSN = 3 
      GO TO 2900
C     SYNTAX ERROR
2800  MESSN = 1 
2900  CALL MESS 
      IF(IBAT) 3000,2000,3000 
C 
C     READ PROM DEPTH 
C 
3000  LL = 0
      NROW = 0
      IVAL1 = 0.
      WRITE(ITERM,10003)
10003 FORMAT(/,24H ENTER PROM DEPTH(S)?   )
      CALL INOUT(1) 
      IF(IERR .EQ. 1) GO TO 9120
3050  CALL SCAN
      IF(IERR) 3800,3060,3800 
3060  IF(ICHAR-IMIN) 3100,3800,3100
C     CHECK IF R OR I*D 
3100  MESSN = 3 
      IF(LL) 3200,3110,3200 
3110  IF(ICHAR-IBLNK) 3200,3120,3200
C     HAVE SINGLE SPECIFICATION - CALCULATE NUMBER OF PROMS 
3120  IF(NVAL) 3900,3900,3130 
3130  IVAL2 = NVAL
      N = 1.+(NINST-1.)/IVAL2 
      IF(N-64) 3140,3140,3700 
3140  NROW = N
      DO 3150 I=1,N 
      NPDEP(I) = NVAL 
      NTDEP(I) = IVAL1
      IVAL1 = IVAL1+IVAL
3150  CONTINUE
      GO TO 4000
C     HAVE I*D SPECIFICATION
3200  LL = 1
      IT = 1
      IF(ICHAR-IAST) 3240,3220,3240
3220  IT = NVAL
      IF(IT) 3900,3900,3230 
3230  ICOL = ICOL+1 
      CALL SCAN 
      IF(IERR) 3800,3235,3800 
3235  IF(ICHAR-IMIN) 3240,3800,3240
3240  IF(IVAL) 3900,3900,3250 
3250  IF((NROW+IT)-64) 3260,3260,3700 
3260  DO 3270 I=1,IT
      NROW = NROW+1 
      NPDEP(NROW) = IVAL
      NTDEP(NROW) = IVAL1 
      IVAL1 = IVAL1+IVAL
3270  CONTINUE
      ICOL = ICOL+1 
      IF(ICHAR-IBLNK) 3050,3300,3050
C     CHECK IF TOO MANY/FEW PROMS SPECIFIED 
3300  MESSN = 7 
      IF(IVAL1-NINST) 3900,3320,3320
3320  IVAL = NPDEP(NROW)
      IVAL = IVAL1-IVAL 
      IF(IVAL-NINST) 4000,3900,3900 
C 
C     TOO MANY PROM ROWS
3700  MESSN = 6 
      GO TO 3900
C     SYNTAX ERROR
3800  MESSN = 1 
3900  CALL MESS 
      IF(IBAT) 4000,3000,4000 
C 
C     PRINT PROM MAP
C 
C     CHECK IF ANY ERRORS IN BATCH MODE 
4000  IF(MESSF*IBAT) 4010,4010,9200 
4010  MESSF = 0 
      IF(LMAP) 5000,5000,4020 
C     CHECK IF MAP MUST BE SEPARATED
4020  LCOLS = 1 
      IF(NCOL-16) 4100,4100,4200
4100  LCOLE = NCOL
      GO TO 4210
4200  LCOLE = 1+(NCOL-1)/2
4210  CALL MAP
      IF(NCOL-16) 5000,5000,4300
4300  LCOLS = LCOLE+1 
      LCOLE = NCOL
      CALL MAP
C 
C     READ OBJECT FILE
C   
5000  NCNT = 0
5005  I = IFREC
      CALL INOUT(2)
      IF(IERR .EQ. 1) GO TO 9120
      IFREC = I+1
      IF(IN(1)-IDOLR) 5010,5310,5010
C     CHECK FOR ADDRESS
5010  IF(IN(1)-ICHRA) 5015,5500,5015
C     PUT OBJECT CODE IN SIMULATED MEMORY
5015  LL = 0
      IVAL = 0
      IF(LHEX .NE. 2) GO TO 5017
      CALL OUTST
      IF(IERR .EQ. 1) GO TO 5900
      INSCT = INSCT+1.
      GO TO 5000
5017  DO 5200 I=1,NBIT
      ICHAR = IN(I)
      NN = 0
      IF(ICHAR-ICHR0) 5020,5050,5020
5020  NN = 1
      IF(ICHAR-ICHR1) 5030,5050,5030
5030  NN = NDONT
      IF(ICHAR-ICHRX) 5900,5100,5900
5050  IF(INVRT) 5100,5060,5100
5060  NN = 1-NN 
5100  IVAL1 = NN
      IVAL = IVAL+IVAL+IVAL1
      LL = LL+1 
      IF(LL-16) 5200,5150,5150
5150  IF(IVAL-32768.) 5170,5160,5160
5160  IVAL = IVAL-65536.
5170  NCNT = NCNT+1 
      IMBUF(NCNT) = IVAL
      LL = 0
      IVAL = 0
5200  CONTINUE
      IF(LL) 5300,5300,5210 
5210  LL = LL+1 
      IVAL1 = NDONT
      DO 5230 I=LL,16 
      IVAL = IVAL+IVAL+IVAL1
5230  CONTINUE
      IF(IVAL-32768.) 5250,5240,5240
5240  IVAL = IVAL-65536.
5250  NCNT = NCNT+1 
      IMBUF(NCNT) = IVAL
C     CHECK IF OBJECT FILE BUFFER IS FULL 
5300  INSCT = INSCT+1.
      IF((NCNT+NWORD)-MSIZE) 5005,5005,5310 
5310  IF(IN(1)-IDOLR) 5350,5320,5350
C     FILL REMAINDER OF BUFFER
5320  IF(LHEX .EQ. 2) GO TO 5360
      IF(NCNT-MSIZE) 5330,5350,5350 
5330  NCNT = NCNT+1 
      DO 5340 I=NCNT,MSIZE
      IMBUF(I) = -NDONT 
5340  CONTINUE
5350  I = IMREC 
      MXREC = IMREC 
      CALL INOUT(4) 
      IMREC = I+1 
      IF(IN(1)-IDOLR) 5000,6000,5000
C     END OF STEP ENGINEERING 
5360  IEND = 1
      CALL OUTST
      GO TO 9990
C 
C     HAVE ADDRESS RECORD - GET ADDRESS 
C 
5500  ICOL = 2
      CALL SCAN 
      IF(IERR) 5900,5510,5900 
5510  IVAL = IVAL-NOFF-INSCT
      IF(LHEX .EQ. 2) GO TO 5610
      IF(IVAL) 5910,5005,5520 
C     HAVE ADDRESS GAP - FILL WITH DONT CARES 
5520  IF(IVAL-32768.) 5530,5910,5910
5530  NVAL = IVAL 
      DO 5600 LL=1,NVAL 
      DO 5550 J=1,NWORD 
      NCNT = NCNT+1 
      IMBUF(NCNT) = -NDONT
5550  CONTINUE
      INSCT = INSCT+1.
      IF((NCNT+NWORD)-MSIZE) 5600,5600,5560
C     WRITE RECORD TO SIMULATED MEMORY
5560  I = IMREC 
      CALL INOUT(4) 
      IMREC = I+1 
      NCNT = 0
5600  CONTINUE
      GO TO 5005
C 
C     ADJUST ADDRESS FOR STEP ENGINEERING 
5610  INSCT = INSCT+IVAL
      GO TO 5005
C 
C     INVALID OBJECT RECORD 
5900  MESSN = 8 
      GO TO 5990
C     INVALID ADDRESS SPECIFIED 
5910  MESSN = 10
5990  CALL MESS 
      GO TO 5000
C 
C     PROCESS PROM OUTPUT 
C 
6000  IF(MESSF) 6002,6002,9200
6002  WRITE(ITERM,10004)
10004 FORMAT(//,43H WHICH PROMS DO YOU WISH TO PRINT/PUNCH?   )
      IMREC = -1
      IPASS = 0 
      CALL INOUT(1) 
6005  DO 6010 I=1,MCOL
      IF(IN(I)-IBLNK) 6015,6010,6015
6010  CONTINUE
      GO TO 9990
C     CHECK PROM TYPE 
6015  ICOL = I
6020  ICHAR = IN(ICOL)
      ISTOP = 1 
      NTOT = NROW*NCOL
      IF(ICHAR-ICHRN) 6030,6600,6030
6030  ISTOP = 0 
      IF(ICHAR-ICHRA) 6040,6400,6040
6040  IGO = 1 
      IF(ICHAR-ICHRC) 6050,6100,6050
6050  IGO = 3 
      IF(ICHAR-ICHRR) 6110,6060,6110
6060  IGO = 2 
C     GET PROM NUMBER, COLUMN OR ROW
6100  ICOL = ICOL+1 
6110  CALL SCAN 
      IF(IERR) 6900,6120,6900 
6120  IF(NVAL) 6130,6910,6130 
6130  IS = NVAL 
      IE = NVAL 
      IF(ICHAR-IMIN) 6140,6150,6140 
6140  IF(ICHAR-IAST) 6190,6900,6190 
C     GET 2ND PARAMETER 
6150  ICOL = ICOL+1 
      CALL SCAN 
      IF(IERR) 6900,6160,6900 
6160  IE = NVAL 
      IF(IS-IE) 6190,6190,6910
6190  ICOL = ICOL-1 
      IF(IGO-2) 6200,6300,6500
C     OUTPUT PROMS BY COLUMNS 
6200  IF(IE-NCOL) 6210,6210,6910
6210  IF(IPASS) 6220,6600,6220
6220  DO 6230 I=IS,IE 
      DO 6230 K=1,NROW
      IPROM = I+(K-1)*NCOL
      CALL OUT
6230  CONTINUE
      GO TO 6600
C     OUTPUT PROMS BY ROWS
6300  IF(IE-NROW) 6310,6310,6910
6310  IF(IPASS) 6320,6600,6320
6320  DO 6330 K=IS,IE
      DO 6330 I=1,NCOL 
      IPROM = I+(K-1)*NCOL
      CALL OUT
6330  CONTINUE
      GO TO 6600
C     OUTPUT ALL PROMS
6400  IS = 1
      IE = NROW*NCOL
C     OUTPUT PROM BY NUMBER 
6500  IF(IE-NTOT) 6510,6510,6910
6510  IF(IPASS) 6520,6600,6520
6520  DO 6530 I=IS,IE 
      IPROM = I 
      CALL OUT
6530  CONTINUE
C 
C     CHECK IF ANY MORE PROMS TO OUTPUT
C 
6600  ICOL = ICOL+1 
      ICHAR = IN(ICOL)
      IF(ICHAR-IAST) 6610,6900,6610 
6610  IF(ICHAR-IMIN) 6620,6900,6620 
6620  ICOL = ICOL+1 
      IF(ICHAR-ICOMM) 6650,6020,6650
6650  IPASS = IPASS+1 
      IF(IPASS-2) 6660,6670,6800
C     CHECK IF LIST FLAG SET
6660  IF(LLIST) 6650,6650,6005
C     CHECK IF PUNCH FLAG SET 
6670  IF(LPCH) 6650,6650,6680 
6680  IF(LCTL) 6690,6005,6690 
6690  IF(LLIST) 6800,6005,6800
C     IF INTERACTIVE MODE GO AGAIN
6800  IF(IBAT+ISTOP) 9990,6002,9990 
C 
C     INVALID SYNTAX
6900  MESSN = 1 
      GO TO 6990
C     PROM VALUE TOO LARGE OR SMALL 
6910  MESSN = 11
6990  CALL MESS 
      IF(IBAT) 9200,6002,9200 
C 
C 
C     INVALID OBJECT HEADER 
9100  MESSN = 2 
      CALL MESS 
      GO TO 9190
C     EOF ON COMMAND INPUT
9110  MESSN = 13
      GO TO 9190
C     EOF ON OBJECT INPUT 
9120  MESSN = 14
9190  CALL MESS 
C     PROGRAM ERROR 
9200  WRITE(ITERM,10020)
10020 FORMAT(/,19H PROGRAM TERMINATED)
9990  STOP
      END 
 STOP
      END 
