github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-28 17:09:15 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/link/lnklod.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

4598 lines
163 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE LNKLOD - LOAD MODULE FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/JBC/RKH/JNG/DCE/MCHC/DZN/PAH/PY/HD/RJF 5-Feb-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==2417 ;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.
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
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
Reference in New Issue View Git Blame Copy Permalink