/ P?S/8 LINCTAPE DUMP PROGRAM / LAST EDIT: 12-JAN-1987 08:00:00 CJL / MUST BE ASSEMBLED WITH '/J' SWITCH SET. / EQUATED SYMBOLS. BLKSIZE=0400 /256 WORDS/BLOCK COM= 0017 /COMPLEMENT ACCUMULATOR INCON= 0031 /EQUATED FROM CONSOLE! JMPC= JMP . /CURRENT PAGE JUMP INSTRUCTION JMSC= JMS . /CURRENT PAGE JMS INSTRUCTION NL0000= CLA /LOAD AC WITH 0000 NL0001= CLA IAC /LOAD AC WITH 0001 NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 NL2000= CLA CLL CML RTR /LOAD AC WITH 2000 NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 NL7775= CLA CLL CMA RTL /LOAD AC WITH 7775 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 NL7777= CLA CMA /LOAD AC WITH 7777 OUTCON= 0033 /EQUATED FROM CONSOLE! SBOOT= 7600 /SYSTEM BOOTSTRAP SBTFUN= 7602 /SYSTEM BOOTSTRAP FUNCTION SCRSIZE=7611 /SOFTWARE CORE SIZE SFILES= 7757 /FILES PASSES HERE SOUTFLS=7607 /OUTPUT FILE COUNT PASSED HERE SPARM= 7756 /EQUALS PARAMETER PASSED HERE SWAL= 7604 /SWITCHES /A-/L SWMX= 7605 /SWITCHES /M-/X SYSIO= 7640 /SYSTEM I/O ENTRY POINT TTY= 0003 /BASE DEVICE CODE OF CONSOLE WRITE= 4000 /SYSIO WRITE BIT / DEPENDENT DEFINITIONS. JMSSYSI=SYSIO&177+JMSC /CALL TO SYSIO FROM ITS PAGE KCCIOT= TTY^10+6002 /CLEAR KEYBOARD FLAG, AC, SET READER RUN KRBIOT= TTY^10+6006 /CLEAR KEYBOARD FLAG, SET READER RUN, LOAD CHARACTER KRSIOT= TTY^10+6004 /OR CHARACTER INTO AC, DON'T CLEAR KEYBOARD FLAG KSFIOT= TTY^10+6001 /SKIP ON KEYBOARD FLAG TFLIOT= TTY+1^10+6000 /SET OUTPUT FLAG TLSIOT= TTY+1^10+6006 /LOAD OUTPUT BUFFER, CLEAR FLAG TSFIOT= TTY+1^10+6001 /SKIP ON OUTPUT FLAG *0 /START AT THE BEGINNING CNT, .-. /TEMPORARY DIGCNT, .-. /DIGIT COUNTER DIGIT, .-. /LATEST INPUT DIGIT LINCNT, .-. /LINE COUNTER FOR BLKPRT NUMBER, .-. /LATEST NUMERIC INPUT VALUE PRTADR, .-. /BLKPRT'S PRINTING ADDRESS PRTPTR, .-. /BLKPRT'S OUTPUT POINTER TEMP, .-. /TEMPORARY *10 /GET TO AUTO-INDEX AREA XR1, .-. /AUTO-INDEX NUMBER 1 GPFELD, .-. /GETPUT'S TRANSFER FIELD GPUNIT, .-. /GETPUT'S UNIT NUMBER INCHAR, .-. /LATEST INPUT CHARACTER TERMSW, .-. /TERMINATOR FOR ZAP HANDLING / I/O ARGUMENTS WHICH MUST BE IN ORDER. GPBUFF, .-. /CORE ARGUMENT FOR GETPUT GPFUN, .-. /FUNCTION WORD GPBLK, .-. /BLOCK NUMBER *20 /GET PAST AUTO-INDEX AREA ECHOSW, 0 /ECHO SWITCH IT, TEXT "IT";0 /REST OF "EXIT" MESSAGE MP, TEXT "MP";0 /REST OF "DUMP" MESSAGE MPGMAX, -PAGMAX-1 /**** 7K **** 7747 **** 8K **** 7737 UPUMSG, TEXT "^U" /"^U" MESSAGE PGMAX, PAGMAX /**** 7K **** 0030 **** 8K **** 0040 /PUT THIS AFTER UPUMSG TO END THE TEXT SHUT, .-. /ZAP'S MODIFICATION SWITCH P7CH, .-. /SEVEN-BIT OUTPUT ROUTINE DCA P7TEMP /SAVE PASSED VALUE P7AGN, JMS I [CHKUP] /CHECK FOR <^P>, ETC. TAD ECHOSW /GET ECHO SWITCH SPA CLA /SKIP IF ECHO ON JMP P7OFF /JUMP IF ECHO OFF TAD P7TEMP /GET THE PASSED VALUE JMS P7OUT /TRY TO PRINT IT JMP P7AGN /GO CHECK INPUT WHILE WAITING P7OFF, JMS I [CHKUP] /CHECK FOR <^P>, ETC. JMP I P7CH /RETURN P7OUT, .-. /SEVEN BIT I/O ROUTINE P7TSF, TSFIOT /**** CONSOLE **** CIF MCS+10 P7JMP, JMP I P7OUT /**** CONSOLE **** JMS OUTCON P7TLS, TLSIOT /**** CONSOLE **** JMP I P7OUT ISZ P7OUT /BUMP RETURN JMP I P7OUT /TAKE SKIP RETURN P7TEMP, /TEMPORARY ROR6, .-. /ROTATE RIGHT SIX ROUTINE CLL RTR;RTR;RTR /MOVE OVER SIX JMP I ROR6 /RETURN SCRIBE, .-. /MESSAGE PRINTING ROUTINE SMA CLA /SKIP IF NO , WANTED JMS I [CRLF] /ELSE DO A , FIRST TAD I SCRIBE /GET THE ARGUMENT ISZ SCRIBE /BUMP PAST IT DCA TEMP /SAVE IT SCRLUP, TAD I TEMP /GET A PAIR JMS ROR6 /BSW JMS SCP6CH /PRINT IT TAD I TEMP /GET IT AGAIN JMS SCP6CH /PRINT IT ISZ TEMP /BUMP TO NEXT JMP SCRLUP /GO DO NEXT PAIR SCP6CH, .-. /SCRIBE'S SIX-BIT PRINT ROUTINE AND [77] /JUST SIX-BIT SNA /SKIP IF VALID JMP I SCRIBE /RETURN TO SCRIBE'S CALLER IF END JMS I [P6CH] /PRINT IT JMP I SCP6CH /RETURN TO SCRIBE CONTPRT,.-. /CONTROL PRINTING ROUTINE DCA P7TEMP /SAVE PASSED VALUE TAD ["^&177] /GET AN "^" JMS P7OUT /PRINT IT JMP .-1 /WAIT FOR IT TAD ["N-"^] /ADJUST TO LOWEST VALUE TAD P7TEMP /GET PASSED VALUE JMS P7OUT /PRINT IT JMP .-1 /WAIT FOR IT JMP I CONTPRT /RETURN ANSFER, TEXT "ANSFER";0 /REST OF "TRANSFER" MESSAGE BLKMSG, TEXT "BLOCK: " /"BLOCK: " MESSAGE FUNMSG, TEXT "FUNCTION: ";0 /"FUNCTION: " MESSAGE TBMSG, TEXT "TOO MANY!" /TOO MANY BLOCKS MESSAGE PAGE RESTRT, TSFIOT /**** CONSOLE **** JMP MORE TLSIOT /RAISE THE FLAG TFLIOT /FOR DECMATE MORE, JMS I [CRLF] /DO A , JMS SCRIBE /ASK FOR FUNMSG /"FUNCTION: " TAD DBUNIT /RESET THE UNIT DCA GPUNIT /FOR NEXT TRANSFER DCA GPFELD /RESET TRANSFER FIELD TAD [BUFFER] /RESET THE TRANSFER DCA GPBUFF /BUFFER ARGUMENT TAD PFRST/(FRST-1) /SETUP THE DCA XR1 /FIRST CHARACTER POINTER TAD [-4] /SETUP THE DCA TMPCNT /TABLE COUNT JMS I (TSTCHR) /GET AND TEST A CHARACTER TSTLUP, TAD I XR1 /COMPARE TO LIST ELEMENT SNA /SKIP IF DIFFERENT FROM LIST ELEMENT JMP FOUND1 /JUMP IF SAME ISZ TMPCNT /LOOKED FOR ALL YET? JMP TSTLUP /NO, GO BACK JMP MORE /YES, BARF FOUND1, TAD XR1 /GET MATCHING POINTER TAD (SCND-FRST-1) /ADJUST TO SECOND LIST ELEMENT DCA XR1 /SAVE FOR COMPARISON LATER JMS I (TSTCHR) /GET AND TEST A CHARACTER TAD I XR1 /BETTER MATCH SZA /SKIP IF SO JMP MORE /BARF TAD XR1 /GET MATCHING VALUE TAD (-SCND) /MAKE RELATIVE CLL RAL /*2 TAD (FINLST-1) /MAKE ABSOLUTE DCA XR1 /SAVE FINAL ADDRESS TAD I XR1 /GET THE FINISHING MESSAGE POINTER DCA TMPCNT /STICK IT IN-LINE NL7777 /INDICATE LACK OF , JMS SCRIBE /PRINT THE MESSAGE TMPCNT, .-. /WILL POINT TO PROPER MESSAGE TAD I XR1 /GET THE BRANCH ADDRESS DCA TMPCNT /SET IT UP JMP I TMPCNT /GO THERE DUMP, JMS GETBLK /GET THE DESIRED BLOCK NUMBER JMS GETNUM /GET THE DESIRED BLOCK COUNT CMA /INVERT FOR COUNTING DCA GETNUM /SAVE IT JMP DUMPIN /CONTINUE THERE DMPLUP, NL0002 /INDICATE ONE BLOCK READ JMS I [GETPUT] /GO READ IT IN JMS I [BLKPRT] /PRINT IT OUT ISZ GPBLK /BUMP TO NEXT BLOCK PFRST, FRST-1 /POINTER TO FRST; HERE IN CASE IT SKIPS! DUMPIN, ISZ GETNUM /MORE TO DO? JMP DMPLUP /YES, GO DO ANOTHER ONE JMP I [MORE] /NO, RESTART DUMP TRANSFE,NL0001 /**** 4K **** SKP TAD [7] /NOW HAVE 0 OR 10 DCA GPFELD /SAVE TRANSFER FIELD TAD TBUFF /GET OUR TRANSFER ADDRESS DCA GPBUFF /SET IT UP JMS GETBLK /GET THE INPUT BLOCK TRNSAGN,JMS GETNUM /GET THE TRANSFER COUNT CLL RAL /DOUBLE IT TO PAGE COUNT TAD MPGMAX /SUBTRACT LIMIT CLL /CLEAR LINK FOR TEST TAD PGMAX /ADD ON LEGAL RANGE SNL /SKIP IF OK JMP TRNSBAD /JUMP IF NOT CLL IAC /INCREMENT TO ORIGIN ONE AND INDICATE READING AND [37] /FOR 40 PAGE CALLS JMS I [GETPUT] /READ IN THE BUFFER JMS GETBLK /GET OUTPUT BLOCK STL /INDICATE WRITING JMS I [GETPUT] /WRITE OUT THE BUFFER JMP I [MORE] /RESTART DUMP TRNSBAD,NL0000 /INDICATE , WANTED JMS SCRIBE /TELL THEM TBMSG /THEY ASKED FOR TOO MUCH JMP TRNSAGN /TRY AGAIN DBUNIT, .-. /BOOTSTRAP UNIT TBUFF, BUFFER /**** 7K OR 8K **** 0000 PRTOCT, .-. /OCTAL OUTPUT ROUTINE DCA TEMP /SAVE PASSED VALUE TAD [-4] /SETUP THE DCA CNT /DIGIT COUNT OCTLUP, TAD TEMP /GET THE VALUE RAL /ROL 1 RTL /ROL 3 DCA TEMP /SAVE IT BACK TAD TEMP /GET NEW VALUE RAL /CORRECT IT AND [7] /JUST ONE DIGIT TAD ["0&77] /MAKE ASCII JMS I [P6CH] /PRINT IT ISZ CNT /DONE 4 YET? JMP OCTLUP /NO, GO BACK TAD [" &77] /YES, GET A JMS I [P6CH] /PRINT IT JMP I PRTOCT /RETURN GETNUM, .-. /GET A NUMBER ROUTINE NL0000 /INDICATE , JMS SCRIBE /ASK FOR NUMBMSG /"NUMBER :" JMS I [GETOCT] /GET NUMERIC RESPONSE JMP GETNUM+1 /<^U> GIVEN DCA GETBLK /SAVE TEMPORARILY JMS I [CHKDIG] /MAKE SURE AN ARGUMENT WAS GIVEN JMP GETNUM+1 /DO IT AGAIN IF NOT TAD GETBLK /GET GOOD VALUE JMP I GETNUM /RETURN GETBLK, .-. /GET BLOCK ARGUMENT ROUTINE / NL0000 /INDICATE , JMS SCRIBE /ASK FOR BLKMSG /"BLOCK: " JMS I [GETOCT] /GET NUMERIC RESPONSE JMP GETBLK+1 /<^U> GIVEN DCA GPBLK /SETUP THE DEDICATED ARGUMENT FOR GETPUT JMS I [CHKDIG] /MAKE SURE AN ARGUMENT WAS GIVEN JMP GETBLK+1 /DO IT AGAIN IF NOT JMP I GETBLK /RETURN NUMBMSG,TEXT "NUMBER: ";0 /NUMBER OF BLOCKS MESSAGE PAGE GETOCT, .-. /GET OCTAL INPUT ROUTINE DCA NUMBER /CLEAR THE NUMBER DCA DIGIT /AND THE LATEST DIGIT TAD (-5) /RESET THE DCA DIGCNT /DIGIT COUNTER GETNXT, JMS I (TTYIN) /GET A CHARACTER TAD (-"8!200) /SUBTRACT MAXIMUM VALUE CLL /CLEAR LINK FOR TEST TAD ("8-"0) /ADD ON LEGAL RANGE SNL /SKIP IF GOOD DIGIT JMP TESTMOR /JUMP IF NOT DCA DIGIT /SAVE GOOD DIGIT TAD NUMBER /GET LATEST VALUE CLL RAL;CLL RAL;CLL RAL /ROTATE CLEANLY TAD DIGIT /ADD ON LATEST DIGIT COLMORE,DCA NUMBER /SAVE IT BACK TAD INCHAR /GET THE CHARACTER ITSELF JMS I [P6CH] /PRINT IT ISZ DIGCNT /TOO MANY DIGITS? JMP GETNXT /NO, GO GET ANOTHER ONE JMP I GETOCT /YES, TAKE BAD RETURN TESTMOR,CLA /CLEAN UP TAD (TSTLST-1) /SETUP THE DCA XR1 /SEARCH POINTER TESTLUP,TAD I XR1 /GET A VALUE SNA /END OF LIST? JMP BADCHR /YES, BARF TAD INCHAR /NO, COMPARE TO LATEST SNA CLA /SKIP IF NOT A MATCH JMP GOTIT /JUMP IF A MATCH ISZ XR1 /BUMP PAST DISPATCH ADDRESS JMP TESTLUP /KEEP GOING GOTIT, TAD I XR1 /GET THE ROUTINE ADDRESS DCA TEMP /STASH IT JMP I TEMP /GO THERE GOTCTU, NL7777 /INDICATE NO , JMS SCRIBE /GIVE THEM UPUMSG /"^U" JMP I GETOCT /TAKE BAD RETURN GOTCOLO,TAD DIGIT /GET LATEST DIGIT DCA GPUNIT /USE AS UNIT FOR GETPUT DCA DIGIT /CANCEL LAST DIGIT TAD [-6] /RESET THE DCA DIGCNT /DIGIT COUNTER JMP COLMORE /CONTINUE THERE GOTALT, NL4000 /SET VALUE GOTUPRW,IAC /SET "^" VALUE GOTMINU,IAC /SET "-" VALUE GOTPLUS,IAC /SET "+" VALUE GOTSLSH,IAC /SET "/" VALUE GOTSEMI,IAC /SET ";" VALUE GOTLF, IAC /SET VALUE GOTCR, DCA TERMSW /SAVE (OR OTHER) VALUE ISZ GETOCT /BUMP TO GOOD RETURN TAD NUMBER /GET VALUE JMP I GETOCT /RETURN TO CALLER BADCHR, TAD [7] /GET A JMS P7CH /RING IT JMP GETNXT /TRY AGAIN CRLF, .-. /, ROUTINE CLA /CLEAN UP TAD ["M&37] /GET A JMS P7CH /PRINT IT TAD ["J&37] /GET A JMS P7CH /PRINT IT JMP I CRLF /RETURN CHKDIG, .-. /CHECK FOR ANY DIGITS TYPED ROUTINE TAD DIGCNT /GET CURRENT DIGIT COUNT TAD (5) /COMPARE TO ORIGINAL VALUE SZA CLA /SKIP IF NO CHANGE ISZ CHKDIG /BUMP RETURN IF THERE WERE ANY JMP I CHKDIG /RETURN AS NECESSARY / COMMAND TABLES. FINLST, MP /(DU)MP DUMP /A(DUMP) P /(ZA)P ZAP /A(ZAP) ANSFER /(TR)ANSFER TRANSFER /A(TRANSFER) IT /(EX)IT SBOOT /A(EXIT) FRST, -"D!200 /DUMP -"Z+"D /ZAP -"T+"Z /TRANSFER -"E+"T /EXIT SCND, -"U!200 /DUMP -"A!200 /ZAP -"R!200 /TRANSFER -"X!200 /EXIT TSTLST, -176; GOTALT / -175; GOTALT / -"^!200;GOTUPRW /"^" -";!200;GOTSEMI /";" -":!200;GOTCOLON /":" -"/!200;GOTSLSH /"/" -"-!200;GOTMINUS /"-" -"+!200;GOTPLUS /"+" -33; GOTALT / -"U!300;GOTCTU /<^U> -15; GOTCR / -12; GOTLF / DOTABL, DOCR / ADDRESS DOLF / ADDRESS DOSEMI /";" ADDRESS EXAMIN /"/" ADDRESS PLUS /"+" ADDRESS MINUS /"-" ADDRESS DOUPRW /"^" ADDRESS P, TEXT "P" /REST OF "ZAP" MESSAGE PAGE / CHARACTER UNPACKING ROUTINE FOR P?S/8 INPUT FILES. / INPUT REVERTS TO CONSOLE AT . IFNZRO .&7000 GIVCHR, .-. /GIVE ME A CHARACTER ROUTINE JMP I GIVTRIM /GO WHERE YOU HAVE TO GIVTRIM,GIVEOF /EXIT ROUTINE; INITIALIZED FOR FIRST FILE AND [77] /JUST SIX-BIT SNA /? JMP GIVEOL /YES TAD [-"\!300] /IS IT "\"? SNA /SKIP IF OTHER JMP GIVCOMMENT /JUMP IF IT MATCHES TAD [-"$+"\-100] /IS IT "$"? SNA /SKIP IF OTHER TAD [33-"$+" -1-100-37] /CONVERT "$" TO TAD [-" +"$] /IS IT A ? SZA /SKIP IF SO IAC /IS IT ? SNA /SKIP IF NEITHER JMP I GIVTRIM /IGNORE OR SPA /ALPHABETIC? TAD [100] /YES, ADD ON ASCII BIT TAD [37] /RESTORE THE CHARACTER TO SEVEN-BIT GVEOLIN,DCA INCHAR /SAVE FOR OTHERS TAD GCOMSW /ARE WE IGNORING COMMENTS? SZA CLA /SKIP IF NOT JMP I GIVTRIM /ELSE IGNORE THIS CHARACTER GTADINC,TAD INCHAR /GET THE CHARACTER BACK JMP I GIVCHR /RETURN TO MAIN GIVEOL, TAD (GVRSET) /SETUP THE DCA GIVTRIM /ALIGNED EXIT TAD GCOMSW /GET COMMENT SWITCH SNA CLA /SKIP IF SET JMP GIVNORMAL /JUMP IF NOT DCA GCOMSW /DELETE COMMENT MODE JMP I GIVTRIM /IGNORE THIS LAST GIVNORM,TAD ["M&37] /GET A JMP GVEOLINE /CONTINUE THERE GIVCOMM,ISZ GCOMSW /INDICATE COMMENT MODE JMP I GIVTRIM /IGNORE THIS CHARACTER GIVEOF, ISZ GFLPTR /BUMP TO NEXT FILE TAD I GFLPTR /GET THE FILE ARGUMENT SNA /END OF LIST? JMP GIVEOTEXT /YES, GO FINISH UP AND [7770] /NO, ISOLATE BLOCK BITS DCA GIVBLK /STORE IN-LINE TAD I GFLPTR /GET FILE ARGUMENT AGAIN AND [7] /JUST UNIT BITS TAD [1^100] /MAKE INTO ONE BLOCK READ DCA GIVFUN /STORE IN-LINE JMP GIVEOB /CONTINUE THERE GIVBAK, TAD I GIVPTR /GET A PAIR SNA /? JMP GIVEOF /YES RTR;RTR;RTR /MOVE DOWN THE HIGH-ORDER JMS GIVTRIM /AND CONVERT IT TO SEVEN-BIT TAD I GIVPTR /GET IT AGAIN JMS GIVTRIM /CONVERT LOW-ORDER TO SEVEN-BIT GVRSET, ISZ GIVPTR /BUMP TO NEXT TAD GIVPTR /GET CURRENT POINTER TAD (-GIVBUFFER-200) /COMPARE TO LIMIT PSYSIO, SZA CLA /SKIP IF BUFFER EXCEEDED JMP GIVBAK /ELSE KEEP GOING GIVEOB, JMS I PSYSIO/(SYSIO) /CALL I/O ROUTINES GIVBPT, GIVBUFFER /TRANSFER ADDRESS GIVFUN, 1^100+.-. /UNIT BITS WILL BE FILLED IN GIVBLK, .-. /BLOCK NUMBER WILL BE FILLED IN ISZ GIVBLK /BUMP FOR NEXT TIME TAD GIVBPTR/(GIVBUFFER) /RESET THE DCA GIVPTR /BUFFER POINTER JMP GIVBAK /KEEP GOING GIVEOTX,DCA ECHOSW /FORCE ECHO ON TAD JMPIMORE/(JMP I [MORE]) /GET THE ZAPPING INSTRUCTION DCA I (DOUPZAP) /RESTORE THE <^P> FUNCTION TAD GTADINCHAR/(TAD INCHAR) /RESTORE THE DCA I (EOFZAP) /INPUT ROUTINE JMP I (TTYIN+1) /CONTINUE THERE GCOMSW, 0 /COMMENT SWITCH GFLPTR, SFILES-1 /FILE POINTER GIVPTR, .-. /BUFFER POINTER GETPUT, .-. /GET OR PUT ROUTINE SZL /READING? JMP PUTOUT /NO, WRITING JMS ROR6 /ROTATE LEFT SIX RAR /(THE HARD WAY) DCA GPAGCT /SAVE FOR WRITING LATER PUTOUT, CLA RAR /4000 IF WRITING, 0 IF READING TAD GPAGCT /ADD ON PAGE COUNT TAD GPUNIT /ADD ON UNIT TAD GPFELD /ADD ON FIELD DCA GPFUN /STORE IN THE CALL NL7775 /SETUP THE ERROR DCA GPERCT /RETRY COUNTER GPAGAIN,JMS I (LINCTAPE) /CALL I/O ROUTINES GPBUFF /WITH THIS PARAMETER JMP GPERROR /BARF! JMP I GETPUT /RETURN TO CALLER GPERROR,ISZ GPERCT /TOO MANY ERRORS? JMP GPAGAIN /NO, TRY AGAIN CLA /CLEAN UP JMS SCRIBE /TELL THEM OF IOERMSG /I/O ERROR JMPIMOR,JMP I [MORE] /FORGET IT! GPAGCT, .-. /PAGE COUNT GPERCT, .-. /ERROR RETRY COUNT IFZERO 1 < SYSDEV, .-. /SYSTEM DEVICE HANDLER CLA /CLEAN UP TAD I SYSDEV /GET THE ARGUMENT POINTER DCA SYSBLK /STASH IT ISZ SYSDEV /BUMP TO ERROR RETURN TAD I SYSBLK /GET THE CORE ARGUMENT DCA SYSCORE /STASH IT ISZ SYSBLK /BUMP TO NEXT TAD I SYSBLK /GET THE FUNCTION WORD DCA SYSFUN /STASH IT ISZ SYSBLK /BUMP TO NEXT TAD I SYSBLK /GET THE BLOCK NUMBER DCA SYSBLK /STASH IT JMS I PSYSIO /CALL I/O ROUTINES SYSCORE,.-. /CORE ADDRESS SYSFUN, .-. /FUNCTION WORD SYSBLK, .-. /BLOCK NUMBER ISZ SYSDEV /BUMP TO SUCCESSFUL RETURN JMP I SYSDEV /RETURN > PAGE BLKPRT, .-. /BLOCK PRINT ROUTINE DCA UNSW /CLEAR <^N> SWITCH JMS I [CRLF] /DO A , JMS SCRIBE /TELL THEM BLKMSG /"BLOCK: " TAD GPUNIT /GET THE UNIT TAD ["0&77] /MAKE IT ASCII JMS I [P6CH] /PRINT IT TAD [":&77+7700] /GET A ":" JMS I [P6CH] /PRINT IT ALSO TAD GPBLK /GET THE BLOCK NUMBER JMS I [PRTOCT] /PRINT IT JMS I [CRLF] /DO A , TAD ["J&37] /GET A JMS P7CH /OUTPUT IT BPRZAP, TAD I (SPARM) /**** NOT /S **** LAS DCA BLKSWS /SAVE SWITCHES TAD BLKSWS /GET THEM BACK AND (BLKSIZE-1&7770)/JUST MAJOR ON-PAGE BITS DCA PRTADR /SAVE AS FIRST PRINTING ADDRESS NXTLINE,ISZ UNSW /<^N> HIT? SKP /SKIP IF NOT JMP I BLKPRT /STOP IMMEDIATELY SLAZAP, TAD BLKSWS /**** NOT /A **** 0000 AND [-BLKSIZE] /JUST PAGE BITS TAD PRTADR /NOW HAVE ABSOLUTE ADDRESS JMS I [PRTOCT] /PRINT IT AT LEFT MARGIN TAD [" &77] /GET A JMS I [P6CH] /PRINT IT TAD PRTADR /GET RELATIVE ADDRESS AGAIN TAD [BUFFER] /MAKE ABSOLUTE IN BUFFER ADDRESS DCA PRTPTR /SETUP FOR RETRIEVING TAD [7770] /RESET THE DCA LINCNT /LINE COUNTER PRTLUP, TAD I PRTPTR /GET A WORD JMS I [PRTOCT] /PRINT IT OUT ISZ PRTPTR /BUMP TO NEXT ISZ PRTADR /BUMP UP THE RELATIVE ADDRESS ISZ LINCNT /DONE ALL YET? JMP PRTLUP /NO, GO DO ANOTHER ONE SLKZAP, TAD PRTPTR /**** /K **** JMP NOASC TAD [7770] /BACKUP TO THE DCA PRTPTR /BEGINNING OF LINE TAD [7770] /RESET THE DCA LINCNT /LINE COUNTER TAD ("*&77) /GET A "*" JMS I [P6CH] /PRINT IT ASCLUP, TAD I PRTPTR /GET A PAIR JMS ROR6 /BSW JMS I [P6CH] /PRINT HIGH ORDER TAD I PRTPTR /GET LOW ORDER JMS I [P6CH] /PRINT IT ISZ PRTPTR /BUMP TO NEXT PAIR ISZ LINCNT /DONE ALL YET? JMP ASCLUP /NO, GO BACK TAD ("*&77) /GET A "*" JMS I [P6CH] /PRINT IT NOASC, JMS I [CRLF] /GOTO NEXT LINE TAD PRTADR /GET THE POINTER VALUE TAD [-BLKSIZE] /COMPARE TO LIMITING VALUE SZA CLA /SKIP IF AT END JMP NXTLINE /JUMP IF NOT JMP I BLKPRT /RETURN IF SO BLKSWS, .-. /SWITCHES FOR BLOCK PRINT ROUTINE UNSW, .-. /<^N> SWITCH CTLCTST,.-. /TEST FOR <^C>, ETC. CLA /CLEAN UP CHKKSF, KSFIOT /**** CONSOLE **** CIF MCS+10 CHKJMP, JMP I CTLCTST /**** CONSOLE **** JMS INCON CHKKRS, KRSIOT/OR KRBIOT /**** CONSOLE **** JMP I CTLCTST AND [177] /JUST SEVEN BIT DCA INCHAR /SAVE IT NL7775 /-3 TAD INCHAR /COMPARE TO <^C> SNA /SKIP IF OTHER ISZ I [SCRSIZE] /INDICATE TO THE MONITOR <^C> WAS HIT SPA SNA CLA /SKIP IF GREATER THAN <^C> JMP I [SBOOT] /ELSE GO BACK TO THE MONITOR CHKKCC, KCCIOT/OR 0000 /**** CONSOLE **** 0000 TAD INCHAR /GET THE CHARACTER BACK JMP I CTLCTST /RETURN IOERMSG,TEXT "I/O ERROR" /"I/O ERROR" MESSAGE CHKUP, .-. /CHECK FOR <^P> ETC. ROUTINE JMS CTLCTST /TEST FOR <^C>, ETC. SZA /SKIP IF NOTHING CAME IN TAD [-"Q!300] /ELSE TEST FOR <^Q> SNA /SKIP IF NEITHER JMP CHKCLR /IGNORE IT IAC /TAD (-"P+"Q)/IS IT <^P>? SNA /SKIP IF NOT JMP DOUP /JUMP IF SO IAC /TAD (-"O+"P)/IS IT <^O>? SNA /SKIP IF NOT JMP DOUO /JUMP IF SO IAC /TAD (-"N+"O)/IS IT <^N>? SNA /SKIP IF NOT JMP DOUN /JUMP IF SO TAD (-"S+"N) /IS IT <^S>? SZA CLA /SKIP IF SO JMP I CHKUP /RETURN IF NOT JMS CTLCTST /WAIT FOR ANOTHER CHARACTER TAD [-"Q!300] /IS IT <^Q>? SZA CLA /SKIP IF SO JMP .-3 /JUMP IF NOT CHKCLR, DCA INCHAR /OBLITERATE THE CHARACTER JMP I CHKUP /RETURN DOUP, DCA ECHOSW /FORCE ECHO ON NL0002/TAD ("P-"N) /INDICATE "P" JMS CONTPRT /PRINT ^P DOUPZAP,JMP CHKCLR /**** **** JMP I [MORE] DOUO, NL0001/TAD ("O-"N) /INDICATE "O" JMS CONTPRT /PRINT ^O NL4000 /SET INVERSION BIT TAD ECHOSW /INVERT CURRENT ECHO STATUS DCA ECHOSW /STORE IT BACK JMP CHKCLR /FINISH IT THERE DOUN,/ NL0000/TAD ("N-"N) /INDICATE "N" JMS CONTPRT /PRINT ^N NL7777 /INDICATE THAT DCA UNSW /<^N> WAS HIT JMP CHKCLR /FINISH IT THERE PAGE ZAP, JMS I (GETBLK) /GET THE BLOCK TO ZAP NL0002 /INDICATE ONE BLOCK READ JMS I [GETPUT] /READ IT IN JMS I [BLKPRT] /GO PRINT IT OUT DCA PRTADR /CLEAR THE RELATIVE POINTER BEGIN, JMS I [CRLF] /GET TO NEXT LINE NL7777 /INDICATE THE DCA SHUT /NON-STORE MODE BAGAIN, JMS I [GETOCT] /GET A NUMBER JMP BEGIN /BARF CLA /CLEAN UP TAD TERMSW /GET TERMINATOR TYPE SPA /SKIP IF NOT JMP DOALT /JUMP IF TAD (DOTABL) /ADD ON TABLE BASE DCA TEMP /STASH IT TAD I TEMP /GET DISPATCH ADDRESS DCA TEMP /STASH IT JMP I TEMP /BRANCH TO ROUTINE DOALT, CLA /CLEAN UP TAD ["$&77+7700] /GET A "$" JMS I [P6CH] /PRINT IT JMS COMMON /PROCESS ARGUMENT (IF ANY) STL CLA /INDICATE WRITING JMS I [GETPUT] /WRITE IT BACK JMP I [MORE] /RESTART DUMP EXAMIN, JMS I [CHKDIG] /CHECK IF ANY ARGUMENT JMP EXCURR /JUMP IF NONE TAD NUMBER /GET THE VALUE AND [-BLKSIZE] /CHECK FOR BAD BITS SZA CLA /SKIP IF OK JMP BEGIN /BARF TAD NUMBER /GET THE GOOD VALUE DCA PRTADR /USE AS LATEST ADDRESS TAD [" &77] /GET A JMS I [P6CH] /PRINT IT EXCURR, TAD ["/&77+7700] /GET A "/" JMS I [P6CH] /PRINT IT TAD PRTADR /GET RELATIVE POINTER AND [BLKSIZE-1] /JUST IN CASE TAD [BUFFER] /MAKE IT ABSOLUTE DCA TEMP /STASH IT TAD I TEMP /GET THE VALUE JMS I [PRTOCT] /PRINT IT JMP BAGAIN-1 /BACK FOR MORE DOCR, JMS COMMON /DO COMMON FUNCTION JMP BEGIN /KEEP GOING PLUS, NL7777 /INDICATE "+" MINUS, DCA TERMSW /SAVE "-" (OR "+") INDICATOR TAD INCHAR /GET OUR CHARACTER JMS I [P6CH] /PRINT IT JMS I [CRLF] /DO A , TAD NUMBER /GET ARGUMENT SNA /SKIP IF ANY NL0001 /ELSE ASSUME ONE ISZ TERMSW /SHOULD WE INVERT? CIA /YES JMP PLSMIN /CONTINUE THERE DOLF, JMS I [CRLF] /DO A , DOUPRW, JMS COMMON /DO COMMON FUNCTION ISZ PRTADR /BUMP TO NEXT ADDRESS PLSMIN, TAD PRTADR /ADD ON CURRENT VALUE AND [BLKSIZE-1] /JUST GOOD BITS DCA PRTADR /SAVE IT TAD PRTADR /GET IT BACK JMS I [PRTOCT] /PRINT IT JMP EXCURR /FINISH THERE DOSEMI, JMS COMMON /DO COMMON FUNCTION ISZ PRTADR /BUMP TO NEXT PGIVCHR,GIVCHR /POINTER TO GIVCHR; HERE IN CASE IT SKIPS! TAD INCHAR /GET THE ";" JMS I [P6CH] /PRINT IT JMP BAGAIN /KEEP GOING COMMON, .-. /COMMON STORE FUNCTION TAD SHUT /GET MODE INDICATOR SNA CLA /SKIP IF NOT ALLOWED TO STORE JMS I [CHKDIG] /CHECK IF ANY ARGUMENT JMP I COMMON /FORGET IT TAD PRTADR /GET THE ADDRESS AND [BLKSIZE-1] /JUST IN CASE TAD [BUFFER] /MAKE ABSOLUTE DCA TEMP /STASH IT TAD NUMBER /GET THE VALUE DCA I TEMP /STORE IT JMP I COMMON /RETURN TSTCHR, .-. /GET AND TEST A CHARACTER ROUTINE JMS TTYIN /GET A CHARACTER TAD (-"U!300) /IS IT <^U>? SZA CLA /SKIP IF SO JMP NOTUPU /JUMP IF NOT NL7777 /INDICATE NO , JMS SCRIBE /GIVE THEM UPUMSG /THE "^U" JMP I TSTCHR /DON'T PRINT IT NOTUPU, TAD INCHAR /GET THE CHARACTER BACK DCA TTYIN /SAVE IT TAD INCHAR /GET IT AGAIN JMS P7CH /PRINT THE CHARACTER TAD TTYIN /GET THE SAVED CHARACTER DCA INCHAR /RESTORE IT TAD INCHAR /GET THE CHARACTER AGAIN JMP I TSTCHR /RETURN FOR DECISION ELSEWHERE TTYIN, .-. /CHARACTER INPUT ROUTINE JMS I [CHKUP] /CHECK FOR INPUT EOFZAP, JMS I PGIVCHR/(GIVCHR)/**** **** TAD INCHAR SNA /SKIP IF ANYTHING THERE JMP .-3 /WAIT FOR SOMETHING TAD (-177) /SUBTRACT LIMIT CLL /CLEAR LINK FOR TEST TAD [37] /ADD ON RANGE SZL CLA /SKIP IF OUT OF RANGE TAD (-40) /ELSE REDUCE TO UPPER-CASE TAD INCHAR /GET ORIGINAL CHARACTER AT LEAST DCA INCHAR /SAVE IT FOR OTHERS TAD INCHAR /GET IT NOW JMP I TTYIN /RETURN P6CH, .-. /SIX-BIT PRINT ROUTINE TAD [" &77] /INVERT IT AND [77] /MASK IT OFF TAD [" &77] /INVERT IT AGAIN JMS P7CH /PRINT IT JMP I P6CH /RETURN PAGE / P?S/8 PDP-12 NON-SYSTEM HANDLER / P?S/8 LINCTAPE NON-SYSTEM HANDLER FOR THE PDP-12. / LAST EDIT: 17-APR-1986 10:00:00 CJL / MAY BE ASSEMBLED WITH '/J' SWITCH SET. / FEATURES: / 1) SUPPORT OF EIGHT UNITS (0-7). / 2) PARITY ERROR DETECTION AND RETRY (WITH COUNTER). / 3) NOT READY OR WRITE LOCK DETECTION AND RETRY (WITH COUNTER). / 4) WAITS IN PDP-8 MODE, THUS ALLOWING INTERRUPTS. XLIST OFF IFNDEF OFF IFNDEF ON IFNDEF BLKSIZE XLIST OFF IFZERO BLKSIZE-400 < XLIST ON; IFZERO 1 < / 5) SUPPORTS 256 OR 257 WORDS/BLOCK LINCTAPES AS A NON-STANDARD / FEATURE OF THIS PROGRAM. > XLIST OFF > IFZERO BLKSIZE-200 < XLIST ON; IFZERO 1 < / 5) SUPPORTS 128 OR 129 WORDS/BLOCK LINCTAPES. > XLIST OFF > XLIST ON PAGE /START ON A GOOD BOUNDARY HERE= . /WHERE WE ARE / DEFINITIONS. AXO= 0001 /LOAD EXTENDED OPERATIONS BUFFER XLIST OFF IFZERO BLKSIZE-200 < XLIST ON BLKSIZE=0200 /128 WORDS/BLOCK (ALSO ALLOWS 129) XLIST OFF > IFZERO BLKSIZE-400 < XLIST ON BLKSIZE=0400 /256 WORDS/BLOCK (ALSO ALLOWS 257) XLIST OFF > XLIST ON LDA= 1000 /LOAD ACCUMULATOR LINC= 6141 /GOTO LINC MODE XLIST OFF IFNDEF LINCTAPE XLIST ON LMR= 6151 /LOAD MAINTENANCE REGISTER LTLENGT=4000 /LINCTAPE BLOCK COUNT NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 NL7775= CLA CLL CMA RTL /LOAD AC WITH 7775 PDP= 0002 /GOTO PDP-8 MODE RDE= 0702 /READ A TAPE BLOCK REVISIO="B&77 /REVISION OF HANDLER TAC= 0003 /TAPE ACCUMULATOR TO ACCUMULATOR TMA= 0023 /LOAD TAPE MEMORY ADDRESS REGISTER TRC= 6152 /TAPE REGISTER CLOCK XFR= 6154 /TRANSFER SELECTED REGISTER TO ACCUMULATOR / DEVICE HANDLER HEADER BLOCK. XLIST OFF IFZERO BLKSIZE-200 < XLIST ON *"L&177;*"T&177;*"A&177 /GROUP NAME *-1 /GROUP COUNT *"L&177;*"T&177;*"A&177 /DEVICE NAME XLIST OFF > IFZERO BLKSIZE-400 < XLIST ON *"L&177;*"T&177;*"D&177 /GROUP NAME *-1 /GROUP COUNT *"L&177;*"T&177;*"D&177 /DEVICE NAME XLIST OFF > XLIST ON *LINCTAPE&177 /ENTRY POINT *LTLENGTH-1 /LENGTH EXPRESSED AS HIGHEST BLOCK *REVISION /REVISION OF HANDLER *HERE /RESET ORIGIN LINCTAP,.-. /ENTRY POINT NL0002 /SET INSTRUCTION FIELD BIT RDF /NOW HAVE CALLING FIELD TAD (CDF) /MAKE RETURN CIF CDF INSTRUCTION DCA LTEXIT /STORE IN-LINE FOR EXIT LATER TAD I LINCTAPE /GET PARAMETER POINTER DCA LTBLOCK /STASH IT ISZ LINCTAPE /BUMP TO ERROR RETURN TAD I LTBLOCK /GET TRANSFER ADDRESS DCA LTCORE /STASH IT ISZ LTBLOCK /BUMP TO NEXT TAD I LTBLOCK /GET FUNCTION WORD AND (70) /JUST TRANSFER FIELD TAD (CDF) /MAKE INTO CDF TRANSFER FIELD INSTRUCTION DCA LTSVFLD /STORE IN-LINE FOR LATER TAD I LTBLOCK /GET FUNCTION WORD AGAIN RAR /LOW-ORDER UNIT BIT TO LINK AND LT3/(3) /ISOLATE HIGH-ORDER UNIT BITS DCA LTEMP /SAVE FOR LATER TAD I LTBLOCK /U2 RW P0 P1 P2 P3 P4 F0 F1 F2 U0 U1 U2 RTL /P0 P1 P2 P3 P4 F0 F1 F2 U0 U1 U2 U2 RW AND LT3/(3) /P0 0 0 0 0 0 0 0 0 0 0 U2 RW CLL RTL /0 0 0 0 0 0 0 0 0 U2 RW 0 0 TAD (RDE) /0 0 0 0 1 1 1 0 0 U2 RW 1 0 DCA LTAPINST /SAVE "RDE" OR "WRI" OR "RDE U" OR "WRI U" IN-LINE TAD LTAPINST /GET TAPE INSTRUCTION BACK DCA LTAPTST /SAVE IN-LINE FOR TESTING ALSO TAD I LTBLOCK /GET FUNCTION WORD AGAIN RAL /MOVE UP AND XLIST OFF IFZERO BLKSIZE-400 < XLIST ON AND (7400) /ISOLATE PAGE BITS XLIST OFF > IFZERO BLKSIZE-200 < XLIST ON AND LT7600/(7600) /ISOLATE PAGE BITS XLIST OFF > XLIST ON DCA LTPAGCT /SAVE FOR COUNTING TAD LTSVFLD /RW 1 1 0 0 1 0 F0 F1 F2 0 0 1 AND (70) /RW 0 0 0 0 0 0 F0 F1 F2 0 0 0 CLL RTL /0 0 0 0 0 F0 F1 F2 0 0 0 0 0 STL IAC RTL /0 0 0 F0 F1 F2 0 0 0 0 1 1 0 RTL /0 F0 F1 F2 0 0 0 0 1 1 0 0 0 TAD LTEMP /0 F0 F1 F2 0 0 0 0 1 1 0 U0 U1 DCA LTAXO /STORE FIELD, NOPAUSE, EXTENDED ADDRESSING, /HIGH-ORDER UNIT BITS IN-LINE FOR LATER ISZ LTBLOCK /BUMP TO BLOCK NUMBER TAD I LTBLOCK /GET THE BLOCK NUMBER DCA LTBLOCK /STASH IT FOR LATER RIF /GET OUR FIELD TAD (CIF) /MAKE INTO CIF OUR FIELD INSTRUCTION DCA LTINHBT /STORE IN-LINE TO TEMPORARILY PREVENT /INTERRUPTS AS THE CODE GOES INTO LINC MODE TAD LTINHBT /GET CIF OUR FIELD INSTRUCTION BACK DCA LTINH2 /STORE IN-LINE AS BEFORE NL7775 /SETUP THE DCA LTRYCNT /ERROR RETRY COUNTER LTNEXT, TAD LTCORE /GET TRANSFER ADDRESS LTINH2, .-. /WILL BE CIF OUR FIELD TO INHIBIT INTERRUPTS LINC /GOTO LINC MODE TMA /LOAD TAPE MEMORY ADDRESS SETUP REGISTER LDA!20 /LOAD ACCUMULATOR WITH LTAXO, .-. /EXTENDED ADDRESSING, NOPAUSE, FIELD /AND HIGH-ORDER UNIT BITS AXO /LOAD EXTENDED OPERATIONS BUFFER LTAPTST,.-. /WILL BE "RDE" OR "WRI" OR "RDE U" OR "WRI U" 0 /MUST USE BLOCK ZERO! LDA!20; 5000 /GET REGISTER SETTING BITS PDP /BACK TO PDP-8 MODE LMR /LOAD MAINTENANCE REGISTER XFR /GET DRIVE STATUS BACK RTR /DRIVE OK TO LINK SNL CLA /SKIP IF DRIVE OK JMP LTERR /JUMP IF NOT LINC /GOTO LINC MODE LTAPINS,.-. /WILL BE "RDE" OR "WRI" OR "RDE U" OR "WRI U" LTBLOCK,.-. /WILL BE DESIRED BLOCK NUMBER PDP /BACK TO PDP-8 MODE TAD LTCORE /GET TRANSFER ADDRESS TAD (BLKSIZE) /NOW HAVE ENDANGERED WORD'S ADDRESS DCA LTEMP /SAVE IT LTSVFLD,.-. /WILL BE CDF TRANSFER FIELD TAD I LTEMP /GET ENDANGERED WORD DCA LTSAVIT /SAVE IT TAD (100) /GET TEST BIT LMR /LOAD MAINTENANCE REGISTER JMP .-1 /WILL SKIP WHEN TAPE IS DONE LT7600, CLA!400 /CLEAN UP TAD LTSAVIT /GET ENDANGERED WORD DCA I LTEMP /RESTORE IT LTINHBT,.-. /WILL BE CIF OUR FIELD INSTRUCTION LINC /GOTO LINC MODE LT3, TAC /GET TAPE ACCUMULATOR PDP /BACK TO PDP-8 MODE CLL IAC /LINK IS SET IF NO PARITY ERRORS IF /READING, GARBAGE VALUE IF WRITING CLA IAC RTL /FORM (WRI&4)+(RDE&2&(NO PARITY ERROR)) AND LTAPINS /AC=4 (IF WRITING) OR AC=2 (IF READING /AND NO PARITY ERROR) SNA CLA /SKIP IF WRITING OR NO PARITY ERROR WHILE READING JMP LTERR /JUMP ON READ PARITY ERROR TAD LTEMP /GET PROTECTED ADDRESS DCA LTCORE /USE NEXT TIME FOR TRANSFER ADDRESS ISZ LTBLOCK /BUMP TO NEXT BLOCK TAD LTPAGCT /GET THE PAGE COUNT XLIST OFF IFZERO BLKSIZE-400 < XLIST ON TAD (-BLKSIZE) /ACCOUNT FOR LATEST TRANSFER XLIST OFF > IFZERO BLKSIZE-200 < XLIST ON TAD LT7600/(-200) /ACCOUNT FOR LATEST TRANSFER XLIST OFF > XLIST ON SNA /ANY LEFT TO DO? JMP LTDONE /NO, RETURN TO CALLER DCA LTPAGCT /YES, SAVE FOR NEXT TIME JMP LTNEXT /GO DO NEXT BLOCK LTERR, ISZ LTRYCNT /TOO MANY ERRORS? JMP LTNEXT /NO, GO READ IT AGAIN NL4000 /GET PRESET BIT TRC /RESET THE TAPE CONTROLLER SKP /FORGET IT LTDONE, ISZ LINCTAPE /BUMP TO SUCCESSFUL RETURN LTEXIT, .-. /WILL BE CIF CDF RETURN FIELD JMP I LINCTAPE /RETURN TO CALLER LTCORE, .-. /TRANSFER ADDRESS LTEMP, .-. /TEMPORARY LTPAGCT,.-. /PAGE COUNTER LTRYCNT,.-. /RETRY COUNTER LTSAVIT,.-. /TEMPORARY PAGE GIVBUFF=. /P?S/8 FILE INPUT BUFFER / REGULAR LINC-8 LINCTAPE HANDLER XLIST OFF IFNDEF OFF IFNDEF ON XLIST ON / P?S/8 NON-SYSTEM LINCTAPE HANDLER FOR THE REGULAR (UN-MODIFIED) LINC-8. / LAST EDIT: 17-APR-1986 10:00:00 CJL / MAY BE ASSEMBLED WITH '/J' SWITCH SET. / FEATURES: / 1) SUPPORT OF EIGHT UNITS (0-7). / 2) STORAGE OF LATEST BLOCK SEARCHED. / 3) CUSTOM OVERSHOOT FACTOR. / 4) CORRECT INITIAL SEARCH DIRECTION BY COMPARING THE DESIRED / BLOCK TO THE LATEST BLOCK SEARCHED, OFFSET BY THE CUSTOM / OVERSHOOT FACTOR. / 5) PARITY ERROR DETECTION. XLIST OFF IFNDEF BLKSIZE IFZERO BLKSIZE-200 < XLIST ON / 6) SUPPORTS 128 WORDS/BLOCK LINCTAPES. XLIST OFF > IFZERO BLKSIZE-400 < XLIST ON / 6) SUPPORTS 256 WORDS/BLOCK LINCTAPES AS A NON-STANDARD FEATURE / OF THIS HANDLER. XLIST OFF > XLIST ON / RESTRICTIONS: / 1) NO RETRIES ON ERROR. / 2) LATEST BLOCK SEARCHED IS IGNORANT OF CHANGE OF LOGICAL UNIT. PAGE /START ON A GOOD BOUNDARY HERE= . /WHERE WE ARE / DEFINITIONS. XLIST OFF IFZERO BLKSIZE-200 < XLIST ON BLKSIZE=0200 /128 WORDS/BLOCK XLIST OFF > IFZERO BLKSIZE-400 < XLIST ON BLKSIZE=0400 /256 WORDS/BLOCK XLIST OFF > XLIST ON IAAC= 6171 /READ LINC "A" REGISTER IACA= 6167 /LOAD LINC "A" REGISTER IACF= 6175 /LOAD LINC INDICATOR FLIP-FLOPS ICON= 6141 /LOAD INTERFACE CONTROL INTS= 6147 /READ INTERFACE STATUS IZSA= 6173 /LOAD LINC "Z" REGISTER INTO LINC "A" REGISTER LTLENGT=4000 /LINCTAPE BLOCK COUNT XLIST OFF IFNDEF L8TAPE XLIST ON NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 NL7777= CLA CMA /LOAD AC WITH 7777 REVISIO="A&77 /REVISION OF HANDLER / DEVICE HANDLER HEADER BLOCK. XLIST OFF IFZERO BLKSIZE-200 < XLIST ON *"L&177;*"I&177;*"N&177 /GROUP NAME *-1 /GROUP COUNT *"L&177;*"I&177;*"N&177 /DEVICE NAME XLIST OFF > IFZERO BLKSIZE-400 < XLIST ON *"L&177;*"I&177;*"D&177 /GROUP NAME *-1 /GROUP COUNT *"L&177;*"I&177;*"D&177 /DEVICE NAME XLIST OFF > XLIST ON *L8TAPE&177 /ENTRY POINT *LTLENGTH-1 /LENGTH EXPRESSED AS HIGHEST BLOCK *REVISION /REVISION OF HANDLER *HERE /RESET ORIGIN L8TAPE, .-. /ENTRY POINT NL0002 /SET INSTRUCTION FIELD BIT RDF /GET CALLING FIELD TAD (CDF) /NOW HAVE CIF CDF RETURN FIELD INSTRUCTION DCA L8OUT /STORE IN-LINE TAD I L8TAPE /GET PARAMETER POINTER DCA L8WAIT /STASH IT TAD I L8WAIT /GET TRANSFER ADDRESS DCA L8BUFF /SAVE IT ISZ L8WAIT /BUMP TO NEXT TAD I L8WAIT /GET FUNCTION WORD RAL /MOVE UP XLIST OFF IFZERO BLKSIZE-400 < XLIST ON AND (-BLKSIZE) /JUST PAGE BITS XLIST OFF > IFZERO BLKSIZE-200 < XLIST ON AND L87600/(-BLKSIZE) /JUST PAGE BITS XLIST OFF > XLIST ON DCA L8PCNT /SAVE AS PAGE COUNT RAR /RECOVER READ/WRITE BIT TAD L83/(3) /ADD ON BLOCK MODE BITS DCA L8FUNCT /SAVE AS TAPE FUNCTION TAD I L8WAIT /GET FUNCTION WORD AGAIN AND L870/(70) /JUST FIELD BITS TAD (CDF) /TURN INTO TRANSFER CDF DCA L8TRFLD /SAVE IN-LINE TAD I L8WAIT /L RW P P P P P F F F U U U RAR /U L RW P P P P P F F F U U AND L83/(3) /U 0 0 0 0 0 0 0 0 0 0 U U IACF /LOAD UNIT FLIP-FLOPS ONLY! NL7777 CML RAR /1 UC 1 1 1 1 1 1 1 1 1 1 1 TAD L83/(3) /L U 0 0 0 0 0 0 0 0 0 1 0 DCA L8UNIT /SAVE UNIT AND SEARCH BITS ISZ L8WAIT /BUMP TO BLOCK ARGUMENT TAD L8BLOCK /GET CURRENT BLOCK CIA /INVERT TAD I L8WAIT /FORM DIFFERENCE WITH DESIRED TAD L8OVSHT /ADD ON OVERSHOOT FACTOR DCA L8DIR /SAVE AS INITIAL DIRECTION TAD I L8WAIT /GET BLOCK ARGUMENT DCA L8BLOCK /SET IT UP ISZ L8TAPE /BUMP TO ERROR RETURN L84002, IOF /PREVENT PROBLEMS! L8NEXT, ISZ L8BLOCK /BUMP UP FOR ONE'S COMPLEMENT L83, 3 /BLOCK 7777 WOULD SKIP! XLIST OFF IFZERO BLKSIZE-400 < XLIST ON TAD (-BLKSIZE) /SETUP XLIST OFF > IFZERO BLKSIZE-200 < XLIST ON TAD L87600/(-BLKSIZE) /SETUP XLIST OFF > XLIST ON DCA L8COUNT /PAGE WORD COUNT DCA L8CHKSM /CLEAR CHECKSUM TAD L8DIR /GET INITIAL DIRECTION RAL /INTO LINK L87600, CLA!400 /CLEAN UP DCA L8DIR /ALL OTHERS FORWARD TAD L8UNIT /D U 0 0 0 0 0 0 0 0 0 1 0 ICON /LOAD UNIT AND SEARCH CML RAR /0 DC U 0 0 0 0 0 0 0 0 0 1 L8SER1, ICON /LOAD NEW DIRECTION L8SER2, JMS L8WAIT /WAIT FOR A BLOCK MARK SMA /NEGATIVE BLOCK NUMBERS? CML /YES, REVERSE OUR INTENT TAD L8BLOCK /COMPARE TO DESIRED BLOCK SNA /SKIP IF NOT FOUND JMP L8COULD /JUMP IF POSSIBLE SZL /RIGHT DIRECTION ANYWAY? JMP L8SER2 /YES, JUST KEEP GOING SMA CLA /REVERSE? STL RAR /NO, FORWARD ICON /STOP THE TAPE IAC /NOW SET TO CHANGE DIRECTION JMP L8SER1 /TURN AROUND THERE L8COULD,SNL CLA /GOING FORWARD? JMP L8SER2 /NO, UNDERSHOOT AND TRY AGAIN TAD L8FUNCT /GET A 3 ICON /GOTO BLOCK MODE SPA /WRITING? TAD L84002/(4002) /YES ICON /REDUNDANT OR TURN WRITERS ON SZL CLA /READING? JMS L8WAIT /YES, WAIT FOR GUARD WORD L8TRFLD,.-. /WILL BE CDF TRANSFER FIELD L8TRLUP,TAD I L8BUFF /GET A WORD JMS L8WAIT /WAIT FOR IT DCA I L8BUFF /PUT A WORD TAD I L8BUFF /RETRIEVE WORD TAD L8CHKSM /UPDATE CHECKSUM DCA L8CHKSM /STORE IT BACK ISZ L8BUFF /BUMP TO NEXT WORD L870, 70 /JUST IN CASE ISZ L8COUNT /DONE WITH THIS BLOCK? JMP L8TRLUP /NO, KEEP GOING TAD L8CHKSM /GET CHECKSUM IN CASE WRITING CIA /INVERT IT JMS L8WAIT /WRITE IT OR READ IN NEW ONE TAD L8CHKSM /WRITE ERROR IMPOSSIBLE SZA CLA /SKIP IF NO READ PARITY ERROR JMP L8ERROR /BARF JMS L8WAIT /WAIT FOR LAST TO BE WRITTEN STL CLA /CLEAN UP TAD L8PCNT /GET PAGE COUNT XLIST OFF IFZERO BLKSIZE-400 < XLIST ON TAD (-BLKSIZE) /DECREMENT IT XLIST OFF > IFZERO BLKSIZE-200 < XLIST ON TAD L87600/(-BLKSIZE) /DECREMENT IT XLIST OFF > XLIST ON SNA /DONE? JMP L8DONE /YES, FINISH UP THERE DCA L8PCNT /NO, SAVE FOR NEXT TIME JMP L8NEXT /GO DO ANOTHER BLOCK L8DONE, ISZ L8TAPE /BUMP TO GOOD RETURN L8ERROR,ICON /STOP THE TAPE L8OUT, .-. /WILL BE CIF CDF RETURN FIELD JMP I L8TAPE /RETURN L8WAIT, .-. /WAIT ROUTINE IACA /LOAD A IN CASE WRITING CLA /CLEAN UP TAD L87/(7) /GET CLEAR BITS ICON /CLEAR TAPE FLAG CLA /CLEAN UP L87, INTS /GET STATUS SMA /SKIP IF TAPE FLAG UP JMP L87 /JUMP IF NOT STL RAR /SAVE DIRECTION, FORM FUNCTION MASK AND L8FUNCT /NOW HAVE READ/WRITE FUNCTION SPA CLA /READING? IZSA /NO, RESTORE A IAAC /GET A EITHER WAY JMP I L8WAIT /RETURN L8BLOCK,.-. /BLOCK TEMPORARY L8BUFF, .-. /BUFFER POINTER L8CHKSM,.-. /CHECKSUM TEMPORARY L8COUNT,.-. /PAGE WORD COUNT L8DIR, .-. /CURRENT DIRECTION L8FUNCT,.-. /FUNCTION TEMPORARY L8OVSHT,7771 /OVERSHOOT FACTOR L8PCNT, .-. /PAGE COUNT L8UNIT, .-. /UNIT AND SEARCH TEMPORARY PAGE BUFFER= . /TRANSFER, ETC. BUFFER STARTS HERE PAGMAX= SBOOT-BUFFER%400^2 /MAXIMUM PAGES TO TRANSFER IN 4K IFNZRO .&177 LTDUMP= . /LTDUMP SYSTEM STARTS HERE L70, 70 /CONSTANT 0070; HERE IN CASE WE'RE CHAINED TO TAD I [SBOOT] /GET BOOTSTRAP INSTRUCTION TAD (-JMSSYSIO) /COMPARE TO POSSIBLE VALUE SNA CLA /SKIP IF OTHER JMP CHKCOVRLAY /JUMP IF IT MATCHES ISZ I (CHKKRS) /TURN "KRSIOT" ISZ I (CHKKRS) /INTO "KRBIOT" DCA I (CHKKCC) /DESTROY "KCCIOT" CHKCOVR,NL0002 /SET "C" BIT MASK AND I [SCRSIZE] /GET THE "C" BIT SNA CLA /SKIP IF SET JMP TESTA /JUMP IF OFF TAD P7JMP /GET THE "JMP I P7OUT" DCA P7TLS /STORE OVER THE "TLSIOT" TAD (JMS OUTCON) /GET THE OUTPUT CALLING INSTRUCTION DCA P7JMP /STORE OVER THE "JMP P7AGN" TAD I [SCRSIZE] /GET THE CORE SIZE WORD RTR;RAR /MOVE DOWN THE MCS BITS AND L70/(70) /ISOLATE MCS BITS TAD (CIF 10) /FORM "CIF MCS+10" INSTRUCTION DCA P7TSF /STORE OVER THE "TSFIOT" TAD I (CHKJMP) /GET THE "JMP I CTLCTST" DCA I (CHKKRS) /STORE OVER THE "KRSIOT" TAD (JMS INCON) /GET THE INPUT CALLING INSTRUCTION DCA I (CHKJMP) /STORE OVER THE "JMP I CTLCTST" TAD P7TSF /GET THE "CIF MCS+10" INSTRUCTION DCA I (CHKKSF) /STORE OVER THE "KSFIOT" DCA I (CHKKCC) /DESTROY "KCCIOT" TAD (MORE&177+JMPC) /GET "JMP MORE" INSTRUCTION DCA I (RESTRT) /PREVENT TTY: INSTRUCTIONS TESTA, TAD I (SWAL) /GET THE SWITCHES /A-/L SMA CLA /SKIP IF /A IS SET DCA I (SLAZAP) /USE RELATIVE VALUES ONLY NL0002 /GET /K MASK AND I (SWAL) /JUST /A SNA CLA /SKIP IF SET JMP TESTMR /JUMP IF NOT TAD (NOASC&177+JMPC) /GET DESTROYING INSTRUCTION DCA I (SLKZAP) /PREVENT ASCII PRINTOUT TESTMR, TAD I (SBTFUN) /GET BOOTSTRAP FUNCTION RAR;CML RAL /INVERT LOW-ORDER BIT AND [7] /JUST UNIT BITS DCA I (DBUNIT) /STORE FOR OTHERS TAD I [SCRSIZE] /GET CORE SIZE WORD AND L70/(70) /JUST LOGICAL SIZE BITS SZA CLA /SKIP IF 4K JMP GOT8K /JUMP IF 8K OR MORE TAD I (SWAL) /GET /A-/L RTL /C TO AC[0] SMA CLA /SKIP IF /C SET JMP USE4K /FORGET IT TAD I [SCRSIZE] /GET CORE SIZE WORD AGAIN AND (700) /JUST MAXIMUM CORE SIZE BITS SZA CLA /SKIP IF 4K JMP GOT8K /JUST USE ANOTHER FIELD NL0002 /SETUP "C" BIT MASK AND I [SCRSIZE] /GET THE "C" BIT SZA CLA /SKIP IF OFF JMP USE4K /FORGET IT IF ON TAD I [SCRSIZE] /GET THE CORE SIZE WORD AGAIN AND (7000) /JUST PHYSICAL SIZE BITS TAD (7000) /SEE IF 8K OR LARGER SPA CLA /SKIP IF SO JMP USE4K /JUMP IF NOT GOT7K, TAD [-10] /USE AT LEAST SOME EXTRA GOT8K, TAD (40-PAGMAX) /USE 40 ISZ GETFLD /USE FIELD ONE ISZ GETBUF /USE LOCATION 10000 USE4K, TAD (PAGMAX) /GET 4K BUFFER COUNT DCA PGMAX /STASH IT TAD PGMAX /GET IT BACK CMA /INVERT IT DCA MPGMAX /STORE NEGATIVE FORM AS WELL GETFLD, TAD TRINST /**** 7K OR 8K **** TAD TRINST+1 DCA I (TRANSFER) /STORE PROPER INSTRUCTION GETBUF, TAD TRBUFF /**** 7K OR 8K **** TAD TRBUFF+1 DCA I (TBUFF) /STORE PROPER VALUE TAD I (SOUTFLS) /GET OUTPUT FILE COUNT TAD I (GFLPTR) /UPDATE FILE POINTER DCA I (GFLPTR) /STORE IT BACK JMS I (LINCHK) /CHECK LINCTAPE CONFIGURATION TAD I (SWMX) /GET /M-/X SWITCHES AND [40] /JUST /S SWITCH SZA CLA /SKIP IF OFF JMP I [MORE] /JUMP IF ON TAD (LAS) /GET CONSOLE INSTRUCTION DCA I (BPRZAP) /STORE OVER CODE JMP I [MORE] /GO START IT UP TRBUFF, BUFFER /4K VALUE 0 /7K OR 8K VALUE TRINST, SKP /4K VALUE NL0001 /7K OR 8K VALUE PAGE LINCHK, .-. /LINCTAPE CHECK ROUTINE LINC /GOTO L...MODE COM /TRY TO COMPLEMENT THE AC PDP /BACK TO GOODY MODE IAC /DID WE COMPLEMENT? SNA CLA /SKIP IF NOT JMP I LINCHK /RETURN, WE'RE A -12 NL7777 /SET SOME BITS IACA /LOAD "A" REGISTER LMVCNT, CLA!400 /CLEAN UP IAAC /READ THEM BACK IAC /INCREMENT SZA CLA /SKIP IF WE'RE A LINC-8 JMP NOHARDWARE /ELSE BARF L8MOVE, TAD I L8PTR /GET A WORD DCA I L12PTR /PUT A WORD ISZ L8PTR /BUMP TO NEXT ISZ L12PTR /LIKEWISE ISZ LMVCNT /DONE YET? JMP L8MOVE /NO, GO BACK JMP I LINCHK /YES, RETURN NOHARDW,JMS SCRIBE /TELL THEM NOLMSG /THEY LOSE JMP I [SBOOT] /GOODBYE! L8PTR, L8TAPE&7600 /WHERE LINC-8 LINCTAPE ROUTINE IS L12PTR, LINCTAPE&7600 /WHERE PDP-12 LINCTAPE ROUTINE IS IFNZRO LINCTAPE-L8TAPE&177 NOLMSG, TEXT "NO LINCTAPE HARDWARE!" PAGE ENDLTDU=. /END OF LTDUMP $ /THAT'S ALL FOLK!