File LIFE B6

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

*20
	/SUBROUTINE FIELD, DISPLAY IN LAST QRT
SEGMNT	6
*20
	/B6 SUBROUTINE CALLER CALLING BANK IN DATA FIELD
	RETURN=6000
B6CALL,	STC JMPSUB
	QAC
	LZE		/IS L=0
	ADD P4000	/NO,SET BIT 0
	STC ACVALZ	/SAVE AC
	IOB
	PMODE
	RDF	/GET DATA FIELD SET UP RETURN INSTR FIELD
	LMODE
	ROR 1
	ADA I
	LIF
	STC LIFX
	ADD 0
	STC	BXRET
	LDA I
ACVALZ,	0		/RESTORE AC
JMPSUB,	0
LIFX,	0	/RETURN, EXIT
BXRET,	0
	/CONSTANTS, TEMP STOR, REF, FLAGS
LF,	212
CR,	215
P100,	100
JMQR,	4400+PREAD
JMQW,	4400+PWRITE
PRMTRS,	0	/PARA IN CORR TAPE
TEMP1,	0	/DECML
P4000,	4000
PLUS2,	2
P3,	3
P1,	1
SPSP,	4040
NUMPTS,	0	/NUMPTS IN PRINT SPECTROM
KIDORA,	IDORA
KRDORA,	RDORA
	/DORETTE CALLER
INTDRA,	SET 6
	0
	PDP
	PMODE
	KCC	/CLEAR KEYBOARD FLAG
	JMS I KIDORA
DRSTRT,	0
	2000	/BEG CORE LOC
	0
DREND,	0	/END CORE LOC
YOFFST,	0
YSCALE,	341		/SCR 1
	JMP .+4
	LMODE
CLLDRA,	SET 6
	0
	PDP
	PMODE
	KCC
	JMS I KRDORA	/REFRESH DORA
	KSF
	JMP .-2	/IF NO NEW CHAR, REFRESH DORA
	KRB	/CHAR IN AC, KEYBOARD FLAG CLEAR
	TSF		/PRINTER READY ?
	JMP .-1
	TLS		/OUTPUT CHAR
	LINC
	LMODE
	JMP 6	/RETURN
	/OUTPUT LINE OF DATA TO TTY:  PTR1 AT ST-1
PRNTLN,	LDA
	0
	STC PRNTPC	/SAVE RET
PRNTLA,	LDH I 1	/GET NEXT CHARACTER
	AZE
	JMP PRNTCH
	ADD CR	/IF 0, PRINT LF,CR
	JMP GOPRT
	CLR
	ADD LF
	JMP GOPRT
	CLR
PRNTPC,	RETURN
	/TURN 6 BIT DATA INTO 12 BIT
PRNTCH,	ADA I
	7740
	APO
	ADD P100	/LESS THAN 40, ADD 300
	ADA I
	237	/ELSE ADD 200
	JMP GOPRT	/PROCESS
	JMP PRNTLA
	/PRINT A CHARACTER IN AC
GOPRT,	IOB
	QATLS	/TLS
	LDA
	0
	STC .+4
	IOB
	QATSF	/TSF
	JMP .-2
	RETURN
	/SUBROUTINE TO READ, BLOCK TAPE IN AC
	/INTO B7Q1, FROM PARA IN B4
RDTAPE,	STC RWTAPE
	ADD JMQR	/TAPE READ
	STC TAPEZ1
	ADD 0
	STC RDTPRT
TAPEZ,	LDF 4
	LDA
	RWTAPE
	STA
	PARA+2002
	PDP
	PMODE
	CDF 10
TAPEZ1,	JMS I PREAD
	PARA
	LINC
	LMODE
	LDF 7
	CLR
RDTPRT,	RETURN
RWTAPE,	0	/STORE PARA 2
	/SUBROUTINE TO WRITE 1 BLK TAPE IN AC
	/INTO B7 QV FROM PARA IN B4
WTTAPE,	STC RWTAPE
	ADD JMQW	/TAPE WRITE
	STC TAPEZ1
	ADD 0
	STC RDTPRT
	JMP TAPEZ
	/SUBROUTINE TO PRINT LF,CR
	/LINES IN AC
PRLF,	COM
	STC 1
	ADD 0
	STC PRLFRT
PRLFA,	CLR
	ADD CR
	JMP GOPRT
	XSK I 1
	JMP PRLFA
	CLR
	ADD LF
	JMP GOPRT
	CLR
PRLFRT,	RETURN
	/SUBSUB TO STORE- WDS IN PTR15
	/FROM DATA FIELD IN PTR 16 LDF 7
	/TO DATA FIELD -1 IN PTR 17 LDF 1
	/IF PAST BLOCK, READ IN NEW BLK
TRNSMD,	LDA		/SET UP TRNXFER FROM B4
	0
	STC TRNSMT
	ADD Z7		/LDF 4
	STC TRNMD1
	JMP TRANS	/DO TRANSFER
	ADD TRNMD2
	STC TRNMD1	/RESTORE LDF5
TRNSMT,	RETURN
TRANS,	LDA
	0
	STC TRNSRT
TRANSA,	LDF 7	/GET NEXT LIFE BLOCK WD
	LDA 16
TRNMD1,	LDF 5
	STA I 17
	JMP TRANSB
	XSK I 15	/HAS BLOCK ENDED
	JMP TRANSA+1	/YES, INIT, READ NEXT
	CLR
TRNSRT,	RETURN
	/PRT 16 MUST BE ADVANCED.  READ IN NEW BLOCK IF NECC.
	/ PTR 16 IS LIFE BLOCK PTR B7Q1
TRANSB,	LDA
	0
	STC TRABRT
	LDF 7
	XSK I 16
	ADD 16
	SAE I
	2777
	JMP TRABRT-1
/WRITE OLD BLK
	LDF 4
	LDA
	PARA+2002
	JMP WTTAPE
	LDA 16	/READ NEW BLOCK
	JMP RDTAPE
	SET I 16
	2400
	LDA 16
TRABRT,	RETURN
	/SUBROUTINE TO PRINT INDEX SPECTRA
	/PTRS 10,11,12-1,15,16,17 USED IN SUBSUB
	/B0 ASSUMED IN B7Q0
TYA,	SET 10
	0
TRNMD2,	LDF 5		/CNST IN TRNMD
	LDA I
	3
	JMP PRLF	/PRINT 3 LF
	SET I 1
	TYO5+5777
	JMP PRNTLN	/PRINT INDEX
	ADD PLUS2
	JMP PRLF	/PRINT 2 LF
	LDF 4
	SET I 1
	TYO6+5777
	JMP PRNTLN	/PRINT INST, SPEC, TP, STBLK, PTS
	ADD P1
	JMP PRLF	/PRINT 1 LF
	/START OF DATA PROC FOR SUB COLUMNS
TYA1,	LDF 7
	SET I 11	/PTR 11 IS INDEX PTR-AT FRST BLK  OF LAST INST
	2007
TYA2,	LDA I 11
	AZE
	JMP TYA3
	APO I
	JMP 10	/IF NEXT ENTRY=0, PRINTOUT OVER
	XSK I 11
	XSK I 11
	JMP TYA2	/IF ENTRY=7777, DELETED, SKIP
TYA3,	SET 16	/SET UP INST DATA FIELD PTR
	11
	SET I 15	/4 CHAR=2WDS
	7775
	SET I 17
	TYANA+1777
	JMP TRNSMD	/TRNS INTO INST LN
	/GET SPECTUM DATA
	LDF 7
	XSK I 11
	LDA I 11	/FIRST BLK  IN AC
	ROL 2
	BCL I
	7774
	STC PRMTRS	/GET  PARA
	LDA 11
	BCL I	/CLEAR PARA FROM TAPE BITS
	6000
Z7,	LDF 4
	STA
	FSTBLK+2000
	JMP RDTAPE	/READ IN FIRST DATA BLOCK
	/GET SPECTRUM LINE
	JMP SET16	/INITIALIZE, STORE
	XSK I 16
	JMP TYA4A
TYA4,	JMP TRANSB	/START OF SPEC DATA
	AZE I
	JMP TYA2	/IF=0, GET NEW INST
	JMP SET16+2	/NO, PROC NEW ANS
TYA4A,	JMP TRNSMD	/TRANS SPEC DATA
	LDA 16		/FST TAPE WD,0 IF DEL
	AZE
	JMP TYAZ
	JMP TRANSB	/DELETED SPECTRA, GET PAST
	JMP TRANSB
	JMP TRANSB	/TO NUMPTS
	JMP TYAX	/TO START OF NEXT SPECTRUM
TYAY,	JMP TRANSB	/GET STBLK
	LIF 4
	JMP TYAY1	/GET OCTAL
TYAY5,	JMP TRANSB	/GET PTS
	SET I 17
	TYAN3E+1777
	LDF 4
	JMP DECML	/PROCESS INTO 4 DIG. COMPL LINE
	SET I 1
	TYAN3+5777
	JMP PRNTLN	/OUTPUT SPECTRUM LINE
TYAX,	JMP ADV16	/MOVE PTR 16 FROM PARA TO FIRST
	JMP TYA4
	/GET PAST TAPE NAME, STORE
TYAZ,	LDF 4
	STA
	TYAN3C+2000
	JMP TRANSB
	LDF 4
	STA
	TYAN3C+2001
	JMP TYAY
	/SUBROUTINE STORES WD IN AC AS 4 DEC ASC DIGITS
	/IN BUFF LOCATED BY PTR 17.  PTRS 13,14,2
DECMRM,	COM
	STC TEMP1	/GET + VAL
	LDA I
	55
V4,	STH 17
	CLR
	ADD TEMP1	/RESTORE AC
	JMP DECMLA
M1THS,	6027
M100,	7633
M10,	7765
M1,	7776
DECML,	STC TEMP1
	ADD 0
	STC DECMRT
	STC 14	/CLEAR DIGIT VALUE
	SET I 13
	7773	/SET DIGIT CNT
	SET I 12
	M1THS		/INIT PLACE PTR
	ADD TEMP1	/RESTORE AC
	APO		/IS VAL -
	JMP DECMRM
	LDA I
	40
	JMP V4		/NO STORE SP
DECMLA,	ADA 12
	AZE I
	JMP DECMLB	/IF NEXT ADD 0, PROCESS
	APO
	JMP DECMLC	/IF NEG, RESET
	XSK I 14	/IF +, BUMP DIGIT VALUE
	JMP DECMLA
DECMLB,	XSK I 14	/0 SEEN.  TERMINATE
	ADD 14
	JMP M1S	/ADD VALUE TO 60, STORE IN PTR 17
	60
	XSK I 13	/IS IT LAST DIGIT
	SKP
DECMRT,	RETURN
	STC 14	/RECLEAR DIGIT CNT
	JMP DECMLB+1	/FILL WITH 0
DECMLC,	COM	/NEG. RESTORE VALUE
	ADA 12
	COM
	STC TEMP1
	ADD 14
	JMP M1S	/WRITE IT
	60
	STC 14
	ADD TEMP1
	XSK I 12	/SET TO NEXT DIGIT
	XSK I 13	/OVER
	JMP DECMLA	/NO, GET MORE
	CLR
	JMP DECMRT	/YES, RETURN
	/SUBROUTINE PUTS 6 BIT ASC IN HALF WD OF PTR 17
M1S,	STC M1A
	ADD 0
	BCL I
	6000
	STC 2	/PTR 2 HAS NEXT LOC
	XSK I 0
	LDA 2
	ADA I
M1A,	0	/ADDED TO AC
	STH I 17	/STORE HALF WD
	CLR
	JMP 0
	EJECT
	/SUBROUTINE TO PRINT SPECTRUM POINTS HEADER, SET COMPUTE LINE
	/PTRS 10,11,12-1,15,16,17 USED IN SUBSUB
	/B0 ASSUMED IN B7Q0
	/SPECTRUM NAME, INSTRUMENT ALREADY STORED FROM DSP
	/PRMTRS CONTAINS  PARA
X12,	STC X32
	LDA I 11
	STC X22		/SAVE LOC
	SET I 12
X22,	0		/12 REACHES BUF
	LDA I
X32,	0
	STA 12
	JMP 0
TYB,	SET 10
	0
	LDF 4
	LDA I
	3
	JMP PRLF	/PRINT 3 LF
	SET I 1
	TYO7+5777
	JMP PRNTLN	/PRINT SPECTRUM
	ADD PLUS2
	JMP PRLF	/PRINT 2 LF
	SET I 1
	TYO8+5777	/PRINT INSTRUMENT
	JMP PRNTLN
	ADD PLUS2
	JMP PRLF	/PRINT 2 LF
	ADD PRMTRS
	COM
	STC 1	/SET 1=:PARA
	SET I 11
	TYB1-1
TYB2,	XSK I 1	/IS THERE MORE PARA
	ADD SPSP	/IF YES, INSERT SPACES
	JMP X12
	JMP X12		/NO,STORE TERM 0
	CLR
	XSK 1	/IS IT OVER
	JMP TYB2	/NO.  STORE MORE 40S
	/YES PRINT LINE
	SET I 1
	TYO9+5777
	JMP PRNTLN
	ADD PLUS2
	JMP PRLF	/PRINT 2 LF
	JMP 10	/RETURN
	/PARAMETER COUNT TABLE
TYB1,	TYO9A+2000
	TYAN4B+2000
	TYO9B+2000
	TYAN4C+2000
	TYO9C+2000
	TYAN4D+2000
	/SUBSUB TO COMPARE BUFFERS-1 IN PTR 6,7
	/WDS IN PTR 10
	/IF YES, 0, IF NO 4000
COMPR,	LDA
	0
	STC	COMPRT	/SAVE RET
COMPR1,	LDA I 6	/COMPARE
	SAE I 7
	JMP COMPR2
	XSK I 10	/YES, END
	JMP COMPR1
	CLR	/YES, OUT WITH 0 IN AC
COMPRT,	RETURN
COMPR2,	LDA I	/NO COMPARE
	7777
	JMP COMPRT	/EXIT, 4000 IN AC
SET16,	SET I 16	/SET UP FOR SEARCH LIFB DATA PTR 16-SUB
	2401
	LDF 7
	SET I 17
	TYAN3B+1777
	SET I 15
	7767
	JMP 0
MV16,	STC 15 	/MOVE 16  -LOC IN AC
	ADD 0
	STC MVRT
MV16A,	JMP TRANSB
	XSK I 15
	JMP MV16A
MVRT,	RETURN
	/SUBROUTINE TO CALCULATE PTS IN PTR 16
	/X PARAMETERS IN PRMTRS
	/AND ADVANCE PTR 16 THAT MANY
	/PTR 16 AT NUM PTS,BNDS IN FIRST WD OF NEXT SPECTRUM
ADV16,	LDF 7
	LDA
	PRMTRS
	COM
	STC 15	/SET 15 TO -PAR
	ADD 0
	STC ADVRT 	/SAVE RET
ADV16A,	ADA 16	/GET PTS X PARA
	XSK I 15
	JMP ADV16A
	COM
	STC 15	/STORE NEG IN 15
ADV16B,	JMP	TRANSB	/MOVE PTR 16 PAST PARA
	XSK I 15
	JMP ADV16B
ADVRT,	RETURN
	/B6 PART OF B4 SUB FST BLK, AC CONT INIT BLK
TYC1,	JMP TYCSB	/FIND SPECTRA
	JMP TYCNT	/CONTINUE
	LIF 4	/NO MATCH, EXIT
	JMP 5
	/SUBROUTINE TO FIND SPECTRUM
	/PTR 16 WILL BE AT NUMPTS, INIT BLK IN AC
	/SPECTRUM NAME IN TYO7A IN B5
	/IF NO MATCH, BUMP RETURN. PTRS6,7,10
TYCSB,	STC TYCSB1
	ADD 0
	STC RETTY	/SAVE RET
	LDA I
TYCSB1,	0 	/INIT BLK NUM
	JMP RDTAPE	/READ IN LIFE TAPE BLOCK
	JMP SET16	/SET UP FOR SPECTRUM READ
	JMP TRANSB	/PUT SPECTRUM NAME IN B4 TYAN3B
TYC1A,	JMP TRNSMD
	/PTR16 STILL AT LAST SPECTRUM LOC
	/SET UP COMPARE
	LDA 16		/IS SPEC DEL
	AZE I
	JMP TYC1N
TYC1M,	LDF 4
	SET I 6
	TYAN3B+1777
	SET I 7
	TYO7A+1777
	SET I 10
	7767
	JMP COMPR	/DO COMPARE
	APO		/IF + AC MATCH
/ONLY NOW PRINT HEADER
	JMP TYC1N
TYC1X,	JMP TYB		/DO PRINT OF HEAD
	JMP TYC2
	/NO MATCH GET NEXT SPECTRA, TRY AGAIN
	/FIRST MOVE PTR 16 TO START OF NEXT SPECTRA FROM END OF THIS
TYC1N,	LDA I
	7774
	JMP MV16	/GET TO NUM PTS LOCATION WITH PTR 16
	JMP ADV16	/GET TO LAST LOCATION OF OLD SPECTRA
	JMP TRANSB
	AZE I
	JMP TYC1B
	JMP SET16+2	/IF MORE SPECTRA, PROCESS
	JMP TYC1A
	/IF NO MORE SPECTRA
TYC1B,	LDA I
	1	/BUMP RET
	ADD RETTY
	STC RETTY
RETTY,	RETURN
	/MATCH, PRINT VALUES. PTR 16 AT FRST WD OF TSTNAME
TYC2,	NOP	/RESET BY DELSPEC ROUTINE
	LDA I
	7774
	JMP MV16	/GET TO NUM PTS
	STC NUMPTS	/SAVE
	JMP RETTY	/RETURN
	/PRINT SUB CONTINUED
TYCNT,	STC 11	/INIT LINE NUM
TYC1C,	ADD	NUMPTS
	AZE I
	JMP V1		/IF NO PTS,NO PRINT
	COM
	STC 10	/SAVE - NUMPTS
TYC1D,	ADD PRMTRS
	COM
	STC 7	/INIT - NUM PARA
TYC1E,	SET I 6
	TYB1+1
	XSK I 11	/STORE NEW LINE NUM
	LDA
	11
	SET I 17
	TYAN4A+5777
	LDF 4
	JMP DECML
	ADD SPSP
	STA
	TYAN4A+2000  /LINE NUM SHOULD BE ONLY 2 DIG
	/PROCESS NEXT POINT
TYC1F,	LDA I
	3775
	ADA 6
	STC 17	/SET UP FOR VALUE STORAGE VIA DECML
P2,	JMP TRANSB	/OVERLAY BE DORA PRT ROUT
	LDF 4	/GET NEXT PT VAL IN AC
	JMP DECML	/CONVERT, STORE
	XSK I 6
	XSK I 6	/ADVANCE PTR 6 TO NEXT TTB1 PTR
	XSK I 7
	JMP	TYC1F	/GET NEXT PARAMETER
	/NO MORE PARAMETERS
/PRINT LINE
	LDF 4
	ADD P1		/PRNT LF,CR
	JMP PRLF
	SET I 1
	TYAN4+5777
	JMP PRNTLN
	XSK I 10
	JMP TYC1D	/REINITIALIZE, GET NEXT POINT PARA
V1,	LIF 4		/IF ALL PTS DONE, RETURN
	JMP 5
	EJECT
	/SUBROUTINE TO TRANSFER DATA
	/PTR 2 HAS START OF TAKE -1
	/PTR 3 HAS START OF PUT -1
	/PRT 4 HAS -NUM WDS OF TRANS
TRDTA,	LDA
	0
	STC TRDTAR
TRDTA1,	LDA I 2
	STA I 3
	CLR
	XSK I 4
	JMP TRDTA1
TRDTAR,	RETURN
	/B6 PART OF SUB TO PRINT MATCHING SPECTRA
LBPRB,	LDF 5
	LDA I
	3
	JMP PRLF	/PRINT 3 LF
	SET I 1
	TYO1+5777
	JMP PRNTLN	/PRINT UNKNOWN
	STA
	TYO2A+2000	/SET TO 0 TO CUT OFF NUM MISSES
	SET I 1
	TYO4+5777	/PRINT SPEC, NUM PK PTS
	JMP PRNTLN
	ADD PLUS2
	JMP PRLF	/PRINT 2 LF
	LDF 4
	STA
	TYAN1B+2000	/SET TO 0 TO CUT OFF NUM MISSES ANS
	/TRANSFER SPECTRUM NAME, NUM PTS OF UNKNOWN
	SET I 2
	TYO7A+1777
	SET I 3
	TYAN1A+1777
	SET I 4
	7767
	JMP TRDTA	/TRANSFER SPEC NAME
	LDF 0
	LDA
	PTSUNK+2000
	LDF 4
	SET I 17
	TYAN1F+5777
	JMP DECML	/GET  PTS
	ADD SPSP
	STA
	TYAN1F+2000	/IN 2 DIGITS
	/PRINT UNKNOWN LINE
	SET I 1
	TYANS+5777
	JMP PRNTLN
	ADD SPSP
	LDF 5
	STA
	TYO2A+2000
	LDF 4
	STA
	TYAN1B+2000	/RESTORE IT
	LDA I
	3
	JMP PRLF	/PRINT 3 LF
	LDF 5
	SET I 1
	TYO3+5777
	JMP PRNTLN	/PRINT LIB
	ADD PLUS2
	JMP PRLF	/PRINT 2 LF
	SET I 1
	TYO4+5777
	JMP PRNTLN	/PRINT SPEC, NUM PK PTS, MISSES
	ADD PLUS2
	JMP PRLF	/PRINT 2 LF
	SET I 16
	2401
LBPRX,	JMP SET16+2
	SET I 17
	TYAN1+2000	/INIT FOR SPEC TRANS
LBPRC,	JMP TRANSB	/PTR 16 AT INIT LOC SPEC
	AZE	/IS THIS THE END
	JMP LBPRD
	LIF 4		/YES,EXIT
	JMP LBPRRT
LBPRD,	JMP TRNSMD	/NO, TRANSFER DATA
	LDA 16
	AZE	/IS SPECTRUM DELETED - TAPE NAME=0
	JMP LBPRE
	JMP TRANSB	/YES, GET PAST IT
	JMP TRANSB
	JMP TRANSB	/TO PARA PTS
	JMP ADV16	/TO LAST SPECTRUM PT
	SET I 15
	7767
	JMP LBPRC-2	/TRY AGAIN
	/SET UP REST OF LINE
LBPRE,	JMP TRANSB
	JMP TRANSB
	JMP TRANSB
	SET I 17
	TYAN1F+5777
	LDF 4
	JMP DECML	/CONVERT NUM PK PTS INTO TEXT BUFF
	ADD SPSP
	STA
	TYAN1F+2000	/WITH 2 DIGITS ONLY
	LDF 7
	LDA 16
	LIF 0	/GO TO B0 PORTION WITH NUM PTS IN AC
	JMP LBPRF
	/FIND SPECTRA MATCH. YES, AC=0, STOP LAST SPEC NMLOC
	/NO, AC NOT=0 -BUT. INIT BLK NUM IN AC CALL
FNDSPB,	STC TYCSB1	/STORE INIT BLK NUM
	ADD 0
	STC FNDRT
	LDA I
	JMP RETTY
	STC TYC2	/SET UP FIND SPEC ROUTINE
	ADD P16
/AVOID HEADER PRINTOUT
	STC TYC1X
	JMP TYCSB+1	/GET SPEC PT
	JMP FNDSPC
	JMP RSTRTY	/NO MATCH, RESTORE
	ADD LF
FNDRT,	RETURN	/RETURN, AC+
RSTRTY,	LDA I	/RESTORE FIND SPEC ROUT
P16,	16
	STC TYC2
	LDA I
	JMP TYB
	STC TYC1X
	JMP 0
FNDSPC,	JMP RSTRTY	/MATCH, RESTORE
	JMP FNDRT	/0 IN AC
	/SUBROUTINE TO STORE DATA WD IN THE AC IN THE
	/NEXT LOCATION IN A DATA BLK
	/IF NEXT LOC LAST IN BLOCK, GET NEW DATA BLK STORE
	/SET BIT MAP ETC.
STRLF,	LDF 7
	STA 16	/STORE VALUE
	LDA
	0
	STC STRTRT
	XSK I 16	/IS THIS THE END OF A BLOCK
	ADD 16
	SAE I
	2777
	JMP STRTRT-2
	LIF 4	/YES
	JMP STRLFB	/GET DAD SET, NEW BLK NUM IN AC
STRLFC,	STA 16	/STORE NEXT BLOCK
	STC STRTPA	/WRITE OUT OLD BLOCK
	JMP WTTAPE+1
	/SET NEW BLOCK IN PARA, AND PTR 16
	LDA I
STRTPA,	0	/GET BLK NUM IN PARA
	LDF 4
	STA
	PARA+2002
	SET I 16
	2400	/INITIALIZE PTR 16
	LDF 4
	CLR
STRTRT,	RETURN	/GO BACK, AC CLEAR
	/DORETTE PRINT ROUTINE PTR FAKE
P4,	LDF 0	/BUMP DATA PTR
	LDA I 16
	JMP 0
	/SUBROUTINE TO GET DISPLAY ANSWER - NEVER CALL FROM B6
	/STORE AC VALUE IN TEXT STRING
GETANS,	LDF 5
	STA
	TXTSTR+2000
	LDA I
	40
	ADD LIFX
	STC .+1
	0 	/GET BACK ORIGINAL LDF
	LIF 5
	JMP DSCALL	/DO DSP, GET ANS, COULD BE IN LDF BUFF
GTANS1,	LDF 4
	CLR	/RETURN TO MAINLINE VIA B6 CALL
	JMP LIFX
	/SUBROUTINE TO MULTIPLY MULTMP,
	/ADD CONTENTS OF AC, STORE BACK
MULTMP,	0
MULACV,	0
MULT10,	STC MULACV
	ADD MULTMP
	ADA I		/CHECK FOR OVERFLOW
	-600		/-3840 IF X10
	APO I
	JMP MULT8E
	CLR
	ADD MULTMP
	ROL 3
	ADD MULTMP
	ADD MULTMP
	ADD MULACV	/HIGH ORDER X10
	STC MULTMP	/+AC, SAVE
	JMP 0
	/SUBROUTINE TO MULTIPLY MULTMP BY 8
	/ADD CONTENTS OF AC, STORE BACK
	/IF AC>7, JUMP ILLEGAL
MULT8,	STA
	MULACV
	BCL I
	7
	AZE
	JMP MULT8E	/8 OR 9, JUMP ILLEGAL
	ADD MULTMP
	ROL 3
	ADD MULACV	/ELSE MULT, ADD AC
	STC MULTMP
	JMP 0
	/SUBROUTINE TO PROCESS BUFFER WHOOSE LOC
	/IN PTR6. -NUM CHAR+1MAX PN PTR 7
	/AC+01F DEC,+3777 IF OCTAL
BMULT1,	0
BMULT,	STC BMULT1
	ADD 0
	STC BMULTR	/SAVE RET
	STC MULTMP	/INITIALIZE BUFF
	SET 6	/COPY PTRS
	2006
	SET 7
	2007
BMULT2,	LDH I 6	/GET NUM IN AC, IF NOT NUM, JMP ILLEGAL
	SHD I
	3400	/IS IT END OF FIELD
	JMP BMULTS
	SHD I
	7400
	JMP BMULTS
	AZE I
	JMP BMULTS	/YES, OUT
	ADA I
	7706
	APO I
	JMP MULT8E
	ADA I
	11
	AZE I
	CLR
	APO
	JMP MULT8E
	SRO
	BMULT1
	JMP MULT8	/EITHER X8, BIT SET
	SRO
	BMULT1
	SKP
	JMP MULT10	/OR X10, BIT CLEAR
	XSK I 7
	JMP BMULT2	/JUMP BACK
	JMP	MULT8E	/ELSE TOO MANY CHAR, ERROR
BMULTS,	LDA
	MULTMP	/RESTORE PROCESSED NUM TO AC
BMULTR, RETURN
	/ERROR, DETERMINE CALLING BANK - 0 OR 4
MULT8E,	LDA
	LIFX	/GET UPPER-CALLING-FIELD
	SAE I
	600
	JMP CHBANK
	LDF 0
	LDA I		/SET UP ERR CD
	4062
	STA 2003
	LIF 0	/B0
	JMP ILLG
	/B4
CHBANK,	LIF 4
	JMP MNLNER	/JUMP MAINLINE ERROR
	*1400
/DISPLAY (MINI MAGSPY )
/COPYRIGHT 1970
/DIGITAL EQUIPMENT CORPORATION,MAYNARD,MASS.
/MOVING WINDOW DISPLAY SUBROUTINE
/CURSOR READ OUT
/CORE OR TAPE FILE
	PMODE
	 
	 
/INITIAL CALL GET PARAM LIST
/SET ARGS FOR RDORA
	 
	 
IDORA,	0		/GET BOUNDS
	CLA CLL
	CDF 10
	TAD I IDORA	/DATA BUFFER
	DCA I KMNFLD	/15 BIT
	ISZ IDORA	/LOWER BOUND
	TAD I IDORA	/AT P+1, P+2
	DCA I KMNADR	/MINFLD,MINADR
	ISZ IDORA
	TAD I IDORA	/UPPER BOUND
	DCA I KMXFLD	/AT P+3, P+4
	ISZ IDORA
	IAC		/RDORA USES
	TAD I IDORA	/MAX+1
	DCA I KMXADR
	RAL
	TAD I KMXFLD
	DCA I KMXFLD
	ISZ IDORA
	TAD I IDORA	/Y SHIFT
	DCA YSHFT
	ISZ IDORA
	TAD I IDORA	/Y SCALE
	DCA I KYSCAL
	TAD I KMNFLD	/INITIALIZE
	DCA I KBUFHI	/WINDOW
	TAD I KMNADR	/STARTING ADDR
	DCA I KBUFLO
	JMP I IDORA	/RTN TO SCR N
KMNFLD,	MINFLD
KMNADR,	MINADR
KMXFLD,	MAXFLD
KMXADR,	MAXADR
KBUFHI,	BUFHI
KBUFLO,	BUFLO
KYSCAL,	YSCAL
P401,	401
DSCLOC,	TAD P401	/DSC X,Y COORD
	DCA VCOORD
	TAD XCURHI	/FIELD
	JMS DSCWD
	TAD XCURLO	/ADDRESS
	JMS DSCWD
	TAD CORVAL	/CONTENTS OF
	JMS DSCWD	/CURSR CORE LOC
	TAD YCUR	/Y COORD OF
	TAD P401
	JMS DSCWD	/CURSOR POINT
RTNCDF,	0		/RESTORE USER
			/DATA FLD
	JMP I RDORA	/RTN
DSCWD,	0		/DSC C(AC)
	LINC
	LMODE
	STC TEMP	/SAVE VALUE
	STC XCORD	/CHAN 1
	SFA		/VC FOR FULL
	ROL I 5		/SIZE IS -40
	LDA I		/-20 FOR HALF
	-20
	LZE		/FULL CHARS ?
	ROL 1		/NO VC-40
	ADM I		/UPDATE VC
VCOORD,	0
DSCLOP,	LDA I
TEMP,	0
	ROL 3		/1 DIGIT
	STA		/AT A TIME
	TEMP		/UPDATE
	BCL I		/LOW 3 BITS
	7770		/ONLY
	ROL 1		/*2 AND REL
	ADA I		/TO GRID TAB
	TAB&1777
	STC 2
	ADD VCOORD
	DSC 2
	DSC I 2
	XSK I 1		/MAKE GAP
	XSK I 1		/BETWEEN CHARS
	SRO I		/DSC 4 CHARS ?
	3567
	JMP DSCLOP	/NO CONT
	PDP
	PMODE
	CLA CLL
	JMP I DSCWD	/RTN
TAB,	4536	/60,0
	3651
	2101	/61,1
	0177
	4523	/62,2
	2151
	4122	/63,3
	2651
	2414	/64,4
	0477
	5172	/65,5
	0651
	1506	/66,6
	4225
	4443	/67,7
	6050
RDORA,	0
	CLA CLL		/SAVE USER DF
	RDF
	TAD Z FLDZ0
	DCA RTNCDF
	LINC
	LMODE
CSAM,	CURSAM		/CURSOR
	SCR 1		/9 BITS COVERS
	PDP		/SCOPE
	PMODE		/MAKE RANGE
	TAD P401	/-1 TO -1000
	CIA CLL
	LINC
	LMODE
	STC CURCNT&1777
WSAM,	WINSAM		/WINDOW
	SCR 4		/75 CENTS W0RTH
	SET I XCORD
XXCRD,	-1000 		/OVERLAYED IF <1000 PTS
	JMP CONT&1777
/WRITE TAPE UNIT 0
/THIS IS NOT DORETTE
/THIS IS A LIFE INSERT
WTUN0,	SET 1
	0
	PDP
	PMODE
	CDF 10
	JMS I PWRITE
	PARA0
	LINC
	LMODE
	LDF 7
	CLR
	JMP 1
	PMODE
	PAGE
CONT,	2
CDF0,	CDF 10
	DCA DBLLO	/PUT KNOB VAL
	TAD DBLLO	/IN DAC
	SPA CLA		/PROPAGATE SIGN
	CMA		/BIT HI ORD
	DCA DBLHI
	JMS DADD
	TAD DBLLO	/UPDATE WIN ADDR
	DCA BUFLO
	TAD DBLHI
	DCA BUFHI
			/MUST CHK
			/WINDOW SA
			/WITH BOUNDS
			/TO MAINTAIN
			/BUFFER RING
	 
	JMS BOUND	/LOWER BOUND
MINFLD,	1
MINADR,	0
	SMA CLA		/LOW END WRAP?
	JMP CHKHI	/NO
	TAD MAXFLD	/RESET TO
	DCA BUFHI	/UPPER BOUND
	TAD MAXADR
WRAP,	DCA BUFLO
	JMS DADD	/CORRECT WRAP
	TAD DBLLO	/CORRECTED
	DCA BUFLO	/WINDOW SA
	TAD DBLHI
	DCA BUFHI
SETFLD,	TAD BUFLO	/SET DISPLAY
	DCA BUFPTR	/ARGS
	TAD NUMDIS
	DCA COUNT
	TAD BUFHI
	DCA BOUND
	JMS SETDF
NXTPNT,	TAD I BUFPTR
	TAD YSHFT	/OFF SET
	LINC
	LMODE
YSCAL,	SCR 1		/SCALE FACTOR
	DIS I XCORD
	PDP
	PMODE
	ISZ CURCNT	/READY TO DIS
			/CURSOR ?
CURRTN,	SKP CLA		/NO
	JMP CURDIS
	ISZ ENDLO	/CHK FOR HI
	JMP OKEND	/END WRAP
	ISZ ENDHI
	JMP OKEND
	TAD MINADR	/RESET TO
	DCA BUFPTR	/LOWER BOUND
	TAD MINFLD
	DCA BOUND
	JMP NXTDF
OKEND,	ISZ BUFPTR	/CHK FOR FIELD
			/BOUNDARY
	JMP OKFLD	/ITS OK
	ISZ BOUND	/SET NXT FLD
NXTDF,	JMS SETDF
OKFLD,	ISZ COUNT	/512 PNTS ?
	JMP NXTPNT	/NO
	JMP I .+1	/DSC READ OUT
	DSCLOC
CHKHI,	JMS BOUND	/CHK UPR BOUND
MAXFLD,	2
MAXADR,	0
M70,	SPA CLA		/HI WRAP ?
	JMP SETFLD
	TAD MINFLD	/YES
	DCA BUFHI	/RESET TO
	TAD MINADR	/LOWER BOUND
	JMP WRAP
/DOUBLE PRECISION ADD
/(DBLHI,DBLLO)+(BUFHI,BUFLO)
/RESULT IN (DBLHI,DBLLO)
/(BUFHI,BUFLO)=INITIAL SCOPE ADDRESS
	 
DADD,	0
	CLA CLL
	TAD DBLLO
	TAD BUFLO
	DCA DBLLO
	RAL
	TAD DBLHI
	TAD BUFHI
	DCA DBLHI
	JMP I DADD
	 
/ADD -UPPER OR -LOWER BOUND
/TO (BUFHI,BUFLO)
/BOUND IS AT P+1,P+2 OF CALL
	 
BOUND,	0
	TAD I BOUND	/2S COM OF ARG
	CMA CLL		/TO DAC
	DCA DBLHI
	ISZ BOUND
	TAD I BOUND
	CIA
	SZL
	ISZ DBLHI
M1000,	NOP
	DCA DBLLO
	JMS DADD
	TAD DBLHI
	DCA ENDHI	/DAC HOLDS -NUM
	TAD DBLLO	/TO END OF BUF
	DCA ENDLO	/NO MATTER FOR
			/LOW END WRAP
	TAD DBLHI	/TO CHK FOR
	ISZ BOUND	/UPON RTN
	JMP I BOUND
SETDF,	0		/SET 8 FIELD
	TAD BOUND	/REL TO BOUND
	CLL RTL
	RAL
	TAD Z FLDZ0
	DCA .+1
DBLLO,	0
	JMP I SETDF
CURDIS,	DCA YCUR	/DISP CURSOR
	TAD BOUND	/SAVE X,Y
	DCA XCURHI	/COORDINATES
	TAD BUFPTR
	DCA XCURLO
	TAD I BUFPTR
	DCA CORVAL
	TAD M70
	DCA DBLLO
	TAD YCUR
CURLOP,	LINC
	LMODE
	SNS I 5
	NOP		/CHANGE TO JMP FREE
/IF FREE CURSOR MOTION DESIRED
	DIS XCORD
	PDP
	PMODE
	ISZ DBLLO
	JMP CURLOP
	JMP CURRTN
CURCNT,	0
/THESE 5 GUYS MAY BE PAGE 0
BUFHI,	1
BUFLO,	0
ENDLO,	0
ENDHI,	0
	DBLHI=SETDF
	BUFPTR=DADD
	XCORD=1
	LMODE
	CURSAM=SAM 1	/CURSOR KNOB
	WINSAM=SAM 0	/WINDOW KNOB
	FRESAM=SAM 5	/FREE CURSOR
	SCALE=SCR
	SC12BU=SCR 3	/SCALE FACTOR
			/12 BIT UNSIGNED
	OF12BU=4000	/Y OFFSET FOR
			/12 BIT UNSIGNED
/THESE 6 GUYS MUST BE PAGE 0
/THEY ARE ALL CONTIGUOUS AND DEFINED
/RELATIVE TO YSHFT BUT THIS IS NOT
/A REQUIREMENT
	YSHFT=20
/THE 4 SCOPE READ OUT VALUES
	XCURHI=YSHFT+1
	XCURLO=XCURHI+1
	CORVAL=XCURLO+1
	YCUR=CORVAL+1
	COUNT=YCUR+1
/AN EXAMPLE TO DISPLAY ALL OF FIELD 1
/12 BIT UNSIGNED DATA
/PMODE
/*S0MEWHERE
/JMS I KIDORA		/INITIAL CALL
/1			/FLD
/0000			/ADDR
/1			/FLD
/7777			/ADDR
/OF12BU			/Y OFF SET
/SC12BU			/Y SCALE FAC
/JMS I KRDORA		/REFRESH CALL
/JMP .-1
/KIDORA,IDORA
/KRDORA,RDORA
	CHAIN "LIFE B5"



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