*COMDECK /GETDZ/
          TITLE     GET$Z 
 36B      IS.IN     0 
 GET$Z    CAP.RM
          ON.RM     DEL,RMS.Z 
 RMG.Z2   BSS       0 
          F.RM      RL,,X4
          SB2       X4
          NZ        X4,NOTEOR 
          SET.RM    BCC,0 
 NOTEOR   BSS       0 
          F.RM      FL,3           X3 IN USE UNTIL END OF GETDZ 
          OFF.RM    PRD,NZPRD      IF NOT PARTIAL 
          F.RM      RPTL,5         LENGTH OF PARTIAL RECORD 
          F.RM      PTL,X1
          IX5       X5-X1 
          IX7       X5+X4          RPTL-PTL+RL
          IX5       X7-X3 
          PL        X5,NZPRD       IF \ FL, USE FL - RL 
          BX3       X7             ELSE, USE RL + RPTL
 NZPRD    BSS       0 
          SB4       X3+            FL 
          IX2       X2+X4 
          IX3       X2-X3 
          PL        X3,UFL         IF AVAIL CHAR LT FL
          SB4       X2             SET SEARCH LIMIT TO AVAIL CHAR 
 UFL      BSS       0 
          SB5       B2             SAVE 
          F.RM      UWD,4 
          GE        B2,B4,ENDLOP
          SB2       B2+10 
 .MD      IFNE      #BETA#,0
          F.RM      WSAB,5
          NG        X5,ZB1         IF LCM WSA 
 .MD      ENDIF 
          MX5       -12            BYTE MASK
          F.RM      BCC,B6
          EQ        B6,B0,GET 
          ON.RM     PRD,GETP
 GET      BSS       0 
          SA1       B3             GET FIRST WORD 
          BX6       X1             SAVE IT
          BX7       -X5*X1         EXTRACT BYTE FROM FIRST WORD 
          ZR        X7,ENDGZ0 
          SA6       X4
          GE        B2,B4,ENDLOOP  IF CANNOT MOVE ANY MORE
* 
*     MAIN LOOP--MOVE WORDS AND WATCH FOR ZERO BYTE.
* 
 ZLOOP    BSS       0 
          SA1       A1+B1          NEXT WORD
          SB2       B2+10D         INCREMENT RL 
          LX6       X1
          BX7       -X5*X1         STRIP OFF BYTE 
          SA6       A6+B1          STORE WORD 
          ZR        X7,ENDGZ       IF EOR 
          LT        B2,B4,ZLOOP    IF NOT LIMIT, LOOP 
          SX4       A6+            UWD (SCM)
          EQ        ENDLOOP 
 .MD      IFNE      #BETA#,0
          EQ        ENDLOOP 
* 
*     FOR LCM:  
* 
 ZB1      BSS 
          WX6       X4             STORE FIRST WORD (LCM) 
          MX7       1 
          MX5       -12            BYTE MASK
          BX4       X4+X7          PUT LCM FLAG INTO X4 
          BX7       -X5*X1         EXTRACT BYTE 
          ZR        X7,ENDGZL      IF EOR 
          GE        B2,B4,ENDLOOP  IF CANNOT MOVE ANY MORE
          SX6       1 
* 
*     LCM LOOP. 
* 
 LCMLOOP  BSS 
          SA1       A1+B1          NEXT WORD
          SB2       B2+10          INCR RL
          IX4       X4+X6          INCREMENT UWD
          BX7       -X5*X1         EXTRACT BYTE 
          WX1       X4             STORE NEXT WORD
          ZR        X7,ENDGZL      IF ZERO BYTE FOUND 
          LT        B2,B4,LCMLOOP  LOOP UNTIL NO MORE DATA
 .MD      ENDIF 
* 
*     END MAIN LOOP.
* 
 GETP     BSS       0 
          F.RM      BCC,B6         B6=BCC 
          SA3       MASK+B6        X3= MASK CORESPONDING TO BCC 
          SA1       SHIFT+B6
          SB6       X1             B6= CHARACTER SHIFT COUNT
          SA1       B3             GET FIRST WORD 
 PLOOP    BSS       0 
          BX6       -X3*X1
          LX6       B6             X6 CONTAINS FIRST HALF OF WORD 
          SA1       A1+B1          GET NEXT WORD
          BX7       X3*X1 
          LX7       B6             X7 CONTAINS SECOND HALF OF WORD
          BX6       X6+X7          COMBINE 2 HALF WORDS 
          SA6       X4             TRANSFER COMBINED WORD TO WSA
          BX7       -X5*X6         TEST COMBINED WORD FOR ZERO BYTE 
          ZR        X7,ENDGZ        FOUND ZERO BYTE 
          GE        B2,B4,ENDGETP 
          SB2       B2+10 
          SX4       X4+B1 
          SA1       A1
          EQ        PLOOP 
 ENDGETP  BSS       0 
          SB3       A1
          SX4       X4+B1 
          EQ        B2,B4,SET.UWD 
          SB3       A1-B1 
 SET.UWD  SET.RM    UWD,X4
          INC.RM    BL,B4-B5
          SX1       B4
          IX2       X2-X1 
          SB6       B4-B2 
          SB6       B6+10 
          F.RM      BCC,B1
          SB6       B6+B1 
          SB1       1 
          SB6       B6-10 
          GE        B6,B0,SET.BCC 
          SB6       B6+10 
 SET.BCC  SET.RM    BCC,B6
          SA1       B3
          ZR        X1,ZRTNA
          SA5       MASK+B6 
          BX7       -X5*X1
          NZ        X7,INC.PTL
          SB6       B6-10 
          SB6       -B6 
          INC.RM    BL,B6 
          SX1       B6
          IX2       X2-X1 
          SB3       B3+B1 
          EQ        ZRTNA 
 INC.PTL  INC.RM    PTL,B4-B5 
          SET.RM    RL,B4 
          F.RM      FL,B6 
          GE        B2,B6,GEN.142 
          ZR        X2,GETMORE
          SX2       B6
          EQ        EXITG 
 GETMORE  SB6       RMG.Z2
          EQ        =XGTMR$SQ 
 GEN.142  BSS       0 
          F.RM      BCC,B6
          SB6       B6-10 
          SB6       -B6 
          INC.RM    BL,B6 
          SX1       B6
          IX2       X2-X1 
          SB3       B3+B1 
          SET.RM    GEN,142B
          EQ        ERR142
 ENDLOOP  BSS 
          SB3       A1+B1          OUT
          EQ        ENDLOPB 
 ENDLOP   BSS       0 
          SX7       B1
          IX4       X4-X7          ADJUST ADDRESS TO LAST XFERED WORD 
ENDLOPB   BSS       0 
          INC.RM    BL,B2-B5       RECORD AMOUNT TAKEN OUT OF BUFFER
          SX1       B2
          IX2       X2-X1 
          SET.RM    RL,B2          SAVE NEW RL
          SB6       RMG.Z2
          ZR        X2,BLKR        NO MORE DATA, ALSO NOT EOR 
          NG        X2,BLKR 
          SET.RM    RL,B4          SET RL EQUAL TO FL 
          MX1       59
          LX1       1 
          IX1       X1+X2 
          PL        X1,ZRTNA       HANDLE 1 OR 0 CHAR AVAILABILITY
          SB6       ZRTURN         SET RETURN ADDRESS 
  
 BLKR     BSS 
          INC.RM    PTL,B2-B5 
 .MD      IFEQ      #BETA#,0
          SET.RM    UWD,A6+B1 
 .MD      ELSE
          SX6       B1
          IX4       X4+X6          INCR UWD 
          SET.RM    UWD,X4,,,CHOP 
 .MD      ENDIF 
          EQ        =XGTMR$SQ      GET MORE DATA
  
 ZRTURN   BSS       0              *** REENTER HERE WITH TACKON 
 .MD      IFEQ      #BETA#,0
          F.RM      UWD,X4,-1 
 .MD      ELSE
          F.RM      UWD,X4
          SX7       B1
          IX4       X4-X7 
          OFF.RM    WSAB,ZRTNA     IF SCM 
          MX7       1 
          BX4       X4+X7          LCM FLAG 
 .MD      ENDIF 
 ZRTNA    BSS 
          SA3       B3             GET NEXT WORD
          ZR        X3,ZRTNC       FULL WORD TERMINATOR 
          OFF.RM    PRD,ZRTNB      NOT A PARTIAL GET
          F.RM      FL,B4 
          LT        B2,B4,NOTEOR1  EXIT IF NOT EOR
 ZRTNB    MX5       -12            CHECK FOR 2-BYTE TERMINATOR
          BX1       -X5*X3
          NZ        X1,EXCESS      NO, ERROR
          SX5       55B 
          LX5       54
          BX1       X5-X3 
          ZR        X1,ZRTNC
          SX5       5555B 
          LX5       48
          BX1       X5-X3 
          NZ        X1,EXCESS 
 ZRTNC    INC.RM    BL,10          INCREMENT BUFFER POINTERS
          SX2       X2-10 
          SB3       B3+B1 
          F.RM      BCC,B6
          EQ        B6,B0,ZRTND 
          SX4       X4-1
 ZRTND    ZR        X3,ENDGZ3 
          EQ        ENDGZ2
 NOTEOR1  BSS       0 
          INC.RM    PTL,B2-B5 
          SX2       B4             SET RRL TO FL SO NOT EOR 
          EQ        EXITG 
* 
*     HANDLE ZERO BYTE--PAD WITH BLANKS.
* 
 ENDGZ    BSS       0 
          SX4       A6
 .MD      IFNE      #BETA#,0
 ENDGZL   BX6       X1
 .MD      ENDIF 
 ENDGZ0   BSS       0 
          SB3       A1+B1          OUT
          INC.RM    BL,B2-B5       BL INCREMENT 
          ZR        X6,ENDGZ1 
          SX5       55B            CHECK DATA = 5500...00 
          LX5       54
          F.RM      ASCII,3 
          ZR        X3,NASCII 
          SX5       40B 
          LX5       48
NASCII    BSS       0 
          BX7       X5-X1 
          NZ        X7,NOTBLNK
          SB2       B2-10          CORRECT RL BY 10 CHARS 
          SB6       B2
          NZ         B2,NOTBLKL    NOT A BLANK LINE 
          SB2        B1            BLANK LINE RL IS 1 
          SB6       B0             BLANK LINE FLAG
          NG        X5,NOTBLKL
          SB2       B1+B1          ASCII BLANK LINE RL=2
NOTBLKL   BSS        0
          SX2       B2
          INC.RM    PTL,B2-B5 
          SET.RM    RL,B2 
          SB2       B6             RESET B2 FOR PROPER BLANK PADDING
          SX7       B1
          IX4       X4-X7          BLANKFILL FROM CURRENT WSA 
          NE        B2,B1,BLNKFILL
          SB2       B2-10 
          EQ        BLNKFILL
 NOTBLNK  BSS       0 
          SB6       0 
          SX7       =YRM$LVL
          NG        X7,ROUNDUP
          SA1       =YRM$LVL
          SX7       X1-80126       FCL CODE REQ - RL .LT. 12B 
          NG        X7,ROUNDUP
 CHARCT   BSS       0 
          SB2       B2-10 
          SB6       0 
          BX3       X6
          F.RM      ASCII 
          MX7       6 
          SB4       6 
          ZR        X1,LOOP        IF NOT ASCII 
          MX7       12             DOUBLE EVERYTING FOR ASCII CHAR
          SB4       12
          SB1       2              COMMIT A CARDINAL SIN
 LOOP     BSS       0 
          SB6       B6+B1 
          BX3       -X7*X3
          AX7       X7,B4 
          NZ        X3,LOOP 
 ROUNDUP  BSS       0 
          SB1       1              RESTORE B1 
          SX3       B1             CONVERT ZERO FILL TO BLANK FILL
          IX1       X6-X3 
          F.RM      ASCII,3 
          NZ        X3,ZASCII 
          SA3       MAGIC 
          BX1       -X6*X1
          BX1       X1*X3 
          BX3       X1
          AX1       2 
          BX3       X3+X1          50  PART OF  55B = BLANK 
          IX7       X6+X3 
          AX3       3              05  PART 
          IX6       X7+X3 
          EQ        STBLNK
ZASCII    SA3       AMAGIC
          BX1       -X6*X1         ALL 1S FOR ZERO CHARACTER
          BX1       X1*X3          1 FOR ZERO CHARACTER 
          AX1       6              CHANGE 4000B TO 0040B
          IX6       X6+X1          ADD BLANKS 
STBLNK    BSS       0 
 .MD      IFEQ      #BETA#,0
          SA6       X4             RE-STORE LAST WORD WITH BLANKS 
 .MD      ELSE
          MI        X4,ZB4
          SA6       X4+            (SCM)
 ZB4      PL        X4,ENDGZB 
          WX6       X4             (LCM)
 ENDGZB   BSS       0 
 .MD      ENDIF 
  
          SX2       B2+B6 
          ON.RM     PRD,ENDGPZ
          INC.RM    PTL,B2+B6 
          SET.RM    RL,B2+B6
          SX7       =YRM$LVL
          NG        X7,BLNKFILL 
          SA1       =YRM$LVL
          SX7       X1-80126       FCL CODE REQ - RL .LT. 12B 
          NG        X7,BLNKFILL 
          SB2       B2+10          RESTORE B2 TO LOCATION BEFORE CHARCT 
          EQ        BLNKFILL
 ENDGPZ   BSS       0 
          SB2       B2+B6 
          SX3       B6             SAVE CHARACTER COUNT 
          F.RM      BCC,B6
          SX1       B6             SAVE BCC VALUE 
          SB6       B6-10 
          SB6       -B6 
          INC.RM    BL,B6 
          IX1       X1+X3 
          SX1       X1-10 
          PL        X1,UPD.BCC
          SX1       X1+10 
 UPD.BCC  SET.RM    BCC,X1
          F.RM      FL,B4 
          LE        B2,B4,NOT142
          SET.RM    GEN,142B
          SB2       B4
          SX2       B4
 NOT142   INC.RM    PTL,B2-B5 
          SET.RM    RL,B2 
          EQ        BLNKFILL
 ENDGZ2   BSS       0 
          GT        B2,B4,EXCESS
          INC.RM    PTL,B2-B5 
          SET.RM    RL,B2 
          SX2       B2
 BLNKFILL BSS       0 
          F.RM      FL,B4          BLABKFULL UP TO FL 
          OFF.RM    PRD,BLANKLG 
          F.RM      RPTL,B4        BLANK TO REQUESTED PTL IF PARTIAL GET
BLANKLG   BSS       0 
          SB2       B2+9
          SB5       RET 
          SX7       B4
          EQ        =YCHWR$RM      FL ROUNDED-UP IN WORDS 
RET       LX7       1              FL WORDS TIMES 2 
          SB5       X7
          LX7       2              FL WORDS TIMES 8 
          SB5       B5+X7          FL ROUNDED-UP IN CHARACTERS
          GE        B2,B5,EXITGG
          SA1       BLANKS
          F.RM      ASCII,3 
          ZR        X3,GOBLNK 
          SA1       ABLANKS 
GOBLNK    BSS       0 
 .MD      IFNE      #BETA#,0
          PL        X4,ADDBS
          SX7       1 
  
 ADDBLCM  BSS 
          IX4       X4+X7 
          SB2       B2+10 
          WX1       X4             STORE BLANK WORD 
          LT        B2,B5,ADDBLCM 
  
          EQ        EXITGG
  
 ADDBS    BSS 
 .MD      ENDIF 
          BX6       X1             PUT IN OUTPUT REGISTER 
          SB2       B2+10 
          SA6       X4+B1          STORE FIRST BLANK WORD (SCM) 
          GE        B2,B5,EXITGG
          SX7       10
  
*     ADD BLANKS LOOP.
 ADDB     BSS       0 
          SB2       B2+X7          INCREMENT RL BY 10 
          SA6       A6+B1          STORE BLANK WORD 
          LT        B2,B5,ADDB
EXITGG    SET.RM    BCC,0 
*     END OF ADD BLANKS LOOP. 
  
 EXITG    BSS 
          SET.RM    RRL,X2         THIS TELLS GET$SQ WE HAVE FOUND EOR
          EQ        =XGXIT$SQ 
  
 ENDGZ1   BSS       0 
          SX6       B1
          SB2       B2-10          DECREMENT RL 
          IX4       X4-X6          DECR UWD 
  
 ENDGZ3   BSS       0 
          F.RM      ASCII 
          NZ        X1,ENDGZ2      IF ASCII DONT WORRY ABOUT TRAILING COLON 
 .MD      IFEQ      #BETA#,0
          F.RM      WSA 
          IX1       X4-X1 
 .MD      ELSE
          F.RM      WSAD
          MX3       1 
          BX7       -X3*X4         CLEAR TOP
          IX1       X7-X1 
 .MD      ENDIF 
          NG        X1,ENDGZ2      DONT BACK UP IF RECORD ALL ZERO
          MX3       54
 .MD      IFNE      #BETA#,0
          PL        X4,ZB6
          RX5       X4             (LCM)
 ZB6      MI        X4,ZB7
 .MD      ENDIF 
          SA5       X4             (SCM)
 .MD      IFNE      #BETA#,0
 ZB7      BSS 
 .MD      ENDIF 
          BX3       -X3*X5
          NZ        X3,ENDGZ2 
          SX1       55B 
          BX6       X5+X1 
 .MD      IFEQ      #BETA#,0
          SA6       A5             STORE LAST WORD IN SCM WSA 
.MD       ELSE
          MI        X4,ZB4A 
          SA6       X4+ 
ZB4A      PL        X4,ENDGZC 
          WX6       X4
ENDGZC    BSS       0 
.MD       ENDIF 
          SB2       B2-B1 
          INC.RM    PTL,B2-B5 
          SET.RM    RL,B2 
          GT        B2,B4,EXCESS
          SX2       B2
          SB2       B2+B1 
          EQ        BLNKFILL
* 
*     GET RID OF EXCESS DATA IN BUFFER. 
* 
 EXCESS   SET.RM    GEN,142B
          INC.RM    PTL,B4-B5 
 ERR142   BSS       0 
***       IF B3 IS ALREADY POINTING AT THE FIRST WORD OF NEXT RECORD, 
***       RETEST THE WORD WHICH PRECEEDS B3 FOR ZERO-BYTE TERMINATOR. 
          SB2       B3-B1 
          F.RM      FIRST,B4
          LE        B4,B2,TESTZ 
          F.RM      LIMIT,B2
          SB2       B2-B1 
 TESTZ    BSS       0 
          MX5       -12 
          SA1       B2
          BX7       -X5*X1
          BX3       X2             X3 = AMT AVAIL DATA
          ZR        X7,EXITDEL
 RMS.Z    BSS       0 
          MX5       48             SET BYTE MASK
          SX6       10             SET CHARACTER DECREMENT
          BX3       X2             X3 = AMT AVAILABLE DATA
          IX7       X3-X6 
          MI        X7,EXITMOR     NONE AVAILABLE 
  
*     DELETE LOOP.
 SCHSZ    BSS       0 
          F.RM      LIMIT,B4       TEST B3\OUT' VS LIMIT
          LT        B3,B4,OUT      IF B3 EXCEEDS BUFFER LIMIT 
          F.RM      FIRST,B3       SET B3 % FIRST 
 OUT      BSS       0 
          F.RM      IN,B4          TEST IF IN=OUT 
          NE        B3,B4,IN       IF IN .NE. OUT, OK TO PROCEED
          SB6       IN
          EQ        =XGTMR$SQ      GET MORE DATA BEFORE PROCEEDING
 IN       BSS       0 
          SA1       B3             READ WORD
          SB3       B3+B1          INCREMENT OUT
          IX2       X2-X6          DECREMENT CHARACTER COUNT
          BX7       -X5*X1         STRIP OFF BYTE 
          ZR        X7,EXITDEL     IF BYTE ZERO, EXIT 
          NZ        X2,SCHSZ       ELSE, IF CHAR COUNT NON-ZERO, LOOP 
*     END DELETE LOOP.
  
          IX3       X3-X2 
          INC.RM    BL,X3 
EXITMOR   BSS       0 
          SB6       RMS.Z          RETURN ADDRESS 
          EQ        =XGTMR$SQ      GET MORE DATA
  
 EXITDEL  BSS 
          IX3       X3-X2 
          F.RM      FL,X2 
          INC.RM    BL,X3          RECORD HOW MUCH WAS TAKEN OUT OF BUF 
          EQ        EXITGG
* END /GETDZ/ 
