/FOREGROUND JOB			EDITED 11/12/73
/CIFT, INSERT THE PROPER CIF OVER THE JMS
/USED PRIMARILY BY SYSTEM OVERLAYS
CIFT,	0000
	DCA	CDFT
	STA CML
	TAD	CIFT
	DCA	CIFT
	TAD	CIFFGM
	UDF			/JUST IN CASE
	DCA I	CIFT
	TAD	CDFT
	JMP I	CIFT

/FOREGROUND JOB FOR COS 300
/FETCHR ENTER WITH THE CHARACTER NUMBER IN THE AC
/AND RETURN WITH THE CHARACTER IN THE AC.
/FETCHR DOES NO I/O THEREFORE IT MAY BE CALLED WITH A JMS
/THUS SAVING THE POOR PROCESSOR ABOUT 74 MEMORY CYCLES
/OR ABOUT 88.8 US. PER CALL ON AN 8/E (JMS VERSES PUSHJ)
FETCHX, 0000
	CLL RAR		 	/CHAR # IN THE AC
	TAD	BASE		/USERS BASE ADDRESS
	UDF
	DCA	TEMP
	TAD I	TEMP		/FETCH WORD WITH THE 6 BIT CHAR.
DF201,	DF202
	SNL			/LINK=0 MEANS LEFT SIDE
BSW201, BSW202
	AND	L77
	TAD	L237		/RETURN CHAR IN AC. NOTE 00 COMES OUT AS 237
	JMP I	FETCHX
/PUTCHR PLACES A CHARACTER INTO THE USERS BUFFER
/AC HAS CHARACTER AND CHRNUM HAS CHARACTER NUMBER.
PUTCHX, 0000
	TAD	PM237
	AND	L77
	DCA	FETCHX		/STORE 6 BIT CHAR, ENTER HERE IF YOU WANT 00 IN BUFFER
	TAD	CHRNUM
	CLL RAR
	TAD	BASE
	DCA	EXTRAX		/WORD WHERE CHAR CAN BE FOUND. LINK HAS SIDE SWITCH
	UDF
	TAD I	EXTRAX
	SNL			/WHICH SIDE MUST WE SAVE?
BSW202,	BSW2A2			/THE RIGHT SIDE
	AND	L7700
	TAD	FETCHX		/PUT IN THE NEW CHARACTER
	SNL			/DO WE NEED ANOTHER BSW?
BSW2A2,	BSW203
	DCA I	EXTRAX
DF202,	DF203
	TAD	UPDWRT
	SMA CLA			/IF "-" LET IT BE
	DCA	UPDWRT		/LET UPDATE KNOW WE WROTE IN THE RECORD.
	DCA	LASTCH		/MUST BE 0 , LOOK AT INPUT
	ISZ	CHRNUM		/INCREMENT CHARACTER NUMBER
	JMP I	PUTCHX		/AND EXIT
PM237,	-237
P35,	35

/ADV, ADVANCE TO THE BEGINNING OF THE NEXT FIELD.
/ALL RETURN CHAR# IN AC, IF FORM IS EXCEEDED 0 IS RETURNED.
/IF AC=-2 IT GOES TO THE BEGINNING OF THE CURRENT FIELD
/IF AC=-4 IT GOES TO THE BEGINNING OF THE PREVIOUS FIELD
ADV,	0000
	TAD	PTFDP		/BUMP IT BACK THE APPROPRIATE NUMBER OF PLACES
	DCA	PTFDP
	UDF
	TAD I	PTFDP
	SNA			/ANY MORE FIELDS?
	JMP	DF203		/NO, EXIT WITH AC = 0
	DCA	PTFD		/POINTS TO FIELD DISCRIPTOR
	TAD I	PTFD		/GET R,C
	DCA	TEMP		/MAY NOT WANT TO DO A CAD
	TAD I	PTFD		/GET DEFINITION AND CHAR COUNT
	DCA	MCHRCT		/-CHAR COUNT
	TAD I	PTFD		/+ OPTION(S)
	DCA	DEFOPT
	TAD I	PTFDP		/GET CHAR # AND RETURN
	TAD	UPDDIS		/DISPLACEMENT FOR UPDATE.
	DCA	CHRNUM
	TAD	CHRNUM
DF203,	DF205
	JMP I	ADV

/CAD, CURSOR ADDRESSING
/ENTER WITH ROW IN AC BITS 0-4 COLUMN IN AC BITS 5-11
CAD,	DCA	TEMP		/STORE IT
CAD2,	TAD	P16		/^N
	PUSHJ
	TTOCHR
	TAD	M4
	DCA	TEMP3		/SETUP COUNT FOR 4 NULLS
	TAD	TEMP
BSW203, BSW204
	RAR			/DIVIDE BY 2?
	AND	L237		/FETCH ROW (37 IS ALL THAT COUNTS [7 BIT VT05])
	TAD	L237		/PUT IT IN 40-63 RANGE
	PUSHJ
CADTTO, TTOCHR			/SEND ROW
	ISZ	TEMP3		/SEND 4 (COUNT 'EM, FOUR) NULLS
	ISZTTO			/QUICK TYPE
	TAD	TEMP
	TAD	L237
	JMP I	CADTTO		/SEND COLUMN (OR EOS FOR ERASE) AND RETURN
/EXTRAX, STORES THE EXTRA CHARACTER OF THE CHECKDIGIT OR SIGN
/IN A NUMERIC FIELD. THE 8 BIT ASCII WILL BE STORED IN THE WORD
/FOLLOWING THE OPTIONS FLAG WORD. BITS 0-3 OF THIS WORD WILL
/HAVE N OF T(N) IF YOU HAVE THE T OPTION.
EXTRAX, 0000
	DCA	TEMP3		/AC HAS THE CHAR THAT WE WANT TO SAVE
	AC0001
P16,	TAD	PTFD
	DCA	TEMP4		/POINTS TO THE EXTRA CHAR WORD
	UDF
	TAD I	TEMP4
	AND	L7400		/SAVE THE N OF T(N)
	TAD	TEMP3		/ADD THE CHAR
	DCA I	TEMP4		/STORE IT BACK
DF205,	DF206			/CDF N (GETS SET UP) *****
	JMP I	EXTRAX
	IFNZRO PTFD-16 <???>	/FIND A NEW CONSTANT FOR 16

/CLEAR, CLEARS REST OF FIELD AND SUCCEDING FIELDS IF NOT AUTO-DUP
/REST OF CURRENT FIELD GET CLEARED REGUARDLESS
/CLEARA,	SAME AS CLEAR EXCEPT IF CURRENT FIELD IS AUTO-DUP
/THE REST OF THE FIELD IS NOT CLEARED
CLEARA, TAD	DEFOPT		/CLEAR ALL BUT ATUO-DUP
	AND	MASKD
	SNA CLA
IFNZRO CLROUT&7000 <???>	/I'M SKIPPING THROUGH AN AND, WHATCH IT!
CLEAR,	PUSHJ
	CLROUT
NCLEAR, PUSHJ			/ENTER HERE IF YOU DON'T WANT TO CLEAR THE REST OF THE CURRENT F
	NXTFLD
	SNA CLA		 	/ADVANCED TOO FAR?
	POPJ			/YES, DONE
	JMP	CLEARA
/CALL, READS OR WRITES ON THE SYSTEM DEVICE
/	TAD (PARM-1
/	PUSHJ
/	CALL
/
/PARM,	L.O.A.,0	/LOW ORDER ADDRESS AND 0
/	R/W/,LEN,F,U	/READ/WRITE,LENGTH,0,0
/	RADD		/RELATIVE ADDRESS FROM BASE
/	H.O.B.		/HIGH ORDER BLOCK NUMBER
/
/THE FIELD GETS SET TO USRCDF FIELD AND
/THE RELATIVE ADDRESS GETS SET TO RELATIVE+BASE ADDRESS
/
/IF YOU CALL THIS FROM THE USER AREA ENTER AT CALLX
CALLX,	UDF
CALL,	DCA	XR16		/POINTS TO PARM
	TAD I	XR16		/L.O.A.
	DCA	ARG1A		/ARG1A HAS LOW ORDER ADDRESS
	TAD	USRCDF
	AND	L70		/PICK UP THE USERS FIELD
	TAD I	XR16		/AND R/W,LEN,0,0
	DCA	ARG2A
	TAD	BASE
	TAD I	XR16
	DCA	ARG3A		/REAL ADDRESS
	TAD I	XR16		/HIGH ORDER BLOCK #
	DCA	ARG4A
DF206,	DF207			/IN CASE WE ENTERED FROM ANOTHER FIELD
	JMS I	SYSQ		/QUEUE TO THE SYSTEM HANDLER
	JMP I	.+1
	IOWAIT			/WAIT FOR I/O OPERATION TO COMPLETE
				/POPJ AT IOWAIT WILL DO RETURN FROM CALL
/
PAGE

/%BLOCK 2
/SASM1, SEND A STRING
/ENTER WITH WORD COUNT IN MCHRCT AND CHAR # IN AC.
LSTFLD,	TAD	CHRNUM		/LIST CURRENT FIELD AT CURSOR POSITION (USE AFTER "MOVE")
SASM1,	TAD	M2
SAS,	CLL RAR
	TAD	BASE
	DCA	XR16
	CMA CML
	DCA	TEMP4
SAS2,	CML			/TO CLEAR THE LINK FROM "JMP SAS2" BELOW.
	UDF
	TAD I	XR16
DF207,	DF208			/CDF N (GETS SET UP) *****
	DCA	TEMP3
	TAD	TEMP3
	SNL			/WHICH HALF ON FIRST WORD?
BSW204, BSW205
SAS3,	AND	L77
	SNA
	TAD	L100
	TAD	L237
	ISZ	TEMP4		/FIRST CHAR?
	ISZTTO			/NO, DO QUICK PUSHJ TTOCHR
	SZL			/WHICH SIDE ON FIRST WORD?
	ISZ	TEMP4		/RIGHT SIDE, BUMP TO FETCH NEXT WORD
	PUSHJ
SAS4,	TTOCHR
	ISZ	MCHRCT		/DONE?
	SKP
	POPJ			/YES
	TAD	TEMP4
	CLL RAR
	SZL CLA
	JMP	SAS2
	TAD	TEMP3
	JMP	SAS3

/CLEAR FIELD FROM CURSOR TO END OF FIELD.
/CURSOR WILL BE LEFT AT END OF THE FIELD CLEARED.
CLROUT, TAD	L337		/CLEAR OUT TO "_"
CLRTHS, DCA	TEMP3		/CLEAR OUT TO WHAT WAS IN THE AC
CLRFLD, STA CLL
	DCA	TEMP5		/FLAG FOR THE FIRST TTOCHR
	TAD	MCHRCT
	SMA CLA		 	/SEE IF ALREADY THERE
	JMP	CLRXRA		/AT END DO NOTHING
CLRLOP, TAD	DEFOPT		/SEE IF A OR D
	SPA CLA
	TAD	L0020		/MAKE IT A 60 (260)
	TAD	L0040		/A 40 (240)
	PUTCHR			/0 OR "SPACE" IN FIELD
	TAD	TEMP3		/UNDER SCORE OR WHAT EVER
	ISZ	TEMP5		/FIRST CHAR?
	ISZTTO			/NO, DO QUICK TTOCHR AND SAVE 88.8US
	PUSHJ
CTTOCH, TTOCHR
	ISZ	MCHRCT		/NEXT
	JMP	CLRLOP
CLRXRA, TAD	DEFOPT		/CLEAR EXTRA CHAR IF ITS A NUMERIC FIELD
	SMA CLA		 	/NUMERIC?
	POPJ			/NO EXIT
	TAD	MCHRCT		/WAS THIS A CLEAR WITH THE POINTER AFTER THE
	SZA CLA		 	/EXTRA CHAR?
	POPJ			/MUST BE A 1
	EXTRA			/CLEAR EXTRA CHARACTER
	ISZ	MCHRCT		/FLAG IT SO I CAN SAVE CODE
	TAD	L337		/FAKE THE EXTRA CHARACTER AND TYPE _
	JMP I	CTTOCH		/AND EXIT

/NXTFLD,	NEXT FIELD. ADVANCE TO THE NEXT NON AUTO-DUP FIELD
/RETURN CHAR # IF THERE 0 IF END OF FORM
/RESET TO FIRST NON-AUTO-DUP FIELD.
RESET,	AC0001			/FIRST FIELD IS DUMMY 0000 , SO LEFT ARROW WON'T GO PAST IT
	TAD	BASE		/SCRATCH BLOCK (BASE) IS WHERE THE POINTERS TO FIELD DISCRIPTORS ARE
	DCA	PTFDP		/POINTER TO FIELD DISCRIPTOR POINTERS
NXTFLD, MOVE			/ADVANCE 1 FIELD
	SNA CLA
	POPJ			/END OF FORM
	TAD	DEFOPT		/CHECK FOR AUTO-DUP
	AND	MASKD
	SZA CLA
	JMP	NXTFLD		/AUTO-DUP IGNORE IT
RESET2, PUSHJ
	CAD2			/TEMP HAS R,C
	TAD	CHRNUM
	POPJ			/RETURN WITH CHAR # IN AC

/ERRMES, PRINTS OUT THE ERROR MESSAGE AND WAITS FOR A CARRAGE RETURN
/FIRST OFFENDING CHARACTER IS TYPED AND ALL OTHERS PRODUCE A BELL
/THIS IS TO PROTECT THE GUY FROM WIPING HIS SCREEN OUT.
ERRMES, PUSHJ
	ROW20			/CLEAR LINE 20, SOUND BEEP PRINT ERR MESS
EM2,	TAD	LASTCH
	PUSHJ
ERRTTO, TTOCHR			/PRINT OFFENDING CHARACTER
	DCA	LASTCH		/AND THEN DELETE IT.
	PUSHJ
	CRWAIT			/WAIT FOR A CAR. RET., THEN CLEAR LINE
	TAD	MCHRCT
	CIA
	DCA	TEMP4		/SAVE WHERE WE ARE
	AC7776
	MOVE			/POSITION CURSOR AT BEGINNING OF FIELD
	CLA CLL
	PUSHJ
	CAD2
	TAD	TEMP4
	TAD	MCHRCT
	DCA	TEMP4		/NUMBER OF PLACES TO MOVE OVER
	TAD	TEMP4
	SNA CLA
	POPJ
EM3,	TAD	MCHRCT
	SNA CLA
	JMP	EM4		/"-" OR C.D.
	PUSHJ
	CURRIT
	ISZ	TEMP4
	JMP	EM3		/MORE TO GO
	POPJ
/CURRIT, CURSOR RIGHT. MOVE CURSOR AND CHAR POINTERS RIGHT 1 CHAR
CURRIT,	ISZ	CHRNUM		/NEXT CHAR
EM4,	ISZ	MCHRCT		/AND COUNT (FOR CURRIT IN ERRMES FOR "-" OR C.D.)
L30,	30
	TAD	L30		/CURSOR RIGHT
	JMP I	ERRTTO		/MOVE CURSOR RIGHT AND EXIT
ISZTTX, ISZ	STACK		/FAKE PUSHJ TO TTOCHR
	ISZ	STACK
	JMP I	ERRTTO

LARROW,	TAD	L7774
	MOVE
	SZA CLA			/IS HE AT THE FIRST FIELD?
	JMP I	(LARRO2		/NO REPOSITION THE CURSOR
	AC0001			/RESTORE PTFDP FIRST
	MOVE			/YES, GOTO THE LAST FIELD
	SZA CLA			/ARE WE AT THE END YET?
	JMP	.-2		/NO KEEP GOING
	AC0001
	JMP	LARROW		/WE MADE IT I HOPE
/
PAGE

/CONTROL U, CLEAR CURRENT FIELD AND REPOSITION AT THE BEGINNING OF IT
/RIGHT ARROW, ADVANCE TO THE NEXT FIELD BUT DON'T CLEAR REST OF CURRENT FILED.
/THIS ADVANCES TO NEXT FIELD EVEN IF ITS AN AUTO-DUP FIELD
CTRLU,	AC7776
	MOVE			/BACK TO BEGINNING OF CURRENT FIELD
	CLA CLL		 	/ADV RETURNS NON ZERO AC IF IT SUCCEEDS
	PUSHJ
	CAD2
	PUSHJ
	CLROUT			/CLEAR IT OUT
	JMP	BARROW		/MORE STUFF TO DO
/CARR AND TAB HAVE SAME FUNCTION IN ALPHA FIELDS
/THEY BOTH CLEAR OUT THE REST OF THE CURRENT FIELD
/AND ADVANCE TO THE NEXT NON AUTO-DUP FIELD
/IT IS ENTERED WITH A JMP FROM INPUT AND IT ONLY EXITS TO BFIELD
/THEREFORE IT IS NECESSARY FOR INPUT TO CLEAR THE STACK POINTER.
/IN A DECIMAL FIELD CARR PUTS IN TRAILING NULLS NOT "0"'S
/AND RIGHT JUSTIFIES IF J OPTION.
/TAB PUTS IN TRAILLING "0"'S, BOTH WILL DO CHECK DIGIT IF C OPTION
/AND RANGE CHECK IF R OPTION.
/LEFT ARROW, GOES TO PREVIOUS FIELD, DOES NOT DELETE ANYTHING
/NOP IF AT THE FIRST FIELD
CARR,	TAD	DEFOPT
	SMA CLA		 	/NUMERIC FIELD?
	JMP	TAB		/NO
ENDNUM,	STA
	DCA	TEMP5		/FLAG FOR FIRST CHAR
	TAD	MCHRCT
	SMA CLA		 	/ANY FIELD REMAINING?
	JMP	CARR3		/NO, BUT CHECK THE EXTRA CHARACTER
CARR2,	TAD	L237		/PUTCHR SUBTRACTS 237
	PUTCHR			/PUT 00 IN CHAR
	TAD	L337
	ISZ	TEMP5		/SKIP ON THE FIRST CHAR SO WE CAN SET UP OUR STACK
	ISZTTO
	PUSHJ
CARTTO, TTOCHR			/OUTPUT "_"
	ISZ	MCHRCT
	JMP	CARR2
CARR3,	TAD	MCHRCT
	SZA CLA
	JMP	CARR4
	TAD	L337
	PUSHJ
	TTOCHR
	EXTRA			/IF 1, DON'T CLEAR EXTRA CHARACTER
CARR4,	TAD	DEFOPT
	AND	MASKC		/SEE IF CHECK DIGIT
	SZA CLA
	JMS I	PCKDIG
	SNA CLA
	JMP	CARR5
	TAD	PCHKER1	 	/"CHECK DIGIT ERROR"
RNGERR, TAD	PAOOR		/ARGUMENT OUT OF RANGE
	PUSHJ
	ERRMES
BARROW,	AC7776			/GO TO THE BEGINNING OF THIS FIELD
RARROW, MOVE			/GO AHEAD 1 FIELD
	SNA CLA
	JMP I	PISFOK		/NO MORE FIELDS
LARRO2,	PUSHJ
	CAD2			/REPOSITION THE CURSOR
	JMP	NOFERR

PCKDIG, CKDIG
CARR5,	TAD	DEFOPT
	AND	MASKJ		/SEE IF RIGHT JUSTIFY
	SNA CLA
	JMP	TAB2		/GET NEXT FIELD
RJUST,	AC7776
	MOVE
	CLA CLL
	JMS I	PRIGHTJ		/RIGHTJ RETURNS WITH EXTRA CHAR IN AC
	DCA	TEMP5
	AC7776
	MOVE
	CLA CLL
	PUSHJ
	CAD2
	PUSHJ
	LSTFLD			/LIST OUT THE CURRENT FIELD
	TAD	TEMP5
	PUSHJ
	TTOCHR			/NOW OUTPUT THE EXTRA CHARACTER
TAB2,	TAD	DEFOPT
	AND	MASKR		/RANGE CHECK?
	SNA CLA
	JMP	TAB3
	TAD	(RMNOK&177+5200
	DCA I	(RMNUPD		/SET UP FOR RANGE CHECK
	AC7776
	MOVE			/MAKE SURE THAT WERE AT THE BEGINNING OF THE FIELD.
	AC7777			/FOR RANGE CHECK
	JMS I	PRMN		/CHECK RANGE
	SZA CLA
	JMP	RNGERR
	JMP	TAB3
TABA,	PUSHJ
	CLROUT
TAB3,	PUSHJ
	NXTFLD			/ADVANCE TO THE NEXT NON AUTO-DUP FIELD
	JMP	BFIELD		/BEGIN FIELD
PCHKER,	CHKER1-AOOR
PAOOR,	AOOR
PRMN,	RMN

TAB,	TAD	DEFOPT
	SMA CLA		 	/A OR D FIELD
	JMP	TABA		/A FIELD
	ISZ	TEMP3		/WAS LAST CHAR TYPED IN FIELD A "-"?
	JMP	TABD		/NO
	PUSHJ			/YES
	RUBOUT			/MOVE THE "-" TO THE EXTRA CHAR
	TAD	KMINUS
TABD,	TAD	KUNDRS		/"_"
	PUSH			/SAVE IT WHERE IT WON'T GET HURT.
	TAD	L260
	PUSHJ
	CLRTHS			/CLEAR OUT TO "0"'S
	PUSHJ
	RUBOUT			/RUBOUT THE "_"
	POP
	EXTRA			/PUT WHATEVER IT WAS IN EXTRA CHAR
	TAD	TEMP3		/LEFT OVER FROM EXTRA
	PUSHJ
	TTOCHR
	JMP	CARR4
KMINUS,	"--"_
KUNDRS,	"_
PRIGHT, RIGHTJ
PINALP, INALPH
PISFOK, ISFOK
/ESCAPE (ALT) IS SIMILAR TO HOME EXCEPT IT DOESN'T CLEAR ANY FIELDS
ESCAPE,	DCA	LASTCH		/TO CLEAR LAST CHAR FROM LAST FIELD OVERFLOW
	PUSHJ
	RESET			/TO THE FIRST NON-AUTO-DUPE FIELD.
BFIELD, SNA CLA		 	/SEE IF I RAN OFF THE FORM
	JMP I	PISFOK		/IS FORM OK?
NOFERR, TAD	DEFOPT
	SMA CLA		 	/SEE IF A OR D
	JMP I	PINALP		/ALPHA INPUT
	JMP I	PINNUM		/NUMERIC INPUT
PINNUM, INNUM
/
PAGE

/%BLOCK 3
/NUMERIC INPUT, ACCEPT ONLY 0-9,AND AN OPTIONAL "-",
/OR CHECK DIGIT (C.D.), IF "-" OR C.D. EXCEEDS THE FIELD
/IT IS PUT IN THE LOW ORDER OF THE OPTIONS+1 (N OF T(N) )
/PTFD POINTS AT OPTIONS AT THIS TIME
/ENTER AT INNUM WITH PUSHJ
NUMNUM, TAD	LASTCH
	JMS I	PKEYPD		/IS IT A NUMBER?
	JMP	NUMBER		/ITS A NUMBER
ILLDCH, TAD	(NUMER1		 /ILLEGAL CHARACTER IN NUMERIC FIELD
	PUSHJ
	ERRMES
INNUM,	PUSHJ
	INPUT
INNUM2, TAD	LASTCH
	TAD	(-"-
	SZA CLA
	JMP	NUMNUM		/NOT "-", SEE IF ITS A NUMBER.
	TAD	LASTCH		/TRAP THE "-" SO ONLY A TERMINATING CHARACTER IS PERMITTED
	PUSHJ
	TTOCHR			/PRINT THE "-"
	TAD	LASTCH
	PUTCHR			/PUT IT IN THE FIELD
	ISZ	MCHRCT		/INC CHARACTER COUNTER
K12,	12			/NOP,IN CASE THE "-" IS THE LAST REAL CHARACTER IN THE FIELD
INNUM3, STA
	DCA	TEMP3		/PUT A FLAG IN TEMP3 (SO I CAN TELL IF HE RUBS-OUT ANYTHING)
	PUSHJ
	INPUT			/WON'T RETURN IF A TERMINATING CHARACTER IS TYPED
	TAD	TEMP3
	SMA CLA
	JMP	INNUM2		/RUBOUT WAS SEEN, ACCEPT A CHARACTER
	TAD	(NUMER2	 	/ILLEGAL CHARACTER AFTER "-"
	PUSHJ
	ERRMES
	JMP	INNUM3
PKEYPD, KEYPAD			/ACCEPT M,J,K,L,U,I,O AS NUMBERS

NUMBER, TAD	LASTCH
	PUSHJ
	TTOCHR			/PRINT IT
	TAD	LASTCH
	PUTCHR			/AND PUT IT IN HIS FIELD
	ISZ	MCHRCT
	JMP	INNUM		/NEXT NUMBER
INNUM4, PUSHJ			/ONLY "-" OR C.D. WILL BE ACCEPTABLE
	INPUT
INNUM5, TAD	MCHRCT
	SZA CLA		 	/SEE IF HE TYPED A RUBOUT SOMEWHERE
	JMP	INNUM2		/YES, LET HIM TRY AGAIN
	TAD	DEFOPT		/NO, SEE IF "C" OPTION
	AND	MASKC
	SZA CLA
	JMP	CHKDIG		/HAS "C" OPTION SO ONLY NUMBERS PLEASE
	TAD	LASTCH		/ONLY "-" PERMITTED
	TAD	(-"-
	SZA CLA
	JMP	EXOVER		/NOT A "-"
ACCEPT, TAD	LASTCH		/ACCEPT EXTRA CHARACTER
	PUSHJ
	TTOCHR
	TAD	LASTCH
	EXTRA
	ISZ	MCHRCT		/SHOULD BE A 1
	DCA	LASTCH
	PUSHJ
	INPUT
	TAD	MCHRCT		/IF IT RETURNS CHECK FOR A RUBOUT
	SMA SZA CLA
	JMP	EXOVER
	JMP	INNUM5
CHKDIG, TAD	LASTCH		/CHECK DIGIT 0-9
	JMS I	PKEYPD
	JMP	ACCEPT
EXOVER, TAD	DEFOPT
	AND	MASKF
	SNA CLA		 	/IF F OPTION TOO MANY CHARS
	JMP I	(ENDNUM		/END NUMERIC FIELD
	TAD	(ALPER2	 	/FIELD OVERFLOW
	PUSHJ
	ERRMES
	JMP	INNUM4

/DARROW, DOWN ARROW. CLEARS ALL FIELDS EXCEPT AUTO DUPS
/AND RESPONDS WITH "IS FORM OK?"
/IF THE CURRENT FIELD WAS AN AUTO-DUP IT WILL NOT BE CLEARED.
DARROW, PUSHJ
	CLEARA			/CLEARALL EXCEPT AUTO-DUPS
ISFOK,	TAD	(MISFOK	 	/IS FORM OK?
	PUSHJ
	MESYES
	SZA CLA
	JMP I	KESCAP		/FORM WAS NOT OK
FRMFED,	PUSHJ
	RESET
ISFOKL, SNA CLA
	POPJ
	TAD	DEFOPT
	SMA CLA		 	/IS IT WORTH CHECKING?
	JMP	ISFOK2		/NO, GET NEXT ONE
	JMS I	(RIGHTJ		/RETURNS WITH I PTFD IN AC
	DCA	TEMP5		/SAVE IT
	TAD	TEMP5
	AND	L377
	TAD	(-"-
	SZA CLA			/WAS THERE A MINUS IN THERE?
	JMP	ISFOK1		/NO "-" SO FORGET IT
	AC7776
	MOVE			/SO I CAN FIND THE LAST CHAR
	CIA			/-CHRNUM
	TAD	MCHRCT
	CMA
	DCA	CHRNUM		/POINT TO THE LAST CHAR
	TAD	CHRNUM
	FETCHR			/GET THE LAST CHAR
	TAD	L0040		/ADD IN THE MINUS
	PUTCHR
ISFOK1,	TAD	DEFOPT
	AND	MASKT
	SNA CLA			/SEE IF T OPTION
	JMP	ISFOK2
	TAD	TEMP5		/WHAT WAS IN THE EXTRA CHARACTER?
	AND	L7400		/GET N OF T(N)
	BSW210=	0
BSW207,	BSW210
	CLL RTL			/N*20
	JMS I	(DECADD
ISFOK2, MOVE
	JMP	ISFOKL
/
	PAGE

INALPH, PUSHJ			/ALPHA INPUT
	INPUT
INALP2, TAD	MASKA
	TAD	MASKLB
	AND	DEFOPT		/CHECK OPTIONS A,#
	SNA
	JMP	NOOPT		/ACCEPT ANY CHARACTER
	AND	MASKA
	SNA CLA
	JMP	OPTLB		/MUST BE # OPTION
	TAD	LASTCH		/A OPTION "SPACE" A-Z
	TAD	(-240
	SNA			/IS IT A SPACE?
	JMP	NOOPT		/YES TAKE IT
	TAD	(240-"[
	CLL
	TAD	KOBRMA
	SZL CLA
	JMP	NOOPT		/A-Z, SO TAKE IT
INAERR, TAD	(ALPER1-ALPER3 	/ILLEGAL CHARACTER IN AN ALPHA FIELD
LBERR,	TAD	(ALPER3		/ILLEGAL CHAR IN # FIELD
	PUSHJ
	ERRMES
	JMP	INALPH
OPTLB,	TAD	LASTCH
	JMS I	(KEYPAD
KOBRMA,	"[-"A			/I'M RUNNING THROUGH A CONSTANT HERE!
	 TAD	LASTCH
	TAD	(-":
	CLL
	TAD	K15		/(":-"-
	SNL CLA		 	/IS IT BETWEEN "-" AND "9" INCLUSIVE
	JMP	LBERR
NOOPT,	TAD	LASTCH
	PUSHJ
	TTOCHR			/PRINT THE CHARACTER
	TAD	LASTCH
	PUTCHR			/PUT IT IN THE FIELD
	ISZ	MCHRCT
	JMP	INALPH
INALP3, PUSHJ
	INPUT			/IF IT RETURNS, TOO MANY CHARACTERS
	TAD	MCHRCT
	SZA CLA
	JMP	INALP2		/UNLESS HE TYPED A RUBOUT
	TAD	DEFOPT
	AND	MASKF		/OR IF HE DID NOT HAVE "F" OPTION
	SNA CLA
	JMP I	(TAB3		/NEXT FIELD, SAME FOR NUMERIC
	TAD	(ALPER2	 	/FIELD OVERFLOW
	PUSHJ
	ERRMES
	JMP	INALP3

/CHECK DIGIT AC=0 IF OK, AC<>0 IF NOT
CKDIG,	0
	AC7776
	MOVE			/MAKE SURE WERE AT THE BEGINNING OF THE FIELD
KM60,	SMA SNL CLA		/(CLA)
K15,	15			/(NOP)
	DCA	TEMP		/IN THE SPECIAL CASE OF AN EMPTY FIELD
	DCA	CHKSUM		/CLEAR OUT OLD CHECKSUM
	JMS	CHKNUM		/PRIME THE PUMP
	CLA CLL		 	/GET RID OF THE RUST
CHKD1,	JMS	CHKNUM		/ANYTHING THERE?
	CLL RAL		 	/*2 FOR EVERY OTHER DIGIT
	TAD	(-12
	SPA			/ > 9 ?
	TAD	(11		/ NO, RESTORE IT.
	CLL IAC		 	/YES, ADD 1 FOR THE CARRY
	ISZ	MCHRCT		/CHECK FOR FULL FIELD
	JMP	CHKD4		/MORE TO GO
CHKD2,	TAD	CHKSUM		/FIELD FULL,UPDATE THE CHECKSUM
	DCA	CHKSUM
	UDF
	TAD I	PTFD
DF208,	DF209
	AND	L77		/THIS IS THE EXTRA CHARACTER IF ANY
	SNA			/ANY THING THERE?
	JMP	CHKD5		/NO, LSTCHR HAS CHECK DIGIT
	TAD	KM60		/ONLY 0 OR 260-271 COULD HAVE BEEN THERE
	DCA	CHKNUM		/SAVE IT FOR A WHILE
CHKD3,	TAD	CHKSUM
	SNA			/0 CHECKSUM IS SPECIAL
	JMP	CHKD3B
	TAD	(-12
	SMA SZA
	JMP	.-2		/MAKE IT MODULO 10
CHKD3B,	TAD	CHKNUM
	JMP I	CKDIG		/IF OK AC SHOULD BE EQUAL TO ZERO
CHKD4,	JMS	CHKNUM
	ISZ	MCHRCT		/IS FIELD FULL AGAIN
	JMP	CHKD1		/NO, LOOP
	JMP	CHKD2		/YES
CHKD5,	TAD	LSTCHR
	DCA	CHKNUM
	JMP	CHKD3		/OK, NOW GET THE LAST DIGIT

CHKNUM, 0000
	TAD	CHKSUM
	DCA	CHKSUM		/UPDATE THE CHKSUM
	TAD	TEMP
	DCA	LSTCHR
	TAD	CHRNUM
	FETCHR
	TAD	(-237
	SNA
	JMP	CHKD5		/END OF DATA
	TAD	(237-260	/MAKE IT A REAL NUMBER
	DCA	TEMP		/SAVE IT HERE
	TAD	LSTCHR
	ISZ	CHRNUM
	JMP I	CHKNUM
CHKSUM, 0000
LSTCHR, 0000
PUTPUT,	PUTCHR			/CALLED FROM ANOTHER FIELD WITH PUSHJ
	POPJ
/
	PAGE

/%BLOCK 4
/INPUT, IGNORES ILLEGAL CHARACTERS AND TRANSFERS CONTROLL TO SPECIAL
/CHARACTER FUNCTIONS IF NEEDED, IT PUTS CHAR IN LASTCH AND AC.
INPUT,	TAD	LASTCH		/DO WE ALREADY HAVE AN INPUT?
INPUT1,	SZA CLA
	POPJ			/YES
INPUT2, PUSHJ			/NO, GET ANOTHER CHAR
	TTICHR
INPUT3,	DCA	LASTCH
	TAD	LASTCH
	TAD	KM240
	SPA
	JMP	CHKINP		/CHECK FOR SPECIAL CHAR
	TAD	(240-337
	SPA
	JMP	INPUT1		/" " THRU "^"
	SZA CLA			/"_" GETS SPECIAL TREATMENT
	JMP	INPUT4		/ASSUME RUBOUT (IF IT'S A LOWER CASE MACHINE TAPE THE SHIFT KEY DOWN)
	TAD	CHRNUM		/"_" MEANS USE CHARACTER THAT IS ALREADY
	FETCHR			/IN THE CURRENT FIELD.
	JMP	INPUT3		/A HANDY FEATURE WHEN INPUTTING A SEARCH KEY
INPUT4,	PUSHJ
	RUBOUT			/RUBOUT LAST CHAR (IF ANY)
	JMP	INPUT2		/GET ANOTHER CHAR
CHKINP, CLA CLL
	TAD	LASTCH
	TAD	(-210
NOTIT,	SPA CLA		 	/CLA FOR NOT IT
	JMP	INPUT2
	TAD	LASTCH
	TAD	(-215
KM240,	SMA SZA
	JMP	OTHER
GOTIT2, TAD	(TABEND	 	/210-215
	DCA	TEMP4
	AC7776			/REMOVE PUSHJ FROM STACK
	TAD	STACK
	DCA	STACK
	TAD I	TEMP4
	DCA	TEMP4
	DCA	LASTCH		/REMOVE THE SPECIAL CHARACTER
	JMP I	TEMP4

/TABLE FOR SPECIAL CHARACTERS
	LARROW
	TAB
	LINFED,	ISFOK
	DARROW
	FRMFED
TABEND, CARR
	CTRLU
	RARROW
	CTRLZ			/CLOSE FILE ON ^Z
	ESCAPE			/ALTMODE
	HOME
/OTHER CHECKS FOR OTHER SPECIAL CHARS NOT IN 210-215
OTHER,	AC0001
	DCA	TEMP3
	TAD	LASTCH
	TAD	(-225
	SPA
	JMP	NOTIT
	SNA
	JMP	GOTIT1
	ISZ	TEMP3
	TAD	(225-230
	SPA
	JMP	NOTIT
	SNA
	JMP	GOTIT1
	ISZ	TEMP3
	TAD	M2		/(230-232
	SPA
	JMP	NOTIT
	SNA
	JMP	GOTIT1
	ISZ	TEMP3
	TAD	M1		/232-233
	SNA
	JMP	GOTIT1
	ISZ	TEMP3
	TAD	M2		/(233-235
	SZA CLA
	JMP	INPUT2		/NOT A CONTROLLING CHAR IGNORE IT
GOTIT1, TAD	TEMP3
	JMP	GOTIT2

DF209,
ABORT,	DF210			/MAY BE ENTERED WITH NON-0 AC
	JMS I	(CLRSTK		/CLEAR THE STACK (AND THE AC)
	PUSHJ
	IOWAIT			/WAIT FOR THE DISK TO SETTLE
	PUSHJ
	CLOSE			/RELEASE THE LOGICAL UNIT (IF ANY ASSIGNED)
RESTRT, TAD	(OVEPAR-1	/ADDRESS OF OVERLAV PARAMITERS
	PUSHJ
	CALL			/READ IN THE OVERLAY
	AC0002
	TAD	USRCDF		/MAKE CDF CIF USRFLD
	DCA	.+1
	0000
	TAD	BASE
	TAD	L1400		/ALL OVERLAYS START AT BASE + 1400
	DCA	TEMP
	JMP I	TEMP
OVEPAR, 0000			/FILLED IN AT STARTUP TO LOW ORDER ADDRESS
	0400			/READ 4 PAGES, FIELD GETS SET UP IN CALL
	1400			/BUFFER 0
OVEPR3,	0000			/HIGH ORDER BLOCK NUMBER, FILLED IN AT STARTUP
/NEW FORM SETS UP TO RECIEVE A NEW RECORD
/IT ZEROS OUT THE Z OPTION FIELDS
NEWFRM, PUSHJ
	RESET
NEWLOP, SNA CLA
	JMP I	KESCAP
	TAD	DEFOPT
	AND	MASKZ		/CHECK FOR Z OPTION
	SNA CLA
	JMP	NOZ
	PUSHJ
	CLROUT			/CLEAR IT
NOZ,	PUSHJ
	NXTFLD			/NEXT FIELD
	JMP	NEWLOP		/IT WOULDN'T MAKE SENSE TO HAVE Z WITH D
DKQ5,	ZBLOCK 4;DKQ0
/
	PAGE

/RIGHT JUSTIFY NUMERIC FIELDS
/IF IN A CHECK DIGIT FIELD, DO THE CHECK DIGIT FIRST
RIGHTJ, 0000
	UDF
	AC0001
	TAD	PTFD
	DCA	TEMP		/PRESERVE PTFD
	TAD I	TEMP
	AND	L377		/GET EXTRA CHARACTER
	SZA CLA		 	/ANYTHING THERE?
	JMP	RJEXIT		/YES, NOTHING TO DO
	TAD	MCHRCT
	DCA	MSIZE		/AND HOW BIG THE FIELD IS
	DCA	DISPLA
	DCA	DISPLB
	DCA	MNUM		/SO A NULL FIELD GETS ZEROED PROPERLY
RJ2,	TAD	CHRNUM
	FETCHR			/GET A CHARACTER FROM THE FIELD
	TAD	R7523		/(-"-
	SNA			/IS IT A "-"
	JMP	RJ4		/YES, NO MORE CHARACTERS IN THE FIELD
	TAD	R16		/("--237
	SNA CLA		 	/IS IT A "00"
	JMP	RJ3		/YES, DITTO
	ISZ	CHRNUM		/NO, NEXT CHARACTER
	ISZ	MCHRCT		/AND CHARACTER COUNT
	JMP	RJ2		/GET NEXT CHAR AND CHECK
RJ3,	TAD	DEFOPT		/NO "-" SEEN
	AND	MASKC
	SNA CLA		 	/DOES IT HAVE THE CHECKDIGIT OPTION?
	JMP	RJ5		/NO
	TAD	MCHRCT		/YES
	CIA
	TAD	MSIZE
	SNA CLA		 	/IS IT AN EMPTY CHECK DIGIT FIELD?
	JMP	RJ9		/YES, FILL IT OUT WITH ZEROES
	STA
	TAD	CHRNUM
	DCA	CHRNUM		/NO, BUMP BACK CHARACTER NUMBER
	STA
	TAD	MCHRCT
	DCA	MCHRCT		/THIS TOO
RJ4,	TAD	CHRNUM
	FETCHR			/GET CHECKDIGIT OR MINUS SIGN
	EXTRA			/AND STORE IT IN THE EXTRA CHAR
RJ5,	TAD	JMPRJ6		/RESET THE LOOP
	DCA	RJ8
	TAD	MCHRCT
	SNA			/FIELD FULL?
	JMP	RJEXIT		/YES, ALL DONE
	CIA
	DCA	DISPLA		/DISPLACEMENT TO END OF FIELD
	AC7776

	TAD	MCHRCT
	DCA	DISPLB		/DISPLACEMENT BACK-1
	STA
	TAD	CHRNUM
	DCA	CHRNUM		/BUMP IT BACK TO THE LAST GOOD DIGIT
	TAD	DISPLA
	TAD	MSIZE
	SNA
	JMP	RJ9		/FIELD EMPTY, ZERO IT OUT
	DCA	MNUM		/-NUMBER TO MOVE
RJ6,	TAD	CHRNUM
	FETCHR			/PICK UP A CHAR
	DCA	TEMP5		/SAVE IT FOR	A WHILE
RJ7,	TAD	CHRNUM
	TAD	DISPLA
	DCA	CHRNUM		/WHERE IT GOES
	TAD	TEMP5
	PUTCHR			/MOVE IT THERE
	TAD	DISPLB
	TAD	CHRNUM
	DCA	CHRNUM		/GO BACK FOR ANOTHER
	ISZ	MSIZE		/ALL DONE?
	JMP	RJ11
RJEXIT,	UDF
	TAD I	PTFD
DF210,	DF212
	JMP I	RIGHTJ		/YES
RJ11,	ISZ	MNUM		/DONE MOVING?
RJ8,	JMP	RJ6		/NO
RJ9,	TAD	L260		/YES, FILL OUT THE REST WITH ZEROES
	DCA	TEMP5
	TAD	RJ10
	DCA	RJ8		/TIGHTEN UP THE LOOP
RJ10,	JMP	RJ7
MNUM,	0000
MSIZE,	0000
DISPLA, 0000
DISPLB, 0000
R7523,	7523
R16,	16
JMPRJ6, JMP RJ6

/CURLFT, MOVE CURSOR LEFT 1 CHAR
/IF AT BEGINNING OF THE FIELD ITS A NOP
/RUBOUT, WILL DELETE LAST CHAR TYPED (EXCEPT IF IT IS IN THE PREVIOUS FIELD)
/AND REPLACE THE CHARACTER ON THE VT05 WITH AN UNDERSCORE AND
/PUT 00 IN HIS FORM BUFFER (NOT A 0 OR "SPACE")
RUB2,	PUSHJ
	CURLFT			/MOVE CURSOR LEFT
	TAD	L337		/UNDERSCORE
	PUSHJ
RTTOCH,	TTOCHR
	TAD	L237
	PUTCHR			/PUT A 00 IN HIS FIELD, CURLFT
CURLFT, TAD	CHRNUM
	CIA
	DCA	TEMP3		/SAVE -CHAR #
	AC7776
	MOVE			/BACK TO THE BEGINNING OF THIS FIELD
	TAD	TEMP3		/COMPAIR IT WITH WHERE WE WERE
	SNA
	POPJ			/WAS AT THE BEGINNING NOP
	CMA			/DIFFERENCE -1
	DCA	TEMP3
	TAD	TEMP3
	TAD	CHRNUM		/WHERE WE WERE -1
	DCA	CHRNUM
	TAD	TEMP3
	TAD	MCHRCT		/NOW UPDATE CHAR COUNT
	JMP	CURL2		/CURSOR LEFT AGAIN
RUBOUT, TAD	MCHRCT
	SPA SNA CLA		/IS IT A 1 (AT EXTRA CHARACTER)?
	JMP	RUB2		/NO, NORMAL RUBOUT
	EXTRA			/YES, CLEAR THE EXTRA CHARACTER
	TAD	L0010		/MOVE CURSOR LEFT
	PUSHJ
	TTOCHR
	TAD	L337
	PUSHJ
	TTOCHR			/PRINT _
CURL2,	DCA	MCHRCT		/MAKE THE 1 A 0 FOR LASE CHARACTER
	TAD	L0010		/MOVE CURSOR LEFT AGAIN
	JMP I	RTTOCH

/RMN CHECKS TO SEE IF A "NUMBER" IS WITHIN A CERTAIN RANGE
/IT IS CALLED WITH A JMS, AND IT EXITS WITH AC = + IF FIELD IS LESS
/THAN M, 0 IF IT IS EQUAL TO OR WITHIN THE RANGE OF M OR N
/AND - IF GREATER THAN N.
/ENTER WITH AC = 7777 FOR A RANGE CHECK, AC <> 7777 FOR SEARCHES
/AND PUT A JMP I RMN AT RMNUPD FOR SEARCHES
/%BLOCK 5
RMNCT,	0
RMN,	0000
	DCA	RMNFLP		/SET FLIP/FLOP
	TAD	KSPA
	DCA	RMNBR
	AC7776
	TAD	BASE
	CIA CLL			/CLEAR THE LINK SO THE RAL CAN HAVE A CML
	TAD	PTFD		/PTFD+2-BASE (RELATIVE WORD FROM BASE TO FIRST CHAR IN M)
	CML RAL		 	/CHARACTER NUMBER OF FIRST CHAR IN M 
RMN1,	DCA	TEMP4
	TAD	MCHRCT
	DCA	RMNCT
	TAD	CHRNUM
	DCA	TEMP5
RMN2,	TAD	TEMP5
	FETCHR
	TAD	(-"?		/WILDCARD CHAR FOR UPDATE
	SNA
	JMP	RMNSKP		/ IGNORE "?" CHARACTERS AND FORCE A MATCH
	TAD	("?
	CIA
	DCA	TEMP3
	TAD	TEMP4
	FETCHR
	TAD	TEMP3
RMNBR,	SPA
RMNUPD,	JMP	RMNOK		/ON GOOD SIDE OF M OR N
	SZA
	JMP I	RMN		/NOT IN RANGE, EXIT WITH AC <> 0
RMNSKP,	ISZ	TEMP4
	ISZ	TEMP5
	ISZ	RMNCT
	JMP	RMN2
	JMP I	RMN		/= M OR N
RMNOK,	CLA CLL
	ISZ	RMNFLP
	JMP I	RMN		/IN RANGE EXIT WITH AC=0
	TAD	KSMSZA
	DCA	RMNBR
	TAD	RMNCT
	CIA
	TAD	TEMP4
	JMP	RMN1
RMNFLP, 0

/CTRLZ, CLOSES FILE WHEN ^Z IS TYPED
CTRLZ,	PUSHJ
	CONFRM
KOPRN,	SNA			/IT WILL LOOK LIKE AN "(" WHEN TYPED
	JMP	CTRLZY		/YES,HE WANTS TO ABORT
	TAD	("Y		/RESTOR THE CHAR
	JMS I	(KEYPAD		/SEE IF ITS A NUMBER
KSPA,	SPA			/YES (AC ALWAYS = 0 SO SKIP)
	JMP I	KESCAP		/NO, HE DOESN'T WANT TO ABORT
	TAD	LASTCH
	AND	L17		/GET THE NUMBER OF THE T(N) REGISTER
	CLL RTL
	RTL			/*20
	TAD	(400-120^2	/THIS SHOULD BE THE OVERFLOW CHARACTER OF T(N)
	DCA	CHRNUM		/SAVE IT FOR TYPE OUT
	TAD	(-17
	DCA	MCHRCT		/16 CHARACTERS TO TYPE OUT
	PUSHJ
	ROW20
	TAD	("T
	PUSHJ
PTTOCH,	TTOCHR
	TAD	KOPRN		/("(
	PUSHJ
	TTOCHR
	TAD	LASTCH
	PUSHJ
	TTOCHR
	TAD	(")
	PUSHJ
	TTOCHR
	TAD	("=
	PUSHJ
	TTOCHR			/WHAT A WASTE OF CORE TO PRINT OUT "T(N)="
	PUSHJ
	LSTFLD			/NOW OUTPUT T(N)
	TAD	TEMP3		/LEFT OVER FROM SAS
	AND	L237
	TAD	L237
	PUSHJ
	TTOCHR			/TYPE OUT JUST THE NUMBER
	TAD	TEMP3
	AND	L0040		/CHECK FOR "-" SIGN
KSMSZA,	SMA SZA			/DUMMY SMA FOR THE CONSTANT
	TAD	("--40		/NOW REMOVE THE LEFT OVER 40
	PUSHJ
	TTOCHR			/TYPE EITHER "-" OR ""
	PUSHJ
	CRWAIT			/WAIT FOR A CR
	JMP	CTRLZ		/AND TRY AGAIN

CTRLZY,	TAD	BASE
	TAD	L1000		/MAKE POINTER TO WORD COUNT FOR RECORD IMMAGE
	DCA	TEMP2
	UDF
	DCA I	TEMP2		/MAKE WORD COUNT =0
DF212,	DF213
	JMS I	(CLRSTK		/CLEAR STACK...WE CAN OVERFLOW IF WE DON'T (GUESS HOW WE KNOW)
	TAD	UPDSIZ		/SEE IF WE WERE IN UPDATE MODE
	SZA CLA
	JMP I	(UPDCLO		/DO CLOSE ON UPDATE
	PUSHJ			/WRITE WILL CLOSE THE FILE
	WRITE
	JMP I	KABORT		/GO ASK HIM WHICH FORM
/HOME, CLEAR ALL FIELDS EXCEPT AUTO DUP AND REPOSITION AT THE
/BEGINNING OF THE CURRENT RECORD
/SAME AS UP ARROW
HOME,	PUSHJ
	RESET
	CLA CLL
	PUSHJ
	CLEARA			/CLEAR ALL EXCEPT AUTO-DUP
	JMP I	KESCAP		/TAKE THIS LINE OUT FOR SPECTACULAR CRASHES!
/
PAGE

/ADD CURENT FIELD TO A T REGISTER.
/ENTER WITH FIELD SETUP AND N*20 OF T(N) IN AC
DECADD,	0000
	TAD	BASETN		/BASE OF T REGISTERS+20-1
	DCA	LASTTN		/SAVE CHARACTER NUMBER OF LAST DIGIT
	AC7776
	MOVE			/MAKE SUR IT DOESN'T GET YOU
	CIA
	TAD	MCHRCT
	CMA
	DCA	FLDARG		/SAVE CHARACTER NUMBER OF LAST CHAR IN FIELD
	TAD	LASTTN
	DCA	CHRNUM		/SETUP FOR PUTCHR
	TAD	CHRNUM
	FETCHR
	AND	L0100		/PICK UP SIGN OF T(N)
	CLL RAR			/MAKE 100 A 40
	DCA	TEMP3		/(P THROUGH Y ARE NEGATIVE NUMBERS)
	TAD	FLDARG
	FETCHR
	AND	L0100
	CLL RAR
	CIA
	TAD	TEMP3
	DCA	TEMP4		/0 IF SAME SIGN
	TAD	(-17
	DCA	CIFT		/AS GOOD AS TEMP AS ANY
	DCA	CARRY
LP,	TAD	MCHRCT
	SMA CLA			/ANYTHING LEFT OF THIS FIELD?
	JMP	DEND		/NO, DON'T BOTHER WITH THE FETCHR
	TAD	FLDARG
	FETCHR
	AND	L17		/STRIP OFF THE NUMBER
DEND,	TAD	CARRY
	DCA	TEMP5		/HOLD IT FOR A WHILE
	DCA	CARRY
	TAD	TEMP4		/ARE SIGNS ALIKE?
	SNA CLA
	JMP	ADD		/YES
SUBT,	TAD	CHRNUM
	FETCHR
	AND	L17
	CIA
	TAD	TEMP5
	CIA
	SMA			/<0?
	JMP	ELP		/NO
	ISZ	CARRY		/YES, SET THE CARRY BIT
ADD2,	TAD	ADD12
	JMP	ELP

ADD,	TAD	CHRNUM
	FETCHR
	AND	L17
	TAD	TEMP5
	TAD	(-12		/SEE IF G.T. 10
	SPA
	JMP	ADD2		/NO, RESTORE IT
	ISZ	CARRY
ELP,	TAD	L260
	PUTCHR
	AC7776			/PUTCHR ISZ'S CHRNUM
	TAD	CHRNUM
	DCA	CHRNUM
	AC7777
	TAD	FLDARG
	DCA	FLDARG
	ISZ	MCHRCT
ADD12,	12			/NOP IN CASE OF SKIP
	ISZ	CIFT		/AS GOOD AS TEMP AS ANY
	JMP	LP		/LOOP 15 TIMES
	TAD	CARRY		/SEE IF ANY CARRY
	SNA CLA
	JMP	SETSGN		/NO, SET THE SIGN AND EXIT
	TAD	TEMP4
	SNA CLA			/ARE SIGNS ALIKE?
	JMP	OVFLO		/YES, SET OVER FLOW
	TAD	TEMP3		/NO, COMPLIMENT SIGN OF T(N)
	CIA
	TAD	L0040
	DCA	TEMP3
	DCA	CARRY		/AND CLEAR OUT THE CARRY
	TAD	(-17
	DCA	CIFT		/AS GOOD AS TEMP AS ANY
	TAD	LASTTN
	JMP	COMLP1

COMLP,	AC7776
	TAD	CHRNUM
COMLP1,	DCA	CHRNUM
	TAD	CHRNUM
	FETCHR
	AND	L17
	TAD	CARRY
	SNA
	ISZ	CHRNUM		/FAKE A PUTCHR
	SNA
	JMP	COMLP2
	CIA
	TAD	(272
	PUTCHR
	AC0001
	DCA	CARRY
COMLP2,	ISZ	CIFT		/AS GOOD AS TEMP AS ANY
	JMP	COMLP
	TAD	CARRY
	SNA CLA
	DCA	TEMP3
SETSGN,	TAD	LASTTN
	DCA	CHRNUM
	TAD	CHRNUM
	FETCHR
	AND	L237
	TAD	L0040
	TAD	TEMP3		/MAKES IT A 000 010 11X XXX (I HOPE)
	PUTCHR
	JMP I	DECADD
OVFLO,	TAD	("*		/TO INDICATE OVERFLOW
	PUTCHR
	JMP I	DECADD
BASETN,	400-120^2+20-1		/SHOULD = LAST CHAR # OF T(0)
LASTTN,	0000
CARRY,	0000
FLDARG,	0000
MISFOK,	CDF 0;	E16		/"IS FORM OK? "
/
PAGE

/%BLOCK 6
TABKEY, -"M
	"M-"J
	"J-"K
	"K-"L
	"L-"U
	"U-"I
	"I-"O
IFNZRO TABKEY&377 <???>		/MUST BE AT BEGINNING OF BLOCK
KEYPAD, 0000			/NUMERIC KEY PAD INPUT
	DCA	LASTCH		/SAVE THE ASCII CHARACTER
	TAD	(-7
	DCA	MTT		/M,J,K,L,U,I,O
	TAD	(TABKEY-1
	DCA	XR14
	TAD	LASTCH
	TAD	(-":
	CLL
	TAD	L12
	SZL CLA		 	/0-9?
	JMP I	KEYPAD		/YES
	TAD	LASTCH
KEYLUP, TAD I	XR14
	SNA			/IS THIS THE ONE?
	JMP	GOTKEY		/YES
	ISZ	MTT
	JMP	KEYLUP		/MORE TO CHECK
	ISZ	KEYPAD		/NOT A NUMBER
	TAD	(31		/RESTORE IT TO ITS PRISTEEN PURENESS
GOTKEY,	TAD	XR14		/THAT'S WHY TABKEY MUST BE AT BEGINNING OF PAGE
	TAD	L260
	AND	L377
	DCA	LASTCH
	JMP I	KEYPAD

/ROUTINE TO OPEN A DATA FILE FOR OUTPUT OR UPDATE
/PUT THE FILE LABEL IN THE APPROPRIATE SLOT IN THE "LABELS" TABLE
/(-237 ASCII, FILLED OUT WITH SPACES).
/SET W5 BITS 6-11 TO THE SEQUENCE # -1 (I.E. 0 IF STARTING AT 1)
/SET AC TO TRIAL LOGICAL UNIT # OR 0 IF NONE + CORRECT OVERLAY OFFSET IN BITS 0-2
/THIS ROUTINE CALLS THE "MOUNT" OVERLAY INTO THE JOB'S I/O BUFFERS
/TO ACTUALLY DO THE MOUNT PROCESSING.
/OVERLAY OFFSETS ARE:
/OUTPUT		0	IF FIRST CALL, 0400 IF CALLED FROM "WRITE"
/UPDATE		1000
/INQUIRY	1400
/APPEND		2000
/LOGIN		4000
/BIT 3 IS SPECIAL FUNCTION BIT, TO BE TESTED BY OVERLAYS IF DESIRED.
/FOR EXAMPLE, THE "OUTPUT" OVERLAY USES IT TO SEE WHO CALLED- THE INITIAL
/MOUNT-THE-FIRST-UNIT ROUTINE OR THE "GPBUF" ROUTINE.
START,	AC4000			/TO START CALL IN LOGIN
INITMT,	DCA	T4		/SAVE (MAYBE) TRIAL UNIT
	TAD	BASE		/FIGURE OUT WHERE JOB'S I/O BUFFERS ARE
	TAD	L1400		/I/O BUFFERS ARE BLOCKS 4-5 OF USER AREA
	DCA	T2
	TAD	T2
	DCA	ARG3A		/MOUNT OVERLAY READS INTO THERE
	TAD	USRCDF
	AND	L70		/USER'S FIELD BITS
	TAD	L0400		/TO READ 2 BLOCKS
	DCA	ARG2A
	TAD	T4		/GET OVERLAY OFFSET + (MAYBE) TRIAL UNIT
	AND	K7200		/MASK OFF TRIAL UNIT AND SPECIAL FUNCTION SWITCH (BIT 3)
	CLL			/BIT 4 SHOULD ALWAYS = 0
	TAD	MTPARM		/ADD IN BASE BLOCK # OF OVERLAYS
	DCA	ARG1A
	RAL			/GET (MAYBE) BLOCK # CARRY
	TAD	MTHIBL
	DCA	ARG4A
	IOF
	JMS I	SYSQ		/GO GET MOUNT OVERLAY
	PUSHJ
	IOWAIT			/GO AWAY UNTIL IT GETS HERE
	AC0001
	TAD	USRCDF		/FORM CIF TO USER FIELD
	DCA	MTT
MTT,	0
	TAD	T4		/GET TRIAL UNIT + OFFSET + FUNCTION BIT
	JMP I	T2		/GO TO THE MOUNT OVERLAY
MTPARM,	0			/LOW BLK # FILLED IN AT INIT TIME
MTHIBL,	0			/HIGH BLK # FILLED IN AT INIT TIME

UPDIF,	PUSHJ
	READ
	SNA			/ANY RECORDS?
	JMP I	(UPDIFN		/NO
	DCA	PTFD		/ABSOLUTE POINTER-2 OF RECORD
	TAD	UPDSIZ
	CLL RAL			/MAKE -WC INTO -CHAR COUNT
	DCA	MCHRCT
	TAD	(2002		/FIRST CHAR IN RECORD IMMAGE
	DCA	CHRNUM		/FIRST CHARACTER IN RECORD IMMAGE BLOCK
	TAD	(RMN&177+5600
	DCA I	(RMNUPD		/SET UP FOR SEARCH
	JMS I	(RMN
	SZA			/WAS IT EQUAL?
	POPJ			/NO, LET WHOEVER CALLED ME FIGURE OUT WHAT TO DO.
	TAD	MCHRCT		/THIS GIVES THE CHARACTER #...
	TAD	TEMP4		/LOOK AT RMN TO FIGURE THIS OUT
	TAD	(-2002		/DISPLACEMENT FROM RECORD IMAGE TO SEARCHED RECORD
	DCA	UPDDIS		/SET IN THE UPDATE DISPLACEMENT
	PUSHJ
	LISTIT			/LIST ENTIRE FORM
	TAD	UPDWRT
	SPA CLA			/IS HE IN UPDATE OR INQUIRY MODE?
	JMP	UPDWT		/INQUIRY MODE
	PUSHJ			/YES, LET HIM UPDATE IT
	ESCAPE
	JMP	UPDXIT
UPDWT,	PUSHJ
	CRWAIT
UPDXIT,	POP			/GET FROM WHERE WE CAME
	DCA	TEMP		/SAVE IT
	POP			/DO THE REST OF THE FAKE POPJ
K7200,	CLA
	TAD	TEMP
	TAD	(-GUPDT-1	/GO TO UPDT
	SNA CLA
	JMP I	(UPDT
	JMP I	(UPDTBR

LISTIT,	PUSHJ			/LIST ENTIRE FORM
	RESET			/SET UP TO THE FIRST FIELD
LISTL,	SNA CLA			/ALL DONE TYPING OUT RECORD?
	POPJ			/YES
	PUSHJ
	CAD2			/NO, POSITION CURSOR TO TYPE OUT THE FIELD
	PUSHJ
	LSTFLD			/TYPE OUT THE FIELD
	MOVE			/AND GO TO THE NEXT FIELD
	JMP	LISTL
/
	PAGE

/DEFINITIONS OF SWAP AREAS FOR MULTI-JOB SETUP.  IF ONLY ONE
/FOREGROUND JOB IS ACTIVE, THIS AREA IS USED FOR ITS BUFFERS.
J0SAVE, 0
	0
	STACK0+2
TLS0LC, TLS0
	OBUF0
	IBUF0-1
	TTCTS
	TTCTS+JOBMAX+1
BASE0,	0		/BASE ADDR OF JOB 0, NOT USED
	ZBLOCK MASK-BASE-1
MASK0,	JMSKTB
	ZBLOCK USRCDF-MASK-1
USR0DF, 0		/CDF USER AREA, NOT USED
/
J1SAVE, 0
	0
	STACK1+2
TLS1LC, TLS1
	OBUF1
	IBUF1-1
	TTCTS+1
	TTCTS+JOBMAX+1+1
BASE1,	400		/BASE ADDR OF JOB 1.
	ZBLOCK MASK-BASE-1
MASK1,	JMSKTB+1
	ZBLOCK USRCDF-MASK-1
USR1DF, 0
/
J2SAVE, 0
	0
	STACK2+2
	TLS2
	OBUF2
	IBUF2-1
	TTCTS+2
	TTCTS+JOBMAX+1+2
BASE2,	400^5+400
	ZBLOCK MASK-BASE-1
MASK2,	JMSKTB+2
	ZBLOCK USRCDF-MASK-1
/%BLOCK 7
USR2DF, 0
/

J3SAVE, 0
	0
	STACK3+2
	TLS3
	OBUF3
	IBUF3-1
	TTCTS+3
	TTCTS+JOBMAX+1+3
BASE3,	400^5^2+400
	ZBLOCK MASK-BASE-1
MASK3,	JMSKTB+3
	ZBLOCK USRCDF-MASK-1
USR3DF, 0
/
J4SAVE, 0
	0
	STACK4+2
	TLS4
	OBUF4
	IBUF4-1
	TTCTS+4
	TTCTS+JOBMAX+1+4
BASE4,	400
	ZBLOCK MASK-BASE-1
MASK4,	JMSKTB+4
	ZBLOCK USRCDF-MASK-1
USR4DF, 0
/

J5SAVE, 0
	0
	STACK5+2
	TLS5
	OBUF5
	IBUF5-1
	TTCTS+5
	TTCTS+JOBMAX+1+5
BASE5,	400^5+400
	ZBLOCK MASK-BASE-1
MASK5,	JMSKTB+5
	ZBLOCK USRCDF-MASK-1
USR5DF, 0
/
J6SAVE, 0
	0
	STACK6+2
	TLS6
	OBUF6
	IBUF6-1
	TTCTS+6
	TTCTS+JOBMAX+1+6
BASE6,	400^5^2+400
	ZBLOCK MASK-BASE-1
MASK6,	JMSKTB+6
	ZBLOCK USRCDF-MASK-1
USR6DF, 0
/

/STACKS FOR MULTIPLE FOREGROUND JOBS RUNNING.  IF ONLY ONE
/FOREGROUND JOB IS RUNNING, THIS AREA IS USED FOR ITS BUFFERS.
STACK0,	0			/WE KNOW THAT STACK 0 WILL NOT HAVE MORE THAN 5 ENTRIES
	0			/CIF CDF 0
	7600
	ZBLOCK STKSIZ-3-JOBMAX-1
JMSKTB,	0+OFFBIT		/RESTART CONDITION WORDS FOR ALL JOBS IN EXTRA STACK 0 SPACE
	0+OFFBIT
	0+OFFBIT
	0+OFFBIT
	0+OFFBIT
	0+OFFBIT
	0+OFFBIT
STACK1,	0
ID201,	ID202
	START
	ZBLOCK STKSIZ-3
STACK2,	0
ID202,	ID203
	START
	ZBLOCK STKSIZ-3
/%BLOCK 10
STACK3,	0
ID203,	ID204
	START
	ZBLOCK STKSIZ-3
STACK4,	0
ID204,	ID205
	START
	ZBLOCK STKSIZ-3
STACK5,	0
ID205,	ID206
	START
	ZBLOCK STKSIZ-3
STACK6,	0
ID206,	ID207
	START
	ZBLOCK STKSIZ-3

DDWAIT,	0			/MASS STORAGE "REQUESTS PENDING" FOR EACH JOB
	0			/ 0 = DONE
	0			/ + = OPERATION PENDING
	0			/ - = ERROR
	0
	0
	0
TTLIST,	TSF0			/TABLE OF IOTS
	TSF1
	TSF2
	TSF3
	TSF4
	TSF5
	TSF6
	0
	KSF0
	KSF1
	KSF2
	KSF3
	KSF4
	KSF5
	KSF6
	0
SAVTBL,	J0,	J0SAVE-1	/THE ADDRESS OF EACH JOB'S SAVE AREA
	J1,	J1SAVE-1
	J2,	J2SAVE-1
	J3,	J3SAVE-1
	J4,	J4SAVE-1
	J5,	J5SAVE-1
	J6,	J6SAVE-1
TTCTS,	0			/COUNTERS FOR OUTPUT BUFFERS
	0
	0
	0
	0
	0
	0
	0			/COUNTERS FOR INPUT BUFFERS
	0
	0
	0
	0
	0
	0

/FILE LABEL FOR EACH JOB'S FILE GOES HERE
/JOB ZERO DOESN'T HAVE ONE - IT USES FIELD ZERO'S MOUNT AND RDOIO
/
LABEL1,	ZBLOCK 3
	0104		/" #"
SEQ1,	0		/"XX"	(SEQUENCE #)
	0100		/0 FOR BENEFIT OF PRINT ROUTINE
LABEL2,	ZBLOCK 3
	0104
SEQ2,	0
	0100
LABEL3,	ZBLOCK 3
	0104
SEQ3,	0
	0100
LABEL4,	ZBLOCK 3
	0104
SEQ4,	0
	0100
LABEL5,	ZBLOCK 3
	0104
SEQ5,	0
	0100
LABEL6,	ZBLOCK 3
	0104
SEQ6,	0
	0100
TTPTRS,	OBUF0-1			/TTY OUTPUT "GET" PTRS
	OBUF1-1
	OBUF2-1
	OBUF3-1
	OBUF4-1
	OBUF5-1
	OBUF6-1
	IBUF0			/KBD INPUT "PUT" PTRS
	IBUF1
	IBUF2
	IBUF3
	IBUF4
	IBUF5
	IBUF6
/
	PAGE

/%BLOCK 11
IFZERO .&4000 <???>	 /ERROR! BUFFERS MUST BE ABOVE 4000
OBUF0,	ZBLOCK TTOSIZ^4;OBUF0		/TTY OUTPUT BUFFERS
OBUF1,	ZBLOCK TTOSIZ^4;OBUF1
OBUF2,	ZBLOCK TTOSIZ^4;OBUF2
OBUF3,	ZBLOCK TTOSIZ^4;OBUF3
OBUF4,	ZBLOCK TTOSIZ^4;OBUF4
OBUF5,	ZBLOCK TTOSIZ^4;OBUF5
OBUF6,	ZBLOCK TTOSIZ^4;OBUF6
IBUF0,	ZBLOCK TTISIZ^2;IBUF0		/KBD INPUT BUFFERS
IBUF1,	ZBLOCK TTISIZ^2;IBUF1
IBUF2,	ZBLOCK TTISIZ^2;IBUF2
IBUF3,	ZBLOCK TTISIZ^2;IBUF3
IBUF4,	ZBLOCK TTISIZ^2;IBUF4
IBUF5,	ZBLOCK TTISIZ^2;IBUF5
IBUF6,	ZBLOCK TTISIZ^2;IBUF6
/
/%BLOCK 12 AT 4400
/END OF FGBG3.PA