From a54514d56f21cfc9efd8f537b009d4fa55e0e28f Mon Sep 17 00:00:00 2001 From: keie Date: Mon, 2 Jul 1984 15:46:59 +0000 Subject: [PATCH] Not in the initial distribution. --- util/ass/asprint.p | 384 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 384 insertions(+) create mode 100644 util/ass/asprint.p diff --git a/util/ass/asprint.p b/util/ass/asprint.p new file mode 100644 index 000000000..9f9c409f1 --- /dev/null +++ b/util/ass/asprint.p @@ -0,0 +1,384 @@ +# +{$d+} +program asprint(prog,output); + +const + + { header words } + NTEXT = 1; + NDATA = 2; + NPROC = 3; + ENTRY = 4; + NLINE = 5; + SZDATA = 6; + + escape1 = 254; { escape to secondary opcodes } + escape2 = 255; { escape to tertiary opcodes } + +type + byte= 0..255; { memory is an array of bytes } + adr= {0..maxadr} long; { the range of addresses } + word= {0..maxuint} long;{ the range of unsigned integers } + size= 0..32766; { the range of sizes is the positive offsets } + sword= {-signbit..maxsint} long; { the range of signed integers } + full= {-maxuint..maxuint} long; { intermediate results need this range } + double={-maxdbl..maxdbl} long; { double precision range } + insclass=(prim,second,tert); { tells which opcode table is in use } + instype=(implic,explic); { does opcode have implicit or explicit operand } + iflags= (mini,short,sbit,wbit,zbit,ibit); + ifset= set of iflags; + + mnem = ( NON, + AAR, ADF, ADI, ADP, ADS, ADU,XAND, ASP, ASS, BEQ, + BGE, BGT, BLE, BLM, BLS, BLT, BNE, BRA, CAI, CAL, + CFF, CFI, CFU, CIF, CII, CIU, CMF, CMI, CMP, CMS, + CMU, COM, CSA, CSB, CUF, CUI, CUU, DCH, DEC, DEE, + DEL, DUP, DUS, DVF, DVI, DVU, EXG, FEF, FIF, FIL, + GTO, INC, INE, INL, INN, IOR, LAE, LAL, LAR, LDC, + LDE, LDF, LDL, LFR, LIL, LIM, LIN, LNI, LOC, LOE, + LOF, LOI, LOL, LOR, LOS, LPB, LPI, LXA, LXL, MLF, + MLI, MLU, MON, NGF, NGI, NOP, RCK, RET, RMI, RMU, + ROL, ROR, RTT, SAR, SBF, SBI, SBS, SBU, SDE, SDF, + SDL,XSET, SIG, SIL, SIM, SLI, SLU, SRI, SRU, STE, + STF, STI, STL, STR, STS, TEQ, TGE, TGT, TLE, TLT, + TNE, TRP, XOR, ZEQ, ZER, ZGE, ZGT, ZLE, ZLT, ZNE, + ZRE, ZRF, ZRL); + + dispatch = record + iflag: ifset; + instr: mnem; + case instype of + implic: (implicit:sword); + explic: (ilength:byte); + end; + +var + { variables indicating the size of words and addresses } + wsize: integer; { number of bytes in a word } + asize: integer; { number of bytes in an address } + pdsize: integer; { size of procedure descriptor in bytes = 2*asize } + + pc,lb,sp,hp,pd: adr; { internal machine registers } + i: integer; { integer scratch variable } + s,t :word; { scratch variables } + sz:size; { scratch variables } + ss,st: sword; { scratch variables } + k :double; { scratch variables } + j:size; { scratch variable used as index } + a,b:adr; { scratch variable used for addresses } + dt,ds:double; { scratch variables for double precision } + found:boolean; { scratch } + opcode: byte; + iclass: insclass; + dispat: array[insclass, byte] of dispatch ; + insr: mnem; { holds the instructionnumber } + header: array[1..8] of adr; + + prog: file of byte; { program and initialized data } + +procedure getit; { start the ball rolling } +var cset:set of char; + f:ifset; + insno:byte; + nops:integer; + opcode:byte; + i,j,n:integer; + wtemp:sword; + count:integer; + repc:adr; + nexta,firsta:adr; + elem:byte; + amount,ofst:size; + c:char; + + function readb(n:integer):double; + var b:byte; + begin + if eof(prog) then + begin writeln('Premature EOF on EM load file') ; halt end; + read(prog,b); if n>1 then readb:=readb(n-1)*256+b else readb:=b + end; + + function readbyte:byte; + begin readbyte:=readb(1) end; + + procedure skipbyte; + var dummy: byte; + begin dummy:=readb(1) end; + + function readword:word; + begin readword:=readb(wsize) end; + + function readadr:adr; + begin readadr:=readb(asize) end; + + function ifind(ordinal:byte):mnem; + var loopvar:mnem; + found:boolean; + begin ifind:=NON; + loopvar:=insr; found:=false; + repeat + if ordinal=ord(loopvar) then + begin found:=true; ifind:=loopvar end; + if loopvar<>ZRL then loopvar:=succ(loopvar) else loopvar:=NON; + until found or (loopvar=insr) ; + end; + + procedure readhdr; + type hdrw=0..32767 ; { 16 bit header words } + var hdr: hdrw; + i: integer; + begin + for i:=0 to 7 do + begin hdr:=readb(2); + case i of + 0: if hdr<>3757 then { 07255 } + begin writeln('Not an em load file'); halt end; + 1: writeln('Test flags: ',hdr); + 2: if hdr<>0 then + begin writeln('Unsolved references: ',hdr) end; + 3: if hdr<>3 then + begin writeln('Incorrect load file version') end; + 4: wsize:=hdr ; + 5: begin asize:=hdr ; pdsize:= asize+asize end; + 6,7: + if hdr<>0 then + begin writeln('First header entry ',i,', is ',hdr) end; + end + end; + writeln('word size',wsize,', pointer size',asize) + end; + + procedure noinit; + begin writeln('Illegal initialization'); halt end; + + procedure readint(a:adr;s:size); + const mrange = 4; + var i:size; + val:double; + cont: array[1..mrange] of byte; + begin { construct integer out of byte sequence } + if s<=mrange then + begin + for i:=1 to s do cont[i]:=readbyte ; + if cont[s]>=128 then val:=cont[s]-256 else val:=cont[s]; + for i:= s-1 downto 1 do val:= val*256 + cont[i]; + writeln(', value ',val) + end + else + begin + write(', bytes(little endian) '); + for i:=1 to s do write(readbyte:4) ; + writeln + end + end; + + procedure readuns(a:adr;s:size); + const mrange=3; + var i:size; + val:double; + cont: array[1..mrange] of byte; + begin { construct unsigned integer out of byte sequence } + if s<=mrange then + begin + for i:=1 to s do cont[i]:=readbyte ; + val:=0; + for i:= s downto 1 do val:= val*256 + cont[i]; + writeln(', value ',val) + end + else + begin + write(', bytes(little endian) '); + for i:=1 to s do write(readbyte:4) ; + writeln + end + end; + + procedure readfloat(a:adr;s:size); + var i:size; b:byte; + begin { construct float out of string} + i:=0; + repeat { eat the bytes, construct the value and intialize at a } + write(chr(readbyte)); i:=i+1; + until b=0 ; + end; + +begin + +#ifdef INSRT + { initialize tables } + for iclass:=prim to tert do + for i:=0 to 255 do + with dispat[iclass][i] do + begin instr:=NON; iflag:=[zbit] end; + + { read instruction table file. see appendix B } + { The table read here is a simple transformation of the table on page xx } + { - instruction names were transformed to numbers } + { - the '-' flag was transformed to an 'i' flag for 'w' type instructions } + { - the 'S' flag was added for instructions having signed operands } + reset(tables); + insr:=NON; + repeat + read(tables,insno) ; cset:=[]; f:=[]; + insr:=ifind(insno); + if insr=NON then begin writeln('Incorrect table'); halt end; + repeat read(tables,c) until c<>' ' ; + repeat + cset:=cset+[c]; + read(tables,c) + until c=' ' ; + if 'm' in cset then f:=f+[mini]; + if 's' in cset then f:=f+[short]; + if '-' in cset then f:=f+[zbit]; + if 'i' in cset then f:=f+[ibit]; + if 'S' in cset then f:=f+[sbit]; + if 'w' in cset then f:=f+[wbit]; + if (mini in f) or (short in f) then read(tables,nops) else nops:=1 ; + readln(tables,opcode); + if ('4' in cset) or ('8' in cset) then + begin iclass:=tert end + else if 'e' in cset then + begin iclass:=second end + else iclass:=prim; + for i:=0 to nops-1 do + begin + with dispat[iclass,opcode+i] do + begin + iflag:=f; instr:=insr; + if '2' in cset then ilength:=2 + else if '4' in cset then ilength:=4 + else if '8' in cset then ilength:=8 + else if (mini in f) or (short in f) then + begin + if 'N' in cset then wtemp:=-1-i else wtemp:=i ; + if 'o' in cset then wtemp:=wtemp+1 ; + if short in f then wtemp:=wtemp*256 ; + implicit:=wtemp + end + end + end + until eof(tables); + +#endif + { read in program text, data and procedure descriptors } + reset(prog); + readhdr; { verify first header } + for i:=1 to 8 do header[i]:=readadr; { read second header } + writeln('textsize ',header[NTEXT],', datasize ',header[SZDATA]); + writeln('data descriptors: ',header[NDATA]); + writeln('procedure descriptors: ',header[NPROC]); + writeln('entry procedure: ',header[ENTRY]); + if header[7]<>0 then writeln('Second header entry 7 is ',header[7]); + if header[8]<>0 then writeln('Second header entry 8 is ',header[8]); + { read program text } + for i:=0 to header[NTEXT]-1 do skipbyte; + { read data blocks } + writeln; writeln('Data descriptors:'); + nexta:=0; + for i:=1 to header[NDATA] do + begin + n:=readbyte; + write(nexta:5,'- '); + if n<>0 then + begin + elem:=readbyte; firsta:=nexta; + case n of + 1: { uninitialized words } + begin + writeln(elem,' uninitialised word(s)'); + nexta:= nexta+ elem*wsize ; + end; + 2: { initialized bytes } + begin + write(elem,' initialised byte(s)'); + for j:=1 to elem do + begin + if j mod 10 = 1 then + begin writeln ; write(nexta:6,':') end ; + write(readbyte:4); nexta:=nexta+1 + end; + writeln + end; + 3: { initialized words } + begin + write(elem,' initialised word(s)'); + for j:=1 to elem do + begin + if j mod 8 = 1 then + begin writeln ; write(nexta:6,':') end ; + write(readword:9); nexta:=nexta+wsize + end; + writeln + end; + 4,5: { instruction and data pointers } + begin + if n=4 then + write(elem,' initialised data pointers') + else + write(elem,' initialised instruction pointers'); + for j:=1 to elem do + begin + if j mod 8 = 1 then + begin writeln ; write(nexta:6,':') end ; + write(readadr:9); nexta:=nexta+asize + end; + writeln + end; + 6: { signed integers } + begin + write(elem,'-byte signed integer '); + readint(nexta,elem); nexta:=nexta+elem + end; + 7: { unsigned integers } + begin + write(elem,'-byte unsigned integer '); + readuns(nexta,elem); nexta:=nexta+elem + end; + 8: { floating point numbers } + begin + write(elem,'-byte floating point number '); + readfloat(nexta,elem); nexta:=nexta+elem + end; + end + end + else + begin + repc:=readadr; + amount:=nexta-firsta; + writeln(repc,' copies of the data from ',firsta:2,' to ',nexta:2); + nexta:= nexta + repc*amount ; + end + end; + if header[SZDATA]<>nexta then writeln('Data initialization error'); + { read descriptor table } + pd:=header[NTEXT]; + for i:=1 to header[NPROC]*pdsize do skipbyte; +end; + +begin getit; +#ifdef RTC + repeat + opcode := nextpc; { fetch the first byte of the instruction } + if opcode=escape1 then iclass:=second + else if opcode=escape2 then iclass:=tert + else iclass:=prim; + if iclass<>prim then opcode := nextpc; + with dispat[iclass][opcode] do + begin insr:=instr; + if not (zbit in iflag) then + if ibit in iflag then k:=pop else + begin + if mini in iflag then k:=implicit else + begin + if short in iflag then k:=implicit+nextpc else + begin k:=nextpc; + if (sbit in iflag) and (k>=128) then k:=k-256; + for i:=2 to ilength do k:=256*k + nextpc + end + end; + if wbit in iflag then k:=k*wsize; + end + end; +#endif +end. -- 2.34.1