--- /dev/null
+TITLE PURE-PAGE LOADER\r
+\r
+RELOCATABLE\r
+\r
+MAPCH==0 ; channel for MAPing\r
+ELN==3 ; Length of table entry\r
+\r
+.GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN\r
+.GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF\r
+\r
+.INSRT MUDDLE >\r
+\r
+SYSQ\r
+\r
+IFE ITS,[\r
+IF1, .INSRT STENEX >\r
+]\r
+\r
+IFN ITS,[\r
+PURDIR==SIXBIT /MUD50/ ; directory containing pure pages\r
+OPURDI==SIXBIT /MHILIB/\r
+OFIXDI==SIXBIT /MHILIB/\r
+FIXDIR==SIXBIT /MUD50/\r
+ARC==1 ; flag saying fixups on archive\r
+]\r
+IFN ITS,[\r
+PGMSK==1777\r
+PGSHFT==10.\r
+]\r
+IFE ITS,[\r
+PGMSK==777\r
+PGSHFT==9.\r
+]\r
+\r
+; This routine taskes a slot offset in register A and\r
+; maps in the associated file. It clobbers all ACs\r
+; It skip returns if it wins.\r
+\r
+PLOAD: PUSH P,A ; save slot offset\r
+ ADD A,PURVEC+1(TVP) ; point into pure vector\r
+ MOVE B,(A) ; get sixbit of name\r
+IFN ITS,[\r
+ MOVE C,MUDSTR+2 ; get version number\r
+ PUSHJ P,CSIXBT ; vers # to six bit\r
+ HRRI C,(SIXBIT /SAV/)\r
+ MOVSS C\r
+ .SUSET [.RSNAM,,0] ; GET CURRENT SNAME TO 0\r
+ .SUSET [.SSNAM,,[PURDIR]] ; get sname for it\r
+ MOVE A,[SIXBIT / &DSK/] ; build open block\r
+ .OPEN MAPCH,A ; try to open file\r
+ JRST FIXITU ; no current version, fix one up\r
+ PUSH P,0 ; for compat wit tenex and save old sname\r
+ DOTCAL FILLEN,[[1000,,MAPCH],[2000,,A]]\r
+ JRST MAPLOS\r
+ ADDI A,PGMSK ; in case not even # of pages\r
+ ASH A,-PGSHFT ; to pages\r
+ PUSH P,A ; save the length\r
+]\r
+IFE ITS,[\r
+ MOVE E,P ; save pdl base\r
+ PUSH P,[0] ; slots for building strings\r
+ PUSH P,[0]\r
+ MOVE A,[440700,,1(E)]\r
+ MOVE C,[440600,,B]\r
+ MOVEI D,6\r
+ ILDB 0,C\r
+ JUMPE 0,.+4 ; violate cardinal ".+ rule"\r
+ ADDI 0,40 ; to ASCII\r
+ IDPB 0,A\r
+ SOJG D,.-4\r
+\r
+ PUSH P,[ASCII / SAV/]\r
+ MOVE C,MUDSTR+2 ; get ascii of vers no.\r
+ IORI C,1 ; hair to change r.o. to space\r
+ MOVE 0,C\r
+ ADDI C,1\r
+ ANDCM C,0 ; C has 1st 1\r
+ JFFO C,.+3\r
+ MOVEI 0,0 ; use zer name\r
+ JRST ZER...\r
+ MOVEI C,(D)\r
+ IDIVI C,7\r
+ AND 0,MSKS(C) ; get rid of r.o.s\r
+ZER...: PUSH P,0\r
+ MOVEI B,-1(P) ; point to it\r
+ HRLI B,260700\r
+ HRROI D,1(E) ; point to name\r
+ MOVEI A,1(P)\r
+\r
+ PUSH P,[100000,,]\r
+ PUSH P,[377777,,377777]\r
+ PUSH P,[-1,,[ASCIZ /DSK/]]\r
+ PUSH P,[-1,,[ASCIZ /MUDLIB/]]\r
+ PUSH P,D\r
+ PUSH P,B\r
+ PUSH P,[0]\r
+ PUSH P,[0]\r
+ PUSH P,[0]\r
+ MOVEI B,0\r
+ MOVE D,4(E) ; save final version string\r
+ GTJFN\r
+ JRST FIXITU\r
+\r
+ MOVE B,[440000,,240000]\r
+ OPENF\r
+ JRST FIXITU\r
+ MOVE P,E ; flush crap\r
+ PUSH P,A\r
+ SIZEF ; get length\r
+ JRST MAPLOS\r
+ PUSH P,C ; save # of pages\r
+ MOVEI A,(C)\r
+]\r
+ PUSHJ P,ALOPAG ; get the necessary pages\r
+ JRST MAPLS1\r
+ PUSH P,B ; save page number\r
+IFN ITS,[\r
+ MOVN A,-1(P) ; get neg count\r
+ MOVSI A,(A) ; build aobjn pointer\r
+ HRR A,(P) ; get page to start\r
+ MOVE B,A ; save for later\r
+ HLLZ 0,A ; page pointer for file\r
+ DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0]\r
+ JRST MAPLS3 ; total wipe out\r
+ .CLOSE MAPCH, ; no need to have file open anymore\r
+]\r
+IFE ITS,[\r
+ MOVE D,-1(P) ; # of pages to D\r
+ HRLI B,400000 ; specify this fork\r
+ HRROI E,(B) ; build page aobjn for later\r
+ TLC E,-1(D) ; sexy way of doing lh\r
+ HRLZ A,-2(P) ; JFN to lh of A\r
+ MOVSI C,120000 ; bits for read/execute\r
+\r
+ PMAP\r
+ ADDI A,1\r
+ ADDI B,1\r
+ SOJG D,.-3 ; map 'em all\r
+ MOVE A,-2(P)\r
+ CLOSF ; try to close file\r
+ JFCL ; ignore failure\r
+ MOVE B,E\r
+]\r
+\r
+; now try to smash slot in PURVEC\r
+\r
+PLOAD1: MOVE A,PURVEC+1(TVP) ; get pointer to it\r
+ ASH B,PGSHFT ; convert to aobjn pointer to words\r
+ MOVE C,-3(P) ; get slot offset\r
+ ADDI C,(A) ; point to slot\r
+ MOVEM B,1(C) ; clobber it in\r
+ ANDI B,-1 ; isolate address of page\r
+ HRRZ D,PURVEC(TVP) ; get offset into vector for start of chain\r
+ TRNE D,400000 ; skip if not end marker\r
+ JRST SCHAIN\r
+ HRLI D,A ; set up indexed pointer\r
+ ADDI D,1\r
+ HRRZ 0,@D ; get its address\r
+ JUMPE 0,SCHAIN ; no chain exists, start one\r
+ CAILE 0,(B) ; skip if new one should be first\r
+ AOJA D,INLOOP ; jump into the loop\r
+\r
+ SUBI D,1 ; undo ADDI\r
+FCLOB: MOVE E,-3(P) ; get offset for this guy\r
+ HRRM D,2(C) ; link up\r
+ HRRM E,PURVEC(TVP) ; store him away\r
+ JRST PLOADD\r
+\r
+SCHAIN: MOVEI D,400000 ; get end of chain indicator\r
+ JRST FCLOB ; and clobber it in\r
+\r
+INLOOP: MOVE E,D ; save in case of later link up\r
+ HRR D,@D ; point to next table entry\r
+ TRNE D,400000 ; 400000 is the end of chain bit\r
+ JRST SLFOUN ; found a slot, leave loop\r
+ ADDI D,1 ; point to address of progs\r
+ HRRZ 0,@D ; get address of block\r
+ CAILE 0,(B) ; skip if still haven't fit it in\r
+ AOJA D,INLOOP ; back to loop start and point to chain link\r
+ SUBI D,1 ; point back to start of slot\r
+\r
+SLFOUN: MOVE 0,-3(P) ; get offset into vector of this guy\r
+ HRRM 0,@E ; make previous point to us\r
+ HRRM D,2(C) ; link it in\r
+\r
+\r
+PLOADD: AOS -4(P) ; skip return\r
+\r
+MAPLS3: SUB P,[1,,1] ; flush stack crap\r
+MAPLS1: SUB P,[1,,1]\r
+MAPLOS:\r
+IFN ITS,[\r
+ MOVE 0,(P)\r
+ .SUSET [.SSNAM,,0] ; restore SNAME\r
+]\r
+ SUB P,[2,,2]\r
+ POPJ P,\r
+\r
+; Here if no current version exists\r
+\r
+FIXITU: PUSH TP,$TFIX\r
+ PUSH TP,0 ; maybe save sname\r
+\r
+IFN ITS,[\r
+ PUSH P,C ; save final name\r
+ MOVE C,[SIXBIT /FIXUP/] ; name of fixup file\r
+IFN <PURDIR-OFIXDI>,.SUSET [.SSNAM,,[OFIXDI]]\r
+IFN ARC, HRRI A,(SIXBIT /ARC/)\r
+ .OPEN MAPCH,A\r
+IFE ARC, JRST MAPLOS\r
+IFN ARC, PUSHJ P,ARCLOS\r
+ MOVE 0,[-2,,A] ; prepare to read version and length\r
+ PUSH P,B ; save program name\r
+ .IOT MAPCH,0\r
+ SKIPGE 0\r
+ FATAL BAD FIXUP FILE\r
+ PUSH P,B ; save version number of fixup file\r
+ MOVEI A,-2(A) ; length -2 (for vers and length)\r
+ PUSHJ P,IBLOCK ; get a UVECTOR for the fixups\r
+ PUSH TP,$TUVEC ; and save\r
+ PUSH TP,B\r
+ MOVE A,B\r
+ MOVSI 0,TUVEC\r
+ MOVEM 0,ASTO(PVP) ; prepare for moby iot (interruptable)\r
+ ENABLE\r
+ .IOT MAPCH,A ; get fixups\r
+ DISABLE\r
+ .CLOSE MAPCH,\r
+ SETZM ASTO(PVP)\r
+ POP P,A ; restore version number\r
+ IDIVI A,100. ; get 100s digit in a rest in B\r
+ ADDI A,20 ; convert to sixbit\r
+ IDIVI B,10. ; B tens digit C 1s digit\r
+ ADDI B,20\r
+ ADDI C,20\r
+ MOVE 0,[220600,,D]\r
+ MOVSI D,(SIXBIT /SAV/)\r
+ CAIE A,20\r
+ IDPB A,0\r
+ CAIE B,20\r
+ IDPB B,0\r
+ IDPB C,0\r
+ MOVE B,[SIXBIT / &DSK/]\r
+ MOVE C,(P) ; program name\r
+IFN <OPURDI-OFIXDI>,.SUSET [.SSNAM,,[OPURDI]]\r
+ .OPEN MAPCH,B ; try for this one\r
+ JRST MAPLS1\r
+ DOTCAL FILLEN,[[1000,,MAPCH],[2000,,A]]\r
+ JRST MAPLS1\r
+ ADDI A,PGMSK ; in case not exact pages\r
+ ASH A,-PGSHFT ; to pages\r
+ PUSH P,A ; save\r
+ PUSHJ P,ALOPAG ; find some pages\r
+ JRST MAPLS4\r
+ MOVN A,(P) ; build aobjn pointer\r
+ MOVSI A,(A)\r
+ HRRI A,(B)\r
+ MOVE B,A\r
+ HLLZ 0,B\r
+ DOTCAL CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0]\r
+ JRST MAPLS4\r
+ SUB P,[1,,1]\r
+ .CLOSE MAPCH,\r
+]\r
+IFE ITS,[\r
+ PUSH TP,$TPDL ; save stack pointer\r
+ PUSH TP,E\r
+ PUSH P,D ; save vers string\r
+ HRROI A,[ASCIZ /FIXUP/]\r
+ MOVEM A,10.(E) ; into name slot\r
+ MOVEI A,5(E) ; point to arg block\r
+ SETZB B,C\r
+ GTJFN\r
+ JRST MAPLS4\r
+ MOVEI C,(A) ; save JFN in case OPNEF loses\r
+ MOVE B,[440000,,200000]\r
+ OPENF\r
+ JRST MAPLS4\r
+ BIN ; length of fixups to B\r
+ PUSH P,A ; save JFN\r
+ MOVEI A,-2(B) ; length of uvextor to get\r
+ PUSHJ P,IBLOCK\r
+ PUSH TP,$TUVEC\r
+ PUSH TP,B ; sav it\r
+ POP P,A ; restore JFN\r
+ BIN ; read in vers #\r
+ MOVE D,B ; save vers #\r
+ MOVE B,(TP)\r
+ HLRE C,B\r
+ HRLI B,444400\r
+ SIN ; read in entire fixups\r
+ CLOSF ; and close file of same\r
+ JFCL ; ignore cailure to close\r
+ HRROI C,1(E) ; point to name\r
+ MOVEM C,9.(E)\r
+ MOVEI C,3(E)\r
+ HRLI C,260700\r
+ MOVEM C,10.(E)\r
+ MOVE 0,[ASCII / /]\r
+ MOVEM 0,4(E) ; all spaces\r
+ MOVEI A,(D)\r
+ IDIVI A,100. ; to ascii\r
+ ADDI A,60\r
+ IDIVI B,10.\r
+ ADDI B,60\r
+ ADDI C,60\r
+ MOVE 0,[440700,,4(E)]\r
+ CAIE A,60\r
+ IDPB A,0\r
+ CAIE B,60\r
+ IDPB B,0\r
+ IDPB C,0\r
+ SETZB C,B\r
+ MOVEI A,5(E) ; ready for 'nother GTJFN\r
+ GTJFN\r
+ JRST MAPLS5\r
+ MOVEI C,(A) ; save JFN in case OPENF loses\r
+ MOVE B,[440000,,240000]\r
+ OPENF\r
+ JRST MAPLS5\r
+ SIZEF\r
+ JRST MAPLS5\r
+ PUSH P,A\r
+ PUSH P,C\r
+ MOVEI A,(C)\r
+ PUSHJ P,ALOPAG ; get the pages\r
+ JRST MAPLS5\r
+ MOVEI D,(B) ; save pointer\r
+ MOVN A,(P) ; build page aobjn pntr\r
+ HRLI D,(A)\r
+ EXCH D,(P) ; get length\r
+ HRLI B,400000\r
+\r
+ HRLZ A,-1(P) ; JFN for PMAP\r
+ MOVSI C,120400 ; bits for read/execute/copy-on-write\r
+\r
+ PMAP\r
+ ADDI A,1\r
+ ADDI B,1\r
+ SOJG D,.-3\r
+\r
+ HLRZS A\r
+ CLOSF\r
+ JFCL\r
+ POP P,B ; restore page #\r
+ SUB P,[1,,1]\r
+]\r
+; now to do fixups\r
+\r
+ MOVE A,(TP) ; pointer to them\r
+ ASH B,PGSHFT ; aobjn to program\r
+\r
+FIX1: SKIPL E,(A) ; read one hopefully squoze\r
+ FATAL ATTEMPT TO TYPE FIX PURE\r
+ TLZ E,740000\r
+ PUSHJ P,SQUTOA ; look it up\r
+ FATAL BAD FIXUPS\r
+\r
+ AOBJP A,FIX2\r
+ HLRZ D,(A) ; get old value\r
+ SUBM E,D ; D is diff between old and new\r
+ HRLM E,(A) ; fixup the fixups\r
+ MOVEI 0,0 ; flag for which half\r
+FIX4: JUMPE 0,FIXRH ; jump if getting rh\r
+ MOVEI 0,0 ; next time will get rh\r
+ AOBJP A,FIX2 ; done?\r
+ HLRZ C,(A) ; get lh\r
+ JUMPE C,FIX3 ; 0 terminates\r
+FIX5: ADDI C,(B) ; access the code\r
+ ADDM D,-1(C) ; and fix it up\r
+ JRST FIX4\r
+\r
+FIXRH: MOVEI 0,1 ; change flag\r
+ HRRZ C,(A) ; get it and\r
+ JUMPN C,FIX5\r
+\r
+FIX3: AOBJN A,FIX1 ; do next one\r
+\r
+FIX2:\r
+IFN ITS,[\r
+IFN <PURDIR-OPURDI> .SUSET [.SSNAM,,[PURDIR]]\r
+ .OPEN MAPCH,[SIXBIT / 'DSK_PURE_>/]\r
+ JRST MAPLS1\r
+ MOVE E,B ; save pointer\r
+ ASH E,-PGSHFT ; to page AOBJN\r
+ .IOT MAPCH,B ; write out the goodie\r
+ SETZB 0,A\r
+ MOVEI B,MAPCH\r
+ MOVE C,(P)\r
+ MOVE D,-1(P)\r
+ .FDELE 0 ; attempt to rename to right thing\r
+ JRST MAPLS1\r
+ .CLOSE MAPCH,\r
+ MOVE B,[SIXBIT / &DSK/]\r
+ .OPEN MAPCH,B\r
+ FATAL WHERE DID THE FILE GO?\r
+ HLLZ 0,E ; pointer to file pages\r
+ PUSH P,E ; SAVE FOR END\r
+ DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0]\r
+ FATAL LOSSAGE LOSSAGE PAGES LOST\r
+ .CLOSE MAPCH,\r
+\r
+ SKIPGE MUDSTR+2 ; skip if not experimental\r
+ JRST NOFIXO\r
+ PUSHJ P,GENVN ; get version number as a number\r
+ MOVE E,(TP)\r
+IFN <PURDIR-FIXDIR>,.SUSET [.SSNAM,,[FIXDIR]]\r
+IFE ARC, .OPEN MAPCH,[SIXBIT / 'DSK_FIXU_>/]\r
+IFN ARC, .OPEN MAPCH,[SIXBIT / 'ARC_FIXU_>/]\r
+IFE ARC, FATAL CANT WRITE FIXUPS\r
+IFN ARC, PUSHJ P,ARCFAT\r
+ HLRE A,E ; get length\r
+ MOVNS A\r
+ ADDI A,2 ; account for these 2 words\r
+ MOVE 0,[-2,,A] ; write version and length\r
+ .IOT MAPCH,0\r
+ .IOT MAPCH,E ; out go the fixups\r
+ SETZB 0,A\r
+ MOVEI B,MAPCH\r
+ MOVE C,-1(P)\r
+ MOVE D,[SIXBIT /FIXUP/]\r
+ .FDELE 0\r
+ FATAL FIXUP WRITE OUT FAILED\r
+ .CLOSE MAPCH,\r
+NOFIXO:\r
+]\r
+IFE ITS,[\r
+ MOVE E,-2(TP) ; restore P-stack base\r
+ MOVEI 0,600000 ; fixup args to GTJFN\r
+ HRLM 0,5(E)\r
+ MOVE D,B ; save page number\r
+ POP P,4(E) ; current version name in\r
+ MOVEI A,5(E) ; pointer ro arg block\r
+ MOVEI B,0\r
+ GTJFN\r
+ FATAL MAP FIXUP LOSSAGE\r
+ MOVE B,[440000,,100000]\r
+ OPENF\r
+ FATAL MAP FIXUP LOSSAGE\r
+ MOVEI B,(D) ; ready to write it out\r
+ HRLI B,444400\r
+ HLRE C,D\r
+ SOUT ; zap it out\r
+ TLO A,400000 ; dont recycle the JFN\r
+ CLOSF\r
+ JFCL\r
+ ANDI A,-1 ; kill sign bit\r
+ MOVE B,[440000,,240000]\r
+ OPENF\r
+ FATAL MAP FIXUP LOSSAGE\r
+ MOVE B,D\r
+ ASH B,-PGSHFT ; aobjn to pages\r
+ PUSH P,B\r
+ HLRE D,B ; -count\r
+ HRLI B,400000\r
+ MOVSI A,(A)\r
+ MOVSI C,120000\r
+\r
+ PMAP\r
+ ADDI A,1\r
+ ADDI B,1\r
+ AOJL D,.-3\r
+\r
+ HLRZS A\r
+ CLOSF\r
+ JFCL\r
+\r
+ HRROI 0,[ASCIZ /FIXUP/] ; now write out new fixup file\r
+ MOVEM 0,10.(E)\r
+ MOVEI A,5(E)\r
+ MOVEI B,0\r
+\r
+ SKIPGE MUDSTR+2\r
+ JRST NOFIXO ; exp vers, dont write out\r
+\r
+ PUSHJ P,GENVN\r
+ MOVEI D,(B) ; save vers in D\r
+ GTJFN\r
+ FATAL MAP FIXUP LOSSAGE\r
+ MOVE B,[440000,,100000]\r
+ OPENF\r
+ FATAL MAP FIXUP LOSSAGE\r
+ HLRE B,(TP) ; length of fixup vector\r
+ MOVNS B\r
+ ADDI B,2 ; for length and version words\r
+ BOUT\r
+ MOVE B,D ; and vers #\r
+ BOUT\r
+ MOVSI B,444400 ; byte pointer to fixups\r
+ HRR B,(TP)\r
+ HLRE C,(TP)\r
+ SOUT\r
+ CLOSF\r
+ JFCL\r
+NOFIXO: MOVE A,(P) ; save aobjn to pages\r
+ MOVE P,-2(TP)\r
+ SUB TP,[2,,2]\r
+ PUSH P,A\r
+]\r
+ HRRZ A,(P) ; get page #\r
+ HLRE C,(P) ; and # of same\r
+ MOVE B,(P) ; set B up for return\r
+ MOVNS C\r
+IFN ITS,[\r
+ SUB P,[2,,2]\r
+ MOVE 0,-2(TP) ; saved sname\r
+ MOVEM 0,(P)\r
+]\r
+ PUSH P,C\r
+ PUSH P,A\r
+ SUB TP,[4,,4]\r
+ JRST PLOAD1\r
+\r
+IFN ITS,[\r
+MAPLS4: .CLOSE MAPCH,\r
+ SUB P,[1,,1]\r
+ JRST MAPLS1\r
+]\r
+IFE ITS,[\r
+MAPLS4: SKIPA A,[4,,4]\r
+MAPLS5: MOVE A,[6,,6]\r
+ MOVE P,E\r
+ SUB TP,A\r
+ SKIPE A,C\r
+ CLOSF\r
+ JFCL\r
+ JRST MAPLOS\r
+]\r
+\r
+IFN ITS,[\r
+IFN ARC,[\r
+ARCLOS: PUSHJ P,CKLOCK\r
+ JRST MAPLS1\r
+\r
+ARCRTR: SOS (P)\r
+ SOS (P)\r
+ POPJ P,\r
+\r
+ARCFAT: PUSHJ P,CKLOCK\r
+ FATAL CANT WRITE FIXUP FILE\r
+ JRST ARCRTR\r
+\r
+CKLOCK: PUSH P,0\r
+ .STATUS MAPCH,0\r
+ LDB 0,[220600,,0]\r
+ CAIN 0,23 ; file locked?\r
+ JRST WAIT ; wait and retry\r
+ POP P,0\r
+ POPJ P,\r
+\r
+WAIT: MOVEI 0,1\r
+ .SLEEP 0,\r
+ POP P,0\r
+ AOS (P)\r
+ POPJ P,\r
+]\r
+]\r
+\r
+; Here to try to get a free page block for new thing\r
+; A/ # of pages to get\r
+\r
+ALOPAG: PUSHJ P,GETPAG ; try to get enough pages\r
+ POPJ P,\r
+ AOS (P) ; won skip return\r
+ MOVEI 0,(B) ; update PURBOT/PURTOP to reflect current state\r
+ ASH 0,PGSHFT\r
+ MOVEM 0,PURBOT\r
+ POPJ P,\r
+\r
+GETPAG: MOVE C,P.TOP ; top of GC space\r
+ ASH C,-PGSHFT ; to page number\r
+ MOVE B,PURBOT ; current bottom of pure space\r
+ ASH B,-PGSHFT ; also to pages\r
+ SUBM B,C ; pages available ==> C\r
+ CAIGE C,(A) ; skip if have enough already\r
+ JRST GETPG1 ; no, try to shuffle around\r
+ SUBI B,(A) ; B/ first new page\r
+ AOS (P)\r
+ POPJ P, ; return with new free page in B\r
+\r
+; Here if shuffle must occur or gc must be done to make room\r
+\r
+GETPG1: MOVEI 0,0\r
+ SKIPE NOSHUF ; if can't shuffle, then ask gc\r
+ JRST ASKAGC\r
+ MOVE 0,PURTOP ; get top of mapped pure area\r
+ SUB 0,P.TOP ; total free words to 0\r
+ ASH 0,-PGSHFT ; to pages\r
+ CAIGE 0,(A) ; skip if winnage possible\r
+ JRST ASKAGC ; please AGC give me some room!!\r
+ SUBM A,C ; C/ amount we must flush to make room\r
+\r
+; Here to find pages for flush using LRU algorithm\r
+\r
+GL1: MOVE B,PURVEC+1(TVP) ; get pointer to pure sr vector\r
+ MOVEI 0,-1 ; get very large age\r
+\r
+GL2: SKIPN 1(B) ; skip if not already flushed\r
+ JRST GL3\r
+ HLRZ D,2(B) ; get this ones age\r
+ CAMLE D,0 ; skip if this is a candidate\r
+ JRST GL3\r
+ MOVE E,B ; point to table entry with E\r
+ MOVEI 0,(D) ; and use as current best\r
+GL3: ADD B,[ELN,,ELN] ; look at next\r
+ JUMPL B,GL2\r
+\r
+ HLRE B,1(E) ; get length of flushee\r
+ ASH B,-PGSHFT ; to negative # of pages\r
+ ADD C,B ; update amount needed\r
+ SETZM 1(E) ; indicate it will be gone\r
+ JUMPG C,GL1 ; jump if more to get\r
+\r
+; Now compact pure space\r
+\r
+ PUSH P,A ; need all acs\r
+ SETZB E,A\r
+ HRRZ D,PURVEC(TVP) ; point to first in core addr order\r
+ HRRZ C,PURTOP ; get destination page\r
+ ASH C,-PGSHFT ; to page number\r
+\r
+CL1: ADD D,PURVEC+1(TVP) ; to real pointer\r
+ SKIPE 1(D) ; skip if this one is a flushee\r
+ JRST CL2\r
+\r
+ HRRZ D,2(D) ; point to next one in chain\r
+ JUMPN E,CL3 ; jump if not first one\r
+ HRRM D,PURVEC(TVP) ; and use its next as first\r
+ JRST CL4\r
+\r
+CL3: HRRM D,2(E) ; link up\r
+ JRST CL4\r
+\r
+; Found a stayer, move it if necessary\r
+\r
+CL2: MOVEI E,(D) ; another pointer to slot\r
+ HLRE B,1(D) ; - length of block\r
+ HRRZ D,1(D) ; pointer to block\r
+ SUB D,B ; point to top of block\r
+ ASH D,-PGSHFT ; to page number\r
+ CAIN D,(C) ; if not moving, jump\r
+ JRST CL6\r
+\r
+ ASH B,-PGSHFT ; to pages\r
+IFN ITS,[\r
+CL5: SUBI C,1 ; move to pointer and from pointer\r
+ SUBI D,1\r
+ DOTCAL CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D]\r
+ FATAL PURE SHUFFLE LOSSAGE\r
+ AOJL B,CL5 ; count down\r
+]\r
+IFE ITS,[\r
+ PUSH P,B ; save # of pages\r
+ MOVEI A,-1(D) ; copy from pointer\r
+ HRLI A,400000 ; get this fork code\r
+ RMAP ; get a JFN (hopefully)\r
+ EXCH D,(P) ; D # of pages (save from)\r
+ ADDM D,(P) ; update from\r
+ MOVEI B,-1(C) ; to pointer in B\r
+ HRLI B,400000\r
+ MOVSI C,120000 ; read/execute modes\r
+\r
+ PMAP ; move a page\r
+ SUBI A,1\r
+ SUBI B,1\r
+ AOJL D,.-3 ; move them all\r
+\r
+ MOVEI C,1(B)\r
+ POP P,D\r
+ ADDI D,1\r
+]\r
+; Update the table address for this loser\r
+\r
+ SUBM C,D ; compute offset (in pages)\r
+ ASH D,PGSHFT ; to words\r
+ ADDM D,1(E) ; update it\r
+CL7: HRRZ D,2(E) ; chain on\r
+CL4: TRNN D,400000 ; skip if end of chain\r
+ JRST CL1\r
+\r
+ ASH C,PGSHFT ; to words\r
+ MOVEM C,PURBOT ; reset pur bottom\r
+ POP P,A\r
+ JRST GETPAG\r
+\r
+CL6: HRRZ C,1(E) ; get new top of world\r
+ ASH C,-PGSHFT ; to page #\r
+ JRST CL7\r
+\r
+; SUBR to create an entry in the vector for one of these guys\r
+\r
+MFUNCTION PCODE,SUBR\r
+\r
+ ENTRY 2\r
+\r
+ GETYP 0,(AB) ; check 1st arg is string\r
+ CAIE 0,TCHSTR\r
+ JRST WTYP1\r
+ GETYP 0,2(AB) ; second must be fix\r
+ CAIE 0,TFIX\r
+ JRST WTYP2\r
+\r
+ MOVE A,(AB) ; convert name of program to sixbit\r
+ MOVE B,1(AB)\r
+ PUSHJ P,STRTO6\r
+PCODE4: MOVE C,(P) ; get name in sixbit\r
+\r
+; Now look for either this one or an empty slot\r
+\r
+ MOVEI E,0\r
+ MOVE B,PURVEC+1(TVP)\r
+\r
+PCODE2: CAMN C,(B) ; skip if this is not it\r
+ JRST PCODE1 ; found it, drop out of loop\r
+ JUMPN E,.+3 ; dont record another empty if have one\r
+ SKIPN (B) ; skip if slot filled\r
+ MOVE E,B ; remember pointer\r
+ ADD B,[ELN,,ELN]\r
+ JUMPL B,PCODE2 ; jump if more to look at\r
+\r
+ JUMPE E,PCODE3 ; if E=0, error no room\r
+ MOVEM C,(E) ; else stash away name and zero rest\r
+ SETZM 1(E)\r
+ SETZM 2(E)\r
+ JRST .+2\r
+\r
+PCODE1: MOVE E,B ; build <slot #>,,<offset>\r
+ MOVEI 0,0 ; flag whether new slot\r
+ SKIPE 1(E) ; skip if mapped already\r
+ MOVEI 0,1\r
+ MOVE B,3(AB)\r
+ HLRE D,E\r
+ HLRE E,PURVEC+1(TVP)\r
+ SUB D,E\r
+ HRLI B,(D)\r
+ MOVSI A,TPCODE\r
+ SKIPN NOSHUF ; skip if not shuffling\r
+ JRST FINIS\r
+ JUMPN 0,FINIS ; jump if winner\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ HLRZ A,B\r
+ PUSHJ P,PLOAD\r
+ JRST PCOERR\r
+ POP TP,B\r
+ POP TP,A\r
+ JRST FINIS\r
+\r
+PCOERR: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE PURE-LOAD-FAILURE\r
+ JRST CALER1\r
+\r
+\r
+PCODE3: HLRE A,PURVEC+1(TVP) ; get current length\r
+ MOVNS A\r
+ ADDI A,10*ELN ; add 10(8) more entry slots\r
+ PUSHJ P,IBLOCK\r
+ EXCH B,PURVEC+1(TVP) ; store new one and get old\r
+ HLRE A,B ; -old length to A\r
+ MOVSI B,(B) ; start making BLT pointer\r
+ HRR B,PURVEC+1(TVP)\r
+ SUBM B,A ; final dest to A\r
+ BLT B,-1(A)\r
+ JRST PCODE4\r
+\r
+; Here if must try to GC for some more core\r
+\r
+ASKAGC: SKIPE GCFLG ; if already in GC, lose\r
+ POPJ P,\r
+ SUBM A,0 ; amount required to 0\r
+ ASH 0,PGSHFT ; TO WORDS\r
+ MOVEM 0,GCDOWN ; pass as funny arg to AGC\r
+ EXCH A,C ; save A from gc's destruction\r
+IFN ITS, .IOPUSH MAPCH, ; gc uses same channel\r
+ PUSH P,C\r
+ MOVE C,[8,,9.] ; SET UP INDICATORS FOR GC\r
+ PUSHJ P,AGC\r
+ POP P,C\r
+IFN ITS, .IOPOP MAPCH,\r
+ EXCH C,A\r
+ JUMPGE C,GETPAG\r
+ PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE NO-MORE-PAGES\r
+ AOJA TB,CALER1\r
+\r
+; Here to clean up pure space by flushing all shared stuff\r
+\r
+PURCLN: SKIPE NOSHUF\r
+ POPJ P,\r
+ MOVEI B,400000\r
+ HRRM B,PURVEC(TVP) ; flush chain pointer\r
+ MOVE B,PURVEC+1(TVP) ; get pointer to table\r
+ SETZM 1(B) ; zero pointer entry\r
+ SETZM 2(B) ; zero link and age slots\r
+ ADD B,[ELN,,ELN] ; go to next slot\r
+ JUMPL B,.-3 ; do til exhausted\r
+ MOVE B,PURBOT ; now return pages\r
+ SUB B,PURTOP ; compute page AOBJN pointer\r
+ JUMPE B,CPOPJ ; no pure pages?\r
+ MOVSI B,(B)\r
+ HRR B,PURBOT\r
+ ASH B,-PGSHFT\r
+IFN ITS,[\r
+ DOTCAL CORBLK,[[1000,,0],[1000,,-1],B]\r
+ FATAL SYSTEM WONT TAKE CORE BACK?\r
+]\r
+IFE ITS,[\r
+ HLRE D,B ; - # of pges to flush\r
+ HRLI B,400000 ; specify hacking hom fork\r
+ MOVNI A,1\r
+\r
+ PMAP\r
+ ADDI B,1\r
+ AOJL D,.-2\r
+]\r
+ MOVE B,PURTOP ; now fix up pointers\r
+ MOVEM B,PURBOT ; to indicate no pure\r
+CPOPJ: POPJ P,\r
+\r
+; Here to move the entire pure space.\r
+; A/ # and direction of pages to move (+ ==> up)\r
+\r
+MOVPUR: SKIPE NOSHUF\r
+ FATAL CANT MOVE PURE SPACE AROUND\r
+ IFE ITS [ASH A,1]\r
+ SKIPN B,A ; zero movement, ignore call\r
+ POPJ P,\r
+\r
+ ASH B,PGSHFT ; convert to words for pointer update\r
+ MOVE C,PURVEC+1(TVP) ; loop through updating non-zero entries\r
+ SKIPE 1(C)\r
+ ADDM B,1(C)\r
+ ADD C,[ELN,,ELN]\r
+ JUMPL C,.-3\r
+\r
+ MOVE C,PURTOP ; found pages at top and bottom of pure\r
+ ASH C,-PGSHFT\r
+ MOVE D,PURBOT\r
+ ASH D,-PGSHFT\r
+ ADDM B,PURTOP ; update to new boundaries\r
+ ADDM B,PURBOT\r
+ CAIN C,(D) ; differ?\r
+ POPJ P,\r
+ JUMPG A,PUP ; if moving up, go do separate CORBLKs\r
+\r
+IFN ITS,[\r
+ SUBM D,C ; -size of area to C (in pages)\r
+ MOVEI E,(D) ; build pointer to bottom of destination\r
+ ADD E,A\r
+ HRLI E,(C)\r
+ HRLI D,(C)\r
+ DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D]\r
+ FATAL CANT MOVE PURE\r
+ POPJ P,\r
+\r
+PUP: SUBM C,D ; pages to move to D\r
+ ADDI A,(C) ; point to new top\r
+\r
+PUPL: SUBI C,1\r
+ SUBI A,1\r
+ DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C]\r
+ FATAL CANT MOVE PURE\r
+ SOJG D,PUPL\r
+ POPJ P,\r
+]\r
+IFE ITS,[\r
+ SUBM D,C ; pages to move to D\r
+ MOVSI E,(C) ; build aobjn pointer\r
+ HRRI E,(D) ; point to lowest\r
+ ADD D,A ; D==> new lowest page\r
+PURCL1: MOVSI A,400000 ; specify here\r
+ HRRI A,(E) ; get a page\r
+ RMAP ; get a real handle on it\r
+ MOVE B,D ; where to go\r
+ HRLI B,400000\r
+ MOVSI C,120000\r
+ PMAP\r
+ ADDI D,1\r
+ AOBJN E,PURCL1\r
+ POPJ P,\r
+\r
+PUP: SUB D,C ; - count to D\r
+ MOVSI E,(D) ; start building AOBJN\r
+ HRRI E,(C) ; aobjn to top\r
+ ADD C,A ; C==> new top\r
+ MOVE D,C\r
+\r
+PUPL: MOVSI A,400000\r
+ HRRI A,(E)\r
+ RMAP ; get real handle\r
+ MOVE B,D\r
+ HRLI B,400000\r
+ MOVSI C,120000\r
+ PMAP\r
+ SUBI E,2\r
+ SUBI D,1\r
+ AOBJN E,PUPL\r
+\r
+ POPJ P,\r
+]\r
+IFN ITS,[\r
+CSIXBT: MOVEI 0,5\r
+ PUSH P,[440700,,C]\r
+ PUSH P,[440600,,D]\r
+ MOVEI D,0\r
+CSXB2: ILDB E,-1(P)\r
+ CAIN E,177\r
+ JRST CSXB1\r
+ SUBI E,40\r
+ IDPB E,(P)\r
+ SOJG 0,CSXB2\r
+CSXB1: SUB P,[2,,2]\r
+ MOVE C,D\r
+ POPJ P,\r
+]\r
+GENVN: MOVE C,[440700,,MUDSTR+2]\r
+ MOVEI D,5\r
+ MOVEI B,0\r
+VNGEN: ILDB 0,C\r
+ CAIN 0,177\r
+ POPJ P,\r
+ IMULI B,10.\r
+ SUBI 0,60\r
+ ADD B,0\r
+ SOJG D,VNGEN\r
+ POPJ P,\r
+\r
+IFE ITS,[\r
+MSKS: 774000,,0\r
+ 777760,,0\r
+ 777777,,700000\r
+ 777777,,777400\r
+ 777777,,777776\r
+]\r
+END\r
+\f\r
projects / pdp10-muddle.git / blobdiff