%CONSTINTEGER EMAS=0,PERQ=1,SYS=PERQ %CONSTINTEGER NOTSYS=(SYS+1)&1 !******************************************** !* PERQ LPUT * !******************************************** %ROUTINESPEC QPUT(%INTEGER A,B,C,D) {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) %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 %CYCLE I=AD,2,AD+(LEN*2)-2 {EMAS J=BYTEINTEGER(I) {EMAS BYTEINTEGER(I)=BYTEINTEGER(I+1) {EMAS BYTEINTEGER(I+1)=J {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) %HALFINTEGER FRED %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 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(RF10) %NAME R10 %RECORD(RF27) %NAME R27 !------------------------------------------------ ! 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,CODE OFFSET,%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=18 !* %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" !* %CONSTINTEGER RCOUNT=104 !* %CONSTSTRING(15)%ARRAY RNAMES(0:RCOUNT) = %C "INITMAIN","INITGLA","IOCP","STOP","WRITE", "NEWSEG","EXTENDSEG","DECREFSEG", "READBLOCK","WRITEBLOCK","CLOSEFILE", "GETLINE","INITCOMP","OPENFILE", "NDIAG","SSMESS","QRMESS","QIDIAG","QFDIAG", "F77STOP","F77PAUSE","F77RTERR","F77IOERR","F77CONCAT", "F77COPY","F77INDEX","F77CMULTC","F77CDIVC","F77CEQUC", "F77CNEQC","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", "QCMESS","FAULTNUM", "QPUT", "CODEGEN", "MAP" !* %CONSTBYTEINTEGERARRAY MODINDEX(0:RCOUNT) = %C 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, 11,11, 17, 16, 10 !* %CONSTBYTEINTEGERARRAY RNO(0:RCOUNT) = %C 1,2,3,4,5, 6,7,8, 9,10,11, 12,13,14, 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, 1,2, 1, 1, 1 !----------------------------------------- ! 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=(32*1024)-1 %CONSTINTEGER REDTAPELEN = 4 ;! DISP TO LDATA AND AREA MAP !----------------------------------------- ! OWNS !---------------------------------------- {EMAS %OWNINTEGER WORKMAX {PERQ} %OWNHALFINTEGERARRAY BUF(0:255) %OWNINTEGER WORKAD ! %OWNINTEGER WMAX=0 %OWNHALFINTEGER LMAX=54 %OWNHALFINTEGERARRAY MODUSED(0:MODCOUNT)=-1(*) %OWNINTEGER TBASE, TON, TMAX %OWNINTEGER FBASE %OWNHALFINTEGER NUMIMPS=0 %OWNHALFINTEGER UNSATREFS=0 %OWNHALFINTEGER NUMRTS=0 %OWNHALFINTEGER MAXRT {PERQ} %OWNHALFINTEGER NUMWORKBLOCKS=0 {PERQ} %OWNHALFINTEGER NUMOBJBLOCKS=0 %OWNSTRING(110) ROOT %OWNHALFINTEGER TRACE=0,WORKID=0,OBJID=0 {PERQ} %OWNINTEGER NULLFLAG=0 %OWNINTEGERARRAY HEAD(9 : 25)=0(*) %OWNINTEGERARRAY AREALENGTH(1 : MAXAREAS) %OWNINTEGERARRAY AREASTART(1 : MAXAREAS) %OWNHALFINTEGERARRAY AREAPROP(1 : MAXAREAS) %OWNHALFINTEGER TYPE19NUM=0,TYPE20NUM=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(32) XREF %BYTEINTEGERARRAYFORMAT MAXBYTEFM(0:MAXFSIZE) { MAX IS 32 KBYTES FOR NOW } {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 %HALFINTEGER OPCODE {EMAS {EMAS DISP=DISP+512 {EMAS OPCODE = OBJECT(DISP) {EMAS %IF OPCODE = CALLXW %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,1) {EMAS NEWLINE {EMAS %FINISH {EMAS %FINISH {EMAS %END {PERQ}%ROUTINE FIX(%INTEGER RID,%INTEGER DISP) {PERQ} {PERQ} {PERQ} %CONSTINTEGER CALLXB = 234 {PERQ} %CONSTINTEGER CALLXW = 235 {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 %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,1) {PERQ} NEWLINE {PERQ} %RETURN {PERQ} %FINISH {PERQ} %FINISH {PERQ} COPY(4,ADDR(CALL),0,FBASE,DISP) {PERQ} %END %ROUTINE SPHEX(%INTEGER N) SPACE PHEX(N) %END %ROUTINE ROUND TO BLOCK BOUNDARY {EMAS L = ((L + 479)&X'FFFFFE00')+EHEAD {PERQ} L = (L +239)&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) {EMAS %MONITOR {PERQ} I=I//0 %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} %IF TMAX>=TBASE+MAXFSIZE %THEN FAIL("WORK FILE TOO SMALL") {PERQ} HALFINTEGER(TON)=1 ;! END OF BLOCK FLAG {PERQ} WRITEBLOCK(WORKID,(TON-TBASE)>>8,ADDR(BUF(0))) { HERE IS WHERE SEQ. WRITES IN FIRST PASS ARE DONE} {PERQ} NUMWORKBLOCKS=NUMWORKBLOCKS+1 {PERQ} NEWLINE {PERQ} PRINTSTRING("WRITING OUT WORKFILE BLOCK") ; WRITE(NUMWORKBLOCKS-1,1) {PERQ} NEWLINE {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 %THEN PRINTSTRING(" - ".STRING(P3)) {TRACEING} %IF TYPE=7 %START {TRACEING} NEWLINE {TRACEING} I=0 {TRACEING} SPHEX(INTEGER(P3+(I>>SYS))) %AND I=I+(4>>SYS) %WHILE P1>I {TRACEING} %FINISH {TRACEING} %IF TYPE=11 %THEN %START {TRACEING} SPHEX(HALFINTEGER(P2+(I>>SYS))) %FOR I=0,(4>>SYS),(20>>SYS) {TRACEING} NEWLINE {TRACEING} %FINISH {TRACEING} %FINISH {PERQ} %RETURN %UNLESS NULLFLAG=0 %IF TYPE>100 %THEN ->COMFRAG -> EP(TYPE) !! EP(*): PRINTSTRING(" Unsupported LPUT entry ") WRITE(TYPE,1) NEWLINE %RETURN !! !-------------------------------------- ! INITIALISING CALLS ON QPUT !-------------------------------------- EP(0): ;! SECOND CALL FROM COMPILER LANGUAGE = P1 {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} NEWSEG(ADDR(WORKAD)+1,64,1,64) 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} ! %IF FILE -> ROOT.(".").XREF %THEN XREF="" %ELSE ROOT=FILE {PERQ} ROOT = FILE ; LENGTH(ROOT)=LENGTH(ROOT)-4 {PERQ} WORKID = P1>>16 {PERQ} OBJID = P1 &X'FFFF' {PERQ} TRACE = P2 {PERQ} %RETURN {PERQ} !-------------------------------------------------- ! REMEMBER AREA FRAGMENTS !-------------------------------------------------- EP(40): EP(41): EP(42): EP(43): EP(44): EP(45): EP(46): { ON BIG PERQ PLACE CODE DIRECTLY INTO OBJECT SEGMENT} 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&(-1) {PERQ} copy(p1&x'ffff',p3,0,ad,inc) TON = TON+(I>>SYS) %RETURN !----------------------------------- ! ENTRY POINT DEFINITION !----------------------------------- 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) ! WMAX = WMAX + I R11_TYPE=11 R11_RECLEN=I R11_LINK = HEAD(11) HEAD(11)=TON {EMAS R11_PROPS = P1>>16 {PERQ} R11_PROPS = HALFINTEGER(ADDR(P1)+1) {EMAS R11_RTNO = P1&X'FFFF' {PERQ} R11_RTNO = HALFINTEGER(ADDR(P1)) 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) NUMRTS=NUMRTS+1 %RETURN !---------------------------- ! EXTERNAL REFERENCES !---------------------------- EP(12): CHECKWORK(44) R1 == RECORD(WSQWRITE(TON)) XREF = STRING(P3) {EMAS %IF XREF -> ("S#").XREF %THEN I=0 R1_TYPE = 12 R1_RECLEN=16 LMAX = LMAX+16 ! WMAX = WMAX+16 R1_LINK = HEAD(12) HEAD(12) = TON TON = TON+(16>>SYS) R1_N=P2 ;! REMEMBER OFFSET OF CALL INSTR %CYCLE I=0,1,RCOUNT %IF XREF=RNAMES(I) %START R1_RID=I MODUSED(MODINDEX(R1_RID))=1 %RETURN %FINISH %REPEAT UNSATREFS = UNSATREFS+1 R1_RID=-1 R1_NAME=XREF I=(LENGTH(R1_NAME)+8)//4 R1_TYPE = 12 R1_RECLEN = 16 + (I*4) TON = TON+((I*4)>>SYS) LMAX = LMAX+(I*4) ! WMAX = WMAX+(I*4) %RETURN COMFRAG: %RETURN !-------------------------------- ! COMMON DEFINITIONS !-------------------------------- EP(14): CHECKWORK(48) R4 == RECORD(WSQWRITE(TON)) R4_NAME=STRING(P3) R4_L=P2 R4_PROPS=P1&X'FFFF' R4_AREA = P1>>16 LMAX = LMAX+I ! WMAX = WMAX+I R4_LINK = HEAD(14) I = (LENGTH(R4_NAME)+16)&X'FC' R4_TYPE = 14 R4_RECLEN = I HEAD(14) = TON 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_LINK=HEAD(9) {EMAS HEAD(9)=TON {EMAS R10_AREA=P1 {EMAS R10_DISP=P2 {EMAS R10_LEN=P3 {EMAS TON=TON+(20>>SYS) ! {EMAS WMAX = WMAX+20 {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_LINK = HEAD(18) HEAD(18) = TON R8_CODEADDR = P2 R8_ADDRFIELD = p3&X'FFFF' TON = TON+(16>>SYS) ! WMAX = WMAX+16 %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_LINK=HEAD(TYPE) HEAD(TYPE)=TON 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 ! WMAX=WMAX+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) ! WMAX = WMAX+6 %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 CHECKWORK(512) ;! FLUSH FINAL WORK BUFFER {PERQ} CLOSE FILE(WORKID,NUMWORKBLOCKS,0) { NOT ESSENTIAL } J = (P1-4)//4 ; %IF J>MAXAREAS %THEN J=MAXAREAS AREALENGTH(I) = BASE(I) %FOR I=1,1,J %END {PERQ} %RETURN { EMAS FALLS THROUGH TO ENTRY(8) EP(8): ! END OF FILE {PERQ} %IF NULLFLAG < 0 %THEN SSERR(228); !PROGRAM TOO LARGE OBJLEN = LMAX+16 + 3000 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) {EMAS OBJECT == ARRAY(FBASE + EHEAD,MAXBYTEFM) LDSTART = ((AREASTART(6) + AREALENGTH(6) )>>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 { READ WORK FILE INTO CORE AREA } {PERQ} LI = TBASE {PERQ} %CYCLE M=0,1,NUMWORKBLOCKS-1 {PERQ} READBLOCK(WORKID,M,LI) {PERQ} LI = LI+256 {PERQ} %REPEAT ! 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 -> LSWITCH LSW(40): 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(0): ! FAIL("CORRUPT WORKFILE ") {PERQ} LSW(1): ;! END OF BLOCK {PERQ} NEWLINE ; PRINTSTRING("END OF BLOCK FOUND") {PERQ} TON = (TON+255)&X'FFFFFF00' {PERQ} ->LSWITCH LSW(*): 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) ->NXTX %IF R1_RID<0 ;! UNSAT REF L2_LINK=LDATA(2) LDATA(2)=(L-LDSTART)>>NOTSYS L2_CODE OFFSET = R1_N&X'FFFF' 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) FIX(R1_RID,REDTAPELEN+R1_N) ;! RELOCATE CALLS ON XREFS NXTX: J = R1_LINK %REPEAT !* !---------------------------------------- ! MODIFY ADDRESSES IN CODE !----------------------------------------- J = HEAD(18) %WHILE J # 0 %CYCLE R8 == RECORD(J) K=R8_CODEADDR LI=FBASE+(AREASTART(1)+K)>>SYS HALFINTEGER(LI)=HALFINTEGER(LI)+R8_ADDRFIELD 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(14) %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 L6_LENGTH=R4_L L6_NAME = R4_NAME {EMAS REVERSE(ADDR(L4_NAME),(LENGTH(L4_NAME)+2)>>1) INC = (L + 10 + 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 !* !----------------------------------------- ! LIST 9 - 32 BIT RELOCATIONS !----------------------------------------- J = HEAD(19) %IF J#0 %START LDATA(9) = (L-LDSTART)>>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(ROOT)+1,ADDR(ROOT),0,L,0) ;! TEMP TILL COMPILER FIXED {EMAS STRING(L) = ROOT 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 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)*NUMRTS) ! !------------------------------------------ ! 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=NUMRTS+1 %ELSEC CH_RTS=NUMRTS 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 CODE AREA 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 {PERQ} H_SOURCEFILE=FILE {EMAS REVERSE(ADDR(H),56) H_NUMIMPS = NUMIMPS H_IMPBLOCK = ((L-FBASE)>>(9-SYS)) ;! BLOCK NUMBER OF IMPORT BLOCK H_GDSIZE = (AREALENGTH(2)+AREALENGTH(5)+1)//2 H_VERSION = "1" H_COPYRIGHT="COPYRIGHT @ERCC" H_COPYRIGHT=H_COPYRIGHT." " %WHILE LENGTH(H_COPYRIGHT)<80 ;! TEMP {EMAS REVERSE(ADDR(H_VERSION),80) H_LANGUAGE=1 ;! FORTRAN FOR NOW !----------------------------- ! 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 + ((NUMRTS+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 MAXRT=0 J=HEAD(11) %WHILE J#0 %CYCLE R11==RECORD(J) E(R11_RTNO)=ADDR(R11) %IF R11_RTNO>MAXRT %THEN MAXRT=R11_RTNO 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 } %IF UNSATREFS > 0 %START ROUND TO BLOCK BOUNDARY H_PRELINKBLOCK = (L-FBASE)>>(9-SYS) HALFINTEGER(L) = UNSATREFS ; L = L + (2>>SYS) { FILL IN NUMBER OF REFS } J = HEAD(12) %WHILE J#0 %CYCLE R1 == RECORD(J) %IF R1_RID<0 %START ;! UNSATISFIED 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 {EMAS MOVE(LENGTH(R1_NAME)+1,ADDR(R1_NAME),ADDR(PLB_ROUTDESC(0))) {PERQ} COPY(LENGTH(R1_NAME)+1,ADDR(R1_NAME),0,ADDR(PLB_ROUTDESC(0)),0) {EMAS REVERSE(ADDR(PLB_ROUTDESC(0)),(LENGTH(R1_NAME)+2)>>1) L = L + (((12+(LENGTH(R1_NAME)+2))>>1)*(2>>SYS)) %FINISH 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} NEWLINE {PERQ} PRINTSTRING(" NUMBER OF OBJECT BLOCKS = ") ; WRITE(NUMOBJBLOCKS,1) {PERQ} WRITEBLOCK(OBJID,M,LI) %AND LI=LI+256 %FOR M=0,1,NUMOBJBLOCKS-1 {PERQ} CLOSEFILE(OBJID,NUMOBJBLOCKS,0) {EMAS INTEGER(FBASE) = L-FBASE { FILL IN FILE LENGTH} %END ;! OF QPUT !* %ENDOFFILE !*