/TSS/8 BASIC EDITOR/EXECUTIVE   (BASED) VERSION 24
/
/REVISION: 25-MAY-71		IDC/GWB/PJK
/
/COPYRIGHT 1969, 1970, 1971	DIGITAL EQUIPMENT CORP.
/				MAYNARD, MASSACHUSETTS
/
/ORIGINALLY WRITTEN BY:
/	INFORMATION DEVELOPMENT COMPANY
/	DEDHAM, MASS
/
/THE TSS/8 BASIC EDITOR IS THE INPUT PROGRAM TO
/THE TSS/8 BASIC COMPILER
/
/THE TSS/8 BASIC EDITOR, UNDER OPERATOR CONTROL, INPUTS BASIC
/SOURCE STATEMENTS TO A TEXT FILE, MANIPULATES THE FILE, AND CALLS
/THE BASIC COMPILER TO PROCESS THIS FILE OF SOURCE STATEMENTS
/
/THE BASIC EDITOR ACCEPTS BASIC SOURCE LANGUAGE STATEMENTS AND
/EDITOR DIRECTIVES
/
/A BASIC SOURCE LANGUAGE STATEMENT IS A STRING OF NO MORE THAN
/83 CHARACTERS OF THE FORM NTTT... , WHERE N IS A DECIMAL
/NUMBER IN THE RANGE 0<N<2047, AND T IS ANY VALID BASIC CHARACTER.
/
/WHEN SUCH A STATEMENT IS ENTERED, ANY EXISTING SOURCE STATEMENT
/WITH THE SAME LINE NUMBER N IS DELETED FROM THE FILE, AND THE NEW
/STATEMENT REPLACES IT. THUS, A STATEMENT WHICH CONSISTS ONLY OF A
/NUMBER ACTS AS A DELETE

/ ! ! ! ! ! ! N O T E ! ! ! ! ! !

/ BASIC ERROR MESSAGES PROGRAM HAS BEEN ADDED TO
/THE END OF THE EDITOR TO CONSERVE SPACE IN THE
/DISK FILE.

/THERE ARE ELEVEN DIRECTIVES:
/
/NEW:   ABORT, RETURN TO "NEW FILE NAME--"
/
/OLD:   ABORT, RETURN TO "OLD FILE NAME--"
/
/BYE:	BYE DELETES THE EDITOR TEMPORARY FILES FROM THE SYSTEM
/	AND RETURNS CONTROL TO TSS-8
/
/CATALOG:CATALOG LISTS ALL FILE NAMES IN THE USERS DIRECTORY
/
/DELETE:DELETE MUST BE FOLLOWED BY ONE OR TWO DECIMAL NUMBERS, WHICH
/	DEFINE A RANGE.  ALL SOURCE STATEMENTS WHOSE NUMBERS FALL
/	IN THIS RANGE, INCLUSIVE, ARE DELETED FROM THE FILE.
/
/LIST:	LIST MAY BE FOLLOWED BY ONE OR TWO DECIMAL NUMBERS WHICH
/	DEFINE A RANGE.  ALL SOURCE STATEMENTS IN THE FILE WHOSE
/	LINE NUMBERS FALL IN THIS RANGE ARE PRINTED.
/	IF LIST IS ENTERED WITH NO LINE NUMBERS, THE ENTIRE FILE IS
/	OUTPUT.
/
/LLIST: SAME AS LIST EXCEPT THAT THE OUTPUT ASSOCIATED WITH IT
/	GOES TO THE LP08 LINE PRINTER INSTEAD OF THE TELEPRINTER.
/
/RUN:	RUN CALLS THE COMPILER AND STARTS COMPILATION OF THE
/	SOURCE LANGUAGE FILE
/
/SAVE:	THIS COPIES THE SOURCE LANGUAGE FILE ONTO A FILE WITH THE
/	CURRENT NAME AND CLOSES THIS FILE.  IF SAVE IS FOLLOWED BY
/	A NAME: SAVE X, THEN THE SOURCE FILE WILL BE COPIED ONTO A
/	FILE NAMED X.  IF THE NAME IS ALREADY IN USE THEN THE SAVE
/	WILL NOT BE PERFORMED.
/
/UNSAVE:UNSAVE MUST BE FOLLOWED BY A FILE NAME X.  THE FILE X IS
/	DELETED FROM THE SYSTEM.  UNSAVE MAY ALSO BE FOLLOWED BY A STRING 
/	OF FILE NAMES--UNSAVE X,Y,Z WOULD DELETE THREE FILES.
/
/TAPE:	TAPE INPUT MODE--UNDUPLEX, DO NOT SEND LF OR _ (RUBOUT)
/	SUPPRESS LEADING SPACES ON LIST OUTPUT AND TYPE NULLS
/	(BLANK TAPE) BEFORE AND AFTER LISTING.
/
/KEY:	RETURN TO NORMAL STATE FROM TAPE INPUT MODE.
/
/REPLACE:SAVE FILE ALWAYS--REPLACE IS THE SAME AS SAVE EXCEPT
/	THAT THE FILE WILL BE SAVED IRREGARDLESS OF WHETHER OR NOT
/	THERE IS ALREADY A FILE HAVING THE SAME NAME.  THE OLD
/	FILE IS DESTROYED.
/
/
/SCRATCH:EQUIVALENT TO DELETE 1,2046--ZEROES FILE AREA.
/
/COMPILE:COMPILE AND SAVE OUTPUT OF COMPILER. A FILE NAME
/	MUST BE SPECIFIED.
/
/EDIT:	CHARACTER EDITING FUNCTION--CALL: EDIT N,M
/	AND TYPE CHARACTER TO SEARCH FOR ON THE NEXT LINE.
/
/!!!!NOTE!!!!!  THE FOLLOWING SUPERCRITICAL LOCATIONS MUST BE
/		CAREFULLY WATCHED.
INTSAV=6227	/CURRENTLY THE TOP OF OVERLAYED CORE (IN BASIN)
LCSAV=352	/TTY COLUMN POSITION (USED BY BASEXC, BASIN)
PRC=353		/LPT COLUMN POSITION (BASEXC, BASIN)
PRGNM=354	/CHAIN PROG. NAME (BASEXC, ERROR, BASIN)
UFIL0=357	/OPEN BLOCK FOR USER FILE 0 (BASIN)
STSX=364	/ENTRY TO SAS ROUTINE (EVERYBODY)
INTX1=347	/VALUE OF X1 IF INTERPRETER WAS JUST LOADED BY SYP (BASIN)
/
/ IOT EQUATES
/
CLOS=6602
CON=6422
CRF=6610
EXT=6611
FINF=6613
KSB=6400
KSR=6030
OPEN=6601
PROT=6604
RED=6612
RFILE=6603
SAS=6040
SRA=6417
ASD=6440
REL=6442
LST=6660
LLS=6666
USE=6421
WFILE=6605
WHO=6616
DUP=6402
UND=6403
SBC=6401
ACT=6617
*0
/PAGE 0 CONSTANTS AND VARIABLES
/
COMP,	JMP I AINE	 /INITIALIZER (EXECUTE ONLY FLAG = -1)
TAPE,	0		/TAPE MODE FLAG (TAPE MODE=1)
INITLD,	1		/INITIAL LOAD FLAG
ENDINT,	0		/SET TO PTR TO LAST WORD OF INTERP BY LOADER OR EXECUTOR
LRST,	0		/RESTART FLAG
SYSERR, SYE		 /SYSTEM ERROR PROGRAM
SYSIOE, SYI		 /SYSTEM IO CHECK
SYSPRG, SYP		 /SYSTEM PROGRAM CALL
*11
X1,	0		/INDEX 1
X2,	0		/INDEX 2
X3,	0		/INDEX 3
X4,	0		/INDEX 4
X5,	0		/INDEX 5
 *20
FINAME, 0		/CURRENT FILE NAME -
	0		/SIX PACKED ASCII CHARACTERS
	0
FISIZE, 0		/NUMBER OF SEGMENTS IN FILE 0
FITYPE, 0		/CURRENT FILE TYPE: 0-OLD, 1-NEW
SEGMNT,	-400		/-(SEGMENT SIZE IN WORDS)
SRSIZE, 0		/NO OF SEGMENTS IN FILE 1
DEVSTS,	-1		/DEVICE STATUS BITS
			/  BIT     DEVICE
			/   0  	    DTA 0
			/  ...	     ...
			/   7	    DTA 7
			/   8	    DSK 8
			/   9	    DSK 9
			/  10	    PTP
			/  11	    LPT
BF1PTR, 0		/BUFFER 1 POINTER
BF2PTR, 0		/BUFFER 2 POINTER
BFSIZE, 0		 /USABLE BUFFER SIZE
FINFBL,	0;  0;  0;  0;  0;  0;  0		 /FILE INFORMATION BLOCK
HIGH,	0		/UPPER LIMIT-LINE NUMBER
ICHCH,	0		/ASCII CHAR INPUT
LAST,	0		/LAST LINE NO IN OUTPUT
LOW,	0		/LOWER LIMIT-LINE NUMBER
P0VEC,	0;  0;  0;  0;  0		 /DCB TRANSFER VECTOR
SEGSPB, 0		 /SEGMENTS PER BUFFER
TEMP1,	0		 /TEMP STORE
TEMP2,	0		 /TEMP STORE
TEMP3,	0		 /TEMP STORE
TEMP4,	0		 /TEMP STORE
TEMP5,	0		 /TEMP STORE
TEMP6,	0		 /TEMP STORE
TXBLIM, 0		/TEXT BUFFER LWA
PROTX,	0		/FILE PROTECTION FOR SAVE AND REPLACE
TXBPTR=X5		/TEXT BUFFER POINTER
WDCNT,	0		/WORD COUNT
SIXBIT,	0		/TSS8 SIXBIT FLAG FOR TEXTO ROUTINE

/! ! ! ! N O T E ! ! ! !
/ANY CHANGES MAKE FROM HERE ON IN PAGE ZERO
/MUST ALSO BE MADE TO THE TABLE WHICH
/BEGINS AT LOCATION 3777 (FBUF1).
PG0DAT=.		/START OF PAGE 1 DATA BLOCK
ACPF,	CPF		 /COPY FILE
AEDT,	EDT		 /EDITOR RESTART
AEDT20, EDT20A		/EDITOR RETURN ENTRY
AEDT60, EDT60		/EDITOR ERROR 12 ENTRY
AFINF,	FINFBL		 /ADDRESS OF FINF BLOCK
AIBN,	IBN		/INPUT BINARY NUMBER
AICH,	ICH		/INPUT CHARACTER
AIFN,	IFN		/INPUT FILE NAME
ALDC,	LDC		/LOAD DCB CONTROL BLOCK
AMOV,	MOV		/MOVE
APFL,	PFL		/POSITION FILE
ARFL,	RFL		/READ FILE
ARLT,	RLT		/READ A LINE OF TEXT
ARWD,	RWD		/REWIND
AWEF,	WEF		 /WRITE TO END OF FILE
AWFL,	WFL		/WRITE FILE
AWIF0,	WIF0		/GET WORD-NO INCREMENT
AWIF,	WIF		/WORD FROM INPUT FILE
AWOF,	WOF		/WORD TO OUTPUT FILE
SEND=JMS I .; TEXTO	/TYPE A MESSAGE IN TEXT FORMAT
PSTSX,	STSX		/SAS ROUTINE FOR SYSTEM
OPEN2=JMS I .; OP2	/OPEN INTERNAL FILE 2 AND SET BIT IN DEVSTS
CRLF=JMS I .; OCR	/PRINT CR,LF
PPRGNM,	PRGNM
BIT2,	1000
BIT4,	200
BIT5,	100
BIT8,	10
BIT10,	2
K7400,	7400
COPY01, COPY+3
RLTATB,	TXBUF-1
K2=BIT10
K3,	3
KM3,	-3
KM4,	-4
KM5,	-5
K7,	7
KM53,	-53
K10=BIT8
K12,	12
K17,	17
K32,	32
K37,	37
KM37,	-37
KM20,	-20
K77,	77
K177,	177
K1100,	1100
K1300,	1300
KM12,	-12
K5,	5
K6,	6
KM24,	-24
K40,	40
KM143,	-143
K617,	617
K55,	55
K53,	53
K137,	137
K100=BIT5
K101,	101
K200=BIT4
K201,	201
K240,	240
KM240,	-240
KM272,	-272
K260,	260
K3737,	3737
K3776, 3776
KA0=K260
KBLANK=K240
KHIBYT, 7700
KLOBYT=K77
KM3777,	-3777
K4002,	4002
AINE,	INE		 /ADDRESS OF INITIALIZER

KM2,	-2
/
/SYSTEM EQUATES
/
CHKFOP=JMS I SYSIOE
COPYFL=JMS I  ACPF
EDITOR=JMP I   AEDT20
EDSTRT=JMP I  AEDT
ERR12=JMP I   AEDT60
GETNXI=JMS I   AWIF
GETWD=JMS I   AWIF0
INPBIN=JMS I   AIBN
INPCH=JMS I   AICH
INPFNM=JMS I   AIFN
IO02=CLA IAC
IO11=TAD    K100
IO12=TAD    K101
IO22=TAD    K201
LOADCB=JMS I ALDC
MOVE=JMS I   AMOV
POSFIL=JMS I   APFL
PUTWD=JMS I   AWOF
RDFILE=JMS I   ARFL
RDTEXT=JMS I   ARLT
REWIND=JMS I   ARWD
WRFILE=JMS I   AWFL
WRTEOF=JMS I  AWEF
*200
/SYSTEM ERROR(SYE)
/
/FUNCTION:TO CALL THE ERROR PROGRAM
/
/ENTRY: ERROR CODE IN WORD FOLLOWING CALL
/
/EXIT: TO ERROR PROGRAM
/
SYE,	0
	CLA
	TAD I	SYE	/GET ERROR CODE
	DCA	10	/STORE ERROR CODE IN 10
	CLA IAC
	JMP	SYP	/CALL ERROR PROGRAM(1)
/SYSTEM IO ERROR(SYI)
/
/FUNCTION:TO CHECK RESULTS OF FILE OPERATIONS
/
/ENTRY:ERROR WORD IN A-REG
/      XSW NON-ZERO IF ERROR MUST ABORT SYSTEM AND RETURN TO TS-8
/
/EXIT: A-REG .EQ. 0: DIRECT RETURN
/      A-REG .NE. 0: XSW .EQ. 0: CALL ERROR PROGRAM WITH A-REG 0
/		     XSW .NE. 0: OUTPUT 00 ERROR AND EXIT TO TS-8
/
SYI,	0
	SNA 	 /IS A-REG ZERO ?
	JMP I	SYI	/YES. RETURN
	TAD	SK400
	SNA CLA
	JMP	SYI6	/DISK FULL ERROR
	TAD   XSW
	SNA CLA 	/IS EXIT SWITCH SET ?
	JMS	SYE	/NO. CALL ERROR PROGRAM
	0
SABORT,	JMS	STSX		/TYPE ABORT
	DMES-DMEN
	DMES-1
	CLA CMA		/CLOSE OUT ALL FILES
	CLOS
	HLT		/NON RECOVERABLE ERROR
	JMP	.-1

/DISK FULL ERROR
/
SYI6,	TAD	XSW
	DCA	ABSW	/ABORT IF NON-RECOVERABLE
	JMS	SYE
	40		/DISK FULL

/
XSW,	-1		 /EXIT SWITCH

ABSW,	0		/DISK FULL ABORT SWITCH


DMES,	212; "A; "B; "O; "R; "T
DCRLF,	215;   212;  "^;  "C

DMEN=DCRLF+2
/SYSTEM PROGRAM CALL(SYP)
/
/FUNCTION:TO LOAD AND START A SYSTEM PROGRAM AT 400
/
/ENTRY:  AC=
/	0-EDITOR
/	1-ERROR
/	2-COMPILER
/	3-LOADER
/	4-EXECUTOR
/	5-INPUT OVERLAY
/	6-INTERPRETER
/	7-FUNCTION OVERLAY
/
/EXIT:TO LOC 400
/
CRC,	TAD SKSAS
	DCA SASOP
	JMS	STSX
	-4
	DCRLF-1			/^C STRING
	TAD	C617		/RESET BREAK MASK IN CASE OF EDIT
	KSB
	TAD LRST	/CHECK THE RESTART FLAG
	SMA SZA CLA
	WRTEOF		/IF SO, WRITE END OF FILE
SYP,	CMA CLL
	DCA	TEMP1		/SAVE CALL AC
	DCA	LRST
	DCA	TAPE		/CLEAR FLAGS
	DUP			/DUPLEX TTY
	TAD SYPTBA	/INITIALIZE TABLE POINTER
	DCA X1
	DCA SYPIOB+1	/CLEAR HIGH-ORDER FILE ADDR
	TAD SK400	/START AT FILE ADDR 400
	JMP SYP2

SYP1,	SNA		/WAS LAST ONE ZERO INCREMENT
	ISZ X1		/YES, SKIP OVER PROGRAM LENGTH
	CLL
	TAD SYPIOB+5	/ADD IN ACCUMULATED LOW-ORDER FILE ADDR
	SZL		/DID IT OVERFLOW
	ISZ SYPIOB+1	/YES, INCREMENT HIGH-ORDER FILE ADDR
SYP2,	DCA SYPIOB+5	/SAVE LOW-ORDER FILE ADDR
	TAD I X1	/GET NEXT INCREMENT
	ISZ TEMP1	/IS THIS THE ENTRY WE WANT
	JMP SYP1	/NO
	SNA		/YES, IS IT ZERO INCREMENT
	TAD I X1	/YES, PROGRAM LENGTH IS NEXT WORD
	CIA		/NO, INCREMENT IS PROGRAM LENGTH
	DCA SYPIOB+3	/STORE NEGATIVE WORD COUNT
	TAD SYPKF	/STORE DISK CURRENT ADDR
	DCA SYPIOB+4
	CLA CMA			/SET EXIT SWITCH
	DCA	XSW		/ERROR IS FATAL
	TAD	SYPIOB
	RFILE		/READ PROGRAM INTO CORE
	TAD	SYPIOB+6	/GET ERROR WORD
	CHKFOP		 /CHECK FILE OP
	DCA   XSW	 /CLEAR EXIT SWITCH
	JMP I	SK400
SK400,	400
SKSAS,	SAS
C617,	617

/
/
SYPIOB, .+1		/SYSTEM IO CONTROL BLOCK
	0		/HIGH ORDER FILE ADDRESS
	3		/INTERNAL FILE NO
	0		/-WORD COUNT
	0		/CORE FWA-1
	0		/LOW ORDER FILE ADDRESS
	0		/ERROR WORD
/
SYPKF,	377		/CORE BUFFER FWA-1
/
/
SYPTBA, .		/PARAMETER TABLE FWA-1
/
	0		/EDITOR
EDTX1,	END-400
	TOPOFCORE-400	/ERROR
	5004		/COMPILER
	544		/LOADER
	243		/EXECUTOR
	0		/INPUT OVERLAY
	1000
INTX1,	INTSAV-400	/INTERPRETER
	760		/FUNCTION OVERLAY

/
/BASIC PLACED ON DISK AS FOLLOWS:
/
/NAME	DISK  CORE	 CORE
/	BEG   LOW	 HIGH
/
/EDITOR 0	0	6143
/ERROR--END OF EDITOR
/COMPLR 6144	400	5403
/LOADER 13150	400	1143
/EXECUT 13714	400	 642
/BASIN  14157	400	7205
/  INT  14157 	400	6226
/  FUNC 22006	400	1357
/
/
/		38 (DECIMAL) 256-WORD SEGMENTS ARE REQUIRED
/
	*352
LCSAV,	0		/SAVE AREA FOR TTY COLUMN POSITION DURING CHAIN
PRC,	0		/SAVE AREA FOR LPT COLUMN POSITION DURING CHAIN
PRGNM,	0		/CURRENT PROG. NAME IF CHAIN IS EXECUTED
	0		/  NOTE:  NEED 0 IN UFIL0 TO ACT AS DELIM. FOR PRINT
	0		/         ROUTINE
UFIL0,	0		/CONTROL BLOCK FOR OPENING USER FILE 0
	0
	0
	0
	0

/
/THIS SUBROUTINE IS USED BY VARIOUS PARTS
/OF BASIC TO TYPE OUT A MESSAGE.

STSX,	0
	TAD I	STSX		/GET PARAMETERS
	DCA	SYPIOB+3
	ISZ	STSX
	TAD I	STSX
	DCA 	SYPIOB+4
	ISZ	STSX
	TAD	SYSPT
SASOP,	SAS
	JMP	.-2
	JMP I	STSX		/EXIT STRING IS OUT

SYSPT,	SYPIOB+3
*400
/EDITOR CONTROL PROGRAM(EDT)
/ALSO ENTRY TO ERROR HANDLER
/FUNCTION:TO IDENTIFY DIRECTIVES ENTERED AND CALL PROCESSING ROUTINES
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:NO SPECIAL CONDITIONS
/
/ERROR EXIT:INVALID ENTRY
/
	JMP I .+1	/GO INITIALIZE EDITOR (AND MAYBE CALL ERROR HANDLER)
	INE50S
/
/ENTRY AFTER CATALOG OR SAVE. SOURCE INFO IS ON FILE 0
/
EDT,	TAD	COMP		/DO NOT COPY FILE IF EXECUTE ONLY
	SPA CLA
	JMP	EDT5
	REWIND		 /REWIND FILES
	TAD   COPY01
	COPYFL		 /COPY FILE 0 TO FILE 1
/
/ENTRY AFTER A START OR RELOAD
/
EDT5,	REWIND		 /REWIND FILES
	IO11
	RDFILE		/READ FROM FILE 1 TO BUFFER 1
	LOADCB		/LOAD FILE 0 DCB TRANSFER VECTOR
	IAC
	DCA I	P0VEC+4 /SET FILE 0 ACTIVE SEGMENT COUNT TO 1
/
/ENTER AT EDT20 AFTER A LINE OR LINE DIRECTIVE(LIST,DELETE) OR UNSAVE
/
/A CR-LF IS OUTPUT AND THE NEXT LINE INPUT FROM THE TTY
/
EDT20A,	TAD DEVSTS	/IS FILE 2 OPEN
	AND K10
	SZA CLA
	JMP EDT20C	/NO
	TAD BIT2	/YES, CLOSE IT
	CLOS
EDT20C,	CLA IAC		/IS LPT ASSIGNED
	AND DEVSTS
	SZA CLA
	JMP EDT20D	/NO
	TAD K4002	/RELEASE LPT
	REL
EDT20D,	STA		/INDICATE ALL DEVICES "CLOSED"
	DCA DEVSTS
	SEND;	READY		/OUTPUT "READY"
	JMP	EDT20B

EDT20,	SEND;	RETURN		/PUT OUT A CR-LF

EDT20B,	RDTEXT			/READ A LINE OF TEXT
EDT25X,	DCA	PROTX		/CLEAR MAGIC SWITCH
EDT25,	INPCH		/INPUT CHARACTER
	JMP   EDT20	 /EOM-FLUSH
	JMP	EDT25	/BLANK
	JMP	EDT60	/ERROR-COMMA
	JMP	EDT60	/ERROR-SPECIAL CHAR
	JMP	EDT26	/ALPHABETIC
/
/FIRST CHARACTER INPUT WAS NUMERIC.PROCESS INPUT AS A LINE OF
/ 'BASIC' SOURCE TEXT
/
	CLA		/NUMERIC
	TAD	TAPE
	SNA CLA
	CRLF
	TAD COMP	/CAN'T BE EXECUTE ONLY FILE
	SPA CLA
	JMP	EDXER		/EXECUTE ONLY ERROR
	INPBIN		/INPUT BINARY NUMBER
	DCA	LOW	/STORE IN LOW
	POSFIL		/POSITION FILE
	GETWD		/GET NEXT LINE NO
	CIA
	TAD	LOW
	SNA CLA		/DOES LINE EQUAL LOW?
EDT45,	GETNXI		/YES
	SZA		/PASS THROUGH LINE
	JMP	EDT45
	TAD	ICHCH
	SZA CLA		/SKIP IF TERM WAS EOM
	JMS I	EDTLTO	/MOVE TEXT TO OUTPUT BUFFER
	ISZ	PROTX	/TEST MAGIC SWITCH
	JMP	EDT20B	/NORMAL RETURN
	JMP	EDT20A	/RETURN THRU READY TYPEOUT
/
/FIRST CHARACTER IS ALPHABETIC, SCAN LIST OF VALID DIRECTIVES,
/THEN SLEW THROUGH INPUT LINE TO A TERMINATOR, AND EXIT TO PROPER
/PROCESSING ROUTINE.
/
EDT26,	DCA	TEMP1		/SAVE FIRST CHARACTER
	TAD	TXBPTR
	DCA	X1
	TAD I	X1
	DCA	TEMP2		/GET SECOND CHARACTER
	TAD I	X1
	DCA	TEMP3		/GET THIRD CHARACTER

	TAD	EDTP1
	DCA	X1		/SET UP POINTER TO DIRECTIVE TABLE

EDT27,	TAD	KM3
	DCA	TEMP4		/CHARACTER COUNT
	TAD	PTEMP1
	DCA	X2	/POINTS TO COMMAND
	DCA	TEMP5		/CLEAR UNMATCHED FLAG

EDT27A,	TAD I	X1
	SNA			/ZERO MARKS END OF TABLE
	JMP	EDT60
	TAD I	X2		/ADD IN CHARACTER TYPED
	AND	K177		/ONLY 7-BITS USED
	SZA CLA
	ISZ	TEMP5		/NO MATCH FOUND
	ISZ	TEMP4
	JMP	EDT27A

	TAD I	X1
	DCA	TEMP4		/GET ADDRESS OF DIRECTIVE ROUINTE
	TAD	TEMP5
	SZA CLA			/TEST FOR MATCH
	JMP	EDT27		/TRY AGAIN

/CHECK FOR EXECUTE ONLY ERROR
	TAD	COMP
	SMA CLA			/SKIP IF EXECUTE ONLY FILE
	JMP	EDT28
	TAD	EXCHK
	TAD	X1
	SPA CLA
	JMP	EDT28
EDXER,	SEND;	EFM	/EXECUTE ONLY FILE
	JMP	EDT20A

/SLEW TO TERMINATOR AND EXIT.
EDT28,	INPCH
	JMP	EDGO		/EOM--END SCAN
	JMP	EDGO		/BLANK--END SCAN
	JMP	EDT60		/COMMA--ERROR
	JMP	EDT60		/SPECIAL CHAR--ERROR
	JMP	EDT28		/ALPHABETIC--CONTINUE
	/NUMERIC FALLS INTO EDT60--ERROR

/
/ERROR EXIT - OUTPUT ERROR MESSAGE 12 AND RESTART LINE
/
EDT60,	SEND;	EDWHAT	/WHAT?
	JMP	EDT20B	/RETURN
/
EDTLTO, LTO		/LINE OF TEXT TO OUTPUT

/EXIT TO DIRECTIVE PROCESSOR.
EDGO,	CLA
	JMP I	TEMP4

EDTP1,	EDTTB1-1	/EXIT ADDRESS TABLE FWA
PTEMP1,	TEMP1-1		/POINTER TO CHARS IN TEMP1-TEMP3
EXCHK,	-EXFOK		/ADDRESS OF LAST LEGAL COMMAND

/COMES HERE ON A TAPE COMMAND
TAPIT,	CLA IAC
	DCA	TAPE		/SET TAPE FLAG
	UND			/UNDUPLEX
	JMS I	PSTSX
	-3
	CRLFM-1
	JMP	EDT20A		/CONTINUE

PAGE

/CONVERT BINARY TO ASCII(CBA)
/
/FUNCTION:TO CONVERT A BINARY NUMBER INTO AN ASCII DECIMAL STRING
/
/ENTRY:BINARY NO IN A-REG
/
/EXIT:TEXT BUFFER POINTER TXBPTR INITIALIZED
/
CBA,	0
	DCA	TEMP1	/SAVE BINARY NO IN TEMP1
	TAD	CBAATB
	DCA	TEMP2	/DECIMAL TABLE POINTER TO TEMP2
	STA
	DCA	TEMP3	/SET ZERO SUPPRESS SWITCH TO -1
	TAD	KM4
	DCA	TEMP4	/INITIALIZE LOOP COUNTER TO -4
	TAD	CBATXP
	DCA	TEMP5	/INITIALIZE TEXT BUFFER WORKING POINTER
	TAD	KBLANK
	DCA	TEMP6	/SET INITIAL CHAR TO BLANK
CBA5,	TAD	TEMP6	/ENTRY TO CONVERSION LOOP
	DCA I	TEMP5	/INITIAL CHAR TO TEXT BUFFER
CBA7,	CLA
	TAD	TEMP1	/BINARY RESIDUE TO A-REG
	TAD I	TEMP2	/SUBTRACT OFF POWER OF 10
	SPA		/IS THIS A NON-ZERO DIGIT ?
	JMP	CBA15	/NO
	DCA	TEMP1	/YES.REDUCE BINARY RESIDUE
	ISZ	TEMP3	/IS THIS FIRST NON-ZERO DIGIT
	JMP	CBA10	/NO
	TAD	KA0	/YES
	DCA	TEMP6	/SET INITIAL CHAR TO ZERO
	TAD	KA0
	DCA I	TEMP5	/SET ZERO IN BUFFER
CBA10,	ISZ I	TEMP5	/INCREMENT ASCII DIGIT AND
	JMP	CBA7	/LOOP BACK
CBA15,	CLA
	ISZ	TEMP2	/INCREMENT DECIMAL TABLE POINTER
	TAD	TAPE	/TEST FOR TAPE MODE
	SNA CLA
	JMP	CBA15A	/NOT IN TAPE MODE
	TAD	TEMP3
	SMA CLA		/IGNORE LEADING ZEROES
CBA15A,	ISZ	TEMP5	/INCREMENT TEXT BUFFER POINTER
	ISZ	TEMP4	/INCREMENT LOOP COUNT
	JMP	CBA5	/LOOP BACK
	CLA CMA
	TAD	TEMP5
	DCA	TXBPTR	/INITIALIZE TEXT BUFFER POINTER TXBPTR
	JMP I	CBA	/EXIT
/
	-1750		/-DECIMAL 1000
	-144		/-DECIMAL 100
	-12		/-DECIMAL 10
	-1		/-1
CBAATB, .-4		/TABLE FWA
CBATXP, TXBUF

/CHARACTER EDIT FUNCTION.
/RESEMBLANCE TO THE FOCAL MODIFY IS PURELY CO-INCIDENTAL.
/THIS ROUTINE SCANS A SPECIFIED LINE FOR THE OCCURANCE OF
/A CHARACTER AND, HAVING FOUND THE CHARACTER IT PERMITS THE
/USER TO INSERT CHANGES AT THAT POINT.

EDIT,	INPCH			/SCAN OVER TO LINE #
	JMP	EDERR1		/LINE NUMBER MUST BE SPECIFIED
	JMP	EDIT		/SCAN OFF SPACES
	JMP	EDERR1		/COMMA
	JMP	EDERR1		/SPEC CHAR
	JMP	EDERR1		/ALPHA
	INPBIN			/BUILD LINE NUMBER
	DCA	LOW		/SAVE LINE NUMBER
	TAD	ICHCH		/EOM MUST BE TERMINATOR
	SZA CLA
	JMP	EDERR1

	POSFIL			/HUNT FOR DESIRED LINE
	GETWD			/GET LINE NUMBER
	CIA
	TAD	LOW
	SNA CLA
	JMP	EDIT1		/OK--FOUND LINE
	SEND;	EDEM2		/CAN'T FIND DESIRED LINE
	EDITOR			/RETURN TO START

EDERR1,	SEND;	LNEM		/INVALID SYNTAX ON LINE
	EDITOR

EDIT1,	CLA CLL CML RAR
	KSB			/I'VE GOT TO BREAK ON ALL CHARS
	GETNXI			/PASS OFF LINE NUMBER
	PUTWD
	CLA IAC			/PUT INTO TAPE MODE FOR A SECOND
	DCA	TAPE
	TAD	LOW
	JMS	CBA		/PUT LINE NUMBER IN BUFFER
	DCA	TAPE		/SET TO KEY MODE
	DUP			/IN CASE SOMEBODY'S PLAYING GAMES
	CLA CMA
	DCA	TEMP5		/GET SET TO READ LH CHAR
	TAD	(TXBUF-3	/SET TO TYPE FRONT OF LINE
	JMP I .+1	/ENTER PAGE TWO OF EDIT
	EDIT2
/COPY INPUT TO OUTPUT(CIO)
/
/FUNCTION:TO COPY LINES OF TEXT FROM THE INPUT FILE TO THE OUTPUT FILE
/
/ENTRY:A-REG HOLDS TERMINATING LINE NUMBER
/
/EXIT:NO SPECIAL CONDITIONS
/
CIO,	0
	DCA	CIOLIM	/LIMIT LINE NO TO CIOLIM
CIO5,	GETWD		/GET LINE NUMBER FROM INPUT BUFFER
	CIA
	TAD	CIOLIM
	SPA SNA CLA 	/IS INPUT LINE NO .GE. LIMIT ?
	JMP	CIO15	/YES.EXIT
	GETNXI		/INPUT LINE NO AGAIN
	DCA	LAST	/STORE IN LAST
	TAD	LAST	/RESTORE A-REG
	PUTWD		/STORE WORD IN OUTPUT FILE
CIO10,	GETNXI		/INPUT NEXT WORD
	DCA	CIOWD	/SAVE IN CIOWD
	TAD	CIOWD	/RESTORE A-REG
	PUTWD		/STORE WORD IN OUTPUT FILE
	TAD	CIOWD
	SZA		/END OF LINE?
	JMP	CIO10	/NO
	JMP	CIO5	/YES
CIO15,	JMP I	CIO	/EXIT
/
CIOLIM, 0		/LIMIT LINE NUMBER
CIOWD,	0		/INPUT WORD
/DELETE DIRECTIVE(DEL)
/
/FUNCTION:TO PROCESS THE EDITOR DIRECTIVE 'DELETE M(,N)'
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:NO SPECIAL CONDITIONS
/
DEL,	0
	JMS I	DELSLD	/SCAN PARAMETER LIST
	POSFIL		/POSITION FILE
DEL5,	GETWD		/GET LINE NO FROM INPUT FILE
	CIA
	TAD	HIGH
	SPA		/IS LINE NO .GT. HIGH?
	EDITOR		/YES.EXIT TO EDITOR
DEL15,	GETNXI		/GET NEXT WORD FROM INPUT FILE
	SZA		/IS THIS END OF LINE?
	JMP	DEL15	/NO
	JMP	DEL5	/YES
/
DELSLD, SLD		/SCAN LIST AND DELETE

/READY MESSAGE
READY,	TEXT /__READY__/
RETURN=READY+4

PAGE

/INPUT CHARACTER(ICH)
/
/FUNCTION:TO INPUT AND IDENTIFY A CHARACTER FROM THE TEXT BUFFER
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:A-REG AND ICHCH CONTAIN CHARACTER OR CODE
/
/CALLING SEQUENCE:JMS ICH
/		  EOM EXIT(A=ICHCH=0)
/		  BLANK EXIT(A=ICHCH=-1)
/		  COMMA EXIT(A=ICHCH=-2)
/		  SPECIAL CHAR EXIT
/		  ALPHABETIC EXIT
/		  NUMERIC EXIT
/
ICH,	0
	CLA
	DCA	ICHCH	/CLEAR ICHCH
	TAD I	TXBPTR		/NEXT CHAR TO A-REG
	AND	K177
	TAD	K200		/CONVERT TO 8 BIT ASCII
	DCA	TEMP1
	TAD	TXBLIM
	CIA
	TAD	TXBPTR
	SMA SZA CLA		/IS THIS END OF MESSAGE?
	JMP	ICH50	/YES
	STA		/NO
	DCA	ICHCH	/SET ICHCH TO -1
	ISZ	ICH	/INCREMENT EXIT ADDRESS
	TAD	KM240
	TAD	TEMP1
	SNA CLA		/IS CHAR A BLANK?
	JMP	ICH50	/YES
	STA CLL RAL	/NO
	DCA	ICHCH	/SET ICHCH TO -2
	ISZ	ICH	/INCREMENT EXIT ADDRESS
	TAD	KMCOM
	TAD	TEMP1
	SNA CLA		/IS CHAR A COMMA?
	JMP	ICH50	/YES
	TAD	TEMP1
	DCA	ICHCH	/STORE INPUT CHAR IN ICHCH
	ISZ	ICH	/INCREMENT EXIT ADDRESS
	TAD	ICHCH
	TAD	KM272	/TEST FOR NUMERIC CHARACTER
	CLL
	TAD	K12
	SNL
	JMP	ICH10	/NO
	ISZ	ICH	/YES
	ISZ	ICH	/SET EXIT TO NUMERIC
ICH10,	TAD	KM53
	CLL		/TEST FOR ALPHABETIC CHARACTER
	TAD	K32
	SZL CLA
	ISZ	ICH	/YES.CHAR IS ALPHABETIC
ICH50,	TAD	ICHCH	/ICHCH TO A-REG
	JMP I	ICH	/EXIT
/
KMCOM,	-254
/INPUT FILE NAME(IFN)
/
/FUNCTION:TO INPUT AN ASCII STRING OF UP TO 6 CHARACTERS
/	AND STORE IT, PACKED TWO CHARACTERS PER WORD.
/	CONVERSION TO 6-BIT FORM IS BY SUBTRACTING 240
/	TRAILING BLANKS ARE SCANNED OVER.
/	TERMINATOR MUST BE EOM OR COMMA.
/	NON-ALPHANUMERIC CHARACTERS ARE ERRORS
/
/ENTRY:	DESTINATION ADDRESS-1 IN AC
/
/EXIT:		ENTRY+2 IF NO ERRORS
/		ENTRY+1 OTHERWISE
/
IFN,	0
	DCA X1		/STORE DESTINATION ADDRESS
	STA CLL RTL	/SET UP TO READ 3 WORDS OF INFO
	DCA IFNCNT
	STA		/BACK UP TEXT BUFFER POINTER TO REREAD
	TAD TXBPTR	/  FIRST CHARACTER
	DCA TXBPTR
IFN10,	JMS IFNGCH	/GET CHARACTER
	CLL RTL		/SAVE AS HIGH-ORDER BYTE
	RTL
	RTL
	DCA IFNWD
	JMS IFNGCH	/GET CHARACTER
	TAD IFNWD	/ADD IN HIGH-ORDER BYTE
	DCA I X1	/STORE IN DESTINATION
	ISZ IFNCNT	/NEED MORE?
	JMP IFN10	/YES
IFN20,	INPCH		/NO, SCAN FOR TERMINATOR AND INCREMENT RET. ADDR. IF VALID
	SKP		/EOM - VALID
	JMP IFN20	/BLANK - CONTINUE SCAN
	ISZ IFN		/COMMA - VALID; INCREMENT RET. ADDR.
	NOP		/SPEC CHAR - INVALID
	NOP		/ALPHA - INVALID
IFN30,	CLA		/NUMERIC - INVALID
	JMP I IFN	/RETURN

/
/ IFNGCH - SUBROUTINE TO GET TSS8 SIXBIT CHARACTERS FOR IFN
/
/ IF EOM, COMMA OR BLANK IS INPUT CHAR THEN BLANK IS RETURNED
/ AND INPUT POINTER IS ADJUSTED SO THAT THE CHAR WILL BE REREAD.
/ IF SPEC CHAR IS INPUT CHAR THEN ERROR RETURN FROM IFN IS TAKEN.
/ TSS8 SIXBIT FORMAT CHAR IS RETURNED IN AC.
/
IFNGCH,	0
	INPCH		/INPUT A CHARACTER
	JMP IFNEX	/EOM - FAKE A BLANK
	JMP IFNEX	/BLANK - SEND A BLANK
	JMP IFNEX	/COMMA - FAKE A BLANK
	JMP IFNEX	/SPEC CHAR - FAKE A BLANK
	NOP		/ALPHA - OK
	TAD KM240	/NUM - CONVERT TO TSS8 SIXBIT
	JMP I IFNGCH

IFNEX,	STA		/FORCE CHAR TO BE REREAD
	TAD TXBPTR
	DCA TXBPTR
	JMP I IFNGCH	/RETURN WITH AC=0 (I.E. SIXBIT BLANK)

IFNCNT, 0		/LOOP COUNTER
IFNWD,	0		/PARTIAL WORD

/THIS SUBROUTINE TYPES OUT A MESSAGE IN TEXT FORMAT.
/IF THE CHARACTER "_" APPEARS IN THE MESSAGE A CR-LF
/IS INSERTED AT THAT POINT.

TEXTO,	0
	CLA
	TAD I	TEXTO
	DCA	TEMP1
	ISZ	TEXTO		/SET UP POINTER
	TAD	TAPE		/CANT OUTPUT IN TAPE MODE
	SZA CLA
	JMP I	TEXTO

	TAD	TEXTP
	DCA	TXBPTR		/RESET POINTER TO TXBUF
	DCA	TEXTC		/RESET COUNT
	JMP	TEXTS

TEXTT,	JMS I	TEXTL
	ISZ	TEMP1		/NEXT WORD
TEXTS,	TAD I	TEMP1		/GET HI BYTE
	RTR CLL
	RTR
	RTR
	TAD SIXBIT	/ADD 40 IF TSS8 SIXBIT
	AND KLOBYT
	SZA
	JMS I	TEXTL		/PUT BYTE IN TXBUF
	TAD I	TEMP1
	TAD SIXBIT	/ADD 40 IF TSS8 SIXBIT
	AND	KLOBYT		/MASK OFF BYTE
	SZA
	JMP	TEXTT		/CONTINUE

	TAD	TEXTC
	CIA
	DCA	TEXTC		/SET UP COUNTER
	JMS I	PSTSX
TEXTC,	0
TEXTP,	TXBUF-1
	JMP I	TEXTO

TEXTL,	LSTC

PAGE
/LLIST DIRECTIVE (LLST)
/
/FUNCTION:PROCESS EDITOR DIRECTIVE 'LLIST(M(,N))'
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:FALLS INTO LIST DIRECTIVE WITH TAPE=-1
/
LLST,	STA		/INDICATE LLIST
	DCA TAPE
/
/!! MUST BE FOLLOWED BY LIST DIRECTIVE PROCESSOR !!
/


/LIST DIRECTIVE(LST)
/FUNCTION:TO PROCESS THE EDITOR DIRECTIVE 'LIST(M(,N))'
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:NO SPECIAL CONDITION
/
LSTX,	DCA I PTEXTC	/CLEAR TEXT COUNTER
	JMS I	LSTSLD	/SCAN PARAMETER LIST
	TAD	LOW
	SMA CLA 	/ANY PARAMETERS ?
	JMP	LST5	/YES
	DCA	LOW	/SET LOW TO ZERO
	TAD   K3776
	DCA	HIGH	/SET HIGH TO 3776
LST5,	POSFIL		/POSITION FILE
	GETWD		/GET LINE NO.
	TAD KM3777	/IS THIS END OF FILE
	SNA CLA
	JMP LST30	/YES, NOTHING TO DO
	TAD	TAPE
	SMA SZA CLA
	JMS	LINULL	/TYPE BLANK TAPE IF IN TAPE MODE
	TAD TAPE	/IS THIS AN LLIST
	SMA CLA
	JMP LST10	/NO
	DCA TAPE	/KICK IT INTO KEYBOARD MODE
	TAD K4002	/ASSIGN LP08 PRINTER
	ASD
	SZA CLA		/DID IT HAPPEN
	ERR12		/NO, PRINTER BUSY
	STA CLL RAL	/YES, INDICATE LPT ASSIGNED
	DCA DEVSTS
	TAD KLST	/STORE PRINTER IOT IN SAS ROUTINE
	DCA I KSASOP
	JMS I PSTSX	/SEND A FORM-FEED AND CR
	-2
	FFCRM-1
LST10,	GETWD		/GET LINE NO FROM INPUT FILE
	DCA	LSTWD	/SAVE IN LISTWD
	TAD	LSTWD	/RESTORE A-REG
	CIA
	TAD	HIGH
	SPA CLA 	/IS LINE NO .GT. HIGH ?
	JMP	LST30	/RETURN TO EDITOR
	GETNXI		/GET LINE NUMBER
	JMS I	LSTCBA	/CONVERT TO ASCII DECIMAL STRING
	TAD	LSTWD
	DCA	LAST	/UPDATE LAST
	TAD	LSTWD	/LINE NO TO OUTPUT BUFFER
	PUTWD		/MOVE TO OUTPUT FILE
LST20,	GETNXI		/GET NEXT WORD
	DCA	LSTWD	/SAVE IN LSTWD
	TAD	LSTWD	/RESTORE A-REG
	PUTWD		/MOVE WORD TO OUTPUT FILE
	TAD	LSTWD
	SNA		/IS THIS END OF LINE?
	JMP	LST25	/YES
	RTR		/NO
	RTR
	RTR		/SHIFT UPPER BYTE TO LOWER
	JMS	LSTC	/CONVERT TO ASCII CHAR
	TAD	LSTWD
	JMS	LSTC	/CONVERT LOWER BYTE TO ASCII
	JMP	LST20	/RETURN FOR NEXT WORD
LST25,	CLA
	TAD	TXBPTR
	CIA
	TAD	LSTCB+2		/MINUS THE NUMBER OF CHARS IN TXBUF
	DCA	LSTCB+1 /STORE IN WORD 1 OF CONTROL BLOCK
LSTCB,	JMS I	PSTSX		/TYPE THE LINE
	0
	TXBUF-3
	JMP	LST10	/RETURN FOR NEXT LINE

/
/LIST SERVICE SUBROUTINE LSTC CONVERTS 6-BIT CHAR TO ASCII
/ENTER WITH CHAR IN L(A)
/AND STORES IT IN TEXT BUFFER.
/IF CHAR IS _ THEN CR-LF IS TYPED INSTEAD.
/ALSO THE NUMBER OF CHARACTERS PUT IN TXBUF IS COUNTED IN TEXTC.
/
LSTC,	0
	AND	KLOBYT		/GET BYTE
	TAD	KM37
	SNA			/IS CHAR A _?
	JMP	LSTCRF		/YES...PUT IN A CRLF
	SPA
	TAD	K100		/ADD 300
	TAD	K237		/ADD 200
LSTC1,	DCA I	TXBPTR		/STORE ASCII CHAR IN TXBUF
	ISZ I PTEXTC	/COUNT CHAR
K237,	237			/USED AS NOP IN CASE ISZ SKIPS!
	JMP I	LSTC		/EXIT

/TYPE CR-LF
LSTCRF,	TAD	K215
	DCA I	TXBPTR
	ISZ I PTEXTC	/PUT CR IN TXBUF AND COUNT IT
	TAD	K212
	JMP	LSTC1		/PUT LF IN TXBUF
/
LSTSLD, SLD		/SCAN LIST AND DELETE
LSTCBA, CBA		/CONVERT BINARY TO ASCII
LSTWD,	0		/SAVE INPUT WORD

FFCRM=.
	214
CRLFM=.
K215,	215
K212,	212
	221		/XON USED BY TAPE MODE!!!


/EXIT TO EDITOR
LST30,	TAD	TAPE
	SNA SPA CLA
	JMP LLSTEN
	CRLF
	JMS	LINULL
	EDITOR

/SUBROUTINE LISTS A STRING OF NULLS
LINULL,	0
	TAD	KHIBYT
	DCA	TXBPTR
	TLS
	ISZ	TXBPTR
	JMP	.-2
	JMP I	LINULL

LLSTEN,	TAD KSAS	/RESTORE SAS IOT AFTER LLIST
	DCA I KSASOP
KEYIT,	DCA TAPE	/SET TO KEYBOARD MODE
	DUP		/DUPLEX THE TTY
	EDITOR

KSASOP,	SASOP
KSAS,	SAS
KLST,	LST
PTEXTC,	TEXTC
/
/RUN(RUN)
/
/FUNCTION:TO PROCESS THE EDITOR DIRECTIVE "RUN"
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:TO LOCATION 400 OF COMPILER OR BASEXC
/	PRGNM IS SET TO 3737
/
RUN,	TAD COMP	/IS THIS EXECUTE ONLY FILE
	SZA CLA
	JMP RUNC	/YES, GO CALL BASEXC
	WRTEOF		/NO, WRITE TO END OF FILE
	STA CLL RAL	/CALL COMPILER
RUNC,	TAD K4
	JMP I SYSPRG
K4,	4

PAGE
/LINE OF TEXT TO OUTPUT(LTO)
/
/FUNCTION:TO MOVE A LINE FROM THE TEXT BUFFER TO THE OUTPUT FILE
/
/ENTRY:	LINE NO IN LOW
/	FIRST CHAR IN ICHCH
/	AC CLEAR
/EXIT:	LINE IN OUTPUT FILE HAS FORMAT-
/	FIRST WORD:  LINE NUMBER IN BINARY
/	BODY:  CHARS IN 6-BIT FORM, 2 PER WORD, FINAL BLANK IF ODD NO
/	LAST WORD:  ZERO
/
LTO,	0
	TAD LOW		/REMEMBER LAST LINE MOVED TO OUTPUT
	DCA LAST
	TAD LOW		/OUTPUT LINE NO.
	PUTWD
	STA		/BACK UP TEXT BUFFER POINTER TO REREAD
	TAD TXBPTR	/  FIRST CHARACTER
	DCA TXBPTR
LTO10,	JMS LTOGCH	/GET CHARACTER AND TEST FOR EOL
	JMP LTO30	/EOL:  GO OUTPUT EOL MARKER
	CLL RTL		/SAVE CHAR AS HIGH-ORDER BYTE
	RTL
	RTL
	DCA LTOWD
	JMS LTOGCH	/GET CHARACTER AND TEST FOR EOL
	JMP LTO20	/EOL:  ODD NO OF CHARS; STORE BLANK AS LAST CHAR
	TAD LTOWD	/ADD IN HIGH-ORDER BYTE
	PUTWD		/OUTPUT TEXT WORD
	JMP LTO10	/CONTINUE

LTO20,	TAD LTOWD	/LOAD HIGH-ORDER BYTE
	TAD K40		/ADD IN BLANK AS LOW-ORDER
	PUTWD		/OUTPUT LAST TEXT WORD
LTO30,	PUTWD		/OUTPUT 0 AS EOL MARKER
	JMP I LTO	/RETURN

/
/ LTOGCH - SUBROUTINE TO GET 6-BIT INPUT CHAR AND TEST FOR EOL
/
/EXIT:	CALL+1 IFF EOL
/	CALL+2 IFF NO EOL (CHAR IN AC)
/
LTOGCH,	0
	TAD TXBPTR	/HAVE WE REACHED EOL
	CIA
	TAD TXBLIM
	SNA CLA
	JMP I LTOGCH	/YES, RETURN WITHOUT INCREMENT
	ISZ LTOGCH	/NO, INCREMENT RET ADDR
	TAD I TXBPTR	/PICK UP NEXT CHAR
	AND KLOBYT	/TRUNCATE TO 6 BITS
	JMP I LTOGCH

LTOWD,	0		/PARTIAL WORD
/POSITION FILE(PFL)
/
/FUNCTION:TO POSITION INPUT AND OUTPUT FILES TO A LINE NO
/
/ENTRY:LINE NO IN LOW
/	LAST LINE NO TO OUTPUT IN LAST
/
/EXIT:INPUT FILE COPIED TO OUTPUT FILE UP TO LINE NO
/
PFL,	0
	CLA
	TAD	LOW
	CIA
	TAD	LAST
	SPA CLA 	/IS LAST .GE. LOW ?
	JMP	PFL10	/NO
	WRTEOF		/YES. COPY TO END OF FILE
	TAD   COPY01
	COPYFL		/COPY FILE 0 TO FILE 1
	REWIND		/REWIND FILES
	IO11
	RDFILE		/READ FILE 1 INTO BUFFER 1
	LOADCB		/LOAD FILE 0 DCB TRANSFER VECTOR
	IAC
	DCA I	P0VEC+4 /SET FILE 0 ACTIVE SEGMENT COUNT TO 1
PFL10,	TAD	LOW
	JMS I	PFLCIO	/COPY FROM INPUT FILE TO OUTPUT UP TO LOW
PFL25,	JMP I	PFL	/EXIT
/
PFLCIO, CIO		/COPY INPUT TO OUTPUT
/COPY FILE(CPF)
/
/FUNCTION: TO COPY ONE FILE ONTO ANOTHER
/
/ENTRY: A-REG CONTAINS THE ADDRESS OF A 2-WORD BLOCK:
/      WORD 1: NUMBER OF SOURCE FILE
/      WORD 2: NUMBER OF DESTINATION FILE
/
/EXIT: NO SPECIAL CONDITIONS
/
CPF,	0
	DCA   CPFT1	 /SOURCE FILE NO ADDRESS TO CPFT1
	TAD I CPFT1	/GET SOURCE FILE NO
	TAD CPFB	/ADD BIAS
	DCA CPF15	/STORE IN PROGRAM
	TAD I	CPFT1	/GET SOURCE FILE NUMBER
	LOADCB		/LOAD SOURCE FILE DCB TRANSFER VECTOR
	ISZ CPFT1	/POINT TO SECOND PARAMETER
	TAD I CPFT1	/GET DESTINATION FILE NO
	DCA	FINFBL	/STORE IN FINFBL
	TAD I P0VEC+4	/GET SOURCE FILE ACTIVE SEGMENT COUNT
	DCA CPFT1	/SAVE IN CPFT1
	TAD	FINFBL	/RESTORE A-REG
	LOADCB		/LOAD DESTINATION FILE DCB TRANSFER VECTOR
	TAD I	P0VEC+3 /GET DESTINATION FILE TOTAL SEGMENT COUNT
	CIA		/TAKE NEGATIVE
	TAD	CPFT1	/ADD SOURCE FILE ACTIVE SEGMENT COUNT
	SPA SNA		 /IS DESTINATION FILE .GE. SOURCE FILE ?
	JMP   CPF10	 /YES
	DCA   FINFBL+1	 /NO. DESTINATION FILE MUST BE EXPANDED
	TAD   AFINF
	EXT		 /EXTEND DESTINATION FILE
	SPA SNA
	JMP	.+3
	CLA
	TAD	K7400		/DISK FULL ERROR
	CHKFOP		 /CHECK OP
	TAD   FINFBL+1	 /EXTEND SEGMENT COUNT TO A-REG
	TAD I P0VEC+3	 /INCREMENT TOTAL SEGMENT COUNT
	DCA I P0VEC+3
CPF10,	CLA
	TAD I P0VEC+3
	DCA I P0VEC+4	 /UPDATE ACTIVE SEGMENT COUNT
	STA		/WAS DESTINATION FILE NO 1?
	TAD FINFBL
	SZA CLA
	JMP	CPF12	/NO
	TAD I P0VEC+3	 /YES. GET NEW FILE 1 SEGMENT COUNT
	DCA   SRSIZE	 /UPDATE SRSIZE
CPF12,	TAD	FINFBL	 /GET DESTINATION FILE NUMBER
	TAD   CPFB	 /ADD BIAS
	DCA   CPF20	 /STORE IN PROGRAM
	REWIND		 /REWIND FILES
CPF15,	0		 /LOAD READ FILE CONTROL WORD
	RDFILE		 /READ FROM SOURCE FILE TO BUFFER 2
	SZL		 /END OF FILE ?
	JMP I	CPF	/YES, EXIT
CPF20,	0		 /NO. LOAD WRITE FILE CONTROL WORD
	WRFILE		 /WRITE TO DESTINATION FILE
	JMP   CPF15
/
CPFB,	TAD   .+1	 /LOAD CONTROL WORD INSTRUCTION
	0001		 /CONTROL WORD - FILE 0, BUFFER 2
	0101		 /CONTROL WORD - FILE 1, BUFFER 2
	0201		 /CONTROL WORD - FILE 2, BUFFER 2
CPFT1=TEMP3

/
/OP2 - ROUTINE TO OPEN FILE 2
/
OP2,	0
	STA		/INDICATE FILE 2 CLOSED
	DCA DEVSTS
	TAD OP2PTR	/OPEN FILE 2
	OPEN
	SZA		/DID OPEN SUCCEED
	JMP I OP2	/NO, RETURN TO CALL+1 WITH ERROR CODE IN AC
	TAD KM11	/YES, INDICATE FILE 2 OPEN
	DCA DEVSTS
	ISZ OP2		/RETURN TO CALL+2
	JMP I OP2
OP2PTR,	FL2CB
KM11,	-11

EDWHAT,	TEXT /_WHAT?__/

PAGE

/READ LINE INTO TEXT BUFFER(RLT)
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:TEXT BUFFER POINTER TXBPTR SET TO TXBUF-1
/	TEXT BUFFER LIMIT TXBLIM SET TO LWA
/
RLT,	0
RLT5,	CLA
	TAD	KM125
	DCA	TEMP1 /SET CONTROL BLOCK WORD 1 TO -85(DECIMAL)
	TAD	RLTATB
	DCA	TEMP2 /SET CB WORD 2 TO TEXT BUFFER FWA-1
RLT10,	TAD	RLTCB
	KSR		/READ A LINE OF TEXT
	TAD	TEMP1
	SZA CLA		/TEST FOR BUFFER FILLED
	JMP	RLT10A
	SEND;	RLTL	/LINE TOO LONG
	CLA STL RTR
	SBC			/CLEAR JUNK OUT OF INPUT BUFFER
	JMP	RLT28	/RESTART LINE

RLT30,	CLA CMA		/FORCE THE ILLEGAL CHAR BRANCH
RLT10A,	TAD I	TEMP2 /TERMINATOR TO A-REG
	JMS	RLCHAR		/SCAN CHAR AGAINST LIST
	JMP	RLT15		/BLANK TAPE
	JMP	RLT15		/LINE FEED
	JMP	RLT35		/CARRIAGE RETURN
	JMP	RLT30		/FORM FEED
	JMP	RLT30		/BELL
	JMP	RLT28		/ALTMODE
	JMP	RLT27		/RUBOUT
	JMP	RLT15		/ILLEGAL CHAR
	JMP	RLT10X		/LEGAL CHAR

RLT15,	ISZ	TEMP1		/GO THRU DELETE CHAR FUNC
	ISZ	TEMP2
RLT27,	TAD	TEMP1
	TAD	KM2	/DECREMENT CHARACTER COUNT
	DCA	TEMP1
	TAD	TEMP2
	TAD	KM2	/DECREMENT ADDRESS
	DCA	TEMP2
	TAD	TEMP1
	TAD	K125
RLT10X,	SMA CLA		/HAS BACKSPACE PASSED START OF LINE ?
	JMP	RLT10	/NO, CONTINUE
RLT28,	CRLF		/OUTPUT CR,LF
	JMP	RLT5	/AND RESTART LINE


RLT35,	STA		/NORMAL EXIT; BACK OVER CR
	TAD TEMP2
	DCA	TXBLIM	/LWA-1 TO TXBLIM
	TAD	RLTATB
	DCA	TXBPTR	/INITIALIZE TEXT BUFFER POINTER TXBPTR
	JMP I	RLT	/EXIT
/
K125,	125
KM125,	-125
RLTCB,	TEMP1		 /TEXT INPUT CONTROL BLOCK

/THIS SUBROUTINE CHECKS THE CHARACTER IN THE AC
/AGAINST VARIOUS POSSIBILITIES AND RETURNS AS FOLLOWS:
/	+1		BLANK TAPE (CHAR = 0)
/	+2		LINE FEED (CHAR = 12)
/	+3		CARRIAGE RETURN (CHAR = 15)
/	+4		FORM FEED (CHAR = 14)
/	+5		BELL (CHAR = 7)
/	+6		ALTMODE (CHAR = 33, 175 OR 176)
/	+7		RUBOUT (CHAR = 177 OR 137)
/	+8		ILLEGAL CHARACTER
/	+9		LEGAL CHAR (AC = CHAR, 240-336)

RLCHAR,	0
	AND	K177		/MASK OFF PARITY
	JMS	RLEXIT		/BLANK TAPE EXIT
	TAD	KM12
	JMS	RLEXIT		/LINE FEED EXIT
	TAD KM3
	JMS	RLEXIT		/CARRIAGE RETURN EXIT
	IAC
	JMS	RLEXIT		/FORM FEED EXIT
	TAD	K5
	JMS	RLEXIT		/BELL EXIT
	TAD	KM24
	SZA			/ESC = 33
	TAD	KM143
	SZA			/ALTMODE1= 176
	IAC
	SNA			/ALTMODE2= 175
	JMP	RLALT		/TAKE CARE OF ALTMODE
	ISZ	RLCHAR
	TAD	KM2
	SNA
	JMP	RLRB		/HANDLE RUBOUT
	TAD	K40
	JMS	RLEXIT		/_ (RUBOUT) EXIT
	CLL
	TAD	K77
	SNL			/SKIP IF ASCII 240 THRU 336
	JMP	RLILL		/ILLEGAL CHAR
	TAD	K240		/CONVERT TO CHAR VALUE
RLXRB,	ISZ	RLCHAR
	JMP I	RLCHAR

/TYPE "$ DELETED" FOR ALTMODE
RLALT,	JMS I	PSTSX		/SEND MESSAGE
	-13
	DALTM-1
	JMP I	RLCHAR		/ALTMODE EXIT

RLRB,	TAD	TAPE		/DONT ECHO _ IF IN TAPE MODE
	SZA CLA
	JMP	RLXRB		/TAKE ILLEGAL CHAR EXIT TO DELETE RUBOUT
	TAD	K137
	JMP	RLIL1		/TYPE _



RLILL,	CLA			/ECHO BELLS FOR ILLEGAL CHAR
	TAD	K7
	TLS
RLIL1,	TLS
	SKP CLA			/EXIT FROM RLEXIT

/EXIT TEST--EXIT IF AC=0
RLEXIT,	0
	SNA
	JMP I	RLCHAR		/LEAVE RLCHAR
	ISZ	RLCHAR		/ADVANCE EXIT ADDRESS
	JMP I	RLEXIT
/REWIND(RWD)
/
/FUNCTION: TO SET ALL FILE CONTROL TO INITIAL STATE
/
/ENTRY: NO SPECIAL CONDITIONS
/
/EXIT: ALL FILE DCB'S INITIALIZED
/     BUFFER POINTERS BF1PTR AND BF2PTR INITIALIZED
/     LAST SET TO -1
/     WDCNT SET TO -SEGMNT
/
RWD,	0
	CLA
	TAD	RWDCBA
	DCA	X1	/INITIALIZE DCB POINTER X1
	STA CLL RTL
	DCA	TEMP1	/INITIALIZE LOOP COUNTER
RWD5,	DCA I	X1	/CLEAR DCB WORD 1
	DCA I	X1	/CLEAR DCB WORD 2
	DCA I	X1	/CLEAR DCB WORD 3
	ISZ	X1	/INCREMENT DCB POINTER X1
	ISZ	X1	/INCREMENT DCB POINTER X1
	ISZ	TEMP1	/INCREMENT LOOP COUNTER
	JMP	RWD5
	STA		/GET -(WDS/SEG + 1)
	TAD SEGMNT
	DCA	WDCNT	/STORE IN WDCNT
	TAD	RWDP1
	DCA	BF1PTR	/INITIALIZE BUFFER 1 POINTER
	TAD	RWDP2
	DCA	BF2PTR	/INITIALIZE BUFFER 2 POINTER
	STA
	DCA	LAST	/SET LAST TO -1
	JMP I	RWD	/EXIT
/
RWDCBA, FL0DCB-1	/DCB BLOCK FWA-1
RWDP1,	FBUF1-1 	/FWA-1 OF FILE BUFFER 1
RWDP2,	FBUF2-1 	/FWA-1 OF FILE BUFFER 2


	PAGE

/COMPILE DIRECTIVE
/USE SAVE TO OPEN THE FILE FOR US,
/THEN CALL COMPILER!
COM,	DCA	RSSWT		/USE SAVE..CAN'T REPLACE
	CLA CMA		/TURN ON COMPILE FLAG
	JMP	SAV1

/SAVE DIRECTIVE(SAV)  REPLACE DIRECTIVE (REP)
/
/FUNCTION:TO PROCESS THE EDITOR DIRECTIVE 'SAVE(F)'
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:NO SPECIAL CONDITIONS
/
REP,	CLA CMA
SAV,	DCA	RSSWT	/SET SAVE REPALCE SWITCH
SAV1,	DCA	KCMP		/STORE COMPILE FLAG
	WRTEOF		 /WRITE TO EOF
	TAD   K2
	LOADCB		 /LOAD FILE 2 TRANSFER VECTOR
	CLA CMA		/RESET PROTECTION WORD
	DCA	PROTX
	TAD   KM3
	MOVE		 /MOVE CURRENT FILE NAME FROM
	FINAME-1		 /FINAME TO
SAVAN2, FL2NM-1		 /FILE 2 NAME BLOCK
	DCA   FITYPE	 /YES, SET TO OLD
/
/INPUT SAVE FILE NAME
/
SAV5,	INPCH		 /INPUT CHARACTER
	JMP   SAV30	 /EOM
	JMP   SAV5	 /BLANK - CONTINUE SLEW
	JMP   ERR11	 /COMMA - ERROR
	JMP   SAV5A	 /SPECIAL CHAR - MAY BE "<"

	NOP		/ALPHABETIC
			/FALL INTO SAV15 (NUMERIC)
/
/
/
/SAVE DIRECTIVE HAS A FILE NAME
/
SAV15,	CLA
	TAD   SAVAN2
	INPFNM		 /INPUT FILE NAME TO FILE 2 NAME BLOCK
	JMP	SAV5A-1	/CHECK FOR "<"

SAV30,	TAD ICHCH	/ONLY VALID TERMINATOR IS EOL
	SZA CLA
	JMP ERR11
	OPEN2
	JMP SAV20	/OPEN FAILED
	ISZ	RSSWT	/ARE WE DOING A REPLACE?
	JMP	SAV25	/SAVE WILL NOT DESTROY FILE
/REDUCE FILE 2 TO ONE SEGMENT!
	TAD	K2
	DCA	FINFBL
	JMS	SCRED		/SUBROUTINE SHORTENS FILE!
	TAD	PROTX		/CHECK FOR EXTENSION SPECIFIED
	SMA CLA
	JMP	SAV30A		/PROTECION ALREADY SET UP
	TAD	FINFBL+5
	AND	K37		/GET EXISTING EXTENSION
	DCA	PROTX
SAV30A,	ISZ	KCMP		/TEST FOR COMPILE
	JMP	SAV30B
	TAD	PROTX
	TAD	K1300		/SET FOR .BAC EXTENSION
	DCA	COMP
	CLA STL RTL
	JMP I	SYSPRG		/CALL COMPILER

SAV30B,	CLA IAC
	DCA I P0VEC+3	 /LOAD TOTAL SEGMENT COUNT INTO FILE 2 DCB
	TAD   SAVCPY
	COPYFL		 /COPY FILE 0 TO FILE 2
	TAD	PROTX
	TAD	K1100		/ADD IN .BAS EXTENSION
	PROT
	EDSTRT		 /RETURN TO EDITOR
/

/TEST FOR SPECIFIED EXTENSION
	TAD	ICHCH		/GET LAST CHARACTER
SAV5A,	TAD	(-"<		/TEST FOR "<"
	SZA CLA
	JMP	ERR11		/INVALID FILE NAME

SAV5B,	TAD I	TXBPTR		/GET NEXT CHAR
	AND	K177
	TAD	(-76
	SNA
	JMP	SAV5C		/FOUND MATCHING >, ALL DONE
	TAD	K6
	CLL
	TAD	BIT8		/TEST FOR OCTAL DIGIT
	SNL
	JMP	ERR11		/NO--INVALID FILE NAME
	DCA	TEMP1
	TAD	PROTX
	SPA		/FIRST TIME?
	CLA			/YES
	RTL CLL
	RAL
	TAD	TEMP1		/NOW BUILT EXTENSION
	TAD	KM37		/IS IT LEGAL
	SMA SZA
	JMP	ERR11		/EXTENSION IS OUTSIDE LEGAL RANGE
	TAD	K37
	DCA	PROTX		/SAVE PROTECTION
	JMP	SAV5B

SAV5C,	INPCH			/SCAN OFF REST OF LINE
	JMP	SAV30		/OK--NAME BUILT
	JMP	SAV5C		/IGNORE SPACES
	JMP	ERR11
	JMP	ERR11
	JMP	ERR11
	JMP	ERR11		/ALL ELSE IS WRONG

/DUPLICATE FILE NAME--CANNOT USE SAVE.
SAV25,	SEND;	DFNM		/DUPLICATE FILE NAME
	EDSTRT

/NO FILE WITH THIS NAME--CREATE ONE
SAV20,	CLA CMA
	DCA	RSSWT	/SET SAVE REPLACE SWITCH
	TAD	(FL2NM
	CRF		/CREATE FILE
	SNA CLA		/WAS CREATE OK?
	JMP	SAV30	/RETURN TO OPEN


/
/FILE NAME ERROR
/
ERR11,	SEND;	BFNM		/BAD FILE NAME
	EDITOR

/
SAVCPY, COPY


RSSWT,	0		/SET TO -1 FOR REPLACE

KCMP,	0			/COMPILE FLAG--SET TO -1 ON COMPILE COMMAND

/REDUCE FILES TO JUST ONE SEGMENT
SCRED,	0
	TAD	AFINF
	FINF			/DON'T NECESSARILY BELIEVE PAGE ZERO
	CLA CMA
	TAD	FINFBL+6
	SPA SNA
	JMP	SCRED1		/FILE IS ALREADY ONE SEGMENT LONG
	DCA	FINFBL+1
	TAD	AFINF
	RED
SCRED1,	CLA
	TAD	FINFBL			/NOW CHANGE VALUE IN DCB
	LOADCB
	CLA IAC
	DCA I	P0VEC+3		/FILE IS JUST ONE SEGMENT LONG
	JMP I	SCRED


PAGE
/THIS IS THE SECOND PAGE OF THE EDIT VERB.
/ENTRY TO THE FIRST PAGE IS AT "EDIT".
EDIT2,	DCA	EDST
	JMS	EDTYP		/OUTPUT LINE #
	TAD	TXBPTR		/SAVE POINTER TO JUST AFTER LINE NUMBER
	DCA	TXBLIM

EDALT,	TAD	TXBLIM		/RESET TO FRONT OF LINE
	DCA	TXBPTR

EDSCN,	TAD	K53
	JMS	TYTYP
	KRB			/GET SCAN CHAR
	AND	K177		/MASK OFF POSSIBLE PARITY
	DCA	PROTX		/SAVE SCAN CHARACTER
	TAD	K55
	JMS	TYTYP
EDSCN0,	TAD	TXBPTR		/SAVE POSITION OF POINTER
	DCA	EDST
	TAD	TEMP4		/LOAD AC IN CASE RH WORD
	ISZ	TEMP5		/SKIP IF LH CHAR NEXT
	JMP	EDSCN1		/NO--RH CHARACTER
	CLA CLL CMA RAL		/SET TO -2
	DCA	TEMP5
	GETWD
	PUTWD			/STASH CHAR IN OUTPUT BUFFER
	GETNXI			/GET IT FOR REAL THIS TIME
	SNA			/TEST FOR EOL
	JMP	EDEND		/YES--ALL DONE
	DCA	TEMP4		/SAVE WORD
	TAD	TEMP4
	RTR;  RTR;  RTR		/GET LH CHARACTER
EDSCN1,	AND	K77
	TAD	KM37
	SPA SNA
	TAD	K100
	TAD	K37		/CONVERT TO REGULAR ASCII
	CIA
	TAD	PROTX		/COMPARE WITH STORED CHARACTER
	SNA
	JMP	EDFND		/HOORAY..I FOUND SOMETHING
	CIA
	TAD	PROTX		/RESTORE CHARACTER
	JMS	EDPUT		/STASH CHAR IN BUFFER
	JMP	EDSCN0+2	/CONTINUE LOOP

/COMES HERE WHEN A CHARACTER IS FOUND
EDFND,	TAD	PROTX		/GET LAST CHARACTER
	JMS	EDPUT		/STASH CHAR IN BUFFER
	JMS	EDTYP		/TYPE LINE UP TO HERE

EDFND1,	KRB			/GET CHARACTER TO INSERT
	JMS I (RLCHAR)	/SCAN CHAR
	JMP	EDFND1		/BLANK TAPE
	JMP	EDLF		/LF-PASS OFF
	JMP	EDCR		/CR-END LINE
	JMP	EDSCN0		/FORM FEED GO ON
	JMP	EDSCN		/BELL START OVER
	JMP	EDALT		/ALTMODE--DELETE LINE TO RIGHT
	JMP	EDFR		/RUBOUT LAST CHAR
	JMP	EDFND1		/ILLEGAL CHAR, TRY AGAIN
	JMS	EDPUT		/STASH CHAR IN BUFFER
	JMP	EDFND1		/AND CONTINUE


EDFR,	TAD	TXBPTR
	CIA
	TAD	TXBLIM		/TEST FOR GONE TOO FAR
	SPA CLA
	CLA CMA			/GO AHEAD WITH RESET
	TAD	TXBPTR
	DCA	TXBPTR
	JMP	EDFND1		/RUBOUT DONE

/PASS OFF REST OF LINE
EDCR,	JMS	EDSOFF		/PASS OFF REST OF LINE
	JMP	EDEND+1

EDLF,	DCA	PROTX		/CLEAR SEARCH CHARACTER
	TAD	(TXBUF+124	/AVOID TYPING REST OF LINE
	JMP	EDSCN0+1


/ALL DONE--FINISH OUT TXBUFF AND RETURN
/TO EDITOR TO LET LINE SCAN DO THE REST OF THE WORK.
EDEND,	JMS	EDTYP		/TYPE OUT REMAINDER OF LINE
	TAD	TXBPTR
	DCA	TXBLIM
	TAD	RLTATB
	DCA	TXBPTR		/RESET POINTER
	TAD	K617		/RESTORE NORMAL BREAK
	KSB
	TAD	LOW
	DCA	LAST		/PUSH LAST TO NEXT VALUE
	CLA CMA			/SET "BACK TO READY" SWITCH
	JMP I (EDT25X)	/EXIT BACK TO EDITOR

/THIS SUBROUTINE TYPES OUT CHARACTERS SCANNED OVER
EDTYP,	0
	TAD	TXBPTR
	CIA
	TAD	EDST
	SMA
	JMP	EDTX		/NOTHING TO TYPE OUT
	DCA	EDST-1		/# OF CHARACTERS TO TYPE
	JMS I	PSTSX
	0			/COUNT
EDST,	0			/POINTER
EDTX,	CLA
	JMP I	EDTYP		/EXIT

/SAVE CHARACTER AND DECTECT BUFFER FULL
EDPUT,	0
	DCA I	TXBPTR		/STASH CHAR
	TAD	TXBPTR
	TAD	(-TXBUF-124
	SPA CLA			/IS THE BUFFER FULL?
	JMP I	EDPUT		/ALL IS WELL
	JMS	EDSOFF		/RESET DISK FILE POINTERS
	SEND;	RLTL		/TYPE LINE TOO LONG
	TAD	K617		/RESET TO NORMAL BREAK
	KSB
	EDITOR			/EXIT BACK TO EDITOR


EDSOFF,	0			/SUBROUTINE PASSES OFF REMAINDER OF LINE
	GETWD
	PUTWD
	GETNXI
	SZA CLA
	JMP	EDSOFF+1
	JMP I	EDSOFF


/CONVERT DIGIT TO ASCII AND TYPE
TYTYP,	0
	TAD	K260
	TLS
	CLA
	JMP I	TYTYP

PAGE

/CATALOG(CAT)
/
/FUNCTION:TO CATALOG A USER FILE
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:NO SPECIAL CONDITIONS
/
CAT,	WRTEOF		 /WRITE TO EOF
	SEND;	CATHDR		/NAME   SIZE
	TAD   CATAFN
	WHO		 /GET USER ID IN FILE 2 NAME BLOCK
	IAC
	DCA I CATV1	/SET CONTROL BLOCK 2 USER NO TO 1
	OPEN2		/OPEN USER UFD AS FILE 2
	CHKFOP		 /CHECK OP
	DCA I CATV1	/RESET FILE 2 USER NUMBER
	TAD KM3400	/SET UP RFILE CONTROL BLOCK
	DCA CATWC	/UFD IS AT MOST 7 SEGMENTS LONG
	TAD CATBF	/POINT TO BUFFER 1
	DCA CATCA
	TAD CATCB	/READ THE UFD
	RFILE
	TAD CATERR	/IGNORE EOF ERROR
	CLL RTR
	SZA CLA
	TAD CATERR	/RESTORE ERROR WORD
	CHKFOP
	TAD I CATBAS	/GET BASE WORD OF UFD ENTRY CHAIN
	DCA CATTMP
	TAD KM200	/AT MOST 128 UFD ENTRIES
	DCA CATCNT
CAT10,	CRLF		/SEND A CR,LF
	ISZ CATCNT	/PROTECT US FROM BAD DIRECTORIES
	JMP CAT20
	EDSTRT
CAT20,	TAD CATTMP	/GET POINTER TO NEXT ENTRY
	SNA		/END OF LIST?
	EDSTRT		/YES, ALL DONE
	TAD CATBUF	/NO, RELOCATE POINTER
	DCA CATPTR
	TAD CATPTR	/GET PTR TO WORD AFTER FILE NAME (LINK TO NEXT ENTRY)
	TAD K3
	DCA CATPT2
	TAD I CATPT2	/SAVE THAT WORD
	DCA CATTMP
	TAD K4040	/STORE END INDICATOR FOR PRINT ROUTINE
	DCA I CATPT2
	TAD K40
	DCA SIXBIT	/INDICATE TSS8 SIXBIT CODE TO BE PRINTED
	SEND		/PRINT FILE NAME
CATPTR,	0
	DCA SIXBIT	/CLEAR SIXBIT INDICATOR
	TAD CATTMP	/RESTORE WORD AFTER FILE NAME INCASE OF BAD DIRECTORY
	DCA I CATPT2
	ISZ CATPT2	/POINT AT WORD CONTAINING EXTENSION AND PROTECTION
	TAD I CATPT2	/SAVE THAT WORD
	DCA PRTS
	TAD PRTS	/GET EXTENSION BITS AND USE THEM TO INDEX
	AND K7600	/  INTO TABLE OF EXTENSIONS
	CLL RTR
	RTR
	RTR
	DCA TEMP1
	TAD TEMP1	/MAKE ALL UNDEFINED EXTENSIONS PRINT AS NULL
	TAD KM24
	SMA CLA
	DCA TEMP1
	TAD TEMP1
	TAD KEXTS
	DCA CATEXT
	TAD TEMP1	/WAS EXTENSION NULL?
	SZA CLA
	TAD KDOT	/NO, PRINT PERIOD
	TAD KBLK	/YES, PRINT BLANK
	JMS I (TYTYP)
	SEND		/PRINT EXTENSION
CATEXT,	0
	ISZ CATPT2	/POINT AT LENGTH WORD
	TAD I CATPT2	/GET LENGTH
	JMS I (CBA)	/CONVERT TO ASCII
	JMS I	PSTSX		/TYPE FILE SIZE
	-4
	TXBUF-1
	TAD	K240
	TLS
	TLS			/2 SPACES
	TAD	PRTS		/GET FILE PROTECTION
	RTR; RAR
	AND	K3		/FIRST DIGIT
	SNA
	TAD	KM20		/PRINT ZERO SUPPRESSED
	JMS I (TYTYP)
	TAD	PRTS
	AND	K7		/GET DIGIT 2
	JMS I (TYTYP)
	JMP CAT10

PRTS=X4		/SAVED PROTECTION WORD
KEXTS,	EXTENS
K4040,	4040
KM200,	-200
K7600=KM200
KM3400,	-3400
CATBUF,	FBUF1
CATBF,	FBUF1-1
CATBAS,	FBUF1+3
CATPT2,	0
CATCNT,	0
KBLK=KM20
KDOT,	".-" 
CATCB,	.+1
	0	/HIGH-ORDER FILE ADDRESS
	2	/INTERNAL FILE NO
CATWC,	-3400	/WORD COUNT
CATCA,	FBUF1-1	/CURRENT ADDRESS
	0	/LOW-ORDER FILE ADDRESS
CATERR,	0	/ERROR WORD
CATTMP=CATERR
CATAFN, FL2NM		/ADDRESS OF FILE 2 NAME BLOCK
CATV1,	FL2CB+1 	/ADDRESS OF FILE 2 USER NUMBER
/EXIT ROUTINE(BYE)
/
/FUNCTION: TO DELETE TEMP FILES 0 AND 1 AND EXIT TO TS-8
/
/ENTRY: NO SPECIAL CONDITIONS
/
/EXIT: TO TS-8 MONITOR
/
BYE,	DCA	LRST
	DCA   FINFBL	 /SET FINF BLOCK FILE NO TO ZERO
	CRLF		/OUTPUT A CR,LF
	JMS I PBYES	/DELETE FILE 0
	JMS I PBYES	/DELETE FILE 1
	TAD K7400
	CLOS
	HLT		 /NO;EXIT TO TS-8
	JMP .-1

PBYES,	BYES
PAGE
/INPUT BINARY NUMBER(IBN)
/
/FUNCTION:TO INPUT AN ASCII DECIMAL STRING AND
/	CONVERT IT TO ITS BINARY EQUIVALENT
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:BINARY EQUIVALENT IN A-REG
/
/ERROR EXIT: IF INPUT NUMBER NOT IN RANGE 1-2046
/
IBN,	0
	CLA
	TAD	ICHCH	/PICK UP FIRST DIGIT
	AND	K17	/CONVERT TO BINARY
IBN5,	DCA	IBNBI	/INITIALIZE COUNTER IBNBI
	INPCH		/INPUT CHARACTER
	JMP	IBN10	/EOM
	JMP	IBN10	/BLANK
	JMP	IBN10	/COMMA
	JMP	IBN10	/SPECIAL CHARACTER
	JMP	IBN10	/ALPHABETIC
	AND	K17
	DCA	TEMP1	/SAVE IN TEMP1
	TAD	IBNBI
	TAD	KM315
	SMA CLA		/CAN IBNBI BE MULTIPLIED BY 10?
	JMP	IBN30	/ERROR-OVERFLOW
	TAD	IBNBI
	RTL CLL
	TAD	IBNBI
	RAL		/10*IBNBI TO A-REG
	TAD	TEMP1	/ADD IN NEW DIGIT
	JMP	IBN5	/RETURN FOR NEXT DIGIT
IBN10,	CLA IAC		/END OF SCAN
	TAD	IBNBI	/BINARY EQUIVALENT TO A-REG
	SPA CLA		 /WAS IN PUT NUMBER 3777
	JMP   IBN30	 /YES,ERROR
	TAD	IBNBI		/GET LINE NUMBER
	SZA		/ZERO IS ALSO AN ILLEGAL NUMBER
	JMP I	IBN	/NORMAL EXIT
IBN30,	SEND;	LNEM	/ILLEGAL LINE NUMBER
	EDITOR		/EXIT TO EDITOR
/
IBNBI,	0		/BINARY COUNTER
KM315,	-315

/SCAN LIST AND DELETE(SLD)
/
/FUNCTION:TO SCAN THE PARAMETER LIST FOLLOWING THE LIST AND
/	DELETE DIRECTIVES
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:LOW SET TO LOWER PARAMETER(-1 DEFAULT)
/	HIGH SET TO HIGHER PARAMETER(-1 DEFAULT)
/
SLD,	0
	STA
	DCA	LOW	/SET LOW TO -1
	STA
	DCA	HIGH	/SET HIGH TO -1
	TAD	ICHCH
	SNA		/IS TERMINATOR EOM?
	JMP I SLD	/YES
SLD5,	INPCH		/NO.INPUT CHARACTER
	JMP I SLD	/EOM
	JMP	SLD5	/BLANK
	JMP	SLD10	/COMMA
	ERR12		/ERROR-SPECIAL CHAR
	ERR12		/ERROR-ALPHABETIC
	INPBIN		/NUMERIC.INPUT BINARY NUMBER
	DCA	LOW	/STORE IN LOW
	TAD	LOW
	DCA	HIGH	/STORE IN HIGH
	TAD	ICHCH
	SNA		/IS TERMINATOR EOM?
	JMP I SLD	/YES
	SMA		/NO.IS IT BLANK OR COMMA?
	ERR12		/ERROR-ILLEGAL TERMINATOR
SLD10,	INPCH		/INPUT CHARACTER
	JMP I SLD	/EOM
	JMP	SLD10	/BLANK
	ERR12		/ERROR-COMMA
	ERR12		/ERROR-SPECIAL CHAR
	ERR12		/ERROR-ALPHABETIC
	INPBIN		/NUMERIC.INPUT BINARY NUMBER
	DCA	TEMP1	/SAVE IN TEMP1
	TAD	LOW
	CIA
	TAD	TEMP1
	SPA CLA 	/IS PARAMETER 2 .LT. LOW?
	JMP	SLD20	/YES
	TAD	TEMP1	/NO
	DCA	HIGH	/STORE PARAMETER 2 IN HIGH
	JMP I SLD
SLD20,	TAD	TEMP1
	DCA	LOW	/STORE PARAMETER 2 IN LOW
	JMP I	SLD	/EXIT
/UNSAVE(UNS)
/
/FUNCTION:TO PROCESS THE EDITOR DIRECTIVE 'UNSAVE'
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:NO SPECIAL CONDITIONS
/
UNS=.
/
/INPUT UNSAVE FILE NAME TO FILE 2 NAME BLOCK
/
UNS5,	INPCH		/INPUT CHARACTER
	JMP I (ERR11)	/EOM-ERROR AT THIS POINT
	JMP	UNS5	/BLANK
	JMP I (ERR11)	/COMMA-ERROR
	JMP I (ERR11)	/SPEC CHAR-ERROR
	NOP		/ALPHABETIC
	STA		/NUMERIC
	TAD	UNSAFN
	INPFNM		/INPUT FILE NAME TO FILE 2 NAME BLOCK
	JMP I (ERR11)	/NO
/
/OPEN FILE AS NO 2 AND REDUCE SIZE TO ZERO
	OPEN2
	JMP UNS7	/OPEN FAILED; CLEAR AC AND GIVE MSG
	CLL CLA CML RTL		/GET #2
	DCA	FINFBL	/SET FINF BLOCK FILE NO TO 2
	JMS	BYES		/USE SUBROUTINE TO DELETE FILE
UNS7,	SZA CLA
	JMP	UNS31	/CANT DELETE FILE
	STA		/INDICATE FILE 2 CLOSED
	DCA DEVSTS
	TAD	ICHCH
	SNA CLA
	EDITOR		/TERMINATOR WAS EOM
	JMP	UNS5		/GET NEXT FILE NAME

UNS31,	SEND;	UNSM	/CAN'T DELETE:
	JMS	TYNAM	/TYPE FILE NAME
	EDITOR			/RETURN TO EDITOR


/TYPE SIX CHARACTER FILE NAME
TYNAM,	0
	TAD K40		/SET OUTPUT RTN TO DO TSS8 SIXBIT
	DCA SIXBIT
	SEND		/PRINT FILE NAME
UNSAFN,	FL2NM		/ADDR OF FILE 2 NAME BLOCK
	DCA SIXBIT	/CLEAR SIXBIT FLAG
	JMP I	TYNAM
/
/NEW:  SET INITLD TO 3 AND RECALL EDITOR
/
NEW,	CLA IAC
/
/OLD:  SET INITLD TO 2 AND RECALL EDITOR
/
OLD,	TAD   K2
	DCA   INITLD	 /SET TO 2
	CRLF		/OUTPUT A CR,LF
	JMP I SYSPRG	/RECALL EDITOR

/
/BYES IS A BYE SERVICE SUBROUTINE
/
BYES,	0
	CLA CMA CLL RAR		/GET 3777
	DCA   FINFBL+1	 /STORE IN REDUCE CONTROL BLOCK
	TAD   AFINF
	RED		 /DELETE FILE
	ISZ   FINFBL	 /INCREMENT FILE NUMBER
	JMP I BYES	 /AND EXIT

PAGE

/
/SCRATCH DIRECTIVE
/CLEAR INPUT BUFFER--LOAD NULL FILE
/
SCR,	REWIND
	STA CLL RAR
	DCA I	WOFBFA
	DCA I (FBUF2+1)
	DCA	FINFBL		/REDUCE TEMP FILES TO ONE SEGMENT
	JMS I PSCRED
	ISZ	FINFBL
	JMS I PSCRED	/BOTH FILES ARE NOW ONE SEGMENT LONG
	CLA IAC		/CHANGE SEGMENT SIZE IN PAGE ZERO
	DCA	FISIZE
	CLA IAC
	DCA	SRSIZE
	IO12
	WRFILE
	JMP I	.+1
	EDT5

PSCRED,	SCRED

/WORD FROM INPUT FILE(WIF)
/
/FUNCTION:TO GET A WORD FROM THE INPUT FILE
/
/ENTRY:THERE ARE TWO ENTRIES:WIF AND WIF0
/	WIF INCREMENTS THE BUFFER POINTER SO NEXT CALL GETS NEXT WORD
/	WIF0 DOES NOT INCREMENT POINTER.NEXT CALL GETS SAME WORD
/
/EXIT:WORD IN A-REG
/
WIF0,	0		/NO-INCREMENT ENTRY
	CLA
	TAD	WIF0
	DCA	WIF	/LOAD EXIT ADDRESS
	STA		/-1 TO A-REG
	JMP	WIF5
WIF,	0		/INCREMENT ENTRY
	CLA		/CLEAR A-REG
WIF5,	DCA	WIFSW	/STORE A-REG IN SWITCH
	ISZ	BF1PTR	/INCREMENT BUFFER POINTER
	TAD	WIFBFA
	TAD	BFSIZE
	CIA
	TAD	BF1PTR
	SPA CLA		/IS POINTER PAST BUFFER LWA?
	JMP	WIF10	/NO
	IO11
	RDFILE
	TAD	WIFBFA
	DCA	BF1PTR	/INITIALIZE BUFFER POINTER BF1PTR
WIF10,	TAD I	BF1PTR	/GET WORD FROM INPUT FILE
	DCA	TEMP1	/SAVE IN TEMP1
	TAD	BF1PTR
	TAD	WIFSW
	DCA	BF1PTR	/ADD SWITCH TO POINTER
	TAD	TEMP1	/RESTORE A-REG
	JMP I	WIF	/EXIT
/
WIFBFA, FBUF1		/INPUT BUFFER FWA
WIFSW=TEMP3
/WORD TO OUTPUT FILE(WOF)
/
/FUNCTION:TO STORE A WORD IN THE OUTPUT FILE
/
/ENTRY:WORD IN A-REG
/
/EXIT:NO SPECIAL CONDITIONS
/
WOF,	0
	ISZ	BF2PTR	/INCREMENT BUFFER POINTER
	ISZ	WDCNT	/INCREMENT WORD COUNT
	JMP	WOF20	/END OF SEGMENT ?
	DCA	WOFT1	/YES, SAVE INPUT WORD
	TAD	SEGMNT
	DCA	WDCNT	/RELOAD WORD COUNT
	LOADCB		/LOAD FILE 0 DCB TRANSFER VECTOR
	TAD I	P0VEC+3 /GET FILE 0 TOTAL SEGMENT COUNT
	CIA		/TAKE NEGATIVE
	TAD I	P0VEC+4 /ADD FILE 0 ACTIVE SEGMENT COUNT
	SPA CLA 	/ANY SPACE LEFT IN FILE 0 ?
	JMP	WOF5	/YES
	TAD	WOFCB	/NO
	EXT		/EXTEND FILE 0 2 SEGMENTS
	SPA SNA
	JMP	.+3
	CLA
	TAD	K7400
	CHKFOP		/CHECK OP
	TAD	K2
	TAD I	P0VEC+3 /UPDATE FILE 0 TOTAL SEGMENT COUNT
	DCA I	P0VEC+3
	TAD I	P0VEC+3 /RESTORE A-REG
	DCA	FISIZE	/UPDATE FISIZE
WOF5,	ISZ I	P0VEC+4 /INCREMENT ACTIVE FILE COUNT
	TAD	WOFBFA
	TAD	BFSIZE	/GET BUFFER LWA+1
	CIA
	TAD	BF2PTR
	SPA CLA 	/IS POINTER PAST BUFFER LWA ?
	JMP	WOF15	/NO
	IO02
	WRFILE		/WRITE BUFFER TO OUTPUT FILE
	TAD	WOFBFA
	DCA	BF2PTR	/INITIALIZE BUFFER POINTER BF2PTR
WOF15,	TAD	WOFT1	/GET INPUT WORD
WOF20,	DCA I	BF2PTR	/STORE IN OUTPUT BUFFER
	JMP I	WOF	/EXIT
/
WOFBFA, FBUF2		/OUTPUT BUFFER FWA
WOFCB,	COPY		/ADDRESS OF EXTEND CONTROL BLOCK
WOFT1,	0		/TEMP STORE
/WRITE TO END OF FILE(WEF)
/
/FUNCTION: TO COPY THE REMAINDER OF FILE 1 ONTO FILE 0 WITH AN EOF
/
/ENTRY: NO SPECIAL CONDITIONS
/
/EXIT: NO SPECIAL CONDITIONS
/
WEF,	0
	CLA
	TAD	COMP
	SPA CLA
	JMP I	WEF		/THIS IS NULL FOR EXECUTE ONLY FILES
	STA CLL RAR
	JMS I	WEFCIO	/COPY FILE 1 TO EOF
	STA CLL RAR
	PUTWD
	PUTWD		/WRITE EOF IN BUFFER
	IO02
	WRFILE		/WRITE LAST BUFFER
	DCA	LRST		/CLEAR FLAG
	JMP I	WEF
/
WEFCIO, CIO		/COPY INPUT TO OUTPUT
/MOVE(MOV)
/
/FUNCTION:TO MOVE A BLOCK OF DATA IN CORE
/
/ENTRY:A-REG:NUMBER OF WORDS TO BE MOVED
/
/EXIT:NO SPECIAL CONDITIONS
/
/CALLING SEQ:JMS MOV
/		FROM ADDRESS
/		TO ADDRESS
/
MOV,	0
	DCA	TEMP1	/-COUNT TO TEMP1
	TAD I MOV	 /DECR 1 ;'FROM' ADDRESS
	DCA	X1	/STORE IN INDEX 1
	ISZ	MOV	/INCREMENT CALLING SEQ POINTER
	TAD I MOV	 /DECR 1; 'TO' ADDRESS
	DCA	X2	/STORE IN INDEX 2
	ISZ	MOV	/INCREMENT CALLING SEQ POINTER
MOV5,	TAD I	X1	/FETCH WORD
	DCA I	X2	/STORE WORD
	ISZ	TEMP1	/CHECK FINISH
	JMP	MOV5	/LOOP BACK
	JMP I	MOV	/EXIT
/OUTPUT CARRIAGE RETURN AND LINE FEED (OCR)
/
/FUNCTION:TO OUTPUT A CR,LF
/
/ENTRY:NO SPECIAL CONDITIONS
/
/EXIT:NO SPECIAL CONDITIONS
/
OCR,	0
	JMS I PSTSX
	-2
	CRLFM-1
	JMP I OCR

PAGE
/LOAD FILE DCB(LDC)
/
/FUNCTION: TO LOAD A TRANSFER VECTOR INTO PAGE 0 TO ACCESS A FILE DCB
/
/ENTRY: INTERNAL FILE NO IN A-REG
/
/EXIT: TRANSFER VECTOR IN PAGE 0 STARTING AT P0VEC
/
LDC,	0
	DCA	LDCT1	/SAVE A-REG IN LDCT1
	TAD	LDCVA
	DCA	X1	/INITIALIZE VECTOR POINTER X1
	TAD	KM5
	DCA	LDCT2	/INITIALIZE LOOP COUNTER
	TAD	LDCT1
	CLL RTL		/CLEAR LINK
	TAD	LDCT1	/5*ENTRY TO A-REG
	TAD	LDCDA
	DCA	LDCT1	/INITIAL DCB ADDRESS TO LDCT1
LDC5,	TAD	LDCT1	/GET NEXT DCB ADDRESS
	DCA I	X1	/STORE IN TRANSFER VECTOR
	ISZ	LDCT1	/INCREMENT DCB ADDRESS
	ISZ	LDCT2	/INCREMENT LOOP COUNTER
	JMP	LDC5
	JMP I	LDC
/
LDCDA,	FL0DCB		/FWA OF DCB BLOCK
LDCT1=TEMP1
LDCT2=TEMP2
LDCVA,	P0VEC-1
/READ-WRITE FILE(RWF)
/
/FUNCTION: TO CONTROL FILE IO
/
/ENTRY: U(A) HOLDS FILE NUMBER
/	L(A) HOLDS BUFFER NO - 1
/
/EXIT: LINK SET ON EOF
/
RFL,	0		/READ ENTRY
	DCA	TEMP1	/SAVE A-REG IN TEMP1
	CLA IAC
	DCA	LRST		/SET FLAG
	STA CLL RAL	/LOAD READ OP
	JMP	RWF5
/
WFL,	0		/WRITE ENTRY
	DCA	TEMP1	/SAVE A-REG IN TEMP1
	TAD	WFL
	DCA	RFL	/LOAD EXIT ADDRESS
RWF5,	TAD	RWFWI	/LOAD WRITE OP
	DCA	RWF25	/STORE OP IN PROGRAM
	TAD	TEMP1
	AND	K7	/GET BUFFER NO - 1
	TAD	RWFLI	/ADD LOAD OP
	DCA	.+1	/STORE IN PROGRAM
	TAD	RWFBFA	/GET BUFFER FWA-1
	DCA	RWFCB+4 /STORE IN IOCB WORD 4
	TAD	TEMP1
	RTR
	RTR
	RTR
	AND	K7	/GET INTERNAL FILE NUMBER
	DCA	RWFCB+2 /STORE IN IOCB WORD 2
	TAD	RWFCB+2 /RESTORE A-REG
	LOADCB		/LOAD DCB TRANSFER VECTOR
	TAD I	P0VEC+1 /GET HIGH ORDER FILE ADDRESS
	DCA	RWFCB+1 /STORE IN IOCB WORD 1
	TAD I	P0VEC	/GET LOW ORDER FILE ADDRESS
	DCA	RWFCB+5 /STORE IN IOCB WORD 5
	TAD I	P0VEC+2 /GET CURRENT SEGMENT COUNT
	CIA		/TAKE NEGATIVE
	TAD I	P0VEC+4 /ADD ACTIVE SEGMENT COUNT
	SZA		/END OF FILE ?
	JMP	RWF10	/NO
	STL		/YES. SET LINK AND
	DCA	LRST		/CLEAR FLAG
	JMP I	RFL	/EXIT
/
RWF10,	CIA
	DCA	RWFT1	/-SEGMENTS RESIDUE TO RWFT1
	TAD	RWFT1	/RESTORE A-REG
	TAD	SEGSPB	/ADD NO OF SEGMENTS PER BUFFER
	SMA CLA 	/IS THERE MORE THAN 1 BUFFER LEFT IN FILE ?
	JMP	RWF15	/NO
	TAD	SEGSPB	/YES. GET NO SEGMENTS PER BUFFER
	CIA		/TAKE NEGATIVE
	DCA	RWFT1	/STORE IN RWFT1
RWF15,	TAD	RWFT1
	CIA		/GET IO SEGMENT COUNT
	TAD I	P0VEC+2 /INCREMENT DCB CURRENT SEGMENT COUNT
	DCA I	P0VEC+2
	TAD SEGMNT	/GET -(NO. OF WORDS PER SEGMENT)
	DCA	RWFT2	/STORE IN RWFT2
RWF20,	TAD	RWFT2	/LOOP TO GET IO WORD COUNT
	ISZ	RWFT1
	JMP	RWF20
	DCA	RWFCB+3 /STORE -WORD COUNT IN IOCB WORD 3
	TAD	RWFCB+3 /RESTORE A-REG
	CIA		/GET IO WORD COUNT
	CLL		/CLEAR LINK
	TAD I	P0VEC	/INCREMENT DCB LOW ORDER ADDRESS
	DCA I	P0VEC
	SZL		/OVERFLOW ?
	ISZ I	P0VEC+1 /YES.INCREMENT HIGH ORDER ADDRESS
	TAD	RWFCB
RWF25,	RFILE		/INPUT-OUTPUT OPERATION
	STA CLL RTL	/GET ALL BUT BIT 10 OF ERROR WORD
	AND RWFCB+6
	CHKFOP		/CHECK FILE OP
	CLL		/CLEAR LINK
	JMP I	RFL	/AND EXIT
/
RWFBFA, FBUF1-1 	/FILE BUFFER 1 FWA-1
	FBUF2-1 	/FILE BUFFER 2 FWA-1
RWFCB,	.+1		/IO CONTROL BLOCK
	0		/HIGH ORDER FILE ADDRESS
	0		/INTERNAL FILE NUMBER
	0		/-WORD COUNT
	0		/CORE BUFFER FWA-1
	0		/LOW ORDER FILE ADDRESS
	0		/ERROR WORD
RWFLI,	TAD	RWFBFA	/LOAD BUFFER ADDRESS INSTRUCTION
RWFT1=TEMP1
RWFT2=TEMP2
RWFWI,	WFILE		/WRITE FILE IOT

/HIGH CORE DATA BLOCKS
/
FL2CB,	2		/FILE 2 CONTROL BLOCK
	0
FL2NM,	0		/FILE 2 NAME BLOCK
	0
	0
	4040		/EOL INDICATOR FOR TYNAM ROUTINE
/
/FILE COPY BLOCK
/
	2
COPY,	0
	2
	1
	0
	1
/
/INTERNAL FILE DEVICE CONTROL BLOCKS(DCB'S)
/
FL0DCB, 0		/FILE 0: CURRENT LOW ORDER FILE ADDRESS
	0		/FILE 0: CURRENT HIGH ORDER FILE ADDRESS
	0		/FILE 0: CURRENT SEGMENT COUNT
	0		/FILE 0: TOTAL SEGMENT COUNT
	0		/FILE 0: ACTIVE SEGMENT COUNT
/
FL1DCB, 0		/FILE 1: CURRENT LOW ORDER FILE ADDRESS
	0		/FILE 1: CURRENT HIGH ORDER FILE ADDRESS
	0		/FILE 1: CURRENT SEGMENT COUNT
	0		/FILE 1: TOTAL SEGMENT COUNT
	0		/FILE 1: ACTIVE SEGMENT COUNT
/
FL2DCB, 0		/FILE 2: CURRENT LOW ORDER FILE ADDRESS
	0		/FILE 2: CURRENT HIGH ORDER FILE ADDRESS
	0		/FILE 2: CURRENT SEGMENT COUNT
	0		/FILE 2: TOTAL SEGMENT COUNT
	0		/FILE 2: ACTIVE SEGMENT COUNT
/
/EDITOR DIRECTIVE TABLES
/
EDTTB1=.
	-"B;  -"Y;  -"E;  BYE		/BYE DIRECTIVE
	-"C;  -"A;  -"T;  CAT		/CATALOG DIRECTIVE
	-"N;  -"E;  -"W;  NEW		/NEW PROGRAM DIRECTIVE
	-"O;  -"L;  -"D;  OLD		/OLD PROGRAM DIRECTIVE
	-"R;  -"U;  -"N;  RUN		/RUN DIRECTIVE
	-"U;  -"N;  -"S;  UNS		/UNSAVE FILE DIRECTIVE


EXFOK,	-"D;  -"E;  -"L;  DEL		/DELETE DIRECTIVE
	-"L;  -"I;  -"S;  LSTX		/LIST DIRECTIVE
	-"L;  -"L;  -"I;  LLST		/LLIST DIRECTIVE
	-"S;  -"A;  -"V;  SAV		/SAVE FILE DIRECTIVE
	-"T;  -"A;  -"P;  TAPIT		/TAPE MODE ENTRY
	-"K;  -"E;  -"Y;  KEYIT		/KEY MODE ENTRY
	-"R;  -"E;  -"P;  REP		/REPLACE FILE DIRECTIVE
	-"S;  -"C;  -"R;  SCR		/SCRATCH FILE DIRECTIVE
	-"C;  -"O;  -"M;  COM		/COMPILE DIRECTIVE
	-"E;  -"D;  -"I;  EDIT		/CHARACTER EDIT FUNCTION
	0		/ZERO MARKS END OF DIRECTIVE TABLE
/
/
DALTM,	"$; " ;  "D;"E;"L;"E;"T;"E;"D
	215		/TEXT BUFFER CR
	212		/TEXT BUFFER LF
TXBUF=.
 *.+124 		/TEXT BUFFER
	0	/OVERFLOW WORD FOR TEXT BUFFER


FBUF1=3777		/FILE BUFFER 1
FBUF2=5777		/FILE BUFFER 2
/FBUF2 CANNOT EXTEND TO 7777 BECAUSE OF ISZ TROUBLES.
/
/CATALOG ROUTINE NEEDS ENOUGH BUFFER AT FBUF1 TO HOLD AT
/  LEAST 7 DISK SEGMENTS.  CATALOG DOES NOT USE FBUF2 SO THIS
/  REQUIREMENT MAY BE MET BY KEEPING FBUF1 AND FBUF2 NEXT TO EACH
/  OTHER.

/VARIOUS ERROR MESSAGES

BFNM,	TEXT /_BAD FILE NAME/

UNSM,	TEXT /_CAN'T DELETE: /

DFNM,	TEXT /_DUPLICATE FILE NAME/

LNEM,	TEXT /_ILLEGAL LINE NUMBER/


RLTL,	TEXT /_LINE TOO LONG/

EFM,	TEXT /_EXECUTE ONLY/

CATHDR,	TEXT /__NAME      SIZE PROT/
EDEM2,	TEXT /_CAN'T FIND LINE/

EXTENS,	TEXT /   /
	TEXT /ASC/
	TEXT /SAV/
	TEXT /BIN/
	TEXT /BAS/
	TEXT /BAC/
	TEXT /FCL/
	TEXT /TMP/
	TEXT /   /
	TEXT /DAT/

/THIS CANNOT EXTEND PAST FBUF1 ! ! ! ! ! !
IFNZRO FBUF1-.&4000 <YOU GOOFED>

/THE FOLLOWING IS ONE-TIME INITIALIZATION CODE
/WHICH IS LOCATED IN THE INPUT BUFFER.
*3777

DATSTR=.
	CPF		/COPY FILE
	EDT		/EDITOR RESTART
	EDT20A		/EDITOR RESTART ENTRY
	EDT60		/EDITOR ERROR ENTRY
	FINFBL		/FINF BLOCK
	IBN		/INPUT BINARY NUMBER
	ICH		/INPUT CHARACTER
	IFN		/INPUT FILE NAME
	LDC		/LOAD DCB CONTROL BLOCK
	MOV		/MOV
	PFL		/POSITION FILE
	RFL		/READ FILE
	RLT		/READ A LINE OF TEXT
	RWD		/REWIND
	WEF		/WRITE TO END OF FILE
	WFL		/WRITE FILE
	WIF0		/WORD FROM INPUT-NO INCREMENT
	WIF		/WORD FROM INPUT FILE
	WOF		/WORD TO OUTPUT FILE
	TEXTO		/MESSAGE OUTPUT ROUTINE
	STSX
	OP2
	OCR
	PRGNM
	1000
	200
	100
	10
	2
	7400
	COPY+3
	TXBUF-1
	3
	-3
	-4
	-5
	7
	-53
	12
	17
	32
	37
	-37
	-20
	77
	177
	1100
	1300
	-12
	5
	6
	-24
	40
	-143
	617
	55
	53
	137
	101
	201
	240
	-240
	-272
	260
	3737
	3776
	7700
	-3777
	4002
	INE
	-2
DATEND=.
FL0CB,	0		/FILE 0 CONTROL BLOCK
	0
FL0NM,	4241		/FILE 0 NAME BLOCK
	6320
	0
FL1CB,	1		/FILE 1 CONTROL BLOCK
	0
FL1NM,	4241		/FILE 1 NAME BLOCK
	6321
	0

INEW,	TEXT /_NEW /
IPNM,	TEXT /PROGRAM NAME--/

CFUM,	TEXT / FOR USER /
CFNM,	TEXT /_CAN'T FIND "/
CLBRM,	TEXT / IN SYSTEM LIBRARY/

XURM,	TEXT /_IMPROPER ACCOUNT #_/
	*4200
/INITIAL ENTRY(INE)
/
/FUNCTION:TO INITIALIZE THE BASIC SYSTEM
/
/ENTRY:FROM SYSTEM INTERPRETER
/
/EXIT:TO EDITOR
/
INE,	DUP
	TAD	AINE
	SRA			/RESET RESTART TO (PROGRAM START)
	CLA CLL CMA RAL
	TAD	INITLD		/FIRST TIME LOAD
	SMA CLA
	JMP	INE1		/NO
	ACT
	RAR CLL
	SZA			/TEST FOR ACCOUNT #1
	RAR
	SZA CLA		/TEST FOR ACCOUNT #2
	JMP	INE0
	SEND; XURM		/NOT GOOD TO RUN BASIC UNDER ACCOUNTS 1 OR 2
	JMP I	.+1
	SABORT			/ABORT RUN

INE0,	SEND;	INEMB1		/NEW OR OLD--
	STA		/CLEAR ALL DEVICE STATUS BITS
	DCA DEVSTS
	TAD BIT2	/CLOSE ANYTHING OPEN ON FILE 2
INE1,	TAD K6000	/CLOSE ANYTHING OPEN ON FILES 0 AND 1
	CLOS
	JMS I INEV8	 /CONSTRUCT TEMP FILE NAMES
	JMS I	(INES2		/COMPUTE VARIOUS CONSTANTS
	DCA	TAPE		/PUT CONSOLE IN NORMAL MODE
/
/CREATE, OPEN, AND INITIALIZE FILES 0 AND 1
/
	JMS I INEV1	 /CREATE AND OPEN FILE "BAS0'NN'" AS FILE 0
	IAC
	DCA	FISIZE	/SET FISIZE TO 1
	IAC
	JMS I INEV1	 /CREATE AND OPEN FILE "BAS1'NN'" AS FILE 1
	IAC
	DCA	SRSIZE	/SET SRSIZE TO 1
/
/INITIALIZE DEVICES, OUTPUT 'NEW OR OLD' , AND PROCESS RESPONSE
/
	TAD	INEKBM
	KSB		/SET KEYBOARD MASK
	CLA CLL CMA RAL
	TAD	INITLD
	SMA		 /NEW OR OLD ?
	JMP INE7	 /YES
	JMP	.+4
INE5,	CLA
	SEND;	INEMB1		/NEW OR OLD--
	RDTEXT		/READ A LINE OF TEXT
	TAD I	TXBPTR
	AND	K177
	TAD	KMAO
	CIA
INE7,	DCA FITYPE	 /STORE NEW-OLD FLAG
	TAD   FITYPE
	DCA	INITLD	 /SET INITLD TO FITYPE
	TAD	FITYPE
	SNA		/IS FILE TYPE 'OLD'?
	JMP	INE10	/YES
	TAD	KM1	/NO
	SNA CLA 	/IS FILE TYPE 'NEW'?
	JMP	INE10N	/YES
	SEND;	EDWHAT	/TYPE WHAT
	JMP	INE5	/RETURN TO RESTART

KM1,	-1
K6000,	6000
/
/OUTPUT 'NEW' OR 'OLD'	' PROGRAM NAME ' AND ACCEPT RESPONSE
/
INE10N,	SEND;	INEW
	JMP	.+3
INE10,	SEND;	IOLD
	SEND;	IPNM		/TYPE "PROGRAM NAME"
	RDTEXT		/READ A LINE OF TEXT
INE20,	INPCH		/INPUT CHARACTER
	JMP	INE25	/ERROR-EOM
	JMP	INE20	/BLANK
	JMP	INE25	/ERROR-COMMA
	JMP	INE25	/ERROR - SPECIAL CHAR
	NOP		/ALPHABETIC
	CLA		/NUMERIC
	TAD	INEFNM
	INPFNM		/INPUT FILE NAME TO FINAME
	CLA STL RAR	/RETURNS HERE IF BAD FILE NAME; SET FLAG
	CLL RAL		/LINK=1 IFF BAD FILE NAME
	TAD FITYPE	/IS THIS AN "OLD"
	SNA CLA
	JMP I (INE40)	/YES
	SNL		/NO, IS FILE NAME OK
	JMP INE75	/YES
/
/PROGRAM NAME IS IN ERROR - OUTPUT ERROR MESSAGE
/
INE25,	SEND;	BFNM		/BAD FILE NAME
	JMP	INE5	/AND RESTART
INE50S,	TAD X1		/IS THIS AN ERROR CALL
	TAD KEDT
	SZA CLA
	JMP I PERROR	/YES
/
/RESTART ENTRY
/
INE50,	CLA CMA
	DCA I	INEV7		/SET EXIT (ABORT) SWITCH
	DCA SIXBIT	/CLEAR SIXBIT FLAG FOR PRINT ROUTINE
	CLA CLL CMA RAL
	TAD	INITLD
	SMA CLA 	 //CALLED BY OLD OR NEW?
	JMP	INE	 /YES;RE-INITIALIZE
	JMS I INEV6	 /INITIALIZE EDITOR
	TAD	COMP
	SPA CLA		/DONT COPY IF EXECUTE ONLY FILE
	JMP INE75A
	TAD	COPY01
	COPYFL		/COPY FILE 0 TO FILE 1
/
/OUTPUT 'READY' AND EXIT TO EDITOR
/
INE75,	DCA	COMP	/RESET COMPILE FLAG
INE75A,	DCA I	INEV7	/CLEAR EXIT SWITCH
	TAD K3737	/CLEAR CHAIN PROG NAME AREA
	DCA I PPRGNM
	TAD	(CRC	/SET ^C RESTART ADDRESS
	SRA			/SET RESTART ADDRESS
	CLA STL RTR
	SBC			/CLEAR INPUT BUFFER
	JMP I	.+1
	EDT5

INEFNM=K17		/ADDRESS OF CURRENT FILE NAME - 1
IFNZRO FINAME-1-17 <YOU GOOFED>
INEKBM,	0617		/KEYBOARD BREAK MASK
KEDT,	-EDTX1
INEV1,	INES1		/TEMP FILE INITIALIZATION ROUTINE
INEV6,	INES4		/REINITIALIZE SYSTEM
INEV7,	XSW		/EXIT SWITCH
INEV8,	INES5		/CONSTRUCT TEMP FILE NAMES
KMAO,	-117
PERROR,	ERROR

	PAGE
/TEMP FILE INITIALIZATION ROUTINE(INES1)
/
/FUNCTION: CREATE AND OPEN FILES 'BAS0N' AND 'BAS1N'
/	   AS FILES 0 AND 1  (N = CONSOLE NUMBER)
/
/ENTRY: INTERNAL FILE NO IN A-REG
/
/EXIT: DCB INITIALIZED
/     IF FILE 1 A SEGMENT WITH EOF IS WRITTEN
/
INES1,	0
	DCA	FINFBL	/SET FILE NUMBER IN FINF BLOCK
	TAD	FINFBL	/RESTORE A-REG
	SZA CLA
	TAD	K5		/CHANGE TO FILE 1
	TAD	INES1N	/ADD BIAS
	DCA	TEMP1	/STORE FILE NAME POINTER IN TEMP1
	TAD	TEMP1
	CRF		/CREATE FILE
	CHKFOP		/CHECK OP
	CLA CLL CMA RAL
	TAD	TEMP1
	OPEN		/OPEN FILE
	CHKFOP		/CHECK OP
	TAD	FINFBL
	RTL CLL
	RTL
	RAL		/GET FILE # IN BITS 5-6
	TAD	PROTMP
	PROT		/SET PROTECTION
	CLA IAC
	DCA	FINFBL+6/SET SEGMENT COUNT TO 1
	JMS	INES3	/LOAD DCB PARAMETERS
	TAD	FINFBL
	SNA CLA 	/IS THIS FILE 1 ?
	JMP I	INES1	/NO, EXIT
	REWIND
	STA CLL RAR	/YES
	DCA I	INES1W
	DCA I	INES1X	/WRITE EOF IN BUFFER 2
	IO12
	WRFILE		/WRITE A SEGMENT ON FILE 1
	JMP I	INES1
/
INES1N,	FL0NM
INES1W,	FBUF2
INES1X, FBUF2+1


PROTMP,	1617		/PROTECTION BITS FOR TEMP FILES

/COMPUTE BUFFER CONSTANTS (INES2)
/
/FUNCTION: SETS SEGSPB TO 4
/	   SETS BFSIZE TO 2000 (8)

INES2,	0
	CLA
	TAD	INESX4
	DCA	SEGSPB
	TAD	INESXZ
	DCA	BFSIZE
	JMP I	INES2

INESX4,	4			/THERE ARE FOUR 400(8) WORD SEGMENTS PER BUFFER
INESXZ,	FBUF2-FBUF1		/BUFFER MUST BE 2000(8) WORDS LONG
/LOAD DCB PARAMETERS(INES3)
/
/FUNCTION: TO LOAD FILE PARAMETERS INTO A DCB
/
/ENTRY: FILE NUMBER IN FINFBL
/      FILE SEGMENT COUNT IN FINFBL+6
/
/EXIT: DCB TOTAL AND ACTIVE SEGMENT COUNT SET TO FINFBL+6
/
INES3,	0
	TAD	FINFBL
	LOADCB		/LOAD DCB TRANSFER VECTOR
	TAD	FINFBL+6/GET SEGMENT COUNT
	DCA I	P0VEC+3 /STORE IN TOTAL SEGMENT COUNT
	TAD	FINFBL+6/RESTORE A-REG
	DCA I	P0VEC+4 /STORE IN DCB ACTIVE SEGMENT COUNT
	JMP I	INES3

/TYPE PROJECT-PROGRAMMER NUMBER AS Z9,Z9.
/NUMBER IS IN AC ON ENTRY
TYPPN,	RTL
	RTL
	DCA	TEMP1
	TAD	TEMP1
	AND	K7
	SZA
	JMS I PTYTYP
	TAD	TEMP1
	RTL
	RAL
	DCA	TEMP1
	TAD	TEMP1
	AND	K7
	JMS I PTYTYP
	TAD	KM4
	JMS I PTYTYP	/INSERT A COMMA
	TAD	TEMP1
	RTL CML
	RAL
	DCA	TEMP1
	TAD	TEMP1
	AND	K7
	SZA
	JMS I PTYTYP
	TAD	TEMP1
	RTL
	RAL
	AND	K7
	JMS I PTYTYP
	JMP I (INE5)	/RETURN TO INIT

PTYTYP,	TYTYP
/CONSTRUCT TEMP FILE NAMES(INES5)
/
/FUNCTION: TO CONSTRUCT UNIQUE TEMP FILE NAMES FOR EACH CONSOLE
/
/ENTRY: NO SPECIAL CONDITIONS
/
/EXIT: NO SPECIAL CONDITIONS
/
INES5,	0
	USE		 /GET JOB NUMBER
	CON		 /GET USER CONSOLE NUMBER
	DCA   TEMP1	 /SAVE IN TEMP 1
	TAD   TEMP1	 /RESTORE A-REG
	RTL
	RAL
	AND	KHIBYT		/GET FIRST # IN BITS 0-5
	TAD	TEMP1
	AND	K707
	TAD	K2020		/CONVERT TO SIXBIT CODE
	DCA I INES5V	 /STORE IN FILE 0 NAME BLOCK
	TAD I INES5V	 /RESTORE A-REG
	DCA I INES5W	 /STORE IN FILE 1 NAME BLOCK
	JMP I INES5
/
K707,	707
K2020,	2020
INES5V, FL0NM+2 	 /WORD 3 - FILE 0 NAME BLOCK
INES5W, FL1NM+2 	 /WORD 3 - FILE 1 NAME BLOCK


IOLD,	TEXT /_OLD /
INEMB1,	TEXT /_NEW OR OLD--/
BFFM,	TEXT /_BAD FILE FORMAT/

PAGE
/
/FILE TYPE IS OLD, OPEN AS FILE 2 AND COPY TO FILE 1
/
INE40,	DCA I	FL2CBX
	DCA	TEMP5	/CLEAR PROJECT NUMBER
	CLA CMA
	TAD	TXBPTR
	DCA	TXBPTR	/SET TO REREAD TERMINATOR
INE40A,	INPCH
	JMP	INE41		/EOM
	JMP	INE40A		/BLANK
	JMP I PINE25		/COMMA, ERROR
	JMP	INE40B		/SPEC CHAR, CHECK
	JMP I PINE25		/ALPHABETIC CHAR, ERROR
	JMS	INECOV		/CONVERT OCTAL TO BINARY
	DCA I	FL2CBX
	CLA CLL CMA RTL
	DCA	TEMP6		/4 CHAR COUNTER

INE40C,	INPCH
	JMP	INE41		/EOM
	JMP	INE40D		/BLANK ENDS LINE
	JMP	INE40F		/COMMA DIVIDES PROJECT PROGRAMMER PAIR
	JMP I PINE25		/SPEC CHAR-ERROR
	JMP I PINE25		/ALPHABETIC CHAR - ERROR
	JMS	INECOV		/CONVERT OCTAL TO BINARY
	DCA	TEMP1
	TAD I	FL2CBX	/GET VALUE
	RTL CLL
	RAL
	TAD	TEMP1
	DCA I	FL2CBX	/NEW VALUE
	ISZ	TEMP6
	JMP	INE40C		/CONTINUE TO FETCH
INE40D,	INPCH			/VERIFY EOM
	JMP	INE41		/EOM
	JMP	INE40D		/BLANK
	JMP I PINE25		/COMMA- ERROR
	JMP I PINE25		/SPEC CHAR-ERROR
	JMP I PINE25		/ALPHABETIC CHAR-ERROR
	JMP I PINE25		/NUMERIC CHAR-ERROR

INE40B,	TAD	(-252		/IS THIS AN ASTERISK "*"
	SZA CLA
	JMP I PINE25		/NO-ERROR
	CLA STL RTL
	DCA I	FL2CBX
	JMP	INE40D		/VERIFY END OF LINE

INECOV,	0
	TAD	(-270
	CLL
	TAD	K10		/IS IT 260-267?
	SNL
	JMP I PINE25		/NO ERROR
	JMP I	INECOV		/OK

INE41,	CLA
	TAD	TEMP5
	TAD I	FL2CBX
	DCA I	FL2CBX
	STA CLL RTL
	MOVE
	FINAME-1
FL2CBX,	FL2NM-1
	OPEN2		/OPEN AS FILE 2
	JMP INE45	/OPEN FAILED
	DCA I	FL2CBX		/CLEAR OWNER
	CLA STL RTL
	DCA	FINFBL		/FILE 2
	TAD	AFINF
	FINF			/GET FILE 2 INFO
	JMS I (INES3)	/LOAD FILE 2 DCB
	REWIND
	IO22
	RDFILE
	DCA	COMP		/CLEAR FLAG
	TAD I	KFBUF2
	SMA SZA CLA
	JMP INE45Y	/NORMAL FILE TYPE
	TAD K3
	TAD I	KFBUF2
	SNA CLA
	JMP INE45Z	/EXECUTE ONLY FILE
	SEND;	BFFM	/BAD FILE FORMAT
	JMP I PINE5		/TRY AGAIN

INE45Z,	STA		/SET EXECUTE ONLY FLAG
	DCA COMP
	STA CLL RAL
INE45Y,	TAD (COPY+1)
	COPYFL
	JMP I (INE75A)

KFBUF2,	FBUF2			/FIRST WORD IN BUFFER 2

INE45,	SEND;	CFNM		/CANT FIND "
	JMS I (TYNAM)
	TAD	INQU
	TLS
	CLA
	TAD I	FL2CBX
	SNA
	JMP I PINE5
	TAD	KM2
	SNA CLA
	JMP	INE41X
	SEND;	CFUM		/FOR USER
	TAD I	FL2CBX
	JMP I (TYPPN)

INE41X,	SEND;	CLBRM		/IN SYSTEM LIBRARY
	JMP I PINE5

INE40F,	CLA
	TAD I	FL2CBX
	RTL CLL
	RTL
	RTL
	AND	KHIBYT
	DCA	TEMP5
	DCA I	FL2CBX
	JMP	INE40C

PINE5,	INE5
PINE25,	INE25
INQU,	""
PAGE
/REINITIALIZE EDITOR(INES4)
/
/FUNCTION: TO INITIALIZE EDITOR AFTER A RESTART
/
/ENTRY: NO SPECIAL CONDITIONS
/
/EXIT: PAGE 0 CONSTANTS LOADED AND DCB'S INITIALIZED
/
INES4,	0
	TAD	INES4V
	JMS I INES4M	 /LOAD PAGE ZERO
	DATSTR-1
	PG0DAT-1
	TAD I PUFIL0	/WAS FILE 0 USED BY FILE I/O
	SZA CLA
	JMP INES40	/YES
	TAD I PPRGNM	/NO, WAS FILE 0 USED BY CHAIN
	TAD KM3737
	SNA CLA
	JMP INES41	/NO
INES40,	JMS I PINES5	/YES, REOPEN BAS0NN
	TAD PFL0CB
	OPEN
	CHKFOP
	DCA I PUFIL0	/CLEAR FILE 0 NAME BLOCK
INES41,	JMS I	INES4A	/COMPUTE SEGSPB AND BFSIZE
	DCA	FINFBL	/SET FILE NUMBER TO 0
	TAD	FISIZE	/GET FILE 0 SEGMENT COUNT
	DCA	FINFBL+6	/STORE IN FINF BLOCK
	JMS I	INES4B	/LOAD FILE 0 DCB
	IAC
	DCA	FINFBL	/SET FILE NUMBER TO 1
	TAD	SRSIZE	/GET FILE 1 SEGMENT COUNT
	DCA	FINFBL+6	/STORE IN FINF BLOCK
	JMS I	INES4B	/LOAD FILE 1 DCB
	JMP I	INES4	/EXIT

PUFIL0,	UFIL0+2
KM3737,	-3737
PFL0CB,	FL0CB
PINES5,	INES5
INES4A, INES2		/COMPUTE SEGSPB AND BFSIZE
INES4B, INES3		/LOAD FILE DCB
INES4V, DATSTR-DATEND	/SIZE OF PAGE 0 DATA BLOCK
INES4M, MOV		 /ADDRESS OF MOVER

END=.
/
/PDP8 BASIC ERROR PROGRAM
/
/THIS PROGRAM IS CALLED BY ANY OTHER ROUTINE.
/IT IS PASSED AN ERROR CODE WHICH IS CONVERTED
/TO  AN ERROR MESSAGE.
/ONCE HAVING OUTPUT THE ERROR MESSAGE THE PROGRAM
/CALLS THE EDITOR.  ALL ERRORS CAUSING THE ERROR
/PROGRAM TO BE CALLED ARE FATAL.
/
/
/ERROR:       ERROR IS PRESENTED A NUMBER IN LOCATION 10 WHICH
/	      SIGNIFIES THE ERROR TYPE. THE ERROR MESSAGE IS OUTPUT
/	      AND THEN THE EDITOR IS CALLED TO RESTART PROCESSING
/	      OF THE SOURCE FILE.
LINE=34		/LINE NUMBER

ERROR,	TAD ERKSAS	/RESET SAS IN CASE IN LPT MODE
	DCA I PSASOP
	TAD	COMP		/CHECK FOR FILE 2 OPEN
	SPA SNA CLA
	JMP	ERROR2
	DCA	COMP		/RESET FLAG
	TAD	ERED
	RED			/DELETE OUTPUT FILE ON ERROR
ERROR2,	DCA SIXBIT
	TAD	LINE		/STORE LINE
	DCA	XLINE		/AND ERROR CODE
	TAD	10
	DCA	ERCODE		/IN A SAFE PLACE
	JMS I KINES4	/INIT EDITOR
	CRLF
	TAD	ERCODE
	TAD	KMLIM		/TEST FOR LEGAL CODE
	SPA CLA
	JMP	ERR2X
	TAD	K3		/FORCE AN ILLEGAL ERROR
	DCA	ERCODE
ERR2X,	TAD	ERCODE
	TAD	KMSGT
	DCA	ERCODE		/SAVE POINTER
	TAD I	ERCODE
	SMA
	TAD	K4000		/ADD IN BIT0
	DCA	.+2		/SAVE MESSAGE ADDRESS
	SEND
	0
	TAD I	ERCODE		/TEST FOR LINE # WANTED
	SMA CLA
	JMP	ERR3		/WE DON'T NEED A LINE #
	SEND;	MSG1		/IN LINE
	CLA IAC
	DCA	TAPE		/DUMMY TAPE MODE
	TAD	XLINE
	JMS I	KCBA
	TAD	TXBPTR
	CIA
	TAD	ERPTR		/COMPUTE NUMBER OF DIGITS
	DCA	.+2
	JMS I	PSTSX
	0
ERPTR,	TXBUF-1
	DCA	TAPE		/CLEAR TAPE MODE

ERR3,	CRLF
	TAD I PPRGNM	/DID CHAIN OCCUR
	TAD KM3737
	SNA CLA
	JMP ERR4X	/NO
	SEND; PRGMSG	/PRINT CURRENT PROGRAM NAME
	SEND; PRGNM
	CRLF
ERR4X,	TAD I	KABSW		/CHECK FOR ABORT SWITCH
	SZA CLA
	JMP I	KABORT
	JMP I	.+1
	INE50			/ENTER EDITOR MAINLINE


PSASOP,	SASOP
ERKSAS,	SAS
KCBA,	CBA
KMSGT,	MSGTBL
KMLIM,	-LIM
XLINE,	0
ERCODE,	0
K4000,	4000
KINES4,	INES4
KABSW,	ABSW
KABORT,	SABORT
ERED,	.+1			/REDUCE FILE PARAMETERS
	2
	3777



MSGTBL,	ERR0-4000	/SYSTEM I-O ERROR
	ERR1-4000	/PROGRAM TOO LARGE
	ERR2-4000	/NO END STATEMENT IN PROGRAM
	ERR15-4000	/SYSTEM ERROR (DO NOT CHANGE!!)
	ERR4		/ILLEGAL INSTRUCTION
	ERR5		/ILLEGAL FORMAT
	ERR6		/ILLEGAL CONSTANT
	ERR7		/PROGRAM NOT FOUND
	ERR8		/ILLEGAL CHARACTER
	ERR9		/BAD SLEEP ARGUMENT
	ERR10		/ILLEGAL VARIABLE
	ERR11L		/ILLEGAL LINE NUMBER
	ERR12L		/ARRAY USED WITHOUT DIM STATEMENT
	ERR13		/ILLEGAL FORMULA
	ERR14		/DIMENSION TOO LARGE
	ERR14A		/IMPROPER DIM STATEMENT
	ERR16		/CHANGE ERROR
	ERR17		/TIMEOUT ERROR
	ERR18		/CAN'T CREATE FILE
	ERR19		/CAN'T DELETE FILE
	ERR20		/STACK OVERFLOW
	ERR21		/OUT OF DATA
	ERR22		/BAD FILE NAME
	ERR23		/UNDEFINED LINE NUMBER
	ERR24		/ILLEGAL OPERATION
	ERR25		/SUBSCRIPT ERROR
	ERR26		/MISUSED CHR$
	ERR27		/GOSUB--RETURN ERROR
	ERR28		/ILLEGAL FOR NESTING
	ERR29-4000	/DEF STATEMENT MISSING
	ERR30		/NEXT WITHOUT FOR
	ERR31-4000	/FOR WITHOUT NEXT
	ERR32-4000	/DISK FULL
	ERR33		/MISUSED TAB FUNCTION
	ERR34		/UNOPEN DISK
	ERR35		/DEVICE BUSY
	ERR36		/INVALID RECORD NO.
	ERR37		/ON INDEX OUT OF RANGE
	ERR38		/INVALID DEVICE NO.
	ERR39		/GET EOF
	ERR40		/GET/PUT ERROR
	ERR41		/CHAIN TO BAD FILE

LIM=.-MSGTBL

PRGMSG,	TEXT 'PROGRAM IS '
MSG1,	TEXT ' LINE '
ERR0,	TEXT 'SYSTEM I-O ERROR_'
ERR1,	TEXT 'PROGRAM TOO LARGE_'
ERR2,	TEXT 'NO END STATEMENT_'
ERR4,	TEXT 'ILLEGAL INSTRUCTION IN'
ERR5,	TEXT 'ILLEGAL FORMAT IN'
ERR6,	TEXT 'ILLEGAL CONSTANT IN'
ERR7,	TEXT 'PROGRAM NOT FOUND AT'
ERR8,	TEXT 'ILLEGAL CHARACTER IN'
ERR9,	TEXT 'BAD SLEEP ARGUMENT IN'
ERR10,	TEXT 'ILLEGAL VARIABLE IN'
ERR11L,	TEXT 'ILLEGAL LINE NUMBER IN'
ERR12L,	TEXT 'ARRAY OR RECORD USED BEFORE DEFINITION IN'
ERR13,	TEXT 'ILLEGAL SYNTAX IN'
ERR14,	TEXT 'DIMENSION TOO LARGE IN'
ERR14A,	TEXT 'IMPROPER DIM OR RECORD STATEMENT IN'
ERR18,	TEXT /CAN'T CREATE FILE IN/
ERR19,	TEXT /CAN'T DELETE FILE IN/
ERR20,	TEXT 'STACK OVERFLOW IN'
ERR21,	TEXT 'OUT OF DATA IN'
ERR22,	TEXT 'BAD FILE NAME IN'
ERR23,	TEXT 'UNDEFINED LINE NUMBER, '
ERR24,	TEXT 'ILLEGAL OPERATION IN'
ERR15=ERR24

ERR25,	TEXT 'SUBSCRIPT ERROR IN'
ERR27,	TEXT 'GOSUB--RETURN ERROR IN'
ERR28,	TEXT 'ILLEGAL FOR NESTING IN'
ERR29,	TEXT 'DEF STATEMENT MISSING_'
ERR30,	TEXT 'NEXT WITHOUT FOR IN'
ERR31,	TEXT 'FOR WITHOUT NEXT_'

ERR32,	TEXT 'DISK FULL_'
ERR33,	TEXT 'MISUSED TAB IN'
ERR26,	TEXT 'MISUSE OF CHR$ IN'
ERR16,	TEXT 'BAD VALUE IN CHANGE STATEMENT AT'
ERR17,	TEXT 'TIME LIMIT EXCEEDED AT'
ERR34,	TEXT 'UNOPEN DISK UNIT IN'
ERR35,	TEXT 'DEVICE BUSY IN'
ERR36,	TEXT 'INVALID RECORD NO. IN'
ERR37,	TEXT 'ON INDEX OUT OF RANGE IN'
ERR38,	TEXT 'INVALID DEVICE NO. IN'
ERR39,	TEXT 'GET BEYOND END OF FILE IN'
ERR40,	TEXT 'GET/PUT ERROR IN'
ERR41,	TEXT 'CHAIN TO BAD FILE AT'

TOPOFCORE=.
	$