src/tendmp.mac

   1 TITLE TENDMP - DTAPE/MTAPE UTILITY - R CLEMENTS/GBH/RH/RD/RCC/JEF 6 APR 71 - V032\r
   2         IFNDEF REL,<REL=0>      ;0 PAPER TAPE, 1 RELOCATABLE BINARY\r
   3         IFNDEF CORE,<CORE=4>    ;NUMBER OF 8K MEMORY BLOCKS\r
   4 \r
   5         SUBTTL 551/136 VERSION\r
   6 \r
   7 IFE REL,<RIM>\r
   8         UTC=210\r
   9         UTS=214\r
  10         DC=200\r
  11 \r
  12 F=0     ;MUST BE 0. USED BY JRA'S\r
  13 A=2     ;MISC TEMP. HOLDS 136 CONO INDEX IN UWAIT\r
  14 B=1     ;TEMP. HOLDS BLOCK # COMPUTATION IN SEARCH\r
  15 C=3     ;HOLDS BITS FOR DECTAPE CONO DURING I/O\r
  16 D=4     ;HOLDS POINTERS FOR AOBJN'S THROUGH CORE\r
  17 E=5     ;HOLDS COUNT OF WORDS IN CURRENT DT BLOCK\r
  18 P=6     ;PC FOR JSP'S\r
  19 CKS=7   ;HAD BEEN CHECKSUM IN MACDMP\r
  20 FILN=10 ;NUMBER OF FILE IN DIRECTORY, 1 TO 26 OCTAL\r
  21 BLKNO=11        ;BLOCK NUMBER SEARCHED FOR ON TAPE\r
  22 WRITE=12        ;MULTI-STATE FLAG FOR DEFINING I/O OPERATION\r
  23                 ;1=D 0=K -1=ELSE\r
  24 PNTR=13 ;POINTER TO BYTE TABLE IN DIRECTORY\r
  25 CH=14   ;HOLDS 6BIT CHARACTER OF COMMAND, OR -1\r
  26 Q=15    ;ANOTHER JSP AC\r
  27 G=16    ;RARELY USED VERY TEMP\r
  28 CT=17   ;COUNT OF WORDS TO DUMP\r
  29 \r
  30 COMPTR=BEGR+377 ;COMMAND POINTER, IF SUPPLIED\r
  31         LOZAD=BEGR-203  ;WHEN CORE IS CLEARED, IT\r
  32                         ;IS FROM 40 THRU LOZAD\r
  33         LOW=20  ;FIRST LOCATION CONSIDERED FOR DUMPING\r
  34         HIGH=BEGR-203   ;LAST LOCATION CONSIDERED FOR DUMPING\r
  35                         ;ZEROED AT BEG THESE DAYS\r
  36         FOOF=BEGR-202   ;NEEDED FOR ZERO CORE SEARCH, ZEROED AT BEG1\r
  37 TAB=BEGR-201            ;FILE DIRECTORY\r
  38 LINK=BEGR-1             ;0-17=LINK, 18-27=FBN, 29-35=WC\r
  39 IFE REL,<LOC 17400+<<CORE-1>*20000>>\r
  40 \f;INITIAL ENTRY IS AT BEGR, UNLESS A COMMAND POINTER IS\r
  41 ;SUPPLIED IN COMPTR. IN THAT CASE, ENTRY IS AT BEGR+1\r
  42 \r
  43 BEGR:   SETZM COMPTR    ;CLEAR ANY JUNK IN COMMAND POINTER\r
  44         CONO 635550     ;I/O RESET, ETC.\r
  45 BEG:    JSP P,CRR       ;TYPE A CR-LF\r
  46         MOVEI D,SPNT-2  ;PREPARE TO REMOVE AOBJN POINTERS\r
  47 BEG1:   SETZB A,FOOF    ;CLEAR A TO PUT IN CORE, CLEAR\r
  48                         ;FOOF FOR  THE NEXT ZERO CORE SEARCH\r
  49         EXCH A,2(D)     ;REMOVE HEADER LIST\r
  50         AOBJN A,.       ;COUNT THROUGH TO NEXT HEADER\r
  51         MOVEI D,-1(A)   ;ACCOUNT FOR OVERSHOOT IN AOBJN\r
  52         JUMPN D,BEG1    ;IF WE DIDNT AOBJN A 0, GO FOR NEXT HDR\r
  53         MOVE PNTR,[XWD 500,TAB-1]       ;5 BIT BYTES IN DIRECTORY\r
  54         SETZB CH,F\r
  55 CRCH:   SETOI WRITE,215 ;USED FOR CARRET TYPEOUT\r
  56 TYI:    SETZB C,HIGH    ;HOPEFULLY HIGH IS TEMPORARY\r
  57         SETZB B,E       ;NAME INITIALIZING\r
  58         TLOA B,400000   ;NULL NAME IS "@. "\r
  59 SPACE:  MOVEI E,C-1     ;EXTENSION INTO C\r
  60         HRLI E,20600    ;FAKE OUT END TEST OF BYTE PTR\r
  61 ;STOP TAPE DRIVE\r
  62         CONO UTC,0\r
  63 NEXT:   ILDB A,@BEGR    ;GIVES A 0 UNLESS COMMAND POINTER SUPPLIED\r
  64                         ;RH OF NEXT IS USED AS A CONSTANT\r
  65 BELL:   SETOI FILN,207  ;INITIALIZATION FOR SEARCH\r
  66         SETZB BLKNO,CT  ; "\r
  67         SETZM LINK\r
  68         JUMPN A,RCH     ;JUMP IF COMMAND READ FROM CORE\r
  69         CONSO TTY,40    ;TYPEIN FLAG?\r
  70         JRST .-1        ;NO,WAIT\r
  71         DATAI TTY,A     ;GET TYPED IN CHARACTER\r
  72         JSP P,TYO       ;ECHO IT (WITH PARITY)\r
  73 RCH:    ANDI A,177      ;STRIP OFF PARITY\r
  74         CAIN A,177      ;RUBOUT?\r
  75         JRST BEGR       ;YES. RESTART TENDMP\r
  76         CAIE A,33       ;NEW ALTMODE?\r
  77         CAIL A,175      ;OR 175 OR 176 ALTMODES?\r
  78         JRST ALTTST     ;YES, SOME ALTMODE.\r
  79         CAIL A,140      ;LOWER CASE CHARACTER?\r
  80         TRZ A,40        ;YES. CHANGE TO UPPER CASE\r
  81         SUBI A,40       ;CONVERT TO SIXBIT\r
  82         JUMPL A,CARRET  ;ANY CONTROL CHARACTER\r
  83         JUMPE A,SPACE   ;CHAR WAS 40\r
  84 NEXT1:  TLNE E,770000   ;NO MORE THAN SIX CHARS\r
  85         IDPB A,E        ;GOES INTO AC1 = B\r
  86         JRST NEXT       ;GET ANOTHER CHARACTER\r
  87 \r
  88 \f\r
  89 ;HERE ON JUMP BLOCK DURING LOADS, OR NUMBER>7 ALT\r
  90 JBLK:\r
  91 ;STOP TAPE DRIVE\r
  92         CONO UTC,0\r
  93         HRRM D,SADR     ;SAVE STARTING ADDRESS\r
  94         JUMPN CH,BEG    ;IF NOT LOADGO COMMAND\r
  95 SADR:   JRST BEG        ;CURRENT S.A.\r
  96 LOADS:                  ;HERE TO LOAD TAPE TO CORE\r
  97         MOVEI D,LOZAD+1 ;FIRST LOC NOT TO ZERO\r
  98         SETZM 40        ;A "FEATURE"\r
  99         MOVE C,[XWD 40,41]      ;PREPARE TO CLEAR CORE.\r
 100         TRNN CH,3       ;SKIP ON M,N   NOT ON L,T,@\r
 101         BLT C,-1(D)     ;ZERO CORE\r
 102 LOAD:   JSP Q,LODUMP    ;START READING FILE. LODUMP PROCESSES\r
 103                         ;ONE HEADER AND ITS DATA\r
 104         JRST LOAD       ;IF OK, GET NEXT BLOCK.(IF NONE, \r
 105                         ;LODUMP RETURNS TO JBLK.)\r
 106 DELE:   SKIPN E,WRITE   ;SKIP IF NOT IN THE K PHASE OF A D COMMAND.\r
 107                         ;OR A K COMMAND\r
 108                         ;ALSO, SET E =0, SO SEARCH HAPPENS IN RBLK\r
 109 CLS1:   AOJA WRITE,CLSTP        ; 0 TO 1. GO DUMP OUT DIRECTORY.\r
 110 ERR:    SKIPA P,NEXT    ;SET TO RETURN TO BEGR\r
 111 CRR:    SKIPA A,CRCH    ;LIKE HRROI A,215 AND SKIPA\r
 112         SKIPA A,BELL    ;GET A BELL CHARACTER\r
 113 TYO:    SKIPN COMPTR    ;DONT TYO IF NO TYI, UNLESS ERR\r
 114         DATAO TTY,A     ;TYPE OUT\r
 115         CONSZ TTY,20    ;WAIT FOR TTY TO FINISH\r
 116         JRST .-1        ;NOT YET\r
 117         CAIE A,215      ;IF CR TYPED IN,\r
 118         JUMPGE A,(P)    ;OR SIGN BIT OF CHAR ON,(SEE CRR)\r
 119         MOVEI A,12      ;APPEND A LINEFEED\r
 120         JRST TYO        ;GO TYPE LF\r
 121 \r
 122 \fALTTST:        TLNN B,4040     ;IF ALPHA CHARACTERS, DONT GET CH\r
 123         LDB CH,E        ;LAST CH BEFORE ALT, -40\r
 124         JUMPN CH,ALTMD  ;IF CH NOT NULL, GOT PROCESS ALTMODE\r
 125 CARRET: MOVSI FILN,-26  ;FILE NAME SPECIFIED. FIRST THING TO\r
 126                         ;DO IS LOOK IT UP IN DIRECTORY\r
 127 LUP:    SKIPN TAB+123(FILN)     ;SEARCH FOR FREE FILE\r
 128         SKIPE BLKNO,TAB+151(FILN)       ;CHECK BOTH WORDS\r
 129         TDZA BLKNO,BLKNO        ;ENSURE CLEAR BLOCK NUMBER\r
 130         HRRM FILN,FREE  ;SAVE NUMBER OF A FREE FILE\r
 131         HLLZ G,TAB+151(FILN)    ;ONLY CHECK LEFT OF 2ND WD\r
 132         CAMN B,TAB+123(FILN)    ;SEARCH FOR TYPED-IN FILE\r
 133         CAME C,G                ;BOTH WORDS\r
 134         AOBJN FILN,LUP  ;NOT THIS ONE. KEEP LOOKING\r
 135         JUMPL FILN,BEG69        ;IF FILE FOUND, JUMP\r
 136         JUMPLE WRITE,ERR        ;IF NOT FOUND, BETTER BE DUMP\r
 137 FREE:   MOVEI FILN,.    ;DUMP & NOT FOUND, MAKE ENTRY WHERE FREE\r
 138                         ;(ADDRESS MODIFIED ABOVE)\r
 139         SKIPE TAB+123(FILN)     ;MAKE SURE HOLE AVAILABLE\r
 140         JRST ERR        ;NO FREE SLOTS\r
 141 \r
 142 BEG69:  MOVEI FILN,1(FILN)      ;FILN IS FILE #+1; CLR LH\r
 143         JUMPL WRITE,LOADS       ;ALL LOAD INSTRUCTIONS\r
 144         SKIPN WRITE     ;DELETE? (K COMMAND)\r
 145         SETZB B,C       ;YES, KILL FILE\r
 146         MOVEM B,TAB+122(FILN)   ;CLEAR IF DELE, ENTER IF NEW DUMP\r
 147         HLLZM C,TAB+150(FILN)   ;BOTH WORDS\r
 148                                 ;FALL INTO DUMP ROUTINE\r
 149                                 ;WHICH IS A NO-OP FOR K\r
 150 \r
 151 \f\r
 152 ;DUMP WRITES OUT CORE ONTO TAPE\r
 153 \r
 154 ;DUMP THRU DUMP2-1 SETS UP POINTERS TO NON-ZERO CORE AREAS. THESE\r
 155 ;AOBJN POINTERS ARE CALLED  "HEADERS", AND PRECEDE THE DATA WHEN\r
 156 ;THE TAPE IS WRITTEN.\r
 157 ;THE FIRST HEADER IS KEPT IN SPNT. SUCCESIVE HEADERS GO INTO THE FIRST\r
 158 ;ZERO WORD FOLLOWING THE BLOCK CORRESPONDING TO THE PREVIOUS HEADER.\r
 159 ;AFTER THE LAST NON-ZERO BLOCK IS (BY DEFINITION) A ZERO, WHICH\r
 160 ;TERMINATES THE HEADER LIST. THIS WORD MAY BE LOCATION FOOF (37176) IF\r
 161 ;CORE WAS FILLED UP TO THE BASE OF TENDMP.\r
 162 \r
 163 DUMP:                   ;HERE ON D,K. (BLKN)=0, FILN SET UP\r
 164         MOVN A,[XWD HIGH-LOW-1,-LOW+1]  ;COUNTER TO EXAMINE \r
 165                                         ;CORE FOR BLOCKS OF 0\r
 166         MOVEI CKS,SPNT-1        ;FIRST HEADER GOES INTO SPNT\r
 167 DMP1:   SKIPN 1(A)      ;FIND SOME NON-ZERO CORE\r
 168         AOBJN A,.-1     ;ZERO. KEEP LOOKING.\r
 169         MOVEM A,D       ;SAVE ADR\r
 170         SKIPN 1(A)      ;FIND SOME ZERO CORE\r
 171         SKIPE 2(A)      ;DON'T MAKE NEW BLOCK FOR 1 ZERO\r
 172         AOBJN A,.-2     ;NON-ZERO. KEEP LOOKING\r
 173         SUB D,A         ;GET -COUNT IN BOTH HALVES OF D\r
 174         SUBI CT,-1(D)   ;COUNT N WORDS DATA, 1 HDR\r
 175         ADDI D,(A)      ;GET F.A.-1 IN RH OF D\r
 176         MOVEM D,1(CKS)  ;SAVE HEADER\r
 177         JUMPGE D,.+2    ;ON DATA GROUPS,\r
 178         MOVE CKS,A      ;GET THE HEADER\r
 179                         ;F.A.+W.C. IS ADR OF NEXT HEADER\r
 180                         ;I.E., FIRST 0 AFTER NON-ZERO BLOCK\r
 181         JUMPL A,DMP1    ;LOOP IF MORE CORE\r
 182         LSH CKS,2       ;SHIFT CORE SIZ FOR DIR\r
 183         SKIPLE WRITE    ;IF DUMPING, SET JOBREL\r
 184         HRRM CKS,TAB+150(FILN)  ;PUT IN DIR\r
 185 DMP2:   MOVEI D,SPNT-1  ;SET UP TO FOLLOW THE HEADERS.\r
 186         MOVEI CT,1(CT)  ;CLR LH, COUNT JBLK\r
 187 DMP3:   MOVE D,1(D)     ;GET HEADER\r
 188         JUMPGE D,THRU   ;IF NULL HEADER FOUND\r
 189         MOVEI Q,DMP3    ;Q:= DMP3 AS A RETURN AFTER AOBJN\r
 190 \r
 191 LODUMP: JSP P,UWAIT\r
 192         JFCL D          ;IN/OUTPUT HEADER\r
 193         JUMPGE D,JBLK   ;IF JRST BLOCK READ. CANT HAPPEN ON WRITE\r
 194 DMP5:   JSP P,UWAIT\r
 195         JFCL 1(D)       ;IN/OUTPUT DATA WORD\r
 196         AOBJN D,DMP5    ;COUNT DOWN THE HEADER\r
 197         JRST (Q)        ;END OF HEADER. TO DMP3 OR LOAD+1\r
 198 ;WRITE:  1=D  0=K  -1=ELSE\r
 199 \r
 200 THRU:   JSP P,UWAIT     ;WRITE OUT JRST BLOCK\r
 201         JFCL SADR       ;FROM LOC SADR\r
 202         TRZA WRITE,-1   ;THEN SET WRITE TO 0, AND GO CLOBBER\r
 203                         ;ANY FURTHER BLOCKS WITH THIS FILN\r
 204 UWAIT:  AOJL E,UWAIT1   ;RETURN ADDR = (P)      DATA ADDR = @(P)\r
 205                         ;E IS -WD COUNT IN BLOCK OR POSITIVE\r
 206                         ;BYTE POINTER FIRST TIME THRU\r
 207         HLRZ BLKNO,LINK         ;SET TO FOLLOW LINK\r
 208 MNLUP0: JUMPGE WRITE,MNLUP      ;WRITING OR DELETING\r
 209         JUMPN BLKNO,RBLK\r
 210 MNLUP:  AOSA BLKNO      ;NEXT BLOCK IN THE DIRECTORY\r
 211 MNLUP1: DPB B,PNTR      ;FOR DELETE, 0 FILE NAME AND NUMBER\r
 212         ILDB A,PNTR     ;SEARCH FILE DIR\r
 213         CAIN A,37\r
 214         JRST DELE       ;END OF TAB MARKER, DELE GOES TO\r
 215                         ;CLSTP ON A "D" TO DUMP DIRECTORY\r
 216         TLO A,-1(WRITE) ;0 ON D, -1 ON K OR K PHASE OF D\r
 217         CAIE FILN,(A)   ;IS THIS BLOCK ASSIGNED TO CURRENT FILE?\r
 218         JUMPN A,MNLUP   ;OR MAYBE FREE? JUMP IF IN USE BY\r
 219                         ;ANOTHER FILE.\r
 220         DPB FILN,PNTR   ;SMASH AWAY WRITE BLOCK ON D OR K. BUT\r
 221                         ;SEE MNLUP1 ON K.\r
 222         JUMPE WRITE,MNLUP1      ;K COMMAND\r
 223         SKIPN C,LINK            ;HAS LINK BEEN SET UP?\r
 224         DPB BLKNO,[XWD 101200,LINK]     ;NO. PUT BLOCK IN AS FIRST BLK NO\r
 225         HRLM BLKNO,LINK ;PUT BLOCK IN AS LINK\r
 226         JUMPE C,MNLUP0          ;JUMP IF THIS IS THE FIRST PASS THRU DIRECTORY\r
 227         HLRZ BLKNO,C            ;GET LINKED BLOCK CHOSEN BEFORE\r
 228         MOVEI C,177             ;PUT IN A WORD COUNT FOR PIP\r
 229         IORM C,LINK             ;AND PUT ALL THAT INTO LINK WORD\r
 230         SUBI CT,177             ;DECREMENT WORDS LEFT TO GO\r
 231 \r
 232 \f\r
 233 ;RBLK SEARCHES FOR THE BLOCK IN BLKNO, ENTERS IT GOING FORWARD,\r
 234 ;AND THEN READS INTO CORE, DUMPS CORE, OR COMPARES CORE AS\r
 235 ;DETERMINED BY CONTENTS OF WRITE.\r
 236 \r
 237 RBLK:   HRRO C,TAPENO   ;CURRENT TAPE NO.\r
 238                         ;SET LH TO  PREPARE FOR JUMPN IN DELE\r
 239 \f\r
 240         SETOB A,B       ;GO FORWARD, SET DC FOR SEARCH\r
 241         CONSZ UTS,40    ;IS CHECKSUM BEING WRITTEN?\r
 242         JRST .-1        ;WAIT\r
 243 RB1:    TRNN B,400001   ;DECIDE WHETHER TO TURN AROUND\r
 244         TRCA C,10000    ;CHANGE DIRECTION AND DELAY\r
 245         CONSO UTC,200000        ;UNIT SELECTED?\r
 246         TRO C,2000      ;INVOKE STARTUP DELAY\r
 247 RBG:    CONO UTC,220200(C)      ;COMMAND TO THE  551.\r
 248                                 ;200=SEARCH, 300=READ, 700=WRITE.\r
 249         CONO DC,4011(A) ;COMMAND TO THE 136.\r
 250 UWAIT1: CONSZ UTS,6     ;ANY ERRORS?\r
 251         JRST ERR        ;YES. GO DING AND THEN TYI\r
 252         CONSO DC,1000   ;DATA READY?\r
 253         JRST .-3        ;NO. WAIT SOME MORE\r
 254         JUMPL E,INOUT(WRITE)    ;IF IN MIDST OF A DT BLOCK, DISPATCH\r
 255         DATAI DC,B      ;NO. SEARCHING. GET BLOCK NUMBER\r
 256         TRZ C,2000      ;DONT DELAY ANY MORE\r
 257         SUBI B,(BLKNO)  ;COMPARE WITH DESIRED BLOCK\r
 258         TRNE C,10000    ;COMPLEMENT IF GOING REVERSE\r
 259         TRC B,-2        ;BIT 35 IS FOR TURNAROUND SPACE.\r
 260         JUMPN B,RB1     ;JUMP IF NOT GOING FORWARD INTO (BLKNO)\r
 261         MOVNI E,200     ;WORDS PER BLOCK\r
 262         MOVEM P,F       ;SAVE RETURN IN AC0\r
 263         TRO C,100       ;READ COMMAND, MAYBE\r
 264         JUMPLE WRITE,RB2        ;JUMP IF READ\r
 265         TRO C,400       ;CHANGE TO WRITE COMMAND\r
 266         MOVNI A,401     ;SET 136 TO OUTPUT\r
 267         JUMPG CT,.+3\r
 268         HRRZS LINK      ;IF LAST BLK, KILL LINK\r
 269         DPB E,PNTR              ;AND THE DIR BYTE ? 0\r
 270 RB2:    CAIE BLKNO,^D100        ;IF NOT DIRECTORY BLOCK\r
 271         MOVEI P,.+2     ;SETUP NEW RETURN\r
 272         JRST RBG\r
 273         AOJ E,LINK      ;IN/OUTPUT LINK\r
 274         JRA P,UWAIT1    ;RESTORE CALLER ADR\r
 275                         ;AND PROCESS DATA WORDS\r
 276 \f\r
 277 \r
 278         DATAI DC,@(P)   ;READ COMMANDS. GET WORD TO CORE\r
 279 INOUT:  JRST UWAIT2     ;INOUT-1 THRU INOUT+1 ARE DISPATCHED TO.\r
 280         DATAO DC,@(P)   ;OUTPUT TO TAPE\r
 281 UWAIT2: JRST 0(P)       ;RETURN TO CALLER OF UWAIT OR RBLK.\r
 282 \f\r
 283 ALTMD:  MOVEI A,"$"\r
 284         JSP P,TYO       ;ALTMODE IS PRINTED AS "$"\r
 285 \r
 286         CAIE CH,"K"-40  ;FOR K, WRITE := 0\r
 287         CAIN CH,"D"-40  ;FOR D, WRITE :=1\r
 288         AOJLE WRITE,.-1 ;COUNT (WRITE)\r
 289 \r
 290         CAIN CH,"G"-40  ;GO TO PROGRAM?\r
 291         JRST @SADR      ;YES. JUMP OUT\r
 292         CAIN CH,"F"-40  ;FILE DIR PRINT?\r
 293         JRST FDIR       ;YES. PRINT FILE DIR OF THIS TAPE\r
 294         CAIN CH,"Z"-40  ;ZERO DIRECTORY?\r
 295         JRST ZDIR       ;DISPATCH\r
 296         CAILE CH,27     ;SKIP IF OCTAL NUMBER\r
 297         JRST TYI        ;NO. GO PROCESS FILE NAME\r
 298         LSH B,3 ;CONVERT SIXBIT TO OCTAL\r
 299         LSHC F,3        ;F+1=B\r
 300         JUMPN B,.-2     ;MAY BE MORE THAN 1 DIGIT (START ADR)\r
 301         CAILE F,7       ;SKIP IF ONE DIGIT\r
 302         JRA D,JBLK      ;D:=SADR. DISPATCH TO JBLK WHICH SAVES SADR.\r
 303 OPNTP:                  ;SHIFT UNIT NUMBER LEFT FOR CONO\r
 304         LSH F,3\r
 305         HRRM F,TAPENO   ;SAVE IN CORE\r
 306 CLSTP:  MOVEI BLKNO,^D100       ;BLK NO OF FILE DIR\r
 307         SETZI PNTR,0    ;DONT CLOBBER DIRECTORY BYTE\r
 308         JSP P,RBLK      ;MOVE TO BLOCK 100\r
 309         JFCL TAB+200(E) ;READ OR WRITE DIR TAB AS DETERMINED BY WRITE\r
 310         AOJL E,UWAIT1   ;COUNT THE 200 WORDS\r
 311         JRST BEG        ;GO ASK FOR NEXT COMMAND\r
 312 \r
 313 ZDIR:   MOVE A,[XWD FOOF,TAB]   ;FOOF IS CLEAR\r
 314         BLT A,TAB+176   ;CLEAR DIRECTORY, EXCEPT LAST WORD FOR ID\r
 315         MOVSI A,(36B4+36B9)     ;RESERVE BLOCKS 1 & 2\r
 316         MOVEM A,TAB     ;IN DIRECTORY\r
 317         MOVSI A,(36B9)\r
 318         MOVEM A,TAB+16  ;BLK 100 (DIR) IS RESERVED TOO\r
 319         HRLOI A,7       ;AND BLOCKS >1100 ARE EOT\r
 320         MOVEM A,TAB+122 ;END OF BYTE TAB\r
 321         AOJA WRITE,CLS1 ;SET WRITE TO OUTPUT\r
 322                                 ;AND DUMP BLK 100.\r
 323 \fFDIR:  MOVNI FILN,26   ;26 FILES (OCTAL)\r
 324 FD2:    JSP P,CRR       ;CR-LF\r
 325 FD3:    SKIPN C,TAB+123+26(FILN)        ;FIRST WORD OF NAME. IS IT BLANK?\r
 326         AOJA C,FD1      ;YES. SET C=1 AND LOOP\r
 327         JSP G,SIXBP     ;PRINT FIRST WORD AND A SPACE\r
 328         HLLZ C,TAB+151+26(FILN) ;SECOND WORD OF FILE NAME\r
 329         JSP G,SIXBP     ;PRINT AND CLEAR C\r
 330 FD1:    AOJL FILN,FD2(C)        ;CAN JUMP TO FD2 OR FD3. COUNT FILES.\r
 331         JRST BEG        ;ALL FILES PRINTED OR BLANK. RETURN.\r
 332 \r
 333 SIXBP:  MOVEI B,7       ;SIXBP PRINTS C(C) IN 6BIT\r
 334                         ;AND ADDS A TRAILING SPACE\r
 335                         ;AND LEAVES (C)=0\r
 336 \r
 337 TAPENO:                 ;USE ADR AS TEMP FOR CURRENT UNIT\r
 338 SIXBP1: SETZI A,.-.     ;CLEAR A\r
 339         LSHC A,6\r
 340         ADDI A,40       ;SIXBIT TO ASCII\r
 341         JSP P,TYO       ;TYPE OUT CHARACTER\r
 342         SOJG B,SIXBP1   ;LOOP IF MORE CHARACTERS\r
 343         JRST 0(G)       ;RETURN\r
 344 \r
 345 SPNT:   0               ;POINTER TO HEADERS IN CORE.\r
 346 \r
 347         LIT\r
 348 \r
 349 \r
 350         SLOP=COMPTR-17-.        ;THIS MANY WORDS BEFORE RESERVED AREA\r
 351                                 ;FOR COMMAND STRINGS.\r
 352 ;!!!!!  NOTE: ABOVE PARAMETER MUST COME OUT POSITIVE IN\r
 353 ;       ORDER TO MEET THE DOCUMENTATION OF RESERVED COMMAND STRING AREA.\r
 354 ;\r
 355 ;       THIS MEANS ANY CODE ADDED MUST BE COMPENSATED FOR BY\r
 356 ;       A CORRESPONDING TIGHTENING SOMEWHERE. GOOD LUCK.\r
 357 ;       TENDMP IS VERY TIGHT ALREADY.\r
 358 \r
 359         END BEGR\r
 360 \f\r
 361 \r