;;; -*-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- ;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- ;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 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 ;IF ARRAY POINTER HAS "GC ME" BIT SET, JRST GCP6F TLNE D,AS ;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 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 ;SET UP SOME ACS FOR THE GCMKL-LOOK LOOP MOVE R,[TTDEAD] MOVSI TT,TTS 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 ;IGNORE IF ALREADY CLOSED JRST GCP6H8 PUSH P,F IFN JOBQIO,[ HLL B,ASAR(A) TLNE B,AS 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 ;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 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 ; 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,, GSSP8: TTS,, 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 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: 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 MOVE P,GCNASV+14- MOVE SP,GCNASV+17- PUSHJ P,UNBIND JSP NACS+1,GCACR SETZM GCFXP 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 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 HRRZS NOQUIT JRST CHECKI ;GCRSR: 0 GCRSR0: HRLM C,NOQUIT ;RESTORE ACS, AND CHECK FOR ANY STACKED INTERRUPTS 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 MOVE P,GCNASV+14- MOVE SP,GCNASV+17- PUSHJ P,UNBIND JSP NACS+1,GCACR ;RESTORE AC'S SETZM GCFXP 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 GCTIME FOR (STATUS GCTIME) 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- ;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 TLNE F,TTS 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 ;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_ ;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_ 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 IORM AR1,TTSAR(A) JRST KLGCND IFN HNKLOG,[ ZZZ==<1_HNKLOG>-1 REPEAT HNKLOG,[ CONC KLGH,\HNKLOG-.RPCNT,: REPEAT 1_,[ PUSH P,ZZZ(A) HLRZ B,(P) PUSH P,B ZZZ==ZZZ-1 ] ;END OF REPEAT 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,/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) ;-,, .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: -,, ] ;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 ;- 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: -,, 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^>] ;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,[-,,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 *D10,[ HRRZ TT,HIXM CORE TT, HALT ] ;END OF IFN *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- 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 *D10,[ MOVEM TT,HIXM CORE TT, HALT MOVE TT,HIXM ] ;END OF IFN *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]