File: TXT875.PA of Tape: Sources/Focal/s7
(Source file text) 

IFNZRO TXTLST <XLIST>

IFZERO LTNASS <
EJECT OS-8 DISPLAY,TEXT,PDL

/&1
	FIELD 2
/CORE MAP:	/0-177:	 DISPLAY CONTROL PAGE ZERO
		/200-7577: TEXT (FIELD 4)
		/200-777: DISPLAY C0NTROL (REST)
		/5000-6777: DISPLAY FILE
		/7000-7577: PUSHDOWN LIST
		/FIELD 3:DIDDLES
		ENDTXT=7577
		DISFIL=5000
		END0=7000	/TOP OF PDL
		PSHBOT=7577
	*0
INTTEM,	0
FFD,	214
LFD,	212
HTABD,	211
	*7
M10,	-10
FILE,	0
XNM,	0
PDL,	0
DISERR,	176
DISMIN,	-DISFIL
CORNER,	1000
SUBWNC,	RESET-2
RESPNT,	JMP RESEX
	0
XA,	0
	0
YA,	0
XB,	0
YB,	0		/CHAR. ORIGIN
XO,	0
YO,	0		/P.PLOT ORIGIN
COSA,	0
COSB,	0		/FOR LINE
SINA,	0
SINB,	0		/IDEM
QUOT,	0
	0		/DOUBLE PREC. LOCATION
SIZE,	4		/FOR GRFDIS(GRAPH)
CNTINC,	0
SAVNAM,	0		/GEN. PURP. REGS
MASKA,	1777		/OVERFLOW
MASKB,	37
SWITCH,	FILSWI
PDMAX,	-PDBOT
PDLST,	PDTOP
FSTA,	DISFIL
/&2

DISPL,	0		/ACCESS FILE NAME
	SWAB		/CLEAR AC AND SWITCH TO MODE B FOR CHAIN
	TAD I SWITCH	/=0 FIRST TIME
	SZA CLA		/ONE FILE AT A TIME
	JMP NEXT
	DCSI		/CLEAR ALMOST ALL
	DCFF		/SLOW:FOR RANDOM PLOT
	DSPA		/PEN UP
	DCHS		/SCOPE CHANNEL
	TAD RESET-1
	DCA PLOSWI
	TAD NEXJM
	DCA DISPL+4
	TAD PDLST
	DCA PDL
	TAD FSTA	/PTS TO FDIS(1)
	DCA XNM		/NAME FILE INDEX
NEXT,	CLA CMA
	DCA I SWITCH	/SET SWITCH
	TAD I XNM	/NEXT NAMED FILE
	SNA		/LIST ENDED BY 0
	JMP RESET
	SPA SNA
NEXJM,	JMP NEXT	/NOT DISPLAYED IF NEGATIVE
	AND MASKA	/OVERFLOW PROTECT
	TAD FSTA
	DCA FILE	/PTS TO FDIS(I+1)
	TAD PLOSWI	/SEE IF PLOT ON
	SPA SNA CLA
	JMP RESET-2
	TAD CORNER	/YES GIVE ONE SHOT FOR INTERRUPT
	DLXA
	CMA
	DIEN		/ENABLE ALL INTERRUPTS
	DLYD
	TAD SUBWNC
	DCA SUBINT	/SO NEXT INT. GOES TO 'JMS DODIS'
	TAD RESPNT
	DCA DISPL+4	/SET "DISPL" FOR NULL LOOP
	JMP RESEX	/GO BACK TO MAIN BEFORE INT.
	JMS DODIS
	SKP
RESET,	DCA I SWITCH
	TAD PLOSWI	/IF PLOT ON
	SPA SNA CLA
	JMP RESEX
	TAD NEXJM
	DCA DISPL+4	/RESET TO "JMP NEXT"
	JMP PLOGO	/AND RETURN TO MAIN WITHOUT FLAG COMING
RESEX,	CIF CDF P	/JMP DISPL+1 DEBUG
	JMP I DISPL
/&3

DODIS,	0		/DISPLAY ONE FILE
	TAD I FILE
	DCFF		/SLOW MODE
	DSPA		/PEN UP
	SPA SNA		/+ & NON ZERO
	JMP I NOMODE
	DCA SAVNAM
	TAD SAVNAM
	TAD MMAX	/PROTECTION
	SMA CLA		/AGAINST DATA
	JMP I ERRPNT
	TAD SAVNAM
	TAD MODLOC
	DCA SUBINT
	TAD I SUBINT
	DCA SUBINT
	JMP I SUBINT

MODLOC,	MODE-1
MMAX,	-17

SUBINT,	0
PLOSWI,	SKP
	JMP PLOGO
	DSPD
	SKP
	JMP .+3
	DSCD
	JMP .-4
	JMP I SUBINT
PLOGO,	CIF CDF 0
	JMP I .+1
	INTRET

PLOINT,	TAD INTTEM
	JMP I SUBINT

NOMODE,	NMODE
ERRPNT,	ERR

	*177
	7777	/ACCESSED BY PC:GIVES 31.(LEFT ANGLE BRACK)7
/&5
	*200
LINDIS,	TAD XO		/SAVE X,Y
	DLXA
	DCA XA
	TAD YO
	DLYC		/AND DISPLAY ORIGIN
	DCA YA
	JMS SUBINT
	DSFF
	DSPB		/NOW FAST AND PEN DOWN
	CLA CLL
	TAD I FILE	/READ R*COS(THETA):X
	SPA
	CMA IAC CML	/ABS. AND SET L IF NEG.
	IAC		/+1 TO ELIMINATE ZERO
	DCA COSA	/STORE ABS. VALUE
	SZL
	CLL CMA RAL	/-2 IF NEG.
	IAC		/-1:NEG. , +1:POS.
	DCA SAVNAM	/SAVE INCREMENT
	TAD COSA
	CIA
	DCA COSB	/STORE NEGATIVE
	CLA CLL
	TAD I FILE	/READ R*SIN(THETA):Y
	SPA
	CMA IAC CML
	IAC
	DCA SINA
	SZL
	CLL CMA RAL
	IAC
	DCA CNTINC	/SAVE Y INCREMENT
	TAD SINA
	CIA
	DCA SINB	/STORE Y NEGATIVE
	MQL
	CMA		/TO PREVENT 45DEGR. STALEMATE
	TAD SINA
	DVI
		COSA
	SZL		/DIVIDE OVERFLOW?
	JMP INVERT	/YES
	DPIC		/FOR ROUNDING
	ISZ CNTINC	/IS Y NEGATIVE?
/&6

	JMP .+10	/NO
	CMA		/YES;NEG. REST
	DCA YA-1
	CMA
	TAD YA		/DECREMENT
	DCA YA
	DCM		/COMPLEMENT QUOTIENT
	SKP
	DCA YA-1	/REMAINDER TO LOW ORDER YA
	DST
		QUOT	/KEEP QUOTIENT
CYCLE1,	DLD		/Y CYCLE
		YA-1
	DAD
		QUOT	/DOUBLE PREC. INC. OR DECR.
	DLYA
	DST
		YA-1
	CLA
	TAD XA
	TAD SAVNAM	/INC. OR DECR. X
	DLXC
	JMS SUBINT
	DCA XA		/SAVE NEW X
	ISZ COSB	/CHECK FOR END
	JMP CYCLE1
	JMP DODIS+1
INVERT,	CLA		/SAME COMMENTS APPLY(INVERTED)
	TAD COSA
	DVI
		SINA
	DPIC
	ISZ SAVNAM
	JMP .+10
	CMA
	DCA XA-1
	CMA
	TAD XA
	DCA XA
	DCM
	SKP
	DCA XA-1
/&7

	DST
		QUOT
CYCLE2,	DLD
		XA-1
	DAD
		QUOT
	DLXA
	DST
		XA-1
	CLA
	TAD YA
	TAD CNTINC
	DLYC
	JMS SUBINT
	DCA YA
	ISZ SINB
	JMP CYCLE2
	JMP DODIS+1

GRFDIS,	TAD XO		/PLOTS Y
	DLXA
	DCA SAVNAM
	TAD I FILE	/DATA ALL NEG
	SMA
	JMP DODIS+2
	TAD YO
	DLYD
	JMS SUBINT
	TAD SAVNAM	/INCR. X
	TAD SIZE
	JMP GRFDIS+1

CONDIS,	TAD XA		/RESET ORIGIN
	DCA XO
	TAD YA
	DCA YO
	JMP DODIS+1
MODE,	ORGDIS
	ORRDIS
	ORTDIS
	STPDIS
	PLODIS
	AXEDIS
	GRFDIS
	HTXDIS
	VTXDIS
	DOTDIS
	LINDIS
	CONDIS
	NAMDIS
	PENDIS
/&8

DOTDIS,	TAD I FILE	/KEEP IT SLOW AND PEN UP
	SMA
	JMP DODIS+2
	TAD XO		/RELATIVE TO ORIGIN
	DLXA
	DCA XA		/UPDATE FOR CONDIS
	TAD I FILE
	TAD YO
	DLYC
	DCA YA
	JMS SUBINT
	JMP DOTDIS

STPDIS,	TAD I FILE	/RESET INCREMENT
	DCA SIZE
	JMP DODIS+1

SETCHR,	0	/SUBROUTINE FOR XTXDIS
	JMS SUBINT	/WAIT FOR FLAG
	DSC
	ISZ CNTINC	/DISPLAY X CHARS
	JMP .-3
	CLA CLL
	JMP I SETCHR

ORRDIS,	TAD XO	/DEFINES NEW RELATIVE ORIGIN
	TAD I FILE
	DCA XO
	TAD YO
	TAD I FILE
	DCA YO
	JMP DODIS+1
/&9

AXEDIS,	TAD YO		/LOAD Y
	DLYB
	TAD I FILE	/-X
	CIA
	TAD XO		/INITIAL POSITION
	DLXC
	DCA CNTINC
	JMS SUBINT
	DSFF		/FAST MODE
	DSPB		/PEN DOWN
	TAD I FILE	/+X
	TAD XO
	DCA SAVNAM
	CLA CLL IAC RTL
	TAD CNTINC
	DLXC
	JMS SAMCHK
	JMP .-4
	DCFF		/SLOW
	DSPA		/PEN UP
	TAD XO		/LOAD X
	DLXB
	TAD I FILE	/-Y
	CIA
	TAD YO
	DLYC
	DCA CNTINC
	JMS SUBINT
	DSFF
	DSPB
	TAD I FILE	/+Y
	TAD YO
	DCA SAVNAM
	CLA CLL IAC RTL
	TAD CNTINC
	DLYC
	JMS SAMCHK
	JMP .-4
	JMP DODIS+1
SAMCHK,	0
	DCA CNTINC
	JMS SUBINT
	TAD SAVNAM
	MQL
	TAD CNTINC
	SAM
	CLA
	SGT
	ISZ SAMCHK
	JMP I SAMCHK
/&10

VTXDIS,	CMA
HTXDIS,	DCA SAVNAM	/SET SWITCH FOR TABS
	TAD FFD		/FORM FEED: 214
	DSC		/HOME UP
	CLA CLL
	TAD YB		/NO. OF CR'S
	SNA
	JMP .+5
	CIA
	DCA CNTINC
	TAD LFD		/LF:212
	JMS SETCHR
	TAD XB		/NO. OF TABS
	SNA
	JMP .+5
	CIA
	DCA CNTINC
	TAD HTABD	/HOR.TAB.:211
	JMS SETCHR
ONECAR,	CMA
	DCA CNTINC	/SET FOR ONE CHAR.
	TAD I FILE	/GET CODE
	SMA		/DATA?
	JMP .+12	/NO
	JMS SETCHR	/YES
	TAD SAVNAM	/WAY UP?
	SMA CLA
	JMP ONECAR	/NORMAL
	TAD M10		/VERTICAL TEXT
	DCA CNTINC
	TAD HTABD	/8 TABS
	JMS SETCHR
	JMP ONECAR
	JMS SUBINT	/WAIT FOR LAST CHAR.
	JMP DODIS+2

	PAGE
/&11

ORGDIS,	TAD I FILE	/SET XO,YO FROM FILE
	DCA XO
	TAD I FILE
	DCA YO
	JMP DODIS+1

ORTDIS,	TAD I FILE	/MAKE TEXT ORIGIN COMPATIBLE
	TAD CORNER
	LSR		/WITH POINT PLOT ORIGIN
	12
	CLA CLL
	TAD I FILE
	TAD CORNER
	CMA
	RAR
	RTR
	RTR
	AND MASKB	/THROW OUT ROTATED BITS;37
	DCA YB
	SZL		/HALF LINE?
	IAC		/YES
	SHL
	3
	DCA XB
	JMP DODIS+1
/&12

PUSH,	0
	DCA CNTINC	/TO SAVE
	CMA
	TAD PDL
	DCA PDL		/RESET PDL
	CLL
	TAD PDL
	TAD PDMAX
	SNL CLA		/OVERFLOW?
	JMP ERR
	TAD CNTINC
	DCA I PDL	/PUSH
	CMA
	TAD PDL
	DCA PDL
	JMP I PUSH

NAMDIS,	TAD I FILE	/GETS OFFSET(I)
	AND MASKA	/PREVENTS OVERFLOW
	SNA		/IS FILE THERE
	JMP DODIS+1	/THEN IGNORE
	DCA SAVNAM
	TAD FILE
	JMS PUSH
	TAD DODIS
	JMS PUSH
	TAD SAVNAM
	TAD FSTA
	DCA FILE
	JMS DODIS
	TAD I PDL
	DCA DODIS
	TAD I PDL	/POPA!
	DCA FILE
	JMP DODIS+1

PLODIS,	TAD I FILE
	SNA CLA
	JMP DODIS+1
	CMA
	TAD FILE
	DCA FILE
	DCA I FILE	/RESET TO SCOPE
	TAD PLOMOD
	DCA PLOSWI
	DCHP
	JMP NEXT

PLOMOD,	DCA INTTEM
/&13

NMODE,	SMA CLA
	JMP I DODIS	/ENDFILE FOUND
ERR,	CMA		/ZERO OUT ERROR
	TAD FILE
	DCA FILE
	DCA I FILE
	DIEN		/CLEAR INTERRUPT
	DCA I SWITCH
	CIF CDF P
	TAD DISMIN	/BUILD SPECIAL ERROR CODE FOR DIS
	TAD FILE	/=RELATIVE LOCATION IN DIS FILE
	DCA I .+4	/PUT IN ERR2
	TAD DISERR	/GET POINTER FOR FICTITIOUS LINE NUMBER
	DCA I .+3	/STORE IN PC
	JMP I .+3	/GO TO ERR2
		ERR2
		PC	/ERROR MESSAGE IS ?XX.XX #31.(LEFT ANGLE BRACK)7
		ERR2+1	/WHERE XX.XX IS OFFENDING LOC IN DIS FILE

PENDIS,	DSPA
	TAD I FILE
	SZA CLA
	DSPB
	JMP DODIS+1

PDBOT=.

PDTOP=.+20

	PAGE

	*5000

FILSWI,	0

	ZBLOCK 1777	/AVOID BEING KILLED BY WRONG DIS

	*7577

	INPUTX+2	/POPJ RETURN FOR CHAIN
	FIELD 4

/&4

	*200

PC0,	0	/TEXT BUFFER HEAD
	0
	0
	0
	0
	5051	/LPAR,RPAR FOR DUMP
	BUFR
	235
LINE0,	LINE1
	0
	TEXT "C-OS/8 FOCAL, 1972"
	*.-1
	7715	/DUMMY CR
LINE1,	0		/TEXT FOR AUTOMATIC LOADING AFTER CHAIN
	0212		/LINENUMBER 01.10
	TEXT "L R FOCAL.IN"
	*.-1
	7715		/C.R.
	7715
	0777		/"G" : GO IN COMMAND MODE
	1577		/C.R.

	PAGE
	FIELD 3


/UTILITY FOR INTERFACING
/BINARY TO BCD ROUTINE (3 BCD DIGITS )
/FROM DEC'S UTILITY ROUTINES
	*200

BINBCX,	0
	DCA BINPUT
	TAD BINCON
	DCA BINPTR
	CLL
	TAD BINCNT
	DCA BINNUM
	TAD BINPUT
BINPTR,	TAD BINTAB
	SZL
	DCA BINPUT
	CLA
	TAD BINNUM
	RAL
	ISZ BINPTR
	SNL
	JMP BINPTR-2
	CLL RTL
	RTL
	TAD BINPUT
	JMP I BINBCX

BINCON,	TAD BINTAB
BINPUT,	0
BINNUM,	0
BINCNT,	20
	DECIMAL
BINTAB,	-800
	-400
	-200
	-100
	-80
	-40
	-20
	-10
	OCTAL

BINBC3,	0
	JMS BINBCX
	CIF CDF 0
	JMP I BINBC3

	PAGE
/UTILITY FOR FUNCTIONS
/DOUBLE PRECISION BCD-BIN - EAE VERSION

DOUBCX,	0		/LO-BIN IN AC;HOBIN IN MQ
	SWP
	DCA DOU1
	CLA SWP
	JMS BCDBIN	/LO WIRD UMGEWANDELT
	DCA DOU2
	TAD DOU1
	JMS BCDBIN	/HO
	MQL		/HO-BIN IN MQ
	TAD DOU2	/LO-BIN IN AC
	MUY		/MQ MIT 1000(10) MULTIPLIZIERT
	DOU175		/UND AC DAZU ADDIERT
	JMP I DOUBCX	/RESULTAT IM AC
DOU175,	1750
DOU1,	0
DOU2,	0

/BCD TO BINARY, SINGLE PRECISION - MIT EAE
/AUS DECUSCOPE VOL. 10, NO. 3 - DORT AUCH COMMENTIERT

BCDBIN,	0		/BCD IM AC
	DCA DOU3
	TAD DOU3
	AND [7400
	MQL MUY
	DOU50
	TAD DOU3
	AND (7760
	MQL MUY
	DOU30
	CIA
	TAD DOU3
	JMP I BCDBIN	/BIN IM AC; 0 IM MQ
DOU50,	5000
DOU30,	3000
DOU3,	0

DOUBC3,	0
	JMS DOUBCX
	CIF CDF 0
	JMP I DOUBC3

	PAGE
DAC30,	DAL1
	CLA CLL
	CIF CDF P
	JMP I [EFUN3

	PAGE
/FLUX
/FOCAL OVERLAY FOR FLUXMETER

/MODE DEFINE:	 S Z=FLUX(M)
/CHAIN TO FADC.: S Z=FLUX(S)
/SET FIELD	 S Z=FLUX(H)
/READ FIELD	 S Z=FLUX(R)

/MODE:
	/BIT 0: 1=INT ON;  0=INT OFF

/INTERRUPT HANDLER SETZT VARIABLE "%" = 0


LUX3,	DCA FLUXAR
	CDF 10
	TAD I [CHARLY
	CDF 30
	DCA FLXARG
	TAD FLXARG
	TAD (-"M
	SNA CLA
	JMP FLMODE
	TAD FLXARG
	TAD (-"S
	SNA
	JMP FLCHN
	IAC
	SNA CLA
	JMP FLREAD
	TAD FLXARG
	TAD (-"H
	SNA CLA
	JMP FLSETH
	ERROR7
FLMODE,	TAD FLUXAR
	INIE
	DCA FLUXIN
	JMP FLEXIT
FLCHN,	INIE
	CDF 10
	DLD
		HORD
	SWP
	DCA FLSBIT
	TAD FLSBIT
	SPA
	DCM
	DCA FLHIGH
	MQA
	DCA FLLOW
	CDF 30
FLUSH2,	INSF
	JMP .-1
	INCF
	INRHI
	MQL
	INRLO
	JMS I [DOUBCX
	DCA FMHIGH
	CLA SWP
	DCA FMLOW
	TAD FLSBIT
	SMA CLA
	JMP FLUP
	TAD FLHIGH
	MQL
	TAD FMHIGH
	SAM
	SNL CLA
	JMP FLUSH2
	TAD FLLOW
	MQL
	TAD FMLOW
	SAM
	SNL CLA
	JMP FLUSH2
	JMP FLADC
FLUP,	TAD FMHIGH
	MQL
	TAD FLHIGH
	SAM
	SNL CLA
	JMP FLUSH2
	TAD FMLOW
	MQL
	TAD FLLOW
	SAM
	SNL CLA
	JMP FLUSH2
FLADC,	TAD FLUXIN
	INIE
	CIF CDF 0
	JMP I .+1
		XADC0

FLSETH,	TAD FLUXAR
	MQL
	CDF 10
	TAD I [HORD
	CDF 30
	DVI
	FL1750
	SZL
	ERROR7
	JMS I (BINBCX
	SWP
	JMS I (BINBCX
	INLHI
	MQA CLA
	INLLO
	JMP FLEXIT
FLREAD,	INRHI
	MQL
	INRLO
	JMS I (DOUBCX
	CDF 10
	DCA I [HORD
	CLA SWP
	DCA I [LORD
	DCA I [OVER2
	TAD [27
	DCA I [EXP
	CDF 30
	JMP FLEXIT
FLEXIT,	CLA CLL
	CIF CDF 10
	JMP I [EFUN3

FLSBIT,	0
FLXARG,	0
FLUXAR,	0
FL1750,	1750
FLUXIN,	1
FLHIGH,	0
FLLOW,	0
FMHIGH,	0
FMLOW,	0

	PAGE

ERR30,	0
	CLA CLL
	TAD ERR30
	CDF 10
	DCA I [ERR2
	CIF CDF 10
	JMP I .+1
		ERR2+1

ERROR7=JMS I [ERR30

EVAL3,	0
	CIF CDF P
	JMP I [EVAL1
EVAL3R,	JMP I EVAL3

	PAGE

>

IFNZRO TXTLST <XLIST>

$$$$$