/ FOCAL, 1969 FOR P?S/8 / LAST EDIT: 04-FEB-1987 20:00:00 CJL / MUST BE ASSEMBLED WITH '/J' SWITCH SET. / FOCAL, 1969 MODIFIED FOR USE WITH THE P?S/8 MONITOR SYSTEM. / ASSEMBLY INSTRUCTIONS: / ASSEMBLE THIS FILE (FOCPQS), AS A BINARY FILE. / ASSEMBLE FOCAL, 1969 AS A BINARY FILE (FOCL69). / BINARY LOAD FOCL69, FOCPQS. / SAVE AS A P?S/8 SYSTEM PROGRAM 00000-07577, FOLLOWED BY 10000-10377. THE / P?S/8 FOCAL SYSTEM TO BE LOADED IS THE FIELD ZERO COMPONENT. THE FIELD / ONE COMPONENT WILL BE USED FOR OVERLAYS TO 07400-07577 AS NECESSARY. / THIS ASSEMBLY IS A MASSIVE PATCH TO FOCAL.ZZM (DEC-08-AJAE-PB BINARY) TO / CREATE A P?S/8 INTERFACE TO FOCAL. VARIOUS NEW FEATURES ARE IMPLEMENTED / AS A RESULT, AND OLD FEATURES MAY WORK DIFFERENTLY, OR ACHIEVE A NEW / UTILITY UNREALIZABLE WITH PAPER-TAPE. / MUCH ATTEMPT HAS BEEN MADE TO MAXIMIZE COMPATIBILITY WITH THE ORIGINAL / PAPER-TAPE VERSION, AS MANY PEOPLE HAVE MADE CUSTOM CHANGES TO THE / ORIGINAL VERSION; MOST OF THESE CHANGES ARE DIRECTLY APPLICABLE TO P?S/8 / FOCAL, AND MANY ARE ACTUALLY IMPLEMENTED HERE. / P?S/8 FOCAL SWITCHES. / /A RETAIN ARCTANGENT, LOGARITHM, AND EXPONENTIAL FUNCTIONS. THERE IS / NO RESTRICTION ON THIS SWITCH REGARDING USE OF /C, EVEN THOUGH / THE ORIGINAL PAPER-TAPE VERSION WOULDN'T ALLOW THIS COMBINATION / OF BUILT-IN FUNCTIONS. / /C RETAIN COSINE, SINE FUNCTIONS. SEE /A. / /E TYPE "=" CHARACTER ON EVALUATED OUTPUT. THIS SWITCH IS PROVIDED / FOR HISTORICAL COMPATIBILITY WITH THE PAPER-TAPE VERSION ONLY. / THE DEFAULT IS TO ALLOW THE USER TOTAL CONTROL OF OUTPUT FORMATTING, / INSTEAD OF FORCING A SOMETIMES UGLY OUTPUT TO BE IMPOSED. / /F INHIBIT LEADING BLANK ON POSITIVE NUMERICAL OUTPUT. THIS CAUSES / COLUMNS OF MIXED-SIGN OUTPUT TO NOT LINE UP, BUT ALLOWS THE USER / TO CONTROL THE PRECISE NATURE OF NUMERICAL OUTPUT, ESPECIALLY / FOR UNSIGNED DATA. / /G EXECUTE "GO" COMMAND AT END OF FILE. DEFAULT IS TO JUST RETURN / CONTROL OF FOCAL INPUT TO THE CONSOLE WITHOUT STARTING. N. B. / THE USER CAN INSERT "GO" COMMANDS INTO THE INPUT STREAM AT ANY / POINT TO INITIATE FOCAL EXECUTION WHICH COULD THEN READ DATA / FURTHER DOWN THE INPUT STREAM. THE PURPOSE OF THIS SWITCH IS TO / AUTO-START THE USER'S FOCAL PROGRAM WITH FURTHER INPUT FROM THE / CONSOLE. / /I INITIAL INPUT ECHOING DURING ASCII FILE TRANSFERS. THE DEFAULT / IS TO INPUT WITHOUT PRINTING DURING THE FILE TRANSFER. THE ECHO / IS RESTORED WHEN END OF FILE IS REACHED. / /L RESTORE HISTORICAL OCTAL PRINTOUT OF LOCATIONS WHICH INDICATE / STORAGE UTILIZATION WITHIN FOCAL. THE USER CAN GAUGE MEMORY / REQUIREMENTS SOMEWHAT WITH THIS OPTION. DEFAULT IS THE STANDARD / (CURRENTLY UNIMPLEMENTED) "LIBRARY" COMMAND. N. B. NEITHER OPTION / IS AVAILABLE DURING INPUT FILE OPERATIONS. ATTEMPTS TO USE EITHER / "L" COMMAND WILL EXIT TO P?S/8. / /N INHIBIT "ASK" INPUT PROMPT. / /P USE PERIOD (".") AS THE USER PROMPT CHARACTER. THE DEFAULT IS / ASTERISK ("*"). / /Q CHANGE ASK INPUT PROMPT CHARACTER TO "?". USE OF /N NULLIFIES / THIS OPTION. / /S ECHO INPUT PROMPT CHARACTER DURING ASCII FILE TRANSFER. THE / DEFAULT IS TO INPUT WITHOUT PROMPTING DURING THE FILE TRANSFER. / THE PROMPT OUTPUT IS RESTORED WHEN END OF FILE IS REACHED. / /T DON'T CONVERT TO . THE DEFAULT IS TO CONVERT ANY / CHARACTERS IN PASSED ASCII FILES TO AS THE FILE IS / READ. N. B., FOCAL HANDLES AS A SINGLE CHARACTER; IF THE / USER DIRECTS OUTPUT TO A DEVICE INCAPABLE OF DEALING WITH A "BARE" / CHARACTER, THE OUTPUT COULD GARBLE OR DEPEND ON PRIOR / INITIALIZATION OF THE DEVICE BY THE USER OUTSIDE OF THE SCOPE OF / P?S/8 FOCAL. / KEY P?S/8 FOCAL FEATURES. / P?S/8 FOCAL SUPPORTS UP TO 17 FILES PASSED TO IT BY P?S/8 (THIS IS THE / LIMIT IMPOSED BY P?S/8, NOT FOCAL). AS FILES ARE PROCESSED, THEY ARE / FIRST ASSUMED TO BE BINARY FILES INTENDED TO BE CUSTOM OVERLAYS TO P?S/8 / FOCAL. ANY FILE PROVING TO BE ASCII AND NOT BINARY ENDS THE BINARY MODE / AND INITIATES THE ASCII FILE MODE. IN ASCII MODE, FILE CONTENTS ARE USED / TO SATISFY ALL INPUT REQUIREMENTS OF FOCAL, REGARDLESS OF PURPOSE (PROGRAM / LINES, INPUT DATA TO RUNNING PROGRAMS, ETC.). AT THE END OF THE LAST FILE, / THE TERMINAL MODE TAKES OVER. FOR MOST PURPOSES THIS MODE IS SIMILAR TO / THE PAPER-TAPE USAGE OF THE ORIGINAL FOCAL, 1969. / FOR BINARY MODIFICATION OF P?S/8 FOCAL, THE USER IS REFERRED TO DECUS / FOCAL-17: "FOCAL:HOW TO WRITE NEW SUBROUTINES AND USE INTERNAL ROUTINES". / THE MAIN RESTRICTIONS ARE: / 1) DON'T INTERFERE WITH THE CHANGES OR PATCHES TO FOCAL, / ESPECIALLY IF THEY ARE TRANSIENT IN NATURE; MANY ITEMS / NORMALLY FOUND IN FOCAL ARE SOMETIMES TEMPORARALLY MODIFIED / TO EXPLOIT SOME OPTION SUCH AS DESTROYING A SUBROUTINE / CALL TO "PRINTC" TO SUPRESS ECHOING DURING ASCII FILE / TRANSFER MODE, ETC. MOST RESTRICTIONS OF THIS NATURE ARE / STRAIGHTFORWARD, AND PROBABLY WOULDN'T BE CHANGED ANYWAY. / IF IN DOUBT, COMPARE THE ORIGINAL AND PATCH, THEN CONTACT / A MEMBER OF THE P?S FOR A FINAL DECISION. / 2) THE BINARY LOADER HAS A BUFFER WITHIN FOCAL'S TEXT BUFFER / WHICH MUST REMAIN UNTOUCHED; THAT BUFFER IS LOCATED AT THE / FIRST COMPLETE PAGE (03400), SO ANY FOCAL PATCH MADE BY A / USER FOR SUBROUTINE ADDITION WOULD ALLOW LESS THAN 400 / CHARACTERS IN FOCAL'S TEXT BUFFER IF PLACED IN THIS AREA / ACCORDING TO THE NORMAL RULES OF FOCAL MODIFYING, I. E. / 04617, 05177, OR 05377 (OR NEW ATN PACKAGE VALUE 05017) / ON DOWN AS NECESSARY TO PLACE THE PATCH'S CODE. THIS IS / NOT EXPECTED TO BE A PROBLEM; IF YOU WRITE SUCH A LARGE / SEGMENT IN MACHINE LANGUAGE, DON'T USE FOCAL! / 3) PAGE 36 (07400-07577) IS A TRANSIENT AREA FOR THE SYSTEM / INTERFACE. DO NOT USE THIS AREA FOR ANY PURPOSE! / 4) CREATE A SAVE AREA FOR ANYTHING MODIFIED BY THE PATCH AND / PUT IT BACK THE WAY YOU FOUND IT WHEN THROUGH; VERIFY THAT / ANY ROUTINE CALLED DURING THE TIME YOUR PATCH IS INSTALLED / DOES NOT DEPEND ON THE OLD CONTENTS OF THE AREA YOU / MODIFIED! / 5) THE SQUARE ROOT FUNCTION HAS BEEN RECODED AND RELOCATED / TO THE FORMER START OF THE TEXT BUFFER REMOVING 33 / LOCATIONS FROM FOCAL'S TEXT BUFFER, HOWEVER THE SQUARE / ROOT IS NOW MORE ACCURATE, AND THE SYSTEM INTERFACE IS OF / REASONABLE SIZE. MANY OF THE RESTRICTIONS OF THE EARLIER / "R-L FOCAL" HAVE BEEN REMOVED, SUCH AS USE OF EXTENDED / FUNCTIONS OR THEIR CORE SPACE IF THEY ARE UNWANTED. A NEW / CLASS OF LIBRARY FUNCTIONS CAN NOW BE ADDED SHOULD THEY / EVER GET CODED; THIS IS NOW FEASIBLE. THE SYSTEM NOW ALLOWS / FREE FORM BATCH FOCAL PROGRAMS ("GO" IS ALLOWED FROM A / USER FILE WITH NO RESTRICTIONS). THE USE OF BATCH FILE / PROGRAMMING ALLOWS EFFECTIVELY LARGER FOCAL PROGRAMS TO / BE EXECUTED, AS THIS ALLOWS MORE EFFICIENT USE OF VALUABLE / FOCAL BUFFER SPACE; THE LOSS OF 33 LOCATIONS IS MORE THAN / OFFSET BY THESE ADVANTAGES. A STUDY DONE ON MULTIPLE / HISTOGRAM PRINTING PROGRAMS INDICATES THAT 4K P?S/8 FOCAL / CAN EXECUTE PROGRAMS OF THIS TYPE THAT THE 8K PAPER-TAPE / VERSION CANNOT! / 6) EXCEPT WHERE RESTRICTED BY P?S/8 ITSELF, BINARY FILES CAN / BE LOADED INTO ANY AVAILABLE EXTENDED MEMORY FOR ANY / USER-DEFINED PURPOSE; THIS COULD REPRESENT A BETTER USE / OF EXTENDED MEMORY THAN THE STRAIGHT 8K VERSION OF FOCAL. / ASSUMING ENOUGH MEMORY, BOTH METHODS ARE AVAILABLE TO THE / USER. / IN PASSING FILES TO FOCAL THE FOLLOWING POINTS SHOULD BE NOTED: / 1) FOCAL IGNORES PASSED OUTPUT FILES. USING OUTPUT FILES / SERVES ONLY TO WASTE FILE LIST POSITIONS. / 2) PASS ALL BINARY FILES BEFORE ALL SOURCE FILES. / 3) PUT ALL DATA RESPONSES IN THEIR LOGICAL PLACE AFTER / EXECUTION OF AN "ASK" STATEMENT. / 4) TURN ECHO ON WITH /I AND /S TO CHECK RESPONSES WHEN / DEBUGGING ASCII PROGRAMS. / 5) DON'T USE LIBRARY COMMANDS IN BATCH MODE; ALL "L" COMMANDS / EXIT TO P?S/8 DURING FILE TRANSFERS. THE OCTAL PRINTOUT / OPTION (/L) IS ALSO INHIBITED AT THIS TIME. / 6) USE BATCH MODE FREELY, AS MUCH MEMORY IS SAVED BY PASSING / DISPOSABLE ONCE-ONLY CODE WITHOUT FOCAL LINE NUMBERS, OR / READ-ONLY DATA IN THE FORM OF ASCII NUMERICAL INPUT / INSTEAD OF STORED ARRAYS. THESE TECHNIQUES LEND THEMSELVES / TO BATCH OPERATIONS (SUCH AS REREADING NUMERICAL DATA IN / STATISTICAL PROGRAMS, OR GRAPHIC PLOT LABELING, ETC.). / 7) REMEMBER THAT FOCAL READS COMMANDS AS VALID DATA NUMBERS / AND VALID DATA NUMBERS AS LINE NUMBERS, BOTH LEGAL AND / ILLEGAL; THIS CAN BE QUITE CONFUSING, SO ECHO THE INPUT / IF YOU HAVE TO DEBUG ANY MIXED INPUT. / 8) IF FOCAL LOOPS WITH NO "ASK"-ING BUT THE FILES ARE NOT / DEPLETED (USER ERROR), THE USER MUST FORCE AN EXIT TO / P?S/8 WITH THE STANDARD BREAK CHARACTERS (<^C>, ETC.). / A TRIVIAL (THOUGH VIABLE) EXAMPLE OF HOW TO USE ALL OF THE ABOVE IDEAS / ON PATCHING FOR CUSTOM DIALOGUES, BINARY FILES, SOURCE AND DATA FILES, / AND BATCH PROCESSING IS SHOWN BELOW: / THIS PROGRAM PROCESSES A NUMERIC DATA FILE PREVIOUSLY CREATED BY ANOTHER / PROGRAM. (ANY PROGRAM WHICH PRINTS ON THE CONSOLE IS ELEGIBLE TO BE / MODIFIED TO DO THIS. A ONE PAGE ROUTINE TO DO THIS IS AVAILABLE AS A / REPLACEMENT FOR A TERMINAL OUTPUT ROUTINE (6-BIT OR 8-BIT) WHICH CREATES / P?S/8 FILES IN MEMORY AND WRITES THEM ON THE SYSTEM DEVICE.) / THE FOLLOWING DRAMATIZATION OF A P?S/8 WORKING SESSION ILLUSTRATES A / PROGRAM WHICH COMPARES DATA NUMBERS TO A PARTICULAR SETTING ON THE / CONSOLE SWITCHES. / .FETCH SRC1 SOURCE OF THE ASSEMBLY PATCH / .LIST / 100 *1345 /OVERLAY THE FADC FUNCTION / 110 LAS /READ CONSOLE SWITCHS / 120 JMP .+4 /FINISH UP AS OLD ADC DID / .PAL BIN1 /DON'T USE AA01A D-A CONVERTER IFNDEF AF01 /DON'T USE AF01 A-D CONVERTER IFNDEF AX08 /DON'T USE AX08 CONVERTERS IFNDEF DF32 /DON'T USE DF32 INTERRUPT HANDLING IFNDEF LAB8E /USE LAB-8/E CONVERTERS IFNDEF LINC8 /DON'T GENERATE LINC-8 INTERRUPT HANDLER IFNDEF TTY /BASE DEVICE CODE OF TTY: / I/O AND PERIPHERAL DEFINITIONS. ACMX= 6371 /LOAD MULTIPLEX REGISTER FOR AX08 ADCV= 6364 /INITIATE CONVERSION FOR AX08 ADLM= 6531 /LOAD CHANNEL FOR AD-8/E, A ADRB= 6533 /READ A-D BUFFER, CLEAR FLAG FOR AD-8/E, A ADSK= 6534 /SKIP ON A-D DONE FLAG FOR AD-8/E, A ADST= 6532 /START CONVERSION FOR AD-8/E, A AFADRB= 6534 /READ A-D BUFFER, CLEAR FLAG FOR AF01 ADSC= 6542 /LOAD CHANNEL FOR AF01 ADSF= 6531 /SKIP ON A-D DONE FLAG FOR AF01 DAL1= 6551 /LOAD X D-A CONVERTER FOR AA01A DAL2= 6552 /LOAD Y D-A CONVERTER FOR AA01A DILX= 6053 /LOAD X REGISTER FOR VC-8/E DILY= 6054 /LOAD Y REGISTER FOR VC-8/E DIS= 6304 /INTENSIFY POINT FOR AX08 DXC= 6301 /CLEAR X REGISTER FOR AX08 DXL= 6302 /LOAD X REGISTER FOR AX08 DYC= 6311 /CLEAR Y REGISTER FOR AX08 DYL= 6312 /LOAD Y REGISTER FOR AX08 KCCIOT= TTY^10+6002 /CLEAR KEYBOARD FLAG KRBIOT= TTY^10+6006 /READ KEYBOARD BUFFER, CLEAR FLAG KRSIOT= TTY^10+6004 /READ KEYBOARD BUFFER KSFIOT= TTY^10+6001 /SKIP ON KEYBOARD FLAG RADC= 6362 /READ A-D, CLEAR FLAG FOR AX08 SKAD= 6332 /SKIP ON A-D DONE FLAG FOR AX08 TCFIOT= TTY+1^10+6002 /CLEAR TTY: FLAG TLSIOT= TTY+1^10+6006 /CLEAR TTY: FLAG, OUTPUT CHARACTER TSFIOT= TTY+1^10+6001 /SKIP ON TTY: DONE FLAG / NUMERIC LOAD DEFINITIONS. NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 NL0100= CLA IAC BSW /LOAD AC WITH 0100 NL2000= CLA CLL CML RTR /LOAD AC WITH 2000 NL3777= CLA CLL CMA RAR /LOAD AC WITH 3777 NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 NL7775= CLA CLL CMA RTL /LOAD AC WITH 7775 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 NL7777= CLA CMA /LOAD AC WITH 7777 / EQUATED SYMBOLS FROM FOCAL, 1969. ARCALG= 4732 /ARCTANGENT ROUTINE ARCRTN= 5024 /ARCTANGENT ADDRESS ARTN= 5000 /ARCTANGENT ADDRESS AXOUT= 0017 /TEXT POINTING XR BOTTOM= 0035 /END OF PUSHDOWN AREA BUFR= 0060 /POINTER TO NEXT FREE LOCATION IN TEXT BUFFER CCR= 0077 /CONSTANT 0215 CFRS= 0133 /POINTER TO DUMMY LINE CHAR= 0066 /FOCAL'S CHARACTER BUFFER CHIN= 2155 /READ A CHARACTER ROUTINE COL= 1255 /ASK ":" LOCATION COMBOT= 0226 /PDL PROTECTION POINTER COMBUF= 0132 /START OF COMMAND BUFFER STORED HERE COMEIN= 3140 /COMMAND INPUT BUFFER COMGO= 1163 /COMMAND DISPATCH TABLE ADDRESS CON1= 5037 /POINTER TO CONSTANT ONE CSTAR= 0225 /ACKNOWLEDGE CHARACTER C100= 0006 /CONSTANT 0100 C200= 0123 /CONSTANT 0200 C260= 0113 /CONSTANT 0260 C9= 5332 /SINE CONSTANT DEBGSW= 0026 /DEBUG SWITCH DDTJR= 0004 /DDT JUMP RETURN DECON= 5627 /DECIMAL CONVERSION ROUTINE DECONV= 5600 /DECIMAL CONVERSION ROUTINE ADDRESS DIV1= 5754 /FLOATING POINT DIVISION ROUTINE DPCVPT= 6302 /POINTER TO DECONV IN FLOATING INPUT ROUTINE DPN= 6305 /POINTER TO DNUMBR IN FLOATING INPUT ROUTINE DSAVE= 5640 /DECIMAL CONVERSION ROUTINE ADDRESS DTST= 5647 /DECIMAL CONVERSION ROUTINE ADDRESS EFUN3I= 0136 /FUNCTION RETURN END= 0134 /FIRST VARIABLE LOCATION IN 8K VERSION ENDFI= 6243 /FLOATING OUTPUT LOCATION ENDT= 0135 /END OF TEXT POINTER ERROR2= JMS I 0166 /ERROR TRAP ERROR3= JMS I 0166 /ERROR TRAP ERROR5= 2725 /ERROR FUNCTION EVAL= 1613 /EXPRESSION EVALUATOR EXIT1= 5034 /EXIT POINTER IN ARCTANGENT ROUTINE EXTR= 2313 /EXTRA CHARACTER UNPACK ADDRESS FCONT= 1101 /FOR ROUTINE LOCATION FCOS= 5200 /COSINE/SINE ROUTINE FEXP= 4620 /EXPONENTIAL FUNCTION FIGO1= 6221 /FLOATING INPUT ADDRESS FINKP= 1133 /FOR ROUTINE LOCATION FLAC= 0044 /FLOATING AC FLINTP= 6200 /FLOATING INPUT ROUTINE FLOUTP= 6000 /FLOATING OUTPUT ROUTINE FLTONE= 2405 /FLOATING CONSTANT ONE FNEG= 5163 /FLOATING NEGATE ROUTINE FOR FEXP, ETC. FNTABF= 0374 /FUNCTION ADDRESS TABLE FNTABL= 2165 /FUNCTION NAME TABLE FOUTPUT=0130 /POINTER TO FLOATING OUTPUT ROUTINE GEND= 2334 /GET ONE HALFWORD ADDRESS GETC= JMS I 0145 /GET A CHARACTER GETSGN= TAD FLAC+1 /GET SIGN OF FLOATING AC GET1= 2330 /GET ONE HALFWORD ROUTINE GET3= 2345 /GET ONE HALFWORD ADDRESS GINC= 0070 /VARIABLE ENTRY LENGTH WORD GO= 5021 /ARCTANGENT ADDRESS GONE= 0232 /COMMAND PROCESSOR ADDRESS GTEM= 0021 /TEMPORARY FOR GET1 ROUTINE HINBUF= 0037 /HIGH-SPEED READER INPUT BUFFER INBUF= 0034 /CHARACTER INPUT BUFFER INDEV= 0064 /INPUT ROUTINE POINTER INTEGER=0053 /FIXING ROUTINE FOR FLAC INPUT= 0756 /INPUT ROUTINE IOBUF= 3120 /I/O BUFFER FOR TERMINAL OUTPUT I33= 2414 /NO-INTERRUPT INPUT ROUTINE ADDRESS K5= 5525 /CONSTANT 0005 WITHIN FLOATING POINT PACKAGE LASTV= 0031 /ADDRESS OF LAST VARIABLE LINENO= 0067 /LINE NUMBER MCR= 0116 /CONSTANT 7563 MINE= 5662 /-"E CONSTANT ADDRESS MINSKI= 0051 /FLOATING NEGATE POINTER MINUSE= 6301 /-"E CONSTANT ADDRESS MINUSZ= 5663 /-"Z CONSTANT ADDRESS MPLUS= 5664 /-"+ CONSTANT ADDRESS MSPACE= 5665 /-" CONSTANT ADDRESS M11= 0121 /CONSTANT 7767 M140= 2556 /CONSTANT 7640 M2= 0111 /CONSTANT 7776 M20= 0105 /CONSTANT 7760 M240= 0114 /CONSTANT 7540 M5= 0120 /CONSTANT 7773 M77= 0103 /CONSTANT 7701 ONE= 4716 /FLOATING CONSTANT ONE IN ATN, ETC. PACKAGE OUTDEV= 0063 /OUTPUT ROUTINE POINTER PACKC= JMS I 0146 /PACK A CHARACTER PACX= 2530 /PACKING ROUTINE ADDRESS PER= 0102 /CONSTANT 0256 PI2= 5036 /POINTER TO PIOT POPJ= JMP I 0141 /POP JUMP PRINTC= JMS I 0151 /PRINT A CHARACTER PRNT= 2442 /TWO-DIGIT PRINT ROUTINE PRNTLN= JMS I 0153 /PRINT LINE NUMBER PTCH= 0126 /INPUT ROUTINE POINTER RESET LOCATION PT1= 0030 /TEMPORARY FOR TDUMP ROUTINE, ETC. P13= 0005 /CONSTANT 0013 P17= 0107 /CONSTANT 0017 P177= 0106 /CONSTANT 0177 P277= 0110 /CONSTANT 0277 P337= 0075 /CONSTANT 0337 P4000= 0124 /FORMER CONSTANT 4000 P43= 6310 /CONSTANT 0043 P7600= 0104 /CONSTANT 7600 P77= 0122 /CONSTANT 0077 P7700= 0101 /CONSTANT 7700 RECOVR= 2740 /RECOVERY ADDRESS RECOVX= 2761 /RECOVERY ADDRESS RETURN= JMP I EFUN3I /RETURN FROM A FUNCTION RTL6= JMS I 0157 /ROTATE AC 6 LEFT RUB1= 3004 /RUBOUT ADDRESS SADR= 6150 /FLOATING OUTPUT BUFFER POINTER SIGN= 7124 /SIGN ROUTINE SRNLST= 1363 /MODIFY CONTROL CHARACTER LIST START= 0177 /FOCAL'S INTERNAL STARTING ADDRESS STARTL= 5064 /LOG ADDRESS STARTV= 0060 /START OF VARIABLES (IN 4K) TASK= 1204 /TYPE/ASK ADDRESS TASK4= 1253 /TYPE/ASK ADDRESS TCRLF2= 1246 /TYPE/ASK ADDRESS TDUMP= 3052 /SYMBOL TABLE TYPEOUT ROUTINE TELSW= 0016 /TERMINAL I/O IN PROGRESS SWITCH TEM= 5156 /POINTER TO ATN TEMPORARY TEXTP= 0017 /TEXT POINTER TGO= 5400 /FLOATING OUTPUT ROUTINE T1= 0032 /TEMPORARY FOR L COMMAND T3= 0033 /TEMPORARY XADC= 1343 /FADC FUNCTION ADDRESS XCT= 0020 /GET HALF-WORD SWITCH XDYS= 1142 /FDIS FUNCTION ADDRESS XINPUT= 5666 /FLOATING POINT INPUT POINTER XSQ2= 4676 /POINTER TO XSQR X1= 5035 /POINTER TO X X2= 4675 /POINTER TO X ZERO= 6520 /INTERPRETIVE POWER ADDRESS / EQUATED SYMBOLS FROM P?S/8. CONINT= 0000 /CONSOLE INTERRUPT LOCATION INCON= 0031 /CONSOLE INPUT ROUTINE INTLST= 0003 /INTERRUPT LIST POINTER IN CONSOLE OVERLAY OUTCON= 0033 /CONSOLE OUTPUT ROUTINE SBLOCK= 7635 /LOAD BLOCK IN SYSTEM LOADER SBOOT= 7600 /SYSTEM BOOTSTRAP ADDRESS SCRSIZE=7611 /SYSTEM CORE SIZE WORD SFILES= 7757 /FILE PARAMETERS START HERE SFUN= 7634 /SYSTEM LOADER FUNCTION WORD SOUTFLS=7607 /OUTPUT FILE COUNT SWAL= 7604 /PASSED SWITCHES: A-L SWMX= 7605 /PASSED SWITCHES: M-X SWY9= 7606 /PASSED SWITCHES: Y, Z, 0-9 SYSIO= 7640 /SYSTEM I/O ROUTINES ENTRY POINT WRITE= 4000 /SYSIO WRITE FUNCTION BIT / FLOATING POINT OPERATIONS. FIXMRI FADD= 1000 /FLOATING ADD FIXMRI FDIV= 3000 /FLOATING DIVIDE FENTER= JMS I 0007 /FLOATING ENTER FEXIT= 0000 /FLOATING EXIT FIXMRI FGET= 0000 /FLOATING GET FIXMRI FMUL= 4000 /FLOATING MULTIPLY FIXMRI FPUT= 6000 /FLOATING PUT FIXMRI FSUB= 2000 /FLOATING SUBTRACT / MISCELLANEOUS SYMBOLS. ANDC= AND . /CURRENT PAGE AND BONCE= 3600 /OVERLAY ONCE-ONLY ADDRESS (ASSUMED) BUFFA= 7400 /TRANSIENT AREA AND BUFFER JMPC= JMP . /CURRENT PAGE JUMP JMSC= JMS . /CURRENT PAGE JMS JMSIZ= JMS I 0 /PAGE ZERO JMS INDIRECT JMSSYSI=SYSIO&177+JMSC /CALL TO SYSIO FROM ITS PAGE NBUFFER=2564 /NEW BUFFER FOR FLOATING OUTPUT, ETC. REVISIO="D&77 /REVISION OF FOCPQS VERSION=12 /VERSION OF FOCPQS / PATCHES TO FOCAL, 1969. *DDTJR-4 /OVER INTERRUPT LOCATIONS PCSAVE, .-. /INTERRUPT PC SAVED HERE JMP I PINTHND/[INTHND]/GOTO INTERRUPT HANDLER PINTHND,INTHND /POINTER TO INTERRUPT HANDLER PIOBUF, IOBUF /POINTER TO I/O OUTPUT BUFFER DDTJR, .-. /AVAILABLE LOCATION / INITIALIZE IN-PROGRESS SWITCH. *TELSW /RIGHT OVER THE SWITCH 0 /IDLE INITIALLY / NEW TEXT POINTER VALUE. *AXOUT /TEXT POINTING XR TEXTP, NFRSTX /WE ATE SOME LOCATIONS UP / NEW VARIABLE POINTER VALUE. *LASTV /POINTS TO LAST VARIABLE NBUFBEG /WE ATE SOME LOCATIONS UP / SET INITIAL PUSHDOWN VALUE. *BOTTOM /LAST LOCATION AVAILABLE FEXP-1 /END OF FREE CORE IF FUNCTIONS RETAINED / AVAILABLE LOCATION BECAUSE HIGH-SPEED READER NO LONGER SUPPORTED. *HINBUF /OVER HIGH-SPEED READER INPUT BUFFER CSCQSW, 0 /<^S>/<^Q> SWITCH; 4000=<^S> RECEIVED / NEW TEXT POINTER VALUE. *BUFR /POINTS TO LAST LOCATION OF TEXT STARTV, NBUFBEG /WE ATE SOME LOCATIONS UP *OUTDEV /OVER EXISTING OUTPUT POINTER COUTPUT /POINT TO OUR OUTPUT ROUTINE / WE INITIALLY POINT THE INPUT ROUTINE AT THE BINARY LOADER. EVENTUALLY / THIS WILL BECOME GETCHR, AND THEN CINPUT, ITS NORMAL VALUE. *INDEV /INPUT POINTER HERE INDEV, BENTRY /BINARY LOADER ADDRESS / THE FOLLOWING LOCATION IS AVAILABLE BECAUSE WE DON'T NEED THE CONSTANT 4000. *P4000 /OVER FORMER CONSTANT AC, .-. /AC SAVED HERE DURING INTERRUPT / THE FOLLOWING LOCATION IS AVAILABLE BECAUSE THE CONTENTS OF "RDIV" WILL / NO LONGER CHANGE. *PTCH /OVER INPUT RESET LOCATION INCHAR, .-. /INPUT BUFFER / REDEFINED COMMAND BUFFER POINTER. *COMBUF /OVER COMMAND BUFFER POINTER COMBUF, NCOMEIN /POINT TO NEW COMMAND BUFFER / REDEFINED TEXT POINTERS DUE TO EATING UP A LITTLE SPACE. *CFRS /FIRST LINE POINTER CFRS, NFRST /POINT TO OUR NEW DUMMY LINE / REDEFINED 8K END POINTER. *END /OVER 8K END POINTER END, NCOMEIN /POINT TO ULTIMATELY UNUSED (4K) COMMAND BUFFER *ENDT /END OF TEXT POINTER NBUFBEG /POINT TO NEW BEGINNING OF BUFFER *167 /AT END OF PAGE ZERO P8K, ZBLOCK 5 /USED BY 8K OVERLAY ZBLOCK 2 /EMPTY SPACE *START-1 /OVER STARTUP ADDRESS RECOVR+1 /NO DIALOGUE USED *COMBOT /OVER PDL PROTECTION POINTER COMBOT, NCOMEOUT+12 /ACCOUNT FOR MOVED COMMAND BUFFER *GONE+13 /OVER REFERENCE TO P4000 NL4000 /TEST FOR SINGLE LINE / NEW FUNCTION ENTRIES. *FNTABF+13 /OVER OLD XSQRT XSQRT /NEW XSQRT *FNTABF+16 /OVER X FUNCTION ENTRY SBOOT /ADVANCED UCK FUNCTION / THE FOLLOWING LOCATIONS FORMERLY REFERENCED BUFFERS WITHIN THE OLD / SQUARE ROOT FUNCTION CODE. WE NOW USE ANOTHER AREA. *FCONT+13 /OVER "FOR" ROUTINE NITER1 /WAS ITER1 *FINKP /OVER "FOR" ROUTINE NITER1 /WAS ITER1 / FOCAL FDIS(X,Y) FUNCTION PATCHES. / CAN BE CUSTOMIZED FOR AA01A, AX08, OR LAB-8/E. IFNZRO AA01A < *XDYS+11 /WHERE Y LOAD GOES DAL2 /LOAD Y D-A CONVERTER *XDYS+14 /WHERE X LOAD GOES DAL1 /LOAD X CONVERTER > IFNZRO AX08 < *XDYS+11 /WHERE Y LOAD GOES DYC DYL /LOAD Y CONVERTER *XDYS+14 /WHERE X LOAD GOES DXC DXL DIS /LOAD X CONVERTER AND INTENSIFY > IFNZRO LAB8E < *XDYS+11 /WHERE Y LOAD GOES DILY /LOAD Y REGISTER *XDYS+14 /WHERE X LOAD GOES DILX /LOAD X CONVERTER > *COMGO+10 /OVER LIBRARY DISPATCH ADDRESS SBOOT /UCK *COMGO+16 /OVER HIGH-SPEED READER DISPATCH ADDRESS ERROR5 /NO HIGH-SPEED READER FUNCTION / TYPE/ASK CODE FIXUP. / VARIOUS VERSIONS OF FOCAL (FOCAL-12, FOCAL-8, ETC.) HAVE REDEFINED THE / PRECISE DEFINITION OF THE DEBUGGING MODE REGARDING FORMATTED INPUT / STATEMENTS (SUCH AS ASK "HELLO",VARIABLE). THIS REQUIRED REASSEMBLING / THE SOURCE OF FOCAL, AS THE PATCH WAS COMPREHENSIVE. BY REUSING THE / AVAILABLE SPACE, THE EQUIVALENT CAN BE IMPLEMENTED, BUT MAINTAINING A / HIGHER DEGREE OF COMPATIBILITY WITH THE ORIGINAL FOCAL, 1969. *TASK /OVER FORMER CODE NCOL, ": /**** /Q **** 0277 *TASK+12 /OVER EXISTING CODE TAD NCOL /GET NEW PROMPT CHARACTER / THE ONLY OUTPUT ROUTINE ATTEMPTS TO DELAY FOR THE BENEFIT OF TERMINALS / REQUIRING A CHARACTER TIME AFTER THE . VARIOUS FEEBLE ATTEMPTS AT THIS / HAVE PRODUCED VERSIONS OF FOCAL WHICH DON'T WORK ON CERTAIN TERMINALS. / MOST NOTABLY, FOCAL, 1969 OUTPUTS A CHARACTER, AND FOCAL-8 OUTPUTS / <^N> (EVIL TO VT05). BY CREATING A SUITABLE CONSTANT, A TRUE (0200) / CHARACTER WILL BE OUTPUT INSTEAD. *TCRLF2+2 /WHERE TO COUNTERACT TAD L7763/(-15) /MAKE IT 0200 INSTEAD *TASK4 /OVER EXISTING CODE TASK4, DCA DEBGSW /CLEAR SWITCH NOW GETC /GET NEXT CHARACTER COL, JMP TASK /KEEP GOING / ANALOGUE TO DIGITAL CONVERSION FIXUP. / AS SUPPLIED, FOCAL DOESN'T WORK ON CHANNEL 0 AS ON THE OTHERS, ALSO SOME / CONVERTERS MAY NOT WORK IF MERELY DEVICE CODES ARE CHANGED. THIS IS AN / ATTEMPT TO SOLVE THIS. ADJACENT SPACE IS USED FROM THE NO INTERRUPT OUTPUT / ROUTINE WHICH IS NOT NEEDED TO DEBUG THE FADC FUNCTION. IF DEBUGGING IS / DESIRED THEN PATCH THE NO INTERRUPT OUTPUT ROUTINE BACK IN AND HAVE FUN / (WILL INTERRUPT?). THIS PATCH CAN BE CONDITIONALLY ASSEMBLED FOR AF01, / AX08, OR AD-8/E, A CONVERTERS. CHANGE DEVICE CODES APPROPRIATELY FOR / OTHER CONVERTERS. *XADC /OVER A-D ROUTINE JMS I INTEGER /FIX THE FLAC IFNZRO AF01 < IOF /PREVENT INTERRUPT PROBLEMS ADSC /LOAD CHANNEL AND CONVERT CLA CLL /CLEAN UP NOW ADSF /FLAG UP? JMP .-1 /NO, WAIT FOR IT AFADRB /YES, READ IT IN > IFNZRO AX08 < NOP /AX08 WILL NOT INTERRUPT ACMX ADCV /LOAD CHANNEL AND START CONVERSION CLA CLL /CLEAN UP NOW SKAD /FLAG UP? JMP .-1 /NO, WAIT FOR IT RADC /YES, READ IT IN > IFNZRO LAB8E < NOP /AD-8/E, A WILL NOT INTERRUPT ADLM /LOAD CHANNEL ADST /START CONVERSION ADSK /FLAG UP? JMP .-1 /NO, WAIT FOR IT ADRB /YES, READ IT IN > DCA FLAC+1 /STORE HIGH-ORDER DCA FLAC+2 /CLEAR LOW-ORDER TAD P13/[13] /SET THE DCA FLAC /EXPONENT ION /OK IF ALREADY ON RETURN /GO BACK TO FOCAL FUNCTION CHECK / EMPTY SPACE AFTER A-D CONVERTER PATCH. ZBLOCK SRNLST-1-. /EMPTY SPACE L7763, -15 /CONSTANT 7763 *FNTABL+16 /OVER X FUNCTION ENTRY "U^2+"C^2+"K /ADVANCED UCK FUNCTION / REVAMPED GET1 ROUTINE; CAN EASILY BE MODIFIED FOR EXTENDED MEMORY. *GET1 /OVER EXISTING ROUTINE GET1, .-. /GET A HALF-WORD ROUTINE ISZ XCT /WHICH HALF? JMP GET3 /GET LEFT ONE FIRST TAD GTEM /GET THE PAIR GEND, AND P77/[77] /JUST SIX BITS DCA CHAR /SAVE IT TAD CHAR /GET IT BACK TAD M77/[-77] /COMPARE TO CASE CODE VALUE SNA /SKIP IF NOT CASE CODE JMP EXTR /JUMP IF CASE CODE TAD G37/(37) /ADJUST 0000-0077 TO 7740-0037 JMP I GET1 /RETURN G37, 37 /CONSTANT 0037 GET3, NL7777 /SET THE SWITCH DCA XCT /FOR NEXT TIME NOP /**** 8K **** CDF TXTFLD TAD I AXOUT /GET THE PAIR CDF 00 /BACK TO OUR FIELD DCA GTEM /SAVE IT TAD GTEM /GET IT BACK RTL6;RAL /MOVE UP JMP GEND /CONTINUE THERE *I33 /OVER NO-INTERRUPT INPUT ROUTINE / COMES HERE AFTER END OF FILE TO SWAP IN MORE CODE INTO 07400. ALSO COMES / HERE TO SWAP IN OPTIONAL LIBRARY HANDLER. ENDFIL, JMS I M140/(SYSIO) /GOTO NEXT PHASE (INITIALLY ENDFILE HANDLER) ENDADR, BUFFA /LOAD IT HERE ENDFUN, 1^100+.-. /UNIT BITS WILL BE FILLED IN SWAPBLK,.-. /BLOCK NUMBER WILL BE FILLED IN ISZ SWAPBLK /BUMP UP FOR NEXT USER OF THIS ROUTINE JMP I ENDADR/(BUFFA) /GO THERE ZBLOCK 3 /EMPTY SPACE *PACX /OVER CHARACTER PACKING ROUTINE CDF 00 /IN CASE EXTENDED MEMORY IN USE *NBUFFER /NEW BUFFER FOR FLOATING OUTPUT, ETC. NFPAC1, ZBLOCK 4 /TEMPORARY FOR XSQRT, ETC. NITER1, ZBLOCK 4 /BUFFER FOR "FOR" ROUTINE, ETC. ZBLOCK NBUFFER+13-. /GET TO END OF FLOATING OUTPUT BUFFER ZBLOCK 1 /EMPTY SPACE PAGE CINPUT, .-. /CONSOLE INPUT ROUTINE CINWAIT,TAD INBUF /GET INPUT BUFFER SPA SNA CLA /SKIP IF ANYTHING THERE JMP CINWAIT /ELSE WAIT FOR IT IOF /PREVENT PROBLEMS TAD INBUF /GET THE CHARACTER DCA COUTPUT /SAVE IT ION /PROTECT NEXT AND COME OUT DCA INBUF /CLEAR INPUT BUFFER TAD COUTPUT /GET OUT CHARACTER JMP I CINPUT /RETURN BUMPIT, .-. /POINTER BUMP ROUTINE TAD I BUMPIT /GET IN-LINE VALUE IAC /ADD ONE AND P17/[17] /JUST BUFFER BITS TAD PIOBUF/(IOBUF) /POINT AT BUFFER DCA I BUMPIT /STORE IN-LINE ISZ BUMPIT /BUMP PAST POINTER JMP I BUMPIT /RETURN OUTDO, TAD CINPUT /GET THE CHARACTER JMS I PTTYOUT/(TTYOUT)/PRINT IT NOW OUTZAP, DCA TELSW /**** CONSOLE AND NO OUTPUT INTERRUPTS **** 7600 OUTGO, ION /TURN INTERRUPT ON AGAIN JMP I COUTPUT /RETURN COUTPUT,.-. /CONSOLE OUTPUT ROUTINE PKEYHND,DCA CINPUT /SAVE PASSED CHARACTER ION /ENSURE INTERRUPT IS ON TAD I FILPTR /GET LATEST CHARACTER IN BUFFER TAD CSCQSW /OR IN <^S>/<^Q> FLAG SZA CLA /SKIP IF EMPTY POSITION JMP .-3 /ELSE WAIT FOR IT TO EMPTY IOF /PREVENT PROBLEMS TAD TELSW /GET IN-PROGRESS FLAG DFINT, SNA CLA /SKIP IF SET JMP OUTDO /JUMP IF NOT NL3777 /FORM MASK AND CINPUT /GET THE CHARACTER DCA I FILPTR /STORE IN THE BUFFER JMS BUMPIT /BUMP UP THE FILPTR, IOBUF /OUTPUT POINTER JMP OUTGO /CONTINUE THERE / INTERRUPT HANDLER STARTS HERE. INTHND, DCA AC /SAVE THE AC RAL /GET THE LINK DCA LINK /SAVE IT ALSO CHKINT, SKP /**** CONSOLE **** CIF MCS+10 JMS CONINT /CHECK OVERLAY INTERRUPTS FIRST DCA BUMPIT /SAVE CONSOLE INTERRUPT STATUS CHKKSF, KSFIOT /**** CONSOLE **** CIF MCS+10 CHKJMP, JMP TRYOUT /**** CONSOLE **** JMS INCON CHKKRS, KRSIOT/OR KRBIOT /**** CONSOLE **** JMP TRYOUT AND P177/[177] /JUST SEVEN-BIT DCA INCHAR /SAVE IT JMS I PKEYHND/(KEYHND)/CHECK KEYBOARD OUT THERE KEYBACK,TAD INBUF /GET CURRENT BUFFER SZA CLA /SKIP IF WE DIDN'T OVERRUN ERRZAP, NOP /**** END OF FILE **** ERROR2 TAD INCHAR /GET OUR CHARACTER TAD C200/[200] /MAKE IT EIGHT-BIT DCA INBUF /STORE IT FOR OTHERS TRYOUT, CLA /**** CONSOLE **** NL0002 TRYTSF, TSFIOT /**** CONSOLE **** AND BUMPIT TRYJMP, JMP INTXIT /**** CONSOLE **** SNA CLA TRYTCF, TCFIOT /**** CONSOLE **** JMP INTXIT DCA TELSW /CLEAR IN-PROGRESS FLAG TRYAGN, TAD I EMTPTR /GET A BUFFERED CHARACTER TAD CSCQSW /OR IN <^S>/<^Q> SWITCH SPA SNA /SKIP IF PRESENT AND ALLOWED JMP INTXIT /ELSE FORGET IT JMS I PTTYOUT/(TTYOUT)/OUTPUT THE CHARACTER DCA TELSW /SET IN-PROGRESS FLAG DCA I EMTPTR /CLEAR THE BUFFERED CHARACTER JMS BUMPIT /BUMP UP THE EMTPTR, IOBUF /EMPTYING POINTER INTXIT, CLA /CLEAN UP / CONDITIONAL INTERRUPT HOOKS. / IF NECESSARY, OTHER PERIPHERALS CAN BE INTERRUPT HANDLED HERE BY PATCHING / THE DF32 OR LINC8 INTERRUPT LOCATIONS. IFNZRO DF32 < JMS I DFINT/(7650) /CALL DF32 INTERRUPT HANDLER > IFZERO DF32 < NOP /AVAILABLE FOR HOOK IF NO DF32 > IFNZRO LINC8 < TAD LIST6+1/[7] /GET CLEAR VALUE ICON /CLEAR LINC INTERRUPTS CLA /CLEAN UP > IFZERO LINC8 < NOP /AVAILABLE NOP /FOR INTERRUPT NOP /HOOKUP > TAD LINK /GET THE SAVED LINK CLL RAR /RESTORE IT TAD AC /GET THE SAVED AC RMF /RESTORE THE EXTENDED FIELDS ION /TURN INTERRUPT ON JMP I 0 /RETURN TO BACKGROUND PTTYOUT,TTYOUT /POINTER TO TTY: OUTPUT ROUTINE / PATCHES TO RECOVERY ROUTINE. *RECOVR+2 /OVER EXISTING CODE CONPAT, ISZ TELSW /**** CONSOLE AND NO OUTPUT INTERRUPTS **** 7600 *RECOVR+6 /OVER POINTER REFERENCE TAD PIOBUF/(IOBUF) /USE OUR POINTER *RECOVR+10 /OVER FORMER NOP CDF 00 /IN CASE EXTENDED MEMORY IN USE *RECOVR+15 /OVER POINTER REFERENCE TAD PIOBUF/(IOBUF) /USE OUR POINTER DCA EMTPTR /RESET EMPTY POINTER TAD PIOBUF/(IOBUF) /USE OUR POINTER DCA FILPTR /RESET FILL POINTER *RECOVX /OVER RECOVERY OUTPUT LINK, .-. /WILL BE 0000 OR 0001 (SAVED LINK BIT) JMS I PTTYOUT/(TTYOUT)/SEND IT TAD P277/["?] /GET A "?" / PATCH TO ELIMINATE REFERENCES TO PTCH. *RECOVX+10 /OVER RECOVERY CODE JMP NOLINE /DON'T PRINT LINE NUMBER DCA LINENO /SAVE VALUE TAD P7700/[7700] /GET PRINTC /PRINT IT PRINTC /PRINT PRNTLN /PRINT THE LINE NUMBER NOLINE, TAD CCR/["M&37!200] /GET A PRINTC /PRINT , JMP START /RESTART PNFPAC1,NFPAC1 /POINTER TO NEW TEMPORARY ZBLOCK 1 /EMPTY SPACE / REVISED SYMBOL TYPEOUT ROUTINE. / THIS CODE IS NO LONGER THAN THE ORIGINAL CLUMSY CODE WHICH REQUIRES / EXTENDED MEMORY CONSIDERATIONS FOR FIELD ZERO DATA! *TDUMP /OVER EXISTING CODE TDUMP, TAD STARTV /**** 8K **** TAD END TDMPLP, DCA PT1 /STASH NEW POINTER TAD LASTV /GET LAST VARIABLE POINTER CIA /INVERT FOR TEST TAD PT1 /COMPARE TO CURRENT POINTER PR50, SNA CLA /SKIP IF MORE TO DO POPJ /ELSE RETURN TAD I PT1 /GET VARIABLE NAME RTL6;RAL /WANT HIGH-ORDER FIRST JMS PTRIM /PRINT IT TAD I PT1 /GET LOW-ORDER JMS PTRIM /PRINT IT TAD PR50/("(&77) /GET A "(" JMS PTRIM /PRINT IT ISZ PT1 /BUMP TO SUBSCRIPT TAD I PT1 /GET THE SUBSCRIPT JMS I NPRNT2/(PRNT) /PRINT IT TAD PR51/(")&77) /GET A ")" JMS PTRIM /PRINT IT ISZ PT1 /BUMP TO VALUE FENTER /ENTER FPP FGET I PT1 /GET THE VALUE FEXIT /LEAVE FPP JMS I FOUTPUT/[FLOUTP]/PRINT THE VALUE TAD CCR/["M&37!200] /GET A PR51, PRINTC /PRINT IT AND TAD GINC /GET INCREMENT TAD M2/[-2] /ADJUST TO ENTRY INCREMENT TAD PT1 /ADD ONTO CURRENT POINTER JMP TDMPLP /KEEP GOING PTRIM, .-. /TRIM AND PRINT ROUTINE TAD RUB1+1/(7640) /INVERT IT AND P77/[77] /ISOLATE SIX-BIT TAD RUB1+1/(7640) /MAKE IT EIGHT-BIT PRINTC /PRINT IT JMP I PTRIM /RETURN NPRNT2, PRNT /POINTER TO TWO-DIGIT PRINT ROUTINE / NEWLY CONCOCTED SQUARE ROOT FUNCTION. *COMEIN /OVER FORMER INPUT BUFFER XSQRT, FENTER /\ FPUT I PNFPAC1/(NFPAC1) / >STORE FLAC INITIALLY FEXIT // GETSGN /DO ONLY POSITIVE SQUARE ROOTS SPA CLA /BARF ON MINUS ERROR3 /NEW SQUARE ROOT ERROR MESSAGE FROM HERE CLA CLL IAC /NL0001 TAD FLAC /START APPROXIMATION SPA SNA /SIGNED AT THAT! CML /FOR MINUS RAR /DIVIDE BY TWO DCA FLAC /PUT IT BACK TAD M11/[-11] /ELSE SETUP DCA I ERROR3-JMSIZ /ITERATION COUNTER CLCU, TAD FLAC+1 /CHECK FOR SNA /ZERO TAD FLAC+2 /ARGUMENT SNA CLA /WHICH HAS SQUARE ROOT=0 JMP SQUEND /AND WE'RE DONE FENTER /\ FPUT I (NITER1) / \ FGET I PNFPAC1/(NFPAC1) / \PERFORM NEWTON-RAPHSON FDIV I (NITER1) / /ITERATION ONE TIME FADD I (NITER1) / / FEXIT // NL7777 /PEEL TAD FLAC /EXPONENT SQUEND, DCA FLAC /DOWN ISZ I ERROR3-JMSIZ /DONE YET? JMP CLCU /NOT YET RETURN /GO BACK WITH GOOD VALUE PAGE / KEYBOARD INPUT ROUTINE. IFNZRO .-CINPUT&177 KEYHND, KEYBACK /KEYBOARD HANDLING ROUTINE; MUST BE PRELOADED! NL7775 /-3 TAD INCHAR /COMPARE TO LATEST SNA /SKIP IF OTHER ISZ I PSCRSIZE/(SCRSIZE) /ELSE INDICATE SO SPA SNA CLA /SKIP IF <^D> OR GREATER JMP I P7600/[SBOOT] /ELSE LEAVE FOR P?S/8 CHKKCC, KCCIOT/OR 0000 /**** CONSOLE **** 0000 TAD INCHAR /GET THE CHARACTER TAD M20/[-"P!300] /IS IT <^P>? SNA /SKIP IF NOT JMP I RECADDRESS /JUMP IF SO TAD M1/(-"Q+"P) /IS IT <^Q>? SNA /SKIP IF NOT JMP GOTQ /JUMP IF SO TAD M2/[-"S+"Q] /IS IT <^S>? SZA CLA /SKIP IF SO JMP I KEYHND /ELSE RETURN GOTS, NL4000 /SET HOLD VALUE GOTQ, DCA CSCQSW /STORE EITHER WAY TAD TELSW /GET IN-PROGRESS SWITCH SNA CLA /SKIP IF SET JMP I PTRYAGN/(TRYAGN) /ELSE TRY TO INFLUENCE OUTPUT JMP I PTRYOUT/(TRYOUT) /FORGET THIS INTERRUPT M1, -1 /CONSTANT 7777 PSCRSIZ,SCRSIZE /POINTER TO SCRSIZE PTRYAGN,TRYAGN /POINTER TO TRYAGN PTRYOUT,TRYOUT /POINTER TO TRYOUT RECADDR,TRYOUT /**** END OF FILE **** RECOVR / NEW 4K INPUT BUFFER. NCOMEIN,ZBLOCK 50 /INPUT BUFFER HERE IF 4K VERSION NCOMEOU=. /END OF COMMAND BUFFER / NEW DUMMY LINE. NFRST, 0000 /POINTER TO END OF LIST 0000 /00.00 LINE NUMBER TEXT "C " /C "P^100+"?-240 /P? TEXT "S/8 FOCAL " /MORE TEXT VERSION%12+2660 /V VERSION%12^66+VERSION+"0^100+REVISION / NFRSTX= .-1 /NEW INITIAL POINTER VALUE "M&37!7700 / NBUFBEG,0000 /PAD CORE PAGE / FOCAL SYSTEM OFFICIALLY STARTS HERE FOR ALIGNMENT PURPOSES. IFNZRO .&177 FOCAL= . /FOCAL SYSTEM STARTS HERE FOCAL, 37/NOP /HERE IN CASE CHAINED TO TAD I (SWMX) /GET /M-/X SWITCHES AND (400) /JUST /P SNA CLA /SKIP IF SET JMP INITNXT /JUMP IF NOT TAD PER/[".] /GET NEW PROMPT DCA I (CSTAR) /STASH IT INITNXT,TAD (SFILES-1) /GET POINTER TO FIRST FILE TAD I (SOUTFLS) /UPDATE TO FIRST INPUT FILE-1 DCA I (BFLPTR) /SETUP THE BINARY LOADER'S POINTER TAD I (SFUN) /GET OUR LOADING UNIT AND (7) /JUST UNIT BITS TAD C100/[1^100] /MAKE INTO ONE PAGE READ DCA I (ENDFUN) /STORE INTO SWAP ROUTINE TAD I (SBLOCK) /GET OUR LOADING BLOCK TAD FOCAL/(37) /ADD ON OFFSET TO OVERLAY BLOCK DCA I (SWAPBLK) /STORE IN OVERLAY HANDLER TESTEYE,TAD I (SWAL) /GET SWITCHES /A-/L AND (10) /JUST /I BIT SZA CLA /SKIP IF OFF JMP TESTES /JUMP IF ON TAD (ION) /GET ZAP VALUE DCA I (CHIN+6) /LEAVE ECHO OFF UNTIL FLIPPED BACK TESTES, TAD I (SWMX) /GET SWITCHES /M-/X RTL6 /MOVE /S BIT TO HIGH-ORDER SPA CLA /SKIP IF OFF JMP TESTEE /JUMP IF ON TAD P7600/[CLA!400] /GET ZAP VALUE DCA I (START+12) /PREVENT STAR PRINTOUT TESTEE, TAD I (SWAL) /GET SWITCHES /A-/L AND C200/[200] /JUST /E BIT SNA CLA /SKIP IF SET JMP TESTQUE /JUMP IF OFF TAD (PRINTC) /GET ZAP VALUE DCA I (FLOUTP+2) /MAKE IT PRINT "=" TESTQUE,TAD I (SWMX) /GET SWITCHES /M-/X AND C200/[200] /JUST /Q BIT SNA CLA /SKIP IF SET JMP TESTEN /JUMP IF OFF TAD P277/["?] /GET "?" DCA I (NCOL) /USE INSTEAD OF ":" TESTEN, NL2000 /SET /N MASK AND I (SWMX) /JUST /N BIT SNA CLA /SKIP IF SET JMP TESTEF /JUMP IF NOT TAD P7600/[CLA!400] /GET ZAP VALUE DCA I (TASK+13) /MAKE IT NOT PRINT ":" TESTEF, TAD I (SWAL) /GET SWITCHES /A-/L RTL6 /F BIT TO LINK SNL CLA /SKIP IF SET JMP TESTTEA /JUMP IF NOT TAD (FLOUTP+10&177+JMPC) /MAKE IT NOT PRINT DCA I (FLOUTP+5) /ANY LEADING SPACES TESTTEA,TAD I (SWMX) /GET SWITCHES /M-/X AND (20) /JUST /T BIT SZA CLA /SKIP IF OFF JMP TESTAC /JUMP IF ON TAD (" -337) /GET TAB FUDGE VALUE DCA I (GTABCON) /MAKE IT CONVERT TO TESTAC, TAD I (SWAL) /GET SWITCHES /A-/L AND (5000) /JUST /A, /C BITS SNA /SKIP IF EITHER ON JMP DELBOTH /JUMP IF BOTH OFF RAL /A TO LINK SNA CLA /SKIP IF /C SET JMP DELSIN /JUMP IF /C OFF SZL /SKIP IF /A OFF JMP ONCECOMMON /JUMP IF /A ON; DON'T CHANGE ANYTHING TAD (FCOS-1) /GET SINE ADDRESS DCA BOTTOM /SETUP NEW LIMIT NL7775 /SETUP COUNT OF THREE JMP BOTHMORE /CONTINUE THERE DELBOTH,TAD (TGO-1) /SETUP NO FUNCTIONS ADDRESS FUNCT, DCA BOTTOM /ESTABLISH NEW LIMIT TAD M5/[-5] /DELETE ALL FIVE FUNCTIONS BOTHMOR,DCA FUNCT /SAVE DELETION COUNTER TAD (ERROR5) /GET ERROR VALUE DCA I FUNPTR /DESTROY A FUNCTION ENTRY ISZ FUNPTR /BUMP TO NEXT FUNCTION ISZ FUNCT /DONE ALL YET? JMP .-4 /NO, GO BACK ONCECOM,JMP I (TESTCON) /CONTINUE THERE DELSIN, TAD (FNTABF+11) /GET NEW FUNCTION POINTER VALUE DCA FUNPTR /SAVE FOR DELETION LATER JMP I (RELOCATE) /GO RELOCATE FUNCTIONS, THEN COME BACK FUNPTR, FNTABF+6 /FUNCTION TABLE ADDRESS PAGE / ROUTINE TO RELOCATE ARCTANGENT, LOGARITHM, EXPONENTIAL PACKAGE SO IT / WILL WORK WITHOUT SINE, COSINE PACKAGE WHEN THE LATTER IS DELETED. RELOCAT,TAD (FEXP+200-1) /NEW CORE LIMIT DCA BOTTOM /TO CORE LIMIT ADDRESS TAD I RELTBL /GET FIRST ADDRESS TO RELOCATE TAD C200/[200] /RELOCATION FACTOR IS 200 DCA I RELTBL /PUT IT BACK ISZ .-1 /ZAP STORE INSTRUCTION ISZ .-4 /ZAP LOAD INSTRUCTION ISZ RELCNT /DONE YET? JMP .-6 /NO, GO RELOCATE SOME MORE RELLUP, TAD I A1 /5177 DCA I A2 /5377 NL7777 /BACK TAD A1 /UP DCA A1 /POINTER NL7777 /BACK TAD A2 /UP DCA A2 /POINTER ISZ MOVCNT /DONE YET? JMP RELLUP /NO NL7776 /CORRECT COUNT JMP I (BOTHMOR) /CONTINUE THERE A1, FCOS-1 /LAST LOCATION IN ATN PACKAGE A2, TGO-1 /LAST NEW LOCATION FOR ATN PACKAGE RELCNT, RELTBL-RELEND /TABLE COUNT MOVCNT, FEXP-TGO /MOVE COUNTER RELTBL= . /RELOCATABLE ADDRESSES FNTABF+6 /ARTN ENTRY FNTABF+7 /FEXP ENTRY FNTABF+10 /FLOG ENTRY X2 /POINTER TO NX NNEGP /FLOATING NEGATE CHECK ARCALG+22 /ARCTAN JUMP ADDRESS GO+2 /ARCTAN JUMP ADDRESS TEM /FLOATING TEMPORARY POINTER RELEND= . /END OF TABLE HERE / TEST FOR EXISTENCE OF CONSOLE OVERLAY, ETC. TESTCON,TAD I P7600/[SBOOT] /GET BOOTSTRAP INSTRUCTION TAD (-JMSSYSIO) /COMPARE TO MAGIC VALUE SNA CLA /SKIP IF DIFFERENT JMP CHKCOVRLAY /JUMP IF IT MATCHES ISZ I (CHKKRS) /TURN "KRSIOT" ISZ I (CHKKRS) /INTO "KRBIOT" DCA I (CHKKCC) /DESTROY "KCCIOT" CHKCOVR,NL0002 /SET "C" BIT MASK AND I (SCRSIZE) /GET THE BIT LSNACLA,SNA CLA /SKIP IF ON JMP I (INTKILLER) /JUMP IF OFF TAD (KSFIOT) /GET DEVICE 03 INSTRUCTION DCA I (ENT03) /STORE IN TABLE TAD (TSFIOT) /GET DEVICE 04 INSTRUCTION DCA I (ENT04) /STORE IN TABLE TAD I (SCRSIZE) /GET CORE SIZE WORD RTR;RAR /MOVE DOWN AND AND (70) /ISOLATE MCS BITS TAD (CDF 10) /FORM CDF MCS+10 DCA INTCDF /STORE IN-LINE TAD INTCDF /GET CDF MCS+10 DCA I (LUP1) /STORE IN-LINE INTCDF, .-. /WILL BE CDF MCS+10 TAD I (INTLST) /GET THE LIST POINTER DCA AC /STASH IT TAD AC /GET LIST POINTER IAC /POINT TO CONSOLE OUTPUT ENTRY DCA INTCDF /STASH THE POINTER TAD I INTCDF /GET THE CONSOLE OUTPUT ENTRY CDF 00 /BACK TO OUR FIELD CMA /INVERT FOR CHECKING SZA CLA /SKIP IF NO OUTPUT INTERRUPTS JMP CONORMAL /JUMP IF NORMAL CONSOLE OUTPUT / SINCE THERE ARE NO OUTPUT INTERRUPTS, WE MUST DISABLE THE OUTPUT BUFFERING. TAD P7600/[CLA!400] /GET CLEARING INSTRUCTION DCA I (OUTZAP) /PREVENT IN-PROGRESS FLAG FROM BEING SET TAD P7600/[CLA!400] /GET CLEARING INSTRUCTION DCA I (CONPAT) /PREVENT RECOVERY ROUTINE FROM SETTING IT ALSO CONORMA,DCA I (CHKKCC) /DESTROY "KCCIOT" TAD I (LUP1) /GET "CDF MCS+10" IAC /TAD (CIF-CDF) /MAKE IT "CIF MCS+10" DCA I (CHKKSF) /STORE OVER "KSFIOT" TAD I (CHKJMP) /GET "JMP TRYOUT" DCA I (CHKKRS) /STORE OVER "KRSIOT" OR "KRBIOT" TAD (JMS INCON) /GET INPUT ROUTINE CALL DCA I (CHKJMP) /STORE OVER "JMP TRYOUT" TAD I (CHKKSF) /GET "CIF MCS+10" DCA I (CHKINT) /ENABLE CONSOLE INTERRUPT HANDLER TAD CHKCOVRLAY/(NL0002) /GET NL0002 INSTRUCTION DCA I (TRYOUT) /ENABLE OUTPUT INTERRUPT BIT MASK TAD (BUMPIT&177+ANDC) /GET "AND BUMPIT" INSTRUCTION DCA I (TRYTSF) /STORE OVER "TSFIOT" TAD I (TRYJMP) /GET "JMP INTXIT" DCA I (TRYTCF) /STORE OVER "TCFIOT" TAD LSNACLA/(SNA CLA) /GET TEST INSTRUCTION DCA I (TRYJMP) /STORE OVER "JMP INTXIT" TAD I (CHKKSF) /GET "CIF MCS+10" DCA I (TTYOUT+1) /STORE OVER "TLSIOT" TAD (JMS OUTCON) /GET OUTPUT ROUTINE CALL DCA I (TTYOUT+2) /STORE OVER "SKP" JMP I (LUP1) /CONTINUE THERE PAGE / COMES HERE TO REMOVE INTERRUPT DEVICES IN THE CONSOLE OVERLAY FROM THE / MASTER INTERRUPT CLEARING LIST. LUP1, .-. /WILL BE CDF MCS+10 TAD I AC /GET AN ENTRY IN CONSOLE INTERRUPT LIST CDF 00 /BACK TO OUR FIELD SNA /END OF LIST? JMP INTKILLER /YES CMA /CHECK FOR NON-INTERRUPT CASE SNA /SKIP IF NOT 7777 ENTRY JMP IGNORE /ELSE JUST IGNORE IT IAC /NOW HAVE NEGATIVE FORM FOR TESTING DCA IOTEXC /SAVE IT TAD (TESTLST) /SETUP THE DCA LSTPTR /LIST POINTER LUP2, TAD I LSTPTR /GET AN ENTRY FROM MASTER LIST SNA /END OF LIST? JMP IGNORE /YES TAD IOTEXC /COMPARE TO TEST VALUE AND (7770) /DELETE IOP BITS FROM TEST SZA CLA /SKIP IF IT MATCHES JMP NOMATCH /JUMP IF NOT NL7777 /CREATE 7777 ENTRY DCA I LSTPTR /DESTROY MASTER LIST ELEMENT NOMATCH,ISZ LSTPTR /BUMP TO NEXT JMP LUP2 /KEEP SEARCHING / COMES HERE IF CONSOLE ELEMENT IS 7777 OR MASTER LIST SEARCH IS DONE. IGNORE, ISZ AC /BUMP TO NEXT CONSOLE LIST ELEMENT JMP LUP1 /TRY TO MATCH NEXT ITEM IN MASTER LIST / COMES HERE TO ATTEMPT TO CLEAR OR DISABLE ALL ACTIVE (NON-REFERENCED) / INTERRUPTS BY EXECUTIVE SEVERAL IOT'S TO THE DEVICE. THE LIST MAY BE / PATCHED FOR INSTALLATION ANOMALIES. INTKILL,TAD (TESTLST) /POINT TO DCA LSTPTR /MASTER LIST NL0002 /SETUP "C" BIT MASK AND I (SCRSIZE) /GET THE "C" BIT SNA CLA /SKIP IF OVERLAY PRESENT NL0100 /WILL BE 0100 ON 8/E OR BETTER TAD P7700/[-100] /COMPARE TO EXPECTED VALUE SNA CLA /SKIP IF DIFFERENT CAF /CLEAN UP BUSS NOW INTKLUP,TAD I LSTPTR /GET AN ENTRY SNA /END OF LIST? JMP INTDONE /YES CMA /CHECK FOR 7777 ENTRY SNA /SKIP IF NOT 7777 JMP NOKILL /JUMP IF 7777 CMA /INVERT BACK AND (7770) /REMOVE IOP BITS DCA IOTINLINE /STORE IN TEST INSTRUCTION JMS IOTEXC /EXECUTE IOT0 ISZ IOTINLINE /BUMP UP AND JMS IOTEXC /EXECUTE IOT1 ISZ IOTINLINE /BUMP UP AND JMS IOTEXC /EXECUTE IOT2 ISZ IOTINLINE /BUMP ISZ IOTINLINE /UP ISZ IOTINLINE /AND JMS IOTEXC /EXECUTE IOT5 ISZ IOTINLINE /BUMP ISZ IOTINLINE /UP AND JMS IOTEXC /EXECUTE IOT7 TAD IOTINLINE /GET IOT7 TAD M5/[2-7] /MAKE IT IOT2 DCA IOTINLINE /STORE IN-LINE TAD (-7) /GET TIME-OUT COUNTER DCA IOTEXC /STASH IT ISZ AC /WASTE JMP .-1 /SOME TIME ISZ IOTEXC /WAITED ENOUGH? JMP .-3 /NO, KEEP GOING JMS IOTEXC /EXECUTE IOT2 NOKILL, ISZ LSTPTR /BUMP TO NEXT ELEMENT JMP INTKLUP /KEEP GOING / COMES HERE AFTER KILLING INTERRUPTS FROM THE LIST. ADDITIONAL PATCH SPACE / CAN BE USED HERE FOR KILLING WEIRD DEVICES THAT WERE REMOVED FROM THE / MASTER LIST. INTDONE,ZBLOCK 20 /FOR ADDITIONAL IOT PATCHING TAD I (SWMX) /GET /M-/X SWITCHES AND (40) /JUST /S SWITCH SZA CLA /SKIP IF OFF JMP START /JUMP IF ON TAD I (CSTAR) /GET PREVAILING PROMPT CHARACTER PRINTC /PRINT IT JMP START /GO START IT UP IOTEXC, .-. /TEST IOT EXECUTION ROUTINE IOTINLI,.-. /WILL BE PROBLEMATIC IOT CIF 00 /PREVENT PROBLEMS! CIF 00 /PREVENT PROBLEMS! CIF 00 /PREVENT PROBLEMS! CIF 00 /PREVENT PROBLEMS! IOF /PREVENT PROBLEMS! CDF 00 /PREVENT PROBLEMS! CLA CLL /CLEAN UP JMP I IOTEXC /RETURN LSTPTR, .-. /INTERRUPT DISABLE LIST POINTER PAGE / INTERRUPT DISABLE TEST LIST. TESTLST,7777 /DEVICE 00 RSF /DEVICE 01 - HIGH-SPEED READER PSF /DEVICE 02 - HIGH-SPEED PUNCH ENT03, 7777/KSFIOT /DEVICE 03 - CONSOLE KEYBOARD ENT04, 7777/TSFIOT /DEVICE 04 - CONSOLE PRINTER 7777 /DEVICE 05 7777 /DEVICE 06 7777 /DEVICE 07 7777 /DEVICE 10 7777/11^10+6001 /DEVICE 11 - DC02, PT08 7777/12^10+6001 /DEVICE 12 - DC02, PT08 7777 /DEVICE 13 7777 /DEVICE 14 7777 /DEVICE 15 7777 /DEVICE 16 7777 /DEVICE 17 7777 /DEVICE 20 - EXTENDED MEMORY 7777 /DEVICE 21 - EXTENDED MEMORY 7777 /DEVICE 22 - EXTENDED MEMORY 7777 /DEVICE 23 - EXTENDED MEMORY 7777 /DEVICE 24 - EXTENDED MEMORY 7777 /DEVICE 25 - EXTENDED MEMORY 7777 /DEVICE 26 - EXTENDED MEMORY 7777 /DEVICE 27 - EXTENDED MEMORY 30^10+6001 /DEVICE 30 31^10+6001 /DEVICE 31 32^10+6001 /DEVICE 32 33^10+6001 /DEVICE 33 34^10+6001 /DEVICE 34 35^10+6001 /DEVICE 35 36^10+6001 /DEVICE 36 37^10+6001 /DEVICE 37 40^10+6001 /DEVICE 40 - PT08, KL-8/E 41^10+6001 /DEVICE 41 - PT08, KL-8/E 42^10+6001 /DEVICE 42 - KL-8/E 43^10+6001 /DEVICE 43 - KL-8/E, VT-8/E 44^10+6001 /DEVICE 44 - KL-8/E 45^10+6006 /DEVICE 45 - VT-8/E, KL-8/E 46^10+6006 /DEVICE 46 - KL-8/E 47^10+6006 /DEVICE 47 - KL-8/E 7777 /DEVICE 50 7777 /DEVICE 51 7777 /DEVICE 52 7777 /DEVICE 53 7777 /DEVICE 54 7777 /DEVICE 55 7777 /DEVICE 56 7777 /DEVICE 57 7777 /DEVICE 60 7777 /DEVICE 61 7777 /DEVICE 62 7777 /DEVICE 63 7777 /DEVICE 64 65^10+6001 /DEVICE 65 - LPT: 66^10+6001 /DEVICE 66 - LPT: 7777 /DEVICE 67 7777 /DEVICE 70 7777 /DEVICE 71 7777 /DEVICE 72 7777 /DEVICE 73 7777 /DEVICE 74 7777 /DEVICE 75 7777 /DEVICE 76 7777 /DEVICE 77 0 /THIS ENDS THE LIST / FUNCTION PATCHES. / AS WRITTEN, THE TRIGONOMETRIC FUNCTION PACKAGES ARE INTERDEPENDENT, THUS / IT IS IMPOSSIBLE TO HAVE ATN, LOG, EXP WITHOUT SIN, COS. / BY TAKING ADVANTAGE OF CODE OPTIMIZATION TECHNIQUES, COINCIDENCES OF / ASSEMBLY AND SMALL HOLES IN THE AREA, THE TWO PACKAGES CAN BE SPLIT. THIS / ALLOWS THE ATN, LOG, EXP PACKAGE TO BE SELECTED ALONE BY RELOCATING IT TO / THE AREA FORMERLY OCCUPIED BY SIN, COS. THIS SAVES EXACTLY ONE PAGE OF / FOCAL BUFFER SPACE. *FEXP+2 /OVER JMS I NEGP JMS I NNEGP/(FNEG) /NEW POINTER *FEXP+14 /OVER FPUT I XSQ2 FPUT NXSQR /NEW TEMPORARY *FEXP+16 /OVER FSUB I XSQ2 FSUB NXSQR /NEW TEMPORARY *FEXP+21 /OVER FPUT I XSQ2 FPUT NXSQR /NEW TEMPORARY *FEXP+32 /OVER FMUL I XSQ2 FMUL NXSQR /NEW TEMPORARY *FEXP+37 /OVER FMUL TWO FMUL NTWO /NEW CONSTANT *FEXP+40 /OVER FADD ONE FADD I (FLTONE) /EXISTING CONSTANT *FEXP+51 /OVER FGET ONE FGET I (FLTONE) /EXISTING CONSTANT *X2 /OVER POINTER TO X X2, NX /NEW STORAGE POINTER *XSQ2 /OVER POINTER TO XSQR NNEGP, FNEG /NEW POINTER TO FNEG *ONE /OVER FORMER CONSTANT ONE NXSQR, ZBLOCK 4 /NEW TEMPORARY NTWO, 0002; 2000; 0000 /NEW CONSTANT TWO *ARCALG+3 /OVER FPUT I XSQ2 FPUT NXSQR /NEW TEMPORARY *ARCALG+6 /OVER FMUL I XSQ2 FMUL NXSQR /NEW TEMPORARY *ARCALG+12 /OVER FMUL I XSQ2 FMUL NXSQR /NEW TEMPORARY *ARCALG+14 /OVER FMUL I XSQ2 FMUL NXSQR /NEW TEMPORARY PAGE *ARTN+5 /OVER FPUT I X1 FPUT NX /NEW TEMPORARY *ARTN+15 /OVER FDIV I X1 FDIV NX /NEW TEMPORARY *ARTN+16 /OVER FPUT I X1 FPUT NX /NEW TEMPORARY *ARCRTN+1 /OVER JMP I EXIT1 JMP ARCEXIT /NEW EXIT ROUTINE *ARCRTN+3 /OVER FPUT I X1 FPUT NX /NEW TEMPORARY *ARCRTN+4 /OVER FGET I PI2 FGET NPI2 /NEW CONSTANT *ARCRTN+5 /OVER FSUB I X1 FSUB NX /NEW TEMPORARY *ARCRTN+7 /OVER JMP I EXIT1, ETC. ARCEXIT,ISZ T3 /SWITCH SIGNS? EXIT1, RETURN /NO, JUST RETURN X1, JMS I MINSKI /NEGATE FLAC PI2, RETURN /THEN RETURN *CON1 /OVER POINTER TO ONE CON1, FLTONE /POINTER TO AVAILABLE CONSTANT ONE *STARTL+14 /OVER FPUT I X1 FPUT NX /NEW TEMPORARY *STARTL+37 /OVER FADD I X1 FADD NX /NEW TEMPORARY *STARTL+41 /JMP I EXIT1 JMP ARCEXIT /NEW EXIT ROUTINE *FNEG+4 /OVER EMPTY SPACE NX, ZBLOCK 4 /TEMPORARY NPI2, 0001; 3110; 3756; 3235 /CONSTANT PI/2 ZBLOCK 1 /EMPTY SPACE *C9+1 /OVER SINE CONSTANT 2501 /CORRECTED VALUE *K5 /OVER FLOATING POINT CONSTANT K5, 4 /CORRECT ROUNDING ERROR / THE FOLLOWING PATCHES ALLOW THE TTYOUT ROUTINE TO LIVE ON THIS PAGE. *DECONV+10 /OVER DECIMAL CONVERSION ROUTINE TAD NMPLUS/(-"+) /COMPARE TO "+" *DECONV+20 /OVER DECIMAL CONVERSION JMS I NXINPUT/(INPUT) /GET NEXT CHARACTER *DECONV+22 /OVER DECIMAL CONVERSION TAD M240/[-" ] /COMPARE TO " " *DECON+2 /OVER DECIMAL CONVERSION TAD NMINE/(-"E) /COMPARE TO "E" *DSAVE+5 /OVER DECIMAL CONVERSION JMS I NXINPUT/(INPUT) /GET NEXT CHARACTER *DTST+5 /OVER DECIMAL CONVERSION TAD NMINUSZ/(-"Z) /COMPARE TO "Z" / TTYOUT ROUTINE. *MINE /OVER FORMER CONSTANTS TTYOUT= . /TTY: OUTPUT ROUTINE MINE, .-. /TTY: OUTPUT MINUSZ, TLSIOT /**** CONSOLE **** CIF MCS+10 MPLUS, SKP /**** CONSOLE **** JMS OUTCON MSPACE, JMP .-2 /WAIT FOR IT IF NECESSARY XINPUT, JMP I TTYOUT /RETURN / AVAILABLE SPACE FOR NEW CONSTANTS. *DIV1+20 /AFTER DIVIDE ROUTINE NMINUSZ,-"Z /CONSTANT 7446 NMPLUS, -"+ /CONSTANT 7525 IFNZRO .-5776 NMINE, -"E /CONSTANT 7473 NXINPUT,INPUT /POINTER TO INPUT ROUTINE / PATCH TO REMOVE "=" ON OUTPUT. *FLOUTP+2 /OVER OUTPUT ROUTINE CLA!400 /REMOVE "=" / PATCH TO POINT FLOATING OUTPUT TO A NEW BUFFER. *SADR /OVER BUFFER POINTER NBUFFER-1 /NEW OUTPUT BUFFER / PATCHES TO ALLOW FILE UNPACKING ROUTINE TO LIVE ON THIS PAGE. *FLINTP /FLOATING INPUT ROUTINE PAGE / THE FOLLOWING LITERAL DEFINITIONS ENSURE THAT THE POINTER TO NMINE WILL / BE CORRECTLY ASSEMBLED. FOO= (7) /ARBITRARY CONSTANT NEEDED LATER FOO= (ENDFILE) /THIS MUST BE SECOND; OTHER LITERALS ARE ARBITRARY *FLINTP+7 /OVER FLOATING INPUT ROUTINE JMS I ENDFI+5/(DECONV)/READ DIGIT GROUP *FLINTP+15 /OVER FLOATING INPUT ROUTINE DCA I NDPN/(DNUMBR) /STORE THE VALUE *FLINTP+17 /OVER FLOATING INPUT ROUTINE TAD I NDPN/(DNUMBR) /GET THE VALUE BACK *FIGO1+11 /OVER FLOATING OUTPUT ROUTINE TAD I GNMINE/(NMINE) /COMPARE TO "E" *FIGO1+15 /OVER FLOATING OUTPUT ROUTINE JMS I ENDFI+5/(DECONV)/READ DIGIT GROUP *MINUSE /OVER AVAILABLE AREA GETCHR= . /GET A CHARACTER ROUTINE HERE MINUSE, .-. /GET A CHARACTER ENTRY POINT NDPN= ./(DNUMBR) /POINTER TO DNUMBR HERE DPCVPT, JMP I GTRIM /GO WHEREVER YOU GO *DPN /OVER AVAILABLE AREA G7715, "M-400 / FUDGE CONSTANT *P43+1 /PUT BODY OF ROUTINE OVER OLD PTR: ROUTINE GFILE, SFILES-1 /FILE POINTER; WILL BE UPDATED AS NECESSARY GPTR, BUFFA /BUFFER POINTER GTABCON,"I&77-37-100 /**** NOT /T **** 7701 IFNZRO .&177-114 GTRIM, GEOF /TRIM ROUTINE AND P77/[77] /TRIM TO SIX-BIT SZA /END OF LINE? JMP .+4 /NO TAD (GETMR2) /YES, FORCE DCA GTRIM /ALIGNMENT TAD G7715/("M-400) /FORCE A TAD (-37) /COMPARE TO SNA /NO TAD GTABCON /YES (MAY BE (" -337) FOR ) SMA /ALPHA? TAD P7700/[-100] /NO TAD P337/[337] /FIXUP TO EIGHT-BIT GEXIT, JMP I GETCHR /RETURN TO FOCAL GETMORE,TAD I GPTR /GET A WORD SNA /? JMP GEOF /YES RTL6;RAL /BYTE SWAP JMS GTRIM /TRIM AND EXIT TAD I GPTR /COME BACK AND GET AGAIN JMS GTRIM /TRIM AND EXIT AGAIN GETMR2, ISZ GPTR /COME BACK AND BUMP POINTER TAD GPTR /COMPARE IT TAD C200/[-BUFFA-200] /TO LIMIT GSYSIO, SZA CLA /DONE WITH BUFFER? JMP GETMOR /NO GEOB, JMS I GSYSIO/(SYSIO) /READ A BLOCK GBUFFA, BUFFA /INTO 07400 GFUN, 1^100+.-. /1 BLOCK ONLY; UNIT BITS WILL BE FILLED IN GBLOCK, .-. /BLOCK NUMBER WILL BE FILLED IN ISZ GBLOCK /FOR NEXT TIME TAD GBUFFA/(BUFFA) /RESET DCA GPTR /CHARACTER POINTER JMP GETMORE /TRY AGAIN GEOF, ISZ GFILE /BUMP FILE POINTER TAD I GFILE /GET A FILE ARGUMENT AND (7770) /JUST BLOCK BITS SNA /? GNMINE, JMP I (ENDFILE) /YES DCA GBLOCK /NO, GO GET ANOTHER TAD I GFILE /GET FILE ARGUMENT AGAIN AND (7) /JUST UNIT BITS TAD C100/[1^100] /GET READ ONE BLOCK BIT DCA GFUN /PUT INTO CALL JMP GEOB /NOW READ IT IN ZBLOCK 1 /EMPTY SPACE PAGE / POINT INTERPRETIVE POWER ROUTINE AT NEW BUFFER SINCE SQUARE ROOT HAS MOVED. *ZERO+31 /OVER ITER1 ADDRESS NITER1 /POINT TO NEW BUFFER *ZERO+34 /OVER ITER1 ADDRESS NITER1 /POINT TO NEW BUFFER *SIGN+3 /OVER REFERENCE TO P4000 NL4000 /LOAD 4000 TO XOR THE SIGN BITS / BINARY LOADER ROUTINE FOR FOCAL. *BUFFA /WHERE THIS EXECUTES BENTRY, .-. /FOCAL COMES HERE WHEN LOOKING FOR AN INPUT CHARACTER IOF /PREVENT PROBLEMS TAD BENTRY /GET CALLER DCA I (GETCHR) /SAVE THERE IN CASE FINAL NL7777 /\ TAD BENTRY / >BACKUP TO CALLER WITHIN FOCAL DCA BENTRY // BEOLOD, ISZ BFLPTR /POINT TO NEXT FILE TAD I BFLPTR /GET NEXT FILE ARGUMENT AND (7770) /JUST BLOCK BITS SNA /END OF LIST? JMP I (ENDFILE) /YES, GO SWAP IN OVERLAY DCA BINBLK /NO, SAVE AS LATEST FILE BLOCK TAD I BFLPTR /GET ARGUMENT AGAIN AND (7) /JUST UNIT BITS TAD C100/[1^100] /ADD ON ONE BLOCK READ BIT DCA BFUN /STORE IN-LINE NL7777 /INDICATE VALIDITY DCA BCHK /CHECK NEEDED BLOAD, JMS I BSYSIO/(SYSIO) /CALL I/O ROUTINES B3400, 3400 /BUFFER BFUN, 1^100+.-. /UNIT BITS WILL BE FILLED IN BINBLK, .-. /BLOCK NUMBER WILL BE FILLED IN TAD B3400/(3400) /RESET THE DCA BINPTR /BUFFER POINTER TAD (-22) /RESET THE DCA BGRPCT /GROUP COUNTER BNWGRP, TAD (-6) /RESET THE DCA BWDCT /WORD COUNTER JMS BGETWD /GET A WORD DCA BRLBTS /SAVE AS FLAG WORD ISZ BCHK /SHOULD WE CHECK FOR VALIDITY? JMP BGRPLP /NO TAD I BINPTR /MAKE TAD P7600/[-200] /CHECK SNA CLA /FOR VALIDITY JMP BGRPLP /OK NL7777 /RESET TAD BFLPTR /FILE POINTER DCA I (GFILE) /FOR GETCHR TAD (GETCHR) /POINT FOCAL DCA INDEV /AT NEXT ROUTINE JMP I BENTRY /GO BACK; NEVER DARKEN MY DOOR AGAIN BGRPLP, TAD BRLBTS /GET FLAG CLL RTL /ROTATE TO NEXT DCA BRLBTS /PUT IT BACK CLA IAC CML /SET LINK ON + AC[11] AND BRLBTS /CHECK FOR CONDITIONS SNL / OR FIELD SETTING? JMP BEOF /YES BSYSIO, SZA CLA /WORD OF CODE? JMP BORGIN /NO JMS BGETWD /GET ANOTHER BCDF, CDF 00 /GETS CHANGED DCA I BLOC /STORE CODE CDF 00 /RESTORE FIELD ISZ BLOC /BUMP CORE POINTER NOP /JUST IN CASE BNXTWD, ISZ BWDCT /DONE SIX YET? JMP BGRPLP /NO DO ANOTHER ISZ BGRPCT /DONE 22 GROUPS YET? JMP BNWGRP /NO DO ANOTHER ISZ BINBLK /BUMP BLOCK FOR NEXT JMP BLOAD /GET IT IN BORGIN, JMS BGETWD /GET A NEW WORD DCA BLOC /MAKE IT THE NEW LOCATION COUNTER JMP BNXTWD /GO DO NEXT ONE BEOF, SZA CLA /SKIP IF JMP BFIELD /JUMP IF FIELD SETTING / THE FOLLOWING IS PROVIDED FOR THE BENEFIT OF OVERLAY FILES WHICH CAN / EASILY ZAP THIS AND GAIN CONTROL. BEOFZAP,0000 /**** FILES WHICH INITIALIZE **** SKP SKP /DON'T NORMALLY GO ANYWHERE JMP I (BONCE) /STARTUP JUST READ IN OVERLAY JMP BEOLOD /GO DO NEXT FILE BFIELD, JMS BGETWD /GET A NEW WORD DCA BCDF /MAKE IT THE NEW FIELD SETTING JMP BNXTWD /GO DO NEXT ONE BGETWD, .-. /GET A WORD FROM THE BUFFER TAD I BINPTR /GET NEXT WORD ISZ BINPTR /FOR NEXT TIME JMP I BGETWD /RETURN BCHK, .-. /VALIDITY CHECKING SWITCH BFLPTR, SFILES-1 /POINTER TO PASSED FILES BGRPCT, .-. /GROUP COUNTER BINPTR, .-. /BUFFER POINTER BLOC, .-. /LOCATION COUNTER BRLBTS, .-. /FLAG WORD BWDCT, .-. /WORD COUNTER PAGE FIELD 1 /OVERLAY FIELD *0 /WHERE IT GENERATES NOPUNCH /FOOL THE ASSEMBLER FIELD 0 /WHERE IT EXECUTES *0 /RESTORE ORIGIN ENPUNCH /RESTORE BINARY OUTPUT RELOC BUFFA /WHERE IT EXECUTES BUFFA, TAD I (SWAL) /GET SWITCHES /A-/L QCNT, RTL6 /G TO AC[0] QCNT2, SMA CLA /SKIP IF /G SET JMP NOGEE /JUMP IF NOT SET TAD ("G) /GET A "G" DCA CHAR /PREPARE TO PACK IT IN PACKC /PACK IT IN TAD CCR/["M&37!200] /GET A DCA INBUF /SET INPUT BUFFER ALSO NOGEE, IOF /PREVENT PROBLEMS TAD (PRINTC) /GET INSTRUCTION DCA I (CHIN+6) /RESTORE ECHO TAD (PRINTC) /GET INSTRUCTION DCA I (START+12) /RESTORE STARS (OR POINTS) TAD (RECOVR) /ALLOW DCA I (RECADDRESS) /<^P> HANDLING TAD (ERROR2) /RESTORE DCA I (ERRZAP) /INPUT BUFFER OVERFLOW ERROR TAD (CINPUT) /RESTORE THE DCA INDEV /INPUT POINTER NL7777 /\ TAD I (GETCHR) / >BACKUP CALLER DCA I (GETCHR) // TAD I (SWAL) /GET SWITCHES /A-/L RAR /L TO LINK SZL CLA /SKIP IF /L OFF JMP LIBSET /JUMP IF ON TAD (LCOM) /SETUP THE DCA I (COMGO+10) /LIBRARY ENTRY JMP I (ENDFILE) /GO SWAP IN NEXT LIBRARY HANDLER LIBSET, TAD (LIBRARY) /SETUP DCA I (COMGO+10) /OUR LIBRARY COMMAND ION /SAFE TO COME OUT NOW! JMP I (GEXIT) /GO REJOIN FOCAL FROM THERE / LIBRARY (LOCATIONS COMMAND) IF /L. LIBRARY,TAD CFRS /GET FIRST JMS PRNT8 /PRINT IT TAD BUFR /GET BUFFER LIMIT JMS PRNT8 /PRINT IT TAD LASTV /GET LAST VARIABLE LIMIT JMS PRNT8 /PRINT IT TAD BOTTOM /GET STACK LIMIT JMS PRNT8 /PRINT IT JMP .+3 /NOT YET! GETC /GET ADDITIONAL INPUT PRINTC /PRINT IT TAD CHAR /GET DELIMITER TAD MCR/[-"M!100] /COMPARE TO SZA CLA /SKIP IF IT MATCHES JMP .-5 /GO BACK OTHERWISE TAD I (FILPTR) /GET FILL POINTER CIA /INVERT FOR TEST TAD I (EMTPTR) /COMPARE TO EMPTYING POINTER SZA CLA /SKIP IF THEY MATCH JMP .-4 /ELSE WAIT FOR IT TAD TELSW /GET IN-PROGRESS FLAG SZA CLA /SKIP IF IDLE JMP .-7 /ELSE WAIT FOR EVERYTHING TO FINISH TAD (-40) /GET TIME COUNTER DCA QCNT2 /SET IT UP ISZ QCNT /WASTE JMP .-1 /SOME TIME ISZ QCNT2 /WASTED ENOUGH TIME? JMP .-3 /NO, KEEP GOING IOF /TURN INTERRUPTS OFF LIBZAP, NOP /**** VT-8/E OVERLAY **** DPSMIOT JMP I P7600/[SBOOT] /GOODBYE! PRNT8, .-. /PRINT AN OCTAL NUMBER ROUTINE DCA T1 /SAVE IN T1 TAD (-4) /GET CONSTANT DCA QCNT /SAVE IN COUNTER QLP, TAD T1 /GET IT BACK CLL RTL;RAL /SHIFT IT TO LOW-ORDER BITS DCA T1 /SAVE IT BACK TAD T1 /GET IT AGAIN RAL /SHIFT INTO PLACE AND (7) /AND WITH A SUITABLE FUDGE TAD C260/["0] /MAKE IT ASCII PRINTC /AND PRINT IT ISZ QCNT /DONE 4 YET? JMP QLP /NO, GO BACK TAD CCR/["M&37!200] /YES, GET PRINTC /AND PRINT THAT JMP I PRNT8 /RETURN PAGE RELOC /TURN OFF RELOCATION FIELD 1 /WHERE IT GENERATES *200 /WHERE IT GENERATES NOPUNCH /FOOL THE ASSEMBLER FIELD 0 /WHERE IT EXECUTES *200 /WHERE IT LOADS ENPUNCH /RESTORE BINARY OUTPUT RELOC BUFFA /WHERE IT EXECUTES BUFFA, ION /RESTORE INTERRUPT QCNT3, JMP I (GEXIT) /REJOIN FOCAL / UNIMPLEMENTED LIBRARY COMMAND; AVAILABLE ONLY AFTER BEING SWAPPED IN. GETC /GET A CHARACTER PRINTC /PRINT IT LCOM, TAD CHAR /GET THE LATEST TAD MCR/[-"M!100] /COMPARE TO SZA CLA /SKIP IF IT MATCHES JMP .-5 /ELSE KEEP GOING TAD I (FILPTR) /GET FILL POINTER CIA /INVERT FOR TEST TAD I (EMTPTR) /COMPARE TO EMPTYING POINTER SZA CLA /SKIP IF THEY MATCH JMP .-4 /ELSE WAIT FOR IT TAD TELSW /GET IN-PROGRESS FLAG SZA CLA /SKIP IF IDLE JMP .-7 /ELSE WAIT FOR EVERYTHING TO FINISH TAD (-40) /GET TIME COUNTER DCA BUFFA /SET IT UP ISZ QCNT3 /WASTE JMP .-1 /SOME TIME ISZ BUFFA /WASTED ENOUGH TIME? JMP .-3 /NO, KEEP GOING IOF /TURN INTERRUPTS OFF LCOMZAP,NOP /**** VT-8/E OVERLAY **** DPSMIOT IOF /TURN INTERRUPTS OFF JMP I P7600/[SBOOT] /GOODBYE! PAGE RELOC /TURN OFF RELOCATION $ /THAT'S ALL FOLK!