/LNKALL - LINK MEMORY ALLOCATOR / / / / / / / / / /COPYRIGHT (C) 1977,1978 BY DIGITAL EQUIPMENT CORPORATION / / / / / / / / / / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. / /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. / /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY /DIGITAL. / / / / / / / / / / /LINK ALLOCATION MODULE XLIST NOPUNCH .INCLUDE LNKMAN.MA ENPUNCH XLIST .RSECT LNKALL .ENTRY YIAL1 YIAL1, DOPIC, CLA CMA /NOW TO CREATE A PICTURE DCA I (CIMAGE /OF CORE JMS WRICIM /INITIALIZE ALL CIMAGES JMS WRCIM1 JMS WRCIM2 CMA DCA HFICP /SET HIGHEST FIELD IN CORE PICTURE TO -1 JMS CPIC /CREATES A CORE IMAGE IN CIMAGE 1 /HIGHEST FLD IN PIC. E11==.; JMS I COS8ER /ERROR JMS SCI /SORT CIMAGE JMS ALLOC /ALLOCATE CORE JMS MAKLHR /MAKE LAST ENTRY TAD OVRCNT SNA /OVERLAY COUNT =0? JMP LSTXIT /YES CIA /NO, STORE AS - DCA OVRCNT TAD LOWAA /LOWAA CONTAINS LENGTH OF OVERLAY ISZ OVRCNT /TIMES NUMBER OF OVERLAYS JMP .-2 TAD CURBLK /PLUS CURRENT BLOCK DCA CURBLK /EQUALS NUMBER OF BLOCKS IN FILE LSTXIT, JMP RETALL /GO TO RESOLVE GST, MAKE MAP .EXTERNAL RETALL / / / / UNABLE TO ALLOCATE SPACE TO A SECT / SO PUT IT AT THE TOP OF THE LIST / AND TRY AGAIN / FAIL1A, TAD HFICP /GET HIGHEST FIELD IN CORE PICTURE CIA TAD VCORE /COMPARE AGAINST HIGHEST FIELD ALLOWED SNA CLA /ALLOCATED ALL FIELDS TO CIMAGE? JMP .+3 /YES JMS NMCI /NO, ALLOCATE NEXT JMP TRYAGN-2 /TRY AGAIN ISZ RETRYC /INCR NO OF RETRIES SKP JMP NRERR /NO ROOM CDF 10 IAC TAD GINDEX /SEE IF ITS BEEN A FAILURE BEFORE DCA TEMP1 TAD I TEMP1 CLL RAR /FAILURE FLAG IS BIT 11 SNL CLA ISZ I TEMP1 /NO - FLAG IT JMS LFF /SORT FAILURES JMP NRERR /FIRST SECT FAILED FAIL1, TAD SOLIST /START IN SECTAB IAC DCA POINT1 HERE, TAD I POINT1 AND (3777 /GET RID OF ALLOCATION FLAGS DCA I POINT1 TAD I POINT1 /GET POINTER TO GST JMS I CCGSTA /COMPUTE GST ENTRY TAD (5 /COMPUTE FIELD WORD TAD GSTADR DCA GSTADR JMS I CPUTG /CLEAR FIELD WORD JMS I CPUTG /CLEAR ADDRESS WORD JMS I CPUTG /CLEAR OVERLAY-LEVEL WORD TAD (6 TAD POINT1 DCA POINT1 TAD POINT1 CIA TAD SECPTR SZA CLA JMP HERE /NEXT ENTRY JMS RDCIM2 /READ CIMAGE FROM IMAGE 2 JMP RETRY /TRY AGAIN FROM THE TOP / WRCIM2, 0 TAD WRCIM2 DCA WRCIM1 TAD (1000 SKP WRCIM1, 0 DCA RWPNT0 /SET UP POINTER 0 TAD (CIMAGE DCA RWPNT1 /SET UP POINTER 1 TAD (-1000 DCA RWCNT /SET UP COUNTER TAD I RWPNT1 /GET A WORD CDF 10 DCA I RWPNT0 /MOVE IT CDF ISZ RWPNT0 /BUMP POINTERS ISZ RWPNT1 ISZ RWCNT /DONE? JMP .-7 /NO JMP I WRCIM1 /YES RDCIM2, 0 TAD RDCIM2 DCA RDCIM1 TAD (1000 SKP RDCIM1, 0 DCA RWPNT0 /SET UP POINTER 0 TAD (CIMAGE DCA RWPNT1 /SET UP POINTER 1 TAD (-1000 DCA RWCNT /SET UP COUNTER CDF 10 TAD I RWPNT0 /GET A WORD CDF DCA I RWPNT1 /MOVE IT ISZ RWPNT0 /BUMP POINTERS ISZ RWPNT1 ISZ RWCNT /DONE? JMP .-7 /NO JMP I RDCIM1 /YES RWPNT0, 0 RWPNT1, 0 RWCNT, 0 PAGE E12==. BADTYP, JMS I COS8ER /BAD SYMBOL TYPE / /DISPATCH TABLE FOR TYPE OF SECT TYPTAB, FITR /A-SECT (2) RR /RELOCATABLE (3) F /FLOATING (4) D /DATA (5) BADTYP /NOT DEFINED (6) BADTYP /NOT DEFINED (7) X /X SECT (10) ZZ /Z SECT (11) / / / /DISPATCH SUBROUTINE FOR PUTCI DISCI, 0 ISZ PTR TAD I PTR DCA PTR1 JMS I PTR1 JMP I DISCI PTR, 0 PTR1, 0 /DISPATCH TABLE FOR DISCI CITAB, WRCIM1 RDCIM WRICIM RDCIM2 WRCIM2 RDCIM1 /HERE IF SECT FAILED TO ALLOCATE, CHECK IF DEPENDENT OR INDEPENDENT FAILUR, CLA /CLEAR AC TAD FIT TAD MOKRE1 SZA CLA /COME FROM DEPENDENT SECT ALLOCATION AREA? JMP FAIL1A /NO, NORMAL FAILURE TAD XR2 /YES TAD (-6 DCA XR2 /BACK UP POINTER TO INDEPENDENT SECT TAD XR2 IAC DCA POINT1 /SET UP POINTER TO INDEPENDENT SECT TAD CURENT JMS I CCGSTA /COMPUTE GST ADDRESS OF INDEPENDENT SECT TAD (5 TAD GSTADR JMS I CGGST /GET FIELD WORD FROM GST IAC DCA GINDEX /SAVE IT (+1) JMS I CPUTG /CLEAR FIELD WORD JMS I CPUTG /CLEAR ADDRESS WORD CDF 10 TAD I POINT1 AND (3777 DCA I POINT1 /DE-ALLOCATE INDEPENDENT SECT TAD SOLIST IAC DCA POINT1 /SET UP POINTER TO SCAN SECT TABLE FAIL0A, TAD POINT1 IAC DCA POINT2 /SET UP POINTER TO RESTRICTION BITS IN SECTAB TAD I POINT2 /GET RESTRICTION WORD RTL;RAL /3 LEFT SMA CLA /"SAME PAGE AS"? JMP .+3 /NO ISZ POINT2 /YES, BUMP POINT2 TWICE JMP .+3 SNL /"SAME FIELD AS"? JMP FAIL0D /NO ISZ POINT2 /YES,BUMP POINT2 ONCE TAD I POINT2 /GET RESTRICTION CIA TAD CURENT SZA CLA /CURRENT SECT? JMP FAIL0D /NO TAD I POINT1 /YES AND (3777 /CLEAR ALLOCATED BIT DCA I POINT1 TAD I POINT1 JMS I CCGSTA /COMPUTE ADDRESS IN GST FOR THIS SECT TAD (5 TAD GSTADR DCA GSTADR JMS I CPUTG /CLEAR FIELD WORD JMS I CPUTG /CLEAR ADDRESS WORD FAIL0D, TAD POINT1 TAD (6 /BUMP POINTER DCA POINT1 TAD POINT1 CIA TAD SECPTR SZA CLA /END OF TABLE? JMP FAIL0A /NO JMS RDCIM1 /YES, READ IN CIMAGE TAD (CIMAGE DCA POINT1 /SET UP TO SCAN CIMAGE FAIL0E, TAD I POINT1 /GET NEXT FIELD WORD IN CIMAGE SPA /END? JMP FAIL0G /YES CIA /NO TAD GINDEX SPA SNA CLA /IS NEXT AVAILABLE FIELD IN CIMAGE? JMP FAIL0F /YES TAD POINT1 /NO, NOT YET ANYWAY TAD (3 DCA POINT1 /BUMP POINTER JMP FAIL0E /TRY AGAIN FAIL0F, CMA /FOUND NEXT AVAILABLE FIELD TAD POINT1 DCA FITPTR /SET UP POINTER IN FITSEC JMP NXTENT /TRY AGAIN FAIL0G, CLA /HERE IF END OF CIMAGE AND NO AVAILABLE FIELDS TAD HFICP CIA TAD VCORE SNA CLA /IS THE HIGHEST FIELD ALREADY IN CIMAGE? JMP FAIL1A /YES, DO IT THE HARD WAY JMS NMCI /NO, PUT NEXT FIELD IN JMP FAIL0F /CLEAN UP MOKRE1, -OKRE1 PAGE / ALLOCATION OF CORE / ALLOC, 0 CDF 0 CMA TAD SECTAB /ADDRESS OF SECT TABLE DCA SOLIST TAD I (SOCNTB /GET FIRST COUNT CIA DCA SOCNT /CNT OF SECT IN OVERLAY TAD SECCNT CIA DCA DEFFLG /LENGTH OF SECT TABLE DCA HIAA /CLEAR OUT HIGH ADDRESS CLA CMA DCA LOWAA /SET LOW ADDRESS TO 7600 OF FIELD 37 IAC DCA CURBLK /SET CURBLK TO 1 TAD (QUSRLV-1 DCA XR6 /SET POINTER TO START OF USER OVERLAY LEVEL DATA TABLE CDF 10 /CLEAR OUT QUSRLV TAD (-40 DCA OVRLVL DCA I XR6 ISZ OVRLVL /OVRLVL WILL BE 0 WHEN DONE TO START WITH "MAIN" JMP .-2 TAD (QUSRLV-1 DCA XR6 JMS WRICIM /WRITE CIMAGE JMS WRCIM2 /WRITE CIMAGE 2 TAD SOCNT /NO. OF RETRIES PER OVERLAY DCA RETRYC CDF 10 JMP FAIL1 /CLEAR SECTS IN GST OF FIELD AND ADDRESS RETRY, TAD SOLIST /START OF LEVEL IN SECTAB DCA XR2 TAD DEFFLG DCA ENTCNT /SET UP COUNT OF ENTRIES NXTENT, IAC TAD XR2 DCA GINDEX /ADDRESS OF CURRENT ENTRY CDF 10 TAD I GINDEX /GST PTR OF CURRENT ENTRY DCA CURENT TAD XR2 JMS GINFO /GET INFO FROM ENTRY JMP MOREQ /ALREADY BEEN ALLOC DCA XR2 /START OF NEXT ENTRY JMS WRCIM1 /SAVE CURRENT CIMAGE TAD OVRLVL CIA TAD OVRL SZA CLA /HAVE OVERLAY OR LEVEL CHANGED? JMP NXTOOL /YES, TEST FOR NEXT OVERLAY OR LEVEL CNTENT, JMS SETFLD /RESOLVE FLD RESTRICTION JMP MOREQ+1 /RESTRICTOR HADN'T BEEN ALLOC JMS SETADR /DO SAME FOR ADDRESS JMP MOREQ+1 /TRY NEXT SECTAB ENTRY JMS FIT /FIND A PLACE FOR IT IN CORE IMAGE AC4000 CDF 10 TAD I GINDEX DCA I GINDEX /FLAG AS ALLOCATED CDF 0 JMS ADJCI /ADJUST CIMAGE TAD SOCNT DCA RECNT TAD SOLIST DCA XR3 /START LOOKING FOR RELATED SECTS LRESTR, TAD XR3 IAC DCA GINDEX TAD XR3 JMS GINFO /GET INFORMATION FROM ENTRY JMP TRYNSE /ENTRY HAS BEEN ALLOCATED, TRY NEXT SECT DCA XR3 /STORE POINTER TO NEXT ENTRY TAD OVRL CIA TAD OVRLVL SZA CLA /DIFFERENT OVERLAY OR LEVEL? JMP TRYNSE+1 /YEP, NO TESTING NEEDED TRY NEXT SECT TAD FLGS RTL; RAL /3 LEFT SMA CLA /"SAME PAGE AS"? JMP .+3 /NO TAD SADR /YES JMP .+4 SNL /"SAME FIELD AS"? JMP TRYNSE+1 /NO TAD SFLD /SECT FIELD CIA TAD CURENT /DOES IT REF. CURRENT? SZA CLA JMP TRYNSE+1 /NOWAY OKRE, JMS SETFLD /YES, SET UP FOR PROPER FIELD JMP TRYNSE+1 /REF. BAD, SECT NOT YET ALLOCATED JMS SETADR /SET UP FOR PROPER ADDRESS, AC=0 JMP TRYNSE+1 /REF BAD, SECT NOT YET ALLOCATED JMS FIT /FIND A PLACE FOR IT IN CORE IMAGE OKRE1, AC4000 /SET ALLOCATED FLAG CDF 10 TAD I GINDEX DCA I GINDEX CDF 0 JMS ADJCI /ADJUST CIMAGE SKP TRYNSE, DCA XR3 ISZ RECNT /ANY MORE TO DO? JMP LRESTR /YES JMP MOREQ+1 /NO, SEE IF MUST PROCESS NEXT ENTRY IN SECTAB / / / /HERE IF NO WORK TO DO ON GST / MOREQ, DCA XR2 /SAVE DATA FROM GINFO ISZ ENTCNT /DONE ALL SECTS? JMP NXTENT /NO, PROCESS NEXT SECTAB ENTRY JMP I ALLOC /YES, DONE / / PAGE / /HERE IF R-SECT RR, JMS TSTPAG /TEST FOR PAGE RESTRICTION CLL TAD CADR /CURRENT CORE ADDRESS SNA /TOP OF PAGE 0? JMP RR1 /YES, CAN'T START THERE AND (177 SNA JMP FITR /ALREADY AT TOP OF PAGE AND FITS(FITSEC CHECKED IT) RR1, TAD CLEN /HAS TO START AT TOP OF PAGE (AND NOT PAGE 0) /LENGTH OF CURRENT CORE SEGMENT SNA /FULL FIELD? JMP RR2 /YES TAD (-200 /NO SNL /COMPUTE LENGTH OF CURRENT CORE AREA /LEFT AT TOP OF NEXT PAGE JMP TRYAGN /NO MEMORY LEFT IN THIS CORE SEGMENT CLL CIA CML TAD SLEN /COMBINE WITH LENGTH OF THIS SECT SZA SNL CLA JMP TRYAGN /NOT ENOUGH ROOM, TRY AGAIN RR2, TAD CADR /ENOUGH ROOM, SET CURRENT CORE ADDRESS AND (7600 /TO TOP TAD (200 /OF NEXT PAGE DCA CADR JMP RR /TRY AGAIN / /SET UP FOR PROPER ADDRESS /EXIT CALL+1 IF SECT NOT YET ALLOCATED / CALL+2 IF ALL OK SETADR, 0 DCA PPAGE /CLEAR PPAGE TAD FLGS RAL SPA CLA /BIT1 = ABSOLUTE ORIGIN FLAG JMP EXITSA /ABS ADDRESS TAD SADR SNA /ANY ADDRESS RESTRICTIONS? JMP EXITSA-2 /NO RESTRICTION CDF 10 JMS SSEC /FIND REF IN SECTAB SKP /FOUND WHAT WE'RE WORKING FOR E14==.; JMS I COS8ER /NOT THERE TAD I POINT2 CDF 0 SMA /HAS SECT BEEN ALLOCATED? JMP EXITSA+1 /NOT ALLOCATED, 1ST RETURN AND (3777 JMS I CCGSTA /CALC GST ENTRY TAD (6 TAD GSTADR JMS I CGGST /GET ADDRESS FROM GST AND (7600 DCA PPAGE /SAVE IN PPAGE CMA DCA SADR /SET SECT ADDRESS TO -1 EXITSA, ISZ SETADR /NORMAL RETURN CLA JMP I SETADR /EXIT / / / /CHECK SECT DATA AGAINST ALLOWABLE LIMITS TRYLIM, 0 TAD CADR /COMPARE CURRENT CORE ADDRESS SPA /IS ADDRESS + ? JMP TRYAGN /NO, THEN CAN'T BE RIGHT TAD LOWLIM /AGAINST LOWER LIMIT SMA SZA /LOWER LIMIT OK? JMP TLIM2 /YES, CHECK UPPER LIMIT WITH LENGTH CIA TAD SLEN /COMBINE IN CURRENT SECT LENGTH CIA CLL DCA TRYDAT /SAVE TAD CLEN /CHECK AGAINST CORE LENGTH SNA /0? JMP .+4 /YES, ALWAYS FITS TAD TRYDAT /NO, COMPARE WITH SECT LENGTH SNL CLA /WILL IT FIT? JMP TRYAGN /NO, TRY NEXT FIELD TAD LOWLIM /YES, RESET CURRENT CORE ADDRESS CIA DCA CADR /TO WHERE WE WANT IT TO START (?)*** TRYLMX, JMP I TRYLIM /DONE / PAGE / TLIM2, CLA /CHECK AGAINST UPPER LIMIT WITH LENGTH TAD CADR /CURRENT CORE ADDRESS TAD SLEN /LENGTH OF SECT TAD UPLIM /UPPER LIMIT SMA SZA CLA /FIT? JMP TRYAGN /NO, TRY AGAIN JMP TRYLMX /YES, OK, EXIT / / GET ALL NEEDED INFO FROM SECTAB ENTRY / / CALLING SEQUENCE: / AC=GST ENTRY ADDR / JMS GINFO / RET1 /ENTY HAS BEEN ALLOCATED / RET2 /NOT ALLOCATED / GINFO, 0 CDF 10 DCA XR4 /PUT ADDRESS IN POINTER TAD I XR4 /GET 1ST WORD OF ENTRY SPA /IF MINUS JMP AA /IT'S BEEN ALLOC DCA GSTPTR /SAVE PTR TO GST TAD I XR4 DCA FLGS /ABS FLD& ADR FLAGS TAD I XR4 DCA SFLD /SECT FIELD TAD I XR4 DCA SADR /SECT ADDRESS TAD I XR4 DCA TEMP1 /OVERLAY,LEVEL & TYPE TAD TEMP1 AND (377 DCA OVRL /OVERLAY&LEVEL TAD TEMP1 AND (7000 DCA TYPE /SECT TYPE TAD I XR4 SZA /IF SECT LENGTH NOT EQUAL 0 ISZ GINFO /TAKE 2ND RETURN DCA SLEN /SECT LENGTH AA1, TAD XR4 CDF 0 JMP I GINFO /EXIT / AA, CLA /BUMP POINTER TO NEXT ENTRY, SINCE TAD (5 JMP AA1 /ALREADY BEEN ALLOCATED-RETURN / / TEST FOR PAGE RESTRICTIONS / TSTPAG, 0 TAD FLGS RAL SPA CLA /ABS ADDR? JMP EXTTST /YES, ALL OK TAD PPAGE /IS THERE A PAGE RETRICTION? SNA CLA JMP EXTTST /NO, ALL OK TAD CADR /YES AND (7600 /SAME PAGE? CIA CLL TAD PPAGE SNL SZA /AS CURRENT? JMP TRYAGN /BELOW, FAILED- TRY AGIAN SNA CLA /NO, CHECK FOR FIT JMP I TSTPAG /YES ALL OK TAD CADR /COMPUTE UPPER LIMIT OF AVAILABLE SPACE TAD CLEN CIA CLL TAD PPAGE SZL CLA /IS DESIRED PAGE BELOW UPPER LIMIT? JMP TRYAGN /NO, TRY AGAIN TAD PPAGE /YES, IS THERE ENOUGH ROOM IN CURRENT CORE SECTION? CIA TAD CADR TAD CLEN CIA CLL CML TAD SLEN /(SECT LENGTH) SNL SZA CLA JMP TRYAGN /NO TAD PPAGE /YES, SET CURRENT ADDRESS DCA CADR /TO "RESTRICTED" PAGE EXTTST, JMP I TSTPAG /CONTINUE ON /SET UP FOR PROPER FIELD /EXIT CALL+1 IF SECT NOT YET ALLOCATED / CALL+2 IF ALL OK SETFLD, 0 TAD FLGS SPA CLA /BIT 0 = ABS FLD FLAG JMP ABSF /FLD WAS ABS TAD SFLD SNA /ANY FIELD RESTRICTION? JMP EXITSF-2 /NO RESTRICTIONS CDF 10 JMS SSEC /SEARCH SECT TABLE FOR FLD OF FIELD RESTRICTION SKP /FOUND WHAT WE'RE LOOKING FOR E15==.; JMS I COS8ER /NOT THERE, ERROR TAD I POINT2 CDF 0 SMA /HAS SECT BEEN ALLOCATED? JMP EXITSF+1 /SECT NOT ALLOC YET (1ST RETURN) AND (3777 /YES JMS I CCGSTA /CALCULATE GST ADDRESS TAD (5 /BUMP TO 5TH ELEMENT TAD GSTADR JMS I CGGST /GET FIELD OF SYMBOL SKP /NORMAL RETURN CMA /IF NO RESTRICTIONS, SET TO -1 DCA SFLD /STORE IN SECT FIELD EXITSF, ISZ SETFLD /BUMP RETURN ADDRESS CLA JMP I SETFLD /EXIT / ABSF, TAD SFLD /ABSOLUTE FIELD FLAG SET CIA TAD HFICP SMA CLA JMP EXITSF /FLD IS CORE PIC, ALL OK TAD SFLD /NOT IN CORE PICTURE DCA .+2 /EXPAND CORE PIC TO JMS CPIC /INCLUDE THIS FLD 0 E16==.; JMS I COS8ER /FLD OUT OF RANGE JMP EXITSF /OK, EXIT / /SUBROUTINE TO SET CURLOC IN GST, THEN CALL TSTHLA TO SET LOWAA AND HIAA SETCUR, 0 TAD GSTADR /BACK UP TAD (-4 /TO DCA GSTADR /"TASK" WORD TAD CADR /STORE CORE ADDRESS JMS I CPUTG JMS TSTHLA /SET UP LOWAA, HIAA JMP I SETCUR / PAGE FIT, 0 TAD TYPE /GET TYPE OF SECT CLL RTL RTL TAD (TYPTAB /FORM ADDRESS IN TABLE DCA TEMP4 /SAVE TAD I TEMP4 /GET XFER ADDRESS DCA CMPADR /SAVE JMS FITSEC /FIT SECT JMP I CMPADR /CHECK FIT BY TYPE FITR, TAD GSTPTR /IF ASECT, RETURN HERE, IT ALWAYS FITS JMS I CCGSTA /CALCULATE GST ADDRESS TAD GSTADR /BUMP TO FLD ENTRY TAD (5 DCA GSTADR TAD CFLD /SAVE FLD IN GST JMS I CPUTG /PUT AC INTO GST TAD CADR JMS I CPUTG /SAVE ADR. TOO JMS SETCUR /SET CURLOC IN GST, SET UP LOWAA,HIAA JMP I FIT /EXIT / / TRY TO FIND THE SMALLEST / SLOT IN CIMAGE FOR THIS SECT / FITSEC, 0 TAD FITPTR /START AT TOP OF CIMAGE,OR CURRENT POINT DCA XR5 /(SEE "FAILUR") TRYAGN, CLA TAD I XR5 SPA /GET 1ST ENTRY JMP FAILUR /END OF CIMAGE, ERROR, NO PLACE TO PUT IT DCA CFLD /SAVE AS CURRENT CORE FIELD TAD I XR5 DCA CADR /SAVE CURRENT CORE ADDRESS TAD I XR5 DCA CLEN /SAVE CURRENT CORE LENGTH TAD SFLD SPA JMP NOFR /NO FLD RESTRICTION IF -(1) CIA TAD CFLD SZA CLA /SAME FLD AS CURRENT RESTRICTION? JMP TRYAGN /NO, TRY AGAIN NOFR, CLA /YES (HERE IF NO FIELD RESTRICTION OR SAME AS CURRENT) TAD SADR CLL CMA SNA JMP NOAR /NO ADDRESS RESTRICTION IF -1 (ORIGINALLY) IAC /RESTORE TO ORIGINAL NUMBER CML TAD CADR SZA SNL /ADDRESS OK? JMP TRYAGN /NO CIA /MAKE + NOAR, TAD SLEN /COMBINE IN SECT LENGTH CLL CML /SET LINK SZA /IF AC NON-ZERO CIA /COMPLEMENT AC DCA FITLEN /SAVE NEGATIVE OF COMBINED LENGTH TAD CLEN /GET CORE LENGTH SNA /IF ZERO (10000) CML /COMPLEMENT LINK TAD FITLEN /COMPARE WITH COMBINED LENGTH SZL CLA /FIT? JMP TRYAGN /DOES NOT FIT, TRY AGAIN IAC /FITS, MUST CORE ADDRESS BE SET? TAD SADR SNA CLA JMP .+3 /NO TAD SADR /YES DCA CADR TAD (CIMAGE-1 DCA FITPTR /RESET FITPTR JMP I FITSEC / / / / FITPTR, CIMAGE-1 FITLEN=. / /ADJUST LOWAA AND HIAA FOR SIZE OF CURRENT LEVEL TSTHLA, 0 /TEST ADDR JUST ALLOC TAD LOWAA /TO SEE IF ITS HIGHER JMS CMPFLD /COMPARE FIELDS (ENTRY AND CURRENT CORE) SMA SZA /ALLOCATIONS JMP TSTHI /FIELD OF ENTRY NOT LOWER THAN CURRENT SZA CLA JMP CHNGL /REPLACE TAD LOWAA /FIELD IS HIGHER THAN CURRENT JMS CMPADR /COMPARE ADDRESS (ENTRY AND CURRENT CORE) SZL CLA /SKIP IF HIGHER OR EQUAL JMP TSTHI /NOT LOWER THAN CURRENT, ALL OK CHNGL, TAD CADR /HIGHER OR EQUAL AND K7600 TAD CFLD DCA LOWAA /SET NEW ENTRY ADDRESS TO LOWEST (CURRENT) TSTHI, CLA /SEE IF ITS HIGHER THAN HIGHEST TAD HIAA JMS CMPFLD /COMPARE ENTRY AND CURRENT CORE FIELD SMA SZA JMP CHNGH /LOWER THAN CURRENT, SET TO CURRENT SZA CLA JMP I TSTHLA /NO, OK TAD HIAA /SAME, CHECK ADDRESSES JMS CMPADR TAD SLEN /ADD SECT LENGTH FOR UPPER LIMIT SNL CLA /SKIP IF LOWER JMP I TSTHLA /HIGHER OR EQUAL, OK K7600, CHNGH, CLA+400 /LOWER TAD CADR TAD SLEN /ADD SECT LENGTH FOR UPPER LIMIT TAD (177 /ROUND UP TO TOP OF NEXT PAGE AND K7600 TAD CFLD DCA HIAA /SET NEW ENTRY ADDRESS TO LOWEST (CURRENT) JMP I TSTHLA /COMPARE FIELD OF ENTRY TO CURRENT CORE FIELD CMPFLD, 0 AND (37 /MASK TO FIELD CIA TAD CFLD /COMPARE JMP I CMPFLD /COMPARE ADDRESS OF ENTRY TO CURRENT CORE ADDRESS CMPADR, 0 AND K7600 /MASK TO ADDRESS CLL CIA /2'S COMP DCA TEMP1 /SAVE TAD CADR /MASK CURRENT TO ADDRESS AND K7600 TAD TEMP1 /COMPARE JMP I CMPADR / PAGE / GENERAL PURPOSE BUBBLE SORT / / CALLING SEQUENCE: / JMS SSORT / ADDRESS OF TABLE TO SORT / LENGTH OF TABLE / LEN OF TABLE ENTRY / WORD OFFSET TO SORT ON / WORD MASK / COMPARE TYPE / RETURN / SSORT, 0 TAD SSORT DCA XR1 CDF 0 TAD I SSORT DCA TABLE /ADDRESS OF TABLE TO SORT CMA TAD I XR1 /LEN OF TABLE SNA /LENGTH OF 1? JMP EXIT /YES, NO SORT NEEDED CIA DCA TABCNT TAD I XR1 /LEN OF ENTRY DCA LENENT TAD I XR1 /WORD OFFSET DCA WORD TAD I XR1 /MASK DCA MASK TAD I XR1 /TYPE OF COMPARE DCA S1 SCDF, CDF 10 A4, DCA EXCNT /0 COUNT OF EXCHANGES TAD TABCNT DCA COUNT1 /NO. OF COMPARES TAD TABLE /PRODUCE OFFSET TO 1ST WORD TAD WORD DCA POINT1 /FOR 1ST POINTER JMP A2+2 /BYPASS NEXT 2 WORDS A2, TAD POINT2 /COMPLETE BUMP OF 1ST POINTER DCA POINT1 TAD LENENT /SET 2ND POINTER TO NEXT POSITION IN TABLE TAD POINT1 DCA POINT2 TAD MASK /GET MASK IAC SNA CLA /MASK=-1? JMP BIGADD /YES, RANGE OF 1 TO 4096 TAD I POINT1 /GET 1ST WORD AND MASK /MASK TO INTERESTED BITS CIA CLL CML /NEGATE DCA TEMP1 /SAVE TAD I POINT2 /GET 2ND WORD AND MASK /MASK TO INTERESTED BITS TAD TEMP1 /COMPARE S1, SMA CLA /GETS CHANGED TO SNL FOR TYPE&OVRL JMS EXCHNG /EXCHANGE ENTRIES ISZ COUNT1 /OK WAY THEY ARE- MORE? JMP A2 /YES TAD EXCNT SZA CLA /ANY CHANGES THIS PASS? JMP A4 /YES, START ANOTHER PASS JMP RETSS /NO- RETURN EXIT, ISZ XR1 /EXIT IF LENGTH OF TABLE = 1 ISZ XR1 /BUMP 4 TIMES ISZ XR1 ISZ XR1 RETSS, TAD KCDF10 DCA SCDF /SET SCDF BACK TO CDF+10 JMP I XR1 /EXIT / BIGADD, CLA CLL CML /HERE IF 1 TO 4096 TAD I POINT1 SZA /0? CIA /NO, COMPLEMENT DCA EXCHNG /SAVE TAD I POINT2 SNA /0? CML /YES, COMPLEMENT LINK TAD EXCHNG /COMPARE THE TWO JMP S1 /DO THE SKIP / TABLE, 0 /TABLE ADDRESS TABCNT, 0 /WORD OFFSET MASK, 0 /MASK EXCNT, 0 /COUNT OF EXCHANGES THIS PASS LENENT, 0 /LENGTH OF ENTRY WORD, 0 /WORD OFFSET KCDF10, CDF+10 / / /EXCHANGE TWO ENTRIES EXCHNG, 0 TAD WORD CIA TAD POINT1 /CURRENT POINTER - WORD OFFSET = 1 POSITION DCA TEMP1 /1ST WORD TAD WORD CIA TAD POINT2 /CURRENT POINTER - WORD OFFSET = 1 POSITION DCA TEMP2 /2ND WORD TAD LENENT CIA DCA COUNT2 /LENGTH CONTEX, TAD I TEMP1 /GET 1ST WORD DCA TEMP3 /SAVE TAD I TEMP2 /GET 2ND WORD DCA I TEMP1 /STORE IN PLACE OF 1ST TAD TEMP3 /STORE 1ST DCA I TEMP2 /IN PLACE OF 2ND ISZ TEMP1 /BUMP POINTERS ISZ TEMP2 ISZ COUNT2 /DONE WHOLE ENTRY? JMP CONTEX /NO ISZ EXCNT /YES, SET A FLAG JMP I EXCHNG /EXIT / / PAGE /DSECT D, JMS TSTPAG /DATA SECT CAN BE ANYWHERE ON A FLD /AND OVERFLOW THE PAGE JMP FITR / /X SECT X, TAD (-10 /MUST BE IN 10-17 DCA LOWLIM TAD (-20 DCA UPLIM JMS TRYLIM JMP FITR / /Z SECT ZZ, TAD (-20 /MUST BE IN 20-177 DCA LOWLIM TAD (-200 DCA UPLIM JMS TRYLIM JMP FITR / / SORT OF FAILURES IN SECTAB / BY LENGTH / LFF, 0 CMA TAD GINDEX /CHECK FOR FIRST ENTRY CIA /IN SECTAB TAD SOLIST SNA CLA JMP I LFF /IT IS, GO BACK TAD GINDEX DCA POINT1 /ENTRY THAT FAILED TAD (5 TAD POINT1 DCA TEMP1 TAD I TEMP1 CIA DCA TEMP4 /LEN OF SEC THAT FAILED CDF 0 TAD (6 DCA LENENT DCA WORD CDF 10 CONTL, TAD POINT1 TAD (-6 DCA POINT2 TAD POINT2 IAC DCA TEMP2 TAD I TEMP2 /FAIL FLAG UP? CLL RAR SNL CLA JMP SWPENT /NO AC4 TAD TEMP2 DCA TEMP2 TAD I TEMP2 /COMPARE LENGTHS TAD TEMP4 SMA SZA CLA JMP RETLFF /CURRENT SMALLER SWPENT, JMS EXCHNG /CURRENT BIGGER - MOVE IT TAD POINT2 DCA POINT1 CMA TAD POINT1 CIA TAD SOLIST SZA CLA /TOP OF SECT LIST? JMP CONTL /NO / RETLFF, ISZ LFF JMP I LFF /GO BACK SO CAN RETURN / / NMCI, 0 TAD HFICP /GET HIGHEST FIELD IN CORE PICTURE IAC /BUMP DCA .+2 /SAVE JMS CPIC /PUT NEXT FLD INTO CIMAGE 0 SKP /RAN OUT OF CORE JMP I NMCI JMS I CFERR /TOO BIG CORERR / / PAGE / /HERE IF NEXT OVERLAY OR LEVEL NXTOOL, TAD OVRLVL /BUMP OVERLAY LEVEL# TAD (20 AND (160 /MASK TO LEVEL BITS CIA /AND MAKE NEGATIVE TAD OVRL /COMPARE WITH NEW OVERLAY# SNA CLA /NEXT LEVEL? JMP NXTLVL /YES / / NEXT OVERLAY NXTOL, JMS RDCIM2 /YES, READ LEVEL CORE IMAGE ISZ OVRCNT /BUMP OVERLAY COUNT JMS NXTCOM /DO SOME CODE COMMON TO BOTH JMP CNTENT /CONTINUE BY RESOLVING FLD RESTRICTIONS / / / NEXT LEVEL NXTLVL, TAD SFLD /SAVE SOME LOCATIONS DCA SSFLD /INCASE OF CALL TO TAD SADR /FITSEC AND ADJCI DCA SSADR TAD SLEN DCA SSLEN JMS MAKLHR /MAKE LOADER HEADER TAD OVRCNT /CALC. FIRST BLK FOR NEXT LEVEL SNA JMP CLNUP /JUST IN CASE OVRCNT IS ZERO CIA DCA OVRCNT TAD LOWAA /IT'S = CURBLK + (NO. OF OVERLAYS ISZ OVRCNT /IN LEVEL * BLK SIZE OF LARGEST JMP .-2 /OVERLAY IN LEVEL) TAD CURBLK DCA CURBLK CLNUP, JMS NXTCOM /DO COMMON STUFF TAD POINT1 CIA TAD (CIMAGE SNA CLA /ANYTHING IN CIMAGE? JMS NMCI /NO, JMS WRICIM /SAVE CIMAGE JMS WRCIM2 /SAVE THIS LEVEL'S CIMAGE DCA OVRCNT /ZERO OVERLAY COUNT CLA CMA /SET LOW ADDRESS TO -1 DCA LOWAA DCA HIAA /SET HIGH ADDRESS TO 0 TAD SOLIST DCA SAV2 /SAVE SOLIST (START OF LEVEL IN SECTAB) TAD DEFFLG DCA SAV3 /SAVE DEFFLG (COUNT OF ENTRIES) TAD SSLEN /RESTORE LOCATIONS SAVED ABOVE DCA SLEN TAD SSADR DCA SADR TAD SSFLD DCA SFLD JMP CNTENT /CONTINUE ALLOCATION OF CORE SSFLD, 0 SSADR, 0 SSLEN, 0 / NXTCOM, 0 TAD OVRL DCA OVRLVL /SET UP FOR NEW OVERLAY OR LEVEL TAD OVRL TAD (SOCNTB DCA SOCNT TAD I SOCNT /GET NEXT COUNT CIA DCA SOCNT TAD ENTCNT DCA DEFFLG /SET UP DEFFLG CLA CLL CMA TAD GINDEX DCA SOLIST /ADR IN SECTAB OF NEXT OVERLAY (OR LEVEL) JMP I NXTCOM / /HERE IF A FLOATING SECT /CAN START ANYWHERE (BUT PAGE 0) AND /MUST BE CONTAINED ON 1 PAGE F, CLL CML TAD SLEN TAD (-200 SZA SNL CLA /LESS OR EQUAL 1 PAGE? E19==.; JMS I COS8ER /NO, ERROR JMS TSTPAG /TEST PAGE RESTRICTIONS TAD CADR AND (7600 SZA CLA /PAGE 0? JMP F1 /NO F0, TAD CADR /YES AND (177 TAD (-200 CLL TAD CLEN SNL /SPACE ON NEXT PAGE? JMP TRYAGN /NO CLL CIA /YES TAD SLEN SZL CLA /NEXT PAGE LONG ENOUGH? JMP TRYAGN /NO TAD CADR /YES, BUMP TO TOP AND (7600 /OF NEXT PAGE TAD (200 DCA CADR F1, TAD CADR /DOES IT AND (177 /FIT TAD (-200 /ON TAD SLEN /THE PAGE? SMA SZA CLA /YES JMP F0 /NO JMP FITR /EXIT / NRMSG, TEXT "NO ROOM" CORERR, TEXT "TOO BIG" PAGE / / MAKE ENTRY IN QUSRLV / EACH ENTRY IS 4 WORDS / WORD 1: NUMBER OF OVERLAYS / 2: STARTING FLD &ADDR / BITS 0-4 ADDR / 7-11 FLD / 3: RELATIVE STARTING BLOCK / 4: LENGTH IN PAGES / MAKXIT, CDF 0 JMP I .+1 MAKLHR, 0 TAD OVRLVL /GET OVERLAY AND LEVEL OF "OLD" SECT SNA CLA /0? JMP MAKLH1 /YES, ALL OK TAD HIAA /NO, GET HIGH ADDRESS AND (37 CIA /MASK TO FIELD AND MAKE NEGATIVE TAD LOWAA /COMPARE WITH LOW ADRESS'S AND (37 /FIELD SZA CLA /SAME? JMP BADLVL /NO, ERROR SCANST, TAD SECTAB /SET UP POINTER TO SCAN SECTAB LOOKING DCA POINT1 /FOR A SECT LOADED BETWEEN LOWAA AND HIAA CDF 0 CLA CMA DCA HIAD /SET HIAD TO -1 CDF 10 SCAN1, TAD I POINT1 /GET AN ENTRY SMA CLA JMP SCAN2 /NOT ALLOCATED TAD I POINT1 /GET IT AGAIN JMS I CCGSTA /COMPUTE GST ADDRESS TAD (5 TAD GSTADR JMS I CGGST /GET FIELD WORD FROM GST CIA TAD LOWAA AND (37 SZA CLA /SAME AS THIS LEVEL? JMP SCAN2 /NOT SAME FIELD, OK IAC /YES, GET ADDRESS FROM GST TAD GSTADR JMS I CGGST DCA GSTADR /SAVE TAD LOWAA /B AND (7600 CIA CLL CML TAD GSTADR /A SZL CLA /GSTADR=>LOWAA? JMP SCAN2 /LESS THAN, OK TAD HIAA /B AND (7600 CIA CLL CML TAD GSTADR /A SZL CLA /GSTADR=>HIAA JMP BADLV2 /ERROR, LOWAA<=GSTADR