/**** FOCAL 5/69 **** /E.A.TAFT - REVISION OF FOCALW 8/68 /EAT/ 25-JUL-72 /ASSEMBLY INSTRUCTIONS FOR DECUS VERSION: /INPUT FILES: / FOCAL.569 FOCAL LANGUAGE PROCESSOR / FLOAT.569 FLOATING POINT PACKAGE / EXTEND.569 EXTENDED FUNCTION PACKAGE / 2USER.569 2-USER OVERLAY /ASSEMBLY USING PAL10 V.141 / .R PAL10 / *FOCAL.BIN_FOCAL.569,FLOAT.569 / *EXTEND.BIN_EXTEND.569 / *2USER.BIN_2USER.569 / *^C / .R PIP / *FOCAL.BIN/B_FOCCAL.BIN,EXTEND.BIN,2USER.BIN / *PTP:/I_FOCAL.BIN /WHEN READ-IN ON A PDP-8, THE LOADER WILL STOP 3 TIMES. THE FIRST / SECTION CONTAINS THE BASIC PROCESSOR AND FLOATING POINT PACKAGE. / THE SECOND SECTION CONTAINS THE EXTENDED FUNCTIONS. THE LAST / SECTION CONTAINS THE 2-USER OVERLAY (REQUIRES 2 TERMINALS AND 8K). EXPUNGE /PROCESSOR INSTRUCTIONS FIXMRI AND=0000 FIXMRI TAD=1000 FIXMRI ISZ=2000 FIXMRI DCA=3000 FIXMRI JMS=4000 FIXMRI JMP=5000 /FLOATING POINT INSTRUCTIONS FIXMRI FPW=0000 FIXMRI FAD=1000 FIXMRI FSB=2000 FIXMRI FMY=3000 FIXMRI FDV=4000 FIXMRI FGT=5000 FIXMRI FPT=6000 FNR=7000 FEXT=0 FENT=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 CIA=7041 ION=6001 IOF=6002 KSF=6031 KRB=6036 TSF=6041 TCF=6042 TPC=6044 TLS=6046 RSF=6011 RRB=6012 RFC=6014 FIXTAB / * FOCAL * - BY RICK MERRILL - FOR THE FAMILY OF 8. /REVISED BY EDWARD TAFT 5/69 /MISCELLANEOUS ITEMS *1 JMP I .+1 /INTERRUPT PROCESSOR ENTRY INTRPT MINUSA, -301 /CONSTANT FNEGSW, 0 /USED FOR CALCULATING SIGNS P13, 13 /CONSTANT C100, 100 /CONSTANT FPNT /ADDRESS OF FLOATING POINT INTERPRETER. /AUTO-INDEX REGISTERS AXIN, 0 /STORAGE INDEX XRT, 0 /EXTRA XR XRT2, 0 /EXTRA XR PDLXR, 0 /PUSHDOWN LIST INDEX REGISTER. FLTXR, IOBUF-1 /XR15 FOR FLOATING POINT C200, 200 /CONSTANT XRT3, 0 /USED BY PUSHDOWN LIST CONTROLS TEXTP=. /TEXT POINTERS AXOUT, FRSTX /OUTPUT INDEX XCT, 0 /UNPACK SWITCH GTEM, 0 /UNPACK STORAGE /NUMBERS PER, 256 /PERIOD M77, -77 /RIGHT MASK P7600, 7600 /GROUP MASK M20, -20 /CONSTANT P177, 177 /STEP MASK BOTTOM, DBCONV-1/END OF TEXT BUFFER FLOAT= JMS I . /FLOAT C(AC) SUBROUTINE XFLOAT P17, 17 /BCD MASK P277, 277 /"?" C240, 240 /SPACE M2, -2 /CONSTANT P2, 2 /CONSTANT C260, 260 /ASCII FOR ZERO HINBUF, 0 /HIGH SPEED INPUT BUFFER FLOP=. /FLOATING OPERAND STORAGE FLOP0, 0 FLOP1, 0 FLOP2, 0 FLOP3, 0 FLAC=. /FLOATING POINT ACCUMULATOR FLAC0, 0 FLAC1, 0 FLAC2, 0 FLAC3, 0 NEGATE= JMS I . /NEGATE FLAC ROUTINE NEGAC TOTDIG, 10 /TOTAL DIGITS IN OUTPUT FIELD FIX= JMS I . /FIX FLAC ROUTINE XFIX TABCTR, 0 /CARRIAGE INDEX /CONSTANTS LIST6=. /INPUT LIST FOR "SFOUND". P337, 337 /LEFT ARR 214 /F.F. 207 /BELL CLF, 212 /L.F. LIST3=. /EXCRETION LIST CCR, 215 /LIST BRANCHER. 0 /SEARCH CHARACTER (VARIABLE) M100=. P7700, 7700 /LEFT MASK M240, -240 /SPACE TEST MPER, -256 /PERIOD TEST MCR, -215 /C.R. TEST MFLT=. /3-WORD FLOATING POINT M3, -3 M5, -5 /PAREN TEST M11, -11 /PAREN TEST P77, 77 /RIGHT MASK FOUTPUT,BDCONV /FLOATING OUTPUT FINPUT, DBCONV /FLOATING INPUT COMBUF, COMEIN /COMMAND BUFFER`START CFRS, FRST /ADDRESS OF DUMMY LINE. END, BUFBEG /FIRST LOCATION USED. ENDT, BUFBEG /START OF STORAGE AREA ** RETURN= JMP I . /FUNCTION RETURN EFUN3I, EFUN3 /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 ASR-33 INTO CHAR AND PRINT IT CHIN PRNTLN=JMS I . /PRINT C(LINENO) XPRNTLN 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 0 DCA PC /FOR COMMAND MODE DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?). TAD COMBOT /PROTECT COMMAND BUFFER. DCA PDLXR /NO PATCH TEST. ISZ DMPSW /INIT UNPACK AND TRACE SWITCH. DCA LIST3+1 /CLEAR SEARCH CHARACTER FOR INPUT. TAD P337 /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 LIST6-1 INLIST-LIST6 PACKC /SAVE STRING CHARACTER. JMP IGNOR ///// P4000, 4000 /LINE NUMBER TEST COMBOT, COMOUT+12 /END OF COMMAND BUFFER,LESS PROTECTION COUNT. CFRSX, FLTZER /POINTER FOR PC=COMMAND OR INPUT ///// /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? ERROR4 /ILLEGAL GROUP ZERO USAGE JMP INPUTX /NO IOF /YES,STOP INPUT MOMENTARILY. ISZ DEBGSW /DISABLE TRACE FOR REPACKING GETLN /READ THIS LINE NUMBER TAD NAGSW TAD P4000 /TEST FOR SINGLE LINE 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. PACKC /SAVE TEXT AND RESTORE DATA FIELD TAD CHAR /TEST FOR END OF INPUT STRING TAD MCR SZA CLA JMP .-5 PUSHJ /REMOVE OLD LINE, IF ANY. DELETE ENDLN /INSERT NEW LINE JMP START ///// 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. XRTL6, 0 /ROTATE AC LEFT 6 CLL RTL RTL RTL JMP I XRTL6 / /PROCESS A LINE NUMBER - "GETLN" XGETLN, 0 SPNOR TAD P4000 /INITIALIZE TO SINGLE LINE DCA NAGSW SORTC /TEST FOR A SIGN SNLIST-1 JMP EVLN /EVALUATE IN FLOATING POINT JMS I INPINT /FIXED POINT: GET GROUP TESTN GETC /GO PAST . IF THERE JMS GEG /GET 1ST STEP DIGIT CLL RTL /MULTIPLY BY TEN TAD SORTCN RAL JMS GEG /GET 2ND STEP DIGIT TAD LINENO /COMBINE GEXIT, SNA DCA NAGSW /MUST BE GROUP DCA LINENO /SAVE STEP NUMBER TAD DECNUM /GROUP SNA JMP GTESTA /GROUP 0: MUST BE "ALL" RTL6 /CONSTRUCT LINE NUMBER RAL TAD LINENO DCA LINENO TAD DECNUM /TEST FOR LEGAL GROUP AND C7760 JMP .+3 GTESTA, ISZ NAGSW /SET TO "ALL" TAD LINENO /MAKE SURE LINE # IS ZERO SNA CLA TESTN /OK, TEST FOR EXTRA DIGITS JMP LNERR /DOUBLE ., ILLEGAL G. 0, OR G.>15 JMP I XGETLN /OK JMP LNERR /TOO MANY DIGITS GEG, 0 /GET A STEP DIGIT DCA LINENO TESTN LNERR, ERROR /DOUBLE PERIODS JMP GEXIT-1 /NO DIGIT GETC /DIGIT, PASS IT TAD SORTCN /EXIT WITH VALUE JMP I GEG ///// INPINT, DECINT C7760, 7760 ///// /EVALUATE A LINE NUMBER IN FLOATING POINT EVLN, PUSHJ /GET VALUE EVAL FIX /GET GROUP # PUSHA TAD FLAC1 SZA CLA JMP LNERR /TOO BIG FENT /GET STEP # FNR FSB I FLARGP /THIS GIVES -(FRACTIONAL PART) FMY I F10P FMY I F10P FSB I FP10P /KILL ANY ROUNDOFF ERROR FEXT NEGATE POPA /RESTORE GROUP DCA DECNUM FIX JMP I .+1 GEXIT ///// F10P, FLTEN FP10P, FLPTEN /RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 15.99 /NAGSW: /GROUP=0000 /LINE=4000 /ALL=0001 /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 JMP TGRP2 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 TSTERM /GO TO TERMINATOR JMP .-1 JMP I .+2 /END OF DO, CONTINUE PROCESSING JMP DO /COMMA, DO ANOTHER PROC TGRP2, TAD THISLN /TEST FOR GOOD GROUP NUMBER. DCA XRT TAD I XRT TSTGRP ERROR2 /NO SUCH GROUP NUMBER JMP DGRP1 /PUSHDOWN LIST CONTROLS / XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA" DCA PD2 /SAVE AC CMA /BACK UP POINTER JMS PCHK /CHECK CORE USAGE TAD PD2 DCA I XRT3 /SAVE JMP I XPUSHA ///// PCHK, 0 TAD PDLXR /INC IN AC DCA PDLXR TAD PDLXR DCA XRT3 /DUPLICATE POINTER TAD PDLXR CLL CIA TAD LASTV SZL CLA ERROR /STORAGE FILLED BY PUSHDOWN LIST JMP I PCHK ///// XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ" CLA IAC TAD XPUSHJ /SAVE RETURN JMS XPUSHA /(PUSHA) TAD I XPUSHJ /TO NEW ROUTINE DCA XPUSHJ JMP I XPUSHJ ///// PD2, 0 /SAVE A FLOATING PT NUMBER - "PUSHF" CLA CMA /COMPUTE ADDRESS TAD I PD2 DCA XRT ISZ PD2 TAD M3 /BACKUP THREE JMS PCHK TAD I XRT /SAVE 3 WORDS DCA I XRT3 TAD I XRT DCA I XRT3 TAD I XRT DCA I XRT3 JMP I PD2 PD3, 0 /RESTORE A FLOATING PT # - "POPF" CLA CMA TAD I PD3 ISZ PD3 DCA XRT TAD I PDLXR DCA I XRT TAD I PDLXR DCA I XRT TAD I PDLXR DCA I XRT JMP I PD3 / /INPUT CONTROL CHARACTERS INLIST, IBAR /B.A.=RESTART IGNOR+4 /F.F. IGNOR+4 /BELL IGNOR /L.F.=IGNORED IRETN /C.R.=TERMINATE INPUT / /LIST OF FUNCTION ADDRESSES FNTABF, XABS /ABSOLUTE VALUE FSGN /SIGN PART XINT /INTEGER PART XDYS /FDIS- DISPLAY Y AND INTENSIFY FRAN /RANDOM NUMBER XDXS /SET X-COORDINATE FOR DISPLAY XADC /READ ANALOG-DIGITAL CONVERTER ERROR5 /ATN THESE ROUTINES NOT IN PACKAGE ERROR5 /EXP ERROR5 /LOG ERROR5 /SIN ERROR5 /COS FSQT /SQUARE ROOT ERROR5 /NEW- USER-DEFINED FUNCTION / 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 OR A TIGHT LOOP. TAD THISLN /SET PC DCA PC PROCESS,GETC /TEST FOR END OF LINE PROC, SORTC /FIRST CHARACTER READY = USE PROC CCR-1 PC1, POPJ /EXIT "PROCESS" SORTC /IGNORE SPACE ; , GLIST-1 JMP PROCESS TAD CHAR /SAVE COMMAND CHARACTER PUSHA GETC /GO TO TERMINATOR SORTC TERMS-4 SKP JMP .-4 SPNOR POPA SORTJ /GO DO COMMAND COMLST-1 COMGO-COMLST ERROR2 /ILLEGAL COMMAND ///// COMMENTS=PC1 /ALSO IS CONTINUE /OUTPUT COMMAND TEXT WRITE, JMS I WTXS /SAVE CHAR AND TEXT POINTERS 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 WEXIT /WRITE FINISHED IAC DCA PT1 /SAVE POINTER TO LINENO OF`NEXT (X-MEM) 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+3 /// WTESTG, TAD THISLN /INIT GROUP PRINTOUT JMP WTEST2 ///// WX, TAD NAGSW SPA SNA CLA /SKIP IF ALL JMP WEXIT PRINTC /PRINT C.R. AGAIN JMP WALL ///// WEXIT, JMS I WTXR /RESTORE CURRENT LINE DCA DEBGSW /RESTORE TRACE TSTERM JMP .-1 JMP PROC /END OF WRITE JMP WRITE /COMMA, MORE TO WRITE ///// WTXS, TXTSAV WTXR, TXTRES 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 ISZ XTESTC TESTN JMP I XTESTC /. (PART OF NUMBER) SKP /OTHER JMP I XTESTC /NUMBER TAD CHAR /TEST FOR "F" TAD MF SZA CLA ISZ XTESTC /NO ISZ XTESTC /RETURNS: JMP I XTESTC /TERMINATOR;NUMBER;FUNCTION;OTHER ///// 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 /COMMAND DECODING LIST COMLST, 323 /SET 306 /FOR 311 /IF 304 /DO 307 /GOTO 303 /COMMENT OR CONTINUE 301 /ASK 324 /TYPE 314 /LIBRARY 305 /ERASE 327 /WRITE 315 /MODIFY 321 /QUIT 322 /RETURN 317 /OPTION 310 /HELLO /CONDITIONAL TRANSFER PROCESS / IF (EXP) A,B,C IF, SORTC /LOOK FOR L-PAR PLPR-1 SKP ERROR /NO ( AFTER IF PUSHJ /EVALUATE EXPRESSION EVAL-1 GETC /PASS ) TAD FLAC1 /TEST FOR -,0,+ SPA CLA JMP I PGOTO /NEGATIVE, USE 1ST REF TSTERM /0 OR POS, GET TO NEXT JMP .-1 JMP I PRCP /; OR CR, CONTINUE SAME LINE TAD FLAC1 /COMMA, SEE IF 0 OR POS SNA CLA JMP I PGOTO /ZERO, USE 2ND REF TSTERM /POSITIVE, GET TO NEXT JMP .-1 JMP I PRCP /; OR CR JMP I PGOTO /COMMA, USE 3RD REF PGOTO, GOTO PLPR, 250 /ASSIGNMENT AND LOOP CONTROL SET=. FOR, PUSHJ /GET POINTER TO VAR. GETARG SPNOR SORTC /SEARCH FOR = TERMS+17-1 SKP ERROR /LEFT OF = IN ERROR: "FOR" OR "SET" TAD PT1 /SAVE VARIABLE POINTER DCA PT2 PUSHJ /EVALUATE INITIAL EXPRESSION EVAL-1 FENT /SAVE INITIAL VALUE FPT I PT2 FEXT TSTERM /CHECK TERMINATOR ERROR /PROBABLY EXCESS R-PAR JMP I PRCP /; OR CR: THIS IS A SET; CONTINUE TAD PT2 /COMMA, SAVE LOOP VAR POINTER PUSHA PUSHJ /EVALUATE SECOND EXPRESSION EVAL TSTERM /CHECK TERMINATOR ERROR /EXCESS R-PAR OR BAD TERMINATOR JMP ONEINC /; OR CR, THAT'S ALL (INC=1) PUSHF /COMMA, SAVE INCREMENT FLARG PUSHJ /EVALUATE FINAL EXPRESSION EVAL SFINAL, PUSHF /SAVE FINAL VALUE FLARG JMS I FTXS /SAVE CHAR AND TEXT POINTERS FLOAT /FLOAT A ZERO TO START FCONT, FENT /COMPARE LOOP VAR TO FINAL FAD I PT2 /LOOP VAR FPT I PT2 FSB I FLARGP /FINAL FEXT TAD PDLXR /CHECK SIGN OF INCREMENT TAD PINC DCA PT2 TAD I PT2 SPA CLA NEGATE /BACKWARD COUNTING TAD FLAC1 SMA SZA CLA JMP FEND /LIMIT REACHED OR EXCEEDED PUSHJ /NOT YET, DO OBJECT STATEMENTS PRCP, PROC JMS I FTXR /RESET TO BEGINNING OF OBJ. STMT. POPF /RESTORE LIMIT FLARG POPF /RESTORE INC FLAC POPA /RESTORE LOOP VAR POINTER DCA PT2 TAD M13 /PUSH DOWN ALL OF ABOVE TAD PDLXR DCA PDLXR JMP FCONT ///// ONEINC, PUSHF /NO INCREMENT GIVEN, SET TO 1 FLTONE JMP SFINAL ///// PINC, 11 M13, -13 FTXS, TXTSAV FTXR, TXTRES FEND, TAD P13 /END OF LOOP TAD PDLXR /REMOVE VALUES!FROM PUSHDOWN LIST DCA PDLXR POPJ PT2, 0 ///// /ASK/TYPE SPECIAL CHARACTERS ALIST, 246 /& 245 /% 242 /" 241 /! 243 /# 244 /$ GLIST, 240 /SPACE TLIST, 254 /, 273 /; 215 /C.R. /SET Y AND INTENSIFY THE POINT XDYS, FIX 6063 /DYL CLA TAD X0 6053 /DXL DIX SKP / /SET X XDXS, FIX DCA X0 /(DXL) RETURN / /TAKE THE INTEGER PART XINT, FIX CLA RETURN X0, 0 ///// TLIST3, TASK4 /" TASK /C.R. - AUTOMATIC QUOTE MATCH /COMMAND POINTERS COMGO, SET FOR IF DO GOTO COMMENTS ASK TYPE LIBRARY ERASE WRITE MODIFY START RETRN OPTION HELLO ///// PACLS2, PQUES RUB1 /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 JMS I TTXTS /PROTECT TEXT TAD COL /TYPE COLON TASKCL, PRINTC /(CLA) TO SUPPRESS ":" JMS I INTERP /CALL INPUT CONVERSION ROUTINE JMS I TTXTR /RESTORE TEXT JMP ASK /CONTINUE PROCESSING INTERP, INTASK //// TYPE2, PUSHJ /DO TYPE EVAL TSTERM ERROR /BAD TERMINATOR IN "TYPE" COL, 272 JMS I OUTS /PRINT JMP TYPE ///// TTXTS, TXTSAV TTXTR, TXTRES OUTS, OUTPT TQUOT, ISZ DEBGSW /DISABLE TRACE GETC /TYPE LITERALS SORTJ TLIST2-1 TLIST3-TLIST2 PRINTC JMP TQUOT+1 ////// TCRLF, TAD CCR /SLASH=CR,LF. PRINTC TASK4, GETC /MOVE TO NEXT CHARACTER JMP TASK //// TCRLF2, TAD CCR /SPLAT=CR JMS I OUTDEV TAD C200 /DELAY FOR C.R. JMP TCRLF+1 /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. TINTR, GETC /PASS PERCENT SIGN JMS I INTG /READ FORMAT CONTROL: "%7.3" TAD DECNUM /INTEGER PART (TOTAL DIGITS) DCA TOTDIG TESTN /GET PAST . IF ANY GETC JMS I INTG /RIGHT-HAND PART (DECIMAL PLACES) TAD DECNUM DCA DECP JMP TASK INTG, DECINT /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. SNA /CHECK FOR ALL JMP MODIFY+2 /ERROR IN ARG 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 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 SORTB /SETUP RETURN TAD I SORTB DCA SORTB SKP SEX, ISZ SORTB /MATCH NOT FOUND. CLA CLL JMP I SORTB /RETURN TO CALLING SEQUENCE. TAB, PUSHJ /TABULATE TO A PARTICULAR COLUMN EVAL-1 FIX /GET COLUMN NUMBER CLL CIA IAC TAD TABCTR SZL CLA JMP TASK /ALREADY THERE OR PAST IT TAD C240 PRINTC TAD FLAC2 /TEST AGAIN JMP TAB+3 SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE SBAR /B.A. = RESTART SCHAR /F.F. = CONTINUE SCONT /BELL = CHANGE SEARCH CHARACTER SCONT+1 /L.F. = FINISH THE LINE AS BEFORE. ///// LISTGO, INPUTX-11 /C.R. - END THE MODIFIED LINE HERE SGOT /FOUND SEARCH CHARACTER /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' CLA CMA /"GETARG" CAN CREATE NEW VAR. GETVAR, PUSHA /"GETVAR" WILL NOT DCA XCTIN /PACK INTO ADD. PACKC GETC /SECOND LETTER SORTC /TERMINATOR? TERMS-1 JMP .+3 /YES TAD CHAR /NO AND P77 /SAVE 2AND LETTER OF NAME TAD ADD PUSHA SORTC /IGNORE THE REST TERMS-1 JMP .+3 GETC JMP .-4 TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN JMP GS1 /NOT SUBSCRIPTED BY L-PAR. TAD LASTOP /SAVE LAST OPERATION PUSHA PUSHJ /MOVE PAST L-PAR AND EVAL-1 /EVALUATE THE SUBSCRIPT. GETC /MOVE PAST R-PAR POPA DCA LASTOP /RECALL LAST OPERATION FIX GS1, DCA SUBS /SAVE SUBSCRIPT POPA DCA ADD /RESTORE NAME TAD STARTV /SEARCH FOR VARIABLE GS3, DCA PT1 TAD PT1 DCA XRT 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 GS2, ISZ I PDLXR /VAR. NOT FOUND, CAN I MAKE ONE? ERROR /UNDEFINED VAR. USED IN EXPRESSION TAD LASTV /OK, 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 TAD SUBS /SAVE SUBSCRIPT DCA I XRT DCA I XRT /INITIALIZE VAR. TO ZERO DCA I XRT DCA I XRT JMP GS5 /EXIT ///// GFND1, TAD I XRT /FOUND NAME, TEST SUBSCRIPT CIA TAD SUBS SZA CLA JMP GS4 /WRONG SUBSCRIPT ISZ PDLXR GS5, ISZ PT1 /SET POINTER TO DATA ISZ PT1 POPJ //// P0, FLTZER /IGNORE LEADING SPACES - "SPNOR" SUBS=. XSPNOR, 0 TAD CHAR TAD M240 SZA CLA JMP I XSPNOR GETC JMP XSPNOR+1 ///// /SEE IF NEXT CHARACTER IS A NUMBER XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN" TAD CHAR TAD MPER /TEST FOR . SZA ISZ XTESTN /NOT A . TAD NTST1 /COMPARE TO "9" SMA JMP NTEXIT /TOO LARGE TAD NTST2 /COMPARE TO "0" SPA JMP NTEXIT /TOO SMALL DCA SORTCN /FOUND DIGIT, SAVE IT ISZ XTESTN NTEXIT, CLA CLL JMP I XTESTN ///// NTST1, 256-272 NTST2, 272-260 /EXIT FROM A "DO" SUBROUTINE RETRN, TAD P0 /(PC) => 0 DCA PC XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ" DCA T2 JMP I T2 /ASK-TYPE CONTROL CHARACTER TABLE ATLIST, TAB /& - TABULATION DELIMITER 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 ///// FLTONE, 0001 2000 FLTZER, 0000 0000 0000 /EVALUATE AN EXPRESSION WHICH /TERMINATES WITH AN R-PAR,; OR C.R. AND /LEAVE THE RESULT IN FLAC AND IN FLARG. GETC /MOVE PAST EXTRA CHARACTER EVAL, DCA LASTOP /EVAUATION CONTROLLER (CHECKPOINT ?) TESTC /TEST CHARACTER AND IGNORE SPACES JMP ETERM1 /TERMIOATION 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, PUSHF /INITIALIZE RESULT TO ZERO. FLTZER POPF FLARG TAD FLARGP /SET PT1. DCA PT1 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, CLA IAC /COMPARE PRIORITIES AND THISOP /PRIORITIES ARE: (^),(*/),(+-),PUT TAD THISOP CIA DCA FLOPR IAC AND LASTOP TAD LASTOP TAD FLOPR SPA CLA JMP EPAR /CONTINUE TAD LASTOP /FIND OPERATION FROM TABLE TAD OPTABL DCA FLOPR TAD I FLOPR DCA FLOPR TAD LASTOP SZA CLA /TEST FOR END OF DATA INTO FLOATING AC. POPF /GET LAST DATA FLAC FENT FLOPR, 00 /(FLOPR I PT1) +-*/^ FPT I FLARGP /SAVE RESULT FEXT 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, OPTABS ///// ENUM, PUSHF /TO PROCESS A NUMBER,SAVE AC FLAC TAD FLARGP /SET POINTER AS FOR A VARIABLE. DCA PT1 JMS I FINPUT /READ TEXT NUMBER => (PT1) POPF /RESTORE THE AC FLAC JMP OPNEXT /CONTINUE ///// EFUN, DCA FLOPR /SET CODE GETC /READ FUNCTION NAME.(1,2,OR 3 LETTERS) SORTC /LOOK FOR TERMINATION CHARACTER. TERMS-1 JMP EFUN2 /YES TAD FLOPR /NO CLL RAL /MISH-MASH HASH CODE TAD CHAR JMP EFUN ELPAR, TSTLPR ERROR4 /DOUBLE OPERATORS EPAR2, TAD SORTCN /LEFT PARENS FOUND. PUSHA TAD LASTOP /SAVE DATA PUSHA PUSHJ /EVALUATE THE EXPRESSION EVAL-1 JMP I EFUN3I /// EFUN2, TAD SORTCN /SAVE 'SORTCN','LASTOP',AND FUNC CODE PUSHA TAD LASTOP PUSHA TAD FLOPR /SAVE FUNCTION CODE. PUSHA TSTLPR ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT PUSHJ /YES EVAL-1 POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I. SORTJ FNTABL-1 FNTABF-FNTABL ERROR2 /ILLEGAL FUNCTION NAME. ///// 241 /! 242 /" 256 /. -FOR INPUT NUMBERS 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' OPTABS, FGT I PT1 FAD I PT1 FSB I PT1 FDV I PT1 FMY I PT1 FPW I PT1 ///// FLARG, 0 /DATA TEMPORARY STORAGE 0 0 ///// /FOCAL TEXT FOR "HELLO" COMMAND HPT, 7056 /[T %] 8.4; 6473 1740 /OPTION K,T,I,E,:,S; 1354 2454 1154 0554 7254 2373 0540 /ERASE ALL 0177 1500 ///// /ABSOLUTE VALUE FUNCTION XABS, TAD FLAC1 SPA CLA NEGATE /CONTINUATION OF FUNCTION CALLS. EFUN3, POPA /RESTORE LAST OPERATION DCA LASTOP FENT FNR /NORMALIZE FUNCTION RETURN FPT FLARG FEXT TAD FLARGP /SET POINTER DCA PT1 POPA /GET LAST PAREN CODE. CIA /CHECK FOR PAREN MATCH. TAD M3 TAD SORTCN /(STILL SET FROM THE LAST "EVAL") SZA CLA /SKIP IF MATCH ERROR4 /PAREN ERROR GETC /MOVE PAST R-PAR, AND RETURN TO OPNEX. JMP I .+1 /FUNCTION RETURN IS OK OPNEXT //// 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 /THE DELETE A LINE ROUTINE DELETE, FINDLN /SETS "THISLN" AND "LASTLN". POPJ /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 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 DELETE /RESET 'LASTLN','THISLN', AND DATA`FIELD. ///// /OPTION TABLE OPTTBL, OPTK /SWITCH TO KEYBOARD INPUT OPTR /READER INPUT OPTT /TTY OUTPUT OPTP /PUNCH OUTPUT OPTI /INTERPRETIVE/NUMERIC I/O OPTC /SINGLE CHARACTER I/O OPTCOL /PRINT ":" AT "ASK" OPTX /SUPPRESS ":" OPTE /ECHO KEYBOARD INPUT OPTN /NO ECHO OPTS /SET VARIABLE TERMINATOR OPTM /START DISK MONITOR FNTABL=. 2533 /ABS 2650 /SGN 2636 /ITR 2565 /DIS 2630 /RAN 2623 /DXS 2517 /ADC 2572 /ATN 2624 /EXP 2625 /LOG 2654 /SIN /LIST OF CODED FUNCTION NAMES 2575 /COS 2702 /SQT 2631 /NEW /ERASE SINGLE LINES, GROUPS, OR VARIABLES ERASE, TAD CHAR /SEE IF "ALL" TAD MINUSA SZA CLA JMP ERVX TAD ENDT /YES, ERASE ALL TEXT DCA BUFR DCA I CFRS ERV, TAD STARTV /ERASE VARIABLES DCA LASTV JMP START /PROGRAM EXECUTION ENDS ///// ERVX, GETLN /GET LINE NUMBER TAD LINENO /SEE OF ZERO OR NONE SZA CLA JMP ERL /NO, ERASE LINES TAD STARTV /YES, ERASE VARIABLES DCA LASTV JMP I .+1 /CONTINUE PROCESSING PROC ///// ERL, TAD BUFR /ERASE LINES DCA AXIN ERG, PUSHJ /EXTRACT ONE LINE DELETE ISZ THISLN TAD NAGSW SMA CLA TAD I THISLN TSTGRP /IF GROUP, SEE IF END OF GROUP JMP ERV /YES TAD I THISLN /NO, CONTINUE ERASING GROUP DCA LINENO JMP ERG /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 XRT2 TAD LINENO CIA TAD I XRT2 /LINENO=0 WILL ALSO BE FOUND SNA ISZ XFIND /FOUND IT (2ND EXIT) SMA CLA JMP FEND3 /PAST IT. TAD THISLN /MOVE POINTERS DCA LASTLN TAD I THISLN SZA /SKIP IF END OF TEST JMP FINDN FEND3, TAD THISLN 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 RTL6 RAL JMP GEND M40, -40 M137, -137 ///// /OPTION LIST OPTLST, "K "R "T "P "I "C ": "X "E "N "S "M ///// /ANALOG-DIGITAL CONVERSION XADC, 6004 DCA FLAC1 /ARG MUST BE 0 RETURN XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" 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 DCA LASTV JMP I XENDLN ///// TXTSAV, 0 /SAVE CHAR AND TEXT POINTERS PUSHF TEXTP TAD CHAR PUSHA JMP I TXTSAV / TXTRES, 0 /RESTORE SAME POPA DCA CHAR POPF TEXTP JMP I TXTRES ///// GRPTST, 0 /AC VS LINENO - "TSTGRP" AND P7600 CIA DCA T2 TAD LINENO AND P7600 TAD T2 SNA CLA ISZ GRPTST JMP I GRPTST /I-O SUBROUTINES VAL=. CHIN, 0 /READ IN A CHARACTER SUBR. - "READC" JMS I INDEV DCA CHAR SORTC /LINEFEED OR RUBOUT? ECHOLST-1 JMP I CHIN /YES ECHO, PRINTC TAD CHAR /SEE IF 200 (L/T) TAD P7600 SZA CLA JMP I CHIN /NO, EXIT JMP CHIN+1 /YES, GET ANOTHER ///// 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 ///// /TEST FOR A COMMA, SEMICOLON, OR CR - "TSTERM" /RETURNS: OTHER, ; OR CR, COMMA /GETS NEXT CHARACTER AFTER COMMA OR OTHER XTSTER, 0 SORTC /LOOK FOR ,;CR TLIST-1 SKP JMP .+6 /OTHER, GO PAST IT TAD SORTCN /FOUND ONE, SEE WHAT IT IS ISZ XTSTER SZA CLA JMP I XTSTER /; OR CR: 2ND EXIT ISZ XTSTER /COMMA, 3RD EXIT GETC JMP I XTSTER ///// COMEIN=.-1 /COMMAND-INPUT BUFFER LIVES HERE. COMOUT=2600 *COMOUT /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 KSF /CHECK FOR KEYBOARD FIRST JMP TINT KRB /READ BUFFER AND CLEAR FLAG TO FETCH NEXT AND P177 /IGNORE PARITY BIT 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 TINT, TSF JMP EXIT TCF DCA TELSW /TURN OFF THE IN-PROGRESS FLAG. TAD I OPTRI SNA JMP EXIT /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 EXIT, 6244 /RESTORE MEMORY FIELD 6101 /SMP NOP /(HLT)-IF YOU HAVE MEMORY PARITY RSF /TEST H.S. READER FLAG JMP .+3 RRB /READ BUFFER AND CLEAR FLAG DCA HINBUF /SAVE CHARACTER TAD SAVLK RAL CLL TAD SAVAC ION EXITJ, JMP I 0 TELSW, 1 /INPUT SWITCH OPTR0, IOBUF /OUTPUT POINTERS OPTRO, IOBUF /VARS OPTRI, IOBUF INBUF, 0 /KEYBOARD BUFFER. ///// 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. TAD XI33 /IS IT A CR? TAD MCR SNA CLA DCA TABCTR /YES, RESET CARRIAGE INDEX TAD XI33 JMS I SKPNP /SKIP IF A NON-PRINTING CHARACTER ISZ TABCTR /PRINTING: INCREMENT INDEX SIN, 0 ION /BE SURE INTERRUPT IS ON. TAD I OPTRO /ANY ROOM? SZA CLA /A CHARACTER IS NON-ZERO JMP .-2 /NO = WAIT. TAD TELSW /IN PROGRESS? SZA CLA JMP .+5 TAD XI33 /NO TLS /TYPE CHARACTER. DCA TELSW /SET IN-PROGRESS FLAG. JMP I XOUTL /RETURN TAD XI33 /SEND DATA DCA I OPTRO TAD OPTRO /SET POINTERS IAC AND P17 TAD OPTR0 DCA OPTRO JMP I XOUTL /////// SKPNP, SKIPNP ERROR2=ERROR; ERROR3=ERROR; ERROR4=ERROR WAITP, OWAIT OPTDOP, OPTTDO 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. JMS I WAITP /WAIT FOR OUTPUT TO FINISH 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 XRT /INIT I/O BUFFERS. DCA I XRT ISZ CNTR JMP .-2 DCA INBUF /INIT KEY-BUFR. TAD OPTR0 /INIT TTY POINTERS. DCA OPTRI TAD OPTR0 DCA OPTRO JMS I OPTDOP /SET TO TTY OUTPUT TAD PTCH /RESET "READC" DCA 113 /IF AN ERROR OCCURS. CMA /PREPARE A STOP BIT FOR TTY TLS /AND RAISE FLAG CLA TAD CCR /PRINT A CR PRINTC TAD P277 /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 PRINTC PRINTC /PRINT SPACE AGAIN AND PRNTLN /PRINT LINE OF ERROR. TAD CCR PRINTC JMP START /INTERRUPT WILL BE RE-ENABLED SOON. ///// /SKIP IF (AC) IS A NON-PRINTING CHARACTER SKIPNP, 0 RTL6 /PRINTING CHARACTERS ARE 240-337 SPA CLA CML SNL ISZ SKIPNP JMP I SKIPNP ///// /PACK A CHARACTER INTO THE BUFFER - "PACKC" PACBUF, 0 SORTJ /LOOK FOR ? OR RUBOUT PACLST-1 PACLS2-PACLST TAD CHAR JMS SKIPNP /PRINTING CHARACTER? JMP .+3 /YES TAD P77 /NO, PACK 77 FIRST JMS PCK1 TAD CHAR /PACK 6-BIT CHARACTER AND P77 JMS PCK1 JMP I PACBUF ///// PQUES, TAD P337 /USE 337 FOR ? JMP .-4 ///// /PACK ONE 6-BIT WORD PCK1, 0 ISZ XCTIN JMP ROT /PACK LEFT HALF TAD ADD /PACK RIGHT HALF AND STORE DCA I AXIN TAD PDLXR /CHECK FOR SPACE CLL CIA TAD P13 TAD AXIN SZL CLA ERROR /BUFFER OR STORAGE OVERFLOW JMP I PCK1 ///// PACLST, 277 /? 377 /RUBOUT ///// ROT, RTL6 /SAVE LEFT HALF DCA ADD CMA DCA XCTIN JMP I PCK1 /RUBOUT ONE CHARACTER RUB1, TAD AXIN /SAVE POINTER DCA PCK1 TAD XCTIN /CHARACTER IN ADD? SZA CLA JMP RUB2 /YES TAD AXIN /NO, BEGINNING OF BUFFER? CIA TAD PACKST SMA CLA JMP PKZERO /YES, IGNORE RUB2, TAD SPLAT /ECHO A BACKSLASH PRINTC ISZ XCTIN JMP RUB3 /BACKUP STORAGE TAD I PCK1 /KILL ADD AND CHECK FOR 77 AND P77 /IN 2ND HALF OF LAST STORED WORD TAD M77 SZA CLA JMP PKZERO /NO, DONE RUB3, TAD I PCK1 /KILL 2ND HALF OF LAST STORED WORD AND P7700 DCA ADD CMA /BACKUP POINTER TAD AXIN DCA AXIN TAD ADD /TEST FOR 77 IN ADD TAD C100 SZA CLA CMA PKZERO, DCA XCTIN JMP I PACBUF SPLAT, 334 /DUMP THE SYMBOL TABLE CONTENTS TDUMP, PUSHF /SAVE TEXT POINTERS TEXTP CMA TAD STARTV /START VARIABLE LIST TDLOOP, DCA FLTXR TAD FLTXR /TEST FOR END OF LIST CMA TAD LASTV SNA CLA JMP TDEND /END FOUND TAD TDTEXT /NO, SET UP POINTERS DCA AXOUT DCA XCT TAD I FLTXR /2 LETTERS OF VAR. NAME DCA TDTEXT+1 PUSHJ /PRINT NAME AND "(" TQUOT TAD I FLTXR /GET AND PRINT SUBSCRIPT JMS I TDOUTP PUSHJ /PRINT ")=" TQUOT TAD P13 /SPACE TO 11TH COLUMN DCA FLAC2 PUSHJ TAB+12 ISZ FLTXR FENT /PICK UP VALUE FGT I FLTXR /(DOES NOT AUTOINDEX) FEXT JMS I FOUTPUT /PRINT VALUE TAD CCR /AND A C.R. PRINTC TAD FLTXR /INCREMENT FOR NEXT VAR. TAD P2 JMP TDLOOP TDEND, POPF /RESTORE TEXT POINTERS TEXTP JMP I .+1 TASK4 TDOUTP, SIGOUT TDTEXT, . /THE FOLLOWING IS FOCAL TEXT 0 /VAR. NAME GOES HERE 5077 /"(" AND C.R. 1551 /")=" AND C.R. 7577 1500 /OPTION ROUTINES / /ROUTINE TO SET UP OUTPUT OPTTDO, 0 TAD CTSF DCA I OPTTL /TSF TAD I OPTTL IAC DCA I OPTTL+1 /TCF TAD I OPTTL+1 TAD P2 DCA I OPTTL+2 /TPC TAD I OPTTL+2 TAD P2 DCA I OPTTL+3 /TLS JMP I OPTTDO CTSF, TSF OPTTL, TINT TINT+2 TINT+7 SIN+11 ///// /ROUTINE TO WAIT UNTIL OUTPUT FINISHES OWAIT, 0 ION /(SWAP) - FOR 2-USER TAD I TSWP /LOOK AT TELSW SZA CLA JMP .-3 JMP I OWAIT TSWP, TELSW ///// OPTP, JMS OWAIT /SET UP FOR PUNCH OUTPUT TAD M20 /CONVERT TO PSF, ETC. SKP OPTT, JMS OWAIT /SET UP FOR TTY OUTPUT JMS OPTTDO OPTXIT, JMP I .+1 /EXIT OPTIONS OPTRET OPTX, TAD OPTC1 /SUPPRESS ":" ON ASK OPTCOL, TAD CPRINT /RESTORE ":" DCA I COLP JMP OPTXIT CPRINT, PRINTC OPTC1, CLA-PRINTC COLP, TASKCL ///// OPTE, TAD CPRINT /SET UP FOR KEYBOARD ECHO OPTN, DCA I ECHP /SUPPRESS ECHO JMP OPTXIT ECHP, ECHO ///// OPTS, GETC /SET UP USER TERMINATOR FOR "ASK" SORTC TERMS-3 SKP JMP .-4 PUSHJ /GET CHARACTER EVAL FIX DCA I USERTP JMP OPTXIT USERTP, USERT ///// OPTM, JMS OWAIT /EXIT TO DISK MONITOR IOF JMP I P7600 ///// /THIS IS THE INITIALIZATION COMMAND HELLO, TAD HP DCA AXOUT DCA XCT PUSHJ /START BY SETTING FORMAT TINTR ///// HP, HPT-1 /FOCAL TEXT "%8.4;O K,T,I,E,:,S;E A" / I/O MODE OPTIONS OPTC, CLA CMA OPTI, DCA IOSW JMP OPTXIT ///// IOSW, 0 / I/O MODE: "I" = 0000 = INTERPRETIVE INPUT, NUMERIC OUTPUT / "C" = 7777 = SINGLE CHARACTER I/O ///// /"ASK" MASTER ROUTINE INTASK, 0 TAD PT1 /SAVE VAR. POINTER DCA OWAIT TAD IOSW /WHAT MODE OF INPUT? SNA CLA JMP STRING /INTERPRETIVE READC /SINGLE CHARACTER TAD CHAR /CONVERT CHARACTER CODE TO FLOATING FLOAT /POINT NUMBER ASKEND, FENT /SAVE VALUE FPT I OWAIT FEXT JMP I INTASK /INTERPRETIVE BUFFERED INPUT STRING, TAD PDLXR /SAVE PUSHDOWN LIST POINTER DCA OPTTDO TAD BUFTOP /PROTECT TOP OF ASKBUF DCA PDLXR ISZ DEBGSW /DISABLE TRACE INBARR, TAD BUFBOT /INITIALIZE ASKBUF DCA AXIN DCA XCTIN TAD BUFBOT DCA PACKST READC /IGNORE SPACES SORTC C240-1 JMP .-3 SORTJ /SEARCH FOR TERMINATOR ASKLST-1 ASKLS2-ASKLST PACKC /PACK INTO BUFFER INGT, READC JMP .-5 /TERMINATOR FOUND, PROCESS INPUT INTERM, TAD CCR /PACK A C.R. DCA CHAR PACKC PACKC TAD OPTTDO /RESTORE PDLXR DCA PDLXR TAD BUFBOT /INITIALIZE UNPACKING DCA AXOUT DCA XCT PUSHJ /EVALUATE EXPRESSION EVAL-1 JMP ASKEND ///// BUFBOT, ASKBUF /BOTTOM OF BUFFER BUFTOP, ASKBND /TOP+12 OF BUFFER ///// /"TYPE" OUTPUT OUTPT, 0 TAD IOSW /WHAT KIND OF OUTPUT SZA CLA JMP COUTPT /SINGLE CHARACTER JMS I FOUTPUT /NUMERIC OUTPUT, PRINT VALUE JMP I OUTPT ///// COUTPT, FIX /GET CODE FOR CHARACTER SNA /MODULO 256 CLL CML RAR /TO ALLOW ZERO CODE TO BE PRINTED JMS I OUTDEV JMP I OUTPT /NOTE: "TDUMP" PRINTS ONLY IN NUMERIC MODE IOBUF=3400 / *IOBUF+20 FRST, 0 /TEXT POINTER 0000 /DUMMY LINE NO 0355 / C- 0617 / FO 0301 / CA 1454 / L, 4040 6557 / 5/ FRSTX, 6671 / 69 7715 BUFBEG=. ///// LIBRARY=ERROR5 /COMMAND NOT AVAILABLE /FOCAL INITIALIZATION ROUTINE *BUFBEG BEGIN, CLA CLL TAD (RECOVR+1 /RESTORE RESTART DCA START-1 IOF /CLEAR FLAGS TO PREVENT INTERRUPT 6022 /PCF 6032 /KCC 6203 /CDF CIF 00 6402 /CLEAR PT08'S 6412 6422 6432 6442 6452 6462 6472 6764 /CLEAR DECTAPE 6772 CLA TLS /START LOW SPEED OUTPUT DCA I FLTXR /CLEAR OUTPUT BUFFER ISZ (-20 JMP .-2 TAD BOTTOM /INITIALIZE PUSHDOWN LIST DCA PDLXR ION PRINTC /CHAR IS A C.R PRINTC PRINTC PUSHJ /TYPE FOCAL HEADING WRITE JMP I .+1 ERV-3 /ERASE ALL