Retro1.org codex

*DECK MGROW 
          IDENT  MGROW
          LIST   F
          ENTRY  MGROW
          EXT    ABORT
          EXT    MGETS
          EXT    MRELS
          EXT    OMOVE
          EXT    XTRACE 
*IF DEF,IMS 
*#
*1DC MGROW
*     1. PROC NAME           AUTHOR              DATE 
*        MGROW               P.C.TAM             78/07/05 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        EXPAND THE SIZE OF A BUFFER. 
* 
*     3. METHOD USED. 
*        WITH DEBUG ON, MGROW WILL CHECK IF BLOCK SIZE IS ZERO, 
*        IF REQUESTED SIZE IS ZERO, OR IF REQUESTED SIZE IS 
*        SMALLER THAN BLOCK SIZE. MGROW WILL ABORT ON THOSE 
*        CONDITIONS.
*        MGROW WILL GET A BUFFER OF REQUESTED SIZE, MOVE
*        INFORMATION TO NEW BLOCK, AND RELEASE OLD BUFFER.
* 
*     4. ENTRY PARAMETER. 
*        (A1) = ADDRESS OF THE ADDRESS OF THE OLD BUFFER ADDRESS
*        (A1)+1 = ADDRESS OF THE ADDRESS OF THE REQUIRED SIZE 
* 
*     5. EXIT PARAMETER.
*        (A1) = ADDRESS OF THE ADDRESS OF NEW BUFFER ADDRESS
*         (A1)+2 = ADDRESS OF THE ADDRESS OF THE COMPLETE FLAG
*                  FLAG SET TO 1 IF MOVE IS SUCCESSFUL
* 
*     6. COMMON DECKS CALLED. 
*        CYBERDEFS INPARU MACDEF FREETAB
* 
*     7. ROUTINES CALLED. 
*        ABORT               ABORT NIP
*        MGETS               ALLOCATE A BUFFER FROM FREE POOL 
*        MRELS               RELEASE A BUFFER TO FREE POOL
*        OMOVE               MOVE INFORMATION 
*        XTRACE              TRACE CALLER 
* 
*     8. DAYFILE MESSAGES.
*        *MGROW CALL ERROR* - OLD OR NEW BLOCK ZERO SIZE, 
*                             NEW BLOCK SIZE LESS THAN OLD SIZE.
* 
*#
*ENDIF
 
*CALL MACDEF
*CALL CYBERDEFS 
*CALL INPARU
*CALL FREETAB 
 
 MGROW    SUBR   =           ENTRY/EXIT 
          SA2    X1          (X2)=BUFADDR 
          SB1    1
          LOAD   A3,X2,FRBBS# (X3)=HEADER WORD OF BUFADDR 
          SA4    A1+B1       (X4)=REQUIRED SIZE 
          LX3    -FRBBS?+FRBBS$-1 RIGHT JUSTIFY BLOCK SIZE
          SA4    X4 
          SX5    X3 
 
 GRF2     IFEQ   DEBUG,1
          IX6    X4-X5       REQUEST SIZE MINUS BLOCK SIZE
          MI     X6,GRZ      ERROR IF BLOCK SIZE GR NEW SIZE
 GRF2     ENDIF 
 
          SX7    A1          SAVE A1
          BX6    X4          SET UP PARM FOR MGETS CALL 
          SA7    SAVEA1 
          SA6    MGPM 
          SA1    MGPMD
          RJ     MGETS       MGETS(SIZE, BUFAD, FALSE)
          SA1    SAVEA1 
          SB1    1
          SA5    MGPM+1      (X5)=BUFAD 
          SA1    X1 
          SA2    A1+2        (X2)=ADDR OF 3RD PARM
          ZR     X5,GRY      BUFAD ZERO 
 
**
*         GET NEW BUFFER
 
          SX7    B1          COMPLETE=TRUE
          BX6    X5          (X6)=BUFAD 
          SA7    X2 
          SA2    X1          (X2)=BUFADDR 
          SA6    X1          BUFADDR=BUFAD
          LOAD   A3,X2,FRBBS# (X3)=HEADER WORD OF OLD BUFADDR 
          SX7    X2+B1       MOLD=BUFADDR+1 
          LX3    -FRBBS?+FRBBS$-1 RIGHT JUSTIFY BLOCK SIZE
          SX6    X5+B1       MNEW=BUFAD+1 
          SA7    MOLD 
          MX0    -1          (X0)=-1
          SA6    MNEW 
          SX4    X3          (X4)=OLD BLOCK SIZE
          IX7    X4+X0       MSIZE=OLD BLOCK SIZE - 1 
          SA7    MSIZE
          BX6    X3-X4       BUILD NEW HEADER 
          LOAD   A5,X5,FRBBS# (X5)=HEADER WORD OF BUFAD BUFFER
          BX7    X2          (X7)=OLD BUFFADR 
          LX5    -FRBBS?+FRBBS$-1 RIGHT JUSTIFY BLOCK SIZE
          SA7    MRPM 
          SX5    X5 
          BX6    X6+X5
          SB2    A5 
          LX6    FRBBS?-FRBBS$+1  NEW BLOCK HEADER FOR BUFAD
          SB3    B2+X4       (B3)=BUFAD+OLD BLOCK SIZE
          SA6    A5 
          MX7    0
          SB4    B2+X5       (B4)=BUFAD+NEW BS
 
 GRW      GE     B3,B4,GRX   LOOP TO ZERO OUT REST OF BLOCK 
          SA7    B3 
          SB3    B3+B1
          EQ     GRW
 
 GRX      BSS    0
          RJ     OMOVE       COPY INFORMATION FROM OLD BLOCK
          SA1    MRPMD
          RJ     MRELS       RELEASE OLD BLOCK
          EQ     MGROWX      RETURN 
 
 GRY      BSS    0
          MX7    0
          SA7    X2          COMPLETE=FALSE 
          EQ     MGROWX 
 
 GRF5     IFEQ   DEBUG,1
 GRZ      BSS    0
          SA1    MSGDR
          RJ     ABORT       *----ABORT----*
 
 MSGDR    VFD    60/MSGD
          BSSZ     1
 MSGD     DATA   L*MGROW CALL ERROR*
 GRF5     ENDIF 
 
 MRPMD    BSS    0
 MGPMD    VFD    60/MGPM
          VFD    60/MGPM+1
          VFD    60/MGPM+2
 MRPM     BSS    0
 MGPM     BSSZ   3           SIZE, BUFAD, FALSE 
 SAVEA1   BSSZ   1
 
          END