/PFOC1D -- PS/8 FOCAL MAIN INTERPRETER /THIS VERSION OF PS/8 FOCAL WAS DERIVED FROM THE FOLLOWING / FOCAL-8 SOURCE: /*********************************************************************** /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 /*********************************************************************** /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 FENT=JMS I 7 RFC=6014 SMP=6101 KCF=6030 DCMA=6601 NEGATE=JMS I 51 FIELD 1 /MISCELLANEOUS ITEMS *0 ECHOP, ECHO RISZ, 0 /RANDOM RANDOM #'S 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, FEXP-1 /PUSHDOWN LIST INDEX REGISTER. FLTXR, IOBUF-1 /XR FOR FLOATING POINT FLTXR2, 0 /EXTRA FOR F.P. TELSW, 0 /CLEAR IN-PROGRESS FLAG TEXTP=. /TEXT POINTERS (LOC *17) AXOUT, 0 /OUTPUT INDEX XCT, 0 /UNPACK SWITCH GTEM, 0 /UNPACK STORAGE PC, PC0 /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, STVAR /ADDRESS OF LAST VARIABLE /*8K* T1, 0 /TEMPORARY REGISTER - MAIN T3, 0 /TEMP REGISTER FOR OUTPUT INBUF, 0 /KEYBOARD INPUT BUFFER BOTTOM, FEXP-1 /LAST LOCATION CURRENTLY AVAILABLE IN FIELD ZERO INSUB, 0 /0= GETC; #0 = READC GOK, GOKILL /TO KILL 'CURRENT PROGRAM SAVED' FLAG / *40 = FLOATING POINT *54 /VARIABLES - INITIALIZED FOR THE DIALOGUE SORTCN, 0 /NUMBER IN TABLE FROM SORTC LASTOP, 0 /LAST OPERATION FOR EVAL EFOP, 0 /FUNCTION CODE. CNTR, -20 /DELETE AND ERROR COUNTER(USED BY F.P. ALSO) BUFR, LINE1 /NEXT LOCATION IN BUFFER = LAST LOCATION OF TEXT/*8K* ADD, XOUTL /CHAR. BUF. IN. XCTIN, 0 /PACK SWITCH OUTDEV, XOUTL /POINTER TO OUT. SUB. INDEV, XI33 /POINTER TO IN. SUB. NAGSW, 0001 /NOT ALL AND/OR GROUP SWITCH(4000=ONE;1=ALL;0=GROUP) CHAR, 215 /THE MOST IMPORTANT REGISTER LINENO, 0000 /LINE NUMBER READ BY GETLN 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. *73 LIST6, 214 /F.F. (^L) 207 /BELL LIST7=. P337, 337 /LEFT ARR CLF, 212 /L.F. LIST3=. /EXCRETION LIST CCR, 215 /LIST BRANCHER. DMPSW, HLT /(SEARCH CHARACTER)-VARIABLE /=0000 FOR TRACE ON. /THE REST OF PAGE ZERO IS PURE TO THE MULTI-USER SYSTEM M100=. P7700, 7700 /LEFT MASK PER, 256 /PERIOD M77, -77 /EXTEND CODE TEST P7600, 7600 /GROUP MASK M20, -20 /CONSTANT P177, 177 /STEP MASK P17, 17 /BCD MASK P277, 277 /"?" M2, -2 /CONSTANT MINUSA, -301 /CONSTANT C260, 260 /ASCII FOR ZERO M240, -240 /SPACE TEST MPER, -256 /PERIOD TEST MCR, -215 /C.R. TEST MFLT, -WORDS /= -4 FOR 4-WORD M5, -5 /PAREN TEST M11, -11 /PAREN TEST P77, 77 /RIGHT MASK C200, 200 /CONSTANTS P4000, 4000 /NAGSW TEST CONSTANT (FOR PDP-5) FLARGP, FLARG /DATA ADDRESS DOUBLE, MULT2 /MULTIPLY FLAC BY 2 FOUTPUT,FLOUTP /FLOATING OUTPUT FINPUT, FLINTP /FLOATING INPUT COMBUF=. LIBN, LIBFIL /COMMAND BUFFER START CFRS, LINE0 /ADDRESS OF DUMMY LINE STARTV=. END, STVAR /VARIABLE BUFFER START ENDT, LINE1 /TEXT BUFFER START EFUN3I, EFUN3 /FUNCTION RETURN CFRSX, FLTZER /MOVED FOR ^L FUDGE /'FINPUT' USES CHAR AND GETC OR READC TO DEVELOP /A NUMBER WHICH IS THEN STORED VIA PT1. WORDS=4 /OR 3 /NEW INSTRUCTIONS: PUSHJ=JMS I . /RECURSIVE SUBROUTINE CALLS XPUSHJ POPJ=JMP I . /RECURSIVE RETURN XPOPJ PUSHA=JMS I . /SAVE AC XPUSHA POPA=JMS I . /RESTORE AC XPOPA PUSHF=JMS I . /SAVE FP # PD2 POPF=JMS I . /RESTORE FP # 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 XPRNTC, 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 5ARG JMP ETERMN /T ECHOLST,0212 /N-ERROR IN FORMAT 0377 /F JMP ETERM+1 /'EVAL' FOUND A TERMINATOR WHICH WAS NOT /END OF EXPRESSION (NOT ERROR!) 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 /-------------------------------------------------------------------- POPA /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' GOKILL, CDF DCA I LIBN /ZERO 'CURRENT PROGRAM SAVED' FLAG CDF 10 JMP START /----------------------------------------------------------------------- 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 POPA /REVERSE THESE TWO INSTRUCTIONS TAD P3 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 CDF /CHANGE DATA FIELD FOR 'DELETE' 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 SORTJ /USE 'SORTJ' INSTEAD OF 'SORTC' ECHOLST-1 /SO 'SORTCN' DOESN'T GET KILLED ECHOGO-ECHOLST PPRNT, PRINTC /ECHO THE INPUT JMP I CHIN /--RETURN-- /------------------------------------------------------------------- FNTABL=. 2533 /FABS 2650 /FSGN 2636 /FITR 2565 /FDIS 2630 /FRAN 2637 /FJOY 2572 /FATN 2624 /FEXP 2625 /FLOG 2654 /FSIN 2575 /FCOS 2702 /FSQT 1140 /FIN 2672 /FOUT 2604 /FIND 2657 /FTIM /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 CDF DCA I CFRS /ERASE ALL TEXT JMP I GOK 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 JMS I DTHIS /TAD I THISLN TSTGRP /DONE ERASING GROUP? JMP I GOK /YES, ERASE 'CURRENT PROGRAM SAVED' FLAG JMS I DTHIS /TAD I THISLN DCA LINENO JMP ERG ERVX, TAD END /ZERO VARIABLES (BUT NOT SECRET VARIABLES) 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. JMS I DXRT /TAD I XRT SNA JMP FEND3-1 /FOUND IT. SZL CLA JMP FEND3 /PAST IT. TAD THISLN /MOVE POINTERS DCA LASTLN JMS I DTHIS /TAD I THISLN 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, JMS I DAXOUT /TAD I AXOUT DCA GTEM CMA DCA XCT TAD GTEM RTR CLL RTR RTR JMP GEND M40, -40 M137, -137 XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" CDF 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 DCA I LIBN /WE'VE ADDED A NEW LINE CDF 10 /KILL 'CURRENT PROGRAM SAVED' FLAG 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 INPUT+1 /^L IN ASK STATEMENT, IGNORE IT FLTONE, 0001 /(NO RELATIVE REFERENCES) 2000 FLTZER, 0000 0000 0000 0000 M12, -12 /DECIMAL CONVERSION FACTOR FOR "PRNT" /---------------------------------------------------------------------- XPUSHJ, 0 CLA CLL IAC TAD XPUSHJ /BUMP RETURN ADDRESS PUSHA /SAVE IT ON THE STACK TAD I XPUSHJ /GET THE ADDRESS DCA XPUSHJ /INDIRECT INDIRECT! JMP I XPUSHJ 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 CIF JMS I TAB /COUNT CHARACTERS JMP OUTCR /IT WAS A CR, PRINT CR/LF JMS I OUTDEV /PRINT NORMAL CHAR JMP I OUT OUTCR, TAD CCR JMS I OUTDEV TAD CLF JMS I OUTDEV TAD C200 /PRINT 2 NULLS AFTER JMS I OUTDEV /EACH CR/LF TAD C200 JMP OUTCR-2 TAB, TABCNT 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 10 /RESTORE FIELD AFTER 'PACKC' JMP I PACBUF /--RETURN-- ESCA, TAD P77 JMS PCK1 JMP PA1 PCK1, 0 ISZ XCTIN /=0 TO START JMP ROT TAD ADD JMS I DAXIN /DCA I AXIN 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 PS8PC, 0 /PC CDF TAD I PC CDF 10 JMP I PS8PC *2600 /INTERRUPT PROCESSOR. SAVAC, 0 /CONTENTS OF AC SAVLK, 0 /CONTENTS OF LINK INTRPT, DCA SAVAC /SAVE WORKING DATA RAR DCA SAVLK 6133 /CLSK - SKIP ON CLOCK FLAG & CLEAR IT JMP TINT ISZ FTIMCT /INCREMENT AND TEST COUNTER JMP TINT /NO SUPER-TICK YET TAD FTIMCS /SUPER-TICK - RESET COUNTER DCA FTIMCT ISZ FTIMER /INCREMENT TIMER CLA CLL TINT, 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 TAD MCTRLP SNA / CTRL/P? JMP RECOVR /YES TAD MCTRLC /NO; CTRL/C? SNA JMP CTRLC /YES TAD CTRSTR /RESTORE DCA INBUF SKP KCC /INITIATE NEXT READ--CHAR. WAS BLANK EXIT, 6662 /PCLF - CLEAR LPT FLAG /CLEAR COMMON FLAGS DCMA /CLEAR DF32 FLAG CLA CLL TAD SAVLK CLL RAL TAD SAVAC CIF CDF /RETURN FROM INTERRUPT JMP INRTRN CTRLC, CIF CDF JMP I .+1 7600 MCTRLP, -220 MCTRLC, -203+220 CTRSTR, +203 /TO RESTORE TO ORIGINAL VALUE FTIMCS, 0 /FUNCTION 'FTIM' VARIABLES FTIMCT, 0 FTIMER, 0 OPTR0, IOBUF /OUTPUT POINTERS OPTRO, IOBUF /VARS OPTRI, IOBUF RANRAN, ISZ RISZ /BUMP RANDOM NUMBER JMP XI33+1 /WHILE WAITING FOR INPUT JMP RANRAN /DON'T LEAVE ZERO XI33, 0 /VIA (INDEV) TAD INBUF /ANY INPUT? SPA SNA JMP RANRAN /NO = WAIT DCA XOUTL DCA INBUF /CLEAR INPUT BUFFER KCC /INITIATE NEXT READ TAD XOUTL /GET CHAR 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 XOUION /RETURN TAD XI33 /SEND DATA DCA I OPTRO TAD OPTRO /SET POINTERS IAC AND P17 TAD OPTR0 DCA OPTRO XOUION, ION JMP I XOUTL /--RETURN-- /ERROR RECOVERY PROCEEDURE ERROR5, DCA .+1 ERR2, 0 ION TAD TELSW /WAIT FOR OUTPUT TO FINISH SZA CLA JMP .-2 CLA CLL CMA /PUT ERROR CODE IN 'LINENO' FOR 'PRNTLN' TAD ERR2 SKP RECOVR, TAD C200 /TELETYPE BREAK DCA LINENO IOF TAD M20 /CLEAR OUTPUT BUFFER DCA CNTR CMA TAD OPTR0 DCA AXIN TAD OPTR0 DCA OPTRI TAD OPTR0 DCA OPTRO CDF 10 DCA I AXIN ISZ CNTR JMP .-2 DCA INBUF /AND INPUT BUFFER RECOVX, CIF CDF /DO LOWER FIELD FIXES JMP I .+1 XRESTOR RECOVY, TAD P277 PRINTC /PRINT A '?'? PRNTLN ISZ PC JMS I DPC SNA JMP .+6 DCA LINENO TAD P7700 PRINTC PRINTC PRNTLN TAD CCR PRINTC 6132 /CLDI - DISABLE CLOCK INTERRUPT JUST IN CASE JMP START /CHARACTER 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 JMS I ECHOP /SHALL WE ECHO A '\'? TAD AXIN DCA T2 CDF /LOWER FIELD TO RUBOUT TEXT 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 END /INIT POINTER FOR DUMP (DON'T DUMP SECRET) DCA PT1 TAD LASTV /TEST FOR END OF LIST CIA TAD PT1 SNA CLA POPJ TAD I PT1 /GET THE VARIABLE CDF /FOR PFOCAL DCA I OP+1 CDF 10 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, PC0+3 PC0+4 /FTIM FUNCTION FTIM, JMS I INTEGER SZA SMA JMP FTIMST /START CLOCK SNA CLA 6132 /CLDI - STOP CLOCK TAD FTIMER /READ TIMER JMP I .+1 /FLOAT IT FIN+2 FTIMST, CIA DCA FTIMCS /COUNTER SETUP REGISTER DCA FTIMER /ZERO TIMER TAD FTIMCS DCA FTIMCT /INITIALIZE COUNTER 6131 /CLEI - ENABLE CLOCK INTERRUPT JMP I EFUN3I ////////////////////////// X133P, XI33 TERMER, 0 /CHECK FOR TERMINATOR (;, CR, SPACE, SORTC GLIST-1 ISZ TERMER CIF CDF JMP I TERMER AXOUTD, 0 CDF TAD I AXOUT CDF 10 JMP I AXOUTD PAGE EOF, 0 /TRYING TO READ FROM A FILE AFTER END TAD X133P /(SHAME ON YOU!) DCA INDEV /RESET POINTER TO TTY TAD P277 /PRINT A '?' JMS XOUTL /ON THE TELETYPE JMS I INDEV /READ A CHARACTER JMP I EOF /TEKTRONIX 4010 GRAPHICS I/O ROUTINES GS=235 US=37 SUB=232 ENQ=205 ESC=233 XJ=3012 YJ=3112 FDIS, TAD FCHKP /CHEAT LIKE HELL!! DCA XPRNTC /KLUDGE PRINTC SO WE KNOW WHAT MODE WE ARE IN JMS I INTEGER /CHECK FIRST ARG (FDIS(I,X,Y)) DCA FDISI /SAVE FOR LATER TESTING TAD FDISI /ALSO TEST NOW SMA SZA CLA /NEGATIVE ARG MEANS START POINT PLOT TAD FDSW /ARE WE IN GRAPHICS MODE? C40, SZA CLA JMP PLOT /WE'RE IN GRAPHICS AND I WAS POSITIVE TAD (GS /OTHERWISE, START NEW LINE HERE JMS XOUTL DCA XHIGH DCA YHIGH PLOT, PUSHJ /GET X COORDINATE EVAL-1 /SKIP COMMA JMS I INTEGER FCHKP, DCA FCHK /TEMP PUSHJ /GET Y COORDINATE EVAL-1 /SKIP COMMA JMS I INTEGER JMS HIGH /AREN'T WE THOUGH!! YHIGH, 0 TAD C40 /ADD APPROPRIATE SIGNAL BITS JMS XOUTL TAD FCHK /SAVED X JMS HIGH /HIGH ORDER X XHIGH, 0 JMS XOUTL ISZ FDISI /FIRST ARGUMENT OF FUNCTION JMP I EFUN3I /RETURN FROM VECTOR PLOTTING: I=0 OR 1 TAD XI33 /SEND XLOW AGAIN TO BRIGHTEN POINT JMP XHIGH+1 FDISI, 0 /SAVED VALUE OF FIRST ARGUMENT TO FDIS FDSW=. HIGH, 0 /SUB TO CHECK HIGH-ORDER, ONLY PRINT IF NEEDED DCA FDT2 /SAVE ARG TAD FDT2 CLL RTR RTR;RAR AND (37 TAD C40 DCA AC1L TAD AC1L TAD I HIGH /COMPARE WITH LAST HIGH SNA CLA JMP HXIT /OK TAD AC1L /NOT SO GOOD, PRINT IT JMS XOUTL TAD AC1L CLL CIA DCA I HIGH /SAVE FOR NEXT TIME HXIT, ISZ HIGH /SKIP TAD FDT2 AND (37 TAD C100 JMP I HIGH FCHK, 0 /PRINTC WAS CALLED, SWITCH TO NORMAL MODE DCA HIGH /SAVE CHAR IN AC TAD (OUT /POINTER TO OUT DCA XPRNTC TAD (US JMS XOUTL TAD HIGH /PRINT CHAR PRINTC /WE RESTORED THE POINTER, REMEMBER? DCA FDSW /RESET MODE SWITCH JMP I FCHK FJOY, TAD (ESC /SEQUENCE STARTS WITH 'ESC' (4010) JMS XOUTL JMS I INTEGER /CHECK ARG SNA CLA TAD (SUB-ENQ /ZERO, TURN ON CURSOR AND WAIT TAD (ENQ /NON-ZERO, READ IT NOW JMS XOUTL TAD FLAC+2 /FOR I=1, THERE WILL BE NO INITIAL CHAR. SPA SNA CLA / THEREFORE, DON'T GET IT JMS XI33 /READ FIRST CHAR (CHAR TYPED OR 4010 STATUS) DCA FCHK /TEMP TAD (XJ /X-COORDINATE GOES IN 'XJ' JMS JLOOK /PUT IT THERE TAD (YJ JMS JLOOK /DITTO FOR Y JMS XI33 /TO GET CR (AND IGNORE IT) CLA CLL TAD FCHK /FLOAT FIRST CHAR FOR RETURN JMP FIN+2 FDT2=. JLOOK, 0 /CREATES VARIABLE IF NEEDED, AND FILLS IT DCA EFOP /SAVE NAME IN 'EFOP' PUSHJ GS1 /CALL 'GETVAR' JMS XI33 /GET HIGH-ORDER AND (37 /MASK IT CLL RTL;RTL;RAL DCA FLAC+1 /SNEAKY, ISN'T IT? JMS XI33 AND (37 TAD FLAC+1 DCA FLAC+1 /NOW FLOAT IT TAD P13 DCA FLAC DCA FLAC+2 FENT /AND PUT IT AWAY FNOR FPUT I PT1 /SET BY 'GETVAR' FEXT JMP I JLOOK PAGE /OUTPUT CHARACTER BUFFER (ADDRESS IS A MULTIPLE OF 20) IOBUF=3400 *IOBUF ZBLOCK 20 STVAR=. /AFTER EXTENDED FUNCTIONS *5352 OCHAR, 0 /OUTPUT A CHARACTER DCA T2 OUTECH, SKP /ECHO ON TELETYPE? JMP .+5 TAD T2 /NO SNA /YES CLA CLL CML RAR /LET HIM PRINT NULLS! JMS I OUTLP TAD T2 CIF JMS I NOCARE /OUTPUT IT JMP I OCHAR OUTLP, XOUTL NOCARE, NOCHAR *5774 MGETC, 0 /GETC FAKE FOR LOWER FIELD GETC CIF JMP I MGETC *6160 THISD, 0 CDF TAD I THISLN CDF 10 JMP I THISD PT1D, 0 CDF TAD I PT1 CDF 10 JMP I PT1D PRINTX, 0 JMS I OUTDEV CIF JMP I PRINTX *6311 XRAN, FENT /PSEUDO-RANDOM NUMBER FGET RNDM /X(1)=(2^17+3)*X(0) MOD 2^16 FPUT EX1 FEXT TAD M16 DCA T1S JMS I DOUBLE ISZ T1S JMP .-2 JMS I PADDR JMS I DOUBLE JMS I PADDR FINT FPUT RNDM FEXT DCA FLAC CLA CLL CMA RAR /=3777 AND FLAC+1 DCA FLAC+1 /BE POSITIVE IT'S POSITIVE JMP I EFUN3I M16, -16 PADDR, DUBLAD RNDM=. T1S, 0 4421 3040 0001 XRTD, 0 CDF TAD I XRT CDF 10 JMP I XRTD AXIND, 0 CDF DCA I AXIN CDF 10 JMP I AXIND TELPCH, DCA TELSW /SETUP TO PRINTOUT JMP I .+1 RECOVR+1 ECHO, 0 ION /MAKE SURE! DCA CHAR /SAVE IN CHAR TAD I PPPRNT /DO WE WANT TO PRINT? SNA CLA JMP I ECHO /NO PRINTC /YES JMP I ECHO PPPRNT, PPRNT ICHARF, 0 /INPUT A CHARACTER FROM A FILE CIF CDF JMS I CHARI /CALL LOWER FIELD JMP I ICHARF CHARI, ICHAR /THIS IS THE "LIBRARY HEAD" *7500 LIB, SPNOR /IGNORE SPACES TAD TELSW /WAIT FOR OUTPUT TO FINISH SZA CLA /(DECTAPE SYSTEMS REALLY NEED THIS!) JMP .-2 IOF CIF CDF /CALL LOWER FIELD JMP I (LOWLIB TAD (JMP I GOSWITCH+1 /RETURN TO APPROPRIATE ROUTINE TAD GOSWITCH DCA GOSWITCH GOSWITCH, JMP I .+1 PROC START LGOSUB GOTO+1 FIN, READC /SINGLE CHARACTER INPUT FUNCTION TAD CHAR /FLOAT THE CHARACTER DCA FLAC+1 DCA FLAC+2 /CLEAR THE REST OF FLAC DCA FLAC+3 TAD P13 /AND SET THE PROPER EXPONENT DCA FLAC JMP I EFUN3I ECHOGO, CHIN+7 CHIN+7 FOUT, JMS I INTEGER /SINGLE CHARACTER OUTPUT FUNCTION SNA TAD P4000 /IN CASE IT'S ZERO PRINTC JMP I EFUN3I CPRNT, 0 /CROSS FIELD FAKES! PRINTC CIF CDF JMP I CPRNT PGETLN, 0 GETLN CIF CDF JMP I PGETLN FRAN, TAD (XRAN /RANDOM RANDOM NUMBERS DCA I (PFRAN /(FIRST CALL ONLY) TAD RISZ /INITIALIZE 'RNDM' DCA I (RNDM+1 JMP I (XRAN XSGN, TAD FLAC+1 /REAL SIGNUM FUNCTION!! SNA CLA JMP I EFUN3I PUSHF FLTONE POPF FLAC JMP XABS FILER, CIF /FILE COMMANDS ('OPEN') JMP I .+1 FILEST PAGE