File LIFE B01

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

*20
/LIFE B0
/REAL TIME LIBRARY LOOKUP OF UNKNOWN SPECTRA
/COPYRIGHT 1970; DIGITAL EQUIPMENT CORPORATION
/                MAYNARD, MASSACHUSETTS 01754
/
/
/RELEASED OCTOBER 1970
/
/
/WRITTEN BY RON KLEINMAN
/
/
	/PTR BUFF IN THIS BANK
SEGMNT 0
*20
	/CONSTANTS, TEMP STORAGE, REF FLGS ETC.
PARDAT,	0	/DATA TAPE UNIT - SET BY DISP
	4	/CORE LOCATION - B1 - CNST
	0	/STARTING BLK NUM - SET BY DISP
	0	/NUM BLKS - SET BY DORETTE PROC
NUMPT0,	0	/NUM PTS, SET BY DISP. - LEGALITY >200, <6000
OFFSET,	1777	/ALSO TEMP FOR PAST SPECTRUM
BASLIN,	0
NUMPRA,	0	/PARA IN CURVES - NOW LEGALLY 1 OR 2
TLRNCE,	0	/FOR PARA 1,2,3 RESPECTIVELY IF ABSOLUTE
	0
	0
MISSES,	0	/NUM MISSES ALLOWED
PTSLIB,	0	/NUM PTS IN LIBRARY TOTAL
PTSUNK,	0	/NUM PTS IN UNKNOWN - RUNNING TOTAL, SET PRIOR MATCH
COMMIS,	0	/NUM MISSES FOR THIS SPECTRUM
PTSCVD,	0	/NUM PTS COVERED IN MATCH ROUT
PRCNT1,	24	/ONE PERCENT - CONSTANT
	3700
SPSPA,	4040
P12,	12
UNKVAL,	0
BUMPR,	0		/SET=NO BUMP PTR 14,UNK
BUMPR1,	0		/SET=NO BUMP PTR 16,LIB
XWORD,	0
XWORD1,	0
/ABOVE 3 FROM MATCH ROUTINE
FLAGWD,	0	/FLAG WORD
	/BIT0=1, UNKNOWN SPECTRA>LIBRARY SPECTRA PTWISE
	/BIT1=1, PERCENT TOLERANCE,
PRCT1,	0	/FOR PARA 1,2,3, RESPECTIVELY IF PERCENT
	0
PRCT2,	0
	0
PRCT3,	0
	0
XNMBUF,	0	/FOR MULT
	0
XNMTMP,	0	/IN PTFAIL ROUT ALSO
/NEG IF LIB XVAL>UNK XVAL
P3777,	3777
QRD,	READ
QWT,	WRITE
*400
BUFB0,	0	/10 WD BUFFER FOR TEXT STRINGS
*415
	/CALL SUBROUTINE IN B6 FROM B0
B6FRB0,	ROL I 1
	ROR 1		/SAVE BIT 0 IN LINC
	SCR 13		/SAVE BITS 1-11 IN MQ
	LDA
	0
	STA
	16
	BCL I
	6000
	STC 15
	LDF 0
	LDA 15	/GET CONTENTS OF LOC AFTER CALL TO B6FRB0
	XSK I  16
	LIF 6
	JMP B6CALL
	LDF 7	/RETURN, VALUE IN AC IS OUTCOME
	JMP 16
	/SUBROUTINE TO COMPARE UNKNOWN TO LIBRARY
	/ASSUMES TOL, MISSES, NUM PTS IN BOTH SET
	/WILL HAVE BUMP IF MATCH, RET IF NO MATCH.
	/PTRS 7-14, 15,16 IN B6SUB CALLER
	/AC CONTAINS  POINTS IN LIB, FLAGWD CORRECTLY SET
	/PTR 16 AT PTS LIB, ENDS AT LAST LOC IN DATA
	PMODE
MATCHF,	TAD Z FLAGWD
	AND Z P3777
	JMP MATCHB-1
	LMODE
MATCH,	STC PTSLIB
	STC COMMIS
	ADD 0
	STC 17	/SAVE RET
	STC PTSCVD
	/FIND WHICH SPECTRUM HAS MORE POINT - 8 CODE
	PDP
	PMODE
	TAD Z PTSUNK
	CMA CLL
	TAD Z PTSLIB	/LIB-UNK
	SMA CLA
	JMP MATCHF
	TAD Z FLAGWD	/IF LIB<UNK
	RAL
	STL RAR		/SET BIT 0
	DCA Z FLAGWD
	/LIB HAS LESS PTS
MATCHB,	TAD Z PTSLIB
	CMA
	DCA 12	/PTR 12 HAS - NUM LIB PTS
	TAD Z PTSUNK
	CMA
	DCA 13	/PTR 13 HAS - NUM UNK PTS
	LINC
	LMODE
	/PTR 16 VIA TRANSB IS AT START OF LIB DATA
	SET I 14
	77	/SET PTR 14 TO START OF UNKNOWN DATA
	/COMPARE NEXT POINT
MATCHC,	JMP PTCM1
	/CHECK  MISSES
	ADD MISSES
	COM
	ADD COMMIS
	APO
	JMP MATCHD
	/NUM MISSES TOO HIGH, NOMATCH
MTHRT,	JMP PASTSP	/GET PAST SPECTRUM
	JMP 17	/EXIT
	/GO ON, CHECK MORE PTS
MATCHD,	XSK 12
	JMP .+2
	JMP MATCHE
	XSK 13
	JMP MATCHC
	/OVER MATCH FOUND. NUM MISSES IN COMMIS, BUMP RET
MATCHE,	XSK I 17
	JMP MTHRT
PTCM6,	LDA
	UNKVAL
	STC XWORD1
	ADD OFFSET
	STC XWORD
/XVALS SAVED, NOW BUMP PTRS,MAYBE
	JMP PTZA
	JMP PTZA1	/ONLY BUMP IF PTR AT XVAL
/MUST ALSO RESTORE BOTH Y VALS
/JUST IN CASE 1 NOT BUMPED
	LDF 6
	LDA
	2016
	STC 1
	LDF 7
	LDA 1
	STC OFFSET
	LDA 14
	STC UNKVAL
	COM
	STC BUMPR
	COM
	STC BUMPR1
	JMP PTCM3
	/GET PAST SPECTRUM - SUBSUB
	/PTR 16 IN MIDDLE AT (PTSLIB - PTSCUD)XPARA
	/SET PTR 15 B6 TO - THIS, THEN DO SUB ADV16
PASTSP,	LDA
	0
	STC PASTRT
	ADD NUMPRA
	COM
	STC 6	/-NUM PAR IN 6
	ADD 12
	AZE I
PASTRT,	RETURN	/IF NO POINTS LEFT, RETURN(16 AT LAST SPEC PT), AC CL
	COM
	STC OFFSET	/STORE DIFF IN TEMP
PASTS1,	ADD OFFSET
	XSK I 6
	JMP PASTS1
	COM
	/MOVE  LOC IN AC. PTR16 AT LAST SPEC PT
	JMP B6FRB0
	JMP MV16	/MOVE 16 TO SAFETY
	JMP PASTRT	/EXIT
	/SUBROUTINE TO COMPARE POINTS
	/IF MATCH, OK, NO, BUMP COMMIS, CLEAR AC
PTCM1,	LDA
	0
	STC PTCMRT
	STC BUMPR
	STC BUMPR1
/SET IS PTR AT Y VAL FLAGS
	JMP PTFALC	/SET PTR6 TO - PARA
PTCM2,	JMP PTR14B
	JMP B6FRB0	/GET NEXT LIB PARAMETER IN OFFSET
	JMP TRANSB	/GET TO NEXT UNK PTR IN UNKVAL
	STC OFFSET
PTCM3,	LDA I
	TLRNCE	/ABSOLUTE TOLERANCE LOCATION
	ADD NUMPRA
	ADD 6
	STC 7	/IN PTR 7
	ADD FLAGWD
	ROL 1
	APO
	JMP PTCMA	/IF PERCENT, GET CONVERTED TOLWD
	/ASSUME TOL WD SET, IN PTR7
PTCM4,	LDA 7	/CHECK UPPER LIMIT
	ADD UNKVAL	/UNK+TOL>,=LIB,OK
	COM
	ADD OFFSET
	COM
	APO
	JMP PTFAIL	/FAILURE, UPPER, AC-
			/CHECK LOWER LIMIT
	LDA 7	/UNK-TOL<,=LIB, OK
	ADD OFFSET
	COM
	ADD UNKVAL
	APO I
	JMP PTFAIL	/FAILURE LOWER, AC+
	/SUCCESS FOR THIS PARAMETER
	XSK I 6
	JMP PTCM6	/GET NEXT,SAVE LIB X VAL
	/POINT CHECKS
PTCM5,	LDA I	/BUMP PTS CVD
PONE,	1
	ADD PTSCVD
	STC PTSCVD
	LDA I 12
	LDA I 13
/BUMP BOTH PT COUNTS
	CLR
PTCMRT,	RETURN 	/EXIT
	/FAILURE
PTFAIL,	STC XNMTMP
	ADD 6	/IS THIS THE FIRST PARAMETER
	ADD NUMPRA
	AZE
	JMP PTFALP	/NO, TRY TRY AGAIN
	/YES. DOES THE CURVE WITH LESS POINTS HAVE THE LESSER VALUE
	/IF YES, THAN THIS IS A FAILURE, BUMP NUM MISSES
	/IF NO, BUMP CURVE WITH GREATER POINTS, TRY AGAIN
	/FLAGWD NEG IF UNK HAS MORE PTS
	/XNMTMP NEG IF LIB HAS GREATER VALUE
PTFAQ,	ADD XNMTMP
	BCO
	FLAGWD	/EXCLUSIVE OR IF NEG, EITHER LIB OR UNK HAS
	APO	/LESS VALUE AND LESS PTS, ERROR
	JMP PTFALB	/BUMP ERROR
	/BUMP PAST POINT IN SPEC WITH LESSER VALUE, MAY NOT BE ERROR
	LDA
	XNMTMP
	APO
	JMP PTFALH
	/LIB HAS LESSER VALUE
PTFALD,	XSK I 6
	JMP .+2
	JMP PTFALE
	JMP PTZA1	/MAYBE BUMP LIB PTR
	JMP PTFALD
PTFALE,	JMP PTFALC	/RESTORE PTR6 TO NUM PARA
	STC BUMPR1	/RESET LIB BMP FLAG
	XSK I 12
	SKP
	JMP YQ1		/LIB OVER
	JMP B6FRB0
	JMP TRANSB
	STC OFFSET
/NEW LIBX VAL SAVED
	JMP PTCM3	/PROCESS MORE OR
YQ1,	SET I 12	/OVER, RESET PTR TO SKIP, BUMP ERROR
PM1,	7776
	ADD FLAGWD
	APO		/IF UNK SMALLER
	JMP PTCM5
	LDA
	13
/ALL REMAINING UNK PTS ARE ERRORS
Z6,	COM
	ADD COMMIS
	STC COMMIS
	JMP PTCM5
	/RESTORE PTR 6
PTFALC,	LDA
	NUMPRA
	COM
	STC 6
	JMP 0
	/UNK HAS LESSER VALUE
PTFALH,	XSK I 6
	JMP .+2
	JMP PTFALJ	/BUMP 1 WD FOR EACH PTR
	JMP PTZA	/GET NEXT UNK LOC, MAYBE
	JMP PTFALH
PTFALJ,	JMP PTFALC	/RESTORE PTR6 TO NUM PARA
	STC BUMPR	/RESET FLG
	LDA I 14
/SAVE NEW UNK VAL-FRST PARA OF NXT PT
	STC UNKVAL
	XSK I 13	/CURVE OVER?
	JMP PTCM3	/NO, JUMP NEW COMPARE
/YES, MOVE LIB PTR TO Y PARA
/IF NOT ALREADY THERE
/AND A 2 PARA INST
PTFALK,	ADD NUMPRA
	SAE I
	2
	JMP PTFALL	/IF 1 PARA,OUT
	LDA
	BUMPR1
	APO
	JMP PTFALL	/IF LIB ON Y,OUT
	JMP B6FRB0
	JMP TRANSB	/ELSE MOVE LIB
PTFALL,	CLR
	SET I 13
	7776
	ADD FLAGWD
	APO I		/IF LIB SMALLER
	JMP PTCM5
	LDA
	12
/ALL REMAINING LIB PTS ARE ERRORS
	JMP Z6
	/FAILURE, AT LAST PARA
PTFALB,	LDA I	/INCREMENT MISSES, EXIT
	1
	ADD COMMIS
	STC COMMIS
	ADD PONE
	ADD PTSCVD
	STC PTSCVD
	JMP 0
	/CONVERT PERCENT TO ABSOLUTE TOL FOR THIS PT
	/LIB PT IN OFFSET
PTCMA,	LDA I
	PRCT1
	ADD NUMPRA
	ADD NUMPRA
	ADD 6
	ADD 6
	BSE I	/PTR 10 HAS SINGLE PREC PARA MULTIPLIER
	4000	/4000 FOR FRACTIONAL MULT
	STC 10
	ADD OFFSET
	MUL 10	/TOLERANCE IS IN AC
	STA 7	/STORE IN TOL WD
	JMP 0	/JUMP LIMIT CHECKING
/FAILURE ON Y,BMP APPROPRIATE PT
PTFALP,	LDA
	XWORD
	STC OFFSET
	ADD XWORD1
	STC UNKVAL
/GET XTMP NEG IF LIBX>UNKX
	ADD XWORD
	COM
	ADD XWORD1
	STC XNMTMP
	JMP PTFAQ	/SAVE X VALS
PTR14B,	LDA I 14
	STC UNKVAL
	JMP 0
/BUMP ONLY UNK PTR MAYBE
PTZA,	LDA
	0
	STC PTZAR
	ADD BUMPR
	APO I
	JMP PTR14B
PTZAR,	0
/BUMP ONLY LIB PTR, MAYBE
PTZA1,	LDA
	0
	STC PTZAR1
	ADD BUMPR1
	APO
	JMP PTZAR1
	JMP B6FRB0
	JMP TRANSB
	STC OFFSET
PTZAR1,	0
	EJECT
	/SUBROUTINE TO MULTIPLY NUM IN XNMBUF BY AC, STORE IN PTR 6
XNUM,	COM
	STC 7	/PTR 7 HAS -
	ADD 0
	STC XNMRET	/SAVE RET
XNUMA,	SET 10
	6
	STA 6
	STA I 6	/CLEAR BUFF INIT
	/PTR 10 HAS UPPER ORDER, PTR 6 LOWER
XNUMB,	LDA 10
	ADD XNMBUF
	STA 10	/GET UPPER ORDER
	CLR
	ADD XNMBUF+1
	LAM 6
	STC XNMTMP	/GET LOWER ORDER, CLEAR AC
	LAM 10	/GET CARRY IN UPPER ORDER
	XSK I 7
	JMP XNUMB	/IF MORE MULT, DO AGAIN
	CLR
XNMRET,	RETURN	/ELSE OUT
LBDATA,	0
	0
	/SUB TO PRINT OUT MATCHING LIB SPECS
LBPRF,	JMP MATCH	/DO CURVES MATCH
	JMP LBPRZ	/NO MATCH
	LDF 6	/MATCH, FILL IN NUM PTS MISS
	LDA I
	LBDATA+5777
	STA
	2017	/SET PTR 17 IN B6 DECML ROUT
	LDA
	COMMIS
	JMP B6FRB0
	JMP DECML
	LDF 4
	ADD LBDATA+1
	STA
	TYAN1C+2000	/STORE  MISSES
	/LINE COMPLETE, PRINT
	LDA I
	TYANS+5777
	LDF 6
	STA
	2001	/SET PTR1 IN PRINTOUT
LBPRG,	LIF 4
	JMP LBPR4	/PRT LN,GET NXT SPEC
LBPRZ,	LIF 6
	JMP LBPRX	/JUST GET NEXT SPEC
	EJECT
	/START OF INITIALIZE DORRETTE
DORART, LIF 4	/RETURN TO CHOICE OPT
	JMP STRTC
DORAGO,	LDF 6
	STC PTSUNK
	LDA I
	1777
	STC OFFSET
	LDA I
	4400
	STA
	75
	STA
	76
	STC 77	/SET INITIAL UNK VAL TO -LARGE
	JMP CLRCRV	/CLR UNK CURVE
	JMP DORGO1
CLRCRV,	LDA
	0
	STC CLRT
	/CLR UNK CURVE LOC 100-377
	SET I 1
	77
	SET I 2
	-300
CLRMOR,	STA I 1
	XSK I 2
	JMP CLRMOR
CLRT,	RETURN
DORGO1,	SET I 3
	4064
	/READ APPROPRIATE NUM BLKS
	LDA
	NUMPT0
	ADD PM1
	SCR 10
	ADD PONE
/SET NUM BLKS>NUM PTS*256
	STC PARDAT+3
	/LEGALITY1 - NUMBLKS+STBLKS<777
	/ASSUME NUMPTS<6000
	ADD PARDAT+3
	ADD PARDAT+2
	ADD PM1
	BCL I
	777
	AZE I
	JMP .+3
/ERROR, DO NOT DO READ
	LIF 4
	JMP STDOR6
	/DO READ
	PDP
	PMODE
	CDF 0
	CIF 10
	JMS I QRD
	PARDAT
	LINC
	LMODE
	LDF 6
DORGO3,	SET I 5
	77	/INITIALIZE DATA PTR
	LDA I
	1777
	/INITIALIZE DORETTE CALL LOCATIONS
	ADD NUMPT0
	STA
	DREND+2000	/END PT
	CLR
	STA
	YOFFST+2000	/OFFSET=0
	STC PTSUNK
	LDA I
	SCR 1
	STA	/SCALE=1
	YSCALE+2000
DORGO4,	JMP B6FRB0
	JMP INTDRA	/INITIALIZE DORA, READ BLKS
PROCMD,	LDF 6	/PROCESS COMMAND
	STC DORGO8
	SET I 3 	/IS BRT SPOT ON CURVE
	4065		/IF NOT ERROR 5
	LDA
	CURCNT+2000
	APO
	NOP		/***
/JMP ILLG IF < 512 PTS
	LDA I	/YES
DORGO8,	0	/RESTORE AC, PROCEED
	/COMMAND CHAR IN AC
DORGO5,	SET I 1
	INTTBL-1 	/INTERPRETATION TABLE
	SET I 2
	-11	/-NUM LEGAL COMMANDS
	SET I 3
	JMPTBL+6000	/JUMP TABLE
DORGO6,	SAE I 1	/IS COMMAND SAME AS AC
	JMP DORGO7
	JMP 3	/YES, JUMP PROCESSING ROUTINE
DORGO7,	XSK I 3
	XSK I 2
	JMP DORGO6	/END, NO JUMP BACK
	SET I 3
	4062		/ERR CD 2
	JMP ILLG	/YES, JUMP ILLEGAL
	/INTERPRETATION TABLE
INTTBL,	306	/F
	255	/-
	253	/+
	302	/B
	317	/O
	305	/E
	330	/X
	320	/P
	325	/U
	/JUMP TABLE
JMPTBL,	JMP F1
	JMP MINUS1
	JMP PLUS1
	JMP B1
	JMP O1
	JMP E1
	JMP X1
	JMP PRNT1
	JMP U1
	/SUBROUTINE TO FILE POINT VALUE
FTEMP,	0	/TEMP
F1,	LDA I	/HAVE TOO MANY PTS BEEN FILED
	374
	SET I 3
	4067		/YES,ERROR 7
	COM
	ADD 5
	APO I
	JMP ILLG	/YES, ILLEGAL
	/NO, GET X VALUE SUBTRACT OFFSET
	LDF 4
	LDA
	OFFSET
	COM
	ADA
	2022
	LDF 6
	STC FTEMP	/SAVE
	LDA		/IF FRST PT,SKIP COMPARE
	5
	SAE I
	77
	SKP
	JMP F2ZXQ
	CLR
	SET 6
POS5,	5
	XSK I 6
	ADD NUMPRA
	COM
	ADD 6	/IS X VALUE LESS THAN LAST X VALUE
	STC 6	/IN PTR 6
	SET I 3
	4070
/ERR CD 8
	LDA 6
	COM
	ADD FTEMP
	APO
	JMP ILLG	/YES, ERROR
F2ZXQ,	LDA
	FTEMP
	STA I 5	/NO, STORE VALUE
	/MORE THAN ONE PARAMETER
	LDA I
	2
	SAE
	NUMPRA
	JMP F3		/IF 1 IN AC,BUMP PTS
	JMP F2		/IF 2 PARA,PROC Y VAL
F3,	LDA		/BMP NUM UNK PTS
	PONE
	ADD PTSUNK
	STC PTSUNK
KEEPDR,	JMP B6FRB0	/REFRESH DORETTE
	JMP CLLDRA
	JMP PROCMD	/PROCESS NEXT CHAR
/STORE YVAL=CORVAL-OFFSET
F2,	NOP		/REPLACE WITH SNS 5
/IF FREE STANDING MODE DESIRED
	JMP G1
/YES,CORVAL-OFFSET=KNOB 5X2!(YSCL-1)
F4,	JMP R1
F5,	STA I 5		/STORE
	JMP F3
/SS5 OFF,STORE CORVAL-OFFSET
G1,	LDA
	YOFFST+2000
	NOP
	LDF 4
	ADA
	2023
	LDF 6
	JMP F5
YSCRNG,	-341		/-SCR 1
	-344		/-SCR 4
YSCTMP,	0
	/SUBROUTINE TO SCALE DISPLAY SMALLER BY HALF
MINUS1,	LDA
	PONE	/ADD 1 TO YSCALE
MORP2,	ADA
	YSCALE+2000
	STA
	YSCTMP
	SET I 3
	YSCRNG
MORP3,	ADA 3		/ADD  -SCR 1
	APO
	JMP MORP4	/ERROR
	LDA I 3
	ADD YSCTMP
	APO I
	JMP MORP4	/ERROR TOO HIGH
	CLR
	ADD YSCTMP	/OK. CHANGE SCALE
	JMP MORP5
MORP4,	LDA 3		/ERR,STR LIMIT
	COM
MORP5,	STA
	YSCALE+2000
	JMP DORGO4	/INITIALIZE DORA
	/SUBROUTINE TO SCALE DISPLAY BIGGER BY DOUBLE
PLUS1,	LDA I
	7776
	JMP MORP2
	/SUBROUTINE TO REDEFINE BASELINE
B1,	LDF 4
	NOP		/REPLACE WITH SNS 5 IF FREESTANDING
/MODE OF DISPLAY DESIRED
	JMP C1
/YES: OFFSET=CORVAL-(KNOB5)X2!(YSCL-1)
B2,	JMP R1
	COM
	ADA
	2023		/CORVAL
B3,	LDF 6
	STA
	YOFFST+2000	/STORE Y OFFSET
	JMP DORGO4
/NO SS5, YOFFSET=-CORVAL
C1,	LDA
	2023		/CORVAL
	COM
	JMP B3
/SUB TO ROTATE KNOB 5 VAL 1 LFT FOR EVERY + DIG IN YSCL-1
R0,	0
R1,	FRESAM		/SAM 5
	STC R0
	LDF 6
	ADD PM1
	ADA
	YSCALE+2000
	BCL I
	7770
	COM
	STC 4		/-YSCL+1
	ADD 0
	STC R9
	ADD R0
	XSK 4		/NO ROTATES
	JMP R2
R9,	RETURN
R2,	ROL 1
	XSK I 4
	JMP R2
	JMP R9		/OVER
	/SUBROUTINE TO SET UP OFFSET
O1,	LDA
	5
	SET I 3
	4063
	SAE I
	77
	JMP ILLG	/IF PTS HAVE ALREADY BEEN STORED-ILLEGAL
	LDF 4
	LDA
	2022
	STC OFFSET	/IF NOT, STORE, JUMP REFRESH DORETTE
	JMP KEEPDR
	/SUBROUTINE TO ERASE ALL PREVIOUS UNKNOWN PTS
E1,	JMP CLRCRV	/CLEAR UNKNOWN CURVE
	SET I 5	/REINITIALIZE CURVE PTR
	77
	STC PTSUNK	/SET NUM PTS=0
	JMP KEEPDR	/REFRESH DORETTE
	/SUBROUTINE TO EXIT DORETTE
X1,	LDA
	PTSUNK
	SET I 3
	4067
	AZE I
	JMP DORART	/IF NO POINTS, EXIT,
	COM
	ADD POS5
	APO I
	JMP ILLG	/IF LESS THAN 5 PTS, ILLEGAL
	/IF MORE THAN 5 POINTS, ADD SPECTRUM
	/INST NAME IN INSTNUM, SPEC IN TYO7A OF B7
	LIF 4
	JMP X2	/GO TO B4 PROCESSOR
	/SPECTRUM ADDED, BLOCK 0 WRITTEN OUT
X4,	JMP DORART	/RETURN TO DORETTE CALLER
	/SUBROUTINE TO PRINT VALUE OF POINTS ALREADY STORED VIA DORETTE
PRNT1,	LDF 6
	IOB
	6041		/TSF-CLR PRNT BUFF
	JMP .-2
	LDA	/INITIALIZE PRINT ROUTINE TYCNT
	PTSUNK
	STA
	NUMPTS+2000	/TELL NUM PTS TO PRINT
	JMP B6FRB0
	JMP TYB		/GET HEADER
	LDF 6
	LDA I
	2077
	STA
	2016	/GET DATA PTR TO UNK, NOT LIB BLK
	LDA I
	JMP P4
	STA
	P2+2000	/BUMP UNK, NOT LIB PTR
	LDA
	NUMPRA
	STA
	PRMTRS+2000	/TELL NUM PARA
	LDA I
	JMP P5
	LDF 4
	STA
	2005	/SET UP RETURN TO P5 IN B4
	CLR
	LIF 6	/JUMP PRINT ROUTINE
	JMP TYCNT
	/PRINT ROUTINE ACCOMPLISHED, REFRESH DORETTE
P6,	JMP KEEPDR
	/TEXT PROC INITIALIZATION SUB
U1A,	STC U1AA
	ADD 0
	STC U1ARET
	LDA I
U1AA,	0
	JMP B6FRB0
	JMP GETANS	/ANS IN LOC 65
	SET I 6
	BUFB0+2000
	SET I 7
	7774
	JMP B6FRB0
	JMP BMULT	/GET PROCESSED NUM IN AC
U1ARET,	RETURN
	/SUBROUTINE TO COMPARE UNK SPECTRUM WITH LIB SPECTRA
	/OUTPUT MATCHES TO TTY
U1,	LDA I
	BUFB0+2000
	LDF 5
	STA
	ANSWER+2000	/SET UP ANS BUFF AT LOC 65 OF B0
	SET I 3
	4062
	CLR
	STC COMMIS
	LDA I	/DISPLAY ALLOWABLE ERROR TOL
	DSP2P1
	JMP U1A
	/PROC NUM IN AC
	/GET PERCNT OR ABSOL
	SAE I
	1
	JMP U2
	/1, PERCENT
	LDA
	FLAGWD
	BSE I
	2000	/SET BIT 1 FLAGWD
	JMP U3
U2,	SAE I
	2
	JMP ILLG	/IF NOT 1, 2 ILLEGAL
	LDA
	FLAGWD
	BCL I	/ABSL, CLEAR BIT
	2000
	/PROCESS PARAMETER TOLERANCES
U3,	SET I 6
	BUFB0+2001
	STC FLAGWD	/PROCESS PARAMETER 1
	JMP UA
	/VALUE OCTAL OR DECIMAL IS IN AC
	APO
	JMP ILLG	/IF NEGATIVE, ERROR
	STC TLRNCE	/ELSE STORE PRA 1
	ADD NUMPRA
	SAE I
	2
	JMP U4	/IF ONE PARA, GO ON
	SET I 6
	BUFB0+6003
	JMP UA	/ELSE PROCESS SECOND
	APO
	JMP ILLG	/IF NEG, ERROR
	STC TLRNCE+1	/ELSE STORE PARA2
	JMP U4
	/PROCESS PARAMETER TOLERANCE, SUB
UA,	ADD 0
	STC UARET
	SET I 7
	7773
	ADD FLAGWD
	ROL 1
	APO I
	JMP UB	/IF PERCNT, ONLY 2 DIG ALLOWED
	XSK I 7
	CLR 	/AC=+0
UC,	JMP B6FRB0
	JMP BMULT	/DO CONVERT 2 DECIMAL
UARET,	RETURN
UB,	CLR
	NOP
	JMP UC	/DO CONVERT 3 ABSOLUTE  DEC
U4,	ADD FLAGWD
	ROL 1
	APO I
	JMP U7	/IF ABSOLUTE, GO ON
	/PERCENT, CONVERT TO ABSOLUTE
	LDA
	PRCNT1
	STC XNMBUF
	ADD PRCNT1+1
	STC XNMBUF+1	/GET MULT NUM AS 1 PERCNT
	SET I 6
	PRCT1	/SET PRCENT TOL 1
	ADD TLRNCE
	JMP XNUM	/PARA 1 PERCENT SET
	ADD NUMPRA
	SAE I
	2
	JMP U7	/IF ONE PARA GO ON
	SET I 6
	PRCT1+2
	CLR
	ADD TLRNCE+1
	JMP XNUM	/PARA 2 PERCENT SET UP
	/GET NUM MISSES ALLOWED, SAME ANS BUFF
U7,	LDF 5
	LDA I
	DSP2P2
	JMP U1A	/PROCESSED NUM IN AC
	STC MISSES	/STORE NUM MISSES
	ADD MISSES
	COM
	ADD PTSUNK
	SET I 3
	4066
	APO
	JMP ILLG	/IF NUM PTS<NUM MISSES, ERROR
	/ALL OK, DO MATCH
	LIF 4
	JMP U8
	/SPECTRUM MATCHES OUTPUTTED
U9,	JMP KEEPDR	/REFRESH DORETTE
	/SOMETHING ILLEGAL HAS BEEN ENTERED
/MUST RESTORE ANSWER BUFF
ILLGL,	LDA I
	BUFB4+2000
	LDF 5
	STA
	ANSWER+2000
	LDA I
	DSPERA
ILLGL1,	JMP B6FRB0
	JMP GETANS	/WAIT FOR CR
	JMP B6FRB0
	JMP CLLDRA	/WAIT FOR CHAR
	JMP PROCMD	/YES, PROCESS IT
NOTUNQ,	LDA I
	DSPERA
	JMP ILLGL1	/DISPLAY ADD SPEC NOT UNIQUE
ILLG,	LDA 		/STR CODE IN PTR 3
	3
	LDF 5
	STA
	ERRCXX+2000
	JMP ILLGL
	CHAIN "LIFE B4"



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search