Directory of image this file is from
This file as a plain text file
/FOCAL-8 REPLACE /DEC-08-LFRRA-A-LA1 /OCTOBER 1971 RM/SM /COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION / MAYNARD, MASSACHUSETTS 01754 /FOCAL IS A REGISTERED TRADEMARK OF /DIGITAL EQUIPMENT CORPORATION /ASSEMBLY INSTRUCTIONS: /.R PAL8 OR .R PAL10 /*REPLACE,REPLACE_REPLACE
NOPUNCH XLIST /NOTES ON LISTING COMMENTS: /THE LIMITS OF PAGE BOUNDARY WANDERING ARE DENOTED BY: /------------------------------------------------------------------- /PAGE BOUNDARY /------------------------------------------------------------------ /LOCATIONS OVERLAYED BY THE 8K OVERLAY ARE DENOTED BY /*8K* /PSEUDO-FLOATING POINT INSTRUCTIONS FIXMRI FPOW=5000 FIXMRI FADD=1000 FIXMRI FSUB=2000 FIXMRI FMUL=4000 FIXMRI FDIV=3000 FIXMRI FGET=0000 FIXMRI FPUT=6000 FNOR=7000 FEXT=0 FXIT=0 FINT=JMS I 7 RFC=6014 SMP=6101 KCF=6030
/MISCELLANEOUS ITEMS *1 JMP I .+2 /INTERRUPT PROCESSOR ENTRY . JMP I .+1 /(USED BY PDP-5) INTRPT DDTJR, DDTJR /USED FOR DEBUGGING P13, 13 /CONSTANT C100, 100 /CONSTANT T=0 /TEXT FIELD NUMBER *7 FPNT /ADDRESS OF FLOATING POINT INTERPRETER /AUTO-INDEX REGISTERS - (START OF SAVE BY QUAD) AXIN, 0 /STORAGE INDEX (LOC *10) XRT, 0 /EXTRA XR XRT2, 0 /EXTRA XR PDLXR, BEGIN-1 /PUSHDOWN LIST INDEX REGISTER. FLTXR, IOBUF-1 /XR FOR FLOATING POINT FLTXR2, 0 /EXTRA FOR F.P. TELSW, HLT /TELETYPE IN PROGRESS SWITCH TEXTP=. /TEXT POINTERS (LOC *17) AXOUT, FRSTX /OUTPUT INDEX XCT, 0 /UNPACK SWITCH GTEM, 0 /UNPACK STORAGE PC, FLTZER /PROGRAM COUNTER /*8K* THISLN, 0 /LINE POINTER FROM 'FINDLN' THISOP, 0 /CURRENT 'EVAL' OPERATION LASTLN, 0 /BACK POINTER FROM 'FINDLN' DEBGSW, 1 /DEBUG SWITCH ; NON-ZERO FOR LITERAL. PACKST, 0 /RUBOUT PROTECTION PT1, 0 /VARIABLE POINTER LASTV, BUFBEG /ADDRESS OF LAST VARIABLE /*8K* T1, 0 /TEMPORARY REGISTER - MAIN T3, 0 /TEMP REGISTER FOR OUTPUT INBUF, 0 /KEYBOARD INPUT BUFFER /**************************************************************** XLIST ENPUNCH /***************************************************************** *35 BOTTOM, FEXP-1 /********* /**************************************************************** NOPUNCH XLIST /***************************************************************** INSUB, 0 /0= GETC; #0 = READC HINBUF, 0 /HIGH SPEED INPUT BUFFER
/ *40 = FLOATING POINT *54 /VARIABLES - INITIALIZED FOR THE DIALOGUE SORTCN, 0 /NUMBER IN TABLE FROM SORTC LASTOP, 0 /LAST OPERATION FOR EVAL EFOP=. /FUNCTION CODE. ATSW, 0 /ASK-TYPE SWITCH CNTR, -20 /DELETE AND ERROR COUNTER(USED BY F.P. ALSO) STARTV=. /=END FOR 8K BUFR, BUFBEG /NEXT LOCATION IN BUFFER = LAST LOCATION OF TEXT/*8K* ADD, OUTL /CHAR. BUF. IN. (DEBUG AIDS.SEE BELOW.) XCTIN, I33 /PACK SWITCH OUTDEV, XOUTL /POINTER TO OUT. SUB. (OUTL)-FOR DEBUGGING INDEV, XI33 /POINTER TO IN. SUB. (I33)-FOR DEBUGGING NAGSW, 0001 /NOT ALL AND/OR GROUP SWITCH(4000=ONE;1=ALL;0=GROUP);(0000)-FOR TSS-8 CHAR, 215 /THE MOST IMPORTANT REGISTER LINENO, 0000 /LINE NUMBER READ BY GETLN;(0400)-FOR TSS-8 GINC, WORDS+2 /=6 FOR 4-WORD - CONSTANT T2, 0 /TEMP REGISTER - FOR NEW INST. ROUTINES. /FOR DEBUGGING, SET OUTL AND I33 INTO OUTDEV AND INDEV; /ALSO PATCH THE ERROR ROUTINE = FOUR /PATCHES PLUS TWO FOR THE HIGH SPEED READER. LIST6=. /INPUT LIST FOR "SFOUND". 214 /F.F. 207 /BELL LIST7=. 203 /CONTROL-C FOR DEBUGGING AND TSS8 P337, 337 /LEFT ARR CLF, 212 /L.F. LIST3=. /EXCRETION LIST CCR, 215 /LIST BRANCHER. DMPSW, HLT /(SEARCH CHARACTER)-VARIABLE /=0000 FOR TRACE ON. /THE REST OF PAGE ZERO IS PURE TO THE MULTI-USER SYSTEM
M100=. P7700, 7700 /LEFT MASK PER, 256 /PERIOD M77, -77 /EXTEND CODE TEST P7600, 7600 /GROUP MASK M20, -20 /CONSTANT P177, 177 /STEP MASK P17, 17 /BCD MASK P277, 277 /"?" M2, -2 /CONSTANT MINUSA, -301 /CONSTANT C260, 260 /ASCII FOR ZERO M240, -240 /SPACE TEST MPER, -256 /PERIOD TEST MCR, -215 /C.R. TEST MFLT, -WORDS /= -4 FOR 4-WORD M5, -5 /PAREN TEST M11, -11 /PAREN TEST P77, 77 /RIGHT MASK C200, 200 /CONSTANTS P4000, 4000 /NAGSW TEST CONSTANT (FOR PDP-5) FLARGP, FLARG /DATA ADDRESS PTCH, CHIN /GENERAL CHARACTER INPUT ROUTINE. DOUBLE, MULT2 /MULTIPLY FLAC BY 2 FOUTPUT,FLOUTP /FLOATING OUTPUT FINPUT, FLINTP /FLOATING INPUT COMBUF, COMEIN /COMMAND BUFFER START /*8K* CFRS, FRST /ADDRESS OF DUMMY LINE /*(K* END, COMEIN /FIRST LOCATION USED IN 8K. ENDT, BUFBEG /START OF STORAGE AREA /*8K* EFUN3I, EFUN3 /FUNCTION RETURN CFRSX, FLTZER /POINTER TO ZERO DATA /'FINPUT' USES CHAR AND GETC OR READC TO DEVELOP /A NUMBER WHICH IS THEN STORED VIA PT1. WORDS=3 /OR 4
/NEW INSTRUCTIONS: PUSHJ=JMS I . /RECURSIVE SUBROUTINE CALL XPUSHJ POPA=TAD I PDLXR/RESTORE AC POPJ=JMP I . /SUBROUTINE RETURN XPOPJ PUSHA=JMS I . /SAVE AC XPUSHA PUSHF=JMS I . /SAVE GROUP OF DATA PD2 POPF=JMS I . /RESTORE GROUP PD3 GETC=JMS I . /UNPACK A CHARACTER UTRA PACKC=JMS I . /PACK A CHARACTER PACBUF SORTJ=JMS I . /SORT AND BRANCH ON AC OR CHAR SORTB SORTC=JMS I . /SORT CHAR XSORTC PRINTC=JMS I . /PRINT AC OR CHAR OUT READC=JMS I . /READ DATA INTO CHAR AND PRINT IT RDIV, CHIN PRNTLN=JMS I . /PRINT C(LINENO) XPRNT GETLN=JMS I . /UNPACK AND FORM A LINENUMBER XGETLN FINDLN=JMS I . /SEARCH FOR A GIVEN LINE XFIND ENDLN=JMS I . /INSERT LINE POINTERS XENDLN RTL6=JMS I . /ROTATE LEFT SIX XRTL6 SPNOR=JMS I . /IGNORE SPACES AND LEADING ZEROS XSPNOR TESTN=JMS I . /PERIOD; OTHER; NUMBER XTESTN TSTLPR=JMS I . /SKIP IF 5<SORTCN<= 11 (I.E. AN L-PAR) LPRTST TSTGRP=JMS I . /SKIP IF G(AC) = G(LINENO) GRPTST TESTC=JMS I . /TERM; NUMBER; FUNCTION; LETTER- AND IGNORE SPACES. XTESTC DELETE=JMS I . /REMOVE OLD TEXT LINE PSIN, XDELETE ERROR2=JMS I . /EXCESS SOMETHING ERROR ERROR3=JMS I . /MISCELLANEOUS ERROR ERROR4=JMS I . /FORMAT ERROR ERR2 /167-174 ARE USED BY 8K OVERLAY /*8K* /175 IS USED BY QUAD
/COMMAND/INPUT DRIVER *176 BEGIN /BECOMES XINT-3 START, SKP CLA /PROGRAM START FROM SELF JMP I .-2 /CONSOLE START: SW=200 /*8K* TAD CFRSX /(PC) => 0 DCA PC /FOR COMMAND MODE IAC /USE ONE IN THE AC TO DCA DMPSW /INIT UNPACK AND TRACE SWITCH DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?) TAD COMBOT /PROTECT COMMAND BUFFER DCA PDLXR /NO PATCH TEST TAD CSTAR /TYPE * TO INDICATE COMMAND MODE PRINTC IBAR, TAD COMBUF /INITIALIZE COMMAND BUFFER DCA AXIN /FOR UNPACKING DCA XCTIN TAD COMBUF /RUBOUT PROTECTION DCA PACKST IGNOR, READC /READ COMMAND STRING SORTJ LIST7-1 INLIST-LIST7 PACKC /SAVE STRING CHARACTER. JMP IGNOR CSTAR, 252 /ACKNOWLEDGE CHARACTER COMBOT, COMEOUT+12 /END OF COMMAND BUFFER,LESS PROTECTION COUNT/*8K*
/COMMAND/INPUT PROCESSOR IRETN, PACKC /START TO PACK C.R. PACKC /FINISH C.R. TAD COMBUF /INITIALIZE "TEXTP" GONE, DCA AXOUT /SETUP CURRENT LINE DCA XCT GETC /READ FIRST CHARACTER. TAD BOTTOM /INIT PUSH-DOWN-LIST DCA PDLXR SPNOR /IGNORE LEADING BLANKS TESTN /DOES THE LINE BEGIN WITH 1-9? JMP GZERR /PERIOD =ILLEGAL GROUP ZERO USAGE JMP INPUTX /NO ISZ DEBGSW /YES,DISABLE TRACE FOR REPACKING GETLN /READ THIS LINE NUMBER TAD P4000 /TEST FOR SINGLE LINE. TAD NAGSW SZA CLA ERROR3 /ILLEGAL LINE NUMBER ON INPUT TAD BUFR /SET POINTERS DCA AXIN DCA XCTIN TAD LINENO /SAVE LINE # DCA I AXIN /*8K* SPNOR /IGNORE SPACES AFTER LINE NUMBER SKP GETC /READ 1ST AFTER LINENO TERMINATOR. SRETN, PACKC /SAVE TEXT AND RESTORE DATA FIELD TAD CHAR /TEST FOR END OF INPUT STRING TAD MCR SZA CLA JMP .-5 DELETE /REMOVE OLD LINE, IF ANY. ENDLN /INSERT NEW LINE JMP START /POINTERS MUST BE REINITIALIZED INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND. PROC TAD I PC /CHECK NEXT LINE /*8K* SNA /END OF PROGRAM? JMP START /YES DCA PC /SAVE NEW LINE NO. TAD PC /START NEW LINE IAC JMP GONE /PROCESS OTHER COMMANDS /TEXT LINE BUFFER FORMAT* /#1 : POINTER OR ZERO IN LAST /#2 : LINENO /#3 - #N+1 : TEXT /#N : C.R.
/LINE NUMBER FORMATION XGETLN, 0 /DEVELOP I.D. - "GETLN" SPNOR /IGNORE LEADING SPACES. TAD CHAR /"ALL" IS A SPECIAL ARGUMENT. TAD MINUSA SNA CLA JMP TESTA DCA INSUB /CALL 'GETC' FROM 'INPUT' VIA 'DECON' JMS I LCON /(DECONV - IN FLOAT.) TAD FLAC+3 /GROUP TOO LARGE? AND P7740 TAD FLAC+2 SZA CLA ERROR2 /GROUP NUMBER TOO LARGE TAD FLAC+3 RTL6 RAL TESTA, DCA LINENO TESTN /TEST3 GETC /READ STEP NUMBER. TESTN /TEST4, OTHER JMP GERR /DOUBLE PERIODS JMP GEXIT /OTHER TAD SORTCN /NUMBER RTL CLL TAD SORTCN RAL TAD LINENO DCA LINENO GETC /READ SECOND STEP NUMBER. TESTN /TEST4, OTHER GERR, ERROR4 /DOUBLE PERIODS JMP GEXIT /OTHER TAD SORTCN /NUMBER TAD LINENO DCA LINENO GETC /TEST FOR CORRECT TERMINATOR TESTN /CHECK SIZE JMP GERR /. SKP ERROR2 /TOO LARGE A LINE NUMBER.
GEXIT, CLL /CLEAR LINK BIT TAD LINENO /TEST FOR GROUP NUMBER. AND P7600 SZA CLA CML TAD LINENO AND P177 /REPARE "NAGSW" SNL SZA GZERR, ERROR2 /0.X = ERROR:ILLEGAL LINE NUMBER. SZA CLA TAD P2000 CML RAL DCA NAGSW JMP I XGETLN /--RETURN-- LCON, DECONV P7740, 7740 P2000, 2000 /--------------------------------------------------------------------- /RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 31.99 /NAGSW: /GROUP=0000 /LINE=4000 /ALL=0001 /LIST OF FUNCTION ADDRESSES. (NAMES ARE IN "FNTABL") FNTABF=. XABS /FABS -ABSOLUTE VALUE XSGN /FSGN -SIGN PART XINT /FITR -INTEGER PART ERROR5 /FY (USER DEFINED) XRAN /FRAN -RANDOM NUMBER ERROR5 /FZ (USER DEFINED) /****************************************************************** XLIST ENPUNCH *402 /******************************************************************* ARTN /FATN -ARCTANGENT FEXP /FEXP -E^X FLOG /FLOG -LN(X) FSIN /FSIN -SINE FCOS /FCOS -COSINE /**************************************************************** NOPUNCH XLIST /******************************************************************** XSQRT /FSQT -SQUARE ROOT ERROR5 /FNEW (USER DEFINED) ERROR5 /FCOM (LIBRA OR USER DEFINED) ERROR5 /FX (USER DEFINED) /----------------------------------------------------------------------- XRTL6, 0 /ROTATE AC LEFT SIX - "RTL6" CLL RTL RTL RTL JMP I XRTL6 /--RETURN--
/RECURSIVE OPERATE, EXECUTE, OR CALL DO, GETLN /EXECUTE ONE LINE, A GROUP,OR ALL TAD PC /SAVE ADDRESS PUSHA /OF CURRENT LINE PUSHF /SAVE REST OF THIS LINE TEXTP /ADDRESS OF TEXT POINTERS DGRP, PUSHF /SAVE NAGSW; CHAR; AND LINENO. NAGSW TAD NAGSW /CHECK DATA FROM GETLN. SPA CLA /SKIP IF GROUP OR ALL JMP DOONE /DO ONE LINE FINDLN /INIT FOR GROUP AND SET THISLN NOP TAD THISLN /TEST FOR GOOD GROUP NUMBER. DCA XRT TAD I XRT /*8K* TSTGRP ERROR2 /NO SUCH GROUP NUMBER DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC. PROCESS-2 POPF /RESTORE THE DATA NAGSW TAD I PC /CHECK FOR END OF TEXT /*8K* SNA JMP DCONT /ALL DONE IAC DCA PT1 /SAVE POINTER TO LINENO TAD NAGSW /CHECK FOR GROUP SMA SZA CLA JMP .+4 /DO ALL TAD I PT1 /TEST GROUP /*8K* TSTGRP JMP DCONT /NOT IN GROUP TAD I PT1 /READ NEXT LINE NO. /*8K* DCA LINENO JMP DGRP /CONTINUE THE SUBROUTINE DOONE, FINDLN /FIND THE LINE ERROR2 /NO SUCH LINE NUMBER PUSHJ /EXECUTE IT PROCESS POPF /RESTORE CHAR NAGSW DCONT, POPF /RESTORE TEXT POINTERS TEXTP POPA /RESTORE ADDRESS OF CURRENT LINE. DCA PC JMP I .+1 /CONTINUE PROCESSING THIS LINE. PROC
/PUSHDOWN LIST CONTROLS XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA" DCA T2 /BACKUP POINTER CMA /AND THEN JMS PCHK /CHECK CORE USAGE TAD T2 /OK DCA I PDLXR /PUSH DOWN LIST POINTER CMA /BACKUP AGAIN JMS PCHK JMP I XPUSHA /--RETURN-- PCHK, 0 TAD PDLXR /INC IN AC DCA PDLXR TAD PDLXR CIA CLL TAD LASTV SZL CLA ERROR3 /STORAGE FILLED BY PUSH-DOWN LIST JMP I PCHK /--RETURN-- XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ" TAD I XPUSHJ DCA T2 /SAVE SUBR. ADDR. CMA JMS PCHK TAD XPUSHJ IAC DCA I PDLXR /SAVE RETURN CMA JMS PCHK JMP I T2 /TRANSFER CONTROL PD2, 0 /SAVE A FLOATING POINT NUMBER - "PUSHF" CLA CMA /COMPUTE VARIABLE ADDR TAD I .-2 DCA XRT ISZ PD2 /FIX RETURN TAD MFLT /COMPUTE PUSH. POINTER JMS PCHK TAD MFLT DCA T2 TAD I XRT DCA I PDLXR ISZ T2 JMP .-3 TAD MFLT /RESET POINTER JMS PCHK JMP I PD2 /--RETURN--
PD3, 0 / RESTORE A FLOATING POINT NUMBER - "POPF" CLA CMA /GET VAR. ADDR. TAD I PD3 ISZ PD3 DCA XRT TAD MFLT DCA T2 TAD I PDLXR /MOVE DCA I XRT ISZ T2 JMP .-3 JMP I PD3 /--RETURN-- /-------------------------------------------------------------------- INLIST=. /INPUT CONTROL CHARACTERS XINT-4 /CTRL/C = BREAK IBAR /B.A. = RESTART IGNOR /L.F. = IGNORE IRETN /C.R. = TERMINATE STRING FLIST2, FLIMIT /,=STANDARD FINFIN /;=SHORT ERROR5 /CR=DUMB FLIST1, FINCR /,=STANDARD FORMAT PROCESS /;=SET;PLUS ,.. PC1 /C.R.=SET COMMAND. MF, -306 /USED BY TESTC
/PRIMARY CONTROL AND TRANSFER GOTO, GETLN /READ THE LINE NUMBER REQUESTED FINDLN /LOCATE IT AND RESET TEXTP ERROR2 /NOT THERE TAD THISLN /SET PC DCA PC /--------------------------------------------------------------------- PROCESS,GETC /TEST FOR END OF LINE PROC, TAD CHAR /FIRST CHARACTER READY = USE PROC TAD MCR SNA CLA PC1, POPJ /EXIT "PROCESS" SORTC /IGNORE "SPACE",",", AND ";". GLIST-1 JMP PROCESS TAD CHAR /SAVE COMMAND CHARACTER AND P337 /EXECUTE LOWER CASE ALSO PUSHA GETC /GO TO TERMINATOR SORTC GLIST-1 SKP JMP .-4 POPA SORTJ /GO DO COMMAND COMLST-1 COMGO-COMLST ERROR2 /ILLEGAL COMMAND COMMENTS=PC1 /ALSO IS CONTINUE
/OUTPUT COMMAND TEXT WRITE, GETLN /SET LINENO ISZ DEBGSW /DISABLE TRACE FINDLN /SEARCH FOR LINE NUMBER JMP WTESTG /NOT THERE OR GROUP TAD LINENO SZA CLA PRNTLN /PRINT LINE NUMBER AND A SPACE. GETC PRINTC /PRINT TEXT OF A LINE. TAD CHAR TAD MCR SZA CLA /SKIP IF END OF LINE JMP .-5 TAD I THISLN WTEST2, SNA JMP WX-2 IAC DCA PT1 /SAVE POINTER TO LINENO OF NEXT TAD NAGSW SMA CLA TAD I PT1 /*8K* TSTGRP /TRY NEXT LINENO FOR GROUP. JMP WX WALL, TAD I PT1 /SET LINEN /*8K* DCA LINENO JMP WRITE+2 WTESTG, TAD THISLN /INIT GROUP PRINTOUT JMP WTEST2 DCA DEBGSW POPJ WX, TAD NAGSW SPA SNA CLA /SKIP IF ALL JMP WX-2 PRINTC /PRINT C.R. AGAIN JMP WALL
XTESTC, 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC" SPNOR /IGNORE SPACES SORTC /TEST THE VARIABLE TERMINATORS TERMS-1 JMP I XTESTC /YES - SORTCN IS SET--RETURN-- TAD CHAR /NO ISZ XTESTC TAD MF SNA CLA /TEST FOR "F" JMP XT3 TESTN JMP I XTESTC /.--RETURN-- SKP /OTHER JMP I XTESTC /NUMBER--RETURN-- ISZ XTESTC XT3, ISZ XTESTC /RETURNS:T;N;F;A JMP I XTESTC /--RETURN-- XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORTC" TAD I XSORTC DCA XRT2 /1ST ARG IS LIST-1 TAD I XRT2 SPA /LIST IS ENDED BY A NEGATIVE NUMBER JMP SEXC /2AND EXIT = NOT IN LIST CIA TAD CHAR SZA CLA /COMPARE JMP .-6 TAD I XSORTC /COMPUTE INCREMENT : 0 - N CMA TAD XRT2 DCA SORTCN SKP /1ST EXIT = YES SEXC, ISZ XSORTC ISZ XSORTC CLA CLL JMP I XSORTC /--RETURN--
GRPTST, 0 /AC VS LINENO - "TSTGRP" AND P7600 CIA DCA T2 TAD LINENO AND P7600 TAD T2 SNA CLA ISZ GRPTST JMP I GRPTST /--RETURN-- /INPUT FROM TEXT OR KEYBOARD; /IF BACK-ARROW, RESTART INPUT INPUT, 0 /INPUT A CHARACTER TAD INSUB /NON-ZERO FOR KEYBOARD SZA CLA JMP .+3 GETC JMP I INPUT /--RETURN-- READC SORTJ SPECIAL-1 INFIX-SPECIAL JMP I INPUT /--RETURN-- /---------------------------------------------------------------------- ILIST, IF1 /, PROCESS /; PC1 /CR /ENGLISH-FRENCH COMLST=. /COMMAND DECODING LIST 323 /SET - ORGANIZE 306 /FOR - QUAND 311 /IF - SI 304 /DO - FAIZ 307 /GOTO - VA 303 /COMMENT- COMMENTE 301 /ASK - DEMANDE 324 /TYPE - TAPE 314 /LIBRARY- ENTREPOSE 305 /ERASE - BIFFE 327 /WRITE - INSCRIS 315 /MODIFY - MODIFIE 321 /QUIT - ARRETE 322 /RETURN - RETOURNE 212 /(ASTERISK)=EXPANDABLE COMMAND /THIS COMMAND LIST IS SPEED OPTIMIZED.
/CONDITIONAL TRANSFER PROCESS. IF, TESTC /IGNORE SPACES AND TEST /--------------------------------------------------------------------- JMS I IECALL /T ISZ PDLXR /N-DUMP THE (EFOP) JMS I IPART /F-CHECK FOR PAREN MATCH TAD M2 /A DCA T1 TAD FLAC+1 /TEST -,0,+ SPA ISZ T1 /N-TO -1,-2,-3 SPA SNA CLA IF3, ISZ T1 /COUNT COMMAS SKP JMP I COMGO+4 /TRANSFER SORTJ /SEARCH TEXT UNTILL ,;C.R. TLIST-1 ILIST-TLIST GETC JMP .-4 IF1, GETC /MOVE PAST COMMA JMP IF3 IECALL, ECALL IPART, PARTEST
/LOOP CONTROL STATEMENT SET=. /SUBSET OF "FOR". FOR, PUSHJ /LOOPS, ETC. GETARG /LOOK FOR "=" NEXT SPNOR /IGNORE SPACES TAD CHAR TAD MEQ SZA ERROR4 /LEFT OF "=" IN ERROR: 'FOR' OR 'SET' TAD PT1 PUSHA /SAVE POINTER TO VARIABLE PUSHJ EVAL-1 /GET INITIAL VALUE EXPRESSION POPA DCA PT1 FINT /INITIALIZE NOW. FPUT I PT1 FXIT SORTJ /TEST LAST CHAR FROM "EVAL" TLIST-1 FLIST1-TLIST ERROR4 /EXCESS R-PAR FINCR, TAD PT1 /SAVE VARIABLE ADDRESS * PUSHA PUSHJ /EVALUATE THE INCREMENT,IF ANY. EVAL-1 SORTJ /TEST TERMINATORS TLIST-1 FLIST2-TLIST ERROR4 /ILLEGAL TERMINATOR IN 'FOR' FLIMIT, PUSHF /SAVE THE INCREMENT. * FLARG PUSHJ /GET THE LIMIT(NO ERROR DETECTION AFTER LIMIT) EVAL-1 FCONT, PUSHF /SAVE THE LIMIT * FLARG PUSHF /SAVE TEXT OF OBJECT STATEMENTS TEXTP PUSHJ /DO THE OBJECT STATEMENTS PROCESS POPF /RESTORE REMAINING TEXT. TEXTP POPF /GET LIMIT FLARG POPF /GET INCREMENT ITER1 POPA /GET VARIABLE ADDRESS DCA PT1
FINT /INCREMENT AND TEST FGET I PT1 /LOAD THE VARIABLE FADD I FINKP /INCREMENT IT FPUT I PT1 /CHANGE IT FSUB I FLARGP /TEST IT FXIT TAD FLAC+1 SMA SZA CLA POPJ /END OF LOOP TAD PT1 PUSHA /SAVE ADDRESS * PUSHF /SAVE INCREMENT AGAIN * FINKP, ITER1 JMP FCONT MEQ, -275 MCOM, -254 FINFIN, PUSHF /SET INCREMENT TO ONE. FLTONE JMP FCONT /PATCH TO WRITE ROUTINE /INSERTS 2 NULL CHARACTERS (CODE 200) / AFTER EACH OUTPUT CARRIAGE RETURN XDYS, TAD C200 /OUTPUT NULL CHARACTER PRINTC TAD C200 PRINTC TAD I THISLN /*8K* SNA /XDYS+5 JMP I .+2 JMP I .+2 WX-2 WTEST2+2 /-------------------------------------------------------------------- /CTRL/C HANDLER TAD C200 DCA LINENO JMP I .+1 RECOVR+1 /TAKE THE INTEGER PART XINT, JMS I INTEGER /(FIX) CLA JMP I EFUN3I
COMGO=. /COMMAND ROUTINE ADDRESSES SET FOR IF DO GOTO /(REFERENCED) COMMENT ASK TYPE LIBRARY ERASE WRITE MODIFY START /RETURN TO COMMAND MODE VIA 'QUIT' RETRN HSPX /ACTIVATE THE HIGH SPEED READER /--------------------------------------------------------------------- /INPUT-OUTPUT STATEMENTS ASK, CLA CMA /REMEMBER WHICH CALL. TYPE, DCA ATSW TASK, SORTJ /SPECIAL CHARACTER? ALIST-1 ATLIST-ALIST ISZ ATSW /TEST QUOTE SWITCH JMP TYPE2 PUSHJ /DO ASK; SETUP PT1 GETARG TAD CHAR /SAVE IN-LINE CHARACTER. PUSHA TAD COL /TYPE COLON PRINTC /(CLA)- TO SUPRESS ":" ISZ INSUB /INDICATE 'READC' IAC /POINT PAST CHAR JMS I FINPUT /READ DATA AND SAVE POPA /RE-TEST LAST TERMINATOR DCA CHAR JMP ASK /CONTINUE PROCESSING TYPE2, PUSHJ /DO TYPE EVAL JMS I FOUTPUT /PRINT JMP TYPE
TQUOT, ISZ DEBGSW /DISABLE TRACE GETC /TYPE LITERALS SORTJ TLIST2-1 TLIST3-TLIST2 PRINTC JMP TQUOT+1 TINTR, GETC /PASS PERCENT SIGN GETLN /READ FORMAT CONTROL: "%7.03" TAD LINENO DCA FISW /SAVE FORMAT CODE JMP TASK TCRLF2, TAD CCR /SPLAT=CR ALONE JMS I OUTDEV IAC /NON-PRINTING DELAY FOR CR (216) TCRLF, TAD CCR /EXCLAMATION POINT=CR,LF. PRINTC TASK4, DCA DEBGSW /RE-ENABLE THE TRACE GETC /MOVE TO NEXT CHARACTER JMP TASK COL, 272 /":" /IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW" / #0: DISABLE AND RETURN ALL"?" ' S. /IF DMPSW = 0: TRACE ON, IF ENABLED / #0: TRACE OFF /IF BOTH = 0 : PRINT TRACE.
/SEARCH ROUTINES MODIFY, GETLN /READ LINE NO. FINDLN /LOOK IT UP NOW. ERROR2 /NOT THERE = BAD COMMAND UNLESS ZERO. TAD BUFR /SET POINTERS DCA AXIN /FOR INPUT DCA XCTIN TAD LINENO /COPY THE SAME LINE NUMBER. DCA I AXIN /*8K* TAD AXIN /SAVE START OF NEW LINE DCA PACKST SCONT, JMS I INDEV /READ THE TELETYPE INPUT SILENTLY. DCA LIST3+1 /SAVE SEARCH CHARACTER ISZ DEBGSW /NO BREAKS. SCHAR, GETC /TYPE+TEST-F.F. PRINTC /PLAYBACK THE TEXT SORTJ /LOOK FOR MATCH LIST3-1 LISTGO-LIST3 PACKC /SAVE NEW LINE. JMP SCHAR SBAR, TAD BUFR /RESTART-B.A. IAC DCA AXIN /SET POINTERS DCA XCTIN SFOUND, READC /READ FROM KEYBOARD SORTJ /TEST LIST6-1 SRNLST-LIST6 SGOT, PACKC /PACK CHAR. JMP SFOUND /MORE
SORTB, 0 /SORT AND BRANCH ROUTINE. - "SORTJ" SNA TAD CHAR /ASSUME CHAR IF AC=0 CIA DCA T2 /SAVE SORT ITEM TAD I SORTB /FIRST ARG IS LIST LESS ONE ISZ SORTB /2AND IS INTRA-LIST LENGTH DCA XRT2 TAD I XRT2 SPA /**LISTS ENDED BY NEGATIVE NUMBERS** JMP SEX /READ EXIT TAD T2 /FIND ADDRESS SZA CLA JMP .-5 TAD XRT2 /MATCH FOUND. TAD I SORTB DCA T2 TAD I T2 DCA T2 /DEBUG : AC = ADDRESS JMP I T2 SEX, ISZ SORTB /MATCH NOT FOUND. CLA CLL JMP I SORTB /--RETURN-- /OUTPUT CARRIAGE RETURN BEFORE ERROR MESSAGE XADC, TAD CCR /OUTPUT CARRIAGE RETURN/LINE FEED PRINTC TAD P277 /OUTPUT QUESTION MARK PRINTC JMP I .+1 RECOVX+4 7600 /XADC+6 USED BY L COMMAND HLT HLT
OUTL, 0 /SLOW OUTPUT FOR ODT SYNCRONIZATION TLS /AND FOR H.S. PUNCH PLS TSF /IOT FOR SLOWEST DEVICE JMP .-1 CLA JMP I OUTL /--RETURN-- /---------------------------------------------------------------------- SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE SCHAR /F.F. = CONTINUE SCONT /BELL = CHANGE SEARCH CHARACTER XINT-4 /CTRL/C = BREAK SBAR /B.A. = RESTART SCONT+1 /L.F. = FINISH THE LINE AS BEFORE. LISTGO=. SRETN /C.R. = END THE LINE HERE AS IS. SGOT /CHAR = SEARCH CHARACTER ALIST=. / ASK/TYPE LIST OF CONTROLS. 245 /% 242 /" 241 /! 243 /# 244 /$ GLIST=. 240 /SPACE TLIST=. 254 /, 273 /; 215 /C.R. /THIS LIST IS ENDED BY 'TESTC'.
/FIND OR ENTER A VARIABLE IN THE LIST. GETARG, TESTC /FIRST LETTER OF ARG TLIST2, 0242 /" 0215 /C.R. - FUNCTION OR NUMBER IS NOT AN ARG. ERROR4 /BAD ARGUEMENT IN 'FOR', 'SET', OR 'ASK' GETVAR, DCA XCTIN /PACK INTO ADD. PACKC GETC /SECOND LETTER SORTC /TERMINATOR? TERMS-1 /---------------------------------------------------------------------- JMP GSERCH /YES TAD CHAR /NO AND P77 /SAVE 2AND LETTER OF NAME TAD ADD DCA ADD GETC /IGNORE THE REST SORTC TERMS-1 JMP GSERCH JMP .-4 GSERCH, TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN JMP GS1 /NOT SUBSCRIPTED BY L-PAR. TAD ADD /SAVE NAME DCA EFOP /FOR RECURSIVE AND ERROR CHECK JMS I GECALL /TO EVAL POPA DCA ADD /RESTORE NAME JMS I PTEST /TEST PAREN MATCH, ETC. JMS I INTEGER /CONVERT TO 12-BIT NUMBER. GS1, DCA SUBS /SAVE SUBSCRIPT TAD STARTV /SEARCH FOR VARIABLE /*8K* GS3, DCA PT1 TAD PT1 CIA TAD LASTV /TEST FOR END OF LIST SPA SNA CLA JMP GS2 /END SEARCH TAD I PT1 /GET TABLE ENTRY CIA TAD ADD SNA CLA JMP GFND1 /FOUND XX GS4, TAD PT1 /TRY NEXT ONE TAD GINC JMP GS3 PTEST, PARTEST GECALL, ECALL
GS2, TAD LASTV /ADD THE VARIABLE TAD P13 /TEST STORAGE LIMITS CIA CLL TAD PDLXR SNL CLA ERROR3 TAD LASTV /UPDATE THE LIST. TAD GINC DCA LASTV TAD ADD /SAVE NAME DCA I PT1 ISZ PT1 /SAVE SUBSCRIPT TAD SUBS DCA I PT1 ISZ PT1 /SET PT1 FINT FGET I CFRSX FPUT I PT1 FXIT POPJ /EXIT GFND1, TAD PT1 /FOUND SAME DCA XRT /TEST SUBSCRIPTS TAD I XRT CIA TAD SUBS SZA CLA JMP GS4 /WRONG SUBSCRIPT ISZ PT1 /SET POINTER TO DATA ISZ PT1 POPJ
SUBS=. XSPNOR, 0 /IGNORE LEADING SPACES - "SPNOR" TAD CHAR TAD M240 SZA CLA JMP I XSPNOR /--RETURN-- GETC JMP XSPNOR+1 M260, -260 M271, -271 RANO, 0000 /RANDOM NUMBER STORAGE! 2000 0000 XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN" TAD CHAR TAD MPER SZA CLA ISZ XTESTN TAD CHAR TAD M260 DCA SORTCN /SAVE VALUE OF THE NUMBER TAD SORTCN /TEST IF REALLY A DIGIT. SPA CLA JMP I XTESTN /--RETURN-- TAD CHAR TAD M271 SPA SNA CLA ISZ XTESTN /IF A NUMBER JMP I XTESTN /--RETURN-- XRAN, FINT /PSEUDO-RANDOM NUMBER GENERATOR. FADD RANO /ADD RUNNING RESULT TO THE ARGUMENT, IF ANY. FMUL .-5 /BLAST THE ARGUMENT FPUT RANO FXIT DCA RANO /CONVERT TO .5 THROUGH .999 /---------------------------------------------------------------------- DCA FLAC /SAME AS RETURN JMP I EFUN3I
/EXIT FROM A "DO" SUBROUTINE RETRN, TAD CFRSX /(PC) => 0 /*8K* DCA PC XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ" DCA T2 JMP I T2 ATLIST=. /ASK-TYPE CONTROL CHARACTER TABLE TINTR /% - FORMAT DELIMITER TQUOT /" - LITERAL DELIMITER TCRLF /! - CARRIAGE RETURN AND LINE FEED TCRLF2 /# - CARRIAGE RETURN ONLY TDUMP /$/- DUMP THE SYMBOL TABLE CONTENTS TASK4 /SP- TERMINATOR FOR NAMES TASK4 /, - TERMINATOR FOR EXPRESSIONS PROCESS /; - TERMINATOR FOR COMMANDS PC1 /C.R. - TERMINATOR FOR STRINGS /$ - FOR 'TDUMP' TERMINATES THE COMMAND.
/EVALUATE AN EXPRESSION WHICH /TERMINATES WITH AN R-PAR,; OR C.R. AND /LEAVE THE RESULT IN FLAC AND IN FLARG. /---------------------------------------------------------------------- ECALL, 0 /RECURSIVE CALL TO "EVAL" TAD SORTCN /SAVE 'SORTCN','LASTOP',AND 'EFOP' PUSHA TAD LASTOP PUSHA TAD EFOP /SAVE FUNCTION CODE. PUSHA TAD ECALL /RETURN TO CALLING PUSHA /ADDRESS AFTER NEXT POPJ GETC /MOVE PAST EXTRA CHARACTER EVAL, DCA LASTOP /EVAUATION CONTROLLER (CHECKPOINT ?) TESTC /TEST CHARACTER AND IGNORE SPACES JMP ETERM1 /TERMINATOR JMP ENUM /NUMBER JMP EFUN /FUNCTION PUSHJ /LETTER OF VARIABLE GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1. OPNEXT, TESTC /PT1=>ARG JMP ETERMN /T ECHOLST,0212 /N-ERROR IN FORMAT 0377 /F ERROR4 /L - MISSING OPERATOR ETERM1, TAD CFRSX /SET PT1. DCA PT1 /TO POINT TO ZERO TAD M2 /TEST FOR UNARY OPERATIONS TAD SORTCN SNA JMP ETERM /CREATE DUMMY FOR UNARY MINUS IAC SNA CLA JMP ARGNXT /IGNORE UNARY PLUS TAD SORTCN /TEST FOR NULL PARENS. TAD M11 SPA CLA JMP ELPAR /MIGHT BE AN L-PAR. ETERMN, TSTLPR SKP ERROR4 /OPERATOR MISSING BEFORE PAREN ETERM, TAD SORTCN /SET FROM "TESTC"-"SORTC" DCA THISOP TAD THISOP TAD M11 SMA CLA /END? DCA THISOP /"THISOP" EQUIV. TO END OF EXP.
ETERM2, TAD THISOP /COMPARE PRIORITIES CIA TAD LASTOP SPA CLA JMP EPAR /CONTINUE TAD LASTOP /FIND OPERATION CLL RTR RTR TAD OPTABL DCA FLOP TAD LASTOP SZA CLA /TEST FOR END OF DATA INTO FLOATING AC. POPF /GET LAST DATA FLAC FINT FLOP, 00 /(FLOPR I PT1)+-*/ FPUT I FLARGP /SAVE RESULT FXIT TAD FLARGP DCA PT1 TAD THISOP TAD LASTOP /=0? SNA CLA POPJ /EXIT "EVAL" POPA /GET PRIOR OP DCA LASTOP JMP ETERM2 /COMPARE THIS OP EPAR, TSTLPR /TEST FOR SUB-EXPRESSION SKP JMP EPAR2 /GO EVALUATE EXPRESSION TAD LASTOP /CONTINUE READING THE EXPRESSION PUSHA /SAVE "LASTOP". TAD PT1 DCA .+2 PUSHF /SAVE LAST ARGUMENT 00 TAD THISOP /MORE TO COME DCA LASTOP ARGNXT, GETC /READ 1ST CHAR OF AN ARG. TESTC /DO SPECIAL CHECK JMP ELPAR /COULD BE LEFT PAREN JMP ENUM /N JMP EFUN /F JMP OPNEXT-2 /L OPTABL, FGET I PT1 /BASE FOR OPERATION COMPUTATION
ENUM, PUSHF /TO PROCESS A NUMBER,SAVE AC FLAC TAD FLARGP /SET POINTER AS FOR A VARIABLE. DCA PT1 DCA INSUB /POINT TO 'GETC' AND USE CHAR JMS I FINPUT /READ TEXT NUMBER => (PT1) POPF /RESTORE THE AC FLAC JMP OPNEXT /CONTINUE EFUN, DCA EFOP /SET CODE GETC /READ FUNCTION NAME.(1,2,OR 3 LETTERS) SORTC /LOOK FOR TERMINATION CHARACTER. TERMS-1 JMP EFUN2 /YES TAD EFOP /NO CLL RAL /MISH-MASH HASH CODE TAD CHAR JMP EFUN EFUN2, TSTLPR ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT JMS ECALL /CALL "EVAL" TO COMPUTE ARGUMENT POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I. SORTJ FNTABL-1 FNTABF-FNTABL ELPAR, TSTLPR /LEFT PAREN OR FELL THROUGH FUNCTION TABLE ERROR4 /DOUBLE OPERATORS OR ILLEGAL FUNCTION NAME. EPAR2, JMS ECALL /EVALUATE NESTED EXPRESSION /-------------------------------------------------------------------- ISZ PDLXR /DUMP EXTRA ARG. JMP I EFUN3I
TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR' 240 /SPACE 0 253 /+ 1 255 /- 2 257 // 3 252 /* 4 336 /UP ARR 5 250 /( 6 L-PARS 333 /[ 7 274 /< 10 251 /) 11 R-PARS 335 /] 12 276 /> 13 254 /, 14 273 /; 15 215 /C.R. 16 275 /= TO END GETARG FROM 'SET' /TWO MINOR FUNCTIONS XSGN, PUSHF /TAKE SIGN*1 OF FLARG FLTONE POPF FLAC /----------------------------------------------------------------------- XABS, TAD FLARG+1 /TAKE ABSOLUTE VALUE OF FLAC SPA CLA /SKIP TO CONTINUE JMS I MINSKI /NEGATE THE FLOATING AC /CONTINUATION OF FUNCTION CALLS. EFUN3, FINT FNOR /NORMALIZE FUNCTION RETURN FPUT FLARG /SAVE FUNCTION VALUE FXIT TAD FLARGP /SET POINTER DCA PT1 JMS PARTEST JMP I .+1 /FUNCTION RETURN IS OK OPNEXT
FLARG, 0 /DATA TEMPORARY STORAGE 0 0 0 P3, 3 LPRTST, 0 /SKIP IF LEFT PAREN. - 'TSTLPR' TAD SORTCN TAD M11 SMA CLA JMP I LPRTST /--RETURN-- TAD SORTCN TAD M5 SMA SZA CLA ISZ LPRTST JMP I LPRTST /--RETURN-- PARTEST,0 /TEST THE PAREN MATCHINGS POPA /RESTORE LAST OPERATION DCA LASTOP TAD P3 /+3 TO COMPARE CODES POPA /GET LAST PAREN CODE. CIA /CHECK FOR PAREN MATCH. TAD SORTCN /(STILL SET FROM THE LAST "EVAL") SZA CLA /SKIP IF MATCH ERROR4 /PAREN ERROR GETC /MOVE PAST R-PAR JMP I PARTEST /--RETURN--
/THE DELETE A LINE ROUTINE XDELETE,0 /UNCHAIN A LINE AND RECOVER THE SPACE. IOF /PROTECT POINTER CHANGES FROM INTERRUPTIONS FINDLN /SETS "THISLN" AND "LASTLN". JMP I XDELETE /ALREADY GONE --RETURN-- ISZ DEBGSW /DISABLE TRACE GETC /MEASURE LENGTH TAD CHAR TAD MCR SZA CLA JMP .-4 TAD AXOUT /SAVE LAST ADDRESS CMA TAD THISLN DCA CNTR /LENGTH < 0 TAD CFRS /IT IS ILLEGAL TO DELETE THE FIRST LINE CIA TAD THISLN SNA CLA JMP START /JUST IGNORE SUCH COMMANDS NOP /CHANGE DATA FIELD TO TEXT /*8K* TAD I THISLN /DISCONNECT DCA I LASTLN TAD CFRS /START LIST AT TOP DOK, DCA T2 /EXAMINATION ADDRESS TAD I T2 /GET THE NEXT ADDR. SNA /TEST FOR END JMP DONE /YES-WRAP UP ALL. DCA T1 /SAVE NEXT ADDRESS. TAD THISLN /COMPARE LINE POSITIONS CIA CLL TAD T1 SZL CLA /SKIP IF THISLN > X TAD CNTR /CHANGE (X) TO ACCOUNT FOR TAD T1 /GARBAGE COLLECTION. DCA I T2 TAD T1 /GET NEXT JMP DOK
/GARBAGE COLLECTION DONE, CMA /BACKUP L FOR XR TAD THISLN DCA XRT TAD CNTR /SETUP END OF HOSE CMA TAD THISLN DCA XRT2 TAD CNTR /CORRECT END OF BUFFER POINTER. TAD BUFR DCA BUFR TAD AXIN /COMPUTE COUNT CMA TAD XRT2 DCA T1 TAD AXIN TAD CNTR DCA AXIN TAD I XRT2 /SIPHON LOWER PART. DCA I XRT ISZ T1 JMP .-3 JMP XDELETE+1 /RESET 'LASTLN','THISLN', AND DATA FIELD. CHIN, 0 /READ IN A CHARACTER SUBR. - "READC" JMS I INDEV DCA CHAR SORTC /LINEFEED OR RUBOUT? ECHOLST-1 JMP I CHIN /YES PRINTC /ECHO THE INPUT JMP I CHIN /--RETURN-- /------------------------------------------------------------------- FNTABL=. 2533 /FABS 2650 /FSGN 2636 /FITR 0331 /FY 2630 /FRAN 0332 /FZ 2572 /FATN 2624 /FEXP 2625 /FLOG 2654 /FSIN 2575 /FCOS 2702 /FSQT 2631 /FNEW 2567 /FCOM 0330 /FX
/ERASE SINGLE LINES, GROUPS, OR VARIABLES ERASE, TESTC /TEST THE SECOND WORD, IF ANY. /--------------------------------------------------------------------- JMP ERVX /ERASE VARIABLES JMP ERL /LINES OR GROUPS JMP .+4 /ERROR TAD CHAR /ALL TEXT TAD MINUSA SZA ERROR3 /BAD ARG FOR ERASE. ERT, TAD ENDT /ERASE ALL TEXT ** DCA BUFR DCA I CFRS /*8K* ERV, TAD STARTV /ERASE VARIABLES /*8K* DCA LASTV /*8K* JMP START /POINTERS MAY BE DIFFERENT NOW. ERL, GETLN /ERASE LINES. TAD BUFR /PROTECT REST OF TEXT. DCA AXIN ERG, DELETE /EXTRACT ONE LINE ISZ THISLN TAD NAGSW SMA CLA TAD I THISLN /*8K* TSTGRP /SKIP IF G(AC) = G(LINENO) /*8K* JMP ERV /*8K* TAD I THISLN /*8K* DCA LINENO JMP ERG ERVX, TAD STARTV /INIT VARIABLES MAY BE INDIRECT COMMAND/*8K* DCA LASTV POPJ
/ROUTINE CALLED VIA "FINDLN": /SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ] /1ST RETURN IF NOT FOUND, /2AND IF FOUND. /"THISLN" = FOUND LINE OR NEXT LARGER. /"LASTLN" = LESSER AND/OR LAST. /"TEXTP" IS SET XFIND, 0 TAD CFRS /INITIALIZE POINTERS TO FIRST LINE DCA LASTLN TAD CFRS FINDN, DCA THISLN /SAVE THIS ONE TAD THISLN DCA XRT TAD LINENO CLL CMA IAC /CLEAR LINK AND NEGATE LINENO. TAD I XRT /LINENO=0 WILL ALSO BE FOUND /*8K* SNA JMP FEND3-1 /FOUND IT. SZL CLA JMP FEND3 /PAST IT. TAD THISLN /MOVE POINTERS DCA LASTLN TAD I THISLN /END OF TEXT? (X_MEM) SZA JMP FINDN /NOT YET SKP ISZ XFIND /2ND EXIT = FOUND FEND3, TAD THISLN /1ST RETURN = NOT FOUND IAC DCA AXOUT /SET "TEXTP". DCA XCT JMP I XFIND /--RETURN--
UTRA, 0 /UNPACK CHARACTER. - "GETC" JMS GET1 UTE, SPA CLA /NORM & EXTEND TAD C100 /300-337 & 340-376 TAD M137 /240-276 & 200-236 TAD CHAR SNA JMP UTX /"?" FOUND TAD P337 UTQ, DCA CHAR TAD DEBGSW TAD DMPSW SNA CLA /PRINT ONLY IF BOTH ARE ZERO. PRINTC JMP I UTRA /--RETURN-- EXTR, JMS GET1 CMA JMP UTE UTX, TAD DEBGSW /TEST FOR TRACE-ENABLED SZA CLA JMP .+6 TAD DMPSW /FLIP THE TRACE FLOP SNA CLA IAC DCA DMPSW JMP UTRA+1 /GET NEXT CHARACTER INSTEAD. TAD P277 /TRACE DISABLED = RETURN "?" JMP UTQ GET1, 0 /UNPACK 6-BITS ISZ XCT /STARTS=0 JMP GET3 TAD GTEM GEND, AND P77 DCA CHAR /SAVE TAD CHAR TAD M77 SNA CLA JMP EXTR /EXTENDED TAD CHAR TAD M40 JMP I GET1 /--RETURN-- GET3, TAD I AXOUT /*8K* DCA GTEM CMA DCA XCT TAD GTEM RTR CLL RTR RTR JMP GEND M40, -40 M137, -137
XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" NOP /*8K* TAD I LASTLN /SAVE OLD POINTER DCA I BUFR TAD BUFR /POINT TO NEW LAST LINE DCA I LASTLN TAD ADD /CHECK FOR EXTRA INFO SZA DCA I AXIN TAD AXIN /COMPUTE NEW END OF BUFFER IAC DCA BUFR TAD STARTV /RESET VARIABLE LIST /*8K* DCA LASTV /*8K* JMP I XENDLN /--RETURN-- /--------------------------------------------------------------------- TLIST3=. /LITERAL TERMINATORS TASK4 /" PC1 /C.R. = AUTOMATIC QUOTE MATCH INFIX=. /DATA CONTROL CHARACTERS FLINTP+2 /LEFT ARROW = KILL INPUT+1 /RUBOUT = IGNORE INPUT+1 /L.F. = IGNORE ENDFI+5 /ALT MODE = EXIT FLTONE, 0001 /(NO RELATIVE REFERENCES) 2000 FLTZER, 0000 0000 0000 0000 M12, -12 /DECIMAL CONVERSION FACTOR FOR "PRNT" /---------------------------------------------------------------------- I33, DCA INBUF /CLEAR INPUT BUFFER KCC /INITIATE NEXT READ TAD I .+3 /GET CHARACTER JMP I .+1 XOUTL-1 XOUTL HLT HLT HLT
XPRNT, 0 /PRINT A LINE NUMBER - "PRNTLN" TAD LINENO RTL6 AND P77 JMS PRNT /TWO DIGIT "PART" NUMBER TAD PER PRINTC /PERIOD FOR SEPARATION TAD LINENO JMS PRNT /TWO DIGIT "STEP" NUMBER. TAD M140 DCA CHAR /SAVE SPACE IN CHAR. PRINTC /PRINT TRAILING SPACE JMP I XPRNT /--RETURN-- VAL=T1 PRNT, 0 /PRINT TWO DECIMAL DIGITS AND P177 DCA VAL TAD C260 DCA T3 JMP .+3 ISZ T3 XYZ, DCA VAL TAD VAL TAD M12 SMA JMP XYZ-1 CLA TAD T3 PRINTC TAD VAL TAD C260 PRINTC JMP I PRNT /--RETURN-- OUT, 0 /OUTPUT A CHARACTER - "PRINTC" SNA /USE (AC) OR (CHAR) TAD CHAR TAD MCR SNA JMP OUTCR TAD CCR JMS I OUTDEV OUTX, JMP I OUT /--RETURN-- OUTCR, TAD CCR JMS I OUTDEV TAD CLF JMP OUTX-1
PACBUF, 0 /PACK A CHARACTER - "PACKC" TAD P277 CIA TAD CHAR SNA /CHANGE 277 TO 337 TAD P40 TAD M100 SNA /TEST FOR RUBOUT. JMP I RUBIT TAD P377 DCA T2 /SAVE INPUT ITEM TAD T2 /SO THAT QUESTION DOESN'T MAKE AND C140 /CHAR LOOK LIKE A LEFT-ARROW TAD M140 SZA /DATA WORD. TAD C140 SNA CLA JMP ESCA /340-377 AND 200-237 PA1, TAD T2 /240-337 AND P77 SZA /IGNORE 300 JMS PCK1 PACX, NOP /*8K* JMP I PACBUF /--RETURN-- ESCA, TAD P77 JMS PCK1 JMP PA1 PCK1, 0 ISZ XCTIN /=0 TO START JMP ROT TAD ADD DCA I AXIN /*8K* DCA ADD /CLEAR PACKING WORD /*8K* TAD PDLXR /CHECK FOR OVERFLOW /*8K* CMA IAC CLL /*8K* TAD P13 /RESERVATIONS FOR PUSH-DOWN LIST/*8K* TAD AXIN SNL CLA JMP I PCK1 /--RETURN-- ERROR2 /FULL BUFFER P40, 40 P377, 377 C140, 140 RUBIT, RUB1 M140, -140 ROT, RTL6 /(EAE) DCA ADD CMA DCA XCTIN JMP I PCK1 /2564-2570, 2572-2576 ARE USED BY 8K OVERLAY /*8K*
*2600 /------------------------------------------------------------------- /---------------------------------------------------------------------- /INTERRUPT PROCESSOR. SAVAC, 0 /CONTENTS OF AC SAVLK, 0 /CONTENTS OF LINK MBREAK, -203 /CONTROL-C INTRPT, DCA SAVAC /SAVE WORKING DATA RAR DCA SAVLK TSF /GIVE OUTPUT PRIORITY JMP KINT TCF DCA TELSW /TURN OFF THE IN-PROGRESS FLAG. TAD I OPTRI SNA JMP KINT /DONE TPC /TYPE NEXT. DCA TELSW /CLEAR AC AND TURN ON THE FLAG. DCA I OPTRI /ZERO OUT THE DATA AREA TAD OPTRI IAC AND P17 TAD OPTR0 DCA OPTRI KINT, KSF /CHECK FOR KEYBOARD FIRST JMP EXIT KRS /INPUT CHARACTER KCF /CLEAR FLAG AND P177 /IGNORE BIT 8 SNA /BLANK? JMP EXIT-1 /YES--GO INITIATE NEXT READ TAD C200 /FORCE BIT 8 ON DCA SIN TAD SIN TAD MBREAK SNA CLA /WAS IT CTRL/C? JMP I RECOVR /YES--HANDLE CTRL/C TAD SIN DCA INBUF SKP KCC /INITIATE NEXT READ--CHAR. WAS BLANK EXIT, RSF /TEST H.S. READER FLAG JMP .+3 RRB /READ BUFFER AND CLEAR FLAG DCA HINBUF /SAVE CHARACTER RMF /RESTORE MEMORY FIELD. SMP /(THESE TWO COULD PATCH TO OTHER PDP-8 DEVICES) NOP /ONLY POSSIBLE HALT = PARITY ERROR IN 8/S ONLY. TAD SAVLK RAL CLL TAD SAVAC ION EXITJ, JMP I 0 /MODIFIED FOR PDP-5 SIN, 0
OPTR0, IOBUF /OUTPUT POINTERS OPTRO, IOBUF /VARS OPTRI, IOBUF XI33, 0 /VIA (INDEV) TAD INBUF /ANY INPUT? SPA SNA JMP .-2 /NO = WAIT DCA XOUTL JMP I .+1 I33 JMP I XI33 /--RETURN-- XOUTL, 0 /VIA (OUTDEV) DCA XI33 /SAVE CURRENT CHARACTER. ION /BE SURE INTERRUPT IS ON. TAD I OPTRO /ANY ROOM? SZA CLA /A CHARACTER IS NON-ZERO JMP .-2 /NO = WAIT. IOF TAD TELSW /IN PROGRESS? SZA CLA JMP .+5 TAD XI33 /NO TLS /TYPE CHARACTER. DCA TELSW /SET IN-PROGRESS FLAG. JMP .+10 /RETURN TAD XI33 /SEND DATA DCA I OPTRO TAD OPTRO /SET POINTERS IAC AND P17 TAD OPTR0 DCA OPTRO ION JMP I XOUTL /--RETURN--
/ERROR RECOVERY PROCEEDURE ERROR5, DCA .+1 /ERROR CALLED FROM A TABLE ERR2, 0 /LIMIT EXCEEDED CLA CMA /COMPUTE CALLING ADDRESS (ALSO "SPACE") TAD ERR2 /AND USE IT AS ERROR NUMBER. DCA LINENO /SAVE ERROR CODE. ION / (JMP.+4) - FOR DEBUGGING TAD TELSW /WAIT FOR OUTPUT TO FINISH SZA CLA JMP .-2 IOF /DISABLE INTERRUPT FOR INITIALIZATIONS JMP .+3 RECOVR, XINT-4 KCC TAD M20 /SETUP INIT COUNT DCA CNTR ISZ TELSW /TURN ON IN-PROGRESS SWITCH CMA TAD OPTR0 DCA AXIN /INIT I/O BUFFERS. NOP /*8K* DCA I AXIN ISZ CNTR JMP .-2 DCA INBUF /INIT KEY-BUFR. TAD OPTR0 /INIT TTY POINTERS. DCA OPTRI TAD OPTR0 DCA OPTRO RECOVX, CLA TLS / RAISE TTY FLAG. (NOP) - FOR DEBUGGING JMP I .+1 /OUTPUT CR/LF AND ? XADC PRNTLN /PRINT ERROR NUMBER AND, ISZ PC TAD I PC /UNLESS IT IS ZERO, /*8K* SNA JMP .+6 DCA LINENO TAD P7700 /PRINT ATSIGN PRINTC PRINTC /PRINT SPACE AGAIN AND PRNTLN /PRINT LINE OF ERROR. TAD CCR /------------------------------------------------------------------ PRINTC TAD PTCH /RESET "READC" DCA RDIV /IF AN ERROR OCCURS. JMP START /INTERRUPT WILL BE RE-ENABLED SOON.
/CHRACTER REMOVAL ROUTINE RUB1, TAD XCTIN /RUBOUT ONE LETTER SZA CLA /---------------------------------------------------------------------- JMP .+6 TAD AXIN CIA TAD PACKST SMA CLA /TEST NULL LINE JMP I RUB5 TAD SPLAT /FOR A RUBOUT ACKNOWLEDGEMENT PRINTC TAD AXIN DCA T2 NOP /*8K* ISZ XCTIN /TEST HALF JMP RUB2 TAD I T2 /"ADD" IS FULL. AND P77 TAD M77 SZA CLA /TEST FOR EXTEND JMP RUB4 RUB3, CMA /SET SWITCH DCA XCTIN CMA /BACKUP POINTER TAD AXIN DCA AXIN TAD I T2 /RESET ADD AND P7700 RUB4, DCA ADD JMP I RUB5 RUB5, PACX RUB2, TAD I T2 /CHECK FOR EXTENDED AND P7700 TAD C100 SZA CLA JMP RUB3 DCA I T2 /SAVE CORRECTION JMP RUB3+1 SPLAT, 334
/SYMBOL TABLE TYPEOUT ROUTINE TDUMP, TAD STARTV /INIT POINTER FOR SYMBOL DUMP /*8K* DCA PT1 TAD LASTV /TEST FOR END OF LIST CIA TAD PT1 SNA CLA POPJ TAD I PT1 /GET THE VARIABLE DCA OP+1 /(DCA I (4)-FOR 8K:SAVE NAME TAD OP /SETUP UNPACK POINTERS DCA AXOUT DCA XCT GETC /READ AND PRINT "XX(" PRINTC GETC PRINTC GETC PRINTC ISZ PT1 TAD I PT1 /PRINT SUBSCRIPT TO 99 JMS I PRNT2 GETC /PRINT ")" PRINTC ISZ PT1 FINT /PICK UP VALUE FGET I PT1 FXIT JMS I FOUTPUT /PRINT VALUE TAD CCR PRINTC TAD GINC TAD M2 TAD PT1 JMP TDUMP+1 PRNT2, PRNT OP, . /*8K* 0000 /*8K* 5051 /(THESE GO IN 10005 FOR X-MEM)
/OUTPUT CHARACTER BUFFER (ADDRESS IS A MULTIPLE OF 20) IOBUF=3120 COMEIN=IOBUF+20 /COMMAND - INPUT BUFFER /------------------------------------------------------------------- /------------------------------------------------------------------- COMEOUT=COMEIN+46 *COMEOUT FRST, 0 /TEXT POINTER 0000 /DUMMY LINE NO. 0340 /TITLE C FOCAL-8 0617 /FO 0301 /CA 1455 /L- 7040 /8 FRSTX, 4040 7715 /DUMMY C.R. /TO SAVE TEXT ,SAVE C(BUFR), C(LASTV), AND C( FRST TO C(BUFR)) /WITH ODT-JR46. THE TAPES MAY BE TOGETHER WITH /THE SYMBOLIC DUMP LAST : FOCAL + FLOAT + DIALOG . /LOADING THE LAST SECTION MAY BE CONSIDERED OPTIONAL. BUFBEG=. /TEXT BUFFER STARTS HERE.
*4400-10 O1, XINT-3 /STARTING ADDRESS BEGIN, TAD O1 /INITIALIZE ANY 8-FAMILY COMPUTER. /-------------------------------------------------------------------- DCA START-1 6142 /CLEAR F.H.'S 8.((JMP ATES+1)-FOR TSS-8) 6077 /SET INTENSITY LEVEL, 34D 6152 /CLEAR LPT 6762 /TC01 6012 /CLEAR PC02 FOR PDP-5 6346 /CLEAR LAB-8 KCC /READER START CLA CLL /-------------------------------------------------------------------- DCA I FLTXR ISZ CNTR /INITIALIZED BY LOAD. JMP .-2 /CLEAR INPUT BUFFER /TEST FOR COMPUTER TYPE NOP NOP TAD PDP5 /TEST FOR PDP-5 DCA 0000 O4, CMA /LINC-8 OR PDP-12? 6167 /SET LINC AC- (INITS AND KILLS 338) CLA 6171 /READ LINC AC SNA CLA JMP T12 TAD P7 /CLEAR LINC-INTERRUPTS 6141 TAD P2 6141 CLA JMP ATES+1 /YES
T12, 6141 /BECOME A LINC 0017 /COMPLEMENT AC 0002 /BACK TO 8 MODE IAC /SET TO ZERO IF PDP-12 SNA CLA JMP ATES+1 JMP .+12 TAD P177 /SET UP FOR 8K L COMMAND DCA I .+2 /TO RESTART FOCAL8 JMP ATES-3 XADC+6 NOP NOP NOP NOP JMP ATES+1 7354 /NL3776 TAD PDP8I /IS THIS A PDP-8/I OR 8/L? SNA CLA JMP ATEI /8/I 7344 /NL7776 TAD P2 SNA CLA JMP ATES+1 /8/L TAD CCR+1 /PDP-8/S DCA I O6 /SETUP PARITY-ERROR HALT TAD OOUT-15 /CORRECT READER WAIT DCA I O5 JMP ATES PDP5X, ISZ I O2 /INCREMENT INTERRUPT RETURN JMP ATES+1
ATEI, TLS G8L, 6000 6000 6000 6000 6000 6000 6000 6000 ISZ CNTR TSF JMP G8L JMP ATES+1 TAD PDP JMS LOOKUP SMA SZA CLA /MONITOR IN USE? JMP T12+7 JMP I .+1 /YES ERT /ERASE ALL AND PROCEED TAD L8AY /NO-SET UP FOR L COMMAND DCA I L8AX /TO RETURN TO COMMAND MODE JMP I .-3 /ERASE ALL AND PROCEED ATES, HLT
/INITIALIZE THE DIALOGUE TLS ION /ENABLE INTERRUPT PUSHJ DO+1 IOF /RETAIN EXP,LOG,ATN ? (256) /RETAIN SINE,COSINE? (128) /XF = +1(NO) -1(YES) 0(YES) TAD XF JMS LOOKUP SNA JMP OOUT /NO DIALOGUE EXECUTED SPA CLA TAD P2 /DELETE EXTENDED FUNCTIONS TAD M5 /(OOUT-15 FOR 8/S READER) DCA CNTR TAD FNPT DCA XRT TAD ER5 DCA I XRT /SET THE TABLE ISZ CNTR JMP .-3 TAD XF /CORRECT BUFFER PROTECT JMS LOOKUP SPA CLA TAD P7600 /(-200) TAD BFXX OOUT, TAD BFX DCA BOTTOM JMP ATES-11 HLT
L8A, 6313 L8B, 6307 L8AY, JMP START L8AX, PRNT8-1 FNPT, FNTABF+5 ER5, ERROR5 BFXX, TGO-FEXP/WITHOUT BFX, FEXP-1 /WITH XF, 3006 /X,F O2, EXITJ /INTERRUPT EXIT PDP, 2004 /P,D O5, HREAD+1 O6, EXIT+6 P7, 7 P2, 2 PDP8I, 4002 /(-3776) PDP5, PDP5X-1 LOOKUP, DDTJR+DMULT4+END+RECOVX+PSIN /MAKE BELIEVE DCA ADD PUSHJ /CALL THE VARIABLE SEARCH ROUTINE. GS1 ISZ PT1 TAD I PT1 JMP I LOOKUP /-------------------------------------------------------------------- /--------------------------------------------------------------------
*6321 /STUCK INTO THE FLOATING POINT PACKAGE. HREAD, 0 TAD M20 /TAD M5 FOR 8/S DCA HSWITC HREAD2, TAD HINBUF /(RSF) -WHEN DEBUGGING SMA CLA /(SKP) JMP HSGO ISZ T1 /SKIP IF OUT OF TAPE JMP HREAD2 ISZ HSWITC JMP HREAD2 JMS HSWITC /LEAVES LINK ZERO TAD PDLXR / < FRST ? TAD HTST SZL CLA ERROR3 /DIRECT COMMAND JMS HSWITC JMP START IBAR HSWITC, 0 TAD HSPSW /INITIALIZE H.S. READER CMA DCA HSPSW /CHANGE STATUS CMA CLL /CLEAR LINK DCA HINBUF /CLEAR BUFFER TAD HSPSW SZA RFC /START HARDWARE SZA CLA TAD RESTR /(HREAD) TAD PTCH DCA RDIV /"READC" JMP I HSWITC /--RETURN-- HSPX, JMS HSWITC /COMMAND "*" - SWAP JMP I .+1 PROC HSGO, CMA /FETCH NEXT CHARACTER DCA HINBUF RFC RRB /PICK UP NEXT CHARACTER AND P177 /CHECK FOR LEADER-TRAILER,ETC. SNA JMP HREAD+1 TAD C200 DCA CHAR /SAVE INPUT JMP I HREAD /--RETURN-- HSPSW, 0 HTST, -COMEOUT-13 RESTR, HREAD-CHIN
/DISK MONITOR INTERACTIVE COMMAND OPERATES VIA THE KEYBOARD. /THIS FITS UNDER THE 10DIGIT FLOATING POINT OUTPUT BUFFER. *7503 LIBRARY,TAD CFRS JMS PRNT8 TAD BUFR /TYPE C(CFRS), C(BUFR),C(LASTV),C(BOTTOM) JMS PRNT8 /OCTAL OUTPUT + COMMA TAD LASTV JMS PRNT8 TAD BOTTOM JMS PRNT8 JMP .+3 GETC PRINTC TAD CHAR TAD MCR SZA CLA JMP .-5 TAD TELSW SZA CLA JMP .-2 /(NOP) - WHEN DEBUGGING IOF /*8K* JMP I P7600 /(7600=DISK MONITOR) /*8K* PRNT8, 0 DCA T1 TAD T1 RTL RTL JMS PRINTD RTL6 RAL JMS PRINTD RTR RAR JMS PRINTD JMS PRINTD CLA TAD CCR PRINTC JMP I PRNT8 /--RETURN-- PRINTD, 0 AND LP7 TAD C260 PRINTC TAD T1 JMP I PRINTD /--RETURN-- LP7, 7 /7557-7577 ARE USED BY 8K OVERLAY /*8K*
/FOCAL-8 FLOATING POINT PACKAGE /COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION / MAYNARD, MASSACHUSETTS 01754 / IFNDEF T <XLIST> *4434 JMP I .+5 *4441 4300 /REMOVE /SPECIAL VERSION TO REMOVE FSQT,FSGN ONLY *4300 DATUMA-12 DMULT+12 DMULT4+3 *4303 TAD .-2 SZA CLA JMP I .+2 SKP PUSHA-DMPSW DCA THISLN+6 DCA THISLN+12 DCA THISLN-1 TAD .+3 DCA I .+3 JMP I .-6 PCHECK+1 LOOP01-TERMS+5 IFNDEF T <XLIST> /PAGE ZERO OF THE /FLOATING POINT ARITHMETIC INTERPRETER FOR FOCAL *40 EX1, 0 /OPERAND STORAGE AC1H, 0 AC1L, 0 OVER1, 0 FLAC=. /FLOATING ACCUMULATOR EXP, 0 /F.A. HORD, 0 LORD, 0 OVER2, 0 SIGNF, 0 /FLOATIN SIGN MINSKI, ACMINS /NEGATE FLAC SUBROUTINE FISW, 2004 /OUTPUT FORMAT INTEGER,FIX /FIX FLAC /FUNCTIONS CONTAINED IN THIS SECTION /ARTN /FEXP /FLOG /FSIN /FCOS /XSQRT
/****************************************************************** XLIST ENPUNCH /********************************************************************** /FLOATING POINT PACKAGE - EXPONENTIAL GETSGN=TAD FLAC+1 RETURN=JMP I EFUN3I *4600+20 FEXP, GETSGN /TAKE ABSOLUTE VALUE SPA CLA JMS I NEGP DCA T3 /C(SIGN)=-1 IF I X2<0 FINT FMUL LG2E FPUT I X2 FEXT JMS I INTEGER /TAKE INTEGER PART DCA FLAG2 /SAVE LOW ORDER DATA FINT FNOR FPUT I XSQ2 FGET I X2 FSUB I XSQ2 FPUT I X2 FMUL I X2 FPUT I XSQ2 FADD DF FPUT TEMP FGET CF FDIV TEMP FSUB I X2 FADD AF FPUT TEMP FGET BF FMUL I XSQ2 FADD TEMP FPUT TEMP FGET I X2 FDIV TEMP FMUL TWO FADD ONE FEXT TAD FLAG2 TAD FLAC DCA FLAC ISZ T3 RETURN FINT FPUT I X2 FGET ONE FDIV I X2 FEXT RETURN
/CONSTANTS FOR FEXP X2, X XSQ2, XSQR AF, 0004 2372 1402 BF, 7774 2157 5157 CF, 0012 5454 0343 DF, 0007 2566 5341 LG2E, 0001 2705 2435 ONE, 0001 2000 0000 TWO, 0002 2000 0000 NEGP, FNEG FLAG2, 0 TEMP, 0 0 0 0
/MAIN ALGORITHM FOR ARCTANGENT ARCALG, FINT FGET I X2 FMUL I X2 FPUT I XSQ2 FMUL BET2 FADD BET1 FMUL I XSQ2 FADD BETZ FPUT TEMP FGET ALF2 FMUL I XSQ2 FADD ALF1 FMUL I XSQ2 FADD ALFZ FMUL I X2 FDIV TEMP FEXT JMP I .+1 ARCRTN /CONSTANTS - FLOATING ARC TANGENT ALFZ, 0000 2437 1643 ALF1, 7777 3304 4434 ALF2, 7773 3306 5454 BETZ, 0000 2437 1646 BET1, 0000 2427 2323 BET2, 7775 3427 7052
/------------------------------------------------------------ /------------------------------------------------------------ /FLOATING POINT ARC TANGENT *5000 ARTN, GETSGN /TAKE ABSOLUTE VALUE SPA CLA JMS FNEG DCA T3 FINT FPUT I X1 FSUB I CON1 FEXT GETSGN SPA CLA JMP GO /LESS THAN ONE FINT FGET I CON1 FDIV I X1 FPUT I X1 FEXT CLA CMA GO, DCA FLAG1 /SIGN FLAG OF RESULT JMP I .+1 /CALL ALGORITHM ARCALG ARCRTN, ISZ FLAG1 /RETURN HERE JMP I EXIT1 FINT FPUT I X1 FGET I PI2 FSUB I X1 FEXT JMP I .+1 EXIT1, EXIT2 /CONSTANTS FOR ARCTANGENT X1, X PI2, PIOT CON1, ONE
FLOG, GETSGN /FLOATING LOGARITHM SNA ERROR3 /ZERO ARGUEMENT FOR LOG SPA CLA ERROR3 /NEGATIVE ARGUMENT FINT FPUT I TEM FSUB I CON1 FEXT GETSGN SNA RETURN SMA CLA JMP STARTL FINT FGET I CON1 FDIV I TEM FPUT I TEM FEXT CLA CMA STARTL, DCA T3 TAD P13 DCA FLAC CMA TAD I TEM DCA FLAC+1 DCA FLAC+2 DCA FLAC+3 IAC DCA I TEM FINT FMUL LOG2 FPUT I X1 FGET I TEM FSUB I CON1 FPUT I TEM FMUL LOG8 FADD LOG7 FMUL I TEM FADD LOG6 FMUL I TEM FADD LOG5 FMUL I TEM FADD L4 FMUL I TEM FADD L3 FMUL I TEM FADD L2 FMUL I TEM FADD L1 FMUL I TEM FADD I X1 FEXT JMP I EXIT1
L1, 0000 3777 7742 L2, 7777 4000 4100 L3, 7777 2517 0310 L4, 7776 4113 7211 /LOGARITHM CONSTANTS LOG5, 7776 2535 3301 LOG6, 7775 4746 0771 LOG7, 7774 2236 4304 LOG8, 7771 4544 1735 TEM, TEMP LOG2, 0 2613 4414 FLAG1, 0 FNEG, 0 JMS I MINSKI CLA CMA JMP I FNEG
/------------------------------------------------------------ /------------------------------------------------------------ /FLOATING POINT SINE AND COSINE *5200 FCOS, FINT /COS(X)=SIN(PI/2-X) FPUT X FGET PIOT FSUB X FEXT FSIN, GETSGN SMA SZA CLA JMP MOD GETSGN SMA CLA RETURN /YES SIN(0)=0 JMS I MINSKI CMA /NO:SIN(-X)=-SIN(X) MOD, DCA T3 /REDUCE X MODULO 2 PI FINT FDIV TWOPI FPUT XSQR FEXT JMS I INTEGER FINT FNOR FPUT X FGET XSQR FSUB X FMUL TWOPI FPUT X FSUB PI /X<PI? FEXT GETSGN SPA CLA JMP PCHECK /YES FINT /NO, SIN(X-PI)=-SIN(X) FPUT X FEXT TAD T3 /INVERT THE SIGN CMA DCA T3
PCHECK, FINT /X<PI/2? FGET X FSUB PIOT FEXT GETSGN SPA CLA JMP PALG /YES FINT /NO FGET PI /SIN(X)=SIN(PI-X) FSUB X FPUT X FEXT PALG, FINT FGET X FDIV PIOT FPUT X FMUL X FPUT XSQR FGET C9 FMUL XSQR FADD C7 FMUL XSQR FADD C5 FMUL XSQR FADD C3 FMUL XSQR FADD PIOT FMUL X FEXT EXIT2, ISZ T3 RETURN JMS I MINSKI RETURN
/CONSTANTS AND POINTERS TWOPI, 0003 3110 3756 /(3755) - FOR 4-WORD 3235 PI, 0002 3110 3756 3235 PIOT, 0001 /USED BY SINE AND COSINE 3110 3756 3235 X, 0000 0000 0000 0000 XSQR, 0000 0000 0000 0000 /SINE CONSTANTS C9, 7764 2501 7015 1042 C7, 7771 5464 5514 6150 C5, 7775 2431 5361 4736 C3, 0000 5325 0414 3167 /END OF EXTENDED FUNCTIONS. /*********************************************************************** NOPUNCH XLIST /***********************************************************************
/------------------------------------------------------------ /------------------------------------------------------------ / - INPUT/OUTPUT ROUTINES FOR THE FOCAL /FLOATING POINT PACKAGE. /IN THE COMMENTS BELOW:- / F = NUMBER OF DIGITS TO BE OUTPUT =FISW / D = NUMBER OF DECIMAL PLACES =DECP / E = DECIMAL EXPONENT =BEXP / P = NUMBER OF PLACES REMAINING TO BE / PRINTED BEFORE DECIMAL POINT *5400 DIGITS=6 /NUMBER OF DECIMAL DIGITS OUT TGO, 0 DCA SCOUNT /SAVE MAX. NUMBER OF DIGITS AVAILABLE - *SET COUNTS* TAD FISW RTL6 AND P77 DCA T1 TAD T1 CIA /NO, COMPUTE FIELD SIZES SNA TAD MD DCA FCOUNT TAD FISW /(JMP FPRNT) - FOR NO ROUNDGIN. SNA /FLOATING OUTPUT? JMP R6 /YES, ROUND OFF TO MAX.NO. PLACES AND P77 DCA DECP TAD FCOUNT TAD DECP SPA / F-D > 0 ? JMP .+5 /YES CLA CMA /NO, TAD T1 DCA DECP /MAKE D = F-1 CMA TAD T3 /COMPARE DECIMAL EXPONENT SMA / F-D > E? CLA /NO, ROUND OFF TO .F PLACES TAD T1 /YES SPA / D+E < 0 ? JMP FPRNT-2 /YES, NO ROUNDING NEEDED, GO TO PRINT TAD MD /NO, ROUND TO D+E PLACES, SMA /TO A MAXIMUM OF D PLACES CLA
R6, TAD RND2 / *ROUND UP * DCA T2 /SAVE NUMBER+1 OF PLACES TO ROUND TO. TAD I BUFST TAD T2 /SET UP BUFFER ADDRESS AT WHICH DCA PLCE /ROUNDING OFF SHOULD START TAD T2 CIA /SET UP COUNT OF MAXIMUM NUMBER DCA T2 /OF CARRIES ALLOWABLE TAD K4 /LITTLE EXTRA ON FIRST DIGIT. RET, ISZ I PLCE /ADD 1 TO DIGIT AT CURRENT POSITION TAD I PLCE TAD OM12 SPA CLA /CARRY REQUIRED? JMP FPRNT /NO, GO TO OUTPUT DCA I PLCE /YES, MAKE CURRENT DIGIT ZERO ISZ T2 /BEGINNING OF BUFFER REACHED? JMP DECR /NO, DECREMENT BUFFER ADDRESS AND REPEAT ISZ I PLCE /YES, SET MANTISSA TO 0.1 ISZ T3 /COMPENSATE BY INCREMENTING EXPONENT CLA FPRNT, TAD FISW /AUTO-INDEX REGISTER ALREADY SET. - *PRINT* SNA CLA / F = 0 ? JMP FLOUT /YES, OUTPUT AS FLOATING NUMBER TAD FCOUNT TAD T3 SMA SZA / E > F ? JMP FLOUT-1 /YES,CONVERT TO E FORMAT TAD DECP SMA / E < F-D ? CLA /NO, TAKE P = E CIA /YES, TAKE P = F-D TAD T3 CIA DCA T1 /SET UP MINUS P BACK, TAD T3 /PRINT DD.DDD TAD T1 SNA CLA / P = E ? JMP DIG /YES, PRINT DIGIT TAD T1 /NO, IAC SPA CLA / P > 1 ? TAD M20 /YES, TAKE SPACE (240-260); OTHERWISE ZERO IN, JMS OUTA /PRINT CHARACTER ISZ T1 /P CHARACTERS PRINTED? JMP BACK /NO TAD PER /YES, PRINTC /PRINT DECIMAL POINT JMP BACK
DECR, CMA /BACKUP TO TOP OF BUFFER. TAD PLCE DCA PLCE JMP RET K4, 4 MD, -DIGITS RND2, DIGITS+1 OM12, -12 BUFST, SADR OPUT, OUTDG DECP, 0 /MODIFIABLE LOCATIONS SCOUNT, 0 FCOUNT, 0 PLCE=. OUTA, 0 /MODIFIED REGISTERS. JMS I OPUT /PRINT CHARACTER ISZ FCOUNT /F CHARACTERS PRINTED? JMP I OUTA /NO--RETURN-- JMP I TGO /YES, NUMBER FINSHED DIG, CMA TAD T3 /REDUCE E, BY 1 DCA T3 ISZ SCOUNT /ARE ALL SIG. FIGS. USED? JMP .+4 /NO CMA /YES, DCA SCOUNT /RESET COUNT TO -1 JMP IN /AND LEAVE C(AC) = 0 TAD I FLTXR /TAKE NEXT DIGIT FROM BUFFER JMP IN /DO FLOATING OUTPUT CLA /IF OUTPUT TOO LARGE, FLOUT, JMS I OPUT /PRINT "0" TAD PER PRINTC /PRINT "." ISZ TGO /SECOND RETURN TAD I FLTXR /TAKE NEXT DIGIT FROM BUFFER JMS OUTA /PRINT IT ISZ SCOUNT /TEST FOR END OF INPUT JMP .-3 /AND REPEAT CMA DCA SCOUNT /OUTPUT EXTRA ZEROS. JMP .-5 ABSOLV, 0 TAD HORD DCA SIGNF TAD HORD SPA CLA JMS I MINSKI JMP I ABSOLV /--RETURN--
/------------------------------------------------------------ /------------------------------------------------------------ /DOUBLE PRECISION DECIMAL-BINARY /INPUT AND CONVERSION FOR + OR - XXX... *5600 DECONV, 0 DCA LORD DCA EXP /ZERO THE EXPONENT AND DCA HORD /INITIALIZE FLOATING AC. DCA OVER2 DCA DNUMBR DCA SIGNF TAD CHAR /ALLOW KEYBOARD SIGN CHECKS. TAD MPLUS SNA JMP .+6 /+SIGN; GET NEXT TAD M2 /CHECK - SIGN SZA CLA JMP .+4 CMA /INIT SIGN CHECK TO POS. DCA SIGNF JMS I XINPUT /GET NEXT TAD CHAR /A SPACE PERHAPS? TAD MSPACE SNA CLA JMP .-4 JMS DECON JMP I DECONV /--RETURN--
DECON, 0 TAD CHAR /TEST LEAD CHARACTER FOR TERMINATOR TAD MINE SNA CLA JMP I DECON /E--RETURN-- TESTN JMP I DECON /.--RETURN-- JMP DTST /OTHER TAD SORTCN /N DSAVE, DCA DIGIT /YES JMS MULT10 /REMAIN MUST =0 SINCE OVERFLOW IS CHECKED ISZ DNUMBR /COUNT DIGITS SZA CLA ERROR2 /INPUT-OVERFLOW ERROR JMS I XINPUT JMP DECON+1 /CONTINUE DTST, TAD CHAR /ALLOW A-Z TAD MINUSA SPA CLA JMP I DECON /--RETURN-- TAD CHAR TAD MINUSZ SZA SMA CLA JMP I DECON /USE SIX BITS OF ASCII--RETURN-- TAD CHAR AND P77 JMP DSAVE MINE, -305 /(7532)- FOR AMPERSAND MINUSZ, -332 MPLUS, -253 MSPACE, -240 XINPUT, INPUT
MULT10, 0 /ROUTINE TO MULTIPLY FLAC BY TEN (10) TAD OVER2 DCA OVER1 TAD LORD /DOUBLE PRECISION WORD DCA AC1L /BY TEN (DECIMAL) TAD HORD /REMAIN=REMAINDER DCA AC1H DCA REMAIN /CLEAR OVERFLOW WORD JMS MULT2 /CALL SUBROUTINE TO JMS MULT2 /MULTIPLY BY TWO JMS DUBLAD /CALL DOUBLE ADD JMS MULT2 TAD DIGIT /ADD LAST DIGIT RECEIVED DCA OVER1 DCA AC1L DCA AC1H JMS DUBLAD TAD REMAIN /EXIT WITH REMAINDER JMP I MULT10 /IN AC--RETURN-- REMAIN, 0 DIGIT, 0 /STORAGE FOR DIGIT DNUMBR, 0 /=NUMBER OF DIGITS MULT2, 0 /MULTIPLY OVER2, LORD, HORD BY 2 TAD OVER2 CLL RAL /CARRY INSERT BIT IS IN LINK DCA OVER2 TAD LORD RAL DCA LORD TAD HORD RAL DCA HORD TAD REMAIN RAL DCA REMAIN JMP I MULT2 /--RETURN--
DUBLAD, 0 /TRIPLE PRECISION ADDITION CLA CLL TAD OVER2 TAD OVER1 DCA OVER2 RAL TAD LORD TAD AC1L DCA LORD RAL TAD HORD TAD AC1H DCA HORD RAL TAD REMAIN /WITH OVERFLOW DCA REMAIN JMP I DUBLAD /--RETURN-- DIV1, 0 /SHIFT OPERAND RIGHT CLA CLL /TRIPLE PRECISION TAD AC1H SPA CLL CML RAR DCA AC1H TAD AC1L RAR DCA AC1L TAD OVER1 RAR DCA OVER1 ISZ EX1 JMP I DIV1 /--RETURN-- JMP I DIV1 /--RETURN--
/------------------------------------------------------------ /------------------------------------------------------------ *6000 /FLOATING OUTPUT CONVERSION ROUTINE FLOUTP, 0 TAD PEQ PRINTC /(CLA)_ TO SUPPRESS "=" TAD HORD /NUMBER>0?? SMA CLA TAD SMSP /PRINT "-" OR A SPACE. TAD SMIN PRINTC JMS I ABSOL2 FGO2, DCA T3 /INITIALIZE DECIMAL EXPONENT TAD EXP /IS EXP 0 TO 4? SPA JMP FGO3 /TOO LARGE:MULTIPLY BY 1/10 SZA TAD M4 SPA SNA CLA JMP FGO4 FINT FMUL I PPTEN FEXT IAC TAD T3 JMP FGO2 FGO3, FINT FMUL I TENPT FEXT CMA JMP .-6
FGO4, DCA I DPT /MULTIPLY BY TWO TO POSITION BIT0 DCA I REPT /CLEAR OVERFLOW WORD TAD SADR /INIT BUFFER POINTER DCA FLTXR TAD EXP /COMPUTE BITS IN 1ST DIGIT CMA CLL DCA OUTDG /TEMP COUNT TAD DCOUNT /SETUP COUNT OF TOTAL OUTPUT DCA EXP JMS I DOUBLE /ROTATE OUT THE 1ST 4 BITS ISZ OUTDG JMP .-2 TAD I REPT /TEST FOR 10-15,0,1-9 SNA JMP FGO5 /IGNORE 1ST ZERO TAD FM12 SPA CLA JMP .+7 /0-9 IAC DCA I FLTXR /OUTPUT A 1 ISZ EXP /COUNT THE DIGIT TAD FM12 /CORRECT REMAINDER ISZ T3 /BUMP DECIMAL EXPONENT NOP TAD I REPT /COMPUTE RESULTANT OR SECOND DIGIT ISZ T3 NOP SKP FGO5, JMS I M10PT /IE. .672X10=6+.72.. ETC DCA I FLTXR ISZ EXP /ALL DIGITS OUTPUT?? JMP .-3 /NO: CONTINUE TAD SADR /INIT BUFFER POINTER DCA FLTXR TAD DCOUNT JMS I ROUND /OUTPUT MANTISSA JMP I FLOUTP /FIXED POINT DONE--RETURN-- TAD CHRT /PRINT "E" PRINTC
/OUTPUT THE EXPONENT TAD T3 /TAKE ABSOLUTE VALUE OF EXPONENT SPA CIA DCA HORD /SAVE + POWER TAD T3 /PRINT SIGN SMA CLA TAD M2 TAD SMIN PRINTC TAD HORD ISZ EXP TAD M144 SMA JMP .-3 TAD C144 DCA HORD /SAVE TENS AND UNITS CMA /OUTPUT HUNDREDS TAD EXP SZA /UNLESS ZERO JMS OUTDG TAD HORD /PRINT TWO DIGITS JMS I PRNTI JMP I FLOUTP /--RETURN-- PRNTI, PRNT CHRT, 305 /E (0246) - FOR AMPERSAND SMSP, 240-255 / PEQ, 275 SMIN, 255 M144, -144 /-100 C144, 0144 /+100 M4, -4 FM12, -12 DCOUNT, -DIGITS-1 /NUMBER OF DIGITS OUTPUT PPTEN, PTEN /IEI DPT, DIGIT REPT, REMAIN /OVERFLOW FROM INTEGER MULTIPLY M10PT, MULT10 SADR, BUFFER-1 ROUND, TGO /ACTUAL OUTPUT ROUTINE TENPT, TEN ABSOL2, ABSOLV OUTDG, 0 /OUTPUT ONE DIGIT TAD C260 PRINTC JMP I OUTDG /--RETURN-- /USED BY 8K
/------------------------------------------------------------ /------------------------------------------------------------ /FLOATING POINT INPUT *6200 FLINTP, 0 /IF C(AC) = 0, USE CHAR SZA CLA /IF C(AC) NON-ZERO , GET NEXT JMS I XIN /GET FIRST CHAR TAD CHAR /IGNORE LEADING SPACES TAD M240 SNA CLA JMP .-4 JMS I DPCVPT /READ FIRST DIGIT GROUP TAD CHAR /AND SET "SIGNF" TAD MPER SZA CLA /ENDED BY PERIOD? JMP FIGO1 JMS I XIN /YES, READ 2AND GROUP DCA I DPN JMS I DCONP TAD I DPN /SAVE NUMBER OF DIGITS IN T3 CMA IAC FIGO1, DCA T3 /NO, TAD P43 DCA EXP JMS I RESOL5 JMS I INORM /NORMALIZE FIRST, THEN FINT FPUT I PT1 /SAVE NUMBER FEXT TAD CHAR TAD MINUSE SZA CLA /"E" READ IN? JMP ENDFI+3 /NO JMS I XIN /YES, READ 3RD DIGIT GROUP JMS I DPCVPT /I.E. CONVERT DECIMAL EXPONENT JMS I RESOL5 TAD OVER2 TAD T3 /C(SEXP)PLACES TO RIGHT DCA T3 /OF LAST DIGIT
/COMPENSATE FOR DECIMAL EXPONENTS ENDFI, FINT /RESTORE MANTISSA FGET I PT1 FEXT TAD T3 /TEST DECIMAL EXPONENT SNA JMP I FLINTP /FINISHED--RETURN-- SMA CLA JMP FIGO4 FINT /. IS TO THE LEFT: FMUL PTEN /TIMES .1000 FPUT I PT1 FEXT IAC JMP .+6 FIGO4, FINT /. IS TO THE RIGHT: FMUL TEN /MULTIPLY BY 10 FPUT I PT1 FEXT CMA TAD T3 DCA T3 JMP ENDFI+3 TEN, 0004 2400 0000 0000 PTEN, 7775 3146 3147 /(3146) - FOR 4-WORD 3150 MINUSE, -305 /(7532) - FOR AMPERSAND DPCVPT, DECONV DCONP, DECON RESOL5, RESOLV DPN, DNUMBR XIN, INPUT INORM, DNORM P43, 43 /END OF FLOATING POINT INPUT /7 FREE /USED BY H.S. READER
/------------------------------------------------------------ /------------------------------------------------------------ *6400 / FLOATING-POINT INTERPRETER FOR FOCAL. FPNT, 0 CLA CLL DCA OVER2 /(NOP) - FOR 4-WORD DCA OVER1 /(NOP) - FOR 4-WORD. TAD I FPNT /GET NEXT INSTRUCTION SNA JMP I FPNT /FAST EXIT--RETURN-- DCA JUMP TAD JUMP AND C200 /GET PAGE BIT SNA CLA /PAGE ZERO? JMP .+3 /YES TAD P7600 /NO AND FPNT /C(FPNT)0-4 CONTAINS PAGE BITS DCA ADDR TAD P177 /GET 7 BIT ADDRESS AND JUMP TAD ADDR DCA ADDR TAD INDRCT /INDIRECT BIT=1? AND JUMP SNA CLA JMP LOOP01 /NO-GO ON TAD I ADDR /YES ,DEFER ,W/O AUTO-INDEX DCA ADDR LOOP01, ISZ FPNT CMA TAD ADDR DCA FLTXR2 TAD JUMP /GET COMMAND CLL RTL RTL AND P17 /GET BITS 0-2,IE OPCODE SNA JMP FLGT TAD TABLE /LOOKUP IN TABLE DCA JUMP TAD I JUMP SNA JMP FLPT DCA JUMP TAD CEX1 /SAVE FLOATING ARGUEMENT,UNLESS'GET' OR 'PUT' DCA FLTXR TAD MFLT DCA CNTR TAD I FLTXR2 DCA I FLTXR ISZ CNTR JMP .-3 JMP I JUMP /GO THERE
JUMP, 0 ADDR=EX1 INDRCT, 0400 TABLE, ITABLE FLPT, TAD CEXP /EXP TO (ADDR) JMP .+5 FLGT, TAD CEXP /(ADDR) TO EXP DCA FLTXR2 CMA TAD ADDR DCA FLTXR /SAVE 'FROM' ADDRESS TAD MFLT /3 OR 4 WORDS DCA CNTR TAD I FLTXR DCA I FLTXR2 ISZ CNTR JMP .-3 JMP FPNT+1 CEXP, EXP-1 CEX1, EX1-1 FLSU, JMS I OPMINS /FSUB=2 - NEGATE THE OPERAND FLAD, JMS I ALGN /FLAD=1 - FIRST ALIGN EXPONENTS JMP FPNT+1 /RETURN IF NO ALIGNMENT IS POSSIBLE JMS I RAR2 /TRIPLE PRECISION ADDDITION JMS I RAR1 /SINCE BITS ARE SHIFTED JMS I TRAD /RIGHT NORF, JMS I NORM /NORMALIZE THE RESULT JMP FPNT+1 /HINT:USE 700X FOR FUNCTIONS.
/INTERPRETIVE POWER NOP /3 FREE LOCATIONS ************ NOP NOP ZERO, DCA EXP /YES DCA HORD DCA LORD DCA OVER2 JMP FPNT+1 FLEX, PUSHF /AC TO A + POWER FLAC PUSHF /SETUP ARGUMENT ( THE EXPONENT) EX1 POPF FLAC JMS I INTEGER /ONLY POSITIVE, INTEGER EXPONENTS SPA JMP .+5 /(COULD DIVIDE) CMA DCA JUMP /TEMP STORAGE DCA OVER1 /(NOP) - FOR 4-WORD TAD HORD SZA CLA ERROR2 /TOO LARGE OR NEGATIVE EXPONENT PUSHF /INITIALIZE TO ONE. FLTONE POPF FLAC POPF ITER1 JMP .+6 PUSHF ITER1 POPF EX1 JMS I MULT /"MULT" ISZ JUMP JMP .-6 JMP FPNT+1
FLMY, JMS I MULT /MULTIPLY JMP FPNT+1 /------------------------------------------------------------ OPMINS, MINUS2 MULT, DMULT NORM, DNORM ALGN, ALIGN RAR1, DIV1 RAR2, DIV2 TRAD, DUBLAD ITABLE=.-1 FLAD FLSU FLDV FLMY FLEX 0000 NORF /------------------------------------------------------------ ACMINS, 0 /ROUTINE TO COMPLEMENT FLAC - VIA "MINSKI" CLL CLA TAD OVER2 /TRIPLE PRECISION NEGATION CMA IAC /OF FLOATING AC DCA OVER2 TAD LORD CMA SZL IAC CLL DCA LORD TAD HORD CMA SZL IAC CLL DCA HORD JMP I ACMINS /--RETURN--
ALIGN, 0 /SUBROUTINE TO ALIGN TAD HORD /BINARY POINTS SNA TAD LORD /IS MANTISSA ZERO? SNA CLA JMP NOX1 /YES, RESULT=OPERAND TAD AC1H /NO,IS OPERAND ZERO? SNA TAD AC1L SNA TAD OVER1 SNA CLA JMP I ALIGN /YES--RETURN-- TAD EX1 CMA IAC TAD EXP SNA /ARE EXPONENTS EQUAL? JMP ADONE /YES DCA ACMINS TAD ACMINS SMA /NO CIA /NEGATE AND DCA AMOUNT /SAVE THE DIFFERENCE TAD AMOUNT TAD TEST2 SPA CLA /CAN THE EXPONENTS BE ALIGNED? JMP NOX /NO, USE LARGER OF THE TWO. TAD ACMINS /YES, SHIFT THE SMALLER SMA CLA JMP ASHFT JMS DIV2 ISZ AMOUNT JMP .-2 JMP ADONE
ASHFT, CMA TAD EX1 DCA EX1 JMS I TAG1 ISZ AMOUNT JMP .-2 ADONE, ISZ ALIGN JMP I ALIGN /--RETURN-- NOX, TAD EX1 /MISSION IMPOSSIBLE! SMA CLA /CHECK FOR SIGN DIFFERENCE JMP NOX2 TAD EXP SMA CLA JMP I ALIGN /-+--RETURN-- JMP .+3 /-- NOX2, TAD EXP SMA CLA TAD ACMINS /TEMP STORAGE OF DIFFERENCE. BOTH POS EXP OR BOTH NEG. SMA SZA CLA JMP I ALIGN /OK (+-)--RETURN-- NOX1, TAD EX1 /USE LARGER DCA EXP TAD AC1H DCA HORD TAD AC1L DCA LORD TAD OVER1 DCA OVER2 JMP I ALIGN /--RETURN-- AMOUNT, 0 TAG1, DIV1
/LEAVE 12 BIT ANSWER IN AC UPON RETURN /LEAVE FLAC AS AN INTEGER, FIX, 0 /VIA (INTEGER) JMS I ABSOL TAD EXP /TEST FOR FRACTION SPA SNA CLA JMP FIXM /DOUBLE CHECK FOR MINUS ONE. IAC DCA OVER1 TAD P27 /INIT ALIGNMENT DCA EX1 JMS ALIGN /DO THE ALIGNMENT TO AN INTEGER TEST2, 0027 /ALREADY DONE; (43)-FOR 4-WORD ISZ OVER2 JMP .+4 ISZ LORD SKP ISZ HORD DCA OVER2 /CLEAR THE FRACTION JMS I RESOL TAD LORD /EXIT WITH LOW ORDER RESULT IN AC. JMP I FIX /--RETURN-- P27, 27 ABSOL, ABSOLV RESOL, RESOLV FIXM, DCA EXP /CLEAR EXPONENT DCA HORD DCA LORD JMP TEST2+6 DIV2, 0 /SHIFT FLAC RIGHT CLA CLL TAD HORD SPA CML RAR DCA HORD TAD LORD RAR DCA LORD TAD OVER2 RAR DCA OVER2 ISZ EXP JMP I DIV2 /--RETURN-- JMP I DIV2 /--RETURN-- /------------------------------------------------------------ SPECIAL=. /INPUT CHARACTERS 337 /LEFT ARROW 377 /RUBOUT 212 /L.F. 375 /ALT MODE -1 /------------------------------------------------------------
/(A+B+C)*(D+E+F)=A*D,A*E,B*D,B*E DMULT, 0 /N- PRECISION MULTIPLY WITH IAC /PRODUCT IN TRIPLE PRECISION TAD EX1 /ADD EXPONENTS+1 JMS SIGN /AND DETERMINE SIGN OF RESULT SPA CLA JMS MINUS2 DCA DATUM-1 /INITIALIZE RESULT DCA DATUM-2 DCA DATUM-3 DCA DATUM-4 TAD A /A*D SAVE /STORE IN MP2 TAD D /SINGLE PRECISION MULTIPLY MULTY 2 /ACCUMULATE STARTING IN #2 DATA WORD TAD E /A*E MULTY 3 TAD B /B*D SAVE TAD D MULTY 3 TAD E /B*E MULTY 4 DMULT4, JMP DMDONE /(DCA DATUM-5)-FOR 4-WORD DCA DATUM-6 TAD F /A*F SAVE TAD A MULTY 4 TAD B /B*F MULTY 5 TAD C /C*D SAVE TAD D MULTY 4 TAD E /C*E MULTY 5 TAD F /C*F MULTY 6
DMDONE, TAD DATUM-1 /COPY RESULT DCA HORD TAD DATUM-2 DCA LORD TAD DATUM-3 DCA OVER2 JMS MULDIV DCA OVER2 /(NOP) - FOR 4-WORD JMP I DMULT /--RETURN-- DATUM=.+6 /INTERMEDIATE STORAGE /#6-LOW ORDER RESULT /#5 /#4 /#3 /#2 /#1-HIGH ORDER RESULT *DATUM-1 MULDIV, 0 /TERMINATE MULTIPLY AND DIVIDE. ISZ SIGNF /CORRECT FOR SIGN JMS I MINSKI JMS I NORMF /SHIFT LEFT NOP JMP I MULDIV /--RETURN-- FLDV, TAD AC1H /4:DIVIDE SNA CLA ERROR2 /DIVISION BY ZERO TAD EX1 /SUBTRACT EXPONENTS+1 CMA IAC IAC JMS SIGN /SET UP SIGNS SMA CLA JMS MINUS2 /NEGATE DIVISOR JMS I DIVIDE /DIVIDE JMS MULDIV JMP I .+1 FPNT+1
/THIS SUBROUTINE PREPARES MULTIPLY AND DIVIDE /FOR ANY COMBINATION OF SIGNED ARGUMENTS AND FOR ZERO. /THE RESULT OF EITHER IS ZERO IF FLAC = 0. /RESULT OF MULTIPLY IS ZERO IF EITHER IS ZERO; /DIVISION BY ZERO IS CHECKED BEFORE THIS /ROUTINE IS CALLED. /THE CALLING AC CONTAINS AN UPDATE VALUE FOR THE /EXPONENT. THE RETURNING AC CONTAINS THE SIGN OF /THE ARGUMENT FOR FURTHER TESTING BY EACH ROUTINE. SIGN, 0 /TEST AND SAVE SIGN OF RESULT TAD EXP /COMPUTE NEW EXPONENT FOR MUL-DIV. DCA EXP TAD P4000 /LOAD 4000 TO XOR THE SIGN BITS AND HORD TAD AC1H SMA CLA /RESULT MAY BE ZERO CMA DCA SIGNF TAD HORD SNA JMP I REVIT /ANSWER IS ZERO. SPA CLA /TAKE ABSOLUTE VALUE OF FLAC JMS I MINSKI TAD AC1H SNA /RESULT OF EITHER MAY BE ZERO JMP I REVIT JMP I SIGN /--RETURN-- /SIGN OF RESULT = SIGNF /+=-1 /-=0 REVIT, ZERO NORMF, DNORM DIVIDE, DUBDIV SAVE=DCA I . MP2 MULTY=JMS I . MP4 A=FLAC+1 B=FLAC+2 C=FLAC+3 D=AC1H E=AC1L F=OVER1
MINUS2, 0 /NEGATE OPERAND CLA CLL /TRIPLE PRECISION TAD OVER1 CMA IAC DCA OVER1 TAD AC1L CMA SZL IAC CLL DCA AC1L TAD AC1H CMA SZL IAC CLL DCA AC1H JMP I MINUS2 /--RETURN-- RESOLV, 0 TAD SIGNF SPA CLA JMS I MINSKI JMP I RESOLV /--RETURN-- /------------------------------------------------------------ /------------------------------------------------------------ *7200 MP4, 0 /SINGLE PRECISION, UNSIGNED MULTIPLY - "MULTY" SNA /NO RESULT ADDED IF ZERO JMP I MP4 /--RETURN-- /FOR EAE INSERT THE FOLLOWING: /7203 3206 DCA .+3 /7204 1256 TAD MP2 /7205 7425 MQL MUY /7206 0000 0 /7207 3253 DCA MP5 /7210 7501 MQA /7211 3255 DCA MP3 /7212 5227 JMP .+15
DCA MP1 /12 BITS BY 12 BITS DCA MP5 TAD THIR DCA MP3 CLL MP6, TAD MP1 RAR DCA MP1 TAD MP5 SNL JMP .+3 CLL TAD MP2 RAR DCA MP5 /SAVE HIGH ORDER RESULT ISZ MP3 JMP MP6 TAD MP1 /CORRECT LOW ORDER RESULT RAR DCA MP3 TAD I MP4 /PICKUP SCALE FACTOR CIA TAD DATUMA /COMPUTE ADDRESS DCA MP1 /TEMP TAD MP3 /LOW ORDER PART CLL TAD I MP1 /ACCUMULATE DCA I MP1 ISZ MP1 RAL TAD MP5 TAD I MP1 DCA I MP1 SNL JMP I MP4 /NO CARRY--RETURN-- ISZ MP1 ISZ I MP1 JMP I MP4 /--RETURN JMP .-3 /CARRY AGAIN DATUMA, DATUM MP5, 0 /PRODUCT MP1, 0 /MULTIPLIER MP3, 0 MP2, 0 /MULTIPLICAND THIR, -14 /12 BITS
MIF, -27 /(-43) - FOR 4-WORD(=7735) DUBDIV, 0 /2 OR 3 PRECISION DIVIDE DCA MP4 DCA MP1 TAD MIF /INIT BIT COUNTER DCA MP3 SKP DV3, JMS I DOUBLE /SHIFT FLAC LEFT CLL TAD AC1L /COMBINE ONE POSITION AND (4-WORD) TAD LORD DCA MP2 /SAVE RESULT RAL TAD HORD /ADD OVERFLOW TAD AC1H SNL /SKIP IF OVERFLOW JMP .+4 DCA HORD /UPDATE FLAC TAD MP2 DCA LORD CLA /CLEAR ACCUMULATOR TAD MP1 /SAVE OVERFLOW BITS CIRCULARLY RAL DCA MP1 TAD MP4 RAL DCA MP4 ISZ MP3 /TEST FOR END OF DIVIDE JMP DV3 TAD MP1 /LOAD RESULTS DCA LORD TAD MP4 DCA HORD JMP I DUBDIV /(NOP)--RETURN-- RAL /EXTRA FOR 4-WORD DCA DNORM ISZ MP3 /TEST FOR END OF DIVIDE JMP DV3 TAD DNORM DCA HORD TAD MP4 DCA LORD TAD MP1 DCA OVER2 JMP I DUBDIV /--RETURN--
DNORM, 0 /SUBROUTINE TO NORMALIZE FLAC JMS I ABSOL3 JMS TEST4 TAD HORD SNA /IS MANTISSA=0? TAD OVER2 SNA TAD LORD SNA CLA JMP EXIT3 /YES TAD HORD RAL CLL SPA CLA /WILL SHIFT BE TOO FAR? JMP .+6 JMS I DOUBLE CMA CLL TAD EXP DCA EXP JMP .-10 JMS I RESOL3 JMS TEST4 /DON'T LEAVE 4000 JMP I DNORM /--RETURN-- EXIT3, DCA EXP /SET TO ZERO JMP I DNORM /--RETURN-- XRAR2, DIV2 TEST4, 0 TAD HORD /TEST FOR 4000 SPA CIA SPA CLA JMS I XRAR2 /SHIFT BACK JMP I TEST4 /--RETURN-- ABSOL3, ABSOLV RESOL3, RESOLV
/------------------------------------------------------------ /------------------------------------------------------------ *7400 /PAGE 18 /FLOATING SQUARE ROOT FUNCTION XSQRT, FINT FPUT FPAC1 /VALUE FEXT /NEWTON'S METHOD IS USED GETSGN SPA CLA ERROR2 /NUMBER IS NEGATIVE=IMAGINARY ROOTS TAD EXP /LINK IS =0 FROM FINT SPA /MATCH THE SIGN WITH LINK BIT CML RAR DCA ITER1 /MAKE FIRST APPROXIMATION SZL /TEST LSB OF EXP ISZ ITER1 NOP TAD SQCON1 DCA ITER1+1 DCA ITER1+2 DCA ITER1+3 TAD FPAC1+1 SNA TAD FPAC1+2 SNA CLA JMP SQEND /NUMBER=0 CLCU, FINT FGET FPAC1 FDIV ITER1 FADD ITER1 FEXT
CLA CMA TAD EXP DCA EXP TAD EXP CMA IAC TAD ITER1 SZA CLA /ARE EXPONENTS EQUAL? JMP ROOTGO /NO TAD HORD /ARE HIGH-ORDER MANTISSAS EQUAL? CMA IAC TAD ITER1+1 SZA CLA JMP ROOTGO /NO TAD LORD CMA IAC TAD ITER1+2 /DO LOW-ORDER MANTISSAS AGREE SMA CMA IAC /WITHIN ONE BIT? IAC SMA CLA RETURN ROOTGO, FINT FPUT ITER1 FEXT JMP CLCU SQEND, DCA EXP RETURN SQCON1, 3015 BUFFER=. ITER1, 0 0 0 0 FPAC1, 0 0 0 BUFFER+13 /ADDRESS OF NEXT FREE LOCATION IN 10-DIGIT VERSION. ENPUNCH $