         TITLE    'SCMD-B00,08/22/73,DWG702985'
         SYSTEM   SIG7F
         CSECT    1
         PCC      0                 CONTROL CARDS NOT PRINTED.
SCMD@    RES      0                 ORIGIN OF SIMPLE-CMD MODULE.
*
*  REF'S  AND  DEF'S
*
         DEF      SCMD@             = START OF 'SCMD' MODULE.
         DEF      @WIDTH            WIDTH COMMAND PROCESSOR.
         DEF      @DIGITS           DIGITS COMMAND PROCESSOR.
         DEF      @ORIGIN           ORIGIN COMMAND PROCESSOR.
         DEF      @ERASE            ERASE COMMAND PROCESSOR.
         DEF      RESIDAM           RESUME ERASING AFTER SI DAMAGE.
         DEF      RERASE            RESUME ERASING.
         DEF      @GROUP            GROUP COMMAND PROCESSOR.
         DEF      @GRP              GRP COMMAND PROCESSOR.
         DEF      @FNS              FNS COMMAND PROCESSOR.
         DEF      @GRPS             GRPS COMMAND PROCESSOR.
         DEF      @VARS             VARS COMMAND PROCESSOR.
         DEF      @SIV              SIV COMMAND PROCESSOR.
         DEF      @SI               SI COMMAND PROCESSOR.
         DEF      @CATCH            CATCH COMMAND PROCESSOR.
         DEF      @OBSERVE          OBSERVE COMMAND PROCESSOR.
         DEF      FOROPEN           FORCED OPEN OF CLOSED FN.
 SPACE 2
*                             REFS TO PROCEDURE:
         REF      ACQCONLY          ACQUIRES CONSTANT ONLY.
         REF      ACQIT             ACQUIRES NAME OR NUMERIC ITEM.
         REF      ACQNAME           ACQUIRES A NAME.
         REF      ACQNB             ACQUIRES NON-BLANK CHAR.
         REF      ACQNXCC           ACQUIRES NEXT CHAR & CODE.
         REF      ALOCNONX          ALLOC DATA BLK: N WDS + HDR, EVEN
*                                     SIZE.  NON-EXECUTION MODE.
         REF      CMDERR            COMMAND ERROR.
         REF      CMDEXIT           COMMAND EXIT.
         REF      DREF              DE-REFERENCER.
         REF      DUMPLING          LINE OUTPUT ROUTINE.
         REF      ERBADCMD          ERROR -- BAD COMMAND.
         REF      ERRERASE          ERROR -- ... NOT ERASED.
         REF      FERASECK          CK FOR ERASE OF FUNC BEING DEFINED.
         REF      FINDNAME          FINDS A NAME, BUT WON'T CREATE NEW.
         REF      FUNLDISP          PUTS FUNC. NAME & LINE NO. IN IMAGE
         REF      GENCHAR           GENERATE CHARACTER (OR MNEMONIC)
         REF      GENNAME           GEN. NAME (EXPAND MNEM. IF PRESENT)
         REF      GENNAME0          (DITTO, BUT WITHOUT INDENTATIONS).
         REF      INPDIR            DIRECT INPUT HANDLER.
         REF      INPRET            INPUT DRIVER ENTRY PT.
         REF      ISVAL             DISPLAYS 'IS  ' & PARAMETER VALUE.
         REF      MAYDREF           DEREFERENCE IF R4 PTS AT A DATA BLK.
         REF      OUTORANG          EXIT (DUAL) FOR COMMON CMDS.
         REF      SETDIGIT          SET DIGITS,GET OLD VALUE
         REF      SETORG            SET NEW ORIGIN-GET OLD VALUE
         REF      SETWIDTH          SET WIDTH,GET OLD VALUE
         REF      SICLR             CLEARS STATE-INDICATOR TO GO-STATE.
         REF      SIDAME            SI DAMAGE DURING ERASE.
         REF      SQUEEZER          ENTRY IN APLINPUT TO SQUEEZE MNEM'S
         REF      XWLOCGLB          EXCHANGES LOCALS & GLOBALS.
*                             REFS TO CONTEXT:
         REF      BREAKFLG          BREAK FLAG.
         REF      CATCHTBL          CATCH TABLE.
         REF      CONSTBUF          CONSTANT BUFFER.
         REF      COPYSAVE          SCRATCH DBLWD.
         REF      DIGITS
         REF      GOSTATE           PT AT STATE-ENTRY TO CLEAR DOWN TO.
         REF      HICOL             HIGH COLUMN INDICATOR.
         REF      HICOMMON          HIGHEST ADDR. IN COMMON REGION.
         REF      IMAGE             IMAGE BUFFER.
         REF      MODE              EXECUTION MODE.
         REF      NAMEBUF           NAME BUFFER.
         REF      OBSERVE           OBSERVATION SETTING.
         REF      OBSFLAG           OBSERVE FLAG.
         REF      OPENFN            POINTER TO FNCT NAME OF FORCED CLOSE
         REF      ORIGIN            INDEX ORIGIN
         REF      RESULT            PTS AT A NEW DATA BLK.
         REF      SAVE312           SAVE AREA.
         REF      SICTRL            STATE-INDICATOR CONTROL SETTING.
         REF      STATEPTR          PTS AT TOP STATE-ENTRY IN XEQ STACK.
         REF      SYMT              PTS AT SYM TBL.
         REF      SYMTSIZE          NO.OF ENTRIES IN SYM TBL.
         REF      WIDTH
*                             REFS TO CONSTANTS:
         REF      BITPOS            TBL OF BITS--BITPOS-K = K-TH BIT.
         REF      BLANKS            BLANKS.
         REF      FUNTYPES          DBLWD -- RANGE OF USER-DEFD FUN TYPS
         REF      IDNOTGRP          ERROR I.D. FOR -- NOT GROUPED.
         REF      IDSYMFUL          ERROR I.D. FOR -- SYM TBL FULL.
         REF      IDWSFULL          ERROR I.D. FOR -- WS FULL.
         REF      MAXREAL           X'7FFFFFFF'
         REF      STACKOFF          OFFSET FROM HI COMMON TO XEQ STACK.
         REF      TEXTCLEA          'CLEA'
         REF      TEXTOFF           'OFF '
         REF      X1FFFF            X'1FFFF'
*
*  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
*
*  OTHER EQU'S
*
*
CATF     EQU      10                FUNCTION-STATE CATEGORY, STACK-ENTRY
QUAD     EQU      X'53'             INTERNAL (EBCDIC) CHAR -- QUAD.
NAMECODE EQU      23                CODESTRING DESIG -- ORDINARY NAME.
LASTCSV  EQU      138               LAST CODESTRING DESIGNATION = DUMMY.
PENDFLAG EQU      X'8000'           MARKS PENDENT STATE-ENTRIES IN STACK
TYPELOGL EQU      1                 DATA BLK TYPE = LOGICAL.
TYPELIST EQU      6                 DATA BLK TYPE = LIST.
TYPEGRP  EQU      X'11'             DATA BLK TYPE = GROUP.
*  CONSTANTS
*
         PAGE
*
* @WIDTH-CHANGE WIDTH AND(OR) REPORT OLD VALUE
*
@WIDTH   LI,R6    SETWIDTH          = WIDTH PARAMETER ROUTINE LOC.
         LW,R7    WIDTH             CURRENT WIDTH SETTING.
PARAMCMD STD,R6   COPYSAVE          SAVE PARAM. ROUTINE LOC & VALUE.
         BAL,R14  ACQCONLY          ACQ 1 CONSTANT ONLY, IF ANY...
         BL       ISVAL               NONE, DISPLAY 'IS  ' & VALUE.
         BG       ERBADCMD            TOO MANY -- BAD COMMAND.
         LI,R5    OUTORANG            OK, SET DUAL RETURN LOC AND
         B       *COPYSAVE                GO TO PARAMETER SET ROUTINE.
         PAGE
*
* @DIGITS-CHANGE DIGITS AND(OR) REPORT OLD VALUE
*
@DIGITS  LI,R6    SETDIGIT          = DIGITS PARAMETER ROUTINE LOC.
         LW,R7    DIGITS            CURRENT DIGITS SETTING.
         B        PARAMCMD
         PAGE
*
* @ORIGIN-CHANGE ORIGIN AND(OR) REPORT OLD VALUE
*
@ORIGIN  LI,R6    SETORG            = ORIGIN PARAMETER ROUTINE LOC.
         LW,R7    ORIGIN            CURRENT ORIGIN SETTING.
         B        PARAMCMD
 PAGE
*
* @ERASE-DRIVER TO ERASE NAMED GLOBAL OBJECTS FROM USERS WORKSPACE
*
@ERASE   LI,R14   0                 PRESET NAME COUNTER.
         STW,R14  CONSTBUF
         CI,R3    LASTCSV           DOE A NAME FOLLOW ')ERASE'...
         BLE      ERBADCMD            NO -- INCORR. CMND.
ERASEA   BAL,R8   FINDNAME          FIND THE NAME...
         B        ERASEB              NOT FOUND.
         MTW,1    CONSTBUF            FOUND, BUMP NAME COUNT.
         LW,R7    CONSTBUF
         STW,R6   CONSTBUF,R7       PUT ITS NAME PTR IN BUFFER.
ERASEB   CI,R3    LASTCSV           DOES ANOTHER NAME FOLLOW...
         BG       ERASEA              YES, LOOP BACK.
         AI,R2    -X'15'              NO, VERIFY END OF STMT...
         BNEZ     ERBADCMD              OOPS -- INCORR. CMND.
         LW,R2    MODE              IS THIS FUNC. DEFN MODE...
         BNEZ     ERASEC              NO.
         BAL,R14  FERASECK            YES, MAY ERASE THE OPEN FUNCTION.
ERASEC   BAL,R14  XWLOCGLB          EXCHANGE LOCALS & GLOBALS.
         LI,R1    0                 PRE-SET INDICATING
         STW,R1   SAVE312             NOT ON A GROUP.
         LW,R1    CONSTBUF          = # NAMES TO ERASE.
ERASED   LW,R6    CONSTBUF,R1       GET A NAME PTR.
         LW,R4    BITPOS-0          EXCHANGE ITS REFERENT-INDICATOR WITH
         XW,R4   *SYMT,R6             A CLEAR (GLOBAL-BIT ONLY) ONE,
         STW,R4   CONSTBUF,R1         AND SAVE THE REF-INDIC.
         AND,R4   X1FFFF            IS THERE A REFERENT...
         BEZ      ERASEJ              NO -- SKIP IT.
         LB,R14  *R4                  YES.
         CI,R14   TYPEGRP           IS IT A GROUP...
         BE       ERASEGRP            YEP.
         CLM,R14  FUNTYPES          IS IT A FUNCTION DESCRIPTOR...
         BCS,9    ERASEI              HOORAY, IT IS NOT.
         LW,R14   1,R4                DAMN, GET ITS REF-COUNT.
         AI,R14   -1                DECR IT; IF ONLY 1 REF, WE CAN
         BEZ      ERASEI              ERASE THE FUNCTION EASILY.
         LI,R12   PENDFLAG          OTHERWISE, CK FOR IT BEING PENDENT.
         LI,R5    X'1FFFF'
         LW,R2    STATEPTR
         B        ERASEF
ERASEE   LI,R3    X'7FFF'
         AND,R3   0,R2
         BEZ      PENDENT             NUTS, PENDENT (DYADIC WHOSE LEFT
         AW,R2    R3                                 ARG IS UNRESOLVED).
ERASEF   CS,R4    1,R2
         BNE      ERASEE
         CW,R12   0,R2
         BANZ     PENDENT             NUTS, PENDENT (CALLED FOR SOMETHIG
         BDR,R14  ERASEE                             & NOT RETURNED TO).
         MTW,-1   1,R4                OK, SUSPENDED ONLY, DECR REF-CNT
         LW,R2    STATEPTR              MOMENTARILY.
         B        ERASEH            DAMAGE EACH SUSPENSION.
ERASEG   LI,R3    X'7FFF'
         AND,R3   0,R2
         AW,R2    R3
ERASEH   CS,R4    1,R2
         BNE      ERASEG
         STW,R14  1,R2                (DAMAGED)
         MTW,-1   1,R4                (DECR REF-COUNT)
         BGZ      ERASEG
         MTW,1    1,R4              SET REF-COUNT BACK TO 1, FOR SYM TBL
         BAL,R7   DREF                AND DE-REF (DELETE) THE FUNCTION.
         B        SIDAME            ERROR -- SIDAMAGE,
RESIDAM  EQU      ERASEJ              RETURN AFTER DISPLAY OF ERR MSG.
PENDENT  LW,R4    CONSTBUF,R1       RESTORE THE ORIGINAL REFERENT-INDIC
         STW,R4  *SYMT,R6             BACK INTO THE FUNC.NAME SYM TBL
*                                     ENTRY.
         B        ERRERASE          ERROR -- NAME NOT ERASED,
RERASE   EQU      ERASEJ              RETURN AFTER DISPLAY OF ERR MSG.
ERASEI   BAL,R7   DREF              DE-REFERENCE THE ERASED REFERENT.
ERASEJ   BDR,R1   ERASED            LOOP TILL ERASE LIST EXHAUSTED.
         LW,R7    SAVE312           ARE WE WORKING ON A GROUP...
         BEZ      RXEXIT              NO.
         AI,R7    -1                  YES, DECR ITS NAME COUNT.
ERASEGQ  STW,R7   SAVE312           SAVE THAT COUNT & IF NOT ZERO
         BGZ      ERASEG1               ERASE ANOTHER NAME IN GROUP.
         LW,R1    SAVE312+2         DONE, RESTORE ORIG. ERASE LIST COUNT
         LW,R14   SAVE312+3           AND ITS 1ST NAME PTR.
         STW,R14  CONSTBUF+1
         LW,R6    SAVE312+1         GET GROUP'S NAME PTR, AND EXCHANGE
         LW,R4    BITPOS-0          (AGAIN) ITS SYM TBL REF-INDIC WITH A
         XW,R4   *SYMT,R6           CLEAR (GLOBAL-BIT ONLY) ONE.
         B        ERASEI            THEN GET RID OF THE GROUP ITSELF.
ERASEGRP LW,R14   SAVE312           IS THIS A GROUP IN A GROUP...
         BNEZ     ERASEI              YES -- DISPERSE IT.
         STW,R1   SAVE312+2           NO, SAVE CURRENT ERASE LIST COUNT.
         STW,R4  *SYMT,R6           PUT GROUP'S DB PTR BACK INTO SYM TBL
         STW,R6   SAVE312+1         SAVE NAME PTR TO THE GROUP.
         LW,R14   CONSTBUF+1        SAVE ERASE LISTS 1ST NAME PTR.
         STW,R14  SAVE312+3
         AI,R4    2                 PT AT COUNT FIELD OF THE GROUP
         LH,R7   *R4                GET ITS COUNT.
         B        ERASEGQ
ERASEG1  LW,R2    SAVE312+1         NAME PTR FOR GROUP ITSELF.
         LW,R3   *SYMT,R2           GET GROUP'S DATA BLK PTR AGAIN.
         AI,R3    2                 OFFSET TO ITS COUNT FIELD.
         LH,R6   *R3,R7             GET ONE OF ITS NAME PTRS. AND PUT
         STW,R6   CONSTBUF+1          IT IN 1ST POS.OF 'ERASE LIST'.
         LI,R1    1                 CLAIM ONLY 1 NAME PTR.
         LW,R14   MODE              IS THIS FUN DEFN MODE...
         BNEZ     ERASED              NO--ERASE THAT ONE.
         STW,R1   CONSTBUF            YES, ERASE AFTER CHECKING FOR
         LI,R14   ERASED                MATCH OF THE OPEN FUNC. NAME PTR
         B        FERASECK
RXEXIT   LI,R14   CMDEXIT           TAKE COMMAND EXIT AFTER
         B        XWLOCGLB            RE-EXCHANGING LOCALS & GLOBALS.
 PAGE
*
* @GROUP-DRIVER TO GATHER LISTED NAMES INTO A GROUP OR DISPERSE A GROUP
*
@GROUP   LI,R14   -1                PRESET NAME COUNTER.
         STW,R14  CONSTBUF
         CI,R3    LASTCSV           DOES A NAME-START FOLLOW ')GROUP'...
         BLE      ERBADCMD            NO -- INCORR. CMND.
GRPA     BAL,R12  ACQNAME           ACQ NAME IF POSSIBLE...
         B        GRPSYMFL            OOPS -- SYM TBL FULL.
         B        GRPWSFL             OOPS -- WS FULL.
         AI,R13   -NAMECODE           OK, VERIFY ORDINARY NAME...
         BNEZ     ERBADCMD              STOP OR TRACE NAME -- INCORR.CMD
         MTW,1    CONSTBUF          BUMP NAME COUNTER.
         LW,R7    CONSTBUF
         STW,R6   CONSTBUF+1,R7     SAVE ITS NAME PTR.
         CI,R3    LASTCSV           DOES ANOTHER NAME FOLLOW...
         BG       GRPA                YES.
         AI,R2    -X'15'              NO, VERIFY END OF LINE...
         BNEZ     ERBADCMD              NOPE -- INCORR. CMND.
         BAL,R14  XWLOCGLB          EXCHANGE LOCALS & GLOBALS.
         LW,R6    CONSTBUF+1        SET R6 = GROUP'S NAME PTR.
         LI,R5    X'1FFFF'          SET FOR SELECTIVE LOAD.
         LI,R4    0
         LW,R7    CONSTBUF          = NO.OF NAMES MINUS 1.
         BGZ      GRPB              (CREATE, REPLACE, OR EXPAND A GROUP)
         LS,R4   *SYMT,R6           (DISPERSE) GET REFERENT-INDICATOR...
         BEZ      RXEXIT              NONE -- ASSUME DISPERSED ALREADY.
         LB,R2   *R4                  OK, VERIFY IT'S A GROUP...
         AI,R2    -TYPEGRP
         BEZ      DISPERSE              BINGO -- DE-REFERENCE IT.
NOTGROUP LI,R14   ERNOTGRP          ISSUE DIAGNOSTIC AFTER
         B        XWLOCGLB            RE-EXCHANGING LOCALS & GLOBALS.
GRPWSFUL BAL,R14  XWLOCGLB          RE-EXCHANGE LOCALS & GLOBALS.
GRPWSFL  LI,R8    IDWSFULL          = ERROR I.D. FOR 'WS FULL'.
         B        CMDERR            CMD ERROR EXIT.
GRPSYMFL LI,R8    IDSYMFUL          = ERROR I.D. FOR 'SYM TBL FULL'.
         B        CMDERR            CMD ERROR EXIT.
GRPB     LS,R4   *SYMT,R6           GET REFERENT-INDICATOR...
         BEZ      GRPC                NONE -- CREATE NEW GROUP.
         LB,R14  *R4                  SOME -- REPLACE OR EXPAND GROUP.
         AI,R14   -TYPEGRP          VERIFY IT'S A GROUP...
         BNEZ     NOTGROUP            OOPS.
GRPC     LW,R11   CONSTBUF          = # NAMES IN THIS )GROUP LIST.
         LI,R10   0                 CLEAR GROUP-NAME REPETITION COUNT.
*                                     (SO WE CAN HANDLE EVEN WEIRDOS
*                                      LIKE ')GROUP G A G B G C G' ).
GRPD     CW,R6    CONSTBUF+1,R7     CK FOR REPEATED GROUP NAME PTR...
         BNE      GRPE                NO.
         AI,R10   -1                  YES, DECR REPETITION COUNT AND
         STW,R10  CONSTBUF+1,R7         REPLACE NAME PTR BY IT.
GRPE     BDR,R7   GRPD              WORK BACK THROUGH THE LIST.
         AW,R11   R10               = # NAMES GROUPED BY THE LIST.
         AI,R10   0                 ANY GROUP-NAME REPETITION...
         BEZ      GRPF                NO.
         AI,R4    0                   YES, DOES ITS GROUP ALREADY EXIST.
         BEZ      GRPF                  NO (STUPID GROUP CMND).
         AI,R4    2                     YES, ADD IN THE # NAMES IN THE
         AH,R11  *R4                         OLD GROUP.
GRPF     STH,R11  CONSTBUF          SET LENGTH OF NEW GROUP.
         AI,R11   2                 ACCT FOR LENGTH HALFWD & ROUND UP.
         SLS,R11  -1                = SIZE NEEDED FOR NEW GROUP DATA BLK
         BAL,R14  ALOCNONX          ALLOC IT & DB HDR...
         B        GRPWSFUL            OOPS -- WS FULL.
         STW,R4   RESULT              FINE, SAVE PTR TO NEW DATA BLK.
         LI,R14   TYPEGRP           MAKE IT A GROUP TYPE DATA BLK.
         STB,R14 *RESULT
         LI,R5    4                 PLUG IN THE NEW GROUP'S LENGTH.
         LH,R10   CONSTBUF
         STH,R10 *RESULT,R5
         INT,R7   CONSTBUF          GET LENGTH OF )GROUP CMND'S LIST.
GRPG     LW,R10   CONSTBUF+1,R7     (FROM RT TO LF) GET LIST'S NAME PTR
         BLZ      GRPI                OR REPETITION INDICATOR.
         AI,R5    1           NOTE--PLUG IN NAME PTRS IN REVERSE ORDER
         STH,R10 *RESULT,R5           WITH RESPECT TO CMND'S LIST.
GRPH     BDR,R7   GRPG
         LI,R2    0                 CLEAR & GET PTR TO NEW GROUP.
         XW,R2    RESULT
         LW,R4   *SYMT,R6           GET OLD REF-INDICATOR FOR THAT NAME.
DISPERSE LI,R3    X'1FFFF'          REPLACE OLD REF-INDIC BY PTR TO NEW
         STS,R2  *SYMT,R6             GROUP (BY ZERO IF A DISPERSE).
         LI,R7    RXEXIT            GO TO 'RXEXIT' AFTER DE-REFERENCING
         B        MAYDREF             ANY OLD GROUP INDICATED.
GRPI     AI,R10   1                 IS IT 1ST REPETITION...
         BNEZ     GRPH                NO, SKIP IT.
         LI,R2    0                                                     U17-0008
         LI,R3    X'1FFFF'            YES, IS THERE AN OLD GROUP OF THE
         LS,R2   *SYMT,R6               SAME GROUP-NAME REPEATED...
         BEZ      GRPH                    NOPE, SKIP IT.
         LI,R3    4                       YEP.
         LH,R14  *R2,R3             GET # NAME PTRS IN OLD GROUP.
         BEZ      GRPH                NONE, SKIP IT.
GRPJ     AI,R3    1
         LH,R10  *R2,R3             MOVE NAME PTRS FOR OLD GROUP INTO
         AI,R5    1                   THE NEW GROUP (RETAINING SAME
         STH,R10 *RESULT,R5           ORDER AS FOR OLD GROUP -- WHICH
         BDR,R14  GRPJ                WAS BACKWARDS FOR OLD GROUP'S
         B        GRPH                CMND LIST).
ERNOTGRP LI,R8    IDNOTGRP          ERROR I.D. FOR 'NOT GROUPED'.
         B        CMDERR            CMD ERROR EXIT.
 PAGE
************************************************************************
*                                                                      *
*  GAP -- PUTS BLANKS INTO IMAGE BUFFER FOR SPACING & COLUMNARIZATION  *
*        UNLESS -- WE ARE AT LEFT MARGIN OR REACH CURRENT WIDTH.       *
*        REGS:   R13 -- LINK, EXIT VIA *R13.                           *
*                R3  -- COLUMN INDICATOR.                              *
*                R7 IS VOLATILE                                        *
*                                                                      *
GAP      AI,R3    0                 ARE WE AT LEFT MARGIN...
         BEZ     *R13                 YES -- EXIT.
         LI,R7    ' '                 NO, GET A BLANKETY-BLANK BLANK.
GAPW     CW,R3    WIDTH             HAVE WE HIT WIDTH-SETTING...
         BGE     *R13                 YES -- EXIT.
         STB,R7   IMAGE,R3            NO, PLUG IN A BLANK.
         AI,R3    1                 INCR COLUMN INDICATOR.
         CI,R3    3                 IS IT A MULTIPLE OF 4...
         BANZ     GAPW                NOT YET.
         B       *R13                 YES -- EXIT.
 PAGE
*
* @GRP-DRIVER TO LIST NAMES OF OBJECTS IN A GROUP
*
@GRP     CI,R3    LASTCSV           DOES A NAME-START FOLLOW ')GRP'...
         BLE      ERBADCMD            NO -- INCORR. CMND.
         BAL,R8   FINDNAME            YES, FIND THE NAME...
         B        CMDEXIT               NOT FOUND -- EXIT.
         AI,R2    -X'15'                FOUND, VERIFY THAT ENDS THE CMND
         BNEZ     ERBADCMD                OOPS -- INCORR. CMND.
         STW,R6   CONSTBUF          OK, SAVE THE NAME PTR.
         BAL,R14  XWLOCGLB          EXCHANGE LOCALS & GLOBALS.
         LW,R6    CONSTBUF          GET THE REFERENT-INDICATOR FOR THE
         LI,R1    X'1FFFF'            NAMED ITEM...
         AND,R1  *SYMT,R6
         BEZ      RXEXIT                NONE -- SKIP IT.
         LB,R14  *R1                    OK, VERIFY REFERENT IS A GROUP.
         AI,R14   -TYPEGRP
         BNEZ     NOTGROUP                YUCK -- NOT GROUPED.
         AI,R1    2                 PT AT 1ST WD OF THE GROUPING, AND
         STW,R1   CONSTBUF            SAVE THAT LOC.
         LH,R1   *CONSTBUF          GET LENGTH OF THE GROUP...
         BEZ      RXEXIT              ZERO -- SKIP IT.
         LI,R3    0                 PRESET COLUMN INDICATOR.
GRPOUT   BAL,R13  GAP               GIVE SPACING & COLUMNARIZATION.
         LH,R8   *CONSTBUF,R1       FROM LAST NAME PTR TO FIRST, DELIVER
         STW,R1   CONSTBUF+1          TO 'GENNAME0' WHICH PUTS THE NAMES
         BAL,R13  GENNAME0            IN IMAGE BUFFER (NO INDENTATIONS)
         LW,R1    CONSTBUF+1          IN PROPER FORM, OUTPUTTING AS
         BDR,R1   GRPOUT              WHOLE LINES ARE FILLED UP.
         AI,R3    0                 WAS LAST LINE OUTPUT ALREADY...
         BEZ      RXEXIT              YES.
         LI,R12   RXEXIT              NO, GO TO 'RXEXIT' AFTER
         B        DUMPLING              OUTPUTTING LAST LINE.
 PAGE
************************************************************************
*                                                                      *
* QNAME -- COMPARES A TEST NAME-STRING AGAINST THE STRING IN CONSTBUF. *
*       REGS:    R7 -- LINK, EXITS: 0,R7 = HIGH  TEST STRING           *
*                                   1,R7 = EQUAL TEST STRING           *
*                                   2,R7 = LOW   TEST STRING           *
*                R6 -- (EXIT) = NO.OF WDS TO CONTAIN THE TEST STRING.  *
*                R1 -- (ENTRY) PTS AT A SYMBOL TABLE NAME-INDICATOR WD *
*                              AND HAS A 1 IN BYTE 0.  FOR A SHORT NAME*
*                                   THE NAME-INDIC. WD CONTAINS IT.    *
*                                   FOR A LONG NAME THE NAME-INDIC. WD *
*                                   CONTAINS A PTR TO THE 1ST WD OF THE*
*                                   NAME & BYTE 0 CONTAINS THE NO.OF   *
*                                   WDS USED TO CONTAIN THE NAME.      *
*                R9 -- (ENTRY) CONTAINS ALL BLANKS.                    *
*                R2 & R3 ARE VOLATILE.                                 *
*                                                                      *
QNAME    LW,R6    BREAKFLG          TEST FOR A BREAK OR HANG-UP...
         BNEZ     QBREAK              YES -- BREAK EXIT.
         LB,R6   *R1                GET BYTE 0 OF NAME-INDICATOR WD.
         CI,R6    20                IS IT LESS THAN A NAME-START CHAR...
         BLE      QNAMEL              YES, IT'S LONG NAME WD COUNT.
         LI,R6    1                   NO, SHORT NAME, USE WD COUNT OF 1.
         LW,R3    R1                SET 'DESTINATION' REG (WD RESOLUT'N)
         B        QNAMES
QNAMEL   LW,R3    0,R1              SET 'DESTINATION' REG (WD RESOLUT'N)
QNAMES   SLS,R3   2                 USE BYTE RESOLUTION.
         LI,R2    BA(CONSTBUF)      SET 'SOURCE' REG.
         CBS,R2   0                 TEST SOURCE VS DESTINATION STRINGS.
         BL       0,R7                LO -- EXIT, TEST-STRING IS HIGH.
         BG       2,R7                HI -- EXIT, TEST-STRING IS LOW.
         CW,R9    CONSTBUF,R6         EQUAL, IS 'SOURCE' A LONGER NAME.
         BNE      2,R7              YES -- EXIT, TEST-STRING IS LOW.
         B        1,R7              NO -- EXIT, NAMES ARE IDENTICAL.
 PAGE
*
* @FNS-DRIVER TO LIST NAMES OF FUNCTIONS IN USERS WORKSPACE
*
* @GRPS-DRIVER TO LIST NAMES OF GROUPS IN USERS WORKSPACE
*
* @VARS-DRIVER TO LIST NAMES OF GLOBAL VARIABLES IN USERS WORKSPACE
*
@FNS     LD,R10   FUNTYPES          = RANGE OF USER-DEFD FUNCTION TYPES.
         AI,R11   3                 EXPAND TO COVER INTRINSIC FUN TYPES.
         B        QSET
@GRPS    LI,R10   TYPEGRP           = RANGE OF GROUP TYPE DATA BLK TYPES
QSETGRP  LI,R11   TYPEGRP
         B        QSET
@VARS    LI,R10   TYPELOGL          = RANGE OF VARIABLE TYPES.
         LI,R11   TYPELIST
QSET     STD,R10  CONSTBUF+44       SAVE RANGE OF DB TYPES OF INTEREST.
         LI,R5    -11
         LW,R9    BLANKS            BLANK 22 WDS EACH OF THE
QSETA    STD,R9   CONSTBUF+22,R5      LO COMPARE STRING AND
         STD,R9   CONSTBUF+44,R5      HI COMPARE STRING.
         BIR,R5   QSETA
         STW,R5   CONSTBUF+47       ZERO (LEFT MARGIN) COL.INDIC. HOLDER
         LI,R5    '9'               SET THE HI COMPARE STRING BIGGER
         STB,R5   CONSTBUF+22         THAN ANY BREADBOX.
         CI,R2    X'15'             DOES CMND LINE END ALREADY...
         BE       QX                  YES.
         LI,R5    -80                 NO, MOVE UP TO 80 NEW CHARS INTO
QSETB    STB,R2   CONSTBUF+20,R5        THE LO COMPARE STRING.
         BAL,R4   ACQNXCC
         CI,R2    ' '               QUIT ON BLANK OR LESS.
         BLE      QSETC
         BIR,R5   QSETB
         B        ACQNXCC           SKIP IF OVER 80 CHARS.
QSETC    BAL,R4   ACQNB             GET 1ST NON-BLANK AFTER LO STRING.
         CI,R2    X'15'             DOES CMND LINE END NOW...
         BE       QX                  YES.
         LI,R5    -80                 NO, MOVE UP TO 80 NEW CHARS INTO
QSETD    STB,R2   CONSTBUF+42,R5        THE HI COMPARE STRING.
         BAL,R4   ACQNXCC
         CI,R2    ' '               QUIT ON BLANK OR LESS.
         BLE      QSETE
         BIR,R5   QSETD
         B        ACQNXCC           SKIP IF OVER 80 CHARS.
QSETE    BAL,R4   ACQNB             GET 1ST NON-BLANK AFTER HI STRING.
         AI,R2    -X'15'            VERIFY THAT ENDS THE CMND.
         BNEZ     ERBADCMD            OOPS -- INCORR. CMND.
QX       BAL,R14  XWLOCGLB          EXCHANGE LOCALS & GLOBALS.
         BAL,R7   QINIT             INIT. FOR SYMBOL COMPARISONS.
QSYMA    AI,R1    2                 PT AT A NAME-INDICATOR WD.
         LI,R5    X'1FFFF'          DOES THAT SYMBOL TABLE ENTRY HAVE A
         AND,R5   -1,R1               REFERENT...
         BEZ      QSYML                 NO, LEAVE ITS HIT-BIT = 0.
         LB,R10  *R5                    YES, GET REFERENT'S D.B. TYPE.
         CLM,R10  CONSTBUF+44       IS IT A TYPE WE ARE INTERESTED IN...
         BCS,9    QSYML               NO, LEAVE HIT-BIT = 0.
         BAL,R7   QNAME           @   YES, COMPARE NAME TO LO STRING...
         B        %+1             @     ABOVE (SET HIT-BIT = 1).
         AWM,R13  -1,R1           @     EQUAL (SET HIT-BIT = 1).
*                                 @     BELOW (LEAVE HIT-BIT = 0).
QSYML    BIR,R8   QSYMA             SWEEP THE WHOLE SYMBOL TABLE.
         LI,R5    -10
QSYMH    LD,R8    CONSTBUF+42,R5    REPLACE LO COMPARE STRING BY HI
         STD,R8   CONSTBUF+20,R5      COMPARE STRING.
         BIR,R5   QSYMH
         BAL,R7   QINIT             INIT. FOR SYMBOL COMPARISONS.
QSYMB    AI,R1    2                 PT AT A NAME-INDICATOR WD.
         CW,R13   -1,R1             TEST HIT-BIT...
         BAZ      QSYMZ               0 -- WE AREN'T INTERESTED.
         BAL,R7   QNAME           @   1 -- COMPARE NAME TO HI STRING...
         B        QHITOFF         @     ABOVE (SET HIT-BIT BACK = 0).
         B        %+1             @     EQUAL.
*                                 @     BELOW.
QSYMZ    BIR,R8   QSYMB             SWEEP THE WHOLE SYMBOL TABLE.
*
* NOTE --AT THIS PT ONLY SYM TBL ENTRIES WHOSE HIT-BIT = 1 ARE OF THE
*          RIGHT TYPE AND USE NAMES IN THE CORRECT RANGE.  EACH OF THOSE
*          NAMES WILL BE DISPLAYED IN (EBCDIC) ORDER.  WHEN DISPLAYED
*          THE CORRESPONDING HIT-BIT WILL BE SET = 0 TO AVOID USING
*          THAT NAME AGAIN.  WE QUIT WHEN ALL HIT-BITS ARE SET = 0.
*
QHUNT    LI,R7    QHUNTA            EXIT FROM QINIT TO QHUNTA.
QINIT    LW,R9    BLANKS            INSURE R9 = ALL BLANKS.
         LI,R13   X'40000'          INSURE R13 = HIT-BIT.
         LCW,R8   SYMTSIZE          = - NO.OF SYM TBL ENTRIES.
         LW,R1    SYMT              PT AT SYM TBL.
         STW,R1   CONSTBUF+46       SET 'CANDIDATE' FLAG POSITIVE.
         AI,R1    -1                PT 2 WDS AHEAD OF 1ST NAME-INDICATOR
         AW,R1    BITPOS-7          SET R1'S BYTE 0 TO A ONE (= NO.OF
*                                     WORDS NEEDED FOR SHORT NAMES).
         B        0,R7              EXIT.
QHITOFF  EOR,R13  -1,R1
         STW,R13  -1,R1             TURN OFF HIT-BIT.
         LI,R13   X'40000'          RESTORE R13 = HIT-BIT.
         B        QSYMZ
QHUNTA   AI,R1    2                 PT AT A NAME-INDICATOR WD.
         CW,R13   -1,R1             TEST HIT-BIT...
         BAZ      QHUNTZ              0 -- WE AREN'T INTERESTED.
         BAL,R7   QNAME           @   1, COMPARE NAME & LATEST CANDIDATE
         B        QHUNTZ          @     ABOVE (NOT INTERESTED YET).
         B        %+1             @     EQUAL (ONLY FAST HIT OF HI ONE).
         STW,R8   CONSTBUF+46     @     BELOW (SET 'CANDIDATE' FLAG TO
*                                              MINUS SYMTSIZE + COUNT).
         LI,R3    QMOVE             GO TO QMOVE AFTER SETTING UP BLANKS.
QRESETHI LI,R5    -10
         LW,R9    BLANKS
QBLANK   STD,R9   CONSTBUF+20,R5    BLANK THE CANDIDATE STRING.
         BIR,R5   QBLANK
         LI,R5    '9'               SET 1ST BYTE ABOVE ALL NAMES.
         STB,R5   CONSTBUF
         B        0,R3              EXIT.
QMOVE    CI,R6    1                 IS NEW CANDIDATE LONG OR SHORT...
         BG       QLONG               LONG.
         LW,R10   0,R1                SHORT, GET THAT NAME AND
         B        QCANDY                PUT IT IN CANDIDATE STRING.
QLONG    LW,R5    0,R1              PT AT 1ST WD OF LONG NAME.
         AI,R5    -1                BACK UP FOR INDEXING THRU THE NAME.
QLONGET  LW,R10  *R5,R6             GET NAME WDS (FROM LAST TO FIRST).
QCANDY   STW,R10  CONSTBUF-1,R6     PUT NAME WD IN CANDIDATE STRING.
         BDR,R6   QLONGET           LOOP TILL 1ST NAME WD REPLACES THE
*                                     'HI' WD OF CANDIDATE STRING.
QHUNTZ   BIR,R8   QHUNTA            SWEEP THE WHOLE SYMBOL TABLE.
         LW,R8    CONSTBUF+46       GET LATEST CANDIDATE FLAG...
         BLZ      QSCORE              MINUS -- GOTCHA.
         LW,R3    CONSTBUF+47         NOT, GET COLUMN INDICATOR...
         BEZ      RXEXIT                0 -- RE-EXCHANGE & EXIT.
         LI,R12   RXEXIT               NZ, GO TO RXEXIT AFTER.
         B        DUMPLING               DISPLAYING LAST LINE.
QBREAK   LW,R8    SYMTSIZE          ON BREAK OR HANG-UP,
         LW,R1    SYMT                PUT ALL HIT-BITS = 0.
         EOR,R13  MAXREAL+1         (MAXREAL+1 = -1) GET ALL BUT HIT-BIT
         LI,R12   0
QGBACK   LS,R12   0,R1
         STW,R12  0,R1
         AI,R1    2
         BDR,R8   QGBACK
         B        RXEXIT            EXIT TO RE-EXCHANGE LOCALS & GLOBALS
QSCORE   AW,R8    SYMTSIZE          GET ENTRY NO. FOR CANDIDATE.
         SLS,R8   1                 MAKE IT A NAME PTR.
         LW,R3    R8
         EOR,R13 *SYMT,R3
         STW,R13 *SYMT,R3           SET ITS HIT-BIT BACK = 0.
         LI,R13   X'40000'
         LW,R3    CONSTBUF+47       GET LATEST COLUMN INDICATOR.
         BAL,R13  GENNAME0          PUT NAME IN IMAGE BUFFER, NO INDENTS
         BAL,R13  GAP               PUT IN SPACING & COLUMNARIZATION.
         STW,R3   CONSTBUF+47       SAVE NEW COLUMN INDICATOR.
         LI,R3    QHUNT             START ANOTHER SYM TBL SWEEP AFTER
         B        QRESETHI            RESETTING THE CANDIDATE STRING TOO
*                                       HIGH (SO ANY NAME WILL DO).
 PAGE
*
* @SIV-DRIVER TO LIST STATE VECTOR AND ASSOCIATED LOCAL VARIABLES
*
* @SI-DRIVER TO LIST STATE VECTOR
*
@SIV     LI,R3    0                 FLAG THAT THIS IS AN )SIV CMND.
@SI      STW,R3   CONSTBUF          SAVE )SI VS )SIV FLAG.
         AI,R2    -X'15'            VERIFY END-OF-STMT.
         BNEZ     SIOPTION            NO, CK FOR SI CONTROL OPTION.
         LW,R1    STATEPTR          PT AT TOP STATE-ENTRY IN STACK.
SIA      STW,R1   CONSTBUF+1        SAVE CURRENT STATE PTR.
         LW,R2    BREAKFLG           HAS A BREAK OCCURRED...
         BNEZ     CMDEXIT              YES -- EXIT
         LI,R2    X'7FFF'           GET WD COUNT TO NEXT STATE-ENTRY.
         AND,R2   0,R1
         BEZ      CMDEXIT             ZERO (FINAL ENTRY) -- EXIT.
         STW,R2   CONSTBUF+2        SAVE IT.
         LI,R3    0                 PRESET COLUMN INDICATOR.
         LB,R14  *CONSTBUF+1        WHAT CATEGORY IS CURRENT STATE...
         AI,R14   -CATF
         BEZ      SIB                 FUNCTION ENTRY.
         LI,R7    QUAD                EVALUATED-INPUT ENTRY.
         LI,R13   SIF               GO TO 'SIF' AFTER
         B        GENCHAR             PUTTING A QUAD IN IMAGE BUFFER.
SIB      LW,R14   1,R1              IS THIS A DAMAGED FUNCTION ENTRY...
         BEZ      SIC                 YES, USE A BLANK FUNCTION NAME &
*                                          LINE NUMBER.
         BAL,R14  FUNLDISP            NO, SHOW FUNC.NAME & LINE NUMBER.
SIC      LI,R13   SID               WE MAY LOOP VIA 'GENCHAR'.
SID      LI,R7    ' '               SET A BLANK.
         CI,R3    6                 HAVE WE REACHED COLUMN 6...
         BL       GENCHAR             NO, PUT BLANK & LOOP.
         LI,R12   PENDFLAG          IS THIS A PENDENT FUNCTION...
         CW,R12  *CONSTBUF+1
         BANZ     SIE                 YES, PUT BLANK.
         LI,R7    '*'                 NO, PUT * TO SHOW SUSPENSION.
SIE      BAL,R13  GENCHAR
         LW,R13   CONSTBUF          TEST FLAG FOR )SIV CMND...
         BEZ      SIV                 IT IS -- SHOW ANY SHADOWED NAMES.
SIF      AI,R3    0                 ARE WE AT LEFT MARGIN...
         BEZ      SIG                 YES.
         BAL,R12  DUMPLING            NO, OUTPUT LAST IMAGE.
SIG      LW,R1    CONSTBUF+1
         AW,R1    CONSTBUF+2        PT AT NEXT STATE-ENTRY IN STACK.
         B        SIA
SIV      LW,R6    CONSTBUF+1        PT AT THE FUNCTION STATE-ENTRY.
         LW,R14   3,R6              GET NO.OF SHADOWED NAMES...
         BEZ      SIF                 NONE.
         AI,R6    2
SIW      BAL,R13  GAP               GIVE SPACING & COLUMNARIZATION.
         AI,R6    2                 PT AT SHADOWED NAME PTR.
         LW,R8    0,R6              GET THAT NAME PTR.
         BAL,R13  GENNAME
         BDR,R14  SIW
         B        SIF
SIOPTION BAL,R14  ACQIT             ACQUIRE OPTION NAME.
         LW,R8    NAMEBUF           GET OPTION...
         CW,R8    TEXTCLEA
         BE       SICLEAR             CLEAR.
         CW,R8    TEXTOFF
         BE       SIOFF               OFF.
         SW,R8    TEXTON              ON...
         BNEZ     ERBADCMD            (OOPS -- BAD COMMAND)
SIOFF    STW,R8   SICTRL            ON=0 & OFF=NZ=DON'T SUSP.FUN ON ERR.
         B        CMDEXIT
TEXTON   TEXT     'ON  '
SICLEAR  LW,R8    HICOMMON          PT AT LAST WD IN COMMON REGION.
         AI,R8    -STACKOFF         OFFSET TO 'FINAL' STATE ENTRY IN THE
         STW,R8   GOSTATE             STATE-INDICATOR.
         LI,R14   INPDIR            REQUEST DIRECT INPUT AFTER
         B        SICLR               CLEARING THE STATE-INDICATOR.
 PAGE
*
* @CATCH-DRIVER TO 'CATCH' ASSIGNMENTS TO A VARIABLE NAME
*
@CATCH   CI,R2    X'15'             CK FOR END-OF-STMT...
         BNE      CATCH               NO, SET A CATCH.
         STW,R6   CATCHTBL            YES, CLEAR ANY CATCHES.
         STW,R6   CATCHTBL+2  NOTE--R6 IS NEGATIVE.
         B        CMDEXIT           EXIT.
CATCH    CI,R3    LASTCSV           DOES A NAME-START FOLLOW )CATCH...
         BLE      ERBADCMD            NO -- BAD COMMAND.
         BAL,R12  ACQNAME           ACQ VARIABLE NAME IF POSSIBLE...
         B        GRPSYMFL            OOPS -- SYM TBL FULL.
         B        GRPWSFL             OOPS -- WS FULL.
         STW,R6   CONSTBUF            OK, SAVE NAME PTR.
         BAL,R14  ACQIT             ACQ 'VIA'...
         LW,R8    NAMEBUF
         CW,R8    TEXTVIA
         BNE      ERBADCMD            DIDN'T -- BAD COMMAND.
         CI,R3    LASTCSV             DID, DOES NAME-START FOLLOW VIA...
         BLE      ERBADCMD              NO -- BAD COMMAND.
         BAL,R12  ACQNAME           ACQ FUNCTION NAME IF POSSIBLE...
         B        GRPSYMFL            OOPS -- SYM TBL FULL.
         B        GRPWSFL             OOPS -- WS FULL.
         LW,R7    CONSTBUF            OK, GET VARIABLE NAME PTR AGAIN.
         LI,R5    -4                = SIZE OF CATCHTBL.
CATCHN   LW,R12   CATCHTBL+4,R5     IS CATCH TBL ENTRY IN USE...
         BLZ      CATCHV              NO, FILL IT IN.
         CW,R7    CATCHTBL+4,R5       YES, FOR SAME VARIABLE NAME...
         BE       CATCHF                YEP, JUST CHANGE FUNC.NAME PTR.
         AI,R5    2                     NOPE, TRY NEXT ENTRY.
         BLZ      CATCHN
         B        ERBADCMD          NO ROOM -- BAD COMMAND.
CATCHV   STW,R7   CATCHTBL+4,R5     FILL VARIABLE NAME PTR ENTRY.
CATCHF   STW,R6   CATCHTBL+5,R5     FILL FUNCTION NAME PTR ENTRY.
         B        CMDEXIT           EXIT.
TEXTVIA  TEXT     'VIA '
 PAGE
*
* @OBSERVE-DRIVER TO 'OBSERVE' INTERMEDIATE RESULTS
*
@OBSERVE AI,R2    -X'15'            VERIFY END-OF-STMT.
         BNEZ     ERBADCMD            OOPS -- BAD COMMAND.
         LI,R2    -2                PREPARE FOR DIRECT INPUT MODE.
         LI,R5    PENDFLAG
         CW,R5   *STATEPTR          IS TOP STATE PENDENT...
         BAZ      OBSERVES            NO, DIRECT INPUT COMING UP.
         LI,R2    -1                  YES, EXECUTION NOW IN PROGRESS.
         STW,R2   OBSERVE           TURN ON OBSERVATION SETTING.
OBSERVES STW,R2   OBSFLAG           SET OBSERVE-CMD FLAG: -2 OR -1
         B        CMDEXIT             SO IT WILL BE -1 DURING NEXT EXEC.
         PAGE
*
*  FOROPEN-FORCED OPEN-ROUTINE TO FORE REOPEN OF FUNCTION WHICH
*          HAS BEEN FORCED CLOSE
*
*          ISSUES MESSAGE- DEL AND FUNCTION NAME (WITH CR)
*          SIMULATES INPUT OF ISSUED MESSAGE
*          GOES TO DIRECT INPUT DRIVER TO HANDLE INPUT
*          (CODESTRINGER WILL RECOGNIZE OPENING DEL AND OPEN FN)
*
*        OW ENTRY, OPENFN HAS NAME OF CLOSED FUNCTION
*
*        REGISTERS ARE USED PROLIFICALLY AND NOT SAVED
*
*
FOROPEN  LW,R7    BLANKS            BLANK PROMPT
         STD,R7   IMAGE
         LI,R3    6
         LI,R7    X'7F'             APL-DEL
         BAL,R13  GENCHAR            OUTPUT IT (OR MNEMONIC)
         LI,R7    X'40'             BLANK
         BAL,R13  GENCHAR
         LW,R8    OPENFN            GET NAME PTR OF FN TO BE OPENED
         BAL,R13  GENNAME
         STW,R3   HICOL             SAVE CHARACTER COUNT FOR SQUEEZER
         BAL,R12  DUMPLING          OUTPUT THE LINE
         LB,R11   OPENFN            RECOVER OLD MODE,                   U17-0010
         BNEZ     REMODE              IF PRESENT;                       U17-0011
         LI,R11   1                   OTHERWISE, ASSUME DIRECT MODE.    U17-0012
REMODE   STW,R11  MODE                                                  U17-0013
         LI,R11   INPRET+1          SET EXIT FROM 'APLINPUT'(SQUEEZER)
         STW,R11  SAVE312+8          USE TAIL-END OF APLINPUT ROUTINE
         B        SQUEEZER            TO REDUCE MNEMONIC IF PRESENT
 PAGE
************************************************************************
 SPACE 2
Z        SET      %-SCMD@           SIZE OF SCMD MODULE IN HEX.
 SPACE
Z        SET      Z+Z/10*6+Z/100*96+Z/1000*1536  SIZE IN DECIMAL.
 SPACE 3
         END

