File: TXTDTP.PA of Tape: Sources/Focal/s6
(Source file text) 

IFNZRO TXTLST <XLIST>

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

/&1
	FIELD 2
/CORE MAP:	/0-177:	 PDL SUBROUTINES;FREE AX.REGS.:15-17
		/200-X: TEXT
		/X-7577: PUSHDOWN LIST
		PSHBOT=7577

	*0
	0		/FOR RUBOUT PROTECTION;SEE RUB1
PSHBUF,	BUFR		/INDIRECT FOR TEXT PROTECTION
PSHCDF,	CDF 0
PSHERR,	ERR2		/POINTER TO ERRROR ROUTINE
	0
	0		/FOR ODT
	0
PSHCNT,	0
PSHAX,	0
PDLXR,	PSHBOT-2	/MAIN AX FOR PDL
PSHM4,	-4
PSHMSK,	7
PSHFRS,	PSHBOT

	*20
PSHM5,	-5

ZPOPA,	0	/ONE ITEM FROM PDL TO AC;OLD AC IN MQ
	JMS FLDSET
	TAD I PDLXR
	JMP FLDCDI	/NO INC RETURN

ZPUSHA,	0	/AC TO PDL;0 TO MQ
	JMS FLDSET
	CLA CMA
	JMS PCHK
	SWP
	DCA I PDLXR
	CLA CMA
	JMS PCHK
	JMP FLDCDI	/NO INC RETURN

	/LOCAL FIELD SATELLITES FOR ALL POPS EXCEPT
	/POPJ MUST BE AS FOLLOWS:
	/XPOPU,	0
	/	MQL
	/	FLDCUR	(DEFINED ON OTHER PAGE)
	/	CIF T	(WHERE T IS FIELD OF POP SUBS.)
	/	JMS I .+1
	/	ZPOPU
/&2

	/FLDCUR	=CLA CMA  FOR FIELD 	0
	/	=CLA			1
	/	=CLA IAC		2
	/	=CLA IAC RAL		3
	/	=CLA CLL CML IAC RAL	4
	/	=CLA IAC RTL		5
	/	=CLA CLL CMA RTL	6
	/	=CLA CLL CMA RAL	7

	/THIS SEQUENCE COULD BE MODIFIED:FLDSET+1

FLDSET,	0	/SUBROUTINE FOR ANALYZING FIELDS AND ADRESSES
	IAC
	AND PSHMSK	/TAKE ONLY 7 BITS
	CLL RAL
	RTL
	TAD PSHCDF
	DCA FLDCDF	/CALLING DATA FIELD
	TAD PSHCDF	/NOW LET'S SEE WHICH D.F. HE PUT
	RDF
	DCA ACCES	/ACCES DATA FIELD
	CDF T		/THIS FIELD
	CLA CLL CMA RAL	/JMS FLDSET ALWAYS FIRST INSTR. OF ZPOPU'S
	TAD FLDSET	/ZPOPU+2
	DCA FLDRET	/NOW BECAUSE OF STANDARD FORM OF SATELLITES
	TAD PSHM5	/-5 PLUS THE
	TAD I FLDRET	/CONT. OF ZPOPU ENTRY,GIVES ADRESS OF XPOPU
	DCA FLDRET
FLDCDF,	HLT		/CHANGE TO CALLING D.F.
	TAD I FLDRET	/THIS IS ADRESS OF ARG.
	DCA FLDRET	/AND FINAL RETURN ADD. FOR POPA,PUSHA
	CLA CMA
	TAD I FLDRET	/ARGUMENT-1 FOR AX
	DCA PSHAX
	CLA CLL IAC RAL	/BUILD A CIF CDF CALLING FIELD
	TAD FLDCDF	/FOR FINAL RETURN
	DCA FLDCDI
	CDF T		/BACK TO THIS FIELD
	JMP I FLDSET

	/BY THE WAY: THE DATA FIELD IS ALWAYS RESET TO CURRENT
	/THIS CAN BE USEFUL

	/CALLS IN A PROGRAM WILL LOOK LIKE THIS:
	/CDF ACCES
	/PUSHF
	/    LOC
	/WILL PUSH 4 WORDS STARTING IN LOC IN FIELD ACCES
/&3

ZPUSHF,	0	/4 WORDS IN PDL;AC CONSERVED;0 TO MQ
	JMS FLDSET
	TAD PSHM4
	JMS PCHK
	TAD PSHM4
	DCA PSHCNT
ACCES,	HLT		/SET BY FLDSET
	TAD I PSHAX	/""
	CDF T
	DCA I PDLXR	/STORE IN PDL
	ISZ PSHCNT
	JMP ACCES	/LOOP
	TAD PSHM4
	JMS PCHK	/RESET PDLXR
	SWP		/RESTORE AC
	ISZ FLDRET	/BUMP PAST ARG
FLDCDI,	HLT		/CDI CURRENT
	JMP I FLDRET	/EXIT
FLDRET,	0

ZPOPF,	0	/4 WORDS FROM PDL IN LOC;AC CONSERVED;0 TO MQ
	JMS FLDSET
	TAD PSHM4
	DCA PSHCNT
	TAD ACCES	/RELOCATE CDF ACCES
	DCA .+3
POPLOP,	CDF T
	TAD I PDLXR
	HLT
	DCA I PSHAX
	ISZ PSHCNT
	JMP POPLOP	/LOOP
	JMP FLDCDI-2	/SAME RETURN AS ZPUSHF
/&4

ZPUSHJ,	0	/GO TO ARG IN ACCES;CDF ALSO ACCES;AC CONSERVED
	JMS FLDSET			/0 TO MQ
	CLA CLL CMA RAL	/-2
	JMS PCHK
	IAC		/TO BUMP PAST ARG
	TAD FLDRET	/RETURN AFTER POPJ
	DCA I PDLXR
	TAD FLDCDI	/CDI AFTER POPJ
	DCA I PDLXR
	CLA CLL CMA RAL
	JMS PCHK
	CLA CLL IAC RAL
	TAD ACCES	/BUILD CDI ACCES
	DCA .+1
	HLT
	SWP		/RESTORE AC
	JMP I PSHAX	/!!

ZPOPJ,	TAD I PDLXR	/AC INCS RETURN AND IS LOST;MQ CONSERVED
	DCA FLDRET
	TAD I PDLXR
	DCA FLDCDI
	JMP FLDCDI

	/!!!!!
	/THIS IS THE ONLY POPU THAT NEEDS ANOTHER SATELLITE!
	/XPOPJ,	CIF CDF T
	/	JMP I .+1	/JMP!!
	/	ZPOPJ

PCHK,	0	/SUB TO BACKUP PDL AND CHECK OVERFLOW
	TAD PDLXR	/AC COMES IN WITH AMOUNT OF BACKUP
	DCA PDLXR
	TAD PDLXR
	CIA CLL
	CDF P		/SOME OTHER FIELD
	TAD I PSHBUF	/GET LOWER BOUNDARY
	CDF T
	SNL CLA
	JMP I PCHK	/NO OVERFLOW
	TAD PSHFRS	/RESET PDL
	DCA PDLXR
	CIF CDF P
	JMS I PSHERR
/&5

	*200

PC0,	0	/TEXT BUFFER HEAD
	0
	0
	0
	0
	5051	/LPAR,RPAR FOR DUMP
	BUFR
	235
LINE0,	LINE1
	0
	TEXT "C DATAPLAN-FOCAL73"
	*.-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

	*PSHBOT-1
	INPUTX+2
	CIF CDF P	/POPJ RETURN FOR CHAIN

	>

IFNZRO TXTLST <XLIST>

$$$$$