--- /dev/null
+TITLE TENDMP - DTAPE/MTAPE UTILITY - R CLEMENTS/GBH/RH/RD/RCC/JEF 6 APR 71 - V032\r
+ IFNDEF REL,<REL=0> ;0 PAPER TAPE, 1 RELOCATABLE BINARY\r
+ IFNDEF MAGT,<MAGT=0> ;0 DTAPE, 1 MTAPE\r
+ IFN MAGT,<\r
+; MAGTAPE UTILITY ROUTINE - COURTSEY DATALINE SYSTEMS J HANCOCK\r
+ >\r
+ IFNDEF MODE,<MODE=0> ;0 IS TD10, 1 IS 551/136\r
+ IFNDEF CORE,<CORE=4> ;NUMBER OF 8K MEMORY BLOCKS\r
+\r
+ IFE MODE,<SUBTTL TD10 VERSION>\r
+ IFN MODE,<SUBTTL 551/136 VERSION>\r
+\r
+IFE REL,<\r
+IFE MAGT,<RIM10B>\r
+IFN MAGT,<RIM10>>\r
+ UTC=210\r
+ UTS=214\r
+ DC=200\r
+ DTC=320\r
+ DTS=324\r
+\r
+F=0 ;MUST BE 0. USED BY JRA'S\r
+A=2 ;MISC TEMP. HOLDS 136 CONO INDEX IN UWAIT\r
+B=1 ;TEMP. HOLDS BLOCK # COMPUTATION IN SEARCH\r
+C=3 ;HOLDS BITS FOR DECTAPE CONO DURING I/O\r
+D=4 ;HOLDS POINTERS FOR AOBJN'S THROUGH CORE\r
+E=5 ;HOLDS COUNT OF WORDS IN CURRENT DT BLOCK\r
+P=6 ;PC FOR JSP'S\r
+CKS=7 ;HAD BEEN CHECKSUM IN MACDMP\r
+FILN=10 ;NUMBER OF FILE IN DIRECTORY, 1 TO 26 OCTAL\r
+BLKNO=11 ;BLOCK NUMBER SEARCHED FOR ON TAPE\r
+WRITE=12 ;MULTI-STATE FLAG FOR DEFINING I/O OPERATION\r
+ ;1=D 0=K -1=ELSE\r
+PNTR=13 ;POINTER TO BYTE TABLE IN DIRECTORY\r
+CH=14 ;HOLDS 6BIT CHARACTER OF COMMAND, OR -1\r
+Q=15 ;ANOTHER JSP AC\r
+G=16 ;RARELY USED VERY TEMP\r
+CT=17 ;COUNT OF WORDS TO DUMP\r
+\r
+COMPTR=BEGR+377 ;COMMAND POINTER, IF SUPPLIED\r
+ LOZAD=BEGR-203 ;WHEN CORE IS CLEARED, IT\r
+ ;IS FROM 40 THRU LOZAD\r
+ LOW=20 ;FIRST LOCATION CONSIDERED FOR DUMPING\r
+ HIGH=BEGR-203 ;LAST LOCATION CONSIDERED FOR DUMPING\r
+ ;ZEROED AT BEG THESE DAYS\r
+ FOOF=BEGR-202 ;NEEDED FOR ZERO CORE SEARCH, ZEROED AT BEG1\r
+TAB=BEGR-201 ;FILE DIRECTORY\r
+LINK=BEGR-1 ;0-17=LINK, 18-27=FBN, 29-35=WC\r
+IFE REL,<IFE MAGT,<LOC 17400+<<CORE-1>*20000>>\r
+ IFN MAGT,<LOC 17377+<<CORE-1>*20000>\r
+ IOWD LAST-BEGR+1,BEGR>>\r
+\f;INITIAL ENTRY IS AT BEGR, UNLESS A COMMAND POINTER IS\r
+;SUPPLIED IN COMPTR. IN THAT CASE, ENTRY IS AT BEGR+1\r
+\r
+BEGR: SETZM COMPTR ;CLEAR ANY JUNK IN COMMAND POINTER\r
+ CONO 635550 ;I/O RESET, ETC.\r
+BEG: JSP P,CRR ;TYPE A CR-LF\r
+ MOVEI D,SPNT-2 ;PREPARE TO REMOVE AOBJN POINTERS\r
+BEG1: SETZB A,FOOF ;CLEAR A TO PUT IN CORE, CLEAR\r
+ ;FOOF FOR THE NEXT ZERO CORE SEARCH\r
+ EXCH A,2(D) ;REMOVE HEADER LIST\r
+ AOBJN A,. ;COUNT THROUGH TO NEXT HEADER\r
+ MOVEI D,-1(A) ;ACCOUNT FOR OVERSHOOT IN AOBJN\r
+ JUMPN D,BEG1 ;IF WE DIDNT AOBJN A 0, GO FOR NEXT HDR\r
+ MOVE PNTR,[XWD 500,TAB-1] ;5 BIT BYTES IN DIRECTORY\r
+ SETZB CH,F\r
+CRCH: SETOI WRITE,215 ;USED FOR CARRET TYPEOUT\r
+TYI: SETZB C,HIGH ;HOPEFULLY HIGH IS TEMPORARY\r
+ SETZB B,E ;NAME INITIALIZING\r
+ TLOA B,400000 ;NULL NAME IS "@. "\r
+SPACE: MOVEI E,C-1 ;EXTENSION INTO C\r
+ HRLI E,20600 ;FAKE OUT END TEST OF BYTE PTR\r
+;STOP TAPE DRIVE\r
+IFN MODE,<CONO UTC,0>\r
+IFE MODE,<CONO DTC,400000>\r
+NEXT: ILDB A,@BEGR ;GIVES A 0 UNLESS COMMAND POINTER SUPPLIED\r
+ ;RH OF NEXT IS USED AS A CONSTANT\r
+BELL: SETOI FILN,207 ;INITIALIZATION FOR SEARCH\r
+ SETZB BLKNO,CT ; "\r
+ SETZM LINK\r
+ JUMPN A,RCH ;JUMP IF COMMAND READ FROM CORE\r
+ CONSO TTY,40 ;TYPEIN FLAG?\r
+ JRST .-1 ;NO,WAIT\r
+ DATAI TTY,A ;GET TYPED IN CHARACTER\r
+ JSP P,TYO ;ECHO IT (WITH PARITY)\r
+RCH: ANDI A,177 ;STRIP OFF PARITY\r
+ CAIN A,177 ;RUBOUT?\r
+ JRST BEGR ;YES. RESTART TENDMP\r
+ CAIE A,33 ;NEW ALTMODE?\r
+ CAIL A,175 ;OR 175 OR 176 ALTMODES?\r
+ JRST ALTTST ;YES, SOME ALTMODE.\r
+ CAIL A,140 ;LOWER CASE CHARACTER?\r
+ TRZ A,40 ;YES. CHANGE TO UPPER CASE\r
+ SUBI A,40 ;CONVERT TO SIXBIT\r
+ JUMPL A,CARRET ;ANY CONTROL CHARACTER\r
+ JUMPE A,SPACE ;CHAR WAS 40\r
+NEXT1: TLNE E,770000 ;NO MORE THAN SIX CHARS\r
+ IDPB A,E ;GOES INTO AC1 = B\r
+ JRST NEXT ;GET ANOTHER CHARACTER\r
+\r
+\f\r
+;HERE ON JUMP BLOCK DURING LOADS, OR NUMBER>7 ALT\r
+JBLK:\r
+;STOP TAPE DRIVE\r
+IFN MODE,<CONO UTC,0>\r
+IFE MODE,<CONO DTC,400000>\r
+ HRRM D,SADR ;SAVE STARTING ADDRESS\r
+ JUMPN CH,BEG ;IF NOT LOADGO COMMAND\r
+SADR: JRST BEG ;CURRENT S.A.\r
+LOADS: ;HERE TO LOAD TAPE TO CORE\r
+ MOVEI D,LOZAD+1 ;FIRST LOC NOT TO ZERO\r
+ SETZM 40 ;A "FEATURE"\r
+ MOVE C,[XWD 40,41] ;PREPARE TO CLEAR CORE.\r
+ TRNN CH,3 ;SKIP ON M,N NOT ON L,T,@\r
+ BLT C,-1(D) ;ZERO CORE\r
+LOAD: JSP Q,LODUMP ;START READING FILE. LODUMP PROCESSES\r
+ ;ONE HEADER AND ITS DATA\r
+ JRST LOAD ;IF OK, GET NEXT BLOCK.(IF NONE, \r
+ ;LODUMP RETURNS TO JBLK.)\r
+DELE: SKIPN E,WRITE ;SKIP IF NOT IN THE K PHASE OF A D COMMAND.\r
+ ;OR A K COMMAND\r
+ ;ALSO, SET E =0, SO SEARCH HAPPENS IN RBLK\r
+CLS1: AOJA WRITE,CLSTP ; 0 TO 1. GO DUMP OUT DIRECTORY.\r
+ERR: SKIPA P,NEXT ;SET TO RETURN TO BEGR\r
+CRR: SKIPA A,CRCH ;LIKE HRROI A,215 AND SKIPA\r
+ SKIPA A,BELL ;GET A BELL CHARACTER\r
+TYO: SKIPN COMPTR ;DONT TYO IF NO TYI, UNLESS ERR\r
+ DATAO TTY,A ;TYPE OUT\r
+ CONSZ TTY,20 ;WAIT FOR TTY TO FINISH\r
+ JRST .-1 ;NOT YET\r
+ CAIE A,215 ;IF CR TYPED IN,\r
+ JUMPGE A,(P) ;OR SIGN BIT OF CHAR ON,(SEE CRR)\r
+ MOVEI A,12 ;APPEND A LINEFEED\r
+ JRST TYO ;GO TYPE LF\r
+\r
+\fALTTST: TLNN B,4040 ;IF ALPHA CHARACTERS, DONT GET CH\r
+ LDB CH,E ;LAST CH BEFORE ALT, -40\r
+ JUMPN CH,ALTMD ;IF CH NOT NULL, GOT PROCESS ALTMODE\r
+CARRET: MOVSI FILN,-26 ;FILE NAME SPECIFIED. FIRST THING TO\r
+ ;DO IS LOOK IT UP IN DIRECTORY\r
+LUP: SKIPN TAB+123(FILN) ;SEARCH FOR FREE FILE\r
+ SKIPE BLKNO,TAB+151(FILN) ;CHECK BOTH WORDS\r
+ TDZA BLKNO,BLKNO ;ENSURE CLEAR BLOCK NUMBER\r
+ HRRM FILN,FREE ;SAVE NUMBER OF A FREE FILE\r
+ HLLZ G,TAB+151(FILN) ;ONLY CHECK LEFT OF 2ND WD\r
+ CAMN B,TAB+123(FILN) ;SEARCH FOR TYPED-IN FILE\r
+ CAME C,G ;BOTH WORDS\r
+ AOBJN FILN,LUP ;NOT THIS ONE. KEEP LOOKING\r
+ JUMPL FILN,BEG69 ;IF FILE FOUND, JUMP\r
+ JUMPLE WRITE,ERR ;IF NOT FOUND, BETTER BE DUMP\r
+FREE: MOVEI FILN,. ;DUMP & NOT FOUND, MAKE ENTRY WHERE FREE\r
+ ;(ADDRESS MODIFIED ABOVE)\r
+ SKIPE TAB+123(FILN) ;MAKE SURE HOLE AVAILABLE\r
+ JRST ERR ;NO FREE SLOTS\r
+\r
+BEG69: MOVEI FILN,1(FILN) ;FILN IS FILE #+1; CLR LH\r
+ JUMPL WRITE,LOADS ;ALL LOAD INSTRUCTIONS\r
+IFE MAGT,<\r
+ SKIPN WRITE ;DELETE? (K COMMAND)\r
+ SETZB B,C ;YES, KILL FILE\r
+ MOVEM B,TAB+122(FILN) ;CLEAR IF DELE, ENTER IF NEW DUMP\r
+ HLLZM C,TAB+150(FILN) ;BOTH WORDS\r
+ ;FALL INTO DUMP ROUTINE\r
+ ;WHICH IS A NO-OP FOR K\r
+\r
+\f\r
+;DUMP WRITES OUT CORE ONTO TAPE\r
+\r
+;DUMP THRU DUMP2-1 SETS UP POINTERS TO NON-ZERO CORE AREAS. THESE\r
+;AOBJN POINTERS ARE CALLED "HEADERS", AND PRECEDE THE DATA WHEN\r
+;THE TAPE IS WRITTEN.\r
+;THE FIRST HEADER IS KEPT IN SPNT. SUCCESIVE HEADERS GO INTO THE FIRST\r
+;ZERO WORD FOLLOWING THE BLOCK CORRESPONDING TO THE PREVIOUS HEADER.\r
+;AFTER THE LAST NON-ZERO BLOCK IS (BY DEFINITION) A ZERO, WHICH\r
+;TERMINATES THE HEADER LIST. THIS WORD MAY BE LOCATION FOOF (37176) IF\r
+;CORE WAS FILLED UP TO THE BASE OF TENDMP.\r
+\r
+DUMP: ;HERE ON D,K. (BLKN)=0, FILN SET UP\r
+ MOVN A,[XWD HIGH-LOW-1,-LOW+1] ;COUNTER TO EXAMINE \r
+ ;CORE FOR BLOCKS OF 0\r
+ MOVEI CKS,SPNT-1 ;FIRST HEADER GOES INTO SPNT\r
+DMP1: SKIPN 1(A) ;FIND SOME NON-ZERO CORE\r
+ AOBJN A,.-1 ;ZERO. KEEP LOOKING.\r
+ MOVEM A,D ;SAVE ADR\r
+ SKIPN 1(A) ;FIND SOME ZERO CORE\r
+ SKIPE 2(A) ;DON'T MAKE NEW BLOCK FOR 1 ZERO\r
+ AOBJN A,.-2 ;NON-ZERO. KEEP LOOKING\r
+ SUB D,A ;GET -COUNT IN BOTH HALVES OF D\r
+ SUBI CT,-1(D) ;COUNT N WORDS DATA, 1 HDR\r
+ ADDI D,(A) ;GET F.A.-1 IN RH OF D\r
+ MOVEM D,1(CKS) ;SAVE HEADER\r
+ JUMPGE D,.+2 ;ON DATA GROUPS,\r
+ MOVE CKS,A ;GET THE HEADER\r
+ ;F.A.+W.C. IS ADR OF NEXT HEADER\r
+ ;I.E., FIRST 0 AFTER NON-ZERO BLOCK\r
+ JUMPL A,DMP1 ;LOOP IF MORE CORE\r
+ LSH CKS,2 ;SHIFT CORE SIZ FOR DIR\r
+ SKIPLE WRITE ;IF DUMPING, SET JOBREL\r
+ HRRM CKS,TAB+150(FILN) ;PUT IN DIR\r
+DMP2: MOVEI D,SPNT-1 ;SET UP TO FOLLOW THE HEADERS.\r
+ MOVEI CT,1(CT) ;CLR LH, COUNT JBLK\r
+DMP3: MOVE D,1(D) ;GET HEADER\r
+ JUMPGE D,THRU ;IF NULL HEADER FOUND\r
+ MOVEI Q,DMP3 ;Q:= DMP3 AS A RETURN AFTER AOBJN\r
+ >\r
+\r
+IFN MAGT,<\r
+ JRST ERR ;HOW DID WE GET HERE? DLS***\r
+;DUMP WRITES OUT CORE ONTO MAGNETIC TAPE\r
+;DUMP WRITES OUT A CORE IMAGE ON MAGNETIC TAPE WITHOUT\r
+;ZERO COMPRESSION. THE RECORDS ARE 200(OCTAL) WORDS IN LENGTH\r
+;AND BEGIN WITH WORD ZERO. BEFORE STARTING THE TAPE IS REWOUND.\r
+;IT ASSUMES MTA0, AT LEAST FOR NOW.\r
+ \r
+ MTC= 340\r
+ MTS= 344\r
+DUMP: CONO MTC,1000 ;REWIND\r
+ CONSO MTS,300000 ;WAIT FOR BOT OR REWINDING\r
+ JRST .-1\r
+ CONSO MTS,40 ;TRANSPORT READY?\r
+ JRST .-1\r
+ SETZ A,\r
+DUMP1: HRLI A,-200 ;WORDS PER BLOCK\r
+ CONO MTC,64100 ;START WRITE OPERATION\r
+DUMP2: CONSO MTS,1 ;TD10 READY FOR DATA?\r
+ JRST .-1\r
+ DATAO MTC,(A) ;SEND OUT DATA\r
+ AOBJN A,DUMP2 ;POINT TO NEXT WORD AND LOOP\r
+ CONO MTS,1 ;STOP THE DRIVE\r
+ CONSO MTS,100 ;WAIT TILL STOPPED\r
+ JRST .-1\r
+ CONSZ MTS,464610 ;ANY ERRORS?\r
+ JRST ERR ;YES, GO RING BELL\r
+ AOSE [-CORE*20000/200+2] ;ALL CORE DUMPED?\r
+ JRST DUMP1 ;NO\r
+ CONO MTC,65100 ;WRITE END OF FILE\r
+ CONSO MTS,100 ;DONE?\r
+ JRST .-1\r
+ CONO MTC,65100\r
+ CONSO MTS,100\r
+ JRST .-1\r
+ JRST BEGR ;ALL DONE\r
+ >\r
+\r
+\r
+LODUMP: JSP P,UWAIT\r
+ JFCL D ;IN/OUTPUT HEADER\r
+ JUMPGE D,JBLK ;IF JRST BLOCK READ. CANT HAPPEN ON WRITE\r
+DMP5: JSP P,UWAIT\r
+ JFCL 1(D) ;IN/OUTPUT DATA WORD\r
+ AOBJN D,DMP5 ;COUNT DOWN THE HEADER\r
+ JRST (Q) ;END OF HEADER. TO DMP3 OR LOAD+1\r
+;WRITE: 1=D 0=K -1=ELSE\r
+\r
+THRU: JSP P,UWAIT ;WRITE OUT JRST BLOCK\r
+ JFCL SADR ;FROM LOC SADR\r
+IFE MODE,< AOJL E,UWAIT1 ;FILL OUT BLOCK, TO GET CKSM OUT>\r
+ TRZA WRITE,-1 ;THEN SET WRITE TO 0, AND GO CLOBBER\r
+ ;ANY FURTHER BLOCKS WITH THIS FILN\r
+UWAIT: AOJL E,UWAIT1 ;RETURN ADDR = (P) DATA ADDR = @(P)\r
+ ;E IS -WD COUNT IN BLOCK OR POSITIVE\r
+ ;BYTE POINTER FIRST TIME THRU\r
+ HLRZ BLKNO,LINK ;SET TO FOLLOW LINK\r
+MNLUP0: JUMPGE WRITE,MNLUP ;WRITING OR DELETING\r
+ JUMPN BLKNO,RBLK\r
+MNLUP: AOSA BLKNO ;NEXT BLOCK IN THE DIRECTORY\r
+MNLUP1: DPB B,PNTR ;FOR DELETE, 0 FILE NAME AND NUMBER\r
+ ILDB A,PNTR ;SEARCH FILE DIR\r
+ CAIN A,37\r
+ JRST DELE ;END OF TAB MARKER, DELE GOES TO\r
+ ;CLSTP ON A "D" TO DUMP DIRECTORY\r
+ TLO A,-1(WRITE) ;0 ON D, -1 ON K OR K PHASE OF D\r
+ CAIE FILN,(A) ;IS THIS BLOCK ASSIGNED TO CURRENT FILE?\r
+ JUMPN A,MNLUP ;OR MAYBE FREE? JUMP IF IN USE BY\r
+ ;ANOTHER FILE.\r
+ DPB FILN,PNTR ;SMASH AWAY WRITE BLOCK ON D OR K. BUT\r
+ ;SEE MNLUP1 ON K.\r
+ JUMPE WRITE,MNLUP1 ;K COMMAND\r
+ SKIPN C,LINK ;HAS LINK BEEN SET UP?\r
+ DPB BLKNO,[XWD 101200,LINK] ;NO. PUT BLOCK IN AS FIRST BLK NO\r
+ HRLM BLKNO,LINK ;PUT BLOCK IN AS LINK\r
+ JUMPE C,MNLUP0 ;JUMP IF THIS IS THE FIRST PASS THRU DIRECTORY\r
+ HLRZ BLKNO,C ;GET LINKED BLOCK CHOSEN BEFORE\r
+ MOVEI C,177 ;PUT IN A WORD COUNT FOR PIP\r
+ IORM C,LINK ;AND PUT ALL THAT INTO LINK WORD\r
+ SUBI CT,177 ;DECREMENT WORDS LEFT TO GO\r
+\r
+\f\r
+;RBLK SEARCHES FOR THE BLOCK IN BLKNO, ENTERS IT GOING FORWARD,\r
+;AND THEN READS INTO CORE, DUMPS CORE, OR COMPARES CORE AS\r
+;DETERMINED BY CONTENTS OF WRITE.\r
+\r
+RBLK: HRRO C,TAPENO ;CURRENT TAPE NO.\r
+ ;SET LH TO PREPARE FOR JUMPN IN DELE\r
+IFE MODE,<\r
+ TRO B,-1 ;ENSURE GOING FORWARD WHEN FIRST SEARCH\r
+ CONSO DTC,300000 ;IS A DIRECTION ASSERTED?\r
+ TRO C,210000 ;NO. GO FORWARD\r
+RB1: TRNN B,400001 ;DECIDE WHETHER TO TURN AROUND\r
+ TRO C,300000 ;TURN AROUND\r
+RBG: CONO DTC,20200(C) ;ISSUE THE COMMAND TO TD10.\r
+ ;200=SEARCH, 300=READ, 700=WRITE.\r
+UWAIT1: CONSZ DTS,672700 ;ANY ERRORS?\r
+ JRST ERR ;YES. GO DING AND THEN TYI\r
+ CONSO DTS,1 ;DATA READY?\r
+ JRST .-3 ;NO. GO WAIT SOME MORE\r
+ JUMPL E,INOUT(WRITE) ;IF IN MIDST OF A DT BLOCK, DISPATCH\r
+ DATAI DTC,B ;NO. SEARCHING. GET BLOCK NO.\r
+ TRZ C,310000 ;CLOBBER DIRECTION BITS IN CONO\r
+ SUBI B,(BLKNO) ;COMPARE WITH DESIRED BLOCK\r
+ CONSZ DTC,100000 ;COMPLEMENT DECISION IF GOING REVERSE\r
+ TRC B,-2 ;BIT 35 IS FOR TURNAROUND SPACE.\r
+>\r
+\f\r
+IFN MODE,<\r
+ SETOB A,B ;GO FORWARD, SET DC FOR SEARCH\r
+ CONSZ UTS,40 ;IS CHECKSUM BEING WRITTEN?\r
+ JRST .-1 ;WAIT\r
+RB1: TRNN B,400001 ;DECIDE WHETHER TO TURN AROUND\r
+ TRCA C,10000 ;CHANGE DIRECTION AND DELAY\r
+ CONSO UTC,200000 ;UNIT SELECTED?\r
+ TRO C,2000 ;INVOKE STARTUP DELAY\r
+RBG: CONO UTC,220200(C) ;COMMAND TO THE 551.\r
+ ;200=SEARCH, 300=READ, 700=WRITE.\r
+ CONO DC,4011(A) ;COMMAND TO THE 136.\r
+UWAIT1: CONSZ UTS,6 ;ANY ERRORS?\r
+ JRST ERR ;YES. GO DING AND THEN TYI\r
+ CONSO DC,1000 ;DATA READY?\r
+ JRST .-3 ;NO. WAIT SOME MORE\r
+ JUMPL E,INOUT(WRITE) ;IF IN MIDST OF A DT BLOCK, DISPATCH\r
+ DATAI DC,B ;NO. SEARCHING. GET BLOCK NUMBER\r
+ TRZ C,2000 ;DONT DELAY ANY MORE\r
+ SUBI B,(BLKNO) ;COMPARE WITH DESIRED BLOCK\r
+ TRNE C,10000 ;COMPLEMENT IF GOING REVERSE\r
+ TRC B,-2 ;BIT 35 IS FOR TURNAROUND SPACE.\r
+>\r
+ JUMPN B,RB1 ;JUMP IF NOT GOING FORWARD INTO (BLKNO)\r
+ MOVNI E,200 ;WORDS PER BLOCK\r
+ MOVEM P,F ;SAVE RETURN IN AC0\r
+ TRO C,100 ;READ COMMAND, MAYBE\r
+ JUMPLE WRITE,RB2 ;JUMP IF READ\r
+ TRO C,400 ;CHANGE TO WRITE COMMAND\r
+IFN MODE,<MOVNI A,401 ;SET 136 TO OUTPUT>\r
+ JUMPG CT,.+3\r
+ HRRZS LINK ;IF LAST BLK, KILL LINK\r
+ DPB E,PNTR ;AND THE DIR BYTE _ 0\r
+RB2: CAIE BLKNO,^D100 ;IF NOT DIRECTORY BLOCK\r
+ MOVEI P,.+2 ;SETUP NEW RETURN\r
+ JRST RBG\r
+ AOJ E,LINK ;IN/OUTPUT LINK\r
+ JRA P,UWAIT1 ;RESTORE CALLER ADR\r
+ ;AND PROCESS DATA WORDS\r
+\f\r
+IFE MODE,<\r
+ DATAI DTC,@(P) ;READ COMMANDS. GET WORD TO CORE\r
+INOUT: JRST UWAIT2 ;INOUT-1 TO INOUT +1 ARE DISPATCHED TO.\r
+ DATAO DTC,@(P) ;OUTPUT TO TAPE\r
+UWAIT2: AOJN E,UWAIT3 ;WAS THAT THE LAST WORD IN THE DT BLOCK?\r
+ CONO DTS,1 ;YES. GIVE FUNCTION STOP TO TD10\r
+ CONSO DTS,100000 ;AND WAIT FOR CHECKSUM TO BE DONE\r
+ JRST .-1 ;NOT YET. WAIT\r
+UWAIT3: SOJA E,0(P) ;DONE. COMPENSATE FOR THE AOJN ABOVE, AND\r
+ ;RETURN TO CALLER OF UWAIT OR RBLK\r
+>\r
+\r
+IFN MODE,<\r
+ DATAI DC,@(P) ;READ COMMANDS. GET WORD TO CORE\r
+INOUT: JRST UWAIT2 ;INOUT-1 THRU INOUT+1 ARE DISPATCHED TO.\r
+ DATAO DC,@(P) ;OUTPUT TO TAPE\r
+UWAIT2: JRST 0(P) ;RETURN TO CALLER OF UWAIT OR RBLK.\r
+>\r
+\f\r
+ALTMD: MOVEI A,"$"\r
+ JSP P,TYO ;ALTMODE IS PRINTED AS "$"\r
+\r
+IFE MAGT,<\r
+ CAIE CH,"K"-40 ;FOR K, WRITE := 0\r
+ CAIN CH,"D"-40 ;FOR D, WRITE :=1\r
+ AOJLE WRITE,.-1 ;COUNT (WRITE)\r
+ >\r
+\r
+IFN MAGT,<\r
+ CAIN CH,"D"-40 ;FOR D, WRITE :=1\r
+ AOJLE WRITE,.-1 ;COUNT (WRITE)\r
+ JUMPG WRITE,DUMP ;D MEANS GO DUMP ON MAG TAPE\r
+ >\r
+\r
+ CAIN CH,"G"-40 ;GO TO PROGRAM?\r
+ JRST @SADR ;YES. JUMP OUT\r
+ CAIN CH,"F"-40 ;FILE DIR PRINT?\r
+ JRST FDIR ;YES. PRINT FILE DIR OF THIS TAPE\r
+ CAIN CH,"Z"-40 ;ZERO DIRECTORY?\r
+ JRST ZDIR ;DISPATCH\r
+ CAILE CH,27 ;SKIP IF OCTAL NUMBER\r
+ JRST TYI ;NO. GO PROCESS FILE NAME\r
+ LSH B,3 ;CONVERT SIXBIT TO OCTAL\r
+ LSHC F,3 ;F+1=B\r
+ JUMPN B,.-2 ;MAY BE MORE THAN 1 DIGIT (START ADR)\r
+ CAILE F,7 ;SKIP IF ONE DIGIT\r
+ JRA D,JBLK ;D:=SADR. DISPATCH TO JBLK WHICH SAVES SADR.\r
+OPNTP: ;SHIFT UNIT NUMBER LEFT FOR CONO\r
+IFE MODE,<LSH F,11>\r
+IFN MODE,<LSH F,3>\r
+ HRRM F,TAPENO ;SAVE IN CORE\r
+CLSTP: MOVEI BLKNO,^D100 ;BLK NO OF FILE DIR\r
+ SETZI PNTR,0 ;DONT CLOBBER DIRECTORY BYTE\r
+ JSP P,RBLK ;MOVE TO BLOCK 100\r
+ JFCL TAB+200(E) ;READ OR WRITE DIR TAB AS DETERMINED BY WRITE\r
+ AOJL E,UWAIT1 ;COUNT THE 200 WORDS\r
+ JRST BEG ;GO ASK FOR NEXT COMMAND\r
+\r
+ZDIR: MOVE A,[XWD FOOF,TAB] ;FOOF IS CLEAR\r
+ BLT A,TAB+176 ;CLEAR DIRECTORY, EXCEPT LAST WORD FOR ID\r
+ MOVSI A,(36B4+36B9) ;RESERVE BLOCKS 1 & 2\r
+ MOVEM A,TAB ;IN DIRECTORY\r
+ MOVSI A,(36B9)\r
+ MOVEM A,TAB+16 ;BLK 100 (DIR) IS RESERVED TOO\r
+ HRLOI A,7 ;AND BLOCKS >1100 ARE EOT\r
+ MOVEM A,TAB+122 ;END OF BYTE TAB\r
+ AOJA WRITE,CLS1 ;SET WRITE TO OUTPUT\r
+ ;AND DUMP BLK 100.\r
+\fFDIR: MOVNI FILN,26 ;26 FILES (OCTAL)\r
+FD2: JSP P,CRR ;CR-LF\r
+FD3: SKIPN C,TAB+123+26(FILN) ;FIRST WORD OF NAME. IS IT BLANK?\r
+ AOJA C,FD1 ;YES. SET C=1 AND LOOP\r
+ JSP G,SIXBP ;PRINT FIRST WORD AND A SPACE\r
+ HLLZ C,TAB+151+26(FILN) ;SECOND WORD OF FILE NAME\r
+ JSP G,SIXBP ;PRINT AND CLEAR C\r
+FD1: AOJL FILN,FD2(C) ;CAN JUMP TO FD2 OR FD3. COUNT FILES.\r
+ JRST BEG ;ALL FILES PRINTED OR BLANK. RETURN.\r
+\r
+SIXBP: MOVEI B,7 ;SIXBP PRINTS C(C) IN 6BIT\r
+ ;AND ADDS A TRAILING SPACE\r
+ ;AND LEAVES (C)=0\r
+\r
+TAPENO: ;USE ADR AS TEMP FOR CURRENT UNIT\r
+SIXBP1: SETZI A,.-. ;CLEAR A\r
+ LSHC A,6\r
+ ADDI A,40 ;SIXBIT TO ASCII\r
+ JSP P,TYO ;TYPE OUT CHARACTER\r
+ SOJG B,SIXBP1 ;LOOP IF MORE CHARACTERS\r
+ JRST 0(G) ;RETURN\r
+\r
+SPNT: 0 ;POINTER TO HEADERS IN CORE.\r
+\r
+ LIT\r
+\r
+\r
+IFN MAGT,<\r
+SLOP: MOVE .+3\r
+ MOVEM COMPTR\r
+ JRST BEGR+1\r
+ XWD 440700,.+1\r
+ BYTE (7) "0",33,177\r
+LAST: JRST SLOP\r
+ >\r
+IFE MAGT,<\r
+ SLOP=COMPTR-17-. ;THIS MANY WORDS BEFORE RESERVED AREA\r
+ ;FOR COMMAND STRINGS.\r
+;!!!!! NOTE: ABOVE PARAMETER MUST COME OUT POSITIVE IN\r
+; ORDER TO MEET THE DOCUMENTATION OF RESERVED COMMAND STRING AREA.\r
+;\r
+; THIS MEANS ANY CODE ADDED MUST BE COMPENSATED FOR BY\r
+; A CORRESPONDING TIGHTENING SOMEWHERE. GOOD LUCK.\r
+; TENDMP IS VERY TIGHT ALREADY.\r
+ >\r
+\r
+ END BEGR\r
+\f
\ No newline at end of file