--- /dev/null
+TITLE MODIFIED AFREE FOR MUDDLE\r
+\r
+RELOCATABLE\r
+\r
+.INSRT MUDDLE >\r
+\r
+.GLOBAL CAFREE,CAFRET,PARNEW,AGC,PARBOT,CODTOP,CAFRE1\r
+.GLOBAL STOGC,STOSTR,CAFRE,ISTOST,STOLST,SAT,ICONS,BYTDOP\r
+.GLOBAL FLIST,STORIC\r
+MFUNCTION FREEZE,SUBR\r
+\r
+ ENTRY 1\r
+\r
+ GETYP A,(AB) ; get type of it\r
+ PUSH TP,(AB) ; save a copy\r
+ PUSH TP,1(AB)\r
+ PUSH P,[0] ; flag for tupel freeze\r
+ PUSHJ P,SAT ; to SAT\r
+ MOVEI B,0 ; final type\r
+ CAIN A,SNWORD ; check valid types\r
+ MOVSI B,TUVEC ; use UVECTOR\r
+ CAIN A,S2NWOR\r
+ MOVSI B,TVEC\r
+ CAIN A,SARGS\r
+ MOVSI B,TVEC\r
+ CAIN A,SCHSTR\r
+ MOVSI B,TCHSTR\r
+ JUMPE B,WTYP1\r
+ PUSH P,B ; save final type\r
+ CAME B,$TCHSTR ; special chars hack\r
+ JRST OK.FR\r
+ HRR B,(AB) ; fixup count\r
+ MOVEM B,(P)\r
+\r
+ MOVEI C,(TB) ; point to it\r
+ PUSHJ P,BYTDOP ; A==> points to dope word\r
+ HRRO B,1(TB)\r
+ SUBI A,1(B) ; A==> length of block\r
+ TLC B,-1(A)\r
+ MOVEM B,1(TB) ; and save\r
+ MOVSI 0,TUVEC\r
+ MOVEM 0,(TB)\r
+\r
+OK.FR: HLRE A,1(TB) ; get length\r
+ MOVNS A\r
+ PUSH P,A\r
+ ADDI A,2\r
+ PUSHJ P,CAFREE ; get storage\r
+ HRLZ B,1(TB) ; set up to BLT\r
+ HRRI B,(A)\r
+ POP P,C\r
+ ADDI C,(A) ; compute end\r
+ BLT B,(C)\r
+ MOVEI B,(A)\r
+ HLL B,1(AB)\r
+ POP P,A\r
+ JRST FINIS\r
+\r
+ \r
+CAFRE: PUSH P,A\r
+ HRRZ E,STOLST+1(TVP)\r
+ SETZB C,D\r
+ PUSHJ P,ICONS ; get list element\r
+ PUSH TP,$TLIST ; and save\r
+ PUSH TP,B\r
+ MOVE A,(P) ; restore length\r
+ ADDI A,2 ; 2 more for dope words\r
+ PUSHJ P,CAFREE ; get the core and dope words\r
+ POP P,B ; restore count\r
+ MOVNS B ; build AOBJN pointer\r
+ MOVSI B,(B)\r
+ HRRI B,(A)\r
+ MOVE C,(TP)\r
+ MOVEM B,1(C) ; save on list\r
+ MOVSI 0,TSTORA ; and type\r
+ HLLM 0,(C)\r
+ HRRZM C,STOLST+1(TVP) ; and save as new list\r
+ SUB TP,[2,,2]\r
+ POPJ P,\r
+ \r
+CAFRE1: PUSH P,A\r
+ ADDI A,2\r
+ PUSHJ P,CAFREE\r
+ HRROI B,(A) ; pointer to B\r
+ POP P,A ; length back\r
+ TLC B,-1(A)\r
+ POPJ P,\r
+\r
+CAFREE: IRP AC,,[B,C,D,E]\r
+ PUSH P,AC\r
+ TERMIN\r
+ SKIPG A ; make sure arg is a winner\r
+ FATAL BAD CALL TO CAFREE\r
+ MOVSI A,(A) ; count to left half for search\r
+ MOVEI B,FLIST ; get first pointer\r
+ HRRZ C,(B) ; c points to next block\r
+CLOOP: CAMG A,(C) ; skip if not big enough\r
+ JRST CONLIS ; found one\r
+ MOVEI D,(B) ; save in case fall out\r
+ MOVEI B,(C) ; point to new previous\r
+ HRRZ C,(C) ; next block\r
+ JUMPN C,CLOOP ; go on through loop\r
+ HLRZ E,A ; count to E\r
+ CAMGE E,STORIC ; skip if a area or more\r
+ MOVE E,STORIC ; else use a whole area\r
+ MOVE C,PARBOT ; foun out if any funny space\r
+ SUB C,CODTOP ; amount around to C\r
+ CAMLE C,E ; skip if must GC\r
+ JRST CHAVIT ; already have it\r
+ SUBI E,-1(C) ; get needed from agc\r
+ MOVEM E,PARNEW ; funny arg to AGC\r
+ PUSH P,A\r
+ MOVE C,[7,,6] ; SET UP AGC INDICATORS\r
+ PUSHJ P,AGC ; collect that garbage\r
+ SETZM PARNEW ; dont do it again\r
+ AOJL A,GCLOS ; couldn't get core\r
+ POP P,A\r
+\r
+; Make sure pointers still good after GC\r
+\r
+ MOVEI D,FLIST\r
+ HRRZ B,(D)\r
+\r
+ HRRZ E,(B) ; next pointer\r
+ JUMPE E,.+4 ; end of list ok\r
+ MOVEI D,(B)\r
+ MOVEI B,(E)\r
+ JRST .-4 ; look at next\r
+\r
+CHAVIT: MOVE E,PARBOT ; find amount obtained\r
+ SUBI E,1 ; dont use a real pair\r
+ MOVEI C,(E) ; for reset of CODTOP\r
+ SUB E,CODTOP\r
+ EXCH C,CODTOP ; store it back\r
+ CAIE B,(C) ; did we simply grow the last block?\r
+ JRST CSPLIC ; no, splice it in\r
+ HLRZ C,(B) ; length of old guy\r
+ ADDI C,(E) ; total length\r
+ ADDI B,(E) ; point to new last dope word\r
+ HRLZM C,(B) ; clobber final length in\r
+ HRRM B,(D) ; and splice into free list\r
+ MOVEI C,(B) ; reset acs for reentry into loop\r
+ MOVEI B,(D)\r
+ JRST CLOOP\r
+\r
+; Here to splice new core onto end of list.\r
+\r
+CSPLIC: MOVE C,CODTOP ; point to end of new block\r
+ HRLZM E,(C) ; store length of new block in dope words\r
+ HRRM C,(D) ; D is old previous, link it up\r
+ MOVEI B,(D) ; and reset B for reentry into loop\r
+ JRST CLOOP\r
+\r
+; here if an appropriate block is on the list\r
+\r
+CONLIS: HLRZS A ; count back to a rh\r
+ HLRZ D,(C) ; length of proposed block to D\r
+ CAIN A,(D) ; skip if they are different\r
+ JRST CEASY ; just splice it out\r
+ MOVEI B,(C) ; point to block to be chopped up\r
+ SUBI B,-1(D) ; point to beginning of same\r
+ SUBI D,(A) ; amount of block to be left to D\r
+ HRLM D,(C) ; and fix up dope words\r
+ ADDI B,-1(A) ; point to end of same\r
+ HRLZM A,(B)\r
+ HRRM B,(B) ; for GC benefit\r
+\r
+CFREET: CAIE A,1 ; if more than 1\r
+ SETZM -1(B) ; make tasteful dope worda\r
+ SUBI B,-1(A)\r
+ MOVEI A,(B)\r
+ IRP AC,,[E,D,C,B]\r
+ POP P,AC\r
+ TERMIN\r
+ POPJ P,\r
+\r
+CEASY: MOVEI D,(C) ; point to block to return\r
+ HRRZ C,(C) ; point to next of same\r
+ HRRM C,(B) ; smash its previous\r
+ MOVEI B,(D) ; point to block with B\r
+ HRRM B,(B) ; for GC benefit\r
+ JRST CFREET\r
+\r
+GCLOS: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE NO-MORE-STORAGE\r
+ JRST CALER1\r
+\r
+CAFRET: HRROI B,(B) ; prepare to search list\r
+ TLC B,-1(A) ; by making an AOBJN pointer\r
+ HRRZ C,STOLST+1(TVP) ; start of list\r
+ MOVEI D,STOLST+1(TVP)\r
+\r
+CAFRTL: JUMPE C,CPOPJ ; not founc\r
+ CAME B,1(C) ; this it?\r
+ JRST CAFRT1\r
+ HRRZ C,(C) ; yes splice it out\r
+ HRRM C,(D) ; smash it\r
+CPOPJ: POPJ P, ; dont do anything now\r
+\r
+CAFRT1: MOVEI D,(C)\r
+ HRRZ C,(C)\r
+ JRST CAFRTL\r
+\r
+; Here from GC to collect all unused blocks into free list\r
+\r
+STOGC: SETZB C,E ; zero current length and pointer\r
+ MOVE A,CODTOP ; get high end of free space\r
+\r
+STOGCL: CAIG A,STOSTR ; end?\r
+ JRST STOGCE ; yes, cleanup and leave\r
+\r
+ HLRZ 0,(A) ; get length\r
+ ANDI 0,377777\r
+ SKIPGE (A) ; skip if a not used block\r
+ JRST STOGC1 ; jump if marked\r
+\r
+ JUMPE C,STOGC3 ; jump if no block under construction\r
+ ADD C,0 ; else add this length to current\r
+ JRST STOGC4\r
+\r
+STOGC3: MOVEI B,(A) ; save pointer\r
+ MOVE C,0 ; init length\r
+\r
+STOGC4: SUB A,0 ; point to next block\r
+ JRST STOGCL\r
+\r
+STOGC1: ANDCAM D,(A) ; kill mark bit\r
+ JUMPE C,STOGC4 ; if no block under cons, dont fix\r
+ HRLM C,(B) ; store total block length\r
+ HRRM E,(B) ; next pointer hooked in\r
+ MOVEI E,(B) ; new next pointer\r
+ MOVEI C,0\r
+ JRST STOGC4\r
+\r
+STOGCE: JUMPE C,STGCE1 ; jump if no current block\r
+ HRLM C,(B) ; smash in count\r
+ HRRM E,(B) ; smash in next pointer\r
+ MOVEI E,(B) ; and setup E\r
+\r
+STGCE1: HRRZM E,FLIST+1 ; final link up\r
+ POPJ P,\r
+\r
+IMPURE\r
+\r
+FLIST: .+1\r
+ ISTOST\r
+\r
+PURE\r
+\r
+END\r
+\f\r
projects / pdp10-muddle.git / blobdiff