/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

	CLL CLA
	ISZ CURB
	TAD CURB
	TAD MAXB	/COMPARE
	SNL CLA
	JMP EXIT2
SETEOM, TAD (300	/SET LEOF,PEOF
	MQL
	TAD STAT
	MQA	/OR FOR SAFETY
	DCA STAT	/SET FOR NEXT TIME
EXIT2,	ISZ PUTC
	JMP I PUTC
CP2,	ISZ WORP	/ADVANCE ONE IN THE OS/8 BUFFER
CP1,	ISZ CHARSW
	TAD WORP
	TAD BUFBASE	/COMPUTE POINTER
	DCA T1
	TAD CHAR
	AND (177
	TAD [200	/SET PARITY
	DCA I T1
	JMP EXIT2
/
NAME2,	ZBLOCK 5	/ROOM HERE
PAGE
MES0,	0	/PRINT A FOUR CHARACTER ERROR MESSAGE
	DCA ARGP	/POINTER TO MESSAGE IN AC
	TAD I ARGP
	DCA ME1
	ISZ ARGP	/FOUT CHARACTERS
	TAD I ARGP
	CDF CIF 0
	DCA ME2
	SWP	/UNIT NUMBER IN MQ
	SNA
	JMP MOME	/0 IS OK
	JMS I [ONDECK	/ATTACH CHANEL
	HLT	/STOP FOR NOW
	JMS MESSG	/GENERAL PRINT MESSAGE
	IOER	/STARTING ADDRESS
	CLL CLA IAC
MOME,	MQL	/LOAD MQ WITH STATUS
	IAC
	TAD ARGP	/AC HAS RETURN ADDRESS
	CDF CIF P
	JMP I MES0
/
IOER,	TEXT /***** /
*.-1	/BACK UP OVER TRAILING ZEROES
ME1,	4040
ME2,	4040
	TEXT / ERROR/
/
MESS,	0
	CDF CIF 0
	CLA	/PROTECTION
	JMS I [ONDECK	/UNIT 0 WILL ALWAYS BE THE CONSOLE
	HLT	/SYSTEM ERROR
	TAD I MESS
	ISZ MESS
	DCA .+2
	JMS MESSG
	0	/ADDRESS OF MESSAGE
	HLT	/SYSTEM ERROR
/
	JMP I MESS
MESSG,	0	/GENERAL MESSAGE PRINTER
	TAD I MESSG	/ADDRESS OF MESSAGE
	DCA MESP
	ISZ MESSG	/FIRST EXIT AFTER ARG
MCK,	TAD I MESP
	SNA	/12BITS OF ZERO IS END
	JMP MDONE
	JMS PR2	/PRINT TWO CHARACTERS
	JMP I MESSG	/ERROR
	ISZ MESP	/NEXT RWO
	JMP MCK	/CHECK FOR END
MDONE,	JMS I [OUTCR	/END LINE
	JMP I MESSG
	ISZ MESSG	/NORMAL EXIT
	JMP I MESSG
MESP,	0
/
PR2,	0
	DCA MTE	/PUT IN TEMP
	TAD MTE
	BSW	/PRINT UPPER BYTE FIRST
	JMS I (SIX28	/CONVERT TO ASCII
	JMS I [PRINTC
	JMP I PR2	/ERROR
	TAD MTE
	JMS I (SIX28	/PRINT LOWER SIX
	DCA CHAR
	JMS I (PUTC
	JMP I PR2	/ERROR
	ISZ PR2
	JMP I PR2
MTE,	0	/TEMP
/
PRINTC, 0
	DCA CHAR
	JMS I [PUTC
	JMP I PRINTC
	ISZ PRINTC
	JMP I PRINTC
/
ASC2I,	0	/CHECK FOR CR AND LF
	TAD (-40	/CONTROL?
	TAD CHAR
	SPA CLA
	JMP CRCK	/CHECK FOR CR
	TAD CHAR	/NO ALLOW ANYTHING ELSE
ASCEX,	ISZ ASC2I
	JMP I ASC2I	/NORMAL EXIT
CRCK,	TAD (-15	/CR IS SPECIAL
	TAD CHAR
	SZA CLA
	JMP .+3
	CMA	/-1
	JMP ASCEX	/NORMAL EXIT
	TAD (-12	/LINE FEED?
	TAD CHAR
	SNA CLA
	JMP I ASC2I	/IGNORE
	TAD CHAR
	TAD (-14	/VERTICLE FORM FEED?
	SNA CLA
	JMP I ASC2I	/IGNORE THEM
	JMP ASCEX-1	/COULD BE LOWER CASE
/
MESS4,	0	/PRINT A MESSAGE ON UNIT 4
	CDF CIF 0	/SAFETY
	CLL CLA IAC RTL /4
TRY0,	JMS I [ONDECK
	HLT
	TAD I MESS4	/GET ADDRESS OF MESSAGE
	DCA .+2
	JMS MESSG
	0	/PONITER GOES HERE
	JMP TRY0	/FAILURE, TRY UNIT 0
	ISZ MESS4
	JMP I MESS4
PAGE
OUTCR,	0	/OUTPUT A CARRIAGE RETURN AND LINE FEED
	TAD (215
	JMS I [PRINTC
	JMP I OUTCR
	TAD (212
	JMS I [PRINTC
	JMP I OUTCR
	ISZ OUTCR
	JMP I OUTCR
/
CCCK,	0
	KRB	/READ IT
	CIA
	DCA CTEMP
	TAD (203
	TAD CTEMP
	SNA CLA
ABORT,	JMP I (7605
	TAD CTEMP
	TAD CNTRLB	/ADD CONTROL B
	SZA CLA
	JMP I CCCK	/IGNORE IT
	JMP I [TRACEB	/TRACEBACK
CTEMP,	0
/
LPT,	0	/INTERNAL CHARACTER HANDLER FOR LINE PRINTER
	SNA CLA	/OUTPUT ONLY
	JMP I TTY	/ERROR
LCK,	KSF	/CHECK FOR USER CALLING
	SKP
	JMS I [CCCK
	LSE	/HARDWARE ERROR
	SKP	/NO
	JMP I LPT	/ERROR
	TAD LGNG	/ALREADY GOING
	SZA CLA
	JMP .+4	/YES
	TAD (214	/TOP OF FORM
	LLS
	DCA LGNG
	LSF
	JMP LCK
	TAD CHAR
	LLS
	CLA IAC
	DCA LGNG
	ISZ LPT	/NORMAL EXIT
	JMP I LPT
LGNG,	0	/LPT GOING FLAG
DONO,	0	/DO NOTHING DEVICE HANDELER
	SZA CLA	/READ OR WRITE
	JMP .+3	/WRITE
	IAC
	JMP I DONO	/EOF ON READ
	ISZ DONO
	JMP I DONO
/
TTY,	0	/TTY OUTPUT
	SNA CLA	/NON ZERO IS OUTPUT
	JMP I TTY	/ERROR TO INPUT
	ISZ TTY	/NORMAL EXIT FROM HERE ON
TWAIT,	KSF
	SKP
	JMS I [CCCK
	TAD TGNG	/TTY GOING?
	SNA CLA
	JMP .+3	/NO
	TSF
	JMP TWAIT
	TAD CHAR
	TLS
	CLA IAC
	DCA TGNG	/FROM NOW ON ITS GOING
	JMP I TTY
/
TGNG,	0	/TYY GOING FLAG
END0,	CIF CDF 0
	TAD (1001
	DCA I (7746	/DON'T MAKE USR SAVE ANYTHING
	CIF 10
	JMS I (7700
	10	/USR IN
	JMS I (CLOSE
	3
	ONAME
	JMS CLOSER	/CHECK FOR ERROR
	TAD EXFILE	/COULD BE ANY CHANNEL FROM 4 TO 9
	DCA .+2
	JMS I (CLOSE
	4
	MNAME
	JMS CLOSER
	JMS I (CLOSE	/COULD BE A USER SPECIFIED FILE FOR 2
	2
	NAME2
	JMS CLOSER
	JMP I (7605	/BACK TO OS/8
/
CLOSER, 0
	SNA CLA	/CHECK FOR ERROR
	JMP I CLOSER	/OK
	JMS I [MESS
	OPPS
	JMP I CLOSER
PAGE
INEXT,	0	/SET UP FOR NRXT INPUT FILE
	CLA CLL IAC RAL /2
	TAD INP	/ADVANCE POINTER TO NEXT FILE
	DCA INP
	TAD (-7642	/CHECK FOR OVER LAST INPUT ENTRY
	TAD INP
	SMA CLA
	JMP I INEXT	/NO 10TH FILE
	CDF 10
	DLD
INP,	7615	/FIRST ENTRY-2
	DCA BASEF	/STORE BASE POINTER
	CDF 0
	MQA	/GET DEVICE NUMBER AND LENGHT
	SNA	/CHECK DEVICE NUMBER
	JMP I INEXT	/FIRST EXIT, NOTHING LEFT
	AND (7760	/MASK OUT LENGHT
	SNA
	JMP .+5	/BIG FILE MUST HAVE CONTROL Z AT END
	CLL CML RAR	/ARITHMETIC SHIFT
	CLL CML RAR
	CLL CML RAR
	CLL CML RAR
	DCA MAXB
	MQA
	AND (17	/GET DEVICE NUMBER
	CIA
	TAD INHAND	/COMPARE
	SNA CLA
	JMP NOLOAD	/SAME, NO REASON TO LOAD
	MQA
	AND (17
	DCA INHAND	/UPDATE
	TAD (IHAND+1
	DCA .+5
	TAD INHAND
	CIF 10
	JMS I USR	/CALL USER WHEREVER IT IS
	1	/LOAD A HANDLER
	IHAND+1	/ROOM FOR TWP PAGE HANDLER
	JMP LDER
	TAD .-2	/GET ENTRY POINT
	DCA ENTRYP
NOLOAD, DCA CURB
	DCA CHARSW
	DCA WORP
	CLL CLA CML IAC RAL	/3
	DCA STAT	/REWOUND AND READ ONLY
	ISZ INEXT	/NORMAL EXIT
	JMP I INEXT
/
LDER,	JMS I [MESS	/ERROR IN LOADING HANDLER
	INER
	JMP I INEXT	/MAKE BELIVE AN EOF
/
RWND0,	0	/REWIND UNIT IN AC
	SNA
	JMP RWH	/EVERYTHINGS OK ON UNIT 0
	JMS I [ONDECK
	JMP RWIOCH	/ERROR
	TAD BASEF
	SNA CLA	/FILE STRUCTURED DEVICE?
	JMP RWIOCH	/NO, NO REWIND
	CLL CLA CML RTR /2000
	AND STAT	/CONTROL OK?
	SZA CLA
	JMP RWIOCH	/NO
	CLL CLA IAC RTL /4
	AND STAT
	SNA CLA	/WRITTEN ON?
	JMP CLREOF	/NO, CLEAR ONLY
	JMS I (FILB	/INSERT CONTROL Z AND FILL BUFFER
	JMP RWIOCH	/ERROR
CLREOF, TAD (7472	/CLEAR WRITTEN ON, EOF-EOM, AND REWOUND BITS
	AND STAT
	IAC	/SET REWOUND BIT
	DCA STAT
	DCA WORP
	DCA CHARSW
	DCA CURB
	CLL CLA CMA RTL /-3
	TAD CUR	/MAIN OUTPUT?
	SZA CLA
	JMP .+4	/NO
	TAD OPT5	/YES
	CIA
	DCA LC	/RESET LINE COUNT
RWH,	CIF CDF P
	JMP I RWND0	/GO HOME
RWIOCH, CLL CLA IAC
	JMP RWH
/
/
PAGE
COMPRESS,	0
	TAD (LB
	DCA COP
	TAD (LB
	DCA CIP
	DCA CCNT
CNEXT,	TAD I CIP	/GET NEXT CHARACTER
	DCA CHAR	/SAVE IT
ENDCK,	TAD CHAR	/CHECK FOR END OF LINE
	SPA
	JMP TRAIL	/DELEAT TRAILING JUNK
	TAD (-40	/SPACE?
	SNA CLA
	JMP FNDB	/FOUND A BLANK
	TAD CHAR
	DCA I COP	/COPY TO OUTPUT
	ISZ COP
	TAD CHAR
	TAD (-11	/HORIZONTAL TAB?
	SNA CLA
	JMP .+3
	ISZ CCNT	/NO
	SKP
	DCA CCNT	/YES, MAKE BELIEVE ALIGNED
	ISZ CIP
	JMP CNEXT
TRAIL,	CLA CMA	/MAKE ENS OF BUFFER
	DCA I COP
	CLA CMA	/BACK UP POINTER
	TAD COP
	DCA COP
	TAD I COP
	DCA CHAR
	TAD CHAR
	SPA CLA	/BEGINNING OF LINE?
	JMP I COMPRESS	/YES
	TAD CHAR
	TAD (-40	/SPACE
	SNA CLA
	JMP TRAIL
	TAD CHAR
	TAD (-11
	SZA CLA
	JMP I COMPRESS	/NO MORE POSSIBLE
	JMP TRAIL
FNDB,	DCA SPC	/CLEAR SPACE COUNT
	ISZ SPC	/INC SPACE COUNT
	ISZ CIP	/GET NEXT CHARACTER
	TAD I CIP
	DCA CHAR
	TAD CCNT
	TAD SPC
	AND (7
	SNA CLA	/NEW TAB?
	JMP INTAB	/YES
	TAD CHAR	/NO
	TAD (-40	/ANOTHER SPACE?
	SNA CLA
	JMP FNDB+1	/YES
	TAD CHAR
	TAD (-11	/TAB?
	SNA CLA
	JMP OTAB	/YES, DELEATE PRECEEDINF BLANKS
EXSPAC, TAD SPC
	CIA	/GET COUNT OF SPACES
	DCA T1
SPCIT,	TAD (40
	DCA I COP
	ISZ COP
	ISZ T1
	JMP SPCIT	/MORE
	TAD SPC	/UPDATE COLUMN COUNT
	TAD CCNT
	DCA CCNT
	JMP ENDCK	/NOW CHECK FOR END
INTAB,	CLA CMA	/INSERT A TAB
	TAD SPC	/EXCEPT FOR SINGLE SPACE
	SNA CLA
	JMP EXSPAC	/INSERT A SINGLR SPACE
OTAB,	TAD (11	/OUTPUT A TAB
	DCA I COP
	DCA CCNT	/RESET TO BEGINNING OF FIELD
	ISZ COP
	JMP ENDCK
/
COP,	0	/COMPRESSION OUTPUT POINTER
CIP,	0	/COMPRESSION INPUT POINTER
SPC,	0	/NUMBER OF ENCOUNTERED CONTIGUIOUS BLANKS
CCNT,	0	/VIRTUAL COULUM COUNT
/
ENDB,	0	/DELEATE TRAILING BLANKS ONLY
	TAD ENDB	/PUT RETURN ADDRESS ENSE WHERE
	DCA COMPRESS
	TAD (LB
	DCA COP
BLOOK,	TAD I COP
	SPA CLA	/LOOK FOR END
	JMP TRAIL
	ISZ COP	/NO
	JMP BLOOK
PAGE
	-1	/BEGINNING OF LINE FOR COMPRESSION
LB,	/LINE BUFFER
/
/ONCE ONLY STUFF IS KEPT IN LB
LINK0,	MUL0	/2
	DIV0	/3
	READ0	/4
	WRITE0	/5
	RWND0	/6
	MES0	/7
	END0	/10,12
DUMMY,	FILENAME S2TEMP.TM
SMLCORE,TEXT+NOT ENOUGH MEMORY.+
TERROR, TEXT+ERROR IN OPENING CHANNEL 2+
MESMES, TEXT+ERROR IN OPENING EXTRA CHANNEL+
OER,	TEXT+ERROR IN OPENING OUTPUT CHANNEL 3.+
OPER,	TEXT+ERROR ENCOUNTERED IN PROCESSING OUTPUT OR CHAIN OPTION+
NOEAE,	TEXT+NO EAE+
*LB+MAXL
	-1	/SENTINAL AT END OF BUFFER
INER,	TEXT+ERROR IN LOADING INPUT HANDLER FOR CHANNEL 1+
OPPS,	TEXT+ERROR IN CLOSING FILE.+
MULV,	TEXT+MULTIPLY OVERFLOW.+
DBY0,	TEXT+DIVIDE BY ZERO+
MNAME,	ZBLOCK 5
ONAME, ZBLOCK 5
BMAX,	ZBLOCK 11	/9 ENTRIES, MAXIMUM BLOCK WRITTEN
DSRN,	TTY;ZBLOCK 5;4000;0
	DONO;0;0;IBUF;0;0;4102;0	/CHARACTER,EOFED,READONLY
	DONO;0;0;FL2B;0;0;4000;0
	DONO;0;0;OBUF;0;0;4000;0
	TTY;0;0;MBUF;0;0;4000;0
	TTY ;ZBLOCK 5;4000;0
	LPT ;ZBLOCK 5;4000;0
	DONO;ZBLOCK 5;4000;0
	DONO;ZBLOCK 5;4000;0
	DONO;ZBLOCK 5;4000;0
PAGE
IHAND=.
OHAND=IHAND+400
MHAND=OHAND+400
FL2H=MHAND+400
IBUF=FL2H+400
OBUF=IBUF+400
FL2B=OBUF+400
MBUF=FL2B+400
*IBUF	/PUT INIT IN IO BUFFERS
MAKE2,	0	/OPEN A FILE FOR CHANNEL 2
	TAD OPT3
	AND (20
	SNA CLA
	JMP USPEC	/USER SPECIFIED?
	CLL CLA IAC RAL /2
	JMS I [ONDECK
	HLT
	CLL CLA IAC	/SYS IS 1
	CIF 10
	JMS I [200
	3	/OPEN
SB,	DUMMY
BL,	0
	JMP M2ER
	TAD SB
	DCA BASEF
	TAD BL
	DCA MAXB
	TAD (FL2B
	DCA BUFBASE
	TAD (7607
	DCA ENTRYP
	IAC
	DCA STAT	/REWOUND
	JMP I MAKE2
M2ER,	CLA IAC
	JMP I MAKE2
/
USPEC,	JMS I (OPENO	/CHECK FOR FILE
	2
	7605-1	/SECOND ENTRY
	FL2H+1	/ROOM FOR TWO PAGE HANDLER
	NAME2-1
	SKP	/FILE OPENED
	JMP I MAKE2	/ERROR OR NO FILE
	CLA IAC	/REWOUND
	DCA STAT	/CLEAR CONTROL RESTRICTIONS
	JMP I MAKE2
CHECK4, 0	/CHECK MESSAGE OPTIONS
	CLL CLA IAC RTL /4
	JMS I [ONDECK
	HLT
	CLL CLA CML RTR //SET BIT 1
	AND OPT3	/SEE IF N WAS SET
	SNA CLA
	JMP OTHER	/SEE IF OTHER DESTIMATION
	TAD (DONO
	DCA ENTRYP
	JMP I CHECK4
/
OTHER,	CLL CLA IAC RTL /4
	DCA EXFILE	/DEFAULT IS 4
	TAD OPT4	/CHECK FOR OPTIONS 4 THROUGH 9
	AND (77
	SNA
	JMP OPN4	/OPEN IT UNDER THE GUISE OF CHANNEL FOUR
	MQL	/SAVE
	DCA EXFILE	/CLEAR COUNT
	MQA	/BRING OPTION BACK
	CLL RTL	/ALIGN SO THAT SHIFT COUNT IS OPTION
	ISZ EXFILE
	CLL RAL
	SMA	/BIT IN HIGH POSITION
	JMP .-3	/NO
	CLA	/RECOGNIZE LOWEST NUMBER

OPN4,	TAD EXFILE
	DCA .+2
	JMS I (OPENO
	4	/ON CHANEL 4
	7612-1	/THIRD FILE
	MHAND+1	/ROOM FOR TWO PAGE HANDLER
	MNAME-1	/STORAGE FOR FILE NAME
	SKP
	JMP I CHECK4	/EITHER NO FILE, OR ERROR
	CLA IAC	/REWOUND
	DCA STAT
	JMP I CHECK4
/
/
FRSTIN, TEXT+NO INPUT FILES+
PAGE
OPENO,	0	/OPEN AN OUTPUT FILE IF SPECIFIED
	JMS ONEXP	/GET CHANEL NUMBER
	DCA T1
	JMS ONEXP	/GET POINTER TO FILE NAME IN FIELD 1
	DCA CDP
	JMS ONEXP	/GET POINTER TO HANDLER	PAGE
	DCA HANP
	JMS ONEXP
	DCA NAMEP
	TAD T1	/CHANEL NUMBER
	JMS I [ONDECK
	HLT	/SHOULD NEVER HAPPEN
	JMS I [MOVE	/BRING FILE SPEC IN
CDP,	0
	CDF 10
NAMEP,	0
	CDF 0
	-5
	ISZ NAMEP	/POINT TO FILE NAME
	TAD I NAMEP	/WAS A FILE SPECIFIED
	SNA
	JMP OEREX+1	/NO FILE
	CIF 10
	JMS I [200
	1	/LOAD HANDLER
HANP,	0
	JMP OEREX	/VERY BAD
	TAD NAMEP
	IAC	/POINT TO FILE NAME
	DCA OA1
	TAD I NAMEP	/GET DEVICE AND LENGHT AGAIN
	CIF 10
	JMS I [200
	3	/OPEN
OA1,	0
OA2,	0
	JMP OEREX
	TAD OA2	/LENGHT
	DCA MAXB
	TAD OA1
	DCA BASEF
	TAD HANP
	DCA ENTRYP
	JMP I OPENO	/NORMAL EXIT
OEREX,	CLL CLA IAC	/ERROR EXIT
	ISZ OPENO	/NO FILE EXIT
	JMP I OPENO
/
ONEXP,	0	/GET NEXT ARG
	TAD I OPENO
	ISZ OPENO
	JMP I ONEXP
/
OPEN3,	0
	JMS I (OPENO	/OPEN THREE FOR OUTPUT
	3
	7600-1
	OHAND+1
	ONAME-1
	JMP CNGSTAT
	JMP I OPEN3
CNGSTAT,DCA STAT
	JMP I OPEN3
/
CORE,	0	/GET BIGGEST FIELD
	CLA CLL
COR0,	CDF 0
	TAD CORSIZ
	RTL
	RAL
	AND COR70
	TAD COREX
	DCA .+1
COR1,	CDF
	TAD I CORLOC
COR2,	NOP
	DCA COR1
	TAD COR2
	DCA I CORLOC
COR70,	70
	TAD I CORLOC
CORX,	7400
	TAD CORX
	TAD CORV
	SZA CLA
	JMP COREX
	TAD COR1
	DCA I CORLOC
	ISZ CORSIZ
	JMP COR0
COREX,	CDF 0
	CLL CMA	/RETURN HIGHEST FIELD NUMBER
	TAD CORSIZ
	JMP I CORE
CORLOC, CORX
CORV,	1400
CORSIZ, 1
/
PAGE
MOVE,	0	/GENERAL CORE MOVER
	TAD I MOVE	/ADDRESS-1 OF FROM
	DCA XR1
	TAD MOVE
	DCA XR3
	TAD I XR3
	DCA FRMFLD
	TAD I XR3
	DCA XR2
	TAD I XR3
	DCA TOFLD
	TAD I XR3
	DCA T1
FRMFLD, 0
	TAD I XR1
TOFLD,	0
	DCA I XR2
	ISZ T1
	JMP FRMFLD
	CDF CIF 0
	JMP I XR3
/
CKPK,	0
	TAD (10
	AND OPT3	/IS U FOR UNPACKED SET?
	SNA CLA
	JMP PCK	/NO
	TAD PTRDIF	/NEEDED TO CALCULATE ADDRESSES
	DCA I (PDIF4
	CLL CLA IAC RTL /4
	DCA NWORDS
	TAD (GET&177+7400
	DCA PVEC
	TAD (STO&177+7400
	DCA PVEC+1
	JMP PFIN
PCK,	TAD PTRDIF	/NEEDED TO CALCULATE ADDRESSES
	DCA I (PDIF2
	JMS I [MOVE
	STO2-1
	CDF 0
	7200-1
	CDF 10
	-200
	TAD (GET2&177+7200
	DCA PVEC
	TAD (STO2&177+7200
	DCA PVEC+1
	CLL CLA IAC RAL /2
	DCA NWORDS
PFIN,	CLA CMA	/MINUS ONE FOR XR
	TAD GTP
	DCA TOP
	JMS I [MOVE
	PVEC-1
	CDF 0
TOP,	0
	CDF 10
	-4
	JMS I [MOVE
	CHARG-1
	CDF 0
	7400-1
	CDF 10
	-200
	TAD OPT5	/FORMFEED REQUEST
	CIA
	DCA I (LC
	TAD [200
	AND OPT2
	SNA CLA
	JMP .+3
	TAD (JMS I [ENDB
	DCA I (COMPIN
	TAD (1000	/CHECK FOR A 'C'
	AND OPT2
	SNA CLA
	JMP I CKPK	/NO
	TAD (JMS I [COMPRESS	/GET INSTRUCTION
	DCA I (COMPIN	/PUT INLINE
	JMP I CKPK
PVEC,	ZBLOCK 2
	CHARG&177+7400
	CHARP&177+7400
PAGE
STARTUP,SWAB	/START OUT RIGHT FROM HE BEGINNING
	CAM
	DPSZ	/CHECK FOR EAE
	SKP	/NOT IN
	JMP .+4
	JMS I [MESS
	NOEAE
	JMP I (7605	/FAST EXIT
	JMS I (CORE	/GET NUMBER OF FIELDS
	DCA HICORE
	CLL CLA CML RTL /6
	AND HICORE
	SZA CLA
	JMP LOTSACORE
	JMS I [MESS
	SMLCORE
	JMP I (7605
LOTSACO,TAD (1001	/NO RESTART, NO SAVE 10000-11777
	DCA I (7746	/JOB STATUS WORD
	JMS I [MOVE	/SAVE STUFF IN FIELD 1 FROM USR
	0-1
	CDF 10
	0-1
	CDF 20
	-2000
	CIF 10
	JMS I (7700	/CALL URS
	10	/LOCK INTO CORE
RESTAR, CIF 10
	JMS I [200
	5	/CALL CD
	2362	/S2
	DCA I (TGNG	/CLEAR GOING FLAG CAUSE OF CD
	JMS I [MOVE	/BRING OPTIN DATA INTO FIELD 0
	7642-1
	CDF 10
	OPT1-1
	CDF 0
	-5
	JMS I (OPEN3	/PROCESS OUTPUT SPECS FIRST
	SNA CLA
	JMP .+4	/NO ERRORS
	JMS I [MESS
	OER
	JMP RESTAR
	SNA CLA
	JMP .+4
	JMS I [MESS
	OPER
	JMP RESTAR
	JMS I (MAKE2	/CREAT A TEMP?
	SNA CLA
	JMP OK2	/2 IS OK
	JMS I [MESS
	TERROR
	JMP RESTAR
OK2,	JMS I (CHECK4	/DIFFERENT MESSAGE FILE?
	SNA CLA
	JMP .+4
	JMS I [MESS
	MESMES
	JMP RESTAR
	CLA IAC
	JMS I [ONDECK	/READY FOR INPUT
	HLT	/SYSTEM ERROR
	JMS I (INEXT	/BRING IN FIRST FILE AS LONG AS USR IS IN
	SKP	/ERROR
	JMP .+4
	JMS I [MESS
	FRSTIN
	JMP RESTAR
	TAD (7700
	DCA USR	/TELL INEXT TO	CALL IN OVERLAY
	JMS I [MOVE
	0-1
	CDF 20
	0-1	/BRING STUFF BACK
	CDF 10
	-2000
	TAD (1000	/USR MUST SAVE	FIELD 1 STUFF
	DCA I (7746
	JMS I [MOVE	/LINK TWO FIELDS TOGETHER
	200-1
	CDF P
	STARTAD-1	/LOCAL CODE
	CDF 0
	-6	/STARTAD,PTRDIF,PTR9+1,LOC100,LOC93,GTP
	JMS I [MOVE
	LINK0-1 /ADDRESSS OF FIELD 0 ROUTINES
	CDF 0
	200-1
	CDF P
	-7
	JMS I (CKPK	/CHECK FOR PACKED-UNPACKED
	TAD (20
	AND OPT2	/CHECK FOR AN H
	SNA CLA
	JMP .+3 /NO
	CLL CLA CML RTR /2000
	DCA TABCK	/NO CHARACTER WILL LOOK LIKE THIS
	JMS I [RESETB
	TAD HICORE
	CDF CIF P
	DCA I PTR9	/SET HIGHEST FIRLD
	ISZ PTR9	/POINT TO LOW ORDER BITS OF A
	TAD NWORDS
	DCA I PTR9	/USED IN MEMORY CALCULATION
	SWAB	/CLEAR MQ
	JMP I STARTAD	/START STAGE 2 CODE
/
HICORE, 0	/HIGHEST CORE FIELD
PAGE
CHARG,	0	/GET A CHARACTER OUT OF THE LINE BUFFER
	CDF 0
	TAD I LBIP	/GET A CHARACTER
	CDF 10
	ISZ LBIP	/ADVANCE OR NEXTIME
	JMP I CHARG
/
/
CHARP,	0	/PUT A CHARACTER INTO THE LINE BUFFER.
	CDF 0
	SPA	/EOL?
	JMP EOL /YES
	DCA I LBOP	/SAVE IT
	ISZ LBOC	/LINE FULL?
	JMP LBOK	/NO
	CMA	/CHANGE CHARACTER TO A -1
EOL,	DCA I LBOP	/OVERLAY WITH -1
	TAD (LB
	DCA LBOP
	TAD (-MAXL-1
	DCA LBOC
	IAC	/INDICATE CHARACTER REJECTED
	SKP	/DO NOT ADVANCE AFTER END OF LINE
LBOK,	ISZ LBOP	/ADVANCE FOR NEXT TIME
	CDF 10
	JMP I CHARP
LBIP,	LB	/LINE BUFFER INPUT POINTER
LBOP,	LB	/LINE BUFFER OUTPUT POINTER
LBOC,	-MAXL-1 /OUTPUT COUNT
/
STO,	0	/STORE A VALUE
	CAM
	TAD I STO
	DCA RP1 /PUT IN LINE
	ISZ STO
	TAD I STO	/ADDRESS OF FLAG
	ISZ STO /SET FOR RETURN
	DCA FP1
	DLD
RP1,	0	/ADDRESS OF ADDRESS
	SHL; 2	/TIMES FOUR TO GET WORD ADDRESS
	CLL RAL /OH WHY OH WHY DID DEC DO IT THIS WAY
	CLL RTL /SHIFT FIELD INTO PLACE
	TAD (CDF 20	/ADD IN OFFSET AND MAKE AN INSTRUCTION
	DCA MEMF1
	SWP	/GET LOWER BITS INTO AC
	DCA MEMP1
	DLD
FP1,	0	/ADDRESS OF FLAG AND VALUE REGISTARS
MEMF1,	HLT	/CHANGE FIEELDS
	DST
MEMP1,	0
	CLL CLA IAC RAL /2
	TAD MEMP1
	DCA MEMP2	/ADDRESS OF POINTER IN SAME FIELD
	TAD FP1
	TAD PDIF4	/CREATE A POINTER TO THE POINTER
	DCA PP1
	TAD MEMF1
	DCA MEMF2
	CDF 10
	DLD
PP1,	0	/GET PTR VALUE
MEMF2,	HLT	/CHANGE TO MEM FIELD
	DST
MEMP2,	0
	CAM
	CDF CIF 10
	JMP I STO
/
GET,	0	/GET A VALUE OUT OF FLUB MEMORY
	CAM
	TAD I GET	/GET POINTER TO ADDRESS
	DCA RP2 /ADDRESS OF MEMORY ADDRESS
	ISZ GET
	TAD I GET	/GET POINTER TO FLAG
	ISZ GET /SET UP FOR RETURN
	DCA FP2
	DLD
RP2,	0	/GET MEMORY ADDRESS
	SHL; 2	/TIMES FOUR TO GET WORD ADDRESS
	CLL RAL
	CLL RTL /MAKE MEMORY FIELD INSTRUCTION
	TAD (CDF 20	/ADD IN OFFSET AND MAKE AN INSTRUCTION
	DCA MEMF3
	SWP	/GET LOWER ADDRESS BITS
	DCA MEMP3
MEMF3,	HLT	/CHANGE TO FLUB MEMORY FIELD
	DLD
MEMP3,	0	/GET FLAG AND VALUE
	CDF 10
	DST
FP2,	0
	CLL CLA IAC RAL /2
	TAD MEMP3	/STILL IN SAME FIELD
	DCA MEMP4
	TAD FP2
	TAD PDIF4	/CREATE A POINTER TO THE POINTER
	DCA PP2
	TAD MEMF3
	DCA .+1
	HLT
	DLD
MEMP4,	0
	CIF CDF 10
	DST
PP2,	0
	CAM
	JMP I GET
PDIF4,	0	/FILLED IN AT RUN TIME
PAGE
STO2,	0	/STORE A VALUE IN FLUB MEMORY
	CAM
	TAD I STO2	/GET ADDRESS OF ADDRESS
	DCA .+2
	DLD
	0	/GET FLUB ADDRESS
	SHL; 1	/TIMES 2 TO CONVERT TO WORDS
	CLL RTL /EXTRACT FILED BITS
	CLL RAL
	TAD (CDF 20	/ADD IN OFFSET AND MAKE AN INSTRUCTION
	DCA ST2C1
	SWP
	DCA ST2P1	/LOWER BITS
	ISZ STO2
	TAD I STO2	/GET POINTER TO FLAG
	ISZ STO2	/GET SET FOR RETURN
	DCA .+2
	DLD
FP21,	HLT
	IAC	/BIAS THE	VALUE
	DCA HLD1	/SAVE FOR TESTING
	TAD P7600	/7 BITS ONLY
	AND HLD1
	SZA CLA
	JMP VALER
	TAD HLD1
	SHL; 5	/SHIFT INTO PLACE
	SWP
	CLL RTR /MOVE HESE TWO BITS BACK 2
	MQA	/COMBINE
	DCA HLD1
	TAD FP21
	TAD PDIF2	/MAKE POINTER TO PTR
	DCA .+2
	DLD
	0	/PICK UP PTR
	TAD P4	/SET BIAS
	DCA HLD2	/SAVE FOR TESTING
	TAD P7770	/TREE BITS ONLY
	AND HLD2
	SZA CLA
	JMP PTRER
	TAD HLD1
	TAD HLD2	/MESH WITH FLAG AND VAL
ST2C1,	HLT	/CHANGE TO CORRECT FIELD
	DST
ST2P1,	0	/STORE IT
	CAM
	CDF CIF 10
	JMP I STO2
/
GET2,	0	/GET A PACKED VALUE
	CAM
	TAD I GET2	/GET ADDRESS OF ADDRESS
	DCA .+2
	DLD
	0
	SHL; 1
	CLL RTL
	CLL RAL /GET FIELD
	TAD (CDF 20	/ADD IN OFFSET AND MAKE AN INSTRUCTION
	DCA GT2C1
	SWP	/GET LOWER BITS
	DCA GTP21
	ISZ GET2
	TAD I GET2
	ISZ GET2
	DCA GF21
GT2C1,	HLT	/CHANGE TO STORAGE FIELD
	DLD
GTP21,	0	/PICK UP PACKED INFO
	CDF 10
	DST; HLD1&177+7200
	LSR; 3
	MQL
	MQA
	AND P3	/GET FLAG OUT
	SWP
	CLL RAR /ALIGN
	CLL RAR
	TAD (-1 /UNBIAS
	DST
GF21,	0	/FLAG AND VALUE
	CLA
	TAD GF21
	TAD PDIF2	/MAKE POINTER TO PTR
	DCA GF22
	TAD HLD1
	MQL
	TAD HLD2
	AND P7	/MASK OUT 3 BITS
	TAD M4	/TAKE OUT BIAS
	DST
GF22,	0	/POINTER TO PTR
	CAM
	JMP I GET2	/RETURN
/
HLD1,	0	/TENP
HLD2,	0
P4,	4
P7600,	7600
P7770,	7770
P3,	3
P7,	7
M4,	-4
PDIF2,	0	/FILLED IN AT RUN TIME
/
VALER,	CIF CDF 0
	JMP I (VALER0
PTRER,	CIF CDF 0
	JMP I (PTRER0
/
PAGE
$