X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Fmappur.mid.159;fp=%3Cmdl.int%3E%2Fmappur.mid.159;h=4f64307351f7aaa9de661cf1ec72493bdef23043;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c diff --git a//mappur.mid.159 b//mappur.mid.159 new file mode 100644 index 0000000..4f64307 --- /dev/null +++ b//mappur.mid.159 @@ -0,0 +1,1972 @@ + +TITLE MAPURE-PAGE LOADER + +RELOCATABLE + +MAPCH==0 ; channel for MAPing +XJRST==JRST 5, + +.GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,GCSTOP,FRETOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN +.GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF,DIR,NDIRS,SQUPNT +.GLOBAL PLODR,SQUKIL,GETBUF,KILBUF,INPLOD,SQKIL,PVSTOR,TVSTOR,DSTOREM,SLEEPR +.GLOBAL OPSYS,SJFNS,MULTSG,PURBTB,SFIX,NSEGS +.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10 +.GLOBAL C%M20,C%M30,C%M40,C%M60 +.GLOBAL MAPJFN,DIRCHN + +.INSRT MUDDLE > +SPCFXU==1 +SYSQ + +IFE ITS,[ +IF1, .INSRT STENEX > +] + +F==PVP +G==TVP +H==SP +RDTP==1000,,200000 +FME==1000,,-1 + + +IFN ITS,[ +PGMSK==1777 +PGSHFT==10. +] + +IFE ITS,[ +FLUSHP==0 +PGMSK==777 +PGSHFT==9. +] + +LNTBYT==340700 +ELN==4 ; LENGTH OF SLOT +FB.NAM==0 ; NAME SLOT IN TABLE +FB.PTR==1 ; Pointer to core pages +FB.AGE==2 ; age,,chain +FB.PGS==3 ; PTR AND LENGTH OF PAGE IN FILE +FB.AMK==37777777 ; extended address mask +FB.CNT==<-1># ; page count mask +EOC==400000 ; END OF PURVEC CHAIN + +IFE ITS,[ +.FHSLF==400000 ; THIS FORK +%GJSHT==000001 ; SHORT FORM GTJFN +%GJOLD==100000 + ;PMAP BITS +PM%CNT==400000 ; PMAP WITH REPEAT COUNT +PM%RD==100000 ; PMAP WITH READ ACCESS +PM%EX==20000 ; PMAP WITH EXECUTE ACCESS (NO-OP ON 20X) +PM%CPY==400 ; PMAP WITH COPY-ON-WRITE ACCESS +PM%WR==40000 ; PMAP WITH WRITE ACCESS + + ;OPENF BITS +OF%RD==200000 ; OPEN IN READ MODE +OF%WR==100000 ; OPEN IN WRITE MODE +OF%EX==040000 ; OPEN IN EXECUTE MODE (TENEX CARES) +OF%THW==02000 ; OPEN IN THAWED MODE +OF%DUD==00020 ; DON'T UPDATE THAWED PAGES +] +; THIS ROUTINE TAKES A SLOT OFFSET IN REGISTER A AND MAPS IN THE ASSOCIATED +; FILE. IT CLOBBERS ALL ACs AND SKIP RETURNS IF IT WINS. + +OFF==-5 ; OFFSET INTO PURVEC OF SLOT +NAM==-4 ; SIXBIT NAME OF THING BEING LOADED +LASTC==-3 ; LAST CHARACTER OF THE NAME +DIR==-2 ; SAVED POINTER TO DIRECTORY +SPAG==-1 ; FIRST PAGE IN FILE +PGNO==0 ; FIRST PAGE IN CORE +VER==-6 ; VERSION NUMBER OF MUDDLE TO USE IN OPENING FILES +FLEN==-7 ; LENGTH OF THE FILE +TEMP==-10 ; GENERAL TEMPORARY SLOT +WRT==-11 ; INDICATION IF OPEN IS FOR WRITING OR READING +CADDR==-12 ; ADDRESS OF CORE IMAGE LOCATION OF FILE +NSLOTS==13 + +; IT FIRST LOOKS TO SEE IF IT HAS THE PAGE NUMBER OF THE FILE + +PLOAD: ADD P,[NSLOTS,,NSLOTS] + SKIPL P + JRST PDLOV + MOVEM A,OFF(P) + PUSH TP,C%0 ; [0] + PUSH TP,C%0 ; [0] +IFE ITS,[ + SKIPN MAPJFN + PUSHJ P,OPSAV +] + +PLOADX: PUSHJ P,SQKIL + MOVE A,OFF(P) + ADD A,PURVEC+1 ; GET TO SLOT + SKIPE B,FB.PGS(A) ; SKIP IF PAGE NUMBER + JRST GETIT + MOVE B,FB.NAM(A) + MOVEM B,NAM(P) + MOVE 0,B + MOVEI A,6 ; FIND LAST CHARACTER + TRNE 0,77 ; SKIP IF NOT DONE + JRST .+3 + LSH 0,-6 ; BACK A CHAR + SOJG A,.-3 ; NOW CHAR IS BACKED OUT + ANDI 0,77 ; LASTCHR + MOVEM 0,LASTC(P) + +; NOT TO TRY TO FIND FILE IN MAIN DATA BASE. +; THE GC'S WINDOW IS USED IN THIS CASE. + +IFN ITS,[ + .CALL MNBLK ; OPEN CHANNEL TO MAIN FILE + JRST NTHERE + PUSHJ P,TRAGN ; TRY OPENING UP CHANNEL AGAIN IF POSSIBLE +] +IFE ITS,[ + SKIPN E,MAPJFN + JRST NTHERE ;who cares if no SAV.FILE? + MOVEM E,DIRCHN +] + MOVE D,NAM(P) + MOVE 0,LASTC(P) + PUSHJ P,GETDIR + MOVEM E,DIR(P) + PUSHJ P,GENVN ; GET VERSION # AS FIX + MOVE E,DIR(P) + MOVE D,NAM(P) + MOVE A,B + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST NTHERE ; GO TRY FIXING UP ITS NOT THERE + ANDI A,-1 ; WIN IN MULT SEG CASE + MOVE B,OFF(P) ; GET SLOT NUMBER + ADD B,PURVEC+1 ; POINT TO SLOT + HRRZ C,1(A) ; GET BLOCK NUMBER + HRRM C,FB.PGS(B) ; SMASH INTO SLOT + LDB C,[LNTBYT,,1(A)] ; SMASH IN LENGTH + HRLM C,FB.PGS(B) ; SMASH IN LENGTH + JRST PLOADX + +; NOW TRY TO FIND FILE IN WORKING DIRECTORY + +NTHERE: PUSHJ P,KILBUF + MOVE A,OFF(P) ; GET POINTER TO PURVEC SLOT + ADD A,PURVEC+1 + PUSHJ P,GENVN ; GET VERSION NUMBER + HRRZM B,VER(P) + PUSHJ P,OPMFIL ; OPEN FILE + JRST FIXITU + +; NUMBER OF PAGES ARE IN A +; STARTING PAGE NUMBER IN SPAG(P) + +PLOD1: PUSHJ P,ALOPAG ; get the necessary pages + JRST MAPLS2 + MOVE E,SPAG(P) ; E starting page in file + MOVEM B,PGNO(P) +IFN ITS,[ + MOVN A,FLEN(P) ; get neg count + MOVSI A,(A) ; build aobjn pointer + HRR A,PGNO(P) ; get page to start + MOVE B,A ; save for later + HRRI 0,(E) ; page pointer for file + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, ; no need to have file open anymore +] +IFE ITS,[ + MOVEI A,(E) ; First page on rh of A + HRL A,DIRCHN ; JFN to lh of A + HRLI B,.FHSLF ; specify this fork + MOVSI C,PM%RD+PM%EX ; bits for read/execute + MOVE D,FLEN(P) ; # of pages to D + HRROI E,(B) ; build page aobjn for later + TLC E,-1(D) ; sexy way of doing lh + + SKIPN OPSYS + JRST BLMAP ; if tops-20 can block PMAP + PMAP + ADDI A,1 + ADDI B,1 + SOJG D,.-3 ; map 'em all + MOVE B,E + JRST PLOAD1 + +BLMAP: HRRI C,(D) + TLO C,PM%CNT ; say it is counted + PMAP ; one PMAP does the trick + MOVE B,E +] +; now try to smash slot in PURVEC + +PLOAD1: MOVE A,PURVEC+1 ; get pointer to it + ASH B,PGSHFT ; convert to aobjn pointer to words + MOVE C,OFF(P) ; get slot offset + ADDI C,(A) ; point to slot + MOVEM B,FB.PTR(C) ; clobber it in + TLZ B,(FB.CNT) ; isolate address of page + HRRZ D,PURVEC ; get offset into vector for start of chain + TRNE D,EOC ; skip if not end marker + JRST SCHAIN + HRLI D,400000+A ; set up indexed pointer + ADDI D,1 +IFN ITS, HRRZ 0,@D ; get its address +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + JUMPE 0,SCHAIN ; no chain exists, start one + CAMLE 0,B ; skip if new one should be first + AOJA D,INLOOP ; jump into the loop + + SUBI D,1 ; undo ADDI +FCLOB: MOVE E,OFF(P) ; get offset for this guy + HRRM D,FB.AGE(C) ; link up + HRRM E,PURVEC ; store him away + JRST PLOADD + +SCHAIN: MOVEI D,EOC ; get end of chain indicator + JRST FCLOB ; and clobber it in + +INLOOP: MOVE E,D ; save in case of later link up + HRR D,@D ; point to next table entry + TRNE D,EOC ; 400000 is the end of chain bit + JRST SLFOUN ; found a slot, leave loop + ADDI D,1 ; point to address of progs +IFN ITS, HRRZ 0,@D ; get address of block +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + CAMLE 0,B ; skip if still haven't fit it in + AOJA D,INLOOP ; back to loop start and point to chain link + SUBI D,1 ; point back to start of slot + +SLFOUN: MOVE 0,OFF(P) ; get offset into vector of this guy + HRRM 0,@E ; make previous point to us + HRRM D,FB.AGE(C) ; link it in + + +PLOADD: AOS -NSLOTS(P) ; skip return + +MAPLOS: SUB P,[NSLOTS,,NSLOTS] ; flush stack crap + SUB TP,C%22 + POPJ P, + + +MAPLS0: ERRUUO EQUOTE NO-SAV-FILE + JRST MAPLOS + +MAPLS1: ERRUUO EQUOTE NO-FIXUP-FILE + JRST MAPLOS + +MAPLS2: ERRUUO EQUOTE NO-ROOM-AVAILABLE + JRST MAPLOS + +FIXITU: + +;OPEN FIXUP FILE ON MUDSAV + +IFN ITS,[ + .CALL FIXBLK ; OPEN UP FIXUP FILE + PUSHJ P,TRAGN ; SEE IF TOTALLY LOSING +] +IFE ITS,[ + MOVSI A,%GJSHT ; GTJFN BITS + HRROI B,FXSTR + SKIPE OPSYS + HRROI B,TFXSTR + GTJFN + FATAL FIXUP FILE NOT FOUND + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + OPENF + FATAL FIXUP FILE CANT BE OPENED +] + + MOVE 0,LASTC(P) ; GET DIRECTORY + PUSHJ P,GETDIR + MOVE D,NAM(P) + PUSHJ P,DIRSR1 ; SEARCH DIRECTORY FOR FIXUP + JRST NOFXUP ; NO FIXUP IN MAIN DIRECTORY + ANDI A,-1 ; WIN IN MULTI SEGS + HRRZ A,1(A) ; GET BLOCK NUMBER OF START + ASH A,8. ; CONVERT TO WORDS +IFN ITS,[ + .ACCES MAPCH,A ; ACCESS FILE +] + +IFE ITS,[ + MOVEI B,(A) + MOVE A,DIRCHN + SFPTR + JFCL +] + PUSHJ P,KILBUF +FIXT1: PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + +IFN ITS,[ + .CALL MNBLK ; REOPEN SAV FILE + PUSHJ P,TRAGN +] + +IFE ITS,[ + MOVE A,MAPJFN ; SET UP DIRCHAN AGAIN + MOVEM A,DIRCHN +] + +; NOW TRY TO LOCATE SAV FILE + + MOVE 0,LASTC(P) ; GET LASTCHR + PUSHJ P,GETDIR ; GET DIRECTORY + HRRZ A,VER(P) ; GET VERSION # + MOVE D,NAM(P) ; GET NAME OF FILE + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST MAPLS1 ; NO SAV FILE THERE + ANDI A,-1 + HRRZ E,1(A) ; GET STARTING BLOCK # + LDB A,[LNTBYT,,1(A)] ; GET LENGTH INTO A + MOVEM A,FLEN(P) ; SAVE LENGTH + MOVEM E,SPAG(P) ; SAVE STARTING BLOCK NUMBER + PUSHJ P,KILBUF + PUSHJ P,RSAV ; READ IN CODE +; now to do fixups + +FXUPGO: MOVE A,(TP) ; pointer to them + SETOM INPLOD ; ABSOLUTE CLUDGE TO PREVENT BUFFER FROM + ; SCREWING US +IFE ITS,[ + SKIPN MULTSG + JRST FIXMLT + HRRZ D,B ; this codes gets us running in the correct + ; segment + ASH D,PGSHFT + HRRI D,FIXMLT + MOVEI C,0 + XJRST C ; good bye cruel segment (will work if we fell + ; into segment 0) +FIXMLT: ASH B,PGSHFT ; aobjn to program + +FIX1: SKIPL E,(A) ; read one hopefully squoze + FATAL ATTEMPT TO TYPE FIX PURE + TLZ E,740000 + +NOPV1: PUSHJ P,SQUTOA ; look it up + FATAL BAD FIXUPS + +; N.B. THE VALUE IN THE FIXUPS FOR AN ADDRESS CAN BE NEGATIVE. IF THIS HAPPENS +; IT MEANS THAT THE LEFT HALF CONTAINS THE VALUE INSTEAD OF THE RIGHT HALF +NOPV2: AOBJP A,FIX2 + HLRZ D,(A) ; get old value + HRRZS E + SUBM E,D ; D is diff between old and new + HRLM E,(A) ; fixup the fixups +NOPV3: MOVEI 0,0 ; flag for which half +FIX4: JUMPE 0,FIXRH ; jump if getting rh + MOVEI 0,0 ; next time will get rh + AOBJP A,FIX2 ; done? + HLRE C,(A) ; get lh + JUMPE C,FIX3 ; 0 terminates +FIX5: SKIPGE C ; If C is negative then left half garbage + JRST FIX6 + ADDI C,(B) ; access the code + +NOPV4: ADDM D,-1(C) ; and fix it up + JRST FIX4 + +; FOR LEFT HALF CASE + +FIX6: MOVNS C ; GET TO ADRESS + ADDI C,(B) ; ACCESS TO CODE + HLRZ E,-1(C) ; GET OUT WORD + ADDM D,E ; FIX IT UP + HRLM E,-1(C) + JRST FIX4 + +FIXRH: MOVEI 0,1 ; change flag + HRRE C,(A) ; get it and + JUMPN C,FIX5 + +FIX3: AOBJN A,FIX1 ; do next one + +IFN SPCFXU,[ + MOVE C,B + PUSHJ P,SFIX +] + PUSHJ P,SQUKIL ; KILL SQUOZE TABLE + SETZM INPLOD +FIX2: + HRRZS VER(P) ; INDICATE SAV FILE + MOVEM B,CADDR(P) + PUSHJ P,GENVN + HRRM B,VER(P) + PUSHJ P,OPWFIL + FATAL MAP FIXUP LOSSAGE +IFN ITS,[ + MOVE B,CADDR(P) + .IOT MAPCH,B ; write out the goodie + .CLOSE MAPCH, + PUSHJ P,OPMFIL + FATAL WHERE DID THE FILE GO? + MOVE E,CADDR(P) + ASH E,-PGSHFT ; to page AOBJN + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, +] + + +IFE ITS,[ + MOVE A,DIRCHN ; GET JFN + MOVE B,CADDR(P) ; ready to write it out + HRLI B,444400 + HLRE C,CADDR(P) + SOUT ; zap it out + TLO A,400000 ; dont recycle the JFN + CLOSF + JFCL + ANDI A,-1 ; kill sign bit + MOVE B,[440000,,240000] + OPENF + FATAL MAP FIXUP LOSSAGE + MOVE B,CADDR(P) + ASH B,-PGSHFT ; aobjn to pages + HLRE D,B ; -count + HRLI B,.FHSLF + MOVSI A,(A) + MOVSI C,PM%RD+PM%EX + PMAP + ADDI A,1 + ADDI B,1 + AOJN D,.-3 +] + + SKIPGE MUDSTR+2 + JRST EFIX2 ; exp vers, dont write out +IFE ITS,[ + HRRZ A,SJFNS ; get last jfn from savxxx file + JUMPE A,.+4 ; oop + CAME A,MAPJFN + CLOSF ; close it + JFCL + HLLZS SJFNS ; zero the slot +] + MOVEI 0,1 ; INDICATE FIXUP + HRLM 0,VER(P) + PUSHJ P,OPWFIL + FATAL CANT WRITE FIXUPS + +IFN ITS,[ + MOVE E,(TP) + HLRE A,E ; get length + MOVNS A + ADDI A,2 ; account for these 2 words + MOVE 0,[-2,,A] ; write version and length + .IOT MAPCH,0 + .IOT MAPCH,E ; out go the fixups + SETZB 0,A + MOVEI B,MAPCH + .CLOSE MAPCH, +] + +IFE ITS,[ + MOVE A,DIRCHN + HLRE B,(TP) ; length of fixup vector + MOVNS B + ADDI B,2 ; for length and version words + BOUT + PUSHJ P,GENVN + BOUT + MOVSI B,444400 ; byte pointer to fixups + HRR B,(TP) + HLRE C,(TP) + SOUT + CLOSF + JFCL +] + +EFIX2: MOVE B,CADDR(P) + ASH B,-PGSHFT + JRST PLOAD1 + +; Here to try to get a free page block for new thing +; A/ # of pages to get + +ALOPAG: MOVE C,GCSTOP ; FOOL GETPAG + ADDI C,3777 + ASH C,-PGSHFT + MOVE B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; skip if multi-segments + JRST ALOPA1 +; Compute the "highest" PURBOT (i.e. find the least busy segment) + + PUSH P,E + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVEI B,0 +ALOPA3: CAML B,PURBTB(A) ; if this one is larger + JRST ALOPA2 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +ALOPA2: AOBJN A,ALOPA3 + POP P,A +] + +ALOPA1: ASH B,-PGSHFT + SUBM B,C ; SEE IF ROOM + CAIL C,(A) + JRST ALOPGW + PUSHJ P,GETPAX ; try to get enough pages +IFE ITS, JRST EPOPJ +IFN ITS, POPJ P, + +ALOPGW: +IFN ITS, AOS (P) ; won skip return +IFE ITS,[ + SKIPE MULTSG + AOS -1(P) ; ret addr + SKIPN MULTSG + AOS (P) +] + MOVE 0,PURBOT +IFE ITS,[ + SKIPE MULTSG + MOVE 0,PURBTB-FSEG(E) +] + ASH 0,-PGSHFT + SUBI 0,(A) + MOVE B,0 +IFE ITS,[ + SKIPN MULTSG + JRST ALOPW1 + ASH 0,PGSHFT + HRRZM 0,PURBTB-FSEG(E) + ASH E,PGSHFT ; INTO POSITION + IORI B,(E) ; include segment in address + POP P,E + JRST ALOPW2 +] +ALOPW1: ASH 0,PGSHFT +ALOPW2: CAMGE 0,PURBOT + MOVEM 0,PURBOT + CAML 0,P.TOP + POPJ P, +IFE ITS,[ + SUBI 0,1777 + ANDCMI 0,1777 +] + MOVEM 0,P.TOP + POPJ P, + +EPOPJ: SKIPE MULTSG + POP P,E + POPJ P, +IFE ITS,[ +GETPAX: TDZA B,B ; here if other segs ok +GETPAG: MOVEI B,1 ; here for only main segment + JRST @[.+1] ; run in sect 0 + MOVNI E,1 +] +IFN ITS,[ +GETPAX: +GETPAG: +] + MOVE C,P.TOP ; top of GC space + ASH C,-PGSHFT ; to page number +IFE ITS,[ + SKIPN MULTSG + JRST GETPA9 + JUMPN B,GETPA9 ; if really wan all segments, + ; must force all to be free + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVE B,P.TOP +GETPA8: CAMLE B,PURBTB(A) ; if this one is larger (or the same) + JRST GETPA7 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +GETPA7: AOBJN A,GETPA8 + POP P,A + JRST .+2 +] +GETPA9: MOVE B,PURBOT + ASH B,-PGSHFT ; also to pages + SUBM B,C ; pages available ==> C + CAMGE C,A ; skip if have enough already + JRST GETPG1 ; no, try to shuffle around + SUBI B,(A) ; B/ first new page +CPOPJ1: AOS (P) +IFN ITS, POPJ P, +IFE ITS,[ +SPOPJ: SKIPN MULTSG + POPJ P, ; return with new free page in B + ; (and seg# in E?) + POP P,21 + SETZM 20 + XJRST 20 +] +; Here if shuffle must occur or gc must be done to make room + +GETPG1: MOVEI 0,0 + SKIPE NOSHUF ; if can't shuffle, then ask gc + JRST ASKAGC + MOVE 0,PURTOP ; get top of mapped pure area + SUB 0,P.TOP + ASH 0,-PGSHFT ; to pages + CAMGE 0,A ; skip if winnage possible + JRST ASKAGC ; please AGC give me some room!! + SUBM A,C ; C/ amount we must flush to make room + +IFE ITS,[ + SKIPE MULTSG ; if multi and getting in all segs + JUMPL E,LPGL1 ; check out each and every segment + + PUSHJ P,GL1 + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAX + +LPGL1: PUSH P,A + PUSH P,[FSEG-1] + +LPGL2: AOS E,(P) ; count segments + MOVE B,NSEGS + ADDI B,FSEG + CAML E,B + JRST LPGL3 + PUSH P,C + MOVE C,PURBOT ; fudge so look for appropriate amt + SUB C,PURBTB-FSEG(E) + ASH C,-PGSHFT ; to pages + ADD C,(P) + SKIPLE C ; none to flush + PUSHJ P,GL1 + HRRZ E,-1(P) ; fet section again + HRRZ B,PURBOT + HRRZ C,PURBTB-FSEG(E) ; lets share with 0 again + SUB C,B + HRL B,E ; get segment + MOVEI A,(B) + ASH B,-PGSHFT + ASH A,-PGSHFT + HRLI A,.FHSLF + HRLI B,.FHSLF + ASH C,-PGSHFT + HRLI C,PM%CNT+PM%RD+PM%WR+PM%EX + PMAP +LPGL4: POP P,C + JRST LPGL2 + +LPGL3: SUB P,C%11 + POP P,A + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAG +] +; Here to find pages for flush using LRU algorithm (in multi seg mode, only +; care about the segment in E) + +GL1: MOVE B,PURVEC+1 ; get pointer to pure sr vector + MOVEI 0,-1 ; get very large age + +GL2: SKIPL FB.PTR(B) ; skip if not already flushed + JRST GL3 +IFE ITS,[ + SKIPN MULTSG + JRST GLX + LDB D,[220500,,FB.PTR(B)] ; get segment # + CAIE D,(E) + JRST GL3 ; wrong swegment, ignore +] +GLX: HLRZ D,FB.AGE(B) ; get this ones age + CAMLE D,0 ; skip if this is a candidate + JRST GL3 + MOVE F,B ; point to table entry with E + MOVEI 0,(D) ; and use as current best +GL3: ADD B,[ELN,,ELN] ; look at next + JUMPL B,GL2 + + HLRE B,FB.PTR(F) ; get length of flushee + ASH B,-PGSHFT ; to negative # of pages + ADD C,B ; update amount needed +IFN ITS,SETZM FB.PTR(F) ; indicate it will be gone +IFE ITS,MOVNS FB.PTR(F) ; save page info for flushing pages + JUMPG C,GL1 ; jump if more to get + +; Now compact pure space + + PUSH P,A ; need all acs + HRRZ D,PURVEC ; point to first in core addr order + HRRZ C,PURTOP +IFE ITS,[ + SKIPE MULTSG + HRLI C,(E) ; adjust for segment +] + ASH C,-PGSHFT ; to page number + SETZB F,A + +CL1: ADD D,PURVEC+1 ; to real pointer + SKIPGE FB.PTR(D) ; skip if this one is a flushee + JRST CL2 ; this one stays + +IFE ITS,[ + PUSH P,C + PUSH P,D + HRRZ C,FB.PGS(D) ; is this from SAV FILE? + JUMPN C,CLFOUT ; yes. don't bother flushing pages + MOVN C,FB.PTR(D) ; get aobjn pointer to code in C + SETZM FB.PTR(D) ; and flush this because it works (sorry) + ASH C,-PGSHFT ; pages speak louder than words + HLRE D,C ; # of pages saved here for unmap + HRLI C,.FHSLF ; C now contains myfork,,lowpage + MOVE A,C ; put that in A for RMAP + RMAP ; A now contains JFN in left half + MOVE B,C ; ac roulette: get fork,,page into B for PMAP + HLRZ C,A ; hold JFN in C for future CLOSF + MOVNI A,1 ; say this page to be unmapped +CLFLP: PMAP ; do the unmapping + ADDI B,1 ; next page + AOJL D,CLFLP ; continue for all pages + MOVE A,C ; restore JFN + CLOSF ; and close it, throwing away the JFN + JFCL ; should work in 95/100 cases +CLFOU1: POP P,D ; fatal error if can't close + POP P,C +] + HRRZ D,FB.AGE(D) ; point to next one in chain + JUMPN F,CL3 ; jump if not first one + HRRM D,PURVEC ; and use its next as first + JRST CL4 + +IFE ITS,[ +CLFOUT: SETZM FB.PTR(D) ; zero the code pointer + JRST CLFOU1 +] + +CL3: HRRM D,FB.AGE(F) ; link up + JRST CL4 + +; Found a stayer, move it if necessary + +CL2: +IFE ITS,[ + SKIPN MULTSG + JRST CL9 + LDB F,[220500,,FB.PTR(D)] ; check segment + CAIE E,(F) + JRST CL6X ; no other segs move at all +] +CL9: MOVEI F,(D) ; another pointer to slot + HLRE B,FB.PTR(D) ; - length of block +IFE ITS,[ + TRZ B,<-1>#<(FB.CNT)> + MOVE D,FB.PTR(D) ; pointer to block + TLZ D,(FB.CNT) ; kill count bits +] +IFN ITS, HRRZ D,FB.PTR(D) + SUB D,B ; point to top of block + ASH D,-PGSHFT ; to page number + CAMN D,C ; if not moving, jump + JRST CL6 + + ASH B,-PGSHFT ; to pages +IFN ITS,[ +CL5: SUBI C,1 ; move to pointer and from pointer + SUBI D,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D] + .LOSE %LSSYS + AOJL B,CL5 ; count down +] +IFE ITS,[ + PUSH P,B ; save # of pages + MOVEI A,-1(D) ; copy from pointer + HRLI A,.FHSLF ; get this fork code + RMAP ; get a JFN (hopefully) + EXCH D,(P) ; D # of pages (save from) + ADDM D,(P) ; update from + MOVEI B,-1(C) ; to pointer in B + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX ; read/execute modes + + SKIPN OPSYS + JRST CCL1 + PMAP ; move a page + SUBI A,1 + SUBI B,1 + AOJL D,.-3 ; move them all + AOJA B,CCL2 + +CCL1: TLO C,PM%CNT + MOVNS D + SUBI B,-1(D) + SUBI A,-1(D) + HRRI C,(D) + PMAP + +CCL2: MOVEI C,(B) + POP P,D +] +; Update the table address for this loser + + SUBM C,D ; compute offset (in pages) + ASH D,PGSHFT ; to words + ADDM D,FB.PTR(F) ; update it +CL7: HRRZ D,FB.AGE(F) ; chain on +CL4: TRNN D,EOC ; skip if end of chain + JRST CL1 + + ASH C,PGSHFT ; to words +IFN ITS, MOVEM C,PURBOT ; reset pur bottom +IFE ITS,[ + SKIPN MULTSG + JRST CLXX + + HRRZM C,PURBTB-FSEG(E) + CAIA +CLXX: MOVEM C,PURBOT ; reset pur bottom +] + POP P,A + POPJ P, + +IFE ITS,[ +CL6X: MOVEI F,(D) ; chain on + JRST CL7 +] +CL6: +IFN ITS, HRRZ C,FB.PTR(F) ; get new top of world +IFE ITS,[ + MOVE C,FB.PTR(F) + TLZ C,(FB.CNT) +] + ASH C,-PGSHFT ; to page # + JRST CL7 + +IFE ITS,[ +PURTBU: PUSH P,A + PUSH P,B + + MOVN B,NSEGS + HRLZS B + MOVE A,PURTOP + +PURTB2: CAMGE A,PURBTB(B) + JRST PURTB1 + MOVE A,PURBTB(B) + MOVEM A,PURBOT +PURTB1: AOBJN B,PURTB2 + + POP P,B + POP P,A + POPJ P, +] + + ; SUBR to create an entry in the vector for one of these guys + +MFUNCTION PCODE,SUBR + + ENTRY 2 + + GETYP 0,(AB) ; check 1st arg is string + CAIE 0,TCHSTR + JRST WTYP1 + GETYP 0,2(AB) ; second must be fix + CAIE 0,TFIX + JRST WTYP2 + + MOVE A,(AB) ; convert name of program to sixbit + MOVE B,1(AB) + PUSHJ P,STRTO6 +PCODE4: MOVE C,(P) ; get name in sixbit + +; Now look for either this one or an empty slot + + MOVEI E,0 + MOVE B,PURVEC+1 + +PCODE2: CAMN C,FB.NAM(B) ; skip if this is not it + JRST PCODE1 ; found it, drop out of loop + JUMPN E,.+3 ; dont record another empty if have one + SKIPN FB.NAM(B) ; skip if slot filled + MOVE E,B ; remember pointer + ADD B,[ELN,,ELN] + JUMPL B,PCODE2 ; jump if more to look at + + JUMPE E,PCODE3 ; if E=0, error no room + MOVEM C,FB.NAM(E) ; else stash away name and zero rest + SETZM FB.PTR(E) + SETZM FB.AGE(E) + CAIA +PCODE1: MOVE E,B ; build ,, + MOVEI 0,0 ; flag whether new slot + SKIPE FB.PTR(E) ; skip if mapped already + MOVEI 0,1 + MOVE B,3(AB) + HLRE D,E + HLRE E,PURVEC+1 + SUB D,E + HRLI B,(D) + MOVSI A,TPCODE + SKIPN NOSHUF ; skip if not shuffling + JRST FINIS + JUMPN 0,FINIS ; jump if winner + PUSH TP,A + PUSH TP,B + HLRZ A,B + PUSHJ P,PLOAD + JRST PCOERR + POP TP,B + POP TP,A + JRST FINIS + +PCOERR: ERRUUO EQUOTE PURE-LOAD-FAILURE + +PCODE3: HLRE A,PURVEC+1 ; get current length + MOVNS A + ADDI A,10*ELN ; add 10(8) more entry slots + PUSHJ P,IBLOCK + EXCH B,PURVEC+1 ; store new one and get old + HLRE A,B ; -old length to A + MOVSI B,(B) ; start making BLT pointer + HRR B,PURVEC+1 + SUBM B,A ; final dest to A +IFE ITS, HRLI A,-1 ; force local index + BLT B,-1(A) + JRST PCODE4 + +; Here if must try to GC for some more core + +ASKAGC: SKIPE GCFLG ; if already in GC, lose +IFN ITS, POPJ P, +IFE ITS, JRST SPOPJ + MOVEM A,0 ; amount required to 0 + ASH 0,PGSHFT ; TO WORDS + MOVEM 0,GCDOWN ; pass as funny arg to AGC + EXCH A,C ; save A from gc's destruction +IFN ITS,.IOPUSH MAPCH, ; gc uses same channel + PUSH P,C + SETOM PLODR + MOVE C,[8,,9.] ; SET UP INDICATORS FOR GC + PUSHJ P,AGC + SETZM PLODR + POP P,C +IFN ITS,.IOPOP MAPCH, + EXCH C,A +IFE ITS,[ + JUMPL C,.+3 + JUMPL E,GETPAG + JRST GETPAX +] +IFN ITS, JUMPGE C,GETPAG + ERRUUO EQUOTE NO-MORE-PAGES + +; Here to clean up pure space by flushing all shared stuff + +PURCLN: SKIPE NOSHUF + POPJ P, + MOVEI B,EOC + HRRM B,PURVEC ; flush chain pointer + MOVE B,PURVEC+1 ; get pointer to table +CLN1: SETZM FB.PTR(B) ; zero pointer entry + SETZM FB.AGE(B) ; zero link and age slots + SETZM FB.PGS(B) + ADD B,[ELN,,ELN] ; go to next slot + JUMPL B,CLN1 ; do til exhausted + MOVE B,PURBOT ; now return pages + SUB B,PURTOP ; compute page AOBJN pointer +IFE ITS, SETZM MAPJFN ; make sure zero mapjfn + JUMPE B,CPOPJ ; no pure pages? + MOVSI B,(B) + HRR B,PURBOT + ASH B,-PGSHFT +IFN ITS,[ + DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] + .LOSE %LSSYS +] +IFE ITS,[ + + SKIPE MULTSG + JRST CLN2 + HLRE D,B ; - # of pges to flush + HRLI B,.FHSLF ; specify hacking hom fork + MOVNI A,1 + MOVEI C,0 + + PMAP + ADDI B,1 + AOJL D,.-2 +] + + MOVE B,PURTOP ; now fix up pointers + MOVEM B,PURBOT ; to indicate no pure +CPOPJ: POPJ P, + +IFE ITS,[ +CLN2: HLRE C,B ; compute pos no. pages + HRLI B,.FHSLF + MOVNS C + MOVNI A,1 ; flushing pages + HRLI C,PM%CNT + MOVE D,NSEGS + MOVE E,PURTOP ; for munging table + ADDI B,_9. ; do it to the correct segment + PMAP + ADDI B,1_9. ; cycle through segments + HRRZM E,PURBTB(D) ; mung table + SOJG D,.-3 + + MOVEM E,PURBOT + POPJ P, +] + +; Here to move the entire pure space. +; A/ # and direction of pages to move (+ ==> up) + +MOVPUR: SKIPE NOSHUF + FATAL CANT MOVE PURE SPACE AROUND +IFE ITS,ASH A,1 + SKIPN B,A ; zero movement, ignore call + POPJ P, + + ASH B,PGSHFT ; convert to words for pointer update + MOVE C,PURVEC+1 ; loop through updating non-zero entries + SKIPE 1(C) + ADDM B,1(C) + ADD C,[ELN,,ELN] + JUMPL C,.-3 + + MOVE C,PURTOP ; found pages at top and bottom of pure + ASH C,-PGSHFT + MOVE D,PURBOT + ASH D,-PGSHFT + ADDM B,PURTOP ; update to new boundaries + ADDM B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; in multi-seg mode, must mung whole table + JRST MOVPU1 + MOVN E,NSEGS + HRLZS E + ADDM PURBTB(E) + AOBJN E,.-1 +] +MOVPU1: CAIN C,(D) ; differ? + POPJ P, + JUMPG A,PUP ; if moving up, go do separate CORBLKs + +IFN ITS,[ + SUBM D,C ; -size of area to C (in pages) + MOVEI E,(D) ; build pointer to bottom of destination + ADD E,A + HRLI E,(C) + HRLI D,(C) + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D] + .LOSE %LSSYS + POPJ P, + +PUP: SUBM C,D ; pages to move to D + ADDI A,(C) ; point to new top + +PUPL: SUBI C,1 + SUBI A,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C] + .LOSE %LSSYS + SOJG D,PUPL + POPJ P, +] +IFE ITS,[ + SUBM D,C ; pages to move to D + MOVSI E,(C) ; build aobjn pointer + HRRI E,(D) ; point to lowest + ADD D,A ; D==> new lowest page + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS3 + MOVEI F,FSEG-1 + ADD F,NSEGS + ASH F,9. +XPLS3: MOVE G,E + MOVE H,D ; save for outer loop + +PURCL1: MOVSI A,.FHSLF ; specify here + HRRI A,(E) ; get a page + IORI A,(F) ; hack seg i + RMAP ; get a real handle on it + MOVE B,D ; where to go + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX + IORI A,(F) + PMAP + ADDI D,1 + AOBJN E,PURCL1 + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PURCL1 + +PUP: SUB D,C ; - count to D + MOVSI E,(D) ; start building AOBJN + HRRI E,(C) ; aobjn to top + ADD C,A ; C==> new top + MOVE D,C + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS31 + MOVEI F,FSEG + ADD F,NSEGS + ASH F,9. +XPLS31: MOVE G,E + MOVE H,D ; save for outer loop + +PUPL: MOVSI A,.FHSLF + HRRI A,(E) + IORI A,(F) ; segment + RMAP ; get real handle + MOVE B,D + HRLI B,.FHSLF + IORI B,(F) + MOVSI C,PM%RD+PM%EX + PMAP + SUBI E,2 + SUBI D,1 + AOBJN E,PUPL + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PUPL + + POPJ P, +] +IFN ITS,[ +.GLOBAL CSIXBT +CSIXBT: MOVEI 0,5 + PUSH P,[440700,,C] + PUSH P,[440600,,D] + MOVEI D,0 +CSXB2: ILDB E,-1(P) + CAIN E,177 + JRST CSXB1 + SUBI E,40 + IDPB E,(P) + SOJG 0,CSXB2 +CSXB1: SUB P,C%22 + MOVE C,D + POPJ P, +] +GENVN: MOVE C,[440700,,MUDSTR+2] + MOVEI D,5 + MOVEI B,0 +VNGEN: ILDB 0,C + CAIN 0,177 + POPJ P, + IMULI B,10. + SUBI 0,60 + ADD B,0 + SOJG D,VNGEN + POPJ P, + +IFE ITS,[ +MSKS: 774000,,0 + 777760,,0 + 777777,,700000 + 777777,,777400 + 777777,,777776 +] + + ; THESE ARE DIRECTORY SEARCH ROUTINES + + +; THIS ROUTINE DOES A BINARY SEARCH ON A DIRECTORY AND RETURNS A POINTER +; RESTED DOWN TO THE APPROPRIATE SLOT IN THE DIRECTORY. +; ARGS: E==DIR POINTER D==FILE-NAME 1 A==VERSION # +; RETS: A==RESTED DOWN DIRECTORY + +DIRSR1: TLOA 0,400000 ; INDICATION OF ONE ARGUMENT SEARCH +DIRSRC: TLZ 0,400000 ; INDICATOR OF 2 ARGUMENT SEARCH + PUSH P,A ; SAVE VERSION # + HLRE B,E ; GET LENGTH INTO B + MOVNS B + MOVE A,E + HRLS B ; GET BOTH SIDES +UP: ASH B,-1 ; HALVE TABLE + AND B,[-2,,-2] ; FORCE DIVIS BY 2 + MOVE C,A ; COPY POINTER + JUMPLE B,LSTHLV ; CANT GET SMALLER + ADD C,B +IFE ITS, HRRZ F,C ; avoid lossage in multi-sections +IFN ITS, CAMLE D,(C) ; SKIP IF EITHER FOUND OR IN TOP +IFE ITS, CAMLE D,(F) ; SKIP IF EITHER FOUND OR IN TOP + MOVE A,C ; POINT TO SECOND HALF +IFN ITS, CAMN D,(C) ; SKIP IF NOT FOUND +IFE ITS, CAMN D,(F) ; SKIP IF NOT FOUND + JRST WON +IFN ITS, CAML D,(C) ; SKIP IF IN TOP HALF +IFE ITS, CAML D,(F) ; SKIP IF IN TOP HALF + JRST UP + HLLZS C ; FIX UP POINTER + SUB A,C + JRST UP + +WON: JUMPL 0,SUPWIN + MOVEI 0,0 ; DOWN FLAG +WON1: LDB A,[221200,,1(C)] ; GET VERSION NUMBER + CAMN A,(P) ; SKIP IF NOT EQUAL + JRST SUPWIN + CAMG A,(P) ; SKIP IF LT + JRST SUBIT + SETO 0, + SUB C,C%22 ; GET NEW C + JRST SUBIT1 + +SUBIT: ADD C,C%22 ; SUBTRACT + JUMPN 0,C1POPJ +SUBIT1: +IFN ITS, CAMN D,(C) ; SEE WHETHER WERE STILL WINNING +IFE ITS,[ + HRRZ F,C + CAMN D,(F) +] + JRST WON1 +C1POPJ: SUB P,C%11 ; GET RID OF VERSION # + POPJ P, ; LOSE LOSE LOSE +SUPWIN: MOVE A,C ; RETURN ARGUMENT IN A + AOS -1(P) ; SKIP RETURN INDICATES IT WAS FOUND + JRST C1POPJ + +LSTHLV: +IFN ITS, CAMN D,(C) ; LINEAR SEARCH REST +IFE ITS,[ + HRRZ F,C + CAMN D,(F) ; LINEAR SEARCH REST +] + JRST WON + ADD C,C%22 + JUMPL C,LSTHLV + JRST C1POPJ + + ; ROUTINE TO GET A DIRECTORY. ASSUMES MAPCH IS OPEN TO FIXUP OR SAV FILE AND 0 IS THE +; LAST CHAR TO BE HASHED. RETURNS POINTER TO DIRECTORY IN E + +IFN ITS,[ +GETDIR: PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + MOVEI C,(B) + ASH C,-10. + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],[1000,,0]] + PUSHJ P,SLEEPR + POP P,0 + IDIV 0,(B) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(B) + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],(A)] + PUSHJ P,SLEEPR + MOVN E,(B) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(B) + POP P,C + POPJ P, +] +; IN WONDERFUL TOPS20 VERSION DIRCHN CONTAINS THE JFN + +IFE ITS,[ +GETDIR: JRST @[.+1] + PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + HRROI E,(B) + ASH B,-9. + HRLI B,.FHSLF ; SET UP DESTINATION (CORE) + MOVS A,DIRCHN ; SET UP SOURCE (FILE) + MOVSI C,PM%RD+PM%EX ; READ+EXEC ACCESS + PMAP + POP P,0 + IDIV 0,(E) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(E) ; POINT TO THE DIRECTORY ENTRY + MOVE A,(A) ; GET THE PAGE NUMBER + HRL A,DIRCHN ; SET UP SOURCE (FILE) + PMAP ; AGAIN READ IN DIRECTORY + MOVEI A,(E) + MOVN E,(E) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(A) + POP P,C + SKIPN MULTSG + POPJ P, + POP P,21 + SETZM 20 + XJRST 20 +] +; HERE IF CAN'T FIND FIXUP FILE IN MAIN DIRECTORY + +NOFXUP: +IFE ITS,[ + MOVE A,DIRCHN ; JFN FOR FIXUP FILE + CLOSF ; CLOSE IT + JFCL +] + MOVE A,FXTBL ; GET AOBJN POINTER TO FIXUP TABLE +NOFXU1: HRRZ B,(A) ; GET VERSION TO TRY + HRRM B,VER(P) ; STUFF IN VERSION + MOVEI B,1 ; DUMP IN FIXUP INDICATOR + HRLM B,VER(P) + MOVEM A,TEMP(P) ; SAVE POINTER TO FXTBL + PUSHJ P,OPXFIL ; LOOK FOR FIXUP FILE + JRST NOFXU2 + PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + HRRZS VER(P) ; INDICATE SAV FILE + PUSHJ P,OPXFIL ; TRY OPENING IT + JRST MAPLS0 ; GIVE UP NO SAV FILE TO BE HAD + PUSHJ P,RSAV + JRST FXUPGO ; GO FIXUP THE WORLD +NOFXU2: MOVE A,TEMP(P) ; GET BACK POINTER + AOBJN A,NOFXU1 ; TRY NEXT + JRST MAPLS1 ; NO FILE TO BE HAD + +GETIT: HRRZM B,SPAG(P) ; GET BLOCK OF START + HLRZM B,FLEN(P) ; DAMMIT SAVE THIS! + HLRZ A,B ; GET LENGTH +IFN ITS,[ + .CALL MNBLK + PUSHJ P,TRAGN +] +IFE ITS,[ + MOVE E,MAPJFN + MOVEM E,DIRCHN +] + + JRST PLOD1 + +; ROUTINE TO SEE IF FILE IS NOT OPEN BECAUSE OF FNF AND FATAL IF SO + +IFN ITS,[ +TRAGN: PUSH P,0 ; SAVE 0 + .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIN 0,4 ; SKIP IF NOT FNF + FATAL MAJOR FILE NOT FOUND + POP P,0 + SOS (P) + SOS (P) ; RETRY OPEN + POPJ P, +] +IFE ITS,[ +OPSAV: MOVSI A,%GJSHT+%GJOLD ; BITS FOR GTJFN + HRROI B,SAVSTR ; STRING POINTER + SKIPE OPSYS + HRROI B,TSAVST + GTJFN + FATAL CANT FIND SAV FILE + MOVEM A,MAPJFN ; STORE THE JFN + MOVE B,[440000,,OF%RD+OF%EX+OF%THW+OF%DUD] + OPENF + FATAL CANT OPEN SAV FILE + POPJ P, +] + +; OPMFIL IS USED TO OPEN A FILE ON MUDTMP. IT CAN OPEN EITHER A SAV OR FIXUP FILE +; AND THE VERSION NUMBER IS SPECIFIED. THE ARGUMENTS ARE +; NAM-1(P) HAS SIXBIT OF FILE NAME +; VER-1(P) HAS 0,,VERSION # FOR SAV FILE AND 1,,VERSION# FOR FIXUP FILE +; RETURNS LENGTH OF FILE IN SLEN AND + +; OPXFIL IS A KLUDGE FOR GETTING SAV AND FIXUP FILES OFF OF THE MDLLIB +; DIRECTORY DURING THE CHANGEOVER TO PRE- AND POST- MUDSAV WORLDS + +OPXFIL: MOVEI 0,1 + MOVEM 0,WRT-1(P) + JRST OPMFIL+1 + +OPWFIL: SETOM WRT-1(P) + SKIPA +OPMFIL: SETZM WRT-1(P) + +IFN ITS,[ + HRRZ C,VER-1(P) ; GET VERSION NUMBER + PUSHJ P,NTOSIX ; CONVERT TO SIXBIT + HRLI C,(SIXBIT /SAV/) ; BUILD SECOND FILE NAME + HLRZ 0,VER-1(P) + SKIPE 0 ; SKIP IF SAV + HRLI C,(SIXBIT/FIX/) + MOVE B,NAM-1(P) ; GET NAME + MOVSI A,7 ; WRITE MODE + SKIPL WRT-1(P) + MOVSI A,6 ; READ MODE +RETOPN: .CALL FOPBLK + JRST OPCHK ; SEE IF FIXUP IS NECESSARY OR JUST REOPENING + DOTCAL FILLEN,[[1000,,MAPCH],[2000,,A]] + .LOSE 1000 + ADDI A,PGMSK ; ROUND + ASH A,-PGSHFT ; TO PAGES + MOVEM A,FLEN-1(P) + SETZM SPAG-1(P) + AOS (P) ; SKIP RETURN TO SHOW SUCCESS + POPJ P, + +OPCHK: .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIE 0,4 ; SKIP IF FNF + JRST OPCHK1 ; RETRY + POPJ P, + +OPCHK1: MOVEI 0,1 ; SLEEP FOR A WHILE + .SLEEP + JRST OPCHK + +; NTOSIX GETS NUMBER IN C AND CONVERTS IT TO SIXBIT AND RETURNS RESULT IN C + +NTOSIX: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[220600,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + SKIPN A + JRST ALADD + ADDI A,20 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + SKIPN C + SKIPE A ; IF BOTH 0 BLANK DIGIT + ADDI A,20 + IDPB A,D + SKIPN C + SKIPE B + ADDI B,20 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +IFE ITS,[ + MOVE E,P ; save pdl base + MOVE B,NAM-1(E) ; GET FIRST NAME + PUSH P,C%0 ; [0]; slots for building strings + PUSH P,C%0 ; [0] + MOVE A,[440700,,1(E)] + MOVE C,[440600,,B] + +; DUMP OUT SIXBIT NAME + + MOVEI D,6 + ILDB 0,C + JUMPE 0,.+4 ; violate cardinal ".+ rule" + ADDI 0,40 ; to ASCII + IDPB 0,A + SOJG D,.-4 + + MOVE 0,[ASCII / SAV/] + HLRZ C,VER-1(E) ; GET SAV/FIXUP FLAG + SKIPE C + MOVE 0,[ASCII / FIX/] + PUSH P,0 + HRRZ C,VER-1(E) ; get ascii of vers no. + PUSHJ P,NTOSEV ; CONVERT TO STRING LEFT JUSTIFIED + PUSH P,C + MOVEI B,-1(P) ; point to it + HRLI B,260700 + HRROI D,1(E) ; point to name + MOVEI A,1(P) + MOVSI 0,100000 ; INPUT FILE (GJ%OLD) + SKIPGE WRT-1(E) + MOVSI 0,400000 ; OUTPUT FILE (GJ%FOU) + PUSH P,0 + PUSH P,[377777,,377777] + MOVE 0,[-1,,[ASCIZ /DSK/]] + SKIPN OPSYS + MOVE 0,[-1,,[ASCIZ /PS/]] + PUSH P,0 + HRROI 0,[ASCIZ /MDL/] + SKIPLE WRT-1(E) + HRROI 0,[ASCIZ /MDLLIB/] ; USE MDLLIB FOR SPECIAL CASE + PUSH P,0 + PUSH P,D + PUSH P,B + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + MOVEI B,0 + MOVE D,4(E) ; save final version string + GTJFN + JRST OPMLOS ; FAILURE + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + SKIPGE WRT-1(E) + MOVE B,[440000,,OF%RD+OF%WR] + OPENF + FATAL OPENF FAILED + MOVE P,E ; flush crap + PUSH P,A + SIZEF ; get length + JRST MAPLOS + SKIPL WRT-1(E) + MOVEM C,FLEN-1(E) ; ONLY SAVE LENGTH FOR READ JFNS + SETZM SPAG-1(E) + +; RESTORE STACK AND LEAVE + + MOVE P,E + MOVE A,C ; NUMBER OF PAGES IN A, DAMN! + AOS (P) + POPJ P, + +OPMLOS: MOVE P,E + POPJ P, + +; CONVERT A NUMBER IN C TO AN ASCII STRING LEFT JUSTIFIED IN C + +NTOSEV: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[440700,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + JUMPE A,ALADD + ADDI A,60 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + ADDI A,60 + IDPB A,D +ALADD1: ADDI B,60 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +; ROUTINE TO READ IN THE FIXUPS FROM DIRCHN OR MAPCH WORKS +; FOR FIXUP FILE OR FIXUPS IN A SEPERATE FILE AS LONG AS THE +; CHANNEL IS OPENED AND ACCESSED TO THE RIGHT PLACE + +RFXUP: +IFN ITS,[ + MOVE 0,[-2,,A] ; PREPARE TO READ VERSION AND LENGTH + .IOT MAPCH,0 ; READ IT IN + SKIPGE 0 ; SKIP IF NOT HIT EOF + FATAL BAD FIXUP FILE + MOVEI A,-2(A) ; COUNT FOR FIRST 2 WORDS + HRRM B,VER-1(P) ; SAVE VERSION # + .IOPUS MAPCH, ; PUSH THE MAPPING CHANNEL + SETOM PLODR + PUSHJ P,IBLOCK ; GET A UVECTOR OF APPROPRIATE SIZE + SETZM PLODR + .IOPOP MAPCH, + MOVE 0,$TUVEC + MOVEM 0,-1(TP) ; SAVE UVECTOR + MOVEM B,(TP) + MOVE A,B ; GET AOBJN POINTER TO UVECTOR FOR IOT + .IOT MAPCH,A ; GET FIXUPS + .CLOSE MAPCH, + POPJ P, +] + +IFE ITS,[ + MOVE A,DIRCHN + BIN ; GET LENGTH OF FIXUP + MOVE C,B + MOVE A,DIRCHN + BIN ; GET VERSION NUMBER + HRRM B,VER-1(P) + SETOM PLODR + MOVEI A,-2(C) + PUSHJ P,IBLOCK + SETZM PLODR + MOVSI 0,$TUVEC + MOVEM 0,-1(TP) + MOVEM B,(TP) + MOVE A,DIRCHN + HLRE C,B +; SKIPE OPSYS ; SKIP IF TOPS20 SINCE C MUST BE NEGETIVE +; MOVNS C ; C IS POSITIVE FOR TENEX ????? + HRLI B,444400 + SIN + MOVE A,DIRCHN + CLOSF + FATAL CANT CLOSE FIXUP FILE + RLJFN + JFCL + POPJ P, +] + +; ROUTINE TO READ IN THE CODE + +RSAV: MOVE A,FLEN-1(P) + PUSHJ P,ALOPAG ; GET PAGES + JRST MAPLS2 + MOVE E,SPAG-1(P) + +IFN ITS,[ + MOVN A,FLEN-1(P) ; build aobjn pointer + MOVSI A,(A) + HRRI A,(B) + MOVE B,A + HRRI 0,(E) + DOTCAL CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, + POPJ P, +] +IFE ITS,[ + PUSH P,B ; SAVE PAGE # + MOVS A,DIRCHN ; SOURCE (MUDSAV) + HLRM A,SJFNS ; SAVE POINTER FOR FUTURE CLOSING + HRR A,E + HRLI B,.FHSLF ; DESTINATION (FORK) + MOVSI C,PM%RD+PM%CPY ; MAKE COPY ON WRITE + SKIPE OPSYS + JRST RSAV1 ; HANDLE TENEX + TLO C,PM%CNT ; REPEAT COUNT BIT FOR TOPS20 + HRR C,FLEN-2(P) ; PAGE (FOR PUSHJ AND PUSHED B) + PMAP +RSAVDN: POP P,B + MOVN 0,FLEN-1(P) + HRL B,0 + POPJ P, + +RSAV1: HRRZ D,FLEN-2(P) ; GET IN PAGE COUNT +RSAV2: PMAP + ADDI A,1 ; NEXT PAGE + ADDI B,1 + SOJN D,RSAV2 ; LOOP + JRST RSAVDN +] + +PDLOV: SUB P,[NSLOTS,,NSLOTS] + PUSH P,C%0 ; [0]; CAUSE A PDL OVERFLOW + JRST .-1 + +; CONSTANTS RELATED TO DATA BASE +DEV: SIXBIT /DSK/ +MODE: 6,,0 +MNDIR: SIXBIT /MUDSAV/ ; DIR OF MAIN DATA BASE FILES +WRKDIR: SIXBIT /MUDTMP/ ; DIRECTORY OF UPDATE FILES + +IFN ITS,[ +MNBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /SAV/] + [SIXBIT /FILE/] + SETZ MNDIR + + +FIXBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /FIXUP/] + [SIXBIT /FILE/] + SETZ MNDIR + +FOPBLK: SETZ + SIXBIT /OPEN/ + A + DEV + B + C + SETZ WRKDIR + +FXTBL: -2,,.+1 + 55. + 54. +] +IFE ITS,[ + +FXSTR: ASCIZ /PS:FIXUP.FILE/ +SAVSTR: ASCIZ /PS:SAV.FILE/ +TFXSTR: ASCIZ /DSK:FIXUP.FILE/ +TSAVST: ASCIZ /DSK:SAV.FILE/ + +FXTBL: -3,,.+1 + 55. + 54. + 104. +] +IFN SPCFXU,[ + +;This code does two things to code for FBIN; +; 1) Makes dispatches win in multi seg mode +; 2) Makes OBLIST? work with "new" atom format +; 3) Makes LENGTH win in multi seg mode +; 4) Gets AOBJN pointer to code vector in C + +SFIX: PUSH P,A + PUSH P,B + PUSH P,C ; for referring back + +SFIX1: MOVSI B,-MLNT ; for looping through tables + +SFIX2: MOVE A,(C) ; get code word + + AND A,SMSKS(B) + CAMN A,SPECS(B) ; do we match + JRST @SFIXR(B) + + AOBJN B,SFIX2 + +SFIX3: AOBJN C,SFIX1 ; do all of code +SFIX4: POP P,C + POP P,B + POP P,A + POPJ P, + +SMSKS: -1 + 777000,,-1 + -1,,0 + 777037,,0 +MLNT==.-SMSKS + +SPECS: HLRES A ; begin of arg diaptch table + SKIPN 2 ; old compiled OBLIST? + JRST (M) ; compiled LENGTH + ADDI (M) ; begin a case dispatch + +SFIXR: SETZ DFIX + SETZ OBLFIX + SETZ LFIX + SETZ CFIX + +DFIX: AOBJP C,SFIX4 ; make sure dont run out + MOVE A,(C) ; next ins + CAME A,[ASH A,-1] ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 ; make sure dont run out + HLRZ A,(C) ; next ins + CAIE A,(ADDI A,(M)) ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 + HLRZ A,(C) + CAIE A,(PUSHJ P,@(A)) ; last one to check + JRST SFIX3 + AOBJP C,SFIX4 + MOVE A,(C) + CAME A,[JRST FINIS] ; extra check + JRST SFIX3 + + MOVSI B,(SETZ) +SFIX5: AOBJP C,SFIX4 + HLRZ A,(C) + CAIN A,(SUBM M,(P)) + JRST SFIX3 + CAIE A,M ; dispatch entry? + JRST SFIX3 ; maybe already fixed + IORM B,(C) ; fix it + JRST SFIX5 + +OBLFIX: PUSH P,[-TLN,,TPTR] + PUSH P,C + MOVE B,-1(P) + +OBLFXY: PUSH P,1(B) + PUSH P,(B) + +OBLFI1: AOBJP C,OBLFXX + MOVE A,(C) + AOS B,(P) + AND A,(B) + MOVE B,-1(P) + CAME A,(B) + JRST OBLFXX + AOBJP B,DOOBFX + MOVEM B,-1(P) + JRST OBLFI1 + +OBLFXX: SUB P,C%22 ; for checking more ins + MOVE B,-1(P) + ADD B,C%22 + JUMPGE B,OBLFX1 + MOVEM B,-1(P) + MOVE C,(P) + JRST OBLFXY + + +INSBP==331100 ; byte pointer for ins field +ACBP==270400 ; also for ac +INDXBP==220400 + +DOOBFX: MOVE C,-2(P) + SUB P,C%44 + MOVEI B,<<(HRRZ)>_<-9>> ; change em + DPB B,[INSBP,,(C)] ; SKIPN==>HRRZ + LDB A,[ACBP,,(C)] ; get AC field + MOVEI B,<<(JUMPE)>_<-9>> + DPB B,[INSBP,,1(C)] + DPB A,[ACBP,,1(C)] + AOS 1(C) ; JRST FOO==>JUMPE ac,FOO+1 + MOVE B,[CAMG VECBOT] + DPB A,[ACBP,,B] + MOVEM B,2(C) ; JUMPL ==> CAMG ac,VECBOT + HRRZ A,3(C) ; get indicator of existence of ADD AC,TVP + CAIE A,TVP ; skip if extra ins exists + JRST NOATVP + MOVSI A,(JFCL) + EXCH A,4(C) + MOVEM A,3(C) + ADD C,C%11 +NOATVP: TLC B,(CAMG#HRLI) ; change CAMG to HRLI (preserving AC) + HRRZ A,4(C) ; see if moves in type + CAIE A,$TOBLS + SUB C,[1,,1] ; fudge it + HLLOM B,5(C) ; in goes HRLI -1 + CAIE A,$TOBLS ; do we need a skip? + JRST NOOB$ + MOVSI B,(CAIA) ; skipper + EXCH B,6(C) + MOVEM B,7(C) + ADD C,[7,,7] + JRST SFIX3 + +NOOB$: MOVSI B,(JFCL) + MOVEM B,6(C) + ADD C,C%66 + JRST SFIX3 + +OBLFX1: MOVE C,(P) + SUB P,C%22 + JRST SFIX3 + +; Here to fixup compiled LENGTH + +LFIX: MOVSI B,-LLN ; for checking other LENGTH ins + PUSH P,C + +LFIX1: AOBJP C,LFIXX + MOVE A,(C) + AND A,LMSK(B) + CAME A,LINS(B) +LFIXX: PUSHJ P,OBLFI2 ; never POPJs, just to make P stack in good + ; state + AOBJN B,LFIX1 + + POP P,C ; restore code pointer + MOVE A,(C) ; save jump for its addr + MOVE B,[MOVSI 400000] + MOVEM B,(C) ; JRST .+2 ==> MOVSI 0,400000 + LDB B,[ACBP,,1(C)] ; B==> AC of interest + ADDI A,2 + DPB B,[ACBP,,A] + MOVEI B,<<(JUMPE)>_<-9.>> + DPB B,[INSBP,,A] + EXCH A,1(C) + TLC A,(HRR#HRRZ) ; HRR==>HRRZ + HLLZM A,2(C) ; TRNN AC,-1 ==> HRRZ AC,(AC) + MOVEI B,(AOBJN (M)) + HRLM B,3(C) ; AOBJP AC,.-2 ==> AOBJN 0,.-2 + MOVE B,2(C) ; get HRRZ AC,(AC) + TLZ B,17 ; kill (AC) part + MOVEM B,4(C) ; HLRZS AC ==> HRRZ AC,0 + ADD C,C%44 + JRST SFIX3 + +; Fixup a CASE dispatch + + CFIX: LDB A,[ACBP,,(C)] + AOBJP C,SFIX4 + HLRZ B,(C) ; Next ins + ANDI B,777760 + CAIE B,(JRST @) + JRST SFIX3 + LDB B,[INDXBP,,(C)] + CAIE A,(B) + JRST SFIX3 + MOVE A,(C) ; ok, fix it up + TLZ A,20 ; kill indirection + MOVEM A,(C) + HRRZ B,-1(C) ; point to table + ADD B,(P) ; point to code to change + +CFIXLP: HLRZ A,(B) ; check one out + TRZ A,400000 ; kill bit + CAIE A,M ; check for just index (or index with SETZ) + JRST SFIX3 + MOVEI A,(JRST (M)) + HRLM A,(B) + AOJA B,CFIXLP + +DEFINE FOO LBL,LNT,LBL2,L +LBL: + IRP A,,[L] + IRP B,C,[A] + B + .ISTOP + TERMIN + TERMIN +LNT==.-LBL +LBL2: + IRP A,,[L] + IRP B,C,[A] + C + .ISTOP + TERMIN + TERMIN +TERMIN + +IMSK==777017,,0 +AIMSK==777000,,-1 + +FOO OINS,OLN,OMSK,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS3,OLN3,OMSK3,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,IMSK],[MOVEI,AIMSK]] + +FOO OINS2,OLN2,OMSK2,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS4,OLN4,OMSK4,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,IMSK],[MOVEI,AIMSK]] + +TPTR: -OLN,,OINS + OMSK-1 + -OLN2,,OINS2 + OMSK2-1 + -OLN3,,OINS3 + OMSK3-1 + -OLN4,,OINS4 + OMSK4-1 +TLN==.-TPTR + +FOO LINS,LLN,LMSK,[[,AIMSK],[,AIMSK],[,IMSK] + [,<-1,,777760>]] + +] +IMPURE + +SAVSNM: 0 ; SAVED SNAME +INPLOD: 0 ; FLAG SAYING WE ARE IN MAPPUR + +IFE ITS,[ +MAPJFN: 0 ; JFN OF SAV FILE +DIRCHN: 0 ; JFN USED BY GETDIR +] + +PURE + +END +