CONSTSTRING (63) LOADVSN=" ** Loader 44B 02/11/83 ** " CONSTINTEGER TRUE=1,FALSE=0 ! !*********************************************************************** !* * !* Conditional compilation constants * !* * !*********************************************************************** ! CONSTINTEGER NEWCONNECT = 0; ! Set this non-zero to work with the ! new CONNECT mechanism. CONSTINTEGER STUDENTSS=0; ! Zero for standard ss, non zero for student ss. ! !********************************************************************************************* !* * !* EEEEEEE MM MM AAA SSSS 22222 9999 00000 00000 * !* E M M M M A A S 2 9 9 0 0 0 0 0 0 * !* EEEE M M M AAAAAAA SSS 22222 999 9 0 0 0 0 0 0 * !* E M M A A S 2 9 0 0 0 0 0 0 * !* EEEEEEE M M A A SSSS 22222 9 00000 00000 * !* L OOOOOOO AAA DDDDD EEEEEEE RRRRRR * !* L O O A A D D E R R * !* L O O AAAAAAA D D EEEE RRRRRR * !* L O O A A D D E R R * !* LLLLLLL OOOOOOO A A DDDDD EEEEEEE R R * !* * !********************************************************************************************* ! ! ! IMPORTANT NOTE. Throughout this code LOADLEVEL refers to the global ! load level of the process. LOCLL (occasionally LL) refers to the local ! load level relevant to the code currently being executed. The two can ! sometimes differ since if an item has to be 'permanently loaded' the ! local load level will switch temporarily to 0. ! Almost all conditions in the loader are tested against 0 (FALSE) ! if possible for efficiency even at the expense of a certain unnaturalness ! in readability. Please do the necessary mental processing! ! C.McC. ! INCLUDE "SS0302S_SSOWNF" ! !*********************************************************************** !* * !* Record formats * !* * !*********************************************************************** ! RECORDFORMAT ADDF(STRING (31) FILE, C (INTEGER MAINEP,DUM1 OR INTEGER GLAFROM,GLATO)) RECORDFORMAT ATMODEF(HALFINTEGER FLAGS, BYTEINTEGER PADS,SPARE,LINELIM,PAGE, C BYTEINTEGERARRAY TABS(1:8), BYTEINTEGER CR,ESC,DEL,CAN, C PROMPT,END, HALFINTEGER FLAGS2,SPARE2,SPARE3, C BYTEINTEGER SCREED1,SCREED2,SCREED3,SCREED4,SCREED5,SCREED6) RECORDFORMAT BREFF(INTEGER FIRST,LAST,LINK) {Basic rec} RECORDFORMAT CONTF(INTEGER DATAEND,DATASTART,PSIZE,FILETYPE, C SUM,DATETIME,SPARE1,SPARE2,MARK,NULL1,UGLA,ASTK,USTK, C NULL2,ITWIDTH,LDELIM,RDELIM,JOURNAL,SEARCHDIRCOUNT, C ARRAYDIAG,INITWORKSIZE,SPARE,ITINSIZE,ITOUTSIZE, C NOBL,ISTK, LONGINTEGER INITPARMS, INTEGER DATAECHO, C TERMINAL,I23,I24,I25,I26,I27,I28,I29,I30,I31,I32, C STRING (31) FSTARTFILE,BSTARTFILE,PRELOADFILE,MODDIR, C CFAULTS,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15, C S16,S17,S18,S19,S20,S21,S22,S23,S24,S25,S26,S27, C S28,S29,S30,S31,S32, STRING (31)ARRAY SEARCHDIR(1:16)) RECORDFORMAT DHF(INTEGER DATAEND, DATASTART, SIZE, FILETYPE, C DATE, TIME, PSTART, SPARE) RECORDFORMAT DIRINFF(STRING (6) USER, STRING (31) BATCHFILE, C INTEGER MARK,FSYS,PROCNO,ISUFF,REASON,BATCHID,SESSICLIM, C SCIDENSAD,SCIDENS,OPERNO,AIOSTAT,SCDATE, C SYNC1DEST,SYNC2DEST,ASYNCDEST,AACCTREC,AICREVS, C STRING (15) BATCHIDEN, STRING (31) BASEFILE, INTEGER PREVIC, C INTEGER ITADDR0,ITADDR1,ITADDR2,ITADDR3,ITADDR4, C STREAMID,DIDENT,SCARCITY,PREEMPTAT, STRING (11) SPOOLRFILE, C INTEGER RESUNITS,SESSLEN,PRIORITY,DECKS,DRIVES,PARTCLOSE, C RECORD (ATMODEF) TMODES, INTEGER PSLOT, STRING (63) ITADDR, C INTEGERARRAY FCLOSING(0:3), INTEGER CLO FES,UEND) ! FCLOSING is a bit-array (0:99). Bit N is set if the operators had ! done D/CLOSE FSYS N <time> at the moment when the process was started. ! CLO FES is used in the same way to indicate 'FE closing' if the ! operators had done D/CLOSE FE N <time>. PART CLOSE is non-zero ! only if the process was started in the last seven minutes before ! a partial close-down. ! %RECORDFORMAT DUFFGLAF(%INTEGER FROM,TO) RECORDFORMAT ENTF(INTEGER TYPE, (INTEGER DR0,DR1 OR INTEGER MAINEP, C DUM1 OR INTEGER GLAFROM,GLATO OR INTEGER USECOUNT,ACCESSMODE), C INTEGER LINK){Entry point or filename records} RECORDFORMAT ESCF(INTEGER PC,RECAD, (INTEGER DR0,DR1 OR INTEGER DESCAD,ENTAD)) RECORDFORMAT FINDF(STRING (31) FILE, INTEGER DIRNO,TYPE,STATUS) RECORDFORMAT FINDGLAF(STRING (31) FILE, INTEGER FROM,TO,GLASTART) RECORDFORMAT IREFF(INTEGER DR0,DR1, (INTEGER OFFSET OR INTEGER ADYNR), C INTEGER LINK) {Info rec} RECORDFORMAT LD1F(INTEGER LINK,LOC, STRING (31) IDEN) RECORDFORMAT LD4F(INTEGER LINK,DISP,L,A, STRING (31) IDEN) RECORDFORMAT LD7F(INTEGER LINK,REFLOC, STRING (31) IDEN) { Also 8,11} RECORDFORMAT LD9F(INTEGER LINK,REFARRAY,L, STRING (31) IDEN) RECORDFORMAT LD13F(INTEGER LINK,A,DISP,LEN,REP,ADDR) RECORDFORMAT LD14F(INTEGER LINK,N) ! %RECORDFORMAT LD14F(%INTEGER LINK,N, %RECORD(RELOCF)%ARRAY R(1:N)) ! %RECORDFORMAT LLINFOF(%INTEGER TAB,GLA,ISTK) RECORDFORMAT LNF(BYTEINTEGER TYPE, STRING (6) NAME, C INTEGER REST,POINT,DR1) RECORDFORMAT NAMEF(BYTEINTEGER TYPE, C (STRING (10) NAME OR STRING (6) LNAME, INTEGER REST), C INTEGER POINT) RECORDFORMAT OFMF(INTEGER START,L,PROP) ! %RECORDFORMAT RELOCF(%INTEGER AREALOC,BASELOC) RECORDFORMAT RF(INTEGER CONAD,FILETYPE,DATASTART,DATAEND) ! %RECORDFORMAT SCTABF(%STRING(31) NAME, %INTEGER I,J) ! %RECORDFORMAT SDIRF(%STRING(31) NAME, %INTEGER CONAD,TYPE) {While old/new} ! %RECORDFORMAT SDIRF(%STRING(31)NAME, %INTEGER CONAD) ! %RECORDFORMAT SSLF(%INTEGER START,LEN) ! !*********************************************************************** !* * !* Constants * !* * !*********************************************************************** ! CONSTBYTEINTEGERARRAY UNSHAREDAREA(1:5)=3,2,5,6,7 ! CONSTINTEGER ABASEOBJ=X'00800020' CONSTINTEGER CMN=X'80000000',DYN=X'40000000',UNSAT=X'20000000',UNRES=X'10000000' CONSTINTEGER DYNAMIC=0,UNRESOLVED=1,UNSATISFIED=2 CONSTINTEGER FNAMETYPE=0,DATA=1,CODE=2,MACRO=4,ALIAS=8 CONSTINTEGER FORTE=2 CONSTINTEGER K64=X'10000' CONSTINTEGER LHOFFSET=1008 {251<<2 bytes of listheads} CONSTINTEGER MAXFINDREC=128 CONSTINTEGER MAXLOADTABSIZE=X'00100000'; ! 1Mb CONSTINTEGER MAXUGLASIZE=X'00400000'; ! Max size of user gla CONSTINTEGER PRIME=251 CONSTINTEGER SEGSIZE=X'40000' CONSTINTEGER SEGSHIFT=18 CONSTINTEGER SSBSTACKSEG=4; ! Segment no of base stack CONSTINTEGER SSCHARFILETYPE=3 CONSTINTEGER SSDATAFILETYPE=4 CONSTINTEGER SSDIRFILETYPE=7 CONSTINTEGER SSOLDDIRFILETYPE=2 CONSTINTEGER SSOBJFILETYPE=1 CONSTINTEGER USTACKCONAD=X'02F80000'; ! Fixed address for user stack ! CONSTINTEGERARRAYFORMAT LHF(0:PRIME) ! CONSTLONGINTEGER CODEDR=X'E100000000000000' CONSTLONGINTEGER DESCDR=X'B100000000000000' CONSTLONGINTEGER ESCDR=X'E500000000000000' CONSTLONGINTEGER NOTUSED=X'8282828282828282' ! CONSTRECORD (SCTABF)ARRAYFORMAT SCTABAF(1:200) ! CONSTSTRING (7) ASTACKNAME="T#ASTK" CONSTSTRING (23) BASEDIR="SUBSYS.SYSTEM_BASEDIR" CONSTSTRING (4) LASTFN="}{|~"; ! This can be used instead of a file name ! as a parameter to CONNECT, etc., to mean "the last file I nominated". CONSTSTRING (11) LOADTABLES="T#LOAD" CONSTSTRING (7) UGLANAME="T#UGLA" CONSTSTRING (15) USEROOT="USEFOR fails - " CONSTSTRING (7) USTACKNAME="T#USTK" ! CONSTSTRING (7)ARRAY AREANAME(1:7)= C "CODE","GLA ","PLT ","SST ","UST ","ICMN","ISTK" CONSTSTRING (11)ARRAY MODLANG(0:10)= C "unknown","IMP/IMP80","FORTE","IOPT","NASS","ALGOL","Opt code","PASCAL","SIMULA", "BCPL","FORTRAN 77" ! !*********************************************************************** !* * !* %SYSTEM Routine/fn/map spec * !* * !*********************************************************************** ! SYSTEMINTEGERFNSPEC CHECKCOMMAND(STRING (255) COM) SYSTEMINTEGERFNSPEC PARMAP SYSTEMINTEGERFNSPEC PSTOI(STRING (63) S) ! SYSTEMLONGREALFNSPEC CPUTIME ! SYSTEMROUTINESPEC ALLOWINTERRUPTS SYSTEMROUTINESPEC CHANGEACCESS(STRING (31) FILE, C INTEGER MODE, INTEGERNAME FLAG) SYSTEMROUTINESPEC CHANGEFILESIZE(STRING (31) FILE, C INTEGER NEWSIZE, INTEGERNAME FLAG) SYSTEMROUTINESPEC CONNECT(STRING (31) S, C INTEGER MODE, HOLE, PROT, RECORD (RF)NAME R, INTEGERNAME FLAG) SYSTEMROUTINESPEC DESTROY(STRING (31) FILE, INTEGERNAME FLAG) SYSTEMROUTINESPEC DISCONNECT(STRING (31) FILE, INTEGERNAME FLAG) SYSTEMROUTINESPEC DUMP(INTEGER FROM,TO) SYSTEMROUTINESPEC FILL(INTEGER LEN,FROM,FILLER) SYSTEMROUTINESPEC FILPS(STRINGNAME DPF,S) SYSTEMROUTINESPEC MOVE(INTEGER L, FROM, TO) SYSTEMROUTINESPEC NDIAG(INTEGER PC,LNB,FAULT,INF) SYSTEMROUTINESPEC OUTFILE(STRING (31) S, C INTEGER L, MAXB, USE, INTEGERNAME CONAD, FLAG) SYSTEMROUTINESPEC PSYSMES(INTEGER ROOT,FLAG) SYSTEMROUTINESPEC SETPAR(STRING (255) S) SYSTEMROUTINESPEC SETUSE(STRING (31) FILE, INTEGER MODE,VALUE) SYSTEMROUTINESPEC SIGNAL(INTEGER EP,P1,P2, INTEGERNAME FLAG) SYSTEMROUTINESPEC SSTRACE(NAME FNRESULT, STRING (63) TMPL) SYSTEMROUTINESPEC UCTRANSLATE(INTEGER AD,LEN) ! SYSTEMSTRINGFNSPEC CONFILE(INTEGER AD) SYSTEMSTRINGFNSPEC FAILUREMESSAGE(INTEGER I) SYSTEMSTRING (8)FNSPEC HTOS(INTEGER VALUE,PLACES) SYSTEMSTRINGFNSPEC ITOS(INTEGER I) SYSTEMSTRINGFNSPEC NEXTTEMP SYSTEMSTRINGFNSPEC SEGSINUSE(INTEGERNAME FIRSTSEG,LASTSEG, INTEGER SEGSTART) SYSTEMSTRINGFNSPEC SPAR(INTEGER I) ! !*********************************************************************** !* * !* External/internal routine/fn/map specs * !* * !*********************************************************************** ! EXTERNALINTEGERFNSPEC DNEWOUTWARDCALL(INTEGER NEWACR,EMAS, C NEWSTACKSEG,DR0,DR1, INTEGERNAME I,J) EXTERNALINTEGERFNSPEC OUTPOS EXTERNALINTEGERFNSPEC OUTSTREAM EXTERNALINTEGERFNSPEC UINFI(INTEGER I) ! EXTERNALROUTINESPEC CHANGECONTEXT ! %EXTERNALROUTINESPEC DPRINTSTRING(%STRING(255) S) EXTERNALROUTINESPEC DSTOP(INTEGER REASON) ! !*********************************************************************** !* * !* Own variables * !* * !*********************************************************************** ! ! %OWNINTEGER DYNDATAPC ! %OWNINTEGER DYNPC ! %OWNINTEGER EUDR0,EUDR1 ! %OWNINTEGER LANG ! %OWNINTEGER LOADERGLA ! %OWNINTEGER MACRODR0=0,MACRODR1=0 ! %OWNINTEGER MAINDR1=0 ! %OWNINTEGER MAXUGLA ! %OWNINTEGER MONCONAD ! %OWNINTEGER SSDYNREFAD ! %OWNINTEGER SSTOPADIR ! %OWNINTEGER SSUGLASIZE=X'00010000' ! %OWNINTEGER TEMPISTK ! %OWNINTEGER TOPSCT ! %OWNINTEGER UNSATPC ! %OWNINTEGER USEFORDESCAD=0; ! Descriptor ad used by USEFOR ! %OWNINTEGER USERSTACKLNB=0 ! ! %OWNINTEGERARRAY AREASTART(1:7) {Starting addresses of obj file areas} ! %OWNINTEGERARRAY NEXTAD(1:3) ! %OWNINTEGERARRAY SSLIBERR(1:4) ! ! %OWNINTEGERARRAYNAME RLH,PLH,TLH,SLH ! ! %OWNINTEGERNAME PERMOFFSET {Nextfree in perm entry table - mapped on to SSOWN_NEXTAD(2)} ! %OWNINTEGERNAME RCODE; ! Return code - maps on to SSCOMREG(24) ! %OWNINTEGERNAME TEMPOFFSET { Nextfree in temp entry tables - mapped on to SSOWN_NEXTAD(3)} ! ! %OWNLONGINTEGER DYNDR {S#DYNAMICREF entry desc} ! %OWNLONGINTEGER UNSATDR {S#UNSATREF entry desc} ! ! %OWNLONGREAL MONTIMEBASE=0 ! ! %OWNRECORD(DUFFGLAF)%ARRAY DUFFGLA(0:63)=0(512) ! %OWNRECORD(SDIRF)%ARRAY SSADIR(-1:16) {Search dir list} ! %OWNRECORD(SSLF)%ARRAY SSLOADTAB(0:3) ! ! %OWNRECORD(SCTABF)%ARRAYNAME SCT ! ! %OWNSTRING(31) USEFORLASTNAME="" ! ! %OWNSTRING(31)%ARRAY PARTLOADED(0:2)=""(3) ! !*********************************************************************** !* * !* Extrinsic variables * !* * !*********************************************************************** ! ! %EXTRINSICINTEGER DIRDISCON ! %EXTRINSICINTEGER INITSTACKSIZE ! %EXTRINSICINTEGER LOADMONITOR ! %EXTRINSICINTEGER SSADEFOPT ! %EXTRINSICINTEGER SSASTACKSIZE ! %EXTRINSICINTEGER SSAUXDR0 ! %EXTRINSICINTEGER SSAUXDR1 ! %EXTRINSICINTEGER SSCURAUX ! %EXTRINSICINTEGER SSCURBGLA ! %EXTRINSICINTEGER SSDIRAD ! %EXTRINSICINTEGER SSINHIBIT,SSINTCOUNT; ! These two must stay together ! %EXTRINSICINTEGER SSMAXAUX ! %EXTRINSICINTEGER SSMAXFSIZE ! %EXTRINSICINTEGER SSMAXBGLA ! %EXTRINSICINTEGER SSOPENUSED ! %EXTRINSICINTEGER SSUSTACKSIZE ! %EXTRINSICINTEGER TEMPAVDSET; ! Used by PLU packages ! ! %EXTRINSICINTEGERARRAY SSCOMREG(0:60) ! ! %EXTRINSICSTRING(31) AVD{ACTIVEDIR} ! %EXTRINSICSTRING(40) SSFNAME ! %EXTRINSICSTRING(6) SSOWNER ! !*********************************************************************** !* * !* External variables * !* * !*********************************************************************** ! ! %EXTERNALINTEGER LOADINPROGRESS=0 ! %EXTERNALINTEGER LOADLEVEL=1 ! %EXTERNALINTEGER MONFILEAD=0 ! %EXTERNALINTEGER MONFILETOP ! %EXTERNALINTEGER NOWARNINGS=FALSE; ! Print warning messages by default ! %EXTERNALINTEGER PERMISTK ! %EXTERNALINTEGER USTB=0 ! ! %EXTERNALRECORD(LLINFOF)%ARRAY LLINFO(-1:31)=0(396) ! ! %EXTERNALSTRING(31) MONFILE="" ! ! !*********************************************************************** !* * !* End of declarations * !* * !*********************************************************************** ! ! ROUTINESPEC UNLOAD2(INTEGER LOCLL,FAIL) ! ! ROUTINE TERMINALPRINT(STRING (255) S1,S2) ! Outputs to stream 0 then selects original output stream. ! Used to ensure that load monitoring and messages during the loading ! liable to be done for a dynamic call are written to the console and not ! the current output file. INTEGER CUROUT CUROUT=OUTSTREAM SELECTOUTPUT(0) IF OUTPOS#0 THEN NEWLINE PRINTSTRING(S1) PRINTSTRING(S2) NEWLINE SELECTOUTPUT(CUROUT) RETURN END ; ! OF TERMINALPRINT ! ! SYSTEMROUTINE STOP ! Routine to reset the auxstack and return tidyly in the event ! of a failure INTEGER I IF SSOWN_LOADINPROGRESS#FALSE THEN UNLOAD2(1,1); ! UNLOAD2 resets LOADINPROGRESS IF SSOWN_FULLDUMP#0 THEN SSOWN_FULLDUMP=0 IF SSOWN_SSAUXDR1#0 THEN START INTEGER(SSOWN_SSAUXDR1)=SSOWN_SSCURAUX INTEGER(SSOWN_SSAUXDR1+8)=SSOWN_SSMAXAUX FINISH IF SSOWN_SSCOMREG(36)#0 THEN START I=SSOWN_SSCOMREG(36) *LLN_I *EXIT_0 FINISH DSTOP(105); ! In case comreg(36) not set - hardly likely but still... END ; ! OF STOP ! ! SYSTEMROUTINE RETURN TO COMMAND LEVEL ! Routine to reset the auxstack and return to command level INTEGER I IF SSOWN_USERSTACKLNB=0 THEN STOP IF SSOWN_LOADINPROGRESS#FALSE THEN UNLOAD2(1,1); ! UNLOAD2 resets LOADINPROGRESS IF SSOWN_FULLDUMP#0 THEN SSOWN_FULLDUMP=0 IF SSOWN_SSAUXDR1#0 THEN START INTEGER(SSOWN_SSAUXDR1)=SSOWN_SSCURAUX INTEGER(SSOWN_SSAUXDR1+8)=SSOWN_SSMAXAUX FINISH ! Now get the LNB for command level, reset SSOWN_SSCOMREG(36), load the LNB ! and exit SSOWN_SSCOMREG(36)=SSOWN_USERSTACKLNB I=SSOWN_USERSTACKLNB *LLN_I *EXIT_0 END ; ! OF RETURN TO COMMAND LEVEL ! ! LONGINTEGERFNSPEC CHECKLOADED(STRING (31) ENTRY, C INTEGERNAME TYPE,LISTHEAD) ! SYSTEMROUTINE INITLOADER(INTEGERNAME FLAG) ! Routine is called once from SSINIT at startup time. ! This routine creates the loader tables and adds the system call table ! to the perm loaded table. File is 3 pages initially: 1 for refs, 1 for ! permloaded entries and 1 for temploaded entries. ! LLINFO fields are initialised where possible. INTEGERARRAYNAME RLH,PLH,TLH,SLH RECORD (SCTABF)ARRAYNAME SCT RECORD (DIRINFF)NAME DIRINF LONGINTEGER DESC INTEGER TYPE,LHD,ADIRINF,I ! Map subsystem entry listheads SLH==ARRAY(SSOWN_SSDIRAD+32,LHF) SSOWN_SLH==SLH OUTFILE(LOADTABLES,X'3000',MAXLOADTABSIZE,0,SSOWN_SSLOADTAB(0)_START,FLAG) IF FLAG#0 THEN DSTOP(123); ! Unable to create T#LOAD ! Note that T#LOAD will always be connected at this address. IF NEWCONNECT=0 THEN SETUSE(LOADTABLES,1,0); ! Increment use count INTEGER(SSOWN_SSLOADTAB(0)_START)=X'3000' INTEGER(SSOWN_SSLOADTAB(0)_START+4)=32 SSOWN_SSLOADTAB(0)_LEN=32 SSOWN_SSLOADTAB(1)_START=SSOWN_SSLOADTAB(0)_START+32 SSOWN_SSLOADTAB(1)_LEN=X'1000'-32 SSOWN_SSLOADTAB(2)_START=SSOWN_SSLOADTAB(0)_START+X'1000' SSOWN_SSLOADTAB(2)_LEN=X'1000' SSOWN_SSLOADTAB(3)_START=SSOWN_SSLOADTAB(0)_START+X'2000' SSOWN_SSLOADTAB(3)_LEN=X'1000' SSOWN_PERMOFFSET==SSOWN_NEXTAD(2) SSOWN_TEMPOFFSET==SSOWN_NEXTAD(3) SSOWN_NEXTAD(I)=LHOFFSET FOR I=3,-1,1 ! Fill ref table with X'82' FILL(SSOWN_SSLOADTAB(1)_LEN-LHOFFSET,SSOWN_SSLOADTAB(1)_START+LHOFFSET,X'82') ! Initialise LLINFO ! LLINFO(-1) holds the starting values of the perm items. SSOWN_LLINFO(0)_TAB=SSOWN_PERMOFFSET SSOWN_LLINFO(-1)_TAB=SSOWN_PERMOFFSET SSOWN_LLINFO(1)_TAB=SSOWN_TEMPOFFSET ! LLINFO(0)_GLA initialised by INITDYNAMICREFS ! LLINFO(0)_ISTK and LLINFO(1)_ISTK initialised by INITUSTK ! LLINFO(1)_GLA initialised by GETGLA RLH==ARRAY(SSOWN_SSLOADTAB(1)_START,LHF) PLH==ARRAY(SSOWN_SSLOADTAB(2)_START,LHF) TLH==ARRAY(SSOWN_SSLOADTAB(3)_START,LHF) SSOWN_RLH==RLH SSOWN_PLH==PLH SSOWN_TLH==TLH ! Map on to system call list ADIRINF=UINFI(10) DIRINF==RECORD(ADIRINF) SCT==ARRAY(DIRINF_SCIDENSAD,SCTABAF) SSOWN_SCT==SCT SSOWN_TOPSCT=DIRINF_SCIDENS ! TYPE=CODE LHD=-1 DESC=CHECKLOADED("S#ENTERONUSERSTACK",TYPE,LHD) LONGINTEGER(ADDR(SSOWN_EUDR0))=DESC LHD=-1 DESC=CHECKLOADED("S#ICLMATHSERRORROUTINE",TYPE,LHD) LONGINTEGER(ADDR(SSOWN_SSLIBERR(1)))=DESC SSOWN_SSCOMREG(13)=ADDR(SSOWN_SSLIBERR(1)); ! Needed by BASIC SSOWN_SSCOMREG(58)=ADDR(SSOWN_MAINDR1); ! Needed by COBOL run RETURN END ; ! OF INITLOADER ! ! ROUTINE INITUSTK ! SYSTEM Routine eventually ! Initialises the user stack and sets up pointers to the initialised ! stack reserved areas INTEGER FLAG,I SSOWN_USTB=USTACKCONAD OUTFILE(USTACKNAME,SSOWN_SSUSTACKSIZE,0,X'40',SSOWN_USTB,FLAG) IF FLAG#0 THEN START SSOWN_USTB=0 TERMINALPRINT("Unable to create USERSTACK - ",FAILUREMESSAGE(FLAG)) RETURN TO COMMAND LEVEL FINISH IF NEWCONNECT=0 THEN SETUSE(USTACKNAME,1,0); ! Inc use count SSOWN_TEMPISTK=SSOWN_USTB+32 SSOWN_PERMISTK=SSOWN_USTB+SSOWN_INITSTACKSIZE INTEGER(SSOWN_USTB)=SSOWN_INITSTACKSIZE!4; ! To make sure new stack starts on odd word SSOWN_LLINFO(-1)_ISTK=SSOWN_PERMISTK; ! Base value if loader tabs reset SSOWN_LLINFO(0)_ISTK=SSOWN_PERMISTK SSOWN_LLINFO(I)_ISTK=SSOWN_TEMPISTK FOR I=SSOWN_LOADLEVEL,-1,1; ! In case LOADLEVEL>1 ! **Comment** The trouble with this approach is that there may be a lot ! of paging between initialised and normal user stack but its the only way ! of easily implementing 'permanently loaded' ISTK. Perhaps worth thinking ! about though. RETURN END ; ! OF INITUSTK ! ! ROUTINE INITAUXSTACK ! Initialises the auxiliary stack. INTEGER FLAG OUTFILE(ASTACKNAME,SSOWN_SSASTACKSIZE,SSOWN_SSASTACKSIZE,0,SSOWN_SSAUXDR1,FLAG) IF FLAG#0 THEN TERMINALPRINT("Create AUXSTACK fails - ", C FAILUREMESSAGE(FLAG)) AND RETURN TO COMMAND LEVEL IF NEWCONNECT=0 THEN SETUSE(ASTACKNAME,1,0) SSOWN_SSMAXAUX=SSOWN_SSAUXDR1+SSOWN_SSASTACKSIZE SSOWN_SSCURAUX=SSOWN_SSAUXDR1+32 INTEGER(SSOWN_SSAUXDR1)=SSOWN_SSCURAUX INTEGER(SSOWN_SSAUXDR1+8)=SSOWN_SSMAXAUX SSOWN_SSAUXDR0=X'28000000'!(SSOWN_SSASTACKSIZE>>2); ! Word vector descriptor SSOWN_SSCOMREG(41)=ADDR(SSOWN_SSAUXDR0) RETURN END ; ! OF INITAUXSTACK ! ! INTEGERFNSPEC HASH(STRING (31) ENTRY, INTEGER HASHCONST) ROUTINESPEC ADDREF(STRING (31) ENTRY, INTEGERNAME FLAG, C INTEGER DR0,AD,TYPE,STATUS,LOCLL,POS,NREFS) ! SYSTEMROUTINE INITDYNAMICREFS ! Called by SSINIT at startup time. ! This routine has two functions - ! 1. Sets up code and branches to handle dynamic and unresolved refs ! from user programs ! 2. Deal with dynamic refs within the subsystem itself. INTEGERARRAYFORMAT LDATAAF(0:15) INTEGERARRAYNAME LDATA RECORD (LD7F)NAME LD8 INTEGER I,PC,LSTART,ABGLA,AD,LHD,FLAG,TYPE,REFLOC ! Get DYNPC and SSOWN_UNSATPC. Need these before can call ADDREF *JLK_3 *J_<DYNREF> *LSS_TOS ; ! TOS now contains addr of jump to DYNREF *ST_PC SSOWN_DYNPC=PC; ! To ensure accessing %OWN does not have unexpected effect *JLK_3 *J_<DYNDATAREF> *LSS_TOS *ST_PC SSOWN_DYNDATAPC=PC *JLK_3 *J_<UNSATREF> *LSS_TOS *ST_PC SSOWN_UNSATPC=PC ! ! Now get entry descriptors of S#DYNAMIC and S#UNSATREF TYPE=CODE LHD=-1 SSOWN_DYNDR=CHECKLOADED("S#DYNAMICREF",TYPE,LHD) LHD=-1 SSOWN_UNSATDR=CHECKLOADED("S#UNSATREF",TYPE,LHD) ! Deal with subsystem dynamic refs SSOWN_DYNREFSTART=SSOWN_SSCURBGLA LSTART=ABASEOBJ+INTEGER(ABASEOBJ+24); ! Load data LDATA==ARRAY(LSTART,LDATAAF) I=LDATA(8); ! Dynamic refs listhead ! ABGLA=ABASEFILE+((INTEGER(ABASEFILE)+X'0003FFFF')&X'FFFC0000') ! ABGLA=SSOWN_SSCURBGLA&X'FFFC0000'; ! Start of BGLA ABGLA=ABASEOBJ+INTEGER(ABASEOBJ+INTEGER(ABASEOBJ+28)+16) SSOWN_AREASTART(1)=ABGLA; ! Dummy to fool ADDREF AD=ADDR(REFLOC); ! Ditto WHILE I#0 CYCLE LD8==RECORD(ABASEOBJ+I) REFLOC=(LD8_REFLOC&X'00FFFFFF')!X'01000000'; ! Dummy REFLOC LHD=HASH(LD8_IDEN,PRIME) ADDREF(LD8_IDEN,FLAG,0,AD,CODE,DYNAMIC,0,LHD,1) IF FLAG>0 THEN DSTOP(125); ! Failure adding subsystem dynamic refs to T#LOAD I=LD8_LINK REPEAT SSOWN_LLINFO(0)_GLA=SSOWN_SSCURBGLA SSOWN_LLINFO(-1)_GLA=SSOWN_SSCURBGLA SSOWN_DYNREFEND=SSOWN_SSCURBGLA; ! So that a call of RESETLOADER can restore ! the subsys dynamic refs. Only ss dynamic refs will have ! SSOWN_DYNREFSTART<=R2_ADYNR<OWN_SSDYNREFEND ! Note that SSOWN_DYNREFEND and SSOWN_LLINFO(-1)_GLA are not necessarily ! always the same. Student subsystems tinker with LLINFO(-1) later. RETURN ; ! End of initialisation sequence ! ! Come here on escape jump from user prog for dynamic code refs DYNREF: ! Preserve environment for eventual call. For an external call then ! the only registers that have to be saved are LNB and PSR (also ! sprach PDS). The DR register contains the address of the escape table. ! At DR+8 we have ! the address of the location in the gla where the code descriptor has ! to go. In certain situations, unusual but not that unusual, the location ! in the gla may already be fixed up while there is an escape descriptor ! to the same item on the stack. When this happens it is likely that the ! reference will already have been removed from the reference tables so ! that the call to DYNAMICREF will produce gibberish at best. What must be ! done here is to compare the escape descriptor and the descriptor at ! the intended fix up location. If these are not the same then load the ! descriptor at the fix up location into ACC and jump to the post call ! code for the normal situation. ! If the descriptors are both escape then proceed thus: ! We must get DYNDR or UNSATDR into the DR register. These have known ! addresses by virtue of their positions in the SSOWN record, so after stacking ! the params to S#DYNAMICREF or S#UNSATREF we construct a descriptor to ! DYNDR or UNSATDR and haul it out of SSOWN on to the stack from whence ! we load it into %DR then call the routine. ! So begin by saving what has to be saved *STLN_TOS ; ! Store LNB *CPSR_TOS ; ! Copy PM,CC,ACS to TOS ! Compare address fields of escape descriptor and descriptor at ref address *LCT_(DR +8); ! Load address of fix up location *CYD_0; ! Copy escape descriptor to ACC *STUH_B ; ! Throw away descriptor, decrement ACS *UCP_(CTB +1); ! Logical compare with address field at fix up locn *JCC_8,<EQUAL> ! If here then ref already fixed up *LSD_(CTB ); ! Load ACC with code descriptor from fixed up loc *J_<POSTCALL> ! Normal sequence EQUAL: *PRCL_4; ! Prepare for call *STD_TOS ; ! Use escape desc as params to S#DYNAMICREF *LD_X'3000000100100000'; ! Descriptor to SSOWN_DYNDR *LSD_(DR ); ! Get DYNDR into the ACC *ST_TOS ; ! Stack it *LD_TOS ; ! Load DR with desc to S#DYNAMICREF *RALN_7; ! Raise LNB to SF-7 *CALL_(DR ); ! Call S#DYNAMICREF ! Now if we couldn't find the ref then we won't return here from ! S#DYNAMICREF. The fact that we have means the descriptor is in the ! ACC as the %RESULT of S#DYNAMICREF POSTCALL: *ST_TOS *LD_TOS ; ! DR now contains entry desc, now restore environment *MPSR_TOS ; ! This resets ACS *LLN_TOS *ESEX_0; ! Resume processing ! DYNDATAREF: ! Come here on encountering a dynamic data ref ! Must preserve whole environment when handling dynamic data refs ! WARNING. Certain types of data ref are accessed via XNB so the ! escape sequence would never be encountered - e.g. %extrinsic record fields. ! However for most simple data refs this sequence will be executed. *STLN_TOS ; ! Store LNB *ST_TOS ; ! Store ACC - length depends on ACS *STB_TOS ; ! Store B *CPSR_B ; ! Copy PM,CC,ACS to B *ADB_16; ! Set bit 27(ICL) for MPSR to restore ACS *STB_TOS ; ! And stack it *STXN_TOS ; ! Store XNB *STCT_TOS ; ! Store CTB *PRCL_4; ! Prepare for call *STD_TOS ; ! Use escape desc as params to S#DYNAMICREF *LD_X'3000000100100000'; ! Descriptor to DYNDR *LSD_(DR ); ! Get DYNDR into ACC *ST_TOS ; ! Stack it *LD_TOS ; ! Load DR with descriptor to S#DYNAMICREF *RALN_7; ! Raise LNB to SF-7 *CALL_(DR ); ! Call S#DYNAMICREF ! Descriptor req is in ACC after call *ST_TOS *LD_TOS ; ! DR now contains data descriptor required ! Restore environment *LCT_TOS *LXN_TOS *MPSR_TOS ; ! This resets ACS *LB_TOS *L_TOS *LLN_TOS *ESEX_0; ! Resume processing ! UNSATREF: ! Get PC of unresolved ref then call S#UNSATREF ! No return from S#UNSATREF ! Get UNSATDR *LSS_TOS ; ! PC of failing routine *PRCL_4 *STD_TOS ; ! DR0,DR1 params for S#UNSATREF *ST_TOS ; ! PC param for S#UNSATREF *LD_X'3000000100100008'; ! Descriptor to UNSATDR *LSD_(DR ); ! Get UNSATDR into ACC *ST_TOS ; ! Stack it *LD_TOS ; ! Load DR with desc for S#UNSATREF *RALN_8 *CALL_(DR ); ! Call S#UNSATREF END ; ! OF INITDYNAMICREF ! ! INTEGERFN DYNLOAD ! Result is TRUE if LOADPARM MIN set RESULT =SSOWN_SSCOMREG(39)&1 END ; ! OF DYNLOAD ! ! INTEGERFN LET ! Result#0 if LOADPARM LET is set RESULT =SSOWN_SSCOMREG(39)&2 END ; ! OF LET ! ! SYSTEMINTEGERFN CURRENTLL ! Result is the current value of the overall LOADLEVEL RESULT =SSOWN_LOADLEVEL END ; ! OF CURRENTLL ! ! SYSTEMINTEGERFN CURSTACK ! Result is 0 if running on base stack, else 1 INTEGER LNB *STLN_LNB IF LNB>>SEGSHIFT=SSBSTACKSEG THEN RESULT =0 ELSE RESULT =1 END ; ! OF CURSTACK ! ! ROUTINE MONFAIL(INTEGER FLAG) ! Called if load monitoring to a file fails. TERMINALPRINT("Load monitoring to file ".SSOWN_MONFILE." fails - ", C FAILUREMESSAGE(FLAG)." Monitor switched to terminal.") SSOWN_MONFILE="" SSOWN_MONFILEAD=0 SSOWN_MONFILETOP=0 RETURN END ; ! OF MONFAIL ! ! ROUTINE MONOUT(STRING (255) S) LONGREAL TIM RECORD (RF) RR STRING (11) STIM INTEGER L1,L2,AD,I,J,VMHOLEOK,FLAG IF SSOWN_MONTIMEBASE=0 THEN SSOWN_MONTIMEBASE=CPUTIME TIM=CPUTIME-SSOWN_MONTIMEBASE ! Turn TIM into suitable string for output. STIM=ITOS(INTPT(FRACPT(TIM)*1000)) STIM="0".STIM WHILE LENGTH(STIM)<3 STIM=ITOS(INTPT(TIM)).".".STIM." " TERMINAL OUTPUT: IF SSOWN_MONFILE="" THEN TERMINALPRINT(STIM,S) AND RETURN ! If here then ouputting direct to file L1=LENGTH(STIM) L2=LENGTH(S) ! Is there room in MONFILE for STIM+S+newline? IF SSOWN_MONFILEAD+L1+L2+1>=SSOWN_MONFILETOP THEN START IF SSOWN_MONFILEAD=0 THEN START ! Create it. OUTFILE(SSOWN_MONFILE,X'1000',0,0,SSOWN_MONCONAD,FLAG) IF FLAG#0 THEN START MONFAIL(FLAG) ->TERMINAL OUTPUT FINISH IF NEWCONNECT=0 THEN SETUSE(SSOWN_MONFILE,1,0) SSOWN_MONFILEAD=X'20' SSOWN_MONFILETOP=X'1000' FINISH ELSE START IF SSOWN_MONFILETOP&X'3FFFF'=0 THEN VMHOLEOK=FALSE ELSE VMHOLEOK=TRUE ! Try to extend the file ! If MONFILETOP is segment aligned then DISCONNECT ! MONFILE since we may need a bigger VM hole. IF VMHOLEOK=FALSE THEN START IF NEWCONNECT=0 THEN SETUSE(SSOWN_MONFILE,-1,0) DISCONNECT(SSOWN_MONFILE,FLAG) IF FLAG#0 THEN START MONFAIL(FLAG) ->TERMINAL OUTPUT FINISH FINISH SSOWN_MONFILETOP=SSOWN_MONFILETOP+X'1000' CHANGEFILESIZE(SSOWN_MONFILE,SSOWN_MONFILETOP,FLAG) IF FLAG#0 THEN START MONFAIL(FLAG) ->TERMINAL OUTPUT FINISH IF NEWCONNECT=0 THEN SETUSE(SSOWN_MONFILE,1,0) IF VMHOLEOK=FALSE THEN START CONNECT(SSOWN_MONFILE,3,0,0,RR,FLAG) IF FLAG#0 THEN START MONFAIL(FLAG) ->TERMINAL OUTPUT FINISH SSOWN_MONCONAD=RR_CONAD FINISH INTEGER(SSOWN_MONCONAD+8)=SSOWN_MONFILETOP; ! Update header file size FINISH FINISH ! Put the new entry into MONFILE J=SSOWN_MONCONAD+SSOWN_MONFILEAD AD=ADDR(STIM) FOR I=1,1,L1 CYCLE BYTEINTEGER(J)=BYTEINTEGER(AD+I) J=J+1 REPEAT AD=ADDR(S) FOR I=1,1,L2 CYCLE BYTEINTEGER(J)=BYTEINTEGER(AD+I) J=J+1 REPEAT BYTEINTEGER(J)=X'0A' SSOWN_MONFILEAD=SSOWN_MONFILEAD+L1+L2+1 INTEGER(SSOWN_MONCONAD)=SSOWN_MONFILEAD; ! Update file header DATAEND field RETURN END ; ! OF MONOUT ! ! INTEGERFN INITHASH(STRING (31) NAME) INTEGER A,J,L,A1,A2 A=ADDR(NAME) L=BYTEINTEGER(A) IF L>8 THEN START ! Close up last 4 to first 4 A1=A+5 A2=A+L-3 BYTEINTEGER(A1+J)=BYTEINTEGER(A2+J) FOR J=3,-1,0 FINISH ELSE NAME=NAME."<>#@!+&" RESULT =BYTEINTEGER(A+1)*71+BYTEINTEGER(A+2)*47+BYTEINTEGER(A+3)*97+ C BYTEINTEGER(A+4)*79+BYTEINTEGER(A+5)*29+BYTEINTEGER(A+6)*37+ C BYTEINTEGER(A+7)*53+BYTEINTEGER(A+8)*59 END ; ! OF INITHASH ! ! INTEGERFN HASH(STRING (31) NAME, INTEGER HASHCONST) INTEGER A,J,W,L,A1,A2 A=ADDR(NAME) L=BYTEINTEGER(A) IF L>8 THEN START ! Close up last 4 to first 4 A1=A+5 A2=A+L-3 BYTEINTEGER(A1+J)=BYTEINTEGER(A2+J) FOR J=3,-1,0 FINISH ELSE NAME=NAME."<>#@!+&" W=BYTEINTEGER(A+1)*71+BYTEINTEGER(A+2)*47+BYTEINTEGER(A+3)*97+ C BYTEINTEGER(A+4)*79+BYTEINTEGER(A+5)*29+BYTEINTEGER(A+6)*37+ C BYTEINTEGER(A+7)*53+BYTEINTEGER(A+8)*59 RESULT =W-(W//HASHCONST)*HASHCONST END ; ! OF HASH ! ! INTEGERFN OLDHASH(STRING (31) NAME, INTEGER HASHCONST) ! TEMPORARY while old directories still valid INTEGER RES, A, B, C, D, E, F, G, H, I, J, K !A-K ALL NEEDED STRING(ADDR(A)) = NAME."<>12ABXY89*" RES = A!!B>>4!!C RESULT = (RES-RES//HASHCONST*HASHCONST) END ; ! OF OLDHASH ! ! ROUTINE CONNDIRS ! Routine rebuilds loader search list. Activated when DIRDISCON#0 ! ROUTINE CONDIR(STRING (31) FILE) INTEGER FLAG RECORD (RF) RR ! Connect a file. Check it's a directory. ! Add it to list of directories in SSADIR. ! Increment count in SSOWN_SSTOPADIR. ! TEMPORARILY accepts old and new style directories CONNECT(FILE,1,0,0,RR,FLAG) IF FLAG=218 AND FILE=SSOWN_AVD{ACTIVEDIR} THEN START ! There is no ACTIVE DIR so leave hole SSOWN_SSADIR(SSOWN_SSTOPADIR)=0 SSOWN_SSTOPADIR=SSOWN_SSTOPADIR+1 RETURN FINISH IF FLAG=0 AND SSOLDDIRFILETYPE#RR_FILETYPE#SSDIRFILETYPE THEN START IF NEWCONNECT#0 THEN DISCONNECT (LASTFN, FLAG) FLAG=267 SSOWN_SSFNAME=FILE; ! Not a directory FINISH IF FLAG#0=SSOWN_NOWARNINGS THEN TERMINALPRINT("*Warning - Connect directory fails - ", C FAILUREMESSAGE(FLAG)) AND NEWLINE AND RETURN IF SSOWN_SSTOPADIR>0 AND RR_CONAD=SSOWN_SSADIR(-1)_CONAD THEN START IF NEWCONNECT#0 THEN SETUSE (LASTFN, -1, 0) RETURN FINISH ! SEARCHDIR=ACTIVEDIR so ignore SEARCHDIR IF NEWCONNECT=0 THEN SETUSE(FILE,1,0) SSOWN_SSTOPADIR = SSOWN_SSTOPADIR+1 SSOWN_SSADIR(SSOWN_SSTOPADIR)_NAME=FILE SSOWN_SSADIR(SSOWN_SSTOPADIR)_CONAD=RR_CONAD SSOWN_SSADIR(SSOWN_SSTOPADIR)_TYPE=RR_FILETYPE RETURN END ; ! OF CONDIR ! INTEGER I,FLAG RECORD (CONTF)NAME C RECORD (RF) RR SETUSE(SSOWN_SSADIR(I)_NAME,-1,0) FOR I=SSOWN_SSTOPADIR,-1,-1 ! Reduce use counts on old directory list SSOWN_SSTOPADIR=-2; ! Forget all previously known directories. CONNECT(SSOWN_OPTIONSFILE,1,0,0,RR,FLAG) ! %IF FLAG#0 %THEN RR_CONAD=SSOWN_SSADEFOPT %ELSE SETUSE(SSOWN_OPTIONSFILE,1,0) IF FLAG#0 THEN RR_CONAD=SSOWN_SSADEFOPT; ! Meantime C==RECORD(RR_CONAD) IF SSOWN_TEMPAVDSET=0 THEN SSOWN_AVD=C_MODDIR; ! In case updated by other than OPTION CONDIR(SSOWN_AVD{ACTIVEDIR}); ! Yes it's that CONDIR moment.......sorry! CONDIR(BASEDIR); ! Subsystem base directory ! Don't search searchdirs if temp active dir in use IF SSOWN_TEMPAVDSET=0 START I=0 WHILE I<C_SEARCHDIRCOUNT CYCLE I=I+1 CONDIR(C_SEARCHDIR(I)) REPEAT FINISH SSOWN_DIRDISCON = 0; ! Search list rebuilt RETURN END ; ! OF CONNDIRS ! ! SYSTEMROUTINE BDIRLIST CONNDIRS; ! Rebuild searchlist SSOWN_DIRDISCON=0 RETURN END ; ! OF BDIRLIST ! ! SYSTEMROUTINE TEMPDIR(STRING (31) FILE, INTEGERNAME FLAG) ! Copies FILE into T#DIR then nominates T#DIR as active dir till return ! to command level RECORD (RF) RR INTEGER CONAD CONNECT(FILE,1,0,0,RR,FLAG) RETURN IF FLAG#0 IF SSOLDDIRFILETYPE#RR_FILETYPE#SSDIRFILETYPE THEN START DISCONNECT (LASTFN, FLAG) SSOWN_SSFNAME=FILE FLAG=267 RETURN FINISH OUTFILE("T#DIR",RR_DATAEND,0,0,CONAD,FLAG) RETURN IF FLAG#0 ! Now make copy MOVE(RR_DATAEND,RR_CONAD,CONAD) IF NEWCONNECT#0 THEN START SETUSE (LASTFN, -1, 0) SETUSE (FILE, -1, 0) FINISH SSOWN_AVD{ACTIVEDIR}="T#DIR" SSOWN_TEMPAVDSET=1 SSOWN_SSOPENUSED=1; ! To ensure TIDYFILES called CONNDIRS; ! Rebuild search list RETURN END ; ! OF TEMPDIR ! ! !*********************************************************************** !* * !* LOADER SEARCH MODULE * !* * !*********************************************************************** ! ! LONGINTEGERFN SEARCHSUBSYS(STRING (31) ENTRY, INTEGERNAME TYPE, C INTEGER LISTHEAD) INTEGER POINT,LEN,LENE LONGINTEGER RES IF SSOWN_SLH(LISTHEAD)=0 THEN START ; ! Nothing on chain RES=0 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"SNIR") RESULT =0 FINISH POINT=SSOWN_SLH(LISTHEAD)+SSOWN_SSDIRAD; ! Address of first item off listhead WHILE STRING(POINT)#"" CYCLE LEN=BYTEINTEGER(POINT) LENE=(LEN+9)&X'FFFFFFF8'; ! Bytes of name IF STRING(POINT)=ENTRY AND BYTEINTEGER(POINT+LEN+1)&TYPE#0 THEN START TYPE=BYTEINTEGER(POINT+LEN+1) RES=LONGINTEGER(POINT+LENE) IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"SNIr") RESULT =RES FINISH POINT=POINT+LENE+8 REPEAT RES=0 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"SNIR") RESULT =0; ! Not there END ; ! OF SEARCHSUBSYS ! ! LONGINTEGERFN SEARCHSCL(STRING (31) ENTRY, INTEGERNAME TYPE) ! Search Director's system call list. This list is ordered alphabetically ! so use binary chop. Note that all entries are of type CODE so return ! unless definitely looking for CODE type entries. LONGINTEGER SCDR INTEGER LO,HI,I IF TYPE&CODE=0 THEN START SCDR=0 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(SCDR,"SNR") RESULT =0 FINISH LO=1 HI=SSOWN_TOPSCT WHILE LO<=HI CYCLE I=(LO+HI)>>1 IF SSOWN_SCT(I)_NAME=ENTRY THEN START TYPE=CODE SCDR=X'E3000000'!SSOWN_SCT(I)_I SCDR=(SCDR<<32)!SSOWN_SCT(I)_J IF SSOWN_DIAGMON&1#0 THEN SSTRACE(SCDR,"SNr") RESULT =SCDR FINISH IF SSOWN_SCT(I)_NAME>ENTRY THEN HI=I-1 ELSE LO=I+1 REPEAT SCDR=0 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(SCDR,"SNR") RESULT =0; ! Not found END ; ! OF SEARCHSCL ! ! LONGINTEGERFN SEARCHLOADED(STRING (31) ENTRY, INTEGERNAME TYPE, C INTEGER LISTHEAD) RECORD (ENTF)NAME ENT LONGINTEGER DESC INTEGER I,START,J,RECAD,LENE,XTYPE FOR I=2,1,3 CYCLE START=SSOWN_SSLOADTAB(I)_START IF I=2 THEN J=SSOWN_PLH(LISTHEAD) ELSE J=SSOWN_TLH(LISTHEAD) WHILE J>0 CYCLE RECAD=START+J LENE=(BYTEINTEGER(RECAD)+4)&X'FFFFFFFC' ENT==RECORD(RECAD+LENE) XTYPE=ENT_TYPE&X'1FFFFFFF'; ! Off special entry bits IF STRING(RECAD)=ENTRY AND (XTYPE&TYPE#0 OR TYPE=0) THEN START IF TYPE=0 THEN START ! Filename search IF SSOWN_MAINDR1=0 AND ENT_MAINEP#0 THEN SSOWN_MAINDR1=ENT_MAINEP DESC=1 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(DESC,"SNIR") RESULT =1; ! i.e. TRUE - the file is loaded FINISH ELSE START TYPE=XTYPE DESC=ENT_DR0 DESC=(DESC<<32)!ENT_DR1 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(DESC,"SNIr") RESULT =DESC FINISH FINISH J=ENT_LINK REPEAT REPEAT DESC=0 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(DESC,"SNIR") RESULT =0; ! Not there END ; ! OF SEARCHLOADED ! ! LONGINTEGERFN CHECKLOADED(STRING (31) ENTRY, INTEGERNAME TYPE,LISTHEAD) ! Search currently loaded material for ENTRY. LISTHEAD will be <0 if it ! is not already known. LONGINTEGER DESC IF LISTHEAD<0 THEN LISTHEAD=HASH(ENTRY,PRIME) DESC=SEARCHSUBSYS(ENTRY,TYPE,LISTHEAD) IF DESC=0 THEN DESC=SEARCHSCL(ENTRY,TYPE) IF DESC=0 THEN DESC=SEARCHLOADED(ENTRY,TYPE,LISTHEAD) IF SSOWN_DIAGMON&1#0 THEN SSTRACE(DESC,"SNNr") RESULT =DESC END ; ! OF CHECKLOADED ! ! SYSTEMLONGINTEGERFN LOOKLOADED(STRING (31) ENTRY, INTEGERNAME TYPE) ! Checks all currently loaded material for ENTRY INTEGER LHD LHD=-1 RESULT =CHECKLOADED(ENTRY,TYPE,LHD) END ; ! OF LOOKLOADED ! ! STRINGFN SEARCHDIR(STRING (31) ENTRY, INTEGER CONAD,IHASH, C INTEGERNAME TYPE) ! This function searches a directory connected at CONAD for entry ! ENTRY. Result is the name of a file containing the entry if TYPE ! is any of CODE, DATA or MACRO, the name of an alias for ENTRY ! if found and null if ENTRY is not found. ! TYPE found (if any) is returned to the calling routine. INTEGER P,HASHCONST,PSTART,HSTART,LEN,INITPOS RECORD (DHF)NAME DH RECORD (NAMEF)ARRAYFORMAT HAF(0:99999) RECORD (NAMEF)ARRAYNAME H STRING (31) PART1,PART2,RES DH==RECORD(CONAD) HASHCONST=INTEGER(CONAD+DH_DATASTART) PSTART=CONAD+DH_PSTART HSTART=CONAD+DH_DATASTART+4 H==ARRAY(HSTART,HAF) INITPOS=IHASH-(IHASH//HASHCONST)*HASHCONST; ! Start looking here. LEN=LENGTH(ENTRY) IF LEN>10 THEN START PART1=SUBSTRING(ENTRY,1,6) PART2=SUBSTRING(ENTRY,7,LEN) FINISH ELSE START PART1=ENTRY PART2="" FINISH P=INITPOS RES="" CYCLE IF H(P)_NAME="" THEN EXIT ; ! Not there IF H(P)_NAME=PART1 AND (H(P)_TYPE&ALIAS#0 OR C H(P)_TYPE&TYPE#0 ) THEN START ; ! It's looking good ! So it's either an alias or an item of the type ! looked for. Check for long name as well. IF (H(P)_TYPE&X'80'=0 AND PART2="") OR C ((H(P)_TYPE&X'80'#0 AND PART2#"") AND C PART2=STRING(PSTART+H(P)_REST)) THEN START ! Found it TYPE=H(P)_TYPE&X'7F' RES=STRING(PSTART+H(P)_POINT) EXIT FINISH FINISH P=P+1 P=0 IF P=HASHCONST EXIT IF P=INITPOS; ! Hash table full and gone right round REPEAT IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"SIINR") RESULT =RES END ; ! OF SEARCHDIR ! ! STRINGFN SEARCHOLDDIR(STRING (31) ENTRY, INTEGERNAME TYPE, C INTEGER CONAD) ! This is a TEMPORARY function to search old-style directories. Remove ! when new-style directories become the standard. ! This function searches a directory connected at CONAD for entry ! ENTRY. Result is the name of a file containing the entry if TYPE ! is any of CODE, DATA or MACRO, the name of an alias for ENTRY ! if found and null if ENTRY is not found. ! N.B. Macros and code entries are indistinguishable in old directories. ! TYPE found (if any) is returned to the calling routine. INTEGER P,HASHCONST,PSTART,HSTART,LEN,INITPOS,OLDTYPE,BOTH RECORD (DHF)NAME DH RECORD (LNF)ARRAYFORMAT HAF(0:99999) RECORD (LNF)ARRAYNAME H STRING (31) PART1,PART2,RES OLDTYPE=TYPE&1; ! CODE,MACRO,ALIAS all 0, DATA=1 ! However this won't cope with a multiple TYPE such as CODE!DATA ! so need to indicate that either is acceptable IF TYPE&1#0#TYPE&X'0000000E' THEN BOTH=TRUE ELSE BOTH=FALSE DH==RECORD(CONAD) HASHCONST=INTEGER(CONAD+DH_DATASTART) PSTART=CONAD+DH_PSTART HSTART=CONAD+DH_DATASTART+4 H==ARRAY(HSTART,HAF) INITPOS=OLDHASH(ENTRY,HASHCONST); ! Start looking here LEN=LENGTH(ENTRY) IF LEN>10 THEN START PART1=SUBSTRING(ENTRY,1,6) PART2=SUBSTRING(ENTRY,7,LEN) FINISH ELSE START PART1=ENTRY PART2="" FINISH P=INITPOS RES="" CYCLE IF H(P)_NAME="" THEN EXIT ; ! Not there IF H(P)_NAME=PART1 AND (H(P)_TYPE&X'7F'=OLDTYPE OR BOTH#FALSE) THEN START ! It's looking good IF (H(P)_TYPE&X'80'=0 AND PART2="") OR C ((H(P)_TYPE&X'80'#0 AND PART2#"") AND C PART2=STRING(PSTART+H(P)_REST)) THEN START ! Found it - make sure type found is o.k. RES=STRING(PSTART+H(P)_POINT) IF H(P)_TYPE&X'7F'=DATA THEN TYPE=DATA ELSE C IF CHARNO(RES,1)='=' THEN TYPE=ALIAS ELSE C IF TYPE&MACRO#0 THEN TYPE=CODE!MACRO ELSE TYPE=CODE EXIT FINISH FINISH P=P+1 P=0 IF P=HASHCONST EXIT IF P=INITPOS; ! Hash table full and gone right round REPEAT IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"SNiR") RESULT =RES END ; ! OF SEARCHOLDDIR ! ! SYSTEMINTEGERFN SEARCH(STRING (31) ENTRY, LONGINTEGERNAME DESC, C STRINGNAME FILE,ACTUALEPNAME, INTEGERNAME TYPE,LOCLL) ! This the loader's main searching routine for the EMAS subsystem. ! Searching is done in the order: ! 1. Subsystem entries ! 2. Privately loaded entries ! 3. Active directory ! 4. Subsystem base directory ! 5. Privately nominated directories RECORDFORMAT DIRF(STRING (31) NAME, INTEGER DIRNO) CONSTINTEGER TOPAHIST=9 RECORD (DIRF)ARRAY AHIST(0:TOPAHIST) STRING (31) RES,LOOKFOR INTEGER FLAG,I,IHASH,K,J,LISTHEAD,XTYPE,NEXTAHIST LONGINTEGER DSC ! ROUTINE PCHAIN(STRING (63) S, INTEGER TOP,DIRNO) INTEGER I SELECTOUTPUT(0) PRINTSTRING(S) PRINTSTRING(" History (reverse order of calling): ") PRINTSTRING(LOOKFOR) SPACES(32-LENGTH(LOOKFOR)) PRINTSTRING(" in ".CONFILE(SSOWN_SSADIR(DIRNO)_CONAD)) NEWLINE FOR I=TOP,-1,0 CYCLE PRINTSTRING(AHIST(I)_NAME) SPACES(32-LENGTH(AHIST(I)_NAME)) PRINTSTRING(" in ".CONFILE(SSOWN_SSADIR(AHIST(I)_DIRNO)_CONAD)) NEWLINE REPEAT RETURN END ; ! OF PCHAIN ! FILE="" NEXTAHIST=0 AHIST(I)=0 FOR I=TOPAHIST,-1,0 LOOKFOR=ENTRY IF SSOWN_LOADMONITOR&8#0 THEN MONOUT( C "Loader search initiated for ".LOOKFOR) CYCLE IF SSOWN_LOADMONITOR&8#0 THEN MONOUT("Looking for ".LOOKFOR) IHASH=INITHASH(LOOKFOR) LISTHEAD=IHASH-(IHASH//PRIME)*PRIME XTYPE=TYPE ! First search system then privately loaded material for the entry DSC=SEARCHSUBSYS(LOOKFOR,XTYPE,LISTHEAD) IF DSC=0 THEN DSC=SEARCHSCL(LOOKFOR,XTYPE) IF DSC=0 THEN DSC=SEARCHLOADED(LOOKFOR,XTYPE,LISTHEAD) IF DSC#0 THEN START ! Found it IF SSOWN_LOADMONITOR&8#0 THEN MONOUT(LOOKFOR." already loaded") ACTUALEPNAME=LOOKFOR DESC=DSC TYPE=XTYPE FLAG=-1 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"Sn2SNNR") RESULT =-1 FINISH !If here then didn't find it already loaded so enter sequence to ! search the directories for the entry. Will a) find it, b) find ! an alias to it, or c) not find it. IF SSOWN_LOADMONITOR&8#0 THEN MONOUT(LOOKFOR." not currently loaded") I=-1; ! 1st directory in search list - i.e. active dir (if present) IF SSOWN_DIRDISCON#0 THEN CONNDIRS; ! Check if rebuild of search list required CYCLE I=I+1 AND CONTINUE IF SSOWN_SSADIR(I)_NAME="" IF SSOWN_LOADMONITOR&8#0 THEN MONOUT("Searching directory ".SSOWN_SSADIR(I)_NAME) IF SSOWN_SSADIR(I)_TYPE=SSDIRFILETYPE THEN C RES=SEARCHDIR(LOOKFOR,SSOWN_SSADIR(I)_CONAD,IHASH,XTYPE) ELSE C RES=SEARCHOLDDIR(LOOKFOR,XTYPE,SSOWN_SSADIR(I)_CONAD); ! TEMP ! RES=SEARCHDIR(LOOKFOR,SSOWN_SSADIR(I)_CONAD,IHASH,XTYPE) IF RES#"" THEN START ! Found it - although it might be an alias IF XTYPE&TYPE#0 THEN START ! Got a file. Set LOCLL to 0 if I=0 i.e. ! if it's in SUBSYS.SYSTEM_BASEDIR so that it's loaded ! on the BASEGLA IF SSOWN_LOADMONITOR&1#0 THEN MONOUT( C LOOKFOR." found in file ".RES) TYPE=XTYPE LOCLL=0 IF I=0 ACTUALEPNAME=LOOKFOR FILE=RES FLAG=0 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"S2SSNNR") RESULT =0 FINISH ! So if here then found an alias RES=SUBSTRING(RES,2,LENGTH(RES)); ! Remove preceding '='. ! Now it is conceivable that this alias could lead to a dead ! end and the item we are actually looking for is in the ! next directory down for example, so to recover from ! this occurrence stack the currently sought for item ! in the next free AHIST record (provided it's not already ! in which case we have a closed loop, or it's a reoccurrence ! of the same lhs of the alias in which case overwrite.). ! Initially always follow the aliases and if dead ends occur ! restore the previous environment one directory down and ! continue similarly until ultimate success or failure. IF NEXTAHIST>TOPAHIST THEN START PCHAIN("Alias chain too long",TOPAHIST,I) FLAG=352 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"S222NNQ") RESULT =352 FINISH ! Check if potential entry is already present K=-1 ! PCHAIN("*DUMP*",NEXTAHIST-1,I) FOR J=0,1,NEXTAHIST CYCLE K=J AND EXIT IF AHIST(J)_NAME=LOOKFOR AND AHIST(J)_DIRNO=I REPEAT IF K>=0 THEN START PCHAIN("Alias loop detected",NEXTAHIST-1,I) FLAG=285 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"S222NNQ") RESULT =285 FINISH ! Add to history chain unless NAME and LOOKFOR are the same ! in which case overwrite NEXTAHIST=NEXTAHIST-1 IF NEXTAHIST>0 AND C LOOKFOR=AHIST(NEXTAHIST-1)_NAME AHIST(NEXTAHIST)_NAME=LOOKFOR AHIST(NEXTAHIST)_DIRNO=I NEXTAHIST=NEXTAHIST+1 IF SSOWN_LOADMONITOR&8#0 THEN MONOUT( C "Alias ".LOOKFOR." = ".RES." found in directory ".SSOWN_SSADIR(I)_NAME) LOOKFOR=RES EXIT ; ! Back to the outer cycle FINISH ELSE START ! Entry not found. Increment I by 1 ! If run out of directories to search then check if any alias ! branches to search. I=I+1 IF I>SSOWN_SSTOPADIR THEN START IF NEXTAHIST=0 OR (NEXTAHIST=1 AND C AHIST(0)_DIRNO=SSOWN_SSTOPADIR) THEN START SSOWN_SSFNAME=LOOKFOR FLAG=289 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"S222NNQ") RESULT =289 ! Not found after complete search. FINISH ! If here then must have branched off at least once to ! follow an alias chain. Restore the item which spawned ! the alias and carry on looking for it in the next dir. NEXTAHIST=NEXTAHIST-1 LOOKFOR=AHIST(NEXTAHIST)_NAME IHASH=INITHASH(LOOKFOR) I=AHIST(NEXTAHIST)_DIRNO+1 IF SSOWN_LOADMONITOR&8#0 THEN MONOUT( C "Alias chain exhausted - restoring ".LOOKFOR." Starting search at ".SSOWN_SSADIR(I)_NAME) FINISH FINISH REPEAT REPEAT END ; ! OF SEARCH ! ! INTEGERFN GETGLA(INTEGER LL,LEN) INTEGER INC,CUR,HOLE,FLAG,I LEN = (LEN+15)&X'FFFFFFF0'; ! Quad word align IF LL=0 THEN START ! Get space off basegla. Ensure quad alignment SSOWN_SSCURBGLA = (SSOWN_SSCURBGLA+15)&X'FFFFFFF0' IF SSOWN_SSCURBGLA+LEN > SSOWN_SSMAXBGLA THEN START TERMINALPRINT("** Base gla full ** Try call of RESET LOADER","") RETURN TO COMMAND LEVEL FINISH CUR = SSOWN_SSCURBGLA SSOWN_SSCURBGLA = SSOWN_SSCURBGLA+LEN IF SSOWN_DIAGMON&1#0 THEN SSTRACE(CUR,"IIr") RESULT = CUR FINISH ! If here then require space off the user gla. May have to create it ! if it does not exist or attempt to extend it if it's not big enough IF SSOWN_SSCOMREG(44)=0 THEN START ! Set hole to be the smaller of max file size allowed - SSMAXFSIZE - ! and max ugla size allowed - MAXUGLASIZE IF SSOWN_SSMAXFSIZE>MAXUGLASIZE THEN HOLE=MAXUGLASIZE ELSE HOLE=SSOWN_SSMAXFSIZE OUTFILE(UGLANAME,SSOWN_SSUGLASIZE,HOLE,0,SSOWN_SSCOMREG(38),FLAG) IF FLAG # 0 THEN TERMINALPRINT("Create USERGLA fails - ", C FAILUREMESSAGE(FLAG)) AND RETURN TO COMMAND LEVEL IF NEWCONNECT=0 THEN SETUSE(UGLANAME,1,0) SSOWN_MAXUGLA = SSOWN_SSCOMREG(38)+SSOWN_SSUGLASIZE SSOWN_SSCOMREG(44)=SSOWN_SSCOMREG(38) SSOWN_LLINFO(I)_GLA=SSOWN_SSCOMREG(38) FOR I=LL,-1,1; ! In case LL>1 FINISH WHILE SSOWN_SSCOMREG(44)+LEN>SSOWN_MAXUGLA CYCLE IF SSOWN_SSUGLASIZE>=SEGSIZE THEN INC=SEGSIZE ELSE INC=K64 CHANGEFILESIZE(UGLANAME,SSOWN_SSUGLASIZE+INC,FLAG) IF FLAG#0 THEN START TERMINALPRINT("Extend USERGLA fails - ",FAILUREMESSAGE(FLAG)) RETURN TO COMMAND LEVEL FINISH SSOWN_SSUGLASIZE = SSOWN_SSUGLASIZE+INC SSOWN_MAXUGLA = SSOWN_SSCOMREG(38)+SSOWN_SSUGLASIZE REPEAT CUR = SSOWN_SSCOMREG(44) SSOWN_SSCOMREG(44) = SSOWN_SSCOMREG(44)+LEN IF SSOWN_DIAGMON&1#0 THEN SSTRACE(CUR,"IIr") RESULT = CUR END ; ! OF GETGLA ! ! INTEGERFN GETSPACE(INTEGERNAME FLAG, INTEGER AREA,OFFSET,LEN) ! Obtains LEN bytes of free space from area AREA of the loader ! tables. If it can't then it tries to extend T#LOAD by a page ! at a time and adjusts the tables so that the extra page is ! available to the requesting AREA then it tries again. INTEGERARRAYNAME RLH,PLH,TLH INTEGER SPACEAD,FSIZE,I,FILLAD,MLEN,MINHOLEAD,DUFF,LO,HI,AD,L BYTEINTEGER FILLER FLAG=0 FSIZE=INTEGER(SSOWN_SSLOADTAB(0)_START+8) WHILE FLAG=0 CYCLE IF AREA#1 THEN START IF SSOWN_SSLOADTAB(AREA)_LEN-SSOWN_NEXTAD(AREA)-LEN>=0 THEN C SPACEAD=SSOWN_SSLOADTAB(AREA)_START+SSOWN_NEXTAD(AREA) AND SSOWN_NEXTAD(AREA)= C SSOWN_NEXTAD(AREA)+LEN ELSE SPACEAD=0 FINISH ELSE START ! Getting space in the reference tables is not quite so straightforward. ! Refs come and go during loading and running and the ref tables cannot ! be run in a stack-like manner. Instead space must be taken where it is ! found. The minimum size of hole of interest is 16 bytes, so start off ! by finding one of these. In subsequent searches for space then start ! looking there rather than at the start of the table. HI=SSOWN_SSLOADTAB(1)_START+SSOWN_SSLOADTAB(1)_LEN-16 LO=SSOWN_SSLOADTAB(1)_START+SSOWN_NEXTAD(1) ! Look for 16 byte hole MINHOLEAD=0 WHILE LO<=HI CYCLE IF LONGINTEGER(LO)=LONGINTEGER(LO+8)=NOTUSED THEN START MINHOLEAD=LO SSOWN_NEXTAD(1)=LO-SSOWN_SSLOADTAB(1)_START EXIT FINISH LO=LO+8 REPEAT ! If MINHOLEAD=0 then no option but to attempt to extend the table IF MINHOLEAD=0 THEN START SSOWN_NEXTAD(1)=HI+8-SSOWN_SSLOADTAB(1)_START SPACEAD=0 FINISH ELSE START IF LEN=16 THEN START SPACEAD=MINHOLEAD SSOWN_NEXTAD(1)=SSOWN_NEXTAD(1)+16 FINISH ELSE START ! If here then looking for a hole > 16 HI=HI+16-LEN; ! New upper limit SPACEAD=0 WHILE LO<=HI CYCLE IF LONGINTEGER(LO)=NOTUSED=LONGINTEGER(LO+8) THEN START AD=LO+16 L=LEN-24 DUFF=FALSE WHILE L>=0 CYCLE DUFF=TRUE AND EXIT IF LONGINTEGER(AD+L)#NOTUSED L=L-8 REPEAT IF DUFF#FALSE THEN LO=AD+L+8 ELSE SPACEAD=LO AND EXIT FINISH ELSE LO=LO+8 REPEAT FINISH FINISH FINISH ! If successful then FILL the space with X'FF' which, incidentally, ! initialises the LINK fields to -1 which is the chain terminator anyway. IF SPACEAD#0 THEN START FILL(LEN,SPACEAD,X'FF') IF SSOWN_DIAGMON&1#0 THEN SSTRACE(SPACEAD,"NIiir") RESULT =SPACEAD FINISH ! If here then couldn't get the space. Try to extend T#LOAD. IF FSIZE=MAXLOADTABSIZE OR FSIZE=SSOWN_SSMAXFSIZE THEN START ! Either condition means that we can't extend any further TERMINALPRINT("** Loader tables full, tell ERCC Advisory","") RETURN TO COMMAND LEVEL; ! No messing about FINISH FSIZE=FSIZE+X'1000' CHANGEFILESIZE(LOADTABLES,FSIZE,FLAG) IF FLAG#0 THEN START SPACEAD=0 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(SPACEAD,"FIiiR") RESULT =0 FINISH INTEGER(SSOWN_SSLOADTAB(0)_START+8)=FSIZE INTEGER(SSOWN_SSLOADTAB(0)_START)=FSIZE ! Reconstruct SSLOADTAB addresses FOR I=1,1,3 CYCLE SSOWN_SSLOADTAB(I)_START=SSOWN_SSLOADTAB(I-1)_START+SSOWN_SSLOADTAB(I-1)_LEN REPEAT ! If area 3 needs extension, update SSLOADTAB(3)_LEN only ! If area#3 then must update SSLOADTAB(AREA)_LEN and all the ! succeeding SSLOADTAB(AREAS)_START for AREAS=AREA+1,1,3 ! The hole must then be filled with X'00' for entry tables, X'82' for refs. IF AREA=3 THEN START SSOWN_SSLOADTAB(3)_LEN=SSOWN_SSLOADTAB(3)_LEN+X'1000' FINISH ELSE START SSOWN_SSLOADTAB(AREA)_LEN=SSOWN_SSLOADTAB(AREA)_LEN+X'1000' FILLAD=SSOWN_SSLOADTAB(AREA+1)_START MLEN=0 MLEN=MLEN+SSOWN_SSLOADTAB(I)_LEN FOR I=AREA+1,1,3 MOVE(MLEN,SSOWN_SSLOADTAB(AREA+1)_START,SSOWN_SSLOADTAB(AREA+1)_START+X'1000') SSOWN_SSLOADTAB(I)_START=SSOWN_SSLOADTAB(I)_START+X'1000' FOR I=AREA+1,1,3 IF AREA=1 THEN FILLER=X'82' ELSE FILLER=X'00' FILL(X'1000',FILLAD,FILLER) FINISH ! Map listheads RLH==ARRAY(SSOWN_SSLOADTAB(1)_START,LHF) PLH==ARRAY(SSOWN_SSLOADTAB(2)_START,LHF) TLH==ARRAY(SSOWN_SSLOADTAB(3)_START,LHF) SSOWN_RLH==RLH SSOWN_PLH==PLH SSOWN_TLH==TLH ! So try again to get the space REPEAT END ; ! OF GETSPACE ! ! INTEGERFN ESCAPEREC(INTEGER TYPE,RECAD,DESCAD,LOCLL) ! Creates an escape table on the base or user gla as appropriate for ! dynamic or (PARM LET) unsatisfied refs. RECORD (ESCF)NAME ESCTAB INTEGER ADYNR ADYNR=GETGLA(LOCLL,16) ESCTAB==RECORD(ADYNR) ESCTAB_RECAD=RECAD IF TYPE&X'1FFFFFFF'=CODE THEN START IF TYPE&DYN#0 THEN ESCTAB_PC=SSOWN_DYNPC ELSE ESCTAB_PC=SSOWN_UNSATPC ESCTAB_DESCAD=DESCAD ESCTAB_ENTAD=0; ! Used by ss dyn refs FINISH ELSE START ! If here it's data IF TYPE&DYN#0 THEN ESCTAB_PC=SSOWN_DYNDATAPC ELSE ESCTAB_PC=SSOWN_UNSATPC ! Store data descriptor from gla before overwriting with escape desc ESCTAB_DR0=INTEGER(DESCAD-4) ESCTAB_DR1=INTEGER(DESCAD) FINISH IF SSOWN_DIAGMON&1#0 THEN SSTRACE(ADYNR,"IiiIr") RESULT =ADYNR END ; ! OF ESCAPEREC ! ! ROUTINE DATAREFWARNING(STRING (31) FILE,ENTRY, INTEGER TOOBIG,TOOSMALL) STRING (11) S INTEGER I IF SSOWN_DIAGMON&1#0 THEN SSTRACE(TOOBIG,"SSII") IF TOOSMALL#0 THEN I=TOOSMALL AND S=" shorter" ELSE I=TOOBIG AND S=" LONGER" TERMINALPRINT("**Warning - ".ITOS(I)." data ref(s) to ".ENTRY." in ".FILE, C S." than current entry") RETURN END ; ! OF DATAREFWARNING ! ! RECORD (FINDGLAF)FN FINDGLA(INTEGER REFAD) ! Function returns the name of the file and the range of gla associated ! with it which contains the data ref at REFAD. ! Note that 'gla' in this respect could mean ISTK. RECORD (FINDGLAF) RES RECORD (ENTF)NAME ENT INTEGER I,J,RECAD,LENE,START,OFFSET RES=0 FOR I=2,1,3 CYCLE START=SSOWN_SSLOADTAB(I)_START J=INTEGER(START+1004); ! The filenames listhead CONTINUE IF J=0 WHILE J>0 CYCLE RECAD=START+J LENE=(BYTEINTEGER(RECAD)+4)&X'FFFFFFFC' ENT==RECORD(RECAD+LENE) IF ENT_TYPE=32 AND ENT_GLAFROM<REFAD<ENT_GLATO THEN START ! Found the gla or istk record required RES_FROM=ENT_GLAFROM RES_TO=ENT_GLATO ! Istk records come before gla records. There is always a gla ! record but not necessarily an istk one. These records are 20 bytes ! long so an istk record is 40 in front of the filename and a gla 20. ! Pointer to gla is 28 bytes beyond istk record. IF STRING(RECAD)="+IS" THEN START RES_GLASTART=INTEGER(RECAD+28) RES_FILE=STRING(RECAD+40) FINISH ELSE START RES_GLASTART=RES_FROM RES_FILE=STRING(RECAD+20) FINISH ->OUT FINISH J=ENT_LINK REPEAT REPEAT OUT: IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"iU") RESULT =RES END ; ! OF FINDGLA ! ! ROUTINE SATISFYREF(STRING (31) ENTRY, LONGINTEGER DESC, C INTEGERNAME FLAG, INTEGER TYPE,LOCLL,POS) ! Satisfies any references outstanding to ENTRY in the loaders ! tables of type(s) consistent with TYPE. ! This requires that the basic record chain must be searched right ! to the end. ! Equally any dynamic data ref must have its original data descriptor ! restored. ! Note on SATISFYREF and LOAD LEVEL ! ==== == ========== === ==== ===== ! We distinguish between the loadlevel that a reference was generated at ! and the loadlevel of the entry at which it is satisfied. There is no ! problem when an entry at a given loadlevel satisfies a reference at ! the same or a higher loadlevel since the file containing the reference ! will be unloaded before or at the same time as the entry. The problem ! arises when a ref at one loadlevel is satisfied by an entry at a higher ! loadlevel since the file containing the entry is likely to be unloaded ! first. e.g. preloaded files, subsystem library files, etc. ! The two cases are handled differently. ! 1. loadlevel ref>= loadlevel entry ! Satisfy ref and destroy information record. ! 2. loadlevel ref<loadlevel entry. ! In these cases we OUGHT to be dealing with dynamic refs in which case ! the information record with its pointer to the escape table is not destroyed ! but the dyn/unsat bits in the basic record are unset to mark a satisfied ! ref. The reason for this is that if the file containing the entry is ! unloaded first then we have to recreate the original dynamic ref from ! the escape table in order to continue safely. All the refs that fall ! into this category will be marked as satisfied refs in the loader ! refs table, which saves the alternative and awful strategy of inspecting ! all the refs of all the files which remain loaded after the unload. ! However what if the ref is not dynamic? I can't envisage the circumstances ! at present but it could happen. If it does then change the information ! record to type dynamic and create a new escape record (and print a warning). ! Must create escape table before satisfying the ref since data refs have ! offsets in the DR1 field in the gla which must be stored. ! The problem is of course that the escape table is stored in gla at a ! higher loadlevel than the file which generated it (if it's not in ! the basegla). The unload will work o.k. but the next load will probably ! overwrite the escape table. This can be avoided by always taking the ! space for the escape table off the basegla ! This strategy should ensure that at unloading time, there should always ! be an escape table to restore from. (code or data - single word handled diff) ! ************************************************************************* RECORD (BREFF)NAME R1 RECORD (IREFF)NAME R2 RECORD (ESCF)NAME DREC INTEGER I,J,RECAD,IRECAD,START,RTYPE,FOUND,REFLEN,LEN INTEGER LASTBLINKAD,GOTUNSAT,LASTILINKAD ! %INTEGER NREFS {Temp} INTEGERNAME ENTLEN,ENTAD RECORD (FINDGLAF) REFINF INTEGER TOOBIG,TOOSMALL,REFLANG ENTLEN==INTEGER(ADDR(DESC)) ENTAD==INTEGER(ADDR(DESC)+4) FLAG=0 REFINF=0 TOOBIG=0 TOOSMALL=0 TYPE=TYPE&X'1FFFFFFF'; ! Off cmn/dyn/unsat bits START=SSOWN_SSLOADTAB(1)_START; ! Start of unsat ref area FOUND=FALSE I=SSOWN_RLH(POS) LASTBLINKAD=START+POS<<2; ! Listhead address ! Search basic records for ENTRY ! NREFS=0 {Temp} WHILE I>0 CYCLE RECAD=START+I LEN=(BYTEINTEGER(RECAD)+8)&X'FFFFFFF8' RTYPE=INTEGER(RECAD+LEN) R1==RECORD(RECAD+LEN+4) I=R1_LINK; ! Maybe going to destroy R1 if its ref required so get link IF STRING(RECAD)=ENTRY AND TYPE&RTYPE#0 THEN START ! Found it ! Now chain through information records for each ref ! Check ref loadlevel against entry loadlevel. Create escape tab ! if necessary. If ref>=entry then proceed as in rest of comment, ! if not then refer to note at routine head. ! If it's code then put in descriptor without further ado ! If data then must check the length of the ref against ! the length of the entry and warn or fail if appropriate. ! If no failures then release the space. ! After the information record chain has been destroyed ! then the basic record also has to be destroyed and the ! remaining records on the chain relinked. ! Of course I don't want to be interrupted while doing ! this!!! SSOWN_SSINHIBIT=TRUE FOUND=TRUE IF FOUND=FALSE GOTUNSAT=FALSE IF RTYPE&UNSAT#0 THEN GOTUNSAT=TRUE RTYPE=RTYPE&X'0FFFFFFF'; ! Off cmn/dyn/unsat/unres bits ! Remove dyn/unsat/unres bits from basic record to show it's been satisfied INTEGER(RECAD+LEN)=INTEGER(RECAD+LEN)&X'8FFFFFFF' LASTILINKAD=RECAD+LEN+4; ! Address of 1st info rec link J=R1_FIRST; ! There must be at least one WHILE J>0 CYCLE ; ! Round the info records ! NREFS=NREFS+1 {Temp} IRECAD=START+J R2==RECORD(IRECAD) J=R2_LINK ! Check if new escape table required IF (R2_DR0>>24)&X'1F'<LOCLL AND R2_DR0&DYN=0 THEN START IF SSOWN_NOWARNINGS=FALSE THEN C TERMINALPRINT("Warning - satisfying non dynamic ref to ", C ENTRY." by entry at higher loadlevel. Ref made dynamic") R2_DR0=(R2_DR0!DYN)&X'DFFFFFFF'; ! Off unsat/on dyn ! If its code or data then construct an escape table on basegla. ! Do nothing for single word refs. IF RTYPE=CODE THEN R2_ADYNR=ESCAPEREC(RTYPE!DYN,RECAD,R2_DR1,0) ELSE C IF RTYPE=DATA THEN R2_ADYNR=ESCAPEREC(RTYPE!DYN,RECAD,R2_DR1,0) FINISH ! Fix up refs IF RTYPE=CODE!DATA THEN START ! Single word ref. Restore offset, add ENTAD INTEGER(R2_DR1)=R2_OFFSET+ENTAD ! Destroy ref unless it's at lower loadlevel than entry IF (R2_DR0>>24)&X'1FF'>=LOCLL THEN START FILL(16,IRECAD,X'82'); ! Destroy record IF IRECAD-START<SSOWN_NEXTAD(1) THEN SSOWN_NEXTAD(1)=IRECAD-START INTEGER(LASTILINKAD)=R2_LINK; ! Update last link FINISH ELSE LASTILINKAD=IRECAD+12 FINISH ELSE START IF TYPE=CODE THEN START ! If the ref is a subsystem dynamic ref then can't fill ! it in since the basegla is shareable. ! (Even an unshared basegla is treated as 'read only' after ! the ss dynamic refs escape descriptors have been planted.) ! Note the assumption that the subsystem only has dynamic ! CODE refs. ! Not fixing up the gla means that the escape sequence will ! be called each time the reference is called but no more than ! that. ! Because we actually need to know when a subsystem dyn ref ! has been satisfied when we get round to unloading then store ! ENTAD in word 4 of the escape table. This is what should be ! fed to DEADREF to find out whether the file containing the ! entry which satisfies the ss dyn ref is being unloaded. UNLESS SSOWN_DYNREFSTART<=R2_ADYNR<SSOWN_DYNREFEND THEN C LONGINTEGER(R2_DR1)=DESC ELSE INTEGER(R2_ADYNR+12)=ENTAD FINISH ELSE START ! {Temp} ! %IF TYPE=CODE %THEN %START ! LONGINTEGER(R2_DR1)=DESC ! MONOUT(ENTRY." fixed up at ".HTOS(R2_DR1,8)." Esc tab at ".HTOS(R2_ADYNR,8)) ! MONOUT("DESC ".HTOS(ENTLEN,8)." ".HTOS(ENTAD,8)) ! MONOUT("Confirm ".HTOS(INTEGER(R2_DR1),8)." ".HTOS(INTEGER(R2_DR1+4),8)) ! %FINISH ! %FINISH %ELSE %START ! {Temp} ! If we are dealing with a data ref then there could be a ! catastrophic fail if REFLEN>ENTLEN and LET is not set. REFLEN=R2_DR0&X'00FFFFFF'; ! Off cmn/dyn/unsat bits and llev IF REFLEN#ENTLEN THEN START IF REFINF_FILE="" OR NOT (REFINF_FROM<R2_DR1<REFINF_TO) THEN START UNLESS TOOSMALL=0=TOOBIG OR SSOWN_NOWARNINGS#FALSE THEN C DATAREFWARNING(REFINF_FILE,ENTRY,TOOBIG,TOOSMALL) TOOBIG=0 TOOSMALL=0 REFINF=FINDGLA(R2_DR1) FINISH REFLANG=BYTEINTEGER(REFINF_GLASTART+16) IF REFLEN<ENTLEN THEN START TOOSMALL=TOOSMALL+1 UNLESS ENTRY="F#BLCM" OR REFLANG=FORTE FINISH ELSE START IF LET=0 THEN START ! LET not set FLAG=296 SSOWN_SSFNAME=ENTRY TERMINALPRINT("**Error - Data ref ".ENTRY." in ". C REFINF_FILE," longer than entry and LOADPARM LET not set") ->OUT FINISH ELSE TOOBIG=TOOBIG+1 FINISH FINISH ! If there's an esc descriptor at R2_DR1-4 then must restore ! original descriptor IF INTEGER(R2_DR1-4)=X'E5000000' THEN START DREC==RECORD(INTEGER(R2_DR1)) INTEGER(R2_DR1-4)=DREC_DR0 INTEGER(R2_DR1)=DREC_DR1 FINISH INTEGER(R2_DR1)=INTEGER(R2_DR1)+ENTAD FINISH ! Ref has been satisfied if here. If the ref loadlevel<LOCLL ! then leave the info record for possible unfixing later else ! destroy it ! The other restriction is that ss dyn ref info recs must ! never be destroyed. IF (R2_DR0>>24)&X'1F'>=LOCLL AND C NOT (SSOWN_DYNREFSTART<=R2_ADYNR<SSOWN_DYNREFEND) THEN START FILL(16,IRECAD,X'82'); ! Destroy record. IF IRECAD-START<SSOWN_NEXTAD(1) THEN SSOWN_NEXTAD(1)=IRECAD-START INTEGER(LASTILINKAD)=R2_LINK; ! Update last link FINISH ELSE LASTILINKAD=IRECAD+12 FINISH REPEAT UNLESS TOOBIG=0=TOOSMALL OR SSOWN_NOWARNINGS#FALSE THEN C DATAREFWARNING(REFINF_FILE,ENTRY,TOOBIG,TOOSMALL) ! If last info record has been destroyed or there was only one ! then integer(LASTILINKAD) is going to be X'FFFFFFFF'. ! R1_LAST must therefore point to this record IF INTEGER(LASTILINKAD)<0 THEN R1_LAST=LASTILINKAD-12-START ! If there are no info records left then destroy the basic record ! and update the last link pointer. IF R1_FIRST<=0 THEN START INTEGER(LASTBLINKAD)=R1_LINK FILL(LEN+16,RECAD,X'82') IF RECAD-START<SSOWN_NEXTAD(1) THEN SSOWN_NEXTAD(1)=RECAD-START FINISH ELSE LASTBLINKAD=RECAD+LEN+12; ! Step past SSOWN_SSCOMREG(7)=SSOWN_SSCOMREG(7)-1 IF GOTUNSAT#FALSE ALLOWINTERRUPTS; ! Allow interrupts again FINISH ELSE LASTBLINKAD=RECAD+LEN+12; ! Step past - never looked REPEAT ! %IF NREFS#0 %AND SSOWN_LOADMONITOR&1#0 %THEN {Temp} MONOUT(HTOS(NREFS,8). %C ! " outstanding refs to ".ENTRY." satisfied") {Temp} IF FOUND=FALSE THEN START SSOWN_SSFNAME=ENTRY FLAG=289; ! Not found FINISH OUT: IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"SlFIII") RETURN END ; ! OF SATISFYREF ! ! ROUTINE ADDENTRY(STRING (31) ENTRY, INTEGERARRAYNAME LH, C INTEGERNAME FLAG,OFFSET, INTEGER TYPE,I0,I1,AREA,POS) ! Adds filenames, code or data entries to the appropriate area of T#LOAD. RECORD (ENTF)NAME R1,R2 LONGINTEGER XDESC INTEGER I,RECAD,NRECAD,LEN,LENE,START,XTYPE XTYPE=TYPE&X'1FFFFFFF'; ! Off special entry bits FLAG=0 ! Check that ENTRY isn't already loaded. ! ENTRY is a filename if XTYPE=0 IF XTYPE=0 THEN XDESC=SEARCHLOADED(ENTRY,XTYPE,POS) ELSE C IF XTYPE<32 THEN XDESC=CHECKLOADED(ENTRY,XTYPE,POS) ELSE XDESC=0 IF XDESC#0 THEN START ! ENTRY already loaded somewhere. SSOWN_SSFNAME=ENTRY FLAG=354; ! already loaded IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"S4FniiiII") RETURN FINISH ! Not in tables if here so add it. ! If there is already a chain off POS then get the last LINK START=SSOWN_SSLOADTAB(AREA)_START RECAD=0 I=LH(POS) WHILE I>0 CYCLE RECAD=START+I LEN=(BYTEINTEGER(RECAD)+4)&X'FFFFFFFC'; ! Name string R1==RECORD(RECAD+LEN) I=R1_LINK REPEAT LENE=(LENGTH(ENTRY)+4)&X'FFFFFFFC'; ! Bytes for ENTRY (word aligned) ! Get space for new record NRECAD=GETSPACE(FLAG,AREA,OFFSET,LENE+16) IF FLAG#0 THEN START IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"S4FniiiII") RETURN FINISH SSOWN_SSINHIBIT=TRUE; ! Inhibit interrupts OFFSET=NRECAD+LENE+16-START STRING(NRECAD)=ENTRY R2==RECORD(NRECAD+LENE) R2_TYPE=TYPE R2_DR0=I0; ! DR0 or MAINEP or GLAFROM or DUM2 or USECOUNT R2_DR1=I1; ! DR1 or DUM1 or GLATO or DUM3 or ACCESSMODE ! Link already set by GETSPACE ! Update previous LINK field if pre existing chain ! otherwise listhead NRECAD=NRECAD-START IF RECAD=0 THEN LH(POS)=NRECAD ELSE R1_LINK=NRECAD ALLOWINTERRUPTS IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"S4FniiiII") RETURN END ; ! OF ADDENTRY ! ! ! ROUTINE ADDREF(STRING (31) ENTRY, INTEGERNAME FLAG, C INTEGER DR0,AD,TYPE,STATUS,LOCLL,POS,NREFS) ! Adds dynamic and unsatisfied refs to T#LOAD. If the unresolved bit is set in the ! basic record and the incoming reference is unsatisfied then the ref ! will be made unresolved immediately. ! Creates an escape record on the gla (if required) for dynamic/unresolved refs RECORD (BREFF)NAME R1 RECORD (IREFF)NAME R2,R3 INTEGER I,J,ADYNR,RECAD,NRECAD,IRECAD,START,FOUND,LENE,LEN INTEGER RTYPE,AREA,K,REFLOC,REFAD,UNRESOLVEDREF STRING (255) DUM ! %CONSTSTRING(11)%ARRAY SREF(1:3)="Data ","Code ","Single wd " {Temp} IF STATUS=DYNAMIC THEN TYPE=TYPE!DYN AND DR0=DR0!DYN ELSE C TYPE=TYPE!UNSAT AND DR0=DR0!UNSAT DR0=DR0!(LOCLL<<24) FLAG=0 AREA=1 START=SSOWN_SSLOADTAB(1)_START LENE=(LENGTH(ENTRY)+8)&X'FFFFFFF8'; ! Bytes req by ENTRY (D-word aligned) UNRESOLVEDREF=FALSE FOUND=FALSE RECAD=0 I=SSOWN_RLH(POS); ! Offset from START of first basic record ! Search chain for occurrence of ENTRY and TYPE WHILE I>0 CYCLE RECAD=START+I LEN=(BYTEINTEGER(RECAD)+8)&X'FFFFFFF8'; ! Len of string d word aligned RTYPE=INTEGER(RECAD+LEN); ! Record type R1==RECORD(RECAD+LEN+4) IF STRING(RECAD)=ENTRY AND TYPE&X'1FFFFFFF'=RTYPE&X'0FFFFFFF' THEN START FOUND=TRUE IF RTYPE&UNRES#0 THEN UNRESOLVEDREF=TRUE EXIT FINISH I=R1_LINK REPEAT ! If FOUND=FALSE then must create a new basic record for ENTRY. ! If there was already something on the chain then must also ! update the link field of the last basic record. SSOWN_SSINHIBIT=TRUE; ! Disallow interrupts IF FOUND=FALSE THEN START ! Create new basic record. Can't be unresolved if here. NRECAD=GETSPACE(FLAG,AREA,LHOFFSET,LENE+16) IF FLAG#0 THEN START IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"SFiiiIIII") ALLOWINTERRUPTS RETURN FINISH ! If 1st member of a chain then update listhead else ! last link field IF RECAD=0 THEN SSOWN_RLH(POS)=NRECAD-START ELSE R1_LINK=NRECAD-START STRING(NRECAD)=ENTRY INTEGER(NRECAD+LENE)=TYPE ! Now map R1 on to the last 3 integers of the basic record R1==RECORD(NRECAD+LENE+4) RECAD=NRECAD FINISH ELSE IF UNRESOLVEDREF=FALSE OR TYPE&UNSAT=0 THEN C INTEGER(RECAD+LEN)=INTEGER(RECAD+LEN)!TYPE ! Note on above line: What we are doing here is %or ing in dynamic ! or unsatisfied bits into the basic record TYPE field. If TYPE has the ! unresolved bit set and the new ref is unsatisfied then don't want to do this. FOR K=NREFS-1,-1,0 CYCLE REFLOC=INTEGER(AD+K<<2) REFAD=SSOWN_AREASTART((REFLOC>>24)&X'0F')+REFLOC&X'00FFFFFF' ! Now create a new info record IRECAD=GETSPACE(FLAG,AREA,LHOFFSET,16) IF FLAG#0 THEN START IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"SFiiiIIII") ALLOWINTERRUPTS RETURN FINISH ! {Temp} ! %IF SSOWN_LOADMONITOR&1#0 %THEN %START ! MONOUT(SREF(TYPE&X'1FFFFFFF')." ref to ".ENTRY." at ".HTOS(REFAD,8)) ! %IF DR0&X'00FFFFFF'#0 %THEN MONOUT(" of length ".HTOS(DR0&X'00FFFFFF',8)) ! MONOUT(" added to active ref tables") ! %FINISH ! {Temp} J=IRECAD-START; ! Offset from start of AREA R2==RECORD(IRECAD) R2_DR0=DR0 R2_DR1=REFAD ! If this is a single word reference then hold INTEGER(REFAD) in R2_OFFSET. ! This is in case the reference is eventually made pseudo dynamic. We must ! be able to restore the offset if the reference is eventually satisfied ! indirectly through something else being loaded. The reference could become ! pseudo dynamic through LOADPARM MIN being set or by unloading if the ref ! gets satisfied by an entry at a higher loadlevel which is subsequently ! unloaded. IF TYPE&X'1FFFFFFF'=CODE!DATA THEN R2_OFFSET=INTEGER(REFAD) ELSE R2_ADYNR=0 ! If this is not the only member of this chain of info records then ! must update the link field from the now penultimate info record ! else the FIRST field of the basic record should point at this ! record. ! The LAST field must be updated regardless. IF R1_LAST>0 THEN START R3==RECORD(START+R1_LAST) R3_LINK=J FINISH ELSE R1_FIRST=J R1_LAST=J ! If this is a dynamic or a new unresolved ref then require escape record IF TYPE&DYN#0 OR UNRESOLVEDREF#FALSE THEN START ! Data refs - Escape record must store the descriptor before ! overwriting with escape desc for eventual restoration when called. ! List 11 refs - Not relevant. Can only be made 'dynamic' by CHANGEREFTYPE ! Create new escape record ! It doesn't matter that TYPE may have the unsat bit set since ! ESCAPEREC only looks for the presence or absence of the dyn bit. IF TYPE&X'1FFFFFFF'=CODE THEN C ADYNR=ESCAPEREC(TYPE,RECAD-START,REFAD,(DR0>>24)&X'1F') ELSE C ADYNR=ESCAPEREC(TYPE,RECAD-START,REFAD,(DR0>>24)&X'1F') AND C REFAD=REFAD-4; ! Data ref points at address field of descriptor LONGINTEGER(REFAD)=ESCDR!ADYNR UNLESS SSOWN_DYNREFEND=0=SSOWN_UNSHAREDBGLA ! i.e. not with ss dynrefs in a shared bgla R2_ADYNR=ADYNR ! %IF SSOWN_LOADMONITOR&1#0 %THEN %C ! MONOUT("Dynamic escape table for ".ENTRY." at ".HTOS(ADYNR,8)) {Temp} IF SSOWN_LOADMONITOR&16#0 AND UNRESOLVEDREF#FALSE THEN START IF TYPE&X'1FFFFFFF'=CODE THEN C DUM="Code ref ".ENTRY." at ".HTOS(REFAD,8) ELSE C DUM="Data ref ".ENTRY." at ".HTOS(REFAD+4,8) TERMINALPRINT(DUM," made type UNRESOLVED") FINISH FINISH REPEAT ! Increment SSOWN_SSCOMREG(7) if it's new unsatisfied ref. ! The condition for this is that this reference is an unsatisfied one ! and (it's the first occurrence of the ref or (it's already there and neither ! the unsatisfied bit nor the unresolved bit is set)). FLAG=-1 IF TYPE&DYN=0 AND (FOUND=FALSE OR (FOUND#FALSE AND RTYPE&X'30000000'=0)) ALLOWINTERRUPTS IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"SFiiiIIII") RETURN END ; ! OF ADDREF ! ! SYSTEMROUTINE FILLPATTN(INTEGER NCOPIES,N,FROM,TO) ! Moves NCOPIES of N bytes from address FROM to address TO INTEGER J,Q,S J=1; ! J groups at a time Q=N; ! J groups are Q bytes long i.e. Q=J*N S=FROM WHILE NCOPIES>0 CYCLE MOVE(Q,S,TO) TO=TO+Q NCOPIES=NCOPIES-J IF Q<=2048 AND S#FROM THEN J=J<<1 ! The test Q<=2048 ensures that we never get MOVEs of >4Kbytes, ! so that the source & destination fields together cover no more ! than 2 consecutive pages. This allows store accesses to be ! recognised as "sequential". ! The test S#TO simply avoids doubling J after the first MOVE, ! because at that point there is only one copy of the pattern ! in the area to be initialised IF J>NCOPIES THEN J=NCOPIES Q=J*N S=TO-Q REPEAT IF SSOWN_DIAGMON&1#0 THEN SSTRACE(J,"Iiii") RETURN END ; ! OF FILLPATTN ! ! INTEGERFN CHECKBOUNDSITE(INTEGER AD,LEN) IF NEWCONNECT=0 THEN START ! This function checks whether there are sufficient contiguous free ! segments from the segment containing AD to connect a file of LEN ! bytes. A result of 1 means that there are not sufficient free segs, ! 0 means that there are. INTEGER NSEG,FLAG,SEGSTART,FIRST,LAST,RES,DIFF STRING (31) FNAME ! Get no of segs required. NSEG=((LEN+X'0003FFFF')&X'FFFC0000')>>18 SEGSTART=(AD&X'FFFC0000')>>18 WHILE NSEG>0 CYCLE FNAME=SEGSINUSE(FIRST,LAST,SEGSTART) IF FNAME#"" THEN START ! Try to disconnect it DISCONNECT(FNAME,FLAG) IF FLAG#0 THEN START RES=1 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"iiR") RESULT =1 FINISH FINISH ELSE LAST=SEGSTART; ! i.e. unused DIFF=LAST-SEGSTART+1 SEGSTART=SEGSTART+DIFF NSEG=NSEG-DIFF REPEAT RES=0 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"iiR") RESULT =0 FINISH END ; ! OF CHECKBOUNDSITE ! ! SYSTEMROUTINE LOADFILE2(STRING (31) FILE, INTEGERNAME FLAG, C INTEGER LOCLL) RECORD (OFMF)ARRAYFORMAT OFMAF(1:7) RECORD (OFMF)ARRAYNAME OFM INTEGERARRAYFORMAT LDATAAF(0:15) INTEGERARRAYNAME LDATA RECORD (LD1F)NAME LD1{Procedure entries} RECORD (LD4F)NAME LD4{Data entries} RECORD (LD7F)NAME LD7{Static refs}, LD8{Dynamic refs},LD11{Single word refs} RECORD (LD9F)NAME LD9{Data refs} RECORD (LD13F)NAME LD13{Multiple initialisation requests} RECORD (LD14F)NAME LD14{Relocation block requests} RECORD (RF) RR RECORD (ADDF)ARRAY FENT(0:3) CONSTINTEGERARRAY FENTTYPE(0:3)=0,32,32,64 CONSTSTRING (7) STEMPCODE="T#CODE",STEMPGLA="T#GLA" INTEGER I,J,K,KK,FFLAG,PDMEM,LBASE,BOUND,XSEG,GLAREQ,LANG INTEGER BISTKAD,CODEBLOCKED,CODEOK,CODEAD,GLABLOCKED,GLAOK,GLAAD INTEGER AD,AREA,ISTKSIZE,ISTKOK,NRELOCNS,AREA1,AREA2,START,FROM INTEGER MAINBIT,LCMN,N,REFARRAY,DUMMY,AFILE,LHD,REFAD,REFLOC,REFVAL INTEGERARRAY PREFAREASTART(1:7) { For bound files if we have to unbind} LONGINTEGER DESC INTEGERNAME DR0,DR1 STRING (255) S1,S2 STRING (31) TEMPCODE,TEMPGLA IF SSOWN_LOADINPROGRESS=FALSE THEN SSOWN_LOADINPROGRESS=TRUE DR0==INTEGER(ADDR(DESC)) DR1==INTEGER(ADDR(DESC)+4) ! !*** !*** START OF LOAD PHASE !*** ! UNLESS FILE->S1.(".").S2 THEN FILE=SSOWN_SSOWNER.".".FILE ! Check if already loaded DUMMY=FNAMETYPE DESC=SEARCHLOADED(FILE,DUMMY,PRIME) IF DESC#FALSE THEN START IF NEWCONNECT#0 THEN SETUSE (LASTFN, -1, 0) FLAG=350; ! Already loaded SSOWN_SSFNAME=FILE IF SSOWN_LOADMONITOR&2#0 THEN MONOUT("**** ".FILE." already loaded ****") ->OUT FINISH IF SSOWN_LOADMONITOR&2#0 THEN MONOUT("**** Starting to load ".FILE." ****") SSOWN_SSCOMREG(8)=ADDR(SSOWN_AREASTART(1)); ! For simulator CONNECT(FILE,1,0,0,RR,FLAG); ! Execute & read ->OUT UNLESS FLAG=0 IF NEWCONNECT#0 THEN SETUSE(LASTFN,-1,0) AFILE=RR_CONAD; ! AFILE will always be conad of file with the code ! Now check that FILE is an object file. If not it may be a macro IF RR_FILETYPE#SSOBJFILETYPE THEN START SETUSE (LASTFN, -1, 0) IF RR_FILETYPE=SSCHARFILETYPE THEN START ! Macro or at least assume it to be SSOWN_MACRODR0=RR_DATAEND-RR_DATASTART SSOWN_MACRODR1=RR_CONAD+RR_DATASTART ! LHD=PRIME ! ADDENTRY(FILE,FFLAG,FNAMETYPE,0,AFILE,0,LOCLL,LHD) ! FLAG=FFLAG %AND ->OUT %IF FFLAG#0 ! EXAMINEMACRO somewhere here for MACRONAME???? ! LHD=HASH(MACRONAME,PRIME) ! ADDENTRY(MACRONAME,FFLAG,LHD,MACRO,SSOWN_MACRODR0,SSOWN_MACRODR1,LOCLL) ! FLAG=FFLAG %AND ->OUT %IF FFLAG#0 FLAG=316; ! Attempt to call macro IF SSOWN_LOADMONITOR&2#0 THEN C MONOUT("**** Character file ".FILE." - macro assumed ****") ->OUT FINISH ELSE START SSOWN_SSFNAME=FILE FLAG=267; ! Invalid filetype ->OUT FINISH FINISH FENT(I)=0 FOR I=3,-1,0 FENT(0)_FILE=FILE ! We are now committed to loading the file. The problem is that it is ! not possible to tidy up an unload with UNLOAD2 until we have the ! filename record(s) in the loader tables and this doesn't happen until ! all the relocations have been done and all the entries are added - ! quite a long way down the code. If we get INT:Aed in the interim ! then we could be in trouble because use counts will have been set ! and possibly T#CODE and T#GLA created but it is still invisible ! to UNLOAD2. ! Solve this by storing the names in array PARTLOADED which is cleared ! after the filename records are in place. UNLOAD2 inspects PARTLOADED. SSOWN_PARTLOADED(0)=FILE SETUSE(LASTFN,1,0); ! Increment use count ! Now want to find out if FILE is a) a pdfile mem, b) a bound file ! or c) has code crossing a segment boundary IF FILE->S1.("_").S2 THEN PDMEM=TRUE ELSE PDMEM=FALSE LBASE=RR_CONAD+INTEGER(RR_CONAD+24); ! Start of load data IF 14#INTEGER(LBASE)#15 THEN FLAG=226 AND ->OUT; ! Corrupt obj LDATA==ARRAY(LBASE,LDATAAF) IF LDATA(5)#0 THEN BOUND=TRUE ELSE BOUND=FALSE OFM==ARRAY(RR_CONAD+INTEGER(RR_CONAD+28)+4,OFMAF) !<<<<<<<<< ENHANCED OFM STRUCT >>>>>>>>>>>> SSOWN_AREASTART(1)=RR_CONAD+OFM(1)_START; ! Code SSOWN_AREASTART(4)=RR_CONAD+OFM(4)_START; ! SST IF BOUND#FALSE THEN START ! Get preferred areastarts in case we have to unbind later. ! **** Note that there is an implicit assumption in handling bound ! **** files that the CODE and the SST are contiguous areas. Relocating ! **** into T#CODE files wouldn't work otherwise. PREFAREASTART(1)=LDATA(5)+OFM(1)_START; ! Code PREFAREASTART(4)=LDATA(5)+OFM(4)_START; ! SST FINISH ! Relocate the code+sst if the file is a pdfile member and its code ! crosses a segment boundary. A linked file may have a total code length that ! suggests it may cross a segment boundary but the linker should have ! ensured that no one code area does. IF PDMEM#FALSE AND SSOWN_AREASTART(1)>>SEGSHIFT#(SSOWN_AREASTART(1)+OFM(1)_L)>>SEGSHIFT C THEN XSEG=TRUE ELSE XSEG=FALSE IF XSEG#FALSE AND SSOWN_LOADMONITOR&1#0 THEN C MONOUT("** Warning: Code relocated - crosses segment boundary") ! And while we're here lets find out how much GLA is going to be ! needed GLAREQ=0 FOR I=4,-1,1 CYCLE GLAREQ=GLAREQ+OFM(UNSHAREDAREA(I))_L REPEAT ! And what language it is - top byte of 4th word of GLA (or PLT ! if it exists IF OFM(3)_L=0 THEN I=2 ELSE I=3 LANG=BYTEINTEGER(RR_CONAD+OFM(I)_START+16) UNLESS 1<=LANG<=10 THEN LANG=0 IF SSOWN_LOADMONITOR&2#0 THEN MONOUT("Module source language ".MODLANG(LANG)) ! *** Bound files *** ! Bound files have to be treated somewhat differently. If the code ! and gla can be connected at their preferred sites then all the ! relocations are already satisfied, but if either or both cannot ! be connected at preferred sites then the preset relocations must ! be unscrambled before the relocations are fixed up with the actual ! addresses. ! Bound files which are members of pdfiles: Although in theory the ! code could be copied to a T#CODE file to the preferred site ! (assuming it's available), doing this superficially attractive ! trick could in fact cause havoc with, for example, large packages ! held as bound files in a single pdfile. Imagine 8 private copies ! of SPSS all running simultaneously.! Bound files which are themselves ! members of pdfiles will be treated as having the preferred code ! site unavailable and relocated in situ. ! T#CODE files will only be employed for code crossing segment ! boundaries. ( Incidentally this overrides pdfile mem considerations). ! Linking is common to both bound and unbound files ! ********************************************************************* UNLESS BOUND=FALSE THEN START !** BOUNDFILE START IF SSOWN_LOADMONITOR&1#0 THEN MONOUT(FILE." is a bound file") BISTKAD=LDATA(10); ! Initstack seg is invariant ! Deal with code first. If it doesn't cross a segment boundary ! then we want to connect the whole file at LDATA(5) else want to ! connect a T#CODE file with CODE+SST at that address. IF XSEG#FALSE THEN START ! Must move the code (and sst) TEMPCODE=STEMPCODE.NEXTTEMP SSOWN_PARTLOADED(2)=TEMPCODE ! Check if preferred site is free IF NEWCONNECT#0 THEN START CODEAD = LDATA(5) OUTFILE (TEMPCODE,OFM(1)_L+OFM(4)_L+32,0,X'40',CODEAD,FLAG) IF FLAG=0 THEN START CODEBLOCKED = FALSE CODEOK = TRUE FINISH ELSE START CODEBLOCKED = TRUE CODEOK = FALSE OUTFILE (TEMPCODE,OFM(1)_L+OFM(4)_L+32,0,0,CODEAD,FLAG) FINISH FINISH ELSE START CODEBLOCKED=CHECKBOUNDSITE(LDATA(5),OFM(1)_L+OFM(4)_L+32) IF CODEBLOCKED=FALSE THEN START CODEOK=TRUE CODEAD=LDATA(5) OUTFILE(TEMPCODE,OFM(1)_L+OFM(4)_L+32,0,X'40',CODEAD,FLAG) FINISH ELSE START CODEOK=FALSE OUTFILE(TEMPCODE,OFM(1)_L+OFM(4)_L+32,0,0,CODEAD,FLAG) FINISH FINISH ->OUT UNLESS FLAG=0 AFILE=CODEAD IF NEWCONNECT=0 THEN SETUSE(TEMPCODE,1,0) FENT(3)_FILE=TEMPCODE ! Store originating SSOWN_AREASTART(1) as word 8 of T#CODE so that ! originating address can be passed back to NDIAGS INTEGER(CODEAD+28)=SSOWN_AREASTART(1) ! Move the code and sst SSOWN_AREASTART(1)=32+CODEAD SSOWN_AREASTART(4)=SSOWN_AREASTART(1)+OFM(1)_L MOVE(OFM(1)_L,RR_CONAD+OFM(1)_START,SSOWN_AREASTART(1)) MOVE(OFM(4)_L,RR_CONAD+OFM(4)_START,SSOWN_AREASTART(4)) FINISH ELSE START ! Doesn't cross seg boundary ! If preferred code location is free then reconnect FILE at that ! location. ! There are two special conditions. a) code may already be ! connected at preferred site and b) pdfile members require ! code relocations regardless. ! Check if preferred site is free IF NEWCONNECT=0 THEN START CODEBLOCKED=CHECKBOUNDSITE(LDATA(5),INTEGER(RR_CONAD+8)) IF PDMEM=FALSE AND CODEBLOCKED=FALSE THEN START ! Relocate at preferred site SETUSE(FILE,-1,0); ! Decrement use count RR_CONAD=LDATA(5) DISCONNECT(FILE,FFLAG) IF FFLAG=0 THEN START ! Disconnected O.K. CONNECT(FILE,1,0,X'40',RR,FLAG) ! Connect at fixed site ->OUT UNLESS FLAG=0 AFILE=RR_CONAD SETUSE(FILE,1,0); ! Inc use count LBASE=RR_CONAD+INTEGER(RR_CONAD+24) LDATA==ARRAY(LBASE,LDATAAF) OFM==ARRAY(RR_CONAD+INTEGER(RR_CONAD+28)+4,OFMAF) SSOWN_AREASTART(1)=RR_CONAD+OFM(1)_START SSOWN_AREASTART(4)=RR_CONAD+OFM(4)_START CODEOK=TRUE FINISH ELSE CODEOK=FALSE FINISH ELSE START IF PDMEM=FALSE AND LDATA(5)=AFILE THEN C CODEOK=TRUE ELSE CODEOK=FALSE FINISH FINISH ELSE START IF PDMEM=TRUE THEN CODEOK = FALSE C ELSE IF LDATA(5)=AFILE THEN CODEOK = TRUE ELSE START ! Relocate at preferred site RR_CONAD=LDATA(5) DISCONNECT(FILE,FFLAG) IF FFLAG=0 THEN START ! Disconnected O.K. CONNECT(FILE,1,0,X'40',RR,FLAG) IF FLAG=0 THEN CODEOK = TRUE ELSE START CONNECT(FILE,1,0,0,RR,FLAG) CODEOK = FALSE ->OUT UNLESS FLAG=0 FINISH ! Connect at fixed site AFILE=RR_CONAD LBASE=RR_CONAD+INTEGER(RR_CONAD+24) LDATA==ARRAY(LBASE,LDATAAF) OFM==ARRAY(RR_CONAD+INTEGER(RR_CONAD+28)+4,OFMAF) SSOWN_AREASTART(1)=RR_CONAD+OFM(1)_START SSOWN_AREASTART(4)=RR_CONAD+OFM(4)_START FINISH ELSE CODEOK=FALSE FINISH FINISH FINISH ! Now the gla ! GLAAD is always the ad of the first byte of gla used by this file TEMPGLA=STEMPGLA.NEXTTEMP SSOWN_PARTLOADED(1)=TEMPGLA IF NEWCONNECT=0 THEN START GLABLOCKED=CHECKBOUNDSITE(LDATA(6),GLAREQ) IF GLABLOCKED=FALSE THEN GLAOK=TRUE ELSE GLAOK=FALSE IF GLAOK=FALSE THEN C OUTFILE(TEMPGLA,GLAREQ,0,0,GLAAD,FLAG) C ELSE START GLAAD=LDATA(6) OUTFILE(TEMPGLA,GLAREQ,0,X'40',GLAAD,FLAG) FINISH FINISH ELSE START GLAAD = LDATA(6) OUTFILE(TEMPGLA,GLAREQ,0,X'40',GLAAD,FLAG) IF FLAG=0 THEN START GLABLOCKED = FALSE GLAOK = TRUE FINISH ELSE START GLABLOCKED = TRUE GLAOK = FALSE OUTFILE(TEMPGLA,GLAREQ,0,0,GLAAD,FLAG) FINISH FINISH ->OUT UNLESS FLAG=0 IF NEWCONNECT=0 THEN SETUSE(TEMPGLA,1,0) FENT(1)_FILE=TEMPGLA FENT(1)_GLAFROM=GLAAD FENT(1)_GLATO=GLAAD+GLAREQ ! Now assign the various SSOWN_AREASTARTs ! If GLAOK is false then going to have to unbind relocation list later ! so calculate PREFAREASTARTs as well. AD=GLAAD IF GLAOK=FALSE THEN DUMMY=LDATA(6)-AD FOR I=1,1,4 CYCLE AREA=UNSHAREDAREA(I) SSOWN_AREASTART(AREA)=AD IF GLAOK=FALSE THEN PREFAREASTART(AREA)=AD+DUMMY MOVE(OFM(AREA)_L,RR_CONAD+OFM(AREA)_START,AD) AD=AD+OFM(AREA)_L REPEAT ! Initialised stack ! If loading on basegla then take the initstack off the top end ! of the initialised area else off the bottom end. ISTKSIZE=OFM(7)_L IF ISTKSIZE#0 THEN START IF SSOWN_USTB=0 THEN INITUSTK IF LOCLL#0 AND SSOWN_TEMPISTK=BISTKAD THEN ISTKOK=TRUE ELSE C ISTKOK=FALSE AND PREFAREASTART(7)=BISTKAD IF LOCLL#0 THEN START ! User gla IF SSOWN_TEMPISTK+ISTKSIZE<=SSOWN_PERMISTK THEN START SSOWN_AREASTART(7)=SSOWN_TEMPISTK MOVE(ISTKSIZE,RR_CONAD+OFM(7)_START,SSOWN_AREASTART(7)) SSOWN_TEMPISTK=SSOWN_TEMPISTK+ISTKSIZE FINISH ELSE START FLAG=312 ->OUT FINISH FINISH ELSE START IF SSOWN_PERMISTK-ISTKSIZE>=SSOWN_TEMPISTK THEN START SSOWN_PERMISTK=SSOWN_PERMISTK-ISTKSIZE SSOWN_AREASTART(7)=SSOWN_PERMISTK MOVE(ISTKSIZE,RR_CONAD+OFM(7)_START,SSOWN_AREASTART(7)) FINISH ELSE START FLAG=312 ->OUT FINISH FINISH FENT(2)_FILE="+IS" FENT(2)_GLAFROM=SSOWN_AREASTART(7) FENT(2)_GLATO=SSOWN_AREASTART(7)+ISTKSIZE FINISH ELSE ISTKOK=TRUE; ! ie none to worry about IF SSOWN_LOADMONITOR&1#0 THEN START S1=" connected at preferred site" IF CODEOK=FALSE THEN MONOUT("**Warning: CODE NOT".S1) ELSE C MONOUT("CODE".S1) IF GLAOK=FALSE THEN MONOUT("**Warning: GLA NOT".S1) ELSE C MONOUT("GLA".S1) IF ISTKSIZE#0 AND ISTKOK=FALSE THEN MONOUT("**Warning: ISTK NOT". C S1) ELSE MONOUT("ISTK".S1) FINISH ! Do as many of the relocations as required ! If CODEOK=TRUE then dont have to do CODE or SST relocations ! (where AREA2=CODE or SST) ! If GLAOK=TRUE then dont do PLT,GLA,ICMN,USTK relocations ! (AREA2=3,2,5,6) ! If ISTKOK=TRUE then dont do ISTK relocations (AREA2=7) UNLESS CODEOK#FALSE AND (GLAOK#FALSE AND ISTKOK#FALSE) C THEN START ! Some relocations necessary. Have to unbind those which have ! to be done again first I=LDATA(14) WHILE I#0 CYCLE LD14==RECORD(RR_CONAD+I) NRELOCNS=LD14_N; ! No of relocations for this record K=RR_CONAD+I+8; ! Address of first AREALOC KK=K+4; ! Address of first BASELOC FOR J=NRELOCNS-1,-1,0 CYCLE AREA2=INTEGER(KK)>>24 IF ((CODEOK=FALSE AND (AREA2=1 OR AREA2=4)) OR C (GLAOK=FALSE AND (AREA2=2 OR AREA2=5 OR AREA2=6 OR C AREA2=3)) OR (ISTKOK=FALSE AND AREA2=7)) THEN START ! Unbind first AREA1=INTEGER(K)>>24 AD=SSOWN_AREASTART(AREA1)+INTEGER(K)&X'00FFFFFF' ! Relocating in this instance means replacing the old ! preferred areastart by the actual areastart. INTEGER(AD)=INTEGER(AD)-PREFAREASTART(AREA2)+SSOWN_AREASTART(AREA2) FINISH K=K+8 KK=K+4 REPEAT I=LD14_LINK REPEAT FINISH !** BOUND FILE FINISH FINISH ELSE START GLAAD=GETGLA(LOCLL,GLAREQ); ! Assign area on BASE or USER gla AD=GLAAD FOR I=1,1,4 CYCLE AREA=UNSHAREDAREA(I) SSOWN_AREASTART(AREA)=AD MOVE(OFM(AREA)_L,RR_CONAD+OFM(AREA)_START,AD) AD=AD+OFM(AREA)_L REPEAT FENT(1)_FILE="+GL" FENT(1)_GLAFROM=GLAAD FENT(1)_GLATO=GLAAD+GLAREQ ! Check whether code needs relocation UNLESS XSEG=FALSE AND OFM(1)_PROP&1=0 THEN START SSOWN_PARTLOADED(2)=TEMPCODE TEMPCODE=STEMPCODE.NEXTTEMP OUTFILE(TEMPCODE,32+OFM(1)_L+OFM(4)_L,0,0,CODEAD,FLAG) ->OUT UNLESS FLAG=0 IF NEWCONNECT=0 THEN SETUSE(TEMPCODE,1,0) FENT(3)_FILE=TEMPCODE AFILE=CODEAD INTEGER(CODEAD+28)=SSOWN_AREASTART(1); ! Store orig AREASTART(1) SSOWN_AREASTART(1)=CODEAD+32 SSOWN_AREASTART(4)=SSOWN_AREASTART(1)+OFM(1)_L MOVE(OFM(1)_L,RR_CONAD+OFM(1)_START,SSOWN_AREASTART(1)); ! CODE MOVE(OFM(4)_L,RR_CONAD+OFM(4)_START,SSOWN_AREASTART(4)); ! SST IF OFM(1)_PROP&1#0 AND SSOWN_LOADMONITOR&1#0 THEN C MONOUT("** Warning - Code flagged as unshareable and relocated") FINISH ! Initialised stack (if any) ! If loading on BASEGLA then take the ISTK off the top of the area ! else off the bottom ! MONOUT("Relocations") ISTKSIZE=OFM(7)_L IF ISTKSIZE#0 THEN START IF SSOWN_USTB=0 THEN INITUSTK IF LOCLL#0 THEN START ! Temp ISTK IF SSOWN_TEMPISTK+ISTKSIZE<=SSOWN_PERMISTK THEN START SSOWN_AREASTART(7)=SSOWN_TEMPISTK MOVE(ISTKSIZE,RR_CONAD+OFM(7)_START,SSOWN_AREASTART(7)) SSOWN_TEMPISTK=SSOWN_TEMPISTK+ISTKSIZE FINISH ELSE START FLAG=312 ->OUT FINISH FINISH ELSE START IF SSOWN_PERMISTK-ISTKSIZE>=SSOWN_TEMPISTK THEN START SSOWN_PERMISTK=SSOWN_PERMISTK-ISTKSIZE SSOWN_AREASTART(7)=SSOWN_PERMISTK MOVE(ISTKSIZE,RR_CONAD+OFM(7)_START,SSOWN_AREASTART(7)) FINISH ELSE START FLAG=312 ->OUT FINISH FINISH FENT(2)_FILE="+IS" FENT(2)_GLAFROM=SSOWN_AREASTART(7) FENT(2)_GLATO=SSOWN_AREASTART(7)+ISTKSIZE FINISH !* !* RELOCATIONS (listhead 14) !* I=LDATA(14) WHILE I#0 CYCLE LD14==RECORD(RR_CONAD+I) NRELOCNS=LD14_N K=RR_CONAD+I+8; ! Ad of first AREALOC KK=K+4; ! Ad of first BASELOC FOR J=NRELOCNS-1,-1,0 CYCLE AREA1=INTEGER(K)>>24 AREA2=INTEGER(KK)>>24 AD=SSOWN_AREASTART(AREA1)+INTEGER(K)&X'00FFFFFF' INTEGER(AD)=INTEGER(AD)+SSOWN_AREASTART(AREA2)+INTEGER(KK)&X'00FFFFFF' K=K+8 KK=K+4 REPEAT I=LD14_LINK REPEAT FINISH ! All code common to both bound and unbound files from here !* !* MULTIPLE INITIALISATIONS (listhead 13) !* I=LDATA(13) WHILE I#0 CYCLE LD13==RECORD(RR_CONAD+I) START=SSOWN_AREASTART(LD13_A)+LD13_DISP IF LD13_LEN=1 THEN FROM=ADDR(LD13_ADDR) ELSE C FROM=RR_CONAD+LD13_ADDR FILLPATTN(LD13_REP,LD13_LEN,FROM,AD) I=LD13_LINK REPEAT ! If a T#CODE was created then change access to ER. All relocations ! now completed. IF XSEG#FALSE OR OFM(1)_PROP&1#0 THEN START CHANGEACCESS(TEMPCODE,5,FLAG) ->OUT IF FLAG#0 FINISH ! Load monitor OFM output IF SSOWN_LOADMONITOR&2#0 THEN START FOR I=1,1,7 CYCLE IF OFM(I)_L#0 THEN MONOUT(AREANAME(I)." ". C HTOS(SSOWN_AREASTART(I),8)." ".HTOS(OFM(I)_L,8)) REPEAT FINISH ! !*** !*** END OF LOAD PHASE !*** ! ! Add code and data entries to loader tables !* !* CODE ENTRIES (listhead 1) !* ! MONOUT("Entries") I=LDATA(1) WHILE I#0 CYCLE LD1==RECORD(RR_CONAD+I) I=LD1_LINK ! Special for the DAP AD=SSOWN_AREASTART((LD1_LOC>>24)&X'0F')+LD1_LOC&X'00FFFFFF'; ! Ad of e.p. ! If the top bit of LD1_LOC is set then this is a main entry. ! If it's the first encountered in this load then assign AD ! to SSOWN_MAINDR1. Don't add entry points called S#GO to loader tables IF LD1_LOC&X'80000000'#0 THEN START ! Found a main entry MAINBIT=X'80000000' IF SSOWN_MAINDR1=0 THEN SSOWN_MAINDR1=AD AND FENT(0)_MAINEP=AD FINISH ELSE MAINBIT=0 UNLESS LD1_IDEN="S#GO" THEN START ! Establish descriptor type. If it's a code area descriptor then ! use E1000000 else B1000000. IF (LD1_LOC>>24)&X'0000007F'=1 THEN DESC=CODEDR!AD ELSE C DESC=DESCDR!AD ! Add to loader tables LHD=HASH(LD1_IDEN,PRIME) IF LOCLL=0 THEN C ADDENTRY(LD1_IDEN,SSOWN_PLH,FFLAG,SSOWN_PERMOFFSET,MAINBIT!CODE,DR0,DR1,2,LHD) ELSE C ADDENTRY(LD1_IDEN,SSOWN_TLH,FFLAG,SSOWN_TEMPOFFSET,MAINBIT!CODE,DR0,DR1,3,LHD) IF FFLAG=354 THEN START IF SSOWN_NOWARNINGS=FALSE THEN C TERMINALPRINT("** WARNING - Code entry ".LD1_IDEN," already loaded") FFLAG=0 FINISH FLAG=FFLAG AND ->OUT IF FFLAG#0 ! Satisfy any outstanding refs to this entry SATISFYREF(LD1_IDEN,DESC,FFLAG,CODE,LOCLL,LHD) FLAG=FFLAG AND ->OUT IF 289#FFLAG#0; ! Shouldn't happen for code FINISH IF SSOWN_LOADMONITOR&4#0 THEN MONOUT("Code Entry ". C LD1_IDEN." at ".HTOS(INTEGER(AD+4),8)) REPEAT !* !* DATA ENTRIES (listhead 4) !* I=LDATA(4) WHILE I#0 CYCLE LD4==RECORD(RR_CONAD+I) ! Values of LD_A>=10 are treated as initialised common i.e. area 6 IF LD4_A>=10 THEN AD=SSOWN_AREASTART(6) ELSE AD=SSOWN_AREASTART(LD4_A) AD=AD+LD4_DISP DESC=LD4_L DESC=(DESC<<32)!AD LHD=HASH(LD4_IDEN,PRIME) IF LOCLL=0 THEN C ADDENTRY(LD4_IDEN,SSOWN_PLH,FFLAG,SSOWN_PERMOFFSET,DATA,DR0,DR1,2,LHD) ELSE C ADDENTRY(LD4_IDEN,SSOWN_TLH,FFLAG,SSOWN_TEMPOFFSET,DATA,DR0,DR1,3,LHD) FLAG=FFLAG AND ->OUT IF FFLAG#0 ! Satisfy any outstanding refs to this entry SATISFYREF(LD4_IDEN,DESC,FFLAG,DATA,LOCLL,LHD) FLAG=FFLAG AND ->OUT IF 289#FFLAG#0 IF SSOWN_LOADMONITOR&4#0 THEN MONOUT("Data Entry ". C LD4_IDEN." at ".HTOS(AD,8)." of length ".HTOS(LD4_L,8)) I=LD4_LINK REPEAT !* !* !* ! If here then have successfully added any code and data entries ! to loader tables and have satisfied any outstanding refs to them. ! Now add the filename records to listhead(PRIME) FOR I=3,-1,0 CYCLE IF FENT(I)_FILE#"" THEN START IF LOCLL=0 THEN ADDENTRY(FENT(I)_FILE,SSOWN_PLH,FFLAG,SSOWN_PERMOFFSET,FENTTYPE(I), C FENT(I)_MAINEP,FENT(I)_DUM1,2,PRIME) ELSE C ADDENTRY(FENT(I)_FILE,SSOWN_TLH,FFLAG,SSOWN_TEMPOFFSET,FENTTYPE(I),FENT(I)_MAINEP, C FENT(I)_DUM1,3,PRIME) FLAG=FFLAG AND ->OUT IF FFLAG#0 FINISH REPEAT SSOWN_PARTLOADED(I)="" FOR I=2,-1,0; ! UNLOAD2 will pick it up now ! !*** !*** LINK PHASE !*** ! !* !* STATIC PROCEDURE REFS (listhead 7) !* ! MONOUT("Code Refs") I=LDATA(7) WHILE I#0 CYCLE AD=RR_CONAD+I LD7==RECORD(AD) IF LD7_IDEN="S#DAPDATA" AND LOCLL=0 THEN FLAG=1011 AND ->OUT ! Now search currently loaded material for ref. If not found, add ! to list of unsat refs. DUMMY=CODE LHD=-1 DESC=CHECKLOADED(LD7_IDEN,DUMMY,LHD) IF DESC#0 THEN START REFAD=SSOWN_AREASTART(LD7_REFLOC>>24)+LD7_REFLOC&X'00FFFFFF'; ! Desc location LONGINTEGER(REFAD)=DESC ! %IF SSOWN_LOADMONITOR&1#0 %THEN MONOUT("Static code ref to ".LD7_IDEN." at ".HTOS(REFAD,8). %C ! " satisfied by known entry") {Temp} FINISH ELSE START ! Didn't find it ADDREF(LD7_IDEN,FFLAG,0,AD+4,CODE,UNSATISFIED,LOCLL,LHD,1) FLAG=FFLAG AND ->OUT IF FFLAG>0; ! Something nasty SSOWN_SSCOMREG(7)=SSOWN_SSCOMREG(7)+1 IF FFLAG<0; ! A new unsat ref FINISH I=LD7_LINK REPEAT ! !* !* DYNAMIC PROCEDURE REFS (listhead 8) !* I=LDATA(8) WHILE I#0 CYCLE AD=RR_CONAD+I LD8==RECORD(AD) IF LD8_IDEN="S#DAPDATA" AND LOCLL=0 THEN FLAG=1011 AND ->OUT ! Search loaded material. If not found add to dyn ref list. DUMMY=CODE LHD=-1 DESC=CHECKLOADED(LD8_IDEN,DUMMY,LHD) IF DESC#0 THEN START REFAD=SSOWN_AREASTART(LD8_REFLOC>>24)+LD8_REFLOC&X'00FFFFFF' LONGINTEGER(REFAD)=DESC ! %IF SSOWN_LOADMONITOR&1#0 %THEN MONOUT("Dynamic code ref to ".LD8_IDEN." at ".HTOS(REFAD,8). %C ! " satisfied by known entry") {Temp} FINISH ELSE START ADDREF(LD8_IDEN,FFLAG,0,AD+4,CODE,DYNAMIC,LOCLL,LHD,1) FLAG=FFLAG AND ->OUT IF FFLAG>0 FINISH I=LD8_LINK REPEAT ! !* !* DATA REFS (listhead 9) !* ! MONOUT("Data Refs") I=LDATA(9) WHILE I#0 CYCLE LD9==RECORD(RR_CONAD+I) ! MONOUT(LD9_IDEN) LCMN=LD9_REFARRAY&X'80000000'; ! Common bit REFARRAY=LD9_REFARRAY&X'7FFFFFFF'; ! Off common bit I=LD9_LINK AD=RR_CONAD+REFARRAY N=INTEGER(AD); ! No of occurrences of this ref AD=AD+4; ! Now points to first element of the REFLOCs IF LD9_IDEN="ICL9CEAUXST" OR LD9_IDEN="ICL9LDLIBPROC" THEN START ! Deal with specials first IF LD9_IDEN="ICL9CEAUXST" THEN START ! Create AUXSTACK if it doesn't already exist IF SSOWN_SSAUXDR1=0 THEN INITAUXSTACK REFVAL=SSOWN_SSCOMREG(41) ! COMREG(41)==Address of T#AUXST desc ( ADDR(SSOWN_SSAUXDR0) ) FINISH ELSE REFVAL=ADDR(SSOWN_SSLIBERR(1)) FOR J=N-1,-1,0 CYCLE REFLOC=INTEGER(AD+J<<2) REFAD=SSOWN_AREASTART((REFLOC>>24)&X'0F')+REFLOC&X'00FFFFFF' INTEGER(REFAD)=REFVAL ! %IF SSOWN_LOADMONITOR&1#0 %THEN MONOUT("Data ref to ".LD9_IDEN." at ".HTOS(REFAD,8). %C ! " satisfied by known entry") {Temp} REPEAT CONTINUE FINISH DUMMY=DATA LHD=-1 DESC=CHECKLOADED(LD9_IDEN,DUMMY,LHD) IF DESC#0 THEN START ! It's loaded. Check the length of this ref against ! the entry. If lengths are the same then fill in ! and go on. If length ref<length loaded then ! print warning for all except FORTE and refs called F#BLCM. If > then print ! warning if PARM(LET) set, catastrophic fail ! otherwise. DR0=DR0&X'7FFFFFFF'; ! Off any common bit IF LD9_L<DR0 THEN START DATAREFWARNING(FILE,LD9_IDEN,0,N) UNLESS LD9_IDEN="F#BLCM" OR C LANG=FORTE OR SSOWN_NOWARNINGS#FALSE FINISH ELSE IF LD9_L>DR0 THEN START IF LET=0 THEN START FLAG=296 SSOWN_SSFNAME=LD9_IDEN TERMINALPRINT("**Error - Data ref ".LD9_IDEN." in ". C FILE," longer than entry and LOADPARM LET not set") ->OUT FINISH ELSE START DATAREFWARNING(FILE,LD9_IDEN,N,0) IF SSOWN_NOWARNINGS=FALSE FINISH FINISH FOR J=N-1,-1,0 CYCLE REFLOC=INTEGER(AD+J<<2) REFAD=SSOWN_AREASTART((REFLOC>>24)&X'0F')+REFLOC&X'00FFFFFF' INTEGER(REFAD)=INTEGER(REFAD)+DR1; ! Satisfy ref ! %IF SSOWN_LOADMONITOR&1#0 %THEN MONOUT("Data ref to ".LD9_IDEN." at ".HTOS(REFAD,8). %C ! " of len ".HTOS(LD9_L,8)." satisfied by known entry") {Temp} REPEAT FINISH ELSE START ! Not currently loaded. Add to unsat ref table. It might ! already be there or it might be a new one. If it is there ! then it will have a length associated with it. ! For now just add the reference, deal with any inconsistencies ! at ref satisfying time. ADDREF(LD9_IDEN,FFLAG,LD9_L!LCMN,AD,DATA!LCMN,UNSATISFIED,LOCLL,LHD,N) FLAG=FFLAG AND ->OUT IF FFLAG>0 SSOWN_SSCOMREG(7)=SSOWN_SSCOMREG(7)+1 IF FFLAG<0 FINISH REPEAT !* !* SINGLE WORD REFS (listhead 11) !* I=LDATA(11) WHILE I#0 CYCLE AD=RR_CONAD+I LD11==RECORD(AD) ! Search currently loaded for either code or data ref DUMMY=CODE!DATA LHD=-1 DESC=CHECKLOADED(LD11_IDEN,DUMMY,LHD) IF DESC#0 THEN START REFAD=SSOWN_AREASTART(LD11_REFLOC>>24)+LD11_REFLOC&X'00FFFFFF' INTEGER(REFAD)=INTEGER(REFAD)+DESC&X'00000000FFFFFFFF' ! %IF SSOWN_LOADMONITOR&1#0 %THEN MONOUT("Single wd ref to ".LD11_IDEN." at ".HTOS(REFAD,8). %C ! " satisfied by known entry") {Temp} FINISH ELSE START ! Didn't find it ADDREF(LD11_IDEN,FFLAG,0,AD+4,CODE!DATA,UNSATISFIED,LOCLL,LHD,1) FLAG=FFLAG AND ->OUT IF FFLAG>0 SSOWN_SSCOMREG(7)=SSOWN_SSCOMREG(7)+1 IF FFLAG<0 FINISH I=LD11_LINK REPEAT ! !*** !*** END OF LINK PHASE !*** ! IF SSOWN_LOADMONITOR&2#0 THEN MONOUT("**** Finished loading ".FILE." ****") OUT: IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"SFI") RETURN END ; ! OF LOADFILE2 ! ! SYSTEMROUTINE UNLOAD2(INTEGER LOCLL,FAIL) ! This routine unloads all files currently loaded with a load level ! greater than or equal to LOCLL. ! ***** Unloading strategy ***** ! 1. Find out which files are to be unloaded by scanning the temporarily ! loaded entry tables (and the permanently loaded tables if the load ! failed). Since these tables operate like a stack then ! only require to look at records which are situated beyond the start ! of the area assciated with LOCLL. Also construct a table of ! gla ranges to go. (T#UGLA, maybe #BGLA, and any gla associated with ! bound files connected at their preferred gla sites.) ! 2. Reduce use counts and disconnect files with use counts of 0. ! Destroy any T#CODE or T#GLA files with use counts of 0. ! 3. Discard any ref in the unsat/dyn table which has a loadlevel ! >= LOCLL. ! Any ref with loadlevel<LOCLL which is currently satisfied (dyn/unsat ! bits in basic record NOT set) should be checked to see whether it now ! points into an area of gla about to be unloaded. If it does then unfix ! and replace with an escape descriptor derived from the associated escape ! table and warn the caller what has been done. ! ***************************************************************** ! N.B. The only trappable failure of UNLOAD2 is when attempting to ! destroy T# files or disconnect files to be unloaded. Since these failures ! do not catastrophically affect the operation of the loader then they will ! merely be reported and UNLOAD2 won't return an error flag ! INTEGERFN DEADREF(INTEGER AD,NDUFF) INTEGER I,FLAG FLAG=FALSE FOR I=0,1,NDUFF CYCLE FLAG=TRUE AND EXIT IF SSOWN_DUFFGLA(I)_FROM<=AD<=SSOWN_DUFFGLA(I)_TO REPEAT IF FLAG=FALSE AND SSOWN_DYNREFSTART<=AD<SSOWN_DYNREFEND THEN FLAG=TRUE ! A ss dynamic ref. IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"iIR") RESULT =FLAG END ; ! OF DEADREF ! ! ROUTINE DISCARDFILES(INTEGERARRAYNAME LH, INTEGERNAME NDUFF, C INTEGER START,DSTART,NEXTFREE) RECORD (ENTF)NAME ENT STRING (31) S1,S2,FNAME INTEGER I,J,RECAD,LENE,FLAG ! All files from DSTART onwards have to be unloaded ! Chain down the filename listhead, pick up any new DUFFGLA ranges ! from T#GLA out of bound files, reduce use counts and destroy ! T#CODE and T#GLA as necessary. ! There are also DATASPACE entries on this listhead. These have ! ENT_TYPE=X'40000000'. J=LH(PRIME) WHILE J>0 CYCLE RECAD=START+J LENE=(BYTEINTEGER(RECAD)+4)&X'FFFFFFFC' ENT==RECORD(RECAD+LENE) IF J>=DSTART THEN START FNAME=STRING(RECAD) IF "+GL"#FNAME#"+IS" THEN START IF ENT_TYPE&X'40000000'#0 THEN START ! DATASPACE file - may have multiple use counts SETUSE(FNAME,-1,0) FOR I=ENT_USECOUNT,-1,0 FINISH ELSE START SETUSE(FNAME,-1,0); ! Reduce use count IF FNAME->S1.("T#CODE").S2 THEN DESTROY(FNAME,FLAG) ELSE C IF FNAME->S1.("T#GLA").S2 THEN START ! More DUFFGLA SSOWN_DUFFGLA(NDUFF)_FROM=ENT_GLAFROM SSOWN_DUFFGLA(NDUFF)_TO=ENT_GLATO NDUFF=NDUFF+1 DESTROY(FNAME,FLAG) FINISH ELSE IF SSOWN_LOADMONITOR&2#0 THEN MONOUT(">>>> Unloading ".FNAME." <<<<") FINISH FINISH FINISH J=ENT_LINK REPEAT ! Now update entry link fields FOR I=PRIME,-1,0 CYCLE IF LH(I)=0 THEN CONTINUE ; ! Nothing on listhead IF LH(I)>=DSTART THEN LH(I)=0 AND CONTINUE ; ! Discard whole chain ! So if here then chain is wholly retained or straddles DSTART J=LH(I) WHILE J>0 CYCLE RECAD=START+J LENE=(BYTEINTEGER(RECAD)+4)&X'FFFFFFFC' ENT==RECORD(RECAD+LENE) IF ENT_LINK>=DSTART THEN ENT_LINK=-1 AND EXIT ; ! Terminate chain J=ENT_LINK REPEAT REPEAT ! Zero the deleted areas FILL(NEXTFREE-DSTART,START+DSTART,X'00') IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"4Niii") RETURN END ; ! OF DISCARDFILES ! INTEGERFN TIDYIRECS(INTEGERNAME RTYPE,FIRST,LAST, C INTEGER LOCLL,START,RECAD,PERMTOUNLOAD,NDUFF,PERMDUFF) ! Function destroys any info records off the current basic record which ! have loadlevels>=current loadlevel being unloaded. ! It also restores escape descriptors for previously satisfied refs which ! now point into an area of gla which has to be unloaded. RECORD (IREFF)NAME R2 INTEGER IRECAD,J,LASTLINKAD,TYPE,DUFFREF,RETAINREF,AD,SSDYNREF LASTLINKAD=ADDR(FIRST) J=FIRST; ! Link to first info rec. WHILE J>0 CYCLE SSDYNREF=FALSE IRECAD=START+J R2==RECORD(IRECAD) J=R2_LINK ! Check loadlevel - bottom 5 bits of top byte of DR0 field ! Destroy info rec if loadlevel>=locll or for a failed load ! check whether the ref is located in the area of gla being removed ! or an area of ISTK being unloaded IF PERMTOUNLOAD#FALSE AND DEADREF(R2_DR1,PERMDUFF)#0 THEN C RETAINREF=FALSE ELSE RETAINREF=TRUE; ! Check whether perm ref to stay IF (R2_DR0>>24)&X'1F'>=LOCLL OR RETAINREF=FALSE THEN START ! Get rid of it. Update last link. INTEGER(LASTLINKAD)=R2_LINK FILL(16,IRECAD,X'82') ! If this hole has an offset less than SSOWN_NEXTAD(1) then reset SSOWN_NEXTAD(1) IF IRECAD-START<SSOWN_NEXTAD(1) THEN SSOWN_NEXTAD(1)=IRECAD-START FINISH ELSE START ! Ref at lower loadlevel than entry or possibly locll 0 LASTLINKAD=IRECAD+12; ! Update LASTLINKAD IF RTYPE&X'70000000'=0 THEN START ! Satisfied ref. Check if it has to be unfixed (i.e. points ! into a DUFFGLA area) TYPE=RTYPE&X'1FFFFFFF'; ! Off cmn/dyn/unsat bits IF TYPE=CODE THEN START AD=INTEGER(R2_DR1+4) ! If this is a ss dyn ref then AD points at the escape table ! otherwise it points into the gla of the file containing the ! entry which satisfied this ref. For a ss dyn ref then this info ! is at AD+12 IF SSOWN_DYNREFSTART<=AD<SSOWN_DYNREFEND THEN SSDYNREF=TRUE C AND DUFFREF=DEADREF(INTEGER(AD+12),PERMDUFF) ELSE C DUFFREF=DEADREF(AD,NDUFF) FINISH ELSE DUFFREF=DEADREF(INTEGER(R2_DR1),NDUFF) UNLESS DUFFREF=FALSE THEN START ! Ref has to be unfixed. SATISFYREF should have ensured that ! there is an escape table. RTYPE=RTYPE!DYN; ! Recreate dynamic ref IF TYPE=CODE THEN START ! Fill in escape descriptor EXCEPT for subsystem dynamic ! refs. These are invariant since the ss basegla is not connected ! in write mode. IF SSDYNREF=FALSE THEN START LONGINTEGER(R2_DR1)=ESCDR!R2_ADYNR IF SSOWN_NOWARNINGS=FALSE THEN C TERMINALPRINT("Warning - Code ref to ".STRING(RECAD)." at ", C HTOS(R2_DR1,8)." made dynamic while unloading") FINISH ELSE INTEGER(AD+12)=0 FINISH ELSE C IF TYPE=DATA THEN START LONGINTEGER(R2_DR1-4)=ESCDR!R2_ADYNR IF SSOWN_NOWARNINGS=FALSE THEN C TERMINALPRINT("Warning - Data ref to ".STRING(RECAD)." at ", C HTOS(R2_DR1,8)." made dynamic while unloading") FINISH ELSE START INTEGER(R2_DR1)=X'FFFFFFFF' IF SSOWN_NOWARNINGS=FALSE THEN C TERMINALPRINT("Warning - Single word ref ".STRING(RECAD)." made pseudo dynamic while unloading"," Will fail catastrophically if called directly") FINISH FINISH FINISH FINISH REPEAT ! Now if the last info rec has been destroyed or there was only one anyway ! then the integer at LASTLINKAD is not going to be synonymous with LAST. ! LAST should point at this record IF INTEGER(LASTLINKAD)<0 THEN LAST=LASTLINKAD-12-START ! If FIRST<=0 no info chain remains. IF FIRST<=0 THEN J=0 ELSE J=1 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(J,"nnnIiiIIIR") RESULT =J END ; ! OF TIDYIRECS ! ! INTEGER I,J,NDUFF,TSTART,PSTART,PERMDUFF,FLAG INTEGER LENE,RECAD,START,LASTLINKAD,AD,TEMPTOUNLOAD,PERMTOUNLOAD RECORD (BREFF)NAME R1 INTEGERNAME RTYPE IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FAIL,"II"); ! N.B. Monitor on entry only ! Check for failed PRELOAD. IF SSOWN_PRELOADFAILED#FALSE=FAIL THEN SSOWN_PRELOADFAILED=FALSE AND FAIL=TRUE RETURN IF LOCLL<=0 AND FAIL=FALSE; ! Not allowed ! Find out what there is that is unloadable IF SSOWN_LLINFO(0)_TAB=SSOWN_PERMOFFSET OR FAIL=FALSE THEN PERMTOUNLOAD=FALSE ELSE C PERMTOUNLOAD=TRUE IF (LOCLL=1 AND SSOWN_LLINFO(LOCLL)_TAB=SSOWN_TEMPOFFSET) OR SSOWN_LLINFO(LOCLL)_TAB=0 C THEN TEMPTOUNLOAD=FALSE ELSE TEMPTOUNLOAD=TRUE ! Which leads to the following table : ! FAIL TEMPTOUNLOAD PERMTOUNLOAD Require UNLOAD? ! F F F NO ! F F T NO ! F T F YES ! F T T YES ! T F F NO ! T F T YES ! T T F YES ! T T T YES ! Check PARTLOADED array in case we got interrupted during ! the critical phase of LOADFILE. FOR I=2,-1,0 CYCLE IF SSOWN_PARTLOADED(I)#"" THEN START SETUSE(SSOWN_PARTLOADED(I),-1,0) IF I#0 THEN DESTROY(SSOWN_PARTLOADED(I),FLAG); ! i.e. a T#CODE or T#GLA SSOWN_PARTLOADED(I)=""; ! Reset it FINISH REPEAT IF FAIL=FALSE=TEMPTOUNLOAD OR (FAIL#FALSE AND C TEMPTOUNLOAD=FALSE=PERMTOUNLOAD) THEN START SSOWN_MAINDR1=0 IF LOCLL=1 THEN SSOWN_MONTIMEBASE=0 RETURN FINISH PSTART=SSOWN_SSLOADTAB(2)_START; ! Start of perm loaded entry table TSTART=SSOWN_SSLOADTAB(3)_START; ! Start of temp loaded entry table NDUFF=0 SSOWN_SSINHIBIT=TRUE; ! Turn off inhibits IF FAIL#FALSE AND SSOWN_LLINFO(0)_TAB#SSOWN_PERMOFFSET THEN START ! Load failed - something loaded on basegla during it, so unload it SSOWN_DUFFGLA(NDUFF)_FROM=SSOWN_LLINFO(0)_GLA SSOWN_DUFFGLA(NDUFF)_TO=SSOWN_SSCURBGLA NDUFF=NDUFF+1 ! For perm loaded material we also have to check permistk range ! which may be removed. Add this to DUFFGLA as well although its not gla. IF SSOWN_USTB#0 AND SSOWN_PERMISTK#SSOWN_LLINFO(0)_ISTK THEN START SSOWN_DUFFGLA(NDUFF)_FROM=SSOWN_PERMISTK SSOWN_DUFFGLA(NDUFF)_TO=SSOWN_LLINFO(0)_ISTK NDUFF=NDUFF+1 FINISH START=PSTART+LHOFFSET DISCARDFILES(SSOWN_PLH,NDUFF,PSTART,SSOWN_LLINFO(0)_TAB,SSOWN_PERMOFFSET) PERMDUFF=NDUFF-1 SSOWN_PERMOFFSET=SSOWN_LLINFO(0)_TAB SSOWN_SSCURBGLA=SSOWN_LLINFO(0)_GLA SSOWN_PERMISTK=SSOWN_LLINFO(0)_ISTK FINISH ! UGLA area to be discarded SSOWN_DUFFGLA(NDUFF)_FROM=SSOWN_LLINFO(LOCLL)_GLA SSOWN_DUFFGLA(NDUFF)_TO=SSOWN_SSCOMREG(44) NDUFF=NDUFF+1 ! If there is any tempistk to unload then add to DUFFGLA as well ! in case anything refers to it. Only possibly relevant when LOADLEVEL>1. IF SSOWN_USTB#0 AND SSOWN_LLINFO(LOCLL)_ISTK#SSOWN_TEMPISTK THEN START SSOWN_DUFFGLA(NDUFF)_FROM=SSOWN_LLINFO(LOCLL)_ISTK SSOWN_DUFFGLA(NDUFF)_TO=SSOWN_TEMPISTK NDUFF=NDUFF+1 FINISH ! Scan the temp table entries still loaded, update the links and ! zero the released area. START=TSTART+LHOFFSET DISCARDFILES(SSOWN_TLH,NDUFF,TSTART,SSOWN_LLINFO(LOCLL)_TAB,SSOWN_TEMPOFFSET) SSOWN_TEMPOFFSET=SSOWN_LLINFO(LOCLL)_TAB SSOWN_SSCOMREG(44)=SSOWN_LLINFO(LOCLL)_GLA SSOWN_TEMPISTK=SSOWN_LLINFO(LOCLL)_ISTK NDUFF=NDUFF-1 ! Tidy ref tables by discarding any ref with loadlevel>=LOCLL ! Any ref with loadlevel< LOCLL should be unfixed if it is satisfied ! and now points into a DUFFGLA area. START=SSOWN_SSLOADTAB(1)_START FOR I=PRIME-1,-1,0 CYCLE IF SSOWN_RLH(I)>0 THEN START ! Something on this listhead LASTLINKAD=START+I<<2; ! Ad of first link field J=SSOWN_RLH(I) ! Search basic records WHILE J>0 CYCLE RECAD=START+J LENE=(BYTEINTEGER(RECAD)+8)&X'FFFFFFF8'; ! Bytes of name RTYPE==INTEGER(RECAD+LENE) AD=RECAD+LENE+4 R1==RECORD(AD); ! The basic record J=R1_LINK ! Now want to tidy the information records. Do this in a ! function for readability of the code. IF TIDYIRECS(RTYPE,R1_FIRST,R1_LAST,LOCLL,START,RECAD, C PERMTOUNLOAD,NDUFF,PERMDUFF)=0 THEN START ! No info records left - destroy basic record INTEGER(LASTLINKAD)=R1_LINK; ! Relink basic chain FILL(LENE+16,RECAD,X'82') IF RECAD-START<SSOWN_NEXTAD(1) THEN SSOWN_NEXTAD(1)=RECAD-START FINISH ELSE LASTLINKAD=RECAD+LENE+12 REPEAT FINISH REPEAT ! Check if USEFOR has been used and has been unloaded in this call of UNLOAD2. IF SSOWN_USEFORDESCAD#0#DEADREF(SSOWN_USEFORDESCAD,NDUFF) THEN C SSOWN_USEFORDESCAD=0 AND SSOWN_USEFORLASTNAME="" ! Now tidy LLINFO IF LOCLL>1 THEN START I=LOCLL WHILE SSOWN_LLINFO(I)_TAB#0 CYCLE SSOWN_LLINFO(I)_TAB=0 I=I+1 REPEAT FINISH ! In the course of unloading we may have had to create new escape ! records on the base gla so update LLINFO(0)_GLA SSOWN_LLINFO(0)_GLA=SSOWN_SSCURBGLA SSOWN_MAINDR1=0; ! Reset IF LOCLL=1 THEN SSOWN_MONTIMEBASE=0; ! Reset for next load if at command level SSOWN_LOADINPROGRESS=FALSE; ! In case it isn't SSOWN_SSCOMREG(7)=0 ALLOWINTERRUPTS RETURN END ; ! OF UNLOAD2 ! ! STRINGFN NEXTREF(INTEGERNAME TYPE,DR0,RECSTART,LHD) ! Gets the next unsatisfied reference from the loader tables ! by inspecting the basic records. Looking for unsatisfied code, ! data or single word refs. ! Preferentially searches for code refs before data refs on the ! assumption that since most data refs are to common areas to be ! created by the loader then the longer we wait the more likely ! the longest length for this area will turn up and avoid ! unnecessary failures. ! For a data ref then inspect the chain of information records. If ! any of them have the common bit set then return the maximum length ! of the records which have the common bit set through DR0 since ! the loader will create space if the directory search fails. ! Data refs are selected before single word refs since a common area ! created by the loader could satisfy a single word ref of the same ! name. Also return basic record address. RECORD (BREFF)NAME R1 RECORD (IREFF)NAME R2 INTEGER I,START,RECAD,DRECAD,SRECAD,IRECAD,J,K,MAXLEN,LEN INTEGER XTYPE,STYPE,DTYPE,SLHD,DLHD STRING (31) RES START=SSOWN_SSLOADTAB(1)_START DRECAD=0 SRECAD=0 DR0=0 FOR J=PRIME-1,-1,0 CYCLE IF SSOWN_RLH(J)>0 THEN START ! Found a chain I=SSOWN_RLH(J) WHILE I>0 CYCLE RECAD=START+I LEN=(BYTEINTEGER(RECAD)+8)&X'FFFFFFF8'; ! Bytes for name str TYPE=INTEGER(RECAD+LEN) R1==RECORD(RECAD+LEN+4) ! An unsatisfied code ref (note not dynamic) in this chain ! will mean that the UNSAT bit is set in TYPE. Return the name ! and the TYPE minus dyn and unsat bits. If it's not code ! and we haven't already found a data or single word ref ! then assign the record address to DRECAD and the type to ! DTYPE for possible later use if we don't find any unsat ! code refs. IF TYPE&UNSAT#0 THEN START XTYPE=TYPE&X'1FFFFFFF' IF XTYPE=CODE THEN START RECSTART=I LHD=J RES=STRING(RECAD) IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"nnnNR") RESULT =RES FINISH ELSE C IF XTYPE=CODE!DATA AND SRECAD=0 THEN SRECAD=RECAD AND C STYPE=TYPE AND SLHD=J ELSE C IF XTYPE=DATA AND DRECAD=0 THEN START DRECAD=RECAD DTYPE=TYPE DLHD=J MAXLEN=0 ! Now search the information chain for the maximum ! length common area (if any) K=R1_FIRST WHILE K>0 CYCLE IRECAD=START+K R2==RECORD(IRECAD) IF R2_DR0&X'80000000'#0 AND C R2_DR0&X'00FFFFFF'>MAXLEN THEN C MAXLEN=R2_DR0&X'00FFFFFF' K=R2_LINK REPEAT FINISH FINISH I=R1_LINK REPEAT FINISH REPEAT ! If here then haven't found a code ref. There ought to be a data/single ! word ref or the table is all screwed up IF DRECAD#0 THEN START TYPE=DTYPE DR0=MAXLEN RECSTART=DRECAD-START LHD=DLHD RES=STRING(DRECAD) IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"nnnNR") RESULT =RES FINISH IF SRECAD#0 THEN START TYPE=STYPE RECSTART=SRECAD-START LHD=SLHD RES=STRING(SRECAD) IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"nnnNR") RESULT =RES FINISH ! We should never get to here TYPE=0 RES="" IF SSOWN_DIAGMON&1#0 THEN SSTRACE(RES,"nnnNR") RESULT ="" END ; ! OF NEXTREF ! ! ROUTINE CHANGEREFTYPE(INTEGER RECSTART,REFTYPE) ! Makes unsatisfied info records off the basic chain at RECAD ! into dynamic records if REFTYPE=DYNAMIC otherwise puts in escape ! descriptor to unsat ref code. Since the searching criterion ! for NEXTREF is the unsat bit set in the basic record then ! this bit is unset. Dyn bit is set in both basic and info recs ! if REFTYPE=DYNAMIC. Unsat bit unset in info recs if they are ! made dynamic otherwise it's left alone. RECORD (BREFF)NAME R1 RECORD (IREFF)NAME R2 INTEGER J,LENE,RECAD,IRECAD,XTYPE,ESCTYPE INTEGERNAME RTYPE STRING (31) REF,ST ! Map on to basic record RECAD=SSOWN_SSLOADTAB(1)_START+RECSTART REF=STRING(RECAD) LENE=(BYTEINTEGER(RECAD)+8)&X'FFFFFFF8' RTYPE==INTEGER(RECAD+LENE) SSOWN_SSINHIBIT=TRUE RTYPE=RTYPE&X'DFFFFFFF'; ! Off unsat bit IF REFTYPE=DYNAMIC THEN RTYPE=RTYPE!DYN ELSE RTYPE=RTYPE!UNRES ! Note. This is the only place where the unresolved bit can be set. XTYPE=RTYPE&X'0FFFFFFF'; ! Off cmn/dyn/unsat/unres bits R1==RECORD(RECAD+LENE+4) ! Now investigate the info recs ! Code and data refs require escape tables whereas single word ! refs can only be made pseudo dynamic J=R1_FIRST WHILE J>0 CYCLE IRECAD=J+SSOWN_SSLOADTAB(1)_START R2==RECORD(IRECAD) IF R2_DR0&UNSAT#0 THEN START ! Interested in this one IF REFTYPE=DYNAMIC THEN START ESCTYPE=XTYPE!DYN R2_DR0=(R2_DR0!DYN)&X'DFFFFFFF'; ! Set dyn / unset unsat ST=" made type DYNAMIC. " FINISH ELSE ESCTYPE=XTYPE AND ST=" made type UNRESOLVED. " IF XTYPE=CODE THEN START R2_ADYNR=ESCAPEREC(ESCTYPE,RECSTART,R2_DR1,(R2_DR0>>24)&X'1F') LONGINTEGER(R2_DR1)=ESCDR!R2_ADYNR IF SSOWN_LOADMONITOR&16#0 THEN C PRINTSTRING("Code ref ".REF." at ".HTOS(R2_DR1,8).ST) FINISH ELSE IF XTYPE=DATA THEN START R2_ADYNR=ESCAPEREC(ESCTYPE,RECSTART,R2_DR1,(R2_DR0>>24)&X'1F') LONGINTEGER(R2_DR1-4)=ESCDR!R2_ADYNR IF SSOWN_LOADMONITOR&16#0 THEN C PRINTSTRING("Data ref ".REF." at ".HTOS(R2_DR1,8).ST) FINISH ELSE START INTEGER(R2_DR1)=X'FFFFFFFF'; ! Imposs address PRINTSTRING("Warning - Single word ref ".REF. C " made pseudo dynamic. Will fail catastrophically if called.") FINISH FINISH J=R2_LINK REPEAT SSOWN_SSCOMREG(7)=SSOWN_SSCOMREG(7)-1; ! Decrement unsat ref count ALLOWINTERRUPTS IF SSOWN_DIAGMON&1#0 THEN SSTRACE(J,"ii") RETURN END ; ! OF CHANGEREFTYPE ! ! ROUTINE CREATECMN(STRING (31) LOOKFOR, INTEGER LL,DR0, INTEGERNAME FLAG, C INTEGER LHD) LONGINTEGER DESC INTEGER START BYTEINTEGER FILLER IF SSOWN_SSCOMREG(39)&4=0 THEN FILLER=X'81' ELSE C FILLER=X'00' START=GETGLA(LL,DR0) FILL(DR0,START,FILLER) IF LL=0 THEN ADDENTRY(LOOKFOR,SSOWN_PLH,FLAG,SSOWN_PERMOFFSET,DATA,DR0,START,2,LHD) ELSE C ADDENTRY(LOOKFOR,SSOWN_TLH,FLAG,SSOWN_TEMPOFFSET,DATA,DR0,START,3,LHD) ->OUT IF FLAG#0 IF SSOWN_LOADMONITOR&4#0 THEN MONOUT("Common area ". C LOOKFOR." created at ".HTOS(START,8)." of length ". C HTOS(DR0,8)) DESC=DR0 DESC=(DESC<<32)!START SATISFYREF(LOOKFOR,DESC,FLAG,DATA,LL,LHD) ->OUT IF FLAG#0 OUT: IF SSOWN_DIAGMON&1#0 THEN SSTRACE(START,"SIiFI") RETURN END ; ! OF CREATECMN ! ! SYSTEMROUTINE CASCADELOAD(INTEGERNAME FLAG, INTEGER LOCLL) STRING (31) LOOKFOR,FILE,ACTUALEPNAME LONGINTEGER DESC INTEGER URECAD,FFLAG,LL,TYPE,DR0,XTYPE,LHD,LHDA IF SSOWN_LOADINPROGRESS=FALSE THEN SSOWN_LOADINPROGRESS=TRUE FLAG=0 LL=LOCLL CYCLE WHILE SSOWN_SSCOMREG(7)#0 CYCLE LOOKFOR=NEXTREF(TYPE,DR0,URECAD,LHD); ! The next unsat ref XTYPE=TYPE&X'1FFFFFFF'; ! 1FFFFFFF not 0FFFFFFF since if unsat not unres FFLAG=SEARCH(LOOKFOR,DESC,FILE,ACTUALEPNAME,XTYPE,LL) IF FFLAG<0 THEN START ! Already loaded - satisfy refs SATISFYREF(LOOKFOR,DESC,FLAG,XTYPE,LL,LHD); ! Decrements SSOWN_SSCOMREG(7) if req. ->OUT IF FLAG#0; ! Something nasty happened FINISH ELSE IF FFLAG=0 THEN EXIT ELSE START ! Didn't find it so .... ! 1. Check if data common and create if necessary else ! 2. If parm let set then change ref type to unresolved ! 3. Fail IF TYPE&CMN#0 AND TYPE&X'1FFFFFFF'=DATA THEN START ! Create common area CREATECMN(LOOKFOR,LL,DR0,FLAG,LHD) ->OUT IF FLAG#0 FINISH ELSE IF LET#0 THEN START CHANGEREFTYPE(URECAD,UNRESOLVED) IF SSOWN_NOWARNINGS=FALSE THEN C TERMINALPRINT("Unresolved ref ",LOOKFOR) NEWLINE FINISH ELSE START FLAG=289 SSOWN_SSFNAME=LOOKFOR TERMINALPRINT("Unsatisfied ref ",LOOKFOR) NEWLINE ->OUT FINISH FINISH REPEAT SSOWN_LOADINPROGRESS=FALSE AND ->OUT IF FILE=""; ! Happens if last ref is made unresolved LOADFILE2(FILE,FLAG,LL) ->OUT IF 0#FLAG#350; ! 350 (already loaded) means an inconsistent directory. ! Now that the file is loaded there could have been 1 of 3 outcomes: ! 1. ACTUALEPNAME is not loaded, i.e. the directory is inconsistent. ! 2. ACTUALEPNAME is loaded and either LOOKFOR=ACTUALEPNAME in which case ! LOADFILE2 satisfied the reference or ! 3. LOOKFOR#ACTUALEPNAME, i.e. an alias, and we have still to satisfy LOOKFOR. ! So call SEARCHLOADED for the descriptor to ACTUALEPNAME and proceed from ! there. IF LOOKFOR=ACTUALEPNAME THEN LHDA=LHD ELSE LHDA=HASH(ACTUALEPNAME,PRIME) DESC=SEARCHLOADED(ACTUALEPNAME,XTYPE,LHDA) IF DESC=0 THEN START SSOWN_SSFNAME=ACTUALEPNAME FLAG=293; ! Inconsistent directory entry for ACTUALEPNAME ->OUT FINISH IF LOOKFOR#ACTUALEPNAME THEN START SATISFYREF(LOOKFOR,DESC,FLAG,XTYPE,LL,LHD) ->OUT IF FLAG#0 FINISH LL=LOCLL IF LL#LOCLL SSOWN_LOADINPROGRESS=FALSE AND ->OUT IF SSOWN_SSCOMREG(7)=0 REPEAT OUT: IF SSOWN_DIAGMON&1#0 THEN SSTRACE(LL,"FI") RETURN END ; ! OF CASCADELOAD ! ! SYSTEMROUTINE MINLOAD(INTEGER LOCLL,MAKEDYNAMIC, INTEGERNAME FLAG) STRING (31) LOOKFOR INTEGER URECAD,TYPE,DR0,NEWTYPE,LHD IF SSOWN_LOADINPROGRESS=FALSE THEN SSOWN_LOADINPROGRESS=TRUE FLAG=0 IF MAKEDYNAMIC#FALSE THEN NEWTYPE=DYNAMIC ELSE NEWTYPE=UNRESOLVED WHILE SSOWN_SSCOMREG(7)#0 CYCLE LOOKFOR=NEXTREF(TYPE,DR0,URECAD,LHD) ! Create any common areas IF TYPE&CMN#0 AND TYPE&X'1FFFFFFF'=DATA THEN START CREATECMN(LOOKFOR,LOCLL,DR0,FLAG,LHD) ->OUT IF FLAG#0 CONTINUE FINISH CHANGEREFTYPE(URECAD,NEWTYPE) REPEAT SSOWN_LOADINPROGRESS=FALSE OUT: IF SSOWN_DIAGMON&1#0 THEN SSTRACE(LHD,"IIF") RETURN END ; ! OF MINLOAD ! ! SYSTEMLONGINTEGERFN LOADEP(STRING (31) ENTRY, C INTEGERNAME TYPE,FLAG, INTEGER LOCLL) STRING (31) FILE,ACTUALEPNAME INTEGER FFLAG,ETYPE LONGINTEGER EDESC IF SSOWN_LOADINPROGRESS=FALSE THEN SSOWN_LOADINPROGRESS=TRUE EDESC=0 ETYPE=TYPE FLAG=0 ! See if it's already loaded FFLAG=SEARCH(ENTRY,EDESC,FILE,ACTUALEPNAME,ETYPE,LOCLL) IF FFLAG<0 THEN START ! Already loaded SSOWN_LOADINPROGRESS=FALSE ->OUT FINISH ELSE IF FFLAG>0 THEN START FLAG=FFLAG EDESC=0 ->OUT FINISH ! If here then found a file LOADFILE2(FILE,FLAG,LOCLL) IF 316#FLAG#0 THEN EDESC=0 AND ->OUT; ! 316 if a macro found IF FLAG=316 THEN START ETYPE=MACRO; ! Old style directories don't differentiate code¯o FLAG=0 EDESC=LONGINTEGER(ADDR(SSOWN_MACRODR0)) ->OUT FINISH ! We know that we must have loaded the file we want, but it may have ! been loaded as the end result of an alias chain so must use ! ACTUALEPNAME with LOOKLOADED to get the descriptor. EDESC=LOOKLOADED(ACTUALEPNAME,ETYPE) IF EDESC=0 THEN START ! We have loaded the file that the directory said we should load but the ! entry point isn't there. We must have an inconsistent directory, i.e. ! an object file has been updated but the directory it is inserted into ! hasn't been. SSOWN_SSFNAME=ACTUALEPNAME FLAG=293; ! Inconsistent directory entry for & EDESC=0 ->OUT FINISH IF SSOWN_SSCOMREG(7)#0 THEN START ! If here then some unsatisfied refs. What we do depends on the load ! parms. IF DYNLOAD=FALSE THEN CASCADELOAD(FLAG,LOCLL) ELSE C MINLOAD(LOCLL,DYNLOAD,FLAG) IF FLAG#0 THEN EDESC=0 AND ->OUT FINISH ELSE SSOWN_LOADINPROGRESS=FALSE ! All O.K. if here - update LLINFO(0) IF SSOWN_LLINFO(0)_TAB#SSOWN_PERMOFFSET THEN START SSOWN_LLINFO(0)_TAB=SSOWN_PERMOFFSET SSOWN_LLINFO(0)_GLA=SSOWN_SSCURBGLA SSOWN_LLINFO(0)_ISTK=SSOWN_PERMISTK FINISH OUT: IF FLAG=0 THEN TYPE=ETYPE IF SSOWN_DIAGMON&1#0 THEN SSTRACE(EDESC,"SNFIr") RESULT =EDESC END ; ! OF LOADEP ! ! SYSTEMLONGINTEGERFN LOADENTITY(STRING (31) ENTRY, INTEGERNAME TYPE,FLAG, C INTEGER LOCLL) STRING (31) S1,S2 RECORD (LD1F)NAME LD1 LONGINTEGER EDESC INTEGER ETYPE,I,START,FOUND RECORD (RF) RR IF SSOWN_LOADINPROGRESS=FALSE THEN SSOWN_LOADINPROGRESS=TRUE ! If ENTRY contains '_' or '.' then can avoid LOADEP call UNLESS ENTRY->S1.(".").S2 OR ENTRY->S1.("_").S2 THEN START ! Try as a command ETYPE=TYPE EDESC=LOADEP(ENTRY,ETYPE,FLAG,LOCLL) IF FLAG=0 THEN START TYPE=ETYPE IF SSOWN_DIAGMON&1#0 THEN SSTRACE(EDESC,"SNFIr") RESULT =EDESC FINISH ! If FLAG#289 then error and give up. However if 'not found' (289) ! then this might have come from failed cascade and want to give up ! under these circumstances as well. Only proceed if we couldn't find ENTRY IF FLAG#289 OR (FLAG=289 AND SSOWN_SSFNAME#ENTRY) THEN ->ERR FINISH ! Not a command and no funny failure. Try to CONNECT CONNECT(ENTRY,1,0,0,RR,FLAG) IF 218#FLAG#0 AND 220#FLAG#167 {Invalid filename} THEN ->ERR IF FLAG=218 OR (FLAG=0 AND SSCHARFILETYPE#RR_FILETYPE#SSOBJFILETYPE) C OR FLAG=220 OR FLAG=167 THEN START ! Didn't find it FLAG=289 ->ERR FINISH IF NEWCONNECT#0 THEN SETUSE (LASTFN, -1, 0) IF RR_FILETYPE=SSCHARFILETYPE THEN START PRINTSTRING("Character file ".ENTRY." found - attempting OBEYJOB ") SSOWN_LOADINPROGRESS=FALSE FLAG=-1 ->ERR FINISH SSOWN_MAINDR1=0 PRINTSTRING("Object file ".ENTRY." found - looking for main entry ") ! Check for main entry before calling LOADFILE2 START=RR_CONAD+INTEGER(RR_CONAD+24)+4; ! Listhead of code entries I=INTEGER(START) FOUND=FALSE WHILE I#0 CYCLE LD1==RECORD(RR_CONAD+I) IF LD1_LOC&X'80000000'#0 THEN FOUND=TRUE AND EXIT I=LD1_LINK REPEAT IF FOUND=FALSE THEN FLAG=298 AND ->ERR; ! No main entry PRINTSTRING("Main entry found ") LOADFILE2(ENTRY,FLAG,LOCLL) IF 350#FLAG#0 THEN ->ERR IF SSOWN_SSCOMREG(7)#0 THEN START ! Unsatisfied refs IF DYNLOAD=FALSE THEN CASCADELOAD(FLAG,LOCLL) ELSE C MINLOAD(LOCLL,DYNLOAD,FLAG) IF FLAG#0 THEN ->ERR FINISH ELSE SSOWN_LOADINPROGRESS=FALSE ! All O.K. if here - update LLINFO(0) IF SSOWN_LLINFO(0)_TAB#SSOWN_PERMOFFSET THEN START SSOWN_LLINFO(0)_TAB=SSOWN_PERMOFFSET SSOWN_LLINFO(0)_GLA=SSOWN_SSCURBGLA SSOWN_LLINFO(0)_ISTK=SSOWN_PERMISTK FINISH TYPE=X'80000000'; ! Set top bit to indicate ENTER mode is 0 EDESC=X'B100000000000000'!SSOWN_MAINDR1 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(EDESC,"SNFIr") RESULT =EDESC ERR: EDESC=0 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(EDESC,"SNFIr") RESULT =0 END ; ! OF LOADENTITY ! ! SYSTEMLONGINTEGERFN DYNAMICREF(INTEGER DR0,DR1) ! Function to handle dynamic refs which require to be satisfied. ! Called from INITDYNAMICREF. STRING (31) ENAME LONGINTEGER EDESC,DESC RECORD (ESCF)NAME DREC INTEGER RECAD,LENE,TYPE,FLAG,LNB ! DR1 is the address of the escape table from which the basic record ! describing this ref can be obtained. From this we want the name and ! the type to call LOADEP. ! PRINTSTRING("+++ Call to DYNAMICREF ==> ".HTOS(DR1,8)." +++ ! ") DREC==RECORD(DR1) RECAD=SSOWN_SSLOADTAB(1)_START+DREC_RECAD; ! Addr of basic record ENAME=STRING(RECAD) LENE=(BYTEINTEGER(RECAD)+8)&X'FFFFFFF8'; ! Bytes of name string TYPE=INTEGER(RECAD+LENE)&X'1FFFFFFF'; ! Off cmn/dyn/unsat bits IF SSOWN_LOADMONITOR&1#0 THEN MONOUT("Attempting to load ".ENAME." dynamically") ! Now a call on LOADEP should, if successful, satisfy all outstanding refs ! to ENAME in the course of loading the file in which it occurs. ! N.B. It can't already be loaded since it wouldn't still be in the ref ! tables EDESC=LOADEP(ENAME,TYPE,FLAG,SSOWN_LOADLEVEL) IF FLAG=0 THEN START ! If dealing with code entry then result is EDESC. However if dealing ! with a data entry we have to restore the data descriptor exactly ! as it would have been if it had been there from the start. LOADEP will ! return the length and the address of the entry so we must reconstruct ! the descriptor by taking the type and bound from DREC_DR0 and adding ! the offset in DREC_DR1 to the address field in EDESC IF SSOWN_LOADMONITOR&1#0 THEN C MONOUT("Load initiated by dynamic call to ".ENAME." successful") IF TYPE&DATA#0 THEN START EDESC=EDESC&X'00000000FFFFFFFF' DESC=DREC_DR0 EDESC=DESC<<32+DREC_DR1+EDESC FINISH IF SSOWN_DIAGMON&1#0 THEN SSTRACE(EDESC,"iir") RESULT =EDESC FINISH ! If here then LOADEP failed for one reason or another. This means abandoning ! the load. IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"SFI") IF SSOWN_DIAGMON&1#0 THEN SSTRACE(EDESC,"iir") SELECTOUTPUT(0) PRINTSTRING(" Load initiated by dynamic call to ".ENAME." failed ") PSYSMES(47,FLAG) *STLN_LNB; ! Store current LNB SSOWN_SSCOMREG(10)=1; ! %MONITOR called flag for JCL interpreter NDIAG(X'2000000',INTEGER(INTEGER(LNB)),0,0) ! ** Comment ** ! The PC being handed to NDIAG is, to quote the old loader 'wrong value ! pro tem'. However it doesn't seem to matter judging by the effects. ! Handing over the appropriate value is slightly more difficult since ! it has to be done in conjunction with storing the environment before ! calling DYNAMICREF. In future it might be better to store the environment ! in a record rather than on the stack, in which case it would be possible to ! give a sensible PC. Another advantage would be preparing the way for ! storing multiple environments more tidily. RETURN TO COMMAND LEVEL END ; ! OF DYNAMICREF ! ! SYSTEMROUTINE UNSATREF(INTEGER DR0,DR1,PC) ! Routine handles any direct calls on unresolved refs. RECORD (ESCF)NAME DREC INTEGER RECAD,LNB ! All we require to do here is extract the name of the ref from the ! basic record then call NDIAG and tidy up. IF SSOWN_DIAGMON&1#0 THEN SSTRACE(PC,"iii") DREC==RECORD(DR1); ! The escape table RECAD=SSOWN_SSLOADTAB(1)_START+DREC_RECAD *STLN_LNB SELECTOUTPUT(0) PRINTSTRING("Attempt to call unsatisfied reference - ".STRING(RECAD)) NEWLINE SSOWN_SSCOMREG(10)=1; ! %MONITOR called flag for JCL interpreter NDIAG(PC,INTEGER(INTEGER(LNB)),0,0) RETURN TO COMMAND LEVEL END ; ! OF UNSATREF ! ! SYSTEMROUTINE ENTERONUSERSTACK(INTEGER USEPARAM,DR0,DR1, STRING (255) PARAM) !THIS IS CALLED BY ENTER WHEN WE ARE CALLING AN EXTERNAL ROUTINE !OR A MAIN PROGRAM.FOR EXTERNAL ROUTINES (USEPARAM#0) IT ENABLES US !TO CALL SIGNAL ON THE USER STACK AND HENCE MAKE "ON EVENT" WORK. INTEGER FLAG,LNB,FAILPC,NEWLNB,FAILDR0,FAILDR1 IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"IiiS") *STLN_LNB; !LNB FOR THIS ROUTINE *JLK_3; !TO OBTAIN ADDRESS OF NEXT INSTRUCTION *J_<FAIL> *LSS_TOS *ST_FAILPC; !THE PC TO BE USED FOR THE RETURN SIGNAL(0,FAILPC,LNB,FLAG) *STSF_NEWLNB; !LNB FOR THE CALLED ROUTINE *MPSR_X'40C0' ; !SET PROGRAM STATUS REG - MASK REAL UNDERFLOW SSOWN_SSCOMREG(36)=NEWLNB!4; !PRCL FORCES ODD ALIGNMENT - FOR %STOP ! If we have just executed a stack switch then remember the LNB in ! case we want to go back to command level directly later. IF SSOWN_USERSTACKLNB=0 THEN SSOWN_USERSTACKLNB=SSOWN_SSCOMREG(36) *PRCL_4 IF USEPARAM#0 START ; !CALL ROUTINE WITH PARAMETER *LSD_PARAM; !DESCRIPTOR TO PARAM *ST_TOS ; !TO STACK *LD_DR0; !PLT DESCRIPTOR TO DR *RALN_7 *CALL_(DR ) RETURN FINISH !MUST BE MAIN PROGRAM (OR COMPILER) CALL WITH NO PARAMETER *LD_DR0 *RALN_5 *CALL_(DR ) RETURN FAIL: !COMES HERE IF CONTINGENCY *ST_FAILDR0 IF SSOWN_RCODE=0 THEN SSOWN_RCODE=103050709 SIGNAL(0,FAILPC,LNB,FLAG); !REPLACE SIGNAL FOR NEXT TIME NDIAG(INTEGER(FAILDR1+16),INTEGER(FAILDR1+8),10,INTEGER(FAILDR1)) END ; ! OF ENTERONUSERSTACK ! ! SYSTEMROUTINE ENTER(INTEGER MODE,DR0,DR1, STRING (255) PARAM) INTEGER STACKSWITCH,SAVECURAUX,SAVECOMREG34,SAVECOMREG36,ACR,FLAG,SF INTEGER USEPARAM,LNB,NEWLNB,PRIV INTEGER EDR0,EDR1; ! Must stay together IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"IiiS") IF SSOWN_LOADMONITOR&1#0 THEN MONOUT("ENTER called") *STLN_LNB PRIV=INTEGER(LNB+4)&X'00040000'; ! PRIV bit in PSR STACKSWITCH=0 ! Switch stacks if a) you are presently on the base stack ! b) you are not privileged ! c) you are calling something outside the basefile ! or ! c') you explicitly request a stack switch IF CURSTACK=0=PRIV AND (DR1>SSOWN_LLINFO(-1)_GLA OR MODE&1#0) THEN STACKSWITCH = 1 USEPARAM=MODE&2; !MUST PUT DESCRIPTOR TO PARAM ON STACK SAVECOMREG36=SSOWN_SSCOMREG(36); !USED BY %STOP - Saved LNB for contingency trapping SAVECOMREG34=SSOWN_SSCOMREG(34); ! Signal level IF SSOWN_SSAUXDR1#0 START ; !AUX STACK IN USE - SAVE CURRENT TOP SAVECURAUX=SSOWN_SSCURAUX; ! Current base of AUXSTACK SSOWN_SSCURAUX=INTEGER(SSOWN_SSAUXDR1); ! Current limit of AUXSTACK FINISH ELSE SAVECURAUX=0 IF STACKSWITCH=1 START ; !NEED TO SELECT USER STACK IF SSOWN_USTB=0 THEN INITUSTK ACR=(INTEGER(LNB+4)>>20)&15; !CURRENT ACR LEVEL ! Call ENTERONUSERSTACK FLAG=DNEWOUTWARDCALL(ACR,1,SSOWN_USTB>>SEGSHIFT,SSOWN_EUDR0,SSOWN_EUDR1,EDR0,EDR1) IF FLAG#0 THEN DSTOP(122); ! DNEWOUTWARDCALL failed EDR0=EDR0!X'E3000000'; !TYPE SYSTEM CALL CHANGECONTEXT *PRCL_4 *LSS_USEPARAM *ST_TOS *LSD_DR0 *ST_TOS *LSD_PARAM *ST_TOS *LD_EDR0 *RALN_10 *CALL_(DR ) -> AFTERCALL FINISH ELSE START ; !ENTER ON CURRENT STACK EDR0=DR0 EDR1=DR1 *STSF_SF; !NEED TO ALIGN NEWLNB ON PAGE BOUNDARY SF=((4095-(SF&X'FFF'))>>2)+2; !NO OF WORDS TO ALIGN *ASF_SF *STSF_NEWLNB SSOWN_SSCOMREG(36)=NEWLNB; !PRCL ALIGNS LNB ON ODD WORD !TEMP NEED TO OR WITH 4 ON LAST LINE FINISH IF USEPARAM=0 START ; !NO PARAMETER *PRCL_4 *LD_EDR0; !ENTRY DESCRIPTOR *RALN_5 *CALL_(DR ) FINISH ELSE START *PRCL_4 *LSD_PARAM; !DESCRIPTOR TO PARAM *ST_TOS ; !PUT AT TOS - IF SYSTEM CALL THEN PARAM IS COPIED TO NEW STACK *LD_EDR0 *RALN_7 *CALL_(DR ) FINISH AFTERCALL: CHANGECONTEXT SSOWN_SSCOMREG(34)=SAVECOMREG34 SSOWN_SSCOMREG(36)=SAVECOMREG36 IF SAVECURAUX#0 THEN SSOWN_SSCURAUX=SAVECURAUX IF SSOWN_USERSTACKLNB#0 THEN SSOWN_USERSTACKLNB=0 END ; ! OF ENTER ! ! EXTERNALROUTINE RUN(STRING (255) PROG) INTEGER FLAG RECORD (RF) RR CONNECT(PROG,1,0,0,RR,FLAG) IF FLAG#0 THEN ->ERR2 IF NEWCONNECT#0 THEN SETUSE (LASTFN, -1, 0) IF RR_FILETYPE#SSOBJFILETYPE THEN START SSOWN_SSFNAME=PROG FLAG=267 ->ERR2 FINISH ! Increment loadlevel SSOWN_LOADLEVEL=SSOWN_LOADLEVEL+1 IF SSOWN_LOADLEVEL>31 THEN FLAG=351 AND ->ERR SSOWN_LLINFO(SSOWN_LOADLEVEL)_TAB=SSOWN_TEMPOFFSET SSOWN_LLINFO(SSOWN_LOADLEVEL)_GLA=SSOWN_SSCOMREG(44) SSOWN_LLINFO(SSOWN_LOADLEVEL)_ISTK=SSOWN_TEMPISTK SSOWN_MAINDR1=0 LOADFILE2(PROG,FLAG,SSOWN_LOADLEVEL) IF 350#FLAG#0 THEN ->ERR IF SSOWN_MAINDR1=0 THEN FLAG=298 AND -> ERR; ! No main entry IF SSOWN_SSCOMREG(7)#0 THEN START ! Unsatisfied refs IF DYNLOAD=FALSE THEN CASCADELOAD(FLAG,SSOWN_LOADLEVEL) ELSE C MINLOAD(SSOWN_LOADLEVEL,DYNLOAD,FLAG) IF FLAG#0 THEN ->ERR FINISH ELSE SSOWN_LOADINPROGRESS=FALSE SSOWN_RCODE=0 ENTER(0,X'B1000000',SSOWN_MAINDR1,"") UNLOAD2(SSOWN_LOADLEVEL,0) SSOWN_LOADLEVEL=SSOWN_LOADLEVEL-1 RETURN ERR: ! If here then fail the load at this LOADLEVEL UNLOAD2(SSOWN_LOADLEVEL,1) SSOWN_LOADLEVEL=SSOWN_LOADLEVEL-1 ERR2: PSYSMES(39,FLAG) SSOWN_RCODE=FLAG RETURN END ; ! OF RUN ! ! EXTERNALROUTINE EXECUTE(STRING (255) PROG) ! Unlike RUN this operates at the current loadlevel and does ! not unload if successful. INTEGER FLAG RECORD (RF) RR CONNECT(PROG,1,0,0,RR,FLAG) IF FLAG#0 THEN ->ERR IF NEWCONNECT#0 THEN SETUSE (LASTFN, -1, 0) IF RR_FILETYPE#SSOBJFILETYPE THEN START SSOWN_SSFNAME=PROG FLAG=267 ->ERR FINISH SSOWN_MAINDR1=0 LOADFILE2(PROG,FLAG,SSOWN_LOADLEVEL) IF 350#FLAG#0 THEN ->ERR IF SSOWN_MAINDR1=0 THEN FLAG=298 AND -> ERR; ! No main entry IF SSOWN_SSCOMREG(7)#0 THEN START ! Unsatisfied refs IF DYNLOAD=FALSE THEN CASCADELOAD(FLAG,SSOWN_LOADLEVEL) ELSE C MINLOAD(SSOWN_LOADLEVEL,DYNLOAD,FLAG) IF FLAG#0 THEN ->ERR FINISH ELSE SSOWN_LOADINPROGRESS=FALSE SSOWN_RCODE=0 ENTER(0,X'B1000000',SSOWN_MAINDR1,"") RETURN ERR: ! Fail the whole load UNLOAD2(SSOWN_LOADLEVEL,1) PSYSMES(103,FLAG) SSOWN_RCODE=FLAG RETURN END ; ! OF EXECUTE ! ! EXTERNALROUTINE PRELOAD(STRING (255) S) INTEGER LL,FLAG RECORD (RF) RR ! Make sure it's not being called by user software. ! {Chance it meantime}%UNLESS CURSTACK=0 %THEN FLAG=358 %AND ->ERR LL=0; ! All loading on the base gla CONNECT(S,1,0,0,RR,FLAG) IF FLAG#0 THEN ->ERR IF NEWCONNECT#0 THEN SETUSE (LASTFN, -1, 0) IF RR_FILETYPE#SSOBJFILETYPE THEN START SSOWN_SSFNAME=S FLAG=267 -> ERR FINISH ! Any failure up to here does not require a call of UNLOAD2 LOADFILE2(S,FLAG,LL) IF 350#FLAG#0 THEN ->ERR1 IF FLAG=350 THEN PRINTSTRING(S." already loaded ") IF SSOWN_SSCOMREG(7)#0 THEN START MINLOAD(LL,TRUE,FLAG); ! Make any unsat refs dynamic IF FLAG#0 THEN -> ERR1 FINISH ELSE SSOWN_LOADINPROGRESS=FALSE ! All O.K. if here - update LLINFO(0) SSOWN_LLINFO(0)_TAB=SSOWN_PERMOFFSET SSOWN_LLINFO(0)_GLA=SSOWN_SSCURBGLA SSOWN_LLINFO(0)_ISTK=SSOWN_PERMISTK SSOWN_RCODE=0 RETURN ERR1: ! If the PRELOAD failed at command level then call UNLOAD2(1,1) ! immediately but if the failure was within a program then an immediate ! call on UNLOAD2 would probably unload the calling program. To avoid this ! set the own PRELOADFAILED which is acted on at the next call of UNLOAD2. IF CURSTACK#0 THEN SSOWN_PRELOADFAILED=TRUE ELSE C UNLOAD2(1,1); ! Which will only unload the file which failed ERR: PSYSMES(52,FLAG) SSOWN_RCODE=FLAG RETURN END ; ! OF PRELOAD ! ! EXTERNALROUTINE CALL(STRING (31) COMMAND, STRING (255) PARAM) INTEGER DR0,DR1,FLAG,ETYPE LONGINTEGERNAME EDESC EDESC==LONGINTEGER(ADDR(DR0)) ! Check if illegal request by a student IF STUDENTSS#0 THEN START IF CHECKCOMMAND(COMMAND)#0 THEN START PRINTSTRING(COMMAND." not valid ") SSOWN_RCODE=307; ! Illegal call from within program RETURN FINISH FINISH ! Increment loadlevel SSOWN_LOADLEVEL=SSOWN_LOADLEVEL+1 IF SSOWN_LOADLEVEL>31 THEN FLAG=351 AND ->ERR SSOWN_LLINFO(SSOWN_LOADLEVEL)_TAB=SSOWN_TEMPOFFSET SSOWN_LLINFO(SSOWN_LOADLEVEL)_GLA=SSOWN_SSCOMREG(44) SSOWN_LLINFO(SSOWN_LOADLEVEL)_ISTK=SSOWN_TEMPISTK ETYPE=CODE EDESC=LOADEP(COMMAND,ETYPE,FLAG,SSOWN_LOADLEVEL) IF FLAG#0 THEN ->ERR SSOWN_RCODE=0; ! Before we ENTER ENTER(2,DR0,DR1,PARAM) UNLOAD2(SSOWN_LOADLEVEL,0) SSOWN_LOADLEVEL=SSOWN_LOADLEVEL-1 ! Note that return code should be set by whatever ENTERed or by ! ENTERONUSERSTACK if a contingency occurred. RETURN ERR: UNLOAD2(SSOWN_LOADLEVEL,1) ! Note that the old loader used -86 to ensure a call on %STOP ! if the CALL ran into trouble. This version allows failures to be ! trapped by the user. PSYSMES(86,FLAG) SSOWN_RCODE=FLAG SSOWN_LOADLEVEL=SSOWN_LOADLEVEL-1 RETURN END ; ! OF CALL ! ! EXTERNALROUTINE EMASFC(INTEGERNAME AC,LC,AP,LP) !*********************************************************************** !* * !* This routine enables a FORTRAN program to call foreground commands * !* or any IMP routines requiring one %STRING(255) parameter * !* The call should be of the form: * !* CALL EMASFC("DEFINE",6,"10,TEMP",7) * !* wher the second and fourth parameters specify the length of the * !* first and third. * !* * !*********************************************************************** STRING (31) COMMAND STRING (255) PARAM IF LC>31 THEN LC=31; ! Truncate command name IF LP>255 THEN LP=255; ! Truncate parameter MOVE(LC,ADDR(AC),ADDR(COMMAND)+1) LENGTH(COMMAND)=LC MOVE(LP,ADDR(AP),ADDR(PARAM)+1) LENGTH(PARAM)=LP CALL(COMMAND,PARAM) END ; ! OF EMASFC ! ! SYSTEMINTEGERFN USEFOR(ROUTINENAME MYNAME, STRING (31) EXTERNALNAME) ! This function is for use in place of CALL particularly in situations ! when constant loading and unloading is a problem, e.g.in a loop. ! MYNAME is the name of a dummy dynamic routine or function which ! must be declared in the calling program. The parameter list of this ! dummy routine or function is immaterial to USEFOR although it is only ! external routines with the same parameter spec that can be called at ! run-time by the program. EXTERNALNAME is the name of the external routine ! which the user actually wants to call at run-time. What this function ! does is to work its way back from its own stack to the location ! in the gla which contains the escape descriptor corresponding to ! the dummy routine, load EXTERNALNAME then if the load was successful ! overwrite the escape descriptor by the descriptor to EXTERNALNAME. ! A call on the dummy routine in the user program is then equivalent ! to a call on EXTERNALNAME. If we want to call EXTERNALNAME many times ! then we only have to load it once. If desired then we can give the ! program different EXTERNALNAMEs in the same run. Beware problems ! with serial re-entrancy though! RECORD (ESCF)NAME ESCTAB LONGINTEGER EDESC INTEGER LNB,FLAG,TYPE *STLN_LNB; ! Store LNB IF SSOWN_USEFORDESCAD=0 THEN START ! First call of USEFOR. Must find the descriptor to the routine in the gla ! If USEFOR is being called correctly then there should be an escape ! descriptor at LNB+20. The escape descriptor will point us to the ! escape table whose 4th field points us at the location we want. ! However an unresolved reference will also have an escape descriptor ! in this location so must also check that the PC field in the escape ! table is DYNPC and not SSOWN_UNSATPC. UNLESS BYTEINTEGER(LNB+20)=X'E5' AND INTEGER(INTEGER(LNB+24))=SSOWN_DYNPC THEN START PRINTSTRING(USEROOT) IF BYTEINTEGER(LNB+20)=X'E5' THEN PRINTSTRING("not %DYNAMICROUTINESPEC") C ELSE PRINTSTRING("dummy %DYNAMICROUTINESPEC satisfied during loading") FLAG=-1 ->OUT FINISH ! Map on to escape table ESCTAB==RECORD(INTEGER(LNB+24)) SSOWN_USEFORDESCAD=ESCTAB_DESCAD FINISH ! Check if USEFORLASTNAME and EXTERNALNAME are the same. If so then no more to do. IF SSOWN_USEFORLASTNAME=EXTERNALNAME THEN FLAG=0 AND ->OUT ! Load EXTERNALNAME TYPE=2; ! Code EDESC=LOADEP(EXTERNALNAME,TYPE,FLAG,CURRENTLL) IF FLAG#0 THEN PRINTSTRING(USEROOT.FAILUREMESSAGE(FLAG)) AND ->OUT ! Update USEFORLASTNAME and overwrite descriptor at SSOWN_USEFORDESCAD SSOWN_USEFORLASTNAME=EXTERNALNAME LONGINTEGER(SSOWN_USEFORDESCAD)=EDESC FLAG=0 OUT: IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"4SR") RESULT =FLAG END ; ! OF USEFOR ! ! EXTERNALROUTINE DATASPACE(STRING (255) S) ! This routine is used to make a pseudo data entry into the perm ! loaded entry table. The routine takes 3, optionally 5 params: ! ENTRY - name of new data entry ! FILE - name of the file which contains the area used by the data entry ! LENGTH - length of data area in bytes ! OFFSET(optional) - offset of start of data area from start of file ! i.e. CONAD+DATASTART, in bytes, defaults to 0 ! ACCESS(optional) - type of access required to data area. Permitted values: ! R - read and read shared ! W - write unshared ! WS - write shared ! Defaults to W on file, R on pdfile CONSTINTEGERARRAY CONMODE(0:3)=3,1,3,11 CONSTSTRING (3)ARRAY ACCMODE(1:3)="R","W","WS" STRING (35) TEMPLATE STRING (31) FILE,ENTRY,ACCESS,S1,S2 LONGINTEGER DESC RECORD (ENTF)NAME ENT INTEGER FLAG,LEN,AD,OFFSET,I,J,HOLDPRMOFF,LENE,LHD,MODE,PDMEM,K,RECAD,RMODE INTEGER USECOUNTAD RECORD (RF) RR TEMPLATE="ENTRY,FILE,LENGTH,OFFSET=0,ACCESS=" UCTRANSLATE(ADDR(S)+1,LENGTH(S)) FILPS(TEMPLATE,S) IF PARMAP&X'FFFFFFE0'#0 THEN FLAG=263 AND ->ERR ENTRY=SPAR(1) FILE=SPAR(2) IF FILE->S1.("_").S2 THEN PDMEM=TRUE ELSE PDMEM=FALSE UNLESS FILE->S1.(".").S2 THEN FILE=SSOWN_SSOWNER.".".FILE LEN=PSTOI(SPAR(3)) IF LEN<0 THEN START SSOWN_SSFNAME=SPAR(3) FLAG=357; ! Not a positive integer ->ERR FINISH OFFSET=PSTOI(SPAR(4)) IF OFFSET<0 THEN START SSOWN_SSFNAME=SPAR(4) FLAG=357; ! Not a positive integer ->ERR FINISH ACCESS=SPAR(5) IF ACCESS#"" THEN START MODE=-1 FOR I=1,1,3 CYCLE MODE=I AND EXIT IF ACCESS=ACCMODE(I) REPEAT IF MODE<0 THEN START SSOWN_SSFNAME=ACCESS FLAG=202; ! Invalid parameter ->ERR FINISH FINISH ELSE IF PDMEM=FALSE THEN MODE=3 ELSE MODE=1 ! Now check legal MODE if pdfile member IF PDMEM#FALSE AND MODE#1 THEN START PRINTSTRING("** Error - Pdfile members used by DATASPACE must have R access ") FLAG=269; ! Illegal use of pdfile member ->ERR FINISH ! Do we know about FILE already, i.e. is there another DATASPACE entry ! in it? Check filenames listhead. RMODE=0 J=INTEGER(SSOWN_SSLOADTAB(2)_START+1004) WHILE J>0 CYCLE RECAD=SSOWN_SSLOADTAB(2)_START+J LENE=(BYTEINTEGER(RECAD)+4)&X'FFFFFFFC' ENT==RECORD(RECAD+LENE) IF ENT_TYPE&X'40000000'#0 AND FILE=STRING(RECAD) THEN START ! Found another dataspace entry in the same file ! Check access modes RMODE=ENT_ACCESSMODE IF RMODE#MODE THEN START *LSS_RMODE *SHZ_I PRINTSTRING("**Error - ".FILE." is already connected in ". C ACCMODE(32-I)." mode for DATASPACE entries ") FLAG=266; ! Inconsistent file use ->ERR FINISH USECOUNTAD=ADDR(ENT_USECOUNT)-SSOWN_SSLOADTAB(2)_START; ! Note it's an offset FINISH J=ENT_LINK REPEAT ! Connect FILE CONNECT(FILE,MODE,0,0,RR,FLAG) IF FLAG#0 THEN ->ERR IF RR_FILETYPE#SSDATAFILETYPE THEN START IF RR_FILETYPE=SSCHARFILETYPE THEN PRINTSTRING( C "**WARNING: ".FILE." is a character file ") ELSE START IF NEWCONNECT#0 THEN SETUSE (LASTFN, -1, 0) FLAG=267 ->ERR FINISH FINISH ! Check data area is wholly within FILE AD=RR_CONAD+RR_DATASTART+OFFSET; ! Start of data area UNLESS AD+LEN-1<RR_CONAD+RR_DATAEND THEN FLAG=355 AND ->ERR ! If there is at least 1 other DATASPACE entry in this file ! i.e. RMODE#0 then must check for overlap ! Search the perm loaded entries to check for overlap IF RMODE#0 THEN START J=SSOWN_SSLOADTAB(2)_START+SSOWN_LLINFO(-1)_TAB; ! Start searching from here WHILE BYTEINTEGER(J)#0 CYCLE LENE=(BYTEINTEGER(J)+4)&X'FFFFFFFC' ENT==RECORD(J+LENE) K=ENT_TYPE&X'1FFFFFFF'; ! Remove special entry bits *LSS_K *SHZ_I I=31-I IF I=0 AND ENT_TYPE&X'40000000'#0 THEN START ! Found another dataspace entry IF NOT (AD+LEN-1<ENT_DR1 OR AD>ENT_DR1+ENT_DR0-1) THEN START SSOWN_SSFNAME=STRING(J) FLAG=356; ! Overlaps previously defined data area ->ERR FINISH FINISH J=J+LENE+16 REPEAT FINISH HOLDPRMOFF=SSOWN_PERMOFFSET; ! For possible failure if adding a file record LHD=HASH(ENTRY,PRIME) ADDENTRY(ENTRY,SSOWN_PLH,FLAG,SSOWN_PERMOFFSET,X'40000000'!DATA,LEN,AD,2,LHD); ! Perm load it IF FLAG#0 THEN ->ERR; ! No need to unload ! Now add file record to listhead PRIME if required otherwise increment ! file record use count IF RMODE=0 THEN START ADDENTRY(FILE,SSOWN_PLH,FLAG,SSOWN_PERMOFFSET,X'40000000',1,MODE,2,PRIME) IF FLAG#0 THEN START FILL(SSOWN_PERMOFFSET-HOLDPRMOFF,SSOWN_SSLOADTAB(2)_START+HOLDPRMOFF,X'00') SSOWN_PERMOFFSET=HOLDPRMOFF -> ERR FINISH FINISH ELSE INTEGER(SSOWN_SSLOADTAB(2)_START+USECOUNTAD)= C INTEGER(SSOWN_SSLOADTAB(2)_START+USECOUNTAD)+1 IF NEWCONNECT=0 THEN SETUSE(FILE,1,0) *LSS_MODE *SHZ_I PRINTSTRING("Data entry ".ENTRY." defined - len ".HTOS(LEN,8)." at ". C HTOS(AD,8)." access mode ".ACCMODE(32-I)) NEWLINE ! Since a new entry has been added to the perm entry tables we must ! satisfy any outstanding refs to it exactly as in LOADFILE2 DESC=LEN DESC=(DESC<<32)!AD ! Find which listhead refs to ENTRY will be chained on. SATISFYREF(ENTRY,DESC,FLAG,DATA,0,LHD) IF 289#FLAG#0 THEN ->ERR ! Update LLINFO(0)_TAB and LLINFO(0)_GLA SSOWN_LLINFO(0)_TAB=SSOWN_PERMOFFSET SSOWN_LLINFO(0)_GLA=SSOWN_SSCURBGLA SSOWN_RCODE=0 RETURN ERR: PSYSMES(107,FLAG) SSOWN_RCODE=FLAG RETURN END ; ! OF DATASPACE ! ! EXTERNALROUTINE ALIASENTRY(STRING (255) S) ! This is a PRELIMINARY version of the command which will add an alias ! to the temp loaded table only. cf DATASPACE ! Command is similar to DATASPACE in that it adds a pseudo entry to ! the loader tables. It is used to provide an alias to an entry name ! which is already loaded. STRING (11) TEMPLATE STRING (31) ENTRY,ALIAS INTEGER DR0,DR1 LONGINTEGERNAME DESC INTEGER FLAG,TYPE,LHD DESC==LONGINTEGER(ADDR(DR0)) TEMPLATE="ENTRY,ALIAS" UCTRANSLATE(ADDR(S)+1,LENGTH(S)) FILPS(TEMPLATE,S) IF PARMAP&X'FFFFFFFC'#0 THEN FLAG=263 AND ->ERR ENTRY=SPAR(1) ALIAS=SPAR(2) ! TYPE=CODE!DATA; ! or MACRO perhaps? Think about it ! Check that ALIAS is not loaded LHD=-1 DESC=CHECKLOADED(ALIAS,TYPE,LHD) IF DESC#0 THEN START SSOWN_SSFNAME=ALIAS FLAG=354; ! Entry already loaded ->ERR FINISH ! Now check that ENTRY is loaded DESC=LOOKLOADED(ENTRY,TYPE) IF DESC=0 THEN START SSOWN_SSFNAME=ENTRY FLAG=353; ! Entry not loaded ->ERR FINISH ADDENTRY(ALIAS,SSOWN_PLH,FLAG,SSOWN_PERMOFFSET,X'20000000'!TYPE,DR0,DR1,2,LHD); ! Perm load it IF FLAG#0 THEN ->ERR; ! No need to unload PRINTSTRING(ALIAS." aliased to entry name ".ENTRY) NEWLINE ! Satisfy any outstanding refs SATISFYREF(ALIAS,DESC,FLAG,TYPE,0,LHD) IF 289#FLAG#0 THEN ->ERR ! Update LLINFO(0)_TAB SSOWN_LLINFO(0)_TAB=SSOWN_PERMOFFSET SSOWN_RCODE=0 RETURN ERR: PSYSMES(108,FLAG) SSOWN_RCODE=FLAG RETURN END ; ! OF ALIASENTRY ! EXTERNALROUTINE RESETLOADER(STRING (255) S) ! Causes ALL user loaded material to be unloaded. ! Fools UNLOAD2 into thinking there is a failed load incorporating ! all the user loaded material ! Note that LLINFO(-1) contains the initial perm values of TAB ! GLA and ISTK so we unload to these values at level 0. ! First make sure it has been called by the CLI. UNLESS CURSTACK=0 THEN START TERMINALPRINT("RESETLOADER fails - ",FAILUREMESSAGE(358)) SSOWN_RCODE=358 RETURN FINISH SSOWN_LLINFO(0)_TAB=SSOWN_LLINFO(-1)_TAB SSOWN_LLINFO(0)_GLA=SSOWN_LLINFO(-1)_GLA SSOWN_LLINFO(0)_ISTK=SSOWN_LLINFO(-1)_ISTK SSOWN_LOADLEVEL=1 UNLOAD2(SSOWN_LOADLEVEL,1) SSOWN_RCODE=0 RETURN END ; ! OF RESETLOADER ! ! EXTERNALROUTINE LOADPARM(STRING (255) S) ! This routine is the loader's equivalent of PARM which refers to compilers ! and allows loader options to be set. The default is FULL which means a ! full cascade load and fails if any unsatisfied refs remain. LOADPARM MIN ! loads only the file which contains the required entry point. Any common ! areas required are created and all unsatisfied refs are made dynamic. ! LOADPARM LET makes unsatisfied refs unresolved after a full cascade load ! so that execution can begin. LET is ignored when LOADPARM MIN is set. STRING (255) PARMSOUT,PARM INTEGER LPARMS,FLAG IF S="?" THEN START IF SSOWN_SSCOMREG(39)&1=0 THEN PARMSOUT="FULL" ELSE PARMSOUT="MIN" IF SSOWN_SSCOMREG(39)&2#0 THEN PARMSOUT=PARMSOUT.",LET" IF SSOWN_SSCOMREG(39)&4#0 THEN PARMSOUT=PARMSOUT.",ZERO" PRINTSTRING(PARMSOUT." ") SSOWN_RCODE=0 RETURN FINISH ! LPARMS=0 SETPAR(S) FLAG=0 CYCLE PARM=SPAR(0) EXIT IF PARM="" IF PARM="FULL" THEN LPARMS=LPARMS&X'FFFFFFFE' AND CONTINUE IF PARM="MIN" THEN LPARMS=LPARMS!1 ELSE C IF PARM="LET" THEN LPARMS=LPARMS!2 ELSE C IF PARM="ZERO" THEN LPARMS=LPARMS!4 ELSE START SSOWN_SSFNAME=PARM FLAG=202 PSYSMES(109,FLAG) FINISH REPEAT IF FLAG=0 THEN SSOWN_SSCOMREG(39)=LPARMS SSOWN_RCODE=FLAG RETURN END ; ! OF LOADPARM ! ! SYSTEMINTEGERFN FIND(STRING (31) ENTRY, INTEGERNAME NREC, INTEGER ADR,TYPE) ! This function will search through the entire loader search list looking ! for occurrences of ENTRY of type TYPE. Those found are returned in a record ! array supplied by the caller at ADR. Each element of the record ! array requires 40 bytes. NREC should be set by the caller to the maximum ! number of records he/she is prepared to accept. The function will reset N ! to the number actually returned. ! The function has an initial capacity of 128 records (MAXFINDREC). ! Possible error results : ! 326 - Illegal value of NREC, i.e. <1 or >MAXFINDREC(128 at present) ! 300 - NREC not big enough, i.e. more records to return than given NREC. RECORD (FINDF)ARRAYFORMAT FINDFAF(1:MAXFINDREC) RECORD (FINDF)ARRAYNAME E LONGINTEGERNAME DSC INTEGER DR0,DR1 INTEGER TOP,LHD,XTYPE,NTYPE,I,IHASH,FLAG STRING (31) RES STRING (31)ARRAY CACHE(1:3) UNLESS 1<=NREC<=MAXFINDREC THEN START IF NREC<1 THEN START PRINTSTRING("Illegal value of NREC - ".ITOS(NREC)." ") SSOWN_SSFNAME="NREC" FLAG=326; ! Invalid value for & param ->OUT FINISH ELSE PRINTSTRING("NREC value too large - reset to ". C ITOS(MAXFINDREC)." ") FINISH DSC==LONGINTEGER(ADDR(DR0)) CACHE(I)="" FOR I=3,-1,1 TOP=NREC NREC=0 E==ARRAY(ADR,FINDFAF) LHD=HASH(ENTRY,PRIME); ! Listhead of ENTRY in loader tables IHASH=INITHASH(ENTRY); ! For faster access to new style directories. ! Start by searching the loader tables for ENTRY ! Note that there are only CODE entries in the subsystem and system call ! list so these tables only need be searched if the CODE bit is set in TYPE. IF TYPE&CODE#0 THEN START XTYPE=CODE DSC=SEARCHSUBSYS(ENTRY,XTYPE,LHD) IF DSC#0 THEN START ! Found it NREC=NREC+1 E(NREC)_FILE="" E(NREC)_DIRNO=-2 E(NREC)_TYPE=CODE E(NREC)_STATUS=1; ! Publically loaded FINISH ELSE START ! Only one item of the same name and type can be loaded at the same time ! so only search system call list if not in subsystem. DSC=SEARCHSCL(ENTRY,XTYPE) IF DSC#0 THEN START NREC=NREC+1 E(NREC)_FILE="" E(NREC)_DIRNO=-2 E(NREC)_TYPE=CODE E(NREC)_STATUS=1 FINISH FINISH FINISH ! Now things start to get complicated. ! ENTRY may be privately loaded and TYPE could be any selection of ! CODE!DATA!MACRO!ALIAS. Different things called ENTRY could be loaded at ! the same time but their TYPE would be different. ! CODE or DATA (or MACRO) entries loaded via the loader search list will be ! encountered again when searching the directories. Because of the way they ! are created, DATASPACE and ALIASENTRY entries will be encountered in the ! loader tables but not in the directories. Entries of type ALIAS are not ! loaded but will be encountered during the directory search. ! ! *Strategy* ! Use SEARCHLOADED to look up the loader tables and store the name of the ! file containing ENTRY in the array CACHE. If we encounter the same file ! later then can indicate that it's STATUS is 'privately loaded', if we don't ! then it must be an ALIASENTRY if CODE or DATASPACE if DATA. ! ! ** Note on MACROs ! At the time of writing, macros are not loadable so they will not ! be encountered by SEARCHLOADED. Equally macro entries and code entries are ! not distinguished in old style directories (they are all flagged 'code'). ! SEARCHOLDDIR will return a TYPE of CODE!MACRO if the MACRO bit is set ! in the TYPE parameter for all code or macro entries. ! To keep things as simple as possible this code will adopt the convention ! meantime that CODE!MACRO should be treated as CODE. ! Therefore if new style directories are implemented or macros become loadable ! then the code will have to be expanded. ! ! Search privately loaded entries. XTYPE=TYPE WHILE XTYPE#0 CYCLE NTYPE=XTYPE DSC=SEARCHLOADED(ENTRY,NTYPE,LHD) IF DSC#0 THEN START ! Found something IF NTYPE=DATA THEN CACHE(NTYPE)=CONFILE(DR1) ELSE C CACHE(NTYPE)=CONFILE(INTEGER(DR1+4)) FINISH XTYPE=XTYPE!!NTYPE; ! Knock out the bit of the type found REPEAT ! Now the loader search list FOR I=-1,1,SSOWN_SSTOPADIR CYCLE CONTINUE IF SSOWN_SSADIR(I)_NAME=""; ! In case there is no activedir XTYPE=TYPE WHILE XTYPE#0 CYCLE NTYPE=XTYPE IF SSOWN_SSADIR(I)_TYPE=SSDIRFILETYPE THEN C RES=SEARCHDIR(ENTRY,SSOWN_SSADIR(I)_CONAD,IHASH,NTYPE) ELSE C RES=SEARCHOLDDIR(ENTRY,NTYPE,SSOWN_SSADIR(I)_CONAD) IF RES#"" THEN START ! Found something NREC=NREC+1 IF NREC>TOP THEN START NREC=NREC-1 FLAG=300; ! Table too small ->OUT FINISH NTYPE=CODE IF NTYPE=CODE!MACRO; ! Meantime E(NREC)_FILE=RES E(NREC)_DIRNO=I E(NREC)_TYPE=NTYPE E(NREC)_STATUS=0; ! Not currently loaded ! Now see if this record requires adjustment. IF NTYPE=ALIAS THEN START E(NREC)_FILE=" ".E(NREC)_FILE WHILE LENGTH(E(NREC)_FILE)<10 FINISH ELSE START IF RES=CACHE(NTYPE) THEN E(NREC)_STATUS=-1 AND CACHE(NTYPE)="" FINISH FINISH IF SSOWN_SSADIR(I)_TYPE#SSDIRFILETYPE AND NTYPE&X'0000000E'#0 THEN C XTYPE=XTYPE&1 ELSE XTYPE=XTYPE!!NTYPE REPEAT REPEAT ! Check out CACHE to see if any DATASPACE or ALIASENTRY entries. FOR I=1,1,2 CYCLE IF CACHE(I)#"" THEN START NREC=NREC+1 IF NREC>TOP THEN FLAG=291 AND ->OUT; ! Too many entries E(NREC)_FILE=CACHE(I) E(NREC)_DIRNO=-2-I; ! So DATASPACE=-3, ALIASENTRY=-4 E(NREC)_TYPE=I E(NREC)_STATUS=-1 FINISH REPEAT FLAG=0 OUT: IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"SIiIQ") RESULT =FLAG END ; ! OF FIND ! ! !*********************************************************************** !* * !* Loader hash commands * !* * !*********************************************************************** ! EXTERNALROUTINE CURRENTREFS(STRING (255) S) ! Prints out a list of currently active refs ! An active reference is one which will trigger off a loader search i.e. ! dynamic or unsatisfied. NOT unresolved or satisfied by entry at higher loadlvl CONSTSTRING (15)ARRAY ST(1:3)="- Data", "- Code", "- Single word" RECORD (BREFF)NAME R1 RECORD (IREFF)NAME R2 INTEGER I,J,RECAD,IRECAD,START,LENE,FOUND,TYPE,XTYPE,K,N FOUND=FALSE START=SSOWN_SSLOADTAB(1)_START; ! Start of ref table. PRINTSTRING("Current active refs are: ") FOR I=PRIME-1,-1,0 CYCLE IF SSOWN_RLH(I)>0 THEN START ! Something off this listhead J=SSOWN_RLH(I) WHILE J>0 CYCLE RECAD=START+J; ! Basic record LENE=(BYTEINTEGER(RECAD)+8)&X'FFFFFF8'; ! Bytes of name TYPE=INTEGER(RECAD+LENE) R1==RECORD(RECAD+LENE+4) IF TYPE&X'60000000'#0 THEN START FOUND=TRUE IF FOUND=FALSE PRINTSTRING(STRING(RECAD)) SPACES(2) XTYPE=TYPE&X'1FFFFFFF' PRINTSTRING(ST(XTYPE)) N=0 K=R1_FIRST WHILE K>0 CYCLE N=N+1 IF N&7=0 THEN NEWLINE SPACES(2) IRECAD=START+K R2==RECORD(IRECAD) PRINTSTRING(HTOS(R2_DR1,8)) IF R2_DR0&CMN#0 THEN PRINTSTRING(" (Common)") IF R2_DR0&DYN#0 THEN PRINTSTRING(" (Dynamic)") ELSE C IF R2_DR0&UNSAT#0 THEN PRINTSTRING(" (Unsat)") K=R2_LINK REPEAT NEWLINE FINISH J=R1_LINK REPEAT FINISH REPEAT IF FOUND=FALSE THEN PRINTSTRING("* None * ") RETURN END ; ! OF CURRENTREFS ! ! EXTERNALROUTINE LOADEDFILES(STRING (255) S) ROUTINE DOFILES(INTEGER START) RECORD (ENTF)NAME ENT STRING (31) FNAME INTEGER J,RECAD,LENE J=INTEGER(START+1004) IF J=0 THEN PRINTSTRING("* None * ") AND RETURN WHILE J>0 CYCLE RECAD=START+J LENE=(BYTEINTEGER(RECAD)+4)&X'FFFFFFFC' ENT==RECORD(RECAD+LENE) FNAME=STRING(RECAD) UNLESS 32<=ENT_TYPE<=64 THEN START PRINTSTRING(FNAME) IF ENT_TYPE#0 THEN PRINTSTRING(" (DATASPACE entries)") NEWLINE FINISH J=ENT_LINK REPEAT RETURN END ; ! OF DOFILES PRINTSTRING("Perm loaded files: ") DOFILES(SSOWN_SSLOADTAB(2)_START) PRINTSTRING("Temp loaded files: ") DOFILES(SSOWN_SSLOADTAB(3)_START) RETURN END ; ! OF LOADEDFILES ! ! EXTERNALROUTINE LOADEDENTRIES(STRING (255) S) ! Prints entries which have been loaded by the caller i.e. no subsys or ! system call table entries ! Does permanent then temporary entries ROUTINE DOENT(INTEGER START,OFFSET) CONSTSTRING (7)ARRAY ST(0:2)="Data ", "Code ", "Macro" STRING (31) ENAME RECORD (ENTF)NAME ENT INTEGER I,J,LENE,K ! Note 1008 rather than 1004 as in LOADEDFILES. START+1004 is the address ! of the listhead of files. An ALIASENTRY record won't add a ! file record so to be sure of picking them up check the first integer ! after the listheads. If it has anything in it then there must be entries. IF INTEGER(START+1008)=0 THEN PRINTSTRING("* None * ") AND RETURN ! Plod down the entry table J=START+OFFSET WHILE BYTEINTEGER(J)#0 CYCLE ENAME=STRING(J) LENE=(BYTEINTEGER(J)+4)&X'FFFFFFFC' ENT==RECORD(J+LENE) K=ENT_TYPE&X'1FFFFFFF'; ! i.e. remove special entry type bits IF K=0 OR K>=32 THEN START ! Got a file record IF K=0 THEN PRINTSTRING("=>=>=>=>=> found in file ".ENAME) AND NEWLINE FINISH ELSE START *LSS_K *SHZ_I I=31-I PRINTSTRING(ENAME." ".ST(I)." at ") IF I=0 THEN PRINTSTRING(HTOS(ENT_DR1,8)." length ".HTOS(ENT_DR0,8)) ELSE C PRINTSTRING(HTOS(INTEGER(ENT_DR1+4),8)) IF ENT_TYPE&X'80000000'#0 THEN PRINTSTRING(" (Main entry)") IF ENT_TYPE&X'40000000'#0 THEN PRINTSTRING(" (DATASPACE entry => ". C CONFILE(ENT_DR1).")") AND NEWLINE IF ENT_TYPE&X'20000000'#0 THEN PRINTSTRING(" (ALIASENTRY entry)") C AND NEWLINE FINISH NEWLINE J=J+LENE+16 REPEAT RETURN END ; ! OF DOENT ! ! Perm loaded first PRINTSTRING("Perm loaded entries: ") DOENT(SSOWN_SSLOADTAB(2)_START,SSOWN_LLINFO(-1)_TAB) ! Temp loaded PRINTSTRING("Temp loaded entries: ") DOENT(SSOWN_SSLOADTAB(3)_START,SSOWN_LLINFO(1)_TAB) RETURN END ; ! OF LOADEDENTRIES ! ! EXTERNALROUTINE LOADDUMP(STRING (255) S) ! Dumps out loader tables and SSLOADTAB, DUFFGLA, LLINFO CONSTSTRING (11)ARRAY LTAREA(1:3) = "REFS ","PERM ENT","TEMP ENT" INTEGER I,L PRINTSTRING("***** DUFFGLA ***** ") FOR I=0,1,63 CYCLE CONTINUE IF SSOWN_DUFFGLA(I)_FROM=0 PRINTSTRING(HTOS(SSOWN_DUFFGLA(I)_FROM,8)." ".HTOS(SSOWN_DUFFGLA(I)_TO,8)." ") REPEAT NEWLINES(2) PRINTSTRING("***** LLINFO ***** ") FOR I=-1,1,31 CYCLE IF SSOWN_LLINFO(I)_TAB#0 THEN START PRINTSTRING(HTOS(SSOWN_LLINFO(I)_TAB,8)." ".HTOS(SSOWN_LLINFO(I)_GLA,8)." ". C HTOS(SSOWN_LLINFO(I)_ISTK,8)." ") FINISH REPEAT NEWLINES(2) IF S#"" THEN L=BYTEINTEGER(ADDR(S)+1)-X'30' ELSE L=-1 UNLESS -1<=L<=3 THEN L=-1 PRINTSTRING(" Dump of loader tables AREA START LEN ") FOR I=1,1,3 CYCLE PRINTSTRING(LTAREA(I)." ".HTOS(SSOWN_SSLOADTAB(I)_START,8)." ". C HTOS(SSOWN_SSLOADTAB(I)_LEN,8)) NEWLINE REPEAT NEWLINES(2) IF L<0 THEN C DUMP(SSOWN_SSLOADTAB(0)_START,SSOWN_SSLOADTAB(0)_START+INTEGER(SSOWN_SSLOADTAB(0)_START)-1) C ELSE DUMP(SSOWN_SSLOADTAB(L)_START,SSOWN_SSLOADTAB(L)_START+SSOWN_SSLOADTAB(L)_LEN-1) RETURN END ; ! OF LOADDUMP ! ! SYSTEMINTEGERFN DAPDATA(STRING (31) ENTRY,FILE, INTEGER LEN,CONAD) ! This is a special for the DAP. The function makes a pseudo data entry ! in the temporarily loaded entries table, a bit like DATASPACE, but we map ! on directly to a nominated virtual address. Checking is minimal. ! We do not add a filename record since the file for which this used is ! created by the Director and is invisible to the subsystem. ! Review again when Director and subsystem connected file tables merge. ! This function cannot be called by something which is permanently ! loaded. There is a line in LOADFILE2 to trap this. LONGINTEGER DESC INTEGER FLAG,LHD UNLESS FILE="#DAP" AND LEN>0 AND CONAD>0 THEN FLAG=1010 AND ->OUT; ! Minimal check LHD=HASH(ENTRY,PRIME) ADDENTRY(ENTRY,SSOWN_TLH,FLAG,SSOWN_TEMPOFFSET,X'40000000'!DATA,LEN,CONAD,3,LHD) IF FLAG#0 THEN ->OUT ! O.K. so satisfy outstanding refs DESC=LEN DESC=(DESC<<32)!CONAD SATISFYREF(ENTRY,DESC,FLAG,DATA,SSOWN_LOADLEVEL,LHD) FLAG=0 IF FLAG=289; ! There weren't any to satisfy OUT: IF SSOWN_DIAGMON&1#0 THEN SSTRACE(FLAG,"SSiiQ") RESULT =FLAG END ; ! OF DAPDATA ! ! ! * These routines are dummies and are only provided for ease of ! * conversion from the old to the new loader. ! ! SYSTEMROUTINE FINDENTRY(STRING (31) ENTRY, C INTEGER TYPE, DAD, STRINGNAME FILE, C INTEGERNAME DR0, DR1, FLAG) PRINTSTRING("FINDENTRY not available in new loader ") FLAG=1001 RETURN END ; ! OF FINDENTRY ! ! SYSTEMROUTINE LOAD(STRING (31) NAME, INTEGER TYPE, C INTEGERNAME FLAG) PRINTSTRING("LOAD not available in new loader ") FLAG=1001 RETURN END ; ! OF LOAD ! ! SYSTEMROUTINE LOADCOMMAND(STRING (31) COMMAND, C STRINGNAME ALIASEDTO, INTEGERNAME MODE, DR0, DR1, FLAG) PRINTSTRING("LOADCOMMAND not available in new loader ") FLAG=1001 RETURN END ; ! OF LOADCOMMAND ! ! SYSTEMROUTINE LOADFILE(STRING (31) S, INTEGER MODE, C INTEGERNAME FLAG) PRINTSTRING("LOADFILE not available in new loader ") FLAG=1001 RETURN END ; ! OF LOADFILE ! ! SYSTEMROUTINE UNLOAD(INTEGER CURGLA) PRINTSTRING("UNLOAD not available in new loader ") RETURN RETURN TO COMMAND LEVEL END ; ! OF UNLOAD ! EXTERNALROUTINE LVSN(STRING (255) S) PRINTSTRING(LOADVSN) RETURN END ; ! OF LVSN ! ! EXTERNALROUTINE DOPROFILE PPROFILE RETURN END ; ! OF DOPROFILE ! ! ENDOFFILE