{*********************} {* EMAS 370 *} {* PUT INTERFACE *} {* April 22 1985 *} {*********************} %CONSTSTRING (31) PUTVERSION= "PUT: version 13th November 1985" { These are the low level code and object generation routines which are common} { to our XA compilers in the EMAS 370 environment. } {April 22nd - Began move to new object file format. Incorporated LPUT functions} { April 18th - added Fortran features: Switch Val and Entry } { Tracing control } %CONSTINTEGER ON= 1, OFF = 2 %CONSTINTEGERNAME PTURNSA=x'003008d4' %CONSTSTRING (5) %ARRAY CHEADINGS(0:15)="pinit","pterm","pjump","plabl", "pusng","pdrop","pmark","pseto","pixrx", "pproc","ppend","pline",""(*) %OWNINTEGERARRAY CCOUNT(0:15) %OWNINTEGERARRAY PTURNC(0:15) %CONSTINTEGER TRACING= ON { Controls conditional compilation } { Trace all significant calls on interface if: } { comreg(26)&1#0 (Major calls) or } { ComReg(26)&2#0 (Code planting calls) } { as directed by calls on procs. Pmonon/Pmonon } { Seldom required info controlled by bits of comreg(26) as follows: } { 128 - Decode each instruction as planted } { 256 - Give a full recode of code area at end of compilation } %CONSTINTEGER EMAS=0 %CONSTINTEGER AMDAHL= 1 %CONSTINTEGER TARGET= AMDAHL {* External/system declarations *} %EXTERNALINTEGERFNSPEC UINFI %ALIAS "S#UINFI"(%INTEGER I) %EXTERNALROUTINESPEC DISCONNECT %ALIAS "S#DISCONNECT"(%STRING (255) FILE, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC UCTRANSLATE %ALIAS "EMAS3UCTRANSLATE"(%INTEGERNAME NA,NL) %EXTERNALROUTINESPEC EMAS3(%STRINGNAME COM,PAR, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC OUTFILE %ALIAS "EMAS3OUTFILE"(%STRING (255) %NAME NAME, %INTEGERNAME LENGTH,MAXBYTES,PROTECTION,CONAD,FLAG) %EXTERNALINTEGERMAPSPEC COMREGMAP %ALIAS "S#COMREGMAP"(%INTEGER I) %EXTERNALROUTINESPEC FAILUREMESSAGE %ALIAS "EMAS3FAILUREMESSAGE"(%INTEGERNAME NMESS, %STRINGNAME FMST) %EXTERNALROUTINESPEC IBMRECODE %ALIAS "S#NCODE"(%INTEGER START,END,OFFSET) {* Constant declarations *} %CONSTINTEGER MAIN= X'80000000' %CONSTINTEGER MAINOREXT= X'80000001' {* Area management constants *} %CONSTINTEGER CODE=1, GLA=2, {free3} SST=4, UST=5, DIAGS=6, STATIC=7, IOTAB=8, ZUST=9, CNST=10 { Order of writing out areas } %CONSTINTEGERARRAY NEXTAREA(1:9)= CODE, CNST, SST, DIAGS, GLA, STATIC, UST, IOTAB, ZUST %CONSTSTRING (6) %ARRAY AREAS(1:10)="Code", "Gla", "Unused", "Sst", "Ust", "Diags", "Static", "Iotab", "Zgst", "Cnst" { Properties of areas in object file map } %CONSTINTEGERARRAY APROPS(CODE:CNST)= 0,1<<31,1<<31,0,1<<31,0,1<<31(3),0 { Internal control variables } { Properties bits for area definitions } %CONSTINTEGER BLANKCOMMON= 1, NAMEDCOMMON = 1<<1, ZEROFILLED = 1<<8, UNASSIGNED = 1<<9, MULTIPLEINIT = 1<<10 %OWNINTEGER EMAS3FLAG %OWNINTEGER ZERO= 0 %OWNINTEGER IMPFLAG %OWNSTRING (255) LANGVERS { Compiler version string } %OWNINTEGER GLOBALADJUSTMENT %OWNINTEGER LINKORMOD { 1 if PCodeBytes used } %OWNINTEGER XAFLAG { 1 for use BASR, 0 for use BALR } %OWNINTEGER MON=0 { Put call monitoring control } %OWNINTEGER ADDMULTIPLES { PUT to add correct number of multiples to code } %OWNINTEGER PROCESSBYPROCS { Process Ca determined entries at end of each proc } %OWNINTEGER FAULTY { Errors have been detected } %OWNINTEGER CA { Code offset } %OWNINTEGER TOTCA { Running total of code size } %OWNINTEGER THISBASECA { @ of record holding Ca after last code processing } %OWNINTEGER LASTCA { Last decode ended here } %OWNINTEGER CURRENTLINE { Updated by PLineStart } %OWNINTEGER CURLEXLEV { Current nesting of blocks } %OWNINTEGER NEXTSYM { Next symbol table entry } %OWNINTEGER SAFECODE { Safe limit for 4 byte jumps from R12 } {* Identifier tables *} %CONSTINTEGER FRAGMENT= 0 { Record contains a pure code fragment } %CONSTINTEGER ECREFTYPE= 1, { Entry is a code ref } EDREFTYPE = 2, { Entry is a data ref } LABELTYPE = 3, { Entry is a Label } ECDEFTYPE = 4, { Entry is a code EP } JUMPTYPE = 5, { Entry is a Jump } USINGTYPE = 6, { Entry is a PUsing } EDDEFTYPE = 8, { Entry is a data EP } CNOPTYPE = 9, { Entry is a PCNOp } SWLABTYPE =10, { Entry is a switch ent linked to a label } SWINDTYPE =11, { Entry is a switch index } MARKERTYPE=12, { Entry is a PMarker for a fixup } ASTART =13 { Entry is a base Ca for a new Proc } {* IBM XA Opcodes etc. *} %INCLUDE "ercs12:ib4_mnemonics" %INCLUDE "ercs12:ib4_props" %IF TRACING=ON %THENSTART %INCLUDE "ercs12:ib4_names" %FINISH {* Service routines *} { RR equivalents of RX jumps for 2 and 6 byte jumps } %CONSTINTEGERARRAY RREQV(BAL:BAS)= BALR, BCTR, BCR, 0(5), BASR %STRING (255) %FN ITOS(%INTEGER N) %STRING (255) S %INTEGER SIGN S="" %IF N<0 %THENSTART N=-N SIGN=1 %FINISHELSE SIGN=0 %CYCLE S=TOSTRING((N-(N//10*10))+'0').S N=N//10 %REPEATUNTIL N=0 %IF SIGN=1 %THEN S="-".S %RESULT=S %END { of Itos } %CONSTSTRING (1) %ARRAY HEX(0:15)= "0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F" %STRING (8) %FN HTOS(%INTEGER I,SIZE) %INTEGER J %STRING (8) S S="" %CYCLE J=(SIZE*4)-4,-4,0 S=S.HEX((I>>J)&15) %REPEAT %RESULT=S %END { of Htos } %IF TRACING=ON %THENSTART %ROUTINE PHEXBYTE(%INTEGER I) { Print the Hex value of a single byte } PRINTSTRING(HEX((I>>8)&15).HEX(I&15)) %END { of PHexByte } %STRING (5) %FN ENAMES(%INTEGER OP) %INTEGER OP1,OP2 OP1=OP>>8 OP2=OP&255 %IF OP=X'80' %OR OP=X'82' %OR OP=X'93' %THENRESULT=NAMES(OP1) %IF OP1=X'E5' %THENSTART %IF OP2=1 %THENRESULT="LASP" %IF OP2=2 %THENRESULT="TPROT" %FINISH %IF OP1=X'B2' %THENSTART %IF OP2<=60 %THENRESULT=EXNAMES(OP2) %IF OP2=X'F0' %THENRESULT="PPG" %IF OP2=X'F1' %THENRESULT="PSU" %FINISH %IF OP1=X'9C' %THENSTART %IF OP2=0 %THENRESULT="SIO" %IF OP2=1 %THENRESULT="SIOF" %IF OP2=2 %THENRESULT="RIO" %FINISH %IF OP1=X'9E' %THENSTART %IF OP2=0 %THENRESULT="HIO" %IF OP2=1 %THENRESULT="HDV" %FINISH %IF OP1=X'9D' %AND OP2=1 %THENRESULT="CLRIO" %IF OP1=X'9F' %AND OP2=1 %THENRESULT="CLRCH" %RESULT="?????" %END { of ENames } %FINISH %INTEGERFN EPROPS(%INTEGER OP) { Checks the format for an extended opcode } %INTEGER OP1,OP2 OP1=OP>>8 OP2=OP&255 %IF OP2=X'80' %OR OP2=X'82' %OR OP2=X'93' %THENRESULT=SPROP %IF OP1=X'E5' %THENSTART %IF 0<=OP2<=1 %THENRESULT=SSE %RESULT=0 %FINISH %IF X'9C'<=OP1<=X'9F' %AND OP2=1 %THENRESULT=SPROP %IF X'9C00'<=OP<=X'9C02' %OR X'9D00'<=OP<=X'9E00' %THENRESULT=SPROP %IF OP1=X'B2' %THENSTART %IF X'F0'<=OP2<=X'F1' %THENRESULT=SPROP %IF OP2>60 %THENRESULT=0 %RESULT=EXPROPS(OP2) %FINISH %RESULT=0 %END { of EProps } %ROUTINE PERROR(%STRING (255) S, %INTEGER GOON) PRINTSTRING(" * Put Interface Error/ ".S." ") COMREGMAP(24)=1 %IF TRACING=ON %THENSTART %MONITOR %FINISH SELECTOUTPUT(0) PRINTSTRING("Put error: ".S." ") SELECTOUTPUT(82) %RETURNIF GOON=0 {try to keep going to allow report of multiple faults } %STOP %END { of PError } {* Local service routines *} %EXTERNALROUTINESPEC MOVE %ALIAS "S#MOVE"(%INTEGER LENGTH,FROM,TO) !%INTEGER I ! %RETURNIF LENGTH<=0 ! %IF target=emas %THENSTART ! I=X'18000000'!LENGTH ! *LSS_FROM ! *LUH_I ! *LDTB_I ! *LDA_TO ! *MV_ %L = %DR ! %FINISHELSESTART; ! ibm etc ! %IF FROM<=TO<=FROM+LENGTH %START ! %CYCLE I=length-1,-1,0 ! byteinteger(to+i)=byteinteger(from+i) ! %REPEAT ! %ELSE ! %CYCLE i=0,1,length-1 ! byteinteger(to+i)=byteinteger(from+i) ! %REPEAT ! %FINISH ! %FINISH !%END %EXTERNALROUTINESPEC FILL %ALIAS "S#FILL"(%INTEGER LENGTH,FROM,FILLER) !%INTEGER I,j ! %RETURNIF LENGTH<=0 ! %IF target=emas %START ! I=X'18000000'!LENGTH ! *LDTB_I ! *LDA_FROM ! *LB_FILLER ! *MVL_ %L = %DR ! %FINISHELSESTART ! byteinteger(i)=filler %FOR i=FROM,1,FROM+length-1 ! %FINISH !%END {* Area initialisation *} {* Fixup Manipulation *} %OWNINTEGER FILESIZE { Running total of object file size } %OWNINTEGER TOPDICT { Size of dictionary } %OWNINTEGER ADICT { Start of dictionary } %OWNINTEGER NDICT { Current start of free space } %OWNINTEGER LFIXUPS, { Head of label fixup list } MFIXUPS2, { Head of markers for relocations } XPROCLIST, { Head of ext proc EP list } XREFLIST, { Head of ext code refs } FFIXUPS, { Head of relocation requests } XDEPLIST, { Head of ext data EPs } XDLIST, { Head of ext data refs } SWLIST, { Head of switch list } CURRSWEND, { Tail of switches for current procedure } THRULIST, { List ordered by Ca for optimisation } THRULINK, { Tail of ThruList } CODELIST, { List of code area fragments ordered by Ca } CODELINK, { Tail of CodeList } HISTLIST, { Head of list of history records } HISTLINK, { Tail of list of history records } AREALIST, { Head of list of area definitions } INITLIST, { Head of list of initialisation records } BOUNDRELOCS, { Head of list of satisfied relocations in a bound file } LASTUSED { Address of last active Using record } %OWNINTEGERARRAY AREAHEAD(GLA:CNST) { Heads of area fragment lists } %OWNINTEGERARRAY AREATAIL(GLA:CNST) { Tails of area fragment lists } %OWNINTEGERARRAY INTLIST(GLA:CNST) { Heads of area initialisation lists } %RECORDFORMAT LABFMT(%SHORTINTEGER TYPE,FLAGS, %INTEGER THRULINK,LINK,LABEL,CA) %RECORDFORMAT ECREFFMT(%INTEGER LINK,ID,GLAAD, %STRING (31) NAME) %RECORDFORMAT ECDEFFMT(%SHORTINTEGER TYPE,DUM, %INTEGER THRULINK,LINK,W0,W1,CA,PARAMW, %STRING (31) NAME) %RECORDFORMAT FIXUPFMT(%INTEGER LINK,TGT,HOST) %RECORDFORMAT EDHEADFMT(%INTEGER LINK,XDLINK,LEN, %STRING (31) NAME) %RECORDFORMAT EDREFFMT(%INTEGER LINK,ADISP) %RECORDFORMAT EDDEFFMT(%INTEGER LINK,DISP,PROPS, %STRING (31) NAME) %RECORDFORMAT USINGFMT(%SHORTINTEGER TYPE,DUM, %INTEGER THRULINK,LINK,REG,CA) %RECORDFORMAT CNOPFMT(%SHORTINTEGER TYPE,B, %INTEGER THRULINK,LINK,W,CA) %RECORDFORMAT MARKERFMT(%INTEGER LINK,CA,LEN) %RECORDFORMAT MARKERFMT2(%SHORTINTEGER TYPE,DUM, %INTEGER THRULINK,LINK,CA) %RECORDFORMAT SWFMT(%SHORTINTEGER SIZE,SAD,LOWER,UPPER, %INTEGER LINK,DEF,LABS) %RECORDFORMAT SWELFMT(%SHORTINTEGER TYPE,INDEX,(%INTEGER THRULINK,RLINK,LLINK, CA %ORINTEGER LINK,LAB)) %RECORDFORMAT AREAFMT(%INTEGER AREA,LEN,OFFSET,LINK) %RECORDFORMAT INITFMT(%INTEGER LINK,DISP, %SHORTINTEGER NCOPIES,AREA,LEN) %RECORDFORMAT AREADEFFMT(%SHORTINTEGER IIN,PROPS, %INTEGER LINK,LEN, %STRING (31) NAME) %RECORDFORMAT HFORMAT(%INTEGER LINK,TYPE,DEPTH, %STRING (*) S) { Area buffer manipulation } %OWNINTEGERARRAY BUFFAD(GLA:CNST) %RECORDFORMAT AREABUFFFMT(%SHORTINTEGER AREA,LEN, %INTEGER OFFSET,LINK, %BYTEINTEGERARRAY DATA(1:4096)) %OWNRECORD (AREABUFFFMT) %ARRAYFORMAT AREABUFFARRAYFMT(GLA:CNST) %OWNRECORD (AREABUFFFMT) %ARRAYNAME AREABUFFER %ROUTINE FLUSHDATA(%INTEGER AREA) { Flush out the current contents of the buffer for Area } %RECORD (AREAFMT) %NAME REC,NEWREC,LASTREC %INTEGER HERE,LEN REC==AREABUFFER(AREA) LEN=REC_LEN %RETURNIF LEN=0 %IF NDICT+SIZEOF(REC)+LEN>TOPDICT %THEN PERROR("Work file full",1) HERE=ADICT+NDICT NEWREC==RECORD(HERE) NEWREC=REC MOVE(LEN,BUFFAD(AREA),HERE+SIZEOF(REC)) NDICT=(NDICT+LEN+SIZEOF(REC)+3)&(\3) NEWREC_LINK=0 %IF AREAHEAD(AREA)#0 %THENSTART LASTREC==RECORD(AREATAIL(AREA)) LASTREC_LINK=HERE %FINISHELSE AREAHEAD(AREA)=HERE AREATAIL(AREA)=HERE REC_OFFSET=REC_OFFSET+LEN REC_LEN=0 %END { of FlushData } {* Output to code area *} %RECORDFORMAT CODEFRAGFMT(%SHORTINTEGER TYPE,LINE, %INTEGER THRULINK,OFFSET,LINK,CA,REG,LEN, (%INTEGER LABEL,USED %ORINTEGER B,W)) %OWNRECORD (CODEFRAGFMT) %NAME CODEBUFFER %OWNINTEGER BUFFSTART %ROUTINE FLUSHCODE(%INTEGER TYPE) { Move the current contents of CodeBuffer to the heap and reset CodeBuffer } %RECORD (CODEFRAGFMT) %NAME REC,REC1 %INTEGER HERE,LEN HERE=ADICT+NDICT REC==RECORD(HERE) LEN=CODEBUFFER_LEN %IF LEN#0 %THENSTART %IF NDICT+SIZEOF(REC)+LEN>TOPDICT %THEN PERROR("Work file full",1) REC=CODEBUFFER %IF LASTCA=0 %THEN LASTCA=HERE MOVE(LEN,BUFFSTART,HERE+SIZEOF(REC)) NDICT=(NDICT+LEN+SIZEOF(REC)+3)&(\3) %IF THRULIST=0 %THEN THRULIST=HERE %IF THRULINK#0 %THENSTART REC1==RECORD(THRULINK) REC1_THRULINK=HERE %FINISH REC_THRULINK=0 THRULINK=HERE %IF CODELIST=0 %THEN CODELIST=HERE %IF CODELINK#0 %THENSTART REC1==RECORD(CODELINK) REC1_LINK=HERE %FINISH REC_LINK=0 CODELINK=HERE %FINISH CODEBUFFER_CA=CA CODEBUFFER_TYPE=TYPE CODEBUFFER_LEN=0 CODEBUFFER_OFFSET=0 CODEBUFFER_LINE=CURRENTLINE %END { of FlushCode } %ROUTINE IPUT312(%INTEGER VAL) ! { Equivalent to IPUT(31,2,Ca,Val)} %IF 4096-CODEBUFFER_LEN<2 %THEN FLUSHCODE(FRAGMENT) BYTEINTEGER(BUFFSTART+CODEBUFFER_LEN)=VAL>>8 BYTEINTEGER(BUFFSTART+CODEBUFFER_LEN+1)=VAL&255 %IF COMREGMAP(26)&128#0 %THEN %C IBMRECODE(CODEBUFFER_LEN+BUFFSTART,CODEBUFFER_LEN+BUFFSTART+2,CA) CODEBUFFER_LEN=CODEBUFFER_LEN+2 CA=CA+2 %END { of IPUT312 } %ROUTINE IPUT314(%INTEGER VAL) ! { Equivalent to IPUT(31,4,Ca,Val) } %INTEGER I %IF 4096-CODEBUFFER_LEN<4 %THEN FLUSHCODE(FRAGMENT) %FOR I=0,1,3 %CYCLE BYTEINTEGER(BUFFSTART+CODEBUFFER_LEN+I)=(VAL>>(24-8*I))&255 %REPEAT %IF COMREGMAP(26)&128#0 %THEN %C IBMRECODE(CODEBUFFER_LEN+BUFFSTART,CODEBUFFER_LEN+BUFFSTART+4,CA) CODEBUFFER_LEN=CODEBUFFER_LEN+4 CA=CA+4 %END { of IPUT314 } %ROUTINE IPUT316(%INTEGER ADVAL) ! { Equivalent to IPUT(31,6,Ca,AdVal) } %IF 4096-CODEBUFFER_LEN<6 %THEN FLUSHCODE(FRAGMENT) MOVE(6,ADVAL,BUFFSTART+CODEBUFFER_LEN) %IF COMREGMAP(26)&128#0 %THEN %C IBMRECODE(CODEBUFFER_LEN+BUFFSTART,CODEBUFFER_LEN+BUFFSTART+6,CA) CODEBUFFER_LEN=CODEBUFFER_LEN+6 CA=CA+6 %END { of IPUT316 } %ROUTINE IPUT31N(%INTEGER LEN,AD) ! { Equivalent to IPUT(31,Len,Ca,Ad) } %IF 4096-CODEBUFFER_LEN1 %THENSTART PRINTSTRING("PIXRR ".NAMES(OP)." ".REGS(R1)." ".REGS(R2)." ") %FINISH %FINISH PERROR("Inappropiate opcode",0) %IF PROPS(OP)&15#RR IPUT312(((OP&255)<<8)!((R1&15)<<4)!(R2&15)) %END { of PIX RR } %EXTERNALROUTINE PIXRRE(%INTEGER OP,R1,R2) %IF TRACING=ON %THENSTART %IF MON>1 %THENSTART PRINTSTRING("PIXRRE ".ENAMES(OP)." ".REGS(R1)." ".REGS(R2)." ") %FINISH %FINISH PERROR("Inappropriate opcode",0) %IF EPROPS(OP)#RRE IPUT314((OP<<16)!((R1&15)<<4)!(R2&15)) %END { of PIX RRE } %EXTERNALROUTINE PIX RX(%INTEGER OP,R1,X2,B2,D2) CCOUNT(8)=CCOUNT(8)+1 PTURNC(8)=PTURNC(8)-PTURNSA %IF TRACING=ON %THENSTART %IF MON>1 %THENSTART PRINTSTRING("PIXRX ".NAMES(OP)." ".REGS(R1)." ".REGS(X2)." ") PRINTSTRING(REGS(B2)." ".HTOS(D2,8)." ") %IF PROPS(OP)&15=RS %THEN PRINTSTRING("*** RS used in RX *** ") %FINISH %FINISH PERROR("Inappropriate opcode",0) %IF PROPS(OP)&15#RX %AND PROPS(OP)&15#RS IPUT314((OP<<24)!((R1&15)<<20)!((X2&15)<<16)!((B2&15)<<12)!(D2&X'FFF')) PTURNC(8)=PTURNC(8)+PTURNSA %END { of PIX RX } %EXTERNALROUTINE PIX RS(%INTEGER OP,R1,R3,B2,D2) %IF TRACING=ON %THENSTART %IF MON>1 %THENSTART PRINTSTRING("PIXRS ".NAMES(OP)." ".REGS(R1)." ".REGS(R3)) PRINTSTRING(" ".REGS(B2)." X'".HTOS(D2,8)."' ") %IF PROPS(OP)&15=RX %THEN PRINTSTRING("*** RX used for RS *** ") %FINISH %FINISH PERROR("Inappropriate opcode",0) %IF PROPS(OP)&15#RS %AND PROPS(OP)&15#RX IPUT314((OP<<24)!((R1&15)<<20)!((R3&15)<<16)!((B2&15)<<12)!(D2&X'FFF')) %END { of PIX RS } %EXTERNALROUTINE PIX SI(%INTEGER OP,I2,B1,D1) %IF TRACING=ON %THENSTART %IF MON>1 %THENSTART PRINTSTRING("PIX ".NAMES(OP)." X'".HTOS(I2,8)."' ".REGS(B1)." X'") PRINTSTRING(HTOS(D1,8)."' ") %FINISH %FINISH PERROR("Inappropriate opcode",0) %IF PROPS(OP)&15#SI IPUT314((OP<<24)!((I2&255)<<16)!((B1&15)<<12)!(D1&X'FFF')) %END { of PIX SI } %EXTERNALROUTINE PIX S(%INTEGER OP,B2,D2) %IF TRACING=ON %THENSTART %IF MON>1 %THENSTART PRINTSTRING("PIXS ".ENAMES(OP)." ".REGS(B2)." X'".HTOS(D2,8)."' ") %FINISH %FINISH PERROR("Inappropriate opcode",0) %IF EPROPS(OP)#SPROP %IF OP<=255 %THEN OP=OP<<8 IPUT314((OP<<16)!((B2&15)<<12)!(D2&X'FFF')) %END { of PIX S } %EXTERNALROUTINE PIX SS(%INTEGER OP,L1,L2,B1,D1,B2,D2) %INTEGER VAL1,VAL2 %IF TRACING=ON %THENSTART %IF MON>1 %THENSTART PRINTSTRING("PIXSS ".NAMES(OP)." ".ITOS(L1)." ".ITOS(L2)." ") PRINTSTRING(REGS(B1)." X'".HTOS(D1,8)."' ".REGS(B2)." X'".HTOS(D2,8)."' ") %FINISH %FINISH PERROR("Inappropriate opcode",0) %IF PROPS(OP)#SS %IF L1#0 %THEN L1=L1-1 %IF L2#0 %THEN L2=L2-1 VAL1=(OP<<24)!((L1&15)<<20)!((L2&255)<<16)!((B1&15)<<12)!(D1&X'FFF') VAL2=((B2&15)<<28)!((D2&X'FFF')<<16) IPUT316(ADDR(VAL1)) %END { of PIX SS } %EXTERNALROUTINE PIX SSE(%INTEGER OP,B1,D1,B2,D2) %INTEGER VAL1,VAL2 %IF TRACING=ON %THENSTART %IF MON>1 %THENSTART PRINTSTRING("PIXSSE ".ENAMES(OP)." ".REGS(B1)." X'".HTOS(D1,8)."' ") PRINTSTRING(REGS(B2)." X'".HTOS(D2,8)."'") %FINISH %FINISH PERROR("Inappropriate opcode",0) %IF EPROPS(OP)#SSE VAL1=(OP<<16)!((B1&15)<<12)!(D1&X'FFF') VAL2=((B2&15)<<28)!((D2&X'FFF')<<16) IPUT316(ADDR(VAL1)) %END {* List handling in heap *} %OWNINTEGER CURLABS,CURLABSTOP %ROUTINE NOTEL(%INTEGER LABEL,CA) { Associate the Label with Ca } %INTEGER I %RECORD (LABFMT) %NAME REC,REC1 %IF CURLABS+SIZEOF(REC)>CURLABSTOP %THENSTART I=((NDICT+4095)&(\4095))+4096 %IF I>TOPDICT %THEN PERROR("New label causes table overflow",1) CURLABS=NDICT+ADICT CURLABSTOP=I+ADICT NDICT=I %FINISH REC==RECORD(CURLABS) REC_TYPE=LABELTYPE REC_LINK=LFIXUPS LFIXUPS=CURLABS REC_LABEL=LABEL REC_CA=CA CURLABS=CURLABS+SIZEOF(REC) %IF CA#-1 %THENSTART { Avoid adding forward ref to Ca ordered list } %IF THRULIST=0 %THEN THRULIST=CURLABS { First on the Ca ordered list } %IF THRULINK#0 %THENSTART REC1==RECORD(THRULINK) REC1_THRULINK=CURLABS %FINISH THRULINK=CURLABS REC_THRULINK=0 %FINISH %END { of NoteL } %INTEGERFN LOCATEL(%INTEGER N, %INTEGERNAME LA) { Returns the addr of the label record associated with label N } %RECORD (LABFMT) %NAME REC LA=LFIXUPS %WHILE LA#0 %CYCLE REC==RECORD(LA) %IF REC_LABEL=N %THENRESULT=0 LA=REC_LINK %REPEAT LA=ADICT+NDICT %RESULT=1 %END { of LocateL } %INTEGERFN LOCATESW(%INTEGER SAD, %INTEGERNAME AT) { Find the location of the entry for a switch at Sad in SST } %RECORD (SWFMT) %NAME REC AT=SWLIST %WHILE AT#0 %CYCLE REC==RECORD(AT) %IF REC_SAD=SAD %THENRESULT=0 AT=REC_LINK %REPEAT %RESULT=1 %END { of Locate Sw } %EXTERNALINTEGERFN PMARKER(%INTEGER HALFWORDS) %RECORD (MARKERFMT) %NAME REC3,REC4 %RECORD (MARKERFMT2) %NAME REC1,REC2 %INTEGER HERE,I CCOUNT(6)=CCOUNT(6)+1 PTURNC(6)=PTURNC(6)-PTURNSA %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Marker at ".HTOS(CA,8)." len ") PRINTSTRING(ITOS(HALFWORDS)." ") %FINISH %FINISH { Associate the Marker with Ca } HERE=ADICT+NDICT %IF HALFWORDS=0 %THENSTART { Marker used to mark a relocation } %IF NDICT+SIZEOF(REC1)>TOPDICT %THEN PERROR("Table overflow",1) REC1==RECORD(HERE) REC1_LINK=MFIXUPS2 MFIXUPS2=HERE REC1_CA=CA REC1_TYPE=MARKERTYPE %IF THRULIST=0 %THEN THRULIST=HERE %IF THRULINK#0 %THENSTART REC2==RECORD(THRULINK) REC2_THRULINK=HERE %FINISH THRULINK=HERE REC1_THRULINK=0 NDICT=NDICT+SIZEOF(REC1) %FINISH HERE=CA IPUT312(0) %FOR I=1,1,HALFWORDS PTURNC(6)=PTURNC(6)+PTURNSA %RESULT=HERE %END { of PMarker } {* Process red tape part of file *} {* Relocation primitives *} %EXTERNALROUTINE PSETOPD(%INTEGER MARKVALUE,OFFSET,HALFWORD) %INTEGER AT,I %RECORD (CODEFRAGFMT) %NAME CREC CCOUNT(7)=CCOUNT(7)+1 PTURNC(7)=PTURNC(7)-PTURNSA %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("PSetOpd, mark ".ITOS(MARKVALUE)." offset ".ITOS(OFFSET)) PRINTSTRING(" value ".ITOS(HALFWORD)." ") %FINISH %FINISH %IF CODEBUFFER_CA<=MARKVALUE>8 BYTEINTEGER(I+1)=HALFWORD&255 ->FINI %FINISH AT=THISBASECA %WHILE AT#0 %CYCLE CREC==RECORD(AT) %IF CREC_CA<=MARKVALUEFOUND AT=CREC_LINK %REPEAT PERROR("Unmatched marker",1) ->FINI FOUND: %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("Set in record at ".HTOS(AT,8)." ") %FINISH %FINISH I=AT+(MARKVALUE-CREC_CA)+SIZEOF(CREC)+(OFFSET<<1) BYTEINTEGER(I)=HALFWORD>>8 BYTEINTEGER(I+1)=HALFWORD&255 FINI: PTURNC(7)=PTURNC(7)+PTURNSA %END { of PSetOpD } %EXTERNALROUTINE PLABEL(%INTEGER LABELID) { Note a label at CA, LabelId being assigned by the code generator } %INTEGER FLAG,VAL,I %RECORD (LABFMT) %NAME LAB,LAST %IF TRACING=ON %THENSTART CCOUNT(3)=CCOUNT(3)+1 PTURNC(3)=PTURNC(3)-PTURNSA %IF MON#0 %THENSTART PRINTSTRING("Plabel called for ".ITOS(LABELID)." ") %FINISH %FINISH FLUSHCODE(FRAGMENT) %IF LOCATEL(LABELID,I)=0 %THENSTART { Forward jump } LAB==RECORD(I) %IF LAB_CA#-1 %THEN PERROR("Label ".ITOS(LABELID)." set twice",1) LAB_CA=CA LAST==RECORD(THRULINK) LAST_THRULINK=I { Add record to Ca ordered list, which } LAB_THRULINK=0 THRULINK=I { was not done by NoteL for a forward ref } %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("Forward label at:".HTOS(CA,8)." ") %FINISH %FINISH %FINISHELSESTART NOTEL(LABELID,CA) %FINISH PTURNC(3)=PTURNC(3)+PTURNSA %END { of PLabel } %EXTERNALROUTINE PUSING(%INTEGER REG) %INTEGER I %RECORD (USINGFMT) %NAME REC,REC1,NEXT CCOUNT(4)=CCOUNT(4)+1 PTURNC(4)=PTURNC(4)-PTURNSA %IF TRACING=ON %THENSTART %IF MON#0 %THEN PRINTSTRING("PUsing, reg ".REGS(REG)." ") %FINISH %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) %IF LASTUSED#0 %THENSTART REC==RECORD(LASTUSED) %IF REC_REG=REG %THENSTART LASTUSED=REC_LINK %FINISHELSESTART %WHILE REC_LINK#0 %CYCLE NEXT==RECORD(REC_LINK) %IF NEXT_REG=REG %THENSTART REC_LINK=NEXT_LINK %FINISH REC==NEXT %REPEAT %FINISH %FINISH FLUSHCODE(FRAGMENT) I=ADICT+NDICT REC==RECORD(I) REC_CA=CA REC_REG=REG REC_TYPE=USINGTYPE %IF THRULIST=0 %THEN THRULIST=I %IF THRULINK#0 %THENSTART REC1==RECORD(THRULINK) REC1_THRULINK=I %FINISH REC_THRULINK=0 THRULINK=I REC_LINK=LASTUSED LASTUSED=I NDICT=NDICT+SIZEOF(REC) PTURNC(4)=PTURNC(4)+PTURNSA %END { of P Using } %EXTERNALROUTINE PDROP(%INTEGER REG) %INTEGER I,FOUND %RECORD (USINGFMT) %NAME USED,NREC CCOUNT(5)=CCOUNT(5)+1 PTURNC(5)=PTURNC(5)-PTURNSA FOUND=0 %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Drop ".REGS(REG)." ") %IF LASTUSED=0 %THEN PRINTSTRING("*** Using list empty *** ") %FINISH %FINISH %IF LASTUSED#0 %THENSTART USED==RECORD(LASTUSED) %IF USED_REG=REG %THENSTART LASTUSED=USED_LINK FOUND=1 %FINISHELSESTART %WHILE USED_LINK#0 %CYCLE NREC==RECORD(USED_LINK) %IF NREC_REG=REG %THENSTART USED_LINK=NREC_LINK FOUND=1 %FINISH USED==NREC %REPEAT %FINISH %FINISH %IF TRACING=ON %THENSTART %IF MON#0 %AND FOUND=0 %THEN PRINTSTRING("*** Unmatched drop *** ") %FINISH PTURNC(5)=PTURNC(5)+PTURNSA %END { of PDrop } %EXTERNALROUTINE PJUMP(%INTEGER OP,LABELID,MASK,REG) { Plant jump instruction, filling in address for backward jumps } %RECORD (LABFMT) %NAME LAB %RECORD (USINGFMT) %NAME USED %INTEGER I,TEM CCOUNT(2)=CCOUNT(2)+1 PTURNC(2)=PTURNC(2)-PTURNSA %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Jump:".NAMES(OP)." ".ITOS(LABELID)." Mask:") PRINTSTRING(ITOS(MASK)." ".REGS(REG)." ") %FINISH %FINISH TEM=LASTUSED %IF LOCATEL(LABELID,I)=0 %THENSTART { Backward jump } LAB==RECORD(I) %IF LAB_CA=0 %THENSTART { Plant 2 byte form } PIXRR(RREQV(OP),MASK,12) { No need to adjust } pturnc(2)=pturnc(2)+pturnsa %RETURN %FINISH I=LASTUSED %IF LAB_CA>=0 %THENSTART { Not a forward ref to label } %IF LAB_CAOUT I=USED_LINK %REPEATUNTIL I=0 %FINISH %FINISH OUT: LASTUSED=I %FINISHELSESTART NOTEL(LABELID,-1) LAB==RECORD(I) %FINISH { Add a jump ref to the list attached to label record at Ad } FLUSHCODE(JUMPTYPE) CODEBUFFER_USED=LASTUSED CODEBUFFER_REG=REG CODEBUFFER_LABEL=ADDR(LAB) LASTUSED=TEM %IF REG>0 %THEN PIX RX(L,REG&15,12,0,0) %IF REG<0 %THEN PIXRX(OP,MASK,0,-REG,0) %ELSE PIXRX(OP,MASK,12,REG&15,0) PTURNC(2)=PTURNC(2)+PTURNSA %END { of PJump } %EXTERNALROUTINE PJINDEX(%INTEGER OP,LABEL,REG1,REG2) { Plant a Branch on Index form of jump to Label } %INTEGER REG,I %RECORD (LABFMT) %NAME LAB %RECORD (USINGFMT) %NAME USED %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Jump on Index:".NAMES(OP)." ".ITOS(LABEL)) PRINTSTRING(" Regs ".REGS(REG1)." ".REGS(REG2)." ") %FINISH %FINISH REG=0 %IF LOCATEL(LABEL,I)=0 %THENSTART { Backward jump } LAB==RECORD(I) %IF LASTUSED#0 %THENSTART USED==RECORD(LASTUSED) %IF 0<=LAB_CA-USED_CA<4096 %THEN REG=-USED_REG %FINISHELSESTART %IF LAB_CA>=4096 %THEN PERROR("No Using for Jump on Index",0) %ELSE REG=-12 %FINISH %FINISHELSESTART NOTEL(LABEL,-1) LAB==RECORD(I) %FINISH { Add a jump ref to the list attached to label record at Ad } FLUSHCODE(JUMPTYPE) CODEBUFFER_LINE=CURRENTLINE CODEBUFFER_USED=LASTUSED CODEBUFFER_REG=REG CODEBUFFER_LABEL=ADDR(LAB) PIXRS(OP,REG1,REG2,0,0) %END { of PJIndex } {* Switch support *} %EXTERNALROUTINE PSWITCH(%INTEGER SSTAD,LOWER,UPPER,SIZE) { Note that a switch with bounds Lower and Upper is at SSTAd } { in the SST. Size is the entry size - 2 or 4 bytes. } %INTEGER HERE %RECORD (SWFMT) %NAME REC %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Switch at ".HTOS(SSTAD,6)." in SST, Size=".ITOS(SIZE)." Bounds = ".ITOS(LOWER).":".ITOS(UPPER)." ") %FINISH %FINISH { Note a switch table at SSTAd in SST } %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) HERE=ADICT+NDICT REC==RECORD(HERE) REC=0 REC_LINK=SWLIST REC_SAD=SSTAD REC_LOWER=LOWER REC_UPPER=UPPER REC_SIZE=SIZE REC_LABS=0 REC_DEF=0 SWLIST=HERE NDICT=NDICT+SIZEOF(REC) %END { of PSwitch } %EXTERNALROUTINE PSWITCHVAL(%INTEGER SSTAD,INDEX,LABEL) { Note a match between Index in switch table at SSTAd and Label } %INTEGER HERE,SWAD %RECORD (SWELFMT) %NAME REC %RECORD (SWFMT) %NAME SW %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("PSwitchVal ".HTOS(SSTAD,6)." Index = ".ITOS(INDEX)) PRINTSTRING(" Label = ".ITOS(LABEL)." ") %FINISH %FINISH %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) HERE=ADICT+NDICT REC==RECORD(HERE) REC=0 %IF LOCATESW(SSTAD,SWAD)#0 %THEN PERROR("Switch ".ITOS(SSTAD)." missing",0) SW==RECORD(SWAD) REC_INDEX=INDEX REC_LAB=LABEL REC_LINK=SW_LABS SW_LABS=HERE NDICT=NDICT+SIZEOF(REC) %END { of PSwitchVal } %EXTERNALROUTINE PSLABEL(%INTEGER SSTAD,INDEX) { Fill in an element of the switch at SSTAd with Ca } %INTEGER AT,HERE %RECORD (SWELFMT) %NAME REC,REC1 %RECORD (SWFMT) %NAME SW %ROUTINE ADDTO(%INTEGERNAME LINK) { Add the element to a tree sorted list } %RECORD (SWELFMT) %NAME NODE %IF LINK=0 %THEN LINK=HERE %ANDRETURN NODE==RECORD(LINK) %IF NODE_INDEX=INDEX %THENSTART { Replace earlier entry } REC_LLINK=NODE_LLINK REC_RLINK=NODE_RLINK LINK=HERE %RETURN %FINISH %IF NODE_INDEX>INDEX %THEN ADDTO(NODE_RLINK) %ELSE ADDTO(NODE_LLINK) %END { of AddTo } %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Switch Label ".ITOS(INDEX)." ".HTOS(SSTAD,6)." ") %FINISH %FINISH FLUSHCODE(FRAGMENT) %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) HERE=ADICT+NDICT REC==RECORD(HERE) REC=0 %IF LOCATESW(SSTAD,AT)#0 %THEN PERROR("Switch ".ITOS(SSTAD)." missing",0) SW==RECORD(AT) REC_INDEX=INDEX REC_TYPE=SWINDTYPE ADDTO(SW_LABS) REC_CA=CA %IF THRULIST=0 %THEN THRULIST=HERE { First on Ca ordered list } %IF THRULINK#0 %THENSTART REC1==RECORD(THRULINK) REC1_THRULINK=HERE %FINISH REC_THRULINK=0 THRULINK=HERE NDICT=NDICT+SIZEOF(REC) %END { of P S Label } %EXTERNALROUTINE PSDEFAULT(%INTEGER SSTAD,LABEL) { Fill any unfilled elements of the switch with Label's Ca } %INTEGER AT,AD,I,DEFLAB,AT2 %RECORD (LABFMT) %NAME REC2 %RECORD (SWFMT) %NAME REC %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Switch Deft. for ".HTOS(SSTAD,6)." label=".ITOS(LABEL)." ") %FINISH %FINISH %IF LOCATESW(SSTAD,AT)#0 %THEN PERROR("Switch ".HTOS(SSTAD,6)." missing",0) REC==RECORD(AT) %IF LABEL=0 %THEN AD=CA { Label =0, default is at Ca } %IF LABEL<0 %THEN AD=LABEL { Label < 0, default is value of Label } %IF LABEL>0 %THENSTART %IF REC_DEF=0 %THENSTART %IF LOCATEL(LABEL,AT2)#0 %THEN NOTEL(LABEL,-1) %FINISHELSESTART I=LOCATEL(DEFLAB,AT2) REC2==RECORD(AT2) REC2_LABEL=LABEL %FINISH %FINISH REC_DEF=LABEL %END { of P S Default } {* Put Interface Passing of Data * *} %EXTERNALROUTINE PCODEHALF(%INTEGER VAL) { Write two bytes to the Code area unchecked at Ca } %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Code Half ".HTOS(VAL,4)." ") %FINISH %FINISH %IF VAL>>16#0 %THEN PERROR("Val too big in PCodeHalf",0) %IF 4096-CODEBUFFER_LEN<2 %THEN FLUSHCODE(FRAGMENT) BYTEINTEGER(BUFFSTART+CODEBUFFER_LEN)=VAL>>8 BYTEINTEGER(BUFFSTART+CODEBUFFER_LEN+1)=VAL&255 CODEBUFFER_LEN=CODEBUFFER_LEN+2 CA=CA+2 %END { of PCode Half } %EXTERNALROUTINE PCODEWORD(%INTEGER VAL) { Write four bytes to the Code area at current position } %INTEGER I %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Code Word: ".HTOS(VAL,8)." ") %FINISH %FINISH %IF 4096-CODEBUFFER_LEN<4 %THEN FLUSHCODE(FRAGMENT) %FOR I=3,-1,0 %CYCLE BYTEINTEGER(BUFFSTART+CODEBUFFER_LEN+I)=VAL&255 VAL=VAL>>8 %REPEAT CODEBUFFER_LEN=CODEBUFFER_LEN+4 CA=CA+4 %END { of PCodeWord } %EXTERNALROUTINE PCODEBYTES(%INTEGER LEN,AD) { Write Len bytes to the code area } %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("PCodeBytes, Len ".ITOS(LEN)." ") %FINISH %FINISH LINKORMOD=1 FLUSHCODE(FRAGMENT) %WHILE LEN>4096 %CYCLE IPUT31N(4096,AD) LEN=LEN-4096 AD=AD+4096 %REPEAT IPUT31N(LEN,AD) %END { of PCodeBytes } %EXTERNALROUTINE PDBYTES(%INTEGER AREA,DISP,LEN,AD) %INTEGER I %RECORD (AREAFMT) %NAME BUFFER %IF TRACING=ON %THENSTART %IF MON#0 %START PRINTSTRING(" PD ( ".ITOS(AREA)." len = ".ITOS(LEN)." Disp=") WRITE(DISP,5) SPACE ! PHexByte(Byteinteger(I)) %FOR I = Ad,1,Ad+Len-1 NEWLINE %FINISH %FINISH BUFFER==AREABUFFER(AREA) ! %IF Disp>Buffer_Offset %AND Disp+LenBuffer_Offset+Buffer_Len %THEN %C ! Buffer_Len = Disp+Len-Buffer_Offset ! %FINISHELSESTART FLUSHDATA(AREA) BUFFER_OFFSET=DISP %WHILE LEN>4096 %CYCLE MOVE(4096,AD,BUFFAD(AREA)) LEN=LEN-4096 AD=AD+4096 BUFFER_LEN=4096 FLUSHDATA(AREA) %REPEAT BUFFER_LEN=LEN MOVE(LEN,AD,BUFFAD(AREA)) ! %FINISH %END { of PDBytes } %EXTERNALROUTINE PD4(%INTEGER AREA,DISP,VALUE) %RECORD (AREAFMT) %NAME BUFFER { Plant a 4 byte value at Disp in Area, using unbuffered areas } %IF TRACING=ON %THENSTART %IF MON>1 %THENSTART PRINTSTRING("PD4, Area=".ITOS(AREA)." Disp=".ITOS(DISP)."Val=".ITOS(VALUE)." ") %FINISH %FINISH BUFFER==AREABUFFER(AREA) ! %IF Disp>=Buffer_Offset %AND Disp+4<=Buffer_Offset+4096 %START ! Move(4,Addr(Value),BuffAd(Area)+Disp-Buffer_Offset) ! %IF Disp+4>Buffer_Offset+Buffer_Len %THEN Buffer_Len = Disp+4-Buffer_Offset ! %FINISHELSESTART FLUSHDATA(AREA) INTEGER(BUFFAD(AREA))=VALUE BUFFER_OFFSET=DISP BUFFER_LEN=4 ! %FINISH %END { of PD4 } %EXTERNALROUTINE PDPATTERN(%INTEGER AREA,DISP,NCOPIES,LEN,AD) %RECORD (INITFMT) %NAME REC %INTEGER I,HERE %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING(" PDPattern( area = "); WRITE(AREA,1) PRINTSTRING(", disp = "); WRITE(DISP,1) PRINTSTRING(", ncopies = "); WRITE(NCOPIES,1) PRINTSTRING(" filler = ") PHEXBYTE(BYTEINTEGER(I)) %FOR I=AD,1,AD+LEN-1 NEWLINE %FINISH %FINISH %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) HERE=ADICT+NDICT REC==RECORD(HERE) %IF GLA<=AREA<=CNST %THENSTART REC_LINK=INTLIST(AREA) INTLIST(AREA)=HERE %FINISHELSESTART REC_LINK=INITLIST INITLIST=HERE %FINISH REC_NCOPIES=NCOPIES REC_AREA=AREA REC_DISP=DISP REC_LEN=LEN MOVE(LEN,AD,HERE+SIZEOF(REC)) NDICT=NDICT+((LEN+3)&(\3))+SIZEOF(REC) FILESIZE=FILESIZE+((LEN+3)&(\3))+20 %END { of PDPattern } {* Put Interface RELOCATION and REFERENCES *} %EXTERNALINTEGERFN PXNAME(%INTEGER TYPE, %STRING (255) %NAME NAME, %INTEGER GLAAD) { Create an external code reference } { Xrefs are used many times so establish mapping to integer ID early} { and save on holding/passing of strings } %RECORD (ECREFFMT) %NAME REC %INTEGER I,J %IF TRACING=ON %THENSTART %IF MON#0 %THEN PRINTSTRING("Xname: ".NAME." symID = ".ITOS(NEXTSYM)." ") %FINISH I=ADDR(NAME)+1 J=LENGTH(NAME) UCTRANSLATE(I,J) %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) NEXTSYM=NEXTSYM+1 %IF TYPE=1 %THEN GLAAD=GLAAD!X'80000000' { Note that a code reference is to be planted at GlaAd } I=ADICT+NDICT REC==RECORD(I) REC_LINK=XREFLIST REC_ID=NEXTSYM REC_GLAAD=GLAAD REC_NAME<-NAME XREFLIST=I FILESIZE=FILESIZE+8+(LENGTH(NAME)+4)&(\3) NDICT=NDICT+SIZEOF(REC) %RESULT=NEXTSYM %END { of PXName } %ROUTINESPEC PDXREF(%INTEGER I,J,K, %STRING (31) %NAME NAME) %EXTERNALROUTINE PFIX(%INTEGER HOSTAREA,HOSTDISP,TGTAREA,TGTDISP) { A relocation request: set word in area, displacement = 'disp' bytes, } { the address of area 'targetareaid', displacement = TgtDisp.} %INTEGER HERE %RECORD (FIXUPFMT) %NAME REC %RECORD (AREADEFFMT) %NAME AREC %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("PFix(".ITOS(HOSTAREA)."/".HTOS(HOSTDISP,6)."->") PRINTSTRING(ITOS(TGTAREA)."/".HTOS(TGTDISP,6)." ") %FINISH %FINISH { Check for common and call PDXRef } %IF TGTAREA>255 %THENSTART { Can only be common } HERE=AREALIST %WHILE HERE#0 %CYCLE AREC==RECORD(HERE) %IF AREC_IIN=TGTAREA %THEN ->FOUND HERE=AREC_LINK %REPEAT PERROR("Common not defined for fixup",0) FOUND: PDXREF(4,HOSTAREA,HOSTDISP,AREC_NAME) %RETURN %FINISH %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) TGTDISP=TGTDISP&X'FFFFFF' %IF FFIXUPS=0 %THEN FILESIZE=FILESIZE+8 { Allow for header first time } { Note that HostDisp in HostArea is to be relocated by base of TgtArea } HERE=ADICT+NDICT REC==RECORD(HERE) REC_LINK=FFIXUPS FFIXUPS=HERE REC_TGT=(TGTAREA<<24)!TGTDISP REC_HOST=(HOSTAREA<<24)!HOSTDISP FILESIZE=FILESIZE+8 NDICT=NDICT+SIZEOF(REC) %END { of PFix } %EXTERNALROUTINE PBRELOC(%INTEGER AREALOC,BASELOC) { A satisfied relocation request in a bound file. } { Binding has set word in AreaLoc>>24, displacement = (AreaLoc<<8)>>8, } { the address of area BaseLoc>>24, displacement = (BaseLoc<<8)>>8.} %INTEGER HERE %RECORD (FIXUPFMT) %NAME REC %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("PBReloc(".ITOS(AREALOC>>24)."/".HTOS((AREALOC<<8)>>8,6)."->") PRINTSTRING(ITOS(BASELOC>>24)."/".HTOS((BASELOC<<8)>>8,6)." ") %FINISH %FINISH %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) %IF BOUNDRELOCS=0 %THEN FILESIZE=FILESIZE+8 { Allow for header first time } { Note that relocation given by AreaLoc:BaseLoc has been satisfied by binding. } HERE=ADICT+NDICT REC==RECORD(HERE) REC_LINK=BOUNDRELOCS BOUNDRELOCS=HERE REC_TGT=BASELOC REC_HOST=AREALOC FILESIZE=FILESIZE+8 NDICT=NDICT+SIZEOF(REC) %END { of PBReloc } %EXTERNALROUTINE PDXREF(%INTEGER TYPE,AREA,DISP, %STRING (31) %NAME ENM) { Define an external data reference } { Relocate word at Disp in Area by external data ref ENm } { Type holds min size in lowest byte } %INTEGER I,J %RECORD (EDHEADFMT) %NAME HEAD %RECORD (EDREFFMT) %NAME REC %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("PDXRef(".AREAS(AREA)."/".HTOS(DISP,8)."->".ENM." ") %FINISH %FINISH { Note that Disp in Area is to be relocated by data xref Name } I=ADDR(ENM)+1 J=LENGTH(ENM) UCTRANSLATE(I,J) I=XDLIST %WHILE I#0 %CYCLE HEAD==RECORD(I) %IF HEAD_NAME=ENM %THEN ->FOUND I=HEAD_LINK %REPEAT %IF NDICT+SIZEOF(HEAD)>TOPDICT %THEN PERROR("Table overflow",1) I=ADICT+NDICT HEAD==RECORD(I) HEAD_LINK=XDLIST HEAD_LEN=TYPE HEAD_NAME=ENM XDLIST=I FILESIZE=FILESIZE+((20+LENGTH(ENM))&(\3)) NDICT=NDICT+SIZEOF(HEAD) FOUND: %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) I=ADICT+NDICT REC==RECORD(I) REC_LINK=HEAD_XDLINK HEAD_XDLINK=I REC_ADISP=(AREA<<24)!DISP FILESIZE=FILESIZE+4 NDICT=NDICT+SIZEOF(REC) %END { of PDXRef } %EXTERNALROUTINE PDATAENTRY(%STRING (255) %NAME NAME, %INTEGER AREA,MAXLEN,DISP) %INTEGER I,J %RECORD (EDDEFFMT) %NAME REC %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("P Data Entry ".NAME.AREAS(AREA)."+".HTOS(DISP,8)." ") %FINISH %FINISH { Note an ext data EP at Disp in Area } I=ADDR(NAME)+1 J=LENGTH(NAME) UCTRANSLATE(I,J) %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) I=ADICT+NDICT REC==RECORD(I) REC_LINK=XDEPLIST REC_PROPS=(AREA<<24)!MAXLEN REC_DISP=DISP REC_NAME=NAME XDEPLIST=I FILESIZE=FILESIZE+((20+LENGTH(NAME))&(\3)) NDICT=NDICT+SIZEOF(REC) %END { of PDataEntry } ! The next five routines deal with PROCEDURES %EXTERNALROUTINE PENTRY(%INTEGER INDEX, %STRING (255) %NAME IDEN) { Sideways entry into procedure. Zero Index means overwrite main EP } %INTEGER I,PROPS,J %RECORD (CODEFRAGFMT) %NAME CREC %RECORD (ECDEFFMT) %NAME REC1,REC2 %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("PEntry ".IDEN." ".ITOS(INDEX)." ") %FINISH %FINISH I=ADDR(IDEN)+1 J=LENGTH(IDEN) UCTRANSLATE(I,J) FLUSHCODE(FRAGMENT) %IF XPROCLIST#0 %AND INDEX=0 %THENSTART { Redefine main entry point as this one } I=XPROCLIST REC1==RECORD(I) %IF REC1_CA<0 %THENSTART XPROCLIST=REC1_LINK %FINISHELSESTART I=REC1_LINK %WHILE I#0 %CYCLE REC2==RECORD(I) %IF REC2_CA<0 %THENSTART REC1_LINK=REC2_LINK ->FOUND %FINISH REC1==REC2 I=REC1_LINK %REPEAT FOUND: %FINISH %FINISH { Note a sideways entry here } %IF INDEX=0 %THEN PROPS=X'80000000' %ELSE PROPS=0 %IF NDICT+SIZEOF(REC1)>TOPDICT %THEN PERROR("Table overflow",1) I=ADICT+NDICT REC2==RECORD(I) REC2_LINK=XPROCLIST CREC==RECORD(THISBASECA) REC2_W0=CREC_CA REC2_W1=0 REC2_CA=CA!PROPS REC2_PARAMW=-1 REC2_TYPE=ECDEFTYPE %IF PROPS#0 %THEN REC2_NAME="S#GO" %ELSE REC2_NAME<-IDEN NDICT=NDICT+SIZEOF(REC2) XPROCLIST=I %IF THRULINK#0 %THENSTART REC1==RECORD(THRULINK) REC1_THRULINK=I %FINISH REC2_THRULINK=0 THRULINK=I %IF THRULIST=0 %THEN THRULIST=I { First on Ca ordered list } FILESIZE=FILESIZE+20+(LENGTH(IDEN)+4)&(\3) %END { of PEntry } %EXTERNALROUTINE PPROC(%STRING (31) %NAME NAME, %INTEGER PROPS,PARAMW, %INTEGERNAME ID) { Start a new procedure } { PROPS&1 = external } { PROPS>>31 = Main entry } %INTEGER TYPE,SAVE,DISP %INTEGER I,J %RECORD (CODEFRAGFMT) %NAME CREC %RECORD (ECDEFFMT) %NAME REC,REC1 CCOUNT(9)=CCOUNT(9)+1 PTURNC(9)=PTURNC(9)-PTURNSA %IF TRACING=ON %THENSTART %IF MON#0 %THEN PRINTSTRING(" proc: ".NAME." CA: ".HTOS(CA,8)." ") %FINISH I=ADDR(NAME)+1 J=LENGTH(NAME) UCTRANSLATE(I,J) CURLEXLEV=CURLEXLEV+1 %IF ID=-1 %THENSTART { No previous spec, so claim an Id } NEXTSYM=NEXTSYM+1 ID=NEXTSYM %FINISH %IF PROPS#0 %THENSTART { Note an external entry point at Ca corresponding to Name } FLUSHCODE(FRAGMENT) %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) I=ADICT+NDICT REC==RECORD(I) REC_LINK=XPROCLIST CREC==RECORD(THISBASECA) REC_W0=CREC_CA REC_W1=0 REC_CA=CA!((PROPS>>31)<<31) REC_PARAMW=PARAMW REC_TYPE=ECDEFTYPE REC_NAME<-NAME NDICT=NDICT+SIZEOF(REC) XPROCLIST=I %IF THRULINK#0 %THENSTART REC1==RECORD(THRULINK) REC1_THRULINK=I %FINISH REC_THRULINK=0 THRULINK=I %IF THRULIST=0 %THEN THRULIST=I { First on Ca ordered list } FILESIZE=FILESIZE+20+(LENGTH(NAME)+4)&(\3) %FINISH PTURNC(9)=PTURNC(9)+PTURNSA %END { of PProc } %EXTERNALROUTINE PPROCENTRY(%INTEGER CODEOFFSET,GLAOFFSET,EPOFFSET,PARAMW, %STRING (31) %NAME NAME) { Pass a complete procedure entry } %RECORD (ECDEFFMT) %NAME REC %INTEGER HERE %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) HERE=ADICT+NDICT REC==RECORD(HERE) REC_W0=CODEOFFSET REC_W1=GLAOFFSET REC_CA=EPOFFSET REC_PARAMW=PARAMW REC_NAME=NAME REC_LINK=XPROCLIST XPROCLIST=HERE NDICT=NDICT+SIZEOF(REC) FILESIZE=FILESIZE+20+(LENGTH(REC_NAME)+4)&(\3) %END { of PProcEntry } { Multiples of 4096 for head of Code } %CONSTINTEGERARRAY MULTIPLES(0:64)= 0, 1*4096, 2*4096, 3*4096, 4*4096, 5*4096, 6*4096, 7*4096, 8*4096, 9*4096,10*4096,11*4096,12*4096,13*4096,14*4096,15*4096,16*6096, 17*4096,18*4096,19*4096,20*4096,21*4096,22*4096,23*4096,24*4096, 25*4096,26*4096,27*4096,28*4096,29*4096,30*4096,31*4096,32*4096, 33*4096,34*4096,35*4096,36*4096,37*4096,38*4096,39*4096,40*4096, 41*4096,42*4093,43*4096,44*4096,45*4096,46*4096,47*4096,48*4096, 49*4096,50*4096,51*4096,52*4096,53*4096,54*4096,55*4096,56*4096, 57*4096,58*4096,59*4096,60*4096,61*4096,62*4096,63*4096,64*4096 { The adjustment needed to compact the 3 * halfwords of NOP planted for } { every PCNOP with W = 8. Ca&7 is the adjusted offset from a double word } { boundary after compaction of preceding code. B is the byte offset given } { to the PCNOP call. } %CONSTINTEGERARRAY ADJ(0:15)= { Ca&7 = 0 } 0, 2, 4, 6, { Ca&7 = 2 } 6, 0, 2, 4, { Ca&7 = 4 } 4, 6, 0, 2, { Ca&7 = 6 } 2, 4, 6, 0 { B = 0 2 4 6 } %OWNINTEGER MINMULTS %ROUTINE PROCESSCODE { Do the jump preprocessing } %RECORD (CODEFRAGFMT) %NAME JREC,CREC %RECORD (LABFMT) %NAME LREC %RECORD (SWFMT) %NAME SW %RECORD (SWELFMT) %NAME SWEL %INTEGER CODEOFST %RECORD (MARKERFMT2) %NAME MREC %RECORD (USINGFMT) %NAME USED %INTEGER I,J,REG,ADJUSTMENT %INTEGER JAD,OFST %RECORD (ECDEFFMT) %NAME ECD %SWITCH THRUTYPE(FRAGMENT:MARKERTYPE) %ROUTINE JUMPFAIL(%STRING (255) ERRMESS) { Report a jump/label/using mismatch } IBMRECODE(JREC_CA+BUFFSTART-48,JREC_CA+BUFFSTART+48,JREC_CA-48) PRINTSTRING("Jump at ".HTOS(JREC_CA,8)." line ".ITOS(JREC_LINE)." Label at ".HTOS(LREC_CA,8)." ******** ".ERRMESS." ") %MONITOR %END { of JumpFail } FLUSHCODE(FRAGMENT) { Allow for the possible addition of multiples at head of code } %IF ADDMULTIPLES#0 %THENSTART CODEOFST=((CA//4096)<<2)+4 %IF CODEOFST<(MINMULTS<<2) %THEN CODEOFST=MINMULTS<<2 %IF NDICT+SIZEOF(JREC)+CODEOFST>TOPDICT %THEN PERROR("Table overflow",1) I=ADICT+NDICT JREC==RECORD(I) JREC_TYPE=FRAGMENT JREC_LEN=CODEOFST MOVE(CODEOFST,ADDR(MULTIPLES(0)),I+SIZEOF(JREC)) NDICT=NDICT+SIZEOF(JREC)+CODEOFST CREC==RECORD(THISBASECA) JREC_LINK=CREC_LINK CREC_LINK=I %FINISHELSE CODEOFST=0 ADJUSTMENT=CODEOFST I=THRULIST %WHILE I#0 %CYCLE J=SHORTINTEGER(I) ->THRUTYPE(J) THRUTYPE(FRAGMENT): JREC==RECORD(I) JREC_CA=JREC_CA+ADJUSTMENT I=JREC_THRULINK ->FINISHED THRUTYPE(JUMPTYPE):{ Process Jump entry } JREC==RECORD(I) J=I+SIZEOF(JREC) LREC==RECORD(JREC_LABEL) %IF JREC_USED#0 %THEN USED==RECORD(JREC_USED) %IF JREC_REG=0 %THENSTART %IF JREC_USED#0 %THENSTART { Try to use offset from a PUsing } %IF LREC_CA=USED_CA %THENSTART { Can use 2 byte jump} { BCR M,RUsed } JREC_REG=-USED_REG BYTEINTEGER(J+2)=RREQV(BYTEINTEGER(J)) BYTEINTEGER(J+3)=(BYTEINTEGER(J+1)&X'F0')!JREC_REG JREC_OFFSET=2 %FINISHELSEIF 0=SAFECODE %THEN %C JUMPFAIL("Using too far, label ".ITOS(LREC_LABEL)) %FINISH %FINISHELSESTART %IF LREC_CA>=SAFECODE %THEN JUMPFAIL("No using, label ".ITOS(LREC_LABEL)) %FINISH %FINISHELSESTART %IF JREC_REG>0 %THENSTART { 8 byte form was planted } LREC==RECORD(JREC_LABEL) %IF JREC_USED#0 %THENSTART USED==RECORD(JREC_USED) %IF LREC_CA=USED_CA %THENSTART { Shorten to 2 bytes } { BCR M,RUsed } BYTEINTEGER(J+6)=RREQV(BYTEINTEGER(J+4)) BYTEINTEGER(J+7)=(BYTEINTEGER(J+5)&X'F0')!USED_REG JREC_REG=-USED_REG-100 { To distinguish from 4 byte form } JREC_OFFSET=6 %FINISHELSEIF 00 %AND 0<(LREC_CA-JREC_CA-2)<4096 %THEN %C %START { Try for 6 byte form } { BASR/BALR followed by BCR } J=J+2 %IF XAFLAG=1 %THENSTART BYTEINTEGER(J)=BASR %FINISHELSESTART BYTEINTEGER(J)=BALR %FINISH BYTEINTEGER(J+1)=JREC_REG<<4 JREC_USED=-1 JREC_REG=-JREC_REG JREC_OFFSET=2 %IF BYTEINTEGER(J+3)&15=12 %THEN BYTEINTEGER(J+3)=BYTEINTEGER(J+3)&X'F0' %FINISH %FINISH %FINISH JREC_CA=JREC_CA+ADJUSTMENT ADJUSTMENT=ADJUSTMENT-JREC_OFFSET I=JREC_THRULINK ->FINISHED THRUTYPE(CNOPTYPE):{ Process CNoOp entry } CREC==RECORD(I) CREC_CA=CREC_CA+ADJUSTMENT %IF CREC_W=4 %THENSTART %IF CREC_CA&3#CREC_B %THENSTART CREC_LEN=0 ADJUSTMENT=ADJUSTMENT-2 %FINISH %FINISHELSESTART %IF CREC_CA&7#CREC_B %THENSTART CREC_LEN=ADJ(CREC_B>>1+(CREC_CA&7)<<1) ADJUSTMENT=ADJUSTMENT+CREC_LEN-6 %FINISH %FINISH I=CREC_THRULINK ->FINISHED THRUTYPE(LABELTYPE):{ Process Label entry } LREC==RECORD(I) LREC_CA=LREC_CA+ADJUSTMENT I=LREC_THRULINK ->FINISHED THRUTYPE(ECDEFTYPE):{ Process external code EP entry } ECD==RECORD(I) ECD_CA=ECD_CA+ADJUSTMENT+TOTCA I=ECD_THRULINK ->FINISHED THRUTYPE(USINGTYPE):{ Process Using entry } USED==RECORD(I) USED_CA=USED_CA+ADJUSTMENT I=USED_THRULINK ->FINISHED THRUTYPE(SWINDTYPE):{ Process switch index entry } SWEL==RECORD(I) SWEL_CA=SWEL_CA+ADJUSTMENT I=SWEL_THRULINK ->FINISHED THRUTYPE(MARKERTYPE):{ Process a code marker for a fixup } MREC==RECORD(I) MREC_CA=MREC_CA+ADJUSTMENT I=MREC_THRULINK ->FINISHED THRUTYPE(*):{ Should not be on list } PERROR("Wrong type on ThruList, no ".ITOS(INTEGER(I)),0) FINISHED: %REPEAT { Now plug the missing fields at the jumps } I=CODELIST %WHILE I#0 %CYCLE JREC==RECORD(I) %IF JREC_TYPE=JUMPTYPE %THENSTART %IF JREC_LABEL=0 %THEN JUMPFAIL("Missing label for jump.") LREC==RECORD(JREC_LABEL) JAD=I+SIZEOF(JREC)+JREC_OFFSET REG=JREC_REG %IF REG=0 %THENSTART %IF BYTEINTEGER(JAD+1)&15=12 %THEN BYTEINTEGER(JAD+1)=BYTEINTEGER(JAD+1)&X'F0' OFST=LREC_CA BYTEINTEGER(JAD+2)=X'C0'!((OFST>>8)&255) BYTEINTEGER(JAD+3)=OFST&255 %FINISHELSESTART %IF REG<0 %THENSTART REG=-REG %IF JREC_USED>0 %THENSTART %IF REG=12 %THEN OFST=LREC_CA %ELSESTART USED==RECORD(JREC_USED) OFST=LREC_CA-USED_CA %FINISH %FINISHELSESTART JAD=JAD+2 OFST=LREC_CA-JREC_CA-2 %FINISH %IF OFST>>12#0 %THEN JUMPFAIL("Offset too large for Using") BYTEINTEGER(JAD+2)=(REG<<4)!(OFST>>8) BYTEINTEGER(JAD+3)=OFST&255 %FINISHELSESTART { 8 byte case } OFST=LREC_CA BYTEINTEGER(JAD+3)=(OFST>>12)<<2 BYTEINTEGER(JAD+6)=BYTEINTEGER(JAD+6)!((OFST>>8)&15) BYTEINTEGER(JAD+7)=OFST&255 %FINISH %FINISH %FINISHELSEIF JREC_TYPE#FRAGMENT %AND JREC_TYPE#ASTART %AND JREC_TYPE#CNOPTYPE %THEN %C PERROR("Wrong type for code",0) I=JREC_LINK %REPEAT { Locate switch labels for current code body } I=SWLIST %WHILE I#CURRSWEND %CYCLE SW==RECORD(I) J=SW_LABS %WHILE J#0 %CYCLE SWEL==RECORD(J) %IF SWEL_TYPE=SWINDTYPE %THENEXIT %IF LOCATEL(SWEL_LAB,I)#0 %THEN %C PERROR("Label missing for switch ".ITOS(SW_SAD)." element no ".ITOS %C (SWEL_INDEX)." label no ".ITOS(SWEL_LAB),0) SWEL_LAB=I J=SWEL_LINK %REPEAT I=SW_LINK %REPEAT CURRSWEND=SWLIST { set backstop for next body of code } CA=(CA+ADJUSTMENT+3)&(\3) %IF NDICT+SIZEOF(JREC)>TOPDICT %THEN PERROR("Table overflow",1) I=ADICT+NDICT JREC==RECORD(I) NDICT=NDICT+SIZEOF(JREC) CREC==RECORD(CODELINK) CREC_LINK=I CODELINK=I TOTCA=TOTCA+CA JREC_CA=TOTCA JREC_TYPE=ASTART CA=0 LASTUSED=0 LFIXUPS=0 THRULIST=0 THRULINK=0 ADJUSTMENT=0 THISBASECA=I GLOBALADJUSTMENT=GLOBALADJUSTMENT-ADJUSTMENT+CODEOFST MINMULTS=0 %END { of ProcessCode } %EXTERNALROUTINE PMINMULTIPLES(%INTEGER NMULTS) { Give minimum number of multiples required for non-code addressing } { Called immediately before PProcEnd or PTerminate, according to } { multiple handling option chosen. } MINMULTS=NMULTS %END { of PMinMultiples } %EXTERNALROUTINE PPROCEND { End of routine } %INTEGER AT,SIZE %INTEGER FLAG CCOUNT(10)=CCOUNT(10)+1 PTURNC(10)=PTURNC(10)-PTURNSA %IF TRACING=ON %THENSTART %IF MON#0 %THEN PRINTSTRING(" Proc END: ") %FINISH PERROR("PProcEnd - too many proc ends ",0) %IF CURLEXLEV=0 %IF PROCESSBYPROCS=1 %THEN PROCESSCODE CURLEXLEV=CURLEXLEV-1 PTURNC(10)=PTURNC(10)+PTURNSA %END { of PProcEnd } {* Put Interface - Miscellaneous *} %EXTERNALROUTINE PNEWAREA(%STRING (255) %NAME NAME, %INTEGER IIN,PROPS) { Note a new area defined by Props } %INTEGER HERE %RECORD (AREADEFFMT) %NAME REC %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("New area ".NAME." ".ITOS(IIN)." props ".HTOS(PROPS,8)." ") %FINISH %FINISH %IF NDICT+SIZEOF(REC)>TOPDICT %THEN PERROR("Table overflow",1) HERE=ADICT+NDICT REC==RECORD(HERE) REC_NAME=NAME REC_PROPS=PROPS REC_IIN=IIN REC_LINK=AREALIST AREALIST=HERE FILESIZE=FILESIZE+((24+LENGTH(NAME))&(\3)) NDICT=NDICT+SIZEOF(REC) %END { of PNewArea } %EXTERNALROUTINE PENDAREA(%INTEGER ID,LEN,PROPS) %INTEGER I %RECORD (AREADEFFMT) %NAME REC %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("End area ".ITOS(ID)."Len= ".ITOS(LEN)." Props= ".ITOS(PROPS)." ") %FINISH %FINISH I=AREALIST %WHILE I#0 %CYCLE REC==RECORD(I) %IF REC_IIN=ID %THEN ->FOUND I=REC_LINK %REPEAT PERROR("Undefined area ".ITOS(ID),0) FOUND: REC_LEN=LEN REC_PROPS=REC_PROPS!PROPS %END { of PEndCommon } %EXTERNALROUTINE PHISTORY(%INTEGER TYPE,AD) { Add a new history record to the object file } %SWITCH SW(0:10) %INTEGER HERE %RECORD (HFORMAT) %NAME REC,REC2 %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("History record type ".ITOS(TYPE)." ") %FINISH %FINISH %IF NDICT+SIZEOF(REC)+((BYTEINTEGER(AD)+4)&(\3))>TOPDICT %THEN PERROR("Table overflow",1) HERE=ADICT+NDICT REC==RECORD(HERE) %IF HISTLINK#0 %THENSTART REC2==RECORD(HISTLINK) REC2_LINK=HERE %FINISH REC_LINK=0 %IF HISTLIST=0 %THEN HISTLIST=HERE HISTLINK=HERE NDICT=NDICT+SIZEOF(REC)+((BYTEINTEGER(AD)+4)&(\3)) FILESIZE=FILESIZE+2+BYTEINTEGER(AD) REC_TYPE=TYPE REC_S=STRING(AD) %END { of PHistory } %EXTERNALROUTINE PFAULTY { Code generator has encountered a user error. Code requests should no } { longer be checked and minimum work done in PUT } FAULTY=1 %END { of PFaulty } %EXTERNALROUTINE PLINESTART(%INTEGER LINE) { Updates latest line number } ccount(11)=ccount(11)+1 pturnc(11)=pturnc(11)-pturnsa CURRENTLINE=LINE %IF TRACING=ON %THENSTART %IF LINE>=COMREGMAP(1)#0 %THEN MON=0 %ELSEIF LINE>=COMREGMAP(60)#0 %THEN MON=3 %IF MON#0 %THENSTART PRINTSTRING("Line no ".ITOS(CURRENTLINE)." ") %FINISH %FINISH FLUSHCODE(FRAGMENT) LASTCA=0 pturnc(11)=pturnc(11)+pturnsa %END { of PLineStart } %EXTERNALROUTINE PLINEDECODE { Decodes from last PLineStart or Decode } %INTEGER I %RECORD (CODEFRAGFMT) %NAME CREC %IF TRACE=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("Decode called ") %FINISH %FINISH %WHILE LASTCA#0 %CYCLE CREC==RECORD(LASTCA) I=LASTCA+SIZEOF(CREC)+CREC_OFFSET IBMRECODE(I,I+CREC_LEN,CREC_CA) LASTCA=CREC_LINK %REPEAT LASTCA=0 %END { of PLineDecode } %EXTERNALROUTINE PINITIALISE(%INTEGER LANGUAGE,PROPERTIES,VERSION) { Start code generation } %RECORD (CODEFRAGFMT) %NAME NEWAREC %STRING (255) S1,S2 %INTEGER I CCOUNT(0)=CCOUNT(0)+1 PTURNC(0)=PTURNC(0)-PTURNSA %IF LANGUAGE=-1 %THEN LANGVERS=STRING(VERSION) %ELSE LANGVERS="Unkown" %IF TRACING=ON %THENSTART MON=COMREGMAP(26)&3 %IF MON#0 %THENSTART PRINTSTRING(" PInitialise ".PUTVERSION." Vsn = ".LANGVERS." ") WRITE(LANGUAGE,8); WRITE(PROPERTIES,8); WRITE(VERSION,8) NEWLINE %FINISH %FINISH %IF LANGVERS->S1.("Imp80").S2 %THENSTART IMPFLAG=1 OUTFILE("T#CODE",1024*UINFI(6),ZERO,X'20000000',BUFFSTART,I) %IF I#0 %THENSTART FAILUREMESSAGE(I,S1) PERROR("Create work file fails ",1) %FINISH %FINISHELSESTART BUFFSTART=COMREGMAP(14) ! Fill(Integer(Buffstart+8)-32,Buffstart+32,0) IMPFLAG=0 %FINISH CODEBUFFER==RECORD(BUFFSTART+32) CODEBUFFER_LEN=0 LINKORMOD=0 MINMULTS=0 FAULTY=0 XAFLAG=1 CA=0 LASTCA=0 TOTCA=0 AREABUFFER==ARRAY(BUFFSTART+32+32+4096,AREABUFFARRAYFMT) %FOR I=GLA,1,CNST %CYCLE AREAHEAD(I)=0 AREATAIL(I)=0 INTLIST(I)=0 BUFFAD(I)=ADDR(AREABUFFER(I)_DATA(1)) %REPEAT NEXTSYM=0 ADICT=BUFFAD(CNST)+4096 TOPDICT=INTEGER(BUFFSTART+8)+BUFFSTART-ADICT BUFFSTART=BUFFSTART+32+SIZEOF(CODEBUFFER) MFIXUPS2=0 LFIXUPS=0 XPROCLIST=0 XREFLIST=0 BOUNDRELOCS=0 FFIXUPS=0 XDEPLIST=0 XDLIST=0 SWLIST=0 CURRSWEND=0 THRULIST=0 THRULINK=0 CURLABS=ADICT CURLABSTOP=((ADICT+4095)&(\4095))+(4*4096) NEWAREC==RECORD(CURLABSTOP) NDICT=SIZEOF(NEWAREC)+CURLABSTOP-ADICT CODELIST=CURLABSTOP CODELINK=CURLABSTOP NEWAREC_TYPE=ASTART THISBASECA=CURLABSTOP LASTUSED=0 AREALIST=0 HISTLINK=0 HISTLIST=0 INITLIST=0 FILESIZE=196 { Object file map + LDATA } %IF PROPERTIES&2#0 %THEN PROCESSBYPROCS=1 %IF PROPERTIES&1=0 %THENSTART ADDMULTIPLES=0 SAFECODE=4096 %FINISHELSESTART ADDMULTIPLES=1 SAFECODE=3840 %FINISH PHISTORY(9,ADDR(LANGVERS)) CURRENTLINE=0 PTURNC(0)=PTURNC(0)+PTURNSA %END { of PInitialise } %EXTERNALROUTINE SETBALR { Must be called by systems not having BASR, immediately after PInitialise } XAFLAG=0 %END { of SetBALR } %EXTERNALINTEGERFN PTERMINATE(%INTEGER ADAREASIZES,MSIZE) { Code generator closes with this call } { Set Code size etc. } { Object file record formats } %RECORDFORMAT PROCENTFMT(%INTEGER LINK,CODEOFFSET,GLAOFFSET,EPOFFSET,PARAMW, %STRING (31) NAME) %RECORDFORMAT PROCREFFMT(%INTEGER LINK,REFLOC, %STRING (31) NAME) %RECORDFORMAT FIXRECFMT(%INTEGER AREALOC,BASELOC) %RECORDFORMAT RELOCFMT(%INTEGER LINK,N, %RECORD (FIXRECFMT) %ARRAY RELOC(1:4000)) %RECORDFORMAT DATAENTFMT(%INTEGER LINK,DISP,LEN,AREA, %STRING (31) NAME) %RECORDFORMAT DATAHEADFMT(%INTEGER LINK,REFARRAY,LEN, %STRING (31) NAME) %RECORDFORMAT DATALISTFMT(%INTEGER N, %INTEGERARRAY REFLOC(1:4000)) %RECORDFORMAT AINITFMT(%INTEGER LINK,AREA,DISP,LEN,REP,ADR) %RECORDFORMAT ADEFFMT(%INTEGER LINK,AREA,LEN,PROPS) %RECORDFORMAT CDEFFMT(%INTEGER LINK,AREA,LEN,PROPS, %STRING (31) NAME) %RECORDFORMAT HISTFMT(%BYTEINTEGER TYPE, %STRING (*) S) { Object file record pointers } %RECORD (PROCENTFMT) %NAME CEP %RECORD (PROCREFFMT) %NAME CREF %RECORD (RELOCFMT) %NAME FHEAD %RECORD (DATAENTFMT) %NAME DEP %RECORD (DATAHEADFMT) %NAME DHEAD %RECORD (DATALISTFMT) %NAME DLIST %RECORD (AINITFMT) %NAME AINIT %RECORD (ADEFFMT) %NAME ADEF %RECORD (CDEFFMT) %NAME CDEF %RECORD (HISTFMT) %NAME HIST { Internal record pointers } %RECORD (INITFMT) %NAME INIT %RECORD (AREADEFFMT) %NAME AREAD %RECORD (HFORMAT) %NAME HISTY %RECORDFORMAT AFMT(%INTEGER START,LEN,PROPS) %RECORDFORMAT OBJMAPFMT(%INTEGER N, %RECORD (AFMT) %ARRAY AREA(CODE:CNST)) %INTEGERARRAYFORMAT LDATAFMT(0:14) %RECORD (OBJMAPFMT) OMAP %RECORD (OBJMAPFMT) %NAME OBJMAP %INTEGERARRAYNAME LDATA %INTEGER SAD,DEFAD,OUTAD,FLAG,CURAD %STRING (255) MESS,FILENAME %RECORD (ECREFFMT) %NAME ECR %RECORD (ECDEFFMT) %NAME ECD %RECORD (EDHEADFMT) %NAME EDH %RECORD (EDREFFMT) %NAME EDR %RECORD (EDDEFFMT) %NAME EDD %INTEGER HOSTAREA,HOSTOFST %RECORD (SWFMT) %NAME SW %RECORD (CODEFRAGFMT) %NAME CREC %RECORD (LABFMT) %NAME LREC %RECORD (SWELFMT) %NAME SWEL %RECORD (AREAFMT) %NAME AREC %RECORD (MARKERFMT2) %NAME MREC %RECORD (FIXUPFMT) %NAME FIX %RECORD (USINGFMT) %NAME USED %INTEGERARRAYFORMAT AREASIZEFM(1:11) %INTEGERARRAYNAME AREASIZES %INTEGERARRAY AREASTART(CODE:CNST) %INTEGER I,J,K %INTEGER JAD,OFST,ADJU,FIXAREA %ROUTINE FOLLOW(%INTEGER LINK, %INTEGERNAME HIGHEST) { Follow the index tree for a switch and fill in its table } %INTEGER I %RECORD (SWELFMT) %NAME EL EL==RECORD(LINK) %IF EL_LLINK#0 %THEN FOLLOW(EL_LLINK,HIGHEST) %IF SW_SIZE=4 %THEN INTEGER(SAD+4*(EL_INDEX-SW_LOWER))=EL_CA %ELSESTART BYTEINTEGER(SAD+2*(EL_INDEX-SW_LOWER))=EL_CA>>8 BYTEINTEGER(SAD+2*(EL_INDEX-SW_LOWER)+1)=EL_CA&255 %FINISH HIGHEST=EL_INDEX+1 %IF EL_RLINK#0 %THEN FOLLOW(EL_RLINK,HIGHEST) %END { of Follow } %IF TRACING=ON %THENSTART CCOUNT(1)=CCOUNT(1)+1 PTURNC(1)=PTURNC(1)-PTURNSA %IF MON#0 %THEN PRINTSTRING("P Terminate called ") %FINISH AREASIZES==ARRAY(ADAREASIZES,AREASIZEFM) %IF PROCESSBYPROCS=0 %THEN PROCESSCODE %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING(" *** Adjustment = ".ITOS(GLOBALADJUSTMENT)." ( ") PRINT(GLOBALADJUSTMENT/TOTCA*100,2,2) PRINTSTRING("% ) ") %FINISH %FINISH FILESIZE=((FILESIZE+3)&(\3))+1024; ! 1024 is temp to allow continuation { Calculate total object file size } {%if LinkorMod=0 %then} AREASIZES(CODE)=TOTCA %FOR I=CODE,1,CNST %CYCLE AREASIZES(I)=(AREASIZES(I)+3)&(\3) FILESIZE=FILESIZE+AREASIZES(I) %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING(AREAS(I)." ".ITOS(AREASIZES(I))." bytes ") %FINISH %FINISH %REPEAT %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("Total file size = ".ITOS(FILESIZE)." ") %FINISH %FINISH FILENAME=STRING(COMREGMAP(52)) %IF FAULTY#0 %THENRESULT=FAULTY %IF FILENAME=".NULL" %THENRESULT=FAULTY OUTFILE(FILENAME,FILESIZE,ZERO,ZERO,OUTAD,FLAG) %IF FLAG#0 %THENSTART FAILUREMESSAGE(FLAG,MESS) PERROR("Create object file fails ".MESS,1) %STOP %FINISH !? Fill(FileSize,OutAd,0) { Write out code list } OMAP=0 OMAP_AREA(CODE)_START=32 OMAP_AREA(CODE)_LEN=TOTCA OMAP_AREA(CODE)_PROPS=0 I=CODELIST AREASTART(CODE)=OUTAD+32 J=0 %WHILE I#0 %CYCLE CREC==RECORD(I) %IF CREC_TYPE=ASTART %THEN J=CREC_CA %ELSE %C MOVE(CREC_LEN,I+SIZEOF(CREC)+CREC_OFFSET,OUTAD+32+J+CREC_CA) I=CREC_LINK %REPEAT { Write out the other areas } %FOR J=2,1,9 %CYCLE K=NEXTAREA(J) I=NEXTAREA(J-1) FLUSHDATA(K) OMAP_AREA(K)_START=OMAP_AREA(I)_START+OMAP_AREA(I)_LEN OMAP_AREA(K)_LEN=AREASIZES(K) OMAP_AREA(K)_PROPS=APROPS(K) AREASTART(K)=AREASTART(I)+AREASIZES(I) I=INTLIST(K) %WHILE I#0 %CYCLE INIT==RECORD(I) %IF INIT_LEN=1 %THENSTART { Value not pointer } FILL(INIT_NCOPIES,AREASTART(K)+INIT_DISP,INTEGER(I+SIZEOF(INIT))) %FINISHELSESTART %FOR OFST=1,1,INIT_NCOPIES %CYCLE MOVE(INIT_LEN,I+SIZEOF(INIT)+((OFST-1)*INIT_LEN), AREASTART(K)+INIT_DISP+((OFST-1)*INIT_LEN)) %REPEAT %FINISH I=INIT_LINK %REPEAT I=AREAHEAD(K) %WHILE I#0 %CYCLE AREC==RECORD(I) MOVE(AREC_LEN,I+SIZEOF(AREC),AREASTART(K)+AREC_OFFSET) I=AREC_LINK %REPEAT %REPEAT I=NEXTAREA(9) CURAD=AREASTART(I)+AREASIZES(I) INTEGER(OUTAD+28)=CURAD-OUTAD OBJMAP==RECORD(CURAD) OBJMAP=OMAP OBJMAP_N=10 CURAD=CURAD+SIZEOF(OBJMAP) LDATA==ARRAY(CURAD,LDATAFMT) INTEGER(OUTAD+24)=CURAD-OUTAD LDATA(0)=14 CURAD=CURAD+60 { Fill in the switch tables } I=SWLIST %WHILE I#0 %CYCLE SW==RECORD(I) SAD=SW_SAD+AREASTART(SST) I=LOCATEL(SW_DEF,J) LREC==RECORD(J) %FOR J=0,1,SW_UPPER-SW_LOWER %CYCLE %IF SW_SIZE=4 %THEN INTEGER(SAD+J<<2)=LREC_CA %ELSESTART BYTEINTEGER(SAD+J<<1)=LREC_CA>>8 BYTEINTEGER(SAD+J<<1+1)=LREC_CA&255 %FINISH %REPEAT J=SW_LOWER %IF SW_LABS#0 %THENSTART SWEL==RECORD(SW_LABS) %IF SWEL_TYPE=SWINDTYPE %THENSTART FOLLOW(SW_LABS,J) %FINISHELSESTART J=SW_LABS %WHILE J#0 %CYCLE SWEL==RECORD(J) LREC==RECORD(SWEL_LAB) %IF SW_SIZE=4 %THENSTART INTEGER(SAD+((SWEL_INDEX-SW_LOWER)<<2))=LREC_CA %FINISHELSESTART BYTEINTEGER(SAD+((SWEL_INDEX-SW_LOWER)<<1))=LREC_CA>>8 BYTEINTEGER(SAD+((SWEL_INDEX-SW_LOWER)<<1)+1)=LREC_CA&255 %FINISH J=SWEL_LINK %REPEAT %FINISH %FINISH I=SW_LINK %REPEAT { Process outstanding lists of requests } I=XPROCLIST { Process external code EPs } %WHILE I#0 %CYCLE ECD==RECORD(I) CEP==RECORD(CURAD) CEP_LINK=LDATA(1) LDATA(1)=CURAD-OUTAD MOVE(17+LENGTH(ECD_NAME),ADDR(ECD_W0),ADDR(CEP_CODEOFFSET)) CURAD=CURAD+((24+LENGTH(ECD_NAME))&(\3)) I=ECD_LINK %REPEAT I=XREFLIST { Process external code refs } %WHILE I#0 %CYCLE ECR==RECORD(I) CREF==RECORD(CURAD) %IF ECR_GLAAD>0 %THENSTART CREF_LINK=LDATA(7) LDATA(7)=CURAD-OUTAD %FINISHELSESTART CREF_LINK=LDATA(8) LDATA(8)=CURAD-OUTAD ECR_GLAAD=ECR_GLAAD&X'FFFFFF' %FINISH CREF_REFLOC=(2<<24)!ECR_GLAAD CREF_NAME=ECR_NAME CURAD=CURAD+((LENGTH(ECR_NAME)+12)&(\3)) I=ECR_LINK %REPEAT I=FFIXUPS { Process word relocations } %IF I#0 %THENSTART FHEAD==RECORD(CURAD) FHEAD_LINK=LDATA(14) LDATA(14)=CURAD-OUTAD J=0 %WHILE I#0 %CYCLE FIX==RECORD(I) J=J+1 FHEAD_RELOC(J)_AREALOC=FIX_HOST FHEAD_RELOC(J)_BASELOC=FIX_TGT I=FIX_LINK %REPEAT FHEAD_N=J CURAD=CURAD+8+J<<3 %FINISH I=BOUNDRELOCS { Process word relocations } %IF I#0 %THENSTART FHEAD==RECORD(CURAD) FHEAD_LINK=LDATA(3) LDATA(3)=CURAD-OUTAD J=0 %WHILE I#0 %CYCLE FIX==RECORD(I) J=J+1 FHEAD_RELOC(J)_AREALOC=FIX_HOST FHEAD_RELOC(J)_BASELOC=FIX_TGT I=FIX_LINK %REPEAT FHEAD_N=J CURAD=CURAD+8+J<<3 %FINISH I=XDEPLIST { Process external data EPs } %WHILE I#0 %CYCLE DEP==RECORD(CURAD) EDD==RECORD(I) DEP_LINK=LDATA(4) LDATA(4)=CURAD-OUTAD DEP_DISP=EDD_DISP DEP_LEN=EDD_PROPS&X'FFFFFF' DEP_NAME=EDD_NAME DEP_AREA=EDD_PROPS>>24 CURAD=CURAD+((20+LENGTH(EDD_NAME))&(\3)) I=EDD_LINK %REPEAT I=XDLIST { Process external data refs } %WHILE I#0 %CYCLE EDH==RECORD(I) DHEAD==RECORD(CURAD) DHEAD_LINK=LDATA(9) LDATA(9)=CURAD-OUTAD CURAD=CURAD+((16+LENGTH(EDH_NAME))&(\3)) DHEAD_NAME=EDH_NAME J=EDH_XDLINK DHEAD_LEN=EDH_LEN EDR==RECORD(J) DHEAD_REFARRAY=CURAD-OUTAD DLIST==RECORD(CURAD) DLIST_N=0 %WHILE J#0 %CYCLE EDR==RECORD(J) DLIST_N=DLIST_N+1 DLIST_REFLOC(DLIST_N)=EDR_ADISP J=EDR_LINK %REPEAT CURAD=CURAD+(DLIST_N<<2)+4 I=EDH_LINK %REPEAT { Process area definitions } I=AREALIST %WHILE I#0 %CYCLE AREAD==RECORD(I) %IF AREAD_PROPS&3=0 %AND AREAD_IIN<255 %THENSTART ADEF==RECORD(CURAD) ADEF_LINK=LDATA(11) LDATA(11)=CURAD-OUTAD ADEF_AREA=AREAD_IIN ADEF_PROPS=AREAD_PROPS ADEF_LEN=AREAD_LEN CURAD=CURAD+16 %FINISHELSESTART CDEF==RECORD(CURAD) CDEF_LINK=LDATA(2) LDATA(2)=CURAD-OUTAD CDEF_AREA=AREAD_IIN CDEF_NAME=AREAD_NAME CDEF_PROPS=AREAD_PROPS CDEF_LEN=AREAD_LEN CURAD=CURAD+((20+LENGTH(AREAD_NAME))&(\3)) %FINISH I=AREAD_LINK %REPEAT { Process initialisations } I=INITLIST %WHILE I#0 %CYCLE INIT==RECORD(I) AINIT==RECORD(CURAD) AINIT_LINK=LDATA(13) LDATA(13)=CURAD-OUTAD AINIT_AREA=INIT_AREA AINIT_DISP=INIT_DISP AINIT_REP=INIT_NCOPIES AINIT_LEN=INIT_LEN CURAD=CURAD+24 %IF INIT_LEN=1 %THENSTART AINIT_ADR=BYTEINTEGER(I+SIZEOF(INIT)) %FINISHELSESTART AINIT_ADR=CURAD-OUTAD MOVE(AINIT_LEN,I+SIZEOF(INIT),CURAD) CURAD=CURAD+((INIT_LEN+3)&(\3)) %FINISH I=INIT_LINK %REPEAT { Process history records } I=HISTLIST %IF I#0 %THENSTART LDATA(12)=CURAD-OUTAD %WHILE I#0 %CYCLE HISTY==RECORD(I) BYTEINTEGER(CURAD)=HISTY_TYPE STRING(CURAD+1)=HISTY_S I=HISTY_LINK CURAD=CURAD+2+LENGTH(HISTY_S) %REPEAT %FINISH CURAD=(CURAD+3)&(\3) INTEGER(OUTAD)=CURAD-OUTAD INTEGER(OUTAD+4)=32 INTEGER(OUTAD+12)=1 %IF COMREGMAP(26)&256#0 %THEN IBMRECODE(OUTAD+32,OUTAD+32+TOTCA,0) %IF IMPFLAG#0 %THEN DISCONNECT("T#CODE",I) %IF I#0 %THENSTART FAILUREMESSAGE(I,MESS) PERROR("Cannot disconnect T#Code or T#Wrk ".MESS,1) %FINISH PTURNC(1)=PTURNC(1)+PTURNSA %FOR I=0,1,15 %CYCLE %IF CCOUNT(I)#0 %START PRINTSTRING(CHEADINGS(I)); WRITE(CCOUNT(I),6); WRITE(PTURNC(I),5) NEWLINE %FINISH %REPEAT %RESULT=FAULTY %END { of PTerminate } ! PGENERATE - FINAL PHASE OF COMPILATION IS CREATE OBJECT FILE %EXTERNALROUTINE PGENERATEOBJECT(%STRING (255) %NAME OBJFILENAME) { Not really needed on EMAS ?? } %END { of PGenerateObject } %EXTERNALROUTINE PMONON MON=1 %END { of PMonOn } %EXTERNALROUTINE PMONOFF MON=0 %END { of PMonOff } %EXTERNALROUTINE PTRACEON %END { of PTraceOn } %EXTERNALROUTINE PTRACEOFF %END { of PTraceOff } {* Pseudo - Operations *} %EXTERNALROUTINE PCNOP(%INTEGER B,W) { Matches CNOP in assembler manual } %INTEGER I %IF TRACING=ON %THENSTART %IF MON#0 %THENSTART PRINTSTRING("PCNOP (".ITOS(B).",".ITOS(W).") ") %FINISH %FINISH FLUSHCODE(CNOPTYPE) CODEBUFFER_W=W CODEBUFFER_B=B %FOR I=1,1,W>>1-1 %CYCLE PIXRR(BCR,0,0) %REPEAT %END { of PCNOP } %ENDOFFILE