FTN7X,L,I 
      PROGRAM ECCE(4, 60),** ECCE   Rev 2.2   04/11/83   MSH ** 
C 
C ************************************************************************* 
C ***                                                                   *** 
C ***                     T H E   E D I N B U R G H                     *** 
C ***                                                                   *** 
C ***         C O M P A T I B L E   C O N T E X T   E D I T O R         *** 
C ***                                                                   *** 
C ***                                                                   *** 
C *+*   Conceived by:                                                   *** 
C ***   HAMISH DEWAR   (EDINBURGH UNIVERSITY COMPUTER SCIENCE DEPT.)    *** 
C ***                                                                   *** 
C ***   First translation from IMP to FORTE by:                         *** 
C ***   KEITH FARVIS   (EDINBURGH REGIONAL COMPUTING CENTRE,   1976)    *** 
C ***                                                                   *** 
C ***   Rewritten for Hewlett Packard System 1000 by:                   *** 
C ***   MIKE HURST     (HEWLETT PACKARD LTD.   1979)                    *** 
C ***                                                                   *** 
C ***   Modifications for FORTRAN-77 by:                                *** 
C ***   MIKE HURST     (HELWETT PACKARD LTD.   1983)                    *** 
C ***                                                                   *** 
C ************************************************************************* 
C 
C 
C 
C 
C 
C 
C     B L O C K   C O M M O N   A R E A S . 
C 
C 
C     Global editor variables, mainly concerned with command parsing. 
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
C 
C        SYM    = Current character from the terminal.
C        PEND   = Next character from the terminal. 
C        SYMTYP = Lookup table of command types.
C        TYPE   = The type of a command.
C        CODE   = The command code. 
C        TEXT   = The text associated with the command. 
C        NUM    = Repetition count. 
C        CHAIN  = Link to the position of brackets in the input command.
C        PP1    = Temporary pointer into the file buffer. 
C        MON    = Monitoring indicator. 
C        CASE   = Case indicator. 
C        STOP   = Repetition limit for commands (constant). 
C        PRINT1 = Print indicator.
C        PRINT2 = Print indicator.
C        LINMAX = Maximum number of characters per line.
C 
C 
C     The command buffer and control pointers.
C 
      COMMON /COMMD/ C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      INTEGER        C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      DIMENSION      C(128) 
C 
C        C      = Command input array (Commands -->   <-- Text).
C        CIBASE = Bottom of command array.
C        TIBASE = Top of command array. 
C        CI     = Current command index.
C        TI     = Current text index. 
C        CMAX   = Maximum command index for this command line.
C 
C 
C     The macro text store. 
C 
      COMMON /MACRO/ STORED, POS1,   POS2,   POS3 
      INTEGER        STORED, POS1,   POS2,   POS3 
      DIMENSION      STORED(192)
C 
C        STORED = Array for storage of the macro command strings. 
C        POS1   = 
C        POS2   =  Three indexes into the STORED array. 
C        POS3   = 
C 
C 
C     The file buffer and pointers. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
C 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
C 
C        A      = The file buffer.  This holds both the main and secondary
C                 files, one before the other.  The data is packed one
C                 character per byte  (two characters per array element 
C                 for the 16-bit System 1000 computer). 
C                 This will be a machine dependant feature. 
C        BUFLEN = The character length of the buffer. 
C        BYTES  = Number of characters stored per buffer element  A(n). 
C 
C     The buffer pointers are arranged as follows:- 
C 
C     <nl>     LINE ONE <nl> LINE T      WO AND <nl> LAST LINE <nl> 
C         !    !             !     !     !      !                   !     ! 
C        TOP  FBEG          LBEG   PP    FP    LEND                FEND  BOT
C 
C        TOP    = Top of file buffer (constant).
C        FBEG   = Beginning of file (index).
C        LBEG   = Beginning of current line (index).
C        PP     = Previous pointer(index).
C        FP     = File pointer (index). 
C        LEND   = End of current line (index).
C        FEND   = End of file (index).
C        BOT    = Bottom of file buffer (constant). 
C 
C     When matching a string in the file:-
C        MS     = Start of matching string (index). 
C        ML     = Last character of matching string (index).
C 
C 
C     Extra pointers for the secondary input facility.
C 
      COMMON /SINPR/ SEXTRA, SINPUT, SINTOP, SFP,    SECFP,  SEND,
     +               MFP,    MLEND,  MEND,   MARKER 
      INTEGER        SEXTRA,         SINTOP, SFP,    SECFP,  SEND,
     +               MFP,    MLEND,  MEND,   MARKER 
      LOGICAL        SINPUT 
C 
C     For the secondary input there is no gap between the top and bottom
C     segments of the file and hence no use of the PP pointer.
C 
C     <nl> LINE ONE <nl> LINE TWO AND <nl> LAST LINE <nl> 
C         !                    !      !                  !        ! 
C       SINTOP                SFP    LEND               FEND     BOT
C 
C        SINTOP = Top of the secondary buffer (constant). 
C        SFP    = Secondary file pointer (index). 
C        SECFP  = Copy of secondary file pointer. 
C        SEND   = Copy of secondary file end pointer. 
C        MFP    = Copy of main file pointer.
C        MLEND  = Copy of main line end pointer.
C        MEND   = Copy of main file end pointer.
C        MARKER = Pointer in main file for transfer of text in the 'A'
C                 command.
C        SINPUT = True if secondary input operative.
C        SEXTRA = Size of secondary buffer (constant).
C 
C 
C     The character set used. 
C 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
C 
C     The characters here are the ASCII set but may need redefining if
C     other sets are used by any particular machine.  ASCII is used 
C     rather than hollerith constants to simplify the arithmetic in 
C     command decoding e.t.c..
C 
C 
C     Input - output stream numbers.
C 
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
C 
C     The input-output streams are defined so that:-
C        TTY    = The users terminal. 
C        MIN    = The main input file.
C        SIN    = The secondary input file (read only). 
C        IN     = Current input stream  ( = MIN or SIN or 0). 
C        OUT    = The output stream.
C 
C 
C 
C 
C ***   IMPLEMENTATION SPECIFIC VARIABLES   *** 
C 
C 
C     Line buffers for terminal input-output. 
C 
      COMMON /TTYIO/ ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      INTEGER        ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      DIMENSION      ILINE(128), OLINE(138), PRSTR(2) 
C 
C 
C     NAMR tables and data control blocks for RTE-IV file access. 
C 
      COMMON /FILIO/ MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      INTEGER        MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      DIMENSION      MITAB(10),  MIDCB(272),
     +               SITAB(10),  SIDCB(144),
     +               MOTAB(10),  MODCB(272) 
      DIMENSION      SONAME(3)
C 
C 
C ***   END OF IMPLEMENTATION SPECIFIC VARIABLES ***
C 
C 
C 
C 
C     I N I T I A L I S A T I O N   O F   C O N S T A N T S . 
C 
C 
C ***   Note.  HP FTN4 cannot support the initialisation of common area 
C ***   variables here.  This is done in the "BLOCK DATA" subprogram at 
C ***   the end of the subroutines. 
C 
C     1. Looping limit and maximum line length:-
C     DATA STOP   /-1000/ 
C     DATA LINMAX   /256/ 
C 
C     2. Input-output stream constants:-
C     DATA TTY        /1/ 
C     DATA MIN        /0/ 
C     DATA SIN        /0/ 
C     DATA IN         /0/ 
C     DATA OUT        /0/ 
C 
C     3. Commands:- 
C     DATA CIBASE     /1/ 
C     DATA TIBASE   /128/ 
C 
C     4. Command type table:- 
C 
C           !   "   #   $   %   &   '   (   )   *   +   ,   -   .   / 
C       0   1   2   3   4   5   6   7   8   9   :   ;   <   =   >   ? 
C       @   A   B   C   D   E   F   G   H   I   J   K   L   M   N   O 
C       P   Q   R   S   T   U   V   W   X   Y   Z   [   \   ]   ^   _ 
C 
C     DATA SYMTYP/
C    +     64,  3,  3,  3,  2,  3,  3, 75, 73, 64,  3, 76,  2,  3,  3,
C    +  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  1,  3,  3,  3, 64,
C    +  3,218, 10, 18,  5,  8,116, 10,  2,  6, 10, 10, 58,120,250,  2,
C    + 74, 50, 10, 22, 85, 53,  6,  2, 32, 32, 32,  3, 74,  3,  3,  3/
C 
C        (octal values) 
C         100,  3,  3,  3,  2,  3,  3,113,111,100,  3,114,  2,  3,  3,
C       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  1,  3,  3,  3,100,
C       3,332, 12, 22,  5, 10,164, 12,  2,  6, 12, 12, 72,170,372,  2,
C     112, 62, 12, 26,125, 65,  6,  2, 40, 40, 40,  3,112,  3,  3,  3 
C 
C        (meaning of bit positions) 
C     7 (200) = Secondary input specific commands.
C     6 (100) = Secondary input permissable commands. 
C     5 ( 40) = A special '%' command.
C     4 ( 20) = A special '%' command.
C     3 ( 10) = 
C     2 (  4) = 
C     1 (  2) = 
C     0 (  1) = 
C 
C 
C ***   IMPLEMENTATION SPECIFIC INITIALISATION   ***
C 
C     5. ASCII character set:-
C     DATA KNL   /10/, KFF   /12/ 
C    +     KSPACE/32/, KXCLAM/33/, KDQUOT/34/, KHASH /35/, KDOLLR/36/,
C    +     KPCENT/37/, KAND  /38/, KQUOTE/39/, KLPAR /40/, KRPAR /41/,
C    +     KSTAR /42/, KPLUS /43/, KCOMMA/44/, KMINUS/45/, KDOT  /46/,
C    +     KSLASH/47/, K0    /48/, K1    /49/, K2    /50/, K3    /51/,
C    +     K4    /52/, K5    /53/, K6    /54/, K7    /55/, K8    /56/,
C    +     K9    /57/, KCOLON/58/, KSEMIC/59/, KLT   /60/, KEQ   /61/,
C    +     KGT   /62/, KQUEST/63/, KAT   /64/, KA    /65/, KB    /66/,
C    +     KC    /67/, KD    /68/, KE    /69/, KF    /70/, KG    /71/,
C    +     KH    /72/, KI    /73/, KJ    /74/, KK    /75/, KL    /76/,
C    +     KM    /77/, KN    /78/, KO    /79/, KP    /80/, KQ    /81/,
C    +     KR    /82/, KS    /83/, KT    /84/, KU    /85/, KV    /86/,
C    +     KW    /87/, KX    /88/, KY    /89/, KZ    /90/, KLBRAC/91/,
C    +     KBACKS/92/, KRBRAC/93/, KUPARR/94/, KSUB  /95/,
C    +     KGRAV /96/, KLA   /97/, KLZ  /122/ 
C 
C 
C     6. File buffer size and packing:- 
C        (BUFLEN = dimension of  A  times the number of bytes per word).
C     DATA BYTES      /2/ 
C     DATA BUFLEN /10000/ 
C 
C 
C     E N D   O F   C O N S T A N T   I N I T I A L I S A T I O N 
C 
C 
C 
C 
C 
C     R U N   T I M E   I N I T I A L I S A T I O N . 
C 
C 
C     Fetch input, secondary and output file names. 
      CALL FILES
C 
C     Open files and set up input-output streams. 
      CALL OPNFI
C 
C     Initialise file buffer pointers.
      CALL EINIT
C 
C     Send an indentification string to the terminal. 
      CALL PSTRG(4HEdit, -4)
      CALL NEWLN
C 
C 
C 
C 
C     C O M M A N D   I N P U T   P H A S E . 
C 
C 
C     Fetch the next command from the terminal. 
 1000 CONTINUE
      I = 1 
      IF (SINPUT) I = 2 
      CALL PRMPT(2H>>, I) 
      CALL RITEM
C 
C     Ignore blank lines
      IF (TYPE.EQ.1) GOTO 1000
C 
C     Set up command buffer pointers. 
      CI = CIBASE 
      TI = TIBASE 
      CHAIN = 0 
      IF (TYPE.NE.0 .OR. CMAX.EQ.0) GOTO 1100 
         C(CMAX+2) = NUM
         CALL RITEM 
         IF (TYPE.NE.1) GOTO 4402 
         GOTO 5000
 1100 CONTINUE
C 
C     Special '%' type commands ? 
      IF (SYM.EQ.KPCENT) GOTO 1300
C 
C     Ordinary commands.  The first item has already been read. 
 1200 CONTINUE
      I = IAND(TYPE, 15)
C 
C     Check for illegal main input / secondary input type.
      J = IAND(TYPE/64, 3)
      IF ((SINPUT .AND. J.LT.1) .OR. (.NOT.SINPUT .AND. J.GT.1))
     +  GOTO 4400 
C 
C     Default values. 
      CODE = SYM
      TEXT = 0
      NUM = 1 
      CALL RITEM
C 
C     Go to the appropriate command type. 
      GOTO (02000, 02000, 02000, 02000, 02400, 02500, 02600, 02700, 
     +      02800, 02900, 03000, 03100, 03200, 02000, 02000, 02000),
     +  I+1 
C 
C 
C     Special '%' type commands.
 1300 CONTINUE
      CALL RDSYM
      IF (SYM.GE.KLA .AND. SYM.LE.KLZ) SYM = SYM-KLA+KA 
      CODE = SYM
      IF (CODE.LT.KA) GOTO 4405 
      CALL RITEM
C 
C     Go to one of the special command types. 
         GOTO (02000, 02100, 02200, 02300), 
     +     IAND(SYMTYP(CODE-KSPACE)/16, 3)+1
C 
C 
C 
C 
C     C O M M A N D   T Y P E   D E C O D I N G . 
C 
C 
C     0. Illegal type.
02000 CONTINUE
      GOTO 4405 
C 
C 
C     1. Special '%' commands:  %C,  %A,  %S,  %T 
C        %C = Normal closure of the editor. 
C        %A = Abort closure.  (Output left in the scratch file).
C        %S = Switch between main and secondary inputs. 
C        %T = Rewind to the top of the file.
02100 CONTINUE
      IF (CODE.NE.KS) GOTO 9000 
      CALL SWINP
      GOTO 5800 
C 
C 
C     2. Macro definitions:  %X,  %Y,  %Z 
02200 CONTINUE
      IF (SYM.NE.KEQ) GOTO 4401 
      I = ((CODE-KX)*64)+1
C 
C     Read command line into STORED buffer for later use. 
 2210 CONTINUE
         CALL RDSYM 
         STORED(I) = SYM
         IF (SYM.EQ.KNL) GOTO 1000
         IF (IAND(I, 63).EQ.0) GOTO 4406
         I = I+1
      GOTO 2210 
C 
C 
C     3. Monitoring modes:  %F,  %M,  %Q
C        Case modes:        %L,  %N,  %U
02300 CONTINUE
      IF (CODE.EQ.KF .OR. CODE.EQ.KM .OR. CODE.EQ.KQ) MON = KM-CODE 
      IF (CODE.EQ.KL .OR. CODE.EQ.KN .OR. CODE.EQ.KU) CASE = KN-CODE
      GOTO 1000 
C 
C 
C     4. Find 
02400 CONTINUE
      IF (TYPE.NE.0) NUM = 0
C 
C 
C     5. Delete, Traverse, Uncover, ( + Find ). 
02500 CONTINUE
C 
C     Put limit of search into code item and reset to default.
      CODE = NUM*128+CODE 
      NUM = 1 
      IF (TYPE.EQ.0) CALL RITEM 
C 
C 
C     6. Insert, Substitute, Verify, ( + Find, Delete, Traverse, Uncover ). 
02600 CONTINUE
C 
C     Check for legitimate quote symbol.
      IF (TYPE.NE.3) GOTO 4404
      TEXT = TI 
      I = SYM 
C 
C     Get the text string for these commands. 
 2610 CONTINUE
         CALL RDSYM 
         IF (SYM.EQ.KNL) PEND = SYM 
C 
C     End of text ? 
         IF (SYM.EQ.KNL .OR. SYM.EQ.I) GOTO 2620
C 
C     String too long ? 
         IF (TI.LE.CI) GOTO 4406
C 
C     Convert to lower case if lower case mode set. 
         IF (CASE.LT.0 .AND. SYM.GE.KA .AND. SYM.LE.KZ) 
     +     SYM = SYM-KA+KLA 
C 
C     Convert to upper case if upper case mode set. 
         IF (CASE.GT.0 .AND. SYM.GE.KLA .AND. SYM.LE.KLZ) 
     +     SYM = SYM-KLA+KA 
         C(TI) = SYM
         TI = TI-1
      GOTO 2610 
C 
C     End of text.
 2620 IF ((SYM.EQ.KNL .OR. TI.EQ.TEXT)
     +    .AND. CODE.NE.KI .AND. CODE.NE.KS) GOTO 4404
      C(TI) = 0 
      TI = TI-1 
      GOTO 2810 
C 
C 
C     7. - undefined -. 
02700 CONTINUE
      GOTO 4405 
C 
C 
C     8. Move, Erase. 
02800 CONTINUE
      IF (SYM.NE.KMINUS) GOTO 3010
C 
C     Convert 'M-' and 'E-' to 'O' and 'W'. 
      CODE = CODE+10
 2810 CALL RITEM
      GOTO 3020 
C 
C 
C     9. Close parenthesis. 
02900 CONTINUE
      CALL UCHAN
C 
C     Do parentheses match ?
      IF (TEXT.EQ.0) GOTO 4403
C 
C     Put in the parenthesis. 
      CODE = KY 
      C(TEXT+2) = NUM 
      TEXT = TEXT+3 
C 
C 
C     10. Get, Kill etc.. 
03000 CONTINUE
C 
C     Funny character ? 
 3010 IF (TYPE.EQ.3) GOTO 4401
 3020 IF (TYPE.EQ.0) CALL RITEM 
      GOTO 4000 
C 
C 
C     11. Open parenthesis. 
03100 CONTINUE
      CODE = KX 
      GOTO 3210 
C 
C 
C     12. Comma.
03200 CONTINUE
      CODE = KZ 
C 
C     Ignore following newline. 
      IF (TYPE.EQ.1) CALL RITEM 
 3210 TEXT = CHAIN
      CHAIN = CI
      NUM = 0 
C 
C 
C 
 4000 CONTINUE
      CALL STACK(CODE)
      CALL STACK(TEXT)
      CALL STACK(NUM) 
C 
C     Make sure command string is not too long. 
      IF (CI+4.GE.TI) GOTO 4406 
C 
C     Get next command if not at an end of line.
      IF (TYPE.NE.1) GOTO 1200
      CALL UCHAN
      IF (TEXT.NE.0) GOTO 4403
      CMAX = CI 
C 
C     Add an extra closing bracket. 
      CALL STACK(KY)
      CALL STACK(CIBASE)
      CALL STACK(1) 
      CALL STACK(0) 
      GOTO 5000 
C 
C 
C 
C 
C     C O M M A N D   I N P U T   E R R O R   R E P O R T S . 
C 
C 
 4400 CALL PSTRG(4H SIN, -4)
      GOTO 4402 
 4401 CALL PSYM(KSPACE) 
      CALL PSYM(CODE) 
 4402 CODE = SYM
      GOTO 4405 
 4403 CALL PSTRG(3H (), -3) 
      GOTO 4407 
 4404 CALL PSTRG(9H TEXT FOR, -9) 
 4405 CALL PSYM(KSPACE) 
      CALL PSYM(CODE) 
      GOTO 4407 
 4406 CALL PSTRG(5H SIZE, -5) 
 4407 CALL PSYM(KQUEST) 
      CALL NEWLN
      IF (CI.NE.CIBASE) CMAX = 0
C 
C     Ignore type ahead.
      CALL TSKIP
      GOTO 1000 
C 
C 
C 
C 
C     C O M M A N D   E X E C U T I O N   P H A S E . 
C 
C 
 5000 CONTINUE
      CI = CIBASE 
C 
 5100 CONTINUE
      CODE = IAND(C(CI), 127) 
C 
C     Are we at the end of a command line ? 
      IF (CODE.EQ.0) GOTO 5800
C 
C     Set up next command.
      TEXT = C(CI+1)
      NUM = C(CI+2) 
      CI = CI+3 
C 
 5200 CONTINUE
      NUM = NUM-1 
      GOTO (06100, 06200, 06300, 06400, 06500, 06600, 06700, 06800, 
     +      06900, 07000, 07100, 07200, 07300, 07400, 07500, 07600, 
     +      07700, 07800, 07900, 08000, 08100, 08200, 08300, 08400, 
     +      08500, 08600, 08700, 08800), CODE-KAT 
C 
 5300 CONTINUE
      IF (NUM.NE.0 .AND. NUM.NE.STOP) GOTO 5200 
      GOTO 5100 
C 
 5400 CONTINUE
      IF (NUM.LT.0) GOTO 5100 
      IF(C(CI).NE.KBACKS) GOTO 5500 
      CI = CI+3 
      GOTO 5100 
C 
 5500 CONTINUE
      I = C(CI) 
C 
C     Check for an opening parenthesis. 
      IF (I.EQ.KX) CI = C(CI+1) 
      CI = CI+3 
C 
C     Check for closing parenthesis or comma. 
      IF (I.NE.KY .AND. I.NE.KZ) GOTO 5510
         NUM = C(CI-1)-1
         GOTO 5400
 5510 CONTINUE
      IF (I.NE.0) GOTO 5500 
C 
C 
C 
C 
C     C O M M A N D   E X E C U T I O N   E R R O R   R E P O R T S.
C 
C 
      CALL PSTRG(10H FAILURE: , -10)
      IF (CODE.NE.KO .AND. CODE.NE.KW) GOTO 5610
C 
C     Restore 'E-' and 'M-' from 'O' and 'W'. 
         CALL PSYM(CODE-10) 
         CODE = KMINUS
 5610 CONTINUE
      CALL PSYM(CODE) 
C 
C     Print out text. 
      IF (TEXT.EQ.0) GOTO 5620
         CALL PSYM(KQUOTE)
 5611    IF (C(TEXT).EQ.0) GOTO 5612
            CALL PSYM(C(TEXT))
            TEXT = TEXT-1 
            GOTO 5611 
 5612    CONTINUE 
         CALL PSYM(KQUOTE)
 5620 CONTINUE
      CALL NEWLN
C 
C     Ignore type ahead.
      CALL TSKIP
      PRINT1 = 0
C 
C 
C 
C 
C     E N D   O F   C O M M A N D   E X E C U T I O N   P H A S E . 
C 
C 
 5800 CONTINUE
      IF (SYM.NE.KNL .OR. MON.LT.0 .OR. 
     +   (PRINT1.EQ.LEND .AND. (MON.EQ.0 .OR. PRINT2.EQ.FP+PP)))
     +  GOTO 1000 
      NUM = 0 
      CALL PRINT
      GOTO 1000 
C 
C 
C 
C 
C     I N D I V I D U A L   C O M M A N D   E X E C U T I O N . 
C 
C 
C     Open parenthesis. (Repetition number reset on close parenthesis). 
08400 CONTINUE
      C(TEXT+2) = NUM+1 
      GOTO 5100 
C 
C     Close parenthesis.
08500 CONTINUE
      IF (NUM.EQ.0 .OR. NUM.EQ.STOP) GOTO 5100
      C(CI-1) = NUM 
C 
C     Comma.
08600 CONTINUE
      CI = TEXT 
      GOTO 5100 
C 
C     Right shift.
07800 CONTINUE
      IF (FP.EQ.LEND) GOTO 5400 
      CALL RIGHT
      GOTO 5300 
C 
C     Left shift. 
07200 CONTINUE
      IF (PP.EQ.LBEG) GOTO 5400 
      CALL LEFT 
      MS = 0
      GOTO 5300 
C 
C     Erase.
06500 CONTINUE
      IF (FP.EQ.LEND) GOTO 5400 
      FP = FP+1 
      GOTO 5300 
C 
C     Erase back. 
07500 CONTINUE
      IF (PP.EQ.LBEG) GOTO 5400 
      PP = PP-1 
      GOTO 5300 
C 
C     Verify. 
08200 CONTINUE
      I = FP
      J = TEXT
 8210 IF (JGET(I).NE.C(J)) GOTO 8220
         I = I+1
         J = J-1
      GOTO 8210 
 8220 CONTINUE
      IF (C(J).NE.0) GOTO 5400
      MS = FP 
      ML = I
      GOTO 5300 
C 
C     Find. 
06600 CONTINUE
      IF (MATCH(N).EQ.0) GOTO 5400
      GOTO 5300 
C 
C     Uncover.
08100 CONTINUE
      IF (MATCH(N).EQ.0) GOTO 5400
      PP = PP1
      GOTO 5300 
C 
C     Delete. 
06400 CONTINUE
      IF (MATCH(N).EQ.0) GOTO 5400
      FP = ML 
      GOTO 5300 
C 
C     Traverse. 
08000 CONTINUE
      IF (MATCH(N).EQ.0) GOTO 5400
C 
C     Substitute ( + Traverse ).
07900 CONTINUE
      IF (FP.NE.MS) GOTO 5400 
      FP = ML 
C 
C     Insert ( + Substitute + Traverse ). 
06900 CONTINUE
      CALL GETSP
      IF (PP-LBEG+LEND-FP.GE.LINMAX) GOTO 5400
      I = TEXT
 6910 CONTINUE
         IF (C(I).EQ.0) GOTO 5300 
         CALL PUTPP(C(I)) 
         I = I-1
      GOTO 6910 
C 
C     Get.
06700 CONTINUE
      CALL PRMPT(1H., 1)
      CALL GETSP
      CALL RSYM(I)
      IF (I.EQ.KDOT) GOTO 5400
      CALL LSTAR
 6710 IF (I.EQ.KNL) GOTO 6720 
         IF (CASE.LT.0 .AND. I.GE.KA .AND. I.LE.KZ) I = I-KA+KLA
         IF (CASE.GT.0 .AND. I.GE.KLA .AND. I.LE.KLZ) I = I-KLA+KA
         CALL PUTPP(I)
         CALL RSYM(I) 
         GOTO 6710
 6720 CONTINUE
C 
C     Break ( + Get ).
06200 CONTINUE
      CALL BREAK
      GOTO 5300 
C 
C     Print.
07600 CONTINUE
      CALL PRINT
      IF (NUM.EQ.0) GOTO 5100 
C 
C     Move ( + Print ). 
07300 CONTINUE
      CALL RSTAR
      IF (FP.EQ.FEND) GOTO 5400 
      CALL BREAK
 7310 CALL REFRS
      GOTO 5300 
C 
C     Kill. 
07100 CONTINUE
      PP = LBEG 
 7110 FP = LEND 
 7120 IF (FP.EQ.FEND) GOTO 5400 
      GOTO 7310 
C 
C     Join. 
07000 CONTINUE
      CALL RSTAR
      IF (PP-LBEG.GT.LINMAX) GOTO 5400
      GOTO 7120 
C 
C     Move back.
08300 CONTINUE
      CALL GETSP
      IF (LBEG.EQ.FBEG) GOTO 5400 
      CALL LSTAR
      CALL LEFT 
      LEND = FP 
 8310 CONTINUE
         PP = PP-1
         K = JGET(PP) 
         IF (K.EQ.KNL) GOTO 8320
         CALL PUTFP(K)
      GOTO 8310 
 8320 CONTINUE
      PP = PP+1 
      LBEG = PP 
      MS = 0
      GOTO 5300 
C 
C     Note. 
07400 CONTINUE
      MARKER = FP 
      GOTO 5300 
C 
C     Abstract. 
06100 CONTINUE
      CALL GETSP
      IF (SINTOP.GT.MARKER .OR. MARKER.GE.SFP) GOTO 5400
      IMARK = MARKER
 160     DO 161 I = 1,LINMAX
         CALL PUTPP(IMARK)
         IMARK = IMARK+1
         IF (IMARK.EQ.SFP) GOTO 162 
 161     CONTINUE 
      CALL GETSP
      GOTO 160
 162  LBEG = PP 
      GOTO 5300 
C 
C     Invert failure condition. 
08800 CONTINUE
      GOTO 5400 
C 
C     - undefined commands -. 
06300 CONTINUE
06800 CONTINUE
07700 CONTINUE
08700 CONTINUE
      GOTO 4405 
C 
C 
C 
C 
C     E D I T O R   T E R M I N A T I O N . 
C 
C 
 9000 CONTINUE
      IF (CODE.EQ.KA .OR. OUT.EQ.0) GOTO 9100 
C 
C     Set flag for %C or %T.
         OUT = 2
C 
C     Move to the bottom of the file. 
 9010    CONTINUE 
            CALL RSTAR
            IF (FP.EQ.FEND) GOTO 9020 
            CALL BREAK
            CALL REFRS
            GOTO 9010 
 9020    CONTINUE 
C 
C     Write buffer out to file. 
 9030    IF (FBEG.EQ.PP) GOTO 9040
            CALL PLINE
            GOTO 9030 
 9040    CONTINUE 
C 
C     Close files.
 9100 CONTINUE
      CALL CLSFI
C 
C     Check for %T. 
      IF (CODE.NE.KT) GOTO 9900 
C 
C     Re-open all files, initialise buffer and jump to restart. 
         CALL OPNFI 
         CALL EINIT 
         CALL PRINT 
         GOTO 1000
 9900 CONTINUE
      END 
      SUBROUTINE EINIT
C 
C     Initialise file buffer pointers.
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /COMMD/ C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      INTEGER        C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      DIMENSION      C(128) 
      COMMON /MACRO/ STORED, POS1,   POS2,   POS3 
      INTEGER        STORED, POS1,   POS2,   POS3 
      DIMENSION      STORED(192)
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      PEND = 0
      PRINT1 = 0
      PRINT2 = 0
      CMAX = 0
      STORED(1) = KNL
      STORED(65) = KNL
      STORED(129) = KNL
      POS1 = 0
      POS2 = 0
      POS3 = 0
      CALL BINIT
      MS = 0
      ML = 0
      IN = MIN
      CALL RLINE
      RETURN
      END
      SUBROUTINE SWINP
C
C     Switch between main and secondary inputs.
C
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      RETURN
      END 
      INTEGER FUNCTION MATCH(DUMMY) 
C 
C     A logical function to find a matching string in the file using
C     the code+limit 'string'.
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /COMMD/ C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      INTEGER        C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      DIMENSION      C(128) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      INTEGER        DUMMY
      INTEGER        FP1,    T1,     LIM,    SKIP 
C 
C     Pick up search limit and first letter.
      LIM = C(CI-3)/128 
      T1 = C(TEXT)
 1000 CONTINUE
C 
C     Note old positions of the pointers. 
         PP1 = PP 
         FP1 = FP 
C 
C     Search one line.
 1100    CONTINUE 
            SKIP = JFIND(FP, T1)-FP 
            CALL JMOVE(PP, FP, SKIP)
            PP = PP+SKIP
            FP = FP+SKIP
            IF (FP.EQ.LEND) GOTO 1200 
            IF (FP.EQ.MS .AND. CODE.NE.KD .AND. CODE.NE. KT) GOTO 1110
C 
C     We have found a match for the first letter.  Now try the rest.
               I = FP 
               J = TEXT 
 1101          CONTINUE 
                  I = I+1 
                  J = J-1 
                  L = C(J)
                  IF (L.EQ.0) GOTO 3000 
               IF (L.EQ.JGET(I)) GOTO 1101
 1110       CONTINUE
C 
C     Match failed.  Move one character right and repeat. 
            CALL RIGHT
         GOTO 1100
 1200    CONTINUE 
C 
C     End of line.
         LIM = LIM-1
C
C     Fail if limit reached or end of file.
         IF (LIM.EQ.0 .OR. FP.EQ.FEND) GOTO 2000
C
C     Move over end of line (or throw away text if 'U' command).
         IF (CODE.EQ.KU) GOTO 1300
            CALL BREAK
         GOTO 1400
 1300    CONTINUE
            PP = PP1
 1400    CONTINUE
         CALL REFRS
      GOTO 1000
C
C     False exit for not matched.
 2000 PP = PP1
      FP = FP1
      MATCH = 0
      RETURN
C 
C     True exit for successful match. 
 3000 MS = FP 
      ML = I
      MATCH = 1 
      RETURN
      END 
      SUBROUTINE REFRS
C 
C     Ensure there is sufficient breathing space in the file buffer for 
C     the next line of input, and input it. 
C 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
C 
C     Move to the end of the current line.
      FP = FP+1 
C 
C     Make sure of space. 
      CALL GETSP
C 
C     Get next line.
      CALL RLINE
      RETURN
      END 
      SUBROUTINE GETSP
C 
C     Make space in the main buffer (if necessary) by outputting the
C     top half. 
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      INTEGER        MAINFP, P1 
C 
C     Is there enough space in the main buffer. 
      IF (FP-PP.GT.2*LINMAX) RETURN 
      P1 = (FBEG+LBEG)/2
C 
C     Logical pointer error !?!?!?
      IF (P1.LE.FBEG) GOTO 999
C 
C     Flush out half the top section of the file buffer.
  100 CONTINUE
         CALL PLINE 
      IF (FBEG.LT.P1) GOTO 100
C 
C     Move up the rest of the top section.
      CALL JMOVE(TOP, FBEG, PP-FBEG)
      LBEG = TOP+LBEG-FBEG
      PP = TOP+PP-FBEG
      FBEG = TOP
      RETURN
C 
C     Logical pointer error ?!?!? 
 999  CALL PSTRG(29H** Text pointers corrupted !!, -29) 
      CALL NEWLN
      CALL CLSFI
      CALL EXEC(6)
      END 
      SUBROUTINE BREAK
C 
C     Insert a newline character into the file buffer.
C 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      CALL PUTPP(KNL) 
      LBEG = PP 
      END 
      SUBROUTINE RLINE
C 
C     Read the next line from the file into the file buffer.
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      INTEGER        P1,     ILEN 
C 
C     Are we at the end of the current section of the file in the file
C     buffer ?
      IF (FP.EQ.FEND) GOTO 200
C 
C     No ... move to the next line in the file buffer.
         LEND = JFIND(FP, KNL)
         RETURN 
  200 CONTINUE
C 
C     Reset buffer pointers.
      MS = 0
      PRINT1 = 0
      PRINT2 = 0
      FP = BOT-LINMAX
C ***   Coerce  FP  to a word boundary.
      FP = FP/BYTES*BYTES
C
C     Read in the next line from the file to the position defined by FP.
C     Note that as FORTRAN arrays start at element 1 (and not 0) we have
C     to add one to the word address of  FP  in  A.
      CALL INLN(A(1+FP/BYTES), ILEN)
C
C     Check for end of file (or no null input).
      IF (ILEN.GE.0) GOTO 300
         FP = BOT
         LEND = FP
         FEND = LEND
      GOTO 400
  300 CONTINUE
C
C     Set line end and file end pointers to the end of the new line and
C     add a newline character.
         LEND = FP+ILEN 
         FEND = LEND+1
  400 CONTINUE
      P1 = PP 
      PP = LEND 
      CALL PUTPP(KNL) 
      PP = P1 
      RETURN
      END 
      SUBROUTINE PLINE
C 
C     Print out the top line in the file buffer.  This routine assumes
C     that a line exists before the  PP  pointer. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      INTEGER        P1,     ILEN 
C 
C     Set  ILEN  to the length of the first line in the buffer. 
      ILEN = JFIND(FBEG, KNL)-FBEG
C 
C ***   Make sure this line is aligned on a word boundary before writing
C ***   it out. 
      P1 = FBEG/BYTES*BYTES 
      IF (P1.NE.FBEG) CALL JMOVE(P1, FBEG, ILEN)
C 
C     Write out the line and advance  FBEG  to the start of the next line.
      CALL OUTLN(A(1+P1/BYTES), ILEN) 
      FBEG = FBEG+ILEN+1
      RETURN
      END 
      SUBROUTINE UCHAN
C 
C        Use temporary links to locate last unmatched open parenthesis
C     (if any).  Fix up any comma units en route. 
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /COMMD/ C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      INTEGER        C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      DIMENSION      C(128) 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
  100 CONTINUE
         TEXT = CHAIN 
         IF (TEXT.EQ.0) RETURN
         CHAIN = C(TEXT+1)
         C(TEXT+1) = CI 
      IF (C(TEXT).NE.KX) GOTO 100 
      RETURN
      END 
      SUBROUTINE STACK(V) 
C 
C        Push a command item onto the command array.
C 
      COMMON /COMMD/ C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      INTEGER        C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      DIMENSION      C(128) 
      INTEGER        V
      C(CI) = V 
      CI = CI+1 
      RETURN
      END 
      SUBROUTINE RITEM
C 
C        Read command item (symbol or number), skipping leading spaces, 
C     standardising case and detecting macro letters.  Set up the type
C     of the item (from SYMTYP) into TYPE.  For a numeric item, assemble
C     a sequence a digits and return the value in NUM.
C     Note that NUM is not altered for non numeric types. 
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /MACRO/ STORED, POS1,   POS2,   POS3 
      INTEGER        STORED, POS1,   POS2,   POS3 
      DIMENSION      STORED(192)
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
  100 CONTINUE
C 
C     Default type for end of line. 
         TYPE = 1 
C 
C     Skip spaces.
  110    CONTINUE 
            CALL RDSYM
         IF (SYM.EQ.KSPACE) GOTO 110
C 
C     Treate any control character as a newline.
         IF (SYM.LT.KSPACE) RETURN
C 
C     Ensure upper case.
         IF (SYM.GE.KLA .AND. SYM.LE.KLZ) SYM = SYM-KLA+KA
C 
C     Fetch item type.
         TYPE = SYMTYP(SYM-KSPACE)
C 
C     Return unless numeric or a macro letter (X, Y, Z).
         IF (IAND(TYPE, 15).NE.0) RETURN
         IF (TYPE.NE.32) GOTO 200 
         POS1 = POS2
         POS2 = POS3
         POS3 = ((SYM-KX)*64)+1 
         GOTO 100 
  200 CONTINUE
      IF (TYPE.NE.0) GOTO 300 
C 
C     A decimal digit.
         NUM = SYM-K0 
  210    CONTINUE 
            CALL RDSYM
            IF (SYM.LT.K0 .OR. SYM.GT.K9) GOTO 220
            NUM = NUM*10+(SYM-K0) 
            GOTO 210
  220    CONTINUE 
         PEND = SYM 
      RETURN
C 
C     '!', '*', '?'  etc..
  300    TYPE = 0 
         NUM = 0
         IF (SYM.EQ.KSTAR) RETURN 
         NUM = STOP+1 
         IF (SYM.EQ.KQUEST) RETURN
         NUM = STOP 
      RETURN
      END 
      SUBROUTINE RDSYM
C 
C     Reads the next command symbol from the terminal or macro buffers
C     into the variable SYM.
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /MACRO/ STORED, POS1,   POS2,   POS3 
      INTEGER        STORED, POS1,   POS2,   POS3 
      DIMENSION      STORED(192)
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      IF (PEND.EQ.0) GOTO 100 
         SYM = PEND 
         PEND = 0 
         RETURN 
  100 CONTINUE
  200 IF (POS3.EQ.0) GOTO 300 
         SYM = STORED(POS3) 
         POS3 = POS3+1
         IF (SYM.NE.KNL) RETURN 
         POS3 = POS2
         POS2 = POS1
         POS1 = 0 
         GOTO 200 
  300 CONTINUE
      CALL RSYM(SYM)
      RETURN
      END 
      SUBROUTINE PRINT
C 
C     Print out the current line on the terminal. 
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      INTEGER        P1 
      LOGICAL        REVID
      PRINT1 = LEND 
      PRINT2 = FP+PP
      CALL PSYM(KSPACE) 
C 
C ***   Special for HP 26xx series terminals.  Use reverse video for the
C ***   section of the current line prior to the file pointer.
      REVID = PP.NE.LBEG .AND. NUM.EQ.0 
      IF (REVID) CALL PSTRG(4H&dJ, -4) 
      P1 = LBEG 
  100 CONTINUE
C 
C     Check for the position of the file pointer. 
         IF (P1.NE.PP) GOTO 110 
C 
C     Type the file pointer unless we are at the beginning of the line. 
C 
C     Generally the file pointer will be a caret (or up-arrow) symbol.
C           IF (P1.NE.LBEG .AND. NUM.EQ.0) CALL PSYM(KUPARR)
C 
C ***   But for HP terminals come out of reverse video mode.
            IF (REVID) CALL PSTRG(4H&d@, -4) 
            P1 = FP 
  110    CONTINUE 
         IF (P1.EQ.LEND) GOTO 200 
         CALL PSYM(JGET(P1))
         P1 = P1+1
      GOTO 100
C 
C     End of file ? 
  200 IF (P1.EQ.FEND) CALL PSTRG(7H**END**, -7) 
      CALL PSYM(KSPACE) 
      CALL NEWLN
      END 
C 
C 
C ************************************************************************* 
C ***                                                                   *** 
C ***   I M P L E M E N T A T I O N   S P E C I F I C   S E C T I O N   *** 
C ***                                                                   *** 
C ************************************************************************* 
C 
C 
C 
C 
C     T E R M I N A L   I N P U T - O U T P U T   R O U T I N E S.
C 
C 
      SUBROUTINE PRMPT(PS, PL)
C 
C     Set up the interactive terminal prompt string.  This is two 
C     characters long maximum.
C 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      COMMON /TTYIO/ ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      INTEGER        ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      DIMENSION      ILINE(128), OLINE(138), PRSTR(2) 
      INTEGER        PS,     PL 
      PRSTR = PS
C 
C ***   For HP RTE-IV terminal drivers we use a '_' to suppress the 
C ***   newline at the end of the prompt. 
      CALL SBYTE(PRSTR, PL, KSUB) 
      PRLEN = PL+1
      RETURN
      END 
      SUBROUTINE RSYM(ICHAR)
C 
C     Read the next character from the interactive terminal.  Here it 
C     is line buffered. 
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      COMMON /TTYIO/ ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      INTEGER        ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      DIMENSION      ILINE(128), OLINE(138), PRSTR(2) 
      INTEGER        ICHAR
      INTEGER        IEQT5
C 
C     Is the line buffer empty ?
      IF (ILINEP.GT.0) GOTO 20
C 
C     Yes ... issue the prompt and read in a new line.
C ***   Here we use the HP RTE-IV re-entrant input-output routine.
   11    CONTINUE 
            CALL REIO(2, TTY, PRSTR, -PRLEN)
            CALL REIO(1, 256+TTY, ILINE, -LINMAX) 
            CALL ABREG(IEQT5, ILINEM) 
C 
C     Check for unexpected end of file  ( EOT  or  ctrl 'D' ).
            IF (IAND(IEQT5, 32).EQ.0) GOTO 20 
            CALL REIO(2, TTY, 0, 0) 
            CALL REIO(2, TTY, 15H** EOF ignored!, -15)
         GOTO 11
   20 CONTINUE
C 
C     Have all the characters in the line buffer been returned ?
      IF (ILINEP.GE.ILINEM) GOTO 30 
C 
C     No ... return the next character. 
         ICHAR = LBYTE(ILINE, ILINEP) 
         ILINEP = ILINEP+1
         RETURN 
   30 CONTINUE
C 
C     End of line.  Return a newline character and zero the line pointer. 
         ICHAR = KNL
         ILINEP = 0 
         RETURN 
      END 
      SUBROUTINE TSKIP
C 
C     Throw away any characters type in but not yet read. 
C 
      COMMON /TTYIO/ ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      INTEGER        ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      DIMENSION      ILINE(128), OLINE(138), PRLEN(2) 
      ILINEP = 0
C 
C ***   In systems which support type-ahead, special look ahead code
C ***   will be required here.
C 
      RETURN
      END 
      SUBROUTINE PSTRG(STRING, ILEN)
C 
C     Put the contents of the  STRING  into the terminal buffer.
C 
      INTEGER        STRING, ILEN 
      DIMENSION      STRING(63) 
      INTEGER        I,      L
      IF (ILEN.LT.0) L = -ILEN
      IF (ILEN.EQ.0) RETURN 
      IF (ILEN.GT.0) L = 2*ILEN 
      DO 10 I = 0, L-1
         CALL PSYM(LBYTE(STRING, I))
   10 CONTINUE
      RETURN
      END 
      SUBROUTINE PNUM(N)
C 
C     Print the number  N  on the terminal. 
C 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      INTEGER        IN,     J,      K
      LOGICAL        LZ 
C 
C     Less than or greater than zero ?
      IF (N.LT.0) GOTO 10 
         IN = N 
         GOTO 20
   10 CONTINUE
         IN = -N
         CALL PSYM(KMINUS)
   20 CONTINUE
C 
C     Print out digits (leading zeros suppressed).
      LZ = .FALSE.
      DO 30 J = 4, 0, -1
         K = MOD(IN/(10**J), 10)+K0 
         LZ = LZ .OR. K.NE.K0 .OR. J.EQ.0 
         IF (LZ) CALL PSYM(K) 
   30 CONTINUE
      RETURN
      END 
      SUBROUTINE PSYM(ICHAR)
C 
C     Output a character to the terminal.  Here it is line buffered.
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      COMMON /TTYIO/ ILINE,  ILINEP, ILINEM, PRSTR, PRLEN,
     +               OLINE,  OLINEP, OLINEM 
      INTEGER        ILINE,  ILINEP, ILINEM, PRSTR, PRLEN,
     +               OLINE,  OLINEP, OLINEM 
      DIMENSION      ILINE(128), OLINE(138), PRSTR(2) 
      INTEGER        ICHAR
C 
C     Queue character in the line buffer unless this is an newline. 
      IF (ICHAR.EQ.KNL) GOTO 10 
         CALL SBYTE(OLINE, OLINEP, ICHAR) 
         OLINEP = OLINEP+1
C 
C     Force newline if buffer full, otherwise return. 
         IF (OLINEP.LT.LINMAX+10) RETURN
   10 CONTINUE
C 
C     Write line to the terminal. 
      CALL NEWLN
      RETURN
      END 
      SUBROUTINE NEWLN
C 
C     Output the current write buffer contents to the terminal. 
C 
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      COMMON /TTYIO/ ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      INTEGER        ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      DIMENSION      ILINE(128), OLINE(138), PRSTR(2) 
C 
C ***   Here we use the HP RTE-IV re-entrant input-output routine.
      CALL REIO(2, TTY, OLINE, -OLINEP) 
      OLINEP = 0
      RETURN
      END 
C 
C 
C     D I S C   F I L E   I N P U T - O U T P U T   R O U T I N E S . 
C 
C 
      SUBROUTINE FILES
C 
C     Fetch the names of the main input, secondary input and main output
C     files.
C 
      EXTERNAL       LOGLU
      INTEGER        LOGLU
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      COMMON /FILIO/ MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      INTEGER        MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      DIMENSION      MITAB(10),  MIDCB(272),
     +               SITAB(10),  SIDCB(144),
     +               MOTAB(10),  MODCB(272) 
      DIMENSION      SONAME(3)
      INTEGER        LINE,   LINEM,  LINEL
      DIMENSION      LINE(40) 
      INTEGER        IA,     IB,     I
C 
C     ECCE is run from a RTE-IV session with the following command: 
C 
C        RUN,ECCE,<main input file>,<secd input file>,<output file> 
C 
C        <main input file> = A valid FMGR file name.
C                            For a null input file use a  0  (zero).
C 
C        <secd input file> = A valid FMGR file name.
C                            If this parameter is omitted the secondary 
C                            input file defaults to a copy of the main
C                            input file.  For a null secondary input use a
C                            0  (zero): this will give a larger window into 
C                            the main input file. 
C 
C        <output file>     = A valid FMGR file name.
C                            If this parameter is omitted the output file 
C                            will replace the main input file (on closing 
C                            ECCE).  To just look at an input file without
C                            altering it a  0 (zero) may be use here. 
C 
C     Get LU of scheduling terminal.
      TTY = LOGLU(IA) 
C
C     Fetch the ECCE run string from the host FMGR.
      CALL EXEC(14, 1, LINE, -80)
      CALL ABREG(IA, IB)
      IF (IA.LT.0) GOTO 9000
      LINEL = 1
      LINEM = IB
C
C     Skip the first two parameters in the ECCE run string  ( "RU,ECCE," ).
      CALL NAMR(MITAB, LINE, LINEM, LINEL)
      CALL NAMR(MITAB, LINE, LINEM, LINEL)
C
C     Parse the main input file name.
      CALL NAMR(MITAB, LINE, LINEM, LINEL)
      IF (IAND(MITAB(4), 003B).EQ.0) GOTO 9100
C
C     Parse the secondary input file name.
      CALL NAMR(SITAB, LINE, LINEM, LINEL)
      IF (IAND(SITAB(4), 003B).NE.0) GOTO 210
         DO 201 I = 1, 10
            SITAB(I) = MITAB(I)
  201    CONTINUE 
  210 CONTINUE
C 
C     Parse the main output file name.
      CALL NAMR(MOTAB, LINE, LINEM, LINEL)
      IF (IAND(MOTAB(4), 003B).NE.0) GOTO 310 
         DO 301 I = 1, 10 
            MOTAB(I) = MITAB(I) 
  301    CONTINUE 
  310 CONTINUE
      RETURN
C 
C     Errors ...   Print message and halt.
 9000 CALL PSTRG(35H** Cannot pick up parameter string., -35) 
      GOTO 9110 
 9100 CALL PSTRG( 
     +  56H** Parameters?   RUN,ECCE,<source>,<secondary>,<output>.,
     +  -56)
 9110 CALL NEWLN
      CALL EXEC(6)
      END 
      SUBROUTINE OPNFI
C 
C     This opens up all the input-output streams using the information
C     from the FILES subroutine.
C 
C ***   For HP RTE-IV a temporary scratch file is created for output. 
C ***   This is renamed to the required output file when the editor is
C ***   closed. 
C 
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      COMMON /FILIO/ MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      INTEGER        MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      DIMENSION      MITAB(10),  MIDCB(272),
     +               SITAB(10),  SIDCB(144),
     +               MOTAB(10),  MODCB(272) 
      DIMENSION      SONAME(3)
      INTEGER        MINAME, MIPARM, MISECU, MICART 
      DIMENSION      MINAME(3)
      EQUIVALENCE    (MINAME, MITAB(1)),  (MIPARM, MITAB(4)), 
     +               (MISECU, MITAB(5)),  (MICART, MITAB(6))
      INTEGER        SINAME, SIPARM, SISECU, SICART 
      DIMENSION      SINAME(3)
      EQUIVALENCE    (SINAME, SITAB(1)),  (SIPARM, SITAB(4)), 
     +               (SISECU, SITAB(5)),  (SICART, SITAB(6))
      INTEGER        MONAME, MOPARM, MOSECU, MOCART, MOTYPE, MOSIZE 
      DIMENSION      MONAME(3)
      EQUIVALENCE    (MONAME, MOTAB(1)),  (MOPARM, MOTAB(4)), 
     +               (MOSECU, MOTAB(5)),  (MOCART, MOTAB(6)), 
     +               (MOTYPE, MOTAB(7)),  (MOSIZE, MOTAB(8))
      INTEGER        ERROR,  JSEC,   JLU,    JTYPE,  JSIZE
      DIMENSION      JSIZE(4) 
      DATA           JSEC  /48/ 
      DATA           JLU   / 0/ 
      DATA           JTYPE / 3/ 
      DATA           JSIZE / 0,  0,  0,  0/ 
C 
C 
C     Open main input file (unless null). 
      MIN = 0 
      IF (MINAME.EQ.0) GOTO 100 
         CALL OPEN(MIDCB, ERROR, MINAME, 0, MISECU, MICART, 256)
         IF (ERROR.LT.0) GOTO 9000
         CALL LOCF(MIDCB, ERROR, J, J, J, JSEC, JLU, JTYPE) 
         IF (ERROR.LT.0) GOTO 9000
         MIN = 1
  100 CONTINUE
C 
C     Open secondary input file (unless null).
      SIN = 0 
      IF (SINAME.EQ.0) GOTO 200 
         CALL OPEN(SIDCB, ERROR, SINAME, 0, SISECU, SICART, 128)
         IF (ERROR.LT.0) GOTO 9100
         SIN = 2
  200 CONTINUE
C 
C     Create temporary scratch file for output. 
      OUT = 0 
      IF (MONAME.EQ.0) GOTO 300 
         IF (MOCART.EQ.0) MOCART = -JLU 
         IF (MOTYPE.EQ.0) MOTYPE = JTYPE
         IF (MOSIZE.EQ.0) MOSIZE = JSEC/2 
C        JSIZE(2) = MOSIZE
C        CALL CRETS(MODCB, ERROR, 0, SONAME 
C    +              JSIZE, MOTYPE, MOSECU, MOCART, 256) 
         SONAME(1) = 2H.E 
         SONAME(2) = 2HCC 
         SONAME(3) = 2HE. 
         CALL CREAT(MODCB, ERROR, SONAME, 
     +              MOSIZE, MOTYPE, MOSECU, MOCART, 256)
         IF (ERROR.LT.0) GOTO 9200
         OUT = 1
  300 CONTINUE
      RETURN
C 
C     Error ...   Print message and stop. 
 9000 CALL PSTRG(21H** Cannot open source, -21) 
      GOTO 9210 
 9100 CALL PSTRG(24H** Cannot open secondary, -24)
      GOTO 9210 
 9200 CALL PSTRG(24H** Cannot create scratch, -24)
 9210 CALL PSTRG(19H file.  FMGR error , -19) 
      CALL PNUM(ERROR)
      CALL NEWLN
      CALL EXEC(6)
      END 
      SUBROUTINE INLN(BUFFER, SIZE) 
C 
C     Read the next line from the main (or secondary) input file into 
C     the array  BUFFER .  SIZE returns the number of characters input. 
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      COMMON /FILIO/ MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      INTEGER        MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      DIMENSION      MITAB(10),  MIDCB(272),
     +               SITAB(10),  SIDCB(144),
     +               MOTAB(10),  MODCB(272) 
      DIMENSION      SONAME(3)
      INTEGER        BUFFER, SIZE 
      DIMENSION      BUFFER(128)
      INTEGER        ERROR
C 
C     Null input file ? 
      SIZE = -1 
      IF (IN.EQ.0) RETURN 
C 
C     Read a record from the appropriate file.
      IF (IN.EQ.MIN) CALL READF(MIDCB, ERROR, BUFFER, LINMAX/2, SIZE) 
      IF (IN.EQ.SIN) CALL READF(SIDCB, ERROR, BUFFER, LINMAX/2, SIZE) 
C 
C     Check for end of file error.
      IF (ERROR.EQ.-12) SIZE = -1 
      IF (SIZE.LT.0) RETURN 
C 
C     Check for other errors. 
      IF (ERROR.LT.0) GOTO 99 
C
C     Convert word count to character count.
      SIZE = 2*SIZE
C
C     Strip off any trailing spaces.
*  10 IF (SIZE.EQ.0 .OR. LBYTE(BUFFER, SIZE-1).NE.KSPACE) RETURN
*        SIZE = SIZE-1
*     GOTO 10
      RETURN
C
C     Disc read error ... print message and stop.
   99 CALL PSTRG(14H**  Read from , -14)
      IF (IN.EQ.MIN) CALL PSTRG(6Hsource, -6)
      IF (IN.EQ.SIN) CALL PSTRG(9Hsecondary, -9)
      CALL PSTRG(21H failed.  FMGR error ,  -21)
      CALL PNUM(ERROR)
      CALL NEWLN
      CALL EXEC(6)
      END
      SUBROUTINE OUTLN(BUFFER, SIZE)
C
C     Write the line in  BUFFER  to the output file.  SIZE gives the
C     number of characters to be output.
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      COMMON /FILIO/ MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      INTEGER        MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      DIMENSION      MITAB(10),  MIDCB(272),
     +               SITAB(10),  SIDCB(144),
     +               MOTAB(10),  MODCB(272) 
      DIMENSION      SONAME(3)
      INTEGER        BUFFER, SIZE 
      DIMENSION      BUFFER(128)
      INTEGER        ERROR,  ISIZE
C 
C     Null output ? 
      IF (OUT.EQ.0) RETURN
      ISIZE = SIZE
C 
C ***   A requirement of the HP RTE-IV File Manager is that there must
C ***   be an even number of characters to each record (line) in a file.
C ***   Here we add an extra space to the end of any odd length lines.
C ***   Note that  BUFFER  is equivalent to  A(n)  in the file buffer.
C ***   Therefore this space is overwritting the newline character at 
C ***   the end this line in the file buffer.  This will not matter as
C ***   long as the start of the next line has been marked with a 
C ***   pointer.  See the  PLINE  routine.
      IF (IAND(ISIZE, 1).EQ.0) GOTO 10
         CALL SBYTE(BUFFER, ISIZE, KSPACE)
         ISIZE = ISIZE+1
   10 CONTINUE
C 
C ***   There must be no blank lines in an File Manager file.  Here we
C ***   substitute two spaces for zero length lines.
C ***   These two spaces cannot be appended to the  BUFFER  as the latter 
C ***   will overwrite the first character of the next line in the file 
C ***   buffer.  We use a seperate call to  WRITF  for this case. 
      IF (ISIZE.GT.0) GOTO 20 
         CALL WRITF(MODCB, ERROR, 2H  , 1)
      GOTO 30 
   20 CONTINUE
         CALL WRITF(MODCB, ERROR, BUFFER, ISIZE/2)
   30 CONTINUE
C 
C     Check for errors. 
      IF (ERROR.GE.0) RETURN
C 
C     Disc write failed ... print error message and stop. 
      CALL PSTRG(44H** Write to output file failed.  FMGR error , -44)
      CALL PNUM(ERROR)
      CALL NEWLN
      CALL EXEC(6)
      END 
      SUBROUTINE CLSFI
C 
C     Close input and output streams (if open). 
C 
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      COMMON /FILIO/ MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      INTEGER        MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      DIMENSION      MITAB(10),  MIDCB(272),
     +               SITAB(10),  SIDCB(144),
     +               MOTAB(10),  MODCB(272) 
      DIMENSION      SONAME(3)
      INTEGER        MONAME, MOPARM, MOSECU, MOCART 
      DIMENSION      MONAME(3)
      EQUIVALENCE    (MONAME, MOTAB(1)),  (MOPARM, MOTAB(4)), 
     +               (MOSECU, MOTAB(5)),  (MOCART, MOTAB(6))
      INTEGER        ERROR
      IF (MIN.NE.0) CALL CLOSE(MIDCB) 
      IF (SIN.NE.0) CALL CLOSE(SIDCB) 
      IF (OUT.EQ.0) RETURN
      IF (OUT.EQ.1) GOTO 100
C 
C     Normal close.  Rename the scratch file to the required output file
C     name.  Purge any previously existing copy of this file. 
         CALL PURGE(MIDCB, ERROR, MONAME, MOSECU, MOCART) 
         IF (ERROR.LT.0 .AND. ERROR.NE.-6) GOTO 99
         CALL NAMF(MODCB, ERROR, SONAME, MONAME, MOSECU, MOCART)
         IF (ERROR.GE.0) RETURN 
C 
C     Some error occured ...
   99 CALL PSTRG(41H** Cannot close output file.  FMGR error , -41) 
      CALL PNUM(ERROR)
      CALL NEWLN
C 
C     Abort close.  Leave the editing in the scratch file.
  100 CALL CLOSE(MODCB) 
      CALL PSTRG(33H** Editing left in scratch file ', -33) 
      CALL PSTRG(SONAME, -6)
      CALL PSTRG(2H'., -2)
      CALL NEWLN
      RETURN
      END 
      BLOCK DATA EDATA
C 
C ***   This block data subprogram is required by HP FTN4 to reserve area 
C ***   form the named common blocks. 
C ***   The block data subprogram containing the file buffer and pointers 
C ***   resides along with the file buffer access routines below. 
C 
      COMMON /CECCE/ SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      INTEGER        SYM,    PEND,   SYMTYP, TYPE,   CODE,   TEXT,
     +               NUM,            CHAIN,  PP1,    MON,    CASE,
     +               STOP,   PRINT1, PRINT2, LINMAX 
      DIMENSION      SYMTYP(63) 
C 
      COMMON /COMMD/ C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      INTEGER        C,      CIBASE, TIBASE, CI,     TI,     CMAX 
      DIMENSION      C(128) 
C 
      COMMON /MACRO/ STORED, POS1,   POS2,   POS3 
      INTEGER        STORED, POS1,   POS2,   POS3 
      DIMENSION      STORED(192)
C 
      COMMON /SINPR/ SEXTRA, SINPUT, SINTOP, SFP,    SECFP,  SEND,
     +               MFP,    MLEND,  MEND,   MARKER 
      INTEGER        SEXTRA,         SINTOP, SFP,    SECFP,  SEND,
     +               MFP,    MLEND,  MEND,   MARKER 
      LOGICAL        SINPUT 
C 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
C 
      COMMON /IOCHN/ TTY,    IN,     MIN,    SIN,    OUT
      INTEGER        TTY,    IN,     MIN,    SIN,    OUT
C 
      COMMON /TTYIO/ ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      INTEGER        ILINE,  ILINEP, ILINEM, PRSTR,  PRLEN, 
     +               OLINE,  OLINEP, OLINEM 
      DIMENSION      ILINE(128), OLINE(138), PRSTR(2) 
C 
      COMMON /FILIO/ MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      INTEGER        MITAB,  MIDCB,  SITAB,  SIDCB,  MOTAB,  MODCB, 
     +               SONAME 
      DIMENSION      MITAB(10),  MIDCB(272),
     +               SITAB(10),  SIDCB(144),
     +               MOTAB(10),  MODCB(272) 
      DIMENSION      SONAME(3)
C 
C 
C 
C 
C     1. Looping limit and maximum line length:-
      DATA STOP   /-1000/ 
      DATA LINMAX   /256/ 
C 
C     2. Input-output stream constants:-
      DATA TTY        /1/ 
      DATA MIN        /0/ 
      DATA SIN        /0/ 
      DATA IN         /0/ 
      DATA OUT        /0/ 
C 
C     3. Commands:- 
      DATA CIBASE     /1/ 
      DATA TIBASE   /128/ 
C 
C     4. Command type table:- 
C 
C           !   "   #   $   %   &   '   (   )   *   +   ,   -   .   / 
C       0   1   2   3   4   5   6   7   8   9   :   ;   <   =   >   ? 
C       @   A   B   C   D   E   F   G   H   I   J   K   L   M   N   O 
C       P   Q   R   S   T   U   V   W   X   Y   Z   [   \   ]   ^   _ 
C 
      DATA SYMTYP/
     +     64,  3,  3,  3,  2,  3,  3, 75, 73, 64,  3, 76,  2,  3,  3,
     +  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  1,  3,  3,  3, 64,
     +  3,218, 10, 18,  5,  8,116, 10,  2,  6, 10, 10, 58,120,250,  2,
     + 74, 50, 10, 22, 85, 53,  6,  2, 32, 32, 32,  3, 74,  3,  3,  3/
  
C        (octal values) 
C         100,  3,  3,  3,  2,  3,  3,113,111,100,  3,114,  2,  3,  3,
C       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  1,  3,  3,  3,100,
C       3,332, 12, 22,  5, 10,164, 12,  2,  6, 12, 12, 72,170,372,  2,
C     112, 62, 12, 26,125, 65,  6,  2, 40, 40, 40,  3,112,  3,  3,  3 
C 
C        (meaning of bit positions) 
C     7 (200) = Secondary input specific commands.
C     6 (100) = Secondary input permissable commands. 
C     5 ( 40) = A special '%' command.
C     4 ( 20) = A special '%' command.
C     3 ( 10) = 
C     2 (  4) = 
C     1 (  2) = 
C     0 (  1) = 
C 
C 
C     5. ASCII character set:-
      DATA KNL   /10/, KFF   /12/,
     +     KSPACE/32/, KXCLAM/33/, KDQUOT/34/, KHASH /35/, KDOLLR/36/,
     +     KPCENT/37/, KAND  /38/, KQUOTE/39/, KLPAR /40/, KRPAR /41/,
     +     KSTAR /42/, KPLUS /43/, KCOMMA/44/, KMINUS/45/, KDOT  /46/,
     +     KSLASH/47/, K0    /48/, K1    /49/, K2    /50/, K3    /51/,
     +     K4    /52/, K5    /53/, K6    /54/, K7    /55/, K8    /56/,
     +     K9    /57/, KCOLON/58/, KSEMIC/59/, KLT   /60/, KEQ   /61/,
     +     KGT   /62/, KQUEST/63/, KAT   /64/, KA    /65/, KB    /66/,
     +     KC    /67/, KD    /68/, KE    /69/, KF    /70/, KG    /71/,
     +     KH    /72/, KI    /73/, KJ    /74/, KK    /75/, KL    /76/,
     +     KM    /77/, KN    /78/, KO    /79/, KP    /80/, KQ    /81/,
     +     KR    /82/, KS    /83/, KT    /84/, KU    /85/, KV    /86/,
     +     KW    /87/, KX    /88/, KY    /89/, KZ    /90/, KLBRAC/91/,
     +     KBACKS/92/, KRBRAC/93/, KUPARR/94/, KSUB  /95/,
     +     KGRAV /96/, KLA   /97/, KLZ  /122/ 
C 
C 
      END 
C 
C 
C ************************************************************************* 
C ***                                                                   *** 
C ***       F I L E   B U F F E R   A C C E S S   R O U T I N E S       *** 
C ***                                                                   *** 
C ************************************************************************* 
C 
C 
C     Access to the characters in the file buffer should be as efficient
C     as possible.  It is strongly recommended that the following routines
C     should be machine coded.
C 
C 
      SUBROUTINE BINIT
C 
C     Initialise the file buffer pointers.  Here the pointers are byte
C     indexes into the file buffer array  A .  If these following 
C     routines are machine coded then it might be worth converting the
C     pointer to physical byte addresses.  All buffer accesses are done 
C     via these routines and so this change will be transparent to the
C     code above this point.
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      TOP = 2*BYTES 
      BOT = BUFLEN*BYTES-1
      FBEG = TOP
      PP = FBEG-1 
      CALL PUTPP(KNL) 
      LBEG = PP 
      FP = BOT
      LEND = FP 
      FEND = LEND 
      RETURN
      END 
      SUBROUTINE RSTAR
C 
C     Move down the file buffer until a newline character is reached. 
C     This routine is implementation transparent but is included here 
C     as it will benifit from machine coding. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
   10 CONTINUE
         IF (FP.EQ.LEND) RETURN 
         CALL RIGHT 
      GOTO 10 
      END 
      SUBROUTINE RIGHT
C 
C     Move down one character in the file buffer, ignoring any newline
C     character.  This routine is implementation transparent but is 
C     included here as it will benifit from machine coding. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      CALL PUTPP(JGET(FP))
      FP = FP+1 
      RETURN
      END 
      SUBROUTINE LSTAR
C 
C     Move back up the file buffer until a newline character is reached.
C     Once again this routine will benifit from machine coding. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
   10 CONTINUE
         IF (PP.EQ.LBEG) RETURN 
         CALL LEFT
      GOTO 10 
      END 
      SUBROUTINE LEFT 
C 
C     Move back one character in the file buffer.  Once again this
C     routine will benifit from machine coding. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      PP = PP-1 
      CALL PUTFP(JGET(PP))
      RETURN
      END 
      INTEGER FUNCTION JGET(IP) 
C 
C     This is essentially a mapping function into the buffer, the index 
C     (or byte address) being  IP . 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      INTEGER        IP 
      JGET = LBYTE(A, IP) 
      RETURN
      END 
      SUBROUTINE PUTPP(ICHAR) 
C 
C     Another mapping routine to store the character ICHAR in the file
C     buffer at  PP  pointer.  PP  is post incremented. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        ICHAR
      CALL SBYTE(A, PP, ICHAR)
      PP = PP+1 
      RETURN
      END 
      SUBROUTINE PUTFP(ICHAR) 
C 
C     Another mapping routine to store the character  ICHAR  is the file
C     buffer at the  FP  pointer.  FP is pre-decremented. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      FP = FP-1 
      CALL SBYTE(A, FP, ICHAR)
      RETURN
      END 
      SUBROUTINE JMOVE(IPTO, IPFROM, ILEN)
C 
C     Move bytes within the file buffer.  ILEN bytes are transfered from
C     the position indexed by  IPFROM  to the position indexed by IPTO. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      INTEGER        IPTO,   IPFROM, ILEN 
      INTEGER        I,      P1,     P2 
      IF (ILEN.LE.0) RETURN 
      P1 = IPTO 
      P2 = IPFROM 
      DO 10 I = 1, ILEN 
         CALL SBYTE(A, P1, LBYTE(A, P2))
         P1 = P1+1
         P2 = P2+1
   10 CONTINUE
      RETURN
      END 
      INTEGER FUNCTION JFIND(IP, ICHAR) 
C 
C     Search for the character  ICHAR  in the file buffer, starting at
C     the position indexed by the pointer  IP .  The scan terminates
C     when the character has been found or a newline is reached.  This
C     function returns as its result the point where the scan finished. 
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
      COMMON /KSYMS/ KNL,    KFF, 
     +               KSPACE, KXCLAM, KDQUOT, KHASH,  KDOLLR, KPCENT,
     +               KAND,   KQUOTE, KLPAR,  KRPAR,  KSTAR,  KPLUS, 
     +               KCOMMA, KMINUS, KDOT,   KSLASH, K0,     K1,
     +               K2,     K3,     K4,     K5,     K6,     K7,
     +               K8,     K9,     KCOLON, KSEMIC, KLT,    KEQ, 
     +               KGT,    KQUEST, KAT,    KA,     KB,     KC,
     +               KD,     KE,     KF,     KG,     KH,     KI,
     +               KJ,     KK,     KL,     KM,     KN,     KO,
     +               KP,     KQ,     KR,     KS,     KT,     KU,
     +               KV,     KW,     KX,     KY,     KZ,     KLBRAC,
     +               KBACKS, KRBRAC, KUPARR, KSUB,
     +               KGRAV,  KLA,    KLZ
      INTEGER        IP,     ICHAR
      INTEGER        P1 
      P1 = IP 
   10 CONTINUE
         K = LBYTE(A, P1) 
         IF (K.EQ.ICHAR .OR. K.EQ.KNL) GOTO 20
         P1 = P1+1
         GOTO 10
   20 CONTINUE
      JFIND = P1
      RETURN
      END 
      BLOCK DATA BDATA
C 
C     This block data subprogram includes the file buffer and pointers. 
C     This data area should reside with the file buffer access routines 
C     if they are machine coded.
C 
      COMMON /BUFF/  A
      INTEGER        A
      DIMENSION      A(10000) 
C 
      COMMON /BUFPR/ TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
      INTEGER        TOP,    FBEG,   LBEG,   PP,     FP,     LEND,
     +               FEND,   BOT,    MS,     ML,     BUFLEN, BYTES
C 
C 
      DATA BUFLEN /10000/ 
      DATA BYTES      /2/ 
C 
C 
      END 
C 
C 
C 
C     G E N E R A L   B Y T E   A C C E S S   R O U T I N E S . 
C 
C 
      INTEGER FUNCTION LBYTE(IARRAY, IBDISP)
C 
C     This function returns the byte displaced by IBDISP from the start 
C     of the array IARRAY.  The high order byte of IARRAY(1) is byte
C     zero.  This routine assumes a 16-bit machine word and that each 
C     byte is as ASCII character (top bit clear). 
C 
      INTEGER        IARRAY, IBDISP 
      DIMENSION      IARRAY(128)
      INTEGER        K
      K = IARRAY(1+IBDISP/2)
      IF (IAND(IBDISP, 1).EQ.1) GOTO 10 
         LBYTE = ISHFT(K, -8) 
         RETURN 
   10 CONTINUE
         LBYTE = IAND(K, 377B)
         RETURN 
      END 
      SUBROUTINE SBYTE(IARRAY, IBDISP, ICHAR) 
C 
C     Store the byte  ICHAR  at a displacement  IBDISP  from the start
C     of the array  IARRAY .  The high order byte of  IARRAY(1)  is byte
C     zero.  This routine assumes a 16-bit machine word and that each 
C     byte is an ASCII character (top bit clear). 
C 
      INTEGER        IARRAY, IBDISP, ICHAR
      DIMENSION      IARRAY(128)
      INTEGER        I
      I = 1+IBDISP/2
      IF (IAND(IBDISP, 1).EQ.1) GOTO 10 
         IARRAY(I) = IAND(IARRAY(I), 177B)+ISHFT(ICHAR, 8)
         RETURN 
   10 CONTINUE
         IARRAY(I) = IAND(IARRAY(I), 77400B)+IAND(ICHAR, 177B)
         RETURN 
      END 
