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 MOVE B,FB.PTR(C) 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,LFIXY MOVE A,(C) AND A,LMSK(B) CAME A,LINS(B) JRST LFIXY 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 LFIXY: POP P,C 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