PROGRAM CISAB
****
* CISAB - DATA/BASIC Disassembler.
     LastUpdated... = "Rev: 17:12 21MAR88 jack <D4.3>DEVEL 37 E"
****
*                           R E V I S I O N   L O G
* PR#     WHEN     WHO        WHY
* ======= ======== ========== ==========================================
*                             INITIAL CODING
* 001     02-03-88  JD        Clear VARNAME array before starting
*
****

$INSERT SYSCOM>KEYS.INS.IBAS
$INSERT SYSLIB>INSERTS>STDDEF.INS.IBAS
$INSERT SYSLIB>INSERTS>STD.SUBROUTINES.INS.IBAS

     COMMON /DEVSYS/ VOC.FILE
     COMMON /CISAB/ OBJECT(6000), SOURCE(6000)

     DIM OPCODES(255), EXT.OPCODES(255), STMT.STRUCTS(255), EXT.STMT.STRUCTS(255), STACK(300), STACK.ELEMENTS(255), EXT.STACK.ELEMENTS(255), OP.TYPES(255), EXT.OP.TYPES(255)
     DIM XREF(6000), VARNAME(500,2)

     GOSUB INITIALIZE
     LOOP
     WHILE MORE.RECORD.IDS
        REMOVE RECORD.ID FROM STREAM SETTING MORE.RECORD.IDS
        RECORD.COUNTER += 1
        PRINT 'Now processing record: ':RECORD.ID
        GOSUB RESET
        PATH = ROOT:'>':RECORD.ID
        GOSUB OPEN.FILE
        IF OPEN.STATUS EQ 0 THEN
           GOSUB LOAD.FILE
           IF TO.LPTR THEN
              PRINTER ON
           END
           GOSUB LOAD.HEADER
           GOSUB LOAD.SYMBOLS
           GOSUB LOAD.XREF
           GOSUB LOAD.OBJECT
           GOSUB DISASSEMBLE
           GOSUB WRITE.SOURCE
           IF TO.LPTR THEN
              PRINTER OFF
              PRINTER CLOSE
              PRINT
           END
           GOSUB CLOSE.FILE
        END
     REPEAT
     RETURN

*

OPEN.FILE:

     PRINT 'Trying ':PATH
     KEY = K$READ+K$GETU
*       PATHNAME = CHAR(128):CHAR(128+LEN(PATH)):PATH
     PATHNAME = PATH
     UNIT = 0
     TYPE = 0
     NUM.SUFFIXES = 0
*       SUFFIX.LIST  = CHAR(128):CHAR(133):".IRUN"
*    SUFFIX.LIST = '.IRUN'
     SUFFIX.LIST = ''
     FILENAME     = ""
     SUFFIX.USED = 1
     OPEN.STATUS = 0
     CALL @SRSFX$(KEY,PATHNAME,UNIT,TYPE,NUM.SUFFIXES,SUFFIX.LIST,FILENAME,SUFFIX.USED,OPEN.STATUS)
     IF OPEN.STATUS EQ 0 THEN
        PRINT 'Found.'
     END ELSE
        PRINT '                        SRSFX failed:'
        PRINT "UNIT        - ": UNIT
        PRINT "TYPE        - ": TYPE
        PRINT "FILENAME    - ": FILENAME
        PRINT "SUFFIX.USED - ": SUFFIX.USED
        PRINT "OPEN.STATUS - ": OPEN.STATUS
     END

     RETURN

*

LOAD.FILE:

     RECORD = ''
     PRINT 'Reading object.'
     LOOP
        CALL @PRWF$$(K$READ,UNIT,BUFFER,BLOCK.SIZE,0,READ.NO.OF.WORDS,CODE)
        RECORD := BUFFER[1,READ.NO.OF.WORDS*2]
     UNTIL CODE # 0
     REPEAT
     PRINT
     PRINT 'Object loaded.'

     RETURN

*

LOAD.HEADER:

     NUM.IN = RECORD[1,2]
     GOSUB CONVERT.SHORT.INTEGER
     NUM.ARGUMENTS = NUM.OUT

     NUM.IN = RECORD[3,2]
     GOSUB CONVERT.SHORT.INTEGER
     NUM.VARS = NUM.OUT

     NUM.IN = RECORD[5,4]
     GOSUB CONVERT.LONG.INTEGER
     DESCR.OFFSET = NUM.OUT * 2

     NUM.IN = RECORD[9,4]
     GOSUB CONVERT.LONG.INTEGER
     XREF.OFFSET = NUM.OUT * 2

     ACTUAL.OBJECT = RECORD[13 , XREF.OFFSET + 2]
     ACTUAL.SYMBOLS = RECORD[15+DESCR.OFFSET , LEN(RECORD)]
     ACTUAL.XREF = RECORD[15+XREF.OFFSET , DESCR.OFFSET - XREF.OFFSET]

     PRINT 'Number of arguments:       ': NUM.ARGUMENTS
     PRINT 'Variables in object:       ': NUM.VARS
     PRINT 'Descriptor offset:         ': DESCR.OFFSET
     PRINT 'Xref offset:               ': XREF.OFFSET
     PRINT
     PRINT 'Record string:             ': LEN(RECORD)
     PRINT 'Size of executable object: ': XREF.OFFSET + 2
     PRINT 'Object string:             ': LEN(ACTUAL.OBJECT)
     PRINT 'Size of cross-reference:   ': DESCR.OFFSET-XREF.OFFSET
     PRINT 'XREF string:               ': LEN(ACTUAL.XREF)
     PRINT 'Size of symbols:           ': LEN(RECORD)-DESCR.OFFSET-14
     PRINT 'Symbols string:            ': LEN(ACTUAL.SYMBOLS)

     IF TO.LPTR THEN
        CRT 'h':
     END

     RETURN

*

LOAD.SYMBOLS:

     NUM.IN = ACTUAL.SYMBOLS[1,2]
     GOSUB CONVERT.SHORT.INTEGER
     SOURCE.NAME = TRIMB(ACTUAL.SYMBOLS[3,NUM.OUT])
     PRINT 'Source program name is ':SOURCE.NAME
     PROGRAM.NAME = SOURCE.NAME
     IF PROGRAM.NAME[5] EQ '.IBAS' THEN
        PROGRAM.NAME = PROGRAM.NAME[1,LEN(PROGRAM.NAME) - 5]
     END

     IF NUM.VARS <= 0 THEN RETURN

     DYN.VARNAME = ''
     MAT VARNAME = 0

     VARNUM = 1
     J = NUM.OUT + 3 + MOD(NUM.OUT,2)

     LOOP
        NUM.IN = ACTUAL.SYMBOLS[J,2]
        GOSUB CONVERT.SHORT.INTEGER
     UNTIL NUM.OUT <= 0
        SYMBOL = ACTUAL.SYMBOLS[J+2,NUM.OUT]
        VARNAME(VARNUM,1) = SYMBOL
        DYN.VARNAME<-1> = SYMBOL
        VARNUM += 1
        J += NUM.OUT + 2 + MOD(NUM.OUT,2)
     REPEAT
     PRINT PROGRAM.NAME:' has ':NUM.VARS:' variables.'
     IF NOT(NO.VARS) THEN
*[001]        MATWRITE VARNAME TO OUTPUT.FILE,PROGRAM.NAME:'.VARS'
        WRITE DYN.VARNAME TO OUTPUT.FILE,PROGRAM.NAME:'.VARS' ;*[001]
     END

     IF TO.LPTR THEN
        CRT 's':
     END

     RETURN

*

LOAD.XREF:

     LINES = LEN(ACTUAL.XREF) - 1       ;* SKIP ZERO BYTE
     LINES -= MOD(LINES,2)              ;* SKIP TRAILING FILLER BYTE(S)

     CHAR.PTR = 2
     LINE.NO = 1
     CNTR1 = 1

     LOOP
     WHILE LINE.NO <= LINES
        XREF(LINE.NO) = MOD( SEQ(ACTUAL.XREF[CHAR.PTR,1]) + 128 , 256)
        CHAR.PTR += 1
        IF XREF(LINE.NO) = 255 THEN
           LINES -= 2
           NUM.IN = ACTUAL.XREF[CHAR.PTR,2]
           CHAR.PTR += 2
           CNTR1 += 2
           GOSUB CONVERT.SHORT.INTEGER
           XREF(LINE.NO) = NUM.OUT
        END
        CNTR1 += 1
        IF CNTR1 >= 508 THEN  ;* SKIP 2 GARBAGE (FILLER) BYTES THAT OCCUR EVERY 508 BYTES
           CHAR.PTR += 2
           CNTR1 = 0
           LINES -= 2
        END
        LINE.NO += 1
     REPEAT

     PRINT PROGRAM.NAME:' has ': LINES:' lines.'
     IF NOT(NO.XREF) THEN
        MATWRITE XREF TO OUTPUT.FILE,PROGRAM.NAME:'.XREF'
     END

     IF TO.LPTR THEN
        CRT 'x':
     END

     RETURN

*

LOAD.OBJECT:

     MAT SOURCE = ''
     MAT OBJECT = ''
     PTR = 1
     FOR I = 1 TO LINES
        LINE.LEN = XREF(I)
        OBJECT(I) = ACTUAL.OBJECT[PTR,LINE.LEN]
        PTR += LINE.LEN
     NEXT I
     PRINT 'Object parsed.'

     IF TO.LPTR THEN
        CRT 'o':
     END

     RETURN

*

DISASSEMBLE:

     EXTENDED = FALSE$
     PAGE

     IF NUM.ARGUMENTS # 0 THEN
        GOSUB BUILD.SUBROUTINE.STATEMENT
     END

      LOCKED.CLAUSE.ARMED = 0
     FOR CUR.LINE = 1 TO LINES
        OBJ.LINE = OBJECT(CUR.LINE)
        OBJ.LEN = XREF(CUR.LINE)
*       SOURCE.LINE = ''
        SOURCE.LINE = SOURCE(CUR.LINE)
        STACKPTR = 0
        PREV.OPCODE = ''
        FOR CUR.CHAR = 1 TO OBJ.LEN
           OPCODE = MOD( SEQ(OBJ.LINE[CUR.CHAR,1]) + 128 , 256)
           GOSUB DECODE
           SOURCE.LINE = TRIMB(SOURCE.LINE)
           GOSUB BUILD.SOURCE.LINE
           PREV.OPCODE = OPCODE
        NEXT CUR.CHAR
        IF STACKPTR GT 0 THEN GOSUB PROCESS.REST.OF.LINE
        SOURCE(CUR.LINE) = SOURCE.LINE
        IF MOD(CUR.LINE,10) = 0 THEN CRT 'd':
        IF MOD(CUR.LINE,1000) = 0 THEN PRINT ' -- ':CUR.LINE
     NEXT CUR.LINE
     IF SOURCE(CUR.LINE - 1) = 'STOP' THEN
        SOURCE(CUR.LINE - 1) = 'END'
     END ELSE
        SOURCE(CUR.LINE) = 'END'
     END
     CRT ''
     RETURN

*

DECODE:

     PRINT.LINE = ('0000':CUR.LINE)[4]:' '
     PRINT.LINE := ('0':OCONV(OPCODE,'MX'))[2]:' '

     IF EXTENDED THEN
        PRINT.LINE := EXT.OPCODES(OPCODE): ' '
        EXTENDED = FALSE$
        OPCODE = -OPCODE
     END ELSE
        PRINT.LINE := OPCODES(OPCODE): ' '
     END

     BEGIN CASE
        CASE OPCODE EQ -5               ;* COMMON VARIABLE
           NUM.IN = CHAR(128): OBJ.LINE[CUR.CHAR+1,1]
           CUR.CHAR += 1
           GOSUB CONVERT.SHORT.INTEGER
           BEGIN CASE
              CASE NUM.OUT = 0
                 ELEMENT = 'DEVSYS'
              CASE NUM.OUT = 1
                 ELEMENT = 'UNLABELLED'
              CASE TRUE$
                 ELEMENT = 'LABELLED.':NUM.OUT
           END CASE
           NUM.IN = OBJ.LINE[CUR.CHAR+1,2]
           CUR.CHAR += 2
           GOSUB CONVERT.SHORT.INTEGER
           ELEMENT := '.': NUM.OUT
           PRINT.LINE := ELEMENT
           STACKPTR += 1
           STACK(STACKPTR) = ELEMENT
        CASE OPCODE = -4 ;* DIM
           LOOK.UP.NAME = STACK(STACKPTR-4)
           LOCATE LOOK.UP.NAME IN DYN.VARNAME<1> SETTING FOUND ELSE FOUND = 0
           IF FOUND THEN
              IF STACK(STACKPTR-2) = 0 THEN
                 VARNAME(FOUND,2) = 1
              END ELSE
                 VARNAME(FOUND,2) = 2
              END
           END
        CASE OPCODE = -112              ;* SYSTEM CALL
           CUR.CHAR += 1
        CASE OPCODE = -66               ;* COMMON STATEMENT
           NUM.IN = CHAR(128): OBJ.LINE[CUR.CHAR+1,1]
           CUR.CHAR += 1
           GOSUB CONVERT.SHORT.INTEGER
           COMMON.AREA = NUM.OUT
           NUM.IN = OBJ.LINE[CUR.CHAR+1,2]
           CUR.CHAR += 2
           GOSUB CONVERT.SHORT.INTEGER
           NUM.COMMON.VARS = NUM.OUT
           IF COMMON.AREA = 2 THEN      ;* LABELLED COMMON
              COMMON.LABEL = OBJ.LINE[CUR.CHAR+1,8]
*             IF COMMON.LABEL[1] # '/' THEN COMMON.LABEL := '/'
              CUR.CHAR += 8
           END ELSE
              COMMON.LABEL = ''
           END
           PRINT.LINE := COMMON.LABEL: " [":NUM.COMMON.VARS:" entries]"
           STACKPTR += 1
           STACK(STACKPTR) = COMMON.LABEL
           STACKPTR += 1
           STACK(STACKPTR) = NUM.COMMON.VARS
           COMMON.VARS = 'UNLABELLED.0'
           NUM.COMMON.VARS -= 1
           FOR XYZ = 1 TO NUM.COMMON.VARS
              COMMON.VARS := ', UNLABELLED.':XYZ
           NEXT XYZ
           STACK(STACKPTR) = COMMON.VARS
        CASE OPCODE = 7 ! OPCODE = 9 ! OPCODE = -21 ! OPCODE = 34 ! OPCODE = 39 ! OPCODE = 48 ;* 3-BYTE BRANCH INSTRUCTIONS
           GOSUB CONVERT.3.BYTE.OFFSET
           STACKPTR += 1
           IF NUM.OUT = 0 AND OPCODE = 48 THEN REL.LINE = 0
           STACK(STACKPTR) = REL.LINE
           IF OPCODE = 7 THEN           ;* SETUP CHECK ADDRESSES FOR "FOR TEST"
              IF XREF(BRANCH.LINE) = 0 THEN
                 FOR XYZ = BRANCH.LINE TO 1 STEP -1
                    IF XREF(XYZ) # 0 THEN BRANCH.LINE = XYZ; XYZ = 1
                 NEXT XYZ
                 BRANCH.OFFSET = 5
              END
              FOR.LINES<-1> = BRANCH.LINE
              FOR.OFFSETS<-1> = BRANCH.OFFSET - 4
           END
           IF OPCODE = 39 AND BRANCH.LINE = CUR.LINE THEN ;* SETUP CHECK ADDRESSES FOR "IF-THEN-ELSE'
              IF.LINES<-1> = BRANCH.LINE
              IF.OFFSETS<-1> = BRANCH.OFFSET - 4
           END
        CASE OPCODE EQ 1                ;* 1-BYTE BRANCH
           NUM.IN = CHAR(128): OBJ.LINE[CUR.CHAR+1,1]
           CUR.CHAR += 1
           GOSUB CONVERT.SHORT.INTEGER
           NUM.OUT = -NUM.OUT
           GOSUB GENERATE.LINE.LABEL
           PRINT.LINE := NUM.OUT
           STACKPTR += 1
           STACK(STACKPTR) = REL.LINE
        CASE OPCODE EQ 45               ;* COLn()
           STACKPTR +=1
           CUR.CHAR += 1
           STACK(STACKPTR) = SEQ(OBJ.LINE[CUR.CHAR,1]) - 128
           PRINT.LINE := ' Column [':STACK(STACKPTR):']'
        CASE OPCODE EQ -71
           LOCKED.CLAUSE.ARMED = 1
        CASE OPCODE EQ 78 ! OPCODE EQ 79 ;* ON/GOSUB & ON/GOTO
           NUM.IN = CHAR(128): OBJ.LINE[CUR.CHAR+1,1]
           CUR.CHAR += 1
           GOSUB CONVERT.SHORT.INTEGER
           NUM.DEST.LABELS = NUM.OUT
           PRINT.LINE := " [": NUM.DEST.LABELS: " target labels]"
           LABELS.LIST = ''
           FOR TARGET.LABEL = 1 TO NUM.DEST.LABELS
              GOSUB CONVERT.3.BYTE.OFFSET
              IF LABELS.LIST # '' THEN LABELS.LIST := ","
              LABELS.LIST := REL.LINE
              IF SOURCE(REL.LINE)[1,LEN(REL.LINE)+1] # (REL.LINE:':') THEN
                 SOURCE(REL.LINE) = REL.LINE:': ':SOURCE(REL.LINE)
              END
           NEXT TARGET.LABEL
           STACKPTR += 1
           STACK(STACKPTR) = LABELS.LIST
        CASE OPCODE EQ 80               ;* ARGUMENT TRANSFER
           NUM.IN = CHAR(128): OBJ.LINE[CUR.CHAR+1,1]
           CUR.CHAR += 1
           GOSUB CONVERT.SHORT.INTEGER
           PRINT.LINE := "  [": NUM.OUT: " argument(s)]"
           ARGUMENT.LIST = ''
           FOR ARGUMENT.NUMBER = 1 TO NUM.OUT
              IF ARGUMENT.LIST # '' THEN ARGUMENT.LIST = ',':ARGUMENT.LIST
              IF STACKPTR GT 1 THEN
                 IF STACK(STACKPTR - 1) = '-2' THEN
                    STACKPTR -= 1
                    STACK(STACKPTR) = 'MAT ':STACK(STACKPTR + 1)
                 END
              END
              ARGUMENT.LIST = STACK(STACKPTR): ARGUMENT.LIST
              STACKPTR -= 1; IF STACKPTR < 0 THEN STACKPTR = 0
           NEXT ARGUMENT.NUMBER
           IF ARGUMENT.LIST # '' THEN ARGUMENT.LIST = '(':ARGUMENT.LIST:')'
           STACKPTR += 1
           STACK(STACKPTR) = ARGUMENT.LIST
        CASE OPCODE EQ 91               ;* LOAD INTEGER VALUE
           NUM.IN = OBJ.LINE[CUR.CHAR+1,4]
           CUR.CHAR += 4
           GOSUB CONVERT.LONG.INTEGER
           PRINT.LINE := NUM.OUT
           STACKPTR += 1
           STACK(STACKPTR) = NUM.OUT
        CASE OPCODE EQ 92               ;* FLOATING POINT
           NUM.IN = OBJ.LINE[CUR.CHAR+1,8]
           CUR.CHAR += 8
           GOSUB CONVERT.FLOATING.POINT
           PRINT.LINE := NUM.OUT
           STACKPTR += 1
           STACK(STACKPTR) = NUM.OUT
        CASE OPCODE EQ 93               ;* STRING INDICATOR
           NUM.IN = CHAR(128):OBJ.LINE[CUR.CHAR+1,1]
           GOSUB CONVERT.SHORT.INTEGER
           STRING = OBJ.LINE[CUR.CHAR+2,NUM.OUT]
           SEQ.STRING = SEQ(STRING)
           IF ((LEN(STRING) EQ 1) AND ((SEQ.STRING LT 32) OR (SEQ.STRING GT 126))) THEN
              ELEMENT = "CHAR(": SEQ.STRING: ")"
           END ELSE
              IF INDEX(STRING,'"',1) THEN
                 ELEMENT = "'" : STRING : "'"
              END ELSE
                 ELEMENT = '"': STRING: '"'
              END
           END
           CUR.CHAR += NUM.OUT + 1
           PRINT.LINE := ELEMENT
           STACKPTR += 1
           STACK(STACKPTR) = ELEMENT
        CASE OPCODE EQ 94               ;* EXTENDED VARIABLE ID
           NUM.IN = OBJ.LINE[CUR.CHAR+1,2]
           CUR.CHAR += 2
           GOSUB CONVERT.SHORT.INTEGER
           PRINT.LINE := VARNAME(NUM.OUT,1)
           STACKPTR += 1
           STACK(STACKPTR) = VARNAME(NUM.OUT,1)
        CASE OPCODE EQ 95
           EXTENDED = TRUE$
        CASE OPCODE GE 96 & OPCODE LE 127 ;* FAST LOAD INTEGERS
           PRINT.LINE := '(':OPCODE-99:')'
           STACKPTR += 1
           STACK(STACKPTR) = OPCODE-99
        CASE OPCODE GE 128              ;* FAST VARIABLES
           IF OPCODE GT NUM.VARS + 127 THEN
              PRINT 'Excess variable reference: ':OPCODE
           END ELSE
              PRINT.LINE := VARNAME(OPCODE - 127,1):'  [Fast variable #':OPCODE - 127:']'
              STACKPTR += 1
              STACK(STACKPTR) = VARNAME(OPCODE-127,1)
           END
     END CASE

*    PRINT PRINT.LINE
     PROG.ASM<-1> = PRINT.LINE

     RETURN

*

BUILD.SOURCE.LINE:

     IF OPCODE LT 0 THEN
        NUM.STACK.ELEMENTS = EXT.STACK.ELEMENTS(ABS(OPCODE))
        OP.TYPE = EXT.OP.TYPES(ABS(OPCODE))
        STMT.STRUCT = EXT.STMT.STRUCTS(ABS(OPCODE))
     END ELSE
        OP.TYPE = OP.TYPES(OPCODE)
        NUM.STACK.ELEMENTS = STACK.ELEMENTS(OPCODE)
        STMT.STRUCT = STMT.STRUCTS(OPCODE)
     END
     IF SOURCE(CUR.LINE) = 'NEXT' AND STMT.STRUCT[1,4] = 'GOTO' THEN
        STACKPTR -= NUM.STACK.ELEMENTS
        RETURN
     END
     BEGIN CASE
        CASE OPCODE = 05                ;* STORE
           IF STACKPTR GT 1 THEN
              LOOK.UP.NAME = STACK(STACKPTR-1)
              LOCATE LOOK.UP.NAME IN DYN.VARNAME<1> SETTING FOUND ELSE FOUND = 0
              IF FOUND THEN
                 IF VARNAME(FOUND,2) GT 0 THEN
                    IF VARNAME(FOUND,2) = 1 THEN
                       STMT.STRUCT = '2.(.3.). = .1'
                       NUM.STACK.ELEMENTS = 3
                    END ELSE
                       STMT.STRUCT = '2.(.4.,.3.) = .1'
                       NUM.STACK.ELEMENTS = 4
                    END
                    CONVERT '.' TO @VM IN STMT.STRUCT
                 END
              END
           END
        CASE OPCODE = -27  ; * SELECT
          IF STACKPTR = 2 THEN
            NULL
          END ELSE
            STMT.STRUCT = 'SELECT .2. TO .1'
            CONVERT '.' TO @VM IN STMT.STRUCT
            NUM.STACK.ELEMENTS =  3
          END
        CASE LOCKED.CLAUSE.ARMED
           IF OPCODE = 39 THEN      ; * IF-THEN-ELSE
              LOCKED.CLAUSE.ARMED = 0
              STMT.STRUCT = 'LOCKED'
              NUM.STACK.ELEMENTS = 0
              CUR.CHAR += 4   ; * MOVE OVER DUPLICATE BRANCH INSTR
           END
        CASE OPCODE = 48 AND STACKPTR = 2 ;* UNTIL
           STMT.STRUCT = 'IF .2. THEN GOTO .1'
           NUM.STACK.ELEMENTS = 2
           OP.TYPE = 1
           CONVERT '.' TO @VM IN STMT.STRUCT
        CASE PREV.OPCODE = 54
          IF OPCODE = 54 OR OPCODE = 55 THEN
              STMT.STRUCT = ' .1. :'
              CONVERT '.' TO @VM IN STMT.STRUCT
           END
        CASE OPCODE = 86                ;* GET ARRAY ELEMENT
           LOOK.UP.NAME = STACK(STACKPTR)
           LOCATE LOOK.UP.NAME IN DYN.VARNAME<1> SETTING FOUND ELSE FOUND = 0
           IF FOUND THEN
              IF VARNAME(FOUND,2) GT 0 THEN
                 IF VARNAME(FOUND,2) = 1 THEN
                    STMT.STRUCT = '1.(.2.)'
                    NUM.STACK.ELEMENTS = 2
                 END ELSE
                    STMT.STRUCT = '1.(.3.,.2.)'
                    NUM.STACK.ELEMENTS = 3
                 END
                 CONVERT '.' TO @VM IN STMT.STRUCT
              END
           END
        CASE OPCODE = -4                ;* GET ARRAY ELEMENT
           LOOK.UP.NAME = STACK(STACKPTR-4)
           LOCATE LOOK.UP.NAME IN DYN.VARNAME<1> SETTING FOUND ELSE FOUND = 0
           IF FOUND THEN
              IF VARNAME(FOUND,2) GT 0 THEN
                 IF VARNAME(FOUND,2) = 1 THEN
                    STMT.STRUCT = 'DIM .5.(.4.)'
                    NUM.STACK.ELEMENTS = 5
                 END ELSE
                    STMT.STRUCT = 'DIM .5.(.4.,.3.)'
                    NUM.STACK.ELEMENTS = 5
                 END
                 CONVERT '.' TO @VM IN STMT.STRUCT
              END
           END
     END CASE

     IF STMT.STRUCT  = '' AND OP.TYPE # 2 THEN
        STACKPTR -= NUM.STACK.ELEMENTS
        OPCODE = PREV.OPCODE
        RETURN
     END

     RESULT = ''
     IF STACKPTR < NUM.STACK.ELEMENTS THEN
        STACKPTR += 1
        STACK(STACKPTR) = OPCODE
        RETURN
     END
     LOOP
        ELEMENT = REMOVE(STMT.STRUCT,MORE.STMT.STRUCT)
     UNTIL ELEMENT = '' & NOT(MORE.STMT.STRUCT)
        IF NUM(ELEMENT) THEN
           CTR1 = STACKPTR-ELEMENT+1
           IF CTR1 GT 0 THEN
              RESULT := STACK(CTR1)
           END ELSE
              RESULT := "BAD ARRAY REF"
           END
        END ELSE
           RESULT := ELEMENT
        END
     REPEAT

     BEGIN CASE
        CASE OPCODE = 39 ! ((OPCODE = 48) AND (STACKPTR = 1)) ;* BRANCH LONG ON TRUE/FALSE$
           FOUND.ELSE = 0
**-- IS LAST ITEM IN THIS LINE A GOTO ?
           IF SEQ(OBJECT(CUR.LINE)[LEN(OBJECT(CUR.LINE))-3,1]) - 128 = 34 THEN
              LOCATE CUR.LINE IN IF.LINES<1> SETTING IF.LINE.FOUND ELSE IF.LINE.FOUND = 0
              IF IF.LINE.FOUND THEN
**-- CHECK TO SEE IF WE HAVE A IF-THEN-ELSE
**-- WITH MULTI-LINED ELSE IMPERATIVE STATEMENTS
                 IF (XREF(CUR.LINE) - 3) = IF.OFFSETS<IF.LINE.FOUND> THEN
                    END.STMT.LINE = CUR.LINE
                    FOUND.ELSE = 1
                 END
              END
           END
           IF NOT(FOUND.ELSE) THEN
              DMY.LINE = STACK(STACKPTR) - (OPCODE = 48)
              END.STMT.LINE = DMY.LINE
           END
           FOR XYZ = DMY.LINE TO 1 STEP -1
              IF XREF(XYZ) # 0 THEN DMY.LINE = XYZ; XYZ = 1
           NEXT XYZ
           IF DMY.LINE <= 0 AND OPCODE = 48 THEN RESULT := 'NULL'
           IF DMY.LINE GT CUR.LINE  AND (CUR.CHAR GE OBJ.LEN) THEN ;* MULTI-LINE STMT - GENERATE END
              IF END.STMT.LINE GT 1 THEN
                 LOOP WHILE XREF(END.STMT.LINE-1) EQ 0 AND SOURCE(END.STMT.LINE-1) = ''
                    END.STMT.LINE -= 1
                 REPEAT
                 IF LEN(SOURCE(END.STMT.LINE)) THEN
                    IF SOURCE(END.STMT.LINE) = 'END' THEN
                       NULL
                    END ELSE
                       SOURCE(END.STMT.LINE) := ' END'
                    END
                 END ELSE
                    SOURCE(END.STMT.LINE) = 'END'
                 END
                 IF OP.TYPE # 2 THEN OP.TYPE = 1
              END
           END
        CASE OPCODE = 1 ! OPCODE = 34 ! OPCODE = 9 ! OPCODE = -21 !  OPCODE = 48 ;* GO TOS & GOSUBS
           IF OPCODE = 34 THEN
              LOCATE CUR.LINE IN FOR.LINES<1> SETTING FOR.LINE.FOUND ELSE FOR.LINE.FOUND = 0
              IF FOR.LINE.FOUND THEN
                 IF (CUR.CHAR - 3) = FOR.OFFSETS<FOR.LINE.FOUND> THEN
                    DEL FOR.LINES<FOR.LINE.FOUND>
                    DEL FOR.OFFSETS<FOR.LINE.FOUND>
                    OP.TYPE = 1
                    RESULT = 'NEXT'
                    GOTO BUILD.SOURCE.LINE.10
                 END
              END
              LOCATE CUR.LINE IN IF.LINES<1> SETTING IF.LINE.FOUND ELSE IF.LINE.FOUND = 0
              IF IF.LINE.FOUND AND ((SOURCE.LINE[4] = 'THEN' AND CUR.CHAR <= OBJ.LEN) OR (SOURCE.LINE[4] # 'THEN')) THEN
                 IF (CUR.CHAR - 3) = IF.OFFSETS<IF.LINE.FOUND> THEN
                    DEL IF.LINES<IF.LINE.FOUND>
                    DEL IF.OFFSETS<IF.LINE.FOUND>
                    IF CUR.CHAR >= OBJ.LEN THEN GOTO BUILD.SOURCE.LINE.9
                    RESULT = ''
                    IF SOURCE.LINE[4] = 'THEN' THEN
                       RESULT = 'NULL '
                    END
                    OP.TYPE = 1
                    IF SOURCE.LINE[4] = 'NEXT' THEN
                       RESULT := '; ELSE'
                    END ELSE
                       RESULT := 'ELSE'
                    END
                    GOTO BUILD.SOURCE.LINE.10
                 END
              END
           END
BUILD.SOURCE.LINE.9:*
           DMY.LINE.NO = STACK(STACKPTR)
           LABEL = DMY.LINE.NO: ': '
           IF SOURCE(DMY.LINE.NO)[1,LEN(LABEL)] # LABEL THEN
              SOURCE(DMY.LINE.NO) = LABEL : SOURCE(DMY.LINE.NO)
           END
     END CASE

BUILD.SOURCE.LINE.10: *

     STACKPTR -= NUM.STACK.ELEMENTS
     IF STACKPTR < 0 THEN STACKPTR = 0

     BEGIN CASE
        CASE OP.TYPE = -1
           STACKPTR = 0
        CASE OP.TYPE = 1 OR OP.TYPE = 2
           IF LEN(SOURCE.LINE) THEN
              IF SOURCE.LINE[6] = 'LOCKED' OR SOURCE.LINE[4] = 'ELSE' OR SOURCE.LINE[4] = 'THEN' OR RESULT[4] = 'ELSE' OR RESULT = 'LOCKED' OR (TRIM(SOURCE.LINE[1,10]) MATCHES "0N':'") THEN
                 SOURCE.LINE := ' '
              END ELSE
                 IF (OPCODE = 54 OR OPCODE = 55) AND SOURCE.LINE[1] = ':' THEN
                    NULL
                 END ELSE
                    SOURCE.LINE := ' ; '
                 END
              END
           END
           SOURCE.LINE := RESULT
           STACKPTR = 0
        CASE OTHERS$
           STACKPTR += 1
           STACK(STACKPTR) = RESULT
           OPCODE = PREV.OPCODE
     END CASE

     RETURN


*

PROCESS.REST.OF.LINE: *

**-- IS THIS A... X = IF-THEN-ELSE

     IF STACKPTR = 2 AND STACK(STACKPTR) = 5 THEN
        SOURCE.LINE = STACK(2) : ' = ':SOURCE.LINE
        STACKPTR = 0
        RETURN
     END
     FOR STACKPTR = STACKPTR TO 1 STEP -1
        IF LEN(SOURCE.LINE) THEN
           SOURCE.LINE := '; '
        END
        ITEM = STACK(STACKPTR)
        IF NUM(ITEM) THEN
           IF ITEM < 0 THEN ITEM = (-ITEM) + 95
           ITEM = ITEM + 1000
        END ELSE
           ITEM = '5000,':ITEM
        END
        SOURCE.LINE := '####(':ITEM:')'
     NEXT STACKPTR
     STACKPTR = 0
     RETURN

*

CONVERT.SHORT.INTEGER:

     CALL @BINARY.CONVERT(NUM.IN,"IS",1,NUM.OUT,STATUS)
     IF STATUS # '' THEN
        CONVERT @FM TO '~' IN STATUS
        PRINT "     Short integer conversion error, status: ": STATUS
     END
     RETURN

*

CONVERT.LONG.INTEGER:

     CALL @BINARY.CONVERT(NUM.IN,"IL",1,NUM.OUT,STATUS)
     IF STATUS # '' THEN
        CONVERT @FM TO '~' IN STATUS
        PRINT "     Long integer conversion error, status: ": STATUS
     END

     RETURN

*

CONVERT.FLOATING.POINT:

     SPECIAL.MANTISA = NUM.IN[1,1]
     MANTISA = NUM.IN[2,6]
     DECIMAL.POS = NUM.IN[7,1]
     EXPONENT = NUM.IN[8,1]
     MANTISA.NUM = 0
     DECIMAL.POS.NUM = 0
     SPECIAL.MANTISA.NUM = 0
     EXPONENT.NUM = 0
     NUM.CNTR = 0
     NUM.FLAG = 0
     FOR NUM.INDX = 5 TO 1 STEP -1
        IF MANTISA[NUM.INDX,1] # CHAR(0) OR NUM.FLAG THEN
           MANTISA.NUM += (SEQ(MANTISA[NUM.INDX,1])-128) * PWR(256,NUM.CNTR)
           NUM.CNTR += 1
           NUM.FLAG = 1
        END
     NEXT I
     DECIMAL.POS.NUM = 129 - SEQ(DECIMAL.POS)
     EXPONENT.NUM = MOD(SEQ(EXPONENT)+128,256) - 132
     NUM.OUT = ((SPECIAL.MANTISA.NUM / 80) * (PWR(2,EXPONENT.NUM)))
     DMY.NUM = MANTISA.NUM / PWR(2,(DECIMAL.POS.NUM-1))
     NUM.OUT += DMY.NUM
     NUM.OUT = NUM.OUT * (PWR(10,DECIMAL.POS.NUM))
*     CALL @BINARY.CONVERT(NUM.IN,"FD",1,NUM.OUT,STATUS)
     IF STATUS # '' THEN
        PRINT "FLOATING POINT CONVERSION ERROR, STATUS: ": STATUS
     END

     RETURN

*

CONVERT.3.BYTE.OFFSET:

     FIRST.CHAR = OBJ.LINE[CUR.CHAR+1,1]
     LAST.2.CHARS = OBJ.LINE[CUR.CHAR+2,2]
     IF SEQ(FIRST.CHAR) LT 128 THEN
        NUM.IN = CHAR(127)              ;* SIGN EXTEND NEGATIVE NUMBER
     END ELSE
        NUM.IN = CHAR(128)              ;* LEADING ZERO FOR POSITIVE NUMBER
     END
     NUM.IN := FIRST.CHAR: LAST.2.CHARS
     CUR.CHAR += 3
     GOSUB CONVERT.LONG.INTEGER
     GOSUB GENERATE.LINE.LABEL
     RETURN

*

GENERATE.LINE.LABEL:

     OFFSET = NUM.OUT
     PRINT.LINE := "[offset ": OFFSET: "] "

     IF OFFSET LT 0 THEN                ;* I.E. WE'RE GOING UP
        STEP.LINE = -1
        FIRST.LINE = CUR.LINE - 1
        LAST.LINE = 1
        COUNT = CUR.CHAR                ;* MUST CONSIDER OBJECT BYTES UP TO & INCLUDING THE BRANCH
     END ELSE
        STEP.LINE = 1
        FIRST.LINE = CUR.LINE + 1
        LAST.LINE = LINES
        OFFSET += 1                     ;* ADJUST BECAUSE OFFSET STARTS AT ZERO
        COUNT = XREF(CUR.LINE) - CUR.CHAR
     END

     ABS.OFFSET = ABS(OFFSET)
     IF COUNT GE ABS.OFFSET THEN        ;* SINGLE-LINE IF-THEN-ELSE OR SOMETHING
        BRANCH.LINE = CUR.LINE
        BRANCH.OFFSET = ABS.OFFSET + CUR.CHAR
        REL.LINE = CUR.LINE
        RETURN
     END

     REL.LINE = FIRST.LINE
     ACCUM = 0
     BACK.LINE.UP = 0
     LOOP
        COUNT += XREF(REL.LINE)
     UNTIL COUNT GE ABS.OFFSET OR REL.LINE EQ LAST.LINE
        ACCUM += XREF(REL.LINE)
        IF ACCUM GT ABS.OFFSET THEN
           ACCUM -= XREF(REL.LINE)
        END
        REL.LINE += STEP.LINE
     REPEAT
     IF ACCUM = 0 THEN BACK.LINE.UP = -1
     BRANCH.LINE = REL.LINE + BACK.LINE.UP
     BRANCH.OFFSET = ABS.OFFSET - ACCUM
     IF ACCUM = 0 THEN
        BRANCH.OFFSET = XREF(REL.LINE-1) + 1
     END
     IF BRANCH.OFFSET LT 4 AND BRANCH.OFFSET GT 0 THEN
        BRANCH.LINE -= 1
        BRANCH.OFFSET = XREF(BRANCH.LINE) + 1
     END

     PRINT.LINE := '  [line #':REL.LINE:']'

     RETURN

*

BUILD.SUBROUTINE.STATEMENT:

     ARGSTRING = ''
     FOR I = 1 TO NUM.ARGUMENTS
        IF LEN(ARGSTRING) THEN ARGSTRING := ','
        ARGSTRING := VARNAME(I,1)
     NEXT I

     SOURCE(1) = "SUBROUTINE ": PROGRAM.NAME: "(": ARGSTRING: ")"

     RETURN

*

WRITE.SOURCE:

     SOURCE.HEADER = ''
     SOURCE.HEADER<-1> = '****'
     SOURCE.HEADER<-1> = '* ':PROGRAM.NAME:' decompiled at ':TIMEDATE():'     [CISAB Rev ':REV.LEVEL:']'
     SOURCE.HEADER<-1> = '*'
     SOURCE.HEADER<-1> = '* Item last updated . . . ':CURRENT.ATTACH.POINT:'  ':TIMEDATE()
     SOURCE.HEADER<-1> = '*'
     SOURCE.HEADER<-1> = '****'

     IF SOURCE(1) MATCHES 'SUBROUTINE...' THEN
        SOURCE(1)<-1> = SOURCE.HEADER
     END ELSE
        SOURCE(1) = SOURCE.HEADER:@FM:SOURCE(1)
     END


     MATWRITE SOURCE TO OUTPUT.FILE, PROGRAM.NAME:".DECOMP"
     WRITE PROG.ASM TO OUTPUT.FILE, PROGRAM.NAME:'.DASM'
     MATWRITE VARNAME TO OUTPUT.FILE,PROGRAM.NAME:".VARS"

     RETURN

*

CLOSE.FILE:

*      EXECUTE "! CLOSE -UNIT ":UNIT
     CALL @SRSFX$(K$CLOS,PATHNAME,UNIT,TYPE,NUM.SUFFIXES,SUFFIX.LIST,FILENAME,SUFFIX.USED,STATUS)

     RETURN

*

INITIALIZE:

     REV.LEVEL = '1.1'                  ;* Update as necessary.
     PRINT
     PRINT
     PRINT 'CISAB  -  INFO/BASIC object code decompiler      Rev. ':REV.LEVEL
     PRINT 'FHP Software Development  (MIS)'
     PRINT
     PRINT
     CURRENT.ATTACH.POINT = ''
     CALL @FULL.PATH$(CURRENT.ATTACH.POINT)

     PROMPT ''

     SRSFX$           = "$SRSFX"
     PRWF$$           = "$PRWF"
     BINARY.CONVERT   = "!BINARY.CONVERT"
     NUM.OUT          = 0
     BLOCK.SIZE       = 94
     BUFFER           = SPACE(2*BLOCK.SIZE)
     READ.NO.OF.WORDS = 0
     CODE             = 0
     IF @(0,0) THEN NULL                ;* DISABLE PRESS NEWLINE TO CONTINUE
     STREAM = FIELD(TRIM(@SENTENCE),' ',2,LEN(@SENTENCE))
     MORE.RECORD.IDS = LEN(STREAM) GT 0

     CONVERT ' ' TO @FM IN STREAM

     DONE = FALSE$
     LOOP
        READNEXT ITEM ELSE
           DONE = TRUE$
        END
     UNTIL DONE
        STREAM<-1> = ITEM
     REPEAT

     CONVERT LCASE$ TO UCASE$ IN STREAM
     RECORD.COUNTER = 0
     TO.LPTR = TRUE$
     LOCATE '-LPTR' IN STREAM<1> SETTING POS ELSE TO.LPTR = FALSE$
     IF TO.LPTR THEN
        PRINT 'Diverting output to LPTR.'
        DEL STREAM<POS>
     END

     NO.XREF = TRUE$
     LOCATE '-NOXREF' IN STREAM<1> SETTING POS ELSE NO.XREF = FALSE$
     IF NO.XREF THEN
        DEL STREAM<POS>
        PRINT 'XREF suppressed.'
     END

     NO.VARS = TRUE$
     LOCATE '-NOVARS' IN STREAM<1> SETTING POS ELSE NO.VARS = FALSE$
     IF NO.VARS THEN
        DEL STREAM<POS>
        PRINT 'VARS suppressed.'
     END

     NO.ASM = TRUE$
     LOCATE '-NOASM' IN STREAM<1> SETTING POS ELSE NO.ASM = FALSE$
     IF NO.ASM THEN
        DEL STREAM<POS>
     END

     REDIRECTED = TRUE$
     LOCATE '-REDIR' IN STREAM<1> SETTING POS ELSE REDIRECTED = FALSE$
     IF REDIRECTED THEN
        REDIRECTED.FILENAME = STREAM<POS+1>
        IF REDIRECTED.FILENAME EQ '' THEN
           STOP 'Redirected filename missing.'
        END
        DEL STREAM<POS+1>
        DEL STREAM<POS>
        OPEN '',REDIRECTED.FILENAME TO OUTPUT.FILE ELSE
           PRINT 'Unable to open the ':REDIRECTED.FILENAME:' redirection file.'
           STOP
        END
        PRINT 'Source output redirecting to ':REDIRECTED.FILENAME:' file.'
     END
     REMOVE FILENAME FROM STREAM SETTING MORE.RECORD.IDS
     IF FILENAME NE '' AND NOT(REDIRECTED) THEN
        OPEN '',FILENAME TO OUTPUT.FILE ELSE
           STOP 'Unable to open ':FILENAME:' file.'
        END
     END
     IF NOT(MORE.RECORD.IDS) THEN
        PRINT 'USAGE: CISAB filename [{recordname}] [args]'
        PRINT '       args are as follows:'
        PRINT '     -LPTR           Diverts output to lineprinter.'
        PRINT '     -REDIR filename Redirects output to alternate file.'
        PRINT "     -NOXREF         Suppress' the generation of the XREF record."
        PRINT "     -NOVARS         Suppress' the generation of the VARS record."
        PRINT '  This command will work from the default select list.'
        STOP
     END

     PRINT "Initializing "

     READV ROOT FROM VOC.FILE,FILENAME,2 ELSE
        STOP 'Unable to read ':FILENAME:' from VOC file.'
     END
     IF INDEX(ROOT,'>',1) EQ 0 THEN
        ROOT = '*>':ROOT
     END

                                        ;* LOAD THE OPCODES INTO THE REGULAR OPCODES ARRAY
                                        ;* OR THE EXTENDED OPCODES ARRAY
     OPEN '','OP.CODES' TO OP.CODES.FILE ELSE
        PRINT 'Unable to open the OP.CODES file.'
        STOP
     END

     SELECT OP.CODES.FILE TO 2

     MAT OPCODES            = ''
     MAT EXT.OPCODES        = ''
     MAT STMT.STRUCTS       = ''
     MAT EXT.STMT.STRUCTS   = ''
     MAT EXT.STACK.ELEMENTS = 0
     MAT STACK.ELEMENTS     = 0
     MAT OP.TYPES           = 0
     MAT EXT.OP.TYPES       = 0

     I = 0
     DONE = FALSE$
     LOOP
        READNEXT OP.CODE.KEY FROM 2 ELSE DONE = TRUE$
     UNTIL DONE
        IF NOT(MOD(I,10)) THEN PRINT 'i':
        I += 1
        READ OP.CODES.REC FROM OP.CODES.FILE, OP.CODE.KEY ELSE
           STOP 'Unable to read ':OP.CODE.KEY:' from OP.CODES file.'
        END
        IF OP.CODE.KEY < 0 THEN
           EXT.OPCODES(ABS(OP.CODE.KEY)) = OP.CODES.REC<1>
           EXT.STMT.STRUCTS(ABS(OP.CODE.KEY)) = OP.CODES.REC<4>
           EXT.STACK.ELEMENTS(ABS(OP.CODE.KEY)) = OP.CODES.REC<2>
           EXT.OP.TYPES(ABS(OP.CODE.KEY)) = OP.CODES.REC<5>
        END ELSE
           OPCODES(OP.CODE.KEY) = OP.CODES.REC<1>
           STMT.STRUCTS(OP.CODE.KEY) = OP.CODES.REC<4>
           STACK.ELEMENTS(OP.CODE.KEY) = OP.CODES.REC<2>
           OP.TYPES(OP.CODE.KEY) = OP.CODES.REC<5>
        END
     REPEAT
     PRINT

     RETURN

RESET:

     PROG.ASM               = ''
     MAT STACK   = ''
     FOR.LINES   = ''
     FOR.OFFSETS = ''                   ;* OFFSET WITHIN THE "FOR.LINES" LINE
     IF.LINES    = ''
     IF.OFFSETS  = ''

     STACKPTR    = 0

     RETURN

  END