         SYSTEM   APTERYX
L        EQU      15                LINK REGISTER
         CSECT    1
         DEF      SLURP,SLURPN,SLURPT,SLURPH,SLURPR,SLURPC,SLURPO
         DEF      SLURPDCB,SLURPA,SLURPD
         REF      M:LO,M:UC,DUMPTAB
*        THE SLURP ROUTINES HANDLE ALL OUTPUT FOR THE PROGRAM
*        IN ONE WAY OR ANOTHER. THE VARIOUS ROUTINES THAT MAKE
*        UP SLURP, AND THEIR FUNCTIONS, ARE:
*        SLURP    COPY CHARACTERS INTO BUFFER UNTIL '%' HIT
*        SLURPN   OUTPUT DECIMAL NUMBER IN 1, THEN SLURP
*        SLURPH   OUTPUT HEX NUMBER IN 1, THEN SLURP
*        SLURPR   OUTPUT NUMBER IN 1 BY RADIX IN 0, THEN SLURP
*        SLURPC   OUTPUT CHRS IN 0,1 PAIR
*        SLURPT   OUTPUT TEXTC IN 0,1 PAIR
*        SLURPO   WRITE OUT THE OUTPUT BUFFER
*        SLURPA   MOVE OUTPUT POINTER TO COLUMN SPECIFIED IN R1
*        SLURPD   PUT TEXTC POINTED TO BY R1 IN BUFFER AND TRANSLATE
*
*        REGISTERS L,5,6,14 ARE CLOBBERED.
*
SLURP    PUSHL
         LW,6     POINTER
         BALL     SLURPXX
         STW,6    POINTER
         PULLL
         B        *L
SLURPXX  LB,14    0,5
         BE       *L                0 MEANS WE'RE DONE.
         AI,5     1                 BUMP.
         CI,14    '%'               MARKER HIT.....
         BE       *L                YUP. LEAVE.
         STB,14   OBUF,6            POKE AWAY
         AI,6     1
         CI,6     140               BUFFER FULL???
         BNE      SLURPXX           NO, KEEP GOING
         STW,6    POINTER
         PUSH     L                 SAVE THE LINK AND THEN
         BALL     SLURPO            GO EMPTY THE BUFFER
         PULLL
         B        *L                BYE.......
*
*        WRITE OUT THE BUFFER- EITHER ON COMMAND, OR WHEN IT GETS FULL
*
SLURPO   PUSH     2,1
         LI,1     OBUF
         LW,2     POINTER           CHR COUNT=BUFFER POINTER.
         BE       %+3               NO BUFEE, NO WRITEE.......
         LI,6     0                 BUFFER IS EMPTY.
         STW,6    POINTER
         CAL1,1   WRITEIT           TAKE THAT!
         LI,1     M:UC              CHECK FOR UC DCB
         CW,1     SLURPDCB
         BNE      %+4               NOT M:UC SO NO CR ON END.
         LI,2     1
         LI,1     PROMPTM           AND A CR FOR YOU ONLINE FOLKS..
         CAL1,1   WRITEIT
         LW,1     =140**24+BA(OBUF)
         MBS,0    ='    '
         PULL     2,1
         B        *L                BYE Y'ALL..........
*
*        SLURPT USES SLURPC TO SHOVEL IN A TEXTC IN 0,1.
*
SLURPT   PUSH     4,0
         LI,2     1                 START WITH BYTE ONE
         LB,3     0                 THIS IS THE COUNT.
         B        SLURPC1           THAT'S ALL THERE IS TO IT.
*
*        SLURPC SHOVELS 8 CHARACTERS FROM (0,1) TO THE BUFFER.
*
SLURPC   PUSH     4,0
         LI,2     0                 LOAD PTR
         LI,3     8                 COUNTER
SLURPC1  LW,6     POINTER
         LB,14    0,2
         BE       %+5               WHAT NULL.. I DIDN'T SEE A NULL...
         STB,14   OBUF,6
         AI,6     1
         AI,2     1
         BDR,3    %-5
         PULL     4,0
         STW,6    POINTER
         B        SLURP             AND SPLIT.
SLURPA   EQU      %
         STW,1    POINTER
         B        *15
*
SLURPD   PUSHL
         PUSH     2,2
         LI,2     1
         LW,6     POINTER
SLURPD1  LB,3     *1,2
         LB,3     DUMPTAB,3
         STB,3    OBUF,6
         AI,6     1
         CI,6     140
         BLE      %+2
         BALL     SLURPO
         AI,2     1
         CB,2     *1
         BLE      SLURPD1
         PULL     2,2
         B        SLURP+2
*
*        SLURP N,H AND R OUTPUT NUMBER IN R1 USING 10 FOR A
*        RADIX FOR SLURPN, 16 FOR A RADIX FOR SLURPH, AND THE
*        CONTENTS OF R0 FOR A RADIX FOR SLURPR. THE NUMBER OF DIGITS
*        WANTED IS IN R9. THE FIELD IS BLANK FILLED, AND THEN THE
*        REQUIRED NUMBER OF CHARACTERS ARE POKED IN. TRUNCATION MAY OCCUR,
*
SLURPR   STW,0    RADIX
         B        SLURPS
SLURPN   LI,14    10
         STW,14   RADIX
         B        SLURPS
SLURPH   LI,14    16
         STW,14   RADIX
SLURPS   LW,6     POINTER
         PUSH     6,0
         PUSH     9
         LI,2     ' '
         STB,2    OBUF,6            POKE THE FIELD FULL OF BLANKS
         AI,6     1
         BDR,9    %-2
         PULL     9
         PUSH     6
         PUSH     9
         AI,6     -1                THE FIRST ONE GOES HERE.
         LI,5     0                 CHARACTER COUNTER
         LAW,3    1                 ONLY POSITIVE NUMBERS......
SLURPS1  LI,2     0                 REMAINDER GOES HERE.
         DW,2     RADIX             GIMMIE A DIGIT
         LB,2     HEX,2             A CHARACTER.
         STB,2    ARG,5             POKE AWAY FOR LATER
         AI,5     1
         CI,3     0                 DONE YET???
         BG       SLURPS1           NOPE. KEEP GOING.
         LI,4     0                 COPY POINTER.
SLURPS2  CI,9     0                 NO DIGITS WANTED?
         BE       SLURPS5           IF 0, SPECIAL CASE.
         LB,14    ARG,4
         STB,14   OBUF,6            POKE AWAY
         AI,4     1
         CW,4     5                 LAST DIGIT IN NUMBER?
         BE       SLURPS3           YUP. ALL DONE
         AI,6     -1
         BDR,9    %-6
SLURPS3  PULL     9
         PULL     6
         PULL     6,0
         STW,6    POINTER
         B        SLURP             GO SLURP TO FINISH UP.
SLURPS4  CI,9     0                 NO DIGITS WANTED?
         BE       %+3               YUP. SHOVEL IN 'NO'
         CI,9     2                 IF ONLY ONE OR TWO DIGITS,
         BLE      SLURPS1           WE'LL PLUG IN ZEROS.
         LI,2     'O'
         STB,2    ARG,5
         AI,5     1
         LI,2     'N'
         STB,2    ARG,5
         AI,5     1
         B        SLURPS2-1         AND FILL INTO BUFFER
SLURPS5  PULL     9
         PULL     6
         AI,6     -1                BACK IT UP
         LW,2     5
         AI,5     -1
         LB,14    ARG,5             GET LEADING DIGIT
         STB,14   OBUF,6            PUT AWAY.
         AI,6     1
         BDR,2    %-4               ARG DIGITS ARE IN REVERSE ORDER
         B        SLURPS3+2         BYE...
HEX      TEXT     '0123456789ABCDEFGHIJ'
PROMPTM  DATA     X'155A0000'
WRITEIT  GEN,1,7,24 1,X'11',SLURPDCB
         DATA     X'34000000'
         PZE      *1
         PZE      *2
         DATA     0
         CSECT    0
SLURPDCB DATA     M:UC
ARG      RES      8
RADIX    DATA     10
OBUF     EQU      %
         LIST     0
         DO1      140
         DATA,1   X'40'
         LIST     1
POINTER  DATA     0
         END
