/ E8FILE

	PAGE  /-------------------------- 2200

/ RENDER MODE LINES
RMODE,	0
	JMS I [RNDINI		/ BASE MODE LINE
	TAD (MLBASE
	JMS I [WR6
	WRRND
	JMS I [RNDFIN	

	TAD CHANGD		/ INDICATE BUFFER CHANGED
	SNA CLA
	JMP RMODEB
	TAD (RNDBUF+1
	DCA RNDP
	TAD (CHGMSG
	JMS I [WR6
	WRRND

RMODEB,	TAD (RNDBUF+5		/ FILE NAME
	DCA RNDP
	TAD FILENM+3		/ SAVE EXTENSION
	DCA RMODET
	DCA FILENM+3
	TAD (FILENM
	JMS I [WR6
	WRRND
	TAD (DOT
	JMS I [WRRND
	TAD RMODET
	DCA FILENM+3
	TAD (FILENM+3
	JMS I [WR6
	WRRND

	JMS BUFSIZ		/ BUFFER SIZE IN AC24
	TAD (RNDBUF+23		/ POINTER TO LSD OF DECIMAL SIZE
	DCA RNDP

RMODEA,	TAD (12			/ WRITE DECIMAL TO RENDER BUFFER
	JMS I [DIVIDE		/ IN REVERSE. WORKS FOR SIZE < 100000
	TAD AC24+1
	TAD (ZERO	
	SCRFLD
	DCA I RNDP
	CODFLD
	STA
	TAD RNDP
	DCA RNDP
	DCA AC24+1
	TAD AC24
	SZA CLA
	JMP RMODEA

	JMP I RMODE
	
RMODET,	0
MLBASE,	TEXT /----                /
CHGMSG,	TEXT /**/

/ 24-BIT ARITHMETIC. ALL BINARY OPS USE AC24 AND TWO-WORD VALUE
/ POINTED T0 BY WORD FOLLOWING JMS. 24-BIT DOUBLEWORDS ARE
/ LITTLE-ENDIAN, OF COURSE.

P24,	0

/ CLEAR 24-BIT ACCUMULATOR
CLR24,	0
	DCA AC24
	DCA AC24+1
	JMP I CLR24

/ LOAD 24-BIT ACCUMULATOR
LD24,	0
	DCA P24
	TAD I P24
	DCA AC24
	ISZ P24
	TAD I P24
	DCA AC24+1
	JMP I LD24

/STORE 24-BIT ACCUMULATOR
ST24,	0
	DCA P24
	TAD AC24
	DCA I P24
	ISZ P24
	TAD AC24+1
	DCA I P24
	JMP I ST24

/ ADD A 15-BIT POINTER TO AC24, WHICH HOLDS THE RESULT OF
/ A SUB15 OPERATION, TO YIELD A 15-BIT POINTER
ADD15,	0
	DCA P24
	CLL
	TAD AC24
	TAD I P24
	DCA AC24
	ISZ P24
	RTL; RTL
	TAD AC24+1
	TAD I P24
	DCA AC24+1
	JMP I ADD15

/ SUBTRACT TWO 15-BIT POINTERS TO YIELD A DIFFERENCE THAT CAN
/ BE ADDED TO A 15-BIT POINTER, OR FIX24 TO GET A PROPER
/ 15-BIT INTEGER.
SUB15,	0
	DCA P24
	TAD I P24
	CLL CIA
	TAD AC24
	DCA AC24
	ISZ P24
	TAD I P24
	CMA
	SNL
	TAD [-10
	IAC
	TAD AC24+1
	DCA AC24+1
	JMP I SUB15

	PAGE  /-------------------------- 2400

/ FIX AC24 FOR 15-BIT POINTER SUBTRACTIONS THAT YIELD NON-NEGATIVE
/ RESULTS
FIX24,	0
	TAD AC24+1
	CLL RTR; RAR
	DCA AC24+1
	JMP I FIX24

/ WRITE CHAR IN AC TO RENDER BUFFER IF IT FITS
WRRND,	0
	SCRFLD
	DCA I RNDP
	CODFLD
	TAD RNDP
	TAD (-RNDEND+1
	SZA CLA
	ISZ RNDP
	JMP I WRRND
/#EC# SCREEN AND MODE LINE TEXT FUNCTIONS

HALFHT=TXTHT%2

/ SET TOP OF SCREEN. SEARCH BACK LINES FROM POINT UNTIL
/   * FIND LINE CURRENTLY AT TOS. DONE, NO CHANGE
/   * REACH BEGINNING OF BUFFER. SET TOS THERE.
/   * MOVED SCRHT LINES, TOS NOT ON SCREEN, SET TOS
/     TO HALF OF SCRHT LINES BEFORE POINT
SETTOS,	0
	TAD BUF			/ DEFAULT TOS IS BEGINNING OF BUFFER
	DCA NEWTOS
	TAD BUF+1
	DCA NEWTOS+1

	JMS I [SREVGP
	DCA TOSN		/ ZERO LINE COUNT
	
TOSA,	TAD [NL			/ SEARCH BACK FOR NL
	JMS I [SREV
	JMP TOSD

	TAD [SRCHP		/ IF WE FOUND THE TOS, WE'RE DONE
	JMS I [INC15
	TAD [SRCHP
	JMS I [SNE15; TOS
	JMP I SETTOS

	ISZ TOSN		/ UPDATE LINE COUNT
	TAD TOSN		/ SAVE A GOOD TOS IF WE NEED IT
	TAD (-HALFHT
	SZA CLA
	JMP TOSB
	TAD SRCHP
	DCA NEWTOS
	TAD SRCHP+1
	DCA NEWTOS+1

TOSB,	TAD TOSN		/ GONE BACK SCRHT LINES?
	TAD (-TXTHT
	SNA CLA
	JMP TOSC
	TAD [SRCHP		/ NO, UNDO THE INC15 AND KEEP LOOKING
	JMS I [DEC15
	JMP TOSA

TOSD,	TAD (TOS		/ COULDN'T FIND ANY NL, TOS ALREADY
	JMS I [SNE15; BUF
	JMP I SETTOS		/ YES, DONE

TOSC,	TAD NEWTOS		/ SET NEW TOS
	DCA TOS
	TAD NEWTOS+1
	DCA TOS+1
	JMP I SETTOS
	
TOSN,	0	
NEWTOS,	0; 0

/ FORWARD ONE SCREEN.
FWDSCR,	0
	TAD CURROW		/ COMPUTE NUMBER OF LINES TO MOVE
	TAD (-TXTHT-HALFHT+1
	DCA TOSN
	JMS I [SFWDPT
FWSCA,	TAD [NL			/ NEXT LINE
	JMS I [SFWD
	JMP FWSCB
	TAD [SRCHP		/ SKIP OVER NL
	JMS I [INC15
	ISZ TOSN		/ MOVED FAR ENOUGH?
	JMP FWSCA

	JMS I [GOFWD		/ YES, GO THERE
FWSCC,	ISZ FWDSCR
	JMP I FWDSCR

FWSCB,	TAD TOSN		/ NO NL, IF CURRENT LINE IS NOT
	TAD (HALFHT-1		/ ON SCREEN, MOVE TO END
	SPA CLA
	JMP I FWDSCR
	JMS I [GOEND
	FAIL
	JMP FWSCC

/ REVERSE ONE SCREEN
REVSCR,	0
	TAD CURROW		/ COMPUTE NUMBER OF LINES TO MOVE
	CIA
	TAD (-HALFHT-1
	DCA TOSN
	JMS I [SREVGP
RVSCA,	TAD [NL			/ PREVIONS LINE
	JMS I [SREV
	JMP RVSCB
	ISZ TOSN		/ MOVED FAR ENOUGH?
	JMP RVSCA

	TAD [SRCHP		/ YES, SKIP OVER NL
	JMS I [INC15
	JMS I [GOREV		/ GO THERE
RVSCC,	ISZ REVSCR
	JMP I REVSCR

RVSCB,	TAD (TOS		/ CAN'T FIND NL, TOS == BUF?
	JMS I [SNE15; BUF
	JMP I REVSCR
	JMS I [GOBEG		/ YES, GO TO BEGINNING
	FAIL
	JMP RVSCC

	PAGE  /-------------------------- 2600

/ SKIP IF AC IS ALPHANUMERIC
SKIPAN,	0
	JMS I [UPPER
	DCA SKANCH
	TAD SKANCH
	TAD (-60		/ NUMERIC?
	SPA CLA
	JMP SKNAB
	TAD SKANCH
	TAD (-72
	SPA CLA
	JMP SKANA

SKNAB,	TAD SKANCH		/ NO, ALPHA?
	TAD (-101
	SPA CLA
	JMP I SKIPAN
	TAD SKANCH
	TAD (-133
	SPA CLA

SKANA,	ISZ SKIPAN
	JMP I SKIPAN

SKANCH,	0

/ CONVERT 6-BIT ASCII TO 8-BIT
CV68,	 0
	 TAD [SP
	 AND [77
	 TAD [SP
	 JMP I CV68

/ WRITE 6-BIT STRING TO SUBROUTINE
WR6,	0
	DCA WR6P
	TAD I WR6
	ISZ WR6
	DCA WR6SUB

WR6A,	TAD I WR6P		/ FIRST CHAR
	RTR; RTR; RTR
	AND [77
	SNA
	JMP I WR6
	JMS CV68
	JMS I WR6SUB

	TAD I WR6P		/ SECOND CHAR
	AND [77
	SNA
	JMP I WR6
	JMS CV68
	JMS I WR6SUB
	ISZ WR6P
	JMP WR6A

WR6P,	0
WR6SUB,	0

/ ERASE SCREEN, SET TOS SO THAT CURSOR IS IN MIDDLE OF SCREEN
REDRAW,	0
	JMS I [SCINIT		/ ERASE
	TAD (HALFHT		/ MOVE TOS
	JMS MOVTOS
	ISZ REDRAW
	JMP I REDRAW

MOVTOS,	0
	CMA
	DCA MVTSN
	JMS I [SREVGP

MVTSA,	TAD [NL			/ BACK HALF-SCREEN OF LINES
	JMS I [SREV
	JMP MVTSB
	ISZ MVTSN
	JMP MVTSA

	TAD [SRCHP		/ SKIP OVER NL
	JMS I [INC15
	TAD SRCHP		/ SET TOS
	DCA TOS
	TAD SRCHP+1
	DCA TOS+1
	JMP I MOVTOS

MVTSB,	TAD BUF			/ NL NOT FOUND, TOS = BUF
	DCA TOS
	TAD BUF+1
	DCA TOS+1
	JMP I MOVTOS

MVTSN,	0

/ DELETE CHARS FROM POINT TO END OF LINE. IF NONE, DELETE
/ NL. FAILS IF NOTHING WAS DELETED (AT END OF BUFFER)
KEOL,	 0
	 JMS I [SFWDPT		/ FIND EOL
	 TAD [NL
	 JMS I [SFWD
	 JMP KEOLA

	 TAD [POINT		/ IF AT EOL, DELETE THE NL
	 JMS I [SNE15; SRCHP
	 SKP
	 JMP KEOLC
	 TAD [SRCHP
	 JMS I [INC15

KEOLC,	 TAD SRCHP		/ DO THE DELETE
	 DCA POINT
	 TAD SRCHP+1
	 DCA POINT+1

KEOLB,	 ISZ KEOL		/ NORMAL RETURN, SET CHANGED
	 STA
	 DCA CHANGD
	 JMP I KEOL

KEOLA,	 TAD [POINT		/ LAST LINE, ANYTHING TO DELETE?
	 JMS I [SNE15; BUFEND
	 JMP I KEOL
	 TAD BUFEND		/ YES, DO IT
	 DCA POINT
	 TAD BUFEND+1
	 DCA POINT+1
	 JMP KEOLB

	PAGE  /-------------------------- 3000

/ MODE LINE TEXT
MLTP,	0

/ CLEAR MLT
CLRMLT,	0
	TAD (MLTBUF
	DCA MLTP
	DCA I MLTP
	JMP I CLRMLT

/ WRITE CHARACTER TO MLT, IGNORE IF BUFFER FULL
WRMLT,	0
	DCA I MLTP
	TAD MLTP
	TAD (-MLTEND+1
	SZA CLA
	ISZ MLTP
	DCA I MLTP
	JMP I WRMLT

/ ERASE CHARACTER FROM MLT, IGNORE IF BUFFER EMPTY
ERMLT,	0
	TAD MLTP
	TAD (-MLTBUF
	SNA CLA
	JMP I ERMLT
	STA
	TAD MLTP
	DCA MLTP
	DCA I MLTP
	JMP I ERMLT

/ RENDER MLT. MUST FIT, OVERFLOW NOT CHECKED
RNDMLT,	0
	JMS I [RNDINI
	TAD (MLTBUF
	DCA MLTP

RMLTA,	TAD I MLTP		/ RENDER EACH CHAR
	SNA
	JMP RMLTB

	TAD [-SP		/ CONTROL CHAR?
	SMA CLA
	JMP RMLTC
	TAD (136
	JMS I [WRRND
	TAD (100

RMLTC,	TAD I MLTP
	JMS I [WRRND
	ISZ MLTP
	JMP RMLTA

RMLTB,	JMS I [RNDFIN
	JMP I RNDMLT

/#ED# FILE INPUT

/ OS/8 USER SERVICE ROUTINE DEFS
USR=7700
FETCH=1
LOOKUP=2
ENTER=3
CLOSE=4
RESET=13

/ FIND FILE
FFILE,	0
	JMS I [GETFIL		/ GET FILENAME
	JMP I FFILE

	JMS CLRBUF		/ GOT ONE, CLEAR BUFFER
	JMP I FFILE		/ USER ABORTED SAVE OFFER

	JMS I [SETFN		/ ACTIVE FILENAME = ENTERED NAME

	TAD (FILEEN		/ LOOKUP FILE
	JMS I [LUFILE
	JMP FFNEW

	JMS I [INSFIL		/ EXISTS, INSERT
	JMP FFERR
FFILEA,	DCA CHANGD		/ SET BUFFER NOT CHANGED
	JMS I [GOBEG		/ BEGINNING OF FILE
	FAIL
	ISZ FFILE
	JMP I FFILE

FFNEW,	JMS I [CLRMLT		/ FILE NOT FOUND, NEW ONE
	TAD (NEWMSG
	JMS I [WR6
	WRMLT
	ISZ MLHOLD
	JMP FFILEA

FFERR,	JMS I [CLRFN		/ ERROR (BUFFER FULL) DON'T LET
	JMP I FFILE		/ USER ACCIDENTALLY WRITE PARTIAL FILE

/ INSERT FILE AT POINT
INFILE,	0
	JMS I [GETFIL		/ GET FILENAME
	JMP I INFILE
	TAD (FILEEN		/ LOOK FOR IT
	JMS I [LUFILE
	JMP INFLN
	JMS I [INSFIL		/ INSERT
	SKP
	ISZ INFILE
	JMP I INFILE

INFLN,	TAD (NFMSG		/ FILE MUST BE FOUND
	JMS I [WR6
	WRMLT
	ISZ MLHOLD
	JMP I INFILE

/ CLEAR BUFFER, SKIP IF NOT QUIT
CLRBUF,	0
	JMS I [OFFER
	JMP I CLRBUF
	ISZ CLRBUF
	
	TAD BUF
	DCA GAP
	TAD BUF+1
	DCA GAP+1
	TAD BUFEND
	DCA POINT
	TAD BUFEND+1
	DCA POINT+1
	JMP I CLRBUF

/ CONVERT CHAR IN AC TO UPPER CASE, A LITTLE TOO AGRESSIVELY SINCE
/ THE SYMBOLS >= 140 ARE ALSO AFFECTED
UPPER,	0
	TAD (-140
	SPA
	TAD [SP
	TAD (100
	JMP I UPPER

	PAGE  /-------------------------- 3200

/ INSERT ONE CHAR, SKIP IF NOT ^Z AND THE CHAR FITS. IGNORE LF
INSF1,	0
	TAD (-32		/ ^Z?
	SNA
	JMP I INSF1
	TAD (32-LF		/ LF?
	SNA
	JMP INSF1A
	TAD (LF
	JMS I [INSERT		/ OK TO INSERT
	JMP INSF1B
INSF1A,	ISZ INSF1
	JMP I INSF1
INSF1B,	ISZ MOREOK
	JMP I INSF1

MOREOK,	0			/ BUFFER FULL, MORE TO READ

/ CLEAR ACTIVE FILENAME
CLRFN,	0
	DCA FILENM
	DCA FILENM+3
	JMP I CLRFN

/ SKIP IF THERE IS AN ACTIVE FILENAME
HAVEFN,	0
	TAD FILENM
	SZA CLA
	ISZ HAVEFN
	JMP I HAVEFN

/ INSERT PREVIOUSLY LOOKED UP FILE AT POINT, SKIP IF OK
INSFIL,	0
	TAD FILLOC
	DCA FILBLK
	DCA MOREOK
	
INSFA,	JMS I DSKEP		/ NEXT BLOCK
	200
FILBUF,	IOBUF
FILBLK,	0
	JMP INSFER
	ISZ FILBLK		/ UPDATE BLOCK NUMBER

	TAD (-200		/ PROCESS CHARACTERS
	DCA INSFN
	TAD FILBUF
	DCA INSFP

INSFC,	TAD I INSFP		/ CHAR 1
	AND (177
	JMS INSF1
	JMP INSFB

	TAD I INSFP		/ SAVE HIGH NIBBLE OF CHAR 3
	AND (3400
	CLL RTR; RTR
	DCA INSFT

	ISZ INSFP		/ CHAR 2
	TAD I INSFP
	AND (177
	JMS INSF1
	JMP INSFB

	TAD I INSFP		/ CHAR 3
	RTL; RTL; RAL
	AND (17
	TAD INSFT
	JMS INSF1
	JMP INSFB

	ISZ INSFP
	ISZ INSFN
	JMP INSFC
	ISZ FILSIZ
	JMP INSFA

INSFB,	TAD [POINT		/ DISTINGUISH EOF FROM BUFFER FULL
	JMS I [SNE15; GAP	/ EOF SKIPS, BUFFER FULL DOESN'T
	SKP
	ISZ INSFIL
	JMP I INSFIL
	
INSFER,	SMA CLA			/ I/O ERROR, SHOW MESSAGE
	TAD (INSE2-INSE1	/ SHOUDN'T GET NON-FATAL
	TAD (INSE1
	JMS I [WR6
	WRMLT
	ISZ MLHOLD
	JMP I INSFIL

INSFP,	0
INSFN,	0
INSFT,	0

/ LOOKUP FILE, AC->NAME, SKIP IF FOUND
LUFILE,	0
	DCA FILLOC
	TAD DEVNUM
	CIF 10
	JMS I [USR
	LOOKUP
FILLOC,	0
FILSIZ,	0
	SKP
	ISZ LUFILE
	JMP I LUFILE

/ INITIALIZE FILE I/O, SKIP IF OK
IOINIT,	0
	CIF 10			/ TELL OS/8 NO DEVICE HANDLERS IN CORE
	JMS I [USR
	RESET
	0

	CIF 10			/ FETCH DISK HANDLER
 	JMS I [USR
	FETCH
DEVNUM=.+1
	DEVICE DSK
DEVEP,	7201
	JMP I IOINIT
	TAD DEVEP
	DCA DSKEP

	ISZ IOINIT
	JMP I IOINIT

	PAGE  /-------------------------- 3400

/ GET FILE NAME, SKIP IF NOT QUIT
GETFIL,	0
GETFR,	JMS I [CLRMLT		/ PROMPT IN MODE LINE TEXT (MLT)
	TAD (GFMSG
	JMS I [WR6
	WRMLT
	JMS I [UPDATE

	DCA FILEEN		/ CLEAR NAME TO BE ENTERED
	DCA FILEEN+1
	DCA FILEEN+2
	DCA FILEEN+3
	TAD (FILEEN

	DCA FILEP		/ SEE COMMENTS BELOW
	DCA FILEX
	DCA FILEH

GETFA,	JMS I [RDTTY		/ READ NEXT CHAR
	DCA GETFCH
	TAD GETFCH		/ QUIT?
	TAD (-BELL
	SNA CLA
	JMP I GETFIL
	
GETFE,	TAD GETFCH
	TAD (-CR		/ END OF ENTRY?
	SNA CLA
	JMP GETFB

	TAD GETFCH		/ ERASE?
	TAD [-10
	SNA CLA
	JMP GETFR

	TAD GETFCH		/ DOT?
	TAD (-56
	SZA CLA
	JMP GETFD

	TAD FILEX		/ YES DOT, IN EXTENSION MODE?
	SZA CLA
	JMP GETFER
	TAD FILEEN		/ NO, ANY NAME CHARACTERS?
	SNA CLA
	JMP GETFER
	ISZ FILEX		/ YES, OK TO SWITCH TO EXTENSION MODE
	TAD (FILEEN+3
	DCA FILEP
	DCA FILEH
	JMP GETFC

GETFD,	TAD FILEX		/ NOT DOT, TOO MANY CHARACTERS?
	SZA CLA
	JMP .+3
	TAD FILEEN+2
	SKP
	TAD FILEEN+3	
	AND [77
	SZA CLA
	JMP GETFER

	TAD GETFCH		/ CONVERT TO UPPERCASE
	JMS I [UPPER
	DCA GETFCH

	TAD GETFCH		/ ALPHANUMERIC?
	JMS I [SKIPAN
	JMP GETFER
	TAD FILEH		/ CHAR OK, INSERT IN FILENAME
	SZA CLA
	JMP GETFG
	
	TAD GETFCH		/ LEFT HALF
	AND [77
	CLL RTL; RTL; RTL
	DCA I FILEP
	ISZ FILEH
	JMP GETFC

GETFG,	TAD GETFCH		/ RIGHT HALF
	AND [77			
	TAD I FILEP
	DCA I FILEP
	DCA FILEH
	ISZ FILEP

GETFC,	TAD GETFCH
	JMS I [WRMLT
	JMS I [UPDATE
	JMP GETFA

GETFER,	TAD [BELL		/ ERROR, IGNORE CHARACTER
	JMS I [WRTTY
	JMP GETFA

GETFB,	TAD FILEEN		/ GOT CR, ANY NAME ENTERED?
	SNA CLA
	JMP GETFER

	
	ISZ GETFIL
	JMP I GETFIL

/ MAKE ENTERED FILENAME CURRENT
SETFN,	0
	TAD FILEEN
	DCA FILENM
	TAD FILEEN+1
	DCA FILENM+1
	TAD FILEEN+2
	DCA FILENM+2
	TAD FILEEN+3
	DCA FILENM+3
	JMP I SETFN

GETFCH,	0			/ CHARACTER BEING ENTERED
FILEP,	0			/ POINTER INTO FILEEN
FILEX,	0			/ NON-ZERO IF WORKING ON FILE EXTENSION
FILEH,	0			/ NON-ZERO IF INSERTING INTO RIGHT HALF
FILEEN,	ZBLOCK 4		/ ENTER NEW NAME HERE

FILENM,	ZBLOCK 5		/ FILE OF CURRENT BUFFER, DISPLAYED IN MODE LINE
	       			/ ONE EXTRA FOR RMODE

	PAGE  /-------------------------- 3600

/ DIVIDE AC24 BY AC, QUOTIENT TO AC24, REMAINDER TO AC24+1
/ ASSUME NO OVERFLOW
DIVIDE,	0
	CIA		/ NEGATE DIVISOR FOR SHIFT/SUBTRACT
	DCA DIVSR
	TAD (-15	/ LOOP COUNT
	DCA DIVCNT
	CLL
	JMP DIVB

DIVA,	TAD AC24+1
	RAL
	DCA AC24+1
	TAD AC24+1
	TAD DIVSR
	SZL
	DCA AC24+1
	CLA
DIVB,	TAD AC24
	RAL
	DCA AC24
	ISZ DIVCNT
	JMP DIVA
	JMP I DIVIDE

DIVSR,	0
DIVCNT,	0

/#EE# FILE OUTPUT

/ COUNT NL CHARS FROM POINT TO WREND ADD RESULT TO WRFSIZ
NLFWD,	0
	JMS I [SFWDPT
NLFWDA,	TAD [NL			/ NEXT NL
	JMS I [SFWD
	JMP I NLFWD
	TAD [SRCHP		/ SRCHP < WREND?
	JMS I [LD24
	TAD WREND
	JMS I [SUB15
	TAD AC24+1
	SMA CLA
	JMP I NLFWD

	ISZ WRFSIZ		/ YES, ADD 1
	SKP
	ISZ WRFSIZ+1

	TAD [SRCHP		/ SKIP OVER NL
	JMS I [INC15
	JMP NLFWDA

/ COUNT NL CHARS FROM GAP TO WRBEG ADD RESULT TO WRFSIZ
NLREV,	0
	JMS I [SREVGP
NLREVA,	TAD [NL			/ NEXT NL
	JMS I [SREV
	JMP I NLREV
	TAD [SRCHP		/ SRCHP >= WRBEG?
	JMS I [LD24
	TAD WRBEG
	JMS I [SUB15
	TAD AC24+1
	SPA CLA
	JMP I NLREV

	ISZ WRFSIZ		/ YES, ADD 1
	SKP
	ISZ WRFSIZ+1
	JMP NLREVA

/ COMPUTE SIZE OF ZONE IN OS/8 BLOCKS (256 WORDS)
WRFBLK,	0
	TAD [GAP		/ NUM CHARS IN ZONE
	JMS I [LD24
	TAD WRBEG
	JMS I [SUB15
	TAD WREND
	JMS I [ADD15
	TAD [POINT
	JMS I [SUB15
	JMS I [FIX24
	TAD (WRFSIZ
	JMS I [ST24
	
	JMS NLFWD		/ ADD EXTRA FOR NL CHARS
	JMS NLREV

	TAD (WRFSIZ		/ ROUND UP TO NUMBER OF BLOCKS
	JMS I [LD24
	TAD (600
	JMS I [DIVIDE
	TAD AC24
	IAC
	DCA WRSIZE
	
	JMP I WRFBLK

WRFSIZ,	0; 0	/ SIZE OF ZONE INCLUDING EXTRA NL CHARS AND ^Z AT END

/ ENTER TENTATIVE OUTPUT FILE, SKIP IF OK. AC CONTAINS
/ NUMBER OF 256-WORD BLOCKS TO BE WRITTEN. INITIALIZE
/ SOME CLFILE AND PACK VARIABLES
ENFILE,	0
	TAD WRNAME
	DCA ENLOC
	TAD WRSIZE
	IAC			/ ONE MORE TO BE SAFE
	CLL RTL; RTL
	TAD DEVNUM
	CIF 10
	JMS I [USR
	ENTER
ENLOC,	0
ENSIZ,	0
	JMP I ENFILE
	TAD ENLOC
	DCA PACKBL
	DCA CLSIZ
	ISZ ENFILE
	JMP I ENFILE

	PAGE  /-------------------------- 4000

/ CLOSE OUTPUT FILE AND MAKE PERMANENT, SKIP IF OK.
CLFILE,	0
	TAD WRNAME
	DCA CLNAME
	TAD DEVNUM
	CIF 10
	JMS I [USR
	CLOSE
CLNAME,	0
CLSIZ,	0
	SKP
	ISZ CLFILE
	JMP I CLFILE

/ PACK CHARACTERS INTO IOBUF. IF FULL, WRITE IT OUT. SKIP IF OK.
/ THREE CHARS IN TWO WORDS, OS/8 ASCII FILE FORMAT
PACK,	0
	DCA PACKCH
	TAD PACKX
	SZA
	JMP PACKA
	TAD PACKCH		/ CHAR 0
	DCA PACK0
	ISZ PACKX
	JMP PACKC

PACKA,	SPA CLA
	JMP PACKB
	TAD PACKCH		/ CHAR 1
	DCA PACK1
	STA
	DCA PACKX
	JMP PACKC

PACKB,	TAD PACKCH		/ CHAR 2
	AND (360
	CLL RTL; RTL
	TAD PACK0
	DCA I PACKP
	ISZ PACKP
	TAD PACKCH
	AND (17
	CLL RTR; RTR; RAR
	TAD PACK1
	DCA I PACKP
	ISZ PACKP
	DCA PACKX

	TAD PACKP		/ END OF IOBUF?
	TAD (-IOBUFE
	SZA CLA
	JMP PACKC

	ISZ ENSIZ		/ OVERWRITE BUG?
	SKP
	JMP I PACK

	JMS I DSKEP		/ YES, WRITE BLOCK
	4200  			/ WRITE 1 BLOCK
PACKIO,	IOBUF
PACKBL,	0
	JMP I PACK
	ISZ PACKBL		/ UPDATE BLOCK NUMBER
	ISZ CLSIZ		/ UPDATE FILE SIZE

	TAD PACKIO		/ RESET POINTER
	DCA PACKP

PACKC,	ISZ PACK
	JMP I PACK

PACKCH,	0	/ CHAR TO PACK
PACKX,	0	/ TRISTATE: 0 CHAR 1, 1 CHAR 2, -1 CHAR 3
PACK0,	0	/ PACKED WORD 0
PACK1,	0	/ PACKED WORD 1
PACKP,	0	/ -> PLACE IN IOBUF

/ SAVE FILE COMMAND. 
SVFILE,	0
	TAD [BUF		/ WRBEG = BUF
	DCA WRBEG
	TAD [BUFEND		/ WREND = BUFEND
	DCA WREND
	TAD (FILENM		/ WRITE TO ACTIVE FILE
	DCA WRNAME
	
	JMS HAVEFN		/ HAVE ACTIVE FILE?
	SKP
	JMP SVFLA
	JMS I [GETFIL		/ NO, GET FILENAME
	JMP I SVFILE		/ USER QUITS
	JMS I [SETFN		/ SET ACTIVE FILE

SVFLA,	JMS I [WRITEF		/ WRITE THE FILE
	JMP I SVFILE

	DCA CHANGD		/ BUFFER NOT CHANGED

	TAD WRSIZE		/ DIAGNOSTIC DISPLAY OF PREDICTED
	JMS I [WRDEC		/ AND ACTUAL NUMBER OF BLOCKS WRITTEN
	WRMLT
	TAD (COMMA
	JMS I [WRMLT
	TAD CLSIZ
	JMS I [WRDEC
	WRMLT
	ISZ MLHOLD
	
	ISZ SVFILE
	JMP I SVFILE

/ WRITE BUFFER TO NEW FILE NAME
WRFILE,	0
	JMS I [CLRFN
	JMS SVFILE
	SKP
	ISZ WRFILE
	JMP I WRFILE

	PAGE  /-------------------------- 4200

/ WRITE ZONE WRBEG,WREND TO FILE WRNAME. SKIP IF OK
WRITEF,	0
	TAD PACKIO		/ INITIALIZE PACK
	DCA PACKP
	DCA PACKX

	JMS WRFBLK		/ GET FILE SIZE
	JMS ENFILE		/ ENTER TENTATIVE FILE
	JMP NOENTR

	TAD I WRBEG		/ SRCHP = WRBEG
	DCA SRCHP
	ISZ WRBEG
	TAD I WRBEG
	DCA SRCHP+1
	STA
	TAD WRBEG
	DCA WRBEG

WRFLA,	TAD [GAP		/ SKIP OVER GAP?
	JMS I [SNE15; SRCHP
	JMP WRFLGP

WRFLF,	TAD WREND		/ AT END OF ZONE?
	JMS I [SNE15; SRCHP
	JMP WRFLEZ

	TAD [SRCHP		/ WRITE NEXT CHARACTER
	JMS I [GET15
	TAD (-NL
	SNA
	JMP WRFNL
	TAD [NL
	JMS PACK
	JMP NOPACK
	JMP WRFLB
	
WRFNL,	TAD (CR			/ WRITE NEW LINE
	JMS PACK
	JMP NOPACK
	TAD (LF
	JMS PACK
	JMP NOPACK

WRFLB,	TAD [SRCHP		/ NEXT CHARACTER
	JMS I [INC15
	JMP WRFLA

WRFLGP,	TAD POINT		/ SKIP OVER GAP
	DCA SRCHP
	TAD POINT+1
	DCA SRCHP+1
	JMP WRFLF

WRFLEZ,	TAD (32			/ WRITE ^Z
	JMS PACK
	JMP NOPACK
WRFLC,	TAD PACKP		/ ZERO REST OF IOBUF AND WRITE IT
	TAD (-IOBUF
	SZA CLA
	JMP WRFLG
	TAD PACKX
	SNA CLA
	JMP WRFLD

WRFLG,	JMS PACK
	JMP NOPACK
	JMP WRFLC

WRFLD,	JMS CLFILE		/ CLOSE FILE
	JMP NOCLOS
	ISZ WRITEF
	JMP I WRITEF

NOENTR,	TAD (NOEMSG
	JMP WRFLE

NOPACK,	DCA CLSIZ		/ ATTEMPT TO DELETE FILE
	JMS CLFILE
	NOP
	TAD (NOPMSG
	JMP WRFLE

NOCLOS,	TAD (NOCMSG	
WRFLE,	JMS I [WR6
	WRMLT
	ISZ MLHOLD
	JMP I WRITEF

/ OFFER TO SAVE CHANGED FILE
OFFER,	0
	TAD CHANGD
	SNA CLA
	JMP OFFERN

	JMS I [CLRMLT		/ CHANGED, PROMPT FOR OPTION
	TAD (SAVMSG
	JMS I [WR6
	WRMLT
	JMS I [UPDATE

OFFERA,	JMS I [RDTTY
	TAD (-131		/ Y? ("Y HAS PARITY BIT SET)
	SNA
	JMP OFFERY
	TAD (131-116		/ N?
	SNA
	JMP OFFERN
	TAD (116-BELL		/ ^G?
	SNA CLA
	JMP I OFFER
	TAD [BELL		/ YES, QUIT RETURN
	JMS I [WRTTY
	JMP OFFERA

OFFERY,	JMS SVFILE		/ Y, SAVE FILE
	SKP
OFFERN,	ISZ OFFER
	JMP I OFFER

	PAGE  /-------------------------- 4400

/ KEEP MARK IN LEGAL POSITION AS POINT CROSSES MARK
FIXMRK,	0
	TAD MKFLAG
	SZA CLA
	JMP FXMKA

	TAD (MARK		/ MARK AT OR BEFORE GAP?
	JMS I [LD24
	TAD [GAP
	JMS I [SUB15
	TAD AC24+1
	SPA CLA
	JMP FXMKX		/ YES, ALL SET

	TAD [POINT		/ NO, FIX IT
	JMS I [ADD15
	TAD (MARK
	JMS I [ST24
	ISZ MKFLAG

	TAD [BUFEND		/ BEYOND END OF BUFFER?
	JMS I [LD24
	TAD (MARK
	JMS I [SUB15
	TAD AC24+1
	SMA CLA
	JMP FXMKX
	
	TAD BUFEND		/ YES, SET TO END
	DCA MARK
	TAD BUFEND+1
	DCA MARK+1
	JMP FXMKX

FXMKA,	TAD (MARK		/ MARK AT OR AFTER POINT?
	JMS I [LD24
	TAD [POINT
	JMS I [SUB15
	TAD AC24+1
	SMA CLA
	JMP FXMKX		/ YES, ALL SET

	TAD [GAP		/ NO, FIX IT
	JMS I [ADD15
	TAD (MARK
	JMS I [ST24
	DCA MKFLAG

	TAD (MARK		/ BEYOND BEGINNING OF BUFFER?
	JMS I [LD24
	TAD [BUF
	JMS I [SUB15
	TAD AC24+1
	SMA CLA
	JMP FXMKX

	TAD BUF			/ YES, SET TO BEGINNING
	DCA MARK
	TAD BUF+1
	DCA MARK+1

FXMKX,	JMP I FIXMRK

/ SET MARK TO POINT
SETPM,	0
	TAD POINT
	DCA MARK
	TAD POINT+1
	DCA MARK+1
	CLA IAC
	DCA MKFLAG
	JMP I SETPM	

/ SET MARK TO POINT COMMAND
SETMRK,	0
	JMS SETPM
	TAD (MRKMSG
	JMS I [WR6
	WRMLT
	ISZ MLHOLD

	ISZ SETMRK
	JMP I SETMRK

/ EXCHANGE POINT AND MARK
EXGPM,	0
	ISZ EXGPM

	TAD MARK		/ GET SET TO MOVE POINT TO MARK
	DCA SRCHP
	TAD MARK+1
	DCA SRCHP+1

	TAD MKFLAG		/ WHICH DIRECTION?
	SZA CLA
	JMP EXGPMA

	TAD POINT		/ REVERSE
	DCA MARK
	TAD POINT+1
	DCA MARK+1
	JMS I [GOREV
	ISZ MKFLAG
	JMP I EXGPM	

EXGPMA,	TAD GAP
	DCA MARK
	TAD GAP+1
	DCA MARK+1
	JMS I [GOFWD		/ FORWARD
	DCA MKFLAG
	JMP I EXGPM
