Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-07 - 43,50462/focal.ctl
There are 2 other files named focal.ctl in the archive. Click here to see a list.
;Control File for DECsystem-10 FOCAL version 5J(345)-1 [19-Oct-76].

;C - THIS FILE CAN BE USED FOR THE FOLLOWING PURPOSES:
;C	1. PRINT THE CONTROL FILE:	.PRINT LPT1:=FOCAL.CTL/PRINT:ARROW
;C	2. INPUT TEST FILE FOR FOCAL:	.R FOCAL
;C					*OPERATE INPUT FOCAL.CTL
;C	3. ASSEMBLE AND LOAD FOCAL:	.SUBMIT FOCAL
;C	4. TEST FOCAL:			.SUBMIT FOCAL/TIME:55:00/TAG:TEST

;C	THE FOLLOWING FEW LINES ALLOW THE .CTL FILE TO BE EXECUTED BY FOCAL.
;C	THIS CODE WILL SKIP TO D0AA AND EXECUTE IT.
;01.20	I FCHR(-1)-37 1.2,1.3,1.2
;01.30	IF -FABS(FCHR(-1)-37)1.2;S K=1,A(1)=37,A(2)=37,A(3)=69,A(4)=87,A(5)=68,A(6)=48,A(7)=65,A(8)=65,A(9)=46,A(10)=70,A(11)=67,A(12)=76
;01.40	S K=K+1;IF -FABS(FCHR(FCHR(-1))-A(K)) 1.2;IF K-12 1.4;E,A;Q
;GO



;ASSEMBLY AND LOADING INSTRUCTIONS FOR DECsystem-10 FOCAL.
;FEATURE-TEST SWITCHES
;---------------------
;PROCESSOR TYPE.	PDP-6:	.CPU=1
;			KA-10:	.CPU=2
;			KI-10:	.CPU=3	(DEFAULT)
;			KL-10:	.CPU=4
;MONITOR TYPE (TO ALLOW USE UNDER MONITORS WITH SUNDRY MINOR DEFICIENCIES)
;MONITOR=3.27 OR 4.72 OR 5.03 OR 5.04 OR 5.05 OR 5.06 (DEFAULT 5.06)
;ARITHMETIC PRECISION:	WPV=1 SINGLE PRECISION
;			WPV=2 DOUBLE PRECISION (DEFAULT)
;FACET:		FNEW UNDEFINED:	HIGH SEGMENT ONLY (NULL LOW SEGMENT)
;		EXTERNAL FNEW : LOW SEGMENT ONLY. (FOCALL.REL)
.R TECO
*ERFOCAL.CTL_%%^E<45>EWFCLTMP.MAC12RXAMAK0,.KN%%^E<45>EF
.EXECUTE FCLTMP.MAC
.DELETE FCLTMP.MAC,FCLTMP.REL
.R MACRO
*FOCALH,FOCALH/C=FCLTMP.PRM,FOCAL
*FOCALL,FOCALL/C=TTY:,DSK:FCLTMP.PRM,FOCAL
*EXTERNAL FNEW
*
*
.LOAD FOCALH
.SSAVE DSK:FOCAL
.DELETE FOCALH.REL
.R CREF
*DSK:FOCALH=FOCALH/O
*DSK:FOCALL=FOCALL/O
.R RUNOFF
*FOCAL.MEM=FOCAL.RNO/UNDERLINE:SEPARATE
*FOCAL.DOC=FOCAL.RND/UNDERLINE:SEPARATE
.KJOB/F/Z:0
.IF(ERROR).GOTO HANG
TEST::
.CHKPNT HANG
.RENAME FHOLD.SHR=FOCAL.SHR	;SAVE STANDARD FILE.
.IF(ERROR)			;IGNORE ERRORS
.RENAME FHOLD.REL=FOCALL.REL	;SAVE STANDARD FILE.
.IF(ERROR)			;IGNORE ERRORS
.R TECO				;CREATE SOME TEMPORARY FILES.
*ERFOCAL.CTL3_%%%<XAMAK0,.KN%%%;0K0,.PEF>EX
.DELETE XMISC.FCL,XLUNAR.FCL,XMULPK.FCL,XLEARN.FCL
.DELETE XHAM.FCL,XRESEQ.FCL,XSYSTA.FCL
.EXECUTE FCLTMP.MAC		;CREATE PARAMETER & COMMAND FILES
.DELETE FCLTMP.MAC,FCLTMP.REL
.ASSIGN DSK LPT			;FORCE SYSTAT OUTPUT TO HAVE A KNOWN FILE NAME.
.SYSTAT/L
.DEASSIGN LPT
.R TECO
*ERSYSTAT.TXT_OF0,.KIFOCAL report forL.,ZKI
*HXAHK
*EBFOCAL.RPT<A-1-^N;>ZJ
.IF(ERROR)*EWFOCAL.RPT
*GAHPEF
;CONVENTION:	"PERMANENT RECORDS IN FOCAL.RPT END WITH CRLF."
.DELETE SYSTAT.TXT
.EXECUTE FCLSET
.LOAD FCLTMP.PRM+FOCAL.MAC/MACRO
.SSAVE
.DELETE FOCAL.REL

;CHECK VERSION NUMBERS OF DOCUMENTATION.
.DIR FCLTMP.DIR=/OPTION:FOCAL/W
.R RUNOFF
*FOCAL.MEM=FOCAL.RNO/UNDERLINE:SEPARATE
*FOCAL.DOC=FOCAL.RND/UNDERLINE:SEPARATE
.R TECO
*ERFCLTMP.DIR<A-1-^N;>J<S:;0KK>
*!VERSION(SHR)! J:SFOCAL	EXE"SOA'JSFOCAL	SHR!A!LRR27II2EO0LS>2S-S^ESI1EOS4RXA
*!DATE(RNO)!    JSFOCAL	RNOLRR27II2EO0LS>S^EDRI1EOS4RXB
*!DATE(RND)!    JSFOCAL	RNDLRR27II2EO0LS>S^EDRI1EOS4RXC
*HKERFOCAL.MEM_ ^EDR0,.KL.,ZKJMB!CHECK DATE IN RNO = DATE OF RNO!
*HKERFOCAL.MEM_VERSION 0,.KL.,ZKJMA!CHECK VERS IN RNO = VERS(SHR)!
*HKERFOCAL.DOC_[XDRR.,ZK0LSVERSION0,.KMA!VERS IN RND = VERS(SHR)!
*HKGDJMC!CHECK DATE IN .RND = DATE OF .RND!
.DELETE FCLTMP.DIR
.R TECO
*ERFOCAL.MEMEWFNEW1.FOR
*_DOUBLE PRECISION FUNCTION0L0,.KS      END
*.,ZKJ<6DS
*      ;6R>HPEF
.COPY NUL:=FOCAL.MAC	;THE MACRO SOURCE FILE.
.IF(NOERROR).GOTO LOOP
.TECO FOCAL.RPT
*<A-1-^N;>ZJISOURCE FILE ABSENT - NO ASSEMBLIES DONE
*EX
.DELETE FCLTMP.PRM
.GOTO FNEWT
CRASH::
.TECO FOCAL.RPT
*<A-1-^N;>ZJI[RE-STARTED AFTER CRASH]
*EX

LOOP::
.REVIVE
.CHKPNT CRASH
.EXECUTE FCLSET
.TECO FOCAL.RPT
*<A-1-^N;>ZJ0KIASSEMBLE NEXT CONFIGURATION FOR TESTEX
.R MACRO
*FCLTMP,FCLTMP=FCLTMP.PRM,FOCAL
*FOCALL=TTY:,DSK:FCLTMP.PRM,FOCAL
*EXTERNAL FNEW
*^Z
*^Z
.DELETE FOCAL.SAV,FOCAL.SHR,FOCAL.EXE,FOCAL.LOW
.LOAD FCLTMP/MAP:TTY:FOCAL
.SSAVE
.R TECO
*ERFCLTMP.LST<A-1-^N;>_PROGRAM^XBREAK.UAJ:SHI-SEG. BREAK"UQAJ'0LXBJS^EAR0,.KS	MACRO6R0XA
*HKEBFOCAL.RPT<A-1-^N;>ZJ0KITEST OF GAI
*-TGBITEST OF FNEWEX
.DELETE FCLTMP.LST,FCLTMP.REL
FNEWT::
.LOAD FOCALL/REL,FNEW1.FOR/F10
.ASSIGN NUL DSK
.ASSIGN NUL SYS
.ASSIGN NUL NEW
.ASSIGN NUL OLD
.START
.IF(ERROR).GOTO FNEWU
;HERE IF PDP-6.
.DEASSIGN
.GET FOCAL
.E 400000
.IF(NOERROR).GOTO CHECK	;AHA! NOT PDP-6!
.LOAD FOCALL/REL,FNEW1.FOR/F10
.ASSIGN DSK OLD
FNEWU::
.DEASSIGN OLD
.ASSIGN DSK OLD
.START
;NEXT LINE HAS A RUBOUT AFTER THE Z, TO CHECK THAT FEATURE.
*ZIF (-FABS(FNEW("ABC")-3));QUIT
;NEXT LINE HAS A BACKSPACE AFTER THE Z, TO CHECK THAT FEATURE.
*Z^HIF (-FABS(FNEW("ABCD")-4));QUIT
;NEXT LINE HAS TWO BACKSPACES AFTER THE Z TO CHECK THAT FEATURE.
*Z^H^HIF (-FABS(FNEW("1234567890")-10));QUIT
.DEASSIGN
.LOAD FOCALL/REL,FNEW1.FOR/F10
.ASSIGN NUL DSK
.ASSIGN NUL SYS
.ASSIGN DSK NEW
.ASSIGN NUL OLD
.START
.DEASSIGN
.LOAD FOCALL/REL,FNEW1.FOR/F10
.ASSIGN NUL DSK
.ASSIGN DSK SYS
.ASSIGN NUL NEW
.ASSIGN NUL OLD
.START
.DEASSIGN
.LOAD FOCALL/REL,FNEW1.FOR/F10
.ASSIGN NUL SYS
.ASSIGN NUL NEW
.ASSIGN NUL OLD
.START
.DEASSIGN
.TECO FOCAL.RPT
*<A-1-^N;>ZJ0KICORE SIZE CHECK AND GET/SAVE TESTEX
.TI
.GET FOCAL	;CHECK SIZE.
.E 404000	;HIGH SEG MUST BE LESS THAN OR EQUAL 2K.
.IF(NOERROR).GOTO CHECK
.E 400000
.IF(NOERROR).GOTO TWOSEG
.E 6000		;IF JUST LOW SEG, THEN IT MUST BE LESS THAN OR EQUAL 3K.
.IF(NOERROR).GOTO CHECK
TWOSEG::.START
*1.01 IF(X+1) ,1.03;Z - X IS NOT NEGATIVE.
*1.03 QUIT
*SET X=-1
*GO;CHECK PROGRAM FIRST.
*SET QQ$="HOW-DO-YOU-DO",YY=4.7537
*LIBRA SAVE FCLTMP.A
.REENTER
*LIBRA SAVE FCLTMP.B
.NSAVE FCLTMX
.IF(ERROR).SAVE FCLTMX
.REENTER
.IF(NOERROR).GOTO CHECK
*LIBRA SAVE FCLTMP.C
.START
.IF(NOERROR).GOTO CHECK
*LIBRA SAVE FCLTMP.D
.CORE 0
.GET FCLTMX.LOW
.IF(ERROR).GET FCLTMX
.START
.IF(NOERROR).GOTO CHECK
*LIBRA SAVE FCLTMP.E
*1.02 Z - CRASH HERE IF 1.01 DID NOT SKIP.
*GO
*SET X=3;LIBRA SAVE FCLTMP.F ALL;SET X=-1;LIBRA CALL FCLTMP.F
*LIBRA DELETE FCLTMP.F;GO;CHECK THAT IF LIST THEN NO SYMBOL TABLE.
.DELETE FCLTMX.SAV,FCLTMX.HGH,FCLTMX.LOW,FCLTMX.EXE
.TECO FCLTMP.A
*SVS^ESKI
*EX
.TECO FCLTMP.B
*SVS^ESKI
*EX
.TECO FCLTMP.C
*SVS^ESKI
*EX
.TECO FCLTMP.D
*SVS^ESKI
*EX
.TECO FCLTMP.E
*SVS^ESKI
*EX
.R FILCOM
*=FCLTMP.A,.B/Q/B
*=FCLTMP.A,.C/Q/B
*=FCLTMP.A,.D/Q/B
*=FCLTMP.A,.E/Q/B
.DELETE FCLTMP.A,FCLTMP.B,FCLTMP.C,FCLTMP.D,FCLTMP.E
.MAKE FOCAL.TMP
*I
*C - PLACE A NULL IN THE IMMEDIATE-MODE TEXT AREA PRIOR TO THIS COMMENT
*1.01	QUIT
*1.02	Z - CRASH LIBRA CALL.
*EX
.RUN FOCAL
*LIBRA CALL FOCAL.TMP
*GO;C - CHECK LIBRA CALL WITH INITIAL CRLF IN THE FILE.
.DELETE FOCAL.TMP
.TECO FOCAL.RPT
*<A-1-^N;>ZJ0KIELEMENTARY AND D0AA TESTSEX
.RUN FOCAL
*D
*E
*F X=1
*G
*I X
*Q
*R
*S X=0
*T
*W
*W ALL
*X
*O I D0AA
.IF(ERROR).GOTO CHECK
.TECO FOCAL.RPT
*<A-1-^N;>ZJ0KILIBRA CALL/SAVE TESTSEX
.RUN FOCAL
*L C XSPEED
*FOR I=1,127;SET COUNT(I)=I,STR$(I)=FCHR$(I)
*L S FCLTMP.A
*e a,;l c FCLTMP.A;l s FCLTMP.B
*E A,;L C FCLTMP.B;L S FCLTMP.B
.TECO FCLTMP.A
*SVS^ESKI
*EX
.TECO FCLTMP.B
*SVS^ESKI
*EX
.R FILCOM
*=FCLTMP.A,FCLTMP.B/Q/B
.RUN FOCAL
*L D FCLTMP.BAK
*L D FCLTMP.A
*l d FCLTMP.B
.TECO FOCAL.RPT
*<A-1-^N;>ZJ0KITYPING AND STRING MANIPULATION CHECKOUTEX
.RUN FOCAL	;TYPING CHECKOUT.
*TYPE %E5.04
*OPERATE OUTPUT DSK:FCLTMP.A/6
*OPERATE OUTPUT DSK:FCLTMP.B/7
*TYPE /6,0!		,/7,"=    0.0000"!
*TYPE /6,.000049!	,/7,"=    0.0000"!
*TYPE /6,.000051!	,/7,"=    0.0001"!
*TYPE /6,.0001!		,/7,"=    0.0001"!
*TYPE /6,.1!		,/7,"=    0.1000"!
*TYPE /6,1!,/7,"=    1.0000"!
*TYPE /6,9999!,/7,"= 9999.0000"!
*TYPE /6,%,1!,/7,"= 1.0000E+0"!
*TYPE /6,%,0!,/7,"= 0.0000E+0"!
*TYPE /6,%,.1!,/7,"= 1.0000E-1"!
*TYPE /6,%,10!,/7,"= 1.0000E+1"!
*TYPE /6,%,-1!,/7,"=-1.0000E+0"!
*TYPE /6,%,$,  /7,!
*SET X=5,Q(76)=76
*TYPE /6,%,$,  /7,!"S Q(76)	= 7.6000E+1"!"S X	= 5.0000E+0"!
*TYPE /6,%,X,! /7,"= 5.0000E+0"!

;CHECK STRING OPERATIONS TOO.
*SET X=5,X$="5",X6=6
*TYPE /6,X,X$,X6;TYPE X6;TYPE X$;TYPE X!;TYPE /7,"= 5.0000E+05= 6.0000E+0= 6.0000E+05= 5.0000E+0"!
*SET X$="A",X$(1)="BC",X$(2,0)="DEF",X$(3,0,0)="GHIJ",X$(4)="KLMNO", X$(5)= "PQRSTU"
*SET X$=X$+X$(1)+X$(2)+X$(3)+X$(4)+X$(5)
*SET Y$="ABCDEFGHIJKLMNOPQRSTU"+FCHR$(10)+FCHR$(13)
*TYPE /6,X$,!,/7,Y$
*SET X$="";TYPE /6 X$+X$
*SET X$="ABC"
*TYPE %2.01,/6,2.0,"HELLO","",2.0,X$,!/7"= 2.0HELLO= 2.0ABC"!
*TYPE /6,X,"HELLO",X,X$!/7"= 5.0HELLO= 5.0ABC"!
*TYPE /6 X "HELLO" X X$ /7 "= 5.0HELLO= 5.0ABC"
*TYPE /6 2.0 "HELLO" 2.0 X$ /7 "= 2.0HELLO= 2.0ABC"
*TYPE /6!"HELLO",2.0,X$,2.0,/7!"HELLO= 2.0ABC= 2.0"
*TYPE /6 "HELLO" 2.0 X$ 2.0!/7 "HELLO= 2.0ABC= 2.0"!
*TYPE /6 "HELLO",X , X$ , X ,!,/7, "HELLO= 5.0ABC= 5.0"!
*TYPE /6 "HELLO" X   X$   X  ! /7  "HELLO= 5.0ABC= 5.0"!
*ERASE
*ASK ;CHECK THAT NO COLON APPEARS IN THE OUTPUT.
*ASK "HOWDY";TYPE /6!/7!
*ASK X$;TYPE /6 X$! /7 "SPACEDELIMITER COMMA,"!
*SPACEDELIMITER COMMA,
*ASK W$,X$,Y$;TYPE /6 W$+X$+Y$!/7"SPACEDELIMITER COMMA,GREEN"!
*
*FOOYELLOW ^UA^U^RAB^RGAABABCABCDABCDEABCDEFREEN
*ASK W$,X$,Y$;TYPE /6 W$+X$+Y$!/7"SPACEDELIMITER COMMA,GREEN"!
*
*FOOYELLOW ^U^HA^U^RAB^H^H^RGA^HAB^H^HABC^H^H^HABCD^H^H^H^HABCDE^H^H^H^H^HABCDEF^H^H^H^H^H^HREEN
*ASK W$,X$,Y$;TYPE /6 W$+X$+Y$!/7"SPACEDELIMITER COMMA,GREEN"!
*
*FOOYELLOW ^U^HA^U^RAB^H^RGAAB^HABC^H^HABCD^H^HABCDE^H^HABCDEF^H^H^HREEN
*ERASE;SET X$="ALPHA"+FCHR$(10)+FCHR$(13)+"BETA"
*TYPE /6 $ /7 $$
*TYPE /6 $ /7 !"S X$	=	",FCHR$(34),"ALPHA",FCHR$(34),"+FCHR$(10)+",FCHR$(34),FCHR$(34),"+FCHR$(13)+",FCHR$(34),"BETA",FCHR$(34)!
*^UA^U^RAB^R^POAABABCABCDABCDEABCDEFPER^RATE OUTPUT TTY:/6;OPERATE OUTPUT TTY:/7
*^U^HA^U^RAB^R^POA^HAB^H^HABC^H^H^HABCD^H^H^H^HABCDE^H^H^H^H^HABCDEF^H^H^H^H^H^HPER^RATE OUTPUT TTY:/6;OPERATE OUTPUT TTY:/7
*^UA^U^RAB^R^POA^HAB^HABC^HABCD^H^HABCDE^H^H^HABCDEF^H^H^HPER^RATE OUTPUT TTY:/6;OPERATE OUTPUT TTY:/7
.R FILCOM
*=FCLTMP.A,.B/Q/B
.DELETE FCLTMP.A,FCLTMP.B
.TECO FOCAL.RPT
*<A-1-^N;>ZJ0KITELETYPE-SPECIFIC TESTSEX
;TELETYPE-SPECIFIC TESTS.
.RUN FOCAL
.REE
*1.1 C
*DO 1.1,1.1;DO 1.1
*
*?
*DO 1.1
*?
*L S TTY:
*1.1 C
*M 1.1
*
*O O TTY:
*O I TTY:
*T " ","?"
*	
.TECO FOCAL.RPT
*<A-1-^N;>ZJ0KIINACCESIBLE-CODE TEST.EX
.TECO FCLTMP.PRM
*:N.CPU=3"S^A
*?IT'S A KI-10!	GO MAN GO!
*^A'
.IF(NOERROR).GOTO NOSIM		;ONLY SIMULATE VERSIONS WITH PURE HI-SEG.
.LOAD FOCALL/REL,SIMFCL
.START
*L C XACCES
*^Z
.START
.IF(NOERROR).GOTO CHECK
*GO TO 1.01
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.IF(NOERROR).GOTO CHECK
*GO
.SET TTY NO ECHO
.IF(ERROR);IGNORE BATCH'S INCAPACITY!
.START
.IF(NOERROR).GOTO CHECK
*GO
=
.SET TTY ECHO
.IF(ERROR);IGNORE BATCH'S INCAPACITY!
.REENTER
*GO
;WE CAN'T DETACH, CCONT, DELAY, ATTACH, CONTROL-C, CONTINUE IN BATCH.
.R TECO
*ERSIMFCL.RPTYAHXAHKEBFOCAL.RPT<A-1-^N;>ZJ0LGAEX
.DELETE SIMFCL.RPT
NOSIM::
.TECO FOCAL.RPT
*<A-1-^N;>ZJ0KIERROR-MESSAGE CHECKOUT.EX
.RUN FOCAL
*OPERATE CALL FOCAL.CTL
.IF(NOERROR).GOTO CHECK
*OPERATE OUTPUT :
.IF(NOERROR).GOTO CHECK
*LIBRA OUTPUT
.IF(NOERROR).GOTO CHECK
*ERASE ALL
*12.34 ERASE ALL
*GO
*FOR X$=2,3,4;
.IF(NOERROR).GOTO CHECK
*FOR X="FIVE",3;
.IF(NOERROR).GOTO CHECK
*FOR X=2,"FIVE";
.IF(NOERROR).GOTO CHECK
*FOR X=2,X$;
.IF(NOERROR).GOTO CHECK
*FOR X=2,3,X$;
.IF(NOERROR).GOTO CHECK
*SET Y=X$
.IF(NOERROR).GOTO CHECK
*SET X$=Y
.IF(NOERROR).GOTO CHECK
*SET X$=2
.IF(NOERROR).GOTO CHECK
*SET X$=+Y$
.IF(NOERROR).GOTO CHECK
*SET X$=-Y$
.IF(NOERROR).GOTO CHECK
*SET X$=*5
.IF(NOERROR).GOTO CHECK
.ERROR %
.RUN
;ENSURE NO FOV ERROR FOR THE FOLLOWING TYPE-OUT:
*TYPE %%E25.18,1E-26
.RUN
;ENSURE ERROR MESSAGE FOR SQUARE ROOT OF -1:
*SET X=FSQT(-1)
.IF(NOERROR).GOTO CHECK
*TYPE %E3.03
.IF(NOERROR).GOTO CHECK
*TYPE %3.04
.IF(NOERROR).GOTO CHECK
*TYPE %100
.IF(NOERROR).GOTO CHECK
*TYPE /1 ;CHANNEL 1 IS NEVER AVAILABLE.
.IF(NOERROR).GOTO CHECK
.ERROR
.E 400000		;IS THIS THE PDP-6 VERSION?
.IF(ERROR).GOTO NOFPT
.ERROR %
.RUN
*TYPE 10^55
.IF(NOERROR).GOTO CHECK
*TYPE 10^(-55)
.IF(NOERROR).GOTO CHECK
NOFPT::.ERROR
.RUN
*GO ..;CHECK LOOP WITH DOUBLE PERIODS.!
.IF(NOERROR).GOTO CHECK
.CORE 15
.IF(NOERROR).GOTO BYPASS
;COME HERE TO CHECK THAT OVERFLOWING CORE IS O.K.
;DON'T CHECK IT IF IT WOULD TAKE TOO MUCH CPU TIME!
.RUN
*1.99 S I=I+1,X(I)=I;G 1.99;USE ALL AVAILABLE CORE
*GOTO 1.99
.IF(NOERROR).GOTO CHECK
.CORE
.CONTINUE
*TYPE I;ERASE
.CORE
BYPASS::.RUN
*OPERATE INPUT DSK:FOCAL.RNO/0
.IF(NOERROR).GOTO CHECK
*OPERATE INPUT DSK:FOCAL.RNO/5;ASK /0;TYPE /0
.TECO FOCAL.RPT
*<A-1-^N;>ZJ0KITEST COMPLETED.
*EX
.TECO FCLTMP.PRM
.IF(ERROR).GOTO DONE
*:SWPV=2"S-DI1EX':SWPV=1"U!A!^A
*?BAD PARAMETER FILE.
*^AEX'-DI2J:S.CPU="UOA'1A-1IDEX
.TECO FCLTMP.PRM
*:S.CPU=0"S^A
*?END OF FOCAL TESTS.
*^A'EX
.IF(ERROR).GOTO DONE
.SILENCE
.BACKTO LOOP

DONE::
.CHKPNT HANG
.DELETE FOCAL.SHR,FOCAL.SAV,FOCAL.EXE,FOCAL.LOW,FOCALL.REL
.RENAME FOCAL.SHR=FHOLD.SHR	;RESTORE STANDARD FILE.
.IF(ERROR)			;IGNORE ERRORS
.RENAME FOCAL.LOW=FHOLD.LOW	;RESTORE STANDARD FILE.
.IF(ERROR)			;IGNORE ERRORS
.RENAME FOCALL.REL=FHOLD.REL	;RESTORE STANDARD FILE.
.IF(ERROR)			;IGNORE ERRORS
.DELETE FCLTMP.PRM,FCLTMP.BAK,FNEW1.FOR,FNEW1.REL
.DELETE FCLSET.MAC,FCLSET.REL,SIMFCL.MAC,SIMFCL.REL,FCLTMP.FCL
.DELETE D0AA.FCL,XACCESS.FCL,XSPEED.FCL
.DELETE FOCAL.MEM,FOCAL.DOC,FOCALH.LST,FOCALL.LST

.TECO FOCAL.RPT
*<A-1-^N;>ZJI
*FOCAL SUCCESSFUL
*EX
.DELETE FOCAL.BAK
.DIRECTORY/S/OPTION:FOCAL
.SUBMIT FOCAL/TAG:STATS/TIME:03:00/OUTPUT:0
.KJOB/F/Z:0
.IF(ERROR).GOTO HANG
;CLOSE THE LOG FILE AND RE-OPEN IT.
;TO COMPLETE TESTS, YOU SHOULD ALSO FOLLOW THROUGH ALL EXAMPLES IN THE
;MANUAL AT THE KEYBOARD TO ENSURE THAT THERE ARE NO DISCREPANCIES.

%ERR::
CHECK::
.NOERROR
.DEASSIGN
.VERSION
.CORE
.REENTER
*WRITE ALL;TYPE $
=^Z
%FIN::
FAILED::
.CHKPNT HANG
.DEASSIGN
.VERSION
.CORE
.TECO FOCAL.RPT
*<A-1-^N;>ZJI
*FOCAL FAILED
*HERE IS AN EXTRACT FROM THE LOG FILE:
*[ONE MOMENT PLEASE...]EX
.SUBMIT FOCAL/TAG:FAIL2/TIME:03:00/OUTPUT:0
.ERROR
.KJOB/F/Z:0
.IF(ERROR).GOTO HANG
;CLOSE THE LOG FILE AND RE-OPEN IT.
FAIL2::
.CHKPNT HANG
.R TECO
*0UAERFOCAL.LOG!LOOP!Y:SERR:"SOA'J:SCHECK:"S!A!0L.,ZKJ<S^ED^ED:^ED^ED:^ED^ED;%A>ODONE'<S^ED^ED:^ED^ED:^ED^ED;%A>^N"EOLOOP'!DONE!
*EBFOCAL.RPT
*Y<A-1-^N;>ZJ0KHXB
*ERFOCAL.LOGHKQA-10_^ED^ED:^ED^ED:^ED^ED0L0,.KGBEX
.KJOB/F/Z:0
.IF(ERROR).GOTO HANG

STATS::
.CHKPNT HANG
.TECO FOCAL.RPT
*<A-1-^N;>ZJI
*HERE ARE SOME STATISTICS OF THE TEST...
*EX
.R TECO
*ERFOCAL.LOG:_	RUNTIME "U^Z'8R.UJ0L.,.+8XIQJJ0,.KI
*
*TOTAL TEST LITEST CONCLUDED AT GII
*0,.XTHKEBFOCAL.RPT<A-1-^N;>ZJGTEX
.DELETE FOCAL.BAK
.KJOB/F/Z:0
.IF(ERROR).GOTO HANG
%FIN::
.KJOB/F/Z:0
.IF(ERROR).GOTO HANG
HANG::
.CHKPNT HANG
.K/F/Z:0
.IF(ERROR)	;WELL IT WAS WORTH TRYING.
.DIR FCLTMP.DIR=/OPTION:FOCAL/W
.TECO FCLTMP.DIR
*<A-1-^N;>S[S,0,.KIALL:.UFD[*,L.,ZKEX
.DIR FCLTMP.DIR=@FCLTMP.DIR/OPTION:FOCAL/W
.DIR FCLTMP.BAK=FCLTMP.BAK/OPTION:FOCAL/W
.R TECO
*ERFCLTMP.BAK<A-1-^N;>S[R0,.KS].,ZKHXT-D@I/;0KK>/JDI<SHXMHKEBFCLTMP.DIR
*<A-1-^N;><S[1,1];-5D><STOTAL;0KK>MM<S,;S^N^ED;RI]=*.*GTKI
*-LI*.*[L>EX
HANG1::
.NOERROR
.DELETE FCLTMP.BAK
.PROTECT *.*
.PROTECT FCLTMP.DIR<577>
.RENAME @FCLTMP.DIR
.K/F/Z:0
.PROTECT FCLTMP.DIR
.TECO FCLTMP.DIR
.ERROR
*<A-1-^N;>KCEX
.IF(NOERROR).BACKTO HANG1
.DELETE FCLTMP.*
.IF(ERROR)
.K/F/Z:0
.IF(ERROR)
.MAKE HANG.MAC
*IHANG:	RESET
*	MOVEI	^^D6	;6 SECONDS SLEEP
*	SLEEP
*	INIT
*	SIXBIT "DSK"
*	0
*	JRST	HANG
*	SETZM	LKBLK+2
*	SETZM	LKBLK+3
*	HLLZS	LKBLK+1
*	LOOKUP	LKBLK
*	EXIT
*	JRST	HANG
*LKBLK:	SIXBIT	"HANG"
*	SIXBIT	"REL"
*	BLOCK	2
*	END	HANG
*EX
.IF(ERROR).BACKTO HANG
.EXECUTE HANG
.IF(ERROR).BACKTO HANG
.KJOB/F/Z:0
.IF(ERROR).BACKTO HANG
%FIN::
.KJOB/F/Z:0
.IF(ERROR).BACKTO HANG
%%%EWFCLSET.MAC
TITLE SETBIG - PROGRAM TO CHANGE THIS USERS SEARCH LIST
SUBTTL TO ENSURE MAXIMUM QUOTA FOR DISK FILES.

;THIS PROGRAM WILL SCAN ALL FILE STRUCTURES IN THE SYSTEM,
;	REJECTING THOSE WITH NO UFD FOR THIS JOB,
;	REJECTING THOSE WRITE-PROTECTED FOR THIS JOB,
;	REJECTING THOSE OFF-LINE OR DOWN,
;	TO FIND THE ONE WITH THE LARGEST AVAILABLE DISK SPACE FOR THIS JOB,
;	AND PLACE IT IN THE JOB'S SEARCH LIST AS THE FIRST ONE.
;	[ANY /NOCREATE WILL BE IGNORED AND CANCELLED.]

	SM=ST-1			;ACCUMULATOR JUST BELOW ST.
	ST=1			;NAME OF A DISK STRUCTURE.
	SP=ST+1			;ACCUMULATOR JUST ABOVE ST.
	AC=SP+1			;GENERAL-PURPOSE ACCUMULATOR.
	MQ=AC+1			;GENERAL-PURPOSE ACCUMULATOR.

	CH=1			;I/O CHANNEL.

	DC.OFL==1B1		;THE UNIT IS OFF-LINE.
	DC.HWP==1B2		;THE UNIT IS HARDWARE WRITE-PROTECTED.
	DC.SWP==1B3		;THE STR IS SOFTWARE WR-PROT 4 THIS JOB.
	DC.STD==1B8		;THE UNIT DOWN. (NOT STRICTLY CORRECT).
	DC.STN==1B7		;NO PACK MOUNTED (NOT STRICTLY CORRECT).
	DC.NNA==1B10		;THE UNIT IS IN A STR FOR NO NEW ENTERS.
	DC.AWL==1B11		;THE STR IS WRITE-LOCKED FOR ALL JOBS.
	.DCUFT==1		;OFFSET FOR LOGGED-IN QUOTA.
	.DCFCT==2		;OFFSET FOR TOTAL FCFS BLOCKS LEFT.
	.GTPPN==2		;TABLE NUMBER FOR PPN'S FOR GETTAB.

	OPDEF	GETTAB [CALLI 41]
	OPDEF	DSKCHR [CALLI 45]
	OPDEF	SYSSTR [CALLI 46]
	OPDEF	JOBSTR [CALLI 47]
	OPDEF	STRUUO [CALLI 50]

DEFINE ERROR (A),<
XWD 1000,[ASCIZ "?
?A
"]
>;END DEFINE ERROR (A)

LOC 41
	JRST	FAULT
RELOC

START:	RESET			;ENTER HERE FOR PROGRAM START.
	SETZM	BIGGEST		;CLEAR BIGGEST DISK SPACE SO FAR.
	SETZM	BIGSTR		;CLEAR STRUCTURE NAME FOR THAT SPACE.
	SETZM	ST		;CLEAR STRUCTURE NAME.
NXTSTR:	SYSSTR	ST,		;SYSSTR UUO - GET NEXT SYSTEM STRUCTURE.
	ERROR	SYSSTR UUO NOT IMPLEMENTED.
	JUMPE	ST,DUNSYS	;EXIT AT END OF SYSTEM LIST.
	MOVEM	ST,LOC		;STORE THE STRUCTURE NAME.
	MOVE	AC,[XWD 4,LOC]	;POINT TO THE LIST OF ARGUMENTS.
	DSKCHR	AC,
	ERROR	SYSSTR GAVE US A NON-DISK STRUCTURE!
	TDNE	AC,[DC.OFL!DC.HWP!DC.SWP!DC.STD!DC.STN!DC.NNA!DC.AWL]
	JRST	NXTSTR		;CAN'T USE THIS STRUCTURE.
	SETZB	SM,SP		;CLEAR I/O STATUS AND BUFFER ADDRESSES.
	OPEN	CH,SM		;SEE IF WE CAN INIT THE STR.
	ERROR	ONE OF THE SYSTEM DISK STRUCTURES CAN'T BE INITTED.
	HRROI	AC,.GTPPN	;SET UP TO ACQUIRE OUR OWN PPN.
	GETTAB	AC,
	ERROR	GETTAB .GTPPN FAILED
	MOVEM	AC,LKBLCK	;STORE PPN IN LOOKUP BLOCK.
	HRLZI	AC,(SIXBIT 'UFD')
	MOVEM	AC,LKBLCK+1	;LEFT HALF OF SECOND WORD IS SIXBIT 'UFD'.
	SETZB	AC,LKBLCK+2	;JUST FOR SAFETY.
	AOBJP	AC,.+1		;GET MFD PPN.
	MOVEM	AC,LKBLCK+3	;STORE TO LOOK IN MFD FOR OUR UFD.
	LOOKUP	CH,LKBLCK	;TRY TO FIND OUR OWN UFD ON THIS STR.
	JRST	NXTSTR		;NONE.	IT'S NO GOOD UNLESS WE HAVE A UFD.
	MOVE	AC,LOC+.DCUFT	;GET LOGGED-IN QUOTA FOR THIS UFD.
	CAML	AC,LOC+.DCFCT	;IS THAT MORE THAN BLOCKS AVAILABLE?
	MOVE	AC,LOC+.DCFCT	;YES! TAKE THE SMALLER VALUE.
	CAMG	AC,BIGGEST	;IS THE NEW ONE BIGGER?
	JRST	NXTSTR		;NO.
	MOVEM	AC,BIGGEST	;YES! STORE THE NEW VALUE.
	MOVEM	ST,BIGSTR	;ALSO STORE THE NAME OF THE STRUCTURE.
	JRST	NXTSTR		;NOW TRY THE NEXT STRUCTURE.

DUNSYS:	SKIPN	AC,BIGSTR	;DID WE FIND AT LEAST ONE STRUCTURE?
	ERROR	NO DISK STRUCTURE IS AVAILABLE TO THIS JOB.
	MOVEM	AC,LOC+1	;PLACE THAT STRUCTURE FIRST IN S.L.
	SETZM	LOC+2		;CLEAR RESERVED WORD.
	SETZM	LOC+3		;CLEAR STATUS TO ENABLE WRITING AND CREATION.
	SETOB	ST,LOC+4	;HERE TO OBTAIN THE JOB'S SEARCH LIST.
	MOVE	AC,[XWD 3,LOC+4];ARGUMENTS FOR JOBSTR UUO.
NXTJST:	MOVE	MQ,AC		;PRESERVE JOBSTR'S ACCUMULATOR.
	JOBSTR	MQ,
	ERROR	JOBSTR UUO FAILED.
	MOVE	ST,(AC)		;GET NAME OF NEXT STRUCTURE.
	CAME	ST,BIGSTR	;IS THIS THE STRUCTURE WE PUT UP AHEAD?
	ADDI	AC,3		;NO. MOVE TO NEXT ITEM IN THE LIST.
	MOVEM	ST,(AC)		;STORE  FOR NEXT JOBSTR CALL.
	AOJN	ST,NXTJST	;LOOP TO END OF JOB'S SEARCH LIST.
	MOVEM	ST,LOC		;SET STRUUO FUNCTION TO .FSSRC=0.
	SUBI	AC,LOC+3	;COMPUTE NUMBER OF WORDS IN ARGUMENT LIST.
	HRL	AC,AC		;PUT WORD-COUNT IN LEFT HALF.
	HRRI	AC,LOC		;POINT TO ARGUMENT LIST.
	STRUUO	AC,
	ERROR	STRUUO FAILED.
	EXIT

;UUO HANDLER...
FAULT:	OUTSTR	@40		;TYPE OUT THE ERROR MESSAGE.
	EXIT

BIGGES:	BLOCK	1		;BIGGEST DISK SPACE SO FAR.
BIGSTR:	BLOCK	1		;STRUCTURE CONTAINING BIGGEST SPACE.
LKBLCK:	BLOCK	4		;LOOKUP BLOCK.
LOC:	BLOCK	1+3*14		;DSKCHR BLOCK, JOBSTR BLOCK OR STRUUO BLOCK.
	END START
%%%EWFCLTMP.MAC
TITLE FCLTMP PROGRAM TO CREATE A PARAMETER FILE, CONTENTS DEPENDING ON CPU TYPE.
;FILE:	FCLTMP.PRM	PARAMETER FILE FOR FOCAL ASSEMBLY.
	AC=1
	MQ=2
	PC=3
	QC=4
	PT=5		;BYTE POINTER
	.GTCNF=11	;GETTAB CONFIGURATION TABLE.
	%CNVER=34	;MONITOR VERSION NUMBER.
START:	RESET
	INIT
	SIXBIT	"DSK"
	XWD	OBUF,0
	HALT	.
	ENTER	E2		;CREATE PARAMETER FILE.
	HALT	.
	JSP	PC,OUTASC
	ASCIZ	"IF1 <
WPV=2
.CPU="
	MOVEI	MQ,"1"		;DEFAULT VALUE FOR IF IT'S A PDP-6
	JFCL	17,.+1
	JRST	.+1
	JFCL	1,MON		;JUMP IF PDP-6
	AOS	MQ
	MOVNI	AC,1
	AOBJN	AC,.+1
	JUMPN	AC,MON		;JUMP IF KA-10
	AOS	MQ
	BLT	AC,0
	JUMPE	AC,MON		;JUMP IF KI-10
	AOS	MQ
MON:	JSP	QC,OUTONE	;OUTPUT ONE CHARACTER =C(MQ)
	MOVE	AC,[XWD %CNVER,.GTCNF]
	GETTAB	AC,		;FIND THE MONITOR'S VERSION NUMBER IN AC.
	JRST	FIN		;HERE IF IT HASN'T GOT ONE.
	MOVE	PT,[POINT 3,AC,17];SET TO PICK ONE DIGIT AT A TIME.
	JSP	PC,OUTASC	;CLOSE PREVIOUS LINE AND START NEW ONE.
	ASCIZ "
MONITOR="
	JSP	QC,OUTDIG	;FIRST DIGIT OF VERSION NUMBER.
	JSP	QC,OUTDIG	;SECOND. (E.G. 6)
	MOVEI	MQ,"."		;DECIMAL POINT.
	JSP	QC,OUTONE
	JSP	QC,OUTDIG	;HIGH ORDER OF MINOR VERSION NUMBER (E.G. 0)
	JSP	QC,OUTDIG	;LOW ORDER (E.G. 1)
FIN:	JSP	PC,OUTASC
	ASCIZ	"
>;END IF1
"
	EXIT
OBUF:	BLOCK 3
E2:	SIXBIT "FCLTMP"
	SIXBIT "PRM"
	BLOCK 2
OUTASC:	HRLI	PC,(POINT 7)
OUTAS1:	ILDB	MQ,PC		;PICK NEXT CHAR IN STRING.
	JUMPE	MQ,1(PC)	;RETURN TO IN-LINE CODE.
	MOVEI	QC,OUTAS1	;DUMMY UP A RETURN ADDRESS TO LOOP.
OUTONE:	SOSGE	OBUF+2		;DECREMENT & TEST COUNT
	OUT			;OUTPUT A BUFFER.
	SKIPA			;O.K. OUTPUT OR NO OUTPUT.
	HALT	.
	IDPB	MQ,OBUF+1	;PUT CHAR IN BUFFER.
	JRST	(QC)		;RETURN.
;HERE TO SEND AN OCTAL DIGIT FROM WHERE PT POINTS BELOW.
OUTDIG:	ILDB	MQ,PT		;GET 3 BITS.
	ADDI	MQ,"0"		;MAKE IT A DIGIT.
	JRST	OUTONE	;SEND IT.
	END	START
%%%EWSIMFCL.MAC
TITLE SIMFCL PROGRAM TO MEASURE THE EXCERCISE OF LOCATIONS OF FCL331.MAC
SUBTTL	PARAMETERS, DEFINITIONS AND INITIALIZATION.
;A CODE TABLE IS FILLED WITH JSR INSTRUCTIONS.
;THAT TABLE IS THEN USED FOR THE SIMULATION, BY EXECUTING EACH JSR
;IN TURN.
;THE JSR IS REPLACED BY REAL CODE IF:
;	1. THE CODE IS FETCHED, AND
;	2. THE INSTRUCTION IS NOT A PC-SENSITIVE ONE, AND
;	3. IT DOES NOT REFERENCE A VARIABLE HIGH SEGMENT LOCATION.
;THE JSR IS REPLACED BY A SIMULATION INSTRUCTION IF:
;	1. THE ABOVE CONDITIONS HOLD, AND
;	2. IT IS A LUUO OR A JUMP INSTRUCTION.
	CA==13		;CUSTOMER ACCUMULATOR.
DEFINE HALT (A) <
JRST [
OUTSTR [ASCIZ "
?A
"]
JRST	4,.
]
>;END DEFINE HALT (A)
BTYPE==1B1		;THIS IS A BYTE INSTRUCTION OR XCT.
STYPE==1B2		;TTCALL ONLY.
MTYPE==1B3		;THIS INSTRUCTION WILL REFERENCE MEMORY.
DTYPE==1B4		;THIS INSTRUCTION WILL REFERENCE MEM+1
LTYPE==1B5		;THIS INSTRUCTION HAS A 4-WORD ARGUMENT BLOCK.
JTYPE==1B6		;THIS INSTRUCTION MAY JUMP.
PTYPE==1B7		;THIS INSTRUCTION IS PC-SENSITIVE.
ILLTYPE==1B8		;ILLEGAL INSTRUCTION IF EFFECTIVE ADDRESS IS IN HISEG.
COD:	BLOCK	4000		;THE JSR TABLE.
USE:	BLOCK	4000		;BIT TABLE OF USAGE.; AN IMAGE OF 400000-404000.

OPTAB:			;TABLE OF BITS ILLUSTRATING OP CODES.
REPEAT 40,<Z>		;LUUO'S
MTYPE			;CALL
PTYPE!ILLTYPE		;INIT		NOTE: THIS IS IMPERFECT!
REPEAT 5,<ILLTYPE>	;UUO'S 42-46
ILLTYPE			;CALLI		NOTE: THIS IS IMPERFECT!
MTYPE!DTYPE!ILLTYPE	;OPEN		NOTE: THIS IS IMPERFECT!
STYPE			;TTCALL
REPEAT 3,<ILLTYPE>	;UUO'S 52-54
MTYPE!DTYPE!LTYPE	;RENAME
ILLTYPE			;IN
ILLTYPE			;OUT
Z			;SETSTS
Z			;STATO
MTYPE			;GETSTS
Z			;STATZ
Z			;INBUF
Z			;OUTBUF
ILLTYPE			;INPUT
ILLTYPE			;OUTPUT
Z			;CLOSE
Z			;RELEASE
Z			;MTAPE
MTYPE!ILLTYPE		;UGETF
Z			;USETI
Z			;USETO
MTYPE!DTYPE!LTYPE	;LOOKUP
MTYPE!DTYPE!LTYPE	;ENTER
ILLTYPE			;UJEN
REPEAT 7,<ILLTYPE>	;UNDEFINED UUO'S.
REPEAT 4,<DTYPE!MTYPE>	;DFAD ETC
REPEAT 4,<ILLTYP>	;UNDEFINED
DTYPE!MTYPE		;DMOVE
DTYPE!MTYPE		;DMOVN
MTYPE			;FIX
ILLTYP
DTYPE!MTYPE
DTYPE!MTYPE
REPEAT 4,<MTYPE>	;FIXR ETC
Z
MTYPE			;IBP
REPEAT 4,<BTYPE!MTYPE>	;BYTE POINTERS
REPEAT 4,<
REPEAT 5,<MTYPE>
Z
MTYPE
MTYPE
>;END REPEAT 4		;FLOATING POINT.
REPEAT 8,<
MTYPE
Z
MTYPE
MTYPE
>;END REPEAT 8		;MOVES, FIXED POINT MUL,DIV.
Z
Z
Z
JTYPE
Z
Z
Z
ILLTYPE
MTYPE		;EXCH
ILLTYPE!MTYPE	;BLT
JTYPE
JTYPE
JTYPE
JTYPE
BTYPE!MTYPE		;XCT
ILLTYPE	;MAP
JTYPE!PTYPE		;PUSHJ
MTYPE
MTYPE
Z
REPEAT 3,<JTYPE!PTYPE>	;JSR,JSP,JSA
JTYPE
REPEAT 2,<
MTYPE
Z
MTYPE
MTYPE
>;END REPEAT 2	;ADD,SUB
REPEAT 8,<Z>
REPEAT 8,<MTYPE>
REPEAT 3,<
REPEAT 8,<JTYPE>
REPEAT 8,<MTYPE>
>;END REPEAT 3	;JUMP,SKIP,AOJ,AOS,SOJ,SOS
REPEAT 3,<
Z
Z
MTYPE
MTYPE
REPEAT 4,<
MTYPE
Z
MTYPE
MTYPE
>;END REPEAT 4		;AND,ANDCA,SETM,ANDCM
>;END REPEAT 3	;RIGHT UP TO ORCBB
Z
Z
MTYPE
MTYPE
REPEAT 20,<
MTYPE
Z
MTYPE
MTYPE
>;END REPEAT 20		;HALF WORDS.
REPEAT 4,<
REPEAT 8,<Z>
REPEAT 8,<MTYPE>
>;END REPEAT 4		;TEST INSTRUCTIONS.
REPEAT 100,<ILLTYPE>
TTCTAB:			;TABLE OF BITS FOR TTCALL UUO.
REPEAT 3,<MTYPE>	;INCHRW,OUTCHR,INCHRS
STYPE!MTYPE		;OUTSTR
REPEAT 4,<MTYPE>	;INCHWL,INCHSL,GETLCH,SETLCH
REPEAT 5,<Z>		;RESCAN,CLRBFI,CLRBFO,SKPINC,SKPINL
MTYPE			;IONEOU
REPEAT 2,<Z>		;RESERVED FOR EXPANSION.
BEGIN:	RESET
	MOVE	CA,41		;MODIFY THE UUO TRAP LOCATION.
	SUBI	CA,400000
	ADDI	CA,COD		;GO TO THE SIMULATED HANDLER.
	MOVEM	CA,41
	MOVEI	CA,STRP.H	;PRE-SET TO HANDLE OUR OWN TRAPS.
	MOVEM	CA,.JBAPR##
	MOVE	CA,[JSR	DECODE]
	MOVEM	CA,COD		;SET TO FILL SIMULATION SPACE WITH TRAPS.
	MOVE	CA,[XWD COD,COD+1]
	BLT	CA,COD+3777	;FILL HIGH SEGMENT WITH TRAPS.
	SKIPA	CA,.+1		;PICK UP ENTRY TO SIMULATOR
	JRST	COD+10		;CORRESPONDS TO ONCE IMAGE.
	MOVEM	CA,FNEWEX##	;GO THERE WHEN DONE FNEWGO.
	JRST	FNEWGO##	;GO AND FIND FOCAL.SHR

;ROUTINE TO RETURN EITHER:
;1.	THE NUMBER OF REFERENCES IN THE USAGE TABLE [FNEW(-1)], OR
;2.	THE POSSIBLE SCORE, [CALLED BY FNEW(0)], OR
;3.	THE RELATIVE LOCATION OF THE NEXT UNREFERENCED LOCATION AFTER
;		THE ONE GIVEN BY THE ARGUMENT [POSITIVE ARGUMENT].
FNEW::	HLRZ	0,400000+.JBHRN##	;GET SIZE OF HIGH SEGMENT.
	SUBI	0,10		;SUBTRACT VESTIGIAL JOB DATA AREA.
	SKIPN	1,@0(16)	;WAS THE ARGUMENT ZERO?
	JRST	FNEW2		;YES.
	JUMPL	1,FNEW1		;REQUIRE NEXT RELATIVE LOCATION?
	FIXR	1,1		;OBTAIN FIXED-POINT ANSWER.
	ANDI	1,7777		;YES.	RESTRICT ARGUMENT TO 4K WORDS.
	SKIPGE	USE+1(1)	;HAS THE NEXT LOCATION BEEN REFERENCED?
	AOJA	1,.-1		;YES.
	MOVE	0,1
	AOJA	0,FNEW2		;POINT TO THE NEXT RELATIVE LOCATION.
FNEW1:	MOVE	1,[-4000,,USE]
	SETZM	0			;COUNT IN HERE.
	SKIPE	(1)
	AOS	0
	AOBJN	1,.-2
FNEW2:	FSC	0,233		;FLOAT THE ANSWER.
	SETZM	1		;MAKE IT DOUBLE-PRECISION.
	POPJ	17,		;RETURN.
SUBTTL INSTRUCTION SIMULATOR SECTION 1:	EFFECTIVE ADDRESS CALCULATION.
DECODE:	0			;COME HERE FROM SIMULATION SPACE.
	MOVE	CA,DECODE	;SAVE PC OF TRAP.
	SUBI	CA,COD
	ADDI	CA,400000	;POINT TO THE HIGH SEGMENT.
	MOVEM	CA,SIMPC1	;SAVE THE SIMULATION OF THE PC.
	MOVEM	CA,SIMPC
	SOS	CA,SIMPC	;POINT TO THE INSTRUCTION BEING SIMULATED.
	SOS	USE-400000(CA)	;MARK THE USAGE.
	MOVE	CA,@SIMPC	;GET THE INSTRUCTION BEING SIMULATED.
	MOVEM	CA,LASTEF	;SAVE FOR JRSTF FLAGS.
	TLZ	CA,777740	;CLEAR SPACE FOR THE TYPE BITS.
	MOVEM	CA,EFFADD	;SAVE FOR THE EFFECTIVE ADDRESS CALCULATION.
	LDB	CA,PSIMOP	;GET OP CODE.
	HLLZ	CA,OPTAB(CA)	;GET NATURE OF THE OPCODE.
	IORB	CA,EFFADD	;GET EFFECTIVE ADDRESS IN CA.
	SETZM	VARIAB		;MARK EFFECTIVE ADDRESS FIXED.
MOREFF:	LDB	CA,[POINT 4,EFFADD,17]	;GET INDEX FIELD.
	JUMPE	CA,EFF1		;SKIP ALL THIS IF NO INDEX FIELD.
	HLLOS	VARIAB		;MARK VARIABLE EFFECTIVE ADDRESS.
	HRR	CA,(CA)		;GET CONTENTS OF INDEX REGISTER.
	ADD	CA,EFFADD	;COMPUTE EFFECTIVE ADDRESS.
	HRRM	CA,EFFADD	;SAVE RESULT.
EFF1:	MOVE	CA,EFFADD
	TLZ	CA,17		;CLEAR INDEX FIELD.
	TLZN	CA,20		;INDIRECT BIT ON?
	TLZE	CA,(BTYPE)	;NO.	BYTE POINTER?
	SKIPA
	JRST	MARK		;NO.	COMPUTATION IS COMPLETE.
	MOVEM	CA,EFFADD	;SAVE THE BTYPE BIT.
	TRNN	CA,400000	;YES.	INDIRECT A HIGH SEGMENT ADDRESS?
	HLLOS	VARIAB		;NO.	THAT MEANS EFF ADD IS VARIABLE.
	TRNN	CA,400000	;YES.	INDIRECT A HIGH SEGMENT ADDRESS?
	JRST	EFF3		;NO.
	SKIPE	VARIAB		;IS EFF ADD VARIABLE?
	SETOM	VARIAB		;YES.	VARIABLE HIGH SEGMENT ADDRESS.
	SOS	USE-400000(CA)	;MARK USAGE.
EFF3:	MOVE	CA,(CA)		;GET NEW CODE.
	MOVEM	CA,LASTEF	;SAVE FOR JRSTF FLAGS.
	DPB	CA,[POINT 23,EFFADD,35]	;SAVE NEXT ADDRESS.
	JRST	MOREFF		;LOOP FOR MORE EFFECTIVE ADDRESS CALCULATION.
SUBTTL INSTRUCTION SIMULATOR SECTION 2:	MARK THE DATA FETCH REFERENCES.
;AT THIS STAGE CA CONTAINS ...
;BIT	0	0	UNUSED
;BITS	2-8		STYPE,MTYPE,DTYPE,LTYPE,JTYPE,PTYPE,ILLTYPE
;BITS	9-12	0	UNUSED
;BITS 13-17	0
;BITS 18-35		EFF  ADD OF SIMULATED INSTR. OR BYTE PTR IF ANY.
MARK:	TLZN	CA,(STYPE)	;TTCALL?
	JRST	MARK2		;NO.
	MOVEM	CA,EFFADD	;STORE WITH ZERO I AND X FIELDS.
	LDB	CA,PSOPAC	;GET OP CODE AND AC.
	HLLZ	CA,TTCTAB-1220(CA)	;GET NEW NATURE.
	HRR	CA,EFFADD	;PRESERVE ADDRESS.
	IORB	CA,EFFADD	;SAVE IT.
	TLZE	CA,(STYPE)	;OUTSTR?
	TRNN	CA,400000	;IS EFFECTIVE ADDRESS IN LO SEG?
	JRST	MARK2		;NO.
	HRLI	CA,(POINT 7,,)	;MAKE A BYTE POINTER.
	MOVEM	CA,BYTADD	;SAVE THE POINTER.
MARK1:	IBP	BYTADD		;POINT TO NEXT BYTE.
	MOVE	CA,BYTADD	;GET THE BYTE POINTER.
	SOS	USE-400000(CA)	;FLAG THE REFERENCE.
	LDB	CA,BYTADD	;GET THE NEXT BYTE.
	JUMPN	CA,MARK1	;LOOP UNTIL NUL BYTE.
	MOVE	CA,EFFADD
MARK2:	MOVEM	CA,EFFADD
	TRNN	CA,400000	;IS EFFECTIVE ADDRESS IN LO SEG?
	JRST	CRESIM		;IGNORE MTYPE IF LO SEG EFFECTIVE ADDR.
	TLNE	CA,(ILLTYPE)
	HALT	ILLEGAL INSTRUCTION.
	TLNN	CA,(MTYPE)	;WILL IT REFERENCE MEMORY?
	JRST	CRESIM		;NO.
	SOS	USE-400000(CA)	;MARK MEMORY REFERENCE.
	SKIPE	VARIAB		;EFF ADD VARIABLE?
	SETOM	VARIAB		;YES. AND REFERENCING HIGH SEGMENT.
	TLNE	CA,(DTYPE)	;DOUBLE PRECISION?
	SOS	USE-400000+1(CA)	;MARK E+1.
	TLNE	CA,(LTYPE)	;LOOKUP ENTER OR RENAME?
	SOS	USE-400000+2(CA)	;MARK E+2
	TLNE	CA,(LTYPE)	;LOOKUP ENTER OR RENAME?
	SOS	USE-400000+3(CA)	;ASSUME SHORT LOOKUP.
SUBTTL INSTRUCTION SIMULATOR SECTION 3:	CREATE THE SIMULATION INSTRUCTION.
CRESIM:	MOVE	CA,@SIMPC	;GET THE INSTRUCTION WE'RE SIMULATING.
	MOVEM	CA,SIMINSTR	;SAVE AS INSTRUCTION TO BE EXECUTED.
	MOVE	CA,EFFADD	;GET SOME FLAG BITS.
	TLNN	CA,(JTYPE)	;IS THIS A JUMP INSTRUCTION?
	JRST	CRSIM1		;NO.
;	LDB	CA,PSOPAC	;PICK OP CODE AND AC OF SIMULATED INSTR.
;	CAIN	CA,<JFCL>_-27	;IS IT JFCL 0?
;	JRST	CRSIM1		;YES.
;	MOVE	CA,EFFADD
;	TRZN	CA,400000	;JUMP TO LOW SEGMENT?
;	HALT	JUMP TO LOW SEGMENT.
	TRZE	CA,400000	;JUMP TO LOW SEGMENT?
	ADDI	CA,COD
	HLL	CA,SIMINSTR	;GET REST OF THE INSTRUCTION.
	TLZ	CA,37		;REMOVE H AND X FIELDS.
	MOVEM	CA,SIMINSTR	;SAVE.
	SKIPE	VARIAB		;JUMP TO VARIABLE ADDRESS?
	SETOM	VARIAB		;YES.	SIMULATE EVERY TIME.
	TLC	CA,(JRSTF)	;CHECK AGAINST JRSTF.
	TLNE	CA,777777	;IS IT JRSTF?
	JRST	CRSIM1		;NO.
	HLL	CA,LASTEF	;YES.	GET FLAGS.
	JRSTF	@CA		;RESTORE FLAGS AND JUMP.
CRSIM1:	TLNE	CA,(MTYPE)	;IS THIS A MEMORY REFERENCE INSTRUCTION?
	TRNE	CA,777600	;YES.	LOW SEGMENT JOB DATA AREA?
	JRST	CRSIM3		;NO.
	HRRZS	CA		;GET THE ACTUAL MEMORY REFERENCE.
	CAIE	CA,.JBREN##	;IS IT REFERENCING .JBREN?
	CAIN	CA,.JBSA##	;	OR .JBSA?
	JRST	CRSIM2		;YES.
	CAIE	CA,.JBAPR##	;IS IT A SET-UP?
	JRST	CRSIM3		;NO.
	MOVEI	CA,SIMAPR	;YES.	MAKE IT USE A DIFFERENT LOCATION.
	DPB	CA,PINS22	;CHANGE THE SIMULATION IN ACCORDANCE.
	JRST	CRSIM3
CRSIM2:	;HERE IF THE INSTRUCTION REFERENCES .JBSA OR .JBREN.
	MOVE	CA,SIMINSTR	;GET THE INSTRUCTION.
	TLC	CA,500000	;CHECK IF IT'S A HALF-WORD INSTRUCTION
	TLNE	CA,700000	;IS IT?
	HALT	NON-HALF-WORD INSTRUCTION REFERENCES .JBSA OR .JBREN
	TLNE	CA,040000	;IS IT STORING IN RIGHT HALF?
	TLNN	CA,002000	;IS IT STORING IN EFFECTIVE ADDRESS?
	JRST	CRSIM3		;NO.
	TLNN	CA,004000	;FROM RIGHT HALF?
	TLNE	CA,001000	;YES.	M-MODE?
	HALT	ILLEGAL STORE INTO .JBSA OR .JBREN
	LDB	CA,PSIMAC	;O.K.	GET THE SIMULATED ACCUMULATOR.
	HRL	CA,(CA)		;GET THE DATA.
	JUMPGE	CA,.-3		;ENSURE WE KNOW WHAT WE'RE DOING.
	ADD	CA,[XWD COD-400000,0]
	HLRM	CA,(CA)		;STORE THE DATA.
CRSIM3:	LDB	CA,PSIMOP	;GET THE OP CODE.
	CAIG	CA,37
	JRST	XLUUO
	CAIN	CA,<CALLI>_-33
	JRST	XCALLI
	CAIN	CA,<PUSHJ>_-33
	JRST	XPUSHJ
	CAIN	CA,<POPJ>_-33
	JRST	XPOPJ
	CAIN	CA,<JSP>_-33
	JRST	XJSP
	HLL	CA,OPTAB(CA)	;GET NATURE OF OP CODE.
	TLNE	CA,(BTYPE)	;IS IT A BYTE INSTRUCTION?
	SETOM	VARIAB		;THERE IS ONE THAT SWITCHES EFF ADD FROM LO TO HI SEG.
	TLNN	CA,(PTYPE)	;PC-SENSITIVE INSTRUCTION?
	JRST	SIMUL		;NO.
	HALT	SIMULATION FAILS ON UNEXPECTED PC-SENSITIVE INSTR.
XLUUO:	HLRO	CA,@SIMPC	;GET THE INDIRECT BIT OF THE UUO ITSELF.
	TRNN	CA,(@)		;IS THE INDIRECT BIT ON?
	SETZB	CA,VARIAB	;NO.	NO NEED TO CONTINUE SIMULATION.
	MOVE	CA,SIMPC	;GET THE ADDRESS OF THE ACTUAL UUO.
	HRLI	CA,(JRST)	;PREPARE TO EXECUTE THE UUO FROM THE HIGH SEG
	MOVEM	CA,SIMINSTR
	JRST	SIMUL
XCALLI:	HRRZ	CA,EFFADD	;GET THE NUMBER OF THE CALLI.
	CAIG	CA,115		;IGNORE ALL CALLI'S LESS THAN TRMOP.
	JRST	SIMUL
	LDB	CA,PSIMAC	;GET THE SIMULATED INSTRUCTION'S AC.
	MOVE	CA,(CA)		;GET THE CONTENTS OF THAT AC.
	TRZN	CA,400000	;DOES IT POINT TO THE HIGH SEGMENT?
	JRST	SIMUL		;NO.
	TLC	CA,777777	;MAKE THE LENGTH NEGATIVE.
	SOS	USE(CA)		;MARK A DATA REFERENCE.
	AOBJN	CA,.-1
	JRST	SIMUL
SUBTTL INSTRUCTION SIMULATOR SECTION 4:	STORE THE SIMINSTR AND DO IT.
SIMUL:	SKIPGE	VARIAB		;NO. VARIABLE HIGH SEGMENT REFERENCE?
	JRST	SIMUL4		;YES. CAREFUL SIMULATION NEEDED.
	SOS	DECODE		;POINT TO THE SPOT IN CODE TABLE.
	MOVE	CA,SIMINSTR	;YES.	GET MODIFIED INSTRUCTION.
	MOVEM	CA,@DECODE
	JRST	@DECODE
SIMUL4:	XCT	SIMINSTR
	JRST	@DECODE		;THEN CONTINUE.
	AOS	DECODE		;UNLESS THE INSTRUCTION SKIPPED.
	JRST	@DECODE

XPOPJ:	HLRZ	CA,SIMINSTR	;GET INSTR BEING SIMULATED.
	CAIE	CA,(POPJ 17,)	;PRESUMABLY FOCAL ALWAYS USES 17.
	HALT	POPJ WITH NON-STANDARD ARGUMENT.
	MOVE	CA,[JRST DOPOPJ]
	MOVEM	CA,SIMINSTRUCTION
	JRST	SIMUL		;STORE A SHORT CUT.
DOPOPJ:	POP	17,CA		;REMOVE ONE FROM THE STACK.
	TRZE	CA,400000	;RELATIVE TO BEGINNING OF CODE.
	ADDI	CA,COD		;SIMULATED CODE.
	JRST	(CA)
XPUSHJ:	MOVE	CA,SIMINSTR	;GET INSTR BEING SIMULATED.
	TLC	CA,(<PUSHJ>^!<PUSH>)
	JRST	XJRST
XJSP:	MOVE	CA,SIMINSTR	;GET INSTR BEING SIMULATED.
	TLC	CA,(<JSP>^!<MOVE>)
XJRST:	TLZ	CA,37		;REMOVE I AND X FIELDS.
	HRRI	CA,SIMPC1	;POINT TO THE CURRENT SIMULATED PC.
	XCT	CA
	JRST	@SIMINSTRUCTION

STRP.H:	HRRE	CA,.JBTPC##	;WHERE DID THE TRAP COME FROM?
	CAIG	CA,COD+4000	;ABOVE SIMULATED CODE?
	CAIG	CA,COD		;NO. BELOW SIMULATED CODE?
	JRST	STRPH1		;YES.	AVOID SIMULATION.
	SUBI	CA,COD-400000	;NO.	PRETEND THAT WE DID.
	HRRM	CA,.JBTPC##	;PUT A SIMULATION THERE.
STRPH1:	SKIPN	CA,SIMAPR
	HALT	A TRAP OCCURRED WITHOUT .JBAPR SET UP
	TRZE	CA,400000	;DID HE THINK IT WAS THE HIGH SEGMENT?
	ADDI	CA,COD		;YES.	THAT'S O.K. LET HIM THINK THAT.
	JRST	@CA

PINS22:	POINT	23,SIMINS,35	;COVER I X AND E FIELDS.
PSIMOP:	POINT	9,@SIMPC,8	;THE OP CODE OF THE SIMULATED INSTRUCTION.
PSIMAC:	POINT	4,@SIMPC,12	;THE AC OF THE SIMULATED INSTRUCTION.
PSOPAC:	POINT	13,@SIMPC,12	;THE OP CODE AND AC OF THE SIMULATED INSTR.
VARIAB:	BLOCK	1	;ZERO MEANS EFFECTIVE ADDRESS IS CONSTANT.
LASTEF:	BLOCK	1	;THE LAST ADDRESS REFERENCED DURING EFF ADD CALC.
EFFADD:	BLOCK	1	;BUILD EFFECTIVE ADDRESS OF THE SIMULATED INSTR.
			;BITS 0-12 SHOW THE TYPE OF INSTRUCTION.
BYTADD:	BLOCK	1	;TEMPORARY STORAGE.
SIMAPR:	BLOCK	1	;PLACE TO SIMULATE CONTENTS OF .JBAPR
			;NON-ZERO MEANS EFF ADD IS VARIABLE.
			;NEGATIVE MEANS A VARIABLE HIGH SEG REFERENCE IS INVOLVED.
SIMPC:	BLOCK	1	;POINT TO THE INSTRUCTION BEING SIMULATED.
SIMPC1:	BLOCK	1	;POINT TO THE INSTRUCTION AFTER THE ONE BEING SIMULATED.
SIMINS:	BLOCK	1	;MAKE THE INSTRUCTION WHICH WE SIMULATE.
	END	BEGIN
%%%EWD0AA.FCL
C FOCAL INSTRUCTION TEST D0AA
C THIS TEST WILL CONSIST OF SEVERAL PAGES EACH WITH DIFFERENT TESTS.
C PAGE 1
TYPE %8.04;SET DUMMY=FOCAL(1,-1)+FOCAL(2,-1)+FOCAL(3,-1)

C -TEST CORE EXPANSION FOR PROGRAM TEXT.
01.01	C - LINE ONE POINT OH ONE.
01.02	C - LINE ONE POINT OH TWO.
01.04	QUIT TO AVOID ERROR.
01.03	CHECK THAT THIS PRESERVES THE ABOVE LINE.
01.05	Z- SHOULD NEVER COME HERE.
GO
1.01 1.02 1.03 1.04 1.05 1.06 1.07 1.08 1.09 1.10 1.11 1.12 1.13 1.14 1.15 1.16 1.17 1.18 1.19 1.20 1.21 1.22 1.23 1.24 1.25 1.26 1.27 1.28 1.29 1.30 1.31 1.32 1.33 1.34 1.35 1.36 1.37 1.38 1.39 1.40 1.41 1.42 1.43 1.44
GO
C -TEST CORE EXPANSION FOR VARIABLES.
FOR I=1,512;SET X(I)=I
1.01 IF(X(I)-I) 1.9,1.2,1.9
1.2 RETURN
1.9 OPERATE OUTPUT TTY: ;TYPE "?",!, "?CORE EXPANSION FAILURE FOR "?I?!;Z
FOR I=1,512;DO 1.01
C - TEST CORE EXPANSION FOR DISK INITIALIZATION.
ERASE ALL
01.01	IF (FOCAL(102)-2) 1.02,1.1,1.8;CHECK OUTPUT CHANNEL.
01.02	IF (-FABS(FOCAL(102)))1.8;X FOCAL(9,9);C SET FLAG 9 FOR "TTY: OUTPUT"
01.10	IF (FOCAL(103)-3) 1.9,1.2,1.9;CHECK INPUT CHANNEL.
01.80	Z - D0AA WORKS CORRECTLY ONLY FOR OUTPUT ON CHANNEL 2 (FILE) OR CHANNEL 0 (TTY:).
01.90	Z - D0AA WORKS CORRECTLY ONLY FOR INPUT ON CHANNEL 3.
01.20	IF (FOCAL(36)-FOCAL(80)+FOCAL(174)-63) 1.3;COUNT SPACE AND TRY FOR 100 OCTAL WORDS.
01.21	S I=I+1,X(I)=I;G 1.2 ;CONTINUE FILLING CORE UNTIL 100 OCTAL OR SO WORDS REMAIN.
01.30	OPERATE OUTPUT DSK:CH4TMP/4
01.31	IF (FOCAL(36)-FOCAL(80)+FOCAL(174)-191) 1.4 ;COUNT SPACE AND TRY FOR 300 OCTAL WORDS.
01.32	S I=I+1,X(I)=I;G 1.31
01.40	OPERATE OUTPUT DSK:CH5TMP/5
01.41	FOR I=1,3200; X FCHR(I)
01.42	O O TTY:/4;O O TTY:/5;TYPE /0;IF(-FOCAL(9,9))1.43;X FOCAL(9,-1);TYPE /2;C - RELEASE I/O CHANNELS.
01.43	O I DSK:CH5TMP.LST/4
01.44	FOR J=1,3200/128;FOR I=1,127;S Q=FCHR(-1);IF -FABS(I-Q) 1.7
01.45	IF FCHR(-1)+1 ,1.47;Z - END-OF-FILE FCHR FAILURE.
01.47	O I TTY:/4;ASK/3;L D CH4TMP.LST;L D CH5TMP.LST;GOTO 2.01
01.70	Z - ERROR IN DISK I/O.

02.01	C - TEST SYMBOL TABLE STABILITY.
02.05	ERASE
02.10	IF FOCAL(36)-FOCAL(176),2.2;Z - .JBREL NOT EQUAL SYMTBH
02.20	IF FOCAL(174)-FOCAL(175),2.3;Z - SYMTBL NOT EQUAL SYMTBC
02.30	RETURN

DO ALL
ERASE

X (-1)^.5+(-1)^.4+(-1)^.6+(-1)^.500000000001+(-1)^.499999999999
C PAGE 2 - LOGIC TESTS
ERASE ALL
1.01	Z - CHECK THIS GETS OVERWRITTEN.
1.06	Z - CHECK THIS GETS OVERWRITTEN.
1.01	C - LOGIC TEST.
1.02	GO TO 1.06;CHECK UPPER CASE "T".
1.04	Z
1.06	GO tO 1.10;CHECK LOWER CASE "t".
1.08	Z
1.10	gOTO 1.14;CHECK LOWER CASE "g".
1.12	Z
1.14	GZAZBZAZDZEZFZGZHZIZJZKZLZMZNZOZPZQZRZSZTZUZVZWZXZYZZ 1.18
1.16	Z;CHECK UPPER CASE LETTERS ARE ALPHANUMERIC.
1.18	gzazbzczdzezfzgzhzizjzkzlzmznzozpzqzrzsztzuzvzwzxzyzz 1.22
1.20	Z;CHECK LOWER CASE LETTERS ARE ALPHANUMERIC.
1.22	S B01=B23,B45=B67,B89=0;G 1.26;CHECK NUMERICS ARE ALPHANUMERIC.
1.24	Z
1.26	GO	TO	1.30;CHECK TAB SEPARATORS.
1.28	Z
1.30	CHECK SUPERFLUOUS SPACES.
1.32	E 1.01 , 1.01 
1.34	GO TO 1.38 ;
1.36	Z ;
1.38	IF ( -1 ) 1.42 , 1.40 , 1.40 ;
1.40	Z
1.42	IF ( -1 + 0 ) 1.46 ;Z ;Z
1.44	Z
1.46	IF ( +0 ) 1.48 , 1.50 , 1.48 Z
1.48	Z - MODIFY COMMAND CHECKOUT - PLEASE IGNORE ...
1.50	IF (	+1	+0	)	1.52	,	1.52	,	1.54	Z
1.52	NOW IS THE TIME FOR ALL GOOD MEN TO COME TO THE AID OF THE PARTY.
1.54	IF	(+1)1.56,1.56	;GO	TO	1.58	Z
1.56	Z - THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG.
1.58	LIBRA SAVE TMPTMP.TMP 1.01 , 1.05 , 1.03	;	LIBRA	CALL	TMPTMP.TMP	; L D TMPTMP.TMP 
1.59	IF (-FABS(FOCAL(103)-3)) 1.60;SET I=FOCAL(9,9);X FOCAL(9,I);IF (FABS(FOCAL(102)+I-1)) ,1.61
1.60	Z - LIBRA CALL OR SAVE DESTROYS INCHN OR OUTCHN.
1.61	OPERATE OUTPUT DSK:TMPTMP.TMP/4
1.62	MODIFY 1.48 ; MODIFY 1.52 , 1.56 
1.64	FOR I=1;TYPE I!
1.66	FOR I=2,10;TYPE I!
1.68	FOR I=1,.2,3;TYPE I!
1.70	FOR I=1,5;TYPE !;FOR J=1,5;TYPE I*J,"	"
1.72	SET X = 1 + 2 - 3 / 4 * 5 ^ 6 ** 7 ;
1.73	TYPE %8.04 /4 %E16.10 /4 ;
1.74	OPERATE OUTPUT TTY:/4;TYPE/0;IF(-FOCAL(9,9))1.75;X FOCAL(9,-1);TYPE /2
1.75	L D TMPTMP.TMP
1.76	S X=1 , Y = 2
1.78	WRITE 3 , 03.00 , 3. , 03 , 03. , 03.0 , 3.0 , 3.00 ;
1.80	ASK X , Y	,	Z	;
1.82	S V=2,Y=FOCAL(1,0),Z(V)=1
1.84	S W=FOCAL( 1 , Z ( V ) ) ; IF( 1+W ) 1.86,1.88,1.86
1.86	Z
1.88	CONTINUE
1.90	CONTINUE
1.92	S XX(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)=1264
1.94	I(XX(7,7,7,7,7,7)-XX(3,3,3,3,3,3,3,3,3)) 1.96,1.98,1.96
1.96	Z - MULTIPLE SUBSCRIPTING FAILS.
1.98	I(XX(63,63,63) - 1264 ) 1.96,2.01,1.96
2.01	S XX(1,1)=XX(2^18-1)
2.02	I(XX(1+2^9)-1264) 1.96,2.04,1.96
2.04	S PI=4*ATAN(1)
2.06	IF(PI*2-PI-PI) 2.08,2.10,2.08
2.08	Z - ROUNDING ERROR IN MULTIPLY-BY-2.
2.10	CONTINUE
2.12	IF 5=5 ;GO TO 2.16
2.14	Z - LOGICAL IF FAILED.
2.16	IF 5#5 ;Z - LOGICAL IF FAILED.
2.18	IF 5=4	;Z - LOGICAL IF FAILED.
2.20	IF 5#4	;GO TO 2.24
2.22	Z - LOGICAL IF FAILED.
2.24	IF 5 .EQ. 5 ;GO TO 2.28
2.26	Z - LOGICAL IF FAILED.
2.28	IF 5 .NE. 5 ;Z - LOGICAL IF FAILED.
2.30	IF 5 .EQ.4 ;Z - LOGICAL IF FAILED.
2.32	IF 5 .NE. 4 ;GO TO 2.36
2.34	Z - LOGICAL IF FAILED.
2.36	I 5 .EQ.5;I 5 .NE.4;I 5=5;I 5#4;I 5 .LE.5;I 5 .LE.6;I 5 .LT.6;I 5 .GE.5;I 5 .GE.4;I 5 .GT.4; GO TO 2.40
2.38	Z - LOGICAL IF FAILED.
2.40	IF 5 .LE. 4 ;Z - LOGICAL IF FAILED.
2.42	IF 5 .LT. 4 ;Z - LOGICAL IF FAILED.
2.44	IF 5 .LT. 5 ;Z - LOGICAL IF FAILED.
2.46	IF 5 .GE. 6 ;Z - LOGICAL IF FAILED.
2.48	IF 5 .GT. 5 ;Z - LOGICAL IF FAILED.
2.50	IF 5 .GT. 6 ;Z - LOGICAL IF FAILED.
2.52	IF 5 .LE.-4 ;Z - LOGICAL IF FAILED.
2.60	I"A".EQ."A";I"A".NE."B";I"A"="A";I"A"#"B";I"A".LE."A";I"A".LE."B";I"A".LT."B";I"A".GE."A";I"B".GT."A";I"AA".GT."A";I"AA".GE."A";I"AA".NE."A";I"AA"#"A";I"A".LT."AA";I"A".LE."AA";I"A".NE."AA";I"A"#"AA";GO TO 2.64
2.62	Z - LOGICAL IF STRING COMPARISONS FAILED.
2.64	IF"B".LE."A";Z - LOGICAL IF FAILED
2.66	IF"B".LT."A";Z - LOGICAL IF FAILED
2.68	IF"B".LT."B";Z - LOGICAL IF FAILED
2.70	IF"B".GE."C";Z - LOGICAL IF FAILED
2.72	IF"B".GT."B";Z - LOGICAL IF FAILED
2.74	IF"B".GT."C";Z - LOGICAL IF FAILED
2.76	IF"A".EQ."B";Z - LOGICAL IF FAILED
2.78	IF"A"= "B";Z - LOGICAL IF FAILED
2.80	IF"A".NE."A";Z - LOGICAL IF FAILED
2.81	IF"A" #  "A";Z - LOGICAL IF FAILED
2.84	IF"AA".LE."A";Z - LOGICAL IF FAILED
2.86	IF"AA".LT."A";Z - LOGICAL IF FAILED
2.88	IF"AA".LT."AA";Z - LOGICAL IF FAILED
2.90	IF"AA".GE."C";Z - LOGICAL IF FAILED
2.92	IF"AA".GT."AA";Z - LOGICAL IF FAILED
2.94	IF"AA".GT."C";Z - LOGICAL IF FAILED
2.96	IF"AA".EQ."A";Z - LOGICAL IF FAILED
2.98	IF"AA" =  "A";Z - LOGICAL IF FAILED
20.01	C - 'FOR' TESTS
20.02	S REP=4;FOR X=-2,2;FOR INC=-2,2;DO 20.7
20.04	IF -FABS(X-3) 20.95;IF -FABS(INC-3) 20.95;GOTO 20.06
20.06	FOR F=-3,3;FOR INC=-0.35,.1,.3;DO 20.8
20.08	SET C=0;FOR MM=1,5;GOTO 20.82
20.10	IF(C-5) 20.95,20.12,20.95
20.12	CONTINUE
20.40	GOTO 20.99
20.70	IF FABS(INC) 20.75,20.75;DO 20.8;IF INC*(Y-END) 20.95;RETURN
20.75	RETURN
20.80	S END = X+INC*REP,W=X ; FOR Y=X,INC,END;DO 20.9
20.82	SET C=C+1
20.90	IF -FABS(W-Y) 20.95;S W=W+INC
20.95	O O TTY:;T$;Z - ERROR IN 'FOR'.
20.99	C - END OF 'FOR' TESTS.
DO ALL
QQ11 2 3
COMMENT - ABOVE ARE FOR THE MODIFY COMMANDS AT 1.62 AND ASK COMMAND AT 1.48.
C PAGE 3 - MODIFY COMMAND
ERASE ALL,
OPERATE OUTPUT TMPTMP.LST/5
21.01	ZET D
21.02	SET W=23.;ZET X=5.2
21.03	SET X=77;ZET U=89.66
21.04	SET Q=5;Z-CATASTROPHE
21.06	21.06 Z - CHECK ERASE / INSERT
21.07	ERASE 21.07 Z CHECK ERASE
21.08	DO 21.09 Z CHECK MODIFY
21.09	MODIFY 21.08,21.09 Z!
21.10	Z--ZZ;#-) 21.4,21.2,21.4
21.20	C-FIFTH LINE
21.30	IF (D-4.63) 21.4,21.5,21.4
21.40	Z - CATASTROPHE IN MODIFY TESTS
21.45	?THIS WILL BE MODIFIED TO REMOVE THE ?'S.
21.50	IF (X-5.2) 21.4,21.6,21.4
21.55	Z - NOW IS THE TIME ETC.
21.60	IF(Y-4.532) 21.4,21.7,21.4
21.70	IF (W-23) 21.4,21.8,21.4
21.80	IF (U-89.66) 21.4,21.82,21.4
21.82	OPERATE OUTPUT TTY:/5
21.85	CHECK LINE 21.45
21.86	L S TMPTMP.LST;OPERATE INPUT TMPTMP.LST/5
21.87	S X=FCHR(-1);IF FABS(63-X) 21.89,21.89;IF(X-39) 21.87,21.94,21.87
21.89	Z - THIS PROGRAM STILL HAS ? IN LINE 21.45
21.94	A /3;T /0;IF(-FOCAL(9,9))21.95;X FOCAL(9,-1);TYPE /2;Q
21.95	QUIT
21.05	Z-CAUSE A BLANK ENTRY IN THE INDEX TABLE! DELETE THIS LINE -
21.05
MODIFY 21.01
ZS

MODIFY 21.01
D=4.63
MODIFY 21.02
ZSET Y=4.532;S

MODIFY 21.03
ZS

MODIFY 21.04
;
MODIFY 21.1
#IF (Q-5
MODIFY 21.55;C - TO MAKE A NULL LINE.

DO 21.55
MODIFY 21.3
Z
MODIFY 21.45;CHECK QUESTION MARKS ARE NOT DELETED.

MODIFY 21.45
?Z - ERROR IN MODIFY - QUESTION MARKS ARE DELETED.

MODIFY 21.45;CHECK WE CAN REMOVE INITIAL QUESTION MARKS BY MODIFY.
?C
Z - CHECK THAT SECOND QUESTION MARK WAS FOUND.

DO ALL
QF

LIBRARY DELETE TMPTMP.LST
ERASE ALL
C PAGE 4 - WRITE COMMAND DIAGNOSTIC
C CHECK THAT 'WRITE' WRITES QUESTION MARKS O.K.
01.05	F S=1,18;X FCHR(-1)
01.08	DO 9.2
01.10	S S=34;D 9;S S=75;D 9;S S=83;D 9;O I TTY:/4;A/3;L D TMPTMP.LST;QUIT
01.23	CHECK THIS "?" AND IS THIS OK? OR THIS?
09.10	IF (FCHR(-1)-S) 9.1,9.2,9.1
09.20	S NEX=FCHR(-1);IF (NEX-63) 9.3,9.4,9.3
09.30	Z - BAD MATCH IN WRITE TEST
09.40	RETURN
O O TMPTMP.LST/4
TYPE "CAN YOU CHECK THIS?"!
WRITE 0
O O TTY:/4;T/0;O I TMPTMP.LST/4;DO ALL
ERASE ALL
1.1	TYPE /0;IF(-FOCAL(9,9))1.43;X FOCAL(9,-1);TYPE /2
1.43	QUIT
DO ALL
ERASE ALL
C PAGE 5 - INPUT ROUTINE DIAGNOSTIC

ERASE ALL

23.1 S PI=3.14159265;A PI ; IF (PI-3.14159265) 23.2,23.3,23.2
23.2 Z - ALTMODE ON 'ASK' FAILED
23.3 A X,Y;IF (-FABS(X-742)) 23.4;IF(Y-123456789) 23.4,23.5
23.4 Z - 'ASK' INPUT FAILURE
23.5 A X; IF (X-0.12346789) 23.6,23.7,23.6
23.6 Z - ASK INPUT OF LETTERS FAILURE
23.7 A X;IF(X+63) 23.8,23.9,23.8
23.8 Z - ASK DATA NEGATIVE FAILURE
23.9 A X; IF (+FABS(X+3.473E+6)) 23.05,23.92;Z - ASK ERROR
23.92 RETURN

DO ALL
43.65742 123456789
.ABCDFGHI
-63
-3.473E+6
ERASE ALL
1.01 IF(25.-25) 7.01,1.02,8.01
1.02 IF(25-2.5E1) 7.02,1.03,8.02
1.03 IF(3.0-3.E+0) 7.03,1.04,8.03
1.04 IF(123.456-123.456E-00) 7.04,1.05,8.04
1.05 RETURN
7.01 Z
7.02 Z
7.03 Z
7.04 Z
8.01 Z
8.02 Z
8.03 Z
8.04 Z
DO ALL
C - PAGE 6 ARITHMETIC TESTS

ERASE ALL
C-FOCAL	v4(261)-1	1659	4-Aug-74

20.01	ERASE;SET X=1+2^(-58),NB=27
20.02	IF(FOCAL(FOCAL(36)-2))20.08,20.05;IF(FOCAL(FOCAL(36)-1))	20.05,20.06,20.07
20.05	Z - COME HERE IF NOT DECSYSTEM-10.
20.06	SET NB=54;GO TO 20.10;KA-10 DOUBLE PRECISION.
20.07	SET NB=62;GO TO 20.10;KI-10 DOUBLE PRECISION.
20.08	SET NB=27;GO TO 20.10;C - SINGLE PRECISION.
20.10	SET PI=2*FATN(2^(NB+4))
20.11	SET DR=1;IF-FABS(PI/4-PI*(1/4))20.12;SET DR=0;C - DIVISION-ROUNDING ALLOWANCE.
20.12	SET PS=2^(14-NB);C - SMALL PERTURBATION.
20.13	SET PL=2^(5-NB/2);C - LARGE PERTURBATION.
20.15	SET NR=8;C - MAXIMUM ALLOWABLE NUMBER OF STEPS IN REDUCTION FORMULA.
20.20	SET NS=FITR(NB/2-6);C - MAXIMUM ALLOWABLE NUMBER OF STEPS IN SERIES FORMULA.
20.30	SET FL2=FLOG(2);CONSTANT IS HANDY TO SAVE RE-COMPUTATION ALL THE TIME.
20.40	ERASE 37,38

21.14	IF FCOS(-PI/2) 21.17,21.15;Z
21.15	S N=21.15,X=360,YE=0,YO=FSIND(X),DYDX=PI/180;D 39
21.16	IF FCOSD(-90) 21.17,21.20;Z
21.17	Z - ERROR IN FCOS OR FCOSD.
21.20	37.10	S DYDX=FCOS(X)
21.22	38.10	S YO=FSIN(X)
21.24	S N=21.24,X=1.467,YE=+FSIN(1.467);DO 37,38,39
21.26	S N=21.26,X=-.1239,YE=-FSIN(.1239);DO 37,38,39
21.28	S N=21.28,X=2*PI+PS,YE=+PS;DO 37,38,39
21.30	S N=21.30,X=2*PI-PS,YE=-PS;DO 37,38,39
21.32	S N=21.32,X=PI+PS,YE=-PS;DO 37,38,39
21.34	S N=21.34,X=PI-PS,YE=+PS;DO 37,38,39
21.36	S N=21.28,X=PI/2+PS,YE=+(1-PS^2/2);DO 37,38,39
21.38	S N=21.38,X=PI/2+PS,YE=+FSIN(PI/2-PS);DO 37,38,39
21.40	S N=21.40,X=PI/2+PS,YE=-FSIN(3*PI/2+PS);DO 37,38,39
21.42	S N=21.42,X=3*PI/2+PS,YE=+FSIN(3*PI/2-PS);DO 37,38,39
21.46	S N=21.46,X=PI/2+PL,YE=+(1-PL*PL/2);DO 37,38,39
21.48	S N=21.48,X=PI/2+PL,YE=+FSIN(PI/2-PL);DO 37,38,39
21.50	S N=21.50,X=3*PI/2+PL,YE=-FSIN(PI/2+PL);DO 37,38,39
21.52	S N=21.52,X=3*PI/2-PL,YE=+FSIN(3*PI/2+PL);DO 37,38,39
21.54	S N=21.54,X=PI/4-PS,YE=+.5^.5*(1-PS);DO 37,38,39
21.56	S N=21.56,X=PI/4+PS,YE=+.5^.5*(1+PS);DO 37,38,39
21.58	S N=21.58,X=3*PI/4-PS,YE=+FSIN(PI/4+PS);DO 37,38,39
21.60	S N=21.60,X=3*PI/4+PS,YE=+FSIN(PI/4-PS);DO 37,38,39
21.62	S N=21.62,X=5*PI/4-PS,YE=-FSIN(PI/4-PS);DO 37,38,39
21.64	S N=21.64,X=5*PI/4+PS,YE=-FSIN(PI/4+PS);DO 37,38,39
21.66	S N=21.66,X=7*PI/4-PS,YE=-FSIN(PI/4+PS);DO 37,38,39
21.68	S N=21.68,X=7*PI/4+PS,YE=-FSIN(PI/4-PS);DO 37,38,39
21.70	S N=21.70,X=PI/8,YE=((1-.5^.5)/2)^.5;DO 37,38,39
21.72	S N=21.72,X=3*PI/8,YE=+FSIN(PI/8)*(1+2*.5^.5);DO 37,38,39
21.74	S N=21.74,X=5*PI/8,YE=+FSIN(3*PI/8);DO 37,38,39
21.76	S N=21.76,X=7*PI/8,YE=+FSIN(PI/8);DO 37,38,39
21.78	S N=21.78,X=9*PI/8,YE=-FSIN(PI/8);DO 37,38,39
21.80	S N=21.80,X=11*PI/8,YE=-FSIN(3*PI/8);DO 37,38,39
21.82	S N=21.82,X=13*PI/8,YE=-FSIN(3*PI/8);DO 37,38,39
21.84	S N=21.84,X=15*PI/8,YE=-FSIN(PI/8);DO 37,38,39
21.86	37.10 S DYDX=2*FSIN(2*X)
21.88	38.10 S YO=FSIN(X)^2+FCOS(X)^2
21.92	38.20 S YE=1
21.93	S N=21.93;F X=.001,.001,.01;DO 37,38,39
21.94	S N=21.94;F X=.01, .01, .1 ;DO 37,38,39
21.95	S N=21.95;F X=.1,  .1,  1  ;DO 37,38,39
21.96	S N=21.96;F X=1,   1,   10 ;DO 37,38,39
21.97	S N=21.97;F X=10, 10,  100 ;DO 37,38,39

22.01	C Logarithm test.
22.04	37.10 S DYDX=2/X
22.06	38.10 S YO=FLOG(X*(1+PS))+FLOG(X/(1+PS))
22.10	38.20 S YE=2*FLOG(X)
22.20	S N=22.20;F I=1,16.5;S X=1+I/16;DO 37,38,39
22.22	S N=22.22;F W=-3,3;F Z=1.3,15;S X=Z*10^W;DO 37,38,39
22.30	ERASE 37,38
22.31	37.1 S DYDX=2
22.32	38.1 S YE=0,YO=FLOG(FEXP(X))-X
22.33	F X=-70,3.14159265,+84;DO 37,38,39

23.01	IF (FABS(0)) 7.01,23.02;Z-CATASTROPHE - NON-ZERO RESULT
23.02	IF (FABS(1-1)) 7.02,23.03;Z-CATASTROPHE - NON-ZERO RESULT
23.03	IF (FABS(1*0)) 7.03,23.04;Z-CATASTROPHE - NON-ZERO RESULT
23.04	IF (FABS(0*1)) 7.04,23.05;Z-CATASTROPHE - NON-ZERO RESULT
23.05	IF (FABS(3^3-27)) 7.05,23.06;Z-CATASTROPHE - NON-ZERO RESULT
23.06	IF (FABS((+1)-(+1))) 7.06,23.07;Z-CATASTROPHE - NON-ZERO RESULT
23.07	IF (FABS(((+1)+(-1)))) 7.07,23.08;Z-CATASTROPHE - NON-ZERO RESULT
23.08	IF (FABS((-1+1)-(1-1))) 7.08,23.09;Z-CATASTROPHE - NON-ZERO RESULT
23.09	IF (FABS((2*3)-(3*2))) 7.09,23.10;Z-CATASTROPHE - NON-ZERO RESULT
23.10	IF (FABS(0/1)) 7.10,23.11;Z-CATASTROPHE - NON-ZERO RESULT
23.11	IF (FABS(0^5)) 7.11,23.12;Z-CATASTROPHE - NON-ZERO RESULT
23.12	IF (1) 23.13,23.13,23.14
23.13	Z-CATASTROPHE - (1) IS NOT POSITIVE!
23.14	IF (-1) 23.15;Z-CATASTROPHE - (-1) IS NOT NEGATIVE!
23.15	SET RADIUS=23.652;IF (FABS(RAD-23.652)) 7.15,23.16;Z-CATASTROPHE
23.16	S X=(1-(1+2^(-40))*(1/(1+2^(-40))));IF (X-2^(2-NB)) 23.17,23.17;Z
23.17	CONTINUE

24.01	C DATAN TEST
24.02	ERASE 37,38
24.04	37.10	S DYDX=2/(1+X^2)
24.06	38.10	S YO=FATN(X)+FATN(-X),YE=0
24.08	S N=24.08;D 24.90
24.10	38.10	S YO=FATN(X)+FATN(1/X),YE=FSGN(X)*PI/2
24.15	S N=24.15;D 24.90
24.20	38.10	S YO=FATN(X)-FATN((X*3^.5-1)/(X+3^.5)),YE=PI/6
24.22	37.10	S DYDX=(1+FABS(1-X*3^.5)/4+FABS(3+X*3^.5)/4)/(1+X^2)
24.25	S N=24.25;D 24.90
24.30	GO TO 24.99
24.90	S Z=(3)^.5*2^(-27);D 24.92;S Z=2-3^.5;D 24.92;S Z=1;D 24.92
24.92	S ZZ=Z^2;D 24.94;S ZZ=Z;D 24.94
24.94	S ZZZ=ZZ-PL;D 24.96;S ZZZ=ZZ;D 24.96;S ZZZ=ZZ+PL;D 24.96
24.96	S X=ZZZ-PS;D 24.98;S X=ZZZ;D 24.98;S X=ZZZ+PS;D 24.98
24.98	D 37,38,39
24.99	CONTINUE AFTER CONCLUSION OF DATAN TESTS.

25.01	C EXPONENTIATION TEST.
25.02	IF (1/2-0.5),25.04;Z
25.03	Z - EXPONENTIATION TEST FAILURE.
25.04	IF (1/2-2^(-1)),25.05;Z
25.05	IF (1/2-(1/2)^1),25.06;Z
25.06	IF (FSQT(1.000001)-(1.000001)^.5),25.08;Z
25.08	IF (FSQT(1.0000000000001)-(1.0000000000001)^.5),25.10;Z
25.10	37.10	S DYDX=FEXP(X)
25.12	38.10	S YO=FEXP(X),YE=0;F Z=22,-1,1;S YE=1+X*YE/Z
25.14	S N=25.14;F X=0,1/8,1;D 37,38,39
25.16	S N=25.16;F X=PL,1/8,1;D 37,38,39
25.18	S N=25.18;F X=-PL,1/8,1;D 37,38,39
25.20	S N=25.20;F X=PS,1/8,1;D 37,38,39
25.22	S N=25.22;F X=-PS,1/8,1;D 37,38,39
25.24	IF FEXP(0)-1 ,25.26,
25.26	IF 2^26-67108864,25.28,
25.28	IF (2^26*2^(-26)-1),25.99,
25.99	CONTINUE

26.01	C FHIBER TEST
26.02	S X=FHIBER(1);IF X,26.03;IF X-1,26.03,
26.03	S X=GETTAB(9,8);X FHIBER(5000);S X=GETTAB(9,8)-X;IF X-249,

27.01	C ERROR INCREMENT TEST.
27.02	S I=FOCAL(34);X GETTAB(9,8);IF I-FOCAL(34) ,27.04,
27.04	X GETTAB(99,99);IF I-FOCAL(34)+1 ,27.06,
27.06	S X=FOCAL(3,3);X FLOG(0),FOCAL(3,X);IF I-FOCAL(34)+2 ,27.08,
27.08	CONTINUE

29.99	QUIT

37.01	C DERIVATIVE OF FUNCTION WRT X.

38.01	C OBSERVED VALUE OF FUNCTION.

39.01	CHECK THAT YO AND YE AGREE WITHIN TOLERANCE.
39.02	C - THIS METHOD IS NOT VALID IF YE DEPENDS ON X.
39.03	C - IF YO HAS X OCCURRING MORE THAN ONCE, THEN DYDX MUST BE THE SUM
39.04	C - OF THE MAGNITUDES OF THE DERIVATIVES OF YO WITH RESPECT TO
39.05	C - EACH OCCURRENCE OF X.
39.10	S VS=0;I FABS(YE) 39.2,39.2;S VS=NS*2^(FITR(FLOG(YE)/FL2)-NB)
39.20	S VR=0;I FABS(X) 39.3,39.3;S VR=NR*FABS(DYDX)*2^(FITR(FLOG(X)/FL2)-NB)
39.30	I -FABS(YO-YE)+VR+VS 39.4;RETURN
39.40	I VR-VS 39.5
39.41	TYPE "?"!"?INACCURACY IN REDUCTION FORMULA CORRESPONDING TO"!
39.42	TYPE "ARGUMENT DIFFERENCE OF",%8,FABS(YO-YE)*NR/VR," IN LSB"!
39.43	G 39.7
39.50	TYPE "?"!"?INACCURACY IN POWER SERIES FORMULA OF"
39.52	TYPE %8,FABS(YO-YE)*NS/VS," IN LSB"!
39.70	TYPE "?ACCURACY FAILURE ON LINE"%4.02,N!
39.80	TYPE %%E18.16,?X?!?YE?!?YO?!
39.90	TYPE $$;Z

DO ALL
C PAGE 8 LIBRARY SAVE/CALL TEST
E,A
01.10	O O DSK:CH4.TMP/4;TYPE "1.99 C";F X=1,1024;TYPE "ABCDE"
01.20	O O TTY:/4;L C CH4.TMP;S X=FOCAL(36);L C CH4.TMP;S X=FOCAL(36)-X
01.30	IF X ,1.4;Z - SUCCESSIVE LIBRA CALLS OF SAME PROGRAM CAUSE CORE EXPANSION.
01.40	L D CH4.TMP;IF 1#1+2^(-30);IF 1=1+2^(-58); QUIT IF KA-10 DOUBLE PRECISION.
01.50	L D CH4.BAK;X FOCAL(3,3);C - SUPPRESS NON-FATAL ERROR MESSAGES.
01.60	S X=FOCAL(34);L C CH4.TMP;IF X#FOCAL(34)-1;Z - NON-FATAL LIBRA CALL FAILED TO COUNT.
01.70	L S CH4.TMP;L C CH4.TMP;IF X#FOCAL(34)-1;Z - NO ERROR HERE.
01.80	L C CH4.BAK;IF X#FOCAL(34)-2;Z - STILL NO .BAK FILE.
01.87	L S CH4.TMP;L C CH4.BAK;IF X#FOCAL(34)-2;Z .BAK FILE NOT CREATED.
01.89	L D CH4.TMP;L D CH4.BAK

GO

C WRITE A FILE THEN READ IT BACK
ERASE ALL
1.1 RETURN
LIBRARY SAVE FOCAL.TMP
ERASE ALL
1.1 Z - THIS NEVER GOT OVERWRITTEN!
LIBRARY CALL FOCAL.TMP
LIBRARY DELETE FOCAL.TMP
GO
C PAGE 9 - CHECK OF MULTI-CHANNEL I/O.
CHANNELS 2 AND 3 MAY BE IN USE BY THE TEST PROGRAM ITSELF!
O O DSK:CH4.TMP/4
O O DSK:CH5.TMP/5
O O DSK:CH6.TMP/6
O O DSK:CH7.TMP/7
O O DSK:CH8.TMP/8
O O DSK:CH9.TMP/9
O O DSK:CH10.TMP/10
O O DSK:CH11.TMP/11
O O DSK:CH12.TMP/12
O O DSK:CH13.TMP/13
O O DSK:CH14.TMP/14
O O DSK:CH15.TMP/15
TYPE /4,"1.12 GO TO 1.15"!
SET I=FOCAL(2,2);CAUSE SUPPRESSION OF EQUALS TYPE-OUT.
FOR I=1.13,.01,1.50;T %4.02,I," Z"!
TYPE 1.48," QUIT"!
TYPE /5,"1.15 GO TO 1.18"!
TYPE /6,"1.18 GO TO 1.21"!
TYPE /7,"1.21 GO TO 1.24"!
TYPE /8,"1.24 GO TO 1.27"!
TYPE /9,"1.27 GO TO 1.30"!
TYPE /10,"1.30 GO TO 1.33"!
TYPE /11,"1.33 GO TO 1.36"!
TYPE /12,"1.36 GO TO 1.39"!
TYPE /13,"1.39 GO TO 1.42"!
TYPE /14,"1.42 GO TO 1.45"!
TYPE /15,"1.45 GO TO 1.48"!
O O TTY:CH4.TMP/4
O O TTY:CH5.TMP/5
O O TTY:CH6.TMP/6
O O TTY:CH7.TMP/7
O O TTY:CH8.TMP/8
O O TTY:CH9.TMP/9
O O TTY:CH10.TMP/10
O O TTY:CH11.TMP/11
O O TTY:CH12.TMP/12
O O TTY:CH13.TMP/13
O O TTY:CH14.TMP/14
O O TTY:CH15.TMP/15
E A
L C CH4.TMP;L C CH5.TMP;L C CH6.TMP;L C CH7.TMP;L C CH8.TMP;L C CH9.TMP
L C CH10.TMP;L C CH11.TMP;L C CH12.TMP;L C CH13.TMP;L C CH14.TMP;L C CH15.TMP
L D CH4.TMP;L D CH5.TMP;L D CH6.TMP;L D CH7.TMP;L D CH8.TMP;L D CH9.TMP
L D CH10.TMP;L D CH11.TMP;L D CH12.TMP;L D CH13.TMP;L D CH14.TMP;L D CH15.TMP
GO
C - RANDOM NUMBER TEST.
ERASE ALL
ERASE
01.01	C- ACCURACY OF INTERNAL NUMBERS ...
01.02	S X=FOCAL(1,1)+FOCAL(2,2),X=1,DX=1
01.03	S M=N,DX=DX/2,Y=X+DX;D 31;IF (N-1000) 1.03
01.04	S LSB=M+8;C-THE BIT NUMBER OF THE LEAST SIGNIFICANT BIT.
01.10	C - SORT INTO BINS ACCORDING TO VALUE OF EACH BINARY BIT.
01.11	F BIT=9,20;S BIN(BIT)=-50
01.12	F X=1,100;S Y=FRAN;F BIT=9,20;D 3
01.13	F BIT=10,20;IF(15-FABS(BIN(BIT)))1.99
01.40	C - MEASURE SEQUENCE LENGTH.
01.41	F X=1,2000;X FRAN
01.42	SET X=FRAN(0)
01.44	FOR C=1,2000;I FABS(X-FRAN),1.98
01.45	IF(-FABS(FRAN(1)-FRAN(1)))1.99;QUIT
01.98	O O TTY:;T"?"!"?RANDOM NUMBER REPEAT SEQUENCE LENGTH",%5,C;Z
01.99	O O TTY:;T"?"!"?ERROR IN RANDOM NUMBER GENERATOR"!%3$;Z

03.10	S Y=Y*2-1
03.20	I Y 3.3;S BIN(BIT)=BIN(BIT)+1;R
03.30	S Y=Y+1;R

31.10	C- SUBROUTINE TO MEASURE DIFFERENCE BETWEEN X AND Y.
31.11	C- N IS THE NUMBER OF BITS REQUIRED TO SEPARATE X FROM Y.
31.20	SET N=100000;IF (-FABS(X-Y)) 31.3;RETURN
31.30	SET N=1-FLOG(FABS(2*(X-Y)/(X+Y)))/FLOG(2);RETURN
GO
TYPE "END OF D0AA."!
O O TMPTMP.LST;T "L D TMPTMP.LST"!!;O O TTY:;O I TMPTMP.LST;C- EXIT.
%%%EWXACCES.FCL
C-FOCAL	v5J(331)-1	1847	13-Mar-76

01.01	C - PROGRAM TO CHECK THE SIMULATION OF FOCAL-10.

02.01	C - FUNCTION EXECUTION.
02.10	X FOCAL(3,3),FOCAL(1,1),FOCAL(2,2),FOCAL(99),FLOG10(2),FLOG(2)
02.20	X FRAN,FRAN,FRAN,FRAN(1),FRAN(-1)
02.30	X FSIN,FSIN(2^(-99)),FSIN(12),FSIND,FCOS,FCOSD
02.40	X GETTAB(5000,5000),GETTAB(0)
02.50	X FEXP,FSQT,FATN(2^10),FATN,FATN(1),FABS,FSGN,FRAN,FITR(1E35)
02.99	ERASE 2

03.01	C - INPUT/OUTPUT ROUTINES.
03.10	O O NUL:/6;O O NUL:/7;O O NUL:/10;O O TTY:/7;O O TTY:/6;O O FCLTMP.FCL/5;TYPE" 3"!;X FCHR(65),FCHR(127),FCHR(127),FCHR(127),FCHR(127),FCHR(127),FCHR(127),FCHR(127),FCHR(65),FCHR(72),FCHR(72),FCHR(18),FCHR(21),FCHR(65),FCHR(32),FCHR(65),FCHR(27),FOCAL(2,2);ty/5%16,9999999999999999.4#!;O O TTY:/5;O O TTY:/10;L D NUL:
03.20	O I DSK:FORLIB.REL[1,4];O I FCLTMP;A X,A$,X,X;X FCHR(-1),FCHR(-1),FCHR(-1);O I TTY:;l D fCLTMP.FCL
03.30	S X$(1,2,3)="ABC"+FCHR$(10)+"ABC"+FCHR$(34),X(1,2,3)=1.E24,X=-1E-20
03.40	O O NUL:;W;W 3;T%,1E-1%30,1E20,1E33$$%E6.01'BOO";O O TTY:
03.50	O O FCLTMP.TMP;T"S";X FCHR(127),FCHR(127),FCHR(8),FCHR(21),FCHR(127),FCHR(8),FCHR(7),FCHR(69),FCHR(12),FCHR(18),FCHR(10);T"M"!;X FCHR(16);T!"O I TTY:;E 3.5,3.51;GO"!;O O TTY:;O I FCLTMP.TMP;M 3.51,3.51,3.51
03.51	PLEASE IGNORE THIS EXAMPLE OF MODIFICATION BY PROGRAM.
03.99	E 3

04.01	C - GENERAL REFERENCES ... EXPRESSIONS AND COMMANDS.
04.02	E? 
04.03	?I(0 .NE.1);I(0 .EQ.0);I(0#1);I(-1=(-1));I("A"="A");I("A"#"B");L S NUL:<100>;L S NUL: 4.01,ALL
04.04	SET X$(1,2,3)="ABC"+X$+"DEF";SET X(1,23,3)=A+B-C*D/4*(3+2)^1.32**0,X$(1,2,3)=X$(1,2,3)
04.06	DO 4.07;GO TO 4.08
04.07	RETURN
04.08	FOR X=1;
04.09	FOR Y=1,2,3;ERASE
04.10	FOR Z=2,-1,1;
04.11	I 0,4.12
04.12	I 1,,4.13
04.13	C
04.99	erase 4

05.01	C - NON-FATAL ERROR MESSAGES.
05.02	T"PLEASE IGNORE THE FOLLOWING NON-FATAL ERROR MESSAGES."!
05.03	X FOCAL(3,-1)
05.04	T/5
05.05	X 1/0
05.06	X 2^(-130)
05.08	X FSQT(-1)
05.09	L D SYS:FOROTS.SHR
05.12	T%200
05.88	X FOCAL(3,3),FEXP(99),FEXP(-99)
05.99	E 5

09.01	C - COMPUTE HOW WE'RE GOING.
09.04	TYPE%4!"SCORE:	"FNEW(-1)" OUT OF"FNEW(0)" POSSIBLE."!

10.01	C - FATAL ERROR MESSAGES.
10.05	DO 11.05
10.06	DO 11.06
10.07	DO 11.07
10.11	DO 11.11
10.12	DO 11.12
10.13	DO 11.13
10.14	DO 11.14
10.15	DO 11.15
10.16	DO 11.16
10.17	DO 11.17
10.18	DO 11.18
10.19	DO 11.19
10.20	DO 11.20
10.21	DO 11.21
10.22	DO 11.22
10.23	DO 11.23
10.24	DO 11.24
10.25	DO 11.25
10.26	DO 11.26
10.27	DO 11.27
10.28	DO 11.28
10.29	DO 11.29
10.30	DO 11.30
10.31	DO 11.31
10.32	DO 11.32
10.33	DO 11.33
10.34	DO 11.34
10.35	DO 11.35
10.36	DO 11.36
10.37	DO 11.37
10.38	DO 11.38
10.39	DO 11.39
10.40	DO 11.40
10.41	DO 11.41
10.42	DO 11.42
10.43	DO 11.43
10.44	DO 11.44
10.45	DO 11.45
10.46	DO 11.46
10.47	DO 11.47
10.48	DO 11.48
10.49	DO 11.49
10.50	DO 11.50
10.51	DO 11.51
10.52	DO 11.52
10.53	DO 11.53
10.54	DO 11.54
10.55	DO 11.55
10.99	L D FCLTMP.TMP;ERASE 12,11,9,10

11.05	ERASE 10.05;D 12.05
11.06	ERASE 10.06;D 12.06
11.07	ERASE 10.07;D 12.07
11.11	ERASE 10.11;D 12.11
11.12	ERASE 10.12;D 12.12
11.13	ERASE 10.13;D 12.13
11.14	ERASE 10.14;D 12.14
11.15	ERASE 10.15;D 12.15
11.16	ERASE 10.16;D 12.16
11.17	ERASE 10.17;D 12.17
11.18	ERASE 10.18;D 12.18
11.19	ERASE 10.19;D 12.19
11.20	ERASE 10.20;D 12.20
11.21	ERASE 10.21;D 12.21
11.22	ERASE 10.22;D 12.22
11.23	ERASE 10.23;D 12.23
11.24	ERASE 10.24;D 12.24
11.25	ERASE 10.25;D 12.25
11.26	ERASE 10.26;D 12.26
11.27	ERASE 10.27;D 12.27
11.28	ERASE 10.28;D 12.28
11.29	ERASE 10.29;D 12.29
11.30	ERASE 10.30;D 12.30
11.31	ERASE 10.31;D 12.31
11.32	ERASE 10.32;D 12.32
11.33	ERASE 10.33;D 12.33
11.34	ERASE 10.34;D 12.34
11.35	ERASE 10.35;D 12.35
11.36	ERASE 10.36;D 12.36
11.37	ERASE 10.37;D 12.37
11.38	ERASE 10.38;D 12.38
11.39	ERASE 10.39;D 12.39
11.40	ERASE 10.40;D 12.40
11.41	ERASE 10.41;D 12.41
11.42	ERASE 10.42;D 12.42
11.43	ERASE 10.43;D 12.43
11.44	ERASE 10.44;D 12.44
11.45	ERASE 10.45;D 12.45
11.46	ERASE 10.46;
11.47	ERASE 10.47;
11.48	ERASE 10.48;
11.49	ERASE 10.49;
11.50	ERASE 10.50;D 12.50
11.51	ERASE 10.51;D 12.51
11.52	ERASE 10.52;
11.53	ERASE 10.53;D 12.53
11.54	ERASE 10.54;D 12.54
11.55	ERASE 10.55;D 12.55

12.05	I 4 .G??E.2;I 4 .GT.2;I 4 .LE.4;I 4 .LT.5;T!"NOW WE HAVE THE ERROR MESSAGE CHECKOUT."
12.06	T!"PLEASE COOPERATE BY FOLLOWING THE INSTRUCTIONS FOR EACH ERROR MESSAGE."
12.07	T!"IN GENERAL THE IDEA IS TO TYPE GO AFTER EACH ONE."!!
12.11	L D PLEASE:TYPE.GO
12.12	12.00 PLEASE TYPE GO.
12.13	G 82.34; PLEASE TYPE GO.
12.14	I PLEASE$ TYPE GO.
12.15	S PLEASE TYPE GO.
12.16	O O SYS:PLEASE.TYPE GO
12.17	SET 2 PLEASE TYPE GO
12.18	L C SYS:ACCT;	PLEASE TYPE GO.
12.19	SET X=2+;PLEASE TYPE GO.
12.20	MODIFY 12.00 - PLEASE TYPE GO.
12.21	O O NUL:[1] - PLEASE TYPE GO.
12.22	O O NUL:[1,2 - PLEASE TYPE GO.
12.23	O O NUL:<100 - PLEASE TYPE GO.
12.24	X (,	PLEASE TYPE GO
12.25	999.99 - PLEASE TYPE GO.
12.26	SET FSIN(X)=5 - PLEASE TYPE GO.
12.27	U - PLEASE TYPE GO.
12.28	O O NUL:/30 - PLEASE TYPE GO.
12.29	X +*	PLEASE TYPE GO.
12.40	X 2+"A" - PLEASE TYPE GO.
12.41	Z - PLEASE TYPE GO.
12.42	O I PLEASE:TYPE.GO
12.50	T!"PLEASE TYPE	SET TTY NO ECHO,	START,	GO."!;O I NUL:;Q
12.51	O O FCLTMP.FCL;T"S";X FCHR(127),FCHR(16);T!"O I TTY:;GO TO 10.01"!;O O TTY:;O I FCLTMP.FCL;M 11.51
12.53	T!"PLEASE TYPE   RUBOUT,   CONTROL-C,   SET TTY ECHO,   REENTER,	GO."!;A X
12.55	T!"PLEASE MAKE THIS JOB RUN DETACHED UNTIL IT GOES INTO TO STATE IN 30 SECONDS."!;X FHIBER(1),FHIBER(30000);T!"THANKYOU"!

91.01	C - HERE TO COUNT AND DISPLAY THE REMAINING UNMARKED LOCATIONS.
91.02	C - FNEW FUNCTION HAS THE FOLLOWING CHARACTERISTICS:
91.03	C - ARGUMENT -1 RETURNS NUMBER OF LOCATIONS IN THE USE TABLE 
91.04	C - 	WHICH HAVE BEEN REFERENCED IN THE SIMULATION.
91.05	C - ARGUMENT  0 RETURNS TOTAL POSSIBLE NUMBER OF REFERENCES.
91.06	C - ARGUMENT POSITIVE IS TAKEN AS A RELATIVE LOCATION IN FOCAL,
91.07	C -	AND RETURNS THE NEXT UNREFERENCED LOCATION AFTER THAT.
91.15	TYPE%4!"SCORE:	"FNEW(-1)" OUT OF"FNEW(0)" POSSIBLE."!
91.17	T!"HERE ARE THE LOCATIONS IN FOCAL.SHR NOT SO FAR REFERENCED."!
91.20	SET LOC=8
91.30	SET LAS=LOC,LOC=FNEW(LOC);IF FNEW(0)+8-LOC 99.99,99.99;D 92;G 91.3

92.10	IF(LOC.EQ.LAS+1);T",40";G 92.3
92.20	T!"40"
92.30	S X=LOC/4096,LAS=LOC;F J=1,4;S X=(X-FITR(X))*8;X FCHR(FITR(X)+48)

99.99	O O SIMFCL.RPT;T%4"ACCESS TEST SCORE: "FNEW(-1)" [PAR"FNEW(0)-31"] OUT OF"FNEW(0)" POSSIBLE."!;O O TTY:;T!"FINISHED"!;O I NUL:;Q

T!"PLEASE TYPE CONTROL-Z,	START,	GO TO 1.01"!
%%%EWXMISC.FCL
10.10	T!"HERE ARE SEVERAL SMALL FOCAL PROGRAMS, SET ONE TO A GROUP."
10.20	T!"THE FIRST LINE OF EACH GROUP DESCRIBES THE GROUP'S FUNCTION:"!
10.30	W 11.01,12.01,13.01,14.01,15.01,16.01,17.01,18.01,19.01,20.01,21.01,22.01,23.01,24.01,25.01,26.01,27.01,28.01,29.01,30.01
10.40	T!"TO RUN ONE OF THE PROGRAMS, SAY GROUP MM, TYPE 'DO MM'"!!!
10.50	QUIT

11.01	C - FOCAL EXAMPLE 1	TABLE GENERATION USING FUNCTIONS
11.03	TYPE %E8.07;xecute FOCAL(2,2);C SUPPRESS "=" TYPEOUT.
11.05	T! "     I         SINE      COSINE          LOG             E"!
11.07	FOR I=1,.00001,1.000101;T %7.06,I,"  ",FSIN(I),"  ",FCOS<I>,"  ",%,FLOG[I],"  ",FEXP(I),!
11.09	QUIT

12.01	C - FOCAL EXAMPLE 2	DECIMAL TO OCTAL CONVERSION.
12.20	S I=0,M=0;X FOCAL(1,1)+FOCAL(2,2);C SUPPRESS COLON AND EQUALS.
12.25	A "DECIMAL: "
12.30	S I=I+1,A(I)=FCHR(-1)-48;IF A(I)*(A(I)-9) 12.3,12.3
12.31	I FABS(A(I)+48-16),12.96;I A(I)+48-127 12.35,12.2,12.35
12.35	I M 12.4,12.7,12.4
12.40	I -FABS(A(I)+48-13) 12.5;X FCHR(-1);G 12.8 ;CARRIAGE-RETURN - SWALLOW LINE-FEED.
12.50	T " ";G 12.8 ;CHARACTER OTHER THAN CR
12.60	I -FABS(A(M)+48-13) 12.5;X FCHR(-1);G 12.8
12.70	F M=1,I-1;S A(M-I)=A(M)
12.75	S M=I,I=0;I A(M)+48-46 12.6,12.3,12.6
12.80	T "OCTAL:";IF FABS(M) 12.8,12.95;S K=0
12.85	S A=0,B=0;F J=-M+1,-1;S A(J)=(10*A+A(J))/8,A=8*(A(J)-FITR(A(J))),A(J)=FITR(A(J)),B=B+A(J)
12.90	S K=K+1,B(K)=A;IF -FABS(B) 12.85;F J=K,-1,1;X FCHR(48+B(J))
12.95	S I=I-1;T ".";F J=1,I*1.2;D 12.98;X FCHR(A+48)
12.96	T !;Q
12.98	S A=0;F K=I,-1,1;S A(K)=8*A(K)+A,A=FITR(A(K)/10),A(K)=A(K)-10*A

13.01	C - FOCAL EXAMPLE 3	FINDING ROOTS OF A QUADRATIC EQUATION
13.10	A!"FOR EQUATION:"!!"  2"!"AX +BX+C	ENTER A ",A,"ENTER B ",B,"ENTER C ",C;S ROOT=B^2-4*A*C
13.20	IF -FABS(A) 13.4;T ! "THIS IS A FIRST DEGREE EQUATION" !; GOTO 13.10
13.40	T %6.03, ! " THE ROOTS ARE"; IF (ROOT) 13.7,13.6
13.50	T !,(-B+FSQT(ROOT))/(2*A),!,(-B-FSQT(ROOT))/(2*A); GOTO 13.1
13.60	T ! -B/(2*A),!; GOTO 13.10
13.70	T " IMAGINARY"!, -B/(2*A)," + (",FSQT(-ROOT)/(2*A),")*i"
13.80	T !,-B/(2*A)," - (",FSQT(-ROOT)/(2*A),")*i",!; GOTO 13.10

14.01	C - FOCAL EXAMPLE 4	POETRY READING.
14.02	T!"LET'S HAVE SOME POETRY!"!!;G 14.07
14.03	ASK"WHICH POEM WOULD YOU LIKE?  ";S N=FCHR(-1);I-FABS(N-27)14.04;Q
14.04	S X=FCHR(-1);I-FABS((X-27)*(X-127)*(X-10)) 14.04;T!!!!!;I(127-X),14.03
14.05	IF(N-33) 14.99;S N=N-64
14.06	I FABS(N-0M),14.30;I FABS(N-0G),14.09;I FABS(N-0H),14.51;I FABS(N-0J),14.61;I FABS(N-0L),14.71;I FABS(N-0B),14.81;I FABS(N-0X),14.07;I FABS(N-0Q),14.41;I FABS(N-0P),14.21,14.03
14.07	T"THE POEMS AVAILABLE ARE..."!!
14.08	T"(X) INDEX"!,"(G) ";D 14.09;T"(M) ";D 14.30;T"(H) ";D 14.51;T"(J) ";D 14.61;T"(L) ";D 14.71;T"(B) ";D 14.81;T"(P) ";D 14.21;T"(Q) ";D 14.41;T!!;G 14.03
14.09	T"GEORGIE PORGIE PUDDING AND PIE"!
14.10	T"KISSED THE GIRLS AND MADE THEM CRY"!
14.11	T"WHEN THE BOYS CAME OUT TO PLAY"!
14.12	T"GEORGIE PORGIE RAN AWAY"!!!
14.13	G 14.03
14.21	T"LITTLE BO PEEP HAS LOST HER SHEEP"!
14.22	T"AND CAN'T TELL WHERE TO FIND THEM"!!!
14.29	G 14.03
14.30	TYPE "MARY HAD A LITTLE LAMB"!
14.31	T"ITS FLEECE WAS WHITE AS SNOW"!
14.32	T"AND EVERYWHERE THAT MARY WENT "!
14.33	T"THE LAMB WAS SURE TO GO"!!
14.34	T"SHE TOOK IT TO THE SCHOOL ONE DAY"!
14.35	T"IT WAS AGAINST THE RULE"!
14.36	T"IT MADE THE CHILDREN LAUGH AND PLAY"!
14.37	T"AND I DON'T KNOW THE REST"!!!
14.39	G 14.03
14.41	T"MARY MARY QUITE CONTRARY"!
14.42	T"HOW DOES YOUR GARDEN GROW"!
14.43	T"WITH SILVER BELLS AND COCKLE SHELLS"!
14.44	T"AND ALL LITTLE MAIDS IN A ROW"!!!!!
14.45	G 14.03
14.51	T"HUMPTY DUMPTY SAT ON A WALL"!
14.52	T"HUMPTY DUMPTY HAD A GREAT FALL"!
14.53	T"ALL THE KINGS HORSES AND ALL THE KINGS MEN"!
14.54	T"COULDN'T PUT HUMPTY TOGETHER AGAIN"!!!!
14.59	G 14.03
14.61	T"LITTLE JACK HORNER SAT IN THE CORNER"!
14.62	T"EATING HIS CHRISTMAS PIE"!
14.63	T"PUT IN HIS THUMB AND PULLED OUT A PLUM"!
14.64	T"AND SAID WHAT A GOOD BOY AM I"!!!!!
14.69	G 14.03
14.71	T"LITTLE MISS MUFFET SAT ON A TUFFET"!
14.72	T"EATING HER CURDS AND WHEY"!
14.73	T"ALONG CAME A SPIDER AND SAT DOWN BESIDE HER"!
14.74	T"AND FRIGHTENED MISS MUFFET AWAY"!!!!!
14.79	G 14.03
14.81	T"BAA BAA BLACK SHEEP"!
14.82	T"HAVE YOU ANY WOOL"!
14.83	T"YES SIR YES SIR"!
14.84	T"THREE BAGS FULL"!
14.85	T"ONE FOR THE MASTER AND ONE FOR THE DAME"!
14.86	T"AND ONE FOR THE LITTLE BOY WHO LIVES DOWN THE LANE"!!!!!
14.87	G 14.03
14.99	QUIT

15.01	C - FOCAL EXAMPLE 5	INTEREST PAYMENT PROGRAM
15.10	ASK !!"ENTER INTEREST IN PERCENT " J,!
15.14	SET J=J/100
15.16	ASK "ENTER AMOUNT OF LOAN " A,!
15.20	ASK "NUMBER OF YEARS " N,!
15.24	ASK "NUMBER OF PAYMENTS PER YEAR " M,!!
15.30	SET N=N*M; SET I=J/M
15.34	SET B=1+I
15.40	SET R=A*I/(1-1/B^N)
15.42	TYPE "MONTHLY PAYMENT ",%7.02, R,!
15.48	TYPE "TOTAL INTEREST  " R*N-A,"(APPROX.)"!!
15.55	SET B=A
15.60	TYPE " INTEREST       APP TO PRINC          BALANCE",!
15.62	SET L=B*I; SET P=R-L
15.66	SET B=B-P
15.68	TYPE L, "      "P,"            "B,!
15.70	IF (B-R) 15.74,15.74,15.62
15.74	TYPE B*I,"      "R-B*I,! "LAST PAYMENT!" B*I+B,!
15.80	QUIT

16.01	C - FOCAL EXAMPLE 6	TEMPERATURE CONVERSION
16.10	ASK !,"FROM ",START,"  TO ",END,"  DEGREES FAHRENHEIT",!
16.20	ASK "     IN INCREMENTS OF ",INCR," DEGREES",!!
16.30	TYPE "THE APPROXIMATE FAHRENHEIT TO CENTIGRADE CONVERSIONS ARE:"
16.40	FOR T=START,INCR,END; TYPE !; DO 16.50
16.45	QUIT
16.50	TYPE " ",T," FAHRENHEIT DEG.  ",(T-32)*5/9," CENTIGRADE DEG."

17.01	C - FOCAL EXAMPLE 7	ONE-LINE FUNCTION PLOTTING
17.50	F I=0,.5,15; T "*",!; F J=0,30+15*FSIN(I)*FEXP[-.1*I]; T " "

18.01	C - FOCAL EXAMPLE 8	U.S. TO AUST DOLLAR CONVERSION
18.05	S RATE=.915
18.09	T %8.02;X FOCAL(2,2)
18.10	F P=1,100;D 18.31,18.32
18.20	X FCHR(12);Q
18.31	X FCHR(12);T"	";F X=1,3;T"         $US       $AUS"
18.32	T!!;F L=1,50;D 18.4;T!
18.40	T"	";F X=1,3;S U=L*10+(X-1)*500+(P-1)*1500;T"   ",U,U*RATE

19.01	C - FOCAL EXAMPLE 9	FHIBER DEMONSTRATION
19.02	TYPE!"THIS PROGRAM IS TUNED FOR USE ON A TERMINAL SPEED OF AT LEAST 150 BAUD"!!
19.04	SET MISTAKES=0,DELAY=0;X FOCAL(1,1),FOCAL(2,2),FHIBER(1)
19.05	T%3!"WHAT IS YOUR NAME?	";IF FHIBER(4000+2^21),19.05;A N$;G 19.1
19.07	T"TOO SMALL"
19.08	S MIS=MIS+1,DEL=DEL+5000;T!"YOU HAVE MADE",MIS," MISTAKE";I MIS-1,19.09;T"S"
19.09	T!"COME ON THERE ",N$!;S DEL=DEL+2000
19.10	T"WHAT IS 2+2 ?	";X FHIBER(1);IF FHIBER(DEL+5000+2^21),19.09;S DEL=0;A X;I X-4 19.07,19.7;T"TOO BIG";G 19.08
19.70	T"CONGRATULATIONS."!;Q

20.01	C - FOCAL EXAMPLE 10	EXPRESSION EVALUATOR.
20.02	TYPE!"ENTER YOUR EXPRESSION DELIMITED BY A SPACE:"!
20.10	A X$;O O FOO.FCL;T "T ",X$,"!"!;O O TTY:;L C FOO;G 20.1

21.01	C - FOCAL EXAMPLE 11	BATCH JOB MONITOR.
21.02	C - PROGRAM TO RING BELLS WHEN OTHER JOB SAME PPN LOGS OFF.
21.05	X FOCAL(2,2)
21.10	S ME=GETTAB(2,-1),MINE=GETTAB(8,-1),ERR=FOCAL(34),NUM=0
21.20	F JOB=1,GETTAB(10,16);I-FABS(ME-GETTAB(2,JOB))-FABS(ERR-FOCAL(34))21.99;I FABS(MINE-GETTAB(8,JOB)),21.99;S NUM=NUM+1,JB1=JB,JB=JOB;I NUM-1,21.99;S JB=JB1;T%2,JOB","
21.30	I 1-NUM 21.4,21.45
21.35	T!"THERE ARE NO OTHER JOBS WITH";G 21.44
21.40	T JB1" ARE JOB NUMBERS UNDER"
21.44	T" THIS PPN."!"PLEASE SELECT THE JOB NUMBER TO WATCH ";A JB
21.45	T!"WAITING FOR JOB",%3,JB," .....";G 21.5
21.48	I FHIBER(9999+2^21),21.5;I FABS(FCHR(-1)-16),21.99;T"[CONTROL-P TO ESCAPE]"!
21.50	I FABS(ME-GETTAB(2,JB)),21.48;T!"FINISHED."!
21.90	T"";X FHIBER(500);T"";I FHIBER(3000+2^21),21.9;I FABS(FCHR(-1)-16),21.99;T"[CONTROL-P TO ESCAPE]"!;G 21.9
21.99	R
%%%EWXLUNAR.FCL
C - FOCAL example 9 Lunar Lander Game.
Erase All,

01.01	X FOCAL(1,1)+FOCAL(3,3)+FOCAL(2,1)
01.04	T !,"CONTROL CALLING LUNAR MODULE....EMERGENCY ..."
01.05	T !,"MANUAL CONTROL IS NECESSARY.",!
01.06	T !,"YOU MAY RESET FUEL RATE K TO 0, OR ANY VALUE FROM"
01.07	T !,"8 TO 200 LBS/SEC AT 10 SECOND INTERVALS."
01.08	T !,"A NEGATIVE VALUE ABORTS THE LANDING."
01.10	T !!,"YOUR ESTIMATED FUEL RESERVE IS 16000 LBS"!
01.12	T !,"FREE FALL IMPACT TIME = 120 SEC. CAPSULE WT. 32500 LBS."
01.14	T !,"WE ARE TURNING ON YOUR RADAR....GOOD LUCK ! ",!!
01.16	S Q=1
01.20	T !,"FIRST RADAR CHECK COMING UP ",!!!
01.30	T !,"COMMENCE LANDING PROCEDURE",!
01.31	T !,"   TIME        HEIGHT            SPEED"
01.32	T "        FUEL      FUEL RATE",!
01.33	T "  SECONDS   MILES   FEET          MPH"
01.34	T "          LBS       LBS/SEC"
01.50	T !!

02.05	S L=0;S A=120;S V=1;S M=33000;S N=17000;S G=.001;S Z=1.8
02.10	T %6,L,%8,FITR(A),%7,5280*(A-FITR(A))
02.20	T %13.02,3600*V,%11.01,M-N,"     K=";A K;S T=10
02.70	T %7.02,;I (K) 2.74;I (200-K) 2.72; I (K-8) 2.71,3.1,3.1
02.71	I (K) 2.74,3.1,2.72
02.72	T !,"NOT POSSIBLE ";F X=1,51;T "."
02.73	T "K= ";A K; G 2.7
02.74	T !!,"LANDING ABORTED - CHICKEN!"!!!;Q

03.10	I ((M-N)-.001) 4.1;I (T-.001) 2.1;S S=T
03.40	I ((N+S*K)-M)  3.5,3.5;S S=(M-N)/K
03.50	D 9;I (I) 7.1,7.1;I (V) 3.8,3.8;I (J) 8.1
03.80	D 6;G 3.1

04.10	T "FUEL OUT AT ",L," SECS.",!
04.40	S S=(-V+FSQT(V*V+2*A*G))/G;S V=V+G*S;S L=L+S

05.10	T "ON MOON AT ",L," SECS.",!;S W=3600*V
05.20	T "IMPACT VELOCITY OF ",W," M.P.H. ",!,"FUEL LEFT: "
05.30	T M-N, " LBS.",!; I (-W+1) 5.5,5.5
05.40	T "PERFECT LANDING ! - (LUCKY ?) ",!;G 5.9
05.50	I (-W+10) 5.6,5.6;T "GOOD LANDING - (COULD BE IMPROVED ) ",!;G 5.9
05.60	I (-W+25) 5.7,5.7;T "CONGRATULATIONS ON A POOR LANDING",!;G 5.9
05.70	I (-W+60) 5.8,5.8;T "CRAFT DAMAGED - GOOD LUCK ",!;G 5.9
05.80	T "SORRY, BUT THERE WERE NO SURVIVORS - YOU BLEW IT ",!
05.82	T "IN FACT YOU CREATED A NEW LUNAR CRATER ",W*.277," FT. DEEP ",!
05.90	T !!,"CONTROL OUT ",!!;Q

06.10	S L=L+S;S T=T-S;S M=M-S*K;S A=I;S V=J

07.10	I (S-.005) 5.1;S S=2*A/(V+FSQT(V*V+2*A*(G-Z*K/M)))
07.30	D 9;D 6;G 7.1

08.10	S W=(1-M*G/(Z*K))/2;S S =M*V/(Z*K*(W+FSQT(W*W+V/Z)))+.05;D 9
08.30	I (I) 7.1,7.1;D 6; I (-J) 3.1,3.1; I (V) 3.1,3.1,8.1

09.10	S Q=S*K/M;S J=V+G*S+Z*(-Q-Q^2/2-Q^3/3-Q^4/4-Q^5/5)
09.40	S I =A-G*S*S/2-V*S+Z*S*(Q/2+Q^2/6+Q^3/12+Q^4/20+Q^5/30)

TYPE !"LUNAR LANDER GAME."!
TYPE !"THIS GAME ALLOWS YOU TO ATTEMPT A LUNAR LANDING SIMULATION"
TYPE !"BY ADJUSTING ROCKET POWER TO CUSHION THE LANDING."
TYPE !"START THE PROGRAM BY TYPING 'GO' FOLLOWED BY THE CR KEY."!!
%%%EWXMULPK.FCL
C - FOCAL MULTIPLE PRECISION PACKAGE.
C-FOCAL	v3A(222)-1	2102	28-AUG-73
ERASE ALL,

1.01	TYPE !!"IN ORDER TO USE THE MULTIPLE-PRECISION PACKAGE,"
1.02	TYPE !"CREATE A FOCAL APPLICATIONS PROGRAM IN GROUPS 1-39,"
1.03	TYPE !"THEN CALL IN THE PACKAGE, AND RUN THE COMBINATION."!
1.04	QUIT

40.01	C - INITIALIZE PARAMETERS AND CONSTANTS
40.10	S N=6 ;C - NUMBER OF WORDS OF PRECISION.
40.11	C - ITEM 0 IS THE SIGN/OVERFLOW WORD.
40.12	C - ITEM N+1 IS THE REMAINDER WORD.
40.20	S M=2^24 ;C - MODULO OF WORDS OF PRECISION
40.21	C - M*M*N MUST NOT OVERFLOW WORD LENGTH.
40.30	S P=0 ;C - STACK POINTER ;C - STACK IS A(P,I)
40.40	S U=1 ;C - INDEX OF WORD WITH DECIMAL POINT AT THE RIGHT OF IT.
40.50	C - ARG = SINGLE-WORD ARGUMENT.
40.60	X FOCAL(2,2);T%3;ERASE 41.01,42.01,43.01,44.01,45.01,46.01,47.01,48.01,49.01,50.01,51.01,52.01,53.01,54.01,55.01,56.01,57.01,58.01,59.01

41.01	C - CREATE A NUMBER WITH VALUE ARG.
41.10	S P=P+1,T1=N+1,T3=0;IF FABS(ARG) 41.2,41.2;S T1=U-FITR(FLOG(FABS(ARG))/FLOG(M)),T3=ARG*M^(T1-U)
41.20	F T2=0,T1-1;S A(P,T2)=0
41.30	F T2=T1,N+1;S A(P,T2)=FITR(T3),T3=M*(T3-FITR(T3))

42.01	C - ADD TOP NUMBER INTO SECOND TOP.
42.10	S P=P-1,T2=0;F T1=N,-1,1;S T3=T2+A(P,T1)+A(P+1,T1),T2=FITR(T3/M),A(P,T1)=T3-M*T2
42.20	S A(P,0)=T2

43.01	C - SUBTRACT TOP NUMBER INTO SECOND TOP.
43.10	S P=P-1,T2=0;F T1=N,-1,1;S T3=T2+A(P,T1)-A(P+1,T1),T2=FITR(T3/M),A(P,T1)=T3-M*T2
43.20	S A(P,0)=T2

44.01	C - SCALE (MULTIPLY) TOP NUMBER BY INTEGER, ARG.
44.10	S T2=0;F T1=N,-1,1;S T3=T2+A(P,T1)*ARG,T2=FITR(T3/M),A(P,T1)=T3-M*T2
44.20	S A(P,0)=T2

45.01	C - DIVIDE TOP NUMBER BY INTEGER, ARG.
45.10	S T2=0;F T1=1,N;S T3=FITR((T2*M+A(P,T1))/ARG),T2=T2*M+A(P,T1)-ARG*T3,A(P,T1)=T3
45.20	S A(P,N+1)=T2

46.01	C - MULTIPLY TOP NUMBER INTO SECOND TOP
46.10	S T4=P-1;F T5=1,N;D 47;S ARG=A(T4,T5);D 44,48
46.20	F T5=1-U,2*N-U;S A(T4,T5)=0
46.30	F T5=1,N;F T1=0,N;S A(T4,T1+T5-U)=A(T4,T1+T5-U)+A(T4+T5,T1)
46.40	S P=T4,T2=0;F T1=2*N-U,-1,-U;S T3=A(P,T1)+T2,T2=FITR(T3/M),A(P,T1)=T3-M*T2

47.01	C - COPY ONE NUMBER TO MAKE A NEW ENTRY, INDEX P
47.10	S P=P+1;F T1=1,N;S A(P,T1)=A(P-1,T1)

48.01	C - INTERCHANGE TOP AND SECOND TOP
48.10	F T1=1,N;S T2=A(P,T1),A(P,T1)=A(P-1,T1),A(P-1,T1)=T2

51.01	C - CREATE LOGARITHM OF TOP ENTRY AS A NEW ENTRY.
51.10	C - NUMBER >= 1
51.20	S POW=0;D 47,53;I -ARG 51.3;Z "ILLEGAL LOGARITHM ARGUMENT".
51.30	I ARG-1.05 51.4;S POW=POW+1;D 55,48,57,53;G 51.30
51.40	S ARG=1;D 41,48,43,47,47;S ITER=1
51.50	S ARG=P-1;D 56;S ARG=P-3;D 56,46,51.9,53;I -FABS(ARG) 51.6;D 57,43;S ARG=2^POW;D 44;R
51.60	S ITER=ITER+1,ARG=ITER;D 45,42;G 51.5
51.90	F T1=1,N;S A(P-2,T1)=A(P,T1)

52.01	C - TYPE OUT TOP NUMBER IN RADIX RAD
52.05	S RAD=FITR(RAD+.5);I -RAD 52.1;S RAD=10;C - DEFAULT DECIMAL.
52.10	D 47,53;F T1=U,-1,1;S A(P,N+T1-U)=A(P,T1)*FSGN(ARG)
52.20	F T1=0,N-U;S A(P,T1)=0
52.30	S ND=0;I -ARG 52.4,52.4;T "-"
52.40	S ND=ND+1,ARG=RAD;D 45,53;S CH(ND)=A(P,N+1);I -FABS(ARG) 52.4
52.50	F T1=ND,-1,1;X FCHR(CH(T1)+48)
52.60	T ".";S ND=(N-U)*FLOG(M)/FLOG(RAD)
52.70	D 57,47;F T7=1,ND;S A(P,U)=0,ARG=RAD;D 44;X FCHR(A(P,U)+48)
52.80	D 57

53.01	C - RETURN VALUE OF TOP NUMBER IN ARG.
53.10	S ARG=0;F T1=1,N;S ARG=ARG+A(P,T1)*M^(U-T1)

54.01	C - ACCEPT A (POSITIVE) (FIXED-POINT) NUMBER TYPED IN, TO CREATE A NEW NUMBER
54.05	I -RAD 54.1;S RAD=10
54.10	S T4=1,ARG=0;D 41
54.20	S CH=FCHR(-1);I CH-46 54.9,54.6;I CH-48 54.9;I 57-CH 54.9;S ARG=RAD;D 44;S ARG=CH-48;D 41,42;G 54.2
54.60	S CH=FCHR(-1);I (CH-48)*(57-CH) 54.9;S ARG=CH-48;D 41;F T8=1,T4;S ARG=RAD;D 45
54.70	D 42;S T4=T4+1;G 54.6
54.90	IF CH-13 54.99,54.91,54.99
54.91	X FCHR(-1);C - SWALLOW LINE-FEED AFTER CARRIAGE-RETURN
54.99	RETURN

55.01	C - CREATE SQUARE ROOT OF TOP NUMBER AS A NEW NUMBER.
55.10	D 53;S ARG=FSQT(ARG),TSQ=2*ARG;D 41
55.20	D 47,47,46;S ARG=P-2;D 56,43;S ARG=TSQ;D 45,53,43;I -FABS(ARG) 55.2

56.01	C - COPY ONE NUMBER TO MAKE A NEW ENTRY, INDEX ARG.
56.10	S P=P+1;F T1=1,N;S A(P,T1)=A(ARG,T1)

57.01	C - DELETE TOP ENTRY
57.10	S P=P-1

58.01	C - TYPE OUT TOP NUMBER IN DECIMAL
58.10	D 47,53;F T1=U,-1,1;S A(P,N+T1-U)=A(P,T1)*FSGN(ARG)
58.20	F T1=0,N-U;S A(P,T1)=0
58.30	S ND=0;I -ARG 58.4,58.4;T "-"
58.40	S ND=ND+1,ARG=10;D 45,53;S CH(ND)=A(P,N+1);I -FABS(ARG) 58.4
58.50	F T1=ND,-1,1;X FCHR(CH(T1)+48)
58.60	T ".";S ND=(N-U)*LOG10(M)
58.70	D 57,47;F T7=1,ND;S A(P,U)=0,ARG=10;D 44;X FCHR(A(P,U)+48)
58.80	D 57

59.01	C - TYPE OUT TOP NUMBER IN OCTAL
59.10	D 47,53;F T1=U,-1,1;S A(P,N+T1-U)=A(P,T1)*FSGN(ARG)
59.20	F T1=0,N-U;S A(P,T1)=0
59.30	S ND=0;I -ARG 59.4,59.4;T "-"
59.40	S ND=ND+1,ARG=8;D 45,53;S CH(ND)=A(P,N+1);I -FABS(ARG) 59.4
59.50	F T1=ND,-1,1;X FCHR(CH(T1)+48)
59.60	T ".";S ND=(N-U)*FLOG(M)/FLOG(8)
59.70	D 57,47;F T7=1,ND;S A(P,U)=0,ARG=8;D 44;X FCHR(A(P,U)+48)
59.80	D 57

TYPE !"FOCAL MULTIPLE-PRECISION PACKAGE."!
TYPE !"	THIS PACKAGE IS A COLLECTION OF SUBROUTINES"
TYPE !"WHICH MUST BE CALLED BY AN APPLICATIONS PROGRAM"
TYPE !"USING THE FOCAL 'DO' COMMAND."
TYPE !"THE APPLICATIONS PROGRAM IS RESPONSIBLE FOR"
TYPE !"SETTING UP THE ARGUMENTS FOR EACH SUBROUTINE AND"
TYPE !"FOR MODIFYING AND CALLING GROUP 40 PRIOR TO INITIAL USE."
TYPE !!"	THE PACKAGE USES VARIABLES"
TYPE !"ARG, ITER, N, ND, M, P, POW, RAD, TSQ, T1,T2,T3,T4,T5,T6,T7,T8 AND V."
TYPE !"ARRAYS A(..,..) AND CH(..) ARE ALSO USED."
TYPE !!"	THE ARRAY A(..,..) IS USED IN THE FORM OF A PUSH-DOWN STACK."
TYPE !"THE PACKAGE INCLUDES ADDITION, SUBTRACTION, MULTIPLICATION,"
TYPE !"DIVISION BY INTEGER, STACK MANIPULATION (DUPLICATE, INTERCHANGE,"
TYPE !"DELETE TOP ENTRIES), LOGARITHM, SQUARE ROOT AND DATA ENTRY AND"
TYPE !"TYPE-OUT IN OCTAL AND DECIMAL."
GO
%%%EWXLEARN.FCL
ERASE,ALL
C - FOCAL LEARNING PROGRAM
C-FOCAL	v3A(226)-1	1716	24-OCT-73

01.01	X FOCAL(2,2);D 2
01.02	D 3.1
01.03	E 3.1;D 3
01.04	D 4
01.05	D 5.1
01.06	E 5.1;D 5
01.07	D 6.1
01.08	E 6.1;D 6
01.09	D 7.1
01.10	E 2,3,4,5,6,7,8,9,10,1.10
01.11	D 21
01.12	D 22
01.13	D 23.05
01.14	E 23.05;D 23
01.15	E 23.1;D 23
01.16	E 23.2;D 23
01.17	D 24
01.18	D 25
01.19	D 26
01.20	E 20,21,22,23,24,25,26,27,28,29,1.20
01.21	D 31
01.22	D 32
01.23	E 32.1;D 32
01.24	D 33
01.25	D 34
01.26	D 35
01.27	D 36
01.28	D 37
01.29	D 38
01.30	E 38.1;D 38
01.31	E 11,19,31,32,33,34,35,36,37,38,39,1.31
01.40	D 41
01.41	D 42
01.42	E 42.1;D 42
01.43	D 43
01.44	D 44
01.45	D 45
01.46	D 46
01.47	D 47
01.48	D 48

02.10	T %8.04,!!"FOCAL MAY BE USED IN PROGRAM OR";D 9.1;T !;D 9.1
02.20	T " ALLOWS 'DESK CALCULATOR' OPERATION"!;D 9.2;T " IS USEFUL FO
02.30	T "R THIS PURPOSE"!!"THE COMPUTER WILL RECEIVE A COMMAND ON TYP
02.40	T "ING '*'";D 9.3;T !"TYPE 123.456";D 8;E 1.01;Q

03.10	D 9.4;E 1.02;Q
03.20	T !!;D 9.2;T " CAN ALSO BE USED IN CALCULATING.";D 9.3
03.30	T !"TYPE 1+2";D 8;E 1.03;Q

04.10	T !!"'*' REPRESENTS MULTIPLY, '/' DIVIDE AND BRACKETS ARE AVAIL
04.20	T "ABLE";D 9.3;T !"TYPE (3/4-9)/(1.23*2.45+1)";D 8;E 1.04;Q

05.10	D 9.4;E 1.05;Q
05.20	T !!;D 9.2;T " CAN BE USED TO PRINT TEXT";D 9.3
05.30	T !"TYPE ";X FCHR(34);T"MARY HAD A LITTLE LAMB";X FCHR(34)
05.40	D 9.5,8,10;E 1.06;Q

06.10	D 9.4,10;E 1.07;Q
06.20	T !!"TEXT, EXPRESSIONS ETC. MAY ALL BE PLACED AFTER";D 9.2
06.25	T !"SEPARATED BY COMMAS";D 9.3
06.30	T !"TYPE ";X FCHR(34);T"ONE=";X FCHR(34);T",1,";X FCHR(34);T"A=";X FCHR(34);T",3.4/5.6,";X FCHR(34);T"B=";X FCHR(34);T",(9-0.7)/4"
06.40	D 9.5,8.3;E 10.21;D 10;E 1.08;Q

07.10	D 9.4,10;E 1.09;Q
07.20	L C F29B;G

08.20	T !"END ALL COMMANDS WITH THE RETURN KEY 
08.30	T !"TYPE 'GO' TO RESUME THE TUTORIAL"!!

09.10	T " IMMEDIATE MODE
09.20	T " THE 'TYPE' COMMAND
09.30	T !" TRY TYPING THE COMMAND:
09.40	T !!"TRY 2 OR 3 SIMILAR COMMANDS - AGAIN";D 8
09.50	T !"N.B. TYPE DOUBLE QUOTES AROUND THE TEXT

10.10	T "IF YOU MIS-TYPE"!"THE 'RUBOUT' OR 'DEL' KEY DELETES THE PRECED
10.20	T "ING LETTER(S)"!
10.21	T"EACH DELETED LETTER IS ECHOED AS IT IS RUBBED OUT."!

20.10	T !"RESUME THE TUTORIAL WITH 'GO'"!!

21.30	T !!%8.04"A SPECIAL SYMBOL, '!', IS USED WITH";D 29.2;T !"TO STA
21.40	T "RT A NEW LINE"!"TRY";D 29.3;T !"TYPE !"!"THEN TRY";D 29.3
21.50	T !"TYPE !!!!!";D 20;E 1.11;Q

22.10	D 29.4;T " WITH TEXT, EXPRESSIONS & '!'"!"SEPARATED BY ','";D 20;E 1.12;Q

23.05	D 29.9;D 29.3;T !"SET A=43.73";D 28;E 1.13;Q
23.10	T !!"NOW TRY"!"SET A=2+3*4-5.6/7.8";D 28;E 1.14;Q
23.20	D 29.4,20;E 1.15;Q
23.30	T !!"THE '=' SIGN IN";D 29.6;T " DIFFERS FROM AN ALGEBRAIC '='
23.40	T !"TRY";D 29.3;T !"SET A=1";D 28.1;T !"SET A=A+1";D 28;E 1.16;Q

24.10	T !!"SO FAR WE HAVE WORKED IN IMMEDIATE MODE"!"WE PROGRAM WITH
24.20	D 29.8;T "S. TRY";D 29.3;T !"11.12 SET A=1";D 28.1;T !"11.15 TYPE 
24.30	T " A,!"!"A";D 29.8;D 29.7;T " THROUGH THE 'DO' COMMAND"!"AFTER T
24.40	T "YPING THE";D 29.8;T "S ABOVE TRY";D 29.3;T !"DO 11.12";D 28.1
24.50	T !"DO 11.15";D 20;E 1.17;Q

25.10	T !!"NOW TYPE A NEW LINE"!"11.13 SET A=A+1"!"TRY 'DO'ING ALL 3
25.20	T " LINES IN VARIOUS ORDERS";D 20;E 1.18;Q

26.10	T !!"YOU CAN WRITE OUT A LINE THUS - TRY"!"WRITE 11.12";D 28.1
26.20	T !"WRITE 11.13";D 28.1;T !"WRITE 11.15";D 20;E 1.19;Q

27.10	T !!"WRITE 11"!"AND"!"DO 11"!"'WRITE' AND 'DO' ALL '11' LINES

28.10	T !" FOLLOWED BY
28.20	T !"TYPE A";D 20

29.20	T " THE 'TYPE' COMMAND
29.30	T " TYPING:
29.40	T !!"NOW TRY SOME SIMILAR COMMANDS
29.60	T " THE 'SET' COMMAND
29.70	T " MAY BE USED
29.80	T " NUMBERED COMMAND
29.90	T !!;D 29.6;D 29.7;T " TO SET THE VALUE OF A VARIABLE"!"TRY

30.10	T !"RESUME WITH 'GO'"!!

31.30	T %8.04" - TRY THEM";D 30;E 1.21;Q

32.10	T !!;D 39.2;T " HALTS A PROGRAM - TRY IT"!"REENTER FOCAL BY THE 'REENTER' MONITOR COMMAND"!;E 1.22;Q
32.20	T !!"GOTO 11.12"!"WILL CAUSE THE PROGRAM TO TRANSFER TO THE
32.30	T " NUMBERED LINE,"!"CARRY OUT THAT COMMAND & THEN EACH NU
32.40	T "MBERED COMMAND IN TURN"!"TRY IT"!"THEN TRY 'GOTO' WITH EA
32.45	12.01	Q
32.50	T "CH OTHER '11' LINE";D 30;E 1.23;Q

33.10	T !!"TYPE IN"!"11.19 GOTO 11.13"!"NOW TRY"!"WRITE 11"!"& STAR
33.20	T "T WITH"!"GOTO 11.12"!"N.B. YOU MUST HALT BY";D 39.2;T!"RESUME WITH 'REENTER' AND 'GO'"!;E 1.24;Q

34.10	T !!"AN ALTERNATIVE TO 'SET' IS 'ASK' - TRY"!"ASK A"!"FOLLOWED B
34.20	T "Y"!"TYPE A,!"!"TYPE IN A NUMBER AFTER ':'";D 30;E 1.25;Q

35.10	T !!"ERASE 11"!"ERASES ALL '11' LINES -TRY IT"!"THEN TRY
35.20	T !"WRITE 11";D 30;E 1.26;Q

36.10	T !!"ENTER & TRY A PROGRAM (USE '11' LINES) USING ASK & TYPE
36.20	T !"N.B. 'ERASE' MAY BE USED WITH SINGLE LINES";D 30;E 1.27;Q

37.10	T !!"SUBSCRIPTS ARE SHOWN BY BRACKETED NUMBERS"!"AFTER THE VA
37.20	T "RIABLE NAME"!"TRY"!"SET A(1)=30.34"!"&"!"SET A(2)=43.75
37.30	T !"THEN"!"TYPE A(1),!"!"&"!"TYPE A(2),!";D 30;E 1.28;Q

38.10	T !!"SET AND TYPE MORE SUBSCRIPTED VARIABLES";D 30;E 1.29;Q
38.20	T !!"IF (X)LINE 1,LINE 2,LINE 3"!"ACTS AS";D 39.1;T " 1' IF X<0 ,
38.30	D 39.1;T " 2' IF X=0 , OR";D 39.1;T " 3' IF X>0"!"'ASK' PRINTS TE
38.40	T "XT LIKE 'TYPE'"!"'ERASE 11' & ENTER THE FOLLOWING 'LOOPING' PROGRAM ....."
38.50	T !"11.10 ASK ";X FCHR(34);T"NO. OF READINGS";X FCHR(34);T",N"!

39.10	T !"'GOTO LINE
39.20	T " TYPING CONTROL/C TWICE

41.50	T %8.04"11.20 SET I=0"!"11.30 SET I=I+1
41.60	T !"11.40 ASK A(I)"!"11.50 IF (I-N)11.3,11.6,11.3"!"11.60 SET I=0
41.70	T !"11.70 SET I=I+1"!"11.80 TYPE A(I),!"!"11.90 IF (I-N)11.7,11
41.75	12.01	Q
41.80	T ".95,11.7"!"11.95 TYPE ";X FCHR(34);T"OUTPUT FINISHED";X FCHR(34);T",!"!" ";T !!;E 1.40;Q

42.10	T !!"NOW TYPE 'GOTO 11.1'"!!;E 1.41;Q
42.20	T !!"'LOOPING' IS BETTER DONE WITH 'FOR'"!"11.20 FOR I=1,N;A
42.40	T "SK A(I)";D 49.2;T " 11.2 TO 11.5";D 49.3;T " 11.2";D 49.4;E 1.42;Q

43.10	T !!"SIMILARLY"!"11.60 FOR I=1,N;TYPE A(I),!";D 49.2
43.20	T " 11.6 TO 11.9";D 49.3;T " 11.6";D 49.4;E 1.43;Q

44.10	T !!"'FOR I=1,N;-' MEANS FOR I=1 UP TO I=N CARRY OUT ALL COMMANDS
44.20	T " AFTER ';'"!"N.B. A LINE MAY CONTAIN DIFFERENT COMMANDS SE
44.30	T "PARATED BY ';'"!"'FOR' IS USED IN SUMMING - ENTER"!"11.70 SET S=
44.40	T "0;FOR I=1,N;SET S=S+A(I)"!"11.92 TYPE ";X FCHR(34);T"S=";X FCHR(34);T",S"!;D 49.4;E 1.44;Q

45.10	T !!"'TYPE' USES THE LAST FORMAT GIVEN"!"ABOVE IT WAS '%8.04'
45.20	T !"[SPACE FOR 8 DIGITS & 4 DECIMALS]"!"'%' IS FORMAT - TRY
45.30	T !"TYPE %8.04,1,!,%5.02,1,!,%2,1,!,%,1,!
45.40	T !"[N.B. INTEGER & 'E' FORMATS]"!!;E 1.45;Q

46.10	T !!"TRY MORE FORMATS"!!;E 1.46;Q

47.10	T !!"CALCULATE FACTORIAL 30 BY"!"SET M=1;FOR A=1,30;SET M=
47.20	T "M*A"!"THEN"!"TYPE %,M,!"!!;E 1.47;Q

48.10	T !"**TUTORIAL ENDS**"!"READ THE FOCAL MANUAL"!!;E A

49.20	T !"WILL REPLACE LINES
49.30	T !"ERASE THEM & TYPE IN THE NEW
49.40	T !"'WRITE 11' & START AS ABOVE"!!
TYPE "FOCAL LEARNING PROGRAM."!!!"THIS PROGRAM WILL ASSIST YOU TO LEARN HOW TO USE FOCAL"!
TYPE "AS A DESK CALCULATOR AND AS A PROGRAMMING TOOL."!
TYPE "FOCAL WILL LEAD YOU THROUGH A LESSON, IN WHICH YOU WILL"!
TYPE "RECEIVE INSTRUCTIONS, YOU WILL TRY SOME EXAMPLES, AND"!
TYPE "YOU WILL RETURN TO THE INSTRUCTOR BY TYPING 'GO' AND CARRIAGE-RETURN."!!!
TYPE !"TO PROCEED, TYPE 'GO' AND STRIKE THE CARRIAGE-RETURN KEY."!
%%%EWXHAM.FCL
ERASE,ALL
C-FOCAL	v3C(245)-1	1001	22-JUN-74

01.10	X FOCAL(2,2),FOCAL(1,1),FCHR(29);D 8;X FCHR(31);D 8
01.20	S TONS=FITR(FRAN*4000),POP=FITR(FRAN*6000),YEAR=1792,POI=0
01.30	X FCHR(29);T!"O KING HAMURABI! LIVE FOREVER!	HERE IS THE"!%4,YEA" B.C. ANNUAL REPORT."!"IN THE KINGDOM THERE ARE"!%5,POP," PEOPLE	(ORIGINALLY"POP")"!TON" TONS OF GRAIN"!
01.40	T"HOW MANY TONS OF GRAIN WOULD YOU LIKE TO SOW THIS SEASON?"
01.90	G 2.2

02.10	S TON=FITR(TON+.5);X FCHR(29);D 8;T%4,!!YEA!!%5,POP!TON!
02.20	S TON=FITR(TON+.5);T!;X FCHR(30);D 8;A SOW;S SOW=FITR(SOW+.5)
02.21	IF(YEA-1751) 9.9;IF(TONS-SOW)3.8,3.7
02.22	I(YEA-1792) 4.1;X FCHR(31)

03.20	G 4.1
03.70	T!!!!;X FCHR(31);T"YOU WISH TO SOW EVERY BIT OF GRAIN IN THE KINGDOM!!"!"NEVERTHELESS, YOUR MAJESTY,! YOUR WISH IS MY COMMAND!"!;X FCHR(14),FCHR(42),FCHR(32);G 2.22
03.80	T!!!!;X FCHR(31);T"WITH EVERY RESPECT YOUR MAJESTY, WE HAVE ONLY"TONS" TONS OF GRAIN"!"AND WE ARE THEREFORE UNABLE TO SOW"SOW" TONS WITHOUT EXTERNAL HELP"!"WHAT IS YOUR ADVICE O KING?"!;G 2.1

04.10	S YEAR=YEAR-1
04.20	S STO=TON-SOW
04.30	S RAT=FITR(STO*FRAN(-1)*STO/POP);IF(.95-FRAN) 4.31;S RAT=0
04.31	S FLOODS=FSQT(FRAN)-.5;IF(.95-FRAN)4.32;S FLOODS=0
04.32	S DROUGHT=FSQT(FRAN)-.5;IF(.95-FRAN)4.33;S DROUGHT=0
04.33	I(RAT-STO) 4.34;S RAT=FITR(STO*3/4)
04.34	S KIL=0;I(RAT)4.4;I(POI)4.4;I(RAT-100*POI)4.35;S POI=0,RAT=RAT-100*POI,KIL=10000*POI;G 4.4
04.35	S POI=POI-RAT/100,KIL=100*RAT,RAT=0
04.40	S HARVEST=FITR(SOW*2.1*FRAN*(1-FLO)*(1-DRO))
04.60	S ENEMYDEATHS=FITR(.5+(FRAN-.9)*SOW*(1+POP*POP/10000)^.1);IF(-ENE) 4.61;S ENE=0
04.61	S EAT=FITR(POP*.1);I(EAT+RAT-STO)4.62;S EAT=FITR((STO-RAT)*.9)
04.62	CONT
04.65	S BIRTH=FITR(.5+POP*.01*(1+FRAN))
04.66	S DEATH=FITR(.5+POP*.003*(1+FRAN))
04.70	S STA=FITR(.5+POP-EAT*20);IF(-STA) 4.9;S STA=0
04.90	S TON=STO-RAT+HAR-EAT
04.91	S OVERFLOWFROMSTORAGEBINS=0;I(TON-9999)4.92;S OVE=TON-9999,TON=9999
04.92	CONTINUE
04.95	S POP=POP+BIR-DEA-ENE-STA;I(-POP)4.96;X FCHR(31);T!!!!"ALL THE PEOPLE ARE DEAD";G 9.9
04.96	C

05.01	I(YEA-1791)5.15
05.02	T BIR" BAB";D 12.3;T" BORN DURING THE YEAR   "!
05.03	T DEA" DEATH";S X=DEA;D 12.01;T" OCCURRED FROM NATURAL CAUSES "!
05.04	T EAT" TON";S X=EAT;D 12.01;T" OF GRAIN W";D 12.1;T" SOLD AS FOOD   "!
05.10	T HAR" TON";S X=HAR;D 12.01;T" OF GRAIN W";D 12.1;T" HARVESTED THIS YEAR   "!;S REMEMBER=(DEA-1)*(EAT-1)*(BIR-1)*(HAR-1)
05.11	G 5.2
05.15	IF FABS(REM) 11.99,5.02;IF FABS((BIR-1)*(DEA-1)*(EAT-1)*(HAR-1)) 11.99,5.02;T BIR!DEA!EAT!HAR!;X FCHR(31)
05.20	I(RAT-.5)5.23;T RAT" TON";S X=RAT;D 12.01;T" OF GRAIN W";D 12.1;T" EATEN BY RATS THIS YEAR"!
05.21	I(-POI)5.23;I(FRAN-.8)5.23;T"WOULD YOU LIKE TO PURCHASE SOME RAT POISON?"!"THE PRICE IS CURRENTLY 10 TONS OF GRAIN PER BIN OF POISON.	? ";S X=FCHR(-1);A X1;X FCHR(26);D 8;X FCHR(26);D 8;I(-FABS(X-89))5.23;T"HOW MANY BINS OF POISON? ";X FCHR(30);D 8;A POI;I(10*POI-TON)5.22;S POI=FITR(TON/10)
05.22	S POI=FITR(POI+.5),TON=TON-10*POI;T POI" BIN";S X=POI;D 12.01;T" OF POISON PURCHASED.   EACH BIN WILL KILL 10,000 RATS	"!
05.23	X FCHR(31);D 8;I(KIL-.5)5.3;T KIL" RAT";S X=KIL;D 12.01;T" DIED FROM POISONING"!
05.30	IF(STA-.5)5.4;IF(POP) 9.1,9.1;T STA;D 12.2;T" DIED OF STARVATION"!
05.31	I(FRAN-.95)5.4;T"THE AIM OF THE GAME IS TO BUILD UP THE POPULATION!"!
05.40	CONTINUE
05.50	I(ENE-.5)5.6;T ENE" FARMER";S X=ENE;D 12.01;T" W";D 12.1;T" KILLED BY ENEMY RAIDERS"!
05.51	I(FRAN-.9)5.6;I(FRAN-.75)5.52;T"PERHAPS YOU ARE SENDING TOO MANY FARMERS TO THE FIELDS?"!;G 5.6
05.52	T"THE MORE WE SOW, YOUR MAJESTY, THE MORE THE ENEMY WILL RAID US"!
05.60	I(FLO-.005)5.7;T 100*FLO" PERCENT OF THE HARVEST WAS RUINED BY FLOODS"!
05.70	I(DRO-.005)5.8;T 100*DRO" PERCENT OF THE HARVEST WAS RUINED BY DROUGHT"!
05.80	I(OVE-.5)5.9;T OVE" TON";S X=OVE;D 12.01;T" OF WHEAT HAD TO BE THROWN IN THE SEA BECAUSE"!"	WE RAN OUT OF STORAGE BINS"!
05.90	I(-TON) 2.1;T!!"ALL THE FOOD IS USED UP 	!!!"

08.01	X FCHR(127),FCHR(127),FCHR(127)

09.01	X FOCAL(2,2);TYPE %2
09.10	T!!"O KING! ALL THE PEOPLE HAVE DIED OF STARVATION!"!!!;QUIT
09.90	T!!!!;X FCHR(31);T"WELL DONE HAMURABI!"!;QUIT

11.02	S X=X*2^(-36);IF(-X)11.04,11.99;S X=X+1
11.04	F XC=1,6;X FCHR(32+FITR(X*64));S X=X*64-FITR(X*64)
11.99	RETURN

12.01	IF FABS(X-1) 11.99,11.99;T"S"
12.10	IF FABS(X-1) 11.99,12.11;T"ERE"
12.11	T"AS"
12.20	IF FABS(STA-1) 11.99,12.21;T" PEOPLE"
12.21	T" PERSON"
12.30	IF FABS(BIR-1) 11.99,12.31;T"IES WERE"
12.31	T"Y WAS"
TYPE "THIS PROGRAM IS INTENDED ONLY FOR VT05 TERMINAL!"!!
TYPE "TYPE 'GO' TO COMMENCE"!
%%%EWXSPEED.FCL

ERASE ALL,
C - ACCURACY TEST.
01.01	C- ACCURACY OF INTERNAL NUMBERS ...
01.02	X FOCAL(1,1),FOCAL(2,2);S INI=GETTAB(4,-1),X=1,DX=1
01.03	S M=N,DX=DX/2,Y=X+DX;D 30;IF (N-1000) 1.03
01.04	TYPE %2,M," BITS ACCURACY FOR INTERNAL NUMBERS."!
01.05	S Y=1.0000001,M=7;D 30;IF(1000-N)1.25
01.06	S Y=1.00000001,M=8;D 30;IF(1000-N)1.25
01.07	S Y=1.000000001,M=9;D 30;IF(1000-N)1.25
01.08	S Y=1.0000000001,M=10;D 30;I(1000-N)1.25
01.09	S Y=1.00000000001,M=11;D 30;I(1000-N)1.25
01.10	S Y=1.000000000001,M=12;D 30;I(1000-N)1.25
01.11	S Y=1.0000000000001,M=13;D 30;I(1000-N)1.25
01.12	S Y=1.00000000000001,M=14;D 30;I(1000-N)1.25
01.13	S Y=1.000000000000001,M=15;D 30;I(1000-N)1.25
01.14	S Y=1.0000000000000001,M=17;D 30;I(1000-N)1.25
01.15	S Y=1.000000000000000001,M=18;D 30;I(1000-N)1.25
01.16	S Y=1.0000000000000000001,M=19;D 30;I(1000-N)1.25
01.17	S Y=1.00000000000000000001,M=20;D 30;I(1000-N)1.25
01.18	S Y=1.000000000000000000001,M=21;D 30;I(1000-N)1.25
01.19	S Y=1.0000000000000000000001,M=22;D 30;I(1000-N)1.25
01.20	S Y=1.00000000000000000000001,M=23;D 30;I(1000-N)1.25
01.21	S Y=1.000000000000000000000001,M=24;D 30;I(1000-N)1.25
01.22	S Y=1.0000000000000000000000001,M=25;D 30;I(1000-N)1.25
01.23	S Y=1.00000000000000000000000001,M=26;D 30;I(1000-N)1.25
01.24	TYPE!"?ERROR IN NUMERIC INPUT ROUTINE"!;RETURN
01.25	TYPE%2,M," SIGNIFICANT DIGITS DISCERNED ON INPUT."!
01.40	T %9.03;C TYPE IN MILLISECONDS TO NEAREST MICRO-SECOND.
01.45	S JIF=50;IF FITR(FITR(2^6+GETTAB(9,15)/2^29)/2)-FITR(2^6+GETTAB(9,15)/2^29)/2 1.5;S JIF=60
01.50	T!"FOLLOWING FIGURES ARE BASED ON A"%2,JIF," CYCLE CLOCK:"!
01.80	G 3.01;COMMENCE EXECUTION.
01.90	C GROUP 2 IS A SCRATCH AREA.

03.01	OPERATE OUTPUT DSK:FOCAL.TMP;F X=2.01,.01,2.99;T%3.02,X,"C"!;C MAKE TEMPORARY FILE
03.02	OPERATE OUTPUT TTY:;L C FOCAL.TMP;T%5.03;C SET UP GROUP 2 FULL OF COMMENTS
03.03	31.02 F X=1,999;C
03.04	D 31;S A=B
03.05	31.02 F X=1,999;                                                  C
03.06	D 31;S SPT=B
03.07	31.02 F X=1,999;C12345678901234567890123456789012345678901234567890
03.08	D 31;S INT=B
03.09	31.02 F X=1,999;D 2.01
03.10	D 31;S DOT=B
03.11	2.01 G 2.02
03.12	D 31;S GOT=B
03.14	31.02 F X=1,999;D 2.99
03.16	D 31; S DPT=B
03.22	31.02 F X=1,999;S Y=0
03.23	D 31;S SET=B
03.24	31.02	F X=1,999;X
03.25	D 31;S XET=B
03.26	31.02 F X=1,999;X .
03.28	D 31;S DP=B
03.32	31.02 F X=1,999;X 0
03.34	D 31;S ZER=B
03.36	31.02 F X=1,999;X .0
03.38	D 31;S DRP=B
03.40	31.02 F X=1,999;X E
03.42	D 31;S DEX=B
03.44	31.02 F X=1,999;X +0
03.46	D 31;S SGN=B
03.50	31.02 F X=1,999;X 1+1
03.52	D 31;S OPA=B
03.54	31.02 F X=1,999;X 1-1
03.56	D 31;S OPS=B
03.58	31.02 F X=1,999;X 1*1
03.60	D 31;S OPM=B
03.62	31.02 F X=1,999;X 1/1
03.64	D 31;S OPD=B
03.66	31.02 F X=1,999;X 1^0
03.68	D 31;S OPE=B
03.70	31.02 F X=1,999;X 1^8
03.72	D 31;S OPF=B
03.74	31.02 F X=1,999;X ()
03.76	D 31;S OPB=B
03.78	31.02	F X=1,999;X FSIN(2)
03.80	D 31;S OFS=B
03.82	31.02	F X=1,999;X FEXP(2)
03.84	D 31;S OFE=B
03.86	31.02	F X=1,999;X FLOG(2)
03.88	D 31;S OFL=B
03.90	31.02	F X=1,999;X FRAN(0)
03.92	D 31;S OFR=B
03.94	31.02	F X=1,999;X FATN(2)
03.96	D 31;S OFA=B

10.01	C TYPE-OUT SECTION.
10.02	T!!!"FEATURE				TIME (MILLISEC)		NOTES."!
10.04	T!"TO INTERPRET 1 SPACE		",(SPT-A)/999/50
10.06	T!"TO INTERPRET 1 CHARACTER	",(INT-A)/999/50
10.08	T!"TO SCAN FOR A LINE NUMBER	",(DPT-DOT)/999/98,"	PER LINE SCANNED OVER"
10.10	T!"TO EXECUTE A "'DO"'		",(DOT-A)/999,"	INCL. # INTERPRETATION"
10.12	T!"TO EXECUTE A "'GO TO"'		",(GOT-DOT)/999,"	INCL. # INTERPRETATION"
10.14	T!"TO EXECUTE A "'SET"'		",(SET-A)/999,"	INCLUDES DATA STORAGE"
10.16	T!"NUMERIC INPUT..."!"	DECIMAL POINT		",(DP-XET)/999
10.18	T!"	DIGITS LEFT OF POINT	",(ZER-XET)/999,"	PER DIGIT"
10.20	T!"	DIGITS RIGHT OF POINT	",(DRP-DP)/999,"	PER DIGIT"
10.22	T!"	EXPONENT		",(DEX-XET)/999,"	PLUS TIME FOR INTEGER"
10.24	T!"	SIGN (+ OR -)		",(SGN-ZER)/999
10.26	T!"OPERATION +			",(OPA-SGN+ZER-XET)/999,"	PLUS INTERPRETATION"
10.28	T!"OPERATION -			",(OPS-SGN+ZER-XET)/999,"	PLUS INTERPRETATION"
10.30	T!"OPERATION *			",(OPM-SGN+ZER-XET)/999,"	PLUS INTERPRETATION"
10.32	T!"OPERATION /			",(OPD-SGN+ZER-XET)/999,"	PLUS INTERPRETATION"
10.34	T!"OPERATION ^			",(OPE-SGN+ZER-DP)/999,"	IF FRACTIONAL POWER"
10.36	T!"		PLUS		",(OPF-OPE)/999/4,"	PER POWER-OF-2 IN EXPONENT"
10.38	T!"OPERATION ()			",(OPB-XET)/999,"	*"
10.40	T!"OPERATION FSIN(2)		",(OFS-XET)/999,"	*"
10.42	T!"OPERATION FEXP(2)		",(OFE-XET)/999,"	*"
10.44	T!"OPERATION FLOG(2)		",(OFL-XET)/999,"	*"
10.46	T!"OPERATION FRAN(0)		",(OFR-XET)/999,"	*"
10.48	T!"OPERATION FATN(2)		",(OFA-XET)/999,"	*"
10.98	T!!"*	INCLUDING TIME TO INTERPRET THE CHARACTERS"
10.99	T!!"TIME FOR THIS TEST PROGRAM	",%3,(GETTAB(4,-1)-INI)/JIF,"	SECONDS."!

29.99	T!!!!;E 2;LIBRARY DELETE FOCAL.TMP;QUIT

30.10	C- SUBROUTINE TO MEASURE DIFFERENCE BETWEEN X AND Y.
30.11	C- N IS THE NUMBER OF BITS REQUIRED TO SEPARATE X FROM Y.
30.20	SET N=100000;IF (-FABS(X-Y)) 30.3;RETURN
30.30	SET N=1-FLOG(FABS(2*(X-Y)/(X+Y)))/FLOG(2);RETURN

31.01	S B=GETTAB(4,-1)
31.02	F X=1,999;S Y=+0
31.03	S B=(GETTAB(4,-1)-B)*1000/JIF;R
TYPE !"FOCAL SPEED TRIALS. TO COMMENCE, TYPE 'GO'."!
C - END OF XSPEED
%%%EWXRESEQ.FCL

ERASE ALL,
C-FOCAL	v5D(315)-1	2019	18-Sep-75

01.01	C PROGRAM TO RE-SEQUENCE A FOCAL PROGRAM.
01.02	10.01
01.03	11.01
01.04	12.01
01.05	13.01
01.06	14.01
01.07	15.01
01.08	16.01
01.09	17.01
01.10	X FOCAL(1,1),FOCAL(2,2)
01.20	A!"NAME OF FOCAL PROGRAM TO RESEQUENCE:"I$
01.25	O O RS.TMP;T I$;O O TTY:;O I RS.TMP
01.30	S I$="",CNT=6,FLAG=0
01.40	S C=FCHR(-1);I(C-46)1.7,1.6;I(C-48)*(C-57)*(C-65)*(C-90)*(C-97)*(122-C)1.2
01.50	I CNT 1.4;S CNT=CNT-1,I$=I$+FCHR$(C);G 1.4
01.60	I FLAG 1.2;S CNT=4,FLAG=-1;G 1.5;C HERE IF EXTENSION SPECIFIED
01.70	I FLAG 1.8;S I$=I$+".FCL";C HERE IF NO EXTENSION SPECIFIED
01.80	O I TTY:
01.90	COLLECT ALL OLD LINE NUMBERS IN ARRAY A(N), N=1,FLN
01.95	O O RS.TMP;T"L S RS.TMP;E,A;L C "I$";E;S X=(2^36+FOCAL(97))/2^18,X=(X-FITR(X))*2^18,FLN=0"!"99.98	S X=X+1;I FOCAL(X)99.99,99.98;S FLN=FLN+1,T=FITR(FOCAL(X)/2^18)/2^7,A(FLN)=100*FITR(T)+128*(T-FITR(T));G 99.98"!"99.99	R"!"D 99.98;E A;L S RS1.TMP;L C RS.TMP;L C RS1.TMP;L D RS1.TMP"!;O O TTY:
01.99	L C RS.TMP

02.10	A"SELECT THE PORTION TO BE RE-SEQUENCED:"!"1.  THE WHOLE PROGRAM."!"2.  ONE GROUP."!"3.  A RANGE OF LINES."!":"J
02.11	I J-1 2.1,2.12;I J-2 2.1,2.5;I J-3 2.1,2.6,2.1
02.12	S L=A(1)/100,LO=1.01,U=A(FLN)/100;T!"THERE ARE"%4,FLN-2" LINES IN THE PROGRAM"!
02.20	A"DO YOU WANT TO PRESERVE THE PROGRAM IN A GROUP STRUCTURE? (YES OR NO)"J;I J-0NO 2.2,2.3;I J-0YES 2.2,2.4,2.2
02.30	T"WARNING: REFERENCES TO GROUPS WILL NOT BE CHANGED."!
02.31	A"WHAT STEP INTERVAL BETWEEN LINE NUMBERS? "S
02.32	S S=FITR(S*100+.5)/100;I S-.01 4.21;I 99*.99-FLN*S 4.21,4.21
02.33	G 2.8
02.40	D 2.31;S S=FITR(S*100+.5)/100,X=101;I S-.01 4.21;F J=1,FLN;D 2.45
02.41	I S,4.21,4.4
02.45	I FITR(A(J)/100)-FITR(X/100),2.46;S X=FITR(A(J)/100)*100+1;G 2.45
02.46	S B(A(J))=X/100,X=X+100*S;I FITR(A(J)/100)-FITR(X/100)2.47
02.47	S X=X-100*S+.01;I FITR(A(J)/100)-FITR(X/100+.5)2.48
02.48	S S=0,J=FLN+1;CAUSE PREMATURE EXIT AND ERROR MESSAGE.
02.50	T"WHAT GROUP NUMBER? :";A L;S U=FITR(L+.5)+.99
02.51	A"ENTER NEW GROUP NUMBER AND STEP SIZE: "LO,S
02.52	I-(LO-FITR(LO))^2 2.51;I LO-1 2.51;I 99-LO 2.51;I S-.01 2.51;I .98-S 2.51;I(L-LO)^2,2.53;S B(L*100)=LO;F J=1,FLN;I(A(J)-LO*100)^2 ,2.59
02.53	I LO 2.1;S LO=LO+.01
02.54	F J=1,FLN;I(FITR(A(J)/100)-L)^2,2.58
02.55	I S,4.21,4.4
02.57	S J=FLN,S=0
02.58	S B(A(J))=LO,LO=LO+S;I FITR(LO-S)-FITR(LO)2.57
02.59	S J=FLN,LO=-1;T!"THERE ARE ALREADY LINES IN THAT GROUP.  SUGGEST OPTION 3."!
02.60	A"ENTER THE NUMBERS OF THE FIRST AND LAST LINES OF THE RANGE: ",L,U;G 2.7
02.70	A"RANGE THESE ARE TO BECOME"!"[LOWEST,INTERVAL]"!LO,S
02.80	I 100-LO 2.7;I S-.01 2.7;I 1-LO 2.9;S LO=1.01
02.90	C

04.01	CHECK THAT RESEQUENCING IS POSSIBLE; MAKE RESEQUENCING MATRIX.
04.10	S K=0;F J=1,FLN;I(A(J)-L*100)*(U*100-A(J))4.3;S B(A(J))=LO+S*K,K=K+1;I FITR(B(A(J)))-B(A(J))4.3;S B(A(J))=B(A(J))+.01;I .015-S 4.3;S K=K+1
04.11	S E$=""
04.13	F J=1,FLN;I(A(J)-L*100)*(A(J)-U*100)4.3,4.3;I(A(J)-LO*100)*(LO*100+(K-1)*100*S-A(J))4.3;S E$=FCHR$(13)+FCHR$(10)+"%OVERLAP WILL OCCUR";I FITR((A(J)-LO*100)/S)-(A(J)-LO*100)/S 4.3;S E$="";T!"%OVERWRITING WILL OCCUR AT LINE"%4.02,A(J)/100" ..."!;S J=FLN
04.14	T E$!
04.20	I LO+K*S-100 4.4
04.21	T!"RE-SEQUENCING IS NOT POSSIBLE WITH THAT INCREMENT"!;G 2.1
04.30	R
04.40	C

05.01	C DO THE RESEQUENCING
05.02	O O RS.TMP;T"O I "I$"/4;O O RS.TMP/5";O O TTY:;L C RS.TMP;L D RS.TMP
05.10	S C0=0,C=0;D 10;C IS THE CURRENT CHARACTER JUST READ FROM THE INPUT FILE; C0 HAS BEEN PROCESSED BUT NOT YET WRITTEN TO THE OUTPUT FILE.
05.90	O I TTY:/4;O O TTY:/5;CLOSE OUTPUT FILE.
05.92	O O RS1.TMP;T"E,A;L C RS.TMP;L D RS1.TMP;L D RS.TMP;T!";X FCHR(34);T"THE RESEQUENCED FILE IS NOW IN CORE.	PLEASE SAVE IT.";X FCHR(34);T"!;Q"!;O O TTY:
05.94	L C RS1.TMP

10.01	C PROGRAM TRANSLATOR
10.02	COME HERE WITH CHARACTER IN C READY TO PROCESS
10.03	CHARACTER IN C0 READY TO WRITE TO THE OUTPUT FILE.
10.04	C - THIS ROUTINE PROCESSES A LINE AT A TIME TILL EOF THEN EXITS.
10.10	I C 10.9;D 11
10.15	C - WE OUGHT TO EXIT GROUP 11 WITH C CONTAINING A LINE FEED.   BEST CHECK THIS HOWEVER...
10.20	D 15;I(C0-10)^2,10.1;I-C0 10.2,10.2
10.90	R

11.01	C LINE TRANSLATOR
11.10	S Z=0,CH(-1)=C0,CH(0)=C
11.20	D 12;I C 11.9;I-(C-10)^2 11.2
11.90	R

12.01	C COMMAND TRANSLATOR
12.02	I(C-48)*(57-C)12.03;D 14;R
12.03	I-C 12.04,12.04;R
12.04	I-((C-10)*(C-13)*(C-59))^2 12.05;D 15;R
12.05	I 32-C 12.06;D 15;G 12.02
12.06	S X=C
12.07	D 15;I(C-47)*(C-58)*(C-64)*(C-91)*(C-96)*(C-123)12.07
12.08	I 32-C 12.09;D 15;I-C 12.08,12.08;R
12.09	I(X-96)*(123-X)12.1;S X=X-32
12.10	I (X-65)*(X-70)*(X-79)*(X-81)*(X-82)*(X-83)*(X-84)*(X-88) 12.11,12.40,12.11	;ASK FOR OPERATE QUIT RETURN SET TYPE XECUTE
12.11	I X-67 12.12,12.55,12.12	;COMMENT
12.12	I (X-68)*(X-69)*(X-77)*(X-87) 12.13,12.46,12.13	;DO;ERASE;MODIFY;WRITE
12.13	I X-71 12.16,12.75,12.16	;GO
12.16	I X-73 12.17,12.45,12.17	;IF
12.17	I X-76 12.18,12.50,12.18	;LIBRA
12.18	T/0!"%ILLEGAL COMMAND IN LINE BEGINNING..."!
12.19	F J=0,Z;X FCHR(CH(J))
12.20	T!/5;G 12.55
12.40	D 13;I C 12.9;I ((C-59)*(C-13)*(C-10))^2,12.9;I ((C-34)*(C-40))^2*(C-48)*(C-57)*(C-65)*(C-90)*(C-97)*(C-122)12.42,12.42;D 15;G 12.4
12.42	D 13;G 12.4
12.45	D 13
12.46	D 14;I-(C-44)^2 12.4;D 15;G 12.46
12.50	I(C-83)*(C-115)12.4,12.51,12.4;C - CONVERT ONLY LIBRA SAVE.
12.51	D 15;I(C-47)*(C-58)*(C-64)*(C-91)*(C-96)*(C-123)12.51
12.52	D 13;I-(C-58)^2 12.46;D 15;G 12.52
12.55	I C 12.99;I(C-10)^2,12.99;D 15;G 12.55
12.75	I FABS((C-84)*(C-116)),12.76;D 14;G 12.55
12.76	D 13,14;G 12.55
12.80	D 15;G 12.02
12.90	I-(C-59)^2 12.99;D 15
12.99	R

13.01	C EXPRESSION SKIPPER
13.02	I C-34 13.1,13.03,13.1
13.03	D 18;G 13.02
13.10	I C-40 13.2,13.11,13.2
13.11	D 17;G 13.5
13.20	I((C-46)*(C-36))^2*(C-48)*(C-57)*(C-65)*(C-90)*(C-97)*(C-122)13.21,13.21,13.4
13.21	D 15;G 13.2;COME TO THIS LINE TO FIND THE END OF ALPHANUMERIC/ALPHANUM$.
13.40	I C-40 13.5,13.11,13.5
13.50	I (C-45)*(C-43)*(C-42)*(C-47)13.9,13.51,13.9
13.51	D 15;G 13.02
13.90	R

14.01	C NUMBER TRANSLATOR
14.10	I C-58 14.2;D 13;R
14.20	I (C-59)*(C-10)*(C-13) 14.3,14.9
14.30	I 32-C 14.4;D 15;G 14.1
14.40	I 47-C 14.5;D 13;R
14.50	S J=0,NP=10,NPI=1,ZZ=Z-1
14.60	S NPI=NPI*10/NP,J=J*NP+(C-48)/NPI;D 16;I(C-46)^2,14.7;I(C-47)*(58-C)14.8,14.8,14.6
14.70	I NP-5 14.8;S NP=1,NPI=.1,C=48;G 14.6
14.80	S J=FITR(J*100+.5);I B(J),14.89;I((CH(ZZ)-32)*(CH(ZZ)-9))^2,14.81;X FCHR(CH(ZZ))
14.81	S C0=0;T%4.02,B(J);R
14.89	S C0=0;F J=ZZ,Z-1;X FCHR(CH(J))
14.90	R

15.01	CHARACTER PUTTER AND GETTER
15.10	X FCHR(C0);S C0=C,C=FCHR(-1),Z=Z+1,CH(Z)=C

16.01	CHARACTER GETTER WITH NO PUTTER.
16.20	S C0=C,C=FCHR(-1),Z=Z+1,CH(Z)=C

17.01	C - IF YOUR CURRENT CHARACTER IS LEFT PARENS (40), DO 17.
17.02	C - THIS GROUP WILL SKIP ALL THE CONTENTS INCLUDING THE ).
17.03	C - ON EXIT, C WILL CONTAIN THE CHARACTER TO RIGHT OF THE ).
17.10	S NP=0
17.20	D 15
17.25	I C 17.99;I C-13 17.2,17.99;I C-34 17.2,17.4;I C-40 17.2,17.5;I 41-C 17.2;S NP=NP-1;I-NP 17.2;D 15;G 17.99
17.40	D 18;G 17.25;COME TO THIS LINE IF " ENCOUNTERED.
17.50	S NP=NP+1;G 17.2;COME TO THIS LINE IF NESTED ().
17.99	R

18.01	C - IF YOUR CURRENT CHARACTER IS DOUBLE QUOTE (34), DO 18.
18.02	C - THIS GROUP WILL SKIP ALL THE CONTENTS INCL THE CLOSING ".
18.03	C - ON EXIT, C WILL CONTAIN THE CHAR TO RIGHT OF CLOSING ".
18.04	D 15;I 34-C 18.04,18.05;I 10-C 18.04,18.9,18.04
18.05	D 15
18.90	R
TYPE!!"BEWARE!	THIS PROGRAM IS PRETTY SLOW."!"IT RESEQUENCES ABOUT 50 LINES PER MINUTE OF CPU TIME."!

%%%EWXSYSTA.FCL
ERASE ALL,
C-FOCAL	v5D(315)-1	1527	2-Aug-75

09.01	C - SYSTAT
09.02	D 9.95;T!"Status of ";F I=0,4;S X=GETTAB(9,I);D 9.98
09.03	T" at";S X=GETTAB(9,8);D 9.97;T" on";S X=GETTAB(9,9);D 9.96;T!
09.04	S X=FITR((GETTAB(9,15)+2^35)/256)/2;I X-FITR(X),9.05;T!"No operator on duty"!
09.05	T"Uptime";S X=GETTAB(10,13);D 9.97;T","100*GETTAB(4,0)/GETTAB(10,13)"%Null time ="100*(GETTAB(4,0)-GETTAB(10,18))/GETTAB(10,13)"%Idle +"100*GETTAB(10,18)/GETTAB(10,13)"%Lost"!
09.06	S X=0;F J=1,GETTAB(10,16);S Z=FITR((GETTAB(0,J)+2^35)/2^32)/2,X=X+2*(Z-FITR(Z))
09.07	T%2,X" Jobs in use out of"SJN".  "GETTAB(9,44)" logged in, out of"GETTAB(9,40)".  (LOGMAX)"!
09.08	T!"Job     Who       User       What   Size(P) State Run Time"!!
09.09	F JOB=1,SJN;S X=FITR(GETTAB(0,JOB)/2^32+8)/2;I X-FITR(X),9.99;T%2,JOB;S X=GETTAB(2,JOB);D 9.93;T"	";S X=GETTAB(25,JOB);D 9.94;S X=GETTAB(26,JOB);D 9.94;T" ";S X=GETTAB(3,JOB);D 9.94;S X=GETTAB(7,JOB)/2^17,X=X-FITR(X),X=X*512,Z=GETTAB(1,JOB)/2^27;D 9.90;S X=JOB;D 9.87;S X=GETTAB(4,JOB);D 9.97;T!
09.80	Q
09.86	T%3,Z"+"%2,GETTAB(1,2^18*(GETTAB(12,JOB)/2^18-FITR(GETTAB(12,JOB)/2^18)))/2^27
09.87	S X=GETTAB(34,FITR(X))/2^18;I-X 9.87;S X=1+FITR(-X),Z=(1+GETTAB(21,FITR(X/3))/2^36)*2^(12*(X-3*FITR(X/3))),Z=64*(Z-FITR(Z));X FCHR(32),FCHR(32+FITR(Z)),FCHR(32+FITR(64*(Z-FITR(Z)))),FCHR(32);S Z=FITR(GETTAB(0,JOB)/2^28+2^8),Z=FSGN(FITR(Z-2*FITR(Z/2))-1);X FCHR(57.5+25.5*Z),FCHR(16*(1-Z)+.5*(1+Z)*(70+17*FITR(1+GETTAB(7,JOB)/2^35+.5)))
09.88	T%3,Z"    ";R
09.89	T%3,Z"+SPY";R
09.90	I GETTAB(12,JOB)9.89,9.88;I FABS(FITR(GETTAB(0,JOB)/2^29)-FITR(GETTAB(0,JOB)/2^29+.5)),9.86;S Z=GETTAB(12,JOB)/2^18,Z=Z-FITR(Z),Z=GETTAB(7,Z*2^18)/2^17,Z=(Z-FITR(Z))*256;T%3,X/2"+"%2,Z
09.91	S X=X/2^36;X FCHR(40+FITR(8*(X-FITR(X)))-8*FSGN(-FITR(8*X)));S X=X*8;X FCHR(40+FITR(8*(X-FITR(X)))-8*FSGN(-FITR(8*X)));S X=X*8;X FCHR(40+FITR(8*(X-FITR(X)))-8*FSGN(-FITR(8*X)));S X=X*8;X FCHR(40+FITR(8*(X-FITR(X)))-8*FSGN(-FITR(8*X)));S X=X*8;X FCHR(40+FITR(8*(X-FITR(X)))-8*FSGN(-FITR(8*X)));S X=X*8;X FCHR(40+FITR(8*(X-FITR(X)))-8*FSGN(-FITR(8*X)));T",";S X=X*8,X=X-FITR(X);F J=1,6;X FCHR(88+FITR(8*(X-FITR(X)))+40*(FSGN(-FITR(8*X))));S X=X*8
09.92	T"    [OPR]";R
09.93	I X-2-2^18,9.92;I-FABS(X-GETTAB(2,-1))9.91;T"   [SELF]"
09.94	S Z=X/2^36+1;F J=1,6;S Z=(Z-FITR(Z))*64;X FCHR(Z+31.5)
09.95	S SJN=(GETTAB(9,13)+2^35)/2^18,SJN=(SJN-FITR(SJN))*2^18-1,JIF=50,DAT$(1)="Jan",DAT$(2)="Feb",DAT$(3)="Mar",DAT$(4)="Apr",DAT$(5)="May",DAT$(6)="Jun",DAT$(7)="Jul",DAT$(8)="Aug",DAT$(9)="Sep",DAT$(10)="Oct",DAT$(11)="Nov",DAT$(12)="Dec";X FOCAL(2,2)
09.96	S Z=FITR(X/31);T%2,X-31*FITR(Z)+1,"-",DAT$(Z-12*FITR(Z/12)+1),"-";S Z=FITR(Z/12);X FCHR(48+FITR(Z/10)+6),FCHR(48+Z-10*FITR(Z/10)+4)
09.97	S Z=FITR(.5+X/JIF);X FCHR(40+FITR(Z/360000)+8*FSGN(FITR(Z/360000)-1)),FCHR(40+FITR(Z/36000-10*FITR(Z/360000))+8*FSGN(FITR(Z/36000)-1)),FCHR(40+FITR(Z/3600-10*FITR(Z/36000))+8*FSGN(FITR(Z/3600)-1)),FCHR(45+13*FSGN(FITR(Z/3600)-1)),FCHR(40+FITR(Z/600-6*FITR(Z/3600))+8*FSGN(FITR(Z/600)-1)),FCHR(40+FITR(Z/60-10*FITR(Z/600))+8*FSGN(FITR(Z/60)-1)),FCHR(45+13*FSGN(FITR(Z/60)-1)),FCHR(40+FITR(Z/10-6*FITR(Z/60))+8*FSGN(FITR(Z/10)-1)),FCHR(48+Z-10*FITR(Z/10))
09.98	S Z=X/2^36+1;F J=1,5;S Z=(Z-FITR(Z))*128;X FCHR(Z+127.5)
09.99	R