1 /This was basically xlisted in the original. 2 /I don't fully understand why it didn't show in the symbol tabe, but 3 /it presumably had to do with the FIXTAB. 4 /2345678901234567890123456789012345678901234567890123456789012345678901234567890 5 FIXMRI FGET=0000 6 FIXMRI FADD=1000 7 FIXMRI FSUB=2000 8 FIXMRI FDIV=3000 /bugbug: How are these two in the wrong order?? 9 FIXMRI FMPY=4000 / 10 FIXMRI FXPN=5000 11 FIXMRI FPUT=6000 12 FEXT=0000 13 /FSQR=0001 14 /FATN=0005 15 /FEXP=0006 16 /FLOG=0007 17 /FNEG=0010 18 /FINP=0011 19 FNOR=7000 20 MQA=7501 21 MQL=7421 22 FIXTAB 23 24 / NOTES ON FOCAL 1976 25 26 / FOCAL 1976 WAS PREPARED THROUGH TWO MONTHS OF WORK FROM A BINARY 27 / PAPERTAPE OF FOCAL 1969. THE PROCESS OF DISASSEMBLY AND REVISION 28 / HAS RESULTED IN MY OWN DEEP UNDERSTANDING OF THE WORKINGS OF FOCAL 29 / AND IN WHAT I BELIEVE TO BE THE BEST VERSION OF FOCAL CURRENTLY 30 / AVAILABLE ANYWHERE. MY THANKS TO NORTH SALEM HIGH SCHOOL FOR EMPLOYING 31 / ME TO PERFORM THIS REVISION. I THINK WE BOTH GOT A GOOD DEAL. 32 / FOCAL IS A REGISTERED TRADEMARK OF DIGITAL EQUIPMENT CORPORATION. 33 34 / VINCENT SLYNGSTAD 35 36 37 / TO SAVE A FOCAL PROGRAM: 38 39 /ON SYSTEMS WITH ASR TELETYPES, TYPE A 'WRITE' COMMAND WITH THE APPROPRIATE 40 /ARGUMENT, BUT DO NOT TYPE THE RETURN. TURN ON YOUR TAPE PUNCH AND DEPRESS 41 /SHIFT, REPEAT, AND @, IN THAT ORDER, AND HOLD DOWN UNTIL THE DESIRED AMOUNT 42 /OF LEADER HAS BEEN GENERATED, THEN RELEASE IN THE REVERSE ORDER. NOW TYPE 43 /RETURN, AND WAIT FOR YOUR PROGRAM TO BE LISTED. THEN DEPRESS THE SHIFT, 44 /REPEAT AND @ KEYS AS ABOVE TO GENERATE TRAILER. TURN OFF THE TAPE PUNCH . 45 /LABEL AND SAVE YOUR TAPE AS DESIRED. 46 47 /ON OS-8 SYSTEMS, THE ABOVE PROCEDURE MAY BE USED, OR THE FOLLOWING COMMANDS 48 /MAY BE TYPED: 49 / @LOCATIONS 50 / XXXX (THE COMMAND TYPES FOUR NUMBERS) 51 / XXXX 52 / YYYY (THIS NUMBER AND 53 / ZZZZ THIS NUMBER ARE IMPORTANT) 54 / .SAVE DEV:NAME 0-YYYY,ZZZZ-7577;200 55 /WHERE "DEV" IS THE NAME OF THE OS-8 DEVICE YOU WISH TO SAVE YOUR PROGRAM ON. 56 /"NAME" IS THE NAME YOU WISH TO GIVE YOUR PROGRAM. 'YYYY' AND 'ZZZZ' ARE 57 /THE THIRD AND FOURTH NUMBERS TYPED BY FOCAL IN RESPONSE TO THE "LOCATIONS" 58 /COMMAND. ALL VARIABLES ARE SAVED TOO WITH THIS METHOD. 59 60 /TO DELETE A PROGRAM SAVED BY THIS METHOD TYPE: 61 / .DELETE DEV:NAME.SV 62 /WHERE "DEV" IS THE NAME OF THE DEVICE THE PROGRAM IS SAVED ON, AND "NAME" IS 63 /THE NAME OF THE PROGRAM YOU WISH TO DELETE. 64 65 66 / TO RELOAD A FOCAL PROGRAM: 67 68 /IF THE PROGRAM WAS SAVED ON PAPERTAPE, THE TAPE MAY SIMPLY BE READ INTO 69 /FOCAL. THE USER MAY THEN USE HIS PROGRAM IN ANY WAY HE DESIRES BY USE OF 70 /MODIFY, GO COMMANDS, OR WHATEVER. 71 72 /IF THE PROGRAM WAS SAVED VIA OS-8 ON A DISK OR DECTAPE, THE FOLLOWING COMMAND 73 /MAY BE TYPED IN MONITOR MODE: 74 / .RUN DEV:NAME 75 /WHERE "DEV" AND "NAME" ARE AS DESCRIBED IN SAVING. IF THE PROGRAM WAS SAVED ON 76 /THE SYSTEM DEVICE, THE FOLLOWING COMMAND MAY BE USED: 77 / .R NAME 78 /WHERE "NAME" IS THE NAME OF THE PROGRAM. THESE METHODS BOTH WILL START FOCAL IN 79 /COMMAND MODE WITH YOUR PROGRAM EXACTLY AS IT WAS PRIOR TO USING THE SAVE 80 /PROCEDURE. NOTE THAT NEITHER OF THESE TECHNIQUES WILL START THE EXECUTION 81 /OF THE USER'S FOCAL PROGRAM. THE PROGRAM IS SIMPLY LOADED AS IF THE USER 82 /HAD TYPED IT IN AGAIN. IT IS NECESSARY FOR THE USER TO THEN TYPE A "GO" 83 /COMMAND TO EXECUTE HIS PROGRAM. 84 85 / ERROR DIAGNOSTIC LIST: 86 87 / NO ATTEMPT WAS MADE TO RETAIN THE OLD ERROR DIAGNOSTIC CODES, AND THE 88 / FOLLOWING IS THE CORRECT AND DEFINITIVE LIST OF ERROR CONDITIONS. 89 90 /?01.00 USER TYPED CONTROL C WHILE FOCAL WAS WAITING FOR INPUT FROM 91 / THE TTY OR DECODING CHARACTERS FOR EXECUTION. 92 /?01.64 LINE NUMBER HAD TO GROUP PORTION AND LINE BEGAN WITH A 93 / DECIMAL POINT ON INPUT. 94 /?01.71 LINE NUMBER HAD NO STEP NUMBER FOLLOWING GROUP NUMBER ON 95 / INPUT FOR STORAGE IN USER PROGRAM. 96 /?02.26 LINE NUMBER HAD GROUP NUMBER OF ZERO ON INPUT OR AS ARGUMENT 97 / IN GOTO OR IF STATEMENT. 98 /?02.53 IN GROUP DO OR BRANCH COMMAND WITH INTEGER ARGUMENT, THE 99 / REFERENCED GROUP OF LINES DOES NOT EXIST. 100 /?02.73 IN A DO OR BRANCH COMMAND AN ATTEMPT WAS MADE TO REFERENCE 101 / A NONEXISTANT LINE. 102 /?02.:2 DURING THE EXECUTION OF A FOCAL COMMAND, THE STACK EXCEEDED 103 / THE AMOUNT OF STORAGE AVAILABLE TO IT. 104 /?03.22 IN A GOTO OR IF COMMAND, A LINE WAS REFERENCED WHICH DID NOT 105 / EXIST IN THE USER PROGRAM. 106 /?03.44 IN COMMAND MODE OR WHILE EXECUTING THE USER PROGRAM, AN ATTEMPT 107 / WAS MADE TO EXECUTE A COMMAND ILLEGAL IN THE FOCAL LANGUAGE. 108 /?04.61 IS A SET OR FOR COMMAND, THE TERMINATOR AFTER A VARIABLE 109 / NAME WAS NOT A COMMA OR EQUALS SIGN. 110 /?04.76 IN A FOR OR SET COMMAND, THE TERMINATOR FOLLOWING THE FIRST 111 / EXPRESSION WAS NOT A RETURN, COMMA (FOR), OR SEMICOLON. 112 /?04.84 IN A FOR COMMAND, THE SECOND EXPRESSION WAS NOT FOLLOWED 113 / BY A COMMA OR SEMICOLON. 114 /?06.04 IN A SET OR ASK COMMAND, A VARIABLE NAME BEGINS WITH AN 115 / OPERATOR, TERMINATOR, OR NUMERIC DIGIT. 116 /?06.47 DURING THE EXECUTION OF A FOCAL COMMAND, AN ATTEMPT WAS MADE 117 / TO CREATE MORE VARIABLES THAN STORAGE WILL ALLOW. 118 /?07.;7 A NONEXISTANT OR DELETED FUNCION WAS REFERENCED, OR AN INVALID 119 / CHARACTER WAS ENCOUNTERED DURING COMMAND INTERPRETATION. 120 /?07.;9 DURING THE EVALUATION OF AN EXPRESSION BY FOCAL, NO OPERATORS 121 / WERE ENCOUNTERED IN A RUN. 122 /?08.62 NO RIGHT PREN WAS FOUND TO MATCH A LEFT PREN IN AN EXPRESSION 123 / DURING COMMAND EXECUTION. 124 /?10.:8 A LINE OR FOCAL PROGRAM IS TOO LONE FOR STORAGE IN THE TEXT 125 / OR SCRATCH BUFFERS. 126 /?27.:0 AN INVALID QUANTITY FOLLOWS AN EXPONENTIATION OPERATOR IN AN 127 / EXPRESSION. 128 /?12.52 THE LINE REFERRED TO BY A MODIFY OR MOVE COMMAND WAS NOT FOUND 129 / IN THE USER PROGRAM. 130 /?29.51 AN ATTEMPT WAS MADE TO DIVIDE BY ZERO IN AN ARITHMETIC 131 / EXPRESSION DURING COMMAND EXECUTION. 132 /?23.35 THE FSIN OF FCOS FUNCTION WAS CALLED WITHOUT AN ARGUMENT DURING 133 / FOCAL COMMAND EXECUTION. 134 /?24.07 THE SQUARE ROOT FUNCTION (FSQT) WAS CALLED IN AN ATTEMPT TO 135 / FIND THE SQUARE ROOT OF A NEGATIVE NUMBER. 136 /?24.:3 IN THE INTERPRETATION OF A NUMERIC QUANTITY IN AN EXPRESSION 137 / OR ASK RESPONSE MORE THAN TEN DIGITS WERE ENCOUNTERED. 138 139 140 141 / NEW FEATURES OF 4K FOCAL 1976 142 143 / THE LINE SEEK ROUTINE HAS BEEN ENHANCED TO LOOK ONLY AT THOSE 144 / LINES WHICH FOLLOW THE CURRENT ONE IF THE SOUGHT AFTER LINE 145 / NUMBER IS GREATER THAN THE CURRENT ONE. 146 147 / BUILT IN VARIABLES ARE NOW SUPPORTED AS FUNCTION CALLS WHICH DO NOT 148 / REQUIRE ARGUMENTS, AS IN 'SET CH=FIN", WHICH WILL ACCESPT ON CHARACTER 149 / FROM THE TTY AND STORE IT IN THE VARIABLE CH. 150 151 / ENHANCED (FASTER, MORE EFFICIENT) PACKING AND UNPACKING ROUTINES 152 / TO GET TEXT IN AND OUT OF THE TEXT BUFFER. 153 154 / THE PROGRAM INTERRUPT ROUTINES HAVE BEEN REMOVED TO MAKE MORE ROOM 155 / FOR USER PROGRAMS. CONTROL C WILL STILL WORK AT ALL TIMES, AND INPUT 156 / BUFFER OVERFLOW IS IMPOSSIBLE. UNFORTUNATELY, THIS CAUSES FOCAL 157 / TO HAVE TO WAIT ON THE PRINTER WHEN IT COULD BE THINKING, ADDING 158 / TO ITS ALREADY EXTREME SLOWNESS. IT IS HOPED THE OTHER CHANGES WILL 159 / COMPENSATE SOMEWHAT BY MAKING FOCAL WORK FASTER. 160 161 / FIN AND FOUT FUNCTIONS HAVE BEEN ADDED. FIN WILL NOT ECHO, AND FOUT 162 / WILL NOT AUTOMATICALLY LINE FEED IF A RETURN IS SENT TO THE PRINTER. 163 / NOTE THAT THE DELETION OF THE INTERRUPT ROUTINES REMOVED ALL 164 / RESTRICTIONS ON WHAT VALUES MAY BE SENT BY FOUT. (FOUT(0) WILL 165 / GENERATE ONE LEADER/TRAILER CODE.) 166 167 / THE ASTERISK COMMAND FOR HIGH SPEED READER MANIPULATION HAD BEEN 168 / REMOVED TO ENHANCE EFFICIENCY AND PROVIDE MORE ROOM. 169 170 / THE * READY SIGNAL HAS BEEN CHANGED TO AN AT SIGN, SO THAT PUNCHED 171 / TAPES WILL NOT PRODUCE ILLEGAL COMMAND MESSAGES AND THE LIKE, AS 172 / THE ASTERISK COMMAND HAS BEEN REMOVED. 173 174 / AN FMQ FUNCTION/PSEUDOVARIABLE HAS BEEN ADDED TO MANIPULATE THE 175 / MULTIPLIER QUOTIENT REGISTER. THE FUNCTION WILL RETURN THE CURRENT 176 / VALUE OF THE MQ, AND WILL REPLACE THAT VALUE IN THE MQ WITH THE 177 / PARAMETER VALUE. TO RETURN THE VALUE OF THE MQ, FMQ MAY BE USED IN 178 / THE FORM OF A PSEUDOVARIABLE, AS IN 'TYPE FMQ'. TO UPDATE THE VALUE 179 / OF THE MQ USE THE FUNCTION SYNTAX, 'SET OLD=FMQ(NEW)", WHICH WILL 180 / SET 'OLD' EQUAL TO THE CONTENT OF THE MQ AND THEN LOAD THE MQ WITH 181 / THE CONTENTS OF THE VARIABLE 'NEW'. 182 183 / THE ERASE COMMAND WITHOUT AN ARGUMENT NO LONGER ERASES VARIABLES, 184 / BUT WILL CAUSE A RETURN TO COMMAND MODE ALLOWING THE USE OF THE 185 / 'END' COMMAND. THE 'ZERO' COMMAND IS NOW USED TO ERASE VARIABLES. 186 187 / THE STACK (PUSH DOWN LIST) ROUTINES HAVE BEEN ENHANCED FOR 188 / GREATER SPEED. 189 190 / THE FLOATING POINT PACKAGE HAS BEEN ENHANCED AND TAILORED TO 191 / BETTER FIT IN WITH THE REST OF FOCAL, RESULTING IN MANY SUBTLE 192 / EFFICIENCIES IN STORAGE AND SPEED. 193 194 / THE TYPE $ FEATURE HAS BEE REMOVED. THE FORMER FUNCTION HAS 195 / BEEN MOVED TO THE 'VARIABLES' COMMAND. NOTE THAT THE 'V' 196 / COMMAND LISTS VARIABLES WITH FOUR DIGIT SIGNED SUBSCRIPTS SO 197 / THE USER CAN GET AN ACCURATE PICTURE OF HIS SYMBOL TABLE. THE 198 / USE OF ZERO VARIABLE REPLACEMENT MAY CAUSE VARIABLES NOT TO APPEAR 199 / IN THE LIST, HOWEVER, SO ANY VARIABLE WHICH DOES NOT APPEAR 200 / SHOULD BE ASSUMED TO HAVE A VALUE OF ZERO. 201 202 / NOTE THAT 'TYPE #' ON A TERMINAL THAT RESPONDS TO FORM FEEDS WILL 203 / CAUSE A PAGE EJECT RATHER THAN A RETURN WITH NO LINE FEED. 204 205 / EQUAL SIGNS, UNNESTED PARENTHESIS, AND RELATIONAL OPERATORS IN 206 / TYPE COMMANDS WILL NOW GENERATE THE ILLEGAL FUNCTION OR TERMINATOR 207 / MESSAGE INSTEAD OF HANGING UP FOCAL. 208 209 / THE FLOATING OUTPUT ROUTINE HAS BEEN REWRITTEN. AS A RESULT, FOCAL 210 / NOW TRUNCATES OUTPUT TO THE DESIRED FORMAT, RATHER THAN ROUNDING. 211 212 / THE FOR COMMAND HAS BEEN ENHANCED TO HANDLE NEGATIVE INCREMENT 213 / VALUES CORRECTLY AND TO YEILD A DIVISION BY ZERO MESSAGE WHEN AN 214 / ATTEMPT IS MADE TO LOOP WITH AN INCREMENT OF ZERO. NOTE ALSO 215 / THAT FOCAL WILL NO LONGER LOOP AT LEAST ONCE, EVEN IF THE INITIAL 216 / VALUE IS BEYOND THE LIMIT. FOR EXAMPLE, 'FOR I=2,-1,3; DO 2' 217 / WILL NOT DO GROUP 2 AT ALL IN THIS VERSION OF FOCAL. THIS IS 218 / USUALLY MORE CONVENIENT TO THE USER THAN AUTOMATICALLY LOOPING. 219 220 / PARENTHESIS ARE NO LONGER NEEDED AROUND THE EXPRESSION IN 'IF' COMMANDS, 221 / BUT THE EXPRESSION WILL NEED TO BE TERMINATED. A COMMA MAY BE USED 222 / FOR THIS IF NECESSARY. 223 224 / EXPRESSIONS ARE NOW ALLOWED ANYWHERE A LINE NUMBER IS EXPECTED, AS 225 / IN 'GOTO X+Y', 'DO J', AND 'IF (A-B)B,C,D'. THE LETTER A, HOWEVER, 226 / MUST NOT BE THE FIRST LETTER OF ARGUMENTS TO REASE COMMANDS, UNLESS 227 / IT IS DESIRED TO REASE THE WHOLE PROGRAM. NOTE THAT ONLY IN ERASE 228 / COMMANDS IS THE LETTER 'A' RESERVED TO MEAN ALL, AND THAT COMMANDS 229 / SUCH AS 'WRITE ALL', 'DO ALL', ETC. SHOULD NOW BE GIVAN AS 230 / SIMPLY 'WRITE', 'DO', ETC. 231 232 / THE FLOATING POINT DECIMAL INPUT ROUTINE HAS BEEN REWRITTEN, RESULTING 233 / IN FASTER INTERPRETATION OF NUMERIC CONSTANTS IN EXPRESSIONS AND 234 / RESPONSES TO ASK COMMANDS. ALSO, NOTE THAT THE RESULT DOES NOT APPEAR 235 / IN THE FLOATING ACCUMULATOR, BUT RATHER IN THE HOLD AREA 'DUMMY'. 236 / THIS WAS DONE AS PART OF THE INTERPRETIVE ASK STATEMENT MODIFICATIONS. 237 238 / COLONS AND EQUAL SIGNS ARE NO LONGER PRINTED BY THE ASK AND TYPE 239 / COMMANDS, MAKING IT NECESSARY FOR THE USER TO INCLUDE PRINTING 240 / CHARACTERS IN QUOTES OR USE TRACE MODE TO GET DESIRED LABELS 241 / INCLUDED IN HIS OUTPUT. 242 243 / THE SYNTAX 'SET A,B,C(2),ETC=(EXPRESSION) IS NOW VALID, ALLOWING 244 / EASIER INITIALIZATION OF MANY VARIABLES TO THE SAME VALUE. 245 / THIS IS ALSO ALLOWED IN FOR STATEMENTS, AS IN 'FOR I,J,K=1,10;DO 2' 246 / WHICH WILL CAUSE I, J, AND K TO BE SET EQUAL TO ONE, THEN THE 247 / VARIABLE 'I' WILL BE STEPPED FROM ONE TO TEN. 248 249 / ESCAPE AND FORM FEED HAVE BEEN ADDED TO THE LIST OF CHARACTERS 250 / WHICH DO NOT ECHO WHEN TYPED IN, SO THAT USERS OF THINGS OTHER 251 / THAN TELETYPES (DECWRITERS, VT-50S, ETC.) WILL NOT ENCOUNTER 252 / SURPRIZES WHEN TYPING IN THESE CHARACTERS. 253 254 / THE MODIFY COMMAND HAS BEEN EXPANDED TO ALLOW AN OPTIONAL SECOND 255 / PARAMETER, WHICH WILL BECOME THE NEW LINE NUMBER FOR THE EDITED 256 / LINE. FOR EXAMPLE, 'MOVE 1.1,1.2' WILL MODIFY LINE 1.1 AS USUAL, 257 / BUT THE RESULT WILL BE STORED AS LINE 1.2. 258 259 / THE CONTROL TABLES WHICH GOVERN ARITHMETIC PRIORITY, THE TYPE 260 / COMMAND, AND TERMINATION HAVE BEEN MERGED FOR BETTER STORAGE 261 / ECONOMY AND CONVENIENCE. TO THE USER, THE MOST SIGNIFICANT RESULT 262 / OF THIS CHANGE IS THAT SPACES AND COMMAS ARE NOW NEEDED ONLY TO 263 / SEPERATE VARIABLE NAMES AND NUMBERS, AS IN 'TYPE A,3B,L' WHICH 264 / WITHOUT THE COMMAS WOULD TYPE VARIABLE A3. 265 266 / THE COMMAND INTERPRETER HAS BEEN MODIFIED TO ACCEPT ALL RESERVED 267 / CHARACTERS AS KEYWORD DELIMITERS, ALLOWING MOST COMMANDS TO DO 268 / WITHOUT THE SPACE SEPERATING THEM FROM THEIR PARAMETERS. 269 270 / THE OVERHEAD INVOLVED WITH FOR COMMANDS HAS BEEN CUT NEARLY IN 271 / HALF, RESULTIN IN A SLIGHT SPEED GAIN. 272 273 / A 'BRANCH' COMMAND HAS BEEN ADDED WHICH IS IDENTICAL TO THE 'IF' 274 / COMMAND EXCEPT THAT 'DO' TRANSFERS ARE PERFORMED INSTEAD OF GOTO. 275 276 / A COLON FOLLOWED BY AN EXPRESSION IN AN ASK IR TYPE STATEMENT WILL 277 / PRODUCE A TABULATION TO THE INDICATED COLUMN. IF THE EXPRESSION IS 278 / NEGATIVE, ZERO, OR ONE, A TABULATION TO THE LEFT MARGIN WILL OCCUR, 279 / AND IF THE CARRIAGE IS BEYOND THE COLUMN REQUESTED A RETURN WITHOUT 280 / A LINE FEED WILL BE PRINTED AND THE CORRECT TABULATION WILL OCCUR. 281 282 / THE VARIABLE SEARCH ROUTINE HAS BEEN ENHANCED FOR BETTER SPEED 283 / AND STORAGE ECONOMY. 284 285 / FOR THOSE WRITING THEIR OWN FUNCTIONS OR PLANNING TO MODIFY INTERNAL 286 / ROUTINES, A NEW LOCATION, 'FARGSW' IS SET TO 7777 WHENEVER A 287 / FUNCTION IS CALLED WITHOUT AN ARGUMENT. ALSO NOTE THAT THIS LOCATION 288 / IS NOT SAVE BY 'EVAL', SO THAT FUNCTIONS THAT HAVE MORE THAN 289 / ONE ARGUMENT SHOULD CLEAR THIS LOCATION BEFORE TAKING THE STANDARD 290 / RETURN. 291 292 / ALSO OF INTEREST TO THOS WRITING MULTIPLE ARGUMENT FUNCTIONS, THERE 293 / IS NOW A SUBROUTINE (COMMAC) CALLED BY 'JMS I PCOMMA', WHICH WILL 294 / SKIP IF LOCATION 'CHAR' CONTAINS A COMMOA, AND IF SO WILL DECODE 295 / THE NEXT CHARACTER. 296 297 / THE IF AND BRANCH COMMANDS NOW HAVE A RELATIONAL FORMAT. THE STATEMENT 298 / 'IF A=B COMMANDS' WILL EXECUTE ALL THE COMMANDS FOLLOWING THE IF ONLY 299 / WHEN A=B. IF THE CONDITION IS NOT MET THE LINE IS TERMINATED, AND 300 / EXECUTION WILL RESUME AS USUAL. NOTE THAT THE COMMAND 'IF A< 302 / MAY BE COMBINED IN ANY QUANTITY AND ORDER. AND EACH WO;; BE TESTED 303 / IN SEQUENCE AND THE REST OF THE LINE EXECUTED IF THE CONDITION IS TRUE. 304 305 / AS A CONSEQUENCE OF THE ABOVE ADDITION, THE CHARACTERS < AND > 306 / ARE NO LONGER VALID AS PARENTHESIS EQUIVALENTS. 307 308 / THE SINGLE QUOTE MARK HAS BEEN ADDED TO THE TYPE AND ASK COMMANDS 309 / AND PERFORMS IN EXACTLY THE SAME MANNER AS THE DOUBLE QUOTE MARK. 310 311 / A NEW INTEGER PART ROUTINE HAS BEEN INCLUDED TO INCREASE SPEED 312 / AND STORAGE ECONOMY, AND TO ELIMINATE CERTAIN ROUNDING ERRORS 313 / COMMON IN MANY VERSIONS OF FOCAL. 314 315 / THE ASK COMMAND HAS BEEN ENHANCED TO ACCEPT EXPRESSIONS INSTEAD OF 316 / JUST NUMBERS. AS A RESULT, LETTERS MAY NO LONGER BE TREATED AS DIGITS 317 / IN A NUMERIC QUANTITY. NOTE THAT ESCAPE AND ARROW WORK NORMALLY, 318 / AND THAT LEADING SPACES ARE IGNORED, BUT TRAILING SPACES TERMINATE. 319 / FOR EXAMPLE ' 3' HAS NOT BEEN TERMINATED, BUT '3 ' HAS, AND '3+ 4' 320 / IS A VALID RESPONSE, BUT '3 +4' IS NOT. 321 322 / A 'LINE FEED ECHO' FEATURE HAS BEEN ADDED WHICH WILL ECHO THE CURRENT 323 / LINE UP TO THE LAST CHARACTER STORED, UNLESS THE PRINTER IS AT 324 / COLUMN ONE. THIS ALLOWS ONE TO EXAMINE A LINE WHICH HAS BEEN CORRECTED 325 / BY USE OF ARROW AND RUBOUTS TO SEE IF IT IS CORRECT. NOTE THAT THIS 326 / FEATURE IS INACTIVE IN COLUMN ONE, ALLOWING TAPES WITH LINE FEEDS TO 327 / BE READ IN ON LINE. 328 329 / FOCAL NO LONGER PRINTS ?00.00 WHEN MANUALLY RESTARTED, BUT SIMPLY STARTS 330 / OUT IN COMMAND MODE. 331 332 333 / A QUOTATION MARK MAY NOW BE PRINTED IN TYPE OR ASK COMMAND STRINGS 334 / BY PLACING IT INSIDE QUOTES FOLLOWED IMMEDIATELY BY ANOTHER QUITE. 335 / THE SECOND OF THESE TWO QUOTATION MARKS WILL BE PRINTED AND FOCAL 336 / WILL REMAIN IN QUOTE MODE, AS IN "TYPE 'THIS''L BE THE DAY'". 337 338 / A GREATER THAN SIGN MAY NOW BE PLACED IN ASK AND TYPE STATEMENTS 339 / TO PRODUCE A LINE-FEED WITHOUT A CARRIAGE RETURN. 340 341 / A 'FTST' FUNCTION HAS BEEN ADDED WHICH WILL RETURN A NEGATIVE ONE 342 / IF NO KEY HAS BEEN STRUCK, OR THE FIN/FOUT CODE OF THE CHARACTER, 343 / IF ONE HAS BEEN TYPED. THE CHARACTER IS NOT DESTROYED, AND SO IS 344 / AVAILABLE FOR FIN OR ASK COMMANDS. 345 346 / A FULLY DEBUGGED ZERO VARIABLE REPLACEMENT FEATURE HAS NOW BEEN 347 / ADDED TO FOCAL, ALLOWING MUCH MORE EFFICIENT UTILIZATION OF THE 348 / AVAILABLE VARIABLE STORAGE. THOSE WRITIN INTERNAL ROUTINES SHOULD 349 / NOTE THE SUBROUTINE 'NOZVR', CALLED BY 'JMS I PNOZVR', WHICH DISABLES 350 / ZERO VARIABLE REPLACEMENT ON THE CURRENT VARIABLE. NOTE THAT THIS 351 / VERSION OF FOCAL WILL REPLACE ALL ZERO VARIABLES BEFORE A 352 / NEW VARIABLE IS CREATED, THUS KEEPING THE SYMBOL TABLE AS SMALL 353 / AS POSSIBLE AND LEAVING AS MUCH ROOM AS POSSIBLE FOR MORE VARIABLES 354 / OR STACK. 355 356 / AN 'XECUTE' COMMAND HAS BEEN ADDED, ALLOWING ONE TO EXECUTE FUNCTION 357 / CALLS WITHOUT STORING THE RESULTS. ANY NUMBER OF ARITHMETIC 358 / EXPRESSIONS MAY FOLLOW THE 'X', AND EACH WILL BE EVALUATED AN THE 359 / RESULT IGNORED. FOR EXAMPLE, 'XECUTE FOUT(141)FOUT(138)' WILL PRINT 360 / A RETURN-LINE-FEED SEQUENCE, AND 'X FIN FIN FIN' WILL 361 / INPUT AND IGNORE THREE CHARACTERS FROM THE TERMINAL. 362 363 / A 'HEADING' COMMAND HAS BEEN ADDED TO ALLOW ALTERATION OF THE 364 / HEADING LINE. THE FORMAT IS SIMPLY THE WORD 'HEADING' OR ANY 365 / OF IT'S ABBREVIATIONS, A SPACE, AND THE DESIRED HEADING. THE 366 / NEW HEADING WILL REPLACE THE OLD, FOCAL WILL ERASE ALL, RESET THE 367 / OUTPUT FORMAT TO %8.04, AND RETURN TO COMMAND MODE. NOTE THAT THE 368 / HEADING SHOULD BE A COMMENT OR DO-NOTHING COMMAND, AS FOCAL WILL 369 / EXECUTE IT BEFORE RUNNING THE USER PROGRAM IN RESPONSE TO A 'GO' 370 / COMMAND. 371 372 / A 'KLEAR' COMMAND HAS BEEN ADDED WHICH REMOVES ALL ACTIVE 'FOR' OR 373 / 'DO' COMMANDS AND PROCEEDS WITH EXECUTION AS IF THE USER HAD JUST 374 / TYPED A 'GOTO' COMMAND TO THE CURRENT PROGRAM STEP. THIS PROVIDES 375 / A MEANS OF ESCAPING 'DO' AND 'FOR' COMMANDS, WHICH IS NOT POSSIBLE 376 / WITH OTHER VERSIONS OF FOCAL. 377 378 / A 'ZERO' COMMAND HAS BEEN ADDED WHICH WILL ERASE THE VARIABLE TABLE 379 / OR SET SELECTED VARIABLES TO ZERO. THIS TAKES THE PLACE OF 'ERASE' 380 / IN OTHER VERSIONS OF FOCAL. A LIST OF VARIABLES MAY BE ZEROED AT 381 / ONCE, AS IN 'ZERO A,B,C', OR THE VARIABLE TABLE MAY BE CLEARED BY 382 / 'ZERO'. NOTE THAT 'ZERO' WITH NO ARGUMENTS DOES AN AUTOMATIC 'KLEAR', 383 / PREVENTING IT'S USE IN SUBROUTINES OR 'FOR' LOOPS. 384 385 / MANY POINTERS TO USEFUL ROUTINES ARE NOW AVAILABLE ON PAGE ZERO. 386 / USERS CODING THEIR OWN FUNCTIONS OR MODIFYING INTERNAL ROUTINES 387 / MAY WANT TO USE THESE POINTERS RATHER THAN CREATING THEIR OWN. 388 389 / A 'FIND' FUNCTION HAS BEEN ADDED WHICH WILL INPUT AND ECHO 390 / CHARACTERS UP TO BUT NOT INCLUDING THE CHARACTER WHOSE FIN/FOUT 391 / CODE, WHICH WILL BE IGNORED. THIS FUNCTION IS USED TO RAPIDLY 392 / COPY TAPES AND TO IGNORE PORTIONS OF INPUT. 393 394 / THE DO COMMAND NOW ACCEPTS MULTIPLE PARAMETERS, AS IN 'DO 3,1.1', 395 / WHICH WILL DO ALL LINES IN GROUP 3, THEN DO LINE 1.1. NOTE THAT 396 / THE PARAMETERS MAY ONLY BE SEPARATED BY A COMMA. 397 398 399 / PATCHES TO FOCAL 1976 400 401 / THE FOLLOWING PATCHES MAY BE IMPLEMENTED AT THE USER'S OPTION TO 402 / PROVIDE COMPATIBILITY WITH OTHER VERSIONS OF FOCAL. THEY MAY BE 403 / IMPLEMENTET VIA ODT AS SHOWN, OR THE EQUIVALENT SWITCH MODIFICATIONS 404 / MAY BE PERFORMED. EACH MODIFICATION MAY BE REVERSED BY RESTORING 405 / THE CONTENTS OF THE AFFECTED LOCATIONS. 406 407 / AUTOMATIC ECHO OF FIN CHARACTERS: 408 / .GET SYS:FOCAL 409 / .ODT 410 / 3011/4467 4550 411 / ^C (TYPE CONTROL C) 412 / .SAVE SYS:FOCAL 413 414 / AUTOMATIC LINE FEED WHEN FOUT RECEIVES A RETURN: 415 / .GET SYS:FOCAL 416 / .ODT 417 / 3026/4466 4547 418 / ^C (TYPE CONTROL C) 419 / .SAVE SYS:FOCAL 420 421 / TO SEND OUTPUT TO LINE PRINTER: (INSTALL BEFORE RUNNING DIALOG) 422 / .GET SYS:FOCAL 423 / .ODT 424 / 4200/6046 6666 425 / 1362/6041 6661 426 / 1364/6046 6666 427 / ^C (TYPE CONTROL C) 428 / .SAVE SYS:FOCAL 429 430 / TO USE FOCAL'S 'L' COMMAND ON NONDISK SYSTEMS: 431 / CHANGE LOCATION 6111 FROM 5512 TO 5177 432 433 / ACKNOWLEDGEMENTS: 434 435 / THE AUTHOR EXTENDS HIS THANKS TO EACH OF THE FOLLOWING GROUPS OR 436 / INDIVIDUALS FOR HELP IN BRINGING ABOUT FOCAL 1976. 437 438 / RICK MERRILL, FOR WRITING THE ORIGINAL FOCAL AND SUPPLYING 439 / MANY OF THE BASIC ALGORITHMS. 440 441 / ROBERT S. JAQUISS, COMPUTER SCIENCE INSTRUCTOR AT NORTH 442 / SALEM HIGH SCHOOL, FOR GETTING ME STARTED WITH COMPUTERS 443 / AND HELPING ME GET TIME ON THE COMPUTER DURENG THE EVENINGS 444 / AND THE SUMMER. 445 446 / EDWARD a TAFT iii, FOR THE INTEGER PART AND RANDOM NUMBER 447 / ROUTINES, ADAPTED FROM FOCAL8-43. 448 449 / THE OREGON MUSEUM OF SCIENCE AND INDUSTRY, FOR THE COMPUTED 450 / LINE NUMBER ALTERATION AND SOME IMPROVEMENTS TO THE VARIABLE 451 / SEEK ROUTINE. 452 453 / WILLIAM F. FERGUSON, FOR HIS SUPPORT AND LISTENING EAR 454 / OVER THE LAST TWO MONTHS, AND HIS AID IN THE DISASSEMBLY 455 / OF THE PORTIONS OF FOCAL DEALING WITH FLOATING POINT 456 / ARITHMETIC. 457 458 / OTHERS WHO HAVE REVISED FOCAL IN THE PAST, FOR THEIR IDEAS 459 / FOR IMPROVEMENTS TO FOCAL. 460 461 *0 /PAGE ZERO 462 000000 0013 P13, 13 /HANDY CONSTANT 463 000001 0077 C77, 77 /HANDY MASK 464 000002 0177 C177, 177 /HANDY MASK 465 000003 0200 C200, 200 /HANDY MASK AND CONSTANT 466 000004 4200 PINTRO, INTRO /POINTER TO INTRODUCTORY DIALOG 467 468 *7 /MORE PAGE ZERO 469 000007 6602 FPP, FLTPKG /POINTER TO FLOATING POINT INTERPRETER 470 000010 0000 PUTPTR, .-. /TEXT ENCODE POINTER 471 000011 0000 QCKPTR, .-. /GENERAL PURPOSE AUTOINDEX LOC. 472 000012 0000 WRKPTR, .-. /GENERAL PURPOSE AUTOINDEX LOC. 473 000013 5634 PDLPTR, BOTTOM /STACK POINTER bugbug: mismatch 474 000014 0000 FPPTR2, .-. /POINTER FOR FPP USE 475 000015 0000 FPPTR1, .-. /POINTER FOR FPP USE 476 000016 7774 N4, -4 /HANDY CONSTANT 477 000017 3607 GETPTR, L01V30+1 /TEXT DECODE POINTER 478 000020 0000 GETSDE, 0 /WHICH SIDE TO DECODE FROM 479 000021 0000 GETWRK, .-. /SAVE AREA FOR UNPACK 480 000022 0000 PC, .-. /POINTER TO CURRENT LINE 481 000023 0000 NEWPC, .-. /POINTER TO NEW LINE 482 000024 0000 NEWOPR, .-. /NEW OPERATOR SAVE AREA (EQUATION SOLVER) 483 000025 0000 OLDPC, .-. /POINTER TO PREVIOUS LINE 484 000026 0000 QUOTSW, .-. /TEXT IN QUOTES SWITCH 485 000027 0000 PUTBEG, .-. /BEGINNING OF LINE (RUBOUT HANDLER) 486 000030 0000 POINT1, .-. /GENERAL PURPOAE POINTER 487 000031 4047 VAREND, FREEBF /POINTER TO END OF VARIABLE AREA 488 000032 0000 SAVE1, .-. /GENERAL PURPOSE SAVE AREA 489 000033 0000 POWER, .-. /POWER OF TEN, USED BY NUMBER PRINT & INTERPRET ROUTINES 490 000034 7770 N10, -10 /DECIMAL NEGATIVE EIGHT, USED BY EQUATION SOLVER 491 000035 7766 N12, -12 /NEGATIVE TEN, DECIMAL 492 000036 5634 BOTTMP, BOTTOM /LAST ADDRESS OF BUFFER SPACE bugbug: mismatch 493 000037 0000 INSW, 0 /INPUT FROM TEXT OR KEYBOARD SWITCH 494 000040 0000 FARGSW, .-. /ARGUMENT SUPPLIED TO FUNCTION SWITCH 495 000041 0000 OPEXP, .-. /FLOATING OPERAND 496 000042 0000 OPHGH, .-. 497 000043 0000 OPMED, .-. 498 000044 0000 OPLOW, .-. 499 000045 0000 FACEXP, .-. /FLOATING ACCUMULATOR 500 000046 0000 FACHGH, .-. 501 000047 0000 FACMED, .-. 502 000050 0000 FACLOW, .-. 503 000051 0000 FACOVR, .-. /OVERFLOW AREA FOR FAC 504 000052 0000 SIGNSW, .-. /SWITCH INDICATING THE SIGN OF NUMBERS 505 000053 7006 NEGATE, NEGF /POINTER TO ROUTINE TO NEGATE FAC 506 000054 0000 FORM, .-. /FORMAT CONTROL WORD 507 000055 7560 FIX, INTEGR /POINTER TO INTEGER PART ROUTINE 508 000056 0000 SORTWK, .-. /SAVE AREA FOR SORT ROUTINES 509 000057 0000 OLDOPR, .-. /HOLD AREA FOR OLD OPERATOR IN EQUATION SOLVER 510 000060 0000 ASKTYP, .-. /ASK/TYPE SWITCH 511 000061 0000 TABCTR, .-. /COUNTER OF COLUMNS PRINTED 512 000062 0000 COUNTR, .-. /GENERAL PURPOSE COUNTER LOCATION 513 000063 4047 TXTEND, FREEBF /LAST LOCATION OF PROGRAM, FIRST FOR VARIABLES 514 000064 0000 PUTWRK, .-. /WORK AREA FOR ENCODE ROUTINE 515 000065 0000 PUTSDE, .-. /WHICH SIDE TO ENCODE IN 516 000066 1361 TYP, IOFOUT /POINTER TO ACTIVE PRINT CHAR ROUTINE 517 000067 2420 INCHAR, IOFIN /POINTER TO ACTIVE INPUT CHARACTER ROUTINE 518 000070 0000 ARGSW, .-. /SWITCHES PERTAINING TO LINENO 519 000071 0215 CHAR, 215 /CHARACTER BEING PROCESSED 520 000072 0000 LINENO, .-. /LINE NUMBER BEING PROCESSED 521 000073 0005 VARLEN, 5 /LENGTH OF FLOATING POINT VARIABLES 522 000074 0000 WORK, .-. /WORK AREA 523 000075 0214 MODIFC, 214 /FORM FEED 524 000076 0207 207 /BELL CODE 525 000077 0203 IMMED, 203 /CONTROL/C 526 000100 0337 337 /BACK ARROW 527 000101 0212 LF, 212 /LINE FEED 528 000102 0215 CR, 215 /CARRIAGE RETURN 529 000103 0001 TRCESW, C77 /TRACE MODE SWITCH 530 000104 7760 N20, -20 /NEGATIVE 20 531 000105 7700 N100, -100 /OCTAL NEGATIVE 100 OR MASK OF 7700 532 000106 7473 N305, -305 /NEGATIVE ASCII "E" 533 000107 0017 C17, 17 /HANDY MASK 534 000110 0140 C140, 140 /CASE BITS MASK 535 000111 0240 C240, 240 /SPACE 536 000112 7600 C7600, 7600 /HANDY MASK, POINTER TO MONITOR 537 000113 0256 DOT, 256 /DECIMAL POINT 538 000114 0277 QUEST, 277 /QUESTION MARK 539 000115 7776 N2, -2 /HANDY CONSTANT 540 000116 7477 N301, -301 /NEGATIVE ASCII "A" 541 000117 0260 C260, 260 /ASCII ZERO 542 000120 7540 N240, -240 /NEGATIVE ASCII SPACE 543 000121 7522 N256, -256 /NEGATIVE ASCII DECIMAL POINT 544 000122 7563 NCR, -215 /NEGATIVE ASCII CARRIAGE RETURN 545 000123 7775 FACLEN, -3 /NEGATIVE LENGTH OF THE FLOATING AC 546 000124 7773 N5, -5 /DECIMAL NEGATIVE FIVE 547 000125 2050 PDUMMY, DUMMY /POINTER TO SYSTEM VARIABLE 548 000126 3401 DOUBLE, FACLFT /POINTER TO SHIFT FAC ONE LEFT ROUTINE 549 000127 6200 TYPFAC, FACTYP /POINTER TO FLOATING POINT OUTPUT ROUTINE 550 000130 6452 FACIN, FACINP /POINTER TO FLOATING POINT NUMBER INTERPRETER 551 000131 3457 SCRTCH, SCRBUF /POINTER TO SCRATCH BUFFER 552 000132 3525 TXTBEG, TEXTST /POINTER TO BEGINNING OF TEXT 553 000133 3530 BUFBEG, STTEXT /POINTER TO BEGINNING OF TEXT AREA 554 000134 2036 FNCXIT, FNCDNE /POINTER TO FUNCTION RETURN ROUTINE 555 000135 3045 PZERO, ZERO /POINTER TO FLOATING POINT ZERO 556 000136 0550 PUSHJ, PUSHPC /POINTER TO RECURSIVE CALL HANDLER 557 000137 2174 LINEND, ENDLIN /POINTER TO LINE FINISHED ROUTINE 558 000140 0525 PUSHA, PUSHAC /POINTER TO STACK ACCUMULATOR 559 000141 0556 PUSHF, PUSHFC /POINTER TO STACK FLOATING POINT 560 000142 0345 POPF, POPFAC /POINTER TO RETRIEVE STACKED FLOATING POINT 561 000143 2306 DECODE, UNPACK /POINTER TO TEXT DECOMPRESSION ROUTINE 562 000144 2506 ENCODE, PACK /POINTER TO TEXT COMPRESSION ROUTINE 563 000145 1332 TABSCH, SCHTAB /POINTER TO LOOK UP AND GO ROUTINE 564 000146 0741 CHECK, SPECHK /POINTER TO TABLE CHECK ROUTINE 565 000147 2471 PRTCL, TYPCHK /POINTER TO PRINT WITH AUTO LF ROUTINE 566 000150 2200 INPUT, INPRT /POINTER TO INPUT AND ECHO ROUTINE 567 000151 2431 ARGOUT, OUTARG /POINTER TO LINE NUMBER PRINT ROUTINE 568 000152 0401 GETARG, ARGGET /POINTER TO ARGUMENT INTERPRETER 569 000153 2240 FNDLIN, LINFND /POINTER TO LINE SEEK ROUTINE 570 000154 2557 NEWLIN, LINNEW /POINTER TO PUT NEW LINE IN TEXT BUFFER ROUTINE 571 000155 0340 ROT6, R6L /POINTER TO SHIFT AC LEFT 6 ROUTINE 572 000156 1547 KLSPCE, SPNOR /POINTER TO IGNORE SPACES ROUTINE 573 000157 1560 SRTNUM, NUMSRT /POINTER TO ROUTINE TO CHECK FOR ".", 0-9, OR ALPHA 574 000160 2054 PRNCHK, CHKPRN /POINTER TO LEFT PREN CHECK ROUTINE 575 000161 0764 GRPTST, SKPGRP /POINTER TO SKIP IF AC IN CURRENT GROUP ROUTINE 576 000162 0720 SRTFUN, FUNSRT /ROUTINE TO CHECK FOR OPERATOR, 0-9, F OR OTHER 577 000163 2101 DELETE, ERALIN /POINTER TO ERASE LINE ROUTINE 578 000164 2606 ERROR, OOPS /POINTER TO ERROR HANDLER 579 000165 3030 GETCHR, CHRGET /POINTER TO GET CHARACTER ROUTINE 580 000166 7526 PNORML, NORMAL /POINTER TO NORMALIZE ROUTINE 581 000167 7371 PABS, ABS /POINTER TO ABSOLUTE VALUE ROUTINE 582 000170 7344 PUNABS, UNABS /POINTER TO RESTORE SIGN ROUTINE 583 000171 7351 PFACRT, FACRT /POINTER TO SHIFT FAC ONE RIGHT ROUTINE 584 000172 7127 PSUM, SUM /POINTER TO ADD FAC AND OPERAND ROUTINE 585 000173 7150 POPRT, OPRGHT /POINTER TO SHIFT OPERAND ONE RIGHT ROUTINE 586 000174 3202 PCOMMA, COMMAC /POINTER TO SKIP-IF-COMMA ROUTINE 587 000175 3213 PNOZVR, NOZVR /POINTER TO DISABLE ZVR ROUTINE 588 000176 0632 PEXEC, EXEC /POINTER TO COMMAND INTERPRETER 589 000177 7610 START, SKP CLA /SKIP TLS, RESTART FOCAL 590 591 592 *0200 /FOCAL MAINLINE, R6L, AND POPA ROUTINES 593 000200 5404 FOCAL, JMP I PINTRO /START INTRODUCTORY DIALOG 594 000201 3037 DCA INSW /SET INPUT FROM BUFFER SWITCH 595 000202 1135 TAD PZERO /GET POINTER TO FLOATING ZERO 596 000203 3022 DCA PC /STORE DUMMY POINTER TO CURRENT LINE 597 000204 7001 IAC /GET ONE IN AC 598 000205 3103 DCA TRCESW /SET "NO TRACE" SWITCH 599 000206 3026 DCA QUOTSW /CLEAR QUOTE FLAG 600 000207 1226 TAD SCRLIM /GET UPPER BOUND FOR SCRATCH BUFFER (+SAFETY) 601 000210 3013 DCA PDLPTR /STORE IN STACK POINTER TO STOP ENCODING 602 000211 1105 TAD N100 /GET READY SIGNAL 603 000212 4547 JMS I PRTCL /PRINT ON TTY 604 000213 1131 SCRAP, TAD SCRTCH /GET POINTER TO SCRATCH BUFFER 605 000214 3010 DCA PUTPTR /STORE IN TEXT ENCODE POINTER 606 000215 3065 DCA PUTSDE /PREPARE TO ENCODE ON LEFT SIDE 607 000216 1131 TAD SCRTCH /GET POINTER TO SCRATCH BUFFER 608 000217 3027 DCA PUTBEG /SET UP AS BEGINNING OF LINE 609 000220 4550 GTCHR, JMS I INPUT /GET CHARACTER FROM KEYBOARD 610 000221 4545 JMS I TABSCH /DO LOOKUP AND GO AMONG 611 000222 0076 IMMED-1 /CHARACTERS FOR IMMEDIATE ACTION 612 000223 7075 IMMDGO-IMMED /POINT TO ADDRESS TABLE IF SUCESSFUL 613 000224 4544 JMS I ENCODE /PUT CHAR IN SCRATCH BUFFER 614 000225 5220 JMP GTCHR /GO GET NEXT CHARACTER 615 000226 3537 SCRLIM, SCRBUF+13+45 /UPPER BOUND FOR SCRATCH BUFFER 616 000227 7240 LFECHO, CLA CMA /GET NEGATIVE ONE 617 000230 1061 TAD TABCTR /ADD TO COLUMN NUMBER 618 000231 7650 SNA CLA /IN COLUMN ONE? 619 000232 5220 JMP GTCHR /YES, IGNORE IT 620 000233 2026 ISZ QUOTSW /INHIBIT TRACE 621 000234 1010 TAD PUTPTR /GET ENCODE POINTER 622 000235 3012 DCA WRKPTR /MOVE TO RUINABLE LOCATION 623 000236 1065 TAD PUTSDE /GET SIDE INDICATOR 624 000237 7650 SNA CLA /ANYTHING IN PUTWRK? 625 000240 5243 JMP .+3 /NO, GO AHEAD 626 000241 1064 TAD PUTWRK /YES, GET WORK AREA 627 000242 3412 DCA I WRKPTR /ENCODE 628 000243 1131 TAD SCRTCH /NO, GET START OF SCRATCH AREA 629 000244 3017 DCA GETPTR /PREPARE TO DECODE 630 000245 3020 DCA GETSDE /FROM THE LEFT SIDE 631 000246 1102 TAD CR /GET RETURN 632 000247 4547 JMS I PRTCL /PRINT CRLF 633 000250 1105 TAD N100 /GET READY SIGNAL 634 000251 4547 LFLOOP, JMS I PRTCL /PRINT CHARACTER 635 000252 1017 TAD GETPTR /GET DECODE POINTER 636 000253 7041 CIA /NEGATE 637 000254 1012 TAD WRKPTR /SUBTRACT FROM ENCODE POINTER 638 000255 7640 SZA CLA /EQUAL? 639 000256 5264 JMP LFTYPE /NO, GET NEXT CHARACTER 640 000257 1020 TAD GETSDE /GET RIGHT/LEFT SWITCH 641 000260 7041 CIA /NEGATE 642 000261 1065 TAD PUTSDE /COMPARE TO OTHER RIGHT/LEFT SW 643 000262 7650 SNA CLA /DONE TYPING? 644 000263 5220 JMP GTCHR /YES, GO INPUT REST OF LINE 645 000264 4543 LFTYPE, JMS I DECODE /GET CHARACTER 646 000265 5251 JMP LFLOOP /GO TYPE IT 647 000266 4544 CARRET, JMS I ENCODE /PUT CR INTO BUFFER 648 000267 4544 JMS I ENCODE /PUT CR INTO BUFFER AGAIN TO BE SURE 649 000270 1131 TAD SCRTCH /GET POINTER TO SCRATCH BUFFER 650 000271 3017 DOIT, DCA GETPTR /STORE IN TEXT DECODE POINTER 651 000272 3020 DCA GETSDE /SET UP FOR LEFT HALFWORD 652 000273 4543 JMS I DECODE /GET CHARACTER FROM BUFFER 653 000274 1036 KLEAR, TAD BOTTMP /GET LAST FREE ADDRESS 654 000275 3013 DCA PDLPTR /STORE IN STACK POINTER 655 000276 4556 JMS I KLSPCE /IGNORE SPACES 656 000277 4557 JMS I SRTNUM /CHECK WHETHER '.', 0-9. OR ALPHA 657 000300 4564 JMS I ERROR /LINE NUMBER STARTED WITH PERIOD 658 000301 5327 JMP DIRECT /DIRECT COMMAND IF FIRST CHAR ALPHA 659 000302 2026 ISZ QUOTSW /INHIBIT TRACE 660 000303 4552 JMS I GETARG /INTERPRET LInE NUMBER 661 000304 7330 CLA CLL CML RAR /GET 4000 IN AC 662 000305 1070 TAD ARGSW /ADD IN LINE NUMBER SWITCHES 663 000306 7640 SZA CLA /LINE NUMBER GOT BOTH GROUP AND FRACTION? 664 000307 4564 JMS I ERROR /NO, GO TO ERROR ROUTINE 665 000310 1063 TAD TXTEND /YES, GET POINTER TO END OF TEXT BUFFER 666 000311 3010 DCA PUTPTR /STORE IN TEXT ENCODE POINTER 667 000312 3065 DCA PUTSDE /PREPARE TO ENCODE ON LEFT SIDE 668 000313 1072 TAD LINENO /GET LINE NUMBER 669 000314 3410 DCA I PUTPTR /STORE IN BUFFER 670 000315 7410 SKP /FIRST CHARACTER ALREADY DECODED 671 000316 4543 MOVELP, JMS I DECODE /GET CHARACTER FROM TEMPORARY BUFFER 672 000317 4544 JMS I ENCODE /PUT CHARACTER INTO TEXT BUFFER 673 000320 1071 TAD CHAR /GET CHARACTER 674 000321 1122 TAD NCR /SUBTRACT CARRIAGE-RETURN 675 000322 7640 SZA CLA /WAS CHARACTER A RETURN? 676 000323 5316 JMP MOVELP /NO, MOVE ANOTHER CHARACTER INTO TEXT BUFFER 677 000324 4563 JMS I DELETE /REMOVE COPY, IF ANY 678 000325 4554 JMS I NEWLIN /ENTER NEW LINE IN TEXT BUFFER 679 000326 5177 JMP START /RETURN TO COMMAND MODE 680 000327 4536 DIRECT, JMS I PUSHJ /RECURSIVE CALL 681 000330 0632 EXEC /EXECUTE COMMAND ROUTINE 682 000331 1422 TAD I PC /GET ADDRESS OF NEXT LINE 683 000332 7450 SNA /DONE? 684 000333 5177 JMP START /YES, RETURN TO COMMAND MODE 685 000334 3022 DCA PC /NO, STORE POINTER TO START OF NEXT LINE 686 000335 1022 TAD PC /GET POINTER TO NEW LINE 687 000336 7001 IAC /ADD ONE TO SKIP LINE NUMBER 688 000337 5271 JMP DOIT /GO EXECUTE NEXT LINE 689 000340 0000 R6L, .-. /ROUTINE TO SHIFT AC 6 LEFT 690 000341 7106 CLL RTL /SHIFT 2 LEFT 691 000342 7006 RTL /SHIFT 2 MORE 692 000343 7006 RTL /SHIFT 2 MORE 693 000344 5740 JMP I R6L /RETURN 694 000345 0000 POPFAC, .-. /ROUTINE TO POP FLOATING POINT NUMBERS OFF STACK 695 000346 7240 CLA CMA /GET NEGATIVE ONE 696 000347 1745 TAD I POPFAC /GET ADDRESS TO POP INTO 697 000350 2345 ISZ POPFAC /SKIP PARM UPON RETURN 698 000351 3011 DCA QCKPTR /STORE IN DESIGNATED AREA 699 000352 1413 TAD I PDLPTR /GET FIRST WORD FROM STACK 700 000353 3411 DCA I QCKPTR /STORE IN DESIGNATED AREA 701 000354 1413 TAD I PDLPTR /GET ENTRY FROM STACK 702 000355 3411 DCA I QCKPTR /STORE IN PROPER LOCATION 703 000356 1413 TAD I PDLPTR /GET WORD FROM STACK 704 000357 3411 DCA I QCKPTR /STORE IN PROPER LOCATION 705 000360 5745 JMP I POPFAC /RETURN 706 000361 2033 FUNCGO, FABS /FUNCTION ADDRESS TABLE 707 000362 2027 FSGN 708 000363 2376 FITR 709 000364 3011 FIN 710 000365 3304 FRAN 711 000366 3025 FOUT 712 000367 3020 FTST 713 000370 3341 FIND 714 000371 3000 FMQ 715 000372 0000 DELFUN, 0000/FATN /bugbug:mismatch 716 000373 0000 0000/FEXP /bugbug:mismatch 717 000374 0000 0000/FLOG /bugbug:mismatch 718 000375 5635 FCOS 719 000376 5641 FSIN 720 000377 6000 FSQT 721 722 *400 /DO COMMAND, GETARG, STACK MAINTENANCE ROUTINES 723 000400 6063 SAVEXP 724 000401 0000 ARGGET, .-. /ROUTINE TO INTERPRET LINE NUMBERS 725 000402 4536 JMS I PUSHJ /DO RECURSIVE CALL 726 000403 1612 EVAL /TO EQUATION SOLVER 727 000404 4455 JMS I FIX /FIC FLOATIN AC (ISOLATE GROUP NUMBER) 728 000405 0001 AND C77 /TAKE MODULO 32 729 000406 4555 JMS I ROT6 /MOVE RESULT TO HIGH ORDER BITS 730 000407 7004 RAL /TO FORM GROUP PORTION 731 000410 3072 DCA LINENO /STORE GROUP NUMBER 732 000411 4453 JMS I NEGATE /NEGATE FLOATING AC 733 000412 4407 JMS I FPP /ENTER FLOATING POINT 734 000413 1525 FADD I PDUMMY /ISOLATE FRATION IN FAC 735 000414 4240 FMPY FL100 /MULTIPLY BY 100 736 000415 1242 FADD FLP5 /ADD .5 TO ROUND 737 000416 0000 FEXT /RETURN TO NORMAL MODE 738 000417 4455 JMS I FIX /FIX FLOATING AC (ISOLATE FRACTION) 739 000420 1072 TAD LINENO /ADD TO GROUP NUMBER 740 000421 3072 DCA LINENO /STORE UPDATED RESULT 741 000422 7100 CLL /SET FUTURE AC11 (GROUP SW) 742 000423 1072 TAD LINENO /GET LINE NUMBER 743 000424 0112 AND C7600 /ISOLATE GROUP BITS 744 000425 7640 SZA CLA /GROUP ZERO? 745 000426 7020 CML /NO, CLEAR FUTURE AC11 (GROUP SW) 746 000427 1072 TAD LINENO /GET LINE NUMBER 747 000430 0002 AND C177 /MASK FOR FRACTION 748 000431 7460 SZA SNL /FRACTION WITHOUT GROUP? 749 000432 4564 JMS I ERROR /YES, INVALID LINE NUMBER 750 000433 7640 SZA CLA /NO, ANY FRACTION AT ALL? 751 000434 1243 TAD C2000 /YES, SET FUTURE AC0 (FRACTION SW) 752 000435 7024 CML RAL /FORM SWITCH WORD 753 000436 3070 DCA ARGSW /STORE SWITCHES PERTAINING TO LINENO 754 000437 5601 JMP I ARGGET /RETURN 755 000440 0007 FL100, 7 /FLOATING POINT CONSTANT OF 100 756 000441 3100 3100 757 000442 0000 FLP5, 0 /FLOATING POINT CONSTANT OF 1/2 (FOR ROUNDING) 758 000443 2000 C2000, 2000 759 000444 0000 0 760 000445 4552 DO, JMS I GETARG /INTERPRET ARGUMENT 761 000446 1022 TAD PC /GET POINTER TO CURRENT LINE 762 000447 4540 JMS I PUSHA /PUT ON STACK 763 000450 4541 JMS I PUSHF /PUSH 764 000451 0017 GETPTR /DECODE WORK AREA 765 000452 4541 DOMORE, JMS I PUSHF /PUSH 766 000453 0070 ARGSW /CURRENT CHARACTER, CURRENT LINE NUMBER 767 000454 1070 TAD ARGSW /GET LINE NUMBER SWITCHES 768 000455 7710 SPA CLA /GROUP DO? 769 000456 5310 JMP DOONE /NO, ONLY DO ONE LINE 770 000457 4553 JMS I FNDLIN /SEEK LINE TO BE PERFORMED 771 000460 7000 NOP /HERE BECAUSE GROUP SEEK TAKES 'NOT FOUND' RETURN 772 000461 1023 TAD NEWPC /GET POINTER TO NEW LINE 773 000462 3011 DCA QCKPTR /PREPARE TO GET LINE NUMBER 774 000463 1411 TAD I QCKPTR /GET NEW LINE NUMBER 775 000464 4561 JMS I GRPTST /IN SAME GROUP? 776 000465 4564 JMS I ERROR /NO, GO TO ERROR ROUTINE 777 000466 4536 JMS I PUSHJ /RECURSIVE CALL 778 000467 0627 GOTO /TO GOTO AND EXECUTE THE LINE 779 000470 4542 JMS I POPF /UNSTACK 780 000471 0070 ARGSW /CURRENT CHARACTER, LINE NUMBER 781 000472 1422 TAD I PC /GET POINTER TO NEXT LINE 782 000473 7450 SNA /IS THIS THE LAST LINE? 783 000474 5316 JMP DODONE /YES, DONE DOING 784 000475 7001 IAC /NO, ADD ONE TO POINT TO LINE NUMBER 785 000476 3030 DCA POINT1 /STORE IN POINTER LOCATION 786 000477 1070 TAD ARGSW /GET LINE NUMBER SWITCHES 787 000500 7740 SZA SMA CLA /DO ALL? 788 000501 5305 JMP YESDO /YES, GO AHEAD AND DO NEXT LINE 789 000502 1430 TAD I POINT1 /NO, GET LINE NUMBER 790 000503 4561 JMS I GRPTST /IN SAME GROUP? 791 000504 5316 JMP DODONE /NO, DONE DOING 792 000505 1430 YESDO, TAD I POINT1 /GET NEW LINE NUMBER 793 000506 3072 DCA LINENO /STORE AS LINE BEING WORKED WITH 794 000507 5252 JMP DOMORE /GO DO THIS LINE TOO 795 000510 4553 DOONE, JMS I FNDLIN /SEEK LINE TO BE PERFORMED 796 000511 4564 JMS I ERROR /LINE NOT FOUND, GO TO ERROR ROUTINE 797 000512 4536 JMS I PUSHJ /RECURSIVE CALL 798 000513 0631 EXEC-1 /TO COMMAND INTERPRETER 799 000514 4542 JMS I POPF /UNSTACK 800 000515 0070 ARGSW /CURRENT CHARACTER, LINE NUMBER 801 000516 4542 DODONE, JMS I POPF /UNSTACK 802 000517 0017 GETPTR /DECODE INFO 803 000520 1413 TAD I PDLPTR /GET ENTRY FROM STACK 804 000521 3022 DCA PC /STORE POINTER TO BEGINNING OF LINE 805 000522 4574 JMS I PCOMMA /CHECK FOR MORE PARAMETERS 806 000523 5576 JMP I PEXEC /NO, GO EXECUTE REST OF LINE 807 000524 5245 JMP DO /YES, GO INTERPRET AND USE THEM 808 000525 0000 PUSHAC, .-. /SUBROUTINE TO STACK THE CURRENT VALUE OF THE AC 809 000526 3074 DCA WORK /SAVE FOR A MOMENT 810 000527 7040 CMA /GET NEGATIVE ONE 811 000530 4337 JMS PDLUP /DECREMENT STACK POINTER 812 000531 1074 TAD WORK /GET ITEM TO BE STACKED 813 000532 3413 DCA I PDLPTR /STORE AC ON STACK 814 000533 7040 CMA /GET NEGATIVE ONE 815 000534 1013 TAD PDLPTR /DECREMENT STACK POINTER 816 000535 3013 DCA PDLPTR /TO RECORD THE ENTRY 817 000536 5725 JMP I PUSHAC /RETURN 818 000537 0000 PDLUP, .-. /MOVE STACK POINTER ROUTINE 819 000540 1013 TAD PDLPTR /ADD STACK POINTER TO AC 820 000541 3013 DCA PDLPTR /STORE UPDATED STACK POINTER 821 000542 1013 TAD PDLPTR /GET NEW STACK POINTER 822 000543 7141 CLL CIA /NEGATE 823 000544 1031 TAD VAREND /ADD POINTER TO END OF VARIABLE TABLE 824 000545 7630 SZL CLA /STACK OVERFLOW? 825 000546 4564 JMS I ERROR /YES, GO TO ERROR ROUTINE 826 000547 5737 JMP I PDLUP /NO, RETURN 827 000550 0000 PUSHPC, .-. /RECURSIVE CALL HANDLER 828 000551 1750 TAD I PUSHPC /GET ADDRESS OF RECURSIVE SUBROUTINE 829 000552 3325 DCA PUSHAC /SAVE FOR LATER RETURN FROM PUSHA 830 000553 1350 TAD PUSHPC /GET ADDRESS FOR RETURN 831 000554 7001 IAC /ADD ONE TO SKIP OVER PARM 832 000555 5326 JMP PUSHAC+1 /GO PUSH RETURN ADDRESS AND GO 833 000556 0000 PUSHFC, .-. /SUBROUTINE TO PUSH FLOATING POINT NUMBERS 834 000557 7240 CLA CMA /GET NEGATIVE ONE 835 000560 1756 TAD I PUSHFC /GET ADDRESS OF NUMBER 836 000561 3011 DCA QCKPTR /STORE ADDRESS OF WORDS TO STACK 837 000562 2356 ISZ PUSHFC /SKIP PARM UPON RETURN 838 000563 1123 TAD FACLEN /GET LENGTH OF FLOATING AC 839 000564 4337 JMS PDLUP /UPDATE STACK POINTER 840 000565 1411 TAD I QCKPTR /GET FIRST WORD TO BE STACKED 841 000566 3413 DCA I PDLPTR /STORE ON STACK 842 000567 1411 TAD I QCKPTR /GET SECOND WORD TO BE STACKED 843 000570 3413 DCA I PDLPTR /STORE ON STACK 844 000571 1411 TAD I QCKPTR /GET THIRD WORD TO BE STACKED 845 000572 3413 DCA I PDLPTR /STORE ON STACK 846 000573 1123 TAD FACLEN /GET LENGTH OF FLOATING AC 847 000574 1013 TAD PDLPTR /UPDATE STACK POINTER 848 000575 3013 DCA PDLPTR /TO PRESERVE ENTRIES 849 000576 5756 JMP I PUSHFC /RETURN 850 000577 0323 COMLST, 323 /SET, STEP 851 852 *600 /COMMAND INTERPRETER, GOTO, WRITE COMMANDS 853 000600 0306 306 /FOR 854 000601 0311 311 /IF 855 000602 0304 304 /DO 856 000603 0307 307 /GO, GOTO 857 000604 0303 303 /COMMENT, CONTINUE 858 000605 0301 301 /ASK, ACCEPT 859 000606 0324 324 /TYPE 860 000607 0310 310 /HELLO, HEADING 861 000610 0313 313 /KLEAR 862 000611 0314 314 /LOCATIONS, LIBRARY, LEAVE 863 000612 0305 305 /ERASE, END 864 000613 0327 327 /WRITE 865 000614 0315 315 /MODIFY, MOVE 866 000615 0302 302 /BRANCH 867 000616 0321 321 /QUIT 868 000617 0322 322 /RETURN 869 000620 0326 326 /VARIABLES 870 000621 0330 330 /XECUTE 871 000622 0332 332 /ZERO 872 000623 7472 N306, -306 /NEGATIVE ASCII 'F' 873 000624 4552 GO, JMS I GETARG /INTERPRET ARGUMENT 874 000625 4553 JMS I FNDLIN /SEEK LINE TO BE GONE TO 875 000626 4564 JMS I ERROR /NO SUCH LINE, GO TO ERROR ROUTINE 876 000627 1023 GOTO, TAD NEWPC /GET POINTER TO NEW LINE 877 000630 3022 DCA PC /STORE AS POINTER TO CURRENT LINE 878 000631 4543 JMS I DECODE /DECODE NEXT CHARACTER 879 000632 1071 EXEC, TAD CHAR /GET CHARACTER 880 000633 1122 TAD NCR /SUBTRACT CARRIAGE-RETURN 881 000634 7650 SNA CLA /WAS CHARACTER A RETURN? 882 000635 5537 JMP I LINEND /YES, GO TO NEXT SEQUENTIAL LINE 883 000636 4546 JMS I CHECK /LOOK TO SEE IF IN 884 000637 2022 TERTAB-1 /TABLE OF TERMINATORS 885 000640 5231 JMP EXEC-1 /YES, IGNORE TERMINATOR 886 000641 1071 TAD CHAR /GET CHARACTER 887 000642 4540 JMS I PUSHA /PUT ON STACK 888 000643 4543 JMS I DECODE /GET CHARACTER FROM BUFFER 889 000644 4546 JMS I CHECK /LOOK TO SEE IF IN TABLE 890 000645 1777 TRMTAB-1 /OF ALL TERMINATORS 891 000646 7410 SKP /YES, EXECUTE STACKED COMMAND 892 000647 5243 JMP .-4 /NO, LOOK FOR TERMINATOR 893 000650 1413 TAD I PDLPTR /GET ENTRY FROM STACK 894 000651 4545 JMS I TABSCH /DO LOOKUP AND GO 895 000652 0576 COMLST-1 /POINTER TO COMMAND TABLE-1 896 000653 2556 COMGO-COMLST /POINT AT COMMAND STARTING ADDRESSES 897 000654 4564 JMS I ERROR /INVALID COMMAND, GO TO ERROR ROUTINE 898 000655 4552 WRITE, JMS I GETARG /INTERPRET ARGUMENT 899 000656 2026 ISZ QUOTSW /FORCE QUOTE MODE 900 000657 4553 WRTELP, JMS I FNDLIN /SEEK LINE TO BE LISTED 901 000660 5307 JMP WRTGRP /NOT FOUND, MUST BE GROUP WRITE 902 000661 1072 TAD LINENO /GET LINE NUMBER 903 000662 7640 SZA CLA /HEADING LINE? 904 000663 4551 JMS I ARGOUT /NO, PRINT LINE NUMBER 905 000664 4543 JMS I DECODE /GET CHARACTER FROM BUFFER 906 000665 4547 JMS I PRTCL /PRINT CHARACTER ON TTY 907 000666 1071 TAD CHAR /GET CHARACTER 908 000667 1122 TAD NCR /SUBTRACT CARRIAGE-RETURN 909 000670 7640 SZA CLA /WAS CHARACTER A RETURN? 910 000671 5264 JMP .-5 /NO, PRINT ANOTHER 911 000672 1423 TAD I NEWPC /GET POINTER WORD OF CURRENT LINE 912 000673 7450 WRTCHK, SNA /ALL LINES WRITTEN? 913 000674 5311 JMP WRTDNE /YES, MUST BE DONE 914 000675 7001 IAC /NO, ADD ONE TO POINT AT LINE NUMBER 915 000676 3030 DCA POINT1 /STORE IN POINTER LOCATION 916 000677 1070 TAD ARGSW /GET LINE NUMBER SWITCHES 917 000700 7700 SMA CLA /GROUP WRITE? 918 000701 1430 TAD I POINT1 /NO, GET LINE NUMBER 919 000702 4561 JMS I GRPTST /IN SAME GROUP? 920 000703 5313 JMP NEWGRP /NO, SEE IF IT SHOULD BE LISTED 921 000704 1430 WRTMRE, TAD I POINT1 /YES, GET NEW LINE NUMBER 922 000705 3072 DCA LINENO /STORE AS LINE BEING WORKED WITH 923 000706 5257 JMP WRTELP /GO LIST THE LINE 924 000707 1023 WRTGRP, TAD NEWPC /GET POINTER TO NEW LINE 925 000710 5273 JMP WRTCHK /CHECK IT OUT 926 000711 3026 WRTDNE, DCA QUOTSW /CLEAR QUOTE FLAG 927 000712 5537 JMP I LINEND /GO EXECUTE NEXT LINE 928 000713 1070 NEWGRP, TAD ARGSW /GET LINE NUMBER SWITCHES 929 000714 7750 SPA SNA CLA /WRITE ALL? 930 000715 5311 JMP WRTDNE /NO, ALL DONE 931 000716 4547 JMS I PRTCL /PRINT RETURN AGAIN 932 000717 5304 JMP WRTMRE /GO WRITE THIS GROUP TOO 933 000720 0000 FUNSRT, .-. /DETERMINE WHETHER OPERATOR, 0-9, 'F', OR OTHER 934 000721 4556 JMS I KLSPCE /IGNORE SPACES 935 000722 4546 JMS I CHECK /LOOK TO SEE IF IN TABLE 936 000723 1777 TRMTAB-1 /OF ARITHMETIC TERMINATORS 937 000724 5720 JMP I FUNSRT /YES, RETURN WITHOUT SKIPPING 938 000725 1071 TAD CHAR /NO, GET CHARACTER 939 000726 2320 ISZ FUNSRT /SKIP AT LEAST ONE WHEN RETURNING 940 000727 1223 TAD N306 /SUBTRACT ASCII 'F' 941 000730 7650 SNA CLA /CHARACTER AN 'F'? 942 000731 5337 JMP FUNSK2 /YES, SKIP TWO AND RETURN 943 000732 4557 JMS I SRTNUM /CHECK WHETHER '.', 0-9, OR ALPHA 944 000733 5720 JMP I FUNSRT /PERIOD, SKIP ONE AND RETURN 945 000734 7410 SKP /ALPHA, SKIP 3 AND RETURN 946 000735 5720 JMP I FUNSRT /NUMERIC, SKIP ONE AND RETURN 947 000736 2320 ISZ FUNSRT /GOING TO SKIP 3 948 000737 2320 FUNSK2, ISZ FUNSRT /GOING TO SKIP AT LEAST TWO 949 000740 5720 JMP I FUNSRT /RETURN 950 000741 0000 SPECHK, .-. /TABLE SCAN ROUTINE 951 000742 1741 TAD I SPECHK /GET POINTER TO TABLE 952 000743 3012 DCA WRKPTR /SAVE IT 953 000744 1412 CHKLP, TAD I WRKPTR /GET AN ENTRY 954 000745 7510 SPA /IS IT THE DELIMITER? 955 000746 5360 JMP CHKXIT /YES, GO RETURN TO CALLER 956 000747 7041 CIA /NO, NEGATE IT 957 000750 1071 TAD CHAR /SUBTRACT ENTRY FROM CHAR 958 000751 7640 SZA CLA /EQUAL? 959 000752 5344 JMP CHKLP /NO, LOOK AT NEXT ENTRY 960 000753 1741 TAD I SPECHK /YES, GET POINTER TO START OF TABLE-1 961 000754 7040 CMA /MAKE NEGATIVE POINTER TO TABLE 962 000755 1012 TAD WRKPTR /COMPUTE WHICH ENTRY 963 000756 3056 DCA SORTWK /SAVE FOR CALLER 964 000757 7410 SKP /TAKE 'FOUND IT' RETURN 965 000760 2341 CHKXIT, ISZ SPECHK /TAKE 'NOT FOUND' RETURN 966 000761 2341 ISZ SPECHK /SKIP OVER PARAMETER UPON RETURN 967 000762 7300 CLA CLL /CLEAR GUNK FROM AC 968 000763 5741 JMP I SPECHK /RETURN 969 000764 0000 SKPGRP, .-. /ROUTINE TO SKIP IF AC AND LINENO SAME GROUP 970 000765 0112 AND C7600 /ISOLATE GROUP BITS FROM AC 971 000766 7041 CIA /NEGATE 972 000767 3074 DCA WORK /STORE FOR LATER 973 000770 1072 TAD LINENO /GET CURRENT LINE NUMBER 974 000771 0112 AND C7600 /ISOLATE GROUP BITS 975 000772 1074 TAD WORK /SUBTRACT GROUP BITS FROM AC 976 000773 7650 SNA CLA /SAME GROUP NUMBER? 977 000774 2364 ISZ SKPGRP /YES, TAKE SKIP RETURN 978 000775 5764 JMP I SKPGRP /RETURN 979 000776 0212 NOECHO, 212 /LF 980 000777 0377 377 /RUBOUT 981 982 *1000 /IF, FOR, AND SET COMMANDS 983 001000 0233 233 /ESC 984 001001 0214 214 /FORM 985 001002 4541 STEP1, JMS I PUSHF /PUSH 986 001003 3043 ONE /CONSTANT OF ONE AS STEP 987 001004 5331 JMP GOTSTP /GO GET LIMIT 988 001005 1254 IF, TAD PGO /GET ADDRESS OF GOTO HANDLER 989 001006 7410 SKP /GO SET UP POINTER 990 001007 1255 BRANCH, TAD PDO /GET ADDRESS OF DO HANDLER 991 001010 3253 DCA IFSAVE /SET UP FOR LATER BRANCHING 992 001011 4536 JMS I PUSHJ /DO RECURSIVE CALL 993 001012 1612 EVAL /TO EQUATION SOLVER 994 001013 4574 JMS I PCOMMA /IGNORE COMMA, IF ANY 995 001014 7000 NOP /IN CASE NO COMMA FOUND 996 001015 4545 JMS I TABSCH /SEARCH 997 001016 3335 RELOPR-1 /FOR RELATIONAL OPERATOR 998 001017 6040 RELOGO-RELOPR /GO DO RELATIONAL IF 999 001020 7344 CLA CLL CMA RAL /OTHERWISE, GET NEGATIVE 2 1000 001021 3032 DCA SAVE1 /INITIALIZE COUNTER 1001 001022 1046 TAD FACHGH /GET HIGH ORDER FAC (SIGN) 1002 001023 7510 SPA /FAC POSITIVE OR ZERO? 1003 001024 2032 ISZ SAVE1 /NO, BUMP COUNTER 1004 001025 7750 SPA SNA CLA /FAC NEGATIVE OR ZERO? 1005 001026 2032 IFTEST, ISZ SAVE1 /NO, BUMP COUNTER 1006 001027 7410 SKP /TEST NOT TRUE, SET UP FOR NEXT TEST 1007 001030 5240 JMP IFRGHT /GO IGNORE REST OF LINE NUMBERS 1008 001031 4545 JMS I TABSCH /DO LOOKUP AND GO 1009 001032 2023 TERTAB /AMONG COMMAND DELIMITERS 1010 001033 7152 IFGO-TERTAB-1 /WHERE TO GO WITH VARIOUS TERMINATORS 1011 001034 4543 JMS I DECODE /NOT A TERMINATOR, IGNORE IT 1012 001035 5231 JMP .-4 /CHECK OUT THE NEXT CHARACTER 1013 001036 4543 IFTRUE, JMS I DECODE /IGNORE THE COMMA 1014 001037 5226 JMP IFTEST /GO CHECK NEXT CONDITION 1015 001040 4552 IFRGHT, JMS I GETARG /INTERPRET LINE NUMBER 1016 001041 4541 JMS I PUSHF /STACK 1017 001042 0070 ARGSW /LINE NUMBER INFO 1018 001043 4546 IFLOOP, JMS I CHECK /CHECK 1019 001044 2024 TERTAB+1 /FOR COMMA OR SEMICOLON 1020 001045 5250 JMP IFGOTO /FOUND IT, DO CORRECT LINE 1021 001046 4543 JMS I DECODE /NOT FOUND IGNORE CHARACTER 1022 001047 5243 JMP IFLOOP /GO SEE IF NEXT IS TERMINATOR 1023 001050 4542 IFGOTO, JMS I POPF /UNSTACK 1024 001051 0070 ARGSW /LINE NUMBER INFORMATION 1025 001052 5653 JMP I IFSAVE /GO DO CORRECT TRANSFER 1026 001053 0000 IFSAVE, .-. /POINTER TO TRANSFER ROUTINE FOR BRANCH AND IF 1027 001054 0625 PGO, GO+1 /POINTER TO 'GOTO' STYLE TRANSFER HANDLER 1028 001055 0446 PDO, DO+1 /POINTER TO 'DO' STYLE TRANSFER HANDLER 1029 001056 3032 SETFOR, DCA SAVE1 /CLEAR VARIABLE COUNTER 1030 001057 7410 SKP /NO TERMINATOR TO IGNORE 1031 001060 4543 INDXLK, JMS I DECODE /IGNORE TERMINATOR 1032 001061 4536 JMS I PUSHJ /RECURSIVE CALL 1033 001062 1401 SEEKVR /FIND INDEX VARIABLE 1034 001063 4575 JMS I PNOZVR /DISABLE ZVR 1035 001064 4556 JMS I KLSPCE /IGNORE SPACES 1036 001065 1030 TAD POINT1 /GET POINTER TO VARIABLE 1037 001066 4540 JMS I PUSHA /SAVE ON STACK 1038 001067 7040 CMA /GET NEGATIVE ONE 1039 001070 1032 TAD SAVE1 /DECREMENT COUNTER 1040 001071 3032 DCA SAVE1 /STORE NEW COUNTER 1041 001072 4545 JMS I TABSCH /LOOK UP AND GO 1042 001073 1401 FORCHR-1 /IF EQUALS OR COMMA 1043 001074 1573 FORGO-FORCHR /TO GET NEXT INDEX OR SET 1044 001075 4564 JMS I ERROR /NO, GO TO ERROR ROUTINE 1045 001076 4536 SET, JMS I PUSHJ /RECURSIVE CALL 1046 001077 1611 EVAL-1 /TO EQUATION SOLVER 1047 001100 1032 TAD SAVE1 /GET COUNT OF VARIABLES TO BE SET 1048 001101 3074 DCA WORK /INITIALIZE FOR COUNTING 1049 001102 1413 INDXLP, TAD I PDLPTR /GET POINTER BACK FROM STACK 1050 001103 3030 DCA POINT1 /STORE IN POINTER LOCATION 1051 001104 4407 JMS I FPP /ENTER FLOATING POINT MODE 1052 001105 6430 FPUT I POINT1 /STORE NEW VALUE IN VARIABLE 1053 001106 0000 FEXT /RETURN TO NORMAL MODE 1054 001107 2074 ISZ WORK /DONE ALL VARIABLES? 1055 001110 5302 JMP INDXLP /NO, DO ANOTHER 1056 001111 4545 JMS I TABSCH /DO LOOKUP AND GO 1057 001112 2023 TERTAB /AMONG COMMAND DELIMITERS 1058 001113 1153 FORGO1-TERTAB-1 /WHERE TO GO IF FOUND 1059 001114 4564 JMS I ERROR /WRONG TERMINATOR 1060 001115 1030 FOR, TAD POINT1 /GET POINTER TO INDEX 1061 001116 4540 JMS I PUSHA /STACK IT 1062 001117 4536 JMS I PUSHJ /RECURSIVE CALL 1063 001120 1611 EVAL-1 /TO EVALUATE SECOND PARAMETER 1064 001121 4545 JMS I TABSCH /DO LOOKUP AND GO 1065 001122 2023 TERTAB /AMONG COMMAND DELIMITERS 1066 001123 0742 FORGO2-TERTAB-1 /GO TO PROPER PLACE 1067 001124 4564 JMS I ERROR /ANOTHER POSSIBILITY FOR WRONG TERMINATION 1068 001125 4541 FORSTP, JMS I PUSHF /PUSH 1069 001126 2050 DUMMY /STEP 1070 001127 4536 JMS I PUSHJ /RECURSIVE CALL 1071 001130 1611 EVAL-1 /EVALUATE LIMIT 1072 001131 4541 GOTSTP, JMS I PUSHF /PUSH 1073 001132 2050 DUMMY /LIMIT 1074 001133 4541 JMS I PUSHF /PUSH 1075 001134 0017 GETPTR /DECODE INFO 1076 001135 4362 JMS UNFOR /UNSTACK CRUD 1077 001136 4407 FORLP, JMS I FPP /ENTER FLOATING POINT MODE 1078 001137 0430 FGET I POINT1 /GET INDEX VARIABLE VALUE 1079 001140 2525 FSUB I PDUMMY /SUBTRACT LIMIT 1080 001141 3772 FDIV I PSTEP /HANDLE NEGATIVE AND ZERO STEP VALUES 1081 001142 0000 FEXT /RETURN TO NORMAL MODE 1082 001143 4575 JMS I PNOZVR /DISABLE ZVR 1083 001144 1046 TAD FACHGH /GET HIGH ORDER FAC (SIGN) 1084 001145 7740 SMA SZA CLA /FAC NEGATIVE OR ZERO? 1085 001146 5537 JMP I LINEND /YES, GO FIND NEXT LINE TO EXECUTE 1086 001147 1074 TAD WORK /NO, GET OLD STACK VALUE 1087 001150 3013 DCA PDLPTR /RESTORE OLD STACK POINTER 1088 001151 4536 JMS I PUSHJ /RECURSIVE CALL 1089 001152 0631 EXEC-1 /COMMAND INTERPRETER 1090 001153 4362 JMS UNFOR /UNSTACK CRUD 1091 001154 4407 JMS I FPP /ENTER FLOATING POINT MODE 1092 001155 0430 FGET I POINT1 /GET INDEX VARIABLE VALUE 1093 001156 1772 FADD I PSTEP /ADD STEP 1094 001157 6430 FPUT I POINT1 /STORE NEW INDEX VARIABLE VALUE 1095 001160 0000 FEXT /RETURN TO NORMAL MODE 1096 001161 5336 JMP FORLP /GO CHECK LIMIT AGAIN 1097 001162 0000 UNFOR, .-. /SUBROUTINE TO UNSTACK 'FOR' INFO 1098 001163 1013 TAD PDLPTR /GET STACK POINTER 1099 001164 3074 DCA WORK /SAVE IN CASE NEED TO GO AGAIN 1100 001165 4542 JMS I POPF /UNSTACK 1101 001166 0017 GETPTR /DECODE INFO 1102 001167 4542 JMS I POPF /UNSTACK 1103 001170 2050 DUMMY /LIMIT 1104 001171 4542 JMS I POPF /UNSTACK 1105 001172 6063 PSTEP, SAVEXP /STEP 1106 001173 1413 TAD I PDLPTR /GET POINTER TO INDEX VARIABLE 1107 001174 3030 DCA POINT1 /STORE IN POINTER 1108 001175 5762 JMP I UNFOR /RETURN 1109 001176 1036 IFGO, IFTRUE /BRANCH TABLE FOR IF COMMAND 1110 001177 0631 EXEC-1 1111 1112 *1200 /ASK, TYPE, TTY OUTPUT ROUTINE, FOUT 1113 001200 2174 ENDLIN 1114 001201 7240 ASK, CLA CMA /SET ASK/TYPE SWITCH 1115 001202 3060 TYPE, DCA ASKTYP /SET UP ASK/TYPE SWITCH 1116 001203 3026 DCA QUOTSW /CLEAR QUOTE FLAG 1117 001204 4545 JMS I TABSCH /DO LOOKUP AND GO 1118 001205 2007 TYPCHR-1 /AMONG CHARACTERS 1119 001206 1431 TYPGO-TYPCHR /PECULIAR TO TYPE AND ASK 1120 001207 2060 ISZ ASKTYP /EXPRESSION, DECIDE WHETHER TO TYPE OR ASK 1121 001210 5241 JMP TYPVAL /GO TYPE A VALUE 1122 001211 4536 JMS I PUSHJ /RECURSIVE CALL 1123 001212 1401 SEEKVR /TO LOOK FOR VARIABLE REFERENCED 1124 001213 4575 JMS I PNOZVR /DISAVLE ZVR 1125 001214 1071 TAD CHAR /GET CHARACTER AFTER VARIABLE REFERENCE 1126 001215 4540 JMS I PUSHA /PLACE ON STACK 1127 001216 1030 TAD POINT1 /GET POINTER TO VARIABLE 1128 001217 4540 JMS I PUSHA /PLACE ON STACK 1129 001220 2037 ISZ INSW /SET INPUT TO COME FROM TTY 1130 001221 1013 TAD PDLPTR /GET STACK POINTER 1131 001222 7001 IAC /POINT TO LAST STACKED ITEM 1132 001223 3032 DCA SAVE1 /SAVE FOR LATER 1133 001224 4536 ASKOVR, JMS I PUSHJ /RECURSIVE CALL 1134 001225 1611 EVAL-1 /EQUATION SOLVER WITH TTY INPUT 1135 001226 1432 TAD I SAVE1 /GET POINTER TO VARIABLE 1136 001227 3030 DCA POINT1 /STORE POINTER FOR RESULT 1137 001230 4407 JMS I FPP /ENTER FLOATING POINT MODE 1138 001231 6430 FPUT I POINT1 /STORE RTESULT IN VARIABLE 1139 001232 0000 FEXT /RETURN TO NORMAL MODE 1140 001233 1032 ALTMDE, TAD SAVE1 /GET FORMER STACK VALUE 1141 001234 3013 DCA PDLPTR /RESTORE STACK, LESS POINTER 1142 001235 3037 DCA INSW /RESET FOR BUFFER INPUT 1143 001236 1413 TAD I PDLPTR /GET ENTRY FROM STACK 1144 001237 3071 DCA CHAR /RESTORE CHARACTER 1145 001240 5201 JMP ASK /GO LOOK AT REST OF COMMAND 1146 001241 4536 TYPVAL, JMS I PUSHJ /RECURSIVE CALL 1147 001242 1612 EVAL /TO EVALUATE EXPRESSION 1148 001243 4527 JMS I TYPFAC /PRINT VALUE 1149 001244 5202 JMP TYPE /GO LOOK AT REST OF COMMAND 1150 001245 2026 QUOTES, ISZ QUOTSW /SET QUOTE FLAG 1151 001246 4543 JMS I DECODE /GET A CHARACTER 1152 001247 4545 JMS I TABSCH /DO A LOOKUP AND GO 1153 001250 7167 UNQUOT-1 /FOR QUOTE OR CR 1154 001251 3405 UNQTGO-UNQUOT /GO DO UNQUOTE IF FOUND 1155 001252 4547 QUOTEL, JMS I PRTCL /OTHERWISE, PRINT CHAR ON TTY 1156 001253 5246 JMP QUOTES+1 /GO PRINT NEXT CHARACTER 1157 001254 4543 QUOTE, JMS I DECODE /GET NEXT CHARACTER 1158 001255 4546 JMS I CHECK /IS IT 1159 001256 7170 UNQUOT /ANOTHER QUOTE? 1160 001257 5252 JMP QUOTEL /YES, GO TYPE IT 1161 001260 5203 JMP TYPE+1 /NO, UNQUOTE 1162 001261 4543 FORMAT, JMS I DECODE /GET NEXT CHARACTER FROM BUFFER 1163 001262 4552 JMS I GETARG /INTERPRET AS ARGUMENT 1164 001263 1072 TAD LINENO /GET RESULT 1165 001264 3054 DCA FORM /SET UP NEW FORMAT CONTROL WORD 1166 001265 5203 JMP TYPE+1 /GO LOOK AT REST OF COMMAND 1167 001266 1101 TYPELF, TAD LF /GET A LINE FEED 1168 001267 5274 JMP EXCLAM+1 /GO PRINT IT 1169 001270 1102 NUMSGN, TAD CR /GET CARRIAGE RETURN 1170 001271 4466 JMS I TYP /PRINT ON TTY 1171 001272 7040 CMA /GET NEGATIVE ONE TO CHANGE CR TO FORM FEED 1172 001273 1102 EXCLAM, TAD CR /GET CARRIAGE RETURN (OR FORM FEED) 1173 001274 4547 JMS I PRTCL /PRINT CHAR ON TTY 1174 001275 4543 TYPIGN, JMS I DECODE /GET NEXT CHARACTER FROM BUFFER 1175 001276 5203 JMP TYPE+1 /GO CHECK REST OF COMMAND 1176 001277 1060 TAB, TAD ASKTYP /GET ASK OR TYPE SWITCH 1177 001300 4540 JMS I PUSHA /STORE ON STACK 1178 001301 4536 JMS I PUSHJ /RECURSIVE CALL 1179 001302 1611 EVAL-1 /TO EXPRESSION SOLVER 1180 001303 4455 JMS I FIX /TAKE INTEGER PART OF RESULT 1181 001304 7550 TABTRY, SPA SNA /POSITIIVE NONZERO? 1182 001305 7201 CLA IAC /NO, TAB TO COLUMN ONE 1183 001306 7041 CIA /NEGATE 1184 001307 7001 IAC /COMPENSATE FOR LEFT MARGIN EQ ONE 1185 001310 1061 TAD TABCTR /ADD CURRENT COLUMN NUMBER 1186 001311 7450 SNA /ALREADY THERE? 1187 001312 5330 JMP TABDNE /YES, ALL DONE 1188 001313 7510 SPA /NEED TO RETURN FIRST? 1189 001314 5323 JMP TABIT /NO, GO AHEAD 1190 001315 7200 CLA /YES, CLEAR JUNK 1191 001316 1102 TAD CR /GET A CARRIAGE RETURN 1192 001317 4466 JMS I TYP /PRINT WITHOUT LINE FEED 1193 001320 4466 JMS I TYP /PINT NUL FOR DELAY 1194 001321 1047 TAD FACMED /GET COLUMN TO TAB TO 1195 001322 5304 JMP TABTRY /GO TAB TO THERE 1196 001323 3062 TABIT, DCA COUNTR /STORE COUNTER 1197 001324 1111 TAD C240 /GET SPACE 1198 001325 4466 JMS I TYP /PRINT IT 1199 001326 2062 ISZ COUNTR /PRINTED ENOUGH? 1200 001327 5324 JMP TABIT+1 /NO, DO ANOTHER 1201 001330 1413 TABDNE, TAD I PDLPTR /GET ASK/TYPE SWITCH FROM STACK 1202 001331 5202 JMP TYPE /GO PROCESS REST OF COMMAND 1203 001332 0000 SCHTAB, .-. /LOOKUP AND GO ROUTINE 1204 001333 7450 SNA /CHARACTER IN AC? 1205 001334 1071 TAD CHAR /NO, USE ONE IN STORAGE 1206 001335 7041 CIA /NEGATE CHARACTER SOUGHT 1207 001336 3074 DCA WORK /SAVE FOR LATER 1208 001337 1732 TAD I SCHTAB /GET TABLE POINTER 1209 001340 2332 ISZ SCHTAB /SKIP FIRST PARM 1210 001341 3012 DCA WRKPTR /SET UP POINTER INTO TABLE 1211 001342 1412 SCHLP, TAD I WRKPTR /GET CHARACTER FROM TABLE 1212 001343 7510 SPA /END OF TABLE? 1213 001344 5356 JMP SCHXIT /YES, TAKE 'NOT FOUND' RETURN 1214 001345 1074 TAD WORK /NO, SUBTRACT CHARACTER 1215 001346 7640 SZA CLA /TABLE ENTRY EQUAL CHARACTER? 1216 001347 5342 JMP SCHLP /NO, LOOK AT NEXT ENTRY 1217 001350 1012 TAD WRKPTR /YES, GET ADDRESS OF ENTRY 1218 001351 1732 TAD I SCHTAB /ADD OFFSET OF GO TABLE 1219 001352 3074 DCA WORK /STORE GO TABLE POINTER 1220 001353 1474 TAD I WORK /GET GO TABLE ENTRY 1221 001354 3074 DCA WORK /STORE AS DESTINATION 1222 001355 5474 JMP I WORK /GO THERE 1223 001356 2332 SCHXIT, ISZ SCHTAB /SKIP OVER THE GO TABLE OFFSET PARAMETER 1224 001357 7300 CLA CLL /LOSE TERMINATOR IN AC 1225 001360 5732 JMP I SCHTAB /RETURN 'NOT FOUND' 1226 001361 0000 IOFOUT, .-. /INTERRUPT OFF CHARACTER OUTPUT 1227 001362 6041 TSF /TTY READY? 1228 001363 5362 JMP .-1 /NO, WAIT FOR IT 1229 001364 6046 TLS /SEND CHARACTER TO TTY 1230 001365 1122 TAD NCR /SUBTRACT CARRIAGE RETURN 1231 001366 7450 SNA /CHARACTER A RETURN? 1232 001367 3061 DCA TABCTR /YES, CLEAR COLUMN COUNTER 1233 001370 1102 TAD CR /RESTORE CHARACTER 1234 001371 0110 AND C140 /GET CASE BITS 1235 001372 7640 SZA CLA /WAS IT PRINTABLE? 1236 001373 2061 ISZ TABCTR /YES, INCREMENT COLUMN 1237 001374 7020 CML /RESTORE LINK 1238 001375 5761 JMP I IOFOUT /RETURN 1239 001376 3120 RELOGO, LESS /BRANCH TABLE FOR IF COMMAND 1240 001377 3122 EQUAL 1241 1242 *1400 /VARIABLE SEEK ROUTINE, RETURN COMMAND 1243 001400 3124 GREATR 1244 001401 4562 SEEKVR, JMS I SRTFUN /CHECK WHETHER OPERATOR, 0-9, 'F', OR WHAT 1245 001402 0254 FORCHR, 254 /, /TABLE FOR SET AND FOR COMMANDS 1246 001403 0275 275 /= 1247 001404 4564 JMS I ERROR /ONLY ALPHA VARIABLE NAMES ARE ALLOWED 1248 001405 3065 LOOKVR, DCA PUTSDE /SET UP FOR LEFT SIDE OF WORD 1249 001406 4544 JMS I ENCODE /PUT CHARACTER INTO BUFFER 1250 001407 4565 LOOKLP, JMS I GETCHR /GET CHARACTER 1251 001410 4546 JMS I CHECK /LOOK TO SEE IF IN TABLE 1252 001411 1777 TRMTAB-1 /OF ARITHMETIC TERMINATORS 1253 001412 5222 JMP GOTNAM /YES, VARIABLE NAME BUILT 1254 001413 2065 ISZ PUTSDE /SECOND CHARACTER? 1255 001414 5207 JMP LOOKLP /NO, IGNORE IT 1256 001415 1071 TAD CHAR /YES, GET CHARACTER 1257 001416 0001 AND C77 /TRIM TO 6-BIT 1258 001417 1064 TAD PUTWRK /MERGE IN LEFT HALF OF NAME 1259 001420 3064 DCA PUTWRK /STORE THE VARIABLE NAME 1260 001421 5207 JMP LOOKLP /GO IGNORE UNTIL TERMINATOR 1261 001422 4560 GOTNAM, JMS I PRNCHK /IS IT SUBSCRIPTED? 1262 001423 5233 JMP NOSUB /NO, SKIP CODE TO EVALUATE 1263 001424 1064 TAD PUTWRK /YES, GET VARIABLE NAME 1264 001425 3060 DCA ASKTYP /ARRANGE IT'S SALVATION 1265 001426 4651 JMS I SOLVE /EVALUATE SUBSCRIPT 1266 001427 1413 TAD I PDLPTR /GET SAVED VARIABLE NAME 1267 001430 3064 DCA PUTWRK /STORE IN WORK AREA 1268 001431 4650 JMS I UNPREN /CHECK FOR RIGHT PREN 1269 001432 4455 JMS I FIX /FIX FLOATING AC (SUBSCRIPT) 1270 001433 3347 NOSUB, DCA SPNOR /SAVE THE SUBSCRIPT (0 IF NONE) 1271 001434 1064 TAD PUTWRK /GET THE VARIABLE NAME 1272 001435 3431 DCA I VAREND /MAKE SURE WE WILL FIND IT 1273 001436 1063 TAD TXTEND /GET POINTER TO START OF VARIABLES 1274 001437 3030 VARSCH, DCA POINT1 /STORE AS POINTER 1275 001440 1430 TAD I POINT1 /GET A VARIABLE NAME 1276 001441 7041 CIA /NEGATE 1277 001442 1064 TAD PUTWRK /SUBTRACT FROM NAME SOUGHT 1278 001443 7650 SNA CLA /GOT RIGHT NAME? 1279 001444 5276 JMP FNDVAR /YES, GO CHECK SUBSCRIPT 1280 001445 1030 WRNGVR, TAD POINT1 /NO, GET POINTER 1281 001446 1073 TAD VARLEN /BUMP TO NEXT VARIABLE 1282 001447 5237 JMP VARSCH /AND TRY AGAIN 1283 001450 2066 UNPREN, CHKUNP /POINTER TO ROUTINE TO HANDLE RIGHT PREN 1284 001451 1600 SOLVE, SEGSLV /POINTER TO ROUTINE TO EVALUATE EXPRESSIONS IN PRENS 1285 001452 1031 MAKVAR, TAD VAREND /GET POINTER TO END OF VARIABLES 1286 001453 1000 TAD P13 /ADD SAFETY MARGIN 1287 001454 7141 CLL CIA /NEGATE 1288 001455 1013 TAD PDLPTR /SUBTRACT FROM STACK POINTER 1289 001456 7620 SNL CLA /OUT OF VARIABLE STORAGE? 1290 001457 4564 JMS I ERROR /YES, CALL ERROR ROUTINE 1291 001460 1031 TAD VAREND /NO, GET POINTER TO END OF VARIABLES 1292 001461 7001 IAC /ADD ONE TO POINT TO SUBSCRIPT 1293 001462 3030 DCA POINT1 /SET UP POINTER 1294 001463 1031 TAD VAREND /GET POINTER TO END OF VARIABLES 1295 001464 1073 TAD VARLEN /ADD ONE MORE VARIABLE 1296 001465 3031 DCA VAREND /STORE UPDATED POINTER 1297 001466 1347 SBCHNG, TAD SPNOR /GET SAVED SUBSCRIPT 1298 001467 3430 DCA I POINT1 /STORE IN NEW VARIABLE 1299 001470 2030 ISZ POINT1 /POINT TO VALUE 1300 001471 4407 JMS I FPP /ENTER FLOATING POINT MODE 1301 001472 0535 FGET I PZERO /GET A ZERO 1302 001473 6430 FPUT I POINT1 /STORE AS NEW VARIABLE'S VALUE 1303 001474 0000 FEXT /RETURN TO NORMAL MODE 1304 001475 5537 JMP I LINEND /DO RECURSIVE RETURN 1305 001476 1030 FNDVAR, TAD POINT1 /GET POINTER TO VARIABLE 1306 001477 2030 ISZ POINT1 /BUMP TO POINT AT SUBSCRIPT 1307 001500 7041 CIA /NEGATE 1308 001501 1031 TAD VAREND /COMPARE TO END OF VARIABLES 1309 001502 7650 SNA CLA /VARIABLE REALLY THERE? 1310 001503 5314 JMP ZVR /NO, GO TRY TO RENAME A ZERO 1311 001504 1430 TAD I POINT1 /GET SUBSCRIPT OF VARIABLE 1312 001505 7041 CIA /NEGATE 1313 001506 1347 TAD SPNOR /COMPARE WITH SUBSCRIPT SOUGHT 1314 001507 2030 ISZ POINT1 /POINT AT VALUE IN CASE IT IS NEEDED 1315 001510 7650 SNA CLA /GOT RIGHT SUBSCRIPT? 1316 001511 5537 JMP I LINEND /YES, DO RECURSIVE RETURN 1317 001512 7144 CLL CMA RAL /NO, GET -2 1318 001513 5245 JMP WRNGVR /GO LOOK AT NEXT VARIABLE 1319 001514 7125 ZVR, CLL CML IAC RAL /GET 3 1320 001515 1063 TAD TXTEND /POINT TO FIRST VARIABLE'S SIGN 1321 001516 3030 ZVRLP, DCA POINT1 /STORE POINTER 1322 001517 1030 TAD POINT1 /GET POINTER 1323 001520 7141 CLL CIA /NEGATE 1324 001521 1031 TAD VAREND /COMPARE TO END OF VARIABLES 1325 001522 7620 SNL CLA /FILLED IN ALL ZEROES? 1326 001523 5252 JMP MAKVAR /YES, GO CREATE A VARIABLE 1327 001524 1430 TAD I POINT1 /NO, GET SIGN OF VARIABLE 1328 001525 7650 SNA CLA /IS IT ZERO? 1329 001526 5332 JMP GOTZRO /YES, GO CHECK IF IT IS NORMALIZED 1330 001527 1030 ZVRNXT, TAD POINT1 /NO, GET POINTER 1331 001530 1073 TAD VARLEN /BUMP TO NEXT VARIABLE 1332 001531 5316 JMP ZVRLP /GO LOOK FOR ZERO 1333 001532 7240 GOTZRO, CLA CMA /GET -1 1334 001533 1030 TAD POINT1 /BACK UP TO EXPONENT 1335 001534 3030 DCA POINT1 /STORE POINTER 1336 001535 1430 TAD I POINT1 /GET EXPONENT 1337 001536 7440 SZA /NORMALIZED? 1338 001537 5327 JMP ZVRNXT /NO, DON'T REPLACE IT 1339 001540 7144 CLL CMA RAL /GET -2 1340 001541 1030 TAD POINT1 /BUILD POINTER TO NAME 1341 001542 3030 DCA POINT1 /STORE POINTER TO NAME 1342 001543 1064 TAD PUTWRK /GET NAME 1343 001544 3430 DCA I POINT1 /STORE NEW NAME 1344 001545 2030 ISZ POINT1 /POINT TO SUBSCRIPT 1345 001546 5266 JMP SBCHNG /GO CHANGE SUBSCRIPT 1346 001547 0000 SPNOR, .-. /SUBROUTINE TO IGNORE LEADING SPACES 1347 001550 1071 TAD CHAR /GET CHARACTER 1348 001551 1120 TAD N240 /SUBTRACT SPACE 1349 001552 7640 SZA CLA /IS IT A SPACE? 1350 001553 5747 JMP I SPNOR /NO, RETURN 1351 001554 4565 JMS I GETCHR /YES, GET NEXT CHARACTER 1352 001555 5350 JMP SPNOR+1 /AND CHECK IT 1353 001556 7520 N260, -260 /NEGATIVE ASCII ZERO 1354 001557 7507 N271, -271 /NEGATIVE ASCII NINE 1355 001560 0000 NUMSRT, .-. /DETERMINE WHETHER '.' 0-9, OR ALPHA 1356 001561 1071 TAD CHAR /GET CHARACTER 1357 001562 1121 TAD N256 /SUBTRACT PERIOD 1358 001563 7640 SZA CLA /IS IT '.'? 1359 001564 2360 ISZ NUMSRT /NO, SKIP AT LEAST ONE 1360 001565 1071 TAD CHAR /GET CHARACTER 1361 001566 1356 TAD N260 /SUBTRACT '0' 1362 001567 3056 DCA SORTWK /SAVE IN CASE OF DIGIT 1363 001570 1056 TAD SORTWK /GET IT BACK 1364 001571 7710 SPA CLA /COULD IT BE A DIGIT? 1365 001572 5760 JMP I NUMSRT /NO, RETURN 1366 001573 1071 TAD CHAR /GET CHARACTER 1367 001574 1357 TAD N271 /SUBTRACT '9' 1368 001575 7750 SNA SPA CLA /IS IT A DIGIT? 1369 001576 2360 ISZ NUMSRT /YES, SKIP TWICE 1370 001577 5760 JMP I NUMSRT /RETURN 1371 1372 *1600 /EQUATION SOLVER 1373 001600 0000 SEGSLV, .-. /ROUTINE TO EVALUATE EXPRESSION IN PRENS 1374 001601 1056 TAD SORTWK /GET CURRENT OPERATOR NUMBER, IF ANY 1375 001602 4540 JMS I PUSHA /PLACE ON STACK 1376 001603 1057 TAD OLDOPR /GET OLD OPERATOR, IF ANY 1377 001604 4540 JMS I PUSHA /PLACE ON STACK 1378 001605 1060 TAD ASKTYP /GET FUNCTION OR VARIABLE NAME, IF ANY 1379 001606 4540 JMS I PUSHA /PLACE ON STACK 1380 001607 1200 TAD SEGSLV /GET RETURN ADDRESS 1381 001610 4540 JMS I PUSHA /PLACE ON STACK 1382 001611 4565 JMS I GETCHR /GET NEXT CHARACTER 1383 001612 3057 EVAL, DCA OLDOPR /CLEAR OLD OPERATORLOCATION 1384 001613 4562 JMS I SRTFUN /CHECK WHETHER OPERATOR, 0-9, 'F', OR WHAT 1385 001614 5235 JMP FRSTOP /FIRST CHARACTER OF SEGMENT IS OPERATOR 1386 001615 5340 JMP NUMBER /INTERPRET NUMBER 1387 001616 5344 JMP FUNC /INTERPRET FUNCTION CALL 1388 001617 4536 VARBLE, JMS I PUSHJ /RECURSIVE CALL 1389 001620 1405 LOOKVR /TO LOOK UP VARIABLE 1390 001621 1037 TAD INSW /GET INPUT FROM TTY SWITCH 1391 001622 7650 SNA CLA /INPUT COMING FROM TTY? 1392 001623 5230 JMP LOOKOP /NO, GO LOOK FOR OPERATOR 1393 001624 1071 TAD CHAR /YES, GET CHARACTER 1394 001625 1120 TAD N240 /SUBTRACT SPACE 1395 001626 7650 SNA CLA /WAS IT A SPACE? 1396 001627 5256 JMP OPROK+1 /YES, TERMINATE EXPRESSION 1397 001630 4562 LOOKOP, JMS I SRTFUN /CHECK WHETHER OPERATOR, 0-9, 'F', OR WHAT 1398 001631 5252 JMP CHKOPR /ONLY OPERATORS ARE ALLOWED AFTER VARIABLE REFERENCES 1399 001632 5256 JMP OPROK+1 /TERMINATOR NOT OPERATOR, END OF SEGMENT 1400 001633 5256 JMP OPROK+1 /TERMINATOR NOT OPERATOR, END OF SEGMENT 1401 001634 5256 JMP OPROK+1 /TERNINATOR NOW OPERATOR, END OF SEGMENT 1402 001635 1135 FRSTOP, TAD PZERO /GET POINTER TO CONSTANT OF ZERO 1403 001636 3030 DCA POINT1 /DUMMY UP FIRST OPERAND 1404 001637 7344 CLA CLL CMA RAL /GET NEGATIVE TWO 1405 001640 1056 TAD SORTWK /ADD TO OPERATOR NUMBER 1406 001641 7450 SNA /UNARY MINUS SIGN? 1407 001642 5255 JMP OPROK /YES, ALLOW IT 1408 001643 7001 IAC /ADD ONE TO AC 1409 001644 7650 SNA CLA /UNARY PLUS SIGN? 1410 001645 5331 JMP OPRIGN /YES, IGNORE IT 1411 001646 1056 TAD SORTWK /GET OPERATOR NUMBER 1412 001647 1034 TAD N10 /SUBTRACT EIGHT 1413 001650 7710 SPA CLA /IS IT A SEGMENT DELIMITER? 1414 001651 5366 JMP LOOKPR /NO, BETTER BE LEFT PREN (bugbug confusing comments) 1415 001652 4560 CHKOPR, JMS I PRNCHK /YES, IS IT LEFT PREN (bugbug confusing comments) 1416 001653 7410 SKP /NO, OK 1417 001654 5256 JMP OPROK+1 /YES, MUST BE PART OF NEXT EXPRESSION 1418 001655 1056 OPROK, TAD SORTWK /GET OPERATOR NUMBER 1419 001656 3024 DCA NEWOPR /STORE AS NEW OPERATOR 1420 001657 1024 TAD NEWOPR /GET NEW OPERATOR 1421 001660 1034 TAD N10 /SUBTRACT EIGHT 1422 001661 7700 SMA CLA /SEGMENT TERMINATOR? 1423 001662 3024 DCA NEWOPR /YES, SET OPERATOR NUMBER (PRIORITY) TO ZERO 1424 001663 1024 CHKPRI, TAD NEWOPR /GET NEW OPERATOR PRIORITY 1425 001664 7041 CIA /NEGATE 1426 001665 1057 TAD OLDOPR /COMPARE TO OLD OPERATOR PRIORITY 1427 001666 7710 SPA CLA /WHICH HAS PRIORITY? 1428 001667 5316 JMP NEWHGH /NEW OPERATOR, GO STACK OLD ONE 1429 001670 1057 TAD OLDOPR /GET OLD OPERATOR PRIORITY 1430 001671 7112 CLL RTR /SHIFT TO CREATE 1431 001672 7012 RTR /FPP OPCODE 1432 001673 1337 NUNPRN, TAD CGETVL /MAKE FPP INSTRUCTION 1433 001674 3302 DCA FPPOPR /PREPARE TO EXECUTE IT 1434 001675 1057 TAD OLDOPR /GET OLD OPERATOR 1435 001676 7640 SZA CLA /BEGINNING OF EQUATION? 1436 001677 4542 JMS I POPF /NO, UNSTACK 1437 001700 0045 FACEXP /INTO FPP AC 1438 001701 4407 JMS I FPP /ENTER FLOATING POINT MODE 1439 001702 0000 FPPOPR, .-. /DO THE NEEDED OPERATION 1440 001703 6525 FPUT I PDUMMY /STORE THE RESULT 1441 001704 0000 FEXT /RETURN TO NORMAL MODE 1442 001705 1125 TAD PDUMMY /GET POINTER TO RESULT 1443 001706 3030 DCA POINT1 /SET UP FIRST OPERAND POINTER 1444 001707 1024 TAD NEWOPR /GET NEW OPERATOR 1445 001710 1057 TAD OLDOPR /ADD IN OLD OPERATOR 1446 001711 7650 SNA CLA /ALL DONE? 1447 001712 5537 JMP I LINEND /YES, RECURSIVE RETURN 1448 001713 1413 TAD I PDLPTR /NO, UNSTACK WAITING OPERATOR 1449 001714 3057 DCA OLDOPR /STORE AS OLDOPR 1450 001715 5263 JMP CHKPRI /AND GO CHECK PRIORITY 1451 001716 4560 NEWHGH, JMS I PRNCHK /LEFT PREN? 1452 001717 7410 SKP /NO, PUT OLD ON WAITING LIST 1453 001720 5273 JMP NUNPRN /YES, GO EVALUATE EXPRESSION IN PRENS 1454 001721 1057 TAD OLDOPR /GET OLD OPERATOR 1455 001722 4540 JMS I PUSHA /PUT ON STACK 1456 001723 1030 TAD POINT1 /GET POINTER TO PSEUDOVARIABLE 1457 001724 3326 DCA .+2 /SET UP FOR PUSH 1458 001725 4541 JMS I PUSHF /PUSH FLOATING POINT 1459 001726 0000 .-. /FROM PSEADOVARIABLE 1460 001727 1024 TAD NEWOPR /GET NEW OPERATOR 1461 001730 3057 DCA OLDOPR /MAKE IT OLD OPERATOR 1462 001731 4565 OPRIGN, JMS I GETCHR /GET CHARACTER FROM BUFFER 1463 001732 4562 JMS I SRTFUN /CHECK WHETHER OPERATOR, 0-9, 'F', OR WHAT 1464 001733 5366 JMP LOOKPR /OPERATOR, BETTER BE LEFT PREN 1465 001734 5340 JMP NUMBER /NUMBER FOLLOWS 1466 001735 5344 JMP FUNC /FUNCTION CALL FOLLOWS 1467 001736 5217 JMP VARBLE /VARIABLE NAME FOLLOWS 1468 001737 0430 CGETVL, FGET I POINT1 /FPP BITS NEEDED TO REFERENCE OPERAND 1469 001740 1125 NUMBER, TAD PDUMMY /GET POINTER TO PSEUDOVARIABLE 1470 001741 3030 DCA POINT1 /SET LOCATION FOR OPERAND 1471 001742 4530 JMS I FACIN /INTERPRET NUMBER 1472 001743 5221 JMP VARBLE+2 /PRETEND A VARIABLE WAS REFERENCED 1473 001744 3060 FUNC, DCA ASKTYP /INITIALIZE PARTIAL FUNCTION NAME 1474 001745 4565 JMS I GETCHR /GET A CHARACTER 1475 001746 4546 JMS I CHECK /CHECK WHETHER IT IS 1476 001747 1777 TRMTAB-1 /AN ARITHMETIC TERMINATOR 1477 001750 5355 JMP GOTFUN /YES, NAME HASH ASSEMBLED 1478 001751 1060 TAD ASKTYP /GET PARTIAL FUNCTION NAME 1479 001752 7104 CLL RAL /DOUBLE IT 1480 001753 1071 TAD CHAR /ADD THE NEW CHARACTER 1481 001754 5344 JMP FUNC /GO LOOK AT NEXT CHARACTER 1482 001755 4560 GOTFUN, JMS I PRNCHK /FUNCTION GOT AN ARGUMENT? 1483 001756 5374 JMP NOPARM /NO, GO TO SPECIAL HANDLER 1484 001757 4200 JMS SEGSLV /YES, EVALUATE IT 1485 001760 3040 DCA FARGSW /CLEAR 'NO ARGUMENT' SWITCH 1486 001761 1413 TAD I PDLPTR /GET FUNCTION HASH 1487 001762 4545 FUNCBR, JMS I TABSCH /DO LOOKUP AND GO 1488 001763 2377 FNCNMS-1 /AMONG FUNCTION HASHCODES 1489 001764 5761 FUNCGO-FNCNMS /GO TO FUNCTION, ELSE 1490 001765 4564 BADFUN, JMS I ERROR /INVALID FUNCTION, COMMAND, OR OPERATOR 1491 001766 4560 LOOKPR, JMS I PRNCHK /CHECK FOR LEFT PREN 1492 001767 4564 JMS I ERROR /DOUBLE OPERATOR, GO TO ERROR ROUTINE 1493 001770 4200 JMS SEGSLV /EVALUATE THE EXPRESSION IN THE PRENS 1494 001771 3040 DCA FARGSW /CLEAR 'NO ARGUMENT' SWITCH 1495 001772 2013 ISZ PDLPTR /POP DUMMY FUNCTION NAME 1496 001773 5534 JMP I FNCXIT /PRETEND RETURN FROM FUNCTION CALL 1497 001774 7240 NOPARM, CLA CMA /GET NEGATIVE ONE 1498 001775 3040 DCA FARGSW /SET 'NO ARGUMENT' SWITCH 1499 001776 1060 TAD ASKTYP /GET FUNCTION HASHCODE 1500 001777 5362 JMP FUNCBR /GO DO LOOKUP AND GO 1501 1502 *2000 /FSGN, FABS, RETURN PROCESSORS, DELETE, PREN ROUTINES 1503 002000 0240 TRMTAB, 240 /TABLE OF TERMINATORS AND OPERATORS IN EQUATIONS 1504 002001 0253 253 /+ 1505 002002 0255 255 /- 1506 002003 0257 257 // 1507 002004 0252 252 /* 1508 002005 0336 336 /^ 1509 002006 0250 250 /( 1510 002007 0333 333 /[ 1511 002010 0251 TYPCHR, 251 /) /CHARACTERS SPECIAL IN TYPE OR ASK 1512 002011 0335 335 /] 1513 002012 0245 245 /% 1514 002013 0247 247 /' 1515 002014 0242 242 /" 1516 002015 0241 241 /! 1517 002016 0243 243 /# 1518 002017 0272 272 /: 1519 002020 0274 274 /< 1520 002021 0275 275 /= 1521 002022 0276 276 /> 1522 002023 0240 TERTAB, 240 /SPACE 1523 002024 0254 254 /, 1524 002025 0273 273 /; 1525 002026 0215 215 /CR 1526 002027 4541 FSGN, JMS I PUSHF /PUSH 1527 002030 3043 DCA OPMED /FLOATING POINT ONE 1528 002031 4542 JMS I POPF /POP 1529 002032 0045 FACEXP /INTO FLOATING AC 1530 002033 1251 FABS, TAD DUMMY+1 /LOOK AT ARGUMENT SIGN 1531 002034 7710 SPA CLA /ARGUMENT POSITIVE? 1532 002035 4453 JMS I NEGATE /NO, NEGATE IT 1533 002036 2040 FNCDNE, ISZ FARGSW /WAS THERE AN ARGUMENT? 1534 002037 4266 JMS CHKUNP /YES, CHECK FOR RIGHT PREN 1535 002040 4566 JMS I PNORML /NORMALIZE THE RESULT 1536 002041 4407 JMS I FPP /ENTER FLOATING POINT MODE 1537 002042 6250 FPUT DUMMY /STORE RESULT IN PSEUDOVARIABLE 1538 002043 0000 FEXT /RETURN TO NORMAL MODE 1539 002044 1125 TAD PDUMMY /GET POINTER TO RESULT 1540 002045 3030 DCA POINT1 /STORE AS POINTER TO FIRST OPERAND 1541 002046 5647 JMP I .+1 /GO PRETEND A VARIABLE 1542 002047 1621 VARBLE+2 /WAS REFERENCED 1543 002050 0000 DUMMY, 0 /PSEUDOVARIABLE, HOLDS LEFT OPERAND 1544 002051 0000 0 1545 002052 0000 0 1546 002053 0000 0 1547 002054 0000 CHKPRN, .-. /ROUTINE TO CHECK FOR LEFT PREN 1548 002055 1056 TAD SORTWK /GET OPERATOR NUMBER 1549 002056 1034 TAD N10 /SUBTRACT EIGHT 1550 002057 7700 SMA CLA /COULD IT BE LEFT PREN 1551 002060 5654 JMP I CHKPRN /NO, TAKE ERROR RETURN 1552 002061 1056 TAD SORTWK /YES, GET OPERATOR NUMBER 1553 002062 1124 TAD N5 /SUBTRACT 5 1554 002063 7740 SZA SMA CLA /IS IT A LEFT PREN? 1555 002064 2254 ISZ CHKPRN /YES, TAKE SKIP RETURN 1556 002065 5654 JMP I CHKPRN /RETURN 1557 002066 0000 CHKUNP, .-. /ROUTINE TO CHECK FOR RIGHT PREN 1558 002067 1413 TAD I PDLPTR /GET OPERATOR FROM STACK 1559 002070 3057 DCA OLDOPR /SAVE AS OLD OPERATOR 1560 002071 7105 CLL IAC RAL /GET A TWO 1561 002072 1413 TAD I PDLPTR /ADD TO LEFT PREN NUMBER 1562 002073 7041 CIA /NEGATE 1563 002074 1056 TAD SORTWK /COMPARE TO RIGHT PREN NUMBER 1564 002075 7640 SZA CLA /PRENS MATCH? 1565 002076 4564 JMS I ERROR /NO, GO TO ERROR ROUTINE 1566 002077 4565 JMS I GETCHR /YES, SKIP OVER UNPREN 1567 002100 5666 JMP I CHKUNP /RETURN 1568 002101 0000 ERALIN, .-. /ROUTINE TO DELETE THE REQUESTED LINE 1569 002102 4553 JMS I FNDLIN /SEEK THE LINE 1570 002103 5701 JMP I ERALIN /LINE ALREADY GONE 1571 002104 2026 ISZ QUOTSW /SET QUOTE FLAG TO PREVENT TRACE 1572 002105 4543 JMS I DECODE /FETCH NEXT CHARACTER 1573 002106 1071 TAD CHAR /GET IT 1574 002107 1122 TAD NCR /SUBTRACT CARRIAGE RETURN 1575 002110 7640 SZA CLA /IS IT THE CARRIAGE RETURN? 1576 002111 5305 JMP .-4 /NO, KEEP LOOKING 1577 002112 1017 TAD GETPTR /YES, GET THE DECODE POINTER 1578 002113 7040 CMA /NEGATE AND SUBTRACT ONE 1579 002114 1023 TAD NEWPC /ADD POINTER TO LINE BEING DELETED 1580 002115 3062 DCA COUNTR /STORE COUNT OF WORDS TO GET RID OF 1581 002116 1132 TAD TXTBEG /GET BEGINNING OF TEXT 1582 002117 7041 CIA /NEGATE 1583 002120 1023 TAD NEWPC /FORM OFFSET OF LINE TO BE REMOVED 1584 002121 7650 SNA CLA /REMOVING HEADING LINE? 1585 002122 5177 JMP START /YES; ABORT 1586 002123 1423 TAD I NEWPC /NO, GET POINTER TO NEXT LINE 1587 002124 3425 DCA I OLDPC /UPDATE POINTER OF PREVIOUS LINE 1588 002125 1132 TAD TXTBEG /GET POINTER TO BEGINNING OF TEXT 1589 002126 3074 PTRUP, DCA WORK /SET UP WOK AREA POINTER 1590 002127 1474 TAD I WORK /GET LINK IN LINE NUMBER POINTER CHAIN 1591 002130 7450 SNA /REWORKED ALL POINTERS? 1592 002131 5344 JMP MOVTXT /YES, GO COMPRESS TEXT 1593 002132 3032 DCA SAVE1 /NO, SAVE THE LINK 1594 002133 1023 TAD NEWPC /GET THE BOUNDARY 1595 002134 7141 CLL CIA /NEGATE 1596 002135 1032 TAD SAVE1 /ADD THE LINK 1597 002136 7630 SZL CLA /LINE GOING TO MOVE? 1598 002137 1062 TAD COUNTR /YES, GET ADJUSTMENT VALUE 1599 002140 1032 TAD SAVE1 /ADD THE LINK 1600 002141 3474 DCA I WORK /UPDATE THE POINTER 1601 002142 1032 TAD SAVE1 /GET THE NEW POINTER 1602 002143 5326 JMP PTRUP /AND GO AGAIN 1603 002144 7040 MOVTXT, CMA /GET NEGATIVE ONE 1604 002145 1023 TAD NEWPC /ADD POINTER TO DELETED LINE 1605 002146 3011 DCA QCKPTR /SET UP 'TO' POINTER 1606 002147 1062 TAD COUNTR /GET NUMBER OF WORDS TO REMOVE 1607 002150 7040 CMA /MAKE IT POSITIVE 1608 002151 1023 TAD NEWPC /ADD TO FORM 'FROM' POINTER 1609 002152 3012 DCA WRKPTR /STORE 'FROM' POINTER 1610 002153 1062 TAD COUNTR /GET WORDS TO REMOVE (NEGATIVE) 1611 002154 1063 TAD TXTEND /ADD END OF TEXT POINTER 1612 002155 3063 DCA TXTEND /UPDATE END OF TEXT POINTER 1613 002156 1010 TAD PUTPTR /GET TEXT ENCODE POINTER 1614 002157 7040 CMA /NEGATE AND SUBTRACT ONE 1615 002160 1012 TAD WRKPTR /ADD IN 'FROM' POINTER 1616 002161 3032 DCA SAVE1 /SAVE COUNT OF WORDS TO MOVE 1617 002162 1010 TAD PUTPTR /GET TEXT ENCODE POINTER 1618 002163 1062 TAD COUNTR /SUBTRACT WORDS TO REMOVE 1619 002164 3010 DCA PUTPTR /STORE UPDATED VALUE 1620 002165 1412 TAD I WRKPTR /GET A WORD 1621 002166 3411 DCA I QCKPTR /MOVE IT TO NEW SPOT 1622 002167 2032 ISZ SAVE1 /DONE YET? 1623 002170 5365 JMP .-3 /NO, GO AGAIN 1624 002171 5302 JMP ERALIN+1 /YES, TRY DELETE AGAIN, JUST IN CASE 1625 002172 1135 RETURN, TAD PZERO /GET POINTER TO CONSTANT OF FP ZERO 1626 002173 3022 DCA PC /SET AS NEW POINTER TO START OF LINE 1627 002174 1413 ENDLIN, TAD I PDLPTR /GET ENTRY FROM STACK 1628 002175 3074 DCA WORK /PREPARE TO GO THERE 1629 002176 5474 JMP I WORK /GO THERE 1630 1631 *2200 /ERASE COMMAND, INPRT, FIND LINE, UNPACK ROUTINES 1632 002200 0000 INPRT, .-. /INPUT A CHARACTER AND ECHO (UNLESS LF OR RUBOUT) 1633 002201 4467 JMS I INCHAR /GET A CHARACTER 1634 002202 3071 DCA CHAR /SAVE IT 1635 002203 4546 JMS I CHECK /LOOK TO SEE IF IN TABLE 1636 002204 0775 NOECHO-1 /OF NOECHO CHARACTERS 1637 002205 5600 JMP I INPRT /YES, WE ARE DONE 1638 002206 4547 JMS I PRTCL /NO, ECHO IT 1639 002207 5600 JMP I INPRT /WE ARE DONE 1640 002210 4556 ERASE, JMS I KLSPCE /IGNORE SPACES 1641 002211 1071 TAD CHAR /GET CHARACTER 1642 002212 1116 TAD N301 /SUBTRACT 'A' 1643 002213 7640 SZA CLA /ERASE ALL? 1644 002214 5223 JMP ERA /NO, GO ERASE A LINE 1645 002215 1133 ERASEA, TAD BUFBEG /YES, GET BUFFER BEGINNING 1646 002216 3063 DCA TXTEND /SET AS BUFFER END 1647 002217 3532 DCA I TXTBEG /REMOVE LINE POINTER LIST 1648 002220 1063 ERADNE, TAD TXTEND /GET END OF PROGRAM 1649 002221 3031 DCA VAREND /ERASE THE VARIABLES 1650 002222 5177 JMP START /RESTART FOCAL 1651 002223 4552 ERA, JMS I GETARG /INTERPRET THE ARGUMENT 1652 002224 1063 TAD TXTEND /GET THE END OF TEXT 1653 002225 3010 DCA PUTPTR /STORE IN ENCODE POINTER 1654 002226 4563 JMS I DELETE /DELETE THE LINE, IF FOUND 1655 002227 2023 ISZ NEWPC /BUMP TO POINT AT NEXT LINE NUMBER 1656 002230 1070 TAD ARGSW /GET LINE NUMBER SWITCHES 1657 002231 7700 SMA CLA /GROUP ERASE? 1658 002232 1423 TAD I NEWPC /YES, GET NEW LINE NUMBER 1659 002233 4561 JMS I GRPTST /IN SAME GROUP? 1660 002234 5220 JMP ERADNE /NO, WE ARE DONE 1661 002235 1423 TAD I NEWPC /YES, GET NEW LINE NUMBER 1662 002236 3072 DCA LINENO /STORE AS LINE TO BE DELETED 1663 002237 5226 JMP ERA+3 /AND GO AGAIN 1664 002240 0000 LINFND, .-. /ROUTINE TO FIND REQUESTED LINE 1665 002241 1422 TAD I PC /GET POINTER WORD OF CURRENT LINE 1666 002242 7650 SNA CLA /AT END OF PROGRAM OR DUMMY LINE? 1667 002243 5255 JMP NEWCHN /YES, RESTART CHAIN 1668 002244 1022 TAD PC /NO, GET POINTER TO CURRENT LINE 1669 002245 3025 DCA OLDPC /STORE AS POINTER TO PREVIOUS LINE 1670 002246 1022 TAD PC /GET POINTER TO CURRENT LINE 1671 002247 3011 DCA QCKPTR /PREPARE TO GET LINE NUMBER 1672 002250 1072 TAD LINENO /GET LINE NUMBER SOUGHT 1673 002251 7141 CLL CIA /NEGATE 1674 002252 1411 TAD I QCKPTR /ADD CURRENT LINE NUMBER 1675 002253 7620 SNL CLA /NEED TO RESTART POINTER CHAIN? 1676 002254 5257 JMP .+3 /NO, SKIP STEPS TO RESET 1677 002255 1132 NEWCHN, TAD TXTBEG /GET BEGINNING OF POINTER CHAIN 1678 002256 3025 DCA OLDPC /SET AS POINTER TO PREVIOUS LINE 1679 002257 1025 TAD OLDPC /GET POINTER TO LINE 1680 002260 3023 FINDLP, DCA NEWPC /SET AS NEW LINE TO LOOK AT 1681 002261 1023 TAD NEWPC /GET LINE POINTER 1682 002262 3011 DCA QCKPTR /SET UP TO ADD LINE NUMBER 1683 002263 1072 TAD LINENO /GET LINE NUMBER SOUGHT 1684 002264 7141 CLL CIA /NEGATE 1685 002265 1411 TAD I QCKPTR /ADD CURRENT LINE NUMBER 1686 002266 7450 SNA /FOUND IT? 1687 002267 5300 JMP FNDXIT /YES, GO TAKE SKIP RETURN 1688 002270 7630 SZL CLA /NO, GONE PAST IT? 1689 002271 5301 JMP FNDXIT+1 /YES, GO WRAP UP 1690 002272 1023 TAD NEWPC /NO, GET NEW POINTER VALUE 1691 002273 3025 DCA OLDPC /SET AS OLD POINTER VALUE 1692 002274 1423 TAD I NEWPC /GET NEW POINTER VALUE 1693 002275 7440 SZA /OUT OF LINES? 1694 002276 5260 JMP FINDLP /NO, KEEP LOOKING 1695 002277 7410 SKP /YES, TAKE 'NOT FOUND' RETURN 1696 002300 2240 FNDXIT, ISZ LINFND /TAKE SKIP (FOUND) RETURN 1697 002301 1023 TAD NEWPC /GET LINE NUMBER POINTER 1698 002302 7001 IAC /POINT AT TEXT 1699 002303 3017 DCA GETPTR /SET UP DECODE POINTER 1700 002304 3020 DCA GETSDE /SET UP TO DECODE FROM LEFT 1701 002305 5640 JMP I LINFND /RETURN 1702 002306 0000 UNPACK, .-. /TEXT DECOMPRESSION ROUTINE 1703 002307 4353 JMS UNPCK1 /UNPACK NEXT HALFWORD 1704 002310 7440 SZA /CONTROL MARKER? 1705 002311 5315 JMP .+4 /NO, GOT 6-BIT CHARACTER 1706 002312 4353 JMS UNPCK1 /YES, GET NEXT 6-BIT 1707 002313 7040 CMA /COMPLEMENT 1708 002314 0001 AND C77 /MASK BACK TO CONTROL CHARACTER 1709 002315 1374 TAD N40 /SUBTRACT 40 1710 002316 7710 SPA CLA /NEED EXTRA 100? 1711 002317 1372 TAD C100 /YES, ADD IT NOW 1712 002320 1003 TAD C200 /SET MARK PARITY 1713 002321 1071 TAD CHAR /ADD CHARACTER 1714 002322 3071 DCA CHAR /STORE FULLY FORMED CHARACTER 1715 002323 1071 TAD CHAR /GET CHARACTER 1716 002324 1375 TAD N277 /SUBTRACT '?' 1717 002325 7650 SNA CLA /IS IT '?' 1718 002326 5343 JMP TRCSWP /YES, GO TOGGLE TRACE MODE 1719 002327 1026 TAD QUOTSW /NO, GET QUOTE FLAG 1720 002330 1103 TAD TRCESW /ADD IN TRACE FLAG 1721 002331 7650 SNA CLA /PRINT FOR TRACE MODE? 1722 002332 4547 JMS I PRTCL /YES, PRINT IT 1723 002333 6031 KSF /NO, CHECK FOR KEYBOARD INPUT 1724 002334 5706 JMP I UNPACK /NO INPUT, WE ARE DONE 1725 002335 6034 KRS /READ THE KEYBOARD 1726 002336 0002 AND C177 /STRIP PARITY, IF ANY 1727 002337 1373 TAD N3 /SUBTRACT THREE 1728 002340 7650 SNA CLA /IS IT CONTROL-C? 1729 002341 5177 JMP START /YES, RESTART FOCAL 1730 002342 5706 JMP I UNPACK /NO, JUST RETURN 1731 002343 1026 TRCSWP, TAD QUOTSW /GET THE QUOTE MODE 1732 002344 7640 SZA CLA /IN QUOTE MODE? 1733 002345 5706 JMP I UNPACK /YES, RETURN THE '?' 1734 002346 1103 TAD TRCESW /NO, GET THE TRACE FLAG 1735 002347 7650 SNA CLA /IN TRACE MODE? 1736 002350 7001 IAC /NO, SET TRACE MODE 1737 002351 3103 DCA TRCESW /STORE NEW TRACE MODE 1738 002352 5307 JMP UNPACK+1 /GO UNPACK AND RETURN A CHARACTER 1739 002353 0000 UNPCK1, .-. /ROUTINE TO UNPACK A HALFWORD 1740 002354 2020 ISZ GETSDE /WHICH SIDE? 1741 002355 5363 JMP LEFT /GO DO LEFT SIDE 1742 002356 1021 TAD GETWRK /RIGHT, GET WORD 1743 002357 0001 GOTHLF, AND C77 /MASK TO 6-BIT 1744 002360 3071 DCA CHAR /STORE IT 1745 002361 1071 TAD CHAR /GET IT BACK 1746 002362 5753 JMP I UNPCK1 /RETURN 1747 002363 1417 LEFT, TAD I GETPTR /GET A NEW WORD 1748 002364 3021 DCA GETWRK /SAVE FOR NOW 1749 002365 7040 CMA /GET -1 1750 002366 3020 DCA GETSDE /SET UP FOR RIGHT SIDE NEXT TIME 1751 002367 1021 TAD GETWRK /GET SAVED WORD 1752 002370 7002 BSW /REPOSITION LEFT SIDE BITS 1753 /bugbug: not family of eight 1754 002371 5357 JMP GOTHLF /GO WRAP UP 1755 002372 0100 C100, 100 /EXTRA 100 FOR ALPHA AND LOWERCASE 1756 002373 7775 N3, -3 /USED IN CONTROL-C CHECK 1757 002374 7740 N40, -40 /USEFUL CONSTANT FOR UNPACK 1758 002375 7501 N277, -277 /NEGATIVE ASCII QUESTION MARK 1759 002376 4455 FITR, JMS I FIX /TAKE INTEGER PART OF ARGUMENT 1760 002377 5534 JMP I FNCXIT /RETURN FROM FUNCTION CALL 1761 1762 *2400 /INPUT, OUTPUT, LINE NUMBER OUTPUT, PACK ROUTINES 1763 002400 2533 FNCNMS, "A^2+"B^2+"S /HASH CODE FUNCTION TABLE 1764 002401 2650 "S^2+"G^2+"N 1765 002402 2636 "I^2+"T^2+"R 1766 002403 1140 "I^2+"N 1767 002404 2630 "R^2+"A^2+"N 1768 002405 2672 "O^2+"U^2+"T 1769 002406 2712 "T^2+"S^2+"T 1770 002407 2604 "I^2+"N^2+"D 1771 002410 1153 "M^2+"Q 1772 002411 2572 "A^2+"T^2+"N 1773 002412 2624 "E^2+"X^2+"P 1774 002413 2625 "L^2+"O^2+"G 1775 002414 2575 "C^2+"O^2+"S 1776 002415 2654 "S^2+"I^2+"N 1777 002416 2702 "S^2+"Q^2+"T 1778 002417 7640 N140, -140 /NEGATIVE LOWER CASE AT SIGN WITHOUT PARITY 1779 002420 0000 IOFIN, .-. /INTERRUPT OFF KEYBOARD INPUT 1780 002421 6031 KSF /KEYBOARD READY? 1781 002422 5221 JMP .-1 /NO, WAIT FOR IT 1782 002423 6036 KRB /YES, READ IT 1783 002424 0002 AND C177 /STRIP PARITY, IF ANY 1784 002425 7450 SNA /IS IT NUL? 1785 002426 5221 JMP IOFIN+1 /YES, IGNORE IT 1786 002427 1003 TAD C200 /NO, SET MARK PARITY 1787 002430 5620 JMP I IOFIN /RETURN THE CHARACTER 1788 002431 0000 OUTARG, .-. /ROUTINE TO TYPE LINE NUMBERS, ERROR CODES 1789 002432 1072 TAD LINENO /GET NUMBER TO BE PRINTED 1790 002433 4555 JMS I ROT6 /ROTATE 'GROUP' NUMBER INTO PLACE 1791 002434 0001 AND C77 /MASK FOR JUST GROUP NUMBER 1792 002435 4246 JMS DCDGTS /OUTPUT AS TWO DIGIT NUMBER 1793 002436 1113 TAD DOT /GET A DOT 1794 002437 4547 JMS I PRTCL /PRINT IT 1795 002440 1072 TAD LINENO /GET THE LINE NUMBER 1796 002441 4246 JMS DCDGTS /OUTPUT THE FRACTION 1797 002442 1111 TAD C240 /GET A SPACE 1798 002443 3071 DCA CHAR /SAVE IT 1799 002444 4547 JMS I PRTCL /PRINT IT 1800 002445 5631 JMP I OUTARG /RETURN 1801 002446 0000 DCDGTS, .-. /PRINT AC5-11 AS TWO DIGITS 1802 002447 0002 AND C177 /MASK OUT CRUFT, IF ANY 1803 002450 3032 DCA SAVE1 /SAVE FOR A MOMENT 1804 002451 1117 TAD C260 /GET '0' 1805 002452 3033 DCA POWER /SAVE IT AS DIVIDE RESULT 1806 002453 5256 JMP .+3 /JUMP INTO DIVIDE ROUTINE 1807 002454 2033 ISZ POWER /INCREMENT RESULT 1808 002455 3032 DCA SAVE1 /UPDATE REMAINDER 1809 002456 1032 TAD SAVE1 /GET REMAINDER 1810 002457 1035 TAD N12 /SUBTRACT TEN 1811 002460 7500 SMA /TOO FAR? 1812 002461 5254 JMP .-5 /NO, GO AGAIN 1813 002462 7200 CLA /YES, CLEAR CRUFT 1814 002463 1033 TAD POWER /GET RESULT 1815 002464 4547 JMS I PRTCL /PRINT IT 1816 002465 1032 TAD SAVE1 /GET REMAINDER 1817 002466 1117 TAD C260 /CONVERT TO ASCII 1818 002467 4547 JMS I PRTCL /PRINT IT 1819 002470 5646 JMP I DCDGTS /RETURN 1820 002471 0000 TYPCHK, .-. /PRINT CHARACTER AND LF IF RETURN 1821 002472 7450 SNA /CHARACTER IN AC? 1822 002473 1071 TAD CHAR /NO, GET CHARACTER 1823 002474 1122 TAD NCR /SUBTRACT CARRIAGE RETURN 1824 002475 7450 SNA /IS IT CARRIAGE RETURN? 1825 002476 5302 JMP CRLF /YES, GO DEAL WITH IT 1826 002477 1102 TAD CR /NO, RESTORE CHARACTER 1827 002500 4466 JMS I TYP /PRINT IT 1828 002501 5671 JMP I TYPCHK /RETURN 1829 002502 1102 CRLF, TAD CR /GET CARRIAGE RETURN 1830 002503 4466 JMS I TYP /PRINT IT 1831 002504 1101 TAD LF /GET LF 1832 002505 5300 JMP .-5 /GO PRINT AND RETURN 1833 002506 0000 PACK, .-. /TEXT COMPRESSION ROUTINE 1834 002507 1071 TAD CHAR /GET THE CHARACTER 1835 002510 1355 TAD N377 /SUBTRACT RUBOUT 1836 002511 7650 SNA CLA /IS IT RUBOUT? 1837 002512 5756 JMP I RBT /YES, GO HANDLE IT 1838 002513 1071 TAD CHAR /NO, GET CHARACTER 1839 002514 0110 AND C140 /GET CASE BITS 1840 002515 7440 SZA /CONTROL CHARACTER? 1841 002516 1217 TAD N140 /NO, RESTORE CHARACTER 1842 002517 7650 SNA CLA /CONTROL CHARACTER? 1843 002520 4326 JMS PACK1 /YES, PACK 00 1844 002521 1071 TAD CHAR /GET CHARACTER 1845 002522 0001 AND C77 /MASK FOR 6-BIT 1846 002523 7440 SZA /IS IT NUL? 1847 002524 4326 JMS PACK1 /NO, PACK IT 1848 002525 5706 PCKXIT, JMP I PACK /RETURN 1849 002526 0000 PACK1, .-. /PACK A 6-BIT HALFWORD 1850 002527 2065 ISZ PUTSDE /WHICH SIDE? 1851 002530 7410 SKP /LEFT, DON'T ADD WORK AREA 1852 002531 1064 TAD PUTWRK /RIGHT, ADD PREVIOUS WORK 1853 002532 7002 BSW /SWAP SIDES 1854 /bugbug: not family of eight / 1855 002533 3064 DCA PUTWRK /STORE NEW WORK AREA 1856 002534 1065 TAD PUTSDE /GET SIDE FLAG (0 OR 1) 1857 002535 7041 CIA /NEGATE 1858 002536 3065 DCA PUTSDE /SET NEW SIDE FLAG 1859 002537 1065 TAD PUTSDE /GET SIDE FLAG 1860 002540 7640 SZA CLA /NEED TO STORE WORK? 1861 002541 5726 JMP I PACK1 /NO, RETURN 1862 002542 1064 TAD PUTWRK /YES, GET WORK 1863 002543 7002 BSW /SWAP SIDES 1864 /bugbug: not family of eight / 1865 002544 3410 DCA I PUTPTR /STORE IN BUFFER 1866 002545 3064 DCA PUTWRK /ERASE STALE WORK 1867 002546 1013 TAD PDLPTR /GET STACK POINTER 1868 002547 7141 CLL CIA /NEGATE 1869 002550 1000 TAD P13 /ADD SAFETY MARGIN 1870 002551 1010 TAD PUTPTR /ADD NEW ENCODE POINTER 1871 002552 7620 SNL CLA /OUT OF ROOM? 1872 002553 5726 JMP I PACK1 /NO, JUST RETURN 1873 002554 4564 JMS I ERROR /YES, CALL ERROR ROUTINE 1874 002555 7401 N377, -377 /NEGATIVE ASCII RUBOUT 1875 002556 2633 RBT, RBOUT /ADDRESS OF RUBOUT HANDLER 1876 002557 0000 LINNEW, .-. /ROUTINE TO ENTER NEW LINE IN POINTER CHAIN 1877 002560 1425 TAD I OLDPC /GET POINTER TO LINE AFTER US 1878 002561 3463 DCA I TXTEND /STORE IN THE NEW LINE 1879 002562 1063 TAD TXTEND /GET POINTER TO NEW LINE 1880 002563 3425 DCA I OLDPC /STORE AS NEXT IN THIS LINE 1881 002564 1064 TAD PUTWRK /GET ENCODE WORK AREA 1882 002565 7440 SZA /IS IT EMPTY? 1883 002566 3410 DCA I PUTPTR /NO, STORE IT NOW 1884 002567 1010 TAD PUTPTR /GET ENCODE POINTER 1885 002570 7001 IAC /INCREMENT 1886 002571 3063 DCA TXTEND /SAVE AS NEW TEXT END 1887 002572 1063 TAD TXTEND /GET NEW TEXT END 1888 002573 3031 DCA VAREND /STORE AS END OF VARIABLES 1889 002574 5757 JMP I LINNEW /RETURN 1890 002575 2174 UNQTGO, ENDLIN /TABLE OF POINTERS FOR UNQUOTES IN ASK/TYPE 1891 002576 1254 QUOTE 1892 002577 1254 QUOTE 1893 1894 *2600 /ERROR MESSAGE, RUBOUT, AND TYPE $ PROCESSORS 1895 002600 2612 ASKGO, CNTRLC /BRANCH TABLE FOR ASK COMMAND 1896 002601 3031 CHRGET+1 1897 002602 3031 CHRGET+1 1898 002603 3031 CHRGET+1 1899 002604 1233 ALTMDE 1900 002605 1224 ASKOVR 1901 002606 0000 OOPS, .-. /ERROR MESSAGE HANDLER 1902 002607 7240 CLA CMA /GET NEGATIVE ONE 1903 002610 1206 TAD OOPS /FORM CALLER'S ADDRESS 1904 002611 7410 SKP /USE IT AS ERROR CODE 1905 002612 1003 CNTRLC, TAD C200 /GET 01.00 1906 002613 3072 DCA LINENO /SAVE ERROR CODE 1907 002614 1114 TAD QUEST /GET A QUESTION MARK 1908 002615 4547 JMS I PRTCL /PRINT IT 1909 002616 4551 JMS I ARGOUT /OUTPUT THE ERROR CODE 1910 002617 2022 ISZ PC /BUMP POINTER TO POINT AT LINE NUMBER 1911 002620 1422 TAD I PC /GET LINE NUMBER, IF ANY 1912 002621 7450 SNA /GOT A LINE NUMBER? 1913 002622 5230 JMP DIRERR /NO, ERROR IN DIRECT COMMAND 1914 002623 3072 DCA LINENO /SAVE IT FOR OUTPUT 1915 002624 1105 TAD N100 /GET AN AT SIGN 1916 002625 4547 JMS I PRTCL /OUTPUT IT 1917 002626 4547 JMS I PRTCL /PRINT A SPACE 1918 002627 4551 JMS I ARGOUT /PRINT THE LINE NUMBER 1919 002630 1102 DIRERR, TAD CR /GET A CARRIAGE RETURN 1920 002631 4547 JMS I PRTCL /PRINT IT 1921 002632 5177 JMP START /RESTART FOCAL 1922 002633 1065 RBOUT, TAD PUTSDE /GET RIGHT/LEFT INDICATOR 1923 002634 7640 SZA CLA /RIGHT OR LEFT? 1924 002635 5243 JMP DELOK /LEFT, OK TO DELETE 1925 002636 1010 TAD PUTPTR /RIGHT, GET ENCODE POINTER 1926 002637 7041 CIA /NEGATE 1927 002640 1027 TAD PUTBEG /COMPARE TO THE BEGINNING 1928 002641 7700 SMA CLA /ANYTHING TO DELETE? 1929 002642 5666 JMP I DELXIT /NO, IGNORE THE RUBOUT 1930 002643 1275 DELOK, TAD SHIFTL /GET A BACKSLASH 1931 002644 4547 JMS I PRTCL /PRINT IT 1932 002645 1010 TAD PUTPTR /GET ENCODE POINTER 1933 002646 3074 DCA WORK /STORE IN WORK AREA 1934 002647 2065 ISZ PUTSDE /WHICH SIDE? 1935 002650 5267 JMP DLRGHT /GO DO RIGHT SIDE DELETION 1936 002651 1474 TAD I WORK /GET ENCODED VALUE 1937 002652 0001 AND C77 /LOSE THE LEFT SIDE 1938 002653 7640 SZA CLA /CONTROL MARKER? 1939 002654 5263 JMP LEFTDL /YES, GO DELETE IT TOO 1940 002655 7040 CMA /GET NEGATIVE ONE 1941 002656 3065 CLOBBR, DCA PUTSDE /SET UP NEW SIDE 1942 002657 7040 CMA /GET NEGATIVE ONE 1943 002660 1010 TAD PUTPTR /BACK UP ENCODE POINTER 1944 002661 3010 DCA PUTPTR /STORE NEW ENCODE POINTER 1945 002662 1474 TAD I WORK /GET LAST WORD ENCODED 1946 002663 0105 LEFTDL, AND N100 /MASK OUT THE RIGHT SIDE 1947 002664 3064 DCA PUTWRK /SAVE AS WORK AREA 1948 002665 5666 JMP I DELXIT /DELETION FINISHED 1949 002666 2525 DELXIT, PCKXIT /POINTER TO ENCODE ROUTINE EXIT 1950 002667 1474 DLRGHT, TAD I WORK /GET LAST WORD ENCODED 1951 002670 0105 AND N100 /MASK OUT THE RIGHT SIDE 1952 002671 7640 SZA CLA /CONTROL MARKER? 1953 002672 5255 JMP CLOBBR-1 /NO, GO WRAP UP 1954 002673 3474 DCA I WORK /YES, CLEAR THE WORD 1955 002674 5256 JMP CLOBBR /AND WRAP UP 1956 002675 0334 SHIFTL, 334 /ASCII BACKSLASH 1957 002676 1063 VARBLS, TAD TXTEND /GET POINTER TO VARIABLE START 1958 002677 3030 DCA POINT1 /SET UP POINTER 1959 002700 1031 TAD VAREND /GET VARIABLE END POINTER 1960 002701 7041 CIA /NEGATE 1961 002702 1030 TAD POINT1 /ADD POINTER 1962 002703 7650 SNA CLA /REACHED END OF VARIABLES? 1963 002704 5537 JMP I LINEND /YES, WE ARE DONE 1964 002705 1430 TAD I POINT1 /NO, GET THE VARIABLE NAME 1965 002706 3765 DCA I NAMPT /STORE IT FOR OUTPUT 1966 002707 7240 CLA CMA /GET NEGATIVE ONE 1967 002710 1365 TAD NAMPT /ADD NAME POINTER 1968 002711 3017 DCA GETPTR /SET UP DECODE POINTER 1969 002712 3020 DCA GETSDE /SET UP FOR LEFT SIDE 1970 002713 4543 JMS I DECODE /GET A CHARACTER 1971 002714 4547 JMS I PRTCL /PRINT IT 1972 002715 1021 TAD GETWRK /LOOK AT DECODE WORK AREA 1973 002716 0001 AND C77 /MASK FOR RIGHT SIDE 1974 002717 1105 TAD N100 /CONVERT TO UPPERCASE 1975 002720 4466 JMS I TYP /PRINT IT 1976 002721 3020 DCA GETSDE /SET UP FOR LEFT SIDE 1977 002722 4543 JMS I DECODE /DECODE THE LEFT PREN 1978 002723 4547 JMS I PRTCL /PRINT IT 1979 002724 1054 TAD FORM /GET FORMAT WORD 1980 002725 4540 JMS I PUSHA /SAVE ON STACK 1981 002726 1364 TAD C1000 /GET NEW FORMAT WORD (%5.00) 1982 002727 3054 DCA FORM /SET FORMAT 1983 002730 2030 ISZ POINT1 /BUMP POINTER 1984 002731 1430 TAD I POINT1 /GET VARIABLE'S SUBSCRIPT 1985 002732 3046 DCA FACHGH /SET HIGH FAC 1986 002733 3047 DCA FACMED /CLEAR MED FAC 1987 002734 3050 DCA FACLOW /CLEAR LOW FAC 1988 002735 1000 TAD P13 /GET PROPER EXPONENT 1989 002736 3045 DCA FACEXP /SET PROPER EXPONENT 1990 002737 4566 JMS I PNORML /NORMALIZE 1991 002740 4527 JMS I TYPFAC /PRINT IT 1992 002741 1413 TAD I PDLPTR /GET SAVED PRINT FORMAT 1993 002742 3054 DCA FORM /RESTORE PRINT FORMAT 1994 002743 1111 TAD C240 /GET A SPACE 1995 002744 4466 JMS I TYP /PRINT THE SPACE 1996 002745 4543 JMS I DECODE /GET THE RIGHT PREN 1997 002746 4547 JMS I PRTCL /AND PRINT IT 1998 002747 4543 JMS I DECODE /GET EQUAL SIGN 1999 002750 4547 JMS I PRTCL /PRINT IT 2000 002751 2030 ISZ POINT1 /POINT TO VALUE 2001 002752 4407 JMS I FPP /ENTER FLOATING POINT MODE 2002 002753 0430 FGET I POINT1 /GET THE VARIABLE'S VALUE 2003 002754 0000 FEXT /RETURN TO NORMAL MODE 2004 002755 4527 JMS I TYPFAC /PRINT THE VARIABLE'S VALUE 2005 002756 1102 TAD CR /GET CARRIAGE RETURN 2006 002757 4547 JMS I PRTCL /PRINT CR-LF 2007 002760 1073 TAD VARLEN /GET LENGTH OF VARIABLE 2008 002761 1115 TAD N2 /OFFSET BY NEGATIVE TWO 2009 002762 1030 TAD POINT1 /ADJUST POINTER FOR NEXT VARIABLE 2010 002763 5277 JMP VARBLS+1 /AND GO AGAIN 2011 002764 1000 C1000, 1000 /%5, USED TO PRINT SUBSCRIPTS 2012 002765 3436 NAMPT, VARNAM /POINTER TO VARNAM 2013 002766 1125 FORGO2, FORSTP /SECOND BRANCH TABLE FOR FOR COMMAND 2014 002767 1002 STEP1 2015 002770 1765 BADFUN 2016 002771 3077 MODTAB, MODFLP /BRANCH TABLE FOR MODIFY COMMAND 2017 002772 3074 GETSCH 2018 002773 2612 CNTRLC 2019 002774 3106 MODSCR 2020 002775 3075 GETSCH+1 2021 002776 0317 MODPTR, MOVELP+1 2022 002777 3116 MODFND 2023 2024 *3000 /MODIFY, RELATIONAL IF STATEMENT, FMQ, FIN, FTST, FOUT 2025 003000 7501 FMQ, MQA /READ MQ CONTENTS 2026 003001 3074 DCA WORK /SAVE THEM 2027 003002 1040 TAD FARGSW /GET ARGUMENT SWITCH 2028 003003 7640 SZA CLA /IS THERE AN ARGUMENT? 2029 003004 5207 JMP .+3 /NO, PROCEED 2030 003005 4455 JMS I FIX /YES, GET IT'S INTEGER VALUE 2031 003006 7421 MQL /AND LOAD IT INTO MQ 2032 003007 1074 TAD WORK /GET RETURN VALUE 2033 003010 7410 SKP /GO FLOAT AND RETURN IT 2034 003011 4467 FIN, JMS I INCHAR /GET AN INPUT CHARACTER 2035 003012 3046 DCA FACHGH /STORE HIGH FAC 2036 003013 3047 DCA FACMED /CLEAR MED FAC 2037 003014 3050 DCA FACLOW /CLEAR LOW FAC 2038 003015 1000 TAD P13 /GET PROPER EXPONENT 2039 003016 3045 DCA FACEXP /SET FAC EXPONENT 2040 003017 5534 JMP I FNCXIT /GO NORMALIZE AND RETURN 2041 003020 1003 FTST, TAD C200 /SET MARK PARITY IN CASE MISSING 2042 003021 6031 KSF /IS KEYBOARD READY? 2043 003022 7240 CLA CMA /NO, JUST RETURN NEGATIVE ONE 2044 003023 6034 KRS /YES, 'OR' IN CHARACTER 2045 003024 5212 JMP FIN+1 /GO RETURN RESULT 2046 003025 4455 FOUT, JMS I FIX /GET THE VALUE AS INTEGER 2047 003026 4466 JMS I TYP /PRINT IT ON THE TTY 2048 003027 5534 JMP I FNCXIT /GO RETURN FROM FUNCTION 2049 003030 0000 CHRGET, .-. /ROUTINE TO GET CHARACTER FROM TTY OR BUFFER 2050 003031 1037 TAD INSW /GET INPUT SOURCE 2051 003032 7640 SZA CLA /IS IT TTY? 2052 003033 5236 JMP .+3 /YES, GO DO THAT 2053 003034 4543 JMS I DECODE /NO, GET CHARACTER FROM BUFFER 2054 003035 5630 JMP I CHRGET /AND RETURN IT 2055 003036 4550 JMS I INPUT /GET CHARACTER FROM TTY 2056 003037 4545 JMS I TABSCH /DO LOOKUP AND GO 2057 003040 6770 ASKCHR-1 /AMONG CHARACTERS SPECIAL 2058 003041 3607 ASKGO-ASKCHR /FOR TTY INPUT 2059 003042 5630 JMP I CHRGET /NOT SPECIAL, RETURN IT 2060 003043 0001 ONE, 1 /FLOATING POINT ONE 2061 003044 2000 2000 2062 003045 0000 ZERO, 0 /FLOATING POINT ZERO 2063 003046 0000 0 2064 003047 0000 0 2065 003050 4552 MODIFY, JMS I GETARG /INTERPRET ARGUMENT 2066 003051 4541 JMS I PUSHF /PUSH 2067 003052 0070 ARGSW /LINE NUMBER INFO 2068 003053 1072 TAD LINENO /GET LINE NUMBER 2069 003054 3074 DCA WORK /STORE AS NEW LINE NUMBER 2070 003055 4574 JMS I PCOMMA /WAS THERE A COMMA? 2071 003056 5261 JMP SAMENO /NO, NOT MOVING 2072 003057 4552 JMS I GETARG /YES, GET NEW LINE NUMBER 2073 003060 5253 JMP .-5 /GO SET UP AS NEW LINE NUMBER 2074 003061 4542 SAMENO, JMS I POPF /POP 2075 003062 0070 ARGSW /LINE NUMBER INFO 2076 003063 4553 JMS I FNDLIN /FIND THE LINE 2077 003064 4564 JMS I ERROR /NO SUCH LINE 2078 003065 1063 TAD TXTEND /GET END OF TEXT 2079 003066 3010 DCA PUTPTR /SET TO ENCODE THERE 2080 003067 3065 DCA PUTSDE /ON THE LEFT SIDE 2081 003070 1074 TAD WORK /GET THE NEW LINE NUMBER 2082 003071 3410 DCA I PUTPTR /STORE IT IN BUFFER 2083 003072 1010 TAD PUTPTR /GET ENCODE POINTER 2084 003073 3027 DCA PUTBEG /SET AS BEGINNING OF LINE 2085 003074 4467 GETSCH, JMS I INCHAR /GET SEARCH CHARACTER FROM TTY 2086 003075 3103 DCA TRCESW /STORE SEARCH CHARACTER 2087 003076 2026 ISZ QUOTSW /SET QUOTE MODE TO PREVENT TRACE 2088 003077 4543 MODFLP, JMS I DECODE /DECODE A CHARACTER 2089 003100 4547 JMS I PRTCL /PRINT IT 2090 003101 4545 JMS I TABSCH /DO LOOKUP AND GO 2091 003102 0101 CR-1 /FOR SEARCH CHAR OR LINE TERMINATOR 2092 003103 2674 MODPTR-CR /GO TO FOUND IT ROUTINE, OTHERWISE 2093 003104 4544 JMS I ENCODE /COPY CHARACTER TO OUTPUT LINE 2094 003105 5277 JMP MODFLP /AND KEEP LOOKING 2095 003106 1063 MODSCR, TAD TXTEND /GET POINTER TO END OF TEXT 2096 003107 7001 IAC /ADD ONE TO SKIP LINE NUMBER AND POINTER 2097 003110 3010 DCA PUTPTR /SET UP ENCODE POINTER 2098 003111 3065 DCA PUTSDE /TO ENCODE ON THE LEFT 2099 003112 4550 JMS I INPUT /GET INPUT FROM KEYBOARD 2100 003113 4545 JMS I TABSCH /LOOKUP AND GO 2101 003114 0074 MODIFC-1 /FOR CHARACTERS USED IN MODIFY 2102 003115 2674 MODTAB-MODIFC /GO TO CORRECT ROUTINE, ELSE 2103 003116 4544 MODFND, JMS I ENCODE /ENCODE THE NEW TEXT 2104 003117 5312 JMP .-5 /AND GO AGAIN 2105 003120 1372 LESS, TAD KSMA /GET SKIP-IF-LESS 2106 003121 5325 JMP .+4 /GO PROCESS RELATIONAL OPERATOR 2107 003122 1373 EQUAL, TAD KSZA /GET SKIP-IF-ZERO 2108 003123 7410 SKP /GO PROCESS RELATIONAL OPERATOR 2109 003124 1374 GREATR, TAD KSPA /GET SKIP-IF-GREATER 2110 003125 4540 JMS I PUSHA /PUSH THE NEEDED SKIP INSTRUCTION 2111 003126 4541 JMS I PUSHF /PUSH 2112 003127 0045 FACEXP /THE LEFT OPERAND 2113 003130 4536 JMS I PUSHJ /RECURSIVE CALL 2114 003131 3163 RELCHK /TO RELOP HANDLER 2115 003132 4542 JMS I POPF /POP TO 2116 003133 0045 FACEXP /RESTORE LEFT OPERAND 2117 003134 4407 JMS I FPP /ENTER FLOATING POINT MODE 2118 003135 2525 FSUB I PDUMMY /SUBTRACT RIGHT OPERAND 2119 003136 0000 FEXT /RETURN TO NORMAL MODE 2120 003137 1413 TAD I PDLPTR /GET SKIP-IF-TRUE 2121 003140 3342 DCA .+2 /GET READY TO USE IT 2122 003141 1046 TAD FACHGH /GET HIGH FAC (SIGN) 2123 003142 0000 .-. /RELATIONAL OPERATOR TRUE? 2124 003143 5537 JMP I LINEND /NO, END THE LINE 2125 003144 4541 JMS I PUSHF /YES, PUSH 2126 003145 2050 DUMMY /THE RIGHT OPERAND 2127 003146 4541 JMS I PUSHF /PUSH 2128 003147 0017 GETPTR /DECODE INFO 2129 003150 1071 TAD CHAR /GET THE CHARACTER 2130 003151 4540 JMS I PUSHA /PUSH IT 2131 003152 4536 JMS I PUSHJ /RECURSIVE CALL 2132 003153 0632 EXEC /EXECUTE REST OF LINE 2133 003154 1413 TAD I PDLPTR /GET THE STACKED CHARACTER 2134 003155 3071 DCA CHAR /RESTORE IT 2135 003156 4542 JMS I POPF /POP 2136 003157 0017 GETPTR /DECODE INFO 2137 003160 4542 JMS I POPF /POP 2138 003161 2050 DUMMY /RIGHT OPERAND 2139 003162 5537 JMP I LINEND /PROCESS REST OF RELATIONAL OPERATORS 2140 003163 4543 RELCHK, JMS I DECODE /DECODE A CHARACTER 2141 003164 4545 JMS I TABSCH /LOOKUP AND GO 2142 003165 3335 RELOPR-1 /AMONG RELATIONAL OPERATORS 2143 003166 6040 RELOGO-RELOPR /SECOND RELATIONAL OPERATOR? 2144 003167 4536 JMS I PUSHJ /NO, CALL TO 2145 003170 1612 EVAL /EVALUATE RIGHT OPERAND 2146 003171 5537 JMP I LINEND /AND START THE RETURN SEQUENCE 2147 003172 7700 KSMA, SMA CLA /SKIP-IF-LESS-THAN 2148 003173 7640 KSZA, SZA CLA /SKIP-IF-EQUAL 2149 003174 7750 KSPA, SPA SNA CLA /SKIP-IF-GREATER-THAN 2150 003175 1060 FORGO, INDXLK /BRANCH TABLE FOR MULTIPLE INDEX SET AND FOR 2151 003176 1076 SET 2152 003177 1115 FORGO1, FOR /FIRST BRANCH TABLE FOR FOR COMMAND 2153 2154 *3200 /ZERO, HEADING, XECUTE COMMANDS, NEW FRAN, FIND FUNCTIONS 2155 003200 0631 EXEC-1 2156 003201 2174 ENDLIN 2157 003202 0000 COMMAC, .-. /ROUTINE TO SKIP IF CHARACTER IS A COMMA 2158 003203 1071 TAD CHAR /GET CHARACTER 2159 003204 1212 TAD MCOMMA /SUBTRACT COMMA 2160 003205 7640 SZA CLA /GOT A COMMA? 2161 003206 5602 JMP I COMMAC /NO, JUST RETURN 2162 003207 2202 ISZ COMMAC /YES, SET FOR SKIP RETURN 2163 003210 4543 JMS I DECODE /IGNORE THE COMMA 2164 003211 5602 JMP I COMMAC /DO SKIP RETURN 2165 003212 7524 MCOMMA, -254 /NEGATIVE ASCII COMMA 2166 003213 0000 NOZVR, .-. /ROUTINE TO DISABLE ZVR FOR A VARIABLE 2167 003214 1030 TAD POINT1 /GET POINTER TO VARIABLE 2168 003215 3011 DCA QCKPTR /SET POINTER INTO VARIABLE 2169 003216 1411 TAD I QCKPTR /GET SIGN OF VARIABLE 2170 003217 7640 SZA CLA /IS IT ZERO? 2171 003220 5613 JMP I NOZVR /NO, WE ARE DONE 2172 003221 7201 CLA IAC /YES, GET A ONE 2173 003222 3430 DCA I POINT1 /AND SET EXPONENT TO DENORMALIZE 2174 003223 5613 JMP I NOZVR /RETURN 2175 003224 4546 ZEROVR, JMS I CHECK /GOT AN ARGUMENT? 2176 003225 2023 TERTAB /TERMINATOR MEANS NO 2177 003226 5240 JMP ZERALL /NO ARGUMENT, MUST BE ZERO ALL 2178 003227 4536 ZERLP, JMS I PUSHJ /RECURSIVE CALL 2179 003230 1401 SEEKVR /LOOK UP THE VARIABLE 2180 003231 4407 JMS I FPP /ENTER FLOATING POINT MODE 2181 003232 0535 FGET I PZERO /GET FLOATING POINT ZERO 2182 003233 6430 FPUT I POINT1 /STORE IN THE VARIABLE 2183 003234 0000 FEXT /RETURN TO NORMAL MODE 2184 003235 4574 JMS I PCOMMA /CHECK FOR A COMMA 2185 003236 5576 JMP I PEXEC /NONE, RESUME COMMAND INTERPRETER 2186 003237 5227 JMP ZERLP /GO ZERO ANOTHER 2187 003240 1063 ZERALL, TAD TXTEND /GET END OF TEXT 2188 003241 3031 DCA VAREND /SET AS END OF VARIABLES 2189 003242 5766 JMP I PKLEAR /GO EXECUTE MORE COMMANDS WITH CLEAR STACK 2190 003243 4546 XEQLP, JMS I CHECK /LOOK AT TERMINATOR 2191 003244 2000 TRMTAB /TO SEE IF IT SHOULD BE IGNORED 2192 003245 4543 JMS I DECODE /YES, IGNORE IT 2193 003246 4536 XECUTE, JMS I PUSHJ /RECURSIVE CALL 2194 003247 1612 EVAL /EQUATION SOLVER 2195 003250 4546 JMS I CHECK /CHECK TERMINATOR 2196 003251 2024 TERTAB+1 /FOR SEMICOLON OR CR 2197 003252 5576 JMP I PEXEC /FOUND, GO TO COMMAND INTERPRETER 2198 003253 5243 JMP XEQLP /NOT FOUND, EVALUATE ANOTHER EXPRESSION 2199 003254 4556 HELLO, JMS I KLSPCE /IGNORE SPACES 2200 003255 1132 TAD TXTBEG /GET BEGINNING OF TEXT 2201 003256 7001 IAC /SKIP LINE NUMBER (00.00) 2202 003257 3010 DCA PUTPTR /SET UP ENCODE POINTER 2203 003260 3065 DCA PUTSDE /SET TO ENCODE ON THE LEFT 2204 003261 7410 SKP /FIRST CHARACTER ALREADY DECODED 2205 003262 4543 HEADLP, JMS I DECODE /DECODE NEXT CHARACTER 2206 003263 4544 JMS I ENCODE /ENCODE IT 2207 003264 1071 TAD CHAR /GET THE CHARACTER 2208 003265 1122 TAD NCR /SUBTRACT CARRIAGE RETURN 2209 003266 7640 SZA CLA /WAS IT A CR? 2210 003267 5262 JMP HEADLP /NO, KEEP GOING 2211 003270 2065 ISZ PUTSDE /YES, CHARACTER HALF ENCODED? 2212 003271 5274 JMP .+3 /NO, KEEP GOING 2213 003272 1064 TAD PUTWRK /YES, GET HALF-ENCODING 2214 003273 3410 DCA I PUTPTR /STORE IT 2215 003274 1010 TAD PUTPTR /GET ENCODE POINTER 2216 003275 7001 IAC /ADD ONE 2217 003276 3133 DCA BUFBEG /SET AS NEW BEGINNING OF BUFFER 2218 003277 1303 TAD C2004 /GET %8.04 2219 003300 3054 DCA FORM /SET FP OUTPUT FORMAT 2220 003301 5702 JMP I PERASE /GO DO ERASE ALL 2221 003302 2215 PERASE, ERASEA /POINTER TO ERASE COMMAND HANDLER 2222 003303 2004 C2004, 2004 /%8.04, TO RESET TYPE FORMAT 2223 003304 4541 FRAN, JMS I PUSHF /STACK 2224 003305 3333 RANDOM /SEED 2225 003306 4542 JMS I POPF /UNSTACK 2226 003307 0045 FACEXP /AS RESULT (R) 2227 003310 4541 JMS I PUSHF /STACK 2228 003311 3333 RANDOM /SEED 2229 003312 4542 JMS I POPF /UNSTACK 2230 003313 0042 OPEXP+1 /AS RIGHT OPERAND 2231 003314 4526 JMS I DOUBLE /SEED=SEED*2^13 2232 003315 4526 JMS I DOUBLE /*2^14 2233 003316 4526 JMS I DOUBLE /*2^15 2234 003317 4526 JMS I DOUBLE /*2^16 2235 003320 4572 JMS I PSUM /FORM R*(2^16+1) 2236 003321 4526 JMS I DOUBLE /FORM R*(2^17+2) 2237 003322 4572 JMS I PSUM /FORM R*(2^17+3) 2238 003323 4541 JMS I PUSHF /STACK 2239 003324 0046 FACHGH /RESULT 2240 003325 4542 JMS I POPF /UNSTACK 2241 003326 3333 RANDOM /AS NEW SEED 2242 003327 3050 DCA FACLOW /TRUNCATE TO TWO WORDS 2243 003330 3045 DCA FACEXP /FORCE INTO RANGE 0..1 2244 003331 4567 JMS I PABS /TAKE ABSOLUTE VALUE 2245 003332 5534 JMP I FNCXIT /RETURN FROM FUNCTION CALL 2246 003333 4421 RANDOM, 4421 /RANDOM SEED 2247 003334 3040 3040 2248 003335 0001 1 2249 003336 0274 RELOPR, 274 /< /TABLE OF RELATIONAL OPERATORS 2250 003337 0275 275 /= 2251 003340 0276 276 /> 2252 003341 4455 FIND, JMS I FIX /TAKE INTEGER PART OF ARGUMENT 2253 003342 7041 CIA /NEGATE 2254 003343 3074 DCA WORK /SAVE FOR SEARCH 2255 003344 4467 FINDL, JMS I INCHAR /GET A CHARACTER 2256 003345 1074 TAD WORK /SUBTRACT THE ONE WE ARE LOOKING FOR 2257 003346 7450 SNA /wAS THIS IT? 2258 003347 5534 JMP I FNCXIT /YES, RETURN 2259 003350 7041 CIA /NO, NEGATE DIFFERENCE 2260 003351 1074 TAD WORK /RESTORE CHAR WITH WRONG SIGN 2261 003352 7041 CIA /RESTORE CHARACTER 2262 003353 4466 JMS I TYP /ECHO IT 2263 003354 5344 JMP FINDL /GO KEEP LOOKING 2264 003355 1056 COMGO, SETFOR /ADDRESS OF SET/FOR COMMAND PROCESSOR 2265 003356 1056 SETFOR /ADDRESS OF SET/FOR COMMAND PROCESSOR 2266 003357 1005 IF /ADDRESS OF IF COMMAND PROCESSOR 2267 003360 0445 DO /ADDRESS OF DO COMMAND PROCESSOR 2268 003361 0624 GO /ADDRESS OF GO COMMAND PROCESSOR 2269 003362 2174 ENDLIN /ADDRESS OF COMMENT COMMAND PROCESSOR 2270 003363 1201 ASK /ADDRESS OF ASK COMMAND PROCESSOR 2271 003364 1202 TYPE /ADDRESS OF TYPE COMMAND PROCESSOR 2272 003365 3254 HELLO /ADDRESS OF HELLO COMMAND PROCESSOR 2273 003366 0274 PKLEAR, KLEAR /ADDRESS OF KLEAR COMMAND PROCESSOR 2274 003367 6072 LOCS /ADDRESS OF LOCATIONS COMMAND PROCESSOR 2275 003370 2210 ERASE /ADDRESS OF ERASE COMMAND PROCESSOR 2276 003371 0655 WRITE /ADDRESS OF WRITE COMMAND PROCESSOR 2277 003372 3050 MODIFY /ADDRESS OF MODIFY COMMAND PROCESSOR 2278 003373 1007 BRANCH /ADDRESS OF BRANCH COMMAND PROCESSOR 2279 003374 0177 START /ADDRESS OF QUIT COMMAND PROCESSOR 2280 003375 2172 RETURN /ADDRESS OF RETURN COMMAND PROCESSOR 2281 003376 2676 VARBLS /ADDRESS OF VARIABLE COMMAND PROCESSOR 2282 003377 3246 XECUTE /ADDRESS OF XECUTE COMMAND PROCESSOR 2283 2284 *3400 /SHIFT FAC ONE LEFT, OUTPUT DIGIT ROUTINES 2285 003400 3224 ZEROVR /ADDRESS OF ZERO COMMAND PROCESSOR 2286 003401 0000 FACLFT, .-. /ROUTINE TO SHIFT FAC LEFT (DOUBLE FAC) 2287 003402 1050 TAD FACLOW /GET LOW WORD 2288 003403 7104 CLL RAL /SHIFT LEFT, WITH CARRY-OUT 2289 003404 3050 DCA FACLOW /SET LOW WORD 2290 003405 1047 TAD FACMED /GET MED WORD 2291 003406 7004 RAL /SHIFT LEFT, WITH CARRY 2292 003407 3047 DCA FACMED /SET MED WORD 2293 003410 1046 TAD FACHGH /GET HIGH WORD 2294 003411 7004 RAL /SHIFT LEFT, WITH CARRY 2295 003412 3046 DCA FACHGH /SET HIGH WORD 2296 003413 1051 TAD FACOVR /GET OVERFLOW WORD 2297 003414 7004 RAL /GET CARRY-IN 2298 003415 3051 DCA FACOVR /SAVE IT 2299 003416 5601 JMP I FACLFT /RETURN 2300 003417 0000 OUTDIG, .-. /ROUTINE TO OUTPUT A DIGIT 2301 003420 1117 TAD C260 /CONVERT TO ASCII 2302 003421 3074 DCA WORK /SAVE IT 2303 003422 2033 ISZ POWER /DID POWER JUST BECOME ZERO? 2304 003423 5226 JMP .+3 /NO, NO '.' NEEDED 2305 003424 1113 TAD DOT /YES, GET A DOT 2306 003425 4466 JMS I TYP /AND PRINT IT 2307 003426 1074 TAD WORK /GET THE DIGIT 2308 003427 4547 JMS I PRTCL /PRINT IT 2309 003430 7144 CLL CMA RAL /GET NEGATIVE TWO 2310 003431 1033 TAD POWER /COMPUTE NEW POWER 2311 003432 3033 DCA POWER /STORE NEW POWER 2312 003433 2045 ISZ FACEXP /ADJUST DIGIT COUNT 2313 003434 2217 ISZ OUTDIG /NO DONE, TAKE THE SKIP RETURN 2314 003435 5617 JMP I OUTDIG /RETURN 2315 003436 0000 VARNAM, .-. /HOLD AREA FOR VARIABLE NAME 2316 003437 5051 TEXT "()=" /TEXT USED BY 'VARIABLES' COMMAND 003440 7500 2317 003441 1765 TYPGO, BADFUN /BRANCH TABLE FOR ASK AND TYPE COMMANDS 2318 003442 1765 BADFUN 2319 003443 1261 FORMAT 2320 003444 1245 QUOTES 2321 003445 1245 QUOTES 2322 003446 1273 EXCLAM 2323 003447 1270 NUMSGN 2324 003450 1277 TAB 2325 003451 1765 BADFUN 2326 003452 1765 BADFUN 2327 003453 1266 TYPELF 2328 003454 1275 TYPIGN 2329 003455 1275 TYPIGN 2330 003456 0631 EXEC-1 2331 003457 2174 ENDLIN 2332 SCRBUF=.-1 /TEMPORARY LINE BUFFER GOES HERE 2333 2334 *SCRBUF+46 /TEXT BUFFER (HEADING LINE AND USER PROGRAM) 2335 003525 3531 TEXTST, L01V10 2336 003526 0000 0 2337 003527 0015 TEXT "@M" 003530 0000 2338 STTEXT=.-1 2339 003531 3577 L01V10, L01V20 2340 003532 0212 0212 2341 /TEXT "TYPE!!'WELCOME TO FOCAL 1976.'!!;SET B,NO=6;DO 1.4;FOR I,YES=3,6;DO 3@M" 2342 /bugbug: questions 1,2,3 need to get asked, and their functions written 2343 003533 2431 TEXT "TYPE!!'WELCOME TO FOCAL 1976.'!!;SET B,NO=6;DO 1.4;FOR I,YES=4,6;DO 3@M" 003534 2005 003535 4141 003536 4727 003537 0514 003540 0317 003541 1505 003542 4024 003543 1740 003544 0617 003545 0301 003546 1440 003547 6171 003550 6766 003551 5647 003552 4141 003553 7323 003554 0524 003555 4002 003556 5416 003557 1775 003560 6673 003561 0417 003562 4061 003563 5664 003564 7306 003565 1722 003566 4011 003567 5431 003570 0523 003571 7564 003572 5466 003573 7304 003574 1740 003575 6300 003576 1500 2344 003577 3606 L01V20, L01V30 2345 003600 0224 0224 2346 003601 2205 TEXT "RETURN@M" 003602 2425 003603 2216 003604 0015 003605 0000 2347 003606 3644 L01V30, L01V40 2348 003607 0236 0236 2349 003610 2431 TEXT "TYPE!%4B' WORDS AVAILABLE FOR USER PROGRAMS'!!;HELLO@M" 003611 2005 003612 4145 003613 6402 003614 4740 003615 2717 003616 2204 003617 2340 003620 0126 003621 0111 003622 1401 003623 0214 003624 0540 003625 0617 003626 2240 003627 2523 003630 0522 003631 4020 003632 2217 003633 0722 003634 0115 003635 2347 003636 4141 003637 7310 003640 0514 003641 1417 003642 0015 003643 0000 2350 003644 3662 L01V40, L02V10 2351 003645 0250 0250 2352 003646 2431 TEXT "TYPE'WILL YOU NEED:'!@M" 003647 2005 003650 4727 003651 1114 003652 1440 003653 3117 003654 2540 003655 1605 003656 0504 003657 7247 003660 4100 003661 1500 2353 003662 3672 L02V10, L02V20 2354 003663 0412 0412 2355 003664 2431 TEXT "TYPE'ATN@M" 003665 2005 003666 4701 003667 2416 003670 0015 003671 0000 2356 003672 3702 L02V20, L02V30 2357 003673 0424 0424 2358 003674 2431 TEXT "TYPE'EXP@M" 003675 2005 003676 4705 003677 3020 003700 0015 003701 0000 2359 003702 3712 L02V30, L02V40 2360 003703 0436 0436 2361 003704 2431 TEXT "TYPE'LOG@M" 003705 2005 003706 4714 003707 1707 003710 0015 003711 0000 2362 003712 3722 L02V40, L02V50 2363 003713 0450 0450 2364 003714 2431 TEXT "TYPE'COS@M" 003715 2005 003716 4703 003717 1723 003720 0015 003721 0000 2365 003722 3732 L02V50, L02V60 2366 003723 0462 0462 2367 003724 2431 TEXT "TYPE'SIN@M" 003725 2005 003726 4723 003727 1116 003730 0015 003731 0000 2368 003732 3742 L02V60, L03V10 2369 003733 0474 0474 2370 003734 2431 TEXT "TYPE'SQT@M" 003735 2005 003736 4723 003737 2124 003740 0015 003741 0000 2371 003742 4003 L03V10, L03V20 2372 003743 0612 0612 2373 003744 2431 TEXT "TYPE'F';DO 2+I/10;ASK'?'R;IF R=YES SET B=I-1;SET I=6;RETURN@M" 003745 2005 003746 4706 003747 4773 003750 0417 003751 4062 003752 5311 003753 5761 003754 6073 003755 0123 003756 1347 003757 7747 003760 2273 003761 1106 003762 4022 003763 7531 003764 0523 003765 4023 003766 0524 003767 4002 003770 7511 003771 5561 003772 7323 003773 0524 003774 4011 003775 7566 003776 7322 003777 0524 004000 2522 004001 1600 004002 1500 2374 004003 4016 L03V20, L03V30 2375 004004 0624 0624 2376 004005 1106 TEXT "IF R=NO RETURN@M" 004006 4022 004007 7516 004010 1740 004011 2205 004012 2425 004013 2216 004014 0015 004015 0000 2377 004016 0000 L03V30, 0 2378 004017 0636 0636 2379 004020 2447 TEXT "T'PLEASE ANSWER YES OR NO.'!;DO 1.4;GOTO 3.1@M" 004021 2014 004022 0501 004023 2305 004024 4001 004025 1623 004026 2705 004027 2240 004030 3105 004031 2340 004032 1722 004033 4016 004034 1756 004035 4741 004036 7304 004037 1740 004040 6156 004041 6473 004042 0717 004043 2417 004044 4063 004045 5661 004046 0015 004047 0000 2380 FREEBF=.-1 2381 2382 *4200 /DIALOG CONTROL PROGRAM 2383 004200 6046 INTRO, TLS /START TELETYPE PRINTER 2384 004201 1200 TAD INTRO /GET THAT TLS 2385 004202 3403 DCA I C200 /DO THAT INSTEAD OF COMING HERE NEXT RESTART 2386 004203 4536 JMS I PUSHJ /RECURSIVE CALL 2387 004204 0445 DO /PERFORM A 'DO' COMMAND 2388 004205 1003 TAD C200 /GET SIXBIT 'B' 2389 004206 3064 DCA PUTWRK /STASH AS VARIABLE NAME 2390 004207 4536 JMS I PUSHJ /RECURSIVE CALL 2391 004210 1433 NOSUB /GO LOOK UP B(0) 2392 004211 4407 JMS I FPP /ENTER FLOATING POINT MODE 2393 004212 0430 FGET I POINT1 /GET THE VALUE OF B(0) 2394 004213 0000 FEXT /RETURN TO NORMAL MODE 2395 004214 1251 TAD PFUNTB /GET POINTER TO DELETABLE FUNCTIONS 2396 004215 3012 DCA WRKPTR /INITIALIZE POINTER 2397 004216 4455 JMS I FIX /GET INTEGER PART 2398 004217 7450 SNA /NEED TO DELETE ANYTHING? 2399 004220 5227 JMP FNCGNE /NO, SKIP FUNCTION REMOVAL 2400 004221 7041 CIA /NEGATE THE COUNT 2401 004222 3062 DCA COUNTR /SET UP COUNTER 2402 004223 1250 TAD PBADFN /GET POINTER TO ERROR CALL 2403 004224 3412 DCA I WRKPTR /REMOVE POINTER TO FUNCTION 2404 004225 2062 ISZ COUNTR /DONE THEM ALL? 2405 004226 5223 JMP .-3 /NO, DO ANOTHER 2406 004227 7240 FNCGNE, CLA CMA /GET NEGATIVE ONE 2407 004230 1412 TAD I WRKPTR /POINT TO NEW END OF BUFFER 2408 004231 3036 DCA BOTTMP /SET NEW END OF BUFFER 2409 004232 1133 TAD BUFBEG /GET BEGINNING OF BUFFER 2410 004233 7041 CIA /NEGATE 2411 004234 1036 TAD BOTTMP /FORM COUNT OF WORDS AVAILABLE 2412 004235 3046 DCA FACHGH /SET HIGH FAC 2413 004236 3047 DCA FACMED /CLEAR MED FAC 2414 004237 3050 DCA FACLOW /CLEAR LOW FAC 2415 004240 1000 TAD P13 /GET THE EXPONENT 2416 004241 3045 DCA FACEXP /SET THE EXPONENT 2417 004242 4566 JMS I PNORML /NORMALIZE 2418 004243 4407 JMS I FPP /ENTER FLOATING POINT MODE 2419 004244 6430 FPUT I POINT1 /STORE IN B(0) 2420 004245 0000 FEXT /RETURN TO NORMAL MODE 2421 004246 5647 JMP I .+1 /RESUME THE DIALOG 2422 004247 0631 EXEC-1 /POINTER TO COMMAND INTERPRETER 2423 004250 1765 PBADFN, BADFUN /POINTER TO 'ILLEGAL FUNCTION' 2424 004251 0371 PFUNTB, DELFUN-1 /POINTER TO DELETABLE FUNCTION TABLE 2425 2426 / 2427 /HEREAFTER BEGIN THE DELETABLE FUNCTIONS. THE FOCAL PROGRAM BUFFER 2428 /WILL OCCUPY THE SPACE FROM 'TEXTST' ABOVE TO ONE WORD BELOW THE 2429 /FIRST FUNCTION WHICH WAS *NOT* DELETED. 2430 / 2431 /bugbug: Currently DELFUN has NULL pointers for FATN, FEXP, and FLOG. 2432 /Correspondingly, the dialog has been modified to always delete them. 2433 /The first function that is optionally deletable, then, is FCOS. 2434 / 2435 /bugbug: Routines that are deletable also are generally currently poorly 2436 /tested and susceptible to approximation errors due to poor numerical 2437 /analysis. 2438 / 2439 2440 ifdef listing < 2441 *5537 2442 BOTTOM=.-1 2443 /FATN code should be inserted here. 2444 /FEXP code should be inserted here. 2445 /FLOG code exists (likely broken), and should be inserted here. 2446 LOGTB=5556 2447 > 2448 ifndef listing < 2449 *5635 2450 BOTTOM=.-1 2451 > 2452 005635 4453 FCOS, JMS I NEGATE /NEGATE THE ARGUMENT 2453 005636 4407 JMS I FPP /ENTER FLOATING POINT MODE 2454 005637 1361 FADD HALFPI /SUBTRACT FROM PI/2 2455 005640 0000 FEXT /RETURN TO NORMAL MODE 2456 005641 2040 FSIN, ISZ FARGSW /IS THERE AN ARGUMENT? 2457 005642 7410 SKP /YES, GOOD 2458 005643 4564 JMS I ERROR /NO, SIN OR COS WITHOUT AN ARGUMENT 2459 005644 1046 TAD FACHGH /GET HIGH FAC 2460 005645 7700 SMA CLA /NEGATIVE? 2461 005646 5251 JMP SINPOS /NO, ALL SET 2462 005647 4453 JMS I NEGATE /YES, MAKE IT POSITIVE 2463 005650 7240 CLA CMA /BUT REMEMBER THAT WE DID 2464 005651 3040 SINPOS, DCA FARGSW /REMEMBER SIGN OF ARGUMENT 2465 005652 4407 JMS I FPP /ENTER FLOATING POINT MODE 2466 005653 6525 FPUT I PDUMMY /STORE THE ARGUMENT IN THE PSEUDOVARIABLE 2467 005654 3355 FDIV PI /DIVIE BY PI 2468 005655 0000 FEXT /RETURN TO NORMAL MODE 2469 005656 4455 JMS I FIX /TAKE INTEGER PART 2470 005657 7010 RAR /DIVIDE BY TWO (INT(ARG/(2*PI))) 2471 005660 7620 SNL CLA /TOP HALF UNIT CIRCLE? 2472 005661 5265 JMP .+4 /YES, ONWARD 2473 005662 1040 TAD FARGSW /NO, GET ARGUMENT SIGN 2474 005663 7040 CMA /COMPLEMENT 2475 005664 3040 DCA FARGSW /UPDATE REMEMBERED SIGN 2476 005665 4566 JMS I PNORML /NORMALIZE 2477 005666 4453 JMS I NEGATE /NEGATE 2478 005667 4407 JMS I FPP /ENTER FLOATING POINT MODE 2479 005670 4355 FMPY PI /MULTIPLY BY PI 2480 005671 1525 FADD I PDUMMY /FORM X MOD PI 2481 005672 6525 FPUT I PDUMMY /SAVE IT 2482 005673 2361 FSUB HALFPI /SUBTRACT PI/2 2483 005674 0000 FEXT /RETURN TO NORMAL MODE 2484 005675 1046 TAD FACHGH /LOOK AT HIGH FAC 2485 005676 7710 SPA CLA /NEGATIVE? 2486 005677 5305 JMP SINE /YES, PROCEED 2487 005700 4407 JMS I FPP /NO, ENTER FLOATING POINT MODE 2488 005701 0355 FGET PI /GET PI 2489 005702 2525 FSUB I PDUMMY /SUBTRACT X MOD PI 2490 005703 6525 FPUT I PDUMMY /SAVE IT 2491 005704 0000 FEXT /RETURN TO NORMAL MODE 2492 005705 4407 SINE, JMS I FPP /ENTER FLOATING POINT MODE 2493 005706 0525 FGET I PDUMMY /GET ALIGNED ARGUMENT 2494 005707 3361 FDIV HALFPI /DIVIDE BY PI/2 2495 005710 6525 FPUT I PDUMMY /STORE IT 2496 005711 4525 FMPY I PDUMMY /SQUARE IT 2497 005712 6347 FPUT XX /STORE FOR A MOMENT 2498 005713 0535 FGET I PZERO /GET ZERO 2499 005714 6352 FPUT FNCANS /STORE AS PARTIAL SUM 2500 005715 0525 FGET I PDUMMY /GET SQUARED ARGUMENT 2501 005716 0000 FEXT /RETURN TO NORMAL MODE 2502 005717 1124 TAD N5 /GET NEGATIVE FIVE 2503 005720 3074 DCA WORK /SET UP TERM COUNTER 2504 005721 1360 TAD PSINTB /GET POINTER TO HALFPI 2505 005722 3030 SINLP, DCA POINT1 /SET UP TERM POINTER 2506 005723 4407 JMS I FPP /ENTER FLOATING POINT MODE 2507 005724 4430 FMPY I POINT1 /MULTIPLY BY TERM 2508 005725 1352 FADD FNCANS /ADD ANSWER 2509 005726 6352 FPUT FNCANS /SET NEW PARTIAL SUM 2510 005727 0525 FGET I PDUMMY /GET X^N TERM 2511 005730 4347 FMPY XX /FORM NEXT X^N 2512 005731 6525 FPUT I PDUMMY /PUT IT BACK 2513 005732 0000 FEXT /RETURN TO NORMAL MODE 2514 005733 7125 CLL CML IAC RAL /GET A THREE 2515 005734 1030 TAD POINT1 /BUMP POINTER 2516 005735 2074 ISZ WORK /DONE ENOUGH TERMS? 2517 005736 5322 JMP SINLP /NO, GO AGAIN 2518 005737 4407 JMS I FPP /ENTER FLOATING POINT MODE 2519 005740 0352 FGET FNCANS /GET PARTIAL SUM FOR RETURN 2520 005741 0000 FEXT /RETURN TO NORMAL MODE 2521 005742 4570 JMS I PUNABS /ADJUST SIGN OF RESULT 2522 005743 2040 ISZ FARGSW /NEED TO NEGATE AGAIN? 2523 005744 5534 JMP I FNCXIT /NO, RETURN RESULT 2524 005745 4453 JMS I NEGATE /YES, NEGATE IT 2525 005746 5534 JMP I FNCXIT /RETURN RESULT 2526 005747 0000 XX, .-. /HOLD AREA FOR X^2 2527 005750 0000 .-. 2528 005751 0000 .-. 2529 005752 0000 FNCANS, .-. /HOLD ARE FOR RESULTS 2530 005753 0000 .-. 2531 005754 0000 .-. 2532 005755 0002 PI, 2 /CONSTANT OF PI 2533 005756 3110 3110 2534 005757 3755 3755/3756 /bugbug 2535 005760 5761 PSINTB, .+1 /TABLE OF CONSTANTS FOR SIN, COS 2536 005761 0001 HALFPI, 1 /FIVE FP CONSTANTS NEEDED FOR SIN, COS SERIES TERMS 2537 005762 3110 3110 2538 005763 3755 3755/3756 /bugbug 2539 005764 0000 0000 2540 005765 5325 5325 2541 005766 0420 0420 2542 005767 7775 7775 2543 005770 2431 2431 2544 005771 5053 5053 2545 005772 7771 7771 2546 005773 5466 5466 2547 005774 6317 6317/6306 2548 005775 7764 7764 2549 005776 2366 2366 2550 005777 5735 5735/5736 2551 2552 *6000 /FSQT, DECIMAL INPUT AIDS, LOCATIONS COMMAND 2553 006000 4407 FSQT, JMS I FPP /ENTER FLOATING POINT MODE 2554 006001 6267 FPUT N /STORE N 2555 006002 0000 FEXT /RETURN TO NORMAL MODE 2556 006003 1046 TAD FACHGH /GET HIGH FAC 2557 006004 7450 SNA /ZERO? 2558 006005 5534 JMP I FNCXIT /YES, WE ARE DONE 2559 006006 7710 SPA CLA /POSITIVE? 2560 006007 4564 JMS I ERROR /NO, REQUESTED SQUARE ROOT OF NEGATIVE NUMBER 2561 006010 1045 TAD FACEXP /YES, GET EXPONENT 2562 006011 7510 SPA /POSITIVE? 2563 006012 7020 CML /NO, SIGN EXTEND 2564 006013 7010 RAR /DIVIDE BY TWO 2565 006014 3263 DCA SAVEXP /STORE EXPONENT OF GUESS 2566 006015 7430 SZL /NEED ROUNDING? 2567 006016 2263 ISZ SAVEXP /YES, ROUND IT 2568 006017 7000 NOP /IN CASE OF OVERFLOW 2569 006020 1262 TAD C3015 /GET GOOD FIRST GUESS 2570 006021 3264 DCA SAVHGH /SET HIGH FAC 2571 006022 3265 DCA SAVMED /CLEAR MED FAC 2572 006023 3266 DCA SAVLOW /SAVE LOW FAC 2573 006024 4407 SQTLP, JMS I FPP /ENTER FLOATING POINT MODE 2574 006025 0267 FGET N /GET N 2575 006026 3263 FDIV SAVEXP /DIVIDE BY GUESS 2576 006027 1263 FADD SAVEXP /ADD GUESS 2577 006030 0000 FEXT /RETURN TO NORMAL MODE 2578 006031 7240 CLA CMA /GET NEGATIVE ONE 2579 006032 1045 TAD FACEXP /FORM DECREMENTED EXPONENT 2580 006033 3045 DCA FACEXP /STORE AS EXPONENT 2581 006034 1045 TAD FACEXP /GET EXPONENT 2582 006035 7041 CIA /NEGATE 2583 006036 1263 TAD SAVEXP /ADD TO GUESS EXPONENT 2584 006037 7640 SZA CLA /EQUAL? 2585 006040 5256 JMP SQTMRE /NO, SET UP TO LOOP AGAIN 2586 006041 1046 TAD FACHGH /YESM GET HIGH FAC 2587 006042 7041 CIA /NEGATE 2588 006043 1264 TAD SAVHGH /ADD HIGH GUESS 2589 006044 7640 SZA CLA /EQUAL? 2590 006045 5256 JMP SQTMRE /NO, SET UP TO LOOP AGAIN 2591 006046 1047 TAD FACMED /YES, GET MED FAC 2592 006047 7041 CIA /NEGATE 2593 006050 1265 TAD SAVMED /ADD MED GUESS 2594 006051 7500 SMA /DIFFERENCE NEGATIVE? 2595 006052 7041 CIA /NO, MAKE IT NEGATIVE 2596 006053 7001 IAC /INCREMENT 2597 006054 7700 SMA CLA /WITHIN ONE EITHER WAY? 2598 006055 5534 JMP I FNCXIT /YES, WE ARE DONE 2599 006056 4407 SQTMRE, JMS I FPP /ENTER FLOATING POINT MODE 2600 006057 6263 FPUT SAVEXP /SET NEW GUESS 2601 006060 0000 FEXT /RETURN TO NORMAL MODE 2602 006061 5224 JMP SQTLP /AND TRY AGAIN 2603 006062 3015 C3015, 3015 2604 006063 0000 SAVEXP, .-. /FLOATING POINT SAVE AREA 2605 006064 0000 SAVHGH, .-. 2606 006065 0000 SAVMED, .-. 2607 006066 0000 SAVLOW, .-. 2608 006067 0000 N, .-. /ARGUMENT HOLD AREA FOR FSQT 2609 006070 0000 NHGH, .-. 2610 006071 0000 NLOW, .-. 2611 006072 1132 LOCS, TAD TXTBEG /GET POINTER TO START OF TEXT 2612 006073 4312 JMS OCTOUT /PRINT IT 2613 006074 1063 TAD TXTEND /GET POINTER TO END OF TEXT 2614 006075 4312 JMS OCTOUT /PRINT IT 2615 006076 1031 TAD VAREND /GET POINTER TO END OF VARIABLES 2616 006077 4312 JMS OCTOUT /PRINT IT 2617 006100 1036 TAD BOTTMP /GET LAST FREE ADDRESS 2618 006101 4312 JMS OCTOUT /PRINT IT 2619 006102 5305 JMP .+3 /DON'T PRINT THIS ONE 2620 006103 4543 JMS I DECODE /GET A CHARACTER 2621 006104 4547 JMS I PRTCL /PRINT IT 2622 006105 1071 TAD CHAR /LOOK AT CHARACTER 2623 006106 1122 TAD NCR /SUBTRACT CARRIAGE RETURN 2624 006107 7640 SZA CLA /IS IT CARRIAGE RETURN? 2625 006110 5303 JMP .-5 /NO, GO AGAIN 2626 006111 5512 JMP I C7600 /YES, RETURN TO MONITOR 2627 006112 0000 OCTOUT, .-. /ROUTINE TO PRINT OCTAL VALUE OF AC 2628 006113 7004 RAL /COMPENSATE FOR LINK 2629 006114 3032 DCA SAVE1 /SAVE THE NUMBER 2630 006115 1016 TAD N4 /GET NEGATIVE FOUR 2631 006116 3074 DCA WORK /SET DIGIT COUNTER 2632 006117 1032 OCOUTL, TAD SAVE1 /GET SAVED VALUE 2633 006120 7006 RTL /SHIFT TO POSIITON 2634 006121 7004 RAL /NEXT DIGIT 2635 006122 3032 DCA SAVE1 /SAVE IT 2636 006123 1032 TAD SAVE1 /GET IT BACK 2637 006124 0334 AND C7 /MASK FOR THE DIGIT 2638 006125 1117 TAD C260 /CONVERT TO ASCII 2639 006126 4466 JMS I TYP /PRINT IT 2640 006127 2074 ISZ WORK /DONE YET? 2641 006130 5317 JMP OCOUTL /NO, GO AGAIN 2642 006131 1102 TAD CR /YES, GET CARRIAGE RETURN 2643 006132 4547 JMS I PRTCL /PRINT IT 2644 006133 5712 JMP I OCTOUT /RETURN TO CALLER 2645 006134 0007 C7, 7 /MASK FOR OCTAL DIGIT 2646 006135 0000 PARTIN, .-. /ROUTINE TO INPUT UNSIGNED INTEGER 2647 006136 3376 DCA DIGCNT /RESET DIGIT COUNTER 2648 006137 4557 JMS I SRTNUM /CHECK WHETHER '.', 0-9, OR ALPHA 2649 006140 5735 JMP I PARTIN /PERIOD, RETURN 2650 006141 5735 JMP I PARTIN /ALPHA, RETURN 2651 006142 1056 TAD SORTWK /GET THE DIGIT 2652 006143 3375 DCA NEWDIG /SET UP FOR NEWDIG 2653 006144 4352 JMS NXTDIG /CALL NEWDIG 2654 006145 2376 ISZ DIGCNT /BUMP DIGIT COUNT 2655 006146 7640 SZA CLA /OVERFLOW? 2656 006147 4564 JMS I ERROR /YES, GO TO ERROR ROUTINE 2657 006150 4565 JMS I GETCHR /NO, GET A CHARACTER 2658 006151 5337 JMP PARTIN+2 /AND GO AGAIN 2659 006152 0000 NXTDIG, .-. /ROUTINE TO PUT NEW DIGIT INTO FAC (FAC=FAC*10+DIGIT) 2660 006153 1050 TAD FACLOW /GET LOW FAC 2661 006154 3044 DCA OPLOW /COPY TO OPERAND 2662 006155 1047 TAD FACMED /GET MED FAC 2663 006156 3043 DCA OPMED /COPY TO OPERAND 2664 006157 1046 TAD FACHGH /GET HIGH FAC 2665 006160 3042 DCA OPHGH /COPY TO OPERAND 2666 006161 3051 DCA FACOVR /CLEAR OVERFLOW WORD 2667 006162 4526 JMS I DOUBLE /OFAC*2 2668 006163 4526 JMS I DOUBLE /OFAC*4 2669 006164 4572 JMS I PSUM /OFAC*5 2670 006165 4526 JMS I DOUBLE /OFAC*10 2671 006166 1375 TAD NEWDIG /GET NEW DIGIT 2672 006167 3044 DCA OPLOW /SET OPERAND LOW 2673 006170 3043 DCA OPMED /ZERO OPERAND MED 2674 006171 3042 DCA OPHGH /ZERO OPERAND HIGH 2675 006172 4572 JMS I PSUM /ADD NEW DIGIT 2676 006173 1051 TAD FACOVR /GET OVERFLOW WORD 2677 006174 5752 JMP I NXTDIG /RETURN IT 2678 006175 0000 NEWDIG, .-. /HOLD AREA FOR DIGIT 2679 006176 0000 DIGCNT, .-. /COUNT OF DIGITS 2680 2681 *6200 /FLOATING POINT OUTPUT ROUTINE 2682 006200 0000 FACTYP, .-. /ROUTINE TO TYPE THE VALUE IN FAC 2683 006201 1046 TAD FACHGH /GET HIGH FAC 2684 006202 7710 SPA CLA /POSITIVE? 2685 006203 1330 TAD C15 /NO, GET 15 2686 006204 1111 TAD C240 /FORM '-' OR SPACE 2687 006205 4547 JMS I PRTCL /PRINT IT 2688 006206 3033 DCA POWER /CLEAR POWER OF TEN 2689 006207 4766 JMS I PFLOUT /CALL OUTPUT ALIGNMENT ROUTINE 2690 006210 1051 TAD FACOVR /GET OVERFLOW WORD (CONTAINS 0-FIFTEEN) 2691 006211 7640 SZA CLA /IS IT ZERO? 2692 006212 5217 JMP OUTZER /NO, SKIP SPECIAL SHIFT 2693 006213 4774 JMS I PNXTDG /YES, SHIFT IN NEXT DIGIT 2694 006214 7240 CLA CMA /GET NEGATIVE ONE 2695 006215 1033 TAD POWER /ADJUST POWER OF TEN 2696 006216 3033 DCA POWER /SET NEW POWER OF TEN 2697 006217 1054 OUTZER, TAD FORM /GET FORMAT CONTROL WORD 2698 006220 7450 SNA /SCIENTIFIC NOTATION? 2699 006221 5267 JMP SCINOT /YES, GO DO IT 2700 006222 4555 JMS I ROT6 /NO, SHIFT DIGIT COUNT TO LOW AC 2701 006223 7041 CIA /NEGATE 2702 006224 1054 TAD FORM /ADD IN DIGITS ON RIGHT 2703 006225 7040 CMA /FORM DIGITS ON LEFT-1 2704 006226 0001 AND C77 /MASK STRAY BITS 2705 006227 3074 DCA WORK /SAVE LEFT DIGIT COUNT 2706 006230 1033 TAD POWER /GET POWER OF TEN 2707 006231 7510 SPA /POSITIVE? 2708 006232 7200 CLA /NO, USE ZERO 2709 006233 7041 CIA /NEGATE 2710 006234 1074 TAD WORK /ADD DIGITS ON LEFT COUNT 2711 006235 7510 SPA /TOO MANY DIGITS ON LEFT? 2712 006236 5267 JMP SCINOT /YES, SWITCH TO SCIENTIFIC NOTATION 2713 006237 7040 CMA /NO, MAKE LEADING SPACE COUNT-1 2714 006240 3074 DCA WORK /SAVE IT 2715 006241 1054 TAD FORM /GET FORMAT WORD 2716 006242 0112 AND C7600 /GET DIGITS ON LEFT 2717 006243 4555 JMS I ROT6 /SHIFT TO LOW AC 2718 006244 1074 TAD WORK /SUBTRACT LEADING SPACE COUNT 2719 006245 7040 CMA /MAKE POSITIVE RESULT 2720 006246 3045 DCA FACEXP /STORE FOR LATER 2721 006247 2074 ISZ WORK /TYPED ENOUGH LEADING SPACES? 2722 006250 7410 SKP /NO, KEEP GOING 2723 006251 5255 JMP .+4 /YES, ON WITH THE OUTPUT 2724 006252 1111 TAD C240 /GET A SPACE 2725 006253 4466 JMS I TYP /PRINT IT 2726 006254 5247 JMP .-5 /AND CHECK AGAIN 2727 006255 1033 TAD POWER /GET POWER OF TEN 2728 006256 7500 SMA /NEGATIVE? 2729 006257 5276 JMP NOSCI /NO, NO NEED TO TYPE ZEROES 2730 006260 3062 DCA COUNTR /YES, SET COUNTER 2731 006261 3033 DCA POWER /ZERO POWER OF TEN 2732 006262 4775 JMS I POUTDG /TYPE A ZERO 2733 006263 5600 JMP I FACTYP /NO MORE DIGITS, RETURN 2734 006264 2062 ISZ COUNTR /NEED MORE? 2735 006265 5262 JMP .-3 /YES, DO ANOTHER 2736 006266 5276 JMP NOSCI /NO, PROCEED WITH OUTPUT 2737 006267 7200 SCINOT, CLA /CLEAR CRUFT 2738 006270 1371 TAD N6 /GET NEGATIVE SIX 2739 006271 3045 DCA FACEXP /SET UP DIGIT COUNT 2740 006272 1033 TAD POWER /GET POWER OF TEN 2741 006273 3032 DCA SAVE1 /SAVE IT 2742 006274 3033 DCA POWER /KLUDGE FOR '.' PLACEMENT 2743 006275 7040 CMA /GET NEGATIVE ONE 2744 006276 3052 NOSCI, DCA SIGNSW /SET SCIENTIFIC NOTATION SWITCH 2745 006277 3062 DCA COUNTR /CLEAR TRAILING ZERO COUNTER 2746 006300 7127 CLL CML IAC RTL /GET CONSTANT SIX 2747 006301 1045 TAD FACEXP /SUBTRACT DIGIT COUNTER 2748 006302 7510 SPA /NEED TRAILING SPACES? 2749 006303 3062 DCA COUNTR /YES, SAVE HOW MANY 2750 006304 1371 TAD N6 /GET NEGATIVE SIX 2751 006305 3045 DCA FACEXP /SET AS DIGIT COUNT 2752 006306 1051 TAD FACOVR /GET FIRST DIGIT 2753 006307 1035 TAD N12 /SUBTRACT TEN 2754 006310 7710 SPA CLA /CORRECTLY ALIGNED? 2755 006311 5316 JMP ODIGOK /YES, GO OUTPUT IT 2756 006312 7001 IAC /NO, GET A ONE 2757 006313 4775 JMS I POUTDG /OUTPUT THAT 2758 006314 5600 JMP I FACTYP /NO MORE DIGITS; SHOULD NEVER HAPPEN 2759 006315 1035 TAD N12 /GET NEGATIVE TEN 2760 006316 1051 ODIGOK, TAD FACOVR /ADD TO OVERFLOW WORD 2761 006317 7410 SKP /AND PROCEED 2762 006320 4774 CMPDIG, JMS I PNXTDG /GET NEXT DIGIT 2763 006321 4775 JMS I POUTDG /OUTPUT THE DIGIT 2764 006322 7410 SKP /NO MORE DIGITS, CHECK FOR SCI. NOTATION 2765 006323 5320 JMP CMPDIG /MORE DIGITS, GO DO THEM 2766 006324 1062 TAD COUNTR /GET TRAILING ZERO COUNT 2767 006325 7650 SNA CLA /NEED A TRAILING ZERO? 2768 006326 5333 JMP .+5 /NO, PROCEED 2769 006327 4775 JMS I POUTDG /YES, OUTPUT A ZERO 2770 006330 0015 C15, 15 /CONSTAND TO CONVERT SPACE TO MINUS SIGN 2771 006331 2062 ISZ COUNTR /NEED MORE? 2772 006332 5327 JMP .-3 /YES, LOOP AGAIN 2773 006333 2052 ISZ SIGNSW /SCIENTIFIC NOTATION? 2774 006334 5600 JMP I FACTYP /NO, WE ARE DONE 2775 006335 1370 TAD C305 /YES, GET 'E' 2776 006336 4547 JMS I PRTCL /PRINT IT 2777 006337 1032 TAD SAVE1 /GET SAVED POWER OF TEN 2778 006340 7510 SPA /POSITIVE? 2779 006341 7041 CIA /NO, MAKE IT POSITIVE 2780 006342 3046 DCA FACHGH /SAVE FOR A MOMENT 2781 006343 1032 TAD SAVE1 /GET POWER OF TEN AGAIN 2782 006344 7710 SPA CLA /POSITIVE? 2783 006345 1330 TAD C15 /NO, GET 15 2784 006346 1111 TAD C240 /FORM SPACE OR MINUS SIGN 2785 006347 4547 JMS I PRTCL /PRINT IT 2786 006350 1046 TAD FACHGH /GET POWER OF TEN (POSITIVE) 2787 006351 2045 ISZ FACEXP /BUMP RESULT LOCATION 2788 006352 1372 TAD N144 /SUBTRACT ONE HUNDRED 2789 006353 7500 SMA /NEGATIVE? 2790 006354 5351 JMP .-3 /NO, GO AGAIN 2791 006355 1373 TAD C144 /YES, UNDO LAST SUBTRACTION 2792 006356 3046 DCA FACHGH /SAVE POWER MOD ONE-HUNDRED 2793 006357 7040 CMA /GET NEGATIVE ONE 2794 006360 1045 TAD FACEXP /FORM FIRST DIGIT 2795 006361 7440 SZA /IS IT ZERO? 2796 006362 4775 JMS I POUTDG /NO, OUTPUT IT 2797 006363 1046 TAD FACHGH /GET REMAINING POWER OF TEN 2798 006364 4767 JMS I PDCOUT /OUTPUT IT 2799 006365 5600 JMP I FACTYP /RETURN 2800 006366 6400 PFLOUT, FLOUT /POINTER TO OUTPUT ALIGNMENT ROUTINE 2801 006367 2446 PDCOUT, DCDGTS /POINTER TO TWO DIGIT DECIMAL OUTPUT ROUTINE 2802 006370 0305 C305, 305 /ASCII 'E', FOR SCIENTIFIC NOTATION 2803 006371 7772 N6, -6 /NEGATIVE SIX, SIGNIFICANT DIGIT MAXIMUM 2804 006372 7634 N144, -144 /NEGATIVE ONE HUNDRED 2805 006373 0144 C144, 144 /POSITIVE ONE HUNDRED 2806 006374 6152 PNXTDG, NXTDIG /ROUTINE TO ENTER NEXT DIGIT IN FAC 2807 006375 3417 POUTDG, OUTDIG /POINTER TO OUTPUT DIGIT ROUTINE 2808 2809 *6400 /FLOATING POINT INPUT, OUTDIG, OUTPUT ALIGNMENT ROUTINE 2810 006400 0000 FLOUT, .-. /DECIMAL OUTPUT ALIGNMENT ROUTINE 2811 006401 4567 JMS I PABS /TAKE ABSOLUTE VALUE 2812 006402 1045 FIXPWR, TAD FACEXP /GET FAC EXPONENT 2813 006403 7510 SPA /POSITIVE? 2814 006404 5215 JMP SMALL /NO, NUMBER IS LESS THAN ONE 2815 006405 1016 TAD N4 /YES, SUBTRACT FOUR 2816 006406 7750 SNA SPA CLA /STILL POSITIVE AND NON-ZERO? 2817 006407 5224 JMP PWROK /NO, THE POWER OF TEN IS CLOSE 2818 006410 4407 JMS I FPP /YES, ENTER FLOATING POINT MODE 2819 006411 3377 FDIV TEN /DIVIDE BY TEN 2820 006412 0000 FEXT /RETURN TO NORMAL MODE 2821 006413 2033 ISZ POWER /BUMP THE POWER OF TEN 2822 006414 5202 JMP FIXPWR /AND CHECK AGAIN 2823 006415 4407 SMALL, JMS I FPP /ENTER FLOATING POINT MODE 2824 006416 4377 FMPY TEN /MULTIPLY BY TEN 2825 006417 0000 FEXT /RETURN TO NORMAL MODE 2826 006420 7040 CMA /GET NEGATIVE ONE 2827 006421 1033 TAD POWER /FORM DECREMENTED POWER OF TEN 2828 006422 3033 DCA POWER /STORE IT 2829 006423 5202 JMP FIXPWR /AND GO AGAIN 2830 006424 3651 PWROK, DCA I PNWDIG /ZERO THE NEW DIGIT 2831 006425 3051 DCA FACOVR /ZERO FAC OVERFLOW AREA 2832 006426 1045 TAD FACEXP /GET FAC EXPONENT 2833 006427 7140 CLL CMA /NEGATE AND SUBTRACT ONE 2834 006430 3252 DCA FACINP /STORE HOW MANY TIMES TO DOUBLE 2835 006431 4526 JMS I DOUBLE /DOUBLE THE FAC 2836 006432 2252 ISZ FACINP /DONE? 2837 006433 5231 JMP .-2 /NO, GO AGAIN 2838 006434 3044 DCA OPLOW /YES, ZERO LOW OPERAND 2839 006435 1051 TAD FACOVR /GET FAC OVERFLOW WORD 2840 006436 7650 SNA CLA /IS IT ZERO? 2841 006437 1374 TAD N114 /YES, ADJUST ROUNDING CONSTANT 2842 006440 1376 TAD C124 /FORM 0.00000500679 2843 006441 3043 DCA OPMED /ZERO MED OPERAND 2844 006442 3042 DCA OPHGH /ZERO HIGH OPERAND 2845 006443 4572 JMS I PSUM /ROUND THE FAC 2846 006444 1051 TAD FACOVR /GET FIRST DIGIT (ZERO TO FIFTEEN) 2847 006445 1035 TAD N12 /SUBTRACT TEN 2848 006446 7700 SMA CLA /IS IT DECIMAL? 2849 006447 2033 ISZ POWER /NO, BUMP POWER OF TEN 2850 006450 5600 JMP I FLOUT /RETURN 2851 006451 6175 PNWDIG, NEWDIG /POINTER TO NEW DIGIT HOLD AREA 2852 006452 0000 FACINP, .-. /ROUTINE TO INPUT FLOATING POINT NUMBER 2853 006453 4541 JMS I PUSHF /PUSH 2854 006454 0045 FACEXP /FLOATING AC 2855 006455 4542 JMS I POPF /POP 2856 006456 2050 DUMMY /INTO SAVE AREA 2857 006457 3045 DCA FACEXP /CLEAR FAC EXPONENT 2858 006460 3046 DCA FACHGH /CLEAR HIGH FAC 2859 006461 3047 DCA FACMED /CLEAR MED FAC 2860 006462 3050 DCA FACLOW /CLEAR LOW FAC 2861 006463 4771 JMS I PPRTIN /INPUT DECIMAL INTEGER 2862 006464 1071 TAD CHAR /GET CHARACTER 2863 006465 1121 TAD N256 /SUBTRACT '.' 2864 006466 7640 SZA CLA /GOT A DOT? 2865 006467 5274 JMP NOFRCT /NO, SKIP FRACTION BIT 2866 006470 4565 JMS I GETCHR /GET NEXT CHARACTER 2867 006471 4771 JMS I PPRTIN /INPUT ANOTHER INTEGER 2868 006472 1772 TAD I PDGCNT /GET DIGIT COUNT 2869 006473 7041 CIA /NEGATE 2870 006474 3033 NOFRCT, DCA POWER /SAVE POWER OF TEN 2871 006475 1375 TAD C43 /GET DECIMAL 35 2872 006476 3045 DCA FACEXP /SET AS FAC EXPONENT 2873 006477 4566 JMS I PNORML /NORMALIZE 2874 006500 1071 TAD CHAR /GET THE CHARACTER 2875 006501 1106 TAD N305 /SUBTRACT 'E' 2876 006502 7640 SZA CLA /WAS IT 'E'? 2877 006503 5340 JMP SAVFAC /NO, SKIP POWER OF TEN INPUT 2878 006504 4541 JMS I PUSHF /YES, PUSH 2879 006505 0045 FACEXP /FAC 2880 006506 4542 JMS I POPF /POP 2881 006507 6063 SAVEXP /INTO SAVE AREA 2882 006510 7200 PWRIGN, CLA /STILL NEED THIS? 2883 006511 4565 JMS I GETCHR /GET NEXT CHARACTER 2884 006512 4556 JMS I KLSPCE /IGNORE SPACES 2885 006513 1071 TAD CHAR /LOOK AT CHARACTER 2886 006514 1373 TAD N253 /SUBTRACT '+' 2887 006515 7450 SNA /IS IT '+; 2888 006516 5310 JMP PWRIGN /YES, IGNORE IT 2889 006517 1115 TAD N2 /SUBTRACT TWO 2890 006520 7640 SZA CLA /IS IT '-'? 2891 006521 5325 JMP PWRIN /NO, PROCEED 2892 006522 7040 CMA /YES, GET NEGATIVE ONE 2893 006523 3052 DCA SIGNSW /SET SIGN SWITCH 2894 006524 5311 JMP PWRIGN+1 /AND CONTINUE 2895 006525 3046 PWRIN, DCA FACHGH /ZERO FAC HIGH 2896 006526 3050 DCA FACLOW /ZERO FAC LOW 2897 006527 4771 JMS I PPRTIN /CALL INTEGER INPUT 2898 006530 4570 JMS I PUNABS /RESTORE SIGN 2899 006531 1050 TAD FACLOW /GET POWER OF TEN 2900 006532 1033 TAD POWER /ADD OLD POWER OF TEN 2901 006533 3033 DCA POWER /SAVE NEW POWER OF TEN 2902 006534 4541 JMS I PUSHF /PUSH 2903 006535 6063 SAVEXP /SAVED FP VALUE 2904 006536 4542 JMS I POPF /POP 2905 006537 0045 FACEXP /INTO FAC 2906 006540 4541 SAVFAC, JMS I PUSHF /PUSH 2907 006541 2050 DUMMY /VALUE OF FAC ON ENTRY 2908 006542 1033 PWRFIX, TAD POWER /GET POWER OF TEN 2909 006543 7450 SNA /IS IT ZERO? 2910 006544 5363 JMP INPXIT /YES, WE ARE DONE 2911 006545 7700 SMA CLA /NO, TOO SMALL OR TOO LARGE? 2912 006546 5354 JMP TOOSML /TOO SMALL 2913 006547 4407 JMS I FPP /ENTER FLOATING POINT MODE 2914 006550 3377 FDIV TEN /DIVIDE BY TEN 2915 006551 0000 FEXT /RETURN TO NORMAL MODE 2916 006552 7001 IAC /GET A ONE 2917 006553 5360 JMP UPPWR /GO UPDATE POWER OF TEN 2918 006554 4407 TOOSML, JMS I FPP /ENTER FLOATING POINT MODE 2919 006555 4377 FMPY TEN /MULTIPLY BY TEN 2920 006556 0000 FEXT /RETURN TO NORMAL MODE 2921 006557 7040 CMA /GET A NEGATIVE ONE 2922 006560 1033 UPPWR, TAD POWER /ADD TO POWER OF TEN 2923 006561 3033 DCA POWER /SET NEW POWER OF TEN 2924 006562 5342 JMP PWRFIX /GO CHECK MAGNITUDE AGAIN 2925 006563 4407 INPXIT, JMS I FPP /ENTER FLOATING POINT MODE 2926 006564 6525 FPUT I PDUMMY /STORE OUR RESULT 2927 006565 0000 FEXT /RETURN TO NORMAL MODE 2928 006566 4542 JMS I POPF /POP 2929 006567 0045 FACEXP /ORIGINAL FAC VALUE 2930 006570 5652 JMP I FACINP /RETURN TO CALLER 2931 006571 6135 PPRTIN, PARTIN /POINTER TO UNSIGNED INTEGER INPUT ROUTINE 2932 006572 6176 PDGCNT, DIGCNT /POINTER TO DIGIT COUNTER 2933 006573 7525 N253, -253 /NEGATIVE ASCII '+' 2934 006574 7664 N114, -114 /ROUNDING CONSTANT 2935 006575 0043 C43, 43 /DECIMAL 35 TO KLUDGE EXPONENT 2936 006576 0124 C124, 124 /ROUNDING CONSTANT 2937 006577 0004 TEN, 4 /FLOATING POINT CONSTANT OF TEN 2938 2939 *6600 /FLOATING POINT ARITHMETIC MOITOR 2940 006600 2400 2400 2941 006601 0000 0 2942 006602 0000 FLTPKG, .-. /FLOATING POINT INTERPRETER 2943 006603 7300 CLA CLL /IGNORE ANYTHING IN AC 2944 006604 3050 DCA FACLOW /CLEAR LOW FAC 2945 006605 3044 DCA OPLOW /CLEAR LOW OPERAND 2946 006606 1602 TAD I FLTPKG /GET FP INSTRUCTION 2947 006607 7450 SNA /IS IT ZERO? 2948 006610 5602 JMP I FLTPKG /YES, WE ARE DONE 2949 006611 3263 DCA INST /SAVE FP INSTRUCTION 2950 006612 1263 TAD INST /GET FP INSTRUCTION 2951 006613 0003 AND C200 /GET PAGE BIT 2952 006614 7640 SZA CLA /PAGE ZERO? 2953 006615 1202 TAD FLTPKG /NO, GET FP PC (YES, GET 00000) 2954 006616 0112 AND C7600 /MASK FOR PAGE BITS 2955 006617 3041 DCA OPEXP /STORE PAGE BITS 2956 006620 1263 TAD INST /GET INSTRUCTION 2957 006621 0002 AND C177 /ISOLATE PAGE OFFSET 2958 006622 1041 TAD OPEXP /ADD PAGE BITS 2959 006623 3041 DCA OPEXP /STORE OPERAND ADDRESS 2960 006624 1263 TAD INST /GET FP INSTRUCTION 2961 006625 0264 AND C400 /LOOK AT INDIRECT BIT 2962 006626 7650 SNA CLA /IS IT SET? 2963 006627 5232 JMP .+3 /NO, SKIP INDIRECTION 2964 006630 1441 TAD I OPEXP /YES, DO INDIRECTION 2965 006631 3041 DCA OPEXP /STORE OPERAND ADDRESS 2966 006632 2202 ISZ FLTPKG /ADVANCE FP PC 2967 006633 7040 CMA /GET NEGATIVE ONE 2968 006634 1041 TAD OPEXP /GET OPERAND ADDRESS 2969 006635 3015 DCA FPPTR1 /SET UP AUTOINDEX 2970 006636 1263 TAD INST /GET INSTRUCTION 2971 006637 7106 CLL RTL /SHIFT OPCODE TO LOW AC 2972 006640 7006 RTL / 2973 006641 0107 AND C17 /MASK FOR OPCODE 2974 006642 7450 SNA /IS IT FGET? 2975 006643 5270 JMP GET /YES, GO DO IT 2976 006644 1265 TAD FPPTAB /NO, ADD DISPATCH POINTER 2977 006645 3263 DCA INST /STORE RESULT 2978 006646 1663 TAD I INST /GET TABLE ENTRY 2979 006647 7450 SNA /IS IT FPUT? 2980 006650 5266 JMP PUT /YES, GO DO IT 2981 006651 3263 DCA INST /NO, SAVE IT 2982 006652 1305 TAD POPRND /GET POINTER TO OPERAND 2983 006653 3014 DCA FPPTR2 /SET UP DESTINATION 2984 006654 1123 TAD FACLEN /GET FAC LENGTH 2985 006655 3062 DCA COUNTR /SET UP COUNTER 2986 006656 1415 TAD I FPPTR1 /GET FROM OPERAND 2987 006657 3414 DCA I FPPTR2 /STORE IN OPERAND AREA 2988 006660 2062 ISZ COUNTR /DONE? 2989 006661 5256 JMP .-3 /NO, DO ANOTHER 2990 006662 5663 JMP I INST /DISPATCH THE INSTRUCTION 2991 006663 0000 INST, .-. /WORK AREA FOR INSTRUCTION INTERPRETATION 2992 006664 0400 C400, 400 /CONSTANT FOR INDIRECTION BIT 2993 006665 6776 FPPTAB, FPPGO-1 /POINTER TO DISPATCH TABLE 2994 006666 1304 PUT, TAD PFAC /SET FAC AS SOURCE 2995 006667 5274 JMP GET+4 /GO DO COPY 2996 006670 1304 GET, TAD PFAC /GET FAC POINTER 2997 006671 3015 DCA FPPTR1 /SET AS DESTINATION 2998 006672 7040 CMA /GET NEGATIVE ONE 2999 006673 1041 TAD OPEXP /COMPUTE POINTER TO OPERAND 3000 006674 3014 DCA FPPTR2 /SET AS SOURCE 3001 006675 1123 TAD FACLEN /GET FAC LENGTH 3002 006676 3062 DCA COUNTR /SET UP COUNTER 3003 006677 1414 TAD I FPPTR2 /GET FROM SOURCE 3004 006700 3415 DCA I FPPTR1 /STORE IN DESTINATION 3005 006701 2062 ISZ COUNTR /DONE YET? 3006 006702 5277 JMP .-3 /NO, DO ANOTHER 3007 006703 5203 JMP FLTPKG+1 /RESUME AT NEXT INSTRUCTION 3008 006704 0044 PFAC, FACEXP-1 /POINTER TO FAC 3009 006705 0040 POPRND, OPEXP-1 /POINTER TO OPERAND 3010 006706 4767 SUB, JMS I PNEGO /NEGATE THE FAC BEFORE ADD 3011 006707 4766 ADD, JMS I PALIGN /ALIGN FAC AND OPERAND 3012 006710 5203 JMP FLTPKG+1 /NO ADDITION NEEDED, PROCEED 3013 006711 4571 JMS I PFACRT /SHIFT FAC RIGHT 3014 006712 4573 JMS I POPRT /SHIFT OPERAND RIGHT 3015 006713 4572 JMS I PSUM /ADD THEM TOGETHER 3016 006714 4566 NOR, JMS I PNORML /NORMALIZE THE RESULT 3017 006715 5203 JMP FLTPKG+1 /PROCEED TO NEXT INSTRUCTION 3018 006716 1046 XPN, TAD FACHGH /GET FAC HIGH 3019 006717 7640 SZA CLA /IS IT ZERO? 3020 006720 5326 JMP NOZOT /NO, ONWARD 3021 /bugbug: Isn't 0^0 == 1?? 3022 006721 3045 ZOTFAC, DCA FACEXP /YES, CLEAR FAC EXPONENT (0^N==0) 3023 006722 3046 DCA FACHGH /CLEAR FAC HIGH 3024 006723 3047 DCA FACMED /CLEAR FAC ME 3025 006724 3050 DCA FACLOW /CLEAR FAC LOW 3026 006725 5203 JMP FLTPKG+1 /PROCEED TO NEXT INSTRUCTION 3027 006726 4541 NOZOT, JMS I PUSHF /PUSH 3028 006727 0045 FACEXP /FAC 3029 006730 4541 JMS I PUSHF /PUSH 3030 006731 0041 OPEXP /OPERAND 3031 006732 4542 JMS I POPF /POP 3032 006733 0045 FACEXP /FAC 3033 006734 4455 JMS I FIX /TAKE INTEGER PART 3034 006735 7510 SPA /EXPONENT POSITIVE? 3035 006736 5344 JMP UPBAD /NO, GO REPORT ERROR 3036 006737 7040 CMA /NEGATE AND SUBTRACT ONE 3037 006740 3263 DCA INST /SET UP MULTIPLY COUNTER 3038 006741 3044 DCA OPLOW /ZERO OPERAND LOW 3039 006742 1046 TAD FACHGH /GET HIGH FAC 3040 006743 7640 SZA CLA /EXPONENT > 2047? 3041 006744 4564 UPBAD, JMS I ERROR /YES, REPORT BAD EXPONENT 3042 006745 4541 JMS I PUSHF /PUSH 3043 006746 3043 ONE /A FLOATING POINT ONE 3044 006747 4542 JMS I POPF /POP 3045 006750 0045 FACEXP /AS RESULT SO FAR 3046 006751 4542 JMS I POPF /POP 3047 006752 6063 SAVEXP /NUMBER TO EXPONENTIATE 3048 006753 5361 JMP MULDNE /PRETEND A MULTIPLY WAS DONE 3049 006754 4541 XPNLP, JMS I PUSHF /PUSH 3050 006755 6063 SAVEXP /NUMBER TO EXPONENTIATE 3051 006756 4542 JMS I POPF /POP 3052 006757 0041 OPEXP /AS OPERAND 3053 006760 4770 JMS I PFPMUL /MULTIPLY 3054 006761 2263 MULDNE, ISZ INST /DONE MULTIPLYING? 3055 006762 5354 JMP XPNLP /NO, GO MULTIPLY 3056 006763 5203 JMP FLTPKG+1 /YES, GO DO NEXT INSTRUCTION 3057 006764 4770 MUL, JMS I PFPMUL /MULTIPLY BY OPERAND 3058 006765 5203 JMP FLTPKG+1 /ON TO NEXT INSTRUCTION 3059 006766 7026 PALIGN, ALIGN /POINTER TO ALIGNMENT ROUTINE 3060 006767 7324 PNEGO, NEGO /POINTER TO NEGATION ROUTINE 3061 006770 7200 PFPMUL, FPMUL /POINTER TO MULTIPLY ROUTINE 3062 006771 0203 ASKCHR, 203 /^C /CHARACTERS RELEVANT IN ASK COMMANDS 3063 006772 0212 212 /LF 3064 006773 0214 214 /FF 3065 006774 0377 377 /DEL 3066 006775 0233 ASK2, 233 /ESC 3067 006776 0337 337 /ARROW 3068 006777 6707 FPPGO, ADD /BRANCH TABLE FOR FLOATING POINT PACKAGE 3069 3070 *7000 /MISCELLANEOUS FLOATING POINT ARITHMETIC SUBROUTINES 3071 007000 6706 SUB 3072 007001 7261 DIV 3073 007002 6764 MUL 3074 007003 6716 XPN 3075 007004 0000 0 3076 007005 6714 NOR 3077 007006 0000 NEGF, .-. /ROUTINE TO NEGATE FLOATING AC 3078 007007 7300 CLA CLL /GET CLEAN AC 3079 007010 1050 TAD FACLOW /GET LOW WORD 3080 007011 7041 CIA /NEGATE IT 3081 007012 3050 DCA FACLOW /STORE IT 3082 007013 1047 TAD FACMED /GET MIDDLE WORD 3083 007014 7040 CMA /NEGATE IT 3084 007015 7430 SZL /CARRY IN? 3085 007016 7101 CLL IAC /YES, IAC 3086 007017 3047 DCA FACMED /STORE IT 3087 007020 1046 TAD FACHGH /GET HIGH WORD 3088 007021 7040 CMA /NEGATE IT 3089 007022 7430 SZL /CARRY IN? 3090 007023 7101 CLL IAC /YES, INCREMENT 3091 007024 3046 DCA FACHGH /STORE IT 3092 007025 5606 JMP I NEGF /RETURN TO CALLER 3093 007026 0000 ALIGN, .-. /ALIGN THE FAC AND THE OPERAND 3094 007027 1046 TAD FACHGH /GET FAC HIGH 3095 007030 7450 SNA /IS IT ZERO? 3096 007031 1047 TAD FACMED /YES, ADD MED FAC 3097 007032 7650 SNA CLA /STILL ZERO? 3098 007033 5314 JMP GETOPR /YES, GO GET OPERAND AND TAKE 'FAIL' RETURN 3099 007034 1042 TAD OPHGH /NO, GET HIGH OPERAND 3100 007035 7450 SNA /IS IT ZERO? 3101 007036 1043 TAD OPMED /YES, GET MED OPERAND 3102 007037 7450 SNA /STILL ZERO? 3103 007040 1044 TAD OPLOW /YES, GET LOW OPERAND 3104 007041 7650 SNA CLA /STILL ZERO? 3105 007042 5626 JMP I ALIGN /YES, JUST RETURN 3106 007043 1041 TAD OPEXP /GET OPERAND EXPONENT 3107 007044 7041 CIA /NEGATE 3108 007045 1045 TAD FACEXP /ADD FAC EXPONENT 3109 007046 7450 SNA /EQUAL? 3110 007047 5276 JMP ALGNOK /YES, ALIGNMENT IS OK 3111 007050 3206 DCA NEGF /NO, STORE SHIFT COUNT 3112 007051 1206 TAD NEGF /GET SHIFT COUNT 3113 007052 7500 SMA /NEGATIVE? 3114 007053 7041 CIA /NO, MAKE IT NEGATIVE 3115 007054 3325 DCA ALGNSV /SAVE NEGATIVE SHIFT COUNT 3116 007055 1325 TAD ALGNSV /GET IT BACK 3117 007056 1326 TAD C27 /ADD TWENTY SEVEN 3118 007057 7710 SPA CLA /TOO FAR APART? 3119 007060 5300 JMP ALGNFL /YES, GO TAKE FAIL RETURN 3120 007061 1206 TAD NEGF /GET SHIFT COUNT 3121 007062 7700 SMA CLA /NEGATIVE? 3122 007063 5270 JMP OPALGN /NO, PROCEED 3123 007064 4571 JMS I PFACRT /SHIFT FAC RIGHT 3124 007065 2325 ISZ ALGNSV /DONE ENOUGH? 3125 007066 5264 JMP .-2 /NO, SHIFT AGAIN 3126 007067 5276 JMP ALGNOK /YES, PROCEED 3127 007070 7040 OPALGN, CMA /FORM NEGATIVE SHIFT COUNT 3128 007071 1041 TAD OPEXP /FORM NEW EXPONENT 3129 007072 3041 DCA OPEXP /UPDATE OPERAND EXPONENT 3130 007073 4573 JMS I POPRT /SHIF OPERAND RIGHT 3131 007074 2325 ISZ ALGNSV /DONE ENOUGH? 3132 007075 5273 JMP .-2 /NO, DO ANOTHER 3133 007076 2226 ALGNOK, ISZ ALIGN /SET UP FOR SKIP (OK) RETURN 3134 007077 5626 JMP I ALIGN /RETURN TO CALLER 3135 007100 1041 ALGNFL, TAD OPEXP /GET OPERAND EXPONENT 3136 007101 7700 SMA CLA /IS IT NEGATIVE? 3137 007102 5307 JMP ALGNCK /NO, CHECK ALIGNMENT 3138 007103 1045 TAD FACEXP /YES, GET FAC EXPONENT 3139 007104 7700 SMA CLA /IS IT NEGATIVE? 3140 007105 5626 JMP I ALIGN /NO, RETURN 3141 007106 5311 JMP CHKDIF /YES, GO CHECK DIFFERENCE 3142 007107 1045 ALGNCK, TAD FACEXP /LOOK AT FAC EXPONENT 3143 007110 7700 SMA CLA /IS OP EXP > 0 AND FAC EXP < 0? 3144 007111 1206 CHKDIF, TAD NEGF /NO, LOOK AT DIFFERENCE 3145 007112 7740 SZA SMA CLA /FAC > OPERAND? 3146 007113 5626 JMP I ALIGN /YES, RETURN 3147 007114 1041 GETOPR, TAD OPEXP /NO, GET OPERAND EXPONENT 3148 007115 3045 DCA FACEXP /SET FAC EXPONENT 3149 007116 1042 TAD OPHGH /GET OPERAND HIGH 3150 007117 3046 DCA FACHGH /SET FAC HIGH 3151 007120 1043 TAD OPMED /GET OPERAND MED 3152 007121 3047 DCA FACMED /SET FAC MED 3153 007122 1044 TAD OPLOW /GET OPERAND LOW 3154 007123 3050 DCA FACLOW /SET FAC LOW 3155 007124 5626 JMP I ALIGN /RETURN 3156 007125 0000 ALGNSV, .-. /SAVE AREA FOR ALIGN ROUTINE 3157 007126 0027 C27, 27 /THENTY SEVEN BITS (TOO FAR FOR ALIGN) 3158 007127 0000 SUM, .-. /ROUTINE TO ADD FAC AND OPERAND (MUST ALIGN FIRST) 3159 007130 7300 CLA CLL /CLEAR CRUFT 3160 007131 1050 TAD FACLOW /GET LOW FAC 3161 007132 1044 TAD OPLOW /ADD LOW OPERAND 3162 007133 3050 DCA FACLOW /STORE LOW RESULT 3163 007134 7004 RAL /GET CARRY-IN 3164 007135 1047 TAD FACMED /ADD MED FAC 3165 007136 1043 TAD OPMED /ADD MED OPERAND 3166 007137 3047 DCA FACMED /STORE MED RESULT 3167 007140 7004 RAL /GET CARRY-IN 3168 007141 1046 TAD FACHGH /ADD FAC HIGH 3169 007142 1042 TAD OPHGH /ADD OPERAND HIGH 3170 007143 3046 DCA FACHGH /STORE RESULT HIGH 3171 007144 7004 RAL /GET CARRY-IN 3172 007145 1051 TAD FACOVR /ADD FAC OVERFLOW 3173 007146 3051 DCA FACOVR /STORE RESULT OVERFLOW 3174 007147 5727 JMP I SUM /RETURN TO CALLER 3175 007150 0000 OPRGHT, .-. /ROUTINE TO SHIFT OPERAND RIGHT AND RETAIN VALUE 3176 007151 7300 CLA CLL /CLEAR CRUFT 3177 007152 1042 TAD OPHGH /GET OPERAND HIGH 3178 007153 7510 SPA /NEED SIGN EXTEND? 3179 007154 7120 CLL CML /YES, DO IT 3180 007155 7010 RAR /SHIFT RIGHT 3181 007156 3042 DCA OPHGH /STORE OPERAND HIGH 3182 007157 1043 TAD OPMED /GET OPERAND MED 3183 007160 7010 RAR /SHIFT RIGHT 3184 007161 3043 DCA OPMED /STORE OPERAND MED 3185 007162 1044 TAD OPLOW /GET OPERAND LOW 3186 007163 7010 RAR /SHIFT RIGHT 3187 007164 3044 DCA OPLOW /STORE OPERAND LOW 3188 007165 2041 ISZ OPEXP /ADJUST OPERAND EXPONENT 3189 007166 5750 JMP I OPRGHT /RETURN TO CALLER 3190 007167 5750 JMP I OPRGHT /RETURN TO CALLER (EXPONENT BECAME ZERO) 3191 007170 0215 UNQUOT, 215 /CR /TABLE OF CHARACTERS WHICH TERMINATE QUOTES 3192 007171 0247 247 /' 3193 007172 0242 242 /" 3194 007173 7777 -1 3195 007174 2612 IMMDGO, CNTRLC /BRANCH TABLE FOR COMMAND MODE 3196 007175 0213 SCRAP 3197 007176 0227 LFECHO 3198 007177 0266 CARRET 3199 3200 *7200 /MULTIPLY, SGNFIX, SGNSET, NEGO, FACRT, ABS, UNABS 3201 007200 0000 FPMUL, .-. /FLOATING POINT MULTIPLY ROUTINE 3202 007201 7001 IAC /ADD ONE 3203 007202 1041 TAD OPEXP /TO OPERAND EXPONENT 3204 007203 4276 JMS SGNSET /COMPUTE SIGN OF RESULT 3205 007204 7710 SPA CLA /OPERAND NEGATIVE? 3206 007205 4324 JMS NEGO /YES, MAKE IT POSITIVE 3207 007206 3245 DCA RESLT1 /CLEAR RESULT HIGH 3208 007207 3244 DCA RESLT2 /CLEAR RESULT MED 3209 007210 3243 DCA RESLT3 /CLEAR RESULT LOW 3210 007211 3242 DCA RESLT4 /CLEAR RESULT ULTRALOW 3211 007212 1046 TAD FACHGH /GET HIGH FAC 3212 007213 3722 DCA I MLTCND /SET UP AS MULTIPLICAND 3213 007214 1042 TAD OPHGH /GET HIGH OPERAND 3214 007215 4723 JMS I PHSMUL /MULTIPLY HIGH WORDS 3215 007216 7244 RESLT2 /INTO RESLT2 3216 007217 1043 TAD OPMED /TAD OPMED 3217 007220 4723 JMS I PHSMUL /MULTIPLY OP MED,FAC MED 3218 007221 7243 RESLT3 /INTO RESLT3 3219 007222 1047 TAD FACMED /GET FAC MED 3220 007223 3722 DCA I MLTCND /SET UP AS MULTIPLICAND 3221 007224 1042 TAD OPHGH /GET OP HIGH 3222 007225 4723 JMS I PHSMUL /MULTIPLY FAC MED, OP HIGH 3223 007226 7243 RESLT3 /INTO RESULT3 3224 007227 1043 TAD OPMED /GET OP MED 3225 007230 4723 JMS I PHSMUL /MULTIPLY FAC MED, OP MED 3226 007231 7242 RESLT4 /INTO RESLT4 3227 007232 1245 TAD RESLT1 /GET HIGH RESULT 3228 007233 3046 DCA FACHGH /SET AS FAC HIGH 3229 007234 1244 TAD RESLT2 /GET MED RESULT 3230 007235 3047 DCA FACMED /SET AS FAC MED 3231 007236 1243 TAD RESLT3 /GET LOW RESULT 3232 007237 3050 DCA FACLOW /SET AS FAC LOW 3233 007240 4246 JMS SGNFIX /RESTORE SIGN 3234 007241 5600 JMP I FPMUL /RETURN TO CALLER 3235 007242 0000 RESLT4, .-. /RESULT ULTRALOW 3236 007243 0000 RESLT3, .-. /RESULT LOW 3237 007244 0000 RESLT2, .-. /RESULT MED 3238 007245 0000 RESLT1, .-. /RESULT HIGH 3239 007246 0000 SGNFIX, .-. /ROUTINE TO FIX RESULT BASED ON SIGN 3240 007247 1050 TAD FACLOW /GET FAC LOW 3241 007250 7710 SPA CLA /ROUNDING NEEDED? 3242 007251 2047 ISZ FACMED /YES, INCREMENT FAC MED 3243 007252 7410 SKP /AND CONTINUE 3244 007253 2046 ISZ FACHGH /INCREMENT FAC HIGH (bugbug: notreached?) 3245 007254 3050 DCA FACLOW /ZERO FAC LOW 3246 007255 2052 ISZ SIGNSW /NEED TO NEGATE? 3247 007256 4453 JMS I NEGATE /YES, DO IT 3248 007257 4566 JMS I PNORML /NORMALIZE 3249 007260 5646 JMP I SGNFIX /RETURN 3250 007261 1042 DIV, TAD OPHGH /GET OPERAND HIGH 3251 007262 7650 SNA CLA /IS IT ZERO? 3252 007263 4564 JMS I ERROR /YES, DIVIDING BY ZERO 3253 007264 1041 TAD OPEXP /GET OPERAND EXPONENT 3254 007265 7041 CIA /NEGATE 3255 007266 7001 IAC /INCREMENT 3256 007267 4276 JMS SGNSET /GET SIGN OF RESULT 3257 007270 7700 SMA CLA /OPERAND NEGATIVE? 3258 007271 4324 JMS NEGO /NO, NEGATE IT 3259 007272 4721 JMS I PHSDIV /DO INTEGER DIVIDE 3260 007273 4246 JMS SGNFIX /RESTORE SIGN OR RESULT 3261 007274 5675 JMP I .+1 /GO EXECUTE 3262 007275 6603 FLTPKG+1 /NEXT FPP INSTRUCTION 3263 007276 0000 SGNSET, .-. /ROUTINE TO UPDATE FACEXP AND SET SIGNSW 3264 007277 1045 TAD FACEXP /UPDATE FAC EXPONENT 3265 007300 3045 DCA FACEXP /SET NEW FAC EXPONENT 3266 007301 7130 CLL CML RAR /GET A 4000 3267 007302 0046 AND FACHGH /GET SIGN OF FAC 3268 007303 1042 TAD OPHGH /ADD SIGN OF OPERAND 3269 007304 7700 SMA CLA /SAME SIGN? 3270 007305 7040 CMA /YES, SET FLAG 3271 007306 3052 DCA SIGNSW /SET SIGN FLAG FOR RESULT 3272 007307 1046 TAD FACHGH /GET FAC HIGH 3273 007310 7450 SNA /IS IT ZERO? 3274 007311 5720 JMP I PZOTF /YES, GO FORCE ZERO 3275 007312 7710 SPA CLA /NO, IS IT POSITIVE? 3276 007313 4453 JMS I NEGATE /NO, MAKE IT POSITIVE 3277 007314 1042 TAD OPHGH /GET HIGH OPERAND 3278 007315 7450 SNA /IS IT ZERO? 3279 007316 5720 JMP I PZOTF /YES, FORCE ZERO 3280 007317 5676 JMP I SGNSET /RETURN TO CALLER 3281 007320 6721 PZOTF, ZOTFAC /POINTER TO ROUTINE TO ZERO RESULT AND CONTINUE 3282 007321 7457 PHSDIV, HSDIV /INTEGER HIGH SPEED DIVIDE 3283 007322 7453 MLTCND, MEDIFF /POINTER TO SAVE AREA FOR MULTIPLICAND 3284 007323 7400 PHSMUL, HSMUL /INTEGER HIGH SPEED MULTIPLY 3285 007324 0000 NEGO, .-. /ROUTINE TO NEGATE THE OPERAND 3286 007325 7300 CLA CLL /CLEAR CRUFT 3287 007326 1044 TAD OPLOW /GET OPERAND LOW 3288 007327 7041 CIA /NEGATE 3289 007330 3044 DCA OPLOW /SET OPERAND LOW 3290 007331 1043 TAD OPMED /GET OPERAND MED 3291 007332 7040 CMA /COMPLEMENT 3292 007333 7430 SZL /CARRY-IN? 3293 007334 7101 CLL IAC /YES, INCREMENT 3294 007335 3043 DCA OPMED /SET OPERAND MED 3295 007336 1042 TAD OPHGH /GET OPERAND HIGH 3296 007337 7040 CMA /COMPLEMENT 3297 007340 7430 SZL /CARRY-IN 3298 007341 7101 CLL IAC /YES, INCREMENT 3299 007342 3042 DCA OPHGH /SET OPERAND HIGH 3300 007343 5724 JMP I NEGO /RETURN 3301 007344 0000 UNABS, .-. /RESTORE SIGN AS NEEDED 3302 007345 1052 TAD SIGNSW /CHECK THE SIGN SWITCH 3303 007346 7710 SPA CLA /NEED TO NEGATE? 3304 007347 4453 JMS I NEGATE /YES, DO SO 3305 007350 5744 JMP I UNABS /RETURN 3306 007351 0000 FACRT, .-. /SHIFT FAC RIGHT 3307 007352 7300 CLA CLL /CLEAR CRUFT 3308 007353 1046 TAD FACHGH /GET FAC HIGH 3309 007354 7510 SPA /NEED TO SIGN EXTEND? 3310 007355 7020 CML /YES, DO IT 3311 007356 7010 RAR /SHIFT RIGHT 3312 007357 3046 DCA FACHGH /SET FAC HIGH 3313 007360 1047 TAD FACMED /GET FAC MED 3314 007361 7010 RAR /SHIFT RIGHT 3315 007362 3047 DCA FACMED /SET FAC MED 3316 007363 1050 TAD FACLOW /GET FAC LOW 3317 007364 7010 RAR /SHIFT RIGHT 3318 007365 3050 DCA FACLOW /SET FAC LOW 3319 007366 2045 ISZ FACEXP /ADJUST EXPONENT 3320 007367 5751 JMP I FACRT /RETURN 3321 007370 5751 JMP I FACRT /RETURN (EXPONENT BECAME ZERO) 3322 007371 0000 ABS, .-. /TAKE ABSOLUTE VALUE 3323 007372 1046 TAD FACHGH /GET FAC SIGN 3324 007373 3052 DCA SIGNSW /REMEMBER IT 3325 007374 1046 TAD FACHGH /GET IT AGAIN 3326 007375 7710 SPA CLA /WAS IT NEGATIVE? 3327 007376 4453 JMS I NEGATE /YES, MAKE IT POSITIVE 3328 007377 5771 JMP I ABS /RETURN TO CALLER 3329 3330 *7400 /INTEGER MULTIPLY, DIVIDE, NORMALIZE, INTEGER PART ROUTINES 3331 007400 0000 HSMUL, .-. /DOUBLE PRECISION INTEGER MULTIPLY ROUTINE 3332 007401 7450 SNA /MULTIPLY BY ZERO? 3333 007402 5246 JMP HSMXIT /YES, GO RETURN 3334 007403 3251 DCA ANSLOW /NO, SAVE AS LOW PRODUCT 3335 007404 3250 DCA ANSHGH /SET ZERO FOR HIGH PRODUCT 3336 007405 1254 TAD N14 /GET NEGATIVE TWELVE 3337 007406 3252 DCA BITCNT /STORE IN BIT COUNTER 3338 007407 7100 CLL /CLEAR CARRY-IN 3339 007410 1251 MULLP, TAD ANSLOW /GET LOW PRODUCT 3340 007411 7010 RAR /IN RESULT BIT, MULTIPLIER BIT OUT 3341 007412 3251 DCA ANSLOW /SAVE LOW PRODUCT 3342 007413 1250 TAD ANSHGH /GET HIGH PRODUCT 3343 007414 7430 SZL /WAS MULTIPLIER BIT SET? 3344 007415 1253 TAD MEDIFF /YES, ADD MULTIPLICAND 3345 007416 7110 CLL RAR /RIGHT SHIFT IT 3346 007417 3250 DCA ANSHGH /SET NEW HIGH PRODUCT 3347 007420 2252 ISZ BITCNT /DONE ALL BITS? 3348 007421 5210 JMP MULLP /NO, GO AGAIN 3349 007422 1251 TAD ANSLOW /YES, GET LOW RESULT 3350 007423 7010 RAR /SHIFT IN LAST BIT 3351 007424 3252 DCA BITCNT /SAVE IT 3352 007425 1600 TAD I HSMUL /GET PARAMETER 3353 007426 3251 DCA ANSLOW /STORE POINTER 3354 007427 1252 TAD BITCNT /GET LOW RESULT 3355 007430 7100 CLL /CLEAR CARRY-OUT 3356 007431 1651 TAD I ANSLOW /ADD LOW ANSWER ALREADY THERE 3357 007432 3651 DCA I ANSLOW /SET LOW ANSWER BITS 3358 007433 2251 ISZ ANSLOW /POINT TO HIGH ANSWER 3359 007434 7004 RAL /GET CARRY 3360 007435 1250 TAD ANSHGH /ADD HIGH RESULT 3361 007436 1651 TAD I ANSLOW /ADD HIGH ANSWER ALREADY THERE 3362 007437 3651 DCA I ANSLOW /SET NEW ANSWER BITS 3363 007440 7420 SNL /CARRY OUT? 3364 007441 5246 JMP HSMXIT /NO, GO EXIT 3365 007442 2251 ISZ ANSLOW /YES, INCREMENT POINTER 3366 007443 2651 ISZ I ANSLOW /INCREMENT NEXT HIGHER WORD 3367 007444 5246 JMP HSMXIT /GO EXIT 3368 007445 5242 JMP .-3 /OVERFLOW, GO INCREMENT NEXT 3369 007446 2200 HSMXIT, ISZ HSMUL /SKIP OVER ARGUMENT 3370 007447 5600 JMP I HSMUL /RETURN TO CALLER 3371 007450 0000 ANSHGH, .-. /HIGH PART OF ANSWER 3372 007451 0000 ANSLOW, .-. /LOW PART OF ANSWER 3373 007452 0000 BITCNT, .-. /BIT COUNTER FOR MULTIPLY AND DIVIDE 3374 007453 0000 MEDIFF, .-. /HOLD ARE FOR MEDIUM AREA DIFFERENCE 3375 007454 7764 N14, -14 /NEGATIVE TWELVE 3376 007455 7751 N27, -27 /NEGATIVE TWENTY THREE 3377 007456 7750 N30, -30 /NEGATIVE TWENTY FOUR 3378 007457 0000 HSDIV, .-. /DOUBLE PRECISION DIVIDE ROUTINE 3379 007460 3200 DCA HSMUL /CLEAR HIGH ORDER RESULT 3380 007461 3251 DCA ANSLOW /CLEAR LOW ORDER RESULT 3381 007462 1256 TAD N30 /GET NEGATIVE TWENTY FOUR 3382 007463 3252 DCA BITCNT /SET UP BIT COUNTER 3383 007464 7410 SKP /NO NEED TO SHIFT THE FIRST TIME 3384 007465 4526 DIVLP, JMS I DOUBLE /SHIFT FAC LEFT 3385 007466 7100 CLL /CLEAR CARRY INDICATOR 3386 007467 1043 TAD OPMED /GET OPERAND MED 3387 007470 1047 TAD FACMED /ADD TO FAC MED 3388 007471 3253 DCA MEDIFF /SAVE DIFFERENCE MED 3389 007472 7004 RAL /GET CARRY 3390 007473 1046 TAD FACHGH /ADD FAC HIGH 3391 007474 1042 TAD OPHGH /ADD OPERAND HIGH 3392 007475 7420 SNL /CARRY OUT? 3393 007476 5302 JMP NOSUBT /NO, SKIP SUBTREACTION 3394 007477 3046 DCA FACHGH /YES, STORE NEW FAC HIGH 3395 007500 1253 TAD MEDIFF /GET DIFFERENCE MED 3396 007501 3047 DCA FACMED /SAVE AS NEW FAC MED 3397 007502 7200 NOSUBT, CLA /CLEAR CRUFT 3398 007503 2252 ISZ BITCNT /DONE ALL BITS? 3399 007504 7410 SKP /NO, CONTINUE 3400 007505 5315 JMP DIVXIT /YES, GO EXIT 3401 007506 1251 TAD ANSLOW /GET ANSWER LOW 3402 007507 7004 RAL /SHIFT IN NEW BIT 3403 007510 3251 DCA ANSLOW /SAVE ANSWER LOW 3404 007511 1200 TAD HSMUL /GET ANSWER HIGH 3405 007512 7004 RAL /SHIFT IN NEW BIT 3406 007513 3200 DCA HSMUL /SET ANSWER HIGH 3407 007514 5265 JMP DIVLP /LOOP FOR ANOTHER BIT 3408 007515 7010 DIVXIT, RAR /GET CARRY TO HIGH AC 3409 007516 3050 DCA FACLOW /SAVE IT TO ROUNDOFF WORD 3410 007517 1251 TAD ANSLOW /GET LOW ANSWER 3411 007520 7001 IAC /INCREMENT (ROUND UP) 3412 007521 3047 DCA FACMED /STORE FAC MED 3413 007522 7004 RAL /GET CARRY OUT 3414 007523 1200 TAD HSMUL /ADD HIGH RESULT 3415 007524 3046 DCA FACHGH /STORE FAC HIGH 3416 007525 5657 JMP I HSDIV /RETURN 3417 007526 0000 NORMAL, .-. /ROUTINE TO NORMALIZE FAC 3418 007527 4567 JMS I PABS /TAKE ABSOLUTE VALUE 3419 007530 7130 CLL CML RAR /GET 4000 3420 007531 1046 TAD FACHGH /AND WITH FAC HIGH 3421 007532 7650 SNA CLA /IS 4000 SET? 3422 007533 4571 JMS I PFACRT /YES, SHIFT ONE RIGHT 3423 007534 1046 TAD FACHGH /GET FAC HIGH 3424 007535 7450 SNA /NONZERO? 3425 007536 1047 TAD FACMED /NO, LOOK IN FAC MED 3426 007537 7450 SNA /STILL ZERO? 3427 007540 1050 TAD FACLOW /YES, LOOK IN FAC LOW 3428 007541 7650 SNA CLA /WELL AND TRULY ZERO? 3429 007542 5356 JMP NRMZRO /YES, GO RETURN ZERO 3430 007543 1046 NRMLP, TAD FACHGH /NO, LOOK AT FAC HIGH 3431 007544 7104 CLL RAL /SHIFT LEFT 3432 007545 7710 SPA CLA /TOP BIT NOW ON? 3433 007546 5354 JMP NRMXIT /YES, WE ARE DONE 3434 007547 4526 JMS I DOUBLE /NO, DOUBLE IT 3435 007550 7140 CLL CMA /GET NEGATIVE ONE 3436 007551 1045 TAD FACEXP /ADJUST FAC EXPONENT 3437 007552 3045 DCA FACEXP /SAVE NEW EXPONENT 3438 007553 5343 JMP NRMLP /GO CHECK AGAIN 3439 007554 4570 NRMXIT, JMS I PUNABS /RESTORE FAC SIGN 3440 007555 5726 JMP I NORMAL /RETURN 3441 007556 3045 NRMZRO, DCA FACEXP /ZERO EXPONENT 3442 007557 5726 JMP I NORMAL /RETURN NORMALIZED ZERO 3443 007560 0000 INTEGR, .-. /ROUTINE TO FIX FLOATING AC 3444 007561 7300 CLA CLL /CLEAR CRUFT 3445 007562 1045 TAD FACEXP /GET FAC EXPONENT 3446 007563 7750 SPA SNA CLA /POSITIVE NONZERO EXPONENT? 3447 007564 3045 DCA FACEXP /NO, ZERO THE EXPONENT 3448 007565 1045 TAD FACEXP /GET THE EXPONENT 3449 007566 1255 TAD N27 /SUBTRACT TWENTY THREE 3450 007567 3252 DCA BITCNT /SAVE SHIFT COUNT 3451 007570 7430 SZL /EXPONENT > TWENTY THREE? 3452 007571 5760 JMP I INTEGR /YES, GIVE UP 3453 007572 4571 JMS I PFACRT /NO, SHIFT RIGHT 3454 007573 2252 ISZ BITCNT /DONE SHIFTING? 3455 007574 5372 JMP .-2 /NO, GO SHIFT AGAIN 3456 007575 3050 DCA FACLOW /YES, CLEAR FRACTIONAL PART 3457 007576 1047 TAD FACMED /GET RESULT 3458 007577 5760 JMP I INTEGR /RETURN IT 3459 $ ABS 7371 ADD 6707 ALGNCK 7107 ALGNFL 7100 ALGNOK 7076 ALGNSV 7125 ALIGN 7026 ALTMDE 1233 ANSHGH 7450 ANSLOW 7451 ARGGET 0401 ARGOUT 0151 ARGSW 0070 ASK 1201 ASK2 6775 unreferenced ASKCHR 6771 ASKGO 2600 ASKOVR 1224 ASKTYP 0060 BADFUN 1765 BITCNT 7452 BOTTMP 0036 BOTTOM 5634 BRANCH 1007 BUFBEG 0133 C100 2372 C1000 2764 C124 6576 C140 0110 C144 6373 C15 6330 C17 0107 C177 0002 C200 0003 C2000 0443 C2004 3303 C240 0111 C260 0117 C27 7126 C3015 6062 C305 6370 C400 6664 C43 6575 C7 6134 C7600 0112 C77 0001 CARRET 0266 CGETVL 1737 CHAR 0071 CHECK 0146 CHKDIF 7111 CHKLP 0744 CHKOPR 1652 CHKPRI 1663 CHKPRN 2054 CHKUNP 2066 CHKXIT 0760 CHRGET 3030 CLOBBR 2656 CMPDIG 6320 CNTRLC 2612 COMGO 3355 COMLST 0577 COMMAC 3202 COUNTR 0062 CR 0102 CRLF 2502 DCDGTS 2446 DECODE 0143 DELETE 0163 DELFUN 0372 DELOK 2643 DELXIT 2666 DIGCNT 6176 DIRECT 0327 DIRERR 2630 DIV 7261 DIVLP 7465 DIVXIT 7515 DLRGHT 2667 DO 0445 DODONE 0516 DOIT 0271 DOMORE 0452 DOONE 0510 DOT 0113 DOUBLE 0126 DUMMY 2050 ENCODE 0144 ENDLIN 2174 EQUAL 3122 ERA 2223 ERADNE 2220 ERALIN 2101 ERASE 2210 ERASEA 2215 ERROR 0164 EVAL 1612 EXCLAM 1273 EXEC 0632 FABS 2033 FACEXP 0045 FACHGH 0046 FACIN 0130 FACINP 6452 FACLEN 0123 FACLFT 3401 FACLOW 0050 FACMED 0047 FACOVR 0051 FACRT 7351 FACTYP 6200 FADD 1000 FARGSW 0040 FCOS 5635 FDIV 3000 FEXT 0000 FGET 0000 FIN 3011 FIND 3341 FINDL 3344 FINDLP 2260 FITR 2376 FIX 0055 FIXPWR 6402 FL100 0440 FLOUT 6400 FLP5 0442 FLTPKG 6602 FMPY 4000 FMQ 3000 FNCANS 5752 FNCDNE 2036 FNCGNE 4227 FNCNMS 2400 FNCXIT 0134 FNDLIN 0153 FNDVAR 1476 FNDXIT 2300 FNOR 7000 unreferenced FOCAL 0200 unreferenced FOR 1115 FORCHR 1402 FORGO 3175 FORGO1 3177 FORGO2 2766 FORLP 1136 FORM 0054 FORMAT 1261 FORSTP 1125 FOUT 3025 FPMUL 7200 FPP 0007 FPPGO 6777 FPPOPR 1702 FPPTAB 6665 FPPTR1 0015 FPPTR2 0014 FPUT 6000 FRAN 3304 FREEBF 4047 FRSTOP 1635 FSGN 2027 FSIN 5641 FSQT 6000 FSUB 2000 FTST 3020 FUNC 1744 FUNCBR 1762 FUNCGO 0361 FUNSK2 0737 FUNSRT 0720 FXPN 5000 unreferenced GET 6670 GETARG 0152 GETCHR 0165 GETOPR 7114 GETPTR 0017 GETSCH 3074 GETSDE 0020 GETWRK 0021 GO 0624 GOTFUN 1755 GOTHLF 2357 GOTNAM 1422 GOTO 0627 GOTSTP 1131 GOTZRO 1532 GREATR 3124 GRPTST 0161 GTCHR 0220 HALFPI 5761 HEADLP 3262 HELLO 3254 HSDIV 7457 HSMUL 7400 HSMXIT 7446 IF 1005 IFGO 1176 IFGOTO 1050 IFLOOP 1043 IFRGHT 1040 IFSAVE 1053 IFTEST 1026 IFTRUE 1036 IMMDGO 7174 IMMED 0077 INCHAR 0067 INDXLK 1060 INDXLP 1102 INPRT 2200 INPUT 0150 INPXIT 6563 INST 6663 INSW 0037 INTEGR 7560 INTRO 4200 IOFIN 2420 IOFOUT 1361 KLEAR 0274 KLSPCE 0156 KSMA 3172 KSPA 3174 KSZA 3173 L01V10 3531 L01V20 3577 L01V30 3606 L01V40 3644 L02V10 3662 L02V20 3672 L02V30 3702 L02V40 3712 L02V50 3722 L02V60 3732 L03V10 3742 L03V20 4003 L03V30 4016 LEFT 2363 LEFTDL 2663 LESS 3120 LF 0101 LFECHO 0227 LFLOOP 0251 LFTYPE 0264 LINEND 0137 LINENO 0072 LINFND 2240 LINNEW 2557 LOCS 6072 LOOKLP 1407 LOOKOP 1630 LOOKPR 1766 LOOKVR 1405 MAKVAR 1452 MCOMMA 3212 MEDIFF 7453 MLTCND 7322 MODFLP 3077 MODFND 3116 MODIFC 0075 MODIFY 3050 MODPTR 2776 MODSCR 3106 MODTAB 2771 MOVELP 0316 MOVTXT 2144 MQA 7501 MQL 7421 MUL 6764 MULDNE 6761 MULLP 7410 N 6067 N10 0034 N100 0105 N114 6574 N12 0035 N14 7454 N140 2417 N144 6372 N2 0115 N20 0104 unreferenced N240 0120 N253 6573 N256 0121 N260 1556 N27 7455 N271 1557 N277 2375 N3 2373 N30 7456 N301 0116 N305 0106 N306 0623 N377 2555 N4 0016 N40 2374 N5 0124 N6 6371 NAMPT 2765 NCR 0122 NEGATE 0053 NEGF 7006 NEGO 7324 NEWCHN 2255 NEWDIG 6175 NEWGRP 0713 NEWHGH 1716 NEWLIN 0154 NEWOPR 0024 NEWPC 0023 NHGH 6070 unreferenced NLOW 6071 unreferenced NOECHO 0776 NOFRCT 6474 NOPARM 1774 NOR 6714 NORMAL 7526 NOSCI 6276 NOSUB 1433 NOSUBT 7502 NOZOT 6726 NOZVR 3213 NRMLP 7543 NRMXIT 7554 NRMZRO 7556 NUMBER 1740 NUMSGN 1270 NUMSRT 1560 NUNPRN 1673 NXTDIG 6152 OCOUTL 6117 OCTOUT 6112 ODIGOK 6316 OLDOPR 0057 OLDPC 0025 ONE 3043 OOPS 2606 OPALGN 7070 OPEXP 0041 OPHGH 0042 OPLOW 0044 OPMED 0043 OPRGHT 7150 OPRIGN 1731 OPROK 1655 OUTARG 2431 OUTDIG 3417 OUTZER 6217 P13 0000 PABS 0167 PACK 2506 PACK1 2526 PALIGN 6766 PARTIN 6135 PBADFN 4250 PC 0022 PCKXIT 2525 PCOMMA 0174 PDCOUT 6367 PDGCNT 6572 PDLPTR 0013 PDLUP 0537 PDO 1055 PDUMMY 0125 PERASE 3302 PEXEC 0176 PFAC 6704 PFACRT 0171 PFLOUT 6366 PFPMUL 6770 PFUNTB 4251 PGO 1054 PHSDIV 7321 PHSMUL 7323 PI 5755 PINTRO 0004 PKLEAR 3366 PNEGO 6767 PNORML 0166 PNOZVR 0175 PNWDIG 6451 PNXTDG 6374 POINT1 0030 POPF 0142 POPFAC 0345 POPRND 6705 POPRT 0173 POUTDG 6375 POWER 0033 PPRTIN 6571 PRNCHK 0160 PRTCL 0147 PSINTB 5760 PSTEP 1172 PSUM 0172 PTRUP 2126 PUNABS 0170 PUSHA 0140 PUSHAC 0525 PUSHF 0141 PUSHFC 0556 PUSHJ 0136 PUSHPC 0550 PUT 6666 PUTBEG 0027 PUTPTR 0010 PUTSDE 0065 PUTWRK 0064 PWRFIX 6542 PWRIGN 6510 PWRIN 6525 PWROK 6424 PZERO 0135 PZOTF 7320 QCKPTR 0011 QUEST 0114 QUOTE 1254 QUOTEL 1252 QUOTES 1245 QUOTSW 0026 R6L 0340 RANDOM 3333 RBOUT 2633 RBT 2556 RELCHK 3163 RELOGO 1376 RELOPR 3336 RESLT1 7245 RESLT2 7244 RESLT3 7243 RESLT4 7242 RETURN 2172 ROT6 0155 SAMENO 3061 SAVE1 0032 SAVEXP 6063 SAVFAC 6540 SAVHGH 6064 SAVLOW 6066 SAVMED 6065 SBCHNG 1466 SCHLP 1342 SCHTAB 1332 SCHXIT 1356 SCINOT 6267 SCRAP 0213 SCRBUF 3457 SCRLIM 0226 SCRTCH 0131 SEEKVR 1401 SEGSLV 1600 SET 1076 SETFOR 1056 SGNFIX 7246 SGNSET 7276 SHIFTL 2675 SIGNSW 0052 SINE 5705 SINLP 5722 SINPOS 5651 SKPGRP 0764 SMALL 6415 SOLVE 1451 SORTWK 0056 SPECHK 0741 SPNOR 1547 SQTLP 6024 SQTMRE 6056 SRTFUN 0162 SRTNUM 0157 START 0177 STEP1 1002 STTEXT 3530 SUB 6706 SUM 7127 TAB 1277 TABCTR 0061 TABDNE 1330 TABIT 1323 TABSCH 0145 TABTRY 1304 TEN 6577 TERTAB 2023 TEXTST 3525 TOOSML 6554 TRCESW 0103 TRCSWP 2343 TRMTAB 2000 TXTBEG 0132 TXTEND 0063 TYP 0066 TYPCHK 2471 TYPCHR 2010 TYPE 1202 TYPELF 1266 TYPFAC 0127 TYPGO 3441 TYPIGN 1275 TYPVAL 1241 UNABS 7344 UNFOR 1162 UNPACK 2306 UNPCK1 2353 UNPREN 1450 UNQTGO 2575 UNQUOT 7170 UPBAD 6744 UPPWR 6560 VARBLE 1617 VARBLS 2676 VAREND 0031 VARLEN 0073 VARNAM 3436 VARSCH 1437 WORK 0074 WRITE 0655 WRKPTR 0012 WRNGVR 1445 WRTCHK 0673 WRTDNE 0711 WRTELP 0657 WRTGRP 0707 WRTMRE 0704 XECUTE 3246 XEQLP 3243 XPN 6716 XPNLP 6754 XX 5747 YESDO 0505 ZERALL 3240 ZERLP 3227 ZERO 3045 ZEROVR 3224 ZOTFAC 6721 ZVR 1514 ZVRLP 1516 ZVRNXT 1527