/FOCAL EQUIVALANCE DEFINITIONS FIXMRI FGET=0000 FIXMRI FADD=1000 FIXMRI FSUB=2000 FIXMRI FDIV=3000 FIXMRI FMUL=4000 FIXMRI FPUT=6000 FIXMRI FNOR=7000 FENT=JMS I 7 FEXT=0 /PAGE ZERO CONSTANTS, POINTERS, ETC. AXIN=10 XRT=11 PDLXR=13 FLTXR=14 FLTXR2=15 AXOUT=17 XCT=20 GTEM=21 PC=22 THISLN=23 ONFLAG=23 DEBGSW=26 PACKST=27 PT1=30 LASTV=31 T1=32 T3=33 FLOP=40 AC1H=41 AC1L=42 OVER1=43 FLAC=44 HORD=45 LORD=46 OVER2=47 SIGNF=50 FISW=52 SORTCN=54 EFOP=56 BUFR=60 ADD=61 XCTIN=62 OUTDEV=63 INDEV=64 CHAR=66 LINENO=67 T2=71 P337=75 CLF=76 CCR=77 LIST3=77 DMPSW=100 P7700=101 PER=102 M77=103 P7600=104 M20=105 P177=106 P17=107 C260=113 M240=114 MCR=116 M5=120 M11=121 P77=122 C200=123 FLARGP=125 DOUBLE=127 FOUTPUT=130 FINPUT=131 CFRS=133 END=134 ENDT=135 START=177 QUIT=177 /NEW INSTRUCTIONS GETSGN=1045 NEGATE=4451 FIXIT=4453 GETC=4545 SORTJ=4547 SORTC=4550 PRINTC=4551 READC=4552 PRNTLN=4553 FINDLN=4555 RTL6=4557 TSTLPR=4562 TSTGRP=4563 TESTC=4564 DELETE=4565 ERROR2=4566 RETURN=5536 /MACHINE INSTRUCTIONS CDI=6203 /FUNCTION ADDRESSES FEXP=4620 ARTN=5000 FLOG=5040 XSQRT=7400 /OTHER CONSTANTS AND POINTERS WORDS=4 LF=212 GOTO=603 PROCESS=610 PROC=611 PC1=614 STAR=614 COMMENT=614 IF=1013 IF1=1035 SET=1041 FOR=1041 FINCR=1065 FLIMIT=1075 FCONT=1101 FPROC=1106 GLIST=1377 TLIST=1400 GETARG=1403 TLIST2=1404 ECALL=1601 EVAL=1613 ECHOLST=1624 TERMS=1770 FLARG=2030 PARTEST=2047 INFIX=2401 PRNT=2442 MULT10=5667 REMAIN=5712 DUBLAD=5733 TEN=6271 FPNT=6400 TEST2=6736 SPECIAL=6777 DMULT4=7036 DATUM=7102 SIGN=7124 RESOLV=7173 MP4=7200 MP1=7254 MP2=7256 MIF=7260 DNORM=7335 TEST4=7366 BUFFER=7470 MONITOR=7600 /INITIAL DIALOG FOR U/W-FOCAL -JVZ- JMP I LOOKER /SELF-SAVER *202 LINE11 *213 MVR, MOVER CHG, CHANGE MID, MIDDLE CKW, CKWRDS JMS I MVR /ENTRY POINT UPPER CDI 10 JMP I UPPER *224 UPPER, 4540 /AFTER 'UPDATE' NOPUNCH *4540 ENPUNCH DCA NAGSW /SET 'GROUP' TAD ENDT /='1.2' DCA LINENO PUSHJ DO+3 TAD ENDT /ERASE THE PROGRAM DCA BUFR JMP .+5 /'RETURN' MIDDLE, LOWER DCA EFOP /SAVE NAME PUSHJ /LOOK IT UP GS1 CDI JMP I MIDDLE /L=1 IF FOUND STOP *UPPER+20 LOWER, 4566 /'WAITUP' DCA LINE0 DCA LIBBLK DCA NUDATE+3 /FOR SHORTER DATE LOOKUP 2717 /WORDS SKP CLA CMA DCA GOSW /-1 FOR 3 WORDS EXTEND, LOOKUP 0530 /EXTENDED JMP OPENER JMS I MVR NOLOGS JMS I CHG NOEXPS TRIG, LOOKUP 2422 /TRIGFNS JMP OPENER JMS I MVR NOTRIG JMS I CHG NOFNS OPENER, LOOKUP 1720 /OPEN JMP EQUAL DCA DEVHLD JMS I CHG NOOHS EQUAL, LOOKUP 0521 /EQUAL JMP SPACER JMS I CHG TADEQL JMP AMPER SPACER, LOOKUP 2320 /SPACE JMP AMPER JMS I CHG NOSPAC AMPER, LOOKUP 0115 /AMPER JMP COLON JMS I CHG ANDSGN COLON, LOOKUP 0317 /COLON JMP PDP8E JMS I CHG ECHOIT PDP8E, LOOKUP 2004 /PDP8E JMP EAE DCA CHR /CLEAR THE FLAG JMS I MVR BSWER JMS I MVR KCFER JMS I CHG KCCER JMS I MVR NUMULT EAE, LOOKUP 0501 /EAE SKP CLA CMA DCA ATEM TAD (UPDATE /RESET POINTERS DCA K177 CDF 10 TAD I (GLOOP-2 IAC DCA I (END CDF JMS I MVR PIE JMS I CHG RESTART JMP I CKW LOOKUP= JMS . LOOKER, SAVE+1 TAD I LOOKER CDI 10 JMS I MID SZL ISZ LOOKER /2ND EXIT=FOUND ISZ LOOKER JMP I LOOKER PAGE CKWRDS, TAD GOSW /CHECK FOR 3 WORD CHANGES SNA CLA JMP CKEAE CDF 10 ISZ I .+1 /ALTER SYMBOL TABLE LIMIT TOP CDF JMS CHANGE THREEW TAD ATEM SZA CLA JMP CKEAE JMS CHANGE THREAD JMS MOVER NUDIV CKEAE, ISZ ATEM /TEST FLAG JMP I 160 /DONE - CALL MONITOR JMS MOVER CLASS8 /CLASSIC-8 EAE PATCH IAC CLL RTL TAD 154 /-4 SZA CLA JMP I 160 JMS MOVER /DO COMMON STUFF PRNTX JMS MOVER EXPON JMS CHANGE PTENP3 TAD CHR /CHECK IF 8/E SNA CLA JMP EAE8E JMS MOVER PART1 JMS MOVER PART2 ISZ GOSW /CHECK # OF WORDS JMP I 160 /GO AWAY JMS MOVER PART3 JMS CHANGE EAE3W JMP I 160 /FINALLY! SWBA REKOVR EAE8E, TAD .-2 DCA I .-2 JMS MOVER NUSTUF JMS MOVER NYSTUF JMS MOVER NIEUW JMS CHANGE POINTRS ISZ GOSW /THREE WORD VERSION ? JMP I 160 /NOPE JMS MOVER QUICKR JMS MOVER SHORTR JMS CHANGE SMALER JMP I 160 /GOOD-BYE! /MOVING ROUTINES: ONE FOR SINGLES & ONE FOR BUNCHES CHANGE, 0 CLA CMA TAD I CHANGE ISZ CHANGE DCA AUTO CLOOP, TAD I AUTO SNA JMP I CHANGE DCA MOVER TAD I AUTO CDF 10 DCA I MOVER CDF JMP CLOOP GO=0 MOVER, 0 CLA CMA TAD I MOVER DCA AUTO CMA TAD I AUTO DCA AUTO 1 ISZ MOVER MLOOP, TAD I AUTO CMA SNA JMP I MOVER CMA CDF 10 DCA I AUTO 1 CDF JMP MLOOP STOP=-1 DOT=. *54 5723 /DSK *66 FILENAME DIALOG.FC *6436 MONITOR /RETURN FROM SAVE *DOT NOFNS, TOP PCD-WORDS-1 GO NOEXPS, TOP FCOS-WORDS-1 GO NOOHS, BOTTOM /PDL POINTERS PCHK-1 TXTEND 5576 373 ERROR5 /NO 'FLEN' ON-1 WRITE-1 ON+4 NOP GO NOSPAC, OUTDG+6 CLA GO TADEQL, OUTDG+5 NOPUNCH *6141 ENPUNCH TAD OUTDG-1 GO *TADEQL+3 ANDSGN, 5662 -"& CHRT "& 6301 -"& GO ECHOIT, 1221 JMS I ECHO GO KCCER, 2667 KCC GO SMALER, 7164 -27 GO PTENP3, PTEN+3 3147 GO THREAD, DMULT4 5263 /JMP DMDONE 7072 DCA OVER2 MIF -27 GO THREEW, GINC 5 /WORDS+2 P7 7 ZEXIT+2 POPJ XINC 4 /WORDS+1 R6 TAD P7 MD -6 /-DIGITS DCOUNT -6-1 /-DIGITS-1 PTEN+2 3147 FPNT+2 DCA OVER1 6455 JMP I JUMP 6476 5201 /'JMP FPNT+1' 6540 DCA OVER1 TEST2 27 GO RESTART,PT1 RNDM XI33+1 ISZ I PT1 PACK2 NUDATE-1 PACKIT 7715 GLOOK 2011 GO POINTRS,6304 RISOLV 6565 MINUS 6576 FLDV 6752 RISOLV GO EAE3W, BE+3 MQL MUY BD+6 MQL GO NOLOGS, 365 ERROR5 ERROR5 ERROR5 STOP NOTRIG, 363 ERROR5 ERROR5 STOP BSWER, 2355 BSW NOP STOP KCFER, 2637 NOPUNCH *2637 ENPUNCH TAD .+4 DCA INBUF KCF JMP XINT 206 /^F STOP *KCFER+7 CLASS8, MP4+3 NOPUNCH *7203 ENPUNCH DCA .+3 TAD MP2 MQL MUY 0 DCA MP5 MQA DCA MP3 JMP .+15 / ZBLOCK 14 STOP *CLASS8+12 PIE, FLAC 2 3110 3755 2421 STOP /8-E SYMBOLS BSW=7002 KCF=6030 NUMULT, MP4+1 /FOCAL8-280 NOPUNCH *7201 ENPUNCH SNA JMP I MP4 SWP DCA MP5 TAD THIR DCA MP3 TAD I MP4 STL CIA TAD DATUMA DCA MP1 TAD I MP1 SWP CYCLE, RAR SWP SNL JMP .+3 CLL TAD MP2 RAR SWP ISZ MP3 JMP CYCLE RAR DCA I MP1 TAD MP5 SWP ISZ MP1 TAD I MP1 DCA I MP1 SNL JMP I MP4 ISZ MP1 ISZ I MP1 JMP I MP4 JMP .-3 / ZBLOCK 6 STOP *NUMULT+45 PART3, DMULT+6 NOPUNCH *7012 ENPUNCH STL RAR JMP BE-1 STOP P7=124 P4000=124 *PART3+4 NUDIV, 7271 NOPUNCH *7271 ENPUNCH TAD AC1L TAD LORD DCA MP2 RAL TAD HORD TAD AC1H SNL JMP .+4 DCA HORD TAD MP2 DCA LORD CLA TAD MP1 RAL DCA MP1 TAD MP4 RAL DCA MP4 ISZ MP3 JMP DV3 TAD MP1 DCA LORD TAD MP4 DCA HORD JMP I DUBDIV STOP *NUDIV+33 PRNTX, PRNT+1 NOPUNCH *2443 ENPUNCH AND P177 MQL DVI 12 SWP JMS I ODG SWP JMS I ODG JMP I PRNT / ZBLOCK 14 STOP *PRNTX+12 EXPON, FGO6+12 NOPUNCH *6113 ENPUNCH MQL DVI 144 SWP SZA JMS OUTDG SWP JMS I .+2 JMP I FGO6 PRNT / ZBLOCK 7 STOP *EXPON+13 PART2, MP4+1 NOPUNCH *7201 ENPUNCH MQL RAL DCA OVER2 TAD HORD DCA .+3 TAD AC1L SWP MUY 0 TAD OVER2 DCA OVER2 BD, TAD LORD DCA .+3 TAD AC1H SWP MUY 0 TAD OVER2 SWP DCA OVER2 JMP I MP4 / ZBLOCK 30 STOP *PART2+25 PART1, DMULT+6 /FOCAL8-283 NOPUNCH *7012 ENPUNCH TAD OVER2 DCA .+3 TAD OVER1 MQL MUY 0 MQL TAD LORD DCA .+3 TAD OVER1 SWP MUY 0 TAD P4000 DCA MULDIV RAL DCA SIGN TAD OVER2 DCA .+3 TAD AC1L SWP MUY 0 TAD MULDIV MQL SZL ISZ SIGN TAD HORD DCA .+3 TAD OVER1 SWP MUY 0 TAD SIGN DCA SIGN TAD OVER2 DCA .+3 TAD AC1H SWP MUY 0 TAD SIGN DCA SIGN BE, TAD LORD DCA .+3 TAD AC1L SWP MUY 0 TAD SIGN JMS I 7152 TAD HORD DCA .+3 TAD AC1H SWP MUY 0 DCA HORD SWP DCA LORD JMS MULDIV JMP I DMULT MULDIV, STOP *PART1+71 SHORTR, 7014 NOPUNCH *7014 ENPUNCH TAD LORD MQL MUY AC1L MQL TAD HORD SWP MUY AC1L DCA AC1L TAD LORD SWP MUY AC1H SWP SPA CLA ISZ AC1L MQA TAD AC1L MQL TAD HORD SWP MUY AC1H SWP DST HORD JMS I .+3 JMS RISOLV JMP I DMULT DNORM / ZBLOCK 35 STOP /EAE SYMBOLS MUY=7405 DVI=7407 NMI=7411 SHL=7413 MQL=7421 SWAB=7431 SCA=7441 DAD=7443 DST=7445 SWBA=7447 DPSZ=7451 MQA=7501 SWP=7521 DCM=7575 CAM=7621 DLD=7663 ACL=7701 *SHORTR+34 QUICKR, 7176 NOPUNCH *7176 ENPUNCH TAD AC1L SWAB TAD AC1H DST AC1H DLD LORD DCA LORD TAD HORD JMP .+5 DLUP, DLD QHI SHL 1 DST QHI DAD AC1H SNL JMP .+3 DST QHI CAM TAD LORD RAL DCA LORD TAD HORD RAL DCA HORD ISZ EX1 JMP DLUP JMS DNORM JMS I .+2 JMP I .+2 RISOLV FPNT+1 STOP /ZBLOCK 6 /USEFUL PATCHING SYMBOLS SHIFTL=4527 DMULT=7004 MP3=7255 MP5=7253 DATUMA=7252 DUBDIV=7261 THIR=7257 DV3=7267 EX1=40 EXP=44 *QUICKR+46 NUSTUF, DMULT+1 /FOCAL8-284 NOPUNCH *7005 ENPUNCH TAD EX1 JMS SGN SNA JMP ZIRO SPA CLA JMS MINUS SWAB TAD OVER2 MQL MUY OVER1 MQL TAD LORD SWP MUY OVER1 TAD P4000 DCA RISOLV RAL DCA MINUS TAD OVER2 SWP MUY AC1L TAD RISOLV MQL SZL ISZ MINUS TAD HORD SWP MUY OVER1 TAD MINUS DCA MINUS TAD OVER2 SWP MUY AC1H TAD MINUS DCA MINUS TAD LORD SWP MUY AC1L TAD MINUS MQL RAL DCA SGN TAD HORD SWP MUY AC1L TAD SGN DCA SGN TAD LORD SWP MUY AC1H TAD SGN SWP DCA OVER2 TAD HORD SWP MUY AC1H SWP DST HORD JMS I .+3 JMS RISOLV JMP I DMULT DNORM / ZBLOCK 13 STOP *NUSTUF+100 NYSTUF, 7116 NOPUNCH *7116 ENPUNCH SGN, 0 IAC TAD EXP DCA EXP STL RAR AND AC1H TAD HORD DCA SIGNF TAD HORD SNA JMP ZIRO SPA CLA NEGATE TAD AC1H JMP I SGN ZIRO, DCA FLAC DCA HORD DCA LORD JMP I .+1 FPNT+3 MINUS, 0 TAD OVER1 SWAB TAD AC1L DCM SWP DST AC1L SWBA CLA CML RAL TAD AC1H CIA DCA AC1H JMP I MINUS RISOLV, 0 TAD SIGNF SPA CLA NEGATE JMP I RISOLV M43, -43 FLDV, TAD EX1 CIA JMS SGN SNA ERROR2 SMA CLA JMS MINUS TAD M43 DCA EX1 SWAB SKP DLOOP, SHIFTL CLL TAD OVER1 TAD OVER2 DCA DNORM RAL TAD AC1L TAD LORD DCA SCNT RAL TAD AC1H TAD HORD SNL JMP .+6 DCA HORD TAD SCNT DCA LORD TAD DNORM DCA OVER2 ACL RAL MQL TAD QLO RAL DCA QLO TAD QHI RAL DCA QHI ISZ EX1 JMP DLOOP TAD QHI DCA HORD TAD QLO SWP DST LORD JMS DNORM JMS I .+3 JMP I .+1 FPNT+1 RISOLV / ZBLOCK 56 STOP *NYSTUF+134 NIEUW, 7326 NOPUNCH *7326 ENPUNCH GT13, NMI SWP DST HORD CAM SCA TAD P14 JMP ALL0-2 P14, 14 DNORM, 0 CLA CLL TAD LORD MQL TAD HORD SWBA NMI SWAB SCA DPSZ CLL CIA TAD P14 CLA SCA DCA SCNT TAD OVER2 SWP DPSZ SKP JMP ALL0 DCA HORD TAD LORD SNL JMP GT13 SHL SCNT, 0 DCA LORD TAD SCNT CIA TAD EXP ALL0, DCA EXP SWP DCA OVER2 SWBA JMP I DNORM QHI, 0 QLO, 0 STOP *NIEUW+54 DECIMAL LINE11, LINE12 128+10 TEXT ^O I TTY:;S #=FIN();I (#-206),1.6;I (#-217)1.1,1.7,1.1?M^ LINE12, LINE13 128+20 TEXT ^O C;T :7"* * * U/W-FOCAL INITIAL DIALOG * * *"!!;Z?M^ LINE13, LINE14 128+30 TEXT ^T "PLEASE ANSWER QUESTIONS WITH Y (=YES) OR N (=NO)"!?M^ LINE14, LINE15 128+40 TEXT ^T "DO YOU WISH TO RETAIN THE STANDARD FEATURES_";O (F(1))2,2.8?M^ LINE15, LINE16 128+50 TEXT ^T !:7"* * * INITIALIZATION COMPLETED * * *"!;R?M^ LINE16, LINE17 128+60 TEXT ^O I TTY:,E;O O TTY:;T " NO"!;X -1;R?M^ LINE17,LINE18 128+70 TEXT ^O I TTY:,E;O O TTY:;T " YES"!;X 0;R?M^ LINE18, LINE19 128+80 TEXT ^C INITIAL DIALOG FOR U/W-FOCAL WRITTEN 2/16/74 BY JIM VAN ZEE/?M^ LINE19, LINE20 128+90 TEXT ^DEPT. OF CHEMISTRY/UNIVERSITY OF WASHINGTON/SEATTLE, WA. 98195?M^ LINE20, LINE21 256+00 TEXT ^T "0) CHANGE TO 6-DIGIT PRECISION_";I (F(1))2.1;Z WORDS?M^ LINE21, LINE22 256+10 TEXT ^T "1) REMOVE FLOG, FEXP & FATN_";I (F(1))2.3;Z EXTENDED?M^ LINE22, LINE23 256+20 TEXT ^T "2) REMOVE FSIN AND FCOS_";I (F(1))2.3;Z TRIGFNS?M^ LINE23, LINE24 256+30 TEXT ^T "3) REMOVE THE FILE COMMANDS_";I (F(1))2.4;Z OPEN?M^ LINE24, LINE25 256+40 TEXT ^T "4) REMOVE THE LEADING SPACE FROM 'TYPE'_";I (F(1))2.6;Z SPACE?M^ LINE25, LINE26 256+50 TEXT ^T "5) REPLACE THE LEADING SPACE WITH AN '='_";I (F(1))2.6;Z EQUAL?M^ LINE26, LINE27 256+60 TEXT ^T "6) USE '&' IN PLACE OF 'E' FOR EXPONENTS_";I (F(1))2.7;Z AMPER?M^ LINE27, LINE28 256+70 TEXT ^T "7) ADD THE ':' PRINTOUT TO 'ASK'_";I (F(1))2.8;Z COLON?M^ LINE28, LINE29 256+80 TEXT ^T "8) ADD THE 8/E PATCH_";I (F(1))2.9;Z PDP8E;G 2.9?M^ LINE29, 0000 256+90 TEXT ^T "9) ADD THE EAE PATCH_";I (F(1))1.8;Z EAE?M^ NXTXT=.;OCTAL FIELD 1 *60 NXTXT NOPUNCH XLIST /PATCHES TO FOCAL ITSELF ! FIELD 1 *0 SETUP, GETC /MOVE PAST THE COMMA TAD ONFLAG SORTJ /CHECK COMMAND CODE COMLST-1 SETGO-COMLST SETGO, SET /MULTIPLE SET COMMAND FINCR /STANDARD FOR COMMAND *PDLXR RESTOR-1 /INITIALIZE STACK POINTER *16 ZBLOCK 1 //FREE INDEX REGISTER *PC PC0 *PACKST RESTOR-1 RNDM //FRAN INITIALIZATION *34 ZBLOCK 4 //FREE LOCATIONS *FLAC 2 3110 /LOAD 'PI' 3755 2421 *FISW 0 /SET TO FLOATING OUTPUT *57 INBUF, 0 /MOVED TO SAVE A WORD LINE1 *INDEV XI33 /PATCHED FOR 'FRAN' GINC, WORDS+2 //INTERCHANGE GINC & NAGSW *70 NAGSW, 1 //FOR CONVENIENCE OF FSF'S *72 MCOM, -", //USEFUL CONSTANT ON PAGE ZERO NOW LIST6, 214 /F.F. (^L) 207 /BELL LIST7=. *102 M12, -12 /DECIMAL CONVERSION CONSTANT *110 //REPLACE 'P277', 'M2' & 'MINUSA' P13, 13 C100, 100 FLOAT=JMP I . /FOR USER FUNCTIONS FIN+2 *117 M4, -4 /USED BY 'GETARG','^',& 'FRAN' *126 M40, -40 /FOR 'GETLN', 'GETC', & 'RECOVR' *132 FP0, FLTZER /MOVED FOR ^L FUDGE LINE0 END, STVAR //PATCH THIS WHEN ADDING FUNCTIONS! LINE1 *137 POPA=JMS I . /REDEFINE SOME NEW INSTRUCTIONS XPOPA PUSHJ=JMS I . XPUSHJ POPJ=JMP I . XPOPJ PUSHA=JMS I . XPUSHA PUSHF=JMS I . PD2 POPF=JMS I . PD3 *146 PACKC=JMS I . PACBUF *151 OUT ECHO, CHIN /ENTRY POINT IS USED FOR 'INSUB' *154 GETLN=JMS I . XGETLN //MAY BE CALLED RECURSIVELY *166 TABCNT, ERR2 /ERROR ENTRY IS ALSO TAB COUNTER DPC, PCD /(TAD I PC) - 8K SUBROUTINES DTHIS, THISD /(TAD I THISLN) DPT1, PT1D /(TAD I PT1) DXRT, XRTD /(TAD I XRT) DAXIN, AXIND /(DCA I AXIN) FCHECK, TESTF //FOCAL STATEMENT FUNCTIONS TOP, FEXP-WORDS-2 /ADJUSTED BY THE INITIAL DIALOG RECOVR-2 /MANUAL RESTART ENTRY POINT *201 TAD C100 /INITIALIZE PC *211 JMS I ECHO /SHOULD WE PRINT A '*'? *212 TAD BUFR /COMMAND INPUT BUFFER *215 TAD BOTTOM /INPUT LIMIT DCA PACKST *221 LIST7-1 /MOVED DOWN ONE INLIST-LIST7 *226 BOTTOM, RESTORE-1 /(OR PCHK-1) - START OF PDL *231 TAD BUFR /INITIALIZE FOR UNPACKING *235 TAD TXTEND /THE LAST WORD! DCA PACKST *241 JMP GZERR /GROUP 0 ERROR *245 STL RAR /'TAD P4000' TAD NAGSW //NAGSW MOVED *255 JMS I DAXIN /DCA I AXIN *273 JMS I DPC /TAD I PC *302 TXTEND, 3576 /(OR 5576 W/O FILE COMMANDS) EJECT /ROUTINE TO EVALUATE A LINE NUMBER - "GETLN" XGETLN, 0 TAD .-1 /PERMIT RECURSIVE CALLS PUSHA /& DIFFERENT ENTRY POINT PUSHJ /EVALUATE ARGUMENT EVAL FIXIT /FIX FLAC AND SET AC TAD M40 /MINUS THIRTY-TWO SMA CLA ERROR2 /BAD GROUP NUMBER TAD LORD /GET GROUP AGAIN RTL6 /SHIFT INTO PLACE RAL DCA LINENO /FIRST PART IS DONE NEGATE /INTEGER PART FENT FADD I FLARGP /SUBTRACT INTEGER FMUL FL100 /INCREASE FRACTION FADD FLP5 /ROUND OFF BINARY ARITHMETIC FEXT FIXIT /FIX THIS PART NOW CLL SZA CLA JMP .+5 /NOT GROUP OR ALL TAD LINENO SNA CLA /WAS IT ALL ? STL IAC /YES: LINK & NAGSW = 1 JMP .+7 /GROUP: LINK & NAGSW = 0 TAD LINENO SNA GZERR, ERROR2 /GROUP ZERO IS ILLEGAL TAD LORD /COMBINE GROUP & STEP NUMBERS DCA LINENO STL RAR /SET NAGSW=4000 & CLEAR LINK DCA NAGSW POPJ /LINK=1 IF "ALL" FL100, 7 3100 0 FLP5, 0 2000 0 0 EJECT /LIST OF FUNCTION ADDRESSES (NAMES ARE IN "FNTABL") FNTABF=. ERROR5 /COM -COMMON STORAGE XSQRT /SQT -SQUARE ROOT FSGN /SGN -SIGN (OMSI VERSION) FABS /ABS -ABSOLUTE VALUE FITR /ITR -INTEGER VALUE FRAN /RAN -RANDOM NUMBER (OMSI) FSIN /SIN -TRIG FUNCTIONS FOR FCOS /COS -ANGLES IN RADIANS ARTN /ATN -USE PI TO CONVERT FLOG /LOG -LOGARITHM (BASE E) FEXP /EXP -EXPONENTIAL (BASE E) /END OF BASIC NUMERICAL FUNCTIONS - REMAINDER DO I/O FIN /IN -SINGLE CHARACTER INPUT FOUT /OUT -SINGLE CHARACTER OUTPUT FIND /IND -CHARACTER SEARCH FLEN /LEN -FILE LENGTH ERROR5 /ADC -ANALOG INPUT ERROR5 /DAC -ANALOG OUTPUT ERROR5 /DVM -DIGITAL VOLTMETER ERROR5 /DIS -OSCILLOSCOPE DISPLAY /ADDITIONAL FUNCTIONS - TABLE CROSSES PAGE BOUNDARY ERROR5 /CNT -FREQUENCY COUNTER ERROR5 /SYN -FREQUENCY SYNTHESIZER ERROR5 /REQ -FREQUENCY GENERATOR ERROR5 /TIM -TIME OF DAY (CLOCK) ERROR5 /TRG -SCHMITT TRIGGERS ERROR5 /POT -POTENTIOMETERS ERROR5 /SWS -SENSE SWITCHES ERROR5 /RLY -RELAY REGISTER ERROR5 /PSD -DIGITAL LOCK-IN ERROR5 /AVR -SIGNAL AVERAGER ERROR5 /FFX -FAST FOURIER TRANSFORM /NOTE: THE ORIGINAL CODE FOR 'FADC' AND 'FDIS' REMAINS AND /USERS WITH THE APPROPRIATE HARDWARE MAY PUT THE ADDRESSES /IN THE TABLE IN PLACE OF 'ERROR5': FADC=1343 & FDIS=1142. /CHANGES TO "DO" DUE TO MOVING NAGSW & GINC FOR F FUNCTIONS /ALSO HANDLES MULTIPLE CALLS IN ONE COMMAND: DO 5.1,4,12.9 *420 DO, TAD DOEXIT /SET UP NORMAL EXIT PUSHA GETLN *426 CHAR //SAVE CHAR,LINENO,NAGSW (AND T2) TAD NAGSW *436 JMS I DXRT /TAD I XRT *444 CHAR JMS I DPC *452 TAD NAGSW *460 JMS I DPT1 /TAD I PT1 *455 JMS I DPT1 /TAD I PT1 *470 CHAR *473 TAD CHAR /CHECK FOR ADDITIONAL CALLS TAD MCOM SZA CLA POPJ /EXIT "DO" GETC /MOVE PAST COMMA JMP DO+2 /'DO' ANOTHER ONE! DOEXIT, PROC EJECT /PUSH DOWN LIST SUBROUTINES - STACK IN FIELD 0 XPUSHA, 0 CDI JMP I .+2 JMP I XPUSHA APUSHX XPUSHJ, 0 CLA IAC TAD XPUSHJ /BUMP RETURN ADDRESS JMS XPUSHA /SAVE IT ON THE STACK TAD I XPUSHJ /GET THE ADDRESS DCA XPUSHJ /INDIRECT INDIRECT! JMP I XPUSHJ XPOPA, 0 CDF TAD I PDLXR CDF 10 JMP I XPOPA RETRN, TAD C100 /R COMMAND DCA PC XPOPJ, JMS XPOPA DCA XPOPA JMP I XPOPA PD2, 0 /PUSHF TAD PD2 CDI DCA I .+3 CDF 10 /RESET CALLING FIELD JMP I .+2 /FAKE A JMS MPD2 MPD2+1 PD3, 0 /POPF CLA CMA TAD I PD3 ISZ PD3 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 PD3 EJECT INPUT, 0 /RELOCATED TO EXPAND COMMANDS TAD I ECHO /READS FROM KEYBOARD OR TEXT SZA CLA /WHICH ONE? JMP .+3 GETC /TEXT JMP I INPUT READC /KEYBOARD SORTJ SPECIAL-1 /_,RO,LF,ALT,^L INFIX-SPECIAL JMP I INPUT INLIST=. *575 FINFIN /; SHORT FORM FLIMIT-1 /CR SETUP /, CHECK S,F *622 DCA ONFLAG /SAVE CODE - CLEAR FLAG *630 TAD ONFLAG SORTJ /COMMAND BRANCH POINT COMLST-1 COMGO-COMLST WRITE=.+1 *652 JMS I DTHIS /TAD I THISD *657 TAD NAGSW //NAGSW MOVED *661 JMS I DPT1 /TAD I PT1 *664 JMS I DPT1 /TAD I PT1 *673 TAD NAGSW *756 GETC /X COMMAND - FOR I/O AND XECUTE, PUSHJ /FOCAL STATEMENT FUNCTIONS EVAL SORTJ GLIST ELIST-GLIST-1 JMP XECUTE ELIST, XECUTE-1 PROCESS PC1 /FOCAL COMMAND CODES: THERE ARE FOUR NEW COMMANDS! COMLST=. "S /SET "F /FOR "D /DO "I /IF "O /ON "G /GOTO "Z /ZERO "R /RETURN "X /XECUTE "C /COMMENT "L /LIBRARY "A /ASK "T /TYPE "W /WRITE "M /MODIFY "E /ERASE "Q /QUIT LF /STAR LF /STAR *1017 CMA CLL RAL /'TAD M2' *1027 JMS I MCR /PATCH "IF" *1032 ILIST-TLIST /ILIST MOVED *1045 TAD MEQ /MOVED *1054 POPA *1070 EVAL /ADD 1 /CHANGES TO "FOR" FOR NEGATIVE INCREMENTS & FASTER LOOPING: *1112 LIMIT, BUFFER /LEAVE FLARG ALONE POPF FLAC /LOAD INCREMENT POPA DCA PT1 /VARIABLE POINTER GETSGN DCA T3 /SAVE SIGN OF INCREMENT FENT FADD I PT1 /INCREMENT LOOP INDEX FPUT I PT1 /AND SAVE IT AGAIN FSUB I LIMIT /COMPARE WITH LIMIT FEXT TAD T3 /SET PROPER SIGN SPA CLA NEGATE GETSGN /NOW TEST IT SMA SZA CLA POPJ /END OF LOOP TAD M16 /EFFECTIVE PUSHDOWN FOR TAD PDLXR /PT1, INCREMENT, LIMIT, DCA PDLXR /TEXTP, AND PUSHJ PROC. JMP I FPROC /CONTINUE LOOP M16, -16 MEQ, -"= FDIS=. /ORIGINAL DISPLAY FUNCTION *1145 TAD MCOM /MCOM MOVED TO PAGE ZERO *1155 POPA *1157 RETURN /CLEARS AC IF NON-ZERO /COMMAND BRANCH POINTS: COMGO=. SET FOR DO IF ON GOTO ZERO RETRN XECUTE COMMENT LIB ASK TYPE WRITE MODIFY ERASE QUIT STAR STAR /CHANGES TO "ASK" "TYPE" & "MODIFY" *1203 PUSHJ /EVALUATE EXPRESSION EVAL JMS I FOUTPUT /PRINT RESULT TYPE, DCA ATSW /NEW ATSW TASK, SORTJ /!,",#,$,%,: ? ALIST-1 ATLIST-ALIST ISZ ATSW /"ASK" OR "TYPE" ? JMP TYPE-3 PUSHJ /LOOKUP VARIABLE GETARG TAD CHAR /SAVE NEXT CHARACTER DCA ATSW TAD ALIST /GET ":" ISZ I ECHO /'JMS I ECHO' TO PRINT IT CLA IAC JMS I FINPUT /READ A NUMBER TAD ATSW DCA CHAR /RESTORE CHARACTER ASK, CMA JMP TYPE /SET ATSW TCRLF, TAD CCR /'!'=CR AND LF PRINTC TASK4, DCA DEBGSW /RE-ENABLE TRACE GETC /MOVE ALONG JMP TASK FORMAT, GETC /MOVE PAST '%' GETLN /GET FORMAT TAD LINENO DCA FISW /SAVE FOR LATER JMP TASK SPLAT, TAD CCR /'#'=CR W/O LF JMS I OUTDEV DCA I TABCNT /RESET TAB COUNTER TAD C200 /GET NULL FOR DELAY JMP TCRLF+1 ATSW= ONFLAG EJECT /NEW MODIFY COMMAND - ALSO PERMITS 'MOVING' LINES: /IF A SECOND LINENO IS GIVEN (SEPARATED BY A COMMA) THE /MODIFIED LINE WILL BE SAVED WITH A NEW NUMBER, LEAVING /THE OLD LINE UNCHANGED. MODIFY, GETLN /READ THE FIRST LINENO SORTC /CHECK FOR A SECOND ONE COMMA-1 GETC /MOVE PAST COMMA PUSHJ /OTHERWISE 'EVAL' GIVES ZERO EVAL TAD BUFR /SET 'TEXTP' DCA AXIN FINDLN /LOOK UP OLD LINE ERROR2 /NOT THERE DCA XCTIN GETSGN SZA CLA /NEW LINENO? PUSHJ /YES: SET IT UP XGETLN+5 TAD LINENO JMS I DAXIN /PACK IT ISZ DEBGSW /DISABLE TRACE & PROTECT LINENO SCONT, JMS I INDEV /GET SEARCH CHARACTER (SILENTLY) DCA DMPSW *1277 LISTGO-LIST3 /LISTGO HAS MOVED *1310 LIST6-1 SRNLST-LIST6 *1354 QUOTE, ISZ DEBGSW /DISABLE TRACE GETC SORTJ /" OR CR TLIST2-1 TLIST3-TLIST2 PRINTC JMP QUOTE+1 SRNLST, 1273 SCONT 1302 /MOVE UP ONE TO ADD TAB SCONT+1 LISTGO, 0261 1312 ALIST, ": /ADDED FOR TAB /CHANGES TO GETARG FOR DOUBLE SUBSCRIPTING, FASTER LOOKUP, /THE ZERO COMMAND AND ZERO-VARIABLE REPLACEMENT. *1411 TAD ADD /SAVE NAME DCA EFOP /WHERE WE CAN PUSH IT GETLP, GETC /GET NEXT CHAR SORTC /END OF NAME? TERMS-1 JMP GSERCH /YES ISZ XCTIN /IS THIS THE SECOND CHAR JMP GETLP /IGNORE ADDITIONAL CHARS TAD CHAR /PACK SECOND CHAR AND P77 /MASK IT JMP GETLP-2 /ADD TO NAME GSERCH, TSTLPR /CHECK FOR SUBSCRIPT JMP GS1 JMS I GECALL /PICK IT UP JMS I LOOK42 /CHECK FOR SECOND SUBSCRIPT GS1, DCA SUBS /SAVE SUBSCRIPT TAD EFOP /INSERT NAME AT END OF TABLE DCA I LASTV /TO MAKE SURE THAT IT IS FOUND TAD .+2 /BEGIN WITH 'SECRET' VARIABLES JMP GLOOP+2 STVAR-1 CMA /BACKUP TO NAME GLOOP, TAD XRT TAD XINC /ADVANCE TO NEXT ONE DCA XRT TAD I XRT /COMPARE NAMES CIA TAD EFOP SZA CLA JMP GLOOP /TRY AGAIN TAD XRT /END OF TABLE ? CIA TAD LASTV SNA CLA JMP MAKVAR /YES: ADD NEW VARIABLE TAD I XRT /NO: CHECK FOR SUBSCRIPT MATCH CIA TAD SUBS SZA CLA JMP GLOOP-1 /NOT THIS ONE GEXIT, STL IAC /FOUND: POINT TO DATA TAD XRT DCA PT1 POPJ /LINK=1 EJECT ZLOOP, SNL CLA /ORGANIZED TO RETAIN ERROR CODE ERROR2 /STORAGE FULL TAD I XRT /IS THIS ONE ZERO? SNA CLA JMP ZFOUND /YES TAD XRT TAD XINC ZSERCH, DCA XRT /POINT TO MANTISSA TAD XRT /CHECKED THEM ALL YET? CLL CMA TAD LASTV JMP ZLOOP MAKVAR, TAD TOP /TEST FOR OVERFLOW CLL CIA TAD LASTV SZL CLA JMP ZINITL /REPLACE A ZERO VARIABLE TAD LASTV /UPDATE STORAGE LIMIT TAD GINC DCA LASTV TAD SUBS /INSERT SUBSCRIPT DCA I XRT SET20, DCA I XRT /ZERO DATA TAD XRT DCA PT1 /SET POINTER JMP ZEXIT SUBS=. *1527 ZEXIT, DCA I XRT DCA I XRT DCA I XRT /(POPJ) FOR 3 WORD VERSION POPJ /LINK=0 *1546 TAD SORTCN /SAME RESULT TAD M11 /WITHOUT M271 *1553 ZINITL, STL RTL TAD END /INITIALIZE X-REGISTER JMP ZSERCH ZFOUND, TAD M4 /POINT TO NAME TAD XRT DCA XRT TAD EFOP DCA I XRT /REPLACE THE NAME JMP SET20-2 /AND THE SUBSCRIPT XINC, WORDS+1 GECALL, ECALL LOOK42, TEST42 *1567 ATLIST, XTAB /FOR : ADDITION FORMAT /% QUOTE /" TCRLF /! SPLAT /# TDUMP /$ TASK4 /SP TASK4 /, PAGE *1626 /'EVAL' FOUND A TERMINATOR WHICH IS JMP 1650 /NOT AN OPERATOR->END OF EXPRESSION TAD FP0 /POINT TO 0 FOR MISSING OPERANDS DCA PT1 CMA CLL RAL /'TAD M2' *1705 POPA *1736 DCA I ECHO /CLEAR FLAG *1757 POPA *1757 JMS I FCHECK /CHECK FN NAME FOR ZERO SORTJ /FUNCTION FINDER - NEW TABLES FNTABL-1 FNTABF-FNTABL *2010 FIN, READC /SINGLE CHARACTER INPUT TAD CHAR DCA HORD /FLOAT ROUTINE DCA LORD TAD P13 /SET PROPER EXPONENT DCA FLAC DCA OVER2 EFUN3, FENT /END OF FUNCTION CALLS FNOR FLAC /LET NORMALIZE SAVE FLAC *2050 POPA *2053 POPA *2077 DCA T3 /NUMBER OF WORDS TO DELETE *2105 CDF /CHANGE DATA FIELD FOR 'DELETE' *2122 TAD T3 *2132 TAD T3 *2136 TAD T3 *2146 TAD T3 EJECT /LIST OF CODED FUNCTION NAMES (ADDRESSES ARE IN "FNTABF") *2155 FNTABL=. 2567 /COM 2702 /SQT 2650 /SGN 2533 /ABS 2636 /ITR 2630 /RAN 2654 /SIN "PLT"="SIN" 2575 /COS 2572 /ATN 2625 /LOG 2624 /EXP "INT"="EXP" 1140 /IN 2672 /OUT 2604 /IND "FCRT=FIND" 2610 /LEN 2517 /ADC 2525 /DAC 2611 /DVM 2565 /DIS "AVE"="DIS" 2574 /CNT 2714 /SYN 2643 /REQ 2657 /TIM "NUM"="TIM" 2673 /TRG 2662 /POT 2715 /SWS 2671 /RLY 2652 /PSD "SET"="PSD" 2602 /AVR 1144 /FFX "FFT"="FIN" /ERASE COMMAND IS ONLY FOR TEXT - USE ZERO FOR VARIABLES ERASE, PUSHF /GET NULL FOR HEADER FLTZER GETLN /WHICH LINE ? SNL /ALL ? JMP ERL /ERASE LINES OR GROUPS ERA, TAD ENDT /ERASE ALL DCA BUFR CDF /TEXT IS IN FIELD 0 DCA I CFRS /PLACE ZERO IN FIRST LINE CDI JMP NONAME /UPDATE HEADER ERL, TAD BUFR /PROTECT REST OF TEXT DCA AXIN ERG, DELETE /EXTRACT GIVEN LINE ISZ THISLN /ADVANCE ONE LINE TAD NAGSW /GROUP OPERATION? SMA CLA /SKIP IF SINGLE LINE JMS I DTHIS /TAD I THISLN TSTGRP /DONE ERASING GROUP? JMP ERA+4 /YES: ERASE PROGRAM FLAG JMS I DTHIS /UPDATE LINE NUMBER DCA LINENO JMP ERG /CONTINUE *2253 JMS I DXRT /TAD I XRT *2262 JMS I DTHIS /TAD I THISLN EJECT /CHANGES TO 'GETC' TO TURN "@" INTO A "SPACE". *2276 UTRA=.-2 UTE, SPA /DON'T CLEAR AC TAD C100 /300-377 & 340-376 TAD M77 /240-276 & 200-236 SNA JMP UTX /"?" FOUND UTQ, TAD P337 DCA CHAR TAD DEBGSW TAD DMPSW SNA CLA /PRINT ONLY IF BOTH ARE ZERO PRINTC JMP I UTRA /RETURN EXTR, JMS GET1 SMA /REVERSE TESTING AT 'UTE' JMP UTE+1 JMP UTE+2 UTX=. *2326 TAD M40 JMP UTQ GET1, 0 /UNPACK 6 BITS ISZ XCT /WHICH HALF ? JMP GET3 GEND=.+1 *2341 JMP EXTR TAD CHAR /BITS 6-11 ONLY SZA /ADD 40 IF ZERO TAD M40 JMP I GET1 /RETURNS TO UTE OR EXTR+1 GET3, CDF TAD I AXOUT CDF 10 DCA GTEM CMA DCA XCT TAD GTEM RTL6 /'BSW;NOP' FOR 8/E RAL JMP GEND *2361 CDF /CHANGE TO TEXT FIELD *2374 DCA I P77 /WE'VE ADDED A NEW LINE: KILL CDF 10 /'CURRENT PROGRAM SAVED' FLAG *2377 TLIST3, TASK4 *INFIX+1 INPUT+1 /RO INPUT+1 /LF *INFIX+4 INPUT+1 /^L FLTONE, 0001 /ALL THIS MUST BE MOVED DOWN ONE 2000 FLTZER, 0000 0000 0000 0000 ILIST, IF1 /, LIST MOVED TO EXPAND COMMANDS PROCESS /; PC1 /CR TERMER, 0 /COMMAND WORD SORT SORTC GLIST-1 ISZ TERMER /2ND EXIT = FOUND CDI JMP I TERMER *2432 CMA CLL RAL /GENERATE A "." JMS I ODG *2436 TAD M140 /PSEUDO SPACE *2453 TAD M12 /PATCH 'PRNT' *2466 OUT, 0 /"PRINTC" SNA /USE AC IF NON-ZERO TAD CHAR /OTHERWISE USE CHAR TAD MCR CIF JMS I .-1 /ADJUST TAB COUNTER JMS I OUTDEV /NORMAL RETURNS JMP I OUT JMS I OUTDEV /CARRIAGE RETURNS ! TAD CLF JMP .-4 ODG, OUTDG EJECT -"? PACBUF, 0 /CHANGES TO 'PACKC' TO SAVE FIVE WORDS TAD .-2 *2507 TAD P40 *2512 JMP I RUBIT TAD P377 *2516 P377, AND (140 /DOUBLE DUTY TAD M140 SZA TAD (140 M140, SZA CLA JMP PA1 TAD P77 /200-237 & 340-377 JMS PCK1 PA1, TAD T2 /240-337 AND P77 SZA /OMIT 300 JMS PCK1 PACX, CDF 10 JMP I PACBUF RUBIT, RUB1 PCK1=. *2541 JMS AXIND /DCA I AXIN P40, 40 DCA ADD TAD PACKST /CHECK LIMIT CLL CIA *2552 AXIND, 0 /8K PATCH CDF DCA I AXIN CDF 10 JMP I AXIND *2564 CHIN, 0 /'READC' (IF AC=0) SNA /'ECHO' IF AC NON-ZERO JMS I INDEV DCA CHAR SORTJ /PRESERVES 'SORTCN' ECHOLST-1 /FOR FUNCTION CALLS ECHOGO-ECHOLST IECHO, PRINTC /'ION' IF NOT ECHOING JMP I CHIN ECHOGO, .-1 /DON'T ECHO .-2 /LF OR R.O. PAGE /INTERRUPT PROCESSOR: CHANGES FOR ^F AND ^C M3, -3 /KEYBOARD KONSTANT 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 OPTRI /I/O BUFFER IS IN FIELD 0 NOW SNA JMP KINT /DONE TPC /TYPE NEXT CHARACTER DCA TELSW /CLEAR AC & TURN ON THE FLAG DCA I OPTRI /ZERO OUT THE DATA JUST USED TAD OPTRI /GET POINTER AND IAC /ADVANCE MODULO 16 AND P17 /(CIRCULAR BUFFER) TAD OPTR0 /ADD START DCA OPTRI /NEW POINTER KINT, KSF /NOW CHECK KEYBOARD JMP XINT KRS /READ BUFFER AND P177 /IGNORE PARITY SNA /LEADER/TRAILER ? JMP XINT-1 TAD M3 SNA /TEST FOR CTRL C JMP MINT TAD M3 SNA /TEST FOR CTRL F JMP RECOVR TAD CTRLF /RESTORE DCA XI33+1 /SAVE AND KILL ISZ TAD INBUF SZA CLA /TEST FOR OVERFLOW ERROR2 TAD XI33+1 /'ZBLOCK 2' FOR 8/E DCA INBUF KCC /CLEAR BUFFER XINT, JMP .+3 /CDI ?0 -PATCH FOR OTHER ZBLOCK 2 /JMP I .+1 -INTERRUPT SERVICE /?INT -IN ANY FIELD TAD SAVLK CLL RAL TAD SAVAC CDI JMP 4 /RE-ENABLE INTERRUPT SYSTEM MINT, CDI JMP I P7600 /MONITOR = 07600 /TTY INTERUPT I/O HANDLERS: /OUTPUT BUFFER HAS BEEN MOVED AND THE INPUT /IS MODIFIED SO AS TO INCREMENT A RANDOM NO. XI33, 0 /VIA (INDEV) ISZ I PT1 /BUMP RANDOM NUMBER TAD INBUF /ANY INPUT? SPA SNA /YES AND NON-ZERO RNDM NO. JMP .-3 /NO OR ZERO RANDOM NUMBER DCA XI33+1 /SAVE TEMPORARILY CTRLF, 206 /'KCC' FOR 8/E DCA INBUF /CLEAR INPUT BUFFER TAD XI33+1 /PLACE CHARACTER IN AC JMP I XI33 OPTR0, IOBUF OPTRI, IOBUF OPTRO, IOBUF XOUTL, 0 /VIA (OUTDEV) DCA XI33 /SAVE CURRENT CHARACTER CDF 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 /YES TAD XI33 /NO TLS /TYPE CHARACTER DCA TELSW /SET IN-PROGRESS FLAG JMP .+10 /RETURN TAD XI33 /PUT DATA IN EXTRA DCA I OPTRO /BUFFER SPACE TAD OPTRO /ADVANCE POINTER IAC /MODULO 16 AND P17 /(CIRCULAR STORE) TAD OPTR0 /ADD BEGINNING DCA OPTRO /NEW VALUE ION CDF 10 JMP I XOUTL SAVAC, 0 SAVLK, 0 TELSW, 0 EJECT /ERROR RECOVERY ROUTINE - REWRITTEN TO PROVIDE FOR /PROPER RESTARTING OF LOW SPEED READER AS WELL AS /MANUAL RESTARTS. ERROR5, DCA ERR2 /TABLE ERROR ERR2, 0 /TAB COUNTER TOO ! ION TAD TELSW /WAIT FOR OUTPUT TO FINISH SZA CLA JMP .-2 CMA TAD ERR2 /PREPARE ERROR CODE JMP RECOVR+1 RECOVX, TAD M40 /CREATE A "?" PRINTC PRNTLN /FOLLOWED BY ERROR CODE ISZ PC JMS I DPC /GET PROGRAM STEP SNA JMP .+6 /DIRECT COMMAND ERROR DCA LINENO TAD P7700 PRINTC /ATSIGN PRINTC /SPACE PRNTLN /LINE NO. TAD CCR PRINTC JMP START DCA TELSW /CLEAR BUSY FLAG SKP CLA /MANUAL RESTART = ?00.00 RECOVR, TAD C200 /KEYBOARD BREAK = ?01.00 DCA LINENO CDI /DISABLE INTERRUPTS AND SET DF KCC DCA INBUF /CLEAR INPUT BUFFER TAD OPTR0 /RESET OUTPUT POINTERS DCA OPTRI TAD OPTR0 DCA OPTRO TAD M20 DCA I OPTR0 /LOOP COUNTER TAD OPTR0 DCA I P13 /FIELD 0 X-REG. IOF /PATCHED BY PLOT OVERLAY JMP I (REKOVR /RESTORE OUTPUT TO TTY RUB1, TAD XCTIN /REMOVE A CHARACTER SZA CLA /HALF-WORD? JMP .+7 TAD AXIN /CHECK POSITION CIA TAD BUFR /BEGINNING OF LINE TAD DEBGSW /PROTECT LINENO *3015 JMS I ECHO /SHALL WE ECHO A '\'? *3020 CDF /LOWER FIELD TO RUBOUT TEXT *3041 PACX /CORRECT POINTER *3044 TAD C100 /MOVED *3052 TDUMP, TAD DMPSW /CHANGES FOR LOWER-FIELD TEXT, DCA ATSW /TRACE PROTECTION, AND IMPROVED TAD END /SUBSCRIPT OUTPUT: -999 TO +999 DCA PT1 TAD LASTV CIA TAD PT1 SNA CLA /ALL DONE? POPJ /YES: END THIS LINE TAD P177 DCA AXOUT /SET 'TEXTP' DCA XCT DCA DMPSW /TURN ON TRACE TAD I PT1 CDF /RESET BY 'GETC' DCA I C200 /INSERT NAME GETC GETC /PRINT "XX(" GETC ISZ PT1 TAD I PT1 /GET THE SUBSCRIPT DCA T3 JMS I SDUMP /PRINT IT GETC /PRINT ")" TAD ATSW DCA DMPSW /RESET TRACE ISZ PT1 FENT FGET I PT1 /GET VALUE FEXT JMS I FOUTPUT /PRINT IT TAD CCR PRINTC CMA CLL RAL /'TAD M2' TAD GINC TAD PT1 JMP TDUMP+3 /NEXT ONE SDUMP, FGO6 /LIBRARY CALL AND FILE OPERATIONS: LGOSUB, PUSHJ /EXECUTE SUBROUTINE DO+3 CMA CLL RTL /LINE FEED = RETURN LIB, CIF /L COMMAND ENTRY JMP I 7 /LCMND = FPNT IN FIELD 0 ICHAR, 0 /FILE INPUT VIA (INDEV) CDI JMS I (ICHAR0 /CALL LOWER FIELD JMP I ICHAR OCHAR, 0 /FILE OUTPUT VIA (OUTDEV) CDI JMS I (OCHAR0 JMS I (XOUTL /ECHO RETURN JMP I OCHAR /NO ECHO RETURN EOF, 0 /TRYING TO READ FROM A FILE TAD (XI33 /AFTER THE END (SHAME ON YOU!) DCA INDEV /RESET POINTER TO TTY TAD CPRNT+1 /AND TURN ON THE ECHO DCA I (IECHO TAD (XOUTL /'EOF' IS ALSO USED BY 'RECOVR' DCA OUTDEV TAD P337 /RETURN A "_" TO CLEAR JMP I EOF /THE "^Z" PREVIOUSLY READ EJECT /CROSS-FIELD LINKS: CGET, 0 /'GETC' FOR DOWN BELOW GETC TAD CHAR CDI JMP I CGET CPRNT, 0 /FOR TAB AND LIST ROUTINES PRINTC CDI JMP I CPRNT PT1D, 0 /8K ROUTINES CDF TAD I PT1 CDF 10 JMP I PT1D THISD, 0 CDF TAD I THISLN CDF 10 JMP I THISD PAGE /THE ZERO COMMAND AND PROTECTED VARIABLES LIVE HERE: ZERO, TESTC /Z COMMAND: CHECK ARGUMENT JMP ZALL /T NO ARGUMENT = ALL VARIABLES GETC /N ILLEGAL (SLIGHT FUDGE) CLA /F IN CASE LINK=0 SORTJ /L NORMAL RETURN GLIST-1 /LOOK FOR SPACE, COMMA ZLIST-GLIST PUSHJ /NEITHER SPACE NOR COMMA, GETARG /SO MUST BE A NAME SZL PUSHJ /WRITE ZEROS SET20 JMP ZERO+3 /CHECK NEXT TERMINATOR ZALL, TAD END /PUT BEGINNING DCA LASTV /INTO END JMP ZERO+4 /AND RETURN ZLIST, ZERO+2 /SP ZERO+2 /, PROCESS /; PC1 /CR FNEW=. /USER FUNCTION AREA STVAR=. /SYMBOL TABLE BEGINS AFTER FUNCTIONS EXCLM=WORDS+2+. /USED FOR DOUBLE SUBSCRIPTING DUMMY=WORDS^3+6+. /USED FOR FOCAL STATEMENT FUNCTIONS *4400 UPDATE, CLA CMA /'ONCE-ONLY' CODE TAD END DCA I (GLOOP-2 /INITIALIZE VARIABLE SEARCH TAD END DCA LASTV TAD GLOOK /PI JMS GLOOK FENT FPUT I PT1 FEXT TAD (4100 /! JMS GLOOK TAD PT1 DCA I (DIMEN /DIMENSION CONSTANT TAD (4200 /" JMS GLOOK TAD (4300 /# JMS GLOOK TAD PT1 DCA I (ARG-1 /FIRST DUMMY VARIABLE TAD (4400 /$ JMS GLOOK TAD (4500 /% JMS GLOOK CMA CLL RAL TAD PT1 TAD GINC DCA END TAD END DCA LASTV /CLEAR THE SYMBOL TABLE TAD PACK2 /INITIALIZE THE DATE DCA AXIN DCA XCTIN TAD I (7666 /TODAY (IN CODE) SZA JMP .+3 TAD PACKIT /INSERT EARLY STOP JMP NODATE RTL6 RAR AND P17 JMS PACK2 TAD I (7666 RTR AND P77 CLL RAR JMS PACK2 TAD (7 /GOOD 'TILL 1980 ! JMS PACKIT TAD I (7666 AND (7 JMS PACKIT TAD ADD /GET HALF-WORD SZA /CHECK IF STORED JMS I DAXIN NODATE, CDI DCA I (NAMLOC TAD P177 DCA I (K177 /RESET POINTER AND JMP NONAME+2 /PUT DATE IN HEADER PACK2, NUDATE-1 DCA T1 DCA T2 TAD T1 SKP ISZ T2 TAD (-12 SMA JMP .-3 TAD (12 DCA T1 TAD T2 SZA JMS PACKIT TAD T1 JMS PACKIT CMA /"0"-1="/" JMS PACKIT JMP I PACK2 PACKIT, 7715 TAD C260 DCA CHAR PACKC JMP I PACKIT GLOOK, 2011 DCA EFOP PUSHJ GS1 JMP I GLOOK PAGE /EXTENDED PRECISION SIN & COS - REFERENCE DECUS FOCAL8-231 /ALGORITHM DUE TO DR. H.B. THOMPSON - UNIV. OF TOLEDO,OHIO *4675 FLARG /TEMPORARY FOR EXP XSQR *5034 EXIT2 /POINTERS FOR ATN FLARG PIOT *5065 TAD P13 /NEW LOCATION *5200 FCOS, NEGATE /COS(X)=SIN(PI/2-X) FENT FADD PIOT FEXT FSIN, GETSGN SNA /X=0 ? RETURN SMA CLA /X<0 ? JMP .+3 NEGATE /YES CMA DCA T3 /REMEMBER SIGN FENT FDIV TWOPI /CHANGE X TO REVOLUTIONS FEXT TESTQ, TAD FLAC /CHECK QUADRANT SPA JMP LTHALF /QUAD I & II SZA CLA JMP GTONE TAD T3 /QUAD III & IV CMA /REVERSE SIGN DCA T3 GTONE, TAD HORD /G.T. ONE REVOLUTION AND P1777 /REMOVE LEADING BIT & DCA HORD /NORMALIZE = SUBTRACT JMS I NORM /2^N REVOLUTIONS GETSGN SNA CLA /TEST FOR ZERO RESULT RETURN JMP TESTQ LTHALF, IAC SZA CLA /L.T. 1/4 ? JMP APPROX /YES: QUAD I NEGATE /NO: QUAD II FENT FADD I HALF /X->0.5-X FEXT APPROX, FENT /SIX TERM POLYNOMIAL FPUT I FLARGP /SAVE RESULT FMUL FLAC /SQUARE IT FPUT XSQR FMUL C11 FADD C9 FMUL XSQR FADD C7 FMUL XSQR FADD C5 FMUL XSQR FADD C3 FMUL XSQR FADD TWOPI FMUL I FLARGP /CONVERT TO ODD POWERS FEXT EXIT2, TAD T3 /CHECK SIGN JMP FABS+1 HALF, FLP5 P1777, 1777 PIOT, 1;3110;3755;2421 TWOPI, 3;3110;3755;2421 C11, 4;4313;0510 C9, 6;2500;3124 C7, 7;5464;5652;3636 C5, 7;2431;5360;3430 C3, 6;5325;0414;3220 XSQR, ZBLOCK 4 EJECT PCD, 0 /SYMBOL TABLE LIMIT CDF TAD I PC CDF 10 JMP I PCD VFN, 0 /GET VARIABLE FILE NAME PUSHJ EVAL-1 /EVALUATE THE EXPRESSION FIXIT /& TAKE THE INTEGER PART TAD HORD SZA CLA /LEAVE ZERO ALONE STL RAR DCA OVER2 /ROUND UP JMS I NORM CMA JMS I FOUTPUT /SET UP THE NUMERIC STRING CIF JMP I VFN /RETURN WITH STRING ADDRESS NORM, DNORM FINFIN, PUSHF /DEFAULT INCREMENT FP1, FLTONE JMP I .+1 FCONT /PERMANENT FUNCTIONS: FITR, FIXIT /SHORTEST FUNCTION RETURN /THAT THERE CAN BE FOUT, FIXIT /SINGLE CHARACTER OUTPUT SNA STL RAR /IN CASE IT'S ZERO PRINTC FSGN, GETSGN /REAL SIGNUM FUNCTION SNA CLA RETURN /ALSO USED BY FOUT FENT FGET I FP1 FEXT FABS, TAD I .+4 /CHECK ORIGINAL SIGN SPA CLA NEGATE RETURN FLARG+1 /THIS ROUTINE EXTENDS THE FORMAT SPECIFICATIONS (%W.DD) TO /INCLUDE NEGATIVE INTEGERS, I.E. %-N . N IS THE NUMBER /OF DIGITS TO BE OUTPUT IN FLOATING FORMAT. TYPE %, (=%0) /CONTINUES TO OUTPUT ALL SIGNIFICANT DIGITS IN THIS FORMAT /BUT ADDITIONALLY ONE CAN NOW SPECIFY ANY NUMBER (1-31) OF /DIGITS COMMEASUREATE WITH THE ACCURACY OF THE DATA. /OTHER CHANGES IMPLEMENTED HERE ARE THE FOLLOWING: FLOATING /FORMAT IS NOW IN STANDARD SCIENTIFIC NOTATION (ONE DIGIT /BEFORE THE DECIMAL POINT) AND THE ROUND-OFF CONSTANT HAS /BEEN CORRECTED (4 IS USED INSTEAD OF 5). THE SYMBOLS AND /COMMENTS ARE LARGELY THOSE FOUND ON PP 67-69 OF FOCAL-1969 DIGITS=12 /NUMBER OF DECIMAL DIGITS OUT *5400 TGO, 0 DCA FLTXR /SAVE BUFFER ADDRESS TAD FISW /GET FORMAT SAVED BY % TRAP STL RTR /SHIFT FIELD SIZE RTR /BACK INTO PLACE RTR /ARITHMETICALLY SNL /NEGATIVE FORMAT ? (OR >W.32) AND P77 /REMOVE STEP NO. IF POSITIVE RAR /FIELD SIZE IS ONLY 5 BITS SNA /ZERO IS SPECIAL TAD MD /MEANS SAME AS %-DIGITS DCA T1 /T1 IS NEGATIVE FOR FLOATING FORMAT TAD T1 CIA /INVERT SMA /- FIELD LENGTH FOR POS. FORMAT JMP R6-3 /E TYPE: CALCULATE ROUND-OFF DCA FLAC /F TYPE: SAVE -FIELD LENGTH TAD FISW /GET NUMBER OF DECIMAL PLACES AND P77 /LINE PART OF "LINENO" DCA DECP /OBVIOUSLY .DD IS LESS THAN .63 TAD FLAC TAD DECP SPA / F-D > 0 ? JMP .+5 /YES CLA CMA /NO TAD T1 DCA DECP /MAKE D = F-1 CMA TAD T3 /COMPARE DECIMAL EXPONENT SMA / F-D > E ? CLA /NO: ROUND OFF TO F PLACES TAD T1 /YES SPA / D+E < 0 ? JMP K4-1 /YES: NO ROUNDING NEEDED, PRINT! TAD MD /NO: ROUND TO D+E PLACES SMA /WITH A MAXIMUM OF D PLACES CLA R6, TAD P13 / *ROUND UP* 'TAD P7' - 3 WORDS DCA T2 /SAVE NUMBER+1 OF PLACES TO RND TO. TAD FLTXR /START OF BUFFER-1 TAD T2 /SET UP BUFFER ADDRESS AT WHICH DCA PLCE /ROUNDING OFF SHOULD START TAD T2 CIA /SETUP COUNT OF MAXIMUM NO. DCA T2 /OF CARRIES ALLOWABLE TAD K4 /LITTLE EXTRA ON FIRST DIGIT RET, ISZ I PLCE /ADD 1 TO DIGIT AT CURRENT POSITION TAD I PLCE TAD M12 /MINUS TEN SPA CLA /CARRY REQUIRED? JMP K4+1 /NO: GO TO OUTPUT DCA I PLCE /YES: MAKE CURRENT DIGIT ZERO ISZ T2 /BEGINNING OF BUFFER REACHED? JMP DECR /NO: DECREMENT BUF. ADR. AND REPEAT ISZ I PLCE /YES: SET MANTISSA TO 0.1 ISZ T3 /COMPENSATE BY INC. EXPONENT K4, 4 /'NOP' CLA CMA /SET SIGN COUNTER DCA T2 TAD FLAC / *PRINT* SNA /FLOATING OUTPUT ? JMP FLOUT /YES TAD T3 /COMPARE EXPONENT WITH FIELD SIZE SMA SZA / E > F ? JMP FLOUT+2 /YES: USE FLOATING FORMAT TAD DECP SMA / E < F-D ? CLA /NO: TAKE P = E CIA /YES: TAKE P = F-D TAD T3 CIA DCA T1 /SET UP MINUS P BACK, TAD T3 /PRINT DD.DDD TAD T1 SNA CLA / P = E ? JMP DIG /YES: PRINT DIGIT IAC /NO ('376' TO SUPPRESS 1ST ZERO) TAD T1 SPA CLA / P < 1 ? TAD M20 /YES: PRINT SPACE (240-260), NOT 0 IN, JMS OUTA /PRINT CHARACTER ISZ T1 /P CHARACTERS PRINTED? JMP BACK /NO CMA CLL RAL /YES ('TAD 376') JMS I OPUT /PRINT DECIMAL POINT JMP BACK DECR, CMA /BACKUP TO TOP OF BUFFER TAD PLCE DCA PLCE JMP RET FLOUT, TAD T1 /SET FIELD SIZE DCA FLAC CLA CMA /SET FLAG DCA PLCE ISZ TGO /SET SECOND RETURN DIG, CMA TAD T3 /REDUCE E BY 1 DCA T3 JMS GETD /GET NEXT DIGIT ISZ PLCE /TEST FLAG JMP IN /NORMAL RETURN JMS I OPUT /PRINT FIRST FLOATING DIGIT CMA CLL RAL /CREATE A PERIOD (256-260) SKP /DON'T FETCH & DON'T COUNT JMS GETD /FETCH NEXT DIGIT JMS OUTA /PRINT IT JMP .-2 /AND REPEAT DECP=. GETD, 0 /ROUTINE TO UNLOAD BUFFER TAD I FLTXR /AUTO-INDEX REG. SET UP UPON ENTRY ISZ FLOP /TEST FOR END OF SIGNIFICANT FIG. JMP I GETD CLA CMA /FORCE -1 IN ORDER TO DCA FLOP /OUTPUT EXTRA ZEROS JMP I GETD /LEAVE C(AC) = 0 PLCE=. OUTA, 0 JMS I OPUT /PRINT CHARACTER ISZ FLAC /F CHARACTERS PRINTED? JMP I OUTA /NO: RETURN JMP I TGO /YES: NUMBER FINISHED MD, -DIGITS OPUT, OUTDG ABSOLV=. /PATCHES TO REMOVE 'M2' AND 'MINUSA' FROM PAGE ZERO *5613 TAD M2 *5622 TAD M240 /ALREADY ON PAGE ZERO *5650 TAD MAT /SUBSTITUTE -"@ FOR -"A SPA SNA CLA *5665 M2, -2 INPUT /INPUT POINTER *5755 CLA STL TAD AC1H MAT, SMA /=-300 CLL *5774 ZBLOCK 4 /FOR CROSS-FIELD CALLS TO 'MULT10' /FLOATING OUTPUT CONVERSION ROUTINES: /REWRITTEN TO PROVIDE THREE NEW FEATURES: (1) A 'FLOATING' /MINUS SIGN WHICH APPEARS BEFORE THE FIRST DIGIT; (2) AN /EXTENDED RANGE FOR THE SYMBOL TABLE DUMP SUBSCRIPT OUT- /PUT (+/-999); (3) A PROVISION FOR NON-PRINTING CALLS WHICH /JUST SET UP THE OUTPUT BUFFER. *6000 FLOUTP, 0 DCA T2 /SET NON-PRINT FLAG GETSGN /SAVE SIGN/ZERO INFO DCA FGO6 JMS I .+2 /NOW TAKE ABSOLUTE VALUE JMP FGO3 /INITIALIZE DECIMAL EXPONENT ABSOLV FGO1, FENT /NUMBER TOO SMALL FMUL I TENPT /MULTIPLY BY 10. FEXT CMA /REDUCE EXPONENT JMP .+5 FGO2, FENT /NUMBER TOO LARGE FMUL I PTTEN /MULTIPLY BY 0.1 FEXT IAC /INCREASE EXPONENT TAD T3 FGO3, DCA T3 /SAVE DECIMAL EXPONENT TAD FLAC /CHECK BINARY EXPONENT SPA JMP FGO1 /TOO SMALL TAD M5 SMA CLA /IS EXP 0 TO 4 ? JMP FGO2 /TOO LARGE FGO4, DCA I REMPT /CLEAR REMAINDER TAD SADR /INITIALIZE BUFFER POINTER DCA FLTXR TAD FLAC /COMPUTE FIRST DIGIT CMA DCA I DIGPT TAD DCOUNT DCA FLAC JMS I DOUBLE /ROTATE OUT THE 1ST 4 BITS ISZ I DIGPT /AND CLEAR DIGIT JMP .-2 TAD I REMPT /TEST FOR 0,1-9,10-15 SNA JMP FGO5 /IGNORE FIRST ZERO TAD M12 SPA CLA JMP SPACE+2 /1-9 IAC DCA I FLTXR /OUTPUT A "1" ISZ FLAC /COUNT THE DIGIT ISZ T3 /BUMP DECIMAL EXPONENT SPACE, 240 TAD M12 /CORRECT THE REMAINDER TAD I REMPT /COMPUTE RESULTANT OR SECOND DIGIT ISZ T3 JMP .+3 SKP FGO5, JMS I M10PT /IE. 0.672 X 10 = 6 + 0.72.. ETC. DCA I FLTXR ISZ FLAC /ALL DIGITS OUTPUT ?? JMP .-3 /NO: CONTINUE TAD DCOUNT DCA FLOP /SAVE NO. OF DIGITS TAD SADR /GET BUFFER POINTER ISZ T2 /TEST PRINT FLAG JMS I ROUND /OUTPUT MANTISSA JMP I FLOUTP /FIXED POINT DONE TAD CHRT /PRINT "E" PRINTC JMS FGO6 /OUTPUT THE EXPONENT JMP I FLOUTP /FLOATING POINT DONE FGO6, 0 /ALSO CALLED BY TDUMP TAD T3 /GET EXPONENT SPA CLA /TEST SIGN STL RTL /+2 -> -3 TAD M5 JMS OUTDG /PRINT SIGN DCA T2 /INITIALIZE HUNDREDS TAD T3 /NOW TAKE ABSOLUTE VALUE SPA CIA SKP /SUBSTITUTE EAE DIVIDE ISZ T2 TAD M144 /SUBTRACT ONE HUNDRED SMA /TEST FOR OVERDRAW JMP .-3 TAD C144 /RESTORE DCA T3 /SAVE TENS AND UNITS TAD T2 /PRINT HUNDREDS SZA /UNLESS ZERO JMS OUTDG TAD T3 /PRINT TWO DIGITS JMS I .+2 JMP I FGO6 PRNT C144, +144 M144, -144 "= OUTDG, 0 /MULTI-PURPOSE ROUTINE SMA /IGNORE SPACES AND THE LIKE OR ISZ T2 /DIGITS OTHER THAN THE FIRST ! JMP DGOUT DCA T2 /SAVE THE FIRST DIGIT TAD SPACE /OR 'TAD OUTDG-1' FOR AN "=" SIGN PRINTC /OR 'CLA' TO REMOVE EITHER TAD FGO6 /GET SIGN INFO SNA DCA T3 /CORRECT EXPONENT OF ZERO SPA CLA TAD C15 /"-" TAD SPACE /FOR POSITIVE NOS. ('SZA') PRINTC TAD T2 /RESTORE AC DGOUT, TAD C260 /FORM ASCII PRINTC JMP I OUTDG C15, 15 /255 CHRT, "E ROUND, TGO TENPT, TEN PTTEN, PTEN M10PT, MULT10 REMPT, REMAIN DIGPT, REMAIN+1 SADR, BUFFER-1 DCOUNT, -DIGITS-1 FLEN, CDI /COMPUTE REMAINING FILE LENGTH JMP I .+1 XLEN XRTD, 0 CDF TAD I XRT CDF 10 JMP I XRTD *6254 FMUL PTEN *6275 RNDM, 4421 /INCREMENTED AT RANDOM 3040 0001 0000 *6306 INPUT *6311 PTEN, -3 /INPUT-OUTPUT CONSTANT MOVED 3146 3146 /AND CORRECTED 3150 /DOUBLE SUBSCRIPTING FEATURE PERMITS VARIABLES OF THE FORM: /X(I,J). ALGORITHM COMPUTES SINGLE SUBSCRIPT BASED ON THE /MAXIMUM NUMBER OF ROWS OF A TWO-DIMENSION ARRAY, E.G. THE /MAXIMUM VALUE OF I. THIS VALUE MUST BE STORED IN THE /FIRST "SECRET VARIABLE" (!). THE FORMULA IS J*!-!+I. IT /WILL WORK NO MATTER WHAT THE VALUE OF ! IS, BUT THE SUB- /SCRIPTS ARE ONLY UNIQUE IF !=MAX(I). /WHILE THE NUMBER OF COLUMNS DOES NOT AFFECT THE INDEXING /IT IS SUGGESTED FOR CONSISTENCY THAT THIS DIMENSION BE /STORED IN THE SECOND "SECRET VARIABLE" (") SO THAT ALL /MATRIX ROUTINES CAN USE THESE VARIABLES FOR LOOP INDICES /THEREBY PERMITTING COMPLETELY GENERAL PROGRAMMING. TEST42, 0 /DOUBLE SUBSCRIPTING ROUTINE TAD CHAR /CHECK FOR SECOND SUBSCRIPT TAD MCOM SZA CLA JMP ONLY1 PUSHF /RECURSIVE CALLS LIKELY FLAC /SO SAVE FIRST SUBSCRIPT PUSHJ /EVALUATE THE SECOND (CAN EVEN EVAL-1 /HANDLE SUBSCRIPTED SUBSCRIPTS!) POPF /TEMPORARY STORAGE FLARG /FOR THE FIRST ONE FENT FMUL I DIMEN /DIMENSION (!) TIMES FSUB I DIMEN / (SECOND MINUS ONE) FADD I FLARGP /PLUS OFFSET OF FIRST FEXT ONLY1, POPA /GET VARIABLE NAME FROM PDL DCA EFOP /AND RESTORE FOR SEARCH JMS I .+3 /CHECK FOR PROPER RIGHT PAREN. FIXIT /FIX FLAC TO GET SUBSCRIPT JMP I TEST42 PARTEST DIMEN, EXCLM+2 /DATA POINTER FOR (!) /IMPROVED RANDOM NUMBER FUNCTION (OMSI) USES TTY WAIT /LOOP TO INITIALLY SET A RANDOM VALUE. AFTER THE FIRST /INPUT SUCCESSIVE NUMBERS ARE GENERATED FROM THE POWER /RESIDUE ALGORITHM DUE TO P.T. BRADY (DECUS 5-25). SEE /ALSO THE DISCUSSION BY G.A. GRIFFITH IN DECUS FOCAL8-1. DUBLAD /X(1)=(2^17+3)*X(0) MOD 2^35 FRAN, FENT FNOR RNDM-1 /LOAD FLOP FGET RNDM /SHIFT LEFT TWELVE FEXT TAD M4 DCA FLAC JMS I DOUBLE /SHIFT LEFT FOUR MORE & ISZ FLAC /LEAVE ZERO IN EXPONENT JMP .-2 JMS I FRAN-1 JMS I DOUBLE /ADD IN 3 TIMES ORIGINAL JMS I FRAN-1 FENT FPUT RNDM-1 /SAVE FOR NEXT CALL FEXT CMA CLL RAR /=3777 AND HORD DCA HORD /BE POSITIVE IT'S POSITIVE RETURN /THE TAB COMMAND FOR 'ASK/TYPE' STATEMENTS HAS BEEN EX- /TENDED TO PERMIT 'SKIPPING' CHARACTERS DURING INPUT. A /NEGATIVE COLUMN NUMBER SPECIFIES THE NUMBER OF CHARACTERS /TO IGNORE; IF THE INPUT ECHO IS ON THESE CHARACTERS WILL /BE SENT TO THE OUTPUT. THIS FEATURE PERMITS IGNORING /UNWANTED PARTS OF A FILE (LABELS, ETC.) DURING INPUT. XTAB, PUSHJ /EVALUTE COLUMN NO. EVAL-1 FIXIT /AND SET RESULT IN AC CIF JMP TAB /SAME PAGE, FIELD 0 SKIP1, READC /SKIP ONE CHARACTER CIF JMP POS /RETURN TO LOWER FIELD /MISCELLANEOUS CHANGES TO FLOATING POINT PACKAGE /MOST ARE STANDARD 4 WORD CHANGES BUT SOME ARE SUGGESTIONS /BY JIM CRAPUCHETTES (DECUS FOCAL8-269) TO SPEED THINGS UP. *6402 SKP /'DCA OVER1' FOR 3-WORD VERSION DCA OVER2 JUMP=SIGNF *6407 DCA JUMP /SAVE FP INSTRUCTION TAD JUMP RTL /MOVE "I" BIT TO LINK RTL / AND "Z" BIT TO AC0 SPA CLA /PAGE 0 ? TAD FPNT /NO, GET PAGE # AND P7600 DCA T1 /AND SAVE IT ('MQL') TAD JUMP /NOW GET RELATIVE LOCATION AND P177 TAD T1 /MERGE PAGE ADDRESS ('MQA') DCA T1 SNL /WAS IT INDIRECT ? JMP .+3 /NO TAD I T1 /YES DCA T1 ISZ FPNT /BUMP TO NEXT INSTRUCTION CMA TAD T1 DCA FLTXR2 /SET UP TRANSFER TAD JUMP /GET OP CODE CLL RTL RTL AND P17 SNA JMP FLGT /0 = "FGET" TAD OPTABL /POINT TO OPERATION DCA JUMP TAD I JUMP SNA JMP FLPT /0 = "FPUT" DCA JUMP TAD I FLTXR2 /MOVE OPERAND INTO FLOP DCA FLOP TAD I FLTXR2 DCA AC1H TAD I FLTXR2 DCA AC1L TAD I FLTXR2 /'JMP I JUMP' FOR 3 WORDS DCA OVER1 JMP I JUMP FLPT, TAD .+2 JMP XFER FLAC-1 FLGT, TAD .-1 DCA FLTXR2 CMA TAD T1 XFER, DCA FLTXR /AVOID LOOP OVERHEAD TAD I FLTXR DCA I FLTXR2 TAD I FLTXR DCA I FLTXR2 TAD I FLTXR DCA I FLTXR2 TAD I FLTXR /'JMP FPNT+1' FOR 3 WORDS DCA I FLTXR2 JMP FPNT+1 FIND, FIXIT /CHARACTER SEARCH FUNCTION CIA DCA FPNT JMP FINDER *6515 FINDER, JMS I INDEV /READ A CHARACTER INTO AC TAD FPNT SNA /FOUND IT ? RETURN /DON'T ECHO SEARCH CHAR. TAD LORD /NO: RESTORE CODE JMS I ECHO /& ECHO AS DIRECTED JMP FINDER COMMA, ", /'SORTA USEFUL' FLEX=. /"^" ENTRY POINT CHANGED *6537 DCA T1 NOP /PATCH FOR 3-WORD VERSION *6545 FLTONE /MOVED DOWN ONE *6550 JMP .+5 /IMPROVED "^" LOOP JMS I OPTABL+4 TAD M4 /PSEUDO PUSHF - SAME DATA TAD PDLXR DCA PDLXR POPF /RECALL ARGUMENT FLOP ISZ T1 JMP .-7 JMP FPNT+1 OPTABL, .+11 PAGE FLEX *TEST2 43 *7003 214 /^L IS IGNORED IN AN 'ASK' COMMAND *DMULT4 DCA DATUM-5 *7072 NOP /CHANGES TO THE SIGN-CHECKING ROUTINES FOR MULTIPLY/DIVIDE /IN ORDER TO SHORTEN THEM SOMEWHAT TO MAKE ROOM FOR "ZERO". *7102 JMS RESOLV /EXIT FROM 'FMUL' AND 'FDIV' JMS I .+2 /SET SIGN AND NORMALIZE JMP I .-3 DNORM *7127 STL RAR /SET 4000 *7132 DCA SIGNF /SIGN OF PRODUCT/QUOTIENT GETSGN SNA /TEST FOR ZERO RESULT JMP ZER0 SPA CLA /TAKE ABSOLUTE VALUE NEGATE TAD AC1H SZA /REVERSE THIS SKIP JMP I SIGN ZER0, DCA FLAC /QUICK EXIT IF RESULT IS ZERO DCA HORD DCA LORD DCA OVER2 JMP I SIGN-1 /FPNT+1 EJECT /CORRECTIONS TO THE DIVIDE ROUTINE FOR 3 WORD MANTISSAS *MIF -43 /SHIFT COUNT FOR DIVIDE *7271 /CORRECT THE DIVIDE ROUTINE TAD OVER1 TAD OVER2 DCA TEST4 RAL TAD AC1L /COMBINE ONE POSITION TAD LORD DCA MP2 /SAVE RESULT RAL TAD HORD /ADD OVERFLOW TAD AC1H SNL /SKIP IF OVERFLOW JMP .+6 DCA HORD /UPDATE FLAC TAD TEST4 DCA OVER2 TAD MP2 DCA LORD CLA /IF NO OVERFLOW TAD MP1 /SAVE OVERFLOW BITS CIRCULARLY RAL DCA MP1 TAD MP4 RAL DCA MP4 TAD DNORM /FOCAL STATEMENT FUNCTIONS: F(N,ARG1,ARG2,...) /N IS A LINE OR GROUP NO. (CONVENIENTLY USE A VARIABLE /NAME WHICH IDENTIFIES THE FUNCTION!) AND THE ARG'S RE- /PLACE THE VALUE OF THE FIRST ENTRIES IN THE SYMBOL TABLE /BEGINNING WITH THE PROTECTED VARIABLE (#). THUS THE FIRST /THREE REPLACEABLE VARIABLES ARE #,$,%. NOTE THAT ! AND " /ARE USED FOR SUBSCRIPTING. FUNCTIONS REQUIRING MORE THAN /THREE ARGUMENTS WILL NEED TO DEFINE ADDITIONAL SYMBOLS AT /THE BEGINNING OF THE TABLE. AS AN EXAMPLE: Z;Z D1 D2 D3 /SETS UP THREE ADDITIONAL "DUMMY" VARIABLES. OF COURSE /THEY ARE PERFECTLY GOOD REGULAR VARIABLES TOO. *7502 TESTF, 0 /CHECK FOR FSF FUNCTION POPA /GET FUNCTION NAME SZA /CHECK FOR 0 = "F" JMP I TESTF /NORMAL FUNCTION FSF, PUSHJ /EVALUATE LINE NUMBER XGETLN+5 /(ARG. IS ALREADY IN FLAC) TAD ONFLAG /SAVE CURRENT POINTER PUSHA /FOR RECURSIVE CALLS PUSHF /SAVE RESULTS LINENO /AND NAGSW TAD .+2 /FIRST DUMMY VARIABLE JMP ARG+7 DUMMY+2 ARG, PUSHJ /EVALUATE REAL ARGUMENTS EVAL-1 FENT FPUT I ONFLAG /SAVE UNDER DUMMY NAME FEXT TAD ONFLAG TAD GINC /ADVANCE TO NEXT ONE DCA ONFLAG TAD CHAR TAD MCOM SNA CLA /ADDITIONAL ARGUMENTS ? JMP ARG DOF, POPF /RESTORE LINENO & NAGSW LINENO TAD SORTCN /SAVE SORTCN PUSHA PUSHJ /EXECUTE A DO BRANCH DO+3 POPA DCA SORTCN POPA /RESTORE POINTER DCA ONFLAG JMP I .+1 /LEAVE FLARG ALONE EFUN3+4 IFF, IF+1 *SPA SNA LGETLN, 0 /FOR LIBRARY COMMANDS GETLN CIF JMP I LGETLN /ON COMMAND: ON (EXPRESSION)-,0,+;CONTINUATION /THIS COMMAND WORKS JUST LIKE THE 'IF' COMMAND EXCEPT THAT /AFTER EXECUTING THE BRANCH THE PROGRAM RETURNS TO THE NEXT /COMMAND (WHICH MAY BE ON THE SAME LINE). ALSO, IT IS NOW /POSSIBLE TO INDICATE THE REST OF THE LINE AS THE SELECTED /BRANCH BY OMITTING THE LINE NUMBER. THUS: "IF (-1),X,Y;Z" /WILL ZERO THE VARIABLES AND "ON (X-Y)X,,Y" WILL CONTINUE /THE PROGRAM IF X=Y, OTHERWISE IT WILL FIRST CALL X OR Y /(WHICHEVER IS SMALLEST) AND THEN CONTINUE THE PROGRAM. OCMND ON, TESTC /O COMMAND CMA /T ON " DCA ONFLAG /N SET FLAG JMP I IFF /F CONTINUE CIF /L "O"THER JMP I ON-1 /"IF" PATCH TO CHECK FOR MISSING LINENO (=CONT. SAME LINE) /ALSO DECIDES BETWEEN "IF" (=GOTO) AND "ON" (=DO) BRANCHES. *-215 /VIA MCR ! ONTEST, 0 GETLN SZL /CHECK FOR BLANK JMP I ONTEST ISZ ONFLAG /TEST FLAG JMP I IFTEST /IF SORTC /ON COMMA-1 DCA CHAR /PREVENT MULTIPLE CALLS PUSHJ DO+3 JMP I ONTEST /CONTINUE IFTEST, GOTO+1 /FOCAL OS/8 LIBRARY ROUTINES FIELD 0 TPUSHF= JMS I [MPD2 /DEFINE SOME NEW INSTRUCTIONS TPOPF= JMS I [MPD3 TGETC= JMS I [MGETC TSPNOR= JMS I [MSPNOR TJUMP= JMS I [JUMPER GETHND= JMS I [HANDLR GTNAME= JMS I [NAME GETMON= JMS I [USRIN DISMIS= JMS I [USROUT WAITUP= JMS I [IOWAIT COMPAR= JMS I [CMPR OPENUP= JMS I [OPEN *1 /INTERRUPT SERVICE ROUTINE CIF 10 JMP I .+1 INTRPT RMF /RETURN FROM INTERRUPT ION JMP I 0 USR, 7700 //POINTER TO MONITOR (200 IF IN CORE) AUTO, ZBLOCK 4 /AUTO-INDEX REGISTERS NUDATE, ZBLOCK 4 /BECOMES THE CURRENT DATE NONAME, TPOPF /CLEAR PROGRAM NAME XNAME, NAMLOC IAC DCA GOSW /SET RETURN JMS HEADER /UPDATE HEADER - THEN CLEAR DCA LIBFIL /'CURRENT PROGRAM SAVED' FLAG TAD GOSW /RETURN FOR LOAD CALLS EXIT, TAD GOJUMP /NORMAL RETURNS='JMP I (PROC' DCA ATEM CDI 10 ION ATEM=. HEADER, 0 TPUSHF XCHAR, NAMLOC /STRATEGICALLY LOCATED ! TPOPF /MOVE PROGRAM NAME TITL DCA I D /CLEAR I.D. TPUSHF NUDATE TPOPF /MOVE CURRENT DATE DIALOG, DATE JMP I HEADER D, DATE-1 GOJUMP, JMP I .+2 /PLUS (GOSW) LGOSUB PROC K177, UPDATE /BECOMES 'START' K604, GOTO+1 NEWDEV, ZBLOCK 4 FLNGTH= .-2 STBLK= .-1 /LIBBLK-1 = INBUF LIBBLK, ZBLOCK 2 /FOR DEVICE NAME K7400, 7400 /LOAD POINT 0 /FOR DEVICE # LIBHND, 0 /HANDLER ENTRY CHR, 0 /LOWER FIELD COPY *CHAR /SAVE A WORD OR TWO! NAMLOC, ZBLOCK 4 EXTENSION=.-1 DEVNO, 0 DEVHLD, 0 LIBDEV, ZBLOCK 4 LIBLEN= .-2 LIBFIL= .-1 /REFERENCE VIA P77 *100 PC0, ZBLOCK 2 /FOR COMMAND MODE VIA C100 DISMISS /CONVENIENT FOR RESTARTING IAC JMP EXIT ERROR1= JMS . GOSW, 0 /LOWER FIELD ERROR ROUTINE DISMISS /CLEARS AC TAD GOSW CDI 10 DCA I [ERR2 JMP I .+1 /SIMULATE A 'JMS' ERR2+1 INBLK, ZBLOCK 2 5000 0 INHND, 0 INFLG, 0 OUTBLK, ZBLOCK 2 5200 0 OUTHND, 0 OUTFLG, 0 /LIBRARY AND FILE COMMAND PROCESSOR: /****** STORAGE ALLOCATION MAP ****** /***** ***** /* 3600 (OUTPUT,RESTORE,CLOSE,ABORT) /* 4000 INPUT BUFFER (PAGE 1) /* 4200 INPUT BUFFER (PAGE 2) /* 4400 OUTPUT BUFFER (PAGE 1) /* 4600 OUTPUT BUFFER (PAGE 2) /* 5000 INPUT HANDLER /* 5200 OUTPUT HANDLER /* 5400 FILES (INPUT,OPEN,AND LIST) /* /* 5600 PUSHDOWN LIST CONTROLS /* 6000 NAME, GTMON, DISMISS, IOWAIT /* 6200 HANDLR, PUTDEV, & TABULATE /* 6400 DECODER, NAMER, DATER, SAVER /* 6600 RUN,CALL,GOSUB,BRANCH,RETURN /* 7000 LIBRARIAN /* 7200 MISCELLANEOUS /* 7400 LIBRARY HANDLER /***** ***** /************************************ /TEXT STORAGE AND THE PUSH-DOWN LIST USE THE /REMAINING SPACE. IF THE FILE COMMANDS ARE /DELETED STORAGE EXTENDS TO 5600; OTHERWISE /IT ENDS AT APPROXIMATELY 3600. /INITIAL TEXT FOR U/W-FOCAL *200 0 /PROGRAM LENGTH 5051 /"()" FOR TDUMP LINE0, 0 /POINTER TO NEXT 0 /LINE NO. ZERO TEXT "C U/W-FOCAL:" TITL, ZBLOCK 4 /NULLS NOW PRINT AS SPACES DATE, ZBLOCK 4 /LINK TO INITIAL DIALOG 7715 /DUMMY CR LINE1=. /OS/8 FOCAL FILE ROUTINES *3622 RESTOR, TSPNOR /'OPEN RESTORE' COMMAND TAD CHR /SAVE COMMAND CHAR DCA NOCHAR CMA /INITIALIZE ECHO SWITCH DCA GOSW GTNAME /TO SET ECHO MODE TAD NOCHAR TJUMP /SORT OUT "I" OR "O" ORLIST-1 ORGO-ORLIST ERROR1 /NEITHER ONE! CLOSE, JMS CLOSER /'OUTPUT CLOSE' COMMAND JMP EXIT CLOSER, 0 /CLOSE THE OPEN OUTPUT FILE TAD OUTFLG SNA CLA /DON'T BOTHER IF IT ISN'T OPEN JMP I CLOSER STL CMA K377, AND (232 /WRITE '^Z' JMS NOCHAR SZL /PAD BUFFER WITH ZEROS JMP .-2 / (AND WRITE IT OUT) KILLIT, IOF TAD DEVHLD /SAVED DEVICE # CIF 10 JMS I USR 4 ONMTMP /POINTER TO SAVED NAME BLKCNT, 0 /FILE LENGTH (BLOCKS) ERROR1 /HUH? TAD (XOUTL /RESTORE TELETYPE OUTPUT ROUTINE CDF 10 DCA I [OUTDEV CDF TAD OUTFLG SNA CLA JMP FILERR /FILE WAS TOO LONG DCA OUTFLG /CLEAR 'FILE OPEN' FLAG TAD BLKCNT /CHECK FOR ALTERNATE EXIT SZA CLA JMP I CLOSER /CALLED BY 'CLOSE' 'OCHK' 'OCLCHK' ABORT, TAD OUTFLG /'OUTPUT ABORT' COMMAND SNA CLA JMP EXIT /EXIT BEFORE OR AFTER ! DCA BLKCNT JMP KILLIT NOCHAR, 0 /PS/8 3/2 BUFFERED CHARACTER OUTPUT AND K377 /MASK OUT GARBAGE ISZ O3 /WHICH CHAR OF THREE? JMP O2 /STRAIGHT PACKING JMS O3 /HALF WORD PACKING - PACK 1ST HALF TAD OSETUP /GET SAVED ARG JMS O3 /PACK SECOND HALF CMA CLL RTL /RESET 3-WAY SWITCH DCA O3 /BUFFER CAN ONLY BE FILLED WITH ISZ OUTFLG /THE 3RD CHARACTER OF 3 JMP I NOCHAR /NOT FULL YET TAD OLNGTH /-MAXIMUM ALLOWABLE LENGTH TAD BLKCNT /LENGTH SO FAR SNL CLA /HAS HE GONE TOO FAR? JMP ABORT+3 /YES, KILL HIM JMS I (PUTDEV /TELL MONITOR THE HANDLER'S IN CORE OUTHND-2 //POINTER TO DEVICE # AND ENTRY IOF JMS I OUTHND /WRITE ONE BLOCK BUFFER 4200 4400 OBLK, 0 JMP I [DERR /DEVICE ERROR ISZ OBLK /BUMP OUTPUT BLOCK ISZ BLKCNT /AND COUNT OF BLOCKS SO FAR JMS OSETUP /RESET POINTERS FOR NEXT BUFFER CLL /INFORM CLOSER THAT JMP I NOCHAR /THE END IS AT HAND O2, DCA I OPTR1 /NORMAL PACKING IS EASY! ISZ OPTR1 /BUMP POINTER JMP I NOCHAR O3, 0 /HALF-WORD PACK ROUTINE CLL RTL RTL DCA OSETUP /SAVE FOR SECOND HALF TAD OSETUP AND K7400 TAD I OPTR2 /ADD IN CHARACTER IN RIGHT HALF DCA I OPTR2 /PACK IT ISZ OPTR2 /BUMP POINTER AGAIN JMP I O3 OPTR1, 0 /PACKING POINTERS OPTR2, 0 ONMTMP, ZBLOCK 4 /SAVED FILE NAME FILERR, ERROR1 /FILE TOO LONG OLNGTH, 0 /MAX. FILE LENGTH ORGO, IRST ORST OSETUP, 0 /RESET ALL THE POINTERS (WHAT FUN!) TAD OBLK-1 DCA OPTR1 TAD OBLK-1 DCA OPTR2 TAD [-200 /X3 = 384 CHARACTERS/BUFFER DCA OUTFLG CMA CLL RTL DCA O3 JMP I OSETUP PAGE 26 IMPUT=( WAITUP /JUST PLAIN SNEAKY! OCLCHK OUTPUT, WAITUP /WAIT FOR TELETYPE TO FINISH CMA OPENUP /CALL USR, HANDLER; ENTER FILE YINT, OUTBLK-1 /OUTPUT HANDLER BLOCK 3 /MONITOR 'ENTER' CODE JMP TTYOUT /'OPEN OUTPUT TTY:' JMP I .-7 /ENTER ERROR: SEE IF FILE ALREADLY DISMISS /OPEN. IF NO ERROR: KICK USR OUT TPUSHF /SAVE NAME AND OTHER CRAP NAMLOC TPOPF ONMTMP TAD STBLK /STARTING BLOCK DCA I (OBLK TAD FLNGTH /-MAXIMUM ALLOWABLE LENGTH DCA I (OLNGTH JMS I (OSETUP /SET UP PACKING POINTERS DCA I (BLKCNT TAD DEVNO /SAVE FOR CLOSE DCA DEVHLD ORST, TAD OUTFLG /'OPEN RESTORE OUTPUT' COMMAND SNA CLA /FLAG IS CHARACTER COUNT ERROR1 /NO OUTPUT FILE TO RESTORE TAD TTYOUT-1 /POINTER TO FILE OUTPUT ROUTINE CDF 10 DCA I [OUTDEV ISZ GOSW /SKIP IF NO ECHO TAD OCHAR0+2 /'TAD ICHAR0' DCA OECHO /SET OUTPUT ROUTINE JMP EXIT /FINISH THE LINE OCHAR TTYOUT, TAD .+2 /SWITCH OUTPUT TO THE TELETYPE JMP ORST+4 XOUTL OCHAR0, 0 /FILE OUTPUT VIA 'PRINTC' DCA ICHAR0 /SAVE CHARACTER FOR ECHO TAD ICHAR0 JMS I (NOCHAR /WRITE IT ION OECHO, TAD ICHAR0 /=0000 IF NO ECHO SNA ISZ OCHAR0 /SET NO ECHO RETURN CDI 10 JMP I OCHAR0 OCMND, TAD K604 /'O' COMMAND ENTRY FROM FIELD 1 DCA EXTENSION /SET '.FD' TAD I XCHAR TJUMP /GO DO COMMAND FILIST-1 FILEGO-FILIST ERROR1 /OOPS - BAD 'O' COMMAND ICHAR0, 0 /FILE INPUT VIA 'READC' ISZ INFLG /DO WE NEED ANOTHER BUFFER? JMP I RDPTR /NO, UNPACK THE CHARACTER IOF JMS I INHND /YES, GO GET IT 0200 4000 IBLK, 0 SMA CLA /ONLY BOTHER WITH FATAL ERRORS SKP CLA JMP I [DERR /WE'VE GOT ONE TAD [-600 /=384 CHARACTERS/BUFFER DCA INFLG ISZ IBLK /BUMP TO NEXT BLOCK TAD IBLK-1 /AND RESTORE POINTERS DCA IPNTR ION ICHAR1, TAD I IPNTR /STRAIGHTFORWARD UNPACK ROUTINE JMS RDPTR /DO COMMON CRAP ICHAR2, TAD I IPNTR /SAVE LEFT HALF FOR LATER AND K7400 DCA ITEMP ISZ IPNTR /INCREMENT TO NEXT WORD TAD I IPNTR /ANOTHER EASY ONE JMS RDPTR ICHAR3, TAD I IPNTR /THIS IS THE TRICKY ONE! ISZ IPNTR /GET LOW-ORDER HALF AND K7400 CLL RTR /SHIFT RIGHT RTR TAD ITEMP /GET HIGH-ORDER HALF (REMEMBER?) RTR /SHIFT SOME MORE RTR JMS RDPTR /GOT IT! JMP ICHAR1 /1-2-3-1-2-3-1-2-3 ... RDPTR, 0 /THIS IS A COROUTINE ! AND K177 /ISN'T THAT AMAZING ? SNA /IGNORE NULLS AND PARITY JMP ICHAR0+1 TAD (-32 /END OF FILE? (^Z) SZA JMP .+5 /NO DCA INFLG /YES, CLEAR OPEN FILE FLAG CDF 10 /AND SET UP CLEVER KLUDGE TAD (EOF /TO CHECK FOR A STUPID DCA I [INDEV /'ATTEMPT-TO-READ-PAST-EOF'! TAD (232 /PASS ^Z TO PROGRAM CDI 10 /(MIGHT COME IN HANDY) JMP I ICHAR0 ITEMP, 0 IPNTR, 0 XLEN, TAD I (OLNGTH /FUNCTION TO CHECK FILE LENGTH TAD I (BLKCNT /(AMOUNT USED THUS FAR) CIA CDI 10 JMP I .+1 /RETURN MAX. AVAILABLE LENGTH FIN+2 ZBLOCK 3 FILEGO, OLIST ABORT CLOSE RESTOR DATER IMPUT OUTPUT PAGE /IMPUT, WAITUP /WAIT FOR THE TELETYPE AGAIN CMA OPENUP /CALL THAT AMAZING INBLK-1 /GENERAL-PURPOSE SUBROUTINE 2 /MONITOR 'LOOKUP' JMP TTYIN /'OPEN INPUT TTY:' ERROR1 /WHOOPS - FILE NOT FOUND DISMISS /BOOT THE USR OUT CLA CMA DCA INFLG /CHARACTER COUNTER TAD STBLK /FIRST BLOCK NO. DCA I .+2 JMP IRST+3 IBLK IRST, TAD INFLG /'OPEN RESTORE INPUT' COMMAND SNA CLA /CHECK CHARACTER COUNT ERROR1 /NO INPUT FILE TO RESTORE TAD TTYIN-1 /SET I/O POINTERS CDF 10 DCA I [INDEV TAD ATEM-1 /'ION' ISZ GOSW /AND ECHO MODE TAD (PRINTC-ION DCA I .+2 /READC ECHO INSTRUCTION JMP EXIT /RETURN IECHO ICHAR TTYIN, TAD (XI33 /'OPEN INPUT TTY:' JMP IRST+4 /THE STACK CAN BEGIN HERE IF THE FILE COMMANDS ARE DELETED. /NOTE: STACK ROUTINES HAVE BEEN REVISED FOR IMPROVED SPEED! PCHK, 0 /STACK OVERFLOW CHECK CDF 10 TAD I [PDLXR /ADJUST FIELD 1 X-REGISTER DCA PDLXR /BACKUP & COPY TAD PDLXR DCA I [PDLXR TAD PDLXR /CHECK FOR OVERFLOW CLL CIA TAD I [BUFR /LAST TEXT WORD CDF SZL CLA PDERR, ERROR1 /TOO BAD ! JMP I PCHK MPUSHA, 0 /PUSH THE AC ON THE STACK DCA MPOPA CMA JMS PCHK TAD MPOPA DCA I PDLXR JMP I MPUSHA *5660 IOBUF, ZBLOCK 20 /TELETYPE OUTPUT BUFFER /LOWER FIELD STACK ROUTINES: MPOPA, 0 /POP A WORD INTO THE AC CDF 10 ISZ I [PDLXR /FAKE A FIELD 1 USE TAD I [PDLXR CDF DCA MPUSHA TAD I MPUSHA JMP I MPOPA MPD2, 0 /PUSH 4 WORDS ON THE STACK CLA CMA TAD I MPD2 /BACKUP POINTER DCA AUTO ISZ MPD2 TAD FCDF+2 RDF /CALLED FROM EITHER FIELD DCA FCDF TAD [-4 JMS PCHK TAD [-4 DCA PCHK FCDF, HLT /CHANGE TO CALLING FIELD TAD I AUTO CDI DCA I PDLXR /LOAD STACK ISZ PCHK JMP FCDF /WITH FOUR WORDS TAD FCDF DCA .+1 CDI JMP I MPD2 MPD3, 0 /POP 4 WORDS CLA CMA TAD I MPD3 DCA PDLXR ISZ MPD3 TAD [-4 DCA PCHK JMS MPOPA DCA I PDLXR ISZ PCHK JMP .-3 JMP I MPD3 APUSHX, JMS MPUSHA /FIELD 1 'PUSHA' CALL CDI 10 JMP I .+1 XPUSHA+3 REKOVR, ZBLOCK 3 /'SWBA' & OTHER RESETS GO HERE DCA I PDLXR /CLEAR OUT THE TTY BUFFER ISZ IOBUF /('-20' SET BY 'RECOVR') JMP .-2 /ALSO CLEARS 'MPUSHA' TAD I [SWAPIN /CHECK CORE-SWAP FLAG SNA CLA JMS I [SWAPIN /RESTORE FOCAL! CDI 10 TAD (RECOVX /LET 'EOF' RESTORE THE TTY DCA I (EOF JMP I (EOF+1 PAGE /READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV' GNAME, TAD ("A-": /WAS IT A DEVICE ? SZA CLA JMP I NAME /NO, ALL SET UP TGETC /YES, MOVE PAST ':' TAD NAMLOC /MOVE TO DEVICE AREA DCA NEWDEV TAD NAMLOC+1 JMP NAME+3 /GET FILENAME NAME, 0 TAD [5723 /CODE FOR 'DSK:' DCA NEWDEV /(DEFAULT DEVICE) DCA NEWDEV+1 DCA NAMLOC /CLEAR NAME AREA DCA NAMLOC+1 /(DON'T CLEAR ASSUMED EXTENSION) DCA NAMLOC+2 TAD XNAME /INITIALIZE POINTERS DCA NMBASE GETN, STA STL DCA PERDSW DCA NAMECT TSPNOR DCA I [NPACK JMP I .+1 /EXAMINE THE FIRST CHARACTER FIRSTC NAMEC, JMP I GETN /GET NEXT CHARACTER OR NUMBER TAD ("(-". /EXTENSION? SNA JMP PERD /YES, CLEAR DEFAULT EXTENSION TAD (".-", /COMMA? SNA CLA JMP ECHCHK /YES, CHECK FOR ECHO JMS DECODE /MUST BE A-Z, 0-9 JMP GNAME /IT WASN'T, MUST BE END OF NAME SZL /RESTORE CHARACTER TAD K57 IAC DCA DECODE /TEMPORARY STORAGE TAD NAMECT /NO MORE THAN 6 CHARACTERS/NAME TAD (-6 K7700, SMA CLA JMP I PASSN /GO TO THE END OF THE NUMBER TAD NAMECT /BUILD POINTER TO CHAR. POSITION CLL RAR TAD NMBASE DCA ATEM TAD DECODE /LEFT OR RIGHT HALF? SZL JMP .+4 RTL /LEFT, SHIFT OVER RTL RTL TAD I ATEM /ADD IN OTHER HALF DCA I ATEM ISZ NAMECT /BUMP COUNT JMP NAMEC /CONTINUE LOOP K57, 57 P4, 4 PERD, TAD NAMLOC /FOUND A PERIOD IN STRING SZA CLA ISZ PERDSW ERROR1 /DOUBLE PERIODS OR NO FILE NAME DCA EXTENSION /CLEAR EXTENSION TGETC /MOVE PAST PERIOD ISZ NMBASE /FAKE OUT POINTERS TAD P4 JMP GETN+2 ECHCHK, TGETC /MOVE PAST COMMA TSPNOR TAD CHR /MUST BE FOLLOWED BY 'ECHO' TAD (-"E SZA CLA JMP GNAME DCA GOSW /CLEAR ECHO FLAG TGETC /MOVE TO END OF WORD JMS DECODE JMP GNAME CLA CLL JMP .-4 DECODE, 0 /CHECK FOR A-Z, 0-9 TAD CHR TAD (-"9-1 CLL IAC TAD K11 /"9(+1)-"0 SZL JMP DCDYES TAD ("0-"Z-1 STL TAD ("Z-"A+1 SNL DCDYES, ISZ DECODE /IT WAS! JMP I DECODE NMBASE=. IOWAIT, 0 /WAIT FOR TELETYPE TO FINISH ION CDF 10 TAD I (TELSW SZA CLA JMP .-2 CDF IOF /THEN TURN OFF THE INTERRUPT JMP I IOWAIT PERDSW=. USRIN, 0 /LOCK THE USR IN CORE IOF /(NOP IF ALREADY IN CORE) CIF 10 JMS I USR 10 TAD [200 /SET POINTER FOR LATER CALLS DCA USR JMP I USRIN NAMECT=. USROUT, 0 /IF THE USR IS IN, KICK IT OUT PASSN, STA CLL AND USR /CHECK POINTER TO FIND OUT SPA CLA JMP I USROUT TAD K7700 /RESET POINTER = 7700 DCA USR IOF CIF 10 JMS I [200 K11, 11 JMP I USROUT PAGE TTYTXT, DEVICE TTY /FOR COMPARISON PURPOSES *CIF /'PRINTC' TAB COUNTER 0 SZA /TEST FOR CR JMP .+4 ISZ CIF /ADVANCE RETURN POINT ISZ CIF DCA I [ERR2 /RESET COUNTER TAD (215-240 SMA /NON-PRINTING CHARACTERS ISZ I [ERR2 /ADD 1 TO TAB COUNT (FIELD 1) NOP /MIGHT SKIP AFTER 4095 TIMES TAD [240 /WITHOUT INTERVENING CR'S CIF 10 JMP I CIF TSP, TASK DHT, 7646 NOTEQ, ISZ SLOT /BUMP POINTER TO SAVE NAME TAD NEWDEV /MOVE NEW DEVICE NAME TO TABLE DCA I SLOT ISZ SLOT TAD NEWDEV+1 DCA I SLOT ISZ SLOT GETMON /NEED USR, MIGHT AS WELL LOCK IT IN RETRY, TAD NEWDEV /MOVE DEVICE NAME FOR MONITOR CALL DCA DEVC TAD NEWDEV+1 DCA DEVC+1 TAD I SLOT /MOVE LOAD POINT DCA DLOAD CIF 10 JMS I USR /CALL MONITOR (ALREADY IN CORE) 1 DEVC, 0 0 /DEVICE NO. DLOAD, 0 /ENTRY POINT ERROR1 /DEVICE NOT AVAILABLE OR TAD [200 / TWO-PAGE HANDLER TAD DLOAD /ENTRY POINT FOR HANDLER SMA CLA /IF >7600 DON'T CHECK FURTHER JMP HANDOK /SYSTEM HANDLER TAD DLOAD /IF THE HANDLER WAS NOT LOADED AND [7600 /INTO THE PROPER PAGE, RELOAD IT! CLL CIA TAD I SLOT /PROPER LOADING ADDRESS SNA CLA JMP HANDOK /EVERYTHING'S ALL RIGHT DCA DLOAD /CLEAR ENTRY POINT JMS PUTDEV /TELL USR THE HANDLER DLOAD-2 /IS NOT IN CORE ANYMORE JMP RETRY /LOAD IT THIS TIME PUTDEV, 0 /TELL THE MONITOR WHETHER TAD I PUTDEV / A HANDLER IS IN OR OUT DCA PDLXR /POINTER TO DEVICE # AND ENTRY TAD DHT /DEVICE HANDLER TABLE TAD I PDLXR /PLUS DEVICE NUMBER DCA ATEM /POINTS TO 'HANDLER-IN-CORE' FLAG TAD I PDLXR CDF 10 DCA I ATEM /FLAG IS SIMPLY HANDLER ENTRY CDF ISZ PUTDEV JMP I PUTDEV /ALSO CALLED BY 'NOCHAR' /LOAD A HANDLER INTO THE PROPER SLOT: HANDLR, 0 TAD I HANDLR /WHICH SLOT? ISZ HANDLR DCA SLOT COMPARE /IF THE HANDLER HAS THE SAME NAME, -2 /DON'T LOAD IT AGAIN SLOT, 0 NEWDEV-1 JMP NOTEQ /DIFFERENT NAMES, LOAD NEW HANDLER ISZ AUTO 2 /(SET BY 'COMPARE') TAD AUTO 2 /POINTS TO DEVICE # DCA .+4 TAD I AUTO 2 DCA DEVNO /MOVE DEVICE # (FOR SAVE AND CLOSE) JMS PUTDEV /SO USR KNOWS IT'S IN CORE 0 JMP I HANDLR HANDOK, ISZ SLOT /BUMP POINTER TO DEVICE # TAD DEVC+1 /SAVE IT DCA I SLOT ISZ SLOT /MOVE TO ENTRY POINT TAD DLOAD /SAVE ENTRY DCA I SLOT TAD DEVC+1 /GET DEVICE # DCA DEVNO /SAVE IT AND EXIT JMP I HANDLR EJECT /TABULATE ROUTINES: CALLED FROM THE UPPER FIELD TAB, SPA /TAB COMMAND JMP NEG CIA TAD I [ERR2 /FIND OUT WHERE WE ARE SMA /HAVEN'T GOT THERE YET ZER, CLA CMA /WE'RE PAST: FORCE -1 DCA GOSW CDI 10 ISZ GOSW /TEST IN ADVANCE SKP /NO JUMPS ALLOWED! JMP I TSP /RETURN TO A/T LOOP TAD [240 /PRINT SPACES JMS I [CPRNT JMP ZER+2 NEG, DCA GOSW TAD I XCHAR /SAVE THE CURRENT CHARACTER DCA CHR CIF 10 JMP SKIP1 /SKIP OVER ONE (OR MORE) POS, ISZ GOSW JMP .-3 TAD CHR DCA I XCHAR /RESTORE THE ORIGINAL ONE JMP ZER /SORT AND BRANCH TABLE FOR LOWER-FIELD COMMANDS: KOMLST, "B /BRANCH "G /GOSUB LF /RETURN "N /NAME "S /SAVE "E /EXIT FILIST, "L /LIST "A /ALL OR ABORT "C /CALL OR CLOSE "R /RUN OR RESTORE "D /DATE OR DELETE ORLIST, "I /INPUT OR INITIAL "O /OUTPUT OR ONLY PAGE /LIBRARY PROCESSOR: COMMAND DECODE, NAMER, DATER, & SAVER. *FPNT /ENTER VIA 'JMP I 7' LCMND, TAD I XCHAR /SAVE CURRENT CHARACTER DCA CHR TAD [603 /SET '.FC' DCA EXTENSION DCA GOSW /POINT TO 'PROC' TSPNOR WAITUP /TURN OFF THE INTERRUPT TAD CHR JMP LGO /RETAIN OLD ERROR CODE NAMER, GTNAME /'LIBRARY NAME' COMMAND JMP EXIT-3 SAVER, GTNAME /'LIBRARY SAVE' COMMAND JMS HEADER /FILL IN THE HEADER JMS SAVE /DO IT JMP EXIT /DONE LGO, TJUMP /BRANCH TO THE APPROPRIATE ROUTINE KOMLST-1 KOMGO-KOMLST ERROR1 /SORRY, CHARLIE! DATER, TAD [NUDATE-1 /'OUTPUT DATE' COMMAND DCA AUTO TAD [-4 DCA GOSW TAD I AUTO /GET DATE AND JMS I [NPACK /OUTPUT IT ISZ GOSW JMP .-3 JMP EXIT /RETURN CGET OCHK SAVE, 0 /CALLED BY 'SAVER' AND 'GOSUB' JMS I .-2 /CLOSE OUTPUT FILE TO AVOID TROUBLE TAD XNAME /POINTER TO NAME DCA SAVEPT CDF 10 TAD I [BUFR /GET PROGRAM LENGTH CDF DCA I [200 /SAVE IT WITH THE PROGRAM GETMON /CALL THE MONITOR GETHND /AND THE HANDLER LIBBLK-1 TAD I [200 /SAVED LENGTH, REMEMBER? AND [7600 /MASK OFF CLL RAR /CONVERT TO PAGES DCA BLOCK /FOR HANDLER TAD BLOCK /ROUND UP TO BLOCKS TAD [100 AND [7600 CLL RAR RTR DCA SAVBLK /FOR MONITOR 'ENTER' TAD SAVBLK /GET DESIRED LENGTH TAD DEVNO /(SET BY 'HANDLR') CIF 10 JMS I USR /ENTER OUTPUT FILE 3 SAVEPT, NAMLOC 0 ERROR1 /NO ROOM ON DEVICE TAD SAVBLK /SHIFT FOR CLOSING LENGTH CLL RTR RTR DCA SAVBLK TAD DEVNO /CLOSE THE FILE BEFORE WE WRITE IT! CIF 10 /(SURE, IT'S CHEATING, BUT JMS I USR /IT SAVES TIME!) 4 NAMLOC SAVBLK, 0 ERROR1 /IMPOSSIBLE ERROR ! TAD SAVBLK /SAVE THIS CRAP TO REMEMBER CIA /WHERE THIS PROGRAM IS DCA LIBLEN /IN CASE WE WANT TO GOSUB TAD SAVEPT DCA LIBFIL TAD NEWDEV DCA LIBDEV TAD NEWDEV+1 DCA LIBDEV+1 TAD SAVEPT /MOVE STARTING BLOCK FOR WRITE DCA POINT4 STL RAR /COMPUTE FUNCTION WORD IAC /SET TO SEARCH FORWARD TAD BLOCK /HOW MUCH TO WRITE DCA BLOCK JMS I LIBHND BLOCK, 0 /WRITE (BLOCK) BLOCKS 200 /FROM FIELD 0, 200 UP POINT4, 0 JMP I [DERR /GO COMPLAIN ABOUT DEVICE DISMISS JMP I SAVE MGETC, 0 /CROSS-FIELD CALL CDI 10 JMS I SAVE-2 DCA CHR JMP I MGETC CMPR, 0 /COMPARE TWO BLOCKS OF ANY LENGTH TAD I CMPR /CALLING SEQUENCE: ISZ CMPR / COMPARE DCA MGETC / -# OF WORDS TAD I CMPR / FIRST-1 ISZ CMPR / SECOND-1 DCA AUTO 2 / RETURN IF NO MATCH TAD I CMPR / RETURN IF MATCH ISZ CMPR DCA AUTO 3 CONT, TAD I AUTO 2 /COMPARE TWO WORDS CIA TAD I AUTO 3 SZA CLA JMP I CMPR /NO MATCH ISZ MGETC /DONE ? JMP CONT /NO, CHECK TWO MORE ISZ CMPR /YES, BUMP RETURN POINTER JMP I CMPR /LIBRARY COMMAND LIST: KOMGO, BRANCH /B GOSUB /G GOBACK /LF NAMER /N SAVER /S MONITOR /E LIST2 /L LISTAL /A CALLER /C RUNNER /R DELEET /D INITIAL /I LIST1 /O /LOOKUP AND LOAD ROUTINES PDR, PDERR SVR, SAVE INITIAL=.+2 SUBBER, CMA CLL RTL /THESE ALL DO THE SAME THING AND RUNNER, IAC /THEN BRANCH TO DIFFERENT PLACES CALLER, IAC /LOAD HAS 5 POSSIBLE EXITS ! OPENUP /CALL THE HANDLER AND LIBBLK-1 /LOOKUP THE FILE 2 JMP .+5 /TTY: NOT A DIRECTORY DEVICE ERROR1 DISMISS JMS I GDT /GET DEVICE TYPE SMA CLA ERROR1 /NOT A DIRECTORY DEVICE CDI 10 JMS I GLN /SOME COMMANDS HAVE LINE NUMBERS LOAD, TAD I [PDLXR /GET PUSHDOWN POINTER CDF TAD [-200 /DIDDLE IT AND [7600 CLL RAL RTL RTL TAD FLNGTH /NOW COMPARE WITH LENGTH OF FILE SPA CLA JMP I PDR /PROGRAM TOO LONG TAD FLNGTH /COMPUTE FUNCTION WORD CLL CIA RTL RTL RTL STL RAL /SET TO SEARCH FORWARD DCA .+4 TAD STBLK DCA .+4 JMS I LIBHND /GET THE PROGRAM TEMP, 0 200 /LOADS FROM 200 UP 0 /STARTING BLOCK NO. JMP I [DERR TAD I [200 /MOVE PROGRAM LENGTH CDF 10 DCA I [BUFR TAD GOSW /CHECK FOR GOSUB SMA CLA JMP LOADGO TPUSHA= JMS I TPA TPOPA= JMS I [MPOPA TAD I XCHAR /GOSUB MUST SAVE TERMINATOR TPUSHA TAD [215 /AND SUBSTITUTE A CR TO FORCE CDF 10 DCA I XCHAR /A RETURN FROM 'TERMER' CDF TPUSHF /ALSO SAVE CURRENT PROGRAM INFO LIBDEV LOADGO, CDF TPUSHF /SAVE NEW PROGRAM POINTERS NEWDEV TPOPF /SO WE KNOW WHERE WE ARE LIBDEV TAD I D /CHECK PROGRAM I.D. SZA CLA JMP I DIALOG /INITIAL DIALOGUE - OR JMP EXIT-1 /PROC, START, GOTO, OR DO GOSUB, TAD LIBFIL /CHECK FOR CURRENT PROGRAM SZA CLA JMP SUBBER /NO NEED TO SAVE IT TPUSHF /MOVE 'FOCAL.TM' TO NAME AREA FOCTXT TPOPF NAMLOC TAD [5723 /DEVICE 'DSK' FOR SAVE DCA NEWDEV DCA NEWDEV+1 JMS I SVR /SAVE FILE & REMOVE USR TAD [603 /RESET EXTENSION TO 'FC' DCA EXTENSION JMP SUBBER GOBACK, TPOPF /RESTORE CALLING PROGRAM POINTERS NEWDEV GETHND /GET THE HANDLER BACK INB, LIBBLK-1 /POINTS TO 'INBUF' DISMISS /AND REMOVE THE USR TPOPA /FINALLY, RESTORE THE PROPER CHAR. CDF 10 DCA I XCHAR JMP LOAD /AND RELOAD THE PROGRAM /THE 'LIBRARY BRANCH' COMMAND ALLOWS PROGRAMS TO TEST THE /TELETYPE WITHOUT READING A CHARACTER. THE BRANCH OCCURS /IF THERE IS -NO- INPUT: 1.1 T PI;L B 1.1;C A KEY WAS HIT /'FIN()' MAY THEN BE USED TO READ AND TEST THE CHARACTER. BRANCH, CDI 10 /'LIBRARY BRANCH' COMMAND JMS I GLN TAD I INB /CHECK FOR INPUT SNA CLA STL RTL /NONE: SET EXIT TO 'GOTO' JMP EXIT /OTHERWISE CONTINUE LINE JUMPER, 0 /SORT AND BRANCH SUBROUTINE CIA DCA TEMP SKP /CURRENT ONE MIGHT BY A TERMINATOR TGETC CDI 10 JMS I TRM /IS 'CHAR' A SP, COMMA, ; OR CR? JMP .-3 /NO TAD I JUMPER /GET LIST ADDRESS ISZ JUMPER DCA AUTO TAD I AUTO GLN, SPA SNA /END OF LIST ? JMP ERRX TAD TEMP SZA CLA /FOUND IT ? JMP GLN-1 /NO TAD AUTO TAD I JUMPER /ADD OFFSET DCA TEMP TAD I TEMP /POINT TO ENTRY DCA TEMP JMP I TEMP ERRX, ISZ JUMPER /ERROR EXIT FOR 'JUMPER' JMP I JUMPER /ERROR ROUTINE CLEARS AC FOCTXT, FILENAME FOCAL.TM TPA, MPUSHA TRM, TERMER GDT=.+1 OLIST, WAITUP /'ONLY LIST' COMMAND LIST1, CMA STL RAL /'LIST ONLY' COMMAND LIST2, ISZ GOSW /'LIBRARY LIST' COMMAND LISTAL, DCA STBLK /'LIST ALL' COMMAND /THIS SECTION DOES THE WORK OF LISTING THE DIRECTORY: /THE 'LIBRARY LIST' COMMAND SHOWS ONLY "FC" AND "FD" FILES /'LIST ALL' SHOWS EVERYTHING & 'LIST ONLY' SHOWS ONLY ONE. GTNAME /GET DEVICE TO LIST GETHND /GET THE HANDLER LIBBLK-1 DISMISS /KICK OUT USR IF HANDLR CALLED IT JMS GETDEV /FIND DEVICE TYPE SMA CLA ERROR1 /CAN'T LIST A NON-DIRECTORY DEVICE JMS I [7607 /SWAP OUT CORE TO MAKE ROOM 4200 /FOR DIRECTORY 1000 40 /SYSTEM SCRATCH AREA JMP I [DERR /WHOOPS! DCA I [SWAPIN /SET THE FLAG TO SWAP BACK IN IAC /DIRECTORY BEGINS WITH BLOCK 1 BLOKLP, DCA LBLOCK IOF JMS I LIBHND 0200 1000 LBLOCK, 1 JMP I [DERR TAD K1004 /FIRST 5 WORDS ARE INFORMATION DCA AUTO LOOP2, TAD AUTO /SAVE FOR LATER DCA AUTO 1 TAD AUTO DCA LIBX TAD I AUTO /LOOKING FOR .FC & .FD FILES SNA CLA JMP PATCH /ZERO FILE ISZ AUTO ISZ AUTO TAD I AUTO /PICK UP EXTENSION DCA LBLOCK TAD I K1004 /WASTE WORDS (NEGATIVE) CIA /THANKS FOR TELLING US, RITCHIE TAD AUTO /SKIP TO LENGTH DCA AUTO TAD I AUTO /ZERO LENGTH MEANS TEMPORARY FILE SNA JMP LOOP3 /IGNORE SUCH THINGS CIA DCA FLNGTH /SAVE POSITIVE LENGTH TAD NAMLOC /WAS A NAME GIVEN ? SZA CLA JMP CKNAME /YES CKFCFD, TAD LBLOCK /COMPARE EXTENSION TAD (-604 /DO WE WANT THIS ONE? SZA IAC SZA CLA TAD GOSW /TEST FOR 'ALL' SZA CLA JMP LOOP3 /GUESS NOT JMP DIRLIST CKNAME, COMPARE /COMPARE THIS NAME WITH ARG -4 LIBX, 0 NAMLOC-1 JMP LOOP3 /NON-MATCHING ISZ STBLK /TEST FOR ONLY ONE DCA NAMLOC /DON'T CHECK ANY MORE DIRLIST,CMA CLL RTL /PRINT 3 WORDS DCA COUNT TAD I AUTO 1 /SET BEFORE THIS JMS I [NPACK /PRINT 2 CHARS ISZ COUNT JMP .-3 TAD (". JMS I (PRINT TAD I AUTO 1 /PRINT EXTENSION JMS I [NPACK TAD TABLE /SET UP FOR DECIMAL LENGTH PRINT DCA POINT ZLUP, DCA ZERSW DCA COUNT NLOOP, TAD I POINT /FINISHED ALL POWERS OF 10? SNA JMP NEND /YES, ALL DONE TAD FLNGTH /NO, SUBTRACT THIS POWER SPA /UNDERFLOW? JMP DIGIT /YES, PRINT THIS DIGIT DCA FLNGTH /NO, GO THROUGH THE LOOP AGAIN ISZ COUNT /ADD ONE TO THIS DIGIT JMP NLOOP /ANOTHER DIVIDE CYCLE PATCH, ISZ AUTO /BUMP PAST EMPTY LENGTH LOOP3, ISZ I LBLOCK-1 /DONE WITH THIS BLOCK? JMP LOOP2 /NO, KEEP GOING WAITUP /WAIT FOR I/O TAD I K1002 /LINK TO NEXT BLOCK SZA /LAST BLOCK? JMP BLOKLP /NO, GET THE NEXT JMS I [SWAPIN /YES, RESTORE SWAPPED CORE JMP EXIT /(JMS RESETS THE FLAG) K1002, 1002 K1004, 1004 DIGIT, CLA CLL /CRAP IN AC ISZ POINT /NEXT POWER OF TEN TAD COUNT /IF THIS DIGIT IS ZERO, AND NO ISZ ZERSW /OTHER DIGITS HAVE BEEN NON-ZERO, SZA /PRINT A SPACE INSTEAD JMP NPRNT TAD [240 JMS I (PRINT JMP ZLUP NPRNT, TAD [260 /CHANGE TO ASCII JMS I (PRINT TABLE, CMA STL /SET ZERO SWITCH JMP ZLUP NEND, TAD [215 /DONE WITH THIS LINE (WHEW!) JMS I (PRINT JMP LOOP3 *CMA STL /TRICKY, HUH? DECIMAL -1000 -100 -10 -1 COUNT=.;OCTAL /CLEVER ASSIGNMENT TERMINATES TABLE *CMA STL RAL /MORE TRICKS! GETDEV, 0 /GET DEVICE TYPE FROM MONITOR TABLE TAD (7757 /DCB-1 TAD DEVNO DCA LIBX CDF 10 TAD I LIBX CDF JMP I GETDEV POINT= NEWDEV ZERSW= NEWDEV+1 PAGE /MISCELLANEOUS GENERAL-PURPOSE ROUTINES /THIS IS THE GENERAL OPEN SUBROUTINE /CALLNG SEQUENCE: /JMS I [OPEN /HANDLER BLOCK /MONITOR CALL CODE /RETURN IF TTY: IS DEVICE /ERROR RETURN /NORMAL RETURN /SETS STBLK, FLNGTH ON PAGE ZERO OPEN, 0 DCA GOSW /SET ECHO/LOAD SWITCH GTNAME /GET DEVICE AND FILENAME COMPARE /DEVICE 'TTY:' IS SPECIAL -2 NEWDEV-1 TTYTXT-1 JMP OTHER /DEVICE OTHER THAN TTY ISZ OPEN /INCREMENT TO PROPER RETURN ISZ OPEN JMP I OPEN OTHER, TAD I OPEN /GET HANDLER BLOCK TO USE DCA HND ISZ OPEN TAD XNAME /POINTER TO NAME DCA NAMPT GETMON GETHND /GET THE HANDLER HND, 0 /SET TO HANDLER BLOCK TAD I OPEN /GET MONITOR CALL CODE (2 OR 3) ISZ OPEN DCA CALL DCA LNGTH /FOR MONITOR KLUDGE - IT FALLS TAD DEVNO / THROUGH IN CASE OF ERROR CIF 10 JMS I USR /DO THE CALL CALL, 0 NAMPT, NAMLOC LNGTH, 0 /LET THE CALLING ROUTINE JMP OTHER-2 /DECIDE ERROR PROCEDURE TAD LNGTH /MOVE PARAMETERS TO PAGE ZERO DCA FLNGTH TAD NAMPT DCA STBLK JMP OTHER-3 /AND TAKE NORMAL RETURN MSPNOR, 0 /COPY UPPER FIELD ROUTINE TAD CHR TAD MSPACE SZA CLA JMP I MSPNOR TGETC JMP MSPNOR+1 DELEET, JMS OCHK /DELETE IS AN EASY ONE GTNAME GETMON GETHND LIBBLK-1 CIF 10 TAD DEVNO JMS I USR /DELETE THE FILE 4 NAMLOC 0 ERROR1 DISMISS JMP EXIT-2 OCHK, 0 /IF ANY FILE EXISTS, CLOSE IT TAD DEVHLD SZA CLA JMS I .+2 JMP I OCHK CLOSER SWAPIN, HLT /RESTORE CORE AFTER DIRECTORY LIST IOF JMS I [7607 /SYSTEM HANDLER 200 1000 40 DERR, ERROR1 /DEVICE ERROR JMP I SWAPIN NPACK, 0 /STANDARD 6-BIT UNPACK ROUTINE DCA OCHK TAD OCHK RTR RTR RTR JMS XFORM TAD OCHK JMS XFORM JMP I NPACK XFORM, 0 AND (77 MSPACE, SMA SZA /PRINT SPACES FOR NULLS TAD MFORTY SPA TAD [100 TAD [240 JMS PRINT JMP I XFORM EJECT OCLCHK, TAD OUTFLG /MAKE 'OPEN OUTPUT' WITH AN SNA CLA /ALREADY OPEN FILE THE SAME AS ERROR1 /'OUTPUT CLOSE;OPEN OUTPUT' JMS I OCHK+5 TAD (YINT /FAKE OUT 'OPEN' DCA OPEN JMP OTHER *STA CLL /VARIABLE FILE NAME PATCH ISZ NPACK /COUNT THE DIGITS TAD NPACK /NOW MANY? MFORTY, SMA SZA CLA TGETC /RETURN TO ALPHA MODE FIRSTC, TAD CHR TAD (-"( /CHECK FOR A LEFT "(" SZA JMP I (NAMEC+1 /CONTINUE CHECKING CDI 10 /FOUND ONE, GO GET # JMS I (VFN DCA AUTO /SAVE STRING ADDRESS TAD I (T3 SPA SNA /CHECK DECIMAL EXPONENT CLA IAC /FOR "0" CIA DCA NPACK /SET DIGIT COUNTER *STA STL CDF 10 /GET A DIGIT - 'GETN' TAD I AUTO CDF TAD [260 /CONVERT TO ASCII DCA CHR JMP STA CLL /! PRINT, 0 /'PRINTC' FOR LISTING AND DATE CDI 10 JMS I [CPRNT JMP I PRINT PAGE EJECT PAGE-ZERO (FIELD 0) LITERALS: $