Directory of image this file is from
This file as a plain text file
/LIBRARY AND FILE COMMAND PROCESSOR: /****** STORAGE ALLOCATION MAP ****** /***** ***** /* 1200 2ND INPUT BUFFER /* 1600 THE OUTPUT BUFFER /* 2200 STACK LIVES HERE /* 3000 PUSHDOWN ROUTINES /* 3200 MAIN INPUT BUFFER /* 3600 MAIN INPUT HANDLER /* 4200 THE LIBRARY HANDLER /* 4600 THE OUTPUT HANDLER /* 5200 2ND INPUT HANDLER /* /* 5600 FILE OUTPUT, CLOSE & ABORT /* 6000 OPEN, RESTORE & FILE INPUT /* 6200 TABULATE, HANDLER & SETDHT /* 6400 DECODER, DATER, SAVER, GOSUB /* 6600 RUN,CALL,BRANCH,RETURN,LJUMP /* 7000 LIBRARIAN, IOWAIT /* 7200 OPEN, DISMISS & COMPARE /* 7400 GTNAME /***** ***** /************************************ / INITIAL TEXT FOR U/W-FOCAL FIELD 2 PAGE 1 0 /PROGRAM LENGTH 5051 /'()' FOR TDUMP LINE0, 0 /POINTER TO NEXT 0 /LINE NO. ZERO TEXT "C U/W-FOCAL:" TITLE, TEXT "VER-4E" /'?M'=CODED CR DATE, TEXT "15.10.78?M" LINE1= DATE+5 /NULLS BECOME SPACES *100 ZBLOCK 2 /PC0 FOR COMMAND MODE
/PAGE ZERO STORAGE HAS BEEN CAREFULLY ARRANGED ! FIELD 0 PAGE 0 INITLZ /INTERRUPT SERVICE ROUTINE CIF P JMP I [INTRPT /PATCH 177 FOR POWER FAIL PRNTC, RMF /RETURN FROM THE INTERRUPT I0N CL0SE, 5600 /'JMP I 0' USR, 7700 //POINTER TO MONITOR (200 IF IN CORE) K77, 77 //LOCATION 7 FOR PLOTTER ROUTINES AUTO, ZBLOCK 4 /AUTO-INDEX REGISTERS ICHARX, ICHAR0 /USE THE REMAINING ONES OFFSET, ICHAR-XI33 /FOR THE EXTRA FEATURES SCHARX, SCHAR0-ICHAR0 *20 NONAME, LPUSHF /INSERT VERSION NO. AFTER 'ERASE' H0RD, VERSION LPOPF XCHAR, NAMLOC-1 /STRATEGICALLY LOCATED! IOWAIT, SP1 /POINTER TOO! DCA GOSW /SET RETURN POINTER JMS TEMP /THEN UPDATE HEADER DCA LIBFLG /ZAP 'PROGRAM SAVED' FLAG TAD GOSW /RETURN FOR LOAD CALLS EXIT, TAD GOJUMP /NORMAL RETURNS='JMP I (PROC' DCA GOSW DISMISS /REMOVE THE USR CDI P I0N GOSW, [DERR /LOWER FIELD ERROR ROUTINE DISMISS /CLEARS AC (JMP 135) TAD GOSW /(RELOCATE FOR LINC INTERRUPTS) CDI P DCA I [ERROR /SIMULATE A 'JMS' JMP I [ERROR+1 GOJUMP, JMP I K177-1 /PLUS (GOSW) *HORD VERSION,TEXT "16K-V4"
LGOSUB /-1 CONT / 0 K177, START /+1 GOTO+1 /+2 NEWDEV, ZBLOCK 4 /'NEWDEV-1'='TELSW' FLNGTH= .-2 STBLK= .-1 /'LIBBLK-1'='BUFR' LIBBLK, ZBLOCK 2 /FOR DEVICE NAME 4201 /LOAD POINT DEVNO, 0 /FOR DEVICE # LIBHND, ERTRAP /HANDLER ENTRY CHAR, [7200 /LOWER FIELD COPY NAMLOC, ZBLOCK 4 /(MUST BE 'CHAR+1') EXTENSION=.-1 DSK, 5723 /HASH CODE FOR DEFAULT DEVICE LIBDEV, ZBLOCK 4 LIBFLG= .-1 /REFERENCE VIA P77 *100 PC0, 0 /ENTRY AND RESTART POINT JMP I 0 /INITIALIZE (ONCE ONLY) SWAP, CLA CLL IAC /POINTER TO SWAP ROUTINE JMP EXIT *.+2 /FOR COMPATIBILITY TEMP, [7400 /UPDATE THE HEADER CIF T JMP NUHEAD+1 SINBLK, ZBLOCK 2 5201 /4201 PATCHED BY PLOT 0 SINHND, 0 SPOINT, 0 D, DATE-1 XNAME, NAMLOC INBLK, ZBLOCK 2 3601 0 INHND, GOSW /REREAD TRAP OUTBLK, ZBLOCK 2 4601 FILDEV, 0 OUTHND, 0 OUTFLG, 0 *PRINTC&177 ERROR0= JMS I . /='PRINTC' TRAP ERROR1= JMS GOSW
/SECONDARY INPUT ROUTINES: THE 'O S' AND 'O R S' COMMANDS /IN THE ABSENCE OF THE PLOTTER ROUTINES THERE ARE NO RE- /STRICTIONS ON THE SECOND INPUT FILE, BUT THE ADDITION OF /THESE ROUTINES LIMITS THE 'L' COMMANDS TO THE USE OF THE /<SAME> DEVICE - OR ANY HANDLER CO-RESIDENT WITH THE SYS- /TEM DEVICE, SUCH AS 'RKB0', OR 'DTA1' IN A 'TD8E' SYSTEM. *200 SINPUT, CLL CMA /USE THE REGULAR LOOKUP ROUTINE JMS I [OPEN SINBLK-1 ERROR0 /FILE MISSING JMP I CRT /PATCHED BY SCOPE OVERLAY TAD STBLK DCA SBLK SM1 DCA SINFLG SRST, TAD SINFLG SNA CLA ERROR0 /NOTHING LEFT TAD SCHARX *CR TAD ICHARX /ENTRY POINT FOR 'O I', 'O R I' CDF P DCA I INP /CHANGE THE FILE INPUT POINTER JMP I TTY INP, FILIN TTY, TTYIN-1 CRT, TTYIN /OR 'OSCOPE' END, ENDCHK SEND, 0 /POINTS TO NEXT STEP JMS I END /CHECK FOR THE EOF SINFLG, 0 /'FILE OPEN' FLAG SCHAR0, ISZ SINFLG /BUFFER EMPTY? JMP I SEND /NO, GET THE NEXT CHARACTER I0F JMS I SINHND /READ ANOTHER BLOCK 0200 1200 /2200 PATCHED BY PLOT SBLK, 0 SMA CLA /FATAL ERROR? SKP CLA JMP I [DERR TAD [-600 DCA SINFLG /RESET THE WORD COUNTER ISZ SBLK /ADVANCE THE BLOCK NO. TAD SBLK-1 DCA SPOINT /AND RESTART FROM THE TOP I0N
SCHAR1, TAD I SPOINT /UNPACK THE BUFFER JMS SEND TAD I SPOINT /SAVE UPPER 4 BITS AND [7400 DCA I SBLK-1 ISZ SPOINT /POINT TO THE NEXT TAD I SPOINT JMS SEND TAD I SPOINT /NOW TO PUT THE PIECES ISZ SPOINT /ALL TOGETHER AGAIN AND [7400 CLL RTR RTR TAD I SBLK-1 RTR RTR JMS SEND JMP SCHAR1 /ROUND & ROUND & ROUND WE GO ///// LPTDEV, XOUTL; ZBLOCK 2 /CHANGE THESE 3 LOCATIONS TO THE /DEVICE LPT /ENTRY POINT AND THE DEVICE NAME LPTCHK, [PDLXR /CHECK FOR CALLS TO 'LPT:' SM2 COMPAR /NOW CHECK IT LPTDEV NEWDEV-1 JMP I LPTCHK /NOT WHAT WE'RE LOOKING FOR ISZ LPTCHK /RETURN WITH THE ENTRY POINT TAD LPTDEV /(INSERT OTHER CODE HERE - FOR EX: JMP I LPTCHK /A CHECK FOR THE ',E' OPTION,ETC.)
/THE STACK, TTY BUFFER & ERROR TRAP ALL LIVE HERE *3024 /BEGINNING OF THE STACK PCHK, ["0 /STACK OVERFLOW CHECK CDF P TAD I [PDLXR /ADJUST FIELD 1 X-REGISTER DCA PDLXR /BACKUP & COPY TAD PDLXR DCA I [PDLXR TAD PDLXR /CHECK FOR OVERFLOW STL CIA TAD (2200 /2600 PATCHED BY PLOT CDI L SPA SNA SZL CLA /-10 = L-P JMP I PCHK PDERR, TAD .-3 /TOO BAD! JMP EXIT+1 /USE 'CDI L' AS THE ERROR CODE MPUSHF, 0 /PUSH 4 WORDS ON THE STACK TAD PDERR-2 /LOWER FIELD ENTRY TAD PCHK+1 /UPPER FIELD ENTRY DCA FCDF CLL CMA TAD I MPUSHF /BACKUP POINTER ISZ MPUSHF DCA AUTO TAD [-4 JMS PCHK TAD [-4 DCA PCHK FCDF, CDF L P /CHANGE TO CALLING FIELD TAD I AUTO CDF S DCA I PDLXR /LOAD STACK ISZ PCHK JMP FCDF /WITH FOUR WORDS SP2 TAD FCDF /CHANGE 'CDF' TO 'CDI' DCA .+1 CDI L P JMP I MPUSHF APUSHX, DCA MPOPF /PUSH THE AC ON THE STACK SM1 JMS PCHK TAD MPOPF DCA I PDLXR CDI P JMP I (XPUSHA+3 /ONLY USED BY FIELD 1
*.&7757 TBUF, ZBLOCK 20 /TELETYPE OUTPUT BUFFER MPOPF, 0 /POP 4 WORDS TAD I MPOPF DCA AUTO JMS PCHK /COPY THE PDLXR TAD [-4 DCA PCHK TAD I PDLXR DCA I AUTO CDF P ISZ I [PDLXR /FAKE A FIELD 1 USE CDF L ISZ PCHK JMP .-6 ISZ MPOPF JMP I MPOPF TRAP, 0 /RECOVER FROM SELETED ERRORS DISMISS TAD TRAP DCA GOSW /ASSUME NORMAL ERROR EXIT SP2 CDF P ISZ I (NAGSW /WAS A LINE NUMBER GIVEN? JMP EXIT /YES, FALL INTO THE TRAP JMP GOSW+1 /NO, DO THE USUAL STUFF REKOVR, 0 /CONTINUATION OF ERROR ROUTINE KCC TAD (-17 DCA TBUF TAD (TBUF DCA PDLXR DCA I PDLXR /CLEAR OUT THE TTY BUFFER ISZ TBUF JMP .-2 TAD I SWAP /CHECK CORE-SWAP FLAG SNA CLA JMS I SWAP /RESTORE THE SCRATCH AREA TAD [CR /PRINT A CR AHEAD OF ERROR MESSAGE CLA /OR 'JMS I PRNTC' TAD REKOVR /LET 'EOF' RESTORE THE TTY CDI P DCA I [EOF JMP I (EOF+1 /THEN GO PRINT THE ERROR MESSAGE PAGE 26
/INITIALIZE THE VARIABLES AND THE DATE INITLZ, ZBLOCK 20 /CLEAR ANNOYING FLAGS SM8 /PATCH FOR MULTI-8 JMP .+4 6770 /GET THE TIME-OF-DAY JMS I MV1 /REVERSE HRS, MINUTES DCA MV1-4 /INITIALIZE RANDOM NO. TAD .+3 JMS MOVE /LOAD COMMAND DECODER AREA .+1-MV1 RELOC RANDOM-16 PUTV, .-1 /SUBROUTINE TO LOCATE VARIABLES DCA THISOP /SAVE THE NAME DCA LORD /CLEAR SUBSCRIPT PUSHJ GS1 /DO THE LOOKUP POPF FLAC /GET THE VALUE FENT FPUTIPT1 /STORE IT FEXT TAD LASTV /ADVANCE THE POINTER DCA FIRSTV CIF L JMP I PUTV /RETURN RANDOM, 0;4421;3040;1;0 /RANDOM ENOUGH? RELOC MV1, SM1 /SET THE ADDRESS POINTERS TAD I (FIRSTV /USING THE VALUE HERE DCA I (SECRTV TAD I (FIRSTV DCA I (LASTV
JMS SETV /CALL OUR FIELD 1 ROUTINE PI;2011 SP2 TAD I (LASTV DCA I (DIMEN /FOR DOUBLE SUBSCRIPTING JMS SETV FPZ;4100 /! JMS SETV FPZ;4200 /" SP2 TAD I (LASTV DCA I (FSFP /FOR FSF'S JMS SETV FPZ;4300 /# JMS SETV FPZ;4400 /$ JMS SETV FPZ;4500 /% JMP FINALZ /'NOP' FOR MORE JMS SETV FPZ;4600 /& JMS SETV FPZ;7200 /: JMS SETV FPZ;3400 /\ JMP .+3 /SINGLE QUOTE IS OUT FPZ;4700 /' FINALZ, CIF T JMS I (DATA /SET THE DATE WORDS JMS I (ENVIR /CHECK THE ENVIRONMENT KSF /KEYBOARD INPUT? JMP NONAME /NO JMP SWAP /YES: LEAVE VERSION ID FPZ= TBUF /FLOATING POINT ZERO PI, 2;3110;3755;2421
SETV, 0 /CROSS-FIELD CALL CDF L TAD I SETV /GET THE DATA VALUE ISZ SETV DCA .+2 LPUSHF /SAVE IT ON THE STACK 0 TAD I SETV /NOW GET THE NAME ISZ SETV CDI P JMS I (PUTV /AND INSERT IT JMP I SETV /DF=P MOVE, 0 /CLEVER LITTLE ROUTINE DCA AUTO TAD I MOVE DCA PC0+1 ISZ MOVE CDF L TAD I MOVE /WHERE ITS AT CDF P DCA I AUTO /WHERE ITS GOING ISZ PC0+1 /COVER OUR TRACKS JMP MOVE+4 ISZ MOVE JMP I MOVE /DF=P PAGE 15 /CHECK THE RUN-TIME ENVIRONMENT: 7777 /BIPCCL POINTER XI33+1 /RELOCATION POINTER ENVIR, 0 TAD I ENVIR-2 /ARE WE RUNNING UNDER SOMETHING? RTL /2000=BATCH, 1000=RTS8 SNL SMA CLA /EITHER BATCH OR RTS8? JMP VIDEO /NO, CHECK SCOPE MODE TAD ENVIR-1 /GET RELOCATION POINTER JMS I .+12 /CHANGE TO NON-INTERRUPT I/O .+1-MV2 RELOC XI33+2
/XI33, 0 / KSF /ANY INPUT? JMP .-1 /WAIT UNTIL THERE IS JMS KCHK TAD INBUF /HERE IT IS DCA XOUTL KCC DCA INBUF /CLEAR INPUT FLAG TAD XOUTL JMP I XI33 XOUTL, MOVE TLS /THIS IS ALL WE NEED! 7600 /'CLA' = MONITOR EXIT JMS KCHK /CHECK FOR INPUT TSF /BUFFER FULL? JMP .-1 JMP I XOUTL BYEBYE, CDI /RETURN TO OS/8 JMP I XOUTL+2 /OR TO BATCH... "P-"C POPX, JMS KCHK /CHECK INPUT AFTER A 'POPJ' JMP I .+1 XPOPJ "C&277 KCHK, POPX /KEYBOARD CHECK KSF JMP I KCHK /NOTHING WAITING KRS AND P177 SNA JMP I KCHK /IGNORE NULLS TAD M20 SNA /CTRL P? JMP M20+2 TAD POPX-1 SNA /CTRL C? JMP BYEBYE TAD KCHK-1 /SET PARITY DCA INBUF /SAVE THE INPUT JMP I KCHK RELOC MV2, TAD .-20 /PATCH 'POPJ' DCA I (POPJ&177 TAD .-21 /MOVE 'KSF' DCA I ENVIR-1 /INTO PLACE
/ DISABLE ALL THE 'IONS' DCA I [ERROR+1 DCA I (4333 /FRA CDF L DCA GOSW-1 DCA I (247 /SINPUT DCA I (OECHO-1 DCA I (ICHAR1-1 TAD MV3-5 /NOP DCA I (TAB+10 DCA I (IOWATE+2 / CHECK FOR BATCH TAD I ENVIR-2 /IS BATCH RUNNING? RAL SMA CLA JMP VIDEO /NO, CHECK SCOPE MODE TAD I ENVIR-2 AND .+16 /GET THE BATCH FIELD TAD .+16 /ADD 'CIF' DCA .+15 /SET UP THE INSTRUCTION TAD ENVIR-1 /CHANGE TTY TO BATCH I/O JMS I ENVIR+20 /=MOVE .+1-MV3 RELOC XI33+2 /XI33, 0 / CIF BF /CHANGE TO THE BATCH FIELD JMS I BATIN /READ FROM THE BATCH STREAM ERROR2 /NOTHING LEFT! TAD XOUTL-1 /CAST OUT LINEFEEDS SNA JMP XI33+1 TAD CLF JMP I XI33 -LF XOUTL, 70 /OUTPUT TO THE BATCH LOG CIF /'PATCHED FOR BATCH' 7000 /'NOP' = BATCH EXIT JMS I BATOUT JMP I XOUTL BATIN, 5400 BATOUT, 7400 RELOC
MEMSIZ= CDI T V /SELECT THE HIGHEST FIELD MV3, TAD .-6 /MOVE THE 'CDI' INSTR DCA I ENVIR-1 /TO 'XI33+1' TAD .-10 /AND THEN TO 'BYEBYE' DCA I (BYEBYE /TO CATCH CTRL/C'S TAD MV2-4 DCA I (BATXIT /FIX UP THE ERROR ROUTINE TAD .-14 TAD (-MEMSIZ /CHECK MEMORY SIZE SPA SNA CLA ERROR1 /NOT ENOUGH MEMORY! VIDEO, CDF 10 TAD I (17726 /DO WE HAVE A VIDEO TERMINAL? AND [200 SNA CLA JMP .+6 /NO, LEAVE RUBOUT ALONE TAD (TAD START DCA I (RUB1+3 TAD (ECHOC /YES, USE 'BS', 'SP', 'BS' DCA I (RUB1+4 SKP DCA I (MODLN /REMOVE LINENO PRINTOUT CDF L JMP I ENVIR PAGE
/ FILE CLOSING AND OUTPUT ROUTINES PAGE 27 /'JMP I 0' CLOSER, 0 /CLOSE OR REMOVE THE FILE DCA TEMP /SET THE 'CALL' FLAG TAD OUTFLG /IS THERE AN OPEN FILE? SNA CLA JMP I CLOSER /NO, IGNORE THE COMMAND TAD O2 /WHICH COMMAND? SNA CLA JMP REMOVE /'ABORT' TAD [232 /'CLOSE' JMS NOCHAR /INSERT A 'CTRL/Z' GETSIZ, SNL SMA /POINTS TO 'MGETA' JMP .-2 /AND PAD WITH ZEROS ISZ TEMP /CHECK CALLING FLAG JMP NOSIZE REMOVE, JMS I GETSIZ /GET THE CLOSING LENGTH, IF ANY STL /ONLY 'O A' & 'O C' HAVE SIZES TAD OLNGTH /COMPARE WITH THAT AVAILABLE SNL SZA CLA ERROR1 /BETTER LUCK NEXT TIME TAD I [LORD /GET THE SIZE BACK SZA /ZERO MEANS 'AS IS' DCA BLKCNT /ENTRY POINT FOR OVERFLOW ERROR NOSIZE, CDF P /RESTORE OUTPUT TO THE ECHO DEVICE TAD I [ECODEV DCA I [OUTDEV /THE USR MUST NOT BE IN CORE! JMS I IOWAIT /WAIT FOR TELETYPE (RESETS DF) JMS I [SETDHT /SET THE ENTRY POINT FOR 'CLOSE' FILDEV-1 / POINTER TO DEVICE # AND ENTRY CIF 10 TAD FILDEV /SAVED DEVICE NO. JMS I USR 4 ONMTMP /FILE NAME POINTER BLKCNT, 0 /CURRENT FILE LENGTH OLNGTH, 0 /MAXIMUM " " TAD OUTFLG SNA CLA ERROR1 /FILE WAS TOO LONG DCA OUTFLG /CLEAR THE 'FILE OPEN' FLAG JMP I CLOSER /ALSO CALLED BY 'SAVE' & 'DELETE' ABORT, DCA O2 /'OUTPUT ABORT' COMMAND DCA BLKCNT CLOSE, SM1 /'OUTPUT CLOSE' COMMAND JMS CLOSER /L=1 JMP EXIT /SIMPLE - ONCE YOU KNOW HOW!
NOCHAR, 0 /OS/8 3/2 BUFFERED CHARACTER OUTPUT AND (377 /MASK OUT GARBAGE ISZ O2 /WHICH CHAR OF THREE? JMP O1 /STRAIGHT PACKING JMS O2 /HALF WORD PACKING - PACK 1ST HALF TAD O3 /GET SAVED ARG JMS O2 /PACK SECOND HALF SM3 /RESET 3-WAY SWITCH DCA O2 /BUFFER CAN ONLY BE FILLED WITH ISZ OUTFLG /THE 3RD CHARACTER OF 3 JMP O1+2 /NOT FULL YET TAD OLNGTH /CHECK THE FILE SIZE TAD BLKCNT /AMOUNT USED SO FAR SNL CLA /HAVE WE GONE TOO FAR? JMP NOSIZE-1 /YES, DELETE THE FILE I0F JMS I OUTHND /WRITE ONE BLOCK BUFFER 4200 1600 /5200 PATCHED BY PLOT OBLK, 0 JMP I [DERR /DEVICE ERROR ISZ OBLK /BUMP OUTPUT BLOCK ISZ BLKCNT /AND COUNT OF BLOCKS SO FAR JMS O3 /RESET POINTERS FOR NEXT BUFFER JMP I NOCHAR /L=1 O1, DCA I OPTR1 /NORMAL PACKING IS EASY! ISZ OPTR1 /BUMP POINTER CLL JMP I NOCHAR /L=0 O2, 0 /HALF-WORD PACK ROUTINE CLL RTL RTL DCA O3 /SAVE FOR SECOND HALF TAD O3 AND [7400 TAD I OPTR2 /ADD IN CHARACTER IN RIGHT HALF DCA I OPTR2 /PACK IT ISZ OPTR2 /BUMP POINTER AGAIN JMP I O2 O3, 0 /RESET THE OUTPUT POINTERS SM3 DCA O2 TAD OBLK-1 DCA OPTR1 TAD OPTR1 DCA OPTR2 TAD [-200 /X3 = 384 CHARACTERS/BUFFER DCA OUTFLG JMP I O3 /'SM3' SETS THE LINK OPTR1, 0 /PACKING POINTERS OPTR2, 0
JMS NOCHAR /'OUTPUT BUFFER' COMMAND DUMPER, TAD OUTFLG /DUMPS THE OUTPUT BUFFER SNL SZA CLA /L=0 INITIALLY JMP DUMPER-1 JMP EXIT /PAD WITH ZEROS AND EXIT ILNGTH XLEN, TAD OLNGTH /FUNCTION TO CHECK FILE LENGTH TAD BLKCNT /(MINUS THE AMOUNT USED SO FAR) CIA SKP TAD I XLEN-1 /FUNCTION TO CHECK INPUT SIZE CDI P JMP I .+1 FL0AT /THIS IS THE 'OPEN OUTPUT' COMMAND: TTYOUT OUTPUT, STL CMA /SET ECHO FLAG AND CALL=3 JMS I [OPEN /CALL USR, HANDLER; ENTER FILE OUTBLK-1 /OUTPUT HANDLER BLOCK ERROR0 /ENTER ERROR: CLOSE FILE & RETRY? JMP I OUTPUT-1 /'OPEN OUTPUT TTY:' (OR JUST 'O O') TAD FLNGTH /MAXIMUM ALLOWABLE LENGTH CIA DCA OLNGTH TAD STBLK /STARTING BLOCK DCA OBLK JMS O3 /SET UP PACKING POINTERS DCA BLKCNT LPUSHF /SAVE THE FILE NAME FOR CLOSING NAMLOC LPOPF ONMTMP-1 /CODE SPILLS ACROSS THE PAGE *FLOUTP-1 /FUDGE TO SAVE A WORD OR TWO JMP ORST BLKNO, 0 ILNGTH, 0 ORST, TAD OUTFLG /'OPEN RESTORE OUTPUT' COMMAND SNA CLA /FLAG IS CHARACTER COUNT ERROR0 /NO OUTPUT FILE TO RESTORE TAD OFFSET /POINTER TO FILE OUTPUT ROUTINE TTYOUT, TAD [XOUTL /SWITCH OUTPUT TO THE TELETYPE CDF P /ENTRY POINT FOR INTERNAL HANDLERS DCA I [OUTDEV ISZ GOSW /SKIP IF NO ECHO TAD OCHAR0+2 /'TAD ENDCHK' DCA OECHO /SET OUTPUT ROUTINE JMP EXIT /FINISH THE LINE TTYP, XI33 /TTY INPUT INDEV
/THE 'OPEN' AND 'RESTORE' COMMANDS AND FILE INPUT/OUTPUT SCANER OCMND, JMS I .-1 /'O' COMMAND ENTRY - SKIP TO NEXT TAD DOTDA DCA EXTENSION /SET '.DA' CMA DCA GOSW /INITIALIZE THE ECHO SWITCH LJUMP /GO DO COMMAND FILIST-1 FILEGO-FILIST ERROR1 /OOPS - BAD 'O' COMMAND RESTOR, CDF P /'O R' COMMANDS - GET NEXT LETTER TAD I XCHAR DCA TEMP /SAVE COMMAND LETTER GTNAME /CHECK FOR ECHO AND LINE NUMBER TAD TEMP DCA CHAR LJUMP /SORT OUT "I", "O", OR "R" ORLIST-1 ORGO-ORLIST ERROR1 /BAD 'RESTORE' COMMAND DOTDA, 401 /WAS 604 FOR '.FD' /THE 'OPEN INPUT' COMMAND: INPUT, CLL CMA /INITIALIZE ECHO AND SET 'CALL'=2 JMS I [OPEN /CALL THAT AMAZING INBLK-1 /GENERAL-PURPOSE SUBROUTINE ERROR0 /WHOOPS - FILE NOT FOUND JMP TTYIN /'OPEN INPUT TTY:' (OR JUST 'O I') TAD FLNGTH DCA ILNGTH /FOR 'FLEN' AND 'FRA' TAD STBLK DCA BLKNO RERD, TAD BLKNO /'OPEN RE READ' COMMAND DCA IBLK /FIRST BLOCK NO. SM1 /RESET FILE POINTERS DCA INFLG /CHARACTER COUNTER IRST, TAD INFLG /'OPEN RESTORE INPUT' COMMAND SNA CLA /CHECK CHARACTER COUNT ERROR0 /NO INPUT FILE TO RESTORE JMP I [CR /SET POINTER TO 'ICHAR0' (12K) TAD OFFSET /=ICHAR-XI33 TTYIN, TAD TTYP /'OPEN INPUT TTY:' CDF P DCA I TTYP+1 /= 'INDEV' ISZ GOSW /CHECK ECHO MODE TAD IRST+2 /= 'PRINTC' DCA I ECHOP JMP EXIT /RETURN /OFFSET,OCHAR-XOUTL /8K CONSTANT
OCHAR0, 0 /FILE OUTPUT VIA 'PRINTC' DCA ENDCHK /SAVE CHARACTER FOR ECHO TAD ENDCHK JMS I FILOUT /WRITE IT I0N OECHO, TAD ENDCHK /=0000 IF NO ECHO SNA ISZ OCHAR0 /SET NO ECHO RETURN CDI P JMP I OCHAR0 FILOUT, NOCHAR RDPTR, 0 /THIS IS A COROUTINE ! JMS ENDCHK /ISN'T THAT AMAZING ? INFLG, 0 ICHAR0, ISZ INFLG /DO WE NEED ANOTHER BUFFER? JMP I RDPTR /NO, UNPACK THE CHARACTER I0F JMS I INHND /YES, GO GET IT 0200 3200 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 I0N ICHAR1, TAD I IPNTR /STRAIGHT-FORWARD UNPACK ROUTINE JMS RDPTR /DO COMMON STUFF TAD I IPNTR /SAVE LEFT HALF FOR LATER AND [7400 DCA I IBLK-1 ISZ IPNTR /INCREMENT TO NEXT WORD TAD I IPNTR /ANOTHER EASY ONE JMS RDPTR TAD I IPNTR /THIS IS THE TRICKY ONE! ISZ IPNTR /GET LOW-ORDER HALF AND [7400 CLL RTR /SHIFT RIGHT RTR TAD I IBLK-1 /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 ... IPNTR, 0
ECHOP, IECHO /PROCESS THE CHARACTERS FROM EITHER INPUT FILE: ENDCHK, 0 /CALLED BY 'RDPTR' AND 'SEND' AND K177 /IGNORE PARITY SZA /NULL? JMP .+4 /NO ISZ ENDCHK /YES, TAKE THE 2ND EXIT AND JMP I ENDCHK /RETURN TO THE INPUT ROUTINE -32 TAD .-1 /END OF FILE? (^Z) SZA JMP .+5 /NO DCA I ENDCHK /YES, CLEAR 'FILE OPEN' FLAG CDF P /AND SET UP A CLEVER RETURN TAD [EOF /TO RESTORE THE KEYBOARD FOR DCA I TTYP+1 /INPUT AND FLAG THE ERROR AT TAD [232 /THE SAME TIME! THIS -ALSO- CDI P /REMOVES THE ^Z SO YOU DON'T JMP ICHAR+3 /GET A SECOND ERROR MESSAGE! *CDF L PLTDEV, XOUTL; ZBLOCK 2 /COULD BE USEFUL!
/TABULATE ROUTINES: CALLED FROM THE UPPER FIELD CR-SP TAB, CDI P /'PRINTC' TAB COUNTER SNA /TEST FOR CR DCA I [ERROR /RESET COUNTER SNA JMP CROUT TAD TAB-1 /CR-SP SMA /NON-PRINTING CHARACTERS ISZ I [ERROR /ADD 1 TO TAB COUNT (FIELD 1) I0N /TURN ON AFTER AN ERROR TAD [SP JMP CROUT+3 ZER, TASK SMA CLA /INITIAL ENTRY POINT JMP POS TAD I XCHAR /SAVE THE CURRENT CHARACTER DCA CHAR NEG, CDI P JMP SKPX /SKIP OVER ONE (OR MORE) ISZ I [LORD JMP NEG TAD CHAR DCA I XCHAR /RESTORE THE ORIGINAL ONE POS, CDI P TAD I [LORD /FIND OUT WHERE WE'RE GOING STL CIA TAD I [ERROR /SUBTRACT FROM WHERE WE ARE SNL CLA JMP I ZER /FORGET IT... TAD [SP JMS CPRNT /PRINT SPACES JMP POS *RMF 0 /'PRINTC' FOR LISTING AND DATE CDI P JMS CPRNT JMP I RMF
/LOAD A HANDLER INTO THE PROPER SLOT: (ENTRY AT 'HANDLR') 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 ERROR0 /DEVICE NOT AVAILABLE TAD DLOAD /CHECK IF THE HANDLER HAS BEEN AND [7600 /LOADED INTO THE PROPER PAGE CMA /'CIA' FOR 1-PAGE HANDLERS TAD I SLOT /DESIRED PAGE SZA CLA TAD DLOAD /WRONG PAGE! TAD [200 /IS IT THE SYSTEM HANDLER? SPA CLA /IF .GT. 7600 WE'RE OK JMP NOGOOD /SORRY, TRY IT AGAIN ISZ SLOT /BUMP POINTER TO DEVICE # TAD DEVC+1 /SAVE IT DCA I SLOT ISZ SLOT /MOVE TO ENTRY POINT TAD DLOAD DCA I SLOT /SAVE ENTRY TAD DEVC+1 HANDX, DCA TEMP /DEVICE NO. JMP I HANDLR NOGOOD, DCA DLOAD /CLEAR ENTRY POINT JMS SETDHT /TELL USR THE HANDLER DLOAD-2 /IS NOT IN CORE ANYMORE JMP RETRY /LOAD IT THIS TIME
*ECODEV HANDLR, 0 /AC = BLOCK POINTER DCA SLOT SM2 /IF THE HANDLER HAS THE SAME NAME, COMPARE /DON'T LOAD IT AGAIN SLOT, 0 NEWDEV-1 JMP NOTEQ /DIFFERENT NAMES, LOAD NEW HANDLER ISZ AUTO 2 /BUMP PAST LOAD POINT TAD AUTO 2 /(SET BY 'COMPARE') DCA .+2 JMS SETDHT /IN CASE USR RESET THE TABLE 0 TAD I AUTO 2 JMP HANDX /SAVE THE DEVICE NO. TTYDEV, DEVICE TTY /FOR COMPARISON PURPOSES *EOF SETDHT, 0 /SET THE DEVICE HANDLER TABLE TAD I SETDHT / (TO FAKE OUT THE USR) DCA PDLXR /POINTER TO DEVICE # AND ENTRY TAD (17646 /TABLE LOCATION TAD I PDLXR /PLUS DEVICE NUMBER DCA DEVC /POINTS TO 'HANDLER-IN-CORE' FLAG TAD I PDLXR CDF 10 DCA I DEVC /FLAG IS SIMPLY HANDLER ENTRY CDF L ISZ SETDHT JMP I SETDHT /ALSO CALLED BY 'CLOSER' /CHARACTER TABLE FOR LOWER-FIELD COMMANDS: KOMLST, CR-200 /RETURN ";-200 /DITTO "Z /ZERO "N /NAME "G /GOSUB "P /P??? FILIST, "L /LIST "A /ALL OR ABORT "C /CALL OR CLOSE "D /DATE OR DELETE "B /BR. OR BUFFER "E /EXIT OR EVERY ORLIST, "S /SAVE OR SECOND "R /RUN OR RESTORE "I /INPUT OR INITIAL "O /OUTPUT OR ONLY PAGE 32
/LIBRARY COMMANDS: SAVER, DELETR, CALLER, RUNNER, GOSUB *FPNT /ENTER VIA 'JMP I 7' LCMND, JMS SCANER /SAVE CHAR AND MOVE TO THE NEXT TAD (603 /SET '.FC' DCA EXTENSION DCA GOSW /POINT TO 'PROC' LJUMP /BRANCH TO THE APPROPRIATE ROUTINE KOMLST-1 KOMGO-KOMLST ERROR1 /SORRY, TRY AGAIN SCANER, (CALL /COMMAND WORD SCANNER CDI P TAD I XCHAR /SAVE CURRENT CHARACTER DCA CHAR JMS LSORT /SCAN TO THE END JMP I SCANER SAVER, GTNAME /'LIBRARY SAVE' COMMAND JMS TEMP /FILL IN THE HEADER JMS SAVE /DO IT JMP EXIT /DONE DELETR, JMS I CL0SE /'LIBRARY DELETE' COMMAND GTNAME TAD LBUFR /'LIBBLK-1' GETHND JMS LCLOSE JMP EXIT-2 LCLOSE, (OPENUP /SAVE OR DELETE A FILE DCA SAVBLK TAD DEVNO CIF 10 JMS I USR 4 NAMLOC SAVBLK, (20 ERROR0 /NOT THERE JMP I LCLOSE FOCLTM, FILENAME FOCAL.TM
GOSUB, LPUSHF /'LIBRARY GOSUB' COMMAND FOCLTM LPOPF /MOVE 'FOCAL.TM' TO NAME AREA NAMLOC-1 TAD DSK /IN CASE WE NEED TO SAVE IT DCA NEWDEV DCA NEWDEV+1 TAD LIBFLG /ARE WE ALREADY SAVED? SNA CLA JMS SAVE /NO TAD (603 DCA EXTENSION /RESET EXTENSION TO 'FC' /LOOKUP AND LOAD ROUTINES: SUBBER, SM3 /THESE ALL DO THE SAME THING AND RUNNER, CLL IAC /THEN BRANCH TO DIFFERENT PLACES CALLER, CLL IAC /LOAD HAS 5 POSSIBLE EXITS ! JMS I [OPEN /CALL THE HANDLER AND LOCATE FILE LBUFR, LIBBLK-1 /= 'BUFR' TOO LIB3, 3 /NOT THERE, NO NAME, OR ERROR1 /SOMETHING JUST AS STUPID JMS I (DEVCHK /FILE STRUCTURED? TAD GOSW /CHECK FOR GOSUB SPA CLA LPUSHF /SAVE CURRENT PROGRAM INFO. LIBDEV JMP LOADGO /'JMP I (LCHECK+2' FOR 8K GOBACK, LPOPF /RESTORE CALLING PROGRAM POINTERS NEWDEV-1 TAD LBUFR GETHND /GET THE HANDLER BACK LOADGO, JMS LOADER /READ THE PROGRAM CDF T /'CDI T' FOR INITIAL DIALOG TAD I D /CHECK PROGRAM I.D. SZA CLA / JMP I D /ENTER SPECIAL PROGRAM INITIAL,ERROR1 /(NONE RIGHT NOW) TAD I [200 /MOVE PROGRAM LENGTH CDF P DCA I LBUFR CDI L /RETURN TO: JMP EXIT-1 /PROC, START, GOTO, OR DO
SAVE, 0 /CALLED BY 'SAVER' AND 'GOSUB' JMS I CL0SE /AVOID TROUBLE CDF P TAD I LBUFR /GET PROGRAM LENGTH CDF T DCA I [200 /SAVE IT WITH THE PROGRAM LSHFT, SM1 TAD I [200 /COMPUTE FILE SIZE CDF L AND [7600 /MASK PAGE COUNT JMS I LSHFT /SHIFT IT IAC /ROUND UP TO BLOCKS CLL RAR DCA FLNGTH /SAVE GETMON /CALL THE MONITOR TAD LBUFR GETHND /GET THE HANDLER JMS I (DEVCHK /CHECK FOR STUPIDITY TAD LIB3 DCA I (CALL /SET UP OUR SUBROUTINE JMS I (OPENUP ERROR1 /NO ROOM OR WRITE-LOCKED TAD FLNGTH JMS LCLOSE /UPDATE DIRECTORY IN ADVANCE! TAD (20 /SET THE 'WRITE' BIT JMS LOADER /SAVE THE PROGRAM JMP I SAVE ///// LOADER, 0 /READ (OR WRITE) A PROGRAM TAD FLNGTH /COMPUTE FUNCTION WORD JMS I LSHFT /'SHFTL6' STL RAL /SET TO SEARCH FORWARD IFNZRO T < TAD (T > /ADD FIELD BITS (12K) DCA .+4 TAD STBLK DCA .+4 JMS I LIBHND /GET THE PROGRAM 0 200 /LOADS FROM 200 UP 0 /STARTING BLOCK NO. JMP I [DERR DISMISS /SO WE CAN USE THE STACK LPUSHF NEWDEV /SAVE NEW POINTERS LPOPF LIBDEV-1 /IN CASE WE 'GOSUB' JMP I LOADER PAGE
/THE 'OUTPUT DATE' COMMAND DATER, TAD [NODATE-1 DCA AUTO TAD [-4 DCA GOSW CDF T TAD I AUTO /GET DATE JMS I ZEROER-1 /OUTPUT IT ISZ GOSW JMP .-4 JMP EXIT /RETURN ///// DEVCHK, 0 /CHECK THE DEVICE TYPE TAD DEVNO TAD P17757 DCA JUMPER CDF 10 TAD I JUMPER CDF L SMA CLA ERROR1 /DEVICE IS NOT FILE STRUCTURED JMP I DEVCHK P17757, 17757 /DEVICE CONTROL WORD TABLE ///// JUMPER, 0 /SORT AND BRANCH SUBROUTINE JMS I IOWAIT /CLEAR AC, RESET DF, TURN IOF TAD I JUMPER /GET LIST ADDRESS ISZ JUMPER DCA AUTO TAD I AUTO SPA /END OF LIST ? JMP ERR STL CIA TAD CHAR SZA CLA /FOUND IT ? JMP .-6 /NO TAD AUTO TAD I JUMPER /ADD OFFSET DCA JUMPER TAD I JUMPER /POINT TO ENTRY DCA JUMPER ERR, CLA CLL /FALL THROUGH OFFSET JMP I JUMPER /L=0 /////
/LIBRARY COMMAND LIST: KOMGO, GOBACK /CR GOBACK /; ZEROER /Z NAMER /N GOSUB /G SCANER-1 /P LLIST /L LISTAL /A CALLER /C DELETR /D BRANCH /B 7600 /E SAVER /S RUNNER /R INITIAL /I /FILE COMMAND LIST FILEGO, LIST1 /O,L ABORT /A CLOSE /C DATER /D DUMPER /B ECOSET /E SINPUT /S RESTOR /R INPUT /I OUTPUT /O /RESTORE COMMAND LIST ORGO, SRST /S RERD /R IRST /I ORST /O /THE 'LOGICAL 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;C A KEY WAS HIT /'FIN()' MAY THEN BE USED TO READ AND TEST THE CHARACTER. /THIS HAS NOW BEEN REPLACED BY THE 'JUMP' COMMAND (V4D). BRANCH, CDI P /'LOGICAL BRANCH' COMMAND I0N JMP I .+1 /USES THE 'JUMP' COMMAND! PACLST+3 ///// ONMTMP, ZBLOCK 4 /SAVED FILE NAME
/THE 'OUTPUT EVERYTHING' COMMAND SWITCHES TO A DIFFERENT /INTERNAL HANDLER FOR ALL OUTPUT, INCLUDING THE ECHO AND /ERRORS; THIS DEVICE IS RESTORED FOLLOWING AN 'O C' OR /'O A' COMMAND. THE HANDLER MAY ALSO BE CALLED BY 'O O' ECOSET, GTNAME /THE 'O E' COMMAND JMS I INTCHK /WAS IT 'O E LPT:'? TAD [XOUTL /NO, EVERYTHING ELSE = 'TTY:' JMP OSCOPE+1 /SAVE ENTRY POINT ZBLOCK 1 /PATCHED BY LAB OVERLAY OSCOPE, TAD .-1 /THE 'O S' COMMAND CDF P DCA I [ECODEV /AFFECTS BOTH 'OCHAR' AND 'EOF' TAD I [ECODEV JMP I .+1 /INSERT ENTRY PT. INTO 'OUTDEV' TTYOUT+1 ///// INTCHK, LPTCHK /CHECK FOR INTERNAL HANDLERS INTRNL+1 /RETURN POINT JMS I INTCHK /CHECK FOR 'LPT:' SKP /TRY AGAIN JMP I INTCHK-1 /PUT ENTRY POINT INTO 'OUTDEV' SM2 COMPARE /CHECK FOR 'PLTR' PLTDEV NEWDEV-1 JMP I INTCHK+1 /NEITHER OF THESE TAD I .-3 JMP I INTCHK-1 /MOVE THE ENTRY POINT ////// LZERO, HANDLR-3 /THE 'LIBRARY ZERO' COMMAND SM1 /DANGEROUS - BUT USEFUL! DCA I FILCNT /RESET THE FILE COUNT DCA I [HANDLR-2 /CLEAR THE LINK WORD DCA I AUTO /CREATE AN 'EMPTY' WITH TAD FLNGTH / THE SPECIFIED LENGTH SNA /IF NO LENGTH, PROBABLY ERROR1 /DIDN'T WANT TO DO THIS! LZXIT, CIA TAD I LZERO /SUBTRACT SYSTEM BLOCKS DCA I AUTO JMS I LIBHND /PUT IT BACK 4200 FILCNT, HANDLR-4 1 JMP I [DERR /OH DEAR! JMP I LZXIT /RESTORE THINGS AND EXIT /////
/THE 'LIBRARY LIST' COMMAND SHOWS ONLY FILES WITH ONE EX- /TENSION. 'LIST ALL' SHOWS EVERYTHING, 'LIST ONLY' JUST 1. LIBBLK-1 LLIST, CMA CLL RTR /'LIBRARY LIST' COMMAND LIST1, CMA STL RAL /'LIST ONLY' / 'ONLY LIST' LISTAL, DCA I [OPEN /'LIST ALL' COMMAND SM3 /CLEAR THE 'L Z' SWITCH ZEROER, DCA 0 /'LIBRARY ZERO' COMMAND DCA GOSW /= NO EMPTIES GTNAME /GET DEVICE TO LIST TAD LLIST-1 GETHND /GET THE HANDLER JMS DEVCHK /CHECK DEVICE TYPE DISMISS /REMOVE THE USR JMS I [7607 /SWAP OUT CORE TO MAKE ROOM 4200 /FOR DIRECTORY HANDLR-4 40 /SYSTEM SCRATCH AREA JMP I [DERR /WHOOPS! DCA I SWAP /SET THE FLAG TO SWAP BACK IN IAC /DIRECTORY BEGINS WITH BLOCK 1 BLOKLP, DCA LBLOCK JMS I LIBHND 0200 HANDLR-4 /POSITIONED FOR OUR CONVENIENCE! LBLOCK, 1 JMP I [DERR TAD [HANDLR /FIRST 5 WORDS ARE INFORMATION DCA AUTO TAD 0 /CHECK FOR 'L Z' SNA CLA JMP I (LZERO+1 /OR 'EMPTY-2' TO DISABLE 'L Z' LOOP2, TAD AUTO /SAVE NAME POINTER FOR PRINTING DCA LIBX TAD I AUTO SNA CLA JMP EMPTY /CHECK IF WE SHOULD LIST EMPTIES ISZ AUTO ISZ AUTO TAD I AUTO /PICK UP EXTENSION DCA LBLOCK TAD I [HANDLR /WASTE WORDS (NEGATIVE) CIA TAD AUTO /SKIP TO LENGTH DCA AUTO TAD I AUTO /ZERO LENGTH MEANS TEMPORARY FILE *CIA SNA /LZERO RETURN JMP LOOP3 /IGNORE SUCH THINGS DCA FLNGTH TAD NAMLOC /WAS A NAME GIVEN ? SNA CLA JMP CKEXTN /NO TAD EXTENSION /CHECK THIS TOO? SNA CLA
IAC /NO, ONLY CHECK THE NAME TAD [-4 COMPARE /COMPARE THIS NAME WITH ARG LIBX, AUTO-1 NAMLOC-1 JMP LOOP3 /NON-MATCHING ISZ I [OPEN /TEST FOR ONLY ONE TAD EXTENSION /OR A NULL EXTENSION SZA CLA DCA NAMLOC /DON'T CHECK ANY MORE JMP DIRLST CKEXTN, TAD EXTENSION /DO WE WANT THIS ONE? CIA TAD LBLOCK SZA CLA TAD I [OPEN /TEST FOR 'ALL' SPA CLA JMP LOOP3 /GUESS NOT DIRLST, SM3 /PRINT 3 WORDS DCA TEMP ISZ LIBX TAD I LIBX JMS I DIRLST /PRINT 2 CHARS ISZ TEMP JMP .-4 TAD DOT JMS I PRNTC TAD LBLOCK /PRINT EXTENSION JMS I DIRLST TAD NPRNT+2 /SET UP FOR DECIMAL LENGTH PRINT DCA NEWDEV NLOOP, DCA NEWDEV+1 /INITIALIZE LEADING-ZERO FLAG DCA SHFTL6 /CLEAR QUOTIENT TAD I NEWDEV /FINISHED ALL POWERS OF 10? SNA JMP LOOP3-2 /YES, ALL DONE TAD FLNGTH /NO, ADD THIS POWER SMA SZA /OVERFLOW? JMP DIDJET /YES, PRINT THIS DIGIT DCA FLNGTH /NO, GO THROUGH THE LOOP AGAIN ISZ SHFTL6 /ADD ONE TO THIS DIGIT JMP NLOOP+2 /ANOTHER DIVIDE CYCLE TAD [CR /DONE WITH THIS LINE (WHEW!) JMS I PRNTC LOOP3, ISZ I LBLOCK-1 /DONE WITH THIS BLOCK? JMP LOOP2 /NO, KEEP GOING JMS I IOWAIT /WAIT FOR I/O TAD I [HANDLR-2 /LINK TO NEXT BLOCK SZA /LAST BLOCK? JMP BLOKLP /NO, GET THE NEXT JMS I SWAP /YES, RESTORE SWAPPED CORE JMP EXIT /(JMS RESETS THE FLAG)
/MANY THANKS TO STEVE L. GILLETT FOR FIGURING OUT /HOW TO MAKE ROOM FOR THE 'LIST EMPTIES' OPTION!! EMPTY, TAD I AUTO /LIST THE EMPTIES! DCA FLNGTH /GET THE LENGTH TAD GOSW /ARE WE SUPPOSED TO? SMA SZA CLA /',E' TESTED BY 'GTNAME' JMP NLOOP-3 /YES, INDENT SLIGHTLY JMP LOOP3 /FORGET IT DIDJET, CLA CLL /CLEAN UP THE AC ISZ NEWDEV /NEXT POWER OF TEN TAD SHFTL6 /IF THIS DIGIT IS ZERO, AND NO ISZ NEWDEV+1 /OTHER DIGITS HAVE BEEN NON-ZERO, SZA /PRINT A SPACE INSTEAD JMP NPRNT TAD [SP JMS I PRNTC JMP NLOOP NPRNT, TAD ["0 /CHANGE TO ASCII JMS I PRNTC CMA STL /SET ZERO SWITCH JMP NLOOP DECIMAL;*CMA STL /TRICKY, HUH? 1000 100 10 1 OCTAL; *SM1 /MORE TRICKS! SHFTL6, 0 /CLEVER USE TERMINATES TABLE CLL RTL RTL RTL JMP I SHFTL6 /CONSIDER 'BSW' FOR THE 8/E NAMLST, "< /BLOCK ": /DEVICE "( /VARIABLE DATA DOT, ". /EXTENSION "[ /SIZE ", /ECHO PAGE 35
/ROUTINE TO ENTER OR FIND A FILE FOR 'O O', 'O I' & 'LIB' OPEN, 0 /LOOKUP AND ENTER ROUTINE DCA GOSW /SET ECHO/LOAD SWITCH IAC RAL /SET CALL CODE (2 OR 3) DCA CALL GTNAME /GET DEVICE AND FILENAME TAD MDSK /CALLING SEQUENCE: TAD NEWDEV / AC=GOSW, L=1 FOR ENTER SNA / JMS I [OPEN TAD NAMLOC / HANDLER BLOCK (-1) SNA CLA / ERROR RETURN JMP SHUT+1 / 'TTY' RETURN SM2 / REGULAR RETURN COMPAR /CHECK FOR CALLS TO 'TTY:' TTYDEV-1 /'TTY:' IS ALSO THE DEFAULT TLSW, NEWDEV-1 /WHEN NO OTHER NAME IS FOUND JMP I INTRNL /CHECK FOR OTHER INTERNAL DEV. JMP SHUT+1 /'TTY:' INTRNL, INTCHK+2 /'.+1' FOR 8K TAD I OPEN /GET HANDLER BLOCK TO USE GETHND /LOAD THE HANDLER TAD NAMLOC /CHECK FOR A DIRECT ACCESS CALL SHFT, CMA STL RAL /POINTS TO 'SHFTL6' TAD CALL /'NAMLOC'=1, 'CALL'=2 (ONLY) SNA ERROR1 /CANNOT USE '<>' WITH 'OPEN OUTPUT' IAC SNA CLA JMP SHUT-1 /OK: 'STBLK' & 'FLNGTH' ARE SET JMS OPENUP /DO WHAT WE CAME FOR JMP SHUT+2 /ERROR RETURN TAD CALL+2 CIA DCA FLNGTH /SAVE POSITIVE LENGTH ISZ OPEN SHUT, DISMISS /REMOVE THE USR ISZ OPEN ISZ OPEN JMP I OPEN /NORMAL RETURN ///// USRIN, 0 /LOCK THE USR IN CORE - 'GETMON' I0F CIF 10 JMS I USR 10 TAD [200 DCA USR JMP I USRIN
OPENUP, 0 /CALLED BY 'SAVE' AND 'OPEN' TAD XNAME DCA CALL+1 /INITIALIZE USR CALL TAD FLNGTH /REQUESTED SIZE FROM 'GTNAME' CLL RTL RTL AND O7760 /SIZE TAD TEMP /DEVICE NO. CIF 10 JMS I USR /'ENTER' OR 'FETCH' CALL, 0 NAMLOC /BECOMES THE BLOCK NO. 0 / AND THE FILE LENGTH O7760, SNL SMA SZA CLA /ERROR RETURN ISZ OPENUP TAD CALL+1 /SAVE STARTING BLOCK DCA STBLK JMP I OPENUP *CLA CLL IAC SWAPIN, NOP /RESTORE CORE AFTER DIRECTORY LIST JMS I [7607 /SYSTEM HANDLER 200 HANDLR-4 40 DERR, ERROR1 /DEVICE ERROR = 'CLA CLL RTL' JMP I SWAPIN USROUT, 0 /REMOVE THE USR - 'DISMISS' SM0 TAD USR /CHECK POINTER TO FIND OUT SMA CLA JMP I USROUT /ALREADY GONE TAD .-2 /RESET THE POINTER DCA USR I0F CIF 10 JMS I [200 11 JMP I USROUT *SP1 IOWATE, 0 /WAIT FOR TELETYPE TO FINISH CDF P I0N TAD I TLSW SZA CLA JMP .-3 I0F CDF L JMP I IOWATE /THEN TURN THE INTERRUPT OFF MDSK, -5723
XFORM, 0 AND K77 SMA SZA TAD [240 AND K77 TAD [240 JMS I PRNTC JMP I XFORM *SM3 NPACK, 0 /STANDARD 6-BIT UNPACK ROUTINE DCA CMPR TAD CMPR JMS I SHFT /'BSW' RAL JMS XFORM TAD CMPR JMS XFORM JMP I NPACK /CALLED BY 'DIRLST' & 'DATER' CMPR, 0 /COMPARE TWO BLOCKS OF ANY LENGTH DCA XFORM /CALLING SEQUENCE: TAD I CMPR / AC= -# OF WORDS ISZ CMPR / COMPARE DCA AUTO 2 / FIRST-1 TAD I CMPR / SECOND-1 ISZ CMPR / RETURN IF NO MATCH DCA AUTO 3 / RETURN IF MATCH TAD I AUTO 2 /COMPARE TWO WORDS CIA TAD I AUTO 3 SZA CLA JMP I CMPR /NO MATCH ISZ XFORM /DONE ? JMP .-6 /NO, CHECK TWO MORE ISZ CMPR /YES, BUMP RETURN POINTER JMP I CMPR ///// PAGE 36
/READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV' NAME, 0 SM1 /POINTER TO 'SHFTL6' DCA AUTO 1 /PERIOD COUNTER DCA MGETA /DIGIT COUNTER TAD DSK DCA NEWDEV DEVNAM, DCA NEWDEV+1 DCA NAMLOC /CLEAR NAME AREA DCA NAMLOC+1 DCA NAMLOC+2 /BUT NOT THE EXTENSION! TAD XNAME DCA STBLK DCA AUTO 2 /CHAR. COUNTER DCA FLNGTH NAMLUP, JMS MGETC /'SM1' SETS L=1 LJUMP /'LJUMP' CLEARS IT NAMLST-1 /TRAP '< : ( . [ ,' NAMGO-NAMLST PLUS10, "9-"0+1 /'NOP' TAD CHAR /CHECK FOR A-Z, 0-9 TAD MINUS9 CLL TAD PLUS10 SZL JMP .+4 /OK TAD K7760 /"0-"@ = -20 STL TAD ("@-"Z-1 SNL CLA JMP NAMEND /ILLEGAL CHARACTER TAD AUTO 2 TAD (-5 K7760, SNL SMA SZA CLA /TOO MANY? JMP IGNORE TAD AUTO 2 CLL RAR TAD STBLK DCA MGETC /NAME POINTER ISZ AUTO 2 TAD CHAR AND K77 SNL JMS I NAME+1 /'SHFTL6' CDF L TAD I MGETC DCA I MGETC
NXTNUM, CDF P TAD I PDLXR /MAY BE GARBAGE TAD ["0 DCA CHAR IGNORE, ISZ MGETA TAD MGETA SPA SNA CLA /END OF THE STRING? JMP NAMLUP+1 TAD I XCHAR /YES, IS THERE MORE? TAD MCOMMA CLL SZA CLA /CHECK FOR A COMMA JMP NAMLUP *-"E VARBL, JMS MGETA /PROCESS A VARIABLE FILE NAME CLL CIA DCA CHAR /ASSUME ITS A LETTER TAD I H0RD /NOW CHECK THE SIGN SPA JMP VLETR /IT WAS, USE -1 AS THE COUNT CDI P JMP VFN /CONVERT POS. NUM. TO ASCII BLKNUM, JMS MGETA /READ THE BLOCK NUMBER ISZ NAMLOC /SET THE BLOCK FLAG JMP NAMLUP-3 *-"9-1 COLON, TAD NAMLOC /MOVE NAME TO 'NEWDEV' DCA NEWDEV TAD NAMLOC+1 JMP DEVNAM MGETC, 0 /CROSS-FIELD CALL CDI P JMP LGETC /L=1 TO SKIP 'GETC' DCA CHAR JMP I MGETC *SNL SMA-1 JMP I .+1 /TRY TO FIGURE THIS OUT! MGETA, 0 /EVALUATE AN EXPRESSION JMS MGETC /SKIP THE DELIMITER CDI P JMP GETA /CALL 'EVAL' *-", PERIOD, ISZ AUTO 1 /DOUBLE PERIODS? JMP NAMEND /APPARENTLY DCA EXTENSION /CLEAR OUT THE ASSUMED ONE ISZ STBLK /ADVANCE STORAGE POINTER TAD (4 /ALLOW FOR TWO MORE CHARACTERS JMP NAMLUP-2
NAMGO, BLKNUM /BLOCK MINUS9, COLON /DEVICE MINUSE, VARBL /LETTERS & NUMBERS MCOMMA, PERIOD /EXTENSION SQBRKT /SIZE ECHCHK /ECHO *SMA SZA SQBRKT, JMS MGETA /READ REQUESTED FILE SIZE JMP NAMLUP-1 VFR, DCA PDLXR /SAVE STARTING ADDRESS TAD I (T3 SPA SNA /CHECK DECIMAL EXPONENT CLA IAC /FORCE 1 IF .LE. ZERO STL CIA VLETR, DCA MGETA /EXPONENT=NUMBER OF DIGITS SNL JMP IGNORE /LETTERS JMP NXTNUM /NUMBERS ECHCHK, TAD [SP /REPLACE THE COMMA WITH A SPACE SKP ISZ GOSW /CLEAR THE SWITCH & REMOVE THE 'E' CDF P DCA I XCHAR JMS I (SCANER /SKIP TO THE 'ECHO' OR LINE NO. TAD I XCHAR TAD MINUSE /DOES IT BEGIN WITH AN 'E'? SNA CLA JMP ECHCHK+2 /YES, MARK IT AND CONTINUE NAMEND, CDI P /EVALUATE THE LINE NUMBER JMP GETL JMS I IOWAIT /AND WAIT FOR THE TERMINAL JMP I NAME /***RETURN*** NAMER, GTNAME /'LIBRARY NAME' COMMAND JMP IOWAIT+1 /JUST UPDATES THE HEADER PAGE 37
/PAGE ZERO (FIELD 0) LITERALS: LPUSHF= JMS I [MPUSHF LPOPF= JMS I [MPOPF LJUMP= JMS I [JUMPER COMPAR= JMS I [CMPR GTNAME= JMS I [NAME GETHND= JMS I [HANDLR GETMON= JMS I [USRIN DISMIS= JMS I [USROUT FIELD 0
/READ AND STORE THE OS/8 DATE WORD: FIELD 2 *14 NODATE, TEXT "NO/DA/TE" /BECOMES THE CURRENT DATE *20 NUHEAD, 0 /MOVE THE NAME UP FROM FIELD L TAD I .+2 DCA NUHEAD TEMP TAD .+2 DCA PDLXR NAMLOC-1 TAD .+2 DCA AUTO TITLE-1 SM3 DCA DATUM CDF L TAD I PDLXR CDF T DCA I AUTO ISZ DATUM JMP .-5 DCA I AUTO /CLEAR THE I.D. TAD NODATE+0 /MOVE THE DATE INTO PLACE DCA I AUTO TAD NODATE+1 DCA I AUTO TAD NODATE+2 DCA I AUTO TAD NODATE+3 DCA I AUTO CDI L JMP I NUHEAD DAY, SZA /ZERO = READ CURRENT DATE JMP NIGHT /NON-ZERO = SET NEW DATE TAD I (17666 JMP NIGHT+2 NIGHT, DCA I (17666 JMS DATUM CDI P JMP I .+1 /'FL0ATR' FL0AT
PACK1, 0 /HALF-WORD PACK ROUTINE TAD (60 /ADD OFFSET AND (77 ISZ (-1 /TEST THE SWITCH JMP PACK0 CLL RTL RTL RTL DCA PDLXR /SAVE LEFT HALF JMP I PACK1 *0 PACK0, TAD PDLXR /MERGE THE PIECES CDF T DCA I AUTO CDF 10 SM1 DCA (-1 /RESET THE SWITCH JMP I PACK1 *7 600 /EXTENDED DATE MASK ZBLOCK 4 /INDICATE USAGE *104 /LEAVE ROOM FOR 'PC0' PACK2, 0 DCA AUTO 2 /SAVE DIGITS DCA AUTO 1 /CLEAR QUOT. JMP .+3 ISZ AUTO 1 /DIVIDE BY TEN DCA AUTO 2 TAD AUTO 2 TAD (-12 SMA JMP .-5 CLA /CLEAR OVERDRAW TAD AUTO 1 /FIRST DIGIT JMS PACK1 TAD AUTO 2 /SECOND DIGIT JMS PACK1 SM2 /"0"-2="." JMS PACK1 JMP I PACK2
/ROUTINE TO UNPACK THE DATE - USED BY 'FDAY' DATA, 0 /CALLED FROM 'INITLZ' JMS DATUM CDI L JMP I DATA DATUM, 0 /UNPACK THE DATE WORD SM1 DCA (-1 /INITIALIZE TAD (NODATE-1 DCA AUTO CDF 10 TAD I (17666 SNA JMP I DATUM /SKIP NULL DATE RTR AND (77 CLL RAR JMS PACK2 /DAY TAD I (17666 RTL RTL AND K7 RAL JMS PACK2 /MONTH TAD I (17666 AND K7 DCA PDLXR CDF 0 TAD I (7777 /WILL BE -1! K7, AND 7 CLL RTR RTR TAD (106 /1970 TAD PDLXR JMS PACK2 /YEAR JMP I DATUM FIELD 2 $