$PAGEWIDTH(80) DEBUG TITLE('8080 DISASSEMBLER FOR ISIS-II')


DISASS:	DO;

/*REF. NO.  BD8*/


 /*
	THIS PROGRAM TAKES A HEX FILE AND GENERATES AN ASSEMBLY
	LANGUAGE PROGRAM SUITABLE TO BE LOADED INTO THE ASSEMBLER.

	THIS PROGRAM WILL WORK BEST ON PROGRAMS WHICH HAVE ALL
	DATA AT THE END OF THE PROGRAM; THUS THEY DON'T MESS
	UP THE ASSEMBLING OF REAL INSTRUCTIONS.

	ALL 16-BIT OPERANDS ARE EXPRESSED AS A LABEL 'LXXXX',
	WHERE XXXX IS A 4-DIGIT DECIMAL NUMBER.  DATA IS OUTPUT
	IN THE OPERAND FIELD OF TWO-BYTE INSTRUCTIONS AS A HEX
	NUMBER.  THEN, AS AN AID, THE OPERAND IS OUTPUT  IN A
	COMMENT IN DECIMAL, OCTAL, AND ASCII FORM.  IF THE ASCII
	VALUE IS A NON-PRINTING CHARACTER, THEN IT IS OUTPUT AS A
	3-DIGIT OCTAL VALUE IN BRACKETS, E.G. <000>.

  **** NOTE: THIS PROGRAM ORIGINALLY USED PAPER TAPE AS BOTH ****
  ****       THE INPUT AND OUTPUT. IT NOW USES ISIS FILES.   ****
  ****       ALSO, THE PUNCH/LIST OPTION HAS BEEN DISABLED,  ****
  ****       AND THE LOCATION AND CONTENT FIELDS THAT WERE   ****
  ****       INCLUDED IN THE LIST FILE HAVE BEEN DELETED FOR ****
  ****       ASM80 COMPATIBILITY REASONS.  THEY INVOLVED     ****
  ****       COMMENTING OUT STATEMENTS THAT REFERENCED       ****
  ****       NOT$PUNCH.  THIS PROGRAM MUST BE LINKED TO      ****
  ****       SYSTEM.LIB AND PLM80.LIB.     (GC 8/18/78)      ****

          COMMAND INVOCATION:  DISASM <INFILE> TO <OUTFILE>

                  <INFILE>  - AN ISIS-II FILE REPRESENTING AN
                              OBJECT FILE IN HEX FORMAT

                  <OUTFILE> - AN ISIS-II FILE THAT RECEIVES THE
                              RESULTING ASSEMBLY LANGUAGE SOURCE
                              PROGRAM.

*/
	DECLARE STATUS ADDRESS;
	DECLARE IS LITERALLY 'LITERALLY',
	CR IS '15Q',
	LF IS '12Q',
	DCL IS 'DECLARE',
	FALSE IS '0',
	TRUE IS '1',
	START$PUNCH IS '12H',
	STOP$PUNCH IS '14H',
	LOWEST$ASCII IS '20H',
	HIGHEST$ASCII IS '5FH',
	MVI IS '12',
	LXI IS '22',
	TAB IS    '11Q',
	CRLF IS 'STROUT(.INTRO,2)',
	DBL IS 'DOUBLE',
	QUOTE IS '47Q';

	/* MAXSYMBOLS IS THE MAXIMUM NUMBER OF SYMBOLS ALLOWED
	   IN THE SYMBOL TABLE.  */

	DECLARE MAXSYMBOLS IS '1500';

	/* THE FOLLOWING SYMBOLS HAVE THE FOLLOWING MEANING:

	PASS		PASS NUMBER - 0 (FALSE) = PASS 1,
				      1 (TRUE) = PASS 2.

	END$PASS	TRUE WHEN END OF HEX TAPE IS FOUND

	LABEL$NO	CONTAINS NUMBER OF LABELS DEFINED

	SYMBOL$DEFINED	CONTAINS ONE BIT FOR EACH ENTRY IN THE
			SYMBOL TABLE.  IF THE BIT=1, THEN THE
			ENTRY IS DEFINED.

	SYMBOL$OUTPUT	CONTAINS ONE BIT FOR EACH ENTRY IN THE
			SYMBOL TABLE.  IF THE BIT=1, THEN THE
			SYMBOL AT THAT LOCATION HAS BEEN OUTPUT.

	SYMBOL$NAME	CONTAINS THE NAME (DECIMAL NUMBER IN LXXXX)
			OF THE CORRESPONDING LOCATION IN THE
			SYMBOL TABLE.

	SYMBOL$VALUE	CONTAINS THE VALUE OF THE SYMBOL AT THAT
			LOCATION IN THE SYMBOL TABLE.

	SYMBOL$NAME AND SYMBOL$VALUE MAKE UP THE SYMBOL TABLE.

	DUMMY,TEMP	TEMPORARY BYTE VARIABLES

	INSTR		BYTE VALUE OF THE INSTRUCTION

	BYTE$COUNT	NO. OF DATA BYTES REMAINING IN THE CURRENT
			BLOCK OF TAPE.

	CKSUM		CONTAINS RUNNING CHECKSUM OF THE BLOCK.

	CODE		CODE USED TO DETERMINE TYPE OF INSTRUCTION
			(SEE BELOW)

	PUNCH		TRUE IF PUNCH OUTPUT WAS REQUESTED,
			FALSE IF LISTING WAS REQUESTED. (NOT IMPLEMENTED.)

	NEW$ADDRESS	ADDRESS OF A NEW DATA BYTE READ FROM THE TAPE.

	OLD$ADDRESS	ADDRESS OF THE LAST DATA BYTE READ.

	OPERAND		VALUE OF THE OPERAND IN TWO- AND THREE-BYTE
			INSTRUCTIONS.

*/


	DECLARE PASS$MESSAGE (*) BYTE DATA (CR,LF,'LOAD HEX TAPE ',
	    'FOR PASS '),(PASS,END$PASS,NOT$PUNCH) BYTE,LABEL$NO
	    ADDRESS, (SYMBOL$DEFINED,SYMBOL$OUTPUT) (256) BYTE,
	    (SYMBOL$NAME,SYMBOL$VALUE) (MAXSYMBOLS) ADDRESS;

	DECLARE (DUMMY,TEMP,INSTR,BYTE$COUNT,CKSUM,CODE,NSPACES,PUNCH) BYTE,
	    (NEW$ADDRESS,OLD$ADDRESS,OPERAND) ADDRESS;

	DECLARE (AFTN, OUT$AFTN) ADDRESS;	/* I/O DECLARATIONS */
	DECLARE BUFFER(128) BYTE;
	DECLARE DINBUFFER (128) BYTE,
		DOUTBUFFER (128) BYTE,
		(DINBUFPTR, DOUTBUFPTR, DINBUFEND) BYTE INITIAL(-1,-1,-1);

	DECLARE INTRO (*) BYTE DATA (CR,LF,'LIST (L) OR PUNCH (P)?'),
	    ENDSTRING (*) BYTE DATA (CR,LF,'        END',CR,LF,CR,LF),
	    REGS (*) BYTE DATA ('BCDEHLMA'),
	    SP (*) BYTE DATA ('SP'),
	    PSW (*) BYTE DATA ('PSW'),
	    READ$ERROR (*) BYTE DATA (CR,LF,'READ ERROR',CR,LF),
	    CSERROR (*) BYTE DATA (CR,LF,'CHECKSUM ERROR',CR,LF),
	    ORG (*) BYTE DATA (CR,LF,'        ORG 0'),
	    ORGEND (*) BYTE DATA ('H',CR,LF,CR,LF);



 /*
	THE FOLLOWING TABLE CONTAINS TWO ENTRIES FOR EACH
	MNEMONIC IN THE 8080 INSTRUCTION SET.  THE FIRST
	ENTRY IS THE 4-BYTE ASCII REPRESENTATION OF THE
	MNEMONIC ITSELF.  THE SECOND ENTRY IS A CODED
	VALUE INDICATING ONE OF THE FOLLOWING TYPE OF
  	INSTRUCTION:

	 1	ONE BYTE INSTRUCTION, NO ARGUMENT
	 2	ONE BYTE, ONE REGISTER ARGUMENT
	 3	ONE BYTE, TWO REGISTER ARGUMENTS (MOV)
	 4	PUSH OR POP
	 5	DAD, INX, DCX, STAX, OR LDAX
	 6	RST
	 7	INR,DCR

	11	DOUBLE BYTE INSTRUCTION, ONE ARGUMENT
	12	DOUBLE BYTE, ONE REGISTER AND ONE DATA (MVI)

	21	TRIPLE BYTE INSTRUCTION, ONE ARGUMENT
	22	TRIPLE BYTE, ONE REGISTER AND ONE DATA (LXI)

	31	ILLEGAL INSTRUCTION - ASSUMED TO BE DATA

*/

	DECLARE MNEMONICS (*) BYTE DATA (
	'NOP ', 1,'LXI ',22,'STAX', 5,'INX ', 5,'INR ', 7,
	'DCR ', 7,'MVI ',12,'RLC ', 1,'DB 0',31,'DAD ', 5,
	'LDAX', 5,'DCX ', 5,'RRC ', 1,'RAL ', 1,'RAR ', 1,
	'SHLD',21,'DAA ', 1,'LHLD',21,'CMA ', 1,'STA ',21,
	'STC ', 1,'LDA ',21,'CMC ', 1,'MOV ', 3,'HLT ', 1,
	'ADD ', 2,'ADC ', 2,'SUB ', 2,'SBB ', 2,'ANA ', 2,
	'XRA ', 2,'ORA ', 2,'CMP ', 2,'RNZ ', 1,'POP ', 4,
	'JNZ ',21,'JMP ',21,'CNZ ',21,'PUSH', 4,'ADI ',11,
	'RST ', 6,'RZ  ', 1,'RET ', 1,'JZ  ',21,'CZ  ',21,
	'CALL',21,'ACI ',11,'RNC ', 1,'JNC ',21,'OUT ',11,
	'CNC ',21,'SUI ',11,'RC  ', 1,'JC  ',21,'IN  ',11,
	'CC  ',21,'SBI ',11,'RPO ', 1,'JPO ',21,'XTHL', 1,
	'CPO ',21,'ANI ',11,'RPE ', 1,'PCHL', 1,'JPE ',21,
	'XCHG', 1,'CPE ',21,'XRI ',11,'RP  ', 1,'JP  ',21,
	'DI  ', 1,'CP  ',21,'ORI ',11,'RM  ', 1,'SPHL', 1,
	'JM  ',21,'EI  ', 1,'CM  ',21,'CPI ',11);


 /*
	THE FOLLOWING TABLE CONTAINS 256 ENTRIES - ONE FOR EACH
	POSSIBLE COMBINATION OF 8 BITS.  THE DATA READ FROM THE
	TAPE ARE  THE ENTRY INTO THIS
	TABLE CORRESPONDING TO THE VALUE OF ANY 8-BIT BYTE REFERS
	TO THE ENTRY NUMBER IN THE TABLE ABOVE, E.G. NOP (OP-CODE = 0)
	REFERS TO ENTRY NUMBER 0 IN THE MNEMONICS TABLE, LXI REFERS TO
	ENTRY NUMBER 1 IN THE MNEMONICS TABLE.

*/
	DECLARE OPCODE (256) BYTE DATA (
	 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11, 4, 5, 6,12,
	 8, 1, 2, 3, 4, 5, 6,13, 8, 9,10,11, 4, 5, 6,14,
	 8, 1,15, 3, 4, 5, 6,16, 8, 9,17,11, 4, 5, 6,18,
	 8, 1,19, 3, 4, 5, 6,20, 8, 9,21,11, 4, 5, 6,22,
	23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
	23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
	23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
	23,23,23,23,23,23,24,23,23,23,23,23,23,23,23,23,
	25,25,25,25,25,25,25,25,26,26,26,26,26,26,26,26,
	27,27,27,27,27,27,27,27,28,28,28,28,28,28,28,28,
	29,29,29,29,29,29,29,29,30,30,30,30,30,30,30,30,
	31,31,31,31,31,31,31,31,32,32,32,32,32,32,32,32,
	33,34,35,36,37,38,39,40,41,42,43, 8,44,45,46,40,
	47,34,48,49,50,38,51,40,52, 8,53,54,55, 8,56,40,
	57,34,58,59,60,38,61,40,62,63,64,65,66, 8,67,40,
	68,34,69,70,71,38,72,40,73,74,75,76,77, 8,78,40)

;

 /*	THE FOLLOWING PROCEDURES ARE PL/M LINKS TO SYSTEM.LIB 
	I/O SUBROUTINES IN THE ISIS-II/MONITOR.  */


OPEN: PROCEDURE (AFT, FILE, ACCESS, MODE, STATUS) EXTERNAL;
	DECLARE (AFT, FILE, ACCESS, MODE, STATUS) ADDRESS;
END OPEN;

READ: PROCEDURE (AFT, BUF, CNT, ACTUAL, STATUS) EXTERNAL;
	DECLARE (AFT, BUF, CNT, ACTUAL, STATUS) ADDRESS;
END READ;

WRITE: PROCEDURE (AFT, BUF, CNT, STATUS) EXTERNAL;
		DECLARE (AFT, BUF, CNT, STATUS) ADDRESS;
END WRITE;

ERROR: PROCEDURE (ERR) EXTERNAL;
	DECLARE ERR ADDRESS;
END ERROR;

CLOSE: PROCEDURE (AFT, STATUS) EXTERNAL;
	DECLARE (AFT, STATUS) ADDRESS;
END CLOSE;

EXIT:	PROCEDURE EXTERNAL;
	END EXIT;

CI:	PROCEDURE BYTE EXTERNAL;    /* INPUT CHARACTER FROM THE TELETYPE */
	END CI;

LO:	PROCEDURE(CHAR) EXTERNAL;   /* OUTPUT CHARACTER TO THE LIST DEVICE */
		DCL CHAR BYTE;
	END LO;

PO:	PROCEDURE(CHAR) EXTERNAL;   /* OUTPUT CHARACTER TO THE PUNCH DEVICE */
		DCL CHAR BYTE;
	END PO;

RI:	PROCEDURE BYTE EXTERNAL;   /* READ A CHARACTER FROM THE READER DEVICE */
	END RI;

ISISERR: PROCEDURE;
	CALL ERROR(STATUS);
	CALL EXIT;
END ISISERR;

CMD$TAIL$ERROR: PROCEDURE;
				/* PRINT COMMAND TAIL ERROR AND STOP */

	CALL WRITE (0, .(CR, LF, 'ERROR IN COMMAND TAIL.', CR, LF,
	  'PLEASE TRY AGAIN.', CR, LF, LF), 46, .STATUS);
	IF STATUS > 0 THEN CALL ISISERR;
	CALL EXIT;

END CMD$TAIL$ERROR;

DOPEN: PROCEDURE;
	DECLARE DUMY ADDRESS;		/*OPEN DISK INPUT FILE */

	IF NOT PASS THEN
	DO;
	  CALL READ(1, .BUFFER, 50, .DUMY, .STATUS);
	  IF STATUS > 0 THEN CALL ISISERR;
	END;

	CALL OPEN(.AFTN, .BUFFER, 1, 0, .STATUS);
	IF STATUS > 0 THEN CALL ISISERR;

	RETURN;
END DOPEN;

DI: PROCEDURE BYTE;			/* READ A BYTE FROM INPUT FILE */

	DECLARE ACTUAL ADDRESS;

	IF DINBUFPTR+1 = DINBUFEND THEN  /* FILL INPUT BUFFER */
	DO;
	  CALL READ (AFTN, .DINBUFFER, 128, .ACTUAL, .STATUS);
	  IF STATUS > 0 THEN CALL ISISERR;
	  DINBUFPTR = -1;
	  DINBUFEND = ACTUAL;
	END;

	DINBUFPTR = DINBUFPTR + 1;
	RETURN DINBUFFER(DINBUFPTR);

END DI;

DSKO: PROCEDURE (CHAR);		/* WRITE A BYTE TO OUTPUT FILE */

	DECLARE CHAR BYTE;

	IF DOUTBUFPTR = 127 THEN   /* OUTPUT BUFFER FULL. WRITE IT. */
	DO;
	  CALL WRITE (OUT$AFTN, .DOUTBUFFER, 128, .STATUS);
	  IF STATUS > 0 THEN CALL ISISERR;
	  DOUTBUFPTR = -1;
	END;

	DOUTBUFPTR = DOUTBUFPTR + 1;
	DOUTBUFFER(DOUTBUFPTR) = CHAR;
	RETURN;

END DSKO;

DOPEN$OUT: PROCEDURE;			/* OPEN OUTPUT FILE */

	DECLARE (I,J) BYTE,
		TO$PTR ADDRESS,
		ASCII$TO BASED TO$PTR BYTE;

	I = 1;
	DO WHILE (BUFFER(I) <> 20H AND BUFFER(I) <> 0DH);
	  I = I + 1;
	END;

	TO$PTR = .(' TO ');
	DO J=0 TO 3;
	  IF BUFFER(I+J) <> ASCII$TO THEN CALL CMD$TAIL$ERROR;
	  TO$PTR = TO$PTR + 1;
	END;

	CALL OPEN (.OUT$AFTN, .BUFFER(I+3), 2, 0, .STATUS);
	IF STATUS > 0 THEN CALL ISISERR;

END DOPEN$OUT;

	/* OUTPUT A CHARACTER TO THE LIST DEVICE IF LISTING THE
	   PROGRAM, TO THE PUNCH DEVICE IF PUNCHING.  */

CHAROUT: PROCEDURE(CHAR);
	DCL CHAR BYTE;
	IF PUNCH THEN CALL PO(CHAR);
	    ELSE CALL DSKO(CHAR);
	END CHAROUT;


	/* OUTPUT AN ASCII STRING ADDRESSED BY 'STRING' OF
	   LENGTH 'LENGTH'.  */

STROUT:	PROCEDURE (STRING,LENGTH);
	DCL STRING ADDRESS, (LENGTH,I) BYTE;
	DCL CHARS BASED STRING  (1) BYTE;

	DO I=0 TO LENGTH-1;
	    CALL CHAROUT(CHARS(I));
	END;
	END STROUT;


	/* OUTPUT A NUMBER BASE 'BASE' WITH 'CHARS' CHARACTERS.  IF
	   ZERO$SUPPRESS IS FALSE, THEN ALWAYS OUTPUT 'CHARS' NUMBER
	   OF CHARACTERS.  OTHERWISE, DELETE LEADING ZEROES.  */

PRINT$NUMBER: PROCEDURE (NUMBER,BASE,CHARS,ZERO$SUPPRESS);
	DCL NUMBER ADDRESS, (BASE,CHARS,ZERO$SUPPRESS,I,J,K) BYTE;
	DCL TEMP(8) BYTE;
	IF CHARS > LAST(TEMP) THEN CHARS = LAST(TEMP);
	K=0;
	DO I=1 TO CHARS;
	    J=NUMBER MOD BASE + '0';
	    IF J>'9' THEN J=J+7;	/* MAKE IT A HEX DIGIT */
	    IF ZEROSUPPRESS AND I<>1 AND NUMBER=0 THEN K=K+1;
	    TEMP(LENGTH(TEMP)-I)=J;
	    NUMBER=NUMBER / BASE;
	END;
	NUMBER=.TEMP+LENGTH(TEMP)-CHARS+K;
	K=CHARS-K;
	CALL STROUT(NUMBER,K);
END PRINTNUMBER;

	/* THIS PROCEDURE RETURNS TRUE IF THE ARGUMENT (BIT$NO)
	   IS A DEFINED SYMBOL, FALSE IF NOT.  */

	DECLARE (TMP1,TMP2,TMP3) BYTE;

DEFINED: PROCEDURE(BIT$NO) BYTE;
	DCL BIT$NO ADDRESS;
	TMP1=BIT$NO / 8;
	TMP2 = SYMBOL$DEFINED(TMP1);
	TMP3 = BIT$NO AND 7;
	IF TMP3 = 0 THEN TMP3 = 1;
	    ELSE TMP3 = SHL(1,TMP3);
	IF (TMP3 AND TMP2) = 0 THEN RETURN FALSE;
	    ELSE RETURN TRUE;
END DEFINED;

	/* THIS ROUTINE HASHES A SYMBOL INTO THE SYMBOL TABLE.
	   THE VALUE OF THE SYMBOL MODULO MAXSYMBOLS IS USED
	   AS THE INDEX INTO THE SYMBOL TABLE.  IF THAT
	   LOCATION IS OCCUPIED, THEN THE FIRST UNOCCUPIED
	   LOCATION IS SEARCHED FOR AND USED.  */

HASH:	PROCEDURE (VALUE);
	DCL VALUE ADDRESS, VAL$MOD$MAX ADDRESS;

	VAL$MOD$MAX = VALUE MOD MAXSYMBOLS;
	DO WHILE TRUE;
	    IF DEFINED(VAL$MOD$MAX) THEN
		DO;
		IF SYMBOL$VALUE(VAL$MOD$MAX) = VALUE THEN RETURN;
		ELSE VAL$MOD$MAX = (VAL$MOD$MAX + 1) MOD MAXSYMBOLS;
		END;
	    ELSE DO;
		SYMBOL$DEFINED(TMP1) = TMP2 OR TMP3;
		SYMBOL$VALUE(VAL$MOD$MAX) = VALUE;
		SYMBOL$NAME(VAL$MOD$MAX) = LABEL$NO;
		LABEL$NO = LABEL$NO + 1;
		RETURN;
		END;
	END;
END HASH;


	/* IN$TABLE RETURNS A TRUE VALUE IF THE ARGUMENT
	   ('VALUE') IS IN THE SYMBOL TABLE, FALSE IF NOT.  */

	DECLARE VAL$MOD$MAX ADDRESS;

IN$TABLE: PROCEDURE(VALUE) BYTE;
	DCL VALUE ADDRESS;
	VAL$MOD$MAX = VALUE MOD MAXSYMBOLS;
	DO WHILE TRUE;
	IF NOT DEFINED(VAL$MOD$MAX) THEN RETURN FALSE;
	IF SYMBOL$VALUE(VAL$MOD$MAX) = VALUE THEN RETURN TRUE;
	VAL$MOD$MAX = (VAL$MOD$MAX + 1) MOD MAXSYMBOLS;
	END;
END IN$TABLE;

GET$SYMBOL$NAME: PROCEDURE ADDRESS;
	SYMBOL$OUTPUT(TMP1) = SYMBOL$OUTPUT(TMP1) OR TMP3;
	RETURN SYMBOL$NAME(VAL$MOD$MAX);
END GET$SYMBOL$NAME;

	/* INITIALIZATION ROUTINE */

INIT:	PROCEDURE;
	END$PASS = FALSE;
	IF NOT PASS THEN
	    DO;
	    LABEL$NO = 0;
	    DO TEMP = 0 TO 255;
		SYMBOL$DEFINED(TEMP)=0;
		SYMBOL$OUTPUT(TEMP)=0;
	    END;
	    END;
	BYTE$COUNT,CKSUM = 0;		/* CLEAR BYTECOUNT, CKSUM */
	PUNCH = FALSE;
	OLDADDRESS = 0FFFFH;
	IF PASS THEN DO;
/*	CALL STROUT(.INTRO,LENGTH(INTRO));	/* ASK L OR P */
/*	DUMMY = CI AND 7FH;		/* GET THE RESPONSE */
/*	CALL CHAROUT(DUMMY);		/* ECHO IT */
/*	CALL CRLF;			*/
	CALL CLOSE(AFTN, .STATUS);
	IF STATUS > 0 THEN CALL ISISERR;
	PUNCH = (DUMMY = 'P');		/* PUNCH IS A LOGICAL VARIABLE*/
	IF PUNCH THEN			/* PUNCH LEADER */
	    DO;
	    CALL CHAROUT(START$PUNCH);	/* START THE PUNCH */
	    DO TEMP=1 TO 150;
	    CALL CHAROUT(0);
	    END;
	    END;
	END;
	NOT$PUNCH = NOT PUNCH AND PASS;
	DINBUFEND = DINBUFPTR+1;
	CALL DOPEN;
	IF NOT PASS THEN CALL DOPEN$OUT;
END INIT;

	/* PROCEDURE TO GET A 4-BIT QUANTITY FROM A CHARACTER
	   READ FROM THE READER DEVICE.  THIS CHARACTER IS
	   ASSUMED TO BE A HEX DIGIT.  */

GET$NIBBLE: PROCEDURE BYTE;
	DCL T BYTE;
/*	T=RI AND 7FH;		*/
	T = DI;
	IF T>='A' AND T<='F' THEN T=T+9;	/*SET LOW 4 BITS RIGHT*/
	  ELSE IF T<'0' OR T>'9' THEN		/* ILLEGAL CHARACTER */
	    DO;
	    CALL STROUT(.READ$ERROR,LENGTH(READ$ERROR));
	    T=0;
	    END;
	RETURN T AND 0FH;			/* RETURN LOW 4 BITS */
	END GET$NIBBLE;


	/* PROCEDURE TO GET A BYTE FROM THE READER DEVICE */

GET$DATA$BYTE: PROCEDURE BYTE;
	TEMP=SHL(GET$NIBBLE,4)+GET$NIBBLE;
	CKSUM=CKSUM+TEMP;			/* MAINTAIN CHECK SUM */
	RETURN TEMP;
	END GET$DATA$BYTE;


	/* READ TAPE FOR BYTE COUNT */

GET$BYTE$COUNT:	PROCEDURE;
/*	DO WHILE (RI AND 7FH) <> ':';	/*LOOK FOR :*/
	DO WHILE DI <> ':';
	END;
	BYTE$COUNT=GET$DATA$BYTE;	/*GET THE BYTE COUNT*/
	CKSUM=BYTE$COUNT;		/*INITIALIZE CHECKSUM*/
	END GET$BYTE$COUNT;

	/* OUTPUT BYTE IN HEX */

OUTPUT$BYTE: PROCEDURE(BYTEOUT);
	DCL BYTEOUT BYTE;
	CALL PRINT$NUMBER (BYTEOUT,16,2,FALSE);
	END OUTPUT$BYTE;

	/* OUTPUT ADDRESS QUANTITY IN HEX (4 DIGITS) */

OUTPUT$ADDRESS: PROCEDURE (ADDR);
	DCL ADDR ADDRESS;
	CALL PRINT$NUMBER(ADDR,16,4,FALSE);
	END OUTPUT$ADDRESS;



	/* ROUTINE TO OUTPUT A BYTE IN ASCII.  IF THE BYTE IS A
	   NON-PRINTING CHARACTER, THEN IT IS OUTPUT AS AN OCTAL
	   NUMBER SURROUNDED BY '<' AND '>', E.G. <000>.  */

ASCII$PRINT: PROCEDURE(ASCII);
	DCL ASCII BYTE;
	IF (ASCII AND 7FH) < LOWEST$ASCII OR (ASCII AND 7FH) >
	    HIGHEST$ASCII THEN DO;	/* NON-PRINTING CHARACTER */
	    CALL CHAROUT ('<');
	    CALL PRINT$NUMBER (ASCII,8,3,FALSE);
	    CALL CHAROUT ('>');
	    END;
	ELSE CALL CHAROUT (ASCII);
END ASCII$PRINT;

	/* THIS ROUTINE OUTPUTS THE 16-BIT ARGUMENT IN
	   DECIMAL, OCTAL, AND ASCII.  */

OUTPUT$OPERAND: PROCEDURE (OPERAND);
	DCL OPERAND ADDRESS;
	CALL PRINT$NUMBER (OPERAND,10,5,TRUE);		/* DECIMAL */
	CALL CHAROUT ('D');  CALL CHAROUT (',');	/* PRINT 'D,' */
	CALL PRINT$NUMBER (OPERAND,8,6,TRUE);		/* OCTAL */
	CALL CHAROUT ('Q');  CALL CHAROUT (',');	/* PRINT 'Q,' */
	CALL CHAROUT (QUOTE);
	IF HIGH(OPERAND) <> 0 THEN CALL ASCII$PRINT (HIGH(OPERAND));
	CALL ASCII$PRINT (LOW(OPERAND));
	CALL CHAROUT (QUOTE);
END OUTPUT$OPERAND;

	/* THIS ROUTINE OUTPUTS 'NSPACES' NUMBER OF SPACES IF A
	   LISTING IS BEING PRODUCED OR A TAB IF IT IS BEING
	   PUNCHED. */

SPACES:	PROCEDURE (NSPACES);
	DCL NSPACES BYTE;
	IF PUNCH THEN CALL CHAROUT (TAB);
	ELSE DO TEMP=1 TO NSPACES;
	     CALL CHAROUT (' ');
	     END;
END SPACES;

	/* FINAL PROCEDURE - END OF FILE FOUND */

END$OUT: PROCEDURE;
	DCL (NAME,N) ADDRESS;
	CALL CRLF;
	DO N = 0 TO LABEL$NO;
	DO NAME = 0 TO MAXSYMBOLS;
	IF SYMBOL$NAME(NAME) = N THEN
	    DO;
	    IF DEFINED(NAME) THEN
		DO;
		IF (SYMBOL$OUTPUT(TMP1) AND TMP3) = 0 THEN
		    CALL CHAROUT(' ');
		ELSE CALL CHAROUT(';');
		CALL CHAROUT('L');
		CALL PRINT$NUMBER(SYMBOL$NAME(NAME),
			10,4,FALSE);
		CALL SPACES (2);
		CALL STROUT(.('EQU'),3);
		CALL SPACES(5);
		CALL CHAROUT('0');
		CALL OUTPUT$ADDRESS(SYMBOL$VALUE(NAME));
		CALL CHAROUT('H');
		CALL SPACES(2);
		CALL CHAROUT(';');
		CALL OUTPUT$OPERAND(SYMBOL$VALUE(NAME));
		CALL CRLF;
		NAME = MAXSYMBOLS;
		END;
	    END;
	END;
	END;
	CALL STROUT(.ENDSTRING,LENGTH(ENDSTRING));
	IF PUNCH THEN
	    DO;
	    DO TEMP=1 TO 150;		/* PUNCH TRAILER */
	    CALL CHAROUT(0);
	    END;
	    CALL CHAROUT(STOP$PUNCH);	/* TURN PUNCH OFF */
	    END;

		CALL WRITE (OUT$AFTN, .DOUTBUFFER, DOUTBUFPTR+1, .STATUS);
		IF STATUS > 0 THEN CALL ISISERR;

		CALL EXIT;

	END END$OUT;

	/* THIS ROUTINE IS INVOKED IF THE INSTRUCTION WAS ILLEGAL
	   (INDICATING IT MUST HAVE BEEN DATA).  THE MNEMONIC
	   OUTPUT WAS 'DB 0'.  THEREFORE, THE DATA BYTE WILL
	   SIMPLY BE OUTPUT AS A HEX NUMBER. */

ILLEGAL: PROCEDURE;
	CALL OUTPUT$BYTE (INSTR);   /*OUTPUT THE INSTRUCTION IN HEX*/
	CALL CHAROUT ('H');  CALL CHAROUT (' ');
	CALL SPACES(8);
	CALL CHAROUT(';');
	CALL OUTPUT$OPERAND (DBL(INSTR));
END ILLEGAL;


	/* PROCEDURE FOR OUTPUTTING SINGLE BYTE INSTRUCTIONS.
	   SEVERAL DIFFERENT TYPES OCCUR.  'CODE' CONTAINS THE
	   CODE SHOWN IN THE MNEMONICS ARRAY DECLARATION COMMENT. */

ONEBYTE: PROCEDURE;
	DUMMY=SHR(INSTR,3) AND 7;
	DO CASE CODE MOD 10 - 1;
	    ;				/* NO ARGUMENT */
	    CALL CHAROUT(REGS(INSTR AND 7));   /* 1 REGISTER ARGUMENT */
	    DO;				/* MOV */
		CALL CHAROUT(REGS(DUMMY));
		CALL CHAROUT(',');
		CALL CHAROUT(REGS(INSTR AND 7));
	    END;
	    IF DUMMY=6 THEN		/*PUSH OR POP*/
	 	CALL STROUT(.PSW,LENGTH(PSW));
	    ELSE CALL CHAROUT(REGS(DUMMY));
	    IF (DUMMY := DUMMY AND 6) = 6 THEN /* DAD,INX,DCX,STAX,LDAX */
		CALL STROUT(.SP,LENGTH(SP));
	    ELSE CALL CHAROUT(REGS(DUMMY));
	    CALL CHAROUT(DUMMY+'0');	/* RST */
	    CALL CHAROUT(REGS(DUMMY));	/* INR,DCR */
	END /* CASES */;
END ONEBYTE;


	/* PROCEDURE FOR TWO BYTE INSTRUCTIONS.  THE ONLY SPECIAL
	   CASE IS THE MVI INSTRUCTION, WHICH HAS A REGISTER AND
	   A DATA ARGUMENT. */

TWOBYTE: PROCEDURE;
	NSPACES=7;
	IF CODE=MVI THEN		/* MVI INSTRUCTION */
	    DO;
	    CALL CHAROUT(REGS(SHR(INSTR,3) AND 7));
	    CALL CHAROUT(',');
	    NSPACES=NSPACES - 2;
	    END;
	CALL CHAROUT('0');
	CALL OUTPUT$BYTE (LOW(OPERAND));
	CALL CHAROUT('H');
	CALL SPACES(NSPACES);
	CALL CHAROUT(';');
	CALL OUTPUT$OPERAND(OPERAND);
END TWOBYTE;


	/* PROCEDURE FOR THREE BYTE INSTRUCTIONS.  THE ONLY SPECIAL
	   CASE IS THE LXI INSTRUCTION, WHICH HAS A REGISTER AND
	   A DATA ARGUMENT. */

THREEBYTE: PROCEDURE;
	NSPACES=5;
	IF CODE=LXI THEN		/* LXI INSTRUCTION */
	    DO;
	    IF (DUMMY := SHR(INSTR,3) AND 7) = 6 THEN
		DO;
		CALL STROUT(.SP,LENGTH(SP));
		NSPACES=NSPACES-1;
		END;
	    ELSE CALL CHAROUT(REGS(DUMMY));
	    CALL CHAROUT(',');
	    NSPACES=NSPACES-2;
	    END;
	IF IN$TABLE(OPERAND) THEN
	    DO;
	    CALL CHAROUT('L');
	    CALL PRINT$NUMBER(SYMBOL$NAME(VAL$MOD$MAX),10,4,FALSE);
	    RETURN;
	    END;
	CALL CHAROUT('0');
	CALL OUTPUT$ADDRESS (OPERAND);
	CALL CHAROUT('H');
	CALL SPACES(NSPACES);
	CALL CHAROUT(';');
	CALL OUTPUT$OPERAND(OPERAND);
END THREEBYTE;


	/* ROUTINE TO INPUT ONE INSTRUCTION BYTE FROM THE READER */

GET$INSTRUCTION: PROCEDURE BYTE;
	DCL INSTR BYTE;
	IF BYTE$COUNT = 0 THEN
	    DO;
	    CALL GET$BYTE$COUNT;
	    IF BYTECOUNT = 0 THEN
		DO;
		IF PASS THEN CALL ENDOUT;
		END$PASS = TRUE;
		RETURN 0;
		END;
	    NEW$ADDRESS = GET$DATA$BYTE * 256 + DBL(GET$DATA$BYTE)
	    + GET$DATA$BYTE * 0;	/* LAST ONE READS THE UNUSED
					   BYTE IN THE HEX TAPE */
	    IF (NEW$ADDRESS <> OLD$ADDRESS+1) AND PASS THEN
		DO;
		CALL STROUT(.ORG,LENGTH(ORG));
		CALL OUTPUT$ADDRESS (NEW$ADDRESS);
		CALL STROUT(.ORGEND,LENGTH(ORGEND));
		END;
	    END;

	ELSE NEW$ADDRESS = OLD$ADDRESS + 1;

	OLD$ADDRESS = NEW$ADDRESS;
	INSTR = GET$DATA$BYTE;
	BYTE$COUNT = BYTE$COUNT - 1;
	IF ZERO THEN
	    DO;
	    TEMP = GET$DATA$BYTE;	/* READ CHECKSUM - SETS ZERO */
	    IF CKSUM <> 0 THEN CALL STROUT(.CSERROR,LENGTH(CSERROR));
	    END;
	RETURN INSTR;
	END GET$INSTRUCTION;

	/* THIS PROCEDURE OUTPUTS THE MNEMONIC OF THE INSTRUCTION
	   AND PASSES CONTROL TO THE PROPER PROCEDURE ABOVE. */

	DCL ADDRESS$FOUND BYTE;

DECODE:	PROCEDURE;
	IF ADDRESS$FOUND THEN
	    DO;
	    CALL CHAROUT ('L');
	    CALL PRINT$NUMBER(GET$SYMBOL$NAME,10,4,FALSE);
	    CALL CHAROUT (':');
	    NSPACES=2;
	    END;
	ELSE NSPACES=8;
	CALL SPACES(NSPACES);

	/* OUTPUT OP-CODE MNEMONIC */

	CALL STROUT ( .MNEMONICS + OPCODE(INSTR)*5 , 4);
	IF CODE < 30 THEN CALL CHAROUT(' ');

	DO CASE CODE/10;
	    CALL ONE$BYTE;	/* SINGLE BYTE INSTRUCTION */
	    CALL TWO$BYTE;	/* DOUBLE BYTE INSTRUCTION */
	    CALL THREE$BYTE;	/* TRIPLE BYTE INSTRUCTION */
	    CALL ILLEGAL;	/* ILLEGAL - MUST BE DATA */
	END /*CASES*/;

	CALL CRLF;
END DECODE;


 /*************************************************************
*******
*******		MAIN PROGRAM STARTS HERE!!!!!!!!!!
*******
*******		IF ONLY PUNCHED OUTPUT IS REQUESTED, THEN THE ADDRESS
*******		AND HEX VALUES (AS OUTPUT BY THE ASSEMBLER) ARE NOT
*******		PRODUCED.  THEY ARE PRODUCED FOR LISTINGS.
*******
*************************************************************/

	DO PASS = 0 TO 1;
/*	CALL STROUT(.PASS$MESSAGE,LENGTH(PASS$MESSAGE));
	CALL CHAROUT(PASS+'0'+1);
	CALL STROUT(.(', STRIKE ANY KEY',CR,LF),18);
	DUMMY = CI;			*/
	CALL INIT;		/* INITIALIZE STUFF */
MAIN:	INSTR=GET$INSTRUCTION;	/* GET THE INSTRUCTION */
	IF END$PASS THEN GO TO END$OF$PASS;
	IF PASS THEN DO;
	IF IN$TABLE(NEW$ADDRESS) THEN
	    DO;
	    CALL CRLF;
	    ADDRESS$FOUND = TRUE;
	    END;
	ELSE ADDRESS$FOUND = FALSE;
	END;
	CODE = MNEMONICS ( OPCODE ( INSTR ) * 5 + 4);
	IF NOT$PUNCH THEN	/* LISTINGS ONLY */
	    DO;
/*	    CALL OUTPUT$ADDRESS (NEW$ADDRESS);
	    CALL CHAROUT(' ');
	    CALL OUTPUT$BYTE (INSTR);
	    NSPACES=2;
					*/
	    CALL CHAROUT(9);		/* OUT TAB */
	    END;
	DO CASE CODE/10;
	    NSPACES=6;	/* SINGLE BYTE INSTRUCTIONS */
	    DO;		/* DOUBLE BYTE INSTRUCTIONS */
		OPERAND=DBL(GET$INSTRUCTION);
		IF END$PASS THEN GO TO END$OF$PASS;
/*		IF NOT$PUNCH THEN CALL OUTPUT$BYTE(OPERAND);    */
	 	NSPACES=4;
	    END;
	    DO;		/* TRIPLE BYTE INSTRUCTIONS */
		DUMMY=GET$INSTRUCTION;
		IF END$PASS THEN GOTO END$OF$PASS;
		OPERAND = DUMMY +
			256 * GET$INSTRUCTION;
		IF END$PASS THEN GOTO END$OF$PASS;
		IF NOT PASS THEN CALL HASH(OPERAND);
/*		IF NOT$PUNCH THEN DO;
		    CALL OUTPUT$BYTE(LOW(OPERAND));
		    CALL OUTPUT$BYTE(HIGH(OPERAND));
		END;
*/
		END;
	    NSPACES=6;	/* ILLEGAL (DATA) */
	END /* CASES */;
/*	IF NOT$PUNCH THEN CALL SPACES(NSPACES);     */
	IF PASS THEN CALL DECODE;		/* DECODE THE INSTRUCTION */
	GOTO MAIN;		/* KEEP A GOIN' */

END$OF$PASS: END;

END	DISASS;				/* END OF THE PROGRAM */