Directory of image this file is from
This file as a plain text file

*20
	/LIFE MAINLINE PROCESSING
	/START DISPLAY INTERPRETATION
SEGMNT 4
*17
FLDZ0,	6201		/CDF 1-DORA
	/LOC 21-24 ARE DORETTE PTRS
*26
INITDL,	LDF 7
	RDC
	6322
	RDC
	7323
	PDP
	PMODE
	KCC
	TLS
	LINC
	LMODE
	JMP STRT
	/CONSTANTS, TEMP STOR, REF, FLAGS
DIAL77,	7777
	READ=7774
	WRITE=7775
RTN,	RETURN	/RETURN, INIT TP
PREAD,	READ
PWRITE,	WRITE
	/PARAMETERS - BLOCK 0
PARA0,	0	/TAPE UNIT - SETFROM QUANDA
	34	/CORE LOCATION - B7Q0
	0	/ST BLK
	1	/BLKS
NAMETP,	0	/4 CHAR TAPE NAME
	0
NUMDIS,	6777		/- NUM PTS DISP
	/DO SUBROUTINE IN B6 - PTRS 10,11
DOSUB,	ROL I 1		/SAVE BIT 0
	ROR 1
	SCR 13
	LDA
	0
	STA
	11	/RETURN JUMP TO MAINLINE CALL
	BCL I
SPCCST,	6000	/CONSTANT IN SPCSR ROUT
	STC 10
	LDF 4
	LDA 10	/CONTENTS OF NEXT LOC - JUMP SUB
	XSK I 11
	LIF 6
	JMP B6CALL
	JMP 11
	/PARAMETERS - REST OF LIFE TAPE
PARA,	0	/TAPE UNIT - SET FROM QUANDA
	35	/CORE LOCATION - B7,Q
	0	/ST BLK - SET FROM SUBROUTINES
	1	/BLKS
NUMPT4,	0	/PARAPTS
NUMPAR,	0	/DATA PARA
INSTNM,	0	/4 CHAR INST NAME
	0
FSTBLK,	0	/FIRST BLK OF INST
M2,	7775	/CONSTS
P1B4,	0001
ERAST,	0
	/SUBROUTINE - CHECK IF LIFE TAPE
	/PTRS 5,6,7 BLOCK 0 OF LIFE TAPE IN B7Q1
	/IF LIFE, BUMP RET, ELSE NOT
CKTPIN,	LDA I	/SET FOR FIRST 8 WORDS
	2377
	STC 6
	SET I 5
	7767	/IN QUARTER1 B7
	LDF 7
	JMP 0
CKTP,	SET 7	/THIS MUST ALSO BE CALLED *
	0
	LDA I 5	/GET NEXT WD
	LDA I 6
	SAE
	5	/IS IT CORRECT
	JMP 7	/NO, GET OUT
	XSK 5	/YES, OVER?
	JMP CKTP+2
CKTPB,	XSK I 7	/YES, BUMP, EXIT
	JMP 7
	/SUBROUTINE TO INITIALIZE LIFE TAPE - OR DELETE ALL
	/SET UP BLK 0 IN B3Q0
INTP,	SET 7	/SET PTRS
	0
	JMP CKTPIN
INTPA,	LDA I 5	/STORE 7770-7777
	LDA
	5
	STA I 6
	XSK 5
	JMP INTPA
INTPB,	CLR	/WHEN FINISHED, STORE REST AS 0
	STA I 6
	LDA
	6
	SAE I
	2777
	JMP	INTPB
	/STORE DAD NULL FOR BLK0, TRAILER
	CLR
	BSE I	/TRAILER
	77
	STA 6
	LDA	/BLK0
	2725
	BSE I
	4000
	STA
	2725
	JMP 7
EJECT
	/SUBROUTINE SET TO ERASE AN INSTRUMENT
	/B0 IN BNK 7 Q0
	/SUB1 - IDENTIFY INSTRUMENT, GET STARTING BLOCK
	/RET IF NONE, BUMP IF FOUND, 2 BUMPS IF OVERFLOW. PTR6 HAS 0 OR 7777
ER1,	SET I 6
	2006
	XSK I 6
	XSK I 6
	SET 7
	0
ER0C,	LDF 7
ER1A,	LDA 6	/IS THIS END - NEXT WD 0
	AZE I
	JMP 7	/YES, ERROR RETURN, PTR6 HAS FIRST 0
	/COMPARE FIRST 2 CHAR
	SAE
	INSTNM
	JMP ER1B
	LDA I 6
	SAE
	INSTNM+1
	JMP ER1B+1
	LDA I 6	/MATCH MADE, GET FIRST BLK
	BCL I
	6000
	STC	FSTBLK
/MATCH MADE,STORE NUM PARA
	LDA 6
	ROL 2
	BCL I
	7774
	LDF 6
	STA
	PRMTRS+2000
	LDF 0
	STA
	NUMPRA+2000
	STC NUMPAR
	LDF 7
	JMP ER1C
ER1B,	XSK I 6	/GET TO NEXT INSTRUMENT
	XSK I 6
	XSK I 6
	LDA I
	5457	/MAKE SURE INDEX DOES NOT OVERFLOW
	ADD 6
	APO
	JMP ER1A	/OK, RETURN
	CLR
	XSK I 7
ER1C,	XSK I 7
	JMP 7	/INDEX OVERFLOW, 2 BUMPS
	/SUBROUTINE FOR MATCH SEARCH OF TAPE INDEX
	/MATCH - 0 BUMPS, OVERFLOW - 1 BUMP, NO MATCH - 2 BUMPS
ER0,	SET 4
	0
	JMP ER1	/JUMP MATCH
	JMP .+4
	JMP 4	/IF MATCH, 0 BUMPS
ER0A,	XSK I 4	/IF OVERFLOW
	JMP 4
	APO	/IF NO MATCH, CHECK FOR 7777
	JMP ER0B	/YES, RETURN
	XSK I 4
	JMP ER0A	/NO MATCH, 2 BUMPS
ER0B,	XSK I 6
	XSK I 6
	XSK I 6
	JMP ER0C	/REENTRENT TO ER0
	/SUB2 - DELETE INSTRUMETNT, GIVEN ST BLK
	/PTR6 AT FST BLK OF INSTRUMENT
ER2,	CLR
	ADD	 FSTBLK
ER2A,	STC PARA+2	/SETUP READ PTRS
	LDF 7
	JMP ER2S1	/SUB SUB TO CLR BIT COORESP TO WD IN PARA+2
	ADD PARA+2
	JMP DOSUB
	JMP RDTAPE	/DO TPAPEREAD OF NEXT BLK
	LDA	/WAS THIS THE LAST BLK
	2777
	AZE
	JMP ER2A	/NO, CLR NEXT DAD BIT
	ADD M2
	ADD 6	/YES, STORE 7777 IN INDEX FILE
	STC 6
	COM
	STA 6
	STA I 6
	STA I 6
ER2RTN,	JMP DOSUB	/JUMP WRITE UNIT 0
	JMP WTUN0
	JMP STRTB
	/SUB SUB TO CLR BIT COORSP TO WD IN PARA 2
ER2S1,	LDA
	0
	STC ER2SRT
	STC 4	/WD CNT
	ADD PARA+2
	STC ERAST
	SET I 5	/-12 BITS
	7763
ER2S2,	ADD ERAST	/GET PROPER WD
	ADD 5
	AZE I
	CLR
	APO
	JMP ER2S3	/AT WD
	XSK I 4
	STC ERAST
	JMP ER2S2
	/AT WD, ROTATE 0001 LEFT 1 BIT FOR EVERY NEG INT FROM 12 DIV
ER2S3,	STC 7
	ADD P1B4
	ROL 1
	XSK I 7
	JMP ER2S3+2
	ROR 1
	STC 7	/PROPEL BIT MASK SET
	ADD 4
	ADA I	/START OF DAD IN BLK 0
	2324
	STC 4	/SET FIRST LOC OF BIT MAP
	LDA I 4
	BCL	/DO BIT CLEAR
	7
	STA 4
	CLR
ER2SRT,	RETURN
	/SUBROUTINE TO PRINT SPECTRUM DATA
	/PTRS 10, 11, 12, 1, 13-17 USED IN SUBSUB
	/HEADER ALREADY ASSUMED PRINTED
	/B0 IN B7Q0
	/AC=0 IF NO MATCH, =4000 IF MATCH
	/4 CHAR NAME IN INSTNM
TYC,	SET 5 		/SAVE RET
	0
	JMP ER0	/FIND INSTRUMENT
	JMP TYCA	/MATCH, DO PRINTOUT
	NOP	/OVERFLOW ILLEGAL
	JMP 5	/NO MATCH, EXIT
TYCA,	ADD FSTBLK
	LIF 6
	JMP TYC1
	EJECT
	/SUBROUTINE TO PRINT ALL MATCHING LIBRARY CURVES
	/FOR UNKNOWN SPECTRUM IN B0
	/INSTNM BUFFER SET UP
	/AC=0, NO MATCH ON INST, A NOT=0, OK
	/ALL PARA IN B0, B4, B6 ASSUMED SET UP
LBPR,	LDA
	0
	STC LBPRRT
	JMP ER0	/GET FIRST BLOCK OF INSTRUMENT
	JMP LBPRA
	NOP
LBPRRT,	RETURN
LBPRA,	ADD FSTBLK
	JMP DOSUB
	JMP RDTAPE	/READ IN FIRST DATA BLK
	LIF 6
	JMP LBPRB	/GO TO B6 FOR PRINTOUT
*400
BUFB4,	0
*415
	/SUBROUTINE TO DELETE A SPECTROM
	/WHOSE NAME IS IN TYO7A OF B5
	/AC=0 IF DELETED, AD - IF NO INST, + IF NO SPECTRA
DELSP,	LDA
	0
	STC DELSRT
	JMP ER0	/GET FIRST BLOCK
	JMP DELSPA
	NOP
	ADD SPCCST
DELSRT,	RETURN	/ERROR, NOT FOUND, AC NEG
DELSPA,	ADD FSTBLK
	JMP DOSUB	/READ IN FIRST DATA BLOCK FIND MATCH
	JMP FNDSPB
	AZE
	JMP DELSRT	/RETURN, NO SPEC MATCH, AC +
	/MATCH, DELETE SPEC
	/PTR 16 AT LAST SPEC WD
DELSPC,	NOP
	NOP
	CLR		/AT FRST TAPE CHARS
	LDF 6	/STORE 0 IN LOC
	LDA
	2016
	STC 3
	LDF 7
	STA 3
	ADD PARA+2
	JMP DOSUB
	JMP WTTAPE	/WRITE IT
	JMP DELSRT	/RETURN OK, AC=0
	/B4 PART OF B6 SUB TO STORE IN LIFE BLK
STRLFB,	JMP FNDAD
	JMP ERNNX	/IF NO BLKS LEFT, JUMP ERROR
	ADD ADSBLK	/BLOCK ASSIGNED, IN AC
	LIF 6
	JMP STRLFC
	/TRANSFER-NUM WDS IN PTR 6
	/FROM PTR 7 TO PTR 16 B7.  PTR 16 AT START OF BUFF, NOT -1
	/ASSUME LDF=4
	/PTR 16 ENDS AT NEXT WD AFTER BUFF
INSRT,	LDA
	0
	STC INSRTN
INSRTA,	LDA I 7	/GET NEXT WD
	JMP DOSUB
	JMP STRLF	/STORE
	XSK I 6	/END
	JMP INSRTA	/NO, GO BACK
INSRTN,	RETURN	/YES
	/SUBROUTINE TO ADD A SPECTRUM
	/WHOSE NAME IS IN TYO7A OF B5, INST NAME IN INSTNM
	/EXIT IF NAME REDUNDANT
	/ONE BUMP IF NO MORE ROOM IN INDEX OR TAPE
	/TWO BUMPS IF OK
	/PTRS BY ERO HAS 4,6,7, USE 12,3
ADSTMP,	0	/LOC BLK 0 OF FIRST 7777, 0 IF UNFILLED
	0
ADSSP,	LDA	/SAVE RET, INIT TRMP
	0
	STC 2
	STC ADSTMP
	STC ADSTMP+1
	/FIND IF INSTRUMENT EXISTS
	JMP ER1
	JMP ADSSP1	/NO MATCH
	JMP ADSSPA	/MATCH
/CHECK IF DELETED SPECTRA FOUND
/BEFORE END REACHED
	LDA
	ADSTMP
	AZE
	JMP ADSSP5	/STORE IN DELETED AREA
ADSBMP,	XSK I 2	/INDEX OVERFLOW
	JMP 2	/BUMP RETURN, EXIT
	/NO MATCH.  EITHER END OF INDEX OR DEL INST
ADSSP1,	APO I
	JMP ADSSP2
	ADD ADSTMP	/DELETED INST, SAVE LOC
	AZE
	JMP ER0B	/UNLESS PRIOR ONE FOUND
	ADD 6
	STC ADSTMP
	JMP ER0B	/RET
ADSBLK,	0
	/SEARCH DAD MAP BLK0.  GET BLK NUM COORESP
	/TO FIRST FREE BIT IN ADSBLK, SET BIT, BMP RETURN
	/IF NO FREE BLOCKS, RET
	/PTRS 3,5,10,11
FNDAD,	LDA
	0
	STC 12	/SAVE RET
	STC 13	/INIT BLK CNT
	LDF 7
	SET I 3	/SET WD TO STRT OF MAP
	2324
FNDAD1,	SET I 5	/RESET BIT CNT
	7763
	/START NEXT WD
FNDAD2,	LDA I 3
	APO I	/IS BIT A 0
	JMP FNDAD3
	ROL 1	/NO, ROTATE
	XSK I 13	/BUMP BLK CNT
	XSK I 5	/IS IT END OF WD
	JMP FNDAD2+1
	LDA
	3
	SAE I		/END OF DAD ?
	2377
	JMP FNDAD1	/NO GET NEXT, ELSE
	JMP 12	/RETURN
	/OPEN BLOCK FOUND, SET BIT, GET IN ADSBLK
FNDAD3,	BSE I
	4000
	ROL 1
	XSK I 5		/REROTATE
	JMP .-2
	STA 3
	LDA
	13
	STC ADSBLK
	XSK I 12
	JMP 12	/RETURN
	/END OF INDEX. ADD ENTRY
	/PTR 6 AT INDEX ENTRY WD1
ADSSP2,	JMP FNDAD	/GET FIRST DAD LOC
	JMP ADSBMP	/TAPE FULL, EXIT
	/TRANSFER 3 WD ENTRY
	LDA
	ADSTMP	/ANY DEL ENTRIES
	AZE I
	JMP ADSSP4	/NO, STORE
ADSSP5,	SET 6
	ADSTMP	/YES, FILL IT
ADSSP4,	LDA
	ADSBLK
	STC FSTBLK
ADSSP3,	LDA
	INSTNM
	STA 6
	LDA
	INSTNM+1
	STA I 6	/STORE INST NAME
	LDA
	NUMPAR
	ROR 2
	ADD ADSBLK
	STA I 6	/STORE NUM PAR, INIT BLK NUM
	LDA
	ADSBLK
	JMP DOSUB	/READ BLOCK
	JMP RDTAPE
	LDA I
	2402
	LDF 6
	STA
	2016	/SET PTR 16 TO START OF STORAGE
	JMP ADSSPX	/JMP TO TRANSFER
	/MATCH MADE IN INDEX, DO SEARCH FOR REDUNDANT SPEC
	/INSTRUMENT ALREADY HAS CURVES
	/SEE IF ONE TO BE ADDED IS REDUNDANT
ADSSPA,	LDA 6	/GET FIRST BLOCK
	BCL I
	6000
	JMP DOSUB
	JMP FNDSPB	/CHECK MATCH
	AZE I
	JMP 2	/IF MATCH, EXIT
	/NO MATCH, PTR 16 AT FIRST NEW LOCATION IN SPECTRA
	/TRANSFER IN SPECTRUM DATA
ADSSPX,	SET I 6
	7767
	SET I 7
	TYO7A-1
	JMP INSRT	/TRANSFER NEW SPECTRUM TO FILE
	SET I 6
	7775
	SET I 7
	NAMETP+7776
	JMP INSRT	/TRANSFER TAPE NAME
	LDF 0
	LDA
	PARDAT+2002
	JMP DOSUB
	JMP STRLF	/STORE ST BLK NUM
	LDF 0
	LDA
	PTSUNK+2000
	STA
	NUMPT4
	JMP DOSUB
	JMP STRLF	/STORE NUM PTS IN SPECTRUM
	SET I 7
	2077
	LDF 0
	ADD NUMPT4	/GET-NUM PTS X NUM PARA
	MUL
	NUMPAR
	COM
	STC 4		/MUST RESET LDF TO B0 EACH LINE
V2,	SET I 6
	7776
	LDF 0
	JMP INSRT
	XSK I 4
	JMP V2
	COM
	JMP DOSUB
	JMP STRLF	/STORE TERMINATING 7777
	COM
	LDF 7
	STA
	2777	/AFTER CURVE AND AS LAST WD OF BLK
	/WRITE OUT LAST BLOCK,
	CLR
	ADD PARA+2
	JMP DOSUB
	JMP WTTAPE
	XSK I 2
	JMP ADSBMP	/RETURN, BUMP TWICE
	/DORETTE HANDLER TO ADD SPECTRUM
X2,	JMP ADSSP
	JMP ERNNU	/JUMP ERROR, NAME NOT UNIQUE
	JMP ERNNX	/JUMP ERROR,NO MORE ROOM
	/OK, SPECTRUM ADDED
	/NOW WRITE BLOCK 0
	PDP
	PMODE
	CDF 10
	JMS I PWRITE
	PARA0
	LINC
	LMODE
	LIF 0
	JMP X4
X3,	LDF 0		/ILLEGAL CODE CALLER
	STA
	2003
	LIF 0		/JMP ERR,NO MORE ROOM
	JMP ILLG
ERNNX,	LDA I
	4071
	JMP X3		/ERROR 9
ERNNU,	LDA I
	4061		/ERROR 1
	JMP X3
	/DORETTE PRINT ROUTINE RESTORER
P5,	LDA I
	JMP TRANSB
	LDF 6
	STA
	P2+ 2000
	LIF 0
	JMP P6	/JMP BACK
	/MATCH SPECTRUM FOR DORETTE
U8,	JMP LBPR
	JMP B4INTB	/REINIT ANS BUFF
	LIF 0
	JMP U9	/PRINTOUT OK, EXIT
	/HELP INITIALIZE DISPLAY ROUTINE
	/PTR7 MUST BE SET, PROCESSED NUM IN AC
HELPDS,	STC HELP1
	ADD 0
	STC HELPRT
HELP2,	LDA I
HELP1,	0
	JMP DOSUB
	JMP GETANS	/OCTAL ANS IN 1365
	SET I 6
	BUFB4+2000
	COM	/MAKE OCTAL
	JMP DOSUB
	JMP BMULT	/ANS CONV, PUT INAC
HELPRT,	RETURN
	/ERROR, DISPLAY, THEN BACK TO SAME DISPLAY
MNLNER,	LDA I	/DISPLAY ILLEGAL - ON NUM CONV
	4062
	LDF 5
	STA
	ERRCXX+2000	/ERROR 2 IF NEEDED
	LDA I
	DSPERB
MNLNE1,	JMP DOSUB	/GET CR
	JMP GETANS
	JMP HELP2	/REDISPLAY LAST DISPLAY
	/MOVE - NUM HALF WDS IN PTR 6
	/FROM PTR 5 BUF
	/TO PRT 7 BUFF
	/0 BECOMES 40
P40,	40
SHOVE,	LDA
	0
	STC SHOVER
SHOVEA,	LDH I 5
	AZE I
	ADD P40	/IF 0, MAKE 40
	SHD I		/IF STRT OF NEW FIELD,IGNORE
	7400
	JMP SHOVEA
	STH I 7
	XSK I 6
	JMP SHOVEA
SHOVER, RETURN
	/SET OF SUBROUTINES TO INTERFACE WITH AND CONTROL DORETTE
	/SUBSUB-IS GIVEN NUMBER IN AC BETWEEN OR=2 VALUES IN PTR6
	/YES, BUMP RET, NO, RETURN
LEGAL,	STA
	LEGAL1
	COM
	ADA 6
	APO I
	JMP 0	/IF MIN-NUM=+, ERROR
	LDA I 6		/MAX
	COM
	ADD LEGAL1	/NUM-MAX=+,ERROR
	APO I
	JMP 0	/ELSE BUMP, RETURN,  IN AC
	XSK I 0
	LDA I	/RESTORE AC
LEGAL1,	0
	JMP 0
	/LEGALITY LIMITS FOR VARIOUS LIFE PARAMETERS
LFUNIT,	0	/UNIT NUM
	17
SHOW3,	1	/CHOICES
	4
SHOW12,	61	/NUM PARA=SHOW31,
	62
SHOW14,	0	/BLOCK NUM RAW DATA
	777
	1001	/NUM PTS
	3770
SHW21M,	0	/NUM MISSES
	277
SHOW41,	1
	3
	/START CHOICE TABLE
STTAB,	0
	JMP STDOR	/JUMP GENERATE CURVE
	JMP STPRT	/JUMP PRINT
	JMP STERR	/JUMP ERASE
	JMP STDIAL	/JUMP START DIAL
	/MAINLINE CODING, DIAL MS I/O READIN
	/PROCESS DATA FROM EARLY DISPLAYS
	/TEXT BUFFER IS BY LOC 1365-CALL BUFB4
B4INTB,	LDA I	/SUB TO INIT ANS BUFF
	BUFB4 + 2000
	LDF 5
	STA
	ANSWER + 2000	/SET UP ANS BUFF
	SET I 7
	7775
	JMP 0
STRT,	JMP B4INTB
	LDA I
	DSP1
	SET I 7
	7774
	NOP
	JMP HELPDS	/GET NUM IN AC
	SET I 6
	LFUNIT
	JMP LEGAL
	JMP MNLNER	/NOT 1-17, ERROR, TRY AGAIN
	/LIFE TAPE UNIT NUM IN AC
STRTA,	STA
	PARA0
	STC PARA	/STORE IN TAPE PARA
	JMP DOSUB
	JMP RDTAPE	/READ BLK 0 INTO QUARTER 1,B7
	/SET UP FOR CHECKING
	JMP CKTPIN	/INITIALIZE
	JMP CKTP	/DO CHECK
	SKP
	JMP STRTB
	/NOT INITIALIZED LIFE TAPE
STRT2,	LDA I
	DSP2
	JMP DOSUB
	JMP GETANS	/ANSWER IN BUFB4
	LDA
	BUFB4
	SAE I
	7431	/INITIALIZE LIFE TAPE
	JMP STRT	/ANY ANSWER BUT YES, START OVER
	JMP INTP	/INITIALIZE LIFE TAPE IF YES
	CLR
	JMP DOSUB
	JMP WTTAPE	/WRITE OUT BLOCK 0 ON LIFE TAPE UNIT
	/READ LIFE BLOCK 0 INTO Q0B7
	/LIFE TAPE INITIALIZED
STRTB,	PDP
	PMODE
	CDF 10
	CIF 10
	JMS I PREAD
	PARA0
	LINC
	LMODE
	/DO CHOICE OPTIONS
STRTC,	LDA I
	DSP3
	SET I 7
	7775
	JMP HELPDS	/GET OCTAL NUM IN AC
	SET I 6
	SHOW3
	JMP LEGAL
	JMP MNLNER	/NOT 1-4, ERROR, TRY AGAIN
	ADA I
	STTAB+6000
	STC 6
	JMP 6
	/SETUP SHOVE ROUTINE
SETSHV,	SET I 6	/BUFB4, 4 CHAR
	7773
	SET I 5
	BUFB4
	JMP 0
STDOR,	JMP IPCSUB	/START DORETTE
	JMP STDORZ	/GET INSTRUMENT NAME
IPCSUB,	LDA
	0
	STC IPCRT	/SUB TO SAVE INST NAME
	LDA I
	DSP1P1
	JMP DOSUB
	JMP GETANS	/4 CHAR NAME IN BUFB4
	JMP SETSHV
	SET I 7	/TRANSFER TO INSTNM
	INSTNM+3777
	JMP SHOVE
	SET I 7
	TYO8A+3777
	JMP SETSHV
	JMP SHOVE
IPCRT,	RETURN
	/CHECK IF NEW INSTRUMENT
STDORZ,	JMP ER0
	JMP STDOR5	/NO
	NOP
	/YES, GET NUM PAR
STDOR3,	LDA I
	DSP1P2
	JMP DOSUB
	JMP GETANS	/ANSWER IN BUFB4
	LDA
	BUFB4
	SAE I
	7431
	JMP STDOR	/IF NEW INST, NOT ACCEPTED, ASK AGAIN
	LDA
	BUFB4+1
	BCL I
	7700	/LEAVE 006 NUM IN AC
	SET I 6
	SHOW12
	JMP LEGAL	/IS NUM PAR FROM 1-2
	JMP STDOR3	/NO,REFUSE INFORMATION
STDOR4,	BCL I
	7774	/GET NUM PAR IN AC
	LDF 6
	STA
	PRMTRS+2000
	LDF 0
	STA
	NUMPRA+2000
	STC NUMPAR	/STORE IN ALL BANKS
	JMP STDOR5
	/NOT NEW INSTRUMENT, GET NUM PAR IN AC
	/GET TAPE NAME, SPECTRUM NAME
STDOR5,	LDA I
	DSP1P3
	JMP DOSUB
	JMP GETANS	/GET ANS BUFF IN BUFB4
	JMP SETSHV
	SET I 7
	NAMETP+3777
	JMP SHOVE	/STORE TAPE NAME
	JMP SHVSB1
	JMP STDORX
SHVSB1,	SET I 6	/SET UP 16 CHAR SPEC TRANSFER
	7757
	SET I 5
	BUFB4+4002
	SET I 7
	TYO7A+3777
	JMP 0	/STORE SPECTRUM NAME
STDORX, JMP SHOVE
	/GET START BLK, UNIT NUM, NUM PTS
STDOR6,	LDA I
	DSP1P4
	SET I 7
	7774
	JMP HELPDS	/GET UNIT NUM IN AC
	SET I 6
	LFUNIT
	JMP LEGAL
	JMP MNLNER	/NOT CORRECT, ERROR, TRY AGAIN
	/START BLK NUM IN AC
	LDF 0
	STA
	PARDAT+2000	/STORE IN DATA TAPE
	/HELP1 ALREADY SET UP, SO BMULT CAN BE USED
	SET I 7
	7773	/SET 3 DIGITS
	SET I 6
	BUFB4+6001
	CLR
	COM	/MAKE OCTAL CONVERSION-START BLK
	JMP DOSUB
	JMP BMULT	/ANS IN OCTAL, IN AC, 0-777 IS LEGAL
	LDF 0
	STA
	PARDAT+2002	/STORE FOR DATA TAPE
	/GET NUMPTS-DECIMAL
	SET I 7
	7772	/4 DIGITS MAX
	SET I 6
	BUFB4+6003
	CLR
	JMP DOSUB
	JMP BMULT	/GET DECIMAL NUM PTS IN AC
	SET I 6
	SHOW14+2
	JMP LEGAL
	JMP MNLNER	/ERROR, TRY AGAIN
	LDF 0
	STA
	NUMPT0+2000	/STORE NUM DATA POINTS
	LIF 0	/START DORETTE
	JMP DORAGO
PRTABL,	0
	JMP PRT1	/PRINT SPECTRA
	JMP PRT2	/PRINT LIBRARY SPECTRUM
	JMP STRTC	/STOP, GO TO CHOICE OPTION
	/START PRINT ROUTINE-MAINLINE
STPRT,	JMP B4INTB	/INIT ANS BUFF
	LDA I
	DSP3P1
	JMP HELPDS	/NUM IN AC
	SET I 6
	SHOW41
	JMP LEGAL
	JMP MNLNER	/ERROR TRY AGAIN
	/CHOICE IN AC
	ADA I
	PRTABL+6000
	STC 6
	JMP 6		/JUMP TO CHOICE 1-3
PRT1,	JMP DOSUB	/PRINT SPECTRA
	JMP TYA
	JMP STRTC	/GO TO CHOICE OPTIONS
	/GET SINGLE SPECTRUM, STORE DATA
SINGL,	LDA
	0
	STC SIGR
	LDA I
	DSP3P2
	JMP DOSUB
	JMP GETANS	/GET NAME OF INST, SPEC IN BUFB4
	JMP SHVSB1	/SET UP SPECTRUM STORE
	JMP SHOVE
	JMP SETSHV	/SET 4 CHAR AT START BUFF
	SET I 7
	INSTNM+3777
	JMP SHOVE	/INST NAME STORED
/STORE IN PRT BUFF
	JMP SETSHV
	SET I 7
	TYO8A+3777
	JMP SHOVE
SIGR,	RETURN
PRT2,	JMP SINGL	/GET ALL DATA INTO BUFF
	JMP TYC	/PRINT REMAINDER
	JMP STRTC	/GO TO CHOICE DISPLAY
TYAY1,	ROL 3		/SAVE TAPE BLK-OCTAL
	STC RTN
	SET I 15
	TYAN3D+3777
	SET I 14
	7774
TYAY2,	ADD RTN
	ROL 3
	STA
	RTN
	BCL I
	7770		/GET NXT DIG
	ADA I
	60
	STH I 15
	CLR
	XSK I 14
	JMP TYAY2
	LIF 6
	JMP TYAY5
QAA1,	JMP B4INTB
	JMP STRTB	/CNTRL R REINITIALIZATION
ERTABL,	0
	JMP ERR1	/ERASE TAPE
	JMP ERR2	/ERASE INSTRUMENT
	JMP ERR3	/ERASE SPECTRUM
	JMP STRTC	/STOP, GO TO CHOICE OPTION
	/PROCESS ERROR DATA
STERR,	JMP B4INTB	/INIT ANS BUFF
	LDA I
	DSP4P1
	JMP HELPDS
	SET I 6
	SHOW3
	JMP LEGAL
	JMP MNLNER	/ERROR IN CHOICE, TRY AGAIN
	/CHOICE IN AC
	ADA I
	ERTABL+6000
	STC 6
	JMP 6	/JUMP TO CHOICE 1-4.
	/ERASE TAPE
ERR1,	JMP ERRNW0	/CLR BLK0 IN B7Q1
	JMP INTP
	CLR
	JMP DOSUB
	JMP WTTAPE	/WRITE IT OUT
	JMP STRTB	/GO TO REREAD LIFE TAPE
	/ERASE INDEX
ERR2,	NOP 	/SAVE INST NAME
	JMP IPCSUB
	JMP ER0
	JMP ER2	/MATCH, DELETE INST
	NOP
ERR2A,	JMP STRTB	/NO MATCH, RETURN
	/DELETE INDIVIDUAL SPECTRA
ERR3,	JMP SINGL	/GET INST, SPEC STORED
	JMP DELSP	/DELETE SPECTRUM
/WRITE OUT BLK 0
	JMP DOSUB
	JMP WTUN0
	JMP STRTB	/RETURN
	/START DIAL
STDIAL,	PDP
	PMODE
	JMP I Z DIAL77
	LMODE
NOMORE,	LDA I		/MAY BE UNUSED
	6165  /ERR CD 5
	JMP X3
/PTR 1 SET,PRNT LINE
LBPR4,	JMP DOSUB
	JMP PRNTLN	/PRINT MATCH SPECTRUM LINE
	LIF 6
	JMP LBPRX	/GET NXT SPECTRA
ERRNW0,	LDA 		/ASK IF SURE
	0
	STC ERRNW9
ERRNW1,	LDA I
	DSPNEW
	JMP DOSUB
	JMP GETANS	/GET Y OR N IN BUFB4
	JMP SETSHV
	LDH I 5
	SHD I
	3100
ERRNW9,	RETURN		/IF Y GO ON
	SHD I
	1600
	JMP STERR	/IF N BACK TO ERASE DISP
	JMP ERRNW1	/ELSE RESHOW SURE
	4040
TYO7,	4040
	TEXT QSPECTRUM :Q
	4040
	4040
TYO7A,	4040	/ANSWER BUFFER
	4040
	4040
	4040
	4040
	4040
	4040
	4040
	0000
TYO8,	4040
	4040
	TEXT QINSTRUMENT :Q
	4040
TYO8A,	4040	/ANSWER BUFFER - USE AS FIRST LINE OF INDEX PRINTOUT
	4040
	0000
TYO9,	4040
	4040
	2013		/PK
	4040
	4040
	TEXT QX VAL Q
	4040
TYO9A,	0	/0 HERE IF ONE PARA
	4040
	TEXT QY VAL Q
	4040
TYO9B,	0	/0 HERE IF TWO PARA
	4040
	TEXT QPARA 3Q
TYO9C,	0000
TYANS,	4040
	4040
TYAN1,	4040
TYAN1A,	4040	/SPECTRUM NAME
	4040
	4040
	4040
	4040
	4040
	4040
	4040
	4040
	4040
TYAN1F,	0000	/PEAK PTS
	4040
TYAN1B,	4040	/0 IF UNKNOWN LINE
	4040
	4040
	4040
TYAN1C,	4040	/MISSES
	0000
	0000
TYAN3,	4040
	4040
TYANA,	4040	/INSTRUMENT NAME
	4040
	4040
	4040
	4040
	4040
	4040
TYAN3B,	0	/SPECTRUM NAME
	0
	0
	0
	0
	0
	0
	0
	4040
	4040
	4040
TYAN3C,	0	/TAPE NAME
	0
	4040
	4040
	4040
	4040
TYAN3D,	0	/ST BLK
	40
	4040
	4040
	4040
TYAN3E,	0	/PTS - 4 DIGITS
	0
	0	/END
TYAN4,	4040
TYAN4A,	0	/PEAK
	0
	4040
	4040
	4000	/PARA1 - 3 DIGITS
	0
TYAN4B,	4000	/0 IF ONLY 1 PARA
	4040
	4040
	4040
	4000	/PARA 2 - 3 DIGITS
	0
TYAN4C,	4040	/0 IF ONLY 2 PARA
	4040
	4040
	4000	/PARA 3 - 3 DIGITS
	0
TYAN4D,	0 		/END OF LINE
TYO6,	4040
	TEXT QINSTRUMENTQ
	4040
	4040
	TEXT QSPECTRUM NAMQ
	0540
	4040
	4040
	4040
	TEXT QTAPE NAMQ
	0540
	4040
	TEXT QSTARTING BLKQ
	4040
	TEXT QPKSQ
	0000
	CHAIN "LIFE B6"