.TITLE	TRACE
/
/  24 MAR 75 (PDH) BEGIN DEBUGGING
/  12 MAR 75 - PAUL HENDERSON - BEGIN TYPING ON WITS
/
/  PROGRAM TO TRACE A PROGRAM, SIMULATING ALL INSTRUCTIONS.
/  IT WILL NOT PERFORM CORRECTLY IF WE TRY TO SIMULATE
/	XCT	A
/  A	CAL
/
IDX=ISZ				/ INDEX POINTER - SKIP NOT EXPECTED
AUTO16=16
LP=-12
TTO=-3
BUFSIZ=70			/ SIZE OF IMAGE BUFFER
/
	.IODEV	LP,TTO
/
TRACE	.INIT	TTO,1,EXIT+1    / ABORT TIDILY ON ^P
	.INIT	LP,1,EXIT+1
	.ENTER	LP,NAME         / IN CASE BULK STORAGE
	LAW	-1
	DAC	LNCNT		/ MUST BEGIN WITH HEADING
	LAC	(LSTIMG
	DAC	LSTPNT		/ DON'T SCRAMBLE WITH 1ST CR
	JMS	WRITE		/ GET TRACE OUTPUT STARTED
B1	NOP			/ FOR DDT BREAKPOINT
/
/  RETURN HERE TO GET NEW OPCODE
/
GETOP	LAC	PC
	DAC	IPC		/ SAVE PC IN 'IMMEDIATE PC'
	JMS	DIGITS		/ OUTPUT PC
	IDX	LSTPNT		/ SINGLE SPACE
/
/  XCT RETURNS HERE TO FETCH ITS INTENDED TARGET
/
XCTOP	LAC*	IPC
	JMS	DIGITS		/ INSTRUCTION
	IDX	LSTPNT		/ ANOTHER SPACE
	LAC*	IPC
	LRS	16
	AND	(17		/ GET OPCODE
	TAD	(JMP OPCODE
	DAC	.+1
	XX			/ DISPATCH TO APPROPRIATE SIMULATION
OPCODE	JMP	.CAL
	JMP	.DAC
	JMP	.JMS
	JMP	.DZM
	JMP	.LAC
	JMP	.XOR
	JMP	.ADD
	JMP	.TAD
	JMP	.XCT
	JMP	.ISZ
	JMP	.AND
	JMP	.SAD
	JMP	.JMP
	JMP	.EAE
	JMP	.IOT
	JMP	.OPR
/
/  THE ASSUMPTION HERE IS THAT 'CAL' WILL NEVER BE
/  INVOKED BY 'XCT'
/
.CAL	JMS	SIXTO7
	.SIXBT	'CAL'
	LAC*	IPC
	AND	(37777
	JMS	DIGITS		/ OUTPUT .DAT SLOT & SUB-FUNCTION
	IDX	PC		/ THIS IS THE WAY 'XCT' WOULD
	LAC*	PC		/ CAUSE IT TO HAPPEN
	AND	(17		/ GET FUNCTION CODE
	TAD	(JMP CALDSP+1
	DAC	CALDSP
	CLA
CALDSP	XX
	JMP	IOPS0		/  0=ILLEGAL 'CAL' FUNCTION
	JMP	ARGS4		/  1=.INIT
	JMP	ARGS3		/  2=.FSTAT, .DLETE, .RENAM
	JMP	ARGS3		/  3=.SEEK
	JMP	ARGS3		/  4=.ENTER
	JMP	ARGS2		/  5=.CLEAR
	JMP	ARGS2		/  6=.CLOSE
	JMP	ARGS2		/  7=.MTAPE
	JMP	ARGS4		/ 10=.READ
	JMP	ARGS4		/ 11=.WRITE
	JMP	IOWAIT		/ 12=.WAIT, .WAITR
	JMP	ARGS5		/ 13=.TRAN
	JMP	ARGS3		/ 14=.TIMER
	JMP	EXIT		/ 15=.EXIT
	JMP	IOPS0		/ 16=ILLEGAL 'CAL' FUNCTION
	JMP	IOPS0		/ 17=ILLEGAL 'CAL' FUNCTION
/
ARGS5	LAW	-1
ARGS4	TAD	(-1
ARGS3	TAD	(-1
ARGS2	TAD	(-1
	DAC	ARGCNT		/ SAVE NUMBER OF ARGUMENTS TO LIST
/
GETCAL	JMS	WRITE		/ WRITE OUT PREVIOUS ARGUMENT
	LAC	(LSTIMG+13
	DAC	LSTPNT		/ START AT 'OPCODE' COLUMN
	LAC*	PC		/ GET ARGUMENT
	IDX	PC
	JMS	DIGITS
	ISZ	ARGCNT
	JMP	GETCAL
/
/  'CAL' IS THE ONLY INSTRUCTION THAT IS ALLOWED TO EXECUTE NORMALLY.
/  HOWEVER, WE MUST INTERCEPT IT AFTER ITS COMPLETION.
/
	LAC	(RESTORE-1      / PREPARE TO INTERCEPT INSTRUCTION
	DAC*	(AUTO16         / STREAM AFTER 'CAL'
	LAC*	PC
	DAC	SAVE1		/ SAVE NEXT INSTRUCTION
	LAC	PC
	DAC	ADDR1		/ SAVE ADDRESS IT CAME FROM
	LAC	(JMS* AUTO16
	DAC*	ADDR1		/ REPLACE WITH JMS TO 'RESTORE'
	JMP*	IPC		/ NOW EXECUTE THE 'CAL' NORMALLY.
/
/  CONTROL RETURNS HERE AFTER 'CAL'
/
RESTORE XX
	JMS	PUTACL		/ OUTPUT LINK & AC IN CASE OF '.OPER'
	JMS	WRITE
	LAW	-1		/ MUST BACK UP PC TO ACCOUNT FOR
	TAD	RESTORE         / REPLACED INSTRUCTION
	AND	(77777
	DAC	PC		/ NEW 15-BIT VALUE OF PC
	LAC	SAVE1
	DAC*	ADDR1		/ RESTORE REPLACED INSTRUCTIONS
	LAC	SAVE2		/ .WAITR RETURN, IF PRESENT
	DAC*	ADDR2
	LAC	(SAVE2		/ DON'T RESTORE NEXT TIME UNLESS
	DAC	ADDR2		/ WE HAVE ANOTHER '.WAITR'
	JMP	GETOP		/ NOW RE-ENTER TRACE LOOP
/
IOWAIT	LAC*	IPC
	AND	(1000		/ .WAIT OR .WAITR?
	SNA
	JMP	ARGS2		/ .WAIT
	LAC	IPC
	TAD	(2		/ .WAITR
	DAC	ADDR2
	LAC*	ADDR2
	DAC	ADDR2		/ .WAITR BRANCH ADDRESS
	LAC*	ADDR2
	DAC	SAVE2		/ SAVE CONTENTS AT BRANCH TRANSFER POIN
	LAC	(JMS* AUTO16    / CATCH THIS ONE TOO, IN CASE I/O BUSY
	DAC*	ADDR2
	CLA
	JMP	ARGS3
/
IOPS0	JMS	WRITE		/ OUTPUT INFORMATION TO DATE
	LAC	(LSTIMG+13
	DAC	LSTPNT		/ COLUMN OF OPCODES
	LAC*	PC		/ GET OFFENDING FUNCTION CODE
	JMS	DIGITS
	JMS	WRITE		/ WRITE IT OUT
	.WRITE	LP,2,IPS0,0     / 'ILLEGAL CAL FUNCTION'
	JMP	CLOSLP
/
EXIT	JMS	WRITE		/ OUTPUT WAITING INFORMATION
	.WRITE	LP,2,XIT,0      / ' .EXIT ENCOUNTERED'
CLOSLP	.CLOSE	LP
	.EXIT
/
ARGCNT;SAVE1;ADDR1;SAVE2;ADDR2 SAVE2
IPS0	IP-.*400+2; 0
	.ASCII	<11>'ILLEGAL CAL FUNCTION'<15> ;IP=.
XIT	XT-.*400+2; 0
	.ASCII	<11>'.EXIT ENCOUNTERED'<15> ;XT=.
/
.DAC	JMS	SIXTO7
	.SIXBT	'DAC'
	JMS	SETMB		/ SET 'MB' TO CORRECT ADDRESS
	DAC*	MB		/ PERFORM INTENT OF INSTRUCTION
	JMP	IDXPC
/
.JMS	JMS	SIXTO7
	.SIXBT	'JMS'
	JMS	SETMB
	LAC	PC
	XOR	(200000         / EXTENDED MEMORY BIT
	DAC*	MB		/ STORE RETURN ADDRESS
	IDX*	MB		/ RETURN MUST POINT TO CORRECT PLACE
	LAC	MB
	DAC	PC		/ MB BECOMES THE NEW PC
	JMP	IDXPC
/
.DZM	JMS	SIXTO7
	.SIXBT	'DZM'
	JMS	SETMB
	DZM*	MB
	JMP	IDXPC
/
.LAC	JMS	SIXTO7
	.SIXBT	'LAC'
	JMS	SETMB
	LAC*	MB
	JMP	LINKAC
/
.XOR	JMS	SIXTO7
	.SIXBT	'XOR'
	JMS	SETMB
	XOR*	MB
	JMP	LINKAC
/
.ADD	JMS	SIXTO7
	.SIXBT	'ADD'
	JMS	SETMB
	ADD*	MB
	JMP	LINKAC
/
.TAD	JMS	SIXTO7
	.SIXBT	'TAD'
	JMS	SETMB
	TAD*	MB
	JMP	LINKAC
/
.XCT	JMS	SIXTO7
	.SIXBT	'XCT'
	JMS	SETMB
	JMS	WRITE
	LAC	(LSTIMG+7       / SKIP PAST THE 'PC' COLUMN
	DAC	LSTPNT
	LAW	52		/ '*'
	DAC	LSTIMG+5        / INDICATE 'XCT' CONTINUATION
	LAC	MB
	DAC	IPC		/ MB BECOMES THE INTERIM PC
	JMP	XCTOP		/ NOW PROCEED WITH MODIFIED PC
/
.ISZ	JMS	SIXTO7
	.SIXBT	'ISZ'
	JMS	SETMB
	ISZ*	MB
	SKP
	IDX	PC		/ INDEX SOFTWARE PC IF SKIP
	JMP	IDXPC
/
.AND	JMS	SIXTO7
	.SIXBT	'AND'
	JMS	SETMB
	AND*	MB
	JMP	LINKAC
/
.SAD	JMS	SIXTO7
	.SIXBT	'SAD'
	JMS	SETMB
	SAD*	MB
	SKP
	IDX	PC
	JMP	LINKAC		/ WE WANT TO SEE THE VALU OF THE AC
/
.JMP	JMS	SIXTO7
	.SIXBT	'JMP'
	JMS	SETMB
	JMS	WRITE
	LAC	MB		/ EFFECTIVE ADDRESS BECOMES
	DAC	PC		/ THE NEW PC
	JMP	GETOP
/
.EAE	JMS	SIXTO7
	.SIXBT	'EAE'
	LAC	(NOP		/ ASSUME SINGLE-WORD INSTRUCTIO
	DAC	EAEOP+1
	LAC*	IPC		/ GET EAE INSTRUCTION
	DAC	EAEOP		/ IT WILL BE EXECUTED DIRECTLY
	JMS	DIGITS
	LAC	EAEOP
	AND	(700		/ GET EAE COMMAND
	SAD	(100		/ IS IT MULTIPLY?
	SKP
	SAD	(300		/    OR DIVIDE?
	SKP
	JMP	NOTMDV		/ NEITHER MULTIPLY NOR DIVIDE
/
	IDX	IPC
	IDX	PC		/ 2-WORD INSTRUCTION.  INDEX PC
	LAW	50		/ '('
	DAC*	LSTPNT
	IDX	LSTPNT
	LAC*	IPC		/ GET OPERAND FOR MULT OR DIVIDE
	DAC	EAEOP+1         / PUT IN EXPECTED PLACE
	JMS	DIGITS		/ LET US SEE WHAT IT WAS
	LAW	51		/ ')'
	DAC*	LSTPNT
	JMP	GETMQ
/
NOTMDV	LAC	SC		/ GET PREVIOUS VALUE OF STEP COUNTER
	XOR	(77
	TAD	(640402         / THIS METHOD OF RESTORING THE
	AND	(640477         / STEP COUNTER IS IN THE PDP-9 HANDBOOK
	DAC	.+1		/ BUT IS ALLEGEDLY WRONG.
	XX
GETMQ	LAC	MQ		/ RESTORE MQ
	LMQ
	JMS	GETACL		/ RESTORE LINK & AC
EAEOP	XX			/ EAE INSTRUCTION INSERTED HERE
	NOP			/ 'NOP' OR EAE OPERAND
	DAC	AC		/ TEMPORARY STORE
	LACQ
	DAC	MQ		/ SAVE MQ
	LACS
	DAC	SC		/ SAVE STEP COUNTER
	LAC	AC		/ RETRIEVE AC FOR 'PUTACL'
	JMS	PUTACL		/ SAVE & OUTPUT LINK & AC
	IDX	LSTPNT		/ SINGLE SPACE
	LAC	MQ
	JMS	DIGITS		/ OUTPUT MQ
	JMP	IDXPC
/
.IOT	JMS	SIXTO7
	.SIXBT	'IOT'
	LAC*	IPC		/ GET INSTRUCTION
	AND	(37777		/ REMOVE OPCODE
	JMS	DIGITS
	JMP	OPRGET		/ NOW GO TO COMMON CODE EXECUTION
/
.OPR	LAC*	IPC		/ GET INSTRUCTION
	AND	(37777		/ IGNORE OP CODE
	SZA
	JMP	CKOPR
	JMS	SIXTO7
	.SIXBT	'NOP'
	JMP	OPRGET
/
CKOPR	LAC*	IPC
	ALSS	4		/ SHIFT OUT OPCODE
CKLAW	SMA!RAL
	JMP	CKCLA
	JMS	SIXTO7
	.SIXBT	'LAW'
	LAC*	IPC
	AND	(17777		/ GET IMMEDIATE DATA
	JMS	DIGITS
	JMP	OPRGET		/ NOW GO AND EXECUTE IT
/
CKCLA	SMA!RAL
	JMP	CKCLL
	JMS	SIXTO7
	.SIXBT	'CLA'
CKCLL	SMA!RAL
	JMP	CKRT
	JMS	SIXTO7
	.SIXBT	'CLL'
CKRT	DAC	MB		/ MB NOT USED FOR THIS INSTRUCTION, SO
	SMA			/ IT MAY BE USED FOR TEMPORARY STORAGE
	JMP	CKRAR		/ INSTRUCTION IS NOT DOUBLE ROTATE
CKRTR	LAC*	IPC		/ ROTATE RIGHT?
	AND	(20
	SNA
	JMP	CKRTL
	JMS	SIXTO7
	.SIXBT	'RTR'
CKRTL	LAC*	IPC
	AND	(10		/ ROTATE LEFT?
	SNA
	JMP	CKSKP
	JMS	SIXTO7
	.SIXBT	'RTL'
	JMP	CKSKP
/
CKRAR	LAC*	IPC		/ CHECK FOR SINGLE ROTATE
	AND	(20
	SNA			/ ROTATE RIGHT?
	JMP	CKRAL
	JMS	SIXTO7
	.SIXBT	'RAR'
CKRAL	LAC*	IPC
	AND	(10
	SNA			/ ROTATE LEFT?
	JMP	CKSKP
	JMS	SIXTO7
	.SIXBT	'RAL'
/
CKSKP	LAC*	IPC		/ GET INSTRUCTION AGAIN
	AND	(1700		/ SAVE ONLY 'CONDITION' BITS
	SAD	(1000		/ IS IT 'SKP'
	SKP			/ YES.
	JMP	SKPEND
	JMS	SIXTO7
	.SIXBT	'SKP'
SKPEND	LAC	MB		/ RETRIEVE INSTRUCTION
	RAL			/ NO LONGER WISH TO CHECK BIT 7
ANDOR	SMA!RAL 	      / CHECK FOR 'AND OF' OR 'OR OF'
	JMP	OROF
ANDOF	SMA!RAL 	      / CHECK FOR 'SZL', 'SNA', 'SPA'
	JMP	CKSNA
	JMS	SIXTO7
	.SIXBT	'SZL'
CKSNA	SMA!RAL
	JMP	CKSPA
	JMS	SIXTO7
	.SIXBT	'SNA'
CKSPA	SMA!RAL
	JMP	CKHLT
	JMS	SIXTO7
	.SIXBT	'SPA'
	JMP	CKHLT
/
OROF	SMA!RAL 	      / CHECK FOR 'SNL', 'SZA', 'SMA'
	JMP	CKSZA
	JMS	SIXTO7
	.SIXBT	'SNL'
CKSZA	SMA!RAL
	JMP	CKSMA
	JMS	SIXTO7
	.SIXBT	'SZA'
CKSMA	SMA!RAL
	JMP	CKHLT
	JMS	SIXTO7
	.SIXBT	'SMA'
/
CKHLT	SMA!RTL
	JMP	CKOAS
	JMS	SIXTO7
	.SIXBT	'HLT'
CKOAS	RAL			/ HAVE TO GET PAST ROTATE BITS
	SMA!RAL
	JMP	CKCML
	JMS	SIXTO7
	.SIXBT	'OAS'
CKCML	SMA!RAL
	JMP	CKCMA
	JMS	SIXTO7
	.SIXBT	'CML'
CKCMA	SMA
	JMP	CKBUFR
	JMS	SIXTO7
	.SIXBT	'CMA'
/
/  WE HAVE NOW REACHED THE END OF THE OPERATE INSTRUCTION DECODING.
/  CHECK TO SEE IF WE HAVE ENOUGH ROOM ON THIS LINE FOR THE LINK & AC.
/
CKBUFR	LAC	LSTPNT
	CMA
	TAD	(LSTIMG+41      / DO WE HAVE ROOM?
	SPA
	JMS	WRITE		/ LINK AND AC WILL APPEAR ON NEXT LINE
/
OPRGET	JMS	GETACL		/ RESTORE LINK & AC TO SIMULATED VALUES
	XCT*	IPC		/ EXECUTE THE INSTRUCTION (IOT OR OPR)
	SKP
	IDX	PC		/ INCREMENT PC IF INSTRUCTION SKIPS
/
LINKAC	JMS	PUTACL		/ STORE AND OUTPUT LINK & AC
IDXPC	JMS	WRITE		/ OUTPUT BUFFER
	IDX	PC		/ INCREMENT PC TO NEXT INSTRUCTION
	JMP	GETOP		/ GO AND GET NEXT INSTRUCTION
/
/  SUBROUTINE TO RESOTRE SIMULATION VALUES OF AC & LINK.
/
GETACL	XX
	LAC	LINK		/ RESTORE LINK
	RAR
	LAC	AC		/ RESTORE AC
	JMP*	GETACL
/
/  SUBROUTINE TO SAVE UPDATED VALUES OF LINK & AC, AND ALSO PUT THEM
/  INTO THE OUTPUT IMAGE BUFFER.
/
PUTACL	XX
	DAC	AC		/ SAVE AC
	CLA!RAL
	DAC	LINK		/ SAVE LINK
	XOR	(60		/ CONVERT TO ASCII
	DAC	LSTIMG+41       / AND PUT IT IN BUFFER
	LAC	(LSTIMG+43      / ALWAYS PUT LINK & AC AT THIS POINT
	DAC	LSTPNT
	LAC	AC		/ GET AC
	JMS	DIGITS		/ PUT ASCII INTO BUFFER
	JMP*	PUTACL
/
LINK;AC;MQ;SC
PC;IPC;MB;DEFER
/
/  SUBROUTINE TO CONVERT NUMBER TO IMAGE ASCII.
/  ENTER WITH NUMBER IN AC, USE CURRENT VALUE OF 'LSTPNT'
/
DIGITS	XX
	JMS	LEAD0		/ ALWAYS SET 'LEADING ZERO' FLAG
LEAD0	XX
	LMQ
	LAW	-5
	DAC	DIGCNT		/ DO 5 DIGITS IN LOOP
NXTDIG	LLSS!1000 3	      / GET DIGIT
	SZA
	JMP	STORE		/ STORE NON-ZERO DIGITS
	LAC	LEAD0
	SZA
	JMP	IDXPNT		/ LEADING ZEROS CONVERTED TO SPACE
STORE	DZM	LEAD0		/ NO LEADING ZEROS AFTER DIGIT OUTPUT
	XOR	(60		/ CONVERT TO ASCII
	DAC*	LSTPNT
IDXPNT	IDX	LSTPNT
	ISZ	DIGCNT
	JMP	NXTDIG
	LLSS!1000 3
	XOR	(60		/ LAST DIGIT OUTPUT AS DIGIT
	DAC*	LSTPNT
	IDX	LSTPNT
	JMP*	DIGITS
/
DIGCNT
/
/  SUBROUTINE TO CONVERT 6-BIT PACKED ASCII TO 7-BIT IMAGE ASCII.
/  THE PACKED 6-BIT IS IN THE LOCATION FOLLOWING THE SUBROUTINE
/  CALL AND THE 7-BIT IMAGE ASCII IS OUTPUT VIA 'LSTPNT'.
/  THE CONTENTS OF THE AC AT ENTRY ARE SAVED AND RESTORED AT EXIT.
/
SIXTO7	XX
	DAC	AC627		/ SAVE AC
	LAW	-3		/ 3 CHARACTERS IN 6-BIT WORD
	DAC	CHRCNT
	LAC*	SIXTO7		/ GET CHARACTERS
	IDX	SIXTO7		/ INDEX TO CORRECT RETURN ADDRESS
	LMQ
SIXNXT	LLSS!1000 6	      / SHIFT IN 1 CHARACTER
	LLSS	14		/ WE DECIDE THE CORRECT TYPE OF BIT TO
	SMA!CLL 	      / ADD ON FOR 7TH BIT
	STL
	LRS	14		/ CONVERT TO 7-BITS
	DAC*	LSTPNT
	IDX	LSTPNT
	ISZ	CHRCNT
	JMP	SIXNXT
	IDX	LSTPNT		/ LEAVE SPACE AFTER OPCODE
	LAC	AC627		/ RESTORE AC
	JMP*	SIXTO7
/
CHRCNT;AC627
/
/  SUBROUTINE TO SET THE SIMULATED MB TO THE CORRECT VALUE.  THE VALUES
/  ARE ALSO INSERTED INTO THE LISTING BUFFER.
/
SETMB	XX
	LAC*	IPC
	AND	(20000
	DAC	DEFER		/ SET 'DEFER' FLAG, IF INDICATED
	LAC*	IPC
	AND	(17777		/ GET 13-BIT ADDRESS FROM INSTRUCTION
	DAC	MB
	LAC	IPC
	AND	(60000		/ GET BANK BITS FROM PC
	XOR	MB
STORMB	DAC	MB		/ NOW HAVE 15-BIT INSTRUCTION ADDRESS
	JMS	DIGITS
	LAW	50		/ '('
	DAC*	LSTPNT
	IDX	LSTPNT
	LAC*	MB		/ CONTENTS OF ADDRESSED MEMORY
	JMS	DIGITS
	LAW	51		/ ')'
	DAC*	LSTPNT
	IDX	LSTPNT
	LAC	DEFER		/ DO WE HAVE TO PERFORM AN ADDITIONAL
	SNA			/ FETCH CYCLE?
	JMP	DIRECT		/ NOT AT THIS POINT.  PROCEED
/
/  WE HAVE AN INDIRECT MEMORY REFERENCE.  WE MUST CHECK TO SEE IF
/  IT IS AN AUTO-INDEX REFERENCE, AND TAKE APPROPRIATE ACTION, IF SO.
/
	LAC	MB
	AND	(17777		/ GET 13-BIT ADDRESS
	TAD	(-10
	SPA			/ IS ADDRESS < 10 ?
	JMP	NOAUTO		/ YES.	NOT AUTO-INDEX.
	TAD	(10-17		/ ADDRESS > 10
	SMA!SZA 	      / IS ADDRESS < 17 ?
	JMP	NOAUTO
/
/  WE HAVE AN AUTO-INDEX REFERENCE. SIMULATE IT PROPERLY.
/
	TAD	(17		/ RESTORE CORRECT ADDRESS.
	DAC	MB		/ IT ALWAYS REFERENCES BANK 0
	IDX*	MB		/ INDEX AUTO_INDEX.  IT SHOULDN'T SKIP
	NOP			/ BUT IT MIGHT
	LAW	40
	DAC	LSTIMG+31       / CHANGE BANK BITS AND
	DAC	LSTIMG+32       / LEADING ZEROS TO SPACES
	DAC	LSTIMG+33
	DAC	LSTIMG+34
/
NOAUTO	LAW	52		/ '*'
	DAC	LSTIMG+21       / INDICATE INDIRECT INSTRUCTION
	JMS	WRITE		/ OUTPUT INFO TO DATE
	LAC	(LSTIMG+22
	DAC	LSTPNT		/ RESUME IN 'INSTRUCTION' COLUMN
	DZM	DEFER		/ CLEAR 'DEFER' FLAG
	LAC*	MB
	AND	(77777		/ ONLY 15 BITS IN ADDRESS
	JMP	STORMB		/ AND RETURN TO LOOP
/
DIRECT	JMS	GETACL		/ SET LINK & AC TO EXPECTED PROG STATE
	JMP*	SETMB
/
/  SUBROUTINE TO OUTPUT THE CURRENT IMAGE BUFFER, THEN RE-INITIALIZE IT
/  TO ALL SPACES.
/
WRITE	XX
	LAW	15		/ CR
	DAC*	LSTPNT		/ APPEND CARRIAGE RETURN TO LINE
	LAC	(LSTIMG
	DAC	PCK+1		/ POINTER FOR PACK
	DAC	LSTPNT		/ AND BUFFER INITIALIZATION
	LAC	(LSTBUF+2
	DAC	PCK+2
	.WAIT	LP		/ WAIT FOR ANY PREVIOUS I/O
PCK	JMS	PACK
	0; 0
	SMA
	JMP	PCK
	TAD	(LSTBUF
	CMA
	TAD	PCK+2		/ (PCK+2) - ( (LSTBUF)
	ALSS	10
	XOR	(2
	DAC	LSTBUF
	.WRITE	LP,2,LSTBUF,0   / WRITE OUT THE LINE
	LAW	-BUFSIZ
	DAC	LSTCNT
	LAW	40		/ INITIALIZE IMAGE BUFFER TO SPACES
	DAC*	LSTPNT
	IDX	LSTPNT
	ISZ	LSTCNT
	JMP	.-3
	LAC	(LSTIMG         / RESET IMAGE BUFFER POINTER
	DAC	LSTPNT
	ISZ	LNCNT		/ HAVE WE OUTPUT A FULL PAGE YET?
	JMP*	WRITE		/ NOT YET
	LAW	-62		/ YES. RESET LINES-PER-PAGE COUNTER
	DAC	LNCNT
	.WRITE	LP,2,HEAD,0     / WRITE NEW COLUMN HEADER INFO
	.WRITE	LP,2,SPACE,0    / BLANK LINE
	JMP*	WRITE
/
LSTIMG	.BLOCK	BUFSIZ
LSTBUF	.BLOCK	BUFSIZ+4/5*2+2	/ MAGIC FORMULA TO CREATE CORRECT SIZE
NAME	.SIXBT	'PROG@@TRC'
LSTPNT;LSTCNT;LNCNT
HEAD	HD-.*400+2; 0
	.ASCII	<14>'   PC'<11>'INSTR  OP   ADDR   CON'
	.ASCII	<11>' L   AC     MQ'<15> ;HD=.
SPACE	2002; 0
	.ASCII	' '<15>
	.TITLE ASCII PACK-UNPACK SUBROUTINE
/
/  CALLING SEQUENCE
/
/	JMS*	PACK (OR UNPACK)
/	.DSA	ADDRESS OF INPUT CHARACTERS
/	.DSA	ADDRESS OF OUTPUT CHARACTERS
/
/THE ADDRESSES ARE INCREMENTED BY THE PROPER AMOUNT TO POINT TO THE
/WORDS IN THE BUFFER.  WHEN CARRIAGE RETURN OR ALT MODE IS ENCOUNTERED,
/THE AC IS SET TO -1 (.TRUE.) ON EXIT FROM THE SUBROUTINE.  HENCE,
/NORMAL CALLING SEQUENCE WOULD BE:
/
/	JMS*	PACK (OR UNPACK)
/	.DSA	ADDRESS IN
/	.DSA	ADDRESS OUT
/	SMA
/	JMP	.-4
/
/	.GLOBL PACK,UNPACK
/
PACK	XX
	LAC*	PACK
	DAC	IN
	TAD	(5
	DAC*	PACK
	ISZ	PACK
	LAC*	PACK
	DAC	OUT
	TAD	(2
	DAC*	PACK
	ISZ	PACK	/POINT TO RETURN
	LAW	-5	/SET A COUNTER TO PROCESS
	DAC	COUNT	/5 CHARACTERS
	CLL		/CLEAR LINK TO PREVENT CONFUSION TO EAE
NEXT	LAC*	IN
	JMS	END	/CHECK FOR END OF LINE
	DAC	END	/HANDY PLACE TO STORE TEMPORARILY
	LAC	TWO
	LMQ
	LAC	ONE	/LOAD TWO WORDS
	LLS	7
	DAC	ONE	/STORE SHIFTED LEFT HALF
	LAC	END
	OMQ		/ADD IN NEW CHARACTER
	DAC	TWO	/STORE NEW RIGHT HALF
	ISZ	IN	/POINT TO NEXT CHARACTER
	ISZ	COUNT	/5 CHARACTERS YET?
	JMP	NEXT	/NO
	LAC	TWO	/YES
	RCL
	DAC	TWO	/MUST SHIFT EXTRA PLACE ON PACK
	LAC	ONE
	RAL
	DAC*	OUT	/RETURN PACKED PAIR TO USER
	ISZ	OUT
	LAC	TWO
	DAC*	OUT
	LAC	LNEND	/EXIT WITH END OF LINE FLAG
	DZM	LNEND	/IN AC
	JMP*	PACK
/
/
IN;OUT;COUNT;LNEND
/
ONE;TWO
/
END	XX
	AND	(177
	SAD	(15	/CHECK FOR CARRIAGE RETURN
	SKP
	SAD	(175	/AND ALT MODE
	SKP
	JMP*	END	/GO AWAY IF NEITHER
	LMQ		/SAVE CHARACTER TEMPORARILY
	LAW	-1	/SET END-OF-LINE FLAG TO
	DAC	LNEND	/.TRUE. (-1) IF FOUND
	LACQ
	JMP*	END
	.END