         TITLE    'FUNDEF-B00,08/22/73,DWG702985'
         SYSTEM   SIG7F
         CSECT    1
         PCC      0                 CONTROL CARDS NOT PRINTED.
FUNDEF@  RES      0                 ORIGIN OF FUNCTION DEFINITION MODULE
*
*  REF'S  AND  DEF'S
*
         DEF      FUNDEF@                 = START OF FUNDEF MODULE.
         DEF      DELCK             ENTERED FROM CODESTRINGER WHEN IT
*                                     ACQUIRES A DEL OR LOCKED-DEL.
         DEF      FIHANDLR          FUNCTION-INPUT HANDLER.
         DEF      REPROMPT          RE-PROMPTS WITH LATEST LINE NUMBER.
         DEF      MERGECOL          WHEN CALLING 'SHOWFL', MERGECOL IS
*                                     SET TO AN EDIT-DIRECTIVE COLUMN-
*                                     VALUE OR NEGATIVE IF NOT AN EDIT.
*                                     WHEN CALLING 'INP4MERG', MERGECOL
*                                     IS 1 LESS THAN THE 1ST COLUMN AT
*                                     WHICH MERGING BEGINS.
         DEF      VISIMAGE          BUFFER TO HOLD VISUAL IMAGE OF A
*                                     LINE TO BE EDITED.
         DEF      FERASECK          CKS FOR AN ERASE OF CURRENT OPEN FN.
         DEF      FORCLOSE          FORCES A CLOSE OF THE OPEN FUNCTION.
         DEF      USEBADFL          USE FUNC.LINE CODESTRING EVEN THOUGH
*                                     IT ENDS ON A LINE-SCAN ERROR.
         DEF      RFSIDAM           RESUME AFTER SI DAMAGE DISPLAY.
         DEF      RFUNDEF           RESUME AFTER ERRFDWS,ERRFDSYM,SHOWFL
 SPACE 3
*                               REFS TO PROCEDURE:
         REF      ACQNXCC           ACQ NEXT CHAR & ITS CODE.
         REF      ACQNXNB           ACQ NEXT NON-BLANK & IS CODE.
         REF      ACQNB             ACQ NON-BLANK & ITS CODE.
         REF      ACQNAME           ACQ A NAME.
         REF      CSN               START CODESTRINGING AT N-TH CHAR.
         REF      CSZ               FINISH CURRENT CODESTRING.
         REF      ERLSCAN           ENTER CODESTRINGER FOR LINE-SCAN ERR
         REF      DREF              DE-REFERENCE A DATA BLOCK.
         REF      MAYDREF           DE-REF. DATA BLK IF DB PTR IS NZ.
         REF      ALOCNONX          ALLOCS. DATA BLK FOR NEW FUNCTION
*                                     DESCRIPTOR & FOR ANY LABEL DATA
*                                     BLKS THAT WILL BE NEEDED.
         REF      CTEST             ATTEMPTS TO GET MORE EXEC. STACK.
         REF      GENCHAR           PUTS CHAR OR ITS EQUIV. IN IMAGE BUF
         REF      GENNAME           PUTS (VISUAL) NAME IN IMAGE BUFFER.
         REF      SHOWFL            DISPLAYS IMAGE AFTER DE-CODESTRING,
*                                     IF NECESSARY.
         REF      INPF              PROMPTS & REQUESTS FUNCTION INPUT.
         REF      INP4MERG          DISPLAYS EDITED LINE FOR MERGING.
         REF      CMDEXIT           EXITS ACCORDING TO MODE & ERR-COND. U15-0004
         REF      SIDR              ASKS FOR 'GO' RESPONSE WHEN
*                                     SI DAMAGE WILL OCCUR.
         REF      SIDAMF            DISPLAYS -- SI DAMAGE -- IN FUNDEF.
         REF      ERRFDWS           DISPLAYS -- WS FULL -- DUE TO FUNDEF
         REF      ERRFDSYM          DISPLAYS -- SYMBOL TABLE FULL.
         REF      ERRDEFN           DISPLAYS -- DEFN ERROR.
*                               REFS TO CONTEXT:
         REF      FDBLOCK           FUNCTION DEFINITION FIXED CONTEXT
         REF      FDTEMPS           FUNCTION DEFINITION TEMP AREA.
         REF      ERRORID           SET NZ IF ERROR DETECTED.
         REF      OLDMODE           MODE WHEN THE FUNC OPEN OCCURRED:   U15-0007
*                                     1 = DIRECT INPUT MODE.            U15-0008
*                                     2 = EVALUATED INPUT MODE.         U15-0009
*                                     2 + E-FLAG = 'EXECUTE' MODE.      U15-0010
*                                                                       U15-0011
         REF      MODE              MODE OF EXECUTION:
*                                     0 = FUNCTION DEFINITION MODE.
*                                     1 = DIRECT INPUT MODE.
*                                     2 = EVALUATED INPUT MODE.
*                                     NEGATIVE = FORCED CLOSE MODE.
         REF      IMAGE             BUFFER FOR INPUT & PROMPTS.
         REF      IMAGES            = # LINES USED TO PERFORM A DISPLAY.
         REF      INBUF             USED AS BUILD-BUFFER DURING EDIT.
         REF      EDITCK            = NZ IF 'DELETE SEQUENCE' INDICATED.
         REF      CURRCS            PTS AT OFFSET WD OF CURRENT CODESTRG
         REF      FDEFPTR           PTS AT 'OLD' FUNCTION DESCRIPTOR IF
*                                     A RE-OPEN OCCURS & IS NOT WIPED
*                                     OUT BY CHANGING THE NEW HEADER.
         REF      RESULT            PTS AT NEW FUNCTION DESCRIPTOR.
         REF      TOPOSTAK          CURRENT TOP OF EXECUTION STACK.
         REF      STATEPTR          TOP STATE-ENTRY IN EXECUTION STACK.
         REF      STKLIMIT          CURRENT LIMIT FOR EXECUTION STACK.
         REF      LOCNEED           NEW STACK LOC NEEDED WHEN OVER LIMIT
         REF      SYMT              PTS AT 1ST WD OF SYMBOL TABLE
         REF      CONSTBUF          BUFFER USED TO HOLD NAME PTRS GIVEN
*                                     VIA AN )ERASE COMMAND.
         REF      OPENFN            FUNC. NAME PTR AT FORCED CLOSE.
         REF      BREAKFLG          = NEG. IF AUTOMATIC CONTINUE CAUSES
*                                     A FORCED CLOSE.
*                               REFS TO CONSTANTS:
         REF      XFFFF             = X'FFFF'
         REF      X1FFFF            = X'1FFFF'
         REF      BLANKS            WD OF BLANKS.
         REF      ZEROZERO          DBLWD OF ZERO.
         REF      FUNTYPES          RANGE OF FUNCTION TYPES.
         REF      BITPOS            32-WD TBL OF BITS (BITPOS-K CONTAINS
*                                     A WD HAVING A 1 ONLY IN BIT POS K)
BLOC     SET      0                *************************************
BLOCK    CNAME                     *                                   *
         PROC                      *  PROC TO 'ALLOCATE' IN FDBLOCK.   *
LF       EQU      FDBLOCK+BLOC     *                                   *
BLOC     SET      BLOC+AF(1)       *                                   *
         PEND                      *************************************
SAVEDEL  BLOCK    1                 SAVE OPENING DEL.
SAVECDEL BLOCK    1                 SAVE CLOSING DEL.
FUNSAVE  BLOCK    3                 SAVE REGS.
GLOBLOC  BLOCK    1                 LOC.OF GLOBAL REF TO RE-OPENED FUN.
LINKFD   BLOCK    1                 LINK FOR USE IN FUNCTION DEFN MODE.
HILINE   BLOCK    1                 PTS AT HI BOUNDARY LINE-CHAIN ENTRY.
LINVAL   BLOCK    1                 CURRENT LINE VALUE.
FBLK     BLOCK    5                 FUNCTION NAME PTRS BLOCK + 1.
NFL      EQU      FBLK+4            HOLDS NO.OF FUNC.LINES FOR NEW FUNC.
*                             NOTE--  THE NLCLS & NLBLS WD MUST BE THE
*                                     NEXT WD AFTER NFL.
NLCLS    BLOCK    1                 HI HALF HOLDS # LOCALS FOR NEW FUNC.
NLBLS    EQU      NLCLS             LO HALF HOLDS # LABELS FOR NEW FUNC.
LOCALS   BLOCK    32                MAX.POSS. # LOCAL NAME PTRS @ 2/WD.
 SPACE 2
TLOC     SET      0                *************************************
TEMP     CNAME                     *                                   *
         PROC                      *  PROC TO 'ALLOCATE' IN FDTEMPS.   *
LF       EQU      FDTEMPS+TLOC     *  (FDTEMPS IS ON A DBLWD BOUND)    *
TLOC     SET      TLOC+AF(1)       *                                   *
         PEND                      *************************************
*
*  TEMPS WHILE OPENING:
*
NAMECNT  TEMP     1                 NAME COUNTER.
TFBLK    TEMP     4                 TEMP FUNCTION NAME PTRS BLOCK.
TNLCLS   TEMP     1                 TEMP NO.OF LOCALS FOR NEW HDR.
TLOCALS  TEMP     32                HOLDS TEMP LOCAL NAME PTRS (HALFWDS)
*
*  TEMPS FOR DIRECTIVE HANDLING:
*
TLOC     SET      0                 (OVERLAY OPENING TEMPS)
LINKHIRE TEMP     2                 DBLWD TO HOLD LINKAGE VALUES.
MERGECOL TEMP     1                 FLAG & COLUMN INDICATOR FOR EDIT.
STARTLV  TEMP     1                 HOLDS 1ST LINE VALUE ON A DISPLAY-N.
VISIMAGE TEMP     33                VISUAL IMAGE FOR EDITING.
*
*  TEMPS FOR CLOSING:
*
TLOC     SET      0                 (OVERLAY DIRECTIVE HANDLING TEMPS)
NEWFTYPE TEMP     1                 HOLDS NEW FUNCTION'S TYPE.
XREFLOC  TEMP     1                 LOC FOR REF-EXCHANGE PROCEDURE.
 PAGE
*
*  STANDARD EQU'S
*                   REGISTERS
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
*  EBCDIC CHARACTERS
*
NEWLINE  EQU      X'15'             END-OF-STMT.
QUAD     EQU      X'53'             QUAD.
DEL      EQU      X'7F'             DEL.
LBRACKET EQU      X'B4'             LEFT BRACKET.
RBRACKET EQU      X'B5'             RIGHT BRACKET.
LFARROW  EQU      X'FD'             LEFT ARROW.
*
*  CODESTRING VALUES:
*
NAMECODE EQU      23                ORDINARY NAME.
BOSCODE  EQU      37                BEGINNING-OF-STMT.
LASTCSV  EQU      138               LAST CODESTRING VALUE.
*
*  OFFSETS IN FUNCTION DESCRIPTOR:
*
XSIZOFF  EQU      2                 EXECUTION STACK SIZE.
RESOFF   EQU      XSIZOFF+1         RESULT NAME PTR.
FBLKSIZE EQU      4                 (4 NAME PTRS IN A FUNCTION BLOCK)
FNOFF    EQU      RESOFF+2          FUNCTION NAME PTR.
NFLOFF   EQU      RESOFF+FBLKSIZE   NO.OF FUNCTION LINES.
*
*  OTHER EQU'S
*
CATLC    EQU      11                LINE-CHAIN CATEGORY OF EXEC.STACK.
EFLAG    EQU      X'10000'          INDICATES 'EXECUTE' MODE.           U15-0014
LOCKFLAG EQU      X'10000'          LOCKED-FUNCTION FLAG.
PENDFLAG EQU      X'8000'           PENDENT STATE-ENTRY FLAG.
NFLAG    EQU      X'20000'          NON-ASSIGNABLE FLAG FOR LABEL
*                                     REFERENT INDICATORS.
STDFDSIZ EQU FBLKSIZE+3  STANDARD FUNCTION DESCRIPTOR SIZE (MINIMUM),
*                        COVERS 4-WD FUNCTION BLK + XSIZE WD + NFL WD +
*                        LOCALS & LABELS COUNT WD.
*
*  DOUBLEWORD CONSTANTS:
*
DELDEL   DATA     129,130           CODESTRING VALUES FOR DEL & LOCK DEL
*
*  CONSTANTS:
*
LCENTRY  DATA     CATLC**24         'DEAD' (SO FAR) LINE-CHAIN CATEGORY.
MAXLINV  DATA     X'9999999'        MAX LINE VALUE = 9999.999.
LBLDBHDR DATA     X'03000004'       LABEL'S DATA BLK HDR --
*                                     INTEGER,SCALAR OF SIZE 4-WDS.
 PAGE
************************************************************************
*                                                                      *
*  HNAMEX -- ENTRY FOR HNAME THAT ACQUIRES THE NEXT NON-BLANK.         *
*  HNAME -- ACQUIRES NAMES FOR A FUNCTION HEADER.                      *
*        REGS:   R7 -- LINK.  EXIT DEPENDS ON NON-BLANK AFTER THE NAME:*
*                               0,R7-- NEWLINE, DEL, OR LOCKED DEL.    *
*                               1,R7-- OTHER (E.G. ANOTHER NAME, ETC.).*
*                               2,R7-- SEMICOLON.                      *
*                R1 -- (ENTRY) PTS AT NON-BLANK CHAR, SHOULD START NAME*
*                      (EXIT) PTS AT NON-BLANK CHAR AFTER THE NAME.    *
*                R2 -- (ENTRY) THE CHAR. HOPEFULLY STARTING A NAME.    *
*                      (EXIT) THE CHAR AFTER THE NAME (NON-BLANK).     *
*                R3 -- (ENTRY) CODE FOR START CHAR.                    *
*                      (EXIT) CODE FOR TERMINATING CHAR.               *
*                R4,R12,R13 ARE VOLATILE, BUT SEE ALSO 'ACQNAME'.      *
*                                                                      *
HNAMEX   BAL,R4   ACQNXNB           ACQ. NEXT NON-BLANK.
HNAME    STW,R7   LINKFD            SAVE LINK.
         CI,R3    LASTCSV           CK FOR NAME-START CODE...
         BLE      ERDEFN              NO -- DEFN ERROR.
         BAL,R12  ACQNAME             YES, ACQUIRE THE NAME.
         B        SYMFULL           (SYM TBL FULL RETURN)
         B        WSFULL            (WS FULL RETURN, DUE TO LONG NAME)
         AI,R13   -NAMECODE         CK FOR ORDINARY NAME...
         BNEZ     ERDEFN              STOP OR TRACE NAME -- DEFN ERROR.
         LW,R7    LINKFD            RESTORE LINK.
         CI,R2    ';'
         BE       2,R7                SEMICOLON EXIT.
         CI,R2    NEWLINE
         BE       0,R7                NEW LINE EXIT.
         CLM,R3   DELDEL
         BCS,9    1,R7                OTHER EXIT.
         B        0,R7                DEL OR LOCKED DEL EXIT.
 PAGE
************************************************************************
*                                                                      *
*  RAISE3 -- RAISE EXECUTION STACK BY 3 WORDS.                         *
*        REGS:   R10 -- LINK, EXIT VIA *R10.                           *
*                R1  -- (EXIT) PTS AT NEW TOP OF STACK.                *
*                R8 IS VOLATILE.                                       *
*                                                                      *
RAISE3   LW,R1    TOPOSTAK          PT AT CURRENT TOP OF STACK.
         AI,R1    -3                RAISE IT 3 WDS.
         CW,R1    STKLIMIT          DOES THIS HIT STACK LIMIT...
         BG       RAISED              NO, OK.
         STW,R1   LOCNEED             YES, SAVE LOCATION NEEDED.
         AI,R1    3                 RESTORE STACK PTR IN CASE WS FULL   U15-0016
         BAL,R8   CTEST             GET MORE COMMON, IF POSSIBLE.
         B        WSFULL              NO LUCK -- WS FULL.
RAISED   STW,R1   TOPOSTAK          PT AT NEW TOP OF STACK.
         B       *R10               EXIT.
 PAGE
************************************************************************
*                                                                      *
*  INITLC --  INITIALIZES THE LINE-CHAIN, SETTING 'HILINE'.            *
*       REGS:    R14 -- LINK, EXIT VIA *R14.                           *
*                R10,R11,R12,R13 ARE VOLATILE.                         *
*                                                                      *
INITLC   BAL,R10  RAISE3            RAISE STACK 3 WDS.
         LW,R11   LCENTRY           = EMPTY LINE-CHAIN CATEGORY.
         LI,R12   X'FFFD'           = HALFWD OF MINUS 3 (TO 0 ENTRY).
         LW,R13   BITPOS-3          LINE-VALUE BOUND ( > MAXLINV).
         LCI      3
         STM,R11  0,R1              SET HI BOUNDARY OF LINE-CHAIN.
         STW,R1   HILINE            SET PTR TO HI LINE-CHAIN ENTRY.
         BAL,R10  RAISE3
         LD,R12   ZEROZERO          0 OFFSET, 0 LINE-VALUE.
         LCI      3
         STM,R11  0,R1              SET LO BOUNDARY OF LINE-CHAIN.
         B       *R14               EXIT
 PAGE
************************************************************************
*                                                                      *
*  GFNREF -- FINDS REFERENT PTR (GLOBAL) FOR FUNCTION NAME.            *
*       REGS:    R14 -- LINK, EXIT VIA *R14                            *
*                R6  -- (ENTRY) NAME PTR FOR FUNCTION NAME.            *
*                R4  -- (EXIT) REFERENT PTR (POSSIBLY ZERO),(COND.CODE)*
*                R5  -- (EXIT) ADDRESS MASK X'1FFFF'.                  *
*                R7  -- (EXIT) LOC OF GLOBAL REFERENCE FOR NAME GIVEN.
*                R13 IS VOLATILE.
*                                                                      *
GFNREF   LI,R5    X'1FFFF'
         LI,R4    0
         LW,R7    SYMT              PT AT SYM TBL ENTRY FOR THIS NAME.
         AW,R7    R6
         LW,R13   0,R7              TEST FOR GLOBAL REF IN SYM TBL...
         BGEZ     GFNSHAD             NO, IT IS SHADOWED.
GFNREFOK LS,R4    0,R7                YES, EXTRACT REFERENT PTR.
         B       *R14               EXIT WITH THAT CONDITION CODE.
GFNSHAD  LW,R7    TOPOSTAK          PT AT TOP OF EXECUTION STACK.
GFNSHADT AI,R7    1                 PT AT NEXT ENTRY.
         LW,R13   0,R7              LOOK FOR G-BIT THAT IS ON...
         BGEZ     GFNSHADT            NO.
         CW,R6    -1,R7               YES, LOOK BACK AT ITS NAME PTR...
         BNE      GFNSHADT                    WRONG NAME, TRY AGAIN.
         B        GFNREFOK                    BINGO.
 PAGE
************************************************************************
*                                                                      *
*  LCSEARCH -- SEARCHES THE LINE-CHAIN UNTIL IT FINDS THE GIVEN LINE   *
*        VALUE OR THE NEXT LOWEST LINE VALUE IN THE CHAIN.             *
*        REGS:   R5 -- LINK; EXIT VIA 0,R5 IF NO MATCH                 *
*                                     1,R5 IF MATCH.                   *
*                R12-- (ENTRY) LINE VALUE TO SEARCH FOR.               *
*                R7 -- (EXIT) LOC OF CHAIN ENTRY REACHED.              *
*                R6 -- (EXIT) WD OFFSET FROM PRIOR (HIGHER LINE VALUE) *
*                             CHAIN ENTRY.                             *
*                R2 -- (EXIT) = 3, I.E. THE HALFWORD ADD-ON NEEDED TO  *
*                                  FIND THE CHAIN VALUE WITHIN A       *
*                                  LINE-CHAIN ENTRY.                   *
*                NO REGS ARE VOLATILE.                                 *
*                                                                      *
LCSEARCH LI,R2    3
         LW,R7    HILINE            PT AT MAX+ LINE-CHAIN ENTRY.
LOW      LH,R6   *R7,R2             GET OFFSET TO NEXT LOWER LC ENTRY.
         AW,R7    R6                PT AT THAT ENTRY.
         CW,R12   2,R7              CK FOR MATCHING LINE VALUE...
         BL       LOW                 GIVEN LINE VALUE LOWER THAN THIS.
         BE       1,R5                MATCH.
         BG       0,R5                NO MATCH, BUT STOP SEARCH; WE'VE
*                                       FOUND A LINE VALUE LOWER THAN
*                                       THE GIVEN ONE.
 PAGE
************************************************************************
*                                                                      *
* NXTFLINE -- CALCULATES THE NEXT FUNCTION LINE VALUE (FOR PROMPTING). *
*        REGS:   R12-- LINK, EXIT VIA *R12.                            *
*                R6 -- (EXIT) CONTAINS THE NEW LINE VALUE.             *
*                R3,R4,&R7 ARE VOLATILE.                               *
*                                                                      *
NXTFLINE LW,R6    LINVAL            GET OLD LINE VALUE.
         LI,R4    4                 = # HEX DIGITS FROM RT. TO 1'S POS.
         LI,R3    0                 R3 IS A SHIFT COUNTER.
CARRY    LI,R7    0                 CLEAR R7 FOR NEXT SHIFT.
DTAIL    AI,R3    4                 ACCUM SHIFT COUNT.
         SLD,R6   -4                SHIFT TRAILING DIGIT INTO TOP OF R7.
         AI,R7    0                 TEST FOR ZERO...
         BNEZ     INCR                NO, INCREMENT AT THAT POSITION.
         BDR,R4   DTAIL               YES, SKIP TAILING ZEROS.
INCR     AW,R7    BITPOS-3          BUMP THE HEX DIGIT.
         LB,R4    R7                TEST FOR BUMPED TO 10, AND IF SO
         AI,R4    X'FFF60'            CLEAR R4 TO AVOID ANY MORE SKIPS.
         BEZ      CARRY             YES, CLEAR AND INCREMENT NEXT POS.
         SLD,R6   0,R3              NO, DE-SHIFT.
         CW,R6    MAXLINV           PERCHANCE CARRIED INTO LFMOST HEXPOS
         BLE      LVRDY               NO, LINE VALUE IS OK.
         LW,R6    MAXLINV             YES, SUBSTITUTE MAX ALLOWED VALUE.
LVRDY    STW,R6   LINVAL            SAVE THE LINE VALUE.
         B       *R12
 PAGE
************************************************************************
*                                                                      *
*  GENFPRMT -- GENERATES A FUNCTION LINE NO. PROMPT IN IMAGE BUFFER.   *
*        REGS:   R12-- LINK, EXIT VIA *R12.                            *
*                R3 -- (EXIT) CONTAINS NO.OF CHARS GENERATED IN IMAGE. *
*                R4,R6,R7,&R13 ARE VOLATILE, BUT SEE ALSO 'GENCHAR'.   *
*                                                                      *
GENFPRMT LI,R3    0                 = # CHARS IN IMAGE.
         LI,R7    LBRACKET          GEN. LEFT BRACKET.
         BAL,R13  GENCHAR
         LW,R6    LINVAL            GET THE LINE VALUE.
         LI,R4    1+4               = # HEX DIGITS IN INTEGER PART.
         LI,R7    0                 CLEAR R7 FOR LEADING ZERO TESTS.
DLEAD    SCD,R6   4                 SHIFT HEX DIGIT INTO LO END OF R7.
         AI,R7    0                 TEST FOR ZERO...
         BNEZ     GENDIGIT            NO, START DIGIT GENERATION.
         BDR,R4   DLEAD               YES, SKIP TILL END OF INTG PART.
         LI,R4    1                 OK, USE INTEGER ANYWAY--I.E. GEN. 0.
GENDIGIT AI,R7    '0'               CONVERT TO EBCDIC INTEGER.
GENPT    BAL,R13  GENCHAR           GENERATE THE CHARACTER.
         LI,R7    0                 CLEAR R7 AGAIN.
         AI,R6    0                 TEST FOR FURTHER NON-ZERO DIGITS...
         BNEZ     GENMORE             YES, MORE TO GENERATE.
         CI,R4    1                   NO, IS INTEGER PART GENERATED...
         BLE      GENRB                 YES -- GENERATE THE RT. BRACKET.
GENMORE  SCD,R6   4                 SHIFT NEXT DIGIT INTO LO END OF R7.
         AI,R4    -1                DO WE NEED A DEC.PT. FIRST...
         BNEZ     GENDIGIT            NO.
         SCD,R6   -4                  YES, SHIFT BACK TILL DEC.PT HAS
         LI,R7    '.'                      BEEN GENERATED.
         B        GENPT
GENRB    LI,R7    RBRACKET          GEN. THE RIGHT BRACKET.
         BAL,R13  GENCHAR
GENBLANK LI,R7    ' '               GEN. A BLANK.
         BAL,R13  GENCHAR
         CI,R3    6                 BLANK OUT TO COLUMN 6, IF NECESSARY.
         BL       GENBLANK
         B       *R12
 PAGE
DELCK    LW,R5    MODE              IS THIS FUNC.DEFN. MODE ALREADY...
         BEZ      CLOSEQ              YES -- PROBABLY A CLOSING DEL.
         STW,R2   SAVEDEL             NO, SAVE OPENING DEL.
         STW,R5   OLDMODE           (SAVE CURRENT MODE).                U15-0018
         CI,R7    2                 IS CODESTR.OFFSET AT 'BEGIN-O-STMT'.
         BNE      ERLSCAN             NO -- LINE-SCAN ERROR.
         LI,R4    0                   YES, THROW CODESTRING AWAY, I.E.
         STW,R4   ERRORID             (CLEAR ERROR I.D.)
         STW,R4   GLOBLOC             (CLEAR GLOBAL REF LOC.)
         XW,R4    CURRCS
         AI,R4    -2
         BAL,R7   DREF                  DE-REFERENCE IT.
         AI,R5    -1                IS THIS DIRECT INPUT MODE...
         BEZ      CLROPEN             YES.                              U15-0022
         LI,R5    EFLAG               NO, QUAD-STATE MODE.  EXTRACT     U15-0023
         AND,R5  *STATEPTR              E-FLAG ('EXECUTE' VS EVAL-INPUT)U15-0024
         STS,R5   OLDMODE               AND MARK OLD MODE SIMILARILY.   U15-0025
CLROPEN  BAL,R4   ACQNXNB           ACQ NEXT NON-BLANK AFTER DEL.
ACQHDR   LI,R5    -1                (THE CLEAR NAME PTR INDICATOR)
         LI,R4    -FBLKSIZE         = - MAX # STANDARD NAMES IN HEADER.
CLRTFBLK STW,R5   TFBLK+FBLKSIZE,R4   CLEAR TEMP STANDARD NAME BLOCK.
         BIR,R4   CLRTFBLK
         LI,R5    0
         STW,R5   TNLCLS            CLEAR TEMP # LOCALS.
         STW,R5   NAMECNT           CLEAR NAME COUNTER.
         BAL,R7   HNAME           @ ACQ HDR NAME & TERMINATION:
         B        ONLY1           @   NEWLINE OR DEL -- ONLY 1 NAME.
         B        LBQ             @   OTHER (LEFT BRACKET,ARROW,NAME...)
         B        SETFN           @   SEMICOLON -- SET FUNCTION NAME.
LBQ      CI,R2    LBRACKET          LEFT BRACKET...
         BNE      ARROWQ              NO (WE SHOULD BE ON A NEW HDR).
         LW,R7    MODE                YES, THIS IS A REOPEN, NO DOUBT...
         BNEZ     TESTFN                WELL, MODE OK -- TEST FUN NAME.
         B        ERDEFN                OOPS -- DEFN ERROR.
ARROWQ   CI,R2    LFARROW           LEFT ARROW...
         BNE      SETANAME            NO (PROBABLY ANOTHER NAME).
         STW,R6   TFBLK               YES, SET TEMP RESULT NAME PTR.
         BAL,R7   HNAMEX          @ ACQ NEXT HDR NAME & TERMINATION:
         B        SETFN           @   NEWLINE OR DEL -- SET FUNC. NAME.
         B        SETANAME        @   OTHER (BETTER BE ANOTHER NAME).
         B        SETFN           @   SEMICOLON -- SET FUNCTION NAME.
SETANAME MTW,1    NAMECNT           INCR NAME COUNTER.
         LW,R7    NAMECNT
         STW,R6   TFBLK,R7          STORE THIS TEMP NAME PTR.
         AI,R7    -2                WILL NEXT NAME BE ONE TOO MANY...
         BGZ      ERDEFN              YES -- DEFN ERROR.
         BAL,R7   HNAME           @   NO, ACQ HDR NAME & TERMINATION:
         B        DETFNAME        @     NEWLINE OR DEL.
         B        SETANAME        @     OTHER (BETTER BE ANOTHER NAME).
*                                 @     SEMICOLON.
*                                 @ DETERMINE WHICH IS THE FUNCTION NAME
DETFNAME STW,R6   TFBLK+3         @ STORE TEMP LAST STD. NAME PTR, IT
*                                     HAS TO BE THE RIGHT DUMMY.
         LW,R7    NAMECNT           WAS THERE 2 PRIOR NAMES BESIDES
         AI,R7    -2                  ANY RESULT NAME...
         BEZ      NEWFQ                 YES, DYADIC FUNCTION.
         LI,R6    -1                    NO, MONADIC FUNCTION.
         XW,R6    TFBLK+1           MOVE THE 1ST NAME (IT'S FUNC. NAME).
SETFN    STW,R6   TFBLK+2           PUT TEMP FUN NAME PTR IN ITS PLACE.
NEWFQ    LW,R6    TFBLK+2           GET THE NEW FUNCTION NAME PTR.
         BAL,R14  GFNREF            IS ITS GLOBAL REFERENT IN USE NOW...
         BEZ      LCLQ                NO.
         CW,R4    FDEFPTR             YES, IS THIS A NEW HDR FOR REOPEND
*                                          FUNCTION...
         BE       LCLQ                     YEP, CK FOR LOCALS IN IT.
         CW,R7    GLOBLOC           DOES NEW HDR NAME ORIGINALLY OPENED
*                                     FUNCTION...
         BNE      ERDEFN                UH-UH -- DEFN ERROR.
         STW,R4   FDEFPTR               UH-HUH, SAVE PTR TO FUNC.DESCR.
         MTW,1    1,R4              AGAIN & INCR ITS REF-COUNT AGAIN.
LCLQ     CI,R2    ';'               LOCAL COMING UP...
         BNE      SETFBLK             NO -- SET THE NEW HDR BLOCK.
         BAL,R7   HNAMEX          @   YES, ACQ NEXT LOCAL & TERMINATION:
         B        LCL             @     NEWLINE OR DEL.
         B        ERDEFN          @     OTHER -- DEFN ERROR.
*                                 @     SEMICOLON.
LCL      LH,R7    TNLCLS          @ GET TEMP LOCALS COUNT.
         STH,R6   TLOCALS,R7        SAVE TEMP LOCAL NAME PTR.
         MTH,1    TNLCLS            INCR TEMP LOCALS COUNT.
         B        LCLQ
ONLY1    LW,R7    MODE              ARE WE ALREADY IN FUN DEFN MODE...
         BEZ      SETFN               YES -- MUST BE A NEW HDR.
TESTFN   BAL,R14  GFNREF            DOES FUN NAME HAVE A GLOBAL REF...
         BNEZ     REOPEN              YES -- MUST BE A REOPEN.
         CI,R2    LBRACKET            NO, NEW HDR UNLESS LEFT BRACKET...
         BE       ERDEFN                OOPS -- DEFN ERROR.
         STW,R6   TFBLK+2               OK, SET NEW FUNCTION NAME.
SETFBLK  LI,R4    -FBLKSIZE
MOVEFBLK LW,R5    TFBLK+FBLKSIZE,R4   MOVE TEMP NAME PTRS & ZEROS INTO
         STW,R5    FBLK+FBLKSIZE,R4     THE CURRENT OPEN HDR BLOCK.
         BIR,R4   MOVEFBLK
         LI,R4    -1
MOVELCLS AI,R4    1                 MOVE TEMP LOCAL NAME PTRS INTO
         CH,R4    TNLCLS              THE CURRENT OPEN HDR LOCALS BLOCK.
         BE       SETNLCLS
         LH,R5    TLOCALS,R4
         STH,R5    LOCALS,R4
         B        MOVELCLS
SETNLCLS STH,R4   NLCLS             SET NO.OF LOCALS IN CURRENT OPEN BLK
         STW,R1   FUNSAVE           SAVE BYTE PTR.
         LW,R4    MODE              ARE WE ALREADY IN FUN DEFN MODE...
         BNEZ     SETFMODE            NO -- A NEW OPEN.
         LW,R5    FDEFPTR             YES -- A RE-HEADER.
         BEZ      ZTEST             (NO OLD FUNCTION CURRENTLY OPEN)
         LW,R5    FNOFF,R5          GET OLD FUNCTION'S NAME PTR.
         CW,R5    FBLK+2            DOES IT MATCH NEW HDR'S FUN NAME PTR
         BE       ZTEST               YES, SOME OTHER HDR CHANGE.
         XW,R4    FDEFPTR             NO, FORGET OLD FUNCTION.
         LI,R7    ZTEST             RETURN TO ZTEST AFTER
         B        DREF                DE-REFERENCING OLD FUNC.DESCRIPTOR
SETFMODE BAL,R14  INITLC            INITIALIZE THE LINE CHAIN.
         LI,R4    0
         STW,R4   MODE              SET FUN DEFN MODE.
         STW,R4   LINVAL            SET LINE VALUE = 0.
ZTEST    CI,R2    NEWLINE           DID HDR END ON NEWLINE OR DEL...
         BE       NXTPROMT            NEWLINE -- PROMPT FOR LINE 1.
         LW,R1    FUNSAVE               (RESTORE BYTE PTR).
         B        CLOSEDEL            DEL -- CLOSE THE FUNCTION.
REHDR    CLM,R3   DELDEL            IS NEW LINE 0 JUST A CLOSING DEL...
         BCS,9    ACQHDR              NO -- ACQ A NEW HDR FOR OPEN FUNC.
         B        CLOSEDEL            YES -- CLOSE THE FUNCTION.
REOPEN   STW,R1   FUNSAVE           SAVE PTR TO LF.BRACKET,NEWLINE,DEL.
         STW,R7   GLOBLOC           SAVE LOC.OF GLOBAL REFERENCE TO THIS
*                                     NAME.  THIS LOC WILL NOT CHANGE
*                                     DURING FUNCTION DEFN MODE.
         LB,R14  *R4                GET TYPE OF REFERENT FOR FUN NAME.
         CLM,R14  FUNTYPES          IT SHOULD BE A FUNCTION DESCRIPTOR.
         BCS,9    ERDEFN              OOPS -- DEFN ERROR.
         LI,R12   LOCKFLAG            OK, IS IT A LOCKED FUNCTION...
         CW,R12   0,R4
         BANZ     ERDEFN                YES -- DEFN ERROR.
         LI,R12   PENDFLAG              NO, SET FOR PENDENT TEST.
         LW,R7    STATEPTR          PT AT TOP STATE-ENTRY IN EXEC.STACK.
         LW,R14   1,R4              = NO.OF REFERENCES TO FUNC.DESCR.
         BDR,R14  RESTATEQ          TEST STATE-ENTRY IF MORE THAN 1 REF.
         B        REOPENOK            OK, ONLY 1 (FOR GLOBAL NAME).
RESTATE  LI,R11   X'7FFF'           EXTRACT OFFSET TO NEXT STATE-ENTRY.
         AND,R11  0,R7
         BEZ      ERDEFN              OOPS, FINAL ENTRY -- DEFN ERROR
*                                       (THIS DEFN ERROR RESULTS DUE TO
*                                        PENDENT STATUS; A D-ENTRY,
*                                        DYADIC FUNCTION, EXISTS FOR THE
*                                        NAMED FUNCTION.  THE D-ENTRY IS
*                                        NOT A STATE-ENTRY, BUT IT WILL
*                                        BECOME ONE AS SOON AS ITS LEFT
*                                        ARGUMENT IS RESOLVED.)
         AW,R7    R11               PT AT IT.
RESTATEQ CS,R4    1,R7              DOES IT REFER TO THE FUNC.DESCR...
         BNE      RESTATE             NO.
         CW,R12   0,R7                YES, IS IT A PENDENT STATE...
         BANZ     ERDEFN                YEP -- DEFN ERROR.
         BDR,R14  RESTATE               NOPE, LOOP TILL REFS ALL TESTED.
REOPENOK MTW,1    1,R4              INCR FUNC.DESCRIPTOR'S REF-COUNT AND
         STW,R4   FDEFPTR             SAVE PTR TO FUNC.DESCRIPTOR.
         LCI      4                 GET RESULT,LF.DUMMY,FUNNAME,AND
         LM,R11   RESOFF,R4           RT. DUMMY NAME PTRS.
         STM,R11  FBLK              SET CURRENT OPEN FUNCTION BLOCK.
         AW,R4    NFLOFF,R4         PT AT THE FUNC.DESCRIPTOR'S
         AI,R4    NFLOFF+1            LOCAL & LABEL COUNTS.
         LH,R7   *R4                GET NO.OF LOCALS.
         STH,R7   NLCLS
         INT,R11  0,R4              GET NO.OF LABELS.
         SLS,R11  1                 (2 WDS PER LABEL).
         AW,R4    R11               PT AT 1ST WD CONTAINING LOCAL PTR.
         AI,R4    1
         SLS,R4   1                 USE HALFWD RESOLUTION.
         LI,R7    -1                SET FOR LOCAL COUNT TEST.
RELCLS   AI,R7    1                 BUMP LOCAL COUNT.
         CH,R7    NLCLS             HAVE WE GOTTEN ALL LOCALS YET...
         BGE      RECHAIN             YES -- DEVELOP THE LINE-CHAIN.
         LH,R12   0,R4                NO, GET LOCAL NAME PTR.
         STH,R12  LOCALS,R7         PUT IT IN CURRENT OPEN LOCAL BLOCK.
         AI,R4    1                 PT AT NEXT HALFWD.
         B        RELCLS
RECHAIN  BAL,R14  INITLC            INITIALIZE THE LINE-CHAIN.
         LI,R12   3                 = OFFSET FROM NEXT LC ENTRY TO LAST.
         LI,R13   0                 PRESET LINE-VALUE HOLDER.
         LI,R7    0                 PRESET LINE COUNTER.
RELINE   LW,R4    FDEFPTR           PT AT FUNC.DESCRIPTOR AGAIN.
         CW,R7    NFLOFF,R4         HAVE ALL OF ITS LINE PTRS BEEN USED.
         BL       REPTR               NOT YET.
         STW,R13  LINVAL              YES, SAVE LAST LINE-VALUE.
         SW,R1    HILINE            = OFFSET FROM TOP LC ENTRY TO BIG-1.
         AND,R1   XFFFF             (OFFSETS ARE HALFWDS).
         LW,R4    HILINE            PT AT THE HI BOUNDARY LINE-CHAIN
         STW,R1   1,R4                ENTRY AND UPDATE ITS OFFSET.
         LW,R1    FUNSAVE           RESTORE PTR TO LF.BRACKET OR WHATEVR
         LI,R9    0                 PRE-SET DIR.CNT SO LF BRACK OVERRIDE
         STW,R9   MODE              SET FUNCTION DEFINITION MODE.       U15-0031
         LB,R2    0,R1              GET THE TERMINATION CHAR AGAIN.
         AI,R1    -1                BACK UP FOR DIRECTIVE HUNT.
         AI,R2    -LBRACKET         TERMINATE ON LEFT BRACKET...
         BNEZ     DIRHUNT             NO, WE'LL USUALLY REPROMPT (N+1)
         B        DIRHUNTR            YES, IT MAY BE AN OVERRIDE.
REPTR    BAL,R10  RAISE3            RAISE EXECUTION STACK BY 3 WDS.
         LI,R3    16                SET SHIFT COUNT.
         SCD,R12  -16               SHIFT LO DIGIT OF LINE NO. TO TOP 12
RELINEA  AW,R12   BITPOS-3          INCR.
         LB,R2    R12               LOOK AT IT.
         AI,R2    X'FFF60'          CK FOR INCR TO 10.
         BNEZ     RELINEOK            NO, OK.
         LI,R12   0                   YES, CLEAR & CARRY.
         AI,R3    4                 BUMP SHIFT COUNT.
         SCD,R12  -4                SHIFT NEXT DIGIT TO TOP OF R12.
         B        RELINEA
RELINEOK SCD,R12  0,R3              SHIFT INCR LINE VALUE BACK TO R13 &
*                                     (AUTOMATICALLY) RESTORE R12 = 3.
         AI,R7    1                 INCR LINE COUNTER.
         AW,R4    R7                GET THAT LINE'S PTR WD.
         LW,R11   NFLOFF,R4
         AW,R11   LCENTRY           MAKE IT LINE-CHAIN CATEGORY.
         LCI      3
         STM,R11  0,R1              STORE THE LINE-CHAIN ENTRY.
         AI,R11   -1                BUMP THE REF COUNT OF THE CODESTRING
         MTW,1   *R11                 DATA BLOCK.
         B        RELINE
FIHANDLR LI,R1    BA(IMAGE)-1       SET TO BEGIN SCANNING IMAGE.
DIRHUNT  LI,R9    -1                = DIRECTIVE COUNTER
DIRHUNTR LI,R11   -1                SET NON-NEG. IF EDIT OR DISPLAY-N
         LI,R10   -1                SET NON-NEG. IF EDIT OR DISPLAY-1.
         STW,R10  SAVECDEL          NO CLOSING DEL, SO FAR.
DIRQ     AI,R9    1                 BUMP DIRECTIVE COUNT.
         BAL,R4   ACQNXNB           GET NEXT NON-BLANK CHAR & CODE.
         CI,R2    LBRACKET          TEST FOR LEFT BRACKET...
         BNE      PASTDIR             NO -- WE ARE PAST DIRECTIVES.
         LI,R10   -1                  YES, NEW DIRECTIVE; IGNORE ANY
         LI,R11   -1                    PRIOR DIRECTIVE SETTINGS.
         BAL,R4   ACQNXNB
         CI,R2    QUAD              CK FOR LEADING QUAD...
         BE       DIRSHOWN            YES -- MUST BE A DISPLAY-N DIR.
         BAL,R14  DIRLV               NO, EXPECT A LINE VALUE.
         STW,R12  LINVAL            IT BECOMES THE CURRENT LINE VALUE.
         CI,R2    QUAD              WAS IT FOLLOWED BY A QUAD...
         BNE      DIRZ                NO -- COULD BE OVERRIDE, DELETE,
*                                           INSERT, REPLACE, OR SKIP.
         LW,R10   LINVAL              YES, COULD BE EDIT OR DISPLAY-1.
         BAL,R4   ACQNXNB
         CI,R3    9                 CK FOR DIGIT CODE NEXT...
         BLE      DIREDIT             YES -- AN EDIT-DIRECTIVE.
DIRZ     AI,R2    -RBRACKET         END DIRECTIVE ON A RT. BRACKET...
         BEZ      DIRQ                OK, CK FOR ANOTHER DIRECTIVE.
         B        ERDIR               OOPS -- DIRECTIVE ERROR.
DIRSHOWN LI,R11   0                 DISPLAY ALL (0) OR SOMETHING.
         BAL,R4   ACQNXNB
         CI,R2    RBRACKET          CK FOR RT. BRACKET NEXT...
         BE       DIRQ                YES, DISPLAY-ALL; CK FOR ANOTHER
*                                          DIRECTIVE.
         BAL,R14  DIRLV               NO, EXPECT LINE VALUE.
         LW,R11   R12               PUT IT IN DISPLAY-N INDICATOR.
         B        DIRZ
DIREDIT  LI,R11   0                 CLEAR COLUMN ACCUMULATOR.
DIRED    MI,R11   10
         AW,R11   R3                ACCUMULATE COLUMN NO. TO START EDIT.
         BAL,R4   ACQNXCC           ACQ. NEXT CHAR & CODE.
         CI,R3    9                 CK FOR DIGIT...
         BLE      DIRED               YES.
         LI,R4    DIRZ                NO, SET EXIT POINT 'DIRZ' AFTER
         B        ACQNB                   INSURING NON-BLANK REACHED.
DIRAN    BAL,R4   ACQNXCC           ACQ. NEXT CHAR & CODE.
DIRAQM   CI,R3    9                 CK FOR DIGIT...
         BG       0,R6                NO -- RETURN.
         SLS,R12  4                   YES, ACCUMULATE A HEX DIGIT.
         AW,R12   R3
         AI,R5    -4                DECR SHIFT COUNT.
         BGEZ     DIRAN               OK, KEEP GOING, NOT TOO MANY DIGS.
         B        ERDIR               OOPS -- DIRECTIVE ERROR.
DIRLV    LI,R12   0                 CLEAR LINE VALUE ACCUMULATOR.
         CI,R3    9                 ARE WE ON A DIGIT...
         BLE      DIRINT              YES, HANDLE INTEGER PART.
         LI,R5    12                  NO, SET SHIFT COUNT FOR MAX. 3
         AI,R2    -'.'                    DIGITS, AND VERIFY DEC.PT.
         BEZ      DIRPT                 OK, HANDLE FRACTION PART.
         B        ERDIR                 OOPS -- DIRECTIVE ERROR.
DIRINT   LI,R5    16                NO MORE THAN 4 SIG. DIGITS ACCEPTED.
         LI,R4    DIRLZ             IGNORE LEADING ZEROES.
DIRLZ    AI,R3    0
         BEZ      ACQNXCC           GOT ONE, ACQ. NEXT CHAR & CODE.
         BAL,R6   DIRAQM            OK, ACCUMULATE INTEGER PART.
         LI,R5    12                SET SHIFT COUNT FOR MAX. 3 MORE DIGS
         CI,R2    '.'               CK FOR DEC.PT...
         BNE      DIRSHIFT            NO, SHIFT TO INTEGER LINE VALUE.
DIRPT    BAL,R6   DIRAN             ACCUM FRACTION PART, IF ANY.
DIRSHIFT SLS,R12  0,R5              SCALE THE LINE VALUE APPROPRIATELY.
         LW,R4    R14               SET TO RETURN FROM 'DIRLV' AFTER
         B        ACQNB               INSURING NON-BLANK REACHED.
PASTDIR  LCI      3                 SAVE SCAN REGS.
         STM,R1   FUNSAVE
         AI,R11   0                 CK FOR SHOW-N OR EDIT DIRECTIVE...
         BGEZ     VERTERM             YES, VERIFY PROPER TERMINATION.
         AI,R10   0                   NO, CK FOR SHOW-1 DIRECTIVE...
         BLZ      CSNQ                  NO.
         LI,R1    -17                   YES.
SAVIMAGE LD,R2    IMAGE+34,R1       SAVE CURRENT IMAGE.
         STD,R2   VISIMAGE+34,R1
         BIR,R1   SAVIMAGE
         STW,R9   CONSTBUF          SAVE DIRECTIVE COUNT.
         BAL,R4   SHOW1             DISPLAY THE LINE, CLOBBERING IMAGE.
         LW,R9    CONSTBUF          RESTORE DIRECTIVE COUNT.
         LI,R1    -17
GETIMAGE LD,R2    VISIMAGE+34,R1    RESTORE THE IMAGE, IT MIGHT BE A
         STD,R2   IMAGE+34,R1         REPLACEMENT FOR DISPLAYED LINE.
         BIR,R1   GETIMAGE
CSQ      LCI      3                 RESTORE SCAN REGS.
         LM,R1    FUNSAVE
CSNQ     CI,R2    NEWLINE           WAS DIRECTIVE FOLLOWED BY NEW LINE.
         BE       NOCS                YES -- NO CODESTRINGING.
         CLM,R3   DELDEL            WAS IT FOLLOWED BY A DEL...
         BCR,9    CLOSEDEL            YES -- CLOSE THE FUNCTION.
         LW,R12   LINVAL              NO, IS LINE VALUE ZERO...
         BNEZ     CSFUNLIN          NOPE, CODESTRING THE FUNCTION LINE
         CI,R2    ')'               YEP, BUT IS IT A CMND...
         BNE      REHDR                JA -- REWRITE THE HEADER.
CSFUNLIN BAL,R12  CSN               DO CODESTRING OR RECOGNIZE COMMAND.
CSLINECK LW,R12   LINVAL            SEARCH THE LINE CHAIN FOR THE       U15-0033
         BAL,R5   LCSEARCH            LINE VALUE...
         B        INSERT                NO MATCH -- AN INSERT.
         LI,R4    0                     MATCH -- A REPLACEMENT.
         XW,R4    CURRCS            CLEAR & GET CODESTRING PTR.
         AW,R4    LCENTRY           ADD LINE-CHAIN CATEGORY VALUE.
REPLACE  XW,R4    0,R7              PUT & TAKE.
         AND,R4   X1FFFF            DID WE TAKE A LIVE ENTRY...
         BEZ      CDELQ               NO.
         AI,R4    -2                  YES, PT AT ITS DATA BLK HEADER.
         LI,R7    CDELQ             CK FOR CLOSE ON THIS LINE OF INPUT
         B        DREF                AFTER DEREFERENCING THIS BLOCK.
USEBADFL LI,R12   EFLAG             ENTERED DUE TO LINE-SCAN ERROR.     U15-0035
         CW,R12   OLDMODE           IS THIS AN 'EXECUTED' FUN DEFN...   U15-0036
         BAZ      CSLINECK            NO, ACCEPT THE BAD LINE.          U15-0037
         B        ERRORCK             YES, DON'T CHANGE THE FUNCTION.   U15-0038
NOCS     LW,R12   EDITCK            WAS A DELETE INDICATED...
         BNEZ     DELETE              YES.
         AI,R9    -1                  NO, WAS A LINE NO. OVERRIDE GIVEN.
         BLEZ     NXTPROMT              NO -- MOVE UP A LINE VALUE.
         B        REPROMPT              YES -- ISSUE THAT LINE NO. AS
*                                              THE FUNCTION LINE PROMPT.
DELETE   LW,R12   LINVAL            FIND THE LINE VALUE IN THE LINE-CHN;
         BEZ      ERDEFN              HOWEVER -- CAN'T DELETE HEADER.
         BAL,R5   LCSEARCH
         B        CDELQ             NO MATCH.
         LW,R4    LCENTRY           MATCH -- REPLACE BY A DEAD ENTRY,
         B        REPLACE             I.E. CATEGORY VALUE BUT NO CS PTR.
INSERT   BAL,R10  RAISE3            RAISE EXECUTION STACK BY 3 WDS.
         STW,R12  2,R1              PUT NEW LINE VALUE IN THE LC ENTRY.
         LI,R4    0                 CLEAR & GET CODESTRING PTR.
         XW,R4    CURRCS
         AW,R4    LCENTRY           ADD LINE-CHAIN CATEGORY VALUE.
         STW,R4   0,R1              SET TOP WD OF LINE-CHAIN ENTRY.
         SW,R7    TOPOSTAK          = OFFSET TO NEXT LOWER LINE-CHAIN
         STW,R7   1,R1                ENTRY; SET THIS ONE'S CHAIN WD.
         SW,R6    R7                = OFFSET FROM NEXT HIGHER LC ENTRY.
         SW,R1    R6                PT AT NEXT HIGHER LINE-CHAIN ENTRY.
         STH,R6  *R1,R2             CORRECT THAT CHAIN WD.
CDELQ    LW,R12   SAVECDEL          DID THIS INPUT END ON CLOSING DEL...
         BGZ      CLOSE               YES -- CLOSE THE FUNCTION.
NXTPROMT BAL,R12  NXTFLINE          CALC. NEXT LINE VALUE.
REPROMPT LI,R12   EFLAG                                                 U15-0040
         CW,R12   OLDMODE           IF THIS IS AN 'EXECUTED' FUNC.DEFN, U15-0041
         BANZ     ACLOSE              CLOSE AUTOMATICALLY.              U15-0042
DOPROMPT LI,R12   INPF              REQUEST FUNCTION INPUT AFTER        U15-0043
         B        GENFPRMT            GENERATING THE LINE NO. TO PROMPT.
SHOW1    STW,R11  MERGECOL          SET NEG. TO INDICATE NON-EDIT.
         STW,R4   LINKFD            SAVE LINK.
         LW,R12   LINVAL            GET THE LINE VALUE.
         BEZ      SHOW1HDR          ZERO -- SHOW THE HEADER ONLY.
         BAL,R5   LCSEARCH          FIND ITS LINE-CHAIN ENTRY, IF ANY.
         B       *LINKFD              NONE.
GENLINE  LI,R4    X'1FFFF'          EXTRACT THE CODESTRING PTR, IF ANY.
         AND,R4   0,R7
         BEZ     *LINKFD              NONE (DEAD LINE-CHAIN ENTRY).
         STW,R4   CURRCS              OK, SET PTR FOR 'SHOWFL'.
         LW,R6    2,R7              DISPLAYED LINE BECOMES THE
         STW,R6   LINVAL              CURRENT LINE VALUE.
         BAL,R12  GENFPRMT          GENERATE THE LINE NO.
SHOW     LW,R14   LINKFD            RETURN VIA SAVED LINK AFTER
         B        SHOWFL              DISPLAYING THE LINE.
SHOW1HDR BAL,R12  GENFPRMT          GENERATE LINE NO. ZERO.
GENHDR   LI,R12   0                 ZERO THE IMAGE COUNTER.
         STW,R12  IMAGES
         LW,R8    FBLK              GET RESULT NAME PTR, IF ANY.
         BLZ      GENLDMY             NO RESULT.
         BAL,R13  GENNAME           GEN. THE NAME.
         LI,R7    LFARROW           GEN. THE LEFT ARROW.
         BAL,R13  GENCHAR
GENLDMY  LW,R8    FBLK+1            GET LEFT DUMMY NAME PTR, IF ANY.
         BLZ      GENFN               NO LEFT DUMMY.
         BAL,R13  GENNAME           GEN. THE NAME.
         LI,R7    ' '               GEN. A BLANK.
         BAL,R13  GENCHAR
GENFN    LW,R8    FBLK+2            GET FUNCTION NAME PTR.
         BAL,R13  GENNAME           GEN. THE NAME.
         LI,R6    -1                PRESET LOCAL COUNTER.
         LW,R8    FBLK+3            GET RIGHT DUMMY NAME PTR, IF ANY.
         BLZ      GENLCLS             NO RIGHT DUMMY.
         LI,R7    ' '               GET A BLANK CHAR.
GENCN    BAL,R13  GENCHAR           GEN. THE CHAR.
         BAL,R13  GENNAME           GEN. THE NAME.
GENLCLS  AI,R6    1                 INCR. THE LOCAL COUNTER...
         CH,R6    NLCLS               VS NO.OF LOCALS...
         BGE      SHOW                  DONE -- SHOW THE HEADER.
         LI,R7    ';'                   MORE, GET A SEMICOLON CHAR.
         LH,R8    LOCALS,R6         GET THAT LOCAL NAME PTR.
         B        GENCN
EDIT     LI,R4    EFLAG             IF THIS IS AN 'EXECUTED' ATTEMPT    U15-0045
         CW,R4    OLDMODE             TO EDIT...                        U15-0046
         BANZ     ERDIR                 DIRECTIVE ERROR.                U15-0047
EDITOK   BAL,R4   SHOW1          @  DISPLAY FOR EDIT (R11 IS POSITIVE)  U15-0048
         CI,R14   EDITOK+1       @  DID WE FIND LINE (SEE ALSO 'SHOW')  U15-0049
         BNE      REPROMPT            NO (DIDN'T EXIST OR WAS DELETED).
         LI,R1    0           INIT: NO.OF CHARS IN -- VISUAL IMAGE (OLD)
         LI,R2    0                                   EDIT CONTROL LINE
         LI,R3    0                                   VISUAL IMAGE (NEW)
         LI,R11   9999        INIT. NO.OF CHARS BEFORE MERGING BEGINS.
         B        ECTRL             START LOOKING AT EDIT CONTROL LINE.
EGET1    LB,R12   VISIMAGE,R1       GET NEXT CHAR FROM OLD VISUAL IMAGE.
         AI,R1    1                 COUNT THAT CHAR & OFFSET TO NEXT.
         CI,R12   NEWLINE           IS IT END-OF-STMT...
         BNE      1,R7                NO -- NORMAL EXIT.
         BDR,R1   0,R7                YES -- BACK UP & TAKE END EXIT.
EDELETE  BAL,R7   EGET1           @ GET (& FORGET) 1 CHAR OF OLD IMAGE.
         B        ENXTCTRL        @   (END-OF-STMT) LOOK AT NEXT CONTROL
         B        ENXTCTRL        @   (NORMAL CHAR) LOOK AT NEXT CONTROL
EDIG09   CW,R3    R11               HAVE WE FOUND MERGE PT. ALREADY...
         BGE      EBLANKER            YES.
         LW,R11   R3                  NO, SET MERGE PT. NOW.
EBLANKER LI,R12   ' '               SET TO INSERT A BLANK IN NEW IMAGE.
         LI,R7    EBLANQ            RETURN FROM 'EMOVER' TO 'EBLANQ'.
EBLANQ   AI,R9    -1                DECR THE BLANK COUNT...
         BGEZ     EMOVER              PUT 1 MORE IN NEW IMAGE.
EMOVE1   BAL,R7   EGET1           @ GET NEXT CHAR OF OLD IMAGE...
         B        ENXTCTRL        @   (END-OF-STMT) LOOK AT NEXT CONTROL
         BAL,R7   EMOVER          @   (NORMAL CHAR) PUT IT IN NEW IMAGE.
ENXTCTRL AI,R2    1                 OFFSET TO NEXT CONTROL CHAR.
ECTRL    LB,R9    IMAGE,R2          GET EDIT-CONTROL CHAR.
         CI,R9    ' '
         BE       EMOVE1              BLANK -- MOVE 1 OLD CHAR TO NEW.
         CI,R9    '/'
         BE       EDELETE             SLASH -- SKIP 1 OLD CHAR.
         CI,R9    NEWLINE
         BE       EZCTRL              END-OF-EDIT-CONTROL-LINE.
         AI,R9    -'0'
         BLZ      ELETTER
         CI,R9    9
         BLE      EDIG09              DIGIT -- INSERT 0 TO 9 BLANKS.
ELETTER  AI,R9    '0'-'A'+1
         BLZ      REPROMPT            (NON-CONTROL-CHAR)
         CI,R9    9
         BLE      ELETAI              A - I -- INSERT 5 TO 45 BLANKS.
         AI,R9    'A'-'J'
         BLZ      REPROMPT            (NON-CONTROL-CHAR)
         CI,R9    9
         BLE      ELETJR              J - R -- INSERT 50 TO 90 BLANKS.
         AI,R9    'J'-'S'
         BLZ      REPROMPT            (NON-CONTROL-CHAR)
         CI,R9    8
         BG      REPROMPT             (NON-CONTROL-CHAR)
         AI,R9    9                   S - Z -- INSERT 95 TO 130 BLANKS.
ELETJR   AI,R9    9
ELETAI   MI,R9    5                 SET BLANK COUNT.
         B        EDIG09
EZCTRL   BAL,R7   EGET1           @ MOVE OLD CHARS INTO NEW VISUAL IMAGE
         B        EDITOUT         @   UNTIL END-OF-OLD-STMT. OCCURS.
         LI,R7    EZCTRL          @ AFTER MOVE, GET 1 MORE CHAR.
EMOVER   CI,R3    130             @ REFUSE TO MOVE MORE THAN 130 TO NEW.
         BE       0,R7                EXIT WITHOUT MOVING.
         STB,R12  INBUF,R3          PUT CHAR IN NEW VISUAL IMAGE.
         AI,R3    1                 COUNT THAT CHAR & OFFSET TO NEXT.
         B       0,R7                 EXIT.
EDITOUT  CW,R3    R11               WERE ANY BLANK INSERTIONS INDICATED.
         BGE      EMERGCOL            YES.
         LW,R11   R3                  NO, SET MERGE-PT. NOW.
EMERGCOL STW,R11  MERGECOL          SET MERGE COLUMN (-1).
         LI,R4    -17               MOVE NEW VISUAL IMAGE (+) TO IMAGE.
ESWITCH  LD,R8    INBUF+34,R4
         STD,R8   IMAGE+34,R4
         BIR,R4   ESWITCH
         B        INP4MERG          INPUT FOR MERGE INTO IMAGE (R3 IS
*                                   THE NO.OF CHARS PRESENTLY IN IMAGE).
VERTERM  CI,R2    NEWLINE           DIRECTIVE FOLLOWED BY:
         BE       SHEDQ               END-OF-STMT -- OK.
         CLM,R3   DELDEL              DEL OR LOCKED DEL...
         BCS,9    ERDIR                 NO -- DIRECTIVE ERROR.
         BAL,R4   ACQNXNB               YES, VERIFY END-OF-STMT NEXT.
         AI,R2    -NEWLINE
         BNE      ERDIR                   OOPS -- DIRECTIVE ERROR.
SHEDQ    AI,R10   0                 IS THIS A SHOW-N OR EDIT...
         BGEZ     EDIT                EDIT.
         STW,R10  MERGECOL              (SET NEG. TO INDICATE NON-EDIT)
         LI,R4    SHOWUP              SHOW-N.
         STW,R4   LINKFD            SET LINKAGE FOR DISPLAY LOOP.
         LW,R12   R11               GET STARTING LINE VALUE.
         STW,R12  STARTLV           SAVE IT.
SHOWSRCH BAL,R5   LCSEARCH          SEARCH FOR LINE VALUE IN LINE-CHAIN.
         B        SHOWHIRE            MISS, USE NEXT HIGHER ENTRY.
         STD,R6   LINKHIRE            OK, SAVE PTR AND BACK-LINKAGE.
         AI,R12   0                 IS THIS THE HEADER LINE...
         BNEZ     GENLINE             NO -- GEN. THE LINE NORMALLY.
         LI,R6    GENHDR              YES -- GEN. THE HEADER AFTER
*                                            DISPLAYING OPENING DEL.
GENDEL   LW,R12   BLANKS            GEN. 4 BLANKS.
         STW,R12  IMAGE
         LI,R3    4                 R3 = CHAR COUNT.
         LW,R7    SAVEDEL           GET THE OPENING DEL.
         BAL,R13  GENCHAR           GEN. IT.
         LI,R7    ' '               GEN. ANOTHER BLANK AND RETURN.
         LW,R13   R6
         B        GENCHAR
SHOWUP   LD,R6    LINKHIRE          RESTORE PTR AND BACK-LINKAGE.
SHOWHIRE SW,R7    R6                BACK UP TO NEXT HIGHER ENTRY.
         LW,R12   2,R7              GET ITS LINE VALUE.
         CW,R12   MAXLINV           IS IT THE UPPER BOUND...
         BLE      SHOWSRCH            NO -- HUNT FOR IT AGAIN (OH HELL).
         LW,R12   STARTLV             YES, CK STARTING LINE VALUE...
         BNEZ     SHOWN                 DIDN'T START ON HEADER.
         BAL,R6   GENDEL                HEADER, GEN. CLOSING DEL.
         BAL,R14  SHOWFL            DISPLAY IT.
SHOWN    LW,R2    FUNSAVE+1         RESTORE NEWLINE OR CLOSING DEL...
         CI,R2    NEWLINE
         BE       NXTPROMT            NEWLINE -- ISSUE NEXT LINE PROMPT.
         B        CLOSED              CLOSING DEL -- CLOSE THE FUNCTION.
CLOSEQ   LCI      3                 SAVE SCAN REGS.
         STM,R1   FUNSAVE
         BAL,R4   ACQNXNB           ACQ. NEXT NON-BLANK.
         CI,R2    NEWLINE           IS IT A NEW LINE CHAR...
         BE       CLOSECS             YES, CLOSE THE CODESTRING.
         LCI      3                   NO, RESET SCAN REGS.
         LM,R1    FUNSAVE
         B        ERLSCAN           ISSUE -- LINE-SCAN ERROR.
CLOSECS  LW,R5    FUNSAVE+1         GET THE CLOSING DEL,
         STW,R5   SAVECDEL            AND SAVE IT FOR 'CDELQ'.
         B        CSZ               FINISH CODESTRING.
CLOSEDEL STW,R2   SAVECDEL          SAVE CLOSING DEL.
         BAL,R4   ACQNXNB           ACQ. NEXT NON-BLANK.
         AI,R2    -NEWLINE          IS IT A NEW LINE CHAR...
         BEZ      CLOSE               YES, CLOSE THE FUNCTION.
         B        ERDEFN              NO -- DEFN ERROR.
ACLOSE   LW,R2    ERRORID           DID AN ERROR OCCUR...
         BNEZ     ERRORCK             YES, ABANDON FUN DEFN ATTEMPT.
         LW,R2    SAVEDEL             NO, AUTOMATIC CLOSE ON OPENING DEL
         B        CLOSED              FOR THE CLOSING DEL.              U15-0052
FORCLOSE MTW,-1   MODE              FORCED-CLOSE; MODE = -1.
         STW,R14  LINKFD            SAVE LINK TO FORCLOSE.
         LW,R14   FBLK+2            PUT OPEN FUNCTION NAME AWAY.
         STW,R14  OPENFN
         LW,R2    OLDMODE           SAVE OLD MODE FOR RECOVERY WHEN THE U15-0054
         STB,R2   OPENFN              FORCED OPEN OCCURS.               U15-0055
         LI,R2    DEL               ASSUME CLOSE ON ORDINARY DEL.
         STW,R2   SAVEDEL
CLOSED   STW,R2   SAVECDEL
CLOSE    LW,R14   FUNTYPES          INIT. FOR TYPE DETERMINATION:
         LW,R8    FBLK
         BLZ      TRYDY               NO RESULT.
         AI,R14   1                   RESULT.
TRYDY    LW,R8    FBLK+1
         BLZ      TRYMON
         AI,R14   4                   DYADIC
         B        SAVETYPE
TRYMON   LW,R8    FBLK+3
         BLZ      SAVETYPE            NILADIC.
         AI,R14   2                   MONADIC.
SAVETYPE SLS,R14  8                 MOVE UP 1 BYTE--LAST BIT= LOCK (=0).
         STW,R14  NEWFTYPE          SAVE NEW FUNCTION TYPE.
         LW,R4    FDEFPTR           IS THIS AN EXCHANGE OF FUNCTIONS...
         BEZ      FWDLC               NO, CONVERT TO FORWARD LINE-CHAIN.
         LI,R8    NODAMAGE            YES, ASSUME NO SI DAMAGE, SAVING
         STW,R8   XREFLOC               EXCHANGE-REFERENT-LOCATION.
         SLS,R14  -8
         CB,R14  *FDEFPTR           COMPARE NEW TYPE VS OLD TYPE.
         BE       FWDLC               SAME.
         LW,R14   1,R4                DIFFERENT, GET REF-COUNT OF OLDIE.
         AI,R14   -2                2 REFS = GLOBAL & FDEFPTR...
         BEZ      FWDLC               OK TO EXCHANGE THEM.
         LI,R14   EFLAG             OH-OH, SI DAMAGE WILL OCCUR.        U15-0057
         CW,R14   OLDMODE             IS THIS AN 'EXECUTED' FUNC.DEFN...U15-0058
         BANZ     SIDAMGO               YES, GO AHEAD & DO DAMAGE.      U15-0059
         BAL,R14  SIDR                OLDIE SUSPENDED -- WISH TO GO ON..
         BE       SIDAMGO               YES, SI DAMAGE IS ACCEPTED.
         LI,R14   0                     NO, STAY IN FUN DEFN MODE SO
         STW,R14  MODE                    USER CAN CORRECT NEW HEADER.
         STW,R14  LINVAL            PROMPT WITH LINE ZERO.
         B        REPROMPT
SIDAMGO  LI,R14   DAMMSG            SET FOR SI DAMAGE MESSAGE WHEN THE
         STW,R14  XREFLOC             ACTUAL EXCHANGES OCCUR.
FWDLC    LI,R2    2
         LI,R3    3
         LI,R6    0
         STW,R6   NFL               CLEAR FUNCTION LINE COUNT.
         STH,R6   NFL,R3            CLEAR NO.OF LABELS.
         LI,R7    X'1FFFF'
         LI,R8    0
         LI,R10   BOSCODE
         LW,R1    HILINE            PT AT HI BOUNDARY LINE-CHAIN ENTRY.
         LI,R5    0
FWDLCE   LH,R9   *R1,R3             = OFFSET TO NEXT LOWER ENTRY.
         STW,R5   1,R1              THIS ENTRY NOW LINKS TO NEXT HIGHER.
         STH,R8  *R1,R2             CLEAR UPPER HALF OF LINK WORD.
         LS,R6    0,R1              DOES THIS ENTRY PT TO CODESTRING...
         BEZ      FWDLCO              NO.
         MTW,1    NFL                 YES, BUMP LINE COUNT.
         CB,R10  *R6,R2             DOES CODESTRING START ON BEGIN-STMT.
         BE       FWDLCO              YES.
         MTW,1    NLBLS               NO, BUMP LABEL COUNT; LABELED LINE
         LW,R11   0,R6              LABEL NAME PTR IS IN LO HALF; PUT IT
         AI,R11   1                   (AN ODD-VALUED VERSION)
         STH,R11 *R1,R2               IN UPPER HALF OF THE LINK WORD.
FWDLCO   AW,R1    R9                PT AT NEXT LOWER ENTRY.
         LCW,R5   R9                = OFFSET BACK TO THE ONE JUST HIT...
         BNEZ     FWDLCE              BUT ZERO MEANS LO BOUNDARY HIT.
         LI,R11   STDFDSIZ          = STANDARD FUNC.DESCRIPTOR SIZE.
         AW,R11   NFL               + 1 WD PER LINE PTR.
         INT,R5   NLBLS
         MI,R5    6                 + 2 WDS/LABEL & ALSO 4-WD DATA BLK.
         AW,R11   R5
         LH,R5    NLCLS
         AI,R5    1
         SLS,R5   -1                + 1 WD/LOCALPAIR & MAYBE AN ODD ONE.
         AW,R11   R5                = TOTAL BLK NEEDED EXC. 2-WD HDR.
         BAL,R14  ALOCNONX          ALLOC. SPACE, IF POSSIBLE.
         B        NOSPACE             YUCK -- WS FULL.
         STW,R4   RESULT              FINE, SAVE PTR TO NEW FUNC.DESCR.
         LW,R8    SAVEDEL
         AW,R8    SAVECDEL          CK FOR LOCKED DEL ON OPEN OR CLOSE.
         AI,R8    -DEL-DEL
         BEZ      SETLTYPE            NO.
         LI,R8    1                   YES, SET LOCK-BIT.
SETLTYPE AW,R8    NEWFTYPE
         STH,R8  *R4                SET NEW FUN TYPE & LOCK FIELDS.
         SLD,R8   -9                SHIFT RESULT-BIT INTO SIGN OF R9,
         AI,R8    -4                  STRIP OUT FUN-TYPE-BIT, R8 NOW =
         AI,R9    0                 0 IF NILADIC, 1 IF MONADIC, 2 IF DY.
         BGEZ     SETXSIZE          R9 = + IF NO RESULT & - IF RESULTBIT
         AI,R8    1                 FINALLY, R8 = # DUMMIES -- GASP.
SETXSIZE LI,R5    1
         AH,R8    NLBLS,R5          + NO.OF LABELS.
         AH,R8    NLCLS             + NO.OF LOCALS.
         SLS,R8   1                 = 2 WDS PER SHADOWED NAME.
         AI,R8    4                 + MIN.OF 4 WDS STACKED ON FUN CALL.
         LW,R5    GLOBLOC           DID WE 'COPY' AN OLD FUNCTION...
         BEZ      SETXSIZW            NO.
         LW,R5    0,R5
         LW,R9    XSIZOFF,R5          YES, GET OLDIE'S XSIZE WORD.
         CI,R9    X'E0000'          DOES IT PT TO AN ERR-CTRL TABLE...
         BAZ      SETXSIZW            NO.
         SLS,R9   15                  YES.  MOVE PTR TO ERR-CTRL TBL UP
         SLD,R8   17                     & SHIFT IT IN, MOVING XSIZE.
         LW,R5    R8                  PT AT ERR-CTRL DATA BLK.
         MTW,1    1,R5                BUMP ITS REF-COUNT.
SETXSIZW STW,R8   XSIZOFF,R4        SET 'XEQ STAK SIZE' FOR CALL &
*                                     (MAYBE) PTR TO ERR-CTRL TBL.
         LCI      FBLKSIZE+1
         LM,R8    FBLK              SET RESULT THRU 'NO.OF FUN. LINES'.
         STM,R8   RESOFF,R4
         LW,R8    LBLDBHDR          = HEADER WD FOR A LABEL'S DATA BLK.
         LI,R9    1                 = REF COUNT OF NEW DATA BLK.
         LI,R10   0                 = THE LABEL'S LINE NO. VALUE (LATER)
         AI,R4    NFLOFF            R4 PTS AT WD BEFORE 1ST LINE PTR.
         LW,R5    R4
         AW,R5    NFL               R5 WILL PT AT THE NEXT
         AI,R5    2                   LABEL-ENTRY PAIR, IF ANY.
         INT,R11 *RESULT            GET SIZE OF TOTAL RESULT BLOCK.
         AW,R11   RESULT            R11 PTS AT WD AFTER TOTAL BLOCK.
         AI,R11   NFLAG             STICK ON THE 'NON-ASSIGNABLE' FLAG.
*
* NOTE -- AT THIS POINT, IT IS NECESSARY THAT R2 = 2 AND R3 = 3 STILL.
*         (SEE ALSO 'FWDLC').
*
         LI,R13   X'7FFFF'          MASK FOR STOP & TRACE BITS + PTR.
         LW,R1    HILINE
         AI,R1    -3                PT AT LO BOUNDARY OF LINE-CHAIN.
         B        LCENDQ            START TRACKING THE LINE-CHAIN.
LCLOOK   AW,R1    R6                PT AT NEXT HIGHER ENTRY.
         LS,R12   0,R1              IS IT LIVE...
         BEZ      LCENDQ              NO, A DELETED LINE PROBABLY.
         AI,R4    1                   YES, PT AT NEXT FUN-LINE PTR WD.
         AI,R10   1                 INCR LINE NUMBER.
         STW,R12  0,R4              SET THE FUNCTION-LINE PTR WD.
         LH,R12  *R1,R2             CK FOR LABEL NAME PTR ON THAT LINE.
         BEZ      LCENDQ              NO.
         AI,R11   -4                  YES, PT AT DATA BLK FOR THE LABEL.
         AI,R12   -1                    (MAKE EVEN NAMEPTR AGAIN)
         LCI      3
         STM,R8  *R11               ESTABLISH DATA BLK USING LINE NUMBER
         STW,R12  0,R5              PUT LABEL'S NAME PTR AND ITS
         STW,R11  1,R5                N-FLAGGED DATA BLK PTR IN
         AI,R5    2                   FUNC.DESCR. & PT AT NEXT WD.
LCENDQ   LH,R6   *R1,R3             = OFFSET TO NEXT HIGHER CHAIN ENTRY,
         BNEZ     LCLOOK              ZERO MEANS HI BOUNDARY ENTRY.
         LW,R6    STATEPTR          DELETE THE ENTIRE LINE CHAIN.
         STW,R6   TOPOSTAK
         LW,R14   NLCLS
         STW,R14  1,R4              SET 'LOCALS & LABELS' COUNT WORD.
         SW,R11   RESULT            = ACTUAL SIZE OF FUNCTION DESCRIPTOR
         LI,R4    1                   (IT INCLUDED LABEL DATA BLKS
         STH,R11 *RESULT,R4            ORIGINALLY, SO REVISE ACCORDING).
         SLS,R5   1                 PT AT HALFWD AFTER LAST LABEL-ENTRY.
         LI,R4    -1
SETLCLS  AI,R4    1                 = NO.OF LOCAL NAME PTRS SET, SO FAR.
         CH,R4    NLCLS             FINISHED SETTING THEM YET...
         BE       GLOBALIT            YES -- MAKE FUNC.DESCR. GLOBAL.
         LH,R8    LOCALS,R4           NO, SET NEXT LOCAL.
         STH,R8   0,R5
         AI,R5    1
         B        SETLCLS
GLOBALIT LI,R2    0                 CLEAR RESULT PTR.
         XW,R2    RESULT            R2 CONTAINS LOC OF NEW FUNC.DESCR.
         AW,R2    BITPOS-0          SET 'GLOBAL' BIT.
         LW,R6    FBLK+2            GET NAME PTR FOR NEW FUNCTION.
         LW,R4   *SYMT,R6           IS GLOBAL REF IN SYM TBL...
         BGEZ     SHADOWED            NO, ITS SHADOWED.
         STW,R2  *SYMT,R6             YES, MAKE NEW GLOBAL REF-IND.
         B        DOWNOLD
SHADOWED LW,R1    TOPOSTAK          PT AT TOP OF EXEC. STACK & FORGET IT
SHADY    AI,R1    1                 PT AT NEXT WD IN STACK.
         LW,R4    1,R1              LOOK AT ITS SUCCESSOR, PROFESSOR...
         BGEZ     SHADY               NOT A SHADOWED GLOBAL.
         CW,R6    0,R1                GLOBAL -- SAME NAME...
         BNE      SHADY                 NO, BUT ITS THERE SOMEWHERE.
         STW,R2   1,R1                  YES, REVISE THAT GLOBAL REF-IND.
DOWNOLD  BAL,R7   MAYDREF           DEREFERENCE ANY OLD FUN DESCR. PTR.
         LW,R4    FDEFPTR           ARE WE POINTING AT OLD ONE...
         BEZ      CLOSEOUT            NO.
         LI,R3    X'1FFFF'            YES, SET TO EXCHANGE REFERENCES
         LI,R5    X'1FFFF'              TO OLDIE WITH NEW OR SI DAMAGE.
         LW,R1    STATEPTR          PT AT TOP STATE-ENTRY.
         MTW,-1   1,R4              TEMPORARILY DECR OLDIE'S REF-COUNT.
         BGZ      XREFQ             LOOK FOR STACKED REFS. TO IT.
         B        XREFDONE
XREFN    LI,R11   X'7FFF'
         AND,R11  0,R1              PT AT NEXT STATE-ENTRY.
         AW,R1    R11
XREFQ    CS,R4    1,R1              IS IT A REFERENCE TO OLDIE.
         BNE      XREFN               NO.
         B       *XREFLOC             YES -- EXCHANGE OR DAMAGE.
DAMMSG   B        SIDAMF            DISPLAY -- SI DAMAGE, AFTER RESUMING
RFSIDAM  LI,R11   DAMAGE              SET TO DO DAMAGE.
         STW,R11  XREFLOC
         LI,R2    0
DAMAGE   STW,R2   1,R1              ZILCH THE WHOLE FDEFPTR WD.
         B        DECROLD
NODAMAGE STS,R2   1,R1              EXCHANGE FDEFPTR'S.
         MTW,1    1,R2              INCR NEW FUNC.DESCRIPTOR'S REF-COUNT
DECROLD  MTW,-1   1,R4              DECR OLDIE'S REF-COUNT.
         BGZ      XREFN             KEEP GOING IF REFS REMAIN IN STACK.
XREFDONE MTW,1    1,R4              DONE, FDEFPTR STILL PTS AT OLDIE.
         LI,R3    0
         STW,R3   FDEFPTR             OH NO, IT DOESN'T.
         BAL,R7   DREF              RELEASE OLDIE & ALL IT REFS EXCLUS.
CLOSEOUT LW,R3    MODE              IS THIS A FORCED-CLOSE...
         BLZ     *LINKFD              YES, RETURN.                      U15-0061
RECOMODE LI,R3    X'FFFF'             NO, RECOVER OLD MODE.             U15-0062
         AND,R3   OLDMODE                                               U15-0063
         STW,R3   MODE                                                  U15-0064
         B        CMDEXIT           EXIT FUNCTION DEFN MODE.            U15-0065
NOSPACE  LI,R14   EFLAG                                                 U15-0067
         CW,R14   OLDMODE           WAS THIS AN EXECUTED FUN DEFN...    U15-0068
         BANZ     WSFULL              YES, ABORT IT ON WS FULL.         U15-0069
         LW,R14   MODE              IS THIS A FORCED CLOSE...           U15-0070
         BEZ      BAKLC               NO, FIX LINE-CHAIN & RE-PROMPT.
         LW,R14   BREAKFLG            YES, WAS IT A LINE DISCONNECT...
         BGEZ     BAKLC                 NO, FORGET FORCED-CLOSE.
FORGETIT LI,R14   X'FFFF'               YES, RESTORE OLD MODE & ABANDON U15-0072
         AND,R14  OLDMODE                 THE FUN DEFN ATTEMPT.         U15-0073
         STW,R14  MODE                                                  U15-0074
ZAP      LI,R4    0                                                     U15-0075
         XW,R4    FDEFPTR           CLEAR ANY REFERENCE TO OLDIE.
         LI,R5    X'1FFFF'
         LI,R14   CATLC             LINE-CHAIN CATEGORY OF STACK ENTRY.
         BAL,R7   MAYDREF
ZAPLC    CB,R14  *TOPOSTAK          IS LINE-CHAIN ENTRY STILL ON TOP.
         BNE     *LINKFD              NO -- EXIT.
         LS,R4   *TOPOSTAK            YES, GET ITS LINE PTR, IF LIVE.
         MTW,3    TOPOSTAK          DROP THAT LINE-CHAIN ENTRY.
         AI,R4    -2                IF LIVE, PT AT CODESTR. DATA BLK HDR
         BGZ      DREF                LIVE -- DE-REF IT & GO TO ZAPLC.
         B        ZAPLC               DEAD.
FERASECK STW,R14  LINKFD            SAVE LINK FROM )ERASE CMND DRIVER.
         LW,R14   FBLK+2            GET NAME PTR OF CURRENT OPEN FUNCT.
         LW,R5    CONSTBUF          = NO.OF NAME PTRS FROM )ERASE CMND.
ERASENQ  CW,R14   CONSTBUF,R5       CK FOR MATCHING NAME PTR IN ERASE...
         BE       FORGETIT            YES, FORGET IT.                   U15-0077
         BDR,R5   ERASENQ
         B       *LINKFD              NO -- EXIT TO )ERASE CMND DRIVER.
BAKLC    LI,R3    3                 RESET LINE-CHAIN TO PT FROM HIGH
         LW,R1    HILINE              ENTRY TO NEXT LOWER ENTRY...
         AI,R1    -3
         LI,R5    0
BAKLCE   LH,R9   *R1,R3
         STH,R5  *R1,R3
         AW,R1    R9
         LCW,R5   R9
         BNEZ     BAKLCE
         STW,R5   MODE              INSURE FUN DEFN MODE.
         LI,R14   DOPROMPT          RE-PROMPT AFTER ISSUING -- WS FULL  U15-0079
         B        ERRFDWS             WHILE IN FUN DEFN MODE.
RFUNDEF  B       *R14  (RETURN FROM ERRFDWS,ERRFDSYM, OR SHOWFL--SEE
*                       EDITOK)
WSFULL   BAL,R14  ERRFDWS           ISSUE -- WS FULL.
ERRORCK  LI,R4    0                                                     U15-0081
         XW,R4    CURRCS            DE-REFERENCE ANY CURRENT CODESTRING.U15-0082
         BEZ      ERRORCKM                                              U15-0083
         AI,R4    -2                                                    U15-0084
         BAL,R7   DREF                                                  U15-0085
ERRORCKM LI,R14   RECOMODE          PREPARE FOR EXIT.                   U15-0086
         STW,R14  LINKFD            USE EXIT AS LINK IN CASE OF A ZAP.  U15-0088
         LW,R14   MODE              DID WE MAKE IT TO FUN DEFN MODE...  U15-0089
         BNEZ     ZAP                 NO, ABANDON THE ATTEMPT.          U15-0090
         LI,R14   EFLAG               YES.                              U15-0091
         CW,R14   OLDMODE           WAS THIS AN EXECUTED FUN DEFN...    U15-0092
         BANZ     ZAP                 YES, ABORT THE ATTEMPT.           U15-0093
         B        DOPROMPT            NO, RE-PROMPT.                    U15-0094
SYMFULL  LI,R14   ERRORCK           RETURN TO ERROR CHECK AFTER
         B        ERRFDSYM            ISSUING -- SYMBOL TABLE FULL.
ERDEFN   EQU      ERRDEFN           DEFINITION ERROR.
ERDIR    EQU      ERDEFN            DEFN ERROR IN DIRECTIVE ANALYSIS.   U15-0099
 PAGE
************************************************************************
 SPACE 2
Z        SET      %-FUNDEF@         SIZE OF FUNDEF MODULE IN HEX.
 SPACE
Z        SET      Z+Z/10*6+Z/100*96+Z/1000*1536  SIZE IN DECIMAL.
 SPACE 3
         END

