Directory of image this file is from
This file as a plain text file
/FOCAL-8 /DEC-8E-LFOCA-A-LA1 /OCTOBER 1971 RM/SM /COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION / MAYNARD, MASSACHUSETTS 01754 /FOCAL IS A REGISTERED TRADEMARK OF /DIGITAL EQUIPMENT CORPORATION /FOCAL-8 IS AN ON-LINE FORMULA CALCULATOR AND /COMPILER FOR STATEMENTS IN ALGEBRAIC LANGUAGE /THIS VERSION OF FOCAL-8 IS SUPPORTED ON THE PDP-8/E /ASSEMBLY INSTRUCTIONS: /.R PAL8 OR .R PAL10 /*FOCAL8,FOCAL8_FOCAL8,FLOAT
/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 *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 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/*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, -2u~ /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) ARTN /FATN -ARCTANGENT FEXP /FEXP -E^X FLOG /FLOG -LN(X) FSIN /FSIN -SINE FCOS /FCOS -COSINE 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* PAUSE