/ FOCAL.ZZM / F O C A L / T H E F O R M U L A C A L C U L A T O R / FOR FORMULATING ON-LINE CALCULATIONS IN ALGEBRAIC LANGUAGE / ON THE FOLLOWING D.E.C. COMPUTERS: / 5, 8, 8/I, 8/S, 8/L, LINC-8, LAB-8, TSS-8, PDP-12 / SOURCE RECREATION, TIDYING UP BY: / CHARLES J. LASNER P?S NY / LAST EDIT: 08-APR-1987 23:00:00 CJL / F O C A L AND F L O A T / COPYRIGHT@ 1969 BY / DIGITAL EQUIPMENT CORPORATION / FOCAL IS A REGISTERED / TRADEMARK OF / DIGITAL EQUIPMENT CORPORATION / ALL RIGHTS RESERVED / 3RD REVISION FIXMRI AND= 0000 /ACTUAL MEMORY REFERENCE INSTRUCTIONS FIXMRI TAD= 1000 FIXMRI ISZ= 2000 FIXMRI DCA= 3000 FIXMRI JMS= 4000 FIXMRI JMP= 5000 FIXMRI FPOW= 5000 /PSEUDO-FLOATING POINT INSTRUCTIONS. FIXMRI FADD= 1000 FIXMRI FSUB= 2000 FIXMRI FMUL= 4000 FIXMRI FDIV= 3000 FIXMRI FGET= 0000 FIXMRI FPUT= 6000 FNOR= 7000 FEXT= 0000 FXIT= 0000 FINT= JMS I 7 NOP= 7000 CLA= 7200 CLL= 7100 CMA= 7040 RAL= 7004 CML= 7020 RAR= 7010 RTR= 7012 RTL= 7006 IAC= 7001 SMA= 7500 SZA= 7440 SPA= 7510 SNA= 7450 SNL= 7420 SZL= 7430 SKP= 7410 HLT= 7402 CIA= 7041 ION= 6001 IOF= 6002 KSF= 6031 KRB= 6036 TSF= 6041 TCF= 6042 TPC= 6044 TLS= 6046 PLS= 6026 RSF= 6011 RRB= 6012 RFC= 6014 SMP= 6101 RMF= 6244 / * FOCAL * - BY RICK MERRILL - FOR THE FAMILY OF 8. / 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= 00 /TEXT FIELD NO. P= 00 /PROGRAM FIELD NO. CDF= 7000 /(X-MEM) - OPR FPNT /ADDRESS OF FLOATING POINT INTERPRETER (LOC *7) / 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 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 T1, 0 /TEMPORARY REGISTER - MAIN T3, 0 /TEMP REGISTER FOR OUTPUT INBUF, 0 /KEYBOARD INPUT BUFFER BOTTOM, BEGIN-1 /LAST LOCATION CURRENTLY AVAILABLE IN FIELD ZERO ** 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. 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, "M&237 /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". "L&237 /F.F. "G&237 /BELL LIST7= . "C&237 /CONTROL-C FOR DEBUGGING AND TSS8 P337, "^+1 /LEFT ARR CLF, "J&237 /L.F. LIST3= . /EXCRETION LIST CCR, "M&237 /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, ". /PERIOD M77, -77 /EXTEND CODE TEST P7600, 7600 /GROUP MASK M20, -20 /CONSTANT P177, 177 /STEP MASK P17, 17 /BCD MASK P277, "? /"?" M2, -2 /CONSTANT MINUSA, -"A /CONSTANT C260, "0 /ASCII FOR ZERO M240, -" /SPACE TEST MPER, -". /PERIOD TEST MCR, -"M!100 /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 CFRS, FRST /ADDRESS OF DUMMY LINE. END, COMEIN /FIRST LOCATION USED IN 8K. ENDT, BUFBEG /START OF STORAGE AREA ** 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 .;XPUSHJ/RECURSIVE SUBROUTINE CALL POPA= TAD I PDLXR /RESTORE AC POPJ= JMP I .;XPOPJ /SUBROUTINE RETURN PUSHA= JMS I .;XPUSHA/SAVE AC PUSHF= JMS I .;PD2 /SAVE GROUP OF DATA POPF= JMS I .;PD3 /RESTORE GROUP GETC= JMS I .;UTRA /UNPACK A CHARACTER PACKC= JMS I .;PACBUF/PACK A CHARACTER SORTJ= JMS I .;SORTB /SORT AND BRANCH ON AC OR CHAR SORTC= JMS I .;XSORTC/SORT CHAR PRINTC= JMS I .;OUT /PRINT AC OR CHAR RDIV, READC= JMS I .;CHIN /READ DATA INTO CHAR AND PRINT IT PRNTLN= JMS I .;XPRNT /PRINT C(LINENO) GETLN= JMS I .;XGETLN/UNPACK AND FORM A LINENUMBER FINDLN= JMS I .;XFIND /SEARCH FOR A GIVEN LINE ENDLN= JMS I .;XENDLN/INSERT LINE POINTERS RTL6= JMS I .;XRTL6 /ROTATE LEFT SIX SPNOR= JMS I .;XSPNOR/IGNORE SPACES AND LEADING ZEROS TESTN= JMS I .;XTESTN/PERIOD; OTHER; NUMBER TSTLPR= JMS I .;LPRTST/SKIP IF 5 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 /ANNOUNCE PRESENCE PRINTC /BY TYPING THE LEAD-IN CHARACTER 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, "* /ACKNOWLEDGE CHARACTER COMBOT, COMEOUT+12 /END OF COMMAND BUFFER, LESS PROTECTION COUNT. / 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 /(X-MEM) 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 (X-MEM) 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 CLL RTL 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 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 /ABS -ABSOLUTE VALUE XSGN /SGN -SIGN PART XINT /ITR -INTEGER PART XDYS /DIS -DISPLAY AND INTENSIFY XRAN /RAN -RANDOM NUMBER XADC /ADC -READ ANALOG TO DIGITAL CONVERTER ARTN /ATN - FEXP /EXP -EXPONENTIAL FUNCTIONS FLOG /LOG - FSIN /SIN -TRIG FUNCTIONS FCOS /COS - XSQRT /SQT -SQUARE ROOT ERROR5 /NEW -USER DEFINED FUNCTIONS ERROR5 /COM - ERROR5 /X - XRTL6, 0 /ROTATE AC LEFT SIX - "RTL6" CLL RTL RTL RTL JMP I XRTL6 / 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 /(X-MEM) 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 (X-MEM) 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 (X-MEM) TSTGRP JMP DCONT /NOT IN GROUP TAD I PT1 /READ NEXT LINE NO. (X-MEM) 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; PROC /CONTINUE PROCESSING THIS LINE. / 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 PCHK, 0 TAD PDLXR /INC IN AC DCA PDLXR TAD PDLXR CLL CIA TAD LASTV SZL CLA ERROR3 /STORAGE FILLED BY PUSH-DOWN LIST JMP I PCHK 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 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 /EXIT INLIST= . /INPUT CONTROL CHARACTERS RECOVR /C.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, -"F /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 COMMENT=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 /TEST FOR END OF TEXT (X-MEM) WTEST2, SNA JMP WX-2 /EXIT; DO NEXT INDIRECT LINE. IAC DCA PT1 /SAVE POINTER TO LINENO OF NEXT TAD NAGSW SMA CLA TAD I PT1 /(X-MEM) TSTGRP /TRY NEXT LINENO FOR GROUP. JMP WX WALL, TAD I PT1 /SET LINENO (X-MEM) 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 TAD CHAR /NO ISZ XTESTC TAD MF SNA CLA /TEST FOR "F" JMP XT3 TESTN JMP I XTESTC /. SKP /OTHER JMP I XTESTC /NUMBER ISZ XTESTC XT3, ISZ XTESTC /RETURNS:T; N; F; A JMP I XTESTC 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 GRPTST, 0 /AC VS LINENO - "TSTGRP" AND P7600 CIA DCA T2 TAD LINENO AND P7600 TAD T2 SNA CLA ISZ GRPTST JMP I GRPTST / 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 READC SORTJ SPECIAL-1 INFIX-SPECIAL JMP I INPUT ILIST, IF1 /, PROCESS /; PC1 /CR / ENGLISH-FRENCH COMLST= . /COMMAND DECODING LIST "S /SET - ORGANIZE "F /FOR - QUAND "I /IF - SI "D /DO - FAIZ "G /GOTO - VA "C /COMMENT- COMMENTE "A /ASK - DEMANDE "T /TYPE - TAPE "L /LIBRARY- ENTREPOSE "E /ERASE - BIFFE "W /WRITE - INSCRIS "M /MODIFY - MODIFIE "Q /QUIT - ARRETE "R /RETURN - RETOURNE "*-40 /(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 UNTIL ,;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, -"= MCOM, -", FINFIN, PUSHF /SET INCREMENT TO ONE. FLTONE JMP FCONT / SET AND INTENSIFY THE POINT: FDIS(X,Y) XDYS, JMS I INTEGER /RETURN=INTEGER VALUE OF Y. PUSHA TAD CHAR TAD MCOM SZA CLA ERROR3 /ARG MISSING PUSHJ EVAL-1 JMS I INTEGER 6063 /DYL CLA POPA 6057 /DXL DIX SKP / 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, DCA DEBGSW /RE-ENABLE THE TRACE 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 CMA /NON-PRINTING DELAY FOR CR TCRLF, TAD CCR /EXCLAMATION POINT=CR, LF. PRINTC TASK4, GETC /MOVE TO NEXT CHARACTER JMP TASK COL, ": /":" / 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 /(X-MEM) 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 / ANALOGUE TO DIGITAL CONVERSION FOR AX08 XADC, JMS I INTEGER NOP /(IOF)-FOR OTHER BRANDS 6375 /ACMX ADCV 6332 /SKAD JMP .-1 6362 /RADC DCA FLAC+2 ION JMP I EFUN3I 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 SRNLST= . /'MODIFY' CONTROL CHARACTER TABLE SCHAR /F.F. = CONTINUE SCONT /BELL = CHANGE SEARCH CHARACTER RECOVR /C.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. "% /% "" /" "! /! "# /# "$ /$ GLIST= . " /SPACE TLIST= . ", /, "; /; "M&237 /C.R. / THIS LIST IS ENDED BY 'TESTC'. / FIND OR ENTER A VARIABLE IN THE LIST. GETARG, TESTC /FIRST LETTER OF ARG TLIST2, "" /" "M&237 /C.R. - FUNCTION OR NUMBER IS NOT AN ARG. ERROR4 /BAD ARGUMENT 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(CHANGE FOR X-MEM) 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 CLL CIA 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 GETC JMP XSPNOR+1 M260, -"0 M271, -"9 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 TAD CHAR TAD M271 SPA SNA CLA ISZ XTESTN /IF A NUMBER JMP I XTESTN 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 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 /EVALUATION 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,"J&237 /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' " /SPACE 0 "+ /+ 1 "- /- 2 "/ // 3 "* /* 4 "^ /UP ARR 5 "( /( 6 L-PARS "[ /[ 7 "< /< 10 ") /) 11 R-PARS "] /] 12 "> /> 13 ", /, 14 "; /; 15 "M&237 /C.R. 16 "= /= 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; OPNEXT /FUNCTION RETURN IS OK 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 TAD SORTCN TAD M5 SMA SZA CLA ISZ LPRTST JMP I LPRTST 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 / 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 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 CDF T /CHANGE DATA FIELD TO TEXT.(X-MEM) 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 CLL CIA 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 FNTABL= . "A^2+"B^2+"S /ABS "S^2+"G^2+"N /SGN "I^2+"T^2+"R /ITR "D^2+"I^2+"S /DIS "R^2+"A^2+"N /RAN "A^2+"D^2+"C /ADC "A^2+"T^2+"N /ATN "E^2+"X^2+"P /EXP "L^2+"O^2+"G /LOG "S^2+"I^2+"N /SIN LIST OF CODED FUNCTION NAMES "C^2+"O^2+"S /COS "S^2+"Q^2+"T /SQT "N^2+"E^2+"W /NEW "C^2+"O^2+"M /COM "X /X / 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 /(X-MEM) ERV, TAD STARTV /ERASE VARIABLES ** DCA LASTV 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 /(X-MEM) TSTGRP /SKIP IF G(AC) = G(LINENO) JMP ERV TAD I THISLN /(X-MEM) DCA LINENO JMP ERG ERVX, TAD STARTV /INIT VARIABLES MAY BE INDIRECT COMMAND 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(X-MEM) 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 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 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 GET3, TAD I AXOUT /(X-MEM) DCA GTEM CMA DCA XCT TAD GTEM CLL RTR RTR RTR JMP GEND M40, -40 M137, -137 XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" CDF T /(X-MEM) 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 (X-MEM) DCA LASTV JMP I XENDLN 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, 0 /NO-INTERRUPT INPUT ROUTINE KSF JMP .-1 KRB AND P177 /IGNORE PARITY BIT SNA JMP .-5 TAD C200 JMP I I33 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 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 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 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, CDF P /(X-MEM) JMP I PACBUF ESCA, TAD P77 JMS PCK1 JMP PA1 PCK1, 0 ISZ XCTIN /=0 TO START JMP ROT TAD ADD DCA I AXIN /(X-MEM) DCA ADD /CLEAR PACKING WORD TAD PDLXR /CHECK FOR OVERFLOW CLL CMA IAC TAD P13 /RESERVATIONS FOR PUSH-DOWN LIST TAD AXIN SNL CLA JMP I PCK1 ERROR2 /FULL BUFFER P40, 40 P377, 377 C140, 140 RUBIT, RUB1 M140, -140 ROT, RTL6 /(EAE) DCA ADD CMA DCA XCTIN JMP I PCK1 /REST OF PAGE USED BY 8K PAGE / 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 KRB /READ BUFFER AND CLEAR FLAG TO FETCH NEXT AND P177 /IGNORE BLANK AND L-T AND PARITY BIT. SNA JMP EXIT TAD C200 DCA SIN TAD SIN TAD MBREAK /MANUAL STOP? SNA CLA JMP RECOVR TAD INBUF /ANY SPACE? SZA CLA ERROR2 /WILL WAIT FOR OUTPUT BUFFER TAD SIN DCA INBUF /SAVE INPUT 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 CLL RAL 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 DCA INBUF /CLEAR INPUT BUFFER TAD XOUTL JMP I XI33 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 / 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, TAD C200 DCA LINENO /SAVE ERROR NUMBER ISZ TELSW /TURN ON IN-PROGRESS SWITCH TAD M20 /SETUP INIT COUNT DCA CNTR CMA TAD OPTR0 DCA AXIN /INIT I/O BUFFERS. CDF P /(X-MEM RESET) DCA I AXIN ISZ CNTR JMP .-2 DCA INBUF /INIT KEY-BUFR. TAD OPTR0 /INIT TTY POINTERS. DCA OPTRI TAD OPTR0 DCA OPTRO RECOVX, CMA /PREPARE A STOP BIT FOR TTY TLS /AND RAISE FLAG. (NOP) - FOR DEBUGGING TAD P7700 /MAKE A "?". PRINTC /AND TURN ON THE INTERRUPT PRNTLN /PRINT ERROR NUMBER AND, ISZ PC TAD I PC /UNLESS IT IS ZERO, (X-MEM) 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 CDF T /(X-MEM) 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.(X-MEM) 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(X-MEM)):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, . / (X-MEM) 0000 / (X-MEM) "(^100+")-200 /(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. "C^100+"--200 /TITLE "F^100+"O-300 /FO "C^100+"A-300 /CA "L^100+",-200 /L, "1^100+"9-200 /19 FRSTX, "6^100+"9-200 /69 "?^100+"M-300 /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, RECOVR+1 /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 6772 /CLEAR 552 CLA CLL DCA I FLTXR ISZ CNTR /INITIALIZED BY LOAD. JMP .-2 /CLEAR INPUT BUFFER / TEST FOR COMPUTER TYPE TAD PDP /CREATE THE VARIABLE 'PDP' JMS LOOKUP /MUST RETURN ZERO 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-3 /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-5 CLL IAC /LAB-8? 6344 /"OTEN" 6331 /"XRIN" SMA CLA JMP .+6 /NO TAD L8A /YES DCA I L8AY TAD L8B /SETUP SCOPE CONTROLS DCA I L8AX JMP ATES-4 7354 /NL3776 TAD PDP8I /IS THIS A PDP-8/I OR 8/L? SNA CLA JMP ATEI 7344 /NL7776 TAD P2 SNA CLA JMP ATES-1 /8 TAD CCR+1 /PDP-8/S DCA I O6 /SETUP PARITY-ERROR HALT TAD O4 /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 TAD CNTR TAD FOUTPUT SPA CLA JMP ATES-2 /8/I ISZ I PT1 /8/L = 7/2^11 ISZ I PT1 /PDP-12 = 6/2^11 ISZ I PT1 /LAB-8 = 5/2^11 ISZ I PT1 /LINC-8 = 4/2^11 ISZ I PT1 /8/I = 3/2^11 ISZ I PT1 /8 = 2/2^11 ATES, ISZ I PT1 /8/S = 1/2^11 /5 = 0 / INITIALIZE THE DIALOGUE TLS ION /ENABLE INTERRUPT PUSHJ DO+1 IOF / SHALL I KEEP EXP, LOG, ATN? (256) / SHALL I KEEP SIN, COS? (128) / XF = +1(NO) -1(YES) 0(YES) TAD XF JMS LOOKUP SNA JMP OOUT /NO DIALOGUE EXECUTED SPA CLA TAD P2 TAD M5 /DELETE X-FUNCTIONS 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 I .+1; ERT /GOES TO START AFTER ERASING ALL L8A, 6313 L8B, 6307 L8AY, XDYS+11 L8AX, XDYS+14 FNPT, FNTABF+5 ER5, ERROR5 BFXX, TGO-FEXP /WITHOUT BFX, FEXP-1 /WITH XF, "X^100+"F-300 /X, F O2, EXITJ /INTERRUPT EXIT PDP, "P^100+"D-300 /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 /HAMILTON STANDARD READER SUBROUTINE. TAD M20 /(CMA)- 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 SNL CLA JMP I .+3 /YES=DIRECT COMMAND ISZ PDLXR /NO=OK TO DUMP CALL POPJ IBAR HSWITC, 0 TAD HSPSW /INITIALIZE H.S. READER CMA DCA HSPSW /CHANGE STATUS CLL CMA /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 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 HSPSW, 0 HTST, -COMEOUT-13 RESTR, HREAD-CHIN / DISK MONITOR INTERACTIVE COMMAND OPERATES VIA THE KEYBOARD. / THIS FITS UNDER THE 10 DIGIT 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 JMP I P7600 /(7600=DISK MONITOR) 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 PRINTD, 0 AND LP7 TAD C260 PRINTC TAD T1 JMP I PRINTD LP7, 7 / USED BY 8K