hSyntax10.Scn.Fnt Syntax10b.Scn.Fnt+         ^X Z StyleElemsAllocPicture%4N*KeplerElemsAllocKeplerGraphsGraphDescKeplerGraphsStarDesc { { {{ { { { z {z { { z z zz z z ~ ~ ~ ~ ~~~~~ ~ ~ ~ ~ } ~ } ~}~}} } } } } | } | }|}|} } } }~}}|{{zzyxxwv~~~}}||||{{{{zzyyyyxxwwwwv{{~ ~zz{ {  |Kepler1RectangleDescKeplerFramesCaptionDescadrSyntax10.Scn.FntnameSyntax10.Scn.Fnt adrSyntax10.Scn.Fnt nameSyntax10.Scn.Fnt  adrSyntax10.Scn.FntnameSyntax10.Scn.FntmodeSyntax10.Scn.FntadrSyntax10.Scn.FntfprintSyntax10.Scn.FntnameSyntax10.Scn.Fnt !"#$%modeSyntax10.Scn.Fnt&adrSyntax10.Scn.Fnt'fprintSyntax10.Scn.Fnt(nameSyntax10.Scn.Fnt)*+,-./01modeSyntax10.Scn.Fnt2adrSyntax10.Scn.Fnt3fprintSyntax10.Scn.Fnt4nameSyntax10.Scn.Fnt5nextSyntax10.Scn.Fnt6nameSyntax10.Scn.Fnt7initSyntax10.Scn.Fnt8refcntSyntax10.Scn.Fnt9sbSyntax10.Scn.Fnt:exportsSyntax10.Scn.Fnt;tdescsSyntax10.Scn.Fnt<cmdsSyntax10.Scn.Fnt=ptrTabSyntax10.Scn.Fnt>importsSyntax10.Scn.Fnt?dataSyntax10.Scn.FntcodeSyntax10.Scn.FntrefsSyntax10.Scn.FntKepler1LineDescKepler1AttrDescModuleSyntax10.Scn.FntExportsSyntax10.Scn.FntCommandsSyntax10.Scn.FntOWU sParcElemsAlloc!                     2!.!!J)U8FoldElemsNew`#q(8  4888888886888*88S8rO8G8aY848 I"F]88GxI@p1KeplerGraphsGraphDescKeplerGraphsStarDesc~~~|}|{|{z{zyyywxxxwvwvuvxx  ~ ~ ~ ~ } } | | | | z  ~ } } | {  z~~ ~~Kepler1RectangleDescKeplerFramesCaptionDescexportsSyntax10.Scn.FnttdescsSyntax10.Scn.FntcmdsSyntax10.Scn.Fnt ptrTabSyntax10.Scn.Fnt  importsSyntax10.Scn.FntdataSyntax10.Scn.Fntglobal variablesSyntax10.Scn.FntconstantsSyntax10.Scn.FntcodeSyntax10.Scn.FntrefsSyntax10.Scn.FntKepler1LineDesc !"#$%&'tagSyntax10.Scn.Fnt(aSyntax10.Scn.Fnt)bSyntax10.Scn.Fnt*cSyntax10.Scn.Fnt+lenSyntax10.Scn.Fnt,dataSyntax10.Scn.Fnt-Kepler1AttrDesc./0123m.exports etc.Syntax10.Scn.Fnt4 888 8x88#Syntax10.Scn.Fnt Header block8888#Syntax10.Scn.Fnt Import blockJ[H68888#Syntax10.Scn.Fnt Export blockR< R&W j 888f88#Syntax10.Scn.Fnt Command block88T88#Syntax10.Scn.Fnt Pointer block^8888#Syntax10.Scn.FntConstant block]88\88#Syntax10.Scn.Fnt Code block688W88#Syntax10.Scn.Fnt Use blockZ88q88#Syntax10.Scn.Fnt Ref blockx8e9(8;9HMODULE ModuleBase; (* ModuleBase implements those part of Modules and Linker which are common. It will probably remain architecture/platform independent. *) IMPORT SYSTEM ,Console,Files,HostSYS,Kernel; (* enum: Result*=(done,fileNotFound,notAnObjFile,fpMismatch,corruptedObjFile,cmdNotFound,modNotFound,notEnoughSpace,refCntNotZero,objNotFound,tooManyFiles); *) TYPE Result*=SHORTINT; CONST done*=0; fileNotFound*=1; notAnObjFile*=2; fpMismatch*=3; corruptedObjFile*=4; cmdNotFound*=5; modNotFound*=6; notEnoughSpace*=7; refCntNotZero*=8; objNotFound*=9; tooManyFiles*=10; CONST ModNameLen*=32; ExtTabWordSize=16; Tag0WordOffset=-2; Mth0WordOffset=Tag0WordOffset-ExtTabWordSize; (* instruction format *) IMM=10000H; JAL=0C000000H; LUI=03C000000H; OP=04000000H; RS=200000H; RT=10000H; (*  *) TYPE ADDRESS=HostSYS.ADDRESS; Name*=ARRAY ModNameLen OF CHAR; Cmd*=RECORD name*:Name; adr*:ADDRESS END; Command*=PROCEDURE; Error*=RECORD res*:Result; imported*:Name; importing*:Name; object*:Name; objmode*:Name; END; Export*=RECORD name*:Name; fprint*:LONGINT; adr*:ADDRESS; mode*:INTEGER END; ModuleName*=Name; Module*=POINTER TO ModuleDesc; ModuleDesc*=RECORD next*:Module; name*:ModuleName; init*:BOOLEAN; refcnt*:LONGINT; sb*:LONGINT; exports*:POINTER TO ARRAY OF Export; tdescs*:POINTER TO ARRAY OF (* Kernel.Tag *) ADDRESS; cmds*:POINTER TO ARRAY OF Cmd; ptrTab*:POINTER TO ARRAY OF ADDRESS; imports*:POINTER TO ARRAY OF (* Module *) ADDRESS; data*:POINTER TO ARRAY OF LONGINT; code*:POINTER TO ARRAY OF LONGINT; refs*:POINTER TO ARRAY OF CHAR END; VAR KernelRoutines:ARRAY 3 OF ADDRESS; (* Address of Kernel NewXXX procedures *) modeStr:ARRAY 9 OF Name; PROCEDURE Fixup(m:Module; entry,L:LONGINT; data:BOOLEAN); VAR L1,L2,c1,c2:LONGINT; BEGIN IF L#0 THEN REPEAT L1:=L; c1:=m.code[L1]; L:=L1 + ASH(SYSTEM.LSH(c1,16),-16) + 1; IF data THEN c2:=m.code[L1+1] + entry; IF L=L1 -1 THEN (* 8-byte access *) m.code[L1]:=(c1 DIV IMM) * IMM + (c2 + 4) MOD IMM; DEC(L1); c1:=m.code[L1]; L:=L1 + ASH(SYSTEM.LSH(c1,16),-16) + 1; L2:=L1 + 2; ELSE L2:=L1 + 1; END; IF ODD(ASH(c2,-15)) THEN INC(c2,IMM) END; m.code[L1]:=LUI + RT*((c1 DIV RS) MOD 32) + (c2 DIV IMM) MOD IMM; m.code[L2]:=(c1 DIV IMM) * IMM + c2 MOD IMM; ELSE (* procedure *) IF (c1 DIV OP) * OP=LUI THEN (* proc var *) m.code[L1]:=(c1 DIV IMM) * IMM + (entry DIV IMM) MOD IMM; INC(m.code[L1 + 1],entry MOD IMM); ELSE (* external call,(c1 DIV OP) * OP=JAL *) (* IF (SYSTEM.ADR(m.code[L1]) DIV 10000000H)#(procadr DIV 10000000H) THEN JAL over 256MB block boundary END; *) m.code[L1]:=JAL + (entry DIV 4) MOD 4000000H; END; END; UNTIL L=L1; END; END Fixup; PROCEDURE LoadModule*(VAR R:Files.Rider; VAR m:Module; VAR error:Error); (* Read a module from its object file. Note: This procedure does not recursively load the imported modules. It also doesn't verify if this module is already loaded. It doesn't link the module into any module list. *) TYPE TDescBlock=POINTER TO RECORD word:ARRAY 32000 OF LONGINT; END; TDescDesc=POINTER TO RECORD tdsize,sentinel,self:LONGINT; ext:RECORD extlev:SHORTINT; filler:ARRAY 3 OF CHAR; END; name:Name; mdesc:Module; pvfprint:LONGINT; END; Type=RECORD tdb:TDescBlock; link,root,nofmeth,nofinhmeth,bmno,bpvfp:LONGINT; bname:Name; END; ExportPtr=POINTER TO Export; ArrPtr=POINTER TO RECORD a,b,c,len,data:LONGINT; END; VAR i,entry,link,fprint,k,t,curtd,limtd:LONGINT; m1:Module; data:BOOLEAN; curexp,limexp:ExportPtr; refsize,nofimp,newreclink,newsyslink,newarrlink,datalink,datasize,consize,codesize:LONGINT; nofexp,nofdesc,nofcom,nofptr,linknr,expnr,descnr:INTEGER; name:Name; ch:CHAR; links:ARRAY 256 OF RECORD entry,link:LONGINT; END; types:ARRAY 128 OF Type; arrPtr:ArrPtr; modname,impname:Name; PROCEDURE Block(tag:CHAR); (* Check if next character is correct block tag. *) VAR ch:CHAR; BEGIN Files.Read(R,ch); IF ch#tag THEN error.importing:=m.name; error.res:=corruptedObjFile; END END Block; PROCEDURE ReadType(VAR tdesc:ADDRESS); VAR tdb:TDescBlock; tdd:TDescDesc; i,tdsize,recsize,pvfp,bmno:LONGINT; nofmeth,nofnewmeth,mthno,nofptr,root,entry:LONGINT; name:Name; BEGIN Files.ReadString(R,name); IF name="" THEN Files.ReadNum(R,pvfp) ELSE pvfp:=0 END; Files.ReadNum(R,types[descnr].link); Files.ReadNum(R,recsize); Files.ReadNum(R,bmno); types[descnr].bmno:=bmno; IF bmno >= 0 THEN Files.ReadString(R,types[descnr].bname); IF types[descnr].bname="" THEN Files.ReadNum(R,types[descnr].bpvfp) END END; Files.ReadNum(R,nofmeth); types[descnr].nofmeth:=nofmeth; Files.ReadNum(R,types[descnr].nofinhmeth); Files.ReadNum(R,nofnewmeth); Files.ReadNum(R,nofptr); root:=14 (* tdsize..pvfp *) + nofmeth + ExtTabWordSize + 1 (* tag *); INC(root,(-root+2) MOD 4); (* ADR(tdesc.a[root]) MOD 16=8 ! *) types[descnr].root:=root; tdsize:=(root + 1 (* recsize *) + nofptr + 1 (* sentinel *))*4; SYSTEM.NEW(tdb,tdsize-24 (* SysBlk header *)); IF tdb=NIL THEN error.importing:=name; error.res:=notEnoughSpace; RETURN END; DEC(SYSTEM.VAL(ADDRESS,tdb),24); types[descnr].tdb:=tdb; tdd:=SYSTEM.VAL(TDescDesc,tdb); tdd.tdsize:=tdsize; tdd.sentinel:=-4; tdd.self:=SYSTEM.ADR(tdb.word[root]); tdd.name:=name; tdd.mdesc:=m; tdd.pvfprint:=pvfp; i:=0; WHILE i < nofnewmeth DO Files.ReadNum(R,mthno); Files.ReadNum(R,entry); INC(i); tdb.word[root + Mth0WordOffset-mthno]:=SYSTEM.ADR(m.code[0]) + 4*entry END; tdb.word[root-1]:=SYSTEM.ADR(tdb.word[0]); tdb.word[root]:=recsize; i:=0; WHILE i < nofptr DO Files.ReadNum(R,tdb.word[root+1+i]); INC(i) END; tdb.word[root+1+nofptr]:=-(nofptr+1)*4; tdesc:=SYSTEM.ADR(tdb.word[root]) END ReadType; PROCEDURE FindExp(mode:INTEGER; VAR name:Name; fprint:LONGINT; VAR adr:LONGINT); BEGIN LOOP IF curexp=limexp THEN error.res:=objNotFound; error.object:=name; error.objmode:=modeStr[mode]; EXIT END; IF (curexp.name=name) & (curexp.mode=mode) THEN IF curexp.fprint#fprint THEN error.res:=fpMismatch; error.object:=name; error.objmode:=modeStr[mode] END; adr:=curexp.adr; INC(SYSTEM.VAL(LONGINT,curexp),SIZE(Export)); EXIT; END; INC(SYSTEM.VAL(LONGINT,curexp),SIZE(Export)); END; END FindExp; PROCEDURE FindTDesc(VAR name:Name; fprint:LONGINT; VAR adr:LONGINT); VAR save,td:LONGINT; tdd:TDescDesc; BEGIN save:=curtd; (* anonymous tdescs are unsorted *) LOOP IF curtd=limtd THEN error.res:=objNotFound; error.object:=name; error.objmode:=modeStr[8]; EXIT ;END; SYSTEM.GET(curtd,td); SYSTEM.GET(td-4,tdd); IF tdd.name=name THEN IF (tdd.pvfprint=fprint) OR (fprint=0) THEN adr:=td; INC(curtd,4); EXIT; END; IF name#"" THEN error.res:=fpMismatch; error.object:=name; error.objmode:=modeStr[8]; EXIT; END END; INC(curtd,4); END; IF name="" THEN curtd:=save; END; END FindTDesc; PROCEDURE InitType(tdesc:ADDRESS; VAR type:Type); VAR l,r,t,k,base,tag,root,n,entry,pvfp:LONGINT; mb:Module; tdb:TDescBlock; tdd:TDescDesc; BEGIN tdb:=type.tdb; IF tdb#NIL THEN (* not done yet *) type.tdb:=NIL; Fixup(m,tdesc,type.link,TRUE); k:=0; root:=type.root; base:=type.bmno; IF base#-1 THEN mb:=SYSTEM.VAL(Module,m.imports[base]); IF type.bname="" THEN pvfp:=type.bpvfp; t:=-1; REPEAT (* tdesc always present since local *) INC(t); SYSTEM.GET(mb.tdescs[t]-4,tdd) UNTIL tdd.pvfprint=pvfp ELSE l:=0; r:=LEN(mb.tdescs^)-1; LOOP IF l>r THEN EXIT; END; t:=(l + r) DIV 2; SYSTEM.GET(mb.tdescs[t]-4,tdd); IF type.bname < tdd.name THEN r:=t-1; ELSIF type.bname>tdd.name THEN l:=t + 1; ELSE EXIT; END; END; IF l>r THEN error.importing:=m.name; error.imported:=mb.name; error.object:=type.bname; error.objmode:=modeStr[8]; error.res:=objNotFound; RETURN; END; END; IF base=0 THEN InitType(mb.tdescs[t],types[t]); (* res always 0 here *) END; base:=mb.tdescs[t]; SYSTEM.GET(base+Tag0WordOffset*4,tag); WHILE tag#0 DO tdb.word[root+Tag0WordOffset-k]:=tag; INC(k); SYSTEM.GET(base+(Tag0WordOffset-k)*4,tag); END; n:=type.nofinhmeth; WHILE n>0 DO DEC(n); entry:=tdb.word[root+Mth0WordOffset-n]; IF entry=0 THEN SYSTEM.GET(base+(Mth0WordOffset-n)*4,tdb.word[root+Mth0WordOffset-n]); END END END; SYSTEM.PUT(SYSTEM.ADR(tdb.word[3]),SHORT(SHORT(k))); (* ok for little and big endian *) tdb.word[root + Tag0WordOffset-k]:=SYSTEM.ADR(tdb.word[root]); (* INC(k); WHILE k < ExtTabWordSize DO tdb.word[root+Tag0WordOffset-k]:=0; INC(k); END; *) END END InitType; PROCEDURE BuildModBlock; (* The allocated module storage is composed of the blocks indicated on the left side of the picture. Each block is structured as show on the right. The pointer in m point to the value after the tag. The tag is always a replicate of the tag generated by SYSTEM.NEW for the whole allocated block. NOTE The len value contains the number of entries, i.e. bytes DIV 4.  *) VAR t,gvarSize:LONGINT; BEGIN SYSTEM.GET(SYSTEM.VAL(ADDRESS,arrPtr)-4,t); SYSTEM.PUT(SYSTEM.ADR(m.exports),arrPtr); arrPtr.len:=nofexp; INC(SYSTEM.VAL(ADDRESS,arrPtr),((LONG(nofexp)*SIZE(Export)+35) DIV 16)*16); SYSTEM.PUT(SYSTEM.VAL(ADDRESS,arrPtr)-4,t); SYSTEM.PUT(SYSTEM.ADR(m.tdescs),arrPtr); arrPtr.len:=nofdesc; INC(SYSTEM.VAL(ADDRESS,arrPtr),((LONG(nofdesc)*4+35) DIV 16)*16); SYSTEM.PUT(SYSTEM.VAL(ADDRESS,arrPtr)-4,t); SYSTEM.PUT(SYSTEM.ADR(m.cmds),arrPtr); arrPtr.len:=nofcom; INC(SYSTEM.VAL(ADDRESS,arrPtr),((LONG(nofcom)*SIZE(Cmd)+35) DIV 16)*16); SYSTEM.PUT(SYSTEM.VAL(ADDRESS,arrPtr)-4,t); SYSTEM.PUT(SYSTEM.ADR(m.ptrTab),arrPtr); arrPtr.len:=nofptr; INC(SYSTEM.VAL(ADDRESS,arrPtr),((LONG(nofptr)*4+35) DIV 16)*16); SYSTEM.PUT(SYSTEM.VAL(ADDRESS,arrPtr)-4,t); SYSTEM.PUT(SYSTEM.ADR(m.imports),arrPtr); arrPtr.len:=nofimp+1; INC(SYSTEM.VAL(ADDRESS,arrPtr),(((nofimp+1)*4+35) DIV 16)*16); SYSTEM.PUT(SYSTEM.VAL(ADDRESS,arrPtr)-4,t); SYSTEM.PUT(SYSTEM.ADR(m.data),arrPtr); gvarSize:=datasize+(-datasize) MOD 8; m.sb:=SYSTEM.ADR(arrPtr.data)+gvarSize; arrPtr.len:=(gvarSize+consize+3) DIV 4; INC(SYSTEM.VAL(ADDRESS,arrPtr),((gvarSize+consize+35) DIV 16)*16); SYSTEM.PUT(SYSTEM.VAL(ADDRESS,arrPtr)-4,t); SYSTEM.PUT(SYSTEM.ADR(m.code),arrPtr); arrPtr.len:=codesize DIV 4; INC(SYSTEM.VAL(ADDRESS,arrPtr),((codesize+35) DIV 16)*16); SYSTEM.PUT(SYSTEM.VAL(ADDRESS,arrPtr)-4,t); SYSTEM.PUT(SYSTEM.ADR(m.refs),arrPtr); arrPtr.len:=refsize END BuildModBlock; BEGIN (* ASSERT((m=NIL)&(res=done)); *) (* ObjFile=OFtag HeaderBlk ImpBlk ExpBlk CmdBlk PtrBlk ConstBlk CodeBlk UseBlk RefBlk. OFtag=0F9X 36X. HeaderBlk=refsize:4 nofexp:2 noftdesc:2 nofcom:2 nofptr:2 nofimp newreclink newsyslink newarrlink datalink datasize consize codesize modname. The object file starts with a header containing size/number of elements of the different parts and the module name. *) Files.ReadLInt(R,refsize); Files.ReadInt(R,nofexp); Files.ReadInt(R,nofdesc); Files.ReadInt(R,nofcom); Files.ReadInt(R,nofptr); Files.ReadNum(R,nofimp); Files.ReadNum(R,newreclink); Files.ReadNum(R,newsyslink); Files.ReadNum(R,newarrlink); Files.ReadNum(R,datalink); Files.ReadNum(R,datasize); Files.ReadNum(R,consize); Files.ReadNum(R,codesize); Files.ReadString(R,modname); codesize:=4*codesize; (* ImpBlk=81X {name}. The import block contains a list of module names to import. They are all loaded calling recursively Load. *) Block(81X); FOR i:=0 TO nofimp-1 DO Files.ReadString(R,impname); END; (* Allocate the module descriptor, and the necessary space for the module itself. *) NEW(m); IF m=NIL THEN error.importing:=""; error.res:=notEnoughSpace; RETURN; END; k:=( (LONG(nofexp)*SIZE(Export)+35) DIV 16 +(LONG(nofdesc)*4+35) DIV 16 +(LONG(nofcom)*SIZE(Cmd)+35) DIV 16 +(LONG(nofptr)*4+35) DIV 16 +((nofimp+1)*4+35) DIV 16 +(datasize+(-datasize) MOD 8+consize+35) DIV 16 +(codesize+35) DIV 16 +(refsize+35) DIV 16 )*16; SYSTEM.NEW(arrPtr,k); IF arrPtr=NIL THEN error.importing:=modname; m:=NIL; error.res:=notEnoughSpace; RETURN; END; m.name:=modname; m.init:=FALSE; m.refcnt:=0; (* Set up all internal pointers, and the module descriptor. BuildModBlocks is a local procedure, which uses and modifies m and arrPtr. *) BuildModBlock; (* ExpBlk=82X {EConst|EType|EVar|EProc|ECProc|EStruct|TDesc|LinkProc} 0X. EConst=1X name fprint. ETyoe=2X name fprint. EVar=3X name fprint offset. EProc 4X name fprint entry. ECProc=5X name fprint. EStruct=6X name pbfprint pvfprint. TDesc=8X (name|0X pvprint) link recsize (-1|basemod (name|0X pvfprint)) nofmth nofinhmth nofnewmth nofptr {mthno entry} {ptroff}. LinkProc=9X entry link. *) Block(82X); linknr:=0; expnr:=0; descnr:=0; Files.Read(R,ch); WHILE ch#0X DO (* character decides, which kind of export it is. *) IF ch=8X THEN (* TDesc *) ReadType(m.tdescs[descnr]); INC(descnr); IF error.res#done THEN m:=NIL; RETURN; END; ELSIF ch=9X THEN (* LinkProc *) Files.ReadNum(R,entry); links[linknr].entry:=SYSTEM.ADR(m.code[0])+4*entry; Files.ReadNum(R,links[linknr].link); INC(linknr); ELSE (* All other start with name fprint *) Files.ReadString(R,m.exports[expnr].name); Files.ReadNum(R,m.exports[expnr].fprint); m.exports[expnr].mode:=ORD(ch); IF ch=3X THEN (* EVar *) (* The variable offset is read and added to the static base to get the absolute address of the variable. *) Files.ReadNum(R,entry); m.exports[expnr].adr:=m.sb+entry; ELSIF ch=4X THEN (* EProc *) Files.ReadNum(R,entry); m.exports[expnr].adr:=SYSTEM.ADR(m.code[0])+4*entry; ELSIF ch=6X THEN (* EStruct *) INC(expnr); m.exports[expnr].mode:=7; m.exports[expnr].name:=m.exports[expnr-1].name; Files.ReadNum(R,m.exports[expnr].fprint); (* pvfprint *) END; INC(expnr); END; Files.Read(R,ch); END; (* CmdBlk=83X {name entry}. Entry is an LONGINT offset relative to the start of the code block. *) Block(83X); t:=SYSTEM.ADR(m.code[0]); FOR i:=0 TO nofcom-1 DO Files.ReadString(R,m.cmds[i].name); Files.ReadNum(R,entry); m.cmds[i].adr:=t+4*entry; END; (* PtrBlk=84X {off}. All offsets are relative to the start of the data block. *) Block(84X); t:=m.sb; FOR i:=0 TO nofptr-1 DO Files.ReadNum(R,k); m.ptrTab[i]:=t+k; END; (* ConstBlk=87X {con:1}. Constant data area. This area is at the beginning of the data area, and may have any length, i.e. not necessarly a multiple of the size of a LONGINT. *) Block(87X); FOR i:=0 TO consize-1 DO Files.Read(R,ch); SYSTEM.PUT(t,ch); INC(t); END; (* CodeBlk=88X {instr:4}. The bytes forming a code area. Its size is a multiple of 4. *) Block(88X); t:=SYSTEM.ADR(m.code[0]); FOR i:=0 TO codesize-1 BY 4 DO Files.ReadLInt(R,k); SYSTEM.PUT(t,k); INC(t,4); END; WHILE linknr>0 DO DEC(linknr); Fixup(m,links[linknr].entry,links[linknr].link,FALSE) END; (* Fixup all referencs to the kernel routines. *) Fixup(m,KernelRoutines[0],newreclink,FALSE); Fixup(m,KernelRoutines[1],newsyslink,FALSE); Fixup(m,KernelRoutines[2],newarrlink,FALSE); Fixup(m,m.sb,datalink,TRUE); (* UseBlk=89X {{UConst|UType|UVar|UProc|UCProc|UpbStr|UpvStr|LinkTD} 0X}. UConst=1X name fprint. UType=2X name fprint. UVar=3X name fprint link. UProc=4X name fprint link. UCProc=5X name fprint. UpbStr=6X name pbfprint. UpvStr=7X name pvfprint. LinkTD=8X (name | 0X pvfprint) link. The finger prints of all used objects. *) Block(89X); FOR i:=0 TO nofimp-1 DO m1:=SYSTEM.VAL(Module,m.imports[i+1]); curexp:=SYSTEM.VAL(ExportPtr,SYSTEM.ADR(m1.exports^)); limexp:=SYSTEM.VAL(ExportPtr,SYSTEM.VAL(ADDRESS,curexp)+LEN(m1.exports^)*SIZE(Export)); curtd:=SYSTEM.ADR(m1.tdescs^); limtd:=curtd+LEN(m1.tdescs^)*4; Files.Read(R,ch); WHILE ch#0X DO Files.ReadString(R,name); Files.ReadNum(R,fprint); CASE ch OF | 1X,2X,5X,6X,7X:FindExp(ORD(ch),name,fprint,entry); link:=-1 | 3X,4X:FindExp(ORD(ch),name,fprint,entry); Files.ReadNum(R,link); data:=ch=3X | 8X:IF name="" THEN Files.ReadNum(R,link) ELSE link:=fprint; fprint:=0 END; FindTDesc(name,fprint,entry); data:=TRUE END; IF error.res#done THEN error.importing:=m.name; error.imported:=m1.name; IF error.res=fpMismatch THEN Console.Str(m.name); Console.Str(" imports "); Console.Str(error.objmode); Console.Ch(" "); Console.Str(m1.name); Console.Ch("."); Console.Str(error.object); Console.Str(" with bad fingerprint") ELSE Console.Str(error.objmode); Console.Ch(" "); Console.Str(m1.name); Console.Ch("."); IF error.object="" THEN Console.Str("'anonymous'") ELSE Console.Str(error.object) END; Console.Str(" not found") END; Console.Ln; m:=NIL; RETURN END; IF link#-1 THEN Fixup(m,entry,link,data) END; Files.Read(R,ch) END; END; (* RefBlk=8AX {0F*X procend savedr savedf frame callarea name {Mode Form adr name}}. Reference information *) Block(8AX); t:=SYSTEM.ADR(m.refs[0]); FOR i:=0 TO refsize-1 DO Files.Read(R,ch); SYSTEM.PUT(t,ch); INC(t); END; (* init types *) FOR i:=0 TO LEN(m.tdescs^)-1 DO InitType(m.tdescs[i],types[i]); IF error.res#done THEN m:=NIL; RETURN END; (* Terminate if types could not be initialised (why ?) *) END; error.res:=done; END LoadModule; PROCEDURE Init; VAR newRec:PROCEDURE(tag:Kernel.Tag):ADDRESS; newSys:PROCEDURE(size:LONGINT):ADDRESS; newArr:PROCEDURE(eltag:Kernel.Tag; nofelem,nofdim:LONGINT):ADDRESS; BEGIN modeStr[1]:="constant"; modeStr[2]:="type"; modeStr[3]:="variable"; modeStr[4]:="procedure"; modeStr[5]:="code procedure"; modeStr[6]:="public structure of"; modeStr[7]:="private structure of"; modeStr[8]:="type descriptor of"; (* Remember Kernel New procedures for module fixup. *) newRec:=Kernel.NewRec; newSys:=Kernel.NewSys; newArr:=Kernel.NewArr; KernelRoutines[0]:=SYSTEM.VAL(ADDRESS,newRec); KernelRoutines[1]:=SYSTEM.VAL(ADDRESS,newSys); KernelRoutines[2]:=SYSTEM.VAL(ADDRESS,newArr); END Init; BEGIN Init; END ModuleBase.