File: TXTN.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
		/200-X: TEXT
		/X-7577: PUSHDOWN LIST

	*0
	0		/FOR RUBOUT PROTECTION;SEE RUB1
PSHBUF,	BUFR		/INDIRECT FOR TEXT PROTECTION
PSHCDF,	CDF 0
PSHERR,	ERROL		/POINTER TO ERRROR ROUTINE
	0
	0		/FOR ODT
	0
PSHCNT,	0
PSHAX,	0
PDLXR,	7505		/MAIN AX FOR PDL
PSHM4,	-4
PSHMSK,	7
PSHCOD,	376		/PO=PUSHDL. OVERFLOW
PSHM5,	-5
FLDCDI,	HLT		/CDI CURRENT
	JMP I FLDRET		/EXIT
FLDRET,	0

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   FOR FIELD		0
	/	=CLA IAC		1
	/	=CLA IAC RAL		2
	/	=CLA CLL CML IAC RAL	3
	/	=CLA IAC RTL		4
	/	=CLA CLL CMA RTL	5
	/	=CLA CLL CMA RAL	6
	/	=CLA CMA		7

FLDSET,	0	/SUBROUTINE FOR ANALYZING FIELDS AND ADRESSES
	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
PSHFEX,	SWP		/RESTORE AC
	ISZ FLDRET	/BUMP PAST ARG
	JMP FLDCDI

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 PSHFEX	/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 PSHCOD
	CIF CDF L
	JMS I PSHERR

VPOPA=JMS I .
	NOP
VPUSHA=JMS I .
	NOP
VPUSHJ=JMS I .
	NOP
VPOPJ=JMP I .
	NOP
VPUSHF=JMS I .
	NOP
VPOPF=JMS I .
	NOP
	PAGE
/&5

PC0,	0	/TEXT BUFFER HEAD
	0
	0
	0
	0
	5051	/LPAR,RPAR FOR DUMP
	BUFR
	235
LINE0,	0
	0
	TEXT "C FOCACU  MAR-1974"
	*.-1
	7715	/DUMMY CR
LINE1,	0		/TEXT FOR AUTOMATIC LOADING AFTER CHAIN

	PAGE

	*7546

	/MONTHS OF THE YEAR

	TEXT "----"
	*.-1
	TEXT "JAN-"
	*.-1
	TEXT "FEB-"
	*.-1
	TEXT "MAR-"
	*.-1
	TEXT "APR-"
	*.-1
	TEXT "MAI-"
	*.-1
	TEXT "JUN-"
	*.-1
	TEXT "JUL-"
	*.-1
	TEXT "AUG-"
	*.-1
	TEXT "SEP-"
	*.-1
	TEXT "OCT-"
	*.-1
	TEXT "NOV-"
	*.-1
	TEXT "DEC-"

	PAGE



	>

IFNZRO TXTLST <XLIST>

$$$$$