%CONSTINTEGER EMAS=0,PERQ=1,SYS=perq
%EXTERNALROUTINE QCODE(%INTEGER START,FINISH,CA,MODE)
! %EXTERNALROUTINESPEC DUMP(%INTEGER A,B,C,D)
%IF SYS=EMAS %START; %SYSTEMROUTINESPEC PHEX(%INTEGER N) ; %FINISHELSESTART
%ROUTINE PHEX(%INTEGER N)
%CONSTBYTEINTEGERARRAY K(0:15)='0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
%HALFINTEGER I,J
%CYCLE J=1,-1,0
%CYCLE I=12,-4,0
PRINTSYMBOL(K((HALFINTEGER(ADDR(N)+J)>>I)&15))
%REPEAT
%REPEAT
%END
%FINISH
!*TOP
!****************************************************************************
!* *
!* PERQ QCODE DISSASSEMBLER
!* *
!****************************************************************************
!*
!*
!* MODE IS :-
! 1 - ASCII EQUIVELANT IS PRINTED
! 2 - NO HEX AD IS PRINTED
! 4 - DECIMAL AD IS PRINTED
! 8 - NO SEGMENT NUMBER IS GIVEN
! 16 - HEX EQUIVELANT IS PRINTED
! 32 - LINES ARE PADDED TO COMMON END POINT
!*
!* THIS ARRAY CONTAINS THE INSTRUCTION MNEMONICS FOR THE PERQ.
!* THE EIGTH CHARACTER CONTAINS THE LENGTH IN BYTES OF THE INSTRUCTION.
!* (EXCEPTION/ IF THIS IS NINE THEN SPECIAL HANDLING IS REQUIRED)
!* THE NEXT THREE DIGITS REVEAL THE TYPE OF THE FIRST THREE PARAMETERS.
!* 0 - NO PARAMATER
!* U - UNSIGNED BYTE
!* B - SIGNED BYTE
!* W - SIGNED 16 BIT WORD
!* D - DOUBLE WORD (32 BITS)
!*
!*
%CONSTSTRING(11) %ARRAY OPS(0:255) = %C
"LDC0 1000","LDC1 1000","LDC2 1000","LDC3 1000","LDC4 1000","LDC5 1000",
"LDC6 1000","LDC7 1000","LDC8 1000","LDC9 1000","LDC10 1000","LDC11 1000",
"LDC12 1000","LDC13 1000","LDC14 1000","LDC15 1000","LDCMO 1000","LDCB 2B00",
"LDCW 3W00","LSA 9U00","ROTSHI 2U00","STIND 1000","LDCN 1000","LDB 1000",
"STB 1000","LDCH 1000","LDP 1000","STP 1000","STCH 1000","EXGO 6WUW",
"LAND 1000","LOR 1000","LNOT 1000","EQUBOOL1000","NEQBOOL1000","LEQBOOL1000",
"LESBOOL1000","GEQBOOL1000","GTRBOOL1000","EQUI 1000","NEQI 1000","LEQI 1000",
"LESI 1000","GEQI 1000","GTRI 1000","**** 1000","**** 1000","**** 1000",
"**** 1000","**** 1000","**** 1000","EQUSTR 1000","NEQSTR 1000","LEQSTR 1000",
"LESSTR 1000","GEQSTR 1000","GTRSTR 1000","EQUBYT 2U00","NEQBYT 2U00","LEQBYT 2U00",
"LESBYT 2U00","GEQBYT 2U00","GTRBYT 2U00","EQUPOWR1000","NEQPOWR1000","LEQPOWR1000",
"SGS 1000","GEQPOWR1000","SRS 1000","EQUWORD2U00","NEQWORD2U00","ABI 1000",
"ADI 1000","NGI 1000","SBI 1000","MPI 1000","DVI 1000","MODI 1000",
"CHK 1000","**** 1000","**** 1000","**** 1000","**** 1000","**** 1000",
"**** 1000","**** 1000","**** 1000","**** 1000","INN 1000","UNI 1000",
"INT 1000","DIF 1000","EXIT 4WU0","NOOP 1000","REPL 1000","REPL2 1000",
"MMS 1000","MES 1000","LVRD 5WUU","LSSN 1000","XJP 9WWW","PSW 1000",
"RASTER 1000","STARTIO1000","**** 1000","INTOFF 1000","INTON 1000","LDLB 2U00",
"LDLW 3W00","LDL0 1000","LDL1 1000","LDL2 1000","LDL3 1000","LDL4 1000",
"LDL5 1000","LDL6 1000","LDL7 1000","LDL8 1000","LDL9 1000","LDL10 1000",
"LDL11 1000","LDL12 1000","LDL13 1000","LDL14 1000","LDL15 1000","LLAB 2U00",
"LLAW 3W00","STLB 2U00","STLW 3W00","STL0 1000","STL1 1000","STL2 1000",
"STL3 1000","STL4 1000","STL5 1000","STL6 1000","STL7 1000","LDOB 2U00",
"LDOW 3W00","LDO0 1000","LDO1 1000","LDO2 1000","LDO3 1000","LDO4 1000",
"LDO5 1000","LDO6 1000","LDO7 1000","LDO8 1000","LDO9 1000","LDO10 1000",
"LDO11 1000","LDO12 1000","LDO13 1000","LDO14 1000","LDO15 1000","LOAB 2U00",
"LOAW 3W00","STOB 2U00","STOW 3W00","STO0 1000","STO1 1000","STO2 1000",
"STO3 1000","STO4 1000","STO5 1000","STO6 1000","STO7 1000","MVBB 2U00",
"MVBW 1000","MOVB 2U00","MOVW 1000","INDB 2U00","INDW 3W00","LDIND 1000",
"SIND1 1000","SIND2 1000","SIND3 1000","SIND4 1000","SIND5 1000","SIND6 1000",
"SIND7 1000","LGAWW 5WW0","STMW 1000","STDW 1000","SAS 1000","ADJ 2U00",
"CALL 2U00","CALLV 1000","ATPB 2B00","ATPW 1000","WCS 1000","JCS 1000",
"LDGB 3UU0","LDGW 4UW0","LGAB 3UU0","LGAW 4UW0","STGB 3UU0","STGW 4UW0",
"**** 1000","**** 1000","RETURN 1000","MMS2 1000","MES2 1000","LDTP 1000",
"JMPB 2B00","JMPW 3W00","JFB 2B00","JFW 3W00","JTB 2B00","JTW 3W00",
"JEQB 2B00","JEQW 3W00","JNEB 2B00","JNEW 3W00","IXP 2U00","LDIB 3UU0",
"LDIW 4UW0","LIAB 3UU0","LIAW 4UW0","STIB 3UU0","STIW 4UW0","IXAB 2U00",
"IXAW 1000","IXA1 1000","IXA2 1000","IXA3 1000","IXA4 1000","TLATE1 1000",
"TLATE2 1000","TLATE3 1000","EXCH 1000","EXCH2 1000","INCB 2U00","INCW 3W00",
"CALLXB 3UU0","CALLXW 4WU0","LDMC 9U00","LDDC 5D00","LDMW 1000","LDDW 1000",
"STLATE 2U00","**** 1000","ENABLE 5WUU","RAISE 6WUW","LDAP 1000","**** 1000",
"**** 1000","**** 1000","**** 1000","**** 1000","ROPS 2U00","INCDDS 1000",
"LOPS 2U00","**** 1000","BREAK 1000","REFILL 1000"
!
%CONSTSTRING(7) %ARRAY SLOPS(0:14)= %C
"CVTLI","CVTL","ADL","NGL","SBL","MPL","DVL","MODL","ABL","EQULONG",
"NEQLONG","LEQLONG","LESLONG","GEQLONG","GTRLONG"
%CONSTSTRING(7) %ARRAY SROPS(0:15)= %C
"TNC","FLT","ADR","NGR","SBR","MPR","DVR","RND","ABR","EQUREAL","NEQREAL","LEQREAL","LESREAL",
"GEQREAL","GTRREAL","****"
!
%IF SYS=EMAS %START
%SYSTEMSTRINGFNSPEC ITOS(%INTEGER I)
%FINISHELSESTART
%STRING(15) %FN ITOS(%INTEGER K)
%INTEGER REM,NUM,NF
%STRING(15) STR
STR=""
%IF K<0 %START
NF=1
K = K *(-1)
%FINISH
%CYCLE
NUM=K
K = K//10
REM = NUM-(K*10)
STR = TOSTRING(REM+'0').STR
%IF K=0 %THEN %EXIT
%REPEAT
%IF NF=1 %THEN STR = "-".STR
%RESULT = STR
%END
%FINISH
%ROUTINESPEC PRINTLINE
%ROUTINESPEC PRAD(%INTEGER AD)
%STRING(4) %FNSPEC HTOS(%HALFINTEGER N)
%ROUTINESPEC PRAX(%INTEGER AD,LEN)
%CONSTINTEGER ASCII=1,NOHEXAD=2,DECAD=4,NOSEG=8,HEXEQUIV=16,PAD=32
%CONSTSTRING(1) %ARRAY HX(0:15)="0","1","2","3","4","5","6","7","8",
"9","A","B","C","D","E","F"
%BYTEINTEGERARRAYFORMAT BFM(0:10000)
%BYTEINTEGERARRAYNAME B,A,T
%INTEGER DISP,OPD
%HALFINTEGER OPDTYPE
%INTEGER MIN,MAX,CTLEN
%INTEGER PC,TOPPC,I,J,K
%HALFINTEGER OPCODE
%STRING(11) MNEMONIC
%OWNINTEGER OUTSTANDING=0
%OWNINTEGER LL=0
%INTEGER OLDMODE
%HALFINTEGER SYM
%INTEGER ADPC,JUMP,PR,PAR1,PAR3
%INTEGER TO
%INTEGER AD,SEG
%INTEGER INSL
%STRING(255) TEXT
%STRING(255) LINE
%STRING(6) NUM
%CONSTINTEGER LSA = 19 , LDMC = 236 , XJP = 100 , LDDC = 237, LOPS=252,ROPS=250
!
!
! PRINTSTRING("
! QCODE(")
! PHEX(START)
! SPACE
! PHEX(FINISH)
! SPACE
! PHEX(CA)
! PRINTSTRING(")")
! NEWLINE
! DUMP(START,FINISH,0,0)
SEG = (START)>>16
PC=0
%if finish<start %then toppc=finish %elsec
TOPPC = FINISH - START
%if sys=perq %then toppc=toppc*2
LL=0
B == ARRAY(START,BFM)
!
%WHILE PC < TOPPC %CYCLE
LINE=""
ADPC=START+PC+OUTSTANDING
OUTSTANDING=0
OPCODE = B(PC)
MNEMONIC = OPS(OPCODE)
LENGTH(MNEMONIC)=7
PRAD(PC+CA) ;!PRINT ADDRESS OF INSTRUCTION
LINE = LINE." "
DISP=1
A == ARRAY(ADDR(MNEMONIC),BFM)
INSL = A(8) - '0'
PR = INSL
%IF INSL = 9 %START ;! DEAL WITH INSTRUCTIONS OF VARIABLE LENGTH
%IF OPCODE=LDMC %THEN INSL=2+(B(PC+1)*2) %AND PR=2 %ELSESTART
! CHECK FOR WORD ALIGNED PARAMS
%IF (OPCODE=XJP %OR OPCODE=LSA ) %AND (PC+CA)&1=0 %THen disp=2
%IF OPCODE = XJP %START ;! CASE JUMP
MIN = (B(PC+2)<<8)!B(PC+1)
%IF MIN>>15# 0 %THEN MIN=MIN!X'FFFF0000'
MAX = (B(PC+4)<<8)!B(PC+3)
%IF MAX>>15#0 %THEN MAX=MAX!X'FFFF0000'
CTLEN= MAX-MIN+1
INSL = DISP+6+(CTLEN*2)
PR = DISP+6
%FINISHELSE %IF OPCODE = LSA %THEN INSL = DISP+1+B(PC+DISP) %AND PR=DISP+1
%FINISH
%FINISH
%IF SYS=EMAS %START
%IF ADPC+INSL>start+toppc+1 %AND toppc#1 %START
PRINTSTRING("
QCODE/ BAD INPUT - instruction at ")
PHEX(ADPC)
PRINTSTRING(" of length ")
WRITE(INSL,1)
PRINTSTRING(" bytes")
PRINTSTRING(" and finish ad =")
PHEX(FINISH)
NEWLINE
OUTSTANDING=(ADPC+INSL)-FINISH
%RETURN
%FINISH
%FINISH
%IF MODE&ASCII#0 %OR MODE&HEXEQUIV#0 %START
%IF INSL>PR %THEN PRAX(PC,PR) %ELSE PRAX(PC,INSL) ;! PRINT ASCII AND HEX EQUIVELANT
%FINISH
! %IF MODE&HEXEQUIV#0 %START
! LINE=LINE." " %FOR I=PR,1,9
! %FINISH
%IF OPCODE=LOPS %START ;! ESCAPETO LONG OPS
LINE=LINE." ".SLOPS(B(PC+1))
LL=LENGTH(LINE)+18
->NXTINT
%FINISH
%IF OPCODE=ROPS %START ;! ESCAPE TO REAL OPS
LINE = LINE." ".SROPS(B(PC+1))
LL = LENGTH(LINE)+18
->NXTINT
%FINISH
LINE = LINE." ".MNEMONIC." "
%IF 204<=OPCODE<=213 %THEN JUMP=1 %ELSE JUMP=0
LL=LENGTH(LINE)+18
%CYCLE I=9,1,11
OPDTYPE=A(I)
%EXIT %IF OPDTYPE='0'
OPD=B(PC+DISP)
%IF OPDTYPE='U' %START
NUM = ITOS(OPD)
DISP=DISP+1
->NXT
%FINISH%ELSE%IF OPDTYPE='B' %START
%IF OPD>>7#0 %THEN OPD=OPD!X'FFFFFF00'
NUM = ITOS(OPD)
DISP=DISP+1
->NXT
%FINISH%ELSE%IF OPDTYPE='W' %START
OPD=(B(PC+DISP+1)<<8)!OPD
%IF OPD>>15#0 %THEN OPD=OPD!X'FFFF8000'
NUM = ITOS(OPD)
DISP=DISP+2
->NXT
%FINISH%ELSEIF OPDTYPE='D' %START
OPD=(B(PC+DISP+1)<<24)!(OPD<<16)! %C
(B(PC+DISP+3)<<8)! %C
(B(PC+DISP+2))
LINE=LINE." "
%EXIT
%FINISH
NXT: %IF I=9 %THEN PAR1=OPD %ELSE PAR3=OPD
NUM = NUM ." " %WHILE LENGTH(NUM)<6
LINE = LINE.NUM
%REPEAT
%IF JUMP=1 %START
LINE=LINE." to "
TO = CA+PC+OPD +INSL
TO=TO&X'FFFF' ;! SUPPRESS PRINTING OF SEG NUMBER
PRAD(TO)
%FINISH
%IF OPCODE=LDDC %START
LINE=LINE.HTOS(HALFINTEGER(ADDR(OPD)+(2>>SYS)))
LINE=LINE.HTOS(HALFINTEGER(ADDR(OPD)))
%FINISH
%IF OPCODE=LSA %START
T == ARRAY(ADDR(TEXT),BFM)
T(I)=B(PC+DISP+I-1) %FOR I=0,1,PAR1+1
%CYCLE I=0,1,LENGTH(TEXT)
T(I+1)='.' %UNLESS 32<=T(I+1)<=123
%REPEAT
LINE=LINE." """.TEXT.""""
%FINISH
PRINTLINE
LINE=""
%IF SYS=EMAS %START
%IF OPCODE=XJP %START
J=ADPC+DISP ;! START AD OF CASE BLOCK
%CYCLE I=MIN,1,MAX
LINE=LINE." ".ITOS(I)." to "
AD = J+((I-MIN)*2)
K = BYTEINTEGER(AD)!(BYTEINTEGER(AD+1)<<8)
%IF K>>15#0 %THEN K=K!X'FFFF0000'
PRAD(PC+CA+K)
PRINT LINE
LINE=""
%REPEAT
LINE = " or default to "
PRAD(PC+CA-2+PAR3)
PRINT LINE
LINE=""
%FINISH
!
! PRINT OUT REMAINDER OF LARGE INSTRUCTIONS
!
%IF OPCODE=LDMC %OR MODE&ASCII#0 %OR MODE&HEXEQUIV#0 %START
J=INSL-PR
I=0
AD = CA+PC+PR
OLDMODE=MODE
MODE=MODE!HEXEQUIV
%WHILE I<J %CYCLE
PRAD(AD)
LINE=LINE." "
%IF J-I>7 %THEN PRAX(AD-CA,8) %ELSE PRAX(AD-CA,J-I)
AD=AD+8
I=I+8
PRINTLINE
LINE=""
%REPEAT
MODE=OLDMODE
%FINISH
%FINISH
NXTINT:
PC=PC+INSL
PRINTLINE %UNLESS LINE=""
%REPEAT
%RETURN
!!
!!
%ROUTINE PRINTLINE
PRINTSTRING("
".LINE)
%IF MODE&PAD#0 %AND LENGTH(LINE)<LL %THEN SPACES(LL-LENGTH(LINE))
%IF MODE<0 %THEN PRINTSTRING("!")
%END
%ROUTINE PRAD(%INTEGER A)
%STRING(9) S
%INTEGER SEG,AD,I
!
SEG = A>>16
A= A&X'FFFF'
%IF SEG#0 %AND MODE&NOSEG=0 %then LINE=LINE.HTOS(SEG)."/"
%IF MODE&NOHEXAD=0 %START
LINE=LINE.HTOS(A)
%FINISH
%IF MODE&DECAD#0 %START
S=" (".ITOS(A).")"
S=S." " %WHILE LENGTH(S)<8
LINE=LINE.S
%FINISH
%END ;! OF PRAD
!
!
%ROUTINE PRAX(%INTEGER A,LEN)
%INTEGER I,SYM,AD,J
!
%if mode&ascii#0 %start
I=0
%CYCLE
SYM = B(A+I)
%IF 32<=SYM<=123 %THEN LINE=LINE.TOSTRING(SYM) %ELSE LINE=LINE."."
I=I+1
%REPEAT %UNTIL I=LEN
J=I&7
%IF J=0 %THEN J=8
LINE=LINE." " %AND J=J+1 %WHILE J<10
%finish
%if mode&hexequiv#0 %start
line = line." "
i=0
%cycle
sym=b(a+i)
line=line.hx(sym>>4).hx(sym&15)
i=i+1
%repeat %until i=len
j=i&7
%if j=0 %then j=8
line=line." " %and j=j+1 %while j<10
%finish
%END ;! OF PRAX
%STRING(4) %FN HTOS(%HALFINTEGER N)
%INTEGER I,J,L
%STRING(4) S
S=""
%CYCLE I=12,-4,0
J=N
L=0
J=J>>1 %AND L=L+1 %WHILE I>L
J=J&15
S = S.HX(J)
%REPEAT
%RESULT=S
%END
%END ;! OF QCODE
!
!
!
%ENDOFFILE