*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