github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-27 12:42:10 +00:00
Code Issues Releases Wiki Activity
Files
e9619de352b9fd7ce6324af8e50ea3d39cc29c85
PDP-10.its/src/l/gcbib.256

2896 lines
68 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;;; -*-MIDAS-*-
;;; **************************************************************
;;; ***** MACLISP ****** GARBAGE COLLECTOR AND ALLOCATION STUFF **
;;; **************************************************************
;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
PGBOT GC
SUBTTL GRABBAGE COLLECTORS AND RELATED ITEMS
GCRET: TDZA A,A ;GC WITH NORET=NIL
GCNRT: MOVEI A,TRUTH ;GC WITH NORET=T
HRRI T,UNBIND ;EXPECTS FLAG IN LH OF T
PUSH P,T
JSP T,SPECBIND
0 A,VNORET
JRST AGC
GC: PUSH P,[333333,,FALSE] ;SUBR 0 - USER ENTRY TO GC
JRST AGC ;TO UNDERSTAND THE 3'S, SEE GSTRT7
MINCEL==6*NFF ;MIN NUMBER WORDS TO RECLAIM FOR EACH SPACE
IFG 40-MINCEL, MINCEL==40
GCCNT: ;FREELIST COUNTING LOOP TO RUN IN AC'S
OFFSET -.
NIL ;SO THAT THE FOLLOWING INS WILL STOP ON NIL
GCCNT1: SKIPE TT,(TT)
GCCNT4: AOJA GCCNT0,.-1 ;OR MAYBE AOBJN
JRST GCP4A
LPROG3==:.-1
GCCNT0:
OFFSET 0
.HKILL GCCNT1 GCCNT4 GCCNT0
SUBTTL GC - INITIALIZATION
WHL==:USELESS*ITS ;FLAG FOR WHO-LINE STUFF
XCTPRO
AGC4: HRROS NOQUIT ;ENTRY FROM FWCONS, FLCONS, AND THE LIKE
NOPRO
SUBI A,2 ;ENTER WITH JSP A,AGC4
PUSH P,A
XCTPRO
AGC: HRROS NOQUIT ;ENTER HERE WITH PUSHJ P,AGC
NOPRO
SKIPE ALGCF ;CANT SUCCESSFULLY GC WHILE IN ALLOC
JRST ALERR
AGC1:
;MUST HAVE DONE HRROS NOQUIT BEFORE COMING HERE.
;FIRST WE GET CURRENT RUNTIME IN "HOST MACHINE UNITS" IN GCTM1.
;THIS MUST BE DONE IN AND AROUND THE SAVING OF THE AC'S.
IT$ .SUSET [.RRUNT,,GCTM1]
MOVEM NACS+1,GCNASV
10$ SETZ NACS+1,
10$ RUNTIM NACS+1, ;GET RUNTIME FOR THIS JOB
10$ MOVEM NACS+1,GCTM1
MOVEI NACS+1,GCACSAV
BLT NACS+1,GCACSAV+NACS ;BLT AWAY ARG ACS (AND NIL) INTO PROTECTED PLACE
20$ MOVEI 1,.FHSLF
20$ RUNTM ;GET RUNTIME FOR THIS FORK
20$ MOVEM 1,GCTM1
MOVE NACS+1,[NACS+2,,GCNASV+1]
BLT NACS+1,GCNASV+16-<NACS+1> ;SAVE NON-MARKED AC'S EXCEPT SP
MOVE NACS+1,[UUOH,,GCUUSV]
BLT NACS+1,GCUUSV+LUUSV-1 ;SAVE UUOH STUFF, IN CASE STRT IS USED
MOVEI A,TRUTH ;SPECBIND TERPRI TO T, TO PREVENT
JSP T,SPECBIND ; AUTO-TERPRI IN GC MESSAGES
0 A,V%TERPRI
MOVEM SP,GCNASV+17-<NACS+1> ;NOW SAVE SP
SETZM GCFXP
SETZ R,
REPEAT NFF,[
SKIPN FFS+.RPCNT ;FIGURE OUT WHICH SPACE(S) EMPTY
TLO R,400000_-.RPCNT
] ;END OF REPEAT NFF
SKIPN FFY2 ;IF WE RAN OUT OF SYMBOL BLOCKS,
TLO R,400000_<-FFY+FFS> ; THEN CREDIT IT TO SYMBOLS
MOVN D,R ;THIS IS A STANDARD HACK TO KILL ONE BIT
TDZE R,D ;SKIP IF THERE WERE NO BITS
JUMPE R,GCGRAB ;JUMP IF EXACTLY ONE BIT ON
AGC1Q: SETZM GCRMV
AOSE IRMVF ;IF OVERRIDE IS ON, THEN
SKIPE VGCTWA
SETOM GCRMV ;DO REMOVAL ANYHOW.
MOVNI TT,20 ;TOP 40 BITS OF WORD ON
JSP F,GCINBT ;INIT MARK BITS FOR LIST, FIXNUM, ETC.
MOVE T,[SFSSIZ,,OFSSIZ] ;SAVE AWAY OLD SIZES OF SPACES
BLT T,OSASIZ ; (USED FOR ARG TO GC-DAEMON)
MOVE T,VGCDAEMON
IOR T,GCGAGV
IFE WHL, JUMPE T,GCP6
IFN WHL, JUMPE T,GCP5
MOVSI R,GCCNT
BLT R,LPROG3
SKIPN VGCDAEMON
HRLI GCCNT4,(AOBJN GCCNT0,)
MOVNI R,NFF ;MAY OR MAY NOT HAVE BIGNUMS OR HUNKS
GCP4: SETZ GCCNT0,
SKIPGE FFS+NFF(R)
JRST GCP4B
SKIPN VGCDAEMON
MOVSI GCCNT0,-MINCEL
SKIPE TT,FFS+NFF(R)
AOJA GCCNT0,GCCNT1
GCP4A: TLZ GCCNT0,-1
HRRZ F,GCWORN+NFF(R) ;ACCOUNT FOR LENGTHS OF ITEMS
IMULI GCCNT0,(F)
CAIGE GCCNT0,MINCEL ;IF LESS THEN MINCEL, THEN FREELIST WAS
SETZM FFS+NFF(R) ; "PRACTICALLY EMPTY" AND DESERVES SOME BLAME
GCP4B: HRLM GCCNT0,NFFS+NFF(R)
AOJL R,GCP4
;FALLS THROUGH
;FALLS IN
;;; PDLS ARE SAFE
IFN WHL,[
GCP5: MOVE F,GCWHO
SKIPE GCGAGV
JRST GSTRT0
TRNN F,1 ;1-BIT MEANS WE WANT TO SEE
JRST GCP6 ; THE REASON FOR THE GC
JRST GSTR0A ; IN THE WHO-LINE
] ;END OF IFN WHL
IFE WHL,[
SKIPN GCGAGV
JRST GCP6
] ;END OF IFE WHL
GSTRT0: STRT 17,[SIXBIT \^M;GC DUE TO !\]
GSTR0A: SETZB TT,D ;FIGURE OUT REASON FOR GC
HLRZ T,(P)
CAIN T,111111 ;WAS IT INITIAL STARTUP? (SEE LISP)
MOVEI TT,[SIXBIT \STARTUP!\]
CAIN T,333333 ;WAS IT USER CALLING GC FUNCTION?
MOVEI TT,[SIXBIT \USER!\]
CAIN T,444444 ;WAS IT ARRAYS?
MOVEI TT,[SIXBIT \ARRAY RELOCATION!\]
CAIN T,555555 ;I/O CHANNELS?
MOVEI TT,[SIXBIT \I/O CHANNELS!\]
CAIN T,666666 ;SUSPEND?
MOVEI TT,[SIXBIT \SUSPEND!\]
JUMPN TT,GSTRT8
MOVNI T,NFF ;NONE OF THOSE HYPOTHESES WORK
GSTRT1: SKIPN FFS+NFF(T) ;MAYBE SOME STORAGE SPACE RAN OUT
SKIPA TT,T
ADDI D,1
AOJL T,GSTRT1
JUMPE TT,GSTRT7 ;NO, THAT WASN'T IT
IFN WHL, SKIPN GCGAGV
.ALSO, JRST GSTRT4
MOVNI T,NFF ;YES, IT WAS. PRINT MOBY MESSAGE!
SETZ R,
GSTRT2: SKIPE FFS+NFF(T)
JRST GSTRT5
JUMPE R,GSTRT3
CAIE D,NFF-2
STRT 17,[SIXBIT \, !\]
CAMN T,TT
STRT 17,[SIXBIT \ AND !\]
GSTRT3: SETO R,
STRT 17,@GSTRT9+NFF(T)
GSTRT5: AOJL T,GSTRT2
STRT 17,[SIXBIT \ SPACE!\]
CAIE D,NFF-1
STRT 17,[SIXBIT \S!\]
IFN WHL, GSTRT4: MOVE TT,GSTRT9+NFF(TT)
JRST GSTRT6
GSTRT7: MOVEI TT,[SIXBIT \ ? !\] ;I DON'T KNOW WHY WE'RE HERE!
GSTRT8:
IFN WHL,SKIPE GCGAGV
STRT 17,(TT) ;PRINT REASON
GSTRT6:
IFN WHL,[
TRNN F,1
JRST GCWHL9
MOVE D,(TT)
MOVE R,1(TT)
ROTC D,-22
MOVSI F,(SIXBIT \!\)
MOVE T,[220600,,D]
GCWHL2: ILDB TT,T
CAIE TT,'!
JRST GCWHL2
DPB NIL,T
GCWHL3: IDPB NIL,T
TLNE T,770000
JRST GCWHL3
HRLI D,(SIXBIT \GC:\)
MOVE T,[-6,,GCWHL6]
.SUSET T
GCWHL9:
] ;END OF IFN WHL
;FALLS THROUGH
;;; PDLS ARE SAFE
SUBTTL GC - MARK THE WORLD
;FALLS IN
GCP6: HRROS MUNGP ;STARTING TO MUNG SYMBOL/SAR MARK BITS
MOVE A,[<-20>_-NUNMRK] ;PRE-PROTECT CERTAIN
ANDM A,BTBLKS ; RANDOM LIST CELLS
MOVNI R,NACS+1 ;PROTECT CONTENTS OF MARKED ACS
GCP6Q0: HRRZ A,GCACSAV+NACS+1(R)
JSP T,GCMARK
AOJL R,GCP6Q0
HRRZ R,C2
ADDI R,1
GCP6Q1: HRRZ A,(R) ;CAUSES MARKING OF CONTENTS
JSP T,GCMARK ; OF ACS AT TIME OF GC, AND OF REG PDL
CAIGE R,(P)
AOJA R,GCP6Q1
MOVEI R,LPROTE-1
GCP6Q2: MOVEI A,BPROTE(R) ;PROTECT PRECIOUS STUFF
JSP T,GCMARK
SOJGE R,GCP6Q2
IFN BIGNUM,[
MOVEI R,LBIGPRO-1
GCP6Q3: MOVEI A,BBIGPRO(R)
JSP T,GCMARK
SOJGE R,GCP6Q3
] ;END OF IFN BIGNUM
MOVSI R,TTS<GC>
IORM R,DEDSAR+TTSAR ;PROTECT DEDSAR
IORM R,DBM+TTSAR ;PROTECT DEAD BLOCK MARKER
HRRZ R,SC2
GCP6Q4: HRRZ A,(R)
JSP T,GCMARK ;MARK SAVED VALUES ON SPEC PDL
CAIGE R,(SP)
AOJA R,GCP6Q4
SKIPN R,INTAR
JRST GCP6Q6
GCP6Q5: MOVE A,INTAR(R)
JSP T,GCMARK
SOJG R,GCP6Q5
GCP6Q6: ;PROTECT INTERRUPT FUNCTIONS
IRP Z,,[0,1,2]X,,[ALARMCLOCK,AUTFN,UDF]
MOVEI R,NUINT!Z
SKIPE A,V!X(R)
JSP T,GCMARK
SOJG R,.-2
TERMIN
SKIPE A,VMERR
JSP T,GCMARK
IFN PAGING,[
SKIPN D,LHSGLK ;SKIP IF ANY LH SEGMENTS
JRST GCP6R0 .SEE LHVBAR
GCP6Q8: MOVEI F,(D) ;CREATE AOBJN POINTER INTO SEGMENT
LSH F,SEGLOG
HRLI F,-SEGSIZ
GCP6Q9: HLRZ A,(F) ;MARK FROM ALL ENTRIES IN THAT SEGMENT
JSP T,GCMARK
HRRZ A,(F)
JSP T,GCMARK
AOBJN F,GCP6Q9
LDB D,[SEGBYT,,GCST(D)] ;FOLLOW LINKED LIST OF SEGMENTS
JUMPN D,GCP6Q8
GCP6R0:
] ;END OF IFN PAGING
;FALLS THROUGH
;;; PDLS ARE SAFE
;FALLS IN
SKIPN GCRMV
JRST GCP6B1
JSP R,GCGEN ;IF DOING TWA REMOVAL, TRY MARKING FROM
GCP8I ;NON-TRIVIAL P-LISTS OF CURRENT OBARRAY
JRST GCP6B2
GCP6B1: MOVE A,VOBARRAY
JSP TT,$GCMKAR ;OTHERWISE, JUST MARK OBARRAY BUCKETS
GCP6B2: MOVEI A,OBARRAY
CAME A,VOBARRAY
JSP TT,$GCMKAR
MOVE R,GCMKL
GCP6A: JUMPE R,GCP6D
HLRZ A,(R)
MOVE D,ASAR(A)
TLNN D,AS<GCP> ;IF ARRAY POINTER HAS "GC ME" BIT SET,
JRST GCP6F
TLNE D,AS<OBA> ;MORE CHECKING ON OBARRAYS
JRST GCP6F0
GCP6F1: JSP TT,GCMKAR ; THEN MARK FROM ARRAY ENTRIES
GCP6F: HRRZ R,(R)
HRRZ R,(R)
JRST GCP6A
GCP6F0: CAMN A,VOBARRAY ; AND IF THIS ISN'T THE CURRENT OBARRAY,
SKIPN GCRMV ; OR IT IS, BUT WE ARENT DOING GCTWA REMOVAL,
JRST GCP6F1
JRST GCP6F
GCP6D: MOVE A,V%TYI
JSP TT,$GCMKAR
MOVE A,V%TYO
JSP TT,$GCMKAR
SKIPN R,PROLIS
GCP6D1: JUMPE R,GCP6H ;PROTECT READ-MACRO
HLRZ A,(R) ; FUNCTIONS (CAN'T JUST GCMARK WHOLE
HLRZ A,(A) ; PROLIS - DON'T WANT TO PROTECT
JSP T,GCMARK ; READTABLE SARS)
HRRZ R,(R)
JRST GCP6D1
GSTRT9: [SIXBIT \LIST!\] .SEE GCWORRY
[SIXBIT \FIXNUM!\] .SEE GCPNT
[SIXBIT \FLONUM!\]
DB$ [SIXBIT \DOUBLE!\]
CX$ [SIXBIT \COMPLEX!\]
DX$ [SIXBIT \DUPLEX!\]
BG$ [SIXBIT \BIGNUM!\]
[SIXBIT \SYMBOL!\]
IRP X,,[2,4,8,16,32,64,128,256,512,1024]
[SIXBIT \HUNK!X!!\]
IFE .IRPCNT-HNKLOG, .ISTOP
TERMIN
[SIXBIT \ARRAY!\]
IFN WHL,[
GCWHL6: .RWHO1,,GCWHO1
.RWHO2,,GCWHO2
.RWHO3,,GCWHO3
.SWHO1,,[.BYTE 8 ? 66 ? 0 ? 366 ? 0 ? .BYTE]
.SWHO2,,D
.SWHO3,,R
] ;IFN WHL
;;; PDLS ARE SAFE
SUBTTL GC - CONSIDER THE EFFECTS OF AN ARRAY DISAPPEARING
;;; UPDATE THE GCMKL BY SPLICING OUT ARRAYS TO BE SWEPT.
;;; IF ANY SUCH ARRAYS ARE OPEN FILES, CLOSE THEM.
CGCMKL:
GCP6H: SKIPN F,GCMKL
JRST GCP7
JSP A,GCP6H0
GCP6H1: HLRZ A,(F)
TDNE TT,TTSAR(A)
JRST GCP6G
TDNE T,ASAR(A)
JRST GCP6H7
GCP6H8:
ANDCAM TT,TTSAR(A)
IORM R,TTSAR(A)
MOVEI B,ADEAD
EXCH B,ASAR(A)
TLNN B,AS<RDT>
JRST GCP6G
MOVEI AR1,PROLIS ;JUST KILLED A READTABLE
GCP6H3: HRRZ AR2A,(AR1) ; - CLEAN UP PROLIS
GCP6H4: JUMPE AR2A,GCP6G
HLRZ C,(AR2A)
HRRZ C,(C)
HLRZ C,(C)
CAIE C,(A)
JRST GCP6H5
HRRZ AR2A,(AR2A)
HRRM AR2A,(AR1)
JRST GCP6H4
GCP6H5: MOVEI AR1,(AR2A)
JRST GCP6H3
GCP6G: HRRZ F,(F)
HRRZ F,(F)
JUMPN F,GCP6H1
JRST GCP7
GCP6H0: MOVSI T,AS<JOB+FIL> ;SET UP SOME ACS FOR THE GCMKL-LOOK LOOP
MOVE R,[TTDEAD]
MOVSI TT,TTS<CN+GC>
JRST (A)
;;; PDLS ARE SAFE
;;; CLEAN UP AND CLOSE A FILE WHEN GARBAGE COLLECTED
GCP6H7: MOVE B,TTSAR(A) ;ABOUT TO GC A FILE ARRAY
TLNE B,TTS<CL> ;IGNORE IF ALREADY CLOSED
JRST GCP6H8
PUSH P,F
IFN JOBQIO,[
HLL B,ASAR(A)
TLNE B,AS<JOB>
JRST GCP6J1
] ;END OF IFN JOBQIO
PUSHJ P,ICLOSE ;OTHERWISE CLOSE THE FILE
MOVEI R,[SIXBIT \^M;FILE CLOSED: !\]
GCP6H2: SKIPN GCGAGV
JRST GCP6H9
STRT 17,(R)
HLRZ A,@(P)
HRRZ AR1,VMSGFILES
TLO AR1,200000
HRROI R,$TYO
PUSHJ P,PRINTA
GCP6H9: POP P,F
JSP A,GCP6H0 ;RE-INIT MAGIC CONSTANTS IN ACS
HLRZ A,(F)
JRST GCP6H8
IFN JOBQIO,[
;;; CLEAN UP AND CLOSE AN INFERIOR PROCEDURE WHEN GARBAGE COLLECTED
GCP6J1:
IFN ITS,[
MOVEI R,[SIXBIT \^M;FOREIGN JOB FLUSHED: !\]
SKIPN T,J.INTB(B)
JRST GCP6J3
MOVEI R,[SIXBIT \^M;INFERIOR JOB FLUSHED: !\]
.CALL GCP6J9 ;IF INFERIOR JOB, OPEN IT ON
.VALUE ; THE TEMPORARY I/O CHANNEL
JFFO T,.+1
MOVNS TT
SETZM JOBTB+21(TT) ;CLEAR ENTRY IN JOB TABLE
] ;END OF IFN ITS
GCP6J3: MOVSI T,TTS<CL> ;MARK THE JOB OBJECT AS BEING CLOSED
ANDCAM T,TTSAR(A)
JRST GCP6H2
IFN ITS,[
GCP6J9: SETZ
SIXBIT \OPEN\ ;OPEN FILE (INFERIOR PROCEDURE)
1000,,TMPC ;CHANNEL NUMBER
,,F.DEV(B) ;DEVICE NAME (USR)
,,F.FN1(B) ;FILE NAME 1 (UNAME)
400000,,F.FN2(B) ;FILE NAME 2 (JNAME)
] ;END OF IFN ITS
] ;END OF IFN JOBQIO
;;; PDLS ARE SAFE
SUBTTL GC - TWA REMOVAL
GCP7: HRRZ A,GCMKL
JSP T,GCMARK
HRRZ A,PROLIS
JSP T,GCMARK
SKIPN GCRMV
JRST GCSWP
JSP R,GCGEN ;IF DOING TWA REMOVAL, THEN WIPE OUT
GCP8G ; T.W.A.'S AND THEN MARK BUCKETS
MOVE A,VOBARRAY
JSP TT,$GCMKAR
;FALLS THROUGH
;;; PDLS ARE UNSAFE
SUBTTL GC - SWEEP THE WORLD
;FALLS IN
GCSWP: .SEE KLINIT ;WHICH CLOBBERS NEXT INSTRUCTION
MOVEM FXP,GCFXP ;WE ARE ABOUT TO CLOBBER THE PDL POINTERS
MOVNI SP,NFF ;NUMBER OF SPACES TO SWEEP
MOVEM SP,GC99
;MAJOR SWEEP LOOP OVER ALL SPACES
GCSW1: MOVE FXP,GCSWTB+NFF(SP) ;PUT INNER SWEEP LOOP IN AC'S
HLLZ FLP,FXP ; AND INITIALIZE COUNT
BLT FLP,(FXP)
SETZ FXP, ;FXP HAS FREELIST, A HAS COUNT
SKIPN FLP,FSSGLK+NFF(SP)
JRST GCSW7
;MINOR SWEEP LOOP OVER ALL SEGMENTS IN A SPACE
GCSW2: MOVEM FLP,GC98
JRST @GCSW2A+NFF(SP) ;DISPATCH ON TYPE TO SEPARATE ROUTINES
GCSW2A: GCSWS ;LIST
GCSWS ;FIXNUM
GCSWS ;FLONUM
DB$ GCSWD ;DOUBLE
CX$ GCSWC ;COMPLEX
DX$ GCSWZ ;DUPLEX
BG$ GCSWS ;BIGNUM
GCSWY ;SYMBOL
IFN HNKLOG, GCSWH1
REPEAT HNKLOG,[
IFL .RPCNT-4, GCSWH1 ;HUNKS OF LESS THAN 40 WORDS
.ELSE GCSWH2 ;HUNKS OF 40 WORDS OR MORE
] ;END OF REPEAT HNKLOG
GCSWA ;SARS
IFN .-GCSW2A-NFF, WARN [WRONG LENGTH TABLE]
GCSW5: MOVE SP,GC99
MOVE FLP,GC98
LDB FLP,[SEGBYT,,GCST(FLP)]
JUMPN FLP,GCSW2
GCSW7:
HRRZ A,@GCSW7A+NFF(SP)
HRRM FXP,FFS+NFF(SP) ;SAVE FREELIST - DON'T DISTURB SIGN BIT
HRRZ B,GCWORN+NFF(SP)
IMULI A,(B) ;ACCOUNT FOR SIZE OF OBJECTS IN THIS SPACE
HRRM A,NFFS+NFF(SP) ;SAVE COUNT OF WORDS COLLECTED
AOSGE SP,GC99
JRST GCSW1
HRRZS MUNGP ;WE HAVE UNDONE MUNGING OF BITS
MOVSI F,TTS<CN+GC>
ANDCAM F,DEDSAR ;MUST CLEAR BITS IN DEDSAR
JSP NACS+1,GCACRS ;RESTORE ACCUMULATORS
JRST GCPNT ;NEXT PRINT STATISTICS
;;; PDLS ARE UNSAFE
;TABLE OF SWEEPERS FOR RUNNING IN ACS AND THE LAST LOCATIONS TO LOAD THEM INTO
GCSWTB: GCFSSWP,,LPROG1 ;LIST
GCFSSWP,,LPROG1 ;FIXNUM
GCFSSWP,,LPROG1 ;FLONUM
DB$ GCHSW1,,LPROGH ;DOUBLE
CX$ GCHSW1,,LPROGH ;COMPLEX
DX$ GCHSW1,,LPROGH ;DUPLEX
BG$ GCFSSWP,,LPROG1 ;BIGNUM
GSYMSWP,,LPROG6 ;SYMBOL
IFN HNKLOG, GCHSW1,,LPROGH
REPEAT HNKLOG,[
IFL .RPCNT-4, GCHSW1,,LPROGH ;HUNKS OF LESS THAN 40 WORDS
.ELSE GCHSW2,,LPROGK ;HUNKS OF 40 WORDS OR MORE
] ;END OF REPEAT HNKLOG
GSARSWP,,LPROG4 ;SARS
IFN .-GCSWTB-NFF, WARN [WRONG LENGTH TABLE]
;TABLE OF AC FOR EACH SWEEPER WHICH HOLDS COUNT OF OBJECTS SWEPT
GCSW7A: GFSCNT ;LIST
GFSCNT ;FIXNUM
GFSCNT ;FLONUM
DB$ GHCNT1 ;DOUBLE
CX$ GHCNT1 ;COMPLEX
DX$ GHCNT1 ;DUPLEX
BG$ GFSCNT ;BIGNUM
GYCNT ;SYMBOL
IFN HNKLOG, GHCNT1
REPEAT HNKLOG,[
IFL .RPCNT-4, GHCNT1 ;HUNK OF LESS THAN 40 WORDS
.ELSE GHCNT2 ;HUNKS OF 40 WORDS OR MORE
] ;END OF REPEAT HNKLOG
GSCNT ;SARS
IFN .-GCSW7A-NFF, WARN [WRONG LENGTH TABLE]
;;; PDLS ARE UNSAFE
GCSWS: MOVE P,GCST(FLP) ;GET SHIFTED ADDRESS OF BIT BLOCK
LSH P,SEGLOG-5 ;SHIFT BACK TO FORM WORD ADDRESS
HRLI P,-BTBSIZ ;MAKE AOBJN POINTER OVER WORDS OF BITS
LSH FLP,SEGLOG
HRLI FLP,-40 ;40 CELLS PER WORD OF BITS
JRST GFSP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCFSSWP: ;SWEEPER FOR LIST, FIXNUM, FLONUM, BIGNUM
OFFSET -.
GFSP1: SKIPN SP,(P) ;GET A WORD OF MARK BITS
JRST GFSP5 ;IF ALL 40 WORDS MARKED, THIS SAVES TIME
GFSP2: JUMPGE SP,GFSP4 ;JUMP IF SINGLE WORD MARKED
HRRZM FXP,(FLP) ;ELSE CHAIN INTO FREE LIST
HRRZI FXP,(FLP)
GFSCNT: AOJ .,0 ;RH COUNTS RECLAIMED CELLS
GFSP4: ROT SP,1 ;ROTATE NEXT MARK BIT UP
AOBJN FLP,GFSP2 ;COUNT OFF 40 WORDS
TLOA FLP,-40 ;RESET 40-WORD COUNT IN AOBJN POINTER
GFSP5: ADDI FLP,40 ;SKIP OVER 40 WORDS IN SWEEP
AOBJN P,GFSP1 ;<BTBSIZ> BLOCKS OF 40 WORDS
JRST GCSW5
LPROG1==:.-1
OFFSET 0
.HKILL GFSP1 GFSP2 GFSCNT GFSP4 GFSP5
GCSWY: LSH FLP,SEGLOG
HRLI FLP,-SEGSIZ
JRST GYSP1
GSYMSWP: ;SWEEPER FOR SYMBOL SPACE
OFFSET -.
GYSP7: (300,,0) ;3.8=PURE, 3.7=COMPILED CODE REFS (NOTE: TSNE WITH ITSELF ALWAYS SKIPS)
GYSP1: HLRZ SP,(FLP)
TRZN SP,1 ;IF MARKED,
TSNE GYSP7,(SP) ; OR IF PURE OR COMPILED CODE NEEDS IT,
JRST GYSP3 ; THEN DO NOT SWEEP UP
JUMPN SP,GYSP5 ;IF NON-NIL LEFT HALF, RECLAIM THE SYMBOL BLOCK
GYSP2: HRRZM FXP,(FLP) ;CHAIN ONTO FREELIST
HRRZI FXP,(FLP)
GYCNT: AOJ .,0
GYSP3: HRLM SP,(FLP)
AOBJN FLP,GYSP1
JRST GCSW5
LPROG6==:.-1
OFFSET 0
.HKILL GYSP1 GYSP2 GYSP3 GYSP7 GYCNT
;;; PART OF SYMBOL SWEEPER - RESTORES A SYMBOL BLOCK TO FFY2.
;;; ALSO ATTEMPTS TO RETURN THE VALUE CELL IF IT HAS ONE.
GYSP5: EXCH SP,FFY2 ;RETURN SYMBOL BLOCK TO FREELIST
EXCH SP,@FFY2
TLZ SP,-1 ;MAYBE TRY TO RETURN A VALUE CELL
CAIE SP,SUNBOUND
JRST GYSP5A
SETZ SP,
JRST GYSP2
GYSP5A: CAIL SP,BXVCSG+NXVCSG*SEGSIZ
JRST GYSP5B ;CAN ONLY RETURN CELLS IN VC SPACE
EXCH SP,FFVC
MOVEM SP,@FFVC
GYSP5B: SETZ SP,
JRST GYSP2
;;; PDLS ARE UNSAFE
IFN HNKLOG+DBFLAG+CXFLAG,[
GCSWD:
GCSWC:
GCSWZ:
GCSWH1: HRRZ P,GCWORN+NFF(SP) ;GET SIZE OF OBJECTS
HRRI GH1SP4,(P)
SUBI P,1
HRRI GH1SP5,(P)
HRRZ P,GCWORN+NFF(SP)
MOVNI SP,40
IDIVM SP,P
HRRI GH1SP6,(P) ;BITS PER BIT BLOCK WORD
MOVE P,GCST(FLP) ;GET SHIFTED ADDRESS OF BIT BLOCK
LSH P,SEGLOG-5 ;SHIFT BACK TO FORM WORD ADDRESS
HRLI P,-BTBSIZ ;MAKE AOBJN POINTER OVER WORDS OF BITS
LSH FLP,SEGLOG ;MAKE AOBJN POINTER OVER CELLS
HRLI FLP,(GH1SP6)
JRST GH1SP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCHSW1:
OFFSET -.
GH1SP1: MOVE SP,(P)
GH1SP2: JUMPGE SP,GH1SP4
HRRZM FXP,(FLP)
HRRZI FXP,(FLP)
GHCNT1: AOJ .,0
GH1SP4: ROT SP,1_HNKLOG
GH1SP5: ADDI FLP,<1_HNKLOG>-1
AOBJN FLP,GH1SP2
GH1SP6: HRLI FLP,<-40>_-HNKLOG
AOBJN P,GH1SP1
JRST GCSW5
LPROGH==:.-1
OFFSET 0
.HKILL GH1SP1 GH1SP2 GHCNT1 GH1SP4 GH1SP5 GH1SP6
] ;END OF IFN HNKLOG+DBFLAG+CXFLAG
;;; PDLS ARE UNSAFE
IFG HNKLOG-4,[
GCSWH2: HRRZ P,GCWORN+NFF(SP) ;GET SIZE OF OBJECTS
HRRI GH2SP5,(P)
SUBI P,1
LSH P,-5
HRRI GH2SP7,(P) ;BITS PER BIT BLOCK WORD
HRRZ P,GCWORN+NFF(SP)
LSH P,-5
MOVNI SP,BTBSIZ
IDIVM SP,P
HRLI P,(P) ;MAKE AOBJN POINTER OVER WORDS OF BITS
MOVE SP,GCST(FLP)
LSH SP,SEGLOG-5
HRRI P,(SP)
LSH FLP,SEGLOG ;MAKE POINTER OVER CELLS
JRST GH2SP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCHSW2:
OFFSET -.
GH2SP1: SKIPL (P) ;ONLY THE SIGN BIT OF A MARK WORD IS USED
JRST GH2SP5
HRRZM FXP,(FLP)
HRRZI FXP,(FLP)
GHCNT2: AOJ .,0
GH2SP5: ADDI FLP,1_HNKLOG
GH2SP7: ADDI P,<<1_HNKLOG>-1>_-5
AOBJN P,GH2SP1
JRST GCSW5
LPROGK==:.-1
OFFSET 0
.HKILL GH2SP1 GH2SP2 GHCNT2 GH2SP5 GH2SP7
] ;END OF IFG HNKLOG-4
GCSWA: LSH FLP,SEGLOG
HRLI FLP,-SEGSIZ/2
JRST GSSP1
GSARSWP: ;SPECIAL SWEEPER FOR SARS
OFFSET -.
GSSP0: ADDI FLP,1
GSSP1:
TDNN GSSP7,TTSAR(FLP) ;TEST IF SAR MARKED (OR OTHERWISE NEEDED)
AOJA GSCNT,GSSP2 ;NO, COUNT IT AS SWEPT
ANDCAM GSSP8,TTSAR(FLP) ;YES, TURN OFF MARK BIT
AOBJN FLP,GSSP0 ; AND TRY NEXT ONE
JRST GCSW5
GSSP2: HRRZM FXP,ASAR(FLP) ;CHAIN INTO FREE LIST
HRRZI FXP,ASAR(FLP)
AOBJN FLP,GSSP0
JRST GCSW5
GSSP7: TTS<CN+GC>,,
GSSP8: TTS<GC>,,
GSCNT: 0
LPROG4==:.-1
OFFSET 0
.HKILL GSSP0 GSSP1 GSSP2 GSSP7 GSSP8 GSCNT
;;; PDLS ARE SAFE
SUBTTL GC - MAKE SURE ENOUGH WAS RECLAIMED
GCPNT: SKIPN GCGAGV
JRST GCE0
SETZM GC99 ;GC99 COUNTS ENTRIES PRINTED
MOVNI F,NFF
GCPNT1: HRRZ T,NFFS+NFF(F)
SKIPN TT,SFSSIZ+NFF(F)
JRST GCPNT6
SOSLE GC99
JRST GCPNT2
STRT 17,[SIXBIT \^M; !\] ;TERPRI-; EVERY THIRD ONE
MOVEI D,3
MOVEM D,GC99
GCPNT2: PUSHJ P,STGPNT
STRT 17,@GSTRT9+NFF(F)
CAME F,XC-1 ;COMMA AFTER EACH BUT LAST
STRT 17,[SIXBIT \, !\]
GCPNT6: AOJL F,GCPNT1
STRT 17,[SIXBIT \ WORDS FREE!\]
;FALLS THROUGH
;;; PDLS ARE SAFE
SUBTTL GC - CLEANUP AND TERMINATION
;FALLS IN
GCE0: MOVNI F,NFF
GCE0C0: MOVE AR2A,MFFS+NFF(F)
TLNN AR2A,-1
JRST GCE0C1
HRRZ AR1,SFSSIZ+NFF(F)
FSC AR1,233 ;FIXNUM TO FLONUM CONVERSION
FMPR AR1,AR2A
MULI AR1,400 ;FLONUM TO FIXNUM CONVERSION
ASH AR2A,-243(AR1)
GCE0C1: SKIPGE FFS+NFF(F)
JRST GCE0C5
CAIGE AR2A,MINCEL
MOVEI AR2A,MINCEL ;MUST SATISFY ABSOLUTE MIN OF<MINCEL> CELLS
GCE0C5: MOVEM AR2A,ZFFS+NFF(F)
HRRZ TT,NFFS+NFF(F)
CAIGE TT,(AR2A) ;ALSO MUST SATISFY USER'S MIN
PUSHJ P,GCWORRY ;IF NOT, MUST WORRY ABOUT IT
GCE0C2: AOJL F,GCE0C0
MOVEI AR2A,1
SKIPN FFY2
PUSHJ P,GRABWORRY ;REMEMBER, F IS ZERO HERE
SKIPN FFY2
JRST GCLUZ
MOVNI F,NFF ;IF WE RECLAIMED LESS THAN ABSOLUTE
GCE0C3: HRRZ TT,NFFS+NFF(F) ; MINIMUM FOR ANY SPACE,
SKIPGE FFS+NFF(F)
JRST GCE0C9
CAIGE TT,MINCEL ; WE ARE OFFICIALLY DEAD
JRST GCLUZ
GCE0C9: AOJL F,GCE0C3
SKIPE PANICP
JRST GCE0C7
MOVNI F,NFF ;NOW SEE IF WE EXCEEDED MAXIMUM
GCE0C6: MOVE TT,SFSSIZ+NFF(F)
CAMG TT,XFFS+NFF(F)
JRST GCE0K3
HRLZ D,GCMES+NFF(F)
HRRI D,1004 ;GC-OVERFLOW
PUSHJ P,UINT ;NOQUIT IS ON HERE, SO INTERRUPT GETS STACKED
GCE0K3: AOJL F,GCE0C6
GCE0C7: MOVNI F,NFF
GCE0C4: MOVE TT,SFSSIZ+NFF(F)
CAMG TT,XFFS+NFF(F) ;IF A SPACE LOST TO GC-OVERFLOW,
JRST GCE0K2 ; DON'T MAKE IT LOSE FOR GC-LOSSAGE TOO
MOVEM TT,XFFS+NFF(F) ;JUST QUIETLY UPDATE ITS GCMAX
JRST GCE0K1
GCE0K2: HRRZ T,NFFS+NFF(F)
CAMGE T,ZFFS+NFF(F)
JRST GCLUZ
GCE0K1: AOJL F,GCE0C4
IFN PAGING,[
HRRZ TT,NOQUIT
IOR TT,INHIBIT
IOR TT,VNORET
SKIPN TT
PUSHJ P,RETSP
] ;END OF IFN PAGING
SKIPE GCGAGV
STRT 17,STRTCR
;FALLS THROUGH
;;; PDLS ARE SAFE
;FALLS IN
SKIPN VGCDAEMON
JRST GCEND
MOVEI C,NIL ;CONS UP ARG FOR GCDAEMON
MOVEI D,NFF-1 ;WE CHECKED LENGTH OF FREELISTS SO
SETZ C, ; WE KNOW CONSES WON'T RE-INVOKE GC
GCE0E: MOVE TT,SFSSIZ(D) ;SIZE OF SPACE AFTER GC
PUSHJ P,CONS1FX
MOVE TT,OFSSIZ(D) ;SIZE OF SPACE BEFORE GC
PUSHJ P,CONSFX
HRRZ TT,NFFS(D) ;LENGTH OF FREELIST AFTER GC
CAIN D,FFX-FFS ;ALLOW FOR THE SPACE USED
SUBI TT,4*NFF ; TO CONS UP THE GC-DAEMON ARG
CAIN D,FFS-FFS
SUBI TT,6*NFF
PUSHJ P,CONSFX
HLRZ TT,NFFS(D) ;LENGTH OF FREELIST BEFORE GC
PUSHJ P,CONSFX
HRRZ A,GCMES(D) ;NAME OF SPACE
PUSHJ P,CONS
MOVE B,C
PUSHJ P,CONS
MOVE C,A
SOJGE D,GCE0E
JSR GCRSR .SEE GCRSR0
HRLI A,1003 ;GC-DAEMON
PUSH P,A ;FOR INTERRUPT PROTECTION ONLY
PUSH FXP,D
MOVS D,A
PUSHJ P,UINT
POPI P,1 ;FLUSH SLOT "FOR INTERRUPT PRO ONLY"
MOVE D,(FXP)
MOVEM F,(FXP) ;USE AC F BELOW, SINCE GCLUZ REQUIRES IT
MOVNI F,NFF ;IF THE RUNNING OF THE GC-DAEMON ATE UP ALL
SKIPN FFS+NFF(F) ; OUR SPACE, THEN LOSE BADLY!
JRST GCLUZ0
AOJL F,.-2
POP FXP,F
JRST POPAJ ;REMEMBER! GCRSR HAS STACKED A SAVED "A"
;;; GC MUST EITHER JRST TO GCEND, OR JSR TO GCRSR BEFORE EXITING.
;;; THIS ASSURES THAT GCTIM WILL PROPERLY REFLECT TIME SPENT IN GC.
;;; THE VALUE IN GCTIM IS IN "HOST MACHINE UNITS".
;;; THESE ARE CONVERTED BEFORE BEING RETURNED TO THE USER.
.SEE SGCTIM
GCEND:
MOVE P,GCNASV+14-<NACS+1>
MOVE SP,GCNASV+17-<NACS+1>
PUSHJ P,UNBIND
IFN D20,[
MOVEI 1,.FHSLF
RUNTM
IFN WHL, MOVEM 1,GC98
SUB 1,GCTM1
ADDM 1,GCTIM ;UPDATE GCTIM FOR D20
] ;END OF IFN D20
JSP NACS+1,GCACR ;ac's are restored *after* D20 runtime
SETZM GCFXP ; calculations, since acs 1-3 are used
IFE D20,[
IT$ .SUSET [.RRUNT,,NACS+1]
10$ SETZ NACS+1,
10$ RUNTIM NACS+1,
IFN WHL, MOVEM NACS+1,GC98
SUB NACS+1,GCTM1
ADDM NACS+1,GCTIM ;UPDATE GCTIM FOR non-D20
] ;END OF IFE D20
IFN WHL,[
SKIPE NACS+1,GCWHO
PUSHJ P,GCWHR
] ;END OF IFN WHL
MOVE NACS+1,GCNASV
HRRZS NOQUIT
JRST CHECKI
;GCRSR: 0
GCRSR0: HRLM C,NOQUIT ;RESTORE ACS, AND CHECK FOR ANY STACKED INTERRUPTS
MOVE P,GCNASV+14-<NACS+1>
MOVE SP,GCNASV+17-<NACS+1>
PUSHJ P,UNBIND
IFN D20,[
MOVEI 1,.FHSLF
RUNTM ;UPDATE GCTIM FOR D20
IFN WHL, MOVEM 1,GC98
SUB 1,GCTM1
ADDM 1,GCTIM
] ;END OF IFN D20
JSP NACS+1,GCACR ;RESTORE AC'S
SETZM GCFXP
IFE D20,[
IT$ .SUSET [.RRUNT,,NACS+1]
10$ SETZ NACS+1,
10$ RUNTIM NACS+1,
IFN WHL*<ITS+D10>, MOVEM NACS+1,GC98
SUB NACS+1,GCTM1
ADDM NACS+1,GCTIM ;UPDATE GCTIME FOR (STATUS GCTIME)
] ;END OF IFE D20
IFN WHL,[
SKIPE NACS+1,GCWHO
PUSHJ P,GCWHR
] ;END OF IFN WHL
MOVE NACS+1,GCNASV
PUSH P,A
HLRZ A,NOQUIT
PUSH P,GCRSR
HRRZS NOQUIT
JRST CHECKI
;;; ROUTINE TO INIT MARK BITS FOR LIST, FIXNUM, FLONUM, HUNK,
;;; AND BIGNUM SPACES. INIT BITS IN TT, RETURN ADDRESS IN F.
GCINBT: MOVEM TT,BBITSG
MOVE AR2A,[BBITSG,,BBITSG+1]
BLT AR2A,@MAINBITBLT ;BLT OUT MAIN BIT AREA
MOVE A,BTSGLK ;INITIALIZE ALL BIT BLOCKS
GCINB0: JUMPE A,(F)
MOVEI AR2A,(A)
LSH AR2A,SEGLOG ;GET ADDRESS OF SEGMENT
HRLI AR2A,(AR2A)
MOVEM TT,(AR2A)
AOJ AR2A,
MOVE T,GCST(A) ;GET END ADDRESS FOR BLT
LSH T,SEGLOG-5
TLZ T,-1
CAIE T,(AR2A)
BLT AR2A,-1(T) ;***BLT!***
LDB A,[SEGBYT,,GCST(A)]
JRST GCINB0
IFN WHL,[
GCWHR: TRNN NACS+1,2 ;SKIP IF GC STATISTICS DESIRED
JRST GCWHR2
MOVE NACS+2,GCTIM
IDIVI NACS+2,25000./4 ;GC TIME IN FORTIETHS OF A SECOND
MOVEM NACS+2,GCWHO2
MOVE NACS+2,GCTIM ;GC TIME
IMULI NACS+2,100. ; TIMES 100.
IDIV NACS+2,GC98 ; DIVIDED BY TOTAL RUNTIME
HRLM NACS+2,GCWHO2 ; EQUALS GC TIME PERCENTAGE
TRNE NACS+1,1
JRST GCWHR2
.SUSET [.SWHO2,,GCWHO2] ;JUST SET .WHO2 IF WHO VARS NOT PREVIOUSLY SAVED
GCWHR8: MOVE NACS+2,GCNASV+1 ;RESTORE ACS
MOVE NACS+3,GCNASV+2
POPJ P,
GCWHR2: MOVE NACS+2,[-3,,GCWHR9] ;RESTORE WHO VARS, POSSIBLY WITH
.SUSET NACS+2 ; GC STATISTICS CLOBBERED INTO GCWHO2
JRST GCWHR8
GCWHR9: .SWHO1,,GCWHO1
.SWHO2,,GCWHO2
.SWHO3,,GCWHO3
] ;IFN WHL
SUBTTL MISCELLANEOUS GC UTILITY ROUTINES
GCACRS: MOVE SP,GCNASV+17-<NACS+1> ;RESTORE SP ALSO
GCACR: SKIPN GCFXP
MOVEM FXP,GCFXP
MOVE NIL,[GCACSAV+1,,1] ;RESTORE ALL ACS EXCEPT NACS+1
BLT NIL,NACS
MOVE NIL,[GCNASV+1,,NACS+2]
BLT NIL,FXP
MOVE NIL,GCACSAV
SETZM GCFXP .SEE CHNINT ;ETC.
JRST (NACS+1)
$GCMKAR: MOVE D,ASAR(A)
GCMKAR: MOVE F,TTSAR(A)
SKIPL D,-1(D) ;MARK FROM ARRAY ENTRIES.
JRST (TT)
GCMKA1: HLRZ A,(D)
JSP T,GCMARK
HRRZ A,(D)
JSP T,GCMARK
AOBJN D,GCMKA1
JUMPE F,(TT)
TLNE F,TTS<TY>
TLNE F,TTS<IO>
JRST (TT)
MOVEI D,FB.BUF(F) ;FOR TTY INPUT FILE ARRAYS,
HRLI D,-NASCII/2 ; MUST MARK INTERRUPT FUNCTIONS
SETZ F,
JRST GCMKA1
;;; GCGEN GENERATES NON-NULL BUCKETS OF THE CURRENT OBARRAY
;;; AND APPLIES A GIVEN FUNCTION TO THEM. IT IS CALLED AS
;;; JSP R,GCGEN
;;; FOO
;;; GCGEN WILL EFFECTIVELY DO A JRST FOO MANY TIMES,
;;; PASSING SOME NON-NULL OBARRAY BUCKET THROUGH ACCUMULATOR D.
;;; FOO IS EXPECTED TO RETURN BY DOING A JRST GCP8A.
;;; WHEN DONE, GCGEN RETURNS, SKIPPING OVER THE ADDRESS FOO.
GCGEN: MOVE F,@VOBARRAY .SEE ASAR
MOVE F,-1(F)
SUB F,R70+1
TLZ R,400000
GCP8A: TLCE R,400000
JRST GCP8A1
AOBJP F,1(R) ;EXIT
HLRZ D,(F)
JUMPN D,@(R)
JRST GCP8A
GCP8A1: HRRZ D,(F)
JUMPN D,@(R)
JRST GCP8A
;;; MARK AN S-EXPRESSION GIVEN IN A. TRACES IT COMPLETELY,
;;; MARKING ALL SUBITEMS BY SETTING A MARK BIT TO **ZERO**
;;; FOR LIST, FIXNUM, FLONUM, AND BIGNUM SPACES, AND TO
;;; **ONE** FOR SYMBOLS AND SARS. (THIS SPEEDS UP SWEEPING.)
;;; NEVER MARKS VALUE CELLS!!!! (THEY ARE NEVER SWEPT.)
;;; CALLED BY JSP T,GCMARK WITH OBJECT IN A. USES A,B,C,AR1,AR2A.
GCMARK: JUMPE A,(T) ;NEEDN'T MARK NIL
MOVEI AR2A,(P) ;REMEMBER WHERE P IS
GCMRK0: JRST GCMRK1 .SEE KLINIT
GCMRK3: TLNN A,GCBSYM ;MAYBE WE FOUND A SYMBOL
JRST GCMRK4 ;NOPE
HLRZ AR1,(C) ;YUP
TROE AR1,1
JRST GCMKND
HRLM AR1,(C)
PUSH P,(C) ;PUSH PROPERTY LIST
PUSH P,(AR1) ;PUSH PNAME LIST
SKIPE ETVCFLSP ;A HAC TO SAVE TIME IF THERE NEVER HAVE BEEN
JRST GCMRK6 ; VALUE CELLS TAKEN FROM LIST SPACE
HRRZ A,@-1(AR1)
JRST GCMRK1 ;GO MARK VALUE OF SYMBOL
GCMRK6: HRRZ A,-1(AR1)
CAIGE A,EVCSG
CAIGE A,BVCSG
JRST GCMRK7
HRRZ A,(A)
CAIE A,QUNBOUND
JRST GCMRK1
JRST GCMRK8
GCMRK7: LSH A,-SEGLOG
SKIPL A,GCST(A) ;SKIP IF VALUE CELL NOT A LIST CELL??
JRST GCMKND ;SUNBOUND, FOR EXAMPLE????
HRRZ A,-1(AR1) ;POINTING TO A VC IN LIST SPACE
JRST GCMRK1
GCMRK4: TLNN A,GCBVC ;MAYBE WE FOUND A VALUE CELL
JRST GCMRK5 ;NOPE
HRRZ A,(C) ;YUP - MARK ITS CDR (THE VALUE)
JRST GCMRK1
GCMRK5: MOVSI AR1,TTS<GC> ;MUST BE AN ARRAY
IORM AR1,TTSAR(C) ;SET ARRAY MARK BIT TO 1
GCMKND: CAIN AR2A,(P) ;SKIP IF ANYTHING LEFT ON STACK TO MARK
JRST (T) ;ELSE RETURN
GCMRK8: POP P,A ;GET NEXT ITEM TO MARK
GCMRK1: HRRZS C,A ;ZERO LEFT HALF OF A, ALSO SAVE IN C
SETZ B,
LSHC A,-SEGLOG ;GET PAGE NUMBER OF ITEM (OTHER BITS GO INTO B)
SKIPL A,GCST(A) ;CHECK GCST ENTRY FOR THAT PAGE
JRST GCMKND ;NOT MARKABLE - IGNORE IT
TLNE A,GCBFOO ;MAYBE IT'S A VALUE CELL OR SYMBOL OR SAR
JRST GCMRK3 ;IF SO HANDLE IT SPECIALLY
LSHC A,SEGLOG-5 ;THIS GETS ADDRESS OF BIT WORD FOR THIS ITEM
ROT B,5 ;B TELLS US WHICH BIT (40/WD)
MOVE AR1,(A) ;GET WORD OF MARK BITS
TDZN AR1,GCBT(B) ;CLEAR THE ONE PARTICULAR BIT
JRST GCMKND ;QUIT IF ITEM ALREADY MARKED
MOVEM AR1,(A) ;ELSE SAVE BACK WORD OF BITS
JUMPGE A,GCMKND .SEE GCBCDR ;JUMP UNLESS MUST MARK THROUGH (REMEMBER THE LSHC)
HRR A,(C) ;GET CDR OF ITEM
TLNN A,GCBCAR_<SEGLOG-5> ;MAYBE WE ALSO WANT TO MARK THE CAR
JRST GCMRK1 ;NO - GO MARK CDR
PUSH P,A ;YES - SAVE CDR ON STACK
HLR A,(C) ;GET CAR OF ITEM AND GO MARK IT
IFE HNKLOG, JRST GCMRK1
IFN HNKLOG,[
TLNN A,GCBHNK_<SEGLOG-5>
JRST GCMRK1 ;ORDINARY LIST CELL
PUSH P,T ;FOR HUNK, SAVE T AND AR2A SO
HRLM AR2A,(P) ; CAN CALL GCMARK RECURSIVELY
MOVEI A,(C)
LSH A,-SEGLOG
HRRZ A,ST(A) ;GET TYPEP OF HUNK
2DIF [HRL C,(A)]GCHNLN,QHUNK0 ;C NOW HAS AOBJN POINTER
MOVEI AR2A,(P) ;SET UP AR2A FOR RECURSIVE GCMARK
GCMRK2: MOVEM C,-1(P) ;SAVE AOBJN POINTER IN SLOT PUSHED FOR CDR
HLRZ A,(C)
JUMPE A,GCMK2A
JSP T,GCMRK1 ;MARK ODD HUNK SLOT
MOVE C,-1(P)
GCMK2A: HRRZ A,(C)
JUMPE A,GCMK2B
JSP T,GCMRK1 ;MARK EVEN HUNK SLOT
MOVE C,-1(P)
GCMK2B: AOBJN C,GCMRK2
POP P,T ;RESTORE T AND AR2A
HLRZ AR2A,T
SUB P,R70+1 ;FLUSH AOBJN POINTER
JRST GCMKND
GCHNLN: -1
REPEAT HNKLOG, -<2_.RPCNT> ;LH'S FOR AOBJN POINTERS
] ;END OF IFN HNKLOG
COMMENT | ONE OF THESE DAYS I'LL DEBUG THE MICROCODE FOR THIS - GLS
IFN ITS,[ IFE SEGLOG-11,[ IFLE HNKLOG-5,[
;;; MARK ROUTINE FOR USE WITH KL-10 MICROCODE
LSPGCM=:070000,,
LSPGCS=:071000,,
KLGCVC: SKIPA A,(A)
PUSH P,B
KLGCM1: LSPGCM A,KLGCM2
KLGCND: CAIN AR2A,(P)
JRST (T)
POP P,A
JRST KLGCM1
KLGCM2: JRST KLGCSY
JRST KLGCVC
JRST KLGCSA
REPEAT HNKLOG, JRST CONC KLGH,\.RPCNT+1
REPEAT 8-.+KLGCM2, .VALUE
KLGCSY: HLRZ AR1,(A)
TROE AR1,1
JRST KLGCND
HRLM AR1,(A)
PUSH P,(A)
PUSH P,(AR1)
HRRZ A,@-1(AR1)
JRST KLGCM1
KLGCSA: MOVSI AR1,TTS<GC>
IORM AR1,TTSAR(A)
JRST KLGCND
IFN HNKLOG,[
ZZZ==<1_HNKLOG>-1
REPEAT HNKLOG,[
CONC KLGH,\HNKLOG-.RPCNT,:
REPEAT 1_<HNKLOG-.RPCNT-1>,[
PUSH P,ZZZ(A)
HLRZ B,(P)
PUSH P,B
ZZZ==ZZZ-1
] ;END OF REPEAT 1_<HNKLOG-.RPCNT-1>
] ;END OF REPEAT HNKLOG
IFN ZZZ, WARN [YOU LOSE]
PUSH P,(A)
HLRZ A,(A)
JRST KLGCM1
] ;END OF IFN HNKLOG
KLGCSW: MOVNI T,3+BIGNUM ;SWEEP
KLGS1: SETZB C,AR1 ;ZERO FREELIST AND COUNT
SKIPN TT,FSSGLK+3+BIGNUM(T)
JRST KLGS1D
KLGS1A: MOVE B,GCST(TT)
LSH B,SEGLOG-5
TLZ B,-1
MOVEI A,(TT)
LSH A,SEGLOG
HRLI A,-SEGSIZ
LSPGCS A,1
LDB TT,[SEGBYT,,GCST(TT)]
JUMPN TT,KLGS1A
KLGS1D: MOVEM C,FFS+3+BIGNUM(T)
HRRM AR1,NFFS+3+BIGNUM(T)
AOJL T,KLGS1
JRST GCSW4A
]]] ;END OF IFLE HNKLOG-5, IFE SEGLOG-11, IFN ITS
| ;END OF COMMENT
GSGEN: SKIPN AR2A,GCMKL ;GENERATE TAILS OF GCMKL AND APPLY
POPJ P, ;FUN IN AR1 TO THEM
PUSH P,AR1
MOVEI AR1,GCMKL
JRST GGEN1
RTSPC2: JUMPE A,GGEN2
RTSP2A: ADD D,TT
GGEN2: HRRZ AR2A,(AR2A) ;GENERAL LOOP FOR GSGEN
MOVEI AR1,(AR2A)
HRRZ AR2A,(AR2A)
GGEN1: JUMPE AR2A,POP1J ;TAIL OF GCMKL IN AR2A,
HRRZ A,(AR2A) ;SPACE OCCUPIED IN TT,
HLRZ A,(A) ;ALIVEP IN A
MOVE TT,(A)
HLRZ A,(AR2A)
HLRZ A,ASAR(A)
JRST @(P) ;ROUTINE WILL RETURN TO GGEN2
GFSPC: PUSH FXP,AR1
PUSHJ P,CNLAC ;COUNT NUMBER OF LIVING ARRAY CELLS
POP FXP,AR1
ADD D,@VBPORG ;NOW HAS TOTAL AMOUNT FREE IN BPS [COUNTING DEAD BLOCKS]
ADD D,GAMNT ;NOW DIMINISHED BY REQUESTED AMOUNT
CAMG D,BPSH
JRST GRELAR ;IF ENOUGH SPACE, THEN RELOCATE
JRST (R)
IFN PAGING,[
GTSP5A: SETZB A,TT ;GIVE OUT NIL AND 0 IF FAIL
JUMPLE AR1,CZECHI
PUSHJ P,BPSGC
JSP R,GFSPC
SETZ AR1,
JRST GTSP1B
] ;END OF IFN PAGING
BPSGC: PUSH FXP,NOQUIT ;SAVE CURRENT STATE OF FLAG
HLLZS NOQUIT ;FORCE OFF RIGHT HALFWORD
PUSH P,[444444,,BPSGX] ;MAGIC NUMBER,,RETURN ADR
JRST AGC
BPSGX: POP FXP,NOQUIT ;RESTORE OLD SETTING OF FLAGS
POPJ P,
;;; SOME ROUTINES FOR USE WITH GSGEN
GCP8K: HLRZ A,(D)
JSP T,GCMARK
GCP8J: HRRZ D,(D) ;MARK ATOMS ON OBLIST
GCP8I: JUMPE D,GCP8A ;WHICH HAVE NON-TRIVIAL
MOVE A,D ;P-LIST STRUCTURE.
JSP T,TWAP
JRST GCP8J
JRST GCP8K
JRST GCP8J
GCP8G: JUMPE D,GCP8A ;REMOVE T.W.A.'S FROM
MOVE A,D ;BUCKETS OF OBLIST.
JSP T,TWAP
JRST GCP8B
JRST GCP8B
HRRZ D,(D)
TLNE R,400000 ;BUCKET COMES FROM LH OF WORD IN OBARRAY
HRLM D,(F) ;IF AT THIS POINT R < 0
TLNN R,400000
HRRM D,(F)
JSP T,GCP8L
JRST GCP8G
GCP8C: HRRZ D,(D)
GCP8B: HRRZ A,(D)
GCP8D: JUMPE A,GCP8A
JSP T,TWAP
JRST GCP8C
JRST GCP8C
HRRZ A,(D)
HRRZ A,(A)
HRRM A,(D)
JSP T,GCP8L
JRST GCP8B
GCP8H: MOVE A,D ;MARK OBLIST BUCKET
JSP T,GCMARK
JRST GCP8A
GCP8L: JUMPE TT,(T) ;IF SCO REMOB'D, THEN REMOVE FROM SCO TABLE
HRRZ A,(TT)
JUMPN A,(T)
HLRZ A,(TT)
MOVE B,(A) ;MUST NOT BE INTERRUPTIBLE HERE
MOVEI A,0
LSHC A,7
JUMPN B,(T)
HRRZ TT,VOBARRAY
HRRZ TT,TTSAR(TT)
ADDI TT,<OBTSIZ+1>/2
ROT A,-1
ADD TT,A
JUMPL TT,GCP8L5
HRRZS (TT)
JRST (T)
GCP8L5: HLLZS (TT)
JRST (T)
TWAP: HLRZ A,(A)
JUMPE A,(T) ;NIL IS ALREADY MARKED
HLRZ TT,(A)
TRZE TT,1
JRST (T) ;NO SKIP IF ALREADY MARKED
MOVE B,SYMVC(TT)
MOVE TT,SYMARGS(TT)
TLNN B,SY.CCN\SY.PUR ;SKIP 1 IF SYMBOL HAS SOME NON-TRIVIAL
TLZE TT,-1 ;PROPERTIES: ARGS OR COMPILED CODE REFERENCE
JRST 1(T)
HRRZ B,(B)
HRRZ A,(A)
CAIN B,QUNBOUND
JUMPE A,2(T) ;SKIP 2 IF TRULY WORTHLESS SYMBOL,
; I.E., UNBOUND AND NO PROPERITES
JRST 1(T) ;SKIP 1 IF MEANINGFUL PROPERTIES OR VALUE
;;; PRINT MESSAGE OF FORM "NNN[MM%] " FOR GC STATISTICS OUTPUT
STGPNT: PUSH FXP,F ;NEED TO SAVE F (IN CASE OF IFORCE)
PUSH FXP,T ;RECLAIMED AMNT IN T, TOTAL FOR SPACE IN TT
IMULI T,100.
IDIVM T,TT
EXCH TT,(FXP)
HRRZ AR1,VMSGFILES
TLO AR1,200000
MOVEI R,$TYO
IFE USELESS, MOVE C,@VBASE ;BASE HAD DAMNED WELL BETTER BE A FIXNUM
IFN USELESS,[
HRRZ C,VBASE
CAIE C,QROMAN
SKIPA C,(C)
PUSHJ P,PROMAN ;SKIPS
] ;END OF IFN USELESS
PUSHJ P,PRINI2
STRT 17,[SIXBIT \[!\] ;BEWARE THESE BRACKETS!!!!!
POP FXP,TT
IFE USELESS, MOVEI C,10.
IFN USELESS,[
HRRZ C,VBASE
CAIE C,QROMAN
SKIPA C,[10.]
PUSHJ P,PROMAN
] ;END OF IFN USELESS
PUSHJ P,PRINI3 ;EFFECTIVELY, PRINI2 WITH *NOPOINT=T
STRT 17,[SIXBIT \%] !\] ;BEWARE THESE BRACKETS!!!!!
POP FXP,F
POPJ P,
;;; VERY IMPORTANT TABLE OF WORDS WITH SINGLE BITS!!! USED FOR MARKING!!!
GCBT: REPEAT 36., SETZ_-.RPCNT
IFN PAGING,[
SUBTTL RETURN CORE TO TIMESHARING SYSTEM
;;; HAIRY ROUTINE TO DECIDE WHETHER TO RETURN SOME BPS TO THE SYSTEM.
;;; MAY ONLY BE CALLED WHEN NOQUIT SPECIFIES NO INTERRUPTS.
RETSP:
10$ POPJ P, ;NOOP ON D10'S RUNNING PAGING LISP
IFE D10,[
MOVEI TT,4 ;GTSPC1 IS ALLOWED TO GRAB 4 PAGES
MOVEM TT,ARPGCT ; BEFORE INVOKING GC FOR LACK OF CORE
PUSHJ P,CNLAC ;COUNT NUMBER OF LIVING ARRAY CELLS
MOVE TT,BPSH
LSH TT,-PAGLOG ;CURRENT HIGHEST CORE BLOCK IN BPS
MOVE R,@VBPORG
ADDI R,1(D)
LSH R,-PAGLOG ;CORE NEEDED IF ARRAYS WERE PACKED
CAML R,TT
POPJ P,
LSH R,PAGLOG
ADDI R,PAGSIZ-1
HRLM R,RTSP1 ;NEW BPSH
SUB R,D
HRRM R,RTSP3 ;NEW BPEND
JUMPE D,RTSP5
HRLM D,RTSP3 ;NUMBER OF CELLS TO MOVE
PUSHJ P,GRELAR ;GRELAR LEAVES BPEND-AFTER-RELOCATION IN TT
HRL AR1,TT
HRR AR1,RTSP3 ;BLOCK PTR
SUBI TT,(AR1)
JUMPLE TT,RTSP2
MOVNI TT,1(TT)
HRRM TT,RTSP1
ADD AR1,R70+1
HLRZ C,RTSP3
ADD C,RTSP3
BLT AR1,(C)
MOVEI AR1,RTSPC1
PUSHJ P,GSGEN ;DO PATCH-UP ON ARRAY PARAMETERS
JSP T,RSXST ;????
RTSP2: HLRZ TT,RTSP1
MOVE R,TT
EXCH R,BPSH
HRRZ D,RTSP3
MOVEM D,@VBPEND
LSH R,-PAGLOG ;OLD CORE HIGHEST
LSH TT,-PAGLOG ;NEW CORE HIGHEST
MOVEI F,1(TT) ;MAKE UP A POINTER INTO THE PURTBL
ROT F,-4
ADDI F,(F)
ROT F,-1
TLC F,770000
ADD F,[450200,,PURTBL]
IT$ SUBM TT,R ;FOR ITS, MINUS THE NUMBER OF PAGES TO HACK
20$ SUBI R,(TT) ;FOR D20, THE POSITIVE NUMBER OF PAGES TO HACK
AOS D,TT
IFN ITS,[
HRLI TT,(R) ;-<NUMBER OF PAGES>,,<INITIAL PAGE NUMBER>
.CALL RTSP9 ;FLUSH THE PAGES
.LOSE 1000
] ;END OF IFN ITS
IFN D20,[
SETO 1, ;-1 MEANS DELETE PAGES
MOVSI 2,.FHSLF ;FROM SELF
HRRI 2,(TT) ;INITIAL PAGE NUMBER
MOVEI 3,(R) ;NUMBER OF PAGES
TLO 3,PM%CNT ;SET ITERATION BIT
PMAP
] ;END OF IFN D20
LSH D,-SEGLOG+PAGLOG
MOVE T,[$NXM,,QRANDOM] ;STANDARD ST ENTRY FOR A FLUSHED PAGE
RTSP7: TLNN F,730000
TLZ F,770000
IDPB NIL,F ;UPDATE PURTBL ENTRY FOR ONE PAGE
REPEAT SGS%PG, MOVEM T,ST+.RPCNT(D) ;UPDATE ST ENTRIES
ADDI D,SGS%PG
IT$ AOJL R,RTSP7
20$ SOJG R,RTSP7
POPJ P,
IFN ITS,[
RTSP9: SETZ
SIXBIT \CORBLK\ ;HACK PAGE MAP
1000,,0 ;DELETE PAGES
1000,,%JSELF ;FROM CURRENT JOB
400000,,TT ;AOBJN POINTER: -<COUNT>,,<PAGE NUMBER>
] ;END OF IFN ITS
RTSP5: SETZM GCMKL ;NO ARRAYS ALIVE
MOVE TT,R
PUSHJ P,BPNDST ;SETQ UP BPEND
JRST RTSP2
RTSPC1: JUMPE A,GGEN2
HRRE B,RTSP1 ;-<SIZE OF SHIFT + 1>
JSP AR1,GT3D
JRST GGEN2
] ;END IFE D10
] ;END OF IFN PAGING
SUBTTL GET SPACE FROM TIMESHARING SYSTEM
GTSPC1: HLLOS NOQUIT
JSP R,GFSPC ;SEE IF FREE SPACE ABOVE BPEND WILL ADD ENOUGH
IFN PAGING,[
SKIPLE AR1,ARPGCT
JRST GTSP1B
] ;END OF IFN PAGING
PUSHJ P,BPSGC ;WHEN COMPACTIFIED AND RELOCATED
JSP R,GFSPC ;IF NOT, GC AND TRY AGAIN
GTSP1B:
IFE PAGING,[
SETZB A,TT ;GIVE OUT NIL AND 0 IF WE FAIL
JRST CZECHI
] ;END OF IFE PAGING
IFN PAGING,[
CAML D,HINXM
JRST GTSP5A
MOVEI T,(D)
TRO T,PAGSIZ-1
MOVE R,BPSH
LSH D,-PAGLOG
LSH R,-PAGLOG
SUBM R,D ;NEGATIVE OF NUMBER OF PAGES TO GET
ADDM F,ARPGCT
MOVEI F,1(R) ;SET UP BYTE POINTER INTO PURTBL
ROT F,-4
ADDI F,(F)
ROT F,-1
TLC F,770000
ADD F,[450200,,PURTBL]
MOVEI TT,1(R)
LSH TT,-SEGLOG+PAGLOG
HLRZ AR1,(P) ;BEWARE! LH OF CALLING PDL SLOT = -1
TRNN AR1,1 ; MEANS THE GETSP FUNCTION IS CALLING
TROA AR1,3
MOVEI AR1,1
IFN ITS,[
HRLI R,(D)
HRRI R,1(R)
.CALL GTSPC8
.LOSE 1000
] ;END OF IFN ITS
IFN D20,[
PUSH P,D ;SAVE NEGATIVE COUNT
PUSH P,R ;AND SAVE CURRENT PAGE NUMBER
GTSPC8: AOS R,(P) ;GET NEXT PAGE NUMBER
LSH R,PAGLOG ;TURN INTO POINTER TO PAGE
SETMM (R) ;CREATE THE PAGE
MOVSI 1,.FHSLF ;OUR PROCESS
HRR 1,(P) ;CURRENT PAGE NUMBER
MOVSI 2,(PA%RD\PA%WT\PA%EX) ;READ, WRITE, EXECUTE
SPACS ;SET THEPAGE ACCESS
AOJL D,GTSPC8
POP P,R
POP P,D
] ;END OF IFN D20
MOVE A,[$XM,,QRANDOM]
GTSPC2: TLNN F,730000
TLZ F,770000
IDPB AR1,F ;UPDATE PURTBL ENTRY
REPEAT SGS%PG, MOVEM A,ST+.RPCNT(TT) ;UPDATE ST ENTRIES
ADDI TT,SGS%PG
AOJL D,GTSPC2
MOVEM T,BPSH ;FALLS INTO GRELAR
] ;END OF IFN PAGING
GRELAR: HLLOS NOQUIT ;MOBY DELAYED QUIT FEATURE.
HRRZ A,BPSH ;LEAVE BPEND-AFTER-RELOCATION AS RESULT
MOVEM A,GSBPN ;TEMPORARY BPEND
MOVEI AR1,GTSPC3
PUSHJ P,GSGEN ;RELOCATE ARRAYS
JSP T,RSXST
GREL1: MOVE TT,GSBPN
PUSHJ P,BPNDST
MOVE TT,(A)
CZECHI: HLLZS NOQUIT
JRST CHECKI ;CHECK FOR ^G THEN POPJ P,
IFN ITS,[
GTSPC8: SETZ
SIXBIT \CORBLK\ ;HACK PAGE MAP
1000,,%CBNDR+%CBNDW ;NEED READ AND WRITE ACCESS
1000,,%JSELF ;FOR MYSELF
,,R ;AOBJN POINTER: -<COUNT>,,<PAGE NUMBER>
401000,,%JSNEW ;WANT FRESH PAGES
] ;END OF IFN ITS
SUBTTL ARRAY RELOCATOR
CNLAC: MOVEI D,0 ;COUNT NUMBER OF LIVING ARRAY CELLS, IN D
MOVEI AR1,RTSPC2
JRST GSGEN
BPNDST: JSP T,FIX1A ;STORE NEW VALUE FOR BPEND
MOVEM A,VBPEND
POPJ P,
;;; COMES HERE FROM GRELAR VIA GSGEN. AR2A HAS TAIL OF GCMKL, TT HAS TOTAL LENGTH OF ARRAY
GTSPC3: JUMPE A,GT3G ;RELOCATE AN ARRAY
MOVEI AR1,-1(TT) ;LENGTH-1 OF ARRAY IN AR1
HLRZ F,(AR2A)
HRRZ A,ASAR(F)
SUBI A,1 ;ARRAY AOBJN PTR LOC IN A.
MOVE C,GSBPN
SUBI C,(AR1)
MOVEM C,GSBPN ;LOC NEW BPTR IN C
MOVEI B,(C)
SUBI B,1(A) ;RELOCATION AMOUNT-1 IN B
CAML A,C ;IS ARRAY ALREADY IN PLACE?
JRST GT3C ;YES, SO EXIT
IFN D10,[
MOVE R,ASAR(F)
MOVE F,TTSAR(F)
TLNN R,AS.FIL ;IF THE ARRAY IS A FILE OBJECT,
JRST GT3H ; IS NOT CLOSED, AND HAS BUFFERS,
TLNN F,TTS.CL ; THEN WE MUST LET THE I/O COMPLETE
SKIPGE F.MODE(F) .SEE FBT.CM
JRST GT3H
IFE SAIL,[
TLNN F,TTS.IO ;OUTPUT?
JRST GT3Z ;NOPE, JUST WAIT
MOVE T,F.CHAN(F) ;GET CHANNEL NUMBER
LSH T,27
TLO T,(OUTPUT) ;FLUSH ALL OUTPUT BUFFERS
XCT T
] ;END IFE SAIL
GT3Z: MOVE F,F.CHAN(F)
LSH F,27
IOR F,[WAIT 0,] ;WAIT FOR THE I/O TO SETTLE DOWN
XCT F ; SO WE CAN RELOCATE THE BUFFERS
GT3H:
] ;END OF IFN D10
SUBI C,(AR1)
CAMGE A,C ;BEWARE: C COULD GO NEGATIVE!
JRST GT3A ;GOOD, EASY BLT
ADDI C,(AR1)
ADDI AR1,1(A) ;FIRST DESTINATION LOC
GT3B: HRRZI C,(AR1)
SUBI AR1,1(B) ;CONSTRUCT SOURCE ADDRESS
HRLI C,(AR1)
HRRZI T,(C)
ADDI T,(B)
BLT C,(T) ;SERIES OF SMALL BLTS
CAMLE AR1,GSBPN
JRST GT3B
ADDI AR1,(B)
SUB AR1,GSBPN
MOVE A,GSBPN
SUBI A,1(B)
GT3A: MOVE C,GSBPN
ADDI AR1,(C)
HRL C,A
BLT C,(AR1) ;FINAL (OR ONLY) BLT
JSP AR1,GT3D
GT3C: SOS GSBPN
JRST GGEN2
GT3D: ADDI B,1
HLRZ A,(AR2A)
ADDM B,ASAR(A) ;UPDATE ARRAY POINTERS BY OFFSET IN B
ADDM B,TTSAR(A)
MOVE C,ASAR(A)
ADDM B,-1(C) ;UPDATE AOBJN PTR BEFORE ARRAY HEADER
HRR C,TTSAR(A) ;FOR A BUFFERED FILE OBJECT, WE MUST
TLNE C,AS.FIL ; RELOCATE CERTAIN ADDRESSES IN THE ARRAY DATA
SKIPGE F.MODE(C) .SEE FBT.CM
JRST (AR1)
MOVE C,TTSAR(A)
IFN ITS+D20,[
ADDM B,FB.IBP(C)
ADDM B,FB.BP(C)
JRST (AR1)
] ;END OF ITS+D20
IFN D10,[
TLNE C,TTS.CL ;DON'T HACK WITH CLOSED FILE OBJECTS
JRST (AR1)
MOVE F,FB.HED(C)
ADDM B,(F) ;UPDATE CURRENT BUFFER ADDRESS
ADDM B,1(F) ;UPDATE BYTE POINTER
HRRZ F,(F)
MOVE R,F
GT3D2: ADDM B,(R) ;UPDATE BUFFER RING POINTERS
HRRZ R,(R)
CAIE R,(F) ;DONE WHEN WE HAVE GONE AROUND THE RING
JRST GT3D2
IFN SAIL,[
MOVE R,F.CHAN(C) ;GET CHANNEL NUMBER
LSH R,27
HRR R,FB.HED(C) ;POINTER TO BUFFER HEADER
HRR R,(R) ;GET CURRENT ADDR OF BUFFER
TLNN C,TTS.IO ;DO APPROPRIATE UUO TO MOVE BUFFER
TLOA R,(INPUT)
TLO R,(OUTPUT)
XCT R
JRST (AR1)
] ;END OF IFN SAIL
IFE SAIL,[
TLNN C,TTS.IO
JRST GT3D4
MOVE R,F.CHAN(C) ;GET CHANNEL NUMBER
LSH R,27 ;FOR OUTPUT BUFFERS
HRR R,FB.HED(C) ;GET CURRENT ADR OF BUFFER
HRR R,(R)
TLO R,(OUTPUT) ;DO APPROPRIATE UUO TO MOVE BUFFER
XCT R
JRST (AR1)
GT3D4: MOVSI R,TTS.BM
IORM R,TTSAR(A)
JRST (AR1)
] ;END OF IFE SAIL
] ;END OF IFN D10
GT3G: HRRZ AR2A,(AR2A)
HRRZ AR2A,(AR2A)
HRRM AR2A,(AR1) ;CUT OUT DEAD BLOCK
JRST GGEN1
PGTOP GC,[GARBAGE COLLECTOR]
;;; ********** MEMORY MANAGEMENT, ETC **********
SUBTTL PURCOPY FUNCTION
PGBOT BIB
PURCOPY:
PUSHJ FXP,SAV5M2
PUSH P,[RST5M2]
PUSH FXP,CCPOPJ
PUSHJ P,SAVX5
PUSH P,[RSTX5]
MOVEI TT,(A) ;USES A,B,T,TT
LSH TT,-SEGLOG
MOVE TT,ST(TT)
TLNE TT,PUR
POPJ P,
2DIF JRST (TT),PCOPY9,QLIST .SEE STDISP
PCOPY9: JRST PCOPLS ;LIST
JRST PCOPFX ;FIXNUM
JRST PCOPFL ;FLONUM
DB$ JRST PCOPDB ;DOUBLE
CX$ JRST PCOPCX ;COMPLEX
DX$ JRST PCOPDX ;DUPLEX
BG$ JRST PCOPBN ;BIGNUM
JRST PCOPSY ;SYMBOL
HN$ REPEAT HNKLOG+1, JRST PCOPHN ;HUNKS
POPJ P, ;RANDOM
JRST PCOPAR ;ARRAY
IFN .-PCOPY9-NTYPES, WARN [WRONG LENGTH TABLE]
PCOPAR: MOVSI TT,TTS.CN
IORM TT,TTSAR(A) ;SET "COMPILED CODE NEEDS ME" BIT
POPJ P,
PCOPLS: SKIPE R,VPURCOPY
JSP T,PURMMQ
HLRZ B,(A) ;PURCOPY A LIST ALREADY
PUSH P,B
HRRZ A,(A)
SKIPE A ;NEVER PURCOPY NIL
PUSHJ P,PURCOPY
EXCH A,(P)
SKIPE A ;NEVER PURCOPY NIL
PUSHJ P,PURCOPY
POP P,B
PCONS: AOSL TT,NPFFS ;PURE FS CONSER
SPECPRO INTPPC
PUSHJ P,GTNPSG ;NOTE: CLOBBERS TT
ADD TT,EPFFS
NOPRO
HRLM A,(TT)
HRRM B,(TT)
MOVEI A,(TT)
POPJ P,
PURMMQ: HLRZ D,(R) ;"POPJ P," IF ITEM IS ON "PURCOPY" LIST
CAIN A,(D)
POPJ P,
HRRZ R,(R)
JUMPN R,PURMMQ
JRST (T)
PCOPFX: MOVE TT,(A)
PFXCONS: CAIGE TT,XHINUM ;PURE FIXNUM CONSER
CAMGE TT,[-XLONUM]
JRST PFXC1
MOVEI A,IN0(TT)
POPJ P, ;NOTE: EXITS WITH POPJ P,!!!
PFXC1: AOSL A,NPFFX
SPECPRO INTPPC
PUSHJ P,GTNPSG
ADD A,EPFFX
NOPRO
PFXC3: MOVEM TT,(A)
POPJ P,
PCOPFL: MOVE TT,(A)
PFLCONS: AOSL A,NPFFL ;PURE FLONUM CONSER
SPECPRO INTPPC
PUSHJ P,GTNPSG
ADD A,EPFFL
NOPRO
JRST PFXC3 ;ALSO EXITS WITH POPJ P,!!!
IFN CXFLAG,[
PCOPCX:
KA MOVE D,1(A)
KA MOVE TT,(A)
KIKL DMOVE TT,(A)
PCXCONS: AOSL A,NPFFC
SPECPRO INTPPC
PUSHJ P,GTNPSG
XCTPRO
MOVEI T,1(A)
MOVEM T,NPFFC
ADD A,EPFFC
NOPRO
DB% JRST PDBC3 ;WILL DROP IN IF NO DOUBLES
] ;END OF IFN CXFLAG
IFN DBFLAG,[
PCOPDB:
KA MOVE D,1(A)
KA MOVE TT,(A)
KIKL DMOVE TT,(A)
PDBCONS: AOSL A,NPFFD
SPECPRO INTPPC
PUSHJ P,GTNPSG
XCTPRO
MOVEI T,1(A)
MOVEM T,NPFFD
ADD A,EPFFD
NOPRO
] ;END OF IFN DBFLAG
IFN DBFLAG+CXFLAG,[
PDBC3:
KA MOVEM D,1(A)
KA JRST PFXC3
KIKL DMOVEM TT,(A)
KIKL POPJ P,
] ;END OF IFN DBFLAG+CXFLAG
IFN DXFLAG,[
PCOPDX:
KA REPEAT 4, MOVE TT+<2#.RPCNT>,.RPCNT
KIKL DMOVE R,(A)
KIKL DMOVE TT,2(A)
PDXCONS: AOSL A,NPFFZ
SPECPRO INTPPC
PUSHJ P,GTNPSG
XCTPRO
MOVEI T,3(A)
MOVEM T,NPFFZ
ADD A,EPFFZ
NOPRO
KA REPEAT 4, MOVEM TT+<2#.RPCNT>,.RPCNT
KIKL DMOVEM R,(A)
KIKL DMOVEM TT,2(A)
POPJ P,
] ;END OF IFN DBFLAG
IFN BIGNUM,[
PCOPBN: PUSH P,(A)
HRRZ A,(A)
PUSHJ P,PURCOPY
HLL A,(P)
SUB P,R70+1
PBNCONS: AOSL TT,NPFFB ;PURE BIGNUM CONSER
SPECPRO INTPPC
PUSHJ P,GTNPSG
ADD TT,EPFFB
NOPRO
MOVEM A,(TT)
MOVEI A,(TT)
POPJ P,
] ;END OF IFN BIGNUM
PCOPSY: PUSH P,A ;SAVE POINTER TO SYMBOL
HLRZ B,(A) ;FETCH POINTER TO SYMBOL BLOCK
MOVE TT,SYMVC(B)
TLNE TT,SY.PUR ;IF ALREADY PURE IGNORE COMPLETELY
JRST PCOPS1
PUSH P,B ;SAVE SYMVC ADR
HRRZ A,SYMPNAME(B)
PUSHJ P,PURCOPY ;PURCOPY THE PNAME
PUSHJ P,PSYCONS ;GET A PURE SY2 BLOCK
POP P,B ;RESTORE SYMVC ADR
HLRZ A,(A) ;GET POINTER TO PURE SY2
HRRZ TT,SYMVC(B) ;GET THE VALUE CELL
HRRM TT,SYMVC(A) ;COPY INTO NEW PURE SY2
HLLZ TT,SYMARGS(B) ;ALSO COPY THE ARGS PROPERTY
HLLM TT,SYMARGS(A)
XCTPRO
HLRZ B,@(P) ;GET POINTER TO OLD SY2
EXCH B,FFY2 ;THIS IS NEW HEAD OF FREELIST, GET OLD HEAD
MOVEM B,@FFY2 ;PLACE CHAIN IN NEWLY FREED CELL
NOPRO
HRLM A,@(P) ;STORE POINTER TO NEW SY2 BLOCK
PCOPS1: LOCKI
HRRZ A,(P) ;GET POINTER TO SYMBOL
PUSHJ P,SYMHSH ;GET HASH VALUE
IDIVI T,OBTSIZ ;MAKE POINTER INTO OBARRAY
PUSH FXP,TT
MOVEI A,(FXP)
MOVE T,VOBARRAY
PUSHJ P,@ASAR(T) ;BUCKET ADR
MOVEI B,(A)
HRRZ A,(P)
PUSHJ P,MEMQ1 ;FIND ACTUAL ATOM
POP FXP,D
JUMPN A,PCOPS3 ;IF IN OBARRAY NO NEED TO GCPROTECT
MOVEI T,1 ;GCPROTECT
HRRZ A,(P)
PUSHJ P,.GCPRO
PCOPS3: UNLOCKI ;CLEANUP AND GO HOME
JRST POPAJ
IFN HNKLOG,[
PCOPHN: SKIPN VHUNKP ;TREAT HUNKS AS LISTS IF HUNKP IS NIL
JRST PCOPLS
SKIPE R,VPURCOPY
JSP T,PURMMQ
PUSH P,A
PUSH FXP,TT
PUSHJ P,USRHNP ;Is this a user's extended object?
POP FXP,TT
JUMPE T,PCOPH5
PUSH P,[QPURCOPY]
MOVNI T,2
XCT SENDI ; Does a JCALL
PCOPH5: POP P,A
PCOPH2:
2DIF [HRRZ B,(TT)]GCWORN,QLIST
PUSH P,B .SEE INTXCT ;CAN'T USE FXP
2DIF [AOSL B,(TT)]NPFFS,QLIST ;THIS WORD SERVES AS ARG TO GTNPSG
SPECPRO INTPPC
PUSHJ P,GTNPSG
XCTPRO
MOVE D,B
ADD D,(P)
SOS D ;SINCE ALREADY AOS'ED ONCE
2DIF [MOVEM D,(TT)]NPFFS,QLIST
NOPRO
2DIF [ADD B,(TT)]EPFFS,QLIST ;B NOW HAS ADDRESS OF FRESH PURE HUNK
PUSH P,A
PUSH P,B
MOVE D,-2(P)
PCOPH3: ADD D,-1(P) ;WE SCAN THE OLD HUNK FROM THE END BACKWARDS
HLRZ B,-1(D) ;GOBBLE A CAR AND A CDR
HRRZ A,-1(D)
PUSH P,B
PUSHJ P,PURCOPY ;PURCOPY THE CDR
EXCH A,(P)
PUSHJ P,PURCOPY ;PURCOPY THE CAR
HRLM A,(P)
MOVE D,-1(P) ;CALCULATE PLACE IN NEW HUNK
ADD D,-3(P)
POP P,-1(D) ;POP COPIED CAR/CDR PAIR INTO PURE HUNK
SOSE D,-2(P)
JRST PCOPH3
POP P,A ;RETURN NEW HUNK
SUB P,R70+2
POPJ P,
] ;END OF IFN HNKLOG
IFN PAGING,[
SUBTTL GETCOR
;;; THIS ROUTINE IS SPECIFICALLY FOR PEOPLE WHO HAND-CODE LAP.
;;; IT IS USED TO ALLOCATE A NUMBER OF CONSECUTIVE PAGES
;;; OF MEMORY FOR VARIOUS PURPOSES, E.G. HACKING OF PDP-11'S
;;; OR INFERIOR JOBS OR WHATEVER.
;;; THE NUMBER OF PAGES DESIRED SHOULD BE IN TT; THE LOW ADDRESS
;;; OF THE PAGES IS RETURNED IN TT, OR ZERO FOR FAILURE.
;;; THIS ROUTINE DOES NOT ACTUALLY GET CORE; IT MERELY RESERVES
;;; ADDRESS SPACE.
;;; THERE IS CURRENTLY NO PROVISION FOR RETURNING THE MEMORY GRABBED.
GETCOR: HLLOS NOQUIT
LSH TT,PAGLOG
MOVE T,HINXM
SUBI T,(TT)
CAMGE T,BPSH
JRST GTCOR6
20$ PUSH P,B
MOVEI F,(TT) ;GETTING F THIS WAY FLUSHES
LSH F,-PAGLOG ; RANDOM BITS. (IT'S SAFER.)
GTCOR4:
PUSHJ P,ALIMPG
.VALUE ;HOW CAN WE LOSE HERE?
SOJG F,GTCOR4
20$ POP P,B
SKIPA TT,HINXM
GTCOR6: TDZA TT,TT ;LOSE, LOSE, LOSE
ADDI TT,1
JRST CZECHI
LHVB0: WTA [BAD SIZE - LH^<!] ;^< = |
LHVBAR: CAIL B,QLIST ;SUBR 2
CAILE B,QARRAY ;GROSS KLUDGE FOR LH
JRST LHVB1
JSP T,FXNV1
TLNE TT,-1
JRST LHVB0
ADDI TT,PAGSIZ-1
IDIVI TT,PAGSIZ
MOVNI AR2A,(TT)
PUSHJ P,GETCOR
JUMPE TT,FIX1
CAIE B,QARRAY
CAIN B,QRANDOM
XORI B,QARRAY#QRANDOM ;GROSS KLUDGE
MOVEI D,(TT)
LSH D,-SEGLOG
IMULI AR2A,SGS%PG
HRLI D,(AR2A)
2DIF [MOVE R,(B)]GCWORS,QLIST
LHVB3: MOVEM R,ST(D)
SETZM GCST(D)
TLNN R,$FS+BN+HNK
JRST LHVB4
MOVE T,LHSGLK
DPB T,[SEGBYT,,GCST(D)]
HRRZM D,LHSGLK
LHVB4: AOBJN D,LHVB3
JRST FIX1
LHVB1: EXCH A,B
WTA [BAD SPACE - LH^<!] ;^< = |
EXCH A,B
JRST LHVBAR
;;; IFN PAGING
SUBTTL PDL OVERFLOW HANDLER
;;; CALL BY JSR PDLSTH
;;; F HAS THE ADDRESS OF THE AC HOLDING THE PDL POINTER.
;;; D HAS AN ADDRESS WITHIN THE PAGE TO GET.
;;; R MAY BE USED AS SCRATCH.
;PDLSTH: 0 ;HACK ST FOR ADDING PDL PAGES
PDLST0:
LSH D,-PAGLOG
IFN ITS,[
.CALL PDLST8
.LOSE 1000
] ;END OF IFN ITS
IFN D20,[
MOVEM A,PDLSTA ;SAVE AWAY AC'S SO CAN DO A JSYS
MOVEM B,PDLSTB
MOVEM C,PDLSTC
MOVEI 1,.FHSLF ;DISABLE INTERRUPT FOR OURSELVES
MOVE 2,[<1_<35.-.ICNXP>>] ;WE CAN'T HANDLE THE NXP TRAP THIS WILL CAUSE
DIC
MOVEI 1,(D) ;PAGE NUMBER
LSH 1,PAGLOG ;MAKE AN ADDRESS
SETMM (1) ;CREATE THE PAGE
MOVSI 1,.FHSLF ;CHANGE ACCESS FOR OUR PROCESS
HRRI 1,(D) ;THE PAGE WE JUST CREATED
MOVSI 2,(PA%RD\PA%WT\PA%EX)
SPACS
MOVEI 1,.FHSLF ;REEANBLE NXP TRAPS
MOVE 2,[<1_<35.-.ICNXP>>]
AIC
MOVE C,PDLSTC ;RESTORE AC'S
MOVE B,PDLSTB
MOVE A,PDLSTA
] ;END OF IFN D20
MOVEI R,(D) ;CALCULATE PURTBL BYTE POINTER
ROT R,-4
ADDI R,(R)
ROT R,-1
TLC R,770000
ADD R,[430200,,PURTBL]
MOVSS D
HRRI D,3
DPB D,R ;UPDATE PURTBL
LSH D,-22+PAGLOG-SEGLOG ;HORRIBLE HACKERY TO UPDATE ST
ADD D,[-<SGS%PG+1>,,ST-1] ; WITHOUT AN EXTRA AC:
REPEAT SGS%PG, PUSH D,PDLST9-P(F) ; USE PUSHES! (CAN'T OVERFLOW)
JRST @PDLSTH
IFN ITS,[
PDLST8: SETZ
SIXBIT \CORBLK\ ;HACK PAGE MAP
1000,,%CBNDR+%CBNDW ;GET READ AND WRITE ACCESS
1000,,%JSELF ;FOR MYSELF
,,D ;PAGE NUMBER
401000,,%JSNEW ;GET FRESH PAGE
] ;END OF IFN ITS
;;; IFN PAGING
;;; HAIRY PDL OVERFLOW HANDLER
PDLOV: MOVE F,INTPDL
MOVEM D,IPSWD2(F) ;SAVE D
MOVEM R,IPSWD1(F) ;SAVE R
SKIPL INTPDL
.VALUE ;I WANT TO SEE THIS! - GLS
MOVEI F,P ;ALL RIGHT THEN, LET'S PLAY
JUMPGE P,PDLH0A ; TWENTY QUESTIONS - IS IT REGPDL?
MOVEI F,SP
JUMPGE SP,PDLH0A ;SPECPDL?
MOVEI F,FXP
JUMPGE FXP,PDLH0A ;FXP?
MOVEI F,FLP ;IF NOT FLP, THEN IT'S PRETTY RANDOM
JUMPGE FLP,PDLH0A
HLRZ R,NOQUIT
JUMPN R,PDLH3A
LERR [SIXBIT \RANDOM PDL OVERFLOW!\]
PDLH0A: HRRZ R,(F) ;FETCH RIGHT HALF OF PDL POINTER
MOVEI D,(R)
CAML R,OC2-P(F) ;IF WE'RE OVER THE ORIGIN OF THE
JRST PDLH5 ; OVERFLOW PDL, THEN ERROR OUT
HLRZ R,F
ADDI R,11(D) ;HERE IS A HACK TO PAGIFY
IORI R,PAGSIZ-1 ; UPWARDS, BUT KEEP WELL AWAY
SUBI R,10 ; FROM THE PAGE BOUNDARY
CAML R,OC2-P(F) ;IF WE'RE ABOVE THE OVERFLOW PDL,
MOVE R,OC2-P(F) ; ONLY INCREASE TO THAT PLACE
CAMGE D,ZPDL-P(F) ;SKIP IF WE'RE ABOVE PDLMAX
JRST PDLH2 ; PARAMETER FOR THIS PDL
TLO F,-1 ;SET FLAG TO INDICATE THIS FACT
MOVE D,MORPDL-P(F) ;PUSH UP THE PDLMAX
ADD D,ZPDL-P(F) ; "SOME MORE"
ANDI D,777760 ;BUT KEEP AWAY FROM PAGE
TRNN D,PAGKSM ; BOUNDARY (PICKY, PICKY!)
SUBI D,20
MOVEM D,ZPDL-P(F)
HRRZ D,(F)
JRST PDLH2A
PDLH2: TLZE F,-1
JRST PDLH2B
CAMLE R,ZPDL-P(F) ;IF OUR GUESS WOULD PUT US OVER
PDLH2A: MOVE R,ZPDL-P(F) ; PDLMAX, GO ONLY AS FAR AS THAT
PDLH2B: SUBI D,(R) ;CALCULATE NEW LEFT HALF FOR PDL PTR
HRLM D,(F) ;CLOBBER INTO PDL PTR
HRRZ D,(F) ;FIGURE OUT IF WE NEED TOP GET
ADDI R,10 ; MORE CORE FOR ALL THIS
ANDI R,PAGMSK
EXCH R,D
CAIG R,(D) ;SKIP IF WE CROSSED NO PAGE BOUNDARY
JSR PDLSTH ;ELSE MUST GET NEW PAGE AND UPDATE ST
TLZN F,-1 ;SKIP IF WE WERE ABOVE PDLMAX
JRST PDLH3A
MOVSI D,QREGPDL-P(F)
HRRI D,1005 ;PDL-OVERFLOW
HRRZ R,INTPDL
HRRZ R,IPSPC(R)
CAIL R,UINT0 ;AVOID DEEP INTERRUPT RECURSION:
CAILE R,EUINT0 ; IF PDL OVERFLOWED WITHIN UINT0,
JRST PDLH4 ; THEN JUST STACK UP THE INTERRUPT,
JSR UISTAK ; AND SOMEONE WILL EVENTUALLY TRY CHECKI
PDLH3A: HRRZ F,INTPDL
JRST INTXT2
PDLH4: MOVE R,FXP ;ELSE TRY TO GIVE A PDL OVERFLOW
SKIPE GCFXP ; USER INTERRUPT IMMEDIATELY
MOVE FXP,GCFXP ;REMEMBER, PDL OVERFLOW IS NOT
PUSH FXP,R ; DISABLED INSIDE THE PDL
PUSHJ FXP,$IWAIT ; OVERFLOW HANDLER!!!
JRST XUINT
JRST INTXIT
;;; IFN PAGING
MORPDL: 400 ;AMOUNTS TO INCREMENT PDLS BY
100 ; WHEN OVERFLOW OCCURS (THIS GIVES
LSWS+100 ; LOSER A CHANCE TO SSTATUS PDLMAX,
200 ; AT LEAST)
PDLMSG: POVPDL ;REG
POVFLP ;FLONUM
POVFXP ;FIXNUM
POVSPDL ;SPEC
PDLST9: $XM,,QRANDOM ;TYPICAL ST ENTRIES FOR PDL PAGES
FL+$PDLNM,,QFLONUM
FX+$PDLNM,,QFIXNUM
$XM,,QRANDOM
PDLH5: IORI R,PAGSIZ-1 ;BAD PDL OV - REALLY DESPERATE
SUBI D,-2(R) ;GIVE US AS MUCH PDL AS IS LEFT
JUMPL D,PDLH6
MOVE P,C2
MOVE FXP,FXC2
SETZM TTYOFF
STRT UNRECOV
STRT @PDLMSG-P(F)
JRST DIE
PDLH6: HRLM D,(F)
HLRZ R,NOQUIT
JUMPN R,GCPDLOV ;FOO! HAPPENED IN GC - BOMB OUT!
HRRZ B,PDLMSG-P(F)
CAIE B,POVSPDL
JRST PDLOV5 ;PDLOV5 HANDLE WILL GET US TO TOP LEVEL
MOVEM P,F ;FOR SP, TRY TO POP BINDINGS FIRST
HRRZ TT,SPSV ; SO *RSET-TRAP WON'T OVERFLOW
MOVE P,[-LFAKP-1,,FAKP] ;SO WE HAVE ENOUGH PDL FOR UBD
PUSH P,FXP
MOVE FXP,[-LFAKFXP-1,,FAKFXP]
PUSHJ P,UBD
POP P,FXP
MOVE P,F
JRST PDLOV5 ;PDLOV5 WILL SET UP PDLS
] ;END OF IFN PAGING
SUBTTL PURE SEGMENT CONSER
;;; GRBPSG RETURNS ONE PUREIFIABLE SEGMENT. ADR IN AC T
;;; GTNPSG IS INVOKED AS FOLLOWS:
;;; AOSL A,NPFF% ;SKIP UNLESS NO MORE LEFT
;;; SPECPRO INTPPC
;;; PUSHJ P,GTNPSG ;MUST GET MORE
;;; ADD A,EPFF% ;ELSE JUST FIGURE OUT ABSOLUTE ADDRESS
;;; NOPRO
;;; WHERE % IS SOME APPROPRIATE LETTER (E.G. S, X, L, B).
;;; GTNPSG UPDATES NPFF% AND EPFF% BY LOOKING AT THE AOSL, THEN
;;; RETURNS TO THE AOSL.
XCTPRO
GRBPSG: HLLOS NOQUIT ;GET NEW PURE SEGMENT
NOPRO
SOVEFX TT D R
SKIPN T,PRSGLK ;SKIP IF ANY SEGMENTS IN PURE SEGMENT FREELIST
PUSHJ P,GTNPS3
LDB D,[SEGBYT,,GCST(T)] ;IF SO, CDR THAT FREELIST
MOVEM D,PRSGLK
MOVE TT,[$XM+PUR,,QRANDOM]
MOVEM TT,ST(T) ;SETUP ST TABLE CORRECTLY
SETZM GCST(T) ;AND ALSO GCST
RSTRFX R D TT
JRST CZECHI
;GETS A PURE SEGMENT FOR CONSING PURPOSES
XCTPRO
GTNPSG: HLLOS NOQUIT ;GET NEW PURE SEGMENT
NOPRO
REPEAT 2, SOS (P) ;BACK UP RETURN ADDRESS TO PRECEDING INST
SOVEFX T TT D R
SKIPN T,PRSGLK ;SKIP IF ANY SEGMENTS IN PURE SEGMENT FREELIST
PUSHJ P,GTNPS3
LDB D,[SEGBYT,,GCST(T)] ;IF SO, CDR THAT FREELIST
MOVEM D,PRSGLK
IFE HNKLOG, MOVE D,@(P) ;NOW D POINTS TO NPFF-
IFN HNKLOG,[
MOVE D,(P) ;THIS ALLOWS REFERENCE TO NPFF- TO BE INDEXED
MOVEI D,@(D) ; BY TT, WHICH MUST BE SAFE TO THIS POINT
] ;END OF IFN HNKLOG
2DIF [SKIPN TT,(D)]GTNPS8,NPFFS
.VALUE
MOVEM TT,ST(T)
SETZM GCST(T)
LSH T,SEGLOG
ADDI T,SEGSIZ
MOVEM T,EPFFS-NPFFS(D) ;UPDATE PARAMETERS FOR NEW PURE SEGMENT
MOVNI T,SEGSIZ+1
MOVEM T,(D)
MOVEI T,SEGSIZ
ADDM T,PFSSIZ-NPFFS(D) ;UPDATE STORAGE SIZE
RSTRFX R D TT T
JRST CZECHI
;;; TYPICAL ST ENTRIES FOR PURE SEGMENTS
GTNPS8: LS+$FS+PUR,,QLIST ;LIST
FX+PUR,,QFIXNUM ;FIXNUM
FL+PUR,,QFLONUM ;FLONUM
DB$ DB+PUR,,QDOUBLE ;DOUBLE
CX$ CX+PUR,,QCOMPLEX ;COMPLEX
DX$ DX+PUR,,QDUPLEX ;DUPLEX
BG$ BN+PUR,,QBIGNUM ;BIGNUM
0 ;NO PURE SYMBOLS
HN$ REPEAT HNKLOG+1, LS+HNK+PUR,,QHUNK0+.RPCNT ;HUNKS
0 ;NO PURE SARS
IFN .-GTNPS8-NFF, WARN [GTNPS8 WRONG LENGTH TABLE]
$XM+PUR,,QRANDOM ;SYMBOL BLOCKS
;CALLED TO GET NEW PAGE OF PURE MEMORY
;RETURNS C(PRSGLK) IN T
GTNPS3: PUSH FXP,TT ;GTNPSG REQUIRES TT TO BE SAFE
IFN PAGING,[
MOVE T,HINXM ;FIGURE OUT IF ANY ROOM LEFT
SUBI T,PAGSIZ
CAMGE T,BPSH
LERR [SIXBIT \NO SPACE FOR NEW PURE PAGE!\]
MOVEM T,HINXM ;UPDATE HINXM
MOVEI TT,1(T)
] ;END OF IFN PAGING
IFE PAGING,[
MOVE TT,HIXM
ADDI TT,PAGSIZ
CAMLE TT,MAXNXM
LERR [SIXBIT \NO SPACE FOR NEW PURE PAGE!\]
MOVEM TT,HIXM
] ;END OF IFE PAGING
LSH TT,-SEGLOG ;UPDATE ST AND GCST FOR NEW PAGE
MOVE D,[$XM+PUR,,QRANDOM]
REPEAT SGS%PG, MOVEM D,ST+.RPCNT(TT)
MOVE D,PRSGLK
REPEAT SGS%PG,[
SETZM GCST+.RPCNT(TT)
DPB D,[SEGBYT,,GCST+.RPCNT(TT)]
MOVEI D,.RPCNT(TT)
] ;END OF REPEAT SGS%PG
MOVEM D,PRSGLK
IFN PAGING,[
MOVEI TT,1(T) ;UPDATE PURTBL
ROT TT,-PAGLOG-4
ADDI TT,(TT)
ROT TT,-1
TLC TT,770000
ADD TT,[430200,,PURTBL]
DPB T,TT ;T HAS 11 IN LOW TWO BITS
; (CAN PURIFY, WITH SOME CARE)
IFN ITS,[
MOVEI R,1(T) ;NOT AN AOBJN POINTER,
LSH R,-PAGLOG ; SO WE GET ONLY ONE PAGE
.CALL GTSPC8
.LOSE 1000
] ;END OF IFN ITS
IFN D20,[
PUSHJ FXP,SAV3
SETMM 1(T) ;CREATE THE PAGE
MOVEI 1,1(T) ;THEN GET THE PAGE NUMBER
LSH 1,-PAGLOG
HRLI 1,.FHSLF
MOVSI 2,(PA%RD\PA%WT\PA%EX)
SPACS
PUSHJ FXP,RST3
] ;END OF IFN D20
] ;END OF IFN PAGING
IFN <PAGING-1>*D10,[
HRRZ TT,HIXM
CORE TT,
HALT
] ;END OF IFN <PAGING-1>*D10
MOVE T,PRSGLK ;FORCE PRSGLK INTO AC T FOR CALLER
POP FXP,TT
POPJ P,
SUBTTL FREE STORAGE SPACE EXPANSION
;;; THIS PORTION OF THE GARBAGE COLLECTOR DETERMINES WHETHER
;;; WE SHOULD JUST GRAB A NEW SEGMENT OF FREE STORAGE FOR SOME
;;; CONSER, OR DO A FULL-BLOWN GARBAGE COLLECTION. IT IS
;;; CONTROLLED BY PARAMETERS SETTABLE VIA (SSTATUS GCSIZE ...).
GCGRAB: MOVN R,D
JFFO R,.+1 ;DETERMINE WHICH SPACE WANTED MORE
SUBI F,NFF
MOVEI AR2A,1 ;MACRAK SEZ: GRAB JUST ONE
SKIPN FFY2
SETZ F,
JUMPE F,GCGRB1 ; ... SEZ MACRAK
MOVE D,SFSSIZ+NFF(F)
CAML D,GFSSIZ+NFF(F) ;CAN'T JUST GRAB IF ABOVE SIZE
JRST AGC1Q ; SPECIFIED FOR "FREE GRABBIES"
MOVE D,GFSSIZ+NFF(F)
CAMLE D,XFFS+NFF(F) ;CAN'T GRAB IF IT WOULD PUT
JRST AGC1Q ; US ABOVE THE MAXIMUM SIZE
GCGRB1: PUSH FXP,AR2A
PUSHJ P,GRABWORRY
POP FXP,AR1
JUMPGE AR2A,AGC1Q ;GO DO FULL-BLOWN GC AFTER ALL
IFN WHL,[
MOVE D,[-3,,GCWHL6]
MOVE R,GCWHO
TRNE R,1
.SUSET D
] ;END OF IFN WHL
JRST GCEND
;;; THESE ROUTINES WORRY ABOUT GETTING A NEW IMPURE FREE STORAGE
;;; SEGMENT. (FOR PURE FREE STORAGE SEGMENTS, SEE GTNPSG.)
;;; GCWORRY MUST DO SPECIAL HACKERY FOR SYMBOL AND SAR SPACES, SINCE THEY
;;; REQUIRE MORE THAN ONE CONSECUTIVE SEGMENT, AND PRINTS OUT PRETTY
;;; MESSAGES IF GCGAG IS NON-NIL. MUST HAVE NOQUIT NON-ZERO.
;;; *THE FOLLOWING COMMENT IS HISTORICAL AND SHOULD BE IGNORED*
;;; MUST HAVE NOQUIT NON-ZERO AND ST/GCST PAGES IMPURE WHEN ENTERING!
;THIS ROUTINE ALLOCATES ONE IMPURE SEGMENT AND MARKS IT AS
; $XM,,QRANDOM IN ST TABLE. POINTER TO SEGMENT RETURNED IN TT
; DESTROYS C, D, AR1, R
GRBSEG: SKIPE TT,IMSGLK
JRST GRBSG1 ;JUMP IF ANY SEGMENTS AVAILABLE
PUSHJ P,ALIMPG ;ELSE MUST GRAB A NEW PAGE
POPJ P, ;FAIL IF NO NEW PAGES TO BE HAD
GRBSG1: LDB D,[SEGBYT,,GCST(TT)]
MOVEM D,IMSGLK ;CDR THE FREE SEGMENT LIST
MOVE D,[$XM,,QRANDOM] ;MARK NEW SEGMENT IN ST TABLE
MOVEM D,ST(TT)
SETZM GCST(TT) ;RESET GCST TABLE ENTRY
LSH TT,SEGLOG ;RETURN A POINTER TO THE HEAD OF THE SEGMENT
AOS (P)
POPJ P,
;THIS ROUTINE IS FOR NORMAL ALLOCATION OF SEGMENTS BY THE GC
GCWORRY:SUBI AR2A,(TT) ;ENTRY FOR GARBAGE COLLECTOR
ADDI AR2A,SEGSIZ-1 ;FIGURE OUT HOW MANY NEW SEGMENTS WE NEED
LSH AR2A,-SEGLOG
GRABWORRY:
HRRZ AR1,VMSGFILES
TLO AR1,200000
JUMPE F,.+2 ;ENTRY FOR GCGRAB
SKIPN GCGAGV ;MAYBE WE WANT A PRETTY MESSAGE?
SOJA AR2A,GCWOR2 ;IF NOT, DECR AR2A (SEE BELOW)
STRT 17,[SIXBIT \^M;ADDING !\]
SOJG AR2A,GCWR0A ;AR2A GETS DECR'ED HERE, TOO!
STRT 17,[SIXBIT \A!\] ;KEEP THE ENGLISH GOOD
JRST GCWR0B
GCWR0A: MOVEI R,$TYO
MOVEI TT,1(AR2A)
PUSH FXP,AR2A
IFE USELESS, MOVE C,@VBASE ;BASE DAMN WELL BETTER BE A FIXNUM
IFN USELESS,[
HRRZ C,VBASE
CAIE C,QROMAN
SKIPA C,(C)
PUSHJ P,PROMAN
] ;END OF IFN USELESS
PUSHJ P,PRINI9
POP FXP,AR2A
GCWR0B: STRT 17,[SIXBIT \ NEW !\]
STRT 17,@GSTRT9+NFF(F)
STRT 17,[SIXBIT \ SEGMENT!\]
SKIPE AR2A
STRT 17,[SIXBIT \S!\]
GCWOR2: SKIPE TT,IMSGLK
JRST GCWR2A ;JUMP IF ANY SEGMENTS AVAILABLE
PUSHJ P,ALIMPG ;ELSE MUST GRAB A NEW PAGE
JRST GCWOR7
GCWR2A: LDB D,[SEGBYT,,GCST(TT)]
MOVEM D,IMSGLK ;CDR THE FREE SEGMENT LIST
MOVE D,FSSGLK+NFF(F) ;CONS NEW SEGMENT ONTO LIST
MOVEM TT,FSSGLK+NFF(F) ; OF SEGMENTS FOR THE
HRRZ R,BTBAOB ; PARTICULAR SPACE
HLL R,GCWORS+NFF(F)
LSH D,22-<SEGLOG-5>
GCWR2B: TLNE R,$FS+FX+FL+BN+HNK+DB+CX+DX .SEE GCWR2C
IORI D,(R) ;MAYBE ALLOCATE A BIT BLOCK FOR
IOR D,GCWORG+NFF(F) ; THE NEW SEGMENT FOR USE BY
MOVEM D,GCST(TT) ; GC IN MARKING CELLS
MOVE D,GCWORS+NFF(F) ;UPDATE ST ENTRY FOR THE
MOVEM D,ST(TT) ; NEW SEGMENT
MOVE D,FFS+NFF(F) ;ADD CELLS OF SEGMENT TO
LSH TT,SEGLOG ; THE FREE STORAGE
MOVEM D,(TT) ; LIST FOR THIS SPACE
MOVE D,[GCWORX,,1]
BLT D,LPROG9
HLL TT,GCWORN+NFF(F)
HRR GCWRX1,GCWORN+NFF(F)
HRRI GCWRX2,-1(GCWRX1)
JRST GCWRX1
GCWR2C: HRRZM TT,FFS+NFF(F)
TLNN R,$FS+FX+FL+BN+HNK+DB+CX+DX .SEE GCWR2B
JRST GCWR4Q
HRRZ TT,BTBAOB ;DECIDE WHETHER THIS BIT BLOCK
LSH TT,SEGLOG-5 ; LIES IN MAIN BIT BLOCK AREA
MOVEI D,-1(TT)
CAME D,MAINBITBLT
JRST GCWR3A
ADDI D,BTBSIZ ;YES - JUST UPDATE MAIN BLT
MOVEM D,MAINBITBLT ; POINTER FOR CLEARING
JRST GCWR3B ; BIT BLOCKS (SEE GCINBT)
GCWR3A: LSH TT,-SEGLOG ;ELSE AOS COUNT OF BIT BLOCKS
AOS GCST(TT) ; IN CURRENT BIT BLOCK SEGMENT
GCWR3B: MOVE TT,BTBAOB ;AOBJN THE BIT BLOCK
AOBJN TT,GCWOR4 ; ALLOCATION POINTER
SKIPE TT,IMSGLK ;FOO! OUT OF BIT BLOCKS!
JRST GCWR3F
PUSHJ P,ALIMPG ;FOO FOO! NEED NEW PAGE!
JRST GCWFOO
GCWR3F: LDB D,[SEGBYT,,GCST(TT)]
MOVEM D,IMSGLK ;CDR LIST OF FREE SEGMENTS
MOVE D,[$XM,,QRANDOM] ;UPDATE ST AND GCST FOR
MOVEM D,ST(TT) ; NEW BIT BLOCK SEGMENT
MOVEI D,(TT) ;GCST ENTRY IS USED TO
LSH D,5 ; INDICATE HOW MANY
MOVEM D,GCST(TT) ; BLOCKS ARE IN USE
MOVE D,BTSGLK ;CONS NEW SEGMENT ONTO LIST
DPB D,[SEGBYT,,GCST(TT)] ; OF BIT BLOCK SEGMENTS
MOVEM TT,BTSGLK
LSH TT,5 ;CALCULATE NEW BIT BLOCK
HRLI TT,-SEGSIZ/BTBSIZ ; ALLOCATION POINTER
GCWOR4: MOVEM TT,BTBAOB
GCWR4Q: JUMPE F,GCWOR6
MOVEI TT,SEGSIZ ;UPDATE VARIOUS GC PARAMETERS
ADDM TT,NFFS+NFF(F)
ADDB TT,SFSSIZ+NFF(F)
CAMLE TT,XFFS+NFF(F) ;MUST STOP IF OVER MAX
SOJA AR2A,.+2 ;KEEP COUNT ACCURATE
GCWOR6: SOJGE AR2A,GCWOR2 ;ALSO STOP IF WE GOT ALL WE WANT
GCWOR7: JUMPE F,CPOPJ
SKIPN GCGAGV ;MAYBE WANT MORE PRETTY MESSAGE
POPJ P,
SKIPL AR2A
STRT 17,[SIXBIT \^M; BUT DIDN'T SUCCEED!\]
STRT 17,[SIXBIT \ -- !\]
STRT 17,@GSTRT9+NFF(F)
STRT 17,[SIXBIT \ SPACE NOW !\]
MOVEI R,$TYO
PUSH FXP,AR2A
HRRZ AR1,VMSGFILES
TLO AR1,200000
MOVE TT,SFSSIZ+NFF(F)
IFE USELESS, MOVE C,@VBASE
IFN USELESS,[
HRRZ C,VBASE
CAIE C,QROMAN
SKIPA C,(C)
PUSHJ P,PROMAN
] ;END OF IFN USELESS
PUSHJ P,PRINI9
STRT 17,[SIXBIT \ WORDS!\]
POP FXP,AR2A
POPJ P,
;;; TYPICAL GCST ENTRIES FOR IMPURE SPACES
GCWORG: GCBMRK+GCBCDR+GCBCAR,, ;LIST
GCBMRK,, ;FIXNUM
GCBMRK,, ;FLONUM
DB$ GCBMRK,, ;DOUBLE
CX$ GCBMRK,, ;COMPLEX
DX$ GCBMRK,, ;DUPLEX
BG$ GCBMRK+GCBCDR,, ;BIGNUM
GCBMRK+GCBSYM,, ;SYMBOL
HN$ REPEAT HNKLOG+1, GCBMRK+GCBCDR+GCBCAR+GCBHNK,, ;HUNKS
GCBMRK+GCBSAR,, ;SAR
IFN .-GCWORG-NFF, WARN [WRONG LENGTH TABLE]
0 ;SYMBOL BLOCKS
;;; TYPICAL ST ENTRIES FOR IMPURE SPACES
GCWORS: LS+$FS,,QLIST ;LISP
FX,,QFIXNUM ;FIXNUM
FL,,QFLONUM ;FLONUM
DB$ DB,,QDOUBLE ;DOUBLE
CX$ CX,,QCOMPLEX ;COMPLEX
DX$ DX,,QDUPLEX ;DUPLEX
BG$ BN,,QBIGNUM ;BIGNUM
SY,,QSYMBOL ;SYMBOL
HN$ REPEAT HNKLOG+1, LS+HNK,,QHUNK0+.RPCNT ;HUNKS
SA+$XM,,QARRAY ;SAR
IFN .-GCWORS-NFF, WARN [WRONG LENGTH TABLE]
$XM,,QRANDOM ;SYMBOL BLOCKS
GCWFOO: STRT [SIXBIT \^M;GLEEP#! OUT OF BIT BLOCKS!\]
JRST GCWOR7
GCWORX: ;EXTEND FREELIST THROUGH NEW SEGMENT
OFFSET 1-.
GCWRX1: HRRZM TT,.(TT) ;OCCUPIES A,B,C,AR1 - MUST SAVE AR2A
GCWRX2: ADDI TT,.
AOBJN TT,GCWRX1
JRST GCWR2C
LPROG9==:.-1
OFFSET 0
.HKILL GCWRX1 GCWRX2
GCWORN: -SEGSIZ+1,,1 ;LIST
-SEGSIZ+1,,1 ;FIXNUM
-SEGSIZ+1,,1 ;FLONUM
DB$ -SEGSIZ/2+1,,2 ;DOUBLE
CX$ -SEGSIZ/2+1,,2 ;COMPLEX
DX$ -SEGSIZ/2+1,,4 ;DUPLEX
BG$ -SEGSIZ+1,,1 ;BIGNUM
-SEGSIZ+1,,1 ;SYMBOL
HN$ REPEAT HNKLOG+1, -SEGSIZ/<1_.RPCNT>+1,,1_.RPCNT ;HUNKS
-SEGSIZ/2+1,,2 ;ARRAY SARS
IFN .-GCWORN-NFF, WARN [WRONG LENGTH TABLE]
-SEGSIZ/2+1,,2 ;SYMBOL BLOCKS
SUBTTL IMPURE PAGE GOBBLER
;;; ALLOCATE AN IMPURE PAGE FREE STORAGE USE
ALIMPG:
IFN PAGING,[
MOVE TT,HINXM ;MUST SAVE AR2A AND F FOR GCWORRY
SUBI TT,PAGSIZ
CAMGE TT,BPSH
] ;END OF IFN PAGING
IFE PAGING,[
MOVE TT,HIXM
ADDI TT,PAGSIZ
CAMLE TT,MAXNXM
] ;END OF IFE PAGING
POPJ P, ;NO PAGES LEFT - RETURN WITHOUT SKIP
IFN PAGING,[
MOVEM TT,HINXM ;ELSE UPDATE HINXM
IFN ITS,[
MOVEI R,1(TT)
LSH R,-PAGLOG
.CALL GTSPC8
.LOSE 1000
] ;END OF IFN ITS
IFN D20,[
SETMM 1(TT) ;CREATE THE PAGE
MOVEI 1,1(TT)
LSH 1,-PAGLOG
HRLI 1,.FHSLF
MOVSI 2,(PA%RD\PA%WT\PA%EX)
SPACS
] ;END OF IFN D20
MOVEI D,1(TT) ;COMPUTE A MAGIC BYTE POINTER
LSH D,-PAGLOG
ROT D,-4
ADDI D,(D)
ROT D,-1
TLC D,770000
ADD D,[430200,,PURTBL]
MOVEI C,1
DPB C,D ;UPDATE THE PURTBL
HRRZ R,(P) ;GET THE CALLER'S PC+1
CAIN R,GTCOR4+1 ;DON'T HACK IMSGLK FOR GETCOR
JRST POPJ1
] ;END OF IFN PAGING
IFN <PAGING-1>*D10,[
MOVEM TT,HIXM
CORE TT,
HALT
MOVE TT,HIXM
] ;END OF IFN <PAGING-1>*D10
LSH TT,-SEGLOG
IFN PAGING, ADDI TT,SGS%PG
MOVE C,IMSGLK ;UPDATE ST AND GCST, AND ADD
MOVE AR1,[$XM,,QRANDOM] ; NEW SEGMENTS TO IMSGLK LIST
MOVEI D,SGS%PG
ALIMP3: MOVEM AR1,ST(TT)
SETZM GCST(TT)
DPB C,[SEGBYT,,GCST(TT)]
MOVEI C,(TT)
SOSE D
SOJA TT,ALIMP3
MOVEM TT,IMSGLK ;EXITS WITH LOWEST NEW SEGMENT # IN TT
JRST POPJ1 ;WINNING RETURN SKIPS
SUBTTL RECLAIM FUNCTION
IFN BIGNUM+USELESS,[
RECLAIM: HRRZS A ;SUBR 2
JUMPE A,CPOPJ ;GC A PARTICULAR SEXP
LOCKI
PUSHJ P,RECL1
MOVEI A,NIL
UNLKPOPJ
RECL1: SKOTT A,LS+PUR
2DIF JRST (TT),RECL9-1,QLIST .SEE STDISP
TLNE TT,HNK+VC+PUR ;DON'T RECLAIM VALUE CELLS!!! (OR HUNKS)
POPJ P, ; - ALSO DON'T RECLAIM PURE WORDS
PUSH P,A ;SAVE ARG
JUMPE B,RECL2 ;B=NIL => RECLAIM ONLY TOP LEVEL OF LIST
HLRZ A,(A) ;RECLAIM CAR
PUSHJ P,RECL1
RECL2: MOVE T,FFS
POP P,FFS
EXCH T,@FFS ;RECLAIM ONE CELL
MOVEI A,(T) ;AND THEN GO AFTER THE CDR
JRST RECL1
RECLFW: JUMPE B,RECL9A ;B=NIL => DON'T RECLAIM FULLWORDS
TLNE TT,$PDLNM ;DON'T RECLAIM PDL LOCATIONS!!!
POPJ P,
2DIF [MOVE T,(TT)]FFS-QLIST ;RECLAIM NUMBER
MOVEM T,(A)
2DIF [MOVEM A,(TT)]FFS-QLIST
POPJ P,
IFN BIGNUM,[
REBIG: MOVE T,FFB ;RECLAIM BIGNUM HEADER
EXCH T,(A)
MOVEM A,FFB
MOVEI A,(T) ;RECLAIM CDR OF BIGNUM
JRST RECL1
] ;END OF IFN BIGNUM
RECL9: JRST RECLFW ;FIXNUM
JRST RECLFW ;FLONUM
DB$ JRST RECLFW ;DOUBLE
CX$ JRST RECLFW ;COMPLEX
DX$ JRST RECLFW ;DUPLEX
BG$ JRST REBIG ;BIGNUM
RECL9A: POPJ P, ;SYMBOL
HN$ REPEAT HNKLOG+1, .VALUE ;HUNKS
POPJ P, ;RANDOM
POPJ P, ;ARRAY
IFN .-RECL9-NTYPES+1, WARN [WRONG LENGTH TABLE]
] ;END OF IFN BIGNUM+USELESS
IFN PAGING,[
SUBTTL VALUE CELL AND SYMBOL BLOCK HACKERY
;;; ROUTINE TO GET MORE VALUE CELL SPACE.
;;; EXPANDS VALUE CELL SPACE BY GETTING NEXT PAGE IN THE HOLE
;;; LEFT FOR THIS PURPOSE, AND EXTENDING THE VALUE CELL FREELIST.
;;; IF NO PAGES LEFT IN THE HOLE, A LIST CELL IS USED.
;;; MAY CLOBBER ONLY A AND TT.
XCTPRO
MAKVC3: HLLOS NOQUIT
NOPRO
SOSL NFVCP
JRST MAKVC4
PUSHJ P,CZECHI
PUSHJ P,CONS1
SETOM ETVCFLSP
JRST MAKVC1
MAKVC4:
IFN ITS,[
PUSH FXP,R ;MUST SAVE R
MOVE R,EFVCS
LSH R,-PAGLOG
.CALL GTSPC8 ;GET A NEW PAGE
.LOSE 10000
POP FXP,R
] ;END OF IFN ITS
IFN D20,[
PUSHJ FXP,SAV3
MOVE 1,EFVCS
SETMM (1) ;CREATE THE PAGE
LSH 1,-PAGLOG
HRLI 1,.FHSLF
MOVSI 2,(PA%RD\PA%WT\PA%EX)
SPACS
PUSHJ FXP,RST3
] ;END OF IFN D20
MOVE A,EFVCS
MOVEM A,FFVC
LSH A,-SEGLOG
MOVE TT,[LS+VC,,QLIST]
REPEAT SGS%PG, MOVEM TT,ST+.RPCNT(A) ;UPDATE SEGMENT TABLE
MOVSI TT,GCBMRK+GCBVC
REPEAT SGS%PG, MOVEM TT,GCST+.RPCNT(A) ;UPDATE GC SEGMENT TABLE
LSH A,-PAGLOG+SEGLOG ;UPDATE PURTBL
ROT A,-4
ADDI A,(A)
ROT A,-1
TLC A,770000
ADD A,[430200,,PURTBL]
MOVEI TT,1
DPB TT,A
AOS TT,EFVCS ;EXTEND FREELIST THROUGHOUT NEW PAGE
HRLI TT,-PAGSIZ+1
HRRZM TT,-1(TT)
AOBJN TT,.-1
HRRZM TT,EFVCS
MAKVC8: PUSHJ P,CZECHI
JRST MAKVC0
] ;END OF IFN PAGING
;;; SYMBOL BLOCK COPYING ROUTINE - TRIGGERED BY PURE PAGE TRAP, OR EXPLICIT CHECK
;;; B POINTS TO OLD SYMBOL BLOCK
;;; LEAVES POINTER TO NEW SYMBOL BLOCK IN B
;;; CLOBBERS TT, LEAVES POINTER TO VALUE CELL IN A
LDPRG9: TLCA B,LDPARG ;FASLOAD CLOBBERING ARGS PROP
ARGCL7: TLC B,ARGCL3 ;ARGS CLOBBERING ARGS PROP
HRRZ A,(B)
JRST MAKVC6
MAKVC9: TLC B,MAKVCX ;MAKVC CLOBBERING IN VALUE CELL
JRST MAKVC6
MAKVC5: PUSH P,SPSV ;MUST PRESERVE SPSV AS WE CAN COME HERE FROM
; WITHIN A BIND AND AGC DOES BINDING ALSO
PUSHJ P,AGC
POP P,SPSV
BAKPRO
MAKVC6: SKIPN FFY2 ;COME HERE IF HRRM ABOVE CAUSES
JRST MAKVC5 ; A PURE PAGE TRAP - MUST COPY
MOVE TT,@FFY2 ; SYMBOL BLOCK FOR THAT SYMBOL
XCTPRO
EXCH TT,FFY2
NOPRO
HRLI A,SY.ONE\SY.CCN\SY.OTC ;ASSUME COMPILED CODE NEEDS IT FOR OTHER
; THEN CALL UUO'S
MOVEM A,SYMVC(TT) ; (THINK ABOUT THIS SOME MORE)
MOVE A,SYMPNAME(B)
MOVEM A,SYMPNAME(TT)
HRRZ A,(TT)
HRLM TT,@(P)
EXCH TT,B
HLRZ TT,TT
JRST (TT)
SUBTTL ALLOC FUNCTION
$ALLOC: CAIE A,TRUTH ;SUBR 1 - DYNAMIC ALLOC
JRST $ALLC5
SETO F, ;ARG=T => MAKE UP LIST
EXCH F,INHIBIT ;CROCKISH LOCKI - DOESN'T MUNG FXP
MOVNI R,NFF
$ALLC6: PUSH FXP,GFSSIZ+NFF(R) ;SAVE UP VALUABLE DATA
PUSH FXP,XFFS+NFF(R) ;LOCKI KEEPS IT CONSISTENT
PUSH FXP,MFFS+NFF(R)
AOJL R,$ALLC6
IFN PAGING, REPEAT 4, PUSH FXP,XPDL+.RPCNT
MOVEM F,INHIBIT ;EQUALLY CROCKISH UNLOCKI
PUSHJ P,CHECKI
PUSH P,R70
IFN PAGING,[
MOVEI R,4
$ALLC9: POP FXP,TT
SUB TT,C2-1(R)
TLZ TT,-1
JSP T,FIX1A
MOVE B,(P)
PUSHJ P,CONS
MOVEI B,QREGPDL-1(R)
PUSHJ P,XCONS
MOVEM A,(P)
SOJG R,$ALLC9
] ;END OF IFN PAGING
MOVEI R,NFF
$ALLC7: SKIPN SFSSIZ-1(R)
JRST $ALLC8 ;SPACE SIZE IS ZERO - IGNORE IT
POP FXP,TT
PUSHJ P,SSGP2A
PUSHJ P,NCONS
MOVEI B,(A)
POP FXP,TT
JSP T,FIX1A
PUSHJ P,CONS
MOVEI B,(A)
POP FXP,TT
JSP T,FIX1A
PUSHJ P,CONS
MOVE B,(P)
PUSHJ P,CONS
MOVEI B,QLIST-1(R)
CAIN B,QRANDOM
MOVEI B,QARRAY
PUSHJ P,XCONS
MOVEM A,(P)
JRST $ALLC4
$ALLC8: SUB FXP,R70+3 ;FLUSH GARBAGE
$ALLC4: SOJG R,$ALLC7
JRST POPAJ
$ALLC0: HRRZ A,(AR2A)
$ALLC5: JUMPE A,TRUE ;DECODE LIST OF PAIRS
HLRZ B,(A) ;ARG IS LIST OF SAME FORM AS
HRRZ AR2A,(A) ; A .LISP. (INIT) COMMENT
HLRZ C,(AR2A)
CAIL B,QREGPDL
CAILE B,QSPECPDL
JRST $ALLC3
MOVEI D,1_-1 ;SSPDLMAX
PUSHJ P,SSGP3$
JRST $ALLC0
$ALLC3: JSP R,SFRET
JRST $ALLC0
JRST $ALLC0
SETZ AR1,
MOVEI F,(C)
SKOTT C,LS
JRST $ALLC2
HRRZ AR1,(C)
HLRZ C,(C)
HLRZ F,(AR1)
SKIPE AR1
SKIPA AR1,(AR1)
SKIPA F,C
HLRZ AR1,(AR1)
$ALLC2: MOVEI D,3_-1 ;SSGCSIZE
PUSHJ P,SSGP3$
MOVEI C,(F)
MOVEI D,5_-1 ;SSGCMAX
PUSHJ P,SSGP3$
MOVEI C,(AR1)
MOVEI D,7_-1 ;SSGCMIN
PUSHJ P,SSGP3$
JRST $ALLC0
PGTOP BIB,[MEMORY MANAGEMENT STUFF]
Reference in New Issue View Git Blame Copy Permalink