<div id='wikitext'>
<pre><b> File: HEXA1.BR of Tape: Sources/Focal/s7</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/FILENAME:	* H E X A 1 . B R *
/
/	VERSION 52 VOM 11. 11. 76

/	HEXAPUS=HEXA1.BR+HEXA2.BR+HEXA3.BR

/
/
/	* P A G E 0 0 . B R *
/
/
/
/	CODE FOR TESTING WITHOUT ETH
/
/	FOR RUN DEFINE FOLLOWING EXPRESSIONS:
/
/	SIMOUT=0		/SIMULATES SEND ALLOWED
/	SIMIN=0			/SIMULATES INPUTSTREAM DEFINED
	METH=0		/IF WITH ETH
	MCDEC=0		/IF WITH COMDAND DECODER
	MTTY=0		/IF WITH INTERUPT ON TTY
	MLPT=0		/IF WITH LINE PRINTER
/	ODTEST=0			/FOR TEST ONLY
/	DRIVT=0			/FOR TESTING OG DRIVER
/	DRIVS=0			/FOR TESTING OF LINE OUTPUT
/	CLOCK=0		/ RECEIVE EBABLED FOR 20B SEC ONLY
/
/	CODE FOR MODEM INTERFACE
/
	IMEN=6414			/INTERUPT ENABLE
	IMDI=6415			/INTERUPT DISABLE
	SKMR=6402			/SKIP ON RECEIVER FLAG
	RMOD=6403			/READ RECEIVE CHAR+CLEAR FLG
	SKMS=6401			/SKIP ON TRANSMIT CHAR AND CLEAR FLG
	SMOD=6404			/LOAD AND TRANSMIT CHAR
	WSYN=6413			/WAIT ON 2 X SYNC
	SMS=6416			/SET MODEM TO SEND
	SMR=6410			/SET MODEM TO RECEIVE
	SKSER=6400			/SKIP ON SEND FLAG,CLEAR FLG
	CON=6405			/SKIP ON CARIER ON AND CLEAR FLG
	COFF=6406			/SKIP ON CARIER OFF AND CLEAR
	DATM=6411			/SET MODEM TO DATA-MODE
	PHOM=6412			/SET MODEM TO PHONE-MODE
/	
/	CODE FOR LINEPRINTER
/
	PSKF=6661
	PCLF=6662
	PSKE=6663
	PSTB=6664
	PSIE=6665
	PCIE=6667		/PCL PSTB=6666
/
/
/	OP CODES FOR CONSTANTS
/
	M3=7346			/-3
	M2=7344			/-2
	M1=STA			/-1
	P1=7301			/ 1
	P2=7305			/ 2
	P3=7325			/ 3
	P4=7307			/ 4
	P6=7327			/ 6
/
/
/	CONSTATS FOR MODEM INTERFACE
/
	PARBIT=4000
	LINF=2400
	OVRUN=1000
	FRAM=2000
	EOMASC=0


/	BUFFERS FOR LINE INPUT AND OUTPUT
/	A BUFFERS ARE IN FIELD 2, B IN FIELD 1
/
	ETBFOA=6000
	ETHA=CDF 20
	ETHB=CDF 10
	ETBFOB=0
	ETBFIA=7000
	ETBFIB=1000
	ETHLE=-777
/
/	DEVICE BUFFERS
/
	LO0BU=2000		/SYSTEM INFO FOR LINE
	LO0BUL=-23
	LI0BU=2200		/FROM LINE OR ERROR TO TTY
	LI0BUL=-200
	LO1BU=2400		/OS8 FOR LINE
	LO1BUL=-1400
	LI1BU=4000		/LPT RING BUFFER IS SPECIAL
	LI1BUL=-1777
	LI2BU=6000		/OS8 FROM LINE
	LI2BUL=-400
	LI3BU=6400		/DITO
	LI3BUL=-400
	CDBU=2030		/COMMAND DECODER BUFFER, FROM TTY
	CDBUL=-147
/
/
/	ASCII 7BIT DEFINITIONS
/
/
/
/	ASCII CODES
/
	CTRLC=3
	MEOM=-3
	SYNC=26
	MSYNC=-26
	LF=12
	CR=15
	CTRLTA=11
	CTRLZ=32
	FFEED=14
	SOH=16
	EOR=36
	EOF=35
	EOI=34
	AD=30
	DIFF=2			/AD IS TO INDICATE ASCII OR BIN
	RUBOUT=177
/				 DIFF FOR MAXIMUM DIFFERENZE WHCICH
/				 NEEDS Q QSL
/
/	STREAMBITS
/
	DLO0=1
	DLI0=1
	DLO1=2
	DLI1=4
	DLI2=20
	DLI3=100
	FIXTAB
/	INTERUPT STUF FOR ETH PROGRAM
/


	*0
	0
	JMP	INTERU
	JMP	INTERU
	JMP	INTERU
	ZBLOCK 10-.
/
/	AUTOINDEX REGISTERS
/
	*10
X0,	0
X1,	0
X2,	0			/X0-X2 USER FOR MOVE
X3,	0			/USER TO STORE INFO IN ETHBUFOB
X4,	0			/USED TO FETCH INFO FROM ETHBUFIB
X5,	0
X6,	0
X7,	0
/
/
/	FIELD 1 BUFFERS
/
BFOB,	ETBFOB
WCBFOB,	ETHLE
BFIB,	ETBFIB
WCBFIB,	ETHLE
LO0,	LO0BU
WCLO0,	LO0BUL
LI0,	LI0BU
WCLI0,	LI0BUL
LO1,	LO1BU
WCLO1,	LO1BUL
LI1,	LI1BU
WCLI1,	LI1BUL
LI2,	LI2BU
WCLI2,	LI2BUL
LI3,	LI3BU
WCLI3,	LI3BUL
CD,	CDBU
WCCD,	CDBUL
DEVTAX,	0
LO1FG,	0
LO1FP,	0
DEFSTR,	0 
/
/
/	AEREA FOR MOVE TO FIELD 2 IS FROM 20 TO 47
/
/
	ZBLOCK 50-.
	*50
/
/
/	SPECIAL RELATIVE POINTER FOR LP
/
LPGET,	0
LPPUT,	0
LPGTOT,	0			/LPT TOTAL POINTERS
LPPTOT,	0
/
/	LINE-CONTROLL INFO WORDS
/
SSTRM,	0		/ACTUAL SEND STREAM
OLDQSL,	0
SENDNO,	0		/NUMBER FOR BLOCK TO SEND
SEQSL,	0		/QSL FOR SEND
SSTAT,	0		/SEND STATUS INFO
SCHAR,	0		/CHARACKTER FOR SEND AND RECEIVE
EXPNO,	0		/EXPECTED BLOCKNUMBER
RSTRM,	0		/ACTUAL RECEIVED STREAM NO
RECNO,	0		/RECEIVED STATUS INFO
REQSL,	0		/RECEIVED QSL
RSTAT,	0		/RECEIVED STATUS INFO
RCHAR,	0			/RECEIVED CHAR
TOCANC,	0		/CONTAINS BIT MASC FOR STREAMS TO CANCLE
CN0,	0
CN1,	0
GETP,	0		/POINTER FOR INFOPU
WC1,	0
EOIFLG,	0		/EOI FOR LO1
INTERU,	DCA	INTAC
	GTF
	DCA	INTAC+1
	7721			/LOAD AC WITH MQ, CLEAR MQ
	DCA	INTAC+2
	TAD	0
	DCA	INTAC+3
	CIF CDF 20
	JMP I	.+1
	INTHA			/JUMP TO INTERUPT HANDLER
/
/
DISMS,	CLL CLA
	TAD	INTAC+2
	MQL
	TAD	INTAC+1
	RTF
	CLA
	TAD	INTAC
	JMP I	0
INTAC,	0
	0
	0
	0
LPTPFL,	0			/LINEPRINTER PROCESSED FLAG
TTYZF,	0		/IS SET TO 1 IF ^Z ON TTYIN
/
/	POINTERS TO FLAGS AND SWICHES FOR IDLEJOB
/
REPSX,	0
SWISX,	0
LASTSX,	0
NEWFSX,	0
TABSX,	0
REPRX,	0
SWIRX,	0
LASTRX,	0
LIX,	0
WCLIX,	0
EORFX,	0
REPFX,	0
CRFLGX,	0
	PAGE
/	* I N I T . B R *
/
/
/	START OF PROGRAM
	*200
	6141			/DISABLE DATA BREAK
	6154			/DISABLE WRC AD
	6135			/CLOCK HALT
	LAS			/TIME SETTING WITH SR
	6132			/LOAD CLOCK REGISTER
	6137			/CLEAR FLG
	6130			/CLOCK INTERUPT ENABLE
	IFDEF MTTY &lt;
/	DISABLES TTY FOR TEST
	CLL CLA IAC &gt;		/ENABLE TTY
	6035
	CLL CLA
	6335			/DISABLE KL8E
	6665			/ENABLE LPT
	6500			/DISABLE DI 50
	6510			/DISABLE DI 51
	IFDEF METH &lt;
	IMEN		&gt;	/ENABLE MODEM INTERUPT
	IFNDEF METH &lt;
	IMDI		&gt;	/DISABLE MODEM FOR TEST
	RMOD			/MODEMFLAGS CLEAR
	SKMS
	NOP
	SKSER
	NOP
	CON
	NOP
	COFF
	NOP
	6032			/TTYRECEIVE
	6042			/TTYPUNCH
	6662			/LPT
	NOP
	NOP
	IFDEF METH &lt;JMS	DIAL&gt;	/DIAL NUMBER, RETUNR IF LINE READY
	JMS	CLEAR		/SET SENDNO, EXPTNO ETC
/
RESTAR,	IOF			/RESTART LOCATION
	NOP
	TAD	(HLT
	DCA	.-2
	JMS	LOTACL		/CLEAR LO1 FILE TABLE AND RESET POINTERS
/FILL WITH 0 FIRST
	M1
	TAD	BFOB
	DCA	X3
	JMS	OBF0
	JMS	CLBFOB
	CDF	20
	P1
	DCA I	(STATE
	DCA I	(LSEND		/LSEND=IDLE
	CDF	0
/
/
/	SETUP SHUTDOWN
	JMS	DEFINE
	DLI0
	JMS	VORSP
	0
	TAD	(53
	CDF	10
	DCA I	X3		/FILL IN SHUT DOWN
	JMS	RESTBL		/FILL REST WITH BLANCS
	JMS	WRITEL		/PUT B BLOCK TO FIELD 2 IN A BLOCK
/
/	SET UP STARTBUF
/
	IFDEF METH &lt;
	JMS	STABUF		/SET UP START BUF
/
/	NOW SET MODEM TO RECEIVE  AND WAIT FOR ACK

	SMR &gt;
	IFNDEF ODTEST &lt;ION&gt;
	IFDEF METH &lt;
/	CODE IS NOTHING FOR TEST PUPUSE
	JMS	TEST37		/WAIT FOR RESTAR
	JMS	CLEAR
	JMS	CLOSEF		/CLOSE EVENTUAL FILES
	JMS	TRANSM		/WAIT FOR TRANSMIT OK
	JMS	WRITEL		/PUT STARTBLOCK TO LINE
	JMS	SAVLIN		/WAIT FOR FIRST ETH INFO
	JMS	DEFINE
	DLI0
	JMS	VORSP		/SET UP DEFINE BLOCK FOR LO1
	0
	CDF	10
	TAD	(41
	DCA I	X3
	ISZ	WCBFOB
	TAD	(41
	DCA I	X3
	ISZ	WCBFOB
	JMS	RESTBL
	JMS	SAVLIN 		/WAIT FOR SECOND ETH BLOCK
	JMS	TRANSM &gt;		/WAIT FOR START TRANSMITED
	JMS	WRITEL 		/PUT LO1 DEFINING BLOCK TO LINE
	JMS	DEFINE
	DLO1			/DEFINES ALSO LO0
	JMS	DEFLI1
	JMS	DEFINE
	DLI1
	IFDEF METH &lt;
/
/	REMEMBER, LO1 DEFINING BLOCK IS ON LINE
/
	JMS	TRANSM
	JMS	WRITEL &gt;		/END OF CONDITIONAL ASSEMBLY
/
/
	IFNDEF MCDEC &lt;
	JMS	CLCD &gt;		/SET CDBUFFER FULL FOR TEST
	JMP	IDLEJ1		/HOPE IT WILL WORK




RESTBL,	0
	CDF	10
	TAD	[40
	DCA I	X3
	TAD	(-ETBFOB-23
	TAD	X3
	SZA	CLA
	JMP	.-5
	DCA	WCBFOB
	CDF	0
	JMP I	RESTBL


TRANSM,	0
	CDF	20
	M1
	TAD I	(WCBFOA
	SZA	CLA
	JMP	.-3		/WAIT
	CDF	0
	JMP I	TRANSM


	PAGE
/
/
/
/
/
DIAL,	0			/SUBROUTINE FOR INIT
	PHOM			/SET MODEM TO PHON MODE
	6032		/CLEAR TTY FLAGS
	6042
	JMS	CLLI0
	JMP	DIAL1
	IFNDEF DRIVT &lt;
	JMS	TELE
	DIALM1
	JMS	TELE
	DIALM2
	JMS	SEND0
	JMS	TOUT &gt;		/PRINT MSG
DIAL1,	6031			/WAIT FOR SOME INPUT
	JMP	.-1
	6030
	CLL CLA
	DATM			/MODEM TO DATA MODE
	JMP I	DIAL
/
/
TOUT,	0
	JMS	CLLI0
TOUT1,	CDF	10
	TAD I	LI0
	CDF	0
	SNA
	JMP	TOUT2
TOUT3,	TLS
	TSF
	JMP	.-1
	TAD	(-215
	SZA	CLA
	JMP	TOUT2
	TAD	(212
	JMP	TOUT3
TOUT2,	ISZ	LI0
	ISZ	WCLI0
	JMP	TOUT1
	JMS	CLLI0
	JMP I	TOUT
/
/
/
CLOSEF,	0
	JMS	FINTAC		/CLEAR LO1 FILETABLE
	JMP	.-1
	TAD	(LO1F2I		/RESET POINTERS
	DCA	LO1FP
	TAD	(LO1FMI
	DCA	LO1FG
	DCA	LPGET		/CLEAR LPT RELATIVE POINTERS
	IFNDEF DRIVS &lt; DCA	LPPUT &gt;
	TAD	CLOS2		/SETUP RETURN FOR CLOSE
	DCA	CLOS1
	TAD	LI2HA
	SNA	CLA
	JMP	CLOF1
	CDF	10
	TAD	(232
	DCA I	LI2
	CDF	0
	P1
	DCA	WCLI2
	JMS	SAVLI2
	DCA	LI2HA			/CLEAR HANDLER ENTRY
	JMS	UNDEF			/REMOVE LI2 FROM DEFINED STREAMS
	DLI2
CLOF1,	TAD	LI3HA
	SNA CLA
	JMP	CLOF3
	CDF	10
	TAD	(232
	DCA I	LI3
	CDF	0
	P1
	DCA	WCLI3
	JMS	SAVLI3
	DCA	LI3HA		/CLEAR HANDLER ENTRY
	JMS	UNDEF
	DLI3
CLOF3,	TAD	(NOP
	DCA	CLOS1
	JMP I	CLOSEF		/LOOK LATER WHAT TO DO HERE
/
/
/
UNDEF,	0
	TAD I	UNDEF
	CMA
	AND	DEFSTR
	DCA	DEFSTR
	ISZ	UNDEF
	JMP I	UNDEF
/
/
/
/
/
CANC,	0
	RDF
	TAD	[CIF CDF	0
	DCA	CANCR
	TAD I	CANC
	CMA
	AND	TOCANC
	TAD I	CANC
	DCA	TOCANC
	ISZ	CANC
CANCR,	HLT
	JMP I	CANC
/
/
DEFLI1,	0
	JMS	VORSP
	0
	CDF	10
	TAD	[41
	DCA I	X3
	TAD	[42
	DCA I	X3
	TAD	[40+40
	DCA I	X3
	CDF	0
	JMS	CLBFOB
	JMP I	DEFLI1
	PAGE
/
/
LASTCS,	0;0
REPCNS,	0;0
SWISE,	0;0
NEWFS,	0;1
BITO3,	0;0
TABSCN,	0;0
/
/
LASTCR,	ZBLOCK 4
REPCNR,	ZBLOCK 4
SWIRE,	ZBLOCK 4
REPFLG,	ZBLOCK 4
EORFLG,	1;1;1;1
CRFLG,	0;1;0;0
/
/
WRITEL,	0
	JMS	MOVE
	ETHB
	ETBFOB
	ETHA
	ETBFOA
	ETHLE
	JMS	CLBFOA
	JMS	CLBFOB
	JMS	SEBLO		/SAVE HEADER
	JMP I	WRITEL
/
/
OBF0,	0			/FILL ETHOB WITH 0
	CDF	10
	DCA I	X3
	ISZ	WCBFOB
	JMP	.-3
	CDF	0
	JMP I	OBF0
KANZ,	0			/SETS UP STREAM TO CANCLE IN LO0
	RDF
	TAD	[CDF CIF 0
	DCA	KANZR
	TAD I	KANZ
	DCA	KANZ1
	CDF	0
	JMS	LO0BLA		/FILL WITH BLANCS FIRST
	TAD	(45
	DCA I	(LO0BU
	TAD	KANZ1
	ISZ	KANZ
	DCA I	(LO0BU+1
	CDF	0
	JMS	CLLO0
KANZR,	HLT
	JMP I	KANZ
KANZ1,	0
/
/
/
LO0BLA,	0
	JMS	CLLO0
	CDF	10
	TAD	[40
	DCA I	LO0
	ISZ	LO0
	ISZ	WCLO0
	JMP	.-4
	JMS	CLLO0
	JMP I	LO0BLA		/RETURNS WITH DF 10
/
/
/
LOTACL,	0
	TAD	(LO1FMI-1	/CLEAR LO1 FILE TABLE AND RESET POINTERS
	DCA	X0
	TAD	(LO1FMI-LO1FMA-1
	DCA	X1
	DCA I	X0
	ISZ	X1
	JMP	.-2
	TAD	(LO1FMI
	DCA	LO1FG
	TAD	(LO1F2I
	DCA	LO1FP
	JMP I	LOTACL
/
/
/
/
/
TEST37,	0
	CDF	20
	TAD I	(WCBFIA		/TEST IF 37=RESTART RECEIVED
	SPA	CLA
	JMP	.-2		/WAIT FOR FULL BUFFER
	JMS	CLBFIA
	CDF	20
	TAD I	(ETBFIA
	AND	[RUBOUT
	CIA
	TAD	(37
	SZA	CLA
	JMP	TEST37+1	/WAIT FOR NEXT FULL BLOCK AND TEST
	DCA I	(ETBFIA
	CDF	0
	JMP I	TEST37
	PAGE
/		* I D L E J O . B R *
/
/
IDLEJ1,	TAD	(-5
	DCA	IDCN0
IDLEJO,	TAD	WCBFOB
	SPA	CLA
	JMP	LAB1
LAB3,	CDF	20
	TAD I	(WCBFOA
	CDF	0
	SPA SNA CLA
	JMP	LAB2		/BUFFER OA IS NOT FREE
	JMS	WRITEL
LAB1,	JMS	INFOGE		/BUFFER OB IS FREE
LAB2,	CDF	20
	TAD I	(WCBFIA		/TEST INPUT A IF FULL WC&gt;=0
	CDF	0
	SPA	CLA
	JMP	LAB4
	TAD	WCBFIB		/BFIA IS FULL !
	SMA	CLA
	JMS	READL		/B IS EMPTY
	JMP	LAB4
LAB4,	TAD	WCBFIB		/TEST IF B IS EMPTY WC&gt;=0
	SPA	CLA
	JMS	INFOPU		/IT IS NOT EMPTY SAVE INFO
	JMS	FILEM		/READ	OR WRITE OS8 , TEST POINTERS ETC
	TAD	EOIFLG		/DO NOT CALL CDEC IF WE WAIT FOR CANCEL
	SZA	CLA
	JMP	NOCDEC
	CIF	20
	TAD	WCCD		/COMMANDS TO DECODE?
	SPA	CLA
	JMS	CDEC		/YES
NOCDEC,	CIF	CDF	0
	IFNDEF MTTY &lt;
	KRB
	TAD	(-203
	SNA	CLA
	JMP	SHUTD &gt;
	JMP	IDLEJO
/
/	END OF IDLEJOB
/
MOVE,	0			/GENERAL MOVE ROUTINE
	RDF
	TAD	[CIF CDF 0
	DCA	MOVER
	M1
	TAD	MOVE
	DCA	X0		/USES AUTOINDEX X0 TO X2
	TAD I	X0
	DCA	FRMFLD
	STA
	TAD I	X0
	DCA	X1
	TAD I	X0
	DCA	TOFLD
	STA
	TAD I	X0
	DCA	X2
	TAD I	X0
	DCA	MVC		/NUMBER OF WORDS
FRMFLD,	HLT
	TAD I	X1
TOFLD,	HLT
	DCA I	X2
	ISZ	MVC
	JMP	FRMFLD
MOVER,	HLT
	JMP I	X0		/RETURN
MVC,	0
/
/
/
/
/
/
/
/
READL,	0
	JMS	MOVE
	ETHA
	ETBFIA
	ETHB
	ETBFIB
	ETHLE
	JMS	CLBFIA
	JMS	CLBFIB
	ISZ	FREAD		/FIRST READ ?
	JMP	.+6
	CDF	10
	TAD I	(ETBFIB+1
	CDF	0
	AND	(7
	DCA	EXPNO
	DCA	FREAD
	JMS	REBLO		/SAVE HEADER
	JMP I	READL
FREAD,	-1
IDCN0,	0
VIERZG,	0
	TAD	[40
	DCA I	X3
	JMP I	VIERZG

QSLNEC,	0			/ROUTINE TO TEST IF QSL IS NECESSARY
	TAD	SEQSL
	TAD	[-20
	SMA	CLA
	JMP	QSLN1		/NEC, IT IS NEG QSL
	TAD	RECNO
	CIA
	TAD	SEQSL
	SNA	CLA
	JMP I	QSLNEC		/NEED NO QSL
QSLN1,	ISZ	QSLNEC
	JMP I	QSLNEC
	PAGE
/
/
/
/	ROUTINE TO GET INFO FROM LO BUFFERS AND FILL IN BFOB
/
INFOGE,	0
	JMS	SENALL		/IS SEND ALLOWED
	JMP I	INFOGE		/NO
	TAD	WFLG		/DO WE HAVE TO WAIT FOR EXPECTED BLOCK
	SZA	CLA
	JMP I	INFOGE		/YES
	TAD	WCLO0		/TEST LO0 BUF FOR INFO
	SPA	CLA
	JMP	LAB8		/LO0 INFO
LAB10A,	JMS	QSLNEC
	JMP I	INFOGE
	TAD	WCLO1
	SPA	CLA
	JMP	LAB9		/LO1 INFO
	JMS	STOPST		/NO LO1 INFO, CLEAR LO1 STATUS
	DLO1
LAB10,	CLA	CLL
	JMS	VORSP		/FILL IN QSL
	0			/STREAM NUMBER 0
	CDF	10
	TAD	[40		/FILL IN NOP
	DCA I	X3		/FILL REST WITH 0
	ISZ	WCBFOB
	JMP	.-2
	CDF	0
	JMP I	INFOGE		/RETURN
LAB8,	JMS	VORSP		/FILL IN ETBFOB STREAM 0 INFO
	0
	JMS	FILOET		/STREAM IN SSTRM=0
	JMP I	INFOGE
	IFNDEF SIMOUT &lt;
LAB9,	TAD	RSTAT		/TEST IF LO1 IS DEFINED
	AND	(DLO1
	SNA	CLA
	JMP	LAB10 &gt;		/QSL NECESSARY
	IFDEF	SIMOUT &lt;
LAB9,	&gt;
	JMS	VORSP
	1
	JMS	FILOET		/STREAM IN SSTRM
	JMP I	INFOGE
/
/	END OF INFOGE
/
/
/
/
VORSP,	0
	TAD	(ETBFOB-1
	DCA	X3		/SET UP POINTER, USES AUTOINDEX X3
	TAD I	VORSP		/FETCH ARGUMENTS STREAMBUFFERPOINTERS
	DCA	SSTRM
	TAD I	VORSP
	CDF	10
	JMS	VIERZG
	ISZ	VORSP
	TAD	SENDNO		/NUMBER OF BLOCK FOR SEND
	JMS	VIERZG
	TAD	SENDNO		/INCREMENT NO IN MODULO 17B
	IAC
	AND	[17
	DCA	SENDNO
	TAD	SEQSL		/TEST FOR NEGATIVE QSL
	TAD	(-20
	SPA	CLA
	JMP	VORS1		/NOT NEGATIVE
	TAD	SEQSL
	JMS	VIERZG
	TAD	SEQSL
	DCA	OLDQSL
	TAD	RECNO
	DCA	SEQSL
	P1
	DCA	WFLG		/SET WAIT ON EXPECTED BLOCK FLAG
	JMP	VORS2		/SEND ONLY ONE NEG QSL
VORS1,	TAD	SEQSL
	CIA
	TAD	RECNO
	SZA	CLA
	P1
	TAD	SEQSL
	AND	[17
	DCA	SEQSL
	TAD	SEQSL
	DCA	OLDQSL
	TAD	SEQSL
	JMS	VIERZG
VORS2,	TAD	SSTAT
	CLL RAL
	BSW
	AND	(3
	JMS	VIERZG
	TAD	SSTAT
	AND	(37
	JMS	VIERZG
	CDF	0
	TAD	WCBFOB
	TAD	(4		/SET PROPERWC, POINTER IS AUTOINDEX
	DCA	WCBFOB
	JMP I	VORSP
/
/	END OF VORSP
/
WFLG,	0
REPOFI,	0
	P4
	CIA
	TAD	X3
	SNA	CLA
	JMP I	REPOFI		/NEVER OVERWRITE VORSPAN
	JMS	MINUS
	X3
	JMS	MINUS
	WCBFOB
	JMS	MINUS
	WC2
	JMP I	REPOFI
	PAGE
/
/
/
/	FILOET	ROUTINE TO FILL ETHB OUT BUFFER
/
FILOET,	0
	JMS	FILOE1
	TAD	(-730
	DCA	WC2
	TAD	SSTRM
	SNA	CLA
	JMP	FILO0
FILO4,	TAD	LO1
	DCA	GETP
	TAD	WCLO1
	DCA	WC1
	JMP	FILO3
FILO0,	TAD	LO0
	DCA	GETP
	TAD	WCLO0
	DCA	WC1
FILO3,	JMS	NEWF		/NEW FILE?
	JMS	FETCHC		/FETCH CHAR, RETURN+1 IF WITH CHAR
	JMP	LAB12		/NO MOORE CHARS
	DCA	SCHAR
	JMS	CHATE
	CR			/TEST FOR CR
	JMP	LAB12A
	JMS	CHATE
	LF
	JMP	FILO3
	JMS	CHATE
	FFEED
	JMP	FILO3
	JMS	CHATE
	0
	JMP	FILO3
	JMS	CHATE
	CTRLTA
	JMP	LAB15
	TAD I	LASTSX
	DCA	.+2
	JMS	CHATE		/TEST FOR SAME CHAR AS LAST
	HLT
	JMP	LAB16
	JMS	REPO
	TAD	SCHAR
	DCA I	LASTSX
FILO5,	JMS	CHATE
	CTRLZ
	JMP	LAB14
	JMS	PUTCA
LAB13,	TAD	WC2		/MOORE ROOM?
	SPA	CLA
	JMP	FILO3		/YES
	JMS	SETLOX
	JMP I	FILOET
WC2,	0
LAB12A,	JMS	REPO
	TAD	SCHAR
	DCA I	LASTSX
	JMS	PUTCA		/CR PRCESSING
	TAD	[LF
	JMS	PUTCA
	TAD	(-7
	DCA I	TABSX
	JMP	LAB13
LAB12,	JMS	REPO
LAB12B,	JMS	FILOE2		/COMES TO HERE IF NO MORE CHARS
FILOER,	JMP I	FILOET
LAB14,	TAD	SSTRM
	SNA CLA
	JMP	LAB12		/ALWAYS EOI ON LO0
	JMS	REPO
	TAD	EOIFLG		/EOI?
	SZA	CLA
	JMP	ISEOI1
	TAD	[EOR
	JMS	PUTCA
	P1
	DCA	WC1		/SET WC1 TO 1
	JMP	LAB12B
LAB15,	JMS	TAB
	JMP	FILO3
/
/
LAB16,	TAD	SSTRM
	SNA	CLA
	JMP	FILO5		/NO REP ON LO0
	ISZ I	REPSX		/REPCN INCREMENT
	TAD	(-100
	TAD I	REPSX		/REPCOUNTER SHOULD NOT BE GREATER THEN 100
	SPA	CLA
	JMP	FILO3		/IT IS LESS THEN 100
	M1
	TAD I	REPSX
	DCA I	REPSX		/THIS CHAR IS TREATED NEXT TIME
	JMS	REPO		/GT THEN 100, CLEAR IST
	JMP	FILO5		/PUT THIS CHAR IN BUFFER
/
/
/
SETLOX,	0
	JMS	OBF0
	TAD	SSTRM
	SZA	CLA
	JMP	.+6
	TAD	GETP
	DCA	LO0
	TAD	WC1
	DCA	WCLO0
	JMP I	SETLOX
	TAD	GETP
	DCA	LO1
	TAD	WC1
	DCA	WCLO1
	JMP I	SETLOX
/
/
	PAGE
/
/
/
FILOE1,	0
	TAD	SSTRM
	TAD	(LASTCS
	DCA	LASTSX
	TAD	SSTRM
	TAD	(REPCNS
	DCA	REPSX
	TAD	SSTRM
	TAD	(SWISE
	DCA	SWISX
	TAD	SSTRM
	TAD	(NEWFS
	DCA	NEWFSX
	TAD	SSTRM
	TAD	(BITO3
	DCA	BITO3X
	TAD	SSTRM
	TAD	(TABSCN
	DCA	TABSX
	JMP I	FILOE1
/
/
/	END OF FILOE1
/
/
FILOE2,	0
	TAD	SSTRM
	SZA	CLA
	JMP	FILOE3		/STREAM LO1
	DCA	WCLO0
	JMS	OBF0		/FILL REST WITH 0
	JMP I	FILOE2
FILOE3,	TAD	GETP
	DCA	LO1
	TAD	WC1
	DCA	WCLO1
	JMS	GETLO1
	TAD	WCLO1
	SPA CLA
	JMP	FILO4		/RETURN FOR UNPACK 
	JMS	OBF0
	JMP I	FILOE2
/
/	END OF FILOE2
/
/
/
/
/	FETCHC	ROUTINE TO FETCH CHARS FROM LOX BUFF
/	INFO MAY BE PACKED OR NOT
FETCHC,	0
	TAD	WC1		/DO WE HAVE INFO?
	SMA	CLA
	JMP I	FETCHC		/NO
	P1
	TAD I	SWISX		/GET CHAR SWITCH
	TAD	INJMP0
	DCA	INJMP2
INJMP2,	HLT			/CONTAINS JMP TO CHAR
	JMP	CHAR1
	JMP	CHAR2
	DCA I	SWISX		/CLEAR UNPACK SWITCH
	JMS	GETPO
	BSW; CLL	RTR
	AND	[17
	TAD I	BITO3X		/REST OF 3RD CHAR
	JMP	FETCHR		/RETURN WITH CHAR IN AC
CHAR1,	ISZ I	SWISX
	JMS	GETPO
	RTR;	RTR
	AND	(360
	DCA I	BITO3X
	JMS	GETPO
	JMP	FETCHR
CHAR2,	ISZ I	SWISX
	JMS	GETPO
	AND	[RUBOUT
	ISZ	FETCHC
	JMP I	FETCHC
FETCHR,	AND	[RUBOUT
	ISZ	GETP
	ISZ	WC1
	NOP
	ISZ	FETCHC		/WE HAVE A CHAR
	JMP I	FETCHC
INJMP0,	JMP	INJMP2
BITO3X,	0
/
/
/
/
/
/
REPO,	0
	TAD I	REPSX
	SNA	CLA
	JMP I	REPO		/NOTHING TO DO
	JMS	REPOFI
	TAD I	REPSX
	TAD	(-3
	SPA	CLA		/IS REPSEQUENCE BIG ENOUGH
	JMP	NOREP
	TAD	(SOH
	JMS	PUTCA		/PUT SOH IN BUF
	TAD	(35
	TAD I	REPSX
	JMS	PUTCA
	TAD I	LASTSX
	JMS	PUTCA
	DCA I	REPSX
	JMP I	REPO
NOREP,	P1				/X3 WAS SET ONE BACK!!
	TAD I	REPSX
	CIA
	DCA I	REPSX
NOREP1,	TAD I	LASTSX
	JMS	PUTCA
	ISZ I	REPSX
	JMP	NOREP1
	JMP I	REPO
GETPO,	0
	CDF	10
	TAD I	GETP
	CDF	0
	JMP I	GETPO
	PAGE
PUTCA,	0
	SNA			/ENTER WITH OR WITHOUT CHAR
	TAD	SCHAR
	CDF	10
	DCA I	X3
	CDF	0
	ISZ	WCBFOB
	ISZ	WC2
	NOP
	ISZ I	TABSX
	JMP I	PUTCA
	TAD	(-7
	DCA I	TABSX
	JMP I	PUTCA
/
/
/
/
/
/
/
/
NEWF,	0
	TAD I	NEWFSX		/NEW FILE?
	SNA CLA
	JMP I	NEWF		/NO
	DCA I	NEWFSX		/YES
	DCA I	REPSX
	TAD	(-7
	DCA I	TABSX
	TAD	(AD
	JMS	PUTCA		/PUT AD IN BUF
NEWF1,	DCA I	SWISX
	JMP I	NEWF
/
/
/
TAB,	0
	JMS	REPO		/CLEAR REPO FIRST
	JMS	PUTCA		/REPO SETS C(X3)=X(X3)-1 
	TAD	[40
	DCA I	LASTSX
	TAD I	TABSX
	CIA
	DCA I	REPSX
	TAD	(-7
	DCA I	TABSX
	JMS	REPO
	JMP I	TAB
CHATE,	0
	TAD I	CHATE		/CHARACTER TEST ROUTINE
	AND	[RUBOUT
	CIA
	TAD	SCHAR
	AND	[RUBOUT
	ISZ	CHATE
	SZA	CLA
	ISZ	CHATE
	JMP I	CHATE
/
/
/
SENALL,	0
	TAD	SENDNO
	CIA
	TAD	REQSL
	SMA	CLA
	TAD	[20
	TAD	SENDNO
	CIA
	TAD	(DIFF
	TAD	REQSL
	SMA	CLA
	ISZ	SENALL
	JMP I	SENALL
/
/
/
/
/
INFG,	0			/FILEPOINTER LO1 INCREMENT ROUTNE
	TAD	LO1FG
	IAC
	DCA	LO1FG
	TAD	LO1FG
	CIA
	TAD	(LO1FMA		/IT IS A RING BUFFER MAX EXEEDED?
	SMA	CLA
	JMP I	INFG
	TAD	(LO1FMI
	DCA	LO1FG
	JMP I	INFG
/
/
/
/
/
M2FG,	0			/SETS FILEPOINTER 2 BACK
	M2			/-3 IN AC
	TAD	LO1FG
	DCA	LO1FG
	TAD	(LO1FMI
	CIA
	TAD	LO1FG		/AC MUST BE .GE. 0
	SMA
	JMP	.+3
	TAD	(LO1FMA+1
	DCA	LO1FG
	CLA	CLL
	JMP I	M2FG
/
/
/
/
/
/
/
USRIN,	0
	JMS	FLD0
	DCA	USRINR
	TAD	USRINS		/TEST IF USR ALREADY IN CORE
	SZA CLA		/SKIP IF NOT
	JMP	USRINR		/ ALREADY IN CORE
	P1
	DCA	USRINS
	CIF	10
	JMS I	(7700
	10
USRINR,	HLT
	JMP I	USRIN
USRINS,	0			/IF INIT, USR IS NOT IN CORE
/
/
/
/
/
USROUT,	HLT			/MAY NOT BE 0 FOR INTIT
	JMS	FLD0
	DCA	USROUR
	TAD	USRINS
	SNA CLA
	JMP	USROUR
	DCA	USRINS
	CIF	10
	JMS I	(200
	11
USROUR,	HLT
	JMP I	USROUT
	PAGE
/
/
/
GETLO1,	0			/ROUTINE TO FETCH LO1 INFO FROM OS8 DEV
	JMP I	.+1		/THIS IS FOR REENTRY OF ROUTINE
LO1NEX,	STARGE
	JMP I	GETLO1
STARGE,	TAD	WCLO1
	SPA	CLA
	JMP I	GETLO1		/NOTHING TO DO
	TAD I	LO1FG		/IS THERE INFO IN FILETABLE
	AND	(4000
	SNA	CLA
	JMP I	GETLO1		/NO
	TAD I	LO1FG
	AND	(77		/TEST FOR TTY
	SNA	CLA
	P1
	DCA	CALAC		/THIS IS AC FOR HANLDER CALL
	JMS	INFG		/INCR POINTER
	TAD I	LO1FG		/FETCH BLOCKNUMBER
	DCA	GETBLO
	TAD	CALAC
	JMS I	LO1HA
	-LO1BUL%2+10
	LO1BU
GETBLO,	0
	JMP	LO1ERR
	TAD	CALAC		/WAIT FOR TTY
	SNA	CLA
	JMP	NOTTTY
	SKP
	JMS	LO1NEX
	CDF	20		/NEXT ENTRY IS HERE
	M2
	TAD I	(RF		/TEST IF READFLAG IS 2
	CDF	0
	SNA	CLA
	JMP	.-6		/WAIT RF=2
	JMS	LO1SUB		/SET POINTERS AND WC
	JMS	LO1STA		/RESTORE ENTRY
	JMS	INFG
	TAD	TTYZF
	SZA	CLA
	JMP	LO1EOF
	JMP	OSRET
NOTTTY,	JMS	LO1SUB
	TAD	(-LO1BUL%400	/UPDATE WC AND CA
	TAD I	LO1FG
	DCA I	LO1FG
	JMS	INFG
	TAD	(-LO1BUL%400
	TAD I	LO1FG
	SMA
	JMP	LO1EOF
	DCA I	LO1FG
OSRET,	JMS	M2FG		/RESET POINTER
	DCA I	(SWISE+1
	JMP I	GETLO1
/
/
MORLO1,	JMS	USRIN
	TAD I	LO1FG
	JMS	FETCHH
	7400			/HANDLER FOR LO1 IF NOT SYS OR DSK
LO1HA,	0			/ENTRY FOR LO1HANDLER
	JMS	USROUT
	JMS	LO1NEX
	TAD	WCLO1
	SPA	CLA
	JMP	.-3		/WAIT FOR LO1 EMPTY
	P1
	DCA I	(NEWFS+1		/SET NEW FILE
	JMS	LO1STA		/RESTORE ENTRY
	JMP	STARGE
CALAC,	0
/
/
/
/
LO1EOF,	JMS	M2FG		/RESET POINTER
	JMS	FINTAC		/CLEAR OLD FILE ENTRIES
	JMP	MORLO1
	JMS	LOTACL
	P1
	DCA	EOIFLG		/SET EOI FLAG
	DCA I	(SWISE+1
	SKP
	JMS	LO1NEX
	TAD	EOIFLG
	SZA	CLA
	JMP	.-3
	P1
	DCA I	(NEWFS+1
	SKP
	JMS	LO1NEX		/NEXT ENTRY TO GETLO1 WILL GO HERE
	TAD	WCLI0
	SMA	CLA
	JMP	.-3
	JMS	TELE
	LO1MSG
	JMS	SEND0
	JMS	TTYOUT
	JMS	LO1STA
	JMP I	GETLO1
/
/
/
ISEOI1,	DCA	EOIFLG
	TAD	[EOI
	JMS	PUTCA
	JMS	OBF0
	P1
	DCA	WCLO1
	JMS	LOTACL		/CLEAR FILETABEL EOI, MAY BE FORCED
	JMP	FILOER		/RETURN FROM FILOET
	PAGE
/
FINTAC,	0			/CLEAR FILENAMETABLE ENTRY
	TAD	(-3
	DCA	GETCN
	DCA I	LO1FG
	JMS	INFG
	ISZ	GETCN
	JMP	.-3
	TAD I	LO1FG		/MORE ENTRIES?
	AND	(4000
	SZA	CLA
	JMP I	FINTAC
	ISZ	FINTAC
	JMP I	FINTAC
GETCN,	0
/
FETCHH,	0			/FETCH DEVICEHANDLE, ENTER WITH 
/DEVICENUMBER IN AC, DEVICEENTRY IS SOTRED AFTER CALLING LOC
	AND	(77
	DCA	FET5
	RDF
	TAD	[CIF CDF 0
	DCA	FET4
	RDF
	TAD	(CDF 0
	DCA	FET3
	TAD I	FETCHH		/FETCH HANDLER ADDR
	ISZ	FETCHH
	DCA	FET1
	TAD	FET5
	SZA	CLA			/TEST FOR TTY WHICH IS SPECIAL
	JMP	FET2
	TAD	(TTYIN
	JMP	FET3
FET2,	CIF	CDF	0
	JMS I	(USRIN		/LOAD USR IF NOT YET IN CORE
	CDF	0
	CIF	10
	TAD	FET5
	JMS I	(200
	1
FET1,	HLT
	HLT			/ERROR HALT
	TAD	FET1
FET3,	HLT
	DCA I	FETCHH
	ISZ	FETCHH
FET4,	HLT
	JMP I	FETCHH
FET5,	0
/
LO1ERM,	TEXT /LO1 ERROR/
/
/
/
/
/
LO1ERR,	0
	JMS	CLLI0
	JMS	TELE
	LO1ERM
	JMS	SEND0
	JMS	TTYOUT
	JMS	CLLO1
	CDF	10
	TAD	(232		/SIMULATE ^Z
	DCA I	LO1
	CDF	0
	JMP	LO1EOF
/
/
/
/
/
LO1STA,	0			/ROUTINE TO RESTORE ENTRY OF GETLO1
	TAD	(STARGE
	DCA	LO1NEX
	JMP I	LO1STA
/
/
/
/
/
/
/
/
/
LO1SUB,	0
	CLL	CLA
	JMS	CLLO1
	JMS	GOSTR
	DLO1
	JMS	USROUT
	JMP I	LO1SUB
/
/
/
/
LO1MSG,	TEXT /EOI LO1/

WNEGQ,	JMS I	[DOSA2
WNEGQ2,	JMS	ETHF40
	DCA	NUMBER		/WAITING FOR CORRECT BLOCK
	TAD	REQSL
	DCA	WNEG1
	JMS	MOD17I
	TAD	NUMBER
	SNA	CLA		/IS IT A GOOD QSL
	JMP	GOODQ
	JMS	MOD17I
	TAD	NUMBER
	SNA	CLA
	JMP	GOODQ
	JMP	LAB22		/IGNORE
GOODQ,	TAD	NUMBER
	DCA	REQSL		/MAKES SEND ALLOWED
	JMP	LAB22
WNEG1,	0
ETHF40,	0
	JMS	ETHF
	HLT
	TAD	[-40
	JMP I	ETHF40
	PAGE
/
/
INFOPU,	0
	TAD	WCBFIB		/NEW ETH BLOCK?
	CIA
	TAD	[ETHLE
	SZA	CLA
	JMP 	LAB20		/NO
	STA			/SET UP POINTERS
	TAD	BFIB
	DCA	X4		/AUTOINDEX X4 FOR FETCH
	JMS	ETHF		/FETCH CHAR FROM ETH
	JMP	LAB22		/CAN NOT USE A NULL BUFFER
	DCA	RCHAR
	JMS	CHATER		/IS CONNECTION RESTARTET?
	37
	JMP	RESTAR		/YES
	JMS	CHATER
	36
	JMP	DRIVMS		/DRIVERMSG?
	JMS	OKSTR		/TEST IF IT IS A POSSIBLE STREAM
	JMS	NEGQSL		/IT IS NOT, THIS INFO IS NONSENCE
	TAD	RCHAR
	TAD	[-40
	DCA	RSTRM		/SAVE STREAMNO
	TAD	RSTRM		/TEST IF STREAM IS DEFINED, IF YES
				/INCREMENT EXPECTED NO
	CLL RAR			/STREAM NO IS 0,2,4 OR 6 =0,1,2,3
	TAD	(STRBIT
	DCA	STROM
	TAD I	STROM 		/GET BITRANGE
	AND	DEFSTR
	SNA	CLA
	JMP	LAB22		/STREAM NOT DEFINED
	JMS	ETHF40
	DCA	NUMBER		/BLOCKN - RECEIVED
	TAD	NUMBER
	CIA
	TAD	EXPNO		/IS IST EXPECTED NUMBER?
	SNA	CLA
	JMP	LAB21		/YES
	TAD	NEGQFL		/WAITING FOR NEGATIVE REJECTED BLOCK?
	SZA	CLA
	JMP	WNEGQ		/YES
	JMP	BIGN		/IS NUMBER GREATER THEN EXPECTED
NEGQSL,	0
	JMS	WOHER
	TAD	EXPNO
	TAD	[20
	DCA	SEQSL		/SET NEGATIVE QSL
	P1
	DCA	NEGQFL		/SET NEG FLAG
	JMP	WNEGQ2		/TEST REQSL TO MAKE SEND ALLOWED
LAB22,	DCA	WCBFIB		/SET BUFFER TO SUPPLY WC=0
	JMP I	INFOPU
LAB21,	JMS	WOHER2
	DCA	NEGQFL		/CLEAR NEG QSL FLAG
	DCA	WFLG
	TAD	NUMBER
	DCA	RECNO		/SAVE RECEIVED NO
	JMS	ETHF40		/SAVE RECEIVED QQSL
	DCA	REQSL		
	JMS	ETHF40		/STREAM STATUS
	BSW
	AND	(100
	DCA	RCHAR
	JMS	ETHF40
	AND	(37
	TAD	RCHAR
	DCA	RSTAT		/R
	JMS	CANCLE
	TAD	EXPNO
	IAC
	AND	[17		/INCREMENT STREAM NUMBER
	DCA	EXPNO
	TAD	RSTRM		/TEST OPCODE FOR STREAM 0 ONLY
	SZA	CLA
	JMP	LAB20		/IT IS NOT STREAM 0
	JMS	ETHF
	HLT
	DCA	RCHAR
	JMS	CHATER
	AD			/IGNORE AD
	JMP	.-5
	TAD	RCHAR
	TAD	[-43
	DCA	BF5
	ISZ	BF5		/ -1 TO -3 SHOULD BE IN BF5
	SKP
	JMP	SHUTD		/ OPCODE 42=SHUTDOWN
	ISZ	BF5
	SKP
	JMP	LAB20		/OPCODE 41=INFO
	ISZ	BF5
	SKP
	JMP	LAB22		/OPCODE 40=NOP
	TAD	EXPNO		/ERROR UNDEFINED OPCODE
	TAD	[17		/IS -1 MODULO 20
	AND	[17
	DCA	EXPNO
	JMS	NEGQSL		/SET NEGATIVE QSL
LAB20,	JMS	PUTIN
	JMP I	INFOPU
DRIVMS,	DCA	RSTRM
	JMP	LAB20			/SIMULATE STREAM 0
STROM,	0			/STROM CONTAINS ADDRESS TO VALID
STRBIT,	DLI0			/STREAM BIT MASC
	DLI1
	DLI2
	DLI3
TEMP4,	0
BF5,	0			/CONTAINS OP CODE 0  1 2 FROM ETH
NEGQFL,	0
NUMBER,	0			/BLOCK NUMBER TEMPORARY
/
/
/



	PAGE
MOD17I,	0
	P1
	TAD	WNEG1
	AND	[17
	DCA	WNEG1
	TAD	WNEG1
	CIA
	JMP I	MOD17I
/
/
/
/
/
PUTIN,	0
	JMS	SETLIX
	TAD	WCLIX
	SMA	CLA
	JMP I	PUTIN
	TAD	RSTRM
	TAD	(JMP	LAB23+1
	DCA	LAB23
LAB23,	HLT
	JMS	LABLI0
	JMP I	PUTIN
	JMS	LABLI1
	JMP I	PUTIN
	JMS	LABLI2
	JMP I	PUTIN
	JMS	LABLI3
	JMP I	PUTIN
/
/
LABLI0,	0
	TAD	WCLI0
	SPA	CLA
	JMS	FILLI0
	JMP I	LABLI0
/
/
/
LABLI1,	0
	JMS	MORERO		/DO WE HAVE ROOM?
	JMP I	LABLI1		/NO
	JMS	LPFILL
	JMS	SAVLI1
	JMP I	LABLI1
/
/
/
LABLI2,	0
	JMS	FILLI2
	JMS	RESWC
	TAD	WCBFOB
	SPA	CLA
	JMP I	LABLI2
	JMS	GOSTR
	DLI2
	JMP I	LABLI2
/
/
/
LABLI3,	0
	JMS	FILLI2
	JMS	RESWC
	TAD	WCBFOB
	SPA CLA
	JMP I	LABLI3
	JMS	GOSTR
	DLI3
	JMP I	LABLI3
/
/
/
/
/
SETLIX,	0
	TAD	RSTRM
	CLL	RAR		/0 1 2 OR 3 IN AC
	AND	(3
	DCA	TEMP4
	TAD	TEMP4
	TAD	(TAD I	LIXX
	DCA	.+1
	HLT
	DCA	LIX
	TAD	TEMP4
	TAD	(TAD I	WCLIXX
	DCA	.+1
	HLT
	DCA	WCLIX
	TAD	TEMP4
	TAD	(LASTCR
	DCA	LASTRX
	TAD	TEMP4
	TAD	(REPCNR
	DCA	REPRX
	TAD	TEMP4
	TAD	(SWIRE
	DCA	SWIRX
	TAD	TEMP4
	TAD	(REPFLG
	DCA	REPFX
	TAD	TEMP4
	TAD	(EORFLG
	DCA	EORFX
	TAD	TEMP4
	TAD	(CRFLG
	DCA	CRFLGX
	JMP I	SETLIX
LIXX,	LI0; LI1; LI2; LI3
WCLIXX,	 WCLI0; WCLI1; WCLI2; WCLI3
/
/
/
/
/
RESWC,	0
	TAD	TEMP4
	TAD	(DCA I	LIXX
	DCA	.+2
	TAD	LIX
	HLT
	TAD	TEMP4
	TAD	(DCA I	WCLIXX
	DCA	.+2
	TAD	WCLIX
	HLT
	JMP I	RESWC
	PAGE
/
ETHF,	0
ETHF1,	TAD	WCBFIB
	SMA CLA
	JMP I	ETHF		/NO MOORE CHARS
	CDF	10
	TAD I	X4
	AND	[RUBOUT
	CDF	0
	ISZ	WCBFIB		/INCREMENT WC
	NOP
	SNA
	JMP	ETHF1		/DO NOT RETURN WITH A 0
	ISZ	ETHF		/RETURN+1
	JMP I	ETHF
/
/
/
FILLI0,	0			/ROUTINE TO FILL IN LI0 BUFFER
	TAD	(PUTI0
	DCA	PUTRUT
LAB32,	JMS	ETHF
	JMP	LAB34B		/BUFFER FINITO
	DCA	RCHAR
	TAD I	REPFX		/TEST REPFLG
	SZA	CLA
	JMP	REPIN0
	TAD I	EORFX
	SZA	CLA
	JMP	EORPI0
	JMS	CHARSP		/TEST FOR SPECIAL CHARS
	JMP	LAB32		/IGNORE 0
	JMP	EORP0		/EOR
	JMP	EORP0		/EOF, DO SAME AS FOR EOR
	JMP	EOIPI0		/EOI
	JMP	NORM0
	JMP	LAB32		/IGNORE LF
	JMP	REP0		/REPETITION
NORM0,	JMS	PUTI0
	SKP			/LI0 IS FULL
	JMP	LAB32
LAB34C,	JMS	ETHFMI		/BUFFER FULL, DECREMTN POINTER AND WC
LAB34,	JMS	RESWC
	JMS	TTYOUT
	JMP I	FILLI0
LAB34B,	DCA	RCHAR
	JMS	PUTI0
	JMP	LAB34
	JMP	.-2
EORP0,	P1
	DCA I	EORFX
	TAD	[CR
	DCA	RCHAR
	JMP	NORM0
/
/
REP0,	P1
	DCA I	REPFX
	JMP	LAB32
/
/
REPIN0,	JMS	REPIN
	JMP	LAB34		/BUFFER FULL
	JMP	LAB32
/
/
EORPI0,	DCA I	EORFX		/CLEAR FLAG
	JMP	LAB32
/
EOIPI0,	DCA	RCHAR		/FILL REST WITH 0
	JMS	PUTI0
	SKP
	JMP	.-2
	JMS	INEOI
	JMP	LAB34
/
/
/
/
/
/
PUTI0,	0
	TAD	WCLIX
	SMA	CLA
	JMP I	PUTI0		/BUFFER FULL
	TAD	RCHAR
	SZA
	TAD	(200		/FORCE PARBIT ON
	CDF	10
	DCA I	LIX
	CDF	0
	ISZ	LIX
	ISZ	WCLIX
	ISZ	PUTI0		/INCREMENT RETURN IF NOT FULL
	JMP I	PUTI0
/
/
/
/
/
CHARSP,	0			/SPECIAL CHARAKTER TEST ROUTINE
	TEST=JMS I	TEMP8
	RETOUR=JMP I	CHARSP
	INCRE=ISZ	CHARSP
/
/	THIS IS ONLY TO MAKE IT EASY
/
	TEST			/ TEST FOR 0
	0
	RETOUR
	TEST
	AD
	RETOUR			/TEST FOR AD, SAME RETURN AS 0
	INCRE
	TEST			/TEST FOR EOR
	EOR
	RETOUR
	INCRE
	TEST			/TEST FOR EOF
	EOF
	RETOUR
	INCRE
	TEST			/TEST FOR EOI
	EOI
	RETOUR
	INCRE
	TEST			/TEST FOR CR
	CR
	RETOUR
	INCRE
	TEST			/TEST FOR LF
	LF
	RETOUR
	INCRE
	TEST			/TEST FOR REP
	SOH
	RETOUR
	INCRE
	RETOUR
TEMP8,	CHATER

ETHFMI,	0			/REOUTINE TO DECREMENT X4 AND WCBFIB
	JMS	MINUS
	X4
	JMS	MINUS
	WCBFIB
	JMP I	ETHFMI
	PAGE
DEFINE,	0
	TAD I	DEFINE
	CMA
	AND	DEFSTR
	TAD I	DEFINE
	DCA	DEFSTR
	TAD	DEFSTR
	DCA	SSTAT
	ISZ	DEFINE
	JMP I	DEFINE
/
/
/
MORERO,	0			/ROUTINE TO TEST SPACE FOR MORE ROOM
	CDF	10
	TAD	LPPUT
	TAD	(LI1BU
	DCA	LPPTOT
	TAD I	LPPTOT
	CDF	0
	SNA	CLA
	ISZ	MORERO
	JMP I	MORERO
/
/
REPIN,	0
	TAD I	REPFX
	TAD	(JMP REPINA
	DCA	REPINA
REPINA,	HLT
	JMP	REPCN		/1 IS REPCOUNTER SET UP
	JMP	REPCA		/2 IS REPCHARACTER 
	JMS	ETHFMI		/REENTRY, BUFFER WAS FULL
	TAD I	LASTRX
	DCA	RCHAR
BUFIL,	JMS I	PUTRUT
	JMP	REPD		/BUFFER IS FULL
	ISZ I	REPRX
	JMP	BUFIL
	JMS	REPDON
REPR,	ISZ	REPIN
	JMP I	REPIN


REPCN,	TAD	RCHAR
	TAD	(-34
	CIA
	TAD I	CRFLGX		/ONE LESS IF BEGINNING OF A LINE
	DCA I	REPRX
	ISZ I	REPFX
	JMP	REPR

REPCA,	TAD	RCHAR
	DCA I	LASTRX
	ISZ I	REPFX
	JMP	REPR

REPD,	ISZ I	REPRX
	JMP I	REPIN
	JMS	REPDON
	JMP I	REPIN

REPDON,	0
	DCA I	LASTRX
	DCA I	REPFX
	DCA I	CRFLGX
	JMP I	REPDON
PUTRUT,	0
/
/
/
PUTLP,	0		/PUT INFO IN LP BUFFER
	SZA			/ENTER WITH OR WITHOUT CHAR
	DCA	RCHAR
	TAD	LPPUT
	TAD	LI1
	DCA	LPPTOT
	TAD	RCHAR
	AND	[RUBOUT
	TAD	(200
	CDF	10
	DCA I	LPPTOT
	CDF	0
	TAD	LPPUT
	IAC
	AND	(-LI1BUL
	DCA	LPPUT
	JMS	MORERO
	SKP
	ISZ	PUTLP		/INCREMENT RETURN IF CHAR
	JMP I	PUTLP
/
/
/
/
/
/
CHATER,	0
	TAD I	CHATER
	AND	[RUBOUT
	CIA
	TAD	RCHAR
	AND	[RUBOUT
	ISZ	CHATER
	SZA	CLA
	ISZ	CHATER
	JMP I	CHATER
/
/
/
/
/
MINUS,	0
	TAD I	MINUS
	ISZ	MINUS
	DCA	MINUS1
	M1
	TAD I	MINUS1
	DCA I	MINUS1
	JMP I	MINUS
MINUS1,	0


OKSTR,	0
	TAD	(OKSTRT-1		/ROUTINE TO TEST IF POSSIBLE
	DCA	X0		/RSTRM NUMBER
	TAD	(-4
	DCA	X1
OKSTR1,	TAD	RCHAR
	CIA
	TAD I	X0
	SNA	CLA
	JMP	OKSTR2		/WE HAVE A POSSIBLE STREAM
	ISZ	X1
	JMP	OKSTR1
	SKP
OKSTR2,	ISZ	OKSTR		/INCREMENT RETURN IF OK STREAM FOUND
	JMP I	OKSTR

OKSTRT,	40; 42; 44; 46
	PAGE
LPFILL,	0			/PROCESS REPRO FIRST
	TAD	(PUTLP
	DCA	PUTRUT			/ENABLE REP-ROUTINE
	TAD	EOILP
	SZA	CLA
	JMP	EORP
LAB28,	JMS	ETHF		/THIS IS 200 M
	JMP I	LPFILL		/BUFFER EMPTY RETURN
	DCA	RCHAR
	IFDEF DRIVS &lt;
	JMP	LAB28 &gt;		/DO NOT USE LP IF LINE TEST, CLEAR BUF
	TAD I	REPFX
	SZA	CLA
	JMP	REPO1
	TAD I	CRFLGX
	SZA CLA
	JMP	CRP1
	JMS	CHATER		/ELIMINATE ADS
	AD
	JMP	LAB28
	JMS	CHARSP		/TEST SPECIAL CHARS
	JMP	LAB28		/CHAR IS 0 OR AD
	JMP	EORP
	JMP	EORP
	JMP	EOIP		/FETCH MORE IGNORE
	JMP	CRPRO		/
	JMP	LAB28
	JMP	REPPRO
NORM1,	JMS	PUTLP		/PUT IN LPBUFFER
	JMP I	LPFILL		/BUFFER FULL
	JMP	LAB28
EORP,	P1
	DCA I	EORFX
	P1
	DCA I	CRFLGX
	TAD	[CR
	JMS	PUTLP
	JMP I	LPFILL
	DCA	EOILP
	TAD	[CR
	JMP	NORM1
EOIP,	DCA	WCBFIB
	P1
	DCA	EOILP		/SET EOIFLG
	JMP	EORP
EOILP,	1
CRPRO,	P1
	DCA I	CRFLGX
	JMP	NORM1
REPPRO,	P1
	DCA I	REPFX
	JMP	LAB28
CRP1,	JMS	LPKICK
	JMS	CHARSP
	JMP	LAB28
	JMP	EORP
	JMP	EORP
	JMP	EOIP
	JMP	CRPRO
	JMP	LAB28
	JMP	REPPRO
	JMS	CHATER
	FFEED
	JMP	ISFFEE
	DCA I	CRFLGX
	JMS	CHATER
	&quot;0
	JMP	.+7
	JMS	CHATER
	&quot;1
	SKP
	JMP	LAB28
ISFFEE,	TAD	(FFEED
	SKP
	TAD	[CR
	JMP	NORM1
/
/
REPO1,	JMS	REPIN
	JMP I	LPFILL		/BUFFER FULL
	JMP	LAB28
/
/
/
LPKICK,	0			/KICKS ON LP IF POSSIBLE OR NECESSARY
	TAD	LPTPFL
	SZA	CLA
	JMP I	LPKICK		/LP RUNS
	TAD	(LI1BU
	TAD	LPGET
	DCA	LPGTOT
	CDF	10
	TAD I	LPGTOT
	CDF	0
	DCA	ETHF		/SAVE CHAR
	TAD	ETHF
	SNA	CLA
	JMP I	LPKICK		/NO INFO RETURN
	CLL	CLA	IAC	/SET LPTPFL
	DCA	LPTPFL
	TAD	LPGET
	IAC
	AND	(-LI1BUL	/INCREMENT POINTER
	DCA	LPGET
	CDF	10
	DCA I	LPGTOT
	CDF	0
	TAD	ETHF
	6666			/PRINT CHAR
	CLL	CLA
	JMP I	LPKICK
/
/
/
SAVLIN,	0
	CDF	20
	TAD I	(WCBFIA
	SPA	CLA
	JMP	.-2
	CDF	0
	JMS	READL
	JMS	INFOPU
	JMP I	SAVLIN
	PAGE
/
/	CANCLE ONLY IF STREAM IS IN RSTAT, BUT NOT IN SSTAT
/
/
/
CANCLE,	0
	TAD	SSTAT
	CMA
	AND	RSTAT
	CMA
	AND	TOCANC
	DCA	CHATER		/SAVE BITMASC
	TAD	CHATER
	SNA
	JMP I	CANCLE		/NOTHING TO DO
	CMA
	AND 	DEFSTR
	DCA	DEFSTR
	TAD	CHATER
	CMA
	AND	TOCANC
	DCA	TOCANC
	JMP I	CANCLE
/
/
/
/
/
/
SAVLI1,	0
	JMS	LPKICK
	TAD	LPPUT		/ENOUGHT ROOM IN LP BUF TO MAKE GOSTREAM
	CIA
	TAD	LPGET
	SMA
	TAD	(LI1BUL
	TAD	(1000		/RESULT IS -OCUPIED LOCS OF LI1
	SPA	CLA
	JMP I	SAVLI1
	JMS	GOSTR		/SET STREAMBIT
	DLI1
	JMP I	SAVLI1
/
/
/
/
/
/
/
FILLI2,	0
	TAD	(PACK2
	DCA	PUTRUT
	TAD	EOI23
	SNA	CLA
	JMP	LAB38
	JMS	ETHF		/IF A NEW FILE ELIMINATE BINARY VORSPAN
	JMP I	FILLI2
	TAD	(-AD
	SZA	CLA
	JMP	.-4
	DCA	EOI23
LAB38,	JMS	ETHF
	JMP I	FILLI2
	DCA	RCHAR
	TAD I	REPFX
	SZA CLA
	JMP	REP2
	JMS	CHARSP
	JMP	LAB38		/IGNORE 0
	JMP	EORP2
	JMP	EORP2
	JMP	EOIP2
	JMP	NORM2		/CR
	JMP	LAB38		/IGNORE LF
	JMP	REPO2
NORM2,	JMS	PACK2		/PACK INTO BUF2
	SKP
	JMP	LAB38
NORM22,	JMS	SAVLIX
	JMP	LAB38
EORP2,	TAD	(CR
	DCA	RCHAR
	JMP	NORM2
EOIP2,	TAD	[CTRLZ
	DCA	RCHAR
	JMS	PACK2
	NOP
	DCA	RCHAR
	JMS	PACK2
	SKP
	JMP	.-2
	JMS	INEOI
	JMP	NORM22
BIGN,	P1
	TAD	EXPNO
	AND	[17
	CIA
	TAD	NUMBER
	SZA	CLA
	JMP	LAB22		/ASSUME I HABE IT ALREADY
	JMS	NEGQSL		/IT IS REALY BAD
/
/

/
/
REPO2,	P1
	DCA I	REPFX
	JMP	LAB38
	PAGE
REP2,	JMS	REPIN
	JMP	NORM22		/BUFFER FULL
	JMP	LAB38
/
/
/
/
/
PACK2,	0			/CHAR IN RCHAR
	TAD	WCLIX
	SMA	CLA
	JMP I	PACK2		/BUFFER FULL
	TAD I	SWIRX
	TAD	[JMP	C0
	IAC
	DCA	C0
C0,	HLT
	JMP	C1
	JMP	C2
	JMP	C3
C1,	ISZ I	SWIRX
	JMS	FORPAR
	DCA	CHAR23
	ISZ	WCLIX
	JMP	LAB41
C2,	ISZ I	SWIRX
	JMS	FORPAR
	DCA	CHAR23
	JMS	STOR23
	M2
	TAD	LIX
	DCA	LIX
	ISZ	PACK2
	JMP I	PACK2
C3,	JMS	FORPAR
	CLL RTL;	RTL
	AND	[7400
	CDF	10
	TAD I	LIX
	DCA I	LIX
	CDF	0
	ISZ	LIX
	DCA I	SWIRX		/RESET CHARSWITCH
	JMS	FORPAR
	BSW; CLL	RTL
	AND	[7400
	CDF	10
	TAD I	LIX
	CDF	0
	DCA	CHAR23
	ISZ	WCLIX
	TAD	WCLIX		/BUFFER FULL
	SPA	CLA		/DO NOT INCR RETUNR IF YES
LAB41,	ISZ	PACK2
	JMS	STOR23
	JMP I	PACK2
FORPAR,	0
	TAD	RCHAR
	AND	[RUBOUT
	SZA
	TAD	[200
	JMP I	FORPAR
CHAR23,	0			/TEMPORARY CHAR STORAGE
/
/
/
/
/
/
STOR23,	0
	TAD	CHAR23
	CDF	10
	DCA I	LIX
	CDF	0
	ISZ	LIX
	JMP I	STOR23
/
/
/
/
SAVLI2,	0			/ROUTINE TO SAVE LI2 INFO ON OS8 DEVICE
	TAD	WCLI2		/NOW SET UP ALL SAVE INFO
	SPA	CLA
	JMP I	SAVLI2		/NOTHING TO DO
	TAD	WCLI2
	DCA	SAVWC
	TAD	LI2DEV
	DCA	SAVDEV
	TAD	LI2HA		/SAVE-HANDLER
	DCA	SAVHA
	TAD	(LI2BU
	DCA	SAVBU
	TAD	(-LI2BUL%2	/HOW MANY PAGES
	AND	[3700
	TAD	(4010		/OUTPUT FROM FIELD1
	DCA	SAVPA
	TAD	LI2BLO
	DCA	SAVBLO		/ACTUAL BLOCK NUMBER
	TAD	LI2FNP		/FILENAME POINTER IF CLOSE
	DCA	SAVFP
	TAD	LI2FL
	DCA	SAVLE
	JMS	OS8OUT		/SAVE!!!
	TAD	SAVLE		/ONLY RETURN IF ALL OK, SAVE BLOCK INFO
	DCA	LI2FL
	TAD	SAVBLO
	DCA	LI2BLO
	JMS	CLLI2		/SET LI2 FREE
	DCA I	SWIRX
	JMP I	SAVLI2
/
/	LI2 FILE INFO TABLE
/
LI2DEV,	0			/DEVICE NUMBER
LI2HA,	0			/ENTRY POINT OF HANDLER
LI2BLO,	0			/LI2 DEVICE POSITION
LI2FL,	0			/BLOCKS WRITTEN
LI2FNP,	LI2NAM
LI2NAM,	0
	0
	0
	0
/
	PAGE
/
/
/
/
SAVLI3,	0
	TAD	WCLI3
	SPA	CLA
	JMP I	SAVLI3
	TAD	WCLI3
	DCA	SAVWC
	TAD	LI3DEV
	DCA	SAVDEV
	TAD	LI3HA
	DCA	SAVHA
	TAD	(LI3BU
	DCA	SAVBU
	TAD	(-LI3BUL%2
	AND	(3700
	TAD	(4010
	DCA	SAVPA
	TAD	LI3BLO
	DCA	SAVBLO
	TAD	LI3FNP
	DCA	SAVFP
	TAD	LI3FL
	DCA	SAVLE
	JMS	OS8OUT
	TAD	SAVLE
	DCA	LI3FL
	TAD	SAVBLO
	DCA	LI3BLO
	JMS	CLLI3
	DCA I	SWIRX
	JMP I	SAVLI3
/
/LI3 FILE INFO TABLE
/
LI3DEV,	0			/CONTAINS DEVICENUMBER
LI3HA,	0			/ENTRY POINT OF HANDLER
LI3BLO,	0			/ACTUAL BLOCK NUMBER
LI3FL,	0			/OS8BLOCK WRITEN
LI3FNP,	0	LI3NAM		/POINTER TO FILENAME
LI3NAM,	0			/FILENAMETABLE
	0
	0
	0			/EXTENSION STARTS WITH 6060
/
/
/
/
/
OS8OUT,	0			/GENEAR SAVE ROUTINE
	JMS I	SAVHA
SAVPA,	0			/FILED BEFORE CALL 
SAVBU,	0
SAVBLO,	0
	JMP 	OS8ERR
	TAD	SAVPA		/NOTHING SPECIAL
	BSW
	CLL	RAR
	AND	(17		/CALC OS8BLOCKS WRITTEN
	DCA	SAVPA
	TAD	SAVBLO
	TAD	SAVPA
	DCA	SAVBLO
	TAD	SAVLE
	TAD	SAVPA
	DCA	SAVLE
OS8RET,	JMS	CLOSE		/CLOSE NECESSARY? WC=1
	JMS	USROUT
	JMP I	OS8OUT
SAVHA,	0
SAVWC,	0
/
/
OS8ERR,	JMS	CLLI0		/FORCE MSG
	JMS	TELE
	OS8MSG
OS8ER1,	JMS	SEND0
	JMS	TTYOUT
	JMS	USROUT		/USR OUT NECESSARY, THEN DO IT
	CDF	20		/WAIT FOR MSG WRITTEN
	TAD I	(TTYAC
	SZA	CLA
	JMP	.-2
	CDF	0
	JMP	SHUTD		/FORCE ON SHUTDOWN BECAUSE TOO MUCH
/IS WRONG AND BEHAVEOUR OF SYSTEM CAN NOT LONGER BE PREDECTED
/
/
OS8MSG,	TEXT /OS8 ER, RESTART/
EOI23,	1
INEOI,	0
	P1
	DCA	EOI23
	P1
	DCA	WCBFIB
	P1
	DCA I	EORFX
	DCA I	SWIRX
	P1
	DCA	WCLIX
	JMP I	INEOI
/
INTV,	0
	TAD	RCHAR
	TAD I	INTV
	ISZ	INTV
	SPA	CLA
	TAD	(200		/NOT IN INTERVALL, FORCE RUTURN+1
	TAD	RCHAR
	TAD I	INTV
	ISZ	INTV
	SPA	SNA	CLA
	JMP I	INTV		/OK IN INTERVALL
	ISZ	INTV
	JMP I	INTV
	PAGE
/
/
/
/
/
/
/
/
/
/
/
/
/
SAVDEV,	0			/DEVICENUMBER FOR SAVE
EXTP,	0			/POINTER TO SAVEFILE EXTENSION
CLOSE,	0
	TAD	SAVWC
	SNA	CLA
CLOS2,	JMP I	CLOSE		/NO CLOSE NECESSARY
	JMS	USRIN
	TAD	SAVDEV
	CDF	0
	CIF	10
	JMS I	(200
	4
SAVFP,	0			/POINTER TO FILENAME
SAVLE,	0
	JMP	CLOER
CLOS1,	NOP			/USED FOR RETURN FROM INIT CLOSEF
	TAD	SAVFP
	TAD	(3
	DCA	EXTP
	TAD I	EXTP		/GET EXTENSION
	AND	(77
	IAC
	TAD	(-72
	SNA	CLA
	TAD	(7
	TAD I	EXTP
	IAC
	DCA I	EXTP
	TAD	SAVFP		/OPEN TENTATIVE FILE
	DCA	ENTFP
	TAD	SAVDEV
	CDF	0
	CIF	10
	JMS I	(200
	3
ENTFP,	0			/OINTER TO FILENAME
	0
	JMP	ENTERR
	DCA	SAVLE		/0 SAVLE INDICATES NEW FILE
	TAD	ENTFP
	DCA	SAVBLO		/STARTING BLOCK OF NEW FILE
	JMS	USROUT
	JMP I	CLOSE
/
/
CLOER,	CLL	CLA
	JMS	TELE
	CLOMSG
	JMP	OS8ER1		/MSG WITH RESTART
ENTERR,	CLL	CLA
	JMS	TELE
	ENTMSG
	JMP	OS8ER1		/MSG WITH RESTART
/
/
CLOMSG,	TEXT /CLOSE ERROR RESTART!/
ENTMSG,	TEXT /ENTER ERROR RESTART!/
/
/
/
/
/
/
/
/
/
/
SAVLIX,	0
	JMS	RESWC		/RESTORE WC
	JMS	SAVLI2
	JMS	SAVLI3
	JMS	SETLIX		/RESTORE NEW POINTERS
	JMP I	SAVLIX
/
/
/
STOPST,	0			/ROUTINE TO STOP STREAM
	TAD I	STOPST
	ISZ	STOPST
	CMA
	AND	SSTAT		/MASC OUT STREAM TO STOP
	DCA	SSTAT
	JMP I	STOPST
/
/
/
GOSTR,	0
	TAD I	GOSTR
	AND	DEFSTR		/SET ONLY DEFINED STREAMS
	CMA
	AND	SSTAT		/MASC OUT TO PREVENT OVERFLOW
	TAD I	GOSTR
	ISZ	GOSTR
	DCA	SSTAT
	JMP I	GOSTR

TTYOUT,	0
	CIF	20
	JMS I	(TTYOU1
	JMP I	TTYOUT

TTYIN,	0
	SNA	CLA
	JMP	.+5
	P4
	TAD	TTYIN
	DCA	TTYIN
	P1
	CIF	CDF 20
	JMS I	(TTYIN1
	JMP I	TTYIN
	PAGE
/		* F I L E M . B R *
/
/
/
FILEM,	0			/ROUTINE PERFORMS SAVE AND FETCH OF
	JMS	GETLO1		/GET LO1 INFO IF THERE IS ANY OR BUF FREE
	JMS	GETCD		/ALL SORT OF INFO
	TAD	WCLI0
	SMA	CLA
	JMS	TTYOUT		/WRITE TTY OUTPUT INFO (INTERUPTDRIVEN )
	JMS	SAVLI1		/KICK ON LPT IF NECESARY
	JMP I	FILEM
/
/
/
/
/
GETCD,	0			/CALLS TTYIN FOR CD IF CD AND TTY IS FREE
	TAD	WCCD
	SPA	CLA
	JMP I	GETCD
	JMS	TTYIN		/TTY IS SELFLOCKING
	JMP I	GETCD
/
/
/
/
/
TELE,	0			/PUT TEXTSTRING IN LI0 BUF
	TAD I	TELE		/FETCH POINTER TO STRING
	ISZ	TELE
	DCA	TELE1
	RDF
	TAD	[CIF CDF 0
	DCA	TELER+1		/DATA FIELD MUST BE CALLING FIELD
	RDF
	TAD	(CDF	0
	DCA	TELE7
	JMS	WHERE1		/SET LI0 AND WCLI0 FROM CORRECT FIELD
	TAD	WCLI0		/BUFFER FREE?
	SMA	CLA
	JMP	TELER
TELE2,	TAD I	TELE1
	BSW
	JMS	TELE3
	JMP	TELER		/FINITO OR BUFFER IS FULL
	TAD I	TELE1
	JMS	TELE3
	JMP	TELER
	ISZ	TELE1
	JMP	TELE2
TELER,	JMS	WHERE2
	HLT
	JMP I	TELE
TELE1,	0
/
/
/
/
/
/
/
TELE3,	0
	AND	(77
	SNA
	JMP	TELE4
	ISZ	TELE3			/NOT FINITO
	TAD	[-40
	SPA
	JMP	TELE5
	TAD	(240
TELE6,	AND	(377
	CDF	10
	DCA I	LI0
TELE7,	HLT			/SET FIELD FOR FETCH OF TEXT
	ISZ	LI0
	ISZ	WCLI0
	JMP I	TELE3
	JMP	TELER		/BUFFER IS FULL
TELE5,	TAD	(340
	JMP	TELE6
TELE4,	TAD	(215		/OUTPUT CR
	JMP	TELE6
/
/
/
/
SEND0,	0			/FILLS LI0 WITH 0 
	JMS	FLD0
	DCA	SEND0R+1
	CDF	10
	DCA I	LI0
	ISZ	LI0
	ISZ	WCLI0
	JMP	.-3
SEND0R,	JMS	WHERE2
	HLT
	JMP I	SEND0
/
WHERE1,	0
	TAD	TELE7
	DCA	.+1
	HLT			/CONTAINS CDF 0 OR 20
	TAD I	(LI0		/IF FIELD IS 0, THIS IS A NOP ROUTINE
	DCA	LI0
	TAD I	(WCLI0
	DCA	WCLI0
	JMP I	WHERE1
/
/
WHERE2,	0
	TAD	TELE7
	DCA	.+1		/RESTORE POINTER AND WC TO CALLING FIELD
	HLT
	TAD	LI0
	DCA I	(LI0
	TAD	WCLI0
	DCA I	(WCLI0
	JMP I	WHERE2
/
/
/
/
/
/
/
/
SHUTD,	CDF	20
	TAD I	(WF
	SZA CLA
	JMP	SHUTD
	CDF	CIF 0
	IOF			/THIS IS END OF PROGRAM
	CAF			/CLEAR ALL FLAGS
	JMP I	(7600
/
/	BUFFER CLEAR ROUTINES
/
CLBFOA,	0
	CDF	20
	TAD	(ETBFOA
	ETHA
	DCA I	(BFOA
	TAD	(ETHLE
	DCA I	(WCBFOA
	CDF	0
	JMP I	CLBFOA
/
/
	PAGE
CLBFIA,	0
	CDF	20
	TAD	(ETBFIA
	ETHA
	DCA I	(BFIA
	TAD	(ETHLE
	DCA I	(WCBFIA
	CDF	0
	JMP I	CLBFIA
/
/
CLBFOB,	0
	TAD	(ETBFOB
	DCA	BFOB
	TAD	(ETHLE
	DCA	WCBFOB
	JMP I	CLBFOB
/
/
CLBFIB,	0
	TAD	(ETBFIB
	DCA	BFIB
	TAD	(ETHLE
	DCA	WCBFIB
	JMP I	CLBFIB
/
/
CLLI0,	0
	RDF
	TAD	[CIF CDF 0
	DCA	CLLI0R
	CIF CDF 0
	TAD	(LI0BU
	DCA	LI0
	TAD	(LI0BUL
	DCA	WCLI0
CLLI0R,	HLT
	JMP I	CLLI0
/
/
CLLI1,	0			/SPECIAL FOR LPT BUF
	TAD	(LI1BU
	DCA	LI1
	TAD	(LI1BUL
	DCA	WCLI1
	DCA	LPTPFL		/LP PROCESSED FLG CLEAR
	IFDEF DRIVS &lt;
	IOF &gt;
	IFDEF MLPT &lt;
/
/	DISABLE BUFFER SET 0 FOR TEST
/
	STA			/FILL LPBUF WITH 0
	TAD	LI1
	DCA	X0
	CDF	10
	DCA I	X0
	ISZ	WCLI1
	JMP	.-2
	CDF	0
	TAD	(LI1BUL
	DCA	WCLI1 &gt;
	DCA	LPPUT 		/CLEAR RELATIVE POINTERS
	IFDEF DRIVS &lt; ION &gt;
	DCA	LPGET
	P1
	DCA	EOILP		/SET EOIFLG TO FORCE FF
	JMP I	CLLI1
/
/
CLLI2,	0
	TAD	(LI2BU
	DCA	LI2
	TAD	(LI2BUL
	DCA	WCLI2
	JMP I	CLLI2
/
/
CLLI3,	0
	TAD	(LI3BU
	DCA	LI3
	TAD	(LI3BUL
	DCA	WCLI3
	JMP I	CLLI3
/
/
CLCD,	0
	TAD	(CDBU
	DCA	CD
	TAD	(CDBUL
	DCA	WCCD
	JMP I	CLCD
/
/
/
/
CLEAR,	0
	CLA CLL
	DCA	TOCANC		/SET UP BLOCK NUMBER STUFF
	P1
	DCA	SENDNO
	P1
	DCA	EXPNO
	DCA	REQSL
	P1
	DCA	RECNO
/
/	O BUFFERS ARE TREATED BY INIT AND FILLED WITH INFO
/
	JMS	CLBFIA
	DCA	WCBFIB
	JMS	CLLI1
	JMS	CLLI2
	JMS	CLLI3
	DCA	WCLO0
	DCA	WCLO1
	DCA	WCCD		/SET COMMAND DECODER EMPTY
	JMP I	CLEAR
/
/
/
CLLO0,	0
	TAD	(LO0BU
	DCA	LO0
	TAD	(LO0BUL
	DCA	WCLO0
	JMP I	CLLO0
/
/
CLLO1,	0
	TAD	(LO1BU
	DCA	LO1
	TAD	(LO1BUL
	DCA	WCLO1
	JMP I	CLLO1
/
/
/
	PAGE
FLD0,	0
	RDF
	AND	(70
	TAD	[CIF	CDF 0
	CDF	0
	JMP I	FLD0
LO1FMI,	ZBLOCK 3^15-1
LO1FMA,	0
DIALM1,	TEXT /DIAL NUMBER 01 47 53 18/
DIALM2,	TEXT /AND IF LINE IS READY, PRESS ANY CHARACTER/
INTER1,	JMS	CLLI0
	JMS	TELE
	INTER2
	JMS	SEND0
	JMS	TOUT
	JMP	SHUTD
INTER2,	TEXT /UNRECOGNISED INTERUPT/

STABUF,	0
	TAD	(STA1-1		/SET UP POINTERS
	DCA	X0
	TAD	(ETBFOB-1
	DCA	X3
STA2,	TAD I	X0
	AND	[RUBOUT
	SNA
	JMP	STA3
	CDF	10
	DCA I	X3
	ISZ	WCBFIB
	CDF	0
	JMP	STA2
STA3,	JMS	OBF0
	JMP I	STABUF
STA1,	37			/RESTART BUFFER
	&quot;D; &quot;A; &quot;V; &quot;O; &quot;S; 0
	PAGE
</pre>
<hr/>
</div>