Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/17/sa.mac
There are 3 other files named sa.mac in the archive. Click here to see a list.
SUBTTL SIMULA RUNTIME SYSTEM, STORAGE ALLOCATION
; Author: Lars Enderin, Reidar Karlsson
; Version: 4 (11,65,72,175,215,265,273,276)
; Purpose: To manage storage for objects (RTS dynamic data).
SEARCH SIMMAC,SIMMCR,SIMRPA
SALL
; The SA module contains the following procedures:
intern .SAAB ; Allocate block instance record
; (without display record).
intern .SAAR ; Allocate a non-block record (array, text, ac stack etc).
intern .SACL ; Give a log message and close GCP.TMP
intern .SADB ; Allocate a block record with
; an attached display record.
intern .SADE ; Deallocate record. Not implemented in the first RTS
; version.
intern .SAGC ; Garbage collector.
intern .SAGI ; Garbage collector initialization
intern .SAIN ; Initialize ref and array variables in a block.
intern .SANP ; Determine and allocate new storage pool area.
Comment;
The routines described implement a particular storage allocation
scheme, which may be changed as experience is gained. Essentially,
storage is allocated in a contiguous pool, starting at YSABOT(XLOW).
All blocks are allocated from YSABOT upwards. YSATOP(XLOW) at each
instant shows the next free location. When YSATOP reaches YSALIM,
.SAGC is called to get more core, and if necessary, reclaim unused
storage. YSALIM is adjusted to leave room for a maximal acs object
(of size 2+QNAC*2 words), ensuring that the accumulators can always
be saved before garbage collection is performed.
***AUBEG
IFN QKI10,<
[175] Statistics of page faults between and during garbage
collections are collected and used in SANP to determine virtual
memory size for paging jobs. YSANWA and YSANWC are used to save
paging data.
>
***AUEND;
RTITLE SA
TWOSEG
RELOC 400K
MACINIT
ERRMAC SA
edit(65)
IFNDEF QZERO,<QZERO==0> ;[65] Do not zero new core (should be zero)
IFE QDEBUG,< DEFINE ASSERT(B)=<>
>
EXTERN .JBREL, .JBFF, .JBHRL
ASSERT<
INTERN SAGCLE,SAGCOD,SAGCOO
EXTERN SAPDCO,SAPDOI,SAPDTO
EXTERN .OCINC, .OCIN7, .OCIND
OPDEF FREEBUFF [PUSHJ XPDP,.OCINC] ;Frees a buffer area
OPDEF GETBUFF [PUSHJ XPDP,.OCIN7] ;Finds a free buffer
OPDEF LINKBUFF [PUSHJ XPDP,.OCIND] ;Links a buffer ring
edit(273) ;[273]
DEFINE CLAIMBUFF <
LF X0,ZBHLEN(X1)
MOVN X0,X0
SF X0,ZBHLEN(X1)
>
>
DEFINE ZDNCASE(z,w)<
LF XTYP,ZDNTYP(XCUR)
IFN QDEBUG,<
JUMPL XTYP,.+2
CAILE XTYP,QZDNTM
GOTO @.+2
>
GOTO @.+1(XTYP)
DEFINE X(A)<IRP A,<EXP w''A''z>>
TYPZDN
>
;Constants used in .SAGC and .SANP
; All floating point constants are stored in right half
; as immediate constants
RH= -^D18 ;To shift a floating point assembly
; constant to the right half
QSAF0= 0.0_RH ;F0 floating initial value of F^ (YSAFES)
QSAR0= 0.0_RH ;R0 " initial value of R^ (YSARES)
QSAB0= 0.0_RH ;B0 " initial value of B^ (YSABES)
IFN QSASTE,<
QSAPMI= ^D256 ;Min free pool area
>
IFE QSASTE,<
QSALMI= ^D512 ;Min low seg area change (treshold value) that
; causes a core request after garbage collection
>
QSALF= 0.0_RH ;LF floating exponential smoothing const. for F^
QSALR= 0.0_RH ;LR " exponential smoothing const. for R^
QSALB= 0.0_RH ;LB " exponential smoothing const. for B^
QSAL1F= 1.0_RH ;L1F floating QSALF + 1.0
QSAL1R= 1.0_RH ;L1R " QSALR + 1.0
QSAL1B= 1.0_RH ;L1B " QSALB + 1.0
;=========== N O T E !!!!!!!!!!!!!! ========================================
;======== QSAL? and QSAL1? MUST be CHANGED at the SAME time ==================
;==============================================================================
QCHGCP=17 ;GCP.TMP channel number
.IOBIN=14 ;GCP.TMP data mode (binary)
QPROTE=0 ;1: a fixed pool is allocated
;0: the dynamic allocation formula is used
IFN <%ZDNTYP-^D17>,<CFAIL ZDNTYP field must end in bit 17..>
SUBTTL .SAAB (allocate block record)
; Purpose: To allocate a block record without a display record.
; Input: Prototype address in XSAC.
; Output: Address of the new block in XRAC.
; Function: Take the length from ZPRBLE(XSAC). If YSATOP+length
; > YSALIM, call .SAGC with the difference in X0.
; Place the current value of YSATOP in XRAC and
; increase YSATOP by the length. Set ZBIZPR=XSAC,
; which should be preserved (not destroyed by .SAGC).
; Return.
.SAAB: PROC
SAVE <X0,XSAC>
LOWADR
LF ,ZPRBLE(XSAC)
ADD YSATOP(XLOW)
SUB YSALIM(XLOW)
IF ;Not enough space
JUMPLE FALSE
THEN ;Collect garbage to get more
EXEC .SAGC
FI
L XRAC,YSATOP(XLOW)
LF ,ZPRBLE(XSAC)
ADDM YSATOP(XLOW)
REPEAT 0,<
SETZM ZBI%S(XRAC)
IF ;More than one variable
CAIG ZBI%S+1
GOTO FALSE
THEN
STACK XTAC
LI ZBI%S+1(XRAC)
HRLI ZBI%S(XRAC)
L XTAC,YSATOP(XLOW)
BLT -1(XTAC)
UNSTK XTAC
FI
>
MOVSI QZBI
WSF ,ZDNTYP(XRAC)
WSF XSAC,ZBIZPR(XRAC)
EXEC .SAIN ;Initialize any ref and/or array variable
RETURN
EPROC
SUBTTL .SAAR (allocate non-block record)
; Purpose: Allocate a dynamic record of given length and type and return
; its address.
; Input: XTAC= XWD record type,record length
; Output: New record address in XTAC.
; Function: If YSATOP + length > YSALIM, call .SAGC. Set XTAC to the
; current value of YSATOP, and increase YSATOP with the given
; length. Initialize data area with YSANIN value (if not = -1).
; Reset YSANIN to zero. Store record type in ZDNTYP field, length
; in second word (which is the most common place), then return.
.SAAR: PROC
LOWADR
LI (XTAC) ;Length
ADD YSATOP(XLOW)
SUB YSALIM(XLOW)
IF
JUMPLE FALSE
THEN
EXEC .SAGC
FI
HLLZM XTAC,@YSATOP(XLOW) ;Type
LI (XTAC) ;Length,
L XTAC,YSATOP(XLOW)
ST 1(XTAC) ;put it in second word
ADD XTAC
ST YSATOP(XLOW)
IF ;Initialization required
AOSN YSANIN(XLOW)
GOTO FALSE
THEN
STACK XSAC
IF
SOSN XSAC,YSANIN(XLOW)
GOTO FALSE
THEN
ST XSAC,2(XTAC)
LI XSAC,3(XTAC)
HRLI XSAC,2(XTAC)
EXCH XSAC
CAILE XSAC,3(XTAC) ;If more than one data word,
BLT -1(XSAC) ;initialize the rest
FI
UNSTK XSAC
FI
SETOM YSANIN(XLOW)
RETURN
EPROC
SUBTTL .SACL (close GCP.TMP)
COMMENT;
Purpose: Give a GC log message.
Output the final GC parameter values
and close GCP.TMP in debug version.
Entry: .SACL
Normal exit: RETURN
Call format: EXEC .SACL
Used subroutines: SANPDU, SAGCOD
FREEBUFF
;
.SACL:
PROC
;***AUBEG
IFN QKI10,<
edit(175) ;[175] save X3 too!
SAVE <X0,X1,X2,X3>
>
IFN QKA10,<
SAVE <X0,X1,X2>
>
;***AUEND
LOWADR(X16)
IF ;GC was ever called
SKIPN X1,YSAGCN(XLOW)
GOTO FALSE
THEN ;Log number of GC's, GC time
OUTSTR [ASCIZ /
/]
IFN QDEBUG,<
L X0,YSASW(XLOW)
SETONA SWGCT2
>
EXEC SAGCOD
edit(265) ;[265]
OUTSTR [ASCIZ / garbage collection(s) in /]
L X1,YSAGCT(XLOW)
EXEC SAGCOD
OUTSTR [ASCIZ / ms
/]
FI
REPEAT 0,<;[276] Misleading, don't output
edit(175)
;[175] type page fault statistics
L X3,[%VMSPF]
GETTAB X3,
SETZ X3,
HLRZ X3,X3
SUB X3,YSANWA(XLOW)
HRLZ X3,X3
ADDB X3,YSANWC(XLOW) ;Cumul. NIW count between GC:s in left half
IF SKIPN X3
GOTO FALSE
THEN
edit(265) ;[265]
OUTSTR [ASCIZ"[Page faults between/during G.C.'s]=["]
HLRZ X1,X3 ;NIW faults between
EXEC SAGCOD
LI X1,"/"
OUTCHR X1
HRRZ X1,X3 ;NIW faults during GC:s
EXEC SAGCOD
OUTSTR [ASCIZ/]
/]
FI >;[276]
IFN QDEBUG,<
;If log output on GCP.TMP
;Update TIM and set TAU
IF
L X0,YSASW(XLOW)
IFONA SAGCPE
GOTO FALSE
THEN
SETZ X0,
RUNTIM X0,
L X1,YSATIM(XLOW)
SUB X0,X1
FLTR X0,X0
ST X0,YSATAU(XLOW)
;Set YSATIM to -1 to indicate last dump record and dump
SETOM YSATIM(XLOW)
EXEC SANPDU
;Close GCP.TMP and release buffer
CLOSE QCHGCP,
L X1,YSABH(XLOW)
FREEBUF
FI
>
RETURN
EPROC
SUBTTL .SADB (allocate block record with display)
; Purpose: To allocate a block record with an attached display record and
; fill some fields with information.
; Input: Block type in XSAC left half, prototype address in the right
; half.
; Output: XRAC = address of the new block instance.
; Function: If the length of the display record (ZPCDLE(XSAC)) plus the
; length of the block (ZPRBLE) plus YSATOP > YSALIM, call .SAGC.
; The display record is allocated, and the ZDNTYP, ZDRLEN, ZDRZAC
; fields are set. ZDRZAC is copied from YCSZAC.
; XRAC is set to the block instance address, ZDNTYP and ZBIZPR are
; copied from the input parameter (XSAC), ZDNZAC is set if YCSZAC
; is non-zero. YCSZAC is reset. ZDRZBI:-XCB, ZDRARE:=YOBJRT.
; Store new ZBI address at ZPREBL in the display. Initialize the
; block to zeros, except for REF variables, the value of a REF
; PROCEDURE and ARRAY variables, which are initialized to NONE.
.SADB: PROC
SAVE <X0,XSAC,XTAC>
LOWADR
LF XRAC,ZPCDLE(XSAC)
LF ,ZPRBLE(XSAC)
ADDI (XRAC)
ADD YSATOP(XLOW)
SUB YSALIM(XLOW)
IF JUMPLE FALSE
THEN EXEC .SAGC
FI
L XTAC,YSATOP(XLOW)
MOVSI QZDR
WSF ,ZDNTYP(XTAC)
SF XRAC,ZDRLEN(XTAC)
L YCSZAC(XLOW)
IF ;Any ac's saved
JUMPE FALSE
THEN ;Mark the block
SF ,ZDRZAC(XTAC)
SETONA ZDNACS(XSAC)
FI
SETZM YCSZAC(XLOW)
ADDI XRAC,(XTAC) ;ZBI address
repeat 0,<
SETZM 2(XTAC)
LI 3(XTAC)
IF CAIL -1(XRAC)
GOTO FALSE
THEN HRLI 2(XTAC)
BLT -2(XRAC)
FI
>
HRRZM XSAC,OFFSET(ZBIZPR)(XRAC)
HLLZM XSAC,OFFSET(ZDNTYP)(XRAC)
LFE XTAC,ZPREBL(XSAC) ;Innermost display level
ADDI XTAC,(XRAC)
ST XRAC,(XTAC)
SF XCB,ZDRZBI(XRAC) ;Dynamic link
HRRZ YOBJRT(XLOW)
SF ,ZDRARE(XRAC) ;Return address
LF XSAC,ZPRBLE(XSAC) ;Block length
ADD XSAC,XRAC
ST XSAC,YSATOP(XLOW)
REPEAT 0,<
SETZM ZBI%S(XRAC)
IF ;More than one variable
CAIG XSAC,ZBI%S+1(XRAC)
GOTO FALSE
THEN
LI ZBI%S+1(XRAC)
HRLI ZBI%S(XRAC)
BLT -1(XSAC)
FI
>
LF XSAC,ZBIZPR(XRAC) ;Get prototype for special initialization
LF ,ZPCTYP(XSAC) ;Check for type procedure
IF ;Ref procedure
CAIE QREF
GOTO FALSE
THEN
LI NONE
ST ZBI%S(XRAC)
FI
EXEC .SAIN ;Initialize any ref and/or array variable
RETURN
EPROC
SUBTTL .SADE (Deallocate record)
; Purpose: To return a record to the free pool.
; Input: YSARES(XLOW)= address of record to deallocate.
.SADE: RFAIL .SADE SHOULD NOT BE CALLED
RETURN
SUBTTL .SAGC (garbage collector)
; Purpose: To provide space for a new piece of data.
; Input: The amount of storage required is specified in X0. If
; YSAREL(XLOW) is different from zero, the pool should be moved
; upwards by that amount.
; Function: The garbage collector works in 4 phases.
; Phase 1:
; Start from XCB and internal run time record pointers and chain
; all referenceable records by their ZDNLNK fields.
; Search record references in records on the chain, chaining all
; found records to the end of the chain.
; Phase 2:
; When all referenceable records have been found, step through the
; storage pool from the start and compute new record addresses
; (assuming that the records should be moved towards the bottom of
; the pool). If YSAREL is non-zero, add it to all new addresses.
; The new addresses are saved in the ZDNLNK fields of the records.
; The unreferenceable records have ZDNLNK=0.
; [273] Do not relocate blocks below address given in YSAFRZ(XLOW).
; When all new addresses are determined, the minimum amount of
; core is requested to make it possible to continue execution
; after the garbage collection. If not enough core is available a
; run time error is generated.
; Phase 3:
; Step through the pool again and replace (update) all reference
; quantities in the system.
; Phase 4:
; Step through the pool a third time and move the records to their
; new positions as given by their ZDNLNK fields.
; Determine a new garbage collector limit and if QSASTE=1 a new
; optimal step size. If QSASTE=0 a pool up to the new garbage
; collector limit is allocated, and if QSASTE=1 a free pool step
; is allocated. If the CORMAX limit is exceeded, the CORMAX value
; is taken as the new garbage collector limit.
; If CORMAX > high segment start, use that as limit.
;REGISTER ASSIGNMENTS AND OPDEFS
XSW= X1 ;Switches the return jump in SAGCNP
XTYP= X1 ;Dyn. rec. type or formal param. type
XLO= X1 ;Used as XLOW
XST= X2 ;Store instruction to update pointers by XCT XST
XBEG= X2 ;First dyn. rec. in pool that must be moved
XPT= X3 ;New pointer value
XKND= X3 ;Formal parameter kind
XAD= X4 ;The address to be loaded into XST before XCT XST
; or address of first occupied word in the new pool
XTOP= X5 ;End of old pool = YSATOP(XLOW)
XCUR= X6 ;Current dyn. rec.
XIND= X7 ;Index register
XSTOP= X7 ;LOOP LIMIT
XSAV= X7 ;Save register
XEND= X10 ;End of ZDNLNK chain in PHASE1
XTOT= X10 ;Total length of adjacent not referenced rec.
XFROM= X10 ;Source address at word by word move
XFROTO= X10 ;BLT ac with source address in left half
;and target address in right
XZPR= X11 ;ZBIZPR
XZEV= X11 ;ZEV pointer
XLEN= X12 ;Length of current rec.
XLNK= X13 ;ZDNLNK
XBOT= X14 ;Bottom of the old pool YSABOT(XLOW)
XNEXT= XCB ;Address to routine NEXT
; (i.e. SAGCN1 in PHASE1 and SAGCN3 in PHASE3)
OPDEF NEXT [JRST (XNEXT)] ;Find next dyn. rec.
OPDEF NPOINT [JSP XSW,SAGCNP] ;Check new pointer
OPDEF NZEV [JSP X0,NEWZEV] ;Compute new zev pointer
OPDEF LENGTH [JSP X0,SAGCLE] ;XLEN := length of current rec.
OPDEF GOBACK [JSP X16,(X16)] ;Coroutine return
OPDEF OP [HRLI] ;Load operation in left half
DEFINE INPOOL <CAIL XPT,(XBOT) ;;Skip next if pointer in pool
CAIL XPT,(XTOP) >
DEFINE NPNT(F) < ;;Handle the pointer in the field F
IFE<%'F - ^D17>,<OP XST,(HRLM XPT,)> ;;Left half
LI XAD,OFFSET(F)(XCUR)
LF XPT,F(XCUR)
NPOINT
IFE<%'F - ^D17>,<OP XST,(HRRM XPT,)> ;;Right half
;;as default
>
OPDEF OUTOCT [PUSHJ 17,SAGCOO] ;Output octal number
OPDEF OUTDEC [PUSHJ 17,SAGCOD] ;Output decimal number
SUBTTL SAGCCH (Garbage collector coroutine)
Comment;
Purpose: Used in Phase 1 to chain a new dyn. rec. to the
ZDNLNK chain if it is not referenced before. Update
XEND to point to the latest chained rec.
Entry: SAGCCH
Input arguments: XPT points to the new record
Normal exit: GOBACK (JSP X16,(X16))
Call format: GOTO (XSW) where XSW contains the PC value
saved by the previous GOBACK.
;
SAGCCH: LF XLNK,ZDNLNK(XPT)
IF ;Not referenced before
JUMPN XLNK,FALSE
CAIN XPT,(XEND)
GOTO FALSE
THEN ;Chain the new rec. and update XEND
SF XPT,ZDNLNK(XEND)
LI XEND,(XPT)
IFN QDEBUG,< ;Log chained records if SWGCTE on
LOWADR(X1)
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN
RTEXT
L X1,XPT
OUTOCT
FI
>
FI
GOBACK ;to SAGCSP or SAGCGP
GOTO SAGCCH ;Entry for next coroutine call on SAGCCH
; Saved by GOBACK in X16
SUBTTL SAGCDR (Garbage collector subroutine)
Comment;
Purpose: Search for dynamic pointers in a display record.
The routine is used for ZBP, ZPB and ZCL records.
Entry: SAGCDR
Input arguments:
XCUR points to the ZBI record
immediately following the display record.
XZPR points to its prototype.
Normal exit: GOTO ZBI.
Call format: GOTO SAGCDR
;
SAGCDR: IF ;NOT Terminated AND NOT keepdisplay
L X0,(XCUR)
IFOFFA ZDNTER
GOTO TRUE
IFOFFA ZDNKDP
GOTO FALSE
THEN ;Display record is referenced
L XSTOP,XCUR
LF XLEN,ZPCDLE(XZPR)
SUBI XCUR,(XLEN)
;If ZDNLNK = 0 (i.e. in PHASE1),
; then mark this ZDR rec. as referenced
LF XLNK,ZDNLNK(XCUR)
IF
JUMPN XLNK,FALSE
THEN ;Put -1 in ZDNLNK to mark as referenced
HLLOS OFFSET(ZDNLNK)(XCUR)
FI
LI XAD,OFFSET(ZDRZAC)(XCUR)
OP XST,(HRLM XPT,)
LOOP
;Search for pointers into the pool in the left half
; of words in the display record area
; i.e. ZDRZAC, ZTSZBI and ZDRZBI fields
HLRZ XPT,(XAD)
SKIPE XPT
NPOINT
AS
AOJ XAD,
CAIGE XAD,(XSTOP)
GOTO TRUE
SA
LI XAD,OFFSET(ZDRZAC)(XCUR)
OP XST,(HRRM XPT,)
LOOP
;Search for pointers into the pool in the right half
; of words in the display record area
; i.e. display vector elements (ZDRZPB)
; and ZTSZAC fields
HRRZ XPT,(XAD)
SKIPE XPT
NPOINT
AS
AOJ XAD,
CAIGE XAD,(XSTOP)
GOTO TRUE
SA
L XCUR,XSTOP ;Restore XCUR
FI
BRANCH ZBI.
SUBTTL SAGCFP (Garbage collector subroutine)
Comment;
Purpose: Check formal parameter locations for ZBP, ZCL and ZPB rec.
Entry: SAGCFP
Input arguments: XCUR points to current dyn. rec. and
XZPR points to its prototype rec.
Normal exit: RETURN
Call format: EXEC SAGCFP
;
SAGCFP: HLLZ XIND,OFFSET(ZPCNRP)(XZPR) ;number of param's in left half
TLNN XIND,-1
RETURN ;No parameters
MOVNS XIND ;Number of param's negated in left half
HRRI XIND,OFFSET(ZPCZFP)(XZPR) ;XIND points to first formal
; parameter descriptor
LOOP
;Find the ZDVZBI,ZDSZBI,ZDLZBI,ZDAZAR,ZRVZBI,ZDPZBI and
; ZFLZBI pointers (i.e. the right half of the first word
; in the formal location)
LF X0,ZFPMOD(XIND)
LF XTYP,ZTDTYP(XIND)
LF XKND,ZPDKND(XIND)
IF
CAIN X0,QVALUE ; Not VALUE mode
CAIN XKND,QARRAY ; OR kind ARRAY
GOTO TRUE
CAIN XTYP,QREF ; OR type REF
GOTO TRUE
CAIE XTYP,QTEXT ; OR TEXT
GOTO FALSE
THEN ;We have an address in RH
LF XAD,ZFPOFS(XIND)
ADDI XAD,(XCUR) ;XAD = formal location address
HRRZ XPT,(XAD)
NPOINT
;Special code for procedures (not switches) not called by name
LF XTYP,ZTDTYP(XIND)
LF XKND,ZPDKND(XIND)
IF ;Procedure not called by name
CAIE XKND,QPROCEDURE
GOTO FALSE
IFNEQF XIND,ZFPMOD,QNAME
CAIN XTYP,QLABEL
GOTO FALSE
THEN ;Procedure not called by name and no switch
LF XPT,ZDPEBI(XAD)
LI XAD,OFFSET(ZDPEBI)(XAD)
NPOINT ;ZDPEBI
FI
IFEQF XIND,ZTDTYP,QREF
ADDI XIND,1 ;Allow for qualification
FI
AS
AOBJN XIND,TRUE ;more parameters
SA
RETURN
SUBTTL SAGCGP (Garbage collector subroutine)
Comment;
Purpose: Find global dynamic record pointers
i.e. pointers in the static area declared in SIMRPA.MAC
Entry: SAGCGP
Normal exit: RETURN
Call format: EXEC SAGCGP
;
SAGCGP: LOWADR(XIND)
;Start the chain with the outermost block
; which is fixed, allocated in generated code
L XCUR,YOCXCB(XLOW) ;Outermost block address
LI XEND,(XCUR) ;End of chain
LI XNEXT,.+2 ;Return address for SAGCSP
GOTO SAGCSP ;Search outermost block
;Make XNEXT point to first record
LI XNEXT,(XCUR) ;in the chain
LOWADR(XIND)
OP XST,(HRRM XPT,(XLOW)) ;Set the store inst. in XST
; to be indexed with XLOW
LI XAD,XCB+YSASAV
L XPT,XCB+YSASAV(XLOW)
NPOINT ;XCB
LI XAD,YTXZTV
HRRZ XPT,YTXZTV(XLOW)
NPOINT ;YTXZTV
LI XAD,YOBJAD
LI XCUR,(XAD)
ADDI XCUR,(XLOW) ;XCUR = YOBJAD + (XLOW)
HRLI XAD,-<QOBJAD + QNGP>
LOOP
HRRZ XPT,(XCUR)
NPOINT ;YOBJAD[0:QOBJAD-1] and
; YCSZAC,YSYSIN,YSYSOU,...
ADDI XCUR,1
AS
AOBJN XAD,TRUE
SA
;Channel table right half
LI XAD,YIOCHT
LI XCUR,(XAD)
ADDI XCUR,(XLOW) ;XCUR = YIOCHT + (XLOW)
HRLI XAD,-20
LOOP
HRRZ XPT,(XCUR)
NPOINT ;YIOCHT [0:17] right half
ADDI XCUR,1
AS
AOBJN XAD,TRUE
SA
;Channel table left half
OP XST,(HRLM XPT,(XLOW)) ;Pointer in left half
; indexed with XLOW
LI XAD,YIOCHT
LI XCUR,(XAD)
ADDI XCUR,(XLOW) ;XCUR = YIOCHT + (XLOW)
HRLI XAD,-20
LOOP
HLRZ XPT,(XCUR)
NPOINT ;YIOCHT [0:17] left half
ADDI XCUR,1
AS
AOBJN XAD,TRUE
SA
OP XST,(HRRM XPT,) ;Set default store instr. in XST
RETURN
SUBTTL SAGCLE (Garbage collector coroutine)
Comment;
Purpose: To determine the length of a dynamic record
Entry: SAGCLE
Input arguments: XCUR points to the record
Normal exit: GOTO @X0
Output arguments: XLEN contains the length
Call format: LENGTH (JSP X0,SAGCLE)
;
SAGCLE: edit(273)
ZDNCASE(,.) ;[273]
.ZDN: RFAIL Bad ptr in XCUR (SAGCLE)
.ZBI:
.ZBP:
.ZPB:
.ZCL: LF XZPR,ZBIZPR(XCUR)
LF XLEN,ZPRBLE(XZPR)
GOTO @X0
.ZTT: LI XLEN,ZTT%S
GOTO @X0
.ZAC: LF XLEN,ZACNAC(XCUR)
ADDI XLEN,2+OFFSET(ZACSVA)
GOTO @X0
.ZTE:
.ZAR:
.ZER:
.ZDR:
.ZYS:
.ZXB: LF XLEN,ZYSLG(XCUR)
GOTO @X0
SUBTTL SAGCN1,SAGCN3 (Garbage collector subroutines)
Comment;
Purpose: SAGCN1: To find next record in the ZDNLNK chain
SAGCN3: To find next record in pool and to update
internal pointers in the new record
Entries: SAGCN1,SAGCN3
Input arg.: SAGCN1: XCUR points to the rec just handled, and XEND points
to the last rec in the chain to be handled.
SAGCN3: XCUR points to the rec just handled and XLEN
contains the length of this rec. XTOP points to the
first free location in the pool. The ZDNLNK field
of a referenced record contains the new address.
Normal exits: GOTO SAGCSP
SAGCN1: GOTO PHASE2 at end of chain
SAGCN3: GOTO PHASE4 at end of pool
Call format: NEXT (GOTO (XNEXT) where XNEXT = SAGCN1 in PHASE1
and XNEXT = SAGCN3 in PHASE3)
;
SAGCN1: ;Find next rec. in chain
CAIN XCUR,(XEND)
GOTO PHASE2 ;Last rec. is already handled
LF XCUR,ZDNLNK(XCUR)
GOTO SAGCSP ;Handle next in chain
SAGCN3: ;Find next rec in the pool
LOOP
ADDI XCUR,(XLEN) ;XCUR points to the next
; rec. in pool
CAIL XCUR,(XTOP)
GOTO PHASE4 ;End of pool
AS
LF XLNK,ZDNLNK(XCUR)
JUMPN XLNK,FALSE ;Referenced rec.
LENGTH
GOTO TRUE ;Not referenced rec.
SA
;Update internal pointers in the new record
;i.e. add the difference new address [ZDNLNK(XCUR)]
; - old address [XCUR] to the internal pointer location
edit(273)
ZDNCASE(..) ;[273]
edit(265) ;[265]
ZDN..: RFAIL Bad ptr in XCUR (SAGCN3)
ZAR..: LF XLNK,ZDNLNK(XCUR)
SUBI XLNK,(XCUR)
ADDM XLNK,OFFSET(ZARBAD)(XCUR) ;ZARBAD
GOTO SAGCSP
ZER..: LF XSTOP,ZERLEN(XCUR)
ADDI XSTOP,(XCUR) ;XSTOP points to the first
; word of the next record
LF XLNK,ZDNLNK(XCUR)
SUBI XLNK,(XCUR) ;XLNK contains the relocation
; constant for all internal pointers
; in this ZER rec.
LF XPT,ZERZEV(XCUR)
IF ;Any free chain in this ZER rec.?
JUMPE XPT,FALSE
THEN
;Update the free chain
LI XZEV,(XPT)
ADD XPT,XLNK
SF XPT,ZERZEV(XCUR)
WHILE ;Not end of free chain
LFE XPT,ZEVZCH(XZEV)
JUMPL XPT,FALSE ;-1 = End of chain
IFN QDEBUG,< CAIL XPT,(XCUR)
CAIL XPT,(XSTOP)
RFAIL ZEVZCH points out of ZER rec.>
DO
LI XAD,(XZEV)
LI XZEV,(XPT)
ADD XPT,XLNK
SF XPT,ZEVZCH(XAD)
OD
FI
;Step through all ZEV nodes in the ZER rec. and update the link
; Pointers in used ZEV nodes (i.e. ZEV nodes with ZEVZCH = 0)
;The ZEVZER pointer is updated at the beginning of PHASE4 since this
; field is used to find the relocation factor in NEWZEV.
LI XZEV,ZER%S(XCUR)
LOOP
LF XPT,ZEVZCH(XZEV)
IF
JUMPN XPT,FALSE
THEN
IFN QDEBUG,<
LOWADR(X1)
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN ;Log the internal ZEV update
STACK X2
RTEXT (ZEV-ZBL -ZLL -ZRL at )
L X1,XZEV
OUTOCT
UNSTK X2
FI
>
;Update ZEV-ZBL,-ZLL,-ZRL
LF XPT,ZEVZBL(XZEV)
NZEV
SF XPT,ZEVZBL(XZEV) ;ZEVZBL
LF XPT,ZEVZLL(XZEV)
NZEV
SF XPT,ZEVZLL(XZEV) ;ZEVZLL
LF XPT,ZEVZRL(XZEV)
NZEV
SF XPT,ZEVZRL(XZEV) ;ZEVZRL
FI
STEP XZEV,ZEV
AS
CAIGE XZEV,1-ZEV%S(XSTOP)
GOTO TRUE
SA
GOTO SAGCSP
NEWZEV: ;Enter with the old ZEV pointer value in XPT
; Its new value is computed into XPT
INPOOL
GOTO @X0
LF XAD,ZEVZER(XPT)
LF XLNK,ZDNLNK(XAD) ;New ZER rec. address
SUB XLNK,XAD ;New - old ZER rec. address
IFN QDEBUG,<
STACK X0
LOWADR(X1)
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN ;Log the ZEV pointer update
STACK X2
RTEXT ( )
L X1,XPT
OUTOCT
TEXT ( )
L X1,XPT
ADD X1,XLNK
OUTOCT
UNSTK X2
FI
UNSTK X0
>
ADD XPT,XLNK ;Update pointer value
GOTO @X0 ;Return (NEWZEV called by JSP X0,NEWZEV)
ZPB..:
ZCL..: ;Update ZEV pointers in Simulation and Process block
LF XZPR,ZBIZPR(XCUR)
LOOP ;Search for ZCPGCI \= 0 in prefix chain
LF XTYP,ZCPGCI(XZPR)
AS
JUMPN XTYP,FALSE
LF X0,ZCPZCP(XZPR)
JUMPE X0,FALSE
L XZPR,X0
GOTO TRUE
SA
IF
CAIE XTYP,QSUSI
GOTO FALSE
THEN
;Simulation block
IFN QDEBUG,<
LOWADR(X1)
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN ;Log the Simulation block update
STACK X2
RTEXT (ZSU-FT -LT at )
L X1,XCUR
OUTOCT
UNSTK X2
FI
>
LF XPT,ZSUFT(XCUR)
NZEV
SF XPT,ZSUFT(XCUR) ;ZSUFT
LF XPT,ZSULT(XCUR)
NZEV
SF XPT,ZSULT(XCUR) ;ZSULT
ELSE
IF
CAIE XTYP,QSUPS
GOTO FALSE
THEN
;Process block
IFN QDEBUG,<
LOWADR(X1)
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN ;Log the Process block update
STACK X2
RTEXT (ZPSZEV at )
L X1,XCUR
OUTOCT
UNSTK X2
FI
>
LF XPT,ZPSZEV(XCUR)
NZEV
SF XPT,ZPSZEV(XCUR) ;ZPSZEV
FI
FI
ZBI..: ;These rec. types have no
ZBP..: ; internal pointers
ZTT..:
ZTE..:
ZAC..:
ZDR..:
ZYS..:
ZXB..: GOTO SAGCSP
SUBTTL SAGCNP (Garbage collector subroutine)
Comment;
Purpose: Check if the new pointer in XPT points into the pool.
If not return at once to SAGCGP or SAGCSP else go to
SAGCCH (PHASE1) or SAGCUP (PHASE3)
(i.e. the current address in X16)
Entry: SAGCNP
Input arguments: XPT contains the pointer value
XAD contains the pointer address
XSW contains the return address
Normal exit: GOTO (XSW)
where XSW has been exchanged with X16 if the new pointer
points into the pool and will cause a jump to SAGCCH (PHASE1)
and SAGCUP (PHASE3). X16 will then contain the return
address from where SAGCNP was called
CALL FORMAT: NPOINT (JSP XSW,SAGCNP)
;
SAGCNP: INPOOL
GOTO (XSW)
EXCH XSW,X16
GOTO (XSW)
SUBTTL SAGCOO, SAGCOD (Garbage collector subroutines)
Comment;
Purpose: To output an octal or a decimal number
Entry: SAGCOO Output octal number
SAGCOD Output decimal number
Input arguments: X1 (right half) contains the number
X0 contains the switch word YSASW(XLOW)
In production version the number is output on TTY
In test version the number is output on TTY if
SWGCT2 in X0 is on and on Sysout if SWGCT3
in X0 is on.
Normal exit: RETURN
Call format: EXEC SAGCOO
EXEC SAGCOD
;
SAGCOO:
PROC
SAVE <X3>
SETZ X3,
LOOP
LSHC X1,-3
AOJ X3,
AS
JUMPN X1,TRUE
SA
LOOP
SETZ X1,
LSHC X1,3
ADDI X1,"0"
IFN QDEBUG,<
IFONA SWGCT2
>
OUTCHR X1
IFN QDEBUG,<
IF
IFOFFA SWGCT3
GOTO FALSE
THEN
EXEC SAPDCO,<X1>
FI
>
AS
SOJG X3,TRUE
SA
RETURN
EPROC
SAGCOD:
PROC
SAVE <X3,X4>
IF
JUMPL X1,FALSE
THEN
SETZ X4,
LOOP
IDIVI X1,^D10
LSHC X2,-4
AOJ X4,
AS
JUMPN X1,TRUE
SA
LOOP
SETZ X2,
LSHC X2,4
ADDI X2,"0"
IFN QDEBUG,<
IFONA SWGCT2
>
OUTCHR X2
IFN QDEBUG,<
IF
IFOFFA SWGCT3
GOTO FALSE
THEN
EXEC SAPDCO,<X2>
FI
>
AS
SOJG X4,TRUE
SA
IFN QDEBUG,<
ELSE
TEXT (negative?)
>
FI
RETURN
EPROC
SUBTTL SAGCSP (Garbage collector subroutine)
Comment;
Purpose: Find all pointers in a dynamic record that point to
other dynamic records and call SAGCNP (NPOINT)
for each pointer found
Entry: SAGCSP
Input arguments: XCUR points to the record to be handled
Normal exit: NEXT (GOTO (XNEXT) where XNEXT points to SAGCN1
in PHASE1 and to SAGCN3 in PHASE3)
Output arg.: XLEN contains the record length.
XZPR points to the prototype record if present
Call format: GOTO SAGCSP
;
SAGCSP: edit(273)
ZDNCASE(.) ;[273]
edit(265) ;[265]
ZDN.: RFAIL Bad ptr in XCUR (SAGCSP)
ZBI.: ;Block instance record
;Common to ZBI, ZBP, ZPB and ZCL records
LF XZPR,ZBIZPR(XCUR)
LF XLEN,ZPRBLE(XZPR)
;Find the offset of the first MAP entry
LF XIND,ZBIBNM(XCUR)
IFE<ZMP%S - 4>,<ASH XIND,2> ; * 4 ( = * ZMP%S)
IFN<ZMP%S - 4>,<IMULI XIND,ZMP%S> ; * ZMP%S
LOOP
;Loop on the prefix chain if ZCL or ZPB record
;Find the first variable MAP address
; (I.E. ZPRMAP + ZMP%S*ZBIBNM)
LF XAD,ZPRMAP(XZPR)
IF ;Any map?
JUMPE XAD,FALSE
THEN
ADDI XIND,(XAD) ;XIND = first map address
LOOP
;Check the map for the ZBI block and its
; enclosing blocks
WLF XAD,ZMPNRV(XIND) ;Number of REF and
; ARRAY variables
IF ;Any REF or ARRAY var.
edit(215)
JUMPGE XAD,FALSE ;[215]
THEN
ADDI XAD,(XCUR) ;Start address
; in right half
LOOP
;Find all REF and ARRAY var. pointers
L XPT,(XAD)
NPOINT
AS
AOBJN XAD,TRUE
SA
FI
WLF XAD,ZMPNTX(XIND) ;Number of words for
; TEXT var.
IF ;Any TEXT var.
JUMPGE XAD,FALSE ;[215]
THEN
ADDI XAD,(XCUR) ;Start address
; in right half
LOOP
;Find all TEXT rec. pointers
LF XPT,ZTVZTE(XAD)
NPOINT ;ZTVZTE
AS
AOBJP XAD,FALSE
AOBJN XAD,TRUE
SA
FI
LF XIND,ZMPZMP(XIND) ;Next outer map
AS
JUMPN XIND,TRUE ; If not the outermost
SA
FI
AS
LF XTYP,ZDNTYP(XCUR)
IF ;ZCL or ZPB
CAIE XTYP,QZCL
CAIN XTYP,QZPB
GOTO FALSE
THEN ;Check variable maps in prefix chain
NEXT
FI
SETZ XIND, ;BNM=0 in the prefix chain
LF XZPR,ZCPZCP(XZPR)
JUMPN XZPR,TRUE
SA
NEXT
ZBP.: ;PROCEDURE
LF XZPR,ZBIZPR(XCUR)
;Check for function procedure type REF or TEXT
LF XTYP,ZPCTYP(XZPR)
IF
CAIN XTYP,QREF
GOTO TRUE
CAIE XTYP,QTEXT
GOTO FALSE
THEN
LI XAD,ZBI%S(XCUR)
HRRZ XPT,(XAD)
NPOINT ;Function value location
FI
EXEC SAGCFP ;Check formal parameters
BRANCH SAGCDR ;Handle the display rec.
; and then return to ZBI.
ZCL.:
ZPB.: ;Class and prefixed block
LF XZPR,ZBIZPR(XCUR)
LOOP ;Search for spec. GC index in prefix chain
LF XTYP,ZCPGCI(XZPR)
AS
JUMPN XTYP,FALSE
LF X0,ZCPZCP(XZPR)
JUMPE X0,FALSE
L XZPR,X0
GOTO TRUE
SA
LF XZPR,ZBIZPR(XCUR)
IFN QDEBUG,< SKIPL XTYP
CAILE XTYP,QIOFI
RFAIL Wrong ZCPGCI in SAGCSP >
GOTO @SYSTCL(XTYP)
SYSTCL: SYSCLASS ;Generate jump table
CLPB.: ;Not a system class
LOOP
;Check formal parameters for the class and its
; enclosing classes
EXEC SAGCFP
LF XZPR,ZCPZCP(XZPR)
AS
JUMPN XZPR,TRUE
SA
LF XZPR,ZBIZPR(XCUR)
BRANCH SAGCDR ;Handle the display rec.
; and then return to ZBI.
SUSI.: ;Simulation class
NPNT(ZSUZPS) ;ZSUZPS
;In PHASE1
; Simulation blocks are chained in a special backward chain
; with last ref. in YSAZSU(XLOW) and linked in
; ZSULNK field
; ZSUZER records are chained in the usual way but not updated
; during PHASE3
; In PHASE4 the chain mentioned above is followed
; and ZER pointers in the sequencing set are updated
; (i.e. ZSUZER and ZERZER and ZEVZER pointers)
IF
CAIE XNEXT,SAGCN1
GOTO FALSE
THEN
LOWADR(XLO)
L X0,YSAZSU(XLOW)
SF X0,ZSULNK(XCUR)
ST XCUR,YSAZSU(XLOW)
;Chain but don't update ZSUZER
NPNT(ZSUZER) ;ZSUZER
FI
GOTO CLPB.
SUPS.: ;Process class
SSLG.: ;Linkage class
NPNT(ZLGSUC) ;ZLGSUC
NPNT(ZLGPRE) ;ZLGPRE
GOTO CLPB.
IOFI.: ;File object
;ZFISPC is handled as parameter (741121 LE)
LI XAD,OFFSET(ZFIIMG)(XCUR)
LF XPT,ZTVZTE(XAD)
NPOINT ;TEXT rec. pointer in ZFIIMG
IF
IFOFF ZFISFD(XCUR)
GOTO FALSE
THEN
NPNT(ZFIARG) ;ZFIARG
FI
IF
IFOFF ZFIDE(XCUR)
GOTO FALSE
THEN
NPNT(ZFIFIL) ;ZFIFIL
FI
GOTO CLPB.
ZTT.: ;Temporary TEXT variable
LI XLEN,ZTT%S
NPNT(ZTTZTE) ;ZTTZTE
NEXT
ZAR.: ;ARRAY record
LF XLEN,ZARLEN(XCUR)
LF XTYP,ZARTYP(XCUR)
IF ;REF or TEXT ARRAY
CAIN XTYP,QREF
GOTO TRUE
CAIE XTYP,QTEXT
GOTO FALSE
THEN
;Find the address of the first element
; (i.e. XCUR + 3N + 3 where N = number of subscripts)
LF XIND,ZARSUB(XCUR) ;N
LI XAD,(XIND) ;N
ASH XAD,1 ;2N
ADDI XAD,3(XIND) ;2N + N + 3 = 3N + 3
ADD XAD,XCUR ;XCUR+3N+3
;Set XSTOP to the address of the first word after the ZAR rec.
LI XSTOP,(XLEN)
ADDI XSTOP,(XCUR)
LOOP
;Step through all elements
HRRZ XPT,(XAD)
NPOINT ;ZTVZTE or REF pointer
ADDI XAD,1
CAIN XTYP,QTEXT
ADDI XAD,1 ;2 words for a TEXT ARR. element
AS
CAIGE XAD,(XSTOP)
GOTO TRUE
SA
FI
NEXT
ZAC.: ;Accumulator stack record
LF XLEN,ZACNAC(XCUR)
LI XAD,OFFSET(ZACSVA)(XCUR)
LF XIND,ZACZAM(XCUR)
HLLZ X0,(XIND) ;X0 = relocation flags in left half
; for real ac's
WHILE
SOJL XLEN,FALSE
DO
ROT X0,1
IF
TRNN X0,1
GOTO FALSE
THEN
;Right half must be relocated
HRRZ XPT,(XAD)
NPOINT
FI
ADDI XAD,1
CAIN XAD,QNAC+OFFSET(ZACSVA)(XCUR)
HRLZ X0,(XIND) ;X0 = relocation flags in
; left half for pseudo ac's
OD
LF XLEN,ZACNAC(XCUR)
ADDI XLEN,2+OFFSET(ZACSVA)
NEXT
ZER.: ;Event notice record
LF XLEN,ZERLEN(XCUR)
;Chain but don't update ZERZER
IF
CAIE XNEXT,SAGCN1
GOTO FALSE
THEN
NPNT(ZERZER) ;ZERZER only in PHASE1
FI
LI XAD,OFFSET(ZERZV1)(XCUR) ;XAD points to the first
; event notice
LI XSTOP,(XLEN)
ADDI XSTOP,(XCUR) ;XSTOP points to the next rec. in pool
LOOP
;Find all ZEVZPS in used ZEV nodes
IF ;ZEV in use? (i.e. ZEVZCH = 0)
LF X0,ZEVZCH(XAD)
JUMPN X0,FALSE
THEN
LF XPT,ZEVZPS(XAD)
NPOINT ;ZEVZPS
FI
STEP XAD,ZEV
AS
CAIGE XAD,1-ZEV%S(XSTOP)
GOTO TRUE
SA
NEXT
ZDR.: ;Display record
IFN QDEBUG,< IF ;PHASE1?
CAIE XNEXT,SAGCN1
GOTO FALSE
THEN ;ZDR should not be referenced
RFAIL XCUR points to ZDR rec. in SAGCSP PHASE1
FI >
ZTE.: ;TEXT record
ZYS.: ;System record (no relocation of contents)
LF XLEN,ZYSLG(XCUR)
NEXT
ZXB.: ;Extended lookup block
LF XLEN,ZXBLG(XCUR)
LF XPT,ZXBP2(XCUR)
IF
;SFD pointer in ZXBP2 if left half = 0
TLNE XPT,-1
GOTO FALSE
THEN
LI XAD,OFFSET(ZXBP2)(XCUR)
NPOINT
FI
NEXT
SUBTTL SAGCUP (Garbage collector coroutine)
Comment;
Purpose: Update a new pointer by executing the instruction in
XST with the new value in XPT
Entry: SAGCUP
Input arguments: XPT points to the old rec. with the new value in
its ZDNLNK field
XST contains the instruction to store XPT at the
pointer address
Normal exit: GOBACK (JSP X16,(X16))
Call format: GOTO (XSW)
;
SAGCUP:
IFN QDEBUG,<
LOWADR(X1)
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN
;Log the update phase
STACK X2
RTEXT
HRRZ X1,XAD
OUTOCT
TEXT ( )
L X1,XPT
OUTOCT
TEXT ( )
LF X1,ZDNLNK(XPT)
OUTOCT
UNSTK X2
FI
>
LF XPT,ZDNLNK(XPT) ;New pointer value
HRRI XST,(XAD) ;Set the address field in XST
XCT XST ;Store the new address in the pointer field
GOBACK
GOTO SAGCUP ;Entry for next call on SAGCUP
SUBTTL .SAGC (Garbage collector)
.SAGC:
PROC
IFN QSASTE,<
; If allocation in steps then
; If X0 = 0 a garbage collection should be forced
; (.SAGC called from SIMDDT or with YSAREL GT 0)
; If X0 NE 0 then check if a new step can be allocated
; without exceeding the garbage collection limit.
; .JBREL + X0 + YSASTE LT YSABOT +YSAL
; If so call SANP1 for a CORE request with lowseg size in X2
; If not do a garbage collection (call SAGC1).
LOWADR(X16)
edit(265) ;[265]
STD X1,YSASAV+X1(XLOW)
JUMPE X0,.SAGC1
L X1,.JBREL
ADD X1,X0
ADD X1,YSASTE(XLOW)
L X2,X1
SUB X1,YSAL(XLOW)
CAML X1,YSABOT(XLOW)
GOTO .SAGC1
XEC SANP1
LD X1,YSASAV+X1(XLOW)
RET
.SAGC1: ;Garbage collector main entry
> ;END IFN QSASTE,
IFE QSASTE,<LOWADR X16>
edit(265) ;[265] Save X0,X3-X15 (X1,X2 already saved)
ST X0,YSASAV+X0(XLOW)
LI YSASAV+X3(XLOW)
HRLI X3
BLT YSASAV+X15(XLOW)
IFON SWNOGC(XLOW)
SAERR 0,Garbage collection not possible
SETON SWNOGC(XLOW) ;Indicate GC started
IFN QDEBUG,<
IF L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN ;Start log output
RTEXT(GARBAGE COLLECTION STARTED)
FI
>
STACK YDSCSW(XLOW) ;Save ^C-REENTER switch
SKIPN YDSCSW(XLOW)
CDEFER ;Defer call on SIMDDT
IF ;Pool to be expanded at the top
SKIPE YSAREL(XLOW)
GOTO FALSE
THEN L X0,YSALIM(XLOW)
SUB X0,YSATOP(XLOW) ;Let X0(saved) be the minimum amount
ADDM X0,X0+YSASAV(XLOW); of free pool area needed
FI
;Update parameters for calculation of new garbage collection
; limit and step size
;***AUBEG
IFN QKI10,<
edit(175) ;[175]
EXTERN .JBPFH
IF ;Page fault handler is in core
SKIPN .JBPFH
GOTO FALSE
THEN
L X1,[%VMSPF]
GETTAB X1,
SETZ X1,
HLRZ X1,X1
L X0,X1
SUB X1,YSANWA(XLOW) ;NIW faults between gc:s
ST X1,YSANWB(XLOW)
HRLZ X1,X1
ADDM X1,YSANWC(XLOW) ;Accumulate between gc:s
ST X0,YSANWA(XLOW)
FI
>
;***AUEND
AOS YSAGCN(XLOW) ;Increment GC counter
SETZ X0,
RUNTIM X0,
L X1,YSATIM(XLOW)
ST X0,YSATIM(XLOW) ;Update TIM
SUB X0,X1
FLTR X0,X0
ST X0,YSATAU(XLOW) ;TAU:=run time before GC
L X1,YSAFES(XLOW)
ST X1,YSAFLA(XLOW) ;Save last F^
L X2,YSAL(XLOW)
FLTR X2,X2
FSBR X2,X1 ;L-F^
IF
JUMPE X0,FALSE ;R unchanged if TAU = 0
JUMPLE X2,FALSE ; or if L-F^ <= 0
THEN
FDVR X2,X0 ;/TAU
ST X2,YSAR(XLOW) ;R:=(L-F^)/TAU
FI
;Set XTOP and XBOT
L XTOP,YSATOP(XLOW) ;Top of pool
L XBOT,YSABOT(XLOW) ;Bottom of pool
IFN QDEBUG,<
;In debug version a buffer ring for GCP.TMP is needed
; (see .SAGI). In this case .SAGC is called with
; an empty pool
IF
CAME XTOP,XBOT
GOTO FALSE
THEN
;Here in debug version to get buff for GCP.TMP
;Just ask for more core and set new pool limit
L X0,YSAREL(XLOW)
ADDI X0,(XBOT)
ST X0,YSABOT(XLOW)
ST X0,YSATOP(XLOW)
L X0,.JBREL
ADD X0,YSAREL(XLOW)
L XFROTO,.JBREL
CORE X0,
SAERR 1,CORE failed
edit(65)
IFN QZERO,<;[65]
SETZM (XFROTO) ;Zero new core just for sure
HRL XFROTO,XFROTO
ADDI XFROTO,1
BLT XFROTO,@.JBREL
>
L X0,.JBREL
HRRM X0,.JBFF
SUBI X0,QSALIM
ST X0,YSALIM(XLOW)
BRANCH SAGCEX ;Exit at once without any updating
FI
>
SUBTTL SAGC (Garbage collector) PHASE 1
PHASE1: ;Chain all referenced dynamic records
; SAGCGP and SAGCSP communicate with the coroutine
; SAGCCH via SAGCNP
IFN QDEBUG,<
L X0,YSASW(XLOW)
IF
IFOFFA SWGCTE
GOTO FALSE
THEN ;Title in log output
RRTEXT (Chain record at)
FI>
LI X16,SAGCCH ;X16 should contain the address of the routine
; to be called when a new pointer is found with
; a value pointing into the pool, and that is
; SAGCCH during PHASE1.
EXEC SAGCGP ;Start with global pointers
LI XCUR,(XNEXT) ;Go on with pointers in records in the chain
; Start of chain saved in XNEXT (SAGCGP)
LI XNEXT,SAGCN1 ;NEXT will call SAGCN1 in PHASE1
JUMPE XCUR,PHASE2 ;No chain to search
BRANCH SAGCSP ;Start searching for pointers in all chained
; records, and chain new referenced records.
SUBTTL SAGC (Garbage collector) PHASE 2
PHASE2: ;Return here from SAGCN1 when there are no more records in the
; chain
HLLOS OFFSET(ZDNLNK)(XEND) ;Set -1 in ZDNLNK to mark
; that the last rec in the chain
; is referenced
;Step through the pool and compute new addresses for all referenced
; records, and store the new addresses in their ZDNLNK field.
; Collect adjacent unreferenced records to one ZYS record
; with the total length in ZYSLG
LOWADR (X16)
IFN QDEBUG,<
L X0,YSASW(XLOW)
IF
IFOFFA SWGCTE
GOTO FALSE
THEN
;Title in the log output
RRTEXT (Rec. at to length)
FI>
L XAD,YSAREL(XLOW) ;The quantity to be added to YSABOT
; if the pool must be moved upwards
ADDI XAD,(XBOT)
ST XAD,YSABOT(XLOW) ;New start address of the pool
LI XCUR,(XBOT) ;Start at the bottom
LOOP ;Thru the pool
LENGTH ;XLEN := length of rec. at XCUR
LF XLNK,ZDNLNK(XCUR)
IF ;Not referenced
JUMPN XLNK,FALSE
THEN ;Make a ZYS rec. of unreferenced neighbours
LI XPT,(XCUR)
LI XTOT,(XLEN)
SETF QZYS,ZDNTYP(XPT)
WHILE
ADDI XCUR,(XLEN)
CAIL XCUR,(XTOP)
GOTO FALSE
DO
LENGTH
LF XLNK,ZDNLNK(XCUR)
JUMPN XLNK,FALSE
ADDI XTOT,(XLEN)
OD
SF XTOT,ZYSLG(XPT)
edit(273) ;[273] Do not relocate below YSAFRZ
CAMG XCUR,YSAFRZ(XLOW)
ADDI XAD,(XTOT)
ELSE
IFN QDEBUG,<
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN
;Log output
RTEXT
L X1,XCUR
OUTOCT
TEXT ( )
L X1,XAD
OUTOCT
TEXT ( )
L X1,XLEN
OUTOCT
FI
>
SF XAD,ZDNLNK(XCUR) ;Store new address
ADDI XAD,(XLEN) ;XAD:=new address for next rec.
ADDI XCUR,(XLEN)
FI
AS
CAIGE XCUR,(XTOP)
GOTO TRUE ;Check next rec. in pool
SA
;Now XAD = the new YSATOP
; IF XAD + X0(saved) + QSALIM > .JBREL,
; ask for more core and update YSALIM(XLOW)
ST XAD,YSATOP(XLOW)
IFN QSADEA,< ;Update YSADEA (the deallocation pointer)
; If YSADEA points to a referenced rec. get its new
; address else set YSADEA to the new YSATOP value
L XPT,YSADEA(XLOW)
LF XPT,ZDNLNK(XPT)
SKIPN XPT
L XPT,XAD
ST XPT,YSADEA(XLOW)
>
ADD XAD,X0+YSASAV(XLOW)
ADDI XAD,QSALIM
IF ;More core needed
CAMG XAD,.JBREL
GOTO FALSE
THEN
L XFROTO,.JBREL
IF
CORE XAD,
GOTO FALSE
THEN
L XAD,.JBREL
HRRM XAD,.JBFF
edit(65)
IFN QZERO,<;[65]
SETZM (XFROTO) ;Zero new core just for sure
HRL XFROTO,XFROTO
ADDI XFROTO,1
BLT XFROTO,(XAD)
>
SUBI XAD,QSALIM
ST XAD,YSALIM(XLOW)
ELSE
;Restore XTOP and XCB for SIMDDT
ST XTOP,YSATOP(XLOW)
L XCB,XCB+YSASAV(XLOW)
SAERR 1,Cannot get enough core for object pool
FI
FI
SUBTTL SAGC (Garbage collector) PHASE 3
PHASE3:
;Update all dynamic pointers in referenced records
; SAGCGP and SAGCSP communicate with the coroutine
; SAGCUP via SAGCNP
;All internal pointers (except ZEVZER) are also updated
; via the NEXT routine SAGCN3
IFN QDEBUG,<
L X0,YSASW(XLOW)
IF
IFOFFA SWGCTE
GOTO FALSE
THEN
;Title in log output
RRTEXT (Pointer old val new val)
FI>
LI X16,SAGCUP
OP XST,(HRRM XPT,);Set the default store inst. in XST
EXEC SAGCGP ;Start with global pointers
LI XCUR,(XBOT) ;Go on with pointers in the pool
LI XNEXT,SAGCN3 ;NEXT will jump to SAGCN3
GOTO SAGCSP ;Step through the pool
SUBTTL SAGC (Garbage collector) PHASE 4
PHASE4:
;Return here from SAGCN3 when the last record in the pool
; has been handled
;Update sequencing set chains and ZEVZER in all ZER records
LOWADR(X16)
L XCUR,YSAZSU(XLOW)
SETZM YSAZSU(XLOW)
WHILE ;More SIMULATION blocks on chain
JUMPE XCUR,FALSE
DO
LF XPT,ZSUZER(XCUR)
LI XAD,OFFSET(ZSUZER)(XCUR)
WHILE
;ZER rec found
JUMPE XPT,FALSE
DO
;Update all internal pointers in this ZER and
; the ZER chain. ZDNLNK contains the new address.
LF XLNK,ZDNLNK(XPT)
HRRM XLNK,(XAD) ;Update ZER chain
; (ZSUZER or ZERZER)
IFN QDEBUG,<
L X0,YSASW(XLOW)
IF
IFOFFA SWGCTE
GOTO FALSE
THEN
;Log the update of ZSUZER and ZERZER
RTEXT (ZER-pointer at )
L X1,XAD
OUTOCT
RTEXT ( )
L X1,XPT
OUTOCT
TEXT ( )
L X1,XLNK
OUTOCT
FI
>
;Step through the ZER rec and update all ZEVZER
LI XZEV,OFFSET(ZERZV1)(XPT)
LF XSTOP,ZERLEN(XPT)
ADDI XSTOP,(XPT)
LOOP
IFN QDEBUG,<
L X0,YSASW(XLOW)
IF
IFOFFA SWGCTE
GOTO FALSE
THEN
;Log the ZEVZER update
RTEXT
LI X1,OFFSET(ZEVZER)(XZEV)
OUTOCT
TEXT ( )
LF X1,ZEVZER(XZEV)
OUTOCT
TEXT ( )
L X1,XLNK
OUTOCT
FI
>
SF XLNK,ZEVZER(XZEV)
AS
;Next ZEV in ZER rec.
STEP XZEV,ZEV
CAIGE XZEV,1-ZEV%S(XSTOP)
GOTO TRUE
SA
LI XAD,OFFSET(ZERZER)(XPT) ;Next ZER rec. in chain
LF XPT,ZERZER(XPT)
OD
LF X0,ZSULNK(XCUR)
ZF ZSULNK(XCUR)
L XCUR,X0 ;Next SIMULATION block in chain
OD
;Step through the pool a third time and move all referenced
; records to the new address and clear their ZDNLNK field
SETZB XBEG,XSAV
LI XCUR,(XBOT)
LOOP
;Find the first rec. to be moved towards the bottom of
; the pool
LF XLNK,ZDNLNK(XCUR)
JUMPE XLNK,L2 ;Unreferenced
;Find first referenced rec.
; in pool that has to be moved
IF ;Not found yet
JUMPN XBEG,FALSE
THEN
IF
CAIE XLNK,(XCUR)
GOTO FALSE
THEN
ZF ZDNLNK(XCUR)
GOTO L2 ;Ref. rec. at top of pool
; need not be moved
FI
LI XBEG,(XCUR) ;XBEG points to the first rec.
; in the pool that must be moved
FI
CAIG XLNK,(XCUR)
GOTO FALSE ;The first rec. to be moved
; towards the bottom is found
LI XSAV,(XCUR) ;Save the latest referenced rec.
L2():! LENGTH
ADDI XCUR,(XLEN)
AS
CAIGE XCUR,(XTOP)
GOTO TRUE ;Handle next rec.
IFN QDEBUG,< CAIE XCUR,(XTOP)
RFAIL No match XCUR-XTOP at end of pool>
SA
LI XPT,(XCUR) ;XPT points to the first rec. to be
; moved towards the bottom
JUMPE XSAV,L3 ;No records are to be moved towards the top
LI XCUR,(XSAV) ;XCUR points to the rec. with the highest
; address that must be moved towards the top
LENGTH
LF XAD,ZDNLNK(XCUR)
ADDI XAD,(XLEN) ;XAD points to the first word in the new rec.
; area of the first rec. moved towards
; the bottom
edit(72)
LI XCUR,(XBEG) ;[72] Generate backward chain in records to be
;[72] moved towards the top
SETZ XFROM,0 ;[72] End of chain
LOOP
;All rec's to be moved towards the top are moved with a BLT or
; if the old and the new area overlap with a word by word
; transfer starting with the last word in the rec.
LF XLNK,ZDNLNK(XCUR)
LENGTH
;Check if the referenced rec. with the highest address
; overlaps with its new area,
; i.e. the rec. whose ZDNLNK points to an address (XLEN) less
; than (XAD), where XAD points to the first occupied word
; in the new pool
IF
JUMPE XLNK,FALSE
SF XFROM,ZDNLNK(XCUR) ;[72] Insert back chain
LI XFROM,(XCUR) ;[72] Save new chain addr
LI X0,(XLNK)
ADDI X0,(XLEN)
CAIE X0,(XAD)
GOTO FALSE
THEN
L4():! ;[72]
;Next rec. to be moved is found
LI XFROM,(XCUR)
ADDI XFROM,(XLEN)
LF XBEG,ZDNLNK(XCUR) ;[72] Next record addr
ZF ZDNLNK(XCUR) ;[72] Clear link field
IF ;Overlap
CAIG XFROM,(XLNK)
GOTO FALSE
THEN ;Move word by word
IFN QDEBUG,<
LOWADR(X1)
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN
;Log upward overlap move
STACK X2
RTEXT (Rec at )
L X1,XCUR
OUTOCT
TEXT( overlap moved to )
L X1,XLNK
OUTOCT
TEXT ( length )
L X1,XLEN
OUTOCT
UNSTK X2
FI
>
;[72]
LOOP
;Move one word at a time
SUBI XAD,1
SUBI XFROM,1
L X0,(XFROM)
ST X0,(XAD)
AS
CAIN XFROM,(XCUR)
GOTO FALSE ;The first word in the
; old area is moved -> the whole
; rec. is moved, and XAD points
; to the first occupied word in
; the new pool
GOTO TRUE ;Move the next word
SA
ELSE ;No overlap, use BLT
;[72]
LI XAD,(XLNK)
LI XFROTO,(XLNK)
HRLI XFROTO,(XCUR)
ADDI XLNK,-1(XLEN)
IFN QDEBUG,<
LOWADR(X1)
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN
;Log upward BLT move
STACK X2
RTEXT (Rec at )
HLRZ X1,XFROTO
OUTOCT
TEXT ( BLT to )
HRRZ X1,XFROTO
OUTOCT
TEXT ( length )
L X1,XLEN
OUTOCT
UNSTK X2
FI
>
BLT XFROTO,(XLNK)
FI
edit(72)
;[72] Next record to be moved has address XBEG
;Calculate the address to which it should be moved
JUMPE XBEG,L3 ;No more records are to be moved
LI XCUR,(XBEG) ;Next record address
LENGTH
LI XLNK,(XAD) ;XAD points to the first occupied
;word in the new pool
SUBI XLNK,(XLEN) ;New record address after the move
GOTO L4
FI ;[72] END
;Search for next rec. to be moved
ADDI XCUR,(XLEN)
IFN QDEBUG,< CAIL XCUR,(XTOP)
RFAIL XCUR points out of the pool >
;[72]
AS
GOTO TRUE
SA
L3():! ;Move the remaining ref. rec. towards the bottom with a BLT
; for each rec.
LI XCUR,(XPT)
WHILE
;Records left
CAIL XCUR,(XTOP)
GOTO FALSE ;All records in the old pool are checked
; and moved to the new pool if
; referenced
DO
LF XLNK,ZDNLNK(XCUR)
LENGTH
IF ;Referenced
JUMPE XLNK,FALSE
THEN
;Move a referenced record and clear ZDNLNK
ZF ZDNLNK(XCUR)
LI XFROTO,(XLNK)
HRLI XFROTO,(XCUR)
ADDI XLNK,-1(XLEN)
IFN QDEBUG,<
LOWADR(X1)
IF
L X0,YSASW(XLOW)
IFOFFA SWGCTE
GOTO FALSE
THEN
;Log downward BLT move
RTEXT (Rec at )
HLRZ X1,XFROTO
OUTOCT
TEXT ( BLT to )
HRRZ X1,XFROTO
OUTOCT
TEXT ( length )
L X1,XLEN
OUTOCT
FI
>
BLT XFROTO,(XLNK)
FI
ADDI XCUR,(XLEN) ;Check next record
OD
IFN QDEBUG,< CAIE XCUR,(XTOP)
RFAIL No match XCUR-XTOP at end of SAGC>
LOWADR(X16)
;Clear freed area at the top
L XFROTO,YSATOP(XLOW)
IF
CAIL XFROTO,(XTOP)
GOTO FALSE
THEN
SETZM (XFROTO)
IF ;More than one word freed
CAIL XFROTO,-1(XTOP)
GOTO FALSE
THEN
HRLI XFROTO,(XFROTO)
ADDI XFROTO,1
BLT XFROTO,-1(XTOP)
FI
FI
;Clear freed area at the bottom
LI XFROTO,(XBOT)
L XSTOP,YSABOT(XLOW)
IF
;At least one word freed
CAIL XFROTO,(XSTOP)
GOTO FALSE
THEN
SETZM (XFROTO)
IF ;More than one word freed
CAIL XFROTO,-1(XSTOP)
GOTO FALSE
THEN
HRLI XFROTO,(XFROTO)
ADDI XFROTO,1
BLT XFROTO,-1(XSTOP)
FI
FI
;Update YSATIM and set X6 to garbage collection runtime
; and output on TTY in debug version
SETZ X6,
RUNTIM X6,
L X1,YSATIM(XLOW)
ST X6,YSATIM(XLOW)
SUBB X6,X1 ;X6 := X1 := TAUGC (fixed)
IFN QDEBUG,<
IF
L X0,YSASW(XLOW)
IFOFFA SWGCT4
GOTO FALSE
THEN
;Log the g.c. time
RTEXT( RUNTIME: )
OUTDEC
FI
>
ADDM X6,YSAGCT(XLOW) ;Accumulate GC time
EXEC .SANP ;Determine free storage pool area
; and allocate a first step
; (or if QSASTE=0 the whole pool)
IFN QDEBUG,<
IF
L X0,YSASW(XLOW)
IFOFFA SWGCT4
GOTO FALSE
THEN
;Log the new low segment limit
L X1,.JBREL
RTEXT(LOW SEGMENT LIMIT: )
EXEC SAGCOO
RTEXT
FI
>
;** EXIT **
SAGCEX:
LOWADR (X16)
UNSTK YDSCSW(XLOW) ;Restore ^C-REENTER switch
SETOFF SWNOGC(XLOW) ;Indicate GC finished
SETZM YSAREL(XLOW)
IFN QDEBUG,<
;Output the last line on Sysout if Sysout used for dump and log output
IFON SWGCT3(XLOW)
EXEC SAPDOI
>
;Restore ac's
MOVSI X16,YSASAV(XLOW) ; YSASAV(XLOW),, 0
BLT XLOW,X15
LOWADR (X16)
RETURN
EPROC
SUBTTL .SAGI (Garbage collector initializations)
Comment;
Purpose: Open in append mode GCP.TMP in debug version
and initialize garbage collection parameters
Entry: .SAGI
Input arguments:
YSABOT(XLOW) should be initialized to
needed low seg. area excluding the storage pool.
YRUNTM(XLOW) should be set to execution start time.
Normal exit: RETURN
Call format: EXEC .SAGI
Used subroutines: SANP1, SANP2, GETBUFF, LINKBUFF
;
.SAGI: PROC
SAVE <X0,X1,X2,X3,X6,X7>
LOWADR(X16)
IFN QDEBUG,<
SETOFF SAGCPE(XLOW)
LI X6,QBUFS ;Buffer size
LI X7,2 ;Number of buffers
GETBUFF
ST X1,YSABH(XLOW)
LI X2,1(X1) ;Buffer header address returned by GETBUFF
HRL X2,X2
LI X0,.IOBIN ;Mode
MOVSI X1,'DSK'
IF
OPEN QCHGCP,X0
GOTO FALSE
THEN
L X1,YSABH(XLOW)
LINKBUFF
LF X0,ZBHBUP(X1)
HRLI X0,4400
SF X0,ZBHBUP(X1)
LI X0,200
SF X0,ZBHCNT(X1)
PJOB X1, ;Job number in X1
;Convert to sixbit in X0 left half
IDIVI X1,^D100
IDIVI X2,^D10
LSH X1,^D12
LSH X2,6
ADD X1,X2
ADD X1,X3
HRL X0,X1
TLO X0,202020
HRRI X0,'GCP'
MOVSI X1,'TMP'
SETZB X2,X3
IF
LOOKUP QCHGCP,X0
GOTO FALSE
THEN
L1():! SETZ X3,
IF
ENTER QCHGCP,X0
GOTO FALSE
THEN
L X1,YSABH(XLOW)
CLAIMBUFF
USETI QCHGCP,-1 ;End of file
IF
OUT QCHGCP, ;Initial OUT
GOTO FALSE
THEN
SETON SAGCPE(XLOW)
OUTSTR [ASCIZ /Err 1:st OUT GCP/]
FI
ELSE
L2():! SETON SAGCPE(XLOW)
OUTSTR [ASCIZ /ENTER error GCP.TMP/]
FI
ELSE
;Create a file if not already present
ENTER QCHGCP,X0
GOTO L2
CLOSE QCHGCP,
LOOKUP QCHGCP,X0
SKIPA
GOTO L1
SETON SAGCPE(XLOW)
OUTSTR [ASCIZ /LOOKUP error GCP.TMP/]
FI
ELSE
SETON SAGCPE(XLOW)
OUTSTR [ASCIZ /OPEN error GCP.TMP/]
FI
;Initialize for dump output on Sysout
L X1,YSATOP(XLOW)
ST X1,YSAIMP(XLOW) ;Local image pointer
HRLZI X0,^D72
ST X0,YSAILC(XLOW) ;ZTVLNG,,ZTVCP
HRLZI X0,QZTE
ST X0,(X1) ;ZDN word for a text record
; placed at the bottom of the pool
LI X0,^D17
ADDM X0,YSATOP(XLOW)
ADDM X0,YSABOT(XLOW) ;Let Image be outside the pool
HRLI X0,^D72
ST X0,1(X1) ;ZTECLN,,ZTELEN
LI X0,OFFSET(ZTECHR)(X1)
HRLI X0,440700 ;POINT 7,ZTECHR,
ST X0,YSAIBP(XLOW) ;Local image byte pointer
SETON SWGCT2(XLOW) ;Default is log and dump output
; on TTY
>
;Initialize garbage collection parameters for garbage collection
; limit and step size calculations.
SETZM YSAGCN(XLOW) ;Number of gc:s
SETZM YSAGCT(XLOW) ;Accumulated GC time
;***AUBEG
IFN QKI10,<
edit(175) ;[175]
L X1,[%VMSPF]
GETTAB X1,
SETZ X1,
HLRZ X1,X1
ST X1,YSANWA(XLOW)
>
;***AUEND
L YRUNTM(XLOW)
ST YSATIM(XLOW) ;TIM := execution start time
MOVSI QSAF0
ST YSAFES(XLOW) ;F^ := F0
MOVSI QSAR0
ST YSARES(XLOW) ;R^ := R0
MOVSI QSAB0
ST YSABES(XLOW) ;B^ := B0
IFN QSASTE,<
L X2,YSABOT(XLOW)
ADDI X2,QSALIM+QSAPMI
EXEC SANP1
L X2,.JBREL
ADDI X2,QPOLMI
SUB X2,YSABOT(XLOW)
ST X2,YSAL(XLOW) ;L := first garb.coll. limit
LI X2,QSAPMI
ST X2,YSASTE(XLOW) ;Initialize step size
>
IFE QSASTE,<
L X1,.JBREL
SUB X1,YSABOT(XLOW)
ST X1,YSAL(XLOW) ;L:=free pool area
>
RETURN
EPROC
SUBTTL .SAIN (initialize ref and array)
; Purpose: To initialize any ref and/or array variables in a block.
; Input: Prototype address in XSAC, block address in XRAC.
; Function: If ZPRMAP(XSAC) =/= 0 and ZMPNRV of the map =/= 0,
; set the variables to NONE.
.SAIN: PROC
SAVE XSAC
LF XSAC,ZPRMAP(XSAC)
IF ;Any MAP
JUMPE XSAC,FALSE
THEN
WLF XSAC,ZMPNRV(XSAC)
IF ;Any REF or ARRAY variable
JUMPE XSAC,FALSE
THEN
ADDI XSAC,(XRAC)
LI NONE
LOOP
ST (XSAC)
AS
AOBJN XSAC,TRUE
SA
FI
FI
RETURN
EPROC
SUBTTL .SANP (New pool)
Comment;
Purpose: To determine a new g.c. limit and
IFN QSASTE,< a new optimal step size and>
make a core request for low. seg area needed
Function: New g.c. limit (L) :=
IFN QSASTE,<:= F^ [ 1 + SQRT( 2B^ R^ ( 1 + A/F^ )]>
IFE QSASTE,<:= F^ [ 1 + SQRT( 1B^ R^ ( 1 + A/F^ )]>
L := Min (L,CORMAX limit)
where
F^ = YSAFES = active memory
R^ = YSARES = allocation rate
B^ = YSABES = garbage collection cost
A = YSAA = accounting dependent parameter
IFN QSASTE,<
New step size YSASTE :=
K 4A/W - U*U
SQRT ( R^ * --- [ ------------ + (X+U) ] )
2 X + U
where expressed in pages and seconds:
R^ = YSARES = allocation rate [pages/sec.]
K = time for a CORE UUO approx.= 0.004 [sec.]
X = C0 + C1 [pages]
C0 = YSATOP + YSAHSZ [pages]
C1 = YSABOT + YSAL + YSAHSZ [pages]
A, W and U are constants that can be evaluated from the
accounting algorithm written on the form:
TIME * [ A + W(M+U)*M]
where M is the total number of 512 word pages allocated
to the job.
> END IFN QSASTE,
========= N O T E !!!!!!!!!!!!!!!!!! =====================
the calculation of A = YSAA should be changed in the code
as soon as the accounting algorithm is changed to
minimize the cost of SIMULA program executions.
if QSASTE = 1 the calculation of the step size
must also be changed.
=============================================================
Entries: .SANP, SANP1, SANP2
.SANP is the main entry after each gc
SANP1 is the entry point to set the storage pool
to the initial value and allocate core
SANP2 is the entry to set the pool to the initial
value if enough core already allocated
Input arguments: At entry to SANP1 X0 should contain the low segment
area needed
Normal exit: RETURN
Call format: EXEC .SANP
EXEC SANP1
EXEC SANP2
Used local subroutines: SANPSQ, SANPDU
;
DEFINE NEWEST(P,XREG) <
;;Compute a new estimate by exponential smoothing of parameter P
;; into register XREG and store the result in YSA'P'ES(XLOW)
;; it is assumed that X0 contains the observed value of P
;; P^ := (P + LP * P^)/(1 + LP) = (P + LP*P^)/L1P
;; where
;; P^ = YSA'P'ES
;; LP = QSAL'P
;; L1P= QSAL1'P = QSAL'P + 1
L XREG,YSA'P'ES(XLOW)
FMPRI XREG,QSAL'P
FADR XREG,X0
FDVRI XREG,QSAL1'P
ST XREG,YSA'P'ES(XLOW)
>
SUBTTL SANPSQ
Comment;
Purpose: Floating point single precision square root function
Function: The square root of the arg. in X1 is calculated.
The arg. is written in the form
arg. = frac * (2**2b)
where 0 < frac < 1
Sqrt(arg.) is then calculated as
Sqrt(frac) * (2**b)
Sqrt(frac) is calculated by a linear approximation, the nature
of which depends on whether 1/4 < frac < 1/2 or 1/2 < frac < 1
followed by two iterations of Newton's method.
Entry: SANPSQ
Input arguments: X1 contains the input arguments
Normal exit: RETURN
Output arguments: X0 contains the result
Call format: EXEC SANPSQ
;
SANPSQ: PROC
;X0:=SQRT(X1)
SETZ X0
JUMPE X1,L9 ;X1 = 0
LSHC X0,^D9 ;Get exp. to X0
SUBI X0,201 ;Get true exp. -1
ROT X0,-1 ;Divide by 2 and
; if true exp. even the sign bit in X0
; will be set
HRRM X0,X3 ;And store for FSC instr.
LSH X1,-^D9 ;Restore fraction in X1
IF ;True exp is odd
JUMPL X0,FALSE
THEN
FSC X1,177 ;Halve and scale fraction
ST X1,X4 ;Now .25 <= X1 < .5
FMPRI X1,200640 ;Compute approx1
FADRI X1,177465
ELSE ;Even true exp
FSC X1,200 ;Scale fraction
ST X1,X4 ;Now .5 <= X1 < 1
FMPRI X1,200450 ;Compute approx1
FADRI X1,177660
FI
L X0,X4 ;1:st iteration of Newton
FDV X0,X1 ;frac/approx1
FAD X1,X0 ;approx1 + frac/approx1
FSC X1,-1 ;Halve
L X0,X4 ;2:nd iteration of Newton
FDV X0,X1 ;frac/approx2
FADR X0,X1 ;approx2 + frac/approx2
FSC X0,(X3) ;Halve and scale
L9():! RETURN ;Result in X0
EPROC
SUBTTL SANPDU
Comment;
Purpose: To dump GC parameter values on GCP.TMP
Function: If debug version and if SAGCPE is off (i.e. GCP.TMP
is ready to receive output data) the GC parameters are
moved with a BLT to the out buffer and written on the
file GCP.TMP when the buffer is filled.
Entry: SANPDU
Normal exit: RETURN
Call format: EXEC SANPDU
;
IFN QDEBUG,<
SANPDU: PROC
SETLOW(X16)
IFON SAGCPE(XLOW)
RETURN
WHILE
L X1,YSABH(XLOW)
LF X2,ZBHCNT(X1) ;Byte counter
SUBI X2,YSAEND-YSASTA
JUMPGE X2,FALSE
DO
IF
OUT QCHGCP,
GOTO FALSE
THEN
SETON SAGCPE(XLOW)
OUTSTR [ASCIZ /OUT error GCP.TMP/]
RETURN
FI
OD
SF X2,ZBHCNT(X1) ;Byte counter
LF X2,ZBHBUP(X1) ;Byte pointer
LI X3,1(X2) ;First free data word in buffer
HRRI X2,YSAEND-YSASTA(X2) ;Next pointer value
SF X2,ZBHBUP(X1)
HRLI X3,YSASTA(XLOW)
BLT X3,(X2)
RETURN
EPROC
>
SUBTTL SANP1
Comment;
Purpose: To make a core request for the low seg area needed
in version with step allocation (QSASTE=1)
Function: After the core request, if QZERO is non-zero
the new core is zeroed.
A new limit for the object pool is determined
Entry: SANP1
Input arguments: X2 contains the number of words needed in low segment
Output arguments: X2 contains maximum number of 1K core blocks
available to the user
Normal exit: RETURN
Error exit: SAERR 1,Cannot get enough core for object pool
Call format: EXEC SANP1
;
IFN QSASTE,<
SANP1: PROC
SETLOW(X16)
IFN QZERO,<L X1,.JBREL>
IF
CORE X2,
GOTO FALSE
THEN
ELSE
;CORE failed, COREMAX in X2 (Kwords)
;***AUBEG
IFN QKI10,<
edit(175) ;[175]
IF ;Virtual core limits are found
L X1,[-1,,.GTCVL]
GETTAB X1,
GOTO FALSE
THEN ;NOTE!! Not quite correct!!
LSH X1,-1 ;Get phys guideline Kwords
ANDI X1,3777 ;Delete rubbish from GETTAB
CAMG X1,X2
SUBI X2,1 ;Going virtual:subtract space
; of PFH
IFN QZERO,<
ELSE
L X1,.JBREL
>
FI
>
;***AUEND
LSH X2,^D10 ;Pages to words
SUB X2,YSAHSZ(XLOW)
edit(276) ;Do not go beyond hiseg start
CAILE X2,377777 ;[276]
LI X2,377777 ;[276]
CAMG X2,.JBREL
L X2,.JBREL ;If more core already allocated in ph2
; (The truncated P if COREMAX = an odd
; number of pages)
CORE X2,
SAERR 1,Cannot get enough core for object pool
FI
edit(65)
IFN QZERO,<;[65]
;Zero new core
IF ;Expanded
CAML X1,.JBREL
GOTO FALSE
THEN
SETZM (X1)
HRL X1,X1
ADDI X1,1
BLT X1,@.JBREL
FI
>
;Set new limit for object pool
L X1,.JBREL
HRRM X1,.JBFF
SUBI X1,QSALIM
ST X1,YSALIM(XLOW)
RETURN
EPROC
> ;END IFN QSASTE,
SUBTTL .SANP (New pool)
.SANP:
PROC
LOWADR(X16)
L XCB,XCB+YSASAV(XLOW) ;Restore XCB for SIMDDT
; if error occurs
Comment; Check if .SAGC called just to move the pool upwards, then
the upper limit is increased with the amount in YSAREL(XLOW)
and this garbage collection is not considered to determine a
new dynamic pool area.;
;***AUBEG
IFN QKI10,<
edit(175)
;[175] X6 holds TAUGC (time for this gc) on entry.
>
;***AUEND
IF ;Pool is to be moved upwards
SKIPN YSAREL(XLOW)
GOTO FALSE
THEN
FIX X0,YSATAU(XLOW) ;Set YSATIM to look as if no
SUBM X0,YSATIM(XLOW) ; garb. coll. had occurred
IFN QSASTE,<
L X2,YSATOP(XLOW)
ADDI X2,QSALIM+QSAPMI
CAMLE X2,.JBREL
BRANCH SANP1
RETURN
>
IFE QSASTE,<
L X0,.JBREL
ADD X0,YSAREL(XLOW)
BRANCH SANP1 ;Make a core request and return
>
FI
;***AUBEG
IFN QKI10,<
;[175]
TSWAP=^D20 ;Time for page swap in ms
IF
SKIPN .JBPFH ;Page fault handler present
GOTO FALSE
L X1,[%VMSPF] ;Get system page
GETTAB X1, ; fault counts
GOTO FALSE
HLRZ X1,X1 ; Not In Working set
L X0,X1
SUB X1,YSANWA(XLOW) ;ng := this count
; - count at SAGC start
ST X0,YSANWA(XLOW) ;Save current count
ADDM X1,YSANWC(XLOW) ;Accumulated count in GC
JUMPE X1,FALSE
THEN ;Use virtual core algorithm
;Determine overheads from gc parameters
L X0,YSANWB(XLOW) ;NIW count since last gc (nb)
ADD X1,X1 ; (2 * ng
ADD X1,X0 ; + nb
IMULI X1,TSWAP ; * tswap)
SUB X1,X6 ; - taugc
LI X2,2K ; Add 2K if negative,
SKIPL X1
MOVN X2,X2 ; Subtract if positive
ADDB X2,YSAL(XLOW) ; New YSAL value
edit(276)
L X1,X2 ;[276]
ADD X2,YSABOT(XLOW) ;[276]
IF ;[276] YSAL would be too big for low seg
CAIG X2,377777-QSALIM
GOTO FALSE
THEN ;Make it just small enough
LI X1,377777-QSALIM
SUB X1,YSABOT(XLOW)
ST X1,YSAL(XLOW)
FI ;[276]
L X2,YSATOP(XLOW)
ADD X2,X0+YSASAV(XLOW)
CAMG X2,X1
L X2,X1
BRANCH CHECK
FI
>
;***AUEND
;Compute all parameters needed for the calculation of a new
; g.c. limit and a new step size.
;F^
; X0 := F = active memory in pool = YSATOP - YSABOT + X0(saved)
L X0,YSATOP(XLOW)
ADD X0,X0+YSASAV(XLOW)
IFN QPROTE,<;Assemble this code if a fixed pool should be allocated
ADDI X0,1000 ;Add at least 1P free pool area
;Expand pool only if necessary
IFN QSASTE,<
L X2,X0
CAMLE X2,YSALIM(XLOW)
EXEC SANP1 ;Ask for more core
RETURN ;Pool area unchanged
>
IFE QSASTE,<
CAMLE X0,YSALIM(XLOW)
GOTO SANP1 ;Ask for more core and return
>
>
SUB X0,YSABOT(XLOW)
FLTR X0,X0
NEWEST (F,X3) ;X3 := F^
;R^
; X0 := R = YSAR
L X0,YSAR(XLOW)
NEWEST (R,X5) ;X5 := R^
;B^
; X0 := B = TAUGC/F^ = X6/X3
IF
JUMPE X6,FALSE ;B^ unchanged if TAUGC = 0
THEN
FLTR X0,X6
FDVR X0,X3
NEWEST (B,X6) ;X6 := B^
ELSE
L X6,YSABES(XLOW)
FI
;A
;================== N O T E !!!!!!!!!!!!!! ========================;
;== This code should be changed if the accounting algorithm is changed;
;=====================================================================;
COMMENT;
A(L+Q) = K(L+Q)/K'(L+Q) - L
where
L = mean storage pool area = (YSAL + YSABOT +YSATOP)/2
Q = memory in high segment + low segment area - L
= YSAHSZ + YSABOT
K(r) is the cpu time dependent part of the accounting algorithm
with R = L+Q = number of active pages in core
!!!!!!! Presently used K(R) = (1.1 + 0.005 R (R + 20)/50)
where
K'(R) = 0.0002(R + 10)
A = ( 1.1 + 0.0001( (L+Q+10)**2 - 100 ))) / 0.0002(L+Q+10) - L
= 5450/(L+Q+10) + 5 + (Q-L)/2 pages
where A, L and Q are expressed in number of pages
Expressed in words we will get:
A = (5450/((L+Q)/512 +10) + 5 + (Q-L)/(2*512) ) * 512
= 14.3E8/(Q+L+5120) + 2560 + (Q-L)/2 words
;
L X0,YSAHSZ(XLOW) ;Q
ADD X0,YSABOT(XLOW)
L X2,X0
L X1,YSAL(XLOW) ;YSAL + YSATOP -YSABOT
ADD X1,YSATOP(XLOW)
SUB X1,YSABOT(XLOW)
ASH X1,-1 ; / 2
ST X1,YSASTE(XLOW) ; =: L
ADD X0,X1 ; (R:=) L + Q
ADDI X0,^D5120 ; + 5120
FLTR X0,X0
MOVSI X1,14.3E8_-^D18
FDVR X1,X0
FADRI X1,(2560.0)
SUB X2,YSASTE(XLOW)
ASH X2,-1
FLTR X2,X2
FADR X1,X2
ST X1,YSAA(XLOW) ;X1 := A
;=====================================================================;
;L
; IFN QSASTE,<
; L := F^ ( 1 + SQRT( 2*B^ R^ (1 + A/F^))
; L := X3 ( 1 + SQRT( 2*X6 X5 (1 +X1/X3))
; >
; IFE QSASTE,<
; L := F^ ( 1 + SQRT( 1*B^ R^ (1 + A/F^))
; L := X3 ( 1 + SQRT( 1*X6 X5 (1 +X1/X3))
; >
FDVR X1,X3
FADRI X1,(1.0)
FMPR X1,X5
FMPR X1,X6
IFN QSASTE,<
FMPRI X1,(2.0)
>
IF
JUMPLE X1,FALSE ;Neg or zero arg to SQRT
THEN
EXEC SANPSQ ;X0 := SQRT(X1)
FADRI X0,(1.0)
FMPR X0,X3 ;X0 := L
FIX X0,X0
;***AUBEG
IFN QKI10,<
edit(175) ;[175]
L X1,[-1,,.GTCVL]
GETTAB X1,
LI X1,400
LSH X1,^D9
LI X1,QPOLMI(X1)
SUB X1,YSAHSZ(XLOW)
CAML X1,X0
;!Preceding line may skip to ELSE branch; put nothing here!
>
;***AUEND
ELSE
FIX X0,X3
ADDI X0,QPOLMI ;Add at least QPOLMI free pool
;***AUBEG
IFN QKI10,<
;[175]
CAML X1,X0
L X0,X1 ; To avoid going too much virtual
>
;***AUEND
FI
IFN QDEBUG,<FIX X0,X3 ;******TEMPORARY DURING TEST
ADDI X0,20000>
IFN QSASTE,<
edit(276) ;[276]
MOVN X1,YSABOT(XLOW)
CAILE X0,377777-QSALIM(X1)
LI X0,377777-QSALIM(X1)
ST X0,YSAL(XLOW) ;Set limit for next garb.coll.
>
IFN QSASTE,<
;=============================================================================
; N O T E !!!!!!!!!!!!!!!!! Code to compute an optimal step size
; should be changed if the accounting algorithm is changed
;=============================================================================
Comment;
New step size YSASTE :=
K 4A/W - U*U
SQRT ( R^ * --- [ ------------ + (X+U) ] )
2 X + U
where expressed in pages and seconds:
R^ = YSARES = allocation rate [pages/sec.]
K = time for a CORE UUO approx.= 0.004 [sec.]
X = C0 + C1 [pages]
C0 = YSATOP + YSAHSZ [pages]
C1 = YSABOT + YSAL + YSAHSZ [pages]
A, W and U are constants that can be evaluated from the
accounting algorithm written on the form:
TIME * [ A + W(M+U)*M]
where M is the total number of 512 word pages allocated
to the job.
Currently at our installation we have:
TIME * [ 1.1 + 0.0001(M+20)*M ]
thus
A = 1.1 [1/sec.]
W = 0.0001 [1/sec. * 1/pages*pages]
U = 20 [pages]
Expressed in words and milliseconds we will get:
A = 1.1 * 10^-3 [1/ms.]
W = 0.0001 * 10^-3 * 512^2 [1/ms. * 1/words^2]
U = 20 * 512 [words]
Step size := SQRT( R * 2 [( 1.143E10 / (X + 10240)) +X+10240])
;
L X1,YSAL(XLOW)
ADD X1,YSABOT(XLOW)
ADD X1,YSATOP(XLOW)
ADD X1,YSAHSZ(XLOW)
ADD X1,YSAHSZ(XLOW)
FLTR X1,X1
MOVSI X2,1.143E10_-^D18
L X3,X1
FADRI X3,(10240.0)
FDVR X2,X3
FADR X3,X2
L X1,X3
FMPR X1,YSARES(XLOW)
FMPRI X1,(2.0)
EXEC SANPSQ
FIX X0,X0
CAIGE X0,QSAPMI
LI X0,QSAPMI
ST X0,YSASTE(XLOW)
;===========================================================================
L X2,YSATOP(XLOW)
ADD X2,X0+YSASAV(XLOW) ;Min low seg to continue exec
ADD X2,YSASTE(XLOW) ;Add a step free pool
;***AUBEG
IFN QKI10,<
;[175]
CHECK:
>
;***AUEND
EXEC SANP1
;If YSAL (g.c. limit) greater than allowed by CORMAX
; limit, set YSAL to the maximal value obtained by the
; return argument from the CORE UUO (X2=CORMAX
; in number of K words).
LSH X2,^D10
SUB X2,YSAHSZ(XLOW)
SUB X2,YSABOT(XLOW)
CAMGE X2,YSAL(XLOW)
ST X2,YSAL(XLOW)
>
IFE QSASTE,<
ADD X0,YSABOT(XLOW)
SANP1: ;Entry at storage pool initialization
L X1,.JBREL
SUB X1,X0
MOVM X1,X1
IF
CAIG X1,QSALMI
GOTO FALSE
THEN
;The low seg. area needed has changed more than QSALMI
; Make a core request for Min(X0,CORMAX - highseg.)
IF
L X2,.JBREL
CORE X0,
GOTO FALSE
THEN
ELSE
;CORE failed, CORMAX in X0 (in K words)
LSH X0,^D10 ;Convert CORMAX to words
SUB X0,YSAHSZ(XLOW) ;Set X0 to CORMAX - high seg length
; and try again
CAMG X0,.JBREL
L X0,.JBREL ;Get the truncated P
; if CORMAX odd
IF
CORE X0,
GOTO FALSE
THEN
ELSE
L XCB,XCB+YSASAV(XLOW) ;Restore XCB
SAERR 1,Cannot get enough core for object pool
FI
FI
IFN QZERO,<;[65]
IF
;Zero new core if expanded
CAML X2,.JBREL
GOTO FALSE
THEN
SETZM (X2)
HRL X2,X2
ADDI X2,1
BLT X2,@.JBREL ;Just for sure
FI
>
FI
;Set .JBFF, YSALIM and YSAL and dump GC parameters if
; debug version
SANP2: ;Entry at storage pool initialization if enough
; core already allocated
L X1,.JBREL
HRRM X1,.JBFF
SUBI X1,QSALIM
ST X1,YSALIM(XLOW)
SUB X1,YSABOT(XLOW)
ST X1,YSAL(XLOW)
> ;END IFE QSASTE
IFN QDEBUG,<
EXEC SANPDU
>
RETURN
EPROC
IFN QDEBUG,< ;Reserve patch area
SAPATCH: BLOCK 100
>
SUBTTL LITERALS
LIT
END