/INIT VERSION 8.24 (01-JANUARY-75) / / / / /COPYRIGHT (C) 1975 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. / / /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY /ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH /THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS /SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO- /VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON /EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO /THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE /SOFTWARE SHALL REMAIN IN DEC. / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE /WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM- /MITMENT BY DIGITAL EQUIPMENT CORPORATION. / /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR /RELIABILITY OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT /SUPPLIED BY DEC. /RIM AUTO-LOADER FOR TSS/8 INIT RIM1= 7757 RIM2= 7760 *7400 FIX, DCA RD1 /SAVE SKIP IOT *7401 TAD K5 *7402 TAD RD1 *7403 DCA RD2 /SAVE READ IOT *7404 RIF /CURRENT FIELD *7405 CMA *7406 AND KCDF /CREATE CDF FOR FIELD 0 OR 2 *7407 DCA KCDF *7410 KCDF, CDF 20 *7411 JMS FRM /READ NEXT FRAME; SKIP ON RETURN *7412 LOOP, DCA SUM /SAVE NEW CHECKSUM *7413 TAD CHAR0 *7414 DCA CHAR1 /SAVE LEFT BYTE *7415 JMS READ *7416 DCA CHAR2 /SAVE RIGHT BYTE *7417 JMS FRM /LOOK AHEAD *7420 JMP CHKSUM /WE HAVE THE CHECKSUM *7421 JMS ASSMBL /ASSEMBLE BOTH BYTES *7422 SNL /DATA OR ORIGIN? *7423 JMP OSAVE /DATA *7424 DCA ORG /SAVE NEW ORIGIN *7425 ADD, TAD CHAR1 *7426 TAD CHAR2 /SUM BOTH BYTES *7427 TAD SUM /WITH THE OLD SUM *7430 JMP LOOP *7431 OSAVE, DCA I ORG /SAVE DATA *7432 ISZ ORG /INCREMENT ADDRESS *7433 RM200, 7600 /COVER SKIP WITH CONSTANT *7434 JMP ADD *7435 CHKSUM, JMS ASSMBL /ASSEMBLE CHECKSUM BYTES *7436 CIA *7437 TAD SUM /SUBTRACT CALCULATED SUM *7440 SZA /OK? *7441 HLT /NO; ERROR *7442 STL RTL /AC=2 *7443 TAD KCDF /PLUS CDF TO "INIT'S" FIELD *7444 DCA K5 /SAVE *7445 K5, 5 /CIF CDF TO FIELD 0 OR 2 *7446 JMP 0 /JUMP INTO INIT *7447 READ, 0 *7450 RD1, HLT /SKIP IOT *7451 JMP .-1 *7452 RD2, HLT /READ IOT *7453 DCA CHAR0 *7454 TAD CHAR0 *7455 JMP I READ *7456 FRM, 0 *7457 JMS READ /READ A FRAME *7460 TAD RM200 *7461 SPA /IS IT DATA/ORIGIN? *7462 ISZ FRM /YES; SKIP ON RETURN *7463 SPA SNA CLA /FIELD SETTING? *7464 JMP I FRM /NO *7465 JMP FRM+1 /YES; IGNORE IT *7466 ASSMBL, 0 *7467 TAD CHAR1 /LEFT BYTE *7470 CLL RTL *7471 RTL *7472 RTL /SHIFTED INTO POSITION *7473 TAD CHAR2 /PLUS RIGHT BYTE *7474 JMP I ASSMBL *7475 ORG, 0 *7476 CHAR0, 24 /CHECKSUM CORRECTION; RIGHT BYTE *7477 CHAR1, 0 *7500 CHAR2, 0 *7501 SUM, 6000 /CHECKSUM CORRECTION; LEFT BYTE *7601 RIMJMP, TAD RIMFIX *7602 DCA RIM2 /RESTORE RIM LOADER *7603 TAD RIM1 /GET SKIP IOT *7604 JMP I FIXA *7605 RIMFIX, JMP RIM1 *7606 FIXA, FIX *RIM2 JMP RIMJMP /EXIT FROM RIM /PAGE 0 FIELD 2 /INIT LOADS ONTO DISK TRACK 2 *0 JMP I SUPERA /JUST IN CASE!! SUPERA, SUPER *10 AXS1, . AXS2, . SIDATA= 20 /SYSTEM INTERPRETER DATA CONSTANTS=SIDATA+12 *CONSTANTS C0002, 2 C0003, 3 C0004, 4 C0007, 7 C0037, 37 C0100, 100 C1000, 1000 C7770, 7770 C7600, 7600 C7763, 7763 DM32, C7740, 7740 JOBCON= CONSTANTS+11 /JOB CONTROL FRSTOR= JOBCON+3 *FRSTOR FREE, . /POINTER TO HEAD OF FREE STORAGE FRECNT, . /# FREE BLOCKS AVAILABLE TIMDAT= FRSTOR+2 /CLOCK AND DATE *TIMDAT /CLOCK CLK2, . CLK1, . SCHDAT= TIMDAT+2 DATEND= 60 /END OF FIELD 0 PAGE 0 DATA FIPDAT= 155 /DATA REFERENCED BY FIP *FIPDAT+1 C0400, 400 SEGSIZ= C0400 /# WORDS PER SEGMENT CORTBA, CORTBL-1 /CORE ALLOCATION TABLE DSUTBA, DSUTBL /USER DISC REQUEST QUEUE /THE DATE IS KEPT AS A 12 BIT NUMBER IN THE FORMAT /DATE=((YEAR-1974)*12+(MONTH-1))*31+DAY-1 *DATE DATE, . CORSRA, CORSRC WAITA, WSCHED WAIT= JMP I WAITA /SUBROUTINE DISPATCHES SUBDSP= DATEND *SUBDSP CHDFA, 0 INIF, HLT JMP I CHDFA CHDF= JMS CHDFA CJOBMX, -JOBMAX INBUF, INBUFA NUMBIA, NUMBI0 CHAR, 0 NUMHO, 0 0 0 CORCNT, 0 C0010, 10 C6201, 6201 C0200, 0200 C0177, 0177 COMGEA, COMGE0 DISCA, DISC0 DISCHA, DISCH0 YESNO= JMS I . YESNO0 MESSAG= JMS I . MESSA0 OCTIN= JMS I . OCTIN0 GETIN= JMS I . GETIN0 OUTTLS= JMS I . OUTA, OUT INKRB= JMS I . IN ZERO1= JMS I . ZERO CHEKCC= JMS I . CCCHEK SWBASE, SWDEX /SWAP TRACK FOR JOB 1 C7777, -1 MC0377, -377 OSF, OSTRAP OST, 7607 OSC, -16 OSA, 7607 OSTAB, . RBOOT 7746 -7 7746 KBOOT 26 -4 26 KBOOT, DLCA DLDC DLAG JMP 31 OSTRAP, NOPUNCH *7607 ENPUNCH TAD KA DCA 7754 TAD KA DCA 7755 DTLB TAD KB DTLA DTSF JMP .-1 TAD KC JMP .-4 KA, 7577 KB, 600 KC, 220 /PAGE ASSIGNMENTS INIP= 1000 /PROGRAM TO OPEN AND MODIFY SINGLE DISC REGISTERS *0200 DISCLK, TAD KCR /PUT OUT A CR, LF OUTTLS TAD KLF OUTTLS / NOW GET AN ADDRESS FROM THE KEYBOARD JMS OTIN JMP DISCLK /: IS ONLY VALID TERMINATOR JMP DISCLK / " " /DISC ADDRESS FOLLOWED BY ":" HAS BEEN ENTERED DISPLA, JMS SPACE /PROVIDE ELEGANT FORMAT JMS I POPEN /GET REG FROM DISC TAD OPNREG /GET THIS VALUE JMS I PHACK /DISPLAY IT JMS SPACE /CONTINUE POLICY OF ELEGANT FORMATING JMS I PSAVE /SAVE VALUE, VALUE1 /REGISTER IS OPEN ---- WAIT FOR A MODIFY JMS OTIN JMP SHUT /TERMINATOR WAS CR JMP CLSOPN /TERMINATOR WAS LF /: WAS TYPED ---- MUST BE NEW DISC ADDRESS JMP DISPLAY /CARRIAGE RETURN MEANS CLOSE REGISTER /FIRST, SEE IF IT WAS MODIFIED SHUT, TAD INPUT SPA CLA JMP DISCLK /NO MODIFY /OPEN REGISTER WAS MODIFIED, SO CHANGE ON THE DISC TAD VALUE1 DCA OPNREG JMS I PCLOSE /WRITE VALUE OUT /NOW SEND OUT LF AND START AGAIN JMP DISCLK /LINE FEED MEANS CLOSE REGISTER AND OPEN THE NEXT ONE CLSOPN, TAD INPUT SPA CLA JMP .+4 /NO MODIFY /VALUE WAS MODIFIED, SO WRITE OUT NEW ONE TAD VALUE1 DCA OPNREG JMS I PCLOSE /RESPOND TO LF WITH CR TAD KCR OUTTLS TAD KCR OUTTLS /FOR TIMING (??) /NOW RESTORE ADDR WORD TO VALUE1 JMS I PRESTOR /NOW INCREMENT ADDRESS IN VALUE, VALUE1 JMS I PNEXTAD /NOW TYPE OUT THIS NEW ADDRESS TAD VALUE JMS I PHACK TAD VALUE1 JMS I PHACK TAD KCOLON OUTTLS JMP DISPLAY /TYPE TWO SPACES SPACE, 0 TAD KSPACE OUTTLS TAD KSPACE OUTTLS JMP I SPACE KSPACE, 0240 KCOLON, 0272 KCR, 0215 KLF, 0212 POPEN, XOPEN PCLOSE, CLOSE PNEXTAD, NEXTAD PSAVE, SAVE PRESTOR, RESTOR PHACK, HACK /ROUTINE TO INPUT AN OCTAL NUMBER /ECHOES INPUT IF IT WAS VALID /CALL: JMS OTIN / CR TERMINATOR / LF TERMINATOR / : TERMINATOR / /RETURNS WITH "DOUBLE PRECISION" INPUT IN /VALUE AND VALUE1 /INPUT=0 IF THERE WAS ANY, ELSE -1 OTIN, 0 CLA CMA DCA INPUT /NO INPUT YET DCA VALUE /SUBTOTAL DCA VALUE1 SKP OUTTLS LISTEN, INKRB DCA YCHAR /IS THE INPUT A VALID TERMINATOR? TAD YCHAR TAD KMCOLON /COLON? SNA JMP COEXIT /YES TAD KMLF /LF? SNA JMP LFEXIT /YES TAD KMCR /CR? SNA JMP CREXIT /YES /NOT A VALID TERMINATOR --- IS IT A VALID OCTAL DIGIT? TAD KMEIGHT STL TAD C0010 SZL /IS IT A VALID OCTAL DIGIT? JMP NOTOK /NO /COMES HERE WITH A VALID OCTAL DIGIT ISZ INPUT /REMEMBER THAT THERE IS INPUT NOP /NOW ADD THIS DIGIT TO THE DOUBLE PRECISION TOTAL DCA XCHAR /FIRST, SHIFT HIGH-ORDER WORD LEFT ONE PLACE TAD VALUE CLL RAL CLL RAL CLL RAL DCA VALUE /NOW GET LEFT-MOST LOW-ORDER DIGIT TAD VALUE1 RTL RTL AND C0007 /MOVE THIS DIGIT INTO THE HIGH ORDER WORD TAD VALUE DCA VALUE /NOW ADD NEW INPUT DIGIT TAD VALUE1 CLL RAL CLL RAL CLL RAL TAD XCHAR DCA VALUE1 TAD YCHAR JMP LISTEN-1 /NOW GO ECHO INPUT COEXIT, ISZ OTIN LFEXIT, ISZ OTIN CREXIT, TAD YCHAR OUTTLS /ECHO TERMINATOR JMP I OTIN NOTOK, CLA MESSAG NOTOK1 JMP OTIN+1 NOTOK1, TEXT " ?_" VALUE, 0 VALUE1, 0 OPNREG, 0 YCHAR, 0 XCHAR, 0 INPUT, -1 KMCOLON, -0272 KMLF, -0212+": KMCR, -0215+212 KMEIGHT, -0270+215 *0400 XOPEN, 0 JMS CONVERT /MAKE A DISC ADDRESS OUT OF VALUE, VALUE1 TAD READCOM /WE ARE READING JMS DISK JMP I XOPEN READCOM, 6603 /DMAR /ROUTINE TO CLOSE A DISC REGISTER CLOSE, 0 TAD WRITECOM JMS DISK JMP I CLOSE WRITECOM, 6605 /DMAW /DISC TRANSFER ROUTINE DISK, 0 DCA DISCIOT /READ IOT OR WRITE IOT /NOW HAVE TO SET UP 7750,7751 IN FIELD 0 /REMEMBER WHAT FIELD WE'RE IN NOW /SO WE CAN RESTORE RIF TAD .+2 DCA XFIELD CDF /NOW GO TO DATA FIELD 0 CLA CMA DCA I P7750 /LOOKING FOR ONE WORD TAD POPNREG DCA I P7751 /READ INTO OPNREG /7750, 7751 ARE SET --- RESTORE DATA FIELD /ALSO, SET DISC TO TRANSFER INTO THIS FIELD XFIELD, 0 RIF IFZERO RF08-40 6615 /DIML; FIELD , NO INTERRUPTS IFZERO RF08 CLA /DEAL DOESN'T CLEAR AC TAD I PDISCLO /PICK UP LOW ADDRESS DISCIOT, 0 /DMAR OR DMAW 6621 /DFSE -- ANY ERRORS? IFZERO RF08 IFZERO RF08-40 DCMA /DON'T LEAVE DISK FLAG UP JMP I DISK /YES P7750, 7750 P7751, 7751 PDISCHI, DISCHI PDISCLO, DISCLO POPNREG, OPNREG-1 /ROUTINE TO CONVERT THE DOUBLE PRECISION NUMBER /IN VALUE, VALUE1 INTO AN RF08 DISC ADDRESS /PUT IT IN DISCHI, DISCLO CONVERT, 0 CLA TAD I PVALUE IFZERO RF08-40 DCA I PDISCHI TAD I PVALU1 DCA I PDISCLO JMP I CONVERT PVALUE, VALUE PVALU1, VALUE1 /ROUTINE TO TYPE THE 4 OCTAL DIGITS IN THE AC /ON THE TELEPRINTER HACK, 0 CLL RAL DCA XHACK TAD KM4 DCA XCNT /4 DIGITS YHACK, TAD XHACK RTL RAL DCA XHACK TAD XHACK AND C0007 TAD K260 OUTTLS ISZ XCNT JMP YHACK JMP I HACK XCNT, 0 DISCHI, 0 DISCLO, 0 XHACK, 0 KM4, -4 K260, 260 /ROUTINE TO GET A CHAR FROM THE KEYBOARD IN, 0 KSF JMP .-1 JMS CCCHEK /IS IT A CONTROL-C? KRB AND C0177 TAD C0200 /IN CASE OF PARITY TERMINALS JMP I IN /RETURN CCCHEK, 0 KSF JMP I CCCHEK KRS /WHAT'S THE CHARACTER? AND C0177 /PARITY TERMINAL? TAD KCRC SMA CML SNA CLA JMP I SUPERA /HE WANTS TO RESTART - ^C JMP I CCCHEK /NO ^C KCRC, -3 /- ^C, STRIPPED OF PARITY BIT /ROUTINE TO TELEPRINT A CHAR OUT, 0 NOP /CHANGE TO "KSF" IF DESIRED TO TERMINATE PRINT-OUT UPON TYPE-AHEAD SKP /NO JMP OUT0 /YES; DON'T WASTE TIME WITH FURTHER PRINTING TLS TSF JMP .-1 OUT0, CLA CHEKCC JMP I OUT /ROUTINE TO INCREMENT THE DOUBLE-PRECISION VALUE /IN VALUE, VALUE1 NEXTAD, 0 CLA ISZ I PVALU1 JMP I NEXTAD ISZ I PVALUE JMP I NEXTAD /ROUTINE TO SAVE VALUE, VALUE1 SAVE, 0 TAD I PVALUE DCA SAVE1 TAD I PVALU1 DCA SAVE2 JMP I SAVE /ROUTINE TO RESTORE VALUE, VALUE1 RESTOR, 0 TAD SAVE1 DCA I PVALUE TAD SAVE2 DCA I PVALU1 JMP I RESTOR SAVE1, 0 SAVE2, 0 *600 LOGMES, 0 /PUT MESSAGE OF THE DAY IN SI YESNO LOGM1 /"PROMO?" JMP I LOGMES /NO DISC /YES, READ SI INTO FIELD 1 6603 SIDEX+1 DISCHK /CHECK FOR DISK OK LOG2LG, MESSAG /MESSAGE TOO LONG LOGM2 /"END WITH ALTMODE" STA TAD LOGST /VERBRK DCA AXS1 TAD LOGST DCA NUMHO /FOR GETCH IAC DCA NUMHO+1 DATFLD /LOGIN MESSAGE TO FIELD 1 LOGNEX, JMS I GETCHA /GET A CHARACTER INTO BUFFER JMP LOG2LG /MESSAGE TOO LONG TAD MC0377 /IS IT AN ESCAPE OR ALTMODE? IAC /TEST FOR MODEL 35 ALTMODE SZA IAC /TEST FOR ALTMODE SZA TAD LOGESC /TEST FOR ESCAPE SZA CLA JMP LOGNEX /NOT ESCAPE OR ALTMODE, GET ANOTHER CHAR TAD AXS1 DCA CHAR DCA I CHAR /A 0 ENDS THE MESSAGE IN SI CHDF MESSAG /ECHO $CR-LF LOGM3 DISC /WRITE OUT SI 6605 SIDEX+1 DISCHK /CHECK FOR DISK OK JMP I LOGMES LOGST, VERBRK /START OF INSTALLATION MESSAGE OF THE DAY GETCHA, GETCH LOGESC, 375-233 /ALT MODE MINUS ESCAPE OCI260, -260 OCTINT, 0 OCTIN0, 0 DCA OCTINT STA TAD INBUF DCA AXS1 OCTIN1, TAD I AXS1 DCA AXS2 TAD AXS2 TAD OCI260 SPA JMP OCTIN2 TAD C7770 SMA JMP OCTIN2 TAD C0010 DCA AXS2 TAD OCTINT CLL RTL RAL TAD AXS2 DCA OCTINT JMP OCTIN1 OCTIN2, CLL CLA TAD OCTINT JMP I OCTIN0 /AFTER LOAD OR DUMP, BOOT BACK TO WHATEVER OPERATING SYSTEM IS ON THE RF08. /THIS WAY, INIT CAN BE USED TO LOAD/DUMP OS/8. RBOOT, 6641 /DCXA /CLEAR RF08 EXTENDED DISK ADDRESS DCEA /AND EVERYTHING ELSE -200 /CLA DMAR DFSC 5352 /JMP . 5752 /JMP I .-1 CRLF= LOGM2+10 LOGM2, TEXT "END WITH ALTMODE_" LOGM3, TEXT "$_" SYSTEM, TEXT "SYSTEM" LIBARY, TEXT "LIBRARY" OPRAT, TEXT "OPERATOR" PASWRD, TEXT " PASSWORD? " TAB, -01 -11 -21 -41 -51 /THE NEXT WORD MUST BE POSITIVE MSG, TEXT "_SI" TEXT "_FIP" TEXT "_INIT" TEXT "_TS8" TEXT "_PUTR" UPAROW, TEXT " ^ " *INIP /ZERO OUT FIRST 6 TRACKS IN PREPARATION FOR BUILDING NEW SYSTEM SBUILD, YESNO REALLY JMP I SUPERA /LUCKILY WE CAUGHT HIM/HER ZERO1 /ZERO FIELD 1 TAD C0051 /START AT TRACK 5, FIELD 1 SB2, DCA SB3 DISC DMAW /WRITE A FIELD OF ZEROES TO DISK SB3, .-. DISCHK /MAKE SURE DISK IS OK TAD SB3 TAD C7770 /GO TO PREVIOUS TRACK SMA /ARE WE THROUGH? JMP SB2 /NO TAD MSGA /INITIALIZE ADDRESS OF MESSAGES DCA MSGB TAD TABA /INITIALIZE TABLE POINTER DCA TABB BUILD1, MESSAG /ASK FOR A TAPE MSGB, .-. TAD I PATXAD DCA SB3 MESSAG UPAROW /" ^ " SB4, IFNZRO CPU&7776 <6030> /ON 8E, CLEAR FLAG, BUT NO READER RUN IFZERO CPU&7776 /CLEAR FLAG INKRB /WAIT FOR A KEY TO BE PRESSED TAD C7600 /LEADER? SZA TAD C7763 /CARRIAGE RETURN? SZA CLA JMP SB4 /NO STA DCA FLAG /ROUTINE TO PATCH THE DISK. A BINARY TAPE IS READ, AND THE CORRESPONDING /WORDS ON A DISK TRACK ARE PATCHED. THE FIELD SETTING ON THE TAPE /DETERMINES WHICH TRACK WILL BE PATCHED. A TAPE WITHOUT A FIELD SETTING /WILL PATCH TRACK 5. A TAPE WITHOUT AN ORIGIN WILL LOAD STARTING AT 0 /HENCE A SAVE FORMAT TAPE WILL LOAD PROPERLY INTO THE SWAP TRACK FOR /JOB NUMBER 1. PATCH, DISC DMAR /READ TRACK 5 INTO CORE C0051, 0051 /TO PATCH IT IF NO FIELD SETTING DISCHK /MAKE SURE THE DISK IS OK TAD .-2 /NOW REMEMBER WHAT IS IN FIELD 1 DCA PATW /SO IT WILL BE PROPERLY RE-WRITTEN TAD PATW DCA PATR CDF 10 /USE FIELD 1 AS BUFFER JMS I BINTA /READ THE BINARY TAPE JMP PATFLD /A FIELD SETTING HAS BEEN ENCOUNTERED SNA /END OF TAPE - WAS THERE A CHECKSUM ERROR? JMS PATRW /NO, SO WRITE OUT FIELD 1 ISZ FLAG /WHERE DID WE COME FROM? JMP I SUPERA /BACK TO SUPERVISOR CHDF SZA CLA /CONTINUE BUILDING - WAS THERE ERROR? JMP BHUH /YES - TRY AGAIN TAD I TABB /NO - WAS RIGHT TAPE LOADED? TAD PATR SZA CLA JMP BHUH /NO - TRY AGAIN IAC TAD SB3 /ADDRESS OF LAST CHARACTER TYPED + 1 DCA MSGB /SET UP FOR NEXT MESSAGE ISZ TABB TAD I TABB /ARE WE THROUGH? SPA CLA JMP BUILD1 /NO JMP I .+1 /YES SUPREF BHUH, MESSAG HUH2 JMP BUILD1 PATXAD, BUFPTR MSGA, MSG+7 /AC IS -7 WHEN THIS IS TADDED TABA, TAB FLAG, 0 TABB, 0 PATFLD, IAC /TRACK IS IN BITS 6-8, MAKE IT FIELD 1 DCA PATR /AND SAVE IT JMS PATRW /WRITE PREVIOUS TRACK; READ NEW ONE JMP I BINT3A /AND CONTINUE BINT3A, BINT3 BINTA, BINTAP PATRW, 0 DISC DMAW /WRITE THE PREVIOUS TRACK PATW, .-. /TRACK FOR PREVIOUS PATCHING DISCHK /MAKE SURE THE DISK IS OK DISC DMAR /READ IN NEW TRACK PATR, 1 /TRACK FOR UPCOMING PATCHING DISCHK /MAKE SURE THE DISK IS OK TAD PATR DCA PATW /REMEMBER WHICH TRACK WE'RE WORKING ON JMP I PATRW /AND RETURN /SYSTEM INITIALIZATION SYSINI, DISC /READ INIT INTO FIELD 2 DMAR 0022 DISCHK /MAKE SURE DISK IS OK CIF CDF 20 /NOW GO THERE JMP .+1 TAD .-2 DCA INIF /SET UP CHDF JMS I SYSPER /INITIALIZE FIP DISC /LOAD FIELD 0 6603 TS8DEX DISCHK /CHECK FOR DISK OK TAD DVTBA DCA INIT0 SYSI1, TAD I INIT0 DCA CHDFA JMS I CHDFA ISZ INIT0 JMP SYSI1 SYSPER, PERSET INIT0, 0 /VARIABLE DVTB POINTER DVTBA, DVTB /ADDRESS OF DVTB XTELL, TEXT "_EXEC DDT LOADED_" DVTB, CLEAR /READ MONITOR II INTO DATFLD CORINI DSKINI DATEIN TIMEIN START *INIP+200 /NUMBER INPUT /CALL NUMBIN / NOT A NUMBER / # IN AC NUMBIN= JMS I NUMBIA NUMBI0, 0 DCA NUMAGN /NUMBER MAGNITUDE CLL STA RTL /MAXIMUM OF TWO DIGITS IN NUMBER DCA NUMCNT JMS I NUMSKP /SKIP LEADING TABS AND SPACES JMP I NUMBI0 /NOTHING THERE NUMBI1, TAD CHAR TAD NUMM9 SMA SZA JMP NUMBI3 /NOT A NUMBER TAD NUMP9 SPA JMP NUMBI3 /NOT A NUMBER DCA CHAR ISZ NUMCNT SKP JMP I NUMBI0 /TOO MANY DIGITS TAD NUMAGN / * 1 CLL RTL / * 4 TAD NUMAGN / * 5 RAL / * 10 TAD CHAR DCA NUMAGN COMGET JMP NUMBI3 /NO MORE CHARACTERS JMP NUMBI1 NUMBI3, CLA TAD C0003 /HAVE ANY DIGITS BEEN FOUND? TAD NUMCNT SNA CLA JMP I NUMBI0 /NO ISZ NUMBI0 TAD NUMAGN JMP I NUMBI0 NUMAGN= NUMHO+1 NUMCNT, 0 NUMSKP, SKIPS NUMM9, -"9 NUMP9, 11 START, 0 DTCA PCF IFZERO D689-4 < EDF /TURN ON DATA PHONES DFCRF CCF > TSF /WAIT FOR CONSOLE FLAG FROM DIALOG JMP .-1 TCF RRB KCC CIF CDF IFNZRO DC08A < T1ON > IFZERO DC08A < IFZERO CPU-1 < CLL CMA /LOAD CLOCK BUFFER CCF CLB > > IFZERO DC08A < IFNZRO CPU-4 IFZERO CPU-4 > IFZERO LPT-1 /CLEAR INTERRUPT FOR LPT ION WAIT REALLY, TEXT "BUILD? " /ASK WHETHER TO READ OR WRITE RW, 0 CLA CLL RIF TAD C6201 DCA INIF /INITIALIZE CHDF CHDF TAD I RW DCA .+2 RW1, MESSAG .-. /CRLF OR "TAPE " MESSAG RDORWT /READ OR WRITE? GETIN TAD I INBUF /FIRST CHARACTER TAD RWMR /R? CLL SZA /YES TAD RWMW /W? SET LINK SZA CLA JMP RW1 /NOT R OR W RTL /0 FOR R, 2 FOR W ISZ RW JMP I RW RWMR, -"R RWMW, "R-"W KEBOOT, IAC CLL RTL RFBOOT, TAD OSTAB DCA AXS1 TAD I AXS1 DCA OSF TAD I AXS1 DCA OST TAD I AXS1 DCA OSC TAD I AXS1 DCA OSA /BOOTWTRAP FOR DEVICE OF YOUR CHOICE -- SET FOR DECTAPE HERE OSB, CHDF TAD I OSF CDF DCA I OST ISZ OSF ISZ OST ISZ OSC JMP OSB DTRA DTXA /MAKE LAST TAPE FLAP (LOAD/DUMP) CDF CIF JMP I OSA *INIP+400 FREND, -FIPBLK /END OF FREE CORE LODDTA, LODDT /LOAD XDDT INTO FIELD 1 XDDFLG, -1 CORFLD, 0 CORLNK, 0 CORJMS, 0 /ISZ I CONDBA IF ^S/^Q FEATURE DISABLED CORCSQ, KBDSQ /LOCATION OF JMS FOR ^S FEATURE CORINI, 0 ISZ XDDFLG /DID HE WANT EXEC DDT? JMS I LODDTA /YES TAD CORJMS CDF SZA DCA I CORCSQ /NO! TAD CORFLD /HOW MANY USER FIELDS DID HE SAY SNA /NO RESPONSE IAC /ASSUME 1 USER FIELD DCA CORCNT TAD CORCNT CMA /INIT CORE SEARCH ROUTINE DCA AXS1 CLL CMA RTL TAD CORSRA DCA AXS2 IAC TAD AXS1 DCA I AXS2 TAD CORTBA CMA TAD AXS1 DCA I AXS2 TAD CORTBA DCA AXS2 CLL CML RTR /ASSIGN AND LOCK DATFLD DCA I AXS2 /NOW UNLOCK ALL USER FIELDS ISZ AXS1 JMP .-2 STL RTL TAD CORCNT CLL RTL DCA CORCNT TAD CORCNT TAD DSUTBA TAD C0010 /MUST START IN MULTIPLE OF 8 AND C7770 DCA I FREE TAD I FREE DATFLD DCA CORLNK TAD CORGEA DCA CORF1 CORIN1, TAD CORLNK TAD C0010 DCA AXS2 CORIN4, TAD AXS2 TAD FREND SNA CLA JMP CORIN2 /DONE TAD AXS2 DCA I CORLNK TAD AXS2 DCA CORLNK ISZ AXS1 JMP CORIN1 HLT /OOPS!!! CORIN2, TAD I CORF1 /ANY EXTRA FREE CORE TO BE GENERATED? SNA JMP CORIN3 DCA AXS2 ISZ CORF1 TAD I CORF1 CIA DCA FREND ISZ CORF1 JMP CORIN4 CORIN3, DCA I CORLNK /LAST LINK IS ZERO TAD AXS1 IAC CDF DCA I FRECNT CHDF JMP I CORINI CORF1, 0 CORGEA, RINGIN FRETEL, 0 MESSAG CY50 IFNZRO CPU-2 IFZERO CPU-2 JMP I FRETEL LOGM1, TEXT "_NEW LOGIN MESSAGE? " FREQUE, TEXT "60 HERTZ POWER? " CY50, TEXT "50 HERTZ ASSUMED_" *INIP+600 /SKIP LEADING SPACES AND TABS /CALL JMS SKIPS / BUFFER EMPTY / NORMAL RETURN SKISPA, -240 SKITAB, 240-211 SKIPS, 0 SKIPS1, COMGET JMP I SKIPS /NONE LEFT TAD SKISPA TAD CHAR SZA TAD SKITAB SNA CLA JMP SKIPS1 ISZ SKIPS JMP I SKIPS MESSA0, 0 RDF TAD C6201 DCA MESSA2 CHDF TAD I MESSA0 DCA BUFPTR ISZ MESSA0 MESSA1, TAD I BUFPTR /PICK UP NEXT WORD SNA /DONE? JMP MESSA2 /YES RTR /GET LEFT HALF OF WORD RTR RTR JMS PRINTI /PRINT IT TAD I BUFPTR AND K0077 SNA /DONE? JMP MESSA2 /YES JMS PRINTI /PRINT IT ISZ BUFPTR /NEXT WORD JMP MESSA1 MESSA2, .-. /CDF TO RESTORE DATA FIELD JMP I MESSA0 /RETURN PRINTI, 0 AND K0077 TAD K7741 SNA /BACKARROW? JMP PRCRLF /YUP - TIME FOR CARRIAGE RETURN, LINE FEED SPA TAD C0100 /RESTORE BIT 5 TAD C0037 PRINT2, OUTTLS /PRINT THE CHARACTER JMP I PRINTI /RETURN PRCRLF, TAD CM215 /GET A CARRIAGE RETURN CIA OUTTLS TAD C0212 /AND NOW LINE FEED JMP PRINT2 BUFPTR, 0 K0077, 0077 K7741, 7741 GETIN0, 0 GETIN1, STA TAD INBUF DCA AXS1 /FOR GETCH TAD INBUF DCA NUMHO TAD GETIN3 /MINUS THE LAST LOCATION IN THE BUFFER DCA NUMHO+1 GETIN2, JMS GETCH /GET A CHARACTER INTO THE BUFFER JMP GETIN1 /BUFFER FULL; TRY AGAIN TAD CM212 /HAS HE TYPED A CR (OR LINE FEED)? SNA CLA JMP I GETIN0 /YES, WE'RE ALL THROUGH HERE JMP GETIN2 /NO, GET ANOTHER CHARACTER GETIN3, -INBUFA-20 CM212, -212 CM215, -215 C0212, 212 /SUBROUTINE TO GET A CHARACTER, AND PUT IT IN THE BUFFER. /RETURN CALL PLUS 1 IF TOO MANY CHARACTERS WERE TYPED. /RETURN CALL PLUS 2 WITH CHARACTER IN AC IS THE NORMAL RETURN. /UPON RUBOUT, ECHOES RUBBED CHARACTERS, BUT NOT PAST BEGINNING OF BUFFER. GETCH, 0 GETESC, 377-233 GETCH1, INKRB GETCH2, DCA CHAR TAD CHAR TAD MC0377 SNA /IS IT A RUBOUT? JMP GETCH3 /YES, GO WORRY ABOUT IT TAD GETESC /IS IT ESCAPE? SZA CLA /YES; DON'T ECHO TAD CHAR OUTTLS /ECHO CHARACTER TAD AXS1 TAD NUMHO+1 /THIS SHOULD BE MINUS THE LAST ADDRESS IN THE BUFFER SMA CLA /HAVE WE OVERRUN THE END OF THE BUFFER? JMP GETCH5 /YES TAD CHAR DCA I AXS1 /ALL OK, NOW SAVE THE CHAR IN THE BUFFER TAD CHAR TAD CM215 SZA CLA /WAS THAT A CARRIAGE RETURN? JMP GETCH4 /NO TAD C0212 /GET LINE FEED AND ECHO, STORE IT JMP GETCH2 GETCH3, TAD AXS1 /HE TYPED A RUBOUT DCA CHAR /SAVE BUFFER POINTER TAD AXS1 CIA TAD NUMHO /THIS SHOULD BE THE INITIAL VALUE OF AXS1 SMA SZA CLA /IS HE BACKING UP TOO FAR? JMP GETCH1 /YES, JUST IGNORE THE RUBOUT TAD I CHAR /GOT GET THE RUBBED-OUT CHARACTER OUTTLS /AND ECHO IT STA TAD AXS1 /NOW BACK UP AXS1 DCA AXS1 JMP GETCH1 GETCH4, TAD CHAR /PUT CHAR IN AC FOR RETURN ISZ GETCH //SKIP ON RETURN JMP I GETCH /AND RETURN GETCH5, MESSAG /THE DUMMY IS TOO PROLIFIC WITH THE TYPING!! HUH JMP I GETCH *INIP+1000 /INIT BOOTSTRAP - LOAD TRACK 2 INTO FIELD 0 INBOOT, DCA DATEIN /SAVE AC DISC DMAR /READ TRACK 2 TO FIELD 0 0020 TAD DATEIN /RESTORE AC DFSC JMP .-1 CIF CDF /AWAY TO FIELD 0, IF WE AREN'T THERE ALREADY DCA CHDFA /AC SAYS WHERE TO JUMP TAD C6201 DCA I INIFA JMP I CHDFA /SO JUMP THERE SUPREF, TAD SUPFUG /REFRESH SUPST, TAD SYSINA /START JMP INBOOT /BOOT IN FRESH COPY OF INIT INIFA, INIF SYSINA, SYSINI SUPFUG, REFCO0-SYSINI /DATE INPUT /DATE=((YEAR-1974)*12+(MONTH-1))*31+DAY-1 DATMUL, DMUL CMCR, -215 C0012, 14 C0031, 37 DECIMAL DM13, -13 D11, 11 D31, 31 DM74, -74 OCTAL DATMON, 0 DATDAY, 0 DATEIN, 0 CLA CLL MESSAG /MONTH-DAY-YEAR: DATMES GETIN STA TAD INBUF DCA AXS1 NUMBIN /MONTH JMP DATEIN+1 TAD DM13 STL IAC TAD D11 SZL /0 /55 TICKS PER SYSTEM TICK IF DC08A; INITIALIZED AT REFRESH TIME IFZERO DC08A <-12> /IN CASE OF PDP-8/A CLKINA, CLKINI TIMCK2, -INCLK2-1 TIMCK1, -INCLK1 C660, TICMIN /TICKS PER MINUTE DECIMAL DM24, -24 D24, 24 DM60, -60 D60, 60 OCTAL TIMEIN, 0 CLA CLL MESSAG TIMESS /TIME: GETIN STA TAD INBUF DCA AXS1 DCA CHAR NUMBIN JMP TIMEIN+1 TAD DM24 STL TAD D24 SZL /HOURS BETWEEN 0 AND 23? JMP TIMEIN+1 /NO DCA NUMHO+1 DCA NUMHO TAD D60 JMS DMUL DCA CHAR NUMBIN JMP TIMEIN+1 TAD DM60 STL TAD D60 SZL /MINUTES BETWEEN 0 AND 59? JMP TIMEIN+1 /NO TAD NUMHO+2 DCA NUMHO+1 DCA NUMHO TAD C660 JMS DMUL CLL CDF TAD NUMHO+2 TAD TIMCK1 DCA I CLK1 RAL TAD NUMHO+1 TAD TIMCK2 DCA I CLK2 TAD FREQ DCA I CLKINA CHDF JMP I TIMEIN DMUL, 0 DCA MP2 /MULTIPLIER TAD NUMHO+1 /LOW ORDER MULTIPLICAND JMS MP4 DCA NUMHO+2 /LOW ORDER TAD MP5 DCA NUMHO+1 /HIGH ORDER TAD NUMHO /HIGH ORDER MULTIPLICAND SNA JMP I DMUL JMS MP4 TAD NUMHO+1 DCA NUMHO+1 RAL /GET CARRY TAD MP5 DCA NUMHO JMP I DMUL MP4, 0 DCA MP1 DCA MP5 TAD M12 DCA MP3 CLL TAD MP1 RAR DCA MP1 TAD MP5 SNL JMP .+3 CLL TAD MP2 RAR DCA MP5 ISZ MP3 JMP MP4+6 TAD MP1 RAR CLL JMP I MP4 MP1, 0 MP2, 0 MP3, 0 MP5= CHDFA M12, -14 CORMES, TEXT "# USER FIELDS - " INBUFA= . ZBLOCK 20 /INPUT BUFFER FOR INIT INPUT *INIP+1600 /DECTAPE - READ OR WRITE ONE FIELD /JMS TO DTRORW WITH DESIRED FIELD IN DTFLD, BEGINNING BLOCK MINUS /ONE IN DTBLOK, DESIRED DRIVE IN CONTROLLER, AND DTFUNC /0050 FOR A WRITE OR 0030 FOR A READ. DTRORW, 0 STA DCA DTCAS /START CA AT -1 TAD C7740 DCA DTBLCT /40 BLOCKS PER FIELD DTRA AND C0200 /IS TAPE MOVING?? SNA CLA TAD C0600 /NO - START IT THE OTHER WAY DTXA DTSR1, TAD C7773 DCA DTRY /TRY 5 TIMES UPON ERROR DTSR2, DTLB /BLOCK NUMBERS TO THIS FIELD DCA I C7755 /AT LOCATION 0 TAD C0010 /START SEARCHING DTSR3, DTXA JMS DTWAIT /WAIT DTRA RTL RTL /DIRECTION BIT TO LINK CLA TAD DTBLOK /DESIRED BLOCK - 1 CMA /-DESIRED BLOCK SZL /FUDGE IF GOING IN REVERSE TAD C0003 TAD 0 /REAL BLOCK - DESIRED BLOCK (+3?) SNA CLA /WHAT DO WE DO NOW? SNL JMP DTSR7 /KEEP GOING, MAYBE REVERSE DIRECTION TAD C7600 /WE'RE THERE, MAKE WC=-200 DCA I C7754 TAD DTCAS DCA I C7755 /SET UP CA TAD DTFLD DTLB /SET UP FIELD FOR TRANSFER TAD DTFUNC DTXA /SET UP FOR READ OR WRITE JMS DTWAIT /WAIT TAD I C7755 /SAVE NEW CURRENT ADDRESS DCA DTCAS DTRA /REMOVE ANY FUNCTION FROM CONTROLLER AND C0077 DTXA ISZ DTBLOK /TIME FOR NEXT BLOCK ISZ DTBLCT /ARE WE THROUGH? JMP DTSR1 /NO TAD DTBLOK /YES - TAD CM2677 /END OF TAPE?? SPA CLA JMP I DTRORW /NO TAD C0400 /YES DTXA /REWIND TAPE DTRA TAD C1000 /GO TO NEXT DRIVE AND C7000 DCA DTBLOK CHEKCC /STALL DTRA DTXA CHEKCC /STALL TAD DTBLOK DTXA /REMEMBER IT IN THE CONTROLLER DCA DTBLOK /START AT BLOCK 1 CHEKCC /STALL JMP I DTRORW /RETURN DTSR7, SNL /REVERSE DIRECTION? JMP DTSR3 /NO TAD C0400 ISZ DTRY /COUNT AN ERROR JMP DTSR3 /AND GO REVERSE DIRECTION TAD C7600 /AC=200 DTXA /STOP THE TAPE MESSAG TAPMIS JMP I SUPERA TAPMIS, TEXT "_DECTAPE ERROR" DTRY, 0 DTBLCT, 0 /COUNT OF BLOCKS TO R/W FOR ONE FIELD DTBLOK, 0 /CURRENT DESIRED BLOCK MINUS ONE DTFLD, 0 /DECTAPE FIELD IN BITS 6-8 DTFUNC, 0 /DECTAPE FUNCTION, 30 FOR READ, 50 FOR WRITE DTLA= 6766 /SHOULDN'T BE HERE, BUT PUT IT IN WHILE I REMEMBER DTCAS, 0 C7773, 7773 C7754, 7754 C7755, 7755 CM2677, -2677 C0077, 0077 C7000, 7000 STATB, 0 /FOR DIAGNOSTIC PURPOSES /MOST RECENT DECTAPE STATUS B ON ERROR /DTWAIT - SUBROUTINE TO WAIT FOR DECTAPE COMPLETION FLAG DTWAIT, 0 DTSF JMP .-1 /WAIT FOR FLAG CHEKCC DTRB SMA CLA /ANY ERROR? JMP I DTWAIT /NO DTRB DCA STATB /FOR DIAGNOSTIC PURPOSES TAD STATB AND C0400 /SELECT ERROR? SZA CLA JMP DTWSEL /YES DTWGOR, DTRA AND C0377 /REMOVE FUNCTION FROM CONTROLLER DTXA TAD C0600 /GO IN REVERSE DTXA JMP DTSR2 DTWSEL, DCA 0 DTXA /SELECT ERROR! C0600, 0600 /WASTE TIME - SELECT ERROR RETURNS AFTER C0377, 0377 /WASTE TIME - 5 MICROSECONDS AFTER DTXA CHEKCC DTRB /IS IT STILL THERE? SPA CLA JMP DTWSEL /YES, TRY AGAIN ISZ 0 /NO, WAIT A WHILE JMP DTWSEL+1 JMP DTWGOR /OK, IT SEEMS TO BE GONE *INIP+2000 /4K DISK READ OR WRITE LOAD, JMS I RWB /GO TO INITIALIZE CHDF, PRINT MESSAGE, CRLF /AND DETERMINE READ OR WRITE TAD C6603 /MAKE A DMAW OR A DMAR DCA RORW MESSAG FIELD1 GETIN TAD I INBUF AND C0007 DCA FLDNUM MESSAG TRACK GETIN OCTIN CLL RTL RAL TAD FLDNUM DCA FLDNUM DISC RORW, 0 FLDNUM, 0 DISCHK /CHECK FOR DISK OK JMP LOAD C6603, 6603 RWB, RW ASCI7, CLEAR, 0 CLA DISC /READ MONITOR II INTO FIELD 1 6603 TS8DEX+11 DISCHK /CHECK FOR OK DISK COMPLETION TAD CLR1 JMS ZERO /ZERO OUT FREE CORE JMP I CLEAR CLR1, JOBTBL ASCI6, ZERO, 0 /CLEAR FIELD 1 FROM C(AC) TO 7777 DCA CLR2 /BEGINNING ADDRESS DATFLD DCA I CLR2 ISZ CLR2 JMP .-2 CHDF JMP I ZERO ASCNT, CLR2, 0 /ROUTINE TO MOVE XDDT INTO DATFLD LODDT, 0 TAD KM4400 DCA I FRENDA /MAKE FRECORE STOP AT 4400 STA TAD K4400 DCA AXS1 /POINTS TO ORIGINAL TAD AXS1 DCA AXS2 /POINTS TO COPY LODDT1, CHDF TAD I AXS1 DATFLD DCA I AXS2 ISZ DDTSIZ /ARE WE DONE YET? JMP LODDT1 DCA I XOPA /CHANGE ^C TO JUMP TO FIELD 0 CHDF MESSAG XTELL JMP I LODDT /YES XOPA, XOP K4400, 4400 KM4400, -4400 FRENDA, FREND DDTSIZ, 4400-7577 /THIS GETS DESTROYED, BUT WHAT THE HECK DDTMES, TEXT "LOAD EXEC DDT AT START-UP? " /ROUTINE TO CONVERT ASCII TO TSS/8 SIXBIT ASCSIX, 0 CLL STA RAL /SET AC=-2 DCA ASCNT TAD INBUF DCA ASCI6 /INPUT BUFFER TAD I ASCSIX DCA ASCI7 /POINTER TO OUTPUT VECTOR ISZ ASCSIX ASCI1, JMS ASCGET /GET ONE CHARACTER CLL RTL RTL RTL /SHIFT TO HIGH ORDER DCA I ASCI7 /SAVE THE CHARACTER CHDF JMS ASCGET /GO GET ANOTHER CHARACTER TAD I ASCI7 /PACK IT IN WITH THE LAST ONE DCA I ASCI7 /AND SAVE IT ISZ ASCI7 CHDF ISZ ASCNT /DONE? JMP ASCI1 /NO JMP I ASCSIX /YES, EXIT ASC240, -240 ASCGET, 0 /GET A PASSWORD CHARACTER, EXIT UPON CARRIAGE RETURN TAD I ASCI6 /GET NEXT CHARACTER TAD ASCCR SNA CLA /IS IT CR? JMP I ASCSIX /YES, RETURN TAD I ASCI6 ISZ ASCI6 TAD ASC240 /PASSWORDS ARE STORED IN EXCESS 240 CODE DATFLD JMP I ASCGET ASCCR, -215 CSQ, TEXT "ENABLE ^S FEATURE? " *INIP+2200 /USES INIT'S BINARY LOADER TO LOAD INTO FIELD 1 ZERO1 /ZERO FIELD 1 DATFLD Y1, JMS I BINLD /GO LOAD BINARY TAPE SKP /FIELD SETTING ENCOUNTERED JMP I SUPERA /END OF TAPE DCA DISC0 /SAVE IT RDF CIA TAD DISC0 /IS IT THE CURRENT FIELD ANYWAY? SNA CLA JMP I BINT3B /YES - SO IT'S OK TAD DISC0 /NO - LET HIM/HER KNOW ABOUT IT HLT CLA /IGNORE FIELD SETTING JMP I BINT3B BINLD, BINTAP BINT3B, BINT3 Y, JMS I STFLDA JMP Y1 STFLDA, STFLD RDORWT, TEXT "READ OR WRITE - " FIELD1, TEXT "FIELD NUMBER - " TRACK, TEXT "TRACK NUMBER - " TAPMES, TEXT "_TAPE " TIMESS, TEXT "HR:MIN - " NUMBLK, TEXT "# - " YN, TEXT "YES OR NO... " /DISK READ OR WRITE /CALL DISC / FUNCTION / DEAL ARGUMENTS (DISC EXTENSION IN BITS 1-8; MEMORY FIELD IN BITS 9-11) / DISCHK / RETURN HERE WHEN OK DISC= JMS I DISCA DISCHK= JMS I DISCHA DISC0, 0 RDF TAD C6201 DCA DISC2 CHDF TAD I DISC0 DCA DISROW ISZ DISC0 TAD I DISC0 DCA DEALSV /SAVE THE DEAL ARGUMENTS TAD DEALSV IFZERO RF08-40 < ISZ DISC0 CLL RTL RAL DEAL CLA CLL> IFZERO RF08 < RTL RAL AND C0070 DIML TAD I DISC0 CLL RTR ISZ DISC0 RAR DXAL> CDF DCA I C7750 STA DCA I C7751 DISROW, 0 JMP I DISC0 C0070, 70 C7750, 7750 C7751, 7751 /SUBROUTINE TO WAIT FOR DISK COMPLETION, CHECK FOR ERRORS, AND /IF THERE ARE ANY ERRORS, RETRY THE OPERATION. DISCH0, 0 CLL STA RTL DCA RFTRY /TRY 3 TIMES IFZERO RF08 IFNZRO RF08 JMP .-1 /WAIT FOR THE DISK TO FINISH DFSE /ERROR? IFZERO RF08-40 /DF32 SKIPS BACKWARDS JMP DISC2 /NO DIMA AND DSKFLG /CHECK WLS, DRL, PER CDF SNA TAD I C7750 /MAYBE NXD - IS WC=0? DISC2, .-. /CDF -- RESTORE DATA FIELD SNA /OK? JMP I DISCH0 /I GUESS SO ISZ RFTRY /3 TRIES YET? CLA SKP JMP DISERR /DISK WRITE LOCKED, PARITY ERROR, OR DRL TAD DISROW /GET OLD DMAR OR DMAW DCA .+2 DISC 0 DEALSV, 0 /DEAL ARGUMENTS SAVED BY LAST DISC CALL JMP DISCH0+3 DSKFLG, IFZERO RF08 <1005> IFZERO RF08-40 <0007> RFTRY, 0 /RETRY COUNT FOR DISK ERRORS DISERR, MESSAG DISKER JMP I SUPERA DISKER, TEXT "_DISK ERROR" *INIP+2400 /DISC DUMP ON DTA1 /DECTAPE BLOCK 40N+1=DISC TRACK N DSKDMP, JMS I RWA /GO TO INITIALIZE CHDF, PRINT MESSAGE, TAPMES /AND DETERMINE READ OR WRITE DCA DTA MESSAG NUMBLK GETIN OCTIN CIA SNA DSKSUP, TAD DSKSZ DCA LDFCNT /SAVE DISK TRACK COUNT DCA RFFUNC /WELL, FOLKS, THE FOLLOWING ROUTINE CHDF /ONLY WORKS IN FIELD 0, SO HERE TAD I RFFUNC /WE GO, MOVING EVERYTHING DOWN TO CDF /FIELD 0 SO THAT IT WILL BE HAPPY DCA I RFFUNC ISZ RFFUNC JMP .-5 CIF CDF /AND DOWN TO FIELD 0! JMP .+1 TAD .-2 DCA INIF /SET UP CHDF FOR FIELD 0 TAD DTA /IS IT LOAD OR DUMP?? CLL SNA CLA STL SNL /SKIP IF READ TAD C0020 TAD C0030 DCA I DTFUNA /SAVE FUNCTION FOR DECTAPE TAD RFDMAR SZL /SKIP IF DISK READ TAD C0002 /MAKE IT DMAW DCA RFFUNC /SAVE DMAR OR DMAW TAD LDFCNT RAL DCA LDFCNT /FUDGE LDFCNT SO THAT IT ISZES TO 0 AT THE RIGHT TIME DCA I DTBLKA /START AT DECTAPE BLOCK 1 TAD C1000 DTLA /START WITH DECTAPE DRIVE 1 IAC DCA RFTRAK /START WITH RF08/DF32 TRACK 0 FIELD 1 TAD C0010 DCA I DTFLDA /START WITH DECTAPE FIELD 1 TAD DTA SZA CLA /LOAD OR DUMP? JMP DMPINI /MUST BE DUMP JMS I DTRWA /READ FIRST TRACK FROM DECTAPE DISC /READ OR WRITE - START OPERATION ONLY RFFUNC, 0 /DMAR OR DMAW RFTRAK, 0 /BITS 1-8=TRACK, 9-11=FIELD ISZ LDFCNT /DONE LOADING? JMP LD2 /NO DISCHK /YES - LAST WRITE OK?? JMP LDSTOP LD2, TAD RFTRAK /WHAT FIELD DOES DECTAPE GO TO NOW? RTR SPA CLA TAD C0010 TAD C0010 DCA I DTFLDA JMS I DTRWA /READ/WRITE DECTAPE ISZ LDFCNT /DONE DUMPING??? JMP DMPJMP /NO DCMA /MAKE SURE THE DISK IS STOPPED LDSTOP, TAD C0400 /YES - REWIND LAST DECTAPE DTXA JMP I .+1 RFBOOT /NOW GO BOOT WHATEVER IS ON RF08/DF32 DMPJMP, DISCHK /DISK OK?? TAD RFTRAK RAR SZL CLA TAD C0002 TAD C0007 TAD RFTRAK DCA RFTRAK JMP RFFUNC-1 DMPINI, DISC RFDMAR, DMAR 1 JMP DMPJMP SUPDMP, STA SUPLOD, DCA DTA /SET DTA NON-0 FOR LOAD, 0 FOR DUMP JMP DSKSUP /AND GO LOAD OR DUMP DTA, 0 DSKSZ, -DSKSIZ LDFCNT, 0 DTFUNA, DTFUNC DTBLKA, DTBLOK DTFLDA, DTFLD DTRWA, DTRORW C0020, 0020 C0030, 0030 RWA, RW TAPERR, TEXT "_TAPE READ ERROR" HUH, TEXT "_WHAT?_PLEASE TRY AGAIN_" HUH2= HUH+3 /FILE PHANTOM AND DISK REFRESHER /WRITE NEW MFD ON DISC DIRECTLY ABOVE THE SWAPPING AREA PAGE FIPR4, 0 FIPASC, ASCSIX MFD1, MFDT-1 FIPREF, ZERO1 /ZERO FIELD 1 MESSAG /"SYSTEM" SYSTEM MESSAG /"PASSWORD" PASWRD GETIN JMS I FIPASC /CONVERT PASSWORD TO SIXBIT 0011 /GOOES AT WORD 11, 12 OF MFD MESSAG /"LIBRARY" LIBARY MESSAG /"PASSWORD" PASWRD GETIN JMS I FIPASC /CONVERT PASSWORD TO SIXBIT 0041 /AND PUT IT AT WORDS 41,42 OF MFD MESSAG /"OPERATOR" OPRAT MESSAG /"PASSWORD" PASWRD GETIN JMS I FIPASC /CONVERT PASSWORD TO SIXBIT 0061 /AND PUT IT AT WORDS 61,62 OF MFD TAD MFD1 /INITIALIZE POINTER DCA AXS1 FIPR2, TAD I AXS1 /GET ADDRESS OF DATA TO BE STORED IN MFD SNA /ARE WE THROUGH? JMP FIPR3 /YES DCA FIPR4 /SAVE IT TAD I AXS1 /GET DATA TO STORE DATFLD DCA I FIPR4 /STORE IT IN THE MFD CHDF JMP FIPR2 /GO FOR MORE FIPR3, TAD SWBASE TAD JBMXP /"JOBMAX" CLL RTL STL RAL /MAKE IT FIELD 1 DCA .+3 DISC DMAW /WRITE OUT THE MFD .-. DISCHK /INITIALIZE STORAGE ALLOCATION TABLE "SAT" /THE SAT TABLE RESIDES IN FIP AT 7777 AND EXTENDS /DOWN THROUGH 7777-(SATSIZ-1). EACH BIT POSITION REPRESENTS 1 SEGMENT /OF FILE STORAGE. /SEGMENT 0 IS BIT 0 OF 7252, /SEGMENT 1 IS BIT 1 OF 7252, ETC. 7252=7777-(SATSIZ+2). /LOCATION SATCNT=7777-(SATSIZ-1)+1 CONTAINS THE COUNT OF AVAILABLE /SEGMENTS. A SEGMENT IS AVAILABLE IF ITS SAT BIT HAS THE /VALUE 0. JMS I FIPRFD /FIP TO FIELD 1 TAD CJTABL ZERO1 /CLEAR ALL FIP TABLES AND RETRIEVAL INFORMATION TAD SWDEXP TAD CJOBMX TAD DSKSZP /"DSKSIZ" CLL RTL RTL TAD C7777 /CAN'T USE LAST SEGMENT ON DF32 DCA STORE0 /NUMBER OF DISK SEGMENTS CLA CMA DATFLD DCA I SATBOT /"-255" CLL STA RTL /SUBTRACT THREE SEGMENTS (FOR 1,2,3 UFD'S) TAD STORE0 /SET SATCNT TO # DISC SEGMENTS-2 DCA I SATCNT /"-254" TAD K7000 /MARK SEGMENTS 1,2,3 FOR MFD, UFD USAGE DCA I SATTBL TAD STORE0 /MORE THAN 4000 SEGMENTS. SMA JMP .+6 /NO OK TAD CM4004 /SUBTRACT 4004 DCA STORE0 TAD C0253 /253 WORDS=4004 SEGS DCA COUNT TAD STORE0 TAD C7764 /-14 ISZ COUNT /COUNT # ZERO WORDS IN SAT SMA JMP .-3 DCA STORE0 STA TAD COUNT TAD SATTBL DCA COUNT STL RAL ISZ STORE0 JMP .-2 DCA I COUNT /MARK END OF FILE STORAGE AS ALLOCATED JMP FIPRF5 FIPRF4, CLA CMA DCA I COUNT FIPRF5, ISZ COUNT JMP FIPRF4 DISC DMAW 0011 /FIP IS TRACK 1, FIELD 1 DISCHK /MAKE SURE THE DISK IS OK JMP I SUPERA SATTBL, -SATSIZ+2 K7000, 7000 COUNT, 0 SWDEXP, -SWDEX JBMXP, JOBMAX C7764, -14 DSKSZP, DSKSIZ STORE0, 0 FIPRFD, FIPRD CJTABL, JTABLE SATBOT, -SATSIZ SATCNT, -SATSIZ+1 C0253, 253 CM4004, -4004 FIPREM, TEXT "_WRITE ZERO SYSTEM DIRECTORY? " *INIP+3000 JMP I .+1 INBOOT /MFD SEGMENT #S TO INBUF FRD0, 0 TAD SWBASE TAD JBMAX CLL RTL STL RAL DCA FRD1 DISC DMAR FRD1, 0 DISCHK /MAKE SURE THE DISK IS OK TAD K0020 DCA AXS1 TAD INBUF DCA AXS2 TAD K7771 DCA Z1 FRD2, DATFLD TAD I AXS1 CHDF DCA I AXS2 ISZ Z1 JMP FRD2 DATFLD TAD I FGRACE /FETCH SIZE OF "GRACE SPACE" CHDF DCA I AXS2 JMP I FRD0 JBMAX, JOBMAX FGRACE, 0014 K0020, 0020 Z1, FIPRD, 0 DISC DMAR 0011 /FIP IS TRACK 1, READ INTO FIELD 1 DISCHK /MAKE SURE THE DISK IS OK JMP I FIPRD Z0, JMS I STFLDB /SET DATA FIELD TYPED DCA Z1 DCA I Z1 /ZERO OUT A FIELD ISZ Z1 JMP .-2 JMP I SUPERA STFLDB, STFLD /TABLE USED TO CONSTRUCT VIRGIN MFD /INCLUDES ENTRIES FOR ACCOUNTS 1, 2, 3 /EACH PAIR OF NUMBERS INCLUDES FIRST THE MFD ADDRESS, THEN ITS CONTENTS MFDT, 3;10 /DUMMY POINTER 10;1 /ACCOUNT NUMBER 1 13;40 /NEXT ACCOUNT STARTS AT 40; LINK TO IT 14;12 /DEFAULT "GRACE SPACE" OF 10 SEGMENTS PAST QUOTA 17;20 /SEGMENT LIST IS AT 20 21;1 /MFD STARTS WITH SEGMENT 1 ONLY 30 /AN EXTRA BLOCK IS USED HERE. THE REASON IS SO THAT THE 7777 /LAST ACCOUNT IN A SEGMENT WON'T HAVE ITS RETRIEVAL /BLOCK IN THE NEXT SEGMENT. 40;2 /ACCOUNT 2 43;60 /LINK TO NEXT ACCOUNT AT 60 44;7777 /NO LIMIT ON DISK SEGMENTS 47;50 /SEGMENT LIST IS AT 50 51;2 /ACCOUNT 2 UFD STARTS WITH ONLY SEGMENT 2 60;3 /ACCOUNT 3 64;7777 /NO LIMIT ON DISK SEGMENTS 67;70 /SEGMENT LIST IS AT 70 71;3 /ACC. 3 UFD OWNS SEGMENT 3 ONLY, INITIALLY 0 /TABLE TERMINATOR CRTABL, RTABLE-1 /MFD SEGMENT #S CUTABL, UTABLE SATCON, SATSIZ+1 CJOBTB, JTABLE-1 /START OF AREA TO CLEAR IN FIP PERSET, 0 JMS FRD0 /MFD SEGMENT #S TO INBUF JMS FIPRD /FIP TO FIELD 1 TAD CJOBTB /CLEAR FIP TABLES DCA AXS1 DATFLD DCA I AXS1 TAD AXS1 /HAVE WE REACHED BOTTOM OF SAT? TAD SATCON SZA CLA JMP .-4 /NO TAD CRTABL /MOVE MFD SEGMENT #S TO RTABLE DCA AXS1 TAD INBUF DCA AXS2 TAD K7771 DCA Z1 PERSE3, CHDF TAD I AXS2 DATFLD DCA I AXS1 ISZ Z1 JMP PERSE3 CLL CLA CML RAL DCA I CUTABL /UTABLE=1 CMA ISZ CUTABL DCA I CUTABL /UTABLE+1=-1 ISZ CUTABL CHDF TAD I AXS2 DATFLD CIA DCA I CUTABL /UTABLE+2=-"GRACE SPACE" CHDF DISC DMAW 0011 /WRITE FIP FROM FIELD 1, TO TRACK 1 DISCHK /MAKE SURE THE DISK IS OK JMP I PERSET K7771, 7771 /THERE'S ALWAYS SOMEONE WHO WILL TRY TO LOAD INIT INTO THE SAME FIELD AS /THE BINARY LOADER. GIVE HIM/HER A MESSAGE IF HE DOES!! *4200 CLA RIF TAD C6201 DCA INIF MESSAG OOPS HLT JMP .-4 OOPS, TEXT "_PLEASE DON'T TRY TO LOAD INIT WITH THE BINARY LOADER " *.-1 TEXT "LOCATED IN FIELD 2!" *7632 JMP I SUPERA /THIS INSTRUCTION SHOULD INTERCEPT ANY BINARY /LOADER IN PROGRESS IN THIS FIELD. /INIT SUPERVISOR /OVERLAYS XDDT PERMANENT SYMBOL TABLE *4200 SUPER, CLA /SET DATA FIELD RIF TAD C6201 DCA INIF CHDF DTRA AND C0200 DTXA /STOP ANY DECTAPE WHICH MAY BE MOVING AFTER AN ERROR TAD OUT1 DCA OUTA /RESTORE TTY OUTPUT IFZERO CPU-2 <6030> /DO HIM/HER A FAVOR IF IT'S AN 8/E IFNZRO CPU-2 <6032> /NOT QUITE AS HELPFUL, BUT NECESSARY MESSAG LDXRS /LOAD, DUMP, START AND OTHER THINGS IN THE LIST OF COMMANDS?? GETIN /WAIT FOR REPLY TAD SUPTBA /ADDRESS OF TABLE OF LETTERS DCA AXS1 /SAVE IT AUTO-INDEX SUPER2, TAD I AXS1 /GET A LETTER FROM TABLE SNA /END OF TABLE? JMP SUPHUH /YES - LET HIM/HER TRY AGAIN TAD I INBUF /ADD ON FIRST CHARACTER TYPED SNA CLA /THIS ONE? JMP SUPER3 /YES - DISPATCH ISZ AXS1 /NO - PASS UP DISPATCH ADDRESS JMP SUPER2 /NEXT SUPER3, TAD I AXS1 /GET DISPATCH ADDRESS DCA CHDFA JMP I CHDFA /AND DISPATCH SUPHUH, CLA MESSAG HUH JMP SUPER SUPTBA, SUPTBL-1 OUT1, OUT STFLD, 0 CHDF TAD I STFAD /WHAT WAS THE SECOND CHARACTER TYPED? TAD STFM8 CLL TAD C0010 SNL JMP SUPHUH CLL RTL RAL TAD C6201 DCA .+1 .-. JMP I STFLD STFAD, INBUFA+1 STFM8, -"8 /REFRESHER CONTROL LOGSMA, LOGMES REFFLD, CORFLD REFDDT, XDDFLG NOCSQ, ISZ CONDBA REFCSQ, CORJMS IFZERO DC08A < REFREQ, FREQ CYC50, FRETEL CYC60, IFNZRO CPU-2 <-6> IFZERO CPU-2 <-14> > REFCO0, JMS I LOGSMA /CHECK FOR NEW SI LOGIN MESSAGE DISC /READ INIT INTO FIELD 1 DMAR 21 DISCHK /IS IT OK? YESNO /LAOD XDDT? DDTMES STA DATFLD DCA I REFDDT /INITIALIZE XDDT LOAD FLAG REFCO1, CHDF MESSAG /# USER FIELDS - CORMES GETIN OCTIN DATFLD DCA I REFFLD /INITIALIZE NUMBER OF USER FIELDS TAD I REFFLD CLL IAC TAD C7770 SZL CLA /IS HIS/HER ANSWER REASONABLE? JMP REFCO1 /NO CHDF YESNO CSQ /DOES HE WANT ^S FEATURE? TAD NOCSQ /NO DATFLD DCA I REFCSQ IFZERO DC08A < IFNZRO CPU-4 < CHDF YESNO FREQUE /60 HERTZ? JMS I CYC50 TAD CYC60 DATFLD DCA I REFREQ > > CHDF DISC /WRITE OUT INIT DMAW 21 DISCHK /MAKE SURE IT'S OK YESNO /DO YOU WANT TO REFRESH? FIPREM JMP I SUPERA /NO JMP I .+1 FIPREF /GO REFRESH SUPTBL, -"L SUPLOD /LOAD -"D SUPDMP /DUMP -"I SUPREF /INITIALIZE -"S SUPST /START -"X 7000 /XDDT -"B SBUILD /BUILD -"P DISCLK /PATCH -"T DSKDMP /LOAD OR DUMP; YOU CHOOSE HOW MANY TRACKS -"O PATCH /LOAD AN OVERLAY TAPE -"C LOAD /READ OR WRITE 4K TO "C" OR -"Y Y /READ BINARY TAPE TO A SELECTED FIELD -"Z Z0 /ZERO A SELECTED FIELD -"M MF0 /MATCH A SELECT FIELD WITH FIELD 1 -"W CD0 /DUMP A SELECTED FIELD -"E OSB /EXIT TO SOME OPERATING SYSTEM -"R RFBOOT /BOOT TO OPERATING SYSTEM ON RF08/DF32 -"K KEBOOT /ROOT TO RK8E 0 /TABLE TERMINATOR /FOLLOWING THIS COMMENT, YOU WILL FIND XDDT. ONLY IT MIGHT BE A /LITTLE HARD TO SEE, SINCE IT'S XLISTED. /XLIST *4434 / VRS: Reconstructed from working binary. 1117 / VRS: Need to disassemble this! 2400 0000 6000 1720 2200 0000 7000 7000 6202 0000 7001 1350 7001 1351 3346 7630 5264 1746 3754 4755 1754 4756 5757 4760 1754 3746 5757 1347 4761 3762 5757 0000 7000 6041 5276 6046 7200 5674 1246 7640 5313 7630 5321 4755 4763 5757 1764 7640 7001 3765 7420 5757 1352 5253 1244 3766 1767 0353 7640 5335 1770 3766 1244 3770 1771 3772 6224 1245 3773 1774 7510 5775 5776 0000 0070 0144 5554 5551 4400 7143 6360 7333 5222 4645 5116 5553 5711 6553 5552 5532 5350 5544 5227 5563 5407 5557 5503 5464 PAGE 0000 2342 1762 7650 5234 1347 3352 1357 4271 5216 1346 3343 2341 5600 1346 7640 5763 7040 1764 3352 1764 7041 1765 7112 7041 4271 5763 3345 1345 7000 1344 3344 5600 7040 0344 1345 5237 0000 4200 7300 3766 1341 7650 5266 2766 1344 1257 7600 1344 0360 1343 7430 1361 7410 1344 3767 5645 0000 3351 2352 7146 3353 7146 3354 1350 3355 1752 2352 7041 1755 2355 7640 5316 2353 5316 1752 2271 5671 2354 5302 2351 5273 5671 2770 0000 5771 0000 7430 5773 1774 3764 5772 1356 1340 3775 5772 7640 0000 0000 0000 0000 0000 0000 5773 6561 0000 0000 0000 0000 0000 7750 7772 0177 0200 6564 5635 6400 6552 7352 7143 7141 7343 5222 7465 6401 6665 PAGE 7020 4743 7100 5744 0000 0000 0000 0000 0000 0000 5613 7777 7420 5747 4750 1751 3752 2753 5754 0000 3755 1756 3757 1756 7041 1760 7112 7041 3761 4762 5240 5623 1755 7006 7700 1335 1336 4763 1341 4764 1755 0342 4765 5623 3755 1766 3757 1766 7041 1756 7112 7041 3761 4762 5270 5767 1755 4765 5767 1770 1340 7650 5771 1772 4316 3745 6224 7041 1745 7650 5311 1337 5313 7040 1773 3774 3775 5776 0000 3334 4750 1751 7104 7104 7104 7161 1334 7430 5747 7041 1334 5716 0000 7774 4440 7577 0007 0240 0777 7105 7010 6367 6317 5635 4645 7143 6553 4446 5605 6773 6402 6775 6552 6776 6600 7220 4474 7333 6401 6736 7537 5723 5400 6400 5722 5721 5222 PAGE 6002 7600 6046 4754 1755 7650 5220 3756 3757 3760 3755 4227 5217 1351 3750 4754 1337 3761 4754 5762 1226 5221 5301 0000 1763 3350 1764 7500 4765 7700 2227 5627 4766 1767 4770 1771 3350 1772 7510 5773 4765 1750 5254 1351 4754 3350 1350 0353 3227 1350 7004 7430 7500 5270 7010 5774 7004 7006 7700 5300 1771 0201 1227 3227 7420 5315 1772 4765 1227 0311 1311 7650 2627 7770 1627 3227 4754 1350 0337 1352 3775 7130 1350 0337 7640 5776 1771 3341 1772 4765 1341 7001 3627 4754 2227 7000 5777 0000 4227 5346 1750 3351 4754 5741 0000 0000 0763 0177 6324 5407 5551 5552 5554 4475 5600 5560 5557 6317 4645 7143 5672 5562 5561 5635 7324 5544 4523 7323 0000 2355 5250 5253 6324 5702 6317 0000 3351 7204 3352 6214 3353 1360 3362 1357 3361 3355 7001 3354 2356 5603 6201 1773 3342 1774 3343 1372 3344 1364 3207 1365 3774 7201 2330 5250 2344 5250 7200 6046 6041 5242 3354 1342 3773 1343 3774 4604 1361 7112 7010 5605 4606 1365 3760 1200 3330 1330 4606 1207 3766 1367 3770 1330 1314 7500 5270 7201 1226 1361 3342 1361 4606 7130 3361 2362 7770 1354 7650 1371 3330 1355 7640 0000 1347 3343 1352 7110 0000 1351 0000 5336 2362 7000 3351 1353 4606 1351 0000 0000 0000 5762 2362 0000 5762 0000 0000 0000 0000 0000 0000 4000 0000 4000 0000 0000 5201 5006 0006 5407 0007 6042 0000 0000 0001 PAGE 7240 3734 3735 4736 3737 1326 4224 1325 3740 7240 1327 3741 1327 4224 3742 1330 3743 3744 3745 5746 0000 3271 1331 3242 3671 2271 2242 5230 5624 7200 1332 4747 4750 5205 0000 1322 7160 1321 7420 5235 3270 1321 5642 4751 1752 3271 4242 3242 1753 4754 1271 3642 2242 2270 5262 5755 0000 0000 0000 7450 7001 7041 3756 6041 5277 5672 4757 1760 4761 1333 4762 4311 5763 0000 1764 4757 1765 4766 1765 3752 5711 0000 4177 1752 5767 7000 4741 6561 7771 7774 0277 5140 6553 4446 6311 7144 4635 7540 4745 7537 7536 4746 6030 4474 6360 4645 7143 6367 6317 5222 5556 6135 5562 6672 7235 5212 5552 5551 7333 7450 0000 0000 0000 0000 0116 0400 PAGE 2401 0400 0000 1000 1123 3200 0000 2000 0403 0100 0000 3000 1215 2300 0000 4000 1215 2000 0000 5000 0000 7200 1360 4764 1765 4766 6031 5232 4767 4770 6036 7450 5230 0357 3224 1224 7450 0000 1354 7450 5304 1356 7450 5306 1353 7450 5772 1350 7500 5310 7200 1224 1345 3343 1743 3344 1344 7650 5225 1343 1346 7500 5326 7200 1224 4764 4773 5744 4773 5774 4773 5775 1352 7500 5317 7200 1347 3344 5300 1355 7510 5262 1351 7450 5776 5225 1352 7700 5300 1224 1363 4777 5302 0000 1361 4764 1362 4764 5735 0000 0000 6177 1600 7400 7735 7741 7746 7757 7766 7773 7775 0177 0207 0260 0273 3600 4474 6367 6317 6324 5341 5007 5224 6300 7065 7062 5635 7235 6453 0000 5004 7200 4734 0000 0000 6543 4451 7740 4727 4450 0077 6454 7346 6452 0000 4735 7347 4452 4447 0000 0000 0000 0000 5653 0000 0000 0000 0000 6530 7457 5240 6337 5073 7006 7003 7005 7306 5000 7446 7433 7456 6445 7455 7400 7012 7401 7401 7401 7401 7401 7401 7401 7401 7400 7400 7014 5014 7120 7002 7121 5640 4503 0000 7340 1771 7200 5700 0212 0215 0240 0340 0000 1306 4772 1305 4772 5711 0000 1365 3322 6201 5717 0000 3366 6224 4317 1366 5724 7010 7013 7011 6547 7004 7030 1367 3773 4774 1775 3776 5777 0000 0214 7450 5746 1211 7500 1370 1310 4772 5746 0000 7200 1307 4772 5760 6201 0000 0000 7700 4742 4474 5557 4645 7143 5560 5222 0000 0000 0000 0000 1360 7041 1200 7500 5603 3357 1200 3354 1354 1366 3355 1754 3755 2354 2357 5214 5603 0000 1360 1366 3356 1361 3756 2356 1362 3756 2356 1363 3756 2356 1353 3756 5625 1767 3353 2770 4256 5771 7001 7001 4256 5772 0000 3365 1770 7640 1364 7650 5773 1365 1310 3270 0000 3360 4203 4225 7040 1365 7450 5305 7710 5310 1202 1366 3202 1201 1366 3201 1200 1366 3200 6224 7041 1774 7640 5656 1775 7160 1200 7420 7200 1775 3775 5656 6031 5330 6034 7650 5332 6032 6031 5336 6032 1346 3776 7040 1200 5777 7000 7260 5751 7066 4444 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 7774 7142 4446 5640 5222 5635 6367 5722 4475 4457 0000 7240 1375 3375 3374 3670 1376 7700 5242 1375 1337 3375 1775 7141 1373 7620 5232 1374 7141 1775 7620 5232 1775 3374 1375 3377 2376 5211 1374 7450 5600 7041 1373 7640 5600 7146 1377 4671 2200 5600 3373 1745 3375 1745 7041 1746 7112 7041 3376 4200 5264 5672 1374 7640 5274 5303 7352 7220 0000 5250 7346 1377 4671 1341 4747 1374 7041 1373 4750 5672 0343 7006 7006 7006 1344 4671 1751 7006 7006 7630 1340 4752 4753 4754 5331 3373 1342 4752 1373 4272 2670 5757 0000 5755 5734 0004 0052 0253 3240 7000 5774 6400 6401 4474 7333 7143 7235 6360 7243 5054 5023 0000 7200 1751 3373 7132 1373 7200 1751 7420 5306 4756 5757 PAGE 5601 5200 1345 1346 1347 1350 1352 5755 1345 1346 1347 1350 1352 3337 1254 3257 1756 7420 5226 7200 4757 1760 7100 7640 7120 1343 7430 4761 7000 3341 1344 7640 5247 1341 3342 1337 3340 1340 3337 1762 4763 1741 4764 3343 4765 1343 4737 4765 2344 5766 7020 4305 5767 7221 3765 1254 3257 4305 1765 1342 3342 4770 1342 4752 1340 4771 1342 3341 5245 0000 1344 7670 5705 4757 1762 4763 1343 3741 4764 5705 1354 1227 3772 7420 5773 4757 1343 0774 7041 3344 1351 3257 4775 3341 5776 0000 6757 0000 0000 0000 0000 0076 0256 0023 0042 5777 6672 7333 0010 7507 7352 4645 4741 7243 6367 6317 6324 6360 5605 5222 6311 6346 7526 5635 6553 5642 7516 4723 7630 5631 1632 7012 7010 5633 0000 3353 1753 7012 7012 7012 4634 1753 4634 5606 0000 4206 2353 1353 4206 2353 1353 4206 5620 4470 5553 4457 6346 0000 3220 3352 1354 4206 5635 0000 7301 1361 0726 7440 7320 1726 0361 7430 5257 2243 5643 3353 1727 0363 1353 5643 0000 1353 7006 7004 3353 1353 0360 2206 7440 5277 5664 1362 4730 1206 7650 5733 4264 5277 7420 5731 4732 1726 3764 1765 3766 1765 3632 3767 7130 3770 4771 1356 3772 5773 7143 7141 4474 5635 4645 0000 7104 3353 3352 1357 3206 4264 5341 2774 5775 5776 7001 1355 3777 5776 0000 0000 7220 4752 5763 7774 0007 0177 0260 7600 5227 6367 5561 5555 5350 5672 5544 4523 5670 7516 5222 7077 2745 2337 5204 5746 7130 1336 3336 1747 0343 7430 5217 7106 7006 7006 2340 1740 3740 1747 0342 3335 1750 7104 7104 7104 1335 3750 5253 1337 1342 7640 5241 1751 5250 1344 3752 2745 4753 5251 3745 1754 3750 7040 3337 2755 5756 1332 1333 1334 3337 7430 4753 1337 5757 4753 1760 7161 1761 7200 1745 7670 5746 1760 1341 3340 1341 3762 2340 3740 2762 5302 5763 3340 7430 4764 4762 1765 4740 5766 1767 3335 1770 4771 1735 4772 0773 1774 7402 5775 1767 5776 0041 1537 5241 0000 0000 0000 0000 7774 0007 0077 0400 6564 5635 6024 4745 7142 4746 4600 6561 4742 6030 5610 4752 6401 6360 5222 4645 7143 5640 7141 6367 6317 6324 6553 7144 4723 7074 /XLIST / VRS: End of XDDT reconstruction *5400 70 /PATCH FIELD SELECT FOR XDDT *6400 4434 4434 4434 *4724 6031 /PATCH TO FIX XDDT BUGS ON 8E *4726 5376 *4776 6032 5772 *5004 /^C CODE TSF JMP .-1 /WAIT FOR FLAG FROM ^C XOP, SKP /NOP IF XDDT IS EXEC DDT CIF CDF 0 JMP I .+1 4200 *5523 1222 *5547 7000 *5572 7760 /GIVE THE TTY FLAG MORE TIME *6045 5225 /DON'T GO TO BINARY LOADER /BINARY LOADER SUBROUTINE /CALLING SEQUENCE: CDF TO FIELD TO LOAD TAPE INTO / JMS BINTAP / JMP ? /RETURN WITH FIELD SETTING IN AC6-8 / /JMP BINT3 WHEN DESIRED ACTION HAS BEEN TAKEN / ? /RETURN WITH CHECKSUM IN THE AC *7600 BINTAP, 0 KCC /BRING UP FLAG ON LS READER, AC=0 RFC /BRING UP FLAG ON HS READER TAD M200 DCA TEMP /INITIALIZE DELAY TIME BLORI, BINF, KSF /LS READER FLAG YET? JMP .+3 /NO TAD BLORI /YES --- JMP .+4 RSF /HS READER FLAG YET? JMP BINIL /NO TAD BHIRI /YES DCA BINRD+1 /SAVE HI/LO SWITCH JMS BFR /READ TAPE-LEADER? JMP .+2 /YES - GO FIND END OF LEADER JMP .-2 /NO - FIND LEADER BEFORE ANYTHING JMS BFR /READ TAPE - LEADER? JMP .-1 /YES - KEEP LOOKING DCA ORIGIN /INITIALIZE ORIGIN FOR SAVE TAPES GO, DCA BINCHK /CLEAR OUT OR UPDATE CHECKSUM BINT2, TAD FRAME /WHAT WAS IT? TAD C7500 SMA JMP BINFLD /MUST HAVE BEEN A FIELD SETTING TAD MASK /NOW GET THE FRAME BACK DCA WORD1 JMS BINRD /GET NEXT FRAME DCA WORD2 JMS BFR /NOW LOOK AHEAD FOR LEADER/TRAILER JMP BINC /TRAILER! GO DO CHECKSUM JMS ASSEMB /ASSEMBLE WORD SZL /ORIGIN? JMP BINORG /ORIGIN DCA I ORIGIN /STORE AWAY DATA ISZ ORIGIN /PREPARE FOR NEXT M200, CLA 400 BINT4, TAD WORD1 /NOW UPDATE THE CHECKSUM TAD WORD2 TAD BINCHK /ADD IN OLD CHECKSUM JMP GO /AND GO SAVE IT AND CONTINUE BINC, JMS ASSEMB /ASSEMBLE THE CHECKSUM CIA TAD BINCHK /COMPUTE FINAL CHECKSUM BINC2, ISZ BINTAP /SKIP ON RETURN SNA /CHECKSUM OK? JMP I BINTAP /YES DCA BINCHK /SAVE IT MESSAG /TELL HIM/HER ABOUT BAD CHECKSUM TAPERR TAD BINCHK /GET CHECKSUM JMP I BINTAP /AND RETURN; CHECKSUM IN AC BINFLD, AND K0070 /GET FIELD BITS JMP I BINTAP /AND GO PROCESS THEM SWITCH, ASSEMB, 0 TAD WORD1 CLL RTL RTL RTL TAD WORD2 JMP I ASSEMB BINIL, JMS DELAY JMP BINF /HERE IS THE REAL BINARY LOADER! JMS BINTAP /GO AND BINARY LOAD JMP .+3 /FOUND A FIELD SETTING M376, HLT /FINISHED - CHECKSUM IN AC BEGIN, JMP .-3 /CONTINUE - HE WANTS ANOTHER TAPE READ TAD K6201 /MAKE A CDF DCA .+1 /SAVE IT TEMP, .-. JMP BINT3 /AND CONTINUE /MORE BINARY LOAD JUNK /BFR - READ TAPE, IGNORING FRAMES BRACKETED BY RUBOUTS /SKIP ON RETURN IF LEADER NOT FOUND BFR, 0 DCA SWITCH /SET THE SWITCH (OR RESET IT) TAD M200 DCA TEMP JMS BINRD /GET A CHARACTER TAD M376 /TEST FOR 377; RUBOUT SPA SNA CLA JMP .+4 /NOT RUBOUT ISZ SWITCH /YES; COMPLEMENT SWITCH CMA JMP BFR+1 TAD SWITCH SZA CLA /IS THE SWITCH SET? JMP BFR+2 /YES; IGNORE THE DATA TAD FRAME /WHAT WAS THE CHARACTER AGAIN? AND MASK TAD M200 SZA CLA /WAS IT LEADER? ISZ BFR /NO, SKIP ON RETURN JMP I BFR /AND RETURN BINT3, JMS BFR /GET NEXT FRAME JMP BINC /HUH? LEADER/TRAILER FOLLOWING FIELD SETTING OR ORIGIN!! JMP BINT2 /AND PROCESS IT BINRD, 0 HLT /KSF OR ELSE JMP HIR JMP BINDL KRB DCA FRAME TAD FRAME JMP I BINRD BHIR, RSF JMP BINDL RRB RFC JMP .-6 *7750 /WC & CA; INIT WILL READ INTO FIELD 0 OK .+1;. BINDL, JMS DELAY JMP BINRD+1 WORD1, .-. /DECTAPE WC & CA WORD2, .-. /MORE BINARY LOAD JUNK BINORG, DCA ORIGIN /SAVE ORIGIN JMP BINT4 DELAY, 0 ISZ FRAME JMP I DELAY ISZ TEMP JMP I DELAY STA /TIME OUT - GIVE HIM/HER ERROR MESSAGE JMP BINC2 BHIRI, JMP BHIR BINCHK, 0 /CHECKSUM ACCUMULATION ORIGIN, 0 /CURRNET ADDRESS FRAME, 0 C7500, 7500 MASK, 0300 K0070, 0070 K6201, 6201 *7777 JMP BEGIN /BINARY LOADER?!! $ $ $ $ $!!!!!!!!!!