FTN4,L, 
      PROGRAM RTMTG  (), 92065-16004  REV. 1901  780705 
C 
C  DATA BUFFERS AND STOREAGE
C 
      INTEGER FUNC1,FUNC2,A,E,F,R,X,AI(6),AO(6) 
      DIMENSION IBUF(72),IDCB1(144),IDCB2(144)
      DIMENSION IBUF4(6),IBUF5(6) 
C 
C 
C 
C 
C  RTM BRANCH AND MNEMONIC TABLE GENERATOR
C  MIKE SCHOENDORF
C  OCTOBER 22,1976
C 
C  SOURCE:        92065-18010 
C  RELOCATEABLE:  92065-16004  REV.1901  770518 
C 
C 
C 
C 
C 
C  MAXIMUM READ LENGTH FROM SESSION CONSOLE 
C 
      IL=72 
C 
C  "RTMTG"
C 
      CALL MESS1
C 
C  >
C 
50    CALL MESS2
C 
C  INITIALIZE END OF FILE, COMMAND, EDIT, ERROR, MESSAGE LENGTH 
C  AND LINE NUMBERS INDICATORS. 
C 
      E=0 
      FUNC1=0 
      FUNC2=0 
      IERR=0
      LEN=0 
      NUMB=0
C 
C  GET COMMAND FUNCTION 
C 
      CALL READ1(FUNC1,IERR)
C 
C  IF NOT EDIT, TABLE, LIST, OR END COMMANDS ERROR EXIT.
C 
      IF (IERR .NE. 0) GO TO 90 
C 
C  EDIT COMMAND 
C 
      IF (FUNC1 .EQ. 4)GO TO 995
C 
C  GET INPUT AND OUTPUT FILE NAMES
C 
      CALL GTFIL(5,IERR,0,AI,AO)
C 
C  CHECK FOR GTFIL ERR
C 
      IF (IERR .NE. 0)GO TO 910 
C 
C  OPEN INPUT FILE
C 
      CALL OPEN(IDCB1,IERR,AI(2),410B)
C 
C  CHECK FOR OPEN ERROR 
C 
      IF (IERR .LT. 0)GO TO 920 
C 
C  IF OUTPUT FILE FOR TABLE, OPEN WITH 110B 
C 
      IF (FUNC1 .EQ. 2)GO TO 95 
C 
C  OPEN OUTPUT FILE (LIST, EDIT)
C 
      CALL OPEN(IDCB2,IERR,AO(2),210B)
C 
C  CHECK FOR OPEN ERROR 
C 
55    IF (IERR .LT. 0)GO TO 70
C 
C  GO PROCESS EDIT, LIST, AND TABLE COMMANDS
C 
60    GO TO (100,700,800)FUNC1
C 
C  OPEN ERROR ON OUTPUT FILE. CHECK IF FILE EXISTS. 
C 
70    IF (IERR .EQ. -6)80,920 
C 
C  FILE DOESN'T EXIST, CREATE IT. 
C 
80    IF (FUNC1 .EQ. 2)GO TO 85 
C 
C  CREATE TYPE 4 OUTPUT FILE
C 
      CALL CREAT(IDCB2,IERR,AO(2),30,4,AO(6),AO(1)) 
C 
C  CHECK FOR CREATE ERROR 
C 
      IF (IERR .LT. 0)990,60
C 
C  CREATE TYPE 5 OUTPUT FILE
C 
85    CALL CREAT(IDCB2,IERR,AO(2),30,5,AO(6),AO(1)) 
C 
C  CHECK FOR CREATE ERROR 
C 
      IF (IERR .LT. 0)990,60
C 
C  COMMAND ERROR
C 
90    CALL ERR2 
      GO TO 50
C 
C  OPEN OUTPUT FILE (TABLES)
C 
95    CALL OPEN(IDCB2,IERR,AO(2),110B)
      GO TO 55
C 
C 
C  EDIT 
C 
C 
C 
C  INITIALIZE ADD, FIND, LINE NUMBER, DELETE LINE NUMBER INDICATORS.
C 
100   A=0 
      F=0 
      N=0 
      X=0 
C 
C  "BRANCH AND MNEMONIC SOURCE EDIT"
C 
      CALL MESS3
C 
C  - (PROMPT) 
C 
110   CALL MESS9
C 
C  GET EDIT COMMAND 
C 
130   CALL READ2(FUNC2,NUMB,IERR) 
C 
C  IF NOT END, ABORT, ADD, DELETE, END, FIND, OR REPLACE, 
C  COMMAND ERROR. 
C 
      IF (IERR .NE. 0)GO TO 190 
C 
C  GO TO ABORT, ADD, DELETE, END, FIND, REPLACE OR
C  FIND NEXT LINE.
C 
      GO TO(400,900,200,300,500,600,550)FUNC2 
C 
C  COMMAND ERROR
C 
190   CALL ERR2 
      GO TO 110 
C 
C 
C  ADD
C 
C 
C 
C  IF FIND PREVIOUS COMMAND, GO WRITE THE LINE. 
C 
200   IF (F .EQ. 1)GO TO 260
C 
C  READ FROM INPUT FILE 
C 
210   CALL READ3(IBUF,LEN)
C 
C  IF NO INPUT, ADD ERROR 
C 
      IF (LEN .EQ. 0) GO TO 960 
C 
C  WRITE ON OUTPUT FILE 
C 
      CALL WRITF(IDCB2,IERR,IBUF,LEN) 
C 
C  SET ADD FLAG INDICATOR 
C 
      A=1 
C 
C  GET NEXT EDIT COMMAND, IF NO WRITE ERROR.
C 
      IF (IERR .NE. 0)950,110 
C 
C  WRITE PENDING LINE TO OUTPUT FILE
C 
260   CALL WRITF(IDCB2,IERR,IBUF,LEN) 
C 
C  CLEAR FIND FLAG INDICATOR
C 
      F=0 
C 
C GET NEXT EDIT COMMAND, IF NO WRITE ERROR.OMMAND 
C 
      IF (IERR .NE. 0)950,210 
C 
C 
C  DELETE (N) 
C 
C 
C 
C  CLEAR DELETE LINE NUMBER INDICATOR 
C 
300   X=0 
C 
C  IF "FIND" PREVIOUS COMMAND, DON'T READ NEXT LINE.
C 
      IF (F .EQ. 1)GO TO 320
C 
C  IF DONE, GO PROMPT 
C 
310   IF (X .EQ. NUMB)GO TO 110 
C 
C  READ NEXT LINE FROM INPUT FILE 
C 
      CALL READF(IDCB1,IERR,IBUF,IL,LEN)
C 
C  CHECK FOR READ ERROR 
C 
      IF (IERR .NE. 0)GO TO 930 
C 
C  IF END OF FILE, OUTPUT TO SESSION CONSOLE "EOF"
C 
      IF (LEN .EQ. -1)GO TO 350 
C 
C  CLEAR "ADD" FLAG INDICATOR 
C 
      A=0 
C 
C  N = CURRENT LINE NUMBER
C 
      N=N+1 
C 
C  X = NUMBER OF LINES DELETED
C 
315   X=X+1 
C 
C  CHECK IF FINISHED
C 
      GO TO 310 
C 
C  IF NO LINES TO DELETE GET NEXT EDIT COMMAND
C 
320   IF (NUMB .EQ. 0)GO TO 110 
C 
C  CLEAR "FIND" PREVIOUS COMMAND INDICATOR
C 
      F=0 
      GO TO 315 
C 
C  SET "EOF" INDICATOR
C 
350   E=1 
C 
C  "EOF"
C 
      CALL MESS6
      GO TO 110 
C 
C 
C  END
C 
C 
C 
C  IF AT END OF INPUT, CLOSE INPUT AND OUTPUT FILES.
C 
400   IF (E .EQ.1)GO TO 900 
C 
C  IF "FIND" LAST COMMAND, GO WRITE LINE. 
C 
      IF (F .EQ. 1)GO TO 420
C 
C  READ NEXT LINE 
C 
410   CALL READF(IDCB1,IERR,IBUF,IL,LEN)
C 
C  CHECK FOR READ ERROR 
C 
      IF (IERR .NE. 0)GO TO 930 
C 
C  IF AT END OF FILE, GO CLOSE INPUT AND OUTPUT FILES.
C 
      IF (LEN .EQ. -1)GO TO 900 
C 
C  WRITE PENDING LINE TO OUTPUT FILE
C 
420   CALL WRITF(IDCB2,IERR,IBUF,LEN) 
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)950,410 
C 
C 
C  FIND 
C 
C 
C 
C  CHECK FOR END OF FILE
C 
500   IF (E .EQ. 1)GO TO 350
C 
C  CHECK IF "ADD" PREVIOUS COMMAND
C 
      IF (A .EQ. 1)GO TO 570
C 
C  CHECK IF "REPLACE" PREVIOUS COMMAND
C 
      IF (R .EQ. 1)GO TO 570
C 
C  CHECK IF "FIND" PREVIOUS COMMAND 
C 
      IF (F .EQ. 1)GO TO 530
C 
C  CHECK IF AT START OF INPUT FILE
C 
505   IF (N .EQ. 0)GO TO 580
C 
C  IF LINE SOUGHT IS LESS THAN CURRENT LINE, ERROR
C  IF LINE SOUGHT = CURRENT LINE STOP LOOKING 
C  IF LINE SOUGHT > CURRENT LINE, KEEP LOOKING. 
C 
510   IF (NUMB-N)970,540,520
C 
C  CLEAR "ADD" FLAG INDICATOR 
C 
520   A=0 
C 
C  READ NEXT LINE 
C 
      CALL READF(IDCB1,IERR,IBUF,IL,LEN)
C 
C  CHECK FOR READ ERROR 
C 
      IF (IERR .NE. 0)GO TO 930 
C 
C  CHECK FOR END OF FILE
C 
      IF (LEN .EQ. -1)GO TO 980 
C 
C  GO WRITE LINE
C 
530   CALL WRITF(IDCB2,IERR,IBUF,LEN) 
C 
C  N = CURRENT LINE NUMBER
C 
      N=N+1 
C 
C  CLEAR "FIND" FLAG INDICATOR
C 
      F=0 
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)950,510 
C 
C  CHECK FOR END OF FILE
C 
540   IF (E .EQ. 1)GO TO 350
C 
C  READ NEXT LINE 
C 
      CALL READF(IDCB1,IERR,IBUF,IL,LEN)
C 
C  CHECK FOR END OF FILE
C 
      IF (LEN .EQ. -1)GO TO 350 
C 
C  CHECK IF READ ERROR
C 
      IF (IERR .NE. 0)GO TO 930 
C 
C  OUTPUT CURRENT LINE NUMBER 
C 
      CALL MESS4(N) 
C 
C  OUTPUT CURRENT LINE
C 
      CALL MESSA(IBUF,LEN)
C 
C  SET "FIND" FLAG INDICATOR
C 
      F=1 
C 
C  GO GET NEXT EDIT COMMAND 
C 
      GO TO 130 
C 
C 
C  FIND NEXT LINE 
C 
C 
C 
C  CHECK FOR END OF FILE
C 
550   IF (E .EQ. 1)GO TO 350
C 
C  N = CURRENT LINE NUMBER
C 
      N=N+1 
C 
C  IF "FIND" PREVIOUS COMMAND, WRITE PENDING LINE,
C  ELSE SET FOR NEXT LINE READ. 
C 
      IF (F .EQ. 1)560,565
C 
C  WRITE PENDING LINE 
C 
560   CALL WRITF(IDCB2,IERR,IBUF,LEN) 
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)GO TO 950 
C 
C  SET LINE SOUGHT = PENDING LINE 
C 
565   NUMB=N
C 
C  GO READ LINE 
C 
      GO TO 590 
C 
C  CHECK IF AT START OF FILE
C 
570   IF (N .EQ. 0)GO TO 580
C 
C  CHECK IF LINE SOUGHT <, =, OR > PENDING LINE.
C 
      IF (NUMB-N)970,970,580
C 
C  SET TO GET NEXT LINE 
C 
580   N=N+1 
C 
C  CLEAR "ADD" AND "REPLACE" INDICATORS 
C 
590   A=0 
      R=0 
      GO TO 510 
C 
C 
C REPLACE 
C 
C 
C 
C  IF AT END, OUTPUT "EOF" TO SESSION CONSOLE.
C 
600   IF (E .EQ. 1)GO TO 350
C 
C  SET "REPLACE" FLAG INDICATOR 
C 
      R=1 
C 
C  IF "FIND" PREVIOUS COMMAND, GET REPLACEMENT LINE 
C 
      IF (F .EQ. 1)GO TO 610
C 
C  N = CURRENT LINE NUMBER
C 
      N=N+1 
C 
C  READ NEXT LINE 
C 
      CALL READF(IDCB1,IERR,IBUF,IL,LEN)
C 
C  CHECK FOR READ ERROR 
C 
      IF (IERR .NE. 0)GO TO 930 
C 
C  CHECK FOR END OF FILE
C 
      IF (LEN .EQ. -1)GO TO 350 
C 
C  OUTPUT CURRENT LINE NUMBER 
C 
      CALL MESS4(N) 
C 
C  OUTPUT CURRENT LINE
C 
      CALL MESSA(IBUF,LEN)
C 
C  GET REPLACEMENT LINE 
C 
610   CALL READ3(IBUF,LEN)
C 
C  CHECK FOR REPLACEMENT ERROR
C 
      IF (LEN .EQ. 0)GO TO 985
C 
C  CLEAR FIND AND ADD FLAG INDICATORS 
C 
      F=0 
      A=0 
C 
C  WRITE ON OUTPUT FILE 
C 
      CALL WRITF(IDCB2,IERR,IBUF,LEN) 
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)950,110 
C 
C 
C  BRANCH AND MNEMONIC TABLE GENERATOR
C 
C 
C 
C  "BRANCH TABLE GENERATOR" 
C 
700   CALL MESS7
C 
C  N = NUMBER OF BRANCH TABLE ENTRIES 
C 
      N=0 
C 
C  FORMAT NAM RECORD
C 
C     NAM BMTBL 
C 
      CALL NAMRC(IBUF)
C 
C  OUTPUT NAM RECORD
C 
      CALL WRITF(IDCB2,IERR,IBUF,17)
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)GO TO 950 
C 
C  FORMAT ENTRY RECORD
C 
C   ENT BRTBL 
C 
      CALL ENTBT(IBUF)
C 
C  OUTPUT ENTRY RECORD
C 
      CALL WRITF(IDCB2,IERR,IBUF,7) 
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)GO TO 950 
C 
C  FORMAT DBL RECORD
C 
C   BRTBL DEF *+1 
C 
      CALL ENTBR(IBUF)
C 
C  OUTPUT DBL RECORD
C 
      CALL WRITF(IDCB2,IERR,IBUF,6) 
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)GO TO 950 
C 
C  READ NEXT BRANCH TABLE ENTRY 
C 
720   CALL READF(IDCB1,IERR,IBUF,IL,LEN)
C 
C  CHECK FOR READ ERROR 
C 
      IF (IERR .NE. 0)GO TO 930 
C 
C  CHECK FOR END OF FILE
C 
      IF (LEN .EQ. -1)GO TO 750 
C 
C  GO PARSE LINE
C 
      CALL PARS1(IBUF,LEN,IBUF4,IBUF5,IERR) 
C 
C  CHECK FOR SYNTAX ERROR 
C 
      IF (IERR .NE. 0)GO TO 790 
C 
C  N = BRANCH TABLE NUMBER ENTRY
C 
      N=N+1 
C 
C  WRITE EXTERNAL RECORD
C 
      CALL WRITF(IDCB2,IERR,IBUF4,6)
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)GO TO 950 
C 
C  WRITE DBL RECORD 
C 
      CALL WRITF(IDCB2,IERR,IBUF5,9)
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)GO TO 950 
C 
C  GET NEXT BRANCH TABLE ENTRY
C 
      GO TO 720 
C 
C  DETERMINE IF INPUT IS FROM PAPER TAPE
C 
750   CALL RWIND(X,IDCB1,IERR)
C 
C  CHECK FOR ERROR IN DETERMINING INPUT DEVICE
C 
      IF (IERR .NE. 0)GO TO 991 
C 
C  REWIND INPUT FILE  
C 
      CALL RWNDF(IDCB1,IERR)
C 
C  CHECK FOR REWIND ERROR 
C 
      IF (IERR .LT. 0)GO TO 991 
C 
C  IF PAPER TAPE INPUT OUTPUT MESSAGE 
C 
      IF (X .EQ. 1)760,780
C 
C  "REWIND SOURCE FILE" 
C 
760   CALL MESS8
C 
C  PAUSE UNTIL REWIND IS DONE, THEN ENTER GO,RTMTG TO CONTINUE. 
C 
      PAUSE 
C 
C  MNEMONIC TABLE GENERATOR 
C 
780   CALL MES10
C 
C  FORMAT ENTRY RECORD
C 
C   ENT MNTBL 
C 
      CALL ENTMT(IBUF)
C 
C  OUTPUT ENTRY RECORD
C 
      CALL WRITF(IDCB2,IERR,IBUF,7) 
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)GO TO 950 
C 
C  FORMAT DBL RECORD
C 
C   MNTBL DEC -X
C 
C    WHERE X IS THE NUMBER OF BRANCH TABLE ENTRIES
C 
      CALL ENTMN(IBUF,N)
C 
C  OUTPUT DBL RECORD
C 
      CALL WRITF(IDCB2,IERR,IBUF,6) 
C 
C  CHECK FOR WRITE ERROR
C 
      IF(IERR .NE. 0)GO TO 950
C 
C  SET MNEMONIC TABLE ENTRY NUMBER = 0
C 
      N=0 
C 
C  NUM = DBL RECORD LENGTH
C 
785   NUM=0 
C 
C  READ NEXT MNEMONIC TABLE ENTRY 
C 
      CALL READF(IDCB1,IERR,IBUF,IL,LEN)
C 
C  CHECK FOR READ ERROR 
C 
      IF (IERR .NE. 0)GO TO 930 
C 
C  CHECK FOR END OF FILE
C 
      IF (LEN .EQ. -1)GO TO 795 
C 
C  GO PARSE ENTRY 
C 
      CALL PARS2(IBUF,LEN,IBUF4,IERR,NUM) 
C 
C  CHECK FOR SYNTAX ERROR 
C 
      IF (IERR .NE. 0)GO TO 788 
C 
C  STEP TO NEXT MNEMONIC TABLE ENTRY
C 
      N=N+1 
C 
C  WRITE DBL RECORD 
C 
      CALL WRITF(IDCB2,IERR,IBUF4,NUM)
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)950,785 
C 
C  STEP TO NEXT MNEMONIC TABLE ENTRY
C 
788   N=N+1 
C 
C  SYN ERR IN LINE "N"
C 
      CALL ERR11(N) 
C 
C  READ NEXT LINE 
C 
      GO TO 785 
C 
C  STEP TO NEXT MNEMONIC TABLE ENTRY
C 
790   N=N+1 
C 
C  SYN ERR IN LINE "N"
C 
      CALL ERR11(N) 
C 
C  READ NEXT LINE 
C 
      GO TO 720 
C 
C  FORMAT END RECORD
C 
795   CALL ENDRC(IBUF)
C 
C  WRITE END RECORD 
C 
      CALL WRITF(IDCB2,IERR,IBUF,4) 
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)GO TO 950 
C 
C  CLOSE INPUT FILE 
C 
      CALL CLOSE(IDCB1,IERR)
C 
C  CHECK FOR CLOSE ERROR
C 
      IF (IERR .LT. 0)GO TO 940 
C 
C  WRITE END OF FILE
C 
      CALL FCONT(IDCB2,IERR,100B) 
C 
C  CHECK FOR END OF FILE ERRROR 
C 
      IF (IERR .LT. 0)GO TO 940 
C 
C  CLOSE OUTPUT FILE
C 
      CALL CLOSE(IDCB2,IERR)
C 
C  CHECK FOR CLOSE ERROR
C 
      IF (IERR .LT. 0)GO TO 940 
C 
C  GET NEXT COMMAND 
C 
      GO TO 50
C 
C 
C  LIST  (ADD LINE NUMBERS TO INPUT FILE ENTRIES) 
C 
C 
C 
C  N = CURRENT LINE NUMBER
C 
800   N=0 
C 
C  "LIST" 
C 
      CALL MESS5
C 
C  STEP TO NEXT LINE
C 
810   N=N+1 
C 
C  PUT LINE NUMBER (N) IN OUTPUT BUFFER 
C 
      CALL CNUMD(N,IBUF)
C 
C  PUT NEXT LINE IN OUTPUT BUFFER 
C 
      CALL READF(IDCB1,IERR,IBUF(6),IL,LEN) 
C 
C  CHECK FOR READ ERROR 
C 
      IF (IERR .NE. 0)GO TO 930 
C 
C  CHECK FOR END OF FILE
C 
      IF (LEN .EQ. -1)GO TO 900 
C 
C  ADD 2 BLANKS TO OUTPUT BUFFER
C 
      IBUF(4)=20040B
      IBUF(5)=20040B
C 
C  SET OUTPUT LINE LENGTH 
C 
      LEN=LEN+4 
C 
C  GO WRITE LINE WITH ITS LINE NUMBER ATTACHED
C 
      CALL WRITF(IDCB2,IERR,IBUF(2),LEN)
C 
C  CHECK FOR WRITE ERROR
C 
      IF (IERR .NE. 0)GO TO 950 
C 
C  PROCESS NEXT LINE
C 
      GO TO 810 
C 
C 
C  ABORT
C 
C 
C 
C  CLOSE INPUT FILE 
C 
900   CALL CLOSE(IDCB1,IERR)
C 
C  CHECK FOR CLOSE ERROR
C 
      IF (IERR .LT. 0)901,905 
C 
C  CHECK IF DCB OPEN
C 
901   IF (IERR .EQ. -11)905,906 
C 
C  WRITE END OF FILE
C 
905   CALL FCONT(IDCB2,IERR,100B) 
C 
C  CHECK FOR END OF FILE ERROR
C 
      IF (IERR .LT. 0)GO TO 940 
C 
C  CLOSE OUTPUT FILE
C 
      CALL CLOSE(IDCB2,IERR)
C 
C  CHECK FOR CLOSE ERROR
C 
      IF (IERR .LT. 0)907,50
C 
C  CLOSE ERROR
C 
906   CALL ERR5 
C 
C  GO CLOSE OUTPUT FILE 
C 
      GO TO 905 
C 
C  CHECK IF DCB OPEN
C 
907   IF (IERR .EQ. -11)50,940
C 
C 
C  ERROR MESSAGES 
C 
C 
C 
C  GTFIL ERR
C 
910   CALL ERR1A
      GO TO 995 
C 
C  OPEN ERR 
C 
920   CALL ERR3 
      GO TO 50
C 
C  READ ERR 
C 
930   CALL ERR4 
      GO TO 900 
C 
C  CLOSE ERR
C 
940   CALL ERR5 
      GO TO 995 
C 
C  WRITE ERR
C 
950   CALL ERR6 
      GO TO 900 
C 
C  ADD ERR
C 
960   CALL ERR7 
      GO TO 110 
C 
C  SEQ ERR
C 
970   CALL ERR8 
      GO TO 110 
C 
C  LINE ERR 
C 
980   CALL ERR9 
      GO TO 110 
C 
C  REPL ERR 
C 
985   CALL ERR10
      GO TO 110 
C 
C  CREATE ERR 
C 
990   CALL ERR12
      GO TO 900 
C 
C  REWIND ERR 
C 
991   CALL ERR13
      GO TO 900 
C 
C  "RTMTG FINISHED" 
C 
995   CALL MESS0
      END 
      END$