/This was basically xlisted in the original. /I don't fully understand why it didn't show in the symbol tabe, but /it presumably had to do with the FIXTAB. /2345678901234567890123456789012345678901234567890123456789012345678901234567890 FIXMRI FGET=0000 FIXMRI FADD=1000 FIXMRI FSUB=2000 FIXMRI FDIV=3000 /bugbug: How are these two in the wrong order?? FIXMRI FMPY=4000 / FIXMRI FXPN=5000 FIXMRI FPUT=6000 FEXT=0000 /FSQR=0001 /FATN=0005 /FEXP=0006 /FLOG=0007 /FNEG=0010 /FINP=0011 FNOR=7000 MQA=7501 MQL=7421 FIXTAB / NOTES ON FOCAL 1976 / FOCAL 1976 WAS PREPARED THROUGH TWO MONTHS OF WORK FROM A BINARY / PAPERTAPE OF FOCAL 1969. THE PROCESS OF DISASSEMBLY AND REVISION / HAS RESULTED IN MY OWN DEEP UNDERSTANDING OF THE WORKINGS OF FOCAL / AND IN WHAT I BELIEVE TO BE THE BEST VERSION OF FOCAL CURRENTLY / AVAILABLE ANYWHERE. MY THANKS TO NORTH SALEM HIGH SCHOOL FOR EMPLOYING / ME TO PERFORM THIS REVISION. I THINK WE BOTH GOT A GOOD DEAL. / FOCAL IS A REGISTERED TRADEMARK OF DIGITAL EQUIPMENT CORPORATION. / VINCENT SLYNGSTAD / TO SAVE A FOCAL PROGRAM: /ON SYSTEMS WITH ASR TELETYPES, TYPE A 'WRITE' COMMAND WITH THE APPROPRIATE /ARGUMENT, BUT DO NOT TYPE THE RETURN. TURN ON YOUR TAPE PUNCH AND DEPRESS /SHIFT, REPEAT, AND @, IN THAT ORDER, AND HOLD DOWN UNTIL THE DESIRED AMOUNT /OF LEADER HAS BEEN GENERATED, THEN RELEASE IN THE REVERSE ORDER. NOW TYPE /RETURN, AND WAIT FOR YOUR PROGRAM TO BE LISTED. THEN DEPRESS THE SHIFT, /REPEAT AND @ KEYS AS ABOVE TO GENERATE TRAILER. TURN OFF THE TAPE PUNCH . /LABEL AND SAVE YOUR TAPE AS DESIRED. /ON OS-8 SYSTEMS, THE ABOVE PROCEDURE MAY BE USED, OR THE FOLLOWING COMMANDS /MAY BE TYPED: / @LOCATIONS / XXXX (THE COMMAND TYPES FOUR NUMBERS) / XXXX / YYYY (THIS NUMBER AND / ZZZZ THIS NUMBER ARE IMPORTANT) / .SAVE DEV:NAME 0-YYYY,ZZZZ-7577;200 /WHERE "DEV" IS THE NAME OF THE OS-8 DEVICE YOU WISH TO SAVE YOUR PROGRAM ON. /"NAME" IS THE NAME YOU WISH TO GIVE YOUR PROGRAM. 'YYYY' AND 'ZZZZ' ARE /THE THIRD AND FOURTH NUMBERS TYPED BY FOCAL IN RESPONSE TO THE "LOCATIONS" /COMMAND. ALL VARIABLES ARE SAVED TOO WITH THIS METHOD. /TO DELETE A PROGRAM SAVED BY THIS METHOD TYPE: / .DELETE DEV:NAME.SV /WHERE "DEV" IS THE NAME OF THE DEVICE THE PROGRAM IS SAVED ON, AND "NAME" IS /THE NAME OF THE PROGRAM YOU WISH TO DELETE. / TO RELOAD A FOCAL PROGRAM: /IF THE PROGRAM WAS SAVED ON PAPERTAPE, THE TAPE MAY SIMPLY BE READ INTO /FOCAL. THE USER MAY THEN USE HIS PROGRAM IN ANY WAY HE DESIRES BY USE OF /MODIFY, GO COMMANDS, OR WHATEVER. /IF THE PROGRAM WAS SAVED VIA OS-8 ON A DISK OR DECTAPE, THE FOLLOWING COMMAND /MAY BE TYPED IN MONITOR MODE: / .RUN DEV:NAME /WHERE "DEV" AND "NAME" ARE AS DESCRIBED IN SAVING. IF THE PROGRAM WAS SAVED ON /THE SYSTEM DEVICE, THE FOLLOWING COMMAND MAY BE USED: / .R NAME /WHERE "NAME" IS THE NAME OF THE PROGRAM. THESE METHODS BOTH WILL START FOCAL IN /COMMAND MODE WITH YOUR PROGRAM EXACTLY AS IT WAS PRIOR TO USING THE SAVE /PROCEDURE. NOTE THAT NEITHER OF THESE TECHNIQUES WILL START THE EXECUTION /OF THE USER'S FOCAL PROGRAM. THE PROGRAM IS SIMPLY LOADED AS IF THE USER /HAD TYPED IT IN AGAIN. IT IS NECESSARY FOR THE USER TO THEN TYPE A "GO" /COMMAND TO EXECUTE HIS PROGRAM. / ERROR DIAGNOSTIC LIST: / NO ATTEMPT WAS MADE TO RETAIN THE OLD ERROR DIAGNOSTIC CODES, AND THE / FOLLOWING IS THE CORRECT AND DEFINITIVE LIST OF ERROR CONDITIONS. /?01.00 USER TYPED CONTROL C WHILE FOCAL WAS WAITING FOR INPUT FROM / THE TTY OR DECODING CHARACTERS FOR EXECUTION. /?01.64 LINE NUMBER HAD TO GROUP PORTION AND LINE BEGAN WITH A / DECIMAL POINT ON INPUT. /?01.71 LINE NUMBER HAD NO STEP NUMBER FOLLOWING GROUP NUMBER ON / INPUT FOR STORAGE IN USER PROGRAM. /?02.26 LINE NUMBER HAD GROUP NUMBER OF ZERO ON INPUT OR AS ARGUMENT / IN GOTO OR IF STATEMENT. /?02.53 IN GROUP DO OR BRANCH COMMAND WITH INTEGER ARGUMENT, THE / REFERENCED GROUP OF LINES DOES NOT EXIST. /?02.73 IN A DO OR BRANCH COMMAND AN ATTEMPT WAS MADE TO REFERENCE / A NONEXISTANT LINE. /?02.:2 DURING THE EXECUTION OF A FOCAL COMMAND, THE STACK EXCEEDED / THE AMOUNT OF STORAGE AVAILABLE TO IT. /?03.22 IN A GOTO OR IF COMMAND, A LINE WAS REFERENCED WHICH DID NOT / EXIST IN THE USER PROGRAM. /?03.44 IN COMMAND MODE OR WHILE EXECUTING THE USER PROGRAM, AN ATTEMPT / WAS MADE TO EXECUTE A COMMAND ILLEGAL IN THE FOCAL LANGUAGE. /?04.61 IS A SET OR FOR COMMAND, THE TERMINATOR AFTER A VARIABLE / NAME WAS NOT A COMMA OR EQUALS SIGN. /?04.76 IN A FOR OR SET COMMAND, THE TERMINATOR FOLLOWING THE FIRST / EXPRESSION WAS NOT A RETURN, COMMA (FOR), OR SEMICOLON. /?04.84 IN A FOR COMMAND, THE SECOND EXPRESSION WAS NOT FOLLOWED / BY A COMMA OR SEMICOLON. /?06.04 IN A SET OR ASK COMMAND, A VARIABLE NAME BEGINS WITH AN / OPERATOR, TERMINATOR, OR NUMERIC DIGIT. /?06.47 DURING THE EXECUTION OF A FOCAL COMMAND, AN ATTEMPT WAS MADE / TO CREATE MORE VARIABLES THAN STORAGE WILL ALLOW. /?07.;7 A NONEXISTANT OR DELETED FUNCION WAS REFERENCED, OR AN INVALID / CHARACTER WAS ENCOUNTERED DURING COMMAND INTERPRETATION. /?07.;9 DURING THE EVALUATION OF AN EXPRESSION BY FOCAL, NO OPERATORS / WERE ENCOUNTERED IN A RUN. /?08.62 NO RIGHT PREN WAS FOUND TO MATCH A LEFT PREN IN AN EXPRESSION / DURING COMMAND EXECUTION. /?10.:8 A LINE OR FOCAL PROGRAM IS TOO LONE FOR STORAGE IN THE TEXT / OR SCRATCH BUFFERS. /?27.:0 AN INVALID QUANTITY FOLLOWS AN EXPONENTIATION OPERATOR IN AN / EXPRESSION. /?12.52 THE LINE REFERRED TO BY A MODIFY OR MOVE COMMAND WAS NOT FOUND / IN THE USER PROGRAM. /?29.51 AN ATTEMPT WAS MADE TO DIVIDE BY ZERO IN AN ARITHMETIC / EXPRESSION DURING COMMAND EXECUTION. /?23.35 THE FSIN OF FCOS FUNCTION WAS CALLED WITHOUT AN ARGUMENT DURING / FOCAL COMMAND EXECUTION. /?24.07 THE SQUARE ROOT FUNCTION (FSQT) WAS CALLED IN AN ATTEMPT TO / FIND THE SQUARE ROOT OF A NEGATIVE NUMBER. /?24.:3 IN THE INTERPRETATION OF A NUMERIC QUANTITY IN AN EXPRESSION / OR ASK RESPONSE MORE THAN TEN DIGITS WERE ENCOUNTERED. / NEW FEATURES OF 4K FOCAL 1976 / THE LINE SEEK ROUTINE HAS BEEN ENHANCED TO LOOK ONLY AT THOSE / LINES WHICH FOLLOW THE CURRENT ONE IF THE SOUGHT AFTER LINE / NUMBER IS GREATER THAN THE CURRENT ONE. / BUILT IN VARIABLES ARE NOW SUPPORTED AS FUNCTION CALLS WHICH DO NOT / REQUIRE ARGUMENTS, AS IN 'SET CH=FIN", WHICH WILL ACCESPT ON CHARACTER / FROM THE TTY AND STORE IT IN THE VARIABLE CH. / ENHANCED (FASTER, MORE EFFICIENT) PACKING AND UNPACKING ROUTINES / TO GET TEXT IN AND OUT OF THE TEXT BUFFER. / THE PROGRAM INTERRUPT ROUTINES HAVE BEEN REMOVED TO MAKE MORE ROOM / FOR USER PROGRAMS. CONTROL C WILL STILL WORK AT ALL TIMES, AND INPUT / BUFFER OVERFLOW IS IMPOSSIBLE. UNFORTUNATELY, THIS CAUSES FOCAL / TO HAVE TO WAIT ON THE PRINTER WHEN IT COULD BE THINKING, ADDING / TO ITS ALREADY EXTREME SLOWNESS. IT IS HOPED THE OTHER CHANGES WILL / COMPENSATE SOMEWHAT BY MAKING FOCAL WORK FASTER. / FIN AND FOUT FUNCTIONS HAVE BEEN ADDED. FIN WILL NOT ECHO, AND FOUT / WILL NOT AUTOMATICALLY LINE FEED IF A RETURN IS SENT TO THE PRINTER. / NOTE THAT THE DELETION OF THE INTERRUPT ROUTINES REMOVED ALL / RESTRICTIONS ON WHAT VALUES MAY BE SENT BY FOUT. (FOUT(0) WILL / GENERATE ONE LEADER/TRAILER CODE.) / THE ASTERISK COMMAND FOR HIGH SPEED READER MANIPULATION HAD BEEN / REMOVED TO ENHANCE EFFICIENCY AND PROVIDE MORE ROOM. / THE * READY SIGNAL HAS BEEN CHANGED TO AN AT SIGN, SO THAT PUNCHED / TAPES WILL NOT PRODUCE ILLEGAL COMMAND MESSAGES AND THE LIKE, AS / THE ASTERISK COMMAND HAS BEEN REMOVED. / AN FMQ FUNCTION/PSEUDOVARIABLE HAS BEEN ADDED TO MANIPULATE THE / MULTIPLIER QUOTIENT REGISTER. THE FUNCTION WILL RETURN THE CURRENT / VALUE OF THE MQ, AND WILL REPLACE THAT VALUE IN THE MQ WITH THE / PARAMETER VALUE. TO RETURN THE VALUE OF THE MQ, FMQ MAY BE USED IN / THE FORM OF A PSEUDOVARIABLE, AS IN 'TYPE FMQ'. TO UPDATE THE VALUE / OF THE MQ USE THE FUNCTION SYNTAX, 'SET OLD=FMQ(NEW)", WHICH WILL / SET 'OLD' EQUAL TO THE CONTENT OF THE MQ AND THEN LOAD THE MQ WITH / THE CONTENTS OF THE VARIABLE 'NEW'. / THE ERASE COMMAND WITHOUT AN ARGUMENT NO LONGER ERASES VARIABLES, / BUT WILL CAUSE A RETURN TO COMMAND MODE ALLOWING THE USE OF THE / 'END' COMMAND. THE 'ZERO' COMMAND IS NOW USED TO ERASE VARIABLES. / THE STACK (PUSH DOWN LIST) ROUTINES HAVE BEEN ENHANCED FOR / GREATER SPEED. / THE FLOATING POINT PACKAGE HAS BEEN ENHANCED AND TAILORED TO / BETTER FIT IN WITH THE REST OF FOCAL, RESULTING IN MANY SUBTLE / EFFICIENCIES IN STORAGE AND SPEED. / THE TYPE $ FEATURE HAS BEE REMOVED. THE FORMER FUNCTION HAS / BEEN MOVED TO THE 'VARIABLES' COMMAND. NOTE THAT THE 'V' / COMMAND LISTS VARIABLES WITH FOUR DIGIT SIGNED SUBSCRIPTS SO / THE USER CAN GET AN ACCURATE PICTURE OF HIS SYMBOL TABLE. THE / USE OF ZERO VARIABLE REPLACEMENT MAY CAUSE VARIABLES NOT TO APPEAR / IN THE LIST, HOWEVER, SO ANY VARIABLE WHICH DOES NOT APPEAR / SHOULD BE ASSUMED TO HAVE A VALUE OF ZERO. / NOTE THAT 'TYPE #' ON A TERMINAL THAT RESPONDS TO FORM FEEDS WILL / CAUSE A PAGE EJECT RATHER THAN A RETURN WITH NO LINE FEED. / EQUAL SIGNS, UNNESTED PARENTHESIS, AND RELATIONAL OPERATORS IN / TYPE COMMANDS WILL NOW GENERATE THE ILLEGAL FUNCTION OR TERMINATOR / MESSAGE INSTEAD OF HANGING UP FOCAL. / THE FLOATING OUTPUT ROUTINE HAS BEEN REWRITTEN. AS A RESULT, FOCAL / NOW TRUNCATES OUTPUT TO THE DESIRED FORMAT, RATHER THAN ROUNDING. / THE FOR COMMAND HAS BEEN ENHANCED TO HANDLE NEGATIVE INCREMENT / VALUES CORRECTLY AND TO YEILD A DIVISION BY ZERO MESSAGE WHEN AN / ATTEMPT IS MADE TO LOOP WITH AN INCREMENT OF ZERO. NOTE ALSO / THAT FOCAL WILL NO LONGER LOOP AT LEAST ONCE, EVEN IF THE INITIAL / VALUE IS BEYOND THE LIMIT. FOR EXAMPLE, 'FOR I=2,-1,3; DO 2' / WILL NOT DO GROUP 2 AT ALL IN THIS VERSION OF FOCAL. THIS IS / USUALLY MORE CONVENIENT TO THE USER THAN AUTOMATICALLY LOOPING. / PARENTHESIS ARE NO LONGER NEEDED AROUND THE EXPRESSION IN 'IF' COMMANDS, / BUT THE EXPRESSION WILL NEED TO BE TERMINATED. A COMMA MAY BE USED / FOR THIS IF NECESSARY. / EXPRESSIONS ARE NOW ALLOWED ANYWHERE A LINE NUMBER IS EXPECTED, AS / IN 'GOTO X+Y', 'DO J', AND 'IF (A-B)B,C,D'. THE LETTER A, HOWEVER, / MUST NOT BE THE FIRST LETTER OF ARGUMENTS TO REASE COMMANDS, UNLESS / IT IS DESIRED TO REASE THE WHOLE PROGRAM. NOTE THAT ONLY IN ERASE / COMMANDS IS THE LETTER 'A' RESERVED TO MEAN ALL, AND THAT COMMANDS / SUCH AS 'WRITE ALL', 'DO ALL', ETC. SHOULD NOW BE GIVAN AS / SIMPLY 'WRITE', 'DO', ETC. / THE FLOATING POINT DECIMAL INPUT ROUTINE HAS BEEN REWRITTEN, RESULTING / IN FASTER INTERPRETATION OF NUMERIC CONSTANTS IN EXPRESSIONS AND / RESPONSES TO ASK COMMANDS. ALSO, NOTE THAT THE RESULT DOES NOT APPEAR / IN THE FLOATING ACCUMULATOR, BUT RATHER IN THE HOLD AREA 'DUMMY'. / THIS WAS DONE AS PART OF THE INTERPRETIVE ASK STATEMENT MODIFICATIONS. / COLONS AND EQUAL SIGNS ARE NO LONGER PRINTED BY THE ASK AND TYPE / COMMANDS, MAKING IT NECESSARY FOR THE USER TO INCLUDE PRINTING / CHARACTERS IN QUOTES OR USE TRACE MODE TO GET DESIRED LABELS / INCLUDED IN HIS OUTPUT. / THE SYNTAX 'SET A,B,C(2),ETC=(EXPRESSION) IS NOW VALID, ALLOWING / EASIER INITIALIZATION OF MANY VARIABLES TO THE SAME VALUE. / THIS IS ALSO ALLOWED IN FOR STATEMENTS, AS IN 'FOR I,J,K=1,10;DO 2' / WHICH WILL CAUSE I, J, AND K TO BE SET EQUAL TO ONE, THEN THE / VARIABLE 'I' WILL BE STEPPED FROM ONE TO TEN. / ESCAPE AND FORM FEED HAVE BEEN ADDED TO THE LIST OF CHARACTERS / WHICH DO NOT ECHO WHEN TYPED IN, SO THAT USERS OF THINGS OTHER / THAN TELETYPES (DECWRITERS, VT-50S, ETC.) WILL NOT ENCOUNTER / SURPRIZES WHEN TYPING IN THESE CHARACTERS. / THE MODIFY COMMAND HAS BEEN EXPANDED TO ALLOW AN OPTIONAL SECOND / PARAMETER, WHICH WILL BECOME THE NEW LINE NUMBER FOR THE EDITED / LINE. FOR EXAMPLE, 'MOVE 1.1,1.2' WILL MODIFY LINE 1.1 AS USUAL, / BUT THE RESULT WILL BE STORED AS LINE 1.2. / THE CONTROL TABLES WHICH GOVERN ARITHMETIC PRIORITY, THE TYPE / COMMAND, AND TERMINATION HAVE BEEN MERGED FOR BETTER STORAGE / ECONOMY AND CONVENIENCE. TO THE USER, THE MOST SIGNIFICANT RESULT / OF THIS CHANGE IS THAT SPACES AND COMMAS ARE NOW NEEDED ONLY TO / SEPERATE VARIABLE NAMES AND NUMBERS, AS IN 'TYPE A,3B,L' WHICH / WITHOUT THE COMMAS WOULD TYPE VARIABLE A3. / THE COMMAND INTERPRETER HAS BEEN MODIFIED TO ACCEPT ALL RESERVED / CHARACTERS AS KEYWORD DELIMITERS, ALLOWING MOST COMMANDS TO DO / WITHOUT THE SPACE SEPERATING THEM FROM THEIR PARAMETERS. / THE OVERHEAD INVOLVED WITH FOR COMMANDS HAS BEEN CUT NEARLY IN / HALF, RESULTIN IN A SLIGHT SPEED GAIN. / A 'BRANCH' COMMAND HAS BEEN ADDED WHICH IS IDENTICAL TO THE 'IF' / COMMAND EXCEPT THAT 'DO' TRANSFERS ARE PERFORMED INSTEAD OF GOTO. / A COLON FOLLOWED BY AN EXPRESSION IN AN ASK IR TYPE STATEMENT WILL / PRODUCE A TABULATION TO THE INDICATED COLUMN. IF THE EXPRESSION IS / NEGATIVE, ZERO, OR ONE, A TABULATION TO THE LEFT MARGIN WILL OCCUR, / AND IF THE CARRIAGE IS BEYOND THE COLUMN REQUESTED A RETURN WITHOUT / A LINE FEED WILL BE PRINTED AND THE CORRECT TABULATION WILL OCCUR. / THE VARIABLE SEARCH ROUTINE HAS BEEN ENHANCED FOR BETTER SPEED / AND STORAGE ECONOMY. / FOR THOSE WRITING THEIR OWN FUNCTIONS OR PLANNING TO MODIFY INTERNAL / ROUTINES, A NEW LOCATION, 'FARGSW' IS SET TO 7777 WHENEVER A / FUNCTION IS CALLED WITHOUT AN ARGUMENT. ALSO NOTE THAT THIS LOCATION / IS NOT SAVE BY 'EVAL', SO THAT FUNCTIONS THAT HAVE MORE THAN / ONE ARGUMENT SHOULD CLEAR THIS LOCATION BEFORE TAKING THE STANDARD / RETURN. / ALSO OF INTEREST TO THOS WRITING MULTIPLE ARGUMENT FUNCTIONS, THERE / IS NOW A SUBROUTINE (COMMAC) CALLED BY 'JMS I PCOMMA', WHICH WILL / SKIP IF LOCATION 'CHAR' CONTAINS A COMMOA, AND IF SO WILL DECODE / THE NEXT CHARACTER. / THE IF AND BRANCH COMMANDS NOW HAVE A RELATIONAL FORMAT. THE STATEMENT / 'IF A=B COMMANDS' WILL EXECUTE ALL THE COMMANDS FOLLOWING THE IF ONLY / WHEN A=B. IF THE CONDITION IS NOT MET THE LINE IS TERMINATED, AND / EXECUTION WILL RESUME AS USUAL. NOTE THAT THE COMMAND 'IF A< / MAY BE COMBINED IN ANY QUANTITY AND ORDER. AND EACH WO;; BE TESTED / IN SEQUENCE AND THE REST OF THE LINE EXECUTED IF THE CONDITION IS TRUE. / AS A CONSEQUENCE OF THE ABOVE ADDITION, THE CHARACTERS < AND > / ARE NO LONGER VALID AS PARENTHESIS EQUIVALENTS. / THE SINGLE QUOTE MARK HAS BEEN ADDED TO THE TYPE AND ASK COMMANDS / AND PERFORMS IN EXACTLY THE SAME MANNER AS THE DOUBLE QUOTE MARK. / A NEW INTEGER PART ROUTINE HAS BEEN INCLUDED TO INCREASE SPEED / AND STORAGE ECONOMY, AND TO ELIMINATE CERTAIN ROUNDING ERRORS / COMMON IN MANY VERSIONS OF FOCAL. / THE ASK COMMAND HAS BEEN ENHANCED TO ACCEPT EXPRESSIONS INSTEAD OF / JUST NUMBERS. AS A RESULT, LETTERS MAY NO LONGER BE TREATED AS DIGITS / IN A NUMERIC QUANTITY. NOTE THAT ESCAPE AND ARROW WORK NORMALLY, / AND THAT LEADING SPACES ARE IGNORED, BUT TRAILING SPACES TERMINATE. / FOR EXAMPLE ' 3' HAS NOT BEEN TERMINATED, BUT '3 ' HAS, AND '3+ 4' / IS A VALID RESPONSE, BUT '3 +4' IS NOT. / A 'LINE FEED ECHO' FEATURE HAS BEEN ADDED WHICH WILL ECHO THE CURRENT / LINE UP TO THE LAST CHARACTER STORED, UNLESS THE PRINTER IS AT / COLUMN ONE. THIS ALLOWS ONE TO EXAMINE A LINE WHICH HAS BEEN CORRECTED / BY USE OF ARROW AND RUBOUTS TO SEE IF IT IS CORRECT. NOTE THAT THIS / FEATURE IS INACTIVE IN COLUMN ONE, ALLOWING TAPES WITH LINE FEEDS TO / BE READ IN ON LINE. / FOCAL NO LONGER PRINTS ?00.00 WHEN MANUALLY RESTARTED, BUT SIMPLY STARTS / OUT IN COMMAND MODE. / A QUOTATION MARK MAY NOW BE PRINTED IN TYPE OR ASK COMMAND STRINGS / BY PLACING IT INSIDE QUOTES FOLLOWED IMMEDIATELY BY ANOTHER QUITE. / THE SECOND OF THESE TWO QUOTATION MARKS WILL BE PRINTED AND FOCAL / WILL REMAIN IN QUOTE MODE, AS IN "TYPE 'THIS''L BE THE DAY'". / A GREATER THAN SIGN MAY NOW BE PLACED IN ASK AND TYPE STATEMENTS / TO PRODUCE A LINE-FEED WITHOUT A CARRIAGE RETURN. / A 'FTST' FUNCTION HAS BEEN ADDED WHICH WILL RETURN A NEGATIVE ONE / IF NO KEY HAS BEEN STRUCK, OR THE FIN/FOUT CODE OF THE CHARACTER, / IF ONE HAS BEEN TYPED. THE CHARACTER IS NOT DESTROYED, AND SO IS / AVAILABLE FOR FIN OR ASK COMMANDS. / A FULLY DEBUGGED ZERO VARIABLE REPLACEMENT FEATURE HAS NOW BEEN / ADDED TO FOCAL, ALLOWING MUCH MORE EFFICIENT UTILIZATION OF THE / AVAILABLE VARIABLE STORAGE. THOSE WRITIN INTERNAL ROUTINES SHOULD / NOTE THE SUBROUTINE 'NOZVR', CALLED BY 'JMS I PNOZVR', WHICH DISABLES / ZERO VARIABLE REPLACEMENT ON THE CURRENT VARIABLE. NOTE THAT THIS / VERSION OF FOCAL WILL REPLACE ALL ZERO VARIABLES BEFORE A / NEW VARIABLE IS CREATED, THUS KEEPING THE SYMBOL TABLE AS SMALL / AS POSSIBLE AND LEAVING AS MUCH ROOM AS POSSIBLE FOR MORE VARIABLES / OR STACK. / AN 'XECUTE' COMMAND HAS BEEN ADDED, ALLOWING ONE TO EXECUTE FUNCTION / CALLS WITHOUT STORING THE RESULTS. ANY NUMBER OF ARITHMETIC / EXPRESSIONS MAY FOLLOW THE 'X', AND EACH WILL BE EVALUATED AN THE / RESULT IGNORED. FOR EXAMPLE, 'XECUTE FOUT(141)FOUT(138)' WILL PRINT / A RETURN-LINE-FEED SEQUENCE, AND 'X FIN FIN FIN' WILL / INPUT AND IGNORE THREE CHARACTERS FROM THE TERMINAL. / A 'HEADING' COMMAND HAS BEEN ADDED TO ALLOW ALTERATION OF THE / HEADING LINE. THE FORMAT IS SIMPLY THE WORD 'HEADING' OR ANY / OF IT'S ABBREVIATIONS, A SPACE, AND THE DESIRED HEADING. THE / NEW HEADING WILL REPLACE THE OLD, FOCAL WILL ERASE ALL, RESET THE / OUTPUT FORMAT TO %8.04, AND RETURN TO COMMAND MODE. NOTE THAT THE / HEADING SHOULD BE A COMMENT OR DO-NOTHING COMMAND, AS FOCAL WILL / EXECUTE IT BEFORE RUNNING THE USER PROGRAM IN RESPONSE TO A 'GO' / COMMAND. / A 'KLEAR' COMMAND HAS BEEN ADDED WHICH REMOVES ALL ACTIVE 'FOR' OR / 'DO' COMMANDS AND PROCEEDS WITH EXECUTION AS IF THE USER HAD JUST / TYPED A 'GOTO' COMMAND TO THE CURRENT PROGRAM STEP. THIS PROVIDES / A MEANS OF ESCAPING 'DO' AND 'FOR' COMMANDS, WHICH IS NOT POSSIBLE / WITH OTHER VERSIONS OF FOCAL. / A 'ZERO' COMMAND HAS BEEN ADDED WHICH WILL ERASE THE VARIABLE TABLE / OR SET SELECTED VARIABLES TO ZERO. THIS TAKES THE PLACE OF 'ERASE' / IN OTHER VERSIONS OF FOCAL. A LIST OF VARIABLES MAY BE ZEROED AT / ONCE, AS IN 'ZERO A,B,C', OR THE VARIABLE TABLE MAY BE CLEARED BY / 'ZERO'. NOTE THAT 'ZERO' WITH NO ARGUMENTS DOES AN AUTOMATIC 'KLEAR', / PREVENTING IT'S USE IN SUBROUTINES OR 'FOR' LOOPS. / MANY POINTERS TO USEFUL ROUTINES ARE NOW AVAILABLE ON PAGE ZERO. / USERS CODING THEIR OWN FUNCTIONS OR MODIFYING INTERNAL ROUTINES / MAY WANT TO USE THESE POINTERS RATHER THAN CREATING THEIR OWN. / A 'FIND' FUNCTION HAS BEEN ADDED WHICH WILL INPUT AND ECHO / CHARACTERS UP TO BUT NOT INCLUDING THE CHARACTER WHOSE FIN/FOUT / CODE, WHICH WILL BE IGNORED. THIS FUNCTION IS USED TO RAPIDLY / COPY TAPES AND TO IGNORE PORTIONS OF INPUT. / THE DO COMMAND NOW ACCEPTS MULTIPLE PARAMETERS, AS IN 'DO 3,1.1', / WHICH WILL DO ALL LINES IN GROUP 3, THEN DO LINE 1.1. NOTE THAT / THE PARAMETERS MAY ONLY BE SEPARATED BY A COMMA. / PATCHES TO FOCAL 1976 / THE FOLLOWING PATCHES MAY BE IMPLEMENTED AT THE USER'S OPTION TO / PROVIDE COMPATIBILITY WITH OTHER VERSIONS OF FOCAL. THEY MAY BE / IMPLEMENTET VIA ODT AS SHOWN, OR THE EQUIVALENT SWITCH MODIFICATIONS / MAY BE PERFORMED. EACH MODIFICATION MAY BE REVERSED BY RESTORING / THE CONTENTS OF THE AFFECTED LOCATIONS. / AUTOMATIC ECHO OF FIN CHARACTERS: / .GET SYS:FOCAL / .ODT / 3011/4467 4550 / ^C (TYPE CONTROL C) / .SAVE SYS:FOCAL / AUTOMATIC LINE FEED WHEN FOUT RECEIVES A RETURN: / .GET SYS:FOCAL / .ODT / 3026/4466 4547 / ^C (TYPE CONTROL C) / .SAVE SYS:FOCAL / TO SEND OUTPUT TO LINE PRINTER: (INSTALL BEFORE RUNNING DIALOG) / .GET SYS:FOCAL / .ODT / 4200/6046 6666 / 1362/6041 6661 / 1364/6046 6666 / ^C (TYPE CONTROL C) / .SAVE SYS:FOCAL / TO USE FOCAL'S 'L' COMMAND ON NONDISK SYSTEMS: / CHANGE LOCATION 6111 FROM 5512 TO 5177 / ACKNOWLEDGEMENTS: / THE AUTHOR EXTENDS HIS THANKS TO EACH OF THE FOLLOWING GROUPS OR / INDIVIDUALS FOR HELP IN BRINGING ABOUT FOCAL 1976. / RICK MERRILL, FOR WRITING THE ORIGINAL FOCAL AND SUPPLYING / MANY OF THE BASIC ALGORITHMS. / ROBERT S. JAQUISS, COMPUTER SCIENCE INSTRUCTOR AT NORTH / SALEM HIGH SCHOOL, FOR GETTING ME STARTED WITH COMPUTERS / AND HELPING ME GET TIME ON THE COMPUTER DURENG THE EVENINGS / AND THE SUMMER. / EDWARD a TAFT iii, FOR THE INTEGER PART AND RANDOM NUMBER / ROUTINES, ADAPTED FROM FOCAL8-43. / THE OREGON MUSEUM OF SCIENCE AND INDUSTRY, FOR THE COMPUTED / LINE NUMBER ALTERATION AND SOME IMPROVEMENTS TO THE VARIABLE / SEEK ROUTINE. / WILLIAM F. FERGUSON, FOR HIS SUPPORT AND LISTENING EAR / OVER THE LAST TWO MONTHS, AND HIS AID IN THE DISASSEMBLY / OF THE PORTIONS OF FOCAL DEALING WITH FLOATING POINT / ARITHMETIC. / OTHERS WHO HAVE REVISED FOCAL IN THE PAST, FOR THEIR IDEAS / FOR IMPROVEMENTS TO FOCAL. *0 /PAGE ZERO P13, 13 /HANDY CONSTANT C77, 77 /HANDY MASK C177, 177 /HANDY MASK C200, 200 /HANDY MASK AND CONSTANT PINTRO, INTRO /POINTER TO INTRODUCTORY DIALOG *7 /MORE PAGE ZERO FPP, FLTPKG /POINTER TO FLOATING POINT INTERPRETER PUTPTR, .-. /TEXT ENCODE POINTER QCKPTR, .-. /GENERAL PURPOSE AUTOINDEX LOC. WRKPTR, .-. /GENERAL PURPOSE AUTOINDEX LOC. PDLPTR, BOTTOM /STACK POINTER bugbug: mismatch FPPTR2, .-. /POINTER FOR FPP USE FPPTR1, .-. /POINTER FOR FPP USE N4, -4 /HANDY CONSTANT GETPTR, L01V30+1 /TEXT DECODE POINTER GETSDE, 0 /WHICH SIDE TO DECODE FROM GETWRK, .-. /SAVE AREA FOR UNPACK PC, .-. /POINTER TO CURRENT LINE NEWPC, .-. /POINTER TO NEW LINE NEWOPR, .-. /NEW OPERATOR SAVE AREA (EQUATION SOLVER) OLDPC, .-. /POINTER TO PREVIOUS LINE QUOTSW, .-. /TEXT IN QUOTES SWITCH PUTBEG, .-. /BEGINNING OF LINE (RUBOUT HANDLER) POINT1, .-. /GENERAL PURPOAE POINTER VAREND, FREEBF /POINTER TO END OF VARIABLE AREA SAVE1, .-. /GENERAL PURPOSE SAVE AREA POWER, .-. /POWER OF TEN, USED BY NUMBER PRINT & INTERPRET ROUTINES N10, -10 /DECIMAL NEGATIVE EIGHT, USED BY EQUATION SOLVER N12, -12 /NEGATIVE TEN, DECIMAL BOTTMP, BOTTOM /LAST ADDRESS OF BUFFER SPACE bugbug: mismatch INSW, 0 /INPUT FROM TEXT OR KEYBOARD SWITCH FARGSW, .-. /ARGUMENT SUPPLIED TO FUNCTION SWITCH OPEXP, .-. /FLOATING OPERAND OPHGH, .-. OPMED, .-. OPLOW, .-. FACEXP, .-. /FLOATING ACCUMULATOR FACHGH, .-. FACMED, .-. FACLOW, .-. FACOVR, .-. /OVERFLOW AREA FOR FAC SIGNSW, .-. /SWITCH INDICATING THE SIGN OF NUMBERS NEGATE, NEGF /POINTER TO ROUTINE TO NEGATE FAC FORM, .-. /FORMAT CONTROL WORD FIX, INTEGR /POINTER TO INTEGER PART ROUTINE SORTWK, .-. /SAVE AREA FOR SORT ROUTINES OLDOPR, .-. /HOLD AREA FOR OLD OPERATOR IN EQUATION SOLVER ASKTYP, .-. /ASK/TYPE SWITCH TABCTR, .-. /COUNTER OF COLUMNS PRINTED COUNTR, .-. /GENERAL PURPOSE COUNTER LOCATION TXTEND, FREEBF /LAST LOCATION OF PROGRAM, FIRST FOR VARIABLES PUTWRK, .-. /WORK AREA FOR ENCODE ROUTINE PUTSDE, .-. /WHICH SIDE TO ENCODE IN TYP, IOFOUT /POINTER TO ACTIVE PRINT CHAR ROUTINE INCHAR, IOFIN /POINTER TO ACTIVE INPUT CHARACTER ROUTINE ARGSW, .-. /SWITCHES PERTAINING TO LINENO CHAR, 215 /CHARACTER BEING PROCESSED LINENO, .-. /LINE NUMBER BEING PROCESSED VARLEN, 5 /LENGTH OF FLOATING POINT VARIABLES WORK, .-. /WORK AREA MODIFC, 214 /FORM FEED 207 /BELL CODE IMMED, 203 /CONTROL/C 337 /BACK ARROW LF, 212 /LINE FEED CR, 215 /CARRIAGE RETURN TRCESW, C77 /TRACE MODE SWITCH N20, -20 /NEGATIVE 20 N100, -100 /OCTAL NEGATIVE 100 OR MASK OF 7700 N305, -305 /NEGATIVE ASCII "E" C17, 17 /HANDY MASK C140, 140 /CASE BITS MASK C240, 240 /SPACE C7600, 7600 /HANDY MASK, POINTER TO MONITOR DOT, 256 /DECIMAL POINT QUEST, 277 /QUESTION MARK N2, -2 /HANDY CONSTANT N301, -301 /NEGATIVE ASCII "A" C260, 260 /ASCII ZERO N240, -240 /NEGATIVE ASCII SPACE N256, -256 /NEGATIVE ASCII DECIMAL POINT NCR, -215 /NEGATIVE ASCII CARRIAGE RETURN FACLEN, -3 /NEGATIVE LENGTH OF THE FLOATING AC N5, -5 /DECIMAL NEGATIVE FIVE PDUMMY, DUMMY /POINTER TO SYSTEM VARIABLE DOUBLE, FACLFT /POINTER TO SHIFT FAC ONE LEFT ROUTINE TYPFAC, FACTYP /POINTER TO FLOATING POINT OUTPUT ROUTINE FACIN, FACINP /POINTER TO FLOATING POINT NUMBER INTERPRETER SCRTCH, SCRBUF /POINTER TO SCRATCH BUFFER TXTBEG, TEXTST /POINTER TO BEGINNING OF TEXT BUFBEG, STTEXT /POINTER TO BEGINNING OF TEXT AREA FNCXIT, FNCDNE /POINTER TO FUNCTION RETURN ROUTINE PZERO, ZERO /POINTER TO FLOATING POINT ZERO PUSHJ, PUSHPC /POINTER TO RECURSIVE CALL HANDLER LINEND, ENDLIN /POINTER TO LINE FINISHED ROUTINE PUSHA, PUSHAC /POINTER TO STACK ACCUMULATOR PUSHF, PUSHFC /POINTER TO STACK FLOATING POINT POPF, POPFAC /POINTER TO RETRIEVE STACKED FLOATING POINT DECODE, UNPACK /POINTER TO TEXT DECOMPRESSION ROUTINE ENCODE, PACK /POINTER TO TEXT COMPRESSION ROUTINE TABSCH, SCHTAB /POINTER TO LOOK UP AND GO ROUTINE CHECK, SPECHK /POINTER TO TABLE CHECK ROUTINE PRTCL, TYPCHK /POINTER TO PRINT WITH AUTO LF ROUTINE INPUT, INPRT /POINTER TO INPUT AND ECHO ROUTINE ARGOUT, OUTARG /POINTER TO LINE NUMBER PRINT ROUTINE GETARG, ARGGET /POINTER TO ARGUMENT INTERPRETER FNDLIN, LINFND /POINTER TO LINE SEEK ROUTINE NEWLIN, LINNEW /POINTER TO PUT NEW LINE IN TEXT BUFFER ROUTINE ROT6, R6L /POINTER TO SHIFT AC LEFT 6 ROUTINE KLSPCE, SPNOR /POINTER TO IGNORE SPACES ROUTINE SRTNUM, NUMSRT /POINTER TO ROUTINE TO CHECK FOR ".", 0-9, OR ALPHA PRNCHK, CHKPRN /POINTER TO LEFT PREN CHECK ROUTINE GRPTST, SKPGRP /POINTER TO SKIP IF AC IN CURRENT GROUP ROUTINE SRTFUN, FUNSRT /ROUTINE TO CHECK FOR OPERATOR, 0-9, F OR OTHER DELETE, ERALIN /POINTER TO ERASE LINE ROUTINE ERROR, OOPS /POINTER TO ERROR HANDLER GETCHR, CHRGET /POINTER TO GET CHARACTER ROUTINE PNORML, NORMAL /POINTER TO NORMALIZE ROUTINE PABS, ABS /POINTER TO ABSOLUTE VALUE ROUTINE PUNABS, UNABS /POINTER TO RESTORE SIGN ROUTINE PFACRT, FACRT /POINTER TO SHIFT FAC ONE RIGHT ROUTINE PSUM, SUM /POINTER TO ADD FAC AND OPERAND ROUTINE POPRT, OPRGHT /POINTER TO SHIFT OPERAND ONE RIGHT ROUTINE PCOMMA, COMMAC /POINTER TO SKIP-IF-COMMA ROUTINE PNOZVR, NOZVR /POINTER TO DISABLE ZVR ROUTINE PEXEC, EXEC /POINTER TO COMMAND INTERPRETER START, SKP CLA /SKIP TLS, RESTART FOCAL *0200 /FOCAL MAINLINE, R6L, AND POPA ROUTINES FOCAL, JMP I PINTRO /START INTRODUCTORY DIALOG DCA INSW /SET INPUT FROM BUFFER SWITCH TAD PZERO /GET POINTER TO FLOATING ZERO DCA PC /STORE DUMMY POINTER TO CURRENT LINE IAC /GET ONE IN AC DCA TRCESW /SET "NO TRACE" SWITCH DCA QUOTSW /CLEAR QUOTE FLAG TAD SCRLIM /GET UPPER BOUND FOR SCRATCH BUFFER (+SAFETY) DCA PDLPTR /STORE IN STACK POINTER TO STOP ENCODING TAD N100 /GET READY SIGNAL JMS I PRTCL /PRINT ON TTY SCRAP, TAD SCRTCH /GET POINTER TO SCRATCH BUFFER DCA PUTPTR /STORE IN TEXT ENCODE POINTER DCA PUTSDE /PREPARE TO ENCODE ON LEFT SIDE TAD SCRTCH /GET POINTER TO SCRATCH BUFFER DCA PUTBEG /SET UP AS BEGINNING OF LINE GTCHR, JMS I INPUT /GET CHARACTER FROM KEYBOARD JMS I TABSCH /DO LOOKUP AND GO AMONG IMMED-1 /CHARACTERS FOR IMMEDIATE ACTION IMMDGO-IMMED /POINT TO ADDRESS TABLE IF SUCESSFUL JMS I ENCODE /PUT CHAR IN SCRATCH BUFFER JMP GTCHR /GO GET NEXT CHARACTER SCRLIM, SCRBUF+13+45 /UPPER BOUND FOR SCRATCH BUFFER LFECHO, CLA CMA /GET NEGATIVE ONE TAD TABCTR /ADD TO COLUMN NUMBER SNA CLA /IN COLUMN ONE? JMP GTCHR /YES, IGNORE IT ISZ QUOTSW /INHIBIT TRACE TAD PUTPTR /GET ENCODE POINTER DCA WRKPTR /MOVE TO RUINABLE LOCATION TAD PUTSDE /GET SIDE INDICATOR SNA CLA /ANYTHING IN PUTWRK? JMP .+3 /NO, GO AHEAD TAD PUTWRK /YES, GET WORK AREA DCA I WRKPTR /ENCODE TAD SCRTCH /NO, GET START OF SCRATCH AREA DCA GETPTR /PREPARE TO DECODE DCA GETSDE /FROM THE LEFT SIDE TAD CR /GET RETURN JMS I PRTCL /PRINT CRLF TAD N100 /GET READY SIGNAL LFLOOP, JMS I PRTCL /PRINT CHARACTER TAD GETPTR /GET DECODE POINTER CIA /NEGATE TAD WRKPTR /SUBTRACT FROM ENCODE POINTER SZA CLA /EQUAL? JMP LFTYPE /NO, GET NEXT CHARACTER TAD GETSDE /GET RIGHT/LEFT SWITCH CIA /NEGATE TAD PUTSDE /COMPARE TO OTHER RIGHT/LEFT SW SNA CLA /DONE TYPING? JMP GTCHR /YES, GO INPUT REST OF LINE LFTYPE, JMS I DECODE /GET CHARACTER JMP LFLOOP /GO TYPE IT CARRET, JMS I ENCODE /PUT CR INTO BUFFER JMS I ENCODE /PUT CR INTO BUFFER AGAIN TO BE SURE TAD SCRTCH /GET POINTER TO SCRATCH BUFFER DOIT, DCA GETPTR /STORE IN TEXT DECODE POINTER DCA GETSDE /SET UP FOR LEFT HALFWORD JMS I DECODE /GET CHARACTER FROM BUFFER KLEAR, TAD BOTTMP /GET LAST FREE ADDRESS DCA PDLPTR /STORE IN STACK POINTER JMS I KLSPCE /IGNORE SPACES JMS I SRTNUM /CHECK WHETHER '.', 0-9. OR ALPHA JMS I ERROR /LINE NUMBER STARTED WITH PERIOD JMP DIRECT /DIRECT COMMAND IF FIRST CHAR ALPHA ISZ QUOTSW /INHIBIT TRACE JMS I GETARG /INTERPRET LInE NUMBER CLA CLL CML RAR /GET 4000 IN AC TAD ARGSW /ADD IN LINE NUMBER SWITCHES SZA CLA /LINE NUMBER GOT BOTH GROUP AND FRACTION? JMS I ERROR /NO, GO TO ERROR ROUTINE TAD TXTEND /YES, GET POINTER TO END OF TEXT BUFFER DCA PUTPTR /STORE IN TEXT ENCODE POINTER DCA PUTSDE /PREPARE TO ENCODE ON LEFT SIDE TAD LINENO /GET LINE NUMBER DCA I PUTPTR /STORE IN BUFFER SKP /FIRST CHARACTER ALREADY DECODED MOVELP, JMS I DECODE /GET CHARACTER FROM TEMPORARY BUFFER JMS I ENCODE /PUT CHARACTER INTO TEXT BUFFER TAD CHAR /GET CHARACTER TAD NCR /SUBTRACT CARRIAGE-RETURN SZA CLA /WAS CHARACTER A RETURN? JMP MOVELP /NO, MOVE ANOTHER CHARACTER INTO TEXT BUFFER JMS I DELETE /REMOVE COPY, IF ANY JMS I NEWLIN /ENTER NEW LINE IN TEXT BUFFER JMP START /RETURN TO COMMAND MODE DIRECT, JMS I PUSHJ /RECURSIVE CALL EXEC /EXECUTE COMMAND ROUTINE TAD I PC /GET ADDRESS OF NEXT LINE SNA /DONE? JMP START /YES, RETURN TO COMMAND MODE DCA PC /NO, STORE POINTER TO START OF NEXT LINE TAD PC /GET POINTER TO NEW LINE IAC /ADD ONE TO SKIP LINE NUMBER JMP DOIT /GO EXECUTE NEXT LINE R6L, .-. /ROUTINE TO SHIFT AC 6 LEFT CLL RTL /SHIFT 2 LEFT RTL /SHIFT 2 MORE RTL /SHIFT 2 MORE JMP I R6L /RETURN POPFAC, .-. /ROUTINE TO POP FLOATING POINT NUMBERS OFF STACK CLA CMA /GET NEGATIVE ONE TAD I POPFAC /GET ADDRESS TO POP INTO ISZ POPFAC /SKIP PARM UPON RETURN DCA QCKPTR /STORE IN DESIGNATED AREA TAD I PDLPTR /GET FIRST WORD FROM STACK DCA I QCKPTR /STORE IN DESIGNATED AREA TAD I PDLPTR /GET ENTRY FROM STACK DCA I QCKPTR /STORE IN PROPER LOCATION TAD I PDLPTR /GET WORD FROM STACK DCA I QCKPTR /STORE IN PROPER LOCATION JMP I POPFAC /RETURN FUNCGO, FABS /FUNCTION ADDRESS TABLE FSGN FITR FIN FRAN FOUT FTST FIND FMQ DELFUN, 0000/FATN /bugbug:mismatch 0000/FEXP /bugbug:mismatch 0000/FLOG /bugbug:mismatch FCOS FSIN FSQT *400 /DO COMMAND, GETARG, STACK MAINTENANCE ROUTINES SAVEXP ARGGET, .-. /ROUTINE TO INTERPRET LINE NUMBERS JMS I PUSHJ /DO RECURSIVE CALL EVAL /TO EQUATION SOLVER JMS I FIX /FIC FLOATIN AC (ISOLATE GROUP NUMBER) AND C77 /TAKE MODULO 32 JMS I ROT6 /MOVE RESULT TO HIGH ORDER BITS RAL /TO FORM GROUP PORTION DCA LINENO /STORE GROUP NUMBER JMS I NEGATE /NEGATE FLOATING AC JMS I FPP /ENTER FLOATING POINT FADD I PDUMMY /ISOLATE FRATION IN FAC FMPY FL100 /MULTIPLY BY 100 FADD FLP5 /ADD .5 TO ROUND FEXT /RETURN TO NORMAL MODE JMS I FIX /FIX FLOATING AC (ISOLATE FRACTION) TAD LINENO /ADD TO GROUP NUMBER DCA LINENO /STORE UPDATED RESULT CLL /SET FUTURE AC11 (GROUP SW) TAD LINENO /GET LINE NUMBER AND C7600 /ISOLATE GROUP BITS SZA CLA /GROUP ZERO? CML /NO, CLEAR FUTURE AC11 (GROUP SW) TAD LINENO /GET LINE NUMBER AND C177 /MASK FOR FRACTION SZA SNL /FRACTION WITHOUT GROUP? JMS I ERROR /YES, INVALID LINE NUMBER SZA CLA /NO, ANY FRACTION AT ALL? TAD C2000 /YES, SET FUTURE AC0 (FRACTION SW) CML RAL /FORM SWITCH WORD DCA ARGSW /STORE SWITCHES PERTAINING TO LINENO JMP I ARGGET /RETURN FL100, 7 /FLOATING POINT CONSTANT OF 100 3100 FLP5, 0 /FLOATING POINT CONSTANT OF 1/2 (FOR ROUNDING) C2000, 2000 0 DO, JMS I GETARG /INTERPRET ARGUMENT TAD PC /GET POINTER TO CURRENT LINE JMS I PUSHA /PUT ON STACK JMS I PUSHF /PUSH GETPTR /DECODE WORK AREA DOMORE, JMS I PUSHF /PUSH ARGSW /CURRENT CHARACTER, CURRENT LINE NUMBER TAD ARGSW /GET LINE NUMBER SWITCHES SPA CLA /GROUP DO? JMP DOONE /NO, ONLY DO ONE LINE JMS I FNDLIN /SEEK LINE TO BE PERFORMED NOP /HERE BECAUSE GROUP SEEK TAKES 'NOT FOUND' RETURN TAD NEWPC /GET POINTER TO NEW LINE DCA QCKPTR /PREPARE TO GET LINE NUMBER TAD I QCKPTR /GET NEW LINE NUMBER JMS I GRPTST /IN SAME GROUP? JMS I ERROR /NO, GO TO ERROR ROUTINE JMS I PUSHJ /RECURSIVE CALL GOTO /TO GOTO AND EXECUTE THE LINE JMS I POPF /UNSTACK ARGSW /CURRENT CHARACTER, LINE NUMBER TAD I PC /GET POINTER TO NEXT LINE SNA /IS THIS THE LAST LINE? JMP DODONE /YES, DONE DOING IAC /NO, ADD ONE TO POINT TO LINE NUMBER DCA POINT1 /STORE IN POINTER LOCATION TAD ARGSW /GET LINE NUMBER SWITCHES SZA SMA CLA /DO ALL? JMP YESDO /YES, GO AHEAD AND DO NEXT LINE TAD I POINT1 /NO, GET LINE NUMBER JMS I GRPTST /IN SAME GROUP? JMP DODONE /NO, DONE DOING YESDO, TAD I POINT1 /GET NEW LINE NUMBER DCA LINENO /STORE AS LINE BEING WORKED WITH JMP DOMORE /GO DO THIS LINE TOO DOONE, JMS I FNDLIN /SEEK LINE TO BE PERFORMED JMS I ERROR /LINE NOT FOUND, GO TO ERROR ROUTINE JMS I PUSHJ /RECURSIVE CALL EXEC-1 /TO COMMAND INTERPRETER JMS I POPF /UNSTACK ARGSW /CURRENT CHARACTER, LINE NUMBER DODONE, JMS I POPF /UNSTACK GETPTR /DECODE INFO TAD I PDLPTR /GET ENTRY FROM STACK DCA PC /STORE POINTER TO BEGINNING OF LINE JMS I PCOMMA /CHECK FOR MORE PARAMETERS JMP I PEXEC /NO, GO EXECUTE REST OF LINE JMP DO /YES, GO INTERPRET AND USE THEM PUSHAC, .-. /SUBROUTINE TO STACK THE CURRENT VALUE OF THE AC DCA WORK /SAVE FOR A MOMENT CMA /GET NEGATIVE ONE JMS PDLUP /DECREMENT STACK POINTER TAD WORK /GET ITEM TO BE STACKED DCA I PDLPTR /STORE AC ON STACK CMA /GET NEGATIVE ONE TAD PDLPTR /DECREMENT STACK POINTER DCA PDLPTR /TO RECORD THE ENTRY JMP I PUSHAC /RETURN PDLUP, .-. /MOVE STACK POINTER ROUTINE TAD PDLPTR /ADD STACK POINTER TO AC DCA PDLPTR /STORE UPDATED STACK POINTER TAD PDLPTR /GET NEW STACK POINTER CLL CIA /NEGATE TAD VAREND /ADD POINTER TO END OF VARIABLE TABLE SZL CLA /STACK OVERFLOW? JMS I ERROR /YES, GO TO ERROR ROUTINE JMP I PDLUP /NO, RETURN PUSHPC, .-. /RECURSIVE CALL HANDLER TAD I PUSHPC /GET ADDRESS OF RECURSIVE SUBROUTINE DCA PUSHAC /SAVE FOR LATER RETURN FROM PUSHA TAD PUSHPC /GET ADDRESS FOR RETURN IAC /ADD ONE TO SKIP OVER PARM JMP PUSHAC+1 /GO PUSH RETURN ADDRESS AND GO PUSHFC, .-. /SUBROUTINE TO PUSH FLOATING POINT NUMBERS CLA CMA /GET NEGATIVE ONE TAD I PUSHFC /GET ADDRESS OF NUMBER DCA QCKPTR /STORE ADDRESS OF WORDS TO STACK ISZ PUSHFC /SKIP PARM UPON RETURN TAD FACLEN /GET LENGTH OF FLOATING AC JMS PDLUP /UPDATE STACK POINTER TAD I QCKPTR /GET FIRST WORD TO BE STACKED DCA I PDLPTR /STORE ON STACK TAD I QCKPTR /GET SECOND WORD TO BE STACKED DCA I PDLPTR /STORE ON STACK TAD I QCKPTR /GET THIRD WORD TO BE STACKED DCA I PDLPTR /STORE ON STACK TAD FACLEN /GET LENGTH OF FLOATING AC TAD PDLPTR /UPDATE STACK POINTER DCA PDLPTR /TO PRESERVE ENTRIES JMP I PUSHFC /RETURN COMLST, 323 /SET, STEP *600 /COMMAND INTERPRETER, GOTO, WRITE COMMANDS 306 /FOR 311 /IF 304 /DO 307 /GO, GOTO 303 /COMMENT, CONTINUE 301 /ASK, ACCEPT 324 /TYPE 310 /HELLO, HEADING 313 /KLEAR 314 /LOCATIONS, LIBRARY, LEAVE 305 /ERASE, END 327 /WRITE 315 /MODIFY, MOVE 302 /BRANCH 321 /QUIT 322 /RETURN 326 /VARIABLES 330 /XECUTE 332 /ZERO N306, -306 /NEGATIVE ASCII 'F' GO, JMS I GETARG /INTERPRET ARGUMENT JMS I FNDLIN /SEEK LINE TO BE GONE TO JMS I ERROR /NO SUCH LINE, GO TO ERROR ROUTINE GOTO, TAD NEWPC /GET POINTER TO NEW LINE DCA PC /STORE AS POINTER TO CURRENT LINE JMS I DECODE /DECODE NEXT CHARACTER EXEC, TAD CHAR /GET CHARACTER TAD NCR /SUBTRACT CARRIAGE-RETURN SNA CLA /WAS CHARACTER A RETURN? JMP I LINEND /YES, GO TO NEXT SEQUENTIAL LINE JMS I CHECK /LOOK TO SEE IF IN TERTAB-1 /TABLE OF TERMINATORS JMP EXEC-1 /YES, IGNORE TERMINATOR TAD CHAR /GET CHARACTER JMS I PUSHA /PUT ON STACK JMS I DECODE /GET CHARACTER FROM BUFFER JMS I CHECK /LOOK TO SEE IF IN TABLE TRMTAB-1 /OF ALL TERMINATORS SKP /YES, EXECUTE STACKED COMMAND JMP .-4 /NO, LOOK FOR TERMINATOR TAD I PDLPTR /GET ENTRY FROM STACK JMS I TABSCH /DO LOOKUP AND GO COMLST-1 /POINTER TO COMMAND TABLE-1 COMGO-COMLST /POINT AT COMMAND STARTING ADDRESSES JMS I ERROR /INVALID COMMAND, GO TO ERROR ROUTINE WRITE, JMS I GETARG /INTERPRET ARGUMENT ISZ QUOTSW /FORCE QUOTE MODE WRTELP, JMS I FNDLIN /SEEK LINE TO BE LISTED JMP WRTGRP /NOT FOUND, MUST BE GROUP WRITE TAD LINENO /GET LINE NUMBER SZA CLA /HEADING LINE? JMS I ARGOUT /NO, PRINT LINE NUMBER JMS I DECODE /GET CHARACTER FROM BUFFER JMS I PRTCL /PRINT CHARACTER ON TTY TAD CHAR /GET CHARACTER TAD NCR /SUBTRACT CARRIAGE-RETURN SZA CLA /WAS CHARACTER A RETURN? JMP .-5 /NO, PRINT ANOTHER TAD I NEWPC /GET POINTER WORD OF CURRENT LINE WRTCHK, SNA /ALL LINES WRITTEN? JMP WRTDNE /YES, MUST BE DONE IAC /NO, ADD ONE TO POINT AT LINE NUMBER DCA POINT1 /STORE IN POINTER LOCATION TAD ARGSW /GET LINE NUMBER SWITCHES SMA CLA /GROUP WRITE? TAD I POINT1 /NO, GET LINE NUMBER JMS I GRPTST /IN SAME GROUP? JMP NEWGRP /NO, SEE IF IT SHOULD BE LISTED WRTMRE, TAD I POINT1 /YES, GET NEW LINE NUMBER DCA LINENO /STORE AS LINE BEING WORKED WITH JMP WRTELP /GO LIST THE LINE WRTGRP, TAD NEWPC /GET POINTER TO NEW LINE JMP WRTCHK /CHECK IT OUT WRTDNE, DCA QUOTSW /CLEAR QUOTE FLAG JMP I LINEND /GO EXECUTE NEXT LINE NEWGRP, TAD ARGSW /GET LINE NUMBER SWITCHES SPA SNA CLA /WRITE ALL? JMP WRTDNE /NO, ALL DONE JMS I PRTCL /PRINT RETURN AGAIN JMP WRTMRE /GO WRITE THIS GROUP TOO FUNSRT, .-. /DETERMINE WHETHER OPERATOR, 0-9, 'F', OR OTHER JMS I KLSPCE /IGNORE SPACES JMS I CHECK /LOOK TO SEE IF IN TABLE TRMTAB-1 /OF ARITHMETIC TERMINATORS JMP I FUNSRT /YES, RETURN WITHOUT SKIPPING TAD CHAR /NO, GET CHARACTER ISZ FUNSRT /SKIP AT LEAST ONE WHEN RETURNING TAD N306 /SUBTRACT ASCII 'F' SNA CLA /CHARACTER AN 'F'? JMP FUNSK2 /YES, SKIP TWO AND RETURN JMS I SRTNUM /CHECK WHETHER '.', 0-9, OR ALPHA JMP I FUNSRT /PERIOD, SKIP ONE AND RETURN SKP /ALPHA, SKIP 3 AND RETURN JMP I FUNSRT /NUMERIC, SKIP ONE AND RETURN ISZ FUNSRT /GOING TO SKIP 3 FUNSK2, ISZ FUNSRT /GOING TO SKIP AT LEAST TWO JMP I FUNSRT /RETURN SPECHK, .-. /TABLE SCAN ROUTINE TAD I SPECHK /GET POINTER TO TABLE DCA WRKPTR /SAVE IT CHKLP, TAD I WRKPTR /GET AN ENTRY SPA /IS IT THE DELIMITER? JMP CHKXIT /YES, GO RETURN TO CALLER CIA /NO, NEGATE IT TAD CHAR /SUBTRACT ENTRY FROM CHAR SZA CLA /EQUAL? JMP CHKLP /NO, LOOK AT NEXT ENTRY TAD I SPECHK /YES, GET POINTER TO START OF TABLE-1 CMA /MAKE NEGATIVE POINTER TO TABLE TAD WRKPTR /COMPUTE WHICH ENTRY DCA SORTWK /SAVE FOR CALLER SKP /TAKE 'FOUND IT' RETURN CHKXIT, ISZ SPECHK /TAKE 'NOT FOUND' RETURN ISZ SPECHK /SKIP OVER PARAMETER UPON RETURN CLA CLL /CLEAR GUNK FROM AC JMP I SPECHK /RETURN SKPGRP, .-. /ROUTINE TO SKIP IF AC AND LINENO SAME GROUP AND C7600 /ISOLATE GROUP BITS FROM AC CIA /NEGATE DCA WORK /STORE FOR LATER TAD LINENO /GET CURRENT LINE NUMBER AND C7600 /ISOLATE GROUP BITS TAD WORK /SUBTRACT GROUP BITS FROM AC SNA CLA /SAME GROUP NUMBER? ISZ SKPGRP /YES, TAKE SKIP RETURN JMP I SKPGRP /RETURN NOECHO, 212 /LF 377 /RUBOUT *1000 /IF, FOR, AND SET COMMANDS 233 /ESC 214 /FORM STEP1, JMS I PUSHF /PUSH ONE /CONSTANT OF ONE AS STEP JMP GOTSTP /GO GET LIMIT IF, TAD PGO /GET ADDRESS OF GOTO HANDLER SKP /GO SET UP POINTER BRANCH, TAD PDO /GET ADDRESS OF DO HANDLER DCA IFSAVE /SET UP FOR LATER BRANCHING JMS I PUSHJ /DO RECURSIVE CALL EVAL /TO EQUATION SOLVER JMS I PCOMMA /IGNORE COMMA, IF ANY NOP /IN CASE NO COMMA FOUND JMS I TABSCH /SEARCH RELOPR-1 /FOR RELATIONAL OPERATOR RELOGO-RELOPR /GO DO RELATIONAL IF CLA CLL CMA RAL /OTHERWISE, GET NEGATIVE 2 DCA SAVE1 /INITIALIZE COUNTER TAD FACHGH /GET HIGH ORDER FAC (SIGN) SPA /FAC POSITIVE OR ZERO? ISZ SAVE1 /NO, BUMP COUNTER SPA SNA CLA /FAC NEGATIVE OR ZERO? IFTEST, ISZ SAVE1 /NO, BUMP COUNTER SKP /TEST NOT TRUE, SET UP FOR NEXT TEST JMP IFRGHT /GO IGNORE REST OF LINE NUMBERS JMS I TABSCH /DO LOOKUP AND GO TERTAB /AMONG COMMAND DELIMITERS IFGO-TERTAB-1 /WHERE TO GO WITH VARIOUS TERMINATORS JMS I DECODE /NOT A TERMINATOR, IGNORE IT JMP .-4 /CHECK OUT THE NEXT CHARACTER IFTRUE, JMS I DECODE /IGNORE THE COMMA JMP IFTEST /GO CHECK NEXT CONDITION IFRGHT, JMS I GETARG /INTERPRET LINE NUMBER JMS I PUSHF /STACK ARGSW /LINE NUMBER INFO IFLOOP, JMS I CHECK /CHECK TERTAB+1 /FOR COMMA OR SEMICOLON JMP IFGOTO /FOUND IT, DO CORRECT LINE JMS I DECODE /NOT FOUND IGNORE CHARACTER JMP IFLOOP /GO SEE IF NEXT IS TERMINATOR IFGOTO, JMS I POPF /UNSTACK ARGSW /LINE NUMBER INFORMATION JMP I IFSAVE /GO DO CORRECT TRANSFER IFSAVE, .-. /POINTER TO TRANSFER ROUTINE FOR BRANCH AND IF PGO, GO+1 /POINTER TO 'GOTO' STYLE TRANSFER HANDLER PDO, DO+1 /POINTER TO 'DO' STYLE TRANSFER HANDLER SETFOR, DCA SAVE1 /CLEAR VARIABLE COUNTER SKP /NO TERMINATOR TO IGNORE INDXLK, JMS I DECODE /IGNORE TERMINATOR JMS I PUSHJ /RECURSIVE CALL SEEKVR /FIND INDEX VARIABLE JMS I PNOZVR /DISABLE ZVR JMS I KLSPCE /IGNORE SPACES TAD POINT1 /GET POINTER TO VARIABLE JMS I PUSHA /SAVE ON STACK CMA /GET NEGATIVE ONE TAD SAVE1 /DECREMENT COUNTER DCA SAVE1 /STORE NEW COUNTER JMS I TABSCH /LOOK UP AND GO FORCHR-1 /IF EQUALS OR COMMA FORGO-FORCHR /TO GET NEXT INDEX OR SET JMS I ERROR /NO, GO TO ERROR ROUTINE SET, JMS I PUSHJ /RECURSIVE CALL EVAL-1 /TO EQUATION SOLVER TAD SAVE1 /GET COUNT OF VARIABLES TO BE SET DCA WORK /INITIALIZE FOR COUNTING INDXLP, TAD I PDLPTR /GET POINTER BACK FROM STACK DCA POINT1 /STORE IN POINTER LOCATION JMS I FPP /ENTER FLOATING POINT MODE FPUT I POINT1 /STORE NEW VALUE IN VARIABLE FEXT /RETURN TO NORMAL MODE ISZ WORK /DONE ALL VARIABLES? JMP INDXLP /NO, DO ANOTHER JMS I TABSCH /DO LOOKUP AND GO TERTAB /AMONG COMMAND DELIMITERS FORGO1-TERTAB-1 /WHERE TO GO IF FOUND JMS I ERROR /WRONG TERMINATOR FOR, TAD POINT1 /GET POINTER TO INDEX JMS I PUSHA /STACK IT JMS I PUSHJ /RECURSIVE CALL EVAL-1 /TO EVALUATE SECOND PARAMETER JMS I TABSCH /DO LOOKUP AND GO TERTAB /AMONG COMMAND DELIMITERS FORGO2-TERTAB-1 /GO TO PROPER PLACE JMS I ERROR /ANOTHER POSSIBILITY FOR WRONG TERMINATION FORSTP, JMS I PUSHF /PUSH DUMMY /STEP JMS I PUSHJ /RECURSIVE CALL EVAL-1 /EVALUATE LIMIT GOTSTP, JMS I PUSHF /PUSH DUMMY /LIMIT JMS I PUSHF /PUSH GETPTR /DECODE INFO JMS UNFOR /UNSTACK CRUD FORLP, JMS I FPP /ENTER FLOATING POINT MODE FGET I POINT1 /GET INDEX VARIABLE VALUE FSUB I PDUMMY /SUBTRACT LIMIT FDIV I PSTEP /HANDLE NEGATIVE AND ZERO STEP VALUES FEXT /RETURN TO NORMAL MODE JMS I PNOZVR /DISABLE ZVR TAD FACHGH /GET HIGH ORDER FAC (SIGN) SMA SZA CLA /FAC NEGATIVE OR ZERO? JMP I LINEND /YES, GO FIND NEXT LINE TO EXECUTE TAD WORK /NO, GET OLD STACK VALUE DCA PDLPTR /RESTORE OLD STACK POINTER JMS I PUSHJ /RECURSIVE CALL EXEC-1 /COMMAND INTERPRETER JMS UNFOR /UNSTACK CRUD JMS I FPP /ENTER FLOATING POINT MODE FGET I POINT1 /GET INDEX VARIABLE VALUE FADD I PSTEP /ADD STEP FPUT I POINT1 /STORE NEW INDEX VARIABLE VALUE FEXT /RETURN TO NORMAL MODE JMP FORLP /GO CHECK LIMIT AGAIN UNFOR, .-. /SUBROUTINE TO UNSTACK 'FOR' INFO TAD PDLPTR /GET STACK POINTER DCA WORK /SAVE IN CASE NEED TO GO AGAIN JMS I POPF /UNSTACK GETPTR /DECODE INFO JMS I POPF /UNSTACK DUMMY /LIMIT JMS I POPF /UNSTACK PSTEP, SAVEXP /STEP TAD I PDLPTR /GET POINTER TO INDEX VARIABLE DCA POINT1 /STORE IN POINTER JMP I UNFOR /RETURN IFGO, IFTRUE /BRANCH TABLE FOR IF COMMAND EXEC-1 *1200 /ASK, TYPE, TTY OUTPUT ROUTINE, FOUT ENDLIN ASK, CLA CMA /SET ASK/TYPE SWITCH TYPE, DCA ASKTYP /SET UP ASK/TYPE SWITCH DCA QUOTSW /CLEAR QUOTE FLAG JMS I TABSCH /DO LOOKUP AND GO TYPCHR-1 /AMONG CHARACTERS TYPGO-TYPCHR /PECULIAR TO TYPE AND ASK ISZ ASKTYP /EXPRESSION, DECIDE WHETHER TO TYPE OR ASK JMP TYPVAL /GO TYPE A VALUE JMS I PUSHJ /RECURSIVE CALL SEEKVR /TO LOOK FOR VARIABLE REFERENCED JMS I PNOZVR /DISAVLE ZVR TAD CHAR /GET CHARACTER AFTER VARIABLE REFERENCE JMS I PUSHA /PLACE ON STACK TAD POINT1 /GET POINTER TO VARIABLE JMS I PUSHA /PLACE ON STACK ISZ INSW /SET INPUT TO COME FROM TTY TAD PDLPTR /GET STACK POINTER IAC /POINT TO LAST STACKED ITEM DCA SAVE1 /SAVE FOR LATER ASKOVR, JMS I PUSHJ /RECURSIVE CALL EVAL-1 /EQUATION SOLVER WITH TTY INPUT TAD I SAVE1 /GET POINTER TO VARIABLE DCA POINT1 /STORE POINTER FOR RESULT JMS I FPP /ENTER FLOATING POINT MODE FPUT I POINT1 /STORE RTESULT IN VARIABLE FEXT /RETURN TO NORMAL MODE ALTMDE, TAD SAVE1 /GET FORMER STACK VALUE DCA PDLPTR /RESTORE STACK, LESS POINTER DCA INSW /RESET FOR BUFFER INPUT TAD I PDLPTR /GET ENTRY FROM STACK DCA CHAR /RESTORE CHARACTER JMP ASK /GO LOOK AT REST OF COMMAND TYPVAL, JMS I PUSHJ /RECURSIVE CALL EVAL /TO EVALUATE EXPRESSION JMS I TYPFAC /PRINT VALUE JMP TYPE /GO LOOK AT REST OF COMMAND QUOTES, ISZ QUOTSW /SET QUOTE FLAG JMS I DECODE /GET A CHARACTER JMS I TABSCH /DO A LOOKUP AND GO UNQUOT-1 /FOR QUOTE OR CR UNQTGO-UNQUOT /GO DO UNQUOTE IF FOUND QUOTEL, JMS I PRTCL /OTHERWISE, PRINT CHAR ON TTY JMP QUOTES+1 /GO PRINT NEXT CHARACTER QUOTE, JMS I DECODE /GET NEXT CHARACTER JMS I CHECK /IS IT UNQUOT /ANOTHER QUOTE? JMP QUOTEL /YES, GO TYPE IT JMP TYPE+1 /NO, UNQUOTE FORMAT, JMS I DECODE /GET NEXT CHARACTER FROM BUFFER JMS I GETARG /INTERPRET AS ARGUMENT TAD LINENO /GET RESULT DCA FORM /SET UP NEW FORMAT CONTROL WORD JMP TYPE+1 /GO LOOK AT REST OF COMMAND TYPELF, TAD LF /GET A LINE FEED JMP EXCLAM+1 /GO PRINT IT NUMSGN, TAD CR /GET CARRIAGE RETURN JMS I TYP /PRINT ON TTY CMA /GET NEGATIVE ONE TO CHANGE CR TO FORM FEED EXCLAM, TAD CR /GET CARRIAGE RETURN (OR FORM FEED) JMS I PRTCL /PRINT CHAR ON TTY TYPIGN, JMS I DECODE /GET NEXT CHARACTER FROM BUFFER JMP TYPE+1 /GO CHECK REST OF COMMAND TAB, TAD ASKTYP /GET ASK OR TYPE SWITCH JMS I PUSHA /STORE ON STACK JMS I PUSHJ /RECURSIVE CALL EVAL-1 /TO EXPRESSION SOLVER JMS I FIX /TAKE INTEGER PART OF RESULT TABTRY, SPA SNA /POSITIIVE NONZERO? CLA IAC /NO, TAB TO COLUMN ONE CIA /NEGATE IAC /COMPENSATE FOR LEFT MARGIN EQ ONE TAD TABCTR /ADD CURRENT COLUMN NUMBER SNA /ALREADY THERE? JMP TABDNE /YES, ALL DONE SPA /NEED TO RETURN FIRST? JMP TABIT /NO, GO AHEAD CLA /YES, CLEAR JUNK TAD CR /GET A CARRIAGE RETURN JMS I TYP /PRINT WITHOUT LINE FEED JMS I TYP /PINT NUL FOR DELAY TAD FACMED /GET COLUMN TO TAB TO JMP TABTRY /GO TAB TO THERE TABIT, DCA COUNTR /STORE COUNTER TAD C240 /GET SPACE JMS I TYP /PRINT IT ISZ COUNTR /PRINTED ENOUGH? JMP TABIT+1 /NO, DO ANOTHER TABDNE, TAD I PDLPTR /GET ASK/TYPE SWITCH FROM STACK JMP TYPE /GO PROCESS REST OF COMMAND SCHTAB, .-. /LOOKUP AND GO ROUTINE SNA /CHARACTER IN AC? TAD CHAR /NO, USE ONE IN STORAGE CIA /NEGATE CHARACTER SOUGHT DCA WORK /SAVE FOR LATER TAD I SCHTAB /GET TABLE POINTER ISZ SCHTAB /SKIP FIRST PARM DCA WRKPTR /SET UP POINTER INTO TABLE SCHLP, TAD I WRKPTR /GET CHARACTER FROM TABLE SPA /END OF TABLE? JMP SCHXIT /YES, TAKE 'NOT FOUND' RETURN TAD WORK /NO, SUBTRACT CHARACTER SZA CLA /TABLE ENTRY EQUAL CHARACTER? JMP SCHLP /NO, LOOK AT NEXT ENTRY TAD WRKPTR /YES, GET ADDRESS OF ENTRY TAD I SCHTAB /ADD OFFSET OF GO TABLE DCA WORK /STORE GO TABLE POINTER TAD I WORK /GET GO TABLE ENTRY DCA WORK /STORE AS DESTINATION JMP I WORK /GO THERE SCHXIT, ISZ SCHTAB /SKIP OVER THE GO TABLE OFFSET PARAMETER CLA CLL /LOSE TERMINATOR IN AC JMP I SCHTAB /RETURN 'NOT FOUND' IOFOUT, .-. /INTERRUPT OFF CHARACTER OUTPUT TSF /TTY READY? JMP .-1 /NO, WAIT FOR IT TLS /SEND CHARACTER TO TTY TAD NCR /SUBTRACT CARRIAGE RETURN SNA /CHARACTER A RETURN? DCA TABCTR /YES, CLEAR COLUMN COUNTER TAD CR /RESTORE CHARACTER AND C140 /GET CASE BITS SZA CLA /WAS IT PRINTABLE? ISZ TABCTR /YES, INCREMENT COLUMN CML /RESTORE LINK JMP I IOFOUT /RETURN RELOGO, LESS /BRANCH TABLE FOR IF COMMAND EQUAL *1400 /VARIABLE SEEK ROUTINE, RETURN COMMAND GREATR SEEKVR, JMS I SRTFUN /CHECK WHETHER OPERATOR, 0-9, 'F', OR WHAT FORCHR, 254 /, /TABLE FOR SET AND FOR COMMANDS 275 /= JMS I ERROR /ONLY ALPHA VARIABLE NAMES ARE ALLOWED LOOKVR, DCA PUTSDE /SET UP FOR LEFT SIDE OF WORD JMS I ENCODE /PUT CHARACTER INTO BUFFER LOOKLP, JMS I GETCHR /GET CHARACTER JMS I CHECK /LOOK TO SEE IF IN TABLE TRMTAB-1 /OF ARITHMETIC TERMINATORS JMP GOTNAM /YES, VARIABLE NAME BUILT ISZ PUTSDE /SECOND CHARACTER? JMP LOOKLP /NO, IGNORE IT TAD CHAR /YES, GET CHARACTER AND C77 /TRIM TO 6-BIT TAD PUTWRK /MERGE IN LEFT HALF OF NAME DCA PUTWRK /STORE THE VARIABLE NAME JMP LOOKLP /GO IGNORE UNTIL TERMINATOR GOTNAM, JMS I PRNCHK /IS IT SUBSCRIPTED? JMP NOSUB /NO, SKIP CODE TO EVALUATE TAD PUTWRK /YES, GET VARIABLE NAME DCA ASKTYP /ARRANGE IT'S SALVATION JMS I SOLVE /EVALUATE SUBSCRIPT TAD I PDLPTR /GET SAVED VARIABLE NAME DCA PUTWRK /STORE IN WORK AREA JMS I UNPREN /CHECK FOR RIGHT PREN JMS I FIX /FIX FLOATING AC (SUBSCRIPT) NOSUB, DCA SPNOR /SAVE THE SUBSCRIPT (0 IF NONE) TAD PUTWRK /GET THE VARIABLE NAME DCA I VAREND /MAKE SURE WE WILL FIND IT TAD TXTEND /GET POINTER TO START OF VARIABLES VARSCH, DCA POINT1 /STORE AS POINTER TAD I POINT1 /GET A VARIABLE NAME CIA /NEGATE TAD PUTWRK /SUBTRACT FROM NAME SOUGHT SNA CLA /GOT RIGHT NAME? JMP FNDVAR /YES, GO CHECK SUBSCRIPT WRNGVR, TAD POINT1 /NO, GET POINTER TAD VARLEN /BUMP TO NEXT VARIABLE JMP VARSCH /AND TRY AGAIN UNPREN, CHKUNP /POINTER TO ROUTINE TO HANDLE RIGHT PREN SOLVE, SEGSLV /POINTER TO ROUTINE TO EVALUATE EXPRESSIONS IN PRENS MAKVAR, TAD VAREND /GET POINTER TO END OF VARIABLES TAD P13 /ADD SAFETY MARGIN CLL CIA /NEGATE TAD PDLPTR /SUBTRACT FROM STACK POINTER SNL CLA /OUT OF VARIABLE STORAGE? JMS I ERROR /YES, CALL ERROR ROUTINE TAD VAREND /NO, GET POINTER TO END OF VARIABLES IAC /ADD ONE TO POINT TO SUBSCRIPT DCA POINT1 /SET UP POINTER TAD VAREND /GET POINTER TO END OF VARIABLES TAD VARLEN /ADD ONE MORE VARIABLE DCA VAREND /STORE UPDATED POINTER SBCHNG, TAD SPNOR /GET SAVED SUBSCRIPT DCA I POINT1 /STORE IN NEW VARIABLE ISZ POINT1 /POINT TO VALUE JMS I FPP /ENTER FLOATING POINT MODE FGET I PZERO /GET A ZERO FPUT I POINT1 /STORE AS NEW VARIABLE'S VALUE FEXT /RETURN TO NORMAL MODE JMP I LINEND /DO RECURSIVE RETURN FNDVAR, TAD POINT1 /GET POINTER TO VARIABLE ISZ POINT1 /BUMP TO POINT AT SUBSCRIPT CIA /NEGATE TAD VAREND /COMPARE TO END OF VARIABLES SNA CLA /VARIABLE REALLY THERE? JMP ZVR /NO, GO TRY TO RENAME A ZERO TAD I POINT1 /GET SUBSCRIPT OF VARIABLE CIA /NEGATE TAD SPNOR /COMPARE WITH SUBSCRIPT SOUGHT ISZ POINT1 /POINT AT VALUE IN CASE IT IS NEEDED SNA CLA /GOT RIGHT SUBSCRIPT? JMP I LINEND /YES, DO RECURSIVE RETURN CLL CMA RAL /NO, GET -2 JMP WRNGVR /GO LOOK AT NEXT VARIABLE ZVR, CLL CML IAC RAL /GET 3 TAD TXTEND /POINT TO FIRST VARIABLE'S SIGN ZVRLP, DCA POINT1 /STORE POINTER TAD POINT1 /GET POINTER CLL CIA /NEGATE TAD VAREND /COMPARE TO END OF VARIABLES SNL CLA /FILLED IN ALL ZEROES? JMP MAKVAR /YES, GO CREATE A VARIABLE TAD I POINT1 /NO, GET SIGN OF VARIABLE SNA CLA /IS IT ZERO? JMP GOTZRO /YES, GO CHECK IF IT IS NORMALIZED ZVRNXT, TAD POINT1 /NO, GET POINTER TAD VARLEN /BUMP TO NEXT VARIABLE JMP ZVRLP /GO LOOK FOR ZERO GOTZRO, CLA CMA /GET -1 TAD POINT1 /BACK UP TO EXPONENT DCA POINT1 /STORE POINTER TAD I POINT1 /GET EXPONENT SZA /NORMALIZED? JMP ZVRNXT /NO, DON'T REPLACE IT CLL CMA RAL /GET -2 TAD POINT1 /BUILD POINTER TO NAME DCA POINT1 /STORE POINTER TO NAME TAD PUTWRK /GET NAME DCA I POINT1 /STORE NEW NAME ISZ POINT1 /POINT TO SUBSCRIPT JMP SBCHNG /GO CHANGE SUBSCRIPT SPNOR, .-. /SUBROUTINE TO IGNORE LEADING SPACES TAD CHAR /GET CHARACTER TAD N240 /SUBTRACT SPACE SZA CLA /IS IT A SPACE? JMP I SPNOR /NO, RETURN JMS I GETCHR /YES, GET NEXT CHARACTER JMP SPNOR+1 /AND CHECK IT N260, -260 /NEGATIVE ASCII ZERO N271, -271 /NEGATIVE ASCII NINE NUMSRT, .-. /DETERMINE WHETHER '.' 0-9, OR ALPHA TAD CHAR /GET CHARACTER TAD N256 /SUBTRACT PERIOD SZA CLA /IS IT '.'? ISZ NUMSRT /NO, SKIP AT LEAST ONE TAD CHAR /GET CHARACTER TAD N260 /SUBTRACT '0' DCA SORTWK /SAVE IN CASE OF DIGIT TAD SORTWK /GET IT BACK SPA CLA /COULD IT BE A DIGIT? JMP I NUMSRT /NO, RETURN TAD CHAR /GET CHARACTER TAD N271 /SUBTRACT '9' SNA SPA CLA /IS IT A DIGIT? ISZ NUMSRT /YES, SKIP TWICE JMP I NUMSRT /RETURN *1600 /EQUATION SOLVER SEGSLV, .-. /ROUTINE TO EVALUATE EXPRESSION IN PRENS TAD SORTWK /GET CURRENT OPERATOR NUMBER, IF ANY JMS I PUSHA /PLACE ON STACK TAD OLDOPR /GET OLD OPERATOR, IF ANY JMS I PUSHA /PLACE ON STACK TAD ASKTYP /GET FUNCTION OR VARIABLE NAME, IF ANY JMS I PUSHA /PLACE ON STACK TAD SEGSLV /GET RETURN ADDRESS JMS I PUSHA /PLACE ON STACK JMS I GETCHR /GET NEXT CHARACTER EVAL, DCA OLDOPR /CLEAR OLD OPERATORLOCATION JMS I SRTFUN /CHECK WHETHER OPERATOR, 0-9, 'F', OR WHAT JMP FRSTOP /FIRST CHARACTER OF SEGMENT IS OPERATOR JMP NUMBER /INTERPRET NUMBER JMP FUNC /INTERPRET FUNCTION CALL VARBLE, JMS I PUSHJ /RECURSIVE CALL LOOKVR /TO LOOK UP VARIABLE TAD INSW /GET INPUT FROM TTY SWITCH SNA CLA /INPUT COMING FROM TTY? JMP LOOKOP /NO, GO LOOK FOR OPERATOR TAD CHAR /YES, GET CHARACTER TAD N240 /SUBTRACT SPACE SNA CLA /WAS IT A SPACE? JMP OPROK+1 /YES, TERMINATE EXPRESSION LOOKOP, JMS I SRTFUN /CHECK WHETHER OPERATOR, 0-9, 'F', OR WHAT JMP CHKOPR /ONLY OPERATORS ARE ALLOWED AFTER VARIABLE REFERENCES JMP OPROK+1 /TERMINATOR NOT OPERATOR, END OF SEGMENT JMP OPROK+1 /TERMINATOR NOT OPERATOR, END OF SEGMENT JMP OPROK+1 /TERNINATOR NOW OPERATOR, END OF SEGMENT FRSTOP, TAD PZERO /GET POINTER TO CONSTANT OF ZERO DCA POINT1 /DUMMY UP FIRST OPERAND CLA CLL CMA RAL /GET NEGATIVE TWO TAD SORTWK /ADD TO OPERATOR NUMBER SNA /UNARY MINUS SIGN? JMP OPROK /YES, ALLOW IT IAC /ADD ONE TO AC SNA CLA /UNARY PLUS SIGN? JMP OPRIGN /YES, IGNORE IT TAD SORTWK /GET OPERATOR NUMBER TAD N10 /SUBTRACT EIGHT SPA CLA /IS IT A SEGMENT DELIMITER? JMP LOOKPR /NO, BETTER BE LEFT PREN (bugbug confusing comments) CHKOPR, JMS I PRNCHK /YES, IS IT LEFT PREN (bugbug confusing comments) SKP /NO, OK JMP OPROK+1 /YES, MUST BE PART OF NEXT EXPRESSION OPROK, TAD SORTWK /GET OPERATOR NUMBER DCA NEWOPR /STORE AS NEW OPERATOR TAD NEWOPR /GET NEW OPERATOR TAD N10 /SUBTRACT EIGHT SMA CLA /SEGMENT TERMINATOR? DCA NEWOPR /YES, SET OPERATOR NUMBER (PRIORITY) TO ZERO CHKPRI, TAD NEWOPR /GET NEW OPERATOR PRIORITY CIA /NEGATE TAD OLDOPR /COMPARE TO OLD OPERATOR PRIORITY SPA CLA /WHICH HAS PRIORITY? JMP NEWHGH /NEW OPERATOR, GO STACK OLD ONE TAD OLDOPR /GET OLD OPERATOR PRIORITY CLL RTR /SHIFT TO CREATE RTR /FPP OPCODE NUNPRN, TAD CGETVL /MAKE FPP INSTRUCTION DCA FPPOPR /PREPARE TO EXECUTE IT TAD OLDOPR /GET OLD OPERATOR SZA CLA /BEGINNING OF EQUATION? JMS I POPF /NO, UNSTACK FACEXP /INTO FPP AC JMS I FPP /ENTER FLOATING POINT MODE FPPOPR, .-. /DO THE NEEDED OPERATION FPUT I PDUMMY /STORE THE RESULT FEXT /RETURN TO NORMAL MODE TAD PDUMMY /GET POINTER TO RESULT DCA POINT1 /SET UP FIRST OPERAND POINTER TAD NEWOPR /GET NEW OPERATOR TAD OLDOPR /ADD IN OLD OPERATOR SNA CLA /ALL DONE? JMP I LINEND /YES, RECURSIVE RETURN TAD I PDLPTR /NO, UNSTACK WAITING OPERATOR DCA OLDOPR /STORE AS OLDOPR JMP CHKPRI /AND GO CHECK PRIORITY NEWHGH, JMS I PRNCHK /LEFT PREN? SKP /NO, PUT OLD ON WAITING LIST JMP NUNPRN /YES, GO EVALUATE EXPRESSION IN PRENS TAD OLDOPR /GET OLD OPERATOR JMS I PUSHA /PUT ON STACK TAD POINT1 /GET POINTER TO PSEUDOVARIABLE DCA .+2 /SET UP FOR PUSH JMS I PUSHF /PUSH FLOATING POINT .-. /FROM PSEADOVARIABLE TAD NEWOPR /GET NEW OPERATOR DCA OLDOPR /MAKE IT OLD OPERATOR OPRIGN, JMS I GETCHR /GET CHARACTER FROM BUFFER JMS I SRTFUN /CHECK WHETHER OPERATOR, 0-9, 'F', OR WHAT JMP LOOKPR /OPERATOR, BETTER BE LEFT PREN JMP NUMBER /NUMBER FOLLOWS JMP FUNC /FUNCTION CALL FOLLOWS JMP VARBLE /VARIABLE NAME FOLLOWS CGETVL, FGET I POINT1 /FPP BITS NEEDED TO REFERENCE OPERAND NUMBER, TAD PDUMMY /GET POINTER TO PSEUDOVARIABLE DCA POINT1 /SET LOCATION FOR OPERAND JMS I FACIN /INTERPRET NUMBER JMP VARBLE+2 /PRETEND A VARIABLE WAS REFERENCED FUNC, DCA ASKTYP /INITIALIZE PARTIAL FUNCTION NAME JMS I GETCHR /GET A CHARACTER JMS I CHECK /CHECK WHETHER IT IS TRMTAB-1 /AN ARITHMETIC TERMINATOR JMP GOTFUN /YES, NAME HASH ASSEMBLED TAD ASKTYP /GET PARTIAL FUNCTION NAME CLL RAL /DOUBLE IT TAD CHAR /ADD THE NEW CHARACTER JMP FUNC /GO LOOK AT NEXT CHARACTER GOTFUN, JMS I PRNCHK /FUNCTION GOT AN ARGUMENT? JMP NOPARM /NO, GO TO SPECIAL HANDLER JMS SEGSLV /YES, EVALUATE IT DCA FARGSW /CLEAR 'NO ARGUMENT' SWITCH TAD I PDLPTR /GET FUNCTION HASH FUNCBR, JMS I TABSCH /DO LOOKUP AND GO FNCNMS-1 /AMONG FUNCTION HASHCODES FUNCGO-FNCNMS /GO TO FUNCTION, ELSE BADFUN, JMS I ERROR /INVALID FUNCTION, COMMAND, OR OPERATOR LOOKPR, JMS I PRNCHK /CHECK FOR LEFT PREN JMS I ERROR /DOUBLE OPERATOR, GO TO ERROR ROUTINE JMS SEGSLV /EVALUATE THE EXPRESSION IN THE PRENS DCA FARGSW /CLEAR 'NO ARGUMENT' SWITCH ISZ PDLPTR /POP DUMMY FUNCTION NAME JMP I FNCXIT /PRETEND RETURN FROM FUNCTION CALL NOPARM, CLA CMA /GET NEGATIVE ONE DCA FARGSW /SET 'NO ARGUMENT' SWITCH TAD ASKTYP /GET FUNCTION HASHCODE JMP FUNCBR /GO DO LOOKUP AND GO *2000 /FSGN, FABS, RETURN PROCESSORS, DELETE, PREN ROUTINES TRMTAB, 240 /TABLE OF TERMINATORS AND OPERATORS IN EQUATIONS 253 /+ 255 /- 257 // 252 /* 336 /^ 250 /( 333 /[ TYPCHR, 251 /) /CHARACTERS SPECIAL IN TYPE OR ASK 335 /] 245 /% 247 /' 242 /" 241 /! 243 /# 272 /: 274 /< 275 /= 276 /> TERTAB, 240 /SPACE 254 /, 273 /; 215 /CR FSGN, JMS I PUSHF /PUSH DCA OPMED /FLOATING POINT ONE JMS I POPF /POP FACEXP /INTO FLOATING AC FABS, TAD DUMMY+1 /LOOK AT ARGUMENT SIGN SPA CLA /ARGUMENT POSITIVE? JMS I NEGATE /NO, NEGATE IT FNCDNE, ISZ FARGSW /WAS THERE AN ARGUMENT? JMS CHKUNP /YES, CHECK FOR RIGHT PREN JMS I PNORML /NORMALIZE THE RESULT JMS I FPP /ENTER FLOATING POINT MODE FPUT DUMMY /STORE RESULT IN PSEUDOVARIABLE FEXT /RETURN TO NORMAL MODE TAD PDUMMY /GET POINTER TO RESULT DCA POINT1 /STORE AS POINTER TO FIRST OPERAND JMP I .+1 /GO PRETEND A VARIABLE VARBLE+2 /WAS REFERENCED DUMMY, 0 /PSEUDOVARIABLE, HOLDS LEFT OPERAND 0 0 0 CHKPRN, .-. /ROUTINE TO CHECK FOR LEFT PREN TAD SORTWK /GET OPERATOR NUMBER TAD N10 /SUBTRACT EIGHT SMA CLA /COULD IT BE LEFT PREN JMP I CHKPRN /NO, TAKE ERROR RETURN TAD SORTWK /YES, GET OPERATOR NUMBER TAD N5 /SUBTRACT 5 SZA SMA CLA /IS IT A LEFT PREN? ISZ CHKPRN /YES, TAKE SKIP RETURN JMP I CHKPRN /RETURN CHKUNP, .-. /ROUTINE TO CHECK FOR RIGHT PREN TAD I PDLPTR /GET OPERATOR FROM STACK DCA OLDOPR /SAVE AS OLD OPERATOR CLL IAC RAL /GET A TWO TAD I PDLPTR /ADD TO LEFT PREN NUMBER CIA /NEGATE TAD SORTWK /COMPARE TO RIGHT PREN NUMBER SZA CLA /PRENS MATCH? JMS I ERROR /NO, GO TO ERROR ROUTINE JMS I GETCHR /YES, SKIP OVER UNPREN JMP I CHKUNP /RETURN ERALIN, .-. /ROUTINE TO DELETE THE REQUESTED LINE JMS I FNDLIN /SEEK THE LINE JMP I ERALIN /LINE ALREADY GONE ISZ QUOTSW /SET QUOTE FLAG TO PREVENT TRACE JMS I DECODE /FETCH NEXT CHARACTER TAD CHAR /GET IT TAD NCR /SUBTRACT CARRIAGE RETURN SZA CLA /IS IT THE CARRIAGE RETURN? JMP .-4 /NO, KEEP LOOKING TAD GETPTR /YES, GET THE DECODE POINTER CMA /NEGATE AND SUBTRACT ONE TAD NEWPC /ADD POINTER TO LINE BEING DELETED DCA COUNTR /STORE COUNT OF WORDS TO GET RID OF TAD TXTBEG /GET BEGINNING OF TEXT CIA /NEGATE TAD NEWPC /FORM OFFSET OF LINE TO BE REMOVED SNA CLA /REMOVING HEADING LINE? JMP START /YES; ABORT TAD I NEWPC /NO, GET POINTER TO NEXT LINE DCA I OLDPC /UPDATE POINTER OF PREVIOUS LINE TAD TXTBEG /GET POINTER TO BEGINNING OF TEXT PTRUP, DCA WORK /SET UP WOK AREA POINTER TAD I WORK /GET LINK IN LINE NUMBER POINTER CHAIN SNA /REWORKED ALL POINTERS? JMP MOVTXT /YES, GO COMPRESS TEXT DCA SAVE1 /NO, SAVE THE LINK TAD NEWPC /GET THE BOUNDARY CLL CIA /NEGATE TAD SAVE1 /ADD THE LINK SZL CLA /LINE GOING TO MOVE? TAD COUNTR /YES, GET ADJUSTMENT VALUE TAD SAVE1 /ADD THE LINK DCA I WORK /UPDATE THE POINTER TAD SAVE1 /GET THE NEW POINTER JMP PTRUP /AND GO AGAIN MOVTXT, CMA /GET NEGATIVE ONE TAD NEWPC /ADD POINTER TO DELETED LINE DCA QCKPTR /SET UP 'TO' POINTER TAD COUNTR /GET NUMBER OF WORDS TO REMOVE CMA /MAKE IT POSITIVE TAD NEWPC /ADD TO FORM 'FROM' POINTER DCA WRKPTR /STORE 'FROM' POINTER TAD COUNTR /GET WORDS TO REMOVE (NEGATIVE) TAD TXTEND /ADD END OF TEXT POINTER DCA TXTEND /UPDATE END OF TEXT POINTER TAD PUTPTR /GET TEXT ENCODE POINTER CMA /NEGATE AND SUBTRACT ONE TAD WRKPTR /ADD IN 'FROM' POINTER DCA SAVE1 /SAVE COUNT OF WORDS TO MOVE TAD PUTPTR /GET TEXT ENCODE POINTER TAD COUNTR /SUBTRACT WORDS TO REMOVE DCA PUTPTR /STORE UPDATED VALUE TAD I WRKPTR /GET A WORD DCA I QCKPTR /MOVE IT TO NEW SPOT ISZ SAVE1 /DONE YET? JMP .-3 /NO, GO AGAIN JMP ERALIN+1 /YES, TRY DELETE AGAIN, JUST IN CASE RETURN, TAD PZERO /GET POINTER TO CONSTANT OF FP ZERO DCA PC /SET AS NEW POINTER TO START OF LINE ENDLIN, TAD I PDLPTR /GET ENTRY FROM STACK DCA WORK /PREPARE TO GO THERE JMP I WORK /GO THERE *2200 /ERASE COMMAND, INPRT, FIND LINE, UNPACK ROUTINES INPRT, .-. /INPUT A CHARACTER AND ECHO (UNLESS LF OR RUBOUT) JMS I INCHAR /GET A CHARACTER DCA CHAR /SAVE IT JMS I CHECK /LOOK TO SEE IF IN TABLE NOECHO-1 /OF NOECHO CHARACTERS JMP I INPRT /YES, WE ARE DONE JMS I PRTCL /NO, ECHO IT JMP I INPRT /WE ARE DONE ERASE, JMS I KLSPCE /IGNORE SPACES TAD CHAR /GET CHARACTER TAD N301 /SUBTRACT 'A' SZA CLA /ERASE ALL? JMP ERA /NO, GO ERASE A LINE ERASEA, TAD BUFBEG /YES, GET BUFFER BEGINNING DCA TXTEND /SET AS BUFFER END DCA I TXTBEG /REMOVE LINE POINTER LIST ERADNE, TAD TXTEND /GET END OF PROGRAM DCA VAREND /ERASE THE VARIABLES JMP START /RESTART FOCAL ERA, JMS I GETARG /INTERPRET THE ARGUMENT TAD TXTEND /GET THE END OF TEXT DCA PUTPTR /STORE IN ENCODE POINTER JMS I DELETE /DELETE THE LINE, IF FOUND ISZ NEWPC /BUMP TO POINT AT NEXT LINE NUMBER TAD ARGSW /GET LINE NUMBER SWITCHES SMA CLA /GROUP ERASE? TAD I NEWPC /YES, GET NEW LINE NUMBER JMS I GRPTST /IN SAME GROUP? JMP ERADNE /NO, WE ARE DONE TAD I NEWPC /YES, GET NEW LINE NUMBER DCA LINENO /STORE AS LINE TO BE DELETED JMP ERA+3 /AND GO AGAIN LINFND, .-. /ROUTINE TO FIND REQUESTED LINE TAD I PC /GET POINTER WORD OF CURRENT LINE SNA CLA /AT END OF PROGRAM OR DUMMY LINE? JMP NEWCHN /YES, RESTART CHAIN TAD PC /NO, GET POINTER TO CURRENT LINE DCA OLDPC /STORE AS POINTER TO PREVIOUS LINE TAD PC /GET POINTER TO CURRENT LINE DCA QCKPTR /PREPARE TO GET LINE NUMBER TAD LINENO /GET LINE NUMBER SOUGHT CLL CIA /NEGATE TAD I QCKPTR /ADD CURRENT LINE NUMBER SNL CLA /NEED TO RESTART POINTER CHAIN? JMP .+3 /NO, SKIP STEPS TO RESET NEWCHN, TAD TXTBEG /GET BEGINNING OF POINTER CHAIN DCA OLDPC /SET AS POINTER TO PREVIOUS LINE TAD OLDPC /GET POINTER TO LINE FINDLP, DCA NEWPC /SET AS NEW LINE TO LOOK AT TAD NEWPC /GET LINE POINTER DCA QCKPTR /SET UP TO ADD LINE NUMBER TAD LINENO /GET LINE NUMBER SOUGHT CLL CIA /NEGATE TAD I QCKPTR /ADD CURRENT LINE NUMBER SNA /FOUND IT? JMP FNDXIT /YES, GO TAKE SKIP RETURN SZL CLA /NO, GONE PAST IT? JMP FNDXIT+1 /YES, GO WRAP UP TAD NEWPC /NO, GET NEW POINTER VALUE DCA OLDPC /SET AS OLD POINTER VALUE TAD I NEWPC /GET NEW POINTER VALUE SZA /OUT OF LINES? JMP FINDLP /NO, KEEP LOOKING SKP /YES, TAKE 'NOT FOUND' RETURN FNDXIT, ISZ LINFND /TAKE SKIP (FOUND) RETURN TAD NEWPC /GET LINE NUMBER POINTER IAC /POINT AT TEXT DCA GETPTR /SET UP DECODE POINTER DCA GETSDE /SET UP TO DECODE FROM LEFT JMP I LINFND /RETURN UNPACK, .-. /TEXT DECOMPRESSION ROUTINE JMS UNPCK1 /UNPACK NEXT HALFWORD SZA /CONTROL MARKER? JMP .+4 /NO, GOT 6-BIT CHARACTER JMS UNPCK1 /YES, GET NEXT 6-BIT CMA /COMPLEMENT AND C77 /MASK BACK TO CONTROL CHARACTER TAD N40 /SUBTRACT 40 SPA CLA /NEED EXTRA 100? TAD C100 /YES, ADD IT NOW TAD C200 /SET MARK PARITY TAD CHAR /ADD CHARACTER DCA CHAR /STORE FULLY FORMED CHARACTER TAD CHAR /GET CHARACTER TAD N277 /SUBTRACT '?' SNA CLA /IS IT '?' JMP TRCSWP /YES, GO TOGGLE TRACE MODE TAD QUOTSW /NO, GET QUOTE FLAG TAD TRCESW /ADD IN TRACE FLAG SNA CLA /PRINT FOR TRACE MODE? JMS I PRTCL /YES, PRINT IT KSF /NO, CHECK FOR KEYBOARD INPUT JMP I UNPACK /NO INPUT, WE ARE DONE KRS /READ THE KEYBOARD AND C177 /STRIP PARITY, IF ANY TAD N3 /SUBTRACT THREE SNA CLA /IS IT CONTROL-C? JMP START /YES, RESTART FOCAL JMP I UNPACK /NO, JUST RETURN TRCSWP, TAD QUOTSW /GET THE QUOTE MODE SZA CLA /IN QUOTE MODE? JMP I UNPACK /YES, RETURN THE '?' TAD TRCESW /NO, GET THE TRACE FLAG SNA CLA /IN TRACE MODE? IAC /NO, SET TRACE MODE DCA TRCESW /STORE NEW TRACE MODE JMP UNPACK+1 /GO UNPACK AND RETURN A CHARACTER UNPCK1, .-. /ROUTINE TO UNPACK A HALFWORD ISZ GETSDE /WHICH SIDE? JMP LEFT /GO DO LEFT SIDE TAD GETWRK /RIGHT, GET WORD GOTHLF, AND C77 /MASK TO 6-BIT DCA CHAR /STORE IT TAD CHAR /GET IT BACK JMP I UNPCK1 /RETURN LEFT, TAD I GETPTR /GET A NEW WORD DCA GETWRK /SAVE FOR NOW CMA /GET -1 DCA GETSDE /SET UP FOR RIGHT SIDE NEXT TIME TAD GETWRK /GET SAVED WORD BSW /REPOSITION LEFT SIDE BITS /bugbug: not family of eight JMP GOTHLF /GO WRAP UP C100, 100 /EXTRA 100 FOR ALPHA AND LOWERCASE N3, -3 /USED IN CONTROL-C CHECK N40, -40 /USEFUL CONSTANT FOR UNPACK N277, -277 /NEGATIVE ASCII QUESTION MARK FITR, JMS I FIX /TAKE INTEGER PART OF ARGUMENT JMP I FNCXIT /RETURN FROM FUNCTION CALL *2400 /INPUT, OUTPUT, LINE NUMBER OUTPUT, PACK ROUTINES FNCNMS, "A^2+"B^2+"S /HASH CODE FUNCTION TABLE "S^2+"G^2+"N "I^2+"T^2+"R "I^2+"N "R^2+"A^2+"N "O^2+"U^2+"T "T^2+"S^2+"T "I^2+"N^2+"D "M^2+"Q "A^2+"T^2+"N "E^2+"X^2+"P "L^2+"O^2+"G "C^2+"O^2+"S "S^2+"I^2+"N "S^2+"Q^2+"T N140, -140 /NEGATIVE LOWER CASE AT SIGN WITHOUT PARITY IOFIN, .-. /INTERRUPT OFF KEYBOARD INPUT KSF /KEYBOARD READY? JMP .-1 /NO, WAIT FOR IT KRB /YES, READ IT AND C177 /STRIP PARITY, IF ANY SNA /IS IT NUL? JMP IOFIN+1 /YES, IGNORE IT TAD C200 /NO, SET MARK PARITY JMP I IOFIN /RETURN THE CHARACTER OUTARG, .-. /ROUTINE TO TYPE LINE NUMBERS, ERROR CODES TAD LINENO /GET NUMBER TO BE PRINTED JMS I ROT6 /ROTATE 'GROUP' NUMBER INTO PLACE AND C77 /MASK FOR JUST GROUP NUMBER JMS DCDGTS /OUTPUT AS TWO DIGIT NUMBER TAD DOT /GET A DOT JMS I PRTCL /PRINT IT TAD LINENO /GET THE LINE NUMBER JMS DCDGTS /OUTPUT THE FRACTION TAD C240 /GET A SPACE DCA CHAR /SAVE IT JMS I PRTCL /PRINT IT JMP I OUTARG /RETURN DCDGTS, .-. /PRINT AC5-11 AS TWO DIGITS AND C177 /MASK OUT CRUFT, IF ANY DCA SAVE1 /SAVE FOR A MOMENT TAD C260 /GET '0' DCA POWER /SAVE IT AS DIVIDE RESULT JMP .+3 /JUMP INTO DIVIDE ROUTINE ISZ POWER /INCREMENT RESULT DCA SAVE1 /UPDATE REMAINDER TAD SAVE1 /GET REMAINDER TAD N12 /SUBTRACT TEN SMA /TOO FAR? JMP .-5 /NO, GO AGAIN CLA /YES, CLEAR CRUFT TAD POWER /GET RESULT JMS I PRTCL /PRINT IT TAD SAVE1 /GET REMAINDER TAD C260 /CONVERT TO ASCII JMS I PRTCL /PRINT IT JMP I DCDGTS /RETURN TYPCHK, .-. /PRINT CHARACTER AND LF IF RETURN SNA /CHARACTER IN AC? TAD CHAR /NO, GET CHARACTER TAD NCR /SUBTRACT CARRIAGE RETURN SNA /IS IT CARRIAGE RETURN? JMP CRLF /YES, GO DEAL WITH IT TAD CR /NO, RESTORE CHARACTER JMS I TYP /PRINT IT JMP I TYPCHK /RETURN CRLF, TAD CR /GET CARRIAGE RETURN JMS I TYP /PRINT IT TAD LF /GET LF JMP .-5 /GO PRINT AND RETURN PACK, .-. /TEXT COMPRESSION ROUTINE TAD CHAR /GET THE CHARACTER TAD N377 /SUBTRACT RUBOUT SNA CLA /IS IT RUBOUT? JMP I RBT /YES, GO HANDLE IT TAD CHAR /NO, GET CHARACTER AND C140 /GET CASE BITS SZA /CONTROL CHARACTER? TAD N140 /NO, RESTORE CHARACTER SNA CLA /CONTROL CHARACTER? JMS PACK1 /YES, PACK 00 TAD CHAR /GET CHARACTER AND C77 /MASK FOR 6-BIT SZA /IS IT NUL? JMS PACK1 /NO, PACK IT PCKXIT, JMP I PACK /RETURN PACK1, .-. /PACK A 6-BIT HALFWORD ISZ PUTSDE /WHICH SIDE? SKP /LEFT, DON'T ADD WORK AREA TAD PUTWRK /RIGHT, ADD PREVIOUS WORK BSW /SWAP SIDES /bugbug: not family of eight / DCA PUTWRK /STORE NEW WORK AREA TAD PUTSDE /GET SIDE FLAG (0 OR 1) CIA /NEGATE DCA PUTSDE /SET NEW SIDE FLAG TAD PUTSDE /GET SIDE FLAG SZA CLA /NEED TO STORE WORK? JMP I PACK1 /NO, RETURN TAD PUTWRK /YES, GET WORK BSW /SWAP SIDES /bugbug: not family of eight / DCA I PUTPTR /STORE IN BUFFER DCA PUTWRK /ERASE STALE WORK TAD PDLPTR /GET STACK POINTER CLL CIA /NEGATE TAD P13 /ADD SAFETY MARGIN TAD PUTPTR /ADD NEW ENCODE POINTER SNL CLA /OUT OF ROOM? JMP I PACK1 /NO, JUST RETURN JMS I ERROR /YES, CALL ERROR ROUTINE N377, -377 /NEGATIVE ASCII RUBOUT RBT, RBOUT /ADDRESS OF RUBOUT HANDLER LINNEW, .-. /ROUTINE TO ENTER NEW LINE IN POINTER CHAIN TAD I OLDPC /GET POINTER TO LINE AFTER US DCA I TXTEND /STORE IN THE NEW LINE TAD TXTEND /GET POINTER TO NEW LINE DCA I OLDPC /STORE AS NEXT IN THIS LINE TAD PUTWRK /GET ENCODE WORK AREA SZA /IS IT EMPTY? DCA I PUTPTR /NO, STORE IT NOW TAD PUTPTR /GET ENCODE POINTER IAC /INCREMENT DCA TXTEND /SAVE AS NEW TEXT END TAD TXTEND /GET NEW TEXT END DCA VAREND /STORE AS END OF VARIABLES JMP I LINNEW /RETURN UNQTGO, ENDLIN /TABLE OF POINTERS FOR UNQUOTES IN ASK/TYPE QUOTE QUOTE *2600 /ERROR MESSAGE, RUBOUT, AND TYPE $ PROCESSORS ASKGO, CNTRLC /BRANCH TABLE FOR ASK COMMAND CHRGET+1 CHRGET+1 CHRGET+1 ALTMDE ASKOVR OOPS, .-. /ERROR MESSAGE HANDLER CLA CMA /GET NEGATIVE ONE TAD OOPS /FORM CALLER'S ADDRESS SKP /USE IT AS ERROR CODE CNTRLC, TAD C200 /GET 01.00 DCA LINENO /SAVE ERROR CODE TAD QUEST /GET A QUESTION MARK JMS I PRTCL /PRINT IT JMS I ARGOUT /OUTPUT THE ERROR CODE ISZ PC /BUMP POINTER TO POINT AT LINE NUMBER TAD I PC /GET LINE NUMBER, IF ANY SNA /GOT A LINE NUMBER? JMP DIRERR /NO, ERROR IN DIRECT COMMAND DCA LINENO /SAVE IT FOR OUTPUT TAD N100 /GET AN AT SIGN JMS I PRTCL /OUTPUT IT JMS I PRTCL /PRINT A SPACE JMS I ARGOUT /PRINT THE LINE NUMBER DIRERR, TAD CR /GET A CARRIAGE RETURN JMS I PRTCL /PRINT IT JMP START /RESTART FOCAL RBOUT, TAD PUTSDE /GET RIGHT/LEFT INDICATOR SZA CLA /RIGHT OR LEFT? JMP DELOK /LEFT, OK TO DELETE TAD PUTPTR /RIGHT, GET ENCODE POINTER CIA /NEGATE TAD PUTBEG /COMPARE TO THE BEGINNING SMA CLA /ANYTHING TO DELETE? JMP I DELXIT /NO, IGNORE THE RUBOUT DELOK, TAD SHIFTL /GET A BACKSLASH JMS I PRTCL /PRINT IT TAD PUTPTR /GET ENCODE POINTER DCA WORK /STORE IN WORK AREA ISZ PUTSDE /WHICH SIDE? JMP DLRGHT /GO DO RIGHT SIDE DELETION TAD I WORK /GET ENCODED VALUE AND C77 /LOSE THE LEFT SIDE SZA CLA /CONTROL MARKER? JMP LEFTDL /YES, GO DELETE IT TOO CMA /GET NEGATIVE ONE CLOBBR, DCA PUTSDE /SET UP NEW SIDE CMA /GET NEGATIVE ONE TAD PUTPTR /BACK UP ENCODE POINTER DCA PUTPTR /STORE NEW ENCODE POINTER TAD I WORK /GET LAST WORD ENCODED LEFTDL, AND N100 /MASK OUT THE RIGHT SIDE DCA PUTWRK /SAVE AS WORK AREA JMP I DELXIT /DELETION FINISHED DELXIT, PCKXIT /POINTER TO ENCODE ROUTINE EXIT DLRGHT, TAD I WORK /GET LAST WORD ENCODED AND N100 /MASK OUT THE RIGHT SIDE SZA CLA /CONTROL MARKER? JMP CLOBBR-1 /NO, GO WRAP UP DCA I WORK /YES, CLEAR THE WORD JMP CLOBBR /AND WRAP UP SHIFTL, 334 /ASCII BACKSLASH VARBLS, TAD TXTEND /GET POINTER TO VARIABLE START DCA POINT1 /SET UP POINTER TAD VAREND /GET VARIABLE END POINTER CIA /NEGATE TAD POINT1 /ADD POINTER SNA CLA /REACHED END OF VARIABLES? JMP I LINEND /YES, WE ARE DONE TAD I POINT1 /NO, GET THE VARIABLE NAME DCA I NAMPT /STORE IT FOR OUTPUT CLA CMA /GET NEGATIVE ONE TAD NAMPT /ADD NAME POINTER DCA GETPTR /SET UP DECODE POINTER DCA GETSDE /SET UP FOR LEFT SIDE JMS I DECODE /GET A CHARACTER JMS I PRTCL /PRINT IT TAD GETWRK /LOOK AT DECODE WORK AREA AND C77 /MASK FOR RIGHT SIDE TAD N100 /CONVERT TO UPPERCASE JMS I TYP /PRINT IT DCA GETSDE /SET UP FOR LEFT SIDE JMS I DECODE /DECODE THE LEFT PREN JMS I PRTCL /PRINT IT TAD FORM /GET FORMAT WORD JMS I PUSHA /SAVE ON STACK TAD C1000 /GET NEW FORMAT WORD (%5.00) DCA FORM /SET FORMAT ISZ POINT1 /BUMP POINTER TAD I POINT1 /GET VARIABLE'S SUBSCRIPT DCA FACHGH /SET HIGH FAC DCA FACMED /CLEAR MED FAC DCA FACLOW /CLEAR LOW FAC TAD P13 /GET PROPER EXPONENT DCA FACEXP /SET PROPER EXPONENT JMS I PNORML /NORMALIZE JMS I TYPFAC /PRINT IT TAD I PDLPTR /GET SAVED PRINT FORMAT DCA FORM /RESTORE PRINT FORMAT TAD C240 /GET A SPACE JMS I TYP /PRINT THE SPACE JMS I DECODE /GET THE RIGHT PREN JMS I PRTCL /AND PRINT IT JMS I DECODE /GET EQUAL SIGN JMS I PRTCL /PRINT IT ISZ POINT1 /POINT TO VALUE JMS I FPP /ENTER FLOATING POINT MODE FGET I POINT1 /GET THE VARIABLE'S VALUE FEXT /RETURN TO NORMAL MODE JMS I TYPFAC /PRINT THE VARIABLE'S VALUE TAD CR /GET CARRIAGE RETURN JMS I PRTCL /PRINT CR-LF TAD VARLEN /GET LENGTH OF VARIABLE TAD N2 /OFFSET BY NEGATIVE TWO TAD POINT1 /ADJUST POINTER FOR NEXT VARIABLE JMP VARBLS+1 /AND GO AGAIN C1000, 1000 /%5, USED TO PRINT SUBSCRIPTS NAMPT, VARNAM /POINTER TO VARNAM FORGO2, FORSTP /SECOND BRANCH TABLE FOR FOR COMMAND STEP1 BADFUN MODTAB, MODFLP /BRANCH TABLE FOR MODIFY COMMAND GETSCH CNTRLC MODSCR GETSCH+1 MODPTR, MOVELP+1 MODFND *3000 /MODIFY, RELATIONAL IF STATEMENT, FMQ, FIN, FTST, FOUT FMQ, MQA /READ MQ CONTENTS DCA WORK /SAVE THEM TAD FARGSW /GET ARGUMENT SWITCH SZA CLA /IS THERE AN ARGUMENT? JMP .+3 /NO, PROCEED JMS I FIX /YES, GET IT'S INTEGER VALUE MQL /AND LOAD IT INTO MQ TAD WORK /GET RETURN VALUE SKP /GO FLOAT AND RETURN IT FIN, JMS I INCHAR /GET AN INPUT CHARACTER DCA FACHGH /STORE HIGH FAC DCA FACMED /CLEAR MED FAC DCA FACLOW /CLEAR LOW FAC TAD P13 /GET PROPER EXPONENT DCA FACEXP /SET FAC EXPONENT JMP I FNCXIT /GO NORMALIZE AND RETURN FTST, TAD C200 /SET MARK PARITY IN CASE MISSING KSF /IS KEYBOARD READY? CLA CMA /NO, JUST RETURN NEGATIVE ONE KRS /YES, 'OR' IN CHARACTER JMP FIN+1 /GO RETURN RESULT FOUT, JMS I FIX /GET THE VALUE AS INTEGER JMS I TYP /PRINT IT ON THE TTY JMP I FNCXIT /GO RETURN FROM FUNCTION CHRGET, .-. /ROUTINE TO GET CHARACTER FROM TTY OR BUFFER TAD INSW /GET INPUT SOURCE SZA CLA /IS IT TTY? JMP .+3 /YES, GO DO THAT JMS I DECODE /NO, GET CHARACTER FROM BUFFER JMP I CHRGET /AND RETURN IT JMS I INPUT /GET CHARACTER FROM TTY JMS I TABSCH /DO LOOKUP AND GO ASKCHR-1 /AMONG CHARACTERS SPECIAL ASKGO-ASKCHR /FOR TTY INPUT JMP I CHRGET /NOT SPECIAL, RETURN IT ONE, 1 /FLOATING POINT ONE 2000 ZERO, 0 /FLOATING POINT ZERO 0 0 MODIFY, JMS I GETARG /INTERPRET ARGUMENT JMS I PUSHF /PUSH ARGSW /LINE NUMBER INFO TAD LINENO /GET LINE NUMBER DCA WORK /STORE AS NEW LINE NUMBER JMS I PCOMMA /WAS THERE A COMMA? JMP SAMENO /NO, NOT MOVING JMS I GETARG /YES, GET NEW LINE NUMBER JMP .-5 /GO SET UP AS NEW LINE NUMBER SAMENO, JMS I POPF /POP ARGSW /LINE NUMBER INFO JMS I FNDLIN /FIND THE LINE JMS I ERROR /NO SUCH LINE TAD TXTEND /GET END OF TEXT DCA PUTPTR /SET TO ENCODE THERE DCA PUTSDE /ON THE LEFT SIDE TAD WORK /GET THE NEW LINE NUMBER DCA I PUTPTR /STORE IT IN BUFFER TAD PUTPTR /GET ENCODE POINTER DCA PUTBEG /SET AS BEGINNING OF LINE GETSCH, JMS I INCHAR /GET SEARCH CHARACTER FROM TTY DCA TRCESW /STORE SEARCH CHARACTER ISZ QUOTSW /SET QUOTE MODE TO PREVENT TRACE MODFLP, JMS I DECODE /DECODE A CHARACTER JMS I PRTCL /PRINT IT JMS I TABSCH /DO LOOKUP AND GO CR-1 /FOR SEARCH CHAR OR LINE TERMINATOR MODPTR-CR /GO TO FOUND IT ROUTINE, OTHERWISE JMS I ENCODE /COPY CHARACTER TO OUTPUT LINE JMP MODFLP /AND KEEP LOOKING MODSCR, TAD TXTEND /GET POINTER TO END OF TEXT IAC /ADD ONE TO SKIP LINE NUMBER AND POINTER DCA PUTPTR /SET UP ENCODE POINTER DCA PUTSDE /TO ENCODE ON THE LEFT JMS I INPUT /GET INPUT FROM KEYBOARD JMS I TABSCH /LOOKUP AND GO MODIFC-1 /FOR CHARACTERS USED IN MODIFY MODTAB-MODIFC /GO TO CORRECT ROUTINE, ELSE MODFND, JMS I ENCODE /ENCODE THE NEW TEXT JMP .-5 /AND GO AGAIN LESS, TAD KSMA /GET SKIP-IF-LESS JMP .+4 /GO PROCESS RELATIONAL OPERATOR EQUAL, TAD KSZA /GET SKIP-IF-ZERO SKP /GO PROCESS RELATIONAL OPERATOR GREATR, TAD KSPA /GET SKIP-IF-GREATER JMS I PUSHA /PUSH THE NEEDED SKIP INSTRUCTION JMS I PUSHF /PUSH FACEXP /THE LEFT OPERAND JMS I PUSHJ /RECURSIVE CALL RELCHK /TO RELOP HANDLER JMS I POPF /POP TO FACEXP /RESTORE LEFT OPERAND JMS I FPP /ENTER FLOATING POINT MODE FSUB I PDUMMY /SUBTRACT RIGHT OPERAND FEXT /RETURN TO NORMAL MODE TAD I PDLPTR /GET SKIP-IF-TRUE DCA .+2 /GET READY TO USE IT TAD FACHGH /GET HIGH FAC (SIGN) .-. /RELATIONAL OPERATOR TRUE? JMP I LINEND /NO, END THE LINE JMS I PUSHF /YES, PUSH DUMMY /THE RIGHT OPERAND JMS I PUSHF /PUSH GETPTR /DECODE INFO TAD CHAR /GET THE CHARACTER JMS I PUSHA /PUSH IT JMS I PUSHJ /RECURSIVE CALL EXEC /EXECUTE REST OF LINE TAD I PDLPTR /GET THE STACKED CHARACTER DCA CHAR /RESTORE IT JMS I POPF /POP GETPTR /DECODE INFO JMS I POPF /POP DUMMY /RIGHT OPERAND JMP I LINEND /PROCESS REST OF RELATIONAL OPERATORS RELCHK, JMS I DECODE /DECODE A CHARACTER JMS I TABSCH /LOOKUP AND GO RELOPR-1 /AMONG RELATIONAL OPERATORS RELOGO-RELOPR /SECOND RELATIONAL OPERATOR? JMS I PUSHJ /NO, CALL TO EVAL /EVALUATE RIGHT OPERAND JMP I LINEND /AND START THE RETURN SEQUENCE KSMA, SMA CLA /SKIP-IF-LESS-THAN KSZA, SZA CLA /SKIP-IF-EQUAL KSPA, SPA SNA CLA /SKIP-IF-GREATER-THAN FORGO, INDXLK /BRANCH TABLE FOR MULTIPLE INDEX SET AND FOR SET FORGO1, FOR /FIRST BRANCH TABLE FOR FOR COMMAND *3200 /ZERO, HEADING, XECUTE COMMANDS, NEW FRAN, FIND FUNCTIONS EXEC-1 ENDLIN COMMAC, .-. /ROUTINE TO SKIP IF CHARACTER IS A COMMA TAD CHAR /GET CHARACTER TAD MCOMMA /SUBTRACT COMMA SZA CLA /GOT A COMMA? JMP I COMMAC /NO, JUST RETURN ISZ COMMAC /YES, SET FOR SKIP RETURN JMS I DECODE /IGNORE THE COMMA JMP I COMMAC /DO SKIP RETURN MCOMMA, -254 /NEGATIVE ASCII COMMA NOZVR, .-. /ROUTINE TO DISABLE ZVR FOR A VARIABLE TAD POINT1 /GET POINTER TO VARIABLE DCA QCKPTR /SET POINTER INTO VARIABLE TAD I QCKPTR /GET SIGN OF VARIABLE SZA CLA /IS IT ZERO? JMP I NOZVR /NO, WE ARE DONE CLA IAC /YES, GET A ONE DCA I POINT1 /AND SET EXPONENT TO DENORMALIZE JMP I NOZVR /RETURN ZEROVR, JMS I CHECK /GOT AN ARGUMENT? TERTAB /TERMINATOR MEANS NO JMP ZERALL /NO ARGUMENT, MUST BE ZERO ALL ZERLP, JMS I PUSHJ /RECURSIVE CALL SEEKVR /LOOK UP THE VARIABLE JMS I FPP /ENTER FLOATING POINT MODE FGET I PZERO /GET FLOATING POINT ZERO FPUT I POINT1 /STORE IN THE VARIABLE FEXT /RETURN TO NORMAL MODE JMS I PCOMMA /CHECK FOR A COMMA JMP I PEXEC /NONE, RESUME COMMAND INTERPRETER JMP ZERLP /GO ZERO ANOTHER ZERALL, TAD TXTEND /GET END OF TEXT DCA VAREND /SET AS END OF VARIABLES JMP I PKLEAR /GO EXECUTE MORE COMMANDS WITH CLEAR STACK XEQLP, JMS I CHECK /LOOK AT TERMINATOR TRMTAB /TO SEE IF IT SHOULD BE IGNORED JMS I DECODE /YES, IGNORE IT XECUTE, JMS I PUSHJ /RECURSIVE CALL EVAL /EQUATION SOLVER JMS I CHECK /CHECK TERMINATOR TERTAB+1 /FOR SEMICOLON OR CR JMP I PEXEC /FOUND, GO TO COMMAND INTERPRETER JMP XEQLP /NOT FOUND, EVALUATE ANOTHER EXPRESSION HELLO, JMS I KLSPCE /IGNORE SPACES TAD TXTBEG /GET BEGINNING OF TEXT IAC /SKIP LINE NUMBER (00.00) DCA PUTPTR /SET UP ENCODE POINTER DCA PUTSDE /SET TO ENCODE ON THE LEFT SKP /FIRST CHARACTER ALREADY DECODED HEADLP, JMS I DECODE /DECODE NEXT CHARACTER JMS I ENCODE /ENCODE IT TAD CHAR /GET THE CHARACTER TAD NCR /SUBTRACT CARRIAGE RETURN SZA CLA /WAS IT A CR? JMP HEADLP /NO, KEEP GOING ISZ PUTSDE /YES, CHARACTER HALF ENCODED? JMP .+3 /NO, KEEP GOING TAD PUTWRK /YES, GET HALF-ENCODING DCA I PUTPTR /STORE IT TAD PUTPTR /GET ENCODE POINTER IAC /ADD ONE DCA BUFBEG /SET AS NEW BEGINNING OF BUFFER TAD C2004 /GET %8.04 DCA FORM /SET FP OUTPUT FORMAT JMP I PERASE /GO DO ERASE ALL PERASE, ERASEA /POINTER TO ERASE COMMAND HANDLER C2004, 2004 /%8.04, TO RESET TYPE FORMAT FRAN, JMS I PUSHF /STACK RANDOM /SEED JMS I POPF /UNSTACK FACEXP /AS RESULT (R) JMS I PUSHF /STACK RANDOM /SEED JMS I POPF /UNSTACK OPEXP+1 /AS RIGHT OPERAND JMS I DOUBLE /SEED=SEED*2^13 JMS I DOUBLE /*2^14 JMS I DOUBLE /*2^15 JMS I DOUBLE /*2^16 JMS I PSUM /FORM R*(2^16+1) JMS I DOUBLE /FORM R*(2^17+2) JMS I PSUM /FORM R*(2^17+3) JMS I PUSHF /STACK FACHGH /RESULT JMS I POPF /UNSTACK RANDOM /AS NEW SEED DCA FACLOW /TRUNCATE TO TWO WORDS DCA FACEXP /FORCE INTO RANGE 0..1 JMS I PABS /TAKE ABSOLUTE VALUE JMP I FNCXIT /RETURN FROM FUNCTION CALL RANDOM, 4421 /RANDOM SEED 3040 1 RELOPR, 274 /< /TABLE OF RELATIONAL OPERATORS 275 /= 276 /> FIND, JMS I FIX /TAKE INTEGER PART OF ARGUMENT CIA /NEGATE DCA WORK /SAVE FOR SEARCH FINDL, JMS I INCHAR /GET A CHARACTER TAD WORK /SUBTRACT THE ONE WE ARE LOOKING FOR SNA /wAS THIS IT? JMP I FNCXIT /YES, RETURN CIA /NO, NEGATE DIFFERENCE TAD WORK /RESTORE CHAR WITH WRONG SIGN CIA /RESTORE CHARACTER JMS I TYP /ECHO IT JMP FINDL /GO KEEP LOOKING COMGO, SETFOR /ADDRESS OF SET/FOR COMMAND PROCESSOR SETFOR /ADDRESS OF SET/FOR COMMAND PROCESSOR IF /ADDRESS OF IF COMMAND PROCESSOR DO /ADDRESS OF DO COMMAND PROCESSOR GO /ADDRESS OF GO COMMAND PROCESSOR ENDLIN /ADDRESS OF COMMENT COMMAND PROCESSOR ASK /ADDRESS OF ASK COMMAND PROCESSOR TYPE /ADDRESS OF TYPE COMMAND PROCESSOR HELLO /ADDRESS OF HELLO COMMAND PROCESSOR PKLEAR, KLEAR /ADDRESS OF KLEAR COMMAND PROCESSOR LOCS /ADDRESS OF LOCATIONS COMMAND PROCESSOR ERASE /ADDRESS OF ERASE COMMAND PROCESSOR WRITE /ADDRESS OF WRITE COMMAND PROCESSOR MODIFY /ADDRESS OF MODIFY COMMAND PROCESSOR BRANCH /ADDRESS OF BRANCH COMMAND PROCESSOR START /ADDRESS OF QUIT COMMAND PROCESSOR RETURN /ADDRESS OF RETURN COMMAND PROCESSOR VARBLS /ADDRESS OF VARIABLE COMMAND PROCESSOR XECUTE /ADDRESS OF XECUTE COMMAND PROCESSOR *3400 /SHIFT FAC ONE LEFT, OUTPUT DIGIT ROUTINES ZEROVR /ADDRESS OF ZERO COMMAND PROCESSOR FACLFT, .-. /ROUTINE TO SHIFT FAC LEFT (DOUBLE FAC) TAD FACLOW /GET LOW WORD CLL RAL /SHIFT LEFT, WITH CARRY-OUT DCA FACLOW /SET LOW WORD TAD FACMED /GET MED WORD RAL /SHIFT LEFT, WITH CARRY DCA FACMED /SET MED WORD TAD FACHGH /GET HIGH WORD RAL /SHIFT LEFT, WITH CARRY DCA FACHGH /SET HIGH WORD TAD FACOVR /GET OVERFLOW WORD RAL /GET CARRY-IN DCA FACOVR /SAVE IT JMP I FACLFT /RETURN OUTDIG, .-. /ROUTINE TO OUTPUT A DIGIT TAD C260 /CONVERT TO ASCII DCA WORK /SAVE IT ISZ POWER /DID POWER JUST BECOME ZERO? JMP .+3 /NO, NO '.' NEEDED TAD DOT /YES, GET A DOT JMS I TYP /AND PRINT IT TAD WORK /GET THE DIGIT JMS I PRTCL /PRINT IT CLL CMA RAL /GET NEGATIVE TWO TAD POWER /COMPUTE NEW POWER DCA POWER /STORE NEW POWER ISZ FACEXP /ADJUST DIGIT COUNT ISZ OUTDIG /NO DONE, TAKE THE SKIP RETURN JMP I OUTDIG /RETURN VARNAM, .-. /HOLD AREA FOR VARIABLE NAME TEXT "()=" /TEXT USED BY 'VARIABLES' COMMAND TYPGO, BADFUN /BRANCH TABLE FOR ASK AND TYPE COMMANDS BADFUN FORMAT QUOTES QUOTES EXCLAM NUMSGN TAB BADFUN BADFUN TYPELF TYPIGN TYPIGN EXEC-1 ENDLIN SCRBUF=.-1 /TEMPORARY LINE BUFFER GOES HERE *SCRBUF+46 /TEXT BUFFER (HEADING LINE AND USER PROGRAM) TEXTST, L01V10 0 TEXT "@M" STTEXT=.-1 L01V10, L01V20 0212 /TEXT "TYPE!!'WELCOME TO FOCAL 1976.'!!;SET B,NO=6;DO 1.4;FOR I,YES=3,6;DO 3@M" /bugbug: questions 1,2,3 need to get asked, and their functions written TEXT "TYPE!!'WELCOME TO FOCAL 1976.'!!;SET B,NO=6;DO 1.4;FOR I,YES=4,6;DO 3@M" L01V20, L01V30 0224 TEXT "RETURN@M" L01V30, L01V40 0236 TEXT "TYPE!%4B' WORDS AVAILABLE FOR USER PROGRAMS'!!;HELLO@M" L01V40, L02V10 0250 TEXT "TYPE'WILL YOU NEED:'!@M" L02V10, L02V20 0412 TEXT "TYPE'ATN@M" L02V20, L02V30 0424 TEXT "TYPE'EXP@M" L02V30, L02V40 0436 TEXT "TYPE'LOG@M" L02V40, L02V50 0450 TEXT "TYPE'COS@M" L02V50, L02V60 0462 TEXT "TYPE'SIN@M" L02V60, L03V10 0474 TEXT "TYPE'SQT@M" L03V10, L03V20 0612 TEXT "TYPE'F';DO 2+I/10;ASK'?'R;IF R=YES SET B=I-1;SET I=6;RETURN@M" L03V20, L03V30 0624 TEXT "IF R=NO RETURN@M" L03V30, 0 0636 TEXT "T'PLEASE ANSWER YES OR NO.'!;DO 1.4;GOTO 3.1@M" FREEBF=.-1 *4200 /DIALOG CONTROL PROGRAM INTRO, TLS /START TELETYPE PRINTER TAD INTRO /GET THAT TLS DCA I C200 /DO THAT INSTEAD OF COMING HERE NEXT RESTART JMS I PUSHJ /RECURSIVE CALL DO /PERFORM A 'DO' COMMAND TAD C200 /GET SIXBIT 'B' DCA PUTWRK /STASH AS VARIABLE NAME JMS I PUSHJ /RECURSIVE CALL NOSUB /GO LOOK UP B(0) JMS I FPP /ENTER FLOATING POINT MODE FGET I POINT1 /GET THE VALUE OF B(0) FEXT /RETURN TO NORMAL MODE TAD PFUNTB /GET POINTER TO DELETABLE FUNCTIONS DCA WRKPTR /INITIALIZE POINTER JMS I FIX /GET INTEGER PART SNA /NEED TO DELETE ANYTHING? JMP FNCGNE /NO, SKIP FUNCTION REMOVAL CIA /NEGATE THE COUNT DCA COUNTR /SET UP COUNTER TAD PBADFN /GET POINTER TO ERROR CALL DCA I WRKPTR /REMOVE POINTER TO FUNCTION ISZ COUNTR /DONE THEM ALL? JMP .-3 /NO, DO ANOTHER FNCGNE, CLA CMA /GET NEGATIVE ONE TAD I WRKPTR /POINT TO NEW END OF BUFFER DCA BOTTMP /SET NEW END OF BUFFER TAD BUFBEG /GET BEGINNING OF BUFFER CIA /NEGATE TAD BOTTMP /FORM COUNT OF WORDS AVAILABLE DCA FACHGH /SET HIGH FAC DCA FACMED /CLEAR MED FAC DCA FACLOW /CLEAR LOW FAC TAD P13 /GET THE EXPONENT DCA FACEXP /SET THE EXPONENT JMS I PNORML /NORMALIZE JMS I FPP /ENTER FLOATING POINT MODE FPUT I POINT1 /STORE IN B(0) FEXT /RETURN TO NORMAL MODE JMP I .+1 /RESUME THE DIALOG EXEC-1 /POINTER TO COMMAND INTERPRETER PBADFN, BADFUN /POINTER TO 'ILLEGAL FUNCTION' PFUNTB, DELFUN-1 /POINTER TO DELETABLE FUNCTION TABLE / /HEREAFTER BEGIN THE DELETABLE FUNCTIONS. THE FOCAL PROGRAM BUFFER /WILL OCCUPY THE SPACE FROM 'TEXTST' ABOVE TO ONE WORD BELOW THE /FIRST FUNCTION WHICH WAS *NOT* DELETED. / /bugbug: Currently DELFUN has NULL pointers for FATN, FEXP, and FLOG. /Correspondingly, the dialog has been modified to always delete them. /The first function that is optionally deletable, then, is FCOS. / /bugbug: Routines that are deletable also are generally currently poorly /tested and susceptible to approximation errors due to poor numerical /analysis. / ifdef listing < *5537 BOTTOM=.-1 /FATN code should be inserted here. /FEXP code should be inserted here. /FLOG code exists (likely broken), and should be inserted here. LOGTB=5556 > ifndef listing < *5635 BOTTOM=.-1 > FCOS, JMS I NEGATE /NEGATE THE ARGUMENT JMS I FPP /ENTER FLOATING POINT MODE FADD HALFPI /SUBTRACT FROM PI/2 FEXT /RETURN TO NORMAL MODE FSIN, ISZ FARGSW /IS THERE AN ARGUMENT? SKP /YES, GOOD JMS I ERROR /NO, SIN OR COS WITHOUT AN ARGUMENT TAD FACHGH /GET HIGH FAC SMA CLA /NEGATIVE? JMP SINPOS /NO, ALL SET JMS I NEGATE /YES, MAKE IT POSITIVE CLA CMA /BUT REMEMBER THAT WE DID SINPOS, DCA FARGSW /REMEMBER SIGN OF ARGUMENT JMS I FPP /ENTER FLOATING POINT MODE FPUT I PDUMMY /STORE THE ARGUMENT IN THE PSEUDOVARIABLE FDIV PI /DIVIE BY PI FEXT /RETURN TO NORMAL MODE JMS I FIX /TAKE INTEGER PART RAR /DIVIDE BY TWO (INT(ARG/(2*PI))) SNL CLA /TOP HALF UNIT CIRCLE? JMP .+4 /YES, ONWARD TAD FARGSW /NO, GET ARGUMENT SIGN CMA /COMPLEMENT DCA FARGSW /UPDATE REMEMBERED SIGN JMS I PNORML /NORMALIZE JMS I NEGATE /NEGATE JMS I FPP /ENTER FLOATING POINT MODE FMPY PI /MULTIPLY BY PI FADD I PDUMMY /FORM X MOD PI FPUT I PDUMMY /SAVE IT FSUB HALFPI /SUBTRACT PI/2 FEXT /RETURN TO NORMAL MODE TAD FACHGH /LOOK AT HIGH FAC SPA CLA /NEGATIVE? JMP SINE /YES, PROCEED JMS I FPP /NO, ENTER FLOATING POINT MODE FGET PI /GET PI FSUB I PDUMMY /SUBTRACT X MOD PI FPUT I PDUMMY /SAVE IT FEXT /RETURN TO NORMAL MODE SINE, JMS I FPP /ENTER FLOATING POINT MODE FGET I PDUMMY /GET ALIGNED ARGUMENT FDIV HALFPI /DIVIDE BY PI/2 FPUT I PDUMMY /STORE IT FMPY I PDUMMY /SQUARE IT FPUT XX /STORE FOR A MOMENT FGET I PZERO /GET ZERO FPUT FNCANS /STORE AS PARTIAL SUM FGET I PDUMMY /GET SQUARED ARGUMENT FEXT /RETURN TO NORMAL MODE TAD N5 /GET NEGATIVE FIVE DCA WORK /SET UP TERM COUNTER TAD PSINTB /GET POINTER TO HALFPI SINLP, DCA POINT1 /SET UP TERM POINTER JMS I FPP /ENTER FLOATING POINT MODE FMPY I POINT1 /MULTIPLY BY TERM FADD FNCANS /ADD ANSWER FPUT FNCANS /SET NEW PARTIAL SUM FGET I PDUMMY /GET X^N TERM FMPY XX /FORM NEXT X^N FPUT I PDUMMY /PUT IT BACK FEXT /RETURN TO NORMAL MODE CLL CML IAC RAL /GET A THREE TAD POINT1 /BUMP POINTER ISZ WORK /DONE ENOUGH TERMS? JMP SINLP /NO, GO AGAIN JMS I FPP /ENTER FLOATING POINT MODE FGET FNCANS /GET PARTIAL SUM FOR RETURN FEXT /RETURN TO NORMAL MODE JMS I PUNABS /ADJUST SIGN OF RESULT ISZ FARGSW /NEED TO NEGATE AGAIN? JMP I FNCXIT /NO, RETURN RESULT JMS I NEGATE /YES, NEGATE IT JMP I FNCXIT /RETURN RESULT XX, .-. /HOLD AREA FOR X^2 .-. .-. FNCANS, .-. /HOLD ARE FOR RESULTS .-. .-. PI, 2 /CONSTANT OF PI 3110 3755/3756 /bugbug PSINTB, .+1 /TABLE OF CONSTANTS FOR SIN, COS HALFPI, 1 /FIVE FP CONSTANTS NEEDED FOR SIN, COS SERIES TERMS 3110 3755/3756 /bugbug 0000 5325 0420 7775 2431 5053 7771 5466 6317/6306 7764 2366 5735/5736 *6000 /FSQT, DECIMAL INPUT AIDS, LOCATIONS COMMAND FSQT, JMS I FPP /ENTER FLOATING POINT MODE FPUT N /STORE N FEXT /RETURN TO NORMAL MODE TAD FACHGH /GET HIGH FAC SNA /ZERO? JMP I FNCXIT /YES, WE ARE DONE SPA CLA /POSITIVE? JMS I ERROR /NO, REQUESTED SQUARE ROOT OF NEGATIVE NUMBER TAD FACEXP /YES, GET EXPONENT SPA /POSITIVE? CML /NO, SIGN EXTEND RAR /DIVIDE BY TWO DCA SAVEXP /STORE EXPONENT OF GUESS SZL /NEED ROUNDING? ISZ SAVEXP /YES, ROUND IT NOP /IN CASE OF OVERFLOW TAD C3015 /GET GOOD FIRST GUESS DCA SAVHGH /SET HIGH FAC DCA SAVMED /CLEAR MED FAC DCA SAVLOW /SAVE LOW FAC SQTLP, JMS I FPP /ENTER FLOATING POINT MODE FGET N /GET N FDIV SAVEXP /DIVIDE BY GUESS FADD SAVEXP /ADD GUESS FEXT /RETURN TO NORMAL MODE CLA CMA /GET NEGATIVE ONE TAD FACEXP /FORM DECREMENTED EXPONENT DCA FACEXP /STORE AS EXPONENT TAD FACEXP /GET EXPONENT CIA /NEGATE TAD SAVEXP /ADD TO GUESS EXPONENT SZA CLA /EQUAL? JMP SQTMRE /NO, SET UP TO LOOP AGAIN TAD FACHGH /YESM GET HIGH FAC CIA /NEGATE TAD SAVHGH /ADD HIGH GUESS SZA CLA /EQUAL? JMP SQTMRE /NO, SET UP TO LOOP AGAIN TAD FACMED /YES, GET MED FAC CIA /NEGATE TAD SAVMED /ADD MED GUESS SMA /DIFFERENCE NEGATIVE? CIA /NO, MAKE IT NEGATIVE IAC /INCREMENT SMA CLA /WITHIN ONE EITHER WAY? JMP I FNCXIT /YES, WE ARE DONE SQTMRE, JMS I FPP /ENTER FLOATING POINT MODE FPUT SAVEXP /SET NEW GUESS FEXT /RETURN TO NORMAL MODE JMP SQTLP /AND TRY AGAIN C3015, 3015 SAVEXP, .-. /FLOATING POINT SAVE AREA SAVHGH, .-. SAVMED, .-. SAVLOW, .-. N, .-. /ARGUMENT HOLD AREA FOR FSQT NHGH, .-. NLOW, .-. LOCS, TAD TXTBEG /GET POINTER TO START OF TEXT JMS OCTOUT /PRINT IT TAD TXTEND /GET POINTER TO END OF TEXT JMS OCTOUT /PRINT IT TAD VAREND /GET POINTER TO END OF VARIABLES JMS OCTOUT /PRINT IT TAD BOTTMP /GET LAST FREE ADDRESS JMS OCTOUT /PRINT IT JMP .+3 /DON'T PRINT THIS ONE JMS I DECODE /GET A CHARACTER JMS I PRTCL /PRINT IT TAD CHAR /LOOK AT CHARACTER TAD NCR /SUBTRACT CARRIAGE RETURN SZA CLA /IS IT CARRIAGE RETURN? JMP .-5 /NO, GO AGAIN JMP I C7600 /YES, RETURN TO MONITOR OCTOUT, .-. /ROUTINE TO PRINT OCTAL VALUE OF AC RAL /COMPENSATE FOR LINK DCA SAVE1 /SAVE THE NUMBER TAD N4 /GET NEGATIVE FOUR DCA WORK /SET DIGIT COUNTER OCOUTL, TAD SAVE1 /GET SAVED VALUE RTL /SHIFT TO POSIITON RAL /NEXT DIGIT DCA SAVE1 /SAVE IT TAD SAVE1 /GET IT BACK AND C7 /MASK FOR THE DIGIT TAD C260 /CONVERT TO ASCII JMS I TYP /PRINT IT ISZ WORK /DONE YET? JMP OCOUTL /NO, GO AGAIN TAD CR /YES, GET CARRIAGE RETURN JMS I PRTCL /PRINT IT JMP I OCTOUT /RETURN TO CALLER C7, 7 /MASK FOR OCTAL DIGIT PARTIN, .-. /ROUTINE TO INPUT UNSIGNED INTEGER DCA DIGCNT /RESET DIGIT COUNTER JMS I SRTNUM /CHECK WHETHER '.', 0-9, OR ALPHA JMP I PARTIN /PERIOD, RETURN JMP I PARTIN /ALPHA, RETURN TAD SORTWK /GET THE DIGIT DCA NEWDIG /SET UP FOR NEWDIG JMS NXTDIG /CALL NEWDIG ISZ DIGCNT /BUMP DIGIT COUNT SZA CLA /OVERFLOW? JMS I ERROR /YES, GO TO ERROR ROUTINE JMS I GETCHR /NO, GET A CHARACTER JMP PARTIN+2 /AND GO AGAIN NXTDIG, .-. /ROUTINE TO PUT NEW DIGIT INTO FAC (FAC=FAC*10+DIGIT) TAD FACLOW /GET LOW FAC DCA OPLOW /COPY TO OPERAND TAD FACMED /GET MED FAC DCA OPMED /COPY TO OPERAND TAD FACHGH /GET HIGH FAC DCA OPHGH /COPY TO OPERAND DCA FACOVR /CLEAR OVERFLOW WORD JMS I DOUBLE /OFAC*2 JMS I DOUBLE /OFAC*4 JMS I PSUM /OFAC*5 JMS I DOUBLE /OFAC*10 TAD NEWDIG /GET NEW DIGIT DCA OPLOW /SET OPERAND LOW DCA OPMED /ZERO OPERAND MED DCA OPHGH /ZERO OPERAND HIGH JMS I PSUM /ADD NEW DIGIT TAD FACOVR /GET OVERFLOW WORD JMP I NXTDIG /RETURN IT NEWDIG, .-. /HOLD AREA FOR DIGIT DIGCNT, .-. /COUNT OF DIGITS *6200 /FLOATING POINT OUTPUT ROUTINE FACTYP, .-. /ROUTINE TO TYPE THE VALUE IN FAC TAD FACHGH /GET HIGH FAC SPA CLA /POSITIVE? TAD C15 /NO, GET 15 TAD C240 /FORM '-' OR SPACE JMS I PRTCL /PRINT IT DCA POWER /CLEAR POWER OF TEN JMS I PFLOUT /CALL OUTPUT ALIGNMENT ROUTINE TAD FACOVR /GET OVERFLOW WORD (CONTAINS 0-FIFTEEN) SZA CLA /IS IT ZERO? JMP OUTZER /NO, SKIP SPECIAL SHIFT JMS I PNXTDG /YES, SHIFT IN NEXT DIGIT CLA CMA /GET NEGATIVE ONE TAD POWER /ADJUST POWER OF TEN DCA POWER /SET NEW POWER OF TEN OUTZER, TAD FORM /GET FORMAT CONTROL WORD SNA /SCIENTIFIC NOTATION? JMP SCINOT /YES, GO DO IT JMS I ROT6 /NO, SHIFT DIGIT COUNT TO LOW AC CIA /NEGATE TAD FORM /ADD IN DIGITS ON RIGHT CMA /FORM DIGITS ON LEFT-1 AND C77 /MASK STRAY BITS DCA WORK /SAVE LEFT DIGIT COUNT TAD POWER /GET POWER OF TEN SPA /POSITIVE? CLA /NO, USE ZERO CIA /NEGATE TAD WORK /ADD DIGITS ON LEFT COUNT SPA /TOO MANY DIGITS ON LEFT? JMP SCINOT /YES, SWITCH TO SCIENTIFIC NOTATION CMA /NO, MAKE LEADING SPACE COUNT-1 DCA WORK /SAVE IT TAD FORM /GET FORMAT WORD AND C7600 /GET DIGITS ON LEFT JMS I ROT6 /SHIFT TO LOW AC TAD WORK /SUBTRACT LEADING SPACE COUNT CMA /MAKE POSITIVE RESULT DCA FACEXP /STORE FOR LATER ISZ WORK /TYPED ENOUGH LEADING SPACES? SKP /NO, KEEP GOING JMP .+4 /YES, ON WITH THE OUTPUT TAD C240 /GET A SPACE JMS I TYP /PRINT IT JMP .-5 /AND CHECK AGAIN TAD POWER /GET POWER OF TEN SMA /NEGATIVE? JMP NOSCI /NO, NO NEED TO TYPE ZEROES DCA COUNTR /YES, SET COUNTER DCA POWER /ZERO POWER OF TEN JMS I POUTDG /TYPE A ZERO JMP I FACTYP /NO MORE DIGITS, RETURN ISZ COUNTR /NEED MORE? JMP .-3 /YES, DO ANOTHER JMP NOSCI /NO, PROCEED WITH OUTPUT SCINOT, CLA /CLEAR CRUFT TAD N6 /GET NEGATIVE SIX DCA FACEXP /SET UP DIGIT COUNT TAD POWER /GET POWER OF TEN DCA SAVE1 /SAVE IT DCA POWER /KLUDGE FOR '.' PLACEMENT CMA /GET NEGATIVE ONE NOSCI, DCA SIGNSW /SET SCIENTIFIC NOTATION SWITCH DCA COUNTR /CLEAR TRAILING ZERO COUNTER CLL CML IAC RTL /GET CONSTANT SIX TAD FACEXP /SUBTRACT DIGIT COUNTER SPA /NEED TRAILING SPACES? DCA COUNTR /YES, SAVE HOW MANY TAD N6 /GET NEGATIVE SIX DCA FACEXP /SET AS DIGIT COUNT TAD FACOVR /GET FIRST DIGIT TAD N12 /SUBTRACT TEN SPA CLA /CORRECTLY ALIGNED? JMP ODIGOK /YES, GO OUTPUT IT IAC /NO, GET A ONE JMS I POUTDG /OUTPUT THAT JMP I FACTYP /NO MORE DIGITS; SHOULD NEVER HAPPEN TAD N12 /GET NEGATIVE TEN ODIGOK, TAD FACOVR /ADD TO OVERFLOW WORD SKP /AND PROCEED CMPDIG, JMS I PNXTDG /GET NEXT DIGIT JMS I POUTDG /OUTPUT THE DIGIT SKP /NO MORE DIGITS, CHECK FOR SCI. NOTATION JMP CMPDIG /MORE DIGITS, GO DO THEM TAD COUNTR /GET TRAILING ZERO COUNT SNA CLA /NEED A TRAILING ZERO? JMP .+5 /NO, PROCEED JMS I POUTDG /YES, OUTPUT A ZERO C15, 15 /CONSTAND TO CONVERT SPACE TO MINUS SIGN ISZ COUNTR /NEED MORE? JMP .-3 /YES, LOOP AGAIN ISZ SIGNSW /SCIENTIFIC NOTATION? JMP I FACTYP /NO, WE ARE DONE TAD C305 /YES, GET 'E' JMS I PRTCL /PRINT IT TAD SAVE1 /GET SAVED POWER OF TEN SPA /POSITIVE? CIA /NO, MAKE IT POSITIVE DCA FACHGH /SAVE FOR A MOMENT TAD SAVE1 /GET POWER OF TEN AGAIN SPA CLA /POSITIVE? TAD C15 /NO, GET 15 TAD C240 /FORM SPACE OR MINUS SIGN JMS I PRTCL /PRINT IT TAD FACHGH /GET POWER OF TEN (POSITIVE) ISZ FACEXP /BUMP RESULT LOCATION TAD N144 /SUBTRACT ONE HUNDRED SMA /NEGATIVE? JMP .-3 /NO, GO AGAIN TAD C144 /YES, UNDO LAST SUBTRACTION DCA FACHGH /SAVE POWER MOD ONE-HUNDRED CMA /GET NEGATIVE ONE TAD FACEXP /FORM FIRST DIGIT SZA /IS IT ZERO? JMS I POUTDG /NO, OUTPUT IT TAD FACHGH /GET REMAINING POWER OF TEN JMS I PDCOUT /OUTPUT IT JMP I FACTYP /RETURN PFLOUT, FLOUT /POINTER TO OUTPUT ALIGNMENT ROUTINE PDCOUT, DCDGTS /POINTER TO TWO DIGIT DECIMAL OUTPUT ROUTINE C305, 305 /ASCII 'E', FOR SCIENTIFIC NOTATION N6, -6 /NEGATIVE SIX, SIGNIFICANT DIGIT MAXIMUM N144, -144 /NEGATIVE ONE HUNDRED C144, 144 /POSITIVE ONE HUNDRED PNXTDG, NXTDIG /ROUTINE TO ENTER NEXT DIGIT IN FAC POUTDG, OUTDIG /POINTER TO OUTPUT DIGIT ROUTINE *6400 /FLOATING POINT INPUT, OUTDIG, OUTPUT ALIGNMENT ROUTINE FLOUT, .-. /DECIMAL OUTPUT ALIGNMENT ROUTINE JMS I PABS /TAKE ABSOLUTE VALUE FIXPWR, TAD FACEXP /GET FAC EXPONENT SPA /POSITIVE? JMP SMALL /NO, NUMBER IS LESS THAN ONE TAD N4 /YES, SUBTRACT FOUR SNA SPA CLA /STILL POSITIVE AND NON-ZERO? JMP PWROK /NO, THE POWER OF TEN IS CLOSE JMS I FPP /YES, ENTER FLOATING POINT MODE FDIV TEN /DIVIDE BY TEN FEXT /RETURN TO NORMAL MODE ISZ POWER /BUMP THE POWER OF TEN JMP FIXPWR /AND CHECK AGAIN SMALL, JMS I FPP /ENTER FLOATING POINT MODE FMPY TEN /MULTIPLY BY TEN FEXT /RETURN TO NORMAL MODE CMA /GET NEGATIVE ONE TAD POWER /FORM DECREMENTED POWER OF TEN DCA POWER /STORE IT JMP FIXPWR /AND GO AGAIN PWROK, DCA I PNWDIG /ZERO THE NEW DIGIT DCA FACOVR /ZERO FAC OVERFLOW AREA TAD FACEXP /GET FAC EXPONENT CLL CMA /NEGATE AND SUBTRACT ONE DCA FACINP /STORE HOW MANY TIMES TO DOUBLE JMS I DOUBLE /DOUBLE THE FAC ISZ FACINP /DONE? JMP .-2 /NO, GO AGAIN DCA OPLOW /YES, ZERO LOW OPERAND TAD FACOVR /GET FAC OVERFLOW WORD SNA CLA /IS IT ZERO? TAD N114 /YES, ADJUST ROUNDING CONSTANT TAD C124 /FORM 0.00000500679 DCA OPMED /ZERO MED OPERAND DCA OPHGH /ZERO HIGH OPERAND JMS I PSUM /ROUND THE FAC TAD FACOVR /GET FIRST DIGIT (ZERO TO FIFTEEN) TAD N12 /SUBTRACT TEN SMA CLA /IS IT DECIMAL? ISZ POWER /NO, BUMP POWER OF TEN JMP I FLOUT /RETURN PNWDIG, NEWDIG /POINTER TO NEW DIGIT HOLD AREA FACINP, .-. /ROUTINE TO INPUT FLOATING POINT NUMBER JMS I PUSHF /PUSH FACEXP /FLOATING AC JMS I POPF /POP DUMMY /INTO SAVE AREA DCA FACEXP /CLEAR FAC EXPONENT DCA FACHGH /CLEAR HIGH FAC DCA FACMED /CLEAR MED FAC DCA FACLOW /CLEAR LOW FAC JMS I PPRTIN /INPUT DECIMAL INTEGER TAD CHAR /GET CHARACTER TAD N256 /SUBTRACT '.' SZA CLA /GOT A DOT? JMP NOFRCT /NO, SKIP FRACTION BIT JMS I GETCHR /GET NEXT CHARACTER JMS I PPRTIN /INPUT ANOTHER INTEGER TAD I PDGCNT /GET DIGIT COUNT CIA /NEGATE NOFRCT, DCA POWER /SAVE POWER OF TEN TAD C43 /GET DECIMAL 35 DCA FACEXP /SET AS FAC EXPONENT JMS I PNORML /NORMALIZE TAD CHAR /GET THE CHARACTER TAD N305 /SUBTRACT 'E' SZA CLA /WAS IT 'E'? JMP SAVFAC /NO, SKIP POWER OF TEN INPUT JMS I PUSHF /YES, PUSH FACEXP /FAC JMS I POPF /POP SAVEXP /INTO SAVE AREA PWRIGN, CLA /STILL NEED THIS? JMS I GETCHR /GET NEXT CHARACTER JMS I KLSPCE /IGNORE SPACES TAD CHAR /LOOK AT CHARACTER TAD N253 /SUBTRACT '+' SNA /IS IT '+; JMP PWRIGN /YES, IGNORE IT TAD N2 /SUBTRACT TWO SZA CLA /IS IT '-'? JMP PWRIN /NO, PROCEED CMA /YES, GET NEGATIVE ONE DCA SIGNSW /SET SIGN SWITCH JMP PWRIGN+1 /AND CONTINUE PWRIN, DCA FACHGH /ZERO FAC HIGH DCA FACLOW /ZERO FAC LOW JMS I PPRTIN /CALL INTEGER INPUT JMS I PUNABS /RESTORE SIGN TAD FACLOW /GET POWER OF TEN TAD POWER /ADD OLD POWER OF TEN DCA POWER /SAVE NEW POWER OF TEN JMS I PUSHF /PUSH SAVEXP /SAVED FP VALUE JMS I POPF /POP FACEXP /INTO FAC SAVFAC, JMS I PUSHF /PUSH DUMMY /VALUE OF FAC ON ENTRY PWRFIX, TAD POWER /GET POWER OF TEN SNA /IS IT ZERO? JMP INPXIT /YES, WE ARE DONE SMA CLA /NO, TOO SMALL OR TOO LARGE? JMP TOOSML /TOO SMALL JMS I FPP /ENTER FLOATING POINT MODE FDIV TEN /DIVIDE BY TEN FEXT /RETURN TO NORMAL MODE IAC /GET A ONE JMP UPPWR /GO UPDATE POWER OF TEN TOOSML, JMS I FPP /ENTER FLOATING POINT MODE FMPY TEN /MULTIPLY BY TEN FEXT /RETURN TO NORMAL MODE CMA /GET A NEGATIVE ONE UPPWR, TAD POWER /ADD TO POWER OF TEN DCA POWER /SET NEW POWER OF TEN JMP PWRFIX /GO CHECK MAGNITUDE AGAIN INPXIT, JMS I FPP /ENTER FLOATING POINT MODE FPUT I PDUMMY /STORE OUR RESULT FEXT /RETURN TO NORMAL MODE JMS I POPF /POP FACEXP /ORIGINAL FAC VALUE JMP I FACINP /RETURN TO CALLER PPRTIN, PARTIN /POINTER TO UNSIGNED INTEGER INPUT ROUTINE PDGCNT, DIGCNT /POINTER TO DIGIT COUNTER N253, -253 /NEGATIVE ASCII '+' N114, -114 /ROUNDING CONSTANT C43, 43 /DECIMAL 35 TO KLUDGE EXPONENT C124, 124 /ROUNDING CONSTANT TEN, 4 /FLOATING POINT CONSTANT OF TEN *6600 /FLOATING POINT ARITHMETIC MOITOR 2400 0 FLTPKG, .-. /FLOATING POINT INTERPRETER CLA CLL /IGNORE ANYTHING IN AC DCA FACLOW /CLEAR LOW FAC DCA OPLOW /CLEAR LOW OPERAND TAD I FLTPKG /GET FP INSTRUCTION SNA /IS IT ZERO? JMP I FLTPKG /YES, WE ARE DONE DCA INST /SAVE FP INSTRUCTION TAD INST /GET FP INSTRUCTION AND C200 /GET PAGE BIT SZA CLA /PAGE ZERO? TAD FLTPKG /NO, GET FP PC (YES, GET 00000) AND C7600 /MASK FOR PAGE BITS DCA OPEXP /STORE PAGE BITS TAD INST /GET INSTRUCTION AND C177 /ISOLATE PAGE OFFSET TAD OPEXP /ADD PAGE BITS DCA OPEXP /STORE OPERAND ADDRESS TAD INST /GET FP INSTRUCTION AND C400 /LOOK AT INDIRECT BIT SNA CLA /IS IT SET? JMP .+3 /NO, SKIP INDIRECTION TAD I OPEXP /YES, DO INDIRECTION DCA OPEXP /STORE OPERAND ADDRESS ISZ FLTPKG /ADVANCE FP PC CMA /GET NEGATIVE ONE TAD OPEXP /GET OPERAND ADDRESS DCA FPPTR1 /SET UP AUTOINDEX TAD INST /GET INSTRUCTION CLL RTL /SHIFT OPCODE TO LOW AC RTL / AND C17 /MASK FOR OPCODE SNA /IS IT FGET? JMP GET /YES, GO DO IT TAD FPPTAB /NO, ADD DISPATCH POINTER DCA INST /STORE RESULT TAD I INST /GET TABLE ENTRY SNA /IS IT FPUT? JMP PUT /YES, GO DO IT DCA INST /NO, SAVE IT TAD POPRND /GET POINTER TO OPERAND DCA FPPTR2 /SET UP DESTINATION TAD FACLEN /GET FAC LENGTH DCA COUNTR /SET UP COUNTER TAD I FPPTR1 /GET FROM OPERAND DCA I FPPTR2 /STORE IN OPERAND AREA ISZ COUNTR /DONE? JMP .-3 /NO, DO ANOTHER JMP I INST /DISPATCH THE INSTRUCTION INST, .-. /WORK AREA FOR INSTRUCTION INTERPRETATION C400, 400 /CONSTANT FOR INDIRECTION BIT FPPTAB, FPPGO-1 /POINTER TO DISPATCH TABLE PUT, TAD PFAC /SET FAC AS SOURCE JMP GET+4 /GO DO COPY GET, TAD PFAC /GET FAC POINTER DCA FPPTR1 /SET AS DESTINATION CMA /GET NEGATIVE ONE TAD OPEXP /COMPUTE POINTER TO OPERAND DCA FPPTR2 /SET AS SOURCE TAD FACLEN /GET FAC LENGTH DCA COUNTR /SET UP COUNTER TAD I FPPTR2 /GET FROM SOURCE DCA I FPPTR1 /STORE IN DESTINATION ISZ COUNTR /DONE YET? JMP .-3 /NO, DO ANOTHER JMP FLTPKG+1 /RESUME AT NEXT INSTRUCTION PFAC, FACEXP-1 /POINTER TO FAC POPRND, OPEXP-1 /POINTER TO OPERAND SUB, JMS I PNEGO /NEGATE THE FAC BEFORE ADD ADD, JMS I PALIGN /ALIGN FAC AND OPERAND JMP FLTPKG+1 /NO ADDITION NEEDED, PROCEED JMS I PFACRT /SHIFT FAC RIGHT JMS I POPRT /SHIFT OPERAND RIGHT JMS I PSUM /ADD THEM TOGETHER NOR, JMS I PNORML /NORMALIZE THE RESULT JMP FLTPKG+1 /PROCEED TO NEXT INSTRUCTION XPN, TAD FACHGH /GET FAC HIGH SZA CLA /IS IT ZERO? JMP NOZOT /NO, ONWARD /bugbug: Isn't 0^0 == 1?? ZOTFAC, DCA FACEXP /YES, CLEAR FAC EXPONENT (0^N==0) DCA FACHGH /CLEAR FAC HIGH DCA FACMED /CLEAR FAC ME DCA FACLOW /CLEAR FAC LOW JMP FLTPKG+1 /PROCEED TO NEXT INSTRUCTION NOZOT, JMS I PUSHF /PUSH FACEXP /FAC JMS I PUSHF /PUSH OPEXP /OPERAND JMS I POPF /POP FACEXP /FAC JMS I FIX /TAKE INTEGER PART SPA /EXPONENT POSITIVE? JMP UPBAD /NO, GO REPORT ERROR CMA /NEGATE AND SUBTRACT ONE DCA INST /SET UP MULTIPLY COUNTER DCA OPLOW /ZERO OPERAND LOW TAD FACHGH /GET HIGH FAC SZA CLA /EXPONENT > 2047? UPBAD, JMS I ERROR /YES, REPORT BAD EXPONENT JMS I PUSHF /PUSH ONE /A FLOATING POINT ONE JMS I POPF /POP FACEXP /AS RESULT SO FAR JMS I POPF /POP SAVEXP /NUMBER TO EXPONENTIATE JMP MULDNE /PRETEND A MULTIPLY WAS DONE XPNLP, JMS I PUSHF /PUSH SAVEXP /NUMBER TO EXPONENTIATE JMS I POPF /POP OPEXP /AS OPERAND JMS I PFPMUL /MULTIPLY MULDNE, ISZ INST /DONE MULTIPLYING? JMP XPNLP /NO, GO MULTIPLY JMP FLTPKG+1 /YES, GO DO NEXT INSTRUCTION MUL, JMS I PFPMUL /MULTIPLY BY OPERAND JMP FLTPKG+1 /ON TO NEXT INSTRUCTION PALIGN, ALIGN /POINTER TO ALIGNMENT ROUTINE PNEGO, NEGO /POINTER TO NEGATION ROUTINE PFPMUL, FPMUL /POINTER TO MULTIPLY ROUTINE ASKCHR, 203 /^C /CHARACTERS RELEVANT IN ASK COMMANDS 212 /LF 214 /FF 377 /DEL ASK2, 233 /ESC 337 /ARROW FPPGO, ADD /BRANCH TABLE FOR FLOATING POINT PACKAGE *7000 /MISCELLANEOUS FLOATING POINT ARITHMETIC SUBROUTINES SUB DIV MUL XPN 0 NOR NEGF, .-. /ROUTINE TO NEGATE FLOATING AC CLA CLL /GET CLEAN AC TAD FACLOW /GET LOW WORD CIA /NEGATE IT DCA FACLOW /STORE IT TAD FACMED /GET MIDDLE WORD CMA /NEGATE IT SZL /CARRY IN? CLL IAC /YES, IAC DCA FACMED /STORE IT TAD FACHGH /GET HIGH WORD CMA /NEGATE IT SZL /CARRY IN? CLL IAC /YES, INCREMENT DCA FACHGH /STORE IT JMP I NEGF /RETURN TO CALLER ALIGN, .-. /ALIGN THE FAC AND THE OPERAND TAD FACHGH /GET FAC HIGH SNA /IS IT ZERO? TAD FACMED /YES, ADD MED FAC SNA CLA /STILL ZERO? JMP GETOPR /YES, GO GET OPERAND AND TAKE 'FAIL' RETURN TAD OPHGH /NO, GET HIGH OPERAND SNA /IS IT ZERO? TAD OPMED /YES, GET MED OPERAND SNA /STILL ZERO? TAD OPLOW /YES, GET LOW OPERAND SNA CLA /STILL ZERO? JMP I ALIGN /YES, JUST RETURN TAD OPEXP /GET OPERAND EXPONENT CIA /NEGATE TAD FACEXP /ADD FAC EXPONENT SNA /EQUAL? JMP ALGNOK /YES, ALIGNMENT IS OK DCA NEGF /NO, STORE SHIFT COUNT TAD NEGF /GET SHIFT COUNT SMA /NEGATIVE? CIA /NO, MAKE IT NEGATIVE DCA ALGNSV /SAVE NEGATIVE SHIFT COUNT TAD ALGNSV /GET IT BACK TAD C27 /ADD TWENTY SEVEN SPA CLA /TOO FAR APART? JMP ALGNFL /YES, GO TAKE FAIL RETURN TAD NEGF /GET SHIFT COUNT SMA CLA /NEGATIVE? JMP OPALGN /NO, PROCEED JMS I PFACRT /SHIFT FAC RIGHT ISZ ALGNSV /DONE ENOUGH? JMP .-2 /NO, SHIFT AGAIN JMP ALGNOK /YES, PROCEED OPALGN, CMA /FORM NEGATIVE SHIFT COUNT TAD OPEXP /FORM NEW EXPONENT DCA OPEXP /UPDATE OPERAND EXPONENT JMS I POPRT /SHIF OPERAND RIGHT ISZ ALGNSV /DONE ENOUGH? JMP .-2 /NO, DO ANOTHER ALGNOK, ISZ ALIGN /SET UP FOR SKIP (OK) RETURN JMP I ALIGN /RETURN TO CALLER ALGNFL, TAD OPEXP /GET OPERAND EXPONENT SMA CLA /IS IT NEGATIVE? JMP ALGNCK /NO, CHECK ALIGNMENT TAD FACEXP /YES, GET FAC EXPONENT SMA CLA /IS IT NEGATIVE? JMP I ALIGN /NO, RETURN JMP CHKDIF /YES, GO CHECK DIFFERENCE ALGNCK, TAD FACEXP /LOOK AT FAC EXPONENT SMA CLA /IS OP EXP > 0 AND FAC EXP < 0? CHKDIF, TAD NEGF /NO, LOOK AT DIFFERENCE SZA SMA CLA /FAC > OPERAND? JMP I ALIGN /YES, RETURN GETOPR, TAD OPEXP /NO, GET OPERAND EXPONENT DCA FACEXP /SET FAC EXPONENT TAD OPHGH /GET OPERAND HIGH DCA FACHGH /SET FAC HIGH TAD OPMED /GET OPERAND MED DCA FACMED /SET FAC MED TAD OPLOW /GET OPERAND LOW DCA FACLOW /SET FAC LOW JMP I ALIGN /RETURN ALGNSV, .-. /SAVE AREA FOR ALIGN ROUTINE C27, 27 /THENTY SEVEN BITS (TOO FAR FOR ALIGN) SUM, .-. /ROUTINE TO ADD FAC AND OPERAND (MUST ALIGN FIRST) CLA CLL /CLEAR CRUFT TAD FACLOW /GET LOW FAC TAD OPLOW /ADD LOW OPERAND DCA FACLOW /STORE LOW RESULT RAL /GET CARRY-IN TAD FACMED /ADD MED FAC TAD OPMED /ADD MED OPERAND DCA FACMED /STORE MED RESULT RAL /GET CARRY-IN TAD FACHGH /ADD FAC HIGH TAD OPHGH /ADD OPERAND HIGH DCA FACHGH /STORE RESULT HIGH RAL /GET CARRY-IN TAD FACOVR /ADD FAC OVERFLOW DCA FACOVR /STORE RESULT OVERFLOW JMP I SUM /RETURN TO CALLER OPRGHT, .-. /ROUTINE TO SHIFT OPERAND RIGHT AND RETAIN VALUE CLA CLL /CLEAR CRUFT TAD OPHGH /GET OPERAND HIGH SPA /NEED SIGN EXTEND? CLL CML /YES, DO IT RAR /SHIFT RIGHT DCA OPHGH /STORE OPERAND HIGH TAD OPMED /GET OPERAND MED RAR /SHIFT RIGHT DCA OPMED /STORE OPERAND MED TAD OPLOW /GET OPERAND LOW RAR /SHIFT RIGHT DCA OPLOW /STORE OPERAND LOW ISZ OPEXP /ADJUST OPERAND EXPONENT JMP I OPRGHT /RETURN TO CALLER JMP I OPRGHT /RETURN TO CALLER (EXPONENT BECAME ZERO) UNQUOT, 215 /CR /TABLE OF CHARACTERS WHICH TERMINATE QUOTES 247 /' 242 /" -1 IMMDGO, CNTRLC /BRANCH TABLE FOR COMMAND MODE SCRAP LFECHO CARRET *7200 /MULTIPLY, SGNFIX, SGNSET, NEGO, FACRT, ABS, UNABS FPMUL, .-. /FLOATING POINT MULTIPLY ROUTINE IAC /ADD ONE TAD OPEXP /TO OPERAND EXPONENT JMS SGNSET /COMPUTE SIGN OF RESULT SPA CLA /OPERAND NEGATIVE? JMS NEGO /YES, MAKE IT POSITIVE DCA RESLT1 /CLEAR RESULT HIGH DCA RESLT2 /CLEAR RESULT MED DCA RESLT3 /CLEAR RESULT LOW DCA RESLT4 /CLEAR RESULT ULTRALOW TAD FACHGH /GET HIGH FAC DCA I MLTCND /SET UP AS MULTIPLICAND TAD OPHGH /GET HIGH OPERAND JMS I PHSMUL /MULTIPLY HIGH WORDS RESLT2 /INTO RESLT2 TAD OPMED /TAD OPMED JMS I PHSMUL /MULTIPLY OP MED,FAC MED RESLT3 /INTO RESLT3 TAD FACMED /GET FAC MED DCA I MLTCND /SET UP AS MULTIPLICAND TAD OPHGH /GET OP HIGH JMS I PHSMUL /MULTIPLY FAC MED, OP HIGH RESLT3 /INTO RESULT3 TAD OPMED /GET OP MED JMS I PHSMUL /MULTIPLY FAC MED, OP MED RESLT4 /INTO RESLT4 TAD RESLT1 /GET HIGH RESULT DCA FACHGH /SET AS FAC HIGH TAD RESLT2 /GET MED RESULT DCA FACMED /SET AS FAC MED TAD RESLT3 /GET LOW RESULT DCA FACLOW /SET AS FAC LOW JMS SGNFIX /RESTORE SIGN JMP I FPMUL /RETURN TO CALLER RESLT4, .-. /RESULT ULTRALOW RESLT3, .-. /RESULT LOW RESLT2, .-. /RESULT MED RESLT1, .-. /RESULT HIGH SGNFIX, .-. /ROUTINE TO FIX RESULT BASED ON SIGN TAD FACLOW /GET FAC LOW SPA CLA /ROUNDING NEEDED? ISZ FACMED /YES, INCREMENT FAC MED SKP /AND CONTINUE ISZ FACHGH /INCREMENT FAC HIGH (bugbug: notreached?) DCA FACLOW /ZERO FAC LOW ISZ SIGNSW /NEED TO NEGATE? JMS I NEGATE /YES, DO IT JMS I PNORML /NORMALIZE JMP I SGNFIX /RETURN DIV, TAD OPHGH /GET OPERAND HIGH SNA CLA /IS IT ZERO? JMS I ERROR /YES, DIVIDING BY ZERO TAD OPEXP /GET OPERAND EXPONENT CIA /NEGATE IAC /INCREMENT JMS SGNSET /GET SIGN OF RESULT SMA CLA /OPERAND NEGATIVE? JMS NEGO /NO, NEGATE IT JMS I PHSDIV /DO INTEGER DIVIDE JMS SGNFIX /RESTORE SIGN OR RESULT JMP I .+1 /GO EXECUTE FLTPKG+1 /NEXT FPP INSTRUCTION SGNSET, .-. /ROUTINE TO UPDATE FACEXP AND SET SIGNSW TAD FACEXP /UPDATE FAC EXPONENT DCA FACEXP /SET NEW FAC EXPONENT CLL CML RAR /GET A 4000 AND FACHGH /GET SIGN OF FAC TAD OPHGH /ADD SIGN OF OPERAND SMA CLA /SAME SIGN? CMA /YES, SET FLAG DCA SIGNSW /SET SIGN FLAG FOR RESULT TAD FACHGH /GET FAC HIGH SNA /IS IT ZERO? JMP I PZOTF /YES, GO FORCE ZERO SPA CLA /NO, IS IT POSITIVE? JMS I NEGATE /NO, MAKE IT POSITIVE TAD OPHGH /GET HIGH OPERAND SNA /IS IT ZERO? JMP I PZOTF /YES, FORCE ZERO JMP I SGNSET /RETURN TO CALLER PZOTF, ZOTFAC /POINTER TO ROUTINE TO ZERO RESULT AND CONTINUE PHSDIV, HSDIV /INTEGER HIGH SPEED DIVIDE MLTCND, MEDIFF /POINTER TO SAVE AREA FOR MULTIPLICAND PHSMUL, HSMUL /INTEGER HIGH SPEED MULTIPLY NEGO, .-. /ROUTINE TO NEGATE THE OPERAND CLA CLL /CLEAR CRUFT TAD OPLOW /GET OPERAND LOW CIA /NEGATE DCA OPLOW /SET OPERAND LOW TAD OPMED /GET OPERAND MED CMA /COMPLEMENT SZL /CARRY-IN? CLL IAC /YES, INCREMENT DCA OPMED /SET OPERAND MED TAD OPHGH /GET OPERAND HIGH CMA /COMPLEMENT SZL /CARRY-IN CLL IAC /YES, INCREMENT DCA OPHGH /SET OPERAND HIGH JMP I NEGO /RETURN UNABS, .-. /RESTORE SIGN AS NEEDED TAD SIGNSW /CHECK THE SIGN SWITCH SPA CLA /NEED TO NEGATE? JMS I NEGATE /YES, DO SO JMP I UNABS /RETURN FACRT, .-. /SHIFT FAC RIGHT CLA CLL /CLEAR CRUFT TAD FACHGH /GET FAC HIGH SPA /NEED TO SIGN EXTEND? CML /YES, DO IT RAR /SHIFT RIGHT DCA FACHGH /SET FAC HIGH TAD FACMED /GET FAC MED RAR /SHIFT RIGHT DCA FACMED /SET FAC MED TAD FACLOW /GET FAC LOW RAR /SHIFT RIGHT DCA FACLOW /SET FAC LOW ISZ FACEXP /ADJUST EXPONENT JMP I FACRT /RETURN JMP I FACRT /RETURN (EXPONENT BECAME ZERO) ABS, .-. /TAKE ABSOLUTE VALUE TAD FACHGH /GET FAC SIGN DCA SIGNSW /REMEMBER IT TAD FACHGH /GET IT AGAIN SPA CLA /WAS IT NEGATIVE? JMS I NEGATE /YES, MAKE IT POSITIVE JMP I ABS /RETURN TO CALLER *7400 /INTEGER MULTIPLY, DIVIDE, NORMALIZE, INTEGER PART ROUTINES HSMUL, .-. /DOUBLE PRECISION INTEGER MULTIPLY ROUTINE SNA /MULTIPLY BY ZERO? JMP HSMXIT /YES, GO RETURN DCA ANSLOW /NO, SAVE AS LOW PRODUCT DCA ANSHGH /SET ZERO FOR HIGH PRODUCT TAD N14 /GET NEGATIVE TWELVE DCA BITCNT /STORE IN BIT COUNTER CLL /CLEAR CARRY-IN MULLP, TAD ANSLOW /GET LOW PRODUCT RAR /IN RESULT BIT, MULTIPLIER BIT OUT DCA ANSLOW /SAVE LOW PRODUCT TAD ANSHGH /GET HIGH PRODUCT SZL /WAS MULTIPLIER BIT SET? TAD MEDIFF /YES, ADD MULTIPLICAND CLL RAR /RIGHT SHIFT IT DCA ANSHGH /SET NEW HIGH PRODUCT ISZ BITCNT /DONE ALL BITS? JMP MULLP /NO, GO AGAIN TAD ANSLOW /YES, GET LOW RESULT RAR /SHIFT IN LAST BIT DCA BITCNT /SAVE IT TAD I HSMUL /GET PARAMETER DCA ANSLOW /STORE POINTER TAD BITCNT /GET LOW RESULT CLL /CLEAR CARRY-OUT TAD I ANSLOW /ADD LOW ANSWER ALREADY THERE DCA I ANSLOW /SET LOW ANSWER BITS ISZ ANSLOW /POINT TO HIGH ANSWER RAL /GET CARRY TAD ANSHGH /ADD HIGH RESULT TAD I ANSLOW /ADD HIGH ANSWER ALREADY THERE DCA I ANSLOW /SET NEW ANSWER BITS SNL /CARRY OUT? JMP HSMXIT /NO, GO EXIT ISZ ANSLOW /YES, INCREMENT POINTER ISZ I ANSLOW /INCREMENT NEXT HIGHER WORD JMP HSMXIT /GO EXIT JMP .-3 /OVERFLOW, GO INCREMENT NEXT HSMXIT, ISZ HSMUL /SKIP OVER ARGUMENT JMP I HSMUL /RETURN TO CALLER ANSHGH, .-. /HIGH PART OF ANSWER ANSLOW, .-. /LOW PART OF ANSWER BITCNT, .-. /BIT COUNTER FOR MULTIPLY AND DIVIDE MEDIFF, .-. /HOLD ARE FOR MEDIUM AREA DIFFERENCE N14, -14 /NEGATIVE TWELVE N27, -27 /NEGATIVE TWENTY THREE N30, -30 /NEGATIVE TWENTY FOUR HSDIV, .-. /DOUBLE PRECISION DIVIDE ROUTINE DCA HSMUL /CLEAR HIGH ORDER RESULT DCA ANSLOW /CLEAR LOW ORDER RESULT TAD N30 /GET NEGATIVE TWENTY FOUR DCA BITCNT /SET UP BIT COUNTER SKP /NO NEED TO SHIFT THE FIRST TIME DIVLP, JMS I DOUBLE /SHIFT FAC LEFT CLL /CLEAR CARRY INDICATOR TAD OPMED /GET OPERAND MED TAD FACMED /ADD TO FAC MED DCA MEDIFF /SAVE DIFFERENCE MED RAL /GET CARRY TAD FACHGH /ADD FAC HIGH TAD OPHGH /ADD OPERAND HIGH SNL /CARRY OUT? JMP NOSUBT /NO, SKIP SUBTREACTION DCA FACHGH /YES, STORE NEW FAC HIGH TAD MEDIFF /GET DIFFERENCE MED DCA FACMED /SAVE AS NEW FAC MED NOSUBT, CLA /CLEAR CRUFT ISZ BITCNT /DONE ALL BITS? SKP /NO, CONTINUE JMP DIVXIT /YES, GO EXIT TAD ANSLOW /GET ANSWER LOW RAL /SHIFT IN NEW BIT DCA ANSLOW /SAVE ANSWER LOW TAD HSMUL /GET ANSWER HIGH RAL /SHIFT IN NEW BIT DCA HSMUL /SET ANSWER HIGH JMP DIVLP /LOOP FOR ANOTHER BIT DIVXIT, RAR /GET CARRY TO HIGH AC DCA FACLOW /SAVE IT TO ROUNDOFF WORD TAD ANSLOW /GET LOW ANSWER IAC /INCREMENT (ROUND UP) DCA FACMED /STORE FAC MED RAL /GET CARRY OUT TAD HSMUL /ADD HIGH RESULT DCA FACHGH /STORE FAC HIGH JMP I HSDIV /RETURN NORMAL, .-. /ROUTINE TO NORMALIZE FAC JMS I PABS /TAKE ABSOLUTE VALUE CLL CML RAR /GET 4000 TAD FACHGH /AND WITH FAC HIGH SNA CLA /IS 4000 SET? JMS I PFACRT /YES, SHIFT ONE RIGHT TAD FACHGH /GET FAC HIGH SNA /NONZERO? TAD FACMED /NO, LOOK IN FAC MED SNA /STILL ZERO? TAD FACLOW /YES, LOOK IN FAC LOW SNA CLA /WELL AND TRULY ZERO? JMP NRMZRO /YES, GO RETURN ZERO NRMLP, TAD FACHGH /NO, LOOK AT FAC HIGH CLL RAL /SHIFT LEFT SPA CLA /TOP BIT NOW ON? JMP NRMXIT /YES, WE ARE DONE JMS I DOUBLE /NO, DOUBLE IT CLL CMA /GET NEGATIVE ONE TAD FACEXP /ADJUST FAC EXPONENT DCA FACEXP /SAVE NEW EXPONENT JMP NRMLP /GO CHECK AGAIN NRMXIT, JMS I PUNABS /RESTORE FAC SIGN JMP I NORMAL /RETURN NRMZRO, DCA FACEXP /ZERO EXPONENT JMP I NORMAL /RETURN NORMALIZED ZERO INTEGR, .-. /ROUTINE TO FIX FLOATING AC CLA CLL /CLEAR CRUFT TAD FACEXP /GET FAC EXPONENT SPA SNA CLA /POSITIVE NONZERO EXPONENT? DCA FACEXP /NO, ZERO THE EXPONENT TAD FACEXP /GET THE EXPONENT TAD N27 /SUBTRACT TWENTY THREE DCA BITCNT /SAVE SHIFT COUNT SZL /EXPONENT > TWENTY THREE? JMP I INTEGR /YES, GIVE UP JMS I PFACRT /NO, SHIFT RIGHT ISZ BITCNT /DONE SHIFTING? JMP .-2 /NO, GO SHIFT AGAIN DCA FACLOW /YES, CLEAR FRACTIONAL PART TAD FACMED /GET RESULT JMP I INTEGR /RETURN IT $