%CONSTINTEGER EMAS=0,PERQ=1,SYS=PERQ %CONSTINTEGER NOTSYS=(SYS+1)&1 !******************************************** !* PERQ LPUT * !******************************************** %ROUTINESPEC QPUT(%INTEGER A,B,C,D) {ensure qput is routine number one} {PERQ} %EXTERNALROUTINESPEC WRITE BLOCK(%HALFINTEGER FILEID,BLOCK, %INTEGER AD) {PERQ} %EXTERNALROUTINESPEC READBLOCK(%HALFINTEGER FILEID,BLOCK,%INTEGER AD) {PERQ} %EXTERNALROUTINESPEC NEWSEG(%INTEGER AD, %HALFINTEGER SIZE,INC,MAXSIZE) {PERQ} %EXTERNALROUTINESPEC CLOSEFILE(%HALFINTEGER FILEID,BLOCKS,BITS) %DYNAMICROUTINESPEC QCODE(%INTEGER I,J,K,L) {EMAS %SYSTEMSTRINGFNSPEC FAILUREMESSAGE(%INTEGER MESS) {EMAS %EXTERNALSTRINGFNSPEC UINFS(%INTEGER N) {EMAS %SYSTEMSTRINGFNSPEC SPAR(%INTEGER N) {EMAS %SYSTEMROUTINESPEC SETFNAME(%STRING(63) S) {EMAS %EXTERNALROUTINESPEC CHANGECONTEXT {EMAS %SYSTEMINTEGERMAPSPEC COMREG(%INTEGER I) {EMAS %SYSTEMROUTINESPEC OUTFILE(%STRING (15) S, %C {EMAS %INTEGER LENGTH, MAXBYTES, PROTECTION, %INTEGERNAME CONAD, FLAG) {EMAS %SYSTEMROUTINESPEC MOVE(%INTEGER L,F,T) {PERQ} %externalroutinespec EXTENDSEG(%halfinteger FILEID,INC) %SYSTEMROUTINESPEC SSERR(%INTEGER N) %ROUTINE PHEX(%INTEGER N) WRITE(N,1) ; SPACE %END !* !* {EMAS !-------------------------------------- {EMAS ! ROUTINE TO CHANGE BYTE ORDER {EMAS !-------------------------------------- {EMAS {EMAS %ROUTINE REVERSE(%INTEGER AD,LEN) {EMAS {EMAS %INTEGER I,J {EMAS {EMAS I=AD {EMAS %UNTIL I=AD+(LEN*2) %CYCLE {EMAS J=BYTEINTEGER(I) {EMAS BYTEINTEGER(I)=BYTEINTEGER(I+1) {EMAS BYTEINTEGER(I+1)=J {EMAS I = I + 2 {EMAS %REPEAT {EMAS %END {PERQ} %ROUTINE COPY(%INTEGER LEN,SBASE, %HALFINTEGER SDISP, %INTEGER TBASE, %HALFINTEGER TDISP) {PERQ {PERQ} **@TBASE {PERQ} *LDDW {PERQ} **TDISP {PERQ} **@SBASE {PERQ} *LDDW {PERQ} **SDISP {PERQ} **LEN+1 {PERQ} *STLATE_X'63' {PERQ} *MVBW {PERQ} %END !* %EXTERNALROUTINE QPUT(%INTEGER TYPE, P1, P2, P3) %RECORDFORMAT RF0(%HALFINTEGER TYPE,RECLEN, %INTEGER LA, DATALEN, FILLER) %RECORDFORMAT RF1(%HALFINTEGER TYPE,RECLEN, %INTEGER LINK, N, RID, %STRING(32) NAME) %RECORDFORMAT RF4(%HALFINTEGER TYPE,RECLEN, %INTEGER LINK, L,%HALFINTEGER PROPS, AREA, %STRING (31) NAME) %RECORDFORMAT RF7(%HALFINTEGER TYPE,RECLEN, %INTEGER LINK, %HALFINTEGER AREA,AREALOC, BASE,BASELOC) %RECORDFORMAT RF8(%HALFINTEGER TYPE,RECLEN, %INTEGER LINK, CODEADDR, ADDRFIELD) %RECORDFORMAT RF9(%HALFINTEGER TYPE,RECLEN, %INTEGER LINK, %halfinteger sp1,iin, %integer LA,DATALEN,FILLER) %RECORDFORMAT RF10(%HALFINTEGER TYPE,RECLEN, %INTEGER LINK,AREA,DISP,LEN) %RECORDFORMAT RF27(%HALFINTEGER TYPE,RECLEN, %INTEGER LINK,LINE,INF,%STRING(32) NAME) %RECORD(RF0) %NAME R0 %RECORD(RF1) %NAME R1 %RECORD(RF4) %NAME R4 %RECORD(RF7) %NAME R7 %RECORD(RF8) %NAME R8 %RECORD(RF9) %NAME R9 %RECORD(RF10) %NAME R10 %RECORD(RF27) %NAME R27 !* l2fm - code offset became rt 25/mar/82 !------------------------------------------------ ! PERQ OBJECT RECORD FORMATS !---------------------------------------------- ! RED TAPE AT START OF CODE SEGMENT %RECORDFORMAT CHFM (%HALFINTEGER DICT,RTS,LDATA,MAP) %RECORD(CHFM) %NAME CH ! LDATA LISTHEADS %HALFINTEGERARRAYFORMAT LDATAFM(0:10) %HALFINTEGERARRAYNAME LDATA ! PROCEDURE ENTRY POINT %RECORDFORMAT L1FM (%HALFINTEGER LINK,PROPS,RTNO,DIAGDISP,%STRING(31) NAME) ! PROCEDURE REFERENCES ( SYSTEM) %RECORDFORMAT L2FM (%HALFINTEGER LINK,rt,%STRING(31) NAME) ! PROCEDURE REFERENCES (USER) %RECORDFORMAT L3FM (%HALFINTEGER LINK,GLA REF, ISN, RTNO, %STRING(31) NAME) ! DATA ENTRIES %RECORDFORMAT L4FM (%HALFINTEGER LINK,AREA, %INTEGER DISP,LEN, %STRING(31) NAME) ! DATA REFERENCE (FROM GLA) %RECORDFORMAT L5FM (%HALFINTEGER LINK,GLAREF,%INTEGER LEN, %STRING(31) NAME) ! COMMON DEFINITIONS %RECORDFORMAT L6FM (%HALFINTEGER LINK,AREA NO, %INTEGER LENGTH,%HALFINTEGER PROPS, %STRING(31) NAME) ! DATA INITIALISATION %RECORDFORMAT L7FM (%HALFINTEGER LINK,AREA, %INTEGER DISP, %HALFINTEGER COPIES,LEN) ! 16 BIT FIXUPS ( IN GLA , RELOCATED BY GLA BASE) %RECORDFORMAT L8FM (%HALFINTEGER LINK, NUM, %HALFINTEGERARRAY DISP(1:10000)) ! 32 BIT FIXUPS ( IN GLA ) %RECORDFORMAT L9FFM (%HALFINTEGER DISP,AREA) %RECORDFORMAT L9FM (%HALFINTEGER LINK,NUM, %RECORD(L9FFM) %ARRAY FIX(1:5000)) ! LIST 10 CONTAINS THE ROOT FILE NAME ! ROUTINE DICTIONARY FORMAT %RECORDFORMAT DICTFM(%HALFINTEGER PS,RPS,LTS,ENTRY,EXIT,LL,SP1,SP2) %RECORD(DICTFM) %ARRAYFORMAT DICTAFM(0:255) %RECORD(DICTFM) %ARRAYNAME DICTIONARY %RECORD(DICTFM) %NAME DICT ! OBJECT FILE AREA MAP %RECORDFORMAT MAPFM(%HALFINTEGER START,PROPS, %INTEGER LEN) %RECORD(MAPFM) %ARRAYNAME AMAP %RECORD(MAPFM) %ARRAYFORMAT AMAPFM(1:10) %RECORD(L1FM) %NAME L1 %RECORD(L2FM) %NAME L2 %RECORD(L3FM) %NAME L3 %RECORD(L4FM) %NAME L4 %RECORD(L5FM) %NAME L5 %RECORD(L6FM) %NAME L6 %RECORD(L7FM) %NAME L7 %RECORD(L8FM) %NAME L8 %RECORD(L9FM) %NAME L9 %RECORDFORMAT HDRFM(%BYTEINTEGER QVERSION, {QCODE VERSION} FLAGS, %BYTEINTEGERARRAY MODULE(0:7), {8 CHAR MODULE NAME (NO LENGTH BYTE) } %STRING(100) SOURCE FILE, { FULL PATH NAME OF SOURCE FILE } %HALFINTEGER NUMIMPS, { NUMBER OF IMPORTED SEGMENTS } IMPBLOCK, { BLOCK NUMBER OF IMPORTS TABLE } GDSIZE, { SIZE IN 16 BIT WORDS OF GLOBAL DATA BLOCK } %STRING(80) VERSION, { VERSION OF COMPILER } COPYRIGHT, %BYTEINTEGER D2, %HALFINTEGER LANGUAGE, %HALFINTEGER PRELINKBLOCK, ROUTDESCBLOCK, DIAGBLOCK) %RECORD(HDRFM) %NAME H %RECORDFORMAT PLBFM(%HALFINTEGER BLOCK,BYTE OFFSET, %BYTEINTEGERARRAY NAME(0:7), %BYTEINTEGERARRAY ROUTDESC(0:255)) %RECORD(PLBFM) %NAME PLB %RECORDFORMAT IMPFM(%BYTEINTEGERARRAY MOD(0:7), %STRING(101) FILE) %RECORD(IMPFM) %ARRAYFORMAT IMPAFM(0:500) %RECORD(IMPAFM) %ARRAYNAME IMPORTS %RECORDFORMAT RF11(%HALFINTEGER TYPE,RECLEN, %INTEGER LINK,%HALFINTEGER PROPS,RTNO, %RECORD(DICTFM) D, %C %HALFINTEGER DIAGDISP,PLEN, %STRING(31) NAME) %RECORD(RF11) %NAME R11 !* %CONSTINTEGER MODCOUNT=27 !* %CONSTSTRING(15)%ARRAY MODULES(0:MODCOUNT) = %C "F77INIT","F77DCTL","F77DIAG","F77IDIAG","F77FDIAG", "F77RMESS","F77IO","F77FMT","F77INTRIN","F77AUX", "F77MAP","F77CMESS","F77COMP","F77ANAL","F77ALLOC", "F77GEN","F77CODE","F77QPUT","IMPSUP","F77QCODE", "F77IOA","F77IOB","F77IOC","F77IOD","F77IOE", "F77IOF","F77FILE","F77COPS" !* %CONSTINTEGER RCOUNT=133 !* %CONSTSTRING(15)%ARRAY RNAMES(0:RCOUNT) = %C "F77IOA","F77IOB","F77IOC","F77IOD","F77IOE","F77IOF", "INITMAIN","INITGLA","IOCP","STOP","WRITE", "NEWSEG","EXTENDSEG","DECREFSEG", "READBLOCK","WRITEBLOCK","CLOSEFILE", "GETLINE","INITCOMP","OPENFILE", "DATEANDTIME","CREATEFILE","FILELOOKUP", "EXTENDFILENAME","DESTROYFILE", "NDIAG","SSMESS","QRMESS","QIDIAG","QFDIAG", "F77STOP","F77PAUSE","F77RTERR","F77IOERR","F77CONCAT", "F77COPY","F77INDEX","F77CMULTC","F77CDIVC","F77CXREL", "F77CHREL","F77IABS","F77ABS","F77MOD","F77AMOD", "F77ISIGN","F77SIGN","F77NINT","F77AINT","F77ANINT", "F77IDIM","F77DIM","F77LLE","F77LGT","F77LLT", "F77LGE","F77LEN", "F77IO", "FORMATCD", "FLOATLONG","TRUNCLONG","ROUNDLONG","F77SQRT","F77EXP", "F77LOG","F77LOG10","F77SIN","F77COS","F77TAN", "F77ASIN","F77ACOS","F77ATAN","F77ATAN2","F77SINH", "F77COSH","F77TANH","F77POWER","F77POWERI","F77CSQRT", "F77CEXP","F77CLOG","F77CSIN","F77CCOS","F77CXXC", "F77CXXR","F77CABS", "F77COMP","SOURCELINE","DICFUL", "ANALSTART","GETCOMAD","FREESP","NEWLISTCELL","FREELISTCELL", "SETLAB","CHECKDOINDEX","FAULT","LFAULT","TFAULT", "IFAULT", "PRINTFL", "GENERATE","COERCECONST", "ALLOC","ALLOCCHAR","INITALLOC","ADDDATAITEM","TIDYGLA", "PFORMAT","TOINTEGER","TOREAL","GLASPACE", "QCMESS","FAULTNUM", "QPUT", "CODEGEN", "MAP", "QCODE", "NEWFILEOP","INREC","INCHAR","INFIELD","OUTCHAR", "OUTFILL","OUTFIELD","OUTREC","BSPREC","F77OPEN", "F77INQUIRE","F77CLOSE","CLOSEFILES", "REALOP","INTOP","COOP" !* %CONSTBYTEINTEGERARRAY MODINDEX(0:RCOUNT) = %C 20,21,22,23,24,25, 0,0,0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0, 1,1,5,3,4, 9,9,9,9,9, 9,9,9,9,9, 9,9,9,9,9, 9,9,9,9,9, 9,9,9,9,9, 9,9, 6, 7, 8,8,8, 8,8,8,8,8, 8,8,8,8,8, 8,8,8,8,8, 8,8,8,8,8, 8,8,8,8, 12,12,12, 13,13,13,13,13, 13,13,13,13,13, 13, 18, 15,15, 14,14,14,14,14, 14,14,14,14, 11,11, 17, 16, 10, 19, 26,26,26,26,26, 26,26,26,26,26, 26,26,26, 27,27,27 !* %CONSTBYTEINTEGERARRAY RNO(0:RCOUNT) = %C 1,1,1,1,1,1, 1,2,3,4,5, 6,7,8, 9,10,11, 12,13,14, 15,16,17, 18,19, 0,1,1,1,1, 1,2,3,4,5, 6,7,8,9,10, 11,12,13,14,15, 16,17,18,19,20, 21,22,23,24,25, 26,27, 1, 1, 0,1,2, 3,4,5,6,7, 8,9,10,11,12, 13,14,15,16,17, 18,19,20,21,22, 23,24,25,26, 1,2,3, 1,2,3,4,5, 6,7,8,9,10, 11, 1, 1,2, 1,2,3,4,5, 6,7,8,9, 1,2, 1, 1, 1, 1, 1,2,3,4,5, 6,7,8,9,10, 11,12,13, 1,2,3 !----------------------------------------- ! CONSTANTS !------------------------------------------ %CONSTINTEGER MAXAREAS=6 %CONSTINTEGER FORTRAN=1,IMP=2 {EMAS %CONSTINTEGER HDRLEN = 544 ;! BYTE DISP FROM EMAS FILE START TO CODE {EMAS %CONSTINTEGER EHEAD=32 {EMAS %CONSTINTEGER MAXFSIZE=X'80000' {PERQ} %CONSTINTEGER HDRLEN = 512 {PERQ} %CONSTINTEGER EHEAD = 0 {PERQ} %CONSTINTEGER MAXFSIZE=(64*1024)-1 %CONSTINTEGER REDTAPELEN = 4 ;! DISP TO LDATA AND AREA MAP {PERQ} %consthalfinteger WSEGINC=1 ;! extend work segment by one block at a time !----------------------------------------- ! OWNS !---------------------------------------- {EMAS %OWNINTEGER WORKMAX {PERQ} %OWNHALFINTEGERARRAY BUF(0:255) {PERQ} %ownhalfinteger WSEGSIZE=1 {minimum work segment size is one block} %ownhalfinteger unsatrefs=0 {PERQ} %ownhalfinteger WSEGMAX=1 {Maximum work segment size} %OWNINTEGER WORKAD %OWNHALFINTEGER LMAX=54 %OWNHALFINTEGERARRAY MODUSED(0:MODCOUNT)=-1(*) %OWNINTEGER TBASE, TON, TMAX,WPTR %OWNINTEGER FBASE %OWNHALFINTEGER NUMIMPS=0 %OWNHALFINTEGER MAXRT=0 {PERQ} %halfinteger wblock {PERQ} %OWNHALFINTEGER NUMWORKBLOCKS=0 {PERQ} %OWNHALFINTEGER NUMOBJBLOCKS=0 %ownstring(6) rels="0.0" %OWNSTRING(110) ROOT %OWNHALFINTEGER TRACE=0,WORKID=0,OBJID=0 {EMAS %OWNINTEGER NULLFLAG=0 %OWNINTEGERARRAY HEAD(5 : 25)=0(*) %OWNINTEGERARRAY AREALENGTH(1 : MAXAREAS) %OWNINTEGERARRAY AREASTART(1 : MAXAREAS) %OWNHALFINTEGERARRAY AREAPROP(1 : MAXAREAS) %OWNHALFINTEGER TYPE19NUM=0,TYPE20NUM=0 %ownbyteintegerarray rtused(0:rcount)=0(*) %OWNSTRING (110) FILE %OWNHALFINTEGER LANGUAGE %OWNHALFINTEGER MAINEP=0 %OWNINTEGER LA %OWNINTEGER DECODEHEAD=0,DECODETAIL=0 !----------------------------------- ! LOCALS !---------------------------------- %INTEGER LI,J,K,L,FLAG {EMAS %INTEGER I {PERQ} %HALFINTEGER I %INTEGER OBJLEN,AD %HALFINTEGER M,INC %string(110) rest %string(255) %name DESC %STRING(32) XREF {EMAS %BYTEINTEGERARRAYFORMAT MAXBYTEFM(0:MAXFSIZE) {EMAS %BYTEINTEGERARRAYNAME OBJECT %INTEGER LDSTART, LDDISP,CODEBASE %SWITCH EP(0 : 40+MAXAREAS) %SWITCH LSW(0 : 40+MAXAREAS) !---------------------------------------------------- ! ROUTINE TO FIX KNOWN SYSTEM XREFS !----------------------------------------------------- {EMAS %ROUTINE FIX(%INTEGER RID,%INTEGER DISP) {EMAS {EMAS {EMAS %CONSTINTEGER CALLXB = 234 {EMAS %CONSTINTEGER CALLXW = 235 {EMAS %constinteger LVRD = 98 {EMAS %HALFINTEGER OPCODE {EMAS {EMAS DISP=DISP+512 {EMAS OPCODE = OBJECT(DISP) {EMAS %IF OPCODE = CALLXW %or OPCODE = LVRD %START {EMAS OBJECT(DISP+1)=MODUSED(MODINDEX(RID)) {EMAS OBJECT(DISP+2)=0 {EMAS OBJECT(DISP+3) = RNO(RID) {EMAS %FINISH %ELSESTART {EMAS %IF OPCODE = CALLXB %START {EMAS OBJECT(DISP+1)=MODUSED(MODINDEX(RID)) {EMAS OBJECT(DISP+2) = RNO(RID) {EMAS %FINISHELSESTART {EMAS NEWLINE {EMAS PRINTSTRING(" BAD XREF ".RNAMES(RID)." pointing at") {EMAS WRITE(DISP-(512+redtapelen),1) {EMAS NEWLINE {EMAS %FINISH {EMAS %FINISH {EMAS %END {PERQ}%ROUTINE FIX(%INTEGER RID,%INTEGER DISP) {PERQ {PERQ {PERQ} %CONSThalfINTEGER CALLXB = 234 {PERQ} %CONSThalfINTEGER CALLXW = 235 {PERQ} %consthalfinteger LVRD = 98 {PERQ} %RECORDFORMAT CALLFM(%BYTEINTEGER SEG,OP,RT,SR) {PERQ} %RECORD(CALLFM) CALL {PERQ {PERQ} DISP=DISP+512 {PERQ} COPY(4,FBASE,DISP,ADDR(CALL),0) {PERQ} %IF CALL_OP = CALLXW %or CALL_OP = LVRD %START {PERQ} CALL_SEG=MODUSED(MODINDEX(RID)) {PERQ} CALL_SR=0 {PERQ} CALL_RT = RNO(RID) {PERQ} %FINISH %ELSESTART {PERQ} %IF CALL_OP = CALLXB %START {PERQ} CALL_SEG=MODUSED(MODINDEX(RID)) {PERQ} CALL_SR = RNO(RID) {PERQ} %FINISHELSESTART {PERQ} PRINTSTRING(" {PERQ}BAD XREF ".RNAMES(RID)." pointing at") {PERQ} WRITE(DISP-(512+redtapelen),1) {PERQ} NEWLINE {PERQ} %RETURN {PERQ} %FINISH {PERQ} %FINISH {PERQ} COPY(4,ADDR(CALL),0,FBASE,DISP) {PERQ} %END %routine spxhalf(%halfinteger n) %constbyteintegerarray hx(0:15)='0','1','2','3','4','5','6','7','8', '9','A','B','C','D','E','F' %halfinteger i,j space %cycle i=12,-4,0 printsymbol(hx((n>>i)&15)) %repeat %end %ROUTINE SPHEX(%INTEGER N) SPACE PHEX(N) %END %ROUTINE ROUND TO BLOCK BOUNDARY {EMAS L = ((L + 479)&X'FFFFFE00')+EHEAD {PERQ} L = (L +255)&X'FFFFFF00' %END %ROUTINE PLACE8(%STRING(255) S, %INTEGER AD) %STRING(255) T T=S T=T." " %WHILE LENGTH(T)<8 {EMAS MOVE(8,ADDR(T)+1,AD) {PERQ} COPY(8,ADDR(T),1,AD,0) %END %INTEGERFN WSQWRITE(%INTEGER N) {EMAS %RESULT = N {PERQ} %RESULT=ADDR(BUF(((TON-TBASE)&X'FF'))) %END %ROUTINE FAIL(%STRING(255) S) SELECTOUTPUT(0) {EMAS COMREG(24)=1 ; ! CAUSE COMPILATION TO FAIL PRINTSTRING(S) %MONITOR %STOP %END %ROUTINE CHECKWORK(%INTEGER N) {PERQ} %HALFINTEGER I %IF TON+(N>>SYS) > TMAX %THEN %START {EMAS %IF WORKMAX > X'40000' %THEN %START {EMAS INTEGER(TON) = (WORKAD+X'40000'-TON)!X'19000000' {EMAS ! TYPE/SIZE OF FILLER RECORD {EMAS !THIS MAKES A PSEUDO RECORD TYPE 25 TO BE SKIPPED {EMAS TMAX = WORKAD+WORKMAX-64 {EMAS TON = WORKAD+X'40000' {EMAS WORKMAX = 0 {EMAS %FINISH %ELSE FAIL("Work file too small") {PERQ} HALFINTEGER(WSQWRITE(TON))=1 {PERQ} WRITEBLOCK(WORKID,(TON-TBASE)>>8,ADDR(BUF(0))) { HERE IS WHERE SEQ. WRITES IN FIRST PASS ARE DONE} {PERQ} NUMWORKBLOCKS=NUMWORKBLOCKS+1 {PERQ} BUF(I)=0 %FOR I=0,1,255 {PERQ} TON=((TON>>8)+1)<<8 {PERQ} TMAX = TON+250 %FINISH %END; ! CHECKWORK !**************** !* START HERE * !**************** {TRACEING} %IF TRACE#0 %START {TRACEING} NEWLINE {TRACEING} PRINTSTRING("LPUT(") {TRACEING} WRITE(TYPE,1) {TRACEING} SPHEX(P1) {TRACEING} SPHEX(P2) {TRACEING} SPHEX(P3) {TRACEING} PRINTSTRING(")") {TRACEING} %IF 41<=TYPE<=TYPE+MAXAREAS %START {TRACEING} SPHEX(INTEGER(P3)) {TRACEING} %FINISH {TRACEING} %IF TYPE=11 %OR TYPE=12 %or type = 16 %THEN PRINTSTRING(" - ".STRING(P3)) {TRACEING} %IF TYPE=7 %START {TRACEING} NEWLINE {TRACEING} I=0 {TRACEING} SPHEX(INTEGER(P3+I)) %AND I=I+(4>>SYS) %WHILE P1>I {TRACEING} %FINISH {TRACEING} %IF TYPE=11 %THEN %START {TRACEING} spxhalf(HALFINTEGER(P2+(I>>SYS))) %FOR I=0,(2>>SYS),(22>>SYS) {TRACEING} NEWLINE {TRACEING} %FINISH {TRACEING} %FINISH {EMAS %RETURN %UNLESS NULLFLAG=0 %IF TYPE>100 %THEN ->AREAFRAG -> EP(TYPE) !! EP(*): PRINTSTRING(" Unsupported LPUT entry ") WRITE(TYPE,1) NEWLINE %RETURN !! !-------------------------------------- ! INITIALISING CALLS ON QPUT !-------------------------------------- EP(0): ;! SECOND CALL FROM COMPILER ! P1 = language {0=pas,1=for,2=imp} ! P2 = release number (addr string if >100) ! P3 = version number LANGUAGE = P1 %if P2>100 %then rels=string(P2) {EMAS LANGUAGE=2 %IF LANGUAGE=0 {EMAS IMP SETS ZERO NOT 2} {EMAS TRACE=COMREG(26) {EMAS ROOT = SPAR(1) {EMAS FILE <- STRING(COMREG(52)) {EMAS %IF FILE = ".NULL" %THEN %START {EMAS NULLFLAG = 1 {EMAS %RETURN {EMAS %FINISH {EMAS WORKAD = COMREG(14) {PERQ} workad = 0 TBASE = WORKAD+EHEAD {EMAS WORKMAX = INTEGER(WORKAD+8); !SIZE OF WORK FILE {EMAS TMAX = WORKMAX {EMAS %IF TMAX > X'40000' %THEN TMAX = X'40000' {EMAS TMAX = WORKAD+TMAX-64 {PERQ} TMAX = TBASE+250 TON = TBASE %RETURN !* {PERQ}EP(1): ;! FIRST CALL FROM COMPILER {PERQ {PERQ} ;! P1 = (FILE ID OF WORKFILE <<16) ! FILE ID OF OBJECT {PERQ} ;! P2 = TRACEING CONTROL {PERQ} ;! P3 = ADDR OF SOURCE FILE STRING {PERQ {PERQ} FILE = STRING(P3) {PERQ} root = file {PERQ} i=0 %while root -> rest.(">").root {PERQ} %if root -> root.(".").rest %then i=0 {PERQ} WORKID = P1>>16 {PERQ} OBJID = P1 &X'FFFF' {PERQ} TRACE = P2 {PERQ} %RETURN !-------------------------------------------------- ! REMEMBER AREA FRAGMENTS !-------------------------------------------------- EP(40): EP(41): EP(42): EP(43): EP(44): EP(45): EP(46): CHECKWORK(P1&X'FFFF'+16) R0 == RECORD(WSQWRITE(TON)) R0_LA = P2 I = (P1&X'FFFF'+19)&X'FFFFFFFC' R0_TYPE = TYPE R0_RECLEN=I R0_DATALEN = P1&X'FFFF' R0_FILLER = P1>>16; ! NO. OF COPIES {EMAS MOVE(P1&X'FFFF',P3,TON+16) {PERQ} ad = addr(buf((TON+8-tbase)&x'ff')) {PERQ} inc = ad&1 ; ad = ad&(-2) {PERQ} copy(p1&x'ffff',p3,0,ad,inc) TON = TON+(I>>SYS) %RETURN !----------------------------------- ! ENTRY POINT DEFINITION !----------------------------------- ! P1 = (mainep<<31)!(props<<16)!rtno ! P2 = Address of data area containing: ! 8 word routine dictionary entry ! 1 word byte disp. codestart to diag entry ! 1 word spare ! 2 word virtual address of routine parameter desc. ! P3 = Address of string containing routine name. EP(11): %IF P1< 0 %THEN MAINEP = 1; ! EXISTENCE OF MAIN EP IF TOP BIT SET J = INTEGER(P2+(20>>SYS)) ;! GET ADDRESS OF DESCRIPTOR %IF J=0 %THEN INC=0 %ELSE INC=BYTEINTEGER(J)+1 CHECKWORK(64+INC) ; ! ADD LENGTH OF ROUTINE PARAMETER DESCRIPTOR R11 == RECORD(WSQWRITE(TON)) R11_NAME=STRING(P3) {EMAS %IF R11_NAME ->("S#").R11_NAME %THEN I=0 ;! FORTRAN DOES NOT GENERATE S# I = (LENGTH(R11_NAME)+36)&X'FC' LMAX = LMAX + (I-24) R11_TYPE=11 R11_RECLEN=I {EMAS R11_PROPS = P1>>16 {PERQ} R11_PROPS = HALFINTEGER(ADDR(P1)+1) {EMAS R11_RTNO = P1&X'FFFF' {PERQ} R11_RTNO = HALFINTEGER(ADDR(P1)) %if r11_rtno>maxrt %then maxrt=r11_rtno R11_D <- RECORD(P2) R11_DIAGDISP = HALFINTEGER(P2+(16>>SYS)) %IF J=0 %THEN R11_PLEN=0 %ELSESTART ;! IGNORE IF ADDRESS IS ZERO {EMAS MOVE(INC,J,ADDR(R11)+I) {PERQ} COPY(INC,J,0,ADDR(R11)+(I>>1),0) INC = (INC+3)>>2<<2 I= I + (INC>>SYS) %FINISH TON = TON +(I>>SYS) %RETURN !---------------------------- ! SYSTEM REFERENCES !---------------------------- ! P1 = Address of parameter descriptor *new* ! P2 = Byte offset codestart to call instruction opcode. ! P3 = Address of string containing routine name. EP(12): CHECKWORK(44) XREF = STRING(P3) {EMAS %IF XREF -> ("S#").XREF %THEN I=0 %CYCLE I=0,1,RCOUNT %IF XREF=RNAMES(I) %START R1 == record(wsqwrite(TON)) R1_TYPE = 12 R1_RECLEN = 16 R1_N = P2 {remember offset of call instr} LMAX = LMAX + 16 TON = TON + (16>>sys) R1_RID=I MODUSED(MODINDEX(R1_RID))=1 RTUSED(i) = 1 %RETURN %FINISH %REPEAT printstring(" Warning - Unknown system reference ".xref) %RETURN !------------------------------- ! USER EXTERNAL REFERENCE !------------------------------- ! P1 = Address of Parameter descriptor ! P2 = Byte offset codestart to call instruction opcode. ! P3 = Address of string containing routine name EP(5): UNSATREFS=UNSATREFS+1 INC = (byteinteger(P1)+3)>>1<<1 {length of descriptor} I = (length(string(P3))+19)>>1<<1 {length of rest of R1} CHECKWORK(I+INC) R1 == record(WSQWRITE(TON)) R1_TYPE = 5 R1_RECLEN=I+INC {Total length of entry} LMAX = LMAX + R1_RECLEN R1_N = P2 {Offset to call instr from codestart} R1_NAME = string(P3) R1_RID = I {Offset to descriptor within R1} TON = TON + (I>>sys) {TON = start point for descriptor} {PERQ} COPY(INC,P1,0,TON,0) {EMAS MOVE(INC,P1,TON) TON = TON + (INC>>sys) %return !---------------------- ! AREA FRAGMENT !---------------------- ! P1 = (repition <<16 ) ! length in bytes ! P2 = displacement in BYTES ! P3 = ADDRESS OF STRING (NAME OF AREA) AREAFRAG: M = P1&X'FFFF' CHECKWORK(M+24) R9 == RECORD(WSQWRITE(TON)) R9_LA=P2 I = (M+27)&X'FFFC' R9_TYPE=6 R9_iin = TYPE R9_RECLEN=I R9_DATALEN=M R9_FILLER=P1>>16 {EMAS MOVE(M,P3,TON+24) {PERQ} AD = ADDR(BUF((TON+12-TBASE)&X'FF')) {PERQ} INC = AD&1 ; AD = AD&(-2) {PERQ} COPY(M,P3,0,AD,INC) TON = TON + (I>>SYS) %RETURN !-------------------------------- ! COMMON DEFINITIONS !-------------------------------- EP(16): CHECKWORK(52) R4 == RECORD(WSQWRITE(TON)) R4_NAME=STRING(P3) R4_L=P2 R4_PROPS=P1&X'FFFF' R4_AREA = P1>>16 I = (LENGTH(R4_NAME)+19)&X'FC' LMAX = LMAX+I R4_TYPE = 16 R4_RECLEN = I TON = TON + (I>>SYS) %RETURN {EMAS !--------------------------------- {EMAS ! REVERSE BYTES {EMAS !--------------------------------- {EMAS {EMAS EP(9): {EMAS {EMAS !P1 = AREA ID {EMAS !P2 = DISP {EMAS !P3 = LENGTH ( IN BYTES) {EMAS {EMAS CHECKWORK(20) {EMAS R10 == RECORD(WSQWRITE(TON)) {EMAS R10_TYPE=9 {EMAS R10_RECLEN=20 {EMAS R10_AREA=P1 {EMAS R10_DISP=P2 {EMAS R10_LEN=P3 {EMAS TON=TON+(20>>SYS) {EMAS %RETURN !------------------------------------------------ ! MODIFY 16 BIT ADDRESS FIELD IN AN INSTRUCTION !------------------------------------------------ EP(18): ! P2 @ IN CODE AREA ! P3 unsigned 16 BIT VALUE TO BE ADDED TO ADDRESS FIELD CHECKWORK(16) R8 == RECORD(WSQWRITE(TON)) R8_TYPE = 18 R8_RECLEN=16 R8_CODEADDR = P2 R8_ADDRFIELD = p3&X'FFFF' TON = TON+(16>>SYS) %RETURN !* !---------------------------------------- ! RELOCATION !---------------------------------------- EP(20): ! 16 BIT RELOCS OF WORD AT P2 BYTES IN GLA BY GLA BASE EP(19): ! 32 BIT RELOCATION OF WORD AT P2 IN GLA BY BASE OF AREA P3 ! CHECKWORK(16) R7 == RECORD(WSQWRITE(TON)) R7_TYPE=TYPE R7_RECLEN=16 R7_AREALOC = P2>>1 %IF TYPE=20 %THEN R7_BASE=2 %ELSEC R7_BASE=P3 TON = TON+(16>>SYS) %IF TYPE=19 %THEN TYPE19NUM=TYPE19NUM+1 %IF TYPE=20 %THEN TYPE20NUM=TYPE20NUM+1 LMAX=LMAX+16 %RETURN !* !--------------------------------------- ! NOTE CODE SECTION FOR DECODE !--------------------------------------- EP(27): !* P1 >0 line no !* 2 = len<<18 ! start !* CHECKWORK(12) R27==RECORD(WSQWRITE(TON)) %IF DECODEHEAD=0 %THEN DECODEHEAD=TON %ELSE INTEGER(WSQWRITE(DECODETAIL)+(4>>SYS))=TON DECODETAIL=TON R27_TYPE=27 R27_RECLEN=16 R27_LINK=0 R27_LINE=P1 R27_INF=P2 TON=TON+(12>>SYS) %RETURN !* !----------------------------------------------------------- ! EP(7 OR 8) END OF FIRST PASS !------------------------------------------------------------ { ACCESS TO WORKFILE HAS BEEN SEQUENTIAL WRITES UP TO THIS POINT } EP(7): %BEGIN %INTEGERARRAYFORMAT BASEFM(1:MAXAREAS) %INTEGERARRAYNAME BASE BASE == ARRAY(P3,BASEFM) HALFINTEGER(WSQWRITE(TON)) = 7 {PERQ}TON = TON + 1 CHECKWORK(512) ;! FLUSH FINAL WORK BUFFER {PERQ}CLOSE FILE(WORKID,NUMWORKBLOCKS,4096) { NOT ESSENTIAL } J = (P1-4)//4 ; %IF J>MAXAREAS %THEN J=MAXAREAS AREALENGTH(I) = (BASE(I)+3)&X'FFFFFFFC' %FOR I=1,1,J %END {PERQ} %RETURN { EMAS FALLS THROUGH TO ENTRY(8) EP(8): ! END OF FILE {EMAS %IF NULLFLAG < 0 %THEN SSERR(228); !PROGRAM TOO LARGE OBJLEN = LMAX+16 + 6000 OBJLEN = OBJLEN+AREALENGTH(I) %FOR I=1,1,MAXAREAS {EMAS OUTFILE(FILE,OBJLEN,0,0,FBASE,FLAG) {EMAS %IF FLAG # 0 %THEN %START {EMAS COMREG(24) = FLAG; ! To give 'Compilation faulty' {EMAS SELECTOUTPUT(0) {EMAS SETFNAME(FILE) {EMAS PRINTSTRING("Create object file fails - ".FAILUREMESSAGE(FLAG)) {EMAS COMREG(47) = 0; ! Overwrite 'no of statements' left by compiler {EMAS %STOP {EMAS %FINISH {PERQ} NUMOBJBLOCKS = (OBJLEN+511)>>9 {PERQ} NEWSEG(ADDR(FBASE)+1,NUMOBJBLOCKS,1,NUMOBJBLOCKS) {PERQ} HALFINTEGER(J)=0 %FOR J=FBASE,1,FBASE+(NUMOBJBLOCKS*256)-1 CODEBASE = ((HDRLEN+REDTAPELEN)>>SYS)+FBASE AREASTART(1) = HDRLEN+REDTAPELEN ;! 32 FOR EMAS}HEADER PLUS 256 WORDS FOR PERQ HEADER + ? FOR RED TAPE AREASTART(4) = AREASTART(1)+AREALENGTH(1); ! CST AFTER CODE AREASTART(3) = AREASTART(4)+AREALENGTH(4) AREASTART(2) = AREASTART(3)+AREALENGTH(3); ! GLA AFTER SST AREASTART(5) = AREASTART(2)+AREALENGTH(2); ! GLAST AFTER GLA AREASTART(6) = AREASTART(5)+AREALENGTH(5) LDSTART =(AREASTART(6)+AREALENGTH(6)+ 3)&X'FFFFFFFC' {EMAS OBJECT == ARRAY(FBASE + EHEAD,MAXBYTEFM) LDSTART = (LDSTART>>SYS) + FBASE LDATA == ARRAY(LDSTART,LDATAFM) {EMAS INTEGER(FBASE+4) = EHEAD; ! START OF CODE {EMAS INTEGER(FBASE+12) = 1; ! OBJECT FILE CODE {EMAS INTEGER(FBASE+24) = LDSTART-FBASE; ! START OF LDATA LDATA(I) = 0 %FOR I=1,1,10 TON = TBASE {EMAS LDDISP = 60 {PERQ} LDDISP = 11 { CREATE WORK SEGMENT } {PERQ} TBASE = 0 {PERQ} WSEGMAX = NUMWORKBLOCKS {PERQ} WSEGMAX = 128 %if WSEGMAX>128 {enforce 64k segment size limit} {PERQ} NEWSEG(addr(TBASE)+1,WSEGSIZE,WSEGINC,WSEGMAX) {PERQ} wptr = TBASE ! ASSIGN SEGMENT NUMBERS TO IMPORTED MODULES NUMIMPS=0 %CYCLE I=0,1,MODCOUNT {EMAS %IF MODUSED(I)#X'FFFF' %START {PERQ} %IF MODUSED(I)>=0 %START MODUSED(I)=NUMIMPS+1 NUMIMPS=NUMIMPS+1 %FINISH %REPEAT !----------------------------------------------------- ! The next section reads back through the work file !----------------------------------------------------- ! Ton is the pointer to the work file which contains area frags and red tape ! {PERQ}Wptr is a pointer to the work segment containing only red tape. {PERQ} wblock = 0 {PERQ} ->LSW(1) {EMAS -> LSWITCH LSW(40): {Area Fragments} LSW(41): LSW(42): LSW(43): LSW(44): LSW(45): LSW(46): R0 == RECORD(TON) J = R0_FILLER; ! NO. OF COPIES L = R0_DATALEN LA = R0_LA K = AREASTART(I-40)+R0_LA ;! TARGET DISP %WHILE J >= 0 %CYCLE {EMAS MOVE(L,TON+16,FBASE+K) {PERQ} COPY(L,TON+8,0,FBASE +(K>>1),K&1) K = K+L J = J-1 %REPEAT -> NEXT LSW(*): FAIL("CORRUPT WORKFILE ") {PERQ} LSW(1): ;! END OF BLOCK {PERQ} TON = Addr(BUF(0)) {PERQ} READBLOCK(workid,wblock,TON) {PERQ} wblock = wblock + 1 {PERQ} ->LSWITCH LSW(5): { Take Red tape here} LSW(6): LSW(11): LSW(12): LSW(18): LSW(14): LSW(9): LSW(19): LSW(20): LSW(16): r1 == record(TON) r1_link = HEAD(i) {PERQ} head(i) = wptr {EMAS HEAD(i) = TON {PERQ} %if WPTR+(R1_RECLEN>>sys)>TBASE+(WSEGSIZE*(512>>SYS)) %start ;! need to extend work segment {PERQ} %if WSEGSIZE=WSEGMAX %then FAIL("Work segment full") {PERQ} EXTENDSEG(halfinteger(addr(TBASE)+1),WSEGINC) {PERQ} WSEGSIZE = WSEGSIZE + WSEGINC {PERQ} %finish {PERQ} COPY(r1_reclen,TON,0,WPTR,0) TON = TON + (r1_reclen>>sys) {PERQ} WPTR = WPTR + (r1_reclen>>1) ->lswitch NEXT: TON = TON + (HALFINTEGER(TON+(2>>SYS))>>SYS) LSWITCH: I = HALFINTEGER(TON) -> LSW(I) LSW(7): {EMAS CHANGECONTEXT; !FINISHED WITH COMPILER - LOSE FROM WORKING SET -> NEXT %UNLESS HALFINTEGER(TON) = 7 L = LDSTART+LDDISP; ! SPACE FOR LISTHEADS+OBJDATA !----------------------------------------------- ! FORM LIST 1 - PROCEDURE ENTRIES !----------------------------------------------- J = HEAD(11) %WHILE J # 0 %CYCLE R11 == RECORD(J) L1 == RECORD(L) L1_LINK = LDATA(1) LDATA(1) = (L-LDSTART)>>NOTSYS L1_PROPS = R11_PROPS L1_RTNO = R11_RTNO L1_DIAGDISP = R11_DIAGDISP L1_NAME = R11_NAME {EMAS REVERSE(ADDR(L1_NAME),(LENGTH(L1_NAME)+2)>>1) INC =(10+LENGTH(R11_NAME))&X'FFFFFFFE' L = L + (INC>>SYS) J = R11_LINK %REPEAT !--------------------------------------- ! FORM LIST 2 - EXTERNAL REFERENCES !--------------------------------------- J = HEAD(12) %WHILE J # 0 %CYCLE L2 == RECORD(L) R1 == RECORD(J) %unless R1_RID<0 %start ;! <0 = in PRE-LINK block, otherwise sys ref. %if rtused(r1_rid)#0 %start L2_LINK=LDATA(2) LDATA(2)=(L-LDSTART)>>NOTSYS L2_rt =rno(r1_rid) L2_NAME = RNAMES(R1_RID) INC = (6+LENGTH(L2_NAME))&X'FFFFFFFE' L = L + (INC>>SYS) {EMAS REVERSE(ADDR(L2_NAME),(LENGTH(L2_NAME)+2)>>1) rtused(r1_rid)=0 %finish FIX(R1_RID,REDTAPELEN+R1_N) ;! RELOCATE CALLS ON XREFS %finish J = R1_LINK %REPEAT !* !---------------------------------------- ! MODIFY ADDRESSES IN CODE !----------------------------------------- J = HEAD(18) %WHILE J # 0 %CYCLE R8 == RECORD(J) K=R8_CODEADDR j = areastart(1)+k LI=FBASE+(j>>SYS) {EMAS HALFINTEGER(LI)=HALFINTEGER(LI)+R8_ADDRFIELD {PERQ} COPY(2,LI,j&1,ADDR(M),0) {PERQ} M = M + R8_ADDRFIELD {PERQ} COPY(2,ADDR(M),0,LI,j&1) J = R8_LINK %REPEAT { FINISHED CONSTRUCTION OF AREAS NOW ON PERQ} !------------------------------------- ! PRODUCE DECODE LISTING !------------------------------------- %WHILE DECODEHEAD#0 %CYCLE R27==RECORD(DECODEHEAD) I=R27_LINE J=R27_INF>>18;! length K=(R27_INF<<14)>>14;! address PRINTSTRING(" LINE ") WRITE(I,1) NEWLINE QCODE(FBASE+EHEAD+K,FBASE+EHEAD+K+J,K,X'F0000000') DECODEHEAD=R27_LINK %REPEAT !-------------------------------------------- ! FORM LIST 6 - COMMON DEFINITIONS !-------------------------------------------- J=HEAD(16) %WHILE J#0 %CYCLE R4==RECORD(J) L6==RECORD(L) L6_LINK = LDATA(6) LDATA(6)=(L-LDSTART)>>NOTSYS L6_AREA NO =R4_AREA L6_PROPS=R4_PROPS {EMAS L6_LENGTH=((R4_L&X'FFFF')<<16)!(R4_L>>16) {PERQ} L6_LENGTH=R4_L L6_NAME = R4_NAME {EMAS REVERSE(ADDR(l6_NAME),(LENGTH(l6_NAME)+2)>>1) INC = ( 12 + LENGTH(R4_NAME) ) &X'FFFFFFFE' L = L + (INC>>SYS) J = R4_LINK %REPEAT {EMAS !--------------------------------------------- {EMAS ! REVERSE BYTES SPECIFICALLY REQUESTED {EMAS !---------------------------------------------- {EMAS {EMAS J = HEAD(9) {EMAS %WHILE J # 0 %CYCLE {EMAS R10 == RECORD(J) {EMAS LI = FBASE+AREASTART(R10_AREA)+R10_DISP {EMAS REVERSE(LI,(R10_LEN+1)>>1) {EMAS J = R10_LINK {EMAS %REPEAT !* !------------------------------------------- ! FORM LIST 7 - AREA FRAGMENTS !------------------------------------------- J=HEAD(6) %WHILE J#0 %CYCLE R9 == RECORD(J) L7 == RECORD(L) L7_LINK=LDATA(7) LDATA(7)=(L-LDSTART)>>NOTSYS L7_AREA=r9_iin-100 {EMAS L7_disp = (R9_la>>16)!((r9_la&x'ffff')<<16) {PERQ} L7_DISP=R9_LA L7_COPIES=R9_FILLER L7_LEN=R9_DATALEN {EMAS MOVE(R9_DATALEN,J+24,L+12) {PERQ} COPY(R9_DATALEN,J,24,L,12) L = L + ((12+R9_DATALEN+1)>>1<>NOTSYS L9 == RECORD(L) L9_LINK = 0 L9_NUM = TYPE19NUM %CYCLE I=1,1,TYPE19NUM R7 == RECORD(J) L9_FIX(I)_DISP = R7_AREALOC L9_FIX(I)_AREA = R7_BASE J = R7_LINK %REPEAT L = L + ((4 + (TYPE19NUM*4))>>SYS) %FINISH !------------------------------------------- ! LIST 8 - 16 BIT RELOCATIONS !------------------------------------------- J = HEAD(20) %IF J # 0 %START LDATA(8) = (L-LDSTART)>>NOTSYS L8 == RECORD(L) L8_LINK = 0 L8_NUM = TYPE20NUM %CYCLE I=1,1,TYPE20NUM R7 == RECORD(J) L8_DISP(I)=R7_AREALOC J = R7_LINK %REPEAT L = L + ((4 + (TYPE20NUM*2))>>SYS) %FINISH !------------------------------------- ! LIST 10 - POINTER TO ROOT FILENAME !--------------------------------------- {EMAS L=(L+1)&X'FFFFFFFE' LDATA(10) = (L-LDSTART)>>NOTSYS {PERQ} COPY(LENGTH(file)+1,ADDR(file),0,L,0) {EMAS STRING(L) = root {EMAS REVERSE(L,(LENGTH(ROOT)+2)>>1) {PERQ} INC = (LENGTH(FILE)+1)&X'FFFFFFFE' {EMAS INC = ( LENGTH(ROOT)+3)&X'FFFFFFFC' L = L + (INC>>SYS) {TRACEING} %IF TRACE#0 %START {TRACEING} NEWLINE {TRACEING} PRINTSTRING("LMAX:") {TRACEING} WRITE(LMAX,1) {TRACEING} WRITE(L-LDSTART,1) {TRACEING} NEWLINE {TRACEING} %FINISH !* !-------------------------------------------------------- ! FORM AREA SUMMARY ( OBJECT FILE MAP ) !--------------------------------------------------------- {EMAS L = (L+3)&(-4) {EMAS INTEGER(FBASE+28) = L-FBASE AMAP == ARRAY(L,AMAPFM) %CYCLE M = 1,1,MAXAREAS AMAP(M)_START = (AREASTART(M)-HDRLEN)>>1 AMAP(M)_PROPS = AREAPROP(M) {EMAS J = AREALENGTH(M)>>1 {EMAS AMAP(M)_LEN = ((J&X'FFFF')<<16)!(J>>16) {PERQ} AMAP(M)_LEN = AREALENGTH(M)>>1 L = L+(8>>SYS) %REPEAT !------------------------------------------------------- ! FILL IN ROUTINE DICTIONARY !---------------------------------------------------- J = HEAD(11) {EMAS L = (L+7)&X'FFFFFFF8' { ROUND TO QUAD WORD BOUNDARY } {PERQ} L = (L+3)&X'FFFFFFFC' DICTIONARY == ARRAY(L,DICTAFM) %WHILE J#0 %CYCLE R11 == RECORD(J) DICT == DICTIONARY(R11_RTNO) DICT = R11_D DICT_LL = DICT_LL+1 DICT_ENTRY = DICT_ENTRY + REDTAPELEN DICT_EXIT = DICT_EXIT + REDTAPELEN J = R11_LINK %REPEAT L = L + ((16>>SYS)*(maxrt+1)) %if l-fbase>(64*1024) %then fail("Object file too large") ! !------------------------------------------ ! FILL IN CODESTART !---------------------------------------- ! AD = CODEBASE-(REDTAPELEN>>SYS) CH == RECORD(AD) I = (ADDR(DICTIONARY(0))-AD) CH_DICT = I>>NOTSYS %if mainep#0 %then ch_rts=maxrt+1 %elsec ch_rts=maxrt CH_LDATA = (LDSTART-AD)>>NOTSYS CH_MAP = (ADDR(AMAP(1))-AD)>>NOTSYS LDATA(0)=10 !----------------------------------------------- {EMAS REVERSE(AREASTART(1)+FBASE+REDTAPELEN,(AREALENGTH(1)>>1)-2) ;! RE-ORDER WORK SEGMENT BYTES !--------------------------------------------------------------------------- ! FILL IN PERQ HEADER !-------------------------------------------------------------------------- ROUND TO BLOCK BOUNDARY H == RECORD(FBASE+EHEAD) H_FLAGS=MAINEP ;! 1 IF PROGRAM , 0 IF MODULE H_QVERSION = 3 !{EMAS REVERSE(ADDR(H_FLAGS),1) {EMAS PLACE8(FILE,ADDR(H_MODULE(0))) ;! TAKE FIRST EIGHT CHARS OF OBJECT FILE NAME !{PERQ} PLACE8("FRED ",FBASE+1) {PERQ} PLACE8(ROOT,FBASE+1) ! AS PERQ MODULE NAME {EMAS H_SOURCEFILE="EMAS:".UINFS(1).">".ROOT {EMAS %IF COMREG(27)&X'00010000'#0 %THEN H_SOURCEFILE=H_SOURCEFILE.".OPT" {PERQ} H_SOURCEFILE=FILE {EMAS REVERSE(ADDR(H)+(2>>SYS),54) H_NUMIMPS = NUMIMPS H_IMPBLOCK = ((L-FBASE)>>(9-SYS)) ;! BLOCK NUMBER OF IMPORT BLOCK H_GDSIZE = (AREALENGTH(2)+AREALENGTH(5)+1)//2 %if language=1 %then h_version="Fortran77 compiler - Release " %elsec h_version = "Imp compiler - Release " h_version = h_version.rels {should get itos in here and use ep(0 P2,P3} {EMAS H_copyright="COPYRIGHT - University of Edinburgh" {PERQ} H_copyright="" H_COPYRIGHT=H_COPYRIGHT." " %WHILE LENGTH(H_COPYRIGHT)<80 ;! TEMP {EMAS REVERSE(ADDR(H_VERSION),80) H_LANGUAGE=language !----------------------------- ! FILL IN IMPORT TABLE !----------------------------- %BEGIN %INTEGER J,AD %STRING(8) S %STRING(100) PATH %INTEGERARRAY E(0:255) AD = L %CYCLE I=0,1,MODCOUNT {EMAS %CONTINUE %IF MODUSED(I)=X'FFFF' {PERQ} %CONTINUE %IF MODUSED(I)<0 PATH = MODULES(I) PLACE8(PATH,L) PATH = PATH.".PAS" {EMAS MOVE(LENGTH(PATH)+1,ADDR(PATH),L+8) {PERQ} COPY(LENGTH(PATH)+1,ADDR(PATH),0,L+4,0) L = L+(110>>SYS) %REPEAT !------------------------------------ ! FILL IN ROUTINE NAME TABLE !------------------------------------ { IMMEDIATELY AFTER IMPORT TABLE IN SAME BLOCK} J = HEAD(11) %WHILE J#0 %CYCLE R11 == RECORD(J) PLACE8(R11_NAME,L + (R11_RTNO*(8>>SYS))) J = R11_LINK %REPEAT S = "F_NULL " %IF MAINEP=0 %THEN PLACE8(S,L) L = L + ((maxrt+1)*(8>>SYS)) {EMAS REVERSE(AD,(L-AD)>>1) ;! RE-ORDER IMPORT BLOCK BYTES !------------------------------------------ ! DIAGNOSTIC BLOCKS !------------------------------------------ ! THESE ARE IN QCODE FOR NOW H_DIAGBLOCK = 0 !------------------------------------------ ! CREATE ROUTINE DESCRIPTOR BLOCKS !------------------------------------------ { GENERATING TEST DATA ONLY - *NOT* FINISHED } E(I)=0 %FOR I=0,1,255 J=HEAD(11) %WHILE J#0 %CYCLE R11==RECORD(J) E(R11_RTNO)=ADDR(R11) J=R11_LINK %REPEAT language=0 {temp} %IF LANGUAGE = FORTRAN %START ROUND TO BLOCK BOUNDARY H_ROUTDESCBLOCK = (L-FBASE)>>(9-SYS) HALFINTEGER(L) = 1 ;! FIRST ENTRY FOR RT0 IS FIXED L=L+(2>>SYS) I=1 %WHILE I<=MAXRT %CYCLE %IF E(I)=0 %THEN FAIL("NON-CONTIGUOUS ROUTINES") R11==RECORD(E(I)) %UNLESS R11_RTNO=0 %START ;! IGNORE RT0 RECORD %IF R11_PLEN#0 %START {PERQ} COPY(LENGTH(R11_NAME)+1,ADDR(R11_NAME),0,L,0) {EMAS REVERSE(L,(LENGTH(R11_NAME)+2)//2) L=L+(((LENGTH(R11_NAME)+2)//2)*(2>>SYS)) %FINISH %FINISH I=I+1 %REPEAT %FINISH %END !------------------------------------------- ! CREATE UNRESOLVED REFERENCE BLOCKS !------------------------------------------- { ALSO KNOWN AS PRE-LINK BLOCKS } J = head(5) %IF J > 0 %START ROUND TO BLOCK BOUNDARY H_PRELINKBLOCK = (L-FBASE)>>(9-SYS) HALFINTEGER(L) = UNSATREFS ; L = L + (2>>SYS) { FILL IN NUMBER OF REFS } %WHILE J#0 %CYCLE R1 == RECORD(J) PLB == RECORD(L) PLB_BLOCK = ((R1_N+REDTAPELEN)>>(9-SYS))+1 PLB_BYTE OFFSET = (R1_N+REDTAPELEN)-((PLB_BLOCK-1)*512) PLACE8(R1_NAME,ADDR(PLB_NAME(0))) {EMAS REVERSE(ADDR(PLB_NAME(0)),4) ! SET RT DEC DESC == string(J+R1_rid) {EMAS MOVE(LENGTH(DESC)+1,ADDR(DESC),ADDR(PLB_ROUTDESC(0))) {PERQ} COPY(LENGTH(DESC)+1,ADDR(DESC),0,ADDR(PLB_ROUTDESC(0)),0) {EMAS REVERSE(ADDR(PLB_ROUTDESC(0)),(LENGTH(DESC)+2)>>1) L = L + (((12+(LENGTH(R1_NAME)+2))>>1)*(2>>SYS)) J = R1_LINK %REPEAT %FINISHELSE H_PRELINKBLOCK=0 { WRITE OUT OBJECT FILE } {PERQ} LI = FBASE {PERQ} NUMOBJBLOCKS = (L-FBASE+((512>>SYS)-1))>>(9-SYS) {PERQ} %if trace#0 %start {PERQ} NEWLINE {PERQ} PRINTSTRING(" NUMBER OF OBJECT BLOCKS = ") ; WRITE(NUMOBJBLOCKS,1) {PERQ} %finish {PERQ} WRITEBLOCK(OBJID,M,LI) %AND LI=LI+256 %FOR M=0,1,NUMOBJBLOCKS-1 {PERQ} CLOSEFILE(OBJID,NUMOBJBLOCKS,4096) {EMAS INTEGER(FBASE) = L-FBASE { FILL IN FILE LENGTH} %END ;! OF QPUT !* %ENDOFFILE !*