Add README.md

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape1 / EPIC.PA

/EPIC PROGRAM, V5A
/
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1973, 1975, 1977
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
\f/EPIC PROGRAM 
/COPYRIGHT 1973,1977
/DIGITAL EQUIPMENT CORP.
/MAYNARD, MASS.01754
	 
	PTAPE=1
	*0
VERS,	10
	*10
NDX0,	0
NDX1,	0
NDX2,	0
	*20
BCC1,	0
BCC2,	0
BLKLEN,	13
BUFFLD,	10
BUFPTR,	0
BYTCNT,	0
	CLOC=BYTCNT
CHKC,	CTRLC
CRLF,	TYCRLF
DATBUF,	HDATA
DOCRC,	CRC
EBLKHI,	0
EFLG,	-1
EOTFLG,	0
EQBLK,	0
ERCODE,	0
	EOLWD=ERCODE
FLEN,	0
FNPTR,	0
FRMPTR,	0
	MODF=FRMPTR
GETCD,	DECOD
HANADR,	0
IDOFLG,	0
	MODB=IDOFLG
IMPFLG,	0
INCHR,	0
INPTR,	0
IOERR,	PHYSIO
LPWT,	LPWAIT
LSPFLG,	0
MAXCNT,	0
MAXLEN,	-MXPBLK
MIFLG,	0
M4,	-4
NAME,	0
OCNT,	0
OUDEV,	0;0;0
OUTCHR,	0
OUTPTR,	0
PARCHR,	0
	MSKWD=PARCHR
PARPTR,	PARADR
PATFLG,	0
P17,	17
P200,	200
RDCHR,	0
	SRWD=RDCHR
RDPBLK,	PREAD
RDSWIT,	SWITCH
RELBLK,	HDATA+5
RBLK,	0
SATOL,	0
SBLK,	0
SLPTR,	0
SMTOX,	0
SYTO9,	0
TMP0,	0
TMP1,	0
TMP2,	0
TMP3,	0
TMP4,	0
TNAME,	TYPNAM
TYDEV,	TYPDEV
TYPTXT,	TTOTXT
USR,	DOUSR
USRDEV,	0
WRCHR,	0
	 
	PAGE
\f	 
START,	NOP
	CIF 10		/START OF PROG
	JMS I (7700
	USRIN
	TAD MAXLEN
	DCA MAXCNT
	TLS
	PLS
	RFC
DECOD,	TAD (-PTAP
	TAD MODE
	SZA CLA
	JMP .+4
	TAD LSPFLG
	SZA CLA
	JMS I LPWT
	JMS I CRLF
	TSF
	JMP .-1
	CIF 10
	JMS I P200
	DECODE
	0
	TLS		/INIT. TTY
	JMS I (SETDV
	JMS I (CHKMI
	CDF	10
	TAD I	(MTOX
	CDF	0
	CLL RTR
	RAR
	SNL
	JMP	NOVERS
	JMS I	CRLF
	JMS I	TYPTXT	/IF /V,TYPE VERSION NUMBER
	VERSON
	JMS I	CRLF
NOVERS,	TAD (FNAME
	DCA NAME
	TAD (7600	/GET NAME
	DCA NDX0
	TAD NAME
	DCA TMP2
	TAD DATBUF
	DCA TMP3
	TAD VERS
	DCA I TMP3
	ISZ TMP3
	TAD M4
	DCA TMP0
	CDF 10
	TAD I (YTO9
	RAL		/CHK /Z
	SMA CLA
	JMP .+3
	DCA EQBLK
	DCA EBLKHI
	TAD I (ATOL
	AND (20		/H ?
	SZA CLA
	FOURK		/YES
	DCA TMP1
	CLA CLL CMA RAR	/=3777
	AND I (7642	/HI EQUALS N
	TAD TMP1
	SZA
	DCA EBLKHI
	TAD I (7642
	DCA TMP1
	TAD I (7646
	SZA
	DCA EQBLK	/=N LO ORD
	TAD I (ATOL
	DCA SATOL
	TAD I (YTO9
	DCA SYTO9
	TAD I (MTOX
	DCA SMTOX
	JMS I (DODFN
	TAD TMP1
	SMA CLA
	JMP GOTMOD
	TAD (MODTBL-1	/GET NEW MODE
	DCA TMP1
	TAD SYTO9
	RAL CLL CML
	RAL
	ISZ TMP1
	SMA		/FOUND IT ?
	JMP .-3
	CLA
	TAD I TMP1
	DCA MODE
	JMS I CRLF
GOTMOD,	JMP I MODE
MODTBL,	PTAP
	FED
	COMPAR
	IFNZRO PTAPE	<
	DECOD
	>
	DECOD
	DECOD
	DECOD
	DECOD
	DECOD
	DECOD
MODE,	DECOD
	 
VERSON,	TEXT	"V 5A "
	0
	PAGE
\f	 
DODFN,	0
	TAD I (7601
	SZA CLA
	JMP LOP0
	TAD SYTO9
	SPA CLA
	JMP LOP0
	ISZ TMP2
	ISZ TMP3
	ISZ TMP0
	JMP .-3
	CDF
	JMP I DODFN
LOP0,	CDF 10
	TAD I NDX0
	CDF
	DCA I TMP2
	TAD I TMP2
	DCA I TMP3
	ISZ TMP2
	ISZ TMP3
	ISZ TMP0
	JMP LOP0
	JMP I DODFN
	 
HSPRDR,	0
	JMS IOWAIT
	RSF
	RRB
	DCA INCHR
	RFC
	TAD INCHR
	JMP I HSPRDR
	 
HSPPCH,	0
	DCA OUTCHR
	JMS IOWAIT
	PSF
	TAD OUTCHR
	PLS
	CLA
	JMP I HSPPCH
	 
LSPRDR,	0
	JMS IOWAIT
	KSF
	KRB
	DCA INCHR
	TAD INCHR
	JMP I LSPRDR
	 
LSPPCH,	0
	DCA OUTCHR
	JMS IOWAIT
	TSF
	TAD OUTCHR
	TLS
	CLA
	JMP I LSPPCH
	 
IOWAIT,	0
	TAD I IOWAIT
	DCA IOTSKP
	ISZ IOWAIT
	TAD IOTSKP
	RTL
	RAL
	AND (700
	TAD VERS
IOTSKP,	0
	JMP .-1
	CLA
	JMP I IOWAIT
	 
CTRLC,	0
	KSF
	JMP I CTRLC
	TAD	[200		/FORCE BIT 8 ON
	KRS
	TAD (-203
	SZA CLA
	JMP I CTRLC
	KCC
CTRLC0,	JMS I CRLF
	TAD (336
	JMS I (LSPPCH
	TAD (303
	JMS I (LSPPCH
	JMS I CRLF
	TSF
	JMP .-1
	JMP I .+1
	7605
	 
	PAGE
\f	 
/HERE FOR SYS:<PTP
	 
PTIN,	TAD LSPFLG
	SNA CLA
	JMP .+4
	IAC
	DCA I (OUTTBL
	TAD (LSPRDR-HSPRDR
	TAD (HSPRDR
	DCA RDCHR
	TAD I (OUTTBL
	DCA USRDEV
	RFC
	JMS I RDPBLK	/GET 1ST PBLK
	JMS RDERR
	TAD DATBUF	/GET NAME
	DCA NDX0
	TAD NAME
	DCA TMP1
	TAD M4
	DCA TMP0
	TAD I NDX0
	DCA I TMP1
	ISZ TMP1
	ISZ TMP0
	JMP .-4
	ISZ NDX0	/BY RELBLK
	TAD I NDX0
	DCA BLKW	/FILE LEN
	TAD PATFLG
	SZA CLA		/RDING A PATCH?
	TAD (LOOKUP-ENTER
	TAD (ENTER	/ENTER=NO PATCH
	JMS I USR
	CLL
	TAD FLEN
	TAD BLKW
	SNA		/DOES IT FIT?
	JMP	.+3
	SZL	CLA
	JMP NOFIT
	TAD BLKW
	DCA FLEN
	DCA RBLK
	TAD FLEN
	CIA
	DCA FCNT
	JMS I (ICHKB	/SEE IF WE GOT
			/THE RIGHT BLK
LOP3,	TAD SBLK	/ABS STR BLK
	TAD I RELBLK
	DCA BLKW	/=BLK TO DO
	JMS I HANADR
	4200		/WRITE 1 BLK
	BUFADR
BLKW,	0
	JMP I IOERR
	ISZ RBLK
	ISZ FCNT
	JMP BY3
	TAD (CLOSE
	JMS I USR
	JMP I GETCD
BY3,	JMS I RDPBLK
	SKP
	JMP LOP3
	MTHREE
	TAD ERCODE	/EOT IS ONLY
			/LEGAL ERROR
	SNA CLA
	JMP IFEOT
	JMS RDERR	/RETRY
	JMP LOP3-1
IFEOT,	TAD PATFLG
	SZA CLA
	JMP I GETCD	/PATCH MODE
			/TERMS ON EOT
	JMS I TYPTXT
	EOTMSG
	JMS I TYPTXT
	NTMSG
	JMS I CRLF
	CLA CMA
	JMS I LPWT
	JMS I RDPBLK
	JMS RDERR
	JMP LOP3-1
	 
\f	 
RDERR,	0
	MTWO
	DCA ERCNT
LOP4,	TAD ERCODE
	TAD (AMSG
	DCA TMP0
	TAD I TMP0
	DCA .+2
	JMS I TYPTXT
	0
	JMS I CRLF
	CLA CMA
	JMS I LPWT
	JMS I RDCHR
	CLA
	JMS I RDPBLK
	SKP
	JMP I RDERR
	ISZ ERCNT
	JMP LOP4
	JMP I IOERR
ERCNT,	0
FCNT,	0
	 
NOFIT,	TAD (16
	JMS I TYDEV
	TAD NAME
	JMS I TNAME
	JMS I TYPTXT
	BIGMSG
	TAD USRDEV
	JMS I TYDEV
	JMP I GETCD
	 
	PAGE
\f	 
PTAP,	JMS I RDSWIT
	PSTBL
	TAD I NAME
	SNA CLA
	JMP I (PTIN	/PTAP INPUT
	TAD I (OUTTBL
	DCA USRDEV
	TAD LSPFLG
	SNA CLA
	TAD (HSPPCH-LSPPCH
	TAD (LSPPCH
	DCA WRCHR
	PLS
	TAD (LOOKUP
	JMS I USR
	TAD PATFLG
	SNA CLA		/PUNCH PATCH ?
	JMP NOPAT
	CLL
	TAD EQBLK	/CHK FOR =N
	TAD FLEN	/OUT OF RANGE
	SNL CLA		/?
	JMP .+4
	JMS I TYPTXT
	BEQMSG
	JMP I GETCD
	TAD EQBLK
NOPAT,	DCA TMP0
	TAD TMP0
	TAD SBLK
	DCA BLKR	/1ST BLK TO PCH
	TAD TMP0	/PUT REL BLK
	DCA I TMP3	/IN HDR
	TAD FLEN
	CIA		/=FILE LEN
	ISZ TMP3
	DCA I TMP3
	ISZ TMP3
	DCA I TMP3	/0 TO LST HDR
			/WORD
	TAD PATFLG	/ONLY 1 BLK
	SZA		/PATCHES AT A
	DCA FLEN	/TIME
	TAD LSPFLG
	SNA CLA
	JMP .+3
LOP2,	CLA CMA
	JMS I LPWT	/ON PUNCH
	TAD MAXLEN
	CIA
	TAD MAXCNT
	SZA CLA		/PCH L/T ?
	JMP .+3		/NO
	JMS WLT
	JMS WLT
LOP1,	JMS I HANADR	/READ 1 BLK
	200		/OF FILE
	BUFADR
BLKR,	0
	JMP I IOERR
	ISZ BLKR
	JMS I (PWRITE
	ISZ I RELBLK
	ISZ FLEN
	JMP BYDUN
	TAD EOTFLG
	SNA CLA		/PCH EOT ?
	JMS EOT		/YES
	JMP I GETCD
BYDUN,	ISZ MAXCNT
	JMP LOP1
	JMS EOT		/PHYSICAL END
			/OF PTP
	TAD LSPFLG
	SZA CLA
	JMS I LPWT
	JMS I TYPTXT
	EOTMSG
	JMS I CRLF
	JMP LOP2	/NEXT PTP
	 
\f	 
WLT,	0
	TAD LTCNT
	DCA TMP0
	TAD P200
	JMS I WRCHR
	JMS I CHKC
	ISZ TMP0
	JMP .-4
	JMP I WLT
LTCNT,	-LTLEN
	 
EOT,	0
	TAD (377
	JMS I WRCHR
	JMS WLT
	JMS WLT
	JMS WLT
	TAD MAXLEN
	DCA MAXCNT
	JMP I EOT
	 
	PAGE
\f	 
PREAD,	0		/READ A PTP BLK
	JMS I RDCHR
	SNA
	JMP PREAD+1	/ITS L/T
	TAD (-200
	SNA
	JMP PREAD+1	/L/T
	RAR CLL		/201 PCH MUST
	SNA CLA		/SEPARATE L/T
			/AND DATA
	JMP ONBLK
	TAD (-377	/ONLY OTHER
	TAD INCHR	/POSSIBILTY IS
	SNA CLA		/END OF PTP
	IAC		/EOT CODE
	IAC		/L/T ERR
BYTERR,	IAC
BLKERR,	DCA ERCODE
	JMP I PREAD	/P+1=ERR RTN
ONBLK,	JMS I (ISETB
	DCA PARFLG
	JMS GETBYT
	ISZ BYTCNT
	JMP .-2
	JMS I RDCHR
	CIA
	TAD BCC1
	SZA CLA
	JMP BLKERR
	JMS I RDCHR
	CIA
	TAD BCC2
	SZA CLA
	JMP BLKERR
	TAD PARFLG
	SPA CLA
	JMP BYTERR
	ISZ PREAD	/GOOD BLK
	JMP BLKERR+1
	 
\f	 
GETBYT,	0
	TAD LSPFLG
	SNA CLA
	JMS I CHKC
	DCA PARCHR
	TAD M4
	DCA CNTR0
LOP6,	MTHREE
	DCA CNTR1
LOP5,	JMS I RDCHR
	DCA I FRMPTR
	ISZ FRMPTR
	TAD INCHR
	JMS I DOCRC
	ISZ CNTR1
	JMP LOP5
	MTHREE
	TAD FRMPTR
	DCA FRMPTR
	JMS PACK
	ISZ CNTR0
	JMP LOP6
	JMS I RDCHR
	JMS I DOCRC
	TAD INCHR
	CIA
	TAD PARCHR
	SNA CLA
	JMP NOPAR
	CLA CMA
	DCA PARFLG
	TAD ABORT
	SPA CLA
	JMP BYTERR
	FOURK
NOPAR,	TAD INCHR
	DCA I PARPTR
	ISZ PARPTR
	JMP I GETBYT
	 
\f	 
/HERE TO PACK 3 8 BIT FRAMES INTO
/2 12 BIT WORDS
	 
PACK,	0
	TAD I FRMPTR
	RTL CLL
	RAL		/1ST FRM TO
	DCA I BUFPTR	/B1-B8
	ISZ FRMPTR
	TAD I FRMPTR	/PUT HI HALF OF
	RTR CLL		/2ND FRM INTO
	RTR		/B9-B11 AND LNK
	RAR
	DCA HOLDW2
	TAD HOLDW2	/PUT 1ST FRM IN
	AND (7		/B0-B7,AND PUT
	TAD I BUFPTR	/HI HALF OF 2ND
	RAL		/IN B8-B11
	DCA I BUFPTR	/YOU AINT SEEN
	TAD I BUFPTR	/NOTHING YET.
	JMS I (DOPAR
	TAD HOLDW2	/LO HAF OF 2ND
	AND (7400	/FRM IS IN
	ISZ FRMPTR	/B0-B3. PUT
	TAD I FRMPTR	/WITH 3RD FRM
	ISZ BUFPTR
	DCA I BUFPTR
	TAD I BUFPTR
	JMS I (DOPAR
	ISZ FRMPTR
	ISZ BUFPTR
	JMP I PACK
PARFLG,	0
CNTR0,	0
CNTR1,	0
ABORT,	-1
HOLDW2,	0
	 
	PAGE
\f	 
PWRITE,	0		/HERE TO WRITE
			/1 BLK OF PTP
	JMS ISETB
	JMS I (WLT
	TAD (201	/START OF DATA
			/BLK CHAR
	JMS I WRCHR
	JMS PUTBYT
	ISZ BYTCNT
	JMP .-2
	TAD BCC1
	JMS I WRCHR
	TAD BCC2
	JMS I WRCHR
	JMP I PWRITE
	 
ISETB,	0
	TAD (FRMADR
	DCA FRMPTR
	TAD (PARADR
	DCA PARPTR
	TAD DATBUF
	DCA BUFPTR
	DCA BCC1
	DCA BCC2
	TAD (-NBYTS
	DCA BYTCNT
	JMP I ISETB
	 
LPWAIT,	0
	HLT
	RFC
	CLA
	JMP I LPWAIT
	 
\f	 
PUTBYT,	0
	DCA PARCHR
	TAD M4
	DCA CNTR2
LOP7,	TAD I BUFPTR
	JMS DOPAR
	TAD I BUFPTR	/PUT 2 WORDS IN
	RTR CLL		/3 8 BIT FRMS
	RTR
	DCA F2
	TAD F2		/B0-B7 OF 1ST
	AND (377	/FOR FRM 1
	DCA F1
	TAD F2		/LO 4 BITS OF
	RAR		/WORD 1
	AND (7400	/TO B0-B3 OF
	DCA F2		/FRM 2
	TAD F1
	JMS I WRCHR
	TAD F1
	JMS I DOCRC
	ISZ BUFPTR
	TAD I BUFPTR
	JMS DOPAR
	TAD I BUFPTR	/PUT B0-B3
	AND (7400	/OF WD2
	RTR CLL		/INTO B4-B8
	RTR
	TAD F2		/NOW PUT LO 4
	RTR		/BITS OF WD1
	RTR		/(B0-B3) AND HI
			/4 BITS OF W2
			/INTO B4-B11
	JMS I WRCHR
	TAD OUTCHR	/=CHR JST PCHED
	JMS I DOCRC
	TAD I BUFPTR
	AND (377	/LO 8 OF 2ND
	JMS I WRCHR
	TAD OUTCHR	/=F3
	JMS I DOCRC
	ISZ BUFPTR
	ISZ CNTR2
	JMP LOP7
	TAD PARCHR
	JMS I WRCHR
	TAD PARCHR
	JMS I DOCRC
	JMS I CHKC
	JMP I PUTBYT
CNTR2,	0
F2,	0
F1,	0
	 
	 
\f	 
/HERE TO COMPUTE PARITY (EVEN ODD)
/12 BIT WORD IS IN AC.
/AFTER EACH (SPA,CML,RAR) SEQUENCE
/AC B0=0 IF THE
/NUMBER OF ALREADY PROCESSED 1
/STATE BITS IS EVEN. OTHERWISE AC B0=1.
	 
DOPAR,	0
	DCA TMP0
	TAD (-13	/-13 BECAUSE 2
			/BITS ARE
			/PROCESSED
			/INITIALLY
	DCA TMP1
	TAD TMP0
	RTR		/LNK HOLDS
			/NEWBIT,AC B0
			/HOLDS STATUS
			/TO DATE.
	SPA		/CHNG FROM ODD
			/TO EVEN ?
	CML		/YES CHANGE
			/STATUS
	RAR		/GET NXT
	ISZ TMP1	/DONE ?
	JMP .-4		/NO
	CMA RAL		/SET LNK=1=EVEN
	CLA		/LNK=0=ODD
	TAD PARCHR	/UPDATE PARITY
	RAL
	DCA PARCHR
	JMP I DOPAR
	 
	PAGE
\f	 
TTOTXT,	0
	TAD I TTOTXT
	DCA TMP0
	ISZ TTOTXT
LOP8,	TAD I TMP0
	RTR
	RTR
	RTR
	JMS DOHAF
	JMP I TTOTXT
	TAD I TMP0
	JMS DOHAF
	JMP I TTOTXT
	ISZ TMP0
	JMP LOP8
	 
DOHAF,	0
	AND (77
	SNA
	JMP I DOHAF
	ISZ DOHAF
	TAD (-40
	SPA
	TAD (100
	TAD (240
	JMS I (LSPPCH
	JMP I DOHAF
	 
TYCRLF,	0
	TAD (215
	JMS I (LSPPCH
	TAD (212
	JMS I (LSPPCH
	JMP I TYCRLF
	 
PHYSIO,	JMS I TYPTXT
	IOMSG
	JMP I GETCD
	 
\f	 
TYPNAM,	0
	DCA TMP2
	TAD TMP2
	DCA TMP0
	MTHREE
	DCA TMP1
LOP9,	TAD I TMP0
	RTR
	RTR
	RTR
	JMS DOHAF
	JMP DOEXT
	TAD I TMP0
	JMS DOHAF
	JMP DOEXT
	ISZ TMP0
	ISZ TMP1
	JMP LOP9
DOEXT,	TAD P3
	TAD TMP2
	DCA TMP0
	TAD I TMP0
	SNA CLA
	JMP P3+1
	TAD P256	/.
	JMS I (LSPPCH
	TAD I TMP0
	RTR
	RTR
	RTR
	JMS DOHAF
P256,	256
	TAD I TMP0
	JMS DOHAF
P3,	3
	TAD (240
	JMS I (LSPPCH
	JMP I TYPNAM
	 
\f	 
OCTOUT,	0
	RAL
	DCA TMP0
	TAD M4
	DCA TMP1
LOP11,	TAD TMP0
	RTL
	RAL
	DCA TMP0
	RAL
	DCA TMP2
	TAD TMP0
	AND (7
	TAD (260
	JMS I (LSPPCH
	TAD TMP2
	RAR CLL
	ISZ TMP1
	JMP LOP11
	TAD (240
	JMS I (LSPPCH
	JMP I OCTOUT
	 
	PAGE
\f	 
/HERE TO SEE IF WE READ THE CORRECT
/BLK OF THE CORRECT FILE.
	 
ICHKB,	0
	TAD PATFLG	/DONT CHK IF
	SZA CLA		/IN PATCH MODE
	JMP I ICHKB
LOP12,	TAD M4
	DCA TMP0
	TAD LSPFLG
	SNA CLA
	JMS I CHKC
	TAD DATBUF	/COMPARE NAMES
	DCA NDX0
	TAD NAME
	DCA TMP1
LOP10,	TAD I NDX0
	CIA
	TAD I TMP1
	SZA CLA
	JMP NAMERR
	ISZ TMP1
	ISZ TMP0
	JMP LOP10
	TAD RBLK	/CHK BLK
	CIA
	TAD I RELBLK
	SNA CLA
	JMP I ICHKB	/GOOD BLK
	JMS I TYPTXT
	NMSG
	TAD RBLK
	JMS I (OCTOUT
	JMS I TYPTXT
	FMSG
	TAD I RELBLK
	JMS I (OCTOUT
RECHK,	JMS I CRLF
	CLA CMA
	JMS I LPWT
	JMS I RDPBLK
	JMS I (RDERR
	JMP LOP12
NAMERR,	JMS I TYPTXT
	NMSG
	TAD NAME
	JMS I TNAME
	JMS I TYPTXT
	FMSG
	TAD DATBUF
	IAC
	JMS I TNAME
	JMP RECHK
	 
\f	 
/CRC GENERATOR
/COURTESY OF MARIO S. ROOT
/COUSIN TO MARIO LEONARD
	 
CRC,	0
	DCA TMP0
	TAD (-7
	DCA TMP1
	TAD TMP0
	AND BCC2
	CIA
	CLL RAL
	TAD TMP0
	TAD BCC2
	CLL RTR
	SPA
	CML
	RAR
	ISZ TMP1
	JMP .-4
	SPA
	JMP .+4
	DCA TMP1
	TAD BCC1
	JMP .+5
	DCA TMP1
	TAD BCC1
	RAR
	CML RAL
	DCA BCC2
	TAD TMP1
	AND (60
	CLL RTL
	DCA BCC1
	TAD BCC1
	AND BCC2
	CIA
	CLL RAL
	TAD BCC1
	TAD BCC2
	DCA BCC2
	TAD TMP1
	CLL RTR
	RTR
	DCA BCC1
	TAD BCC1
	CLL RAR
	CLL RAR
	DCA TMP1
	TAD TMP1
	AND BCC1
	CIA
	CLL RAL
	TAD BCC1
	TAD TMP1
	DCA BCC1
	JMP I CRC
	 
	PAGE
\f	 
/CHK FOR MASTER INPUT DEVICE ONLY
	 
CHKMI,	0
	TAD (INTBL-1
	DCA NDX0
	TAD I NDX0
	SNA CLA
	JMP BY1		/NO MI
	TAD (-10
	DCA TMP0
	ISZ NDX0
	TAD I NDX0	/MUST HAVE NO
	SZA CLA		/OTHER IN DEVS
	JMP BY1		/FOUND 1
	ISZ TMP0
	JMP .-5
	CLA CMA		/MI ONLY SET
BY1,	DCA MIFLG	/MI FLAG
	JMP I CHKMI
	 
	 
\f	 
DOUSR,	0		/HERE TO DO A
	DCA N1-1	/USR CALL
	TAD NAME	/EITHER LOOKUP
	DCA N1		/,ENTER OR
	TAD FLEN	/CLOSE
	DCA N1+1
	TAD USRDEV
	JMS I (GETHAN
	CIF 10
	TAD USRDEV
	AND P17
	JMS I P200
	0
N1,	0;0
	JMP USRERR
	TAD N1
	DCA SBLK
	TAD N1+1
	DCA FLEN
	JMP I DOUSR
USRERR,	JMS I TYPTXT
	USRMSG
	TAD N1-1
	JMS I (OCTOUT
	TAD USRDEV
	JMS I TYDEV
	TAD NAME
	JMS I TNAME
	JMS I CRLF
	JMP I GETCD
	 
	PAGE
\f	 
SETDV,	0
	JMS CHKP37
	7600-1		/OUTPUT INFO
	OUTTBL-1
	4
	-3
	JMS CHKP37
	7617-1		/INPUT INFO
	INTBL-1
	1
	-11
	JMP I SETDV
	 
CHKP37,	0
	DCA TMP0
	TAD (TM-1
	DCA NDX1
	TAD I CHKP37	/P37 ADDR
	DCA NDX0
	ISZ CHKP37
	TAD I CHKP37
	DCA TMP1	/PERM TBL
	ISZ CHKP37
	TAD I CHKP37
	DCA TMP3	/ENTRY LEN-1
	ISZ CHKP37
	TAD I CHKP37
	DCA TMP2	/-NUM TO DO
XLOP2,	CDF 10
	TAD I NDX0
	SZA		/BLANK ENTRY ?
	ISZ TMP0	/NO
	CDF
	DCA I NDX1	/TMP SAV
	TAD NDX0	/ADV PTR TO NXT
	TAD TMP3
	DCA NDX0
	ISZ TMP2	/DONE?
	JMP XLOP2	/NO
	TAD TMP0	/WAS P37
	SNA CLA		/BLANK ?
	JMP BY0		/YES USE SET OF
			/DEV LAST
			/SPECIFIED
	TAD TMP1
	DCA NDX1
	TAD (TM-1
	DCA NDX0
	TAD I CHKP37
	DCA TMP0
	TAD I NDX0	/NEW UNIT
	DCA I NDX1
	DCA I NDX1	/0 TO SBLK
	ISZ TMP0
	JMP .-4
	DCA I NDX1
BY0,	ISZ CHKP37
	JMP I CHKP37
	 
\f	 
/ROUT TO INTERPRET PS/8 SWITCHES
	 
SWITCH,	0
	TAD I SWITCH	/PTR TO TBL
	DCA TMP0
	ISZ SWITCH
	CLL
	TAD (7757
	AND SATOL
	TAD SMTOX
	SNA SZL CLA
	JMP I SWITCH	/NONE TO READ
XLOP0,	TAD I TMP0
	SNA		/END OF TBL ?
	JMP I SWITCH	/YES
	DCA TMP1	/PTR TO FLAG
	CLA CMA		/SET TO YES
	DCA I TMP1	/STATE
XLOP1,	ISZ TMP0
	TAD I TMP0	/AC=P37 SW ADDR
	ISZ TMP0	/=PTR TO MASK
	SNA		/MORE ARGS FOR
			/THIS SWIT ?
	JMP XLOP0	/NO DO NXT
	DCA TMP2
	TAD I TMP2
	AND I TMP0	/CLR NON SWITCH
			/BITS
	CIA		/COMP WITH MASK
	TAD I TMP0
	SZA CLA		/IF ALL OK
			/LEAVE SWITCH
	 		/ALONE
	DCA I TMP1
	JMP XLOP1
	 
\f	PAGE
\f	 
WRITE,	0
	TAD WRITE
	DCA READ
	FOURK
	JMP READ+1
	 
READ,	0
	DCA RWBIT
	JMS I CHKC
	TAD I READ
	DCA DVPTR
	ISZ READ
	TAD I DVPTR	/UNIT
	JMS I (GETHAN
	ISZ DVPTR
	TAD I DVPTR	/PUT NUM BLKS
	AND P17		/IN B1-B5
	RTL CLL
	RTL
	RTL
	RAL
	TAD BUFFLD
	TAD RWBIT
	DCA IOLST
	ISZ DVPTR
	TAD I DVPTR
	DCA IOLST+2	/SBLK
	JMS I HANADR
IOLST,	0
	2000
	0
	JMP .+3
	ISZ READ	/NON ERR RTN
	JMP I READ
	CLA
	JMS I TYPTXT
	IOMSG
	MTWO
	TAD DVPTR
	DCA TMP0
	TAD I TMP0
	JMS I TYDEV
	TAD I NAME
	SNA CLA
	JMP .+3
	TAD NAME
	JMS I TNAME
	TAD IOLST+2
	JMS I (OCTOUT
	TAD RWBIT
	SMA CLA
	JMP DONALL
	TAD (337
	JMS I (LSPPCH	/BACK ARROW
DONALL,	JMS I CRLF
	JMP I READ
RWBIT,	0
DVPTR,	0
	 
	PAGE
\f	 
\f	 
GETHAN,	0
	AND P17
	DCA TMP1
	TAD TMP1
	TAD (DEVRES-1
	DCA TMP0
	CDF 10
	TAD I TMP0	/IS HANDLER IN
	CDF		/IN CORE ?
	SZA
	JMP NOFET	/YES
	MTWO
	TAD TMP1
	SNA CLA
	TAD (1200
	TAD (6001	/ENABLE 2 PG HANDLERS
	DCA .+5
	TAD TMP1
	CIF 10
	JMS I P200
	FETCH
	0
	JMP FETERR
	TAD .-2
NOFET,	DCA HANADR
	JMP I GETHAN
	 
FETERR,	JMS I TYPTXT
	USRMSG
	TAD (FETCH
	JMS I (OCTOUT
	JMP I GETCD	/ABORT
			/COMMAND
	 
TYPDEV,	0
	AND P17
	TAD (DMTBL-1
	DCA TMP0
	TAD I TMP0
	DCA .+2
	JMS I TYPTXT
	0
	JMP I TYPDEV
	 
	PAGE
\f	 
COMPAR,	JMS I RDSWIT
	CSTBL
	TAD I (OUTTBL
	DCA USRDEV
	TAD USRDEV
	DCA CD1
	TAD (INTBL
	DCA INPTR
	TAD I NAME
	SNA CLA
	JMP CDEV
	TAD (LOOKUP
	JMS I USR
	TAD SBLK
	DCA CD1+2
	TAD I INPTR
	DCA CD2
	CDF 10
	TAD I (7620
	CDF
	DCA CD2+2
	JMS DOCOMP
CDEV,	JMP I GETCD
	 
DOCOMP,	0
LOP14,	JMS I (READ
	CD1
	JMP I GETCD
	TAD (2400
	DCA I (IOLST+1
	JMS I (READ
	CD2
	JMP CERR
	CLA CMA
	DCA BADB
	TWOK
	DCA I (IOLST+1
	TAD (1777
	DCA NDX0
	TAD (2377
	DCA NDX1
	TAD (-400
	DCA ZCNT
	CDF 10
LOP13,	TAD I NDX0
	CIA
	TAD I NDX1
	SZA CLA
	JMP BADCOM
LOP15,	ISZ ZCNT
	JMP LOP13
	CDF
	ISZ CD1+2
	ISZ CD2+2
	ISZ FLEN
	JMP LOP14
	JMP I DOCOMP
BADCOM,	CDF
	ISZ BADB
	JMP BYBLK
	TAD CD1
	JMS I TYDEV
	TAD CD1+2
	JMS I (OCTOUT
	TAD CD2
	JMS I TYDEV
	TAD CD2+2
	JMS I (OCTOUT
	JMS I CRLF
BYBLK,	TAD BADFO
	SZA CLA
	JMP I GETCD
	TAD BADBO
	SZA CLA
	JMP DOMORE
	TAD (400
	TAD ZCNT
	JMS I (OCTOUT
	TAD NDX0
	DCA TMP0
	CDF 10
	TAD I TMP0
	CDF
	JMS I (OCTOUT
	TAD NDX1
	DCA TMP0
	CDF 10
	TAD I TMP0
	CDF
	JMS I (OCTOUT
	JMS I CRLF
DOMORE,	JMS I CHKC
	CDF 10
	JMP LOP15
CERR,	TWOK
	DCA I (IOLST+1
	JMP I GETCD
CD1,	0;1;0
CD2,	0;1;0
BADB,	0
BADBO,	0
BADFO,	0
ZCNT,	0
	 
	PAGE
\f	 
/FILE EDITOR FOR OS/8.
	 
FED,	TAD I (OUTTBL
	AND P17
	DCA USRDEV
	TAD I NAME
	SZA CLA
	JMP ITSNAM
	TAD USRDEV
	TAD (DLTBL-1
	DCA TMP0
	TAD I TMP0
	DCA FLEN
	DCA SBLK
	JMP .+3
ITSNAM,	TAD (LOOKUP
	JMS I USR
	DCA SRWD
	CLA CMA
	DCA MSKWD
	DCA MODF
	TAD USRDEV
	DCA OUDEV
	IAC
	DCA OUDEV+1
	JMS I (RD
LOP16,	JMS I (GINP
	JMS I (G6BIT
	JMP GOTCMD
	DCA ENDCT
	TAD (CMDTBL-2
	DCA NDX0
	ISZ NDX0
	TAD I NDX0
	CIA
	TAD ENDCT
	SZA CLA
	JMP .-5
	TAD I NDX0
	DCA CMDTBL-1
GOTCMD,	JMS I CMDTBL-1
	JMP LOP16
	 
	QMARK
CMDTBL,	2200
	R
	2700
	W
	0300
	C
	2300
	SR
	1700
	O
	0500
	EX
ENDCT,	0
	QMARK
	 
QMARK,	0
	TAD (277
	JMS I (LSPPCH
	JMS I CRLF
	JMP I QMARK
	 
\f	 
C,	0		/STATUS COMMAND
	TAD RBLK
	JMS I (OCTOUT
	TAD MODF
	SNA CLA
	JMP .+3
	TAD (306
	JMS I (LSPPCH
	TAD MODB
	SNA CLA
	JMP .+3
	TAD (302
	JMS I (LSPPCH
	TAD (240
	JMS I (LSPPCH
	TAD CLOC
	JMS I (OCTOUT
	TAD SRWD
	JMS I (OCTOUT
	TAD MSKWD
	JMS I (OCTOUT
	JMS I CRLF
	JMP I C
	 
	PAGE
\f	 
GETC,	0		/GET AN INPUT
	TAD I BUFPTR	/CHAR
	TAD EOLWD
	SNA CLA
	JMP I GETC
	TAD I BUFPTR
	DCA INCHR
	ISZ BUFPTR
	TAD INCHR
	TAD (-254	/,
	SNA CLA
	JMP I GETC
	ISZ GETC
	TAD INCHR
	JMP I GETC
	 
G6BIT,	0		/8 TO 6 BIT
	JMS GETC
	JMP I G6BIT
	AND (77
	RTL CLL
	RTL
	RTL
	DCA TMP0
	JMS GETC
	JMP EX6
	AND (77
	TAD TMP0
	DCA TMP0
	JMS GETC
	JMP EX6
	JMS BUPTR
	JMS BUPTR
	JMS BUPTR
	JMP I G6BIT
EX6,	TAD TMP0
	ISZ G6BIT
	JMP I G6BIT
	 
\f	 
GOCTAL,	0		/GET OCTAL DIGIT
	TAD BUFPTR
	DCA TMP2
	JMS GETC
	JMP I GOCTAL
	JMS BUPTR
LOP17,	DCA TMP1
	JMS GETC
	JMP FOCT
	TAD (-260
	DCA TMP0
	TAD TMP0
	AND (7770
	SNA CLA
	JMP .+4
	TAD TMP2
	DCA BUFPTR
	JMP I GOCTAL
	TAD TMP1
	RTL CLL
	RAL
	TAD TMP0
	JMP LOP17
FOCT,	ISZ GOCTAL
	TAD TMP1
	JMP I GOCTAL
	 
BUPTR,	0
	CLA CMA
	TAD BUFPTR
	DCA BUFPTR
	JMP I BUPTR
	 
\f	 
RD,	0		/READ A BLK
	DCA TMP0	/=REL BLK TO DO
	CLL
	TAD FLEN
	TAD TMP0
	SNL CLA
	JMP .+3
	JMS I (QMARK
	JMP I RD
	TAD TMP0
	DCA RBLK
	TAD RBLK
	TAD SBLK
	DCA OUDEV+2
	JMS I (READ
	OUDEV
	JMP I IOERR
	DCA MODB
	DCA CLOC
	JMP I RD
	 
R,	0		/R COMMAND
	JMS GOCTAL
	TAD RBLK
	JMS RD
	JMP I R
	 
W,	0		/WRITE COMMAND
	TAD MODB
	SNA CLA
	JMP .+5
	JMS I (WRITE
	OUDEV
	JMP I IOERR
	CLA CMA
	DCA MODF
	TAD RBLK
	IAC
	JMS RD
	DCA MODB
	JMP I W
	 
EX,	0		/EXIT TO DECODE
	TAD MODB
	SNA CLA
	JMP I GETCD
	JMS I (WRITE
	OUDEV
	JMP I IOERR
	JMP I GETCD
	 
	PAGE
\f	 
GINP,	0		/GET KBRD INPUT
	TAD MAXLEN
	DCA OCNT
	TAD (BUFADR
	DCA BUFPTR
	JMS I [LSPRDR
	AND	[177
	TAD	[200
	DCA	INCHR
	TAD	INCHR
	TAD (-212
	SNA
	JMP LFEND
	TAD (212-203
	SNA
	JMP I [CTRLC0
	TAD (203-215
	SNA
	JMP LFEND-1
	TAD (215-225
	SZA
	JMP TRYRUB
	TAD (336
	JMS I (LSPPCH
	TAD (325
	JMS I (LSPPCH
	JMS I CRLF
	JMP GINP+1
TRYRUB,	TAD (225-377
	SZA CLA
	JMP PUTC
	TAD MAXLEN
	CIA
	TAD OCNT
	SNA CLA
	JMP GINP+5
	CLA CMA
	TAD OCNT
	DCA OCNT
	CLA CMA
	TAD BUFPTR
	DCA BUFPTR
	TAD (334
	JMS I (LSPPCH
	JMP GINP+5
PUTC,	TAD INCHR
	JMS I (LSPPCH
	TAD INCHR
	TAD (-240
	SNA CLA
	JMP GINP+5
	TAD INCHR
	DCA I BUFPTR
	ISZ BUFPTR
	ISZ OCNT
	JMP GINP+5
	IAC
LFEND,	DCA I BUFPTR
	TAD I BUFPTR
	CIA
	DCA EOLWD
	TAD (BUFADR
	DCA BUFPTR
	JMS I CRLF
	JMP I GINP
	 
\f	 
O,	0		/OPEN LOC N
	JMS I (GOCTAL
	JMP .+3
	AND (377
LOP20,	DCA CLOC
	JMS DOLOC
	TAD EOLWD
	SZA CLA
	JMP I O
	TAD CLOC
	IAC
	AND (377
	SZA
	JMP LOP20
	JMS I (W
	JMP LOP20+1
	 
DOLOC,	0
	JMS GETWRD
	JMS I (OCTOUT
	TAD (257
	JMS I (LSPPCH
	JMS GINP
	JMS I (GOCTAL
	JMP I DOLOC
	JMS PUTWRD
	JMP I DOLOC
	 
GETWRD,	0
	TAD CLOC
	TAD I (IOLST+1
	DCA TMP0
	CDF 10
	TAD I TMP0
	CDF
	JMP I GETWRD
	 
PUTWRD,	0
	DCA TMP0
	TAD CLOC
	TAD I (IOLST+1
	DCA TMP1
	TAD TMP0
	CDF 10
	DCA I TMP1
	CDF
	CLA CMA
	DCA MODB
	JMP I PUTWRD
	 
	PAGE
\f	 
SR,	0		/SEARCH COMM.
	JMS I (GOCTAL
	SKP
	DCA SRWD
	JMS I (GOCTAL
	SKP
	DCA MSKWD
	TAD EOLWD
	DCA ISVEOL
	DCA MATFLG
	TAD SRWD
	AND MSKWD
	CIA
	DCA BCC1
	CLA CMA
	DCA SRBFLG
LOP18,	JMS I (GETWRD
	AND MSKWD
	TAD BCC1
	SNA CLA
	JMP SRMAT
LOP19,	ISZ CLOC
	TAD CLOC
	AND (377
	SZA CLA
	JMP LOP18
	TAD (377
	DCA CLOC
	TAD ISVEOL
	SZA CLA
	JMP EXS
	JMS I (W
	TAD CLOC
	SNA CLA
	JMP LOP18-2
	JMP EXS
SRMAT,	TAD SRBFLG
	SNA CLA
	JMP .+3
	TAD RBLK
	JMS I (OCTOUT
	CLA CMA
	DCA MATFLG
	DCA SRBFLG
	TAD CLOC
	JMS I (OCTOUT
	JMS I CRLF
	JMS I (DOLOC
	TAD EOLWD
	SNA CLA
	JMP LOP19
EXS,	TAD MATFLG
	SNA CLA
	JMS I (QMARK
	JMP I SR
SRBFLG,	0
MATFLG,	0
ISVEOL,	0
	 
	PAGE
\f	 
/TABLES FOR FPIP
	 
DLTBL,	-6260		/DEVICE LENGTHS
	-6260		/FOR UNITS 1-17
	0		/SYS,DSK,TTY
	0		/LPT
	-1341;-1341		/DTA0-
	-1341;-1341		/DTA7
	-1341;-1341
	-1341;-1341
	0
	0
	0
	 
DMTBL,	SYMSG
	DKMSG
	TTMSG
	LPMSG
	D0MSG
	D1MSG
	D2MSG
	D3MSG
	D4MSG
	D5MSG
	D6MSG
	D7MSG
	PPMSG
	PRMSG
	CDMSG
	 
AMSG,	PARMSG
	PARMSG
	LTMSG
	EOTMSG
\f	 
PSTBL,	EOTFLG
	SATOL
	200		/E
	0
	LSPFLG
	SATOL
	1		/L
	0
	PATFLG
	SMTOX
	400		/P
	0;0
CSTBL,	BADBO
	SATOL
	2000		/B
	0
	BADFO
	SATOL
	4000
	0;0
	 
\f	 
TM,	0
	0
	0
	0
	0
	0
	0
	0
	0
OUTTBL,	1;0
	0;0
	0;0
	0
INTBL,	5;0
	0;0
	0;0
	0;0
	0;0
	0;0
	0;0
	0;0
	0;0
	0
	 
\f	 
S0FLG,	0		/CM
\f	 
SYMSG,	TEXT "SYS:"
	0
DKMSG,	TEXT "DSK:"
	0
TTMSG,	TEXT "TTY:"
	0
LPMSG,	TEXT "LPT:"
	0
D0MSG,	TEXT "DTA0:"
	0
D1MSG,	TEXT "DTA1:"
	0
D2MSG,	TEXT "DTA2:"
	0
D3MSG,	TEXT "DTA3:"
	0
D4MSG,	TEXT "DTA4:"
	0
D5MSG,	TEXT "DTA5:"
	0
D6MSG,	TEXT "DTA6:"
	0
D7MSG,	TEXT "DTA7:"
	0
PPMSG,	TEXT "PTP:"
	0
PRMSG,	TEXT "PTR:"
	0
CDMSG,	TEXT "CDR:"
	0
EOTMSG,	TEXT "END OF TAPE "
	0
NTMSG,	TEXT "ENTER NEXT "
	0
BIGMSG,	TEXT "IS TOO BIG FOR "
	0
PARMSG,	TEXT "PARITY ERROR "
	0
LTMSG,	TEXT "L/T ERROR "
	0
USRMSG,	TEXT "USR "
	0
IOMSG,	TEXT "I/O ERROR "
	0
NMSG,	TEXT "NEED: "
	0
FMSG,	TEXT "FOUND: "
	0
BEQMSG,	TEXT "BAD =BLK"
	0
	 
\f	 
PARADR,	0
	*PARADR+41
FNAME,	0;0;0;0;0
FRMADR,	0
	*614+FRMADR
AAFREE,	0
	*6600-10
HDATA,	0		/TYPE (HOLDS
			/VERS FOR NOW)
	0;0;0;0		/NAME
	0		/REL BLK
	0		/LEN
	0		/CONTINUATION
			/WD 0 FOR NOW
BUFADR,	0
	 
	LTLEN=124
	MXPBLK=40
	NBYTS=41
	MTHREE=7346	/CLA CLL CMA RTL
	MTWO=7344	/CLA CLL CMA RAL
	TWOK=7332	/CLA CLL CML RTR
	FOURK=7330	/CLL CML CLA RAR
	FETCH=1
	LOOKUP=2
	ENTER=3
	CLOSE=4
	DECODE=5
	CHAINE=6
	ERROR=7
	USRIN=10
	USROUT=11
	INQUIRE=12
	RESET=13
	PLS=6026
	PSF=6021
	RFC=6014
	RRB=6012
	RSF=6011
	DEVRES=7647
	ATOL=7643
	MTOX=7644
	YTO9=7645
	IFZERO	PTAPE	<
	NSLOTS=S0END-S0FLG
	>
	 
	 
	$
\f