Retro1.org codex

*DECK MGETC 
          IDENT  MGETS
          SST 
          ENTRY  MGETS
 
          ENTRY  MEM
          ENTRY  CFOFLG 
          ENTRY  CFOWD
          ENTRY  LDPM 
          ENTRY  PGNAME 
          ENTRY  RASSC
 
          EXT    ABORT
          EXT    MRELS
          EXT    MSEIZE 
          EXT    OCFL 
          EXT    OMSG 
          EXT    XTRACE 
          SYSCOM
 MEM      EQU    0
          LIST   F
*IF DEF,IMS 
*#
*1DC  MGETS 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        MGETS               P. C. TAM           77/09/27 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE IS RESPONSIBLE FOR GETTING A LARGE ENOUGH BUFFER
*        FROM FREE CHAIN FOR THE CALLING ROUTINE AND RETURN THE EXTRA 
*        WORDS TO THE FREE CHAIN. 
* 
*     3. METHOD USED. 
*        SCAN FREE CHAIN FOR A BUFFER FIT THE REQUESTED SIZE BEST.
*        IF CAN NOT FIND A BIG ENOUGH BUFFER THEN CALL OCFL TO ISSUE
*        MEMORY REQUEST TO THE OPERATING SYSTEM FOR ADDITIONAL SPACE
*        OF REQUESTED SIZE + 300 WORDS. (IF NIP MAXFL NOT REACHED YET)
*        DELINK THE BUFFER FOUND FROM FREE CHAIN. 
*        RELEASE EXTRA WORDS FROM BUFFER FOUND. 
*        ZERO OUT THE BUFFER AND SET BLOCK SIZE.
* 
*     4. ENTRY PARAMETERS.
*        (X1) = ADDRESS OF THE REQUIRED SIZE OF BUFFER
* 
*     5. EXIT PARAMETERS. 
*        (A1)+1 = ADDRESS OF THE ADDRESS OF THE BUFFER ADDRESS
*        (A1)+2 = ADDRESS OF THE ADDRESS OF ZERO FLAG 
* 
*     6. COMDECKS CALLED. 
*          CYBERDEFS  FREETAB  INPARU MACDEF
*          STATTAB2  SYSTIME
* 
*     7. ROUTINES CALLED. 
*          MSEIZE            RELEASE BUFFER SPACE 
*          OCFL              MAKE MEMORY REQUEST TO OPERATING SYSTEM
*          OMSG              LOG ERROR MESSAGE
*          XTRACE            RECORD CALL
* 
*     8. DAYFILE MESSAGES.
*        *MAX FL REACHED
* 
*#
*ENDIF
*CALL SYSCOMD 
*CALL MACDEF
*CALL CYBERDEFS 
*CALL INPARU
*CALL FREETAB 
*CALL STATTAB2
*CALL SYSTIME 
 
 
 MGETS    SUBR   =           ENTRY/EXIT 
 
*         (A0)=ADDRESS OF PARM BLOCK
 
          SX6    A1          (X6)=ADDR OF PARM BLOCK
          SA6    PARMA       (PARMA)=ADDR OF PARM BLOCK 
          SA0    A1          (X0)=ADDR OF PARM BLOCK
 
          IFEQ   DEBUG,1,6
          SX6    A1 
          SA6    TEMP 
          SX1    XMGETC 
          RJ     XTRACE 
          SA1    TEMP 
          SA1    X1 
 
 
 
* 
* STEP 1  SCAN FREE CHAIN FOR BEST FIT SPACE
*         FOLLOWING REGISTERS ARE SET IN THIS STEP: 
*         (X1)=REQUIRED BUFFER SIZE (RQSIZE)
*         (X2)=FRESFB (TOTAL SIZE OF ALL FREE BUFFERS)
*         (X3)=FRENOFB (TOTAL NUMBER OF FREE BUFFERS) 
 
          SA1    X1          (X1)=RQSIZE VALUE
          SB7    X1          (B7)=RQSIZE VALUE
          SA2    FRETAB+FRESFB#        (X2)=FRESFB VALUE
          SB6    X2          (B6)=FRESFB VALUE
          SA4    MAXFL
          SB2    X4          (B2)=MAXFL 
 
 B1       IFNE   BESTFIT,1
          LT     B6,B7,MGTS8 BRANCH IF FRESFB LS RQSIZE 
          MX0    -1          (X0)=-1
          SA3    FRETAB+FRENOFB#       (X3)=FRENOFB 
          SA4    FRETAB+FREFBFP#       (X4)=FREFBFP WORD
          BX7    X3 
 
*         (A4)=ADR OF BUFFER EXAMINED CURRENTLY 
*         (B4)=A4 AFTER LOOP TERMINATED 
 
 MGTS1    ZR     X7,MGTS7    CHECK FOR LOOP TERMINATION 
          SA4    X4          (X4)=FRBFBFP OR FREFBFP WORD 
          BX5    X4 
          LX5    -FRBBS?+FRBBS$-1 (X5)=FRBBS FIELD RIGHT JUSTIFIED
          SX5    X5 
          IX5    X5-X1       (X5)=FRBBS[0]-RQSIZE 
          ZR     X5,MGTS7    BRANCH IF FRBBS[0]-RQSIZE ZERO 
          PL     X5,MGTS7    BRANCH IF FRBBS[0]-RQSIZE GR ZERO
          IX7    X7+X0       (X7)=X7-1
          EQ     MGTS1       LOOP BACK
 
 MGTS7    BSS    0
          SB4    A4          SAVE CHOSEN BUFFER ADR 
 
 S1       IFEQ   STAT,1 
          IX7    X3-X7       UPDATE ST$GNB
          SA4    ST$GNB 
          IX7    X4+X7
          SA7    A4 
 S1       ENDIF 
 
          ZR     X5,MGTSZ    FOUND BUFFER 
          PL     X5,MGTSZ    FOUND BUFFER 
 
 B1       ELSE
          SB5    X4          MAX FL 
 
          LT     B6,B7,MGTS8 BRANCH IF FRESFB LS RQSIZE 
          MX0    -1          (X0)=-1
          SA3    FRETAB+FRENOFB#
          SA4    FRETAB+FREFBFP#
          BX7    X3 
 
*         (A4)=ADDR OF CURRENT BUFFER EXAMINED
*         (B4)=SET TO A4 AT LOOP END
 
 MGTS1    ZR     X7,MGTS7    CHECK FOR EXIT FROM LOOP 
          SA4    X4          (X4)=FRBFBFP OR FREFBFP WORD 
          BX5    X4 
          LX5    -FRBBS?+FRBBS$-1 (X5)=FRBBS FIELD RIGHT JUSTIFIED
          SX5    X5 
          IX5    X5-X1       (X5)=FRBBS-RQSIZE
          SB7    X5 
          LT     B7,B0,MGTS2 BRANCH IF B7 LS ZERO 
          GE     B7,B5,MGTS2 BRANCH IF FRBBS-RQSIZE GR B5 
          SB5    B7          NEW MIN FRBBS-RQSIZE 
          SB4    A4          CORRESPONDING BUFFER 
          EQ     B7,B0,MGTS7 BRANCH IF FRBBS-RQSIZE ZERO
 
 MGTS2    BSS    0
          IX7    X7+X0       (X7)=X7-1
          EQ     MGTS1       LOOP BACK
 
 MGTS7    BSS    0
 
 S1       IFEQ   STAT,1 
          IX7    X3-X7       UPDATE ST$GNB
          SA5    ST$GNB 
          IX7    X7+X5
          SA7    A5 
 S1       ENDIF 
 
          LT     B5,B2,MGTSZ BRANCH IF FRBBS-RQSIZE IS SET
 B1       ENDIF 
 
*** 
* 
*         CANNOT FIND BIG ENOUGH BUF
*         ASK SYSTEM FOR MORE SPACE IF NIP HAS NOT REACH MAX FL 
* 
 MGTS8    BSS    0
          RJ     MSTAVF      CALL INTERNAL PROC TO EXTEND PROGRAM LEN 
          SA1    PARMA       (X1)=ADDR OF PARM BLOCK
          SA0    X1          (A0)=ADDR OF PARM BLOCK
          SA1    X1          (X1)=RQSIZE ADDR 
          SA1    X1          (X1)=RQSIZE VALUE (RESTORE X1) 
          SA5    CTLSLWA     (X5)=(CTLSLWA) 
          SB7    X5          (B7)=(CTLSLWA) 
          SA4    TEMP2       (X4)=(TEMP2) 
          BX7    X4          (X7)=(TEMP2) 
          SA7    A5          CTLSLWA=(TEMP2)
          IX4    X4-X5       (X4)=NEW CTLSLWA - OLD CTLSLWA 
          SA2    FRETAB+FRESFB#        (X2)=(FRESFB)
          IX7    X2+X4       (X7)=(FRESFB)+(TEMP1)
          SA7    A2 
          SA5    FRETAB+FREFBBP#       (X5)=(FREFBBP WORD)
          MX0    -FRBBS$     (X0)=MASK FOR FRBBS FD 
          LX5    -FREFBBP?+FREFBBP$-1  RIGHT JUSTIFY (FREFBBP)
          SB6    X5          (B6)=(FREFBBP) 
          LX0    FRBBS?-FRBBS$+1       SHIFT TO APP POS IN WORD 
          LOAD   A5,B6,FRBBS# (X5)=(FRBBS[FREFBBP] WORD)
          BX6    -X0*X5      (X6)=(FRBBS[FREFBBP] FD) 
          LX6    -FRBBS?+FRBBS$-1      RIGHT JUSTIFY (FRBBS[FREFBBP] FD)
          SB5    B6+X6       (B5)=(FRBBS[FREFBBP])+(FREFBBP)
          EQ     B7,B5,MGTSR5 BRANCH IF CTLSLWA EQ (B5) 
 
*         LAST FREE BUFFER NOT AT CTLSLWA 
 
          SA3    FRETAB+FRENOFB#       SET NEW FRENOFB
          MX7    -1          (X7)=-1
          SB4    B7          BUFWA=(CTLSLWA ORIGINAL) 
          IX7    X3-X7       (X7)=X3+1
          SA7    A3 
          LX4    FRBBS?-FRBBS$+1       SHIFT TO APPP POS IN WORD
          SX7    FRETAB+FREFBFP#       (X7)=FRETAB+FREFBFP
          BX7    X7+X4       (X7)=NEW BUFWA HEADER BS, FP SET 
          SX6    B6          (X6)=(FREFBBP) 
          LX6    FREFBBP?-FREFBBP$+1   SHIFT TO APP POS IN WORD 
          BX7    X7+X6       (X7)=NEW BUFWA HEADER
          SA7    B4          WRITE TO CM
          EQ     MGTSZ
 
*         LAST BUFFER AT CTLSLWA
 
 MGTSR5   SB4    B6          BUFWA=(FREFBBP)
          IX6    X6+X4       (X6)=FRBBS[FREFBBP]+TEMP1
          LX6    FRBBS?-FRBBS$+1       SHIFT TO APP POS IN WORD 
          BX7    X0*X5       (X7)=(FRBBS[FREFBBP] WORD MINUS BS FD) 
          BX7    X7+X6       (X7)=NEW BUFFER HEADER 
          SA7    B4          WRITE TO CM
 
 
*** 
*         FOUND, CALL MSEIZE TO DELINK FROM FREE CHAIN
* 
 
 MGTSZ    BSS    0
          SA4    A0+1        (BUFWA)=ADDR OF SELECTED BUFFER
          SX6    B4 
          SA6    X4 
          RJ     MSEIZE 
          EQ     MGETSX      EXIT 
 
 
*     INTERNAL PROCEDURE USED IN TWO PLACES IN MGETC
 
*IF DEF,IMS 
*#
*1DC  MSTAVF
*     1. PROC NAME           AUTHOR              DATE 
*        MSTAVF              P.C.TAM             78/08/25 
* 
*     2. FUNCTION DESCRIPTION.
*        INTERNAL PROCEDURE FOR MGETS.
* 
*     3. METHOD USED. 
*        UPDATE STATISTICS VARIABLES ST$FL, ST$FLW, ST$FLT. 
*        CALL OCFL TO EXTEND PROGRAM LENGTH.
* 
*     4. ENTRY PARAMETERS.
*        X7                  NO OF WORDS PROGRAM LENGTH IS INCREASED
*        B7                  NEW PROGRAM LENGTH 
* 
*     5. EXIT PARAMETERS. 
*        NONE 
* 
*     6. COMMON DECKS CALLED. 
*        NONE.
* 
*     7. ROUTINES CALLED. 
*        OCFL                INCREASE PROGRAM LENGTH
* 
*     8. DAYFILE MESSAGES.
*        NONE.
* 
*#
*ENDIF
 
 MSTAVF   SUBR   =           ENTRY/EXIT 
 
 S3       IFEQ   STAT,1 
          MX6    -1          (X6)=-1
          SA4    ST$FL       INCR NO OF FL INCREASE 
          IX6    X4-X6       (X6)=X4+1
          SA6    A4 
          SA4    ST$FLW      INCR NO OF WORD INCREASED
          IX6    X4+X7
          SA6    A4 
 S3       ENDIF 
 
          SA5    CTLSLWA
          SB7    X5          CURRENT LWA
          LT     B7,B2,MSTAVF0     MAX FL NOT YET REACHED 
          SA1    MSGERR      MAXFL REACHED, NO BUFFER TO ALLOCATE 
          RJ     ABORT       *----- ABORT -----*
 
 MSTAVF0  BSS    0           REQUEST OS FOR MORE MEMORY 
          SX7    X1+577B     (X7)=RQSIZE+320+63 
          AX7    6
          LX7    6           (X7) ROUNDED TO NEAREST 100B 
          SA5    CTLSLWA     LWA OF FL
          IX6    X5+X7
 
*         CHECK IF REACHED MAXIMUM FIELD LENGTH 
 
          SA4    MAXFL       MAX FIELD LENGTH FOR NIP 
          IX7    X4-X6       COMPARE TO NEW LWA 
          ZR     X7,MSTAVF1  EXIT IF REACHED MAX FL 
          PL     X7,MSTAVF2  EXIT IF NOT EXCEEDED MAX FL
 MSTAVF1  SX6    X4          LWA SET TO MAX FL
          MX0    FREMFL$     SIZE OF FIELD OF MAX-FIELD-LENGTH FLAG 
          SA4    FRETAB+FREMFL#  WORD CONTAINING MAX-FIELD-LENGTH FLAG
          BX7    X4+X0       CLEAR MAX-FIELD-LENGTH FIELD 
          SA7    A4          SET MAX-FIELD-LENGTH FLAG
 MSTAVF2  SA6    TEMP2       SAVE NEW LWA 
          SA1    TMP2A
          RJ     OCFL 
 
 S4       IFEQ   STAT,1 
          SA5    THETIME+RTSECS#       SYSTEM TIME
          MX0    RTSECS$     MASK FOR RTSECS FD 
          IFNE   RTSECS?,WL-1,1        IF SEC FD NOT LEFT JUST. 
          LX5    WL-1-RTSECS? LEFT JUST.
          BX5    X0*X5       SECOND FD ONLY 
          SA4    TIMECFL     TIME OF LAST OCFL CALL 
          SA3    CTLSLWA     OLD FL 
          LX5    RTSECS$     RJ SECOND FD 
          LX3    -6          OLD FL IN 100B MULTIPLE
          SA1    ST$FLT 
          IX2    X5-X4
          BX7    X5 
          DX6    X3*X2       (X6)=NIP OLD FL * ELAPSED TIME 
          SA7    A4          UPDATE TIME OF LAST OCFL CALL
          IX6    X6+X1       ACC ST$FLT 
          SA6    A1          UPDATE ST$FLT
 S4       ENDIF 
 
          EQ     MSTAVFX
 
 MSGERR   VFD    60/MSGMFL
          BSSZ   1
 MSGMFL   DATA   L*MGETC/MAXFL REACHED. * 
 XMGETC   DATA   L*MGETC* 
 TEMP     BSS    1
 TEMP2    BSSZ   1
 PARMA    BSSZ   1
 TMP2A    VFD    60/TEMP2 
          END