/STAGE2 RUN TIME SYSTEM
/
/	THIS IS THE MACHINE DEPENDENT CODE PART OF STAGE2.
/	IT CONTAINS THE INITIAL SET UP AND INTERACTION WITH THE
/	OPERATING SYSTEM, I/O AND CLEAN-UP.
/	THE GET, STORE, MULTPLY AND DIVIDE ARE ALSO HERE
/
SWAB=7431
SWBA=7447
SAM=7457
DAD=7443
DLD=7663
DST=7445
DPIC=7573
DPCM=7575
DPSZ=7451
MUY=7405
DVI=7407
SHL=7413
ASR=7415
LSR=7417
CAM=7621
LSF=6661
LSE=6663
LLS=6666
FIXTAB
MAXL=205	/133 DECIMAL
P=10
*10
XR1,	0
XR2,	0
XR3,	0
*20
TABCK,	-11	/TAB CHECK
LBP,	LB	/POINTER TO LINE BUFFER
LBC,	-MAXL-1
T1,	0	/GENERAL TEMP.
T2,	0
ARGP,	0
CHAR,	0
INHAND, -1	//CURRENT DEVICE NUMBER OF INPUT
CUR,	-1	/CURRENT CHANEL ON DECK
ENTRYP, 0	/ENTRY POINT OF HANDLER
CURB,	0	/CURRENT RELATIVE BLOCK NUMBER
BASEF,	0	/BLOCK # OF FILE BASE
BUFBASE,0	/ADDRESS OF BUFFER IN FIELD 1
WORP,	0	/WORD POINTER (RELATIVE) INTO OS/8 BUFFER
CHARSW, 0	/CHARACTER SWITCH. 0,1, OR 2
STAT,	0	/DEVICE STATUS
/	BITS IN THE STATUS WORD ARE ALLOCATED AS FOLLOWS:
/	0	CHARACTER HANDLER
/	1	NO CONTROL OPERATIONS ALLOWED
/	2	IS A TENATIVE (OUTPUT) FILE
/	3	TEMPORARY FILE
/	4	END OF FILE OR MEDIUM THIS BUFFER
/	5	LOGICAL END OF FILE
/	9	WRITTEN ON
/	10	READ ONLY FILE (NO REWIND)
/	11	FILE IS REWOUND
/
MAXB,	0	/FILE SIZE IN BLOCKS
STARTAD,	/STARTING ADDRESS OF STAGE2
RESGN,	0	/FLAG FOR RESULTING SIGN
PTRDIF, 0	/DIFFERENCE BETWEEN FLAG ANG PTR
PTR9,	0	/USED ONLY ONCE
TRACEP, 0	/POINTER TO TRACE BACK IN FIELD P
EXPER,	0	/POINTER TO TRACE BACK WITH EXPRESSION ERROR
GTP,	0	/ADDRESS OF POINTERS ON PAGE ZERO FIELD 1
NWORDS, 3
EXFILE, 4	/CHANNEL NUMBER OF THE EXTRA FILE (DEFAULT 4)
CNTRLB, 202
OPT1,	0	/OPTION BITS FROM CD
OPT2,	0
OPT3,	0
OPT4,	0
OPT5,	0
USR,	200	/POINTER TO USR FOR INEXT
NL,
RA1,	0	/DP REG.
NH,
RA2,	0
DL,
RB1,	0
DH,
RB2,	0
Q,
RC1,	0
PAGE
	JMP I (STARTUP	/NORMAL ENTRY
/
/	MUL0 MULTIPLYS TWO 24BIT NUMBERS TOGETHER. OVERFLOW NOW PRODUCES A HALT.
/	ON ENTRY THE AC POINTS TO A LIST OF THREE ADDRESSES IN FIELD P.
/	THE ADDRESSES ARE OPERAND 1, OPERAND 2 AND THE RESULT.
/
MUL0,	0	/MULTIPLY TWO DP NUMBERS
	DCA ARGP	/AC HAS ARGLIST POINTER
	TAD I ARGP	/DF STILL P
	DCA M1	/FIRST ARG
	ISZ ARGP	/NEXT
	TAD I ARGP	/SECOND ARG
	DCA M2
	ISZ ARGP	/RESULT ADDRESS
	TAD I ARGP
	DCA RESP
	CLL CLA CMA RAL /-2
	DCA RESGN	/KEEP TRACK OF RESULT SIGN
	DLD
M1,	0
	SMA	/CHECK SIGN
	JMP .+3
	DPCM	/MAKE POSATIVE
	ISZ RESGN	/MAKE THE FACT KNOWN
	DCA RB2
	SWP
	DCA RB1
	DLD	/NEXT
M2,	0
	SMA
	JMP .+4
	DPCM
	ISZ RESGN
	NOP	/COULD SKIP
	CDF 0
	DST; RA1
	CLA MUY; RB1	/LORD TIMES LORD
	SWP	/GET LOW RESULT
	DCA RC1
	TAD RA2
	SWP MUY; RB1	/NICE INSTRUCTION DEC!
	SZA CLA	/MUST BE ZERO
	JMP MOVER
	TAD RA1
	SWP MUY; RB2	/HI TIMES LOW + HI(LOW*HI)
	SZA CLA
	JMP MOVER
	TAD RC1
	SWP	/PUT IN RIGHT ORDER
	SPA
	JMP MOVER
	ISZ RESGN	/SIGN CHECK
	SKP	/REVERSE SENCE
	DPCM
	CDF CIF P
	DST
RESP,	0
	CLL CLA IAC	/1
	TAD ARGP	/POINT TO RETURN
	JMP I MUL0
/
MOVER,	CAM
	JMS I [MESS4
	MULV
EXER,	CLL CLA
	CDF CIF P
	JMP I EXPER
/
CLOSE,	0	/CLOSE A FILE IS IT WAS SPECIFIED
	TAD I CLOSE	/GET CHALEL NUMBER
	DCA CNO
	TAD CNO
	JMS I [ONDECK
	HLT	/SYSYTEM ERROR
	ISZ CLOSE
	TAD I CLOSE	/POINTER TO NAME
	ISZ CLOSE
	DCA FNAME
	TAD I FNAME
	SNA CLA	/WAS THERE A FILE SPECIFACTION?
	JMP I CLOSE	/NO
	TAD CNO
	TAD (BMAX-1
	DCA OMAX
	TAD I OMAX	/CHECK FOR ANYTHING WORTH SAVING
	TAD CURB
	TAD WORP
	TAD CHARSW
	SNA CLA
	JMP I CLOSE	/DON'T CLOSE IT IF NEVER WRITTEN ON
	JMS I (FILB	/CLOSE IT OUT
	JMP ERCL	/ERROR IN CLOSING FILE
	TAD I OMAX	/GET NEW LIMIT
	DCA OMAX
	TAD I FNAME
	ISZ FNAME
	CIF 10
	JMS I [200	/NED0 BROUGHT URS IN
	4	/CLOSE
FNAME,	0
OMAX,	0
ERCL,	CLA IAC
	JMP I CLOSE
/
CNO,	0
PAGE
/
/	DIV0 PERFORMS A 24 BIT BY 24 BIT DIVISION. ONLY THE INTEGER PART IS RETU
/	NED.	IN ORDER TO SPEED THINGS UP IT CHECKS THE RELATIVE SIZE
/	OF THE TWO OPERANDS AND JUMP TO THE FASTEST CODE.
/
DIV0,	0	/DIVIDE 24BITS SIGNED BY 24 BITS SIGNED
	DCA ARGP	/AC HAS POINTER TO ARG LIST.
	TAD I ARGP	/DF STILL P
	DCA DP	/DENOMINATOR
	ISZ ARGP
	TAD I ARGP
	DCA NP	/NUMORATOR
	ISZ ARGP
	TAD I ARGP
	DCA RESQ	/RESULT (QUOTIANT)
	CLL CLA CMA RAL /-2
	DCA RESGN	/SIGN OF RESULT
	DLD
DP,	0
	DPSZ
	JMP DNOT0	/DIVISOR OK
	JMS I [MESS4
	DBY0
	JMP I (EXER
DNOT0,	SMA	/MINUS?
	JMP .+3	/NO
	DPCM	/MAKE IT PLUS
	ISZ RESGN	/SAY SO
	DCA DH
	SWP
	DCA DL
	KSF	/IS USER CALLING?
	SKP	/NO
	JMS I [CCCK	/MAYBE HE(SHE) HAS CHANGED HER(HIS) MIND
	DLD
NP,	0	/NUMORATOR
	CDF 0
	SMA	/SAME GAME
	JMP .+4
	DPCM
	ISZ RESGN
	NOP
	DST; NL
	SZA CLA	/GOT HI ORDER BITS?
	JMP BIGNUM	/YES
	TAD DH	/NOW CHECK SIZE OF DIVISOR
	SZA CLA	/ SMALL/SMALL?
	JMP STOR0	/SMALL BY BIG IS ZERO
	DVI; DL	/LOW BITS STILL IN MQ
	CLA	/FORGET REMAINDER
	JMP SGNQ	/CORRECT SIGN
BIGNUM, TAD DH	/DIVISOR BIG TOO?
	SZA CLA
	JMP DBIG	/YES
	TAD NH	/NEED TWO DIVIDES
	MQL DVI; DL	/RESULT IS TIMES 10000 OCTAL
	SWP	/GET HI ORGER OF Q
	DCA Q
	TAD NL	/LOW ORDER BITS OF NUMERATOR ARE
	SWP DVI; DL	/THE LOW ORDER BITS OF THE REMAINDER
	CLA	/FORGET REMAINDER AFTER THAT
	TAD Q
	JMP SGNQ
DBIG,	TAD NH	/BOTH NUMBERS ABOUT THE SAME SIZE
	MQL DVI; DH	/FIRST ESTIMATE
	CLA MQA
	DCA Q
	DCA CORQ	/ZERO OUT CORRECTION FOR Q
	TAD DL	/MULTIPLY BACK
	MQL MUY; Q
	SWP
	DCA T1
	TAD DH
	SWP MUY; Q
	TAD T1	/AC MUST HAVE BEEN ZERO
	SWP	/GET CORRECT ORDER
	DPCM	/SUBTRCT
QTST,	DAD; NL	/CHECK FOR REMAINDER
	SMA	/MINUS MEANS LOWER BITS SNUCK UP
	JMP DOK	/POSATIVE REMAINDER LESS THAN DIVISOR
	ISZ CORQ	/INCREMENT AMOUNT BY WICH TO CORRECT Q
	JMP QTST	/THIS COULD BE VERY SLOW
DOK,	CLA
	TAD CORQ	/CORRECTION
	CIA
	TAD Q
	MQL
SGNQ,	ISZ RESGN
	SKP
	DPCM
STORQ,	CDF CIF P
	DST
RESQ,	0
	CLL CLA IAC	/1
	TAD ARGP	/RETURN POINTER
	JMP I DIV0
STOR0,	CAM
	JMP STORQ
CORQ,	0
PAGE
/
/	ONDECK IS LIKE A CHANEL ATTACH. IT BRINGS THE RELAVENT INFO
/
/	ABOUT A FILE ONTO PAGE ZERO. DEVICE 0 SHOULD BE DETECTED BEFORE
/	A CALL TO ONDECK. FIRST RETURN IS FATAL, SECOND IS OK.
/
ONDECK, 0	/GET INFO ABOUT A UNIT
	SWAB	/SAVE UNIT# IN MQ
	MQA
	SPA CLA	/MUST BE POSATIVE.
	JMP I ONDECK	/ERROR
	TAD CUR
	SAM	/COMPAIR
	SNA CLA	/DIFFERENT
	JMP NOWK	/ALREADY THERE
	TAD (12	/MAXIMUM UNIT # PLUS 1
	SAM
	SMA CLA	/10 SHOULD BE GREATER THAN ANY NUMBER
	JMP I ONDECK	/ERROR
	JMS OFFDECK	/SAVE CURRENT INFO IF GOOD
	MQA
	DCA CUR	/NEW ENTRY
	SHL; 17	/TIMES 8 ALTOGETHER
	TAD (DSRN-1	/DEVICE SEQUENCE REFERENCE NUMBER TABLE
	DCA XR1
	TAD (ENTRYP-1
	DCA XR2
	TAD (-10
	DCA T1
	TAD I XR1
	DCA I XR2	/TRANSFER
	ISZ T1	/COUNT
	JMP .-3
NOWK,	ISZ ONDECK	/NORMAL EXIT
	JMP I ONDECK
/
/
/	OFFDECK PUT CHANEL INFO BACK IF IT IS GOOD. OFFDECK MUST NOT
/	ALTER THE MQ.
/
OFFDECK,	0
	TAD CUR
	SPA CLA	/MINUS MEANS DUMMY DATA
	JMP I OFFDECK
	TAD CUR	/LEAVE MQ ALONE
	CLL RAL; CLL RTL	/TIMES 8
	TAD (DSRN-1
	DCA XR1
	TAD (ENTRYP-1
	DCA XR2
	TAD (-10
	DCA T1
	TAD I XR2
	DCA I XR1
	ISZ T1
	JMP .-3
	CMA
	DCA CUR	/MARK IT BAD
	JMP I OFFDECK
/
/
SIX28,	0	/CONVERT THE LOWER SIX BITS TO 8 BIT ACSII
	AND (77	/USE LOWER BITS
	MQL	/SAVE FOR TESTING
	MQA
	AND (40
	SNA CLA
	CLL CLA IAC BSW /300 TYPE CODE
	TAD [200	/SET MARK PARITY
	MQA	/ADD IN LOWER BITS
	JMP I SIX28
/
VALER0, JMS I [MESS4
	VALM
	JMP TRACEB
PTRER0, JMS I [MESS4
	PERM
TRACEB, CIF CDF P
	CLL CLA
	DCA CNTRLB	/CLEAR CONTROL BE TO AVOID RECURSION
	JMP I TRACEP	/PROVIDE TRACE BACK
VALM,	TEXT+VALUE OUT OF RANGE+
PERM,	TEXT+PTR VALUE OUT OF RANGE+
PAGE
READ0,	0	/READ FROM THE CHANEL IN THE AC
	SNA	/CHECK FOR CHANEL 0
	JMP NEOF	/CHANNEL 0 GIVE EOF ON READ
	JMS I [ONDECK	/GET RELAVENT INFO
	JMP RIOCH	/SOME SORT OF CHANEL DES. ERROR
	KSF	/USER CALLING
	SKP
	JMS I [CCCK	/CONTROL C CHECK
	JMS I [RESETB	/RESET FOR READ OPERATION
	CLL CLA IAC RTL /4
	AND STAT	/CHECK FRO WRITTEN ON
	SZA CLA
	JMP RIOCH	/READ AFTER WRITE
RTST,	CLL CLA IAC	/1
	AND STAT	/RREWOUND?
	SNA CLA
	JMP EOFT	/NO
	TAD BASEF
	DCA .+6
	TAD BUFBASE
	DCA .+3
	JMS I ENTRYP	/CALL HANDLER
	0200	/READ TWO PAGES
	0	/CORE ADDRESS
	0	/DISK ADDRESS
	JMP SHRTCK
CLRRW,	CLL CLA CMA RAL /7776
	AND STAT	/CLEAR REWOUND BIT
	DCA STAT
	JMP GETMR
SHRTCK, SPA CLA	/FATAL ERROR?
	JMP RIOCH	/BAD ERROR
	TAD [200
	MQL
	CLL CLA CMA RAL
	AND STAT	/CLEAR RWOUND BIT
	MQA	/SET PHYSICAL EOF
	DCA STAT	/SET PHYSICAL EOF
	JMP GETMR
EOFT,	CLA CLL IAC BSW /100
	AND STAT	/LOGICAL EOF?
	SNA CLA
GETMR,	JMS I (GETC	/READ A CHARACTER
	JMP REOF	/END FILE OR READ ERROR
	JMS I (ASC2I	/CONVERT TO INTEGER
	JMP GETMR	/IGNORE
	SMA	/CHECK FOR EOL
	JMP EOLT	/NO, NOW CHECK SPACE LEFT
	DCA I LBP	/INSERT AN END OF LINE
	SKP
NEOF,	CLL CLA IAC	/NORMAL EOF
RHOME,	CDF CIF P
	JMP I READ0	/STATUS IN AC
EOLT,	DCA I LBP	/SAVE IT
	TAD I LBP
	TAD TABCK	/CHECK FOR A HORIZONTAL TABB
	SZA CLA
	JMP NOTAB
	TAD LBP
	TAD (-LB
	AND (7
	TAD (-10
	DCA TABC
EXPTAB, TAD (40
	DCA I LBP
	ISZ LBP	/ADVANCE
	ISZ LBC	/COUNT
	SKP	/STILL ROOM
	JMP MEOL	/OUT OF ROOM
	ISZ TABC	/MORE SPACES?
	JMP EXPTAB	/YES
	JMP GETMR	/NO
NOTAB,	ISZ LBP	/ADVANCE
	ISZ LBC	/COUNT
	JMP GETMR	/STILL ROOM
MEOL,	CMA	/MAKE EOL MARKER
	DCA I LBP	/OVERLAY LAST CHARACTER
IGNOR,	JMS I (GETC
	JMP RET	/READ ERROR TEST
	TAD CHAR
	TAD (-15	/LOOK FOR CR
	SZA CLA
	JMP IGNOR	/KEEP GOING
	JMP RHOME	/DONE
RIOCH,	CLL CLA IAC RAL /2	/FATAL ERROR
	JMP RHOME
RET,	SZA CLA	/EOF OR READ ERROR?
	JMP RIOCH	/CHANEL ERROR
	JMP RHOME	/EOF FOR NEXT TIME
/
REOF,	SZA CLA	/EOF?
	JMP RIOCH	/NO, FATAL ERROR
	CMA	/-1
	TAD CUR	/FILE 1?
	SZA CLA
	JMP NEOF	/NORMAL EOF
	JMS I (INEXT	/OPEN NEXY INPUT FILE
	JMP NEOF
	JMP RTST	/REWIND TEAT
/
TABC,	0	/SPACES LEFT TO BE TABED(MINUS)
PAGE
WRITE,	0	/LOCAL SUBROUTINE OF WRITE0
	JMS I [ONDECK	/BRING OUT INFO
	JMP WIOCH	/FATAL ERROR
	KSF	/CHECK IF USER IS CALLING
	SKP
	JMS I [CCCK
	TAD (302	/CHECK FOR EOM,OEF, AND READ ONLY
	AND STAT	/CHECK FOR EOM OR READ ONLY
	SZA CLA
	JMP WIOCH	/FATAL ERROR
	CLL CLA IAC RTL /4
	MQL
	CLL CLA CMA RAL /7776
	AND STAT	/CLEAR REOUND BIT
	MQA	/OR THE BIT IN
	DCA STAT	/WRITTEN ON
	JMS RESETB	/RESET LINE
PMORE,	TAD I LBP	/PICK UP A CHARACTER
	SPA	/CHECK FOR EOL
	JMP FEOL	/FOUND EOL
	JMS I [PRINTC	/PUT INTO BUFFER
	JMP WIOCH	/FATA ERROR
	ISZ LBP	/ADVANCE
	ISZ LBC	/COUNT
	JMP PMORE
FEOL,	CLA
	JMS I [OUTCR	/END LINE
WIOCH,	CLL CLA IAC RAL /2
WHOME,	JMP I WRITE
/
WRITE0, 0	/WRITE OUT THE LINE BUFFER
	SNA
	JMP WBAC	/DO NOTHING FOR UNIT ZERO
	DCA HLDU	/SAVE THE UNIT NUMBER
	CLL CLA CMA RTL /-3
	TAD HLDU
	SZA CLA	/MAIN OUTPUT UNIT
	JMP OU	/NO, OTHER UNIT
	TAD OPT4
	SMA CLA	/'Y' SET?
	JMP .+5	/NO
	TAD (5	/YES, OUTPUT TO UNIT 5 ALSO
	JMS WRITE
	SZA	/OK?
	JMP WBAC	/NO
	CLA IAC
	AND OPT2	/'L' SET?
	SNA CLA
	JMP .+5	/NO
	CLL CLA CML IAC RTL	/6
	JMS WRITE
	SZA	/OK?
	JMP WBAC	/NO
	TAD OPT3
	SMA CLA	/'M' SET
	JMP .+5	/NO
	CLL CLA IAC RTL /4
	JMS WRITE
	SZA	/OK?
	JMP WBAC	/NO
COMPIN, NOP	/MAY BE OVERLAYED TO CALL COMPRESS ROUTINE
CLL CLA CML IAC RAL	/3
	JMS WRITE
	SZA CLA	/OK?
	JMP WBAC	/NO
	TAD OPT5	/FORMFEED SETTING?
	SNA CLA
	JMP WBAC	/NO
	ISZ LC	/YES
	JMP WBAC	/NOT THIS TIME
	TAD (214	/FORMFEED
	JMS I [PRINTC	/OUTPUT IT
	JMP WIOCH2	/ERROR
	TAD OPT5
	CIA
	DCA LC	/RESET COUNT
	SKP
WIOCH2, CLL CLA IAC RAL /2
WBAC,	CDF CIF P
	JMP I WRITE0
OU,	TAD HLDU	/GET CHANNEL NUMBER
	JMS WRITE
	JMP WBAC
HLDU,	0
LC,	0
/
RESETB, 0	/RESET POINTERS OF LINE BUFFER
	TAD (LB
	MQL
	MQA
	DCA LBP
	CDF 10
	MQA
	DCA I (LBIP&177+7400
	SWP
	DCA I (LBOP&177+7400
	TAD (-MAXL-1
	DCA I (LBOC&177+7400
	CDF 0
	TAD (-MAXL-1
	DCA LBC
	JMP I RESETB
PAGE
FILB,	0	/EOF THE FILE AND FLUSH THE BUFFER
	TAD (232
MORFIL, JMS I [PRINTC
	JMP I FILB	/CHANNEL ERROR
	TAD WORP
	TAD CHARSW
	SZA CLA	/NEW BUFFER
	JMP MORFIL	/NO
	TAD CUR
	TAD (BMAX-1
	DCA T1
	TAD CURB
	DCA I T1	/INSERT INTO TABLE
	ISZ FILB	/NORMAL EXIT
	JMP I FILB
/
GETC,	0	/GET A CHARACTER OUT OF THE BUFFER
	TAD STAT
	SMA CLA	/CHARACTER AT A TIME?
	JMP .+4	/NO
	JMS I ENTRYP	/CALL IT (AC=0 MEANS READ)
	JMP I GETC	/ERROR
	JMP CZT	/CHECK FOR CONTROL Z
	TAD CHARSW	/0,1, OR 2
	TAD (JMP .+3
	DCA .+1
	HLT
	JMP GC1	/FIRST CHARACTER
	JMP GC2	/SECOND CHARACTER
	DCA CHARSW	/SET UP FOR FIRST NEXTIME
	CMA	/BACK UP POINTER
	TAD WORP
	TAD BUFBASE	/CORE ADDRESS
	DCA T1
	TAD I T1	/GET BITS 0 TO 3
	BSW	/MOVE TO LOWER PART OF WORD
	AND (74	/MASK OUT 4 BITS
	CLL RTL	/ALIGN AND CLEAR LINK
	MQL	/SAVE IT
	ISZ T1	/ADVANCE POINTER
	TAD I T1	/GET BITS 3 TO 7
	BSW	/MOVE TO LOWER PART OF WORD
	AND (74	/MASK OUT 4 BITS
	CLL RTR	/ALIGN WITH BIT 0
	MQA	/MASK IN LOWER 4
	AND (177	/NO PARITY
	DCA CHAR	/SAVE IN COMMON
	ISZ WORP	/ADVANCE BUFFER POINTER
	TAD WORP
	AND (377
	SZA CLA	/TEST FOR OVER BUFFER
	JMP CZT	/OK, NOW TEST FOR CONTROL Z	, OR TAB
	DCA WORP	/RESET POINTER
	ISZ CURB	/ADVANCE THE COUNT
	TAD CURB
	TAD MAXB	/COMPARE WITH MAXIMUN SIZE
	SZL CLA	/LINK CLEARED FROM PACKING
	JMP EOM	/END OF MEDIUM
	TAD CURB
	TAD BASEF	/COMPUTE BLOCK NUMBER
	DCA DISKAD
	TAD BUFBASE
	DCA CORAD	/BUFFER ADDRESS
	JMS I ENTRYP	/CALL HADDLER
	0200	/READ TWO RECORDS
CORAD,	0	/INTO THIS LOCATION
DISKAD, 0	/FROM HERE
	SKP	/CHANEL ERROR
	JMP CZT	/OK
	SMA CLA	/ONLY NEGATIVE IS FATAL
	JMP EOMF	/END OF FIEL FOUND
	IAC	/1 WILL BE ADDED TO THIS TO GET 2
	JMP I GETC	/FIRST EXIT, ONE IN AC
CZT,	TAD CHAR
	TAD (-32	/CHECK FOR LOGICAL EOF
	SNA CLA
	JMP SETEOF	/YES
EXTC,	ISZ GETC	/NORMAL EXIT
	JMP I GETC
SETEOF, JMS EOFSET	/SET THE BIT IN STATUS
EOM,	JMS EOFSET	/SET LOGICAL EOF
	JMP I GETC	/EOF EXIT
EOMF,	TAD [200
	MQL
	TAD STAT
	MQA	/OR IT IN
	DCA STAT
	JMP CZT
GC2,	ISZ WORP	/ADVANCE POINTER
GC1,	ISZ CHARSW	/SET FOR NEXT TIME
	TAD WORP	/GET RELATIVE POINTER
	TAD BUFBASE
	DCA T1
	TAD I T1
	AND (177	/MASK OUT JUNK AND PARIY
	DCA CHAR
	JMP CZT	/TEST FOR EOF
/
EOFSET, 0	/SET LOGICAL EOF
	CLL CLA IAC BSW /100
	MQL
	TAD STAT
	MQA	/OR IT IN CASE IT IS DONE TWICE
	DCA STAT
	JMP I EOFSET
PAGE
PUTC,	0	/PUT A CHARACTER IN AN OS/8 BUFFER
	TAD STAT
	SMA CLA	/CHARACTER AT A TIME?
	JMP .+6	/NO
	IAC	/AC NE 0 MEANS WRITE
	JMS I ENTRYP	/CALL IT
	JMP I PUTC	/ERROR
	ISZ PUTC
	JMP I PUTC
	TAD CHARSW	/0,1, OR 2
	TAD (JMP .+3
	DCA .+1
	HLT
	JMP CP1	/FIRST
	JMP CP2	/SECOND
	DCA CHARSW	/RESET FOR NEXT TIME
	CMA	/-1
	TAD WORP	/BACK UP POINTER
	TAD BUFBASE
	DCA T1
	TAD CHAR
	AND (160	/MASK OUT UPPER 3
	TAD [200	/SET PARITY
	CLL RTR	/ALIGN ON THE HALF WORD
	BSW	/PUT IN UPPER WORD
	MQL
	TAD I T1	/MESH THE TWO
	AND (377	/ALLOW WRITE AFTER READ
	MQA
	DCA I T1
	TAD CHAR
	AND (17	/LOWER BITS
	CLL RTL	/ALIGN WITH HALF WORD
	BSW	/PUT IN UPPER WORD
	MQL
	ISZ T1
	TAD I T1
	AND (377	/ALLOW WRITE AFTER READ
	MQA
	DCA I T1
	ISZ WORP	/ADVANCE IN BUFFER
	TAD WORP
	AND (377
	SZA CLA	/END OF BUFFER?
	JMP EXIT2	/NO, OK TO LEAVE
	DCA WORP	/YES, RESET
	TAD CURB
	TAD BASEF	/COMPUTE FILE BLOCK NUMBER
	DCA WDAD
	TAD BUFBASE
	DCA FROMAD
	JMS I ENTRYP	/WRITE
	4200	/WRITE 2 RECORDS
FROMAD, 0	/BUFFER ADDRESS
WDAD,	0	/DISK BLOCK NUMBER
	SKP	/CHANEL ERROR
	JMP .+3	/OK
	CLL CLA IAC
	JMP I PUTC	/FIRST EXIT WITH ONE IN AC