Directory of image this file is from
This file as a plain text file
/TSS/8 FAILSAFE V2.01 / /BOB CURRIER NMUSD 17:26:34 9-MAR-74 / / THIS PROGRAM IS DESIGNED TO DUMP AND RESTORE A TSS/8 FILE STRUCTURE /WHILE RUNNING THE TIMESHARING MONITOR. IT CAN BE ASSEMBLED FOR A NUMBER /OF SYSTEMS, TO TAKE ADVANTAGE OF THE SPECIAL FEATURES OF EACH. /MINIMUM CONFIGURATION IS A TSS/8 SYSTEM WITH ONE DECTAPE. / /EDIT BY CURRIER 21-APR-75 19:35:42 /MODIFIED TO WORK UNDER STANDARD DEC MONITOR.
/DEFINE PARAMETERS / /MONITOR PARAMETERS IFNDEF SYSTEM <SYSTEM=0> /SYSTEM = 0 FOR STANDARD DEC /SYSTEM = 1 FOR 8.22X PRIV SYSTEM /SYSTEM = 2 FOR 8.24 V3 JOBMAX=20 /MAXIMUM # OF JOBS ON SYSTEM IFNDEF LIST <LIST=0> /LIST = 1 FOR COMPLETE LISTING ARKLEN=201 /LENGTH OF ARCHIVE DIRECTORY DIRLEN=201 /LENGTH OF FAILSAFE DIRECTORY DTALEN=201 /LENGTH OF DECTAPE BLOCK (INCLUDING LINK WORD) MFDLEN=100 /LENGTH OF MFD BUFFER UFDLEN=3400 /LENGTH OF A UFD (7 SEGMENTS MAX) UFDBUF=-UFDLEN MFDBUF=UFDBUF-MFDLEN DTABUF=MFDBUF-DTALEN DIRBUF=DTABUF-DIRLEN ARKBUF=DIRBUF-ARKLEN BLOCK1=0003 /FIRST DECTAPE BLOCK TO BE USED ACHGEN=BIT7 /ACCOUNT CHANGE ENABLE BIT (FOR 22X MONITOR ONLY) / /DEFINE BITS / BIT0=4000 BIT1=2000 BIT2=1000 BIT3=400 BIT4=200 BIT5=100 BIT6=40 BIT7=20 BIT8=10 BIT9=4 BIT10=2 BIT11=1 *0010 /DEFINE AUTO INDEX REGISTERS / UFDSTK, MFDBUF-1 /POINTER TO MFDBUF FDIRPT, . /POINTER TO CURRENT LOCATION IN FAILSA DIR ADIRPT, . /POINTER TO CURRENT LOCATION IN ARKIVE DIR DPWPTX, . /POINTER FOR DIR FULL FILXPT, UFDBUF-1 /POINTER INTO UFD *0000 / /DEFINE PROGRAM ENTRY / JMP I .+1 SUPER /OFF TO THE SUPERVISOR CLA CLL /COME HERE ON ^C IFNZRO SYSTEM < TAD RETACT /RETURN TO OUR ORIGINAL PPN LIN > HLT /AND HALT........
/ /DEFINE PROGRAM TRANSFER VECTORS / *0020 IFZERO SYSTEM-1 < LIN=JMS I . LGIN > IFZERO SYSTEM-2 < LIN=SETPPN > DIRFUL=JMS I . DFX01 TAPDAT=JMS I . TPDT01 WFID=JMS I . WFID01 FAICHK=JMS I . FCHX01 FAINIT=JMS I . FINI01 CHKARK=JMS I . CHAX01 DIRWRT=JMS I . DWX01 DIRPW=JMS I . DPWX01 DTAPUT=JMS I . DTPUT DTAGET=JMS I . DTGET BUMTAP=JMS I . NOGUD ERROR=JMS I . ERRPRT FERROR=JMS I . FERPRT EXTPRT=JMS I . EXTENS ACTOUT=JMS I . ACTX01 GETUFD=JMS I . UFD01 GETMFD=JMS I . MFD01 FILINF=JMS I . FILX01 SPACE=JMS I . SPAC01 CRLF=JMS I . CRLFB PUTNUM=JMS I . NUMBER PUTCHR=JMS I . ASCOUT PUTDATE=JMS I . DATER PUTIME=JMS I . TIME0 ARKCHK=JMS I . ACHX01 RETPUT=JMS I . RTPX01 RTINIT=JMS I . RTINI RETINF=JMS I . RTIX01 RERROR=JMS I . RERPRT DELETE=JMS I . DEL0 CONVERT=JMS I . CONV01 IFZERO SYSTEM-1 < CREATE=CRF > IFNZRO SYSTEM-1 < CREATE=JMS I . CRE001 MFDINI=JMS I . MFDI01 UFDGET=JMS I . UFDG01 UFDPUT=JMS I . UFDP01 GETBLK=JMS I . GB001 >
/ /DEFINE PAGE ZERO REGISTERS / REGST=. *REGST FAIDRV, 0 /FAILSAFE DECTAPE DRIVE ARKDRV, 1 /ARCHIVE DECTAPE DRIVE LISDRV, . /LISTING DECTAPE DRIVE RETDRV, 0 /RESTORE DECTAPE DRIVE DIRBLK, . /CURRENT DIR BLOCK ARKBLK, . /CURRENT ARK BLOCK RETACT, . /ACCOUNT TO RETURN TOO WHEN FAILSAFE IS DONE PPN, . /CURRENT PPN FBLK, . /CURRENT BLOCK FOR FAILSAFE ABLK, . /CURRENT BLOCK FOR ARCHIVE RLOKUP, /# OF RESTOR LOOKUPS FLOKUP, 0 /# OF FAILSA LOOKUPS ALOKUP, 0 /# OF ARKIVE LOOKUPS RFILES, /# OF RESTOR FILES FFILES, 0 /# OF FAILSA FILES AFILES, 0 /# OF ARKIVE FILES RLKER, /# OF RESTOR ERRORS FLKER, 0 /# OF FAILSA ERRORS ALKER, 0 /# OF ARKIVE ERRORS RSEGS, /# OF RESTOR SEGS FSEGS, 0 /# OF FAILSA SEGS ASEGS, 0 /# OF ARKIVE SEGS RETPNT, . RETCNT, . NUMHO, . /REGISTERS FOR TIME OF DAY DECODING . /THREE IN ALL . /TOLD YOU SO. LISCNT, . /COUNTER FOR LISTING ROUTINE LISPNT, . /POINTER FOR LISTING ROUTINE LISNUM, . /GENERAL REGISTER FOR LISTING ROUTINE LISSEG, . /SEGMENT COUNTER FOR LISTING ROUTINE SEGPNT, 0 /POINTER TO SEGMENT IN MFD UFDHIA, 0 /HIGHEST MODIFIED ADDRESS IN UFD C3777, 3777 C60, 0060
/ /DEFINE DISK TRANSFER REGISTERS / OPNBLK, .+1 FILNUM, . /IFN ACTNUM, . /PPN OF FILE OWNER NAME0, . /NAME OF FILE NAME1, . NAME2, . DSKBLK, .+1 HIGH, . /HI-ORDER FILE ADDRESS NUMFIL, . /IFN WC, . /WORD COUNT FOR DISK TRANSFER CA, . /CORE ADDRESS FOR DISK TRANSFER ADDR, . /LO-ORDER FILE ADDRESS DSERR, . /READ/WRITE ERROR WORD
/ /DEFINE TIME DECODING STACKS / / /HIGH ORDER BITS / DCTAB, 7650 /-TICKS PER 10 HOURS 7767 /-TICKS PER 1 HOUR 7776 /-TICKS PER 10 MINUTES 7777 /-TICKS PER 1 MINUTE 7777 /-TICKS PER 10 SECONDS 7777 /-TICKS PER 1 SECOND / /LOW ORDER BITS / DCTAB1, 0700 /-TICKS PER 10 HOURS 1540 /-TICKS PER 1 HOUR 4220 /-TICKS PER 10 MINUTES 6650 /-TICKS PER 1 MINUTE 7634 /-TICKS PER 10 SECONDS 7766 /-TICKS PER 1 SECOND / /BUFFER AREA USED BY DECODING ROUTINE / CHRBUF, ZBLOCK 10 PAGE
/ /THIS IS THE HEART OF THE FAILSAFE ROUTINES. THIS IS THE AREA WHICH /HANDLES ALL DISPATCHES TO THE OTHER ROUTINES. / FAILSA, TAD FAIDRV /GET DRIVE DCA FAIL03 /STORE FOR TAPE CHECK FAICHK /CHECK FOR BUM TAPE ID FAIL03, 0 /DRIVE JMP FAIL06 /ILLEGAL TAPE ID IFNZRO SYSTEM < ACT /GET OUT PPN FOR RETURNING AFTER FAILSAFE OR ON ERROR DCA RETACT > FAINIT /INITIALIZE ALL THE GARBAGE IFNZRO SYSTEM < CLA CLL IAC LIN > /CHANGE TO PPN [0,1] GETMFD /GET THE MFD INTO CORE AND DECODE IT FAINIT /REINITIALIZE 'UFDSTK' FAIL01, TAD I UFDSTK /GET A PPN OFF THE UFD STACK SNA /IS IT ZERO (END OF FILE) ??? JMP I FEXITL /YES--MOST CERTAINLY IS--EXIT DCA PPN /NO--STORE IT AS NEXT PPN TO FAILSAFE IFZERO SYSTEM-1 < TAD PPN /GET IT BACK LIN > /AND LOGIN UNDER IT GETUFD /GET THE UFD INTO CORE SO WE CAN LOOK AT IT FAIL02, FILINF /GET INFO ON A FILE FAIL01 /ERROR RETURN (INDIRECT) FNAME0, . /2 CHARS OF NAME FNAME1, . /2 CHARS OF NAME FNAME2, . /2 CHARS OF NAME MAKES 6 IN ALL!! FPPN, . /PPN OF FILE OWNER (FPPN=PPN) FPROT, . /PROTECTION AND EXTENSION OF FILE FSIZE, . /SIZE OF FILE FDATE, . /DATE OF CREATION FOR FILE CHKARK /CHECK TOO SEE IF FILE SHOULD BE ARCHIVED /(HOPEFULLY SOMEDAY WE'LL IMPLEMENT THE ARCHIVE SYSTEM) JMP FAIL02 /FILE HAS BEEN ARCHIVED TAD FAIDRV /NOT .ARK FILE, GET FAILSA DRIVE AGAIN DCA FAIL04 TAD FBLK /GET CURRENT BLOCK DCA FAIL05 /AND STORE FOR DHRECTORY WRITE DIRPW /PUT ENTRY IN DIR FAIL04, 0 /DRIVE FAIL05, 0 /BLOCK TAD FAIL05 /GET NEW BLOCK NUMBER DCA FBLK /UPDATE (MAY BE SAME AS BEFORE) DIRFUL /CHECK FOR DIRECTORY OVERFLOW DIRWRT /DIR FULL--WRITE IT OUT JMP FAIL02 /NOW LOOP ON BACK FOR ANOTHER FILE, ANOTHER PPN FEXITL, FEXIT
/ /COME HERE ON BUM TAPE ID / FAIL06, BUMTAP /TELL OPERATOR ABOUT OUR BAD TAPE JMP FAILSA /AND LOOP ON BACK TO CHECK AGAIN
/ /ROUTINE TO GET THE MFD INTO CORE AND DECODE IT INTO A TABLE. / /THIS ROUTINE ASSUMES THAT THE USER IS ON PPN [0,1] / /CALL: GETMFD / RETURN / MFD01, 0 TAD WHOLOC /ASSUME WE'RE ON PPN [0,1] WHO /PICK UP THAT OLD PSWD IAC /OPEN THE MFD ON IFN 1 DCA FILNUM IAC /UFD IS ON PPN [0,1] DCA ACTNUM TAD OPNBLK /SET UP FOR OPEN OPEN /AND OPEN AWAY!! SZA /WAS IT OK?? ERR4=. ERROR /NO--FLAG IT DCA HIGH /OPEN OK--NOW READ IN THE MFD; CLEAR HI-ORDER ADDRESS IAC /FILE ON IFN 1 DCA NUMFIL TAD MFDWC /HOW MUCH MFD WE WANT TO EAT IN ONE BITE (BYTE?) DCA Z WC TAD MFDCA /WHERE WE WANT TO PUT OUR BITE (STOMACH?) DCA Z CA DCA Z ADDR /START AT FILE ADDRESS 00000000 DCA Z DSERR /CLEAR OUT ANY ERROR GARBAGE TAD Z DSKBLK RFILE /READ THE OLD FILE!! TAD Z DSERR /OK?? SNA /ZERO?? JMP .+4 /YES--OK, NO ERROR ON DISK READ AND M7775 /NO--CHECK FOR SHORT FILE ERROR AND IGNORE SZA ERR5=. ERROR /BUM DISK READ MFD04, TAD I MFDLK1 /OK READ--GET THE FIRST POINTER TAD MFDLK1 /OFFSET IT (ADD UFDBUF+3) DCA MFDPNT /STORE AS POINTER TAD I MFDPNT /GET LINK WORD TO NEXT NAME TAD MFDDIF /OFFSET IT AGAIN DCA MFDPNT /STORE AS NEW POINTER /THIS CAUSES US TO BYPASS THE MFD,WHICH IS OK AS WE DON'T WANT TO /FAILSAFE (OR ARCHIVE) THE UFD'S. TAD MFDLOC /START OF MFDTBL-1 DCA Z UFDSTK /STORE IN AUTO-INDEX REGISTER MFD02, TAD I MFDPNT /PICK UP A PPN DCA I Z UFDSTK /AND STORE IT IFZERO SYSTEM-1 < CLA STL IAC RAL /AC_0003 TAD MFDPNT /ADD TO POINT TO NEXT LINK WORD DCA MFDPNT > /STORE AS POINTER IFNZRO SYSTEM-1 < ISZ MFDPNT /INCREMENT POINTER TAD I MFDPNT /GET HALF A PASSWORD DCA I Z UFDSTK /STORE IT ISZ MFDPNT /BUMP THE POINTER TAD I MFDPNT /GET ANOTHER PASSWORD WORD DCA I Z UFDSTK /STORE IT ISZ MFDPNT /MAKE IT POINT TO LINK > TAD I MFDPNT /GET NEW LINK SNA /ZERO?? JMP MFD03 /YES-- WE'RE ALL DONE HERE TAD MFDDIF /NO-- OFFSET IT DCA MFDPNT /STORE AS NEW POINTER JMP MFD02 /AND LOOP ON BACK MFD03, DCA I Z UFDSTK /STORE ZERO AT BOTTOM OF TABLE JMP I MFD01 /AND EXIT MFDWC, -UFDLEN /NUMBER OF WORDS TO READ OUT OD MFD MFDCA, UFDBUF-1 /WHERE TO PUT THEM MFDLK1, UFDBUF+3 /LINK TO FIRST LINK (SORTA) MFDDIF, UFDBUF /OFFSET TO START OF BUFFER MFDLOC, MFDBUF-1 /START OF MFDTBL-1 (FOR UFDSTK) WHOLOC, NAME0 /LOCATION TO PUT PPN, PASSWORD MFDPNT, . /TEMPORARY POINTER M7775, 7775 /MASK FOR SHORT FILE ERROR CHECK
/ /ROUTINE TO WRITE FAILSAFE ID ONTO A DECTAPE. / /CALL: WFID / DRIVE / RETURN / /WARNING: THIS ROUTINE IS NON-REENTRANT!!!!! / WFID01, 0 TAD I WFID01 /GET THE DRIVE TO WRITE ON DCA WFID02 ISZ WFID01 /INCREMENT POINTER FOR RETURN WFID03, TAD I WFID04 /START TRANSFERRING DATA INTO DTABUF DCA I WFID05 ISZ WFID04 ISZ WFID05 ISZ WFIDCN /TRANSFERRED 4 WORDS YET?? JMP WFID03 /NOPE-- DTAPUT /YES--TRANSFER TO DECTAPE WFID02, . /DRIVE BLOCK1 /BLOCK DTABUF-1 /WHERE TO GET IT JMP I WFID01 /EXIT-- WFID04, WFID06 WFID05, DTABUF WFIDCN, -0004 WFID06, 4641 /FA 5154 /IL 6341 /SA 0000 /
/ /FAILSAFE EXIT ROUTINE / FEXMSL, FEXMS1 /LINK TO MESSAGE FEXIT, CLA CLL IFNZRO SYSTEM < TAD RETACT /BACK TO OUR ORIGINAL PPN LIN > DCA I FDIRPT /INSERT A BLOCK OF ZEROES DIRWRT /AND WRITE OUT THE DIRECTORY ONTO DECTAPE CRLF /FORMAT GIGO TAD FEXMSL /"FAISAFE DONE (" PUTCHR P 17 FEXI1, TAD NUMHOL TOD PUTIME /OUTPUT THE TIME OF DAY TAD FEXPAR /")" PUTCHR 0001 CRLF TAD FEXMS2 /"TOTAL OF " PUTCHR P 11 TAD FLKER /GET ERROR COUNT PUTNUM S D 2 /HOPEFULLY NO MORE THAN 99 ERRORS!! TAD FEXMS3 /" ERRORS IN " PUTCHR P 13 TAD Z FLOKUP /GET NUMBER OF LOOKUPS PERFORMED PUTNUM S D 3 /SHOULD NOT BE MORE THAN 999 FILES ON SYSTEM TAD FEXMS4 /" LOOKUPS" PUTCHR P 10 CRLF TAD FFILES /GET NUMBER OF FILES FAILSAFED PUTNUM S D 3 TAD FEXMS5 /" FILES (" PUTCHR P 10 TAD FSEGS /GET NUMBER OF SEGMENTS FAILSAFED PUTNUM S D 4 TAD FEXMS6 /". BLOCKS) FAILSAFED" PUTCHR P 23 CRLF CRLF HLT NUMHOL, NUMHO /LINK TO TIME BLOCK
FEXMS1, .+1 TEXT /FAILSAFE DONE (/ FEXMS2, .+1 TEXT /TOTAL OF / FEXMS3, .+1 TEXT / ERRORS IN / FEXMS4, .+1 TEXT / LOOKUPS/ *.-1 FEXMS5, .+1 TEXT / FILES (/ *.-1 FEXMS6, .+1 TEXT /. BLOCKS) FAILSAFED/ FEXPAR, ")
/ /ROUTINE TO WRITE OUT DIRECTORY AND SET UP FOR NEXT ONE. / /CALL: DIRWRT / RETURN / DWX01, 0 TAD FBLK /GET NEXT FREE BLOCK DCA I DWX05 /STORE AS LINK WORD ISZ FBLK /GRAB THAT FREE BLOCK TAD DIRBLK /GET THIS DIRBLK DCA DWX02 /STORE AS PLACE TO WRITE OUT DIRECTORY TAD FAIDRV /GET OUR DRIVE # DCA DWX03 /STORE THE DRIVE DTAPUT /AND WRITE DIRECTORY ONTO THE DECTAPE DWX03, . /DRIVE DWX02, . /BLOCK DIRBUF-1 /BUFFER-1 STA /AC_7777 TAD FBLK /GET THE NEW DIRECTORY BLOCK DCA DIRBLK TAD DWX04 /SET DIR POINTER BACK TO START DCA FDIRPT JMP I DWX01 /EXIT-- DWX04, DIRBUF-1 DWX05, DIRBUF+200
/ /FAILSAFE INITIALIZATHON ROUTINE / /SETS UP ALL POINTERS MAKING THE PROGRAM REENTRANT (OF A KIND) / /CALL: FAINIT / RETURN / FINI01, 0 TAD FINI02 /GET BLOCK 1 DCA DIRBLK /STORE AS FIRST DIRECTORY BLOCK TAD FINI02 /GET BLOCK 1 IAC /INCREMENT PAST DIRECTORY BLOCK DCA FBLK /STORE AS FIRST AVAILABLE DATA BLOCK TAD FINI03 /GET START OF DIRECTORY BUFFER DCA FDIRPT /STORE AS POINTER TAD FINI04 /GET START OF MFDTBL-1 DCA UFDSTK /STORE AS POINTER TAPDAT /WRITE OUT TAPE HEADER DATA CLA CLL /BE TIDY. JMP I FINI01 /AND EXIT-- FINI02, BLOCK1 FINI03, DIRBUF+7 /START OF DIRECTORY BUFFER; SKIPPING TAPE ID FINI04, MFDBUF-1 PAGE
/ /ROUTINE TO WRITE OUT FILE AND UPDATE DIRECTORY, DOES NOT CHECK FOR /DIECTORY OVERFLOW. / /CALL: DIRPW / DRIVE / STARTING BLOCK (UPDATED AFTER FILE WRITE) / DPWX01, 0 ISZ Z FLOKUP /INCREMENT NUMBER OF FILE LOOKUPS TAD I FNAM0 /STORE NAME FOR OPEN DCA Z NAME0 TAD I FNAM1 DCA Z NAME0+1 TAD I FNAM2 DCA Z NAME0+2 TAD I FPPNL /GET PPN OF FILE OWNER DCA Z ACTNUM /STORE AS FILE OWNER FOR OPEN UUO DCA Z FILNUM /STORD AS IFN FOR OPEN UUO DCA Z NUMFIL /STORE AS IFN FOR RFILE UUO TAD Z OPNBLK /GET BLOCK FOR OPEN UUO OPEN /AND OPEN THE FILE-- SZA /OK? JMP DPWX08 /NO!! DCA DPWFAD /CLEAR FILE ADDRESS (LO-ORDER) DCA DPWHAD /CLEAR FILE ADDRESS (HI-ORDER) TAD I FSIZXL /GET SIZE CLL RAL /*2 FOR DECTAPE BLOCKS CIA /NEGATE DCA DPWCNT /STORE AS LOOP COUNTER TAD I DPWX01 /GET DRIVE NUMBER ISZ DPWX01 /UPDATE ADDRESS DCA DPWX03 /STORE DRIVE NUMBER TAD I DPWX01 /GET STARTING BLOCK NUMBER DCA DPWBKN DPWX02, TAD DPWHAD /GET HI-ORDER FILE ADDRESS DCA Z HIGH /STORE IN DISK TRANSFER BLOCK TAD DPW200 /GET WORD COUNT CIA DCA Z WC TAD DPWBUF /GET BUFFER-1 DCA Z CA /STORE TAD DPWFAD /GET LO-ORDER FILE ADDRESS DCA Z ADDR /STORE IT DCA Z DSERR /CLEAR OUT ERROR WORD TAD DSKBLK /GET RFILE BLOCK AND.... RFILE /!!! TAD DSERR /GET ERROR WORD SZA CLA /?????? JMP DPWX10 DTAPUT /NOW WRITE DATA ONTO THE DECTAPE DPWX03, 0 DPWBKN, 0 /BLOCK DTABUF-1 /BUFFER CLL /_____DON'T FORGET_____ TAD DPWFAD /GET LO-ORDER ADDRESS TAD DPW200 /INCREMENT DCA DPWFAD /AND RESTORE IT SZL /OVERFLOW?? ISZ DPWHAD /YES--INCREMENT HI-ORDER CLL /NO--CLEAR LINK ANYWAY ISZ DPWBKN /INCREMENT BLOCK NUMBER ISZ DPWCNT /DONE WHOLE FILE?? JMP DPWX02 /NO--LOOP ON THRU DPWX07, TAD I DPWX01 /GET STARTING BLOCK NUMBER DCA DPWBK1 /STORE FOR DIRECTORY TAD DPWBKN DCA I DPWX01 /UPDATE BLOCK NUMBER ISZ DPWX01 /INCREMENT RETURN TAD DPWM07 /ARG COUNT DCA DPWCNT /STORE AS COUNTER TAD DPWFP /GET POINTER TO DIRECTORY INFO DCA DPWPTX /STORE IN AUTO-INDEX POINTER DPWX04, TAD I DPWPTX /GET INFO DCA I FDIRPT /STORE IN DIRECTORY (VIA AX POINTER) ISZ DPWCNT /ALL DONE?? JMP DPWX04 /NOPE--KEEP LOOPING DPWX06, TAD DPWBK1 /YES--GET BLOCK 1 DCA I FDIRPT /STORE IN DIRECTORY ENTRY FOR THIS FILE ISZ FFILES /INCREMENT NUMBER OF FILES TRANSFERED TAD I FSIZXL /GET FILE SIZE TAD Z FSEGS DCA Z FSEGS /AND UPDATE FAILSAFE SEGMENT COUNTER JMP I DPWX01 /EXIT DPWX08, FERROR /PRINT"FAILSAFE FAILURE--" TAD DPW8ML PUTCHR P 27 DPWX09, TAD FNAM0 /OUTPUT NAME PUTCHR P T 6 TAD FPRO1 /GET EXTENSION EXTPRT /PRINT IT TAD DPW9ML PUTCHR P 3 /"' [" TAD Z PPN ACTOUT /OUTPUT PPN TAD DPW9LM PUTCHR 3 ISZ DPWX01 ISZ FLKER /UPDATE ERROR COUNT JMP I DPWX01 DPWX10, FERROR TAD DPW1ML PUTCHR P 27 JMP DPWX09
FPRO1, FPROT /POINTER TO FILE PROTECTION/EXTENSION FNAM0, FNAME0 /POINTER TO FILE NAME FNAM1, FNAME1 /POINTER TO FILE NAME FNAM2, FNAME2 /POINTER TO FILE NAME FPPNL, FPPN /POINTER TO PPN OF FILE OWNER DPWFP, FNAME0-1 /POINTER FOR AX FSIZXL, FSIZE /POINTER TO FILE SIZE DPWM07, -0007 /COUNT FOR PARAMETERS DPWBUF, DTABUF-1 /SEGMENT BUFFER DPW200, 0200 /DTA BLOCK SIZE (NOT INCLUDING LINK WORD) DPWBK1, . /STORAGE FOR BLOCK ONE DPWHAD, . /STORAGE FOR HI-ORDER FILE ADDRESS DPWFAD, . /STORAGE FOR LO-ORDER FILE ADDRESS DPW8ML, DPW8MS DPW1ML, DPW1MS DPW9ML, DPW9MS DPW9LM, DPW9M
/ /ROUTINE TO RECORD DATE AND TIME IN DIRECTORY BLOCK ONE. / /ASSUMES DIRECTORY IS IN DIRBUF. / /CALL: TAPDAT / RETURN / DPWCNT, TPDT01, 0 TAD TPDT02 /GET ADDRESS FOR TIME TOD /GET TIME DATE /GET DATE DCA I TPDT03 JMP I TPDT01 /EXIT-- TPDT02, DIRBUF+4 /LOC IN DIR FOR TOD TPDT03, DIRBUF+6 /LOC IN DIR FOR DATE PAGE
/ /ROUTINE TO READ IN UFD. / /CALL: GETUFD (PPN IN AC) / RETURN / UFD01, 0 IFZERO SYSTEM-1 < TAD WHOPLC /PLACE TO PUT PPN, PASWORD WHO > IFNZRO SYSTEM-1 < TAD I Z UFDSTK /RETRIEVE PASSWORD DCA Z NAME1 /STORE AS NAME TAD I Z UFDSTK DCA Z NAME2 > IAC RAL CLL /OPEN UFD ON IFN 2 DCA FILNUM IFZERO SYSTEM-1 < IAC > /UFD ON PPN [0,1] DCA Z ACTNUM TAD OPNBLK /SET UP FOR OPEN OPEN SZA /OK OPEN?? ERR6=. ERROR /BUM OPEN DCA Z HIGH /YES--CLEAR HI-ORDER FILE ADDRESS IAC RAL CLL /OPEN ON IFN 2 DCA NUMFIL TAD UFDWC /HOW MANY WORDS OF UFD TO READ DCA Z WC TAD UFDCA /WHERE TO PUT THEM DCA Z CA DCA Z ADDR /READ FROM FILE ADDRESS 00000000 DCA Z DSERR /CLEAR OUT DISK TRANSFER ERROR WORD TAD Z DSKBLK RFILE /READ AWAY!! TAD Z DSERR /WAS IT COOL?? SNA /ZERO? JMP .+4 /YES--AL IS OKAY AND U7775 /MASK OFF SHORT FILE ERROR AND IGNORE IT SZA ERR7=. ERROR /NO-- JMP I UFD01 /YES--ALL DONE THIS ROUTINE WHOPLC, NAME0 /THE IS THE PALCE FOR A WHO UFDWC, -UFDLEN /NUMBER OF WORDS OF UFD TO READ IN ONE BITE UFDCA, UFDBUF-1 /WHERE TO PUT THEM U7775, 7775 /MASK FOR SHORT FILE ERROR
/ /ROUTINE TO PRINT THE MESSAGE "FAILSAFE FAILURE--" / /CALL: FERROR / RETURN / FERPRT, 0 CRLF /A TOUCH OF THE OLD FORMAT TAD FERMS1 /"FAILSAFE FAILURE--" PUTCHR P 22 CRLF JMP I FERPRT /OFF TO THE EXTENDED ERROR PRINTERS FERMS1, .+1 TEXT /FAILSAFE FAILURE--/
/ /ROUTINE TO GET INFO ON A FILE OUT OF THE UFD. / /EXPECTS UFD OF PROPER USER TO BE IN CORE WHEN CALLED / /CALL: FILINF / ERROR RETURN (INDIRECT) / NAME / NAME / NAME / PPN / EXTENSION/PROTECTION / SIZE / CREATION DATE / NORMAL RETURN / FILX01, 0 TAD FILXPT /GET FILE POINTER CIA /AND COMPARE TO SEE IF THIS IS NEW UFD TAD FILXOS /COMPARE TO OFFSET (UFDBUF-1) SZA CLA /ARE THEY EQUAL? JMP FILX02 /NO--WE MUST BE IN MIDDLE OF A UFD TAD I FILXP3 /YES--MUST BE NEW UFD; GET LINK WORD SZA /ZERO? TAD FILXOS /NO--ADD OFFSET DCA FILXPT /YES--STORE FOR ERROR FILX02, TAD FILXPT /CHECK FOR END OF UFD SNA CLA /ZERO? JMP FILXER /YES--END OF UFD ISZ FILX01 /NO--INCREMENT PAST ERROR RETURN TAD FILXM7 /READ IN INFO DCA FILXCN /STORE -7 AS DATA COUNTER FILX03, TAD I FILXPT /TRANSFER THE DATA DCA I FILX01 /TO HERE ISZ FILX01 /INCREMENT POINTER ISZ FILXCN /ALL DONE? JMP FILX03 /NO--LOOP ON BACK TAD FILX01 /YES--NOW WE MUST BACK UP; GET NEW POINTER; AND STORE PPN TAD FILXM4 /BACK UP POINTER DCA FILXTM /STORE POINTER TAD I FILXTM /GET THE NEW POINTER DCA FILXPT /STORE IT TAD Z PPN /GET THE CURRENT PPN DCA I FILXTM /STORE IT OVER LINK WORD TAD FILXPT /GET OUR NEW POINTER SZA /ZERO??--IF SO LEAVE ZERO FOR ERROR FLAG TAD FILXOS /NO--OFFSET IT FOR NEXT TIME DCA FILXPT /TUCK IT AWAY JMP I FILX01 /AND EXIT / /COME HERE IF ZERO IS FOUND AS POINTER. / /THIS IS THE CASE WHEN THERE ARE NO MORE FILES IN THE UFD. FIRST WE /PUT "FILXOS" IN "FILXPT" AS WE ASSUME NEXT TIME FILX01 IS CALLED WE WILL HAVE A /HAVE A NEW UFD. / FILXER, TAD FILXOS /ERROR--PUT UFDBUF-1 IN FILXPT DCA FILXPT /AS NEXT TIME WE SHOULD HAVE ANOTHER UFD TAD I FILX01 /GET ERROR RETURN DCA .+2 JMP I .+1 /AND DO AN ERROR RETURN! .-. FILXP3, UFDBUF+3 /POINTER TO FIRST LINK WORD FILXTM, . /TEMPORARY REGISTER FILXCN, . /TEMPORARY COUNTER FILXOS, UFDBUF-1 /BUFFER OFFSET FILXM4, -0004 /CONSTANT TO BACK UP POINTER FILXM7, -0007 /AMOUNT OF DATA TO TRANSFER
/ /ROUTINE TO PRINT A PPN IN THE FORM XX,XX. / /CALL: ACTOUT (PPN IN AC) / RETURN / ACTX01, 0 DCA ACTX02 /STORE IT FOR NOW TAD ACTX02 /BUT NOT FOR LONG CLL RTR /ROTATE 6 BITS RTR RTR AND ACTX77 /MASK OFFTHE NEW LO-ORDER 6 BITS PUTNUM S 2 TAD ACTXCM /OUTPUT THE COMMA PUTCHR 0001 TAD ACTX02 /GET THE PPN AGAIN AND ACTX77 /MASK OFF T LO-ORDER 6 BITS PUTNUM S 2 CLA CLL /JUST TO BE NEAT JMP I ACTX01 /NOW EXIT-- ACTX02, . /TEMPORARY STORAGE FOR PPN ACTX77, 0077 /PPN MASK ACTXCM, ", /COMMA FOR FORMATTING GIGO
/ /DEBUG ROUTINE / /PRINTS CONTENTS OF AC AND RETURNS, WITH RESTORED AC / /CALL: JMS (DEBUG) / RETURN / DEBUG, 0 DCA DEBU TAD DEBU PUTNUM 04 TAD DEBU JMP I DEBUG DEBU, 0 PAGE
/ /DECTAPE HANDLERS FOR TSS/8 FAILSAFE / / /ROUTINE TO PUT DATA ONTO A DECTAPE / /CALL: DTAPUT / DRIVE # / BLOCK # / BUFFER-1 / RETURN / DTPUT, 0 TAD DTWRIT /BIT6 SET DCA DTRW /STORE IT IN FUNCTION WORD TAD DTPUT /GET RETURN ADDRESS DTGO, DCA DTASRV /STORE IT JMP DTASRV+1 /AND START THOSE DECTAPES! / /ROUTINE TO RETREIVE DATA OFF OF A DECTAPE. / /CALL: DTAGET / UNIT # / BLOCK # / BUFFER-1 / DTGET, 0 TAD DTREAD /BIT7 SET DCA DTRW /STORE IT IN FUNCTION WORD TAD DTGET /GET RETURN ADDRESS JMP DTGO /AND OFF WE GO DTWRIT, BIT6 DTREAD, BIT7
/ /DECTAPE HANDLER / /THIS IS THE SUBROUTINE THAT ACTUALLY MOVES THE DECTAPES. / DTASRV, 0 TAD I DTASRV /GET UNIT NUMBER CLL RTR /ROTATE INTO CORRECT BITS RTR /AGAIN-- TAD DTRW /ADD IN FUNCTION WORD DCA DTBLK+1 /STORE IN PARAMETERS BLOCK ISZ DTASRV /INCREMENT TO NEXT PARAMETER TAD I DTASRV /GET BLOCK NUMBER CONVERT /CONVERT TO LOGICAL BLOCK NUMBER DCA DTBLK+2 /STORE IT ISZ DTASRV TAD I DTASRV /GET ADDRESS OF BUFFER-1 DCA DTBLK+3 /STORE IT ISZ DTASRV TAD DTBLK /GET ADDRESS OF PARAMETERS DTXA /AND MOVE THAT DECTAPE!! DTSF /HANG AROUND UNTILL IT'S DONE JMP .-1 DTRB /CHECK SOME FLAGS AND DTERFL /CHECK ERROR FLAGS SZA /ARE ANY FLAGS SET?? ERR3=. ERROR /YES--TELL OPR SO-- JMP I DTASRV /EXIT-- DTBLK, .+1 /DECTAPE PARAMETER BLOCK 0 /BITS0-2=TRANSPORT;BITS6-8=FUNCTION 0 /DECTAPE BLOCK NUMBER 0 /CORE ADDRESS-1 OF BUFFER DTERFL, BIT0 /MASK FOR CHECKING DECTAPE ERROR FLAGS DTRW, . /FUNCTION STORAGE WORD
/ /ROUTINE TO CHECK FOR FAILSAFE TAPE ID / /CALL: FAICHK / DRIVE / ILLEGAL RETURN / OKAY RETURN / FCHX01, 0 TAD I FCHX01 /GET DRIVE ISZ FCHX01 DCA FCHX02 /STORE IT DTAGET /GET BLOCK ONE FCHX02, . /DRIVE BLOCK1 /BLOCK DIRBUF-1 /BUFFER TAD I FCHX03 /GET FIRST FOUR LOCATION TAD I FCHX04 TAD I FCHX05 TAD I FCHX06 TAD MFAILS /GET WHAT IT SHOULD BE FOR "FAILSA " SZA CLA /COMPARE JMP I FCHX01 /ERROR ISZ FCHX01 JMP I FCHX01 /OKAY--RETURN AND SKIP FCHX03, DIRBUF FCHX04, DIRBUF+1 FCHX05, DIRBUF+2 FCHX06, DIRBUF+3 MFAILS, -356
/ /ROUTINE TO CHECK FOR FULL DIRECTORY / /CALL: DIRFUL / FULL DIRECTORY RETURN / NORMAL RETURN / DFX01, 0 TAD FDIRPT /GET THE DIRECTORY POINTER CIA /NEGATE TAD DFX02 /COMPARE TO END OF DIRBUF SNA CLA /FULL? JMP I DFX01 /YES-- ISZ DFX01 /NO--SKIP JMP I DFX01 /EXIT DFX02, DIRBUF+177
/ /MESSAGES LEFT OVER FROM THE FILE OUTPUT ROUTINE. / DPW8MS, TEXT / UNABLE TO OPEN FILE '/ DPW1MS, TEXT / UNABLE TO READ FILE '/ DPW9MS, TEXT /' ["/ DPW9M, "];215;212
/ /ROUTINE TO CONVERT A LOGICAL BLOCK NUMBER TO A PHYSICAL BLOCK NUMBER. / /CALL: TAD BLOCK NUMBER / CONVERT / RETURN WITH PHYSICAL BLOCK NUMBER / CONV01, 0 DCA CONV02 DCA CONV03 /CLEAR OUT COUNTER TAD CONV02 ISZ CONV03 /INCREMENT COOUNTER TAD COM270 /SUBTRACT 270 SMA JMP .-3 /STILL >270 TAD CON270 /RECOVER RTL /*10 RAL AND CN7770 /GET SIGNIFICANT PART TAD CN7777 /DECREMENT TAD CONV03 /GET LO-ORDER JMP I CONV01 /EXIT CONV02, 0 CONV03, 0 COM270, -0270 CON270, 0270 CN7770, 7770 CN7777, 7777 PAGE
IFZERO SYSTEM-1 < / /ROUTINE TO CHANGE PPN. / /CALL: LIN (PPN IN AC) / RETURN / LGIN, 0 DCA NEWPPN /STORE NEW PPN USE /GET OUR JOB NUMBER TAD PRVST /GET START OF PRVTBL DCA PRIV /STORE AS ADDRESS IN TS8II TO PEEK AT TAD PEKBLK /SET UP FOR A PEEK 6423 /TO GET OUR CURRENT PRIV WORD TAD PSW /GET PRIV WORD INTO THE AC AND CMASK /DUMP ACCOUNT CHANGE ENABLE BIT TAD CBIT /AND GET IT BACK AGAIN (THIS DUMPS OVERFLOW) DCA PSW /STORE IT AGAIN TAD PRIV /TRANSFER ADDRESS TO POKE BLOCK DCA PRIV2 TAD POKBLK /POKE IN NEW PRIV WORD 6424 TAD NEWPPN /GET THE PPN WE WANT TO CHANGE TO 6615 /AND CHANGE TO IT CLA /IN CASE OF ERROR, OUR OTHER CHECK WILL GET IT. TAD PSW /GET PRIVE WORD AND CMASK /CLEAR ACCOUNT CHANGE ENABLE DCA PSW /AND PUT IT BACK TAD POKBLK 6424 /NOW POKE IT BACK ACT /CHECK TO SEE IF IT WORKED CIA TAD NEWPPN /CHECK AGAINST WISHED FOR PPN SZA CLA ERROR /VERY BAD ERROR IF IT DIDN'T WORK JMP I LGIN /EXIT-- NEWPPN, . /REGISTER FOR PPN PSW, . /REGISTER FOR PRIV WORD PRVST, 0400 /START OF PRVTBL IN TS8II CMASK, -ACHGEN-1-200 /MASK TO CLEAR ACCOUNT CHANGE ENABLE CBIT, ACHGEN /BIT TO SET ACCOUNT CHANGE ENABLE PEKBLK, .+1 10 PRIV, 0 PSW 7777 POKBLK, .+1 10 PSW PRIV2, 0 7777 >
IFNZRO SYSTEM-1 < / /FREE DIRECTORY BLOCK FETCH ROUTINE / /THIS ROUTINE SEARCHES THE DIRECTORY IN CORE FOR A FREE BLOCK, AND RETURNS /WITH ITS ADDRESS / /CALL: GETBLK / ERROR RETURN (NO FREE BLOCKS) / NORMAL RETURN (BLOCK LOCATION IN AC) / GB001, 0 TAD GBUFD /GET START OF DIRECTORY DCA GBPT /STORE AS POINTER FOR SEARCH GB002, TAD I GBPT /GET FIRST WORD OF BLOCK SNA CLA /ZERO? JMP GB003 /YES-- COULD BE A FREE BLOCK GB004, TAD GB0010 /NOPE-- INCREMENT TO NEXT BLOCK TAD GBPT /ADD IN OLD POINTER SNA /HAVE WE OVERFLOWED ALL THE WAY AROUND JMP I GB001 /YES-- TAKE ERROR RETURN DCA GBPT /NO-- STORE AS NEW POINTER JMP GB002 /LOOP ON BACK GB003, ISZ GBPT /WE HAVE BLOCK WITH FIRST WORD ZERO TAD I GBPT /LOOK AT SECOND WORD TO MAKE SURE ITS NOT SNA CLA /LAST BLOCK OF SEGMENT POINTERS JMP GB005 /IT'S NOT! WE GOT ONE STA /IT WAS, KEEP LOOKING JMP GB004 GB005, TAD GBPT /CONVERT POINTER TO REAL TAD GBMUF DCA Z UFHIA /STORE AS HIGHEST MODIFIED LOC IN UFD TAD Z UFHIA /GRABIT BACK ISZ GB001 /INCREMENT PAST ERROR RETURN JMP I GB001 /AND EXIT GBUFD, UFDBUF+10 /POINTER TO FIRST POSSIBLE FREE BLOCK GB0010, 0010 /TURKEY CONSTANT GBMUF, -UFDBUF /BUFFER OFFSET GBPT, 0 /POINTER INTO UFD
/ /INITIALIZATION ROUTINE FOR MFD / /THIS ROUTINE CREATES A FILE IN THE UFD, CAUSES THE MFD TO BE READ /IN, FIND THE FILE IN THE MFD, FINDS ITS SECOND RETREIVAL POINTER /AND STORES IT'S LOCATION. / /CALL: MFDINI / RETURN / MFDI01, 0 TAD MCRBLK /GET BLOCK FOR CREATION CRF /CREATE IT SZA /ERROR? ERROR /YOU BET ERR8=. GETMFD /GET MFD INTO CORE TAD MFDOS /GET START OF MFD DCA Z FILXPT /STUFF IT INTO AN AUTO-INDEX MFDI02, TAD Z FILXPT DCA MFDTMP /STOW IT FOR LATER FILINF /GET INFO ON A FILE (UFD) MFDI03 /ERROR RETURN MFDINM, 0 0 0 0 0 0 0 TAD MFDINM /SEE IF ITS THE FILE WE CREATED TAD MFDNAM SZA CLA JMP MFDI02 TAD MFDINM+1 TAD MFDNAM+1 SZA CLA JMP MFDI02 TAD MFDINM+2 TAD MFDNAM+2 SZA CLA JMP MFDI02 CLA CLL IAC RTL /FOUND IT! TAD MFDTMP /GET POINTER TO RETREIVAL BLOCK DCA MFDTMP CLA CLL IAC RAL /AC_0002 TAD I MFDTMP /THIS WILL GIVE US SECOND SEGMENTPOINTER DCA Z SEGPNT /STORE AS SUCH FOR LATER ROUTINES JMP I MFDI01 /EXIT MFDI03, ERROR /FILE NOT FOUND ERR9=. MFDOS, UFDBUF-1 MFDNAM, -4641 -5154 -6341 MCRBLK, .+1 4641 /FA 5154 /IL 6341 /SA MFDTMP, 0 >
/ /ROUTINE TO CHECK FOR ARCHIVE TAPE ID. / /CALL: ARKCHK / DRIVE / ILLEGAL RETURN / OK RETURN / ACHX01, 0 TAD I ACHX01 /GET DRIVE ISZ ACHX01 /INCREMENT DCA ACHX02 /STORE IT DTAGET /GET DECTAPE "BLOCK1" ACHX02, . /DRIVE BLOCK1 /BLOCK ARKBUF-1 TAD I ACHX03 /GET FIRST 4 LOCATIONS TAD I ACHX04 TAD I ACHX05 TAD I ACHX06 TAD MARKS /GET WHAT IT SHOULD BE FOR "ARKIVE " SZA CLA JMP I ACHX01 /ERROR ISZ ACHX01 /OK--INCREMENT PAST ERROR RETURN JMP I ACHX01 /AND EXIT ACHX03, ARKBUF ACHX04, ARKBUF+1 ACHX05, ARKBUF+2 ACHX06, ARKBUF+3 MARKS, -0400
/ /ROUTINE TO FLAG A BUM TAPE ID. / /CALL: BUMTAP / RETURN ON ^C FROM OPR0: / NOGUD, 0 CRLF /FORMAT-- TAD CONTC1 /SET NEW RESTART ADDRESS SRA /TO CONTINUE FAILSAFE ON ^C TAD TAPMS1 /"ILLEGAL TAPE ID....." PUTCHR P 52 CRLF /FORMAT TOUCHS-- TAD WAIT /WAIT 60 SECONDS FOR OPERATOR TO WAKE UP STM /ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ NOGU2, CLA /COME HERE ON ^C FROM OPR0: TAD CONTC2 /RESET ^C TO HALT SRA JMP I NOGUD /EXIT CONTC1, NOGU2 CONTC2, 0002 WAIT, 0055 /45 (10) SECONDS TAPMS1, .+1 TEXT /ILLEGAL TAPE ID--OPERATOR ACTION REQUESTED/ PAGE
/ /ERROR ROUTINE / /CALL: ERROR / NO RETURN / / /THIS IS JUST A STOPGAP ERROR PROCESSOR, SOMEDAY WE WILL INSTALL A FULL /BLOWN ERROR DIAGNOSTIC SYSTEM TO TELL TEH OPERATOR EXACTLY WHAT WENT /WRONG WHERE, WHEN, AND WHY. THAT IS WHY YOU FIND "ERRX=." /SCATTERED THRUOUT THE PROGRAM, THAT IS THE BEGINNINGS OF THE /DIAGNOSTICS. THIS HACKER SHOULD DO FOR NOW. / ERRPRT, 0 DCA L2SA /SAVE AC AT ERROR TIME TAD ERRMS /"NON-RECOVERABLE ERROR AT USER LOCATION " PUTCHR /JUST SO THE OPR KNOWS WHY THE DECTAPES STOPPED P 57 STA /PRINT ERROR ADRESS-1 TAD ERRPRT /GET ADDRESS+1 OF ERROR PUTNUM 4 CRLF /FANCY!! TAD L2SA /RECOVER AC HLT /AND STOP L2SA, . /AC AT ERROR INTERRUPT TIME ERRMS, .+1 TEXT /NON-RECOVERABLE ERROR OCCURING AT USER ADDRESS /
/ /EXTENSION PRINTING ROUTINE / /PRINTS THE EXTENSION OF THE PROTECTION/EXTENSION IN THE AC AT ENTRY / / /CALL: EXTPRT (EXTENSION IN AC) / RETURN / EXTENS, 0 AND C7600 /DROP OFF PROTECTION BITS CLL RTR /ROTATE EXTENSION INTO BITS 4-9 RTR RTR TAD EXTMSL /OFFSET AGAINST TEXT TABLE PUTCHR P 4 /OUTPUT EXTENSION IN FAMILIAR .XXX FORMAT JMP I EXTENS /EXIT C7600, 7600 EXTMSL, EXTMS1 EXTMS1, TEXT /.SI .ASC.SAV.BIN.BAS.BAC/ *.-1 TEXT /.FCL.TMP.DAT / *.-1 TEXT / .PAL.ALG/ *.-1 TEXT /.F4 .DOC.TXT.SYS.ARK.CBL/ *.-1 TEXT /.CAL.APL.OVL.LST /
/ /SPACE ROUTINE / /ANOTHER HACKER!! / /CALL: SPACE / NUMBER OF SPACE TO BE OUTPUT / RETURN / SPAC01, 0 TAD I SPAC01 /GET NUMBER OF SPACES WANTED ISZ SPAC01 /INCREMENT FOR RETURN TAD SPP /FLAG 'EM AS BEING PACKED DCA .+3 /STORE IN PARAMETERS WORD TAD SPACES PUTCHR P 1 JMP I SPAC01 /EXIT SPP, P SPACES, .+1 4040;4040;4040
/ /ROUTINE TO CHECK TO SEE IF FILE SHOULD BE ARCHIVED / /ALSO CALLS THE ARCHIVING ROUTINES. / /CALL: CHKARK / RETURN IF FILE ARCHIVED / RETURN IF FILE NOT ARCHIVED / / /FOR NOW, SINCE WE HAVE NOT YET IMPLEMENTED THE ARCHIVE SYSTEM /(SOMEDAY!), WE WILL MERELY SKIP THE ARCHIVE RETURN AND PLOW AHEAD. / CHAX01, 0 ISZ CHAX01 /ARCHIVE SYSTEM NOT IMPLEMENTED JMP I CHAX01 PAGE
PAGE / /UTILITY ROUTINE-----ASCOUT / / /CHARACTER TYPING ROUTINE / /CALL: TAD (ADDR OF 1ST CHAR / PUTCHR / (NUMBER OF CHRS / /THE WORD COUNT ALSO CONTAINS THE FOLLOWING /PARAMETERS: / / BIT 0 IS SET IF THEY ARE PACKED / BIT 1 IS SET IF THEY ARE PACKED IN TSS/8 / INTERNAL CODE (EXCESS 40) / /NOTE: IF ONLY ONE CHAR IS SPECIFIED IT IS ASSUMED / TO BE IN THE AC. / P=4000 T=2000 ASCOUT, 0 DCA CHRPTR STA TAD I ASCOUT SZA CLA JMP .+6 TAD CHRPTR TLS CLA ISZ ASCOUT JMP I ASCOUT TAD I ASCOUT AND C77 CIA DCA OUTCNT TAD I ASCOUT SPA CLA JMP UNPACK TAD I CHRPTR TLS CLA ISZ CHRPTR ISZ OUTCNT JMP .-5 OTCEXT, CLA ISZ ASCOUT JMP I ASCOUT UNPACK, TAD I ASCOUT RTL; CLA SZL TAD C40 DCA CONVRT NPCK1, TAD I CHRPTR RTR; RTR; RTR JMS EXPAND ISZ OUTCNT SKP JMP OTCEXT TAD I CHRPTR JMS EXPAND ISZ CHRPTR ISZ OUTCNT JMP NPCK1 JMP OTCEXT CONVRT, 0 EXPAND, 0 TAD CONVRT AND C77 DCA SIXBIT TAD SIXBIT AND C40 SNA CLA TAD KC100 TAD KC200 TAD SIXBIT TLS CLA JMP I EXPAND SIXBIT, 0 CHRPTR, 0 OUTCNT, 0 C40, 0040 C77, 0077 KC100, 0100 KC200, 0200 / /CRLF ROUTINE / CRLFB, 0 CLA CLL TAD CRLFMS PUTCHR 2 JMP I CRLFB CRLFMS, .+1 215; 212 PAGE / /COMBINATION OCTAL-DECIMAL OUTPUT ROUTINE / /COURTESY JOHN YOUNG / /CALL: TAD VALUE / PUTNUM / S D 3 / RETURN / / /S S MEANS SUPRESS LEADING ZEROES /D D MEANS CONVERT OUTPUT TO DECIMAL /3 3 IS NUMBER OF DIGITS TO OUTPUT (1-4) / / S=4000 D=1000 NUMOUT, 0 DCA NUMBER TAD I NUMOUT CLL RAL /OCTAL OR DECIMAL OUTPUT? SPA CLA TAD NUMDO /DECIMAL TAD NUMOPT DCA NUMSPT /PUT IN STACK POINTER TAD P260 DCA NUMDT+1 TAD P260 DCA NUMDT+2 TAD P260 DCA NUMDT+3 TAD NUMDPT /SET DATA POINTER DCA NUMDT CMA CLL RTL DCA NUMCNT /SET UP ISZ LOOP TAD NUMBER /GETETH OUT THY NUMBER NUMLOP, TAD I NUMSPT /TAKE AWAY VALUE SPA JMP .+3 /IF NEG, CHANGE TO POWER-1 ISZ I NUMDT /TAKEN AWAY VAL, INCREMENT VALUE JMP NUMLOP /TAKE AWAY MORE DCA NUMBER /WE TOOK TOO MUCH TAD I NUMSPT /ADD THAT VALUE BACK CIA TAD NUMBER ISZ NUMDT /INCREMENT TO NEXT CHARACTER ISZ NUMSPT /INCREMENT STKPNT TONEXT VALUE ISZ NUMCNT /ARE WE DONE? JMP NUMLOP /NOPE, GOWAN BACK! TAD P4260 /THIS IS A ZERO, BUT IT IS DCA NUMDT+4 /NEGATIVE, INDICATES ENDOF STACK TAD I NUMOUT /ARE WE TO SUPRESS SMA CLA /LEADING ZEROES? JMP NUMPUT /NO--GO TO OUTPUT TAD NUMDPT DCA NUMDT CMA CLL RTL DCA NUMCNT NUMSUP, TAD P260 CIA TAD I NUMDT /IF THIS IS A ZERO SZA CLA /PUT A SPACE THERE INSTEAD JMP NUMPUT /IF NOT, DONT SUPPRESS ANYMORE TAD P240 DCA I NUMDT ISZ NUMDT ISZ NUMCNT /IF THIS IS ALL ZERO NUMBER JMP NUMSUP /DON'T SUPPRESS LAST ONE NUMPUT, TAD I NUMOUT /FIGURE NUMBER OF CHARS TO OUTPUT AND P7 /AND WHERE TO START CIA TAD NUMOPN DCA 17 TAD I 17 TLS SMA CLA JMP .-3 ISZ NUMOUT JMP I NUMOUT / /DATA AND CONSTANTS / P260, 0260 P240, 0240 P7, 0007 P4260, 4260 NUMCNT, .-. NUMSPT, .-. NUMBER, .-. NUMDO, NUMDEC-NUMOCT NUMOPT, NUMOCT NUMDEC, 6030 /-1000 DECIMAL 7634 /-100 DECIMAL 7766 /-10 DECIMAL NUMOCT, 7000 /-1000 OCTAL 7700 /-100 OCTAL 7770 /-10 OCTAL NUMDPT, .+2 NUMDT, .+1 0 /THOUSANDS 0 /HUNDREDS 0 /TENS 0 /ONES+4000 NUMOPN, .-1 PAGE
/ /ROUTINE TO OUTPUT THE DATE IN THE FORM DD-MMM-YY / /CALL: DATE / PUTDATE / RETURN / DATER, 0 DCA DATDAY DCA DATYR DATE1, TAD DATDAY SMA CLA JMP DATE2 ISZ DATYR TAD DATDAY TAD N564 DCA DATDAY JMP DATE1 DATE2, DCA DATMON TAD DATDAY TAD N37 SPA JMP .+4 ISZ DATMON DCA DATDAY JMP .-6 CLA ISZ DATDAY /NOW WE HAVE THE DAY IN DATDAY /YEAR*12+MONTH IN DATMON TAD DATYR TAD C100 DCA DATYR DATE3, TAD DATMON TAD N14 SPA JMP .+4 ISZ DATYR DCA DATMON JMP DATE3 CLA TAD DATDAY PUTNUM S D 2 TAD DASH PUTCHR 01 TAD DATMON CLL RAL TAD MONTHL PUTCHR P 4 TAD DATYR PUTNUM S D 2 JMP I DATER DATDAY, . DATMON, . DATYR, . N564, -0564 N37, -0037 N14, -0014 C100, 0100 DASH, "- MONTHL, MONTHS
/ /ROUTINE TO OUTPUT THE TIME OF DAY. / /CALL: PUTIME / RETURN / TIME0, 0 TIME, TAD CHRBFL DCA POINT TAD PTFORM DCA PTCONT PTLOOP, TAD PT260 DCA PTDIGI CLL TAD NUMHO+1 PTIMX, TAD DCTAB1 DCA NUMHO+2 RAL TAD NUMHO PTIMX1, TAD DCTAB SNL JMP PTIMA DCA NUMHO TAD NUMHO+2 DCA NUMHO+1 ISZ PTDIGI JMP PTIMX-2 PTIMA, ISZ PTIMX ISZ PTIMX1 CLA TAD PTDIGI DCA I POINT ISZ POINT TAD PTCONT SNA JMP OUTBUF RAL CLL DCA PTCONT SZL JMP PTLOOP TAD PTCOLN DCA I POINT ISZ POINT JMP PTLOOP PTFORM, 5200 OUTBUF, TAD CHRBFL PUTCHR 10 JMP I TIME0 POINT, 0 PTDIGI, 0 PTCONT, 0 PT260, 260 PTCOLN, ": CHRBFL, CHRBUF N24, -0024 PAGE
/ /LIST OF MONTHES USED BY PUTDATE / MONTHS, TEXT /JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC-/ PAGE
/ /LISTING ROUTINES / /CALL: JMP LISTR / NO RETURN / *UFDBUF LISTR, CLA CLL CRLF TAD Z LISDRV /GET THE DRIVE DCA LISX01 FAICHK /CHECK FOR FAILSAFE FORMAT LISX01, 0 /DRIVE SKP /ERROR JMP LISX02 /FAILSAFE FORMAT TAD Z LISDRV /GET THE DRIVE AGAIN DCA LISX03 ARKCHK /CHECK FOR ARCHIVE FORMAT LISX03, 0 /DRIVE SKP /BAD TAPE FORMAT JMP LISX04 /ARCHIVE FORMAT BUMTAP /NOTIFY OPERATOR JMP LISTR /SEE IF HE'S FIXED IT LISX02, TAD LISM1 /"FAILSAFE " PUTCHR P 11 JMP LISX05 LISX04, TAD LISM2 /"ARCHIVE " PUTCHR P 10 LISX05, TAD LISM3 /"TAPE FOR " PUTCHR P 11 TAD Z LISDRV /GET DRIVE DCA LISX06 DTAGET /GET FIRST DIRECTORY BLOCK LISX06, . BLOCK1 DTABUF-1 TAD I DATPLC /GET DATE OFF TAPE PUTDATE /OUTPUT IT SPACE 1 TAD I TIMPLC /TRANSFER TIME DCA Z NUMHO TAD I TIMPL2 DCA Z NUMHO+1 PUTIME /OUTPUT IT CRLF /FORMAT GIGO CRLF TAD LISHL /OUPUT HEADING PUTCHR P 55 CRLF CRLF RTINIT /INITIALIZE POINTERS TAD LISDRV /GET OUR DRIVE DCA LISX08 /STORE DTAGET LISX08, . /DRIVE BLOCK1 /BLOCK DIRBUF-1 /BUFFER DCA LISNUM DCA LISSEG LISX07, RETINF /GET RETREIVAL INFORMATION LISDON LNAME0, . /2 CHARS OF FILE NAME LNAME1, . /2 CHARS OF FILE NAME LNAME2, . /2 CHARS OF FILE NAME LPPN, . /PPN OF FILE OWNER LPROT, . /PROTECTION/EXTENSION OF FILE LSIZE, . /SIZE OF FILE LDATE, . /DATE OF CREATION FOR FILE LBLK1, . /LOGICAL STARTING BLOCK FOR FILE RETREIVAL ISZ Z LISNUM /INCREMENT NUMBER OF FILES FOUND TAD LNAME /GET LINK TO FILE NAME PUTCHR P T 6 TAD LPROT /GET FILE EXTESION/PROTECTION EXTPRT /OUTPUT EXTENSION SPACE 3 TAD LPROT /GET FILE EXTENSION/PROTECTION AND PROTMK /DUMP EXTENSION BITS PUTNUM S 2 SPACE 3 TAD LSIZE /GET FILE SIZE PUTNUM S D 3 TAD LSIZE /UPDATE SEGMENT COUNT TAD LISSEG DCA LISSEG SPACE 2 TAD LDATE /GET FILE'S DATE OF CREATION PUTDATE /OUPUT IT SPACE 3 TAD LBLK1 /GET STARTING BLOCK (LOGICAL) OF FILE PUTNUM S 4 SPACE 2 TAD LPPN /GET PPN OF FILE OWNER ACTOUT CRLF JMP LISX07 /NO-- LISM1, LISMS1 LISM2, LISMS2 LISM3, LISMS3 LISHL, LISHED DATPLC, DTABUF+6 TIMPLC, DTABUF+4 TIMPL2, DTABUF+4 LNAME, LNAME0 PROTMK, 0377 PAGE
/ /SECOND PART OF LISTING ROUTINE / LISDON, CLA CLL CRLF TAD LISDM1 /"TOTAL OF " PUTCHR P 11 TAD LISSEG PUTNUM S D 3 TAD LISDM2 PUTCHR P 13 /" BLOCKS IN " TAD LISNUM PUTNUM S D 3 TAD LISDM3 /" FILE" PUTCHR P 6 CRLF CRLF HLT /ALL DONE / /MESSAGES / LISMS1, TEXT /FAILSAFE / LISMS2, TEXT /ARCHIVE / *.-1 LISMS3, TEXT /TAPE FOR / LISDM1, .+1 TEXT /TOTAL OF / LISDM2, .+1 TEXT / BLOCKS IN / LISDM3, .+1 TEXT / FILES/ *.-1 LISHED, TEXT / NAME EXT PROT SIZE DATE BLK 1 PPN/ PAGE
/ /ROUTINE TO RESTORE THE FILE STRUCTURE. / /CALL: JMP RESTOR / NO RETURN / RESTOR, TAD RETDRV /GET DRIVE DCA REST01 /STORE FOR DTA MOVE FAICHK /CHECK FOR FAILSAFE ID REST01, . /DRIVE JMP REST0 /BUM TAPE ID RTINIT /INITIALIZE ALL THE POINTERS TAD RETDRV /READ IN BLOCK 1 DCA REST02 /OFF THIS DRIVE DTAGET REST02, . BLOCK1 DIRBUF-1 REST03, RETINF /GET RETREIVAL INFORMATION ON A FILE RSTEND /GO THERE WHEN ALL DONE RNAME0, . /2 CHARS OF FILE NAME RNAME1, . /2 CHARS OF FILE NAME RNAME2, . /2 CHARS OF FILE NAME RPPN, . /PPN OF FILE OWNER RPROT, . /PROTECTION/EXTENSION OF FILE RSIZE, . /SIZE OF FILE RDATE, . /DATE OF CREATION FOR FILE RBLK1, . /LOGICAL BLOCK 1 FOR FILE RETREIVAL RETPUT /OUTPUT FILE TO DSK: JMP REST03 /LOOP AROUND FOR ANOTHER FILE REST0, BUMTAP JMP RESTOR
/ /ROUTINE TO GET RETRIEVAL INFORMATION ON A FILE. / /CALL: RETINF / ERROR RETURN (INDIRECT) / NAME / NAME / NAME / PPN / EXT/PROT / FILE SIZE / CREATE DATE / BLOCK NUMBER / RETURN / RTIX01, 0 TAD I RETPNT /GET TOP OF ENTRY SNA /ZERO? JMP RETEND /YES--TAKE ERROR RETURN ISZ RTIX01 /NO--INCREMENT RETURN VECTOR DCA I RTIX01 /STORE WORD 1 ISZ RETPNT /LOOP ON THRU WHILE STORING INFORMATION TAD I RETPNT ISZ RTIX01 /INCREMENT POINTER DCA I RTIX01 ISZ RTICNT /ALL 10 WORDS TRANSFERRED?? JMP .-5 /NOPE-- TAD RTM7 /YES--REPLACE COUNTER FOR NEXT TIME AROUND DCA RTICNT ISZ RETPNT ISZ RTIX01 /INCREMENT FOR RETURN ISZ RETCNT /TRANSFERRED A DECTAPE BLOCK'S WORTH YET?? JMP I RTIX01 /NO--EXIT TAD I RETPNT /YES--GET BLOCK # SNA /ZERO?? JMP I RTIX01 /YES--LEAVE FOR ERROR TRAP NEXT TIME AROUND DCA RTIX02 /NO--STORE FOR GET TAD RETDRV /GET OUR DRIVE DCA RTIX03 DTAGET RTIX03, . /DRIVE RTIX02, . /BLOCK DIRBUF-1 /BUFFER TAD RTIX04 /GET TOP OF BUFFER DCA RETPNT /STORE AS NEW POINTER TAD RTIX05 /RESET FILE COUNT TO -0020 DCA Z RETCNT /AND STORE FOR NEXT TIME AROUND JMP I RTIX01 /EXIT RETEND, TAD I RTIX01 /COME HERE ON ERROR DCA .+2 /STORE RETURN VECTOR JMP I .+1 .-. RTICNT, -0007 RTM7, -0007 RTIX04, DIRBUF RTIX05, -0020
/ /ROUTINE TO PRINT "RESTORE ERROR--". / /CALL: RERROR / RETURN / RERPRT, 0 CRLF /NOTHING LIKE FORMATTING TAD RERMS1 /"RESTORE FAILURE--" PUTCHR P 21 CRLF JMP I RERPRT RERMS1, .+1 TEXT /RESTORE FAILURE--/
/ /ROUTINE TO DELETE THE FILE OPEN ON IFN ZERO. / /CALL: DELETE / RETURN / DEL0, 0 TAD DELBLK RED SZA ERROR JMP I DEL0 DELBLK, .+1 0000 0400 PAGE
/ /ROUTINE TO OUTPUT A DECTAPE FILE TO DISK. / /CALL: RETPUT / RETURN / RTPX01, 0 IFNZRO SYSTEM-1 < UFDGET > /READ IN A NEW UFD IFZERO SYSTEM-1 < TAD I RPPNL /GET PPN OF FILE OWNER LIN > /LOGIN UNDER IT ISZ Z RLOKUP /INCREMENT NUMBER OF FILE LOOKUPS DCA Z FILNUM DCA Z ACTNUM /PPN [0,0] (ASSUME OURS) TAD I RNAM0 /TRANSFER NAME FOR OPEN AND CREATE DCA Z NAME0 TAD I RNAM1 DCA Z NAME0+1 TAD I RNAM2 DCA Z NAME0+2 TAD Z OPNBLK OPEN SNA CLA /OPEN OK?? (IT SHOULDN'T!!) JMP RTPX05 /YES--ERROR--FILE ALREADY EXISTS-- TAD CRNAME /NO--CREATE THE FILE CREATE SZA CLA /CREATE OK?? JMP RTPX06 /NO-- TAD Z OPNBLK /YES--NOW OPEN IT OPEN SZA CLA /OPEN OK?? JMP RTPX07 /NOPE-- TAD I RSIZL /YES--GET FILE SIZE CLL RAL /*2 FOR DECTAPE BLOCKS CIA /NEGATE FOR COUNTER DCA SIZCNT /STORE AS COUNTER STA /AC_7777 TAD I RSIZL /GET THE FILE SIZE DCA EXTSIZ /STORE A AMOUNT TO EXTEND TAD EXTBLK /SET UP FOR EXTEND EXT /EXTEND IT DCA Z HIGH /START SETTING UP FOR DISK WRITE LOOP CLA CLL IAC DCA Z NUMFIL DCA Z ADDR DCA Z DSERR RTPX02, TAD I RBLK1L /GET BLOCK # ISZ I RBLK1L /INCREMENT BLOCK # DCA RTPX03 /STORE FOR DECTAPE GET TAD Z RETDRV DCA RTPX04 DTAGET RTPX04, . RTPX03, . DTABUF-1 TAD RTM200 /WC FOR FILE TRANSFER DCA Z WC TAD DTABFL /GET START OF BUFFER-1 DCA Z CA TAD Z DSKBLK /GET THE PARAMETERS BLOCK WFILE /AND WRITE TAD Z DSERR /CHECK OUT ERROR SZA CLA /WELL???? JMP RTPX08 /ERROR!! CLL /JUST TO BE SURE TAD Z ADDR /INCREMENT DISK ADDRESS TAD RTC200 /BY 0200 (8) DCA Z ADDR SZL /OVERFLOW?? ISZ HIGH /YES--INCREMENT HIGH ORDER ADDRESS CLL /ONCE AGAIN--BE SURE ISZ SIZCNT /ALL DONE?? JMP RTPX02 /NO--LOOP ON BACK FOR ANOTHER DTA BLOCK'S WORTH TAD I RPROTL /GET PROTECTION/EXTENSION PROT /PROTECT FILE ISZ Z RFILES /INCREMENT NUMBER OF FILES TRANSFERED TAD I RSIZL /UPDATE NUMBER OF SEGMENTS TRANSFERRED TAD Z RSEGS DCA Z RSEGS JMP I RTPX01 /EXIT-- RNAM0, RNAME0 RNAM1, RNAME1 RNAM2, RNAME2 CRNAME, OPNBLK+3 RSIZL, RSIZE RBLK1L, RBLK1 SIZCNT, . RTM200, -0200 RTC200, 0200 DTABFL, DTABUF-1 RPROTL, RPROT RPPNL, RPPN RTP9XL, RTPX09 RTMS1L, RTMS1 RTMS2L, RTMS2 RTMS3L, RTMS3 RTMS4L, RTMS4 RTMS5L, RTMS5 EXTBLK, .+1 0 EXTSIZ, .
/ /ERROR ROUTINES FOR RESTORE. / RTPX05, RERROR TAD RTMS1L PUTCHR P 45 CRLF TAD RTMS2L PUTCHR P 13 JMP I RTP9XL RTPX06, RERROR TAD RTMS3L PUTCHR P 31 JMP I RTP9XL RTPX07, RERROR TAD RTMS4L PUTCHR P 45 CRLF TAD RTMS2L PUTCHR P 13 DELETE JMP I RTP9XL RTPX08, RERROR TAD RTMS5L PUTCHR P 35 DELETE JMP I RTP9XL PAGE
/ /ROUTINE TO END UP RESTORE. / RSTEND, CLA CLL IFNZRO SYSTEM < TAD RETACT LIN > CRLF TAD RSEX01 /"FILE SYSTEM RESTORED (" PUTCHR P 26 JMP I .+1 /USE CODE FROM FAILSAFE TO FINISH UP. FEXI1 RSEX01, .+1 TEXT /FILE SYSTEM RESTORED (/ *.-1
/ /ROUTINE TO INITIALIZE POINTERS AND REGISTERS FOR SYSTEM RESTORE. / /CALL: RTINIT / RETURN / RTINI, 0 DCA Z RLKER /CLEAR OUT ERROR COUNT DCA Z RLOKUP /CLEAR OUT LOOKUP COUNT DCA Z RFILES /CLEAR OUT FILE COUNT DCA Z RSEGS /CLEAR OUT SEGMENT COUNT TAD RTINI2 /SET UP POINTER INTO DIRECTORY DCA RETPNT /SKIPPING TAPE HEADER TAD RTINI3 /SET UP FILE COUNT FOR DIRECTORY DCA RETCNT /SKIPPING TAPE HEADER IFNZRO SYSTEM-1 < MFDINI > /PLAY WITH MFD TO ALLOW CREATES ON OTHER PPN'S JMP I RTINI /EXIT-- RTINI2, DIRBUF+10 RTINI3, -0017
/ /SECOND PART OF RETPUT ROUTINE / RTPX09, TAD RNAM0L /OUTPUT NAME PUTCHR P T 6 TAD I RPRTL /OUTPUT EXTENSION EXTPRT TAD RTMS6L /"' [" PUTCHR P 3 TAD Z PPN /OUPUT PPN ACTOUT TAD RTMS7L PUTCHR 3 ISZ Z RLKER TAD I .+4 DCA .+2 JMP I .+1 .-. RTPX01 RTMS6L, DPW9MS RTMS7L, DPW9M RNAM0L, RNAME0 RPRTL, RPROT
/ /MESSAGES FOR THE RESTORE ROUTINES. / RTMS1, TEXT / FILE TO BE RESTORED ALREADY EXISTS./ RTMS2, TEXT / FILE IS '/ RTMS3, TEXT / UNABLE TO CREATE FILE '/ RTMS4, TEXT / UNABLE TO OPEN FILE AFTER CREATION./ RTMS5, TEXT / UNABLE TO WRITE ONTO FILE '/ PAGE
/ /DUMMY OPTION SERVER. / /THIS IS A VERY KLUDGY PROGRAM/USER INTERFACE, BUT DON'T DESPAIR, A /MUCH BETTER ONE IS IN THE MAKING. SO FOR NOW--THE FORMAT IS / .FAILSA/<OPTION><DECTAPE DRIVE> / /THUS, FOR A FAILSAFE ONTO DTA4: / / .FAILSA/F4 / /THE OPTIONS AVAILABLE ARE: / / F FAILSAFE / L LIST / R RESTORE / SUPER, CLA CLL IAC CML RAL /AC_0003 SRA /HALT ON ^C CLA CLL CML RAR /AC_4000 KSB /BREAK ON ANY KBD CHARACTER ACT /STORE ACCOUNT IN CASE OF ^C DCA RETACT KSF /A CHARACTER IN BUFFER? JMP SUP07 /NO--ERROR KRB /YES--GET IT CIA /NEGATE DCA TCHAR /STORE IN TEMPORARY REGISTER TAD TCHAR /GET IT AGAIN TAD KF SZA CLA /IS IT AN "F"?? JMP SUP01 /NO-- TAD SUPFAI /YES--GET ADDRESS FOR FAILSAFE JMP SUP04 /OFF-- SUP01, TAD TCHAR TAD KL /IS IT AN "L"?? SZA CLA JMP SUP02 /NO-- TAD SUPLIS /YES--GET LISTING DISPATCH JMP SUP04 SUP02, TAD TCHAR TAD KR SZA CLA /IS IT AN "R"?? JMP SUP03 /NO--ERROR TAD SUPRET /YES-- SUP04, DCA SUP05 /SAVE DISPATCH KSF /ANOTHER CHAR?? JMP SUP06 /NO--ERROR KRB /YES-- DCA TCHAR /STORE TEMPORARILY TAD TCHAR TAD N0215 /CHECK FOR CARRIAGE RETURN SNA CLA JMP SUP06 /ERROR-- TAD TCHAR TAD N0260 /CONVERT FROM ASCII DCA Z LISDRV /STORE AS DRIVE TAD Z LISDRV DCA Z RETDRV TAD Z RETDRV DCA Z FAIDRV CLA CLL JMP I SUP05 /OFF TO CORRECT ROUTINE SUP05, .-. SUP07, TAD SUPMS1 PUTCHR P 41 JMP SUP08 SUP03, TAD SUPMS2 PUTCHR P 35 JMP SUP08 SUP06, TAD SUPMS3 PUTCHR P 35 SUP08, CRLF CRLF HLT TCHAR, . KF, "F KR, "R KL, "L N0260, -0260 N0215, -0215 SUPFAI, FAILSA SUPLIS, LISTR SUPRET, RESTOR SUPMS1, .+1 TEXT /OPTION REQUIRED FOR THIS VERSION./ SUPMS2, .+1 TEXT /ILLEGAL OPTION SPECIFICATION./ SUPMS3, .+1 TEXT /DRIVE SPECIFICATION REQUIRED./ *.-1 PAGE
$-$-$-$-$-$-$-$-$-$=$=$=$=$=$=$=$=$=$=$=$=$=$=$