/P?S/8 DECTAPE-LINCTAPE COPY PROGRAM /FOR USE ON MODIFIED LINC-8 / LAST EDIT: 23-JUN-1978 02:10:59 CJL / EQUATED SYMBOLS NL0001= CLA IAC /LOAD AC WITH 0001 NL3777= CLA CLL CMA RAR /LOAD AC WITH 3777 NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 NL7775= CLA CLL CMA RTL /LOAD AC WITH 7775 SBOOT= 7600 /MONITOR BOOTSTRAP SCRSIZE=7611 /SOFTWARE CORE SIZE HERE SWAL= 7604 /SWITCHES /A-/L SYSIO= 7640 /SYSTEM I/O ENTRY WRITE= 4000 /SYSIO WRITE BIT PAGE 0 CHAR, 0 /INPUT BUFFER COUNT, 0 /VERIFY COUNT DEVSW, 0 /DEVICE NEEDED SWITCH FCHAR, 0 /FIRST COMPARE CHARACTER FINBLK, -1 /FIRST INPUT BLOCK FOTBLK, 0 /FIRST OUTPUT BLOCK INCR, 0 /INCREMENT INDEV, 0 /INPUT DEVICE ZBLOCK 10-. /GET TO AUTO-INDEX AREA INFLD, 0 /INPUT FIELD INUNIT, 0 /INPUT UNIT LATEST, 0 /LATEST DIGIT XR1, 0 /INDEX NUMBER 1 XR2, REPADR-1 /INDEX NUMBER 2 LENGTH, 0 /I/O CALL LENGTH LINBLK, 0 /LAST INPUT BLOCK NUMBER, 0 /INPUT ROUTINE RESULT ZBLOCK 20-. /GET PAST AUTO-INDEX AREA OUTDEV, 0 /OUTPUT DEVICE OUTUNT, 0 /OUTPUT UNIT RWINCR, CORE2-CORE%200 /BASIC R/W BUFFER SCHAR, 0 /SECOND COMPARE CHARACTER SEPSW, 0 /SEPARATOR SWITCH STEMP, 0 /TRIM ROUTINE TEMPORARY UNIT, 0 /UNIT TEMPORARY VERCNT, -3 /VERIFY COUNT VERFLD, 0 /VERIFY FIELD VINCR, SBOOT-CORE2%200 /ADDITIONAL AMOUNT IF NON-VERIFY VSW, 0 /VERIFY SWITCH INPUT, 0 /INPUT ROUTINE KSF /WAIT FOR JMP .-1 /A CHARACTER JMS CTLCHK /CHECK FOR ^C TAD CHAR /RESTORE IT JMP I INPUT /RETURN L7600, /CONSTANT 7600 BAD, CLA+400 /CLEAN UP JMS I (SCRIBE /COMPLAIN OF BADMSG /BAD VALUE JMP SYSCPY-1 /START OVER AGAIN CTLCHK, 0 /<^C> CHECK ROUTINE CLA /JUST IN CASE KSF /FLAG UP? JMP I CTLCHK /NO, FORGET IT KRS /YES, READ IN THE CHARACTER AND (177 /JUST 7-BIT TAD (-3 /<^C>? SPA SNA /SKIP IF NOT -<^C> JMP I L7600 /JUMP IF SO KRB /GET AGAIN, CLEARING FLAG AND (177 /JUST 7-BIT TAD (-22 /<^R>? SNA /SKIP IF NOT JMP I (SYSAGN /JUMP IF SO TAD (2 /<^P>? SNA /SKIP IF NOT JMP SYSCPY-1 /RESTART IF SO TAD (20 /RESTORE CHARACTER DCA CHAR /SAVE IT FOR OTHERS JMP I CTLCHK /RETURN PRTOCT, 0 /OCTAL PRINT ROUTINE DCA FCHAR /SAVE VALUE TAD [-4 /SETUP DCA SCHAR /COUNT PLOOP, TAD FCHAR /GET VALUE RTL /ROTATE RAL /AROUND DCA FCHAR /SAVE IT BACK TAD FCHAR /GET AGAIN RAL /POSITION IT AND [7 /JUST DIGIT BITS TAD ["0&177 /MAKE IT ASCII JMS I [OUTPUT /PRINT IT ISZ SCHAR /DONE ALL YET ? JMP PLOOP /NO, GO BACK JMP I PRTOCT /RETURN PAGE SYSCPY, JMS I [SCRIBE /ANNOUNCE OUR PRESENCE STARMSG /WITH THIS DCA SEPSW /INDICATE "<" IS DELIMITER STA /INDICATE DEVICE REQUIRED JMS I [GETNUM /GET OUTPUT BLOCK SYSCPY /RESTART ADDRESS OUTDEV /PUT DEVICE ADDRESS HERE OUTUNT /OUTPUT UNIT HERE DCA FOTBLK /SAVE FIRST OUTPUT BLOCK ISZ SEPSW /INDICATE "<" IS NOT DELIMITER STA /INDICATE DEVICE IS REQUIRED JMS I [GETNUM /GET INPUT BLOCK SYSCPY /RESTART HERE INDEV /PUT DEVICE ADDRESS HERE INUNIT /INPUT UNIT HERE DCA FINBLK /SAVE FIRST INPUT BLOCK TAD I [SWAL /GET SWITCHES /A, ETC. SMA CLA /SKIP IF /A JMP ASKLST /JUMP IF NOT JMS I [SCRIBE /TELL THEM NMBLKMSG /WE NEED BLOCK COUNT JMS I [GETNUM /GET THE NUMBER .-3 /FOR RESTART LINBLK /DUMMY UNIT TAD [-1 /BACKUP TAD FINBLK /ADD ON FIRST JMP ASKCOM /FINISH THERE ASKLST, JMS I [SCRIBE /TELL THEM WE NEED LIBMSG /THE LAST INPUT BLOCK JMS I [GETNUM /GET THE NUMBER ASKLST /FOR RESTART LINBLK /DUMMY UNIT ASKCOM, DCA LINBLK /SAVE LAST INPUT BLOCK VQUES, JMS I [SCRIBE /ASK FOR VMSG /VERIFICATION VQUES2, JMS INPUT /GET REPLY TAD [-"Y+200 /IS IT "Y"? SZA /SKIP IF SO JMP TRYNO /JUMP IF NOT STA /INDICATE NO , JMS I [SCRIBE /ANSWER YESMSG /"YES!" STA /INDICATE VERIFYING NOIN, DCA VSW /SAVE AS VERIFY SWITCH TAD VSW /GET VERIFY SWITCH SNA CLA /SKIP IF ON TAD VINCR /ADD ON ADDITIONAL PAGES TAD RWINCR /USE THIS AT LEAST DCA INCR /AS INCREMENT SYSAGN, TAD [JMP BAD /SETUP DCA I [DONE /NO TRANSFER TRAP TAD FOTBLK /GET FIRST OUTPUT BLOCK DCA I [OUTBLK /PUT INTO CALL TAD FINBLK /GET STARTING BLOCK JMP I [LOOP /GO BABY GO ! TRYNO, TAD [-"N+"Y /IS IT "N"? SZA CLA /SKIP IF SO JMP NOBARF /UGH! STA /INDICATE NO , JMS I [SCRIBE /TELL THEM NOMSG /"NO!" JMP NOIN /CONTINUE THERE NOBARF, TAD [7 /GET A JMS I [OUTPUT /RING IT JMP VQUES2 /TRY AGAIN OUTPUT, 0 /TTY: OUTPUT ROUTINE TLS /PRINT IT NOW TSF /WAIT FOR IT JMP .-1 /TO FINISH CLA /CLEAN UP JMP I OUTPUT /RETURN VBDMSG, TEXT "VERIFY ERROR AT " BADMSG, TEXT "BAD VALUE GIVEN" LIBMSG, TEXT "LAST INPUT BLOCK " NMBLKMS,TEXT "# BLOCKS " VMSG, TEXT "VERIFY?" YESMSG, TEXT " YES!" NOMSG, TEXT " NO!" STARMSG,TEXT "*" PAGE LOOP, DCA INBLK /SAVE PASSED BLOCK TAD INBLK /GET IT BACK CLL CIA /INVERT FOR COMPARISON TAD LINBLK /COMPARE TO LAST BLOCK SNL /SKIP IF NOT DONE JMP DONE /THIS COULD MEAN NONE DONE ALSO CMA /\ TAD INCR / >ADD ON -INCR+1 CIA // SZL /ANY REMAINDER CLA /NO, CLEAR OUT TAD INCR /ADD ON INCREMENT DCA LENGTH /SAVE AS LENGTH FOR CALLS DCA DONE /CLEAR TRAP TAD LENGTH /GET LENGTH CLL RTL /\ RTL / >MAKE PAGE COUNT RTL // AND [3700 /MAKE SURE DCA COUNT /SAVE FOR LATER USE HERE TAD COUNT /GET PAGE COUNT TAD INUNIT /BUILD CALL WITH INPUT UNIT TAD INFLD /AND FIELD DCA INFUN /SETUP INPUT FUNCTION WORD NL4000 /GET WRITE BIT TAD INFUN /ADD ON READ BITS AND [7770 /THROW AWAY OLD UNIT TAD OUTUNT /ADD ON OUTPUT UNIT DCA OUTFUN /STORE INLINE LPAGN, JMS CTLCHK /CHECK FOR ^C JMS I INDEV /READ INPUT DEVICE INPARM /INPUT PARAMETER JMP .-2 /TRY AGAIN NL7775 /SET VERIFY DCA VERCNT /COUNT TO 3 VERAGN, JMS CTLCHK /CHECK FOR ^C JMS I OUTDEV /WRITE OUTPUT OPARM /OUTPUT PARAMETER HLT /BARF VERCHK, TAD VSW /GET VERIFY SWITCH SNA CLA /SKIP IF SET JMP ENDLUP /JUMP IF NOT TAD OUTBLK /GET WRITE FUNCTION'S BLOCK DCA VERBLK /MAKE IT VERIFY FUNCTION'S BLOCK TAD OUTFUN /GET OUTPUT FUNCTION AND [3707 /JUST PAGE, UNIT BITS TAD VERFLD /ADD ON FIELD BITS DCA VERFUN /SAVE AS VERIFY FUNCTION JMS CTLCHK /CHECK FOR ^C JMS I OUTDEV /READ OUTPUT DEVICE VPARM /VERIFY PARAMETER JMP VERBAD /BARF STA /-1 TAD OPARM /GET POINTER DCA XR1 /SET IT UP STA /-1 TAD VPARM /GET POINTER DCA XR2 /SET IT UP TAD COUNT /GET PAGE COUNT CLL RAL /MAKE IT NUMBER OF WORDS CIA /INVERT DCA FCHAR /SAVE AS VERIFY WORD COUNT VERLUP, NOP/CDF 00 /GOTO BUFFER FIELD TAD I XR1 /GET FIRST WORD CIA /INVERT FOR TEST VERCDF, NOP/CDF 00 /GO TO VERIFY FIELD TAD I XR2 /ADD ON OTHER WORD SZA CLA /SKIP IF EQUAL JMP VERBAD /JUMP IF NOT ISZ FCHAR /DONE ALL YET ? JMP VERLUP /NO, GO BACK ENDLUP, NOP/CDF 00 /MAKE SURE FIELD 0 TAD LENGTH /\ TAD OUTBLK / >UPDATE OUTPUT BLOCK DCA OUTBLK // TAD LENGTH /GET CURRENT LENGTH TAD INBLK /ADD ON CURRENT BLOCK SZA /SKIP IF EQUAL JMP LOOP /GO BACK FOR MORE DONE, JMP BAD /THIS WILL BE ZAPPED CLA /CLEAN UP JMS I [SCRIBE /WE'RE DONE DONMSG /WITH THIS ONE JMP SYSCPY-1 /START OVER VERBAD, NOP/CDF 00 /MAKE SURE FIELD 0 ISZ VERCNT /THREE TIME LOSER ? JMP VERAGN /NO, TRY ONCE MORE TIME JMS I [SCRIBE /TELL THEM VBDMSG /THE BAD NEWS TAD OUTDEV /GET OUTPUT DEVICE TAD [-DEV1 /IS IT THE FIRST DEVICE? SZA CLA /SKIP IF SO TAD [DLET2-DLET1 /ADD OFFSET IF NOT TAD [DLET1 /USE FIRST DEVICE AT LEAST JMS I [OUTPUT /PRINT IT TAD OUTUNT /GET OUTPUT UNIT TAD ["0&177 /MAKE IT ASCII JMS I [OUTPUT /PRINT IT TAD [":&177 /GET A COLON JMS I [OUTPUT /PRINT IT TAD XR1 /GET BUFFER POINTER TAD [-CORE /MAKE ABSOLUTE OFFSET RTL /\ RTL / >MAKE BLOCK NUMBER RTL // AND [37 /JUST BLOCK BITS TAD OUTBLK /GET BASE BLOCK JMS I [PRTOCT /PRINT IT JMS INPUT /GET RESPONSE TAD [-24 /<^T>? SNA /SKIP IF NOT JMP LPAGN /RETRY AGAIN IAC /<^S>? SZA CLA /SKIP IF SO JMP .-6 /NOT EITHER JMP ENDLUP /SKIP PAST PROBLEM INPARM, CORE /INTO INPUT BUFFER INFUN, .-. /BLOCK LENGTH AS APPROPRIATE INBLK, .-. /FILLED IN BEFORE OPARM, CORE /SAME BUFFER FOR WRITING OUTFUN, .-. /WRITE APPROPRIATE BLOCK LENGTH OUTBLK, .-. /FILLED IN INITIALLY VPARM, CORE2 /INTO COMPARE BUFFER VERFUN, .-. /VERIFY SAME LENGTH AS PREVIOUS WRITE VERBLK, .-. /EQUAL TO FOTBLK DONMSG, TEXT "DONE!" PAGE GETNUM, 0 /NUMERIC INPUT ROUTINE DCA DEVSW /SAVE DEVICE REQUIREMENT SWITCH TAD I GETNUM /GET RETURN ADDRESS DCA PRTOCT /STASH IT ISZ GETNUM /BUMP TO NEXT NL4000 /SET FLAG DCA UNIT /SAVE IT DCA LATEST /CLEAR DIGIT TEMPORARY TAD DEVSW /DO WE NEED DEVICE? SNA CLA /SKIP IF SO JMP INCLR /JUMP IF NOT TAD I GETNUM /GET DEVICE STASH ADDRESS DCA FCHAR /SAVE IT ISZ GETNUM /BUMP TO UNIT ADDRESS STAGN, JMS UPUINPUT /GET A CHARACTER TAD [-DLET1+25 /IS IT THE FIRST DEVICE? SZA /SKIP IF SO JMP STRYIT /JUMP IF NOT SKP /DON'T USE SECOND DEVICE STOK, TAD [DEV2-DEV1 /USE INTER-DEVICE OFFSET TAD [DEV1 /ADD ON FIRST DEVICE ADDRESS DCA I FCHAR /SAVE AS DEVICE ADDRESS SCOLIN, TAD CHAR /GET THE CHARACTER JMS I [OUTPUT /GO PRINT IT INCLR, DCA NUMBER /CLEAR RESULT INMORE, JMS UPUINPUT /GET ANOTHER CHARACTER TAD [-":+225 /IS IS A COLON ? SSNA, SNA /SKIP IF NOT JMP SCOLON /JUMP IF SO TAD [-"8+": /TOO LARGE ? SMA /SKIP IF NOT JMP CHECK1 /JUMP IF MAYBE TAD [-"0+"8 /TOO SMALL ? SPA /SKIP IF NOT JMP CHECK2 /JUMP IF MAYBE DCA LATEST /SAVE AS LATEST DIGIT TAD CHAR /GET DIGIT IN ASCII FORM JMS I [OUTPUT /PRINT IT TAD NUMBER /GET CURRENT RESULT CLL RAL /\ CLL RAL / >ROTATE CLEANLY CLL RAL // TAD LATEST /ADD ON LATEST DIGIT JMP INCLR /KEEP ON GOING CHECK1, TAD [-376+"8 /IS IT ? SZA /SKIP IF SO IAC /? SZA /SKIP IF SO TAD [-"<+375 /"<"? CRIN, SNA CLA /SKIP IF NOT , "<", , OR JMP INRET /JUMP IF ANY OF ABOVE CRBARF, TAD [7 /BANG A JMS I [OUTPUT /GET IT ON JMP INMORE /KEEP GOING CHECK2, TAD [-233+"0 /? SNA /SKIP IF NOT JMP INRET /JUMP IF YES TAD [-215+233 /? JMP CRIN /FIND OUT THERE SCOLON, TAD UNIT /GET CURRENT UNIT SMA CLA /SKIP IF NEVER USED JMP CRBARF /JUMP IF USED TAD LATEST /GET LATEST DCA UNIT /USE AS UNIT JMP SCOLIN /GO BACK FOR MORE STRYIT, TAD [-DLET2+DLET1 /IS IT THE SECOND DEVICE? SNA CLA /SKIP IF NOT JMP STOK /JUMP IF SO TAD [7 /GET A JMS I [OUTPUT /RING IT JMP STAGN /TRY AGAIN INRET, TAD SEPSW /GET SWITCH SNA CLA /SKIP IF SET TAD [SZA-SNA /ADD ON DIFFERENCE TAD SSNA /ADD BASE INSTRUCTION DCA GETTST /STASH IT INLINE TAD CHAR /GET DELIMITER TAD [-"<+200 /COMPARE TO "<" GETTST, .-. /SKIP IF CORRECT JMP CHECK1 /JUMP IF NOT SZA CLA /SKIP IF ACTUALLY "<" JMP .+3 /JUMP IF NOT TAD CHAR /GET "<" JMS I [OUTPUT /PRINT IT TAD I GETNUM /GET UNIT ADDRESS DCA FCHAR /STASH IT ISZ GETNUM /BUMP TO NEXT TAD UNIT /GET CURRENT UNIT AND [7 /JUST IN CASE NEVER USED! DCA I FCHAR /STORE IT TAD NUMBER /GET RESULT JMP I GETNUM /RETURN UPUINPU,0 /CHECKING INPUT ROUTINE JMS INPUT /GET A CHARACTER TAD [-177 /IS IT A ? SZA /SKIP IF SO TAD [-25+177 /<^U>? SZA /SKIP IF EITHER JMP I UPUINPUT /RETURN IF NEITHER JMP I PRTOCT /RESTART IF EITHER SCRIBE, 0 /SCRIBE ROUTINE SZA CLA /BYPASS? JMP NOCR /YES TAD [15 /GET A JMS I [OUTPUT /PRINT IT TAD [12 /GET A JMS I [OUTPUT /PRINT IT NOCR, TAD I SCRIBE /GET MESSAGE ADDRESS DCA STEMP /SAVE IT ISZ SCRIBE /BUMP PAST ARGUMENT SLOOP, TAD I STEMP /GET A PAIR RTR /\ RTR / >BSW RTR // JMS STRIM /PRINT HIGH HALF TAD I STEMP /GET AGAIN JMS STRIM /PRINT LOW HALF ISZ STEMP /BUMP TO NEXT JMP SLOOP /GO BACK FOR NEXT PAIR STRIM, 0 /TRIM + EXIT ROUTINE AND [77 /JUST SIX-BIT SNA /END OF MESSAGE? JMP I SCRIBE /YES, RETURN TAD [40 /\ AND [77 / >MAKE INTO 7-BIT ASCII TAD [40 // JMS I [OUTPUT /PRINT IT JMP I STRIM /RETURN PAGE /P?S NON-SYSTEM LINC-8 (MOD) HANDLER XLIST 0; IFZERO 1< P?S NON-SYSTEM LINCTAPE HANDLER FOR THE MODIFIED LINC-8 FEATURES: 1)SUPPORT OF EIGHT UNITS (0-7) 2)INDIVIDUAL RETENTION OF LATEST BLOCK INFORMATION 3)THROUGH USE OF 2), CORRECT INITIAL SEARCH DIRECTION 4)PARITY ERROR DETECTION AND RETRY (WITH COUNTER) 5)ADJUSTABLE (ONE WORD) CUSTOM OVERSHOOT FACTOR LAST EDIT: 26-FEB-1977 07:30:59 CJL > XLIST 0 L8HAND, 0 /ENTRY POINT CLA CLL CML RTL /+2 RDF /NOW HAVE CALLING FIELD TAD LTCDF /MAKE RETURN CIDF INSTRUCTION DCA L8OUT /SAVE FOR EXIT LATER TAD I L8HAND /GET PARAMETER POINTER DCA LWAIT /STASH IT TAD I LWAIT /GET TRANSFER ADDRESS DCA LBUFF /SET IT UP ISZ LWAIT /BUMP TO FUNCTION WORD TAD I LWAIT /GET FUNCTION WORD RAL /MOVE UP AND LT7600 /ISOLATE PAGE BITS DCA LPAGCT /SAVE AS PAGE COUNT TAD I LWAIT /GET FUNCTION AGAIN AND LT70 /JUST TRANSFER FIELD BITS TAD LTCDF /NOW HAVE CDF TRANSFER FIELD DCA TRNCDF /SET IT UP TAD I LWAIT /GET FUNCTION AGAIN LDUW /LOAD R/W BUFFER AND LOW UNIT BITS RAR /MOVE OVER AND LT3 /JUST EXTENDED UNITS IACF /LOAD THE UNITS RAL /RESTORE ALL UNIT BITS TAD TDBLK /NOW HAVE PROPER "TAD" INSTRUCTION DCA TADINST /STORE INLINE ISZ LWAIT /BUMP TO BLOCK ARGUMENT TAD I LWAIT /GET THE BLOCK NUMBER DCA TBLOCK /STASH IT TADINST,TAD BLOCK0 /GET LATEST BLOCK NUMBER CIA /INVERT TAD TBLOCK /COMPARE TO DESIRED BLOCK TAD LOVSHT /ADD ON OVERSHOOT FACTOR DCA LDIRCT /SAVE AS INITIAL DIRECTION CLA CLL CMA RTL /-3 DCA TRYCT /TO RETRY COUNT ISZ L8HAND /BUMP TO ERROR RETURN IOF /PREVENT PROBLEMS LNEXT, ISZ TBLOCK /FOR ONE'S COMPLEMENT BUMP FIRST LT3, 3 /WATCH OUT FOR BLOCK 7777! TAD LT7600 /SETUP DCA TCOUNT /BLOCK WORD COUNTER DCA TCHKSM /CLEAR CHECKSUM TAD LDIRCT /GET FIRST TIME DIRECTION STSR /SET SEARCH AND AC IF NOT FIRST TIME SERCH1, ACMN /LOAD MOTION SERCH2, JMS LWAIT /WAIT FOR A BLOCK MARK TAD TBLOCK /COMPARE TO DESIRED SZA /SKIP IF POSSIBLE JMP SERCH1 /JUMP IF NOT SKFM /GOING MY WAY? JMP SERCH2 /NO, IT'LL TURN AROUND SOON ENOUGH LRWS /GOTO READ (AND MAYBE WRITE) MODE JMS LWAIT /SKIP GUARD WORD IF READING TRNCDF, CDF 00 /TO TRANSFER FIELD TRNLUP, TAD I LBUFF /GET A WORD JMS LWAIT /WAIT FOR IT (OR NEW ONE) DCA I LBUFF /PUT A WORD TAD I LBUFF /GET IT BACK TAD TCHKSM /UPDATE THE DCA TCHKSM /CHECKSUM ISZ LBUFF /BUMP TO NEXT WORD LT70, 70 /JUST IN CASE ISZ TCOUNT /DONE WITH BLOCK? JMP TRNLUP /NO, KEEP GOING TAD TCHKSM /GET ACCUMULATED CHECKSUM CIA /INVERT FOR WRITING JMS LWAIT /WRITE IT OUT (OR READ IN NEW ONE) TAD TCHKSM /MUST COMPARE EITHER WAY SZA CLA /SKIP IF NO PARITY ERROR JMP PARERR /BARF JMS LWAIT /WAIT FOR LAST WORD TO BE WRITTEN LT7600, CLA+400 /CLEAN UP TAD LPAGCT /GET CURRENT PAGE COUNT TAD LT7600 /DECREMENT IT SNA /DONE? JMP TDONE /YES, FINISH UP DCA LPAGCT /NO, SAVE FOR NEXT TIME JMP LNEXT /GO DO ANOTHER BLOCK TDONE, CLA CLL CML RTR /DCA-TAD TAD TADINST /NOW HAVE "DCA BLOCKN" DCA TRYCT /SAVE INLINE TAD TBLOCK /GET CURRENT BLOCK TRYCT, DCA BLOCK0 /STASH IT IN TABLE ISZ L8HAND /BUMP TO GOOD RETURN ERRXIT, ICON /STOP THE TAPE L8OUT, CIF CDF 00 /BACK TO CALLING FIELD JMP I L8HAND /RETURN TO CALLER PARERR, TAD LBUFF /GET CURRENT ADDRESS TAD LT7600 /BACKUP A PAGE DCA LBUFF /SAVE IT ISZ TRYCT /TOO MANY ERRORS? JMP LT3 /NO, TRY AGAIN JMP ERRXIT /YES, FORGET IT LWAIT, 0 /WAIT ROUTINE IACA /LOAD "A" REGISTER FOR WRITING SKTF /WAIT FOR TAPE FLAG JMP .-1 /TO HAPPEN CLTF /CLEAR AC, FLAG IAAC /GET LATEST WORD EITHER WAY JMP I LWAIT /RETURN TBLOCK, 0 /SEARCH BLOCK BLOCK0, ZBLOCK 10 /BLOCK TABLE LBUFF, 0 /TRANSFER ADDRESS POINTER TCHKSM, 0 /CHECKSUM TEMPORARY TCOUNT, 0 /PAGE WORD COUNT LDIRCT, 0 /INITIAL DIRECTION LTCDF, CDF 00 /CDF CONSTANT LOVSHT, 7761 /OVERSHOOT FACTOR LPAGCT, 0 /PAGE COUNT TDBLK, TAD BLOCK0 /INSTRUCTION CONSTANT /LINC-8 DEFINITIONS ACMN= 6177 /AC TO MOTION FLIP-FLOPS CLTF= 6144 /CLEAR AC, TAPE FLAG IAAC= 6171 /READ "A" REGISTER IACA= 6167 /LOAD "A" REGISTER IACF= 6175 /LOAD UNIT (ETC.) FLIP-FLOPS ICON= 6141 /INTERFACE CONTROL INTS= 6147 /READ LINC INTERRUPT STATUS LDUW= 6162 /LOAD BUFFERED R/W, UNIT[0] FLIP-FLOPS LRWS= 6166 /LOAD "ON-BLOCK" MODE, SET WRITE AND SKIP IF /PREVIOUS LDUW AC[0] ON SKFM= 6146 /SKIP IF FORWARD TAPE MOTION SKTF= 6142 /SKIP ON TAPE FLAG STSR= 6164 /SET SEARCH, CONDITIONALLY CLEAR AC /LOSS OF TAPE MOTION DISABLES AC CLEAR /EXECUTING STSR ENABLES FUTURE STSR'S TO /CLEAR THE AC /SETTING SEARCH CLEARS THE TAPE FLAG /LINC "A" REGISTER IS INTACT AFTER A TRANSFER /EVEN IF IN "ON-BLOCK" MODE AND WRITERS ON PAGE /DECTAPE I/O FOR LINC-8 /DECTAPE I/O ROUTINES FOR LINC-8 MODIFIED /ACCORDING TO THE COOLEY LABS-D. SOERGEL /SPECIFICATIONS AS DESIGNED BY K. METZGER ET. AL. /OF COOLEY LABS, C. LASNER, P?S N. Y., AND D. SOERGEL /OF SYRACUSE N. Y. /HANDLER FOLLOWS P?S NON-SYSTEM FORMAT, BUT SUPPORTS /SPECIAL FUNCTIONS. HANDLER DOES NOT HAVE OFFICIAL P?S /SANCTION AS IT IS NOT PAGE OR FIELD RELOCATABLE AND /THEREFORE MUST BE ASSEMBLED INTO ANY PROGRAM USING IT. /CALLING SEQUENCE: / CDF CALLER /SET TO CALLING FIELD / CIF 00 /WHERE ROUTINES ARE / JMS I (DECTAPE /CALL I/O / PARAM /ADDRESS OF PARAMETER LIST / ERROR RETURN HERE / GOOD RETURN HERE /PARAM, CORE /CORE BUFFER / FUNCTION /FUNCTION WORD / BLOCK /BLOCK NUMBER /FUNCTION BIT ASSIGNMENTS: / (R/W^4000)+(PAGE COUNT^100)+(DATA FIELD^10)+ / (600 WORDS/BLOCK^4)+(REVERSE XFER^2)+UNIT / DEFINITIONS ACMN= 6177 /LOAD MOTION CONTROL FROM AC CLRLC= 6154 /CLEAR LINE COUNTER CLTF= 6144 /CLEAR AC, TAPE FLAG IAAC= 6171 /READ "A" REGISTER IACA= 6167 /LOAD "A" REGISTER IACF= 6175 /LOAD INDICATOR FLIP-FLOPS IACS= 6163 /LOAD "S" REGISTER ICON= 6141 /MULTI-USE INTERFACE CONTROL ITAC= 6157 /READ MARK WINDOW LDUW= 6162 /LOAD R/W FLIP-FLOP AND UNIT[2] LRWS= 6166 /LOAD R/W MODE AND SKIP 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 SFFLG= 6156 /SKIP ON FRAME FLAG SKTF= 6142 /SKIP ON TAPE FLAG SMODE= 6152 /SET SPECIAL MODE STSR= 6164 /SET SEARCH, MAYBE CLEAR AC SUMCHK, SZA CLA /PARITY ERROR ? JMP DTERR /YES, COMPLAIN NL2000 /DCA-TAD TAD GETBLK /NOW HAVE "DCA BLKN" DCA PUTBLK /STORE IN-LINE TAD BLOCK /GET CURRENT BLOCK PUTBLK, DCA BLK0 /OR DCA BLK1 TAD I PCURADD /GET CURRENT ADDRESS DCA BUFBEG /SAVE AS NEW ADDRESS TAD DIRFLG /GET DIRECTION FLAG SNA CLA /SKIP IF FORWARDS NL7776 /BACKUP IF BACKWARDS IAC /+1 IF FORWARDS, -1 IF BACKWARDS TAD BLOCK /ADD ON CURRENT BLOCK DCA BLOCK /SAVE AS NEW BLOCK TAD PAGCNT /GET PAGE COUNT TAD BLKSIZE /ADD ON USAGE AMOUNT SNA /SKIP IF MORE TO DO JMP DTEXIT /JUMP IF DONE DCA PAGCNT /STORE IT BACK JMP I .+1 /GO DO NEXT NXTBLK /THROUGH HERE DTEXIT, ISZ DECTAPE /BUMP TO SUCCESSFUL RETURN L7000, 7000 /THIS CAN BE SKIPPED DTSTOP, ICON /STOP THE TAPE RETFLD, CIF CDF 00 /BACK TO CALLING FIELD JMP I DECTAPE /RETURN DTERR, ISZ TRYCNT /TOO MANY TIMES ? JMP I PDTURNX /NO, TRY AGAIN JMP DTSTOP /TAKE ERROR RETURN BLK0, 0 /UNIT 0 LAST BLOCK BLK1, 0 /UNIT 1 LAST BLOCK BLKSIZE,0 /BLOCK SIZE COUNTER BLOCK, 0 /DESIRED BLOCK BUFBEG, 0 /TRANSFER ADDRESS DIRFLG, 0 /DIRECTION FLAG DATFLD, 0 /DATA FIELD L40, 40 /CONSTANT 0040 L400, 400 /CONSTANT 0400 L70, 70 /CONSTANT 0070 L7200, 7200 /CONSTANT 7200 L7770, 7770 /CONSTANT 7770 PAGCNT, 0 /PAGE COUNT PCURADD,CURADD /POINTER TO CURRENT ADDRESS PDIRCOM,DIRCOM /POINTER TO DIRECTION COMPLEMENTER PDIRDEC,DIRDECIDE /POINTER TO TURNAROUND DECIDER PDTURNX,DTURNX /POINTER TO TURN AROUND ROUTINE PRWZAP, RWZAP /WHERE TO ZAP IN A READ OR WRITE RDKLDG, RDINST-WINST /READ KLUDGE VALUE TADBLK, TAD BLK0 /TAD INSTRUCTION TRYCNT, -3 /RETRY COUNT WRINST, WINST /WRITE INSTRUCTION XTRAWD, 0 /EXTRA WORD FLAG DECTAPE,0 /ENTER HERE FOR DECTAPE I/O NL0002 /SET CIF BIT RDF /GET CALLING FIELD TAD LCDF /MAKE INTO CIF CDF RETURN DCA RETFLD /SAVE FOR ULTIMATE RETURN TAD I DECTAPE /GET CALLER'S ARGUMENT POINTER DCA BLKSIZE /SET IT UP ISZ DECTAPE /BUMP TO ERROR RETURN TAD I BLKSIZE /GET CORE ARGUMENT DCA BUFBEG /STASH IT ISZ BLKSIZE /BUMP TO FUNCTION WORD TAD I BLKSIZE /GET FUNCTION WORD DCA DIRFLG /SAVE IT HERE FOR NOW ISZ BLKSIZE /BUMP TO BLOCK ARGUMENT TAD I BLKSIZE /GET BLOCK ARGUMENT DCA BLOCK /STASH IT NOP/CDF P /SAFE TO COME OUT NOW TAD DIRFLG /GET FUNCTION WORD LDUW /LOAD LOW ORDER UNIT AND R/W BIT RAL /MOVE UP PAGE BITS AND D7600 /JUST PAGE BITS DCA PAGCNT /SAVE IT SNL /WRITING ? TAD RDKLDG /MAKE IT READ TAD WRINST /AT LEAST WRITE DCA I PRWZAP /ZAP IT INLINE NL0001 /SET UNIT MASK AND DIRFLG /JUST UNIT BIT TAD TADBLK /ADD ON "TAD BLK0" INSTRUCTION DCA GETBLK /SAVE AS "TAD BLKN" INSTRUCTION IACF /USING UNIT 0-1 ONLY TAD DIRFLG /GET FUNCTION AGAIN AND L70 /JUST FIELD BITS TAD LCDF /MAKE INTO CDF INSTRUCTION DCA DATFLD /SAVE AS TRANSFER FIELD TAD DIRFLG /GET FUNCTION AGAIN RTR /GET THE SIZE AND RAR /DIRECTION BITS L7700, SMA CLA /SKIP IF REVERSE TRANSFER TAD L40 /SET FORWARD VALUE DCA DIRFLG /SAVE AS DIRECTION FLAG SNL /600 WORDS/BLOCK ? TAD L400 /NO, MAKE IT 200 WORDS/BLOCK TAD L7200 /AT LEAST THAT MANY DCA BLKSIZE /SAVE AS BLOCK SIZE COUNTER SZL /129TH WORD HANDLING ? STA /SET IF NOT NEEDED FOR 384 WORD BLOCKS DCA XTRAWD /SAVE AS EXTRA WORD FLAG NL7775 /SETUP DCA TRYCNT /RETRY COUNT TAD DIRFLG /GET DIRECTION FLAG TAD L7000 /NOP IF BACKWARDS, CMA IF FORWARDS DCA I PDIRCOM /SAVE FOR MOTION ROUTINE TAD DIRFLG /GET DESIRED TRANSFER DIRECTION CLL RTR /10 IF FORWARDS, 0 IF BACKWARDS TAD L7700 /SPA CLA IF FORWARDS, SMA CLA IF BACKWARDS DCA I PDIRDECIDE /USE IN TURNAROUND DECISION ROUTINE TAD DIRFLG /GET DESIRED TRANSFER DIRECTION CLL RAR /20 IF FORWARDS, 0 IF BACKWARDS TAD L7770 /+10 IF FORWARDS, -10 IF BACKWARDS GETBLK, TAD BLK0 /OR TAD BLK1 CLL CMA /INVERT FOR GUESS TAD BLOCK /ADD ON DESIRED BLOCK D7600, 7600 /LINK NOW CONTAINS GUESS DIRECTION TAD DIRFLG /GET DESIRED DIRECTION SZA CLA /SKIP IF REVERSE TRANSFER CML /MUST CHANGE SENSE OF GUESS RAR /GET GUESS DIRECTION JMP I .+1 /FORCE INITIAL MOTION THAT WAY SAVDIR /THROUGH HERE LCDF, CDF 00 /CDF CONSTANT PAGE DIRDEC, SPA CLA /OR SMA CLA DTURNX, NL4000 /INVERT DIRECTION IF APPROPRIATE TAD DIRECT /ADD ON CURRENT DIRECTION SAVDIR, DCA DIRECT /SAVE AS NEW DIRECTION NXTBLK, STSR /FORCE WRITE OFF NOW TAD DIRECT /GET CURRENT DIRECTION DIRCOM, CMA /OR NOP ACMN /LOAD MOTION FLIP-FLOPS SPA CLA /ARE WE GOING ACTUALLY BACKWARDS ? TAD L20 /NO, ADD ON CML BIT TAD L7004 /ADD ON RAL INSTRUCTION DCA BITSHFT /SETUP DECODER POLARITY NL0001 /SETUP FOR DECTAPE POLARITY SMODE /GOTO SPECIAL MODE TAD DIRECT /GET CURRENT DIRECTION SPA CLA /SKIP IF SAME AS DESIRED TAD L4002 /NOT IT, ADD ON UNDERSHOOT FACTOR DCA USHOOT /SAVE FOR BLOCK COMPARISONS STA /SETUP TO RESET MARK WINDOW MRKWAIT,DCA MRKWND /SAVE CURRENT WINDOW SFFLG /WAIT FOR JMP .-1 /A NEW BIT ITAC /GET IT RAR /PUT INTO LINK CLA /CLEAN UP TAD MRKWND /GET CURRENT WINDOW BITSHFT,RAL /OR CML RAL TAD BLKMARK /IS IT A BLOCK MARK ? SNA /SKIP IF NOT JMP BLKSYNC /JUMP IF SO TAD ENDZONE /END MARK ? SNA /SKIP IF NOT JMP DTURNX /TURN THE TAPE AROUND TAD RESTORE /RESTORE CURRENT WINDOW JMP MRKWAIT /TRY AGAIN BLKSYNC,CLRLC /CLEAR LINE COUNTER TAD LICON3 /GOTO DATA MODE ICON /FOR BLOCK NUMBERS CLTF /CLEAN UP AC, TAPE FLAG IAAC /GET BLOCK NUMBER JMS I PUNSCRM /UNSCRAMBLE IT LICON3, IACS /DISPLAY CURRENT BLOCK TAD USHOOT /ADD ON UNDERSHOOT FACTOR CIA /INVERT FOR COMPARISON TAD I PBLOCK /ADD ON DESIRED SZA /SKIP IF CORRECT JMP DIRDEC /GO BACK AND FIGURE IT OUT JMS I PDTWAIT /WAIT FOR A WORD JMS I PDTWAIT /TWO WORDS JMS LINE /WAIT FOR A LINE JMS LINE /TWO LINES CLRLC /CLEAR LINE COUNTER NOW CLTF /CLEAR AC, TAPE FLAG LRWS /LOAD DATA MODE, AND MAYBE WRITE MODE JMS I PDTWAIT /WAIT FOR A WORD IF READING JMS I PDTWAIT /WAIT FOR CHECKSUM WORD AND L1463 /JUST 6-BIT CHECKSUM DCA I PCHKSUM /SAVE IT TAD I AXTRAWD /GET EXTRA WORD FLAG TAD I ADIRFLG /AND TRANSFER DIRECTION SZA CLA /SKIP IF AN EXTRA WORD IS THERE JMP NOEXT /JUMP IF NONE THERE JMS I PDTWAIT /WAIT FOR A WORD JMS I PEXOR /EXOR IT IN NOEXT, TAD I PBLKSIZE /GET BLOCK SIZE DCA I PWRDCNT /USE AS WORD COUNT TAD I PBUFBEG /GET BUFFER ADDRESS JMP I .+1 /CONTINUE WRDLUP /THERE LINE, 0 /WAIT FOR 1 LINE ITAC /CLEAR FLAG SFFLG /WAIT FOR IT JMP .-1 /TO HAPPEN JMP I LINE /RETURN ADIRFLG,DIRFLG /POINTER TO DIRECTION FLAG AXTRAWD,XTRAWD /POINTER TO EXTRA WORD FLAG BLKMARK,-2526 /BLOCK MARK CODE DIRECT, 0 /CURRENT TAPE DIRECTION ENDZONE,-2222+2526 /END MARK CODE L1463, 1463 /CONSTANT 1463 L20, 20 /CONSTANT 0020 L4002, 4002 /UNDERSHOOT FACTOR CONSTANT L7004, RAL /CONSTANT 7004 MRKWND, 0 /MARK WINDOW PBLOCK, BLOCK /POINTER TO BLOCK ARGUMENT PBLKSIZE,BLKSIZE /POINTER TO BLOCK SIZE COUNTER PBUFBEG,BUFBEG /POINTER TO CURRENT ADDRESS REFRESH PCHKSUM,CHKSUM /POINTER TO CHECKSUM TEMPORARY PDTWAIT,DTWAIT /POINTER TO DTWAIT ROUTINE PEXOR, EXOR /POINTER TO EXOR ROUTINE PUNSCRM,UNSCRM /UNSCRAMBLE ROUTINE POINTER PWRDCNT,WRDCNT /POINTER TO WORD COUNT RESTORE,2222 /RESTORATION VALUE FOR MARK CODES USHOOT, 0 /UNDERSHOOT VALUE PAGE WRDLUP, DCA CURADD /SAVE THIS BUFFER START RWLOOP, NOP/CDF T /TO TRANSFER FIELD RWZAP, TAD I CURADD /OR JMP READ JMS SCRMBL /SCRAMBLE IT JMS DTWAIT /WAIT FOR IT JMS EXOR /EXOR IT IN READCOM,ISZ CURADD /BUMP TO NEXT NOP /JUST IN CASE ISZ WRDCNT /DONE YET ? JMP RWLOOP /NO, GO BACK NOP/CDF P /BACK TO OUR FIELD NOW TAD I PDIRFLG /GET DIRECTION TAD I PXTRAWD /AND EXTRA WORD FLAG TAD L7740 /COMPARE TO 0040 SZA CLA /SKIP IF MORE TO COME JMP NOMORE /JUMP IF NOT JMS DTWAIT /WAIT FOR ANOTHER WORD JMS EXOR /EXOR IT IN NOMORE, TAD CHKSUM /GET CHKSUM CMA RTL /MOVE OVER ITSELF JMS EXOR /EXOR ITSELF TAD CHKSUM /GET CHECKSUM AND L6314 /JUST ACTUAL CHECKSUM BITS JMS DTWAIT /SEND IT TO TAPE JMS EXOR /EXOR IT IN JMS DTWAIT /WAIT FOR ANOTHER WORD CLA /CLEAN UP TAD CHKSUM /GET THE CHECKSUM AND L6314 /JUST GOOD BITS JMP I .+1 /NOW GO BACK TO EXIT ROUTINE SUMCHK /THROUGH HERE READ, JMS DTWAIT /WAIT FOR A WORD JMS EXOR /EXOR IT IN TAD SCRMBL /GET THE LATEST WORD JMS UNSCRM /UNSCRAMBLE IT DCA I CURADD /STORE IT JMP READCOM /REJOIN THERE RDINST= JMP READ /NEEDED INSTRUCTION CONSTANT EXOR, 0 /EXOR SUBROUTINE DCA SCRMBL /SAVE WORD TAD SCRMBL /GET IT BACK AND CHKSUM /REMOVE OVERFLOWS CLL RAL /*2 CIA /INVERT TAD SCRMBL /ADD ON ORIGINAL TAD CHKSUM /ADD ON CHECKSUM DCA CHKSUM /STASH IT JMP I EXOR /RETURN DTWAIT, 0 /WORD WAIT ROUTINE IACA /LOAD IN CASE WRITING SKTF /WAIT FOR IT JMP .-1 /TO HAPPEN CLTF /CLEAR AC, TAPE FLAG IAAC /GET IT BACK OR NEW WORD JMP I DTWAIT /RETURN CHKSUM, 0 /CHECKSUM TEMPORARY CURADD, 0 /CURRENT TRANSFER ADDRESS L6314, 6314 /CONSTANT 6314 L77, 77 /CONSTANT 0077 L7740, 7740 /CONSTANT 7740 PDIRFLG,DIRFLG /POINTER TO DIRECTION FLAG PSCRTBL,SCRTBL /POINTER TO SCRAMBLE TABLE PUNTBL, UNTBL /POINTER TO UNSCRAMBLE TABLE PXTRAWD,XTRAWD /POINTER TO EXTRA WORD FLAG SCRTMP, 0 /TEMPORARY TBLPTR, 0 /TABLE POINTER TEMPORARY WINST= TAD I CURADD /NEEDED INSTRUCTION DEFINITION WRDCNT, 0 /WORD COUNT UNSCRM, 0 /READ UNSCRAMBLE JMS SCRCOM /DO COMMON STUFF TAD PUNTBL /ADD ON UNSCRAMBLE BASE DCA TBLPTR /STASH IT TAD I TBLPTR /GET TRANSLATED VALUE CLL RTL /SHIFTED 2 PLACES RTL /SHIFTED 4 PLACES RAL /SHIFTED 5 PLACES DCA SCRTMP /HIGH-LOW TABLES NOW OVERLAP ON 5 TAD EXOR /GET THE WORD BACK AND L77 /JUST TABLE SIZE TAD PUNTBL /ADD ON TABLE BASE DCA TBLPTR /STASH IT TAD I TBLPTR /GET VALUE TAD SCRTMP /COMBINE HALVES JMP I UNSCRM /RETURN SCRMBL, 0 /WRITE SCRAMBLE JMS SCRCOM /DO COMMON STUFF TAD PSCRTBL /ADD ON TABLE POINTER DCA TBLPTR /STASH IT TAD I TBLPTR /GET THE VALUE CLL RTL /SHIFTED 2 PLACES DCA SCRTMP /SAVE IT TAD EXOR /GET THE WORD AND L77 /JUST TABLE SIZE TAD PSCRTBL /ADD ON TABLE BASE DCA TBLPTR /STASH IT TAD I TBLPTR /GET VALUE TAD SCRTMP /COMBINE HALVES JMP I SCRMBL /RETURN SCRCOM, 0 /COMMON ROUTINE DCA EXOR /SAVE WORD NOP/CDF P /MAKE SURE OUR FIELD TAD EXOR /RETRIEVE WORD RTR /\ RTR / >BSW RTR // AND L77 /JUST TABLE SIZE JMP I SCRCOM /RETURN PAGE UNTBL, 4466;4462;4426;4422 /UNSCRAMBLING TABLE 4066;4062;4026;4022 0466;0462;0426;0422 0066;0062;0026;0022 4464;4460;4424;4420 4064;4060;4024;4020 0464;0460;0424;0420 0064;0060;0024;0020 4446;4442;4406;4402 4046;4042;4006;4002 0446;0442;0406;0402 0046;0042;0006;0002 4444;4440;4404;4400 4044;4040;4004;4000 0444;0440;0404;0400 0044;0040;0004;0000 SCRTBL, 1463;1063;1443;1043 /SCRAMBLING TABLE 1462;1062;1442;1042 0463;0063;0443;0043 0462;0062;0442;0042 1423;1023;1403;1003 1422;1022;1402;1002 0423;0023;0403;0003 0422;0022;0402;0002 1461;1061;1441;1041 1460;1060;1440;1040 0461;0061;0441;0041 0460;0060;0440;0040 1421;1021;1401;1001 1420;1020;1400;1000 0421;0021;0401;0001 0420;0020;0400;0000 PAGE CORE= . /INPUT BUFFER STARTS HERE CORE2= SBOOT-.&7400%2+./COMPARE BUFFER STARTS HERE START, TAD I (SCRSIZE) /GET MEMORY CONFIGURATION TSTEMP, AND (70) /EXTRACT LOGICAL SIZE TAD (-20) /DO WE HAVE 12K? SMA /SKIP IF NOT JMP DO12K /YES, WE DON'T NEED ANY MORE TAD (10) /DO WE HAVE 8K? SNA CLA /SKIP IF NOT JMP TEST8K /GO THERE IF SO TEST4K, JMS TSTMOR /CHECK FOR ANYTHING EXTRA -100 /TRYING FOR MOST OR ALL OF 8K SKP /8K AVAILABLE COMPLETELY JMP SYSCPY-1 /ONLY 4K DO8K, TAD (REP8K-1) /GET 8K OR 4K+ REPLACEMENT LIST ADDRESS JMP REPCOM /JUMP TO COMMON CODE TO DO ZAPS TEST8K, JMS TSTMOR /CHECK FOR MORE THAN 8K -200 /TRYING FOR ALL OR MOST OF 12K JMP DO12K /WE'VE GOT IT UNRESTRICTED JMP DO8K /NOTHING EXTRA AVAILABLE DO8KPLS,TAD (7200%200) /GET NUMBER OF PAGES AVAILABLE DCA REP12K /SAVE INTO ZAP LIST JMP REPCOM-1 /ZAP FOR SLIGHTLY LESS THAN 12K DO12K, CLA /CLEAN UP AC TAD (REP12K-1) /GET POINTER TO 12K ZAP LIST REPCOM, DCA XR1 /SAVE IN AUTO-INCREMENT REGISTER DCA VINCR /VERIFY USES IDENTICAL COUNT DCA I (VPARM) /VERIFY BUFFER AT LOCATION 0000 ZAPLUP, TAD I XR2 /GET AN ADDRESS TO ZAP SNA /END OF LIST? JMP SYSCPY-1 /YES, START COPY DCA START /SAVE FOR INDIRECTNESS TAD I XR1 /GET REPLACEMENT VALUE DCA I START /ZAP THE CODE JMP ZAPLUP /LOOP TILL TABLE END TSTMOR, 0 /TEST FOR MORE MEMORY SUBROUTINE TAD I (SWAL) /GET SWITCHES A-L RTL /MOVE /C TO AC[0] SMA CLA /SKIP IF SET JMP NOEXTRA /FORGET IT, DON'T EVEN TRY TAD I (SCRSIZE) /GET MEMORY CONFIGURATION AND (700) /MCS BITS ONLY TAD I TSTMOR /IS WHAT WE WANT WITHIN THE MAXIMUM? SMA CLA /SKIP IF NOT JMP GOTEXTRA /YES, VIOLATE LCS AND USE ALL OF NEXT FIELD NL0001 /MASK FOR S BIT AND I (SCRSIZE) /GET IT FROM CURRENT CONFIGURATION WORD SZA CLA /SKIP IF WE MIGHT BE ABLE TO BORROW SOME CORE JMP NOEXTRA /ELSE WE LOSE TAD I TSTMOR /GET AMOUNT DESIRED CLL RAL /\ CLL RAL / >SHIFT TO H.O. 3 BITS CLL RAL // DCA TSTEMP /SAVE FOR A FEW MICROSECONDS TAD I (SCRSIZE) /GET THE CONFIGURATION WE'RE OPERATING UNDER AND (7000) /ONLY THE PHYSICAL SIZE TAD TSTEMP /GET DESIRED AMOUNT SMA CLA /SKIP IF NONE EVEN THERE AT ALL SOMEXTR,ISZ TSTMOR /HERE IF WE'VE RECOVERED A PARTIAL FIELD NOEXTRA,ISZ TSTMOR /HERE IF WE CAN'T BORROW ANYTHING GOTEXTR,ISZ TSTMOR /HERE IF WE'VE RECOVERED AN ENTIRE FIELD JMP I TSTMOR /RETURN TO CALLER REPADR, RWINCR /BASIC R/W BUFFER LENGTH INFLD /R/W BUFFER FIELD VERFLD /VERIFY BUFFER FIELD INPARM /READ CORE ADDRESS OPARM /WRITE CORE ADDRESS VERLUP /R/W BUFFER CDF INSTRUCTION VERCDF /VERIFY BUFFER CDF INSTRUCTION ENDLUP /POST-VERIFY RESET VALUE VERBAD /RESET VALUE AFTER VERIFY ERROR 0 /THIS ENDS THE LIST REP12K, 40 /USE 40 PAGES 10 /FIELD 1 20 /FIELD 2 0 /LOCATION 10000 0 /LOCATION 10000 CDF 10 /FIELD 1 CDF 20 /FIELD 2 CDF 00 /RESET AFTER VERIFY CDF 00 /RESET ON VERIFY ERROR REP8K, SBOOT-CORE%200 /BUFFER LENGTH 0 /FIELD 0 10 /FIELD 1 CORE /USE THIS CORE /AND THIS CDF 00 /FIELD 0 CDF 10 /FIELD 1 CDF 00 /RESET AFTER VERIFY CDF 00 /RESET ON VERIFY ERROR /DEVICE DEFINITIONS DLET1= "D&177 /"D" FOR DECTAPE DLET2= "L&177 /"L" FOR LINCTAPE DEV1= DECTAPE /FIRST DEVICE ADDRESS DEV2= L8HAND /SECOND DEVICE ADDRESS