home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / misc / bcpl.ark / DISASM.B < prev    next >
Encoding:
Text File  |  1988-11-27  |  8.6 KB  |  192 lines
  1. GET "COMPHDR"
  2.  
  3. STATIC $( A=?; B=?; C=? $)
  4.  
  5. LET START() BE
  6. $( LET I = ?
  7.    IF INPUT() = CON THEN SELECTINPUT(FINDINPUT("BCPL.OUT"))
  8.    BINARYINPUT(TRUE)
  9.    $( IF INTKEY() FINISH
  10.       I := RDCH()
  11.       TEST I=S.SECTION THEN
  12.          $( LET CH = RDCH()
  13.             WRITES("Section ")
  14.             UNTIL CH = 0 DO
  15.             $( WRCH(CH)
  16.                CH := RDCH()
  17.             $)
  18.          $)
  19.       ELSE TEST I=S.NEEDS THEN
  20.          $( LET CH = RDCH()
  21.             WRITES("Needs ")
  22.             UNLESS CH = 0 DO
  23.                $( WRCH(CH + ('A'-1))
  24.                   WRCH(':')
  25.                $)
  26.             FOR K = 1 TO 11 DO
  27.                $( CH := RDCH()
  28.                   UNLESS CH = ' ' DO WRCH(CH)
  29.                   IF K = 8 WRCH('.')
  30.                $)
  31.          $)
  32.       ELSE TEST I=S.GLOBSYM | I=S.LABSYM THEN
  33.          $( LET CH=?
  34.             RDW()
  35.             CH := RDCH()
  36.             WRITES(I=S.GLOBSYM -> "Global ", "Label ")
  37.             WRITEF("%N = ", A)
  38.             UNTIL CH = 0 DO
  39.             $( WRCH(CH)
  40.                CH := RDCH()
  41.             $)
  42.          $)
  43.       ELSE    
  44.          $( LET S = STR(I)
  45.             WRITEF(S, A, B, C)
  46.          $)
  47.       NEWLINE()
  48.    $) REPEATUNTIL (I = S.ENDFILE) | (I = ENDSTREAMCH)
  49. $)
  50.  
  51. AND RDW() BE
  52. $( LET L = RDCH()
  53.    LET H = RDCH()
  54.    A := L | (H << 8)
  55. $)
  56.  
  57. AND RDB() BE 
  58. $( A := RDCH() $)
  59.  
  60. AND RDE() BE
  61. $( B := RDCH()
  62.    A := "+"
  63.    IF B > 127 THEN 
  64.      $( A := "-"
  65.         B := 256 - B 
  66.      $)
  67. $)
  68.  
  69. AND RDB1() BE
  70. $( C := RDCH() $)
  71.  
  72. AND STR(I) = VALOF SWITCHON I INTO
  73. $( CASE S.ENDFILE:                       RESULTIS "ENDFILE"
  74.    CASE S.STARTFILE:                     RESULTIS "STARTFILE"
  75.    CASE S.STARTSECT:                     RESULTIS "STARTSECTION"
  76.    CASE S.LABDEF:        RDW();          RESULTIS "LABEL %N"    
  77.    CASE S.NEWLAB:        RDW();          RESULTIS "NEWLAB %N"
  78.    CASE S.GORG:          RDW();          RESULTIS "SETGLOBAL %N"
  79.    CASE S.WALIGN:                        RESULTIS "ALIGN"
  80.    CASE S.SUBHB:                         RESULTIS "SBC HL,BC"
  81.    CASE S.INCIX:                         RESULTIS "INC IX"
  82.    CASE S.LIMB:             RDB();          RESULTIS "LD B,0%X2H"
  83.    CASE S.LIMDE:     RDW();          RESULTIS "LD DE,0%X4H"
  84.    CASE S.LIMBC:     RDW();          RESULTIS "LD BC,0%X4H"
  85.    CASE S.LIMHL:     RDW();          RESULTIS "LD HL,0%X4H"
  86.    CASE S.RTAP:                             RESULTIS "RST 008H [RTAP]"
  87.    CASE S.LIMIY:     RDW()           RESULTIS "LD IY,0%X4H"
  88.    CASE S.GOTO:                             RESULTIS "JP GOTO"
  89.    CASE S.ADDHH:                         RESULTIS "ADD HL,HL"
  90.    CASE S.PLUS:                             RESULTIS "ADD HL,DE"
  91.    CASE S.DECIX:                     RESULTIS "DEC IX"   
  92.    CASE S.RET:                             RESULTIS "RET"      
  93.    CASE S.FINISH:                     RESULTIS "JP FINISH"
  94.    CASE S.ADDIYSP:                     RESULTIS "ADD IY,SP"
  95.    CASE S.ORA:                             RESULTIS "OR A" 
  96.    CASE S.ORH:                             RESULTIS "OR H" 
  97.    CASE S.MINUS:                     RESULTIS "SBC HL,DE" 
  98.    CASE S.LDAL:                          RESULTIS "LD A,L"    
  99.    CASE S.JPZ:            RDW();         RESULTIS "JP Z,L%N"  
  100.    CASE S.JPNZ:              RDW();         RESULTIS "JP NZ,L%N"         
  101.    CASE S.JPC:              RDW();         RESULTIS "JP C,L%N" 
  102.    CASE S.JPNC:              RDW();         RESULTIS "JP NC,L%N"
  103.    CASE S.JPPO:              RDW();         RESULTIS "JP PO,L%N"
  104.    CASE S.JPPE:              RDW();         RESULTIS "JP PE,L%N"
  105.    CASE S.SWITCHON:                      RESULTIS "CALL SWITCH"
  106.    CASE S.DB:             RDB();         RESULTIS "DB 0%X2H" 
  107.    CASE S.DW:              RDW();         RESULTIS "DW 0%X4H" 
  108.    CASE S.DWLAB:      RDW();         RESULTIS "DW L%N"   
  109.    CASE S.PUSHHL:                     RESULTIS "PUSH HL"  
  110.    CASE S.POPHL:                     RESULTIS "POP HL"   
  111.    CASE S.PUSHDE:                        RESULTIS "PUSH DE"  
  112.    CASE S.POPDE:                     RESULTIS "POP DE"   
  113.    CASE S.NEG:                             RESULTIS "CALL NEG" 
  114.    CASE S.ABS:                             RESULTIS "CALL ABS" 
  115.    CASE S.NOT:                             RESULTIS "CALL NOT" 
  116.    CASE S.RV:                             RESULTIS "RST 018H [RV]"  
  117.    CASE S.JPLAB:          RDW();         RESULTIS "JP L%N"   
  118.    CASE S.LDLIX:      RDE();         RESULTIS "LD L,(IX%S%N)"
  119.    CASE S.STLIX:      RDE();         RESULTIS "LD (IX%S%N),L"
  120.    CASE S.LDHIX:      RDE();         RESULTIS "LD H,(IX%S%N)"
  121.    CASE S.STHIX:      RDE();         RESULTIS "LD (IX%S%N),H"
  122.    CASE S.LDEIX:      RDE();         RESULTIS "LD E,(IX%S%N)"
  123.    CASE S.LDDIX:      RDE();         RESULTIS "LD D,(IX%S%N)"
  124.    CASE S.LDHLGLB:        RDW();         RESULTIS "LD HL,(GLOB %N)"
  125.    CASE S.STHLGLB:        RDW();         RESULTIS "LD (GLOB %N),HL"
  126.    CASE S.LDDEGLB:        RDW();         RESULTIS "LD DE,(GLOB %N)"
  127.    CASE S.LDHLLAB:        RDW();         RESULTIS "LD HL,(L%N)"
  128.    CASE S.STHLLAB:        RDW();         RESULTIS "LD (L%N),HL"
  129.    CASE S.LDDELAB:        RDW();         RESULTIS "LD DE,(L%N)"
  130.    CASE S.BYTEAP:                        RESULTIS "CALL GETBYTE"
  131.    CASE S.DIV:                           RESULTIS "CALL DIV"
  132.    CASE S.REM:                             RESULTIS "CALL REM"
  133.    CASE S.MULT:                             RESULTIS "CALL MULT"
  134.    CASE S.LS:                            RESULTIS "CALL LESS"
  135.    CASE S.GR:                             RESULTIS "CALL GREATER"
  136.    CASE S.LE:                             RESULTIS "CALL LESSEQ" 
  137.    CASE S.GE:                             RESULTIS "CALL GREATEQ"
  138.    CASE S.EQ:                             RESULTIS "CALL EQUALS" 
  139.    CASE S.NE:                             RESULTIS "CALL NEQ"    
  140.    CASE S.LSHIFT:                        RESULTIS "CALL LSHIFT" 
  141.    CASE S.RSHIFT:                        RESULTIS "CALL RSHIFT" 
  142.    CASE S.LOGAND:                     RESULTIS "CALL LOGAND" 
  143.    CASE S.LOGOR:                         RESULTIS "CALL LOGOR"  
  144.    CASE S.EQV:                             RESULTIS "CALL EQV"    
  145.    CASE S.NEQV:                             RESULTIS "CALL NEQV"   
  146.    CASE S.LOCADDR:                       RESULTIS "CALL LOCADDR"
  147.    CASE S.GLBADDR:        RDW();         RESULTIS "LD HL,GLOB %N"
  148.    CASE S.LABADDR:        RDW();         RESULTIS "LD HL,L%N/2"
  149.    CASE S.LABDEADR:       RDW();         RESULTIS "LD DE,L%N/2"
  150.    CASE S.EXCHG:                     RESULTIS "EX DE,HL"   
  151.    CASE S.STBYTE:                     RESULTIS "LD (HL),E"  
  152.    CASE S.STIND:                     RESULTIS "RST 020H [STIND]" 
  153.    CASE S.INCHL:                         RESULTIS "INC HL"
  154.    CASE S.DECHL:                     RESULTIS "DEC HL"
  155.    CASE S.INCDE:                     RESULTIS "INC DE"
  156.    CASE S.DECDE:                         RESULTIS "DEC DE"
  157.    CASE S.SUBHH:                         RESULTIS "SBC HL,HL"
  158.    CASE S.JPP:              RDW();         RESULTIS "JP P,L%N"
  159.    CASE S.JPM:              RDW();         RESULTIS "JP M,L%N"
  160.    CASE S.LDSPIY:                        RESULTIS "LD SP,IY"
  161.    CASE S.SRTAP:                         RESULTIS "RST 010H [SRTAP]"
  162.    CASE S.TWODIV:                        RESULTIS "CALL TWODIV"
  163.    CASE S.ADDIXBC:                       RESULTIS "ADD IX,BC"
  164.    CASE S.LDAGLB:         RDW();         RESULTIS "LD A,(GLOB %N)"
  165.    CASE S.LDALAB:         RDW();         RESULTIS "LD A,(L%N)"
  166.    CASE S.LIMA:           RDB();         RESULTIS "LD A,0%X2H"
  167.    CASE S.LDAIX:          RDE();         RESULTIS "LD A,(IX%S%N)"
  168.    CASE S.STBYTEA:                       RESULTIS "LD (HL),A"
  169.    CASE S.STBYTIM:        RDB();         RESULTIS "LD (HL),0%X2H"
  170.    CASE S.STIXIM:         RDE(); RDB1(); RESULTIS "LD (IX%S%N),0%X2H"
  171.    CASE S.LDBYTE:                        RESULTIS "LD L,(HL)"
  172.    CASE S.LDHIM:          RDB();         RESULTIS "LD H,0%X2H"
  173.    CASE S.INCLOC:         RDE();         RESULTIS "INC (IX%S%N)"
  174.    CASE S.SKIP:                          RESULTIS "JR NZ,$+5"
  175.    CASE S.SKIPZ:                         RESULTIS "JR Z,$+3"
  176.    CASE S.VEC:                           RESULTIS "CALL VECTOR"
  177.    CASE S.OFLV:                          RESULTIS "CALL OFLV"
  178.    CASE S.OFRV:                          RESULTIS "CALL OFRV"
  179.    CASE S.ADDHB:                         RESULTIS "ADD HL,BC"
  180.    CASE S.DECA:                          RESULTIS "DEC A"
  181.    CASE S.ORIX:           RDE();         RESULTIS "OR (IX%S%N)"
  182.    CASE S.SUBA:           RDB();         RESULTIS "SUB 0%X2H"
  183.    CASE S.BIT:     RDB(); B := (A>>3)&7
  184.                    A := A>>6
  185.                    TEST A=1 THEN A:="BIT"
  186.               ELSE TEST A=2 THEN A:="RES"
  187.               ELSE               A:="SET"
  188.                                          RESULTIS "%S %N,(HL)"
  189.    DEFAULT:               A := I;        RESULTIS "----UNKNOWN----(%N)"
  190. $) 
  191.   
  192.