         TITLE    'INTRINS-B00,08/22/73,DWG702985'
         SYSTEM   SIG7F
         CSECT    1
         PCC      0                 CONTROL CARDS NOT PRINTED.
INTRINS@ RES      0                 ORIGIN OF INTRINSIC FUNCTIONS MODULE
*
*  REF'S  AND  DEF'S
*
         DEF      INTRINS@          = START OF INTRINS MODULE.
         DEF      MIBEAM            MONADIC I-BEAM FUNCTIONS.
         DEF      MTBAR             MONADIC T-BAR FUNCTION.
         DEF      DTBAR             DYADIC T-BAR FUNCTION.
         DEF      MINTRIN           MONADIC -- INTRINSIC FUNCTIONS.
         DEF      DINTRIN           DYADIC  -- INTRINSIC FUNCTIONS.
         DEF      NINTRIN           NILADIC -- INTRINSIC FUNCTIONS.
         DEF      QZOUT             STARTS QUAD-0 (GRAPHICS) OUTPUT.
         DEF      QZOUTRET          RESUMES AFTER QUAD-0 OUTPUT.
         DEF      QZIN              STARTS QUAD-0 (GRAPHICS) INPUT.
         DEF      QZINRET           RESUMES AFTER QUAD-0 INPUT.
         DEF      MXRETURN  RETURNS: MONADIC INTRINSIC OR OPERATOR,
         DEF      DXRETURN           DYADIC INTRINSIC OR OPERATOR,
         DEF      NIRETURN           NILADIC INTRINSIC,
         DEF      SXRETURN           SUBSCRIPTING,
         DEF      AXRETURN           ASSIGNED INDEXING,
         DEF      XEQNIL             NO CODESTRING 'EXECUTE' OPERATION.
         DEF      BCBRANCH          CLR BREAK & DO ERR-CTRL BRANCH.
         DEF      ECBRANCH          DO ERR-CTRL BRANCH.
         DEF      IV1               GET INTEGER NO. FROM RT ARG.
         DEF      OPBREAK           BRK DURING OPERATOR EXECUTION.
         DEF      ERLSERR           LINE-SCAN ERR (DURING EXECUTION).
         DEF      ERSYN             SYNTAX ERROR.
         DEF      ERUND             UNDEFINED.
         DEF      ERNOR             NO RESULT.
         DEF      ERIO              I/O ERR (DURING CODESTRING EXECUT'N)
         DEF      ERDOMAIN          DOMAIN ERROR.
         DEF      ERRANK            RANK ERROR.
         DEF      ERLENGTH          LENGTH ERROR.
         DEF      ERWSFUL           WS FULL.
         DEF      ERSING            SINGULAR MATRIX.
         DEF      ERFORMAT          FORMAT ERROR.
         DEF      ERINDEX           INDEX ERROR.
         DEF      ERXEQ             ERROR DURING AN 'EXECUTE' OPERATION.
         DEF      ERTERMAL          WRONG TERMINAL
         DEF      ERFILEIO          FILE I/O ERR (IDENTIFIED BY R2).
 SPACE 3
*                             REFS TO PROCEDURE:
         REF      ERRN              GEN. VECTOR -- ERROR NO. & LINE NO.
         REF      ERRF              GEN. VECTOR -- ERROR FUN.NAME.
         REF      ERRX              GEN. VECTOR -- HEX I/O ERR CODE.
         REF      LOBRNCK           START ERR-CTRL BRANCH CHECKING.
         REF      TIMODAY           TIME-OF-DAY.
         REF      DATE              DATE.
         REF      CPUTIME           CPU TIME.
         REF      OVERTIME          OVERHEAD TIME.
         REF      UNSYMS            UNUSED SYMBOLS.
         REF      NUMUSERS          NUMBER OF USERS.
         REF      SETWIDTH          SETS WIDTH.
         REF      SETDIGIT          SETS DIGITS.
         REF      SETORG            SETS ORIGIN.
         REF      SETFUZZ           SETS FUZZ.
         REF      TABSET            SETS TABS.
         REF      DELAYER           DELAYS EXECUTION.
         REF      DELTAGRF          DELTA-GRF =GRAPHIC SERVICES ROUTINE.
         REF      DELTAFMT          DELTA FMT (SPECIAL OUTPUT FORMATTER)
         REF      FILEOPS           INTRINSIC-OP USED BY FILE I/O SUB-
*                                     SYSTEMS.
         REF      RETURNMX  RESUME AFTER: MONADIC
         REF      RETURNDX                DYADIC
         REF      RETURNNI                NILADIC
         REF      RETURNSX                SUBSCRIPTING
         REF      RETURNAX                ASSIGNED INDEXING
         REF      XEQEMPTY                NIL 'EXECUTE'
         REF      QOUTRET                 QUAD-0 (GRAPHICS) OUTPUT.
         REF      QDBDONE                 QUAD-0 (GRAPHICS) INPUT.
         REF      QZOUTPUT          QUAD-0 (GRAPHICS) OUTPUT ROUTINE.
         REF      QZINPUT           QUAD-0 (GRAPHICS) INPUT ROUTINE.
         REF      ERRSET            ERROR HANDLER.
         REF      DREF              DE-REFERENCER.
         REF      MAYDREF           DE-REFS IF R4 IS NON-ZERO.          U05-0004
         REF      SYSTERR           SYSTEM ERROR (UNIMPLEMENTED INTRINS)
         REF      ALOCBLK           ALLOCATES A DATA BLOCK.
         REF      ALOCHNW           ALLOCS DATA BLK -- HDR + N WDS, EVEN
         REF      ALOCTRES          ALLOCS A TEXT RESULT DATA BLK.
         REF      F2I               FLOATING-TO-INTEGER CONVERTER.
*                             REFS TO CONTEXT:
         REF      LOGONTIM          LOG-ON TIME.
         REF      TERMTYPE          TERMINAL TYPE.
         REF      USERACCT          USER'S ACCOUNT.
         REF      RANDOM            RANDOM VALUE.
         REF      OPER              DBLWD TEMP FOR OPERATOR INFO.
         REF      ON%OFF            ON-LINE VS BATCH FLAG (1 VS 0).
         REF      BREAKFLG          BREAK FLAG (0 = CLEAR).
         REF      XSEGBRK           EXECUTION SEGMENT BREAK TRIGGER.
         REF      OFFSET            USED TO SET 'ERROR POSITION'.
         REF      LBLOCK            PTS AT LOOP-CONTROL BLOCK.
         REF      RTARG             PTS AT RT ARG'S DATA BLOCK.
         REF      LFARG             PTS AT LF ARG'S DATA BLOCK.
         REF      RESULT            PTS AT RESULT'S DATA BLOCK.
         REF      RSTYPE            HOLDS TYPE -- USUALLY FOR RESULT.
         REF      RSRANK            HOLDS RANK -- USUALLY FOR RESULT.
         REF      RSSIZE            HOLDS SIZE -- USUALLY FOR RESULT.
         REF      CONSTBUF          USED AS A TEMP STORAGE BLK.
         REF      DYNBOUND          PTS AT HI BOUND OF DYNAMIC AREA.
         REF      FREETOTL          # UNUSED WDS IN CURR. DYNAMIC AREA.
         REF      TOPOSTAK          PTS AT TOP OF EXECUTION STACK.
         REF      STATEPTR          PTS AT TOP STATE-ENTRY IN STACK.
 SPACE 3
*
*  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
*
TYPETEXT EQU      2                 DATA BLK TYPE -- TEXT.
TYPELOGL EQU      1                                  LOGICAL.
TYPEINTG EQU      3                               -- INTEGER.
TYPEXSEQ EQU      5                               -- INDEX SEQUENCE.
CATQ     EQU      7                 EXEC.STACK CATEGORY FOR EVAL-INPUT.
DYINT    EQU      14                DYADIC INTRINSIC TYPE.
NYINT    EQU      16                NILADIC INTRINSIC TYPE.
FLINFLG  EQU      X'10000'          FUNCTION-LINE FLAG BIT (S-CATEGORY).
*
*  DOUBLEWORD CONSTANTS
*
DELAYRNG DATA     1,86400           DELAY RANGE -- 1 SECOND TO 1 DAY.
ONE      EQU      DELAYRNG          = 1
INTRANGE DATA     DYINT,NYINT       INTRINSIC FUNCTION TYPE RANGE.
*
*  OTHER CONSTANTS
*
24HRS    DATA     5184000           # 60THS OF A SECOND IN ONE DAY.
 PAGE
 PAGE
OPBREAK  BAL,R2   SETERR     -1   @ BREAK
ERLSERR  BAL,R2   SETERR      0   @ LINE-SCAN ERR ('SYNTAX ERR')
ERSYN    BAL,R2   SETERR      1   @ SYNTAX ERROR
ERUND    BAL,R2   SETERR      2   @ UNDEFINED
ERNOR    BAL,R2   SETERR      3   @ NO RESULT
ERIO     BAL,R2   SETERR      4   @ I/O ERROR
ERDOMAIN BAL,R2   SETERR      5   @ DOMAIN ERROR
ERRANK   BAL,R2   SETERR      6   @ RANK ERROR
ERLENGTH BAL,R2   SETERR      7   @ LENGTH ERROR
ERWSFUL  BAL,R2   SETERR      8   @ WS FULL
ERSING   BAL,R2   SETERR      9   @ SINGULAR MATRIX
ERFORMAT BAL,R2   SETERR     10   @ FORMAT ERROR
ERINDEX  BAL,R2   SETERR     11   @ INDEX ERROR
ERXEQ    BAL,R2   SETERR     12   @ ERROR DURING AN EXECUTE-OPERATION.
*
ERFILEIO EQU      SETERR2  R2 SET   FILE I/O ERR (R2 SAYS WHICH ONE).
ERTERMAL EQU      SETERR2  R2 SET   WRONG TERMINAL
 SPACE
SETERR   AI,R2    -OPBREAK-2        SET ERROR I.D.
SETERR2  LI,R3    0                 CLEAR EXECUTION-SEGMENT BREAK
         STW,R3   XSEGBRK             TRIGGER.
         INT,R3   OPER+1            SET BYTE OFFSET IN CURR. CODESTRING
         STW,R3   OFFSET              AT WHICH ERROR WAS DETERMINED.
         B        ERRSET            DO ERROR HANDLING.
 PAGE
*
*  I N T E R F A C E S    T O    R E S U M E    E X E C U T I O N
*
*    A F T E R    S U C C E S S F U L    O P E R A T I O N . . .
*
XEQNIL   B        XEQEMPTY          ASSUME EMPTY RESULT FOR AN 'EXECUTE'
NIRETURN LI,R4    0                 NILADIC INTRINSIC COMPLETED.
         STW,R4   XSEGBRK             (CLR EXEC.SEGMENT BREAK TRIGGER)
         LW,R3    OPER+1              (RESTORE CODESTRING OFFSET)
         B        RETURNNI            (RESUME -- R4 = 0)
SXRETURN LI,R4    0                 SUBSCRIPTING COMPLETED.
         STW,R4   XSEGBRK             (CLR EXEC.SEGMENT BREAK TRIGGER)
         XW,R4    LBLOCK
         BAL,R7   MAYDREF             (DE-REF. ANY LOOP CONTROL BLOCK)  U05-0006
         LW,R3    OPER+1              (RESTORE CODESTRING OFFSET)
         B        RETURNSX            (RESUME)
AXRETURN LI,R4    0                 ASSIGNED-INDEXING COMPLETED.
         STW,R4   XSEGBRK             (SEE COMMENTS FOR SXRETURN)
         XW,R4    LBLOCK
         BAL,R7   MAYDREF                                               U05-0008
         LW,R3    OPER+1
         B        RETURNAX
         LI,R4    0               @ MON.OP (USING LBLOCK) COMPLETED.
         STW,R4   XSEGBRK         @   (SEE COMMENTS FOR SXRETURN)
         XW,R4    LBLOCK          @
         BAL,R7   DREF            @
MXRETURN LI,R2    0               @ MONADIC OPERATION COMPLETED.
         STW,R2   XSEGBRK             (CLR EXEC.SEGMENT BREAK TRIGGER)
         B        RETURNMX            (RESUME WITH R2 = 0)
         LI,R4    0               @ DY.OP (USING LBLOCK) COMPLETED.
         STW,R4   XSEGBRK         @   (SEE COMMENTS FOR SXRETURN)
         XW,R4    LBLOCK          @
         BAL,R7   DREF            @
DXRETURN LI,R2    0               @ DYADIC OPERATION COMPLETED.
         STW,R2   XSEGBRK             (CLR EXEC.SEGMENT BREAK TRIGGER)
         B        RETURNDX            (RESUME WITH R2 = 0)
 PAGE
************************************************************************
*                                                                      *
* BCBRANCH -- CLEARS BREAK FLAG & DOES ERROR-CONTROL BRANCH, ON ENTRY  *
*       R12 = MINUS THE CONTENTS OF BREAKFLG.                          *
* ECBRANCH -- DOES ERROR-CONTROL BRANCH.                               *
*       REGS:    R1  (ENTRY) PTS AT PENDENT FUNCTION STATE THAT IS     *
*                            TAKING ERROR CONTROL (TOP OF STACK).      *
*                R12 (EXIT) = FLINFLG -- AS IF BRANCH IS FROM INSIDE   *
*                                        THAT FUNCTION: STOP WILL BE   *
*                                        HONORED IF ENCOUNTERED.       *
*                OTHER REGS MAY BE REGARDED VOLATILE.                  *
*                                                                      *
BCBRANCH AWM,R12  BREAKFLG          CLEAR THE BREAK.
ECBRANCH LI,R12   FLINFLG           SET R12 AS IF FUNCTION DID BRANCH.
         B        LOBRNCK           START BRANCH CK FOR ERR-CTRL FUNC.
 PAGE
*
*  G R A P H I C S    I N T E R F A C I N G . . .
*
QZOUT    B        QZOUTPUT          START GRAFIX OUTPUT.
QZOUTRET LI,R4    0                 RESUME AFTER GRAFIX OUTPUT.
         XW,R4    RTARG               (DEREF. RT. ARG. PTR)
         BAL,R7   DREF
         LW,R3    OPER+1            RESTORE CS OFFSET TO THE QUAD-0.
         B        QOUTRET           RESUME CODESTRING EXECUTION.
 SPACE 2
QZIN     B        QZINPUT           START GRAFIX INPUT.
QZINRET  RES      0                 RESUME AFTER GRAFIX INPUT.
         LW,R1    TOPOSTAK          PT AT TOP OF EXEC.STACK.
         LW,R3    OPER+1            RESTORE CS OFFSET TO THE QUAD-0.
         B        QDBDONE           RESUME CODESTR.XEQ WITH RESULT SET.
 PAGE
************************************************************************
*                                                                      *
*  IV1 -- GETS A SINGLE INTEGER VALUE FROM RT ARG'S DATA BLOCK.        *
*        DOMAIN ERROR IF RT ARG:  IS TEXT OR LIST TYPE                 *
*                                 IS REAL AND VALUE IS NOT WITHIN FUZZ *
*                                   OF AN INTEGER.                     *
*        LENGTH ERROR IF RT ARG HAS MORE THAN 1 ELEMENT OR IS EMPTY.   *
*                                                                      *
*        REGS:   R14 -- LINK, EXIT VIA *R14.                           *
*                R2  -- (EXIT) CONTAINS RT ARG'S DATA BLK TYPE.        *
*                R7  -- (EXIT) CONTAINS THE INTEGER VALUE (ALSO STORED *
*                              IN 'CONSTBUF')                          *
*                R1,R4,R5,R6,R8  ARE VOLATILE (SEE ALSO 'F2I').        *
*                                                                      *
IV1      LW,R4    RTARG             PT AT WD AFTER RT ARG'S REF-COUNT.
         AI,R4    2
         LI,R1    1
         LB,R8   *RTARG,R1          GET RT ARG'S RANK...
         BEZ      IV1OK               SCALAR.
IV1Q     AI,R4    1                   ARRAY, VERIFY LENGTHS ARE 1...
         CW,R1    -1,R4
         BNE      ERLENGTH              NOT -- LENGTH ERROR.
         BDR,R8   IV1Q
IV1OK    LW,R7    0,R4              GET (SUPPOSED) VALUE WD.
         LB,R2   *RTARG             GET RT ARG'S TYPE.
IV1TYPE  B        IV1TYPE,R2      @ VECTOR ON TYPE: 0 -- IMPOSSIBLE.
         B        IV1LOGL         @                 1 -- LOGICAL.
         B        ERDOMAIN        @                 2 -- TEXT.
         B        IV1INTG         @                 3 -- INTEGER.
         B        IV1REAL         @                 4 -- REAL.
         B        IV1XSEQ         @                 5 -- INDEX SEQUENCE.
         B        ERDOMAIN        @                 6 -- LIST.
IV1LOGL  SLS,R7   -31               GET THE LOGICAL VALUE.
         B        IV1INTG
IV1XSEQ  AW,R7    1,R4              ADD COEFFICIENT TO BIAS.
         B        IV1INTG
IV1REAL  AI,R4    1                 PT AT NEXT WD (ODD OR EVEN OK).
         SLS,R4   -1                PT AT REAL DBLWD VALUE.
         LD,R6    0,R4              GET REAL VALUE.
         BAL,R5   F2I               CONVERT TO INTEGER IF POSSIBLE...
         B        ERDOMAIN            NO LUCK -- DOMAIN ERROR.
IV1INTG  STW,R7   CONSTBUF            OK, SAVE INTEGER VALUE.
         B       *R14               EXIT.
 PAGE
 SPACE
MIBEAM   BAL,R14  IV1               GET SINGLE INTEGER ELEMENT.         U05-0010
         AI,R7    -19               OFFSET BY MINIMUM ACCEPTED NO.      U05-0011
         BLZ      NEGIBEAM            OOPS, TRY NEGATIVE I-BEAM.
         CI,R7    29-19             VERIFY NOT TOO BIG...               U05-0013
         BLE      IGO,R7              OK, TAKE CORRESPONDING BRANCH.    U05-0014
         B        ERDOMAIN            OOPS -- DOMAIN ERROR.
IGO      B        I19             @  SESSION TIME.
         B        I20             @  TIME OF DAY.
         B        I21             @  CPU TIME.
         B        I22             @  BYTES OF WORKSPACE REMAINING.
         B        I23             @  NUMBER OF USERS.
         B        I24             @  LOG-ON TIME.
         B        I25             @  DATE
         B        I26             @  TOP LINE NO.
         B        I27             @  VECTOR OF LINE NOS.
         B        I28             @  TERMINAL TYPE.
*        B        I29             @  USER'S ACCOUNT.
I29      LI,R11   6               @ ALLOCATE A 6-WD DATA BLK.
         BAL,R7   ALOCBLK
         STW,R4   RESULT            SAVE PTR TO RESULT DATA BLK.
         LI,R11   (TYPETEXT**8)+1   TYPE = TEXT   RANK = 1 (VECTOR).
         STH,R11 *RESULT
         LI,R11   8                 LENGTH = 8.
         LW,R12   USERACCT          USER'S ACCOUNT (8 CHARS, POSSIBLY
         LW,R13   USERACCT+1          INCLUDING TRAILING BLANKS).
         LCI      3
         STM,R11  2,R4              FILL IN LENGTH AND ACCOUNT.
         B        MXRETURN          RETURN FROM MONADIC-OP EXECUTION.
I19      BAL,R14  TIMODAY           GET TIME-OF-DAY (R11) 60THS OF SEC.
         SW,R11   LOGONTIM          SUBTRACT LOG-ON-TIME.
         BGEZ     SCLRRES           = SESSION TIME...
         AW,R11   24HRS               OOPS, CORRECT FOR MIDNITE CROSSED.
         B        SCLRRES           ITS A SCALAR RESULT.
I20      LI,R14   SCLRRES           SCALAR RESULT IN R11 IS
         B        TIMODAY             TIME-OF-DAY IN 60THS OF SEC.
I21      LI,R14   SCLRRES           SCALAR RESULT IN R11 IS
         B        CPUTIME             CPU TIME IN 60THS OF SEC.
I22      LW,R11   TOPOSTAK
         SW,R11   DYNBOUND          = # WDS BETWEEN STACK & END OF DYN.
         AW,R11   FREETOTL          + UNUSED WDS OF DYNAMIC.
         SLS,R11  2                 IN BYTES.
         AI,R11   -64               WITH 64-BYTE CUSHION.
         BGEZ     SCLRRES           SCALAR RESULT.
         LI,R11   0                 USE 0 IF PUSH INTO CUSH.
         B        SCLRRES
I23      LI,R14   SCLRRES           SCALAR RESULT IN R11 IS
         B        NUMUSERS            NO.OF USERS IN 100THS OF A PERSON.
I24      LW,R11   LOGONTIM          = TIME OF DAY AT LOG-ON IN 60THS/SEC
         B        SCLRRES             FOR THE SCALAR RESULT.
I25      LI,R14   SCLRRES           SCALAR RESULT IN R11 IS 'MMDDYY' AS
         B        DATE                BASE 10 VERSION OF THE DATE.
I26      LI,R7    SCLRRES-1         (SET EXIT FROM SVSTART).
SVSTART  LW,R5    STATEPTR          PT AT TOP STATE-ENTRY.
         LI,R8    0                 SET FOR SELECTIVE LOADS.
         LI,R9    X'7FFF'
STATE    LS,R8    0,R5              GET 'NEXT' FIELD OF STATE-ENTRY.
         BEZ      0,R7              NONE -- TAKE FINAL-ENTRY EXIT.
         LB,R6   *R5                GET CATEGORY.
         CI,R6    CATQ
         BNE      STATEF            FUNCTION-CATEGORY.
         LI,R11   0                 QUAD-CATEGORY USE 0.
         B        1,R7              TAKE NORMAL EXIT.
STATEF   LW,R11   1,R5              GET LINE NO. & FUNC.PTR, IF ANY...
         BNEZ     STATEFL             OK.
         LI,R11   -1                  DAMAGED, USE -1.
STATEFL  SAS,R11  -17               = LINE NO. ONLY.
         B        1,R7              TAKE NORMAL EXIT.
         LI,R11   0               @   USE 0 FOR FINAL-ENTRY ON I26.
SCLRRES  LW,R4    RTARG           @ PT AT RIGHT ARGUMENT DATA BLK.      U05-0016
         LW,R5    1,R4              GET ITS REF-COUNT.                  U05-0017
         AI,R5    -1                IF NOT EXACTLY ONE,                 U05-0018
         BNEZ     SCLRINTG            ALLOCATE A FRESH BLOCK FOR RESULT.U05-0019
         LH,R2   *RTARG             IF EXACTLY ONE, IT'S A TEMP.        U05-0020
         AI,R2    -(TYPEINTG**8)    SO, IF SCALAR INTEGER ALREADY,      U05-0021
         BEZ      RESRTARG            USE RT ARG'S BLOCK FOR RESULT.    U05-0022
SCLRINTG STW,R11  CONSTBUF          SAVE INTEGER VALUE FOR RESULT.
SCLRINTA LI,R11   4                 ALLOCATE A 4-WD DATA BLK.
         BAL,R7   ALOCBLK
         LI,R11   TYPEINTG          INTEGER TYPE.
         STB,R11 *R4
         LW,R11   CONSTBUF          RECOVER THE VALUE.
         B        SETVALUE
RESRTARG MTW,1    1,R4              BUMP REF-COUNT.
SETVALUE STW,R4   RESULT            SAVE PTR TO RESULT DATA BLK.
         STW,R11  2,R4              SET ITS VALUE.
         B        MXRETURN
I27      LI,R11   0                 COUNTS NO.OF STATE-ENTRIES TILL FIN.
         LW,R5    STATEPTR          PT AT TOP STATE-ENTRY.
         LI,R8    0                 SET FOR SELECTIVE LOADS.
         LI,R9    X'7FFF'
         B        I27Q              START QUERY.
I27N     AW,R5    R8                PT AT NEXT STATE-ENTRY.
         AI,R11   1                 COUNT THE PREVIOUS ONE.
I27Q     LS,R8    0,R5              IS THIS THE FINAL ENTRY...
         BNEZ     I27N                NO.
         STW,R11  CONSTBUF            YES, SAVE STATE-ENTRY COUNT.
         AI,R11   1                 ADD 1 FOR THE LENGTH OF THE VECTOR.
         BAL,R7   ALOCHNW           ALLOC THAT MANY WDS + HDR & EVEN NO.
         STW,R4   RESULT            SAVE PTR TO RESULT DATA BLK.
         LI,R7    (TYPEINTG**8)+1   TYPE = INTEGER   RANK = 1 (VECTOR).
         STH,R7  *RESULT
         LW,R11   CONSTBUF          GET NO.OF STATE ENTRIES.
         STW,R11  2,R4              THAT'S THE LENGTH OF THE VECTOR.
         AI,R4    2
         BAL,R7   SVSTART         @ START LOOKING AT STATE-VECTOR AGAIN.
         B        MXRETURN        @   FINAL ENTRY.
         AI,R4    1               @   OTHER.
         STW,R11  0,R4              FILL IN ITS LINE NO. INDICATION.
         AW,R5    R8                PT AT NEXT STATE-ENTRY.
         B        STATE             FIND ITS CATEGORY ETC. LOOPING.
I28      LW,R11   TERMTYPE          GET TERMINAL TYPE NUMBER FOR THE
         B        SCLRRES             SCALAR RESULT.
 PAGE
NEGIBEAM AI,R7    19                RESTORE OFFSET.
         LCW,R7   R7                GET (HOPEFULLY) PLUS VALUE...
         BLEZ     ERDOMAIN            OOPS -- DOMAIN ERROR.
         CI,R7    NEGIBBND          VERIFY IN RANGE...
         BLE      NIGO,R7             OK, TAKE CORRESPONDING BRANCH.
NIGO     B        ERDOMAIN        @   OOPS -- DOMAIN ERROR.
         B        NI1             @ OVERHEAD TIME.
         B        NI2             @ NO.OF UNUSED SYMBOLS.
         B        NI3             @ ON-LINE VS BATCH.
 SPACE 2
NEGIBBND EQU      %-NIGO-1          = NO.OF NEGATIVE I-BEAM BRANCHES.
 SPACE 2
NI1      LI,R14   SCLRRES           SCALAR RESULT IN R11 IS
         B        OVERTIME            OVERHEAD TIME IN 60THS OF SEC.
NI2      LI,R14   SCLRRES           SCALAR RESULT IN R11 IS
         B        UNSYMS              NO.OF UNUSED SYMBOLS.
NI3      LW,R11   ON%OFF            = 1 IF ON-LINE OR 0 IF BATCH.
         B        SCLRRES           SCALAR, INTEGER RESULT.
MTBAR    LB,R11  *RTARG             GET RT ARG'S TYPE &
         B        SCLRINTG            USE THAT VALUE FOR SCALAR,INTEGER
*                                       RESULT.
DTBAR    LI,R5    TYPEINTG          VERIFY LEFT ARG IS INTEGER TYPE...
         CB,R5   *LFARG
         BNE      ERDOMAIN            NO -- DOMAIN ERROR.
         LI,R8    X'FF'             VERIFY LEFT ARG IS SCALAR...
         CH,R8   *LFARG
         BANZ     ERRANK              NO -- RANK ERROR.
         LW,R4    LFARG             PT AT LEFT ARG.
         LW,R6    2,R4              GET ITS VALUE.
         CI,R6    2                 IS IT 2...
         BNE      INTRIGUE            NO, GUESS ITS FOR INTRINSIC.
         STW,R6   RSTYPE              YES, SET TYPE OF RESULT.
         CB,R5   *RTARG             VERIFY RT ARG IS INTEGER TYPE...
         BE       DTBARI              OK.
         LI,R5    TYPEXSEQ            NO, TRY FOR INDEX SEQUENCE...
         CB,R5   *RTARG
         BNE      DTBART                NOPE, LOGICAL PERHAPS.
         LW,R4    RTARG                 OK, PT AT ITS DATA BLOCK.
         LW,R11   2,R4              GET ITS LENGTH VALUE.
         STW,R11  RSSIZE            THAT IS THE NO.OF ELEMENTS.
         LI,R5    1
         STW,R5   RSRANK            RANK OF RESULT IS 1 (VECTOR).
         BAL,R14  ALOCTRES          ALLOC A TEXT TYPE RESULT DATA BLK.
         LW,R5    RTARG             PT AT RT ARG AGAIN.
         LW,R14   RSSIZE            GET NO.OF ELEMENTS AGAIN.
         STW,R14  2,R4              THAT IS LENGTH OF NEW TEXT VECTOR...
         BEZ      DXRETURN            ZERO.
         LW,R9    3,R5              GET INDEX SEQ'S BIAS VALUE.
         AI,R4    3                 PT AT 1ST VALUE WD OF RESULT.
         SLS,R4   2                 USE BYTE ADDRESSING.
DTBARX   AW,R9    4,R5              ADD INDEX SEQ'S COEFFICIENT VALUE.
         STB,R9   0,R4              PUT BYTE IN RESULT.
         AI,R4    1                 PT AT NEXT RESULT BYTE POSITION.
         BDR,R14  DTBARX            LOOP TILL LAST VALUE.
         LW,R11   3,R5              RE-CALC. FIRST VALUE.
         AW,R11   4,R5
         OR,R11   R9                MERGE THE FIRST & LAST VALUES.
         B        DTBARQ            CK THAT RANGE.
DTBART   LI,R5    TYPELOGL          IS RT ARG LOGICAL TYPE...
         CB,R5   *RTARG
         BNE      ERDOMAIN            NO -- DOMAIN ERROR.
DTBARI   LI,R5    1
         LB,R4   *RTARG,R5          GET RANK OF RT ARG AND SAVE IT.
         STW,R4   RSRANK
         BEZ      DTBARS            SCALAR.
         LW,R14   RSRANK            ARRAY, CALC. NO.OF ELEMENTS.
         AW,R4    RTARG
DTBARN   MW,R5    1,R4
         AI,R4    -1
         BDR,R14  DTBARN
DTBARS   STW,R5   RSSIZE            SAVE NO.OF ELEMENTS.
         LW,R11   RSSIZE            ALLOCATE A TEXT TYPE DATA BLK RESULT
         BAL,R14  ALOCTRES            FOR THAT MANY ELEMENTS, SAME RANK.
         LW,R5    RTARG             PT AT WD AFTER RT ARG'S REF-COUNT.
         AI,R5    2
         AI,R4    2                 LIKEWISE FOR RESULT.
         LW,R14   RSRANK            GET RANK...
         BEZ      DTBARE              SCALAR, WE PT AT THE VALUE WD.
DTBARF   LW,R9    0,R5                ARRAY, COPY LENGTHS OF RT ARG
         STW,R9   0,R4                  INTO LENGTHS OF RESULT.
         AI,R4    1
         AI,R5    1
         BDR,R14  DTBARF            FINISH POINTING AT 1ST VALUE WD.
DTBARE   LW,R14   RSSIZE            GET NO.OF ELEMENTS...
         BEZ      DXRETURN            NONE.
         SLS,R4   2                   SOME, USE BYTE ADDRESSING ON RES.
         LI,R11   0
         LI,R9    TYPELOGL          IS RT ARG LOGICAL... (TYPE = 1)
         CB,R9   *RTARG
         BNE      DTBARK              NO, INTEGER.
DTBARLW  LW,R10   0,R5                YES, LOAD LOGL VALUE WD.
         AI,R5    1                 PT AT NEXT VALUE WD, IF ANY.
         LI,R8    32                32 LOGL VALUES PER WD.
DTBARLB  AI,R10   0                 TEST A LOGL VALUE...
         BGEZ     DTBARLZ             ZERO.
         STB,R9   0,R4                ONE, STORE BYTE = 1.
DTBARLU  AI,R4    1                 PT AT NEXT BYTE.
         BDR,R14  DTBARLS           LOOP TILL
         B        DXRETURN            DONE WITH LOGL ELEMENTS.
DTBARLZ  STB,R11  0,R4              STORE BYTE = 0.
         B        DTBARLU
DTBARLS  SLS,R10  1                 GET NEXT LOGL VALUE BIT,
         BDR,R8   DTBARLB             IF ANY REMAIN IN THIS VALUE WD.
         B        DTBARLW           GET NEXT WD.
DTBARK   LW,R9    0,R5              MOVE EACH ELEMENT FROM RT ARG
         OR,R11   0,R5                (ACCUMULATING BITS FOR VALIDATION)
         STB,R9   0,R4                  INTO RESULT.
         AI,R4    1
         AI,R5    1
         BDR,R14  DTBARK
DTBARQ   CI,R11   X'FFF00'          VALIDATE NO ELEMENT EXCEEDED 8 BITS.
         BAZ      DXRETURN            OK.
         B        ERDOMAIN            OOPS -- DOMAIN ERROR.
ITEST    CI,R2    #DINTRS         @ NO.OF DYADIC INTRINSICS.
         CI,R2    #MINTRS         @ NO.OF MONADIC INTRINSICS.
NINTRIN  CI,R2    #NINTRS         @ NO.OF NILADIC INTRINSICS.
         BL       NYV,R2              OK, VECTOR ON THE INTRINSIC NO.
         BAL,R15  SYSTERR             TOO BIG
MINTRIN  CI,R6    #MINTRS           NO.OF MONADIC INTRINSICS.
         BL       MYV,R6              OK, VECTOR ON THE INTRINSIC NO.
         BAL,R15  SYSTERR             TOO BIG
DINTRIN  CI,R6    #DINTRS           NO.OF DYADIC INTRINSICS.
         BL       DYV,R6              OK, VECTOR ON THE INTRINSIC NO.
         BAL,R15  SYSTERR             TOO BIG
INTRIGUE CLM,R6   INTRANGE          VERIFY TYPE VALUE IS INTRINSIC...
         BCS,9    ERDOMAIN            NO -- DOMAIN ERROR.
         CH,R8   *RTARG               OK, VERIFY SCALAR RT ARG...
         BANZ     ERRANK                NOPE -- RANK ERROR.
         LW,R4    RTARG                 YEP, PT AT RT ARG DATA BLK.
         LW,R2    2,R4              GET RT ARG VALUE WD.
         CB,R5   *RTARG             IS RT ARG AN INTEGER TYPE...
         BE       INTRIGUI            YES.
         SLS,R2   -31                 NO, PROBABLY LOGICAL TYPE, GET BIT
         LI,R5    TYPELOGL          VERIFY LOGICAL TYPE...
         CB,R5   *RTARG
         BNE      ERDOMAIN            OOPS -- DOMAIN ERROR.
INTRIGUI AI,R2    0                 VERIFY POSITIVE VALUE.
         BLZ      ERDOMAIN            NEGATIVE -- DOMAIN ERROR.
         EXU      ITEST-DYINT,R6      VERIFY NOT TOO BIG...
         BGE      ERDOMAIN              IT IS -- DOMAIN ERROR.
         LI,R11   2                     OK, ALLOCATE A 2-WD DATA BLK.
         BAL,R7   ALOCBLK
         STW,R4   RESULT            SAVE PTR TO RESULT DATA BLK.
         STH,R2  *RESULT            PLUG IN THE INTRINSIC NO.
         STB,R6  *RESULT            PLUG IN THE INTRINSIC TYPE.
         B        DXRETURN          RETURN FROM DYADIC-OP EXECUTION,
DYV      B        DELTAFMT        @ DYADIC INTRINSIC NO. 0
         BDR,R6   %+1             @ (FILEOPS--SET R6=0)        1
         B        FILEOPS         @ (APL ERR-HANDLING VERSION) 2
         B        DELTAGRF        @                            3
         BAL,R15  SYSTERR         @                     4
         BAL,R15  SYSTERR         @                     5
         BAL,R15  SYSTERR         @                     6
         BAL,R15  SYSTERR         @                     7
#DINTRS  EQU      %-DYV           @ # DYAD.INTRINSICS.
MYV      B        IORIGIN         @ MONADIC INTRINSIC NO. 0
         B        IWIDTH          @                       1
         B        IDIGITS         @                       2
         B        ITABS           @                       3
         B        ISETLINK        @                       4
         B        ISETFUZZ        @                       5
         B        IDELAY          @                       6
         BAL,R15  SYSTERR         @                       7
         BAL,R15  SYSTERR         @                       8
         BAL,R15  SYSTERR         @                       9
         BAL,R15  SYSTERR         @                      10
         BAL,R15  SYSTERR         @                      11
#MINTRS  EQU      %-MYV           @ # MON.INTRINSICS.
NYV      B        ERRN            @ NILADIC INTRINSIC NO. 0
         B        ERRF            @                      1
         B        ERRX            @                     2
         BAL,R15  SYSTERR         @                     3
#NINTRS  EQU      %-NYV           @
IORIGIN  BAL,R14  IV1               GET THE ELEMENT.
         LI,R5    EZQ-1             GO TO 'EZQ' AFTER
         B        SETORG              SETTING THE ORIGIN.
         B        ERDOMAIN      @   (ERR RETURN FROM THE SET-ROUTINES)
EZQ      LW,R11   R7            @   PUT OLD VALUE (RESULT) IN R11.      U05-0024
         B        SCLRRES           PRODUCE SCALAR, INTEGER RESULT.     U05-0025
IWIDTH   BAL,R14  IV1               GET THE ELEMENT.
         LI,R5    EZQ-1             GO TO 'EZQ' AFTER
         B        SETWIDTH            SETTING THE WIDTH.
IDIGITS  BAL,R14  IV1               GET THE ELEMENT.
         LI,R5    EZQ-1             GO TO 'EZQ' AFTER
         B        SETDIGIT            SETTING DIGITS.
ISETFUZZ BAL,R14  IV1               GET THE ELEMENT.
         LI,R5    EZQ-1             GO TO 'EZQ' AFTER
         B        SETFUZZ             SETTING FUZZ.
ISETLINK BAL,R14  IV1               GET THE ELEMENT.
         OR,R7    ONE               INSURE THAT WE USE ODD LINK.
         BLZ      ERDOMAIN            NEGATIVE -- DOMAIN ERROR.
         XW,R7    RANDOM            SET NEW, GET OLD LINK.
         B        EZQ
IDELAY   BAL,R14  IV1               GET THE ELEMENT.
         CLM,R7   DELAYRNG          VERIFY REASONABLE DELAY VALUE.
         BCS,9    ERDOMAIN            NOT -- DOMAIN ERROR.
         BAL,R5   DELAYER             OK -- DELAY EXECUTION......
         LI,R11   0                     (RESUME EXECUTION)
         STW,R11  CONSTBUF          SET UP TO FAKE OUT THE TAB RESULT
         B        IMEMPTY             GENERATOR SO THAT AN EMPTY VECTOR
*                                       RESULTS.
ITABS    LB,R2   *RTARG             GET RT ARG'S TYPE...
         AI,R2    -TYPEINTG
         BEZ      ITABSI              INTEGER.
         AI,R2    TYPEINTG-TYPEXSEQ
         BNEZ     ITABSQ              LOGICAL PERHAPS.
         LW,R4    RTARG               INDEX SEQUENCE.
         LW,R6    2,R4              GET ITS LENGTH.
         CI,R6    16
         BG       ERLENGTH            TOO LONG -- LENGTH ERROR.
         LW,R7    3,R4              GET ITS BIAS VALUE.
         LI,R5    CONSTBUF+17       PT AT BUFFER TO SAVE NEW TAB VECTOR.
ITABSX   AW,R7    4,R4              ADD ITS COEFFICIENT VALUE.
         STW,R7   0,R5              PUT ANSWER IN BUFFER.
         AI,R5    1                 PT AT NEXT WD IN BUFFER.
         BDR,R6   ITABSX
         LW,R6    2,R4              GET LENGTH AGAIN.
         LI,R4    CONSTBUF+17       PT AT 1ST VALUE IN BUFFER.
         B        ITABSET
ITABSQ   LI,R2    TYPELOGL**8       VERIFY LOGICAL SCALAR.
         CH,R2   *RTARG
         BNE      ERDOMAIN            OOPS -- DOMAIN ERROR.
ITABSI   LW,R4    RTARG             PT AT WD AFTER RT ARG'S REF-COUNT WD
         AI,R4    2
         LI,R6    1                 INIT LENGTH = 1  (ALSO BYTE OFFSET).
         LB,R8   *RTARG,R6          GET RANK OF RT ARG.
         BEZ      ITABSET             SCALAR.
         AI,R8    -1
         BNEZ     ERRANK              NON-VECTOR ARRAY -- RANK ERROR.
         LW,R6    0,R4                VECTOR, GET ITS LENGTH.
         AI,R4    1                 PT AT 1ST VALUE WD.
ITABSET  BAL,R2   TABSET            SET TABS IF OK.
         B        ERDOMAIN            OOPS -- DOMAIN ERROR.
         LW,R11   CONSTBUF            OK, GET NO.OF OLD TAB VALUES.
IMEMPTY  AI,R11   1                 ALLOCATE VECTOR OF THAT LENGTH
         BAL,R7   ALOCHNW             PLUS 2-WD HDR & EVEN SIZE.
         STW,R4   RESULT            SAVE PTR TO RESULT DATA BLK.
         LI,R11   (TYPEINTG**8)+1   TYPE = INTEGER   RANK = 1.
         STH,R11 *RESULT
         LW,R6    CONSTBUF          GET NO.OF OLD TAB VALUES.
         STW,R6   2,R4              SET LENGTH OF VECTOR RESULT.
         AI,R4    2                 PT AT LENGTH WD.
ITABSZ   LW,R7    CONSTBUF,R6       FILL IN VALUES
         STW,R7  *R4,R6               FROM LAST
         BDR,R6   ITABSZ                TO FIRST.
         B        MXRETURN
 PAGE
************************************************************************
 SPACE 2
Z        SET      %-INTRINS@        SIZE OF INTRINS IN HEX.
 SPACE
Z        SET      Z+Z/10*6+Z/100*96+Z/1000*1536  SIZE IN DECIMAL.
 SPACE 3
         END

