TITLE LNKNEW - LOAD NEW BLOCKS MODULE FOR LINK SUBTTL D.M.NIXON/DMN/JLd/TXR/JNG/DZN/PAH/PY/HD 9-Sep-85 ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1985,1986. ALL RIGHTS RESERVED. ; ; ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ; ; ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ; ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC,OVRPAR ;[1704] SALL ENTRY LNKNEW EXTERN LNKSCN,LNKLOD,LNKCOR,LNKWLD,LNKLOG,LNKCST CUSTVR==0 ;CUSTOMER VERSION DECVER==6 ;DEC VERSION DECMVR==0 ;DEC MINOR VERSION DECEVR==2367 ;DEC EDIT VERSION SEGMENT ;LOCAL ACC DEFINITIONS INTERN R,RB,WC R=R1 ;CURRENT RELOCATION COUNTER RB=R+1 ;RELOCATION BYTE WORD WC=R3 ;WORD COUNT SUBTTL REVISION HISTORY ;START OF VERSION 1A ;52 ADD ASCIZ TEXT BLOCK ;START OF VERSION 2 ;141 TURN ON AND FIX BUGS IN ASCII TEXT BLOCKS ;START OF VERSION 2B ;253 Correct problems with ASCII blocks: make work with ; CCL entry; cause multiple line blocks to not lose ; characters by initializing byte pointer once (here). ;404 Re-insert edits 344 and 340, which got lost. ;405 Recover if EOF encountered while reading ASCII text. ;411 Don't try to free core here that was freed in LNKSCN. ;START OF VERSION 2C ;454 Allow (but ignore) the trace blocks from MAKLIB. ;471 Add code for ALGOL debugging system. ;517 Make first word of ALGOL symbol file be 1044,,count. ;530 Get definition of triplet flag bits right. ;534 Store files from the same .TEXT block in the right order. ;557 Clean up the listing for release. ;START OF VERSION 3A ;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560) ;START OF VERSION 4 ;731 SEARCH MACTEN,UUOSYM ;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765) ;Start of version 5I ;1000 Add Block 1070 ;START OF VERSION 4A ;1174 Label and clean up all error messages. ;1212 Use E$$NEB instead of EOFTS label in T.1003 (in an off conditional). ;1217 Clean up the listings for release. ;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220). ;1303 Change the LNKLNM message to also include the file name. ;START OF VERSION 5 ;1405 New blocks T.1010 thru T.1134 and supporting routines added. ;1426 Delete redundant T.1042-T.1044 routines introduced during merge. ;1430 Remove .NWBLK conditionals forcing an error from T.1060 blocks, ; and ignore them. ;1434 New block type 1004 ( byte pointer initialization ) added. ;1440 Apply edit 1240,1237, and 1120 to the new blocks. ;1443 Make sure PDV .REL blocks aren't in LINK-10. ;1445 Typo in block type 1004 corrected. ;1452 Lengthen LITYPE bounds to include all new blocks. ;START OF VERSION 5A ;1467 Change D.IN1 call to D.CNT at T1004C. ;1470 Correct stack discipline in T.1004 and make sure there are ; no index registers on return from T.1S6 ;1471 Remove use of T.11XX and PB.1 from type 1130 blocks, which ; have no relocation words, also alter type 112x block to ; handle just one relocation byte. ;1472 Get the right number of chars for a function name and ; don't lose the count, in T.112X. Use symbols for the ; offsets. Also clean up the dispatch macros. ; ;1500-1677 Reserved for Maintenance ;1503 Make 1010-1034 blocks do thirty-bit reloc on their start addresses. ; ;1510 Test for include mode at LNKNEW+4. ;1701 Correct typos in T.1130 introduced during V5A source merge. ;1704 Handle Type 1045 block. ;1706 Handle COMMONs in Type 1045 properly. ;1707 Correct typo in 1706. ;1712 Call WRTPTR not WRTDAT at T1045C+3. ;1714 Remove increment of RC.CV in TNYBTL, this should be done at ; end of module. ;1720 Change POPJ to POP at REL.TB+2. ;1721 Correct space initialization at TNYBTB+17. ;1722 Fix RLADD not to lose right half is left half is absolute. ;1726 Fixes to 101X block processing to speed up loops and avoid some ; boundary errors. ;1730 Test limit values and handle overlays okay in Type 101x block ; processing. ;1742 Don't lose the section number when calling T.1AD from T.1004. ;1745 Don't lose T4 across the call to DY.GET in T.1045 processing. ;1754 Type 1072 block support. ;1770 Change JRST CPOPJ to POPJ P, at TSTSEG+5 ;1776 Change call to T.1AD from T.1004, include call in T.1010-1034. ;2005 Store module name for 112x blocks. ;2007 Give the LNKUCB message a long error message. ;2020 Add a word to the typechecking blocks for linking them together. ;2022 Change tests at T1045C to terminate more surely. ;2026 Update copyright and cleanup listings. ;2031 Don't set the writable bit in OVERLW unless actually doing overlays. ;2072 Skip unused byte when relocating the address in type 102X blocks. ;2073 Add contents of WRTDAT, not address of WRTDAT in WRTPTR. ;Start of Version 6 ;2200 Use 30 bit addresses in fixup blocks for SY.CHP ;2205 Don't add 30 bit address to 18 bit byte pointer. ;2212 Fix problems with type 1072 long polish block. ;2222 Implement the type 1050, 1051, and 1052 rel blocks. ;2223 Implement the type 1131 psect redirection block. ;2231 Fix typo in edit 2223. ;2236 Keep stack straight for long symbols in type 1131. ;2246 Fix chained and additive fixups. ;2247 Allow for .LOW. not existing yet. ;2254 Remove FAIL block header chain, use 30 bit NAMPTR. ;2255 Use 30 bit addresses for LS area fixups. ;2262 Implement the 1160 data block, use common code for the 1004 block. ;2266 Don't truncate type 112x symbol names. ;2270 Allow type 112x blocks to page. ;2272 Default psects to .LOW. and .HIGH. in the type 1131 block. ;2301 Handle error from D.CNT correctly. ;2303 Push correct register in non-symbolic type 1004 blocks. ;2305 Make 1070 blocks work, Make 1002 blocks work ;2307 Fix problem with typechecking routines with six character names. ;2310 Implement the type 1074 long symbol common block. ;2313 Make type 1004 and 1160 work in overlays. ;2324 Make polish chained fixup handlers clear P1 before calling SY.CHx. ;2326 Make 1003 (long title) blocks work ;2327 Fix problem with relocation in type 1160 block. ;2333 Set flags for fixup block in 1070 code. ;2340 Check for invalid psect index in 1074. ;2343 Fix problem with sparse data below address 140. ;2345 Clean up and fix t1003 block code. ;2366 Fix type 1160 block on TOPS-10. ;2367 Do Copyright statements. SUBTTL BLOCK DISPATCH TABLES XALL NDSPTB: LITYPE (1000,1160) ;[2262] NDISPL==.-NDSPTB SALL SUBTTL DISPATCH TO NEW BLOCK TYPE ;ENTER WITH BLOCK TYPE IN T1 ;ALSO IN W1 LNKNEW: CAILE T1,1777 ;IS IT DEC SUPPLIED JRST LNKCST ;NO, TRY CUSTOMER LINK ITEMS CAIL T1,1000+NDISPL*2 ;IS IT LEGAL TYPE JRST E$$IRB## ;[1174] NO, NOT YET AVAILABLE TRNE FL,R.LIB!R.INC ;[1510] IN LIBRARY SEARCH MODE? JRST T.SRCH ;YES, IGNORE IF NOT ENTRY BLOCK TYPE HRREI T2,-<1000+NDISPL>(T1) ;OFFSET TYPE JUMPGE T2,.+2 ;IF NEGATIVE, USE RHS SKIPA T2,NDSPTB+NDISPL(T2) ;USE RIGHT HALF HLRZ T2,NDSPTB(T2) ;USE LEFT HALF JRST (T2) ;DISPATCH ;HERE IF IN LIBRARY SEARCH MODE - TEST FOR BLOCK TYPE 1001, 1002 T.SRCH: CAIN T1,1001 ;IS IT ENTRY BLOCK? JRST T.1001 ;YES, SEE IF WE WANT IT CAIN T1,1002 ;OR EXTENDED ENTRY BLOCK? JRST T.1002 CAIN T1,1003 ;TITLE BLOCK (INCASE /INCLUDE) JRST T.1003 JRST T.1000 ;IGNORE THIS BLOCK SUBTTL BLOCK TYPE 1000 - JUNK WORDS ; ---------------- ; ! 1000 ! COUNT ! ; ---------------- ; ! DATA WORD ! ; ---------------- ; ! DATA WORDS ! ; ---------------- T.1000: HRRZ T1,W1 ;GET WORD COUNT JUMPE T1,LOAD## ;JUST IGNORE T1000A: CAML T1,DCBUF+2 ;ENOUGH WORDS IN BLOCK? SOJA T1,T1000B ;NO, BUT ACCOUNT FOR INITIAL ILDB ADDM T1,DCBUF+1 ;ADVANCE BYTE POINTER MOVN T1,T1 ;NEGATE ADDM T1,DCBUF+2 ;COUNT DOWN WORD COUNT JRST LOAD## ;GET NEXT BLOCK T1000B: SUB T1,DCBUF+2 ;COUNT DOWN WORDS IN BUFFER PUSHJ P,D.INP## ;GET NEXT BUFFER JRST T1000A ;FINISH OFF BLOCK T1000C: MOVNI W1,400000(WC) ;[2262] PUT WORD COUNT IN W1 JRST T.1000 ;[2262] IGNORE REST OF BLOCK SUBTTL BLOCK TYPE 1001 - SINGLE WORD ENTRIES ; ---------------- ; ! 1001 ! COUNT ! ; ---------------- ; ! SYMBOLS ! ; ---------------- ; ! SYMBOLS ! ; ---------------- IFE .NWBLK,< T.1001==E$$IRB## ;[1174] ILLEGAL IF NOT THERE > ;END IFE .NWBLK IFN .NWBLK,< T.1001: MOVEI T2,0(W1) ;GET NUMBER OF ENTRIES IN THIS MODULE MOVE R3,T2 ;SAFE PLACE FOR COUNT DOWN JUMPE T2,LOAD## ;IGNORE 0 ENTRIES SKIPN ENTPTR ;ALREADY SOME ENTRIES FOR THIS MODULE? JRST T1001E ;NO HLRO T1,ENTPTR ;GET -NUMBER SUB T2,T1 ;NUMBER WE NEED PUSHJ P,DY.GET## ;GET IT HRLZ T3,ENTPTR ;FORM BLT PTR HRR T3,T1 HLRO T4,ENTPTR ;-NUMBER OF WORDS MOVM W3,T4 ADDI W3,(T1) ;END OF BLT BLT T3,-1(W3) ;MOVE ALL PREVIOUS ENTRIES MOVN T2,T2 ;NEGATE NEW LENGTH HRL T1,T2 ;FORM AOBJN POINTER EXCH T1,ENTPTR ;SWAP POINTERS HRRZ T1,T1 ;ADDRESS ONLY MOVM T2,T4 ;AND LENGTH PUSHJ P,DY.RET## ;GIVE SPACE BACK JRST T1001D ;HERE WHEN THIS IS THE FIRST BLOCK TYPE 1001,1002 OR 4 SEEN. T1001E: MOVN T1,T2 HRLM T1,ENTPTR ;LEFT HALF OF AOBJN PTR PUSHJ P,DY.GET## ;GET SPACE HRRM T1,ENTPTR ;FINISH POINTER HRRZ W3,T1 ;DON'T NEED W3 FOR ANYTHING T1001D: HRLI W3,(POINT 36) ;SO USE AS DEPOSIT BYTE POINTER TRNN FL,R.LIB ;IN LIBRARY SEARCH MODE JRST T1001B ;NO, JUST STORE SYMBOLS FOR LATER T1001A: SOJLE R3,LOAD## ;END OF BLOCK PUSHJ P,D.IN1## ;READ A WORD MOVE W2,W1 ;PUT SYMBOL IN SYMBOL ACC SETZ W1, ;ZERO FLAGS IDPB W2,W3 ;STORE ENTRY PUSHJ P,TRYSYM## ;SEE IF SYMBOL IS IN TABLE JRST T1001A ;NO, TRY NEXT TRZA FL,R.LIB ;UNDEF, CLEAR SKIP CONTROL JRST T1001A ;DEFINED, DON'T NEED THIS DEFINITION T1001B: SOJL R3,LOAD## ;END OF BLOCK PUSHJ P,D.IN1## IDPB W1,W3 ;STORE JRST T1001B ;LOOP > SUBTTL BLOCK TYPE 1002 - LONG SYMBOL ENTRY ; ---------------- ; ! 1002 ! COUNT ! ; ---------------- ; ! SYMBOL ! ; ---------------- ; ! MORE SYMBOL ! ; ---------------- IFE .NWBLK,< T.1002==E$$IRB## ;[1174] ERROR UNLESS FIXED > ;END IFE .NWBLK IFN .NWBLK,< T.1002: MOVEI R3,0(W1) ;GET NUMBER OF WORDS OF ENTRY IN THIS BLOCK CAIG R3,1 ;TREAT 0 AND 1 AS T.1001 JRST T.1001 ;NOT A LONG SYMBOL CAIL R3, ;[2305] IS IT LONGER THAN MAX NAME SIZE? PUSHJ P,E$$STL ;[2305] YES - GIVE ERROR MOVEI T2,1 ;NEED ONE MORE WORD FOR POINTER SKIPN ENTPTR ;ALREADY SOME ENTRIES FOR THIS MODULE? JRST T1002E ;NO HLRO T1,ENTPTR ;GET -NUMBER SUB T2,T1 ;NUMBER WE NEED PUSHJ P,DY.GET## ;GET IT HRLZ T3,ENTPTR ;FORM BLT PTR HRR T3,1(T1) ;BUT LEAVE SPACE AT TOP HLRO T4,ENTPTR ;-NUMBER OF WORDS MOVM W3,T4 ADDI W3,(T1) ;END OF BLT BLT T3,-1(W3) ;MOVE ALL PREVIOUS ENTRIES MOVN T2,T2 ;NEGATE NEW LENGTH HRL T1,T2 ;FORM AOBJN POINTER EXCH T1,ENTPTR ;SWAP POINTERS HRRZ T1,T1 ;ADDRESS ONLY MOVM T2,T4 ;AND LENGTH PUSHJ P,DY.RET## ;GIVE SPACE BACK HRRZ W3,ENTPTR ;RESET W3 TO POINT TO TOP ITEM (HOLE) JRST T1002D T1002E: MOVN T1,T2 HRLM T1,ENTPTR ;LEFT HALF OF AOBJN PTR PUSHJ P,DY.GET## ;GET SPACE HRRM T1,ENTPTR ;FINISH POINTER HRRZ W3,T1 ;DON'T NEED W3 FOR ANYTHING T1002D: MOVE T2,R3 ;[2305] get count for this entry name PUSHJ P,DY.GET## ;[2305] get the space we need MOVN T2,T2 ;[2305] negate the length HRLS T2 ;[2305] make left half of aobjn pointer HRR T2,T1 ;[2305] make right half of abojn (addres of dy ;[2305] block for name) T1002L: PUSHJ P,D.IN1 ;[2305] MOVEM W1,(T2) ;[2305] store a word AOBJN T2,T1002L ;[2305] JRST T1002B ;[2305] MOVEI T2,-1(R3) ;THESE MANY EXTRA (AFTER FIRST) WORDS ROTC T1,-1 ;CUT IN HALF SKIPGE T1 ;NO CARRY ADDI T2,1 ;EXTRA BLOCK FOR LAST WORD IMULI T2,.L ;THESE MANY WORDS IN TRIPLETS ADDI T2,.L ;PLUS INITIAL ONE HRLZM T2,0(W3) ;STORE WORD COUNT IN EMPTY SLOT TRNE T2,770000 ;UNLESS SYMBOL IS SUPER LONG ADDI T2,1 ;IN WHICH CASE ONE MORE FOR COUNT PUSHJ P,DY.GET## ;GET SPACE HRRM T1,0(W3) ;STORE POINTER ADDRESS TRNE T2,770000 ;FIX IF SUPER LONG JRST [HRRZS 0(W3) ;CLEAR COUNT MOVEM T2,0(T1) ;STORE AS FIRST WORD AOJA T1,.+1] ;PASS OVER IT HRRZ W3,T1 ;USE DATA BLOCK TO STORE ENTRY HRLI W3,(POINT 36) ;SO USE AS DEPOSIT BYTE POINTER MOVX W1,PT.SYM!PT.EXT ;SOME FLAGS IDPB W1,W3 PUSHJ P,D.IN1## ;GET FIRST 6 IDPB W1,W3 ;STORE ALSO MOVE W2,W1 ;SAVE FIRST 6 CHARS SETZ W1, ;ZERO VALUE IDPB W1,W3 T1002A: SOJLE R3,T1002B ;END OF BLOCK MOVX W1,S.LST ;CLEAR LAST TRIPLET FLAG IN PREV ANDCAM W1,-2(W3) ;SINCE WE NOW COME AFTER IT MOVX W1,S.SYM!S.LNM!S.LST ;SECONDARY FLAGS IDPB W1,W3 PUSHJ P,D.IN1## ;READ A WORD IDPB W1,W3 ;STORE SYMBOL SOJLE R3,T1002B ;END OF BLOCK PUSHJ P,D.IN1## ;NO IDPB W1,W3 ;STORE SECOND WORD JRST T1002A ;LOOP ;HERE WHEN SYMBOL STORED T1002B: HRL T1,R3 ;[2305] GET THE COUNT MOVE T2,ENTPTR ;[2305] MOVEM T1,(T2) TRNN FL,R.LIB ;IN LIBRARY SEARCH MODE JRST LOAD## ;YES, SYMBOL STORED SO GET NEXT BLOCK MOVE W2,1(W3) ;[2305] COUNT,,ADDRESS OF SYMBOL NAME TO W2 PUSHJ P,TRYSYM## ;SEE IF SYMBOL IS IN TABLE JRST LOAD## ;NO, GET NEXT BLOCK TRZ FL,R.LIB ;UNDEF, CLEAR SKIP CONTROL JRST LOAD## ;DEFINED, DON'T NEED THIS DEFINITION > SUBTTL BLOCK TYPE 1003 - NAME ; _____________________________________________________ ; | 1003 | Long count | ; ----------------------------------------------------- ; | 1 | Count of Title words | ; ----------------------------------------------------- ; | Program Title | ; ----------------------------------------------------- ; | additional program title | ; ----------------------------------------------------- ; | additional program title | ; ----------------------------------------------------- ; . . . ; _____________________________________________________ ; | 2 | # ascii comment words | ; ----------------------------------------------------- ; | comment word | ; ----------------------------------------------------- ; | more comment words | ; ----------------------------------------------------- ; . . . ; _____________________________________________________ ; | 3 | count of compiler words | ; ----------------------------------------------------- ; | compiler code | CPU bits | ; ------------------------------------------------------ ; | Compiler name (in ascii) | ; ------------------------------------------------------ ; | additional compiler name | ; ------------------------------------------------------ ; | additional compiler name | ; ------------------------------------------------------ ; . . . ; ______________________________________________________ ; | 4 | 0 | ; ------------------------------------------------------ ; | Compile Date and Time | ; ------------------------------------------------------ ; | Compiler version number | ; ------------------------------------------------------ ; | 5 | 0 | ; ------------------------------------------------------ ; | Device Name | ; ------------------------------------------------------ ; | UFD or 0 for TOPS-20 | ; ------------------------------------------------------ ; | 6 | 0 | ; ------------------------------------------------------ ; | Tops-10 file Name | ; ------------------------------------------------------ ; | file extention | 0 | ; ------------------------------------------------------ ; | 7 | number of SFDs | ; ------------------------------------------------------ ; | SFD 1 | ; ------------------------------------------------------ ; | SFD 2 | ; ----------------------------------------------------- ; . . . ; ______________________________________________________ ; | 10 | Number of TOPS-20 file | ; | | spec words (in ascii) | ; ------------------------------------------------------ ; | TOPS-20 file spec | ; ------------------------------------------------------ ; | more TOPS-20 file spec | ; ------------------------------------------------------ ; . . . ; ______________________________________________________ ; | 11 | 0 | ; ------------------------------------------------------ ; | Source version number | ; ------------------------------------------------------ ; | Date | Time | ; ------------------------------------------------------ IFE .NWBLK,< T.1003==E$$IRB## > ;HERE ON A BLOCK TYPE 1003 (NAME BLOCK) ;THE W'S CONTAIN THE CURRENT TRIPLET AND THE T'S ARE SCRATCH. T.1003: RELOCATE (NONE) ;THIS BLOCK TYPE CONTAINS NO RELOCATION TRNE FL,R.LIB!R.INC ;NEED AN EXCUSE TO LOAD THIS? SKIPE INCPTR ;ANY POSSIBILITY WE'LL GET ONE? CAIA ;DON'T NEED AN EXCUSE OR COULD GET ONE JRST T1000C ;[2345] NO CHANCE, JUST IGNORE THIS BLOCK PUSHJ P,D.GET1 PUSHJ P,T1003E ;ERROR HLR T1,W1 ;[2326] get the sub-block code HRRZS W1 ;[2326] save just sub-block count CAIE T1,1 ;[2326] this is first sub-block must be name ;[2326] sub-block JRST E$$IRB ;[2326] else the block is bad XCT X03BIT(T1) ;[2326] set the correct bits in flag word (w1) MOVE T1,W1 ;COPY FLAGS FOR DESTRUCTIVE TESTING TXC T1,PT.SGN!PT.TTL ;THESE BITS SHOULD BE ON TXZ T1,PT.EXT ;IGNORE THIS BIT HOWEVER TROE FL,R.LOD ;DID WE SEE AND END BLOCK FOR LAST PRGM? PUSHJ P,E$$NEB## ;[1212] WARN USER, BUT TRY TO CONTINUE TRNE FL,R.FHS ;FORCED TO HIGH SEGMENT? PUSHJ P,T1003H ;YES, MAKE SURE THERE IS ONE PUSHJ P,X03TTL ;[2326] get the module name ;[2326] Now check /include /exclude to see if we have to load this module TRNE FL,R.LIB!R.INC JRST X03INC SKIPN EXCPTR ;[2326] if any /excludes SKIPE INCPTR ;[2326] no but may have to purge entry in ;[2326] include list. JRST X03EXC ;[2326] see if should be excluded (t.6exc) X03OK: TRZ FL,R.LIB!R.INC ;[2326] loading this module for sure MOVEM W2,PRGNAM ;[2326] save name for error messages SKIPE REDLO ;[2326] doing /REDIRECT PUSHJ P,T.6RED## ;[2326] yes so do it TRNE FL,R.FHS ;[2326] need to adjust relocation tables? PUSHJ P,T.6RC## ;[2326] yes so do it MOVE T1,LSYM ;WORD COUNT IN LOCAL SYMBOL TABLE MOVEM T1,NAMPTR ;POINT TO THIS TITLE BLOCK PUSHJ P,E$$LMN## ;[2326] tell that this module is being loaded SETZM W3 ;[2326] zero w3 PUSHJ P,X03ADD ;[2326] since it is loaded put in local symbol ;[2326] for map AOS PRGNO ;[2326] one more module seen X03SRT: PUSHJ P,D.GET1 ;[2326] get the next word JRST X03ND ;[2345] go output seg info HRRZ T1,W1 ;[2326] get count if any HLRZ T2,W1 ;[2326] get the sub-block code for index SKIPLE T2 ;[2345] Index must be greater than 0 CAIL T2,MAXBIT ;[2345] but less than maximun index JRST T1003E ;[2345] Not a valid sub-block index code XCT X03BIT(T2) ;[2326] set the appropriate bits in w1 XCT X03JMP(T2) ;[2326] go to the appropriate routine ;[2326] this routine handles the CPU code and the compiler name and code. X03PRC: HRRZ P1,T1 ;[2326] save count of extra compiler name words HLLZS W1 ;[2326] clear the count from flag word PUSH P,W1 ;[2326] put the flags on the stack PUSH P,P1 ;[2326] store the count since p1 is used later PUSHJ P,D.GET1 ;[2326] get the next word JRST T1003E ;[2345] something is wrong with rel blk MOVE W2,W1 ;[2326] first compiler & CPU bits to w2 LDB T1,[POINT 6,W2,5] ;[2345] get runnable cpu bits ANDI T1,CP.MSK ;[2326] clear CPUS we don't know about SKIPN T1 ;[2345] asked for none? MOVEI T1,CP.MSK ;[2326] yes--means all HRRZM T1,CTYPE ;[2326] save with compiler type MOVE T2,CPUTGT ;[2326] get target CPUs JUMPE T2,x03TGT ;[2326] the CPU switches are not being used TDON T1,T2 ;[2326] test for a good target switch JRST E$$CPU## ;[2326] .DIRECTIVE is for wrong CPU X03TGT: SKIPN OKCPUS ;[2345] can any CPU run this code? JRST X03END ;[2345] no--forget this test ANDM T1,OKCPUS ;[2326] enforce CPU flags SKIPN OKCPUS ;[2326] can prog run at all now? PUSHJ P,E$$CCD## ;[2326] no--CPU conflict detected X03END: LDB T1,[POINT 12,W2,17] ;[2345] now get processor type CAILE T1,CT.LEN ;[2326] check for range SETZ T1, ;[2326] make it unknown HRLM T1,CTYPE ;[2326] save compiler type MOVE T2,PROCSN ;[2326] get list of procs seen so far MOVE P1,T1 ;[2326] safe place PUSH P,W2 ;[2345] put on stack for CT.NAM(t1) call XCT CT.NAM##(T1) ;[2326] proc routines expect many ACs + (p) MOVE T1,CT.BIT##(P1) ;[2326] get corresponding bit IORM T1,PROCSN ;[2326] signal we have seen this one IORM T1,LIBPRC ;[2326] a new module this library pass POP P,W2 ;[2326] clear flags off stack POP P,P1 ;[2326] restore count of name words JUMPE P1,NONAME ;[2345] check for no compiler name PUSHJ P,D.GET1 ;[2326] get next word - 1st name word JRST T1003E ;[2345] something is wrong with rel blk SKIPA W3,W1 ;[2345] put first compiler name word in w3 NONAME: SETZM W3 ;[2345] if no compiler word then put in 0 POP P,W1 ;[2345] restore compiler type and CPU bits PUSHJ P,LS.ADD## ;[2326] store the triplet SOS P1 ;[2326] decrement count of JRST RELLP ;[2326] check and put rest of long compiler ;[2326] name in the ls area ;[2326] this routine takes the string stored as count,,address in w2 and builds ;[2326] triplets then stores them in ls area. X03ADD: TLNE W2,770000 ;[2326] is it a long title? PJRST LS.ADD## ;[2345] no - just one words worth - go do it HLRZ P1,W2 ;[2326] count of words to p1 HLLZS W1 ;[2326] clear count form w1 need to set trip ;[2326] bits there HRRZ P2,W2 ;[2326] the address of string to p2 CAILE P1,1 ;[2326] do we need extended triplets TXC W1,PS.EXO ;[2326] yes extended triplets to follow PUSHJ P,X031WD ;[2326] build primary triplet TXZ W1,PS.EXO ;[2326] clear secondary following bit TXZ W1,PT.SGN!PT.EXT;[2326] clear primary flags TRPLP: JUMPLE P1,DONE ;[2326] have we finished? CAIGE P1,2 ;[2326] need whole triplet? JRST X031WD ;[2326] no - build last triplet PUSHJ P,X03TRP ;[2326] yes - build whole triplet JRST TRPLP ;[2326] go back and check for more DONE: POPJ P, ;[2326] finished ;[2326] build whole triplet from string address stored in p2, ;[2326] count stored in p1. X03TRP: DMOVE W2,@P2 ;[2326] put the 2 words in w2, w3 SUBI P1,2 ;[2326] two words stored so decrement count ADDI p2,2 ;[2326] got two so bump address PUSHJ P, LS.ADD## ;[2326] put them in the ls area POPJ P, ;[2326] build a triplet with only one word of title left and store in ls area X031WD: MOVE W2,@P2 ;[2326] get word form source and put in w2 SETZM W3 ;[2326] zero w3 SOS P1 ;[2326] subtract one from count AOS P2 ;[2326] add one to the address PJRST LS.ADD## ;[2345] store the triplet in the ls area ;[2326] This routine builds triplets from the rel file and stores them in the ;[2326] ls area enters with the flags in w1 and count in right half of w1. ;[2326] Gets the next two words and puts them in w2,and w3. X03STR: HRRZ P1,T1 ;[2326] count of words to p1 PUSHJ P,X03TRW ;[2326] build primary triplet RELLP: JUMPLE P1,X03SRT ;[2345] go back for next sub-block CAIGE P1,2 ;[2326] need whole triplet? JRST X031RW ;[2326] no - build last triplet PUSHJ P,X03TRW ;[2326] yes - build whole triplet JRST RELLP ;[2326] gets a word form the rel block and put it in w2, zeroes w3, then ;[2326] stores the triplet in the ls area. X031RW: PUSH P,W1 ;[2326] save the flags PUSHJ P,D.GET1 ;[2326] get the next word from the rel file JRST T1003E ;[2345] something is wrong with the rel block MOVE W2,W1 ;[2326] put the word in w2 SETZM W3 ;[2326] third word is a zero POP P,W1 ;[2326] restore the flags SUBI P1,1 ;[2326] decrease the count of words PUSHJ P,LS.ADD## ;[2326] store the triplet in the ls area JRST X03SRT ;[2345] back for the next sub-block ;[2326] gets two words from the rel block and puts them in w2,w3 then ;[2326] stores the triplet in the ls area. X03TRW: PUSH P,W1 ;[2326] save the flags PUSHJ P,D.GET1 ;[2326] get the next word for rel block JRST T1003E ;[2345] something is wrong MOVE W2,W1 ;[2326] word to w2 PUSHJ P,D.GET1 ;[2326] get the next word from the rel block JRST T1003E ;[2345] block is bad MOVE W3,W1 ;[2326] last word for the triplet SUBI P1,2 ;[2326] 2 words gone POP P,W1 ;[2326] get back the flags PJRST LS.ADD## ;[2345] store the triplet in the ls area ;[2326] this routine gets the name words and builds the name in NAMBLK for ;[2326] testing against /INCLUDES, /EXCLUDES X03TTL: HRRZ T2,W1 ;[2326]* count of title words to t2 CAIL T2,SYMSIZ ;[2345] is it longer than max symbol length? PUSHJ P,E$$STL ;[2326] Yes - give an error PUSH P,W1 ;[2326] save the flags CAIG T2,1 JRST X03SHT ;[2326] just one word so put in w2 TXC W1,PT.EXT ;[2326] need additional triplets MOVNS T2 ;[2326] negative count HRLZS T2 ;[2326] put it in left half for AOBJN ptr X03LP: PUSHJ P,D.GET1 ;[2326] get the next name word JRST LOAD ;[2326] end of block MOVEM W1,NAMBLK(T2) ;[2326] store the next word AOBJN T2,X03LP ;[2326] done? - no get the next word MOVEI W2,NAMBLK ;[2326] address of title to w2 POP P,W1 ;[2326] restore the flags HRL W2,W1 ;[2326] count to left of w2 SETZM W3 ;[2326] zero last word of triplet HLLZS W1 ;[2326] don't want count in flag word POPJ P, ;[2326] all done X03SHT: PUSHJ P,D.GET1 ;[2326] get the name word JRST T1003E ;[2345] error bad rel block SKIPN W2,W1 ;[2345] put it in w2 MOVE W2,[SIXBIT/.MAIN./] ;[2326] yes - use the default name SETZM W3 ;[2326] zero w3 POP P,W1 ;[2326] restore the flags POPJ P, ;[2326] return ;[2326] Now we have the name as count,,ptr in program name and stored in LS. ;[2326] lets see if we need to load this module. X03INC: PUSHJ P,INCCHK## ;[2326] check /INCLUDES SKIPA ;[2326] don't load this module JRST X03OK ;[2326] found it in /INCLUDES so go load it TRZA FL,R.LOD ;[2326] not there clear loading flag X03POP: TRO FL,R.LIB ;[2326] cause module to be ignored by /EXCLUDE POP P,W1 ;[2326] restore w1 JRST T1000C ;[2326] ignore rest of the block ;[2326] check the /EXCLUDE to see if it's there X03EXC: PUSHJ P,EXCCHK## ;[2326] see if in the /EXCLUDE list JRST X03POP ;[2326] yes so don't load this module JRST X03OK ;[2326] not excluded so go load X03STT: PUSHJ P,X03TRW ;[2326] store triplet in ls area JRST X03SRT ;[2326] back for the next part ;[2326] table of bits that get set according to left half of sub-block flag ;[2326] word. The code in the sub-block flag word is the index into the table ;[2326] and the bits are saved in the first word of the ls triplets generated ;[2326] by the sub-blocks. X03BIT: JFCL ;[2326] TXO W1,PT.SGN!PT.TTL!PT.EXT ;[2345] sign, primary title, extended MOVX W1,S.TTL!S.CMT ;[2345] comment MOVX W1,S.TTL!S.PRC!S.CMT ;[2345] Processor MOVX W1,S.TTL!S.CRE ;[2345] Creation date MOVX W1,S.TTL!S.DEV ;[2345] Device MOVX W1,S.TTL!S.NAM ;[2345] File name MOVX W1,S.TTL!S.SFD ;[2345] Sfd MOVX W1,S.TTL!S.FIL ;[2345] TOPS-20 file spec MOVX W1,S.TTL!S.VER ;[2345] Source version number MAXBIT== . - X03BIT ;[2345] table size ;[2326] Table of routines to execute based on the code in left half of ;[2326] sub-block flag word. Uses that code as index to table. X03JMP: JRST T1003E ;[2345] Bad sub-block code JRST T1003E ;[2345] Second name sub-block - error JRST X03STR ;[2345] Comment sub-block - store ascii text JRST X03PRC ;[2345] Compile/CPU sub-block check processor info JRST X03STT ;[2345] Compile date/time/version # - 3 word sub-blocks JRST X03STT ;[2345] Device/UFD - 3 word sub-block JRST X03STT ;[2345] TOPS-10 file spec/ext - 3 word sub-block JRST X03STR ;[2345] SFDs JRST X03STR ;[2345] TOPS-20 file spec JRST X03STT ;[2345] Source version number/date and time ;HERE IF /SEG:HIGH. MAKE SURE HIGH SEG EXISTS, THEN FAKE THE RC TABLES. T1003H: PUSH P,W1 ;SAVE OVER SETRC CALL SETZ W1, ;CREATE HIGH SEGMENT WITH DEFAULT ORIGIN SKIPN SG.TB+2 ;HIGH SEGMENT EXIST ALREADY? PUSHJ P,SETRC## ;NO, CREATE ONE MOVEI R,1 ;NOW MAKE .LOW. POINT TO HIGH SEG MOVE T1,SG.TB+2 ;ADDR OF HIGH SEG DATA BLOCK MOVEM T1,@RC.TB ;MAKE .LOW. (RC #1) POINT TO IT POP P,W1 ;RESTORE FLAGS OF NEXT TRIPLET POPJ P, ;Here after all sub-blocks have been processed. Call TTLRCL to put the segment ;descriptor triplets in the LS area. Then go get the next block. X03ND: PUSHJ P,TTLRLC## ;[2345] build segment info triplets-put in LS JRST LOAD## ;[2345] get the next block ;HERE ON SOME TYPE OF ERROR OR INVALID FORMAT IN THE 1003 BLOCK TYPE T1003E: MOVEI T1,1003 ;SHOULD NEVER GET HERE JRST E$$IRB## ;[1174] SO WARN THE USER SUBTTL BLOCK TYPE 1004 - BYTE ARRAY INITIALIZATION ; or ; ; ---------------- ---------------- ; ! 1004 ! count ! ! 1004 ! count ! ; ---------------- ---------------- ; ! relocation ! ! relocation ! ; ---------------- ---------------- ; ! byte count ! ! global symbol! ; ---------------- ---------------- ; ! byte pointer ! ! byte count ! ; ---------------- ---------------- ; ! byte string ! ! byte pointer ! ; ---------------- ---------------- ; ! ... ! ! byte string ! ; ---------------- ---------------- ; ! ... ! ; ---------------- T.1004: PUSHJ P,RB.2## ;READ AND RELOCATE FIRST TWO WORDS JRST LOAD## ;[2262] FAILED, TRY NEXT BLOCK SETZ W3, ;[2205] VALUE OF SYMBOL (ZERO IF NONE) TLNN W2,770000 ;IS IT A 6-BIT GLOBAL SYMBOL? JRST T1004A ;NO PUSH P,W1 ;YES, SAVE BYTE COUNT PUSHJ P,T.1S6## ;CALL T.1 CODE TO EVALUATE SYMBOL SKIPA W3,W2 ;[2262] KEEP THE SYMBOL VALUE T1004A: PUSH P,W2 ;[2303] SAVE BYTE COUNT LDB T3,[POINT 6,W1,11] ;GET BYTE SIZE MOVEM T3,BYTSIZ ;[2262] SAVE IT LDB T1,[POINT 6,W1,5] ;[2262] GET BYTE POSITION MOVEM T1,BYTPOS ;[2262] SAVE IT MOVEM W1,BYTADR ;[2262] STORE IT MOVEI T1,1 ;[2262] GET THE REPETITION COUNT MOVEM T1,REPCNT ;[2262] SET IT SETZM FILCNT ;[2262] 1004 BLOCKS DON'T FILL POP P,W1 ;[2262] GET THE BYTE COUNT MOVEM W1,BYTCNT ;[2262] SAVE IT PUSHJ P,X160SZ ;[2262] FIX UP THE BYTE POINTER ;[2262] The following calculation deliberately throws away the carry ;[2262] which may have occured by incrementing BYTADR in X160SZ. This ;[2262] is because FORTRAN uses a 777777 address in a byte pointer to ;[2262] point to the beginning of a common block. HLLZ T2,LSTRRV ;[2262] GET THE SECTION NUMBER HLLM T2,BYTADR ;[2205] PUT IT INTO THE ADDRESS (CLOBBER CARRY) ADDM W3,BYTADR ;[2262] AND ADD THE SYMBOL JRST T1160S ;[2262] JOIN THE COMMON CODE ;Enter here from error in T.1S code ;Clean up and just ignore this block. T1004U::.ERR. (MS,.EC,V%L,L%W,S%W,USB,) .ETC. (JMP,,,,,.ETIMF##) POP P,T1 ;POP OFF THE RETURN ADDRESS MOVE R3,-1(P) ;RESTORE THE WORD COUNT SUBI R3,3 ;ACCOUNT FOR THE WORDS WE HAVE ALREADY READ T1004Z: POP P,T1 ;CLEAN UP THE STACK POP P,T1 ; ... POP P,P3 ;[1470] ... MOVE W1,R3 ;RESTORE WORD COUNT JRST T.1000 ;AND JUST IGNORE THE BLOCK SUBTTL BLOCK TYPE 1010-1014 RIGHT HALF RELOCATION ; ; -------------------- ; ! 101X ! n ! header word ; !------------------! ; !b1!b2! ... !bi! ----- ; !------------------! ! ; ! beginning addr. ! ! ; !------------------! ! ; ! data 1 ! !--- subblock ; !------------------! ! ; // .... // ! ; !------------------! ; ! data(i-1) ! ----- ; -------------------- ; ... ;**;[2072] Replace 2 lines at T1004Z+25L. PAH 19-Jul-84 DEFINE NEWBLK(RBSIZ,RBNUM,RELTYP,ROFF<0>)< ;;[2072] MOVE P1,[POINT RBSIZ,RB,-1] ;;[2072] MOVEI P2,RBNUM ;;NUMBER OF RELOC BYTES MOVE P4,[ RELTYP ] ;;HOW TO DO THE RELOC JRST T.NYBT ;;COMMON CODE TO INTERPRET THIS > ;[1405] CPSECT=.TEMP ;[2262] TEMPORARY T.1010:: NEWBLK(2,^D18,RADD) ;[1405] T.1011:: NEWBLK(3,^D12,RADD) ;[1405] T.1012:: NEWBLK(6,6,RADD) ;[1405] T.1013:: NEWBLK(9,4,RADD) ;[1405] T.1014:: NEWBLK(18,2,RADD) ;[1405] SUBTTL BLOCK TYPES 1020-1023 LEFT/RIGHT HALFWORD RELOCATION ; ; -------------------- ; ! 102X ! n ! ; !------------------! ; !l1,r1! ... !li,ri! -- ; !------------------! | ; ! beginning addr. ! | ; !------------------! | ; ! data 1 ! | ; !------------------! | -- subblock ; // .... // | ; !------------------! | ; ! data(i-1) ! | ; -------------------- -- ; ... ; T.1020:: ;**;[2072] Change 1 line at T.1020+1. PAH 19-Jul-84 NEWBLK(2,^D9,RLADD,1) ;[2072] T.1021:: ;**;[2072] Change 1 line at T.1021+1. PAH 19-Jul-84 NEWBLK(3,6,RLADD,1) ;[2072] T.1022:: ;**;[2072] Change 1 line at T.1022+1. PAH 19-Jul-84 NEWBLK(6,3,RLADD,1) ;[2072] T.1023:: ;**;[2072] Change 1 line at T.1023+1. PAH 19-Jul-84 NEWBLK(9,2,RLADD,1) ;[2072] SUBTTL BLOCK TYPES 1030-1034 FOR 30-BIT RELOCATION ; ; -------------------- ; ! 103X ! n ! header word ; !------------------! ; !b1!b2! ... !bi! ----- ; !------------------! ! ; ! beginning addr. ! ! ; !------------------! ! ; ! data 1 ! !--- subblock ; !------------------! ! ; // .... // ! ; !------------------! ; ! data(i-1) ! ----- ; -------------------- ; T.1030:: NEWBLK(2,^D18,THADD) ;[1405] T.1031:: NEWBLK(3,^D12,THADD) ;[1405] T.1032:: NEWBLK(6,6,THADD) ;[1405] T.1033:: NEWBLK(9,4,THADD) ;[1405] T.1034:: NEWBLK(18,2,THADD) ;[1405] SUBTTL SUBROUTINES SUPPORTING BLOCK TYPES 1010-1034 PB.1: ; ; This routine can return in one of three ways: ; +1 means the end of the REL block has been seen. ; +2 means the end of the sub-block has been seen. ; +3 means that a word has been placed in W1 and its ; corresponding psect index is found in R ; TRNN WC,377777 ;[1405] END OF BLOCK? JRST PB0 ;[1405] YES, RETURN +1 PUSHJ P,D.IN1## ;[1471] PICK UP A WORD AOBJP WC,PB1 ;[1471] END OF SUBBLOCK? ILDB R,P1 ;[1405] AND A PSECT INDEX PB2: AOS (P) ;[1405] PB1: AOS (P) ;[1405] PB0: POPJ P, ;[1405] PSORGN: ; ; On entry, R contains a psect index. ; Check this index against the total number seen. ; Return in R the pointer to this psect's relocation counter JUMPE R,CPOPJ ;[1444] LEAVE ABS DATA ALONE CAMG R,RC.NO ;PSECT INDEX EXIST? JRST PSORG0 ;[1405] YES CAIG R,2 ;[1405] MIGHT BE TWOSEG? TRNN FL,R.TWSG ;[1405] JRST E$$IPX## ;NO, GIVE ERROR SKIPA ;[1405] YES, FETCH COUNTER DIRECTLY PSORG0: HRRZ R,@RC.MAP ;[1444] GET INTERNAL PSECT NUMBER MOVE R,@RC.TB ;[1405] FETCH COUNTER SKIPGE RC.AT(R) ;[1405] ORIGIN SET? PUSHJ P,R.ERR## ;[2247] NO, NEEDS AN ORIGIN POPJ P, ;[1405] RETURN RADD: ; ; Right-half relocation. ; JUMPE R,CPOPJ ;[1444] LEAVE ABS VALUES ALONE HRR T2,W1 ;[1444] PICK UP THE HALFWORD PUSHJ P,TSTSEG ;[1444] ADD T1,T2 ;[1444] ADD IN THE PSECT ORIGIN HRR W1,T1 ;[1405] RELOCATED HALFWORD POPJ P, THADD: ; ; Thirty-bit relocation. ; JUMPE R,CPOPJ ;[1444] LEAVE ABS VALUES ALONE LDB T2,[POINT 30,W1,35] ;[1405] PICK UP EXTENDED ADDR PUSHJ P,TSTSEG ;[1444] ADD T1,T2 ;[1444] ADD IN THE PSECT ORIGIN DPB T1,[POINT 30,W1,35] ;[1405] AND PUT IT BACK POPJ P, RLADD: ; ; Relocation of left and right halfwords. ; JUMPE R,LADD ;[1722] LEAVE ABS VALUES ALONE HLR T2,W1 ;[1444] PICK UP LEFT HALF PUSHJ P,TSTSEG ;[1444] ADD T1,T2 ;[1444] ADD IN THE PSECT ORIGIN ;**;[2072] Change 1 line at RLADD+8L. PAH 19-Jul-84 HRLM T1,W1 ;[2072] RELOCATED LEFT HALF LADD: ILDB R,P1 ;[1722] FETCH NEXT RELOC BYTE PUSHJ P,PSORGN ;[1405] CHECK IT OVER JRST RADD ;[1405] FINISH WITH RIGHTHALF TSTSEG: ; [1444] This routine picks up the value to be added in for relocating ; a word against a psect -- special case code for .HIGH. and .LOW. is ; here. MOVE T1,RC.NM(R) ;[1444] WHAT IS IT? CAME T1,[SIXBIT /.HIGH./] ;[1444] HIGHSEG? CAMN T1,[SIXBIT /.LOW./] ;[1444] OR LOWSEG? JRST [ MOVE T1,RC.SG(R) ;[1444] IF SO, MOVE T1,LL.S0(T1) ;[1444] CALCULATE RELOCATION ADD T1,RC.CV(R) ;[1444] SOMEWHAT DIFFERENTLY SUB T1,RC.IV(R) ;[1444] JRST CPOPJ ] ;[1444] AND RETURN MOVE T1,RC.CV(R) ;[1727] ELSE RELOC WRT. ORIGIN POPJ P, ;[1770] T.NYBT: ; ; T.1010 through T.1037 come here after setting up ACs as follows: ; P1 -an initialized byte pointer for the relocation bytes ; P2 -number of relocation bytes in the word ; P4 -dispatch address for type of relocation (left,right,30bit) ; SPUSH ;[1405] SAVE REGISTERS TNYBTB: MOVN T1,P2 ;[1726] WC GETS SUBBLOCK COUNT AGAIN HRLI WC,-2(T1) ;[1726] COUNT INCLUDES RELOC WORD ; BEGIN PROCESSING A SUB-BLOCK PUSHJ P,PB.1 ;[1405] FETCH FIRST WORD OF BLOCK JRST [ SPOP JRST LOAD ] ;[1405] NO MORE IN BLOCK JFCL ;[1405] "IMPOSSIBLE" MOVE RB,W1 ;[1405] SETUP RELOC BYTE MOVE P1,-1(P) ;[1405] RESET BYTEPOINTER PUSHJ P,PB.1 ;[1405] FETCH START ADDRESS JRST [ SPOP JRST LOAD ] ;[1405] NO MORE JFCL ;[1405] "IMPOSSIBLE" PUSHJ P,PSORGN ;[1405] FETCH THE RELOC COUNTER PTR MOVEM R,CPSECT ;[1405] "CURRENT PSECT" COUNTER PTR PUSHJ P,THADD ;[1503] RELOCATE THE START ADDR MOVE P3,W1 ;[1405] PICK UP START ADDRESS ; ;[1721] Here compute the size of the subblock into P2 The number of ;[1721] of words in the rest of the block is in the right half of WC and the ;[1721] subblock cannot have more than P2-1 words in it. ; HRROI T1,400000(WC) ;[1721] RECOVER SIZE OF BLOCK ( RH OF MOVN T1,T1 ;[1721] WC CONTAINS -( SIZE + 400000 ) SUBI P2,2 ;[1721] SIZE OF SUBBLOCK IN P2 INCLUDES ;[1721] REL WORD, SO DECR IT ONCE AND ;[1721] AGAIN FOR THE FENCE IN ;[1721] "FINISH=START+SIZE-1" BELOW CAIL P2,-1(T1) ;[1721] SHORT SUBBLOCK? MOVEI P2,-1(T1) ;[1721] YES, USE SIZE OF BLOCK-1 ADDB P2,W1 ;[1776] HIGHEST LOCATION TO BE LOADED PUSHJ P,T.1AD ;[1776] JFCL ;[1776] THROW IT AWAY JFCL ;[1776] DEFER IT AWHILE TNYBTL: PUSHJ P,PB.1 ;[1405] FETCH A DATA WORD JRST [ SPOP JRST LOAD ] ;[1405] NO MORE JRST [ DMOVE P1,-1(P) ;[1726] FETCH PTR AND COUNT AGAIN JRST TNYBTB ] ;[1405] RESET FOR NEXT SUBBLOCK PUSHJ P,PSORGN ;[1405] GET ANY PSECT INDICES PUSHJ P,@P4 ;[1405] DO THE RELOCATION IFN FTOVERLAY,< SKIPE RT.LB ;[1730] DOING OVERLAYS? SKIPA W3,[JSP T1,CS.RHS##] ;[1730] YES, NOTE OVL RELOC > ;[1401] END OF IFN FTOVERLAY MOVE W3,[MOVEM W1,(P3)] ;[1730] NO, SIMPLE DEPOSIT XCT W3 ;[1730] AOJA P3,TNYBTL ;[1714] INCR DESTINATION PTR AND ;[1714] DO IT AGAIN SUBTTL BLOCK TYPES 1042 AND 1043 - PROGRAM AND LIBRARY REQUESTS ; ----------------- ; ! 1042 ! COUNT ! ; ----------------- ; ! DEVICE ! ; ----------------- ; ! FILE NAME ! ; ----------------- ; ! EXT !DIR CNT! ; ----------------- ; ! PROJ ! PROG ! ; ----------------- ; ! SFD ! ; ----------------- ; ; . ; ; . IFN .NWBLK,< T.1042: SKIPA P1,[PRGPTR] ;TYPE 1042 IS PROGRAMS TO LOAD T.1043: MOVEI P1,LIBPTR ;TYPE 1043 IS LIBRARIES TO SEARCH RELOCATE (NONE) ;FILE NAMES ETC ARE NOT RELOCATABLE PUSHJ P,D.TRIP ;GET THE 1ST THREE WORDS (REQUIRED) JRST E$$IRR ;[1174] ERROR - NOT ENOUGH DATA WORDS T1042A: MOVEI T2,R.LEN ;LENGTH OF A REQUEST/REQUIRE BLOCK PUSHJ P,DY.GET## ;ALLOCATE ONE DSTORE W1,, ;STORE DEVICE & FILENAME HLLZM W3,R.EXT(T1) ;STORE EXTENSION, BUT NOT COUNT HRRZ P2,W3 ;REMEMBER DIRECTORY LENGTH IN P2 JUMPE P2,T1042X ;DONE IF NO DIRECTORY GIVEN PUSHJ P,D.GET1 ;GET THE PPN JRST E$$IRR ;[1174] ERROR MOVEM W1,R.PPN(T1) ;REMEMBER IT SOJLE P2,T1042X ;DONE IF NO SFD'S MOVE T2,T1 ;GET A COPY OF REQUEST BLOCK POINTER HRLI T2,-5 ;MAKE AN AOBJN POINTER FOR SFD'S T1042L: PUSHJ P,D.GET1 ;GET THE NEXT SFD JRST E$$IRR ;[1174] NONE THERE, COUNT LIED MOVEM W1,R.SFD(T2) ;STORE THIS SFD SOJLE P2,T1042X ;QUIT IF COUNT RUNS OUT AOBJN T2,T1042L ;OR IF NO MORE ROOM IN OUR BUFFERS T1042X: PUSHJ P,T.RQST## ;GO CHAIN THIS REQUEST IN IF UNIQUE PUSHJ P,D.TRIP ;ANYTHING ELSE THERE? JRST LOAD## ;NO, LOAD NEXT BLOCK JRST T1042A ;YES, LOAD IT TOO E$$IRR::.ERR. (MS,.EC,V%L,L%W,S%W,IRR,) ;[1174] .ETC. (JMP,,,,,.ETNMF##) ;[1174] JRST LOAD## ;NOT ALWAYS A FATAL ERROR SUBTTL BLOCK TYPE 1044 - BLOCK STRUCTURED ALGOL LOCAL SYMBOLS ; ----------------- ; ! 1044 ! COUNT ! ; ----------------- ; ! STRUCTURED ! ; ----------------- ; ! ALGOL SYMBOLS ! ; ----------------- ; ! SIXBIT - MAY ! ; ----------------- ; ! BE EXTENDED ! ; ----------------- ; ; . ; ; . ;THIS BLOCK TYPE INSERTED IN EDIT 471 T.1044: SKIPE NOSYMS ;NO SYMBOLS REQUESTED? PJRST T.1000 ;YES, DUMP THIS BLOCK RELOCATE (NONE) ;NO RELOCATION INFO IN ALGOL SYMBOLS T1044L: PUSHJ P,D.GET1 ;READ NEXT WORD OF DATA JRST LOAD## ;END OF BLOCK SKIPG AS.FR ;ENOUGH ROOM LEFT IN AS AREA? JRST T1044G ;NO, GET SOME MORE T1044P: MOVEM W1,@AS.PT ;PUT CURRENT DATUM IN PLACE AOS AS.PT ;UPDATE FREE POINTER SOS AS.FR ;AND FREE COUNT AOS ASYM ;COUNT ONE MORE WORD OF ALGOL SYMBOLS JRST T1044L ;LOOP OVER ENTIRE ALGOL SYMBOL BLOCK ;HERE TO GET MORE FREE SPACE IN THE AS AREA T1044G: MOVEI P1,AS.IX ;POINT TO THE AS AREA FOR LNKCOR SKIPN AS.LB ;HAS AREA BEEN SETUP? JRST T1044I ;NO, GO INITIALIZE IT MOVEI P2,1 ;EXPAND BY ONE BLOCK PUSHJ P,LNKCOR## ;GET THE CORE PUSHJ P,E$$MEF## ;CAN'T??? JRST T1044P ;NOW GO PUT THE SYMBOL INTO THE FILE ;HERE TO INITIALIZE THE AS AREA (FIRST TIME TYPE 1044 SEEN). T1044I: PUSHJ P,XX.INI## ;CALL GENERAL INITIALIZER AOS AS.PT ;RESERVE ROOM FOR COUNT WORD SOS AS.FR ; BY DECREMENTING ALL COUNTS AOS ASYM ; AS IF ONE WORD HAD BEEN USED JRST T1044P ;NOW PUT AWAY THE DATA > ;IFN .NWBLK SUBTTL BLOCK TYPE 1045 - DECLARE WRITABLE OVERLAY LINKS T.1045:: PUSHJ P,STDATA ;[1704] USE GENERAL ROUTINE PUSH P,W2 ;[1704] SAVE THE BLOCK IOWD MOVE T4,W2 ;[1707] PUT THE IOWD IN W1 MOVX T1,$OVWRITABLE ;[1704] WRITABLE OVERLAY IS INDICATED SKIPE OVERLW ;[2031] DON'T SET UNLESS DOING OVERLAYS IORM T1,OVERLW ;[1704] REMEMBER THIS SKIPN WRTDAT ;[1704] HAS A TABLE BEEN SET UP? JRST [ MOVEI T2,WR.LEN ;[1704] FETCH WORDS NEEDED PUSH P,T4 ;[1745] SAVE POINTER PUSHJ P,DY.GET## ;[1704] ... POP P,T4 ;[1745] RESTORE POINTER MOVEM T1,WRTDAT ;[1704] JRST .+1 ] ;[1704] MOVE T1,(T4) ;[1704] CHECK WRITABLE BIT OF BLOCK TLNN T1,200000 ;[1704] JRST T1045A ;[1704] CURRENT LINK NOT WRITABLE HRLZI T1,400000 ;[1704] SET SIGN BIT IN WRTDAT IORM T1,WRTDAT ;[1704] SO /LINK CAN DEAL WITH IT T1045A: AOBJP T4,T1045X ;[1704] UNTIL NO MORE MOVE W2,(T4) ;[1704] PICK UP FIRST NAME MOVX W1,PT.SGN!PT.SYM!PS.GLB!PS.COM!PS.REL ;[1706] SET SOME LIKELY FLAGS PUSHJ P,TRYSYM## ;[1706] SEE IF KNOWN COMMON NAME JRST E$$UCB ;[1706] WHOLLY UNKNOWN JRST E$$UCB ;[1706] UNDEFINED ( NOT COMMON ) MOVE T1,(P1) ;[1706] GET PRIMARY FLAGS TXNN T1,PS.COM ;[1706] ALREADY COMMON? JRST E$$SNC## ;[1706] NO, ERROR ;IN WHAT LINK DOES THIS COMMON RESIDE? TXNE T1,PS.BGS ;[1706] FROM SOMEPLACE ELSE? JRST T1045B ;[1706] YES! WHERE? HRLZI T1,400000 ;[1706] SET SIGN BIT IN WRTDAT IORM T1,WRTDAT ;[1706] SO /LINK CAN DEAL WITH IT JRST T1045A ;[1706] AND LOOK AT THE NEXT ONE T1045B: MOVS P1,LSTPTR ;[1706] WALK BACKWARDS THROUGH TREE T1045C: TRNN P1,-1 ;[2022] REACHED ROOT? JRST T1045A ;[2022] YES, CHECK THE NEXT HRRZ T1,(P1) ;[1706] GET LINK# HRRZ P1,1(P1) ;[2022] AND NEXT PTR PUSHJ P,WRTPTR ;[1712] SET IT WRITABLE MOVX T2,OW.WRT ;[1706] ... DPB T2,T1 ;[1706] ... JRST T1045C ;[1706] DO IT AGAIN T1045X: POP P,W2 ;[1704] THROW AWAY THE BLOCK HLRZ T2,W2 ;[1704] MOVN T2,T2 ;[1704] HRRZ T1,W2 ;[1704] PUSHJ P,DY.RET## ;[1704] JRST LOAD## ;[1704] ALL DONE E$$UCB::.ERR. (MS,.EC,V%L,L%W,S%W,UCB,) ;[2007] .ETC. (SBX,.EC!.EP,,,,W2) ;[1706] .ETC. (STR,,,,,,) ;[1706] JRST T1045A ;[1706] TRY TO GET ANOTHER ;WRTPTR RETURNS A BYTE POINTER TO THE WRITABLE LINK FLAGS FOR A SPECIFIED LINK. ;THIS IS USED TO TEST AND SET THE WRITABLE STATUS OF A LINK. THE CALL IS: ; ; T1/ LINK NUMBER ; ;ON RETURN, T1 CONTAINS THE BYTE POINTER. T2 IS USED. WRTPTR:: IDIVI T1,^D18 ;[1704] FLAGS ARE 2 BITS PER LINK ADD T1,WRTDAT ;[2073] ADD BASE ADDRESS HRLI T1,(POINT 2,0,35) ;[2073] ADD TEMPLATE BYTE POINTER IMULI T2,-2 ;[1704] COMPUTE P FIELD OF BYTE POINTER ADDI T2,^D36 ;[1704] .. DPB T2,[POINT 6,T1,5] ;[1704] STORE IN P FIELD POPJ P, ;[1704] DONE SUBTTL BLOCK TYPE 1050 - PSECT NAME BLOCK ; --------------------- --------------------- ; ! 1050 ! COUNT ! ! 1050 ! COUNT ! ; --------------------- --------------------- ; ! 0 ! INDEX ! ! 0 ! INDEX ! ; --------------------- --------------------- ; ! SIXBIT PSECT NAME ! ! 0 ! MBZ ! COUNT ! ; --------------------- --------------------- ; ! (ATTRIBUTES) ! ! SIXBIT PSECT NAME ! ; --------------------- --------------------- ; ! (ORIGIN) ! ! ADDITIONAL NAME ! ; --------------------- --------------------- ; ; . ; ; . ; ; --------------------- ; ! ADDITIONAL NAME ! ; --------------------- ; ! (ATTRIBUTES) ! ; --------------------- ; ! (ORIGIN) ! ; --------------------- ;[2222] This block sets up W1-W3 and joins common code in the type 24 ;[2222] block. T.1050: SKIPLE MODTYP ;[2222] Twoseg seen in module? PUSHJ P,E$$MPT## ;[2222] Yes, error SETOM MODTYP ;[2222] Flag psects seen PUSHJ P,D.GET1 ;[2222] Get the index JRST LOAD## ;[2222] Empty block? MOVEI P1,(W1) ;[2222] Save it in P1 PUSHJ P,SYM.IN ;[2222] Get the psect name JRST [MOVEI T1,1050 ;[2222] No name? JRST E$$RBS##] ;[2222] Bad rel block PUSHJ P,D.GET1 ;[2222] Get the attributes SETZ W1, ;[2222] No attributes TXO W1,AT.PS ;[2222] Remember this psect seen in this module MOVE W3,W1 ;[2222] Save attributes in W3 PUSHJ P,D.GET1 ;[2222] Get the origin SETZ W1, ;[2222] No origin JRST T.24B## ;[2222] Join common code ;[2222] Here to read a symbol from the rel file. Returns symbol ;[2222] in W2 if short, length,,pointer in W2 if long. Long symbols ;[2222] are placed in SYMBLK. Returns skip if successful, non-skip ;[2222] if rel block is too short. SYM.IN: PUSHJ P,D.GET1 ;[2222] Get the name (first word) POPJ P, ;[2222] No symbol! MOVE W2,W1 ;[2222] Get the symbol TLNE W2,770000 ;[2222] Long symbol? JRST CPOPJ1 ;[2222] No, done JUMPE W2,CPOPJ1 ;[2223] Done if zero SYMIN1: CAIN W2,1 ;[2262] Short symbol in disguise? JRST [PUSHJ P,D.GET1 ;[2223] Yes, get one word POPJ P, ;[2223] No word means bad rel block MOVE W2,W1 ;[2223] Put it in W2 JRST CPOPJ1] ;[2223] Return with a short symbol PUSH P,W2 ;[2222] Save the count MOVNS W2 ;[2222] Negate it HRLZS W2 ;[2222] Put it in left half for AOBJN SYMINL: PUSHJ P,D.GET1 ;[2222] Get a symbol word name JRST [POP P,W2 ;[2222] No more, clear up the stack POPJ P,] ;[2222] And return MOVEM W1,SYMBLK(W2) ;[2222] Store the word AOBJN W2,SYMINL ;[2222] Go back if more POP P,W2 ;[2222] Get the count HRLZS W2 ;[2222] Count in left half HRRI W2,SYMBLK ;[2222] Address in right half JRST CPOPJ1 ;[2222] Successful return SUBTTL BLOCK TYPE 1051 - SET CURRENT PSECT ; --------------------- ; ! 1051 ! COUNT ! ; --------------------- ; ! 0 ! INDEX ! ; --------------------- T.1051: PUSHJ P,D.GET1 ;[2222] Get the index JRST LOAD## ;[2222] Empty block? MOVEI R,(W1) ;[2222] Psect index in R CAMLE R,RC.NO ;[2222] Psect index exist? JRST E$$IPX ;[2222] No, give error HRRZ R,@RC.MAP ;[2222] Get internal psect number MOVEM R,RC.CUR ;[2222] Set as the current psect JRST LOAD## ;[2222] Done SUBTTL BLOCK TYPE 1052 - PSECT END BLOCK ; --------------------- ; ! 1052 ! COUNT ! ; --------------------- ; ! 0 ! INDEX ! ; --------------------- ; ! PSECT BREAK ! ; --------------------- ; ; . ; ; . ; ; --------------------- ; ! 0 ! INDEX ! ; --------------------- ; ! PSECT BREAK ! ; --------------------- T.1052: PUSHJ P,D.GET1 ;[2222] Get the index JRST LOAD## ;[2222] No more? MOVEI R,(W1) ;[2222] Psect index in R CAMLE R,RC.NO ;[2222] Psect index exist? JRST E$$IPX ;[2222] No, give error HRRZ R,@RC.MAP ;[2222] Get internal psect number PUSHJ P,D.GET1 ;[2222] Give me a break JRST [MOVEI T1,1052 ;[2222] Rel block should not end here JRST E$$RBS##] ;[2222] Give an error PUSH P,RC.CUR ;[2222] Save the current psect MOVEM R,RC.CUR ;[2222] Set as the current psect MOVE P1,@RC.TB ;[2222] Get pointer to new psect MOVE T1,W1 ;[2222] Put the break in T1 PUSHJ P,R.CUR## ;[2222] Relocate it MOVE W1,T1 ;[2222] Get it back POP P,RC.CUR ;[2222] Restore the current psect PUSHJ P,CHKSZ0## ;[2222] Check for psect too big CAMLE W1,RC.HL(P1) ;[2222] A new record for the break? MOVEM W1,RC.HL(P1) ;[2222] Yes, set HL (CV fixed in T.5) JRST T.1052 ;[2222] Go back for another SUBTTL BLOCK TYPE 1060 - BINARY PATCH TRACE BLOCK (MAKLIB) ; ----------------- ; ! 1060 ! COUNT ! ; ----------------- ; ! EDIT NAME ! ; ----------------- ; ! ACTIV ! LASTA ! ; ----------------- ; ! CREAT ! DATE ! ; ----------------- ; ! INSTL ! DATE ! ; ----------------- ; ! (RESERVED) ! ; ----------------- ; ! # ASC ! # PCO ! ; ----------------- ! ; ! ASC EDIT NAME ! ! MAY BE ZERO OR MORE OF ; ----------------- ! THESE ASSOC. EDIT BLOCKS ; ! B0 IF INCLUDE ! ! ; ----------------- ! ; ; . MAY BE ANY # AND COMBINATION OF BELOW ; ------------------------------------- ; . ; ; (INSERT PCO) (REMOVE PCO) (RE-INSERT PCO) ; ; ----------------- ----------------- ----------------- ; ! 1 ! COUNT ! ! 2 ! COUNT ! ! 3 ! COUNT ! ; ----------------- ----------------- ----------------- ; ! RELOC ! ADDR ! ! EDIT NAME ! ! EDIT NAME ! ; ----------------- ----------------- ----------------- ; ! ORG ! P ADR ! ; ----------------- ; ; . ; ; . T.1060==T.1000 ;[1430] IGNORE BLOCK. SHOULD SOMEDAY GO INTO ; LS AREA FOR .MAP FILE. SUBTTL BLOCK TYPE 1070 - LONG SYMBOL NAME ; ----------------- ----------------- ; ! 1070 ! COUNT ! ! 1070 ! COUNT ! ; ----------------- OR ----------------- ; !CODE! N!R! 0 ! !CODE! N!R! 0 ! ; ----------------- ----------------- ; ! VALUE ! ! ( PSECTS ) ! ; ----------------- ----------------- ; ! NAME ! ! VALUE ! ; ----------------- ----------------- ; ! NAME ! ; ----------------- ; ! ( . . . ) ! ; ----------------- ; ! (ADD. VALUE ) ! ; ----------------- ; ! ( . . . ) ! ; ----------------- IFN .NWBLK,< ;THIS BLOCK TYPE INSERTED IN EDIT 1000 T.1070: PUSHJ P,D.GET1 ;GET FLAG WORD JRST LOAD## ;END OF BLOCK MOVE P2,W1 ;SAVE ORIGINAL FLAG WORD IN P2 SETO R, ;ASSUME NO EXPLICIT PSECTS TRZN W1,400000 ;IS THERE A PSECT-WORD? JRST T1070A ;NO, JUMP PUSHJ P,D.GET1 ;YES, GET IT JRST LOAD## ;?? MOVE R,W1 ;R CONTAINS TEMPORARY PSECTS T1070A: LDB RB,[POINT 3,P2,21] ;RB/ RELOC TYPE PUSHJ P,REL.1 ;GET RELOCATED VALUE-- W1/FLAG, W3/VALUE JRST LOAD## ;?? TXO W1,PT.SGN!PT.SYM ;FLAG IT SYMBOL LDB W2,[POINT 7,P2,17] ;GET N--SYMBOL LENGTH CAIL W2, ;[2305] IS IT LONGER THAN MAX SYMBOL LENGTH? PUSHJ P,E$$STL ;[2305] YES GIVE AN ERROR JUMPG W2,[PUSHJ P,T1070E JRST T1070B] PUSH P,W1 ;SAVE FLAG PUSHJ P,D.GET1 ;READ NAME (1 WORD) JRST LOAD## ;?? MOVE W2,W1 ;MOVE TO RIGHT AC POP P,W1 ;RECOVER FLAGS(PRIMARY SYMBOL FLAGS) ;THE ORIGINAL FLAG WORD STILL IN P2 T1070B: .JDDT LNKNEW,T1070B,<> LDB T1,[POINT 7,P2,28] ;[2305] IS IT AN EXTENDED VALUE? CAIL T1, ;[2305] IS IT LONGER THAN MAX SYMBOL LENGTH? PUSHJ P,E$$STL ;[2305] YES GIVE AN ERROR SKIPE T1 ;[2305] PUSHJ P,EXVAL ;[2305] YES SET UP COUNT,,PTR TO VALBLK SETZ P1, ;P1 & P2 USED IN LSHC FOR DECODING LSHC P1,3 ;GET FIRST DIGIT OF CODE PUSHJ P,@T1070T(P1) ;DISPATCH JRST T.1070 ;LOOP BACK FOR NEXT ENTRY ;FIRST DIGIT DISPATCH TABLE T1070T: T.1070U ;0XX - NAME (NEVER SHOULD HAPPEN) T1070L ;1XX - LOCAL T1070G ;2XX - GLOBAL SY.BH## ;3XX - BLOCK HEADER (FAIL) REPEAT 4, ;4XX - 7XX UNDEFINED ;UNDEFINE CODE -- GIVE ERROR MSSG T1070W: POP P,W1 ;RESTORE FLAG AND THEN ERROR T1070U: JRST E$$URC## ;OUT WITH ERROR MESSAGE ;L - LOCAL SYMBOL T1070L: TXO W1,PS.LCL ;DOING LOCAL DEFINITION SETZ P1, ;SETUP FOR NEXT DIGIT LSHC P1,3 ;OF 9-BIT CODE XCT [JFCL ;10X TXO W1,PS.DDT ;11X - SUPPRESSED TO DDT TXO W1,PS.MPO ;12X - MAP ONLY REPEAT 5,](P1) ;13X - 17X NOT DEFINED SETZ P1, ;SET UP TO GET 3RD DIGIT OF THE 9-BIT CODE LSHC P1,3 ; JRST SY.LS## ;FOR ALL 1XX CODE ;G - GLOBAL SYMBOL T1070G: SETZ P1, ;P1 & P2 USED TO DECODE 9-BIT CODE LSHC P1,3 ;GET 1ST DIGIT XCT [JFCL ;20X TXO W1,PS.DDT ;21X - SUPPRESSED TO DDT TXO W1,PS.MPO ;22X - MAP ONLY JRST T1070U ;23X - UNDEFINED JRST T1070Q ;24X - GLOBAL REQUEST FOR CHIN FIXUP JRST T1070Q ;25X - GLOBAL REQEST FOR ADDITIVE FIXUP JRST T1070Q ;26X - GLOBAL REQUEST FOR SYMBOL FIXUP JRST T1070U](P1) ;27X - UNDEFINED SETZ P1, ;2ND DIGIT LSHC P1,3 ; JRST @[SY.GS## ;200,210,220 - GLOBAL DEFINITION (1WORD VALUE) SY.GS## ;201,211,221 - (EXTENDED VALUE-NOT IMPLEMNETED) EXVAL ;[2305] 202,212,222 - NOT DEFINED SY.DGR## ;3 - RIGHT HALF DEFERRED SY.DGL## ;4 - LEFT HALF DEFERRED T1070D ;5 - BOTH HALVES DEFERRED T1070D ;6 - 30BIT DEFERRED T1070D](P1) ;7 - FULL WORD DEFERRED T1070D: TXO W1,PS.UDF ;FULL WORD DEFERRED JRST SY.DGR## ; ;[2305] Here if V is not zero - stores the value symbol in VALBLK and stores ;[2305] count,,valblk in w3 EXVAL: PUSH P,W1 ;[2305] save flags MOVEM W3,VALBLK ;[2305] store the first word of extended value MOVEI W3,VALBLK ;[2305] W3 get address of symbol name AOS T1 ;[2305] add 1 to count of words (count in block ;[2305] is number of addtional words) HRL W3,T1 ;[2305] W3 gets count,,valblk SOS T1 ;[2305] sub 1 from count since one word ;[2305] has been stored MOVNS T1 ;[2305] negative count for AOBJN HRLZS T1 ;[2305] put it in the left half AOS T1 ;[2305] add one to right half for word already ;[2305] done EXVAL1: PUSHJ P,D.GET1 ;[2305] get next word of extended value symbol jfcl ;**** ;jrst e$$isn ;[2305] should be more, something is rotten MOVEM W1,VALBLK(T1) ;[2305] store the name word AOBJN T1,EXVAL1 ;[2305] done? no go back for next word POP P,W1 ;[2305] restore flags POPJ P, ;[2305] return w3/ count,,valblk ;Q - GLOBAL REQUESTS (CODES 24X, 25X, 26X) T1070Q: PUSH P,P1 ;STORE 2ND DIGIT SETZ P1, ;SET UP FOR 3RD DIGIT LSHC P1,3 ; PUSH P,P1 ;STORE 3RD DIGIT ALSO TXO W1,PS.REQ ;SET REQUEST FLAG PUSHJ P,TRYSYM## ;LOCATE THE GLOBAL SYMBOL JRST T1070I ;NOT FOUND, GO PUT IN JRST T1070J ;FOUND BUT UNDEFINED, MUST WAIT JUMPE W3,[ POP P,0(P) ;RESTORE STACK AND RETURN POP P,0(P) ;FOR A FAKE REQUEST POPJ P,] ; IOR W1,0(P1) ;GET FLAGS TXNN W1,PS.REL ;RELOCATABLE? TDZA W1,W1 ;NO, CLEAR FLAGS MOVX W1,FS.REL MOVEM W1,SYMFLG ;SAVE IT FOR SYMBOL TABLE FIXUP POP P,T3 ;RESTORE 3RD DIGIT POP P,T1 ;RESTORE 2ND DIGIT XCT T1070S(T3) ;[2246] set the bits for type of fixup CAIN T1,4 ;CHAINED FIXUP? JRST X70CH ;[2246] check what type of chained fixup CAIE T1,6 ;SKIPE IF SYMBOL FIXUP PJRST SY.AD0## ;JUMP IF ADDITIVE MOVE W2,W3 ;[1002] EXPECT DEFINING SYMBOL IN W3 & REQUEST IN W2 PJRST SY.AS## ;GO DO SYMBOL TABLE FIXUP X70CH: MOVE T2,W3 ; MOVE W3,2(P1) TXNE W1,FS.FXR ;[2246] right half chained fixup? JRST SY.CHR## ;[2246] yes TXNE W1,FS.FXL ;[2246] left half chained fixup? JRST SY.CHL## ;[2246] yes TXNE W1,FS.FXE ;[2246] thirty bit chained fixup? JRST SY.CHE## ;[2246] yes JRST SY.CHF## ;[2246] full word is all that's left T1070S: JRST T1070X ;2X0 - NOT A REAL FIXUP, RESTORE W1 AND RETURN JRST T1070W ;2X1 - NOT DEFINED JRST T1070W ;2X2 - NOT DEFINED TXO W1,FS.FXR ;2X3 - RIGHT HALF FIXUP TXO W1,FS.FXL ;2X4 - LEFT HALF FIXUP JRST T1070W ;2X5 - NOT DEFINED TXO W1,FS.FXE ;2X6 - EXTENDED(30-BIT) FIXUP TXO W1,FS.FXF ;2X7 - FULL WORD FIXUP T1070X: POP P,W1 ;RESTORE W1, THEN RETURN POPJ P, ;GLOBAL SYMBOL NOT IN TABLE T1070I: POP P,T3 ;GET BACK 3RD DIGIT POP P,T2 ;GET 2ND DIGIT AOS USYM ;COUNT ONE MORE UNDEFINED CAIN T2,4 ;CHAINED FIXUP JRST X70CHF ;[2305] Yes go handle chained request JUMPE T3,INSRT## ;NOT A REAL FIXUP TXO W1,PS.FXP!PT.EXT ;SET FIXUP FLAG PUSH P,W1 ;FLAGS ON STACK MOVX W1,FP.SGN!FP.SYM!FP.PTR ;THESE ARE FOR THE FX BLOCK XCT T1070S(T3) ;MORE FLAGS CAIE T2,6 ;SKIPE IF SYMBOL FIXUP JRST T1070Y ;JUMP IF ADDITIVE FIXUP TXO W1,FS.FXS ;FLAG SYMBOL FIXUP PUSHJ P,SY.QS## ; JRST [SOS USYM ;NON LOADED LOCAL POP P,W1 ; POPJ P,] T1070Y: TXNN W1,PS.EXO ;A LONG SYMBOL NAME? JRST SY.RQ2## ;NO, JUMP MOVE P1,LSTGBL ;[2255] GET GS POINTER INTO P1 ADD P1,GS.LB ;MAKE IT ABS PUSHJ P,INSRT## ;GO INSRT THE SYMBOL FIRST MOVE W3,2(P1) ;REQUEST ADDR IN W3 MOVE T1,LSTGBL ;[2255] GET THE GLOBAL POINTER MOVE W3,LSTLCL ;[2255] AND THE LOCAL POINTER PUSHJ P,SY.RA## ;GO EXTEND THE ENTRY MOVE W3,P1 ;GET POINTER TO GS SUB W3,GS.LB ;MAKE IT RELATIVE, NEEDED FOR INSRTL POPJ P, ;RETURN X70CHF: CAIN T3,3 ;[2305] is it a right half chained request JRST INSRT## ;[2305] yes - so just put it in PUSH P,W1 ;[2305] save the primary flags MOVX W1,FP.SGN!FP.SYM!FP.PTR ;[2305] TXO W1,FS.FXC ;[2305] indicate we have a chained request XCT T1070S(T3) ;[2305] set bit for type chained fixup request JRST SY.RQ2 ;[2305] say a prayer and off you go. ;GLOBAL SYMBOL FOUND IN TABLE BUT UNDEFINED T1070J: POP P,T3 ;GET 3RD DIGIT POP P,T2 ;GET 2ND DIGIT JUMPE W3,CPOPJ ;DUMMY REQUEST CAIN T2,4 ;CHAINED REQUEST JRST [IORM W1,0(P1) JRST SY.RU3##] ;YES, JUMP MOVE W1,0(P1) TXOE W1,PS.FXP ;ALREADY DEFERED FIXUPS? JRST T1070K ;YES, PUSH P,W1 ;NO, SAVE PRIMARY FLAGS MOVX W1,FP.SGN!FP.SYM!FP.PTR ;[2333] SET SOME FLAGS FOR FX BLOCK XCT T1070S(T3) ;SET FLAGS FOR FX BLOCK MOVE T1,W2 ;[2255] NAME SHOULD BE IN T1 IF NOT SYMBOL CAIE T2,6 ;SKIP IF SYMBOL FIXUP JRST SY.RA## ;JUMP IF ADDITIVE FIXUP EXCH W2,W3 ;[2305] GET READY FOR CALL TO SY.QS TXO W1,FS.FXS ;FLAG SYMBOL FIXUP PUSHJ P,SY.QS## JRST T1070X PUSHJ P,TRYSYM ;[2305] JRST TX70RD ;[2305] JRST TX70PD ;[2305] JRST TX70TD ;[2305] TX70RD: AOS USYM ;[2305] JRST SY.RQ2## ;[2305] TX70PD: EXCH W2,W3 ;[2305] MOVE T1,LSTGBL ;[2255] GET THE GLOBAL POINTER MOVE W3,LSTLCL ;[2255] AND THE LOCAL POINTER JRST SY.RA## TX70TD: JRST SY.RC0## ;[2305] T1070K: MOVEI T1,0(P1) ADDI T1,.L SKIPG W1,0(T1) JRST SY.RUH## TXNN W1,S.FXP JRST T1070K+1 MOVE P1,T1 MOVX W1,FP.SGN!FP.SYM!FP.PTR ;[2333] SET SOME FLAGS FOR FX BLOCK XCT T1070S(T3) CAIE T2,6 ;SKIP IF SYMBOL FIXUP JRST T1070F ;JUMP IF ADDITIVE TXO W1,FS.FXS ;FLAG SYMBOL FIXUP PUSHJ P,SY.QS## POPJ P, T1070F: HRR W1,2(P1) SUB P1,NAMLOC PUSHJ P,SY.FX0## ADD P1,NAMLOC HRRM W3,2(P1) POPJ P, ;E - EXTENDED SYMBOL NAME T1070E: MOVEI T1,0(W2) ;N (NAME LENGTH ) IN W2 PUSH P,W1 ;SAVE FLAGS PUSHJ P,D.GET1 ;GET 1ST WORD OF NAME JRST LOAD## ; PUSH P,W1 ;SAVE 1ST WORDS OF NAME PUSHJ P,D.GET1 ;GET 2ND WORD OF NAME JRST LOAD## ; JUMPN W1,LNGNM ;WE DO HAVE A LONG NAME, JUMP POP P,W2 ;ONLY A SHORT NAME , INTO W2 SOJLE T1,.+4 ;FINISHED? PUSHJ P,D.GET1 ;NO, MORE NULLS PADDED JRST LOAD## ; JRST .-3 ;SKIPE OVER THEM POP P,W1 ;RECOVER FLAGS POPJ P, ;AND RETURN ;HERE IF WE REALLY HAVE A LONG NAME ; 0(P)/ 1ST WORD OF NAME ; -1(P)/ FLAGS ;[2305] stores the symbol name in SYMBLK ;[2305] stores count,,symblk in W2 LNGNM: POP P,W2 ;1ST WORD OF NAME EXCH W1,0(P) ;FLAGS INTO W1, AND 2ND WORD OF NAME ON STACK ADDI T1,1 ;[2305] number of words of symbol name MOVEM W2,SYMBLK ;[2305] store the first word HRLZ W2,T1 ;[2305] into the left half of w2 HRRI W2,SYMBLK ;[2305] address of symbol to w2 MOVEI T1,1 ;[2305] set up index to symblk POP P,T2 ;[2305] get the second word MOVEM T2,SYMBLK(T1) ;[2305] store it away AOS T1 HLRZ T2,W2 ;[2305] get the count to t2 SUBI T2,2 ;[2305] minus the words already done SKIPN T2 ;[2371] if only 2 words then POPJ P, ;[2371] done so return MOVNS T2 ;[2305] -count HRLS T2 HRR T2,T1 ;[2305] AOBJN pointer PUSH P,W1 ;[2305] save the flags T1070M: PUSHJ P,D.GET1 ;[2305] get the next name word JRST LOAD MOVEM W1,SYMBLK(T2) ;[2305] store the next word AOBJN T2,T1070M POP P,W1 ;[2305] restore the flags POPJ P, SUBTTL BLOCK TYPE 1072 - POLISH FIXUPS (SUPPORT LONG SYMBOLS) ; ---------------- ; ! 1072! COUNT ! ; ---------------- ; ! BYTE ! BYTE ! ; ---------------- ;THE POLISH FIXUP BLOCK IS STORED IN THE FX AREA ;THE ACTION IS :- ;(1) READ AND RELOCATE THE FIXUPS ; STORE THEM IN FX AREA ;(1A) FIND THE STORE OPERATOR, AND DELETE THE FIXUP IF ; NOT WANTED (DUE TO NON-LOADED LOCAL OR /ONLY). ;(2) CHECK AND EVALUATE GLOBAL REQUESTS ; STORE VALUES BACK IN FIXUP ;(3) IF THERE ARE NO UNDEFINED GLOBAL REQUESTS ; EVALUATE POLISH AND STORE ;(4) IF THERE ARE UNDEFINED REQUESTS ; LINK GLOBAL SYMBOL TO FIXUP AREA AND CONTINUE ;(5) WHEN LAST UNDEFINED GLOBAL IS DEFINED ; EVALUATE AND STORE ;(6) IF STORE ADDRESS IS PAGED TO DSK ; STORE BACK IN FIXUP AREA AND PROCESS AT END ;HERE TO READ BLOCK AND STORE IN FX AREA T.1072: HRRZI T2,2(W1) ;WORD COUNT HRLZM T2,T11FA ;STORE BLOCK SIZE PUSHJ P,FX.GET## ;GET SPACE IN FX AREA SUB T1,FX.LB ;RELATIVE .JDDT LNKNEW,T.1072,<> MOVE W2,T1 ;SAFE PLACE FOR POINTER HRRM T1,T11FA ;STORE STARTING ADDRESS MOVEI W3,2(W2) ;BYTE POINTER TO START OF FIXUP HRLI W3,(POINT 18) MOVEM W3,T11BP ;STORE INITIAL BYTE POINTER SUBI W3,1 ;W3 ALSO POINTS TO GLOBAL COUNT HRLI W1,(FP.SGN!FP.POL!FF.NEW) ;[2212] SET POLISH FIXUP BITS ADDI W1,2 ;ACCOUNT FOR OVERHEAD WORDS ADD W2,FX.LB ;FIX IN CORE ADD W3,FX.LB ;... MOVEM W1,(W2) ;STORE HEADER WORD PLUS SYMBOLS SETZM 1(W2) ;CLEAR GLOBAL COUNT ADDI W2,2 ;BYPASS ;Now read in 2 half words at a time from buffer ;Check to see if a half word is one of the following: ; 1. Psect index ; 2. Operator code ; 3. Store operator code ; 4. Data operator code ;[2212] The primary purpose here is to do the relocation calculation for ;[2212] a relocatable data when one is encountered, and to change the ;[2212] halfword relocatable operator and the store operators to a ;[2212] different format which allows section numbers to be preserved. MOVE P2,T11BP ;[2212] Byte pointer which will find store op SETZ P3, ;[2212] Start by reading the first halfword PUSHJ P,X72GN ;[2212] Get the first halfword JRST LOAD## ;[2212] Completely empty block PUSH P,RC.CUR ;[2212] Save current psect JRST X72RD2 ;[2212] Join the main loop X72RDF: PUSHJ P,X72SGN ;[2212] Eat a fullword as two halfwords PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block X72RDH: PUSHJ P,X72SGN ;[2212] Eat a halfword PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block ;[2212] Read and decode the next operator X72RD: PUSHJ P,X72SGN ;[2212] Get next halfword PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block ;[2212] Check for a psect index X72RD2: CAIL T1,PL.IL ;[2212] Psect index? JRST X72PSI ;[2212] Yes ;[2212] Check for a data operator JUMPE T1,X72RDH ;[2212] If absolute halfword, ignore next half CAIN T1,PL.ABF ;[2212] Absolute Fullword? JRST X72RDF ;[2212] Yes, Ignore two halfwords CAIN T1,PL.RLH ;[2212] Relocatable halfword? JRST X72RRH ;[2212] Yes, relocate next halfword CAIN T1,PL.RLF ;[2212] Relocatable fullword? JRST X72RRF ;[2212] Yes, relocate the next fullword ;[2212] Check for an operator CAIL T1,PL.OL ;[2212] Too low for operator? CAILE T1,PL.OH ;[2212] Or too high? CAIA ;[2212] Not an operator JRST X72RD ;[2212] An operator, ignore it ;[2212] Check for a store operator or symbol operator MOVE T2,T1 ;[2212] Get the code TRZ T2,LENGTH ;[2212] Ignore the count CAIL T2,PL.SL ;[2212] Store operator? JRST X72SOP ;[2212] Yes CAIN T2,PL.SYM ;[2212] Symbol operator? JRST X72RDS ;[2212] Yes, skip a bunch of halfwords PUSHJ P,X72IPO ;[2212] Not a valid operator ;[2212] Here to handle a psect index X72PSI: MOVEI R,-400000(T1) ;[2212] Get the psect index CAMLE R,RC.NO ;[2212] In bounds? PUSHJ P,E$$IPX ;[2212] No, die HRRZ R,@RC.MAP ;[2212] Get the internal psect index MOVEM R,RC.CUR ;[2212] Set the current index JRST X72RD ;[2212] Read more operators ;[2212] Here to relocate a fullword X72RRF: PUSHJ P,X72SGN ;[2212] Get next halfword PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block MOVE W3,T1 ;[2212] Keep this halfword PUSHJ P,X72SGN ;[2212] Get next halfword PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block HRL T1,W3 ;[2212] Get back the left half PUSHJ P,R.CUR## ;[2212] Relocate it JRST X72BAK ;[2212] Put back the whole word ;[2212] Here to relocate a halfword. This requires replacing the operator, ;[2212] since part of the operator field must be used to remember the section ;[2212] number. X72RRH: PUSHJ P,X72SGN ;[2212] Get next halfword PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block PUSHJ P,R.CUR## ;[2212] Relocate it TLO T1,PL.NEW ;[2212] Set new halfword operator bits ;Here to put back a fullword in the polish string X72BAK: JUMPE P3,X72BA1 ;[2212] Was last a right half? HLRM T1,-1(W2) ;[2212] No, left half is in the previous word HRL W1,T1 ;[2212] Right half is in left half of this one JRST X72RD ;[2212] Continue reading the polish string X72BA1: MOVE W1,T1 ;[2212] Just replace the entire word JRST X72RD ;[2212] It will be stored soon ;[2212] Here to read a symbol X72RDS: LSH T1,-^D9 ;[2212] Get the length JUMPE T1,X72R50 ;[2212] Check for radix-50 special case CAILE T1,MAXSYM/3-1 ;[2212] Make sure symbol not too big PUSHJ P,E$$STL ;[2212] Can't handle it MOVEI W3,1(T1) ;[2212] Count of halfwords to read X72RS1: PUSHJ P,X72SGN ;[2212] Get next halfword PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block SOJG W3,X72RS1 ;[2212] Ignore all of them JRST X72RD ;[2212] Go back for next operator X72R50: PUSHJ P,X72SGN ;[2212] Get next halfword PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block MOVE W3,T1 ;[2212] Keep this half around PUSHJ P,X72SGN ;[2212] Get next halfword PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block PUSH P,W2 ;[2212] Keep the pointer safe MOVE W2,T1 ;[2212] get the right half HRL W2,W3 ;[2212] And the left half PUSHJ P,R50T6## ;[2212] Convert it to sixbit MOVE T1,W2 ;[2212] Put it where it belongs POP P,W2 ;[2212] Get back the pointer JRST X72BAK ;[2212] Put the word back in the block ;[2212] Here to get a polish halfword and store the previous one. This ;[2212] routine de-blocks the full words supplied by D.GET1 into halfwords. ;[2212] P3 / 0 to read left half, 1 to read right half ;[2212] P2 / Byte pointer for store op ;[2212] W2 / Byte pointer for store ;[2212] W1 / Full word read (returned) ;[2212] T1 / Next halfword (returned) ;[2212] This routine parallels the T11SGN routine in LNKOLD. X72SGN: JUMPN P3,X72GN1 ;[2212] JUST PROCESSED RHS? MOVEM W1,(W2) ;[2212] YES--STORE OLD WORD NOW ADDI W2,1 ;[2212] COUNT ANOTHER WORD STORED X72GN: JUMPN P3,X72GN1 ;[2212] TIME TO READ A NEW WORD? PUSHJ P,D.GET1 ;[2212] YES--GET ONE POPJ P, ;[2212] NO MORE--GIVE NON-SKIP RETURN HLRZ T1,W1 ;[2212] FIRST TIME GIVE LHS MOVEI P3,1 ;[2212] SIGNAL RHS FOR NEXT TIME IBP P2 ;[2212] COUNT ANOTHER BYTE JRST CPOPJ1 ;[2212] GIVE GOOD RETURN X72GN1: HRRZ T1,W1 ;[2212] TIME FOR RHS MOVEI P3,0 ;[2212] SIGNAL LHS FOR NEXT TIME IBP P2 ;[2212] COUNT ANOTHER BYTE JRST CPOPJ1 ;[2212] GIVE GOOD RETURN ;[2212] Here on store. X72SOP: MOVEM W1,(W2) ;[2212] Make sure the last halfword is stored ADD P2,FX.LB ;[2212] Relocate the store operator pointer TRNE T1,S.ADR ;[2212] An address? JRST X72SAD ;[2212] Yes, go handle it ;[2212] Here to test for a symbol and to determine if it is needed PUSH P,T1 ;[2212] Save the store operator MOVE T2,T1 ;[2212] Get a copy of the store operator TRZ T2,777770 ;[2212] Clear all but last digit PUSH P,[FS.FXF ;[2212] 754 Save bit for this fixup type FS.FXE ;[2212] 755 FS.FXL ;[2212] 756 FS.FXR]-4(T2) ;[2212] 757 LSH T1,-^D9 ;[2212] Get the length JUMPE T1,X72S50 ;[2212] Special if Radix 50 CAIN T1,1 ;[2212] Short symbol? JRST X72SSM ;[2212] Yes, handle differently ;[2212] Here for long symbol. Copy it into SYMBLK. CAILE T1,MAXSYM/3-1 ;[2212] Make sure symbol not too big PUSHJ P,E$$STL ;[2212] Can't handle it MOVE W3,T1 ;[2212] Keep the count in a better place PUSH P,T1 ;[2212] And save it for SY.RQS call MOVE P1,[POINT 18,SYMBLK] ;[2212] Get a pointer to a static area X72SOL: PUSHJ P,X72BYT ;[2212] Get the next three characters PUSHJ P,E$$ISM## ;[2212] Not complete? IDPB T1,P1 ;[2212] Store the characters SOJGE W3,X72SOL ;[2212] Keep going until all done POP P,W3 ;[2212] Get the count back ADDI W3,1 ;[2212] Make it a true count TRNN W3,1 ;[2212] Is it odd? JRST X72SEV ;[2212] No, even SETZ T1, ;[2212] Yes, IDPB T1,P1 ;[2212] Zero the extra halfword ADDI W3,1 ;[2212] Account for it X72SEV: LSH W3,-1 ;[2212] Convert to words HRLZ W3,W3 ;[2212] Put count in left half HRRI W3,SYMBLK ;[2212] Count,,Pointer JRST X72SYM ;[2212] Go see if needed ;[2212] Here for radix-50 symbols. Replace with SIXBIT, treat as short symbol. X72S50: PUSHJ P,X72BYT ;[2212] Get the next halfword PUSHJ P,E$$ISM ;[2212] Not complete? HRL W2,T1 ;[2212] Hold onto it PUSHJ P,X72BYT ;[2212] Get one more PUSHJ P,E$$ISM ;[2212] Not complete? HRR W2,T1 ;[2212] Get the rest of the symbol PUSHJ P,R50T6## ;[2212] Convert to SIXBIT MOVE W3,W2 ;[2212] Get the symbol in the correct AC JRST X72SYM ;[2212] Go see if needed ;[2212] Here for short symbol. Build it in W3. X72SSM: PUSHJ P,X72BYT ;[2212] Get the next halfword PUSHJ P,E$$ISM## ;[2212] Not complete? HRL W3,T1 ;[2212] Hold onto it PUSHJ P,X72BYT ;[2212] Get one more PUSHJ P,E$$ISM ;[2212] Not complete? HRR W3,T1 ;[2212] Get the rest of the symbol ; JRST X72SYM ;[2212] See if needed ;[2255] Here for a symbol. See if it is needed, and if so replace ;[2255] the symbol name and old store operator with the new store ;[2255] operator and the section number of the symbol in the LS area, ;[2255] followed by the rest of the LS pointer for the symbol, followed ;[2255] by the GS pointer to the symbol. X72SYM: POP P,W1 ;[2212] Restore the bits PUSHJ P,SY.QS## ;[2212] See if we want this symbol JRST [POP P,0(P) ;[2212] Non-loaded local, clean up stack PUSHJ P,T.11RT## ;[2212] Return block JRST LOAD##] ;[2212] And exit POP P,T1 ;[2212] Restore the op code TRZ T1,^-7 ;[2212] Get the last digit ADDI T1,PL.NSS ;[2212] Add the base for new fullword operator LSH T1,^D12 ;[2212] Put it in the high order bits HLRZ T2,LSTLCL ;[2255] Get the local symbols section number ADD T1,T2 ;[2255] Put it in the opcode word DPB T1,P2 ;[2212] Store the new store op code HRRZ T2,LSTLCL ;[2212] Get the right half of the LS pointer IDPB T2,P2 ;[2212] Store it MOVE T2,LSTGBL ;[2255] Get the Global symbols pointer IDPB T2,P2 ;[2212] Store it ;[2212] If this block is to be extended to handle FAIL block names ;[2212] code should be added here. ;[2212] It should read the symbol and store it into the block using P2 ;[2212] so that it can be recognized correctly. This may make the ;[2212] block shorter but that should not matter. JRST X72GC ;[2212] Check for undefined symbols ;[2212] Set up address for memory fixup X72SAD: MOVE P1,T1 ;[2212] Save the store operator TRNN T1,LENGTH ;[2212] Non-zero length? JRST X72SAH ;[2212] No, it's a halfword store ;[2212] Here to handle fullword (possibly relocatable) PUSHJ P,X72BYT ;[2212] Get a halfword PUSHJ P,E$$NAP## ;[2212] Not complete? MOVE W3,T1 ;[2212] Hold on to it PUSHJ P,X72BYT ;[2212] Get another halfword PUSHJ P,E$$NAP ;[2212] Not complete? HRL T1,W3 ;[2212] Put fullword in T1 TRNE P1,S.REL ;[2212] Is this relocatable? PUSHJ P,R.CUR ;[2212] Yes, relocate it TRZ P1,^-7 ;[2212] Get the last digit ADDI P1,PL.NSF ;[2212] Add the base for new fullword operator LSH P1,^D12 ;[2212] Put it in the high order bits DPB P1,P2 ;[2212] Store the new operator HLRZ T2,T1 ;[2212] Get left half (section number) IDPB T2,P2 ;[2212] Store it IDPB T1,P2 ;[2212] Store right half (address) JRST X72GC ;[2212] Check for undefined symbols ;[2212] Here to handle halfword (possibly relocatable) X72SAH: PUSHJ P,X72BYT ;[2212] Get a halfword PUSHJ P,E$$NAP ;[2212] Not complete? TRNE P1,S.REL ;[2212] Is this relocatable? PUSHJ P,R.CUR ;[2212] Yes, relocate it TRZ P1,^-7 ;[2212] Get the last digit ADDI P1,PL.NSH ;[2212] Add the base for new fullword operator LSH P1,^D12 ;[2212] Put it in the high order bits HLRZ T2,T1 ;[2212] Get left half (section) ADD T2,P1 ;[2212] Add in the opcode DPB T2,P2 ;[2212] Store it IDPB T1,P2 ;[2212] Store right half (address) JRST X72GC ;[2212] Check for undefined symbols ;[2212] Here to read a byte into T1. Similar to X72SGN except that ;[2212] the word is not stored and the byte pointers are not updated. X72BYT: JUMPN P3,X72BT1 ;[2212] Just processed RHS? PUSHJ P,D.GET1 ;[2212] Yes--get one POPJ P, ;[2212] No more--Give non-skip return HLRZ T1,W1 ;[2212] First time give LHS MOVEI P3,1 ;[2212] Signal RHS for next time JRST CPOPJ1 ;[2212] Give good return X72BT1: HRRZ T1,W1 ;[2212] Time for RHS MOVEI P3,0 ;[2212] Signal LHS for next time JRST CPOPJ1 ;[2212] Give good return ;[2212] Here to count and evaluate global requests. This routine uses ;[2212] P1 and P2 as temporaries, and assumes that they are the accumulators ;[2212] after T4, since the extend instructions require 6 contiguous ACs. X72GC: POP P,RC.CUR ;[2212] Restore the psect index MOVE W1,T11BP ;[2212] Reset byte pointer ADD W1,FX.LB ;[2212] Fix in core JRST X72G1 ;[2212] Bypass first time X72G0: IBP W1 ;[2212] Bypass next half word X72G1: ILDB T1,W1 ;[2212] Read half word CAIL T1,PL.NSO ;[2212] Store operator (new style) JRST X72GE ;[2212] Yes CAIL T1,PL.NEW ;[2212] Halfword data operator? JRST X72G0 ;[2212] Yes, eat the next halfword CAIL T1,PL.IL ;[2212] Psect index? JRST X72G1 ;[2212] Yes, ignore it JUMPE T1,X72G0 ;[2212] If absolute halfword eat 1 halfword CAIE T1,PL.ABF ;[2212] Fullword absolute? CAIN T1,PL.RLF ;[2212] Or fullword relocatable? AOJA W1,X72G1 ;[2212] Yes, ignore the next 2 halfwords CAIL T1,PL.OL ;[2212] Too low for operator? CAILE T1,PL.OH ;[2212] Or too high? CAIA ;[2212] Not an operator JRST X72G1 ;[2212] An operator, ignore it ;[2212] Here if global symbol request. Find out if long or short, and ;[2212] prepare for TRYSYM. MOVE T2,W1 ;[2212] Save the pointer for ILDB or MOVSLJ SUB W1,FX.LB ;[2212] In case the area moves PUSH P,W1 ;[2212] Save the pointer LSH T1,-^D9 ;[2212] Get the length PUSH P,T1 ;[2212] Save the length CAIG T1,1 ;[2212] Short symbol (or converted radix-50)? JRST X72GS ;[2212] Yes ;[2212] Here if long symbol. Copy it into SYMBLK and build a pointer to it ADDI T1,1 ;[2212] Make into correct count MOVE T4,T1 ;[2212] Also destination count TLNE T4,1 ;[2212] Is it odd? ADDI T4,1 ;[2212] Make it even (fullword for TRYSYM) HRLZ W2,T4 ;[2212] Save the destination size MOVE P1,[POINT 18,SYMBLK] ;[2212] Destination EXTEND T1,[MOVSLJ T1, ;[2212] Move to word-aligned static area 0] ;[2212] Fill with zero byte if necessary JFCL ;[2212] Destination is always largest LSH W2,-1 ;[2212] Make the size in words HRRI W2,SYMBLK ;[2212] Count,,pointer for TRYSYM JRST X72TRY ;[2212] See if it's defined ;[2212] Here for short symbol X72GS: ILDB T1,T2 ;[2212] Get left half of symbol ILDB W2,T2 ;[2212] Get right half part HRL W2,T1 ;[2212] Full symbol in W2 X72TRY: .JDDT LNKNEW,X72GS,<< CAMN W2,$SYMBOL##>> MOVX W1,PT.SGN!PT.SYM ;[2212] Set the bits PUSHJ P,TRYSYM## ;[2212] See if defined JRST X72ND ;[2212] No, need to define it JRST X72UN ;[2212] Undf, so just as bad POP P,T1 ;[2212] Get the count back POP P,W1 ;[2212] Restore byte pointer to start of symbol ADD W1,FX.LB ;[2212] Add core offset MOVEI T2,PL.ABF ;[2212] Get an absolute fullword operator DPB T2,W1 ;[2212] Replace the symbol operator MOVS T2,2(P1) ;[2212] Get value (reversed) IDPB T2,W1 ;[2212] Store left half of value MOVSS T2 ;[2212] Swap the value back IDPB T2,W1 ;[2212] Store right half of value SOJLE T1,X72G1 ;[2212] Find out how many words left ;[2212] (done if short symbol) MOVEI T2,PL.IL ;[2212] Get a no-op (psect index is good here) X72GZ: IDPB T2,W1 ;[2212] Clobber extra symbol name halfword SOJG T1,X72GZ ;[2212] Continue until none left JRST X72G1 ;[2212] Done with this symbol X72GE: MOVE W3,T11BP ;[2212] Get pointer back to beginning ADD W3,FX.LB ;[2212] Add base of area SKIPN -1(W3) ;[2212] Any undefined globals? PUSHJ P,T1072E ;[2212] No, evaluate fixup now JRST LOAD## ;[2212] Else wait till all defined ;[2212] Here if global symbol not in global symbol table yet ;[2212] Treat as if additive global request ;[2212] Get extended triplet and point to fixup triplet in fixup area ;[2212] In turn this triplet points to the polish fixup ;[2212] NOTE AT THIS POINT W1, W2, AND W3 ARE USED FOR NON-SYMBOL ;[2212] STUFF, THEY MUST BE SAVED X72ND: AOS USYM ;[2212] Increment undef count TXO W1,PS.REQ ;Usual flags PUSH P,W1 ;Save primary flags PUSH P,[0] ;Zero value MOVX W1,S.FXP ;Secondary symbol flag PUSHJ P,GS.FX0## ;Put in global table MOVX W1,FP.SGN!FP.SYM!FP.PTR!FP.POL ; HRRZ W3,T11FA ;Address (relative to fx.lb) of polish PUSHJ P,SY.FX0## ;Now put into fixup table PUSHJ P,SY.GX0## ;Link to global X72GD: POP P,W1 ;[2212] Get back the length POP P,T1 ;[2212] And the byte pointer in a temporary ADD T1,FX.LB ;[2212] Relocate again SKIPN W1 ;[2212] Was this radix-50? MOVEI W1,1 ;[2212] Yes, set to length-1 ADDI W1,1 ;[2212] Get the actual length ADJBP W1,T1 ;[2212] Pass the symbol, result back in W1 MOVE W3,T11BP ADD W3,FX.LB ;... AOS -1(W3) ;Bump count of undefined symbols JRST X72G1 ;Get next half word ;[2212] Here to see if fixup requests exist for this symbol ;[2212] If so add to chain, if not create chained list in extended symbol X72UN: MOVE W1,0(P1) ;Flags go in W1 now TXNE W1,PS.FXP ;Already fixups defered? JRST X72DF ;[2212] Yes, just link to chain MOVEI T1,.L ;[612] Need another triplet PUSHJ P,SY.MOV## ;[612] So stretch current one MOVX W1,PS.FXP ;[612] We now have a fixup triplet IORM W1,0(P1) ;[612] So mark it SUB T1,GS.LB ;[612] Get rel. addr of new triplet PUSH P,T1 ;[612] Save it MOVX W1,FP.SGN!FP.SYM!FP.PTR!FP.POL ;[612] Ptr to polish HRRZ W3,T11FA ;[612] To try again when syms defined PUSHJ P,SY.FX0## ;[612] Put w1-w3 in FX area POP P,T1 ;[612] Restore pointer into GS ADD T1,GS.LB ;[612] Make absolute again MOVX W1,S.FXP!S.LST ;Pointer to fixup chain TMOVEM W1,0(T1) ;[612] Store in new triplet JRST X72GD ;[612] Return to scan rest of polish ;HERE IF FIXUP REQUEST EXISTS ALREADY ;JUST LINK INTO FRONT OF CHAIN X72DF: ADDI P1,.L ;[2212] Look for additive global request SKIPG W1,0(P1) ;Get secondary flags PUSHJ P,E$$ISP## ;[2212] Primary or no flags set TXNN W1,S.FXP ;Is this the one JRST X72DF ;[2212] No try again SKIPN W1,2(P1) ;Get pointer, better be non-zero PUSHJ P,E$$ISP## ;[2212] Bad pointer HRLI W1,(FP.SGN!FP.SYM!FP.PTR!FP.POL) ; HRRZ W3,T11FA ;Point to polish SUB P1,NAMLOC ;Incase core moves PUSH P,P1 ;Save unrelocated pointer PUSHJ P,SY.FX0## ;Put in fixup area POP P,P1 ;Restore pointer ADD P1,NAMLOC ;Relocate it HRRM W3,2(P1) ;Fixup request pointer chain JRST X72GD ;Get next half-word ;HERE TO EVALUATE POLISH FIXUP T1072E::SKIPN W3,POLSTK ;[2212] Get stack pointer PUSHJ P,T.11PD## ;[2212] Not setup yet MOVEI T3,100 ;Incase of on operator MOVEM T3,SVSAT PUSH W3,[MXPLOP##+100] ;Fake operator MOVE W2,T11BP ;Setup read byte pointer IFN DEBSW,< MOVEI W1,-2(W2) ;[632] POINT TO 1ST WORD OF BLOCK > ;END IFN DEBSW .JDDT LNKOLD,T1072E,<> ;[632] ADD W2,FX.LB ;Fix in core X72RP: ILDB W1,W2 ;Read a half-word MOVEM W1,SAVCOD CAIL W1,PL.NSO ;[2212] Store operator (new style) JRST X72ST ;[2212] Yes CAIL W1,PL.NEW ;[2212] Halfword data operator? JRST X72RH ;[2212] Yes, eat the next halfword CAIL W1,PL.IL ;[2212] Psect index? JRST X72RP ;[2212] Yes, ignore it JUMPE W1,X72AH ;[2212] If absolute halfword eat 1 halfword CAIE W1,PL.ABF ;[2212] Fullword absolute? CAIN W1,PL.RLF ;[2212] Or fullword relocatable? JRST X72FO ;[2212] Yes, ignore the next 2 halfwords CAIL W1,PL.OL ;[2212] Too low for operator? CAILE W1,PL.OH ;[2212] Or too high? JRST X72IPO ;[2212] Not an operator, illegal ; JRST X72OP ;[2212] An operator, stack it ;[2212] Handle operators X72OP: AOBJN W3,.+2 ;[2212] Check for overflow PUSHJ P,T.11PL# ;[2212] Overflow-go enlarge stack MOVEM W1,(W3) ;[2212] Save operator on stack MOVE T3,DESTB##-100(W1) ;Get number of operands needed MOVEM T3,SVSAT ;Also save it JRST X72RP ;[2212] Back for more X72IPO: MOVE W1,SAVCOD ;[2212] Remember what's the problem X72RPE: PUSHJ P,E$$IPO## ;[2212] Invalid polish operator ;[2212] Handle operands ;[2212] Absolute halfword X72AH: ILDB T2,W2 ;[2212] Get the operand JRST X72P0 ;[2212] Handle the value ;[2212] Relocatable halfword - Looks sort of like a fullword X72RH: TRZA W1,PL.NEW ;[2212] Get rid of opcode, leaving section ;[2212] Relocatable or absolute Fullword X72FO: ILDB W1,W2 ;[2212] Get the first halfword ILDB T2,W2 ;[2212] Get the second halfword HRL T2,W1 ;[2212] Put both together ; JRST X72P0 ;[2212] Handle the value X72P0: SETZ T1, ;[2212] Value operand X72P1: SOJL T3,X72ES ;[2212] Enough operands seen AOBJN W3,.+2 ;[2212] Check for overflow PUSHJ P,T.11PL# ;[2212] Overflow-go enlarge stack MOVEM T2,(W3) ;[2212] Save operator on stack HRLI T1,400000 ;Put in a value marker AOBJN W3,.+2 ;[2212] Check for overflow PUSHJ P,T.11PL# ;[2212] Overflow-go enlarge stack MOVEM T1,(W3) ;[2212] Save operator on stack JRST X72RP ;Get more polish ;Here when we have enough operands for the current operator X72ES: SKIPN SVSAT ;[2212] Is it unary JRST X72UO ;[2212] Yes, no need for 2nd operand POP W3,T1 ;[2212] Pop off marker POP W3,T1 ;And value X72UO: POP W3,T3 ;Operator XCT OPTAB##-100(T3) ;Both values just XCT MOVE T2,T1 ;Get the current value SKIPG T3,(W3) ;Is there a value in the stack? MOVE T3,-2(W3) ;Yes, this must be the operator MOVE T3,DESTB##-100(T3) ;Get number of operands needed MOVEM T3,SVSAT ;Save it here SKIPG (W3) ;Was there an operand SUBI T3,1 ;Have one operand already JRST X72P1 ;[2212] Go see what we should do now ;Here to store the final value X72ST: MOVE T2,-2(W3) ;[2212] This should be the fake operator CAIE T2,MXPLOP##+100 ;[2212] Is it PUSHJ P,X72IPO ;[2212] No ILDB T2,W2 ;[572] Get core addr or LS pointer HRL T2,W1 ;[2212] Get the section (zero for symbols) TLZ T2,PL.NMX ;[2212] Remove the high order (opcode) bits MOVE W3,-1(W3) ;Get the value after ignoring the flag LSH W1,-^D12 ;[2212] Get the opcode PUSHJ P,@STRT72-PL.NS(W1) ;[2212] Call the correct fixup routine PJRST T.11RT## ;[2212] All done, now give space back ;Store operator action table ;**;[2324] Change 2 lines at STRT72. PAH 16-Jul-84 STRT72: T11CHF## ;[2324] 0764 0774 Fullword chained X72CHE ;[2324] 0765 0775 Thirty bit chained T11CHL## ;[2212] 0766 0776 Left half chained T11CHR## ;[2212] 0767 0777 Right half chained X72FWS ;[2212] 1764 1774 Fullword chained X72FWS ;[2212] 1765 1775 Thirty bit chained X72FWS ;[2212] 1766 1776 Left half chained X72FWS ;[2212] 1767 1777 Right half chained T11SYF## ;[2212] xxx754 Fullword symbol X72SYE ;[2212] xxx755 Thirty bit symbol T11SYL## ;[2212] xxx756 Left half symbol T11SYR## ;[2212] xxx757 Right half symbol ;**;[2324] Add 7 lines at STRT72+13. PAH 14-Jul-84 ;[2324] Here to clear P1 before going to the thirty-bit chained fixup ;[2324] routine -- that routine calls others which interpret a nonzero ;[2324] value in P1 as a fixup block pointer. X72CHE::SETZ P1, ;[2324] Clear leftover pointer so P1 ;[2324] isn't treated as a fixup pointer PUSHJ P,SY.CHF## ;[2324] Do the fullword chained fixup POPJ P, ;[2324] And return to the dispatcher X72SYE: MOVX W1,FS.FXE ;[2212] Thirty bit fixup JRST SY.ASP## ;[2212] Join symbol fixup code X72FWS: ILDB W2,W2 ;[2212] Get the next byte HRL T2,W2 ;[2212] Put it in T2 MOVSS T2 ;[2212] Correct order SUBI W1, ;[2212] Fix up store opcode PJRST @STRT72-PL.NS(W1) ;[2212] Go to the correct fixup routine E$$STL::.ERR. (MS,.EC,V%L,L%F,S%F,STL,) ;[2007] .ETC. (JMP,,,,,.ETIMF##) SUBTTL BLOCK TYPE 1074 - FORTRAN COMMON BLOCK ; --------------------------------- ; ! 1074 ! COUNT ! ; --------------------------------- ; ! PSECT INDEX ! SYMBOL LENGTH ! ; --------------------------------- ; ! COMMON BLOCK LENGTH ! ; --------------------------------- ; ! SIXBIT COMMON BLOCK NAME ! ; --------------------------------- ; ! (MORE SIXBIT NAME) ! ; --------------------------------- T.1074::PUSHJ P,D.GET1 ;[2310] Get the index,,length JRST LOAD## ;[2310] Empty block HLRZ R,W1 ;[2310] Get the psect index CAMLE R,RC.NO ;[2340] In bounds? PUSHJ P,E$$IPX ;[2340] No, die HRRZ R,@RC.MAP ;[2310] Convert to internal psect index MOVE R,@RC.TB ;[2310] Get the RC block MOVE W3,RC.CV(R) ;[2310] Get the current value HRRZ W2,W1 ;[2310] Get number of characters PUSHJ P,D.GET1 ;[2310] Get the COMMON block size JRST [MOVEI T1,1074 ;[2310] No next word? JRST E$$RBS##] ;[2310] Bad rel block PUSH P,W1 ;[2310] Save the length PUSHJ P,SYMIN1 ;[2310] Read the symbol JRST [MOVEI T1,1074 ;[2310] Symbol fouled up? JRST E$$RBS##] ;[2310] Bad rel block POP P,W1 ;[2310] Restore the length PUSHJ P,T.COMM## ;[2310] Build the common block JRST LOAD## ;[2310] Done HRRZ P1,@HT.PTR ;[2310] Set up pointer to symbol ADD P1,GS.LB ;[2310] Unrelocate it MOVE W3,.L+2(P1) ;[2310] Get the common length ADDB W3,RC.CV(R) ;[2310] Bump relocation counter CAML W3,RC.LM(R) ;[2310] Check against the limit PUSHJ P,TOOBIG## ;[2310] Too big, give a warning JRST LOAD## ;[2310] > ;IFN .NWBLK SUBTTL ASCIZ TEXT BLOCK ; ------------- ; ! A S C I I ! ; ------------- ; ! T E X T 0 ! ; ------------- IFN .ASBLK,< LNKASC::TRNE FL,R.LIB!R.INC ;[602] ARE WE LOADING? JRST ASCSKP ;[602] NO, SKIP OVER THIS TEXT BLOCK MOVEI T2,^D128 ;USE STANDARD BUFFER OF 200 WORDS PUSHJ P,DY.GET## MOVEM T1,F.ASCC ;USE COUNT TO HOLD CURRENT POINTER HRLI T1,(POINT 7,,35) ;BUILD THE BYTE POINTER MOVEM T1,F.ASCI ;INITIAL AREA POINTER ASCT0: MOVEI P1,1(T1) ;FIRST WORK IS USED AS A LINK IF MORE DATA TLO P1,-^D127 ;FORM AOBJN POINTER JRST ASCT2 ;JUMP INTO WORD STASHING LOOP ASCT1: PUSHJ P,D.RED1## ;GET WORD FROM REL FILE JRST ASCFIN ;END OF FILE ASCT2: MOVEM W1,(P1) ;STORE TEXT WORD TRNN W1,177B34 ;FINISHED IF NULL BYTE JRST ASCFIN ;YES AOBJN P1,ASCT1 ;NO, LOOP UNLESS BLOCK FULL MOVEI T2,^D128 ;GET ANOTHER BLOCK PUSHJ P,DY.GET## MOVEM T1,@F.ASCC ;STORE POINTER MOVEM T1,F.ASCC ;POINT TO NEW BLOCK MOVEI P1,1(T1) ;FORM BYTE POINTER AGAIN HRLI P1,-^D127 JRST ASCT1 ;AND CONTINUE ASCFIN: MOVEI T1,^D127*5 ;CHARACTERS PER BLOCK MOVEM T1,F.ASCC ;SET COUNT FOR FIRST BLOCK PUSH P,F.NXZR ;REMEMBER POINTER TO END PUSH P,F.INZR ;SAVE CURRENT FILE SPEC POINTERS PUSH P,SWFLAG ;AND SWITCHES INZLOC: SETZM F.INZR ;NOW CLEAR THEM SETZM F.NXZR SWFLOC: SETZM SWFLAG ASZLOC: HLLZM FL,F.ASZR ;STORE GLOBAL FLAGS IN LH JRST LNKSCN## ;GO TO SCANNER FOR INCORE COMMAND ;HERE TO PROCESS ASCII TEXT IN /INCLUDE OR /SEARCH MODE. JUST IGNORE IT. ASCSKP: TRNN W1,177B34 ;[602] END OF ASCIZ STRING? JRST LOAD## ;[602] YES, PROCESS NEXT BLOCK TYPE PUSHJ P,D.IN1## ;[602] GET NEXT WORD, GOTO LOAD IF EOF JRST ASCSKP ;[602] AND CONTINUE IGNORING IT ;RETURN HERE ASCRET::HRRZ T1,F.ASZR ;SEEN ANY FILE NAMES YET? JUMPN T1,ASCRT2 ;YES, NOT LOOKING AT SWITCHES POP P,T1 ;RESTORE OLD SWFLAG EXCH T1,SWFLAG ;PUT INCORE ONES FIRST SKIPA T3,SWFLOC ;LOOK FOR END OF LIST ASCRT1: MOVE T3,T2 ;STORE OLD MOVE T2,(T3) ;GET NEXT POINTER TRNE T2,-1 ;0 LINK IS END JRST ASCRT1 ;NOT YET HRRM T1,(T3) ;LINK OLD SWITCHES IN PUSH P,SWFLAG ;NOW SAVE REVISED SWITCH LIST ASCRT2: PUSHJ P,ASZCHN ;LINK NEW SPECS TO OLD F.ASZR TRNE T1,-1 ;ANY SPECS SEEN THIS PASS? PUSHJ P,INSEOL ;YES, INSERT /CRLF FOR SWITCHES SETZM F.INZR ;NOW CLEAR VARIABLES FOR NEXT TIME SETZM F.NXZR ;SO WON'T CONFUSE CLANS MOVE T1,F.ASCI ;PICK UP POINTER TO CURRENT TEXT CAME T1,[-1] ;REACHED EOF YET? JRST LNKSCN## ;NO, GO PROCESS NEXT LINE POP P,SWFLAG ;YES, RESTORE THINGS TO EARLIER POP P,F.INZR ;OLD F.INZR (REST REAL COMMAND) PUSHJ P,ASZCHN ;CHAIN OLD LINE TO END OF NEW TRNE T1,-1 ;ANY MORE THIS REAL COMMAND LINE? PUSHJ P,INSEOL ;YES, INSERT /CRLF HLLO T2,F.ASZR ;LAST TIME, SO RESET GLOBAL FLAGS TRNE T1,-1 ;T1 EITHER 0 OR ADDR OF SWITCH MOVEM T2,2(T1) ;SWITCH, STORE VALUE POP P,F.NXZR ;END OF NEW CHAIN SAME AS OLD MOVE T1,F.ASZR ;PUT WHOLE CHAIN IN F.INZR HRRZM T1,F.INZR ;SO LNKWLD CAN FIND IT SETZM F.ASZR ;NOW CLEAN UP ASCII TEXT DATA BASE SETZM F.ASCI ;.. SETZM F.ASCC ;.. SETZM F.ASCK JRST LOAD ;CONTINUE WITH CURRENT .REL FILE ;HERE TO FOLLOW THE F.ASZR CHAIN, AND APPEND THE F.INZR CHAIN ; TO IT. RETURNS OLD F.INZR IN T1 ASZCHN: SKIPA T3,ASZLOC ;GET ADDR OF HEAD OF LIST ASZCN1: MOVE T3,T2 ;REMEMBER LAST ADDR IN CASE END HRRZ T2,F.NXT(T3) ;FOLLOW CHAIN JUMPN T2,ASZCN1 ;IF NOT DONE, CONTINUE MOVE T1,F.INZR ;GET START OF F.INZR CHAIN HRRM T1,F.NXT(T3) ;STORE AT END OF F.ASZR CHAIN POPJ P, ;DONE ;HERE TO PUT A GLOBAL SWITCH BLOCK ONTO THE SCAN BLOCK POINTED TO BY ; F.INZR TO INDICATE THAT /CRLF PROCESSING IS NEEDED BEFORE THIS FILE ; SPEC IS PROCESSED. THIS RESETS EOL DEFAULTS, ETC. SINCE THE POSITION ; OF CRLFS IS FORGOTTEN DURING ASCII BLOCK PROCESSING. THIS ROUTINE ; RETURNS THE ADDRESS OF THE ADDED SWITCH BLOCK IN T1. INSEOL: MOVEI T2,3 ;SWITCH BLOCKS ARE 3 WORDS PUSHJ P,DY.GET## ;GRAB ONE MOVSI T2,3 ;1ST WORD IS LEN,,ADDR OF NEXT MOVEM T2,0(T1) ;STORE IN BLOCK MOVEI T2,%CRLF% ;2ND WORD IS TOKEN VALUE MOVEM T2,1(T1) ;STORE IT TOO HRRZ T2,F.INZR ;GET POINTER TO NEW SCAN BLOCK HLRZ T3,F.SWP(T2) ;GET ADDR OF CURRENT SWITCHES HRLM T1,F.SWP(T2) ;REPLACE WITH ADDR OF THIS BLOCK HRRM T3,0(T1) ;LINK IN ANY OLD SWITCHES POPJ P, ;NOW CALCULATE THE VALUE OF %CRLF% FROM THE SWMAC MACRO. DEFINE SWMAC(A,B,C,D,E,F,G,H,I),< IF1,< IFIDN ,< IFNDEF %CRLF%,< %CRLF%==TK. >> TK.==TK.+1 >> TK.==0 ;INITIAL CONDITION SWTCHS >;END IFN .ASBLK SUBTTL NEW BLOCK TYPE INPUT ROUTINES COMMENT ^ THESE ROUTINES COUNT BLOCK LENGTH AND DO RELOCATION AS FOLLOWS: AC WC CONTAINS THE NEGATIVE COUNT OF WORDS LEFT UNTIL THE NEXT RELOCATION WORD IN THE LEFT HALF, AND THE NEGATIVE COUNT OF WORDS LEFT IN THE CURRENT BLOCK IN THE RIGHT HALF. BIT 18 IS OFF SO THAT THE OVERFLOW OF THE RIGHT HALF WILL NOT AFFECT THE LEFT HALF ON KA10'S. THE ROUTINES FOR THOSE BLOCK TYPES THAT DO NOT EXPECT RELOCATION WORDS SHOULD SET THE LEFT HALF OF WC TO 400000 (BY USE OF THE RELOCATE MACRO) SO THAT THE CURRENT "RELOCATION BLOCK" WILL NEVER EXPIRE. AC RB CONTAINS THE CURRENT RELOCATION WORD. EACH TIME THAT A NEW RELOCATION BYTE IS REQUIRED, RB (= R+1) IS SHIFTED C(RELSIZ) BITS TO THE LEFT, THEREBY SETTING UP R. IF WE ARE NOT LOADING DATA THAT CONTAINS RELOCATION WORDS, THIS CODE IS STILL EXECUTED, BUT SINCE RB ALWAYS CONTAINS ZERO, THE CODE IS ALWAYS CONSIDERED ABSOLUTE. NOTE THAT LH(WC) IS NOT KEPT UP TO DATE IF LOADING A BLOCK TYPE THAT DOES NOT INCLUDE RELOCATION WORDS, AND PROCESSING ROUTINES FOR THOSE BLOCK TYPES MAY SAVE OVERHEAD BY CALLING D.GET? INSTEAD OF D.REL?, ALTHOUGH D.REL? WILL WORK CORRECTLY IF CALLED. ^ IFN .NWBLK,< ;SUBROUTINE TO READ IN A TRIPLET FROM THE CURRENT BLOCK. ;CALL IS: ; ; PUSHJ P,D.TRIP ; NO DATA RETURN (END OF BLOCK OR END OF FILE) ; HERE WITH W1-W3 SETUP ; ;USES W1-W3, T1-T2. D.TRIP::PUSHJ P,D.GET1 ;GET NEXT WORD, CHECKING FOR END OF DATA POPJ P, ;NONE LEFT MOVE W3,W1 ;SAVE FLAGS FOR LATER PUSHJ P,D.GET1 ;GET SYMBOL, IF THERE POPJ P, ;IT'S NOT MOVE W2,W1 ;POSITION SYMBOL CORRECTLY PUSHJ P,D.REL1 ;NOW READ VALUE, POSSIBLY RELOCATING POPJ P, ;OH WELL EXCH W1,W3 ;PUT FLAGS & VALUE IN CORRECT PLACES JRST CPOPJ1 ;GOOD RETURN ;ROUTINES TO GET THE NEXT WORD FROM THE DATA FILE AND DO ANY ;RELOCATION NECESSARY AS INDICATED BY RELSIZ, WC, AND RB. CALL IS: ; ; PUSHJ P,D.REL? ; NO DATA RETURN ; OK RETURN ; ;RETURNS THE NEXT WORD IN W1, OR W2 & W1. USES T1-T2. D.REL2::PUSHJ P,D.REL1 ;GET THE FIRST WORD POPJ P, ;NONE LEFT MOVE W2,W1 ;SAVE FIRST WORD ;FALL IN TO GET SECOND WORD D.REL1::TRNN WC,377777 ;MORE DATA IN THIS BLOCK? POPJ P, ;NO, RETURN NO DATA PUSHJ P,D.RED1## ;YES, GET NEXT WORD JRST E$$PEF ;[1174] WORD COUNT WAS WRONG AOBJN WC,DRELN ;GO RELOCATE UNLESS NEED NEW SUB-BLOCK MOVE RB,W1 ;SAVE THE NEW RELOCATION WORD MOVNI T1,^D36 ;FIND SIZE OF THIS SUB-BLOCK IDIV T1,RELSIZ ;FROM THE BYTE SIZE TRNE FL,R.LHR ;LEFT HALF RELOCATION DATA TOO? ASH T1,-1 ;YES, ONLY 1/2 AS MANY WORDS IN BLOCK HRL WC,T1 ;AND RESET SUB-BLOCK COUNT PUSHJ P,D.GET1 ;NOW GET 1ST DATA WORD OF NEW BLOCK POPJ P, ;??? DRELN: SETZ R, ;ZAP SOME BITS LSHC R,@RELSIZ ;GRAB RELOCATION BYTE JUMPE R,CPOPJ1 ;IF ABSOLUTE, WE'RE DONE ; SKIPN R,@RC.TB ;ELSE SET UP R FOR RELOCATION BLOCK ; JRST E$$IRC ;[1174] RELOCATED TO SEGMENT NOT SET UP ;********* ADD MORE CODE HERE ******************************** E$$IRC::.ERR. (MS,.EC,V%L,L%F,S%F,IRC,) ;[1174] .ETC. (JMP,,,,,.ETNMF##) > ;END IFN .NWBLK< ;HERE TO GET THE NEXT WORD FROM THE CURRENT BLOCK. RETURNS NON-SKIP ;ON END OF BLOCK OR END OF FILE. EXPECTS WC TO BE SET UP FROM LNKLOD. D.GET1::TRNN WC,377777 ;END OF BLOCK ON LAST WORD? POPJ P, ;YES, NO MORE DATA PUSHJ P,D.RED1## ;NO, GET NEXT WORD JRST E$$PEF ;[1174] PREMATURE END OF FILE AOJA WC,CPOPJ1 ;COUNT WORD & GIVE GOOD RETURN CPOPJ1: AOS 0(P) ;THE USUAL CPOPJ: POPJ P, ;HERE WHEN THE .REL FILE HAS A PREMATURE EOF. E$$PEF::.ERR. (MS,.EC,V%L,L%F,S%W,PEF,) ;[1174] .ETC. (FSP,,,,,DC) POPJ P, ;TRY TO CONTINUE SUBTTL WORD RELOCATION FOR BLOCK 1070 ;ROUTINE TO RELOCATE A WORD (USED BY BLOCK 1070) ; ; PUSHJ P,REL.1 ; NO DATA RETURN ; OK RETURN (W1/ RETURN VALUE) ; ;ENTER WITH: ; ; R/ TEMP. PSECTS (-1 IF NOT USED) ; RB/ RELOCATION TYPE ; RC.CUR/ CUREENT PSECT ; ;ACS USED: R,RB,T1,W1,W3 ; ;RETURN VALUES: ; W1/ FLAG ; W3/ VALUE IFN .NWBLK,< ;[1000] REL.1::TRNN WC,377777 ;MORE DATA IN THIS BLOCK? POPJ P, ;NO, RETURN NO DATA PUSHJ P,D.GET1 ;GO GET A WORDS POPJ P, ;??? MOVE W3,W1 ;RETURN VALUE IN W3 SETZ W1, ;CLEAR RETURN FLAG WORD JUMPE RB,CPOPJ1 ;IF ABS, OK RETURN MOVX W1,PS.REL ;RELOCATABLE SYMBOL JUMPGE R,REL.T ;JUMP IF TEMPORARY PSECTS SPECIFIED PUSHJ P,@[ REL.R ;1 - RIGHT HALF REL.L ;2 - LEFT HALF REL.B ;3 - BOTH HAVES REL.E ;4 - EXTENDED(30BIT) REL.F]-1(RB) ;5 - FULL WORD JRST CPOPJ1 ;SKIP RETURN REL.T: PUSH P,RC.CUR ;USE TEMP. PSECTS INSTEAD OF CURRENT ONE PUSHJ P,@[ REL.TR ;1 - RIGHT HALF REL.TL ;2 - LEFT HALF REL.TB ;3 - BOTH HALVES REL.TE ;4 - EXTENDED(30 BIT) REL.TF]-1(RB) ;5 - FULL WORD POP P,RC.CUR ;RESTORE ORIGINAL PSECT JRST CPOPJ1 ;AND SKIP RETURN REL.B: PUSHJ P,REL.L ;RELOCATE LEFT WITH CUREENT PSECT FIRST JRST REL.R ;THEN DO THE SAME WITH RIGHT HALF REL.TB: PUSH P,R ;SAVE FOR RIGHT PUSHJ P,REL.TL ;RELOCATE LEFT WITH TEMP. PSECT POP P,R ;[1720] REL.TR: HRRZ R,@RC.MAP ;[1716] TRANSLATE RH PSECT INDEX TO INTERNAL HRRM R,RC.CUR ;TEMPORARILY SWITCH CURRENT PSECT REL.R: HRR T1,W3 ;ADDRESS IN T1 PUSHJ P,R.CUR## ;GO RELOCATE IT WITH CURRENT PSECT HRR W3,T1 ;RETURN VALUE IN W3 POPJ P, ; REL.TL: HLRZ R,R ;[1716] GET LH PSECT INDEX HRRZ R,@RC.MAP ;[1716] TRANSLATE TO INTERNAL PSECT INDEX HRRM R,RC.CUR ;[1716] SWITCH CURRENT PSECT REL.L: HLR T1,W3 ;SET UP ADDRESS IN T1 PUSHJ P,R.CUR## ;GO RELOCATE IT HRL W3,T1 ;RETURN VALUE IN W3 POPJ P, ; REL.TE: HRRZ R,@RC.MAP ;[1716] TRANSLATE RH PSECT INDEX TO INTERNAL HRRM R,RC.CUR ;SWITCH CURRENT PSECT REL.E: LDB T1,[POINT 30,W3,35] PUSHJ P,R.CUR## ; LDB W3,[POINT 30,T1,35] POPJ P, REL.TF: HRRZ R,@RC.MAP ;[1716] TRANSLATE RH PSECT INDEX TO INTERNAL HRRM R,RC.CUR ;SWITCH CURRENT PSECT REL.F: MOVE T1,W3 ;SET UP ADDRESS IN T1 PUSHJ P,R.CUR## ;GO RELOCATE IT MOVE W3,T1 ;RETURN VALUE IN W3 POPJ P, ; > ;IFN .NWBLK SUBTTL SUPPORT CODE FOR 11XX BLOCKS DEFINE NEWBLX(SIZ,NUM,TYP,DSP,PRC,XIT)< SETZM NORBYT ;;[1456] PUSH P,[ PRC ] ;;DATA WORD PROCESSOR MOVE P1,[POINT SIZ,RB] ;;HOW TO ACCESS RELOC BYTES MOVEI P2,NUM ;;NUMBER OF RELOC BYTES MOVE P4,[ TYP ] ;;HOW TO DO THE RELOC PUSHJ P,DSP ;;COMMON CODE TO INTERPRET THIS IFNB , ;;[1471] JRST LOAD ;;TO GET BACK TO MAIN LOOP > ;[1423] T.11XX:: ; ; T.1100 through T.1137 come here after setting up ACs as follows: ; P1 -an initialized byte pointer for the relocation bytes ; P2 -number of relocation bytes in the word ; P4 -dispatch address for type of relocation (30bit) ; ; First set up stack. POP P,T1 ;[1405] UNSTACK RETURN ADDRESS EXCH T1,(P) ;[1405] SWAP WITH PROCESSOR ADDRESS PUSH P,T1 ;[1405] RETURN ONLY WHEN THRU AOS P2 ;[1423] SUBBLOCK INCLUDING RELOC WORD SPUSH ;[1423] SAVE REGISTERS MOVN T1,(P) ;[1423] SETUP WC HRL WC,T1 ;[1423] ; Note the data blocksize as some processors need this data. HRRZ P3,WC ;[1405] TDO P3,[-1,,400000] ;[1405] REAL NEGATIVE NUMBER MOVNS P3 ;[1405] NOW POSITIVE PUSH P,P4 ;[1405] SAVE P4 IDIVI P3,1(P2) ;[1405] INCLUDE HEADER IN BLOCKSIZE IMULI P3,1(P2) ;[1405] MAXIMUM DATA BLOCKSIZE SKIPE P4 ;[1405] IF NONZERO RESIDUE ADDI P3,-1(P4) ;[14YY] ADD IT, MINUS HEADER POP P,P4 ;[1405] GET P4 BACK T11XXR: ; BEGIN PROCESSING A SUB-BLOCK PUSHJ P,PB.1 ;[1405] FETCH FIRST WORD OF BLOCK JRST [ SPOP POPJ P, ] ;[1405] NO MORE IN BLOCK JFCL ;[1405] IMPOSSIBLE" MOVE RB,W1 ;[1405] SETUP RELOC BYTE MOVE P1,-1(P) ;[1405] RESET BYTEPOINTER ; BEGIN PROCESSING THE LIST T11XXL: PUSHJ P,PB.1 ;[1423] FETCH A DATA WORD JRST [ SPOP POPJ P, ] ;[1423] NO MORE JRST [ SKIPE RB,NORBYT ;[1456] JRST T11XXA ;[1456] MOVE P2,(P) MOVE P1,-1(P) MOVN T1,P2 HRL WC,T1 JRST T11XXR ] ;[1423] RESET FOR NEXT SUBBLOCK T11XXA: PUSHJ P,PSORGN ;[1456] GET ANY PSECT INDICES PUSHJ P,@P4 ;[1423] DO THE RELOCATION PUSHJ P,@-2(P) ;[1405] AND THE PROCESSING JRST T11XXL ;[1423] DO IT AGAIN SUBTTL BLOCK TYPES 1100-1104 - PROGRAM DATA VECTORS T.1100:: NEWBLX(2,^D18,THADD,T.11XX,T.110X) ;[1423] T.1101:: NEWBLX(3,^D12,THADD,T.11XX,T.110X) ;[1423] T.1102:: NEWBLX(6,6,THADD,T.11XX,T.110X) ;[1423] T.1103:: NEWBLX(9,4,THADD,T.11XX,T.110X) ;[1423] T.1104:: NEWBLX(18,2,THADD,T.11XX,T.110X) ;[1423] T.110X: SKIPE W1 ;[1423] IGNORE ZEROS MOVEM W1,PDVADR## ;[1423] STORE PDV ADDR ;** MAKE THIS WORK RIGHT FOR MULTIPLE PDVS ** POPJ P, SUBTTL BLOCK TYPES 1120-1124 -- TYPE CHECKING BLOCKS DEFINE T112XM(N)< NEWBLX(N,<^D36/N>,THADD,T.11XX,T.112X,T112XP) > ;[1472] T.1120:: T112XM(2) ;[1472] T.1121:: T112XM(3) ;[1472] T.1122:: T112XM(6) ;[1472] T.1123:: T112XM(^D9) ;[1472] T.1124:: T112XM(^D18) ;[1472] T.112X: SETOM NORBYT ;[1456] DON'T READ ANY MORE RELOC BYTES SKIPGE P3 ;[1405] FIRST TIME THRU? JRST T112X ;[1405] NO MOVEI T2,ABOVH(P3) ;[2270] MUST ALLOCATE A STORAGE BLOCK SKIPE PAG.TP ;[2270] TP AREA PAGING? JRST T112P ;[2270] YES PUSHJ P,TP.GET## ;[2270] NO, ALLOCATE IN TP AREA SKIPE PAG.TP ;[2270] DID IT JUST START PAGING? T112P: PUSHJ P,DY.GET## ;[2270] PAGING, GET SPACE IN DY AREA MOVEM T2,ABSIZ(T1) ;[2270] STORE SIZE MOVE W3,PRGNAM ;[2005] GET THE MODULE NAME MOVEM W3,ABMOD(T1) ;[2020] SAVE IT MOVE W2,T1 ;[2270] ADDRESS OF THE BLOCK MOVEI W3,ABABA(T1) ;[2020] SAVE A PTR MOVN T2,P3 ;[1405] HRL W3,T2 ;[1405] MAKE W3 AN AOBJN PTR SETOM P3 ;[1405] SAY WE'VE BEEN HERE T112X: MOVEM W1,(W3) ;[1405] STORE THE DATA ADD W3,[1,,1] ;[1471] POPJ P, ;[1405] GET MORE T112XP: MOVE T1,ABCNT(W2) ;[2266] GET THE CHARACTER COUNT SUBI T1,1 ;[2307] ACCOUNT FOR THE NULL IDIVI T1,6 ;[2307] IN WORDS SKIPE T2 ;[2266] ANY LEFT? ADDI T1,1 ;[2266] YES, NEED ONE MORE WORD HRLZ W3,T1 ;[2266] PUT IT IN AS THE SYMBOL LENGTH HRRI W3,SYMBLK ;[2266] THE SYMBOL IN WILL BE IN SYMBLK SETZM SYMBLK-1(T1) ;[2266] MAKE SURE NO JUNK IN LAST WORD MOVE T4,ABCNT(W2) ;[1472] NOTE COUNT MOVE T2,[POINT 7,ABNAM(W2)] ;[1472] MOVE T3,[POINT 6,SYMBLK] ;[2266] PUT IT IN SYMBLK T112X0: SOJL T4,T112X1 ;[1472] STOP WHEN ALL CHARS DONE ILDB T1,T2 ;[1472] PICK UP ASCII JUMPE T1,T112X1 ;[1472] NUL MUST BE END OF ASCIZ SUBI T1," " ;[1472] ASCII TO SIXBIT IDPB T1,T3 ;[1472] ACCUMULATE JRST T112X0 ;[1472] T112X1: EXCH W3,W2 ;[1472] W2/SIXBIT,W3/PTR PUSHJ P,SY.TYP## ;[1472] POPJ P, SUBTTL BLOCK TYPE 1130 -- COERCION BLOCK T.1130:: PUSHJ P,STDATA ;[1704] USE GENERAL ROUTINE MOVEM W2,COERPT ;[1405] JRST LOAD## ;[1701] SUBTTL BLOCK TYPE 1131 - PSECT REDIRECTION ; --------------------- ; ! 1131 ! COUNT ! ; --------------------- ; ! 0 ! INDEX ! ; --------------------- ; ! LOWSEG PSECT NAME ! ; --------------------- ; ! HIGHSEG PSECT NAME! ; --------------------- ;Where a psect name is: ; --------------------- --------------------- ; ! SIXBIT PSECT NAME ! ! 0 ! MBZ ! COUNT ! ; --------------------- --------------------- ; ! (ATTRIBUTES) ! ! SIXBIT PSECT NAME ! ; --------------------- --------------------- ; ! ADDITIONAL NAME ! ; --------------------- ; ; . ; ; . ; ; --------------------- ; ! ADDITIONAL NAME ! ; --------------------- T.1131: PUSHJ P,X131GT ;[2223] Get the low psect JRST [MOVEI T1,1131 ;[2223] No psect name is JRST E$$RBS##] ;[2223] an error JUMPE W2,X131HI ;[2223] No symbol, try high segment EXCH W2,REDLO ;[2223] Save it, get old PUSHJ P,X131RT ;[2223] Return the old symbol X131HI: PUSHJ P,X131GT ;[2223] Get the high psect JRST [MOVEI T1,1131 ;[2223] No psect name is JRST E$$RBS##] ;[2223] an error JUMPE W2,X131DF ;[2272] Done if no symbol EXCH W2,REDHI ;[2223] Save it, get old PUSHJ P,X131RT ;[2223] Return the old symbol X131DF: MOVE T1,['.LOW. '] ;[2272] Get the default low seg psect SKIPN REDLO ;[2272] Is there a low seg psect? MOVEM T1,REDLO ;[2272] No, default it MOVE T1,['.HIGH.'] ;[2272] Get the default high seg psect SKIPN REDHI ;[2272] Is there a high seg psect? MOVEM T1,REDHI ;[2272] No, default it JRST LOAD## ;[2223] Done ;[2223] Here to read a possibly long symbol into the DY area. ;[2223] On exit, W2 contains the symbol. X131GT: PUSHJ P,D.GET1 ;[2223] Get the symbol POPJ P, ;[2223] Not there MOVE W2,W1 ;[2223] Put it in W2 TLNE W2,770000 ;[2223] Long symbol? JRST CPOPJ1 ;[2223] No, done CAIN W2,1 ;[2223] Short symbol in disguise? JRST [PUSHJ P,D.GET1 ;[2223] Yes, get one word POPJ P, ;[2223] No word means bad rel block MOVE W2,W1 ;[2223] Put it in W2 JRST CPOPJ1] ;[2223] Return with a short symbol MOVE T2,W2 ;[2223] Get the length JUMPE T2,CPOPJ1 ;[2223] Zero, no symbol PUSHJ P,DY.GET ;[2223] Allocate some space HRL T1,T2 ;[2223] Build length,,address PUSH P,T1 ;[2223] Store it MOVNS W2 ;[2223] Negate the count HRLZS W2 ;[2223] Put it in the left half HRR W2,T1 ;[2223] Make an AOBJN word X131GL: PUSHJ P,D.GET1 ;[2223] Get a word JRST [POP P,W2 ;[2223] No more, clear up stack POPJ P,] ;[2223] Return MOVEM W1,(W2) ;[2223] Save the word AOBJN W2,X131GL ;[2223] Do all words POP P,W2 ;[2236] Restore count,,address JRST CPOPJ1 ;[2223] Done, return OK ;[2223] Here to return a possibly long symbol in the DY area. ;[2223] On entry, W2 contains the symbol. X131RT: HLRZ T2,W2 ;[2231] Get the count JUMPE T2,CPOPJ ;[2223] Done if empty TRNE T2,770000 ;[2223] Long symbol? POPJ P, ;[2223] No, done HRRZ T1,W2 ;[2223] Long symbol PJRST DY.RET## ;[2223] Return the space SUBTTL BLOCK TYPE 1160 -- SPARSE DATA ; -------------------------------- ; | 1160 | Long Count | ; -------------------------------- ; |R|F|B|P|Symlen| Psect | ; -------------------------------- ; | Symbol (Symlen words) | ; -------------------------------- ; |S| Origin address | ; -------------------------------- ; | Repetition Count if R=1 | ; -------------------------------- ; | Fill Count if F=1 | ; -------------------------------- ; | Fill Byte if F=1 | ; -------------------------------- ; | Byte Count if B=1 | ; -------------------------------- ; | Data Bytes | ; -------------------------------- T.1160: PUSHJ P,D.GET1 ;[2262] Get the first word of the rel block JRST LOAD## ;[2262] Empty block MOVE R,W1 ;[2262] Save the psect number etc. LDB T1,[POINTR R,X60.P] ;[2262] Get the byte position MOVEM T1,BYTPOS ;[2262] Save it LDB W2,[POINTR R,X60.SL] ;[2262] Get the symbol length SETZ W3, ;[2262] Zero the symbol value JUMPE W2,X160NS ;[2262] Is there a symbol? PUSHJ P,SYMIN1 ;[2262] Read the symbol JRST [MOVEI T1,1160 ;[2262] No symbol? JRST E$$RBS##] ;[2262] Bad rel block MOVX W1,PT.SGN!PT.SYM!PS.GLB ;[2262] Set the flags PUSHJ P,TRYSYM## ;[2262] See if defined JRST E$$USD ;[2262] Not even in table JRST E$$USD ;[2262] Undefined, so still no use MOVE W3,2(P1) ;[2262] Get value IFN FTOVERLAY,< ;[2262] CAMGE W3,PH+PH.ADD ;[2262] Make sure array is in this link JRST T.1SE## ;[2262] No, must be common in father link >;[2262] IFN FTOVERLAY X160NS: PUSHJ P,D.GET1 ;[2262] Get the next word JRST [MOVEI T1,1160 ;[2262] No next word? JRST E$$RBS##] ;[2262] Bad rel block LDB T1,[POINTR W1,X60.S] ;[2262] Get the byte size MOVEM T1,BYTSIZ ;[2262] Save it LDB T1,[ADDRES W1] ;[2262] Get the address part ADD W3,T1 ;[2262] Add the symbol part TRNN R,-1 ;[2262] Psect relocation required? JRST X160NP ;[2262] No PUSH P,R ;[2262] Keep the bits around PUSH P,RC.CUR ;[2327] Save the current psect PUSHJ P,REL.TE ;[2262] Relocate the address (30 bit) POP P,RC.CUR ;[2327] Restore the current psect HRRM R,0(P) ;[2262] Keep the RC block pointer POP P,R ;[2262] Get them back X160NP: MOVEM W3,BYTADR ;[2262] Save the low address for the data MOVEI W1,1 ;[2262] Get the default repetition count TXNN R,X60.R ;[2262] Repetition count? JRST X160NR ;[2262] No PUSHJ P,D.GET1 ;[2262] Get the repetition count JRST [MOVEI T1,1160 ;[2262] No count? JRST E$$RBS##] ;[2262] Bad rel block JUMPE W1,T1000C ;[2262] If zero, don't bother X160NR: MOVEM W1,REPCNT ;[2262] Save the repetition count SETZM FILCNT ;[2262] Assume no fill TXNN R,X60.F ;[2262] Fill required? JRST X160NF ;[2262] No PUSHJ P,D.GET1 ;[2262] Get fill count JRST [MOVEI T1,1160 ;[2262] No count? JRST E$$RBS##] ;[2262] Bad rel block MOVEM W1,FILCNT ;[2262] Save it PUSHJ P,D.GET1 ;[2262] Get fill character JRST [MOVEI T1,1160 ;[2262] No character? JRST E$$RBS##] ;[2262] Bad rel block MOVEM W1,FILCHR ;[2262] Save it X160NF: MOVEI W1,1 ;[2262] Default byte count TXNN R,X60.B ;[2262] Byte count given? JRST X160NB ;[2262] No, no byte count PUSHJ P,D.GET1 ;[2262] Get byte count JRST [MOVEI T1,1160 ;[2262] No count? JRST E$$RBS##] ;[2262] Bad rel block X160NB: MOVEM W1,BYTCNT ;[2262] Save it PUSHJ P,X160SZ ;[2262] Set up for size calculations T1160S: SUB W1,T1 ;[2262] Minus number of bytes in first word IDIV W1,BYTPWD ;[2262] Number of extra words needed SKIPE W2 ;[2262] Any extra bytes? ADDI W1,1 ;[2262] Yes, account for them ADD W1,BYTADR ;[2262] Add first address to get last MOVEM W1,LSTBYT ;[2262] Remember it MOVE P3,BYTADR ;[2262] Get the first byte address HRRZS R ;[2262] Get only the psect number SETOM TP.PP ;[2270] Don't page the TP area for this PUSHJ P,T.1AD## ;[2262] Try and allocate all of it JRST [SETZM TP.PP ;[2270] Allow TP area paging JRST T1000C] ;[2270] And ignore it (/ONLY switch in use) PUSHJ P,T160DF ;[2262] Move window if deferred (less than 140) SETZM TP.PP ;[2270] Allow the TP area to page IFN FTOVERLAY,< ;[2313] MOVN T1,PH+PH.ADD ;[2313] Get -base of overlay ADDM T1,BYTADR ;[2313] Offset the first address ADDM T1,LSTBYT ;[2313] Offset the last address >;[2313] IFN FTOVERLAY ;[2262] Memory has been allocated. Set up for the loop to copy from the ;[2262] rel file buffer into memory. ;[2262] Set up number of bytes available in current source buffer MOVE R,RC.SG(R) ;[2262] Get the high/low segment index MOVE T1,DCBUF+2 ;[2262] Get the number of words in the buffer IMUL T1,BYTPWD ;[2262] Number of bytes in buffer MOVEM T1,SRCCNT ;[2262] Remember it ;[2262] Set up number of bytes which can be stored into in current ;[2262] destination buffer MOVE T4,TAB.AB(R) ;[2262] Get the top of the area SUB T4,TAB.LB(R) ;[2262] Minus bottom equals size ADD T4,TAB.LW(R) ;[2262] Add the value of the bottom to get top SUB T4,BYTADR ;[2262] Minus start address is what's left IMUL T4,BYTPWD ;[2262] Number of bytes available MOVE T1,BYTPOS ;[2262] Save it MOVE T3,BYTSIZ ;[2262] Get the byte size IDIVI T1,(T3) ;[2262] See how many bytes left in first word ADD T1,T4 ;[2262] Add bytes in first word MOVEM T1,DSTCNT ;[2262] Destination count ;[2262] Build the source byte pointer. Note that pointer is to end of ;[2262] previous word, and will be bumped by the MOVSLJ. MOVE T1,BYTSIZ ;[2262] Get the byte size HRRZ T2,DCBUF+1 ;[2262] Get the source pointer to the buffer DPB T1,[POINT 6,T2,11] ;[2262] Set up the byte size ;[2262] Build the destination byte pointer MOVE P1,BYTADR ;[2262] Get the byte address SUB P1,TAB.LW(R) ;[2262] Minus the window offset ADD P1,TAB.LB(R) ;[2262] Relocate DPB T1,[POINT 6,P1,11] ;[2262] Put byte size in the byte pointer MOVE T1,BYTPOS ;[2262] Get the byte position DPB T1,[POINT 6,P1,5] ;[2262] Put it in the byte pointer MOVE W3,BYTCNT ;[2262] Get number of bytes to move DMOVE T3,DCBUF+1 ;[2262] Get location and size of buffer DMOVEM T3,BUFBEG ;[2262] Remember them ;[2262] Loop to copy from the input buffers to the output windows. X160NX: PUSHJ P,X160BF ;[2262] Make sure the buffer is not empty PUSHJ P,X160CW ;[2262] Check the window ;[2262] Find the number of bytes which can be copied MOVE T4,W3 ;[2262] Get the number of bytes desired CAMLE T4,SRCCNT ;[2262] More than in the source buffer? MOVE T4,SRCCNT ;[2262] Yes, can't do more than that CAMLE T4,DSTCNT ;[2262] More than can fit in window? MOVE T4,DSTCNT ;[2262] Yes, do only that much MOVN T1,T4 ;[2262] Get minus what will be copied ADDM T1,SRCCNT ;[2262] Update the source count ADDM T1,DSTCNT ;[2262] And the destination count MOVE T1,T4 ;[2262] Put count in both places SUB W3,T4 ;[2262] Remember how many have been done SETZB T3,P2 ;[2262] Just to be safe EXTEND T1,[MOVSLJ] ;[2262] Copy the string JFCL ;[2262] Should not run out JUMPN W3,X160NX ;[2262] Continue until all bytes copied ;[2262] Now fix up the source buffer pointers. Use stored original ;[2262] pointers and the source byte pointer. SKIPGE DCBUF+1 ;[2262] Is it new buffer pointer never ILDB'd? ADDI T2,1 ;[2262] Yes, Point at next word HRRM T2,DCBUF+1 ;[2262] And fix up the pointer HRRZ T3,BUFBEG ;[2262] Get the beginning of the buffer ADD T3,BUFLEN ;[2262] Plus length is end of buffer SUBI T3,(T2) ;[2262] Minus how far was used MOVEM T3,DCBUF+2 ;[2262] Restore it into DCBUF ;[2262] Here to do fill if necessary SKIPN W3,FILCNT ;[2262] Get the fill count JRST X160RP ;[2262] None, go do repeat count MOVX P3, ;[2262] Get the op code for the fill MOVE P4,FILCHR ;[2262] And the fill byte X160FL: PUSHJ P,X160CW ;[2262] Check the window ;[2262] Find the number of bytes which can filled this time MOVE T4,W3 ;[2262] Get the number of bytes desired CAMLE T4,DSTCNT ;[2262] More than can fit in window? MOVE T4,DSTCNT ;[2262] Yes, do only that much SUB W3,T4 ;[2262] Remember how many have been done MOVN T3,T4 ;[2262] Get minus what will be copied ADDM T3,DSTCNT ;[2262] Update the destination count SETZ T1, ;[2262] No source characters SETZB T3,P2 ;[2262] Just to be safe EXTEND T1,P3 ;[2262] Fill as many as possible JFCL ;[2262] Skips if filling JUMPN W3,X160FL ;[2262] Do them all ;[2262] Here to handle the repeat count X160RP: SOSG REPCNT ;[2262] Need to copy again? JRST LOAD## ;[2262] No, done ;[2262] Here to pick a method for handling the repeat count. ;[2262] If all of the data will fit in the current window, just ;[2262] copy it with the MOVSLJ. If one copy of the data will ;[2262] fit in memory, and there is more than about 1/4 of the ;[2262] window (must be at least 1 page) free, copy what is ;[2262] possible with the MOVSLJ, move the window, and continue ;[2262] copying. Otherwise, split the window into two smaller ;[2262] windows, get a copy of the data into one, and copy it ;[2262] to the other. ;[2366] On TOPS-10 there are a couple extra wrinkles. If the ;[2366] area is split into source and destination windows, their ;[2366] contents must not overlap. This means that the windows ;[2366] must be shorter than the size of the data items. This ;[2366] means that, for an item less than one page long, the ;[2366] window size would be zero. It is necessary to use a ;[2366] one window move for such data. It is also possible ;[2366] that the area will be only one page long. If it will ;[2366] be necessary to move the window, at least two pages ;[2366] will be necessary. MOVE W3,FILCNT ;[2262] Get the fill count ADDB W3,BYTCNT ;[2262] Include it in the byte count IMUL W3,REPCNT ;[2262] Total number of bytes to move IFE TOPS20,< ;[2366] MOVE T1,BYTCNT ;[2366] Get number of bytes IDIV T1,BYTPWD ;[2366] Size in words CAIGE T1,.IPS ;[2366] Less than one page? JRST X160SS ;[2366] Yes, special case >;[2366] IFE TOPS20 MOVE T3,BYTADR ;[2262] Get the origin address CAMGE T3,TAB.LW(R) ;[2262] Outside of the window? JRST X160CX ;[2262] Yes, too big for one window CAMG W3,DSTCNT ;[2262] That many bytes left? JRST X160SM ;[2262] Yes, it will fit in one window MOVE T1,TAB.AB(R) ;[2262] Get the upper bound SUBI T1,(P1) ;[2262] Minus what is left CAIG T1,.IPS ;[2262] More than a page? JRST X160CX ;[2262] No, too big for one window IMULX T1,4 ;[2262] 4 times what's left MOVE T3,TAB.AB(R) ;[2262] Get the upper bound SUB T3,TAB.LB(R) ;[2262] Minus the lower CAMGE T1,T3 ;[2262] More than a quarter of the window left? JRST X160CX ;[2262] No, use two windows X160SM: MOVE T2,BYTADR ;[2262] Get the first copy's address SUB T2,TAB.LW(R) ;[2262] Minus the window bound ADD T2,TAB.LB(R) ;[2262] Relocate it MOVE T3,BYTSIZ ;[2262] Get the byte size DPB T3,[POINT 6,T2,11] ;[2262] Put byte size in the byte pointer MOVE T3,BYTPOS ;[2262] Get the byte position DPB T3,[POINT 6,T2,5] ;[2262] Put it in the byte pointer X160SL: MOVE T1,W3 ;[2262] Get the number of bytes left to copy CAML T1,DSTCNT ;[2262] Less than what can be done? MOVE T1,DSTCNT ;[2262] Yes, do that many SUB W3,T1 ;[2262] Update what's left to do MOVN T4,T1 ;[2262] Get minus how many to do ADDM T4,DSTCNT ;[2262] Update count of what's left MOVE T4,T1 ;[2262] Both counts the same SETZB T3,P2 ;[2262] Just to be safe EXTEND T1,[MOVSLJ] ;[2262] Copy the string JFCL ;[2262] Should not run out JUMPE W3,LOAD## ;[2262] Check for done HRRZ P3,T2 ;[2262] Get the source SUB P3,TAB.LB(R) ;[2262] Unrelocate it ADD P3,TAB.LW(R) ;[2262] Get the true address TXZ P3,.IPM ;[2262] Put on a page boundary MOVE P2,P3 ;[2262] Get the bottom of the window area ADD P2,TAB.AB(R) ;[2262] Plus the upper area limit SUB P2,TAB.LB(R) ;[2262] Minus the lower CAMLE P2,LSTBYT ;[2262] Is this more than necessary? MOVE P2,LSTBYT ;[2262] Yes, only get this much TXO P2,.IPM ;[2262] Put on a page boundary SUB T2,TAB.LB(R) ;[2366] Unrelocate the pointers SUB P1,TAB.LB(R) ;[2366] In case the area moves PUSH P,T2 ;[2366] Save the source pointer PUSH P,P1 ;[2366] And the destination pointer PUSH P,TAB.LW(R) ;[2366] And the current window bottom PUSHJ P,@[EXP PG.LSG##,PG.HSG##]-1(R) ;[2262] Move the window POP P,T1 ;[2262] Get back the old lower bound SUB T1,TAB.LW(R) ;[2262] How far the window moved MOVNS T1 ;[2262] Make it positive POP P,P1 ;[2262] Get back the destination pointer SUB P1,T1 ;[2262] Adjust the pointer POP P,T2 ;[2262] Get back the source pointer SUB T2,T1 ;[2262] Adjust the pointer ADD T2,TAB.LB(R) ;[2366] Relocate the pointers ADD P1,TAB.LB(R) ;[2366] Back into the correct area ;[2262] Note that this calculation is incorrect for the last time the window ;[2262] is moved, since the window may be shrunk. This is not important, as ;[2262] LSTBYT guarantees the bytes which will be moved will fit in the window. IMUL T1,BYTPWD ;[2262] In bytes ADDM T1,DSTCNT ;[2262] Update the destination counter JRST X160SL ;[2262] Go back and copy more bytes IFE TOPS20,< ;[2366] Here for case of less than one page. Make sure that ;[2366] there are at least 2 pages in the area. X160SS: MOVE T1,TAB.AB(R) ;[2366] Get the top of the area SUB T1,TAB.LB(R) ;[2366] Minus the bottom for size CAILE T1,.IPS-1 ;[2366] One page? JRST X160SM ;[2366] No, no problem PUSH P,P1 ;[2366] Save the destination pointer MOVEI P1,(R) ;[2366] Point to the area MOVEI P2,1 ;[2366] Expand by one page PUSHJ P,LNKCOR## ;[2366] Get the core PUSHJ P,E$$MEF## ;[2366] Not even one page? MOVE P1,TAB.AB(R) ;[2366] Get new upper bound SUB P1,TAB.LB(R) ;[2366] Get new size ADD P1,TAB.LW(R) ;[2366] Add window bottom MOVEM P1,TAB.UW(R) ;[2366] New windown top MOVE P1,BYTPWD ;[2366] Get bytes per word IMULI P1,.IPS ;[2366] Get bytes per page ADDM P1,DSTCNT ;[2366] Update the destination counter POP P,P1 ;[2366] Retrieve destination pointer JRST X160SM ;[2366] Process as simple case >;[2366] IFE TOPS20 ;[2262] Here to handle the case where multiple copies will not fit ;[2262] in the window. Split the window, and use half for the source ;[2262] and half for the destination. X160CX: MOVE T1,TAB.LW(R) ;[2262] Get the lower window bound MOVE T2,TAB.UW(R) ;[2262] And the upper bound PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R) ;[2262] Empty the window MOVE T2,TAB.AB(R) ;[2262] Get the maximum address SUB T2,TAB.LB(R) ;[2262] Minus the minimum address ADDI T2,1 ;[2262] Get actual window size CAIL T2,2*.IPS ;[2366] At least two pages in area? JRST X160CM ;[2366] Yes, no problem MOVEI P1,(R) ;[2366] Point to the area MOVEI P2,1 ;[2366] Expand by one page PUSHJ P,LNKCOR## ;[2366] Get the core PUSHJ P,E$$MEF## ;[2366] Not even one page? MOVEI T2,2*.IPS ;[2366] Now there are two pages X160CM: LSH T2,-1 ;[2262] Get size of half window TRO T2,.IPM ;[2262] Put at end of page IFE TOPS20,< MOVE T4,W3 ;[2366] Get number of bytes IDIV T4,BYTPWD ;[2366] Size in words TRZ T4,.IPM ;[2366] Maximum window size to prevent overlap SUBI T4,1 ;[2366] As an upper limit CAMLE T2,T4 ;[2366] Window small enough? MOVE T2,T4 ;[2366] No, use smaller size >;[2366] IFE TOPS20 MOVE T1,TAB.LB(R) ;[2262] Get the lower bound ADD T2,TAB.LB(R) ;[2262] End of lower window half DMOVEM T1,DST.LB ;[2262] Save as the destination bounds MOVEI T3,1(T2) ;[2262] Source LB is destination UB+1 IFE TOPS20,< ;[2366] ADD T4,T3 ;[2366] Get the highest acceptable bound CAML T4,TAB.AB(R) ;[2366] Is it OK? JRST X160CZ ;[2366] Yes, no overlap possible SETZM 1(T4) ;[2366] Zero first free word HRLI T1,1(T4) ;[2366] From HRRI T1,2(T4) ;[2366] To BLT T3,@TAB.AB(R) ;[2366] Zero extra memory MOVEM T4,TAB.AB(R) ;[2366] Set new bound X160CZ: >;[2366] IFE TOPS20 MOVE T4,TAB.AB(R) ;[2262] Get upper bound DMOVEM T3,SRC.LB ;[2262] Save as the source bounds MOVEM T2,TAB.AB(R) ;[2262] Set up destination window HRRZ T1,P1 ;[2262] Get the destination address SUB T1,TAB.LB(R) ;[2262] Relocate ADD T1,TAB.LW(R) ;[2262] Make into an address PUSH P,T1 ;[2262] Keep the address TXZ T1,.IPM ;[2262] Set on block boundary MOVEM T1,TAB.LW(R) ;[2262] New lower bound MOVE T2,T1 ;[2262] Get the lower bound ADD T2,DST.AB ;[2262] Add the destination upper bound SUB T2,DST.LB ;[2262] Minus the lower is high address MOVEM T2,TAB.UW(R) ;[2262] Save it DMOVEM T1,DST.LW ;[2262] Save the window addresses PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R) ;[2262] Read the window POP P,T1 ;[2262] Get back the destination address SUB T1,DST.LW ;[2262] Subtract the lower window bound ADD T1,DST.LB ;[2262] Unrelocate it HRR P1,T1 ;[2262] Put it back in the byte pointer MOVE W1,P1 ;[2262] Get the destination byte pointer PUSHJ P,X160CB ;[2262] Count the remaining bytes in the window MOVEM T1,DSTCNT ;[2262] Remember it DMOVE T1,SRC.LB ;[2262] Now switch to the source window MOVEM T1,TAB.LB(R) ;[2262] Store the source lower bound MOVEM T2,TAB.AB(R) ;[2262] And upper MOVE T1,BYTADR ;[2262] Get the source address TXZ T1,.IPM ;[2262] Set on a page boundary MOVEM T1,TAB.LW(R) ;[2262] Save the lower window ADD T2,T1 ;[2262] Lower window plus upper bound SUB T2,SRC.LB ;[2262] Minus lower bound is upper window MOVEM T2,TAB.UW(R) ;[2262] Save it DMOVEM T1,SRC.LW ;[2262] Save it PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R) ;[2262] Read the window MOVE W1,BYTADR ;[2262] Get the source address SUB W1,SRC.LW ;[2262] Subtract the lower window bound ADD W1,SRC.LB ;[2262] Unrelocate it MOVE T1,BYTSIZ ;[2262] Get the byte size DPB T1,[POINT 6,W1,11] ;[2262] Put it in the byte pointer MOVE T1,BYTPOS ;[2262] Get the source byte position DPB T1,[POINT 6,W1,5] ;[2262] Put it in the byte pointer PUSHJ P,X160CB ;[2262] Count the remaining bytes in the window MOVEM T1,SRCCNT ;[2262] Remember it MOVE T2,W1 ;[2262] Get the source address in memory X160MB: PUSHJ P,X160SC ;[2262] Check the source window PUSHJ P,X160DS ;[2262] And the destination window ;[2262] Find the number of bytes which can be copied MOVE T4,W3 ;[2262] Get the number of bytes desired CAMLE T4,SRCCNT ;[2262] More than in the source buffer? MOVE T4,SRCCNT ;[2262] Yes, can't do more than that CAMLE T4,DSTCNT ;[2262] More than can fit in window? MOVE T4,DSTCNT ;[2262] Yes, do only that much MOVN T1,T4 ;[2262] Get minus what will be copied ADDM T1,SRCCNT ;[2262] Update the source count ADDM T1,DSTCNT ;[2262] And the destination count MOVE T1,T4 ;[2262] Put count in both places SUB W3,T4 ;[2262] Remember how many have been done SETZB T3,P2 ;[2262] Just to be safe EXTEND T1,[MOVSLJ] ;[2262] Copy the string JFCL ;[2262] Should not run out JUMPN W3,X160MB ;[2262] Continue until all bytes copied ;[2262] Now unscrew the windows and return. Remove the source window, ;[2262] and leave the destination window only. IFN TOPS20,< ;[2262] DMOVE T1,SRC.LB ;[2262] Get the source bounds MOVEM T1,TAB.LB(R) ;[2262] Set the lower bound MOVEM T2,TAB.AB(R) ;[2262] And the upper DMOVE T1,SRC.LW ;[2262] Get the window limits MOVEM T1,TAB.LW(R) ;[2262] Set the lower window MOVEM T2,TAB.UW(R) ;[2262] And the upper PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R) ;[2262] Write the window > ;[2262] IFN TOPS20 IFE TOPS20,< MOVE T1,SRC.LB ;[2262] Get the lower bound HRL T1,SRC.LB ;[2262] In both halves SETZM (T1) ;[2262] Zero the first word ADDI T1,1 ;[2262] From,,to for zero MOVE T2,SRC.AB ;[2262] How far to go BLT T1,(T2) ;[2262] Zero the memory > DMOVE T1,DST.LB ;[2262] Get the source bounds MOVEM T1,TAB.LB(R) ;[2262] Set the lower bound MOVEM T2,TAB.AB(R) ;[2262] And the upper DMOVE T1,DST.LW ;[2262] Get the window limits MOVEM T1,TAB.LW(R) ;[2262] Set the lower window MOVEM T2,TAB.UW(R) ;[2262] And the upper JRST LOAD## ;[2262] Done ;[2262] Here if deferred. What this really means is that it goes ;[2262] below address 140. Since this block cannot be deferred, move ;[2262] the window to page zero. Note that this must be in the low seg ;[2262] because the high segment cannot start below 140. ;[2343] Uses R, T1, T2 T160DF: MOVE R,SG.TB+1 ;[2343] In low segment MOVE T1,LW.LC ;[2262] Get the low bound MOVE T2,UW.LC ;[2262] And the high bound PUSHJ P,LC.OUT## ;[2262] Write the window MOVE T1,LC.LB ;[2262] Get the base of the area IORI T1,.IPM ;[2262] Want only one block MOVEM T1,LC.AB ;[2262] Allocate it SETZB T1,LW.LC ;[2343] Starting at address zero MOVEI T2,.IPM ;[2262] Want one page MOVEM T2,UW.LC ;[2343] Set the window correctly PJRST LC.IN## ;[2262] Go get it ;[2262] Here to compute the byte size, and diddle the byte pointer ;[2262] if necessary. ;[2343] On input W1 contains the byte count ;[2343] On return W1 contains the total number of bytes ;[2343] Uses T1,T2,T3 X160SZ: MOVE T3,BYTSIZ ;[2262] Get the byte size MOVEI T1,^D36 ;[2262] Bits per wordt IDIVI T1,(T3) ;[2262] Bytes per word MOVEM T1,BYTPWD ;[2262] Save it ADD W1,FILCNT ;[2262] Byte count plus fill bytes IMUL W1,REPCNT ;[2262] Times the repetition count MOVE T1,BYTPOS ;[2262] Get the byte position MOVE T3,BYTSIZ ;[2262] Get the byte size IDIVI T1,(T3) ;[2262] See how many bytes left in first word JUMPN T1,CPOPJ ;[2262] Done if something in first word MOVEI T1,^D36 ;[2262] Need to point to beginning MOVEM T1,BYTPOS ;[2262] of word AOS BYTADR ;[2262] Next word MOVE T1,BYTPWD ;[2262] Number of bytes in first word POPJ P, ;[2262] Continue calculation ;[2262] Here to check that there is something in the rel ;[2262] file buffer. If it is empty, read some more. ;[2262] Also updates the source pointer in T2. ;[2262] Uses T1,T2,T3,T4 X160BF: SKIPLE SRCCNT ;[2262] Rel buffer empty? POPJ P, ;[2262] No, return SKIPN DCBUF ;[2262] If zero, reading from core JRS