Hebdogiciel n°71

 

Note: Un fonction de sortie sur imprimante a été ajouté au listing.

10 !------------------------------------
20 !
30 !         DESASSEMBLEUR 7020
40 !         +SORTIE IMPRIMANTE
50 !
60 !------------------------------------
70 CALL TIT
80 K$=KEY$
90 I=(K$="1")+(K$="2")+(K$="3")+(K$="4"):IF I=0 THEN 80
100 CALL RAZ(4,4,15,33)
110 LOCATE (22,1):PRINT RPT$(" ",39)
120 CALL COLOR("0Yb")
130 LOCATE (22,5)
140 PRINT "IMPRIMANTE (OUI=1-NON=0)?";
150 ACCEPT VALIDATE("10")SIZE(1)NULL(0)BEEP;IMP
160 IF K$="1" THEN CALL NOTA(IMP):GOTO 70
170 IF K$="3" THEN CALL MOD(IMP):GOTO 70
180 DIM IN$(4,15),AA$(3),B$(5),B(3)
190 !Instructions TMS 7020
200 DATA NOP,IDLE,D,D,D,EINT,DINT,SETC,POPST,STSP,RETS,RETI,D,LDSP,PUSHST,D
210 DATA D,D,MOV,AND,OR,XOR,BTJO,BTJZ,ADD,ADC,SUB,SBB,MPY,CMP,DAC,DSB
220 DATA D,D,MOVP,ANDP,ORP,XORP,BTJOP,BTJZP,MOVD,D,LDA,STA,BR,CMPA,CALL,D
230 DATA D,D,DEC,INC,INV,CLR,XCHB,SWAP,PUSH,POP,DJNZ,DECD,RR,RRC,RL,RLC
240 DATA JMP,JN/JLT,JZ/JEQ,JC/JHS,JP/JGT,JPZ/JGE,JNZ/JNE,JNC/JL,TRAP,TSTA
250 DATA TSTB,CLRC,D,D,D,D
260 RESTORE 200:FOR I=0 TO 4
270 FOR J=0 TO 15
280 READ IN$(I,J)
290 IF K$="2"AND IN$(I,J)="D" THEN IN$(I,J)="ZZ"
300 NEXT:NEXT
310 IF K$="2" THEN CALL INS(IN$(,),IMP):PAUSE:GOTO 70
320 CLS "Ybb":CALL COLOR("0bY")
330 INPUT "ADRESSE DEPART hexa ";A$:I=LEN(A$):CALL TEST(A$):IF A$="" THEN 320
340 IF I>4 THEN 320 ELSE A$=RPT$("0",4-I)&A$
350 CLS "Ybb":CALL COLOR("0bY")
360 INPUT "ADRESSE FIN hexa ";I$:I=LEN(I$):CALL TEST(I$):IF I$="" THEN 350
370 IF I>4 THEN 350 ELSE I$=RPT$("0",4-I)&I$
380 CLS:CALL COLOR("0Yb")
390 CALL DECI(A$,AD,T):IF T=0 THEN 330
400 CALL DECI(I$,AF,T):IF T=0 THEN 330
410 T=0:FOR A=AD TO AF
420 CALL PEEK(A,H1)::C=H1:AD$=A$
430 J$,B$(1),B$(2),B$(3),B$(4),B$(5),AA$(1),AA$(2),AA$(3)="":N,B(1),B(2),B(3)=0
440 CALL HEX(H1,H2,C$)
450 F=-(H1=0)+2*(H1>0)*(H1<8)+3*(H1>7)*(H1<11)+4*(H1>10)*(H1<14)-6*(H1=15)
460 F=F-1+5*(H1=14)*(H2<8)+6*(H1=14)*(H2>7):IF F=5 THEN 530
470 IF H1=8 AND H2=0 THEN 1400
480 IF H1=9 AND H2=1 THEN 1420
490 IF H1=11 AND H2=0 THEN 1440
500 IF H1=12 AND H2<2 THEN 1450
510 IF H1=13 AND H2<2 THEN 1470
520 IF IN$(F,H2)="D"AND H1<>14 THEN I$="DATA":GOTO 1510
530 ON F+1 GOTO 540,560,880,1180,1310,1370,1370
540 !========  INSTRUCTIONS I  ========
550 N=0:I$=IN$(0,H2):GOTO 1510
560 !========  INSTRUCTIONS II  =======
570 I$=IN$(1,H2):ON H1 GOTO 580,620,660,700,750,790,830
580 IF H2=6 OR H2=7 THEN N=2 ELSE N=1
590 CALL LEC(N,A,A$,AA$(),B$(),B())
600 IF N=2 THEN CALL AH(B(2),A,B$()):J$="R"&STR$(B(1))&",A,@>"&B$(4):GOTO 1510
610 J$="R"&STR$(B(1))&",A":GOTO 1510
620 IF H2=6 OR H2=7 THEN N=2 ELSE N=1
630 CALL LEC(N,A,A$,AA$(),B$(),B())
640 IF N=2 THEN CALL AH(B(2),A,B$()):J$="%>"&B$(1)&",A,@>"&B$(4):GOTO 1510
650 J$="%>"&B$(1)&",A":GOTO 1510
660 IF H2=6 OR H2=7 THEN N=2 ELSE N=1
670 CALL LEC(N,A,A$,AA$(),B$(),B())
680 IF N=2 THEN CALL AH(B(2),A,B$()):J$="R"&STR$(B(1))&",B,@>"&B$(4):GOTO 1510
690 J$="R"&STR$(B(1))&",B":GOTO 1510
700 IF H2=6 OR H2=7 THEN N=3 ELSE N=2
710 CALL LEC(N,A,A$,AA$(),B$(),B())
720 IF N=2 THEN 740 ELSE CALL AH(B(3),A,B$()):J$="R"&STR$(B(1))&",R"&STR$(B(2))
730 J$=J$&",@>"&B$(4):GOTO 1510
740 J$="R"&STR$(B(1))&",R"&STR$(B(2)):GOTO 1510
750 IF H2=6 OR H2=7 THEN N=2 ELSE N=1
760 CALL LEC(N,A,A$,AA$(),B$(),B())
770 IF N=2 THEN CALL AH(B(2),A,B$()):J$="%>"&B$(1)&",B,@>"&B$(4):GOTO 1510
780 J$="%>"&B$(1)&",B":GOTO 1510
790 IF H2<6 OR H2>7 THEN 820
800 N=1:CALL LEC(N,A,A$,AA$(),B$(),B())
810 CALL AH(B(1),A,B$()):J$="B,A,@>"&B$(4):GOTO 1510
820 J$="B,A":GOTO 1510
830 IF H2=6 OR H2=7 THEN N=3 ELSE N=2
840 CALL LEC(N,A,A$,AA$(),B$(),B())
850 IF N=2 THEN 870 ELSE CALL AH(B(3),A,B$()):J$="%>"&B$(1)&",R"&STR$(B(2))
860 J$=J$&",@>"&B$(4):GOTO 1510
870 J$="%>"&B$(1)&",R"&STR$(B(2)):GOTO 1510
880 !========  INSTRUCTIONS III  ======
890 I$=IN$(2,H2):IF H2=8 THEN 1040 ELSE IF H2>9 THEN 1110
900 ON H1-7 GOTO 910,950,990
910 IF H2>5 THEN N=2 ELSE N=1
920 CALL LEC(N,A,A$,AA$(),B$(),B())
930 IF N=2 THEN CALL AH(B(2),A,B$()):J$="A,P"&STR$(B(1))&",@>"&B$(4):GOTO 1510
940 J$="A,P"&STR$(B(1)):GOTO 1510
950 IF H2>5 THEN N=2 ELSE N=1
960 CALL LEC(N,A,A$,AA$(),B$(),B())
970 IF N=2 THEN CALL AH(B(2),A,B$()):J$="B,P"&STR$(B(1))&",@>"&B$(4):GOTO 1510
980 J$="B,P"&STR$(B(1)):GOTO 1510
990 IF H2>5 THEN N=3 ELSE N=2
1000 CALL LEC(N,A,A$,AA$(),B$(),B())
1010 IF N=2 THEN 1030 ELSE CALL AH(B(3),A,B$()):J$="%>"&(B$(1))&",P"&STR$(B(2))
1020 J$=J$&",@>"&B$(4):GOTO 1510
1030 J$="%>"&(B$(1))&",P"&STR$(B(2)):GOTO 1510
1040 ON H1-7 GOTO 1050,1070,1090
1050 N=3:CALL LEC(N,A,A$,AA$(),B$(),B())
1060 J$="%>"&B$(1)&B$(2)&",R"&STR$(B(3)):GOTO 1510
1070 N=2:CALL LEC(N,A,A$,AA$(),B$(),B())
1080 J$="R"&STR$(B(1))&",R"&STR$(B(2)):GOTO 1510
1090 N=3:CALL LEC(N,A,A$,AA$(),B$(),B())
1100 J$="%>"&B$(1)&B$(2)&"(B),R"&STR$(B(3)):GOTO 1510
1110 ON H1-7 GOTO 1120,1140,1160
1120 N=2:CALL LEC(N,A,A$,AA$(),B$(),B())
1130 J$="@>"&B$(1)&B$(2):GOTO 1510
1140 N=1:CALL LEC(N,A,A$,AA$(),B$(),B())
1150 J$="*R"&STR$(B(1)):GOTO 1510
1160 N=2:CALL LEC(N,A,A$,AA$(),B$(),B())
1170 J$="@>"&B$(1)&B$(2)&"(B)":GOTO 1510
1180 !========  INSTRUCTIONS IV   ======
1190 I$=IN$(3,H2):ON H1-10 GOTO 1200,1200,1270
1200 IF H2=10 THEN 1230
1210 IF H1=11 THEN J$="A" ELSE J$="B"
1220 GOTO 1510
1230 N=1:CALL LEC(N,A,A$,AA$(),B$(),B())
1240 CALL AH(B(1),A,B$())
1250 IF H1=11 THEN J$="A,@>"&B$(4) ELSE J$="B,@>"&B$(4)
1260 GOTO 1510
1270 IF H2=10 THEN N=2 ELSE N=1
1280 CALL LEC(N,A,A$,AA$(),B$(),B())
1290 IF N=2 THEN CALL AH(B(2),A,B$()):J$="R"&STR$(B(1))&",@>"&B$(4):GOTO 1510
1300 J$="R"&STR$(B(1)):GOTO 1510
1310 !========  INSTRUCTIONS V  ========
1320 N=1:I$=IN$(4,H2)
1330 IF H2=0 THEN 1350 ELSE H=POS(I$,"/",1)
1340 IF T=0 THEN I$=SEG$(I$,1,H-1) ELSE I$=SEG$(I$,H+1,3):T=0
1350 A=A+1:CALL ADR(A$):AA$(N)=A$:CALL PEEK(A,H1):CALL AH(H1,A,B$())
1360 J$="@>"&B$(4):B$(1)=B$(0):GOTO 1510
1370 !========  INSTRUCTIONS VI  ======
1380 IF H1=14 THEN I$="TRAP "&STR$(31-H2) ELSE I$="TRAP "&STR$(15-H2)
1390 GOTO 1510
1400 N=1:CALL LEC(N,A,A$,AA$(),B$(),B())
1410 I$="MOVP":J$="P"&STR$(B(1))&",A":GOTO 1510
1420 N=1:CALL LEC(N,A,A$,AA$(),B$(),B())
1430 I$="MOVP":J$="P"&STR$(B(1))&",B":GOTO 1510
1440 I$="TSTA/CLRC":GOTO 1510
1450 IF H2=1 THEN I$="TSTB" ELSE I$="MOV":J$="A,B"
1460 GOTO 1510
1470 H=H2:N=1:CALL LEC(N,A,A$,AA$(),B$(),B())
1480 I$="MOV":J$=STR$(B(1))
1490 IF H=0 THEN J$="A,R"&J$ ELSE J$="B,R"&J$
1500 !        IMPRESSION
1510 IF I$="CMP"OR I$="CMPA" THEN T=1
1520 PRINT AD$&" "&C$&" "&I$&" "&J$;
1530 IF IMP=0 THEN 1600
1540 WW$=AD$&"        "&C$&"        "&I$&" "&J$:WL=LEN(WW$)
1550 OPEN #1,"20",OUTPUT
1560 PRINT #1,WW$;
1570 IF C<32 OR C>126 THEN 1590
1580 PRINT #1,TAB(45+WL);CHR$(C)
1590 CLOSE #1
1600 IF C>31 AND C<127 THEN PRINT TAB(35);CHR$(C) ELSE PRINT
1610 FOR I=1 TO N
1620 PRINT AA$(I)&" "&B$(I);
1630 IF IMP=0 THEN 1700
1640 XX$=AA$(I)&"        "&B$(I)&"        ":XL=LEN(XX$)
1650 OPEN #1,"20",OUTPUT
1660 PRINT #1,XX$;
1670 IF B(I)<32 OR B(I)>126 THEN 1690
1680 PRINT #1,TAB(44+XL);CHR$(B(I))
1690 CLOSE #1
1700 IF B(I)>31 AND B(I)<127 THEN PRINT TAB(35);CHR$(B(I)) ELSE PRINT
1710 NEXT
1720 CALL ADR(A$)
1730 NEXT A
1740 CALL COLOR("0bY"):GOTO 330
1750 !
1760 !******* SOUS-PROGRAMMES ********
1770 !####### Decimal --> Hexa
1780 SUB HEX(H1,H2,H$)
1790 HX$="0123456789ABCDEF"
1800 H2=H1-16*INT(H1/16)
1810 H1=INT(H1/16)
1820 H$=SEG$(HX$,H1+1,1)&SEG$(HX$,H2+1,1):SUBEND
1830 !###### Incrementation adresse hexa
1840 SUB ADR(A$)
1850 HX$="0123456789ABCDEF0"
1860 FOR I=4 TO 1 STEP -1
1870 A$=SEG$(A$,1,I-1)&SEG$(HX$,POS(HX$,SEG$(A$,I,1),1)+1,1)&SEG$(A$,I+1,4-I)
1880 IF SEG$(A$,I,1)<>"0" THEN SUBEXIT
1890 NEXT:SUBEND
1900 !###### Hexa --> Decimal
1910 SUB DECI(A$,A,T)
1920 HX$="0123456789ABCDEF":A=0
1930 FOR I=1 TO 4
1940 T=POS(HX$,SEG$(A$,I,1),1):IF T=0 THEN SUBEXIT
1950 A=A+16^(4-I)*(T-1)
1960 NEXT:SUBEND
1970 !###### Lecture des arguments
1980 SUB LEC(N,A,A$,AA$(),B$(),B())
1990 FOR I=1 TO N
2000 A=A+1:CALL ADR(A$):AA$(I)=A$:CALL PEEK(A,X):CALL HEX(X,Y,B$(I))
2010 B(I)=Y+16*X:NEXT
2020 SUBEND
2030 !###### Menu
2040 SUB TIT
2050 CLS "Ybb"
2060 CALL CHAR(0,"0103030303030303FF80")
2070 CALL CHAR(1,"FC0405050406020C1921")
2080 CALL CHAR(2,"0080404080000C12BA8A")
2090 CALL CHAR(3,"C04060381C0E03010000")
2100 CALL CHAR(4,"213D050505C4E2311018")
2110 CALL CHAR(5,"8ABAA1A1A1224C902040")
2120 CALL CHAR(6,"0")
2130 CALL CHAR(7,"0C0703")
2140 CALL CHAR(8,"4020E")
2150 CALL COLOR("1Yb")
2160 FOR I=0 TO 2
2170 A$=""
2180 FOR J=0 TO 2
2190 A$=A$&CHR$(3*I+J)
2200 NEXT
2210 FOR L=0 TO 1
2220 LOCATE (1+I+L*18,1)
2230 FOR K=1 TO 13
2240 PRINT A$;:NEXT:NEXT
2250 PRINT
2260 FOR L=1 TO 5
2270 FOR K=0 TO 1
2280 LOCATE (1+L*3+I,1+K*36)
2290 PRINT A$:NEXT
2300 NEXT:NEXT
2310 A$="DDEESSAASSSSEEMMBBLLEEUURR"
2320 LOCATE (7,7)
2330 CALL COLOR("0WbL")
2340 PRINT A$
2350 A$="TTMMSS  77002200"
2360 LOCATE (14,12)
2370 CALL COLOR("0RbLHIF")
2380 PRINT A$
2390 LOCATE (15,12)
2400 PRINT A$
2410 PAUSE 5
2420 LOCATE (8,12)
2430 CALL COLOR("0RbLHI")
2440 PRINT A$
2450 LOCATE (9,12)
2460 PRINT A$
2470 A$=RPT$(" ",20)
2480 CALL COLOR("0bb")
2490 LOCATE (14,12)
2500 PRINT A$
2510 LOCATE (15,12)
2520 PRINT A$
2530 CALL COLOR("0bY")
2540 LOCATE (11,5)
2550 PRINT "1-Notations"
2560 LOCATE (13,5)
2570 PRINT "2-Instructions"
2580 LOCATE (15,5)
2590 PRINT "3-Modes d'Adressage"
2600 LOCATE (17,5)
2610 PRINT "4-Desassemblage"
2620 LOCATE (22,3)
2630 PRINT "Pour diminuer les pauses --> RETURN"
2640 SUBEND
2650 !###### Effacement cadre
2660 SUB RAZ(I,J,L,H)
2670 CALL COLOR("0bb")
2680 A$=RPT$(" ",H)
2690 FOR H=0 TO L-1
2700 LOCATE (I+H,J)
2710 PRINT A$
2720 NEXT
2730 SUBEND
2740 !###### Calcul adresse relative
2750 SUB AH(H1,A,B$())
2760 IF H1<128 THEN H=A+H1+1 ELSE H=A+H1-255
2770 CALL HEX(H1,H2,B$(0))
2780 H1=INT(H/256):CALL HEX(H1,H2,B$(4))
2790 H1=H-256*INT(H/256):CALL HEX(H1,H2,B$(5)):B$(4)=B$(4)&B$(5)
2800 SUBEND
2810 !######  Presentation des instructions
2820 SUB INS(I$(,),IMP)
2830 DATA addition avec retenue,addition,and,and Port,branchement
2840 DATA bit test et saut si=1,idem Port,bit test et saut si=0,idem Port
2850 DATA appel sous-prog,raz,raz retenue,comparaison,idem avec A
2860 DATA add. decimale avec retenue
2870 DATA decrement,decrement double,desactive INT,decrement et saut si<>0
2880 DATA soustraction decimale,active INT,arret jusqu'a INT,increment,inversion
2890 DATA saut conditionnel,saut direct,saut conditionnel,idem,idem,idem,idem
2900 DATA idem,chargement A,chargement pointeur pile,transfert,transfert 16 bits
2910 DATA transfert Port,multiplication,pause,or,idem Port,valeur hors pile
2920 DATA valeur hors pile en ST,valeur dans pile,ST dans pile
2930 DATA retour INT,retour sous-prog,decalage gauche,idem par retenue
2940 DATA decalage droite,idem par retenue,soustraction avec retenue,retenue=1
2950 DATA transfert de A,pointeur de pile en B,soustraction,echange quartet
2960 DATA trap,test A,test B,echange avec B,ou exclusif,idem Port
2970 DATA L'instruction BTJO correspond a un,AND.Si le resultat <>0 alors saut.
2980 DATA Pour BTJZ saut si resultat=0," "
2990 DATA pour les sauts le premier nom est,un test du status.Le second est un
3000 DATA test apres les instructions CMP
3010 LOCATE (4,10):CALL COLOR("0WWL"):PRINT "IINNSSTTRRUUCCTTIIOONNSS"
3020 L=6:RESTORE 2830:FOR K=1 TO 80
3030 I1,J1=0:A$="Z"
3040 FOR I=0 TO 4
3050 FOR J=0 TO 15
3060 IF I$(I,J)<A$ THEN I1=I:J1=J:A$=I$(I,J)
3070 NEXT:NEXT
3080 IF A$="Z" THEN 3170
3090 READ B$
3100 LOCATE (L,4):CALL COLOR("0bY"):PRINT "       "
3110 LOCATE (L,4):PRINT I$(I1,J1):I$(I1,J1)="ZZ"
3120 LOCATE (L,11):CALL COLOR("0Yb"):PRINT RPT$(" ",26)
3130 LOCATE (L,11):PRINT B$:PAUSE 1
3140 IF L=18 THEN L=4 ELSE L=L+1
3150 IF IMP=1 THEN CALL IMP(A$,B$)
3160 NEXT
3170 CALL RAZ(9,4,10,33):L=L+1:CALL COLOR("0Yb")
3180 FOR I=1 TO 7:READ A$
3190 L=L+1:LOCATE (L,4):PRINT A$
3200 IF IMP=1 THEN CALL IMP(A$,"")
3210 NEXT:PAUSE 5
3220 SUBEND
3230 !#####  Presentation Notations
3240 SUB NOTA(IMP)
3250 DATA Rx,Registre x 0<x<127,A,=Registre R0,B,=Registre R1
3260 DATA Px,Port x 0<x<255,ST,Registre Status,INT,Interruption
3270 DATA CA,Compteur d'adresse,@,adresse,>,notation hexa
3280 DATA %,valeur directe,*,index d'adressage indirect,MSB,octet Poids Fort
3290 DATA LSB,octet Poids faible
3300 DATA 0000-007F,Registres R,0100-01FF,Controles et ports(>0104),0200-7FFF
3310 DATA ROM BASIC,8000-BFFF,RAM 16 K,C000-C7FF,RAM CPU,F806-FFCF,ROM,FFD0-FFFF
3320 DATA TRAP 23 a 0 (MSB;LSB)
3330 L=6:LOCATE (4,10):CALL COLOR("0YYL"):PRINT "NNOOTTAATTIIOONNSS"
3340 RESTORE 3250
3350 FOR I=1 TO 20
3360 READ A$,B$
3370 CALL COLOR("0bY"):LOCATE (L,4):PRINT RPT$(" ",4+L1*5):LOCATE (L,4)
3380 PRINT A$:CALL COLOR("0Yb"):LOCATE (L,8+5*L1):PRINT B$:PAUSE 2
3390 IF IMP=1 THEN CALL IMP(A$,B$)
3400 IF I=13 THEN PAUSE 10:CALL RAZ(4,4,15,33):L=5:L1=1
3410 L=L+1:NEXT:PAUSE 10
3420 CALL RAZ(4,4,15,33):SUBEND
3430 !#####  Presentation Modes d'adressage
3440 SUB MOD(IMP)
3450 LOCATE (4,10):CALL COLOR("0YYL"):PRINT "AADDRREESSSSAAGGEESS"
3460 L=8:LOCATE (6,12):CALL COLOR("0YbI"):PRINT "CI=CODE INSTUCTION"
3470 DATA Reg. A,Compris dans CI,Reg. B,Compris dans CI
3480 DATA Reg. x,CI+1byte=x,Port x,CI+1byte=x
3490 DATA Direct,CI+2bytes d'adresse,Indirect,CI+1byte=reg--> LSB adr.
3500 DATA "........","       reg-1--> MSB adr.",Indexe,CI+2bytes adr. + B -->adr
3510 DATA Relatif,CI+1byte a ajouter a CA,Immediat,CI+1byte= valeur direct
3520 RESTORE 3470:FOR I=1 TO 10
3530 READ A$,B$
3540 IF IMP=1 THEN CALL IMP(A$,B$)
3550 CALL COLOR("0bY"):LOCATE (L,4):PRINT RPT$(" ",8):LOCATE (L,4)
3560 PRINT A$:CALL COLOR("0Yb"):LOCATE (L,12):PRINT B$:PAUSE 2
3570 L=L+1:NEXT:PAUSE 10
3580 CALL RAZ(4,4,15,33):SUBEND
3590 SUB TEST(A$)
3600 H$="0123456789ABCDEF"
3610 FOR I=1 TO LEN(A$):IF POS(H$,SEG$(A$,I,1),1)=0 THEN A$=""
3620 NEXT:SUBEND
3630 SUB IMP(A$,B$)
3640 OPEN #1,"20",OUTPUT:PRINT #1,A$,B$:CLOSE #1:SUBEND

Ce listing est uniquement proposé pour un usage privé.
Sans accord écrit préalable, vous n'êtes pas autorisé à le distribuer, le transmettre ou le rediffuser.