SUBTTL	WRITTEN BY MARK R. CRISPIN/MRC

VCUS==:1	;CUSTOMER
VDIS==:1	;DISASSEMBLER VERSION
VMIN==:2	;MINOR
VEDT==:2	;EDIT

	LOC	<.JBVER==:137>
	BYTE	(3)VCUS(9)VDIS(6)VMIN(18)VEDT

	DEFINE	TITLE.(VC,VA,VM)<
TITLE	PALDIS -- PDP-10 DISASSEMBLER FOR PDP-8 BINARY FILES VA(VM)-VC
IF2<PRINTX	PALDIS VERSION VA(VM)-VC>
>

	SALL

	TITLE.(\VCUS,\VDIS,\VEDT)	;DEFINE TITLE
	RELOC
;USEFUL DEFINITIONS

PTR==1
DSK==2
CH8PCH==200
CH7PCH==100
W==1
S==2
S1==3
A==4
P==17
STAR=="*"
TAB=="	"
SLASH=="/"
ZERO=="0"
CR==15
LF==12
;FILE STUFF

INDEV:	210			;IMAGE MODE
	SIXBIT/PTR/		;PAPER TAPE READER
	IBUF			;POINT TO BUFFER
OUTDEV:	0			;ASCII MODE
	SIXBIT/DSK/		;DISK
	OBUF,,0			;POINT TO BUFFER
IBUF:	BLOCK	3		;INPUT BUFFER
OBUF:	BLOCK	3		;OUTPUT BUFFER
INFIL:	SIXBIT/PDP8/		;NOT REALLY NEED IF PTR, UNLESS
	SIXBIT/BIN/		;LOGICAL PTR AIN'T PHYSICAL PTR
	Z
	Z
OUTFIL:	SIXBIT/PDP8/		;OUTPUT FILE NAME
	SIXBIT/DIS/		;EXTENSION
	Z
	Z
;	***START OF PROGRAM***

PALDIS:	JFCL			;IN CASE OF CCL
	RESET			;RESET THE WORLD
	SETZ			;CLEAR 0
	OPEN	PTR,INDEV	;OPEN THE PTR
	JRST	NOINDV		;CAN'T
	OPEN	DSK,OUTDEV	;OPEN THE DISK
	JRST	NOOTDV		;CAN'T
	LOOKUP	PTR,INFIL	;DOES NOTHING IF PTR, NIFTY THINGS IF NOT
	JRST	NOINDV		;CAN'T
	ENTER	DSK,OUTFIL	;OPEN A NEW FILE
	JRST	NOOTDV		;CAN'T
	OUTSTR	OKAY		;SAY OKAY SO FAR
	MOVEI	P,PDL-1		;MOVE OUR PDL TO P
	PUSHJ	P,GET		;GET A WORD
DISAWD:	LDB	W,IBUF+1	;REGET CHAR
	TRZE	W,CH8PCH	;CHANNEL 8 PUNCH?
	JRST	CH8SER		;YES, HANDLE IT
	TRZE	W,CH7PCH	;CHANNEL 7 PUNCH?
	JRST	CH7SER		;YES, HANDLE IT
	MOVEI	S,(W)		;COPY THE WORD
	PUSHJ	P,GET		;GET SECOND WORD
	CAILE	W,77		;CHECK FOR VALIDITY
	JRST	TAPERR		;BAD!
	SETO			;SET FLAGS
	LSH	S,6		;SHIFT S OVER SO WE MAY
	ADDI	S,(W)		;ADD SECOND WORD IN
	PUSHJ	P,GET		;LOOK AT NEXT WORD
	CAIN	W,CH8PCH	;TRAILER?
	JRST	CH8SER		;YES
	PUSHJ	P,OCTOUT	;SEND IT
	MOVEI	W,TAB		;GET A TAB
	PUSHJ	P,PUT		;SEND IT
	MOVEI	W,SLASH		;GET A SLASH
	PUSHJ	P,PUT		;SEND IT
	AOJ	A,		;INCREMENT A
	MOVEI	S,(A)		;GET A
SENACR:	PUSHJ	P,OCTOUT	;SEND IT
	MOVEI	W,CR		;GET A CR
	PUSHJ	P,PUT		;SEND IT
	MOVEI	W,LF		;GET A LF
	PUSHJ	P,PUT		;SEND IT
	JRST	DISAWD		;DISASSEMBLE ANOTHER WORD
;I/O SUBROUTINES

GET:	SOSGE	IBUF+2		;IS INPUT BUFFER EMPTY?
	JRST	GET1WD		;YES, GET SOME
	ILDB	W,IBUF+1	;GET A WORD
	POPJ	P,		;RETURN
GET1WD:	IN	PTR,		;GET SOME DATA
	JRST	GET		;OKAY
	OUTSTR	EOFPTR		;NO MORE TO READ
BYE:	CLOSE	PTR,		;FINISH UP
	CLOSE	DSK,		; ''
	RELEAS	PTR,		; ''
	RELEAS	DSK,		; ''
	EXIT			;EXIT
PUT:	SOSG	OBUF+2		;CHECK FOR BUFFER FULL
	JRST	PUT1WD		;SEND BUFFER
	IDPB	W,OBUF+1	;ADD INTO BUFFER
	POPJ	P,		;RETURN
PUT1WD:	OUT	DSK,		;SEND ENTIRE THING
	JRST	PUT+2		;OKAY
	OUTSTR	BADDSK		;BARF, PUNT, AND IMPEACH DISK
	EXIT			;RUN TO MOMMIE
TAPERR:	OUTSTR	BADTAP		;YELL AT TAPE
	EXIT			;CRY TO MOMMIE
NOINDV:	OUTSTR	BADINP		;YES AT DEVICE
	EXIT			;LEAVE
NOOTDV:	OUTSTR	BADOUT		;YELL AT DEVICE
	EXIT			;LEAVE
;OCTAL OUTPUT SUBROUTINE

OCTOUT:	IDIVI	S,10		;DIVIDE BY 8
	PUSH	P,S1		;SAVE REMAINDER
	SKIPE	S		;FINISHED?
	PUSHJ	P,OCTOUT	;NO, DO IT AGAIN
	POP	P,S		;GET LATEST DIGIT
	MOVEI	W,ZERO(S)	;CONVERT TO ASCII
	PUSHJ	P,PUT		;SEND IT
	POPJ	P,		;RETURN
;SPECIAL CHANNEL PUNCHES SERVICE ROUTINE

CH8SER:	TRZE	W,CH7PCH	;IS CHANNEL 7 ALSO PUNCHED?
	JRST	FLDSER		;SERVICE FIELD REQUEST
	TRZ	W,CH8PCH	;GET RID OF BIT IF STILL THERE
	JUMPN	W,TAPERR	;BAD TAPE IF NOT ZERO
	JUMPE	DISAWD-1	;IF FLAG=0, AT BEGINNING OF FILE
	OUTSTR	OPTMES		;TYPE OPTION MESSAGE
	INCHRW	W		;GET A CH
	CAIE	W,STAR		;IS IT A STAR?
	JRST	BYE		;NO, LEAVE
	SETZ			;WIPE FLAG
	JRST	DISAWD-1	;DISASSEMBLE AGAIN
CH7SER:	MOVEI	S,(W)		;COPY W
	LSH	S,6		;SHIFT OVER
	MOVEI	W,TAB		;GET A TAB
	PUSHJ	P,PUT		;SEND IT
	MOVEI	W,STAR		;GET A STAR
	PUSHJ	P,PUT		;SEND IT
	PUSHJ	P,GET		;GET ANOTHER
	TRZE	W,CH8PCH!CH7PCH	;IS EXTRA STUFF SET?
	JRST	TAPERR		;YES, BAD TAPE
	ADDI	S,(W)		;ADD TWO TOGETHER
	MOVEI	A,-1(S)		;COPY S TO A
	PUSHJ	P,GET		;GLITCH TO UNGLITCH GLITCH
	JRST	SENACR		;SEND AND CRLF
FLDSER:	MOVEI	A,200		;INITIAL ADDRESS
	MOVEI	S,(W)		;SAVE LOCATION
	MOVEI	W,TAB		;GET TAB
	PUSHJ	P,PUT		;SEND IT
	MOVEI	W,"#"		;TECO THIS TO "FIELD"
	PUSHJ	P,PUT		;SEND IT
	PUSHJ	P,GET		;UNGLITCH
	LSH	S,-3		;SHIFT OVER
	JRST	SENACR		;SEND IT
OKAY:	ASCIZ/[PROCESSING BINARY TAPE]
/
EOFPTR:	ASCIZ/%OUT OF TAPE ON PTR
/
BADDSK:	ASCIZ/? DISK WRITE ERROR
/
BADTAP:	ASCIZ/? BAD PDP-8 BINARY TAPE
/
BADINP:	ASCIZ/? CAN'T OPEN INPUT DEVICE
/
BADOUT:	ASCIZ/?  CAN'T OPEN OUTPUT DEVICE
/
OPTMES:	ASCIZ/
END OF FILE, TYPE * TO CONTINUE
/
PDL:	BLOCK	20		;LEAVE SOME ROOM
	END	PALDIS