File LNKBN2.MA (MACREL macro assembler source file)

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

/LNKBN2 - LINK BINARY MODULE #2
/
/
/
/
/
/
/
/
/
/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 BINARY MODULE #2 XLIST NOPUNCH .INCLUDE LNKMAN.MA ENPUNCH XLIST .RSECT LNKBN2
/SUBROUTINE TO CREATE A NEW ORIGIN /TEMP1=ADDRESS TO SET TO /TEMP4=FIELD TO SET TO NEWORG, 0 DCA OUTINH /DON'T INHIBIT PUNCHING TAD OPTAB RAL SPA CLA /DOING .BN? JMP PUNORG /YES TAD BSECTP /DOING MAIN TAD (-LHDR SNA CLA /IF BSECTP IF POINTING TO START OF LHDR JMP MAINL /YES- FIND CORRECT BUFFER TAD (CIDAT /MAINL SKIPS THIS INSTRUCTION NEWOR1, DCA EPTR /SET PTR TO CURRENT SECTION (FIELD WORD) CLA IAC TAD EPTR DCA EPT2 /SET EPT2 TO ADDRESS WORD TAD I EPT2 /DO A DOUBLE PRECISION SUBTRACT, GET ADDRESS CIA CLL TAD TEMP1 /SUBTRACT FROM NEW ADDRESS DCA TEMP3 /SAVE DIFFERENCE TAD TEMP3 AND (7400 DCA TEMP2 /SAVE HIGH ORDER 4 BITS OF DIFFERENCE CML RAL /PROPOGATE CARRY INTO HIGH ORDER TAD I EPTR /GET FIELD FROM BINARY TABLE CIA CLL TAD TEMP4 /SUBTRACT FROM NEW FIELD SPA /IF RESULT IS POSITIVE, NEW ADDRESS IS HIGHER JMP BADORG /OUT OF RANGE CLL RAR TAD TEMP2 /COMBINE AND SHIFT RIGHT 8 RAL RTL RTL /(I.E. LEFT 5) DCA TEMP2 TAD TEMP2 ISZ EPT2 /BUMP TO WORD 3 TAD I EPT2 /ADD TO RELATIVE BLOCK OF SECTION DCA NEWBLK /STORE AS NEW BLOCK ISZ EPT2 /BUMP TO LENGTH TAD I EPT2 /GET "TABLED" LENGTH IAC /CONVERT TO BLOCKS CLL RAR CIA TAD TEMP2 /COMPARE TO COMPUTED LENGTH SMA CLA /IF RESULT IS NEGATIVE, NEW LENGTH IS SHORTER JMP BADORG /ORIGIN OUT OF RANGE (***?***) JMS NEWBB /GET BUFFER USING NEWBLK TAD TEMP3 AND (377 /ADD IN ORIGIN TAD BLKBEG /ADD IN BEGINNING BLOCK DCA BLKSIZ /FORM POINTER INTO PROPER BUFFER ORGXIT, JMP I NEWORG /DONE
/COME HERE ON ORIGIN OR WHEN CROSSING /AN AREA BOUNDARY TO SELECT A BINARY /CORE BUFFER FOR A NEW LOADER IMAGE /AREA. THE BINARY BUFFER TABLE /ASSOCIATES CORE BUFFERS TO LOADER /IMAGE AREAS. NEWBB, 0 TAD (LDBUFS /SET UP POINTER DCA BP /TO SEARCH BINARY POINTERS CDF 10 /CHANGE TO DF=1 NEWBB1, TAD I BP /GET POINTER CMA SNA /END? JMP NOEMTY /YES, NOT BLOCK AND NO EMPTY CMA SNA /EMPTY? JMP FNDMT /YES, FOUND EMPTY CIA /NONE OF THE ABOVE TAD NEWBLK SNA CLA /THIS ONE? JMP FNDBUF /YES, FOUND BUFFER NEWBB2, ISZ BP TAD BP /NO TAD (-LDBUFS-40 SZA CLA /END? JMP NEWBB1 /NO, TRY AGAIN NOEMTY, ISZ FNDPTR /HERE IF NO EMPTY TAD FNDPTR TAD (-LDBUFS-40 SNA CLA /END OF BUFFER? JMP FNDSET /YES TAD I FNDPTR CMA SZA CLA /END OF BUFFER? JMP WRIOUT /NO, WRITE OUT CURRENT FNDSET, TAD (LDBUFS /END OF BUFFER, RESET POINTER DCA FNDPTR JMP NOEMTY+1 /TRY AGAIN WRIOUT, TAD FNDPTR /SET UP BP DCA BP AC4000 JMS I (LDRIO /WRITE OUT BUFFER FNDMT, TAD NEWBLK /SET UP NEW BLOCK CDF 10 DCA I BP JMS I (LDRIO /READ IN NEW BUFFER FNDBUF, JMS NEWBUF /SET UP POINTERS INTO BUFFER JMP I NEWBB /DONE FNDPTR, 0
/GET RIGHT BLOCK FOR MAIN MAINL, TAD TEMP4 /FIELD RAL CLL /TIMES 2 TAD (MBST /PLUS MBST DCA MPTR /POINTS TO 2 WORD PAIR TAD I MPTR /FIRST ITEM IS SNA /(BETTER BE NON-ZERO) JMP BADERR DCA MCTR /COUNT OF PIECES IN FIELD ISZ MPTR TAD I MPTR /2ND ITEM IS POINTER DCA MPTR /TO PIECE 4 WORD ENTRY TAD MPTR /PASS BACK TO JMP NEWOR1 /NEWORG ROUTINE / /HERE IF LOADER CODE ERROR LCERR, JMS I COS8ER /ERROR E23==.-1 / / /CLOSE THE .BN FILE PCLOSE, JMS CHKSM /PUNCH CHECKSUM JMS OCLOSE /CLOSE FILE E37==.; JMS I COS8ER /ERROR PAGE
/GET VALUE OF LSD REFERENCE REFVAL, 0 TAD LSDREF JMS GETREF /GET GST # OF LSD REFERENCE SNA E24==.; JMS I COS8ER /ERROR IF GST# IS 0 JMS I CCGSTA /CALCULATE GST ADDRESS AC3 /GET XFER VECTOR TAD GSTADR /NUMBER FROM JMS I CGGST /WORD 4 DCA TRANUM /SAVE AC2 /GET FIELD VALUE TAD GSTADR /FROM WORD 6 JMS I CGGST DCA RFLD TAD GSTADR IAC JMS I CGGST /WORD 7 = VALUE DCA RVALUE IAC /WORD 10 = OVERLAY AND LEVEL TAD GSTADR /GET OVERLAY &LEVEL JMS I CGGST DCA TEMP1 TAD OPTAB+1 RAR SZL CLA / RTS-8 (/X) ? JMP REFXIT /YES, FORGET ABOUT XFER VECTORS TAD TEMP1 SNA CLA /MAIN OR LIBRARY? JMP REFXIT /YES-RETURN TAD OPTAB AND (100 SNA CLA / "F" OPTION JMP REFVL1 /NO, CHECK ALL PERTINENT STUFF TAD TEMP1 /YES CIA /SAME OVERLAY AS TAD OVRL /CURRENT? SZA CLA JMP OKTRAP /NO, GET XFER VECTOR JMP REFXIT /YES, NO XFER VECTOR NEEDED REFVL1, TAD TEMP1 AND (160 /LEVEL DCA TEMP2 TAD OVRL /LEVEL &OVERLAY OF CURRENT MODULE AND (160 /COMPARE LEVELS CIA TAD TEMP2 SMA SZA JMP OKTRAP /IN A HIGHER LEVEL, OK SZA CLA JMP NOGOOD /LOWER LEVEL NOT LEGAL
TAD TEMP1 AND (17 /OVERLAY DCA TEMP3 TAD OVRL AND (17 CIA TAD TEMP3 SNA CLA /SAME LEVEL -SAME OVERLAY? JMP REFXIT /YES - ITS OKAY NOGOOD, JMS NFERR /DIFFERENT OVERLAY OLLERR /BAD NEWS -OVERLAY/LEVEL ERROR- LOWER THAN ALLOWED JMP REFXIT /HERE IF IN HIGHER LEVEL THAN CURRENT OKTRAP, CLA /INSERT TRAP TO OVERLAY HANDLER TAD TRANUM AND (7770 SNA /IS TRANSFER VECTOR NUMBER NON-ZERO? JMP NOGOOD /NO, ERROR OKTRP1, TAD (-10 /GET ADDRESS OF TRANSFER VECTOR CLL RAR /DIVIDE BY 2- CAUSING A*4 OF INDEX TAD TRNADR /ADD BASE OF TRANSFER VECTORS DCA RVALUE TAD TRNFLD DCA RFLD REFXIT, CDF JMP I REFVAL TRANUM=. /TRANSFER VECTOR NUMBER /
/COME HERE TO COMPUTE A 15 BIT /BUFFER ADDRESS FROM AN ENTRY /IN THE BINARY BUFFER TABLE. NEWBUF, 0 TAD MXFLD TAD (-10 SZA CLA /OPERATING IN 8K? JMP NEWBF0 /NO CLA CLL CMA RAL /YES, GET SPECIAL CODE (36), (40-2) JMP NEWBF1 /FORCE 7000, FLD 1 NEWBF0, TAD BP /GET POINTER TO BINARY BUFFER TAD (-LDBUFS /SUBTRACT OFF START OF TABLE NEWBF1, TAD (40 /ADD 40 DCA BLKBEG /SAVE TAD BLKBEG RAR CLL /RIGHT 1 AND (70 /MASK FOR FIELD BITS TAD .+1 /ADD CDF CDF DCA OUTFLD /STORE IN OUTFLD TAD BLKBEG AND (17 /MASK TO ADDRESS BITS RTR CLL /POSITION IN AC 0-4 RTR RAR JMS NEWBF2 /STORE IN POINTER /TEST FOR USE OF 7600 JMP I NEWBUF
/OPEN .BN FILE POPEN, TAD OUTFIL+4 TAD (-'SV SZA CLA /IS OUTPUT FILE .SV? JMP .+3 /NO TAD ('BN /YES, CHANGE TO .BN DCA OUTFIL+4 JMS OOPEN /OPEN OUTPUT FILE E38==.; JMS I COS8ER /ERROR JMP CHKSM1 /PUNCH LEADER-TRAILER POPEN1, TAD (40 DCA GI /CLEAR /I FROM "GO" JMP PCCB2 /CONTINUE ON WITH WORK PAGE
/HERE TO PROCESS THE RELOCATABLE BINARY RELOCA, 0 NEWORD, JMS NXTTXT /GET NEXT TEXT WORD TAD (-6 /SET FLAG COUNT TO -6 DCA FLGCNT TAD TXTWRD /SAVE THE TEXT WORD AS A FLAG WORD DCA FLGWRD NXTFLG, JMS NXTTXT /GET NEXT TEXT WORD TAD FLGWRD /MOVE FLAG WORD LEFT 2 RTL DCA FLGWRD TAD FLGWRD RAL /+1 = 3 AND (3 /FORM ENTRY ADDRESS INTO CODTBL TAD (CODTBL JMP JMPTAB /DISPATCH OFF OF TABLE ENTRY REL12, TAD CSECT /CODTBL TRANSFER HERE IF CURRENT SECT /IS TO BE ADDED TO ENTRY (1) ASIS, TAD TXTWRD /CODTBL TRANSFER HERE IF LOAD AS IS (0) OUTP, JMS PUTBIN /OUTPUT BINARY WORD MOVEON, ISZ FLGCNT /BUMP FLAG COUNT JMP NXTFLG /PROCESS NEXT FLAG WORD BYTE JMP NEWORD /TIME TO GET NEXT FLAG WORD / /CODTBL TRANSFER HERE IF 7 BIT RELOCATION (2) REL7B, TAD CSECT /ADD LOWER 7 BITS OF CURRENT AND (177 /SECT ADDRESS TO ENTRY JMP ASIS /
/CODTBL TRANSFER HERE IF SPECIAL LOADER CODE (3) SLC, TAD TXTWRD /ENTRY CONTAINS SPECIAL (3) AND (377 DCA LSDREF /LSD REFERENCE IS IN BITS 4 TO 11 TAD TXTWRD RTL /LOADER CODE IN BITS 0-3 RTL RAL AND (17 TAD (LCTAB /LCTAB= TABLE OF LOADER CODE VALUES JMP JMPTAB /TRANSFER TO SPECIAL CODE ROUTINES / /LCTAB TRANSFERS HERE IF EXTENDED LOADER CODE LC0, TAD LSDREF AND (17 TAD (ELCTAB /LSDREF IS EXTENDED FUNCTION JMPTAB, DCA ADDR /FORM DISPATCH ADDRESS TAD I ADDR DCA ADDR JMP I ADDR /DISPATCH THRU TABLE ENTRY ADDR, 0 / /ELCTAB TRANSFERS HERE IF ELC=0, END OF TEXT, EXIT RELOCA ELC0, JMP I RELOCA /
/INITIALIZE SAVE FILE BLOCKS INTBLK, 0 TAD (LDBUFS /SET UP BP DCA BP IAC CDF 10 DCA I BP /SET TO RELATIVE BLOCK 1 CDF TAD (-400 DCA COUNT1 /SET UP TO STORE JMS NEWBUF /GET ADDRESS OF BLOCK BUFFER CMA TAD BLKBEG DCA XR1 /STORE IN XR1 TAD OUTFLD /GET FIELD DCA .+1 0 INTBL0, TAD OPTAB AND (20 SNA CLA / H OPTION? JMP .+3 /N0 TAD (HLT /YES JMP INTSTO /STORE "HLT" TAD OPTAB AND (4 SNA CLA / J OPTION? JMP INTSTO /NO, STORE 0 IAC /YES, STORE "JMP ." TAD XR1 AND (177 TAD (5200 INTSTO, DCA I XR1 /STORE ISZ COUNT1 /DONE 400? JMP INTBL0 /NO CDF /YES INTLUP, AC4000 JMS I (LDRIO /WRITE OUT BLOCK CDF 10 TAD I BP /GET BLOCK # CDF CMA TAD I (LDCLEN SNA CLA /DONE ALL? JMP I INTBLK /YES CDF 10 /NO ISZ I BP /BUMP BLOCK # JMP INTLUP-1 /NO / PAGE
/LCTAB TRANSFERS HERE IF LC=1, ADD VALUE OF LSD WORD REFERENCED TO NEXT WORD LC1, JMS NXTTXT /GET PTR TO NXT TEXT WORD JMS REFVAL /GET VALUE OF LSD REF TAD RVALUE /ADD VALUE OF LSD REF CONTLC, TAD TXTWRD /TO NEXT ENTRY WORD JMP OUTP /OUTPUT RESULT / /LCTAB TRANSFERS HERE IF LC=2, ADD FIELD OF LSD WORD REFERENCED TO NEXT WORD LC2, JMS NXTTXT JMS REFVAL TAD RFLD /ADD THE FIELD OF THE LSD REF JMS FLD59 /REARRANGE FOR CDF-CIF JMP CONTLC /LCTAB TRANSFERS HERE IF LC=3, LOAD A ZBLOCK, LENGTH IS LSDREF FIELD, /VALUE IS NEXT WORD LC3, JMS NXTTXT TAD LSDREF TAD (7400 DCA TEMP1 /LENGTH OF ZBLOCK TAD TXTWRD DCA TEMP2 /CONTENTS OF ZBLOCK ISZ TEMP1 /MORE? SKP /YES JMP MOVEON /NO -CONTINUE TAD TEMP2 JMS PUTBIN /STORE IN OUTPUT BUFFER JMP .-5 /
/ /LCTAB TRANSFERS HERE IF LC=4, BEGIN OR CONTINUE LOADING DATA FOR SECT /SPECIFIED BY THE LSD REFERENCE LC4, TAD SECTFD /GET SECT FIELD SNA /0? JMP LC4B /YES, NO "OLD SECT" DCA GCDF /NO, SAVE CDF TO GST TAD SECTAD /MOVE ADDRESS OF CURRENT LOC DCA GSTADR TAD CURLOC JMS I CPUTG /STORE "OLD" CURRENT LOC LC4B, JMS GETLVL /SET OVRL DCA OVRL /TO THIS OVERLAY AND LEVEL JMS REFVAL /GET VALUE THIS TIME JMS FIXDAT /FIX UP LOADER INFORMATION TAD RVALUE /MAKE LOC OF LSD REF DCA CSECT /THE CURRENT SECT ADDR TAD RFLD /DO SAME FOR FIELD DCA CFLD TAD (-4 /BACK UP TO CURRENT LOC LOC TAD GSTADR DCA SECTAD /SAVE AS SECT ADDRESS TAD GCDF DCA SECTFD /SAVE FLD AS SECT FIELD TAD SECTAD JMS I CGGST /GET "CURRENT LOC" SKP LC4A, TAD CSECT /SET UP FOR NEWORG DCA TEMP1 TAD TEMP1 /SAVE IN CURLOC DCA CURLOC TAD CFLD DCA TEMP4 JMS NEWORG /FORM NEW ORIGIN JMP MOVEON /CONTINUE SECTFD, 0 /SECT FIELD, 0 FOR INITIALIZATION SECTAD, 0 /SECT ADDRESS /
/ /LCTAB TRANSFERS HERE IF LC=5, NEXT WORD IS DATA, ADD TO LSD REFERENCED, /CHECK LSD REFERENCED 0-177,SUM (BITS 5-11) IS 0-177 LC5, JMS NXTTXT JMS REFVAL TAD RVALUE /0<=LSD<=177? TAD (-200 SMA CLA JMP NOTZER /NO, ERROR TAD RVALUE /YES - ADD LSD VALUE TAD TXTWRD /TO NEXT ENTRY WORD DCA TEMP1 TAD TEMP1 AND (377 /0<=SUM(BITS 5-11)<=177? TAD (-200 SMA CLA JMP NOTZER /NO TAD TEMP1 LC5A, JMP OUTP /YES- OUTPUT IT / /ELCTAB TRANSFERS HERE IF ELC=3, PUSH NEXT WORD ONTO STACK ELC3, DCA LSDREF /ZERO LSDREF /LCTAB TRANSFERS HERE IF LC=6, ADD NEXT WORD TO VALUE OF LSD REFERENCE, /PUSH RESULTS ONTO STACK LC6, JMS NXTTXT CONL12, DCA RVALUE /ZERO REFERENCE VALUE TAD LSDREF SZA CLA /IF LSDREF=0, DON'T GET REFERENCE VALUE JMS REFVAL TAD TXTWRD /ADD CONSTANT TAD RVALUE /TO LSD REF VALUE CONLC, JMS PUSH /PUSH RESULT ON STACK JMP MOVEON /LCTAB TRANSFERS HERE IF LC=7, PUSH LSD FIELD ONTO STACK LC7, TAD LSDREF JMP CONLC /LCTAB TRANSFERS HERE IF LC=10, PUSH FLD OF LSD REF ONTO STACK LC10, JMS REFVAL TAD RFLD /PUSH FIELD JMS FLD59 /REARRANGE FOR CDF-CIF JMP CONLC /PUSH BACK ONTO STACK / /LCTAB TRANSFERS HERE IF LC=12, PUSH THE VALUE OF THE LSD REFERENCED /ONTO THE STACK LC12, DCA TXTWRD /ZERO TXTWRD JMP CONL12 /PUSH VALUE OF LSD REF ON STACK /
/ /LCTAB TRANSFERS HERE IF LC=11, POP VALUE OFF STACK. RESULT IS NEW VALUE /OF LSD REF., SHOULD REFERENCE A GLOBAL LC11, JMS POP /POP VALUE OFF STACK DCA TEMP1 /AND SAVE TAD LSDREF /GET LSD REF LOC JMS GETREF JMS I CCGSTA /COMPUTE GST ADDRESS TAD (4 TAD GSTADR /WORD5 = TYPE CODE JMS I CGGST /BUT FIRST... AND (17 /IS GST ENTRY A GLOBAL? TAD (-15 SZA CLA E26==.; JMS I COS8ER /NO -BAD NEWS SOMEONE GOOFED ISZ GSTADR ISZ GSTADR TAD TEMP1 JMS I CPUTG /STUFF IT IN THERE JMP MOVEON / PAGE
/ /ELCTAB TRANSFERS HERE IF ELC=4, POP, NEGATE, PUSH ELC4, JMS POP /POP IT CIA /NEGATE JMP PRESLT /PUSH IT / /ELCTAB TRANSFERS HERE IF ELC=5, POP TOP 2 ITEMS, ADD, PUSH BACK ELC5, JMS POP2 /POP 2 ADDIT, TAD TEMP1 /ADD TAD TEMP2 PRESLT, JMS PUSH /PUSH RESULT JMP MOVEON / /ELCTAB TRANSFERS HERE IF ELC=6, POP, TOP 2 ITEMS, SUBTRACT, PUSH BACK ELC6, JMS POP2 /POP 2 TAD TEMP1 /SUBTRACT 1ST CIA TAD TEMP2 /FROM 2ND JMP PRESLT /PUSH RESULT / /POP TWO THINGS OFF STACK POP2, 0 JMS POP DCA TEMP1 JMS POP DCA TEMP2 JMP I POP2 / /ELCTAB TRANSFERS HERE IF ELC=7, POP TOP 2, MULTIPLY, PUSH 12 BIT RESULT ELC7, JMS POP2 /POP2 TAD TEMP1 SNA /0? JMP ZEROM /YES CIA /NEGATE DCA COUNT1 /SAVE TAD TEMP2 /ADD TO SUM ISZ COUNT1 /DONE? JMP .-2 /NO ZEROM, JMP PRESLT /PUSH RESULT /
/ELCTAB TRANSFERS HERE IF ELC=10, POP TOP 2, DIVIDE, PUSH 12 BIT RESULT ELC10, JMS POP2 /POP2 TAD TEMP1 SNA /0? E27==.; JMS I COS8ER /DIVIDE BY ZERO CIA /NO, MAKE - DCA TEMP1 /SAVE DCA COUNT1 /0 COUNT TAD TEMP2 /GOT DIVIDEND CLL TAD TEMP1 /SUBTRACT SNL /OVERFLOW? JMP .+3 /YES ISZ COUNT1 /NO, COUNT JMP .-5 /GO AGAIN CLA TAD COUNT1 /GET RESULT JMP PRESLT /PUSH IT / /ELCTAB TRANSFERS HERE IF ELC=11, POP TOP 2, INCLUSIVE OR, PUSH RESULT ELC11, JMS POP2 /POP 2 TAD TEMP1 /GET FIRST AND TEMP2 /MASK CIA /NEGATE JMP ADDIT /ADD ORIGINAL NUMBERS (IT WORKS) AND PUSH / /ELCTAB TRANSFERS HERE IF ELC = 12, POP TOP 2, AND, PUSH RESULT ELC12, JMS POP2 /POP 2 TAD TEMP1 /AND 1ST AND 2ND AND TEMP2 JMP PRESLT /PUSH RESULT / /ELCTAB TRANSFERS HERE IF ELC=13, POP, SHIFT LEFT, PUSH RESULT ELC13, JMS POP RAL CLL JMP PRESLT / /ELCTAB TRANSFERS HERE IF ELC=16, EXCHANGE TOP 2 ENTRIES ON THE STACK ELC16, JMS POP2 /POP TOP 2 TAD TEMP1 /GET FIRST JMS PUSH /PUSH IT TAD TEMP2 /GET SECOND JMP PRESLT /PUSH IT /ELCTAB TRANSFERS HERE IF ELC=17, POP TOP ENTRY ON STACK, /RESULT IS NEW ORIGIN RELATIVE TO CURRENT SECT ELC17, JMS POP JMP LC4A
/STARTING WITH LATEST, /WRITE OUT ALL CORE RESIDENT /BINARY FILES / / WRALL, 0 TAD (LDBUFS /SET UP BP DCA BP WRALUP, TAD BP TAD (-LDBUFS-40 SNA CLA /DONE? JMP WRADUN /YES CDF 10 TAD I BP /GET BLOCK NUMBER CDF CMA SNA /DONE? JMP WRADUN /YES CMA SNA CLA /ANY BLOCK TO WRITE? JMP .+3 /NO AC4000 /YES, WRITE IT JMS LDRIO ISZ BP /BUMP POINTER JMP WRALUP /TRY AGAIN WRADUN, ISZ I (7746 /SET BIT 11 OF JSW JMP I WRALL
/ / COME HERE TO READ-WRITE THE LOADER IMAGE / LDRIO, 0 /AC=4000 FOR WRITE, 0 FOR READ TAD (200 /ADD "1 BLOCK" DCA LDRIOC /STORE READ/WRITE JMS I (NEWBUF /COMPUTE 15 BIT BUFFER ADDRESS FROM ENTRY /IN BINARY BUFFER TABLE CDF 10 TAD I BP CDF CMA SNA /BLOCK # OK? JMP LDRIOR /NO CMA SNA JMP LDRIO /STILL NOT OK DCA LDRIOB /BLOCK # TAD I (OUTFLD /AND FIELD TAD (-CDF /SUBTRACT OFF CDF INSTRUCTION TAD LDRIOC /ADD IN READ/WRITE AND BLOCK2 DCA LDRIOC /STORE R/W+BLOCK CNT + FLD BITS TAD BLKBEG /START OF BINARY DATA DCA LDRIOA /STORE IN CALL JMS I CIOHAN /DF MUST BE ZERO HERE FILE, OTFL /LOADER IMAGE FILE LDRIOC, 0 /R/W + BLOCK CNT + FLD LDRIOA, 0 /ADDRESS LDRIOB, 0 /BLOCK NUMBER LDRIOR, JMP I LDRIO /NULL BUFFER XFER ADDRESS AND EXIT / /CODE TABLE CODTBL, ASIS /0 - LOAD AS IS REL12 /1 - ADD BASE OF CURRENT SECT TO ENTRY REL7B /2 - 7 BIT RELOCATION SLC /3 - SPECIAL LOADER CODE PAGE
/PUSH SUBROUTINE PUSH, 0 DCA I IN /STORE WORD TO BE PUSHED TAD IN /MOVE CURRENT POINTER DCA SOUT ISZ IN /BUMP CURRENT POINTER TAD IN TAD SBOTTOM SMA CLA /AT END OF STACK? E28==.; JMS I COS8ER /YES, ERROR, STACK FULL JMP I PUSH /OK / / IN, STACK SBOTTOM, -BSTAK / / POP, 0 TAD SOUT SNA JMP .+3 TAD (-STACK SPA CLA /STACK UNDERFLOW? E29==.; JMS I COS8ER /YES, ERROR TAD I SOUT /NO, GET ENTRY DCA TEMP3 /SAVE TAD SOUT /MOVE CURRENT POINTER DCA IN CMA /DECREMENT CURRENT POINTER TAD SOUT DCA SOUT TAD TEMP3 /RETURN WITH VALUE IN AC JMP I POP / /START PASS 2 PTWO, DCA RELBLK /ZERO RELATIVE BLOCK OF LSD / TAD (INBUF /SET UP INPTR TO START OF BUFFER DCA INPTR JMS REMOD /READ MODULE AC2 /COMPUTE ADDRESS OF WORD 3 ENTRY (LIBRARY FLAG) TAD MODPTR DCA TEMP1 TAD I TEMP1 /GET WORD 3 OF MODTAB ENTRY CDF 0 DCA LIBFLG /SAVE IN LIBFLG IAC DCA LIBMOD /SET LIBMOD TO 1 TAD LIBFLG SPA CLA /IS IT A LIBRARY?
NXTLIB, JMS LIBREL /YES TAD INPTR DCA LSDSTR /INITIALIZE STARTING LOC OF LSD CDF 10 JMS IPTRTB /INITIALIZE PTR TABLE JMS PROBOT /BYPASS LSD HEADER, PROCESS THE LSD NXTLB1, JMS BUMINP /BUMP INPTR TO TOP OF NEXT BLOCK GOREL, TAD I INPTR /GET HEADER WORD SMA CLA /TEXT? JMP NXTLB1 /NO, TRY NEXT BLOCK ISZ INPTR /BUMP POINTER PAST HEADER WORD JMS RELOCA /PROCESS THE RELOCATABLE BINARY TAD LIBFLG SMA CLA /PROCESSING LIBRARIES? JMP GOREL1 /NO JMS BUMINP /YES, BUMP INPTR TO TOP OF NEXT BLOCK CDF 0 JMP NXTLIB /GET NEXT LIBRARY GOREL1, JMS ADVOVR /GET NEXT MODULE JMP PTWO /PROCESS IT TAD OPTAB RAL SPA CLA /DOING .BN FILE? JMP PCLOSE /YES JMS WRALL /DONE ALL MODULES, WRITE THEM OUT GOREL2, CIF 10 JMS I USR /USR IN 10 TAD OUTFIL /DEVICE # OF OUT FILE CIF 10 JMS I (200 4 /CLOSE OUTPUT FILE OUTFIL+1 /NAME OF OUTPUT FILE LDCLEN, 0 /LEN OF FILE E30==.; JMS I COS8ER /CLOSE ERROR
TAD OPTAB / /G? (GO) AND (40 SNA CLA JMP I (7600 /NO, RETURN TO MONITOR CDF 10 /YES TAD I (OTFL+1 /SET UP TO DCA I (7620 /CALL ABSLDR TAD OUTFIL DCA I (7617 DCA I (7621 TAD (7641 DCA XR0 /SET UP POINTER AC4000 TAD STRTFD DCA I XR0 /4000+FLD INTO 7642 (ALT MODE) TAD GI DCA I XR0 /G,I INTO 7643 DCA I XR0 /0 INTO 7644 DCA I XR0 / 7645 TAD STRTAD DCA I XR0 /STARTING ADDRESS INTO 7646 IAC CIF 10 CDF 0 JMS I (200 /CALL USR 2 /LOOKUP ARG1, ABSNAM SOUT, 0 E31==.; JMS I COS8ER /ERROR, ABSLDR NOT FOUND TAD ARG1 JMP CHAINF /CHAIN TO ABSLDR GI, 50 /G,I FOR ABSLDR, CHANGED TO 40 IF .BN FILE / PAGE
/ BUMINP, 0 TAD INPTR /GO TO TOP OF NEXT OS8 BLOCK TAD (400 AND (7400 DCA INPTR TAD INPTR TAD (-ENDBUF SPA CLA /IF POS, REACHED END OF BUFFER JMP BUMXIT TAD (INBUF /RESET POINTER DCA INPTR JMS I (REMOD /AND READ NEXT PORTION OF MODULE BUMXIT, JMP I BUMINP /
/ ELCTAB, ELC0 /ELC = 0, END OF TEXT EXIT RELOCA ELC1 / 1, NEXT WORD IS 12 BIT ORIGIN ELC2 / 2, POP A WORD FROM STACK AND LOAD IT ELC3 / 3, PUSH NEXT WORD ONTO STACK ELC4 / 4, NEGATE TOP OF STACK ELC5 / 5, ADD ELC6 / 6, SUBTRACT ELC7 / 7, MULTIPLY ELC10 / 10, DIVIDE ELC11 / 11, INCLUSIVE OR ELC12 / 12, EXCLUSIVE OR ELC13 / 13, LEFT SHIFT ELC14 / 14, PUSH LEVEL AND OVERLAY OF CURRENT SECT ELC15 / 15, ABSOLUTE ORIGIN ELC16 / 16, SWITCH TOP 2 ENTRIES ON STACK ELC17 / 17, POP A WORD FROM STACK, MAKE IT THE NEW ORIGIN
/ BYTSWP, 0 RTR RTR RTR JMP I BYTSWP / / LCTAB, LC0 /LC = 0, EXTENDED LOADER CODE LC1 / 1, 12 BIT RELOCATION NEXT WORD DATA, / ADD VALUE OF LSD WORD THAT IS REFERENCED LC2 / 2, THE NEXT WORD IS DATA, ADD THE FIELD / OF THE LSD WORD THAT IS REFERENCED (LEFT 3) LC3 / 3, LOAD A ZBLOCK, THE LSD REFERENCE FIELD / CONTAINS LENGTH OF BLOCK IN 1'S COMP. NEXT WORD IS DATA LC4 / 4, BEGIN (OR CONTINUE) LOADING DATA / FOR SECT SECIFIED BY LSD REFERENCE LC5 / 5, NEXT WORD IS DATA, ADD VALUE OF LSD WORD / REFERENCED THEN VERIFY LSDREF BETWEEN 0 AND 177, SUM LC6 / 6, NEXT WORD IS CONSTANT, ADD TO LSD / REFERENCE, PUSH RESULT ON STACK LC7 / 7, LSD FIELD CONTAINS 8 BIT CONSTANT, / PUSH IT ONTO STACK LC10 / 10, PUSH THE INTRUCTION FIELD OF THE LSD / REFERENCE ONTO STACK LC11 / 11, POP A VALUE OFF THE STACK. RESULT IS A / NEW VALUE OF LSD REFERENCE. MUST BE GLOBAL SYMBOL LC12 / 12, PUSH THE VALUE OF THE LSD REFERENCE / ONTO THE STACK LC13 / 13, PUSH I.F. OF LSDREF,REARRANGED, ONTO STACK LCERR / 14, ERROR LCERR / 15, ERROR LCERR / 16, ERROR LCERR / 17, ERROR /
/HERE IF PROCESSING A LIBRARY FILE/ LIBREL, 0 CDF TAD I LIBPTR /GET ENTRY FROM LIBTB CDF 10 AND LIBMOD DCA TEMP1 TAD LIBMOD /MOVE BIT LEFT 1 FOR CLL RAL /NEXT LIBRARY ENTRY SNA IAC DCA LIBMOD SZL /IF PUSHED INTO LINK ISZ LIBPTR /DUMP POINTER TAD TEMP1 SZA CLA /INTERESTED IN THIS MODULE? JMP I LIBREL /YES - GO PROCESS IT JMS SKPLIB /NO- JUMP OVER THE WHOLE THING JMP LIBRL1 /END OF FILE JMP LIBREL+1 /TRY AGAIN LIBRL1, ISZ LIBPTR /BUMP POINTER JMP GOREL1 /GO ON TO NEXT FILE LIBMOD, 0 /BIT WHICH TELLS IF WE WANT THIS MODULE / /HERE TO GET NEXT MODULE ADVOVR, 0 JMS ADVPTR /GET NEXT MODULE SKP /NOT DONE ISZ ADVOVR /HAD GOTTEN LAST MODULE ADVXIT, JMP I ADVOVR /EXIT CALL+2 /ELCTAB TRANSFERS HERE IF ELC=1, NEXT WORD IS AN ORIGIN RELATIVE /TO THE BASE OF THE CURRENT SECT ELC1, JMS NXTTXT /GET NEXT WORD TAD TXTWRD /ADD ORIGIN JMP LC4A /TO CURRENT SECT START / /ELCTAB TRANSFERS HERE IF ELC=15, NEXT WORD IS AN ABSOLUTE ORIGIN ELC15, JMS NXTTXT /GET NEXT WORD TAD TXTWRD /GET ABSOLUTE ORIGIN JMP LC4A+1 /SET TO THAT ADDRESS / /LCTAB TRANSFERS HERE IF LC=13, PUSH REARRANGED I.F. BITS OF LSDREF ONTO STACK /(FOR XEDF INSTRUCTION) LC13, TAD LSDREF /GET LSDREF JMS GETREF /GET GST NUMBER JMS I CCGSTA /CALCULATE GST ADDRESS TAD (5 TAD GSTADR JMS I CGGST /GET WORD 6 (FIELD) JMS FLD80 /REARRANGE BITS FOR XEDF JMP CONLC /PUSH ONTO STACK
/ELCTAB TRANSFERS HERE IF ELC=14, PUSH LEVEL AND OVERLAY OF SECT ONTO STACK ELC14, TAD OVRL /GET LEVEL AND OVERLAY JMP CONLC /PUSH ONTO STACK FILMES, TEXT "IMAGE OVERFLOW" STSYM, TEXT "SWPTAB" *.-1 TRANV, TEXT "TRANVC" *.-1 XFERVM, TEXT "XFERV" / PAGE /
/ /BUILD TRANSFER VECTOR TABLE BULDTV, 0 TAD TRNCNT SNA CLA /ANY TRANSFER VECTORS NEEDED? JMP I BULDTV /NO JMS SFOR /SEARCH FOR SWAP TABLE STSYM /IN GST JMS NEWORG /SET TO ADDRESS FOUND TAD (LHDR-1 /SETUP TO ACCESS LOADER HEADER INFO BUFFER DCA XR6 TAD (-40 DCA COUNT1 CDF 10 TAD I XR6 /GET WORD FROM LDHR BUFFER JMS PUTBIN /PUT IN BINARY IMAGE ISZ COUNT1 /DONE ALL 40? JMP .-4 /NO, GET NEXT TAD OPTAB+1 RAR SZL CLA /RTS8 SYSTEM (/X) ? JMP I BULDTV /YES, DON'T DO REST OF STUFF JMS SFOR /SEARCH FOR TRANS. VECTOR TRANV TAD TEMP1 DCA TRNADR /SAVE ADDRESS OF TRANSFER VECTOR TABLE TAD TEMP4 DCA TRNFLD /SAVE FIELD OF TRANSFER VECTOR TABLE JMS NEWORG /SET TO THAT ADDRESS JMS SFOR /SEARCH FOR XFERVM /XFERV TAD TEMP1 AND (377 DCA FLGWRD /SAVE ADDRESS OF XFERV DCA TRNCNT /0 TRANSFER VECTOR COUNT TAD GSTCDF DCA GCDF TAD GST /START AT BEGINNING OF GST DCA GSTPTR /& SEARCH FOR ALL TV FLAGS
NXTTRN, TAD (7 /GET WORD WITH TV FLAG TAD GSTPTR /(WORD 10) JMS I CGGST SMA CLA JMP BUMPIT /NOT FLAGED TRY NEXT TAD TRNCNT TAD (10 /BUMP TRANSFER VECTOR COUNT SNA /0? JMP TOMANY /YES, TOO MANY TRANSFER VECTORS DCA TRNCNT /NO, ALL OK AC2000 /SET AC TO 2000 TAD FLGWRD JMS I (PUTBIN /1ST WRD =ISZ XFERV, "PUNCH IT" TAD FLGWRD TAD (4401 /2ND WRD=JMS I XFERV+1, "PUNCH IT" JMS I (PUTBIN AC3 /SET UP FOR TAD GSTPTR /WORD 4 IN GST DCA GSTADR TAD TRNCNT /GET TRANSFER VECTOR COUNT JMS I CPUTG /PUT IN WORD 4 OF GST IAC /GET WORD 6 (FIELD) TAD GSTADR JMS I CGGST DCA BFLD /SAVE IT TAD BFLD AND (30 SNA CLA /ANY EXTRA FIELD BITS SET? JMP .+5 /NO JMS NFERR /YES, WARN OPERATOR CAUT TAD .-3 DCA .-3 /ONCE TAD BFLD TAD (3760 /PROPOGATE HIGH ORDER BIT TO AC0 AND (4017 TAD (1770 /PROPOGATE LOW ORDER BIT TO AC1 AND (6007 DCA BFLD /PUT BACK TAD GSTADR /GET WORD 7 IAC JMS I CGGST DCA TXTWRD /(ADDR) IAC /NOW GST WORD 10 TAD GSTADR JMS I CGGST /LEVEL & OVERLAY AND (177 CLL RTL RAL /SQUISH TOGETHER TAD BFLD /3RD WRD =OVERLAY &FLD JMS PUTBIN /"PUNCH IT" TAD TXTWRD JMS PUTBIN /4TH WRD = ADDR, "PUNCH IT"
BUMPIT, JMS INCPTR /INCREMENT TO NEXT GST ENTRY JMS TSTBOT /END OF GST? JMP NXTTRN /GO AFTER NEXT TV JMP I BULDTV /YES, EXIT TOMANY, JMS NFERR /TOO MANY TRANSFER VECTORS TOMESS JMP BUMPIT TOMESS, TEXT "TOO MANY XFER VECTORS" BFLD, 0 PAGE
.ENTRY MORCCB MORCCB, DCA CURBLK CDF /FORCE DF=0 TAD OPTAB RAL SPA CLA /DOING .BN FILE? JMP POPEN /YES TAD CURBLK /SINCE WE KNOW CLL RTL /THE BLOCK SIZE SZL SPA CLA /LET'S TELL THEM RTL /UNLESS SZL /IT"S >255 CLA TAD OUTFIL CIF 10 JMS I USR 3 /ENTER OUTPUT FILE LDRBLK, OUTFIL+1 LDRLEN, 0 JMP I (ENTERR /ERROR IN OPENING FILE TAD CURBLK /SEE IF LOADER IMAGE STL /WILL FIT TAD LDRLEN /ON TENTATIVE FILE SZL SNA CLA JMP .+3 JMS I CFERR /SORRY CHARLIE, TOO SMALL FILMES TAD CURBLK DCA I (LDCLEN /SET UP DATA FOR CLOSING .SV FILE TAD OUTFIL CDF 10 DCA I (OTFL TAD LDRBLK /SO IT CAN BE USED DCA I (OTFL+1 /TO WRITE OUT BLK CDF 0 TAD (QUSRLV-1 /SET UP TO ACCESS OVERLAY SUPPORT DATA DCA XR0 DCA I XR1 /CLEAR OUT CCB TO END TAD XR1 TAD (-CCB-377 SZA CLA JMP .-4 TAD (CCB+137 /SET UP TO STORE OVERLAY DATA DCA XR1 TAD (-40 DCA COUNT1 CDF 10 TAD I XR0 CDF DCA I XR1 ISZ COUNT1 JMP .-5
TAD I (CCB+5 /GET 1ST 2 WORD PAIR FCW AND (6 SZA CLA /ABOVE FIELD 7? AC4000 /YES, COMPLEMENT BIT 0 TAD I PCCB DCA I PCCB JMS I CIOHAN OTFL 4200 /WRITE PCCB, CCB /PG OF CCB + OVERLAY DATA + 0'S 0 TAD (LDBUFS-1 DCA FNDPTR /INITIALIZE POINTER JMS INTBLK /INITIALIZE BLOCKS PCCB2, JMS CMBST /MAKE BIN SECT TABLE FOR MAIN /SET UP TABLE THAT RELATES /BINARY SECTINS TO LDR /IMAGE RELATIVE BLOCK NUMS. /1 DBL WD AND 2 SINGLE-WD ARGUMENTS PER /SECTION (17 BIT ADDR, RELATIVE /BLOCK, AND LENGTH). THERE ARE /8 SECTIONS /(MAIN, LEVL1,....,LEVL7) /TABLE STARTS AT LHDR AND /IS USED BY SUBR NEWORG TAD (LHDR-1 /SET UP ACCESS TO LOADER HEADER BUFFER DCA XR1 /SET UP ACCESS TO OVERLAY SEGMENT DATA TAD (QUSRLV-1 DCA XR0 TAD (-10 DCA TEMP4 /NOW DO THE 8 LEVELS CDF 10 SETSLP, ISZ XR0 /SKIP OVER OVERLAY COUNT TAD I XR0 /GET OVERLAY ADDRESS, FIELD DCA BSECTP /SAVE TAD I XR0 /GET RELATIVE STARTING BLOCK NUMBER DCA TEMP1 /SAVE THAT TAD BSECTP /WE WILL EXTRACT FIELD FIRST AND (37 DCA I XR1 /FIRST COMES 17-BIT ADDRESS, FIELD GET STORED IN LHDR TAD I XR0 /GET LENGTH OF LEVEL DCA TEMP2 /AND SAVE TAD BSECTP AND (7400 DCA I XR1 /PAGE ADDRESS, STORE LHDR TAD TEMP1 DCA I XR1 /RELATIVE BLOCK, STORE IN LHDR TAD TEMP2 DCA I XR1 /THEN LENGTH INTO LHDR AS BLOCKS ISZ TEMP4 /DONE ALL 8 LEVELS (MAIN + 7 OVERLAY LEVELS)? JMP SETSLP /NO, GO TO NEXT
INITP2, TAD (LHDR /PTR TO TOP DCA BSECTP /OF TABLE CLA CMA /SET FLG DCA PASS2 /FOR SUBR ADVOVR CDF JMS BULDTV /BUILD UP TRANSFER VECTORS TAD (LIBTB /SETUP POINTER INTO LIBRARY TABLE DCA LIBPTR DCA OVRL /ZERO OVERLAY # JMS IMTP /INITIALIZE MODULE TABLE POINTER JMP I .+1 PTWO /START PASS 2 / PAGE
/CREATE "MAIN" BINARY SECTION TABLE CMBST, 0 IAC /ADD 1 DCA RELBLK /STORE AS RELATIVE BLOCK TAD I (CCB RAL; CLL CML RAR /FORCE H O BIT ON DCA COUNT1 /SETUP SECTION COUNT TAD (CCB+3 DCA XR7 /SETUP POINTER TO CCB TEMP STORAGE TAD (MBST-1 /SET UP POINTER TO MAIN BINARY SECTION TABLE DCA XR6 TAD (-100 DCA TEMP1 /CLEAR OUT 1ST 64 WORDS OF MBST DCA I XR6 ISZ TEMP1 JMP .-2 NXT, TAD I XR7 /GET ORIGIN DCA TEMP1 TAD I XR7 /GET PGS AND FIELD DCA TEMP2 TAD TEMP2 JMS FLD95 /EXTRACT FIELD AND POSITION DCA TEMP3 TAD TEMP3 /COMPUTE COUNT LOCATION OF MBST RAL CLL TAD (MBST DCA POINT1 CMA /DECREMENT COUNT TAD I POINT1 DCA I POINT1 ISZ POINT1 /BUMP TO POINTER TAD I POINT1 SZA CLA /IS POINTER EMPTY? JMP .+4 /NO IAC /YES, STORE IN ADDRESS TAD XR6 /OF FIRST 4-WORD ENTRY DCA I POINT1 TAD TEMP3 DCA I XR6 /STORE FIELD IN MBST TAD TEMP1 DCA I XR6 /STORE ADDRESS IN MBST TAD TEMP2 /COMPUTE # OF RECORDS JMS BYTSWP AND (37 SNA TAD (37 DCA TEMP2 TAD TEMP2 IAC RAR CLL DCA TEMP1 /SAVE # OF BLOCKS TO XFER TAD RELBLK DCA I XR6 /STORE RELATIVE BLOCK NUMBER IN MBST
TAD TEMP1 TAD RELBLK DCA RELBLK TAD TEMP2 DCA I XR6 /STORE # OF BLOCKS IN MBST ISZ COUNT1 JMP NXT JMP I CMBST /ABCDE TO ACDEB00 FLD59, 0 CLL RAL /MOVE AC LEFT 1 TAD (7740 /PUT "A" IN LINK AND (37 /CLEAR UNUSED BITS TAD (3760 /PUT "B" IN AC0 SPA /"B"? IAC /YES, PUT "B" IN AC11 AND (17 /MASK OFF GARBAGE SZL /"A"? TAD (20 /YES, PUT "A" IN 7 CLL RTL /LEFT 2 JMP I FLD59 /DONE /ABCDE TO CDEBA0 FLD80, 0 CLL RAL /MOVE AC LEFT 1 TAD (7740 /PUT "A" IN LINK AND (37 /CLEAR UNUSED BITS TAD (3760 /PUT "B" IN AC0 SPA /"B"? IAC /YES, PUT "B" IN AC11 RTL /PUT "B" IN 9, "A" IN 10 AND (76 /MASK OFF UNWANTTED BITS JMP I FLD80 /DONE /CDEBA0 TO ABCDE FLD95, 0 AND (76 /MASK OFF UNWANTED BITS RTR CLL; RAR /MOVE "A" TO AC0, "B" TO LINK SZL /"B"? TAD (10 /YES, PUT "B" IN AC8 SPA /"A"? TAD (4020 /YES, PUT "A" IN AC7, CLEAR AC0 JMP I FLD95 /DONE
CAUT, TEXT "CAUTION - ENTRY POINT ABOVE FIELD 7" /ELCTAB TRANSFERS HERE IF ELC=2, POP WORD FROM STACK AND LOAD IT ELC2, JMS POP JMP OUTP PAGE
BADORG, CLA TAD BSECTP TAD (-LHDR SZA CLA /DOING MAIN? JMP BADERR /NO, ORIGIN OUT OF RANGE AC4 /YES, BUMP POINTER TAD MPTR DCA MPTR /INTO MBST TAD MPTR /GET NEW ADDRESS ISZ MCTR /BEYOND END? JMP NEWOR1 /NO, RETURN ADDRESS TO NEWORG CLA /YES, ERROR, CLEAR AC BADERR, CMA /INHIBIT OUTPUT DCA OUTINH JMP ORGXIT /
/ /GET NEXT TEXT WORD, STORE IN TXTWRD NXTTXT, 0 TAD INPTR AND (377 SZA CLA /CROSSING 400 WORD BOUNDRY? JMP GETWRD /NO TAD INPTR /YES, END OF INPUT BUFFER? TAD (-ENDBUF SZA CLA JMP GETWRD-3 /NO, BUMP POINTER AROUND HEADER WORD JMS REMOD /YES, READ NEW BUFFER TAD (INBUF DCA INPTR /RESET INPTR TO BEGINNING OF BUFFER ISZ INPTR /BUMP POINTER AROUND HEADER WORD STA DCA FLGCNT /MAKE IT LOOK LIKE END OF FLGWRD GETWRD, CDF 10 TAD I INPTR /GET NEXT TEXT WORD CDF 0 DCA TXTWRD /SAVE IT ISZ INPTR /INCREMENT TO NEXT TEXT WORD JMP I NXTTXT /EXIT /
NOTZER, JMS NFERR NOZMES JMP LC5A / NOZMES, TEXT "PAGE 0 REF NOT ON PAGE 0" / /MORE OF NEWBUF NEWBF2, 0 DCA BLKBEG /SAVE ADDRESS TAD OPTAB+2 AND (4000 SZA CLA /USE 7600? JMP I NEWBF2 /YES TAD BLKBEG /NO TAD (-7400 SZA CLA /DOES IT USE BUFFER STARTING AT 7400? JMP I NEWBF2 /NO CDF 10 /YES, ERROR DCA I BP /RESET JMP NEWBB2 /SELECT ANOTHER BUFFER /
/HERE TO FIX UP CORE IMAGE DATA FOR NEW SECT FIXDAT, 0 TAD OVRL /GET CURRENT OVERLAY-LEVEL NUMBER AND (160 /MASK TO LEVEL RTR CLL TAD (LHDR /FORM ENTRY IN LHDR DCA BSECTP /SET UP BSECTP CMA TAD BSECTP DCA XR0 /SET UP AUTO INDEX REG TAD (CIDAT-1 DCA XR1 /SET UP STORAGE POINTER (-1) TAD (-4 DCA XR2 /SET UP COUNTER CDF 10 /MOVE 4 DATA WORDS TAD I XR0 CDF DCA I XR1 ISZ XR2 JMP .-5 TAD OVRL AND (17 /FORM CURRENT OVERLAY NUMBER SNA /0? JMP FIXDT1 /YES, NO MULTIPLICATION NEEDED CIA /MAKE - DCA TEMP3 /SAVE TAD I (CIDAT+3 /GET LENGTH OF OVERLAY IAC /CONVERT TO BLOCKS CLL RAR DCA TEMP2 /SAVE TAD TEMP2 /MULTIPLY BY NUMBER OF OVERLAY ISZ TEMP3 JMP .-2 FIXDT1, TAD I (CIDAT+2 /ADD IN STARTING POINT OF LEVEL DCA I (CIDAT+2 /STORE AWAY RESULT JMP I FIXDAT /DONE OLLERR, TEXT "OVERLAY-LEVEL" /OVERLAY-LEVEL ERROR - LOWER THAN ALLOWED PAGE
/COME HERE TO STORE 1 WORD /IN SOME OUTPUT BUFFER PUTBIN, 0 DCA TEMP2 /SAVE TAD OUTINH K7640, SZA CLA /INHIBIT OUTPUT? JMP I PUTBIN /YES TAD OPTAB RAL SPA CLA /DOING .BN FILE? JMP PBIN /YES TAD TEMP2 /NO OUTFLD, 0 /CDF X DCA I BLKSIZ /STORE IT AWAY CDF 0 ISZ BLKSIZ TAD BLKSIZ AND (377 /HAVE WE CROSSED SZA CLA /A BLOCK BOUNDRY? JMP PUTBN1 /NO ISZ NEWBLK /YES, BUMP BLOCK NUMBER JMS NEWBB /SELECT A NEW BUFFER TAD BLKBEG DCA BLKSIZ /RE-INITIALIZE WORD POINTER PUTBN1, ISZ CURLOC /BUMP CURLOC NOP /FILLER JMP I PUTBIN /EXIT PBIN, CLL JMS PUNBIN /PUNCH BINARY JMP PUTBN1 /BUMP CURLOC, EXIT /PUNCH BINARY PUNBIN, 0 TAD TEMP2 /GET WORD TO PUNCH RTR; RTR; RTR /6 RIGHT AND (177 /MASK TO 6 MSB'S AND ORG BIT DCA TEMP4 TAD TEMP4 TAD CHKSUM DCA CHKSUM /ADD TO CHECKSUM TAD TEMP4 JMS OCHARA TAD TEMP2 /GET WORD AGAIN AND (77 /MASK TO LSB'S DCA TEMP4 TAD TEMP4 TAD CHKSUM DCA CHKSUM TAD TEMP4 JMS OCHARA JMP I PUNBIN
/PUNCH ORIGIN PUNORG, TAD TEMP4 CIA TAD ORIGIN SNA CLA /HAS THIS FIELD BEEN PUNCHED BEFORE? JMP PUNOR1 /YES TAD TEMP4 /NO DCA ORIGIN TAD ORIGIN AND (30 /MASK TO MSB'S TAD (300 JMS OCHARA /PUNCH IT TAD TEMP4 AND (7 /MASK TO LSB'S RTL CLL; RAL /3 LEFT TAD (300 JMS OCHARA /PUNCH IT PUNOR1, TAD TEMP1 DCA TEMP2 /SET UP TO PUNCH ORIGIN CLL CML /SET LINK JMS PUNBIN /PUNCH IT JMP ORGXIT /EXIT ORIGIN, -1 /PUNCH CHECKSUM CHKSM, POPEN1 TAD CHKSUM DCA TEMP2 /SET UP TO CLL JMS PUNBIN /PUNCH IT CHKSM1, TAD K7640 DCA CHKSUM TAD (200 JMS OCHARA /PUNCH L/T ISZ CHKSUM /DONE 200? JMP .-3 /NO JMP I CHKSM /YES CHKSUM, 0 OCHARA, 0 CDF JMS OCHAR E39==.; JMS I COS8ER /ERROR JMP I OCHARA
/GET LEVEL FOR LSD REFERENCE GETLVL, 0 TAD LSDREF /GET LSD REF. JMS GETREF /CONVERT TO GST # SNA /OK? E33==.; JMS I COS8ER /NO, ERROR JMS SSEC /SEARCH SECTABLE FOR SECT# NOP TAD (4 /ADD 4 TAD POINT2 /TO POINT2 DCA POINT2 /TO POINT TO TAD I POINT2 /OVERLAY AND LEVEL AND (177 /MASK JMP I GETLVL / ABSNAM, FILENAME ABSLDR.SV ENTERR, JMS I CFERR /ENTER ERROR-USR ENTMSG ENTMSG, TEXT "ENTER ERROR" / PAGE
/OS-8 SUBROUTINES /PARAMETER ASSIGNMENT OUBUF=6600 /6600 OUCTL=4200 /2 PAGES (OCTAL) OUCD=OUTFIL /OUTPUT LIST DCB=7600+160 /DEVICE CONTROL TABLE SUBFLD=0 /SUBROUTINE FIELD
/CHARACTER OUTPUT SUBROUTINE FOR OS-8 PROGRAMS /THE ASSEMBLY PARAMETERS ARE AS FOLLOWS: / OUBUF=OUTPUT BUFFER STARTING ADDRESS / OUCTL=FUNCTION WORD OF I/O HANDLER / OUDEVH=OUTPUT HANDLER STARTING ADDRESS / OUCD=START OF OUTPUT NAME TABLE OUFLD=OUCTL&70 /OUTPUT BUFFER FIELD OOPEN, 0 /OPEN OUTPUT FILE OU7600, 7600 TAD OOPEN JMS GTFLD /GET CALLING FIELD TAD OUCDX DCA OUCDP IAC TAD OUCDX /POINT TO OUTPUT FILE NAME IN CD DCA OUCD1 TAD OUCD1 DCA OUBLK /AREA OUENTR, TAD I OUCDX CIF 10 JMS I (7700 /ENTER OUTPUT FILE 3 OUBLK, 7601 /GETS STARTING BLOCK OF HOLE OUELEN, 0 /GETS SIZE OF HOLE AVAILABLE JMP OEFAIL /FAILURE - SEE WHAT WE DID DCA OUCCNT /CLEAR CLOSING LENGTH JMS OUSETP /SET UP POINTERS SKP /NORMAL RETURN OORETN, JMP RTNCDF /ERROR RETURN TAD OUTFIL CDF 10 DCA I (OTFL /SET UP OUTPUT FILE DATA TAD OUBLK DCA I (OTFL+1 JMP RTNCDF-1 OEFAIL, TAD I OUCDX /IF LENGTH =0, GIVE OPEN ERROR AND (7760 /IF NOT, MAKE IT 0 AND TRY AGAIN SNA CLA JMP ONTERR /WAS 0 FAILED TAD I OUCDX AND (17 /MAKE IT 0 DCA I OUCDX JMP OUENTR /AND TRY AGAIN ONTERR, CLA / CLA CLL CML RAR JMP OORETN
OUTDMP, 0 /DUMP OUTPUT BUFFER DCA OUCTLW /STORE CONTROL WORD CDF SUBFLD TAD OUCCNT /IF THIS IS FIRST WRITE, START THE SNA /SEARCH FORWARD ON DECTAPE ISZ OUCTLW DCA OUREC TAD OUCTLW CLL RTL RTL RTL AND (17 /COMPUTE NUMBER OF RECORDS TO OUTPUT TAD OUCCNT //UPDATE CLOSING LENGTH DCA OUCCNT TAD OUCCNT /SEE IF CLOSING LENGTH WILL BE CLL CML /BIGGER THAN OUTPUT HOLE TAD OUELEN SNL SZA CLA JMP I OUTDMP /WILL BE TO BIG OUCDIF, CIF CDF 0 CDF SUBFLD JMS I CIOHAN /DO THE WRITE OTFL /LOADER IMAGE FILE OUCTLW, 0 OUBUF OUREC, 0 OUNOWR, ISZ OUTDMP /TAKE NORMAL RETURN JMP I OUTDMP PTP=0020
OTYPE, 0 /OTYPE LOOKS AT THE OUTPUT DEVICE # RDF TAD (CIF CDF 00 DCA OTRTN CDF SUBFLD TAD I OUCDX /AND LOOKS UP THE DCB WORD FOR AND (17 /THAT DEVICE TAD (DCB-1 DCA OUTEM CDF 10 TAD I OUTEM /GET DCB ENTRY OTRTN, HLT JMP I OTYPE OUCDX, OUCD OUTEM, 0 PAGE
OCLOSE, 0 /CLOSE OUTPUT FILE TAD OCLOSE JMS GTFLD /GET FIELD CALLED FROM JMS OTYPE /DETERMINE IF OUTPUT IS TO PTP AND (770 /IF IT IS, DONT OUTPPUT A ^Z TAD (-PTP SZA CLA TAD (232 /NOT PTP, OUTPUT ^Z AS EOF JMS OCHAR JMP OCRET /ERROR RETURN JMS OCHAR /FILL WITH 0 CHARACTER JMP OCRET FILLIP, JMS OCHAR /FILL TO BOUNDARY WITH 0 JMP OCRET JMS OTYPE /IF OUTPUT IS DIRECTORY DEVICE, FILL SPA CLA /WHOLE RECORD, ELSE HALF RECORD TAD (100 TAD (77 AND OUDWCT /ARE WE UP TO BOUNDARY YET SZA CLA JMP FILLIP /NO TAD OUDWCT TAD (OUCTL&3700 /IS THERE A FULL WRITE LEFT SNA JMP NODUMP /YES. BUT DON'T DO IT AS ^Z IS OUT TAD (4000+OUFLD JMS OUTDMP /DUMP LAST BUFFER JMP OCRET NODUMP, TAD OUCCNT /GET CLOSING LENGTH DCA LDCLEN /PUT IN CLOSE ROUTINE JMP GOREL2 /CLOSE FILE OUCD1, OUCD+1 OUCCNT, 0 /CLOSING FILE LENGTH HERE OCRET, JMP RTN+1 /ERROR OCISZ, JMP RTNCDF-1 /NORMAL RETURN OUCDP, OUCD
OUSETP, 0 /INITIALIZE OUTPUT POINTERS TAD (OUCTL&3700 CIA DCA OUDWCT /DOUBLE WORD OUTPUT COUNT TAD (OUBUF /INITIALIZE WORD POINTER DCA OUPTR TAD OUJMPE DCA OUJMP /3 WAY UNPAK SWITCH JMP I OUSETP OCHAR, 0 /OUTPUT CHARACTER ROUTINE AND (377 /ISOLATE EIGHT BITS DCA OUTEMP RDF /GET FIELD WE WERE CALLED TAD (CDF CIF /FROM DCA OUCRET OUCHAR, CDF OUFLD /GO TO DATA FIELD OF BUFFER ISZ OUJMP /BUMP CHARACTER SWITCH OUJMP, HLT /GETS JMP.,JMP.+1, ETC JMP OCHAR1 JMP OCHAR2 OCHAR3, TAD OUTEMP /THIRD CHARACTER CLL RTL /HIGH ORDER BITS GO INTO THE RTL /HIGH ORDER 4 BITS OF THE AND (7400 /FIRST OF TWO WORDS TAD I OUPOLD DCA I OUPOLD TAD OUTEMP /THE SECOND DOUBLE WORD GETS CLL RTR /THE LOW ORDER BITS OF RTR /THE THIRD CHARACTER RAR AND (7400 TAD I OUPTR DCA I OUPTR TAD OUJMPE /RESET CHARACTER SWITCH DCA OUJMP ISZ OUPTR /POINT TO NEXT BUFFER WORD ISZ OUDWCT /BUMP DOUBLE COUNT AFTER /THREE CHARACTERS. JMP OUCOMN /GET OUT TAD (OUCTL /READY TO OUTPUT A BUFFER JMS OUTDMP /OUTPUT IT JMP OUCRET /AN ERROR JMS OUSETP /RESET OUTPUT POINTERS JMP OUCOMN /GET OUT OCHAR2, TAD OUPTR /POINT TO FIRST DOUBLE WORD DCA OUPOLD ISZ OUPTR /POINT OUPTR TO SECOND OCHAR1, TAD OUTEMP DCA I OUPTR OUCOMN, ISZ OCHAR /NORMAL EXIT OUCRET, CIF /ERROR EXIT JMP I OCHAR OUTEMP, 0 OUPOLD, 0 OUPTR, 0 OUJMPE, JMP OUJMP OUDWCT, 0
CHAINF, DCA GTFLD /CHAIN TO ABSLDR CIF 10 JMS I (200 6 GTFLD, 0 /GET CALLING FIELD DCA RTN /SAVE RETURN PC RDF TAD (CDF CIF DCA RTNCDF CDF SUBFLD JMP I GTFLD ISZ RTN RTNCDF, HLT JMP I RTN RTN, .-1 CLA JMP RTNCDF



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