
 1000  *SAVE S.FAST GARBAGE COLLECTOR
 1010  *--------------------------------
 1020  *   FAST GARBAGE COLLECTOR
 1030  *--------------------------------
 1040  *   BY COL. PAUL SHETLER, MD
 1050  *   INSPIRED BY CORNELIS BONGERS
 1060  *--------------------------------
 1070  *
 1080  *   CALL FROM APPLESOFT WITH K=USR(N)
 1090  *
 1100  *   IF N=0, THEN COLLECTION FORCED
 1110  *
 1120  *   IF N<0, THEN POOL CHECKED FOR NEG ASCII.
 1130  *           IF NO NEG ASCII, THEN GC FORCED
 1140  *           IF NEG ASCII FOUND, THEN
 1150  *                SET USER(#)=0 AND QUIT.
 1160  *
 1170  *   IF N>0, THEN COLLECTION PERFORMED ONLY IF
 1180  *          LESS THAN N*256 BYTES OF FREE
 1190  *          SPACE LEFT.
 1200  *--------------------------------
 1210  *      THE APPLESOFT PROGRAM MUST INLCUDE
 1220  *      THE FOLLOWING STATEMENTS TO SET UP
 1230  *      THIS GARBAGE COLLECTOR:
 1240  *
 1250  *      100 HIMEM:37888:REM$9400
 1260  *      110 PRINT CHR$(4)"BLOAD B.FAST GARBAGE COLL
 1270  *          ECTOR"
 1280  *      120 POKE 10,76 : POKE 11,0 : POKE 12,148
 1290  *--------------------------------
 1300  * EQUATES FOR GARBAGE COLLECTION
 1310  *--------------------------------
 1320  SHORT.FLAG          .EQ $06
 1330  STRING.LENGTH       .EQ $07
 1340  INDEX               .EQ $19
 1350  OFFSET              .EQ $1B
 1360  ARRAY.END           .EQ $1D
 1370  *--------------------------------
 1380  *      USER(#)  EQUATES
 1390  *--------------------------------
 1400  FACMO               .EQ $A0
 1410  FACLO               .EQ $A1
 1420  AYINT               .EQ $E10C
 1430  GIVAYF              .EQ $E2F2
 1440  *--------------------------------
 1450  *      STANDARD EQUATES
 1460  *--------------------------------
 1470  LOWTR               .EQ $9B
 1480  FORPNT              .EQ $08
 1490  STREND              .EQ $6D
 1500  VARTAB              .EQ $69
 1510  FRESPC              .EQ $71
 1520  FRETOP              .EQ $6F
 1530  MEMSIZE             .EQ $73
 1540  ARYTAB              .EQ $6B
 1550  *--------------------------------
 1560         .OR $9400
 1570         .TF B.FAST GARBAGE COLLECTOR
 1580  *--------------------------------
 1590  USR.GARBAGE.COLLECTOR
 1600         JSR AYINT    CONVERT USR ARGUMENT TO INTEGER
 1610  *                   WITH HIBYTE IN FACMO, LO IN FACLO
 1620         LDA FACMO    IS # MINUS?
 1630         BMI .3       ...NEED TO CHECK FOR NEG ASCII
 1640         LDA FACLO
 1650         AND #$1F     8136 BYTES
 1660         BEQ .4       ...IF =0 THEN FORCED COLLECTION
 1670         CLC
 1680         ADC STREND+1
 1690         CMP FRETOP+1
 1700         BCS .4       ...NEED TO COLLECT NOW
 1710  *---CALC FREE SPACE--------------
 1720  .1     SEC
 1730         LDA FRETOP
 1740         SBC STREND
 1750         TAY          LO BYTE
 1760         LDA FRETOP+1
 1770         SBC STREND+1
 1780  *---FLOAT (AY) FOR USR RESULT----
 1790  .2     JMP GIVAYF   FLOAT (AY) AND RETURN
 1800  *---CHECK POOL FOR NEG ASCII-----
 1810  .3     JSR SET.STRING.POOL.STROLL
 1820         JSR FIND.NEXT.NEG.BYTE.IN.POOL
 1830         LDA #0       PREPARE ZERO IN CASE NEG ASCII
 1840         TAY
 1850         BCS .2       ...FOUND SOME NEG ASCII
 1860  *---COLLECT GARBAGE NOW----------
 1870  .4     JSR MARK.ALL.ACTIVE.STRINGS
 1880         JSR RAISE.ALL.ACTIVE.STRINGS
 1890  *---FINAL CLEAN UP---------------
 1900         LDA LOWTR    STORE NEW BOTTOM OF STRING POOL
 1910         STA FRESPC
 1920         LDA LOWTR+1
 1930         STA FRESPC+1
 1940         LDA SHORT.FLAG    NEED TO FIX SHORT STRINGS?
 1950         BEQ .5            ...NO, NOT ANY SHORT ONES
 1960         JSR FIX.SHORT.STRINGS
 1970  .5     LDA FRESPC   SET FRETOP TO TOP OF FREE SPACE
 1980         STA FRETOP
 1990         LDA FRESPC+1
 2000         STA FRETOP+1
 2010         JMP .1
 2020  *--------------------------------
 2030  *   MARK ACTIVE STRINGS WITH NEG BYTE
 2040  *--------------------------------
 2050  MARK.ALL.ACTIVE.STRINGS
 2060         LDA #0       FLAG->NONE
 2070         STA SHORT.FLAG
 2080         JSR INITIATE.SEARCH
 2090  .1     JSR FIND.NEXT.STRING.VARIABLE
 2100         BCS .5       ...NO MORE VARIABLES
 2110         LDY #0       POINT AT LENGTH BYTE OF DESC.
 2120         LDA (LOWTR),Y
 2130         BEQ .1       STRING LEN =0
 2140  *---CHECK LOCATION OF STRING-----
 2150         TAX          SAVE STRLEN IN X-REG
 2160         INY          IF STRING DATA INSIDE PROGRAM,
 2170         LDA (LOWTR),Y     THEN NO NEED TO FIDDLE
 2180         STA FORPNT        WITH IT FURTHER.
 2190         CMP VARTAB
 2200         INY
 2210         LDA (LOWTR),Y
 2220         STA FORPNT+1
 2230         SBC VARTAB+1      IN PROGRAM?
 2240         BCC .1            ...YES, SO PASS
 2250  *---CHECK FOR SHORT STRING-------
 2260         CPX #3       IF 1 OR 2, SPECIAL TREATMENT
 2270         BCS .3       ...LONG STRING
 2280  *---SHORT STRING HANDLER---------
 2290         STX SHORT.FLAG    NON-ZERO TO FLAG
 2300         LDA #$FF
 2310         STA (LOWTR),Y     MARKER IN 3RD DESC. BYTE
 2320         DEY               POINT AT 2ND DESC. BYTE
 2330         DEX               CHECK LENGTH
 2340         BEQ .2            LEN=1, PUT $FF IN 2ND BYTE
 2350         LDA (FORPNT),Y    LEN=2, SAVE CHAR IN 2ND BYTE
 2360  .2     STA (LOWTR),Y
 2370         DEY               POINT AT 1ST BYTE OF DESC.
 2380         LDA (FORPNT),Y    MOVE FIRST BYTE OF STRING
 2390         STA (LOWTR),Y         TO DESC.
 2400         BPL .1       ALWAYS
 2410  *---LONG STRING HANDLER----------
 2420  .3     LDA (FORPNT),Y    MARK FIRST BYTE OF STRING
 2430         ORA #$80          MAKE NEG ASCII
 2440  .4     STA (FORPNT),Y
 2450         DEY               BACK UP TOWARD BEG. OF DATA
 2460         BMI .1            ...FINISHED MARKING THIS
 2470         LDA (FORPNT),Y    SAVE STRING CHAR IN DESC.
 2480         INY
 2490         STA (LOWTR),Y     IN LAST 2 BYTES
 2500         DEY          OF DESCRIPTOR
 2510         LDA LOWTR,Y  SAVE ADDR INSIDE STRING
 2520         BCS .4       ALWAYS SET
 2530  *---FINISHED MARKING STRINGS-----
 2540  .5     RTS
 2550  *--------------------------------
 2560  *   MOVE THE STRINGS AS HIGH AS POSSIBLE
 2570  *--------------------------------
 2580  RAISE.ALL.ACTIVE.STRINGS
 2590         JSR SET.STRING.POOL.STROLL
 2600         STX LOWTR+1  STARTS AT TOP
 2610         STA LOWTR    OF STRNG POOL
 2620  .1     JSR FIND.NEXT.NEG.BYTE.IN.POOL
 2630  *--------------------------------
 2640  * CARRY CLEAR ON RETURN WHEN THRU
 2650  *--------------------------------
 2660         BCC .4       ...NO MORE STRINGS IN POOL
 2670         LDY #0
 2680         AND #$7F
 2690         STA (FRESPC),Y
 2700  *--------------------------------
 2710  * RESTORE STRING POOL TO POS ASC
 2720  * THEN RESET POINTERS
 2730  *--------------------------------
 2740         SEC
 2750         LDA FRESPC   RECOVER ADDR.
 2760         SBC #2       OF DESCRIPTOR
 2770         STA FRESPC   FROM THE STR
 2780         BCS .2       ...NO BORROW
 2790         DEC FRESPC+1
 2800  .2     LDA (FRESPC),Y
 2810         STA FORPNT   AND PUT IT
 2820         INY          IN FORPNT
 2830         LDA (FRESPC),Y
 2840         STA FORPNT+1
 2850         INY          Y=2
 2860         LDA (FORPNT),Y
 2870  *--------------------------------
 2880  * RESTORE STRING BY RETURNING
 2890  * THE FIRST TWO BYTES WHICH WERE
 2900  * STORED IN THE DESCRIPTOR.
 2910  *
 2920  * THEN POINT DESCRIPTOR TO THE 
 2930  * NEW, CORRECT STRING POSITION.
 2940  *--------------------------------
 2950         DEY
 2960         STA (FRESPC),Y
 2970         LDA (FORPNT),Y
 2980         DEY          Y=0
 2990         STA (FRESPC),Y
 3000         LDA (FORPNT),Y
 3010         STA STRING.LENGTH
 3020         SEC
 3030         LDA LOWTR
 3040  *--------------------------------
 3050  * POINT LOWTR & STRING DESCRIPTOR
 3060  * TO BOTTOM OF NEW STRING POOL.
 3070  *
 3080  * LOWTR HOLDS THE MOVING BOTTOM
 3090  * OF THE STRING POOL.
 3100  *--------------------------------
 3110         SBC STRING.LENGTH
 3120         STA LOWTR
 3130         INY
 3140         STA (FORPNT),Y
 3150         LDA LOWTR+1
 3160         SBC #0
 3170         STA LOWTR+1
 3180         INY
 3190         STA (FORPNT),Y
 3200  *--------------------------------
 3210  * NOW MOVE THE STRING TO ITS
 3220  * NEW ADDRESS.
 3230  *--------------------------------
 3240         LDY STRING.LENGTH
 3250  .3     DEY
 3260         LDA (FRESPC),Y
 3270         STA (LOWTR),Y
 3280         TYA
 3290         BNE .3       ...NOT FINISHED YET
 3300         BEQ .1       ...ALWAYS
 3310  *---FINISHED MOVING STRINGS------
 3320  .4     RTS
 3330  *--------------------------------
 3340  *   RESTORE NORMAL CONFIGURATION OF PNTR AND DATA
 3350  *      FOR STRINGS OF 1 OR 2 CHARACTERS
 3360  *
 3370  *      SCAN THRU VARIABLE SPACE AGAIN:
 3380  *          DESCRIPTORS OF STRINGS MARKED WITH $FF
 3390  *          CONTAIN THE CHAR(S) TO RESTORE TO POOL.
 3400  *
 3410  *      FRESPC POINTS AT BOTTOM OF POOL
 3420  *      LOWTR POINTS AT DESCRIPTORS
 3430  *--------------------------------
 3440  FIX.SHORT.STRINGS
 3450         JSR INITIATE.SEARCH
 3460  .1     JSR FIND.NEXT.STRING.VARIABLE
 3470         BCS .5       ...FINISHED!
 3480         LDY #2       POINT AT 3RD BYTE, 2ND OF ADDR
 3490         STY STRING.LENGTH
 3500         LDA (LOWTR),Y     IF 3RD BYTE =$FF, SHORTY.
 3510         CMP #$FF     A SHORTY?
 3520         BNE .1       ...NO, KEEP SCANNING VARIABLES
 3530         DEY          ...YES, POINT AT 2ND BYTE
 3540         LDA (LOWTR),Y     IF 2ND BYTE ALSO $FF, 
 3550         PHA               THEN LEN=1
 3560         BPL .2       ...NOT $FF, ITS A STR CHAR
 3570         DEC STRING.LENGTH
 3580  .2     DEY          POINT AT 1ST BYTE OF DESCRIPTOR
 3590         LDA (LOWTR),Y     GET 1ST ASC CHAR OF STRING
 3600         PHA               SAVE ON STACK
 3610  *---CALC PLACE IN POOL FOR DATA--
 3620         SEC
 3630         LDA FRESPC   REPOINT FRESPC
 3640         SBC STRING.LENGTH
 3650         STA FRESPC
 3660         BCS .3
 3670         DEC FRESPC+1
 3680  *---RESTORE LENGTH TO DESC.------
 3690  .3     LDA STRING.LENGTH
 3700         STA (LOWTR),Y
 3710  *---STORE CHARS INTO POOL--------
 3720  *--AND ADDR INTO DESCRIPTOR------
 3730         PLA          FIRST CHAR
 3740         STA (FRESPC),Y
 3750         INY
 3760         LDA FRESPC   LOBYTE OF ADDR
 3770         STA (LOWTR),Y
 3780         PLA          2ND CHAR
 3790         BMI .4       ...IT IS $FF, ONLY 1 CHAR
 3800         STA (FRESPC),Y
 3810  .4     INY
 3820         LDA FRESPC+1 HIBYTE OF ADDR
 3830         STA (LOWTR),Y
 3840         BNE .1       ALWAYS
 3850  *---ALL FINISHED WITH SHORTIES---
 3860  .5     RTS
 3870  *--------------------------------
 3880  *      STRING POOL STROLL
 3890  *--------------------------------
 3900  SET.STRING.POOL.STROLL
 3910         LDX MEMSIZE+1 POINT FRESPC
 3920         LDA MEMSIZE   AT HIMEM
 3930         STA FRESPC    TO START
 3940         STX FRESPC+1  STROLL.
 3950         RTS
 3960  *--------------------------------
 3970  *   SEARCH STRING POOL FROM TOP TO BOTTOM
 3980  *      FOR A NEGATIVE BYTE.
 3990  *
 4000  *      RETURN .CS. IF NEG BYTE FOUND,
 4010  *             .CC. IF REACHED END OF POOL
 4020  *--------------------------------
 4030  FIND.NEXT.NEG.BYTE.IN.POOL
 4040         LDX FRESPC+1
 4050         LDY FRESPC
 4060         LDA #0       PAGE AT A TIME
 4070         STA FRESPC
 4080         TYA          IS IT ZERO?
 4090         BNE .2       NO!
 4100  .1     DEX          YES
 4110         CPX FRETOP+1 STILL IN POOL?
 4120         BCC .5       ...NO
 4130         STX FRESPC+1 DO NEXT PAGE
 4140  .2     DEY
 4150         BEQ .3 
 4160         LDA (FRESPC),Y
 4170         BPL .2       POS ASCII
 4180         BMI .4       NEG SO QUIT
 4190  .3     LDA (FRESPC),Y
 4200         BPL .1 NEW PAGE
 4210  .4     CPX FRETOP+1
 4220         BNE .5       FRESPC>FRETOP
 4230         CPY FRETOP   FOR CARRY FLAG
 4240  .5     STY FRESPC   FRESPC POINTS TO NEG ASC
 4250         RTS
 4260  *--------------------------------
 4270  *   SET UP SEARCH OF VAR TABLE
 4280  *--------------------------------
 4290  INITIATE.SEARCH
 4300         LDA VARTAB   START AT BEGINNING OF VARIABLES
 4310         STA INDEX
 4320         LDX VARTAB+1
 4330         STX INDEX+1
 4340         LDY #7       EACH VAR TAKES 7 BYTES
 4350         STY OFFSET
 4360         RTS
 4370  *--------------------------------
 4380  *   FIND NEXT STRING VARIABLE
 4390  *--------------------------------
 4400  FIND.NEXT.STRING.VARIABLE
 4410  .1     LDX INDEX+1   SETUP SEARCH FOR NEXT STRING
 4420         LDA INDEX
 4430         LDY OFFSET
 4440         CPY #7       STILL IN SIMPLE VARIABLES?
 4450         BNE .4       ...NO, IN ARRAYS
 4460         CPX ARYTAB+1 WE WERE, CHECK FURTHER...
 4470         BCC .2       ...YES, STILL SIMPLE
 4480         CMP ARYTAB
 4490         BCS .3       ...NO
 4500  .2     JSR IS.THIS.A.STRING.VARIABLE
 4510         BCS .8       ...STRING FOUND
 4520         JSR NXTEL    NOT A STRING
 4530         BCC .1       ...ALWAYS, TRY AGAIN
 4540  .3     LSR OFFSET   SET OFFSET TO 3 NOW
 4550         STA ARRAY.END
 4560         STX ARRAY.END+1
 4570  .4     CPX ARRAY.END+1 INSIDE AN ARRAY?
 4580         BCC .8       ...YES
 4590         CMP ARRAY.END
 4600         BCC .8
 4610         CPX STREND+1 STILL IN VAR SPC?
 4620         BCC .5       ...YES
 4630         CMP STREND
 4640         BCC .5       ...YES
 4650         RTS          CARRY SET WHEN THRU VAR SPC
 4660  *---SET UP A NEW ARRAY-----------
 4670  .5     LDY #2
 4680         CLC
 4690         LDA (INDEX),Y
 4700         ADC INDEX
 4710         STA ARRAY.END   POINTER TO
 4720         INY          NEXT ARRAY
 4730         LDA (INDEX),Y
 4740         ADC INDEX+1
 4750         STA ARRAY.END+1
 4760         JSR IS.THIS.A.STRING.VARIABLE IS THIS A STR?
 4770         BCS .6       ...YES
 4780         LDA ARRAY.END
 4790         STA INDEX    NO
 4800         LDX ARRAY.END+1
 4810         STX INDEX+1
 4820         BNE .4       ...ALWAYS
 4830  *---FOUND STRING ARRAY-----------
 4840  .6     LDY #4       POINT AT
 4850         LDA (INDEX),Y     #DIMENSIONS OF ARRAY
 4860         ASL          *2
 4870         ADC #5
 4880         ADC INDEX    POINT INDEX TO
 4890         STA INDEX    FIRST ELEMENT
 4900         BCC .7       OF NEW ARRAY
 4910         INC INDEX+1
 4920  .7     LDX INDEX+1
 4930  *
 4940  .8     STA LOWTR    LOWTR->STR DESCRIPTOR
 4950         STX LOWTR+1
 4960  *---NEXT VARIABLE----------------
 4970  NXTEL  CLC
 4980         LDA OFFSET   POINT INDEX TO
 4990         ADC INDEX    NEXT VAR OR ELEMENT
 5000         STA INDEX
 5010         BCC .1 
 5020         INC INDEX+1
 5030         CLC
 5040  .1     RTS          STR FOUND,CARRY CLEAR
 5050  *--------------------------------
 5060  * SUBROUTINE STRING CHECK
 5070  *--------------------------------
 5080  IS.THIS.A.STRING.VARIABLE
 5090         LDY #0
 5100         CLC          INCASE NOT STR
 5110         LDA (INDEX),Y
 5120         BMI .2       ...NOT STRING
 5130         INY
 5140         LDA (INDEX),Y
 5150         BPL .2       ...NOT STRING
 5160         LDA #2       POINT PAST STR NAME
 5170         ADC INDEX
 5180         BCC .1       ...STRING
 5190         INX          INDEX+1
 5200  .1     SEC          CARRY SET IF STR FOUND
 5210  .2     RTS
 5220  *--------------------------------

