Directory of image this file is from
This file as a plain text file
/ U/W-FOCAL VERSION 4E FOR 16K / 16KCPR.PA / REVISIONS: / NEW FLAGS CLEARED AT 13112 - 13126 / COPYRIGHT (C) 1978 - ALL RIGHTS RESERVED BY / LAB DATA SYSTEMS - SEATTLE, WASHINGTON 98125 / **CORE MAP** / (16K VERSION) /FIELD 0: USER AREA, STACK, OS/8 ROUTINES, & I/O BUFFERS /FIELD 1: INTERPRETER, FUNCTIONS, FLOATING POINT PACKAGE /FIELD 2: PROGRAM TEXT ASCENDING - FCOM AREA COMING DOWN /FIELD 3: VARIABLES / ADDITIONAL INSTRUCTION CODES: FENT=JMS I 7 FIXMRI FGET=0000 FIXMRI FADD=1000 FIXMRI FSUB=2000 FIXMRI FDIV=3000 FIXMRI FMUL=4000 FIXMRI FPWR=5000 FIXMRI FPUT=6000 FIXMRI FNOR=7000 FEXT=0000 CDI=CDF CIF FIXTAB / SPECIAL PSEUDO-OPS FOR CROSS-FIELD CALLS: FGETIPT1=FGET I 0 FADDIPT1=FADD I 0 FMULIPT1=FMUL I 0 FPUTIPT1=FPUT I 0 / ASSEMBLY INSTRUCTIONS USING PAL8-V10: / UWF.BN<16KCPR,12KFNS,8KFIO,8KFPP,16KLIB/L/K=100 / EAE VERSION: 8XFIO,8XFPP /
FIELD 1 /PROCESSOR FIELD PAGE 0 P134, "\&177 /SCOPE INPUT LIST BELL, "G&277 /MODIFY " " P337, "_ /COMMAND " " CFF, FF CLF, LF CCR, CR TRACE, RO /SEARCH CHAR & TRACE SWITCH FPNT /ADDRESS OF F.P. INTERPRETER /AUTO-INDEX REGISTERS SAVMQ, 0 /INTERRUPT REGISTERS SAVAC, 0 SAVLK, 0 PDLXR, PCHK-1 /PUSHDOWN LIST INDEX REGISTER XRT, 0 /FOR POPF, GETARG, DELETE, FINDLN XRT2, 0 /FOR SORTJ, DELETE, FLOATING PT. AXIN, 0 /INPUT (PACKING) POINTER TEXTP=. AXOUT, 0 /OUTPUT (UNPACKING) REG. GTEM, 0 /UNPACKING TEMP. STORAGE XCT, RANDOM+1 /UNPACKING SWITCH PC, 100 /PROGRAM (LINE) POINTER /PACKING AND STORAGE CONSTANTS BOTTOM, PCHK-1 /BEGINNING OF PDL LEVEL0, RANDOM /BEGINNING OF 'FOR' STACK FORLVL, RANDOM /'FOR' LOOP STACK POINTER HEADER, LINE0 /BEGINNING OF TEXT BUFFER BUFEND, -7557 /LAST PROGRAM LOCATION TXTEND, -7577 /LAST LOCATION FOR INPUT FIRSTV, STVAR /**MASTER LOCATION** SECRTV, STVAR-1 /BEGINNING OF VARIABLES TABEND, -3 /END OF THE SYMBOL TABLE /'E1' FOR 8K, '2200' FOR 12K IFNDEF STVAR <STVAR=0> /'3200' FOR 8K, '2200' FOR 12K /MISCELLANEOUS THINGS CONTINUE=JMP I . /COMMAND RETURN CONT NORMALIZE=JMS I . /NORMALIZE C(FLAC) NORM ABSOL, ABSOLV /TAKE THE ABSOLUTE VALUE RESOL, RESOLV /RESTORE THE PROPER SIGN
/FLOATING POINT REGISTERS (LOC *40) SIGN, 0 /FOR ABS VALUE & MUL/DIV T1, 0 /FOR INSTRUCTIONS & F.P.P. T2, 0 /FOR FUNCTIONS & I/O T3, 0 /ARGUMENT SIGN & DEC. EXP. FLAC=. EXP, 0 /FLOATING ACCUMULATOR HORD, 0 LORD, 0 OVER, 0 FLOP=. EX1, 0 /FLOATING OPERAND AC1H, 0 AC1L, 0 OVR1, 0 TELSW, 0 /OUTPUT DONE FLAG INBUF, 0 /INPUT BUFFER (*LOC 55) INDEV, XI33 /POINTER TO INPUT DEVICE OUTDEV, XOUTL /AND OUTPUT DEVICE (TTY) BUFR, LINE1 /NEXT LOCATION IN TEXT BUFFER LASTV, STVAR /NEXT LOCATION IN SYMBOL TABLE PT1, 0 /VARIABLE POINTER THISOP, 0 /CURRENT OP, FN OR VARIABLE NAME LASTOP, 0 /PREVIOUS ARITHEMETIC OPERATION SORTCN, 0 /RELATIVE POSITION IN A LIST CHAR, 0 /THE MOST IMPORTANT REGISTER LINENO, 0 /SET BY 'GETLN' NAGSW, 0 /'NOT ALL' AND/OR 'GROUP' SWITCH LASTC, 0 /FOR 'NEXT', 'ASK', 'ON' & FSF'S FISW, 0 /CODED OUTPUT FORMAT THISLN= THISOP /NOT USED SIMULTANEOUSLY LASTLN= LASTOP
/CONSTANTS USEFUL THROUGHOUT FOCAL: P7, 7 /FOR 'FPOW' AND DIGIT MASK P13, 13 /FOR FLOAT AND PDLXR POINTER P177, 177 /STEP MASK & POINTER P43, 43 /35 BITS P77, 77 /RIGHT MASK C100, 100 /CHARACTER TESTS & PC0 P17, 17 /BCD MASK AND CONSTANT C200, 200 /TEST CONSTANT & POINTER C240, 240 /SPACE P7600, 7600 /GROUP MASK & FLARG POINTER FLARGP= P7600 /TEMPORARY STORAGE FOR 'EVAL' M4, -4 /FOR 'GETARG', 'FPOW', & 'FRAN' M5, -5 /FOR 'PRINTN', 'QUIT', ' 'FSQT' M14, -14 /FOR 'LPRTST', 'TESTN' MCR, -CR /FOR 'WRITE','IF','DELETE','PRINTC' FP1, FLTONE /FOR 'FLOG', 'FSIN', 'Y' & 'DBLSUB' GINC, WORDS+2 /FOR 'GETARG', 'TDUMP' & 'FSF'S *.+5 /FOR USER CONSTANTS /TEMPORARY STORAGE HAS ALL BEEN PLACED ON THE LAST /PAGE USING THE COMMAND DECODER AREA FROM 7600-7646. FLARG= 7600 /TEMPORARY FOR 'EVAL' NEXTP= 7604 /TEXT POINTERS FOR 'NEXT' & 'BREAK' BUFFER= 7610 /TEMPORARY FOR FUNCTIONS & OUTPUT RANDOM= 7642 /UPPER LIMIT FOR STACK POINTERS /SYMBOLS USEFUL THROUGHOUT FOCAL: WORDS=4 /HURRAY! DIGITS=12 L=00 /DATA FIELD FOR LIBRARY V=30 /DATA FIELD FOR VARIABLES S=00 /DATA FIELD FOR THE STACK P=10 /DATA FIELD FOR PROCESSOR T=20 /DATA FIELD FOR THE TEXT LF=212 FF=214 CR=215 SP=240 RO=377
/NEW INSTRUCTIONS: PUSHA= JMS I . /SAVE THE AC ON THE STACK XPUSHA POPA= JMS I . /UNLOAD THE STACK XPOPA PUSHJ= JMS I . /CALL A SUBROUTINE XPUSHJ POPJ= JMP I . /RETURN FROM A SUBROUTINE XPOPJ PUSHF= JMS I . /SAVE 4 WORDS XPUSHF POPF= JMS I . /RESTORE THEM XPOPF SORTJ= JMS I . /SORT AND BRANCH ON AC OR CHAR SORTB SORTX= JMS I . /LOOK FOR SP, COMMA, SEMI, CR XSORT TESTC= JMS I . /TEST FOR TERM, FN, NO., OR VAR. CTEST TESTX= JMS I . /TEST FOR TERM AND SET SORTCN XTEST TESTN= JMS I . /TEST FOR PERIOD, NUMBER NTEST READC= JMS I . /READ & ECHO A CHARACTER (AC=0) ECHOC= JMS I . /PRINT C(AC) WHEN ECHO IS ENABLED CHIN PRINTC= JMS I . /PRINT C(AC) OR 'CHAR' (IF AC = 0) CHOUT PRINTD= JMS I . /PRINT A SINGLE DIGIT FROM THE AC OUTDG READN= JMS I . /USE 'FETCH' TO INPUT A NUMBER FLINTP PRINTN= JMS I . /CONVERT BINARY TO ASCII & PRINT ATSW, FLOUTP /FOR 'ASK', 'TYPE', 'FBLK' & 'FRA' PACKC= JMS I . /PACK A CHARACTER PACBUF GETC= JMS I . /UNPACK A CHARACTER BKSW, UTRA /'BREAK' SWITCH SPNOR= JMS I . /IGNORE LEADING SPACES XSPNOR TSTCMA= JMS I . /SKIP IF CHAR=COMMA & MOVE PAST IT CMATST TESTCR= JMS I . /SKIP IF CHAR = CR CRTEST GETLN= JMS I . /COMPUTE A LINE NUMBER (RECURSIVE) XGETLN FINDLN= JMS I . /SEARCH TEXT FOR A GIVEN LINE XFIND PRNTLN= JMS I . /PRINT LINE NUMBER DMPSW, XPRNT /TRACE DISABLE SWITCH DELETE= JMS I . /REMOVE A LINE AND PACEND, XDELETE /RECOVER THE SPACE DCAIAXIN=JMS I . /'DCA I AXIN' IN FIELD T AXIND
/FLOATING POINT PSEUDO INSTRUCTIONS: FLOAT= JMS I . /FLOAT THE AC FIGO6 FLOATR= JMP I . /FLOAT THE AC AND RETURN FIN+2 FL0ATR= JMP I . /UNSIGNED FLOAT & RETURN FL0AT RETURN= JMP I . /REGULAR FUNCTION RETURNS FINISH, EFUN3 SHIFTL= JMS I . /MULTIPLY FLAC BY 2 MULT2 NEGATE= JMS I . /COMPLEMENT AND INCREMENT FLAC INVERT FIXIT= JMS I . /CONVERT FLAC TO A 24-BIT INTEGER INTEGER MULT10= JMS I . /MULTIPLY FLAC BY TEN & ADD THE AC XTEN CHKSGN= JMS I . /TAKE ABSOLUTE VALUE + CHECK FOR 0 SGNCHK RTL6= JMS I . /ROTATE THE AC LEFT 6 BETA, XRTL6 /FOR THE PDP12 OVERLAY *.+4 /PATCH AREA PRODUCT=. /FOR SOFTWARE MULTIPLY *176 ERROR2= JMS I . /FIELD 1 ERROR TABCNT, ERROR /ENTRY POINT IS THE TAB COUNTER /DEFINE SOME MICROCODED INSTRUCTIONS: SP1= CLA STL RAL SP2= CLA STL RTL SM0= CLA STL RAR SM1= CMA STL RAL /NO CLA SM2= STA CLL RAL SM3= STA CLL RTL I0N= ION /MAKE THESE EASY TO CHANGE I0F= IOF /OR 'NOP'
/ COMMAND PROCESSOR FOR VERSION 4 *177 START=. /PROGRAM SELF-START (=7610) BUFFPT, SKP CLA /OUTPUT BUFFER IS AT 17610. JMP I "* /CONSOLE START (FROM 10200) TAD .-1 /ANNOUNCE PRESENCE ECHOC /(DON'T PRINT IF THE ECHO IS OFF) TAD BOTTOM DCA PDLXR /RESET THE STACK POINTERS TAD LEVEL0 DCA FORLVL TAD TXTEND /SET THE INPUT LIMIT DCA I PACEND TAD C100 /SET PC FOR COMMAND MODE DCA PC IBAR, DCA T3 /RESET THE PACKING SWITCH *FF /RETURN FROM LINEFEED TAD BUFR /INITIALIZE THE BUFFER POINTER DCA AXIN /=*CR DCA TRACE /TURN OFF THE TRACE DCA I DMPSW /BUT ENABLE THE TRAP IGNOR, READC /READ THE COMMAND STRING SORTJ P337-1 INLIST-P337 PACKC /SAVE EACH LITTLE CHARACTER JMP IGNOR ///// INLIST, IBAR /B.A. = RESTART IGNOR /F.F. = IGNORE LNFEED /L.F. = RETYPE IRETN /C.R. = TERMINATE ///// IRETN, PACKC /PACK THE CR PACKC /BE SURE ITS ALL THERE TAD BUFEND DCA I PACEND /SET REPACKING LIMIT TAD BUFR /INITIALIZE 'TEXTP' ///// /TEXT BUFFER FORMAT: /#1 : POINTER OR ZERO IN LAST /#2 : LINENO /#3 - #N-1 : TEXT /#N : CR (=7715)
/IMMEDIATE AND SEQUENTIAL COMMAND EXECUTION: NEXTLN, DCA AXOUT /SET LINE POINTERS DCA XCT GETC /READ FIRST CHARACTER SPNOR /IGNORE LEADING BLANKS TESTN /DOES THE LINE BEGIN WITH 0-9? SKP /PERIOD: ALLOW GROUP ZERO JMP INPUTX /NO, ITS A DIRECT COMMAND ISZ I DMPSW /YES, KILL TRACE TO PROTECT '?' GETLN /READ THE LINE NUMBER JMS I MODIFY+2 /INITIALIZE THE NEW LINE JMP SRETN /REPACK THE FIRST CHARACTER *"* /FOR 'LINEFEED' M20-1 /MANUAL RESTART ECHOFF, PRINTC /ECHO FF TO CLEAR THE SCREEN JMP IGNOR /(FOR THE SCOPE VERSIONS) GETC /GET THE NEXT CHARACTER SRETN, PACKC /REPACK TESTCR /TEST FOR THE END OF LINE JMP .-3 PACKC /FINISH THE CR DELETE /REMOVE THE OLD LINE, IF ANY CDF T TAD I LASTLN /INSERT NEW ONE DCA I BUFR TAD BUFR DCA I LASTLN TAD T3 /-1 IF CR NEEDED 2ND WORD CIA TAD AXIN /COMPUTE NEW END-OF-BUFFER DCA BUFR CDI L DCA I P77 /SET 'PROGRAM MODIFIED' FLAG JMP 100 /TURN ON INTERRUPTS & RESTART ///// *"? /FOR 'QUIT' VIA 'PACLST' TAD M5 /CREATES 'PUSHJ;GOTO+1' INPUTX, PUSHJ /PROCESS THE IMMEDIATE COMMAND PROC CDF T TAD I PC SNA /END OF THE PROGRAM? JMP START /YES DCA PC /SAVE THE NEW LINE POINTER TAD PC IAC /ADVANCE TO THE LINENO JMP NEXTLN /AND CONTINUE PROCESSING
/LINE NUMBER EVALUATION: 'GETLN' XGETLN, 0 /NOW HANDLES NEGATIVE NUMBERS TAD .-1 / AND PERMITS RECURSIVE CALLS PUSHA PUSHJ /EVALUATE THE ARGUMENT EVAL MODEPT, TAD EXP /MODIFY AND FSF ENTRY POINT TAD M5 SMA SZA CLA /.GT. 31? ERROR2 TAD PC /POINT TO THE CURRENT LINE DCA XRT TYPEPT, SM1 /TFRMT ENTRY POINT DCA NAGSW /SET NAGSW FOR 'ALL' CHKSGN /TAKE THE ABSOLUTE VALUE JMP ALL /ZERO=ALL, L=1 FROM 'FPUT' SMA SZA CLA /CHECK THE ORIGINAL SIGN DCA NAGSW /CLEAR SWITCH IF POSITIVE FIXIT /GET THE GROUP NUMBER RTL6 /SHIFT INTO PLACE ('BSW') CLL RAL CDF T /SHIFT TO TEXT BUFFER SNA /RELATIVE ADDRESSING? TAD I XRT /YES, USE CURRENT GROUP AND P7600 DCA LINENO /SAVE GROUP NUMBER NEGATE FENT /RESETS D.F. FADD I FLARGP /SUBTRACT THE GROUP NUMBER FMUL FL100 /SHIFT THE DECIMAL POINT FADD FLP5 /ROUND OFF THE RESULT FEXT FIXIT /LEAVES L=0 ISZ NAGSW /FORCE ZERO FOR NEG LINENO DCA NAGSW /SET 'NOT-ALL/GROUP SWITCH' TAD NAGSW /AC = LINENO IF WE SKIPPED TAD LINENO /COMBINE LINE & GROUP NUMBERS ALL, DCA LINENO POPJ /LINK=1 IF ALL (SET BY CHKSGN) FL100, 7;3100;0 /CONSTANTS FOR 'GETLN' FLP5, 0;2000;ZBLOCK 2 / ALSO USED BY 'FSQT' /LINE NUMBERS MAY RANGE FROM 0 TO +- 31.99 /NEGATIVE NUMBERS FORCE THE 'GROUP' SWITCH. / NAGSW: /ALL= 7777(1) /GROUP= 0000(0) /LINE= 0XXX(0)
/'MODIFY' AND 'MOVE' COMMANDS DIFFER ONLY IN THAT 'MOVE' /HAS A SECOND LINE NUMBER (SEPARATED BY A COMMA) WHICH /BECOMES THE LINENO OF THE CORRECTED LINE. THE OLD LINE /REMAINS UNCHANGED IN THIS CASE. MODIFY, GETLN /READ THE FIRST LINENO TSTCMA /PASS THE COMMA IF THERE IS ONE INITLN /'NOP' PUSHJ /OTHERWISE 'EVAL' GIVES ZERO EVAL FINDLN /LOOK UP THE OLD LINE ERROR2 /NOT THERE TAD HORD /TEST SECOND ARGUMENT SZA CLA /NEW LINENO? PUSHJ /YES: 'MOVE' AS WELL AS 'MODIFY' MODEPT /.LT. 1000 SO WE CAN DO THIS MODLN, PRNTLN /'NOP' TO OMIT THE NUMBER ///// JMS INITLN /SAVE LINENO SCONT, JMS I INDEV /GET SEARCH CHARACTER (SILENTLY) DCA TRACE SCHAR, GETC /PLAYBACK TEXT TAD CHAR ECHOC /ALLOW SILENT EDITING SORTJ /LOOK FOR A MATCH CCR-1 LISTGO-CCR PACKC /SAVE THE NEW LINE JMP SCHAR ///// SBAR, JMS INITLN /RESTART AFTER A '_' SFOUND, READC /READ FROM KEYBOARD SORTJ /AND TEST BELL-1 SRNLST-BELL SGOT, SP1 /PROTECT LINENO FROM RUBOUTS PACKC /PACK CHAR JMP SFOUND /MORE ///// SRNLST, SCONT /BELL = CHANGE SEARCH CHARACTER SBAR /B.A. = DELETE LINE TO THE LEFT SCHAR /F.F. = LOOK FOR NEXT OCCURANCE SCONT+1 /L.F. = FINISH THE LINE AS BEFORE LISTGO, SRETN /C.R. = END THE LINE RIGHT HERE SGOT /CHAR = STOP ON SEARCH CHARACTER ///// INITLN, ZBLOCK 2 /INITIALIZE A NEW LINE DCA T3 TAD BUFR /RESET INPUT POINTERS DCA AXIN TAD LINENO /PACK LINENO DCAIAXIN ISZ I DMPSW /KILL THE TRACE JMP I INITLN /USED BY MODIFY, ERASE AND INPUT
/OUTPUT THE INDIRECT PROGRAM WEND, POPA /RESTORE TEXT POINTERS DCA CHAR POPF TEXTP DCA I DMPSW /RESTORE TRACE TSTCMA /CHECK FOR MULTIPLE LISTING CONTINUE TAD CCR PRINTC /SEPARATE MULTIPLE CALLS ///// WRITE, GETLN /SET LINENO PUSHF /SAVE TEXT POSITION TEXTP TAD CHAR PUSHA WCONT, FINDLN /SEARCH FOR LINE NUMBER JMP WTESTG /NOT THERE OR GROUP PRNTLN /ALSO DISABLES THE TRACE GETC PRINTC /PRINT A LINE OF TEXT TESTCR /SKIP AT THE END JMP .-3 TAD THISLN /POINT TO THE NEXT LINE WTESTG, JMS GRPCHK /CHECK ITS VALIDITY JMP WEND /LAST ONE OR ONLY ONE TAD LASTLN /STILL IN THE GROUP? SZA CLA PRINTC /SEPARATE GROUPS JMP WCONT /RETURN TO LOOP /DELETE SINGLE LINES, GROUPS OR EVERYTHING ERASE, GETLN /WHICH SHALL IT BE? SZL /ALL? JMP ERA /YES JMS INITLN /SET MEMORY PROTECTION ERG, DELETE /REMOVE A SINGLE LINE TAD LASTLN /WATCH OUT FOR THE END JMS GRPCHK /CHECK IF NEXT LINE IS OK JMP ERX /DONE: CLEAR PROGRAM FLAG JMP ERG /DELETE SOME MORE ///// LINE1 ERA, TAD .-1 /RESET THE COMMAND BUFFER DCA BUFR CDF T /PUT ZERO IN THE FIRST LINE DCA I HEADER ERX, CDI L /AND REMOVE THE PROGRAM NAME JMP NONAME
/CLEAR THE SYMBOL TABLE AND/OR SELECTED VARIABLES ZERO, TESTC /CHECK FOR AN ARGUMENT JMP ZALL /NO ARG = ALL VARIABLES GETC /F (SLIGHT FUDGE) SPNOR /N (ALSO ILLEGAL) SORTJ /L VARIABLE NAME ZLIST-1 ZGO-ZLIST PUSHJ /NOT A TERMINATOR GETARG /SO IT MUST BE A NAME ISZ XRT2 /ADVANCE DATA POINTER PUSHJ ZFOUND /THEN ZAP IT JMP ZERO+3 ZALL, TAD FIRSTV /RESET THE TABLE DCA LASTV JMP ZERO+4 /E.G. Z,A,B,C... ///// GRPCHK, 0 /FOR REPEATED OPERATIONS CDF T /TEXT BUFFER SNA /AC = POINTER TO NEXT JMP .+6 /FIRST LINE IN A GROUP DCA INITLN /SAVE POINTER TAD I INITLN /'THISLN', 'LASTLN', 'PC' SNA /END OF TEXT BUFFER? JMP GRPXIT+1 /YES DCA THISLN /SAVE NEW POINTER TAD NAGSW /CHECK THE TYPE OF OPERATION SMA SZA /FIRST EXIT = SINGLE OR E.O.G. JMP GRPXIT /ALSO SERVES FOR END-OF-TEXT DCA LASTLN /SAVE A COPY OF NAGSW ISZ THISLN /POINT TO LINE NUMBER TAD I THISLN AND P7600 CIA TAD LINENO /COMPARE WITH CURRENT AND P7600 ISZ LASTLN /FORCE 2ND EXIT FOR 'ALL' SNA CLA ISZ GRPCHK /SECOND EXIT = KEEP GOING DCA LASTLN /NON-ZERO = 'ALL' BUT N.I.G. TAD I THISLN GRPXIT, DCA LINENO /UPDATE THE LINE NUMBER CDF P JMP I GRPCHK /////
/ THE IMPROVED 'RETURN' COMMAND PERMITS AN OPTIONAL LINE /NUMBER WHICH WILL TRANSFER TO THAT LINE RATHER THAN RE- /TURNING TO THE CALL. A VERY USEFUL FEATURE! RETRN, PUSHF /SAVE FSF RESULTS FLARG GETLN /CHECK FOR A LINENO TAD LINENO /SAVE IT DCA THISLN TAD C100 /POINT TO PC0 DCA PC CML CMA RAR / 3777 OR 7777 DCA LASTLN /SET RETURN FLAG POPF /RESTORE FSF FLARG /'CLA' POPJ /GO BACK A LEVEL /PRIMARY CONTROL AND TRANSFER GOTO, GETLN /READ THE LINE NUMBER REQUESTED FINDLN /LOCATE IT AND RESET TEXTP ERROR2 /NOT THERE - 'NOP' TO USE NEXT! TAD THISLN /SET THE PC DCA PC GETC /TEST FOR THE END OF THE LINE PROC, TAD CHAR AND P337 /EXECUTE LOWER CASE TOO! DCA LASTC /SAVE COMMAND & CLEAR A FLAG SORTX /CHECK FOR SP, COMMA, SEMI, CR JMP PC1+1 /NONE OF THE ABOVE JMS CRTEST /CR? JMP PROC-1 /IGNORE SPACES, COMMAS, SEMIS PC1, JMP I COMGO-1 /EXIT AT THE END OF A LINE GETC /SKIP TO END OF THE COMMAND SORTX JMP .-2 TAD LASTC /RECALL COMMAND LETTER TAD (-"Z-1 STL IAC TAD ("Z-"? SZL SNA /IS IT @-Z? CERR, ERROR2 /ILLEGAL COMMAND TAD PC1 DCA .+1 /EXECUTE AN INDIRECT JUMP ///// CRTEST, 0 /SKIP IF CHAR IS A CR: 'TESTCR' TAD CHAR TAD MCR SNA CLA ISZ CRTEST JMP I CRTEST
/RECURSIVE OPERATE, EXECUTE, OR CALL LGOSUB, TAD P7600 /GET RETURN FLAG JMP DO+1 /EXECUTE THE SUBROUTINE LCMNDS, SPNOR /'L' COMMAND ENTRY POINT CIF L JMP I FENT&177 /SAME ADDRESS AS THE FPP ///// DOXIT, SZA /CHECK FOR 'DO' OR 'GOSUB' JMP LCMNDS+1 /RETURN TO CALLING PROGRAM TSTCMA /CHECK FOR ADDITIONAL CALLS CONTINUE /NONE: PROCESS NEXT COMMAND ///// DO, GETLN /EXECUTE A LINE, GROUP, OR ALL DCA SORTCN /ENTRY POINT FOR GOSUB PUSHF /ENTRY POINT FOR FSF'S TEXTP /SAVE TEXT POINTERS ///// DOGRP, PUSHF /SAVE SORTCN, CHAR, LINENO, NAGSW SORTCN FINDLN /FIND THE OBJECT LINE JMP DOERR /NOT THERE: DO WE CARE? PUSHJ /EXECUTE A SINGLE LINE GOTO+3 POPF /RESTORE THE DATA SORTCN TAD PC /CHECK THE NEXT LINE JMS I (GRPCHK /SHOULD WE EXECUTE IT? JMP DORTN /ALL DONE JMP DOGRP /CONTINUE SUBROUTINE ///// DORTN, POPF /RESTORE TEXT POINTERS TEXTP TAD SORTCN /CHECK RETURN FLAG SMA SZA JMP GOTO-2 /FSF RETURN ('CLA;POPJ') ISZ LASTLN /CHECK RETURN OPTION JMP DOXIT /NONE, RETURN TO CALL SZA CLA /GOSUB? POPF /YES, DUMP PROGRAM INFO FLOP /OTHERWISE 'NOP' TAD THISLN DCA LINENO /GET THE LINE NUMBER JMP GOTO+1 /AND GO SOMEWHERE ELSE ///// ERROR /PATCHED BY PROGRAM INTERRUPT DOERR, JMS I (GRPCHK /TEST FOR A GOOD LINE OR GROUP JMS I .-2 /SORRY JMP DOGRP+2 /OK- GET THE FIRST LINE /////
/COMMAND BRANCH TABLE: NINE NEW COMMANDS ARE AVAILABLE XPOPJ /STARTS THE TABLE COMGO, CERR /@ INDIRECT ASK /A BREAK /B PC1 /C DO /D ERASE /E FOR /F GOTO /G HESI /H HESITATE IF /I JUMP /J CERR /K KONTROL LCMNDS /L MODIFY /M NEXT /N ON /O CERR /P PLOT QUIT /Q RETRN /R SET /S TYPE /T CERR /U USER CERR /V VIEW WRITE /W SET /X XECUTE YNCR /Y YNCREMENT ZERO /Z ///// CONT, SKP CLA /COMMAND RETURN - 'CONTINUE' GETC SORTJ /SEARCH FOR A ';' OR A C.R. ILIST-1 IGO-ILIST JMP CONT+1 ///// CMATST, 0 /TEST FOR A COMMA: 'TSTCMA' CLA TAD CHAR TAD (-", SZA CLA JMP I CMATST /FIRST RETURN IF IT'S NOT GETC ISZ CMATST JMP I CMATST /REMOVE IT AND TAKE 2ND RTN ///// PAGE 4
FOR, PUSHJ /LOOP CONTROL BEGINS WITH 'SET' EVAL SORTJ /TEST LAST CHAR FROM 'EVAL' TLIST-1 FGO-TLIST JMP FOR /ALLOW SPACES BUT DON'T ADVERTISE MEQ, -"= /'EVAL' FOUND A REPLACEMENT OPERATOR (=): STACK THE / LAST OPERATION AND LOCK THE VARIABLE IN POSITION. *TAD FENT&177 /WIERD! EQLS, 0 /PLACED HERE TO SAVE A WORD TAD CHAR TAD MEQ SZA CLA JMP I EQLS CDF V /SOLVE THE 'ZVR' PROBLEM! TAD I XRT2 SNA CLA CMA /PROTECT ZERO VARIABLES TAD I PT1 DCA I PT1 TAD LASTOP /STACK CURRENT OPERATOR PUSHA TAD PT1 PUSHA /SAVE POINTER TO VARIABLE SP1 JMP I FCONT-1 /SET 'LASTOP' TO 1 FOR '=' ///// FINCR, GETC /SKIP THE COMMA THAT GOT US HERE TAD LASTC /IS IT 'SET' OR 'FOR' ? SNA CLA JMP FOR /'SET I=1,N=2' TAD PT1 /'FOR I=1,N' PUSHA /RESAVE THE VARIABLE POINTER PUSHJ /EVALUATE THE INCREMENT EVAL SORTJ /TEST THE NEW TERMINATOR ILIST-1 FLIST-ILIST ERROR2 /ILLEGAL TERMINATOR IN 'FOR' ///// FINFIN, PUSHF /STANDARD INCREMENT FLTONE JMP FCONT FLIMIT, PUSHF /SAVE THE INCREMENT; GET THE LIMIT FLAC PUSHJ /(NO ERROR DETECTION AFTER LIMIT) EVAL-3 FCONT, PUSHF /SAVE THE LIMIT FLAC
/THE POINTER TO THE TOP OF THE STACK IS SAVED EACH TIME. /THIS PERMITS 'BREAKS' WHICH CUT THROUGH ALL INTERVENING /SUBROUTINE CALLS. THE LEVEL POINTERS ARE STACKED FROM /'RANDOM' DOWNWARDS, PERMITTING 15 OR MORE NESTED LOOPS. /NO CHECKING IS PERFORMED SINCE THE PROBABILITY OF AN /OVERFLOW OCCURING IS VANISHINGLY SMALL. PUSHF /SAVE THE CURRENT TEXT POSITION TEXTP CMA TAD FORLVL /ADJUST LEVEL COUNTER DCA FORLVL CMA TAD PDLXR /SAVE RETURN POINTER DCA I FORLVL PUSHJ /EXECUTE TO THE END FPROC, PROC-1 /RETURN FROM OBJECT STATEMENTS POPF /RESET THE TEXT POINTERS TEXTP POPF /RECOVER THE LIMIT BUFFER POPF /LOAD THE INCREMENT FLAC POPA /RESTORE THE VARIABLE POINTER DCA PT1 ISZ I BKSW /TEST FOR A 'BREAK' JMP FTEST /NONE FEXIT, ISZ FORLVL /REMOVE ONE LEVEL ISZ LASTC /CHECK FOR CONTINUATION POPJ /NONE, END THIS LINE PUSHF NEXTP POPF /MOVE TO NEW TEXT POSITION TEXTP JMP I MCR /CHECK FOR A LINENO (CF. 'IF') FTEST, SM0 AND HORD DCA SIGN /SAVE SIGN OF THE INCREMENT FENT FADDIPT1 /INCREMENT LOOP INDEX FPUTIPT1 /AND SAVE IT AGAIN FSUB I BUFFPT /COMPARE WITH LIMIT FEXT TAD SIGN TAD HORD /TEST RESULT SMA SZA CLA JMP FEXIT /EXIT FROM 'FOR' TAD I FORLVL /EFFECTIVE PUSHDOWN FOR DCA PDLXR /PT1, INCREMENT, LIMIT JMP I FPROC /TEXTP, & PUSHJ(PROC-1)
/THE 'NEXT' AND 'BREAK' COMMANDS ADD A NEW DIMENSION TO /FOCAL'S LOOPS BY PERMITTING NESTED OPERATIONS AND EARLY /TERMINATION. THEY ARE PATTERNED AFTER SIMILAR COMMANDS /IN 'COLPAC' & 'FOCLF'. SPECIAL THANKS TO THESE AUTHORS! /BOTH COMMANDS MAY INCLUDE A LINENO TO SPECIFY A BRANCH. /WHEN NO LOOPS ARE IN PROGRESS THESE COMMANDS ARE SIMPLY /'NOPS' UNLESS A BRANCH IS SPECIFIED, IN WHICH CASE IT /WILL BE TAKEN. THUS A LINE CONTAINING AN 'N' OR A 'B' /COMMAND CAN BE EXECUTED BY ANY PART OF THE PROGRAM. BREAK, SM1 /SET THE 'BREAK' FLAG DCA I BKSW / (RESET BY 'GETC') NEXT, TAD I FORLVL /IS THERE A MATCHING 'FOR'? SNA JMP I MCR /NO, TREAT LIKE A SPECIAL 'GOTO' DCA PDLXR /YES, DROP THE STACK TO THIS LEVEL SM1 /SET THE 'NEXT' SWITCH DCA LASTC PUSHF TEXTP POPF /AND SAVE THE CURRENT POSITION NEXTP POPJ /THEN RETURN TO THE 'FOR' LOOP ///// /SEARCH FOR A GIVEN LINE NUMBER: 1ST RETURN IF MISSING, / 2ND IF FOUND. 'THISLN'= TARGET LINE OR NEXT LARGER - /'LASTLN'=LESSER AND OR LAST. 'GETC' POINTERS ARE SET, /BUT NOT THE PC SO ERRORS SHOW THE CORRECT LINE NUMBER. XFIND, 0 /FIND A LINE OF TEXT - 'FINDLN' CDF T TAD HEADER DCA LASTLN /INITIALIZE TO THE HEADER LINE TAD LASTLN FINDN, DCA THISLN /SAVE NEW LINE POINTER TAD THISLN DCA AXOUT /INITIALIZE UNPACKING REG. TAD LINENO STL CIA TAD I AXOUT /ADVANCE AND COMPARE SNA CLA ISZ XFIND /FOUND IT - TAKE 2ND EXIT SNL JMP FINDX /FOUND IT OR PAST IT TAD THISLN DCA LASTLN /SAVE POINTER TAD I THISLN SZA /END OF TEXT? JMP FINDN /NOT YET FINDX, DCA XCT /CLEAR UNPACKING SWITCH CDF P JMP I XFIND /1ST RETURN = NOT FOUND
/INPUT-OUTPUT COMMANDS: -ASK- AND -TYPE- /'SET' TURNS INTO 'TYPE' WHEN THE TRACE SWITCH IS ON *.!177-3 /PUT 'SET' JUST BEFORE 'TYPE' SET, DCA LASTC /THE MOST IMPORTANT COMMAND ! TAD TRACE /CHECK THE TRACE SWITCH SMA CLA /SKIP IF ITS ON JMP FOR /OFF: USE THE 'FOR' ROUTINE ///// TYPSET, PUSHJ /EVALUATE THE EXPRESSION EVAL PRINTN /OUTPUT IT & RESET 'ATSW' TASK, SPNOR /MOVE TO NEXT ARGUMENT SORTJ /!,",#,$,%,: ? ALIST-1 AGO-ALIST ISZ I ATSW /'ASK' OR 'TYPE'? JMP TYPSET ///// PUSHJ /LOOKUP THE VARIABLE GETARG TAD CHAR /SAVE THE CHARACTER DCA LASTC TAD PROMPT NOP /'ECHOC' READ, SP1 READN /GET THE NUMBER YLST, "; CR /SORT LIST FOR 'YNCR' "- /IS THE INPUT SWITCH FENT FPUTIPT1 /SAVE THE VALUE FEXT ENDFI, TAD CHAR /'ALTMODE' RETURN DCA I ASK /SAVE THE TERMINATOR TAD LASTC DCA CHAR /RESTORE TEXT CHARACTER ASK, CLA SM1 /POINTS TO 'TERM' TYPE, DCA I ATSW /SET THE SWITCH JMP TASK ///// TBACK, TAD CCR /'#' = CR ONLY JMS I OUTDEV DCA I TABCNT TAD (200-CR /CREATE A NULL FOR DELAY TCRLF, TAD CCR /'!' = CR AND LF PRINTC TASK4, GETC /MOVE ALONG JMP TASK /////
/DISPATCH TABLE FOR 'ASK' 'TYPE' 'ZERO' 'FOR' 'SET' 'IF' AGO, TQUOT+1 /" - PRINT CHAR STRING TASK4 /, - END OF EXPRESSION TCRLF /! - CR AND LF TFRMT /% - SET OUTPUT FORMAT TBACK /# - CARRIAGE RETURN ONLY TDUMP /$ - DUMP THE SYMBOL TABLE TABX /: - TABULATE OR SKIP ZGO, ZERO+2 /, - MULTIPLE ZERO COMMAND FGO, FINCR /, - MULTIPLE SETS OR FOR IGO, THEN /, - UNUSED 'IF' BRANCHES YGO, PROC-1 /; - END OF COMMAND PROC+2 /CR END OF LINE DECR /- - DECREMENT A VARIABLE ///// ALIST, "" /'SORTJ' CONTROL TABLE ", "! "% "# "$ PROMPT, ": /FOR 'ASK' ZLIST, ", /FOR 'ZERO' TLIST, ", /FOR 'SET' ILIST, ", /FOR 'IF/ON' "; CR /'PUSHJ' ENDS THE LIST ///// TFRMT, PUSHJ /MOVE PAST THE '%' EVAL-3 TAD C100 /POINT TO PC0 DCA XRT PUSHJ /READ FORMAT TYPEPT TAD LINENO DCA FISW /SAVE FOR LATER JMP TASK ///// TQUOT, PRINTC /ECHO ISZ I DMPSW /DISABLE TRACE GETC /PASS QUOTE - READ NEXT DCA I DMPSW /RESTORE THE TRACE SORTJ TLIST2-1 /QUOTE OR CR TLIST3-TLIST2 JMP TQUOT ///// AXIND, 0 /'DCAIAXIN' CDF T DCA I AXIN CDF P JMP I AXIND
/PUSHDOWN LIST SUBROUTINES - STACK IS IN FIELD 0 XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL TAD I XPUSHJ /GET THE TARGET ADDRESS DCA XPUSHA /SAVE FOR THE INDIRECT JUMP TAD XPUSHJ /GET THE RETURN ADDRESS IAC /BUMP IT SKP /AND PUSH IT ON THE STACK XPUSHA, 0 /PUSH THE AC ONTO THE STACK CDI L JMP I (APUSHX JMP I XPUSHA XPOPJ, CDF S TAD I PDLXR /GET THE RETURN ADDRESS DCA XPOPA JMP XPOPA+3 /RESTORE D.F. AND BRANCH XPOPA, 0 /PULL SOMETHING OFF THE STACK CDF S TAD I PDLXR CDF P JMP I XPOPA XPUSHF, 0 /SAVE A FLOATING-POINT NUMBER TAD XPUSHF CDI L /USE LOWER FIELD ROUTINE FOR THIS DCA I (MPUSHF CDF P /RESET THE CALLING FIELD JMP I (MPUSHF+2 /UPPER FIELD ENTRY POINT XPOPF, 0 /RESTORE A FLOATING-POINT NUMBER CLA CMA TAD I XPOPF /BACKUP DATA POINTER ISZ XPOPF /AND ADVANCE THE RETURN DCA XRT JMS XPOPA /DUMP FOUR WORDS DCA I XRT JMS XPOPA DCA I XRT JMS XPOPA DCA I XRT JMS XPOPA DCA I XRT JMP I XPOPF PAGE
/FIND OR ENTER A VARIABLE IN THE SYMBOL TABLE GETARG, TESTC /GET FIRST LETTER OF NAME LPRTST /FUNCTIONS AND NUMBERS XINC, WORDS+1 /ARE NOT GOOD VARIABLES ERROR2 /BAD ARG IN ASK, YNCR OR ZERO GETVAR, SM1 /ENTRY POINT FOR 'EVAL' FLOAT /SET COUNTER & CLEAR SUBSCRIPT TAD CHAR AND P77 /USE 6-BIT CODES RTL6 /MOVE TO THE LEFT - 'BSW' DCA THISOP /SAVE WHERE WE CAN PUSH IT GETLP, GETC /GET NEXT CHARACTER TESTX /END OF THE NAME? JMP GSERCH /YES ISZ HORD /IS THIS THE SECOND CHAR? JMP GETLP /IGNORE ADDITIONAL CHARS TAD CHAR AND P77 /MASK IT OFF TAD THISOP /MERGE THE OTHER HALF JMP GETLP-1 ///// GSERCH, JMS I GETARG+1 /CHECK FOR A SUBSCRIPT JMP GS1 /NONE JMS I (ECALL /PICK IT UP JMS I (DBLSUB /CHECK FOR DOUBLE SUBSCRIPTS POPA /GET VARIABLE NAME FROM PDL JMS I (PARTEST /CHECK FOR PROPER RIGHT PAREN. GETC /MOVE PAST CLOSING PARENS FIXIT /CONVERT ALL THIS TO AN INTEGER CIA /INVERT FOR FAST CHECKING GS1, DCA T3 /SAVE SUBSCRIPT TAD THISOP CIA /INVERT NAME FOR THE SAME REASON DCA T1 CDF V DCA I LASTV /DEFINE THE END OF THE TABLE TAD SECRTV /BEGIN WITH SECRET VARIABLES JMP GLOOP+2 ///// CMA /BACKUP TO NAME GLOOP, TAD XINC /ADVANCE ONE TAD XRT2 DCA XRT2 TAD I XRT2 /CHECK NAME SNA /END OF THE TABLE? JMP MAKVAR /YES TAD T1 /'SAM' SZA CLA /MATCH? JMP GLOOP /TRY AGAIN TAD T3 TAD I XRT2 /CHECK SUBSCRIPT SZA CLA JMP GLOOP-1 /NOT THIS ONE STL /L=1 IF FOUND
ISZ XRT2 /POINT TO DATA GEXIT, TAD XRT2 DCA PT1 POPJ /RESETS D.F. ///// MAKVAR, TAD TABEND /SYMBOL TABLE LIMIT STL CIA TAD LASTV TAD GINC /COMPARE WITH NEW END POINT SNL JMP ZSERCH /FULL: TRY TO REPLACE A ZERO TAD TABEND DCA LASTV /UPDATE STORAGE POINTER STL CMA JMP ZFOUND+2 /INSERT NAME & CLEAR DATA ///// ZSERCH, CLA STL IAC /INITIATE SEARCH FOR ZERO TAD FIRSTV JMP ZINITL ZLOOP, TAD LASTV /CHECK PROGRESS CLL CMA TAD XINC /ADVANCE TO NEXT ONE TAD XRT2 SZL /ALL DONE? ERROR2 /YES: SYMBOL TABLE IS FULL TAD LASTV /SETS THE LINK ZINITL, DCA XRT2 /XRT2=XRT2+XINC-1 TAD I XRT2 /EXPONENT + TAD I XRT2 /HIGH ORDER SNA CLA /CHECK THAT BOTH ARE ZERO SNL /AND NOT ADDITIVE INVERSES JMP ZLOOP ///// ZFOUND, CDF V /ALSO USED BY 'ZERO' TAD M4 /POINT TO THE NAME TAD XRT2 /CLEAR THE LINK DCA XRT2 TAD THISOP /REPLACE IT DCA I XRT2 TAD LORD /AND THE SUBSCRIPT TOO DCA I XRT2 DCA I XRT2 /ZERO THE DATA TAD XRT2 DCA XRT /SWITCH INDEX REGISTERS DCA I XRT DCA I XRT DCA I XRT /'NOP' FOR 3-WORD VERSION JMP GEXIT /L=0 ///// TLIST3, TASK4 /SORT LIST FOR QUOTED STRINGS XPOPJ /AUTOMATIC RIGHT QUOTE MARK
/CONDITIONAL TRANSFER PROCESSES: 'IF', 'ON' AND 'JUMP' /'IF' TRANSFERS WITH A 'GOTO' BRANCH WHILE 'ON' USES A /'DO' CALL AND RETURNS TO THE CALLING POINT AFTERWARDS. /'JUMP' USES THE VALUE OF THE EXPRESSION TO SELECT CALL ON, TESTC /THIS IS ALSO THE 'O' COMMAND SM1 /T R-PAR MEANS ITS 'ON' DCA LASTC /F ILLEGAL - WILL BE TRAPPED JMP IF+1 /N CONTINUE WITH 'IF' CIF L /L DOUBLE-WORD 'O' COMMAND JMP I .+1 /CONTINUE WITH LOWER-FIELD CHECKS OCMND JM, JMS I (ECALL /'JUMP (...) S1,S2,S3,S4,S5,...' SM1 /SET THE 'DO' FLAG DCA LASTC FIXIT /GET SUBROUTINE CALL CIA JMP IF+3 /THEN USE 'IF' TO FINISH UP IF, TESTC /IGNORE SPACES AND TEST JMS I (ECALL /T SM2 /F ISZ PDLXR /N DUMP 'THISOP' JMS I (PARTEST /L CHECK FOR PAREN MATCH TAD HORD /TEST -,0,+ SPA ISZ THISOP SPA SNA CLA THEN, ISZ THISOP /COUNT COMMAS JMP I (CONT+1 /KEEP LOOKING GETC /MOVE PAST IT JMP I MCR /CHECK WHETHER ITS 'IF' OR 'ON' ///// *-CR /VIA MCR ! GETLN /PATCH TO CHECK FOR MISSING LINENO SZL /AND TO CHOOSE BETWEEN 'IF' & 'ON' CONTINUE /NO NUMBER = CONT. WITH SAME LINE ISZ LASTC /TEST FLAG JMP I (GOTO+1 /IF (ALSO 'NEXT' OR 'BREAK') TSTCMA /ON (ALSO 'JUMP') JMP I (DO+1 /CALL THE SUBROUTINE JMP .-2 /PREVENT MULTIPLE 'DO' CALLS PAGE 7
/EVALUTE AN EXPRESSION ENDING WITH A TERMINATOR AND LEAVE /THE RESULT IN 'FLAC' AND 'FLARG'. 'JMS ECALL' EVALUATES /SUB-EXPRESSIONS, 'PUSHJ;EVAL' SCANS THE CURRENT ONE. NOW /HANDLES MULTIPLE REPLACEMENT OPERATORS AND CHAR VALUE OP /ALA FOCAL65. THANKS TO WAYNE WALL FOR SOME SUPER IDEAS! ECALL, 0 /RECURSIVE CALL TO 'EVAL' TAD .-1 DCA PT1 PUSHF /= 'PT1, THISOP, LASTOP, SORTCN' PT1 ARGNXT, DCA LASTOP /SET OR CLEAR THE OP CODE GETC /SKIP THE TERMINATOR SKP /CONTINUE 'EVAL' ///// EVAL, DCA LASTOP /EVALUATION CONTROLLER TESTC /TEST CHARACTER & IGNORE SPACES JMP ETERM1 /TERMINATOR JMP EFUN /FUNCTION JMP ENUM /NUMBER PUSHJ /LETTER OF VARIABLE GETVAR /LOOKUP THE NAME SPNOR /SKIP TO THE OPERATOR JMS I EQLSPT /IS IT AN 'EQUAL SIGN'? FENT FGETIPT1 /NO, MOVE VALUE TO FLAC FEXT ///// OPNEXT, TESTC /CHECK NEXT OPERATOR JMP ETERMN /T TLIST2, "" /F - ERROR IN FORMAT CR /N JMP EMINUS+1 /L - MISSING OPERATOR ///// ETERM1, SM2 /DO SPECIAL CHAR CHECK TAD LASTOP SMA CLA /INITIALLY OR AFTER AN '=' JMP ELPAR FLOAT /SET UP DEFAULT VALUE DCA FLAC TAD SORTCN /CHECK FOR '-', '+', PARENS TAD M4 SNA JMP EMINUS /CREATE DUMMY FOR UNARY MINUS SPA CLA JMP EVAL-2 /IGNORE UNARY PLUS, EXTRA '=' TAD SORTCN /TEST FOR NULL PARENTHESES TAD M14 SPA CLA JMP ELPAR /MIGHT BE A LEFT PARENTHESIS
ETERMN, JMS LPRTST /ETERM1 FALLS THROUGH 'LPRTST' TAD SORTCN SNA /PARENS OR AN '=' OUT OF PLACE ERROR2 /MISSING OPERATOR OR ILLEGAL '=' TAD M14 SPA CLA /CHECK FOR END OF THE EXPRESSION EMINUS, TAD SORTCN DCA THISOP /ZERO = **THE END** ETERM2, TAD THISOP /COMPARE PRIORITIES CIA TAD LASTOP SPA CLA JMP ESTACK /STACK AND CONTINUE FENT BASE, FPUT I FLARGP /MOVE THE OPERAND FEXT SM1 TAD LASTOP /FIND OPERATION SNA JMP EQUALS /PROCESS AN '=' M10, SPA SNA SZL CLA POPJ /NONE, EXIT 'EVAL' POPF FLAC /GET THE PREVIOUS RESULT TAD LASTOP CLL RTR /SHIFT OP CODE INTO PLACE RTR TAD BASE /COMPENSATES FOR OP CODE DCA OPER FENT OPER, 0000 /'FXXX I FLARGP' FEXT POPA /GET NEXT OPERATION DCA LASTOP JMP ETERM2 ///// EQUALS, POPA /GET VARIABLE POINTER DCA PT1 EQLSPT, TAD FENT&177 /DOUBLE KLUDGE = 'FPUTIPT1' JMP OPER-2 ///// ESTACK, JMS LPRTST /TEST FOR SUB-EXPRESSION SKP JMP EPAR2 /GO EVALUATE EXPRESSION TAD LASTOP /STACK CURRENT OPERATOR PUSHA PUSHF /SAVE THE RESULT TOO FLAC TAD THISOP /ADVANCE THE OPERATOR JMP ARGNXT /////
EFUN, DCA THISOP /CLEAR THE FUNCTION NAME GETC TESTX /LOOK FOR A TERMINATOR JMP EFUN2 /FOUND ONE TAD THISOP CLL RTL /GENERATE THE HASH CODE TAD CHAR TAD P7600 JMP EFUN ///// EFUN2, JMS LPRTST /MUST BE FOLLOWED BY PARENS ERROR2 /VARIABLE NAME BEGINS WITH 'F' JMS ECALL /CALL 'EVAL' TO READ THE ARGUMENT POPA SNA /IS IT A FSF? JMP I .-1 SORTJ /BRANCH ON FUNCTION CODE FNTABL-1 FNTABF-FNTABL ELPAR, JMS LPRTST /LEFT PAREN OR FELL THROUGH TABLE ERROR3, ERROR2 /DOUBLE OPERATORS OR UNKNOWN FUNC EPAR2, JMS ECALL /EVALUATE NESTED EXPRESSION ISZ PDLXR /DUMP THE EXTRA ARGUMENT RETURN /COMPLETE THE FUNCTION CALL ///// LPRTST, 0 /SKIP IF CHAR IS A LEFT PAREN TAD SORTCN TAD M10 SNA /AND CATCH SINGLE QUOTES TOO JMP ECHR AND M4 /=7774 SNA CLA ISZ LPRTST /1-3 ARE PARENS JMP I LPRTST ///// ENUM, READN /READ A NUMBER FROM TEXT JMP OPNEXT /'JMP' IS NEGATIVE ///// *.!177-4 /PUT THIS RIGHT AT THE END ECHR, ISZ I DMPSW GETC /GET THE NEXT CHARACTER DCA I DMPSW TAD CHAR /FLOAT IT FLOAT JMP EFUN3+1 /ALMOST LIKE A 'RETURN' /////
/FUNCTION RETURNS AND CHARACTER TESTING: *2001 PARTEST,0 /TEST THE PAREN MATCHING DCA THISOP /SAVE THE AC IN 'THISOP' POPA /RESTORE LAST OPERATION DCA LASTOP SP2 /GET OPENING PAREN + TWO POPA CMA /NEGATE AND SUBTRACT ONE TAD SORTCN /(PARENS DIFFER BY THREE) SZA CLA /DO THEY MATCH? ERROR2 /NO THEY DON'T - TOO BAD! JMP I PARTEST /ENTRY POINT IS A BETA REGISTER ///// XRTL6, 0 /ROTATE THE AC LEFT SIX - 'RTL6' CLL RTL RTL RTL JMP I XRTL6 /'XRTL6' IS ALSO A BETA REGISTER ///// FL0AT, CLL RAR /UNSIGNED INTEGER FLOAT ROUTINE FLOAT RAR DCA LORD /JUST SHIFT EVERYTHING RIGHT ONE ISZ EXP EFUN3, JMS PARTEST /'RETURN' - CLEARS AC & RESETS DF NORMALIZE GETC /SKIP THE TERMINATOR JMP I .+1 OPNEXT /CONTINUE WITH 'EVAL' ///// MF, -"F /'FN' CHECK FOR 'TESTC' C232, 232 /'EOF' CHECK FOR 'FIND' ///// CTEST, 0 /TEST THE NEXT CHARACTER - 'TESTC' SPNOR /IGNORE SPACES JMS XTEST /CHECK ALL THE TERMINATORS JMP I CTEST /IT WAS A TERM - 'SORTCN' IS SET TAD CHAR TAD MF SNA CLA JMP XT3 /FUNCTION JMS NTEST SKP /PERIOD ISZ CTEST /OTHER ISZ CTEST /NUMBER XT3, ISZ CTEST JMP I CTEST /RETURNS: T;F;N;L /////
/NEW ROUTINE TO TEST IF 'CHAR' IS A TERMINATOR - 'TESTX' /THIS ROUTINE WAS DEVISED BY JIM CRAPUCHETTES (FOCAL8-269) /TO SHORTEN THE TIME REQUIRED FOR THIS TEST BY A FACTOR OF /3-5. THIS RESULTS IN A NET IMPROVEMENT OF ABOUT 12%. XTEST, 0 /TERMINATOR TEST - SETS 'SORTCN' TAD CHAR TAD M336 SMA SZA /IS IT > 336? JMP NO /NOT A TERMINATOR TAD P4 SMA SZA /IS IT > 332? JMP YES RANK, TAD P34 SMA SZA /IS IT > 276? JMP NO /IT'S A LETTER TAD P3 SMA /IS IT > 272? JMP YES+2 TAD P14 SMA SZA /IS IT > 257? JMP NO /IT'S A NUMBER TAD P11 SMA SZA /IS IT > 247? JMP YES+1 TAD P6 SZA /IS IT A SPACE? TAD P23 NO, SNA CLA /IS IT A CR? JMP YES+2 ISZ XTEST /NOT A TERMINATOR JMP I XTEST YES, TAD P11 / [ \ ] ^ TAD P3 / ' ( ) * + , - . / TAD RANK / ; < = > CR DCA .+1 TAD RANK /GET PRIORITY NO. SPA JMP NO /OMIT PERIOD & \ DCA SORTCN JMP I XTEST /////
NTEST, 0 /TEST FOR PERIOD, NUMBER - 'TESTN' TAD CHAR TAD MPER SZA ISZ NTEST TAD M14 /TEST FOR 0-9 CLL TAD P12 DCA SORTCN /SAVE RESULT SZL ISZ NTEST /IF A NUMBER JMP I NTEST ///// / PRIORITY TABLE FOR 'EVAL' P34, 34 /; 01 = = 13 /< 03 = + 0 /= 04 = - 16 /> 05 = / 10 /' 06 = * P11, 11 /( 07 = ^ P14, 14 /) 10 = ' P6, 6 /* 11 = ( P3, 3 /+ 12 = [ P23, 23 /, 13 = < P4, 4 /- 14 = ) MPER, -". /. 15 = ] 5 // 16 = > P12, 12 /[ 23 = , M336, -"^ /\ 34 = ; 15 /] 34 = CR 7 /^ 34 = SPACE ///// /TRANSFER LIST FOR 'SET' AND 'FOR' FLIST, FLIMIT /, FINFIN /; FINFIN-1 /CR /////
/LIST OF CODED FUNCTION NAMES (LOCATIONS IN 'FNTABF') F2=200^4+200 F3=200^4+200^4+200 FNTABL=. "C^4+"O^4+"M-F3 /COM "I^4+"T^4+"R-F3 /ITR "R^4+"A^4+"C-F3 /RAC "S^4+"G^4+"N-F3 /SGN "A^4+"B^4+"S-F3 /ABS "S^4+"Q^4+"T-F3 /SQT "R^4+"A^4+"N-F3 /RAN "S^4+"I^4+"N-F3 /SIN "C^4+"O^4+"S-F3 /COS "A^4+"T^4+"N-F3 /ATN "L^4+"O^4+"G-F3 /LOG "E^4+"X^4+"P-F3 /EXP "R^4+"A-F2 /RA "L^4+"S-F2 /LS "S^4+"R-F2 /SR "M^4+"Q-F2 /MQ "I^4+"N-F2 /IN "O^4+"U^4+"T-F3 /OUT "I^4+"N^4+"D-F3 /IND "M^4+"I^4+"N-F3 /MIN "M^4+"A^4+"X-F3 /MAX "B^4+"L^4+"K-F3 /BLK "L^4+"E^4+"N-F3 /LEN "T^4+"R^4+"M-F3 /TRM "D^4+"A^4+"C-F3 /DAC "A^4+"D^4+"C-F3 /ADC "T^4+"R^4+"G-F3 /TRG "B^4+"U^4+"F-F3 /BUF "T^4+"I^4+"M-F3 /TIM "D^4+"I^4+"N-F3 /DIN "R^4+"E^4+"Q-F3 /REQ "C^4+"T^4+"R-F3 /CTR "D^4+"V^4+"M-F3 /DVM "X^4+"T^4+"R-F3 /XTR "N^4+"E^4+"W-F3 /NEW "D^4+"A^4+"Y-F3 /DAY /THE HASH CODE HAS BEEN CHANGED TO IMPROVE UNIQUENESS. /CHARACTERS ARE SHIFTED 2 BITS AT A TIME AFTER MASKING /THE LEADING BIT. THE TABLE IS ENDED BY 'EXTR'
/UNPACK A CHARACTER FROM THE TEXT BUFFER: 'GETC' EXTR, JMS GET1 /EXTENDED CHARACTER SNA /300? JMP UTE-1 /RESTORE '@' TAD M40 SMA /REVERSE THE TEST JMP UTE+1 /340-376 JMP UTE+2 /201-237 ///// TOGL, ISZ TRACE /TOGGLE THE TRACE FLOP SM1 DCA TRACE M40, SMA SZA CLA /GET THE NEXT CHARACTER UTRA, 0 /UNPACK A CHARACTER JMS GET1 SZA /TURN NULLS INTO SPACES TAD M40 /SUBTRACT 40 UTE, SPA /WHICH SET? TAD C100 /300-337 TAD M77 /240-276, 200 SZA /IS IT A QUESTION MARK? JMP UTX /NO, RESTORE THE CHAR TAD XPRNT /YES SNA CLA /DOES IT GET SPECIAL ATTN? JMP TOGL /YES, TOGGLE THE TRACE FLOP TAD M40 /NO, TREAT IT NORMALLY UTX, TAD P337 DCA CHAR TAD XPRNT /IF XPRNT=0, TRAP '?' MARKS TAD TRACE / >0, IGNORE '?' MARKS SPA CLA /IF TRACE=0, THE TRACE IS OFF PRINTC / -1, THE TRACE IS ON JMP I UTRA /PRINT ONLY IF SUM IS NEGATIVE ///// GET1, 0 /UNPACK 6 BITS ISZ XCT /STARTS WITH 0 JMP GET3 TAD GTEM GEND, AND P77 TAD M77 SNA JMP EXTR /EXTENDED TAD P77 JMP I GET1 M77, -77 ///// XSPNOR, 0 /IGNORE INTERVENING SPACES: 'SPNOR' TAD CHAR TAD M240 SZA CLA JMP I XSPNOR JMS UTRA JMP XSPNOR+1
GET3, CLA CMA /RESET THE FLIP-FLOP DCA XCT CDF T TAD I AXOUT /GET 12-BITS CDF P DCA GTEM TAD GTEM RTR RTR /BSW RTR JMP GEND /RETURN WITH THE FIRST CHARACTER ///// XPRNT, 0 /PRINT A LINE NO. - 'PRNTLN' TAD C240 /SET UP A SPACE DCA CHAR TAD LINENO /THE ENTRY POINT IS 'DMPSW' SNA JMP I XPRNT /NO NUMBER FOR THE HEADER RTL6 AND P77 JMS I PRNTX /TWO-DIGIT 'GROUP' NUMBER SM2 /TO GENERATE A '.' PRINTD TAD LINENO JMS I PRNTX /TWO-DIGIT 'STEP' NUMBER PRINTC JMP I XPRNT PRNTX, PRNT ///// / NEW ROUTINE TO TEST IF 'CHAR' IS A SPACE, SEMICOLON, /COMMA OR CARRIAGE RETURN; SKIPS IF IT IS ANY OF THESE. XSORT, 0 /COMMAND WORD SORT - 'SORTX' TESTCR TAD M240 /-SPACE SZA TAD CHAR /NOT CR M240, SMA SZA TAD MSC /SEMICOLON SPA TAD P17 /COMMA SNA CLA ISZ XSORT /ONE OF THE ABOVE JMP I XSORT MSC, SP-"; ///// /'PACKC' LIST - ALLOWS ROOM FOR 'FNTABF' TO GROW PACGO, PQST /? PCAT /@ RUB1 /RO
/LIST OF FUNCTION ADDRESSES (NAMES ARE IN 'FNTABL') FNTABF=. FCOM /COM -COMMON STORAGE FITR /ITR -NEW INTEGER FN FRAC /RAC -FRACTIONAL PART FSGN /SGN -SIGN= -1, 0, +1 FABS /ABS -ABSOLUTE VALUE FSQT /SQT -SQUARE ROOT FRAN /RAN -RANDOM NUMBER FSIN /SIN -TRIG FUNCTIONS FOR FCOS /COS -ANGLES IN RADIANS FATN /ATN -USE PI TO CONVERT FLOG /LOG -NAPERIAN LOGARITHM FEXP /EXP -EXPONENTIAL (BASE E) /END OF BASIC NUMERICAL FUNCTIONS - REMAINDER DO I/O FRA /RA -RANDOM ACCESS STORAGE ERROR3 /LS -READ THE LEFT SWITCHES FSR /SR -SW. REG. OR R. SWITCHES FMQ /MQ -DISPLAY A NO. IN THE MQ FIN /IN -SINGLE CHARACTER INPUT FOUT /OUT -SINGLE CHARACTER OUTPUT FIND /IND -CHARACTER SEARCH FMIN /MIN -MINIMUM VALUE FMAX /MAX -MAXIMUM VALUE FBLK /BLK -STARTING BLOCK FLEN /LEN -FILE LENGTH FTRM /TRM -INPUT TERMINATOR /ADDITIONAL LABORATORY-TYPE FUNCTIONS ERROR3 /DAC -ANALOG OUTPUT ERROR3 /ADC -ANALOG INPUT ERROR3 /TRG -SCHMITT TRIGGERS ERROR3 /BUF -DISPLAY BUFFER STORAGE ERROR3 /TIM -ELAPSED TIME INTERVAL ERROR3 /DIN -DIGITAL INPUT REGISTER ERROR3 /REQ -PROGRAMABLE OSCILLATOR ERROR3 /CTR -FREQUENCY COUNTER ERROR3 /DVM -DIGITAL VOLTMETER ERROR3 /XTR -EXTRA FUNCTION SLOT ERROR3 /NEW -UNDEFINED FUNCTION FDAY /DAY -SET THE OS/8 DATE
/INSERT A CHAR IN THE TEXT BUFFER - 'PACKC' PACBUF, 0 /ALSO HANDLES DELETIONS DCA PCK1 /SAVE LINENO PROTECTION SORTJ PACLST-1 /CHECK FOR '?', '@', 'RO' PACGO-PACLST TAD CHAR TAD C240 /DECODE AND C100 SZA CLA /EXTENDED? JMP .+3 PCAT, TAD P77 /201-237, 300, 340-376 JMS PCK1 TAD CHAR /200, 240-276, 301-336 JMS PCK1 PACX, CDF P DCA RUB3 /RESET ERROR TRAP JMP I PACBUF ///// PCK1, 0 AND P77 ISZ T3 /=0 TO START JMP PCK2 TAD LASTC DCAIAXIN JMP I PCK1 ///// PCK2, RTL6 /'BSW' DCA LASTC STL CMA DCA T3 TAD AXIN TAD I PACEND /CHECK TEXT LIMIT SNL CLA ERROR2 /TEXT BUFFER FULL JMP I PCK1 ///// PQST, TAD P337 /REPLACE 277 WITH 337 JMP PACX-1 ///// /A NOTE OF APPRECIATION TO EDWARD TAFT III /FOR HELPING WITH THIS APPROACH TO 'PACKC'. /REFERENCE: DECUS FOCAL8-52 (FOCAL 5/69)
RUB1, TAD T3 /RUBOUT ONE LETTER SMA CLA /HALF-WORD? JMS RUB3 /CHECK POSITION TAD P134 /'TAD START' JMP .+4 /'ECHOC' PRODUCES TAD SPAC /'BS', 'SP', 'BS' ECHOC /FOR VIDEO TERMINALS TAD START ECHOC /7-BIT '\' OTHERWISE TAD AXIN DCA PT1 CDF T ISZ T3 /WHICH HALF? JMP RUB2 TAD I PT1 /'T3' HAS BEEN RESET! CMA AND P77 /TEST FOR EXTENDED CHAR SPAC, SZA CLA JMP PACX JMS RUB3 /LOOK OUT FOR LINE NUMBERS! RUB2, CLL CMA /REMOVE 2ND HALF OF STORED WORD TAD AXIN DCA AXIN /RESET STORAGE POINTER TAD I PT1 AND RUB1+1 /=7700 DCA LASTC TAD LASTC TAD C100 /CHECK FOR EXTENDED CLA CMA RAR /L=1 IF NOT " DCA T3 /RESET BYTE COUNTER JMP PACX ///// RUB3, 0 /WATCH OUT FOR THE BEGINNING TAD AXIN STL CIA TAD BUFR TAD PCK1 /PROTECT THE LINENO SNL CLA JMP PACX /DON'T DO ANYTHING! JMP I RUB3 /////
/THE QUIT COMMAND NOW HAS A 'RESTART' OPTION: 'QUIT 5.1' /WILL STOP THE PROGRAM, AND THEN RESTART IT AT LINE 5.1. /'QUIT 0' (OR JUST 'Q') WORKS AS BEFORE. THE RESTART CAN /BE DEFERRED UNTIL THE OCCURRENCE OF ANY ERROR BY SPECI- /FYING A NEGATIVE LINE NUMBER: 'QUIT -5.1' WILL SAVE THE /LINE NUMBER UNTIL YOU ACTUALLY GET AN ERROR. QUIT, GETLN /GET THE LINE NUMBER SZL JMP START /ZERO: (OR NO ARGUMENT) TAD T3 SMA CLA /CHECK THE SIGN JMP ERTRAP+1 /POSITIVE: AUTO-RESTART TAD LINENO DCA RUB3 /NEGATIVE: SAVE FOR LATER CONTINUE ///// ERTRAP, DCA LINENO /MOVE THE LINE NUMBER TAD BOTTOM DCA PDLXR TAD LEVEL0 /CLEAR THE STACKS DCA FORLVL JMP I PACLST /THEN RESTART THE PROG. /ERROR RECOVERY ROUTINE: MODIFIED FOR THE ERROR TRAP ERROR, 0 /TAB COUNTER TOO ! I0N CLA TAD TELSW /WAIT FOR TTY TO FINISH SZA CLA JMP .-3 CDF P TAD RUB3 /SHOULD WE TRAP THIS ONE? SZA JMP ERTRAP /YES TAD ERROR /PROCESS ERROR CODE TO AND C100 /ELIMINATE NON-NUMERICS CMA STL RAR /7777 OR 7737 JMP I .+1 /NO - REPORT IT M20+1 /THE EXPANDED 'JUMP' COMMAND PROVIDES KEYBOARD CHECKING JM JUMP, TESTC /CHECK WHICH FORM WE'VE GOT JMP I JUMP-1 /T = 'JUMP (...) *, *, *, *, ' PACLST, "? /N 'PACKC' LIST FITS IN HERE TO "@ /F SERVE AS 'NOPS' FOR 'TESTC' RO /L TAD INBUF / IF NOT A TERMINATOR, ASSUME A SZA CLA / LINE NUMBER & CHECK THE INPUT CONTINUE / BUFFER. NOTHING THERE: BRANCH JMP I MCR / OTHERWISE CONTINUE WITH PROG.
SORTB, 0 /SORT AND BRANCH ROUTINE - 'SORTJ' SNA TAD CHAR /ASSUME CHAR IF AC=0 CIA DCA DCAT2 TAD I SORTB /FIRST ARGUMENT IS LIST-1 ISZ SORTB DCA XRT TAD I XRT SPA /LISTS ARE ENDED BY NEGATIVE NOS.! JMP SEX /NOT THERE! TAD DCAT2 SZA CLA /MATCH? JMP .-5 /NOT REALLY TAD XRT TAD I SORTB /COMPUTE ADDRESS DCA SORTB TAD I SORTB /DEBUG: AC = ADDRESS DCA SORTB SEX, SZA CLA /CLEAR AC IF NO MATCH ISZ SORTB /TAKE THE SECOND EXIT JMP I SORTB ///// /IMPROVED SYMBOL TABLE DUMP /THE NUMBER OF VARIABLES PER LINE IS DETERMINED BY THE EX- /PRESSION FOLLOWING THE '$'. THUS 'TYPE $4' WILL PRINT 4 /VARIABLES PER LINE. IF NO VALUE IS SPECIFIED (OR 0) THE /PREVIOUS VALUE WILL BE USED. THE DEFAULT IS INITIALLY 3. TDUMP, PUSHJ /GET NUMBER OF VARIABLES PER LINE EVAL-3 FIXIT CIA SZA DCA DMPNO /CHANGE DEFAULT VALUE TAD TRACE DCA LASTC /SAVE THE TRACE SWITCH TAD FIRSTV DCA PT1 /START AT THE BEGINNING TAD DMPNO DCA TRACE /INITIALIZE THE COUNTER JMP DUMPT+4 /(THESE THREE COULD GO) /////
DUMPT, TAD DMPNO /SET COUNTER AND TURN ON TRACE DCA TRACE TAD CCR PRINTC /RESETS THE DF TAD GINC CIA DCA XCT /INITIALIZE LOOP TAD DCAT1 DCA DCAT2 CDF V DCA I LASTV /CLEAR THE LAST NAME TAD I PT1 /MOVE VAR. TO THIS FIELD ISZ PT1 /NO HARM IF IT SKIPS ISZ .+1 DCAT2, DCA T1 /T2, T3, ETC. ISZ XCT /RESETS THE SWITCH TOO! JMP .-5 TAD T2 /LAST ONE? SNA JMP DUMPX /YES CDF T DCA I C200 /SAVE THE NAME TAD P177 DCA AXOUT /SET 'TEXTP' GETC /RESETS THE DF GETC GETC /PRINT 'XX(' JMS I (FGO6 /PRINT SUBSCRIPT GETC /PRINT ')' PRINTN /PRINT VALUE CDF V ISZ TRACE /FINISHED THIS LINE? TAD I PT1 /NO, LAST ENTRY? SNA CLA /NEITHER JMP DUMPT /START A NEW LINE TAD C240 JMP DUMPT+3 /SEPARATE THE VARIABLES ///// DMPNO, -3 /DEFAULT = 3 DUMPX, TAD LASTC /RESET THE TRACE SWITCH DCA TRACE POPJ /RESET DF AND END THE LINE /////
/REMOVE A LINE OF TEXT AND RECOVER THE SPACE - 'DELETE' XDELETE,0 /ENTRY POINT IS PACKING LIMIT TAD LINENO /TRYING TO DELETE LINE 0? SNA CLA JMP START /JUST IGNORE SUCH COMMANDS FINDLN /SETS THISLN, LASTLN, AND TEXTP JMP I XDELETE /ALREADY GONE ///// I0F /PROTECT TEXT POINTERS GETC /MEASURE LENGTH TESTCR JMP .-2 TAD AXOUT /GET LAST ADDRESS CMA TAD THISLN /SUBTRACT FROM FIRST DCAT1, DCA T1 TAD T1 /CORRECT BUFFER POINTER TAD BUFR DCA BUFR CDF T TAD I THISLN /DISCONNECT DCA I LASTLN TAD HEADER /START AT THE BEGINNING XLOOP, DCA LASTLN /CORRECT LINE POINTERS TAD I LASTLN /GET THE NEXT ADDR DCA GTEM /SAVE TAD GTEM /COMPARE LINE POSITIONS CLL CIA TAD THISLN SNL CLA /SKIP IF THISLN > X TAD T1 /CHANGE (X) TO ACCOUNT TAD GTEM /FOR GARBAGE COLLECTION DCA I LASTLN TAD GTEM /GET NEXT SZA /TEST FOR END JMP XLOOP ///// TAD AXIN /COMPUTE COUNT CIA TAD AXOUT DCA XCT CMA TAD THISLN /RESET AXIN DCA AXIN TAD I AXOUT DCA I AXIN /SHIFT REMAINDER OF BUFFER DOWN ISZ XCT JMP .-3 JMP XDELETE+4 /RESET 'LASTLN', 'THISLN' AND D.F. PAGE
/TTY INTERUPT I/O HANDLERS: /OUTPUT BUFFER HAS BEEN MOVED AND THE INPUT MODIFIED /TO INCREMENT A RANDOM NO. OR CALL A DISPLAY ROUTINE KEYCK, XI33+1 /PATCHED BY DISPLAY ROUTINE XOUTN, TAD XI33 TLS /TYPE FIRST CHARACTER DCA TELSW /SET IN-PROGRESS FLAG CDF P JMP I XOUTL P7757, 7757 /LOC = PAGE+6 XI33, (REKOVR /VIA (INDEV) ISZ I XCT /BUMP RANDOM NUMBER TAD INBUF /ANY INPUT? SNA /YES AND NON-ZERO RNDM NO. JMP I KEYCK /NO OR ZERO RANDOM NUMBER DCA XI33+1 /SAVE AND KILL 'ISZ' DCA INBUF /CLEAR INPUT BUFFER TAD XI33+1 /PLACE CHARACTER IN AC JMP I XI33 MCP, "C-"P /OINK, OINK XOUTL, 0 /VIA (OUTDEV) DCA XI33 /SAVE CURRENT CHARACTER CDF L I0N /BE SURE INTERRUPT IS ON TAD I OPTRI /ANY ROOM? SZA CLA /A CHARACTER IS NON-ZERO JMP .-3 /NO = WAIT CIF P /INHIBIT POINTER CHANGES TAD TELSW /IN PROGRESS? SNA CLA JMP XOUTN /NO TAD XI33 /PUT DATA IN EXTRA DCA I OPTRI /BUFFER SPACE TAD OPTRI /ADVANCE POINTER IAC /MODULO 20 AND P7757 /(CIRCULAR STORE) DCA OPTRI /NEW VALUE JMP XOUTN+3 /RE-ENABLE INTERRUPTS MINT, CDI /CTRL/C EXIT JMP I P7600 /MONITOR = 07600 SM8=6254 DCMA=6601 PCLF=6662 RCTF=6677
/INTERRUPT PROCESSOR: CHANGES FOR ^C AND ^F OR ^P INTRPT, DCA SAVAC /SAVE WORKING REGISTERS RAR DCA SAVLK TINT, TSF /CHECK OUTPUT FIRST WHILE DF=0 JMP KINT TCF DCA TELSW /TURN OFF THE IN-PROGRESS FLAG TAD I OPTRO /I/O BUFFER IS IN FIELD 0 NOW SNA JMP KINT /DONE TLS /TYPE NEXT CHARACTER DCA TELSW /CLEAR AC & TURN ON THE FLAG DCA I OPTRO /ZERO OUT THE DATA JUST USED TAD OPTRO /GET POINTER AND IAC /ADVANCE MODULO 20 CTRLF, AND P7757 /(CIRCULAR BUFFER) DCA OPTRO /NEW POINTER KINT, KSF /NOW CHECK THE KEYBOARD JMP UINT KRS /READ BUFFER AND P177 /IGNORE PARITY TAD (-3 SNA /TEST FOR CTRL C JMP MINT TAD (-3 /'TAD MCP' -> ^P SNA CLA /TEST FOR CTRL F JMP M20+2 TAD INBUF /CHECK BUFFER CLL CIA KRB /RE-READ CHAR AND P177 SNA /LEADER/TRAILER? JMP UINT TAD C200 SNL /OVERFLOW? ERROR2 /'NOP' IF YOU DON'T CARE DCA INBUF UINT, NOP /RESERVED FOR PLOTTER OVERLAY NOP / " NOP / " 6302 /NOW CLEAR SOME ANNOYING FLAGS 6312 6322 6332 6342 6076 6402 JMP XINT /CDI 0 /USE THS PATCH FOR ADDITIONAL NOP /JMP I .+1 /INTERRUPT SERVICE NOP /DDRESS /IN ANY FIELD
XINT, NOP /16KXII.PA OVERLAYS HERE NOP / " RCTF DCMA PCLF /LPT8I.PA OVERLAYS HERE PCF TAD SAVLK CLL RAL TAD SAVAC CDI JMP PRNTC /RETURN FROM THE INTERRUPT OPTRI, TBUF /OUTPUT BUFFER POINTERS OPTRO, TBUF /'I'= 'IN', 'O'= 'OUT' /PRINT THE ERROR MESSAGE DCA TELSW /CLEAR THE BUSY FLAG M20, SMA SZA SNL CLA /SKIP ERROR CODE TAD I TABCNT /AC= -1 OR -41 DCA LINENO DCA INBUF TAD OPTRI /RESET POINTER DCA OPTRO CDI L JMS REKOVR /CLEAR OUTPUT BUFFER ///// TAD ("?-"_ /RETURN VIA 'EOF' PRINTC /PRINT A "?" PRNTLN /FOLLOWED BY ERROR CODE ISZ PC CDF T TAD I PC /GET PROGRAM STEP SNA JMP .+6 /DIRECT COMMAND ERROR DCA LINENO TAD C100 /ATSIGN PRINTC /RESETS DF PRINTC /SPACE PRNTLN /LINE NO. TAD CCR PRINTC BATXIT, JMP START /OR RETURN TO BATCH ///// PAGE /END OF COMMAND PROCESSOR /IN THE 8K VERSION THE VARIABLES COME NEXT AND EXTEND TO /THE BEGINNING OF THE FUNCTIONS. IN THE 12K VERSION THIS /SPACE IS AVAILABLE FOR USER ADDITIONS - HELP FOCAL GROW!