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 [email protected]/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