/SUBROUTINE TO CONVERT A SINGLE 6 BIT
/CHARACTER TO A SINGLE 8 BIT CHARACTER
/	
SBTA,	0
	CLA CLL
	TAD ERS0	/FETCH CHARACTER
	SNA	/WAS IT A NULL?
	JMP I SBTA	/YES...IGNORE IT
	TAD SBM40	/NO...SUBTRACT 40
	SPA CLA	/WAS IT > OR = 40?
	TAD SB100	/NO...SET 100
	TAD SB200	/YES...ADD 200
	TAD ERS0	/ADD CHARACTER
	DCA ERS0	/STORE 8 BIT CODE
	JMP I SBTA	/RETURN
/	
/CONSTANTS...CONVERT TO 8 BIT ROUTINE
/	
SB100,	100
SB200,	200
SBM40,	0-40
/SUBROUTINE TO MOVE NUMBERS BETWEEN MACRO
/DATA STORE AND MICRO AC AND SR REGISTERS
/
/THE SUBROUTINE OPERATES ACCORDING TO THE
/VALUE OF A SOFTWARE FLAG:-
/	FLAG = 0 :	MACRO ARG1 TO MICRO SR
/	"	= 1 :	MICRO AC	TO MACRO ARG1
/	
STORER, 0
	CLA CLL
/	
/TEST FOR ZERO PRECISION
/	
	TAD F2	/FETCH NO OF WORDS
	CLL RAR	/ROTATE THREE...
	RTR	/...PLACES RIGHT
	SNA	/IS NO OF WORDS ZERO?
	JMP STCHK	/YES...CHECK IF CORRECT
	DCA STKNT	/NO...STORE NUMBER
/	
/NOW TEST FOR OBJECT ERROR
/	
	CLA CLL CMA RTL /SET -3
	TAD STKNT	/ADD NUMBER
	SMA SZA CLA	/WAS NUMBER > 3?
	JMP I TVMOER	/YES...TO OBJECT ERROR
/	
/FLAG IS FETCHED AND TESTED TO DETERMINE
/WHICH OPERATION THE ROUTINE IS TO PERFORM

	/	
	TAD SFLAG	/NO...FETCH FLAG
	SNA CLA	/IS IT ZERO?
	JMP SET1	/YES...SET FOR A1 TO SR
	/	
	/SET UP ROUTINE TO MOVE MICRO AC TO MACRO ARG1
	/	
	TAD STACL	/NO...FETCH AC ADDRESS
	DCA STADD	/STORE IT
	CLA CLL CMA	/SET -1
	TAD STKNT	/ADD NO OF WORDS
	TAD ARG1	/ADD ADDRESS
	DCA STCON	/STORE IT
	TAD RCDFI	/FETCH CDF INSTRUCTION
	DCA STRLP	/SET IT
	TAD ARG1F	/FETCH CDF INSTRUCTION
	DCA STRLP1	/SET IT
	JMP SET	/CONTINUE
/	
/SET UP ROUTINE TO MOVE MACRO ARG1 TO MICRO SR
/	
SET1,	DCA SRH	/CLEAR 36 BIT SR
	DCA SRM
	DCA SRL
	CLA CLL CMA	/SET -1
	TAD STKNT	/ADD NO OF WORDS
	TAD ARG1	/ADD ADDRESS
	DCA STADD	/STORE IT
	TAD STSRL	/FETCH SR ADDRESS
	DCA STCON	/STORE IT
	TAD ARG1F	/FETCH CDF INSTRUCTION
	DCA STRLP	/SET IT
	TAD RCDFI	/FETCH CDF INSTRUCTION
	DCA STRLP1	/SET IT
/	
/NOW SET UP TRANSFER LOOP
/	
SET,	TAD STKNT	/FETCH NO OF WORDS
	CIA	/NEGATE
	DCA STKNT	/SET AS COUNTER
/	
/THIS IS THE TRANSFER LOOP
/	
STRLP,	0	/SET DATA FIELD TO FETCH
	TAD I STADD	/FETCH DATA
STRLP1, 0	/SET DATA FIELD TO STORE
	DCA I STCON	/STORE DATA
	CDF	/SET DATA FIELD TO ZERO
	JMS I TVPDPR	/UPDATE FETCH POINTER
	STADD
	JMS I TVPDPR	/UPDATE STORE POINTER
	STCON
	ISZ STKNT	/INDEX COUNTER
	JMP STRLP	/BACK IF NOT LAST
	JMP I STORER	/RETURN

/	
/IF NO OF WORDS IS ZERO CHECK TO SEE IF ZERO IS ALLOWED
/	
STCHK,	TAD OPCODE	/FETCH OPCODE
	TAD SKM13	/SUBTRACT 13
	SNA CLA	/WAS OPCODE 13?
	JMP I STORER	/YES...RETURN
	TAD OPCODE	/NO...FETCH OPCODE
	TAD SKM16	/SUBTRACT 16
	SMA CLA	/WAS OPCODE 16?
	JMP I STORER	/YES...RETURN
/	
/IF ZERO IS ALLOWED THEN INSTRUCTION IS
/"IMMEDIATE" AND A CONSTANT IS FETCHED
/	
	TAD ARG1	/NO...FETCH CONSTANT

	DCA SRL	/PLACE IN SR
	TAD INSTRH
	DCA SRM
	DCA SRH
	JMP I STORER	/RETURN
/	
/CONSTANTS...FETCH DATA ROUTINE
/	
STACL,	ACL
STSRL,	SRL
SKM13,	0-13
SKM16,	0-16
STADD,	0
STCON,	0
STKNT,	0
/	
/TRIPLE PRECISION DIVIDE ROUTINE
/	
TDIV,	0
	CLA CLL
	DCA DSGN	/SET SIGN OF RESULT SWITCH
/
/NOW CHECK SIGNS OF EVERYTHING
/
	TAD ACH	/FETCH HIGH ORDER AC
	SMA	/IS IT NEGATIVE?
	JMP NNA	/NO...CONTINUE
	ISZ DSGN	/YES...SET SIGN SWITCH
	JMS C72	/COMPLEMENT 72 BIT AC-MQ
NNA,	CLA CLL
	TAD SRH	/FETCH HIGH ORDER SR
	DCA SR1H	/STORE IN HIGH ORDER SR1
	TAD SRM	/FETCH MED ORDER SR
	DCA SR1M	/STORE IN MED ORDER SR1
	TAD SRL	/FETCH LOW ORDER SR

	DCA SR1L	/STORE IN LOW ORDER SR1
	TAD SRH	/FETCH HIGH ORDER SR
	SMA	/IS IT NEGATIVE?
	JMP NNSR	/NO...COMPLEMENT SR1
	ISZ DSGN	/YES...SET SIGN SWITCH
	JMS I TVCOMP	/COMPLEMENT SR
	SRH
	JMP INDL	/TO DIVIDE LOOP
NNSR,	JMS I TVCOMP	/COMPLEMENT SR1 IF +VE
	SR1H
INDL,	TAD DM36	/PLACE -36
	DCA DSHC	/IN SHIFT COUNTER
/
/THIS BEGINS THE ACTUAL DIVIDE
/
/FIRST SHIFT AC-MQ LEFT 1 PLACE
/
DLP,	JMS I TVFAIL	/CHECK FOR POWER DOWN
	CLA CLL CML	/SET LINK = 1
	TAD DM6	/PUT -6
	DCA ERS0	/IN INDEX LOCATION
	TAD AMQLD	/PUT ADDRESS OF LOW ORDER MQ
	DCA ERS1	/IN ADDRESS INDEX LOCATION
/
DLP1,	CLA CML
	TAD I ERS1	/FETCH WORD FROM 72 BIT REGISTER
	RAL	/SHIFT LEFT 1
	DCA I ERS1	/RESTORE TO 72 BIT REGISTER

	CLA CMA	/ -1
	TAD ERS1	/ + ADDRESS
	DCA ERS1	/GIVES NEW ADDRESS
	ISZ ERS0	/INDEX ON NO OF WORDS
	JMP DLP1	/BACK IF NOT FINISHED
	/
	/CHECK TO SEE IF AC > OR = SR
	/
	CLA CLL
	TAD SRH	/FETCH HIGH ORDER SR
	CIA	/MAKE NEGATIVE
	TAD ACH	/ADD HIGH ORDER AC
	SNA	/IS RESULT ZERO?
	JMP DLP2	/YES...MORE TESTS
	SMA	/NO...IS AC > SR?
	JMP SBTC	/YES...GO TO SUBTRACT
	JMP INDX	/NO...GO TO INDEX SHIFT COUNTER
DLP2,	CLA CLL
	TAD SRM	/FETCH MED ORDER SR
	CMA CML IAC	/NEGATE; USE LINK AS 13 BIT AC
	TAD ACM	/ADD MED ORDER AC
	SNA	/RESULT ZERO?
	JMP DLP3	/YES...MORE TESTS
	SNL	/LINK IS SIGN; IS AC > SR?
	JMP SBTC	/YES...GO TO SUBTRACT
	JMP INDX	/NO...GO TO INDEX SHIFT COUNTER
DLP3,	CLA CLL
	TAD SRL	/FETCH LOW ORDER SR
	CMA CML IAC	/NEGATE; USE LINK AS 13 BIT AC
	TAD ACL	/ADD LOW ORDER AC
	SZL	/LINK IS SIGN; IS AC > OR = SR?
	JMP INDX	/NO...INDEX SHIFT COUNTER
/
/NOW SUBTRACT SR FROM AC
/
SBTC,	CLA CLL IAC	/SET 1...
	DCA SFLAG	/...IN FLAG
	JMS I TVADDS	/ADD SR1 TO AC
	DCA SFLAG	/CLEAR FLAG
	ISZ MQL	/LOW MQ + 1; ACCOUNTS FOR DIVISION
INDX,	ISZ DSHC	/INDEX SHIFT COUNTER
	JMP DLP	/BACK IF NOT FINISHED
/
/DIVISION COMPLETE...NOW CHECKT
/
	CLA CLL
	TAD DSGN	/FETCH SIGN SWITCH
	RAR	/SHIFT RIGHT 1
	SNL	/WAS IT ODD?
	JMP I TDIV	/NO...RESULT +VE...EXIT
	JMS I TVCOMP	/YES...COMPLEMENT RESULT
	MQH
	JMP I TDIV	/RETURN
/
/LOCAL CONSTANTS...DIVIDE ROUTINE

	/
DM6,	0-6
DM3,	0-3
DM36,	0-44
AMQLD,	MQL
DSHC,	0
DSGN,	0
/
/TRIPLE PRECISION MULTIPLY ROUTINE
/
TMPY,	0
	CLA CLL
	DCA SIGN	/ZERO SIGN OF RESULT SWITCH
	DCA ACH	/CLEAR 36 BIT AC.
	DCA ACM
	DCA ACL
TSMQ,	TAD MQH	/FETCH HIGH ORDER MQ
	SMA	/IS IT NEGATIVE?
	JMP TSSR	/NO...CONTINUE
	ISZ SIGN	/YES...SET SIGN SWITCH
	JMS I TVCOMP	/COMPLEMENT MQ
	MQH
TSSR,	CLA CLL
	TAD SRH	/FETCH HIGH ORDER SR
	SMA	/IS IT NEGATIVE?
	JMP STLP	/NO...CONTINUE
	ISZ SIGN	/YES...SET SIGN SWITCH
	JMS I TVCOMP	/COMPLEMENT SR
	SRH
STLP,	CLA CLL	/INITIALISE MULTIPLICATION LOOP
	TAD M36	/PLACE -36 IN
	DCA SHCT	/SHIFT COUNTER
/
/THIS IS THE MULTIPLICATION LOOP
/
MLP,	CLA CLL
	JMS I TVFAIL	/CHECK FOR POWER DOWN
	TAD MQL	/FETCH LOW ORDER MQ
	RAR	/OBTAIN RIGHTMOST BIT
	SNL	/WAS IT A 1?
	JMP SHFT	/NO...JUST SHIFT
	CLA CLL	/YES...CLEAR AC AND LINK
	DCA SFLAG	/CLEAR FLAG
	JMS I TVADDS	/ADD SR TO AC
/
/NOW SHIFT AC AND MQ RIGHT ONE PLACE AS A 72 BIT REGISTER
/
SHFT,	CLA CLL

	DCA ERS0	/ZERO SHIFTED BIT LOCATION
	TAD AACH	/SET ADDRESS OF HIGH ORDER AC
	DCA IR1	/ -1 IN AUTO INDEX REGISTER 1
	TAD AACH	/AND ALSO TO
	DCA IR2	/AUTO INDEX REGISTER 2
	TAD M6	/FETCH -6
	DCA ERS1	/STORE AS INDEX
GETW,	TAD I IR1	/FETCH WORD
	RAR	/SHIFT RIGHT 1
	TAD ERS0	/ADD BIT SHIFTED OUT OF LAST
	DCA I IR2	/WORD TO SAME WORD
	RAR	/LINK TO HIGH ORDER AC
	DCA ERS0	/TO SHIFTED BIT LOCATION
	ISZ ERS1	/INCREMENT NO OF WORDS
	JMP GETW	/BACK IF NOT FINISHED
	ISZ SHCT	/ADD 1 TO SHIFT COUNTER
	JMP MLP	/BACK IF NOT LAST
/
/MULTIPLICATION OVER...NOW SET SIGN OF RESULT
/
	CLA CLL
	TAD SIGN	/FETCH SIGN SWITCH
	RAR	/SHIFT RIGHT 1
	SNL	/WAS IT AN ODD NO?
	JMP I TMPY	/NO...RETURN WITH AC-MQ +VE
	JMS C72	/YES...COMPLEMENT 72 BIT PROD.
	JMP I TMPY	/RETURN WITH AC-MQ -VE
/
/
/SUBROUTINE TO COMPLEMENT AC AND MQ AS ONE 72 BIT REGISTER
/
C72,	0
	CLA CLL
	TAD M6	/PLACE -6
	DCA ERS0	/IN AN INDEX LOCATION
	TAD AMQL	/PLACE LOW ORDER MQ ADDRESS
	DCA ERS1	/IN CURRENT REGISTER LOCATION
	TAD MQL	/FETCH LOW ORDER MQ
NEG,	CIA	/MAKE NEGATIVE
	JMP ENTL	/THEN ENTER LOOP IN MIDDLE
/
C72L,	CLA CMA CLL CML / -1
	TAD ERS1	/ + ADDRESS OF CURRENT REGISTER
	DCA ERS1	/IS NEW ADDRESS
	TAD I ERS1	/FETCH CURRENT REGISTER
	CMA	/COMPLEMENT IT
	TAD SIGN	/ADD OVERFLOW BIT

ENTL,	DCA I ERS1	/RESTORE TO REGISTER
	GLK	/FETCH OVERFLOW BIT
	DCA SIGN	/STORE IT
	ISZ ERS0	/INDEX ON NO OF REGISTERS
	JMP C72L	/RETURN FOR MORE
	JMP I C72	/RETURN WITH AC-MQ -VE
/	
/LOCAL CONSTANTS...MULTIPLY ROUTINE
/	
M6,	0-6
M36,	0-44
AACH,	ACH-1
AMQL,	MQL
SHCT,	0
SIGN,	0
/	

	/THE ADDTO AND STORE FUNCTIONS
	/
ADDTOR, CLA
	DCA SFLAG	/CLEAR FLAG
	JMS I TVADDS	/ADD SR TO AC
STORR,	CLA CLL IAC	/SET 1...
	DCA SFLAG	/...IN FLAG
	JMS I TVSTOR	/PLACE AC IN ARG1
	DCA SFLAG	/CLEAR FLAG
RAEXIT, TAD ACCH	/FETCH HIGH ORDER AC
	DCA ACH	/RESET IT
	TAD ACCM	/FETCH MED ORDER AC
	DCA ACM	/RESET IT
	TAD ACCL	/FETCH LOW ORDER AC
	DCA ACL	/RESET IT
	JMP I TVMST	/EXIT