.TITLE DSKLIB DISK LIBRARIAN .IDENT /V02.18/ ;;EXPIRE= 7377 ;THIS VERSION EXPIRES JULY 31, 1979 .ENABL LC ; Copyright (C) 1983 ; Berez Associates ; 64 Jacqueline Road ; Waltham, MA 02154 ; ;This software is furnished under a license for use only on a ;single computer system and may be copied only with the inclu- ;sion of the above copyright notice. This software, or any other ;copies thereof, may not be provided or otherwise made available ;to any other person except for use on such system and to one who ;agrees to these license terms. Title to and ownership of the ;software shall at all times remain in Berez Associates. .SBTTL DEFINE PROGRAM SECTIONS AND ATTRIBUTES .PSECT DATA,D ;MOST MODIFIABLE DATA .PSECT STRING,RO,D ;STRING SPACE, READ ONLY .PSECT CODE,RO ;INSTRUCTIONS, READ ONLY .PSECT BUFFER,D ;EXPANDABLE DATA AREA AT END OF PROGRAM .SBTTL USER OPTION LINKAGE AND SPECIAL OPTIONS .PSECT DATA ;GLOBALS DEFINED IN DLBOPT .GLOBL DPBLKS,PROMPT,OWNER,PRTNAM,CATNAM,DEVTAB,DEFORD .GLOBL TRMTYP,TT0COL,TT1COL,PRTCOL,PRTLNS,DEFCOL ;GLOBALS USED IN DLBOPT .GLOBL CNAME,CTYPE,CDATE,CDISK,CSIZE BUFLOC: DPBLKS+1*512.+BITMAP ;INITIAL BUFFER BOTTOM DISKS: DPBLKS+1*512.+BITMAP-DSKPTR/2 ;HIGHEST DISK NUMBER ALLOWED + 1 TUNE= 3 ;PERFORMANCE TUNING VALUE, 0 <= TUNE <= 5 ;IN GENERAL, HIGHER NUMBERS ARE MORE ;DISK SPACE EFFICIENT BUT LESS TIME EFFICIENT ;OTHER OPTIONS; 0=NO, 1=YES SCCA= 1 ;INTERCEPT CONTROL-C MTLOOK= 1 ;USE MULTI-TERMINAL INFO FOR TERMINAL TYPE SOBINS= 0 ;HARDWARE HAS SOB INSTRUCTION EIS= 1 ;HARDWARE HAS EXTENDED INSTRUCTION SET .SBTTL PROGRAMMING CONVENTIONS ;PROGRAM SECTIONS: ; CODE READ ONLY, CONTAINS ALL CODE AND SOME CONSTANT DATA ; DATA CONTAINS MOST DATA INCLUDING EVERYTHING MODIFIABLE ; STRING CONTAINS STRING DATA, MOSTLY FROM STRING MACROS ; BUFFER POINTS TO DYNAMICALLY ALLOCATED MEMORY ABOVE PROGRAM ;EACH SUBROUTINE IS OFFSET FROM THE NEXT BY A BLANK LINE. EACH BEGINS ;WITH A SHORT DESCRIPTION INCLUDING REGISTERS USED - BOTH ARGUMENTS ;AND RETURNED VALUES. ;GENERALLY, A SINGLE ARGUMENT IS PASSED IN R0. A SINGLE VALUE WILL ;LIKEWISE BE RETURNED IN R0. IN ANY CASE, R0 IS A SCRATCH REGISTER ;AND NEED NOT BE PRESERVED. ALL OTHER REGISTERS, EXCEPT WHERE OTHER- ;WISE SPECIFIED, MUST BE PRESERVED ACROSS EACH SUBROUTINE CALL. NOTE ;THAT TOP-LEVEL ROUTINES, COMx ROUTINES, ARE EXCLUDED FROM THIS ;RESTRICTION. ;SUBROUTINES ARE NORMALLY CALLED VIA JSR PC. THOSE THAT SKIP RETURN ;OR TAKE FOLLOWING ARGUMENTS, AS SPECIFIED IN THE INDIVIDUAL DESCRIPTION, ;ARE CALLED VIA JSR R5. .SBTTL MCALLS .MCALL .EXIT,.TTYOUT,.TTYIN,.PRINT,.LOOKUP,.CLOSE,.READW,.WRITW .MCALL .RCTRLO,.ENTER,.SETTOP,.DATE,.DSTAT,.FETCH,.TTINR,.GTIM .MCALL .GVAL,.SCCA,.MTATCH,.MTDTCH,.MTGET,.SERR,.HERR,.SPFUN .SBTTL GENERAL MACROS ;PUSH REGISTERS ONTO STACK .MACRO SAVE REGS .IRPC REGNUM,REGS MOV R'REGNUM,-(SP) .ENDM .ENDM SAVE ;POP REGISTERS FROM STACK .MACRO RESTOR REGS .IRPC REGNUM,REGS MOV (SP)+,R'REGNUM .ENDM .ENDM RESTOR ;RING BELL .MACRO FEEP PRINC BELL .ENDM FEEP ;NEXT LINE .MACRO CRLF JSR PC,NEWLIN .ENDM CRLF ;PRINT SPACES .MACRO SPACE NUM .IF NB NUM MOV #NUM,R0 .ENDC JSR PC,PUTSPC .ENDM SPACE ;PRINT A STRING STORED IN STR AREA .MACRO PRINT STR .IF NB ^\STR\ .PSECT STRING $$$=. .ASCIZ \STR\ .PSECT CODE MOV #$$$,R0 .ENDC JSR PC,PUTSTR .ENDM PRINT ;PRINT A STRING WITHOUT CRLF .MACRO PRIN1 STR .IF NB ^\STR\ .PSECT STRING $$$=. .ASCII \STR\ .BYTE 200 .PSECT CODE MOV #$$$,R0 .ENDC JSR PC,PUTSTR .ENDM PRIN1 ;PRINT A CHARACTER .MACRO PRINC CHR .IF NB ^\CHR\ MOV #CHR,R0 .ENDC JSR PC,PUTCHR .ENDM PRINC ;RETURN TO TOP LEVEL .MACRO ERRET MOV TOPSP,SP JMP TOPLEV .ENDM ERRET ;PRINT MESSAGE & ERRET, OPTIONALLY RESET CATALOG .MACRO ERROR STR,RESET .PSECT STRING $$$=. .ASCIZ \STR\ .PSECT CODE .IF B RESET JSR PC,ERRHND .IFF JSR PC,ERRHDR .ENDC .WORD $$$ .ENDM ERROR ;IF FILE NOT FOUND, PRINT SPECIAL MESSAGE, ELSE NORMAL ERROR .MACRO CATERR STR .PSECT STRING $$$=. .ASCIZ \STR\ .PSECT CODE JSR PC,CERHND .WORD $$$ .ENDM CATERR ;PRINT WARNING MESSAGE & SKIP RETURN .MACRO WARN STR .PSECT STRING $$$=. .ASCIZ \STR\ .PSECT CODE JSR R5,WRNHND .WORD $$$ .ENDM WARN ;PRINT INFORMATIONAL MESSAGE & SKIP RETURN .MACRO INFORM STR .PSECT STRING $$$=. .ASCIZ \STR\ .PSECT CODE JSR R5,INFHND .WORD $$$ .ENDM INFORM ;IF NO SOB, REPLACE WITH OTHER INSTRUCTIONS .IF EQ SOBINS .MACRO SOB REG,LOC DEC REG BNE LOC .ENDM SOB .ENDC ;BEGIN HELP TEXT .MACRO HLPBEG .PSECT STRING $$$=. .ENDM HLPBEG ;DEFINE A LINE OF TEXT FOLLOWED BY A CRLF .MACRO L STR .ASCII \STR\<15><12> .ENDM L ;END HELP TEXT .MACRO HLPEND .BYTE 200 .PSECT CODE .WORD $$$ .ENDM HLPEND ;DEFINE A VARIABLE IN DATA SECTION .MACRO DEFVAR NAM,VAL .PSECT DATA .IF NB ^\VAL\ NAM: VAL .IFF NAM: 0 .ENDC .PSECT CODE .ENDM DEFVAR ;IF NO EIS INSTRUCTIONS, REPLACE WITH SIMULATION ROUTINES .IF EQ EIS ;ARITHMETIC SHIFT (SINGLE WORD) .MACRO ASH NUM,REG MOV REG,-(SP) MOV NUM,-(SP) JSR PC,ASHSIM MOV (SP)+,REG .ENDM ASH ;MULTIPLY (SINGLE WORD ONLY) .MACRO MUL NUM,REG .IF DIF REG,R1 .IF DIF REG,R3 .IF DIF REG,R5 .ERROR ;DOUBLE WORD MULTIPLY NOT IMPLEMENTED .ENDC .ENDC .ENDC MOV REG,-(SP) MOV NUM,-(SP) JSR PC,MULSIM MOV (SP)+,REG .ENDM MUL ;DIVIDE (DOUBLE WORD) .MACRO DIV NUM,REG MOV REG,-(SP) MOV REG+1,-(SP) MOV NUM,-(SP) JSR PC,DIVSIM MOV (SP)+,REG+1 MOV (SP)+,REG .ENDM DIV .ENDC .SBTTL STRINGS .PSECT STRING .NLIST BEX ;MACRO FOR .ASCII FOLLOWED BY .BYTE 200 .MACRO ASCI2 STR .ASCII /STR/ .BYTE 200 .ENDM ASCI2 ;VERSION NUMBER STRING VERSIO: .ASCII /DSKLIB (Disk Librarian) V/ .IIF NDF,EXPIRE .ASCII /0/ ;NORMAL VERSION .IIF DF,EXPIRE .ASCII /S/ ;SPECIAL VERSION WITH EXPIRATION DATE ASCI2 <2.18> NCMSTR: ASCI2 < command not yet implemented> ERRMSG: ASCI2 WRNMSG: ASCI2 INFMSG: ASCI2 MONTAB: ASCI2 ;MONTH TABLE FOR DATE PRINTING ASCI2 ASCI2 ASCI2 ASCI2 ASCI2 ASCI2 ASCI2 ASCI2 ASCI2 ASCI2 ASCI2 RTAFMT: .ASCII /DECRT11A / ;RT11A FORMAT STRING FOR DISK ID AREA COPYRT: ASCI2 NULLIN: .ASCIZ // ;NULL LINE FOR CRLF TSXINI: .ASCII <35>/K/<35>/D/<200> ;TSX INIT STRING TSXONE: .ASCII <35>/Q/<1><200> ;TSX STRING FOR SINGLE CHARACTER FIELD .LIST BEX .SBTTL CONSTANTS AND DATA LOCATIONS .PSECT DATA ;CHARACTER DEFINITIONS AND CONTROL CHARACTER MACRO .MACRO CONTROL CHR,NAME NAME= ''CHR&37 .ENDM CONTROL CONTROL C,CTLC CONTROL G,BELL CONTROL H,BS CONTROL J,LF CONTROL L,FF CONTROL M,CR CONTROL U,LINDEL SPACE= 40 RUBOUT= 177 COMMA= ', DOT= '. COLON= ': DASH= '- STAR= '* PERCNT= '% DOLLAR= '$ SLASH= '/ JSW= 44 ;JOB STATUS WORD LOCATION ERRBYT= 52 ;EMT ERROR RETURN CODE BYTE GENOPT= 372 ;OFFSET FOR SYSGEN OPTION WORD MONVER= 276 ;OFFSET FOR MONITOR VERSION NUMBER CAT: 1 ;CATALOG CHANNEL, 2 FOR SECONDARY CATALOG DISK: 3 ;CHANNEL FOR DISK UPDATE TMPCHN: 4 ;TEMPORARILY USED CHANNEL PRTCHN: 5 ;PRINT FILE CHANNEL SEGSIZ= 1 ;SEGMENT SIZE=(8-TUNE)^2, .REPT 10-TUNE ;KLUDGE NECESSARY SINCE NO EXPONENTIATION SEGSIZ= SEGSIZ*2 .ENDR SEGMSK= 256./SEGSIZ-1 ;MASK TO GET RELATIVE SEGMENT NUMBER SEGMSK= ^CSEGMSK ;KLUDGE BECAUSE OF MACRO LIMITATION CATSIZ: 0 ;CATALOG SIZE IN BLOCKS MAXSEG: 0 ;HOLDS HIGHEST SEGMENT NUMBER IN THIS FILE CATSZ1: 0 ;HOLDING AREAS FOR CATALOG SWITCHING MAXSG1: 0 CATSZ2: 0 MAXSG2: 0 TOPSP: 0 ;HOLDS SAVED INITIAL STACK POINTER CURDAT: 0 ;CURRENT DATE IN DSKLIB FORMAT BUFBOT: 0 ;LOWEST BUFFER WORD (ABOVE HANDLERS) BUFTOP: 0 ;HIGHEST BUFFER WORD (TOP OF OUR MEMORY) BUFNXT: 0 ;NEXT FREE WORD IN BUFFER PQBOT: 0 ;PRINT QUEUE BUFFER BOTTOM PQNXT: 0 ;PRINT QUEUE BUFFER TOP PLUS 1 TTSTAT: TRMTYP ;HOLDS TERMINAL STATUS BITS: ;BIT 15 = DOUBLE CONTROL-C TYPED ;BIT 0 = TERMINAL TYPE (SEE TRMTYP) TTDCOL: DEFCOL ;DEFAULT NUMBER OF TERMINAL PRINT COLUMNS TTPCOL: 0 ;TERMINAL PRINT COLUMNS LSTCOL: 0 ;LAST COLUMN PRINTED ON LINE TTPLNS: 0 ;TERMINAL PRINT LINES (PER PAGE) TTPBTS: 0 ;TERMINAL PRINT BYTES (PER PAGE) CURPAG: 0 ;CURRENT PAGE NUMBER PRTBLK: 0 ;CURRENT PRINT FILE BLOCK PRTPTR: 0 ;PRINT POINTER, ZERO IF NO PRINT FILE PRTBUF: .BLKB 1000 ;PRINT OUTPUT BUFFER (1 BLOCK) PRTEND: AREA: .BLKW 6 ;AREA USED FOR SYSTEM CALLS UPDEV: .WORD 0,0,0,0 ;FILE NAME FOR UPDATE DEVICE FILNAM: .WORD 0,0,0,0 ;FILE NAME FOR GETFIL DEFDEV: .RAD50 /DK / ;DEFAULT DEVICE NAME DSKNUM: 0 ;CURRENT DISK NUMBER DSKNAM: 0,0,0 ;CURRENT DISK NAME DSKFRE: 0 ;CURRENT FREE BLOCKS COUNTER DIRBLK: 0 ;BLOCK NUMBER FOR NEXT DISK DIRECTORY SEGMENT ENTBTS: 0 ;NUMBER OF WORDS IN CURRENT DIRECTORY ENTRIES LASTLE: 0 ;LAST CATALOG ENTRY IN SEGMENT NSPLOC: 0 ;NEXT-SEGMENT-POINTER LOCATION SEGEND: 0 ;END OF CURRENT SEGMENT NNXTSG: 0 ;NEXT SEGMENT NUMBER NXTSGR: 0 ;ADDRESS OF NEXT SEGMENT ROUTINE MATCHN: 0 ;FILE NAME MATCH ROUTINE MATCHT: 0 ;FILE TYPE MATCH ROUTINE CURBLK: 0 ;CURRENTLY LOADED BLOCK NUMBER, 0 IF NONE MODBLK: 0 ;MODIFIED CURRENT BLOCK? INSTR: .BLKW 40. ;INPUT STRING STREND: FNAME: .BLKB 9. ;FILE NAME (ASCII) FMASK: .BLKB 9. ;FILE MASK NAME (ASCII) ;SEGMENT OFFSET POINTERS PDSKNO= 0 ;DISK NUMBER PNXTSG= 2 ;NEXT SEGMENT NUMBER PFENT= 4 ;FIRST ENTRY IN SEGMENT PDFREE= 12 ;DISK FREE (BLOCKS) WORD OF FIRST SEGMENT ;COMPARISON ROUTINES USED BY COMPAR, DECREASING ORDER OF IMPORTANCE COMPRS: .BLKW 5 REVERS: 0 ;FLAG FOR REVERSE SORTING (SET BY /R) SRTFLG: 0 ;FLAG USED BY SORT ROUTINE FVOLID: 0 ;FLAG FOR FINDING VOLUME ID'S DSTBLK: .BLKW 4 ;SPACE FOR .DSTAT VALUES COMSTR: 0 ;POINTER TO COMMAND STRING, IF ANY LSIZE: 0 ;LESS THAN FILE SIZE FOR FIND GSIZE: 0 ;GREATER THAN FILE SIZE FOR FIND BDATE: 0 ;BEFORE FILE DATE FOR FIND SDATE: 0 ;SINCE FILE DATE FOR FIND ODISK: 0 ;ONLY DISK NUMBER FOR FIND MONRTB: .RAD50 /JAN/ ;MONTH (RAD50) TABLE .RAD50 /FEB/ .RAD50 /MAR/ .RAD50 /APR/ .RAD50 /MAY/ .RAD50 /JUN/ .RAD50 /JUL/ .RAD50 /AUG/ .RAD50 /SEP/ .RAD50 /OCT/ .RAD50 /NOV/ .RAD50 /DEC/ RT11V3: 0 ;RT-11 VERSION 3 FLAG, 1 IF TRUE TSX: 0 ;TSX FLAG .SBTTL COMMAND TABLE STUFF .MACRO CMND LTR,STR ;MACRO TO CREATE COMMAND TABLE ENTRY .IF NB .PSECT STRING $$$=. .ASCII /STR/ .BYTE 200 .PSECT DATA .WORD $$$,COM'LTR .IFF .WORD NCMSTR,NOCMND .ENDC .ENDM CMND COMTAB: CMND A, CMND B CMND C, CMND D, CMND E, CMND F, CMND G CMND H, CMND I CMND J CMND K CMND L, CMND M, CMND N CMND O, CMND P, CMND Q, CMND R CMND S, CMND T, CMND U, CMND V, CMND W, CMND X CMND Y CMND Z .SBTTL SWITCH TABLES .MACRO SW LTRS,STR ;MACRO TO CREATE SWITCH TABLE ENTRY .PSECT STRING .EVEN $$$=. .ASCII \LTRS\ .ASCIZ \STR\ .PSECT DATA .WORD $$$,SW'LTRS .ENDM SW ;TABLE FOR NO SWITCHES NULTAB: .WORD 0 ;TABLE FOR SECONDARY CATALOG SWITCH ONLY SECTAB: SW SE, SW HE, .WORD 0 ;TABLE FOR VOLUME SWITCHES VOLTAB: SW OW, SW RT,<11A format> SW HE, .WORD 0 ;TABLE FOR FIND COMMAND SWITCHES FNDTAB: SW NA, SW TY, SW DA, SW FI, SW DI, SW RE, SW VO, SW LE, SW EQ, SW GR, SW BE, SW DU, SW SI, SW ON, SW PR, SW LI, SW CO, SW QU, SW SE, SW HE, .WORD 0 .SBTTL RAD50 CONVERSION TABLES .NLIST BEX ;TABLE FOR ASCII TO RAD50 CONVERSION, TO ATRTAB: .BYTE 0, -1, -1, -1, 33, 34, -1, -1 .BYTE -1, -1, 35, -1, -1, -1, 34, -1 .BYTE 36, 37, 40, 41, 42, 43, 44, 45 .BYTE 46, 47, -1, -1, -1, -1, -1, -1 .BYTE -1, 1, 2, 3, 4, 5, 6, 7 .BYTE 10, 11, 12, 13, 14, 15, 16, 17 .BYTE 20, 21, 22, 23, 24, 25, 26, 27 .BYTE 30, 31, 32, -1, -1, -1, -1, -1 .BYTE -1, 1, 2, 3, 4, 5, 6, 7 .BYTE 10, 11, 12, 13, 14, 15, 16, 17 .BYTE 20, 21, 22, 23, 24, 25, 26, 27 .BYTE 30, 31, 32, -1, -1, -1, -1, -1 ;TABLE FOR RAD50 TO ASCII CONVERSION RTATAB: .ASCII / ABCDEFGHIJKLMNOPQRSTUVWXYZ$%*0123456789/ .LIST BEX .SBTTL MAIN PROGRAM .PSECT CODE .ENABL LSB REENT1: MOV TOPSP,SP ;RESTORE ORIGINAL SP .SERR ;TRAP HARD ERRORS JMP START1 ;SKIP ONE-TIME-ONLY INITIALIZATIONS REENTR: BR REENT1 ;REENTRY ADDRESS START:: MOV SP,TOPSP ;SAVE ORIGINAL SP FOR QUICK RETURNS BIT #400,@#JSW ;WERE WE CHAINED TO? BEQ 1$ ;NO MOV #510,COMSTR ;YES, POINT TO COMMAND STRING 1$: .SERR ;TRAP HARD ERRORS MOV #AREA,R0 ;TRY A TSX-ONLY EMT MOV #107*400,(R0) EMT 375 BCS 2$ ;IF IT FAILED, THIS ISN'T TSX INC TSX ;SUCCEEDED, SET FLAG FOR LATER 2$: .GVAL #AREA,#MONVER ;GET MONITOR VERSION NUMBER CMPB R0,#2 ;IS IT VERSION 2? BEQ START1 ;YES (SKIP .SCCA AND MULTITERMINAL INFO.) CMPB R0,#10 ;VERSION 10 OR LESS? (FIX FOR HT 11.) BGT START1 ;CALL IT VERSION 2 (PROBABLY HT11) 3$: INC RT11V3 ;YES, SET FLAG .IF NE MTLOOK ;LOOK FOR MULTI-TERMINAL INFORMATION? DEFVAR MTGBLK, <.BLKW 4> ;BLOCK FOR TERMINAL VARIABLES TST TSX ;TSX? BNE START1 ;YES, DON'T LOOK AT TERMINAL .GVAL #AREA,#GENOPT ;NO, GET SYSGEN OPTION WORD BIT #20000,R0 ;MULTI-TERMINAL SUPPORT? BEQ START1 ;NO CLR R1 ;START WITH LUN 0 4$: .MTATCH #AREA,#0,R1 ;ATTEMPT TO ATTACH THIS TERMINAL BCC 6$ ;TERMINAL ATTACHED 5$: INC R1 ;FAILURE, TRY NEXT LUN CMP R1,#20 ;TRIED ALL LOCAL DL'S? BLT 4$ ;NO INFORM BR START1 6$: .MTGET #AREA,#MTGBLK,R1 ;GET TERMINAL INFORMATION .MTDTCH #AREA,R1 ;AND DETACH THE TERMINAL BIT #100000,MTGBLK+6 ;IS THIS THE CONSOLE? BEQ 5$ ;NO BIT #100000,MTGBLK ;SCOPE? BNE 7$ ;YES BIC #1,TTSTAT ;NO, CLEAR DISPLAY TERMINAL BIT MOV #TT0COL,R0 ;COLUMN NUMBER DEFAULT BR 8$ 7$: BIS #1,TTSTAT ;SET DISPLAY TERMINAL BIT MOV #TT1COL,R0 ;COLUMN NUMBER DEFAULT 8$: ;;; BIT #2,MTGBLK ;CRLF AT END OF LINE? ;;; BEQ 9$ ;NO, USE DEFAULT COLUMN NUMBER MOV MTGBLK+6,R1 ;YES, LOOK AT TERMINAL WIDTH BIC #177400,R1 ;CLEAR UNWANTED BITS CLR R0 ADD #4,R1 ;ALLOW FOR N-1 COLUMN SEPARATORS DIV #34.,R0 ;34 CHARACTERS NEEDED PER COLUMN 9$: MOV R0,TTDCOL ;SAVE NUMBER OF COLUMNS TO USE .ENDC START1: TST TSX ;IS THIS TSX? BEQ 10$ ;NO .PRINT #TSXINI ;INITIALIZE TERMINAL CHARACTERISTICS 10$: TST RT11V3 ;IS THIS RT-11 V3? BEQ 11$ ;NO .DATE ;YES, GET CURRENT DATE BR 12$ 11$: MOV @#54,R0 ;VERSION 2 FORM OF .DATE MOV 262(R0),R0 12$: TST R0 ;ANY DATE SET? BNE 13$ ;YES WARN CLR R0 13$: JSR PC,CNVDAT ;CONVERT DATE TO DSKLIB FORMAT MOV R0,CURDAT MOV BUFLOC,R1 ;INITIAL BUFFER BOTTOM MOV R1,BUFBOT ;INITIALIZE BUFFER POINTER ADD #1776,R1 .SETTOP R1 ;GET FIRST 512 WORDS FOR DIRECTORY BUFFER MOV R0,BUFTOP ;HIGH WORD CMP R0,R1 ;MUST GET ALL REQUESTED MEMORY BEQ 14$ FEEP .PRINT #ERRMSG PRINT CLR R0 ;HARD EXIT .EXIT 14$: BIS #030000,@#JSW ;ALLOW REENTRY AND SPECIAL-MODE TT INPUT .IF NE SCCA ;SCCA OPTION SELECTED TST RT11V3 ;IS THIS A VERSION 3 MONITOR? BEQ 15$ ;NO, SCCA NOT ALLOWED .SCCA #AREA,#TTSTAT ;DISABLE CONTROL-C ABORTS 15$: .ENDC MOV #CATNAM,R1 ;USE DEFAULT CATALOG JSR PC,OPNCAT ;GET THE CATALOG, FALL THROUGH TO TOPLEV .DSABL LSB TOPLEV: .RCTRLO ;ENABLE OUTPUT CMP CAT,#1 ;PRIMARY CATALOG SELECTED? BEQ 1$ ;YES JSR PC,TOCAT1 ;NO, SELECT PRIMARY CATALOG JSR PC,CRESET ;AND RESET IT 1$: MOV BUFBOT,BUFNXT ;RESET FREE WORD POINTER MOV TTDCOL,TTPCOL ;SET COLUMN COUNT TO DEFAULT CLR LSTCOL ;RESET COLUMN COUNTER TST PRTPTR ;PRINTING TO FILE? BEQ 2$ ;NO JSR PC,OUTPRT ;YES, WRITE OUT REST OF PRINT BUFFER CLR PRTPTR ;TURN OFF PRINTING TO FILE .CLOSE PRTCHN 2$: CLR TTPBTS ;RESET PAGING FLAG/COUNTERS BIC #100000,TTSTAT ;CLEAR DOUBLE CONTROL-C BIT .TTYOUT #PROMPT ;REQUEST NEXT COMMAND 3$: JSR PC,GETCHR ;COMMANDS ARE ONE CHARACTER CMP R0,#'? ;QUESTION MARK IS SPECIAL BEQ CMNDS ;LIST COMMANDS CMP R0,#CR ;CARRIAGE RETURN ALSO SPECIAL BNE 4$ CRLF .PRINT #VERSIO ;PRINT VERSION STRING CRLF .PRINT #COPYRT ;PRINT COPYRIGHT MESSAGE CRLF BR TOPLEV 4$: CMP R0,#'A ;MUST BE A LETTER BLT 5$ CMP R0,#'Z BLE 6$ 5$: FEEP ;IF NOT A LETTER, COMPLAIN BR 3$ ;AND TRY AGAIN 6$: MOV R0,R1 ;DON'T LOSE CHARACTER .TTYOUT ;ECHO CHARACTER SUB #'A,R1 ;CALCULATE COMMAND TABLE OFFSET ASL R1 ASL R1 ADD #COMTAB,R1 .PRINT (R1)+ ;FIRST TABLE LOCATION IS STRING TO PRINT .TTYOUT #SPACE ;END STRING WITH SPACE JSR PC,@(R1) ;NEXT LOCATION POINTS TO COMMAND ROUTINE BR TOPLEV ;NEXT COMMAND .SBTTL COMMAND HANDLERS ;ROUTINES NEED NOT PRESERVE REGISTERS CMNDS: PRINC ;LIST COMMANDS IN TABLE CRLF MOV #COMTAB,R1 MOV #'A,R2 1$: MOV (R1)+,R3 ;STRING TO PRINT CMP (R1)+,#NOCMND ;IGNORE UNIMPLEMENTED COMMANDS BEQ 2$ PRINC SPACE MOV R2,R0 PRINC MOV R3,R0 PRINT CRLF 2$: INC R2 CMP R2,#'Z BLE 1$ CRLF JMP TOPLEV ;DUMMY SUBROUTINE FOR UNIMPLEMENTED COMMAND HLPBEG L HLPEND NOCMND: CRLFRT: CRLF ;ENTRY FOR COMMON TYPE OF RETURN RTS PC ;ABORT HLPBEG L L ^/ Are you sure? es\<174>\o/ L L <(Exits from DSKLIB, purging any new catalog.)> HLPEND COMA: CRLF ;VERIFY ABORT PRIN1 < Are you sure? > JSR R5,GETANS BR CRLFRT ;NO, SIMPLY RETURN MOV #1,R0 ;YES, QUIT BUT DON'T CLOSE FILES .EXIT ;CREATE CATALOG FILE HLPBEG L ^\named: ; size=\ L ^/[ Overwrite existing catalog? es\<174>\o]/ L L <(Creates new catalog and opens it as primary or secondary.)> HLPEND .ENABL LSB COMC: JSR R5,GETFIL ;GET FILE NAME .WORD CATNAM+6 ;DEFAULT CATALOG FILE NAME .WORD SECTAB ;SECONDARY CATALOG ALLOWED JSR PC,FILTST ;VALIDATE FILE NAME PRIN1 <; size=> JSR R5,GETNUM CLR R0 ;DEFAULT TO ZERO CMP R0,#DPBLKS+2 ;MUST BE AT LEAST 1 EXTRA BLOCK FOR DATA BGE 1$ ERROR 1$: MOV R0,R2 ;SAVE SIZE ASH #TUNE,R0 ;NUMBER OF SEGMENTS IN NEW FILE CMP R0,#4096. ;MUST NOT BE MORE THAN BIT MAP WILL HOLD BLE 2$ ERROR 2$: .LOOKUP #AREA,TMPCHN,R1 ;FILE ALREADY EXISTS? BCS 3$ ;NO .CLOSE TMPCHN CRLF ;YES, CONFIRM OVERWRITE PRIN1 < Overwrite existing catalog? > JSR R5,GETANS ;YES OR NO? BR 8$ ;NO 3$: .CLOSE CAT .ENTER #AREA,CAT,R1,R2 ;CREATE NEW CATALOG BCC 4$ ERROR 4$: MOV #HEADER,R3 ;INITIALIZE HEADER PAGES MOV #256.,R4 5$: MOV #-1,(R3)+ ;SET ALL SEGMENT-FREE BITS SOB R4,5$ MOV #DSKPTR,R3 MOV DISKS,R4 6$: CLR (R3)+ ;ZERO DISK POINTER TABLE SOB R4,6$ MOV R2,CATSIZ ;REMEMBER FILE SIZE ASH #TUNE,R2 ;MULTIPLY BY NUMBER OF SEGMENTS PER BLOCK DEC R2 ;HIGH SEGMENT NUMBER MOV R2,MAXSEG ;SAVE FOR LATER MOV #TUNE,TUNSAV ;SAVE TUNE FOR FUTURE FILE VALIDATION MOV #DPBLKS,DPBSAV ;SAVE NUMBER OF DISK POINTER BLOCKS, ALSO MOV #DPBLKS+1*<256./SEGSIZ>,-(SP) ;NUMBER OF SEGS IN HEADER PAGES CLR R0 ;POINTER TO FIRST SEGMENT 7$: JSR PC,CLRBIT ;CLEAR SEGMENT BITS FOR HEADER PAGES INC R0 ;NEXT SEGMENT DEC (SP) BNE 7$ TST (SP)+ JSR PC,WRITHD ;WRITE OUT HEADER BLOCKS MOV CATSIZ,R1 DEC R1 ;LAST BLOCK NUMBER .WRITW #AREA,CAT,#HEADER,#256.,R1 ;WRITE LAST BLOCK AS PLACE HOLDER BCC 8$ ERROR 8$: JMP CRLFRT .DSABL LSB ;DIRECTORY OF DISKS HLPBEG L L L <(Lists disks cataloged in primary catalog.)> HLPEND COMD: CRLF ;START ON NEW LINE CLR DSKNUM ;FIRST DISK IS ZERO 1$: JSR R5,FRSTSG ;GET ITS FIRST SEGMENT BR 2$ ;NO SEGMENT CHAIN FOR THIS DISK JSR PC,PENT ;PRINT IT 2$: INC DSKNUM ;NEXT DISK CMP DSKNUM,DISKS ;AT END? BLT 1$ ;NO JSR PC,FPENT ;FINISH UP THE PRINTING JMP CRLFRT ;RETURN & SKIP A LINE ;EXPUNGE DISK HLPBEG L ^\#\ L L <(Removes disk information from primary catalog.)> HLPEND COME: PRINC '# JSR R5,GETNUM ;GET DISK NUMBER BR 1$ ;ABORT EXPUNGE JSR PC,EXPUNG ;EXPUNGE IT 1$: JMP CRLFRT ;FIND FILE HLPBEG L ^\named: [...]\ L L <(Finds matching files and lists them.)> L <(/HELP lists switches allowed.)> HLPEND .ENABL LSB COMF: MOV #DEFORD,R1 ;SET UP DEFAULTS IN CASE NO SWITCHES USED MOV #COMPRS,R2 MOV #5,R3 1$: MOV (R1)+,(R2)+ SOB R3,1$ CLR TTPCOL ;OTHER DEFAULTS MOV #-1,GSIZE MOV #-1,LSIZE MOV #77777,BDATE MOV #-1,ODISK CLR SDATE CLR REVERS ;CLEAR SWITCH-RELATED FLAGS CLR FVOLID CLR TTPLNS CLR QUIET JSR R5,GETFIL ;GET FILE NAME TO FIND .WORD NULTAB ;FILE TYPE DEFAULTS TO NULL .WORD FNDTAB ;USE FIND SWITCH TABLE TST TTPCOL ;NUMBER OF COLUMNS SPECIFIED? BNE 2$ ;YES MOV TTDCOL,TTPCOL ;NO, USE DEFAULT 2$: CMP CAT,#2 ;SECONDARY CATALOG MUST BE RESET IF SELECTED BNE 3$ JSR PC,CRESET 3$: TST PRTPTR ;PRINT TO FILE? BEQ 4$ ;NO .CLOSE PRTCHN ;YES, CLOSE JUST IN CASE SAVE 1 MOV #PRTNAM,R1 ;POINTER TO PRINTER FILE NAME JSR PC,GETHND ;MAKE SURE HANDLER IS IN CORE CLR PRTBLK ;RESET BLOCK COUNTER .ENTER #AREA,PRTCHN,R1,#0 ;OPEN PRINTER FILE RESTOR 1 BCC 4$ ERROR 4$: DEFVAR FFILES ;FOUND FILES COUNTER CLR FFILES ;INITIALIZE IT DEFVAR FBLKS1 ;FOUND BLOCKS, LOW ORDER WORD CLR FBLKS1 DEFVAR FBLKS2 ;FOUND BLOCKS, HIGH ORDER WORD CLR FBLKS2 MOV TTPLNS,R5 ;NUMBER OF LINES PER PAGE BLE 5$ ;NO PAGING DESIRED SUB #3,R5 ;RESERVE 3 LINES FOR HEADER MUL TTPCOL,R5 ;CALCULATE AND SAVE NUMBER OF BYTES PER PAGE MUL #14,R5 MOV R5,TTPBTS 5$: .PRINT #NULLIN ;CRLF MUST PRINT ON TERMINAL CLR CURPAG ;CLEAR PAGE COUNTER TST (R1)+ ;IGNORE DEVICE NAME MOV R1,R2 ;FILE MASK NAME POINTER MOV R1,R4 MOV #FMASK,R1 ;ASCII FILE MASK NAME POINTER MOV #3,R3 ;3 WORDS IN RAD50 FILE NAME 6$: MOV (R4)+,R0 ;TRANSLATE FILE NAME JSR PC,FRAD50 SOB R3,6$ MOV #FMASK,R0 ;TEST FILE NAME MOV #6,R1 ;6 CHARACTERS JSR PC,TMATCH ;TEST MATCH TYPE NECESSARY MOV R0,MATCHN ;SAVE ROUTINE ADDRESS MOV #FMASK+6,R0 ;FILE TYPE MOV #3,R1 ;3 CHARACTERS JSR PC,TMATCH ;TEST MATCH TYPE MOV R0,MATCHT ;SAVE TST ODISK ;ONLY DISK REQUESTED? BMI 7$ ;NO MOV ODISK,DSKNUM ;YES, SAVE NUMBER JSR R5,FRSTSG ;GET FIRST SEGMENT IN CHAIN BR 16$ ;FAILURE BR 8$ ;SUCCESS 7$: JSR R5,FRSTSS ;GET FIRST SEQUENTIAL SEGMENT BR 16$ ;FAILURE 8$: JSR PC,CHKDCC ;CHECK FOR DOUBLE CONTROL-C JSR R5,NXTENT ;GET NEXT ENTRY BR 16$ ;FAILURE TST 10(R1) ;VOLUME ID ENTRY? BPL 9$ ;NO TST FVOLID ;YES, WANT VOLUME ID? BEQ 15$ ;NO, SKIP THIS ENTRY BR 10$ ;YES, KEEP THIS ONE 9$: TST FVOLID ;ONLY WANT VOLUME ID'S? BNE 15$ ;YES, SKIP THIS ENTRY 10$: CMP GSIZE,#-1 ;NO GREATER THAN SIZE SPECIFIED? BEQ 11$ ;YES, SKIP COMPARISON CMP 6(R1),GSIZE ;GREATER THAN GREATER THAN SIZE? BLOS 15$ ;NO, FAILURE 11$: CMP 6(R1),LSIZE ;LESS THAN LESS THAN SIZE? BHIS 15$ ;NO, FAILURE MOV 10(R1),R0 ;FILE DATE BIC #140000,R0 ;CLEAR SPECIAL BITS CMP R0,BDATE ;BEFORE BEFORE DATE? BGE 15$ ;NO, FAILURE CMP R0,SDATE ;SINCE SINCE DATE? BLT 15$ ;NO, FAILURE MOV #FMASK,R3 ;NAME MASK POINTER MOV #6,R4 ;6 CHARACTERS IN NAMES JSR R5,@MATCHN ;TRY TO MATCH BR 15$ ;FAILURE ADD #4,R1 ;MOVE TO RAD50 TYPE WORDS ADD #4,R2 MOV #FMASK+6,R3 ;MOVE TO ASCII MASK TYPE MOV #3,R4 ;3 CHARACTERS IN TYPES JSR R5,@MATCHT ;TRY TO MATCH BR 14$ ;FAILURE SUB #4,R1 ;BACKUP TO BEGINNING OF MATCHED FILE NAME INC FFILES ;FOUND ANOTHER ONE ADD 6(R1),FBLKS1 ;ADD SIZE TO TOTAL ADC FBLKS2 TST QUIET ;PRINT ENTRY? BEQ 12$ ;YES ADD #12,R1 ;NO, SKIP IT BR 13$ 12$: JSR PC,QENT ;QUEUE ENTRY FOR PRINTING 13$: SUB #4,R2 ;BEGINNING OF FILE MASK NAME BR 8$ ;LOOP 14$: SUB #4,R1 ;BACKUP TO BEGINNING OF FILE NAMES SUB #4,R2 15$: ADD #10.,R1 ;MOVE TO NEXT ENTRY BR 8$ ;LOOP 16$: TST QUIET ;DON'T PRINT BNE 17$ ;YES JSR PC,PQENTS ;NO, PRINT QUEUED ENTRIES TST TTPBTS ;PAGING ENABLED? BEQ 17$ ;NO TST PRTPTR ;YES, OUTPUT TO TERMINAL? BNE 17$ ;NO PRINC FF ;YES, END ON NEW PAGE 17$: .RCTRLO ;JUST IN CASE PRINTING DISABLED MOV PRTPTR,-(SP) ;SAVE PRINTING-TO-FILE FLAG CLR PRTPTR ;MUST PRINT TO TERMINAL SPACE 5 ;ALIGN LIKE DIR PROGRAM MOV FFILES,R0 ;NUMBER OF FILES FOUND JSR PC,PNUM ;PRINT IT DEC R0 ;JUST ONE FILE FOUND? BNE 18$ ;NO PRIN1 < File, > ;YES, USE SINGULAR MESSAGE BR 19$ 18$: PRIN1 < Files, > 19$: MOV FBLKS1,R1 ;NUMBER OF BLOCKS FOUND, LOW ORDER MOV FBLKS2,R0 ;HIGH ORDER DIV #100.,R0 ;SPLIT NUMBER DECIMALLY FOR PRINTING BEQ 20$ ;LESS THAN 100 BLOCKS JSR PC,PNUM ;PRINT LEADING DIGITS CMP R1,#9. ;LESS THAN 10? BGT 20$ ;NO .TTYOUT #'0 ;YES, FILL IN 0 IF DIGITS ALREADY PRINTED 20$: MOV R1,R0 ;PRINT REMAINING OR ONLY NUMBER JSR PC,PNUM PRIN1 < Block> DEC R1 ;JUST ONE BLOCK FOUND? BEQ 21$ ;YES, USE SINGULAR FORM OF WORD PRINC 's ;NO, PLURAL 21$: CRLF MOV (SP)+,PRTPTR ;RESTORE FLAG FOR TOPLEV CHECKING JMP CRLFRT ;NEXT COMMAND .DSABL LSB ;HELP HLPBEG L ^\for command:\ L L <(Prototype command and arguments shown.)> HLPEND COMH: PRIN1 1$: JSR PC,GETCHR ;COMMANDS ARE ONE CHARACTER CMP R0,#'A ;MUST BE A LETTER BLT 2$ CMP R0,#'Z BLE 3$ 2$: FEEP ;IF NOT A LETTER, COMPLAIN BR 1$ ;AND TRY AGAIN 3$: MOV R0,R1 ;DON'T LOSE CHARACTER CRLF CRLF PRINC SPACE MOV R1,R0 ;ECHO CHARACTER PRINC SUB #'A,R1 ;CALCULATE COMMAND TABLE OFFSET ASL R1 ASL R1 ADD #COMTAB,R1 MOV (R1)+,R0 ;FIRST TABLE LOCATION IS STRING TO PRINT PRINT PRINC SPACE ;END STRING WITH SPACE MOV (R1),R1 ;POINTER TO COMMAND HANDLER MOV -2(R1),R0 ;PREVIOUS WORD POINTS TO HELP TEXT PRINT JMP CRLFRT ;LIST DISK HLPBEG L ^\#\ L L <(Lists cataloged information for specified disk.)> HLPEND COML: PRINC '# JSR R5,GETNUM ;GET DISK NUMBER BR 3$ ;ABORT LISTING MOV R0,DSKNUM ;SAVE IT FOR COMPARISON WITH SEGMENTS JSR R5,FRSTSG ;GET THE FIRST SEGMENT BR 4$ ;FAILURE CRLF ;START ON NEW LINE JSR PC,PENT ;PRINT HEADER ENTRY JSR PC,FPENT ;NEW LINE CRLF ;SKIP A LINE BEFORE REST OF ENTRIES 1$: JSR R5,NXTENT ;NEXT ENTRY BR 2$ ;NO MORE ENTRIES JSR PC,PENT ;PRINT IT BR 1$ ;LOOP 2$: JSR PC,FPENT ;FINISH IT UP 3$: JMP CRLFRT ;RETURN & SKIP A LINE 4$: ERROR ;MOVE DISK FROM PRIMARY TO SECONDARY CATALOG HLPBEG L ^\#\ L L <(Copies disk information from primary to secondary catalog.)> HLPEND .ENABL LSB COMM: PRINC '# JSR R5,GETNUM ;GET DISK NUMBER BR 1$ ;MOVE ALL MOV R0,DSKNUM ;SAVE IT FOR COMPARISON WITH SEGMENTS JSR PC,TSTDNM ;TEST RANGE OF DISK NUMBER ASL R0 TST DSKPTR(R0) ;POINTER TO FIRST SEGMENT BNE MOVE ;GOOD DISK ERROR 1$: PRINT ;DEFAULT IS ALL DISKS CLR R0 ;START WITH ZERO BR 3$ 2$: INC R0 ;NEXT DISK CMP R0,DISKS ;PAST LAST DISK? BGE 4$ ;YES 3$: MOV R0,R1 ASL R1 MOV DSKPTR(R1),R1 ;DOES DISK CHAIN EXIST? BEQ 2$ ;NO, TRY AGAIN MOV R0,DSKNUM PRIN1 < Move disk #> ;YES, MOVE IT MOV DSKNUM,R0 JSR PC,PNUM ;ECHO NUMBER BEING MOVED JSR PC,MOVE ;DO IT JSR PC,TOCAT1 ;RESTORE PRIMARY CATALOG JSR PC,CRESET ;AND RESET IT MOV DSKNUM,R0 ;NEXT DISK BR 2$ 4$: JMP CRLFRT .ENABL LSB ;INTERNAL ROUTINE OF COMM MOVE: JSR PC,CHKDCC ;CHECK FOR DOUBLE CONTROL-C MOV BUFBOT,R2 ;COPY SEGMENTS INTO BUFFER MOV DSKNUM,R0 ASL R0 MOV DSKPTR(R0),R0 ;FIRST SEGMENT IN CHAIN 1$: JSR PC,GETSEG ;GET NEXT SEGMENT CMP PDSKNO(R1),DSKNUM ;PROPER DISK NUMBER? BNE 2$ ;NO CMP PNXTSG(R1),MAXSEG ;NEXT SEGMENT POINTER IN RANGE? BLE 3$ ;YES 2$: CRLF INFORM BR 12$ 3$: MOV R2,R3 ADD #SEGSIZ*2-2,R3 ;LAST WORD NEEDED 4$: CMP R3,BUFTOP ;ABOVE CURRENT TOP OF BUFFER? BLOS 6$ ;NO JSR R5,GETMEM ;YES, GET MORE MEMORY BR 5$ ;FAILURE BR 4$ ;SUCCESS, SEE IF ENOUGH GOTTEN 5$: ERROR 6$: MOV PNXTSG(R1),R0 ;NEXT SEGMENT IN CHAIN MOV #SEGSIZ,R4 ;WORDS TO TRANSFER 7$: MOV (R1)+,(R2)+ ;TRANSFER SEGMENT SOB R4,7$ TST R0 ;WAS THIS LAST SEGMENT? BNE 1$ ;NO, GET NEXT ONE JSR PC,TOCAT2 ;SWITCH TO SECONDARY CATALOG JSR PC,CRESET ;AND RESET IT MOV DSKNUM,R0 ;DISK ALREADY IN CATALOG? ASL R0 TST DSKPTR(R0) BEQ 8$ ;NO ASR R0 JSR PC,EXPUNG ;YES, EXPUNGE IT 8$: JSR PC,FNDBIT ;FIND A FREE SEGMENT MOV BUFBOT,R2 ;POINTER TO FIRST DISK SEGMENT MOV DSKNUM,R1 ASL R1 MOV R0,DSKPTR(R1) ;SAVE DISK POINTER IN DIRECTORY PAGE 9$: JSR PC,GETSEG ;AND GET IT (CORE POINTER IN R1) MOV PNXTSG(R2),R0 ;ZERO IF LAST SEGMENT MOV #SEGSIZ,R3 ;NUMBER OF WORDS TO TRANSFER 10$: MOV (R2)+,(R1)+ ;TRANSFER SEGMENT SOB R3,10$ INC MODBLK ;SET MODIFIED BLOCK FLAG TST R0 ;LAST SEGMENT? BEQ 11$ ;YES JSR PC,FNDBIT ;NO, FIND ANOTHER SEGMENT MOV R0,PNXTSG-(R1) ;PUT POINTER TO NEW SEG IN OLD ONE BR 9$ ;GET THE NEW ONE 11$: JSR PC,CLRBLK ;WRITE OUT LAST BLOCK USED JSR PC,WRITBM ;WRITE OUT BIT MAP MOV DSKNUM,R0 JSR PC,WRITDP ;WRITE OUT PAGE CONTAINING DISK POINTER CRLF 12$: RTS PC .DSABL LSB ;OPEN CATALOG HLPBEG L ^\named: \ L L <(Opens existing catalog as primary or secondary.)> HLPEND COMO: JSR R5,GETFIL ;GET FILE NAME .WORD CATNAM+6 ;DEFAULT CATALOG TYPE .WORD SECTAB ;SECONDARY CATALOG ALLOWED JSR PC,OPNCAT ;OPEN IT JMP CRLFRT ;PRINTER FILE HLPBEG L ^\named: \ L L <(Directs printer output to specified file.)> HLPEND COMP: JSR R5,GETFIL ;GET FILE NAME .WORD PRTNAM+6 ;DEFAULT PRINTER FILE TYPE .WORD NULTAB ;NO SWITCHES MOV FILNAM,PRTNAM ;NEW DEVICE TST FILNAM+2 ;FILE NAME SUPPLIED? BEQ 1$ ;NO, USE PREVIOUS NAME MOV FILNAM+2,PRTNAM+2 ;YES, USE NEW NAME MOV FILNAM+4,PRTNAM+4 MOV FILNAM+6,PRTNAM+6 1$: JMP CRLFRT ;QUIT HLPBEG L L L <(Exits from DSKLIB, making any new catalog permanent.)> HLPEND COMQ: .CLOSE #1 ;BE NEAT (ANYWAY, MIGHT BE NEW) .CLOSE #2 ;CLOSE BOTH PRIMARY AND SECONDARY CATALOGS MOV #1,R0 ;DON'T DO A RESET .EXIT ;QUIT ;SIZE OF CATALOG HLPBEG L L L <(Lists information about primary catalog.)> HLPEND .ENABL LSB COMS: MOV #CATNAM,R1 ;PRINT CATALOG NAME WITH SPACES SUPPRESSED MOV (R1)+,R0 JSR PC,PRD50S PRINC COLON MOV (R1)+,R0 JSR PC,PRD50S MOV (R1)+,R0 JSR PC,PRD50S PRINC DOT MOV (R1),R0 JSR PC,PRD50S PRIN1 < is > MOV CATSIZ,R0 ;NUMBER OF BLOCKS IN CATALOG JSR PC,PNUM PRIN1 < blocks, > CLR R0 CLR R1 1$: JSR R5,TSTBIT ;TEST NEXT SEGMENT BIT BR 3$ ;NO MORE BITS BNE 2$ ;BIT SET MEANS SEGMENT FREE INC R1 ;COUNT USED SEGMENTS 2$: INC R0 ;NEXT SEGMENT BR 1$ 3$: MOV R0,R2 ;TOTAL NUMBER OF SEGMENTS 4$: CMP R1,#654. ;OVERFLOW POSSIBLE IN MULTIPLY? BLE 5$ ;NO ASR R1 ;YES, SCALE DOWN BOTH NUMBERS ASR R2 BR 4$ ;AND CHECK AGAIN 5$: MUL #100.,R1 ;SCALE USED SEGMENT COUNT FOR PERCENTAGE MOV R2,R3 ASR R3 ;ROUND ADD R3,R1 CLR R0 DIV R2,R0 ;PERCENTAGE GOES TO R0 JSR PC,PNUM ;PRINT IT PRINT <% full> JMP TOPLEV .DSABL LSB ;TERMINAL TYPE HLPBEG L ^/is printing\<174>\display/ L L <(Toggles terminal type and associated characteristics.)> HLPEND .ENABL LSB COMT: BIT #1,TTSTAT ;BIT 0 IN TTSTAT IS TERMINAL TYPE BEQ 1$ ;OFF IS PRINTING PRINT ;ON IS DISPLAY, CHANGE TO PRINTING MOV #TT0COL,R1 ;NUMBER OF COLUMNS FOR THIS TERMINAL BIC #1,TTSTAT ;CLEAR DISPLAY BIT BR 2$ 1$: PRINT ;CHANGE TO DISPLAY MOV #TT1COL,R1 ;NUMBER OF COLUMNS BIS #1,TTSTAT ;SET DISPLAY BIT 2$: MOV R1,TTDCOL ;SAVE DEFAULT NUMBER OF COLUMNS RTS PC .DSABL LSB ;UPDATE FROM DRIVE HLPBEG L ^/>\<174>\ll\<174>\K:\<174>\ile\<174>\chives/ L L <(Copies directory information into primary catalog.)> HLPEND .ENABL LSB COMU: .IF DF,EXPIRE ;EXPIRATION DATE? CMP CURDAT,#EXPIRE ;YES, SEE IF PAST IT, YET BLE 1$ ;NO, STILL SAFE MOV #EXPIRE,TUNSAV ;YES, KILL CATALOG 1$: .ENDC PRINC '> ;PROMPT COMU1: JSR PC,GETCHR ;GET DRIVE NUMBER CMP R0,#'D ;"D" MEANS DK: BEQ 4$ CMP R0,#'F ;"F" MEANS FILE BEQ 5$ CMP R0,#'A ;"A" MEANS ALL BEQ 6$ CMP R0,#'R ;"R" MEANS ARCHIVES BEQ 9$ SUB #'0,R0 ;OTHERWISE, MUST BE A DIGIT BLT 2$ CMP R0,#9. BLE 3$ 2$: FEEP ;COMPLAIN & RETRY ON BAD CHARACTER BR COMU1 3$: JMP UPDATE ;DO THE UPDATE FOR THIS DRIVE 4$: PRIN1 ;USE DK: FOR UPDATE MOV #<^RDK >,UPDEV ;SET NAME FOR .LOOKUP JMP UPDAT2 ;DO UPDATE 5$: PRIN1 ;UPDATE FROM A FILE DEFVAR ARCTYP,<.RAD50 /ARC/> ;DEFAULT ARCHIVE TYPE JSR R5,GETFIL ;GET FILE NAME .WORD ARCTYP ;DEFAULT TYPE .WORD NULTAB ;NO SWITCHES MOV #FILNAM,R0 ;SET UP FILE NAME FOR UPDATE MOV #UPDEV,R1 .REPT 4 MOV (R0)+,(R1)+ .ENDR PRIN1 <, > JMP UPDAT3 ;DO UPDATE 6$: PRINT ;UPDATE FROM ALL DRIVES CLR -(SP) ;START WITH DRIVE 0 7$: MOV (SP),R1 ;LOOP THROUGH ALL TEN POSSIBLE DRIVES ASL R1 ;RELATIVE WORD NUMBER TST DEVTAB(R1) ;ZERO HERE MEANS NO DRIVE DEFINED BEQ 8$ PRIN1 ^/ Update from drive >/ ;GOT ONE MOV (SP),R0 JSR PC,UPDATE ;GO UPDATE 8$: INC (SP) ;NEXT CMP (SP),#9. ;DONE? BLE 7$ TST (SP)+ ;CLEAN OFF STACK RTS PC 9$: PRINT ;UPDATE FROM ALL ARCHIVE DRIVES MOV #<^RAR0>,UPDEV ;ARCHIVE DEVICE CLR UPDEV+2 ;DO A NON-FILE-STRUCTURED OPEN 10$: .CLOSE DISK ;JUST IN CASE .LOOKUP #AREA,DISK,#UPDEV ;TRY TO OPEN CHANNEL TO HANDLER BCS 13$ ;NO LUCK DEFVAR ARCMAP ;PLACE TO PUT MAP BYTE .SPFUN #AREA,DISK,#301,#ARCMAP,#0,#0 ;GET MAP BYTE BCS 13$ ;LOSE MOV UPDEV,-(SP) ;END WITH DRIVE 7 ADD #7,(SP) MOV UPDEV,-(SP) ;START WITH DRIVE 0 11$: ROLB ARCMAP ;IS NEXT MAP BIT A ONE? BCC 12$ ;NO, THIS UNIT NOT DEFINED PRIN1 ^/ Update from drive >/ ;YES, GOT ONE MOV (SP),R0 MOV R0,UPDEV JSR PC,UPDAT1 ;GO UPDATE 12$: INC (SP) ;NEXT CMP (SP),2(SP) ;DONE? BLOS 11$ TST (SP)+ ;CLEAN OFF STACK MOV (SP)+,UPDEV ;NEXT DEVICE TO TRY ADD #<50-7>,UPDEV BR 10$ 13$: CMP UPDEV,#<^RAR0> ;WAS THIS THE FIRST HANDLER TRIED? BNE 14$ ;NO, DON'T DIE, JUST END ERROR 14$: RTS PC .ENABL LSB ;INTERNAL ROUTINE OF COMU UPDATE: ASL R0 ;RELATIVE WORD NUMBER MOV DEVTAB(R0),R1 ;GET DRIVE NAME ASR R0 ADD #'0,R0 ;PRINT DRIVE NUMBER PRINC MOV R1,UPDEV ;SAVE NAME FOR .LOOKUP BNE 1$ ;ZERO MEANS UNDEFINED NAME ERROR 1$: PRIN1 <, > ;SHOW DEVICE NAME MOV R1,R0 UPDAT1: JSR PC,PRAD50 PRINC COLON UPDAT2: CLR UPDEV+2 ;DO NON-FILE-STRUCTURED OPEN UPDAT3: MOV #UPDEV,R1 ;POINTER TO DEVICE NAME JSR PC,GETHND ;GET HANDLER IF NECESSARY MOV BUFBOT,R5 ;CURRENT BUFFER BOTTOM, READ STUFF INTO HERE .CLOSE DISK ;JUST IN CASE .LOOKUP #AREA,DISK,#UPDEV ;USUALLY, NON-FILE-STRUCTURED OPEN BCC 2$ ERROR 2$: .READW #AREA,DISK,R5,#256.,#1 ;IDENTIFICATION BLOCK OF DISK BCC 3$ CRLF INFORM RTS PC 3$: CLR R0 CLR R3 ;BUILD DISK NUMBER HERE MOV 352*2(R5),DIRBLK ;BLOCK NUMBER FOR FIRST DIRECTORY SEGMENT MOV R5,R1 ADD #354*2,R1 ;POINTER TO VOLUME-ID MOV #3,R2 ;3 CHARACTER NUMBERS 4$: MOVB (R1)+,R0 ;NEXT DIGIT SUB #'0,R0 ;DIGITIZE AND VALIDATE IT BLT 5$ CMP R0,#9. BLE 6$ 5$: ERROR 6$: MUL #10.,R3 ;DISK NUMBER IS DECIMAL ADD R0,R3 SOB R2,4$ ;LOOP MOV R3,DSKNUM ;SAVE DISK NUMBER JSR PC,TSTDNM ;TEST RANGE OF DSKNUM MOV #DSKNAM,R2 ;POINTER TO BLOCK FOR DISK NAME MOV #3,R3 ;3 RAD50 WORDS IN DISK NAME 7$: JSR R5,CRAD50 ;CONVERT NEXT 3 CHARACTERS BR 8$ ;FAILURE BR 9$ ;SUCCESS 8$: ERROR 9$: MOV R0,(R2)+ ;SAVE NEXT WORD OF NAME JSR PC,PRAD50 ;PRINT IT CMP R3,#2 ;PRINT DOT BETWEEN NAME AND TYPE BNE 10$ PRINC DOT 10$: SOB R3,7$ ;NEXT WORD PRIN1 <, disk > MOV DSKNUM,R0 JSR PC,PNUM ;PRINT DISK NUMBER ASL R0 TST DSKPTR(R0) ;DISK PREVIOUSLY ENTERED? BEQ 11$ ASR R0 JSR PC,EXPUNG ;IF SO, EXPUNGE IT BEFORE UPDATING 11$: JSR PC,FNDBIT ;FIND A FREE SEGMENT MOV DSKNUM,R1 ASL R1 MOV R0,DSKPTR(R1) ;SAVE DISK POINTER IN DIRECTORY PAGE JSR PC,GETSEG ;AND GET IT (CORE POINTER IN R1) JSR PC,NEWSEG ;INITIALIZE THIS SEGMENT MOV #DSKNAM,R2 ;SAVE BASIC DISK INFORMATION MOV (R2)+,(R1)+ ;NAME (2 WORDS) MOV (R2)+,(R1)+ MOV (R2)+,(R1)+ ;TYPE CLR (R1)+ ;FILL IN LENGTH LATER MOV CURDAT,(R1) ;TODAY IS LAST UPDATE DATE BIS #100000,(R1)+ ;TAG THIS ENTRY AS VOLUME ID MOV #-1,(R1) ;END-OF-SEGMENT MARKER IN CASE NO FILES CLR DSKFRE ;FREE-DISK-BLOCKS COUNTER MOV DIRBLK,R2 12$: .READW #AREA,DISK,R5,#512.,R2 ;READ NEXT DIRECTORY SEGMENT BCC 13$ ERROR ,RESET 13$: MOV 6(R5),ENTBTS ADD #7*2,ENTBTS ;STORE NUMBER OF BYTES PER ENTRY MOV R5,R2 ADD #12,R2 ;FIRST ENTRY 14$: INC R2 ;SKIP TO TYPE CODE FOR CURRENT DIRECTORY ENTRY BITB #10,(R2) ;END OF DIRECTORY SEGMENT? BEQ 15$ ;NO MOV 2(R5),R2 ;NEXT DIRECTORY SEGMENT NUMBER BEQ 20$ ;NO MORE DIRECTORY SEGMENTS ASL R2 ;2 BLOCKS PER SEGMENT ADD DIRBLK,R2 ;ADJUST TO ABSOLUTE BLOCK NUMBER DEC R2 DEC R2 BR 12$ ;READ THE BLOCKS 15$: BITB #4,(R2)+ ;PERMANENT FILE? BNE 16$ ;YES TST -(R2) ;OTHERWISE, BACKUP TO BEGINNING OF ENTRY ADD 10(R2),DSKFRE ;ADD LENGTH TO FREE BLOCK TOTAL ADD ENTBTS,R2 ;NEXT ENTRY BR 14$ ;TRY AGAIN 16$: CMP R1,LASTLE ;PAST LAST CATALOG ENTRY IN SEGMENT? BLOS 17$ ;NO JSR PC,FNDBIT ;YES, FIND ANOTHER SEGMENT MOV R0,@NSPLOC ;PUT POINTER TO NEW SEGMENT IN OLD ONE JSR PC,GETSEG ;GET THE NEW ONE JSR PC,NEWSEG ;AND INITIALIZE IT 17$: .REPT 4 ;TRANSFER NAME, TYPE, AND LENGTH MOV (R2)+,(R1)+ .ENDR TST (R2)+ SAVE 0 MOV (R2)+,R0 ;CONVERT AND TRANSFER DATE JSR PC,CNVDAT TST -16(R2) ;PROTECTED FILE? BPL 18$ ;NO BIS #40000,R0 ;YES, SET PROTECTED BIT IN DATE WORD 18$: MOV R0,(R1)+ RESTOR 0 SUB #7*2,R2 ;MOVE POINTER TO NEXT DIRECTORY ENTRY ADD ENTBTS,R2 CMP R1,SEGEND ;PAST END OF SEGMENT? BHI 19$ ;YES MOV #-1,(R1) ;IF NOT, WRITE OUT END-OF-SEGMENT MARKER 19$: BR 14$ ;NEXT ENTRIES 20$: MOV DSKNUM,R0 ASL R0 MOV DSKPTR(R0),R0 ;GET POINTER TO FIRST SEGMENT OF CHAIN JSR PC,GETSEG ;GET THE SEGMENT INC MODBLK ;ABOUT TO MODIFY IT MOV DSKFRE,PDFREE(R1) ;PUT FREE BLOCKS COUNT IN PROPER SLOT JSR PC,CLRBLK ;WRITE OUT LAST BLOCK USED JSR PC,WRITBM ;WRITE OUT BIT MAP MOV DSKNUM,R0 JSR PC,WRITDP ;WRITE OUT PAGE CONTAINING DISK POINTER CRLF ;SIGNIFY COMPLETION JMP CHKDCC ;CHECK FOR DOUBLE CONTROL-C AND RETURN .DSABL LSB ;VOLUME ID CHANGE HLPBEG L ^/for drive >\<174>\K:\<174>\ile/ L L ^\to #; named: \ L L <(Changes volume name and/or number for disk on drive.)> HLPEND .ENABL LSB COMV: PRIN1 ^\for drive >\ 1$: JSR PC,GETCHR ;GET DRIVE NUMBER CMP R0,#'D ;"D" MEANS DK: BEQ 3$ CMP R0,#'F ;"F" MEANS FILE BEQ 4$ SUB #'0,R0 ;OTHERWISE, MUST BE A DIGIT BLT 2$ CMP R0,#9. BLE 5$ 2$: FEEP ;COMPLAIN & RETRY ON BAD CHARACTER BR 1$ 3$: PRIN1 ;USE DK: FOR UPDATE MOV #<^RDK >,UPDEV ;SET NAME FOR .LOOKUP BR 7$ ;DO UPDATE 4$: PRIN1 ;UPDATE FROM A FILE JSR R5,GETFIL ;GET FILE NAME .WORD ARCTYP ;DEFAULT ARC TYPE .WORD NULTAB ;NO SWITCHES MOV #FILNAM,R0 ;SET UP FILE NAME FOR UPDATE MOV #UPDEV,R1 .REPT 4 MOV (R0)+,(R1)+ .ENDR PRIN1 <, > BR 8$ ;DO UPDATE 5$: ASL R0 ;RELATIVE WORD NUMBER MOV DEVTAB(R0),R1 ;GET DRIVE NAME ASR R0 ADD #'0,R0 ;PRINT DRIVE NUMBER PRINC MOV R1,UPDEV ;SAVE NAME FOR .LOOKUP BNE 6$ ;ZERO MEANS UNDEFINED NAME ERROR 6$: PRIN1 <, > ;SHOW DEVICE NAME MOV R1,R0 JSR PC,PRAD50 PRINC COLON 7$: CLR UPDEV+2 ;USE NON-FILE-STRUCTURED OPEN 8$: MOV #UPDEV,R1 ;POINTER TO DEVICE NAME JSR PC,GETHND ;GET HANDLER IF NECESSARY .CLOSE DISK ;JUST IN CASE .LOOKUP #AREA,DISK,#UPDEV ;USUALLY, NON-FILE-STRUCTURED OPEN BCC 9$ ERROR 9$: .READW #AREA,DISK,BUFBOT,#256.,#1 ;IDENTIFICATION BLOCK OF DISK BCC 10$ ERROR 10$: CRLF MOV BUFBOT,R1 CMP 724(R1),#6 ;RT11A FORMAT ALWAYS HAS 6 HERE BNE 12$ ;MUST NOT BE RT11A FORMAT ADD #760,R1 ;POINTER TO FORMAT TYPE MOV #RTAFMT,R2 ;RT11A FORMAT STRING MOV #12.,R3 ;12 CHARACTERS IN FORMAT STRING 11$: CMPB (R1)+,(R2)+ ;COMPARE NEXT CHARACTER BNE 12$ ;FAILURE SOB R3,11$ ;LOOP CLR -(SP) ;SUCCESS, CLEAR NON-INIT FLAG BR 13$ 12$: MOV #1,-(SP) ;SET NON-INIT FLAG WARN 13$: MOV #730,R1 ;POINTER TO VOLUME-ID ADD BUFBOT,R1 PRIN1 ;FIRST PRINT CURRENT ID MOV #3,R2 14$: MOVB (R1)+,R0 ;DISK NUMBER PRINC SOB R2,14$ PRIN1 <; named: > MOV #6,R2 15$: MOVB (R1)+,R0 ;DISK NAME PRINC SOB R2,15$ PRINC DOT MOV #3,R2 16$: MOVB (R1)+,R0 ;DISK TYPE PRINC SOB R2,16$ PRIN1 <; owner: > MOV #12.,R2 17$: MOVB (R1)+,R0 ;OWNER PRINC SOB R2,17$ CRLF PRIN1 ;NOW GET NEW ID SUB #24.,R1 ;RESET ID POINTER 18$: JSR R5,GETNUM ;GET NUMBER BR 19$ ;KEEP OLD NUMBER CMP R0,#999. ;ONLY 3 DIGITS ALLOWED BLOS 21$ ;NEGATIVE NUMBERS ILLEGAL ERROR 19$: MOV #3,R2 ;BYPASS AND PRINT CURRENT NUMBER 20$: MOVB (R1)+,R0 PRINC SOB R2,20$ BR 23$ 21$: MOV R0,R3 ;CONVERT NUMBER TO DIGITS DIV #10.,R2 SAVE 3 MOV R2,R3 CLR R2 DIV #10.,R2 SAVE 32 MOV #3,R2 22$: RESTOR 0 ;CONVERT TO ASCII AND STORE ADD #'0,R0 MOVB R0,(R1)+ SOB R2,22$ 23$: MOV R1,R3 PRIN1 <; > CLR OWNERF ;CLEAR VOLUME-RELATED FLAGS CLR RTAFLG JSR R5,GETFIL ;GET FILE NAME .WORD NULTAB ;TYPE DEFAULTS TO BLANK .WORD VOLTAB ;VOLUME SWITCHES MOV R1,R2 MOV R3,R1 TST (R2)+ ;IGNORE DEVICE NAME MOV #3,R3 24$: MOV (R2)+,R0 ;CONVERT AND TRANSFER NAME AND TYPE JSR PC,FRAD50 SOB R3,24$ TST (SP)+ ;NON-RT11A INITIALIZED DISK? BEQ 26$ ;NO MOV BUFBOT,R1 MOV #6,724(R1) ;YES, ASSUME DIRECTORY WILL START AT BLOCK 6 TST RTAFLG ;INITIALIZE FOR RT11A FORMAT? BEQ 26$ ;NO MOV #RTAFMT,R1 ;YES, GET FORMAT NAME MOV #760,R2 ;POINTER TO FORMAT FIELD ADD BUFBOT,R2 ;ABSOLUTIZE IT MOV #12.,R3 ;12 CHARACTERS 25$: MOVB (R1)+,(R2)+ ;TRANSFER IT SOB R3,25$ MOV BUFBOT,R1 MOV #^RV3A,726(R1) ;CALL IT V3A FORMAT 26$: TST OWNERF ;CHANGE OWNER? BEQ 28$ ;NO MOV #OWNER,R1 ;YES, GET DESIRED OWNER NAME MOV #744,R2 ;POINTER TO OWNER FIELD ADD BUFBOT,R2 ;ABSOLUTIZE IT MOV #6,R3 ;6 WORDS 27$: MOV (R1)+,(R2)+ ;TRANSFER IT SOB R3,27$ 28$: .WRITW #AREA,DISK,BUFBOT,#256.,#1 ;REWRITE DISK BLOCK BCC 29$ ERROR 29$: JMP CRLFRT .DSABL LSB ;WIDTH OF TERMINAL HLPBEG L ^\(in columns) #\ L L <(Changes default number of columns for file name printing.)> HLPEND COMW: PRIN1 <(in columns) #> ;PROMPT COMW1: JSR PC,GETCHR ;GET NUMBER OF COLUMNS MOV R0,R1 SUB #'0,R1 ;MUST BE A DIGIT, GREATER THAN 0 BLE 1$ CMP R1,#9. BLE 2$ 1$: FEEP ;COMPLAIN & RETRY ON BAD CHARACTER BR COMW1 2$: PRINC ;ECHO DIGIT MOV R1,TTDCOL ;SAVE NEW DEFAULT NUMBER OF COLUMNS JMP CRLFRT .SBTTL RANDOM UTILITY SUBROUTINES ;ERROR HANDLER ERRHDR: JSR PC,CRESET ;ENTRY FOR CATALOG RESET ERRHND: FEEP ;NORMAL ENTRY CLR PRTPTR ;DISABLE PRINTING TO FILE CRLF .PRINT #ERRMSG ;?DSKLIB-F- .PRINT @(SP) ;POINTER TO STRING FOLLOWS JSR CALL CLR COMSTR ;ABORT COMMAND STRING, IF ANY ERRET ;ERROR RETURN TO TOPLEV ;CATALOG ERROR HANDLER CERHND: CMPB @#ERRBYT,#2 ;CHANNEL-NOT-OPEN ERROR? BEQ 1$ ;YES, SPECIAL MESSAGE .CLOSE CAT BR ERRHND 1$: ERROR ;WARNING HANDLER WRNHND: .PRINT #WRNMSG ;?DSKLIB-W- .PRINT (R5)+ ;POINTER TO STRING FOLLOWS JSR CALL RTS R5 ;WARN RETURNS TO CALLER ;INFORMATIONAL MESSAGE HANDLER INFHND: .PRINT #INFMSG ;?DSKLIB-I- .PRINT (R5)+ ;POINTER TO STRING FOLLOWS JSR CALL RTS R5 ;INFORM RETURNS TO CALLER ;CONVERT DATE TO DSKLIB FORMAT: ; BITS 0-4 DAY ; BITS 5-8 MONTH ; BITS 9-13 LAST 2 DIGITS OF YEAR MINUS 110 OCTAL ; BIT 14 RESERVED ; BIT 15 VOLUME ID ENTRY FLAG CNVDAT: SAVE 12 MOV R0,R1 BIC #^C37,R0 ;CLEAR ALL BUT YEAR BITS ASL R1 ;LEFT JUSTIFY MONTH AND DAY BITS ASL R1 MOV #11,R2 ;4 MONTH PLUS 5 DAY BITS 1$: ROL R1 ;TRANSFER A BIT THROUGH CARRY BIT ROL R0 SOB R2,1$ ;LOOP RESTOR 21 RTS PC ;SELECT PRIMARY CATALOG TOCAT1: MOV CATSIZ,CATSZ2 ;SAVE SIZE VALUES FOR CAT2 MOV MAXSEG,MAXSG2 MOV CATSZ1,CATSIZ ;RESTORE VALUES FOR CAT1 MOV MAXSG1,MAXSEG MOV #1,CAT ;CHANNEL FOR PRIMARY CATALOG RTS PC ;SELECT SECONDARY CATALOG TOCAT2: MOV CATSIZ,CATSZ1 ;SAVE SIZE VALUES FOR CAT1 MOV MAXSEG,MAXSG1 MOV CATSZ2,CATSIZ ;RESTORE VALUES FOR CAT2 MOV MAXSG2,MAXSEG MOV #2,CAT ;CHANNEL FOR SECONDARY CATALOG RTS PC ;CHECK FOR DOUBLE CONTROL-C .ENABL LSB CHKDCC: TST TTSTAT ;BIT 15 MEANS DOUBLE CONTROL-C TYPED BMI 1$ ;YES RTS PC ;NO 1$: CLR PRTPTR ;IF YES, DISABLE PRINTING TO FILE TST TSX ;UNDER TSX? BNE 2$ ;YES, DON'T PRINT THIS (STRANGE TSX BUG) PRINT <^C^C> ;ABORT CURRENT OPERATION 2$: BIS #100,@#JSW ;SET DON'T-WAIT-FOR-INPUT BIT 3$: .TTINR ;AND FLUSH INPUT BUFFER BCC 3$ BIC #100,@#JSW ERRET .DSABL LSB .SBTTL FILE NAME MATCHING ROUTINES ;TEST FILE NAME TO CHOOSE MOST EFFICIENT MATCH ROUTINE (RETURN IN R0) ;RAD50 FILE NAME POINTER IN R0, CHARACTER COUNT IN R1 TMATCH: SAVE 23 CLR R3 ;TEST BITS GO HERE 1$: MOVB (R0)+,R2 ;NEXT CHARACTER CMP R2,#SPACE ;NO BITS FOR SPACE BEQ 4$ CMP R2,#PERCNT ;2 BIT FOR PERCENT BNE 2$ BIS #2,R3 BR 4$ 2$: CMP R2,#STAR ;4 BIT FOR STAR BNE 3$ BIS #4,R3 BR 4$ 3$: BIS #10,R3 ;10 BIT FOR ANY OTHER CHARACTER 4$: SOB R1,1$ ;LOOP THROUGH ALL CHARACTERS IN NAME MOV MATTAB(R3),R0 ;GET PROPER MATCH ROUTINE 8$: RESTOR 32 RTS PC ;MATCH TABLE FOR TMATCH ROUTINE MATTAB: DMATCH ;ALL SPACES PMATCH ;PERCENTS DMATCH ;STARS DMATCH ;PERCENTS AND STARS RMATCH ;NONSPECIAL CHARACTERS PMATCH ;NONSPECIAL CHARACTERS AND PERCENTS HMATCH ;NONSPECIAL CHARACTERS AND STARS HMATCH ;NONSPECIAL CHARACTERS, PERCENTS, AND STARS ;DUMMY MATCH, ALWAYS SKIPS (SUCCEEDS) DMATCH: TST (R5)+ ;SKIP RETURN RTS R5 ;RAD50 MATCH, COMPARES WORDS, SKIPS ON SUCCESS RMATCH: CMP (R1),(R2) ;COMPARE FIRST WORDS BNE 2$ ;FAILURE CMP R4,#6 ;TWO WORD NAMES? BNE 1$ ;NO, SUCCESS CMP 2(R1),2(R2) ;YES, COMPARE SECOND WORDS BNE 2$ ;FAILURE 1$: TST (R5)+ ;SKIP RETURN 2$: RTS R5 ;PERCENT MATCH, COMPARES CHARACTERS WITH % WILD, SKIPS ON SUCCESS PMATCH: SAVE 2 MOV R1,R2 MOV #FNAME,R1 ;BUFFER FOR TRANSLATED CHARACTERS MOV (R2),R0 ;FIRST FILE NAME WORD JSR PC,FRAD50 ;TRANSLATE TO ASCII CMP R4,#6 ;TWO WORD NAME? BNE 1$ ;NO MOV 2(R2),R0 ;YES, TRANSLATE SECOND WORD JSR PC,FRAD50 1$: SUB R4,R1 ;BACKUP TO BEGINNING OF STRING 2$: CMPB (R3),#PERCNT ;NEXT MASK CHARACTER IS PERCENT? BNE 3$ ;NO CMPB (R1)+,(R3)+ ;YES, ADVANCE POINTERS BR 4$ ;PERCENT MATCHES ANYTHING 3$: CMPB (R1)+,(R3)+ ;DO CHARACTERS MATCH? BNE 5$ ;NO 4$: SOB R4,2$ ;LOOP TST (R5)+ ;ALL CHARACTERS MATCH, SKIP RETURN 5$: MOV R2,R1 ;RAD50 POINTERS MUST BE RESTORED RESTOR 2 RTS R5 ;HAIRY MATCH, SKIPS ON SUCCESS HMATCH: SAVE 2 MOV R1,R2 MOV #FNAME,R1 ;BUFFER FOR TRANSLATED CHARACTERS MOV (R2),R0 ;FIRST FILE NAME WORD JSR PC,FRAD50 ;TRANSLATE TO ASCII CMP R4,#6 ;TWO WORD NAME? BNE 1$ ;NO MOV 2(R2),R0 ;YES, TRANSLATE SECOND WORD JSR PC,FRAD50 1$: SUB R4,R1 ;BACKUP TO BEGINNING OF STRING SAVE 2 MOV R4,R2 ;SAME NUMBER OF CHARACTERS IN BOTH STRINGS JSR R5,IHMAT ;MATCH ASCII STRINGS BR 2$ ;FAILURE TST (R5)+ ;SKIP ON SUCCESS 2$: RESTOR 12 ;RESTORE RAD50 FILE NAME POINTERS RTS R5 ;INTERNAL HAIRY MATCH ROUTINE, SKIPS ON SUCCESS ;FILE NAME IN R1, LENGTH IN R2, FILE MASK IN R3, LENGTH IN R4 IHMAT: TST R4 ;NO MORE MASK CHARACTERS? BNE 2$ ;NO TST R2 ;YES, AND NO MORE FILE CHARACTERS? BEQ 11$ ;YES, SUCCESS 1$: CMPB (R1)+,#SPACE ;NO, SUCCESS IF ONLY SPACES LEFT BNE 12$ ;FAILURE IF OTHER CHARACTERS SOB R2,1$ BR 11$ 2$: TST R2 ;MASK CHARACTERS BUT NO NAME CHARACTERS? BNE 5$ ;NO 3$: CMPB (R3),#STAR ;YES, SUCCESS IF ONLY STARS AND/OR SPACES BEQ 4$ CMPB (R3),#SPACE BNE 12$ 4$: INC R3 SOB R4,3$ BR 11$ ;FAILURE IF OTHER CHARACTERS IN MASK 5$: CMPB (R3),#PERCNT ;PERCENT IN MASK? BNE 6$ ;NO CMPB (R1)+,(R3)+ ;YES, AUTOMATIC MATCH BR 10$ 6$: CMPB (R3),#STAR ;STAR IN MASK? BNE 9$ ;NO INC R3 ;YES, FLUSH STAR AND LOOP DEC R4 ;(STAR MATCHES ZERO OR MORE CHARACTERS) SAVE 34 ;MASK STRING USED FOR EACH PASS THROUGH LOOP 7$: SAVE 12 ;SAVE CURRENT NAME AND LENGTH JSR R5,IHMAT ;TRY TO MATCH BR 8$ ;FAILURE ADD #10,SP ;SUCCESS, CLEAR STACK AND RETURN BR 11$ 8$: RESTOR 21 ;FLUSH ONE NAME CHARACTER AND TRY AGAIN MOV (SP),R4 MOV 2(SP),R3 INC R1 DEC R2 BGE 7$ ADD #4,SP ;FAILURE IF NO MORE NAME CHARACTERS BR 12$ 9$: CMPB (R1)+,(R3)+ ;NAME CHARACTER MATCHES MASK? BNE 12$ ;NO, FAILURE 10$: DEC R2 ;YES, SUCCESS IFF REST OF STRINGS MATCH DEC R4 BR IHMAT 11$: TST (R5)+ ;SKIP ON SUCCESS 12$: RTS R5 .SBTTL FILE RELATED STUFF ;FILE NAME VALIDATION (FILE BLOCK POINTER IN R1) FILTST: TST 2(R1) ;CHECK FOR MISSING FILE NAME BEQ 3$ JSR PC,GETHND ;GET HANDLER IF NECESSARY CMP R1,#CATNAM ;FILE NAME IN CATNAM? BEQ 2$ ;YES, JUST RETURN CMP CAT,#2 ;SECONDARY CATALOG SELECTED? BEQ 2$ ;YES, DON'T SAVE NAME SAVE 12 ;NO, TRANSFER FILE NAME TO CATNAM MOV #CATNAM,R2 SAVE 3 MOV #4,R3 1$: MOV (R1)+,(R2)+ SOB R3,1$ RESTOR 321 2$: RTS PC 3$: ERROR ;GET HANDLER IF NOT ALREADY LOADED .ENABL LSB GETHND: .DSTAT #DSTBLK,R1 ;CHECK STATUS OF DESIRED DEVICE BCC 1$ ERROR 1$: TST DSTBLK+4 ;HANDLER ALREADY LOADED? BNE 6$ ;YES, RETURN IMMEDIATELY SAVE 2 MOV BUFBOT,R2 ;CALCULATE MINIMUM REQUIRED TOP OF BUFFER ADD DSTBLK+2,R2 ;ADD SPACE FOR NEW HANDLER ADD #2000,R2 ;ADD 2 BLOCKS FOR DIRECTORY SEGMENTS 2$: CMP BUFTOP,R2 ;IS BUFTOP HIGH ENOUGH? BHIS 4$ ;YES JSR R5,GETMEM ;NO, TRY TO GET MORE MEMORY BR 3$ ;FAILURE BR 2$ ;SUCCESS, IS IT ENOUGH? 3$: ERROR 4$: .FETCH BUFBOT,R1 ;FETCH HANDLER BCC 5$ ERROR 5$: MOV R0,BUFBOT ;MOVE BUFFER ABOVE NEW HANDLER MOV R0,BUFNXT ;MUST SET THIS, ALSO RESTOR 2 6$: RTS PC .DSABL LSB ;OPEN CATALOG .ENABL LSB OPNCAT: JSR PC,FILTST ;VALIDATE FILE NAME .CLOSE CAT ;CLOSE OLD CATALOG IF OPEN .LOOKUP #AREA,CAT,R1 ;FIND THE CATALOG BCC 1$ ERROR 1$: MOV R0,CATSIZ JSR PC,CRESET ;GET HEADER PAGES AND INITIALIZE VARIABLES CMP #TUNE,TUNSAV ;GOOD CATALOG FILE WITH CORRECT TUNE? BNE 2$ CMP #DPBLKS,DPBSAV ;GOOD, ALSO? BEQ 4$ 2$: .CLOSE CAT .IF DF,EXPIRE ;INCLUDE EXPIRATION CODE CMP #EXPIRE,TUNSAV ;CATALOG EXPIRED? BNE 3$ ;NO, NORMAL ERROR ERROR 3$: .ENDC ERROR 4$: MOV CATSIZ,R0 ;NUMBER OF BLOCKS IN CATALOG ASH #TUNE,R0 ;MULTIPLY BY NUMBER OF SEGMENTS PER BLOCK DEC R0 ;HIGH SEGMENT NUMBER MOV R0,MAXSEG ;SAVE FOR LATER RTS PC .DSABL LSB ;CATALOG RESET CRESET: JSR PC,READHD ;GET HEADER PAGES FROM CAT CLR CURBLK ;INITIALIZE CAT VARIABLES CLR MODBLK RTS PC ;READ HEADER PAGES READHD: .READW #AREA,CAT,#HEADER,#DPBLKS+1*256.,#0 BCS 1$ RTS PC 1$: CATERR ;WRITE HEADER PAGES WRITHD: .WRITW #AREA,CAT,#HEADER,#DPBLKS+1*256.,#0 BCS 1$ RTS PC 1$: CATERR ;READ BIT MAP PAGE READBM: .READW #AREA,CAT,#BITMAP,#256.,#0 ;BIT MAP IS PAGE 0 BCS 1$ RTS PC 1$: CATERR ;WRITE BIT MAP PAGE WRITBM: .WRITW #AREA,CAT,#BITMAP,#256.,#0 ;BIT MAP PAGE IS 0 BCS 1$ RTS PC 1$: CATERR ;WRITE A DISK POINTER PAGE (DISK NUMBER IN R0) WRITDP: SAVE 1 MOV R0,R1 ASL R1 ;COVERT TO RELATIVE BYTE COUNT ADD #DSKPTR-HEADER,R1 ;GET RELATIVE FILE WORD NUMBER BIC #777,R1 ;BEGINNING OF RELATIVE BLOCK SAVE 2 MOV R1,R2 ADD #HEADER,R1 ;CORE WORD OF BEGINNING OF BLOCK SWAB R2 ASR R2 ;BLOCK NUMBER .WRITW #AREA,CAT,R1,#256.,R2 ;WRITE OUT THIS DISK POINTER PAGE BCS 1$ RESTOR 21 RTS PC 1$: CATERR ;READ CURRENT BLOCK READBK: .READW #AREA,CAT,#BLKBUF,#256.,CURBLK ;CURBLK HOLDS BLOCK NUMBER BCS 1$ RTS PC 1$: CATERR ;WRITE CURRENT BLOCK WRITBK: .WRITW #AREA,CAT,#BLKBUF,#256.,CURBLK ;CURBLK HOLDS BLOCK NUMBER BCS 1$ RTS PC 1$: CATERR ;EXPUNGE DISK NUMBER IN R0 FROM CATALOG .ENABL LSB EXPUNG: SAVE 12 MOV R0,DSKNUM JSR PC,TSTDNM ;TEST NUMBER FOR PROPER RANGE MOV R0,R2 ASL R2 MOV DSKPTR(R2),R0 ;POINTER TO FIRST SEGMENT BEQ 2$ CLR DSKPTR(R2) ;DELETE THE POINTER ASR R2 1$: JSR PC,GETSEG ;GET THE NEXT SEGMENT CMP PDSKNO(R1),R2 ;MAKE SURE SEGMENT IS FOR PROPER DISK BNE 3$ JSR PC,SETBIT ;DEALLOCATE THE SEGMENT MOV PNXTSG(R1),R0 ;GET NEXT SEGMENT POINTER BNE 1$ ;DONE IF ZERO MOV R2,R0 JSR PC,WRITDP ;WRITE THE DISK POINTER PAGE FOR DISK JSR PC,WRITBM ;WRITE THE BIT MAP RESTOR 21 RTS PC 2$: ERROR 3$: ERROR ,RESET .DSABL LSB ;CLEAR OUT CURRENT BLOCK CLRBLK: TST MODBLK ;CURRENT BLOCK WAS MODIFIED? BEQ 1$ JSR PC,WRITBK ;YES, WRITE IT BACK OUT CLR MODBLK 1$: CLR CURBLK RTS PC .SBTTL SEGMENT HACKING ROUTINES ;GET SEGMENT, POINTER IN R0, RETURN CORE POINTER IN R1 GETSEG: SAVE 02 JSR PC,NSPLIT ;SPLIT SEGMENT NUMBER CMP R1,CURBLK ;BLOCK ALREADY LOADED? BEQ 1$ ;YES JSR PC,CLRBLK ;CLEAR OUT OLD BLOCK MOV R1,CURBLK ;MAKE DESIRED BLOCK CURRENT JSR PC,READBK ;AND LOAD IT 1$: ASH #11-TUNE,R2 ;CONVERT RELATIVE SEGMENT TO RELATIVE WORD ADD #BLKBUF,R2 ;ABSOLUTIZE IT MOV R2,R1 ;RETURN IT IN R1 RESTOR 20 RTS PC ;INITIALIZE NEW SEGMENT FOR WRITING (POINTER IN R1) NEWSEG: INC MODBLK ;SET MODIFIED-BLOCK FLAG MOV R1,SEGEND ADD #SEGSIZ*2-2,SEGEND ;END OF SEGMENT MOV SEGEND,LASTLE SUB #10,LASTLE ;LAST POSSIBLE CATALOG ENTRY START WORD MOV DSKNUM,PDSKNO(R1) ;STORE DISK NUMBER ADD #PNXTSG,R1 ;NEXT-SEGMENT-POINTER LOCATION MOV R1,NSPLOC ;SAVE IT CLR (R1) ;INITIALIZE IT ADD #PFENT-PNXTSG,R1 ;MOVE TO FIRST ENTRY LOCATION RTS PC ;SETUP NEXT SEGMENT FOR READING, RETURN POINTER IN R1 NXTSEG: MOV NNXTSG,R0 ;SEGMENT TO GET JSR PC,GETSEG ;GET IT CMP PDSKNO(R1),DSKNUM ;MUST HAVE PROPER DISK NUMBER BNE 1$ MOV R1,LASTLE ADD #SEGSIZ*2-12,LASTLE ;LAST POSSIBLE CATALOG ENTRY START WORD MOV PNXTSG(R1),NNXTSG ;SAVE NEXT SEGMENT NUMBER ADD #PFENT,R1 ;MOVE TO FIRST ENTRY RTS PC 1$: ERROR ;SETUP NEXT SEQUENTIAL SEGMENT FOR READING, RETURN POINTER IN R1 NXTSSG: MOV NNXTSG,R0 ;SEGMENT TO GET JSR PC,GETSEG ;GET IT MOV PDSKNO(R1),DSKNUM ;SAVE PROPER DISK NUMBER MOV R1,LASTLE ADD #SEGSIZ*2-12,LASTLE ;LAST POSSIBLE CATALOG ENTRY START WORD 1$: INC R0 ;TRY NEXT SEGMENT JSR R5,TSTBIT ;USED? BR 2$ ;NO MORE SEGMENTS BNE 1$ ;FREE, TRY AGAIN BR 3$ 2$: CLR R0 ;ZERO MEANS NO MORE SEGMENTS 3$: MOV R0,NNXTSG ;SAVE NEXT SEGMENT NUMBER ADD #PFENT,R1 ;MOVE TO FIRST ENTRY RTS PC ;TEST DISK NUMBER FOR PROPER RANGE TSTDNM: CMP DSKNUM,DISKS ;MUST BE LESS THAN ALLOWABLE NUMBER OF DISKS BGE 1$ RTS PC 1$: ERROR ;GET FIRST SEGMENT IN CHAIN GIVEN DSKNUM, SKIP ON SUCCESS FRSTSG: JSR PC,TSTDNM ;TEST DISK NUMBER FOR RANGE MOV DSKNUM,R0 ASL R0 MOV DSKPTR(R0),R0 ;FIRST SEGMENT NUMBER BEQ 1$ ;FAILURE IF ZERO MOV R0,NNXTSG ;GET THE SEGMENT JSR PC,NXTSEG TST (R5)+ ;SKIP RETURN MOV #NXTSEG,NXTSGR ;SET UP PROPER NEXT SEGMENT ROUTINE TO USE 1$: RTS R5 ;GET FIRST SEQUENTIAL FILE SEGMENT IN CATALOG, SKIP ON SUCCESS FRSTSS: MOV #DPBLKS+1*<256./SEGSIZ>,R0 ;FIRST NON-HEADER SEGMENT BR 2$ 1$: INC R0 ;TRY NEXT SEGMENT 2$: JSR R5,TSTBIT ;USED? BR 3$ ;NO MORE SEGMENTS, FAILURE RETURN BNE 1$ ;FREE, TRY AGAIN MOV R0,NNXTSG ;FIRST USED SEGMENT JSR PC,NXTSSG ;GET FIRST SEGMENT MOV #NXTSSG,NXTSGR ;NEXT SEGMENT ROUTINE WILL BE SEQUENTIAL ONE TST (R5)+ ;SKIP RETURN 3$: RTS R5 ;ENSURE THAT R1 POINTS TO GOOD ENTRY, SKIP RETURN NXTENT: CMP (R1),#-1 ;-1 MEANS END-OF-SEGMENT BEQ 1$ CMP R1,LASTLE ;PAST LAST POSSIBLE START WORD? BLE 2$ ;IF NOT, JUST RETURN SUCCESSFULLY 1$: TST NNXTSG ;ANOTHER SEGMENT? BEQ 3$ ;IF NOT, RETURN UNSUCCESSFULLY JSR PC,@NXTSGR ;IF SO, GET IT 2$: TST (R5)+ ;SKIP RETURN 3$: RTS R5 .SBTTL RAD50 HACKING ROUTINES ;CONVERTS 3 ASCII CHARACTERS POINTED TO BY R1 TO ONE RAD50 WORD IN R0 ;SKIP RETURNS CRAD50: MOV #3,R0 ;CHARACTER LOOP COUNTER SAVE 2 CLR R2 ;ASCII CHARACTER AND TABLE POINTER SAVE 3 CLR R3 ;BUILD RAD50 WORD HERE SAVE 4 CLR R4 ;RAD50 CHARACTER 1$: MOVB (R1)+,R2 ;GET NEXT ASCII CHARACTER CMP R2,#RUBOUT ;MUST BE 7-BIT BGT 2$ SUB #SPACE,R2 ;CANNOT BE CONTROL CHARACTER BLT 2$ MOVB ATRTAB(R2),R4 ;GET RAD50 EQUIVALENT CMPB R4,#-1 ;UNTRANSLATABLE CHARACTER? BEQ 2$ ;YES MUL #50,R3 ;SHIFT PARTIAL RAD50 WORD ADD R4,R3 ;ADD IN NEW CHARACTER SOB R0,1$ ;LOOP FOR REST OF CHARACTERS MOV R3,R0 ;RETURN WORD HERE TST (R5)+ ;SKIP RETURN 2$: RESTOR 432 ;FAILURE ENTRY RTS R5 ;CONVERTS FROM RAD50 WORD (R0) TO ASCII (POINTER IN R1) FRAD50: SAVE 23 MOV R0,R3 MOV #3,R0 ;3 CHARACTERS IN RAD50 WORD 1$: CLR R2 DIV #50,R2 ;SHIFT OUT NEXT RAD50 CHARACTER MOVB RTATAB(R3),-(SP) ;STACK ASCII EQUIVALENT MOV R2,R3 ;OLD QUOTIENT BECOMES NEW DIVIDEND SOB R0,1$ ;NEXT CHARACTER MOV #3,R0 2$: MOVB (SP)+,(R1)+ ;MOVE CHARACTERS TO ASCII BLOCK SOB R0,2$ RESTOR 32 RTS PC ;PRINTS RAD50 WORD IN R0 PRAD50: SAVE 3 ;NORMAL ENTRY CLR R3 BR PRD500 PRD50S: SAVE 3 ;ENTRY FOR SUPPRESSING SPACES MOV #1,R3 PRD500: SAVE 12 SUB #4,SP ;LEAVE ROOM FOR ASCII (SP MUST BE KEPT EVEN) MOV SP,R1 ;ASCII BLOCK POINTER JSR PC,FRAD50 ;CONVERT FROM RAD50 MOV SP,R1 ;ASCII BLOCK POINTER MOV #3,R2 ;3 CHARACTERS CLR R0 1$: MOVB (R1)+,R0 ;PRINT THEM CMP R0,#SPACE ;SPACE? BNE 2$ ;NO TST R3 ;YES, DON'T PRINT IF SUPPRESSING SPACES BNE 3$ 2$: PRINC 3$: SOB R2,1$ ADD #4,SP ;CLEAR BLOCK OFF STACK RESTOR 213 RTS PC .SBTTL TERMINAL INPUT ROUTINES ;GET A CHARACTER WITH A LITTLE HACKERY .ENABL LSB GETCHR: TST COMSTR ;COMMAND STRING IN USE? BNE 1$ ;YES TST TSX ;NO, TSX? BEQ 3$ ;NO .PRINT #TSXONE ;YES, REQUEST SINGLE CHARACTER FIELD BR 3$ ;AND GET THE CHARACTER GETCH1: TST COMSTR ;ENTRY FOR FULL LINE, COMMAND STRING IN USE? BEQ 3$ ;NO 1$: MOVB @COMSTR,R0 ;YES, GET NEXT CHARACTER BEQ 2$ ;END-OF-STRING INC COMSTR ;BUMP COUNTER BR 4$ 2$: CLR COMSTR ;AT END-OF-STRING RETURN TO TERMINAL INPUT 3$: .TTYIN ;GET CHARACTER FROM TERMINAL 4$: .IF NE SCCA CMP R0,#CTLC ;CONTROL-C MEANS ERRET BNE NOCTLC PRINT <^C> ERRET NOCTLC: .ENDC CMP R0,#CR ;CARRIAGE RETURN? BNE 5$ ;NO TST TSX ;YES, UNDER TSX? BNE 6$ ;YES, NO LINE FEED JSR PC,GETCH1 ;OTHERWISE, FLUSH TRAILING LINE FEED MOV #CR,R0 ;AND RESTORE CHARACTER 5$: CMP R0,#'a ;CONVERT LOWERCASE TO UPPERCASE BLT 6$ CMP R0,#'z BGT 6$ SUB #40,R0 6$: RTS PC .DSABL LSB ;DELETE A CHARACTER DELCHR: BIT #1,TTSTAT ;PRINTING? BEQ 1$ ;YES .TTYOUT #BS ;ERASE CHARACTER ON A DISPLAY .TTYOUT #SPACE .TTYOUT #BS RTS PC 1$: .TTYOUT ;ECHO CHARACTER ON PRINTER RTS PC ;GET A STRING GETSTR: SAVE 12 MOV #INSTR,R1 ;BUFFER TO STORE STRING IN GETST1: JSR PC,GETCH1 ;GET NEXT CHARACTER CMP R0,#RUBOUT ;DELETE PREVIOUS CHARACTER? BNE 3$ CMP R1,#INSTR ;CHARACTER TO DELETE BNE 2$ 1$: FEEP BR GETST1 2$: MOVB -(R1),R0 ;POP LAST CHARACTER FROM STRING JSR PC,DELCHR ;DELETE A CHARACTER BR GETST1 3$: CMP R0,#LINDEL BNE 5$ MOV R1,R2 SUB #INSTR,R2 ;NUMBER OF CHARACTERS IN STRING BEQ GETST1 4$: MOVB -(R1),R0 ;POP LAST CHARACTER FROM STRING JSR PC,DELCHR ;DELETE IT SOB R2,4$ ;LOOP THROUGH ALL CHARACTERS BR GETST1 5$: CMP R0,#SPACE ;ANY OTHER CONTROL CHARACTER MEANS BLT 6$ ;END-OF-STRING CMP R1,#STREND ;IF STRING BUFFER FULL, BEQ 1$ ;COMPLAIN MOVB R0,(R1)+ ;STORE CHARACTER .TTYOUT ;ECHO IT BR GETST1 ;GET NEXT ONE 6$: CLRB (R1) ;STRING IS ASCIZ CMP R0,#CR ;SPECIAL HACK FOR CARRIAGE RETURN, BNE 7$ TST TSX ;IF RUNNING UNDER TSX, BEQ 7$ CRLF ;BECAUSE OF TSX ECHO SUPPRESSION BUG 7$: RESTOR 21 RTS PC ;GET A NUMBER, SKIP UNLESS NO DIGITS TYPED GETNUM: SAVE 123 JSR PC,GETSTR ;GET A STRING CLR R1 ;PUT NUMBER HERE MOV #INSTR,R2 CLR R3 ;PUT CHARACTERS HERE TSTB (R2) ;NULL STRING? BEQ 3$ ;YES, FAILURE RETURN 1$: MOVB (R2)+,R3 ;NEXT CHARACTER BEQ 2$ ;END-OF-STRING SUB #'0,R3 ;CONVERT TO BINARY NUMBER BMI 4$ ;BAD DIGIT CMP R3,#9. BGT 4$ ;BAD DIGIT MUL #10.,R1 ;DECIMAL SHIFT ADD R3,R1 ;ADD NEW DIGIT BR 1$ ;NEXT 2$: TST (R5)+ ;SKIP ON NUMBER GOTTEN MOV R1,R0 3$: RESTOR 321 RTS R5 4$: ERROR ;GET YES OR NO ANSWER, SKIP ON YES .ENABL LSB GETANS: JSR PC,GETCHR ;GET A CHARACTER CMP R0,#'N ;N FOR NO BNE 1$ PRIN1 BR 3$ 1$: CMP R0,#'Y ;Y FOR YES BEQ 2$ FEEP ;COMPLAIN IF WRONG CHARACTER & RETRY BR GETANS 2$: PRIN1 TST (R5)+ ;SKIP ON SUCCESS 3$: RTS R5 .DSABL LSB ;GET A FILE NAME (POINTER TO FILE NAME RETURNED IN R1) ;CALLED WITH JSR R5, NEXT WORDS ARE POINTERS TO TYPE & SWITCH TABLE .ENABL LSB GETFIL: MOV @(R5)+,FILNAM+6 ;DEFAULT TYPE MOV DEFDEV,FILNAM ;DEFAULT DEVICE CLR FILNAM+2 ;DEFAULT NAME CLR FILNAM+4 SAVE 234 MOV (R5)+,R1 ;SWITCH TABLE TO USE SAVE 51 PRIN1 JSR PC,GETSTR ;GET FILE NAME MOV #INSTR,R2 ;INPUT STRING CLR R5 ;CLEAR COLON AND DOT BITS 1$: MOV #FNAME,R1 ;INITIALIZE NAME TO SPACES MOV #" ,(R1) MOV #" ,2(R1) MOV #" ,4(R1) MOV #7,R3 ;MAXIMUM CHARACTERS PLUS ONE 2$: MOVB (R2)+,R0 ;GET NEXT CHARACTER BEQ 4$ ;END OF STRING CMP R0,#SLASH ;SWITCHES AFTER FILE NAME BEQ 4$ CMP R0,#COLON ;COLON ENDS DEVICE NAME BEQ 4$ CMP R0,#DOT ;DOT ENDS NAME BEQ 4$ MOVB R0,(R1)+ ;OTHERWISE, TRANSFER TO NAME BUFFER SOB R3,2$ ;LOOP 3$: ERROR ;SEVEN CHARACTERS ARE TOO MANY 4$: MOV #FNAME,R1 ;CONVERT NAME TO RAD50 WORDS JSR R5,CRAD50 BR 3$ ;BAD CHARACTERS IN NAME MOV R0,R3 JSR R5,CRAD50 BR 3$ ;BAD CHARACTERS IN NAME MOVB -1(R2),R4 ;RETRIEVE TERMINATING CHARACTER BEQ 6$ ;END OF STRING CMP R4,#COLON ;END OF DEVICE NAME? BNE 5$ ;NO BIT #3,R5 ;YES, ALREADY GOT COLON AND/OR DOT? BNE 3$ ;YES, ERROR BIS #1,R5 ;NO, NOW SET COLON BIT TST R0 ;MORE THAN 3 CHARACTERS? BNE 3$ ;YES, ERROR MOV R3,FILNAM ;NO, STORE DEVICE NAME BR 1$ ;NEXT NAME 5$: CMPB R4,#DOT ;END OF NAME? BNE 6$ ;NOT NECESSARILY BIT #2,R5 ;YES, ALREADY GOT DOT? BNE 3$ ;YES, ERROR BIS #2,R5 ;NO, NOW SET DOT BIT MOV R3,FILNAM+2 ;STORE NAME MOV R0,FILNAM+4 BR 1$ ;NEXT NAME 6$: BIT #2,R5 ;PRECEDING DOT? BNE 7$ ;YES, THIS IS TYPE MOV R3,FILNAM+2 ;NO, THIS IS NAME MOV R0,FILNAM+4 BR 8$ 7$: TST R0 ;YES, TYPE HAS MORE THAN 3 CHARACTERS? BNE 3$ ;YES, ERROR MOV R3,FILNAM+6 ;NO, SAVE TYPE 8$: RESTOR 1 ;SWITCH TABLE POINTER TSTB R4 ;ANY SWITCHES? BEQ 15$ ;NO 9$: MOVB (R2)+,R3 ;FIRST SWITCH CHARACTER BNE 11$ ;ERROR ON PREMATURE END OF STRING 10$: ERROR 11$: SWAB R3 ;PACK FIRST 2 CHARACTERS INTO R3 BISB (R2)+,R3 BEQ 10$ SWAB R3 MOV R1,R4 ;SWITCH TABLE POINTER 12$: MOV (R4)+,R0 ;STRING POINTER FOR NEXT SWITCH BEQ 10$ ;END OF TABLE CMP R3,(R0)+ ;SWITCHES MATCH? BEQ 13$ ;YES TST (R4)+ ;NO, CONTINUE LOOP BR 12$ 13$: MOVB (R2)+,R3 ;NEXT CHARACTER ENTERED BEQ 14$ ;END OF STRING MEANS SWITCHES MATCH CMP R3,#SLASH BEQ 14$ ;ALSO MATCH ON END OF SWITCH CMP R3,#SPACE BEQ 14$ ;ALSO ENDS SWITCH CMPB R3,(R0)+ ;CHARACTER MATCHES NEXT TABLE SWITCH CHARACTER BEQ 13$ ;YES, TRY NEXT CHARACTERS BR 10$ ;NO, ERROR 14$: JSR PC,@(R4) ;EXECUTE SWITCH HANDLER MOVB -1(R2),R4 ;GET TERMINATION CHARACTER BEQ 15$ ;IF END OF STRING, RETURN CMP R4,#SLASH ;WAS IT A SLASH OR A SPACE BEQ 9$ ;SLASH OK BR 10$ ;SPACE ILLEGAL TO BEGIN A SWITCH 15$: MOV #FILNAM,R1 ;RETURN POINTER TO FILE NAME RESTOR 5432 RTS R5 .DSABL LSB ;GET A NUMERIC ARGUMENT, STRING POINTER IN R2 .ENABL LSB GETNAR: CMPB -1(R2),#SPACE ;ARGUMENT? BEQ 1$ ;YES ERROR 1$: SAVE 13 CLR R1 ;PUT NUMBER HERE 2$: MOVB (R2)+,R3 ;NEXT CHARACTER BEQ 3$ ;END-OF-STRING CMP R3,#SLASH ;ALSO END OF NUMBER BEQ 3$ SUB #'0,R3 ;CONVERT TO BINARY NUMBER BMI 4$ ;BAD DIGIT CMP R3,#9. BGT 4$ ;BAD DIGIT MUL #10.,R1 ;DECIMAL SHIFT ADD R3,R1 ;ADD NEW DIGIT BR 2$ ;NEXT 3$: MOV R1,R0 RESTOR 31 RTS PC 4$: ERROR .DSABL LSB ;GET A DATE ARGUMENT, STRING POINTER IN R2 DEFVAR DDAY DEFVAR DMONTH DEFVAR DYEAR .ENABL LSB GETDAR: CMPB -1(R2),#SPACE ;ARGUMENT? BEQ 1$ ;YES ERROR 1$: SAVE 134 CLR DDAY ;INITIALIZE DATE VARIABLES CLR DMONTH CLR DYEAR CLR R4 ;DATE PARTS READ BITS 2$: MOVB (R2)+,R0 ;FIRST CHARACTER IN THIS PART OF DATE BEQ 10$ ;NULL ARGUMENT GETS TODAY'S DATE CMP R0,#SLASH ;NEXT SWITCH ALSO SIGNALS NULL ARGUMENT BEQ 10$ CMP R0,#'A ;A LETTER? BGE 5$ ;YES, GET MONTH SUB #'0,R0 ;NO, IS IT A GOOD DIGIT? BLT 9$ ;NO, ERROR CMP R0,#9. BGT 9$ ;NO, ERROR MOV R0,R1 CMPB (R2),#'0 ;NEXT CHARACTER A DIGIT? BLT 3$ ;NO, END OF NUMBER CMPB (R2),#'9 BGT 3$ ;NO, END OF NUMBER MUL #10.,R1 ;DECIMAL SHIFT FIRST DIGIT MOVB (R2)+,R0 ;SECOND DIGIT SUB #'0,R0 ;CONVERT FROM ASCII ADD R0,R1 ;BUILD NUMBER 3$: TST R1 ;NUMBER IS ZERO? BEQ 9$ ;YES, ILLEGAL CMP R1,#31. ;RANGE FOR DAY OF MONTH? BGT 4$ ;NO, COULD BE YEAR BIT #1,R4 ;YES, DAY PREVIOUSLY READ? BNE 9$ ;YES, ERROR BIS #1,R4 ;SET DAY READ BIT MOV R1,DDAY ;SAVE DAY BR 8$ ;NEXT PART 4$: SUB #110,R1 ;VALID RANGE FOR YEAR? BLT 9$ ;NO, ERROR CMP R1,#37 BGT 9$ ;NO, ERROR BIT #4,R4 ;YEAR PREVIOUSLY ENTERED? BNE 9$ ;YES, ERROR BIS #4,R4 ;SET YEAR READ BIT MOV R1,DYEAR ;SAVE YEAR BR 8$ ;END OF DATE ROUTINE 5$: DEC R2 ;BACKUP TO CHARACTER JUST READ MOV R2,R1 JSR R5,CRAD50 ;CONVERT MONTH TO RAD50 BR 9$ ;FAILURE MOV R1,R2 MOV #MONRTB,R1 ;RAD50 MONTH TABLE POINTER MOV #1,R3 ;FIRST MONTH 6$: CMP R0,(R1)+ ;MATCH WITH NAME READ? BEQ 7$ ;YES INC R3 ;NO, NEXT MONTH CMP R3,#12. ;END OF TABLE? BLE 6$ ;NO, LOOP BR 9$ ;YES, ERROR 7$: BIT #2,R4 ;MONTH PREVIOUSLY READ? BNE 9$ ;YES, ERROR BIS #2,R4 ;SET MONTH READ BIT MOV R3,DMONTH ;SAVE MONTH 8$: MOVB (R2)+,R0 ;NEXT CHARACTER BEQ 10$ ;END OF STRING IS END OF DATE CMP R0,#SLASH ;NEXT SWITCH? BEQ 10$ ;YES, ALSO END OF STRING CMP R0,#DASH ;LEGAL DATE PART SEPARATOR? BEQ 2$ ;YES, READ NEXT PART 9$: ERROR ;NO, ERROR 10$: CMPB -2(R2),#DASH ;DATE ENDED WITH DASH? BEQ 9$ ;YES, ERROR TST R4 ;DATE ENTERED? BNE 11$ ;YES MOV CURDAT,R0 ;NO, DEFAULT TO TODAY'S DATE BR 14$ ;RETURN 11$: BIT #4,R4 ;YEAR ENTERED? BNE 12$ ;YES MOV CURDAT,R0 ;NO, USE CURRENT YEAR BIC #140777,R0 SWAB R0 ASR R0 MOV R0,DYEAR 12$: BIT #3,R4 ;MONTH AND/OR DAY ENTERED? BEQ 13$ ;NO, LEAVE NULL FOR BEGINNING OF YEAR BIT #2,R4 ;MONTH BUT NO DAY? BNE 13$ ;YES, NULL DAY FOR BEGINNING OF MONTH MOV CURDAT,R0 ;DAY BUT NO MONTH, USE CURRENT MONTH ASH #-5,R0 BIC #^C17,R0 MOV R0,DMONTH 13$: MOV DYEAR,R0 ;CONVERT DATE TO INTERNAL FORMAT ASH #4,R0 ADD DMONTH,R0 ASH #5,R0 ADD DDAY,R0 14$: RESTOR 431 ;RETURN RTS PC .DSABL LSB .SBTTL SWITCH HANDLERS ;NAME SORT SWNA: MOV #CNAME,R0 BR SWSORT ;TYPE SORT SWTY: MOV #CTYPE,R0 BR SWSORT ;DATE SORT SWDA: MOV #CDATE,R0 BR SWSORT ;FILESIZE SORT SWFI: MOV #CSIZE,R0 BR SWSORT ;DISK NUMBER SORT AND GENERAL SORT TYPE HANDLER SWDI: MOV #CDISK,R0 SWSORT: SAVE 123 MOV #DEFORD,R1 ;DEFAULT ORDER OF COMPARISON ROUTINES MOV #COMPRS,R2 ;SORT COMPARISON ROUTINES BLOCK MOV #4,R3 ;FOUR TYPES IN ADDITION TO PRIMARY MOV R0,(R2)+ ;PRIMARY SORT TYPE GOES FIRST 1$: CMP R0,(R1)+ ;IS NEXT DEFAULT TYPE PRIMARY TYPE? BEQ 1$ ;YES, GO ON TO NEXT ONE MOV -2(R1),(R2)+ ;NO, TRANSFER THIS TYPE SOB R3,1$ ;LOOP THROUGH REST OF TYPES RESTOR 321 RTS PC ;REVERSE SORT SWRE: INC REVERS RTS PC ;FIND VOLUME ID'S INSTEAD OF FILE NAMES SWVO: INC FVOLID RTS PC ;LESS THAN FILE SIZE SWLE: JSR PC,GETNAR ;GET NUMERIC ARGUMENT MOV R0,LSIZE RTS PC ;EQUAL TO FILE SIZE (n-1 < SIZE < n+1) SWEQ: JSR PC,GETNAR ;GET NUMERIC ARGUMENT MOV R0,GSIZE DEC GSIZE MOV R0,LSIZE INC LSIZE RTS PC ;GREATER THAN FILE SIZE SWGR: JSR PC,GETNAR ;GET NUMERIC ARGUMENT MOV R0,GSIZE RTS PC ;BEFORE FILE DATE SWBE: JSR PC,GETDAR ;GET DATE ARGUMENT MOV R0,BDATE RTS PC ;DURING FILE DATE SWDU: JSR PC,GETDAR ;GET DATE ARGUMENT MOV R0,SDATE ;USE AS SINCE DATE BIT #777,R0 ;ONLY YEAR ENTERED? BNE 1$ ;NO ADD #1000,R0 ;YES, INCREMENT YEAR FOR BEFORE DATE BR 3$ 1$: BIT #37,R0 ;ONLY YEAR AND MONTH GIVEN? BNE 2$ ;NO ADD #40,R0 ;YES, INCREMENT MONTH FOR BEFORE DATE BR 3$ 2$: INC R0 ;OTHERWISE, INCREMENT DAY FOR BEFORE DATE 3$: MOV R0,BDATE ;SAVE BEFORE DATE RTS PC ;SINCE FILE DATE SWSI: JSR PC,GETDAR ;GET DATE ARGUMENT MOV R0,SDATE RTS PC ;ONLY DISK NUMBER SWON: JSR PC,GETNAR ;GET NUMERIC ARGUMENT MOV R0,ODISK RTS PC ;OUTPUT TO PRINTER SWPR: MOV #PRTBUF,PRTPTR ;SET UP PRINT BUFFER POINTER TST TTPCOL ;GET PRINTER DEFAULTS FOR VARIABLES NOT SET BNE 1$ MOV #PRTCOL,TTPCOL 1$: TST TTPLNS BNE 2$ MOV #PRTLNS,TTPLNS 2$: RTS PC ;LINES PER PAGE SWLI: JSR PC,GETNAR ;GET NUMERIC ARGUMENT MOV R0,TTPLNS BNE 1$ DEC TTPLNS ;CONVERT 0 TO -1 TO PROTECT IT FROM /PRINTER 1$: RTS PC ;COLUMNS PER LINE, MUST BE POSITIVE SWCO: JSR PC,GETNAR ;GET NUMERIC ARGUMENT TST R0 BLE 1$ MOV R0,TTPCOL RTS PC 1$: ERROR ;QUIET, DON'T PRINT FILES FOUND, JUST COUNT DEFVAR QUIET ;QUIET FLAG SWQU: INC QUIET RTS PC ;SECONDARY CATALOG SWSE: JSR PC,TOCAT2 RTS PC ;OWNER FIELD SET DEFVAR OWNERF ;OWNER FLAG SWOW: INC OWNERF RTS PC ;RT11A FORMAT DEFVAR RTAFLG ;RT11A FORMAT FLAG SWRT: INC RTAFLG RTS PC ;HELP .ENABL LSB SWHE: CRLF PRINT < Switches:> SAVE 1 ;SAVE TABLE POINTER 1$: .TTYOUT #SPACE MOV (R1)+,R0 ;NEXT STRING BEQ 2$ ;END OF TABLE .PRINT ;PRINT CURRENT STRING TST (R1)+ ;SKIP ROUTINE POINTER BR 1$ ;LOOP 2$: RESTOR 1 ;RESTORE TABLE POINTER CRLF ERRET .DSABL LSB .SBTTL TERMINAL OUTPUT ROUTINES ;PRINT A CHARACTER TO TERMINAL OR PRINTER FILE PUTCHR: TST PRTPTR ;PRINTING TO FILE? BNE PRTCHR ;YES .TTYOUT ;NO, NORMAL TERMINAL OUTPUT RTS PC PRTCHR: MOVB R0,@PRTPTR ;ENTRY FOR PRINTER FILE, PUT CHAR IN BUFFER INC PRTPTR ;UPDATE POINTER CMP PRTPTR,#PRTEND ;END OF BUFFER? BEQ OUTPRT ;YES, OUTPUT CHARACTERS RTS PC ;NO, JUST RETURN ;PRINT A STRING TO TERMINAL OR PRINTER FILE PUTSTR: TST PRTPTR ;PRINTING TO FILE? BNE 1$ ;YES .PRINT ;NO, NORMAL TERMINAL OUTPUT RTS PC 1$: SAVE 1 MOV R0,R1 2$: MOVB (R1)+,R0 ;GET NEXT CHARACTER FROM STRING BEQ 3$ ;END OF STRING CMPB R0,#200 ;ALSO END OF STRING BEQ 4$ JSR PC,PRTCHR ;TRANSFER CHARACTER TO BUFFER BR 2$ ;NEXT CHARACTER 3$: MOV #CR,R0 ;NULL MEANS END STRING WITH CRLF JSR PC,PRTCHR MOV #LF,R0 JSR PC,PRTCHR 4$: RESTOR 1 RTS PC ;OUTPUT ANY CHARACTERS IN PRINT BUFFER .ENABL LSB OUTPRT: CMP PRTPTR,#PRTBUF ;ANY CHARACTERS IN BUFFER? BEQ 3$ ;NO SAVE 1 MOV PRTPTR,R1 ;GET BUFFER POINTER BIT #1,R1 ;ODD NUMBER OF CHARACTERS? BEQ 1$ ;NO CLRB (R1)+ ;YES, FILL TO NEXT WORD 1$: SUB #PRTBUF,R1 ;CALCULATE NUMBER OF WORDS USED ASR R1 .WRITW #AREA,PRTCHN,#PRTBUF,R1,PRTBLK ;WRITE OUT BUFFER BCC 2$ ERROR 2$: INC PRTBLK ;UPDATE BLOCK COUNTER FOR NEXT WRITE MOV #PRTBUF,PRTPTR ;RESET POINTER RESTOR 1 3$: RTS PC .DSABL LSB ;PRINT CARRIAGE RETURN, LINE FEED NEWLIN: MOV #NULLIN,R0 ;PRINT AN EMPTY LINE PRINT RTS PC ;PRINT SPACES PUTSPC: SAVE 0 ;NUMBER OF SPACES TO PRINT BLE 2$ ;NO SPACES 1$: MOV #SPACE,R0 JSR PC,PUTCHR ;PRINT ONE DEC (SP) ;ANY MORE? BNE 1$ ;YES 2$: TST (SP)+ RTS PC ;PRINT NUMBER (ASSUMED TO BE POSITIVE), PRESERVE NUMBER (IN R0) PNUM: SAVE 01 MOV #-1,-(SP) ;END OF LIST MARKER MOV R0,R1 1$: CLR R0 DIV #10.,R0 ;SHIFT NEXT DECIMAL DIGIT INTO R1 SAVE 1 ;STACK IT MOV R0,R1 BNE 1$ ;NEXT DIGIT 2$: RESTOR 0 ;RETRIEVE DIGIT CMP R0,#-1 ;END OF LIST? BEQ 3$ ;YES ADD #'0,R0 ;ASCIIIZE IT PRINC ;AND PRINT IT BR 2$ ;NEXT DIGIT 3$: RESTOR 10 RTS PC ;PRINT FORMATTED NUMBER (ASSUMED TO BE POSITIVE) IN R0, DIGITS IN R1 .ENABL LSB PFNUM: SAVE 3 ;NORMAL ENTRY TO FILL WITH SPACES MOV #SPACE,R3 BR 1$ PFZNUM: SAVE 3 ;ENTRY FOR ZERO FILLING MOV #'0,R3 1$: SAVE 2 MOV R1,R2 MOV #-1,-(SP) ;END OF LIST MARKER MOV R0,R1 2$: CLR R0 DIV #10.,R0 ;SHIFT NEXT DECIMAL DIGIT INTO R1 SAVE 1 ;STACK IT DEC R2 ;DECREMENT DIGIT COUNTER MOV R0,R1 BNE 2$ ;NEXT DIGIT TST R2 ;UNUSED DIGITS? BLE 4$ ;NO 3$: MOV R3,R0 ;FILL WITH SPACES OR ZEROES PRINC SOB R2,3$ 4$: RESTOR 0 ;RETRIEVE DIGIT CMP R0,#-1 ;END OF LIST? BEQ 5$ ;YES ADD #'0,R0 ;ASCIIIZE IT PRINC ;AND PRINT IT BR 4$ ;NEXT DIGIT 5$: RESTOR 23 RTS PC .DSABL LSB ;PRINT DATE PDATE: BIT #37777,R0 ;NO DATE? BEQ 1$ ;YES SAVE 12 MOV R0,R2 BIC #^C37,R0 ;PULL OUT DAY BITS MOV #2,R1 ;2 DIGITS JSR PC,PFNUM ;PRINT DAY PRINC DASH ;SEPARATOR MOV R2,R0 ASH #-5,R0 ;PULL OUT MONTH BITS BIC #^C17,R0 ASL R0 ;CALCULATE MONTH NAME LOCATION IN DATE TABLE ASL R0 ADD #MONTAB-4,R0 PRINT ;PRINT IT PRINC DASH ;SEPARATOR MOV R2,R0 ASH #-11,R0 BIC #^C37,R0 ;PULL OUT YEAR BITS ADD #110,R0 ;ADD OFFSET JSR PC,PFNUM ;PRINT IT ALSO WITH 2 DIGITS RESTOR 21 RTS PC 1$: SPACE 9. ;BLANKS IF NO DATE RTS PC ;PRINT ENTRY POINTED TO BY R1 AND ADVANCE R1 PAST IT .ENABL LSB PENTD: MOV (R1)+,R0 ;ENTRY POINT FOR DSKNUM ALREADY IN ENTRY BR PENT0 PENT: MOV DSKNUM,R0 ;NORMAL ENTRY, GET DISK NUMBER PENT0: TST LSTCOL ;FIRST COLUMN ON LINE? BEQ 1$ ;YES SAVE 0 SPACE 4 ;4 SPACES BEFORE NEXT COLUMN RESTOR 0 1$: SAVE 2 MOV R1,R2 MOV #3,R1 ;3 DIGITS JSR PC,PFNUM PRINC SPACE MOV (R2)+,R0 ;PRINT FILE NAME JSR PC,PRAD50 MOV (R2)+,R0 JSR PC,PRAD50 PRINC DOT MOV (R2)+,R0 ;PRINT FILE TYPE JSR PC,PRAD50 MOV (R2)+,R0 ;PRINT FILE LENGTH MOV #5,R1 ;5 DIGITS JSR PC,PFNUM PRINC SPACE MOV (R2),R0 ;PRINT FILE DATE JSR PC,PDATE MOV #SPACE,R0 ;ASSUME NOT PROTECTED BIT #40000,(R2)+ ;PROTECTED FILE? BEQ 2$ ;NO MOV #'P,R0 ;YES, CHANGE ASSUMPTION 2$: PRINC ;PRINT THE CHARACTER INC LSTCOL ;UPDATE COLUMN COUNT CMP LSTCOL,TTPCOL ;END OF LINE? BNE 3$ ;NO CLR LSTCOL ;YES, RESET COUNTER CRLF ;AND NEW LINE 3$: MOV R2,R1 RESTOR 2 RTS PC .DSABL LSB ;FINISH PRINTING OF ENTRIES (NEW LINE) FPENT: TST LSTCOL ;ANY COLUMNS PRINTED ON THIS LINE? BEQ 1$ ;NO, DO NOTHING CRLF ;YES, NEXT LINE CLR LSTCOL ;AND RESET COLUMN COUNTER 1$: RTS PC ;PRINT HEADER ON NEW PAGE .ENABL LSB PHDR: SAVE 3 CLR R3 ;FIND-STRING-PRINTED-ON-FIRST-LINE FLAG PRINC FF ;START ON NEW PAGE MOV #VERSIO,R0 ;PRINT VERSION STRING PRIN1 PRINC SPACE CMP TTPCOL,#2 ;MORE THAN 2 COLUMNS? BLE 4$ ;NO SAVE 12 ;YES, SPACE OUT PAGE NUMBER MESSAGE MOV TTPCOL,R1 SUB #2,R1 ;BASIC HEADER USES 2 COLUMNS MUL #34.,R1 ;EACH COLUMN USES 34 POSITIONS DEC R1 ;SUBTRACT EXTRA SPACE USED IN 2 COLUMN HEADER MOV R1,R0 MOV #INSTR,R2 ;FIND STRING ENTERED SUB #20.,R1 ;ALLOW FOR PREFIX 1$: TSTB (R2)+ ;END OF STRING? BEQ 2$ ;YES DEC R1 ;DECREMENT TRAILING SPACES COUNT BGE 1$ ;CONTINUE, UNLESS NEGATIVE BR 3$ ;STRING WON'T FIT, LEAVE FOR NEXT LINE 2$: MOVB #200,-(R2) ;END STRING WITH NO CRLF BYTE PRIN1 < Find file named: > ;PREFIX MESSAGE MOV #INSTR,R0 PRIN1 ;PRINT FIND STRING CLRB (R2) ;REPLACE NULL AT END OF STRING INC R3 ;SET FIND-STRING-PRINTED FLAG MOV R1,R0 ;NUMBER OF TRAILING SPACES REQUIRED 3$: SPACE RESTOR 21 4$: SPACE 3 MOV CURDAT,R0 ;PRINT CURRENT DATE JSR PC,PDATE PRINC SPACE JSR PC,PCTIME ;PRINT CURRENT TIME PRIN1 < Page > INC CURPAG ;UPDATE CURRENT PAGE NUMBER AND PRINT IT MOV CURPAG,R0 JSR PC,PNUM CRLF ;NEXT LINE MOV #NULLIN,R0 ;BLANK LINE TST R3 ;PRINT FIND STRING HERE? BNE 5$ ;NO PRIN1 < Find file named: > MOV #INSTR,R0 ;PRINT FIND COMMAND STRING 5$: PRINT RESTOR 3 JMP CRLFRT ;SKIP A LINE .DSABL LSB ;PRINT CURRENT TIME PCTIME: SAVE 1 SUB #4,SP ;2 WORD SLOT FOR TIME .GTIM #AREA,SP ;GET IT RESTOR 01 DIV #3600.,R0 ;FIND NUMBER OF MINUTES SAVE 1 ;SAVE REMAINING TICKS MOV R0,R1 CLR R0 DIV #60.,R0 ;SEPARATE HOURS AND MINUTES JSR PC,PNUM ;PRINT HOURS PRINC COLON MOV R1,R0 ;PRINT MINUTES WITH 2 DIGITS MOV #2,R1 JSR PC,PFZNUM PRINC COLON CLR R0 RESTOR 1 DIV #60.,R0 ;FIND SECONDS MOV #2,R1 JSR PC,PFZNUM ;PRINT SECONDS WITH 2 DIGITS RESTOR 1 RTS PC .SBTTL BUFFER HANDLING ROUTINES ;QUEUE ENTRY FOR LATER PRINTING, POINTER IN R1, ADVANCE PAST ENTRY .ENABL LSB QENT: MOV BUFNXT,R0 ;NEXT WORD TO WRITE INTO ADD #12,R0 ;LAST WORD NEEDED FOR ENTRY CMP R0,BUFTOP ;PAST END OF BUFFER? BLOS 2$ ;NO JSR R5,GETMEM ;YES, GET MORE MEMORY BR 1$ ;NO MORE AVAILABLE BR QENT ;GOT SOME, TEST AGAIN 1$: INFORM ;INFORM USER JSR PC,PQENTS ;PRINT QUEUE ENTRIES TO CLEAR QUEUE 2$: MOV BUFNXT,R0 ;PREPARE TO WRITE MOV DSKNUM,(R0)+ ;MOVE DISK NUMBER .REPT 5 ;MOVE OTHER ENTRY WORDS MOV (R1)+,(R0)+ .ENDR MOV R0,BUFNXT ;SAVE UPDATED POINTER RTS PC .DSABL LSB ;GET MORE BUFFER MEMORY, SKIP ON SUCCESS GETMEM: MOV BUFTOP,R0 ;CURRENT MEMORY LIMIT ADD #1000,R0 ;TRY TO GET ANOTHER BLOCK .SETTOP CMP R0,BUFTOP ;GOT ANY NEW MEMORY? BLOS 1$ ;NO TST (R5)+ ;YES, SKIP RETURN 1$: MOV R0,BUFTOP ;SAVE NEW LIMIT RTS R5 ;PRINT QUEUED ENTRIES IN BUFFER AND CLEAR BUFFER PQENTS: SAVE 12345 JSR PC,SORT ;SORT ENTRIES MOV BUFBOT,PQBOT ;INITIALIZE LOCAL PRINT QUEUE POINTERS MOV BUFNXT,PQNXT MOV TTPBTS,R3 ;BYTES PER PAGE IF PAGING BEQ 3$ ;PAGING DISABLED 1$: ADD PQBOT,R3 ;END OF PAGE CMP R3,BUFNXT ;PAST REAL END OF QUEUE? BLOS 2$ ;NO MOV BUFNXT,R3 ;YES, JUST GO TO END OF QUEUE 2$: MOV R3,PQNXT ;CURRENT END OF PAGE JSR PC,PHDR ;PRINT HEADER FOR NEW PAGE 3$: MOV PQNXT,R3 ;CALCULATE WORDS USED SUB PQBOT,R3 CLR R2 DIV #14,R2 ;CONVERT TO NUMBER OF ENTRIES IN QUEUE MOV R2,R3 CLR R2 DIV TTPCOL,R2 ;FIND NUMBER OF ENTRIES PER COLUMN TST R3 ;ROUND UP ONE IF NECESSARY BEQ 4$ INC R2 4$: MOV R2,R3 ;CALCULATE WORD INCREMENT BETWEEN COLUMNS MUL #14,R3 MOV PQBOT,R5 SAVE 5 ;NEXT WORD AFTER COLUMN ONE ENDS ADD R3,(SP) SUB #14,R5 ;WILL BE CONVERTED TO STARTING ADDRESS MOV PQNXT,R2 ;NEXT WORD AFTER END OF QUEUE SUB #14,R3 ;ALLOW FOR PENT UPDATING R1 5$: ADD #14,R5 ;NEXT LINE STARTS HERE CMP R5,(SP) ;PAST END OF FIRST COLUMN? BEQ 8$ ;YES MOV R5,R1 MOV TTPCOL,R4 ;NUMBER OF COLUMNS ON LINE 6$: JSR PC,CHKDCC ;CHECK FOR DOUBLE CONTROL-C CMP R1,R2 ;REACHED END OF QUEUE? BHIS 7$ ;YES JSR PC,PENTD ;PRINT QUEUE ENTRY ADD R3,R1 ;NEXT ENTRY SOB R4,6$ ;NEXT COLUMN BR 5$ ;NEXT LINE 7$: JSR PC,FPENT ;TERMINATION OF LINE AT END OF QUEUE BR 5$ ;NEXT LINE 8$: TST (SP)+ MOV TTPBTS,R3 ;PAGING ENABLED? BEQ 9$ ;NO CMP PQNXT,BUFNXT ;END OF REAL QUEUE? BEQ 9$ ;YES, DONE MOV PQNXT,PQBOT ;NO, NEXT PAGE BR 1$ 9$: MOV BUFBOT,BUFNXT ;RESET FREE WORD POINTER RESTOR 54321 RTS PC .SBTTL COMPARISON ROUTINES ;COMPARE NAMES, ENTRY POINTERS IN R1 AND R2, ;SKIP TWICE ON NAME1NAME2 CNAME: CMP 2(R1),2(R2) BLO 1$ BHI 3$ CMP 4(R1),4(R2) BEQ 2$ BHI 3$ 1$: TST (R5)+ 2$: TST (R5)+ 3$: RTS R5 ;COMPARE TYPES, LIKE CNAME CTYPE: CMP 6(R1),6(R2) BR CTEST ;COMPARE DATES, LIKE CNAME CDATE: CMP 12(R1),12(R2) BR CTEST ;COMPARE DISK NUMBERS, LIKE CNAME CDISK: CMP (R1),(R2) BR CTEST ;COMPARE SIZES, LIKE CNAME CSIZE: CMP 10(R1),10(R2) CTEST: BEQ 1$ BHI 2$ TST (R5)+ 1$: TST (R5)+ 2$: RTS R5 ;GENERAL COMPARISON ROUTINE, ENTRY POINTERS IN R1 AND R2 ;SKIPS IF FILES DO NOT HAVE TO BE REARRANGED COMPAR: SAVE 34 MOV #COMPRS,R3 ;COMPARISON ROUTINES TO USE MOV #5,R4 ;5 OF THEM TO TRY IN WORST CASE 1$: JSR R5,@(R3)+ ;IF EQUAL SO FAR, DO A COMPARISON BR 3$ ;FILE1 > FILE2 BR 2$ ;FILE1 = FILE2 BR 4$ ;FILE1 < FILE2 2$: SOB R4,1$ ;FILES EQUAL, TRY NEXT COMPARISON BR 5$ ;COMPLETELY EQUAL, SUCCEED 3$: TST REVERS ;GREATER, FAILURE UNLESS REVERSE BEQ 6$ BR 5$ 4$: TST REVERS ;LESS, SUCCESS UNLESS REVERSE BNE 6$ 5$: TST (R5)+ 6$: RESTOR 43 RTS R5 .SBTTL SORT ROUTINES ;SORT ENTRIES IN QUEUE USING SHELL METHOD SORT: SAVE 12345 MOV #777.,R5 ;ZEROTH SHELL INCREMENT 1$: JSR PC,CHKDCC ;CHECK FOR DOUBLE CONTROL-C INC R5 ;CALCULATE NEXT SHELL SORT INCREMENT ASR R5 SAVE 5 MUL #14,R5 ;CONVERT ENTRY INCREMENT TO WORD INCREMENT MOV BUFNXT,R3 ;FIRST WORD PAST END OF QUEUE 2$: CLR SRTFLG ;FLAG MARKS CHANGES DURING SORT PASS MOV BUFBOT,R1 ;FIRST QUEUE ENTRY MOV R1,R2 ADD R5,R2 ;SECOND QUEUE ENTRY 3$: CMP R2,R3 ;REACHED END OF QUEUE? BHIS 8$ ;YES JSR R5,COMPAR ;COMPARE NEXT TWO ENTRIES BR 4$ ;MUST REARRANGE ADD #14,R1 ;ENTRIES OK, ADVANCE TO NEXT ENTRIES ADD #14,R2 BR 3$ 4$: INC SRTFLG ;SET MODIFICATION FLAG MOV #6,R4 ;STACK FIRST ENTRY FORWARDS 5$: MOV (R1)+,-(SP) SOB R4,5$ SUB #14,R1 ;RESET FIRST ENTRY POINTER MOV #6,R4 ;MOVE SECOND ENTRY TO FIRST FORWARDS 6$: MOV (R2)+,(R1)+ SOB R4,6$ MOV #6,R4 ;UNSTACK NEW SECOND ENTRY BACKWARDS 7$: MOV (SP)+,-(R2) SOB R4,7$ ADD #14,R2 ;ADVANCE TO NEW SECOND ENTRY BR 3$ ;NEXT COMPARISON 8$: SUB R5,R3 ;LAST BLOCK OF ENTRIES NOW IN POSITION TST SRTFLG ;ANY CHANGES DURING PASS? BNE 2$ ;YES, ANOTHER INTERCHANGE PASS NECESSARY RESTOR 5 CMP R5,#1 ;REACHED UNIT INCREMENT, YET? BNE 1$ ;NO, NEXT SHELL PASS RESTOR 54321 RTS PC .SBTTL BIT MAP HACKING ROUTINES ;SPLIT SEGMENT NUMBER (R0) INTO BLOCK (R1) AND RELATIVE SEG (R2) NSPLIT: MOV R0,R1 ASH #-TUNE,R1 ;SHIFT AWAY SEGMENT BITS MOV R0,R2 BIC #SEGMSK,R2 ;ISOLATE RELATIVE SEGMENT BITS RTS PC ;POINT TO A BIT MAP BIT (NUMBER IN R0) ;RETURN ABSOLUTE WORD NUMBER IN R1, BIT MASK IN R2 PNTBIT: SAVE 3 MOV R0,R1 MOV R0,R3 ASH #-4,R1 ;RELATIVE WORD NUMBER ASL R1 ;BYTE ADD #BITMAP,R1 ;ABSOLUTIZE IT MOV #1,R2 ;CREATE POINTING BIT BIC #177760,R3 ;BIT POSITION IN WORD ASH R3,R2 ;SHIFT BIT TO POSITION RESTOR 3 RTS PC ;CLEAR A BIT MAP BIT (ALLOCATE A SEGMENT) CLRBIT: SAVE 12 JSR PC,PNTBIT ;POINT TO BIT BIC R2,@R1 ;CLEAR THE BIT RESTOR 21 RTS PC ;SET A BIT MAP BIT (DEALLOCATE A SEGMENT) SETBIT: SAVE 12 JSR PC,PNTBIT ;POINT TO BIT BIS R2,@R1 ;SET THE BIT RESTOR 21 RTS PC ;TEST A BIT MAP BIT (0 IF USED, ELSE FREE), SKIP ON SEGMENT IN RANGE TSTBIT: CMP R0,MAXSEG ;OUT OF RANGE? BGT 1$ ;YES, FAILURE RETURN TST (R5)+ ;NO, CONTINUE AND SKIP RETURN SUB #4,SP SAVE 12 JSR PC,PNTBIT ;POINT TO BIT MOV R1,6(SP) ;PLAY GAMES TO RETURN WITH REGISTERS UNCHANGED MOV R2,4(SP) ;AND ZERO CONDITION BIT SET OR CLEARED RESTOR 21 BIT (SP)+,@(SP)+ ;ACTUAL TEST 1$: RTS R5 ;FIND A FREE SEGMENT IN BIT MAP FNDBIT: SAVE 12 MOV #BITMAP,R1 ;BEGINNING OF BIT MAP 1$: TST (R1)+ ;NEXT WORD BEQ 1$ ;LOOP UNTIL NON-ZERO WORD FOUND TST -(R1) ;BACKUP TO PROPER WORD MOV R1,R0 SUB #BITMAP,R0 ;RELATIVE BYTE NUMBER ASH #3,R0 ;SEGMENT NUMBER OF FIRST BIT MOV #1,R2 ;BIT TO TEST WITH BR 3$ ;SKIP FIRST INCREMENT 2$: INC R0 ;NEXT BIT ASL R2 ;NEXT BIT POSITION 3$: BIT R2,(R1) ;LOOP TO FIND FIRST 1 BEQ 2$ CMP R0,MAXSEG BGT 4$ ;GREATER THAN HIGHEST GOOD SEGMENT? BIC R2,(R1) ;CLEAR FOUND BIT RESTOR 21 RTS PC ;RETURN SEGMENT POINTER 4$: ERROR ,RESET .SBTTL EXTENDED INSTRUCTION SET SIMULATION ROUTINES ;ALL ROUTINES TAKE ARGUMENTS ON STACK & RETURN RESULT ON STACK AFTER ;REMOVING CONSTANT ARGUMENT .IF EQ EIS ;ARITHMETIC SHIFT (SINGLE WORD) ASHSIM: SAVE 01 MOV 10(SP),R0 ;WORD TO SHIFT MOV 6(SP),R1 ;NUMBER OF BITS TO SHIFT BY BEQ 4$ ;NO SHIFT REQUIRED BLT 2$ ;RIGHT SHIFT 1$: ASL R0 ;LEFT SHIFT SPECIFIED NUMBER OF TIMES SOB R1,1$ BR 4$ 2$: NEG R1 3$: ASR R0 ;RIGHT SHIFT SPECIFIED NUMBER OF TIMES SOB R1,3$ 4$: MOV R0,10(SP) ;REPLACE SHIFTED WORD MOV 4(SP),6(SP) ;MOVE RETURN ADDRESS WHERE NUMBER ARGUMENT WAS RESTOR 10 TST (SP)+ ;POP OFF OLD COPY OF RETURN ADDRESS RTS PC ;MULTIPLY (SINGLE WORD ONLY) MULSIM: SAVE 012 CLR R0 ;BUILD PRODUCT HERE MOV 12(SP),R1 ;MULTIPLICAND MOV 10(SP),R2 ;MULTIPLIER 1$: ASR R2 ;TEST CURRENT LOW ORDER BIT BCC 2$ ;ZERO? ADD R1,R0 ;YES, ADD PARTIAL PRODUCT 2$: ASL R1 ;MULTIPLY MULTIPLICAND BY 2 TST R2 ;ANY MULTIPLIER BITS LEFT? BNE 1$ ;YES, LOOP MOV R0,12(SP) ;RETURN PRODUCT IN MULTIPLICAND SLOT MOV 6(SP),10(SP) ;SHIFT RETURN ADDRESS TO CLEAR MULTIPLIER SLOT RESTOR 210 TST (SP)+ ;POP OFF OLD COPY OF RETURN ADDRESS RTS PC ;DIVIDE (DOUBLE WORD) DIVSIM: SAVE 012345 MOV 22(SP),R0 ;HIGH ORDER DIVIDEND WORD MOV 20(SP),R1 ;LOW ORDER DIVIDEND WORD CLR R2 ;HIGH ORDER SHIFTED DIVISOR WORD MOV 16(SP),R3 ;LOW ORDER SHIFTED DIVISOR WORD CLR R4 ;SHIFT COUNT CLR R5 ;QUOTIENT BUILT HERE 1$: CMP R2,R0 ;COMPARE SHIFTED DIVISOR WITH DIVIDEND BNE 2$ CMP R3,R1 2$: BHI 3$ ;DONE WHEN DIVISOR IS GREATER INC R4 ;ELSE, INCREMENT SHIFT COUNTER ASL R3 ;AND SHIFT DIVISOR ROL R2 BR 1$ ;LOOP 3$: TST R4 ;ORIGINAL DIVISOR GREATER THAN DIVIDEND? BEQ 8$ ;YES, RETURN 0 WITH DIVIDEND AS REMAINDER 4$: ASR R2 ;UNSHIFT DIVISOR ONE BIT ROR R3 CMP R2,R0 ;COMPARE WITH REMAINING DIVIDEND BNE 5$ CMP R3,R1 5$: BHI 6$ ;STILL GREATER SUB R3,R1 ;ELSE, DECREASE DIVIDEND BY SHIFTED DIVISOR SBC R0 SUB R2,R0 SEC ;AND SET CURRENT QUOTIENT BIT BR 7$ 6$: CLC ;RESET CURRENT QUOTIENT BIT 7$: ROL R5 ;SHIFT CURRENT BIT INTO QUOTIENT SOB R4,4$ ;LOOP UNTIL DIVISOR COMPLETELY UNSHIFTED 8$: MOV R5,22(SP) ;SAVE QUOTIENT MOV R1,20(SP) ;AND REMAINDER MOV 14(SP),16(SP) ;SHIFT RETURN ADDRESS TO CLEAR DIVISOR SLOT RESTOR 543210 TST (SP)+ ;POP OFF OLD COPY OF RETURN ADDRESS RTS PC .ENDC .SBTTL FINISH IT UP .PSECT BUFFER ;BUFFER AT END, SPACE ALLOCATED VIA .SETTOP $$$=. BLKBUF= $$$ ;CURRENT BLOCK LOADED FROM CATALOG $$$=$$$+512. HEADER= $$$ ;HEADER PAGES DESCRIBING CATALOG BITMAP= $$$ ;SEGMENT ALLOCATION TABLE, FREE=1 $$$=$$$+512. TUNSAV= $$$ ;SAVED TUNE FOR DSKLIB VERSION VALIDATION $$$=$$$+2 DPBSAV= $$$ ;SAVED DPBLKS, LIKE TUNSAV $$$=$$$+2 DSKPTR= $$$ ;DISK LIST HEADER POINTER PAGE .END START