software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape5 / RKLFMT.PA

/RK8E/RK8L DISK FORMATTER
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
\f/RK8E/RK8L DISK FORMATTER PROGRAM: MD-08-DHRKD-D
/MAINDEC-08-DHRKD-D-D
/
/MODIFIED FOR OS8V3D BY ED STEINBERGER
/
DLSC=6740			/LOAD SECTOR COUNTER
DSKP=6741			/SKIP ON TRANSFER DONE OR ERROR
DCLR=6742			/CLEAR DISK CONTROL LOGIC
DLAG=6743			/LOAD ADDRESS AND GO
DLCA=6744			/LOAD CURRENT ADDRESS
DRST=6745			/READ STATUS REGISTER
DLDC=6746			/LOAD COMMAND REGISTER
DMAN=6747			/LOAD MAINTENANCE
/
LDSC=JMS I	XXLDSC
IOTCHN=JMS I	XCHANG
LODTRK=JMS I	XWRTRK
REDDSK=JMS I	XRDTRK
RECAL=JMS I	XRESTR
RECEIV=JMS I	XWAIT
KILBUF=JMS I	XKLBUF
ERROR=JMS I	XERRO
RDSTAT=JMS I	XRDST
LDADD=JMS I	XLDAD
DSKSKP=JMS I	XSDKP
LDCMD=JMS I	XLDCM
LDCUR=JMS I	XLDCA
CLRALL=JMS I	XCLDR
PRNTER=JMS I	XPRN
OCTEL=JMS I	XFROCT
TWOCT=JMS I	XTOCT
TYPE=JMS I	XPRINT
CRLF=JMS I	XCRLF
APT8A=JMS I	XAPT8
TIME=JMS I	XTIME
TICK=JMS I	XTICK
KAERRO=JMS I	XAERRO
/
*0
/
	304			/REV D
	5001
	0002
	0003
/
*10
/
AUTO10,	0
/
AUTO11,	0
/
*20
/
	0000			/PSEUDO SWITCH REGISTER
	0			/CONTROL WORD 1 - USE PSUEDO SWITCHES **ES**
	400			/CONTROL WORD 2 - SET CONSOLE PACKAGE ACTIVE **ES**
	0000			/RESERVED
XAPT8,	APT8
XTIME,	KTIME
XAERRO,	AERRO
XTICK,	KTICK
XCHANG,	CHANG
XWRTRK,	WRTTRK
XRDTRK,	REDTRK
XRESTR,	RESTOR
XWAIT,	WAIT
XKLBUF,	KLBUF
XPRINT,	PRINT
XERRO,	ERRO
XRDST,	RDST
XSDKP,	SDKP
XLDCM,	LDCM
XLDCA,	LDCA
XLDAD,	LDAD
XCLDR,	CLDR
XXLDSC,	XLDSC
XPRN,	PRN
XFROCT,	FROCT
XTOCT,	TOCT
XCRLF,	UPONE
XLOTRK,	LOTRK
XHITRK,	HITRK
BGNBUF,	WRKBUF
AMOUNT,	0
SWITCH,	0
K0003,	0003
K4,	4
K0007,	0007
K0040,	0040
M313,	-313
K0277,	0277
K0200,	0200
K0260,	0260
K4000,	4000
K7735,	7735
K7760,	7760
K0400,	400
K0037,	0037
KCDF,	CDF
M4,	-4
M10,	-10
DRIVNO,	0
CHAR,	0
LOWAD,	0
HIGHAD,	0
TRKCNT,	0
DSKCNT,	0
SBCNT1,	0
STCNT1,	0
STCNT2,	0
STCNT3,	0
TCNTR1,	0
TCNTR2,	0
TCNTR3,	0
TCNTR4,	0
TCNTR5,	0
/
GDREG2,	0
EXBIT,	0
CMREG,	0
STREG,	0
DAREG,	0
CAREG,	0
ADREG,	0
DTREG,	0
BGNTST,	FRMDSK
HOMEMA,	0
DATCNT,	0
CLKCNT,	-2
/
XMOVE,	MOVE
LOC8ED,	0
XEND,	ENDTST
SOFT,	0
ADPOT1,	DSK0A
DSK0A,	0
DSK1A,	0
DSK2A,	0
DSK3A,	0
DSK4A,	0
DSK5A,	0
DSK6A,	0
DSK7A,	0
ADPOT2,	DSK0B
DSK0B,	0
DSK1B,	0
DSK2B,	0
DSK3B,	0
DSK4B,	0
DSK5B,	0
DSK6B,	0
DSK7B,	0
PCOUNT,	0				/USED ONLY IF ON APT
/
*200
/
BGN,	RIF
	DCA	HOMEMA
	TAD	HOMEMA
	TAD	KCDF			/MAKE HOMEDF
	DCA	.+1
	HLT				/MAKE DF=IF
/NOW TEST FOR APT SYSTEM
/IF ON APT TERMINAL MESSAGES ARE SKIP
/TO AVOID TIMING PROBLEMS WITH THE SYSTEM
	APT8A				/TEST FOR APT SYSTEM
	JMS	XC8PSW			/GET SR=.
	*.-1			/**ES**
	NOP			/**ES**
	IOTCHN				/CHANGE DEVICE TO SWR3-8
	CRLF
	CRLF
	PRNTER				/PRINT "RK8E/RK8L DISK FORMATTER PROGRAM"
	MES1				/MESSAGE 1 POINTER
	CRLF
	PRNTER				/PRINT "FOR ALL QUESTIONS"
	MES2				/MESSAGE POINTER 2
ALLAGN,	TAD	M10
	DCA	STCNT1			/COUNTER FOR AMOUNT OF DISKS
	DCA	LOC8ED
	DCA	STCNT2
SAMAGN,	CRLF
	PRNTER			/PRINT "FORMAT DISK ? "
	MES3				/MESSAGE POINTER 3
	TAD	STCNT2
	TAD	K0260
	TYPE				/TYPE DISK NUMBER
QUES1,	TAD	K0277
	TYPE				/TYPE ?
	TAD	ADPOT1
	TAD	STCNT2
	DCA	STCNT3
	RECEIV				/WAIT FOR CHARACTER
	JMP	NOTDSK			/NO NOT THIS DISK
	JMP	QUES1			/NEITHER YES OR NO
WASDSK,	ISZ	LOC8ED
	CLA CLL CMA
NOTDSK,	DCA I	STCNT3			/YES, WAS CLEAR DISK POINTER
	ISZ	STCNT2			/UPDATE POINTER
	ISZ	STCNT1			/COUNT DISKS
	JMP	SAMAGN			/ASK ABOUT NEXT
/
DONE,	CRLF
	PRNTER				/PRINT "ARE YOU SURE ?"
	MES4				/MESSAGE POINTER 4
	RECEIV				/WAIT FOR CHARACTER
	JMP	ALLAGN			/NO, START ALL OVER
	JMP	DONE			/NEITHER TYPE ?
	TAD	LOC8ED
	CIA
	SNA				/ANY DISKS
	JMP	BGN			/NO, OPERATOR ERROR
	DCA	LOC8ED			/YES, AMOUNT LOCATED
/
/FIRST RECALIBRATE AND FORMAT IN WRITE ALL MODE
/ALL DISK DRIVES SELECTED BY OPERATOR,. MAKE THE FIRST
/TWO WORDS OF EVERY DISK SECTOR EQUAL TO THE 
/ABSOLUTE DISK ADDRESS.
/
FRMDSK,	JMS I	XMOVE			/MOVE DISK POINTERS
	TAD	LOC8ED
	DCA	AMOUNT
	TAD	AMOUNT
	DCA	DSKCNT			/COUNTER FOR AMOUNT OF DISKS
	DCA	TCNTR4
	TAD	ADPOT2
	DCA	TCNTR5			/A FEW COUNTERS
	TAD I	TCNTR5
	SZA CLA				/FORMAT THIS DISK
	JMP	FORMAT			/YES, GO
NEXFRM,	ISZ	TCNTR5			/NO, TRY NEXT
	ISZ	TCNTR4
	JMP	.-5
	HLT				/WHAT HAPPENED????
/
FORMAT,	TAD	TCNTR4
	AND	K0003			/MASK OUT
	CLL RAL				/MAKE DISK NUMBER
	DCA	DRIVNO
	TAD	TCNTR4
	AND	K4
	SZA CLA
	TAD	K0200
	DCA	EXBIT			/SET EXTENDED DRIVE BIT
	RECAL				/RECALIBRATE THIS DRIVE
	JMP	RENEX1			/RECALIBRATE NEXT EXISTING
	DCA	LOWAD			/SETUP ADDRESS POINTER
	DCA	HIGHAD			/SETUP ADDRESS POINTER
	TAD	M313
	DCA	TRKCNT			/COUNTER FOR AMOUNT OF TRACKS
/
/
WRTDSK,	TICK				/TIMING FOR APT IF NEEDED.
	-4				/OTHERWISE BOTH ARE SKIPPED
	LODTRK				/FORMAT A TRACK
	JMP	RENEX1			/TO NEXT DISK
	CLA CLL
	TAD	LOWAD
	TAD	K0040
	DCA	LOWAD			/UPDATE TO NEXT TRACK
	SZL CLA				/SET EXTENDED BIT
	ISZ	HIGHAD			/YES
	ISZ	TRKCNT			/UPDATE TRACK COUNTER
	JMP	WRTDSK			/DO NEXT TRACK
RENEX1,	ISZ	DSKCNT			/UPDATE DISK COUNTER
\f	JMP	NEXFRM			/DO NEXT DISK
/
/ROUTINE TO CHECK ADDRESSING INFORMATION ON THE DISK.
\f/THE FIRST TWO WORDS OF EVERY SECTOR SHOULD EQUAL
/THE ABSOLUTE DISK ADDRESS. ALL OTHER DATA IS
/NOT CHECKED.
/
CHKDSK,	TAD	AMOUNT
	DCA	DSKCNT			/AMOUNT OF DISKS
	DCA	TCNTR4
	TAD	ADPOT2
	DCA	TCNTR5
	TAD I	TCNTR5			/SOFTWARE INFORMATION
	SZA CLA				/CHECK THIS DISK
	JMP	CHKDAT			/CHECK THIS ONE
NEXCHK,	ISZ	TCNTR5			/UPDATE FOR NEXT DISK
	ISZ	TCNTR4
	JMP	.-5
	HLT				/WHAT HAPPENED?????
/
CHKDAT,	TAD	TCNTR4
	AND	K0003			/MASK OUT
	CLL RAL				/MAKE DRIVE NUMBER
	DCA	DRIVNO
	TAD	TCNTR4
	AND	K4
	SZA CLA
	TAD	K0200
	DCA	EXBIT			/SET EXTENDED DRIVE BIT
	RECAL				/RECALIBRATE
	JMP	RENEX2			/TRY NEXT DRIVE
	DCA	LOWAD
	DCA	HIGHAD			/SETUP STARTING DISK ADDRESS
	TAD	M313
	DCA	TRKCNT			/AMOUNT OF TRACKS TO DO
	JMP	CHECK
/
PAGE
/
CHECK,	TICK				/TIMING FOR APT IF NEEDED.
	-4				/SKIPPED IF NOT REQUIRED.
	REDDSK				/READ AND CHECK ONE CYLINDER
	JMP	RENEX2			/TO NEXT DISK
	CLA CLL
	TAD	LOWAD
	TAD	K0040
	DCA	LOWAD			/UPDATE TO NEXT CYLINDER
	SZL CLA				/TIME TO SET EXTENDED BIT
	ISZ	HIGHAD			/YES, SET IT
	ISZ	TRKCNT			/UPDATE CYLINDER COUNTER
	JMP	CHECK			/CHECK NEXT ONE
RENEX2,	ISZ	DSKCNT			/UPDATE DISK COUNTER
	JMP	NEXCHK			/CHECK NEXT
/
/
	TAD	22
	AND	K4000			/TEST FOR APT
	SNA CLA				/ARE WE?
	JMP	ENDTST			/NO. NORMAL RUN
	ISZ	PCOUNT			/INCREMENT PASS COUNT
	JMP	FRMDSK			/LOOP PROGRAM
ENDTST,	CRLF
	PRNTER				/PRINT "PASS COMPLETE"
	TEXEND
	CRLF
	PRNTER				/PRINT "TRY SAME SEQUENCE"
	MES5
	RECEIV				/WAIT FOR INPUT FROM OPERATOR
	JMP	ALLAGN			/NO, ASK AGAIN
	JMP	.-5
	JMP	FRMDSK			/TRY SAME SEQUENCE
/
/
/SUBROUTINE FOR "ERRORS," SCOPE LOOPS, AND
/ERROR TYPEOUTS.
/
ERRO,   0
	CLA CLL IAC
	TAD	ERRO			/GET PC STORED
	DCA	RETRN1			/STORE FOR RETURN
	KAERRO				/NOTIFY APT OF ERROR IS NEED BE
        CRLF
	CRLF
        TAD I   ERRO                    /GET TEXT POINTER
        AND     K0007                   /MASK 9-11
	TAD	HEDTAD			/MAKE ERROR HEADER TAD
	DCA	.+1
	HLT				/MODIFIED HEADER TAD
        DCA     .+2
        PRNTER                          /MODIFIED HEADER POINTER
        HLT
        CRLF
        PRNTER                          /PRINT PC:
        TEXPC
        TAD     ERRO                    /GET PC POINTER
        OCTEL                           /PRINT PC STORED
        TAD I   ERRO                    /GET TEXT POINTER
        CLL RAL
        SNL
        JMP     NTGD                    /NOT GD: REGISTER
        DCA     ERRO
        PRNTER                          /PRINT GD:
        TEXGD
        TAD     GDREG2
        OCTEL                           /PRINT FOUR OCTAL
        SKP CLA
NTGD,	DCA	ERRO
	PRNTER
	TEXEX
	TAD	EXBIT
	SZA CLA
	IAC
	OCTEL
        TAD     XTEXT
        DCA     PCNTR2
        TAD     XREG
        DCA     AUTO10
        TAD     K7771
        DCA     PCNTR1                  /COUNTER FOR    # OF HEADS
	CLA CLL CMA RAL
	DCA	PCNTR3
STRAUT, TAD     ERRO                    /GET TEXT POINTER
        SMA
        JMP     NOTEX                   /NOT THIS ONE
        CLL RAL
        DCA     ERRO
	TAD	PCNTR2			/GET TEXT MESSAGE POINTER
	ISZ	PCNTR2
	ISZ	PCNTR2
        DCA     .+2                     /STORE FOR PRNTER
        PRNTER                          /PRINT XX:
        HLT                             /MODIFIED TEXT POINTER
        TAD I   AUTO10
        OCTEL                           /PRINT FOUR OCTAL
	ISZ	PCNTR3
	SKP CLA
	CRLF
AGAIN,	ISZ	PCNTR1
        JMP     STRAUT                  /CHECK FOR NEXT XX:
	JMP I	RETRN1			/RETURN TO QUESTION
NOTEX,  CLL RAL
        DCA     ERRO
	ISZ	PCNTR2
	ISZ	PCNTR2
        ISZ     AUTO10
	JMP	AGAIN
/
RETRN1,	0
XTEXT,	TEXCM
XREG,	EXBIT
PCNTR1, 0
PCNTR2,	0
PCNTR3,	0
HEDTAD,	TAD	HEDLST
HEDLST,	ERTX1
	ERTX2
	ERTX3
	ERTX4
K7771,	7771
/
PAGE
/
/ROUTINE TO FORMAT CYLINDER
/MAKE FIRST TWO WORDS OF EVERY SECTOR
/EQUAL TO DISK ADDRESS.
/
WRTTRK,	0
	CLA CLL CML RAR
	DCA	GDREG2			/SETUP COMPARE REGISTER
	KILBUF				/CLEAR BUFFER
	TAD	K7735			/AMOUNT OF SECTORS TO DO
	DCA	TCNTR1			/SETUP COUNTER
	DCA	TCNTR2			/STARTING WITH 0
	TAD	K7760			/STOPPER
	DCA	TCNTR3			/SECTOR COUNTER POINTER STOP
LODR1,	TAD	TCNTR2
	AND	K0037			/MASK SECTOR BITS
	TAD	LOWAD			/ADD IN CYLINDER
	DCA I	XLOTRK			/SETUP TRACK WORD IN BUFFER
	TAD	EXBIT			/ADD IN EXTENDED BIT
	TAD	HIGHAD
	TAD	DRIVNO			/ADD IN DRIVE NUMBER
	DCA I	XHITRK			/SETUP TRACK WORD IN BUFFER
	TAD I	XHITRK
	AND	K7577
	TAD	HOMEMA			/CURRENT FIELD
	TAD	K5000			/FUNCTION WRITE ALL
	LDCMD				/LOAD COMMAND
	TAD	EXBIT
	LDSC				/LOAD EXTENDED DRIVE BIT
	CLA				/CLEAR EXTENDED DRIVE BIT
	TAD	BGNBUF
	LDCUR				/LOAD CURRENT ADDRESS
	TAD I	XLOTRK
	LDADD				/LOAD TRACK AND GO
	DSKSKP				/SKIP ON FLAG
	JMP	.-1			/WAIT FOR FLAG
	RDSTAT				/READ STATUS
	TAD	K4000
	SZA CLA				/WAS STATUS 0?
	JMP	LODER			/ERROR, STATUS ON WRITE ALL
	ISZ	TCNTR2
	ISZ	TCNTR3			/COUNT FIRST REVOLUTION
	SKP CLA				/STILL IN FIRST REV.
	DCA	TCNTR2			/SETUP FOR SECTOR "1"
	ISZ	TCNTR2
	ISZ	TCNTR1			/UPDATE SECTOR COUNTER
\f	JMP	LODR1			/TRY NEXT SECTOR
	ISZ	WRTTRK
	JMP I	WRTTRK			/THIS CYLINDER DONE
LODER,	ERROR				/ERROR, STATUS
	3602				/TEXT POINTER
/
	RECAL				/CLEAR CONTROL AND DRIVE
	JMP I	WRTTRK			/TO NEXT DISK
	CRLF
	PRNTER				/PRINT "TRY SAME AGAIN"
	ERMES1
	RECEIV				/WAIT FOR YES OR NO
	JMP	LODER-2			/WAS A NO TRY SAME CYLINDER
	JMP	.-5			/WAS NEITHER ASK AGAIN
	JMP	WRTTRK+1		/YES, TRY NEXT
K5000,	5000
K7577,	7577
/
/
/SUBROUTINE TO READ STATUS REGISTER
/
RDST,   0
IOT5,  DRST                            /READ STATUS IOT
        SKP
ERHLT5,	JMS	XC8ERR			/SKIP TRAP ERROR.
        DCA     STREG                   /SAVE RESULTS
        TAD     STREG
        JMP I   RDST                    /EXIT
/
/SUBROUTINE TO LOAD CURRENT ADDRESS REGISTER
/
LDCA,   0
        DCA     ADREG                   /SAVE IN ADDRESS
	TAD	ADREG
	DCA	CAREG			/SETUP INITIAL CURRENT ADDRESS
        TAD     ADREG
IOT4, DLCA                            /LOAD CURRENT ADDRESS IOT
        JMP I   LDCA                    /EXIT
ERHLT4,	JMS	XC8ERR			/SKIP TRAP ERROR.
	JMP	.-1
/
/
/SUBROUTINE TO LOAD TRACK ADDRESS REGISTER
/
LDAD,   0
	DCA	DAREG			/SAVE OUTBOUND DATA
	TAD	DAREG
IOT3,  DLAG                            /LOAD DISK ADDRESS REGISTER
        JMP I   LDAD                    /EXIT
ERHLT3,	JMS	XC8ERR			/SKIP TRAP ERROR.
	JMP	.-1
/
/
/SUBROUTINE TO LOAD COMMAND REGISTER
/
LDCM,   0
	DCA	CMREG			/SAVE OUTBOUND DATA
	DCA	INMODE
	JMS	XC8CKP			/CHECK FOR CONTROL CHARACTERS.
	CLA
	CLA
	TAD	CMREG
IOT6,	DLDC				/LOAD COMMAND REGISTER
        JMP I   LDCM                    /EXIT
ERHLT6,	JMS	XC8ERR			/SKIP TRAP ERROR.
	JMP	.-1
/
/
/SUBROUTINE ISSUE "DLSC"
XLDSC,	0
IOT0,	DLSC
	JMP I	XLDSC
ERHLT0,	JMS	XC8ERR
	JMP	.-1

/SUBROUTINE TO ISSUE "DSKP" DISK SKIP IOT
/
SDKP,   0
IOT1,  DSKP                            /DISK SKIP IOT
        SKP                             /DID NOT SKIP
        ISZ     SDKP
        JMP I   SDKP                    /EXIT
/
/SUBROUTINE TO ISSUE "DCLR" CLEAR IOT
/
CLDR,   0
IOT2,  DCLR                            /DCLR "CLEAR IOT"
        JMP I   CLDR                    /EXIT
ERHLT2,	JMS	XC8ERR			/SKIP TRAP ERROR.
	JMP	.-1
/
/ROUTINE TO ZERO WORK BUFFER
/
KLBUF,	0
	CLA CLL CMA
	TAD	BGNBUF			/START OF BUFFER -1
	DCA	AUTO10			/SETUP AUTO INDEX
	TAD	K7400
	DCA	DATCNT			/SETUP COUNTER
	DCA I	AUTO10			/CLEAR BUFFER
	ISZ	DATCNT			/UPDATE COUNTER
	JMP	.-2			/NOT ALL CLEARED YET
	JMP I	KLBUF			/BUFFER CLEARED
K7400,	7400
/
PAGE
/
/
/ROUTINE TO READ AND CHECK A CYLINDER
/
REDTRK,	0
	TAD	K7735
	DCA	TCNTR1			/AMOUNT OF SECTORS TO DO
	DCA	TCNTR2			/STARTING WITH 0
	TAD	K7760
	DCA	TCNTR3
	KILBUF				/CLEAR BUFFER
CHKR1,	CLA CLL CMA
	DCA	SOFT			/SETUP SOFT ERROR FLAG
	TAD	BGNBUF
	LDCUR				/LOAD CURRENT ADDRESS
	TAD	HIGHAD			/EXTENDED CYLINDER BIT
	TAD	DRIVNO			/CURRENT DRIVE
	TAD	HOMEMA			/CURRENT FIELD
	LDCMD				/LOAD COMMAND
	TAD	EXBIT			/LOAD EXTENDED DRIVE BIT
	LDSC
	CLA				/CLEAR EXTENDED DRIVE BIT
	TAD	TCNTR2
	AND	K0037			/MASK SECTOR BITS OFF
	TAD	LOWAD			/ADD IN OTHER DISK ADDRESS
	LDADD				/LOAD AND GO
	DSKSKP				/DISK SKIP IOT
	JMP	.-1			/WAIT FOR FLAG
	RDSTAT				/READ STATUS
	TAD	K4000			/ADD IN FUDGE FACTOR
	SNA CLA				/SKIP IF ERROR
	JMP	STAOK			/STATUS O.K.
	TAD	STREG			/GET STATUS READ
	AND	K0010
	SNA CLA				/WAS IT A CRC
	JMP	STAER			/NO, JUST A HARD ERROR
	DCA	SOFT			/CLEAR SOFT ERROR FLAG
STAOK,	TAD	CMREG			/GET LAST COMMAND
	AND	K0007
	TAD	EXBIT			/ADD EXTENDED DRIVE BIT
	CIA
	TAD I	XHITRK			/GET WORD READ FROM DISK
	SNA CLA				/SKIP IF ERROR
	JMP	FRSTOK			/FIRST WORD O.K.
	TAD I	XHITRK			/GET WORD
	DCA	DTREG			/SETUP ERROR PRINTER
	TAD	CMREG
	AND	K0007
	DCA	GDREG2			/SETUP GOOD FOR PRINTER
	JMP	DATER			/NO, DATA ERROR
FRSTOK,	TAD I	XLOTRK			/GET WORD READ
	CIA
	TAD	DAREG			/COMPARE TO GOOD
	SNA CLA				/SKIP IF ERROR
	JMP	DATOK			/WORD O.K.
	ISZ	ADREG			/SETUP ERROR PRINTER
	TAD	DAREG
	DCA	GDREG2			/SETUP GOOD WORD FOR PRINTER
	TAD I	XLOTRK			/GET WORD READ
	DCA	DTREG			/SETUP FOR PRINTER
	JMP	DATER			/DATA ERROR
DATOK,	TAD	SOFT			/GET SOFT ERROR FLAG
	SNA CLA				/WAS IT CLEAR
	JMP	STAER			/YES, STATUS ERROR
	TAD	TCNTR2
	TAD	K0003			/ADVANCE 3 SECTORS
	DCA	TCNTR2
	ISZ	TCNTR3
	JMP	CHKR1			/MORE TO FORMAT
	ISZ	REDTRK
	JMP I	REDTRK			/EXIT, O.K.
DATER,	TAD	K7741
	DCA	TCHKT			/SETUP TEXT POINTER
	JMP	CHKER			/ERROR
STAER,	TAD	K3600
	DCA	TCHKT			/SETUP TEXT POINTER
	CLA CLL CML RAR
	DCA	GDREG2			/SETUP GOOD STATUS PRINTER
CHKER,	ERROR				/ERROR, READ DATA
TCHKT,	0				/MODIFIED TEXT POINTER
	RECAL				/CLEAR CONTROL AND DRIVE
	JMP I	REDTRK			/TO NEXT DISK
	CRLF
	PRNTER				/PRINT "TRY SAME AGAIN"
	ERMES3
	RECEIV
	JMP	DATER-2			/CHECK NEXT 
	JMP	.-5			/RE-PRINT
	JMP	REDTRK+1		/TRY SAME AGAIN
/
/THIS ROUTINE WILL TEST FOR APT AND NOP CONSOLE
/PACKAGE IF NEED BE
/
APT8,	0
	TAD	22
	SMA CLA
	JMP I	APT8
	TAD	22
	AND	K7377			/ON APT. NOP CONSOLE PACKAGE
\f	DCA	22
	TAD	22
	AND	K0007			/ISOLATE DRIVE NUMBER OR
					/NUMBER OF DRIVES TO BE DONE
	DCA	STCNT1
	TAD	22
	AND	K0100
	SNA CLA				/SINGLE DRIVE TESTING
	JMP	MULDSK			/NO.SEVERAL TO DO
	TAD	ADPOT1			/GET DISK POINTER
	TAD	STCNT1			/ESTABLISH DRIVE TO DO
	DCA	STCNT1
	CLL CLA CMA			/-1
	DCA I	STCNT1
	CLL CLA CMA			/ONE DISK TO DO
	DCA	LOC8ED
	JMP I 	BGNTST
MULDSK,	TAD	STCNT1			/DRIVE TO BE DONE
	CMA
	DCA	STCNT1
	TAD	ADPOT1			/GET DISK POINTER
	TAD	STCNT2			/ESTABLISH DRIVE TO BE DONE
	DCA	STCNT3
	ISZ	LOC8ED
	CLL CLA CMA
	DCA I	STCNT3			/DO THIS DRIVE
	ISZ	STCNT2	
	ISZ	STCNT1
	JMP	MULDSK+3		/MORE TO DO
	TAD	LOC8ED
	CIA
	DCA	LOC8ED		/NUMBER TO BE DONE
	JMP I	BGNTST
K7377,	7377
PAGE
/
/SUBROUTINE TO PRINT TWO OCTAL
/
TOCT,   0
        DCA     SBCNT1                  /SAVE AC
        TAD     SBCNT1
        RAR
        RTR
        AND     K0007
        TAD     K0260
        TYPE                            /PRINT FIRST BYTE
        TAD     SBCNT1
        AND     K0007
        TAD     K0260
        TYPE                            /PRINT SECOND BIT
        JMP I   TOCT                    /EXIT
/
/
/
/ROUTINE TO DO CRLF
/
UPONE,  0
        CLA CLL
        TAD     K0215
        TYPE
        TAD     K0212
        TYPE
	TYPE				/TYPE ONE NULL
        JMP I   UPONE
/
K0215,	0215
K0212,	0212
/
/ROUTINE TO PRINT FOUR OCTAL
/
FROCT,  0
        RTL
        RTL
        DCA     UPONE
        TAD     M4
        DCA     TOCT
        TAD     UPONE
        AND     K0007
        TAD     K0260
        TYPE
        TAD     UPONE
        RTL
        RAL
        DCA     UPONE
        ISZ     TOCT
        JMP     .-11
	TAD	K0240
	TYPE
        JMP I   FROCT
/
/SUBROUTINE TO PRINT TEXT
/
PRN,    0
        CLA CLL
        TAD I   PRN                     /GET POINTER
        ISZ     PRN
        DCA     FROCT
        TAD I   FROCT
        AND     K7700
        SNA
        JMP     EXIT
        SMA
        CML
        IAC
        RTR
        RTR
        RTR
        TYPE
        TAD I   FROCT
        AND     K0077
        SNA
        JMP     EXIT
        TAD     K3740
        SMA
        TAD     K4100
        TAD     K0240
	TYPE
        ISZ     FROCT
        CLA CLL
        JMP     PRN+5
EXIT,   CLA CLL
        JMP I   PRN

/
K4100,	4100
K3740,	3740
/
/ROUTINE TO TYPE
/
PRINT,  0
        TLS
        TSF
	JMP	.-1
        TCF
        CLA
        JMP I   PRINT
K0240,	0240
K7700,	7700
K0077,	0077
K0010,	10
K7741,	7741
K3600,	3600
/ROUTINE TO WAIT FOR KEY FROM OPERATOR
/
WAIT,	0
	CLA CLL
	KCC
	KSF
	JMP 	.-1
	KRB
	TLS
	TSF
	JMP	.-1
	AND	K0177
	TAD	K0200
	DCA	CHAR
	TAD	CHAR
	DCA	C8CHAR
	ISZ	INMODE
	JMS	XC8CNT		/CHECK FOR CONTROL CHARACTERS.
	CLA
	CLA
	DCA	INMODE
	KCC
	TCF
	TAD	CHAR
	CIA
	TAD	K0316
	SNA CLA				/WAS IT A NO
	JMP I	WAIT			/YES
	ISZ	WAIT			/UPDATE RETURN POINTER
	TAD	CHAR
	CIA
	TAD	K0331
	SNA CLA				/WAS IT A YES
	ISZ	WAIT			/WAS A YES
	JMP I	WAIT			/WAS NEITHER
K0177,	0177
K0316,	0316
K0331,	0331
/
PAGE
/
/
/ROUTINE TO RECALIBRATE SELECTED DRIVE
/
RESTOR,	0
	CLA CLL IAC			/ENABLE CLEAR CONTROL
	CLRALL				/CLEAR CONTROL
	TAD	DRIVNO			/CURRENT DRIVE
	TAD	HOMEMA			/CURRENT FIELD
	LDCMD				/LOAD COMMAND
	TAD	EXBIT
	LDSC				/LOAD EXTENDED DRIVE BIT
	CLA CLL CML RAR			/MAYBE EXPECTED STATUS
	DCA	GDREG2			/SETUP COMPARE REGISTER
	CLA CLL CML RTL			/ENABLE RECALIBRATE BIT
	CLRALL				/"RECALIBRATE"
	DSKSKP				/DISK SKIP IOT
	JMP	.-1			/WAIT FOR FIRST DONE FLAG
	RDSTAT				/READ STATUS
	TAD	K2000
	SNA				/WAS IT BUSY AND DONE
	JMP	RESTA			/YES, THEN ITS O.K.
	TAD	K2000			/NO, THEN IT MUST BE JUST DONE
	SZA CLA				/WAS IT JUST DONE
	JMP	RESTER			/NO, ERROR
RESTA,	CLRALL				/CLEAR STATUS
	TAD	K0200			/ENABLE SET SECOND DONE FLAG
	TAD	CMREG			/ORIGINAL COMMAND
	LDCMD				/LOAD COMMAND
	DSKSKP				/DISK SKIP IOT
	JMP	.-1			/WAIT FOR SECOND DONE
	RDSTAT				/READ STATUS
	TAD	K4000
	SZA CLA				/WAS IT ONLY DONE FLAG
	JMP	RESTER			/NO, ERROR STATUS
	CLA CLL IAC			/ENABLE CLEAR CONTROL
	CLRALL				/CLEAR CONTROL
	ISZ	RESTOR			/UPDATE FOR GOOD RECALIBRATE
	JMP I	RESTOR			/RETURN
RESTER,	ERROR				/ERROR, STATUS
	3603				/TEXT POINTER
/
	CRLF
	PRNTER				/PRINT "TRY RECALIBRATE"
	ERMES2
	RECEIV				/WAIT FOR INPUT
	JMP	.+3			/TRY NEXT EXISTING DISK
	JMP	.-5
	JMP	RESTOR+1		/TRY AGAIN
	CLA CLL IAC
	TAD	AMOUNT			/GET AMOUNT ON SYSTEM
	SNA				/WAS THERE ONLY 1 LEFT
	JMP I	XEND			/LAST DISK
	DCA	AMOUNT			/MORE TO GO BUT CLEAR THIS ONE
	DCA I	TCNTR5			/CLEAR DISK POINTER
	JMP I	RESTOR			/TRY NEXT ONE
/
/
/ROUTINE TO CHANGE DEVICE CODES
/
CHANG,	0
	JMS	XC8SW			/GET SWITCH REGISTER BITS.
	RAR
	SNL CLA				/CHANGE DEVICE CODES?
	JMP I	CHANG			/NO.
	JMS	XC8SW			/GET SWITCHES.
	AND	A0770
	DCA	CSAVE1			/SAVE DESIRED
	TAD	CCNTR1
	DCA	CSAVE2
\f	TAD	CHNPOT
	DCA	RESTOR
CHANGR,	TAD I	RESTOR			/GET ADDRESS POINTER
	DCA	KWAIT
	TAD I	KWAIT			/GET OLD CODE
	AND	A7007			/MASK
	TAD	CSAVE1			/ADD IN DESIRED
	DCA I	KWAIT			/STORE DESIRED DEVICE CODE
	ISZ	RESTOR			/UPDATE POINTER
	ISZ	CSAVE2			/UPDATE CHANGE COUNTER
	JMP	CHANGR
	JMP I	CHANG			/EXIT TO PROGRAM.
/
KWAIT,	0
A7007,	7007
A0770,	0770
CSAVE1,	0
CSAVE2,	0
CCNTR1,	7771
CHNPOT,	CHNPOT+1
	IOT0
	IOT1
	IOT2
	IOT3
	IOT4
	IOT5
	IOT6
K2000,	2000
/
/THIS ROUTINE WILL GENERATE TIMING IF NEEDED BY THE APT SYSTEM
/
KTICK,	0
	CLL CLA
	TAD	22			/GET HARDWARE CONFIGURATION
	AND	K4000
	SNA CLA				/ON APT?
	JMP	EXTICK			/NO
	TAD I	KTICK			/GET TIMING VALUE
	DCA	COUNT			/ESATABLISH TIME
	ISZ	CLKCNT
	JMP	EXTICK			/RETURN
	TAD	COUNT			/GET VALUE OF COUNTER
	DCA	CLKCNT			/STORE IT
	ISZ	CNT			/TIMING NEED BE DONE?
	JMP	EXTICK
	TIME
	TAD	KCNT			/TIMING VALUE
	DCA	CNT			/INIT SECOND COUNTER
EXTICK,	ISZ	KTICK			/MOVE BEYOND TIMING VALUE
	JMP I	KTICK

COUNT,	0
CNT,	-2
KCNT,	-2
K0100,	0100
/
/
/ROUTINE TO NOTIFY APT OF USE IF REQUIRED
/
KTIME,	0
	IOF			/DISABLE INTERUPTS
	RDF			/GET PRESENT DATA FIELD
	TAD KCDF
	DCA .+1			/ESTABLISHES CURRENT DATA FIELD
	HLT
	CIF 70				/FIELD 7. LOCATION OF UV PROM
	JMS I K6500
	CLL CLA
	JMP I KTIME
/
K6500,	6500
/
PAGE
/
/
/THIS ROUTINE WILL NOTIFY APT OF AN ERROR AND SEND PC TO
/APT SYSTEM. ALL ERRORS WILL RESULT IN PROGRAM HLT AND A TIME OUT ON
/APT. APT WILL TAKE OVER FROM THERE.

/
AERRO,	0
	IOF			/DISABLE INTERUPTS
	CLA
	TAD	22		/CHECK FOR APT SYSTEM
	SMA CLA
	JMP I	AERRO		/RETURN NOT ON APT
	TAD I 	KERRO		/GET PC
	DCA SAVPC
	RDF			/GET CURRENT DATA FIELD
	TAD KCDF
	DCA .+2
	TAD SAVPC
	HLT			/REPLACED WILL CURRENT DATA FIELD
	CIF 70			/CHANGE IF FOR APT RETURN TO FIELD 7
	JMP I K6520		/NOTIFIES APT OF ERROR
	HLT
/
K6520,	6520
KERRO,	ERRO
SAVPC,	0
/
/
/ROUTINE TO MOVE DISK POINTERS
/
MOVE,	0
	TAD	ADPT1
	DCA	AUTO10

	TAD	ADPT2
	DCA	AUTO11
	TAD	M10
	DCA	MCNTR1
	TAD I	AUTO10			/FROM HERE
	DCA I	AUTO11			/TO THERE
	ISZ	MCNTR1			/4 POINTERS
	JMP	.-3
	JMP I	MOVE
/
ADPT1,	DSK0A-1
ADPT2,	DSK0B-1
MCNTR1,	0
/
/
TEXPC,  TEXT    "PC:"
TEXGD,  TEXT    "GD:"
TEXEX,	TEXT	"EX:"
TEXCM,	TEXT	"CM:"
TEXST,	TEXT	"ST:"
TEXDA,  TEXT    "DA:"
TEXCA,	TEXT	"CA:"
TEXAD,  TEXT    "AD:"
TEXDT,  TEXT    "DT:"
/
ERTX1,	TEXT	"READ STATUS ERROR"
ERTX2,	TEXT    "DISK DATA ERROR"
ERTX3,	TEXT	"WRITE STATUS ERROR"
ERTX4,	TEXT	"RECALIBRATE STATUS ERROR"
/
ERMES1,	TEXT "TRY TO FORMAT SAME CYLINDER AGAIN?"
ERMES2,	TEXT "TRY TO RECALIBRATE SAME DISK AGAIN?"
ERMES3,	TEXT "TRY TO CHECK SAME CYLINDER AGAIN?"
/
TEXEND,	TEXT	"RK8E/RK8L DISK FORMATTER PASS COMPLETE"
MES1,	TEXT "RK8E/RK8L DISK FORMATTER PROGRAM"
MES2,	TEXT "FOR ALL QUESTIONS, ANSWER Y FOR YES OR N FOR NO."
MES3,	TEXT "FORMAT DISK "
MES4,	TEXT "ARE YOU SURE?"
MES5,	TEXT "FORMAT SAME DISK(S) AGAIN?"
/
PAGE
/
WRKBUF=.
/
HITRK=.
LOTRK=.+1
/
ENDBUF=.+377
/


/CONSOL SRC -V2-R0- CONSOLE PACKAGE


/LAS= CALL C8CKSW OR JMS XC8SW
/THIS WILL READ THE SWITCH REGISTER FROM THE PLACE SPECIFIED
/BY LOCATION 20 BIT 0.


/THE PROGRAN SHOULD CHECK FOR A CONTROL CHARACTER FRON THE TERMINAL
/EVERY FIVE(5) SECONDS OR SOONER.

/LOCATIONS THAT NEED TO BE SET UP FOR USING THE CONSOLE PACKAGE.

/CNTVAL IN XC8PASS    THIS LOCATION DETERMINDS THE NUMBER OF
/PROGRAM COMPLETIONS THAT ARE NEEDED BEFORE THE PASS MESSAGE IS TYPED
/THE VALUE SHOULD PUT THE PASS MESSAGE OUT IN THE RANGE OF 1 TO 5 MINUTES.
/THIS SHOULD BE A POSITIVE NUNBER.

/C8STRT   THIS IS FOUND IN CNTRL ROUTINE CONTROL R PART
/IT IS THE RETURN WHEN CONTROL R IS ENTERED (RESTART PROGRAM)
/THE RETURN JUMPS TO XDOSW WHICH CONTAINS C8STRT SO PUT THE LABEL C8STRT
/WHERE YOU WANT TO RESTART THE PROGRAM.


/SETUP1 IN XC8ERR    THIS IS THE MASK BIT FOR HALT ON ERROR
/PLACE THE CORRECT BIT IN THIS LOCATION FOR HALTING ON ERRORS.

/SETUP2 IN XC8PASS   THIS IS THE MASK FOR HALT A END OF PASS.

/THE CALL TABLE IS A CONDITIONAL ASSEMBLY.
/TO ASSEMBLE THE CALL REMOVE THE / BEFORE CONSOL=0.
/IN COMBINING THE CONSOL PACKAGE TO A DIAGNOSTIC.
/THE CALL TABLE IS TO BE AT THE BEGINNING OF A PROGRAM.


/CONSOL=0
	PSKF=	6661
	PCLF=	6662
	PSKE=	6663
	PSTB=	6664
	PSIE=	6665
	GTF=	6004
	ACL=	7701
	CAF=	6007
	MQL=	7421
	MQA=	7501
/
*3000
/
/*********************************************************************
/C8PASS
/THIS IS CALLED AT THE END OF EACH PROGRAM COMPLETION
/THE VALUE OF** CNTVAL** WILL BE DETERMINED BY THE TIME IT TAKES
/THE PROGRAM TO COMPLETE THIS MANY C8PASS TO BE IN THE 1 TO 4 MINUTE
/RANGE
/	C8PASS=JMS   XC8PAS
/EX. OF CALL		C8PASS
	/		HLT		/HALT IF NON CONSOL PACKAGE
/		JMP	START1		/CONTINUE RUNNING THIS PROGRAM


/RETURN TO LOCATION CALL PLUS ONE WITH THE AC=0 IF NON CONSOL PACKAGE AND HLT
/IF CONTINUE TO RUN THEN RETURN TO CALL PLUS2 AC=0 
/THE LOCATION SETUP2 IS THE MASK BIT FOR THE HALT AT END OF PASS
/CHECK THAT IT IS CORRECT FOR THE CURRENT PROGRAM

/CALLS USED BY XC8PAS ARE  CHKCLA-XC8CRLF-XC8OCTA-XC8SW-XC8PNT-XC8INQ-


XC8PAS,	0
	CLA
\f	JMS	CHKCLA		/IS WORD 22 BIT 3 ACTIVE CONSOLE?
	JMP	DOPACK		/IS CLASSIC
	JMS	C8GET		/GET THE REGISTERS.
	JMS	XC8SW		/DEACTIVE CONSOL CHECK SR SETTING
	AND	(400		/FOR HALT ON END OF C8PASS
	SZA CLA			/1= HALT 0 CONTINUE
	JMP I	XC8PAS		/GO TO HALT
	JMP	C8BY1		/CONTINUE ON RUNNING PROGRAM
DOPACK,	JMS	CKCOUT		/CLASS CHECK C8PASS COUNT
	JMP	C8BY1		/C8PASS COUNT NOT DONE REDO PROGRAM
	ISZ	PASCNT		/C8PASS COUNT DONE SET C8PASS COUNT
	JMS	XC8CRLF
	JMS	XC8PNT		/C8PRNT BUFFER
	MESPAS			/
	TAD	PASCNT		/GET NUMBER
	JMS	XC8OCTA		/CONVERT IT TO ASCII
	JMS	XC8CRLF		/DO A CARRIAGE RETURN
	JMS	C8GET		/GET THE REGISTERS.
	JMS	XC8SW		/CHECK A HALT AT END OF C8PASS
SETUP2,	AND	(400		/MASK BIT
	SZA CLA			/HALT =1 NO SKIP CONTINUE =0
	JMS	XC8INQ		/STOP PROGRAM EXECUTION-LOOK FOR INPUT
C8BY1,	ISZ	XC8PAS		/BUMP RETURN
	JMP I	XC8PAS
CKCOUT,	0
	TAD	DOSET		/CHECK IF SET UP NEEDED
	SZA CLA			/0=SET UP C8PASS COUNT VALUE
				/1=C8PASS COUNT VALUE OK
	JMP	NOSET		/C8PASS COUNT VALUE ON
	TAD	CNTVAL		/GET COUNT VALUE FOR THIS PROG
	CMA			/SET TO NEGATIVE
	DCA	DOCNT		/STORE IN HERE
	ISZ	DOSET		/INDICATE VALUE SET UP
NOSET,	ISZ	DOCNT		/COUNT THE NUMBER OF PASSES
	JMP	C8BY1		/EXIT FOR ANOTHER PASS
	DCA	DOSET		/SET TO C8PRNT C8PASS
	ISZ	CKCOUT		/BUMP RETURN FOR
	JMP I	CKCOUT		/C8PASS C8TYPE OUT
DOCNT,	0
PASCNT,	0			/
DOSET,	0
CNTVAL,	0
MESPAS,	TEXT	"DHRKDD  PASS "



/*********************************************************************

/C8CKSW

/THIS ROUTINE CAN BE USED INPLACE OF A READ THE SWITCHES LAS.
/ROUTINE THAT WILL CHECK WHERE TO READ THE
/C8 SWITCHES FROM IE. FROM PANEL OR PSEUDO SWITCH REGISTER
/THE SELECTION IS DETERMINED BY THE STATE OF BIT 0 IN LOCATION 21.

	/C8CKSW=	JMS XC8SW
	/EX.	JMS	XC8SW		/READ THE C8SWIT REGISTER
					/RETURN WITH THE CONTENTS OF SWITCH REGISTER

/RETURN TO NEXT LOCATION FOLLOWING CALL WITH THE AC= TO VALUE OF C8SWIT SETTING

/CALLS USED ARE-XC8CKPA-



XC8SW,	0
	JMS	XC8CKPA		/GO CHECK THE IF ANY CONTRL
	NOP
	TAD	21		/GET WD FOR INDICATOR
	SPA CLA			/CHECK IF FROM PANEL 4000
	7614			/DO LAS AND SKIP GET FROM PANEL WITH LAS
	TAD	20		/PSEUDO SWITCH
	JMP I	XC8SW		/EXIT WITH STATUS BIT IN AC.


/*********************************************************************

/C8TTYI
/THIS ROUTINE WILL LOOK FOR A INPUT FROM THE TERMINAL
/AND REMOVE ANY PARITY BITS, THEN MAKE IT 8 BIT ASCI.
/	C8TTYI=	JMS XC8TTY
/EX.	JMS	XC8TTYI		/READ CHAR FROM THE CONSOL DEVICE
	/			/RETURN TO CALL PLUS ONE AC CONTAINS THE CHAR


/CALLS USED -NONE- BUT C8CHAR IS OFF PAGE AND IN ROUTINE CALLED XC8ECHO

/
/
XC8TTY,	0
	KSF			/LOOK FOR KEYBOARD FLAG
	JMP	.-1
	KRB			/GET CHAR
	AND	(177		/MASK FOR 7 BITS
	TAD	(200		/ADD THE EIGTH BIT
	DCA	C8CHAR		/STORE IT
	TAD	C8CHAR
	JMP I	XC8TTY		/EXIT



/*********************************************************************

/C8PRNT

/THIS ROUTINE WILL TYPE THE CONTENTS OF THE C8 PRINT BUFFER. THE LOCATION
/OF THE BUFFER WILL BE IN THE ADDRS FOLLOWING THE CALL.   PRINTING OF THE BUFFER
/WILL STOP WHEN A 00 CHAR IS DETECTED. CHARACTERS ARE PACKED 2 PER WORD.

/	C8PRNT=	JMS XC8PNT


/EX.	JMS	XC8PNT			/C8PRNT THE CONTENTS OF THE FOLLOWING BUFFER
/	MESS77				/LOCATION OF C8PRNT BUFFER

/C8PRNT WILL USE THE LOCATION FOLLOWING THE CALL AS THE POINTER FOR THE
/C8PRNT ROUTINE.RETURN TO CALL PLUS TWO WITH AC= 0

/CALLS USED ARE-XC8TYPE-XC8PNT



XC8PNT,	0
	CLA CLL
	TAD I	XC8PNT		/GET C8PRNT BUFFERS STARTING LOCATION
	DCA	PTSTOR		/STORE IN PTSTOR
	ISZ	XC8PNT		/BUMP RETURN
C8DO1,	TAD I	PTSTOR		/GET DATA WORD
	AND	(7700		/MASK FOR LEFT BYTE
	SNA			/CHECK IF 00 TERMINATE
	JMP I	XC8PNT		/EXIT
	SMA			/IS AC MINUS
	CML			/MAKE CHAR A 300 AFTER ROTATE
	IAC			/MAKE CHAR A 200 AFTER ROTATE
	RTR
	RTR
	RTR			/PUT CHAR IN BITS 4-11 MAKE IT 8 BIT ASCII
	JMS	XC8TYPE		/C8PRNT IT ON CONSOLE
	TAD I	PTSTOR		/GET DATA WORD
	AND	(0077		/MASK FOR RIGHT BYTE
	SNA			/CHECK IF 00 TERMINATOR
	JMP I	XC8PNT		//EXIT
	TAD	(3740		/ADD FUDGE FACTOR TO DETERMINE IF 200
	SMA			/OR 300 IS TO BE ADD TO CHAR
	TAD	(100		/ADD 100
	TAD	(240		/ADD 200
	JMS	XC8TYPE		/C8TYPE ONLY BITS 4-11
	ISZ	PTSTOR		/BUMP POINTER FOR NEXT WORD
	JMP	C8DO1		/DO AGAIN
PTSTOR,	0			/STOR FOR C8PRNT BUFFER
/**************************************************************************


/C8PAUS
/THIS ROUTINE WILL CHECK IF THE CONSOL PACKAGE IS ACTIVE,IF ACTIVE
/IT WILL RETURN TO CALL PLUS ONE AC= 0. AND DO THAT INSTRUCTION.
/IF THE CONSOL PACKAGE IS NOT ACTIVE THE CALL WILL BE REPLACED
/WITH A 7402 HALT AND THEN RETURN TO THE HALT.

/	C8PAUS=	JMS XC8PAU
/
/
/EX.		JMS	XC8PAUS		/CHECK IF ON ACTIVE CONSOL IF NOT HALT HERE
/		ANYTHING		/RETURN HERE IF ON ACTIVE CONSOL
/
/

/CALLS USED ARE -CHKCLA-



XC8PAU,	0
	CLA CLL
	JMS	CHKCLA		/CHECK LOC 22 BIT 3 CONSOLE BIT
	JMP	C8DO3		/GO DO CONSOL PART RETURN CALL +1
	CMA			/DEACTIVE CONSOLE PACKAGE PUT HLT IN CALL
	TAD	XC8PAU		/GET CORRECT RETURN ADDRS
	DCA	XC8PAU		/SET UP RETURN
	TAD	(7402		/GET CODE FOR HLT
	DCA I	XC8PAU		/PUT HALT IN CALL LOCATION
C8DO3,	JMP I	XC8PAU		/GO TO HALT OR RETURN TO NEXT LOCATION


PAGE
/*********************************************************************
\f

/C8CNTR
/THIS ROUTINE WILL CHECK FOR THE PRESENCE OF CONTROL CHARACTERS
/IT WILL CHECK FOR THE FOLLOWING CHAR C-R-Q-L-S
/	C8CNTR=	JMS XC8CNT

/EX.	JMS	XC8CNTR			/CHECK FOR CONTROL CHARACTER
/	JMP	ANYTHING		/LOC FOLLOWING CALL IS FOR CONTINUING THE PROGRAM
/	JMP	ANYTHING		/LOC. IS FOR RETURN IF INMODE SET AND NOT CNTRL CHAR
/

/RETURN IS TO CALL PLUS ONE IF CONTINUE
/RETURN IS TO CALL PLUS TWO IF INMODE SET AND NOT CONTROL CHAR
/RETURN IS TO CALL PLUS TWO IF INMODE IS NOT SET AND NO
/CONTROL CHAR ..THIS WILL PRINT THE CHARACTER AND A ? 
/CLEAR THE AC AND RETURN CALL+2.

/CALLS USED ARE-CHKCLA-XC8TYPE-XC8CRLF-C8GET-UPAROW-XC8TYI-XC8PSW-
/
/
/
XC8CNT,	0
	DCA	ACSAVE		/SAVE THE AC
	JMS	CHKCLA		/CHECK LOC.22 BIT3 FOR CONSOLE BIT
	JMP	.+3		/ON ACTIVE CONSOLE
	TAD	ACSAVE		/DEACTIVE CONSOLEGET AC FOR RETURN
	JMP I	XC8CNT		/EXIT NOT ON ACTIVE CONSOLE
	GTF
	DCA	FLSAVE
	MQA
	DCA	MQSAVE		/SAVE THE MQ
	DCA	INDEXA		/SET DISPLACEMENT INTO TABLE B 
	TAD	XTABLA		/GET ADDRS OF TABLE A
	DCA	GETDAT		/CONTAINS POINTER TO CONTROL CHAR
REDOA,	TAD I	GETDAT		/GET CONTROL CHAR FROM TABLE
	SNA			/CHECK FOR A 0 END OF TABLE
	JMP	DONEA		/END OF TABLE NO CONTROL CHAR
	TAD	C8CHAR		/COMPARE CHAR TO CONTROL CHAR
	SNA CLA			/0 IF MATCH
	JMP	GOITA		/MATCH
	ISZ	INDEXA		/NO MATCH NOT END OF TABLE REDO
	ISZ	GETDAT		/BUMP INDEX FOR EXIT WHEN CONTROL FOUND
	JMP	REDOA		/BUMP GETDAT FOR COMPARE OF NEXT CNTRL CHAR.
DONEA,	TAD	INMODE		/CHECK IF PROGRAM EXPECTS CHAR
	SZA CLA			/1=CHAR EXPECTED  0= NO CHAR EXPECTED
	JMP	EXITA		/CHAR EXPECTED
	TAD	C8CHAR		/GET CHAR - NOT CONTROL + NOT EXPECTED
	JMS	XC8TYPE		/C8PRNT CHAR
	TAD	(277		/GET CODE FOR "?"
	JMS	XC8TYPE
	JMS	XC8CRLF
	ISZ	XC8CNT		/BUMP RETURN
	JMP I	XC8CNT		/EXIT CALL+2
EXITA,	ISZ	XC8CNT		/BUMP RETURN FOR MAIN PROGRAM CHECK OF CHAR
	TAD	C8CHAR		/PUT CHAR IN AC.
	JMP I	XC8CNT		/EXIT
GOITA,	TAD	C8CHAR		/GET THE CONTENTS OF CHAR
	TAD	(100		/ADD 100 TO FORM A GOOD ASCII CHARACTER
	DCA	C8CHAR		/RESTORE COFFECT CHAR
	TAD	XTABLB		/GET START OF TABLE B
	TAD	INDEXA		/GET NOW FAR INTO TABLE
	DCA	GOTOA		/STORE IT
	TAD I	GOTOA		/GET THE ROUTINE STARTTING ADDRESS
	DCA	GOTOA		/STORE IT IN HERE
	JMP I	GOTOA		/GOTO CONTROL CHAR ROUTINE
GOTOA,	0000			/ADD OF CNTRL ROUTINE TO EXECUTE
INDEXA,	0000			/DISPLACEMENT INTO CNTRL TABLE
GETDAT,	0000			/LOCATION OF ADDRS OF CONTROL CHAR.
XTABLA,	TABLA			/ADDRS OF TABLEA
XTABLB,	TABLB			/ADDRS OF TABLEB
TABLA,	7575			/CNTRL C BACK TO MONITOR 203
	7564			/CNTRL L SWITCH ERROR PRINTTING DEVICE 214
	7557			/CNTRL Q START DISPLAYING CHAR. AGAIN 221
	7556			/CNTRL R BACK TO BEGINNING OF PROGRAM 222
	7555			/CNTRL S STOP SENDING CHAR TO DISPLAY WAIT FOR CNTRL Q 223
	7573			/CNTRL E CONTINUE WITH PROGRAM 205
	7574			/CONTROL D CHANGE SWITCH REGISTER ON FLY
	0000

TABLB,	CNTRLC
	CNTRLL
	CNTRLQ
	CNTRLR
	CNTRLS
	CNTRLE
	CNTRLD
/
/CONTROL Q
/START SENDING CHAR. TO THE DISPLAY
/THIS WILL RETURN CONTROL TO CALL THAT WAS SET BY
/THE CALL FOR CONTROL S.
/
CNTRLQ,	DCA	INMODE		/SET SOFT FLAG FOR UNEXPECTED CHAR
	TAD	C8SETS		/CHECK IF CONTROL S TYPED IN
	SZA CLA
	JMP	BYRETR		/CONTROL S TYPED IN 
	JMS	C8GET		/NO CONTROL S TYPED PREVIOUSLY
	JMP I	XC8CNTR		/LEAVE VIA CNTR ENTRY ADDRESS
BYRETR,	DCA	C8SETS		/CLEAR THE SOFT FLAG
	JMS	C8GET		/RESTORE REGISTERS
	JMP I	C8RETR		/EXIT TO ADDRESS SET BY CONTROL S
/
/
/CONTROL R
/GO TO THE QUESTION C8SWIT
CNTRLR,	DCA	TTYLPT		/CLEAR THE TYPE FLAG SET TO TTY
	DCA	C8SETS		/CLEAR SOFT FLAG FOR CNTRL S
	DCA	INMODE
	JMS	UPAROW		/PRINT THE ^ AND C8CHAR
C8BY4,	DCA	C8SWST		/CLEAR FLAG FOR CNTRL D OR R
	JMP I	XDOSW		/GO TO ADDRS OF C8SWIT
XDOSW,	BGN			/DOSW IS LABEL FOR C8SWIT QUESTION
/
/
/CONTROL S
/STOP SENDING CHAR. TO DISPLAY UNTIL A ^Q IS RECEIVED
/
/
CNTRLS,	TAD	C8SETS		/IF1 DO NOT STORE IN C8RETR
	SZA CLA
	JMP	C8DO7		/DONT SET UP C8RETR
	IAC			/MAKE RETURN CALL PLUS 2
	TAD	XC8CNT		/GET RETURN FOR THIS CALL
	DCA	C8RETR		/STORE IT HERE FOR USE BE CNTROL Q
C8DO7,	ISZ	C8SETS		/SET FLAG TO SAVE CALL
	JMS	XC8TTYI			/LOOK FOR THE INPUT
	JMS	C8GET		/GET REGISTERS 
	JMS	XC8CNTR			/CHECK FOR THE CONTROL CHAR
	CLA
	JMP	CNTRLS		/IF NOT A CNTRL Q R C REASK
C8SETS,	0
C8RETR,	0
/
/SWITCH OUTPUT FROM ONE OUTPUT DEVICE TO ANOTHER - THE TWO OUTPUTS ARE THE
/CONSOLE AND THE PRINTER WITH DEVICE CDOE 66.
/
/
CNTRLL,	TAD	TTYLPT		/GET PRESENT C8SWIT INDICATOR
	CMA			/COMPLEMENT IT
	DCA	TTYLPT		/STOR NEW C8SWIT
	JMS	UPAROW		/C8PRNT ^ AND CHAR ON NEW DEVICE
	JMS	C8GET		/RESTORE THE REGISTERS
	JMP I	XC8CNT		/EXIT
/
/CONTROL E
/CONTINUE RUNNING FROM A INQUIRE OR ERROR
/
/
CNTRLE,	JMS	UPAROW		/PRINT THE CONTROL CHAR
	JMS	C8GET		/GET THE REGISTERS
	JMP I	XC8CNT		/RETURN TO CALL PLUS ONE
/

/CONTROL C
/RETURN TO MONITOR CONTROL C
CNTRLC,	DCA	TTYLPT		/CLEAR THE LPT FLAG TO PRINT ON DISPLAY
	JMS	UPAROW		/C8PRNT A^ AND LETTER IN CHAR
	CDF CIF			/GO TO 0 FLD
	CAF			/CLEAR THE WORLD
	JMP I	(7600		/GO TO DIAGNOSTIC MONITOR
/*********************************************************************
/
/
/
PAGE

/
	/CONTROL D
	/CHANGE THE SWITCH REGISTER ANYTIME CNTRL D AND RETURN TO
	/THE PROGRAM RUNNING.


CNTRLD,	JMS	UPAROW
\f	TAD	C8SETD		/CHECK IF THE RETURN ADDRS IS SAFE
	SZA CLA
	JMP	C8DO11		/DO NOT CHANGE THE RETURN ADDRS
	TAD	XC8CNT		/GET THE RETURN ADDRS AND SAVE IT
	DCA	C8RETD		/SAVE THE RETURN HERE
	ISZ	C8SETD		/INDICATE RETURN SAVED DONT DISTROY
C8DO11,	JMS	XC8PSW			/GO CHANGE THE SWITCH REGISTER
	DCA	C8SETD		/CLEAR THE FLAG
	JMS	C8GET		/RESTORE THE AC MQ LINK ETC
	JMP I	C8RETD		/RETURN TO THE PROGRAM
/
C8SETD,	0
C8RETD,	0



/THIS WILL TYPE A UP ARROW AND THE CHAR IN C8CHAR.

UPAROW,	0			/C8PRNT THE "^" AND THE CHAR C8TYPED IN
	TAD	(336		/CODE FOR ^
	JMS	XC8TYPE
	TAD	C8CHAR		/C8TYPE THE CHAR
	JMS	XC8TYPE
	JMS	XC8CRLF
	JMP I	UPAROW		/EXIT



/***********************************************************************

C8GET,	0
	CLA
	TAD	MQSAVE
	MQL			/RESTORE MQ
	TAD	FLSAVE
	RAL			/RESTORE THE LINK
	CLA
	TAD	ACSAVE		/RESTORE THE AC
	JMP I	C8GET		/GET THE REGISTERS



/********************************************************************

/C8INQU
/C8INQU ROUTINE WILL PRINT A WAITING
/AND THE PROGRAM IS EXPECTING A CONTROL CHAR INPUT
/IF CONTINUE FROM CONTROL CHAR RETURN IS CALL PLUS ONE
/IF NO CONTROL CHAR ENTERED THEN WAITING IS REPRINTED
/AND PROGRAM WAITS FOR A CONTROL CHAR AGAIN.

/	C8INQU =	JMS XC8INQ

/EX.	JMS	XC8INQ			/C8 WILL PRINT A WAITINGAND WAIT FOR INPUT
/	DO ANYTHING			/RETURN IS CALL PLUS ONE AC =0 CONTINUE

/CALLS USED ARE -CHKCLA-XC8PNT-XC8TYI-C8GET-XC8CNTR-


XC8INQ,	0
	CLA CLL
	JMS	CHKCLA		/CHECK LOC 22 BIT 3 CONSOLE BIT
	SKP			/ACTIVE CONSOLE PACKAGE
	JMP I	XC8INQ		/NOT CONSOLE LEAVE
	JMS	XC8PNT
	WATMES			/INQUIR WAITTING
	JMS	XC8TTYI		/GET CHARACTER
	JMS	C8GET
	JMS	XC8CNTR		/CHECK IF CONTROL CHARACTER
	JMP I	XC8INQ		/EXIT AND CONTINUE
	JMP	XC8INQ+1	/REASK
WATMES,	TEXT	"WAITING "


/*********************************************************************

/C8SWIT

/ROUTINE WILL CHECK IF CONSOL IS ACTIVE IF IT IS ACTIVE DISPLAY 
/SW QUESTION . IN NOT ACTIVE IT WILL NOT PRINT THE SW QUESTION BUT
/RETURN TO CALL PLUS ONE AC=0.
/C8SWIT WILL SET UP THE PSEUDO SWITCH
/REGISTER WITH THE NEW DATA ENTERED
/
/	C8SWIT =	JMS XC8PSW

/EX.		JMS	XC8PSW		/SET UP PSEUDO C8SWIT REGISTER IF
					/ON THE CONSOL PACKAGE. RETURN IS CALL PLUS ONE AC = 0

/CALLS USED ARE -CHKCLA-XC8PSW-XC8PNT-XC8OCTA-XC8TYPE-


XC8PSW,	0
	JMS	CHKCLA		/CHECK LOC 22 BIT 3 CONSOLE BIT
	SKP			/ACTIVE CONSOLE
	JMP I	XC8PSW		/DEACTIVE CONSOLE PACKAGE
				/RETURN WITHOUT ASKING PSEUDO SWITCH
	TAD	C8SWST		/IS THE SOFT FLAG SET FOR SWITCH?
	SZA CLA			/SKIP IF ONE ENTRY AT ATIME OK
	JMP	C8BY4		/SECOND ENTRY WITH OUT A EXIT GO TO SW QUESTION
	ISZ	C8SWST		/FIRST ENTRY SET FLAG
C8RDPS,	JMS	XC8PNT		/C8PRNT SR=
	MESA
	TAD	20		/GET CONTENTS OF SW
	JMS	XC8OCTA		/CONVERT IT TO ASCII
	TAD	(40		/GET SPACE
	JMS	XC8TYPE
	ISZ	INMODE		/SET FLAG FOR CHAR EXECTED
	JMS	XC8ECHO		/LOOK FOR INPUT
	JMS	TSTCHA		/NOT CONTROL TEST IT IS LEGAL
	TAD	C8CHAR		/STORE NEW CHAR IN SW REG
	DCA	20

	TAD	(-3		/GET A MINUS 3
	DCA	TMPCNT		/STORE IN TEMP COUNT
GETCH1,	JMS	XC8ECHO		/GET NEXT CHAR
	JMS	TSTCHA		/CHECK IF CR + GOOD CHAR
	TAD	20		/GET C8SWIT REGISTER
	RTL CLL			/ROTATE IT LEFT 3 PLACES
	RAL
	TAD	C8CHAR		/GET CHAR + ADD IT TO PREVIOUS CONTENTS
	DCA	20		/SAVE NEW CONTENTS
	ISZ	TMPCNT		/BUMP COUNT
	JMP	GETCH1		/JMP BACK + GET NEXT CHAR
	JMP	ENDIT		/END 4 CHAR C8TYPED IN
TSTCHA,	0
	CIA			/CMPL CHAR IN AC
	TAD	(215		/TEST IF IT IS A CARRIAGE RETURN
	SNA CLA			/SKIP IN NOT CR.
	JMP	ENDIT		/WAS CARRIAGE RETURN
	TAD	C8CHAR		/NOT CR. GET CHAR
	TAD	(-260		/CHECK IF IT IS IN RANGE
	SPA CLA			/IF NOT POSITIVE C8ERR CHAR SMALLER THEN 260
	JMP	ERR1		/C8ERR - CHAR TOO SMALL
	TAD	C8CHAR		/GET CHAR
	TAD	(-270		/GET A -270 + CHECK IF IT IS LARGER THEN 7
	SMA CLA			/SKIP IF LESS THEN 7
	JMP	ERR1		/C8ERR ON CHAR NOT IN RANGE
	TAD	C8CHAR		/GET CHAR
	AND	(7		/MASK FOR RIGHT BYTE
	DCA	C8CHAR		/STORE IN CHAR
				/GET CHAR IN AC
	JMP I	TSTCHA		/EXIT
ERR1,	TAD	(277		/C8PRNT
	JMS	XC8TYPE		/?
	JMS	XC8CRLF		/
	JMP	C8RDPS		/EXIT + ASK AGAIN
ENDIT,	JMS	XC8CRLF		/DO A CR LF
	DCA	C8SWST		/CLEAR THE PSW ENTRY FLAG
	JMP I	XC8PSW		/EXIT ROUTINE
C8SWST,	0

TMPCNT,	0
MESA,	TEXT	"SR= "


PAGE

/C8OCTA

/OCTAL TO ASCII CONVERSION
/THIS ROUTINE WILL TAKE THE OCTAL NUMBER IN THE AC AND CONVERT IT TO ASCII
/THE RESULT WILL BE PRINTED ON THE CONSOL TERMINAL
/	C8OCTA=	JMS XC8OCT
/
/EX.	JMS	XC8OCTA		/AC CONTAINS NUMBER TO BE CHANGE
/	RETURN IS TO CALL PLUS ONE AC=0
/
/CALLS USED ARE -XC8TYPE-


XC8OCT,	0
	CLL RTL
	RTL			/POSITION THE FIRST CHAR FOR PRINTING
	DCA	C8TMP1		/SAVE CORRECT POSITIONED WORD HERE
	TAD	(-4
	DCA	C8CKP		/STORE COUNTER IN HERE
C8DO4,	TAD	C8TMP1		/GET FIRST NUMBER
	AND	(0007		/MASK
	TAD	(260		/ADD THE PRINT CONSTANT
	JMS	XC8TYPE		/TYPE THE NUMBER
	TAD	C8TMP1		/
	RTL
	RAL			/PUT NEXT NUMBER IN POSITION
	DCA	C8TMP1		/STORE IT
	ISZ	C8CKP		/DONE YET WITH FOUR NUMBERS
	JMP	C8DO4		/NOT YET DO MORE
	JMP I	XC8OCT		/DONE WITH FOUR 
	C8TMP1,	0
	C8CKP,	0


/*********************************************************************

/C8CRLF
/C8TYPE CR AND LF WITH FILLERS FOLLOWING EACH LF AND CR
\f/
/	C8CRLF=	JMS XC8CRL
/
/EX.	JMS	XC8CRLF		/C8PRNT A CR AND LF WITH FILL
/				/RETURN TO CALL PLUS ONE AC =0
/CALLS USED ARE -XC8TYPE-


XC8CRLF,0
	CLA CLL
	TAD	(215		/GET CODE FOR CR
	JMS	XC8TYPE
	TAD	FILLER
	CMA
	DCA	FILCNT		/STORE FILLER IN HERE
	TAD	(212		/GET CODE FOR LF
C8DO2,	JMS	XC8TYPE
	ISZ	FILCNT		/CHECK ON FILLER CHAR
	JMP	C8DO2		/TYPE A NON PRINTING CHAR
	JMP I	XC8CRL		/EXIT
FILLER,	0004			/FILLER SET FOR 4 CHAR
FILCNT,	0			/COUNTER FOR FILL



//*************************************************************
/C8CKPA
/THIS ROUTINE WILL CHECK IF A CHARACTER WAS ENTERED FROM THE
/TERMINAL. IFTHE FLAG IS SET AND THE CONSOLE PACKAGE IS
/ACTIVE A CHECK IS MADE TO DETERMIND IF IT IS A CONTROL CHAR.
/IF IT WAS A CONTROL CHAR THEN ITS CONTROL FUNCTION IS PERFORMED.
/IF NOT A CONTROL CHARACTER OR A CONTROL E-D-L-O- IT WILL DO
/THE CONTROL FUNCTION AND RETURN TO CALL PLUS 2.
/A NON CONTROL CHARACTER WILL BE PRINTEDAND A "?" IT WILL RETURN TO
/CALL PLUS 2.
/IF NO FLAG IS SET OR THE CONSOL IS NOT ACTIVE THE RETURN IS TO
/CALL PLUS 1.


/	C8CKPA=	JMS	XC8CKP


/EX.	JMS	XC8CKPA			/CALL TO CHECK IF CONTROL CHAR SET
/	ANYTHING(SKIP)		/RETURN IF NOT FLAG OR NOT CONSOLE ACTIVE
/	ANYTHING(JMP EXIT SKIP CHAIN)	/RETURN IF NOT CONTROL OR CONTINUE CONTROL


/CALLS USED ARE -XC8TTYI-XC8CNTR-C8GET-


XC8CKP,	0
	DCA	ACSAVE		/SAVE THE AC
	GTF			/SAVE THE FLAGS
	DCA	FLSAVE		/SAVE THE FLAGS
	MQA			/PUT MQ IN AC
	DCA	MQSAVE		/SACE THE MQ
	KSF			/CHECK THE KEYBOARD FLAG
	JMP	C8BY3		/EXIT TO CALL PLUS 1
	JMS	CHKCLA		/CHECK LOC 22 BIT 3 CONSOLE BIT
	SKP			/ACTIVE CONSOLE PACKAGE
	JMP	C8BY3		/EXIT TO CALL PLUS 1
	JMS	XC8TTYI		/GET THE CHAR
	JMS	C8GET		/GET THE FLAGS
	JMS	XC8CNTR		/CHECK IF CONTROL  CHAR.
	NOP			/RETURN IF A CONTINUE CHAR.
	ISZ	XC8CKP		/BUMP RETURN FOR CALL PLUS 2
C8BY3,	JMS	C8GET		/GET REGISTERS
	JMP I	XC8CKP		/SAY GOOD BY

//*********************************************************************

/C8ECHO
/THIS ROUTINE WILL LOOK FOR A CHAR FROM THE KEYBOARD.  STORE IT IN LOCATION CHAR
/CHECK IF IT WAS A CONTROL CHARACTER - SET INMODE - PRINT CHARACTER

/	C8ECHO =	JMS XC8ECH
/EX.	JMS	XC8ECHO		/LOOK FOR CONSOL CHAR C8PRNT IT
				/RETURN CALL PLUS ONE AC = CHAR C8TYPED IN

/CALLS USED ARE -XC8TTYI-XC8CNTR-C8GET-XC8ECH-XC8TTYPE

/
XC8ECH,	0
	JMS	XC8TTYI		/WAIT FOR CHAR FROM KEYBOARD
	JMS	C8GET		/RESTORE THE REGISTERS
	ISZ	INMODE		/SET INMODE IDENTIFING THIS AS A EXPECTED CHAR
	JMS	XC8CNTR		/GO CHECK IF IT IS A CONTROL CHAR
	JMP I	XC8ECH		/WAS A CONTROL CHAR - CONTINUE RUNNING
	JMS	XC8TYPE		/NOT A CONTROL CHAR C8PRNT IT
	DCA	INMODE		/CLEAR FLAG THAT CHAR EXPECTED
	TAD	C8CHAR		/GET CHAR IN AC
	JMP I	XC8ECH		/EXIT
C8CHAR,	0
INMODE,	0

/*********************************************************************

/C8TYPE
/THIS ROUTINE WILL C8PRNT ON THE CONSOLE OR THE LPT WITH DEVICE CODE 66.
/
/	C8TYPE=	JMS XC8TYP

/EX.	JMS	XC8TYPE		/C8PRNT THE CHAR IN THE AC.
	/			/RETURN CALL PLUS ONE AC =0000
				/DO NOT CLEAR THE LINK IN THIS ROUTINE NEEDED BYC8OCT

/CALLS USED ARE -C8HANG-XC8CNTR-XC8PNT-XC8CRLF-XC8INQU-


XC8TYP,	0
	DCA	PNTBUF		/STORE CHAR
	TAD	TTYLPT		/CHECK O=TTY 7777=LPT
	SZA CLA
	JMP	XDOLPT		/DO OUT PUT ON LPT
	TAD	PNTBUF
	TLS
	TSF
	JMP	.-1
	TCF
	JMP	C8BY5
XDOLPT,	TAD	PNTBUF		/GET CHAR
	PSTB	PCLF		/C8PRNT IT
	JMS	C8HANG		/CHECK KEYBOARD IF HUNG
	PCLF			/CLEAR THE FLAG
C8BY5,	7600			/CLEAR THE AC
	JMP I	XC8TYP		/EXIT
PNTBUF,	0
TTYLPT,	0


C8HANG,	0
	CLA		/
	TAD	C8BY5		/GET CONSTANT 7600
	DCA	PNTBUF		/PNTBUF IS NOW A COUNTER 
	PSKF			/SKIP ON PRINTER DONE
	SKP			/NOT DONE YET
	JMP I	C8HANG		/SAW FLAG DONE 
	ISZ	C8CONT		/FIRST COUNTER FAST ONE
	JMP	.-4		/CHECK IF FLAG SET YET
	ISZ	PNTBUF		/MADE 4096 COUNTS ON FAST COUNTER
	JMP	.-3		/KEEP IT UP FOR 5 SEC 
	TAD	XC8CNTR		/GET THE RETURN ADDRESS IN CONTROL
	DCA	C8HANG		/SAVE IT IN HANG
	DCA	TTYLPT		/ALLOW PRINTING ON TTY
	JMS	XC8PNT
	MESHANG			/LPT ERROR
	JMS	XC8CRLF
	JMS	XC8INQU		/PRINT WAITING 
	JMP I	C8HANG		/CONTINUE TO SAVE ADDRESS
C8CONT,	0			/COUNTER FOR TIMER
MESHANG,TEXT	"LPT ERROR"

PAGE
/*********************************************************************
/*******************************************************************

/THIS ROUTINE WILL CHECK LOCATION 22 THE HARD WARE CONFIG WORD.
/TO SEE IF THE CONSOLE BIT 3 )400) IS SET IF SET THEN RETURN
/TO CALL PLUS TWO FO A ACTIVE CONSOLR PACKAGE AC=0
/IF NOT SET THEN TO CALL PLUS ONE FOR A DEACTIVE CONSOLE PACKAGE.


CHKCLA,	0
	CLA
	TAD	22		/GET THE COTENTA OF LOCATION 22
	AND	(400		/MASK FOR BIT 3 (400
	SNA CLA			/
	ISZ	CHKCLA		/ACTIVE CONSOLE PACKAGE RETURN
				/CALL PLUS ONE (1) FOR ACTIVE
	JMP I	CHKCLA		/DEACTIVE CONSOLE PACKAGE RETURN
				/CALL PLUS TWO (2)

/C8ERR
/THIS ROUTINE WILL DETERMINE WHAT TO DO WHEN A C8ERR IS ENCOUNTERED
/WILL CHECK IF CLASSIC SYSTEM, WILL CHECK C8SWIT REGISTERS.
/	C8ERR=	JMS XC8ERR
/EX.	JMS	XC8ERR		/GO TO C8ERR CALL IF NOT CONSOL 
/				/RETURN IS CALL PLUS ONE AC =0000

/CALLS USED ARE -CHKCLA-XC8CRLF-XC8SW-XC8INQU-XC8PNT-XC8OCTA-


XC8ERR,	0
	IOF
	DCA	ACSAVE		/SAVE AC
	GTF
	DCA	FLSAVE		/SAVE THE FLAGS
\f        MQA
        DCA     MQSAVE          /SAVE THE MQ
        CLA CLL CMA             /SUBTRACT A 1 FOR TRUE LOCATION
        TAD     XC8ERR          /GET RETTURN LOCATION
        DCA     PCSAVE          /SAVE ADD OF C8ERR CALL
        JMS     CHKCLA          /CHECK LOC.22 BIT 3 CONSOL BIT
        SKP                     /ACTIVE CONSOLE PACKAGE
        JMP     NTCLAS          /NOT CLASSIC SYSTEM
        JMS     C8GET           /GET THE REGISTERS.
        JMS     XC8SW           /CHECK SWITCH REG FOR BIT THAT INDICATES
                                /NO ERROR MESSAGE
SETUP1, AND     (0000           /MASK FOR BIT FOR NO ERROR PRINTING
                                /IF THIS ERROR MESSAGE IS TO ALWAYS
                                /BE PRINTED LEAVE AND VALUE AT 0000
        SZA CLA                 /SKIP IF BIT IS 0 PRINT ERROR MESSAGE
        JMP     C8DO10          /DO NOT PRINT
        JMS     XC8CRLF
        JMS     XC8PNT
        ERRMES                  /PRINT THE ERROR MESSAGE
        JMS     XC8PNT
        MESPC                   /PRINT THE PC STSTEMENT
        TAD     PCSAVE
        JMS     XC8OCTA         /CONVERT 4 DIGIT PC TO ASCII
        JMS     XC8PNT
        MESAC                   /PRINT THE AC MESS
        TAD     ACSAVE
        JMS     XC8OCTA
        JMS     XC8PNT
        MESMQ                   /PRINT MQ
        TAD     MQSAVE
        JMS     XC8OCTA
        JMS     XC8PNT
        MESFL                   /PRINT FL
        TAD     FLSAVE
        JMS     XC8OCTA
        JMS     XC8CRLF
C8DO10, JMS     C8GET           /GET THE REGISTERS.
        JMS     XC8SW           /CHECK SWITCH REGISTER
        SKP CLA                 /SKIP IF BIT 0 SET
        JMP     C8BY2           /LEAVE
        JMS     XC8INQ          /GO TO THE INQUIRE ROUTINE
        JMP     C8BY2           /LEAVE
NTCLAS, JMS     C8GET           /GET THE REGISTERS.
        JMS     XC8SW           /CHECK PSEUDO SWITCH REGISTER
                                /CHECK THE C8SWIT REGISTER
        SKP CLA                 /SKIP IF HALT
        JMP I   XC8ERR          /NO HALT CONTINUE
        TAD     (7402           /CODE FOR HLT
        DCA I   PCSAVE          /PUT IT IN CALL LOC.
        JMS     C8GET
        JMP I   PCSAVE          /EXIT  TO CALL AND HALT
C8BY2,  JMS     C8GET           /GET THE REGISTERS
        JMP I   XC8ERR
ERRMES, TEXT    "DHRKDD  FAILED "
MESPC,  TEXT    "  PC:"
MESAC,  TEXT    "  AC:"
MESMQ,  TEXT    "  MQ:"
MESFL,  TEXT    "  FL:"
PCSAVE, 7777
ACSAVE, 7777
MQSAVE, 7777
FLSAVE, 7777

        $$$
/#8
/#8