File: FOCINT.PA of Tape: Sources/Focal/fc3

(Source file text) 

---

/INITIAL DIALOGUE FOR PS/8 FOCAL

	*176
	INIT

	*4000
INIT,	TAD (TELPCH
	DCA 176
	DCA TELSW
	CDF
	TAD I (207	/MOVE LENGTH OF INITIAL DIALOGUE
	CDF 10
	DCA BUFR	/(JUST IN CASE)
	ION
	PUSHJ
		DO+1
	IOF
	TAD (4300	/"#@" FOR SYSTEM STATUS
	JMS LOOKUP
	CLA CLL CMA
	TAD PT1
	DCA PT1
	FINT		/GET SYSTEM STATUS VARIABLE
	FGET I PT1
	FPUT INITMP	/SAVE IT FOR LATER
	FEXT
	TAD FLAC+1	/IF IT'S ZERO, INITIAL DIALOGUE WASN'T THERE
	SNA CLA
	JMP SECRET	/ASSUME STANDARD FEATURES
CHKLOG,	TAD (100	/"A@" (KEEP SIN & COS)
	JMS LOOKUP
	SZA CLA
	JMP CHKSIN
	JMS CHANGE	/KILL ALL EXTENDED FUNCTIONS
		SINADD-1
	TAD (XTAB-1	/SET VARIABLE BOTTOM
	JMP CHKFIL-1
CHKSIN,	TAD (200	/"B@" (KEEP ALL FUNCTIONS)
	JMS LOOKUP
	SZA CLA
	JMP CHKFIL
	JMS CHANGE	/KILL LOG, EXP, ATN
		LOGADD-1
	TAD (5177	/AND RESET BOTTOM
	DCA BOTTOM
CHKFIL,	TAD (400	/"D@" (FILE COMMANDS)
	JMS LOOKUP
	SZA CLA
	JMP CHKSP
	JMS CHANGE	/KILL FILE COMMANDS
		FILADD-1
CHKSP,	TAD (500	/"E@" (LEADING SPACE IN TYPE [FOR FILES])
	JMS LOOKUP
	SZA CLA
	JMP CHKEQ
	JMS CHANGE
		SPADD-1
CHKEQ,	TAD (700	/"G@" ('=' IN TYPE)
	JMS LOOKUP
	SNA CLA		/REVERSE SENSE ON NON-STANDARD FEATURES
	JMP CHKCOL
	JMS CHANGE
		EQADD-1
CHKCOL,	TAD (1000	/"H@" (FOR ':' IN ASK)
	JMS LOOKUP
	SNA CLA
	JMP CHKAMP
	JMS CHANGE
		COLADD-1
CHKAMP,	TAD (1100	/"I@" (FOR & INSTEAD OF E)
	JMS LOOKUP
	SNA CLA
	JMP CHKPRC
	JMS CHANGE
		AMPADD-1
CHKPRC,	TAD (300	/"C@" (EXTENDED PRECISION)
	JMS LOOKUP
	SZA CLA
	JMP SECRET
	JMS CHANGE
		FORADD-1
	TAD (-31
	DCA LOOKUP
	TAD (7270
	DCA 10
	TAD (FORFIN-1
	DCA 11
	TAD I 11
	DCA I 10
	ISZ LOOKUP
	JMP .-3
SECRET,	TAD END
	DCA LASTV	/ERASE VARIABLES
	TAD (4100
	JMS LOOKUP	/CREATE THE THREE SECRET VARIABLES
	TAD (4200
	JMS LOOKUP
	TAD (4300
	JMS LOOKUP
	CLA CLL CMA
	TAD PT1
	DCA PT1		/BACKUP PT1
	FINT		/RESTORE SYSTEM SECRET VARIABLE
	FGET INITMP
	FPUT I PT1
	FEXT
	TAD LASTV
	DCA END		/MAKE THEM SECRET
	JMP I .+1
	2214		/ERASE ALL TEXT

INITMP,	ZBLOCK 4	/HOLDING AREA FOR '#'

	PAGE
LOOKUP,	0
	DCA ADD
	PUSHJ
		GS1
	ISZ PT1
	TAD I PT1	/PICK UP FIRST SIGNIFICANT WORD
	JMP I LOOKUP

CHANGE,	0
	TAD I CHANGE
	ISZ CHANGE
	DCA 10
CLOOP,	TAD I 10
	SNA
	JMP I CHANGE
	DCA T2
	TAD I 10
	DCA I T2
	JMP CLOOP

/THESE ARE THE LISTS TO PATCH FOCAL TO YOUR CUSTOMIZED SPECS

FORADD,	70
	5
	117
	7775
	5526
	7772
	5527
	7
	5310
	3756
	5314
	3756
	5320
	3756
	6143
	7771
	6277
	3147
	6402
	3047
	6540
	3043
	6736
	27
	7036
	5263
	7105
	2047
	7072
	3047
	7260
	7751
	0

FORFIN,	1042
	1046
	3256
	7004
	1045
	1041
	7420
	5304
	3045
	1256
	3046
	7200
	1254
	7004
	3254
	1200
	7004
	3200
	2255
	5267
	1254
	3046
	1200
	3045
	5661

FILADD,	PUSHB		/PATCH PUSHB
	MPUSHA-1+13
	PUSHB1		/PATCH PUSHB1
	5576+13
	1201		/PATCH COMGO
	2725
	0

SINADD,	405
	2725
	406
	2725
LOGADD,	402
	2725
	403
	2725
	404
	2725
	0

COLADD,	1216
	1371		/'TAD ALIST'
	1217
	JMS I ECHOP
	0

SPADD,	6001
	CLA CLL		/DON'T PRINT LEADING SPACE
	6002
	CLA CLL
	0

EQADD,	6001
	1335		/'TAD PEQ'
	6002
	PRINTC
	6135
	0275		/PRINT LEADING '='
	0

AMPADD,	5662
	7532
	6133
	246
	6301
	7532
	0

	PAGE


---