TITLE LNKCOR - CORE MANAGEMENT MODULE FOR LINK SUBTTL D.M.NIXON/DMN/JLd/JBC/JNG/DZN/PAH/PY/HD/JBS 18-Dec-85 ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974,1985,1986. ALL RIGHTS RESERVED. ; ; ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ; ; ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ; ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC IFN TOPS20,< SEARCH MONSYM > ;[1401] IFN TOPS20 SALL ENTRY LNKCOR EXTERN LNKLOG CUSTVR==0 ;CUSTOMER VERSION DECVER==6 ;DEC VERSION DECMVR==0 ;DEC MINOR VERSION DECEVR==2375 ;DEC EDIT VERSION SEGMENT SUBTTL REVISION HISTORY ;START OF VERSION 1A ;40 ADD GENERAL GARBAGE COLLECTOR ;42 TAB.PT NOT REDUCED WHEN CORE GIVEN BACK ;100 FIX BUG IN XX.INI WITH LARGE PROGRAMS ;START OF VERSION 2 ;135 ADD OVERLAY FACILITY ;204 FIX SFU ERROR ;START OF VERSION 2B ;231 (13869) P1 NOT RESTORED IN TIME IN XX.INI ;234 NUL:/SAVE CAUSES PAGING ON NUL: DEVICE, USE DSK INSTEAD ;246 FIX CORE OVERFLOW CALCULATION ;257 Remove edit 231, restores old P1 too soon ;273 Fix disk overflow of high/low segment. ;301 Cope with case where during DSK overflow, not enough ; room found to replace IO.EMG. ;354 LABEL EDIT 234 ;364 Add routine to handle lh fixups in the TITLE block's ; segment data. ;365 Give an error message if about to do a bad fixup. ;371 Define .ERSFU in this module. ;374 Prevent wild transfer of control at LCHCHK. ;415 Respect LS.PP always. ;START OF VERSION 2C ;467 Only allocate the first word of areas that need it in XX.INI ;471 Add code for ALGOL debugging system. ;510 Fixup relocatable symbols in LS area correctly. ;511 Don't do symbol fixups unless entire 3 word block is is core ;516 Handle LS completely full on call to expand LS correctly ; when core is full and some of LS must be paged out. ;517 Add AS.IN routine. ;525 Restore T1 after calling CHKMAX, which uses it. ;530 Define triplet flag bits correctly. ;543 Set PS.MDF correctly on LS fixups. ;544 SOUP in LINK version 3 stuff for TOPS-20. ;556 Check for GS area non-existence at STF.FL (can happen ; if called late in LNKXIT) and skip some stuff if so. ;557 Clean up the listing for release. ;START OF LINK VERSION 3 ;451 CHANGE THE RUC MESSAGE ;START OF VERSION 3A ;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560) ;START OF VERSION 4 ;566 Do page fault fixup of high seg info in seg block right. ;577 Handle TB fixups to the LS area. ;604 Handle NUL: correctly. ;632 Implement $FIXUP. ;640 Make FR.CNT never return too high an answer. ;647 Add argument to GBCK.L indicating how much memory to clear. ;650 Use VM on TOPS-10 if available. ;670 Don't wipe out DY.LNK in LDCR7Y. ;676 Always do POP loop in memory. ;720 Move core upwards in 2 steps if it's .GE. 400000. ;731 SEARCH MACTEN,UUOSYM ;736 Change overflow file protection to standard protection. ;750 When doing overflow or core compress, leave window size of .IWS. ;755 Set and check TAB.ZE table for zeroing free space. ;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765) ;771 Fix bug with shuffling large( .GT. 400000) core segment. ;1104 Remove part of edit 750 from LH.DMP to fix address checks. ;1113 Fix memory bugs when writing overlay tree. ;1130 Don't count memory requests for pagable areas toward /MAXCOR. ;1174 Label and clean up all error messages. ;1214 Fix unmatched angle bracket bugs. ;1217 Clean up the listings for release. ;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220). ;START OF VERSION 4B ;1230 Make overflow files, and hence symbol and .EXE files, end up on right path. ;1275 Fix core management bug when expanding a zero length area with PAGE. ;START OF VERSION 5 ;1221-1477 Maintenance edits ;1401 Native mode handling of overflow files ;1412 Overflow into nonzero sections if loading them. ;1426 FTFRK2 program fork code. ;1442 Make LH.DMP call CRTFRK if a nonzero section is being dumped to. ; Also don't dump to nonexistent section 0 in the program fork. ;1450 Correct typo in call to CRTFRK, save register 16 properly, use ; PRGFRK symbol for fork handling. ;START OF VERSION 5A ;1520 Use GBCK.L to fix pointers in LSREDU. ;1525 Adjust TAB.PT when high or low segment overflows to disk. ;1532 Map 2nd half of overflow window, not 1st half, at CREDU. ;1536 Fix paging of multisection LS areas on the -20. ;1542 Do not add section number to addresses twice at LDCR6C, LDCOR7. ;1543 Avoid using EXTFLG when calling LS.OUT or NEWSCT. ;1771 Add 1 to t2 before call to DY.RET near NEWSC0 ;2023 Try expunging directory for quota exceeded failures with PMAPs. ;2024 Fix edit 2023 and fix typo at OVFOU2+5. ;2026 Update copyright and delete edit banners. ;2044 Always removed mapped area in XX.INI under TOPS-20 ;2051 Don't ask for SPR if DSK: can't be written to for .TMP files ;Start of Version 6 ;2200 Use 30 bit addresses for symbol table fixups. ;2202 Use T1 and T2 as arguments for xx.IN and xx.OUT, fix some PMAPs. ;2213 Fix off by one when testing/setting FXSBIT. ;2214 Add 30 bit symbol fixups. ;2215 Performance improvements for GBCK.L, fix wrong AC bug in 2202. ;2235 Give error if overlay in non-zero section. ;2242 Make NEWSCT global so it can be called from LNKLOD. ;2247 Load program in an inferior fork. ;2254 Remove fail block fixup, update title and seg fixups for 30 bits. ;2255 Remove code which prevents fixups to nonzero LS sections. ;2264 Add module name to LNKCCS, add JSYS errors to LNKIxx and LNKOxx. ;2270 Add pagable TP area for argument typechecking. ;2300 Remove FTFORK code. ;2301 Fix up native TOPS-20 error messages. ;2302 Fix off-by-one in LC.IN/LC.OUT. ;2321 Use halfword LL.S2, left half is non-zero if /SEG:LOW or /REDIRECT. ;2330 Add TOPS-10 versions of xx.IN and xx.OUT. ;2365 Preserve t4 across call to NEWSCT ;2366 Implement sparse paging on TOPS-10. ;2374 Change TP.PT to new global TPPTR. ;2375 Do Copyrights. SUBTTL SIMPLE TESTS FIRST LNKCOR: JUMPE P2,LDCR7Y ;JUST WANT TO SHUFFLE CORE ADDI P2,.IPM ;MAKE SURE ITS A 128 WORD BLOCK ANDCMI P2,.IPM MOVE T1,TAB.UB(P1) ;GET UPPER BOUND LDCOR0: SUB T1,TAB.AB(P1) ;MINUS ACTUAL BOUND CAMGE T1,P2 ;BIG ENOUGH? JRST LDCOR1 ;NO, TRY ONE ABOVE IFN TOPS20,< SKIPN TAB.PG(P1) ;[2202] IS THIS AREA PAGED? JRST LCR1.5 ;[1401] NO, NOTHING SPECIAL MOVE T1,TAB.AB(P1) ;[2202] GET THE CURRENT BOUND SUB T1,TAB.LB(P1) ;[2202] CURRENT SIZE ADD T1,TAB.LW(P1) ;[2202] GET THE UPPER BOUND ADDM P2,TAB.AB(P1) ;[2202] FIX ACTUAL BOUND TO REFLECT INCREASE ADDM P2,TAB.FR(P1) ;[2202] AND FREE SPACE COUNTER SKIPL TAB.UW(P1) ;[2202] ACTUAL UPPER WINDOW BOUND? ADDM P2,TAB.UW(P1) ;[2202] YES, UPDATE IT TOO MOVE T2,T1 ;[2202] GET THE UPPER BOUND ADDI T1,1 ;[2202] GET THE LOWER BOUND OF THE INCREASE ADD T2,P2 ;[2202] NEW UPPER BOUND PUSHJ P,@TB.IN(P1) ;[2202] MAP IN THE PAGES JRST CPOPJ1 ;[1401] AND RETURN LCR1.5: > ;[1401] END IFN TOPS20 ADDM P2,TAB.AB(P1) ;FIX ACTUAL BOUND TO REFLECT INCREASE ADDM P2,TAB.FR(P1) ;AND FREE SPACE COUNTER CPOPJ1: AOS (P) ;SKIP RETURN CPOPJ: POPJ P, ;THAT TEST FAILED BUT MAYBE WE CAN GET SOME FROM NEXT AREA LDCOR1: CAIL P1,HG.TAB ;NOT IF TOP AREA JRST LDCOR2 ;SINCE NOTHING ABOVE IT SKIPE T1,TAB.UB+1(P1) ;ZERO IF NOT IN USE SKIPE TAB.AB+1(P1) ;ZERO IF SET UP BUT NOT USED JRST LDCOR2 ;NO EASY TASK SUB T1,TAB.LB+1(P1) ;SEE HOW MUCH IS REALLY FREE CAMGE T1,P2 ;BUT IS IT ENOUGH JRST LDCOR2 ;NO, NEED GENERAL TEST ADDM P2,TAB.LB+1(P1) ;FIX THE BOUNDARIES ADDM P2,TAB.UB(P1) ; AS THEY SHOULD BE JRST LDCOR0 ;RETURN WITH BOUNDS SETUP SUBTTL TABLE DRIVEN CORE MOVER ;HERE TO SEE IF ENOUGH CORE IN LOW SEGMENT LDCOR2: PUSHJ P,FR.CNT ;COUNT FREE CORE MOVE T2,FRECOR ;WE SHOULD KEEP THIS MUCH FREE ADD T2,P2 ;AFTER GETTING ALL WE NEED SUBM T1,T2 ;MINUS WHAT WE HAVE JUMPGE T2,LDCOR4 ;GIVES ENOUGH? IFN TOPS20,< JRST LNKOVF ;[650] CORE ALWAYS FULL ON TOPS20 > ;END OF IFN TOPS20 IFE TOPS20,< SKIPE CORFUL ;NO, IS CORE FULL (CORE UUO FAILED)? JRST LNKOVF ;YES MOVN T2,T2 ;GET WHAT WE NEED ADD T2,.JBREL ;ON TOP OF WHAT WE ALREADY HAVE IFN FTVM,< SKIPE USEVM ;[650] VM SYSTEM? SKIPA T1,[.VCRX] ;[650] YES, GROW FASTER > ;END OF IFN FTVM MOVEI T1,.CORX ;[650] MINIMUM NORMAL INCREMENT ADD T1,.JBREL## ;[650] PLUS CURRENT SIZE CAMGE T2,T1 ;[650] ASKING FOR LESS THAN MINIMUM? SKIPA T3,T1 ;[650] YES, ASK FOR AT LEAST MINIMUM MOVE T3,T2 ;[650] NO, ASK FOR ALL WE NEED CAMLE T3,MAXCOR ;[650] ASKING FOR TOO MUCH? JRST LDCOR3 ;[650] YES, OVERFLOW CORE T3, ;[650] TRY FOR WHAT WE NEED JRST LDCOR3 ;[650] CAN'T GET IT, OVERFLOW E$$EXP::.ERR. (MS,.EC,V%L,L%I,S%I,EXP,) ;[1174] .ETC. (COR,.EP,,,,.JBREL) HRRZ T2,.JBREL ;GET NEW TOP MOVEI T1,HG.TAB ;HOWEVER TOP ITEMS IN TABLE MAY BE ZERO SKIPN TAB.LB(T1) ;SO LOOK FOR HIGHEST NON-ZERO SOJA T1,.-1 ;NOT FOUND YET, BUT WE WILL MOVEM T2,TAB.UB(T1) ;RESET TOP BOUNDARY CAIE P1,(T1) ;IF EXPANDING TOP AREA JRST LDCOR2 ;COUNT AGAIN > ;END OF IFE TOPS20 LNKCON: JUMPE P2,CPOPJ1 ;P2=0 WAS ONLY SHUFFLING JRST LNKCOR ;TRY TO GET FROM NEW INCREASE IFE TOPS20,< ;CORE UUO FAILED ;IF FRECOR=0 INITIALIZE DSK FOR OVERFLOW ;OTHERWISE ZERO FRECOR AND TRY AGAIN LDCOR3: SKIPN FRECOR ;BEEN HERE BEFORE? JRST LDCR3A ;YES, OVERFLOW TO DSK NOW SETZM FRECOR ;CLEAR THIS RESTRICTION JRST LDCOR2 ;AND TRY AGAIN ;BUT FIRST EXPAND AS MUCH AS WE CAN ;THIS CAN HAPPEN IF A LARGE ARRAY IS SEEN LDCR3A: SETOM CORFUL ;[650] WE'RE AS BIG AS WE CAN GET MOVE T3,MAXCOR ;[650] TRY TO GET THIS BIG LDCR3B: MOVE T1,T3 ;[650] NEXT SMALLER SIZE TO TRY CAMG T1,.JBREL## ;[650] WOULD IT DO ANY GOOD? JRST LDCR3D ;[650] NO, GIVE UP CORE T1, ;[650] TRY FOR IT CAIA ;[650] FAILED, TRY FOR NEXT SMALLER JRST LDCR3C ;[650] OK, ADJUST TABLES AND CONTINUE SUB T3,.PGSIZ ;[650] TRY FOR ONE CORE BLOCK LESS SOJA T3,LDCR3B ;[650] LOOP TILL WE'RE AS BIG AS CAN BE ;HERE WHEN WE GOT A LITTLE BIGGER. TELL THE USER. LDCR3C: PUSH P,T2 ;[650] SAVE OVER .ERR. E01EXP::.ERR. (MS,.EC,V%L,L%I3,S%I,EXP) ;[1174] .ETC. (COR,.EP,,,,.JBREL) POP P,T2 ;[650] RESTORE MOVEI T1,HG.TAB ;START AT TOP OF TABLE SKIPN TAB.LB(T1) ;FOR SOMEONE SETUP SOJA T1,.-1 ;NOT SETUP, SCAN DOWN MOVE T3,.JBREL MOVEM T3,TAB.UB(T1) ;ALLOCATE FREE SPACE LDCR3D: CAMG T2,.JBREL## ;[650] NEED TO OVERFLOW YET? JRST LNKCON ;[650] NO, DO IT NEXT TIME (CORFUL SET) JRST LNKOVF ;NOW EXPAND TO DSK > ;END IFE TOPS20 E$$MEF::.ERR. (MS,0,V%L,L%F,S%F,MEF,) ;[1174] ;WE HAVE ENOUGH CORE SOMEWHERE BUT IS IT ABOVE WHERE WE ARE? LDCOR4: MOVE T1,[TAB.NB,,TAB.NB+1] SETZM TAB.NB ;USUAL BLT TO CLEAR TABLE BLT T1,TAB.NB+HG.TAB MOVEI T1,ARTAB(P1) ;GET ADDRESS OF ASCII NAME OF AREA E$$MOV::.ERR. (MS,.EC,V%L,L%I,S%I,MOV,) ;[1174] .ETC. (STR,.EP,,,,T1) MOVSI T2,-LN.TAB(P1) ;FORM AOBJN WORD FOR THIS AREA HRRI T2,(P1) ;AND ABOVE PUSHJ P,FRECNT ;COUNT SPACE ABOVE CAMGE T1,P2 ;ENOUGH? JRST LDCOR7 ;NO, MUST MOVE DOWN ;WE HAVE ENOUGH ABOVE SO JUST MOVE UP SUB T1,P2 ;GET FREE SPACE PUSH P,T1 ;SAVE IT ;NOW TO FILL IN TAB.NB WITH ITEMS NOT TO MOVE MOVNI T2,1(P1) ;FORM AOBJN WORD HRLZ T2,T2 ;FOR FIRST PART OF TABLE MOVE T1,TAB.LB(T2) ;CURRENT LOWER BOUND MOVEM T1,TAB.NB(T2) ;WHERE IT WILL GO TO AOBJN T2,.-2 ;LOOP MOVSI T2,-HG.TAB(P1) ;FORM AOBJN POINTER HRRI T2,(P1) ;FOR REST OF AREAS MOVE T1,TAB.AB(T2) ;GET ACTUAL IN USE ADDI T1,.IPM(P2) ;PLUS WHAT WE NEED ANDCMI T1,.IPM ;MUST BE ON BLOCK BOUND JRST LDCR4B ;SEE IF ANY MORE TO DO LDCR4A: ;HERE FOR REST OF TABLE ADD T1,TAB.AB(T2) ;ADD IN LENGTH OF THIS SUB T1,TAB.LB(T2) ;.. ADDI T1,.IPM ;ENSURE ON BLOCK BOUND ANDCMI T1,.IPM LDCR4B: SKIPE TAB.LB+1(T2) ;LEAVE 0 AS 0 MOVEM T1,TAB.NB+1(T2) ;TO GET START OF NEXT AOBJN T2,LDCR4A ;LOOP ;WE NOW HAVE A TABLE OF ADDRESS OF START OF DATA AFTER MOVE ;PLUS SOME LEFT OVER ;WE NEED A GOOD ALGORITHM TO DISTRIBUTE THIS TO ;MINIMIZE THE NUMBER OF WORDS TO BLT ;THIS SIMPLE ONE WILL DO FOR NOW POP P,T1 ;GET FREE SPACE BACK LSH T1,-.IPS2W ;[650] IN .IPS-SIZED CHUNKS HRREI T2,HG.TAB(P1) MOVM T2,T2 ;GET NUMBER ARE AREAS TO ALLOCATE MOVSI T2,-LN.TAB(P1) ;FORM AOBJN POINTER HRRI T2,(P1) ;FOR REST OF AREAS INCLUDING THIS ONE SETZ T3, ;START AT ZERO LDCR4C: SKIPE TAB.LB(T2) ;IGNORE ZERO AREAS CAMN T2,[-LN.TAB+BG.IX,,BG.IX] ;BUT IGNORE BOUND GLOBALS CAIA ADDI T3,1 ;COUNT SETUP ONES AOBJN T2,LDCR4C ;SO WE KNOW WHO TO GIVE SPARE TO IDIVI T1,(T3) ;ALLOCATE EVENLY SKIPE T2 ;NO REMAINDER ADDI T1,1 ;COUNT ONE EXTRA UNTIL REMAINDER GONE LSH T1,.IPS2W ;[650] BACK TO WORDS MOVE T3,T2 ;PREFER TO USE T2 FOR INDEX MOVSI T2,-LN.TAB(P1) ;AOBJN WORD AGAIN HRRI T2,(P1) ;EXCLUDING THIS AREA ;HERE TO FIXUP TAB.NB TO REFLECT DESIRED POSITIONS ;ENTER WITH :- ;T1 = CORE TO ADD WORDS (PLUS 128 IF REMAINDER NON-ZERO) ;T2 = AOBJN WORD FOR AREA TO COVER ;T3 = COUNT OF REMAINDER (WHEN 0 T1=T1-128) ;T4 = USED FOR COUNT LDCR5Z: SETZ T4, ;USED TO KEEP CURRENT INCREMENT LDCOR5: AOBJP T2,LDCOR6 ;ALL SET NOW GO MOVE IT SKIPN TAB.LB(T2) ;LEAVE ZERO ALONE JRST LDCOR5 CAMN T2,[-LN.TAB+BG.IX,,BG.IX] ;IGNORE BOUND GLOBALS JRST LDCR5M ;SINCE NO FREE SPACE ADD T4,T1 ;INCREMENT THE INCREMENT SOSN T3 ;REMAINDER JUST EXPIRED? SUBI T1,.IPS ;YES, NOT SO MUCH TO GIVE AWAY NOW LDCR5M: ADDM T4,TAB.NB(T2) ;ADD IN EXTRA JRST LDCOR5 ;LOOP ;HERE TO MOVE CORE AREAS, EITHER UP OR DOWN LDCOR6: IFN FTVM,< MOVSI T3,-LN.PAG ;[650] AOBJN PTR TO PAGBLK BUFFER > ;END OF IFN FTVM MOVE T1,TAB.NB+GS.IX ;[650] DESTINATION OF GLOBALS SUB T1,TAB.LB+GS.IX ;ORIGIN JUMPE T1,LDCR6A ;NOTHING TO CHANGE IF NOT MOVED ADDM T1,HT.PTR ;FIXUP POINTER TO HASH TABLE LDCR6A: SETZ T2, ;INITIALIZE COUNTER LDCR6B: PUSHJ P,MOVTST ;SEE WHATS TO BE MOVED JRST ADJFRE ;NOTHING CAML T1,TAB.LB(T2) ;SEE WHICH WAY TO GO JRST MOVUP ;UP IN CORE MOVDWN: CAMG T1,TAB.AB-1(T2) ;ARE WE CLEAR OF AREA LOWER STILL? JRST LDCR6B ;NO, TRY NEXT MOVBLT: IFN FTVM,< SKIPE USEVM ;[650] CAN WE MOVE WITH PAGE UUO'S? JRST LDCR6V ;[650] YES, DO SO (MUCH FASTER) > ;END OF IFN FTVM IFN TOPS20,< SKIPN TAB.PG(T2) ;[1401] IS THIS AREA PAGING? JRST LDCR6D ;[1401] NO, DO ORDINARY BLTS LDCR6C: PUSH P,T2 ;[1401] SET ASIDE INDEX -- WE WILL USE T2 MOVE T3,TAB.AB(T2) ;[1401] TOP OF AREA SUB T3,TAB.LB(T2) ;[1401] -BOTTOM OF AREA = LENGTH LSH T3,-9 ;[1401] LENGTH IN PAGES AOJE T3,LDCR6E ;[2202] INCLUDE ALL PAGES (DON'T WRITE IF NONE) TXO T3, ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS MOVE T1,TAB.LB(T2) ;[1401] ADDRESS TO MAP AWAY LSH T1,-9 ;[1401] IN PAGES, PLEASE HRLI T1,.FHSLF ;[1401] SELF,,PROCESSPAGE MOVE T2,T1 ;[1401] T2 GETS IT SETOM T1 ;[1401] T1 GETS -1 -- UNMAP, PLEASE PMAP% ;[1401] OUT THEY GO! ERCAL [POP P,T2 ;[2202] ERROR -- GET THE INDEX JRST @TB.OER(T2)] ;[2202] TELL THE USER WHAT FAILED LDCR6E: HRRZ T2,0(P) ;[1401] GET INDEX BACK PUSH P,T3 ;[1401] SET ASIDE BITS AND COUNT SKIPN T3,@TB.JFD(T2) ;[1401] PICK UP THE JFN PUSHJ P,E$$MMF ;[2270] NO JFN - GIVE UP MOVE T1,TAB.LW(T2) ;[1401] NOTE ADDRESS IN OVF FILE CAIE T2,HC.IX ;[2321] HIGH SEGMENT? JRST LDCR6L ;[2321] NO, LOW SEGMENT ADD T1,LL.S2 ;[2247] YES, ADD OFFSET INTO FILE HRRZS T1 ;[2321] ALWAYS IN SECTION ZERO LDCR6L: LSH T1,-9 ;[2321] MAKE IT PAGES HRL T1,T3 ;[1401] JFN,,FILEPAGE POP P,T3 ;[1401] PUT COUNT BACK JUMPE T3,LDCR6F ;[2202] DON'T READ IF AREA EMPTY MOVE T2,TAB.NB(T2) ;[1401] FETCH DESTINATION LSH T2,-9 ;[1401] IN PAGES, PLEASE HRLI T2,.FHSLF ;[1401] PROCESS IS OURSELF PMAP% ERCAL [POP P,T2 ;[2202] ERROR -- GET THE INDEX JRST @TB.IER(T2)] ;[2202] TELL THE USER WHAT FAILED LDCR6F: POP P,T2 ;[2247] PUT THE INDEX BACK PUSHJ P,ADJTBL ;[2247] ADJUST THE TABLES JRST LDCR6B ;[1401] AND TRY AGAIN ; [1401] DISPATCH TABLE GIVING JFNS FOR OVERFLOW FILES TB.JFD:: DEFINE XXX (ABC)< IFDEF ABC'.JF,< ABC'.JF > IFNDEF ABC'.JF,< [ 0 ] > > AREAS LDCR6D: > ;[1401] IFN TOPS20 MOVE T3,TAB.AB(T2) ;TOP OF WHAT WE HAVE SUB T3,TAB.LB(T2) ;GIVES LENGTH TO GO HRL T1,TAB.LB(T2) ;FORM XWD FOR BLT ADD T3,TAB.NB(T2) ;LAST ADDRESS TO BE MOVED TO BLT T1,(T3) ;AND MOVE PUSHJ P,ADJTBL ;[650] ADJUST THE TABLES JRST LDCR6B ;[650] AND TRY AGAIN IFN FTVM,< ;HERE TO MOVE VIA PAGE. UUO, THEN CONTINUE AT LDCR6A LDCR6V: PUSHJ P,MOVPAG ;[650] MOVE VIA PAGE. UUO JRST LDCR6A ;[650] TRY AGAIN > ;END OF IFN FTVM ;HERE TO ADJUST THE VARIOUS TABLES ;THIS IS DONE AFTER EACH BLT ;ENTER WITH T2 = AOBJN POINTER ADJTBL: SKIPN T1,TAB.NB(T2) ;GET NEW ORIGIN POPJ P, ;IF O JUST IGNORE IFN TOPS20,< SKIPN TAB.PG(T2) ;[1401] FREE SPACE WAS ZEROED BY UNMAP > ;[1401] IFN TOPS20 SETOM TAB.ZE(T2) ;[755] NEED TO CLEAR FREE SPACE LATER. SUB T1,TAB.LB(T2) ;FIND DIFFERENCE ADDM T1,TAB.LB(T2) ;ADJUST ALL TABLES ADDM T1,TAB.AB(T2) ADDM T1,TAB.PT(T2) POPJ P, ;[650] RETURN ;HERE IF NOT ENOUGH CORE ABOVE WHERE WE ARE ;SEE IF ENOUGH JUST BELOW LDCOR7: JUMPE P1,LDCR7X ;NOTHING BELOW IF AREA=0? MOVEI T1,-1(P1) ;GET NEXT LOWER POINTER SKIPN T2,TAB.UB(T1) ;GET BOUND IF NOT ZERO SOJGE T1,.-1 ;AREA 0 ALWAYS SET UP SUB T2,TAB.AB(T1) ;GET FREE SPACE SUB T2,P2 ;MINUS WHAT WE WANT JUMPL T2,LDCR7X ;NO SUCH LUCK LSH T2,-.IPS2W ;[650] FORM 128 WORD BLOCKS IDIVI T2,2 ;[650] HALF IT ADD T2,T3 ;[650] GIVE REMAINDER TO EXPANDING AREA LSH T2,.IPS2W ;[650] BACK TO WORDS ADD T2,P2 ;ALSO ADD IN WHAT WE WANTED ;NOW ADJUST TABLES AND MOVE CODE MOVN T2,T2 CAIN P1,GS.IX ;GLOBAL SYMBOL AREA MOVED DOWN? ADDM T2,HT.PTR ;YES, ADJUST HASH TABLE POINTER ADDM T2,TAB.UB(T1) ;PREVIOUS UPPER BOUND OF LOWER AREA IFN FTVM,< SKIPE USEVM ;[650] VM AVAILABLE? JRST LDCR7V ;[650] YES, USE FAST WAY > ;END OF IFN FTVM IFN TOPS20,< SKIPN TAB.PG(P1) ;[1401] IS THIS AREA PAGING? JRST LDCR7B ;[1401] NO, DO ORDINARY BLTS PUSH P,T2 ;[1401] SET ASIDE COUNT -- WE WILL USE T2 MOVE T2,TAB.LB(P1) ;[1401] WHERE TO START LSH T2,-9 ;[1401] IN PAGES HRLI T2,.FHSLF ;[1401] PROCESS IS SELF MOVE T3,TAB.AB(P1) ;[1401] TOP OF AREA SUB T3,TAB.LB(P1) ;[1401] -BOTTOM OF AREA = LENGTH AOJE T3,LDCR7C ;[2202] WELL, ALMOST (DON'T DO IT IF NO AREA) LSH T3,-9 ;[1401] LENGTH IN PAGES TXO T3, ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS SETOM T1 ;[1401] T1 GETS -1 -- UNMAP, PLEASE PMAP% ;[1401] OUT THEY GO! ERCAL @TB.OER(P1) ;[2202] ERROR -- RETIRE LDCR7C: MOVE T1,TAB.LW(P1) ;[1401] NOW GET THEM BACK CAIE P1,HC.IX ;[2321] HIGH SEGMENT? JRST LDCR7S ;[2321] NO, LOW SEGMENT HRRZ T2,LL.S2 ;[2321] YES, GET OFFSET INTO FILE ADD T1,T2 ;[2321] ADD IT LDCR7S: LSH T1,-9 ;[2321] FILEPAGE HRL T1,@TB.JFD(P1) ;[1401] FILEJFN MOVE T2,(P) ;[1401] GET COUNT BACK, BUT KEEP IT ADDM T2,TAB.AB(P1) ;[1401] FIXUP BOUNDS ADDM T2,TAB.PT(P1) ;[1401] AND POINTERS ADDB T2,TAB.LB(P1) ;[1401] FETCH DESTINATION JUMPE T3,LDCR7D ;[2202] DON'T READ IF NO AREA LSH T2,-9 ;[1401] IN PAGES, PLEASE HRLI T2,.FHSLF ;[1401] PROCESS IS OURSELF PMAP% ERCAL @TB.IER(P1) ;[2202] ERROR -- RETIRE LDCR7D: POP P,T2 ;[1401] PUT THE COUNT BACK JRST LNKCON ;[1401] TRY AGAIN LDCR7B: > ;[1401] IFN TOPS20 ADDM T2,TAB.AB(P1) ;NEW ACTUAL BOUND ADDM T2,TAB.PT(P1) ;ADJUST POINTER HRLZ T3,TAB.LB(P1) ;GET FROM ... ADDB T2,TAB.LB(P1) ;ADJUST LOWER HLL T2,T3 ;FROM ...TO BLT T2,@TAB.AB(P1) ;BLT OF AREA MOVE T3,TAB.AB(P1) ;GET LAST WORD IN USE SETZM 1(T3) ;CLEAR FIRST FREE WORD HRLI T3,1(T3) ;FORM BLT POINTER HRRI T3,2(T3) ;TO ZERO FREE AREA BLT T3,@TAB.UB(P1) JRST LNKCON ;TRY AGAIN IFN FTVM,< ;HERE TO MOVE P1'S AREA DOWN BY T2 ON A VM SYSTEM VIA MOVPAG LDCR7V: ADD T2,TAB.LB(P1) ;[650] NEW LOWER BOUND MOVEM T2,TAB.NB(P1) ;[650] SETUP FOR MOVPAG MOVE T2,P1 ;[650] AREA TO MOVE IN T2 FOR MOVPAG MOVSI T3,-LN.PAG ;[650] DOPAGE'S AC PUSHJ P,MOVPAG ;[650] MOVE AREA DOWN PUSHJ P,FRCPAG ;[650] DO LAST PAGE. UUO SETZM TAB.NB(P1) ;[650] RESTORE TAB.NB TO GOODNESS JRST LNKCON ;[650] CONTINUE > ;END OF IFN FTVM LDCR7X: CAIG P1,1 ;TRIED 0 & 1 ALREADY JRST LDCR7Y MOVN T2,P1 ;GET AREA HRLZ T2,T2 ;AOBJN POINTER FOR ALL BELOW PUSHJ P,FRECNT ;COUNT FREE SPACE SUB T1,P2 ;MINUS WHAT WE WANT JUMPL T1,LDCR7Y ;NOT ENOUGH ;SEE HOW MANY AREAS ARE SETUP (NON-ZERO) MOVN T3,P1 ;GET AREA HRLZ T3,T3 ;AOBJN POINTER FOR ALL BELOW MOVEI T4,1 ;CURRENT ONE IS LDCR7U: SKIPE TAB.LB(T3) CAMN T2,[-LN.TAB+BG.IX,,BG.IX] ;IGNORE BOUND GLOBALS CAIA ADDI T4,1 ;ONE MORE AOBJN T3,LDCR7U LSH T1,-.IPS2W ;[650] INTO 128 WORD BLOCKS IDIVI T1,(T4) ;DISTRIBUTE EVENLY SKIPE T2 ;ANY REMAINDER? ADDI T1,1 ;YES LSH T1,.IPS2W ;[650] BACK TO WORDS ;HERE TO SETUP LOWER PART OF TABLE TAB.NB MOVN T3,P1 HRLZ T3,T3 ;AOBJN WORD SKIPN T4,TAB.LB(T3) ;LOAD UP BASE AOBJN T3,.-1 ;NEVER FAILS BUT JUST INCASE MOVEM T4,TAB.NB(T3) ;LOWEST NON-ZERO BOUND DOES NOT MOVE LDCR7L: SKIPN TAB.LB(T3) ;IGNORE ZERO'S JRST LDCR7M ADD T4,TAB.AB(T3) SUB T4,TAB.LB(T3) ;WHAT WE NEED CAME T2,[-LN.TAB+BG.IX,,BG.IX] ;IGNORE BOUND GLOBALS ADD T4,T1 ;PLUS HANDOUT ADDI T4,.IPM ;MAKE SURE ON A BLOCK BOUND ANDCMI T4,.IPM SKIPN TAB.LB+1(T3) ;SEE IF NEXT IS SETUP AOBJN T3,.-1 ;WILL ALWAYS FIND A TOP MOVEM T4,TAB.NB+1(T3) ;IS NEW BOUND SOSN T2 ;COUNT DOWN REMAINDER SUBI T1,.IPS ;AND REMOVE EXTRA LDCR7M: AOBJN T3,LDCR7L ;LOOP ;NOW FOR REST OF TABLE, UNCHANGED MOVSI T3,-LN.TAB(P1) HRRI T3,(P1) ;AOBJN POINTER AOBJP T3,LDCR7N ;ACCOUNT FOR AREA WE ARE TRYING TO EXPAND SKIPE T1,TAB.LB(T3) MOVEM T1,TAB.NB(T3) ;MOVE BOUND AOBJN T3,.-2 ;LOOP LDCR7N: JRST LDCOR6 ;START TO MOVE ;MOST GENERAL MOVER ;HERE WHEN NOT ENOUGH BELOW AND NOT ENOUGH ABOVE ;BUT ENOUGH IN BOTH PLACES COMBINED ;SETUP TAB.NB TO MOVE ALL OF CORE IN EITHER DIRECTION LDCR7Y: MOVSI T2,-HG.TAB ;SET UP TAB.NB MOVE T1,TAB.LB ;FIRST ITEM NEVER MOVES MOVEM T1,TAB.NB ;SINCE IT IS AGAINST FIXED AREA MOVEI T3,1 ;[650] INIT COUNT OF USED AREAS TO 1 LDCR7A: ADD T1,TAB.AB(T2) ;ADD IN ACTUAL SPACE USED SUB T1,TAB.LB(T2) ADDI T1,.IPM ;MUST BE ON BLOCK BOUND ANDCMI T1,.IPM CAIN P1,(T2) ;IS THIS THE AREA TO GIVE IT TO? ADD T1,P2 ;YES, ADJUST START OF NEXT ABOVE SKIPN TAB.LB+1(T2) ;[650] LEAVE 0 ALONE JRST LDCR7Z ;[670] GO LOOP MOVEM T1,TAB.NB+1(T2) ;[650] STORE DESTINATION ADDRESS ADDI T3,1 ;[650] COUNT ANOTHER ACTIVE AREA LDCR7Z: AOBJN T2,LDCR7A ;[670] LOOP PUSH P,T3 ;[650] SAVE COUNT OF AREAS OVER FR.CNT PUSHJ P,FR.CNT ;[650] COUNT ALL OF SPACE AGAIN SUB T1,P2 ;[650] REMOVE WHAT WE WANTED LSH T1,-.IPS2W ;[650] SAME CODE AS ABOVE POP P,T3 ;[650] RESTORE COUNT OF AREAS IDIV T1,T3 ;[650] SHARE EXTRA OVER ACTIVE AREAS SKIPE T3,T2 ;[650] ADDI T1,1 ;[650] LSH T1,.IPS2W ;[650] MOVSI T2,-LN.TAB ;SCAN ALL TABLES JRST LDCR5Z ;AND ADD TO ALL ITEMS IN TABLE ;HERE FOR REVERSE BLT TO MOVE CORE UPWARDS CHUNK1==200000 ;[720] IF NEED TO BE MOVED IN 2 STEPS MOVUP: ADD T1,TAB.AB(T2) ;FIND ADDRESS OF END SUB T1,TAB.LB(T2) SKIPA T4,T2 ;GET COPY TO PLAY WITH SKIPN TAB.LB(T4) ;OK IF NOT ZERO AOBJN T4,.-1 ;LOOP UNTIL WE GET SOMETHING USEFUL TLNN T4,-1 ;DID WE FIND A NON-ZERO HIGHER AREA? JRST MOVUP1 ;NO, SKIP TEST FOR NEXT SINCE IT DOESN'T EXIST CAML T1,TAB.LB(T4) ;IS START OF NEXT IN WAY? JRST LDCR6B ;YES, TRY NEXT ;NOTE WE CAN NOT USE A BLT HERE SINCE WE ARE GOING UP IN CORE ;THEREFORE USE POP LOOP. MOVUP1: IFN FTVM,< SKIPE USEVM ;[650] CAN WE USE PAGE. UUO TO MOVE? JRST LDCR6V ;[650] YES, MUCH BETTER THAN POP LOOP > ;END OF IFE FTVM IFN TOPS20,< SKIPE TAB.PG(T2) ;[1401] IS THIS AREA PAGING? JRST LDCR6C ;[1401] YES, DO PMAPS > ;[1401] END OF IFN TOPS20 PUSH P,T2 ;[771] SAVE WHO WE ARE MOVE T4,TAB.AB(T2) ;TOP SUB T4,TAB.LB(T2) ;MINUS BOTTOM GIVES LENGTH ;NOW FOR ITERATIVE LOOP ;T4: 400000+LENGTH,,TOP OF OLD DATA HRL T4,T4 ;IN BOTH HALF JUMPL T4,[PUSH P,[CHUNK1,,0] ;[1214] SIZE .GE. 400000 SUB T4,[CHUNK1,,0] ;[720] FIRST DO LENTH LESS A CHUNK JRST .+1] ;[720] THEN MOVE CHUNK ADD T4,TAB.LB(T2) ;TOP OF DATA TLO T4,(1B0) ;PREVENT PDL UNDERFLOW MOVE T1,TAB.NB(T2) ;DESTINATION SUB T1,TAB.LB(T2) ;-START TO GET OFFSET TXO T1,<(T4)> ;[720] ADD INDEX FIELD MOVEM T1,POPOFS ;[720] STORE FOR LOOP BELOW POPLP: POP T4,@POPOFS ;[720] MOVE A WORD JUMPL T4,POPLP ;[720] LOOP IF MORE WORDS POP P,T2 ;[771] RESTORE STACK CAMN T2,[CHUNK1,,0] ;[720] DOING 2 STEPS? JRST [HRLI T4,CHUNK1-1 ;[720] YES, MOVE ONE MORE CHUNK TLO T4,(1B0) ;[720] PREVENT PDL OVRFLO JRST POPLP] ;[720] ONE MORE TIME PUSHJ P,ADJTBL ;FIXUP TABLE JRST LDCR6A ;[650] TRY AGAIN ;HERE TO MOVE AN AREA UP OR DOWN ON A VM SYSTEM BASED ON TAB.NB ;USES EXCHANGE RATHER THAN MOVE SO WON'T HAVE TO DESTROY DESTINATION ;ENTER WITH T2 POINTING TO AREA TO MOVE IFN FTVM,< MOVPAG: SPUSH ;[650] NEED LOTS OF ACS MOVE P1,TAB.NB(T2) ;[650] CALCULATE SIGNED OFFSET SUB P1,TAB.LB(T2) ;[650] FROM OLD PLACE TO NEW MOVE P2,TAB.AB(T2) ;[650] SET P2 = TOTAL SIZE OF AREA TO MOVE SUB P2,TAB.LB(T2) ;[650] BY OLD LAST WORD - OLD FIRST WORD ADDI P2,1 ;[650] +1 SINCE AB IS 1 LESS JUMPE P2,MOVPG4 ;[1275] DON'T MOVE IF AREA CONTAINS NO PAGES JUMPL P1,MOVPG1 ;[650] MOVING UP? MOVNI T1,1 ;[650] YES, WILL SWEEP AREA DOWNWARDS MOVE P3,TAB.AB(T2) ;[650] AND SET FIRST WORD TO MOVE TO END JRST MOVPG2 ;[650] REJOIN MAIN CODE MOVPG1: MOVEI T1,1 ;[650] GOING DOWN, WILL SCAN UP AREA MOVE P3,TAB.LB(T2) ;[650] STARTING AT BOTTOM WORD MOVPG2: ASH P1,-9 ;[650] CONVERT WORDS TO PAGES LSH P2,-9 ;[650] .. LSH P3,-9 ;[650] .. ;BACK HERE TO PUT EACH NEW PAGE. UUO ARG INTO THE PAGBLK AREA MOVPG3: MOVE T4,P3 ;[650] RETRIEVE SOURCE PAGE ADD T4,P1 ;[650] + OFFSET = DESTINATION PAGE HRL T4,P3 ;[650] SOURCE,,DESTINATION TXO T4,1B0 ;[650] NOTE EXCHANGE, NOT MOVE PUSHJ P,DOPAGE ;[650] EXCH THE PAGE ADD P3,T1 ;[650] POINT TO NEXT PAGE TO MOVE SOJG P2,MOVPG3 ;[650] AND GO MOVE IT ;HERE WHEN THROUGH WITH THIS AREA MOVPG4: SPOP ;[1275] RESTORE ACS USED JRST ADJTBL ;[650] GO FIXUP OTHER TAB.XX WORDS > ;END OF IFN FTVM SUBTTL HERE TO CLEAN UP BEFORE RETURNING TO CALLER ADJFRE: IFN FTVM,< SKIPE USEVM ;[650] BEEN DOING PAGE. UUOS? PUSHJ P,FRCPAG ;[650] YES, FINISH UP > ;END OF IFN FTVM MOVSI T2,-LN.TAB+1 ;USUAL AOBJN POINTER +1 ADJFR1: MOVE T3,T2 ;GET COPY OF POINTER SKIPN T1,TAB.LB+1(T3) ;START OF NEXT AOBJN T3,.-1 ;IGNORE 0'S SUBI T1,1 ;END IS ONE LESS SKIPN TAB.AB(T2) ;[755] LEAVE ZERO IF NOT SET JRST ADJFR2 ;[755] CAME T1,TAB.UB(T2) ;[755] ANY CHANGE IN UB? SETOM TAB.ZE(T2) ;[755] YES, NEEDS CLEARING LATER MOVEM T1,TAB.UB(T2) ;FREE SPACE POINTER ADJFR2: AOBJN T2,ADJFR1 ;[755] LOOP FOR NEXT AREA IF NOT FINISHED MOVE T2,.JBREL ;TOP OF LOW SEG MOVEI T1,HG.TAB ;HOWEVER TOP ITEMS IN TABLE MAY BE ZERO SKIPN TAB.LB(T1) ;SO LOOK FOR HIGHEST NON-ZERO SOJA T1,.-1 ;NOT FOUND YET, BUT WE WILL MOVEM T2,TAB.UB(T1) ;RESET TOP BOUNDARY ; .. ; .. ;HERE TO ZERO ALL XXX.UB SPACE IN CORE IF NOT VIRTUAL ;IF VIRTUAL, IT'S ALREADY ZERO (WE EXCHANGED WITH ZERO PAGES) SETOM COREFL ;[650] SIGNAL CORE SHUFFLED FOR LNKF40 IFN FTVM,< SKIPE USEVM ;[650] BLT'S OR PAGE UUOS? JRST LNKCON ;[650] PAGE, UUO'S, NO ZEROING NEEDED > ;END OF IFN FTVM MOVSI T2,-LN.TAB+1 BLTUBT: HRRZ T1,TAB.AB(T2) ;GET START OF FREE AREA JUMPE T1,BLTUB1 ;NOT IF ZERO THERE SKIPN TAB.ZE(T2) ;[755] NEEDS TO BE CLEARED? JRST BLTUB1 ;[755] NO, SETZM TAB.ZE(T2) ;[755] YES, INITIALIZE FLAG ADDI T1,1 ;GET FIRST FREE (PERHAPS) HRLI T1,(T1) ;BLT POINTER ADDI T1,1 ;IT IS NOW SKIPN T3,TAB.LB+1(T2) ;ADDRESS OF NEXT LOW BLOUD AOBJN T2,.-1 ;SKIP THE ZERO JUMPE T3,BLTUB1 ;SHOULD HAVE SOMETHING THOUG CAIG T3,(T1) ;SEE IF ANY REAL SPACE JRST BLTUB1 ;NO, TAB.AB=TAB.UB SETZM -1(T1) ;GET THE FIRST ZERO THERE BLT T1,-1(T3) ;FOR END ADDRESS BLTUB1: AOBJN T2,BLTUBT ;GET NEXT MOVEI T1,HG.TAB ;LAST IS SPECIAL SKIPN TAB.LB(T1) ;INCASE GS.LB IS ZERO SOJA T1,.-1 ;WE WILL FIND TRUE TOP HRRZ T1,TAB.AB(T1) ADDI T1,1 HRL T1,T1 ADDI T1,1 HRRZ T3,.JBREL CAIG T3,(T1) JRST LNKCON ;NOW REALLY DO THE ALLOCATION SETZM -1(T1) BLT T1,-1(T3) JRST LNKCON ;TRY AGAIN ;HERE TO STORE A PAGE. UUO ARG FROM T4 INTO THE PAGBLK AREA. ;WILL DO A PAGE. UUO AND SKIP RETURN WHENEVER PAGBLK AREA FILLS UP ;T3 CONTAINS AN AOBJN POINTER TO PAGBLK. ;PAGE. UUO FUNCTION TO DO IS IN PAGFUN IFN FTVM,< DOPAGE: MOVEM T4,PAGBLK(T3) ;[650] STORE THE ARGUMENT AOBJN T3,CPOPJ ;[650] RETURN UNLESS LIST IS FULL JRST FRCPG1 ;[650] ELSE GO DO A PAGE. UUO ;ENTER HERE TO FORCE A PAGE. UUO ON THE CURRENT CONTENTS OF PAGBLK. FRCPAG: CAMN T3,[-LN.PAG,,0] ;[650] PAGE. UUO BLOCK EMPTY? POPJ P, ;[650] YES, DON'T BOTHER WITH A PAGE. UUO FRCPG1: HLRE T3,T3 ;[650] GET NEG. COUNT OF EMPTY WORDS ADDI T3,LN.PAG ;[650] + SIZE OF BLOCK = # WORDS USED MOVEM T3,PAGCNT ;[650] STORE FOR UUO MOVS T3,PAGFUN ;[650] PICK UP FUNCTION CODE HRRI T3,PAGCNT ;[650] POINT AT FIRST WORD OF ARGUMENT BLOCK PAGE. T3, ;[650] DO THE PAGE. UUO PUSHJ P,E$$PUF ;[1174] DIDN'T MAKE IT MOVSI T3,-LN.PAG ;[650] RESTORE AOBJN POINTER TO GOODNESS POPJ P, ;[650] RETURN ;HERE ON A PAGE. UUO FAILURE E$$PUF::.ERR. (MS,.EC,V%L,L%F,S%F,PUF,) ;[1174] .ETC. (OCT,.EP,,,,T3) > ;END OF IFN FTVM ;HERE TO COUNT FREE CORE IN BOUND AREAS ;ENTER WITH T2 CONTAINING AOBJN WORD TO AREAS TO COUNT ;RETURNS COUNT IN T1 FR.CNT::MOVSI T2,-LN.TAB ;ENTER HERE TO COUNT ALL OF CORE FRECNT: SETZ T1, ;INITIALIZE COUNT ADD T1,TAB.UB(T2) ;ADD UPPER BOUND SUB T1,TAB.AB(T2) ; SUBTRACT ACTUAL BOUNDS AOBJN T2,.-2 ;FOR ALL AREAS ANDCMI T1,.IPM ;[640] MAKE MULTIPLE OF .IPS POPJ P, ;HERE TO SEE IF ANYTHING LEFT TO MOVE ;SKIP RETURN IF YES ;NON-SKIP IF ALL DONE MOVTST: AOBJN T2,.+2 ;GET NEXT UNLESS AT END OR START MOVSI T2,-LN.TAB ;RESET AOBJN COUNTER MOVE T1,TAB.NB(T2) ;GET DESTINATION CAME T1,TAB.LB(T2) ;SAME AS ORIGIN AOSA (P) ;NO, EXIT WITH T2 SET UP AOBJN T2,.-3 ;LOOP POPJ P, ;UNLESS DONE ;AREA NAMES FOR INFO MESSAGES DEFINE XXX (A) < ASCIZ \A\ > XALL ARTAB: AREAS SALL SUBTTL XX.GET - SUBROUTINES TO GET SPACE IN SPECIFIC AREA DEFINE XXX(AREA) < AREA'.GET::PUSH P,P1 ;SAVE P1 MOVEI P1,AREA'.IX ;INDEX TO AREA IFIDN ,< SKIPN AREA'.LB ;ALREADY SETUP? PUSHJ P,AREA'.INI ;NO, DO SO NOW> IFIDN ,< ;[2270] SKIPN AREA'.LB ;[2270] ALREADY SETUP? PUSHJ P,AREA'.INI ;[2270] NO, DO SO NOW> .GETBK: PUSHJ P,.GETSP ;GENERAL SIMPLE CORE EXPANDER POP P,P1 ;RESTORE POPJ P, DEFINE XXX(%AREA) < %AREA'.GET::PUSH P,P1 ;SAVE P1 MOVEI P1,%AREA'.IX ;INDEX TO %AREA IFIDN <%AREA>,< SKIPN %AREA'.LB ;ALREADY SETUP? PUSHJ P,%AREA'.INI ;NO, DO SO NOW> IFIDN <%AREA>,< ;[2270] SKIPN %AREA'.LB ;[2270] ALREADY SETUP? PUSHJ P,%AREA'.INI ;[2270] NO, DO SO NOW> PJRST .GETBK ;COMMON RETURN >> XALL AREAS SALL ;SUBROUTINE TO GET SPACE FROM LINKED LIST OF SPACE ; ;CALLED BY ; PUSH P,P1 ;USUALLY ; MOVEI T2,SIZE ;WHAT WE WANT ; MOVEI P1,XXX.IX ;AREA TO GET SPACE FROM ; PUSHJ P,GETSPC ; ;ADDRESS OF RETURNED SPACE IN T1 ;T2 IS UNCHANGED ;USED T3 AND T4 ;HERE TO GET SOME WORDS FROM FREE CORE FOR ANY AREA ;LINKED GARBAGE LIST IS OF FORM ;NOTE ALL POINTERS ARE RELATIVE TO BASE OF THAT AREA ;INITIAL POINTER IS TB.LNK(P1) ;TOTAL FREE SPACE IS IN TB.FSP(P1) ;GARBAGE AREAS ARE IN ASCENDING ORDER OF SIZE ;NUMBER OF WORDS REQUIRED IS IN T2 ;RETURN ADDRESS OF WORDS IN T1 ;ALSO USES T3 AS BACK LINK .GETSP:: JUMPG T2,GETWDS ;DEFENSIVE CHECK INCASE 0 WORDS E$$AZW::.ERR. (MS,,V%L,L%F,S%F,AZW,) ;[1174] GETWDS: CAMLE T2,TB.FSP(P1) ;SEE IF ENOUGH TOTAL FREE SPACE JRST GETWDM ;NO, SO DON'T WASTE TIME MOVSI T3,TB.LNK(P1) ;GET INITIAL POINTER GETWD1: MOVS T1,T1 ;SAVE OLD POINTER HLR T1,T3 ;SAVE THIS TRNN T1,-1 ;IF POINTER IS ZERO JRST GETWDM ;NOT ENOUGH IN ONE CHUNK MOVE T3,(T1) ;GET NEXT TRNE T3,-1 ;LEAVE ZERO ALONE ADD T3,TAB.LB(P1) ;ADD IN BASE MOVS T3,T3 ;PUT SIZE IN RIGHT CAILE T2,(T3) ;SEE IF THIS HOLE IS BIG ENOUGH JRST GETWD1 ;NO, TRY NEXT ;FALL THROUGH TO NEXT PAGE ;FOUND A SPACE REMOVE FROM LIST .GETSR: ;ENTRY TO REMOVE THIS AREA GETWD4: MOVS T1,T1 ;PUT IT WAY ROUND WE EXPECT IT HLRZ T4,T3 ;GET LINK ADDRESS SKIPE T4 ;LEAVE ZERO ALONE SUB T4,TAB.LB(P1) ;REMOVE OFFSET HRRM T4,(T1) ;REMOVE LINK FROM CHAIN HRR T1,T3 ;SIZE WE GOT IN THIS CHUNK HRRZ T3,TB.FSP(P1) ;GET TOTAL FREE WORDS SUBI T3,(T1) ;MINUS THOSE JUST TAKEN MOVEM T3,TB.FSP(P1) ;AS NEW TOTAL CAIN T2,(T1) ;EXACTLY THE RIGHT SIZE JRST GETWD3 ;YES, NOTHING TO PUT BACK PUSH P,T2 ;SAVE SIZE REALLY REQUIRED PUSH P,T1 ;AND ADDRESS HRRZ T3,T1 ;SIZE OF THIS BLOCK HLRZ T1,T1 ;ADDRESS ADDI T1,(T2) ;START OF LEFT OVER SPACE SUBM T3,T2 ;AND ITS SIZE PUSHJ P,.RETSP ;PUT IT IN CHAIN POP P,T1 ;RESTORE POP P,T2 GETWD3: HLRZ T1,T1 ;SET POINTER ;NOW ZERO ALL OF BLOCK BEFORE GIVING IT TO THE USER SETZM (T1) ;CLEAR FIRST WORD HRLZ T3,T1 ;FORM BLT POINTER HRRI T3,1(T1) MOVE T4,T1 ;FORM END OF BLT ADDI T4,-1(T2) CAIE T2,1 ;BUT NOT IF ONLY ONE WORD BLT T3,(T4) ;ZAP POPJ P, ;HERE TO ACTUALLY GET THE WORDS FROM UNUSED MEMORY MAY CAUSE OVERFLOWS GETWDM: MOVE T1,TAB.FR(P1) ;NUMBER OF FREE WORD SUBI T1,(T2) ;SEE IF ENOUGH JUMPL T1,GETWD2 ;NO, MUST EXPAND SOME THING MOVEM T1,TAB.FR(P1) ;YES, STORE NEW COUNT MOVE T1,TAB.PT(P1) ;GET ACTUAL ADDRESS OF NEXT FREE WORD ADD T1,T2 ;ALLOCATE THIS BLOCK EXCH T1,TAB.PT(P1) ;T1 POINTS TO ALLOCATED BLOCK POPJ P, ;HERE IF WE HAVE TO EXPAND TO GET SOME ROOM GETWD2: PUSH P,T2 ;SAVE NUMBER OF WORDS REQUIRED PUSH P,P2 ;DESTROYS P2 MOVE P2,T2 ;NUMBER OF WORDS WE NEED SUB P2,TAB.FR(P1) ;MINUS WHAT WE HAVE NOW PUSHJ P,LNKCOR ;GENERAL CORE EXPANDER JRST E$$MEF ;[1174] FAILED POP P,P2 ;RESTORE P2 POP P,T2 ;RESTORE T2 SKIPE TAB.UW(P1) ;[2270] AREA PAGING? POPJ P, ;[2270] YES, JUST LEAVE (TYPECHECKING) JRST GETWDM ;TRY AGAIN ;HERE TO CREATE A NEW AREA (USUALLY FX) ;CALLED BY ; MOVE T2,SIZE REQUIRED ; MOVE P1,AREA ; PUSHJ P,FX.INI ;RETURNS WITH AREA SETUP ;SAVES T2 ;USES T1, AND T3 FX.INI: PUSH P,T2 ;SAVE T2 PUSHJ P,XX.INI ;GENERAL POP P,T2 POPJ P, ;RETURN TP.INI: PUSH P,T2 ;[2270] SAVE T2 PUSHJ P,XX.INI ;[2270] GENERAL ROUTINE POP P,T2 ;[2270] RESTORE T2 POPJ P, ;[2270] RETURN XX.INI::MOVEI T1,(P1) ;GET AREA NUMBER SKIPN TAB.LB(T1) ;FIND NEXT LOWEST SETUP SOJG T1,.-1 ;DY IS ALWAYS SETUP MOVE T2,TAB.UB(T1) ;SEE IF ANY FREE SUB T2,TAB.AB(T1) CAIL T2,.IPS ;MUST HAVE AT LEAST THIS JRST SY.FX1 ;WE HAVE PUSH P,[EXP XX.INI] ;RETURN ADDRESS PUSHJ P,.SAVE2## ;SAVE P1 AND P2 MOVEI P2,.IPS MOVEI P1,(T1) PUSHJ P,LNKCOR PUSHJ P,E$$MEF ;[1174] MOVNI T1,.IPS ;WE MUST HAVE GOT THE SPACE ADDM T1,TAB.AB(P1) ;SO TAKE IT BACK ADDM T1,TAB.FR(P1) ;ALSO FROM FREE SPACE IN TAB.AB SKIPN TAB.PG(P1) ;IS THIS AREA PAGING? POPJ P, ;NO, JUST RETURN TO XX.INI JRST .+1(P1) ;YES, SORT OUT WINDOWS DEFINE XXX (ABC) < IFNDEF CNA.'ABC,< HALT > IFDEF CNA.'ABC,< JRST CNA.'ABC >> AREAS ;HERE IF LOW OR HIGH CODE PAGED ;JUST REDUCE THE INCORE WINDOW CNA.LC: CNA.HC: ADDM T1,TAB.UW(P1) ;REDUCE THE WINDOW JRST CNABLT ;AND CLEAR BLOCK ;HERE IF LOCAL SYMBOLS ARE PAGED ;IF GOING IN FORWARDS DIRECTION (UW.LS=-1) AREA IS 0 ;IF NOT CLEAR AREA CNA.LS: ;[2044] IFE TOPS20,< ;[2044] SKIPGE UW.LS ;TEST FOR -1 POPJ P, ;JUST RETURN >;[2044] END IFE TOPS20 IFN TOPS20,< ;[2044] SKIPL UW.LS ;[2044] Test for -1 >;[2044] END IFN TOPS20 ADDM T1,UW.LS ;BACKUP UPPER POINTER CNABLT: MOVE T1,TAB.AB(P1) ;TOP OF WHAT WE KEEP IFE TOPS20,< ADDI T1,2 HRLI T1,-1(T1) ;FORM BLT PTR. SETZM -1(T1) ;CLEAR FIRST WORD MOVEI T2,.IPS-2(T1) ;DESTINATION OF BLT BLT T1,(T2) ;CLEAR ALL OF BLOCK > ;[1426] IFE TOPS20 IFN TOPS20,< ADDI T1,1 ;[2044] Need page above top of area LSH T1,-9 ;GET PAGE TLO T1,.FHSLF MOVE T2,T1 SETOM T1 SETZM T3 PMAP% ;UNMAP THIS FROM THE WINDOW ERCAL E$$OLS ;[2202] ERROR -- RETIRE > ;[1426] IFN TOPS20 POPJ P, SY.FX1: MOVE T2,TAB.UB(T1) MOVEM T2,TAB.UB(P1) MOVEM T2,TAB.AB(P1) MOVNI T2,.IPS ADDB T2,TAB.UB(T1) ADDI T2,1 MOVEM T2,TAB.LB(P1) SETZM (T2) ;CLEAR MOVEM T2,TAB.PT(P1) ;POINT BEYOND IT MOVEI T1,.IPS ;BUT REST IS FREE MOVEM T1,TAB.FR(P1) ;MARK IT SO CAIE P1,FX.IX ;IS 1ST WORD USEFUL IN THIS AREA? CAIN P1,TP.IX ;[2270] CAIA ;[2270] NO, DON'T ALLOCATE IT POPJ P, ;YES ;THIS AREA MUST NOT START THE SYMBOL CHAINS AT RELATIVE 0 ;OTHERWISE WE CANNOT TELL END OF CHAIN FROM ONE AT 0 ;FIX IS TO ALLOCATE FIRST WORD ;CURRENTLY NOT USED FOR ANYTHING AOS TAB.PT(P1) ;FIRST WORD IN USE SOS TAB.FR(P1) ;SO ONE LESS FREE POPJ P, SUBTTL XX.RET - SUBROUTINES TO RETURN SPACE IN SPECIFIC AREA DEFINE XXX(AREA) < AREA'.RET::PUSH P,P1 ;SAVE P1 MOVEI P1,AREA'.IX ;INDEX TO AREA .RETBK: PUSHJ P,.RETSP ;RETURN SPACE POP P,P1 ;RESTORE POPJ P, ;RETURN DEFINE XXX(%AREA) < %AREA'.RET::PUSH P,P1 ;SAVE P1 MOVEI P1,%AREA'.IX ;INDEX TO %AREA PJRST .RETBK ;COMMON RETURN >> XALL AREAS SALL ;SUBROUTINE TO RETURN SPACE TO LINKED LIST ; ;CALLING SEQUENCE IS ; PUSH P,P1 ;SAVE P1 (USUALLY REQUIRED ; T1 = ADDRESS OF SPACE ; T2 = SIZE OF SPACE ; MOVEI P1,XXX.IX ;AREA ; PUSHJ P,.RETSP ; ;USES T3 AND T4 ;HERE TO ADD SOME WORDS TO FREE CORE LIST ;ADDRESS OF BLOCK IN T1 ;SIZE OF IT IN T2 ;ALSO USES T3,T4 ;IF SPACE IS ADJACENT TO TOP OF AREA MOVE DOWN THE XX.AB POINTER ; THIS FREES UP THE SPACE FOR THE GENERAL CORE EXPANDER .RETSP::JUMPE T2,CPOPJ ;CAN NOT GIVE BACK 0 CAML T1,TAB.LB(P1) ;MAKE SURE ITS IN BOUNDS CAMLE T1,TAB.AB(P1) PUSHJ P,E$$RUM ;[1174] IT'S NOT, GIVE ERROR CAIGE T2,.IPS ;IF MORE THAN 1 BLOCK JRST ADDWDS ;NO, JUST LINK IN MOVE T3,T1 ;GET COPY ADDI T3,(T2) ;END OF AREA CAME T3,TAB.AB(P1) ;ADJACENT TO UPPER USED BOUND? JRST ADDWDS ;NO MOVE T3,T1 ;GET COPY IORI T3,.IPM ;MAKE INTO BOUND MOVE T4,T3 ;GET A COPY EXCH T4,TAB.AB(P1) ;AND EXCHANGE WITH PREVIOUS COPY ;HOWEVER WE HAVE TO ZERO THE AREA HRL T3,T3 ;SO BUILD BLT POINTER SETZM (T3) ;CLEAR FIRST WORD ADDI T3,1 ;FINISH BLT POINTER BLT T3,(T4) ;CLEAR ALL OF AREA MOVE T3,T2 ;GET COPY OF NEW ADDRESS ANDCMI T3,.IPM ;COUNT NO. OF BLOCKS MOVN T3,T3 ;NEGATE SO WE CAN ADD ADDM T3,TAB.PT(P1) ; TO FREE SPACE POINTER TO KEEP IN BOUNDS ANDI T2,.IPM ;LESS TO GIVE BACK NOW JUMPE T2,CPOPJ ;FINISHED IF NONE ADDWDS: HRLZM T2,(T1) ;STORE SIZE AND CLEAR ADDRESS ADDM T2,TB.FSP(P1) ;ADD IN THIS BLOCK SKIPE TB.LNK(P1) ;ANYTHING THERE? JRST ADDWD1 ;YES, LINK IN CHAIN SUB T1,TAB.LB(P1) ;REMOVE OFFSET HRRZM T1,TB.LNK(P1) ;ADDRESS IN RIGHT HALF POPJ P, ;RETURN E$$RUM::.ERR. (MS,,V%L,L%F,S%F,RUM,) ;[1174] ADDWD1: REPEAT 0,< MOVEI T4,TB.LNK(P1) ;START OF CHAIN JRST ADDWD3 ;SKIP FIRST TIME ADDWD2: HRL T4,T4 ;SAVE PREVIOUS IN LEFT HALF HLR T4,T3 ;SAVE LAST POINTER WITH ADDRESS IN RIGHT ADDWD3: MOVE T3,(T4) ;GET NEXT POINTER TRNE T3,-1 ;LEAVE ZERO ALONE ADD T3,TAB.LB(P1) ;ADD OFFSET MOVS T3,T3 ;GET SIZE IN RIGHT HALF, ADDRESS IN LEFT CAIG T2,(T3) ;FIND CURRENT HOLE AT LEAST AS BIG JRST ADDWD4 ;YES, LINK INTO LIST TLNE T3,-1 ;FINISHED LIST IF ADDRESS IS 0 JRST ADDWD2 ;NO, TRY AGAIN SUB T1,TAB.LB(P1) ;REMOVE OFFSET HRRM T1,(T4) ;YES, LINK ONTO END POPJ P, ADDWD4: TRNE T4,-1 ;END OF CHAIN IF 0 ADDRESS JRST ADDWD5 ;YES, USE PREV POINTERS SUB T4,TAB.LB(P1) ;REMOVE OFFSET HRRM T4,(T1) ;STORE IN LINK ADDRESS SUB T1,TAB.LB(P1) ;REMOVE OFFSET ADD T4,TAB.LB(P1) ;ADD OFFSET HRRM T1,(T4) POPJ P, ADDWD5: SUB T4,TAB.LB(P1) ;REMOVE OFFSET MOVS T4,T4 ;PREVIOUS,,CURRENT SUB T1,TAB.LB(P1) HRRM T1,(T4) ;LINK BACK IN CHAIN ADD T1,TAB.LB(P1) HLRM T4,(T1) ;ANDFORWARDS POPJ P, > ; [1401] REPEAT 0 ; ;[1401] The following modification converts free space management to a ; first-fit algorithm and randomizes the free space chain. ; Credit to Knuth ( who describes it and notes its virtues ) ; and to DZN ( who told me to check it out ). ; MOVE T4,TB.LNK(P1) ;[1401] PICK UP 1ST LINK HRRM T4,(T1) ;[1401] CHAIN IN RETURNED BLOCK HRRZ T4,T1 ;[1401] GET PTR TO RETURNED BLOCK SUB T4,TAB.LB(P1) ;[1401] RELATIVIZE IT MOVEM T4,TB.LNK(P1) ;[1401] AND STORE AS HEAD OF CHAIN POPJ P, ;[1401] DONE SUBTTL XX.GBC - SUBROUTINES TO GARBAGE COLLECT SPECIFIC AREA DEFINE XXX(AREA) < AREA'.GBC::PUSHJ P,.SAVE1## ;SAVE P1 MOVEI P1,AREA'.IX ;INDEX TO AREA PJRST .GBCSP ;GARBAGE COLLECT > XALL AREAS SALL ;SUBROUTINE TO GARBAGE COLLECT SPECIFIC AREA ; ;CALLING SEQUENCE ; PUSH P,P1 ;SAVE P1 ; MOVEI P1,XXX.IX ;AREA ; PUSHJ P,.GBCSP ; ;USES T1, T2, T3, T4 ; ;THE FREE SPACE IS IN A LIST ANCHORED TO TB.LNK ;STORED IN ASCENDING ORDER OF SIZE ;FIRST RELINK LIST IN ASCENDING ORDER OF ADDRESS ANCHORED TO TAB.NB ;THEN COLLECT ADJACENT AREAS, GIVE BACK TOP IF ALL FREE ;THEN PUT NEW LIST BACK IN TB.LNK ;NOTE, TEMP LIST CONTAINS ACTUAL ADDRESSES SINCE CORE CANNOT MOVE .GBCSP::SKIPN TB.FSP(P1) ;ANYTHING TO DO? POPJ P, ;NO SETZM TB.FSP(P1) ;WE ARE ABOUT TO TAKE IT ALL MOVE T1,TB.LNK(P1) ;FIRST TIME JUST STORE ADD T1,TAB.LB(P1) ;ADD IN BASE MOVE T2,(T1) ;GET NEXT POINTER HRRZM T2,TB.LNK(P1) ;SAVE FOR 2ND HLLZS (T1) ;CLEAR LINK HRRZM T1,TAB.NB(P1) ;USED TO HOLD TEMP LIST GBCSP1: SKIPN T1,TB.LNK(P1) ;GET ADDRESS OF BLOCK JRST GBCSP5 ;ALL DONE, NOW COLLECT ADD T1,TAB.LB(P1) ;ADD IN BASE HRRZ T2,(T1) ;GET NEXT POINTER HRRZM T2,TB.LNK(P1) ;STORE NEXT BLOCK POINTER HLLZS (T1) ;CLEAR FORWARD POINTER MOVE T3,TAB.NB(P1) ;START OF TEMP CHAIN SETZ T4, ;FIRST TIME GBCSP2: CAIG T1,(T3) ;FIND CURRENT HOLE AT HIGHER ADDRESS JRST GBCSP3 ;YES, LINK INTO LIST MOVE T4,T3 ;CURRENT GETS FUTURE HRRZ T3,(T4) ;GET NEXT POINTER JUMPN T3,GBCSP2 ;NOT FINISHED YET HRRM T1,(T4) ;YES, LINK ONTO END JRST GBCSP1 ;SEE IF MORE TO DO ;HERE WHEN CURRENT ADDRESS IS NOT HIGHEST GBCSP3: JUMPN T4,GBCSP4 ;0 IF LOWEST ADDRESS HRRM T3,(T1) ;STORE IN LINK ADDRESS HRRZM T1,TAB.NB(P1) ;STORE BACK AS LOWEST JRST GBCSP1 ;SEE IF MORE TO DO ;HERE IF ADDRESS IS IN MIDDLE OF LIST GBCSP4: HRRM T3,(T1) ;LINK FORWARDS HRRM T1,(T4) ;LINK BACK IN CHAIN JRST GBCSP1 ;SEE IF MORE TO DO ;NOW TO COLLECT ADJACENT SPACES GBCSP5: SKIPA T4,TAB.NB(P1) ;GET START OF LIST GBCSP6: HRRZ T4,T1 ;NEXT NON-CONTIGUOUS AREA JUMPE T4,GBCSP8 ;END OF LIST IF 0 GBCSP7: MOVE T1,(T4) ;GET SIZE,, NEXT POINTER HLRZ T2,T1 ;SIZE OF THIS BLOCK ADDI T2,(T4) ;END OF THIS +1 HRRZ T3,T4 ;SAVE T4 INCASE END IN SIGHT CAIE T2,(T1) ;ADJACENT? JRST GBCSP6 ;NO HLLZS (T4) ;CLEAR CURRENT POINTER IN FIRST BLOCK MOVE T2,(T1) ;GET FUTURE POINTER AND CURRENT SIZE ADDM T2,(T4) ;ADD NEW SIZE AND POINTER SETZM (T1) ;CLEAR OLD POINTER IN 2ND BLOCK JRST GBCSP7 ;GET NEXT ADJACENT ;HERE TO GIVE BACK TOP PIECE IF POSSIBLE GBCSP8: MOVS T1,T1 ;PUT SIZE IN RIGHT ADD T1,TAB.FR(P1) ;ADD IN UNALLOCATED SPACE IN LAST BLOCK CAMN T2,TAB.PT(P1) ;COMPARE WITH UNALLOCATED POINTER CAIGE T1,.IPS ;MUST BE 1 OR MORE BLOCKS JRST GBCSP9 ;NOT ENOUGH MOVE T2,T3 ;GET COPY OF LOWEST FREE ADDRESS IN LAST BLOCK IORI T2,.IPM ;ROUND UP MOVE T4,TAB.PT(P1) ;SAVE TOP OF CURRENTLY ZEROED CORE MOVEM T2,TAB.AB(P1) ;MAKE NEW TOP OF USED CORE MOVEM T3,TAB.PT(P1) ;SAVE NEW UNALLOCATED POINTER ANDI T1,.IPM ;NO. OF WORDS FREE IN LAST BLOCK MOVEM T1,TAB.FR(P1) ;AS UNALLOCATED IN LAST BLOCK MOVEI T1,TAB.NB(P1) ;NOW WE MUST CLEAR LAST FORWARD POINTER CAIA MOVE T1,T2 ;CURRENT GETS PREV FUTURE HRRZ T2,(T1) ;SET NEW FUTURE CAIE T2,(T3) ;FOUND IT? JRST .-3 ;NO HLLZS (T1) ;YES, CLEAR FORWARD LINK HRL T3,T3 ;FORM BLT PTR TO CLEAR CORE ADDI T3,1 ;FROM NEW TAB.PT SETZM -1(T3) ; UP TO BLT T3,(T4) ; OLD TAB.PT ;HERE TO RE-LINK IN ORDER OF SIZE GBCSP9: SKIPN T1,TAB.NB(P1) ;GET NEXT POINTER POPJ P, ;ALL DONE MOVE T2,(T1) ;GET SIZE,,NEXT POINTER HRRZM T2,TAB.NB(P1) ;STORE NEXT HLRZ T2,T2 ;SIZE ONLY PUSHJ P,.RETSP ;RETURN THIS BLOCK JRST GBCSP9 ;LOOP SUBTTL XX.TST - SUBROUTINES TO SEE IF SPECIFIED ADDRESS IS FREE (TO EXPAND CURRENT BLOCK) ;CALLING SEQUENCE IS ; PUSHJ P,XX.TST ; WITH T1 = REQUIRED ADDRESS ; RETURN 0 FAILED ; RETURN 1 T2 = SIZE OF BLOCK AVAILABLE DEFINE XXX(AREA) < AREA'.TST::PUSH P,P1 ;SAVE P1 MOVEI P1,AREA'.IX ;INDEX TO AREA .TSTBK: PUSHJ P,.TSTSP ;GENERAL SIMPLE CORE TESTER CAIA ;NON-SKIP RETURN AOS -1(P) ;SKIP RETURN POP P,P1 ;RESTORE POPJ P, DEFINE XXX(%AREA) < %AREA'.TST::PUSH P,P1 ;SAVE P1 MOVEI P1,%AREA'.IX ;INDEX TO %AREA PJRST .TSTBK ;COMMON RETURN >> XALL AREAS SALL ;SUBROUTINE TO TEST IF ADDRESS IS FREE .TSTSP: ENTRY .TSTSP SKIPN T2,TB.LNK(P1) ;GET START OF CHAIN POPJ P, ;NO START HRL T1,T2 ;STORE BACK ADDRESS JRST .TSTS2 ;FIRST TIME .TSTS1: HRL T1,T2 ;STORE BACK ADDRESS HRRZ T2,(T2) ;GET NEXT ADDRESS JUMPE T2,CPOPJ ;ZERO IS END ADD T2,TAB.LB(P1) ;RELOCATE IT .TSTS2: CAIE T2,(T1) ;WHAT WE WANT? JRST .TSTS1 ;NO, TRY NEXT HLRZ T2,(T2) ;GET SIZE JRST CPOPJ1 ;AND SKIP RETURN SUBTTL XX.REM - SUBROUTINES TO REMOVE SPECIFIED BLOCK (TO ADD TO CURRENT IN USE) ;CALLING SEQUENCE IS ; PUSHJ P,XX.REM ; WITH T1 =BACK ADDRESS,, REQUIRED ADDRESS ; T2 = SIZE REQUIRED DEFINE XXX(AREA) < AREA'.REM::PUSH P,P1 ;SAVE P1 MOVEI P1,AREA'.IX ;INDEX TO AREA .REMBK: PUSHJ P,.TSTSP ;GENERAL SIMPLE CORE REMOVER POP P,P1 ;RESTORE POPJ P, DEFINE XXX(%AREA) < %AREA'.REM::PUSH P,P1 ;SAVE P1 MOVEI P1,%AREA'.IX ;INDEX TO %AREA PJRST .REMBK ;COMMON RETURN >> XALL AREAS SALL ;SUBROUTINE TO REMOVE DESIRED CHUNK .REMSP: ENTRY .REMSP PJRST .GETSR ;USE GENERAL PURPOSE ROUTINE SUBTTL XX.ZAP ROUTINE TO REMOVE ALL OF ONE AREA ;CALLING SEQUENCE ; MOVEI T1, AREA TO BE REMOVED ; PUSHJ P,XX.ZAP ;ALSO USES T2 XX.ZAP::SKIPN T2,TAB.LB(T1) ;GET LOWER BOUND JRST ZAP0 ;JUST CLEAR POINTERS IFE TOPS20,< HRL T2,T2 ;FORM BLT POINTER ADDI T2,1 ;WELL ALMOST SETZM -1(T2) ;CLEAR FIRST WORD BLT T2,@TAB.AB(T1) ;AND REST > ;[1401] IFE TOPS20 IFN TOPS20,< ADDI T2,1 MOVE T3,TAB.AB(T1) ;[1401] PICK UP LAST ADDR SUB T3,T2 ;[1401] LENGTH LSH T3,-9 ;[1401] IN PAGES AOJE T3,XXZAP1 ;[2202] NO, INCLUDE ALL PAGES TXO T3, ;[2202] MARK IT A COUNT PUSH P,T1 ;[1401] SAVE INDEX LSH T2,-9 ;[1401] IN PAGES HRLI T2,.FHSLF SETOM T1 PMAP% POP P,T1 ;[1401] RESTORE INDEX XXZAP1: ;[2202] > ;[1401] IFN TOPS20 MOVE T2,TAB.UB(T1) ;GET UPPER BOUND PUSH P,T1 ;SAVE T1 SKIPN TAB.LB-1(T1) ;SEE WHO TO GIVE IT TO SOJA T1,.-1 ;WILL GET DY EVENTUALLY MOVEM T2,TAB.UB-1(T1) ;GIVE IT TO NEXT LOWER AREA SETUP POP P,T1 ;RESTORE ORIGINAL AREA ZAP0: SETZM TAB.LB(T1) ;CLEAR ALL POINTERS SETZM TAB.AB(T1) SETZM TAB.UB(T1) SETZM TAB.PT(T1) SETZM TAB.FR(T1) SETZM TB.LNK(T1) SETZM TB.FSP(T1) POPJ P, ;RETURN SUBTTL GIVE BACK BLOCKS OF CORE ;CALLING SEQUENCE ; HRRI T1,UPPER ADDRESS TO RETURN ; HRLI T1,UPPER ADDRESS TO CLEAR ; PUSHJ P,GBCK.L ;ALSO USES T2 GBCK.L:: HLRZ T2,T1 ;[647] GET UPPER ADDRESS TO CLEAR JUMPE T2,[PUSH P,T1 ;[647] UPPER ADDRESS TO CLEAR SAME AS RETURN JRST GBCKL1] HRRZS T1,T1 ;[647] CLEAR LH CAMLE T2,T1 ;[647] CLEARING MORE THAN GIVING BACK? MOVE T2,T1 ;[647] YES, DON'T CLEAR TOO FAR PUSH P,T2 ;[647] SAVE HIGHEST TO CLEAR TO GBCKL1: IFN DEBSW,< HRRZ T2,T1 ANDI T2,.IPM ;ADDRESS MUST END IN .IPM CAIE T2,.IPM HALT > MOVEI T2,HG.TAB ;START AT TOP GBCKL2: JUMPL T2,CPOPJ ;[1755] STOP WHEN THROUGH SKIPE TAB.LB(T2) ;IGNORE IF NOT SETUP CAMGE T1,TAB.LB(T2) ;FOUND RIGHT BLOCK YET? SOJA T2,.-2 ;NO, BUT WE WILL HRRZ T3,TAB.LB(T2) ;GET 1ST ADDRESS MOVEM T1,TAB.LB(T2) ;[2215] UPDATE NEW LOWER BOUND POP P,T1 ;[2215] GET UPPER ADDRESS TO CLEAR IFN TOPS20,< ;[2215] ALWAYS BLT ON TOPS-10 CAIG T1,T3 ;[2215] ANYTHING TO CLEAR? JRST GBCKL3 ;[2215] NO > ;[2215] IFN TOPS20 SETZM (T3) ;ZERO FIRST ADDRESS HRL T3,T3 ADDI T3,1 ;FORM BLT PTR BLT T3,@T1 ;CLEAR ALL OF CORE GBCKL3: MOVE T1,TAB.LB(T2) ;[647] GET NEW LOWER BOUND AOSA TAB.LB(T2) ;AS NEXT HIGHER ADDRESS SKIPN TAB.LB(T2) ;LOOK FOR NEXT LOWER AREA SETUP SOJA T2,.-1 ;WILL FIND ONE EVENTUALLY MOVEM T1,TAB.UB(T2) ;GIVE FREE SPACE TO IT POPJ P, SUBTTL DSK OVERFLOW ROUTINES ;USE STANDARD OPEN BLOCK, EASIER TO DEBUG AND DUMP DATA BASE LNKOVF: SKIPN AS.LB ;IS THERE AN AS AREA? JRST LSCOVF ;NO, CHECK LS AREA SKIPE PAG.AS ;AS AREA ALREADY PAGED OUT? JRST ASREDU ;YES, TRY TO REDUCE IT FURTHER PUSHJ P,AS.DMP ;NO, PUT IT OUT JRST LSCOVF ;[650] DIDN'T WIN ANYTHING JRST LNKCON ;AND TRY AGAIN LSCOVF: SKIPN LS.PP ;ALLOWED TO THINK ABOUT LS AREA? SKIPN LS.LB ;DO WE STIL HAVE SYMBOLS? JRST LHCOVF ;NO, TRY CORE SKIPE PAG.LS ;ALL LOCAL SYMBOLS STILL IN CORE? JRST LSREDU ;NO PUSHJ P,LS.DMP ;YES, GET RID OF THEM JRST LHCOVF ;[650] DIDN'T GET ANYWHERE JRST LNKCON ;AND TRY AGAIN ;HERE TO SEE IF THE AS AREA IS BIGGER THAN ONE PAGE, AND REDUCE ;IT UNMERCIFULLY IF SO. THERE IS NO PERCENTAGE IN KEEPING IT IN. ASREDU: MOVE T2,AS.PT ;[2202] GET ABS POINTER TO FIRST FREE SUB T2,AS.LB ;[2202] SUBTRACT FIRST USED ANDCMI T2,.IPM ;[2202] FIND HOW MANY WORDS WE CAN OUTPUT JUMPE T2,LSCOVF ;[2202] IF NONE, TRY LS AREA ADD T2,LW.AS ;[2202] CONVERT TO NEW LW.AS PUSH P,T2 ;[2202] SAVE THE NEW LOW VIRTUAL ADDRESS SUBI T2,1 ;[2202] FIND HIGHEST ADDR TO OUTPUT MOVE T1,LW.AS ;[2202] LAST TO OUTPUT PUSHJ P,AS.OUT ;DUMP THE CORE POP P,LW.AS ;RESTORE NEW LOWEST ADDR IN CORE MOVE T1,AS.PT ;GET POINTER TO 1ST PAGE STILL IN ANDCMI T1,.IPM ;FIND FIRST ADDR TO KEEP SUBI T1,1 ;MAKE LAST LOC TO RETURN IFN TOPS20,< ;[2215] DON'T HAVE GBCK.L ZERO THE AREA HRLI T1,1 ;[2215] SINCE AS.OUT REMOVED IT'S PAGES > ;[2215] IFN TOPS20 PUSHJ P,GBCK.L ;GIVE BACK THE CORE MOVE T1,LW.AS ;GET LOWEST ADDR IN CORE ADD T1,AS.AB ;CALCULATE HIGHEST VIRT ADDR SUB T1,AS.LB ;AS LW+AB-LB MOVEM T1,UW.AS ;STORE FOR THE WORLD JRST LNKCON ;TRY THE ALLOCATION AGAIN ;HERE TO SEE IF IT IS WORTHWHILE TO OUTPUT MORE OF THE SYMBOL TABLE LSREDU: MOVE T2,LS.AB ;[2202] SEE IF ITS WORTH IT SUB T2,LS.LB ;[2202] GET THE SIZE ANDCMI T2,.IPM ;[2202] BUT NOT INCLUDING LAST BLOCK JUMPE T2,LHCOVF ;[2202] NOTHING TO DO, TRY CORE OVERFLOW MOVE T2,LSYM ;[2202] HIGHEST ANDCMI T2,.IPM ;[2202] EXCEPT FOR LAST BLOCK PUSH P,T2 ;[2202] SAVE AS IT WILL BE LOWEST AFTER OUTPUT SUBI T2,1 ;[2202] HIGHEST IS ONE LESS MOVE T1,LW.LS ;[2202] LOWEST NOW PUSHJ P,LS.OUT ;OUTPUT WINDOW POP P,LW.LS ;RESET LOWER WINDOW MOVE T1,LS.PT ;POINTER INTO PAGE STAYING IN ANDCMI T1,.IPM ;GET ADDRESS OF START OF PAGE SUBI T1,1 ;LAST GOING OUT IS 1 LESS IFN TOPS20,< ;[2215] DON'T HAVE GBCK.L ZERO THE AREA HRLI T1,1 ;[2215] SINCE LS.OUT REMOVED IT'S PAGES > ;[2215] IFN TOPS20 PUSHJ P,GBCK.L ;GIVE IT AWAY JRST LNKCON ;TRY AGAIN ;HERE TO CHECK FOR EITHER LC OR HC TO BE PAGED ;THE ALGORITHM IS ;IF ONLY A LOW SEGMENT REDUCE ITS SIZE ;IF TWO SEGMENTS THEN ; IF NEITHER HAS YET BEEN OUTPUT, OUTPUT THE LARGER ; IF BOTH HAVE BEEN OUTPUT, THEN OUTPUT SOME OF CURRENT LARGER ; IF ONLY ONE HAS BEEN OUTPUT, THEN OUTPUT SOME OF CURRENT LARGER LHCOVF: SKIPN HC.LB ;IF NO HIGH SEGMENT JRST LCOVF ;NO CHOICE BUT TO PAGE LOW SEG ;SEE IF WE ARE PAGING BOTH ALREADY DGET T1,LC.AB,HC.AB ;GET UPPER BOUNDS SUB T1,LC.LB SUB T2,HC.LB ;FIND LENGTHS IFE TOPS20,< ;[2247] CAIN T1,.IPM ;[650] BOTH SEGMENTS MINIMUM SIZE? CAIE T2,.IPM ;[650] MAYBE, ARE THEY? JRST LHCOV1 ;[650] NO PUSHJ P,CHKMAX ;[650] YES, SEE IF MAXCOR REASONABLE JRST LNKCON ;[650] MORE ROOM! EXPAND CORE... DGET T1,LC.AB,HC.AB ;[650] RECALCULATE WHAT CHKMAX WIPED OUT SUB T1,LC.LB ;[650] SUB T2,HC.LB ;[650] LHCOV1: SKIPE PAG.S1 SKIPN PAG.S2 JRST LCHCHK ;NO >;[2247] END IFE TOPS20 ;HERE IF BOTH AREAS ARE PAGED CAMG T2,T1 ;LOW .GT. HIGH JRST LCREDU ;YES, IF EQUAL TAKE FROM LOW JRST HCREDU ;NO TRY HIGH IFE TOPS20,< ;[2247] ;HERE TO DECIDE WHETHER TO REDUCE THE SIZE OF SEGMENT ALREADY ;PAGED, OR TO START PAGING ONE ;WE NEED SOME GOOD WAY TO DECIDE WHICH ;TO OUTPUT FIRST ;FOR NOW JUST OUTPUT BIGGER ;PERHAPS SHOULD OUTPUT ONE WITH MOST BLANK DATA ;CHECK THAT PAGING THE LARGER WILL ;BE ENOUGH -- IF NOT JUST PAGE ;REQUIRED ONE LCHCHK: MOVEI T3,LC.IX ;ASSUME LOW IS BIGGEST CAMGE T1,T2 ;WHICH SEGMENT IS BIGGER? MOVEI T3,HC.IX ;HIGH IS, USE IT CAMGE P2,T1-LC.IX(T3) ;IS IT BIG ENOUGH? PJRST @[EXP LCREDW,HCREDW]-LC.IX(T3) ;YES, DO BIGEST CAIE P1,LC.IX ;CAN ONLY PAGE REQUESTED IF CAIN P1,HC.IX ;LC OR HC, OTHERWISE USE T3 PJRST @[EXP LCREDW,HCREDW]-LC.IX(P1) ;NO, DO REQUESTED PJRST @[EXP LCREDW,HCREDW]-LC.IX(T3) ;JUST USE BIGGEST >;[2247] IFE TOPS20 LCOVF: SKIPN LC.LB ;[1113] LAST CHANCE--IS THERE AN LC AREA? JRST E$$MEF ;[1174] NO--JUST RAN OUT OF LUCK IFN TOPS20,< ;[2247] JRST LCREDU ;[2247] REDUCE LOW SEGMENT >;[2247] IFN TOPS20 IFE TOPS20,< ;[2247] MOVE T1,LC.AB ;[650] FIND SIZE SUB T1,LC.LB ;[650] CAIE T1,.IPM ;[650] ONLY ONE PAGE? JRST LCOVF1 ;[650] NO, CONTINUE PUSHJ P,CHKMAX ;[650] YES, MAXCOR REASONABLE? JRST LNKCON ;[650] WASN'T, TRY AGAIN LCOVF1: SKIPN PAG.S1 ;ALREADY PAGING? JRST LC.DMP ;NO DO SO JRST LCREDU ;YES, REDUCE SIZE OF WINDOW ;HERE TO TEST /MAXCORE TO MAKE SURE SIZE IS REASONABLE ;IF NOT INCREASE MAXCOR BUT WARN USER CHKMAX: SKIPN MAXCOR ;MAXCOR SET? JRST CPOPJ1 ;NO, SKIP RETURN MOVE T1,DY.AB ;SEE HOW MUCH WE ABSOLUTELY NEED ADD T1,GS.AB SUB T1,GS.LB ;+GLOBAL AREA ADD T1,FX.AB SUB T1,FX.LB ;+FIXUPS IFN FTOVERLAY,< ADD T1,RT.AB ;[650] SUB T1,RT.LB ;[650] +RELOCATION TABLES ADD T1,BG.AB ;[650] SUB T1,BG.LB ;[650] +BOUND GLOBALS > ;END OF IFN FTOVERLAY ADDI T1,2*.IPS ;SYMBOLS + LOW CODE SKIPE HC.LB ADDI T1,.IPS ;+ HIGH CODE SKIPE AS.LB ;[650] ALGOL SYMBOLS? ADDI T1,.IPS ;[650] YES, ONE BIGGER CAIE P1,LC.IX ;[1130] COUNT THIS REQUEST TOO CAIN P1,HC.IX ;[1130] UNLESS THE REQUEST IS FOR JRST CHKMX1 ;[1130] A PAGABLE AREA, I.E., CAIE P1,LS.IX ;[1130] LC, HC, LS OR AS CAIN P1,AS.IX ;[1130] .. JRST CHKMX1 ;[1130] .. ADD T1,P2 ;[1130] NOT PAGABLE--COUNT THIS REQUEST TOO CHKMX1: IOR. T1,.PGSIZ ;[1130] GET PAGE BOUND CAMG T1,MAXCOR ;TROUBLE IF MAXCOR TOO SMALL JRST CPOPJ1 ;OK, ITS NOT MOVE T2,HIORGN ;[650] GET BOTTOM OF HIGH SEG SUBI T2,1001 ;[650] MAX MAXCORE, WITH 1P FOR HELPER CAMLE T1,T2 ;[650] NEED LESS THAN MAX?? JRST CPOPJ1 ;[650] NO, DON'T INCREASE ANY MORE MOVEM T1,MAXCOR ;SAVE NEW MINIMUM E$$MSS::.ERR. (MS,.EC,V%L,L%W,S%W,MSS,) ;[1174] .ETC. (COR,.EP,,,,T1) SETZM CORFUL ;[650] LET LDCOR2 TRY AGAIN POPJ P, ;HERE FOR LOW SEGMENT LCREDW: SKIPN PAG.S1 ;ALREADY SETUP? JRST LC.DMP ;NO, FIRST TIME >;[2247] IFE TOPS20 LCREDU: PUSH P,R ;SAVE R MOVEI R,LC.IX ;INDEX FOR LOW JRST CREDU ;REDUCE SIZE ;HERE FOR HIGH SEGMENT IFE TOPS20,< ;[2247] HCREDW: SKIPN PAG.S2 ;ALREADY SETUP JRST HC.DMP ;NO, FIRST TIME >;[2247] IFE TOPS20 HCREDU: PUSH P,R ;SAVE R MOVEI R,HC.IX ;INDEX FOR HIGH ;FALL INTO CREDU ;HERE TO REDUCE LOW/HIGH SEGMENT WINDOW TO HALF SIZE AND TRY AGAIN ;IF THIS IS NOT ENOUGH, LNKCOR WILL LOOP UNTIL ;EITHER ALL WINDOWS ARE DOWN TO 200 WORDS OR IT GETS ENOUGH SPACE CREDU: MOVE T2,TAB.AB(R) ;[2202] TOP SUB T2,TAB.LB(R) ;[2202] -BOTTOM ADDI T2,1 ;[2202] LENGTH LSH T2,-1 ;[2202] CUT IN HALF ANDCMI T2,.IWM ;[2202] AT LEASET RESERVE WINDOW SIZE JUMPE T2,TPOVF ;[2270] TRY THE TYPECHECKING AREA PUSH P,T2 ;[2202] SAVE LENGTH TO REMOVE IFE TOPS20,< ADD T2,LW.S0(R) ;[2202] NEW BOTTOM SUBI T2,1 ;[2202] THEREFORE TOP TO OUTPUT MOVE T1,LW.S0(R) ;[2202] FROM HERE UP > ;[1401] IFE TOPS20 IFN TOPS20,< MOVE T1,LW.S0(R) ;[2202] SEND THE WHOLE AREA AWAY MOVE T2,UW.S0(R) ;[2202] > ;[1401] IFN TOPS20 PUSHJ P,@[EXP LC.OUT,HC.OUT]-1(R) POP P,T1 ;GET BACK LENGTH IFE TOPS20,< ADDM T1,LW.S0(R) ;SHORTEN WINDOW ADD T1,TAB.LB(R) ;FIX IN CORE SUBI T1,1 ;HIGHEST ADDRESS TO GIVE AWAY PUSHJ P,GBCK.L ;TO NEXT LOWER AREA IN USE > ;[1401] IFE TOPS20 IFN TOPS20,< MOVE T2,TAB.LW(R) ;[1532] SHORTEN WINDOW ADD T2,T1 ;[1532] NEW WINDOW STARTS MOVEM T2,TAB.LW(R) ;[1532] MIDWAY THRU CURRENT WINDOW ADDB T1,TAB.LB(R) ;[1401] SUBTRACT FROM THIS AREA PUSH P,R ;[1401] SAVE THE INDEX SOSA T1 ;[1401] NEW TOP OF NEXT LOWER AREA SKIPN TAB.LB(R) ;[1401] FIND THE NEXT LOWER AREA SOJN R,.-1 ;[1401] KEEP GOING TILL WE DO MOVEM T1,TAB.UB(R) ;[1401] HAVING DONE SO, RESET IT'S UPPER BOUND POP P,R ;[1401] RESTORE THE INDEX MOVE T1,LW.S0(R) ;[2202] GET HALF AREA BACK MOVE T2,UW.S0(R) ;[2202] PUSHJ P,@[EXP LC.IN,HC.IN]-1(R) > ;[1401] IFN TOPS20 POP P,R ;RESTORE R JRST LNKCON ;TRY AGAIN, MAY RETURN TPOVF: POP P,R ;[2270] RESTORE R SKIPE TP.AB ;[2270] HAVE A TYPECHECKING AREA? SKIPE TP.PP ;[2270] AND ALOWED TO PAGE IT? POPJ P, ;[2270] NO, RETURN NON-SKIP SKIPE PAG.TP ;[2270] ALREADY OVERFLOWED? JRST TPREDU ;[2270] NO PUSHJ P,TP.DMP ;[2270] YES, GET RID OF THEM POPJ P, ;[2270] DIDN'T GET ANYWHERE JRST LNKCON ;[2270] AND TRY AGAIN TPREDU: MOVE T1,UW.TP ;[2270] GET THE UPPER BOUND SUB T1,LW.TP ;[2270] GET THE SIZE CAIGE T1,2*.IPS ;[2270] MORE THAN TWO PAGES LEFT? POPJ P, ;[2270] NO, NOTHING TO DO LSH T1,-1 ;[2270] GET HALF THE SIZE TRO T1,.IPM ;[2270] SET ON A PAGE BOUNDARY ADD T1,LW.TP ;[2270] PLUS BOTTOM IS HIGHEST TO KEEP MOVE T2,UW.TP ;[2270] GET THE OLD UPPER WINDOW MOVEM T1,UW.TP ;[2270] SET IT AS THE NEW UPPER WINDOW ADDI T1,1 ;[2270] FIRST WORD TO REMOVE PUSHJ P,TP.OUT ;[2270] REMOVE IT MOVE T1,UW.TP ;[2270] GET THE UPPER BOUND SUB T1,LW.TP ;[2270] GET THE NEW SIZE ADD T1,TP.LB ;[2270] GET NEW HIGH ADDRESS MOVEM T1,TP.AB ;[2270] SAVE IT JRST LNKCON ;[2270] TRY AGAIN SUBTTL DISK OVERFLOW ROUTINES -- OUTPUT -- TOPS10 ;CALLED BY ; MOVE T1,[FIRST,,LAST ADDRESS TO OUTPUT] ; PUSHJ P,LC.OUT/HC.OUT/LS.OUT ;USES T1, T2, T3 IFE TOPS20,< DEFINE PAGOUT (%AREA,CHAN,WD)< %AREA'.OUT:: CAMLE T2,HB.'WD ;BIGGEST SO FAR? MOVEM T2,HB.'WD ;YES IFIDN <%AREA>,< ;[2366] Special if LC area ;[2366] Build byte pointer to the map. Point at the first page ;[2366] to write. SPUSH ;[2366] Need lots of acs LSH T1,-.DBS2W ;[2366] From address into 128 word blocks LSH T2,-.DBS2W ;[2366] To address into 128 word blocks MOVE T3,T1 ;[2366] Get the from address LSH T3,-.LMS2D ;[2366] Make index into map ADJBP T3,[POINT 18,LC.MAP,17] ;[2366] Find the offset into the entry ;[2366] Get the next disk block LCOUTL: LDB T4,T3 ;[2366] Get the window base block JUMPN T4,LCOUTN ;[2366] Check for non-zero ;[2366] Found a zero entry. Fill in as many zero entries as necessary PUSH P,T3 ;[2366] Save the pointer PUSH P,T1 ;[2366] And the from block MOVE P1,LC.UM ;[2366] Get the new block number LCOUTZ: ADDI P1,1 ;[2366] Actually one higher DPB P1,T3 ;[2366] Store the block number ADDI P1,.LMS-1 ;[2366] Point to next block group MOVEM P1,LC.UM ;[2366] Adjust upper bound ADDI T1,.LMS ;[2366] Address for next group CAML T1,T2 ;[2366] Last index for this write? JRST LCOUTA ;[2366] Yes, go pop acs and continue ILDB T4,T3 ;[2366] No, get the next index JUMPE T4,LCOUTZ ;[2366] Get an index if it is zero LCOUTA: POP P,T1 ;[2366] Get the from block POP P,T3 ;[2366] And the pointer JRST LCOUTL ;[2366] Go output these blocks ;[2366] Found an index. Add the offset and do USETO LCOUTN: MOVE P1,T1 ;[2366] Get the from block ANDI P1,.LMM ;[2366] Get the offset part MOVE P2,T4 ;[2366] Get the index base ADD T4,P1 ;[2366] Get the actual disk block USETO CHAN,(T4) ;[2366] Set on block MOVE P4,T4 ;[2366] Remember the starting block ;[2366] Loop looking for contiguous blocks. Stop when there is ;[2366] either no contiguous block, or when the last block needed ;[2366] is seen. ;[2366] P1 Contains the number of blocks to write ;[2366] P2 Contains the index base for the current block ;[2366] P3 contains the block number to write SUBI P1,.LMS ;[2366] Get the number of blocks MOVN P1,P1 ;[2366] As a positive quantity MOVE P3,T1 ;[2366] Get a copy of the from block TRZ P3,.LMM ;[2366] Get beginning block for this index LCOUTM: ADDI P3,.LMS ;[2366] Beginning of next index CAML P3,T2 ;[2366] Need next index? JRST LCOUTE ;[2366] No ILDB T4,T3 ;[2366] Get the next block index ADDI P2,.LMS ;[2366] Increment the previous index CAMN P2,T4 ;[2366] Are they the same? CAIL P1,<<400000/.DBS>-.LMS> ;[2366] And IOWD below limit? JRST LCOUTF ;[2366] No, write what we have ADDI P1,.LMS ;[2366] Got a contiguous chunk, add more blocks JRST LCOUTM ;[2366] Do the next chunk ;[2366] Found the last chunk. Set P1 to reflect the correct ;[2366] number of blocks. LCOUTE: MOVEI P1,1(T2) ;[2366] Highest block to write SUB P1,T1 ;[2366] Minus lowest (for this time) ;[2366] Write the blocks. LCOUTF: MOVE T4,P1 ;[2366] Get the number of blocks IMULI T4,-.DBS ;[2366] Make it negative words MOVE P2,T1 ;[2366] Get back the start LSH P2,.DBS2W ;[2366] In words SUB P2,LW.LC ;[2366] Minus window start (may not be origin) ADD P2,LC.LB ;[2366] Fix in core SUBI P2,1 ;[2366] IOWD is one less HRL P2,T4 ;[2366] Left half is -count SETZ P3, ;[2366] Terminate list OUT CHAN,P2 ;[2366] Dump block CAIA ;[2366] It worked JRST E$$OLC ;[2366] It failed ADDI P4,-1(P1) ;[2366] Get last block written CAMLE P4,LC.UP ;[2366] Largest physical block written? MOVEM P4,LC.UP ;[2366] Yes, remember it ADD T1,P1 ;[2366] Account for blocks written CAMG T1,T2 ;[2366] All done? JRST LCOUTL ;[2366] No, do some more SPOP ;[2366] Restore the acs >;[2366] IFIDN LC IFDIF <%AREA>,< ;[2366] FOR NON-LC AREA MOVE T3,T1 ;[2330] GET FIRST ADDRESS LSH T3,-.DBS2W ;[2330] INTO 128 WORD BLOCKS USETO CHAN,1(T3) ;[2330] SET ON BLOCK (0 ADDRESS IS IN BLOCK 1) MOVE T3,T1 ;FROM SUB T3,T2 ;[2330] -TO = -LENGTH SUBI T3,1 ;[2330] CORRECT COUNT MOVE T2,T1 ;FROM SUB T2,LW.'WD ;MINUS WINDOW START (MAY NOT BE ORIGIN) ADD T2,%AREA'.LB ;FIX IN CORE SUBI T2,1 ;IOWD IS ONE LESS HRL T2,T3 ;LEFT HALF IS -COUNT SETZ T3, ;TERMINATE LIST OUT CHAN,T2 ;DUMP BLOCK >;[2366] IFDIF LC POPJ P, ;OK E$$O'%AREA::PUSH P,[CHAN] ;[1174] STACK ERROR CHAN .ERR. (ST,0,V%L,L%F,S%F,O'%AREA,) > > ;[1401] END IFE TOP20 SUBTTL DISK OVERFLOW ROUTINES -- OUTPUT -- TOPS20 ;[2202] CALLED BY ;[2202] MOVE T1, ;[2202] MOVE T2, ;[2202] PUSHJ P,LC.OUT/HC.OUT/LS.OUT ;[2202] USES T1, T2, T3, T4 IFN TOPS20,< DEFINE PAGOUT (%AREA,CHAN,WD)< %AREA'.OUT:: MOVEI T4,%AREA'.IX ;[2202] CHANNEL INFO PUSHJ P,OVF.OU ;[1426] DO THE I/O POPJ P, E$$O'%AREA:: PUSHJ P,JSERR## ;[2264] SET UP THE JSYS ERROR ..FORK==0 ;[2247] ASSUME NOT TO FORK IFIDN <%AREA>,,<..FORK==1> ;[2247] FORK IF LC AREA IFIDN <%AREA>,,<..FORK==1> ;[2247] FORK IF HC AREA .ERR. (MS,.EC,V%L,L%F,S%F,O'%AREA,) IFE ..FORK,< ;[2264] .ETC. (STR,.EC,,,,,< to file >) .ETC. (FSP,.EC,,,,'CHAN) ;[2301] >;[2247] IFE ..FORK .ETC. (NLN,.EC) ;[2264] NEW LINE FOR ERROR TEXT .ETC. (STR,,,,,ERRJSY) ;[2264] TYPE ERSTR% TEXT > ;[1426] END PAGOUT OVF.OU: OVFOU0: CAML T1,T2 ;[2247] UPPER LESS THAN LOWER? POPJ P, ;[2247] YES, DON'T DO ANYTHING PUSH P,T2 ;[2202] -1(P): LAST PUSH P,T1 ;[2202] 0(P): FIRST MOVE T1,TB.CHN(T4) ;[2202] T1: CHANNEL SKIPN T1,CHAN.JF(T1) ;[2202] JFN? JRST @TB.OER(T4) ;[2202] GIVE THE ERROR CAMG T2,TAB.HB(T4) ;[2202] BIGGER THAN WHAT WE HAVE? JRST OVFOU1 ;[1401] NO, CONTINUE. EXCH T2,TAB.HB(T4) ;[2202] SWAP OLD BOUND FOR NEW JUMPN T2,OVFOU1 ;[2202] IF WE'RE STARTING UP A NON-0 SECTION MOVE T2,0(P) ;[2202] T2: FIRST ADDR OF DEST LSH T2,-9 ;[1401] T2: FIRST PAGE OF DEST MOVE T3,-1(P) ;[2202] T3: LAST ADDR LSH T3,-9 ;[1401] T3: LAST PAGE SUBI T3,-1(T2) ;[2202] T3: PAGE COUNT. NOTE THAT ;[2202] (FIRST-LAST)+1 = FIRST-(LAST-1) TXO T3, ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS HRL T2,T1 ;[1401] T2: JFN,,FIRST PAGE MOVE T1,0(P) ;[2202] LOWER BOUND OF BLOCK SUB T1,TAB.LW(T4) ;[2202] MINUS WINDOW START (MAY NOT BE ORIGIN) ADD T1,TAB.LB(T4) ;[2202] FIX IN CORE LSH T1,-9 ;[1401] RELOCATE TO REAL PAGE HRLI T1,.FHSLF ;[1401] T1: SELF,,SOURCE PAGE PMAP% ;[1401] OUT THEY GO ERCAL PMAPER ;[2023] TRY EXPUNGE IF QUOTA EXCEEDED OVFOU1: MOVE T2,0(P) ;[2202] T2: First addr of dest MOVE T3,-1(P) ;[2202] T3: Last addr SUB T3,T2 ;[2202] T3: Number of words LSH T3,-9 ;[2202] T3: Number of pages ADDI T3,1 ;[2302] T3: Size of area TXO T3,PM%CNT ;[2302] SET COUNT SUB T2,TAB.LW(T4) ;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN) ADD T2,TAB.LB(T4) ;[1401] FIX IN CORE LSH T2,-9 ;[1401] RELOCATE TO REAL PAGE HRLI T2,.FHSLF ;[1401] T2: SELF,,SOURCE PAGE SETOM T1 ;[1401] UNMAP PMAP% ;[1401] OUT THEY GO ERCAL @TB.OER(T4) ;[1426] GIVE THE ERROR POP P,T1 ;[2202] LOWER BOUND POP P,T2 ;[2202] UPPER BOUND POPJ P, ;[1401] NORMAL RETURN ;This routine expunges the directory if a PMAP fails with a Quota Exceeded ;violation PMAPER: DMOVEM T1,CRTMP1 ;[2024] Save AC's from PMAP% MOVEM T3,CRTMP3 ;[2024] in CRTMP1-3 MOVEI T1,.FHSLF ;[2024] This process GETER% ;[2024] Get last error ERJMP @TB.OER(T4) ;[2202] HRRZS T2 ;[2024] Just the error number CAIE T2,IOX11 ;[2024] Is it Quota Exceeded error? JRST @TB.OER(T4) ;[2215] No - just give error PUSHJ P,EXPNG ;[2024] Yes - Try expunging the directory POPJ P, ;[2024] Return to PMAPER caller EXPNG:: PUSH P,T4 HLRZ T2,CRTMP2 ;[2024] Get the JFN SETZB T1,T3 ;[2024] No flags - no directory groups RCDIR% ;[2024] Just get the directory number ERJMP BADRET MOVE T2,T3 ;[2024] Directory number to T2 DELDF% ;[2024] Expunge the directory ERJMP BADRET SETZ T3, ;[2024] Zero T3 MOVE T1,CRTMP2 ;[2024] Destination to T1 HRRZ T4,CRTMP3 ;[2024] Number of pages attempted MAPPAG: HRRZ T2,CRTMP2 ;[2024] Starting page of destination ADD T2,T3 ;[2024] Calculate page to check for HRR T1,T2 ;[2024] That page to T1 RPACS% ;[2024] Get access bits for that page ERJMP BADRET ;[2024] TXNN T2,PA%PEX ;[2024] Does that page exist? JRST NOPAGE ;[2024] No AOS T3 ;[2024] Yes - increment count SOJG T4,MAPPAG ;[2024] Check the next page JRST BADRET NOPAGE: DMOVE T1,CRTMP1 ;[2024] Restore PMAP% source and destination ADD T1,T3 ;[2024] Page number of source to start from ADD T2,T3 ;[2024] Page number of destination to start at MOVE T3,CRTMP3 ;[2024] Flag bits for PMAP% HRR T3,T4 ;[2024] Count of pages left to map PMAP% ;[2024] Try again ERJMP BADRET ;[2024] Failed again give up and go home POP P,T4 POPJ P, ;[2024] Success - pop,pop home and go on BADRET: POP P,T4 AOS (P) ;[2024] Skip return for failures POPJ P, DEFINE XXX(%AREA)< ;;[1230] DEFINE ERROR MESSAGE ADDRS IFDEF %AREA'.OUT,< ;;[2264] IF OVERFLOW ROUTINE EXISTS EXP E$$O'%AREA ;[1230] ERROR WITH %AREA FILE > IFNDEF %AREA'.OUT,< ;;[2264] IF NO OVERFLOW ROUTINE EXISTS EXP [HALT] ;[1230] %AREA AREA DOES NOT PAGE > > XALL ;[1230] TB.OER: AREAS ;[1230] GENERATE ERROR MESSAGE ADDRS SALL ;[1230] > ;[1401] END IFN TOP20 XALL ;LOW SEGMENT PAGOUT (LC,LC,S1) ;HIGH SEGMENT PAGOUT (HC,HC,S2) ;SYMBOL TABLE PAGOUT (LS,SC,LS) ;ALGOL SYMBOLS PAGOUT (AS,AC,AS) ;ARGUMENT TYPECHECKING [2270] PAGOUT (TP,PC,TP) ;[2270] SALL SUBTTL DISK OVERFLOW ROUTINES -- INPUT -- TOPS10 ;CALLED BY ; MOVE T1,[FIRST,,LAST ADDRESS TO INPUT] ; PUSHJ P,LC.IN/HC.IN/LS.IN ;USES T1, T2, T3 IFE TOPS20,< DEFINE PAGIN (%AREA,CHAN,WD,FIXUP,%OK)< %AREA'.IN:: IFIDN <%AREA>,< ;[2366] Special if LC area CAMLE T2,HB.LC ;[2366] Bigger than what we have? MOVEM T2,HB.LC ;[2366] Yes, reset highest ;[2366] Build byte pointer to the map. Point at the first page ;[2366] to read. SPUSH ;[2366] Need lots of acs LSH T1,-.DBS2W ;[2366] From address into 128 word blocks LSH T2,-.DBS2W ;[2366] To address into 128 word blocks MOVE T3,T1 ;[2366] Get the from address LSH T3,-.LMS2D ;[2366] Make index into map ADJBP T3,[POINT 18,LC.MAP,17] ;[2366] Find the offset into the entry ;[2366] Get the next disk block LCINL: LDB T4,T3 ;[2366] Get the window base block JUMPN T4,LCINN ;[2366] Check for non-zero ;[2366] Found a zero entry. Zero memory as necessary, disk space will ;[2366] be allocated when the pages are written. The disk pages are ;[2366] not allocated here because the .EXE file writer sometimes tries ;[2366] to read in much more than it needs. MOVE P1,T1 ;[2366] Get the from block LSH P1,.DBS2W ;[2366] In words SUB P1,LW.LC ;[2366] Minus window start (may not be origin) ADD P1,LC.LB ;[2366] Fix in core TRO T1,.LMM ;[2366] End of this area MOVE P2,T1 ;[2366] Get the from block CAML P2,T2 ;[2366] Beyond what's wanted? MOVE P2,T2 ;[2366] Yes, use top wanted LSH P2,.DBS2W ;[2366] In words TRO P2,.DBM ;[2366] At top of page SUB P2,LW.LC ;[2366] Minus window start (may not be origin) ADD P2,LC.LB ;[2366] Fix in core SETZM (P1) ;[2366] Zero the first word HRLS P1 ;[2366] Build BLT word ADDI P1,1 ;[2366] As from,,to BLT P1,(P2) ;[2366] Zero memory IBP T3 ;[2366] Go to the next block AOJA T1,LCINZ ;[2366] Do next area ;[2366] Found an index. Add the offset. LCINN: MOVE P1,T1 ;[2366] Get the from block ANDI P1,.LMM ;[2366] Get the offset part MOVE P2,T4 ;[2366] Get the index base ADD T4,P1 ;[2366] Get the actual disk block MOVE P4,T4 ;[2366] Remember initial block ;[2366] Loop looking for contiguous blocks. Stop when there is ;[2366] either no contiguous block, or when the last block needed ;[2366] is seen. ;[2366] P1 Contains the number of blocks to read ;[2366] P2 Contains the index base for the current block ;[2366] P3 Contains the block number to read SUBI P1,.LMS ;[2366] Get the number of blocks MOVN P1,P1 ;[2366] As a positive quantity MOVE P3,T1 ;[2366] Get a copy of the from block TRZ P3,.LMM ;[2366] Get beginning block for this index LCINM: ADDI P3,.LMS ;[2366] Beginning of next index CAML P3,T2 ;[2366] Need next index? JRST LCINE ;[2366] No ILDB T4,T3 ;[2366] Get the next block index ADDI P2,.LMS ;[2366] Increment the previous index CAMN P2,T4 ;[2366] Are they the same? CAIL P1,<<400000/.DBS>-.LMS> ;[2366] And IOWD below limit? JRST LCINF ;[2366] No, write what we have ADDI P1,.LMS ;[2366] Got a contiguous chunk, add more blocks JRST LCINM ;[2366] Do the next chunk ;[2366] Found the last chunk. Set P1 to reflect the correct ;[2366] number of blocks. LCINE: MOVEI P1,1(T2) ;[2366] Highest block to write SUB P1,T1 ;[2366] Minus lowest (for this time) ;[2366] Make sure the blocks exist in the overflow file ; LCINF: MOVE T4,P4 ;[2366] Get the first block to read ADDI T4,-1(P1) ;[2366] Get the highest block to be read CAMG T4,LC.UP ;[2366] Higher than exists in file? JRST LCINR ;[2366] No, read the file USETO CHAN,1(T4) ;[2366] Create new blocks to read MOVEM T4,LC.UP ;[2366] Remember new highest block ;[2366] Read the blocks. LCINR: USETI CHAN,(P4) ;[2366] Set on block MOVE T4,P1 ;[2366] Get the number of blocks IMULI T4,-.DBS ;[2366] Make it negative words MOVE P2,T1 ;[2366] Get back the start LSH P2,.DBS2W ;[2366] In words SUB P2,LW.LC ;[2366] Minus window start (may not be origin) ADD P2,LC.LB ;[2366] Fix in core SUBI P2,1 ;[2366] Iowd is one less HRL P2,T4 ;[2366] Left half is -count SETZ P3, ;[2366] Terminate list IN CHAN,P2 ;[2366] Read block CAIA ;[2366] It worked JRST E$$ILC ;[2366] It failed ADD T1,P1 ;[2366] Account for blocks written LCINZ: CAMG T1,T2 ;[2366] All done? JRST LCINL ;[2366] No, do some more SPOP ;[2366] Restore the acs >;[2366] IFIDN LC IFDIF <%AREA>,< ;[2366] FOR NON-LC AREA MOVE T3,T2 ;[2330] GET LAST ADDRESS WE NEED CAMG T2,HB.'WD ;BIGGER THAN WHAT WE HAVE? JRST %OK ;NO MOVEM T2,HB.'WD ;YES, RESET HIGHEST LSH T3,-.DBS2W ;[2330] MUST DO USETO TO ZERO FILE ;SO WE WILL INPUT ZERO DATA USETO CHAN,2(T3) ;[2330] YES, GET THIS MUCH %OK:! MOVE T3,T1 ;[2330] GET FIRST ADDRESS LSH T3,-.DBS2W ;[2330] INTO 128 WORD BLOCKS USETI CHAN,1(T3) ;[2330] SET ON BLOCK (0 ADDRESS IS IN BLOCK 1) MOVE T3,T1 ;[2330] FROM SUB T3,T2 ;[2330] -TO = -LENGTH SUBI T3,1 ;[2330] CORRECT LENGTH MOVE T2,T1 ;[2330] FROM SUB T2,LW.'WD ;MINUS WINDOW START (MAY NOT BE ORIGIN) ADD T2,%AREA'.LB ;FIX IN CORE SUBI T2,1 ;IOWD IS ONE LESS HRL T2,T3 ;LEFT HALF IS -COUNT SETZ T3, ;TERMINATE LIST IN CHAN,T2 ;DUMP BLOCK >;[2366] IFDIF LC IFB ,< POPJ P, ;OK > IFNB ,< PJRST %AREA'.FXR ;DO ANY FIXUPS REQUIRED > E$$I'%AREA::PUSH P,[CHAN] ;[1174] SAVE ERROR CHAN .ERR. (ST,0,V%L,L%F,S%F,I'%AREA,) > > ;[1401] END IFE TOPS20 SUBTTL DISK OVERFLOW -- INPUT -- TOPS20 ;[2202] CALLED BY ;[2202] MOVE T1, ;[2202] MOVE T2, ;[2202] PUSHJ P,LC.IN/HC.IN/LS.IN ;[2202] USES T1, T2, T3, T4 IFN TOPS20,< DEFINE PAGIN (%AREA,CHAN,WD,FIXUP)< %AREA'.IN:: MOVEI T4,%AREA'.IX ;[2202] CHANNEL INFO PUSHJ P,OVF.IN ;[1426] DO THE I/O IFB ,< POPJ P, ;[1401] OK > IFNB ,< PJRST %AREA'.FXR ;[1401] DO ANY FIXUPS REQUIRED > E$$I'%AREA:: PUSHJ P,JSERR## ;[2264] SET UP THE JSYS ERROR ..FORK==0 ;[2247] ASSUME NOT TO FORK IFIDN <%AREA>,,<..FORK==1> ;[2247] FORK IF LC AREA IFIDN <%AREA>,,<..FORK==1> ;[2247] FORK IF HC AREA .ERR. (MS,.EC,V%L,L%F,S%F,I'%AREA,) IFE ..FORK,< ;[2264] .ETC. (STR,.EC,,,,,< from file >) .ETC. (FSP,.EC,,,,'CHAN) ;[2301] >;[2247] IFE ..FORK .ETC. (NLN,.EC) ;[2264] NEW LINE FOR ERROR TEXT .ETC. (STR,,,,,ERRJSY) ;[2264] TYPE ERSTR% TEXT POPJ P, > ;[1426] END PAGIN OVF.IN: PUSH P,P1 ;[1426] SAVE REGISTER PUSH P,T2 ;[2202] -1(P): LAST PUSH P,T1 ;[2202] 0(P): FIRST CAIE T4,LC.IX ;[2202] LOW SEGMENT? CAIN T4,HC.IX ;[2247] OR HIGH SEGMENT? CAIA ;[2247] YES, MUST CHECK SECTIONS JRST OVFIN1 ;[2202] NO MOVE P1,T1 ;[2247] GET THE LOWER BOUND PUSHJ P,NEWSCT ;[2202] MAKE SURE IT EXISTS MOVE P1,-1(P) ;[2247] GET THE UPPER BOUND PUSHJ P,NEWSCT ;[2202] MAKE SURE IT EXISTS OVFIN1: MOVE T1,TB.CHN(T4) ;[2202] GET THE CHANNEL SKIPN T1,CHAN.JF(T1) ;[2202] JFN? JRST @TB.IER(T4) ;[2202] GIVE THE ERROR HRLS T1 ;[1401] JFN IN RH MOVE T2,0(P) ;[2202] T2: FIRST ADDRESS CAIE T4,HC.IX ;[2321] HIGH SEGMENT? JRST OVFIN2 ;[2321] NO, LOW SEGMENT HRRZ T3,LL.S2 ;[2321] YES, GET OFFSET INTO FILE ADD T2,T3 ;[2321] ADD IT OVFIN2: LSH T2,-9 ;[2321] IN PAGES, PLEASE HRR T1,T2 ;[1401] JFN,,FILE PAGE MOVE T3,-1(P) ;[2202] GET LAST ADDRESS CAMLE T3,TAB.HB(T4) ;[2202] BIGGER THAN WHAT WE HAVE? MOVEM T3,TAB.HB(T4) ;[2202] YES, RESET HIGHEST SUB T3,0(P) ;[2247] T3:LAST-FIRST LSH T3,-9 ;[1401] IN PAGES ADDI T3,1 ;[2302] NUMBER OF PAGES TO MAP TXO T3, ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS MOVE T2,0(P) ;[2202] LOWER BOUND OF BLOCK SUB T2,TAB.LW(T4) ;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN) ADD T2,TAB.LB(T4) ;[1401] FIX IN CORE LSH T2,-9 ;[1401] IN PAGES HRLI T2,.FHSLF ;[1401] PROCESS IS SELF PMAP% ;[1401] MAP THESE PAGES ERCAL @TB.IER(T4) ;[2202] GIVE THE ERROR POP P,T1 ;[1401] CLEAN UP STACK POP P,T2 POP P,P1 POPJ P, ;[1426] AND RETURN NEWSCT:: ;[2242] PUSH P,T4 ;[2365] SAVE T4 HRRZ T2,LL.S0(T4) ;[2321] GET THE SEGMENT OFFSET ADD P1,T2 ;[2321] ADD IT HLRZS P1 ;[2247] GET THE SECTION NUMBER MOVN T2,P1 ;[2202] GET THE NEGATED SECTION NUMBER SKIPE OVERLW ;[2235] DOING OVERLAYS? JUMPN P1,E$$CBO ;[2235] YES, MUST BE DOING SECTION ZERO CAIN T4,HC.IX ;[2247] HIGH SEGMENT? JUMPN P1,E$$NHN## ;[2247] YES, MUST BE DOING SECTION ZERO HRLZI T1,400000 ;[1450] SET B0 LSH T1,(T2) ;[2213] B(N)=SECT(N) TDNE T1,FXSBIT ;[2200] THIS BIT SET IN ARRAY MAP WORD? JRST NEWSC1 ;[2365] YES, THE SECTION'S THERE ALREADY IORM T1,FXSBIT ;[1450] NO, SAY IT'S THERE PUSHJ P,E$$CRS ;[1450] SAY WE'RE CREATING THE SECTION JUMPE P1,NEWSC1 ;[2365] DON'T REALLY CREATE SECTION ZERO SETZM T1 ;[1450] CREATE THE SECTION HRRZ T2,P1 ;[1450] SPECIFY WHICH HRL T2,LC.JF ;[2247] AND WHERE MOVE T3,[SM%RD!SM%WR!SM%EX!1] ;[2202] CREATE ONE SECTION SMAP% ERCAL E$$CCS NEWSC1: POP P,T4 ;[2365] RESTORE T4 POPJ P, ;[1450] AND RETURN E$$CCS::.ERR. (MS,.EC,V%L,L%F,S%F,CCS,) ;[2202] .ETC. (OCT,.EP!.EC,,,,P1) ;[2264] .ETC. (JMP,,,,,.ETIMF##) ;[2264] Type the filename > ;[2301] END IFN TOPS20 E$$CBO::.ERR. (MS,,V%L,L%F,S%F,CBO,) ;[2235] DEFINE XXX(%AREA)< ;;[1230] DEFINE ERROR MESSAGE ADDRS IFDEF %AREA'.IN,< ;;[2264] IF OVERFLOW ROUTINE EXISTS EXP E$$I'%AREA ;[1230] ERROR WITH %AREA FILE > IFNDEF %AREA'.IN,< ;;[2264] IF NO OVERFLOW ROUTINE EXISTS EXP [HALT] ;[1230] %AREA AREA DOES NOT PAGE > > XALL ;[1230] TB.IER: AREAS ;[1230] GENERATE ERROR MESSAGE ADDRS SALL ;[1230] XALL ;LOW SEGMENT PAGIN (LC,LC,S1,) ;HIGH SEGMENT PAGIN (HC,HC,S2,) ;SYMBOL FILE PAGIN (LS,SC,LS,LS.FXR) ;ALGOL SYMBOLS PAGIN (AS,AC,AS,) ;ARGUMENT TYPECHECKING [2270] PAGIN (TP,PC,TP,) ;[2270] SALL ;TABLES OF XX.IN AND XX.OUT, INDEXED BY XX.IX DEFINE XXX(%AREA)< IFDEF %AREA'.IN,< EXP %AREA'.IN > IFNDEF %AREA'.IN,< EXP [HALT] >> XALL TB.IN:: AREAS DEFINE XXX(%AREA)< IFDEF %AREA'.OUT,< EXP %AREA'.OUT > IFNDEF %AREA'.OUT,< EXP [HALT] >> TB.OUT::AREAS SALL SUBTTL TABLES USED BY ??.DMP, INDEXED BY ??.IX DEFINE XXX(%AREA)< ;;[1230] DEFINE TEMP FILE NAMES IFDEF %AREA'.DMP,< EXP 'L'%AREA'' ;[1230] FOR nnn'%AREA'.TMP > IFNDEF %AREA'.DMP,< EXP 0 ;[1230] %AREA AREA DOES NOT PAGE > > XALL ;[1230] TB.NAM: AREAS ;[1230] GENERATE TEMP FILE NAMES SALL ;[1230] TB.CHN: EXP 0 ;[1230] DY AREA DOES NOT PAGE XWD 0,LC ;[1230] LC AREA CHANNELS XWD 0,HC ;[1230] HC AREA CHANNELS XWD %SC,AC ;[1230] AS AREA CHANNELS EXP 0 ;[1230] RT AREA DOES NOT PAGE XWD %SC,SC ;[1230] LS AREA CHANNELS EXP 0 ;[1230] FX AREA DOES NOT PAGE XWD 0,PC ;[2270] TP AREA CHANNELS EXP 0 ;[1230] BG AREA DOES NOT PAGE EXP 0 ;[1230] GS AREA DOES NOT PAGE DEFINE XXX(%AREA)< ;;[1230] DEFINE PAGING MESSAGE ADDRS IFDEF %AREA'.DMP,< EXP E$$P'%AREA ;[1230] PAGING AREA %AREA > IFNDEF %AREA'.DMP,< EXP [HALT] ;[1230] %AREA AREA DOES NOT PAGE > > XALL ;[1230] TB.PAG: AREAS ;[1230] GENERATE PAGING MESSAGE ADDRS SALL ;[1230] IFE TOPS20,< ;[2247] E$$PLC::.ERR. (MS,0,V%L,L%I,S%I,PLC,) ;[1230] POPJ P, ;[1230] RETURN E$$PHC::.ERR. (MS,0,V%L,L%I,S%I,PHC,) ;[1230] POPJ P, ;[1230] RETURN >;[2247] IFE TOPS20 E$$PLS::.ERR. (MS,0,V%L,L%I,S%I,PLS,) ;[1230] POPJ P, ;[1230] RETURN E$$PAS::.ERR. (MS,0,V%L,L%I,S%I,PAS,) ;[1230] POPJ P, ;[1230] RETURN E$$PTP::.ERR. (MS,0,V%L,L%I,S%I,PTP,) ;[2270] POPJ P, ;[2270] RETURN IFN TOPS20,< ;[2202] E$$CRS:: .ERR. (MS,.EC,V%L,L%I,S%I,CRS,) ;[1450] .ETC. (OCT,.EP,,,,P1) ;[1450] POPJ P, ;[1450] RETURN > ;[2202] IFN TOPS20 DEFINE XXX(%AREA)< ;;[1230] DEFINE ERROR MESSAGE ADDRS IFDEF %AREA'.DMP,< EXP E$$E'%AREA ;[1230] ERROR WITH %AREA FILE > IFNDEF %AREA'.DMP,< EXP [HALT] ;[1230] %AREA AREA DOES NOT PAGE > > XALL ;[1230] TB.ERR: AREAS ;[1230] GENERATE ERROR MESSAGE ADDRS SALL ;[1230] IFE TOPS20,< ;[2270] E$$ELC::PUSH P,[LC] ;[2051] INDICATE WHICH CHANNEL .ERR. (LRE,0,V%L,L%F,S%F,ELC,) E$$EHC::PUSH P,[HC] ;[2051] INDICATE WHICH CHANNEL .ERR. (LRE,0,V%L,L%F,S%F,EHC,) E$$ELS::PUSH P,[SC] ;[2051] INDICATE WHICH CHANNEL .ERR. (LRE,0,V%L,L%F,S%F,ELS,) E$$EAS::PUSH P,[AC] ;[2051] INDICATE WHICH CHANNEL .ERR. (LRE,0,V%L,L%F,S%F,EAS,) E$$ETP::PUSH P,[PC] ;[2270] INDICATE WHICH CHANNEL .ERR. (LRE,0,V%L,L%F,S%F,ETP,) ;[2270] >;[2301] IFE TOPS20 IFN TOPS20,< ;[2301] E$$ELS::PUSH P,[SC] ;[2301] INDICATE WHICH CHANNEL .ERR. (LRE,.EC,V%L,L%F,S%F,ELS,) ;[2301] .ETC. (NLN,.EC) ;[2301] CRLF .ETC. (STR,,,,,ERRJSY) ;[2301] Type error text E$$EAS::PUSH P,[AC] ;[2301] INDICATE WHICH CHANNEL .ERR. (LRE,.EC,V%L,L%F,S%F,EAS,) ;[2301] .ETC. (NLN,.EC) ;[2301] CRLF .ETC. (STR,,,,,ERRJSY) ;[2301] Type error text E$$ETP::PUSH P,[PC] ;[2301] INDICATE WHICH CHANNEL .ERR. (LRE,.EC,V%L,L%F,S%F,ETP,) ;[2301] .ETC. (NLN,.EC) ;[2301] CRLF .ETC. (STR,,,,,ERRJSY) ;[2301] Type error text >;[2301] IFN TOPS20 SUBTTL DUMP LOCAL SYMBOL AREAS (LS AND AS) WHEN MEMORY IS FULL LS.DMP::SPUSH ;[1230] SAVE SOME ACS MOVX R,LS.IX ;[1230] SET UP LS AREA INDEX PUSHJ P,LA.DMP ;[1230] COMMON CODE TO SET UP FILE JRST LARET ;[1230] DIDN'T NEED TO OVERFLOW--RETURN MOVE P1,TAB.AB(R) ;[1230] SIZE OF LS AREA SUB P1,TAB.LB(R) ;[1230] ALMOST ANYWAY IFE TOPS20,< SUBI P1,.IPS ;[1230] HIGHEST TO OUTPUT > ;[1401] SETZ T1, ;[2202] START AT ZERO MOVE T2,P1 ;[2202] GIVE BACK THIS MUCH PUSHJ P,@TB.OUT(R) ;[1230] GENERAL OUTPUT ROUTINE IFN TOPS20,< SUBI P1,.IPS ;[1401] KEEP ONE PAGE ADDI P1,1 ;[1401] LOWEST TO KEEP MOVEM P1,LW.S0(R) ;[1401] WILL BECOME WINDOW LOWER LIMIT MOVE T1,P1 ;[2202] BRING IT BACK PUSHJ P,@TB.IN(R) ;[1401] ... MOVE T1,TAB.AB(R) ;[1401] RESET ALLOCATION POINTER SUBM T1,TAB.PT(R) ;[1401] ... MOVE T1,TAB.LB(R) ;[1401] PICK UP LOWERBOUND ADDI T1,.IPS-1 ;[1401] RESET TAB.AB(R) TO NEW LIMITS MOVEM T1,TAB.AB(R) SUBM T1,TAB.PT(R) ;[1401] RESET LS.PT > ;[2202] IFN TOPS20 MOVE T1,P1 ;[1401] ADD T1,TAB.LB(R) ;[1230] ADD IN OFFSET IFE TOPS20,< ADDI P1,1 ;[1230] LOWEST TO KEEP FOR GBCK.L > ;[1401] IFE TOPS20 JRST LARET1 ;[1230] GIVE BACK FREED MEM AND RETURN TP.DMP::SPUSH ;[2270] SAVE SOME ACS MOVX R,TP.IX ;[2270] SET UP LS AREA INDEX PUSHJ P,LA.DMP ;[2270] COMMON CODE TO SET UP FILE JRST LARET ;[2270] DIDN'T NEED TO OVERFLOW--RETURN MOVE T2,TP.AB ;[2270] GET THE TOP SUB T2,TP.LB ;[2270] MINUS BOTTOM IS SIZE SETZ T1, ;[2270] START FROM THE BEGINNING PUSHJ P,TP.OUT ;[2270] WRITE IT ;**; At TP.DMP+8 and TP.DMP+9 Change TP.PT to TPPTR edit 2374 MOVEM T2,TPPTR ;[2374] SAVE THE ARGCHECKING POINTER AOS TPPTR ;[2374] START ON NEW PAGE MOVE T1,T2 ;[2270] GET THE SIZE LSH T1,-2 ;[2270] GET HALF OF THE AREA TRZ T1,.IPM ;[2270] AS BEGINNING OF A PAGE MOVEM T1,LW.TP ;[2270] STORE AS LOWER WINDOW MOVEM T2,UW.TP ;[2270] AND UPPER WINDOW PUSHJ P,TP.IN ;[2270] READ IT SUB T2,T1 ;[2270] SIZE OF AREA ADD T2,TP.LB ;[2270] HIGHEST LOC IN AREA MOVEM T2,TP.AB ;[2270] STORE IT JRST LARET2 ;[2270] DONE AS.DMP::SPUSH ;[1230] SAVE SOME ACS MOVX R,AS.IX ;[1230] SET UP AS AREA INDEX PUSHJ P,LA.DMP ;[1230] COMMON CODE TO SET UP FILE JRST LARET ;[1230] DIDN'T NEED TO OVERFLOW--RETURN MOVE P1,TAB.PT(R) ;[1230] FIGURE SIZE OF AS AREA SUB P1,TAB.LB(R) ;[1230] NOT COUNTING THAT ABOVE PT ANDCMI P1,.IPM ;[1230] FIND EXTRANEOUS BLOCKS SETZ T1, ;[2202] STARTING AT ZERO MOVE T2,P1 ;[2202] COPY SUBI T2,1 ;[2202] GET ADDR OF LAST TO OUTPUT PUSHJ P,@TB.OUT(R) ;[1230] WRITE OUT THE DATA MOVE T1,TAB.PT(R) ;[1230] GET FIRST PHYS PAGE TO KEEP ANDCMI T1,.IPM ;[1230] POINT TO 1ST WORD IN PAGE SUBI T1,1 ;[1230] WORD BEFORE IS HIGHEST TO RETURN ; JRST LARET1 ;[1230] FALL INTO IT LARET1: SETOM TAB.UW(R) ;[1230] SIGNAL PAGING BUT NO UPPER LIMIT IFE TOPS20,< MOVEM P1,TAB.LW(R) ;[1230] FIX WINDOW LOWER LIMIT PUSHJ P,GBCK.L ;[1230] GIVE IT AWAY > ;[1401] LARET2: PUSHJ P,GETIOM ;[2270] USE SOME OF NEW AREA FOR IO.EMG AOS -2(P) ;[1230] INDICATE SKIP RETURN LARET: SPOP ;[1230] COMMON RETURN--RESTORE ACS POPJ P, ;[1230] DONE LA.DMP::MOVE T1,TAB.AB(R) ;[1230] COMPUTE SIZE OF LS AREA SUB T1,TAB.LB(R) ;[1230] .. ANDCMI T1,.IPM ;[1230] BUT NOT LAST PAGE JUMPE T1,CPOPJ ;[1230] IF 1P, DON'T BOTHER PUSHJ P,@TB.PAG(R) ;[1230] GIVE OVERFLOW MESSAGE MOVE T1,IO.EMG ;[1230] ALLOCATE EMERG. AREA HRRZ T2,TB.CHN(R) ;[1230] FOR PROPER CHANNEL MOVEM T1,IO.PTR(T2) ;[1230] .. SETZM IO.EMG ;[1230] NOT FREE NOW (RESET LATER) MOVEI T2,.IODPR ;[1230] USE DUMP RECORDS MODE MOVEM T2,I.MOD(T1) ;[1230] .. MOVEI T2,LN.RIB-1 ;[1230] SIZE OF EXTENDED ENTER BLOCK MOVEM T2,I.RIB(T1) ;[1230] .. MOVE T2,JOBNUM ;[1230] BUILD nnnL?? FILE NAME HRR T2,TB.NAM(R) ;[1230] .. MOVEM T2,I.NAM(T1) ;[1230] .. MOVSI T2,'TMP' ;[1230] BUILD EXTENSION TOO MOVEM T2,I.EXT(T1) ;[1230] .. SETZM I.PRV(T1) ;[1230] STANDARD PROTECTION MOVE T2,TAB.AB(R) ;[1230] GET LENGTH OF AREA SUB T2,TAB.LB(R) ;[1230] .. LSH T2,-<.DBS2W-1> ;[1230] ASSUME THIS IS HALF OF IT MOVEM T2,I.EST(T1) ;[1230] AS GOOD A GUESS AS ANY OTHER SKIPLE T2,SYMFRM ;[1230] USER REQUESTING A SYMBOL FILE? CAME T2,[EXP $SYMALGOL,0,$SYMTRIPLET]-AS.IX(R) ;[1230] .. JRST LADMP1 ;[1230] NO--JUST OVERFLOW TO DSK:[-] HLRZ T1,TB.CHN(R) ;[1230] WRITING A SYMBOL FILE--TRY TO HRRZ T2,TB.CHN(R) ;[1230] WRITE OVERFLOW FILE THERE PUSHJ P,DVSUP.## ;[1230] .. PUSHJ P,@TB.ERR(R) ;[1230] CAN'T--GO PRINT ERROR AND DIE JRST CPOPJ1 ;[1230] DONE LADMP1: MOVX T2,'DSK ' ;[1230] WRITE OVERFLOW FILE TO DSK:[-] MOVEM T2,I.DEV(T1) ;[1230] .. SETZM I.RIB+.RBPPN(T1) ;[1230] .. HRRZ T1,TB.CHN(R) ;[1230] OVERFLOW AREA ON PROPER CHANNEL PUSHJ P,DVUPD.## ;[1230] .. PUSHJ P,@TB.ERR(R) ;[1230] CAN'T--GO PRINT ERROR AND DIE JRST CPOPJ1 ;[1230] DONE SUBTTL DUMP LOW/HIGH SEG DATA WHEN CORE IS FULL IFE TOPS20,< ;[2247] ;HERE FOR LOW SEG LC.DMP::PUSH P,R ;[1230] SAVE R MOVEI R,LC.IX ;INDEX FOR LOW JRST LH.DMP ;GO DUMP IT ;HERE FOR HIGH SEG HC.DMP::PUSH P,R ;[1230] SET UP INDEX FOR HC AREA MOVEI R,HC.IX ;FALL INTO LH.DMP ;HERE TO DUMP EITHER LOW OR HIGH ;ENTER WITH R=LC.IX OR HC.IX LH.DMP: PUSHJ P,@TB.PAG(R) ;[1230] PRINT OVERFLOW MESSAGE MOVE T1,IO.EMG ;[604] GET TEMP SPACE HRRZ T2,TB.CHN(R) ;[1230] FOR PROPER CHANNEL MOVEM T1,IO.PTR(T2) ;[1230] .. SETZM IO.EMG ;NOT FREE NOW (RESET LATER) MOVSI T2,'DSK' ;[1230] PUT OVERFLOW FILE ON DSK:[-] MOVEM T2,I.DEV(T1) ;[1230] .. MOVEI T2,.IODPR ;USE MODE 16 MOVEM T2,I.MOD(T1) MOVEI T2,LN.RIB-1 ;SIZE OF EXTENDED ENTER BLOCK MOVEM T2,I.RIB(T1) MOVE T2,JOBNUM ;GET SIXBIT JOB NUMBER HRR T2,TB.NAM(R) ;[1230] .. MOVEM T2,I.NAM(T1) ;TO FORM TEMP NAME MOVSI T2,'TMP' MOVEM T2,I.EXT(T1) SETZM I.PRV(T1) ;[1230] STANDARD PROTECTION MOVE T2,HL.S0(R) ;GET HIGHEST LOC LOADED LSH T2,-<.DBS2W-1> ;[650] 2* NUMBER OF 128 WORDS MOVEM T2,I.EST(T1) ;GOOD GUESS? HRRZ T1,TB.CHN(R) ;[1230] GET CHANNEL FOR OVERFLOW FILE PUSHJ P,DVUPD.## ;UPDATE MODE PUSHJ P,@TB.ERR(R) ;[1230] CAN'T--GO PRINT ERROR AND DIE ;NOW FOR OUTPUT, SETUP IOWD FOR DATA TO BE OUTPUT ;AND GET RID OF AREA LHDMP2: MOVE T1,TAB.AB(R) ;SEE HOW LONG A BUFFER WE USED SUB T1,TAB.LB(R) ;THIS IS LENGTH MOVEM T1,UW.S0(R) ;THIS IS THE UPPER WINDOW BOUND MOVEI T2,1(T1) ;MAKE INTO 128 WORDS & LSH T2,-<1+.IPS2W> ;[650] CUT IN HALF LSH T2,.IPS2W ;[650] BUT KEEP IN 128 WORD CHUNKS CAIGE T2,.IPS ;[1104] IN CASE 1/2 IS .LT. 1 PAGE, MOVEI T2,.IPS ;[1104] DUMP ONE PAGE TO MARK PAGING SUBI T1,-1(T2) ;GET NEW BOTTOM WINDOW BOUND PUSH P,T1 ;SAVE IT SKIPN T1 ;IF SEG IS ONLY 1 BLOCK MOVEI T1,.IPS ;[2366] OUTPUT IT TO MARK PAGING HRRZI T2,-1(T1) ;[2202] UPPER WINDOW (ALWAYS UNDER ONE SECTION) SETZ T1, ;[2202] START AT ZERO PUSHJ P,@[EXP LC.OUT,HC.OUT]-1(R) POP P,T1 ;RECOVER LOWEST ADDRESS NOT OUTPUT JUMPE T1,LHSET1 ;[1751] SPECIAL IF BASE STILL 0 MOVEM T1,LW.S0(R) ;SET IT ADD T1,TAB.LB(R) ;BOTTOM IN REAL CORE SUBI T1,1 ;[650] SET FOR GBCK.L PUSHJ P,GBCK.L ;RETURN FREE SPACE LHSET1: PUSHJ P,GETIOM ;RESET IO.EMG PUSHJ P,LNKCON ;TRY AGAIN, IN CASE ORIG CALL WAS FOR CAIA ;THIS AREA (NEED TO UPDATE UW CORRECTLY) AOS -1(P) ;PRESERVE LNKCOR RETURN MOVE T1,TAB.AB(R) ;ACTUAL TOP SUB T1,TAB.LB(R) ;LENGTH -1 ADD T1,LW.S0(R) ;NEW TOP MOVEM T1,UW.S0(R) POP P,R ;RESTORE POPJ P, ;RETURN TO LNKCOR CALLER > ;[1755] IFE TOPS20 SUBTTL FIXUPS ;HERE TO SEE IF ANY SYMBOL FIXUP HAVE TO BE DONE FOR THIS WINDOW ;CHECK CURRENT LW.LS-UW.LS AGAINST ENTRIES IN FXP.LS ;FORMAT OF FXP.LS IS ; PTR TO LAST,,PTR TO FIRST ;USES T1, T2, T3 LS.FXR:: SKIPN FS.SS ;ANY FIXUPS TO DO? POPJ P, ;NO, JUST RETURN PUSH P,R ;MUST SAVE R INCASE FROM LNKXIT PUSH P,[0] ;[2200] LOWER ADDRESS TO OUTPUT PUSH P,[0] ;[2200] UPPER ADDRESS TO OUTPUT PUSHJ P,SYMCHN ;SEE IF ANY FIXUPS FOR THIS AREA POP P,T2 ;[2200] GET BACK UPPER POP P,T1 ;[2200] GET BACK LOWER POP P,R ;SAFE TO RESTORE R NOW IFE TOPS20,< JUMPE T1,CPOPJ ;NO FIXUPS DONE TRZ T1,.IPM ;[2202] MAKE INTO TRUE OUTPUT PTR IORI T2,.IPM ;[2202] POINT TO END OF BLOCK PJRST LS.OUT ;OUTPUT AND RET > ;[1401] IFE TOPS20 IFN TOPS20,< POPJ P, ;[1401] RETURN > ;[1401] IFN TOPS20 ;GETIOM - GET SPACE FOR IO.EMG AND RESERVE IT ;CALLED BY ; PUSHJ P,GETIOM ;USES T1, T2 GETIOM: MOVEI T2,LN.IO ;SPACE WE NEED PUSHJ P,DY.GET ;GET IT MOVEM T1,IO.EMG POPJ P, ;CHKSYM - SEE IF ANY FIXUPS EXIST FOR THE NEW SYMBOL WINDOW ;IF SO LINK THEM INTO FXT.S0 ;AND DO THEM ;USES T1-T4 SYMCHN: SETZM FXT.S0 ;CLEAR TEMP PTR HRRZ T1,FS.SS ;GET PTR TO LOWEST ADD T1,FX.LB ;+OFFSET LDB T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS ADDI T2,.L-1 ;MAKE SURE LAST WORD IN CORE HLRZ T1,FS.SS ;PTR TO HIGHEST ADD T1,FX.LB ;+OFFSET LDB T3,[ADDRESS 1(T1)] ;[2200] 30 BIT ADDRESS CAMG T2,UW.LS ;IS LOWEST ADDRESS TOO HIGH? CAMGE T3,LW.LS ;OR HIGHEST TOO LOW? POPJ P, ;YES, JUST GIVE UP ;MAKE QUICK TEST INCASE ALL IN CORE ;IN WHICH CASE WE NEED NOT CHASE CHAIN SUBI T2,.L-1 ;ACCOUNT FOR ALL 3 WORDS ADDI T3,.L-1 ;IN ALL CHECKS CAML T2,LW.LS ;IS LOWEST ADDRESS .GT. LOW WINDOW? CAMLE T3,UW.LS ;AND HIGHEST ADDRESS .LE. HIGH WINDOW JRST .+5 ;NO, DO THE SLOW WAY MOVE T1,FS.SS ;GET POINTER WORD MOVEM T1,FXT.S0 ;MOVE IT ALL OVER SETZM FS.SS ;REMOVE FROM LIST TO CONSIDER JRST FXSLP0 ;AND DO IT MOVEI T1,FS.SS ;GET INITIAL PTR ;START AT BACK SINCE MOST USUAL CASE ;IS TO READ FILE BACKWARDS CHKSYL: HLRZ T1,(T1) ;GET NEXT JUMPE T1,CPOPJ ;NOTHING TO DO ADD T1,FX.LB ;OFFSET LDB T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS ADDI T2,.L-1 ;ALL 3 WORDS MUST BE INCORE CAMLE T2,UW.LS ;INCORE? JRST CHKSYL ;NO, LOOP HRRZ T3,(T1) ;GET FORWARD LINK JUMPE T3,[MOVEI T3,FS.SS ;IF ZERO THIS IS TOP OF CHAIN JRST CHKSYM] ;SO WE CAN FIXUP HRL T3,T3 ;STORE UNRELOCATED IN LEFT HALF ADD T3,FX.LB ;RELOCATED IN RIGHT HLLZS (T1) ;CLEAR FORWARD PTR OF REMOVED PART CHKSYM: SUB T1,FX.LB ;-OFFSET MOVSM T1,FXT.S0 ;TEMP PTR TO HIGHEST TO DO ADD T1,FX.LB ;+OFFSET CHKSYH: HLRZ T1,(T1) ;GET NEXT JUMPE T1,[MOVEI T1,FS.SS ;GET FIRST IF JRST SYMFIN] ;REACHED END OF CHAIN ADD T1,FX.LB ;+OFFSET LDB T2,[ADDRESS 1(T1)] ;[2200] ADDRESS CAML T2,LW.LS ;STILL IN CORE? JRST CHKSYH ;YES MOVE T2,T1 ;GET ABS ADDRESS SUB T2,FX.LB ;REMOVE OFFSET HRL T1,T2 ;STORE LINK IN LEFT HALF FOR LATER SYMFIN: HRRZ T2,(T1) ;GET 1ST FIXUP WE CAN DO HRRM T2,FXT.S0 ;STORE IN PTR ADD T2,FX.LB ;RELOCATE IN FIXUP BLOCK HRRZS (T2) ;AND CLEAR BACK LINK ;NOW CLOSE PTRS OVER HOLE HLRM T3,(T1) ;LINK TOP TO BOTTOM HLLM T1,(T3) ;AND BOTTOM TO TOP ;NOW TO EXECUTE THE FIXUPS FXSLP0: HRRZ T1,FXT.S0 ;GET FIRST ADDRESS ADD T1,FX.LB ;IN CORE LDB T1,[ADDRESS 1(T1)] ;[2200] GET SYMBOL ADDRESS (REL TO ORIGIN) MOVEM T1,-2(P) ;[2200] PUT LOW ADDRESS ON STACK INPLACE OF [0] HLRZ T1,FXT.S0 ;SAME FOR UPPER ADDRESS ADD T1,FX.LB LDB T1,[ADDRESS 1(T1)] ;[2200] GET SYMBOL ADDRESS ADDI T1,.L-1 ;FIXED UP ALL 3 WORDS MOVEM T1,-1(P) ;[2200] SAVE UPPER ADDRESS ON STACK FXSLUP: HRRZ T1,FXT.S0 ;GET NEXT PTR JUMPE T1,CPOPJ ;ALL DONE FOR THIS LIST .JDDT LNKCOR,FXSLUP,<> ;[632] ADD T1,FX.LB ;+OFFSET HRRZ T2,(T1) ;NEXT PTR HRRM T2,FXT.S0 ;STORED LDB T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS LDB T3,[HIGH6 1(T1)] ;[2200] AND INDEX FROM HIGH SIX BITS MOVE T4,2(T1) ;VALUE ADD T2,LS.LB ;ADD IN BASE SUB T2,LW.LS ;MINUS WINDOW BASE PUSHJ P,@SYMTAB(T3) ;GO TO RIGHT ROUTINE MOVEI T2,3 ;SIZE OF BLOCK PUSHJ P,FX.RET ;RESTORE NOW (INCASE REQUIRED AGAIN) JRST FXSLUP ;AND CONTINUE IFN DEBSW,< ;SET THE FOLLOWING LOCATION TO THE OFFSET FROM THE BEGINNING OF THE FX ;AREA OF THE FIRST WORD OF A FIXUP BLOCK THAT IS INTERESTING FOR ;DEBUGGING PURPOSES. LINK WILL HIT A BREAKPOINT WHEN THE FIXUP BLOCK ;IS PROCESSED, OR WHEN A NEW FIXUP IS STORED IN THAT BLOCK. $FIXUP::BLOCK 1 ;[632] PLACE FOR FX OFFSET FOR .JDDT > ;END IFN DEBSW DEFINE X (A)< EXP STF.'A > XALL SYMTAB: SFIXUPS SALL ;ENTER WITH :- ;T1 = ADDRESS OF FIXUP IN FX (FROM) ;T2 = ADDRESS OF FIXUP RECIPIENT IN LS (TO) ;T3 = INDEX (SCRATCH) ;T4 = VALUE OF FIXUP ;RELOCATABLE STF.RR:! ;[2214] ALL RELOCATABLE DISPATCH HERE STF.RL:! ;[2214] STF.RE:! ;[2214] STF.RF: PUSH P,T1 ;[2214] SAVE A SCRATCH AC MOVX T1,PS.REL ;GET 'I AM RELOCATABLE' BIT IORM T1,0(T2) ;MAKE SURE SET IN FLAG WORD POP P,T1 ;RESTORE SCRATCH AC SUBI T3,<_<-^D30>> ;[2200] CONVERT TO CORRESPONDING PJRST @SYMTAB(T3) ; ADDITIVE TYPE AND DISPATCH ;RIGHT HALF STF.AR: HRRZ T3,2(T2) ;GET CURRENT VALUE ADD T3,T4 ;ADD IN FIXUP HRRM T3,2(T2) ;PUT NEW VALUE BACK MOVX T3,PS.UDR ;WE CAN NOW TURN THIS FLAG OFF JRST STF.FL ;JOIN COMMON CODE ;LEFT HALF STF.AL: HLRZ T3,2(T2) ;GET CURRENT VALUE ADD T3,T4 ;ADD IN FIXUP HRLM T3,2(T2) ;PUT BACK NEW MOVX T3,PS.UDL ;LEFT HALF NOW DEFINED JRST STF.FL ;FULL WORD STF.AF: ADDM T4,2(T2) ;ADD IN FIXUP MOVX T3,PS.UDF ;FULLY DEFINED NOW JRST STF.FL ;[2214] FALL INTO COMMON CODE ;[2214] Thirty bit STF.AE: LDB T3,[ADDRESS 2(T2)] ;[2214] Get current value ADD T3,T4 ;[2214] Add in fixup DPB T3,[ADDRESS 2(T2)] ;[2214] Put back new value MOVX T3,PS.UDF ;[2214] Fully defined now ; JRST STF.FL ;[2214] Fall into common code ;FALL THROUGH TO NEXT PAGE ;HERE WITH T3 CONTAINING THE BITS WE'RE DEFINING. CLEAR IN LS AREA ;AND CHECK FOR POSSIBLE MULTIPLE DEFINITION IF GLOBAL. STF.FL: MOVX T4,PS.GLB ;CHECK GLOBAL DEFINITION, SINCE TDNN T4,0(T2) ;LOCALS CAN'T BE MULT. DEFINED JRST STF.LC ;LOCAL SYMBOL, NO PROBLEM ;**** TEMP CROCK TO AVOID HALT IF DOING FIXUPS WHILE SORTING SYMBOL ;**** TABLE LATE IN LNKXIT, AFTER LNKXIT HAS DELETED GS AREA. THE REAL ;**** SOLUTION IS TO HAVE LNKXIT KEEP THE GS AREA AROUND LONGER, BUT ;**** THAT SOLUTION IS FAR TOO COMPLEX TO IMPLEMENT AT THE PRESENT TIME, ;**** DUE TO LNKXIT'S HORRIBLE HABIT OF DOING CORE UUO'S AND REFERENCING ;**** .JBREL DIRECTLY (THE GS ARE WOULD BE OVERWRITTEN BY THE FX OR LS ;**** AREAS EVEN IF IT WASN'T DELETED). THIS SHOULD BE FIXED!!!! SKIPN GS.LB ;GS AREA EXIST? JRST STF.LC ;NO (**CROCK**) SKIP THIS CHECK ;**** END OF TEMP CROCK SPUSH ;SAVE THE WORLD TMOVE W1,0(T2) ;PICK UP THE SYMBOL WE NEED PUSHJ P,TRYSYM## ;GET THE REAL VALUE HALT . ;THEN WHY IS IT IN THE LS AREA? JFCL ;DOESN'T MATTER IF UNDEFINED SPOP ;RESTORE DEFINING BITS AND LS PTR MOVE W1,0(P1) ;PICKUP REAL FLAGS FROM GLOBALS TXNN W1,PS.UDF!PS.REQ ;SYMBOL COMPLETELY DEFINED? JRST STF.PV ;YES, P2 POINTS TO REAL VALUE TXNN W1,PT.EXT ;NO, MUST GET PART VALUE FROM PVS JRST STF.GU ;NO PVS, GIVE UP STF.NX: ADDI P1,.L ;ADVANCE TO NEXT TRIPLET SKIPG P2,0(P1) ;PICK UP SECONDARY FLAGS JRST STF.GU ;PRIMARY HERE?? GIVE UP! TXNE P2,S.PVS ;IS THIS THE ONE WE'RE LOOKING FOR JRST STF.PV ;YES, GO COMPARE VALUES TXNN P2,S.LST ;NO, BUT ARE THERE MORE TRIPLETS? JRST STF.NX ;YES, GO EXAMINE THEM JRST STF.GU ;NO, NOT MULTIPLY DEFINED AT ALL ;HERE WITH THE ABS ADDR OF THE PVS TRIPLET ON THE GLOBAL SYMBOL IN ;P2. THIS SYMBOL MUST BE MULTIPLY DEFINED IF FULLY DEFINED AND A PVS ;TRIPLET STILL EXISTS, BUT CHECK VALUES ANYWAY IN CASE NOT FULLY DEFINED ;(/MAP:NOW OR AN UNDEFINED GLOBAL) SO MAP WILL BE CORRECT. STF.PV: MOVE T4,2(T2) ;GET THE NEW VALUE WE JUST FOUND TXNE T3,PS.UDR ;NOT DEFINING RH? TXNE W1,PS.UDR ;OR IS RH UNKNOWN? HRR T4,2(P1) ;YES, CAN'T POSSIBLY BE CONFICTING TXNE T3,PS.UDL ;SAME LOGIC FOR LH TXNE W1,PS.UDL ;.. HLL T4,2(P1) ;T4 NOW DIFFERENT IF MULT. DEF. CAMN T4,2(P1) ;IS IT? TDZA T4,T4 ;NO, CLEAR T4 MOVX T4,PS.MDF ;YES, FLAG AS MULTIPLY DEFINED IORM T4,0(T2) ;SET PS.MDF IF NEEDED STF.GU: SPOP ;RESTORE THE WORLD STF.LC: ANDCAB T3,0(T2) ;CLEAR ALL UNDEF BITS JUST DEFINED TXNE T3,PS.UDF ;IF SYMBOL IS NOW FULLY DEFINED POPJ P, ;NO, WAIT SOME MORE MOVX T3,PS.REQ ;WE CAN TURN OFF THE REQUEST BIT ANDCAM T3,0(T2) POPJ P, ;HERE TO FIXUP NAME STUFF IN TITLE BLOCK STF.TL: MOVE T3,0(T2) ;GET FLAGS TXNN T3,PT.TTL ;BETTER BE A TITLE JRST BADSTF ;IT'S NOT, REPORT ERROR MOVEM T4,2(2) ;[2254] STORE POINTER BACK POPJ P, ;HERE TO FIXUP SEG STUFF IN TITLE BLOCK STF.SG: SKIPL T3,0(T2) ;GET FLAGS TXNN T3,S.SEG ;LOOK FOR SEGMENT STUFF JRST BADSTF ;REPORT ERROR SKIPN T4 ;[2254] DID USER PROGRAM HAVE THIS SEG? SETZB T4,1(T2) ;[2254] NO, CLEAR LENGTH WORD MOVEM T4,2(T2) ;[2254] YES, STORE BACK POPJ P, ;HERE TO FIXUP SEGMENT ORIGINS IN TITLE BLOCK STF.SL: SKIPL T3,(T2) ;CHECK SECONDARY TRIPLET TXNN T3,S.SEG ;THAT DESCRIBES SEGMENT DATA JRST BADSTF ;REPORT THE ERROR MOVEM T4,1(T2) ;[2254] OTHERWISE, STORE NEW VALUE POPJ P, ;DONE ;HERE ON A BAD TRIPLET BADSTF: PUSH P,T1 ;NEED T1 FOR CONTINUE ATTEMPT E$$SFU::.ERR. (MS,0,V%L,L%W,S%W,SFU,) ;[1174] OUCH! POP P,T1 ;RECOVER FIXUP POINTER POPJ P, ;TRY TO CONTINUE E$$MMF::.ERR. (MS,0,V%L,L%F,S%F,MMF,) ;[2202] CORLIT: END