X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Fnfree.mid.53;fp=%3Cmdl.int%3E%2Fnfree.mid.53;h=be431d4f89ff65ddb201b1c4f040807d528af437;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c diff --git a//nfree.mid.53 b//nfree.mid.53 new file mode 100644 index 0000000..be431d4 --- /dev/null +++ b//nfree.mid.53 @@ -0,0 +1,281 @@ + +TITLE MODIFIED AFREE FOR MUDDLE + +RELOCATABLE + +.INSRT MUDDLE > + +.GLOBAL CAFREE,CAFRET,PARNEW,AGC,PARBOT,CODTOP,CAFRE1 +.GLOBAL STOGC,STOSTR,CAFRE,ISTOST,STOLST,SAT,ICONS,BYTDOP +.GLOBAL FLIST,STORIC,GPURFL,GCDANG,PVSTOR,SPSTOR +.GLOBAL %CLNCO + +MFUNCTION FREEZE,SUBR + + ENTRY 1 + + GETYP A,(AB) ; get type of it + PUSH TP,(AB) ; save a copy + PUSH TP,1(AB) + PUSH P,[0] ; flag for tupel freeze + PUSHJ P,SAT ; to SAT + MOVEI B,0 ; final type + CAIN A,SNWORD ; check valid types + MOVSI B,TUVEC ; use UVECTOR + CAIN A,S2NWOR + MOVSI B,TVEC + CAIN A,SARGS + MOVSI B,TVEC + CAIN A,SCHSTR + MOVSI B,TCHSTR + CAIN A,SBYTE + MOVEI B,TBYTE + JUMPE B,WTYP1 + PUSH P,B ; save final type + CAMN B,$TBYTE + JRST .+3 + CAME B,$TCHSTR ; special chars hack + JRST OK.FR + HRR B,(AB) ; fixup count + MOVEM B,(P) + + MOVEI C,(TB) ; point to it + PUSHJ P,BYTDOP ; A==> points to dope word + HRRO B,1(TB) + SUBI A,1(B) ; A==> length of block + TLC B,-1(A) + MOVEM B,1(TB) ; and save + MOVSI 0,TUVEC + MOVEM 0,(TB) + +OK.FR: HLRE A,1(TB) ; get length + MOVNS A + PUSH P,A + ADDI A,2 + PUSHJ P,CAFREE ; get storage + HRLZ B,1(TB) ; set up to BLT + HRRI B,(A) + POP P,C + ADDI C,(A) ; compute end + BLT B,(C) + HLLOS 1(C) ; INDICATION IN RELOCATION FIELD THAT ITS NOT GARBAGE + MOVEI B,(A) + HLL B,1(AB) + POP P,A + JRST FINIS + + +CAFRE: PUSH P,A + HRRZ E,STOLST+1 + SETZB C,D + PUSHJ P,ICONS ; get list element + PUSH TP,$TLIST ; and save + PUSH TP,B + MOVE A,(P) ; restore length + ADDI A,2 ; 2 more for dope words + PUSHJ P,CAFREE ; get the core and dope words + POP P,B ; restore count + MOVNS B ; build AOBJN pointer + MOVSI B,(B) + HRRI B,(A) + MOVE C,(TP) + MOVEM B,1(C) ; save on list + MOVSI 0,TSTORA ; and type + HLLM 0,(C) + HRRZM C,STOLST+1 ; and save as new list + SUB TP,[2,,2] + POPJ P, + +CAFRE1: PUSH P,A + ADDI A,2 + PUSHJ P,CAFREE + HRROI B,(A) ; pointer to B + POP P,A ; length back + TLC B,-1(A) + POPJ P, + +CAFREE: IRP AC,,[B,C,D,E] + PUSH P,AC + TERMIN + SKIPG A ; make sure arg is a winner + FATAL BAD CALL TO CAFREE + MOVSI A,(A) ; count to left half for search + MOVEI B,FLIST ; get first pointer + HRRZ C,(B) ; c points to next block +CLOOP: CAMG A,(C) ; skip if not big enough + JRST CONLIS ; found one + MOVEI D,(B) ; save in case fall out + MOVEI B,(C) ; point to new previous + HRRZ C,(C) ; next block + JUMPN C,CLOOP ; go on through loop + HLRZ E,A ; count to E + CAMGE E,STORIC ; skip if a area or more + MOVE E,STORIC ; else use a whole area + MOVE C,PARBOT ; found out if any funny space + SUB C,CODTOP ; amount around to C + EXCH B,D + CAMLE C,E ; skip if must GC + JRST CHAVIT ; already have it + SUBI E,-1(C) ; get needed from agc + MOVEM E,PARNEW ; funny arg to AGC + PUSH P,A + MOVE C,[7,,6] ; SET UP AGC INDICATORS + SKIPE GPURFL ; DONT GC IF IN DUMPER + JRST PURGC + PUSHJ P,AGC ; collect that garbage + SETZM PARNEW ; dont do it again + POP P,A + +; Make sure pointers still good after GC + + MOVEI B,FLIST + HRRZ D,(B) + + HRRZ E,(D) ; next pointer + JUMPE E,.+4 ; end of list ok + MOVEI B,(D) + MOVEI D,(E) + JRST .-4 ; look at next + +CHAVIT: MOVE C,CODTOP + MOVE E,PARBOT + PUSHJ P,%CLNCO ; flush extra pages + MOVE E,PARBOT ; find amount obtained + SUBI E,1 ; dont use a real pair + MOVEI C,(E) ; for reset of CODTOP + SUB E,CODTOP + EXCH C,CODTOP ; store it back + CAIE B,(C) ; did we simply grow the last block? + JRST CSPLIC ; no, splice it in + HLRZ C,(B) ; length of old guy + ADDI C,(E) ; total length + ADDI B,(E) ; point to new last dope word + HRLZM C,(B) ; clobber final length in + HRRM B,(D) ; and splice into free list + MOVEI C,(B) ; reset acs for reentry into loop + MOVEI B,(D) + JRST CLOOP + +; Here to splice new core onto end of list. + +CSPLIC: MOVE C,CODTOP ; point to end of new block + HRLZM E,(C) ; store length of new block in dope words + HRRM C,(D) ; D is old previous, link it up + MOVEI B,(D) ; and reset B for reentry into loop + JRST CLOOP + +; here if an appropriate block is on the list + +CONLIS: HLRZS A ; count back to a rh + HLRZ D,(C) ; length of proposed block to D + CAIN A,(D) ; skip if they are different + JRST CEASY ; just splice it out + MOVEI B,(C) ; point to block to be chopped up + SUBI B,-1(D) ; point to beginning of same + SUBI D,(A) ; amount of block to be left to D + HRLM D,(C) ; and fix up dope words + ADDI B,-1(A) ; point to end of same + HRLZM A,(B) + HRRM B,(B) ; for GC benefit + +CFREET: CAIE A,1 ; if more than 1 + SETZM -1(B) ; make tasteful dope worda + SUBI B,-1(A) + MOVEI A,(B) +ACRST: IRP AC,,[E,D,C,B] + POP P,AC + TERMIN + POPJ P, + +PURGC: SUB P,[1,,1] ; CLEAN OFF STACK + SETOM GCDANG ; INDICATE GC SHOULD HAVE OCCURED + JRST ACRST + +CEASY: MOVEI D,(C) ; point to block to return + HRRZ C,(C) ; point to next of same + HRRM C,(B) ; smash its previous + MOVEI B,(D) ; point to block with B + HRRM B,(B) ; for GC benefit + JRST CFREET + +CAFRET: HRROI B,(B) ; prepare to search list + TLC B,-1(A) ; by making an AOBJN pointer + HRRZ C,STOLST+1 ; start of list + MOVEI D,STOLST+1 + +CAFRTL: JUMPE C,CPOPJ ; not founc + CAME B,1(C) ; this it? + JRST CAFRT1 + HRRZ C,(C) ; yes splice it out + HRRM C,(D) ; smash it +CPOPJ: POPJ P, ; dont do anything now + +CAFRT1: MOVEI D,(C) + HRRZ C,(C) + JRST CAFRTL + +; Here from GC to collect all unused blocks into free list + +STOGC: SETZB C,E ; zero current length and pointer + MOVE A,CODTOP ; get high end of free space + +STOGCL: CAIG A,STOSTR ; end? + JRST STOGCE ; yes, cleanup and leave + + HLRZ 0,(A) ; get length + ANDI 0,377777 + SKIPGE (A) ; skip if a not used block + JRST STOGC1 ; jump if marked + +; HERE TO SEE WHETHER AN UNMARKED ITEM IS AN ATOM. IF IT IS IT IS NOT GARBAGE +; AND IT IS PRESERVED WITH ITS VALUE CELLS FLUSHED + + HLRZ 0,-1(A) ; GET TYPE OF FIRST D.W. + ANDI 0,TYPMSK ; FLUSH MONITORS + CAIE 0,SATOM + JRST STOGC5 ; NOT AN ATOM COLLECT THE GARBAGE + PUSH P,A ; SAVE PTR TO D.W. + HLRZ 0,(A) + SUB A,0 ; POINT TO JUST BEFORE ATOM + SETZM 1(A) ; ZERO VALUE CELLS + SETZM 2(A) + POP P,A ; RESTORE A + JRST STOGC1 + +STOGC5: HLRZ 0,(A) + JUMPE C,STOGC3 ; jump if no block under construction + ADD C,0 ; else add this length to current + JRST STOGC4 + +STOGC3: MOVEI B,(A) ; save pointer + MOVE C,0 ; init length + +STOGC4: SUB A,0 ; point to next block + JRST STOGCL + +STOGC1: HLLOS (A) ; -1 IS INDICATOR OF FREE SLOT + ANDCAM D,(A) ; kill mark bit + JUMPE C,STOGC4 ; if no block under cons, dont fix + HRLM C,(B) ; store total block length + HRRM E,(B) ; next pointer hooked in + MOVEI E,(B) ; new next pointer + MOVEI C,0 + JRST STOGC4 + +STOGCE: JUMPE C,STGCE1 ; jump if no current block + HRLM C,(B) ; smash in count + HRRM E,(B) ; smash in next pointer + MOVEI E,(B) ; and setup E + +STGCE1: HRRZM E,FLIST+1 ; final link up + POPJ P, + +IMPURE + +FLIST: .+1 + ISTOST + +PURE + +END + \ No newline at end of file