File LNKALL.MA (MACREL macro assembler source file)

Directory of image this file is from
This file as a plain text file

/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<HIAA SCAN2, TAD POINT1 /BUMP POINTER TAD (6 DCA POINT1 TAD POINT1 CIA TAD SAV2 IAC SZA CLA /AT END OF LOWER LEVELS? JMP SCAN1 /NO, REPEAT CDF 0 TAD HIAD CMA SZA CLA /ANY INTERVENING SECTS? JMP BADLV3 /YES TAD LOWAA /NO AND (200 SZA CLA /IS LOWAA A MULTIPLE OF 400? JMP BADLV1 /NO, ERROR TAD CLNCI SNA CLA /NEED TOO CLEAN UP CIMAGE? JMP MAKLH1 /NO DCA CLNCI /YES, CLEAR FLAG JMS RDCIM /GET ORIGINAL CIMAGE TAD LOWAA /SET AND (37 /UP DCA SFLD /TO TAD LOWAA /CALL AND (7600 /FITSEC DCA SADR /SO TAD LOWAA /THAT CIA /CAN TAD HIAA /FAKE DCA SLEN /OUT JMS FITSEC /CALL TO JMS ADJCI /ADJCI
MAKLH1, CDF 10 TAD OVRCNT /GET COUNT OF OVERLAYS IN LEVEL IAC /ADD 1 FOR CURRENT DCA I XR6 /STORE IN TABLE TAD LOWAA /GET LOW ADDRESS DCA I XR6 /STARTING ADDR. & FLD TAD CURBLK /GET RELATIVE BLOCK # DCA I XR6 /STORE IN TABLE TAD LOWAA /COMPUTE LENGTH CIA TAD HIAA DCA LOWAA /SAVE LENGTH TAD LOWAA /EXTRACT FIELD AND (37 DCA TEMP1 TAD LOWAA /EXTRACT # OF PAGES USED AND (7600 CLL RAL /LEFT 1 TAD TEMP1 /COMBINE WITH FLD RTL /POSITION RTL RAL DCA LOWAA /SAVE TAD LOWAA IAC RAR CLL TAD CURBLK /ADD TO CURRENT NO OF BLKS DCA CURBLK JMP MAKLH2 CLNCI, 0 PAGE
MAKLH2, TAD LOWAA /LEN IN PGS DCA I XR6 /STORE IN TABLE TAD LOWAA /CONVERT PAGES IAC RAR CLL DCA LOWAA /TO BLOCKS TAD OVRLVL SZA CLA /IN MAIN? JMP MAKXIT /NO IAC /YES, SET CURBLK DCA CURBLK /BACK TO 1 JMP MAKXIT /
/HERE IF LOWAA NOT A MULTIPLE OF 400 BADLV1, TAD LOWAA TAD (200 JMP BADLVL+2 /CLEAN UP CIMAGE TO EVEN PAGE /HERE IF LOWAA<=GSTADR<HIAA BADLV2, TAD HIAD CMA SNA CLA /ANYTHING IN HIAD? JMP .+7 /NO TAD HIAD /YES AND (7600 /B CIA CLL CML TAD GSTADR /A SZL SNA CLA /NEED NEW ADDRESS? JMP SCAN2 /NO TAD POINT1 /YES TAD (5 DCA POINT2 TAD I POINT2 /CHECK LENGTH TAD GSTADR /PLUS STARTING ADDRESS TAD (177 /ROUND UP TO NEXT PAGE AND (7600 SNA /NON-ZERO? TAD (7600 /NO, SET UPPER LIMIT TO 7600 DCA GSTADR TAD LOWAA AND (37 TAD GSTADR DCA HIAD /SET HIAD TO NEW HIGH ADDRESS JMP SCAN2 /TRY AGAIN /HERE IF INTERMEDIATE SECT (AFTER BADLV2 ABOVE) BADLV3, TAD HIAD JMP BADLVL+2 /CLEAN UP CIMAGE BADLVL, TAD HIAA /HERE IF LEVEL IS NOT ALL IN 1 FIELD AND (37 /GET FIELD FROM HIGH ADDRESS DCA HIAA /PUT BACK TO HELP CLEAN UP CIMAGE JMS RDCIM /READ OLD CIMAGE CLA CMA DCA CLNCI /SET CLNCI FLAG JMS CLEAN /CLEAN UP CIMAGE CLA TAD OVRLVL AND (160 /SET BACK TO OVERLAY 0 OF THE LEVEL DCA OVRLVL DCA HIAA CMA DCA LOWAA /SET LOW ADDRESS TO HIGHEST ADDRESS DCA OVRCNT /CLEAR COUNTER TAD SOCNT DCA RETRYC JMS WRCIM2 /WRITE NEW CIMAGE TAD SAV2 DCA SOLIST /RESTORE SOLIST TAD SAV3 DCA DEFFLG /RESTORE DEFFLG TAD OVRLVL TAD (SOCNTB DCA SOCNT TAD I SOCNT CIA DCA SOCNT /SET UP SECT COUNTER CDF 10 JMP FAIL1 /REMOVE ALLOCATION FLAGS, TRY AGAIN HIAD, 0
.EXTERNAL PANIC NRERR, JMS NFERR /NO ROOM, MAKE NON-FATAL NRMSG ACM3 DCA COUNT1 /SET UP COUNTER FOR SYMBOL OUTPUT TAD GSTPTR JMS I CCGSTA /CALCULATE ADDRESS OF SYMBOL IN GST TAD GSTADR JMS I CGGST /GET 1ST WORD SMA /BEGIN WITH $? JMP NR1+2 /NO DCA TEMP1 /YES, SAVE TAD (244 JMS TTYO /OUTPUT A "$" TAD TEMP1 AND (3777 /MASK OFF "$" JMP NR1+2 NR1, TAD GSTADR JMS I CGGST /GET NEXT 2 CHARACTERS DCA TEMP1 /SAVE TAD TEMP1 RTR CLL RTR RTR JMS FIXCHR /CONVERT LEFT CHARACTER JMS TTYO /OUTPUT IT TAD TEMP1 JMS FIXCHR /CONVERT RIGHT CHARACTER JMS TTYO ISZ GSTADR /BUMP POINTER ISZ COUNT1 /BUMP COUNTER JMP NR1 /NOT DONE, LOOP JMS CRLF /DONE DCA OUTFIL /FORCE NO .SV JMP PANIC /EXIT / PAGE /
/MOVE UP ALL DATA FROM CURRENT POINT IN CIMAGE MOVEUP, 0 DCA XR4 /SET POINTER AC3 /3 MORE 'CAUSE EACH ENTRY IS 3 WORDS TAD XR4 DCA XR5 /FOR SECOND POINTER MOVUP1, TAD I XR5 CMA SNA /IF ENTRY =-1, EXIT JMP EXITM CMA /OTHERWISE, RESTORE DCA I XR4 /STORE TAD I XR5 DCA I XR4 TAD I XR5 DCA I XR4 JMP MOVUP1 /DO AGAIN EXITM, CMA /STORE -1 TO INDICATE END DCA I XR4 CMA TAD XR4 DCA XR5 /SET UP XR5 TO END OF CIMAGE JMP I MOVEUP /EXIT /
/ / PUTS ENTRIES INTO CIMAGE / BUT FIRST CHECKS FOR NULLS AND / ADJUSTS PICTURE ACCORDINGLY / / CALLING SEQUENCE: / JMS PUTCI / LA /LOW ADDR TO BE INSERTED / HA /HI ADDR / RETURN / PUTCI, 0 TAD (CITAB-1 DCA PTR ACM3 DCA CTR PUTCI0, TAD I PUTCI /GET LOW ADDRESS DCA TEMP3 /SAVE ISZ PUTCI /BUMP RETURN TAD I PUTCI /GET HIGH ADDRESS DCA TEMP4 /SAVE TAD (NULTAB /START OF NULL TABLE-1 DCA POINT1 TAD I (NULTAB /NUM OF ENTRIES IN NULL TABLE SNA JMP NNWCP /NO NULL TABLE TO PROCESS DCA COUNT4 /COUNT OF ENTRIES IN NULL TABLE ANPF, ISZ POINT1 TAD I POINT1 /GET ANOTHER PAGE AND AND (37 /FLD FROM NULL TABLE CIA TAD HFICP /LOOK FOR NULL IN FLD WE'RE DOING SNA CLA JMP FLDOK /FOUND THE RIGHT FLD TFAN, ISZ COUNT4 /NOT THIS FIELD, DONE? JMP ANPF /NOT YET NNWCP, TAD TEMP3 /NULL NOT WITHIN CORE PIC CIA TAD TEMP4 DCA LEN /LENGTH = HIGH ADDRESS-LOW ADDRESS JMS PUT /COMPLETE PICTURE BY STORING IN CIMAGE PUTRET, CLA CMA TAD PUTCI /BACK UP PUTCI DCA PUTCI JMS DISCI /WRITE CURRENT JMS DISCI /READ NEXT ISZ CTR /DONE ALL 3 SETS? JMP PUTCI0 /NO ISZ PUTCI /YES ISZ PUTCI /BUMP RETURN JMP I PUTCI /EXIT
FLDOK, TAD I POINT1 AND (7400 /LOOK AT PAGE CIA DCA NULL /TOP ADDR OF NULL CLL TAD NULL /NEGATIVE START OF NULL TAD TEMP3 /START OF CORE SNA /IS NULL IN CORE PICTURE? JMP SAME /START OF CORE AND NULL SAME SZL CLA JMP TFAN /NO MAYBE, CLA CLL /MAYBE, NULL ABOVE START OF CORE TAD NULL TAD TEMP4 SNL CLA /IS NULL WITHIN SPEC? JMP TFAN /NO TAD NULL /YES TAD TEMP3 CIA DCA LEN /INSERT IMAGE UPTO NULL JMS PUT /PUT ENTRY IN CIMAGE TAD NULL CIA CLL JMP SAME+2 SAME, CLL TAD TEMP3 /BUMP LOW ADDRESS TAD (400 DCA TEMP3 SZL JMP PUTRET /IF LINK SET, NO MORE MEMORY TAD TEMP3 /LOW ADDRESS CIA CLL CML TAD TEMP4 /HIGH ADDRESS SZL SNA CLA /ANY MEMORY LEFT? JMP PUTRET /NO, EXIT JMP TFAN /YES, TRY FOR NEXT ENTRY IN NULL TABLE / / / NULL, 0 /TOP ADDRESS OF NULL LEN, 0 /LENGTH OF SEGMENT CTR, 0 /LOOP COUNTER /
/ PUT ENTRIES INTO CIMAGE / PUT, 0 JMS SERCI /SEARCH CIMAGE FOR -1 TAD XR7 TAD (-CIMAGE-776 SNA CLA /READY TO OVERFLOW CIMAGE? E13==.; JMS I COS8ER /YES TAD HFICP DCA I XR7 /STORE FIELD TAD TEMP3 DCA I XR7 /LOW ADDRESS TAD LEN /LENGTH DCA I XR7 CMA /-1 (END) DCA I XR7 JMP I PUT / / PAGE
/ ADJUST CIMAGE / ADJCI, 0 CMA /BACK UP TO ADDRESS DATA TAD XR5 DCA POINT2 TAD I POINT2 /GET ADDRESS DCA TEMP2 /SAVE TAD TEMP2 CIA TAD CADR SNA /SAME AS CURRENT CORE ADDRESS? JMP STRTS /YES, START TO IMPLEMENT SECT IN CORE IMAGE ISZ POINT2 /NO, BUMP TO LENGTH DCA I POINT2 /SAVE NEW LENGTH JMS SERCI /SEARCH CIMAGE FOR -1 TAD XR7 /SET TO END OF TABLE DCA XR5 JMS IN /INSERT NEW ENTRY IN CIMAGE JSCI, CMA DCA I XR5 /STORE TERMINATOR IN CIMAGE JSCI4, JMS SCI /SORT CORE IMAGE TABLE JMP I ADJCI /START IMPLEMENTING SECT IN CORE IMAGE STRTS, ACM2 /BACK UP 2 TAD POINT2 DCA XR5 TAD SLEN /COMPARE SECT LENGTH CIA TAD CLEN /TO CURRENT CORE LENGTH SNA CLA JMP CLOSUP /EQUAL, CLOSE UP CIMAGE JMS IN /INSERT NEW ENTRY IN CIMAGE JMP JSCI4 /SORT CIMAGE CLOSUP, TAD XR5 JMS MOVEUP /CLOSE UP CIMAGE JMP JSCI /
/ SCI, 0 /SORT CORE IMAGE TABLE DCA SS+2 /SET LENGTH OF TABLE TO 0 (COMPUTE LATER) JMS SERCI /SEARCH CIMAGE FOR -1 TAD (-CIMAGE /START OF TABLE TAD XR7 /END OF TABLE IAC DIV3, TAD (-3 /DIVIDE BY 3 ISZ SS+2 /BUMP COUNT SMA SZA /DONE? JMP DIV3 /NO CLA CMA DCA COUNT4 /SET UP FOR 2 PASSES CLA CLL CMA RAL DCA SWRD+1 /SET MASK TO 7776 IAC /SET WORD TO 1 SS1, DCA SWRD CDF TAD .-1 DCA SCDF /SET SCDF FOR FIELD 0 SS, JMS SSORT /SORT (1ST BY ADDRESS, 2ND BY FIELD) CIMAGE /TABLE 0 /LENGTH OF TABLE 3 /LENGTH OF ENTRY SWRD, 1 /WORD OFFSET 7776 /MASK SZL CLA /TYPE OF COMPARE ISZ COUNT4 /DONE BOTH PASSES? JMP I SCI /YES, EXIT TAD (37 /NO DCA SWRD+1 /NOW WORD 0, SET MASK TO 37 JMP SS1 /SORT AGAIN /INSERT NEW ENTRY IN CIMAGE IN, 0 TAD CADR /ADD CURRENT CORE ADDRESS TAD SLEN /TO SECT LENGTH DCA TEMP3 /SAVE UPPER ADDRESS TAD TEMP2 /GET OLD CIMAGE ADDRESS WORD TAD CLEN /ADD CURRENT CORE LENGTH CIA TAD TEMP3 /COMPARE TO UPPER ADDRESS SNA /SAME? JMP DONE /YES, DONE DCA TEMP2 /NO, SAVE DIFFERENCE TAD CFLD /STORE CURENT CORE FIELD IN CIMAGE DCA I XR5 TAD TEMP3 /STORE UPPER ADDRESS IN CIMAGE DCA I XR5 TAD TEMP2 /STORE NEW LENGTH CIA DCA I XR5 DONE, JMP I IN
/ WRICIM, 0 CDF JMS I (7607 7600-CIMAGE%2+4000 CIMAGE SCRBLK E17==.; JMS I COS8ER JMP I WRICIM / RDCIM, 0 CDF JMS I (7607 7600-CIMAGE%2 CIMAGE SCRBLK E18==.; JMS I COS8ER JMP I RDCIM / /SEARCH CIMAGE FOR -1 SERCI, 0 TAD (CIMAGE-1 DCA XR7 TAD I XR7 /GET 1ST WORD OF 3 WORD SET IAC SZA CLA /-1? JMP .+5 /NO CMA /YES, BACK UP XR7 TAD XR7 DCA XR7 JMP I SERCI /EXIT AC2 /NOT -1, SET UP FOR NEXT 1ST WORD TAD XR7 JMP SERCI+2 / PAGE
/ CREATE CORE PICTURE IN CIMAGE / / EACH ENTRY IS 3 WORDS / ********************* / * FLD * / ********************* / * START ADDRESS * / ********************* / * LEN * / ********************* / / CALLING SEQUENCE: / JMS CPIC / N /N=HIGHEST FLD IN PIC / ERROR RETURN / NORMAL RETURN / CPIC, 0 TAD I CPIC /GET HIGHEST FIELD IN PICTURE CIA TAD VCORE /IS ARG BIGGER THEN SPA CLA /VIRTUAL CORE? JMP ENDCP+1 /YES, TAKE ERROR RETURN NFICP, IAC /INCR TO NXT FLD IN CPIC TAD HFICP CIA TAD I CPIC SPA CLA /END OF SPEC? JMP ENDCP /YES, NO MORE TO INSERT ISZ HFICP /NO, BUMP HIGH FIELD IN CORE PICTURE TAD HFICP TAD MFLD SPA CLA /BELOW /M LIMIT? TAD K7600A /YES, 7600 ONLY DCA HIADR /NO, ALLOW FULL FIELD TAD HFICP TAD (-7 SPA SNA /WHICH BANK? JMP LOW32K /BANK 0 CIA DCA CNT3 /SAVE NEGATIVE COUNT TAD (RFLD0 DCA PNT3 /SET UP POINTER CLL CML /SET UP LINK CPIC0, RAR /ROTATE BIT RIGHT 1 SNL /LINK SET? JMP .+3 /NO ISZ PNT3 /YES, BUMP POINTER RAR /MOVE INTO AC0 ISZ CNT3 /DONE LOOP? JMP CPIC0 /NO AND I PNT3 /YES, IS RESPECTIVE BIT SET? SZA CLA JMP NFICP /YES, DO NOT USE FLD, TRY NEXT
CMA CLL TAD HFICP SMA SZA CLA /FLD 0 OR 1? JMP NORMF /NOT FLD 0 OR 1 SNL /FLD 0 OR 1? IAC /0, SET TO 2 IAC /1, SET TO 1 AND OPTAB+2 CLL RTR /3 RIGHT (AC 10,11 TO AC 0,1) RAR SNA /USE 0-1777 IN FLD? JMP NORMF /YES SHRTF, DCA HIADR /SET UP JOB STATUS WORD TAD HIADR /BY OR'ING IN BIT CMA AND JSWRD TAD HIADR DCA JSWRD JMS PUTCI /PUT 2000 TO 7600 INTO CORE IMAGE 2000 /LA K7600A, 7600 /HA JMP NFICP /PROCESS NEXT FIELD / / ENDCP, ISZ CPIC /NORMAL EXIT ISZ CPIC /ERROR EXIT JMP I CPIC /EXIT / NORMF, JMS PUTCI /SET UP CORE IMAGE 0 /ALWAYS 0 (LA) HIADR, 0 /7600 OR HIGHEST LOCATION ALLOWED (HA) JMP NFICP /PROCESS NEXT FIELD / / LOW32K, CLA /HERE IF BANK 0 TAD HFICP CMA /MAKE COUNT 1'S COMP NEGATIVE DCA CNT3 TAD (OPTAB+2 DCA PNT3 /SET UP POINTER CLL CML RTR /SET AC TO 2000 JMP CPIC0 /POSITION BIT CNT3=COUNT1 PNT3=. / /
CLEAN, 0 TAD (CIMAGE /CLEAN UP CIMAGE DCA POINT1 TAD HIAA AND (37 /GET FIELD FROM ADDRESS DCA TEMP1 /SAVE IT TAD HIAA /GET ADDRESS BITS AND (7600 DCA TEMP2 /SAVE THEM ELIMN, TAD I POINT1 SPA JMP I CLEAN /END OF CIMAGE CIA TAD TEMP1 /ENTRY FIELD ISZ POINT1 SMA SZA /SKIP IF CURRENT ENTRY FIELD LESS OR EQUAL CIMAGE JMP ELIM /REMOVE ENTRY FROM CIMAGE SZA CLA /EQUAL? JMP INCELM /NO, INCLUDE ENTRY TAD TEMP2 /YES, HOW ABOUT ADDRESSES? CIA CLL CML TAD I POINT1 DCA TEMP3 SZL CLA /SKIP IF CURRENT BINARY ADDRESS IS LOWER OR EQUAL CIMAGE JMP TELIMB INCELM, ISZ POINT1 /BUMP POINTER WORD ENTRY ISZ POINT1 JMP ELIMN /TRY AGAIN / ELIM, CLA CMA /SET UP POINTERS TAD POINT1 DCA POINT1 CMA TAD POINT1 JMS MOVEUP /MOVE ALL DATA UP 1 SLOT (2 LOCATIONS) JMP ELIMN /TRY AGAIN /
/ /PART OF "ELIMN" TELIMB, TAD TEMP2 DCA I POINT1 /CHANGE ADDR TO START OF NEXT BLK ISZ POINT1 TAD I POINT1 /GET LEN - SUB TAD TEMP3 /DIFFERENCE SZL SNA /WAS CIMAGE ENRY BIG ENUF JMP .+3 /NO -DO AWAY WITH IT DCA I POINT1 /YES- SAVE NEW LEN JMP INCELM+1 ACM2 /GET BACK BEGIN OF ENTRY JMP ELIM+1 / / PAGE



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search