File: KEY.PA of Tape: Sources/Focal/s6

(Source file text) 

---

/FILE SECURITY DATAPLAN-FOCAL73
/TO BE LOADED WITH L L KEY;KEY.SV ON SYS:
/THAN CALL PROGRAM TO BE MODIFIED WITH L C XXXXX
/PROGRAM THAN SAVES AGAIN AND COMES BACK FOR MORE
/IF FOCAL IS TO BE CODED:INSERT THE CODE-NUMBER FIRST
/ADRESS FOR CODE-NUMBER IN FOCAL IS:01762

	MQL=7421
	MQA=7501
	GOSUB=1711
	CODENU=1762
	BUFR=60
	AUTO3=12
	AUTO4=13
	PC0=200
	LINE0=210
	LINE1=224
	SAVPR=1432
	EXITOS=22
	PDLXR=11
	POPA=4536
	PUSHF=4542
	SCHAR=1273
	WRITE=634
	FOCTXT=1570
	BLLL=1524
	FIELD 0

	*3000

	NOP
	TAD (CODENU&177+1+5200	/"JMP CODENU+1"
	DCA I (GOSUB-1	/MODIFY "L CALL" EXIT SO THAT
	TAD (CODENU&177+2+5600	/"JMP I CODENU+2"
	DCA I (CODENU+1
	TAD (.+3	/WE COME BACK TO HERE+3
	DCA I (CODENU+2	/AFTER A "L CALL XXX"
	JMP I (201	/TO CHAIN RETURN POINT;BACK TO FOCAL
	CDF 0
	TAD I (CODENU	/TRANSFER CODE-NUMBER
	CIA
	DCA TMCOD
	TAD TMCOD	/NEG. TEMP
	CIA
	DCA I (CODE	/IN APPEN
	CDF 10
	TAD (7600
	MQL
	TAD I (BUFR	/GET LENGTH OF PROGRAM
	MQA		/OR WITH 7600
	CLL
	TAD (7600-7525	/SEE IF APPEN FITS IN PAGE
	SZL CLA
	TAD (200	/NO.ADD ONE PAGE
	TAD I (BUFR
	AND (7600	/IF IT DIDN'T FIT START OF PAGE
	TAD (APPEN&177-1
	DCA APPSTR	/STORE TEMP
	TAD APPSTR
	DCA I (BUFR	/RESET BUFR
	TAD (APPEN-2
	DCA AUTO3
	CMA
	TAD APPSTR
	DCA AUTO4
	TAD (7600-7525
	CIA
	DCA COUNT
TRNSLP,	CDF 0		/NOW TRANSFER APPEN TO FLD 2
	TAD I AUTO3
	CDF 20
	DCA I AUTO4
	ISZ COUNT	/7525-7600
	JMP TRNSLP
	TAD TMCOD
	TAD I (LINE1
	DCA I (PC0+1	/C(LINE1)-CODE>PC0+1
	TAD TMCOD
	TAD I (LINE0
	DCA I (LINE1	/C(LINE0)-CODE>LINE1
	DCA I (LINE0	/0>LINE0
	TAD TMCOD
	TAD APPSTR
	IAC
	DCA I (PC0+2	/APPEN ENTRY-CODE>PC0+2
	DCA I (LINE0-1	/NOT NEEDED ANY MORE
	CDF 0
	DCA I (SAVPR+14	/SO "SAVPR" DOESN'T RESET LINE0-1
	JMS I (SAVPR	/NOW RESAVE PROGRAM
	JMP EXITOS	/AND BACK TO FOCAL

TMCOD,	0
APPSTR,	0
COUNT,	0

	PAGE

/THIS PART IS MOVED TO FLD 2 AT THE END OF THE PROGRAM

	*3325

	SKP		/FALLING IN WILL GIVE ERROR
APPEN,	JMS .		/ADRESS: C (PC0+2) + CODE
	CMA		/AC CARRIES C(PC0+2)
	TAD APPEN	/AC=CODE
	CIA
	TAD CODE
	SZA		/IF ZERO ALL OK
	JMP I PDLXR	/IT WILL BLOW UP
	DCA I PC02PT	/CLEAR POINTER
	TAD I LIN1PT
	TAD CODE
	DCA I LIN0PT	/SET LINE0
	TAD I PC01PT
	TAD CODE
	DCA I LIN1PT	/SET LINE1
	DCA I PC01PT
	CDF 10
	TAD VPOPA
	DCA I SCHARPT	/KILL MODIFY
	TAD VPOPA
	DCA I WRIT2PT
	TAD VPUSHF
	DCA I WRIT10	/KILL WRITE
	CIF CDF 0
	DCA I SVPTPT
	TAD SAVMOD
	DCA I BLM3PT	/KILL SAVE
	TAD APPEN	/APPEN IN AC FOR BUFR
	JMP I .+1
	GOSUB-4

	SAVEPT=1467

CODE,	0
PC02PT,	PC0+2
LIN1PT,	LINE1
LIN0PT,	LINE0
PC01PT,	PC0+1
VPOPA,	POPA
VPUSHF,	PUSHF
SCHARP,	SCHAR
WRIT2P,	WRITE+2
WRIT10,	WRITE+10
SVPTPT,	SAVEPT+3
SAVMOD,	FOCTXT&177-1+1200	/"TAD FOCTXT-1"
BLM3PT,	BLLL-3

$$$$

---