File: TDCOPY.PA of Tape: OS8/OS8-V3/dec-s8-osysb-a-ua7
(Source file text)
/TD8E DECTAPE COPY /DEC-8E-UTDEA-A-LA /APRIL 1972 SM /COPYRIGHT 1972 DIGITAL EQUIPMENT CORPORATION / MAYNARD, MASSACHUSETTS 01754 /DEFINITIONS FOR PAL8 AND PAL10 BSW=7002 MQL=7421 MQA=7501 CAM=7621 SWP=7521 ACL=7701 CAF=6007 CDI=6203 KCF=6030 SDSS=6771 SDST=6772 SDSQ=6773 SDLC=6774 SDLD=6775 SDRC=6776 SDRD=6777 FIXTAB HALT=HLT /UNIT NUMBER DEFINITIONS FOR TD8E IOT'S UNIT01=0770 UNIT23=0760 UNIT45=0750 UNIT67=0740 LIMIT=7600 *11 X11, 0 X12, 0 /PAGE 0 CONSTANTS AND VARIABLES *20 INPUT, 0 /INPUT UNIT CONSTANT OUTPUT, 0 /OUTPUT UNIT CONSTANTS 0 0 0 0 0 0 OCOUNT, 0 /NUMBER OF OUTPUT UNITS SPECIFIED OPOINT, 0 LIST, OUTPUT-1 OUTNUM, 0 IBLOCK, 0 /STARTING INPUT BLOCK OBLOCK, 0 /STARTING OUTPUT BLOCK NUMBER, 0 /NUMBER OF BLOCKS TO TRANSFER FIELDS, 0 /-(HIGHEST FIELD AVAILABLE) COUNT, 0 /TEMPORARY COUNTERS COUNT1, 0 / " COUNT2, 0 / " COUNT3, 0 / " COUNT4, 0 / " UNIT, 0 /UNIT CONSTANT--THIS TRANSFER VERF, 0 /VERIFY SWITCH (1=YES,0=NO) WDCNT, 0 /-(NUMBER OF WORDS PER BLOCK) RW, 0 /READ/WRITE BIT--THIS TRANSFER FLD0, 0 /# OF BLOCKS IN FIELD 0 BUFFER FLDN, 0 /# OF BLOCKS IN FIELD N BUFFER BUF0, 0 /START OF FIELD 0 BUFFER BUFN, 0 /START OF FIELD N BUFFER XNUMB, 0 /# OF BLOCKS LEFT TO TRANSFER BLOCKN, 0 /STARTING BLOCK NUMBER--THIS TRANSFER NUMB1, 0 NUMB2, 0 VB, 0 END0, 0 /BEGINNING OF FIELD 0 VERIFY BUFFER ENTRY, 0 /ENTRY TO TD8E HANDLER INB, 0 OUTB, 0 OHOLD, 0 MESSG1, TEXT @TD8E COPY@ MESSG3, TEXT @ 12-BIT WORDS PER BLOCK@ *200 START, TLS JMS CRLF JMS I [MESSGE MESSG1 /@TD8E COPY@ JMS CRLF DCA COUNT JMP I [END /ONCE ONLY CODE FOR MULTIPLE FIELD TEST START1, JMS QUEST MESSG4 /@FROM UNIT:@ SWP JMS UNITNO /MAKE UNIT NUMBER CONSTANT DCA INPUT TAD LIST DCA OPOINT SKP AGAIN, JMS ERR4 /*ILLEGAL RESPONSE* DCA OCOUNT DCA COUNT JMS I [MESSGE MESSG5 /@TO UNITS:@ MORE2, JMS I [ANSWER JMP AGAIN ACL JMS UNITNO /MAKE UNIT NUMBER CONSTANT MQL /STORE IN MQ MQA /RESTORE TO AC CIA TAD INPUT SNA CLA /IS OUTPUT UNIT = INPUT UNIT ? JMP MORE2+1 /YES--ERROR ISZ OPOINT ISZ OCOUNT /COUNT ONE MORE OUTPUT UNIT TAD OCOUNT TAD [-10 SPA CLA /WERE MORE THAN 7 UNITS SPECIFIED? JMP .+3 JMS CRLF /YES--CARRIAGE RETURN JMP OALL /IGNORE EXTRA ONE SWP /NO-- DCA I OPOINT /STORE UNIT CONSTANT IN LIST TAD COUNT CIA TAD OCOUNT SPA SNA CLA /ALL UNITS IN? JMP MORE2 /YES OALL, DCA COUNT JMS I [MESSGE MESSG6 /@FIRST INPUT BLOCK:@ JMS I [ANSWER JMP WHOLE /COPY WHOLE TAPE TAD COUNT SNA CLA /WERE TOO MANY SPECIFIED? JMP .+5 JMS I [MESSGE /YES ERROR4 /@ILLEGAL RESPONSE@ JMS CRLF JMP OALL /REPEAT THE QUESTION ACL /NO DCA IBLOCK /STORE JMS QUEST MESSG7 /@FIRST OUTPUT BLOCK:@ ACL DCA OBLOCK JMS QUEST MESSG8 /@NUMBER OF BLOCKS TO COPY:@ ACL SNA /WERE 0 BLOCKS SPECIFIED? JMP QUEST1 /YES--REPEAT QUESTION DCA NUMBER JMP .+4 WHOLE, DCA IBLOCK DCA OBLOCK DCA NUMBER /0 MEANS WHOLE TAPE JMS QUEST MESSG9 /@VERIFY OUTPUT (YES=1,NO=0):@ ACL AND [7 DCA VERF JMP I (SETUP /OUTPUT CARRIAGE RETURN/LINE FEED CRLF, 0 TAD (215 JMS I [TYPE TAD [212 JMS I [TYPE JMP I CRLF /--RETURN-- ERR4, 0 JMS I [MESSGE ERROR4 /@ILLEGAL RESPONSE@ JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED TAD [-4 TAD ERR4 DCA ERR4 DCA COUNT JMP I ERR4 /--RETURN-- QUEST, 0 TAD I QUEST DCA MNUM ISZ QUEST JMS I [MESSGE MNUM, 0 JMS I [ANSWER QUEST1, JMS ERR4 TAD COUNT SZA CLA JMP QUEST1 JMP I QUEST /--RETURN-- /CONVERT UNIT NUMBER TO A WORD OF THE FORM /000 XXX XXX 000 OR /100 XXX XXX 000 /WHERE XY0 IS THE THIRD DIGIT OF THE IOT /AND 0 OR 1 REFLECTS THE TD8E UNIT NUMBER /ENTER WITH THE UNIT NUMBER IN THE AC /EXIT WITH SPECIAL CODE IN AC UNITNO, 0 AND [7 /MASK OUT ALL EXTRANEOUS BITS CLL RAR /SAVE 0/1 BIT IN LINK MQL /STORE ROTATED WORD, CLEAR AC RAR SWP /PRESERVE 0/1 BIT IN MQ TAD TABX /GET DEVICE NUMBER CORRECTLY DCA CRLF TAD I CRLF MQA /OR IN 0/1 BIT JMP I UNITNO /--RETURN-- TABX, UNITS /SKIP 4 LINES AND FETCH MARK TRACK SKIPQ, 0 IOTR5, SDSQ JMP .-1 IOTR6, SDRC JMP I SKIPQ /--RETURN-- *400 /USER RESPONSE HANDLER /USES MQ FOR TEMPORARY STORAGE /EXIT WITH RESPONSE IN MQ /EXIT TO CALL+1 IF JUST CARRIAGE RETURN /OR ILLEGAL CHARACTER, CARRIAGE RETURN /OR ;,CARRIAGE RETURN /EXIT TO CALL+2 IF GOOD DATA, CARRIAGE RETURN /INCREMENT COUNT AND EXIT TO CALL+2 IF GOOD DATA; /ILLEGAL CHARACTERS CAUSE WHOLE ANSWER TO BE IGNORED /AND EXIT TO CALL+1 ANSWER, 0 CAM /CLEAR AC AND MQ TAD CLEAR DCA SWITCH MORE, JMS LISTEN /FETCH A CHARACTER TAD (-215 SZA /IS IT A CARRIAGE RETURN? JMP .+5 /NO TAD [212 /YES--OUTPUT LINE FEED JMS TYPE SWITCH, NOP /SET UP EXIT ADDRESS JMP I ANSWER /--RETURN-- TAD (215-260 SPA /IS CHARACTER LESS THAN 260? JMP BAD /YES--ILLEGAL CHARACTER TAD [260-270 /NO SMA /IS IT MORE THAN 269? JMP SEMI /YES--CHECK FOR SEMICOLON TAD (270 /RESTORE CHARACTER AND [7 /MASK OUT EXTRANEOUS BITS CLL SWP AND (777 /MASK OUT FIRST DIGIT IF THERE ARE 4 RAL /ROTATE 3 LEFT RTL MQA /FETCH NEW CHARACTER MQL /STORE RESULT IN MQ TAD SKIP /SET UP TO SKIP ON RETURN DCA SWITCH JMP MORE /FETCH ANOTHER CLEAR, NOP SKIP, ISZ ANSWER BAD, CLA /ILLEGAL CHARACTER JMS I [CRLF JMP I ANSWER /--RETURN-- /TEST FOR SEMICOLON SEMI, TAD (270-273 SZA CLA /IS CHARACTER A SEMICOLON? JMP BAD /NO--ILLEGAL CHARACTER ISZ COUNT /YES--INCREMENT COUNTER JMP SWITCH /EXIT FROM ANSWER ROUTINE /TELETYPE INPUT AND ECHO HANDLER LISTEN, 0 KSF JMP .-1 KRB TLS /ECHO CHARACTER JMS CHECK /CHECK FOR CTRL/C AND CTRL/S JMP I LISTEN /--RETURN-- /CHECK FOR CTRL/C AND CTRL/S /ENTER WITH INPUT CHARACTER IN AC /EXIT TO HANDLER OR WITH CHARACTER IN AC CHECK, 0 TAD (-203 SNA /IS IT CTRL/C? JMP I CTRLC /YES--HANDLE IT TAD (203-223 SNA /IS IT CTRL/S? JMP I [REPEAT /YES--HANDLE IT TAD (223 /RESTORE CHARACTER JMP I CHECK /--RETURN-- CTRLC, LIMIT /MESSAGE OUTPUT HANDLER /EXPECTS MESSAGE ADDRESS TO BE IN LOCATION AFTER CALL /EXITS TO CALL+2 MESSGE, 0 TAD I MESSGE DCA FINDER /SET UP POINTER ISZ MESSGE DCA LOC /SET L/R SWITCH TO L (EVEN) LNEXT, TAD I FINDER /GET WORD BSW RHALF, AND [77 SNA /IS CHARACTER 0 (TERMINATOR)? JMP I MESSGE /YES--RETURN-- DCA CHAR TAD CHAR AND (40 SNA CLA /IS IT A LETTER? TAD [100 /YES--301-337 TAD [200 /NO--240-277 TAD CHAR /RESTORE CHARACTER JMS TYPE /OUTPUT IT ISZ LOC TAD LOC RAR SZL CLA /WHICH HALF WAS THAT? JMP .+3 ISZ FINDER /RIGHT JMP LNEXT TAD I FINDER /LEFT JMP RHALF FINDER, 0 LOC, 0 CHAR, 0 /TELETYPE OUTPUT ROUTINE TYPE, 0 TSF JMP .-1 TLS CLA JMP I TYPE /--RETURN-- /INSERT IOT'S ACCORDING TO TABLES /UNIT CONTAINS APPROPRIATE UNIT CODE /COUNT CONTAINS -(NUMBER OF IOT'S TO TRANSFER) /COUNT1 CONTAINS ADDRESS OF ADDRESS TABLE /UNIT CONTAINS UNIT CODE OF CURRENT UNIT INSERT, 0 TAD I COUNT1 DCA COUNT3 TAD UNIT MQL TAD I COUNT3 /MAKE NEW IOT AND (7007 MQA CIA TAD I COUNT3 /COMPARE WITH IOT FROM PROGRAM SNA CLA /ARE THE IOT'S THE SAME AS THE LAST UNIT? JMP I INSERT /YES--RETURN-- INS1, TAD I COUNT1 DCA COUNT3 TAD I COUNT3 /GET IOT FROM PROGRAM AND (7007 /RETAIN ONLY SIGNIFICANT BITS MQA /OR IN UNIT NUMBER DCA I COUNT3 /PUT IT IN PROGRAM ISZ COUNT1 /BUMP COUNTERS ISZ COUNT /DONE YET? JMP INS1 /NO JMP I INSERT /YES--RETURN-- PAGE /COUNT THE NUMBER OF WORDS PER BLOCK /PLACE IT IN MWORDS /BE SURE ALL TAPES MATCH INPUT FORMAT SETUP, TAD LIST DCA OPOINT /SET POINTER TO I/O LIST DCA COUNT2 /CLEAR COUNTER TAD OCOUNT CMA DCA OUTNUM /SET # OF UNITS SET4, TAD (TABLE1-END1-1 /SET UP COUNTERS FOR IOT FIX DCA COUNT TAD (TABLE1 DCA COUNT1 TAD I OPOINT DCA UNIT JMS I [INSERT /PUT THE PROPER IOT'S IN THE FOLLOWING ROUTINE DCA WDCNT /CLEAR WORD COUNT TAD UNIT AND [4000 TAD (2000 IOTX7, SDLC CLA IOTX8, SDRC RTL SZL /DOES UNIT EXIST? JMP .+3 /YES SELERR, JMS I [ERR3 /@SELECT ERROR UNIT N@ JMP SETUP AND (400 SZA CLA /TURNED ON? JMP SELERR /NO TAD UNIT /GET 0 OR 1 UNIT BIT (0 OR 4000) AND [4000 TAD [1000 /GET GO BIT IOTX1, SDLC /START READING FORWARD JMS SKIP4 /SKIP 8 LINES TO AVOID GARBAGE JMS SKIP4 IOTX3, SDSS /LOOK FOR FORWARD BLOCK NUMBER (26) JMP .-1 IOTX4, SDRC AND [77 TAD (-26 SZA CLA /FOUND YET? JMP IOTX3 /NO--KEEP LOOKING SET2, JMS SKIP4 /YES--START COUNTING LINES BY FOURS ISZ WDCNT NOP AND [77 TAD (-51 SZA CLA /FOUND GUARD YET? JMP SET2 /NO TAD UNIT /YES AND [4000 IOTX2, SDLC /STOP UNIT CLA TAD COUNT2 SZA /IS THIS THE INPUT UNIT? JMP SET5 /NO TAD (-11 /YES--SAVE THE COUNT TAD WDCNT CIA DCA COUNT2 JMP SET3 /FIRST OUTPUT UNIT SET5, TAD (-11 /NOT INPUT UNIT TAD WDCNT SZA CLA /SAME NUMBER OF WORDS AS INPUT UNIT? JMP ERR5 /NO*ILLEGAL FORMAT* SET3, ISZ OPOINT /NEXT UNIT ISZ OUTNUM /DONE YET? JMP SET4 /NO TAD COUNT2 /YES--PRINT MESSAGE DCA I [MWORDS /SET UP NUMBER OF WORDS PER BLOCK TAD I [MWORDS CIA JMS I [PRINT /PRINT 4 DIGIT NUMBER OF BLOCKS JMS I [MESSGE /YES--PRINT REST OF MESSAGE MESSG3 JMS I [CRLF /IF WHOLE TAPE IS TO BE COPIED, IT IS NECESSARY TO /COMPUTE THE NUMBER OF BLOCKS ON THE TAPE (NB) /USING THE NUMBER OF WORDS PER BLOCK (WB) /AND THE FORMULA: /OCTAL: NB=[63 6160/(WB+17)]+2 /DECIMAL: NB=[212,080/(WB+15)]+2 TAD NUMBER SZA CLA /COPY WHOLE TAPE? JMP VERFQ /NO-- DCA COUNT /YES--COMPUTE NUMBER OF BLOCKS ON TAPE TAD I [MWORDS CIA TAD (17 DCA COUNT1 /GET NUMBER OF WORDS PER BLOCK+17 TAD (-64 DCA COUNT2 TAD (-6160 SUB, CLL TAD COUNT1 ISZ COUNT /COUNT A BLOCK--TOO MANY? SKP /NO JMP ERR5 /YES--ERROR SZL ISZ COUNT2 JMP SUB CLA CLL TAD COUNT /COUNT IS [63 6160/WB+17]+1 IAC /ADD 1 MORE DCA NUMBER /STORE AS # OF BLOCKS TO TRANSFER JMP I .+1 VERFQ ERR5, CLA JMS I [MESSGE ERROR5 /*ILLEGAL FORMAT UNIT* JMS I [DECODE /PRINT UNIT NUMBER JMS I [CTRLR /WAIT FOR CTRL/R JMS I [CRLF /CARRIAGE RETURN/LINE FEED JMP SETUP /TRY AGAIN /READ FOUR LINES AND FETCH MARK TRACK SKIP4, 0 IOTX5, SDSQ JMP .-1 IOTX6, SDRC JMP I SKIP4 /--RETURN-- PAGE /IS TAPE TO BE VERIFIED? /SET UP DEPENDING ON RESPONSE VERFQ, TAD VERF SZA CLA /VERIFY? JMP YES /YES-- TAD (NOP /NO-- DCA I VERF1A TAD (OUTN DCA I VERF2A JMP CONT YES, TAD (RAR DCA I VERF1A TAD (VERIFY DCA I VERF2A CONT, JMP I .+1 DOIT VERF1A, VERF1 VERF2A, VERF2 /WAIT FOR CTRL/R CTRLR, 0 JMS I [LISTEN /FETCH CHARACTER TAD [-222 SZA CLA /IT IT CTRL/R? JMP .-3 /NO--WAIT FOR ONE JMS I [CRLF /CARRIAGE RETURN/LINE FEED JMP I CTRLR /--RETURN-- REPEAT, DCA COUNT JMS I [CRLF JMS I [QUEST /@REPEAT (YES=1;NO=0):@ MESS11 ACL AND [7 SZA CLA JMP I [CLEAN /YES JMP I [START+1 /NO--RESTART MESSG6, TEXT @FIRST INPUT BLOCK:@ MESSG7, TEXT @FIRST OUTPUT BLOCK:@ MESSG8, TEXT @NUMBER OF BLOCKS TO COPY:@ MESSG9, TEXT @VERIFY OUTPUT (YES=1,NO=0):@ MESS10, TEXT @DONE@ MESS11, TEXT @REPEAT (YES=1,NO=0):@ ERROR1, TEXT @VERIFY ERROR BLOCK @ ERROR2, TEXT @TAPE ERROR BLOCK @ ERROR3, TEXT @SELECT ERROR UNIT @ PAGE /SETUP FOR ACTUAL READ/WRITE/VERIFY OPERATION DOIT, TAD [LIMIT-END /SET UP NUMBER OF BLOCKS JMS DIV1 /IN FIELD 0 BUFFER DCA FLD0 TAD M200 JMS DIV1 /AND IN FIELD N BUFFERS DCA FLDN TAD IBLOCK /SET UP RUNNING COUNTERS AND POINTERS DCA INB /FOR NEXT INPUT BLOCK TAD OBLOCK DCA OUTB /FOR NEXT OUTPUT BLOCK TAD NUMBER DCA NUMB1 /FOR NUMBER OF BLOCKS LEFT TO TRANSFER JMP .+4 ALLDUN, TAD XNUMB SNA CLA /DONE WITH ALL BLOCKS YET? JMP REWIND /YES /READ--- READX, TAD LIST /NO--SET UP POINTER TO OUTPUT UNITS DCA OPOINT TAD OCOUNT CMA DCA OUTNUM TAD INB DCA BLOCKN TAD NUMB1 /SET POINTERS FOR TRANSFER DCA XNUMB TAD NUMB1 DCA NUMB2 /SAVE COUNTER FOR WRITE TAD INPUT /SELECT INPUT UNIT DCA UNIT DCA RW /SET R/W BIT TO READ TAD [END /SET START OF BUFFERS IN CASE DCA BUF0 /THEY WERE CHANGED BY VERIFY DCA BUFN JMS I [READY /FILL THE BUFFERS TAD XNUMB /SAVE THE POINTERS DCA NUMB1 TAD BLOCKN DCA INB OUTN, ISZ OPOINT ISZ OUTNUM /DONE WITH ALL UNITS YET? JMP .+4 /NO--CONTINUE WRITING TAD OHOLD /YES DCA OUTB JMP ALLDUN /READ ANOTHER BUFFER LOAD WRITEX, TAD OUTB DCA OHOLD TAD OHOLD /WRITE DCA BLOCKN /RESET POINTERS TAD OUTB DCA VB /SAVE COUNTER FOR VERIFY TAD NUMB2 DCA XNUMB TAD I OPOINT /SELECT OUTPUT UNIT DCA UNIT CLA CLL CML RAR /AC=4000 DCA RW /SET R/W BIT TO WRITE JMS I [READY TAD BLOCKN DCA OHOLD JMP I .+1 VERF2, VERIFY /SEE HOW MANY BLOCKS WILL FIT INTO BUFFER /ENTER WITH BUFFER SIZE IN AC /EXIT WITH # OF BLOCKS IN AC DIV1, 0 DCA COUNT1 DCA COUNT TAD COUNT1 /TOTAL WORDS DIV2, CLL TAD I [MWORDS /-NUMBER OF WORDS PER BLOCK SNL /RUN OUT OF ROOM? JMP .+3 /YES-- ISZ COUNT /NO--COUNT A BLOCK JMP DIV2 CLA CLL /IGNORE LESS THAN A BLOCK LEFT TAD COUNT VERF1, RAR /DIVIDE BY 2 IF VERIFY (NOP IF NO VERIFY) JMP I DIV1 /--RETURN-- /END OF OPERATION /REWIND TAPES TO INITIAL END ZONE REWIND, TAD OCOUNT CMA DCA COUNT2 /SET NUMBER OF TAPES STILL SPINNING RLIST, CLA CMA TAD LIST DCA OPOINT /SET POINTER TO UNIT LIST TAD OCOUNT IAC CMA DCA OUTNUM /SET NUMBER OF UNITS IN LIST RUNIT, KRB JMS I [CHECK /CHECK TTY FOR CTRL/S OR CTRL/C ISZ OUTNUM /DONE WITH WHOLE LIST YET? SKP CLA /NO JMP RLIST /YES--START THROUGH LIST AGAIN ISZ OPOINT TAD I OPOINT /GET UNIT CODE RTL SZL CLA /STILL SPINNING? JMP RUNIT /NO--TRY NEXT TAPE TAD I OPOINT /YES DCA UNIT TAD [-6 DCA COUNT TAD [RTAB DCA COUNT1 JMS I [INSERT /PUT PROPER IOT'S IN THIS ROUTINE TAD I OPOINT AND [4000 /UNIT/READ TAD [3000 /REVERSE/GO IOTR1, SDLC JMS I [SKIPQ JMS I [SKIPQ /WAIT FOR DRIVE TO GET UP TO SPEED IOTR2, SDSS JMP .-1 IOTR3, SDRC /GET MARK TRACK BITS AND [77 TAD [-22 SZA CLA /END ZONE? JMP RUNIT /NO--NEXT UNIT CLA CLL CML RTR /AC=2000 MQA /UNIT CODE STILL IN MQ FROM INSERT DCA I OPOINT /SET STOPPED BIT TAD I OPOINT AND [6000 IOTR4, SDLC /STOP UNIT M200, 7600 /CLA ISZ COUNT2 /ALL TAPES STOPPED? JMP RUNIT /NO--NEXT UNIT JMS I [MESSGE /YES MESS10 /@DONE@ JMP I [REPEAT PAGE /VERIFICATION ROUTINES VERIFY, TAD VB /SET POINTERS AND COUNTERS FOR TRANSFER DCA BLOCKN TAD NUMB2 DCA XNUMB DCA RW TAD END0 /SET BEGINNINGS OF VERIFY BUFFERS DCA BUF0 TAD (3700 DCA BUFN TAD CDF0 DCA COMP2 JMS I [READY /READ VERIFY BUFFERS FULL TAD COUNT1 /GET # OF BLOCKS IN LAST BUFFER FILLED DCA COUNT3 CMA /SET AUTOINDEX POINTERS TO BUFFERS TAD [END DCA X11 CMA CLL TAD END0 DCA X12 TAD COUNT CMA TAD FIELDS DCA COUNT /SET NUMBER OF FIELDS WHICH WERE FILLED JMS COMP4 /GET NUMBER OF BLOCKS TAD FLD0 CIA DCA COUNT4 /SET COUNTER JMS COMP /COMPARE THE BUFFERS COMP3, TAD COUNT SNA CLA JMP I [OUTN JMS COMP4 /GET NUMBER OF BLOCKS TAD FLDN CIA DCA COUNT4 TAD COMP2 /EACH FIELD------ TAD (10 DCA COMP2 /SET CDF INSTRUCTION PROPERLY CMA CLL /SET AUTOINDEX POINTERS TO BUFFERS DCA X11 TAD (3677 DCA X12 JMS COMP JMP COMP3 /DO THE NEXT FIELD /ENTER WITH AC CLEAR /EXIT TO CALL+1 WITH AC CLEAR IF /NORMAL BUFFER FILL /EXIT TO CALL+2 WITH # OF BLOCKS IN AC IF /LAST BUFFER COMP4, 0 ISZ COUNT /LAST FIELD FILLED? JMP I COMP4 /NO--RETURN-- TAD XNUMB /YES--OUT OF BLOCKS? SZA CLA JMP I COMP4 /NO--RETURN-- TAD COUNT3 /YES--GET ACTUAL # OF BLOCKS ISZ COMP4 /INCREMENT RETURN ADDRESS JMP I COMP4 /--RETURN-- /COMPARE PORTION OF VERIFY ROUTINE COMP, 0 TAD I [MWORDS /SET NUMBER OF WORDS PER BLOCK COUNTER DCA COUNT2 COMP2, HALT /SHOULD CONTAIN CDF N TAD I X11 /GET CORRESPONDING WORDS FROM EACH BUFFER CIA TAD I X12 CDF0, CDF 0 SZA CLA /DO WORDS MATCH? JMP ERR1 /NO--VERIFY ERROR TRY, ISZ COUNT2 /DONE WITH BLOCK? JMP COMP2 /NO--CONTINUE ISZ COUNT4 /DONE WITH ALL BLOCKS? JMP COMP+1 /NO JMP I COMP /YES--RETURN-- ERR1, JMS I [MESSGE ERROR1 /*VERIFY ERROR BLOCK * TAD COUNT4 /GET CURRENT BLOCK NUMBER CIA TAD I (BLOCKS /FROM BLOCK THIS OPERATION STARTED WITH JMS PRINT /PRINT 4 DIGIT BLOCK NUMBER JMS I [MESSGE ERROR6 /*UNIT * JMS I [DECODE /PRINT UNIT NUMBER WAIT, JMS I [LISTEN /WAIT FOR RESPONSE DCA PRINT JMS I [CRLF TAD PRINT TAD [-224 SNA /WAS IT CTRL/T? JMP I [WRITEX /YES--TRY AGAIN TAD [2 SZA CLA /WAS IT CTRL/R? JMP WAIT /NO--WAIT FOR A GOOD RESPONSE JMP TRY /YES--IGNORE AND CONTINUE /PRINT A 4 DIGIT OCTAL NUMBER /ENTER WITH NUMBER IN AC PRINT, 0 DCA I [MESSGE /TEMPORARY STORAGE TAD [-4 DCA I [ANSWER /SET DIGIT COUNTER TAD I [MESSGE RAL DCA I [CRLF FOUR, TAD I [CRLF RAL RTL DCA I [CRLF TAD I [CRLF AND [7 TAD [260 JMS I [TYPE /PRINT ONE DIGIT ISZ I [ANSWER /DONE YET? JMP FOUR /NO JMP I PRINT /YES--RETURN-- /CLEAN UP UNIT TABLES AFTER REWIND CLEAN, TAD LIST DCA OPOINT TAD OCOUNT CMA DCA OUTNUM /SET POINTER AND COUNTER CLEAN1, TAD I OPOINT /GET UNIT CODE AND (4770 /MASK OUT EXTRANEOUS BITS DCA I OPOINT /REPLACE IT ISZ OPOINT ISZ OUTNUM /DONE YET? JMP CLEAN1 /NO JMP I [DOIT /YES--NEXT OPERATION PAGE /FILL ALL N FIELDS ONCE /ENTER WITH AC CLEAR /# OF BLOCKS FOR FIELD 0 IN FLD0 /# OF BLOCKS FOR OTHERS IN FLDN /ADDRESSES OF BUFFERS IN BUF0, BUFN /R/W BIT (0 OR 4000) IN RW READY, 0 TAD [IOTLOC-TABEND-1 DCA COUNT TAD [IOTLOC DCA COUNT1 JMS I [INSERT /PUT PROPER IOT'S IN HANDLER TAD UNIT SPA CLA /EVEN OR ODD UNIT NUMBER? CLL IAC RTL /ODD TAD [ORIGIN /EVEN DCA ENTRY /SET UP ENTRY TO HANDLER TAD RW MQL /STORE UNIT BIT FOR LATER CMA TAD FIELDS /SET COUNTER FOR # OF FIELDS DCA COUNT CLL TAD FLD0 /ADJUST NUMBER OF BLOCKS TO JMS SUB1 /TRANSFER DEPENDING ON NUMBER TAD FLD0 /LEFT TO BE TRANSFERRED JMS SUB2 /RESET FUNCTION WORD TAD BUF0 /SET UP BUFFER POINTERS JMS SUB3 JMS TRANS /TRANSFER DATA--FIELD 0 ZOOM, ISZ COUNT /BEGINNING OF LOOP FOR EACH FIELD ABOVE 0 SKP /DONE YET? JMP I READY /YES--RETURN-- TAD FIELDS CIA CLL TAD COUNT IAC RAL RTL /GET FIELD SETTING READY MQL /STORE IN MQ TAD FUNCTN /GET PREVIOUS FUNCTION WORD AND [4000 /GET R/W BIT MQA /OR IN FIELD SETTING MQL /STORE CLL TAD FLDN /ADJUST NUMBER OF BLOCKS TO TRANSFER JMS SUB1 TAD FLDN JMS SUB2 /AND RESET FUNCTION WORD TAD BUFN JMS SUB3 /SET UP BUFFER POINTERS JMS TRANS /TRANSFER DATA--FIELDS 1-N JMP ZOOM /FILL ANOTHER FIELD SUB1, 0 CIA TAD XNUMB CLL CML /SET LINK=1 SMA /ARE THERE LESS BLOCKS LEFT THAN A FIELD FULL? DCA XNUMB /NO--REDUCE COUNT OF BLOCKS LEFT JMP I SUB1 /YES-TRANSFER BLOCKS LEFT--RETURN-- SUB2, 0 DCA COUNT1 /LINK=1 IF BLOCKS LEFT, 0 IF NONE SNL /DONE WITH ALL BLOCKS YET? DCA XNUMB /YES--BUMP SWITCH TAD COUNT1 /NO BSW MQA /PUT # OF BLOCKS INTO FUNCTION WORD DCA FUNCTN /START REVERSE JMP I SUB2 /--RETURN-- SUB3, 0 DCA BUFADD TAD BLOCKN /SET STARTING BLOCK NUMBER DCA BLOCKS TAD COUNT1 TAD BLOCKN DCA BLOCKN /RESET STARTING BLOCK FOR NEXT TIME JMP I SUB3 /--RETURN-- /CALL TO THE HANDLER TRANS, 0 KRB /CHECK TELETYPE JMS I [CHECK /WAS ^C OR ^S TYPED? JMS I ENTRY FUNCTN, 0 /FUNCTION WORD BUFADD, 0 /BUFFER ADDRESS BLOCKS, 0 /STARTING BLOCK NUMBER JMP ERR /ERROR RETURN KRB /CHECK TELETYPE JMS I [CHECK /WAS ^C OR ^S TYPED? CLA TAD XNUMB SZA CLA /DONE YET? JMP I TRANS /NO--RETURN-- ISZ COUNT JMP I READY /--RETURN-- JMP I READY /--RETURN-- /TRANSFER ERROR HANDLER ERR, SNA CLA /FATAL ERROR? JMP SELECT /NO JMS I [MESSGE /YES ERROR2 /*TAPE ERROR BLOCK * TAD I (BLOCK JMS I [PRINT /PRINT BLOCK NUMBER JMS I [MESSGE ERROR6 /*UNIT * JMS DECODE /PRINT UNIT NUMBER JMS I [CRLF JMP I [REWIND SELECT, JMS ERR3 ISZ FUNCTN /TURN AROUND AND TRY AGAIN JMP FUNCTN-1 ERR3, 0 JMS I [MESSGE ERROR3 /*SELECT ERROR UNIT * JMS DECODE /PRINT UNIT NUMBER JMS CTRLR /WAIT FOR CTRL/R JMP I ERR3 /--RETURN-- /DECODE UNIT NUMBER FOR PRINTING /PRINT UNIT NUMBER BEFORE RETURNING DECODE, 0 CLL TAD UNIT RAL MQL /SAVE ROTATED CODE IN MQ RAL SWP /SAVE EVEN/ODD BIT IN MQ RAR /WORK ON IOT CODE RTR IAC CMA AND [7 MQA /INCLUDE EVEN/ODD BIT TAD [260 /MAKE ASCII DIGIT JMS I [TYPE JMP I DECODE /--RETURN-- PAGE /TD8E DECTAPE HANDLER /SLIGHTLY MODIFIED VERSION OF DEC-E8-UZTA-D /COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION / MAYNARD, MASSACHUSETTS 01754 /THE CALLING SEQUENCE IS: / JMS ENTRY / FUNCTION WORD / BUFFER ADDRESS / STARTING BLOCK / ERROR RETURN / NORMAL RETURN (AC CLEAR) /FUNCTION WORD: / BIT 0: 0=READ, 1=WRITE / BITS 1-5: # OF BLOCKS TO BE TRANSFERRED / BITS 6-8: FIELD OF BUFFER AREA / BITS 9-10: UNUSED / BIT 11: 1=START FORWARD, 0=START REVERSE /ERRORS: /THE HANDLER DETECTS TWO TYPES OF ERRORS: /FATAL ERRORS: / PARITY ERROR / TIMING ERROR / TOO GREAT A BLOCK NUMBER /FATAL ERRORS TAKE ERROR RETURN WITH AC=4000 /NON-FATAL ERROR: / SELECT ERROR (IMPROPER UNIT NUMBER OR NO UNIT NUMBER) /NON-FATAL ERROR TAKES ERROR RETURN WITH AC=0 PAGE MFIELD=0 ORIGIN=. DTA0, 0 /ENTRY POINT FROM UNIT 0 CLA CLL /0 TO LINK JMP DTA1X C1000, 1000 DTA1, 0 /UNIT 2 ENTRY CLA CLL CML /1 TO LINK TAD DTA1 DCA DTA0 /PICK UP ARGS AT DTA0 DTA1X, RAR DCA YUNIT /LINK TO UNIT POSITION RDF TAD C6203 /GET DATA FIELD AND SETUP RETURN DCA LEAVE TAD I DTA0 /GET FUNCTION WORD IOT1, SDLD /PUT FUNCTION INTO DATA REGISTER CLL RTR /AC STILL HAS FUNCTION. PUT # WORDS PER /BLOCK INTO LINK SZL CLA /KNOCK ONE OFF WDSBLK? NOP /*****SPECIAL MODIFICATION TO FREE BIT 10***** TAD MWORDS DCA WCOUNT /STORE MASTER WORD COUNT ISZ DTA0 /TO BUFFER TAD I DTA0 DCA BUFF ISZ DTA0 /TO BLOCK NUMBER TAD I DTA0 DCA BLOCK ISZ DTA0 /POINT TO ERROR EXIT CIF CDF MFIELD /TO ROUTINES DATA FIELD IOT2, SDRD /GET FUNCTION INTO AC CLL RAL AND CM200 /GET # PAGES TO XFER DCA PGCT IOT3, SDRD C374, AND C70 /GET FIELD FOR XFER TAD C6203 /FORM CDF N DCA XFIELD /IF=0 AND DF=N AT XFER. CLA CLL CMA RTL DCA TRYCNT /3 ERROR TRIES TAD YUNIT /TEST FOR SELECT ERROR IOT4, SDLC IOT5, SDRC AND C100 SZA CLA JMP FATAL-1 IOT6, SDRD /PUT FUNCT INTO XFUNCT IN SECOND PG. DCA I CXFUN TAD WCOUNT DCA I CXWCT IOT7, SDRD /GET MOTION BIT TO LINK CLL RAR JMP GO /AND START THE MOTION. RWCOM, SDST /ANY CHECKSUM ERRORS? SZA CLA /OR CHECKSUM ERRORS? JMP TRY3 /PLEASE NOTE THAT THE LINK IS ALWAYS /SET AT RWCOM. GETCHK SETS IT. TAD PGCT /NO ERROR..FINISHED XFER? TAD CM200 SNA JMP EXIT /ALL DONE. GET OUT DCA PGCT /NEW PAGE COUNT ISZ BLOCK /NEXT BLOCK TO XFER TAD WCOUNT /FORM NEXT BUFFER ADDRESS CIA TAD BUFF DCA BUFF CLL CML /FORCES MOTION FORWARD GO, CLA CML RTR /LINK BECOMES MOTION BIT TAD C1000 TAD YUNIT /PUT IN 'GO' AND UNIT # IOT8, SDLC /LOOK FOR BLOCK NO. JMS I CRDQUD /WAIT AT LEAST 6 LINES TO LOOK JMS I CRDQUD CM200, 7600 /COULD HAVE SAVED A LOC. HERE SRCH, SDSS JMP .-1 /WAIT FOR SINGLE LINE FLAG IOT9, SDRC CLL RTL /DIRECTION TO LINK. INFO BITS /ARE SHIFTED. AND C374 /ISOLATE MARK TRACK BITS TAD M110 /IS IT END ZONE? SNA /THE LINK STAYS SAME THRU THIS JMP ENDZ TAD M20 /CHECK FOR BLOCK MARK SZA CLA JMP SRCH IOT10, SDRD /GET THE BLOCK NUMBER SZL /IF WE ARE IN REVERSE, LOOK FOR 3 /BLOCKS BEFORE TARGET BLOCK. THIS /ALLOWS TURNAROUND AND UP TO SPEED. TAD C3 /REVERSE CMA TAD BLOCK CMA /IS IT RIGHT BLOCK? SNA JMP FOUND /YES..HOORAY! M110, SZL SNA CLA /NO, BUT ARE WE HEADED FOR IT? /ABOVE SNA IS SUPERFLUOUS. JMP SRCH /YES ENDZ, SDRC /WE ARE IN THE END ZONE CLL RTL /DIRECTION TO LINK SZL CLA /ARE WE IN REVERSE? JMP GO /YES..TURN US AROUND /IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR TRY3, ISZ TRYCNT JMP GO /TRY 3 TIMES CLL CLA JMP FATAL /LINK OFF MEANS AC=4000 ON RETURN EXIT, ISZ DTA0 CLL CML /AC=0 ON NORMAL RETURN FATAL, TAD YUNIT SDLC /STOP THE UNIT CLA CML RAR LEAVE, HLT JMP I DTA0 /--RETURN-- C6203, 6203 CRDQUD, RDQUAD WCOUNT, 0 BUFF, 0 MWORDS, 0 YUNIT, 0 CXFUN, XFUNCT M20, -20 PGCT, 0 CXWCT, XWCT C100, 100 TRYCNT, -3 BLOCK=DTA1 *ORIGIN+170 FOUND, SZL CLA /RIGHT BLOCK. HOW ABOUT DIRECTION? JMP GO /WRONG..TURN AROUND TAD YUNIT /PUT UNIT INTO LINK CLL RAL /AC IS NOW 0 C70, 70 /********DON'T MOVE THIS!!!!****** C3, 3 TAD BUFF /GET BUFFER ADDRESS XFIELD, HLT /INTO NEXT PAGE *ORIGIN+200 XUNIT=EQUFUN CIF MFIELD DCA XBUFF /SAVE ADDRESS RAR /NOW GET UNIT # DCA XUNIT TAD XWCT DCA WORDS /WORD COUNTER REVGRD, SDSS JMP .-1 /LOOK FOR REVERSE GUARD IOT11, SDRC AND K77 TAD CM32 /IS IT REVERSE GUARD? SZA CLA JMP REVGRD /NO.KEEP LOOKING TAD XFUNCT /GET FUNCTION READ OR WRITE K7700, SMA CLA JMP READ /NEG. IS WRITE WRITE, SDRC AND C300 /CHECK FOR WRITE LOCK AND SELECT ERROR CLL CML /LOCK OUT AND SELECT ARE AC 0 ERRORS SZA CLA JMP I CFATAL /FATAL ERROR. LINK MUST BE ON JMS RDQUAD /NO ONE EVER USES THIS WORD! C7600, 7600 TAD C1400 TAD XUNIT /INITIATE WRITE MODE IOT12, SDLC CLA CMA JMS WRQUAD /PUT 77 IN REVERSE CHECKSUM CLA CMA DCA CHKSUM WRLP, TAD I XBUFF /GLORY BE! THE ACTUAL WRITE! JMS WRQUAD ISZ XBUFF /BUMP CORE POINTER K77, 77 /ABOVE MAY SKIP ISZ WORDS /DONE THIS BLOCK? JMP WRLP /NOT YET..LOOP A WHILE TAD XFUNCT /IS THE OPERATION FOR WDSBLK PER BLOCK? CLL RTR /IF NO, WRITE A 0 WORD SZL CLA JMS WRQUAD /WRITE A WORD OF 0 JMS GETCHK /DO THE CHECK SUM JMS WRQUAD /WRITE FORWARD CHECKSUM JMS WRQUAD /ALLOW CHECKSUM TO BE WRITTEN JMP I CRWCOM READ, JMS RDQUAD JMS RDQUAD JMS RDQUAD /SKIP CONTROL WORDS AND K77 TAD K7700 /TACK 7700 ONTO CHECKSUM. DCA CHKSUM /CHECKSUM ONLY LOW 6 BITS ANYWAY RDLP, JMS RDQUAD JMS EQUFUN /COMPUT CHECKSUM AS WE GO DCA I XBUFF /IT GETS CONDENSED LATER ISZ XBUFF C300, 300 /PROTECTION ISZ WORDS /DONE THIS OP? JMP RDLP /NO SUCH LUCK TAD XFUNCT /IF OP WAS FOR WDSBLK-1, READ AND CLL RTR /CHECKSUM THE LAST TAPE WORD SNL CLA JMP RDLP2 JMS RDQUAD /NOT NEEDED FOR WDSBLK/BLOCK JMS EQUFUN /CHECKSUM IT RDLP2, JMS RDQUAD /READ CHECKSUM AND K7700 JMS EQUFUN JMS GETCHK /GET SIX BIT CHECKSUM JMP I CRWCOM WRQUAD, 0 /WRITE OUT A 12 BIT WORD JMS EQUFUN /ADD THIS TO CHECKSUM IOT13, SDSQ /SKIP ON QUADLINE FLAG JMP .-1 IOT14, SDLD /LOAD DATA ONTO BUS CLA /SDLD DOESN'T CLEAR AC JMP I WRQUAD RDQUAD, 0 /READ A 12 BIT WORD SDSQ JMP .-1 IOT15, SDRD /READ DATA JMP I RDQUAD EQUFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM CMA DCA EQUTMP /ACTUALLY CHECKSUMS ON DECTAPE ARE TAD EQUTMP /EQUIVALENCE OF ALL WORDS IN A RECORD AND CHKSUM /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE CIA /IS ASSOCIATIVE, WE CAN DO IT 12 CLL RAL /BITS AT A TIME AND CONDENSE LATER. TAD EQUTMP /THIS ROUTINE USES THESE IDENTITIES: TAD CHKSUM /A+B=(A.XOR.B)+2*(A.AND.B) DCA CHKSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B) TAD EQUTMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B)) CMA JMP I EQUFUN GETCHK, 0 /FORM 6 BIT CHECKSUM CLA TAD CHKSUM CMA CLL RTL RTL RTL JMS EQUFUN CLA CLL CML /FORCES LINK ON AT RWCOM TAD CHKSUM AND K7700 JMP I GETCHK CFATAL, FATAL CRWCOM, RWCOM XFUNCT, 0 CM32, -32 C1400, 1400 CHKSUM, 0 WORDS, 0 XBUFF, 0 XWCT, 0 EQUTMP, 0 /IOT TABLES FOR TD8E SUBROUTINE IOTLOC, IOT1 IOT2 IOT3 IOT4 IOT5 IOT6 IOT7 RWCOM IOT8 SRCH IOT9 IOT10 ENDZ FATAL+1 REVGRD IOT11 WRITE IOT12 IOT13 IOT14 RDQUAD+1 TABEND, IOT15 UNITS=. UNIT01 UNIT23 UNIT45 UNIT67 RTAB, IOTR1 IOTR2 IOTR3 IOTR4 IOTR5 IOTR6 /IOT TABLES FOR WORDS PER BLOCK ROUTINE TABLE1, IOTX1 IOTX2 IOTX3 IOTX4 IOTX5 IOTX6 IOTX7 END1, IOTX8 MESSG4, TEXT @FROM UNIT:@ MESSG5, TEXT @TO UNITS:@ ERROR5, TEXT @ILLEGAL FORMAT UNIT @ ERROR6, TEXT @ UNIT @ ERROR4, TEXT @ILLEGAL RESPONSE@ /ONCE ONLY CODE END, JMS I (QUEST MESSG2 /@HIGHEST FIELD AVAILABLE:@ ACL AND [7 CIA DCA FIELDS TAD (CDF DCA CDF00 TAD FIELDS SNA /MORE THAN 1 FIELD?? JMP LIM /NO--NO PROBLEM DCA COUNT1 /YES--ARE THEY ALL PRESENT? NEXT, TAD CDF00 TAD (10 DCA CDF00 /SET FOR DATA FIELD CHANGE TAD (HLT CDF00, CDF DCA I (10 /TRY LOCATION 10 TAD I (10 CDF 0 CIA TAD (HLT SNA CLA /IS FIELD THERE? JMP NEXT1 /YES--TRY NEXT ONE JMS I [MESSGE /NO ERROR4 /ILLEGAL RESPONSE JMS I [CRLF /CARRIAGE RETURN/LINE FEED DCA COUNT /CLEAR COUNT JMP END /TRY AGAIN NEXT1, ISZ COUNT1 /DONE YET? JMP NEXT /NO LIM, TAD (LIMIT-END /SET BEGINNING OF VERIFY BUFFER CLL RAR TAD [END DCA END0 TAD (NOP DCA I (START1-1 JMP I (START1 MESSG2, TEXT @HIGHEST FIELD AVAILABLE:@ FIELD 0 *200 $