Trailing-Edge
-
PDP-10 Archives
-
bb-jr93k-bb
-
10,7/link/lnklod.mac
There are 50 other files named lnklod.mac in the archive. Click here to see a list.
TITLE LNKLOD - LOAD MODULE FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/JBC/RKH/JNG/DCE/MCHC/DZN/PAH/PY/HD/RJF 14-SEP-88
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; 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,OVRPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
IFN TOPS20,< SEARCH MONSYM > ;[1401]
SALL
ENTRY LNKLOD
EXTERN LNKSCN,LNKCOR,LNKWLD,LNKLOG,LNKF40,LNKMAP,LNKXIT
CUSTVR==0 ;CUSTOMER VERSION
DECVER==6 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==2422 ;DEC EDIT VERSION
VERSION
SEGMENT
;LOCAL ACC DEFINITIONS
INTERN R,RB,WC
R=R1 ;CURRENT RELOCATION COUNTER
RB=R+1 ;RELOCATION BYTE WORD
WC=R3 ;WORD COUNT
;[1477] USEFUL MACROS FROM MACSYM
DEFINE WID(MASK)<<^L<-<<MASK>_<^L<MASK>>>-1>>> ; WIDTH OF MASK
DEFINE POS(MASK)<<^L<<MASK>&<-<MASK>>>>> ; POSITION OF MASK
DEFINE POINTR(LOC,MASK)<<POINT WID(MASK),LOC,POS(MASK)>>
; BYTE POINTER TO MASK
SUBTTL REVISION HISTORY
;START OF VERSION 1A
;44 ADD ASCIZ TEXT BLOCK
;45 HASH INITIAL SYMBOLS AT ASSEMBLY TIME
;46 ADD KLUDGE FEATURE
;52 ADD ASCII TEXT BLOCK
;54 ADD KIONLY D.P. INST.
;61 ADD STORE CODE IN FX AREA FOR TWOSEG FORCED HIGH/LOW
;63 STORE MULTIPLY-DEFINED SYMBOLS IN SYMBOL TABLE FOR MAP
;75 ADD ROUTINE TO ADDRESS CHECK A SINGLE WORD
;101 FIXES FOR FAIL CODE WITH UNDEF GLOBALS IN BLOCK 11
;102 ADD TEST FOR END BLOCK NOT SEEN BEFORE EOF
;106 REMOVE HIORG, REPLACE WITH LL.S2 OR SO.S2 AS REQUIRED
;107 REPLACE KLUDGE BY MIXFOR
;111 MAKE MIXFOR WORK EVEN IF NOT IN SEARCH MODE
;112 CHECK PER FILE /SEARCH SWITCH @LODTST
;113 MAKE MIXFOR KNOW ABOUT ARRAY REFERENCES IN ARGS
;115 MAKE /NOSYMS WORK CORRECTLY
;START OF VERSION 1B
;117 (12058) ADD MISSING POPJ P, AT FORKI+2
;130 (12315) PREVIOULY REQUESTED COMMON IS NOT PUT IN LOCAL SYMBOL TABLE CORRECTLY
;START OF VERSION 2
;135 ADD OVERLAY FACILITY
;143 ADD TEST FOR /INCLUDE MODE
;145 IMPLEMENT USER LIBRARIES
;147 TURN ON MIXFOR FEATURE
;152 FIX LOOP IF /NOINIT AND UNDEF SYMBOLS
;157 (12640) ONLY PRINT FSI MESSAGE IF /FORSE GIVEN EXPLICITLY
;161 ADD LANGUAGE SPECIFICATION TO /USERLIB
;163 IF /ONLY IS ON DON'T LOAD F-10 CODE INTO LOW SEG BY DEFAULT
;164 MAKE CPU TEST OF REL FILES MORE GENERAL
;166 READ BACK RADIX50 SYMBOL FILES
;167 CHANGE ARGS TO /OTS SWITCH
;172 (13243) BUG IF MORE THAN 1 BLOCK TYPE 16 (OR 17) SEEN
;173 TEST ASCIZ BLOCK TYPE FOR VALID FIRST CHAR
;174 FIX BUGS IN RELOCATABLE OVERLAYS
;176 MAKE START BLOCK (7) BE TWO WORDS LONG
;200 LOAD REENTRANT OVERLAY HANDLER
;204 FIX CORE EXPANSION BUG IN SYMBOL TABLE FIXUPS
;206 FIX RH CHAINED GLOBAL IF NOT ALL OF CHAIN IN CORE
;210 (13461) MORE OF #172, HANDLE TYPE 16 CORRECTLY
;220 HANDLE COMMON REFERENCED BEFORE BEING DEFINED CORRECTLY
;START OF VERSION 2B
;223 FIXUP PRIMARY TRIPLET AFTER ADDITIVE FIXUPS HAVE BEN DONE
;232 (13920) UNRELOCATE POLISH POINTER BEFORE CALL TO T.11EV
;233 (13932) INFINITE LOOP IF UNDEF SYMBOLS AND TYPE 16 BLOCKS
;251 Setup FX before using for temp storage when /SEG:LOW
; and no high seg size in REL file
;275 ADD CODE TO LOAD SIMULA LIBRARY
;305 Correct the test for CPU type so it works.
;325 Don't ever eliminate block 3 when saving TWOSEG REL
; block in DY and FX during force to single segment when
; high segment break is unknown.
;327 Save 2 locations in F40NAM
;341 INCLUDE EDIT 327 IN MAINTENANCE SOURCES. LABEL EDITS 223,232,233
;367 KEEP CORRECT W3 ON POLISH FIXUPS WHEN SYMBOL JUST DEFINED
;375 Make LS.ADE internal for use in LNKOLD.
;376 Give error message if trying to overlay F40 code.
;405 Add routine D.RED1, like D.IN1 but POPJ's on EOF.
;412 Preserve W3 when doing fixups.
;422 Shut off /SEG:??? when processing fixups.
;START OF VERSION 2C
;450 Correct code at F40NAM to give error message if illegal
; mixing of F40 and FORTRAN CODE
;451 Change message for illegal mixing of F40 and Fortran code
;456 Setup P1 in ADCHK. before calling LNKCOR.
;457 REQUEST FORSE. as soon as both FORTRAN's seen so
; library searching will work. Don't wipe out PROCSN when
; searching libraries.
;462 Set up R in .MXFOR after calling SY.RQ, which destroys it.
;464 Implement /MISSING and LNKIMM
;465 Redo some of block type dispatch for block type 100.
;470 Preserve left half of R at SY.FHS for overlays.
;471 Add code for ALGOL debugging system.
;510 Generate correct fixups for relocatable symbols in LS area.
;512 Handle chained fixups (PS.FXC) correctly.
;515 Teach fixup processor about PH.ADD
;517 Change ABLLEN to LN.ABL
;522 Set relocation bit correctly when following paged fixups.
;526 Don't set relocation bits unless loading overlays. fix to 522.
;530 Define triplet flags correctly.
;532 Don't search FORLIB too many times.
;535 Always search user libraries for all links.
;541 Fixup F40 subroutine prologue correctly under /MIXFOR.
;542 Define entry points correctly when paging in MIXFOR processor.
;543 Catch multiple definition for additive second definition.
;544 SOUP in LINK version 3 stuff for TOPS-20.
;555 Always load global symbols into ALGOL programs.
;557 Clean up the listing for release.
;START OF VERSION 3
;445 INSERT OLD EDITS TO POLISH SYMBOL FIXUPS
;START OF VERSION 3A
;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;561 Fix the MIXFOR code for F10 subroutines
;572 Make sure LS addr in core before doing fixups
;574 Load OTS into low seg if no high seg and low seg .GT. 128K
;605 Use OUTSTR for ?LNKUGS message.
;611 Support COBOL-74
;612 Fix various polish bugs
;613 Load user libs before system libs to avoid FOROTS screwup.
;614 Re-search a system lib if more modules that want it are seen.
;630 Don't forget INCLUDE/EXCLUDE specs after editing an error.
;632 Fix $LOCATION to always work, add $FIXUP.
;650 Use VM on TOPS-10 if available.
;654 Accept a relative address in LS.ADE incase shuffling.
;661 Make the %LNKMDS message be L%W.
;667 Call correct paging routine to move hi seg up.
;672 Set FX.DIR correctly in PRGLIB.
;673 Change the FON and ILI messages to MSR and IRB.
;677 Don't default to /SYMSEG:LOW if loading overlays.
;704 Order psect reloc table by order of origin before doing map.
;712 Add check for psect index when a global is defined.
;716 Read in smaller of LN.WD or current size when moving window down.
;731 SEARCH MACTEN,UUOSYM
;734 Don't allow mixing of KL & KA, or KL & KI compiled code.
;737 Clear link list pointer after it's given back.
;741 Check fixup address against window range.
;746 Add CHKBND routine to check PSECT overlap after reloc table sort.
;747 Update LOWLOC after reloc table sorted and before going to LNKXIT.
;751 Fix bug with calculation of space to give back in PG.SD.
;752 JFFO cpu-code from Block 6 before dispatching to inconsistancy check.
;760 Expand PSECT overlap checks to check each PSECT with all others.
;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;START OF LINK 4A
;766 Return cpu table offset in P2 from routine CPUTST.
;777 Comment SY.RF as destroying P1-P4.
;1101 Keep LSTBLK (last block read from current file) up to date.
;1102 Keep window into overflow file in section 0.
;1103 Zero the .REQUEST/.REQUIRE list pointer after freeing its contents.
;1106 Update HL.S1 from RC.CV of the highest PSECT loaded.
;1114 Don't clear COBOL symbols and ALGOL OWNs in LODTST (moved to T.5A).
;1116 When expanding a window in PG.SX, read in any data already in the
; overflow file for the region being created. Broken by 716.
;1120 Remove CPUTST routine (T.6 does it now) and all calls to it.
;1131 Force non-reentrant OTS sooner, if low segment is within 40 pages of 400000.
;1132 Teach SEGCHK about PSECTs above the high segment.
;1135 Make PG.SU expand anyway if request crosses page and window only a page.
;1143 Fake a module name if LS.ADD called with a symbol before a module seen.
;1165 Zero LSTSYM in SY.RLS if the symbol was rejected.
;1174 Label and clean up all error messages.
;1175 Fix /UPTO with a symbolic argument.
;1200 If loading reentrant FOROTS, search SYS:FORLIB/SEGMENT:LOW.
;1201 Change reference to $SEGLOW to LC.IX.
;1203 Support extended FORTRAN.
;1204 Complain if any Psects are too long.
;1207 Make the LNKCMX message continue loading.
;1212 Make LNKIVC and LNKPOV consistent with other messages.
;1213 Respect the FS.MDC bit.
;1215 Use RC.HL instead of RC.CV for the LOWLOC check at CHKLLC.
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
;START OF VERSION 4B
;1225 Force /UPTO: if GETSEGging OTS, and make OTS origin compiler-specific.
;1226 Remove now redundant test for non-root link in FORNAM.
;1227 Allow multiple COBOL-74 modules to be loaded without LNKCMC.
;1230 Use correct I/O channel for ALGOL symbol file.
;1232 Make E$$USA be a subroutine called also from LNKOV1.
;1234 Fix munged T1 which prints garbage if multiple LNKPOV errors.
;1246 Set up high segment in GO: if /SYMSEG:HIGH was seen.
;1251 Fix test in PG.SU so it doesn't request more core than available.
;1256 Put processor type in P4 before calling QREENT if overlaid.
;1262 Make LNKCMX message print out once only.
;1265 Make ALGCHK label global.
;1271 Cause FORLIB to load /SEG:LOW if main program is not FORTRAN.
;1277 If /LINK is not followed by /NODE, print LNKNSM error.
;1300 Don't do chained fixups if BADCORE is non-zero.
;1305 Use HP.S1 and HP.S2 before sorting psects.
;1312 Load a nonsharable OTS if /SYMSEG:HIGH and edit 1246
;1315 Fix user libraries to use bits for compiler type.
;1320 Fix T3HOLD to know about new rel blocks and ASCII text blocks.
;START OF VERSION 5
;1400 Use OVRPAR.MAC.
;1401 Nativize overflow file handling, fix ?LNKMEF bug in PG.LSG/PG.HSG
;1402 Nativize REL file handling.
;1412 Make SY.CHR,SY.CHL warn user before truncating fullword value.
;1420 Save T2 across error in SY.CHR,SY.CHL, and include missing POPJ.
;1432 Make ?LNKNSM only a warning.
;1433 Distinguish COBOL,COBOL-68 and COBOL-74.
;1434 Support for byte initialization.
;1435 PASCAL support.
;1441 Make sure E$$NSM returns properly.
;1442 Remove hard-wired section-1 limit on PSECT boundaries.
;1450 Fix typo in edit 1442, also ext addr patch in PG.MOV.
;1451 PASCAL support -- force library to lowseg as default.
;1463 Redo deferred fixup handling for nonzero sections.
;Start of Version 5A
;1467 Make D.CNT global for calling from LNKNEW.
;1474 Fix bad test for caller/callee block in SY.TYP.
;1475 Rewrite coercion block processing.
;1476 Fixes to type mismatch checking, char fixup handling.
; Rewrite SY.TY2 to pick up the right descriptors.
; Don't mark unknown functions as global requests.
;1477 Fix miscount of 2ndary arg descriptors in ARGSCN.
;1523 Don't define PASDT% as zero if undefined before library search.
;1545 Set continuation bit for errors which will print module names.
;1702 Remove call to LS.ADD in typechecking code.
;1703 Add RTSECT routine to release unneeded 2ndary triplets
; after typechecking, and don't inhibit bound global searches.
;1711 Put CHKCHX code under FTFRK2 conditional.
;1723 If arg count for caller and function doesn't match, typecheck
; only the args that exist.
;1724 Add a new action code to the set accepted in the coercion block.
;1725 Change error message E$$CMX to say "GFloating" Fortran.
;1732 Don't clear FXSPTR as a hint to CHKCHN that it should call CHKCHX.
; Just recurse to CHKCHN from CHKCHX after the check.
;1733 Don't complain about truncation of section number in section-local
; halfword fixups, but do complain about negative numbers being
; truncated if they're large ones.
;1734 Fix edit 1733, which breaks deferred right half fixups.
;1735 Fix typo introduced when installing edit 1733.
;1736 Strip unsupported FMXFOR code.
;1737 Don't lose deferred fixups in nonzero sections.
;1740 Don't create the lower section if the window straddles sections
; while doing fixups.
;1741 Don't add in section numbers unnecessarily.
;1743 Correct typo in edit 1724 that breaks char fixups.
;1751 Type out argument number in decimal, not octal.
;1753 Make LNKCMX a warning, not a fatal error.
;1777 Fix type checking code to handle nonresident argument blocks.
;2001 Pass the right typechecking triplet pointer to RTSECT.
;2005 Fix some typechecking bugs.
;2007 Give LNKFTH a long error message.
;2012 Fix function return to use arg checking in correct order.
;2013 Fix /NOSYSLIB - Don't insert instructions after a skip.
;2015 Preserve function name length accross TMATCH call.
;2020 Use a linked list to keep track of typechecking blocks.
;2025 Define FOROT% as 400010 for sharable OTS so 5a libraries work.
;2026 Update copyright and cleanup listings.
;2037 Check more carefully for last triplet in SY.RF1
;2045 Fix typechecking to not clobber other secondary triplets.
;2046 Garbage collect the DY area occasionally if many typecheck blocks.
;2053 Argcheck the BG area and defer fixups accross overlays.
;2065 Check .ABS. against zero when computing LOWLOC.
;2074 Calculate page size correctly in PG.MOV.
;2103 Typecheck structure mismatches.
;Start of Version 6
;2200 Use 30 bit addresses in fixups.
;2202 Call xx.IN and xx.OUT with 30 bit addresses, remove NONZER and FTFRK2.
;2203 Handle new style store and halfword fetch operators in type 11 blocks.
;2212 Handle deferred type 1072 polish fixups.
;2214 Add 30 bit fixups, change section default for fullword chained fixups.
;2215 Tell GBCK.L not to BLT areas which have been unmapped.
;2216 Fix long symbols in INSRT and LS.ADD.
;2217 Check for word alligned byte ptrs and fix lost sect numbers at COESPC.
;2220 Handle long symbols in psect names and /UPTO.
;2221 Fix edit 2217 so that it gets section right at SEGCHK. call in COESP2.
;2224 Get ots reentrancy correct if extended addressing or /PVBLOCK:HIGH.
;2226 Remove long /INCLUDE and /EXCLUDE blocks properly.
;2227 Return /PSCOMMON blocks at end of load.
;2242 Make sure all sections in all psects exist.
;2243 Fix off by one, make sure RC.HL not less than RC.CV.
;2247 Don't use LOWLOC, don't LNKPOV .LOW. if it does not exist.
;2255 Use 30 bit addresses for the LS area for symbol fixups.
;2262 Allow PG.xSG to return less than request, don't create extra sections.
;2263 Fix 30 bit additive deferred, set additive bit not chained.
;2264 Fix typo in LNKPMA message which caused it to type out as PMC.
;2266 Don't pass short symbols to TYP.BG as long, overlays can't handle them.
;2267 Remove part of edit 2266, proper fix is in LNKHSH.
;2270 Allow argument typechecking to page, fix conditionals in edit 2262.
;2273 Use 30 bit addresses for type 12 LNKEND blocks.
;2300 Remove F40 code.
;2301 Fix up TOPS-20 errors.
;2305 Add code to support 1070 blocks.
;2310 Rewrite LS.ADE to support long symbols.
;2322 Make LNKCCE a fatal error.
;2331 Always return the last secondary triplet after fixups.
;2342 Fix problems if TP overflows or GS area moves during typechecking.
;2343 Give LNKMMF, not LNKMEF on core manager error.
;2356 Remove unnecessary TOPS20 conditionals.
;2366 Implement extended addressing rules on TOPS-10.
;2374 Use TPPTR for TP.PT in typchecking code and fix TP paging problem.
;2376 Correct calculation for BLTing long symbol.
;2403 New corporate Copywrite statement.
;2405 Preserve W3 across calls that move mem in TP code.
;2406 Correct code for section changes in RDBACK
;2407 Edit 2406 not good enouhg
;2417 Update Copywrite statement to 1988.
;2422 Make PG.TPU read data from overflow file after expanding TP area.
SUBTTL LOAD CONTROL
;ENTER HERE FROM LNKSCN
;LNKWLD READS A FILE SPEC FROM LIST POINTED TO BY F.INZR
;NON-SKIP RETURN IS END OF LIST
;SKIP RETURN WITH DEVICE INITED AND FILE OPEN OR ENTERED
LNKLOD: JFCL .+1 ;IN CASE CCL ENTRY
IFN .ASBLK,<
SKIPE F.ASCI ;READING INCORE TEXT?
JRST LNKWLD## ;YES, SEE IF ANY SWITCHES FOR CURRENT SPEC
>
HLLZ FL,FLAGS ;RESET GLOBAL DEFAULTS
E$$LDS::.ERR. (MS,0,V%L,L%I,S%I,LDS,<LOAD segment>) ;[1174]
LODNXT: HLR FL,FL ;CLEAR TEMP FLAGS AND SET FROM GLOBAL ONES
SKIPN F.EDIT ;[630] DON'T IF EDITING AN ERROR
PUSHJ P,Z.INER ;CLEAR LOCAL STORAGE, GIVE ERRORS
PUSHJ P,LNKWLD ;GET NEXT FILE SPEC
JRST LNKSCN ;LIST EMPTY GET MORE
LODTST::JFCL ;INCASE FROM /SYSLIB
IFN FTOVERLAY,< ;[1277]
SKIPE LINKSEEN ;[1277] IN LIMBO BETWEEN OVERLAYS?
PUSHJ P,E$$NSM ;[1277] YES, GO PRINT AN ERROR
> ;[1277]
HRRM FL,FLAGS ;SAVE LOCAL FLAGS AT START OF FILE
TRNN FL,R.LIB!R.INC ;IN LIBRARY SEARCH MODE OR /INC MODE?
JRST LOAD ;NO
SKIPN USYM ;ANY UNDEFINED SYMBOLS
SKIPE INCPTR ;OR SOME INCLUDES STILL TO DO?
CAIA ;YES
JRST EOF1 ;NO, GET NEXT FILE
SKIPE XBUF ;YES, INDEX IN CORE FOR THIS FILE?
JRST T.14B## ;YES, USE IT TO FIND PROG TO LOAD
JRST LOAD
E$$NSM::.ERR. (MS,0,V%L,L%W,S%W,NSM,</NODE switch missing after /LINK switch>) ;[1277]
POPJ P, ;[1441] RETURN TO CALLER
T.LOAD::HRR FL,FLAGS ;RESTORE LOCAL FLAGS
TRNE FL,R.LIB!R.INC ;IN LIBRARY SEARCH MODE OR /INC MODE?
JRST LODTST ;YES,
; JRST LOAD
SUBTTL READ BLOCK TYPE AND DISPATCH
;LOAD READS THE FIRST WORD OF A BLOCK
;IT PUTS THE LENGTH (NEGATIVE) IN WC AND DISPATCHES TO HANDLING ROUTINE
LOAD:: PUSHJ P,D.IN1 ;READ ONE WORD
MOVNI WC,400000(W1) ;GET NEG BLOCK LENGTH
HLRZ T1,W1 ;GET BLOCK TYPE
MOVEM T1,CURTYP ;[1434] SAVE CURRENT TYPE FOR ERROR RECOVERY
CAIG T1,377 ;IS IT OLD BLOCK TYPES
JRST LNKOLD## ;YES, HANDLE THERE
CAIG T1,003777 ;IN RANGE FOR NEW?
CAIGE T1,1000
JRST T.ERR1 ;NO
JRST LNKNEW## ;YES
;UNKNOWN BLOCK TYPES
T.ERR1:
CAILE T1,777 ;IN LNKOLD OR LNKCST?
JRST T.ERR2 ;NO, MUST BE ASCII TEXT
CAIL T1,700 ;DEC-DEFINED SPEC. FILE TYPES?
JRST LNKOLD## ;YES, GO HANDLE
CAIL T1,402 ;402-677 (CUSTOMER TYPES) ?
JRST LNKCST## ;YES, LET CUSTOMER HANDLE
CAIE T1,400 ;ONLY CHOICE LEFT IS F40
JRST T.401## ;SO ITS T.401 IF NOT T.400
JRST T.400## ;USUALLY IS 400
T.ERR2: ;HERE FOR ASCII TEXT OR ILLEGAL
IFN .ASBLK,<
CAIL T1,(<ASCII / />&<-1,,0>)
CAILE T1,(<ASCII /zzz/>&<-1,,0>)
CAIA ;NO
JRST LNKASC## ;VALID ASCIZ BLOCK
>
E$$IRB::.ERR. (MS,.EC,V%L,L%F,S%F,IRB,<Illegal REL block type >) ;[1174]
.ETC. (OCT,.EP!.EC,,,,T1)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
SUBTTL CLEAR INCLUDE/EXCLUDE STORAGE
Z.INER: HRRZ P1,INCPTR ;GET POINTER TO FIRST BLOCK
JUMPE P1,Z.EXIN ;NONE, GIVE UP
MOVEI T1,[ASCIZ \?LNKIMM \] ;GET PREFIX
PUSHJ P,MISNG1## ;TYPE IT AND REST OF MESSAGE
Z.INEX::HRRZ P1,INCPTR ;GET FIRST
JUMPE P1,Z.EXIN ;NONE, TRY EXCLUDES
HLLZS INCPTR ;ZERO POINTER SINCE LIST GONE
PUSHJ P,Z.ZAP ;WIPE OUT THIS LIST
;FALL INTO Z.EXIN
Z.EXIN: HRRZ P1,EXCPTR ;GET POINTER TO EXCLUDE LIST
JUMPE P1,CPOPJ ;ALL DONE
HLLZS EXCPTR ;INDICATE LIST ZEROED
Z.ZAP:
ADD P1,[-.EXC+1,,1] ;MAKE AOBJN POINTER TO BLOCK
Z.ZAP1: SKIPE P2,(P1) ;GET NEXT WORD
TLNE P2,770000 ;MUST BE A POINTER
JRST Z.ZAP2 ;NOTHING THERE
HRRZ T1,P1 ;[2226] LONG SYMBOL, T1=ADDRESS
HLRZ T2,P2 ;[2226] T2=SIZE
PUSHJ P,DY.RET## ;RETURN THE BLOCK
Z.ZAP2: AOBJN P1,Z.ZAP1 ;LOOP OVER ENTIRE BLOCK
SUBI P1,.EXC ;POINT BACK TO 1ST WORD
MOVEI T1,(P1) ;POINT TO FIRST WORD
MOVEI T2,.EXC ;STANDARD SIZE
HRRZ P1,(P1) ;SAVE POINTER WORD
PUSHJ P,DY.RET## ;FREE UP THE CORE
JUMPN P1,Z.ZAP ;LOOP IF MORE
POPJ P, ;ELSE FINISHED
SUBTTL ADDRESS CHECK A SINGLE WORD
;HERE TO MAKE SURE LOCATION IS IN CORE
;ENTER WITH ADDRESS IN P3
;RETURNS NEW ADDRESS (MAYBE) IN P3
;MAY USE P2 (IF PAGING)
;CALLED BY
; MOVE P3,ADDRESS
; MOVEI R,SEGMENT NO.
; PUSHJ P,ADCHK.##
SGCHK.::TRNN FL,R.FLS!R.FHS ;[2203] Forced loading?
PJRST SGCHK0 ;[2053] No, no problem
TRNN FL,R.FLS ;[2053] Which segment has been faked?
SKIPA T1,[1] ;[2053] Low seg has been faked
MOVEI T1,2 ;[2053] High seg faked if /SEG:LOW
HRR R,T1 ;[2053] Setup R For SG.TB; Preserve LH
MOVE T1,@SG.TB ;[2053] Get real value for RC table
EXCH T1,@RC.TB ;[2053] Restore it, get fake value
PUSH P,T1 ;[2053] Save fake value to restore later
PUSH P,R ;[2053] Remember which segment
PUSH P,LL.S2 ;[2053] LL.S2 Was also faked by T.3
HRRZS LL.S2 ;[2053] If we are loading F10, that is
PUSHJ P,SGCHK0 ;[2053] Now do the fixup
POP P,LL.S2 ;[2053] Restore LL.S2
POP P,R ;[2053] Remember which counter we grabbed
POP P,@RC.TB ;[2053] And restore it
POPJ P, ;[2053] Return From SY.RF
SGCHK0: HRRI R,2 ;[2053] ASSUME HIGH SEG
SKIPE LL.S2 ;[1777] MUST BE LOW SWG IF ONLY ONE SEG
CAMGE P3,LL.S2 ;[1777] BELOW BOTTOM OF HIGH SEG?
SOJA R,ADCHK.
SUB P3,LL.S2 ;[1777] FORM OFFSET TO HIGH SEG
CAMGE P3,HL.S2 ;[1777] BEFORE END OF HIGH SEG?
JRST ADCHK.
MOVE P3,0(P) ;[1777] RESTORE ADDRESS
HRRI R,1
ADCHK.::
IFN FTOVERLAY,<
SKIPE RT.LB ;RELOCATION TABLE SETUP?
PUSHJ P,RT.P3## ;YES, SET BYTE PTR
CAIN R,1 ;LOW SEG?
SUB P3,PH+PH.ADD ;[1400] REMOVE LINK ORIGIN
>
MOVE P2,P3 ;GET A COPY
IFE TOPS20,< ;[2262]
SKIPE PAG.S0(R) ;PAGING?
JRST ADCHK2 ;YES, SEE IF IN CORE
ADD P2,LC.LB-1(R) ;RELOCATE RELATIVE ADDRESS
CAMG P2,LC.AB-1(R) ;WILL IT FIT IN EXISTING SPACE?
JRST ADCHK1 ;YES
SUB P2,LC.AB-1(R) ;GET EXTRA REQUIRED
MOVEI P1,LC.IX-1(R) ;POINT TO PROPER AREA
PUSHJ P,LNKCOR## ;TRY TO GET MORE SPACE
JRST ADCHK2 ;FAILED BUT MUST BE ON DSK
SUB P3,LW.S0(R) ;INCASE WE DUMPED CORE FOR FIRST TIME
>;[2262] IFE TOPS20
IFN TOPS20,< ;[2270]
PUSHJ P,@[EXP PG.LSG,PG.HSG]-1(R) ;[2270] MAKE SURE IN MEMORY
>;[2270] IFN TOPS20
ADCHK1: ADD P3,LC.LB-1(R) ;FINALLY FIX IN CORE
POPJ P, ;RETURN WITH P3 SETUP
IFE TOPS20,< ;[2270]
ADCHK2:
PUSHJ P,@[EXP PG.LSG,PG.HSG]-1(R)
JRST ADCHK1 ;NOW TRY
>;[2270] IFE TOPS20
SUBTTL PAGING CORE CONTROL
IFE TOPS20,<
;HERE TO CHECK TO SEE IF LOW SEG ADDRESS IS INCORE
;IF NOT CHANGE CORE WINDOW TO INCLUDE NEW ADDRESS
PG.LSG::CAMGE P3,LW.S1 ;IS LOWER ADDRESS IN CORE
PUSHJ P,PG.LSD ;NO, MOVE WINDOW DOWN
CAMLE P2,UW.S1 ;AND UPPER ALSO
PUSHJ P,PG.LSU ;NO, NEED TO MOVE WINDOW UP
SUB P3,LW.S1 ;REMOVE BASE
POPJ P, ;AND CONTINUE
;HERE FOR LOW SEG TO MOVE DOWN
PG.LSD: PUSH P,R ;SAVE R
MOVEI R,LC.IX ;INDEX TO LOW SEG
JRST PG.SD ;GENERAL MOVER DOWN
PG.LSU: PUSH P,R ;SAVE R
MOVEI R,LC.IX ;INDEX TO LOW SEG
JRST PG.SU ;GENERAL MOVER UP
;HERE TO MOVE THE WINDOW EITHER UP OR DOWN, BUT WITH NO OVERLAPING. FIRST,
;OUTPUT CURRENT WINDOW, THEN READ BACK THE PORTION WE WILL NEED. WINDOW
;(POTENTIALLY) SHRINKS TO SMALLER OF LN.WD OR ITS CURRENT SIZE. IF NEW WINDOW
;ORIGIN PLUS LENGTH EXCEEDS 512P IN THE FILE'S ADDRESS SPACE, SLIDE THE WINDOW
;DOWN JUST ENOUGH SO IT ENDS AT 512P.
PG.SD: MOVE T1,LW.S0(R) ;[2202] SETUP CONTROL WORD
MOVE T2,UW.S0(R) ;[2202] FIRST,,LAST WORD TO MOVE
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R)
MOVE T1,P3 ;LOWER ADDRESS WE NEED
ANDCMI T1,.IPM ;MAKE INTO BLOCK BOUND
EXCH T1,LW.S0(R) ;RESET WINDOW
SUB T1,UW.S0(R) ;OLD BASE - OLD UPPER
MOVM T2,T1 ;+LENGTH -1
MOVE T1,T2 ;[751] SPACE TO GIVE BACK
SUBI T1,LN.WD ;[751] IN CASE CURRENT SIZE BIGGER
CAILE T2,LN.WD-1 ;[717] CURRENT SIZE SMALLER?
MOVEI T2,LN.WD-1 ;[717] NO, USE LN.WD
ADD T2,LW.S0(R) ;[717] GET US TO END
MOVEM T2,UW.S0(R) ;[717]
JUMPL T1,PG.SD2 ;[717] JUMP IF NOTHING TO GIVE BACK
ADD T1,TAB.LB(R) ;FIX IN CORE
IFN TOPS20,< ;[2215] DON'T HAVE GBCK.L ZERO THE AREA
HRLI T1,1 ;[2215] SINCE IT'S PAGES WERE REMOVED
> ;[2215] IFN TOPS20
PUSHJ P,GBCK.L## ;GIVE BACK TO NEXT LOWER
PG.SD2: MOVE T1,LW.S0(R) ;[2202] RESET CONTROL WORD
MOVE T2,UW.S0(R) ;[2202] TO DESIRED AREA
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R)
PJRST FIXUP ;FIXUP ALL POSSIBLE CORE CHAINS
;HERE TO MOVE THE WINDOW UP IN MEMORY. IF NECESSARY, DUMP THE LOWER PART OF THE
;WINDOW AND MOVE DOWN THE REST. THEN EXPAND THE END OF THE WINDOW IF NECESSARY
;AND READ IN THE UPPER PART WHICH IS USUALLY ZERO. TRY TO KEEP THE SIZE OF THE
;WINDOW REASONABLE AS A FIRST APPROXIMATION.
PG.SU: MOVE T1,P2 ;[1135] SEE IF REQUEST CROSSES A PAGE BOUNDARY
XOR T1,P3 ;[1135] ..
TXNN T1,^-<.IPS-1> ;[1135] ..
JRST PG.SU1 ;[1135] NO--NO SWEAT
MOVE T1,TAB.AB(R) ;[1135] YES--THEN MAKE SURE AT LEAST 2 PAGES
SUB T1,TAB.LB(R) ;[1135] IN THE WINDOW
CAIGE T1,.IPS ;[1135] ..
JRST PG.SU2 ;[1135] ONLY 1 PAGE--MUST EXPAND
PG.SU1: CAMG P2,TAB.HB(R) ;[1135] THE HIGH ADDR ALREADY OUT ON DISK?
JRST PG.SD ;[716] YES, DON'T BOTHER TO EXPAND
PG.SU2: PUSHJ P,FR.CNT## ;[1135] SEE HOW MUCH FREE SPACE WE HAVE
ADD T1,UW.S0(R) ;IF WE GIVE IT ALL TO THIS AREA
SUB T1,LW.S0(R) ;[1251] UPPER BOUND - LOWER BOUND
SUB T1,FRECOR ;[1251] MINUS WHAT MUST BE KEPT FREE
CAMG P2,T1 ;WILL IT NOW FIT?
JRST PG.SX ;YES, JUST EXPAND
;SEE IF BY GIVING AWAY LESSER OF LN.WD OR HALF OF EXISTING AREA
;WE CAN FIT THIS REQUEST IN, IF SO
;DELETE LOWER PART (WRITE OUT FIRST)
;IF NOT, MOVE WINDOW UP AS FAR AS POSSIBLE VIA PG.SD, THEN EXPAND
;AS MUCH AS NEEDED VIA PG.SX
MOVE T2,UW.S0(R) ;TOP OF AREA
SUB T2,LW.S0(R) ;MINUS BOTTOM
ADDI T2,1 ;GET EVEN
LSH T2,-1 ;HALF
ANDCMI T2,.IPM ;KEEP IN BLOCKS
CAILE T2,LN.WD ;USE THE LESSER
MOVEI T2,LN.WD
ADD T1,T2 ;ADD TO PREVIOUS ACCUMULATION
CAMLE P2,T1 ;WIL IT NOW FIT?
JRST PG.SS ;[650] NO, CENTER MINIMAL WINDOW
PUSH P,T2 ;SAVE THE EXCESS
MOVE T1,LW.S0(R) ;CURRENT LOWEST
ADD T2,T1 ;FIRST TO KEEP
SUBI T2,1 ;[2202] HIGHEST TO GET RID OF
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R)
POP P,T1 ;GET EXCESS BACK
ADDM T1,LW.S0(R) ;NEW LOWER BOUND
ADD T1,TAB.LB(R) ;ADD BASE IN CORE
SUBI T1,1 ;HIGHEST LOC TO GIVE AWAY
IFN TOPS20,< ;[2215] DON'T HAVE GBCK.L ZERO THE AREA
HRLI T1,1 ;[2215] SINCE IT'S PAGES WERE REMOVED
> ;[2215] IFN TOPS20
PUSHJ P,GBCK.L## ;GIVE EXCESS AWAY
JRST PG.SU ;SHOULD NOW FIT (AFTER A SHUFFLE
;HERE IF WE CAN'T FIT THIS REQUEST INTO CURRENT WINDOW.
;MAKE SURE P3 POINTS INTO BOTTOM PAGE OF WINDOW VIA PG.SD, THEN
;EXPAND WINDOW TO ENCOMPASS P2 VIA PG.SX IF NECESSARY.
PG.SS: MOVE T1,P3 ;[650] LOWEST LOCATION WANTED
ANDCMI T1,.IPM ;[650] WHAT LW WOULD BE AT BEST
CAME T1,LW.S0(R) ;[650] WINDOW AS HIGH AS POSSIBLE?
PUSHJ P,@[EXP PG.LSD,PG.HSD]-1(R) ;[667] NO, MOVE UP
CAMLE P2,UW.S0(R) ;[650] WINDOW BIG ENOUGH?
JRST PG.SX ;[650] NO, EXPAND VIA LNKCOR
JRST RPOPJ ;[650] YES, GOOD ENOUGH
;HERE TO EXPAND CORE BY AS MUCH AS WE NEED
;ALSO CHECK INCASE OVERFLOW FILE ALREADY CONTAINS THE NEW AREA
;IF SO READ IT IN
PG.SX: PUSH P,P1 ;SAVE ACCS USED BY LNKCOR
PUSH P,P2
MOVEI P1,(R) ;WHO WE WANT TO EXPAND
SUB P2,UW.S0(R) ;BY HOW MUCH
PUSHJ P,LNKCOR## ;GET IT
PUSHJ P,PGMOV2 ;[2366] CAN'T DO IT, TAKE WHAT'S AVAILABLE
POP P,P2 ;RESTORE
POP P,P1
MOVE T1,TAB.AB(R) ;HIGHEST BLOCK IN CORE
SUB T1,TAB.LB(R) ;LENGTH OF INCORE AREA
ADD T1,LW.S0(R) ;LENGTH FROM ORIGIN
EXCH T1,UW.S0(R) ;IS NEW UPPER BOUND
CAML T1,HB.S0(R) ;[1116] HOWEVER IF EVEN BIGGER HAS BEEN SEEN?
JRST RPOPJ ;NO, RESTORE R AND RETURN
ADDI T1,1 ;[2202] IT MUST BE ON THE DSK
MOVE T2,UW.S0(R) ;[2202] SO SETUP TRANSFER REQUEST
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R) ;[1116]
PJRST FIXUP ;[1116] AND DO ANY FIXUPS
;SIMILARLY FOR HIGH SEG
PG.HSG::CAMGE P3,LW.S2 ;SAME AS FOR LOW SEG
PUSHJ P,PG.HSD
CAMLE P2,UW.S2
PUSHJ P,PG.HSU
SUB P3,LW.S2 ;REMOVE BASE
POPJ P, ;CONTINUE
;HERE TO CHANGE WINDOW TO HIGH SEG
;HERE TO MOVE WINDOW DOWN
;FIRST OUTPUT THE WINDOW, THEN READ BACK WHAT WE NEED
PG.HSD: PUSH P,R ;SAVE R
MOVEI R,HC.IX ;INDEX TO HIGH
JRST PG.SD ;MOVE DOWN
;HERE TO MOVE WINDOW UP IN CORE
;DUMP LOWER PART OF WINDOW, BLT DOWN AND READ IN TOP PART
;THIS PART IS MOST LIKELY ZERO
PG.HSU: PUSH P,R ;SAVE R
MOVEI R,HC.IX ;INDEX TO HIGH
JRST PG.SU ;MOVE UP
> ;[1401] IFE TOPS20
IFN TOPS20,<
;[1401] THIS CODE FIXES OCCASIONAL ?LNKMEF.
;HERE TO CHANGE WINDOW TO LOW SEG
PG.LSG::
CAMGE P3,LW.S1 ;[1401] IS LOWER ADDRESS IN CORE?
SKIPA ;[1401] NO
CAMLE P2,UW.S1 ;[1401] IS UPPER ADDRESS IN CORE?
PUSHJ P,PG.LSX ;[1401] NO, MOVE THE WINDOW
SUB P3,LW.S1 ;[1401] REMOVE BASE
POPJ P, ;[1401] AND CONTINUE
PG.LSX: PUSH P,R ;[1401] SAVE CURRENT R
MOVEI R,LC.IX ;[1401] INDEX TO LOW SEG
CAML P3,LW.S1 ;[1401] SIMPLE EXPANSION POSSIBLE?
JRST PG.XPN ;[1401] YES, TRY THAT FIRST
JRST PG.MOV ;[1401] GENERAL MOVER
;[1401] SIMILARLY FOR HIGH SEG
PG.HSG::CAMGE P3,LW.S2 ;[1401] SAME AS FOR LOW SEG
SKIPA
CAMLE P2,UW.S2
PUSHJ P,PG.HSX
SUB P3,LW.S2 ;[1401] REMOVE BASE
POPJ P, ;[1401] CONTINUE
;[1401] HERE TO CHANGE WINDOW TO HIGH SEG
PG.HSX: PUSH P,R ;[1401] SAVE R
MOVEI R,HC.IX ;[1401] INDEX TO HIGH
CAML P3,LW.S2 ;[1401] SIMPLE EXPANSION POSSIBLE?
JRST PG.XPN ;[1401] YES, TRY THAT FIRST
JRST PG.MOV ;[1401] MOVE DOWN
;[1401] MINOR NOTE: THE STACK IS CLEANED UP AT RETURN FROM "FIXUP".
;[1401] HERE TO TRY EXPANDING THE WINDOW.
PG.XPN:
MOVE T1,TAB.UB(R)
SUB T1,TAB.AB(R) ;[1401] WHAT'S AVAILABLE
MOVE T2,P2
SUB T2,UW.S0(R) ;[1401] HOW MUCH MORE WE WANT
CAMGE T1,T2 ;[1401] ENOUGH TO SIMPLY EXPAND?
JRST PG.MOV ;[1401] NO, DO GENERAL PURPOSE MOVE
PUSH P,P1 ;[1401] SAVE ACS
PUSH P,P2
MOVEI P1,(R) ;[1401] NOTE INDEX
MOVE P2,T2 ;[1401] AND AMOUNT TO EXPAND BY
PUSHJ P,LNKCOR ;[1401] ASK
PUSHJ P,E$$MEF ;[1401] NOT ALWAYS GIVEN...
POP P,P2 ;[1401] RESTORE
POP P,P1
JRST PGDONE ;[1401] ALL SET.
;[1401] HERE TO MOVE THE WINDOW. OUTPUT THE EXISTING WINDOW AND THEN
;[1401] BRING IN THE REQUESTED DATA.
PG.MOV:
MOVE T1,LW.S0(R) ;[2202] RETURN CURRENT SPAN
MOVE T2,UW.S0(R) ;[2202] FIRST,,LAST
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R)
;[1401] IS THERE ENOUGH STORAGE IN THIS AREA TO FIT THE REQUEST?
MOVE T1,UW.S0(R) ;[1401] LAST
SUB T1,LW.S0(R) ;[1401] -FIRST
MOVE T2,P2 ;[1401] UPPERBOUND
TRO T2,.IPM ;[2074] AT TOP OF A PAGE
SUB T2,P3 ;[1401] LOWERBOUND
CAMGE T1,T2 ;[1401] AREA GTRE REQUEST?
JRST PGMOV1 ;[1401] NO
MOVE T1,P3 ;[1401] LOWER ADDRESS WE NEED
ANDCMI T1,.IPM ;[1401] MAKE INTO BLOCK BOUNDARY
MOVEM T1,LW.S0(R) ;[1401] RESET LOWER WINDOWBOUND
MOVE T2,P2 ;[1401] HIGHEST ADDRESS WE NEED
ANDCMI T2,.IPM ;[1401] MAKE INTO BLOCK BOUNDARY
ADDI T2,.IPS-1 ;[1401] INCLUDE THE PAGE
MOVEM T2,UW.S0(R) ;[1401] RESET UPPER WINDOWBOUND
SUB T2,T1 ;[1401] GET WINDOW LENGTH
MOVE T1,TAB.LB(R) ;[1401] RESET AREA BOUNDS
ADD T1,T2
MOVEM T1,TAB.AB(R)
MOVE T1,LW.S0(R) ;[2202] BRING IN THE WINDOW
MOVE T2,UW.S0(R) ;[2202]
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R)
JRST PGDONE
;[1401] HERE IF MEMORY MUST BE REQUESTED
PGMOV1:
;[1401]
; THERE IS NOT ENOUGH ROOM CURRENTLY ALLOCATED IN MEMORY. BRING IN ONE
; PAGE'S WORTH OF THE REQUEST, AND ASK LNKCOR TO EXPAND ON IT TO PROVIDE
; THE REST.
MOVE T2,TAB.LB(R) ;[2202] GET THE LOWER BOUND
ADDI T2,.IPS-1 ;[2202] ALLOW ONE PAGE
MOVEM T2,TAB.AB(R) ;[2202] NEW UPPER BOUND
MOVE T1,P3 ;[1401] LOWER END OF REQUEST
ANDCMI T1,.IPM ;[1401] MAKE INTO BLOCKBOUND
MOVEM T1,LW.S0(R) ;[1401] SET LOWER WINDOWBOUND
MOVE T2,T1 ;[2202] GET LOWER BOUND
ADDI T2,.IPS-1 ;[2202] END OF PAGE
MOVEM T2,UW.S0(R) ;[2202] SET UPPER WINDOWBOUND
PUSHJ P,@[EXP LC.IN,HC.IN]-1(R)
MOVE T2,P2 ;[1401] UPPER END OF REQUEST
ANDCMI T2,.IPM ;[1401] MAKE INTO BLOCKBOUND
ADDI T2,.IPS-1 ;[1401] THROUGH END OF PAGE
SUB T2,UW.S0(R) ;[2202] ADDITIONAL SPACE NEEDED
PUSH P,P1 ;[1401] SAVE ACS USED BY LNKCOR
PUSH P,P2 ;[1401]
MOVEI P1,(R) ;[1401] WHAT TO EXPAND
MOVE P2,T2 ;[1401] BY HOW MUCH
PUSHJ P,LNKCOR##
PUSHJ P,PGMOV2 ;[2262] CAN'T DO IT
POP P,P2 ;[1401] RESTORE ACS
POP P,P1
;[1401] THE WINDOW HAS BEEN RESET TO COVER THE REQUEST.
PGDONE:
PJRST FIXUP ;[1401] DO ANY FIXUPS POSSIBLE
> ;[1401] IFN TOPS20
;HERE TO SEE IF ANY FIXUPS CAN BE DONE FOR LOW SEG JUST READ IN
;MUST NOT CHANGE P1-P4 & MUST SAVE R
;USES T1-T4
FIXUPL: PUSH P,R ;NEED TO SAVE IT
MOVEI R,LC.IX ;LOAD INDEX TO LOW
JRST FIXUP ;DO THE FIXUPS
;HERE TO SEE IF ANY FIXUPS CAN BE DONE FOR HIGH SEG JUST READ IN
;MUST NOT CHANGE P1-P4 & MUST SAVE R
;USES T1-T4
FIXUPH: PUSH P,R ;NEED TO SAVE IT
MOVEI R,HC.IX
FIXUP: PUSHJ P,CHKCHN ;SEE IF ANYTHING TO DO
RPOPJ: POP P,R ;RESTORE R
POPJ P,
;[2262] Here if unable to get requested memory. Get whatever is
;[2262] available. The calling routine will have to check to see
;[2262] if it got what it needed. Note that routines which need
;[2262] only one page will not have to check as they always get it.
PGMOV2: PUSHJ P,FR.CNT## ;[2262] FIND OUT WHAT IS AVAILABLE
SUB T1,FRECOR ;[2262] MINUS WHAT LNKCOR WILL PRESERVE
MOVE P2,T1 ;[2262] THAT'S HOW MUCH TO ASK FOR
PUSHJ P,LNKCOR## ;[2262] GO GET IT
PUSHJ P,E$$MMF## ;[2343] NOT EXPECTED TO FAIL
POPJ P, ;[2262] DONE
SUBTTL PROCESS FIXUPS FOR NEW WINDOW
;CHKCHN - SEE IF ANY FIXUPS EXIST FOR THE NEW CORE WINDOW
;IF SO LINK THEM INTO FXT.S0
;AND DO THEM
;R=2*N+1 FOR LOW, R=2*N+2 FOR HIGH
;DESTROYS R
;USES T1-T4
CHKCHN:
PUSHJ P,.SAVE1## ;[1737] Save P1 - will point to fixup chain head
MOVEI P1,FX.S0(R) ;[1737] Point to the Rth section's fixup header
CAIE R,1 ;[2200] Low segment fixups?
JRST CHKCHE ;[1737] No, go on and use FX.S0(R)
HLRZ P1,LW.LC ;[2200] Get the section number of the window
MOVEI P1,FXSPTR(P1) ;[2200] Set the head pointer and process
CHKCHE: SKIPN (P1) ;[1737] Anything to do?
POPJ P, ;NO
SETZM FXT.S0 ;CLEAR TEMP PTR
HRRZ T1,(P1) ;[1737] Get pointer to fixup for lowest address
ADD T1,FX.LB ;+OFFSET
LDB T2,[ADDRESS 1(T1)] ;[2200] GET ADDRESS
SUB T2,LL.S0(R) ;REMOVE ORIGIN
IFN FTOVERLAY,<
CAIN R,1 ;LOW SEGMENT?
SUB T2,PH+PH.ADD ;[1400] YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
HLRZ T1,(P1) ;[1737] Pointer to fixup for highest address
ADD T1,FX.LB ;+OFFSET
LDB T3,[ADDRESS 1(T1)] ;[2200] ADDRESS
SUB T3,LL.S0(R) ;REMOVE ORIGIN
IFN FTOVERLAY,<
CAIN R,1 ;LOW SEGMENT?
SUB T3,PH+PH.ADD ;[1400] YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
CAMG T2,UW.S0(R) ;IS LOWEST ADDRESS TOO HIGH?
CAMGE T3,LW.S0(R) ;OR HIGHEST TOO LOW?
POPJ P, ;YES, JUST GIVE UP
;MAKE QUICK TEST INCASE ALL CHAIN IN CORE
;IN WHICH CASE WE NEED NOT CHASE THE CHAIN
CAML T2,LW.S0(R) ;IS LOWEST ADDRESS .GT. LOW WINDOW?
CAMLE T3,UW.S0(R) ;AND HIGHEST ADDRESS .LE. HIGH WINDOW
JRST .+5 ;NO, DO THE SLOW WAY
MOVE T1,(P1) ;[1737] Get pointer word
MOVEM T1,FXT.S0 ;MOVE IT ALL OVER
SETZM (P1) ;[1737] Remove from list to consider
JRST FXTLUP ;AND DO IT
MOVE T1,P1 ;[1737] Get initial pointer
;Start at back since most usual case
;is to read file backwards
CHKCHL: HLRZ T1,(T1) ;GET NEXT
JUMPE T1,CPOPJ ;NOTHING TO DO
ADD T1,FX.LB ;OFFSET
LDB T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS
SUB T2,LL.S0(R) ;REMOVE ORIGIN
IFN FTOVERLAY,<
CAIN R,1 ;LOW SEGMENT?
SUB T2,PH+PH.ADD ;[1400] YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
CAMG T2,UW.S0(R) ;[741] INCORE?
CAMGE T2,LW.S0(R) ;[741] CHECK AGAINST WINDOW RANGE
JRST CHKCHL ;NO, LOOP
HRRZ T3,(T1) ;GET FORWARD LINK
JUMPE T3,[MOVE T3,P1 ;[1737] If link is zero, this is
JRST CHKCHM] ;[1737] the top of the chain
HRL T3,T3 ;STORE UNRELOCATED IN LEFT HALF
ADD T3,FX.LB ;RELOCATED IN RIGHT
HLLZS (T1) ;CLEAR FORWARD PTR OF REMOVED PART
CHKCHM: SUB T1,FX.LB ;-OFFSET
MOVSM T1,FXT.S0 ;TEMP PTR TO HIGHEST TO DO
ADD T1,FX.LB ;+OFFSET
CHKCHH: HLRZ T1,(T1) ;GET NEXT
JUMPE T1,[MOVE T1,P1 ;[1737] Point to the header if we have
JRST CHKFIN] ;[1737] reached the end of the chain
ADD T1,FX.LB ;+OFFSET
LDB T2,[ADDRESS 1(T1)] ;[2200] ADDRESS
SUB T2,LL.S0(R) ;REMOVE ORIGIN
IFN FTOVERLAY,<
CAIN R,1 ;LOW SEGMENT?
SUB T2,PH+PH.ADD ;[1400] YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
CAML T2,LW.S0(R) ;STILL IN COREE?
JRST CHKCHH ;YES
MOVE T2,T1 ;GET ABS ADDRESS
SUB T2,FX.LB ;REMOVE OFFSET
HRL T1,T2 ;STORE LINK IN LEFT HALF FOR LATER
CHKFIN: HRRZ T2,(T1) ;GET 1ST FIXUP WE CAN DO
HRRM T2,FXT.S0 ;STORE IN PTR
ADD T2,FX.LB ;RELOCATE IN FIXUP BLOCK
HRRZS (T2) ;AND CLEAR BACK LINK
;NOW CLOSE PTRS OVER HOLE
HLRM T3,(T1) ;LINK TOP TO BOTTOM
HLLM T1,(T3) ;AND BOTTOM TO TOP
;NOW TO EXECUTE THE FIXUPS
;STORE R IN LEFT OF FXT.S0 (NOT USED FOR CHAIN PROCESSING)
FXTLUP: PUSH P,W3 ;KEEP W3 INTACT
FXTLP1: SOS FXC.S0(R) ;COUNT 1 LESS
HRRZ T1,FXT.S0 ;GET NEXT PTR
JUMPE T1,[POP P,W3 ;RESTORE W3
POPJ P,] ;ALL DONE FOR THIS LIST
.JDDT LNKLOD,FXTLP1,<<CAMN T1,$FIXUP##>> ;[632]
ADD T1,FX.LB ;+OFFSET
PUSH P,1(T1) ;GET ADDRESS (EXPECTED IN T2)
MOVE W3,2(T1) ;VALUE
HRRZ T2,(T1) ;NEXT PTR
HRRM T2,FXT.S0 ;STORED
MOVEI T2,3 ;SIZE OF BLOCK
PUSHJ P,FX.RET## ;RESTORE NOW (INCASE REQUIRED AGAIN)
POP P,T2 ;ADDRESS IN T2
LDB T1,[HIGH6 T2] ;[2200] GET INDEX
TLZ T2,770000 ;[2200] AND 30 BIT ADDRESS (CLEAR HIGH 6 BITS)
HRLM R,FXT.S0 ;SAVE R SINCE IT WILL POINT TO DATA BLOCK ON RETURN
PUSHJ P,@CHNTAB(T1) ;GO TO RIGHT ROUTINE
HLRZ R,FXT.S0 ;RESTORE R
JRST FXTLP1 ;AND CONTINUE
IFE FTOVERLAY,<
PFF.CR==SY.CHR ;USE NORMAL CHAIN-CHASING ROUTINES
PFF.CL==SY.CHL
PFF.CF==SY.CHF
PFF.CE==SY.CHE ;[2214]
> ;END IFE FTOVERLAY
DEFINE X (A)<
EXP PFF.'A
>
CHNTAB: CFIXUPS
SUBTTL FIND HIGHEST LOCATION TO FIXUP
;ROUTINE TO FIND HIGHEST LOCATION TO FIXUP IN EITHER LOW OR HIGH SEG
;CALLED BY
; PUSHJ P,FHA.L/FHA.H
;RETURNS
;T1 = HIGHEST LOC, 0 IF NONE TO DO
;USES T1,T2
FHA.L: MOVEI T1,MAXSEC ;[2200] Number of sections
FHALX1: JUMPE T1,CPOPJ ;[2200] Done if below table
SKIPN FXSPTR-1(T1) ;[2200] Check for nonzero entry
SOJA T1,FHALX1 ;[2200] Get another if zero
HLRZ T1,FXSPTR-1(T1) ;[2200] Check the highest loc
SETZ T2, ;[2200] 0 for low segment
JRST FHALH1 ;[2200] Join common code
FHA.H: MOVEI T2,1 ;1 FOR HIGH
HLRZ T1,FX.S1(T2) ;GET PTR TO HIGHEST LOC THIS CHAIN
JUMPE T1,CPOPJ ;NOTHING THERE
FHALH1: ADD T1,FX.LB ;[2200] +OFFSET
LDB T1,[ADDRESS 1(T1)] ;[2200] AND NOTE ADDR TO BE FIXED
IFN FTOVERLAY,<
JUMPN T2,CPOPJ ;LOW SEGMENT?
SUB T1,PH+PH.ADD ;[1400] YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
POPJ P, ;RETURN
SUBTTL SCAN WHOLE PROGRAM FOR FIXUPS
;ROUTINE TO READ OVERFLOW FILES BACKWARDS AND DO ALL POSSIBLE CODE FIXUPS
COR.FX::
SKIPE FX.S2 ;[2200] High seg fixups?
JRST CORFX0 ;[2200] Yes, must do fixups
MOVEI T1,MAXSEC ;[2200] Get the number of sections
CORFX1: SKIPE FXSPTR-1(T1) ;[2200] Fixups for this section?
JRST CORFX0 ;[2200] Yes
SOJG T1,CORFX1 ;[2200] No, try the next section
POPJ P,
CORFX0: PUSH P,R ;[1463] SAVE R
E$$FCF::.ERR. (MS,0,V%L,L%I,S%I,FCF,<Final code fixups>) ;[1174]
CORFXL: ;HERE FOR LOW SEGMENT
PUSHJ P,FHA.L ;FIND ADDRESS
JUMPE T1,CORFXH ;TRY HIGH
IORI T1,.IPM ;ROUNDED UP TO BLOCK BOUND
MOVEI R,LC.IX ;SET INDEX
PUSHJ P,RDBACK ;READ IN REQUIRED CORE IMAGE
;AND DO ALL FIXUPS WE CAN
JRST CORFXL ;TRY AGAIN
CORFXH: ;HERE FOR HIGH
PUSHJ P,FHA.H ;SEE IF ANY HIGH
JUMPE T1,CORFXT ;TEST TO SEE IF ANY MORE LOW
SUB T1,LL.S2 ;REMOVE ORIGIN
IORI T1,.IPM
MOVEI R,HC.IX ;SET INDEX FOR HIGH
PUSHJ P,RDBACK ;READ IN AND FIXUP
JRST CORFXH ;LOOP
CORFXT: PUSHJ P,FHA.L ;ANY LOW
JUMPN T1,CORFXL ;YES, RECYCLE
POP P,R ;RESTORE R
POPJ P, ;RETURN
;HERE TO DO ACTUAL READ BACK
;ENTER WITH
;R = 1 FOR LOW
;R = 2 FOR HIGH
RDBACK: MOVE T2,UW.S0(R) ;[2202] GET THE OLD BOUNDARY
MOVEM T1,UW.S0(R) ;[2202] STORE THE NEW UPPER LIMIT
MOVE T1,LW.S0(R) ;[2202] WRITE OUT CURRENT IMMAGE
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R)
MOVE T1,UW.S0(R) ;NOW FIND BOTTOM
HLLZM T1,LW.S0(R) ;[2407] SECTION,,0 OF NEW BOTTOM
HRRZS T1 ;[2407] UW ADDRESS IN SECTION
ADD T1,TAB.LB(R)
SUB T1,TAB.AB(R) ;FOR NEW LW.S0(R)
HRRM T1,LW.S0(R) ;[2407] SET BASE IN THIS SECTION
JUMPGE T1,RDBCK1 ;OK IF NOT TOO MUCH
ADDM T1,TAB.AB(R) ;TOO MUCH, CUT BACK TOP
HLLZS LW.S0(R) ;[2407] GET SECTION,,0 AS LOWER WINDOW
;[2407] WINDOW NOW ALL IN CORE
IFE TOPS20,< ;[2202] DON'T BLT ON THE -20, IT'S MAPPED AWAY
MOVE T1,TAB.LB(R) ;TOP WE WILL FILL
HRLI T1,1(T1) ;FORM BLT PTR
HRRI T1,2(T1)
SETZM -1(T1) ;AND CLEAR UP TO .UB
BLT T1,@TAB.UB(R) ;SO WE DON'T LEAVE JUNK BEHIND
> ;[2202] IFE TOPS20
RDBCK1: MOVE T1,LW.S0(R) ;[2202] NOW FOR READIN
MOVE T2,UW.S0(R) ;[2202]
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R)
PJRST @[EXP FIXUPL,FIXUPH]-1(R) ;AND DO FIXUPS
;HERE TO DO PAGE FAULT FIXUPS
;ADDITIVE FIXUPS
PFF.AR: JUMPE T2,CPOPJ ;DONE IF ZERO
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
HRRZ T1,(T2) ;GET RIGHT HALF VALUE
ADD T1,W3 ;PLUS DEFINED SYMBOL
HRRM T1,(T2) ;STORE NEW VALUE
POPJ P,
PFF.AL: JUMPE T2,CPOPJ ;DONE IF ZERO
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
HLRZ T1,(T2) ;GET LEFT HALF VALUE
ADD T1,W3 ;PLUS DEFINED SYMBOL
HRLM T1,(T2) ;STORE NEW VALUE
POPJ P,
PFF.AF: JUMPE T2,CPOPJ ;DONE IF ZERO
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
ADDM W3,(T3) ;[2214] PLUS DEFINED SYMBOL
POPJ P,
PFF.AE: JUMPE T2,CPOPJ ;[2214] Done if zero
PUSHJ P,SEGCHK ;[2214] Setup incore address
PUSHJ P,E$$ANM ;[2214] We only get here when page is in core
LDB T1,[ADDRESS(T2)] ;[2214] Get 30 bit half value
ADD T1,W3 ;[2214] Plus defined symbol
DPB T1,[ADDRESS(T2)] ;[2214] Store new value
POPJ P, ;[2214]
;CHAINED FIXUPS
IFN FTOVERLAY,<
PFF.CR: SKIPE T1,RT.PT ;IS RT AREA SET UP?
CAMN T1,RT.LB ;MAYBE, IS IT?
PJRST SY.CHR ;NO, NO RELOC BITS TO SET
PUSH P,P3 ;SAVE P3 OVER RT.P3
MOVE P3,T2 ;ADDRESS OF CURRENT FIXUP
PUSHJ P,RT.P3## ;SETUP BYTE POINTER
ILDB T1,RT.PT ;PICK UP RELOCATION BITS
TRNE T1,1 ;RH RELOCATABLE?
TXO R,1B1 ;YES, TELL RT.T2R
MOVE T2,P3 ;RESTORE CHAIN ADDRESS
POP P,P3 ;AND PRESERVED AC
PJRST SY.CHR ;GO CHASE CHAIN
PFF.CL: SKIPE T1,RT.PT ;ANY RELOC BITS TO WORRY ABOUT?
CAMN T1,RT.LB ;MAYBE, ARE THERE?
PJRST SY.CHL ;NO, GO FOLLOW CHAINS
PUSH P,P3 ;SAVE P3 OVER RT.P3
MOVE P3,T2 ;ADDRESS OF CURRENT FIXUP
PUSHJ P,RT.P3## ;SETUP BYTE POINTER
ILDB T1,RT.PT ;PICK UP RELOCATION BITS
TRNE T1,2 ;LH RELOCATABLE?
TXO R,1B0 ;YES, TELL RT.T2L
MOVE T2,P3 ;RESTORE CHAIN ADDRESS
POP P,P3 ;AND PRESERVED AC
PJRST SY.CHL ;GO CHASE CHAIN
PFF.CF: SKIPE T1,RT.PT ;RELOC BITS?
CAMN T1,RT.LB ;OR IS RT AREA EMPTY?
PJRST SY.CHF ;EMPTY, DON'T WORRY ABOUT IT
PUSH P,P3 ;SAVE P3 OVER RT.P3
MOVE P3,T2 ;ADDRESS OF CURRENT FIXUP
PUSHJ P,RT.P3## ;SETUP BYTE POINTER
ILDB T1,RT.PT ;PICK UP RELOCATION BITS
LSH T1,-^D34 ;MOVE TO LEFT JUSTIFY
IOR R,T1 ;SET WHERE RT.T2F CAN FIND IT
MOVE T2,P3 ;RESTORE CHAIN ADDRESS
POP P,P3 ;AND PRESERVED AC
PJRST SY.CHF ;GO CHASE CHAIN
PFF.CE: SKIPE T1,RT.PT ;[2214] Reloc bits?
CAMN T1,RT.LB ;[2214] Or is RT area empty?
PJRST SY.CHE ;[2214] Empty, don't worry about it
PUSH P,P3 ;[2214] Save P3 over RT.P3
MOVE P3,T2 ;[2214] Address of current fixup
PUSHJ P,RT.P3## ;[2214] Setup byte pointer
ILDB T1,RT.PT ;[2214] Pick up relocation bits
LSH T1,-^D34 ;[2214] Move to left justify
IOR R,T1 ;[2214] Set where RT.T2E can find it
MOVE T2,P3 ;[2214] Restore chain address
POP P,P3 ;[2214] And preserved ac
PJRST SY.CHE ;[2214] Go chase chain
> ;END IFN FTOVERLAY
E$$ANM::.ERR. (MS,,V%L,L%F,S%F,ANM,<Address not in memory>)
;REPLACEMENTS
;RIGHT HALF
PFF.RR: JUMPE T2,CPOPJ
PUSHJ P,SEGCHK
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
HRRM W3,(T2) ;JUST REPLACE WHATS THERE
POPJ P,
;LEFT HALF
PFF.RL: JUMPE T2,CPOPJ
PUSHJ P,SEGCHK
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
HRLM W3,(T2)
POPJ P,
;FULLWORD
PFF.RF: JUMPE T2,CPOPJ ;DONE IF ZERO
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
MOVEM W3,(T2) ;REPLACE VALUE
POPJ P,
;[2214] Thirty bit
PFF.RE: JUMPE T2,CPOPJ ;[2214] Done if zero
PUSHJ P,SEGCHK ;[2214] Setup incore address
PUSHJ P,E$$ANM ;[2214] We only get here when page is in core
DPB W3,[ADDRESS(T2)] ;[2214] Replace value
POPJ P,
SUBTTL LOCAL SYMBOL STORE
;ROUTINE TO ADD CONTENTS OF W1, W2, W3 TO LOCAL SYMBOLTABLE
;ALSO USED TO PUT GLOBALS AND OTHER STUFF THERE
;CHECKS FOR DSK OVERFLOW ETC
;THIS IS WHERE IT ALL GETS DONE
LSADDX: PUSHJ P,LS.XPN ;NEED TO EXPAND FIRST
LS.ADD::SKIPN @GS.LB ;[1143] USER TYPE /NOINITIAL?
PUSHJ P,LS.CHK ;[1143] YES, SEE IF NEED A DUMMY MODULE NAME
LSADD: MOVE T1,LSYM ;[1143] GET SYMBOL TABLE POINTER
MOVEM T1,LSTLCL ;[2255] STORE REL POINTER TO NEXT LOCAL SYMBOL
TXNN W1,PS.GLB ;IF NOT GLOBAL
SETZM LSTGBL ;[2255] CLEAR SPURIOUS GLOBAL POINTER
TXC W1,PT.TTL!PT.PSC ;[2220] Could be a long psect
TXCE W1,PT.TTL!PT.PSC ;[2220] Was it?
TXNE W1,PT.SYM ;[2216] Is it a symbol?
TLNE W2,770000 ;[2216] And long?
CAIA ;[2216] No, short or non-symbl
JRST [PUSH P,W2 ;[2216] Yes, save the length and pointer
PUSH P,[LSADDL] ;[2216] Where to go to do long symbol
MOVE W2,(W2) ;[2216] Get the first six characters
JRST .+1] ;[2216]
MOVEI T2,.L ;[2216] Short symbol, need one triplet
MOVE T1,LS.FR ;NUMBER OF WORDS FREE
SUBI T1,(T2) ;WE NEED SOME MORE FOR THIS ENTRY
JUMPL T1,LSADDX ;NOT ENOUGH
MOVEM T1,LS.FR ;STORE NEW COUNT
MOVE T1,T2 ;SAME NUMBER OF WORDS
ADDM T2,LSYM ;COUNT EXTRA WORDS
ADDB T1,LS.PT ;NEW ACTUAL BOUND
TMOVEM W1,-3(T1) ;FLAGS, NAME, VALUE
POPJ P,
;[2216] Here on a long symbol to store the secondaries
LSADDL: MOVE W2,(P) ;[2216] Get back the pointer
HLR T2,W2 ;[2216] Get the count
CAILE T2,1 ;[2216] Check for only one word
SKIPN 1(W2) ;[2216] Or second word blank
JRST LSADLZ ;[2216] Only one word - Done
MOVX T3,PS.EXO ;[2216] Get the bit indicating extended triplet
IORM T3,-3(T1) ;[2216] Set it
MOVNI T1,-1(T2) ;[2216] Negate it, account for first word
HRL W2,T1 ;[2216] Build AOBJN pointer (low by one word)
;[2216] Get another word, and generate a secondary LS triplet for it
LSADL1: SKIPN 1(W2) ;[2216] Is this blank?
JRST LSADLD ;[2216] Yes, done
LSADL2: MOVEI T2,.L ;[2216] Need another triplet
MOVE T1,LS.FR ;[2216] Number of words free
SUBI T1,(T2) ;[2216] We need some more for this entry
JUMPL T1,[PUSHJ P,LS.XPN ;[2216] Get more memory
JRST LSADL2] ;[2216] Go back
MOVEM T1,LS.FR ;[2216] Store new count
MOVE T1,T2 ;[2216] Same number of words
ADDM T2,LSYM ;[2216] Count extra words
ADDB T1,LS.PT ;[2216] New actual bound
TXNE W1,PT.TTL ;[2220] A title block?
MOVX T2,S.TTL!S.PSN ;[2220] Yes, this is a psect name
TXNE W1,PT.SYM ;[2220] Symbol?
MOVX T2,S.SYM!S.LNM ;[2220] Yes, Get the flags for long symbol name
MOVEM T2,-3(T1) ;[2216] Store the flags
MOVE T2,1(W2) ;[2216] Get a name word
MOVEM T2,-2(T1) ;[2216] Store the name word
AOBJP W2,LSADLD ;[2216] Check for more
SKIPN T2,1(W2) ;[2216] There's more, get the next one
JRST LSADLD ;[2216] Null word, done
MOVEM T2,-1(T1) ;[2216] Store another word
AOBJN W2,LSADL1 ;[2216] Continue
LSADLD: MOVX T2,S.LST ;[2216] Get flag indicating end
IORM T2,-3(T1) ;[2216] Indicate end
LSADLZ: POP P,W2 ;[2216] Restore count and pointer
POPJ P, ;[2216] Done
;HERE IF WE HAVE TO EXPAND
LS.XPN: PUSHJ P,.SAVE2## ;SAVE PRESERVED ACCS
PUSH P,T2 ;SAVE WORD COUNT
MOVEI P1,LS.IX ;LOCAL SYMBOL AREA
MOVE P2,T2 ;NUMBER OF WORDS REQUIRED
SUB P2,LS.FR ;LESS WHAT WE HAVE
PUSHJ P,LNKCOR ;GENERAL CORE EXPANDER
PUSHJ P,E$$MEF## ;[1174] CANNOT EXPAND ANY MORE
POP P,T2
POPJ P,
;HERE TO ADD EXTENDED SYMBOL TRIPLETS (COMMON FOR INSTANCE)
;ENTER WITH P1 CONTAINING A RELATIVE POINTER INTO THE GS AREA
;RETURNS WITH P1 FIXED IN CORE.
;[2310] NOTE - CURRENTLY ONLY HANDLES ONE EXTENDED SECONDARY
LS.ADE::SPUSH <W1,W2,W3> ;[2310] Save symbol ACs
ADD P1,GS.LB ;[2310] Find the global symbol
MOVE W3,2(P1) ;[2310] Get GS area value
SUB P1,GS.LB ;[2310] Relocate pointer
PUSHJ P,LS.ADD ;[2310] Put in the symbol
ADD P1,GS.LB ;[2310] Find the global symbol
TMOVE W1,.L(P1) ;[2310] Get the secondary
TLNN W2,770000 ;[2310] Long symbol?
MOVE W2,(W2) ;[2310] Yes, make short
PUSHJ P,LS.ADD ;[2310] Insert it too
SPOP <W3,W2,W1> ;[2310] Restore symbol ACs
POPJ P, ;[2310] Done
;HERE IF USER TYPED /NOINITIAL. IF USER TYPES /SET, /COMMON, ETC. BEFORE
;LOADING ANYTHING, THEN WE NEED TO INSERT A MODULE NAME SO SYMBOLS WILL
;NOT OCCUR OUTSIDE OF A MODULE. USE THE SYMBOL NAME FOR THE MODULE NAME.
LS.CHK: MOVE T1,LSYM ;[1143] GET SIZE OF LS AREA SO FAR
CAIN T1,1 ;[1143] EMPTY?
TXNN W1,PT.SYM ;[1143] YES, BUT IS THIS A SYMBOL?
POPJ P, ;[1143] NO, NOT THE SPECIAL CASE
MOVEM T1,NAMPTR ;[1143] CREATING A NEW MODULE
AOS PRGNO ;[1143] REMEMBER ONE MORE
SPUSH <W1,W3,T2> ;[1143] SAVE CALLER'S ARGS
MOVX W1,PT.SGN!PT.TTL ;[1143] THIS IS A TITLE
SETZ W3, ;[1143] NO PREVIOUS PTR
PUSHJ P,LSADD ;[1143] INSERT IN LS AREA
SPOP <T2,W3,W1> ;[1143] RESTORE ACS
SETZM LSTGBL ;[2255] SINCE NOT REALLY A SYMBOL
SETZM LSTLCL ;[2255] ZERO THE LAST SYMBOL POINTERS
POPJ P, ;[1143] RETURN TO LS.ADD OR LS.ADE
SUBTTL GLOBAL SYMBOL STORE
;HERE WHEN SYMBOL MUST BE PUT IN TABLE
;POINTERS IN P1 _ P4
;SYMBOL STILL IN W1, W2, W3
SY.GS0::PUSHJ P,INSRT ;PUT CURRENT SYMBOL IN GLOBAL TABLE
MOVEI T2,.L ;ONLY 3 WORDS LONG
IFN FTOVERLAY,<
TXNN W1,PS.BGS ;A BOUND SYMBOL?
>
SKIPE NOSYMS ;NOT IN LOCAL IF NOT WANTED
POPJ P,
PJRST LS.ADD ;PUT IN LOCAL SYMBOL FILE
INSRT:: SKIPE @HT.PTR ;IS THERE A ZERO IN TABLE
JRST E$$SIF ;[1174] NO, ERROR, SHOULD NEVER HAPPEN
INSRT0: AOS GSYM ;COUNT SYMBOL
SOS HSPACE ;AND DECREMENT SPACE IN HASH TABLE
.JDDT LNKLOD,INSRT0,<<CAMN W2,$SYMBOL>> ;ARE WE LOOKING FOR THIS SYMBOL?
TLNN W2,770000 ;[2216] Do we have a long symbol name?
JRST INSRTE ;[2216] Yes so let's set it up
INSRTS: TXNE W1,PT.EXT ;[2216] Triplet has secondaries?
JRST INSRTL ;[2216] Yes, just move pointers
MOVEI T2,.L ;[2216] Number of words required
PUSHJ P,GS.GET## ;GO GET THEM
TMOVEM W1,0(T1) ;STORE TRIPLET SYMBOL
INSRT1: SUB T1,NAMLOC ;GET OFFSET TO NAMTAB
HRL T1,P3 ;HASH TOTAL IN LEFT HALF
MOVEM T1,@HT.PTR ;HASH TOTAL,,REL ADDRESS OF SYMBOL
TXNN W1,PS.GLB ;[2255] DEFINING A GLOBAL?
POPJ P, ;[2255] NO, RETURN
HRRZM T1,LSTGBL ;[2255] YES, STORE POINTER TO IT
SETZM LSTLCL ;[2255] NO LAST LOCAL (YET)
POPJ P, ;RETURN
;HERE IF SYMBOL IS EXTENDED
;SYMBOL IS ALREADY IN CORE POINTER NEED ADJUSTING AND W3 RESET
INSRTL: MOVE T1,W3 ;W3 POINTS TO INCORE BLOCK
ADD T1,NAMLOC ;RELATIVE TO GS.LB
MOVE W3,2(T1) ;RESTORE W3 (VALUE)
JRST INSRT1 ;PUT IN HASH TABLE
;[2216] Here for long symbol. Put it in memory
INSRTE: HLR T1,W2 ;[2216] Count of words in symbol name
MOVNS T1 ;[2216] Make it negative for aobjn pointer
HRLS T1 ;[2216] Into the left half
HRR T1,W2 ;[2216] Address of symbol in the right half
INSRTZ: SKIPE (T1) ;[2216] Zero word?
AOBJN T1,INSRTZ ;[2216] No look at the next
HLRES T1 ;[2216] See it they were all contained sym name
HLRZ T2,W2 ;[2216] Get the original word count
ADD T2,T1 ;[2216] Add (neg) count left from the aobjn
CAIG T2,1 ;[2216] Actually a short symbol?
JRST [MOVE W2,(W2) ;[2216] Yes, get the symbol
JRST INSRTS] ;[2216] Use the short symbol code
HRL W2,T2 ;[2216] Put the count of non-zero words in w2
PUSHJ P,GS.GET## ;[2216] Get that many words from the gs area
HRL T3,W2 ;[2216] BLT source address
HRR T3,T1 ;[2216] BLT dest address
ADD T2,T1 ;[2376] Add number of word to dest address
SUBI T2,1 ;[2376] Last location to load into
BLT T3,(T2) ;[2216] Go ahead and move it
SUB T1,GS.LB ;[2216] Make gs address relative
HLL T1,W2 ;[2216] Put in the size
PUSH P,T1 ;[2216] Save the size,,GS pointer
TXNE W1,PT.EXT ;[2216] Triplet has secondaries?
JRST INSRTM ;[2216] Yes, just move pointers
MOVEI T2,.L ;[2216] Number of words required
PUSHJ P,GS.GET## ;[2216] Go get them
MOVEM W1,0(T1) ;[2216] Store triplet symbol flags
POP P,1(T1) ;[2216] And the size,,GS pointer
MOVEM W3,2(T1) ;[2216] And the value
JRST INSRT1 ;[2216] Remember this symbol
;[2216] Here for long symbol in extended triplet. The triplets are
;[2216] already in the GS area, but the name pointer points to the
;[2216] DY area or static memory. Fix the pointer in the primary
;[2216] triplet.
INSRTM: MOVE T1,W3 ;[2216] W3 Points to incore block
ADD T1,GS.LB ;[2216] Relative to gs.lb
POP P,1(T1) ;[2216] Insert the pointer to the symbol
MOVE W3,2(T1) ;[2216] Restore W3 (value)
JRST INSRT1 ;[2216] PUT IN HASH TABLE
E$$SIF::.ERR. (MS,0,V%L,L%F,S%F,SIF,<Symbol insert failure, non-zero hole found>) ;[1174]
SUBTTL SATISFY GLOBAL REQUESTS
;HERE TO SATISFY GLOBAL REQUESTS WITH DEFINED VALUE
;FLAGS IN W1
;VALUE IN W3
;ALL CHAINED REQUESTS ARE RIGHT-HALF FIXUPS
;P1-P4 ARE NOT SAVED BY THIS ROUTINE
SY.RF:: SOSGE USYM ;DECREMENT UNDEFINED GLOBAL COUNT
PUSHJ P,E$$DUZ ;[1174] BUT NOT TOO FAR
TRNE FL,R.FHS ;ARE RC TABLES SCREWED UP?
JRST SY.FHS ;YES, RESTORE THEM FOR FIXUPS
TRNE FL,R.FLS ;BUT MUST SAVE THEM IF RESTORED
JRST SY.FLS ;SINCE OTHERS DEPEND ON THEM
;BOTH SY.FHS & SY.FLS RETURN HERE WITH A PUSHJ
SY.FXX: IORM W1,0(P1) ;SEE WHAT WE HAVE IN FLAGS
MOVX W1,PS.UDF!PS.REQ ;DON'T NEED THESE NOW
ANDCAB W1,0(P1) ;SO CLEAR FROM MEMORY
MOVE T2,2(P1) ;PICKUP ADDRESS
MOVEM W3,2(P1) ;STORE VALUE
PUSHJ P,SY.CHR ;CHAIN THROUGH RIGHT HALF
MOVEI T2,.L ;STORE SYMBOL BEFORE WE LOSE IT
TXNE W1,PS.COM ;IF COMMON NEED TWO TRIPLETS
JRST [ADDI T2,.L
SUB P1,GS.LB ;[654] MAKE POINTER RELATIVE
PUSHJ P,LS.ADE ;STORE MULTIPLE WORD
JRST .+2] ;SKIP NEXT INST.
PUSHJ P,LS.ADD ;IN LOCAL TABLE
TXNN W1,PS.FXP ;ANY FIXUPS FOR THIS SYMBOL?
POPJ P, ;NO
JRST SY.RF1 ;YES
E$$DUZ::.ERR. (MS,,V%L,L%F,S%F,DUZ,<Decreasing undefined symbol count below zero>) ;[1174]
SY.FHS: SKIPA T1,[1] ;LOW SEG HAS BEEN FAKED
SY.FLS: MOVEI T1,2 ;HI SEG FAKED IF /SEG:LOW
HRR R,T1 ;SETUP R FOR SG.TB; PRESERVE LH
MOVE T1,@SG.TB ;GET REAL VALUE FOR RC TABLE
EXCH T1,@RC.TB ;RESTORE IT, GET FAKE VALUE
PUSH P,T1 ;SAVE FAKE VALUE TO RESTORE LATER
PUSH P,R ;REMEMBER WHICH SEGMENT
PUSH P,LL.S2 ;LL.S2 WAS ALSO FAKED BY T.3
HRRZS LL.S2 ;IF WE ARE LOADING F10, THAT IS
PUSHJ P,SY.FXX ;RE-JOIN SY.RF TILL IT POPJS
;HERE WHEN SY.RF RETURNS. RESTORE FORCED LOADING MODE.
POP P,LL.S2 ;RESTORE LL.S2
POP P,R ;REMEMBER WHICH COUNTER WE GRABBED
POP P,@RC.TB ;AND RESTORE IT
POPJ P, ;RETURN FROM SY.RF
SUBTTL SATISFY ADDDITIVE GLOBALS
;HERE FOR ADDITIVE GLOBALS
;THE ADDDITIVE GLOBAL REQUESTS ARE STORED IN LINKED LISTS IN AREA FX
;THE INITIAL POINTER TO THEM IS IN AN EXTENDED TRIPLET IN AREA GS
SY.RF1: HRRZ P1,@HT.PTR ;SETUP P1 AGAIN
ADD P1,NAMLOC ;ABSOLUTE
SY.RF2: HLLZ T1,0(P1) ;GET FLAGS AGAIN
TXNN T1,PS.REL ;IF THIS SYMBOL IS RELOCATABLE
TDZA T1,T1 ;NO
ANDX T1,PS.REL ;ALL THOSE DEPENDING ON IT ARE TOO
MOVEM T1,SYMFLG ;STORE INCASE SYMBOL TABLE FIXUPS
SYRF2A: ADDI P1,.L ;POINT TO EXTENDED SYMBOL
MOVE T1,0(P1) ;GET FLAGS
JUMPL T1,CPOPJ ;FINISHED IF PRIMARY SYMBOL
TXNE T1,S.FXP ;[2037] This triplet a fixup request?
JRST SYRF2B ;[2037] Yes
TXNN T1,S.LST ;[2037] Is this the last secondary?
JRST SYRF2A ;[2037] No, try next
POPJ P, ;[2037] Yes, no additive fixups here
SYRF2B: MOVE T1,P1 ;[2037] Remember where we are
SUB T1,NAMLOC
PUSH P,T1 ;SO WE CAN DELETE FIXUP REQUEST WHEN DONE
MOVE P1,2(P1) ;GET POINTER TO FIXUP
SY.RF3: .JDDT LNKLOD,SY.RF3,<<CAMN P1,$FIXUP##>> ;[632]
PUSH P,P1 ;SAVE ADD OF FIXUP BLOCK
ADD P1,FX.LB ;IN CORE
MOVE W1,(P1) ;GET FLAGS AND NEXT POINTER
TXNE W1,FP.POL ;POLISH FIXUP (TYPE 11)?
JRST [PUSHJ P,SY.PF0 ;YES, SEE IF FIXUP CAN BE DONE
POP P,P1 ;RESTORE POINTER
ADD P1,FX.LB ;FIX IN CORE
JRST SY.RF4] ;AND DELETE THIS REQUEST
EXCH W2,1(P1) ;[2255] SWAP NAME WITH REQUEST
EXCH W3,2(P1) ;SWAP VALUE WITH REQUEST
PUSHJ P,SY.ADG ;DO THIS FIXUP
POP P,P1 ;RESTORE P1
ADD P1,FX.LB ;INCASE CORE MOVED
MOVE W2,1(P1) ;[2255] RESTORE W2
MOVE W3,2(P1) ;RESTORE W3
SY.RF4: MOVE T1,P1 ;FINISHED WITH IT NOW
MOVEI T2,.L
PUSHJ P,FX.RET## ;RETURN SPACE
HRRZ P1,W1 ;GET NEXT REL POINTER
JUMPE P1,SY.RF5 ;ZERO MARKS END OF CHAIN
TXNE W1,FP.SYM
JRST SY.RF3 ;DO THIS ONE
E$$ISP::.ERR. (MS,,V%L,L%F,S%F,ISP,<Incorrect symbol pointer>) ;[1174]
SY.RF5: POP P,T1 ;[2331] GET THE SYMBOL POINTER
ADD T1,NAMLOC ;[2331] IN CASE MOVED
PJRST SY.ZST ;[2331] REMOVE THE SECONDARY AND RETURN
;HERE FOR ADDITIVE GLOBAL REQUEST WITH VALUE ALREADY DEFINED
SY.ADG: TXNN W1,FS.FXS ;SYMBOL TABLE FIXUP?
JRST SY.AD0 ;NO
OR W1,SYMFLG ;STORE EXTRA FLAGS (PS.REL)
JRST SY.STF ;YES
;HERE TO FILL IN SINGLE ADDITIVE GLOBAL REQUEST
SY.AD0::
TXNE W1,FS.FXC ;RH CHAINED FIXUP?
JRST SY.ADC ;YES, HANDLE SEPERATELY
IFN FTOVERLAY,<
MOVE T1,0(P1) ;GET INCORE FLAGS
TXNE T1,PS.RBG ;FROM A RELOCATABLE LINK?
PUSHJ P,RT.FX## ;YES, STORE FIXUP FOR RELOCATION
>;END OF IFN FTOVERLAY
TLZ W3,770000 ;[2200] Remove any leftover radix 50 bits
MOVE T2,W3 ;[2200] GET 30 BIT REL ADDRESS OF FIXUP
PUSHJ P,SEGCHK ;GET CORE LOCATION
JRST SY.ADP ;OUT ON DSK (PAGED)
TXNE W1,FS.FXL ;LEFT HALF FIXUP?
JRST SY.ADL ;YES
TXNE W1,FS.FXF ;OR FULL WORD?
JRST SY.ADF ;YES
TXNE W1,FS.FXE ;[2214] OR THIRTY BIT?
JRST SY.ADE ;[2214] YES
SY.ADR:
IFN FTOVERLAY,<
TXNE W1,FS.REL ;RELOCATABLE?
TXO R,1B1 ;YES, RESET BIT IN R
PUSHJ P,SY.ADT ;RELOCATABLE OVERLAY?
JFCL RT.T2R## ;YES, SET RELOC BIT CORRECTLY
>
HRRZ T1,(T2) ;GET RIGHT HALF VALUE
ADD T1,2(P1) ;PLUS DEFINED SYMBOL
HRRM T1,(T2) ;STORE NEW VALUE
POPJ P,
SY.ADL:
IFN FTOVERLAY,<
TXNE W1,FS.REL ;RELOCATABLE?
TXO R,1B0 ;YES, RESET BIT IN R
PUSHJ P,SY.ADT ;RELOCATABLE OVERLAY?
JFCL RT.T2L## ;YES, SET RELOC BIT CORRECTLY
>
HLRZ T1,(T2) ;GET LEFT HALF VALUE
ADD T1,2(P1) ;PLUS DEFINED SYMBOL
HRLM T1,(T2) ;STORE NEW VALUE
POPJ P,
SY.ADF:
IFN FTOVERLAY,<
TXNE W1,FS.REL ;RELOCATABLE?
TXO R,3B1 ;YES, RESET BITS IN R
PUSHJ P,SY.ADT ;RELOCATABLE OVERLAY?
JFCL RT.T2F## ;YES, SET RELOC BIT CORRECTLY
>
MOVE T1,(T2) ;GET FULL WORD VALUE
ADD T1,2(P1) ;PLUS DEFINED SYMBOL
MOVEM T1,(T2) ;STORE NEW VALUE
POPJ P,
SY.ADE: ;[2214] Thirty bit
IFN FTOVERLAY,< ;[2214]
TXNE W1,FS.REL ;[2214] Relocatable?
TXO R,1B1 ;[2214] Yes, reset bits in R
PUSHJ P,SY.ADT ;[2214] Relocatable overlay?
JFCL RT.T2E## ;[2214] Yes, set reloc bit correctly
> ;[2214]
LDB T1,[ADDRESS(T2)] ;[2214] Get full word value
ADD T1,2(P1) ;[2214] Plus defined symbol
DPB T1,[ADDRESS(T2)] ;[2214] Store new value
POPJ P, ;[2214] Done
SY.ADC: MOVE T2,W3 ;RETRIEVE ADDRESS OF CHAIN
MOVE W3,2(P1) ;GET VALUE TO STORE FOR SY.CHR
TXNE W1,FS.FXL ;[2305] is it a left half chain?
PJRST SY.CHL ;[2305] yes - go do it
TXNE W1,FS.FXE ;[2305] is it a 30 bit chained fixup
PJRST SY.CHE ;[2305] yes - go do it
TXNE W1,FS.FXF ;[2305] is it a full word chained fixup
PJRST SY.CHF ;[2305] yes - go do it
PJRST SY.CHR ;[2305] must be right half chain GO CHASE CHAIN
;SY.CHR WILL DO RIGHT THING FOR
;RELOCATABLE OVERLAYS
;HERE WHEN REQUIRED ADDRESS IS NOT IN CORE
;STORE AS A FIXUP REQUEST FOR ADDITIVES, EITHER RH ,LH, OR FULL
;ENTER WITH R = 1 (LOW), OR R = 2 (HIGH)
;W1 = FIXUP FLAGS
;W3 = ADDITIVE REQUEST
;2(P1) = SYMBOL VALUE
;PUT T2 =W3 AND W3 = 2(P1)
SY.ADP: MOVE T2,W3 ;EXPECTS ADDRESS IN T2
MOVE W3,2(P1) ;TRUE VALUE IN W3
TXNE W1,FS.FXR ;RIGHT HALF FIXUP?
TXO T2,CPF.AR ;[2200] YES
TXNE W1,FS.FXL ;LEFT HALF FIXUP
TXO T2,CPF.AL ;[2200] YES
TXNE W1,FS.FXF ;FULL WORD?
TXO T2,CPF.AF ;[2200] YES
TXNE W1,FS.FXE ;[2214] THIRTY BIT FIXUP?
TXO T2,CPF.AE ;[2263] YES
TXNE W1,FS.FXC ;RIGHT HALF CHAINED?
TXO T2,CPF.CR ;[2200] YES
PJRST SY.CHP ;LINK IN
IFN FTOVERLAY,<
SY.ADT: SKIPN RT.LB ;IS IT RELOCATABLE
POPJ P, ;NO
PUSH P,P1 ;SAVE SYMBOL TABLE PTR
MOVSI P1,(Z @) ;TURN ON @ IN STACK
IORM P1,-1(P) ;THERE MUST BE AN EASIER WAY?
SETZ P1, ;SIGNAL NOT A SYMBOL FIXUP
HRRZ T2,W3 ;RESET ADDRESS
PUSHJ P,@-1(P) ;GO TO CORRECT ROUTINE
POP P,P1 ;RESTORE
HRRZ T2,W3 ;RESET ADDRESS
PUSHJ P,SEGCHK ;GET CORE LOCATION
HALT . ;CAN NOT HAPPEN
POPJ P, ;AND RETURN
>
;HERE FOR SYMBOL TABLE FIXUP
;CALLED BY
; MOVE W1,FLAGS
; MOVE W2,GLOBAL SYMBOL TABLE POINTER [2255]
; MOVE W3,LOCAL SYMBOL TABLE POINTER [2255]
; MOVE P1,POINTER TO DEFINING TRIPLET (GS OR FX)
; PUSHJ P,SY.STF
;USES T1 - T4
SY.STF::SPUSH <W3,W2,W1,P1> ;SAVE ALL VALUES NEEDED LATER
SYSTF1: MOVE T1,W2 ;[2255] GET GLOBAL ADDRESS
JUMPE T1,SYSTFL ;NO GLOBAL FIXUP REQUIRED
TXNE W1,FS.MDC ;[1213] ONLY WANT TO COMPARE VALUES?
JRST [MOVE T1,P1 ;[1213] YES, USE DEFINING TRIPLET AS VALUE
JRST SYSTFC] ;[1213] SKIP SEARCH FOR S.PVS TRIPLET
ADD T1,NAMLOC ;RELOCATE
MOVE T3,0(T1) ;GET FLAGS
TXNN T3,PT.OTH ;NOT SYMBOL?
JRST SYSTF3 ;YES IT IS
TXNN T3,PO.IND ;INDIRECT POINTER PERHAPS?
PUSHJ P,E$$ISP ;[1174] NO???
MOVE W2,2(T1) ;[2255] RESET REAL POINTER
MOVEM W2,-2(P) ;[2255] KEEP STACK UP TO DATE
MOVEI T2,.L ;AND GET RID OF THIS DUMMY BLOCK
PUSHJ P,GS.RET##
JRST SYSTF1 ;TRY AGAIN
SYSTF2: TXNE T3,S.LST ;MORE TO COME?
PUSHJ P,E$$ISP ;[1174] NO, NO PVS TRIPLET???
SYSTF3: ADDI T1,.L ;LOOK AT NEXT TRIPLET
SKIPG T3,0(T1) ;PICK UP FLAGS
PUSHJ P,E$$ISP ;[1174] MUSN'T BE PRIMARY
TXNN T3,S.PVS ;FOUND THE PVS TRIPLET?
JRST SYSTF2 ;NO, KEEP LOOKING
;FALL THROUGH TO NEXT PAGE
;HERE WITH ABSOLUTE POINTER TO PVS TRIPLET IN T1. DEFINE GLOBAL SYMBOL.
MOVE T2,W1 ;GET FIXUP FLAGS FOR SY.AST
MOVE W3,2(P1) ;[572] AND FIXUP VALUE
PUSHJ P,SY.AST ;SET 2(T1) TO REAL VALUE
SYSTFC: MOVX T3,PS.UDR ;[1213] ASSUME RH FIXUP
TXNE W1,FS.FXL ;LEFT HALF?
TXC T3,PS.UDF ;YES, MAKE DEFINITION LH TOO
TXNN W1,FS.FXF ;[2214] UNLESS FULL WORD
TXNE W1,FS.FXE ;[2214] OR 30 BIT
TXO T3,PS.UDF ;IN WHICH CASE WE'RE DEFINING ALL
MOVE T2,-2(P) ;[2255] RESTORE PRIMARY TRIPLET ADDR
ADD T2,NAMLOC ;MAKE ABSOLUTE
MOVE T4,T3 ;[612] COPY OF BITS BEING DEFINED
AND T4,0(T2) ;[612] WHICH OF THOSE ARE NOW UNDEFINED
CAME T3,T4 ;[612] ANYTHING WE'RE DEFINING KNOWN?
JRST SYSTFM ;YES, MULTIPLE DEFINITION
PUSHJ P,SYSTFF ;SET FLAGS AT 0(T2) PROPERLY
TXNE T3,PS.UDF ;STILL UNDEFINED ANYWHERE?
JRST SYSTFL ;YES, GIVE UP FOR NOW
SOSGE USYM ;NO, DECREMENT USYM
PUSHJ P,E$$DUZ ;[1174] BUT NOT TOO FAR
MOVE W3,2(T1) ;GET NOW-DEFINED VALUE
MOVE P1,T2 ;POINT TO PRIMARY OF NEW SYMBOL
TXNN W1,FS.MDC ;[1213] DON'T ZAP S.PVS IF WE DIDN'T USE IT
PUSHJ P,SY.ZST ;AND ZAP 2NDARY 3RPLET
MOVE W1,0(P1) ;GET FLAGS FOR SY.FXP
PUSHJ P,SY.FXP ;GO DO ALL DEFINITIONS
JRST SYSTFL ;AND CORRECT LS AREA TRIPLET
;HERE IF WE FOUND A MULTIPLE DEFINITION, WITH T1 POINTING TO PRIMARY,
;AND T2 POINTING TO S.PVS TRIPLET. WARN USER AND DISCARD NEW VALUE.
SYSTFM: MOVE P1,T2 ;STORE P.T. ADDR IN P1 FOR SY.MDF
MOVE T4,0(T2) ;GET STILL UNDEF BITS IF ANY
MOVE T2,2(T1) ;NEW SYMBOL VALUE
TXNE T3,PS.UDR ;NOT DEFINING RH?
TXNE T4,PS.UDR ;RH STILL UNKNOWN?
HRR T2,2(P1) ;YES, CAN'T BE MULTIPLE DEFINITION
TXNE T3,PS.UDL ;SAME CASE FOR LH
TXNE T4,PS.UDL ;ONLY GIVE MDS IF CONFLICT
HLL T2,2(P1) ;NOW HAVE ADJUSTED NEW VAL IN T2
CAMN T2,2(P1) ;MULTIPLE DEFINITION?
JRST SYSTFL ;NO (WHAT LUCK!) GO FIX LS AREA
DMOVE W1,0(P1) ;YES, SET NEW TRIPLET FROM OLD
MOVE W3,2(T1) ;BUT WITH DIFFERENT VALUE
PUSHJ P,SY.MDF ;WARN USER OF BUG
SKIPA T4,[PS.MDF] ;FLAG TO SET IN LOCAL TABLE
;SKIP THROUGH TO FIXUP LOCAL TABLE
;HERE TO FIX THINGS UP IN THE LOCAL SYMBOL TABLE
SYSTFL: MOVEI T4,0 ;NORMAL ENTRY, NOT MDS
PUSH P,T4 ;REMEMBER FOR AFTER SYSTF4 RETURNS
MOVE P1,-1(P) ;RESTORE EVERYTHING
MOVE W1,-2(P) ;. .
MOVE W2,-3(P) ;. .
MOVE W3,-4(P) ;. .
PUSHJ P,SYSTF4 ;GO FIXUP LOCAL TABLE
SPOP <T4,P1,W1,W2,W3> ;RESTORE THINGS FOR POSTERITY
MOVE T2,W3 ;[2255] GET RELATIVE LS ADDRESS
JUMPE T2,CPOPJ ;[572] GIVE UP IF NONE
CAML T2,LW.LS ;[572] IS IT STILL IN CORE?
IORM T4,0(T1) ;YES, SET MULTIPLY DEFINED
POPJ P, ;DONE
SYSTF4: MOVE T2,W3 ;[2255] GET ADDRESS IN LOCAL TABLE
JUMPE T2,CPOPJ ;FORGET IT IF NOT IN LOCAL TABLE
CAMGE T2,LW.LS ;STILL IN CORE?
JRST SY.STP ;NO, GO GENERATE FIXUP
ADD T2,LS.LB ;YES, MAKE ABSOLUTE ADDRESS
SUB T2,LW.LS ;IN CASE PAGING
MOVX T3,PS.UDR ;ASSUME RH FIXUP
TXNE W1,FS.FXL ;LEFT HALF?
TXC T3,PS.UDF ;YES, MAKE DEFINITION LH TOO
TXNN W1,FS.FXF ;[2214] UNLESS FULL WORD
TXNE W1,FS.FXE ;[2214] OR THIRTY BIT
TXO T3,PS.UDF ;IN WHICH CASE WE'RE DEFINING ALL
PUSHJ P,SYSTFF ;SET FLAGS AT 0(T2) CORRECTLY
MOVE T1,T2 ;T1 POINTS TO LS TRIPLET
MOVE T2,W1 ;T2 CONTAINS FIXUP FLAGS
MOVE W3,2(P1) ;[572] W3 IS ADDITIVE DEFINITION
PJRST SY.AST ;GO FIXUP LS TRIPLET
;HERE TO SET THE FLAGS AT 0(T2) FROM T3 & W1
SYSTFF: ANDCAB T3,0(T2) ;ZAP BITS NOW DEFINED
MOVX T4,PS.REQ ;HOPE WE CAN CLEAR THIS NOW
TXNN T3,PS.UDF ;ONLY IF COMPLETELY DEFINED
ANDCAM T4,0(T2) ;GOT IT!
MOVX T4,PS.REL ;MUST ALSO SET RELOC IF OTHER WAS
TXNE W1,FS.REL ;WAS IT?
IORM T4,0(T2) ;YES, SO NEW SYMBOL IS TOO
POPJ P, ;RETURN WITH T3 SET UP
;HERE FOR POLISH FIXUPS CAUSED BY A BLOCK TYPE 11
;CONTAINING ONE OR MORE UNDEFINED GLOBAL SYMBOLS
;REPLACE THE NOW DEFINED SYMBOL BY ITS VALUE
;IF MORE UNDEFS EXIST GIVE UP
;IF ALL SYMBOLS ARE DEFINED DO FIXUP
SY.PF0: MOVE T4,2(P1) ;GET REL ADDRESS OF POLISH BLOCK
ADD T4,FX.LB ;ADD BASE
MOVE T1,(T4) ;[2212] GET THE HEADER WORD
TXNE T1,FF.NEW ;[2212] NEW STYLE POLISH BLOCK?
JRST SY.NPF ;[2212] YES
HRLI T4,(POINT 18) ;FORM BYTE POINTER
ADDI T4,2 ;BYPASS HEADER AND GLOBAL COUNT
SKIPA T3,T4 ;USE T3 AS CURRENT, T4 AS INITAL
SYPF1: IBP T3 ;BYPASS NEXT HALF WORD
SYPF2: ILDB T1,T3 ;READ HALF WORD
CAIL T1,MXPLOP## ;[712] CHECK FOR VALID OPS
JRST [CAIGE T1,600000 ;[2203] PSECT INDEX?
JRST SYPF2 ;[2203] YES, SKIP IT
CAIGE T1,610000 ;[2203] NEW STYLE HALFWORD FETCH?
JRST SYPF1 ;[2203] YES, IGNORE NEXT HALFWORD TOO
POPJ P,] ;[712] STORE OPERATOR, IGNORE, NOT ALL DEFINED
CAIL T1,3 ;IF OPERATOR
JRST SYPF2 ;IGNORE IT
CAIN T1,1 ;36 BIT VALUE?
AOJA T3,SYPF2 ;YES, GET NEXT HALF WORD AFTER IT
;HERE IF T1=2, GLOBAL SYMBOL REQUEST
ILDB T1,T3 ;GET FIRST PART OF SYMBOL
HRLZ T2,T1 ;STORE LEFT HALF PART OF SYMBOL
ILDB T1,T3 ;GET RIGHT HALF PART
HRR T2,T1 ;FULL SYMBOL IN W2
CAME T2,W2 ;IS THIS THE SYMBOL NOW DEFINED?
JRST SYPF2 ;NO
SUBI T3,2 ;BACKUP BYTE POINTER
IBP T3 ;TO POINT TO 2
MOVEI T1,1 ;CHANGE GLOBAL MARKER INTO 36 BIT VALUE MARKER
IDPB T1,T3
MOVS T1,W3 ;GET VALUE
IDPB T1,T3 ;STORE IT
MOVSS T1
IDPB T1,T3 ;T3 BACK AS IT WAS
SOSE -1(T4) ;ALL UNDEFS NOT DEFINED?
POPJ P, ;[2212] NO, CAN'T EVALUATE THIS TIME
;NOW TO EVALUATE POLISH FIXUP
;USE T.11EV (IN LNKOLD)
;THIS USES W1, W2, W3 FOR NON-SYMBOL USE
SPUSH <W1,W2,W3> ;SAVE SYMBOL ACCS
SUB T4,FX.LB ;UNRELOCATE
MOVEM T4,T11BP ;SETUP BYTE POINTER
MOVE T1,2(P1) ;ADDRESS OF POLISH BLOCK
ADD T1,FX.LB ;MAKE ABSOLUTE
HRLZ T1,0(T1) ;BLOCK LENGTH
HRRI T1,-2(T4) ;START ADDRESS OF BLOCK
MOVEM T1,T11FA
PUSHJ P,T.11EV## ;EVALUATE
SPOP <W3,W2,W1> ;RESTORE ACCS
POPJ P,
;[2212] Here to handle new style (1072) polish fixup blocks
SY.NPF: PUSH P,P1 ;[2212] Save some AC's which are used as
PUSH P,P2 ;[2212] temporaries in the EXTEND instructions
PUSH P,P3 ;[2212] Save a place for the pointer
PUSH P,P4 ;[2212] And another place for T1072E
MOVEI P3,2(T4) ;[2212] Get the start of the polish
HRLI P3,(POINT 18) ;[2212] Make it a byte pointer
SKIPA P4,P3 ;[2212] Keep the pointer to the beginning
SYNP0: IBP P3 ;[2212] Eat a halfword
SYNP1: ILDB T1,P3 ;[2212] Get the next halfword
CAIL T1,PL.NSO ;[2212] Store operator (new style)
JRST SYNPR ;[2212] Yes, Go pop and return
CAIL T1,PL.NEW ;[2212] Halfword data operator?
JRST SYNP0 ;[2212] Yes, eat the next halfword
CAIL T1,PL.IL ;[2212] Psect index?
JRST SYNP1 ;[2212] Yes, ignore it
JUMPE T1,SYNP0 ;[2212] If absolute halfword eat 1 halfword
CAIE T1,PL.ABF ;[2212] Fullword absolute?
CAIN T1,PL.RLF ;[2212] Or fullword relocatable?
AOJA P3,SYNP1 ;[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 SYNP1 ;[2212] An operator, ignore it
;[2212] Here if a symbol. Figure out whether a long symbol test is
;[2212] needed.
LSH T1,-^D9 ;[2212] Get the count
TLNN W2,770000 ;[2212] Short symbol
JRST SYNPL ;[2212] Long symbol, must compare strings
;[2212] Check special case of long symbol in polish block. Must be
;[2212] compared anyways because symbol in polish block could be short
;[2212] symbol padded with null halfwords.
CAILE T1,1 ;[2212] Short symbol (or converted radix-50)?
JRST SYNPS ;[2212] No, it's special
;[2212] Here for a short symbol compare. Build the symbol in an AC
;[2212] and do a simple compare.
ILDB T2,P3 ;[2212] Get a symbol halfword
ILDB T1,P3 ;[2212] And another
HRL T1,T2 ;[2212] Build entire symbol
CAME T1,W2 ;[2212] This the symbol?
JRST SYNP1 ;[2212] No, try some more
SUBI P3,2 ;[2212] Back up the byte pointer
IBP P3 ;[2212] By three bytes
MOVEI T2,PL.ABF ;[2212] Get absolute fullword code
IDPB T2,P3 ;[2212] Store it
HLR T2,W3 ;[2212] Get the high order value
IDPB T2,P3 ;[2212] Store it
IDPB W3,P3 ;[2212] Store the low order value
JRST SYNPE ;[2212] See if ready to evaluate
;[2212] Here to compare a short symbol and a long one. Build a pointer
;[2212] to the short symbol and use the long symbol code.
SYNPS: MOVEI T4,2 ;[2212] Count two halfwords for symbol
MOVE P1,[POINT 18,W2] ;[2212] Symbol is in W2
JRST SYNPX ;[2212] Join the long symbol code
;[2212] Here for long symbols. Set up and do a string compare.
;[2212] T1 and T2 contain the count and pointer for the polish block.
;[2212] T4 and P1 contain the count and pointer for the symbol.
;[2212] Also adjust the byte pointer to the end of the symbol.
SYNPL: HRR P1,W2 ;[2212] Get the address of the symbol
ADD P1,GS.LB ;[2212] Make it absolute
HRLI P1,(POINT 18,) ;[2212] Get the pointer
HLR T4,W2 ;[2212] Get the count (in words)
ADD T4,T4 ;[2212] Make count into halfwords
SYNPX: ADDI T1,1 ;[2212] Get a correct count
PUSH P,P3 ;[2212] Save the pointer in case of match
PUSH P,T1 ;[2212] And the length
MOVE T2,P3 ;[2212] Get the pointer to the string
MOVE T3,P3 ;[2212] Get the pointer
MOVE P3,T1 ;[2212] Get the count
ADJBP P3,T3 ;[2212] Point at the end of the string
EXTEND T1,[CMPSE ;[2212] Do the string compare
0 ;[2212] Pad with zeros if either string
0] ;[2212] runs out.
JRST [POP P,(P) ;[2212] Not the same, toss the count
POP P,(P) ;[2212] And the old pointer
JRST SYNP1] ;[2212] Keep looking
POP P,T1 ;[2212] Get the count
POP P,T2 ;[2212] And the pointer
MOVEI T3,PL.ABF ;[2212] Get the code for absolute fullword
DPB T3,T2 ;[2212] Store it
HLR T3,W3 ;[2212] Get the value (left half)
IDPB T3,T2 ;[2212] Store it
IDPB W3,T2 ;[2212] Store the right half of the value
MOVEI T3,PL.IL ;[2212] Get a psect index (no-op)
SUBI T1,2 ;[2212] Account for the two stored halfwords
SYNPZ: IDPB T3,T2 ;[2212] Overwrite a symbol halfword
SOJG T1,SYNPZ ;[2212] Clear all extra symbol halfwords
; JRST SYNPE ;[2212] See if ready to evaluate
;[2212] Here to decide whether to evaluate. Evaluate if the last
;[2212] Global in the block has just been defined.
SYNPE: SOSE -1(P4) ;[2212] Count one more defined, last one?
JRST SYNPR ;[2212] No, can't evaluate this time
;[2212] Here to evaluate a new-style polish fixup. The evaluation
;[2212] is done in T1072E in LNKNEW.
SPUSH <W1,W2,W3> ;[2212] Save the symbol ACs
HRRZI T1,-2(P4) ;[2212] Get address of beginning of block
SUB P4,FX.LB ;[2212] Relocate
MOVEM P4,T11BP ;[2212] Save the byte pointer
HRL T1,0(T1) ;[2212] Get the count
SUB T1,FX.LB ;[2212] Relocate, make count,,address in FX
MOVEM T1,T11FA ;[2212] Save it
PUSHJ P,T1072E## ;[2212] Evaluate the polish block
SPOP <W3,W2,W1> ;[2212] Restore the symbol ACs
SYNPR: POP P,P4 ;[2212] Restore the ACs
POP P,P3 ;[2212]
POP P,P2 ;[2212]
POP P,P1 ;[2212]
POPJ P, ;[2212] And return
;HERE TO GENERATE LOCAL SYMBOL FIXUP IN A LINKED LIST
;FORMAT OF FIXUP IS THE SAME AS ALL OTHER PAGED FIXUPS
;WORD 1 BACK PTR,,FORWARD PTR
;WORD 2 INDEX,,SYMPTR
;WORD 3 VALUE
;
;CALLED BY
; MOVE W1,DEFINING SYMBOL FLAGS
; MOVE W3,SYMBOL PTR
; MOVE P1,PTR TO DEFINING SYMBOL
; PUSHJ P,SY.STP
;DESTROYS R
SY.STP: PUSH P,W3 ;SAVE LOCAL SYMBOL PTR
MOVE T2,W3 ;[2255] AND REL ADDRESS IN SYMBOL TABLE
MOVE W3,2(P1) ;FIXUP VALUE FROM ORIGINAL SYMBOL DEF
TXNE W1,FS.FXR ;RIGHT HALF FIXUP?
TXO T2,SPF.AR ;[2200] YES
TXNE W1,FS.FXL ;LEFT HALF FIXUP?
TXO T2,SPF.AL ;[2200] YES
TXNE W1,FS.FXF ;FULL WORD FIXUP?
TXO T2,SPF.AF ;[2200] YES
TXNE W1,FS.FXE ;[2214] THIRTY BIT FIXUP?
TXO T2,SPF.AE ;[2214] YES
TXNN W1,FS.REL ;DEFINING SYMBOL RELOCATABLE?
JRST SYSTP1 ;NO, FIXUP TYPE IS OK
ADD T2,[SPF.RR-SPF.AR] ;[2200] MAKE CORRESPONDING
SYSTP1: MOVEI R,FS.SS-FX.S0 ;LOAD INDEX
SUB P1,FX.LB ;REMOVE OFFSET INCASE CORE MOVES
PUSHJ P,SY.CHP ;LINK INTO LIST
ADD P1,FX.LB ;...
POP P,W3 ;RESTORE W3
POPJ P,
SUBTTL ADDRESS CHAINS (RH, LH, FULL WORD)
;FIXUP CHAINING OF SYMBOLS
;ENTER WITH
;W3 = VALUE
;T2 = ADDRESS OF CHAIN (REL TO PROG ORIGIN)
;RIGHT HALF
SY.CHR::
SKIPE T2 ;[1733] NO CHAIN?
SKIPE BADCORE## ;[1300] POSSIBLE FIXUP TO OVERLAID PSECT?
POPJ P, ;[1300] YES, DON'T DO FIXUP
IFN TOPS20,< ;[2202]
TLNN W2,770000 ;[1733] SIXBIT symbol ?
JRST SYCHR0 ;[1733] No, just store the value
MOVE T1,W3 ;[1734] Don't hack with real value
TLCE T1,-1 ;[1734] Is the left half all zeros ?
TLCN T1,-1 ;[1734] Or all ones?
JRST SYCHR0 ;[1733] Yes, store RH of value
PUSH P,T2 ;[1420] Save the address
XOR T2,W3 ;[1733] Clear bits that match
TLNE T2,-1 ;[1733] Same left half value ?
PUSHJ P,E$$FTH ;[1412] No, warn user of value truncation
POP P,T2 ;[1420] Get back store address
> ;[2202] IFN TOPS20
SYCHR0: HLL T1,T2 ;[2200] Get the section number for the chain
SYCHR1: ;[1733]
IFN FTOVERLAY,<
SKIPE RT.LB ;RELOCATABLE OVERLAY?
PUSHJ P,RT.T2R## ;YES, SET RELOC BIT CORRECTLY
>
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
JRST [TXO T2,CPF.CR ;[2200] PAGE NOT IN CORE
JRST SY.CHP] ;CHAIN REQUESTS TOGETHER
HRR T1,(T2) ;[2200] GET NEXT LINK, PRESERVING SECTION
;[2200] Here is where section defaulting is done for right halfword
;[2200] fixups. The current rule is to wrap within a section.
HRRM W3,(T2) ;FILL IN VALUE
MOVE T2,T1 ;SETUP FOR NEXT
TRNE T2,-1 ;[2200] Any more?
JRST SYCHR1 ;[2200] Yes, loop back
POPJ P, ;[1733] End of chain, return
;LEFT HALF
SY.CHL::SKIPE T2 ;[1733] No chain to worry about?
SKIPE BADCORE## ;[1733] or possible fixup to overlaid psect?
POPJ P, ;[1300] Yes, don't do fixup
IFN TOPS20,< ;[2202]
TLNN W2,770000 ;[1733] SIXBIT symbol ?
JRST SYCHL0 ;[1420] No, just store the value
MOVE T1,W3 ;[1734] Don't hack with real value
TLCE T1,-1 ;[1734] Is the left half all zeros ?
TLCN T1,-1 ;[1734] Or all ones?
JRST SYCHL0 ;[1733] Yes, store RH of value
PUSH P,T2 ;[1420] SAVE THE ADDRESS
XOR T2,W3 ;[1733] Clear bits that match
TLNE T2,-1 ;[1733] Same left half value ?
PUSHJ P,E$$FTH ;[1412] No, warn user of value truncation
POP P,T2 ;[1420] Get back store address
> ;[2202] IFN TOPS20
SYCHL0: HLL T1,T2 ;[2200] Get the section number for the chain
SYCHL1: ;[1733]
IFN FTOVERLAY,<
SKIPE RT.LB ;RELOCATABLE OVERLAY?
PUSHJ P,RT.T2L## ;YES, SET RELOC BIT CORRECTLY
>
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
JRST [ TXO T2,CPF.CL ;[2200] PAGE NOT IN CORE
JRST SY.CHP] ;CHAIN REQUESTS TOGETHER
HLR T1,(T2) ;[2200] GET NEXT LINK, PRESERVING SECTION
;[2200] Here is where section defaulting is done for left halfword
;[2200] fixups. The current rule is to wrap within a section.
HRLM W3,(T2) ;FILL IN VALUE
MOVE T2,T1 ;SETUP FOR NEXT
TRNE T2,-1 ;[2200] Any more?
JRST SYCHL1 ;[2200] Yes, loop back
POPJ P, ;[1733] END OF CHAIN, RETURN
E$$FTH::
.ERR. (MS,.EC,V%L,L%W,S%W,FTH,<Fullword value >) ;[2007]
.ETC. (SBX,.EC!.EP,,,,W2) ;[1412]
.ETC. (STR,,,,,,< being truncated to halfword>) ;[1412]
POPJ P, ;[1420]
;FULL WORD
SY.CHF::SKIPE BADCORE## ;[1300] POSSIBLE FIXUP TO OVERLAID PSECT?
POPJ P, ;[1300] YES, DON'T DO FIXUP
SY.CF1: ;[2200]
IFN FTOVERLAY,<
SKIPE RT.LB ;RELOCATABLE OVERLAY?
PUSHJ P,RT.T2F## ;YES, SET RELOC BIT CORRECTLY
>
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
JRST [TXO T2,CPF.CF ;[2200] PAGE NOT IN CORE
JRST SY.CHP] ;CHAIN REQUESTS TOGETHER
;[2214] Here is where section defaulting is done for fullword chained
;[2214] fixups. The current rule is use the 30 bit address and cross
;[2214] sections as necessary.
LDB T1,[ADDRESS(T2)] ;[2214] GET NEXT LINK
MOVEM W3,(T2) ;FILL IN VALUE
MOVE T2,T1 ;SETUP FOR NEXT
JUMPN T2,SY.CF1 ;[2214] IF MORE TO FIXUP, DO IT
POPJ P, ;[2200] DONE IF END OF CHAIN
;Thirty Bit
SY.CHE::SKIPE BADCORE## ;[2214] Possible fixup to overlaid psect?
POPJ P, ;[2214] Yes, don't do fixup
SY.CE1: ;[2214]
IFN FTOVERLAY,< ;[2214]
SKIPE RT.LB ;[2214] Relocatable overlay?
PUSHJ P,RT.T2F## ;[2214] Yes, set reloc bit correctly
> ;[2214]
PUSHJ P,SEGCHK ;[2214] Setup incore address
JRST [TXO T2,CPF.CE ;[2214] Page not in CORE
JRST SY.CHP] ;[2214] Chain requests together
;[2214] Here is where section defaulting is done for fullword chained
;[2214] fixups. The current rule is use the 30 bit address and cross
;[2214] sections as necessary.
LDB T1,[ADDRESS(T2)] ;[2214] Get next link
DPB W3,[ADDRESS(T2)] ;[2214] Fill in value
MOVE T2,T1 ;[2214] Setup for next
JUMPN T2,SY.CE1 ;[2214] If more, do it
POPJ P, ;[2214] Done if end of chain
SUBTTL DEFER FIXUPS
;HERE IF REQUIRED ADDRESS NOT INCORE
;DO NOT READ PAGE BACK IN, JUST STORE REQUEST IN FX TABLE
;FILL IN LATER WHEN ENOUGH TO JUSTIFY READING PAGE BACK
;FIXUPS ARE STORED IN DOUBLLY LINKED LIST IN ASCENDING ORDER
;POINTER IS PTR TO HIGHEST ADD,,PTR TO LOWEST ADD
;THE NULL LINK IS 0
;DATA BLOCK IS
; BACKWARD PTR,,FORWARD PTR
; FIXUP ADDRESS IN USER CORE
; FIXUP VALUE
;CALLED BY
; MOVEI R,TABLE OFFSET (REL TO FX.S0)
; MOVE T2,REL ADDRESS OF FIXUP
; MOVE W3,VALUE OF FIXUP
; PUSHJ P,SY.CHP
SY.CHP::HRRZ T1,R ;CLEAR RELOCATION BITS
CAILE T1,FS.SS-FX.S0 ;VALIDATE INDEX
PUSHJ P,INVIDX ;INVALID INDEX
PUSH P,T2 ;SAVE ADDRESS
MOVEI T2,3 ;NEED 3 WORD BLOCK
PUSHJ P,FX.GET## ;IN FIXUP AREA
POP P,T2 ;REL ADDRESS (TO SEGMENT) OF REQUEST
MOVEM T2,1(T1) ;STORE IN BLOCK
MOVEM W3,2(T1) ;AND VALUE
SUB T1,FX.LB ;REMOVE SET
.JDDT LNKLOD,SY.CHP,<<CAMN T1,$FIXUP##>> ;[632]
TLZ T2,770000 ;[2200] Addresses are only 30 bits
PUSH P,P1 ;[2200] Save an accumulator
HLRZ T3,T2 ;[2200] Get the section number
MOVEI P1,FX.S0(R) ;[2200] Point to the correct segment
HRRZ T4,R ;[2200] Get the section number
CAIN T4,1 ;[2200] Pointing to low segment?
MOVEI P1,FXSPTR(T3) ;[2200] Yes, use section specific pointer
AOS FXC.S0(R) ;[2200] Increment count of fixups per segment
PUSHJ P,SY.FP0 ;[2200] Store the fixup
POP P,P1 ;[2200] Restore P1
POPJ P, ;[2200] Return
SUBTTL FIXUP CHAIN CONSTRUCTION
;NOW TO LINK IN CHAIN, HERE WITH
;P1 = POINTER TO FIXUP CHAIN
;T1 = ADDRESS (REL TO FX.LB) OF THIS BLOCK
;T2 = VALUE (ADDRESS REL TO SEG OF FIXUP)
;USES T3, T4 AS POINTERS
SY.FP0: SKIPE (P1) ;[2200] VIRGIN CHAIN?
JRST SY.FP1 ;NO
HRL T1,T1 ;BOTH ENDS POINT TO SAME LOC
MOVEM T1,(P1) ;[2200] STORE LINK
POPJ P, ;RETURN
INVIDX: POP P,T1 ;GET LOCATION
HRRZS T1 ;CLEAR FLAGS
E$$IVC::.ERR. (MS,.EC,V%L,L%F,S%F,IVC,<Index validation check failed at address >) ;[1212]
.ETC. (OCT,.EP,,,,T1)
;HERE IF CHAIN ALREADY SETUP
SY.FP1: HLRZ T3,(P1) ;[2200] GET PTR TO TOP OF CHAIN
ADD T3,FX.LB ;ADD IN OFFSET
SETZ T4, ;PREV PTR WAS START OF CHAIN
PUSH P,T1 ;[2200] SAVE THE POINTER
TLZ T2,770000 ;[2200] GET THE 30 BIT ADDRESS PART ONLY
JRST SY.FP4 ;FIRST TIME THROUGH LOOP
SY.FP2: HRLZ T4,T4 ;SAVE LAST IN LEFT HALF
HRR T4,T3 ;SAVE THIS IN RIGHT
HLRZ T3,(T4) ;GET NEXT LOWER
JUMPE T3,SY.FX6 ;END IF ZERO
ADD T3,FX.LB ;ADD IN OFFSET
SY.FP4: LDB T1,[ADDRESS 1(T3)] ;[2200] GET THE 30 BIT ADDRESS
CAML T2,T1 ;[2200] FIND ADDRESS SMALLER THAN WHAT WE HAVE
JRST SY.FP3 ;YES, LINK INTO LIST
JRST SY.FP2 ;NO, TRY AGAIN
SY.FX6: POP P,T1 ;[2200] AND THE POINTER
HRLM T1,(T4) ;[2200] ADD TO END
HRRM T1,(P1) ;[2200] AND TO INITIAL PTR
SUB T4,FX.LB ;-OFFSET
ADD T1,FX.LB ;+OFFSET
HRRZM T4,(T1) ;FORWARD LINK
POPJ P,
SY.FP3: POP P,T1 ;[2200] AND THE POINTER
TRNN T4,-1 ;[2200] START OF CHAIN IF 0 ADDRESS
JRST SY.FP5 ;YES, USE PREV POINTERS
HRRM T1,(T3) ;FWD PTR IN NEXT LOWER
HRLM T1,(T4) ;BKW PTR IN NEXT HIGHER
ADD T1,FX.LB ;ADD OFFSET
SUB T4,FX.LB ;REMOVE OFFSET
SUB T3,FX.LB ;FROM ADJACENT BLOCKS
HRRM T4,(T1) ;STORE IN LINK ADDRESS
HRLM T3,(T1)
POPJ P,
;HERE IF NEW ADDRESS IS BIGGEST YET
SY.FP5: HRRM T1,(T3) ;LINK BACK IN CHAIN
HRLM T1,(P1) ;[2200] AND INITIAL PTR
ADD T1,FX.LB ;FIX
SUB T3,FX.LB ;REMOVE OFFSET
HRLZM T3,(T1) ;BACKWARDS PTR
POPJ P,
SUBTTL MULTIPLY DEFINED GLOBAL
;HERE IF MULTIPLY DEFINED GLOBAL SYMBOL
;ENTER WITH W1, W2, W3 CONTAIN NEW SYMBOL
;P1 IS POINTER TO OLD SYMBOL
;USES T1
SY.MDS::PUSHJ P,SY.MDF ;WARN USER AND SET GLOBAL FLAG
TXO W1,PS.MDF ;FLAG MULTIPLE FOR LOCALS
PJRST LS.ADD ;AND GO STICK IN LOCAL TABLE
SY.MDF: MOVE T1,0(P1) ;GET CURRENT FLAGS
TXON T1,PS.MDF ;FLAG IT MULTIPLY DEFINED
AOS MSYM ;AND COUNT ONE MORE IF NEW
MOVEM T1,0(P1)
MOVE T1,2(P1) ;CURRENT VALUE
E$$MDS::.ERR. (MS,.EC,V%L,L%W,S%W,MDS,<Multiply-defined global symbol >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2) ;SYMBOL IN W2
.ETC. (JMP,.EC,,,,.ETIMF##) ;[1174] PRINT OFFENDING MODULE
.ETC. (NLN,.EC) ;[1174]
.ETC. (STR,.EC,,,,,<Defined value = >) ;[1174]
.ETC. (OCT,.EC!.EP,,,,T1) ;CURRENT VALUE
.ETC. (STR,.EC,,,,,<, this value = >)
.ETC. (OCT,.EP,,,,W3) ;[1174]
SETZM LSTGBL ;[2255] SO WE DON'T DO FIXUPS?
SETZM LSTLCL ;[2255] TO LOCAL OR GLOBAL SYMBOL
POPJ P,
;HERE TO FILL IN PARTIAL VALUE SYMBOL (SYM1=SYM2)
;PRIMARY VALUE IS USUAL CHAINED REFERENCES
;SECONDARY VALUE IS ADDITIVE VALUE OF PARTIAL DEFINITION
;THERE MAY ALSO BE ADDITIVE GLOBAL FIXUPS REQUIRED
;CALLED BY
; MOVE T1,ADDRESS OF GLOBAL TO FIXUP
; MOVE T2,FLAGS FOR FIXUP TYPE
; MOVE W1,SYMBOL FLAGS
; MOVE W3,FIXUP VALUE
; PUSHJ P,SY.AS0
SY.AS1: TXNE T3,S.LST ;IF LAST TRIPLET
JRST SY.AS4 ;GIVE UP
SY.AS0::ADDI T1,.L ;GET NEXT TRIPLET
MOVE T3,(T1) ;GET FLAGS
JUMPL T3,SY.AS4 ;JUST INCASE
TXNN T3,S.PVS ;IS THIS THE ONE WE WANT
JRST SY.AS1 ;NO, TRY AGAIN
PUSHJ P,SY.AST ;FIXUP VALUE
TXNE W1,PS.UDF ;IF STILL UNDEFINED
JRST SY.AS4 ;GIVE UP
SOSGE USYM ;ONE LESS UNDEFINED THEN
PUSHJ P,E$$DUZ ;[1174] BUT NOT TOO FAR
MOVX T3,PS.REQ ;IF NOW FULLY DEFINED
ANDCAM T3,0(P1) ;CLEAR GLOBAL REQUEST FLAG IF SET
MOVE W3,2(T1) ;GET FIXUP VALUE (TEMP STORAGE ONLY)
PUSHJ P,SY.ZST ;ZAP PVS TRIPLET (T1 POINTS TO IT)
SY.FXP: EXCH W3,2(P1) ;GET VALUES RIGHT WAY ROUND
;AND FIXUP ALL REQUESTS
MOVE T2,W3 ;GET START OF CHAIN
DMOVE W2,1(P1) ;GET NAME AND VALUE OF SYMBOL
PUSHJ P,SY.CHR ;RIGHT-HALF CHAINED FIXUP
TXNN W1,PS.FXP ;ANY FIXUPS TO BE DONE?
SY.AS4: POPJ P, ;NO
PJRST SY.RF2 ;YES, DO ALL ADDITIVE FIXUPS
;HERE TO GET RID OF A SECONDARY TRIPLET IN THE GS AREA POINTED TO BY T1
SY.ZST: MOVE T3,0(T1) ;GET TRIPLET FLAGS
TXNN T3,S.LST ;LAST BLOCK?
PUSHJ P,SY.ZS1 ;NO, GIVE BACK THE MIDDLE FIRST
MOVEI T2,.L ;GIVE IT BACK
PUSH P,T1 ;SAVE ADDRESS
PUSHJ P,GS.RET##
POP P,T1 ;GET BACK POINTER
MOVE T3,-.L(T1) ;GET FLAGS
JUMPL T3,SY.ZS2 ;REACHED PRIMARY
MOVX T3,S.LST ;SET THIS IS LAST TRIPLET NOW
IORM T3,-.L(T1)
POPJ P, ;DONE
SY.ZS2: MOVX T3,PT.EXT!PS.FXP ;REMOVE EXTENDED FLAG
ANDCAM T3,-.L(T1) ;SINCE WE DON'T HAVE IT NOW
POPJ P, ;DONE
;HERE TO MOVE UP THE SECONDARY TRIPLETS
SY.ZS1: HRLZI T2,.L(T1) ;NEXT TRIPLET
HRRI T2,0(T1) ;THIS TRIPLET
ADDI T1,.L ;POINT TO NEXT
BLT T2,-1(T1) ;MOVE IT UP
SKIPG T2,0(T1) ;GET FLAGS
PUSHJ P,E$$ISP ;[1174]
TXNN T2,S.LST ;GOT THERE YET
JRST SY.ZS1 ;NO, TRY AGAIN
POPJ P,
;HERE TO FIXUP PARTIAL VALUE EITHER RH OR LH
;ENTER WITH
; T1 = PTR TO CURRENT EXTENDED TRIPLET
; T2 = FLAGS (WHICH HALF TO FIXUP)
; W3 = ADDITIVE VALUE
SY.AST::TXNE T2,FS.FXR ;RIGHT HALF?
JRST SY.ASR ;YES
TXNE T2,FS.FXL ;LEFT HALF?
JRST SY.ASL ;YES
TXNE T2,FS.FXE ;[2214] THIRTY BIT?
JRST SY.ASE ;[2214] YES
SY.ASF: MOVE T3,2(T1) ;GET CURRENT VALUE
ADD T3,W3 ;ADD, IGNORE CARRY
MOVEM T3,2(T1) ;STORE VALUE BACK
POPJ P,
SY.ASR: HRRZ T3,2(T1) ;GET CURRENT VALUE
ADDI T3,(W3) ;IGNORE CARRY
HRRM T3,2(T1) ;STORE VALUE IN RIGHT
POPJ P,
SY.ASL: HLRZ T3,2(T1) ;GET CURRENT VALUE
ADDI T3,(W3) ;IGNORE CARRY
HRLM T3,2(T1) ;STORE BACK
POPJ P,
SY.ASE: LDB T3,[ADDRESS 2(T1)] ;[2214] Get current value
ADD T3,W3 ;[2214] Add, ignore carry
DPB T3,[ADDRESS 2(T1)] ;[2214] Store back
POPJ P, ;[2214] Return
SUBTTL SYMBOL ROUTINES
;HERE TO MOVE A SYMBOL TO ANOTHER (LARGER) AREA
;GENERALLY TO ADD EXTENDED TRIPLETS
;CALLED BY
; MOVE T1,EXTRA REQUIRED
; MOVE P1,ABS LOC OF PRIMARY
; MOVE P2,REL OFFSET OF PRIMARY
; PUSHJ P,SY.MOV
;RETURNS
;P1 = NEW ABS ADDRESS
;T1 = LAST SYMBOL TRIPLET IN USE
SY.MOV::PUSH P,T1 ;SAVE EXTRA
PUSHJ P,SY.CHK ;SEE HOW MUCH WE ALREADY HAVE
EXCH T2,0(P) ;SWAP SO WE SAVE LENGTH
ADD T2,0(P) ;THIS IS HOW MUCH WE WANT
PUSHJ P,GS.GET## ;GET IT
HRRZ P1,@HT.PTR ;RESET P1(INCASE CORE MOVED)
ADD P1,NAMLOC ;FIX IN CORE
HRLZ T2,P1 ;MOVE FROM
HRR T2,T1 ; TO
MOVE T3,T1 ;UPTO
ADD T3,0(P) ;END
BLT T2,-1(T3)
EXCH P1,T1 ;SWAP
MOVE T2,0(P) ;FINISHED WITH OLD AREA
;UNLESS THERE ARE PARTIAL VALUE FIXUPS
MOVE T3,0(T1) ;GET FLAGS
TXNN T3,PT.EXT ;EXTENDED?
JRST SYMOV2 ;NO DON'T WASTE TIME
MOVE T3,T1 ;YES, MIGHT BE PARTIAL VALUES
SYMOV1: ADDI T3,.L ;ADVANCE TO NEXT SECONDARY
SKIPGE T4,0(T3) ;GET SECONDARY FLAGS
JRST SYMOV2 ;DONE
TXNE T4,S.PVS ;ONLY WANT PARTIAL VALUE
JRST SYMOV3 ;YES, MUST SAVE A POINTER TO NEW BLOCK
TXNN T4,S.LST ;IF LAST TRIPLET WE ARE FINISHED
JRST SYMOV1 ;NO TRY AGAIN
JRST SYMOV2 ;NOTHING WORTH SAVING HERE
;HERE WHEN PVS TRIPLET FOUND
SYMOV3: MOVX T4,PT.SGN!PT.OTH!PO.IND ;SET FLAGS
MOVEM T4,0(T1) ;IN MEMORY
MOVE T4,P1 ;GET NEW POINTER
SUB T4,NAMLOC ;MINUS OFFSET
MOVEM T4,2(T1) ;AS VALUE
ADDI T1,.L ;ADDVANCE
SUBI T2,.L
SYMOV2: PUSHJ P,GS.RET## ;SO GIVE IT BACK
MOVX T1,PT.EXT ;[612] TRIPLET IS NOW EXTENDED
IORM T1,0(P1) ;[612] SO MARK IT SO
MOVE T1,P1 ;ABS ADDRESS
SUB T1,NAMLOC ;MAKE REL
HRRM T1,@HT.PTR ;RESET POINTER
POP P,T2 ;GET LENGTH BACK
MOVE T1,P1
ADD T1,T2 ;POINT TO END
MOVX T3,S.LST ;IS NOT LAST NOW, SO REMOVE FLAG
SKIPL -.L(T1) ;BUT NOT IF PRIMARY
ANDCAM T3,-.L(T1)
POPJ P,
;HERE TO COUNT THE NUNBER OF TRIPLETS IN A SYMBOL
;ENTER WITH P1 = ADDRESS (ABS)
;RETURN T2 = LENGTH
;USES T1
;STOPS ON EITHER LAST TRIPLET (S.LST) OR NEXT PRIMARY (PT.SGN)
SY.CHK::SKIPGE T1,0(P1) ;SEE IF PRIMARY
TXNE T1,PT.EXT ;YES, BUT IS SYMBOL EXTENDED?
JRST SYCHK1 ;MUST COUNT EXTENDED
MOVEI T2,.L ;THE EASY WAY TO GET LENGTH
POPJ P, ;JUST RETURN
SYCHK1: HRRZ T2,P1 ;COPY STARTING ADDRESS
JUMPGE T1,SYCHK2 ;JUMP IF SECONDARY ON ENTRY
ADDI T2,.L ;GET FIRST SECONDARY
SYCHK2: SKIPGE T1,0(T2) ;MAKE SURE NOT PRIMARY
PUSHJ P,E$$ISP ;[1174] SHOULD NEVER HAPPEN
ADDI T2,.L ;ADVANCE PAST
TXNN T1,S.LST ;LAST TRIPLET?
JRST SYCHK2 ;NOT YET
SUBI T2,(P1) ;YES, GET LENGTH
POPJ P,
;HERE TO RETURN OLD SYMBOL AREA BACK TO POOL
;MAY BE ANY LENGTH (MULTIPLE OF .L)
;ENTER WITH P1 = ADDRESS OF SYMBOL IN CORE
;USES T1, T2
SY.RET::PUSHJ P,SY.CHK ;SEE HOW LONG IT IS
HRRZ T1,P1 ;GET START ADDRESS
SETZM @HT.PTR ;DELETE IN SYMBOL TABLE
PJRST GS.RET## ;RETURN IT
;HERE TO SETUP T2 TO POINT TO INCORE ADDRESS
;ENTER WITH T2 = RELATIVE ADDRESS
;SETS UP RHS OF R, LEAVES RELOC BITS IN LHS
;RETURNS
;+1 ADDRESS NOT IN CORE (PAGING ONLY)
; T2 UNAFFECTED, R CHANGED
;+2 ADDRESS IN CORE AND T2 POINTS TO IT
SEGCHK::
PUSH P,T2 ;[1132] SAVE USER VIRTUAL ADDRESS
HRRI R,2 ;ASSUME IN HIGH SEG
SKIPE LL.S2 ;[1132] MUST BE LOW IF ONLY ONE SEGMENT
CAMGE T2,LL.S2 ;[1132] BELOW BOTTOM OF HIGH SEGMENT?
SOJA R,SEGCK2 ;[1132] IN LOW SEGMENT
SUB T2,LL.S2 ;[1132] FORM OFFSET INTO HIGH SEGMENT
CAMGE T2,HL.S2 ;[1132] BEFORE END OF HIGH SEGMENT?
JRST SEGCK4 ;[1132] YES, IN HIGH SEGMENT
MOVE T2,0(P) ;[1132] RESTORE ADDRESS (OFFSET INTO LOW SEG)
HRRI R,1 ;[1132] SET R TO LOW SEGMENT
SEGCK2: ;[1132] HERE IF T2 AND R POINT TO LOW SEG
IFN FTOVERLAY,<
SUB T2,PH+PH.ADD ;[1400] OFFSET INTO LC IF NOT ROOT LINK
> ;END IFN FTOVERLAY
SEGCK4: SKIPN PAG.S0(R) ;[1132] IS THIS AREA PAGING?
JRST SEGCK6 ;[1132] NO, ADDR CAN'T BE ON DISK
CAML T2,LW.S0(R) ;[632] IS ADDRESS IN CORE?
CAMLE T2,UW.S0(R) ;[632] MAYBE, IS IT?
JRST [POP P,T2 ;[1132] NOT IN CORE, RESTORE CALLER'S T2
POPJ P,] ;[1132] RETURN TO CALLER
;HERE IF ADDRESS IS DEFINITELY IN CORE.
SEGCK6: EXCH T2,0(P) ;[1132] GET PHYSICAL ADDRESS FOR .JDDT
.JDDT LNKLOD,SEGCK6,<<CAMN T2,$LOCATION>> ;[1132]
POP P,T2 ;[1132] RESTORE OFFSET INTO SEGMENT
SUB T2,LW.S0(R) ;[632] RELATIVE TO IN-CORE PART OF AREA
HRR R,@SG.TB ;[632] FIND APPROPRIATE RC BLOCK
ADD T2,@RC.LB(R) ;[632] MAKE PHYSICAL LOAD-TIME ADDRESS
JRST CPOPJ1 ;[632] SUCCESS RETURN TO USER
;HERE TO PUT REQUEST IN GLOBAL SYMBOL TABLE
;ENTER WITH
;W1 = SECONDARY TRIPLET FLAGS
;W2 = SYMBOL NAME
;W3 = FIXUP VALUE (NOT USED)
;+0(P) = RETURN ADDRESS
;-1(P) = VALUE OF PRIMARY TRIPLET
;-2(P) = FLAGS FOR PRIMARY TRIPLET
;
;NOTE, REMOVES 3 ITEMS FROM STACK
GS.FX0::MOVEI T2,2*.L ;NEED EXTENDED SYMBOL
PUSHJ P,GS.GET## ;GET SPACE FOR SYMBOL
TXO W1,S.LST ;SIGNAL AS LAST TRIPLET
TMOVEM W1,.L(T1) ;STORE SECONDARY TRIPLET FLAGS, NAME, VALUE
MOVE W1,-2(P) ;GET PRIMARY FLAGS
TXO W1,PS.FXP!PT.EXT ;MARK ADDITIVE REQUESTS IN FIXUP TABLE
MOVE W3,-1(P) ;GET VALUE FROM STACK
TMOVEM W1,0(T1) ;STORE FLAGS, NAME, VALUE
MOVE W3,T1 ;POINT TO INCORE BLOCK
SUB W3,NAMLOC ;INCASE IT MOVES
PUSH P,W3 ;SAVE VALUE INCASE CORE MOVES
PUSHJ P,INSRT ;PUT IN GLOBAL TABLE
POP P,W3 ;GET ADDRESS BACK (RELATIVE TO GX.LB)
POP P,T2 ;GET RETURN ADDRESS
SUB P,[2,,2] ;REMOVE JUNK FROM STACK
JRSTF @T2 ;AND RETURN
;HERE TO LINK FIXUP TRIPLET TO CURRENT GLOBAL TRIPLET
;ENTER WITH FIXUP ADDRESS (RELATIVE TO FX.LB)
;IN W3 (SET BY SY.FX0)
;AND GLOBAL ADDRESS (RELATIVE TO GX.LB)
;IN P2
;NOTE BOTH TABLES MAY MOVE
SY.GX0::HRRZ T1,@HT.PTR ;FIND OUT WHERE GLOBAL TRIPLET
ADD T1,NAMLOC ;IS IN CORE
HRRZM W3,.L+2(T1) ;FIXUP POINTER TO FIXUP LIST
POPJ P,
;HERE TO PUT SYMBOL INTO FIXUP TABLE
;ENTER WITH
;W1 = FLAGS
;W2 = SYMBOL
;W3 = VALUE
;RETURN WITH
;W3 = POINTER TO LOCATION RELATIVE TO FX.LB
SY.FX0::MOVEI T2,.L ;SPACE IN 3 WORD CHUNKS
PUSHJ P,FX.GET## ;SPECIAL SPACE GETTER
TMOVEM W1,0(T1) ;STORE FIXUP REQUEST
MOVE W3,T1 ;PUT ADDRESS IN W3
SUB W3,FX.LB ;MAKE IT RELATIVE TO ORIGIN
.JDDT LNKLOD,SY.FX0,<<CAMN W3,$FIXUP##>> ;[632]
POPJ P, ;RETURN
;HERE TO SEE IF SYMBOL REQUESTED FOR SYMBOL TABLE FIXUP WAS LAST
;SYMBOL DEFINED (NOT FULLY DEFINED OF COURSE)
;CALLED BY
; MOVE W3,SYMBOL
; PUSHJ P,SY.RLS
;RETURNS
;+1 NOT LAST SYMBOL DEFINED
;+2 LAST SYMBOL DEFINED
;T1= ADDRESS OF SYMBOL IN LOCAL TABLE
;T2= ADDRESS OF SYMBOL IN GLOBAL TABLE
SY.RLS::MOVE T1,LSTLCL ;[2255] GET LOCAL ADDRESS
JUMPE T1,.+3 ;LEAVE ZERO ALONE
ADD T1,LS.LB ;RELOCATE
SUB T1,LW.LS ;BUT REMOVE WINDOW BASE
MOVE T2,LSTGBL ;[2255] AND GLOBAL
SKIPE T2
ADD T2,NAMLOC ;RELOCATE
TLNN W3,770000 ;[2216] LONG SYMBOL?
JRST SY.RLL ;[2216] YES
JUMPE T1,[JUMPE T2,SYRLSZ ;[1165] NO LOCALS, TRY GLOBAL
CAME W3,1(T2) ;IF IN GLOBAL TABLE
JRST SYRLSZ ;[1165] NO MATCH
JRST CPOPJ1] ;[2255] GOT IT HERE
CAME W3,1(T1) ;SAME?
JRST SYRLSZ ;[1165] NO
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
;[2216] Here to handle long symbols
SY.RLL: JUMPE T2,SYRLL3 ;[2216] Check for local
SPUSH <T1,T2,P1,P2> ;[2216] Global, save accs for compare
HLRZ T4,W3 ;[2216] Get the count
HRRZ P1,W3 ;[2216] And the address
HRLI P1,(POINT 36) ;[2216] Build a byte pointer
MOVE T2,1(T2) ;[2216] Get the count,,pointer for the global
TLNE T2,770000 ;[2216] A short symbol?
JRST [MOVEI T2,W3 ;[2216] Yes, point at symbol
MOVEI T1,1 ;[2216] Only one word long
JRST SYRLL0] ;[2216] Go compare it
HLRZ T1,T2 ;[2216] Get the count
ADD T2,GS.LB ;[2216] Relocate it
SYRLL0: HRLI T2,(POINT 36) ;[2216] Make a byte pointer
EXTEND T1,[CMPSE ;[2216] Compare the strings
0
0]
JRST SYRLL2 ;[2216] Not the same
SYRLL1: SPOP <P2,P1,T2,T1> ;[2216] A match, restore accs
JRST CPOPJ1 ;[2255] and return success
SYRLL2: SPOP <P2,P1,T2,T1> ;[2216] Not the same, restore accs
SYRLSZ: SETZM LSTGBL ;[2255] DON'T CONFUSE SYMBOLS DOWN THE PIKE
SETZM LSTLCL ;[2255] EITHER LOCAL OR GLOBAL
POPJ P, ;[1165]
;[2216] Here to handle long local symbols
SYRLL3: SPUSH <T1,T2,P1,P2> ;[2216] Save some accs
HLRZ P1,W3 ;[2216] Get the count
HRRZ P2,W3 ;[2216] And the address of the symbol
MOVE T2,(P2) ;[2216] Get the first six characters
CAME T2,1(T1) ;[2216] Same?
JRST SYRLL2 ;[2216] No, not a match
SOJLE P1,[MOVE T2,(T1) ;[2216] One word symbol? Get the flags
TXNN T2,PS.EXO ;[2216] Extended?
JRST SYRLL1 ;[2216] No, it's a match
JRST SYRLL2] ;[2216] Different size, not a match
;[2216] Here for each secondary triplet
SYRLL4: ADDI T1,.L ;[2216] Point to next triplet
ADDI P2,2 ;[2216] Point to next two symbol words
MOVE T2,-1(P2) ;[2216] Get the next symbol word
CAME T2,1(T1) ;[2216] Same?
JRST SYRLL2 ;[2216] No, not a match
SOJE P1,[SKIPN 2(T1) ;[2216] If end of symbol, check extra word
JRST SYRLL1 ;[2216] Null word, it's a match
JRST SYRLL2] ;[2216] Different size, not a match
MOVE T2,(P2) ;[2216] Get the next symbol word
CAME T2,2(T1) ;[2216] Same?
JRST SYRLL2 ;[2216] No, not a match
SOJG P1,SYRLL4 ;[2216] Still OK, last one?
MOVE T2,(T1) ;[2216] Get the bits
TXNN T2,S.LST ;[2216] Last secondary?
JRST SYRLL1 ;[2216] Yes, it's a match
JRST SYRLL2 ;[2216] Different size, not a match
SUBTTL ADD SECONDARY TYPECHECKING BLOCK
SY.TYP::
IFN FTOVERLAY,< ;[2053]
SKIPN OVERLW ;[2053] Overlayed program?
JRST SYTYP ;[2053] No, don't worry about BG area
MOVE T3,ABCNT(W3) ;[2053] Compute ptr to flag word
IDIVI T3,5 ;[2053] Byte count to word count
SKIPE T4 ;[2053] If not exact fit
AOS T3 ;[2053] Count extra in next word
ADDI T3,ABNAM(W3) ;[2053] T3 Points to flag word
MOVE T3,(T3) ;[2053] Flags
TXNN T3,TPWHO ;[2053] Caller?
PUSHJ P,TYP.BG## ;[2053] Callee, typecheck the bound globals
; JRST SYTYP ;[2053] Check the current overlay
>;[2053] IFN FTOVERLAY
SYTYP:: MOVX W1,PT.SGN ;[2053] SET UP TYPECHECK BLOCKS IN GS
SKIPN R2,PAG.TP ;[2342] REMEMBER IF TP AREA PAGING
SUB W3,TP.LB ;[2270] NOT PAGING, RELOCATE POINTER
PUSHJ P,TRYSYM## ;[1405] SEE IF IN TABLE
JRST SY.TY0 ;[1405] NO, PUT IN
JRST SY.TY1 ;[1405] ALREADY IN UNDEF TABLE
JRST SY.TY1 ;[1405] STORE NEW BLOCK EVEN IF
;[1405] CALLEE IS KNOWN
SY.TY0: SKIPN PAG.TP ;[2270] PAGING?
ADD W3,TP.LB ;[2270] NO, UNRELOCATE
SKIPE PAG.TP ;[2270] PAGING?
SKIPE R2 ;[2342] AND JUST STARTED PAGING?
CAIA ;[2270] NO, IT'S OK
PUSHJ P,TPTODY ;[2270] JUST STARTED PAGING - PUT BLOCK IN DY
IFN FTOVERLAY,< ;[2053]
SKIPE ARGOVL ;[2053] Argchecking the BG area?
POPJ P, ;[2053] Yes, don't put it in
>;[2053] IFN FTOVERLAY
;[1405] HERE TO PUT UNKNOWN SYMBOL'S ARGBLK DATA PTR IN GLOBAL TABLE
;[1405] USE EXTENDED BLOCK TO HOLD POINTER
AOS USYM ;[1405] COUNT FUNCT NAME AS UNDEFINED
MOVEI T2,.L*2 ;[1405] NEED TWO BLOCKS TO HOLD
SKIPN PAG.TP ;[2405] TP PAGING?
SUB W3,TP.LB ;[2405] NO MAKE ADDRESS RELATIVE
PUSHJ P,GS.GET## ;[1405] PARTIAL DEFINITION AND ARGBLK DATA
SKIPN PAG.TP ;[2405] TP PAGING?
ADD W3,TP.LB ;[2405] ADD LOWER BOUND - MAKE ABSOLUTE
SKIPE PAG.TP ;[2405] PAGING?
SKIPE R2 ;[2405] AND JUST STARTED PAGING?
CAIA ;[2405] NO, IT'S OK
PUSHJ P,TPTODY ;[2405] JUST STARTED PAGING - PUT BLOCK IN DY
TXO W1,PT.EXT!PS.REQ!PT.SYM
;[1476] MARK AS USING EXTENDED TRIPLET
DMOVEM W1,0(T1) ;[1405] PRIMARY FLAGS & SYMBOL
SETZM 2(T1) ;[1405] NO REQUESTS YET
PUSH P,W2 ;[2270] SAVE THE NAME
PUSHJ P,SYTY0A ;[2020] BUILD THE SECONDARY TRIPLET
POP P,W2 ;[2270] RESTORE THE NAME (INSRT WANTS IT)
MOVE W3,T1 ;[2020] FOR EXTENDED SYMBOLS
SUB W3,NAMLOC ;[2020] W3 CONTAINS POINTER TO EXTENDED TRIPLET
PUSHJ P,INSRT ;[2020] PUT IN GLOBAL TABLE
POPJ P, ;[2020] DONE
SYTY0A: MOVX T2,S.LST!S.OTH ;[2020] TYPECHECK MARKER
MOVE T3,ABCNT(W3) ;[1474] COMPUTE PTR TO FLAG WORD
IDIVI T3,5 ;[1474] BYTE COUNT TO WORD COUNT
SKIPE T4 ;[1474] IF NOT EXACT FIT
AOS T3 ;[1474] COUNT EXTRA IN NEXT WORD
ADDI T3,ABNAM(W3) ;[1474] T3 POINTS TO FLAG WORD
MOVE T3,(T3) ;[1474] FLAGS,,COUNT
PUSHJ P,TP.REL ;[2270] RELOCATE (AND PUT IN TP AREA IF IN DY)
SETZ W2, ;[2270] CLEAR END OF CHAIN POINTER
TXNE T3,TPWHO ;[1474] CALLER?
MOVE W2,W3 ;[2270] YES, POINT TO END OF CHAIN
MOVEM T2,.L+0(T1) ;[1405] SECONDARY FLAGS
DMOVEM W2,.L+1(T1) ;[1405] SYMBOL AGAIN (MAY AS WELL) & PTR
POPJ P, ;[1702] AND RETURN
;[1405] Here if "partially defined" symbol is already present.
;[2020] Look for secondary triplet for typechecking.
SY.TY1:
SKIPN PAG.TP ;[2270] PAGING?
ADD W3,TP.LB ;[2270] NO, UNRELOCATE
SKIPE PAG.TP ;[2270] PAGING?
SKIPE R2 ;[2342] AND JUST STARTED PAGING?
CAIA ;[2270] NO, IT'S OK
PUSHJ P,TPTODY ;[2270] JUST STARTED PAGING - PUT BLOCK IN DY
MOVE T1,(P1) ;[2020] GET PRIMARY FLAGS
TXNN T1,PT.EXT ;[2020] EXTENDED?
JRST SYTY1N ;[2020] NO, NO TYPECHECKING SECONDARY
MOVEI T2,(P1) ;[2020] POINT TO THE FIRST TRIPLET
SYTY1A: ADDI T2,.L ;[2020] ADVANCE TO NEXT TRIPLET
MOVE T1,(T2) ;[2020] GET THE FLAGS
TXNE T1,S.OTH ;[2020] TYPECHECKING?
JRST SYTY1B ;[2020] YES, FOUND IT
TXNN T1,S.LST ;[2045] LAST ONE?
JRST SYTY1A ;[2020] NO, TRY ANOTHER
SYTY1N: ;[2053]
IFN FTOVERLAY,< ;[2053]
SKIPE ARGOVL ;[2053] Typechecking the BG area?
POPJ P, ;[2053] Yes, don't put it in
>;[2053] IFN FTOVERLAY
MOVEI T1,.L ;[2053] NO TYPCHECKING YET, NEED EXTRA TRIPLET
SKIPN PAG.TP ;[2405] TP PAGING?
SUB W3,TP.LB ;[2405] NO MAKE ADDRESS RELATIVE
PUSHJ P,SY.MOV ;[1405] MOVE WHAT WE HAVE
PUSH P,T1 ;[2405] SAVE T1
SKIPN PAG.TP ;[2405] TP PAGING?
ADD W3,TP.LB ;[2405] ADD LOWER BOUND - MAKE ABSOLUTE
SKIPE PAG.TP ;[2405] PAGING?
SKIPE R2 ;[2405] AND JUST STARTED PAGING?
CAIA ;[2405] NO, IT'S OK
PUSHJ P,TPTODY ;[2405] JUST STARTED PAGING - PUT BLOCK IN DY
POP P,T1 ;[2405] RESTORE T1
SUBI T1,.L ;[2045] GET POINTER TO PREVIOUS TRIPLET
JRST SYTY0A ;[2020] FILL IN NEW SECONDARY
SYTY1B: MOVEI W1,(T2) ;[2270] SAVE TYPECHECKING POINTER
MOVE T3,ABCNT(W3) ;[2020] COMPUTE PTR TO FLAG WORD
IDIVI T3,5 ;[1474] BYTE COUNT TO WORD COUNT
SKIPE T4 ;[1474] IF NOT EXACT FIT
AOS T3 ;[1474] COUNT EXTRA IN NEXT WORD
MOVE R,T3 ;[1474] REMEMBER THIS OFFSET
ADDI T3,ABNAM(W3) ;[1474] T3 POINTS TO FLAG WORD
MOVE T2,1(W1) ;[2020] GET POINTER TO END OF LIST
MOVE T3,(T3) ;[1474] FLAGS,,COUNT
; W1 Points To the header word in the argument checking secondary [2270]
; triplet. The second word of the triplet contains either 0 if [2270]
; the callee has been seen, or the address of the last caller if no [2270]
; callee has been seen. The third word of the triplet contains the [2270]
; address of the first caller or the address of the callee. [2270]
; W3 Points to the new block. [2020]
; T3 contains the flags for the new block. [2020]
; R contains the number of words in the name. [2005]
; must not be touched, TMATCH looks at it. [2005]
TXNN T3,TPWHO ;[1474] CALLER?
JRST SYTY1D ;[2020] NO, THIS IS CALLEE
JUMPE T2,SYTY1P ;[2020] CHECK FOR CALLER AND CALLEE
;Here if have caller and callee has not been seen. Link it at end of list.
ADD T2,TP.LB ;[2270] UNRELOCATE
SKIPE PAG.TP ;[2270] PAGING?
JRST SYTY1W ;[2270] YES, LINK IN FRONT OF LIST
SUB W3,TP.LB ;[2270] RELOCATE
MOVEM W3,ABLNK(T2) ;[2020] ADD TO END OF LIST
MOVEM W3,1(W1) ;[2270] REMEMBER NEW LIST END
POPJ P, ;[2020] DONE
;[2270] Here if paging the TP area. Move the block into the TP
;[2270] area and link it to the front of the list. Linking it
;[2270] to the end of the list is preferred, but would involve
;[2270] doing a fixup to the linked list.
SYTY1W: PUSHJ P,TP.REL ;[2270] MOVE IT INTO THE DY AREA
MOVE T1,2(W1) ;[2270] GET POINTER TO BEGINNING OF LIST
MOVEM W3,2(W1) ;[2270] PUT THE POINTER IN THE FRONT
SUB W3,LW.TP ;[2270] SUBTRACT THE WINDOW BOUND
ADD W3,TP.LB ;[2270] UNRELOCATE IT
MOVEM T1,ABLNK(W3) ;[2270] STORE THE OLD FIRST IN THE LINK WORD
POPJ P, ;[2270] DONE
;Here if have caller and callee has been seen. Typecheck it and toss it.
SYTY1P: PUSH P,W3 ;[2020] SAVE POINTER TO CALLER
MOVE P1,W3 ;[2020] GET THE CALLER ARG BLOCK
MOVE P2,2(W1) ;[2270] GET THE CALLEE ARG BLOCK
SKIPN PAG.TP ;[2270] PAGING?
JRST SYTY1R ;[2270] NO, IT'S IN MEMORY
MOVE T1,P2 ;[2270] GET THE ADDRESS
MOVE T2,ABSIZ(P1) ;[2270] AND THE SIZE (FROM THE CALLER)
PUSHJ P,PG.TP ;[2270] MAKE SURE IT'S IN MEMORY
MOVE T2,ABSIZ(T1) ;[2270] GET THE ACTUAL SIZE
CAMG T2,ABSIZ(P1) ;[2270] BIGGER THAN EXPECTED?
JRST SYTY1Q ;[2270] NO, IT'S IN MEMORY
MOVE T1,P2 ;[2270] GET THE ADDRESS AGAIN
PUSHJ P,PG.TP ;[2270] AND ASK FOR THE BIGGER BLOCK
SYTY1Q: SKIPA P2,T1 ;[2270] GET THE UNRELOCATED POINTER
SYTY1R: ADD P2,TP.LB ;[2270] UNRELOCATE
PUSHJ P,TMATCH ;[2020] ARG CHECK IT
POP P,T1 ;[2020] GET POINTER TO BLOCK
MOVE T2,ABSIZ(T1) ;[2270] AND IT'S SIZE
JRST SYTY1C ;[2046] RETURN BLOCK
;Here if have callee and callee has not been seen. Typecheck all callers.
SYTY1D: JUMPE T2,SYTY1I ;[2020] CHECK FOR ANOTHER CALLER
MOVE P2,W3 ;[2270] GET POINTER TO CALLEE
MOVE P1,2(W1) ;[2270] GET POINTER TO FIRST CALLER
SUB W1,GS.LB ;[2342] RELOCATE IN CASE GS AREA MOVES
PUSH P,W1 ;[2342] SAVE SYMBOL POINTER
SYTY1L: SKIPN PAG.TP ;[2270] PAGING?
JRST SYTY1E ;[2270] NO, IT'S IN MEMORY
MOVE T1,P1 ;[2270] GET THE ADDRESS
MOVE T2,ABSIZ(P2) ;[2270] AND THE SIZE (FROM THE CALLEE)
PUSHJ P,PG.TP ;[2270] MAKE SURE IT'S IN MEMORY
MOVE T2,ABSIZ(T1) ;[2270] GET THE ACTUAL SIZE
CAMG T2,ABSIZ(P2) ;[2270] BIGGER THAN EXPECTED?
JRST SYTY1F ;[2270] NO, IT'S IN MEMORY
MOVE T1,P1 ;[2270] GET THE ADDRESS AGAIN
PUSHJ P,PG.TP ;[2270] AND ASK FOR THE BIGGER BLOCK
SYTY1F: SKIPA P1,T1 ;[2270] GET THE UNRELOCATED POINTER
SYTY1E: ADD P1,TP.LB ;[2270] UNRELOCATE
SPUSH <R,P1,P2> ;[2270] SAVE THE ACS FOR TYPECHECKING
PUSHJ P,TMATCH ;[2020] ARGCHECK THIS ONE
SPOP <P2,P1,R> ;[2020] RESTORE THE REGISTERS
HRRZ T1,P1 ;[2020] GET ADDRESS OF CALLER BLOCK
MOVE T2,ABSIZ(P1) ;[2270] GET THE SIZE OF THE BLOCK
MOVE P1,ABLNK(P1) ;[2270] GET POINTER TO NEXT BLOCK
AOS TPGCNT ;[2270] COUNT FOR GARBAGE COLLECTION
SKIPN PAG.TP ;[2270] PAGING?
PUSHJ P,TP.RET## ;[2270] NO, TOSS THE BLOCK
JUMPN P1,SYTY1L ;[2020] ARGUMENT CHECK ALL OF THEM
MOVE W3,P2 ;[2270] GET BACK THE CALLEE BLOCK IN W3
;**; insert at SYTY1E + 12 edit 2374
PUSH P,P2 ;[2374] SAVE P2
PUSHJ P,TP.REL ;[2270] RELOCATE THE POINTER, PUT IN TP
POP P,P2 ;[2374] RESTORE P2
POP P,W1 ;[2270] GET BACK GLOBAL SYMBOL POINTER
ADD W1,GS.LB ;[2342] ADD AREA BASE
MOVEM W3,2(W1) ;[2270] FROM NOW ON, THE CALLER IS KNOWN
SETZM 1(W1) ;[2270] REMEMBER IT
;**; insert at SYTY1E + 18 edit 3274
MOVE W3,P2 ;[2374] CALLEE BLOCK TO W3
JRST SYTY1G ;[2046] DONE, CHECK FOR GARBAGE COLLECT
;Here if have callee and callee has been seen. Toss the new block.
SYTY1I: MOVE T1,W3 ;[2020] GET POINTER TO SECOND CALLEE BLOCK
MOVE T2,ABSIZ(T1) ;[2270] GET SIZE OF NEW BLOCK
;[2046] Here to return a block, and to garbage collect if not done recently.
SYTY1C: AOS TPGCNT ;[2270] COUNT THE BLOCK
SKIPN PAG.TP ;[2270] PAGING?
PUSHJ P,TP.RET## ;[2270] NO, REMOVE IT FROM TP AREA
SKIPE PAG.TP ;[2270] PAGING?
PUSHJ P,DY.RET## ;[2270] YES, REMOVE IT FROM DY AREA
SYTY1G: MOVE T1,TPGCNT ;[2270] GET THE COUNT OF RETURNED BLOCKS
CAIGE T1,TP.MRB ;[2270] CHECK FOR LOTS OF THEM
POPJ P, ;[2046] NOT TOO MANY
SETZM TPGCNT ;[2270] LOTS, RESET COUNTER
SKIPN PAG.TP ;[2270] PAGING?
PJRST TP.GBC## ;[2270] NO, GARBAGE COLLECT TP AREA
PJRST DY.GBC## ;[2270] YES, GARBAGE COLLECT DY AREA
;[2270] Here to relocate the address in W3. If the block is in the
;[2270] DY area, put it in the TP area.
;[2270] W3 contains the pointer.
TP.REL: SKIPE PAG.TP ;[2270] Paging?
JRST TPREL1 ;[2270] Yes, must move to TP area
SUB W3,TP.LB ;[2270] No, relocate
POPJ P, ;[2270] Done
TPREL1: SPUSH <T1,T2,T3> ;[2270] Get some acs
PUSHJ P,DYTOTP ;[2270] Copy the block
;**; Insert AT TPREL1 + 2 edit 2374
SKIPN ARGOVL ;[2374] Typchecking the BG area ?
PUSHJ P,DY.RET## ;[2270] Give back the DY block
SPOP <T3,T2,T1> ;[2270] Restore the acs
POPJ P, ;[2270] Done
;[2270] Here to move the block from the DY area to the TP area.
;[2342] W3 contains the address in the TP area.
;[2270] Returns W3 as address of the block in the TP area.
;[2270] T1 as address of the block in the DY area.
;[2270] T2 as the length of the block.
DYTOTP: MOVE T1,TPPTR ;[2374] Get the "first free" in the TP area
PUSH P,TPPTR ;[2374] Remember where the block starts
MOVE T2,ABSIZ(W3) ;[2270] Get the size in T2
PUSHJ P,PG.TP ;[2270] Get the block in the window
MOVE T2,ABSIZ(W3) ;[2270] Restore the size in T2
ADDM T2,TPPTR ;[2374] Bump the "first free" pointer
ADDI T2,-1(T1) ;[2270] Last address to copy to
HRL T1,W3 ;[2270] Get the DY address
BLT T1,(T2) ;[2270] Copy the block inot the TP area
MOVE T1,W3 ;[2270] Get the address
MOVE T2,ABSIZ(W3) ;[2270] And the size
POP P,W3 ;[2270] Get the TP address of the block
POPJ P, ;[2270] Done
;[2270] Here to move the block from the TP area to the DY area.
;[2270] W3 contains the address in the DY area.
;[2270] Returns W3 as address of the block in the DY area.
TPTODY: MOVE T1,W3 ;[2270] Get the TP address
MOVEI T2,ABOVH ;[2270] Need the overhead words
PUSHJ P,PG.TP ;[2270] Get the block in the window
MOVE T2,ABSIZ(T1) ;[2270] Get the actual size
PUSHJ P,DY.GET## ;[2270] Get a block of DY memory
EXCH T1,W3 ;[2270] TP Address in T1, DY in W3
PUSHJ P,PG.TP ;[2270] Get whole block in window
MOVE T2,ABSIZ(T1) ;[2270] Get back the size
HRL T1,W3 ;[2270] Get DY,,TP address
MOVSS T1 ;[2270] Make it source,,dest
ADDI T2,-1(W3) ;[2270] Last address to copy to
BLT T1,(T2) ;[2270] Copy the data
POPJ P, ;[2270] Done
;[2270] Here to get an argument typechecking block in memory.
;[2270] This routine will not expand the TP area beyond TP.UB
;[2270] Unless absolutely necessary.
;[2270] T1 contains the address.
;[2270] T2 contains the block size.
;[2270] Return T1 as in-memory address of block.
;[2270] Uses T1,T2,T3
PG.TP: ADD T2,T1 ;[2270] Add the origin and the size
SUBI T2,1 ;[2270] Minus one is end of block
CAMGE T1,LW.TP ;[2270] Bottom within window?
JRST PG.TPM ;[2270] No, must rewindow
CAMG T2,UW.TP ;[2270] Top within window?
JRST PG.TPZ ;[2270] Yes, unrelocate and exit
;[2270] Here to see if expanding the window with LNKCOR will keep it
;[2270] within TP.UB. If not, don't bother expanding, just move it.
MOVE T3,T2 ;[2270] Get the upper bound
SUB T3,LW.TP ;[2270] Minus the window
ADD T3,TP.LB ;[2270] Where it would be in memory
CAMG T3,TP.UB ;[2270] Can it expand easily?
JRST PG.TPU ;[2270] Yes, expand the window
;[2270] Must move the window. Unmap it and remap within what's
;[2270] available. If the window is too small, call LNKCOR to
;[2270] expand it.
PG.TPM: PUSH P,T2 ;[2270] Save the upper address
PUSH P,T1 ;[2270] And the lower address
MOVE T1,LW.TP ;[2270] Get the window bottom
MOVE T2,UW.TP ;[2270] And the top
PUSHJ P,TP.OUT## ;[2270] Write it
MOVE T1,(P) ;[2270] Recover the lower bound
TRZ T1,.IPM ;[2270] Put it on a page bound
MOVE T2,TP.AB ;[2270] Get the upper bound
SUB T2,TP.LB ;[2270] Minus the lower is size
ADD T2,T1 ;[2270] Lower plus size is upper bound
MOVEM T1,LW.TP ;[2270] Store new lower window
MOVEM T2,UW.TP ;[2270] And upper window
PUSHJ P,TP.IN## ;[2270] Bring it into memory
POP P,T1 ;[2270] Get the pointer
POP P,T2 ;[2270] And the top
MOVE T3,T2 ;[2270] Get the upper bound
SUB T3,LW.TP ;[2270] Minus the window
ADD T3,TP.LB ;[2270] Where it would be in memory
CAMG T3,TP.AB ;[2270] Does it fit?
JRST PG.TPZ ;[2270] Yes, unrelocate and exit
PG.TPU: SUB T3,TP.AB ;[2270] How much is necessary
SPUSH <T1,P1,P2> ;[2270] Save the pointer and some ACs
MOVEI P1,TP.IX ;[2270] Want memory in the TP area
MOVE P2,T3 ;[2270] Get the size
PUSHJ P,LNKCOR## ;[2270] Get the memory
PUSHJ P,E$$MEF## ;[2270] No memory available
MOVE T1,UW.TP ;[2422] GET OLD UPPER WINDOW
AOJ T1, ;[2422] START READING EXTRA STUFF FROM HERE
MOVE T2,TP.AB ;[2422] NEW ALLOCATED TOP
SUB T2,TP.LB ;[2422] LENGTH OF NEW WINDOW IN CORE
ADD T2,LW.TP ;[2422] +LOWER WINDOW = NEW UPPER WINDOW
MOVEM T2,UW.TP ;[2422] STORE IT
PUSHJ P,TP.IN## ;[2422] READ INTO EXPANDED WINDOW
SPOP <P2,P1,T1> ;[2270] Restore the acs and pointer
PG.TPZ: SUB T1,LW.TP ;[2270] Remove the window base
ADD T1,TP.LB ;[2270] Add the area base
POPJ P, ;[2270] Done
; COMPLAIN ABOUT ARG COUNT MISMATCHES.
; THEN FEED THE INDIVIDUAL ENTRIES TO ARGSCN.
; IF THERE ARE 2NDARY DESCRIPTORS FOR AN INDIVIDUAL ENTRY NOTE ANY
; DISAGREEMENTS THERE.
TMATCH:
MOVE P3,P1 ;[1476] REMEMBER THE CALLER'S ENTIRE ARGBLK
MOVE R2,ABMOD(P1) ;[2005] GET CALLERS NAME FOR ERRORS
ADDI P1,ABNAM(R) ;[1476] GO STRAIGHT TO THE ARG DESCRIPTORS
ADDI P2,ABNAM(R) ;[1476]
MOVE T1,(P1) ;[2005] FLAGS,,CALLER COUNT
MOVNI T2,(T1) ;[2005] MINUS CALLER COUNT
TXNN T1,TPVAL ;[2005] IS IT A FUNCTION
SUBI T2,1 ;[2005] NO, COUNT LAST ARGUMENT
HRRZ W1,P1 ;[2005] TEMP PTR FOR CALLER LIST
HRL W1,T2 ;[2005] AS AN AOBJN POINTER
MOVE T1,(P2) ;[2005] FLAGS,,CALLEE COUNT
MOVNI T2,(T1) ;[2005] MINUS CALLEE COUNT
TXNN T1,TPVAL ;[2005] IS IT A FUNCTION
SUBI T2,1 ;[2005] NO, COUNT LAST ARGUMENT
HRRZ W3,P2 ;[2005] TEMP PTR FOR CALLEE LIST
HRL W3,T2 ;[2005] AS AN AOBJN POINTER
SETZM P4 ;[1476]
TMTCH1: AOBJP W1,TMTCH2 ;[2005] BUMP POINTER, SEE IF DONE
MOVE T1,(W1) ;[1476] PICK UP ARG DESC
TXNE T1,TPIAD ;[2005] IS IT INTRINSIC?
JRST [LDB T1,[TPSND(W1)] ;[2005] GET NUMBER OF SECONDARYS
ADD W1,T1 ;[2005] ACCOUNT FOR THEM
JRST TMTCH1] ;[2005] TRY FOR ANOTHER PRIMARY
TMTCH2: AOBJP W3,TMTCH3 ;[2005] BUMP POINTER, SEE IF DONE
MOVE T2,(W3) ;[2005] PICK UP ARG DESC
TXNE T2,TPIAD ;[2005] IS IT INTRINSIC?
JRST [LDB T2,[TPSND(W3)] ;[2005] GET NUMBER OF SECONDARYS
ADD W3,T2 ;[2005] ACCOUNT FOR THEM
JRST TMTCH2] ;[2005] TRY FOR ANOTHER PRIMARY
JUMPGE W1,TMTCH3 ;[2005] CHECK FOR DONE
ADDI P4,1 ;[2005] COUNT ANOTHER ARGUMENT
PUSHJ P,ARGSCN ;[1476]
JRST TMTCH1 ;[1476] AND DO IT AGAIN
TMTCH3: HLRZ T1,W1 ;[2005] GET THE CALLER ARG COUNT
HLRZ T2,W3 ;[2005] AND THE FUNCTION ARG COUNT
MOVE P4,(P1) ;[2005] GET THE FLAGS
TXNE P4,TPCNT ;[2005] COMPLAIN ABOUT DIFFERENT COUNTS?
CAMN T1,T2 ;[2005] YES, ARE THEY DIFFERENT?
SKIPA ;[2005] NO
PUSHJ P,ARGCNE ;[2005] YES, ERROR
TMTC3A: MOVE T1,(P1) ;[2005] GET THE FLAG WORDS
MOVE T2,(P2) ;[2005] FOR BOTH LISTS
TXNE T1,TPVAL ;[2005] IS CALLER A FUNCTION?
TXNN T2,TPVAL ;[2005] AND CALLEE TOO?
JRST TMTCH8 ;[2005] NO
JUMPGE W1,TMTCH5 ;[2005] CHECK FOR AT END OF LIST
TMTCH4: LDB T1,[TPSND(W1)] ;[2005] GET NUMBER OF SECONDARIES
ADD W1,T1 ;[2005] ACCOUNT FOR THEM
AOBJN W1,TMTCH4 ;[2005] GET ANOTHER
TMTCH5: JUMPGE W3,TMTCH7 ;[2005] CHECK FOR AT END OF LIST
TMTCH6: LDB T1,[TPSND(W1)] ;[2005] GET NUMBER OF SECONDARIES
ADD W3,T1 ;[2005] ACCOUNT FOR THEM
AOBJN W3,TMTCH6 ;[2005] GET ANOTHER
TMTCH7: MOVE T1,(W1) ;[2005] GET PRIMARY DESCRIPTOR
MOVE T2,(W3) ;[2005] FOR BOTH
SETZ P4, ;[2005] ARGUMENT ZERO IS FUNCTION RETURN
PUSHJ P,ARGSCN ;[2005] COMPARE THE RETURN VALUES
TMTCH8: MOVE T1,(P1) ;[2005] GET CALLER ARGUMENT
TXNN T1,TPSOF ;[2005] COMPLAIN IF SUBROUTINE/FUNCTION?
POPJ P, ;[2005] NO, DONE
XOR T1,(P2) ;[2005] COMPARE THE BITS
TXNN T1,TPVAL ;[2005] ARE THEY DIFFERENT?
POPJ P, ;[2005] NO
MOVE T1,(P1) ;[2005] GET BACK CALLER ARG
TXNN T1,TPVAL ;[2005] WAS CALLER THE FUNCTION?
SKIPA T1,[1,,0] ;[2012] YES, SET FOR COERSION
MOVX T1,<0,,1> ;[2012] NO, SET FOR COERSION
MOVX T3,FCRTV ;[2005] COERSION BLOCK TYPE
PJRST ARGERR ;[2005] CALL THE COERSION ROUTINE
;[1474] Routine ARGSCN.
; Checks for mismatch
; T1: Caller's arg (actual)
; T2: Function arg (formal)
; P1: Pointer to Caller's arglist
; P2: Pointer to Function's arglist
; P3: Pointer to Caller's argblock
; P4: Arg number
; W1: Pointer to current arg descr of Caller
; W2: Sixbit Function name
; W3: Pointer to current arg descr of Function
; Uses T3,T4.
;POINTERS TO FUNCTION ARGUMENT DESCRIPTOR FIELDS
FUNFLD: POINTR(T2,TPNUP)
POINTR(T2,TPPASM)
POINTR(T2,TPTYPM)
POINTR(T2,TPCTC)
;POINTERS TO CALLER'S ARGUMENT DESCRIPTOR FIELDS
CALFLD: POINTR(<(P)>,TPNUP)
POINTR(<(P)>,TPPASM)
POINTR(<(P)>,TPTYPM)
POINTR(<(P)>,TPCTC)
;MASKS FOR EACH ARGUMENT DESCRIPTOR FIELD
MSKFLD: TPNUP
TPPASM
TPTYPM
TPCTC
ARGSCN: PUSH P,W3 ;[1477] NEED A SPARE REGISTER
PUSH P,T1 ;[1477] AND SAVE THE CALLER'S ARG
SETZM W3 ;[1477] USE REGISTER AS COUNTER
MOVE T4,T1 ;[1477]
XOR T4,T2 ;[1477] NOTE MISMATCHES
ARGSCL: CAILE W3,FCCTC ;[1477] ALL FIELDS EXAMINED?
JRST ARGSCX ;[1477] YES
TDNN T4,MSKFLD(W3) ;[1477] MISMATCH IN THIS FIELD?
AOJA W3,ARGSCL ;[1477] NO, CHECK THE NEXT ONE
LDB T1,CALFLD(W3) ;[1477] WHAT DID CALLER GIVE?
LDB T3,FUNFLD(W3) ;[1477] WHAT DID FUNC EXPECT?
HRL T1,T3 ;[1477] FORMAL,,ACTUAL
MOVE T3,W3 ;[1477] T3 HAS TYPE BEING SENT
PUSHJ P,ARGERR ;[1477] TAKE APPROPRIATE ACTION
AOJA W3,ARGSCL ;[1477] AND TRY AGAIN
ARGSCX:
;[2103] Check for structure mismatch too.
TDNN T4,[TPSTRM] ;[2103]
JRST ARGSX0 ;[2103] No mismatch seen
LDB T1,[POINTR(<(P)>,TPSTRM)]
;[2103] What did caller expect?
LDB T3,[POINTR(T2,TPSTRM)] ;[2103] What did func expect?
HRL T1,T3 ;[2103] Formal,,actual
MOVEI T3,FCSTR ;[2103] This is a structure mismatch
PUSHJ P,ARGERR ;[2103] Handle it
ARGSX0: ;[2103]
;[1477] There may be 2ndary descriptors. Check for them.
POP P,T1 ;[1477] GET CALLER DESCR BACK
POP P,W3 ;[1477] RESTORE REGISTER W3 TOO
ANDI T1,TPSNDM ;[2005] ISOLATE NUMBER OF SECONDARIES
ANDI T2,TPSNDM ;[2005] IN CALLER AND CALLEE
ARGSX1: JUMPE T1,ARGSX9 ;[2005] CHECK FOR NO SECONDARIES
JUMPE T2,ARGSX9 ;[2005] IN EITHER DESCRIPTOR
ADDI W1,1 ;[2005] INCREMENT THE POINTERS
ADDI W3,1 ;[2005]
SUBI T1,1 ;[2005] DECREMENT THE COUNTS
SUBI T2,1 ;[2005]
PUSH P,T2 ;[2005] SAVE AN AC
PUSH P,T1 ;[2005] AND ANOTHER
LDB T2,[TPSIZ(W1)] ;[2005] GET THE COUNTS
LDB T1,[TPSIZ(W3)] ;[2005] FOR BOTH ARGS
SUB T2,T1 ;[2005] ACTUAL MINUS FORMAL
LDB T4,[TPMCH(W3)] ;[2005] GET THE TYPE TO CHECK FOR
MOVEI T3,FCLEN ;[2005] LENGTH CODE
SETZ T1, ;[2005] SET FOR ZERO BLOCK
XCT ARGSXT(T4) ;[2005] DO THE COMPARISON
PUSHJ P,ARGERR ;[2005] FAILED - GIVE MESSAGE
POP P,T1 ;[2005] RESTORE THE AC
POP P,T2 ;[2005] AND THE OTHER
JRST ARGSX1 ;[2005] TRY FOR MORE
ARGSX9: ADD W1,T1 ;[2005] ACCOUNT FOR THEM
ADD W3,T2 ;[2005] IN CASE THEY ARE DIFFERENT
POPJ P, ;[1477] AND LEAVE
;TABLE OF POSSIBLE ACTIONS - WILL SKIP IF T2 IS PERMISSABLE
ARGSXT: SKIPA T2 ;[2005] 000 ALWAYS ALLOWED
SKIPE T2 ;[2005] 001 MUST BE EQUAL
SKIPL T2 ;[2005] 010 ACTUAL .LT. FORMAL
SKIPLE T2 ;[2005] 011 ACTUAL .LE. FORMAL
SKIPG T2 ;[2005] 100 ACTUAL .GT. FORMAL
SKIPGE T2 ;[2005] 101 ACTUAL .GE. FORMAL
JFCL ;[2005] 110 NEVER LEGAL (RESERVED)
JFCL ;[2005] 111 NEVER LEGAL (RESERVED)
ARGCNE: MOVX T3,FCWNA ;[2005] LOOKING FOR NUMBER OF ARGS
SETZ T1, ;[2005] MUST BE ZERO IN BLOCK
; PJRST ARGERR ;[2005] LOOK FOR COERSION BLOCK
ARGERR: PUSH P,T2 ;[1476]
MOVE T2,ABCAL(P3) ;[1476] PREPARE TO COMPLAIN
; If there's a coerblock find out if a mismatch of this kind has some
; particular action specified.
PUSHJ P,COETST ;[1476]
POP P,T2 ;[1476]
POPJ P, ;[1470]
;[1474] Routine COETST
;[1474] Scans the coercion block
;[2005] Return -- Error typed if appropriate
COETST: PUSH P,T1 ;[1474] SAVE IT FOR NOW
MOVE R,COERPT ;[2005] STARTING AT THE FIRST
JUMPE R,COEDSP ;[2005] IF NO BLOCK, DO INFORMATIONAL
SKIPA ;[2005] START WITH FIRST PAIR
COETS1: ADD R,[1,,1] ;[1474] SKIP THE PAIR
HLRZ T1,(R) ;[1474] PICK UP FIELD CODE
CAMN T1,T3 ;[1474] RIGHT ONE FOUND?
JRST COETS3 ;[1474] YES
COETS2: AOBJN R,COETS1 ;[1474] NO, TRY AGAIN
SETZ R, ;[2005] DEFAULT INFORMATIONAL
JRST COEDSP ;[2005] GIVE INFORMATION MESSAGE
COETS3: MOVE T1,1(R) ;[1474] CHECK OUT THE PAIR
CAME T1,(P) ;[1474] IS THIS THE MISMATCH SOUGHT?
JRST COETS2 ;[1474] NO, KEEP LOOKING
HRRZ T1,(R) ;[1474] PICK UP ACTION CODE
MOVEI R,3 ;[1474]
CAIN T1,-1 ;[1474] 777777 -- FATAL
JRST COEDSP ;[1474] GO DO IT
CAIN T1,3 ;[1743] SOMETHING SPECIAL
JRST COESPC ;[1474] GO DO IT
MOVE R,T1 ;[2005]
COEDSP: POP P,T1 ;[2005] RESTORE FORMAL,,ACTUAL
CAIN R,4 ;[2005] IS IT "DO NOTHING"?
POPJ P, ;[2005] YES
PUSH P,TERLVL(R) ;[1474] PUSH THE SEVERITY
JRST @TERDSP(T3) ;[2005] TYPE THE ERROR
S%F ;[2012] -1 FATAL
TERLVL: S%I4 ;[2005] 0 INFORMATIONAL
S%W ;[2005] 1 WARNING
S%C ;[2005] 2 ERROR
S%F ;[2005] 3 FATAL (RESERVED)
;[2005] 4 NO ACTION
TERDSP: COEUPD ;[2005] 0 UPDATE
E$$AMM ;[2005] 1 PASSING MECHANISM
E$$TMM ;[2005] 2 ARGUMENT TYPE CODE
E$$AMM ;[2005] 3 COMPILE TIME CONSTANT
E$$WNA ;[2005] 4 WRONG NUMBER OF ARGUMENTS
COERTV ;[2005] 5 RETURN VALUE
E$$LMM ;[2005] 6 LENGTH MISMATCH
E$$AMM ;[2103] 7 STRUCTURE CODE
COERTV: TRNN T1,-1 ;[2005] DOES CALLER EXPECT A VALUE?
JRST E$$URV ;[2012] NO, OTHER MESSAGE
JRST E$$NVR ;[2012] YES, GIVE THIS ERROR
COEUPD: TRNN T1,-1 ;[2005] CALLER NO-UPDATE?
JRST E$$AMM ;[2005] NO, SHOULD BE HARMLESS
JRST E$$PMA ;[2005] YES, POSSIBLE MODIFICATION
COESPC: POP P,(P) ;[2005] TOSS STACK VALUE
CAIE T1,3 ;[1474] SPECIAL DESCR-TO-HOLL FIXUP?
POPJ P, ;[1474] NO
;[1474] Make quite sure we're supposed to do this.
;[1474] Only caller's compile-time constants can be picked up.
;[1474] Sneak a peek at descriptor in caller block.
MOVE T1,(W1) ;[2005] CURRENT CALLER'S DESCRIPTOR
TXNN T1,TPCTC ;[2005] COMPILE-TIME-CONST?
POPJ P, ;[1777] FORGET ABOUT IT AND LEAVE
;[1476] P3: Pointer to Caller's argblock
;[2005] W1: (left half) Minus number of descriptors left to process
;[2005] P1: Pointer to flags word (and descriptor count)
;[1476] Pick up the address of the argblk, and construct a pointer
;[1476] to the descriptor being passed to the function.
SPUSH <P1,P2,P3> ;[1777] SAVE SOME ACS
PUSH P,T2 ;[1474] WILL NEED IT
HLRE T2,W1 ;[2005] MINUS COUNT OF ARGS TO DO
ADD T2,ABABA(P3) ;[2005] ADD ADDR OF CALLERS ARG BLK
HRRZ P3,(P1) ;[2005] GET NUMBER OF DESCRIPTORS
ADDI T2,-1(P3) ;[2005] CALCULATE THE DESCRIPTOR
MOVE P3,(P1) ;[2005] GET THE FLAGS
TXNN P3,TPVAL ;[2005] IS IT A FUNCTION?
ADDI T2,1 ;[2005] NO
LDB P3,[POINT 30,T2,35] ;[1777] TAKE 30 BIT ADDRESS
IFN FTOVERLAY,< ;[2053]
SKIPE ARGOVL ;[2053] Argchecking the BG area?
JRST COEOVL## ;[2053] Yes, may have to defer this fixup
>;[2053] IFN FTOVERLAY
COESP0::PUSH P,P3 ;[2053] SAVE IT
PUSHJ P,SGCHK. ;[1777] FIND OUT WHERE IT IS
PUSH P,P3 ;[1777] SAVE PTR TO ARG DESCRIPTOR
HRRZ P3,(P3) ;[1777] PICK UP PTR TO STRING DESCR
MOVEI T1,17 ;[1474] CHANGE ARG BITS TO HOLLERITH
DPB T1,[POINT 4,@(P),12] ;[1474] ...
POP P,(P) ;[1474] THROW AWAY THE 'FIXED' POINTER
HLL P3,0(P) ;[2217] ADD IN SECTION NUNBER
PUSHJ P,SGCHK. ;[1777] GET WHERE STRING DESC REALLY IS
LDB T1,[POINT 6,(P3),5] ;[2217] GET THE HIGH ORDER SIX BITS
CAIE T1,44 ;[2217] IS IT A VALID BYTE POINTER
CAIN T1,61 ;[2217] IS IT A VALID OWGBP
JRST COESP2 ;[2217] YES
CAIN T1,67 ;[2217] IS IT A 9-BIT ASCII BP
JRST COESP2 ;[2217] YES - ITS O.K.
PUSHJ P,E$$CCE ;[2217] NO - POINTER NOT WORD ALIGNED
POP P,(P) ;[2217] CLEAN UP THE STACK
JRST COESP1 ;[2217] SKIP FIXUP AND RESTORE ACS
COESP2: HRRZ T1,(P3) ;[1777] ABSOLUTE ADDR OF STRING
EXCH T1,(P) ;[1777] ABSOLUTE ADDRESS OF STRING TO
;STACK REL ADDR OF DISCRIPTOR TO P3
MOVE P3,T1 ;[1777] SET UP P3 FOR CALL
PUSHJ P,SGCHK. ;[1777] FIND OUT WHERE IT IS
POP P,T1 ;ABSOLUTE ADDR OF STRING TO T1
HRLI T1,(<Z 17,>+1B0) ;[2217] HOLLERITH BITS + SECTION LOCAL
MOVEM T1,(P3) ;[2217] PUT IT WHERE IT BELONGS
COESP1::POP P,T2 ;[2053] RESTORE OLD T2 VALUE
SPOP <P3,P2,P1> ;[1777] RESTORE ACS
POPJ P, ;[2005] DONE.
;LNKCCE Character constant not word aligned in call to routine FOO
; called form module BAR at location 123456
E$$CCE:: ;[2217]
.ERR. (MS,.EC,V%L,L%F,S%F,CCE,<Character constant not word aligned >)
.ETC. (JMP,,,,,.ETMW2) ;[2322]
;LNKWNA Wrong number of arguments in call to routine FOO
; called from module BAR at location 123456
E$$WNA:: ;[2005]
.ERR. (MS,.EC,V%L,L%D,S%D,WNA,<Wrong number of arguments>) ;[2005]
.ETC. (JMP,,,,,.ETMW2) ;[1474]
;LNKNVR No value returned by routine FOO
; called from module BAR at location 123456
E$$NVR:: ;[2005]
.ERR. (MS,.EC,V%L,L%D,S%D,NVR,<No value returned by routine >) ;[2005]
.ETC. (JMP,,,,,.ETMW4) ;[2005]
;LNKURV Unexpected return value in call to routine FOO
; called from module BAR at location 123456
E$$URV:: ;[2005]
.ERR. (MS,.EC,V%L,L%D,S%D,URV,<Unexpected return value>) ;[2005]
.ETC. (JMP,,,,,.ETMW2) ;[2005]
;LNKLMM Length mismatch for argument N in call to routine FOO
; called from module BAR at location 123456
E$$LMM:: ;[2005]
.ERR. (MS,.EC,V%L,L%D,S%D,LMM,<Length mismatch for >) ;[2005]
.ETC. (JMP,,,,,.ETMW1) ;[2005]
;LNKTMM Type mismatch seen for argument N in call to routine FOO
; called from module BAR at location 123456
E$$TMM:: ;[2005]
.ERR. (MS,.EC,V%L,L%D,S%D,TMM,<Type mismatch for >) ;[2005]
.ETC. (JMP,,,,,.ETMW1) ;[1474]
;LNKPMA Possible modification of argument N in call to routine FOO
; called from module BAR at location 123456
E$$PMA::
.ERR. (MS,.EC,V%L,L%D,S%D,PMA,<Possible modification of >) ;[2264]
.ETC. (JMP,,,,,.ETMW1) ;[2005]
;LNKAMM Argument mismatch in argument N in call to routine FOO
; called from module BAR at location 123456
E$$AMM::
.ERR. (MS,.EC,V%L,L%D,S%D,AMM,<Argument mismatch in >) ;[2005]
; .ETC. (JMP,,,,,.ETMW1) ;[2005]
.ETMW1: .ETC. (XCT,.EC,,,,<[SKIPN P4]>) ;[2005] FUNCTION ARGUMENT?
.ETC. (JMP,,,,,.ETMW3) ;[2005] ;[2005] NO
.ETC. (STR,.EC,,,,,<argument >) ;[2005] YES
.ETC. (DEC,.EP!.EC,,,,P4) ;[1751]
.ETMW2: .ETC. (STR,.EC,,,,,< in call to routine >)
.ETMW4: .ETC. (SBX,.EC!.EP,,,,W2)
.ETC. (NLN,.EC) ;[2005]
.ETC. (STR,.EC,,,,,<called from module >) ;[2005]
.ETC. (SBX,.EC!.EP,,,,R2) ;[2005]
.ETC. (STR,.EC,,,,,< at location >)
.ETC. (OCT,.EP,,,,T2)
POPJ P,
.ETMW3: .ETC. (STR,.EC,,,,,<returned value>) ;[2005]
.ETC. (JMP,,,,,.ETMW2) ;[2005]
SUBTTL COMPILER SPECIFIC ROUTINES
DEFINE X(A,B,C,D)< ;;[1225] ACCOUNT FOR EXTRA ARG
IF1,<BLOCK 1>
IF2,<
IFDEF B'NAM,< ;;[1120] CALL PROCESSOR ROUTINE
PUSHJ P,B'NAM
>
IFNDEF B'NAM,<
JFCL ;;[1120] NOTHING TO DO
>
>
>
XALL
CT.NAM::PROCESSORS
DEFINE X(A,B,C,D)< ;;[1225] ACCOUNT FOR EXTRA ARG
B'BIT
>
CT.BIT::PROCESSORS
SALL
;CALLED BY PUSHJ P,xxxNAM
;
;ENTER WITH
; T1/ INDEX TO CT.TAB
; T2/ PROCSN (CT.BIT)
; W2/ PROGRAM NAME
; -1(P)/ BLANK COMMON
;HERE IF ALGOL MAIN PROGRAM - SETS THIS AS PROGRAM NAME
ALGNAM: SKIPN -1(P) ;SEE IF BLANK COMMON SET
POPJ P, ;[1120] USES COMMON SIZE AS MAIN PROG MARKER.
SETZM -1(P) ;CLEAR COMMON SIZE
MOVEM W2,LODNAM ;SAVE NAME
HRLZM T1,MNTYPE ;AND SAVE ALGOL AS MAIN PROG TYPE
POPJ P, ;[1120] DONE
;[1433] COBOL
C68NAM: JUMPE T2,CPOPJ ;[1120] OK FIRST TIME
TXNE T2,C74BIT ;[1433] TEST FOR COBOL-74
JRST E$$CMC ;[1174] NOT ALLOWED
TXNE T2,CBLBIT ;[1433] TEST FOR COBOL
JRST E$$CM6 ;[1433] NOT ALLOWED
TXNE T2,C68BIT ;[1433] OR IF COBOL-68 ALREADY SEEN
POPJ P, ;[1120] DONE
E$$CMF::.ERR. (MS,.EC,V%L,L%F,S%F,CMF,<COBOL module must be loaded first>) ;[1545]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
C74NAM: JUMPE T2,CPOPJ ;[1120] OK FIRST TIME
TXNE T2,C68BIT ;[1433] TEST FOR COBOL-68
JRST E$$CMC ;[1174] NOT ALLOWED
TXNE T2,CBLBIT ;[1433] TEST FOR COBOL
JRST E$$CM7 ;[1433] NOT ALLOWED
TXNN T2,C74BIT ;[1433] OR IF COBOL-74 ALREADY SEEN
JRST E$$CMF ;[1174]
POPJ P, ;[1227] DONE
CBLNAM: JUMPE T2,CPOPJ ;[1433] OK FIRST TIME
TXNE T2,C68BIT ;[1433] TEST FOR COBOL-68
JRST E$$CM6 ;[1433] NOT ALLOWED
TXNE T2,C74BIT ;[1433] TEST FOR COBOL-74
JRST E$$CM7 ;[1433] NOT ALLOWED
TXNN T2,CBLBIT ;[1433] OR IF COBOL ALREADY SEEN
JRST E$$CMF ;[1433]
POPJ P, ;[1433] DONE
E$$CMC::.ERR. (MS,.EC,V%L,L%F,S%F,CMC,<Cannot mix COBOL-68 and COBOL-74 compiled code>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
E$$CM6::.ERR. (MS,.EC,V%L,L%F,S%F,CM6,<Cannot mix COBOL-68 and COBOL compiled code>) ;[1433]
.ETC. (JMP,,,,,.ETIMF##) ;[1433]
E$$CM7::.ERR. (MS,.EC,V%L,L%F,S%F,CM7,<Cannot mix COBOL-74 and COBOL compiled code>) ;[1433]
.ETC. (JMP,,,,,.ETIMF##) ;[1433]
;FORTRAN
XFRNAM: TXNE T2,FORBIT ;[1203] SEEN OTHER FORTRAN?
JRST E$$CMX ;[1203] YES, ERROR
JRST FOROK ;[1203] NO, PROCEED
FORNAM: TXNE T2,XFRBIT ;[1203] OTHER FORTRAN?
JRST E$$CMX ;[1203] YES, COMPLAIN
PASNAM: ;[1435] SAME TEST FOR PASCAL
FOROK: MOVE T1,OTSEG ;[2300] DID USER SPECIFY NON-REENT OTS?
SOJE T1,CPOPJ ;YES, SO LOAD TWO SEG CODE IN TWO SEGMENTS
SKIPN HC.LB ; IF ANY HIGH LOADED
TRNE FL,R.FNS!R.FLS!R.FHS!R.LSO!R.HSO ;ANY REASON TO KEEP SEGMENTS DISTINCT?
POPJ P, ;EITHER USER HAS SPECIFIED WHICH, OR ALREADY LOADED HIGH
;IN EITHER CASE RIGHT THING HAPPENS
TRO FL,R.FLS ;NO, SO FORCE LOW SEGMENT
POPJ P, ;SO FOROTS WILL BE SHAREABLE
E$$CMX::SKIPE NOCMX ;[1262] HAS THIS ERROR BEEN PRINTED BEFORE?
JRST FOROK ;[1262] YES, DON'T PRINT IT AGAIN
SETOM NOCMX ;[1262] FLAG THIS AS SEEN
.ERR. (MS,.EC,V%L,L%W,S%W,CMX,<Cannot mix GFloating FORTRAN compiled code with FORTRAN compiled code>) ;[1753]
.ETC. (JMP,,,,,.ETIMF##) ;[1203]
AOS .JBERR ;[1207] STOP EXECUTION
JRST FOROK ;[1207] BUT KEEP LOADING
;SITGO
STGNAM:
E$$SNS::.ERR. (MS,.EC,V%L,L%F,S%F,SNS,<SITGO not supported>)
.ETC. (JMP,,,,,.ETIMF##) ;[1203]
SUBTTL STORE CODE IN FX AREA
T3HOLD::MOVEI T2,.IPS ;STORE CODE IN INTERNAL PAGES
PUSHJ P,DY.GET## ;FIRST BLOCK IN DY, REST IN FX
MOVE T2,[3,,1] ;BLOCK HEADER
MOVEM T2,1(T1) ;FOR RE-READ
MOVEM W1,3(T1) ;STORE HIGH SEG ORIGIN
MOVEI W2,3(T1) ;POINT TO NEXT FREE LOC
HRLI W2,-.IPS+3 ;AOBJN WORD FOR THIS BLOCK
PUSH P,T1 ;SAVE ORIGIN
T3HEDR: PUSHJ P,D.IN1 ;GET NEXT HEADER
HLRZ T2,W1 ;[1320] GET TYPE
CAIN T2,5 ;[1320] NEED END BLOCK
JRST T5FND ;FOUND IT
PUSHJ P,FXHOLD ;HOLD CODE IN FX AREA
JRST T3HEDR ;AND CONTINUE
;HERE TO STORE BLOCK IN CORE (FX)
;ENTER WITH W1 = FIRST DATA WORD
FXHOLD: HRRZ T1,W1 ;GET WORD COUNT
JUMPE T1,FXHLD0 ;[1320] STORE ZERO IN CASE ASCII TEXT
CAILE T2,3777 ;[1320] ASCII TEXT BLOCK?
SKIPA T1,[0] ;[1320] YES, STORE ONLY ONE WORD
CAILE T2,377 ;[1320] OLD STYLE REL BLOCK?
JRST FXHLD0 ;[1320] NO, LONG COUNT IS OK
CAIG T1,^D18 ;ONLY 1 SUB BLOCK
AOJA T1,FXHLD0 ;YES
IDIVI T1,^D18 ;NO, COUNT NO.
IMULI T1,^D19 ;ADD RELOCATION WORD
JUMPE T2,FXHLD0 ;NO REMAINDER
ADDI T1,1(T2) ;ADD REMAINDER + BYTE WORD
FXHLD0: SKIPA W3,T1 ;NO OF WORDS IN THIS BLOCK
FXHLD1: PUSHJ P,D.IN1 ;GET NEXT WORD
AOBJP W2,FXHLD3 ;RAN OUT OF SPACE
FXHLD2: MOVEM W1,(W2) ;STORE IT
SOJGE W3,FXHLD1 ;LOOP FOR ALL OF BLOCK
POPJ P, ;GET NEXT BLOCK
FXHLD3: SUBI W2,.IPS ;BACKUP POINTER TO START OF BLOCK
SKIPE FX.LB ;LIST IN DY IF NOT SETUP
CAMGE W2,FX.LB ;IS LIST IN FX OR DY
TLOA W2,-1 ;IN DY
SUB W2,FX.LB ;IN FX, REMOVE OFFSET
MOVEI T2,.IPS ;GET NEXT BLOCK
PUSHJ P,FX.GET## ;IN FIXUP AREA
TLZN W2,-1 ;WAS IT IN DY
ADD W2,FX.LB ;NO, PUT BACK OFFSET
EXCH T1,W2 ;NEW POINTER IN W2, OLD IN T1
MOVE T2,W2 ;COPY IT
SUB T2,FX.LB ;REMOVE OFFSET
.JDDT LNKLOD,FXHLD3,<<CAMN T2,$FIXUP##>> ;[632]
SUB T2,LW.FX ;INCASE PAGING
MOVEM T2,(T1) ;FIXUP POINTER
HRLI W2,-.IPS ;FORM AOBJN POINTER
AOBJN W2,FXHLD2 ;STORE CURRENT WORD IN NEW BLOCK
;HERE WHEN END BLOCK FOUND
T5FND: MOVEI T1,2 ;ONLY STORE FIRST 3 WORDS
PUSHJ P,FXHLD0
PUSH P,W1 ;SAVE HIGH SEG BREAK
PUSHJ P,FXHLD1 ;FINISH OFF BLOCK
POP P,W1 ;DATA WORD BACK
;NOW GET FIRST BLOCK BACK
POP P,W2
HRLM W1,3(W2) ;NOW WE HAVE A VALID BREAK
T5FND1: PUSH P,DCBUF ;STACK REAL BUFFER HEADER
PUSH P,DCBUF+1
PUSH P,DCBUF+2
MOVEI T1,.IPS-1 ;MAX NO. OF WORDS IN BUFFER
MOVEM T1,DCBUF+2
HRRM W2,DCBUF+1 ;NEW BUFFER HEADER
SETZM DCBUF ;SIGNAL INCORE
JRST LOAD ;AND TRY AGAIN
;HERE TO GET NEXT BUFFER
;MOVE IT FROM FX AREA TO DY AREA (FIXED ADDRESS)
FXRED1: PUSHJ P,FXREAD ;CALLED FROM D.INP
JRST D.IN1 ;SO RETURN THERE
FXRED2: PUSHJ P,FXREAD ;CALLED FROM D.READ
JRST D.RED1 ;SO RETURN TO THE CALLER
FXREAD::PUSHJ P,.PSH4T## ;[2262] NEED SOME TEMP ACCS
HRRZ T1,DCBUF+1 ;GET FINAL BYTE POINTER
SUBI T1,.IPS-1 ;BACKUP
HRRM T1,DCBUF+1
MOVEI T2,.IPS-1 ;NO OF WORDS IN BUFFER
MOVEM T2,DCBUF+2
SKIPN T1,(T1) ;GET FIRST WORD (POINTER)
HALT
SKIPE PAG.FX ;PAGING?
HALT
.JDDT LNKLOD,FXREAD,<<CAMN T1,$FIXUP##>> ;[632]
ADD T1,FX.LB ;ADD IN BASE
HRRZ T2,DCBUF+1 ;ADDRESS OF FIXED DY AREA ARRAY
HRLZ T3,T1 ;FROM
HRR T3,T2 ;TO
BLT T3,.IPS-1(T2) ;UNTIL
MOVEI T2,.IPS ;NOW GIVE BACK
PUSHJ P,FX.RET##
PUSHJ P,.POP4T## ;RESTORE T1-T4
POPJ P, ;AND RETURN
;HERE WHEN ALL DONE
T5FIN:: PUSHJ P,FX.GBC## ;GARBAGE COLLECT FX AREA
HRRZ T1,DCBUF+1 ;WHERE WE ARE NOW
ADD T1,DCBUF+2 ;+ WHATS LEFT
SUBI T1,.IPS-1 ;BACKUP
SKIPE (T1) ;BETTER HAVE FINISHED
HALT
MOVEI T2,.IPS ;GIVE BLOCK BACK
PUSHJ P,DY.RET##
POP P,DCBUF+2
POP P,DCBUF+1
POP P,DCBUF
JRST T.LOAD ;GET NEXT BLOCK
SUBTTL HERE TO TERMINATE LOAD
GO:: PUSHJ P,LIBRARY ;LOAD DEFAULT LIBS
MOVE T1,SYMSEG ;GET /SYMSEG
SKIPN NOSYMS ;NO SYMBOLS AVAILABLE?
CAIN T1,$SSGNONE ;[1201] USER GIVE /SYMSEG:NONE?
JRST [SETZM SYMSEG ;YES, TELL LNKXIT
JRST GOSTRT] ;DEFINE START ADDRESS
CAIE T1,$SSGHIGH ;[1246] WANT SYMBOLS IN HIGH SEGMENT?
JRST GOSYM ;[1246] NO - CHECK DEFAULT
SKIPE HC.LB ;[1246] HIGH SEG EXIST YET?
JRST GOSTRT ;[1246] YES - NO NEED TO CREATE ONE
SETZ W1, ;[1246] USE DEFAULT ORIGIN
PUSHJ P,SETRC## ;[1246] AND SET UP THE HIGH SEGMENT
MOVEI T1,$SSGHIGH ;[1246] RESTORE T1 TO /SYMSEG:HIGH
GOSYM: JUMPN T1,GOSTRT ;OK IF USER SPECIFIED
IFN TOPS20,<
MOVEI T1,$SSGLOW ;[1201] OTHERWISE, DEFAULT TO LOW
MOVEM T1,SYMSEG ;STORE FOR LNKXIT
> ;END IFN TOPS20
GOSTRT: SKIPN W2,STADDR+1 ;IS START ADDRESS STILL SYMBOLIC?
JRST GOUPTO ;[1175] NO
MOVX W1,PT.SGN!PT.SYM
PUSHJ P,TRYSYM## ;SEE IF DEFINED BY NOW
JRST NOSTRT ;[1232] UNDEFINED
JRST NOSTRT ;[1232] UNDEFINED
MOVE T1,2(P1) ;GET VALUE
ADDM T1,STADDR ;CALCULATE VALUE
SETZM STADDR+1 ;NOW KNOWN
JRST GOUPTO ;[1175] GO CHECK /UPTO
;HERE WHEN THE START ADDRESS IS UNDEFINED.
NOSTRT: PUSHJ P,E$$USA ;[1232] NOTIFY THE USER
JRST GOUPTO ;[1232] GO CHECK /UPTO:
E$$USA::.ERR. (MS,.EC,V%L,L%W,S%W,USA,<Undefined start address >) ;[1174]
.ETC. (SBX,.EP,,,,W2) ;[1174]
SETZM STADDR ;[1175] CLEAR ADDRESS
SETZM STADDR+1 ;[1175] ...
POPJ P, ;[1232] DONE
;NOW TO CHECK THE /UPTO SYMBOL, IF ANY
GOUPTO: MOVE W2,SYMLIM ;[1175] GET /UPTO VALUE
SKIPN SYMLMS ;[2220] SYMBOLIC?
JRST GOUSYM ;[1175] NO
MOVX W1,PT.SGN!PT.SYM ;[1175] FLAGS
PUSHJ P,TRYSYM## ;[1175] SEE IF DEFINED
JRST E$$UUA ;[1175] NO
JRST E$$UUA ;[1175] NO
MOVE T1,2(P1) ;[1175] YES, FETCH VALUE
MOVEM T1,SYMLIM ;[1175] STORE FOR LNKXIT
SETZM SYMLMS ;[2220] NO LONGER SYMBOLIC
JRST GOUSYM ;[1175] GO CHECK UNDEFINED SYMBOLS
;HERE IF THE /UPTO ADDRESS IS UNDEFINED.
E$$UUA::.ERR. (MS,.EC,V%L,L%W,S%W,UUA,<Undefined /UPTO: address >)
.ETC. (SBX,.EP,,,,W2) ;[1175]
SETZM SYMLIM ;[1175] NO LIMIT
SETZM SYMLMS ;[2220] AND NOT SYMBOLIC
; ..
; ..
;HERE TO MAKE A LAST-DITCH TRY AT DEFINING THE LAST UNDEFINED SYMBOL.
GOUSYM: SKIPN USYM ;STILL SOME UNDEFS?
JRST LODXIT ;NO, GIVE UP
MOVX W1,PT.SGN!PT.SYM ;MIGHT BE ALGOL REFERENCE
MOVE W2,['%OWN ']
SETZ W3,
PUSHJ P,TRYSYM## ;SEE IF PENDING REQUEST
CAIA ;NOT IN TABLE
JRST DEFOWN ;YES, NEEDS DEFINING
;HERE TO EXIT
;GO EITHER TO LNKMAP OR LNKXIT
LODXIT: MOVEI T1,TP.IX ;[2270] NOW DELETE TYPECHECKING AREA
PUSHJ P,XX.ZAP## ;[2270] GET RID OF IT
PUSHJ P,RETPSC ;[2270] RETURN PSECT/COMMON BLOCKS
MOVEI R,1 ;[1305] SET UP FOR LOW SEG
MOVE R,@SG.TB ;[1305]
MOVE T1,HP.S1 ;[1305] GET .LOW. PSECT BREAK
CAMLE T1,RC.HL(R) ;[1305] IS IT HIGHER?
MOVEM T1,RC.HL(R) ;[1305] PUT IT IN THE PSECT BLOCK
SKIPN LL.S2 ;[1305] IS THERE A HIGH SEG?
JRST LODXI1 ;[1305] NO - IGNORE HP.S2
MOVEI R,2 ;[1305] SET UP FOR HIGH SEG
MOVE R,@SG.TB ;[1305]
MOVE T1,HP.S2 ;[1305] GET .HIGH. PSECT BREAK
CAMLE T1,RC.HL(R) ;[1305] IS IT HIGHER?
MOVEM T1,RC.HL(R) ;[1305] PUT IT IN THE PSECT BLOCK
LODXI1: SKIPE USYM ;ANY UNDEFINED SYMBOLS?
PUSHJ P,LODUGS ;[1174] PRINT UNDEFINED GLOBALS MESSAGE
HLRZ P1,INCPTR ;GET GLOBAL INCLUDE POINTER
JUMPN P1,[TLO P1,100 ;SET LH POSITIVE AS ERROR
MOVEI T1,[ASCIZ \?LNKIMM \]
PUSHJ P,MISNG1##
JRST .+1] ;AND REENTER MAIN STREAM
RELEASE DC, ;CLOSE INPUT I/O
MOVEI T1,DC ;FINISHED WITH INPUT BUFFERS NOW
MOVEM T1,IO.CHN
PUSHJ P,DVRET.## ;RETURN TO FREE POOL
SETZM IO.PTR+DC ;FORGET ABOUT IT
PUSHJ P,LODFIX ;DO ALL FIXUPS WE NEED
PUSHJ P,ALGCHK ;SEE IF ALGOL SYMBOL FILE NEEDED
MOVEI T3,1 ;[704] USED FOR LOOP CONTROL IN SRT.RC
PUSHJ P,SRT.RC ;[704] YES, GO SORT THE RELOC TABLES
IFN TOPS20,< ;[2242]
PUSHJ P,CHK.RC ;[2242] MAKE SURE ALL PAGES EXIST
> ;[2242] IFN TOPS20
MOVE T1,MAPSW ;SEE IF WE NEED A MAP
CAME T1,[$MAPEND] ;AT THE END
JRST LNKXIT ;NO
JRST LNKMAP ;YES
LODUGS: MOVE T1,[PUSHJ P,UNDNXT##] ;[1174] SET UP NEXT SYMBOL ROUTINE
MOVEM T1,NXTGLB ;[1174] ..
MOVE W3,HT.PRM ;[1174] SET UP INDEX TO HASH TABLE
ADDI W3,1 ;[1174] START 1 UP FOR SOSGE IN UGSNXT
E01UGS::.ERR. (MS,.EC,V%L,L%F,S%C,UGS) ;[1174]
.ETC. (JMP,,,,,.ETUGS##) ;[1174] PRINT UNDEF'ED GLOBALS AND RETURN
;[2227] Here to return the common/psect blocks
RETPSC: SKIPN R,CPSECT ;[2227] Get the base of the list
POPJ P, ;[2227] Nothing to do
RETPS0: HLRZ T2,PC.PSC(R) ;[2227] Get the psect name
TRNE T2,770000 ;[2227] Short symbol?
JRST RETPS1 ;[2227] Yes, don't return much
HRRZ T1,PC.PSC(R) ;[2227] Get it's address
PUSHJ P,DY.RET## ;[2227] Give it back
RETPS1: HLRZ T2,PC.CMN(R) ;[2227] Get the common name
TRNE T2,770000 ;[2227] Short symbol?
JRST RETPS2 ;[2227] Yes, don't return much
HRRZ T1,PC.CMN(R) ;[2227] Get it's address
PUSHJ P,DY.RET## ;[2227] Give it back
RETPS2: MOVE T1,R ;[2227] Get the block address
MOVEI T2,PC.SIZ ;[2227] And the length
MOVE R,PC.LNK(R) ;[2227] Point to the next one
PUSHJ P,DY.RET## ;[2227] Give this one back
JUMPN R,RETPS0 ;[2227] Return them all
POPJ P, ;[2227] Done
;[704] HERE TO SORT THE PSECT RELOCATION TABLES BY ORDER OF
;[704] THEIR ORIGINS BEFORE DOING THE MAP OR EXIT.
;[704] USES T1,T2,T3,W1 AND R
;[747] ONCE THE SORT IS DONE, UPDATE LOWLOC and then
;[746] jump to check PSECT boundaries for any overlap.
SRT.RC: CAML T3,RC.NO ;[704] FINISHED?
JRST CHKLLC ;[747] YES, UPDATE LOWLOC
MOVE R,RC.NO ;[704] NO, START FROM THE END
SRT.R2: MOVE T1,@RC.TB ;[704] GET TABLE ADDRESS
SUBI R,1 ;[704] NEXT TABLE DOWN
MOVE T2,@RC.TB ;[704] ITS ADDRESS
MOVE W2,T2 ;[704] SAVE IT ALSO IN W2, INCASE OF EXCHANGE
MOVE W1,RC.IV(T1) ;[704] GET ORIGIN OF FIRST ONE
CAMGE W1,RC.IV(T2) ;[704] COMPARE WITH THE ORIGIN OF THE SECOND
JRST [ADDI R,1 ;[704] FIRST ON IS LESS, SO SWAP
EXCH W2,@RC.TB ;[704] THE TABLE ADDRESSES
SUBI R,1 ;[704]
MOVEM W2,@RC.TB ;[704]
JRST .+1] ;[704]
JUMPG R,SRT.R2 ;[704] LOOP BACK IF MORE TABLES
AOJA T3,SRT.RC ;[704] LOOP FOR ANOTHER SORT PASS
;[747] HERE TO UPDATE LOWLOC.
CHKLLC:
IFE TOPS20,< ;[2247]
SKIPN LOWLOC ;[747] IF LOWLOC IS ZERO ALREADY
JRST CHKLL1 ;[760][747] DON'T NEED TO CHECK
SETZ R, ;[747] GET .ABS.
MOVE T1,@RC.TB ;[747]
MOVE W1,RC.HL(T1) ;[1215] USE HIGHEST LOC EVER SEEN
MOVEI R,1 ;[747] GET .LOW.
MOVE T2,@RC.TB ;[747]
MOVE W2,RC.HL(T2) ;[1215] USE HIGHEST LOCATION EVER SEEN
SKIPN W1 ;[2065] ANYTHING IN .ABS.?
CAILE W2,140 ;[2065] OR IN .LOW.?
JRST [SETZM LOWLOC ;[747] YES,
JRST CHKLL1] ;[760][747] NOW, GO CHECK PSECT OVERLAP
AOS R ;[747] NOTHING IN .LOW.
CAMLE R,RC.NO ;[1132] NEXT PSECT ORG MUST BE LOWEST
JRST [SETZM LOWLOC ;[1132] NO NEXT, LOWLOC IS ZERO
JRST CHKLL1] ;[1132] DONE
MOVE T1,@RC.TB ;[1132] GET POINTER TO RC BLOCK
MOVE W1,RC.IV(T1) ;[747]
CAMGE W1,LOWLOC ;[747]
MOVEM W1,LOWLOC ;[747] IN THAT CASE, UPDATE
CHKLL1: ;[2247]
>;[2247] IFE TOPS20
;FALL THROUGH TO NEXT PAGE
;HERE TO UPDATE HL.S1 FROM PSECT INFO, IF NEEDED
MOVE R,RC.NO ;[2247] POINT TO HIGHEST PSECT
CHKLL2: MOVE T1,@RC.TB ;[1106] GET POINTER TO THIS RC BLOCK
MOVE T2,RC.SG(T1) ;[1106] GET SEGMENT NUMBER
CAIN T2,1 ;[1106] LOW SEG?
JRST CHKLL3 ;[1106] GOT HIGHEST PSECT, GO FIX HL.S1
SOJGE R,CHKLL2 ;[1106] NO, LOOP OVER OTHER RELOC. COUNTERS
JRST CHKLL4 ;[1106] NONE FOUND, DONE
;HERE WHEN WE HAVE FOUND THE HIGHEST RC IN THE LOW SEG (A PSECT)
CHKLL3: SKIPN T2,RC.HL(T1) ;[1106] GET HL IF AVAILABLE
MOVE T2,RC.CV(T1) ;[1106] OR CV IF ITS NOT
CAMLE T2,HL.S1 ;[1106] POINT BEYOND CURRENT HL.S1?
MOVEM T2,HL.S1 ;[1106] YES, UPDATE WITH NEW VALUE
CHKLL4: MOVE R2,RC.NO ;[1106] USED IN CHKBND FOR LOOP CONTROL
; JRST CHKBND ;[760]
;[746] HERE TO CHECK FOR PSECT OVERLAP. IF OVERLAP IS FOUND
;A WARNING IS OUTPUT AND RETURN.
CHKBND: MOVE R,R2 ;[760][746] START FROM THE END
MOVE T1,@RC.TB ;[760][746] GET RELOC TABLE POINTER
MOVE T2,RC.HL(T1) ;[1204] HIGHEST EVER LOADED
MOVE T3,RC.CV(T1) ;[1204] WHERE NEXT WORD GOES
MOVE W1,RC.IV(T1) ;[746] GET THE ORIGIN
CHKBN1: SOJLE R,CHKBN2+1 ;[760] CHECK WITH ALL LOWER PSECTS
MOVE T2,@RC.TB ;[746] GET TABLE PTR TO PSECT BEFORE
MOVE W2,RC.CV(T2) ;[760][746] AND ITS CURRENT VALUE
CAML W1,W2 ;[746] ANY OVERLAP?
JRST CHKBN2 ;[760][746] NO, LOOP
CAMLE W2,RC.CV(T1) ;[760] MIN OF THE TWO RC.CV'S
MOVE W2,RC.CV(T1) ;[760]
CAMGE W1,RC.IV(T2) ;[760] MAX OF THE TWO RC.IV'S
MOVE W1,RC.IV(T2) ;[760]
SKIPGE RC.AT(T2) ;[2247] HAS THE PSECT BEEN USED?
JRST CHKBN2 ;[2247] NO (MUST BE UNUSED .LOW.)
PUSH P,T1 ;[1234] SAVE PTR TO PSEG
MOVE T1,RC.NM(T1) ;[746] SET UP TO OUTPUT WARNING
MOVE T2,RC.NM(T2) ;[746] GET THE TWO PSECT NAMES
E$$POV::.ERR. (MS,.EC,V%L,L%W,S%W,POV,<Psects >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,T1) ;[1174]
.ETC. (STR,.EC,,,,,< and >)
.ETC. (SBX,.EC!.EP,,,,T2) ;[1174]
.ETC. (STR,.EC,,,,,< overlap from address >) ;[1212]
.ETC. (OCT,.EC!.EP,,,,W1) ;[1174]
.ETC. (STR,.EC,,,,,< to >)
.ETC. (OCT,.EP,,,,W2) ;[1174]
POP P,T1 ;[1234] RESTORE PTR TO PSEG
CHKBN2: JUMPG R,CHKBN1 ;[760] LOOP DOWN IF MORE IN THIS SWEEP
SOJG R2,CHKBND ;[760] NEXT PSECT
POPJ P, ;[760] ALL DONE
LODFIX::SKIPN W1,LINKTB ;ANY BLOCK TYPE 12 LINKS?
JRST B12NOT ;NO
HRLI W1,-LN.12 ;FORM AOBJN WORD
B12LUP: MOVE T2,LN.12(W1) ;[2273] GET END ADDRESS
JUMPE T2,B12END ;NONE
MOVE W3,(W1) ;[2273] LAST ADDRESS
PUSHJ P,SEGCHK ;GET IN CORE ADDRESS
JRST [TXO T2,CPF.RR ;[2200] NOT IN CORE
PUSHJ P,SY.CHP ;SO PUT IN FIXUP LIST
JRST B12END] ;AND RETURN FOR NEXT
HRRM W3,(T2) ;STORE IN CORE
B12END: AOBJN W1,B12LUP ;LOOP FOR ALL ITEMS
HRRZ T1,LINKTB ;ADDRESS OF TABLE
MOVEI T2,2*LN.12 ;[2273] LENGTH
PUSHJ P,DY.RET## ;GIVE IT BACK
SETZM LINKTB ;[737] CLEAR POINTER
B12NOT: SKIPN P1,PRGPTR ;ANY BLOCK TYPE 16 TO RETURN?
JRST B16NOT ;NO
B16RET: MOVEI T1,(P1) ;ADDRESS
MOVEI T2,4 ;SIZE
HRRZ P1,(P1) ;NEXT
PUSHJ P,DY.RET## ;RETURN SPACE
JUMPN P1,B16RET ;LOOP
SETZM PRGPTR ;[1103] REMEMBER THAT WE'RE DONE
B16NOT: PJRST COR.FX ;FIXUP ALL CODE CHAINS
IFN TOPS20,< ;[2242]
;[2242] Here to make sure all sections exist
;[2243] Also insure that that RC.HL is not below RC.CV
;[2242] Uses R, W1, W2, P1, and T1-T4 (in RC.CHK)
CHK.RC: MOVE R,RC.NO ;[2242] Start at the last psect
RCCHK0: MOVE W1,@RC.TB ;[2242] Get pointer to RC block
MOVE W2,RC.CV(W1) ;[2243] Get current value
CAMLE W2,RC.HL(W1) ;[2243] Higher than "highest loaded"?
MOVEM W2,RC.HL(W1) ;[2243] Yes, probably /REDIRECT - fix it
MOVE W2,RC.IV(W1) ;[2242] Get the base of the psect
CAML W2,RC.HL(W1) ;[2262] Empty psect?
JRST RCCHK2 ;[2242] Yes, don't create section
HLLZS W2 ;[2242] Make it section,,0
RCCHK1: MOVE P1,W2 ;[2242] Put it in in correct AC
MOVE T4,RC.SG(W1) ;[2242] Get the index
SKIPE P1 ;[2242] Don't bother for section zero
PUSHJ P,NEWSCT## ;[2242] Make sure it exists
ADD W2,[1,,0] ;[2242] Next section
CAMGE W2,RC.HL(W1) ;[2243] This section in psect?
JRST RCCHK1 ;[2242] Yes, create it too
RCCHK2: SOJG R,RCCHK0 ;[2242] Done with this one, do others
POPJ P, ;[2242] No more
>;[2242] IFN TOPS20
;HERE TO SETUP FILE/SYMBOL:ALGOL IF NEEDED, AND STORE THE
;FILESPEC IN THE FIRST ALGOL OWN BLOCK SEEN THIS LOAD
ALGCHK::SKIPN NOSYMS ;[1265] /NOSYMS? (AFTER 1044 SEEN)
JRST ALGCH2 ;NO
ALGCH1: MOVEI T1,AC ;POINT TO ALGOL CHANNEL
SKIPE PAG.AS ;AS AREA PAGING?
PUSHJ P,DVDEL.## ;YES, DELETE OVERFLOW FILE
SETZM LW.AS ;ZAP PAGING POINTERS
SETZM UW.AS ;..
MOVEI T1,AS.IX ;NOW DELETE AREA
PJRST XX.ZAP## ;SO LNKXIT WILL HAVE MORE ROOM
;HERE IF NOT /NOSYMBOLS
ALGCH2: SKIPE T1,SYMFRM ;USER SAY /SYMBOL?
CAIN T1,2 ;YES, /SYMBOL:ALGOL?
CAIA ;YES, GIVE IT TO HIM
JRST ALGCH1 ;NO, FORGET WE EVER SAW 1044
JUMPN T1,ALGCH3 ;DON'T DEFAULT IF USER SPECIFIED
MOVX T1,ALGBIT ;GET BIT FOR ALGOL
TDNE T1,MNSEEN ;SEEN AN ALGOL MAIN PROGRAM?
SKIPN AS.LB ;AND SOME ALGOL SYMBOLS?
JRST ALGCH1 ;NO
MOVEI T1,2 ;DEFAULT TO /SYMBOL:ALGOL
MOVEM T1,SYMFRM ;SINCE USER DIDN'T SAY
MOVEI T2,F.LEN ;NEED A TEMP IO DATA BLOCK
PUSHJ P,DY.GET## ;FROM THE DY AREA
MOVE P1,T1 ;SAVE ADDR FOR DV.OUT
MOVE T1,LODNAM ;USE MAIN PROG NAME AS FILE NAME
MOVEM T1,F.NAME(P1) ;SAVE IN BLOCK
MOVSI T1,'SYM' ;EXTENSION '.SYM'
MOVEM T1,F.EXT(P1) ;SAVE FOR LNKFIO
PUSHJ P,DVOUT.## ;MAKE SCAN BLOCK INTO IO BLOCK
%SC,,.IODPR ;SYMBOL CHANNEL, DUMP RECORDS MODE
MOVE T1,P1 ;DONE WITH SCAN BLOCK
MOVEI T2,F.LEN ;SO RETURN IT TO DY AREA
PUSHJ P,DY.RET## ;..
MOVE T1,IO.PTR+%SC ;[1230] FORCE ALGOL SYM FILE TO
MOVX T2,<Z AC,> ;[1230] USE CHANNEL AC
MOVEM T2,I.CHN(T1) ;[1230] ..
ALGCH3: SKIPN SYMSEG ;USER SPECIFY WHERE SYMBOLS GO?
AOS SYMSEG ;NO, PUT THEM IN LOW SEG (ALGOL 7)
SKIPN P3,ASFILE ;LOW ADDRESS OF DESCRIPTOR
POPJ P, ;NO TYPE 15 SEEN, DON'T FILL IN
MOVEI P2,LN.ABL(P3) ;TOP ADDRESS OF DESCRIPTOR
SKIPE PAG.S1 ;PAGING LOWSEG?
PUSHJ P,PG.LSG ;YES, MAKE SURE BLOCK ADDRESSABLE
ADD P3,LC.LB ;MAKE ABSOLUTE PHYSICAL ADDRESS
HRRZ T1,IO.PTR+%SC ;ADDRESS OF FILE INFO
MOVE T2,I.DEV(T1) ;GET DEVICE OUT OF IO BLOCK
MOVEM T2,0(P3) ;MAKE 1ST WORD OF OTS DESCRIPTOR
MOVE T2,I.NAM(T1) ;SAME FOR FILE NAME
MOVEM T2,1(P3) ;IT BECOMES 2ND WORD
HLLZ T2,I.EXT(T1) ;EXTENSION...
MOVEM T2,2(P3) ;...INTO 3RD WORD
SKIPN T2,I.PPN(T1) ;GET PPN IF SPECIFIED
JRST ALGCH5 ;NOT, USE DEFAULT PATH
TLNE T2,-1 ;POINTER TO PATH?
JRST ALGCH4 ;NO
SKIPN T3,2(T2) ;YES, GET PPN
MOVE T3,PTHDIR ;OR DEFAULT PATH IF NOT SPECIFIED
MOVEM T3,3(P3) ;STORE AS WORD 4 FOR ALGOL
MOVSI T3,3(T2) ;MAKE BLT POINTER FOR SFD'S
HRRI T3,4(P3) ;INTO WORDS 5-9 OF BLOCK
BLT T3,11(P3) ;COPY SFD'S & TRAILING ZERO
POPJ P, ;FINISHED
ALGCH4: MOVEM T2,3(P3) ;STORE PPN IN CORE
SETZM 4(P3) ;INDICATE NO SFD'S
POPJ P, ;DONE
ALGCH5: MOVSI T2,PTHDIR ;WANTS DEFAULT - BLT OUR DEFAULT
HRRI T2,3(P3) ; PATH INTO THE ALGOL OWN BLOCK
BLT T2,11(P3) ;BLLLLLLLLLLIIIIIIIITTTTTTTT
POPJ P, ;DONE AT LAST
LIBRARY::
POP P,T1 ;RESTACK TOP 2 ITEMS
EXCH T1,(P) ;SO WE RETURN TO MAIN CALLER
PUSH P,T1 ;UNTIL ALL LOADED
IFN FTOVERLAY,<
SKIPE OVERLW ;SEEN /OVERLAY?
SKIPL LNKMAX ;AND STILL IN ROOT?
JRST PRGTST ;NO
TDO FL,[L.LIB,,R.LIB] ;FORCE LIBRARY SEARCH MODE
HLRZ P4,MNTYPE ;[1256] GET MAIN PROCESSOR TYPE
JUMPN P4,LIBOVL ;[1256] IS THERE ONE?
MOVE T1,LIBPRC ;[1256] NO - GET THE LIST OF ONES USED
ANDCM T1,NOLIBS ;[1256] BUT NOT THE ONES ELIMINATED
JFFO T1,.+1 ;[1256] FIND THE NUMBER OF THE FIRST ONE
MOVE P4,T2 ;[1256] PUT IT AS ARG FOR QREENT
LIBOVL: ;[1256]
PUSHJ P,QREENT ;WANT REENTRANT VERSION?
CAIA ;NO, LOAD AS IS
TRO FL,R.FLS ;YES, FORCE LOW SEG
MOVEI T2,F.LEN ;GET SPACE
PUSHJ P,DY.GET## ;FOR FILE SPEC
MOVSI T3,'SYS' ;DEFAULT DEVICE
MOVE T4,['OVRLAY'] ;FILE NAME
DSTORE T3,F.DEV(T1),F.NAME(T1)
MOVSI T3,'REL'
SETOM F.NAMM(T1) ;SET MASK
HLLOM T3,F.EXT(T1)
PUSHJ P,LNKPRG ;PUT IN LIST
; JRST PRGTST
>
PRGTST: SKIPG PRGPTR ;ANYTHING TO DO HERE
JRST LIBTST ;NO, SEE IF ANY LIBRARIES
TDZ FL,[L.LIB,,R.LIB] ;INCASE WE WERE IN SEARCH MODE
PUSH P,P1 ;NEED AN ACC
MOVE P1,PRGPTR ;GET START
PRGTS1: SKIPGE (P1) ;WANT THIS ONE?
JRST PRGTS2 ;NO, ALREADY LOADED
MOVEI T2,F.LEN ;GET SPACE FOR DATA BLOCK
PUSHJ P,DY.GET##
MOVE T2,P1 ;GET POINTER TO TYPE 16 BLOCK
PUSHJ P,PRGLIB ;TRANSFORM AND LINK IN
HRROS (P1) ;MARK AS LOADED
PRGTS2: HRRZ P1,(P1) ;GET NEXT ADDRESS
JUMPN P1,PRGTS1 ;NOT DONE YET IF NON-ZERO
HRROS PRGPTR ;MARK WHOLE LIST DONE
POP P,P1
PUSHJ P,NXTLIB ;SETUP RETURN ADDRESS
JRST PRGTST ;SEE IF WE LOADED ANY MORE TYPE 16 BLOCKS
LIBTST: SKIPN LIBPTR ;ANY LIBRARIES
JRST USETST ;NO TRY USER DEFAULT LIBRARY(S)
SKIPN USYM ;YES, BUT ANY NEED FOR THEM
JRST REMLIB ;NO REMOVE THE SPACE THEY OCCUPY
TDO FL,[L.LIB,,R.LIB] ;GET INTO LIBRARY SEARCH MODE
MOVEI T2,F.LEN ;GET SPACE FOR DATA BLOCK
PUSHJ P,DY.GET##
MOVE T2,LIBPTR ;GET POINTER TO TYPE 17 BLOCK
PUSHJ P,PRGLIB ;TRANSFORM AND LINK IN
MOVE T1,LIBPTR ;GET POINTER BACK
MOVE T2,(T1) ;GET NEXT ADDRESS
MOVEM T2,LIBPTR ;AND STORE IT (ZERO IS END)
MOVEI T2,4 ;GIVE BACK BLOCK
PUSHJ P,DY.RET##
SKIPN LIBPTR ;NOT DONE YET IF NON-ZERO
PUSHJ P,NXTLIB
JRST PRGTST ;INCASE WE LOADED ANY MORE TYPE 16 OR 17
;HERE FOR USER DEFINED DEFAULT LIBRARIES
USETST: SKIPE USYM ;ANY UNDEFS LEFT?
SKIPG USEPTR ;ANY LIBRARIES
JRST DEFTST ;NO, TRY SYSTEM DEFAULTS
HRROS USEPTR ;ONLY ONCE THOUGH
PUSH P,P1 ;NEED A SAFE ACC
MOVE P1,USEPTR ;TO HOLD PTR TO LIST
USETS1: MOVE T1,1(P1) ;[1315] GET LANGUAGE TYPE BITS
TDNN T1,PROCSN ;HAVE WE LOADED THIS TYPE?
JRST USETS3 ;NO, GIVE IT A MISS
USETS2: MOVEI T2,F.LEN ;SPACE WE NEED
PUSHJ P,DY.GET## ;FOR LOOKUP BLOCK
ADDI T2,-1(T1) ;END OF BLT
MOVEI T3,2(T1) ;BYPASS FIRST 2 WORDS
HRLI T3,2(P1) ;BLT PTR
BLT T3,(T2) ;MOVE TO TEMP BLOCK
PUSHJ P,LNKPRG ;PUT IN LIST
USETS3: HRRZ P1,(P1) ;GET NEXT
JUMPN P1,USETS1 ;DO IT
POP P,P1
TDO FL,[L.LIB,,R.LIB] ;[613] MAKE SURE IN /SEARCH MODE
PUSHJ P,NXTLIB ;[613] LOAD THE USER LIBRARIES
; JRST DEFTST ;NOW FOR SYSTEM DEFAULT LIBS
DEFTST: SKIPN USYM ;ANYTHING TO DO?
JRST DEFXIT ;NO, RETURN TO LNKOV1 OR LNKLOD
TDO FL,[L.LIB,,R.LIB] ;MAKE SURE
PUSHJ P,DEFLOD ;YES, TRY DEFAULT LIBS
PUSHJ P,NXTLIB
SKIPG PRGPTR ;SEE IF WE LOADED ANYMORE 16
SKIPE LIBPTR ;OR 17 BLOCKS
JRST PRGTST ;YES, CYCLE AGAIN
SKIPE LIBPRC ;DID WE LOAD ANYTHING?
JRST DEFTST ;YES, TRY AGAIN
MOVX W1,PT.SGN!PT.SYM ;FLAGS
MOVE W2,['%OWN '] ;SYMBOL
SETZ W3, ;TRY AGAIN FOR %OWN
PUSHJ P,TRYSYM##
CAIA ;NOT IN TABLE
JRST DEFOWN ;UNDEFINED
DEFXIT: SETZM GOTO ;BACK TO NORMAL SCANNING
HRRZS USEPTR ;BACK AS IT WAS
TPOPJ: POP P,T1 ;REMOVE TOP RETURN
POPJ P, ;RETURN TO REAL CALLER
DEFOWN: MOVE W3,%OWN ;GET BASE
PUSHJ P,SY.GS## ;DEFINE
JRST DEFXIT
NXTLIB: POP P,GOTO ;STORE RETURN ADDRESS
JRST LNKWLD ;AND LOAD THIS
PRGLIB: DGET T3,<R.DEV(T2)>,<R.NAM(T2)> ;GET DEV & FILE NAME
DSTORE T3,F.DEV(T1),F.NAME(T1)
SETOM F.NAMM(T1) ;SET MASK
MOVE T3,R.EXT(T2) ;GET USER EXTENSION
HLLOM T3,F.EXT(T1) ;STORE WITH -1 MASK
MOVX T4,FX.DIR ;[672] BIT THAT SAYS DIR SPECIFIED
MOVEM T4,F.MODM(T1) ;[672] SAY TO LOOK AT IT
SKIPE T3,R.PPN(T2) ;[672] GET PPN, IF ANY
MOVEM T4,F.MOD(T1) ;[672] THERE WAS, REMEMBER IT
MOVEM T3,F.DIR(T1)
SETOM F.DIRM(T1) ;MUST MATCH EXACTLY
HRLI T2,-5 ;SET UP TO COPY ANY SFD'S
MOVE T4,T1
PRGSFD: SKIPN T3,R.SFD(T2) ;ANY MORE THERE?
JRST LNKPRG ;NO...WE'RE DONE
MOVEM T3,F.SFD(T4) ;STORE THE SFD
SETOM F.SFDM(T4) ;MUST MATCH EXACTLY
ADDI T4,2 ;SFD'S COME IN BIWORDS FOR SCAN
AOBJN T2,PRGSFD ;LOOP FOR ALL SFD'S
;NOW TO LINK INTO LIST
LNKPRG: SKIPN F.INZR ;FIRST TIME?
JRST FSTPRG ;YES
MOVE T2,F.NXZR ;GET CURRENT
MOVEM T1,(T2) ;STORE FORWARD POINTER
MOVEM T1,F.NXZR ;AND POINT TO IT
POPJ P,
FSTPRG: MOVEM T1,F.INZR ;SET FIRST POINTER
MOVEM T1,F.NXZR ;AND CURRENT
POPJ P,
DEFLOD: MOVE T1,NOLIBS ;GET MASK OF PROCESSORS NOT TO LOOK AT
ANDCAM T1,LIBPRC
SKIPE @GS.LB ;LOAD JOBDAT UNLESS LOADED ORIGINALLY BY DEFAULT
JRST DEFLD2 ; OR IF BEEN THROUGH LOOP ONCE ALREADY
MOVE P1,['JOBDAT']
PUSHJ P,LOAD1 ;LOAD JOBDAT
SETOM @GS.LB ; BUT ONLY ONCE
DEFLD2: HLRZ T1,MNTYPE ;GET COMPILER OF MAIN PROG
JUMPE T1,DEFLD1 ;NO MAIN (MAYBE 2ND TIME ROUND)
MOVE T2,CT.BIT(T1) ;GET CORRESPONDING BIT
ANDCAM T2,LIBPRC ;REMOVE FROM LIST TO LOOK AT
IORM T2,MNSEEN ;[614] A NEW MAIN PROG TYPE SEEN
MOVE P4,T1 ;[2013] PASS COMPILER TYPE TO MAIN PRG PROC
TDNN T2,NOLIBS ;[2013] NOT TO SEARCH THIS LIBRARY?
PUSHJ P,@MNTBL(T1) ;DO WHAT WE HAVE TO FOR IT
DEFLD1: SKIPN T1,LIBPRC ;GET LIST OF OTHER PROCS SEEN
POPJ P, ;ALL DONE
JFFO T1,.+1 ;GET LEADING BIT
MOVE T1,CT.BIT(T2) ;GET BIT
ANDCAM T1,LIBPRC ;CLEAR IT
MOVE P4,T2 ;[1225] PASS COMPILER TYPE TO SUBROUTINE PROC
PUSHJ P,@PRCTBL(T2) ;DO ACTION FOR THIS PROCESSOR
JRST DEFLD1 ;LOOP
;HERE TO SEE IF LIBRARY IS ALREADY REQUESTED
;IF NOT PUT IN LIST OF FILES TO LOAD (IN SEARCH MODE)
;ENTER WITH P1 = SIXBIT \FILE.NAME\
LOAD1: SKIPN T1,F.INZR ;GET BASE OF LIST
JRST LOAD2 ;NO LIST NO REQUESTS YET
CAMN P1,F.NAME(T1) ;ALREADY IN LIST
POPJ P, ;YES JUST RETURN
MOVE T1,F.NXT(T1) ;GET NEXT POINTER
JUMPN T1,.-3 ;TRY IT
LOAD2: MOVEI T2,F.LEN ;GET SPACE
PUSHJ P,DY.GET## ;FOR DATA BLOCK
MOVSI T2,'SYS' ;ALL DEFAULT LIBS LIVE ON SYS (FOR NOW)
MOVEM T2,F.DEV(T1)
MOVEM P1,F.NAME(T1) ;STORE NAME
SETOM F.NAMM(T1) ;SET MASK
MOVSI T2,'REL' ;DEFAULT EXT IS REL
HLLOM T2,F.EXT(T1)
PJRST LNKPRG ;PUT IN LIST AND RETURN
REMLIB: SKIPN T1,LIBPTR ;GET SPACE TO REMOVE
JRST DEFXIT ;ALL DONE
MOVE T2,(T1) ;GET NEXT BLOCK
HRRZM T2,LIBPTR ;RESET POINTER
MOVEI T2,4 ;SIZE OF BLOCK
PUSHJ P,DY.RET## ;GIVE IT BACK
JRST REMLIB ;LOOP
DEFINE X(A,B,C,D)< ;;[1225] ACCOUNT FOR EXTRA ARG
IF1,<
BLOCK 1
>
IF2,<
IFDEF B'.L0,<
EXP B'.L0
>
IFNDEF B'.L0,<
EXP CPOPJ
>>>
;HERE FOR TABLE FOR MAIN COMPILER
XALL
MNTBL: PROCESSORS
;HERE FOR ALL OTHER PROCESSORS SEEN
DEFINE X(A,B,C,D)< ;;[1225] ACCOUNT FOR EXTRA ARG
IF1,<
BLOCK 1
>
IF2,<
IFDEF B'.L1,<
EXP B'.L1
>
IFNDEF B'.L1,<
EXP CPOPJ
>>>
PRCTBL: PROCESSORS
;DEFINE A TABLE OF THE HIGH SEGMENT ORIGIN FOR EACH COMPILER'S OTS, WHEN THE OTS
;IS TO BE BROUGHT IN AT RUNTIME.
DEFINE X(A,B,C,D)< ;;[1225] EXPAND THE OTS ORIGINS
IFB <D>,< ;;[1225] IF NO ORIGIN, JUST SET TO 0
EXP 0 ;NO RUNTIME OTS FOR C
> ;;[1225] ..
IFNB <D>,< ;;[1225] ELSE EXPAND THE ORIGIN
EXP D ;START OF C OTS
> ;;[1225] ..
> ;[1225]
OTSTBL: PROCESSORS ;[1225] GENERATE THE TABLE
SALL
;HERE TO DO SPECIAL ACTION FOR SOME PROCESSORS
FOR.L0: ;[2300]
MOVX P4,CT.FOR ;WE'VE NOW SELECTED FORTRAN'S OTS
PUSHJ P,QREENT ;SEE IF WE WANT REENT OTS
JRST FORL03 ;[1271] NO
MOVX W1,PT.SGN!PT.SYM
MOVE W2,['FOROT%'] ;SPECIAL SYMBOL
MOVEI W3,400000+.JBHDA
;[2025] Set 5A FOROTS origin,
;[2025] this is the last using FOROT%
PUSHJ P,SY.GS## ;DEFINE IT
PUSHJ P,FORL03 ;[1271] PUT FORLIB IN LIST OF LIBRARIES
; ..
;SINCE WE'RE LOADING REENTRANT FOROTS, LOAD SYS:FORLIB/SEGMENT:LOW.
;THIS IS REQUIRED BY FOROTS VERSION 6 AND LATER.
FORL04: MOVE P2,F.NXZR ;[1271] LAST LIBRARY PUT ON LIST
CAMN P1,F.NAME(P2) ;[1200] WAS IT FORLIB?
SKIPE F.SWP(P2) ;[1200] WITH NO SWITCHES YET?
POPJ P, ;[1200] NO, RETURN FROM FOR.L0
MOVEI T2,3 ;[1200] YES, ALLOCATE A SWITCH BLOCK
PUSHJ P,DY.GET## ;[1200] IN DY AREA
MOVEM T1,F.SWP(P2) ;[1200] PUT SWITCH IN FILE BLOCK
HRLZM T2,0(T1) ;[1200] STORE BLOCK SIZE
DMOVE T2,[EXP %SEG%,$SSGLOW] ;[1201] SWITCH AND ARGUMENT
DMOVEM T2,1(T1) ;[1200] STORE IN SWITCH BLOCK
POPJ P, ;[1200] DONE
;DEFINE %SEG%. MUST CALL SWTCHS MACRO.
..SEG==0
DEFINE SWMAC(A,B,C,D,E,F,G,H,I)<
IFIDN <B>,<SEGMENT>,<%SEG%==..SEG>
..SEG==..SEG+1>
SWTCHS ;[1200] LOOK FOR /SEGMENT
;HERE WHEN FORTRAN CODE IS SEEN, BUT NO MAIN PROGRAM.
FOR.L1: PUSHJ P,FORL03 ;[1271] LOAD THE LIBRARY
SKIPE T1,OTSEG ;[1271] GET THE /OTS: SWITCH
CAIE T1,1 ;[1271] /OTS:NONSHAR?
SKIPE HL.S2 ;[1271] NO - HIGH SEG EXIST?
POPJ P, ;[1271] LEAVE IT TWOSEG
PJRST FORL04 ;[1271] MAKE IT /SEG:LOW
FORL03: MOVE P1,['FORLIB'] ;[2300] COMMON LIBRARY
PJRST LOAD1
;HERE WHEN EXTENDED FORTRAN IS SEEN. SAME AS FORTRAN.
XFR.L0==FOR.L0 ;[1203] MAIN PROGRAM ENTRY
XFR.L1==FOR.L1 ;[1203] ANY CODE SEEN ENTRY
C68.L0: ;[1433]
C68.L1: MOVE P1,['LIBOL '] ;[1433]
PJRST LOAD1
C74.L0:
C74.L1: MOVE P1,['C74LIB']
PJRST LOAD1
CBL.L0:
CBL.L1: MOVE P1,['COBLIB']
PJRST LOAD1
ALG.L0: PUSHJ P,QREENT ;SEE IF WE WANT REENT VERSION
JRST ALG.L2 ;NO
MOVX W1,PT.SGN!PT.SYM
MOVE W2,['%SHARE']
SETZ W3,
PUSHJ P,SY.RQ## ;PUT IN REQUEST
ALG.L1: SKIPE LODNAM ;SEE THE MAIN PROGRAM YET?
JRST ALG.L2 ;YES
E$$AMP::.ERR. (MS,,V%L,L%W,S%W,AMP,<ALGOL main program not loaded>) ;[1174]
ALG.L2: MOVE P1,['ALGLIB']
PJRST LOAD1
NLI.L0:
NLI.L1: MOVX W1,PT.SGN!PT.SYM
MOVE W2,['%NELGO'] ;DEFINE SYMBOL
SETZ W3, ;WITH ZERO VALUE
PUSHJ P,SY.RQ## ;PUT IN REQUEST FOR IT
MOVE P1,['LIBNEL'] ;AND SPECIAL LIBRARY
JRST LOAD1 ;NOW LOAD IT
BCL.L0:
BCP.L1: MOVE P1,['BCPLIB']
PJRST LOAD1
SIM.L1: SKIPE LODNAM ;MAIN PROGRAM SEEN YET?
JRST SIM.L0 ;YES
E$$SMP::.ERR. (MS,,V%L,L%W,S%W,SMP,<SIMULA main program not loaded>) ;[1174]
SIM.L0: MOVE P1,['SIMLIB']
PJRST LOAD1
PAS.L0: PUSHJ P,QREENT ;[1435] SEE IF WE WANT REENT OTS
SKIPA W2,['PASOT%'] ;[1435] NO, DEFINE SPECIAL SYMBOL
;[1451] JRST PASL01 ;[1435] YES
JRST [ TLO FL,L.FLS
TRO FL,R.FLS
JRST PASL01 ];[1451] FORCE LIBRARY LOAD TO LOWSEG
MOVX W1,PT.SGN!PT.SYM
SETO W3, ;[1435] GIVE IT A DEFINITE VALUE
PUSHJ P,SY.GS ;[1435] DEFINE IT
PASL01: MOVX W1,PT.SGN!PT.SYM ;[1435]
MOVE W2,['PASDT%'] ;[1435] LOOKUP SPECIAL SYMBOL
SETZ W3, ;[1435] PROBABLY NOT REQUIRED
PUSHJ P,TRYSYM ;[1435]
JRST PASLUK ;[1435] UNKNOWN
JRST PASLUD ;[1435] UNDEFINED
JRST PAS.L1 ;[1435] HERE WHEN PASDT% IS ALREADY DEFINED
;[1435] USER HAS LOADED PASDDT BY HAND, DO NOTHING
;PASDT% IS UNKNOWN, USER DID NOT COMPILE WITH DEBUGGER SWITCH, DO NOT LOAD PASDDT.
;[1435] GIVE ERROR IF /DEB:PAS SEEN
PASLUK: SKIPN PASDFL ;[1435] /DEB:PAS SEEN?
JRST PAS.L1 ;[1435] NO, DO NOTHING
.ERR. (MS,0,V%L,L%W,S%W,PCD,<PASCAL program not compiled with debug switch, PASDDT not loaded>)
JRST PAS.L1 ;[1435] AND CONTINUE
PASLUD:
PAS.L1: MOVE P1,['PASLIB'] ;[1435] LOAD PASCAL LIBRARY
JRST LOAD1 ;[1435]
QREENT:
IFN TOPS20,< ;[2366]
MOVE T1,FXSBIT ;[2224] GET THE SECTION BITS
TDNE T1,[^-1B0] ;[2224] ANY NON-ZERO SECTIONS?
JRST QREEN2 ;[2224] YES
>;[2366] IFN TOPS20
IFE TOPS20,< ;[2366]
MOVE T1,HL.S1 ;[2366] GET THE HIGHEST LOADED
TLNE T1,-1 ;[2366] OUTSIDE OF SECTION ZERO?
JRST QREEN2 ;[2366] YES
>;[2366] IFE TOPS20
MOVE T1,OTSTBL(P4) ;[1225] ARE WE TOO CLOSE TO ORIGIN OF
SUBX T1,LN.OTS ;[1225] OTS IF BROUGHT IN AT RUNTIME?
CAMLE T1,HL.S1 ;[1225] ..
JRST QREEN1 ;[1131] NO--GO TRY FOR SHARABLE RUNTIME OTS
SKIPN HL.S2 ;[574] NON-SHARABLE OTS. HIGH SEG EXIST?
TDO FL,[L.FLS,,R.FLS] ;[574] NO, DON'T START ONE
POPJ P, ;[574] NON-SKIP RETURN
;HERE IF LOW SEG .LT. 128K. CHECK /OTS AND HI SEG EXISTANCE
QREEN1: SKIPE T1,OTSEG ;[574] HAS USER SPECIFIED /OTS?
SOJE T1,CPOPJ ;[574] YES, /OTS:NONSHARABLE?
MOVE T1,SYMSEG ;[1312] GET /SYMSEG
SUBI T1,$SSGHIGH ;[1312] IN CASE /SYMSEG:HIGH
SKIPN NOSYMS ;[1312] DON'T CHECK IF NO SYMBOLS
JUMPE T1,CPOPJ ;[1312] NONSHARABLE IF /SYMSEG:HIGH
HLRZ T1,PRGPDV ;[2224] GET THE PDV KEYWORD
CAIE T1,$SSGHIGH ;[2224] /PVBLOCK:HIGH?
SKIPE HL.S2 ;[1225] NO, GREAT. HIGH SEG EXIST YET?
POPJ P, ;[1225] YES--MUST LOAD OTS
MOVE T1,OTSTBL(P4) ;[1225] NO--GET OTS AT RUNTIME--MAKE SURE SYMBOL
SUBI T1,1 ;[1225] DOESN'T GROW INTO RUNTIME OTS BY
SKIPN SYMLIM ;[1225] FORCING /UPTO: JUST UNDER IT (UNLESS
MOVEM T1,SYMLIM ;[1225] USER SPECIFIED DIFFERENT /UPTO:)
JRST CPOPJ1 ;[1225] ALLOW GETSEG AT RUNTIME
;[2224] Here if non-zero sections
QREEN2: SKIPE T1,OTSEG ;[2224] Has user specified /OTS?
SOJE T1,CPOPJ ;[2224] Yes, /OTS:NONSHARABLE?
JRST CPOPJ1 ;[2224] No, re-entrant ots
SUBTTL COMMON I/O ROUTINES
;THESE ROUTINES POP OFF THE RETURN AND GO TO LODNXT ON EOF.
D.IN2:: PUSHJ P,D.IN1 ;GET A WORD
MOVE W2,W1 ;IN W2
D.IN1:: SOSGE DCBUF+2 ;ANYTHING IN BUFFER?
JRST D.INP ;NO DO INPUT
ILDB W1,DCBUF+1 ;GET NEXT WORD
POPJ P,
D.INP:: SKIPN DCBUF ;IF 0 THEN READING FROM CORE
JRST FXRED1 ;GET NEXT BUFFER
PUSHJ P,D.CNT ;[1101] DO IN UUO AND COUNT BLOCK
JRST D.IN1 ;AND RETURN
D.ERR::
IFE TOPS20,<
STATZ DC,IO.EOF ;EOF?
> ;[1402] IFE TOPS20
IFN TOPS20,<
SKIPG RFLEN
> ;[1402] IFN TOPS20
JRST EOF ;YES
E01EIF::
IFE TOPS20,<
PUSH P,[DC] ;[1174] SAVE CHANNEL FOR LNKLOG
.ERR. (ST,0,V%L,L%F,S%F,EIF) ;[1174]
> ;[1402] IFE TOPS20
IFN TOPS20,<
PUSHJ P,JSERR## ;[2301] SET UP THE JSYS ERROR
.ERR. (MS,.EC,V%L,L%F,S%F,EIF)
.ETC. (FSP,.EC,,,,DC) ;[2301]
.ETC. (NLN,.EC) ;[2301] NEW LINE FOR ERROR TEXT
.ETC. (STR,,,,,ERRJSY) ;[2301] TYPE ERSTR% TEXT
> ;[1402] IFN TOPS20
;THESE ROUTINES ARE LIKE THE CORRESPONDING D.IN? ROUTINES, EXCEPT
;THAT THEY RETURN CPOPJ1 WITH DATA OR CPOPJ ON EOF FROM REL FILE.
D.RED2::PUSHJ P,D.RED1 ;GET A WORD
POPJ P, ;NONE TO GET
MOVE W2,W1 ;SAVE IN W2
D.RED1::SOSGE DCBUF+2 ;ANYTHING IN BUFFER?
JRST D.READ ;NO, GO GET ANOTHER BUFFER
ILDB W1,DCBUF+1 ;YES, GET THE NEXT DATA WORD
JRST CPOPJ1 ;AND RETURN IT
D.READ::SKIPN DCBUF ;READING FROM CORE?
JRST FXRED2 ;YES, GO GET NEXT BUFFER
PUSHJ P,D.CNT ;[1101] DO IN UUO AND COUNT BLOCK #
JRST D.RED1 ;THAT WAS EASY
IFE TOPS20,<
STATZ DC,IO.EOF ;EOF?
> ;[1402] IFE TOPS20
IFN TOPS20,<
SKIPG RFLEN
> ;[1402] IFN TOPS20
POPJ P, ;YES.
JRST D.ERR ;NO, INPUT ERROR
;
IFE TOPS20,<
;THIS ROUTINE DOES AN IN UUO AND KEEPS TRACK OF THE CURRENT BLOCK
;NUMBER. BLOCK NUMBER IS RELATIVE (LIKE USETI) ON DISK, ABSOLUTE
;ON DTA.
;RETURNS +1 IF IN UUO WORKED, +2 IF FAILED (LIKE IN UUO DOES).
;DESTROYS W1 ONLY.
D.CNT:: SKIPN DTAFLG ;[1467] READING FROM DECtape?
JRST D.CNT2 ;[1101] NO, JUST AOS THE COUNT FOR DISK
;HERE ON DECtape
SKIPGE LSTBLK ;[1101] IS THIS THE FIRST IN FROM DTA?
JRST D.CNT1 ;[1101] YES, MUST GET THE BLOCK DIFFERENTLY
MOVE W1,DCBUF ;[1101] NORMAL CASE, GET PTR TO NEXT
LDB W1,[POINT 18,1(W1),17] ;[1101] OUT OF OLD BUFFER
MOVEM W1,LSTBLK ;[1101] STORE IN LSTBLK
JRST D.CNT3 ;[1101] SKIP DISK'S AOS, GO DO IN UUO
;HERE ON FIRST IN FROM DECtape. GET FIRST BLOCK NUMBER FROM LOOKUP
D.CNT1: LDB W1,[POINT 10,FEXT,35] ;[1101] ON FIRST IN,
MOVEM W1,LSTBLK ;[1101] GET FROM LOOKUP BLOCK
JRST D.CNT3 ;[1101] GO DO IN UUO
;HERE ON DISK
D.CNT2: AOS LSTBLK ;[1101] ON DISK, JUST AOS LSTBLK
D.CNT3: IN DC, ;[1101] DO THE IN UUO
POPJ P, ;[1101] SUCCESS, RETURN
JRST CPOPJ1 ;[1101] IN UUO SKIPPED, PROPOGATE IT
> ;[1402] IFE TOPS20
IFN TOPS20,<
;
; THIS ROUTINE MAPS THE REL FILE TO A BUFFER SEVERAL PAGES AT A TIME.
; CURRENT FILE PAGE IS KEPT IN LSTBLK.
; COUNT OF BYTES LEFT IN FILE IS KEPT IN RFLEN
; WHEN RFLEN GOES NEGATIVE END OF FILE HAS BEEN SEEN.
; DCBUF+1 ( BUFFER BYTE POINTER ) AND DCBUF+2 ( BUFFER LENGTH ) ARE SET UP.
; T1,T2 AND T3 ARE USED BUT PRESERVED.
; RETURNS +1 IF ALL OK, +2 IF PMAP FAILED OR END-OF-FILE ON ENTRY.
;[2366] NOTE THAT THIS BUILDS A 444400 STYLE BYTE POINTER, WHICH IS NOT
;[2366] THE SAME AS THE TOPS-10 IN UUO. IF THIS IS CHANGED HERE, CODE
;[2366] IN X160B2 IN LNKNEW WILL ALSO HAVE TO BE CHANGED.
D.CNT:: ;[1467]
SKIPGE RFLEN ;END OF FILE ENCOUNTERED ALREADY?
JRST CPOPJ1 ; +2 RETURN
SPUSH <T1,T2,T3> ;WE'LL NEED THE TEMPS
MOVE T1,DCBUF ;PICK UP BUFFER BEGINNING
MOVE T2,T1 ; T2 GETS PAGE #
LSH T2,-9
HLL T1,[POINT 36,0] ;AND RESET BUFFER BYTE POINTER
MOVEM T1,DCBUF+1
HRLI T2,.FHSLF ;PROCESS IS SELF
HRL T1,DC.JF ;PICK UP FILE JFN
HRR T1,LSTBLK ;AND CURRENT FILE BLOCK
MOVE T3,[PM%CNT!PM%RD!PM%PLD!<LN.BF_-9>]
PMAP%
ERJMP [ SPOP <T3,T2,T1> ; RESTORE TEMPS
JRST CPOPJ1 ; AND PROPAGATE ERROR
]
MOVEI T1,<LN.BF_-9> ; INCREMENT CURRENT FILE BLOCK
ADDM T1,LSTBLK
MOVEI T1,LN.BF ;
MOVEM T1,DCBUF+2 ; RESET BUFFER BYTE COUNT
MOVE T2,RFLEN ; DECREMENT FILE BYTE COUNT
CAMGE T2,T1 ; IF LESS THAN A BUFFERFUL IS LEFT
MOVEM T2,DCBUF+2 ; SAY SO
SUB T2,T1
MOVEM T2,RFLEN
SPOP <T3,T2,T1> ; RESTORE TEMPS
POPJ P,
> ;[1402] IFN TOPS20
IFN TOPS20,<
RDSKP::
; RDSKP
; Call:
; MOVEI T1,<target page>
; PUSHJ P,RDSKP
;
; Action:
; Moves the rel file buffer to encompass the target page,
; enabling one to skip intermediate pages.
; Saves all registers, modifies RFLEN and LSTBLK.
SPUSH <T2,T3> ;SAVE ACS FOR SCRATCH USE
MOVE T2,LSTBLK ;T2: BUFFER'S END
SETZM T3 ;T3: COUNTER
RDSKP1: CAMG T2,T1 ;BUFFER INCLUDES TARGET PAGE?
JRST [ MOVEI T2,<LN.BF_-9>(T2)
MOVEI T3,LN.BF(T3)
JRST RDSKP1 ]
MOVEI T2,-<LN.BF_-9>(T2)
MOVEI T3,-LN.BF(T3) ;BACKUP
CAML T3,RFLEN ;PAST END OF FILE?
JRST [ SPOP <T3,T2>
JRST CPOPJ1 ] ;PROPAGATE ERROR SKIP
MOVNS T3 ;-COUNT
ADDM T3,RFLEN ;FUDGE COUNT
MOVEM T2,LSTBLK ;FUDGE BUFFER'S END
SPOP <T3,T2> ;RESTORE ACS
PUSHJ P,D.CNT ;AND CALL THE READER
JRST CPOPJ ;PROPAGATE SUCCESS
JRST CPOPJ1 ; OR FAILURE
; END OF RDSKP
> ;[1402] IFN TOPS20
EOF::
TRZE FL,R.LOD ;ENS BLOCK SEEN?
PUSHJ P,E$$NEB ;[1174] NO GIVE WARNING
POP P,(P) ;POP OFF RETURN
EOF1:: SKIPE XBUF ;USING INDEXED LIBRARY
PUSHJ P,ZXBUF ;YES, GET RID OF IT
IFN TOPS20,<
SPUSH <T1,T2,T3> ;SET REGISTERS ASIDE
MOVE T2,DCBUF ;PICK UP BUFFER PTR
LSH T2,-9 ;MAKE IT A PAGE
MOVEI T1,DC ;PICK UP CHANNEL POINTER
MOVEM T1,IO.CHN ;FOR DVCLS.
HRLI T2,.FHSLF
MOVE T3,[PM%CNT!<LN.BF_-9>]
SETOM T1
PMAP ;LET GO THE MAPPED PAGES
SETZM RFLEN ;[1402] ZERO OUT PAGES
PUSHJ P,DVCLS.## ;AND CLOSE THE ASSOCIATED FILE
SPOP <T3,T2,T1> ;RESTORE REGS
> ; [1402] IFN TOPS20
JRST LODNXT ;GET NEXT FILE
E$$NEB::.ERR. (MS,.EC,V%L,L%W,S%W,NEB,<No end block seen>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
MOVEI R,1 ;NOW TRY TO FIXUP RELOC TABLES
MOVE R,@RC.TB ;DO LOW SEG FIRST
MOVE T1,RC.HL(R) ;HIGHEST LOC SEEN
CAMLE T1,RC.CV(R) ;GREATER THAN CURRENT?
MOVEM T1,RC.CV(R) ;STORE HIGHEST
MOVEI R,2 ;NO FOR HIGH SEGMENT
SKIPN R,@RC.TB
JRST CPOPJ ;NO HIGH SEG
MOVE T1,RC.HL(R) ;HIGHEST LOC SEEN
CAMLE T1,RC.CV(R) ;GREATER THAN CURRENT?
MOVEM T1,RC.CV(R) ;STORE HIGHEST
SETZM LOD37 ;[1114] DONE WITH COBOL SYMBOLS
SETZM OWNLNG ;[1114] AND ALGOL OWNS
; SETZM VARLNG ;[1114] AND LVARS
POPJ P,
;HERE TO REMOVE XBUF (FAKE BUFFER USED FOR LIBRARY INDEX)
ZXBUF:: HRRZ T1,XBUF ;ADDRESS IN CORE
MOVEI T2,^D128 ;SIZE
SETZM XBUF ;DONE WITH IT NOW
PJRST DY.RET## ;GIVE SPACE BACK AND RETURN
IFN DEBSW,<
$LOCATION:: 0 ;STORE ADDRESS TO BREAK ON
$SYMBOL:: 0 ;STORE 6BIT SYMBOL TO BREAK ON
>
SUBTTL THE END
LITLOD: END LNKLOD