File: LIB.PA of Tape: Sources/Focal/s9
(Source file text)
/&0 /DEFINITIONS OF FOC AND FLT IF NEEDED IFNZRO FFNASS < BUFR=0060 CHARLY=0165 CHIN=2405 CPRNT=2566 EFUN3=2024 EOF=1362 ERR2=2745 EXP=0044 FOUNS=4466 FOUS=4542 FOUSTR=4446 FOUX0=4437 GOSWIT=7517 HORD=0045 ICHARF=2740 INDEV=0064 INPUTX=0227 INTRPT=2601 L=0 LORD=0046 MGETC=5774 MMINSK=4723 OCHAR=1345 OUTDEV=0063 OUTECH=1347 OVER2=0047 P=0010 PC=0022 PGETLN=2572 PRINTC=4551 PROC=0613 PUSH1=4712 T=0020 TELSW=0016 TERMER=5172 XINTEG=7572 XI33=2672 XOUTL=2704 > IFNZRO LIBLST <XLIST> IFZERO LTNASS < EJECT OS-8 FOCAL IN-OUT AND UTILITY /&1 FIELD 0 *1 /INTERRUPT SERVICE ROUTINE JMP I .+1 INTSTO INTRPD, INTRPT 0 0 /FOR OD 0 *7 TPUSHJ=JMS I . MPUSHJ AUTO1, 0 /AUTO-INDEX REGISTERS...ACTUALLY USE SOME PDLXR, PSHBOT-1 /PUSHDOWN AUTO-INDEX(ALLREADY ONE RETURN IN IT) AUTO3, 0 /MPD3 AUTO4, 0 AUTO5, 0 /COMPARE AUTO6, 0 /COMPARE AUTO7, 0 AUTO8, 0 XCNTR, 0 /GENERAL COUNTER--SUCH AS FOR MPD2,MPD3,COMPARE USR, 7700 /POINTER TO MONITOR (200 IF IN CORE) EXITOS, JMS I [DISMIS /NORMAL RETURN FOR PS/8 COMMANDS ION CDF CIF 10 JMP I .+1 GOSWITCH-3 NAMLOC, ZBLOCK 3 /USED BY NAME EXTENS, 0 /"FC", "FD", "FP" OR "FN" DERR, ERROR1 /DEVICE ERROR NEWDEV, ZBLOCK 2 /USED BY NAME TEM7, 0 /PUSHA ATEM, 0 /FLDSET XCHAR, CHAR SHNDLR, 7607 /DEFINE LOWER FIELD INSTRUCTIONS . . . TGETC=JMS I . XGETC TPOPA=JMS I . MPOPA TPUSHA=JMS I . MPUSHA TPUSHF=JMS I . MPD2L TPOPF=JMS I . MPD3L /&2 TSORTJ=JMS I . MSORTJ ECHFLG, 0 /-1:NO ECHO OPNFLG, 0 /OOPEN:-1;OCLOSE:0 IPNFLG, 0 /IOPEN:-1 FLNGTH, 0 /SET BY OPEN STBLK, 0 /SET BY OPEN DEVNO, 0 /SET BY HANDAD LIBBLK, 0 /FOR DEVICE NAME 0 7200 /LOAD POINT 0 /FOR DEVICE # LIBHND, 0 /HANDLER ENTRY TESTRM=JMS I . MSORTC TINTEG=JMS I . MINTEG ERROR1=JMS I . ERROR CHAR, 0 /FOR OBSCURE FAKING REASONS INBLK, 0 0 4400 0 INHND, 0 OUTBLK, 0 0 5000 0 OUTHND, 0 TPRINTC=JMS I . MPRINTC TGETLN=JMS I . MGETLN TSPNOR=JMS I . XTSPNOR LIBFIL, 0 /STARTING BLOCK OF SAVED PROG;UNSAVED = 0 DEVHLD, 0 /OOPEN:DEV. NO. FOR CLOSE PAGE /&3 / FELD / FOCAL OVERLAY FUER MAGNET /MODE DEFINIEREN: S Z=FELD(M) /VORZEICHEN DEF.: S Z=FELD(S) /FELD EINSTELLEN: S Z=FELD(H) /FELD AUSLESEN: S Z=FELD(R) /MODE: M IN BCD /BIT 0: 0=INT ON; 1=INT OFF /BIT 1: 0=MODE A; 1=MODE B /BIT 2 UND BIT 3: DH/DT: /0=200, 1=50, 2=25, 3=12.5 GAUSS/SEC /INTERRUPT HANDLER SETZT VARIABLE "!" = 0 *200 FELD, CLA CDF 10 TAD I [CHARLY CDF 0 DCA FEARG TAD FEARG TAD (-"M SNA CLA JMP FEMODE TAD FEARG TAD (-"S SNA JMP FESIGN IAC SNA CLA JMP FEREAD TAD FEARG TAD (-"H SNA CLA JMP FESETH ERROR1 FEMODE, MACL TINTEG RTL BSW MALM JMP FEEXIT FESIGN, CDF 10 TAD I [HORD CDF 0 SPA CLA TAD FENBIT DCA FESBIT JMP FEEXIT /&4 FESETH, TINTEG MQL CDF 10 TAD I [HORD CDF 0 DVI FE1750 SZL ERROR1 JMS I (BINBCD SWP JMS I (BINBCD TAD FESBIT MALH MQA CLA MALL JMP FEEXIT FEREAD, MARH RTL RTL DCA FERSGN TAD FERSGN RTR RTR AND [177 MQL MARL JMS I (DOUBCD CDF 10 DCA I [HORD CLA SWP DCA I [LORD DCA I [OVER2 TAD [27 DCA I [EXP CDF 0 TAD FERSGN SMA CLA JMP FEEXIT TPUSHJ MMINSK FEEXIT, CIF CDF 10 JMP I [EFUN3 FESBIT, 0 FENBIT, 0200 FEARG, 0 FERSGN, 0 FE1750, 1750 /&5 /SECOND PART OF FX: COMMON TO DIS STORAGE FUNCTION FXLOWA, MQA CLA /GETS HIGHIST EXPONENT DCA XMEXP TPOPA DCA CPOINT /COMMON START CDF P TAD I [LORD /RELATIVE START OF DIS TAD [DISFIL /ABOSULUTE START DCA DPOINT TAD XMEXP /GIVE HIGHEST EXPONENT BACK DCA I [LORD /TO FOCAL;IT GETS NORMALIZED CDF L TAD [-400 DCA XTAL /SET TALLY XLOOP, TAD I CPOINT /GET EXPONENT SAM / HIGHEST EXP - EXP;FIRST TIME MQ STILL SET. IAC /FOR VERY INVOLVED REASONS DCA XSHIFT ISZ CPOINT TAD XSHIFT AND [7760 /NOT BIGGER THAN 15 SZA CLA JMP XSHIFT+1 /ZEROLIZE TAD I CPOINT /GETS MANTISSA ASR /UNNORMALIZE XSHIFT, 0 CLL CML RAR /GIVES DISPLAY BIT AND ONE MORE CDF DI DCA I DPOINT /STORE CDF L ISZ DPOINT ISZ CPOINT TAD XMEXP MQL /MQ WAS DESTROYED BY SHIFT ISZ XTAL /MORE? JMP XLOOP CIF CDF P JMP I [EFUN3 XMEXP, 0 CPOINT, 0 DPOINT, 0 XTAL, 0 PAGE /&6 / FADC / FOCAL OVERLAY FUER DVM /BEREICH FIX 10V, MESSZEIT EINSTELLBAR /MESSZEIT EINSTELLEN: S Z=FADC(T) [MESSZEIT=10E-T] /MESSUNG STARTEN: S Z=FADC(S) /MESSWERT AUSLESEN: S Z=FADC(R) /MESSEN UND AUSLESEN: S Z=FADC(Q) [OHNE INTERRUPT] /INTERRUPT HANDLER SETZT VARIABLE "#" = 0 XADC0, CLA CDF 10 TAD I [CHARLY CDF 0 TAD (-"T SNA JMP FATIME IAC SNA JMP FASETM IAC SNA JMP FAREAD IAC SNA JMP FAMESS ERROR1 FATIME, TCCL TINTEG AND (3 TAD (64 TCSF CLA TCEI JMP FAEXIT FASETM, CLA IAC TCEI TCME JMP FAEXIT FAMESS, TCCL TCME TCSD JMP .-1 /&7 FAREAD, TCRB /HO-ZAHL+SIGN(AC1)+SIGNCHANGE(AC2) RTL /VORZEICHENWECHSEL ? SPA JMP FASCHG /JA RAR /VORZEICHEN MERKEN DCA FASGN /FASGN NEGATIV WENN ZAHL POSITIV TAD FASGN RAR /HO-BCD DESTILLIEREN AND (777 MQL /IN MQ STECKEN TCRB /LO-BCD IM AC JMS I (DOUBCD /UMWANDELN CDF 10 DCA I [HORD /HO-BIN IM AC, LO IM MQ CLA SWP DCA I [LORD DCA I [OVER2 TAD (27 /BEI INTEGERN IST EXP=27(8) DCA I [EXP CDF 0 TAD FASGN /VORZEICHEN DRAN SPA CLA JMP .+3 TPUSHJ MMINSK /MACHT FLAC NEGATIV FAEXIT, CIF CDF 10 JMP I [EFUN3 FASCHG, TCRB CLA CDF 10 DCA I [EXP DCA I [HORD DCA I [LORD DCA I [OVER2 CDF 0 JMP FAEXIT FASGN, 0 /&8 /THIS IS THE FIRST PART OF THE FX FUNCTION /"COMMON TO DIS" DUMP; THIS PART USES SUBROUTINE MAXEXP /TO DETERMINE LARGEST EXPONENT, WHICH IS USED FOR SCALING /TO AN INTEGER IN PART 2: FXLOWA FXLOW, TPOPA /GET BACK COMMON START DCA MAXPNT TAD MAXPNT TPUSHA /BACK IN PDL FOR FXLOWA JMS MAXEXP /GET LARGEST EXP JMP I (FXLOWA /MAX EXP IS IN MQ MAXEXP, 0 TAD [-400 /SEARCH THROUGH 256 NUMBERS IN FCOM DCA MAXTAL CLA CLL CML RAR /4000 IN AC MQL /4000 IN MQ; VERY SMALL, VERY NEGATIVE EXP. JMP MXGEXP MXLOOP, ISZ MAXPNT ISZ MAXPNT ISZ MAXTAL /FINISHED ? SKP /NO JMP I MAXEXP /YES; EXIT WITH MAX.EXP. IN MQ MXGEXP, TAD I MAXPNT /NEXT EXP. SZA /IS IT 0 ? JMP MAXSAM ISZ MAXPNT /YES TAD I MAXPNT /LOOK AT MANTISSA SZA CLA SKP /0 IS A GOOD EXP JMP MXLOOP+1 /NUMBER IS 0, IGNORE CMA TAD MAXPNT DCA MAXPNT MAXSAM, SAM /COMPARES SIGNED NUMBERS CLA CLL SGT /NEW EXP. BIGGER ? SKP /YES JMP MXLOOP /NO; GET NEXT TAD I MAXPNT /LOAD NEW EXP IN MQ MQL JMP MXLOOP MAXPNT, 0 MAXTAL, 0 /&9 /FOURIER FUNCTION - FIELD 0 PART; MAIN ROUTING IN FIELD 1 /"FOUR" USES 256 DATA POINTS STORED IN FCOM(0-255); /FOR LESS DATA FILL ARRAY WITH ZEROS; /TRANSFORMED SPECTRUM STORED IN FCOM(256-511) FOUEXP, TAD I (FOUXJ0 /GET START OF X BUFFER DCA MAXPNT JMS MAXEXP /GET LARGEST EXPONENT OF X NUMBERS CLA MQA DCA I (FOUXEX /STORE IT FOR SCALING PURPOSES CIF CDF P JMP I (FOUX0 /BACK TO FIELD 1 PAGE FOUJ0, TAD FOUXJ0 /GET START OF X BUFFER DCA FOUXJ DCA FOUJ /INIT. FOUNX, TAD I FOUXJ ISZ FOUXJ CIA /SCALE IT RELATIVE TO X-MAX TAD FOUXEX DCA FOUSFT /MAX SHIFT IN EAE IS 32 TAD FOUSFT AND [7760 /BUT IF SHIFT GREATER THAN 15 SZA CLA /WE CAN SET X=0 JMP FOUSFT+1 TAD I FOUXJ ASR FOUSFT, 0 ISZ FOUXJ SNA /IF X IS ZERO THERE IS NO CONTRIBUTION JMP FOUNJ /TO THE SUM; GET NEXT X SPA /SEPARATE SIGN AND VALUE OF X JMP .+4 DCA FOUX DCA FOUSIG JMP .+5 CIA DCA FOUX CMA DCA FOUSIG /SIG=0,-1 FOR X POS,NEG TAD FOURET /SET UP FIRST RETURN OF FOUCC-SR DCA FOUCC DCA FOUSCS /SET SWITCH TO "COS" CDF P TAD I (FOUS /GET CURRENT S VALUE CDF L SKP /&10 FOUCC, 0 /S IN AC; CALCULATE COS(Z) (SIN(Z)) MQL MUY /Z=K*PI/2 FOUJ /K=S*J/N=KQ.KR SHL 1 /KQ IN AC; KR IN MQ;S IN PARTS OF 1/16 TAD FOUSCS /FOR SCS=3 SIN(Z) IS CALCULATED DCA FOUKQ /KQ MODULO 4 = QUADRANT OF Z MQA DCA FOUKR /KR IS FRACTION OF Z BETWEEN 0 AND PI/2 DCA FOUSGN /INIT TAD FOUKQ /QUADRANT-TEST ON ANGLE: RAR SNL CLA JMP .+6 /QUADRANT 0 OR 2: KR OK TAD FOUKR /QUADRANT 1 OR 3: SET KR=1-KR CMA /(THAT IS: TAKE PI/2 MINUS ANGLE) DCA FOUKR IAC DCA FOUSGN TAD FOUKQ /QUADRANT-TEST ON SIGN: RTR SZL CLA JMP .+6 /1 OR 2: NEG CMA /0 OR 3: POS TAD FOUSGN SPA CIA DCA FOUSGN /SGN=0,1 FOR COS NEG,POS TAD FOUKR /CALCULATE Z MQL MUY FOUPIH /PI/2 DCA FOUZ /(MAX VALUE 6204) TAD FOUZ /CALCULATE COSINE MQL MUY /COS(Z)=1-A*Z^2*(1-B*Z^2) - TO 0.2% FOUZ DCA FOUZZ /Z SQUARED TAD FOUZZ MQL MUY FOUB /B*Z^2 CIA /1-B*Z^2 MQL MUY FOUA /A*(1-B*Z^2) MQL MUY FOUZZ /Z^2*A*(1-B*Z^2) SHL 2 /SCALING FOR "1 MINUS ..." CMA /1-A*Z^2*(1-B*Z^2) DCA FOUCOS /&11 TAD FOUSIG /GET SIGN OF X*COS;STORE IT IN GT FLAG TAD FOUSGN MQL LSR 1 /GT FLAG =1 WHEN SIGN POS TAD FOUX /COMPUTE X(J)*COS(S*J) MQL MUY FOUCOS SGT DCM /IS NEG ASR 10 /TO PREVENT OVERFLOW OF SUM CIF CDF P JMP I FOUCC /PRODUCT IN AC+MQ FOUNJ, ISZ FOUJ /NEXT J TAD FOUJ TAD [-400 /J=256? SPA CLA JMP FOUNX /NO; CALC. NEXT PRODUCT CIF CDF P /YES; TO NEXT S JMP I (FOUNS FOUJ, 0 FOUX, 0 FOUXEX, 0 FOUXJ, 0 FOUXJ0, 1000 FOURET, FOUSTR FOUSCS, 0 FOUSIG, 0 FOUSGN, 0 FOUZ, 0 FOUZZ, 0 FOUPIH, 6221 FOUA, 3762 FOUB, 2306 FOUKQ, 0 FOUKR, 0 FOUCOS, 0 MPRINT, 0 CIF CDF P JMS I [CPRNT JMP I MPRINT PAGE CMST=. ZBLOCK 2000 /&12 /HERE ARE THE ROUTINES FOR SAVING AND CALLING /COMMON(NUMBER) AND DISPLAY (PICTURE) FILES /LIB NUMBER NAME.EX LOADS COMMON FILE /LIB NUMBER NAME.EX,E SAVES (ENTERS) COMMON FILE /LIB PICTURE NAME.EX CALLS DISPLAY FILE /LIB PICTURE NAME.EX,E SAVES DISPLAY FILE /NUMBER ASSUMES .FN EXTENSION;PICTURE ASSUMES .FP EXTENSION *4000 PICTUR, CLA CLL CML RTL /616+2=620=.FP , LINK=0 SKP NUMBER, CLL CML /SET LINK FOR NUMBER TAD (0616 /.FN DCA EXTENSION /SAVE ASSUMED EXTENSION SZL /PICTURE? CMA /NO DCA PICFLG /REMEMBER WHICH CMA DCA ECHFLG /HERE IT SHOULD BE CALLED ENTERFLAG JMS I [NAME JMS I [GTMON JMS I [HANDAD LIBBLK-1 /SO WE CAN STILL I/O ISZ ECHFLG /CHECK IF WE WANT TO SAVE JMP PNSAV /YES TAD [NAMLOC DCA USR1+2 DCA USR1+3 TAD DEVNO CIF P USR1, JMS I USR 2 /LOOKUP NAMLOC /POINTER TO NAME 0 ERROR1 /FILE NOT THERE TAD USR1+2 DCA PNHAND+3 TAD USR1+3 TAD [4 /CHECK FOR CORRECT LENGTH SZA CLA ERROR1 /SOMEBODY HAS BEEN FOOLING AROUND! ISZ PICFLG /DO WE WANT TO CALL A PICTURE? JMP .+6 /YES TAD (1001 /NO,COMMON FILE DCA PNHAND+1 /READ 8 PAGES, FORWARD,FLD 0 TAD (CMST /INTO COMMON BUFFER DCA PNHAND+2 JMP PNHAND /GO READ /&13 TAD (1021 /READ 8 PAGES,FORWARD,FLD 2 DCA PNHAND+1 TAD [DISFIL /INTO DISPLAY FILE DCA PNHAND+2 PNHAND, JMS I LIBHND 0 0 0 JMP DERR JMP EXITOS /TO PROC VIA DISMISS PNSAV, JMS I [OCHK /CLOSE ANY OPEN FILES TAD [NAMLOC DCA USR2+2 DCA USR2+3 TAD [100 /WRITE 4 BLOCKS TAD DEVNO CIF P USR2, JMS I USR 3 /ENTER NAMLOC 0 ERROR1 TAD USR2+2 /SAVE TENTATIVE START DCA PNHAND+3 TAD [4 /CLOSE 4 BLOCKS DCA USR3+3 TAD DEVNO CIF P USR3, JMS I USR 4 /CLOSE NAMLOC 0 ERROR1 ISZ PICFLG /PICTURE? JMP .+6 /YES TAD (5001 /NO;NUMBER DCA PNHAND+1 /WRITE 8 PAGES,FORWARD,FLD. 0 TAD (CMST /FROM COMMON BUFFER DCA PNHAND+2 JMP PNHAND TAD (5021 /WRITE 8 PAGES,FORWARD,FLD. 2 DCA PNHAND+1 TAD [DISFIL /FROM DISPLAY DCA PNHAND+2 CDF DI DCA I FILPNT CDF L JMP PNHAND FILPNT, FILSWI PICFLG, -1 /&14 /UTILITY FOR INTERFACING /BINARY TO BCD ROUTINE (3 BCD DIGITS ) /FROM DEC'S UTILITY ROUTINES BINBCD, 0 CIF CDF 30 JMS I .+2 JMP I BINBCD BINBC3 /IN FIELD 3 PAGE /&15 /PS/8 FOCAL FILE ROUTINES RESTORE,TSPNOR /'OPEN RESTORE' COMMAND TAD CHAR /SAVE COMMAND CHAR (3 WORD COMMAND!) TPUSHA TGETC TESTRM /GO TO END OF COMMAND WORD SKP CLA JMP .-3 CLA CLL CMA /INITIALIZE ECHO SWITCH DCA ECHFLG JMS I [NAME /JUST TO SET ECHO MODE TPOPA TAD [-"I /OPEN RESTORE INPUT? SNA JMP I [IRST /YES TAD ["I-"O /NO, MUST BE OUTPUT SZA CLA ERROR1 /NEITHER ONE! JMP I [ORST OCLOSE, 0 /CLOSE THE OPEN OUTPUT FILE TAD OPNFLG SNA CLA /DON'T BOTHER IF IT ISN'T OPEN JMP I OCLOSE TAD [232 /WRITE '^Z' JMS NOCHAR TAD OPTR1 /PAD BUFFER WITH ZEROS TAD (-3400 /(AND WRITE IT OUT) SZA CLA JMP .-4 TAD DEVHLD /SAVED DEVICE # IOF CIF 10 JMS I USR 4 /CLOSE ONMTMP /POINTER TO SAVED NAME BLKCNT, 0 /FILE LENGTH (BLOCKS);ZEROED BY OOPEN ERROR1 /HUH? DCA OPNFLG /CLEAR 'FILE OPEN' FLAG ION CDF 10 TAD [XOUTL /RESTORE TELETYPE OUTPUT ROUTINE DCA I [OUTDEV CDF JMP I OCLOSE /DO WHATEVER ELSE NEEDS TO BE DONE /&16 NOCHAR, 0 /PS/8 3/2 BUFFERED CHARACTER OUTPUT JMS I (FLDSET /CALLED FROM EITHER FIELD DCA CCIF /SAVE CALLING FIELD CDF TAD ATEM /CHARACTER TO BE OUTPUT AND (377 /MASK OUT GARBAGE ISZ O3 /WHICH CHAR OF THREE?;-3 INITIALLY JMP O2 /STRAIGHT PACKING JMS RT /HALF WORD PACKING - PACK FIRST HALF TAD ATEM /GET SAVED ARG JMS RT /PACK SECOND HALF CLA CLL CMA RTL /RESET 3-WAY SWITCH DCA O3 ISZ OCHCT /BUFFER CAN ONLY BE FILLED WITH 3RD CHAR OF 3 JMP CCIF /NOT FULL YET, RETURN TO CALLING ROUTINE JMS I [PUTDEV /TELL THE MONITOR THIS HANDLER'S IN CORE OUTHND-1 /POINTER TO DEVICE # AND ENTRY CLA CLL TAD OLNGTH /-MAXIMUM ALLOWABLE LENGTH TAD BLKCNT /LENGTH SO FAR SZL CLA /HAS HE GONE TOO FAR? JMP OOVER /YES, KILL HIM IOF JMS I OUTHND /WRITE ONE BLOCK BUFFER 4200 3400 OBLK, 0 /SET BY OOPEN JMP DERR /DEVICE ERROR ISZ OBLK /BUMP OUTPUT BLOCK ISZ BLKCNT /AND COUNT OF BLOCKS SO FAR JMS OSETUP /RESET POINTERS FOR NEXT BUFFER ION JMP CCIF O2, DCA I OPTR1 /NORMAL PACKING IS EASY! ISZ OPTR1 /BUMP POINTER CCIF, HLT /FILLED WITH CIF CDF JMP I NOCHAR /&17 O3=. /WHY NOT? RT, 0 /HALF-WORD PACK ROUTINE CLL RTL RTL DCA ATEM /SAVE FOR SECOND HALF TAD ATEM AND [7400 TAD I OPTR2 /ADD IN CHARACTER IN RIGHT HALF DCA I OPTR2 /PACK IT ISZ OPTR2 /BUMP POINTER AGAIN JMP I RT OOVER, DCA OPNFLG /HE BLEW IT - KILL THE FILE!! TAD DEVHLD IOF CIF 10 JMS I USR 4 ONMTMP 0 /LENGTH OF ZERO TO DELETE O7600, 7600 /IGNORE ERRORS ERROR1 /BECAUSE WE ALREADY KNOW ABOUT THEM OSETUP, 0 /RESET ALL THE POINTERS (WHAT FUN!) TAD OBLK-1 DCA OPTR1 TAD OBLK-1 DCA OPTR2 CLA CLL CMA RTL DCA O3 TAD O7600 DCA OCHCT JMP I OSETUP OPTR1, 0 OPTR2, 0 OLNGTH, 0 /SET BY OOPEN OCHCT, 0 IOWAIT, 0 /WAIT FOR TTY TO FINISH ION CDF P TAD I (TELSW /BUSY FLAG IS 0 WHEN THROUGH SZA CLA JMP .-2 CDF L IOF JMP I IOWAIT PAGE /&18 *5400 OOPEN, JMS I [IOWAIT /WAIT FOR TELETYPE TO FINISH (DECTAPES ARE SLOW!) JMS I [OPEN /CALL USR, HANDLER; ENTER OUTPUT FILE YINT, OUTBLK-1 /OUTPUT HANDLER BLOCK 3 /MONITOR 'ENTER' CODE YBLK, JMP TTYOUT /'OPEN OUTPUT TTY:' JMP I (OCLCHK /ERROR ON ENTER - SEE IF FILE ALREADY OPEN JMS I [DISMISS /KICK USR OUT TPUSHF /SAVE NAME AND EXTENSION NAMLOC TPOPF ONMTMP TAD STBLK /STARTING BLOCK DCA I (OBLK /IN NOCHAR TAD FLNGTH /-MAXIMUM ALLOWABLE LENGTH DCA I (OLNGTH /IN NOCHAR JMS I (OSETUP /SET UP PACKING POINTERS CLA CLL CMA /THERE'S A FILE OPEN! DCA OPNFLG TAD DEVNO /SAVE FOR CLOSE DCA DEVHLD DCA I (BLKCNT /DITTO ORST, TAD OPNFLG /ENTRY FOR 'OPEN RESTORE OUTPUT' SNA CLA /IF 'OPEN OUTPUT', FLAG IS ALREADY SET ERROR1 /NO OUTPUT FILE TO RESTORE CDF 10 ISZ ECHFLG /SKIP IF NO ECHO TAD IBLK+2 /(SKP CLA) DCA I (OUTECH /SET OUTPUT ROUTINE TAD (OCHAR /POINTER TO FILE OUTPUT ROUTINE CIF CDF 10 DCA I [OUTDEV /FOR EACH CHAR. TO NOCHAR ION JMP I [PROC /FINISH THE LINE TTYOUT, TAD [XOUTL /SWITCH OUTPUT TO TELETYPE (INTERRUPT) JMP .-5 MINTEG, 0 /INTEGER FAKE CIF CDF P JMS I [XINTEG JMP I MINTEG /&19 ICHAR, 0 /GET A CHARACTER FROM A FILE CLA CLL /MAKE SURE ISZ INCHT /DO WE NEED ANOTHER BUFFER?;-1 INITIALLY JMP I RDPTR /NO, UNPACK THE CHARACTER IOF JMS I INHND /YES, GO GET IT 0200 3000 IBLK, 0 /SET BY IOPEN SMA CLA /ONLY BOTHER WITH FATAL ERRORS SKP CLA JMP DERR /WE'VE GOT ONE ION ISZ IBLK /BUMP TO NEXT BLOCK TAD IBLK-1 /AND RESTORE POINTERS DCA IPNTR TAD [7200 DCA INCHT ICHAR1, TAD I IPNTR /STRAIGHTFORWARD UNPACK ROUTINE JMS RDPTR /DO COMMON CRAP ICHAR2, TAD I IPNTR /SAVE LEFT HALF FOR LATER AND [7400 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 [7400 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 /IF YOU DIDN'T KNOW, THIS IS A COROUTINE! AND [177 /ISN'T THAT AMAZING? SNA /IGNORE NULLS AND PARITY JMP ICHAR+1 TAD (-32 /END OF FILE? (^Z) SZA JMP .+5 /NO DCA IPNFLG /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 (MIGHT COME IN HANDY) CIF CDF 10 JMP I ICHAR /&20 ITEMP, 0 IPNTR, 0 INCHT, 0 /SET TO -1 BY IOPEN ONMTMP, ZBLOCK 4 FILEST, TAD I XCHAR /HERE'S WHERE FILES START!! DCA CHAR /GET NEXT CHAR CDF TAD (604 /SET '.FD' ASSUMED EXTENSION DCA EXTENSION TSPNOR /SKIP SPACES TAD CHAR /SAVE COMMAND CHAR TPUSHA TGETC TESTRM /GO TO END OF COMMAND WORD SKP CLA JMP .-3 TPOPA TSORTJ /GO DO COMMAND FILIST-1 FILGO-FILIST ERROR1 /OOPS - BAD 'O' COMMAND MGETLN, 0 /CROSS FIELD FAKE CIF CDF P JMS I (PGETLN JMP I MGETLN PAGE /&21 IOPEN, JMS I [IOWAIT /WAIT FOR TELETYPE (DECTAPES ARE STILL SLOW!) JMS I [OPEN /CALL THAT AMAZING GENERAL-PURPOSE SUBROUTINE INBLK-1 2 /MONITOR 'LOOKUP' JMP TTYIN /'OPEN INPUT TTY:' ERROR1 /WHOOPS - FILE NOT FOUND JMS I [DISMISS /BOOT THE USR OUT TAD STBLK /SET POINTERS AND OTHER CRAP DCA I (IBLK /IN ICHAR CLA CLL CMA DCA IPNFLG CLA CLL CMA DCA I (INCHT /IN ICHAR IRST, TAD IPNFLG /'OPEN RESTORE INPUT' COMES HERE SNA CLA /FLAG IS SET ALREADY IF 'OPEN INPUT' ERROR1 /NO INPUT FILE TO RESTORE TAD (ICHARF /SET I/O POINTERS CIF CDF 10 DCA I [INDEV ISZ ECHFLG /AND ECHO MODE TAD (PRINTC DCA I (CHIN+6 ION JMP I [PROC TTYIN, TAD (XI33 /'OPEN INPUT TTY:' JMP TTYIN-7 PCHK, 0 /ENTRY WITH UPDATE VALUE FOR PDL TAD PDLXR DCA PDLXR TAD PDLXR CIA CLL TAD (END0 /CHECK FOR PDL OVERFLOW SNL CLA JMP I PCHK TAD (PSHBOT DCA PDLXR CDF L ERROR1 MPUSHA, 0 /PUSH AC ON STACK JMS FLDSET /CALLED FROM EITHER FIELD CDF DI DCA ACDF CMA JMS PCHK TAD ATEM /SET BY FLDSET DCA I PDLXR CMA TAD PDLXR DCA PDLXR ACDF, CIF CDF L JMP I MPUSHA /&22 MPD2L, 0 /FIELD 0 ENTRY CLA CMA TAD I MPD2L ISZ MPD2L JMS MPD2 JMP I MPD2L MPD2, 0 /PUSH FOUR WORDS DCA AUTO3 TAD [-4 JMS PCHK TAD [-4 DCA XCNTR JMS FLDSET DCA .+1 HLT TAD I AUTO3 /GET ONE WORD CIF CDF DI DCA I PDLXR /STORE ONE FCIF, CIF CDF L ISZ XCNTR /MORE TO GO? JMP .-6 /YES TAD [-4 TAD PDLXR /RESET PDL DCA PDLXR TAD FCIF-4 DCA .+1 HLT JMP I MPD2 MPD3L, 0 CLA CMA TAD I MPD3L ISZ MPD3L JMS MPD3 JMP I MPD3L MPD3, 0 /POP 4 WORDS DCA AUTO3 TAD [-4 DCA XCNTR JMS FLDSET DCA FCDF CLA CLL CMA RAL /(-2)TO MAKE CDF TAD FCDF DCA .+3 CDF DI TAD I PDLXR HLT DCA I AUTO3 ISZ XCNTR JMP .-5 FCDF, HLT JMP I MPD3 /&23 MPOPA, 0 JMS FLDSET DCA .+3 CDF DI TAD I PDLXR HLT JMP I MPOPA PDLSET, 0 /TO RESET PDL TAD (PSHBOT DCA PDLXR CIF CDF P JMP I PDLSET FLDSET, 0 DCA ATEM TAD FCIF RDF JMP I FLDSET PAGE /&24 /LIBRARY COMMAND PROCESSOR /****** STORAGE ALLOCATION MAP ****** /***** ***** /* 200 FELD (MAGNET FUNCTION)+FX(COMTODIS) PART 2 /* 400 XADC0 (DVM FUNCTION)+FOURIER PART 1 /* 600 FOURIER (PART 2:FOUCC)+FX(COMTODIS) PART 1 /* 1000 COMMON BUFFER /* 3000 INPUT BUFFER (PAGE 1) /* 3200 INPUT BUFFER (PAGE 2) /* 3400 OUTPUT BUFFER (PAGE 1) /* 3600 OUTPUT BUFFER (PAGE 2) /* 4000 PICTUR,NUMBER,BINBCD /* 4200 FILES (OUTPUT AND RESTORE),IOWAIT /* 4400 INPUT HANDLER /* 5000 OUTPUT HANDLER /* 5400 FILES (INPUT AND OPEN) /* 5600 PUSHDOWN LIST CONTROLS, IOPEN /* 6000 NAME, GTMON, DISMISS /* 6200 HANDAD, COMPARE, INTERRUPT(FLD.0) /* 6400 LOWLIB, SAVER, RETURN /* 6600 CHAINER, FETCHER, GOSUB /* 7000 OPEN, BUMP, DOUBCD /* 7200 LIBRARY HANDLER /***** ***** /************************************ NAME, 0 /READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV' JMS DISMIS /'GETC' WON'T WITH THE USR IN CORE TAD (5723 /CODE FOR 'DSK:' DCA NEWDEV /(DEFAULT DEVICE) DCA NEWDEV+1 JMS GNAME /GET FIRST PART (MIGHT BE DEVICE) 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+4 /GET FILENAME GNAME, 0 /READ A NAME INTO 'NAMLOC' DCA NAMLOC /CLEAR NAME AREA DCA NAMLOC+1 /(DON'T CLEAR ASSUMED EXTENSION) DCA NAMLOC+2 TAD [NAMLOC /INITIALIZE POINTERS DCA NMBASE CLA CMA DCA PERDSW DCA NAMECT TSPNOR SKP /&25 NAMEC, TGETC /MAIN LOOP TAD CHAR /LOWER FIELD COPY, OF COURSE TAD [-". /EXTENSION? SNA JMP PERD /YES, CLEAR DEFAULT EXTENSION TAD [".-", /COMMA? SNA CLA JMP ECHCHK /YES, CHECK FOR ECHO ECHGO, JMS DECODE /MUST BE A-Z, 0-9 JMP I GNAME /IT WASN'T, MUST BE END OF NAME SZL /RESTORE CHARACTER TAD [57 IAC /6-BIT ASCII DCA DECODE /TEMPORARY STORAGE TAD NAMECT /NO MORE THAN 6 CHARACTERS/NAME TAD [-6 SMA CLA /DON'T MOVE;DISMIS USES 7700 JMP NAMEC TAD NAMECT /BUILD POINTER TO CHARACTER POSITION CLL RAR TAD NMBASE DCA TT TAD DECODE /LEFT OR RIGHT HALF? SZL BSW BSW /LEFT, SHIFT OVER TAD I TT /ADD IN OTHER HALF DCA I TT ISZ NAMECT /BUMP COUNT JMP NAMEC /CONTINUE LOOP 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 [4 JMP NAMEC-3 /&26 ECHCHK, TGETC /MOVE PAST COMMA TSPNOR TAD CHAR /MUST BE FOLLOWED BY 'ECHO' TAD [-"E SZA CLA JMP I GNAME DCA ECHFLG /SET ECHO FLAG TGETC /MOVE TO END OF WORD JMS DECODE JMP I GNAME CLA CLL JMP .-4 DECODE, 0 /CHECK FOR A-Z, 0-9 TAD CHAR /IF YES ISZ RETURN TAD [-"9-1 CLL TAD ["9+1-"0 SZL JMP DCDYES /NUMBER;CHAR-260;L=1 TAD ["0-"Z-1 CLL CML TAD ["Z-"A+1 SNL DCDYES, ISZ DECODE /ALPHA;CHAR-301;L=0 JMP I DECODE NMBASE, 0 PERDSW, 0 NAMECT, 0 TT, 0 MPUSHJ, 0 /FIELD ZERO PUSHJ TAD I MPUSHJ ISZ MPUSHJ CIF CDF P JMS I [PUSH1 JMP I MPUSHJ /&27 XGETC, 0 /FAKE CIF CDF P JMS I [MGETC TAD I XCHAR CDF L DCA CHAR JMP I XGETC GTMON, 0 /LOCK THE USR IN CORE IOF /(NOP IF ALREADY IN CORE) CDF L CIF P JMS I USR 10 TAD [200 /SET POINTER FOR LATER CALLS DCA USR JMP I GTMON DISMIS, 0 /IF THE USR IS IN, KICK IT OUT CLA CLL TAD USR /CHECK POINTER TO FIND OUT SPA CLA JMP I DISMIS IOF CIF P JMS I USR 11 TAD ECHGO+10 /RESET POINTER DCA USR JMP I DISMIS PAGE /&28 /HANDAD CALL: HANDAD /SLOT /SETS DEVNO; DEVICE NO. IN SLOT; ENTRYPOINT IN SLOT HANDAD, 0 /LOADS HANDLER INTO PROPER SLOT TAD I HANDAD /WHICH SLOT? ISZ HANDAD DCA SLOT JMS 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 AUTO5 TAD I AUTO5 /(SET BY 'COMPARE') DCA DEVNO /MOVE DEVICE # (FOR SAVE AND CLOSE) TAD AUTO5 /POINTS TO DEVICE # DCA .+2 JMS I [PUTDEV /SO USR KNOWS IT'S IN CORE 0 JMP I HANDAD 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 JMS I [GTMON /WE MUST CALL THE 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 IAC /TWO PAGE HANDLER! DCA DLOAD CIF P JMS I USR /CALL MONITOR (ALREADY IN CORE) TABCPT, 1 /FETCH BY NAME DEVC, 0 /NAME 0 /RETURNS DEVICE NO. DLOAD, 0 /RETURNS ENTRY POINT ERROR1 /DEVICE NOT AVAILABLE CLL /&29 TAD DLOAD /ENTRY POINT FOR HANDLER TAD [200 /IF THIS HANDLER IS IN PAGE 7600, SZL CLA /DON'T BOTHER TO CHECK FOR LEGALITY JMP HANDOK /SYSTEM HANDLER TAD DLOAD /IF THE HANDLER WAS NOT LOADED AND INTR76 /(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 I [PUTDEV /TELL USR THE HANDLER IS NOT DEVC+1 /IN CORE ANYMORE JMP RETRY /LOAD IT THIS TIME 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 HANDAD COMPARE,0 /COMPARE TWO BLOCKS OF INDEFINITE LENGTH TAD I COMPARE /CALLING SEQUENCE: ISZ COMPARE /JMS COMPARE DCA XCNTR / -# OF WORDS TO CHECK TAD I COMPARE / FIRST-1 ISZ COMPARE / SECOND-1 DCA AUTO5 /RETURN IF NO MATCH TAD I COMPARE /RETURN IF MATCH ISZ COMPARE DCA AUTO6 AGAIN, TAD I AUTO5 /COMPARE TWO WORDS CIA TAD I AUTO6 SZA CLA JMP I COMPARE /NO MATCH ISZ XCNTR /FINISHED? JMP AGAIN /NO, CHECK NEXT TWO ISZ COMPARE /YES, BUMP RETURN POINTER JMP I COMPARE /&30 LOADER, JMS I [NAME /THIS IS FOR CHAINING TO ANOTHER PROGRAM TAD [2326 /EXTENSION "SV" IS FORCED ON DCA EXTENSION /:IT HAS TO BE A SAVE FILE FOR USR CHAIN JMS I [OCLOSE /DON'T FORGET TO CLOSE THE FILES TAD [NAMLOC /POINTER TO NAME DCA .+5 IAC /USR CHAIN EXPECTS IT TO BE ON SYS: DEV.#1 CIF P JMS I USR 2 /LOOKUP RETURNS FILE START IN ARG.2 NAMLOC 0 ERROR1 /USR DID NOT FIND IT TAD [6 /OK! CHANGE USR FUNCTION TO CHAIN = 6 DCA .-5 JMP .-10 /BY-BY!! WILL SEE YOU SOME OTHER TIME! INTSTO, DCA ACSV /FLD L INTERRUPT HANDLER GTF DCA FLAGS DRIS /CHECK INTERRUPTS FROM PLOTTER CIF CDF DI SZA CLA JMP I INTPLO CIF CDF P JMS I INTRPD INTRET, CLA CLL TAD FLAGS RTF /INHIBITS INTERRUPT TILL NEXT JMP INTR76, 7600 /CLA;REFERENCED TAD ACSV JMP I 0 INTPLO, PLOINT ACSV, 0 FLAGS, 0 COMLIST,"S /SAVE "C /CALL "R /RUN "D /DELETE "G /GOSUB " /FAKE A 'LIBRARY RETURN' WITH A SPACE "E /EXIT "N /NUMBER;COMMON FILE "P /PICTURE;DISPLAY FILE "L /LOAD; CHAIN A PROGRAM -1 PAGE /&31 /ACTUAL LIBRARY PROCESSOR /STARTING WITH COMMAND DECODE: LOWLIB, DCA CHAR /CURRENT CHAR COMES DOWN IN AC TAD CHAR /SAVE FOR COMMAND SORT TPUSHA TAD [603 /'.FC' ASSUMED EXTENSION DCA EXTENSION SKP CLA /MIGHT BE A TERMINATOR ALREADY TGETC /MOVE TO END OF COMMAND WORD TESTRM SKP JMP .-3 TPOPA /RESTORE COMMAND CHAR TSORTJ /AND BRANCH TO APPROIATE ROUTINE COMLIST-1 COMPO-COMLIST ERROR1 /SORRY, CHARLIE! COMPO, SAVER FETCHER CHAINER BUMP GOSUB RETOUR C7600, 7600 NUMBER PICTUR LOADER SAVER, JMS I [NAME /GET NAME FOR SAVE JMS SAVPR /DO IT JMP EXITOS /EASY, WASN'T IT? SAVPR, 0 /CALLED BY 'SAVER' AND 'GOSUB' JMS I [OCHK /CLOSE OUTPUT FILE TO AVOID TROUBLE TAD [NAMLOC /POINTER TO NAME DCA SAVEPT CDF 10 TAD I [BUFR /GET PROGRAM LENGTH MQL JMS I [GTMON /CALL THE MONITOR JMS I [HANDAD /AND THE HANDLER LIBBLK-1 CDF T MQA /PROGRAM LENGTH DCA I (LINE0-1 /SAVE IT WITH IT MQA /&32 AND C7600 /MASK OFF CLL RAR /CONVERT TO PAGES DCA BLOCK /FOR HANDLER TAD BLOCK /ROUND UP TO BLOCKS TAD [100 AND C7600 CLL RTR RAR DCA RECORD /FOR MONITOR 'ENTER':BITS 0-7 TAD RECORD /GET DESIRED LENGTH TAD DEVNO /(SET BY 'HANDAD') CDF L CIF P JMS I USR /ENTER OUTPUT FILE 3 SAVEPT, NAMLOC 0 ERROR1 /NO ROOM ON DEVICE TAD RECORD /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 /CLOSE NAMLOC SAVBLK, 0 /NO. OF BLOCKS 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 TAD (4041 /GET FUNCTION WORD TAD BLOCK /HOW MUCH TO WRITE DCA BLLL JMS I LIBHND BLLL, 0 /WRITE (BLOCK) BLOCKS FROM FIELD 2 200 /FROM 200 UP POINT4, 0 JMP DERR /GO COMPLAIN ABOUT DEVICE JMP I SAVPR /&33 LIBLEN, 0 /SAVED LENGTH LIBDEV, ZBLOCK 2 RECORD, 0 BLOCK, 0 RETOUR, TPOPA /GET BACK ALL THE JUNK WE SAVED CDF 10 /FOR THE LAST GOSUB DCA I XCHAR /IN-LINE CHARACTER CDF TPOPF /DEVICE NAME NEWDEV TPOPA /FILE LENGTH DCA FLNGTH TPOPA /STARTING BLOCK DCA STBLK JMS I [HANDAD /GET THE HANDLER BACK LIBBLK-1 JMP I (LOADGO /LOAD THE PROGRAM OCLOSR, JMS I [OCLOSE /CLOSE OUTPUT FILE CIF CDF P JMP I [PROC /ANOTHER EASY ONE! GETDEV, 0 /GET DEVICE TYPE FROM MONITOR TABLE TAD (7757 /DCB-1 TAD DEVNO DCA BLOCK CDF P TAD I BLOCK CDF L JMP I GETDEV FOCTXT, FILENAME FOCAL.TM /USED BY GOSUB PAGE /&34 /LOOKUP AND LOAD ROUTINES CHAINER,IAC /THESE ALL DO THE SAME THING GOSUB1, IAC /AND THEN GO TO DIFFERENT PLACES FETCHER,IAC CDF 10 DCA I [GOSWITCH CDF LOAD, JMS I [OPEN /CALL THE HANDLER AND LOOKUP THE FILE LIBBLK-1 2 JMP .+5 /TTY: NOT A DIRECTORY DEVICE ERROR1 JMS I [DISMISS JMS I (GETDEV /GET DEVICE TYPE SMA CLA ERROR1 /NOT A DIRECTORY DEVICE TGETLN /SOME COMMANDS HAVE LINE NUMBERS LOADGO, JMS I [DISMISS /ONLY USED BY 'RETURN' TAD STBLK /BLOCK TO READ FROM DCA POINT6 TAD (17 /20 OCTAL PAGES;20200-24177 TAD FLNGTH /NOW COMPARE WITH LENGTH OF FILE SPA CLA ERROR1 /PROGRAM TOO LONG CDF 10 CLA CLL CMA RAL /(=-2) TAD I [GOSWITCH /IS THIS A GOSUB? SZA CLA JMP .+7 /NO, SKIP THIS GARBAGE TAD I XCHAR /YES, SAVE PROGRAM NAME, ETC. CDF TPUSHA /PDL NOW CONTAINS: TAD [215 /CHAR,DEVICE,FILE LENGTH,START BLOCK CDF 10 DCA I XCHAR CDF TAD FLNGTH /COMPUTE FUNCTION WORD CIA CLL RTL RTL RTL CLL CML RAL /SET TO SEARCH FORWARD TAD (40 /FIELD 2 DCA LENF1 JMS I LIBHND /GET THE PROGRAM LENF1, 1221 200 POINT6, 0 JMP DERR /&35 TAD NEWDEV /SAVE THIS STUFF SO WE DCA I (LIBDEV /KNOW WHERE WE ARE TAD NEWDEV+1 DCA I (LIBDEV+1 TAD STBLK DCA LIBFIL TAD FLNGTH DCA I (LIBLEN CDF T TAD I (LINE0-1 /MOVE PROGRAM LENGTH CDF P DCA I [BUFR CDF L JMP EXITOS /GO TO APPROPRIATE ROUTINE GOSUB, TAD LIBFIL /CHECK FOR CURRENT PROGRAM SZA JMP NOSAVE /NO NEED TO SAVE CORE TPUSHF /MOVE 'FOCAL.TM' TO NAME AREA FOCTXT TPOPF NAMLOC TAD (5723 /DEVICE 'DSK' FOR SAVE DCA NEWDEV DCA NEWDEV+1 JMS I (SAVPR /SAVE FILE (THIS WILL LEAVE USR IN CORE) TAD [603 /RESET EXTENSION TO 'FC' DCA EXTENSION JMS I [DISMISS /KICK MONITOR OUT TO SAVE TAD LIBFIL /STARTING BLOCK NOSAVE, TPUSHA /'LIBFIL' STILL IN AC TAD I (LIBLEN TPUSHA TPUSHF LIBDEV JMP GOSUB1 XTSPNOR,0 /DUPLICATE UPPER FIELD ROUTINE TAD CHAR TAD [-240 SZA CLA JMP I XTSPNOR TGETC JMP XTSPNOR+1 TTYTXT, DEVICE TTY /HANDY THING TO HAVE /&36 MSORTJ, 0 /ANOTHER DUPLICATE CIA DCA ATEM TAD I MSORTJ ISZ MSORTJ DCA AUTO4 TAD I AUTO4 SPA JMP MSEX TAD ATEM SZA CLA JMP .-5 TAD AUTO4 TAD I MSORTJ DCA ATEM TAD I ATEM DCA ATEM JMP I ATEM MSEX, ISZ MSORTJ CLA CLL JMP I MSORTJ FILIST, "I /INPUT "O /OUTPUT "C /CLOSE "R /RESTORE PAGE /&37 /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 CLA CLL CMA /INITIALIZE ECHO FLAG TO OFF DCA ECHFLG JMS I [NAME /GET DEVICE AND FILENAME JMS I [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 [NAMLOC /POINTER TO NAME DCA NAMPT JMS I [GTMON JMS I [HANDAD /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 THROUGH ON ERROR) TAD DEVNO /DO THE CALL CIF 10 /DEV # IN AC JMS I USR /2: LOOKUP CALL, 0 /3: ENTER NAMPT, NAMLOC /POINTER TO NAME;RETURNS START BLOCK LNGTH, 0 /RETURNS -FILE LENGTH IN BLOCKS;TENTATIVE FOR ENTER JMP OTHER-2 /LET THE CALLING ROUTINE DECIDE ERROR PROCEDURE TAD LNGTH /MOVE PARAMETERS TO PAGE ZERO DCA FLNGTH TAD NAMPT DCA STBLK JMP OTHER-3 /AND TAKE NORMAL RETURN /&38 ERROR, 0 /LOWER FIELD ERROR ROUTINE JMS I [DISMIS /MAKE SURE TAD ERROR /FAKE OUT ERROR ROUTINE CIF CDF 10 /AND GO TO IT DCA I (ERR2 JMP I (ERR2+1 BUMP, JMS I [NAME /DELETE IS AN EASY ONE (THANK GOD!) JMS I [GTMON JMS I [HANDAD LIBBLK-1 JMS OCHK /CLOSE ANY OPEN OUTPUT FILE CIF 10 /DELETE THE FILE TAD DEVNO JMS I USR 4 NAMLOC 0 ERROR1 DCA LIBFIL /IN CASE HE JUST DELETED THIS PROGRAM JMP EXITOS OCHK, 0 /IF ANY FILE EXISTS, CLOSE IT TAD DEVHLD SZA CLA JMS I [OCLOSE JMP I OCHK OCLCHK, TAD OPNFLG /MAKE 'OPEN OUTPUT' WITH AN ALREADY OPEN FILE SNA CLA /THE SAME AS 'OUTPUT CLOSE;OPEN OUTPUT' ERROR1 JMS I [OCLOSE TAD (YINT /FAKE OUT 'OPEN' DCA OPEN JMP OTHER PUTDEV, 0 /TELL THE MONITOR A HANDLER IS IN OR OUT TAD I PUTDEV /GET POINTER TO DEV# AND ENTRY DCA ERROR TAD I ERROR /DEVICE# ISZ ERROR /BUMP POINTER TO ENTRY TAD (7646 /MONITOR TABLE DCA OCHK /POINTER TO 'HANDLER IN CORE' FLAG TAD I ERROR /FLAG IS HANDLER ENTRY CDF P /TABLE IS IN FIELD ONE DCA I OCHK CDF L ISZ PUTDEV JMP I PUTDEV /&39 MSORTC, 0 /CHECK FOR TERMINATOR CIF CDF P JMS I (TERMER ISZ MSORTC JMP I MSORTC FILGO, IOPEN OOPEN OCLOSR RESTOR /UTILITY FOR FUNCTIONS /DOUBLE PRECISION BCD-BIN - EAE VERSION DOUBCD, 0 /LO-BIN IN AC;HOBIN IN MQ CIF CDF 30 JMS I .+2 JMP I DOUBCD DOUBC3 /IN FIELD 3 PAGE /&40 /GET OUT THE PAGE 0 LITERALS > FIELD 2 IFNZRO LIBLST <XLIST>