File PS8.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/ PS/8 MONITOR SYSTEM FOR 8K PDP-8, 8/I, 8/L, 8/E    PS8.002
/OCTOBER 31, 1970		R. LARY/E. FRIEDMAN

/COPYRIGHT 1970,  DIGITAL EQUIPMENT CORP., MAYNARD MASS.

/THIS VERSION OF PS/8 IS USR-COMPATIBLE WITH THE PRELIMINARY SYSTEM
/RELEASED IN JUNE, 1970
/HOWEVER, CHANGES AND ADDITIONS HAVE BEEN MADE
/TO THE KEYBOARD MONITOR, INITIAL BOOTSTRAP, DIRECTORY STRUCTURE
/AND ABSOLUTE LOADER.

/	SYMBOLIC REFERENCES TO VARIOUS OVERLAYS:

	MEOVLY=26		/DIRECTORY OVERFLOW OVERLAY FOR "ENTER"
	MCDREC=51		/COMMAND DECODER
	MSOVLY=54		/"SAVE W. ARGS" OVERLAY
	MSOVL2=55		/SECOND PART OF SAVE W. ARGS
	MERRTN=56		/MONITOR ERROR ROUTINE
	MRUNRC=57		/"CHAIN" OVERLAY
	ODTREC=60		/SYSTEM ODT
	MFREE=70		/BEGINNING OF FILE STORAGE

/KEYBOARD MONITOR FOR PS/8 SYSTEM - UNCOMMENTED AT PRESENT FIELD 0 MTHREE=CLA CLL CMA RTL *200 GETNAM, JMP I PRNAME DCA NM1 DCA NM2 DCA NM3 DCA NM4 TAD [NM1 DCA PN CLA CMA DCA PRDSW GTNMX, DCA NMCT TAD I LXR TAD [-240 SNA JMP .-3 TAD [240 SKP GTNMLP, TAD I LXR DCA TMP TAD TMP TAD [-256 SNA JMP PERIOD TAD [-2 CLL TAD [-12 SNL CLA JMP NINSRT TAD [-301 TAD TMP CLL CML TAD [-32 SNL CLA JMP EONAME NINSRT, TAD NMCT TAD [-6 SMA CLA JMP GTNMLP TAD NMCT CLL RAR TAD PN DCA TEMP1 TAD TMP AND [77 SZL JMP .+4 RTL RTL RTL TAD I TEMP1 DCA I TEMP1 ISZ NMCT JMP GTNMLP PERIOD, ISZ PRDSW JMP EONAME ISZ PN TAD [4 JMP GTNMX EONAME, TAD NMCT SZA CLA ISZ GETNAM JMP I GETNAM PRNAME, 4000 TAD NM1 JMS PRWD TAD NM2 JMS PRWD TAD NM3 JMS PRWD TAD NM4 SNA CLA JMP I PRNAME TAD [256 JMS PCHAR TAD NM4 JMS PRWD JMP I PRNAME PRINLP, JMS PRWD ISZ PRMESG SKP PRMESG, 0 CLA TAD I PRMESG SZA JMP PRINLP TSF JMP .-1 JMP I ERRET PRWD, 0 DCA TMP TAD TMP RTR RTR RTR JMS PCHAR TAD TMP JMS PCHAR JMP I PRWD PCHAR, 0 AND [77 SNA JMP I PCHAR TAD [-40 SPA TAD [100 TAD [240 JMS I PCH JMP I PCHAR PRINT, 0 JMP .+3 TSF JMP .-1 TLS CLA TAD [7000 DCA PRINT+1 JMP I PRINT KMER1, JMS PRNAME JMS PRMESG TEXT / NOT AVAILABLE/ TMP, 0
*400 KMNTRY, JMP I .+1 KMINIT PCRLF, JMS I [CRLF KEYMON, JMS I GLINE TAD [BEGLN-1 DCA LXR JMS I GNAME JMP PRINTQ JMS I [SRCH -123; ASSIGN -2301; SAVE -2225; RUN -705; GET -2200; R -2324; START -1704; ODT -0405; DEAS -0401; DATE 0 JMS I [PRNAME PRINTQ, JMS I [PRMESG TEXT /?/ 0 ASSIGN, TAD [12 JMS GDEVNO TAD [UDNAME-1 DCA TM1 JMS I GNAME JMP STONAM TAD NM2 SNA CML TAD NM1 SNL SMA TAD [4000 STONAM, CDF 10 DCA I TM1 CDF 0 JMP KEYMON R, DCA I [GETSW TAD P6203 JMS I [RESET ISZ RUNSW TAD [SHNDLR DCA HANDAD CLA IAC JMP RGETPG GDEVNO, 0 DCA ASNM1-1 JMS I [MINCOR JMS I GNAME JMP I [KMER4 TAD NM1 DCA ASNM1 TAD NM2 DCA ASNM1+1 TAD HNDLAD DCA HANDAD CIF 10 JMS I SYSTEM 1 ASNM1, 0;0 HANDAD, 0 JMP I [KMER1 TAD ASNM1+1 JMP I GDEVNO GET, TAD [SKP RUN, DCA I [GETSW TAD P6203 JMS I [RESET DCA RUNSW CLA IAC JMS GDEVNO RGETPG, JMS RSCOMN JMS I [MINCOR TAD SENTER CIF 10 JMS I SYSTEM 2 PGNAME, NM1 0 /USELESS LENGTH WORD JMP I [KMER2 JMP I .+1 RLOADR RSCOMN, 0 DCA SENTER TAD HANDAD DCA DEVHND JMS I GNAME JMP I [KMER4 TAD NM4 SNA TAD [2326 DCA NM4 JMP I RSCOMN SAVE, TAD [SAVE12 /CHANGE ERROR RETURN ADDRESS AS WE WILL DESTROY CORE DCA ERRET TAD I [JSBITS JMS I [RESET TAD [1200 DCA HNDLAD CLA IAC JMS GDEVNO JMS RSCOMN JMP I .+1 SAVE2 HNDLAD, 7400 /REPLACED WITH 1200 BY "SAVE" DATE, JMS I [SHNDLR 0201 0600 MSOVL2 /DATE PROCESSOR IS IN UPPER HALF-RECORD JMP KMONER JMP I [1000 *573 /LOADS SYSTEM ODT OVER THE MONITOR ODT, JMS I PGTOUT JMS I [SHNDLR 1001 0 ODTREC /LOCATION 600 IN ODT IS A HLT (ERROR RETURN)
*600 START, NOESCP, DCA TEMP1 DCA TEMP2 JMS I [STRTX TAD I [JFIELD DCA I [MSTCDF TAD I [JSBITS AND [1000 SZA CLA JMP I [KMER3 TAD I [JSBITS JMS I [RESET /RESET ONLY IF NO START ADR SPECIFIED TAD I [JSTART STCOMN, DCA I [MSTADR TSF JMP .-1 /WAIT FOR PRINTER TO FINISH JMS I PGTOUT TAD I [JSBITS SPA CLA JMP I [MSTCDF TAD [SHNDLR DCA I [MREAD-1 TAD [1000 DCA I [MREAD+1 DCA I [MREAD+2 TAD [MTEMP+4 DCA I [MREAD+3 TAD FUDJMP DCA I [MSWITC JMP I [MREAD MINCOR, 0 CIF 10 JMS I SYSTEM 10 CDF 10 DCA I [OLDT9 /ZERO OUT "DIRECTORY IN CORE" KEY CDF 0 TAD [200 DCA SYSTEM JMP I MINCOR RLOADR, RUN1, TAD I [PGNAME DCA FILE JMS I DEVHND 0101 7000 FILE, 0 /READ IN THE HEADER BLOCK JMP KMONER /ERROR WHILE READING HEADER BLOCK TAD I [7000 JMS I [CCBTST /TEST VALIDITY OF CCB (PERFUNCTORALLY) TAD I [7001 DCA I [MSTCDF TAD I [7002 DCA I [MSTADR /MOVE THE STARTING ADDRESS INTO UPPER CORE TAD I [7001 DCA I [JFIELD TAD I [7002 DCA I [JSTART TAD I [7003 /SET UP THE JOB INFORMATION AREA JMS I [RESET /AND CLEAR INFORMATION ABOUT "RUN" HANDLER TAD FUDJMP DCA I [MSWITC /SET MSWITC TO INHIBIT LOADING 7400 GETSW, SKP /SKP FOR GET, NOP FOR RUN JMP RUN2 TAD P6203 DCA I [MSTCDF TAD [7600 DCA I [MSTADR /IF A GET, SET STARTING ADDRESS TO RETURN /TO MONITOR RUN2, TAD I [PGNAME+1 CMA TAD FILE DCA R7400 /GET THE RECORD NUMBER OF THE LAST RECORD IN THE FILE TAD I [7000 CLL CMA RAL TAD [7004 DCA TM1 /AND THE ADDRESS OF THE LAST PARAMETER PAIR TAD I TM1 DCA I [MREAD+2 ISZ TM1 TAD DEVHND TAD [200 /LINK IS ZERO AT THIS POINT SNL CLA /IS THIS DEVICE HANDLER IN PAGE 7600? TAD I TM1 /NO - MUST CHECK FOR DESTROYING PG 7400 CLL RAL /(AC=0 IF LOADING FROM SYSTEM HANDLER) TAD I [MREAD+2 TAD [200 SZA CLA /DOES THIS PROGRAM LOAD OVER PG 7400? JMP RUN6 /NO - BREATHE EASY JMS I DEVHND 0101 6600 R7400, 0 /YES - READ THE CONTENTS OF PAGE 7400 JMP I [RERR /INTO PG 6600 AND WRITE THEM ON "SYS" JMS WRCTLB /ALONG WITH THE CORE CONTROL BLOCK ISZ RUNSW /FROM NOW ON WE LOOK LIKE AN "R" COMMAND DCA I [MSWITC /SET SWITCH TO READ PG 7400 FROM "SYS" TAD I TM1 TAD [7700 /BUMP DOWN COUNT OF LAST PARAMETER PAIR SZA /DID WE EXHAUST IT? JMP RUN5 /NO - COOL ISZ I [7000 /WE DID - BUMP NUMBER OF PAIRS DOWN SKP JMP I [MSWITC /ONLY ONE PAIR - GO RESTORE 7400 & START RUN5, DCA I TM1 /RESTORE BUMPED COUNT JMP RUN2 /GO BACK AND DO IT RIGHT(MUST FALL THROUGH) RUN6, TAD I TM1 DCA I [MREAD+1 TAD RUNSW SNA CLA /IS THIS A "RUN" COMMAND? JMS WRCTLB /YES - WRITE OUT THE CORE CONTROL BLOCK TAD FILE JMP I [RUN7 /GO DO THE ACTUAL LOADING WRCTLB, 0 JMS I [SHNDLR 4200 6600 MTEMP+10 /THE CONTROL BLOCK GOES INTO THE UPPER HALF JMP KMONER /OF RECORD "MTEMP+10" JMP I WRCTLB /PAGE 7400 GOES INTO THE LOWER HALF IF NECESSARY DEAS, TAD [UDNAME-1 /ZERO OUT USER DEVICE NAME TABLE DCA X1 TAD [-17 DCA TM1 CDF 10 DCA I X1 ISZ TM1 JMP .-2 CDF 0 JMP I [KEYMON
*1000 RUN7, IAC DCA RUNFIL /STORE STARTING BLOCK NUMBER TAD DEVHND DCA I [MREAD-1 TAD DEVHND DCA RUNHND /STORE DEVICE HANDLER ENTRY IN THIS PAGE TAD I ADR1 DCA I ADR2 ISZ ADR1 /MOVE THE ACTUAL LOADER ISZ ADR2 /INTO PAGE 7200 ISZ ADCNT JMP .-5 JMP I .+1 /AND GO TO IT RUN8&177+7200 ADR1, RUN8 ADR2, RUN8&177+7200 ADCNT, RUN8&177+7600 RUN8, ISZ I R7000 /IS THIS THE LAST PARAMETER PAIR? JMP RUN9 /NO - KEEP LOADING TAD RUNFIL DCA I RMRD3 /MOVE THE RECORD NUMBER INTO THE FINAL READ TSF JMP .-1 /WAIT FOR THE TELETYPE TO DIE DOWN (RF08 IS FAST!) JMP I .+1 MREAD /READ THE LAST SEGMENT AND START UP RUN9, TAD I RUNADR DCA RADR /SET UP THE LOADING ADDRESS OF THE CURRENT SEGMENT ISZ RUNADR TAD I RUNADR DCA RCTL /AND THE READ CONTROL WORD JMS I RUNHND RCTL, 0 RADR, 0 RUNFIL, 0 JMP RERR /INPUT ERROR READING THE PROGRAM TAD RCTL JMS ROTAT /GET THE BLOCK LENGTH OF THIS SEGMENT TAD RUNFIL DCA RUNFIL /UPDATE THE BLOCK NUMBER FROM IT ISZ RUNADR JMP RUN8 /BACK FOR ANOTHER ONE ROTAT, 0 CLL RTR RTR RTR AND (37 IAC CLL RAR JMP I ROTAT RERR, CIF 10 JMS I (7700 7 0 /TOTALLY MEANINGLESS RUNADR, 7004 R7000, 7000 RMRD3, MREAD+3 KMER2, JMS I [PRNAME JMS I [PRMESG TEXT / NOT FOUND/ KMER4, JMS I [PRMESG TEXT /TOO FEW ARGS/ CCBTST, 0 /EXAMINE COUNT WORD OF CCB FOR VALIDITY /ASCII AND BINARY FILES USUALLY FAIL THIS TEST RUNHND=CCBTST /GRUNGE A LOCATION CMA AND [7740 SNA CLA JMP I CCBTST /IT WAS VALID TAD [7605 DCA ERRET /RELOAD MONITOR ON THIS ERROR JMS I [PRMESG /IT WASN'T - TELL THE USER TEXT /BAD CORE IMAGE/ GETOUT, 0 /SUBROUTINE TO KICK MONITOR OUT IF NECESSARY TAD I [JSBITS RAR CLA TAD SYSTEM SZL SPA CLA /IS THE SYSTEM IN CORE AND SHOULD IT BE? JMP I GETOUT CIF 10 /YES AND NO - KICK IT OUT JMS I SYSTEM 11 /BYE BYE TAD [7700 DCA SYSTEM JMP I GETOUT RESET, 0 DCA I [JSBITS /MARK AREAS FOR I/O OPTOMIZATION JMS I [MINCOR CIF 10 JMS I SYSTEM 13 /RESET DEVICE HANDLERS AND OUTPUT FILES CDF 10 TAD [MOFILE-1 DCA X1 TAD [-47 DCA TEMP1 DCA I X1 /ZERO OUT THE COMMAND DECODER AREA ISZ TEMP1 JMP .-2 CDF 0 JMP I RESET KMER3, JMS I [PRMESG TEXT /NO!!/
*1200 /TELETYPE INPUT ROUTINE XGLINE, KEYMON+1 TAD [256 JMS I PCH DCA RBFLAG TAD [BEGLN-1 DCA LXR CHLOOP, KSF JMP CHLOOP TAD [200 KRS DCA NM1 KCC JMS SRCH -225;CTRLU -215;CARRET -377;RUBOUT -375;ALTMOD -376;ALTMOD -233;ALTMOD -212;LFEED -200;CHLOOP -217;CHLOOP /IGNORE ^O -203;CTRLC /MUST BE JUST BEFORE 0 ZROFUJ, 0 JMS PRNT CINSRT, TAD NM1 DCA I LXR TAD LXR TAD [-BEGLN-110 SPA CLA JMP CHLOOP CARRET, JMS CRLF TAD LXR TAD [1-BEGLN SNA CLA JMP XGLINE+1 DCA I LXR DCA I LXR JMP I XGLINE PRNT, 0 ISZ RBFLAG JMP .+3 TAD [334 JMS I PCH DCA RBFLAG TAD NM1 JMS I PCH JMP I PRNT CTRLC, CTRLU, TAD [336 JMS I PCH TAD NM1 TAD [100 CLRLIN, JMS I PCH JMS CRLF ISZ SRCH TAD I SRCH SZA CLA JMP XGLINE+3 JMP XGLINE+1 CRLF, 0 TAD [215 DCA NM1 JMS PRNT TAD [212 JMS I PCH JMP I CRLF ALTMOD, TAD [244 DCA NM1 JMS PRNT JMP CARRET+1 RUBOUT, TAD LXR TAD [1-BEGLN SNA CLA JMP RBSPCL TAD [334 ISZ RBFLAG JMS I PCH CLA CMA DCA RBFLAG TAD LXR DCA TEMP1 TAD I TEMP1 JMS I PCH LBCKUP, CLA CMA TAD LXR JMP CHLOOP-1 RBSPCL, ISZ RBFLAG JMP CLRLIN+1 TAD [334 JMP CLRLIN SRCH, ZROFUJ-1 /PART OF THE "INITIAL ^C" FUDGE TAD I SRCH ISZ SRCH SNA JMP I SRCH TAD NM1 SNA CLA JMP SFND ISZ SRCH JMP SRCH+1 SFND, TAD I SRCH DCA TEMP1 JMP I TEMP1 LFEED, JMS CRLF DCA I LXR TAD [BEGLN-1 DCA XR TAD I XR SNA JMP LBCKUP JMS I PCH JMP .-4
*1400 SAVE2A, JMS I [SHNDLR 0201 400 MTEMP+10 JMP KMONER SAVE3, TAD [603 DCA XR TAD I [600 DCA TM1 TAD TM1 JMS I [CCBTST /CHECK TM1 FOR => 7740 ISZ XR TAD I XR /GET THE I/O CONTROL WORD OF THIS SEGMENT JMS I PROTAT /EXTRACT THE LENGTH FROM IT TAD CLENGT DCA CLENGT /UPDATE THE LENGTH OF THE FILE ISZ TM1 JMP .-6 /LOOP FOR ALL SEGMENTS OF THE FILE TAD CLENGT /USE THIS LENGTH WHEN ENTERING THE FILE CLL RTL RTL TAD SENTER CIF 10 JMS I SYSTEM 3 /ENTER SFILE, NM1 ELENGT, 0 /KNOWN LENGTH JMP SAVERR TAD SENTER CIF 10 JMS I SYSTEM 4 /CLOSE NM1 /NAME FOR "CLOSE" CLENGT, 1 /CLOSING LENGTH JMP SAVERR TAD [603 DCA XR JMS I PGTOUT /KICK THE I/O MONITOR OUT IF NECESSARY TAD I [JSBITS RAL CMA /IF JOB LOADS INTO LOCS 0-1777, SNL SMA CLA /BUT NOT INTO LOCS 10000-11777, JMS LOADF0 /LOAD 0-1777 INTO 10000-11777 NOW TAD SFILE DCA SWFILE JMS SWRITE /WRITE OUT CONTROL BLOCK SAVE4, TAD I XR DCA SADR CLA CLL CML RAR TAD I XR DCA SCTL SAVE5, TAD SADR RAL SZL SPA CLA /DOES THIS SEGMENT START BELOW 2000? JMP SAVE8 /NO - NOTHING TO WORRY ABOUT TAD SCTL AND [70 SZA CLA /FIELD 0? JMP SAVE8 /NO - SAVE AS IS SAVE6, JMS LOADF0 /LOAD THE FIELD 0 SAVE AREA OVER THE I/O MONITOR SAVE7, CLA CMA TAD SCTL CLL RAL TAD SADR RAL SZL SPA CLA /CHECK WHETHER UPPER LIMIT IS ABOVE 2000 JMP SAVE7A /IT IS - MUST MAKE 2 WRITES TAD SCTL /TOTALLY CONTAINED IN 0-1777 TAD [10 /CHANGE FIELD 0 TO FIELD 1 AND CONTINUE JMP SAVE8A SAVE7A, TAD SCTL /WRITE IN 2 PARTS - DCA TM1 TAD SADR CIA /FIRST PART FROM FIELD 1, EVERYTHING BELOW 2000 TAD [2020 CLL CML RAR DCA SCTL JMS SWRITE CLA CLL CML RTR DCA SADR TAD SCTL /SECOND PART FROM FIELD 0, EVERYTHING ABOVE 2000 AND [3700 CIA TAD TM1 SAVE8A, DCA SCTL SAVE8, JMS SWRITE ISZ I [600 JMP SAVE4 SAVE12, JMS I [SHNDLR 0610 0 MONTOR /FORCE THE I/O MONITOR BACK INTO CORE JMP KMONER /(OY VEH!) CLA CMA CDF 10 DCA I [7700 /TELL THE KEYBOARD MONITOR THAT ITS IN CORE JMP I [7605 /*** DEPENDS ON 7605 BEING A CDF CIF 10 *** LOADF0, 0 ISZ F0OVLY /HAS THE FIELD 0 OVERLAY BEEN LOADED BEFORE? JMP I LOADF0 /EVIDENTLY JMS I [SHNDLR 1010 F0OVLY, -1 /WILL BE 0 IF WE EXECUTE THIS CODE, OF COURSE MTEMP+4 JMP KMONER JMP I LOADF0 SWRITE, 0 JMS I DEVHND SCTL, 4101 SADR, 600 SWFILE, 0 JMP SAVERR TAD SCTL JMS I PROTAT TAD SWFILE DCA SWFILE /BUMP RECORD NUMBER JMP I SWRITE SAVERR, JMS I [PRMESG TEXT /SAVE ERROR/
*1600 BEGLN, 0 /LINE BUFFER KMINIT, CDF 10 /INITIALIZATION - DESTROYED BY LINE BUFFER ISZ I [7700 /LOC 17700=7777 IF I/O MONITOR IS KNOWN JMP .+3 /TO BE IN CORE, SO SET UP TAD [200 /THE INITIAL POINTER FOR CALLS TO THE MONITOR DCA SYSTEM /ACCORDINGLY CDF 0 TAD PMSWIT /RESTORE THE "MSWITC" AREA IN PAGE 7600 DCA X1 TAD PMSRST /SINCE IT CAN BE DESTROYED BY "SYSTEM ODT" DCA LXR TAD M7 DCA TEMP2 TAD I LXR DCA I X1 ISZ TEMP2 JMP .-3 TAD [200 KRS TAD M203 SNA CLA /IS THERE A ^C IN THE READER BUFFER KSF /WITH THE FLAG ON? JMP I ERRET /NO - PRINT CRLF AND PERIOD KCC /CLEAR KEYBOARD FLAG JMP I .+1 /YES CTRLC /PRINT "^C" M203, -203 M7, -7 PMSWIT, MSWITC PMSRST, . /THIS IS THE TABLE USED TO REFRESH 7765-7773 SHNDLR&177+4200 /JMS SHNDLR 0100 7400 MTEMP+10 HLT CDF CIF 0 TCF *1712 /LOCS 1600-1711 ARE FOR THE LINE BUFFER STRTX, 0 TAD I LXR SNA JMP I STRTX SKP DIGTLP, TAD I LXR TAD (-270 CLL TAD [10 SNL JMP EONUM DCA TMP1 ISZ DIGFLG JMS ROT JMS ROT JMS ROT TAD TEMP2 TAD TMP1 DCA TEMP2 JMP DIGTLP EONUM, CLA TAD TEMP1 AND (7 CLL RTL RAL TAD (6203 DCA I [MSTCDF TAD TEMP2 JMP I .+1 STCOMN ROT, 0 TAD TEMP2 CLL RAL DCA TEMP2 TAD TEMP1 RAL DCA TEMP1 JMP I ROT SAVE2, TAD I LXR SNA CLA JMP I (SAVE2A JMS I [SHNDLR 0201 600 MSOVLY JMP KMONER JMP I .-3
/OVERLAY TO KEYBOARD MONITOR FOR "SAVE" WITH ARGUMENTS *2000 /GOES INTO 600 SAVE1A, TAD (STRTX&177+2200 /"ISZ STRTX" DCA I (EONUM TAD (STRTX&177+5600 /"JMP I STRTX" DCA I (EONUM+1 TAD (1603 DCA X1 DCA TM1 CDF 10 DCA I [OLDT9 S6203, CIF CDF 0 TAD (SROTAT-1200 DCA PROTAT /REPLACE THE POINTER TO "ROTAT" AS WE HAVE DESTROYED THE ORIGINAL TAD (SGETOUT-1200 DCA PGTOUT /LIKEWISE "GETOUT" JMS I [SHNDLR 0210 1400 MTEMP+10 /READ IN CONTROL BLOCK JMP KMONER JMS LXRBAK /RESET LXR TO LOOK AT FIRST CHAR JMS LXRBAK DCA DASHFG SNUMLP, JMS I (SGTNUM-1200 JMP SDLOOK /NO NUMBER - GET DELIMETER TAD I LXR TAD (-"- SNA CLA JMP SVDASH JMS LXRBAK TAD DASHFG SNA CLA /WAS THERE A LOWER LIMIT? JMS DASHSB /NO - SET LOWER LIMIT TO UPPER LIMIT TAD TEMP1 CIA TAD OLD1 SZA CLA /ARE THE FIELDS THE SAME? JMP KMER5 /NO - ERROR TAD TEMP2 AND [7600 TAD [200 DCA TEMP2 TAD TEMP2 CIA CLL TAD OLD2 SZL CLA /IS UPPER LIMIT > LOWER LIMIT? JMP KMER5 /NO - ERROR CDF 10 TAD OLD1 DCA I X1 TAD OLD2 DCA I X1 TAD TEMP2 DCA I X1 /CREATE A TRIPLET(FIELD, LOW LIMIT, HIGH LIMIT) /IN THE TABLE IN FIELD 1 ISZ TM1 /BUMP ENTRY COUNT SDLOOK, CDF 0 TAD I LXR SNA JMP I (SVEND-1200 TAD (-", SNA JMP SNUMLP-1 TAD (",-"; SNA JMP SSTADR TAD (";-"= SNA CLA JMP I (SSBITS-1200 KMER5, JMS I [PRMESG TEXT /ILLEGAL ARG./ LXRBAK, 0 CLA CMA TAD LXR DCA LXR JMP I LXRBAK SVDASH, TAD DASHFG SZA CLA JMP KMER5 ISZ DASHFG JMS DASHSB JMP SNUMLP SSTADR, JMS I (SGTNUM-1200 JMP KMER5 /NULL STARTING ADR - ERROR TAD TEMP1 AND (7 CLL RTL RAL TAD S6203 CDF 10 DCA I (1601 /STORE AWAY STARTING FIELD TAD TEMP2 DCA I (1602 /AND STARTING ADDRESS JMP SDLOOK DASHSB, 0 TAD TEMP1 AND (7 DCA OLD1 TAD TEMP2 AND [7600 DCA OLD2 JMP I DASHSB DASHFG, 0 OLD1, 0 OLD2, 0
*2200 /LOADS INTO 1000 SGTNUM, 0 DCA DIGFLG DCA TEMP1 DCA TEMP2 JMS I [STRTX JMP .+4 TAD (20 SNA CLA JMP .-4 JMS I (LXRBAK-1200 TAD DIGFLG SZA CLA ISZ SGTNUM JMP I SGTNUM SSBITS, JMS SGTNUM JMP I (KMER5-1200 TAD TEMP2 CDF 10 DCA I (1603 JMP I (SDLOOK-1200 SVEND, JMS I [SHNDLR 0101 0600 MSOVL2 /READ IN SECOND PART OF OVERLAY JMP KMONER TAD TM1 SNA JMP I (MOVECB-1600 CIA CDF 10 DCA I (1600 /NOW SORT THE ENTRIES IN THE SEGMENT TABLE ON /DECREASING FIELD AND INCREASING ADDRESS /WITHIN THE FIELD. TAD (1603 DCA P1 CLA IAC TAD I (1600 SNA JMP I (SORTED-1600 /RIDICULOUS TO SORT ONE ITEM DCA TEMP1 OUTRLP, TAD (3 TAD P1 DCA P2 TAD TEMP1 DCA TEMP2 INERLP, TAD P1 DCA LXR TAD P2 DCA X1 TAD I LXR CIA CLL TAD I X1 SNA CLA JMP TIE /FIELDS ARE EQUAL - SORT ON ADDRESS IN FIELD SZL JMP SWITCH /WRONG ORDER - SWITCH 'EM TIENTY, TAD P2 TAD (3 DCA P2 /INDEX TO NEXT ENTRY SWNTRY, ISZ TEMP2 JMP INERLP TAD P1 TAD (3 DCA P1 /ELEMENT IS IN PLACE - GO TO NEXT POSITION ISZ TEMP1 JMP OUTRLP JMP I (SORTED-1600 /SORT COMPLETE - CHECK FOR CONSISTENCY CBMOVE, CDF 10 /FINAL CODE TO MOVE NEW CONTROL BLOCK TAD I LXR /INTO PAGE 600 OF FIELD 0 CDF 0 DCA I X1 ISZ TEMP1 JMP CBMOVE JMP I (SAVE3 /EXIT TO SAVE PROCESSOR SROTAT, 0 /THIS ROTATE REPLACES THE ROTAT ROUTINE RTR /WHICH WE HAVE UNFORTUNATELY READ OVER RTR RTR AND (37 IAC CLL RAR JMP I SROTAT SGETOUT,0 /REPLACES "GETOUT" WHICH WE'VE STORED OVER TAD I [JSBITS RAL /ONLY PERFORMS THOSE FUNCTIONS THAT "SAVE" NEEDS SPA CLA JMP I SGETOUT CIF 10 JMS I SYSTEM 11 JMP I SGETOUT TIE, TAD I LXR CIA CLL TAD I X1 SZL CLA /TEST FOR ADRESSES IN ASCENDING ORDER JMP TIENTY /YES - DONT HAVE TO SWAP SWITCH, JMS SWSUBR JMS SWSUBR JMS SWSUBR CLA CLL CMA RTL TAD P1 DCA P1 /RESET FIRST POINTER JMP SWNTRY /AND DONT BUMP 2D POINTER, AS WE HAVE JUST BUMPED IT SWSUBR, 0 ISZ P1 ISZ P2 TAD I P1 DCA TM1 TAD I P2 DCA I P1 TAD TM1 DCA I P2 JMP I SWSUBR P1, 0 P2, 0
*2400 /LOADS INTO 600 ON TOP OF SAVE1A SORTED, TAD I (1600 IAC SNA /IS THERE ONLY ONE ITEM IN THE LIST? JMP MERGED /YES - DON'T COMPRESS FURTHER DCA TEMP1 TAD (1603 DCA X1 TAD (1606 DCA LXR /NOW CHECK THE SORTED FILE FOR CONSISTENCY /OVERLAPPING SEGMENTS ARE ERRORS, /ABUTTING SEGMENTS ARE TO BE CONDENSED IN /THE INTERESTS OF SPEED MRGLP, TAD I LXR CIA TAD I X1 SZA CLA JMP NOCMPR /DIFFERENT FIELDS - INCOMPARABLE ISZ X1 TAD I LXR CIA CLL TAD I X1 SNA CLA JMP BUTTNG /UPPER LIMIT(2)=LOWER LIMIT(1) - ABUTTING SEGMENTS SNL CLA JMP NXTONE /UPPER LIM(2)<LOWER LIM(1) - NORMAL CASE CDF 0 /UPPER LIM(2) > LOWER LIM(1) - ERROR JMS I [PRMESG TEXT /BAD ARGS/ BUTTNG, CLA CMA TAD X1 DCA X1 TAD I LXR DCA I X1 /SET UPPER LIM(2) = UPPER LIM(1) TAD X1 TAD (-1777 SZA CLA JMP .-5 /AND COMPRESS OUT THE LOWER ENTRY ISZ I (1600 /DECREMENT THE ENTRY COUNT (CAN'T OVERFLOW) JMP SORTED /START OVER FROM BEGINNING NOCMPR, ISZ X1 ISZ X1 ISZ LXR NXTONE, ISZ LXR ISZ TEMP1 JMP MRGLP /NOW ALL THAT REMAINS IS TO TRANSFORM OUR TRIPLETS /INTO THE FORMAT WHICH THE RUN LOADER EXPECTS; I.E. /DEVICE-HANDLER ARGUMENTS MERGED, TAD (1603 DCA LXR TAD (1603 DCA X1 TAD I (1603 AND (1777 TAD (6000 DCA I (1603 /INITIALIZE STATUS BITS TO NO OVERLOADS TAD I (1600 DCA TEMP1 MERGLP, TAD I LXR DCA TEMP2 TAD I LXR AND (7400 DCA TMP1 TAD TMP1 DCA I X1 /STORE ADDRESS TAD TMP1 CIA TAD I LXR /FORM UPPER LIM - LOWER LIM CLL RTR RTR TAD TEMP2 /ADD IN FIELD RAL RTL /ROTATE WHOLE MESS INTO PLACE DCA I X1 TAD TMP1 CLL RAL SZL SPA CLA /IS THE LOWER LIMIT < 2000? JMP NXTSEG /NO TAD TEMP2 RAR SZA CLA /YES- IS THE FIELD 0 OR 1? JMP NXTSEG /NO SNL IAC CMA CML RTR AND I (1603 /AND OUT THE PROPER OVERLOAD BIT DCA I (1603 NXTSEG, ISZ TEMP1 JMP MERGLP MOVECB, TAD (1577 DCA LXR TAD (577 DCA X1 TAD [7600 DCA TEMP1 JMP I (CBMOVE-1200
*2600 /DATE PROCESSOR - LOADS INTO 600 DATEXX, JMS DECIM -15 /GET THE MONTH CLL RTR RTR RAR /PUT IN BITS 0-3 DCA TEMP1 JMS DECIM -40 /GET THE DAY CLL RTL RAL /PUT IN BITS 4-8 TAD TEMP1 DCA TEMP1 /COMBINE WITH MONTH DCA DDELIM /MAKE END-OF-LINE THE DELIMITER JMS DECIM -116 /GET THE YEAR TAD (-106 /SCALE DOWN TO RANGE 1970-1977 SPA JMP BADNUM /DIDN'T MAKE THE RANGE TAD TEMP1 /COMBINE WITH MONTH AND DAY CDF 10 DCA I (MDATE /STORE IN SYSTEM DATE CELL CDF 00 TSF JMP .-1 /WAIT FOR TELETYPE TO DIE DOWN (RF08) JMP I (7605 /RETURN TO MONITOR DECIM, 0 /DECIMAL INPUT FOR DATE DCA TEMP2 DECMLP, TAD I LXR /GET NEXT CHAR DCA TM1 TAD TM1 TAD (-240 SNA CLA JMP DECMLP /IGNORE BLANKS TAD TM1 TAD DDELIM /CHECK FOR SLASH OR EOL SNA CLA JMP DECOVR TAD TM1 TAD (-272 CLL TAD (12 SNL /CHECK IF DIGIT JMP BADNUM /NO - ERROR IN DATE DCA TM1 TAD TEMP2 CLL RTL TAD TEMP2 RAL TAD TM1 DCA TEMP2 JMP DECMLP DECOVR, CLA CLL TAD TEMP2 TAD I DECIM SZL CLA /TEST IF NUMBER IS WITHIN LIMITS JMP BADNUM /IT ISN'T ISZ DECIM TAD TEMP2 JMP I DECIM /RETURN WITH NUMBER IN AC BADNUM, CLA /CRAP IN AC TAD (7605 DCA ERRET JMS I [PRMESG TEXT /BAD DATE/ DDELIM, -257
*3000 /MONITOR ERROR PROCESSOR - LOADS INTO 11400 CLA CMA JMS I (FGET ISZ ZERO JMP .-3 /WAIT FOR TELETYPE PRINTER CLA TAD MERRNO CLL RAL SNA JMP USRERR CLL RAR TAD (60 DCA I (MERTYP-1400 MERCMN, TAD (MERRXR DCA XR TAD I XR SNA JMP MERNUM JMS MERPCH JMP .-4 MERNUM, TAD I (FPUTX RTR RAR AND (7 TAD (60 JMS MERPCH CLA CLL CMA RAL TAD I (MONITO RAL DCA T1 TAD (-4 DCA T2 MEROLP, TAD T1 RTL RAL DCA T1 TAD T1 AND (7 TAD (60 JMS MERPCH ISZ T2 JMP MEROLP TAD MERRNO TAD (3773 SPA CLA CLA CMA DCA I (7700 DCA OLDT9 CLA CLL CML RAR DCA MERRNO CDF 0 TAD I (JSBITS AND (6777 TAD (1000 DCA I (JSBITS /SET THE CURRENT JOB UNSTARTABLE CDF CIF 0 JMP I (7600 USRERR, CLA CLL JMS I (FGET TAD (60 DCA I (UERTYP-1400 TAD (UERRXR-MERRXR JMP MERCMN MERPCH, 0 6046 6041 JMP .-1 CLA JMP I MERPCH ZERO, 0 *3200 /LOADS INTO 1600 MERRXR=.-1401 "M;"O;"N;"I;"T;"O;"R;" ;"E;"R;"R;"O;"R;" MERTYP, 0;" ;"A;"T;" 0 UERRXR=.-1401 "U;"S;"E;"R;" ;"E;"R;"R;"O;"R;" UERTYP, 0;" ;"A;"T;" 0
/EXECUTION TIME LOADER FOR MONITOR "CHAIN" COMMAND *3400 /EXECUTES IN FIELD 0 IN PAGE 7400 MCHNX, DCA MCHREC /STORE STARTING RECORD # CIF 10 JMS I (200 13 /RESET ALL DEVICE ASSIGNMENTS 0 /BUT DON'T CLEAR OUTPUT FILES CIF 10 JMS I (200 11 /KICK MONITOR OUT AND RESTORE CORE IF NECESSARY JMS MCHRD /PARAMETERS PRESET TO READ CONTROL BLOCK INT0 7200 TAD I (7201 DCA I (MSTCDF /TRANSFER INFORMATION FROM CONTROL BLOCK CLA IAC TAD I (7202 DCA I (MSTADR /TO PAGE 7600 TAD I (7203 TAD (1000 DCA I (JSBITS TAD (7204 DCA MCHT1 TAD MCHFJM DCA I (MSWITC TAD (TCF DCA I (MSTCDF+1 MCHN1, ISZ I (7200 JMP MCHN2 TAD I MCHT1 DCA I (MREAD+2 ISZ MCHT1 TAD I MCHT1 DCA I (MREAD+1 TAD MCHREC DCA I (MREAD+3 TAD (SHNDLR DCA I (MREAD-1 JMP I (MREAD MCHN2, TAD I MCHT1 DCA MCHADR /SET UP COMMAND TO READ NEXT SEGMENT ISZ MCHT1 TAD I MCHT1 DCA MCHCTL JMS MCHRD /READ IT ISZ MCHT1 JMP MCHN1 /LOOP ON NUMBER OF SEGMENTS MCHRD, 0 JMS I (SHNDLR MCHCTL, 0101 /1 RECORD INTO FIELD 0 STARTING FORWARDS MCHADR, 7200 MCHREC, 0 HLT /CANT COPE WITH ERRORS ON SYSTEM DEVICE TAD MCHCTL MCHBMP, CLL RTR RTR RTR AND (37 IAC CLL RAR TAD MCHREC DCA MCHREC JMP I MCHRD MCHT1, 0 MCHFJM, MSTCDF&177+5200 /"JMP MSTCDF"
*4000 /SYSTEM GENERATOR - WRITES STUFF OUT USING SHNDLR WRITE=JMS I 0 JMS SYSSWP /SWAP SYSTEM DEVICE HANDLER INTO 7600 WRITE; 4200; 7400; 0; JMP BERR /BOOTSTRAP TAD RBFLAG SZA CLA JMP .+6 WRITE; 4210; 1377; 01; JMP BERR /DIRECTORY WRITE; 5001; 0000; 07; JMP BERR /KEYBOARD MONITOR WRITE; 4610; 0000; MONTOR; JMP BERR /INPUT-OUTPUT MONITOR WRITE; 4111; 3400; MEOVLY; JMP BERR /"ENTER" OVERLAY WRITE; 4701; 2000; MSOVLY; JMP BERR /SAVE OVERLAY, /ERROR ROUTINE AND "CHAIN" TAD RBFLAG SZA CLA JMP .+13 WRITE; 4101; LDRCTL; MFREE; JMP BERR /ABSLDR CONTROL BLOCK WRITE; 5010; 2000;MFREE+1; JMP BERR /ABSLDR JMS I (4200 /OUTPUT THE DEVICE HANDLERS JMP BERR JMS SYSSWP /SWAP BACK PAGE 7600 CLA CMA HLT CLA JMP I .+1 BERR, 7600 JMS SYSSWP HLT JMP .-1 W6600, 6600 W7600, 7600 SYSSWP, 0 TAD W6600 DCA TEMP1 TAD W7600 DCA TEMP2 SWAPLP, TAD I TEMP1 DCA TM1 TAD I TEMP2 DCA I TEMP1 TAD TM1 DCA I TEMP2 ISZ TEMP1 ISZ TEMP2 JMP SWAPLP JMP I SYSSWP /CONTROL BLOCK FOR ABSOLUTE LOADER LDRCTL, 7777 /ONE CONTIGUOUS LOAD 6213 /STARTING ADDRESS IN FIELD 1 2000 /STARTING LOCATION=12000 6003 /DOES NOT LOAD OVER EITHER MONITOR AREA /ALSO DOES NOT USE THESE AREAS AT COMMAND TIME - TRUE /ONLY FOR FIRST CALL TO COMMAND DECODER 2000 /FIRST(AND ONLY) SEGMENT STARTS AT 2000 1010 /IN FIELD 1 AND IS 10 PAGES LONG
*7400 NOPUNCH *7600 ENPUNCH /UPPER PAGE OF FIELD 1 - CHOCK FULL OF GOODIES /LIKE THOUSANDS OF TABLES AND THE MONITOR CALL LOCATION MOFILE, ZBLOCK 17 /OUTPUT FILE TABLE - 7600-7616 (3 ENTRIES MAX) /5 WORDS PER ENTRY - DEVICE # AND FILE NAME MIFILE, ZBLOCK 24 /INPUT FILE TABLE - 7617-7642 (10 ENTRIES MAX) /2 WORDS PER ENTRY - DEVICE # AND RECORD # /LAST WORD IN TABLE CONTAINS TERMINATION INDICATOR /(0 FOR CR, 1 FOR ALTMODE) AND HIGH ORDER /PART OF NUMERICAL ARGUMENT MPARAM, ZBLOCK 4 /PARAMETER TABLE - 7643-7646 /FIRST 3 WORDS - MASK OF SWITCHES(A-Z,0-9). /FOURTH WORD - CONTAINS THE LOW ORDER BITS OF /THE NUMERICAL ARGUMENT /TABLE OF DEVICE HANDLERS PRESENTLY IN CORE DVHNDL, 7607;7607;0;0;0;0;0 0;0;0;0;0;0;0;0 MDATE, 0 /HOLDS THE CURRENT DATE- 4 BIT MONTH, /5 BIT DAY, 3 BIT YEAR FROM 1970 MGET, CIF 0 JMS SHNDLR /INST FIELD IS 0 1000 /READ 4 RECORDS INTO FIELD 0 0 /LOCATIONS 0-1777 7 /KEYBOARD MONITOR FOLLOWS DIRECTORY PJSBTS, JSBITS /SERVES AS A HALT (WATCH IT!) SCDCIF, CDF CIF 0 JMP I .+1 KMNTRY MCALL1, 0 DCA MARG1 /SAVE AC AS IT MAY CONTAIN AN ARGUMENT RDF /GET CALLING FIELD TAD SCDCIF DCA SMCIF CDF 0 TAD I PJSBTS RAR CDF 10 SZL CLA /DOES JOB USE LOCS 10000-11777? JMP MONRD /NO - DONT SAVE THEM CIF 0 JMS SHNDLR 5010 0 MTEMP HLT MONRD, CIF 0 JMS SHNDLR 610 0 MONTOR HLT JMP MSTART /START THE MONITOR UP IN PAGE 0 MRETRN, CIF 0 JMS SHNDLR 1010 /READ 10 RECS INTO FIELD 1 0 MTEMP /TEMP REGION ON SYS HLT /SYS HAS PROBLEMS SMCIF, 0 JMP I MCALL1 MARG1, 0 /TABLE OF USER DEVICE NAMES /ALSO USED BY SYSTEM ODT UDNAME, 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0
DCB, ZBLOCK 17 /DEVICE CONTROL BLOCK - SET IN "CONFIG" /******************************************************** / MAP OF SYSTEM DEVICE AS OF 12/1/69 /******************************************************** / * 256 WORD RECORDS * /******************************************************** / RECORDS CONTENTS / ------- -------- / 0 MONITOR BOOTSTRAP / 1- 6 SYSTEM DIRECTORIES / 7-12 KEYBOARD MONITOR / 13-15 I/O MONITOR(CALLABLE MONITOR) / 16-25 DEVICE HANDLER RECORDS / 26 MONITOR "ENTER" OVERLAY / 27-50 MONITOR SCRATCH AREA FOR SAVING CORE / 51-53 COMMAND DECODER / 54-55 "SAVE WITH ARGUMENTS" AND "DATE" OVERLAYS / 56 MONITOR ERROR ROUTINE / 57 "CHAIN" PROCESSOR / 60-63 SYSTEM ODT / 64-67 RESERVED FOR EXPANSION / 70-END FILE STORAGE
SHNDLR=7607 /ENTRY POINT TO SYSTEMS HANDLER *6600 NOPUNCH *7600 ENPUNCH /SYSTEM HANDLER AND FIELD 0 UPPER PAGE /INCLUDES BOOTSTRAP AND PART OF MONITOR CALL ROUTINE DVHORG=16 /DEVICE HANDLER RECORDS MTEMP=27 MONTOR=13 JMS SHNDLR 5000 /SAVE MONITOR CORE - WRITE 5 RECORDS FROM FIELD 0 0 /(LOCATIONS 0-1777) MTEMP+4 7602 /TROUBLE WITH SYSTEM DEVICE CDF CIF 10 JMP MGET /NOW GO READ IN THE KEYBOARD MONITOR *6744 /INFORMATION ABOUT CURRENT JOB NOPUNCH *7744 ENPUNCH JFIELD, 6203 /A CDF CIF N INSTRUCTION TO START THE JOB JSTART, 7600 /THE STARTING ADDRESS JSBITS, 1000 /VARIOUS STATUS BITS - USED FOR OPTOMIZATION /BIT 4000 - JOB DID NOT LOAD INTO 00000-01777 /BIT 2000 - JOB DID NOT LOAD INTO 10000-11777 /BIT 1000 - JOB IS NOT RESTARTABLE /BIT 2 - JOB DOES NOT USE LOCS 00000-01777 /BIT 1 - JOB DOES NOT USE LOCS 10000-11777 SOFSET, 0 /FOR FUTURE(AND MAYBE PRESENT) USE /DATA BREAK FILLERS FOR SYSTEM BOOTSTRAP 7750 7751 7752 7753 7754 7755 /MONITOR PATCH TO HELP BLEEP LOADER 0 /ADDRESS OF HANDLER FOR DEVICE USED MREAD, JMS I .-1 0 0 0 HLT MSWITC, JMP .+6 /ZEROED IF PG 7400 (HANDLER) MUST BE READ OVER JMS SHNDLR 0100 7400 MTEMP+10 /GET THE PAGE OFF OF THE SYSTEM DEVICE HLT MSTCDF, CDF CIF 0 TCF /EXIT WITH A CLEAR CONSCIENCE(ALSO A CLEAR FLAG) JMP I .+1 MSTADR, 0 SBLOCK, 0
*0 SHNDLR /USED BY SYSGEN (4000) KMONER, CLA TAD [7605 DCA ERRET JMS I [PRMESG TEXT /SYSTEM ERROR/ LXR, 0 X1, 0 *20 RBFLAG, 0 /USED BY SYSGEN - MUST BE AT LOC 20 TEMP1, 0 TEMP2, 0 TM1, 0 TMP1, 0 SYSTEM, 7700 PCH, PRINT GLINE, XGLINE GNAME, GETNAM NM1, 203 NM2, 0 NM3, 0 NM4, 0 DEVHND, 7607 NMCT, 0 PN, 0 PRDSW, 0 RUNSW, 0 DIGFLG, 0 FUDJMP, MSTCDF&177+5200 /"JMP MSTCDF" SENTER, 0 P6203, 6203 PROTAT, ROTAT PGTOUT, GETOUT ERRET, PCRLF /SET TO 7605 BY CERTAIN ROUTINES
FIELD 1 /FIELD 1 /BLEEP MONITOR - MONITOR ROUTINES /THIS MONITOR IS CALLED INTO CORE BY A JMS 7700 IN FIELD 1 /IT REPLACES CORE FROM 200-1777 /AND INTERPRETS THE WORDS AFTER THE JMS AS A MONITOR FUNCTION /MONITOR FUNCTIONS ARE ASSIGN,LOOKUP,ENTER,ETC. MAXCMD=13 *200 MONITO, 0 /MONITOR SUBROUTINE DCA MACARG /STORE AC ARG DCA USERFG /SET FLAG TO INDICATE WE WERE CALLED DIRECTLY RDF /GET CALLING FIELD TAD [CDF CIF 0 DCA FGETX MRENTR, TAD FGETX DCA FPUTX /FOR LOADING AND STORING CALLING SEQUENCE JMS FGET /GET FIRST ARGUMENT[AND SET DATA FIELD 1) ISZ MONITO CLL TAD [-MAXCMD-1 SZL JMP MERROR TAD JMPMAX DCA .+1 HLT /BRANCH TO APPROPRIATE ROUTINE WITH LINK ON MCTABL, MASSIGN MLOOKUP MENTER MCLOSE MCD MCHAIN MERR MESCAP MESCPR MASGN MRSETP, MRESET FPUT, 0 /MUST FOLLOW LAST ADDRESS IN JUMP TABLE FPUTX, 0 DCA I MONITO CDF CIF 10 JMPMAX, JMP I FPUT MEOERR, ISZ MERRNO MIOERR, ISZ MERRNO MERROR, ISZ MERRNO ISZ MERRNO ISZ MERRNO ISZ MERRNO MERR, CLA CIF 0 JMS I [SHNDLR 0210 1400 MERRTN HLT JMP I .-3 MCD, CLA CLL CML RAR JMS CDSWAP /SWAP OUT CORE IF NECESSARY JMS FGET DCA T1 CIF 0 JMS I [SHNDLR 0601 0 MCDREC JMP MIOERR TAD FPUTX CDF CIF 0 JMS I [200 DCA FPUTX TAD FPUTX DCA FGETX JMS CDSWAP /RESTORE THE SWAPPED CORE IF NECESSARY JMP I MRSETP /AFTER CD, RESET DEVICE AREA MCHAIN, JMS FGET DCA T1 /BUFFER THE ARGUMENT CIF 0 JMS I [SHNDLR 0101 7400 MRUNRC JMP MIOERR TAD T1 /LOAD THE BUFFERED ARGUMENT CDF CIF 0 JMP I .-5 MLNOTF, CLA ISZ MONITO MNEXT, TAD USERFG MESCAP, CLL RAR TAD MONITO DCA I [7700 TAD FPUTX DCA I [SMCIF CLA IAC CML CDF 0 AND I [JSBITS CDF 10 RAR SZL SPA CLA /RESTORE CORE IF USERFG=1 AND JSW[11]=0 JMP I [SMCIF JMP I [MRETRN MESCPR, CLL CML JMP MESCAP+1 FGET, 0 TAD MONITO JMS FGETW JMP I FGET FGETW, 0 DCA FPUT FGETX, HLT TAD I FPUT CDF CIF 10 JMP I FGETW CDSWAP, 0 TAD ME1000 /FORM READ OR WRITE OPERATION DCA MCDCTL CDF 0 TAD I [JSBITS CDF 10 RTR SZL CLA /IS IT NECESSARY TO SAVE CORE? JMP I CDSWAP /NO CIF 0 JMS I [SHNDLR MCDCTL, 0 0 MTEMP+4 JMP MIOERR JMP I CDSWAP EOVFLO, CIF 0 JMS I [SHNDLR 0111 ME1000, 1000 /ENTER OVERLAY LOADS OVER ENTER (NATCH) MEOVLY JMP MIOERR JMP I ME1000
*400 /ASSIGN PROCESSOR - TRANSLATE DEVICE NAME INTO DEVICE NUMBER /(IF NECESSARY),GET DEVICE HANDLER INTO CORE(IF NECESSARY) /AND ADJUST TABLES(IF NECESSARY). IS THIS REALLY NECESSARY? MASGN, CLA IAC MASSIGN, DCA ASFLAG TAD MACARG SZA /IS DEVICE NUMERIC OR SYMBOLIC? JMP DFOUND /NUMERIC JMS I [FGET /GET HIGH ORDER 2 CHARS OF NAME ISZ I [MONITO SNA JMP I [MRTRN+1 /FIRST WORD OF NAME MUST BE NON-ZERO DCA NAME JMS I [FGET SNA /IS NAME >2 CHARACTERS LONG? JMP NOHASH /NO - DON'T HASH TAD NAME RAL CLL CML RAR /FORCE SIGN BIT OF HASH NAME ON DCA NAME NOHASH, TAD [UDNAME-1 /SEARCH USER NAME TABLE FIRST DSRCH, DCA XR TAD [-17 DCA T2 DSRCLP, TAD I XR CIA TAD NAME SNA CLA JMP DSFND ISZ T2 JMP DSRCLP TAD XR SMA CLA /WHICH TABLE DID WE JUST SEARCH? JMP I [MRTRN+1 /SYSTEM TABLE - ERROR TAD [SDNAME-1 JMP DSRCH /GO SEARCH SYSTEM TABLE DSFND, TAD T2 TAD [20 JMS I [FPUT /PUT NUMBER INTO CALLING SEQUENCE JMS I [FGET /GET IT BACK IN AC, BUMPING POINTER ISZ I [MONITO DFOUND, JMS I [MCKDEV /DETERMINE ITS VALIDITY (NON-ZERONESS) /AND FORM POINTERS SNA /IS THE DEVICE HANDLER IN CORE? TAD I T2 SNA /DOES A HANDLER EXIST FOR THE DEVICE? JMP I [MLNOTF /NO - SAME AS THE DEVICE NOT EXISTING CMA RAL /GET THE COMPLEMENT OF THE HIGH ORDER BIT INTO THE LINK SNL CLA /TWO PAGE HANDLER?(IF HANDLER IS IN CORE, /THIS TEST IS RANDOM BUT WE DON'T CARE) TAD [100 /YES - FORCE A TWO-PAGE READ TAD [100 DCA DVHCTL TAD T1 DCA T7 /SAVE T1 AS WE WILL DESTROY IT LATER TAD I T1 TAD ASFLAG SZA CLA /DOES HE ACTUALLY WANT US TO LOAD THE SILLY THING? JMP AFINIS /NO - HE MUST HAVE TASTE. JMS I [FGET /FETCH PAGE IN WHICH HANDLER IS TO BE LOADED RAR /GET THE LINK, WHICH HAS BEEN UNTOUCHED SINCE WE /PUT THE "TWO PAGE HANDLER" FLAG INTO IT SNL SMA /IF THIS HANDLER IS TWO-PAGE, IS HE ALLOWING IT TO BE? JMP I [MLNOTF /NO - GIVE AN ERROR RETURN RAL /YES - ROTATE BACK AND [7600 /MAKE IT LEGAL DCA DVHLOC JMS GETREC DCA DVHREC CIF 0 JMS I [SHNDLR DVHCTL, 0 /READ ONE OR TWO PAGES INTO FIELD 0 DVHLOC, 0 DVHREC, 0 JMP I [MIOERR /SYSTEM DEVICE ERROR /NOW GO THROUGH THE TABLE OF AVAILABE HANDLERS TAD [-17 /AND MARK OFF THOSE WHICH ARE NOW IN CORE DCA T4 DVHCLP, TAD T4 JMS I [MCKDEV /LOW ORDER BITS OF T4 GO THROUGH 1-17 CMA TAD DVHLOC CLL CML RAR TAD DVHCTL /IF A HANDLER ENTRY POINT IS WITHIN 200 WORDS OF THE SMA CLA /LOADING ADDRESS (400 FOR A TWO-PAGE HANDLER) DCA I T1 /MARK IT AS WIPED JMS GETREC CIA TAD DVHREC SZA CLA JMP NOTINC TAD I T2 AND [177 TAD DVHLOC DCA I T1 NOTINC, ISZ T4 JMP DVHCLP AFINIS, TAD I T7 JMP I [MRTRN /STORE HANDLER ADDRESS AND EXIT GETREC, 0 TAD I T2 /GET RECORD OF DEVICE HANDLER CLL RTL RTL RTL /EXTRACT THE RECORD NUMBER AND [17 TAD [DVHORG-1 /ADD THE BASE OF DEVICE HANDLER STORAGE
JMP I GETREC MCKDEV, 0 AND [17 SNA JMP I [MERROR /DEVICE 0 IS ILLEGAL DCA NAME TAD NAME TAD [SDVHND-1 /FORM POINTER INTO HANDLER IMAGE TABLE DCA T2 TAD NAME TAD [DVHNDL-1 DCA T1 TAD NAME TAD [DCB-1 DCA T8 /FORM POINTER TO DCB ENTRY FOR DEVICE TAD I T1 JMP I MCKDEV IFNZRO .-564 <REASSEMBLE CONFIG> SDNAME, ZBLOCK 17 /SYSTEM DNAME TABLE - SET UP BY "CONFIG"
IFZERO .+200&1000 <*600> /LOOKUP PROCESSOR - GETS THE STARTING BLOCK OF AN INPUT FILE /ON A SPECIFIED DEVICE.SKIPS IF FILE WAS FOUND OR DEVICE /IS NOT FILE ORIENTED MLOOKUP,CLL /SET RDCAT MODE TO INPUT JMS MRDCAT JMP ERETRN /NON-FILE STRUCTURED DEVICE JMS MDSRCH /SEARCH THE DIRECTORY FOR THE FILE JMP MRTRN+1 /NOT FOUND - TAKE ERROR RETURN LRETRN, TAD T5 CIA TAD I [DORG /CONVERT T5 TO A RECORD NUMBER ERETRN, JMS I [FPUT ISZ I [MONITO TAD T6 CIA /STORE FILE LENGTH AS A NEGATIVE NUMBER MRTRN, JMS I [FPUT /THIS CODE IS JUMPED TO BY SEVERAL ROUTINES ISZ I [MONITO JMP I [MLNOTF MRDCAT, 0 SZA JMP MRDREN /NOT THE FIRST SEGMENT - DON'T SET UP POINTERS DCA T5 /ZERO STARTING BLOCK NUMBER DCA T6 /ZERO FILE LENGTH TAD MACARG /GET DEVICE NUMBER FROM AC JMS I [MCKDEV /CHECK LEGALITY AND FORM POINTERS SNA JMP I [MERROR+1 /DEVICE HANDLER IS NOT IN CORE - ERROR DCA T9 /ADDRESS OF DEVICE HANDLER JMS I [FGET DCA T4 /STORE THE POINTER TO THE FILE NAME IN T4 SNL CML RAR RTR /FORM A MASK OF 2000 OR 1000 DEPENDING ON LINK AND I T8 SZA CLA /TEST FOR READ-ONLY(L=1) OR WRITE-ONLY(L=0) JMP MRTRN+1 /FAILED THE TEST - ERROR RETURN TAD I T8 SMA CLA JMP I MRDCAT /DEVICE IS NOT FILE-ORIENTED ISZ MRDCAT CLA IAC MRDREN, DCA MCATRC /STORE SEGMENT NUMBER TAD T9 /USE LOW ORDER BITS AND [177 /OF DEVICE HANDLER ENTRY POINT CLL RTL /AND THE REQUESTED SEGMENT NUMBER RAL /TO FORM A "UNIQUE" KEY TAD MCATRC /FOR THIS SEGMENT OF THIS DIRECTORY /(THE UNIQUENESS DEPENDS ON EACH HANDLER HAVING A DIFFERENT /STARTING OFFSET IN ITS PAGE) CIA TAD OLDT9 /COMPARE KEY AGAINST KEY OF CURRENT SEGMENT SNA /ARE THEY THE SAME? JMP INLRDY /YES - DON'T READ SEGMENT, ITS IN CORE CIA TAD OLDT9 DCA OLDT9 /STORE THE KEY OF THE NEW IN-CORE SEGMENT CLA CLL CML RAR /CHANGE WRITE TO READ JMS MWRCAT INLRDY, TAD I [DCOUNT DCA NFILES /FIRST WORD IN CATALOG = -# OF FILES IN CATALOG TAD [DPROPR-1 DCA XR /SET XR TO POINT TO FIRST FILE ENTRY JMP I MRDCAT /RETURN TO BUMPED ADDRESS MDSRCH, 0 FSRCLP, TAD I XR SNA CLA /EMPTY SPACES HAVE A ONE WORD ZERO DIRECTORY ENTRY JMP SKPMTF /SO SKIP THE 4 WORD COMPARE ON THEM CLA CMA TAD XR DCA XR TAD [-4 DCA T6 TAD T4 DCA T7 SRCWDL, TAD T7 JMS I [FGETW CIA TAD I XR SZA CLA /COMPARE ENTRY AGAINST ARGUMENT(8 CHARACTERS) JMP NXTFIL ISZ T7 ISZ T6 JMP SRCWDL JMS BUMPXR /SKIP GARBAGE WORDS TAD I XR SNA JMP SKPMTF+1 /UNCLOSED OUTPUT FILES DONT COUNT CIA DCA T6 /STORE FILE LENGTH ISZ MDSRCH JMP I MDSRCH NXTFIL, TAD T6 IAC JMS BUMPXR /SKIP REST OF NAME AND GARBAGE WORDS SKPMTF, TAD I XR /GET LENGTH OF THIS ENTRY TAD T5 DCA T5 /ADD TO BLOCK STARTING ADDRESS ISZ NFILES JMP FSRCLP DCA T5 /RE-INITIALIZE BLOCK NUMBER FOR NEXT SEGMENT TAD I [DLINK /DIRECTORY EXHAUSTED - ANY MORE? SZA JMP MRDREN JMP I MDSRCH BUMPXR, 0 /ROUTINE TO SKIP (DWASTE+AC) WORDS TAD I [DWASTE CIA /DWASTE IS NEGATIVE AND SO IS AC TAD XR DCA XR JMP I BUMPXR MWRCAT, 0 TAD [4210 DCA CATCTL CIF 0 JMS I T9 CATCTL, 4210 /WRITE 2 RECORDS FROM FIELD 1 1400 MCATRC, 1 JMP I [MERROR+2 /CANNOT REWRITE CATALOG JMP I MWRCAT IFNZRO .-766 <REASSEMBLE CONFIG> SDVHND, ZBLOCK 17 /DEVICE HANDLER INFORMATION TABLE - SET BY CONFIG
IFZERO 1000&. <*1000> /ENTER PROCESSOR FOR MONITOR /FIND A HOLE IN THE DIRECTORY LARGE ENOUGH TO ACCOMODATE THE FILE /AND STICK IT IN. MAKE A NOTE THAT WE DID SO FOR THE /"CLOSE" PROCESSOR. MENTER, DCA EPASS /SET UP FOR PASS 1 JMS I [MRDCAT /READ CATALOG AND SET UP NFILES AND XR JMP I [ERETRN /NON-FILE-STRUCTURED DEVICE JMS I [CONSOL DCA T2 /INTIIALIZE STARTING BLOCK NUMBER COUNTER TAD [DPROPR-1 DCA XR /RESTORE XR (CONSOLIDATOR DESTROYED IT) TAD MACARG CLL RTR RTR AND [377 /GET REQUESTED LENGTH FROM AC BITS 0-7 CIA DCA T3 /T3=REQUESTED LENGTH. IF T3=0, MEANS RETURN /LARGEST EMPTY SPACE ON TAPE. IF T3<>0, MEANS RETURN /SMALLEST BLOCK OF LENGTH =>T3. TAD I T8 /GET FCB ENTRY AND [7 SZA CLA /ANY ACTIVE TENTATIVE FILES ON THIS DEVICE? JMP I [MRTRN+1 /YES - TAKE ERROR RETURN MELOOP, TAD I XR SNA CLA JMP MEMPTY /EMPTY SPACE - LOOK AT LENGTH MTHREE /OCCUPIED - IGNORE JMS I [BUMPXR TAD I XR MELEND, TAD T2 DCA T2 /UPDATE T2 TO STARTING BLOCK # OF NEXT ENTRY ISZ NFILES JMP MELOOP /GO TO NEXT ENTRY /DIRECTORY BLOCK EXHAUSTED TAD EPASS SZA CLA /WHAT PASS ARE WE IN? JMP EFINUP /SECOND PASS - THIS IS FOR KEEPS TAD I [DLINK /FIRST PASS SZA /ANY MORE SEGMENTS? JMP I [MRDREN /YES - CONTINUE /DONE - SEE IF OUR BEST IS GOOD ENOUGH. TAD T4 JMS I [FGETW SZA CLA /CHECK THAT FIRST WORD OF NAME IS NON-ZERO TAD T6 SNA CLA /AND THAT WE FOUND WHAT WE WANTED JMP I [MLNOTF /OTHERWISE GIVE ERROR RETURN TAD ASFLAG /GET NUMBER OF BEST SEGMENT ISZ EPASS /AND RESTART THE ALGORITHM IN PASS 2 JMP I [MRDREN /(TAKES LESS SPACE THAN SAVING XR AND NAME) /EVERYTHING IS SET UP - PERFORM THE ACTUAL ENTRY OPERATION EFINUP, TAD XR DCA T1 TAD [-4 JMS I [BUMPXR TAD I [DWASTE CIA TAD XR /CATALOG MUST HAVE ROOM FOR ONE MORE FILE TAD [-1772 /AFTER THIS FILE IS ENTERED SMA CLA /WILL NEW ADDITION OVERFLOW CATALOG? JMP I [EOVFLO /YUP - CALL OVERLAY TO EXTEND DIRECTORY MELP2, TAD I T1 /MOVE REST OF CATALOG UP DCA I XR /TO CREATE SPACE FOR NEW ENTRY CLA CMA TAD T1 DCA T1 CLA CMA CLL RAL TAD XR DCA XR TAD T1 CIA CLL CML TAD NAME SZA CLA /HAVE WE PUSHED UP EVERYTHING? JMP MELP2 /NO, KEEP PUSHING TAD [-4 DCA T1 /NOW MOVE THE USERS FILE NAME TAD NAME DCA XR TAD T4 JMS I [FGETW /[IN THE USERS FIELD, OF COURSE) DCA I XR ISZ T4 ISZ T1 /INTO THE EMPTY SPACE JUST CREATED JMP .-5 TAD I [MDATE /PUT DATE OF CREATION INTO FILE NAME DCA I XR /THIS WILL BE DESTROYED IF DWASTE=0 IAC /ADJUST XR BUMP BECAUSE OF DATE STORE JMS I [BUMPXR DCA I XR /GIVE THE NEWLY ENTERED FILE A LENGTH OF 0 TAD XR /PUT A POINTER TO THE LENGTH WORD OF THE DCA I [DFLAG /NEW ENTRY INTO THE DIRECTORY HEADER CLA CMA TAD I [DCOUNT DCA I [DCOUNT /INCREASE THE FILE COUNT BY 1 TAD I T8 TAD ASFLAG DCA I T8 /SIGNAL AN OPEN OUTPUT FILE ON THIS DEVICE
JMS I [MWRCAT /WRITE THE ALTERED CATALOG BACK OUT JMP I [LRETRN /STORE ARGS BACK JUST LIKE "LOOKUP" MEMPTY, TAD I XR CIA CLL DCA T1 /SAVE LENGTH OF CURRENT ENTRY TAD T3 TAD T6 CLA /LINK NOW EQUALS BEST LENGTH>=DESIRED LENGTH TAD T3 SNA CML /IF DESIRED LENGTH=0 WE ALWAYS WANT MAXIMUM TAD T1 CLA CML /LINK IS NOW ON IF DESIRED LENGTH IS NOT IN BETWEEN /BEST LENGTH AND CURRENT LENGTH TAD T1 CIA TAD T6 SZL SNA CLA /TAKE EITHER MIN OR MAX OF BEST AND CURRENT LENGTHS, /DEPENDING ON WHETHER LINK IS ON OR OFF JMP MNOCHG /MIN(MAX)=BEST - NOTHING TO DO TAD T1 DCA T6 /MAKE CURRENT ENTRY NEW "BEST" CLA CLL CMA RAL TAD XR DCA NAME /REMEMBER CATALOG LOCATION TAD I [MCATRC DCA ASFLAG /ALSO DIRECTORY SEGMENT NUMBER TAD T2 DCA T5 /AND STARTING BLOCK NUMBER MNOCHG, TAD T1 CIA JMP MELEND /GO UPDATE THE BLOCK NUMBER
*1200 /CLOSE PROCESSOR - CLOSES AN OUTPUT FILE WHICH WAS OPENED /BY THE "ENTER" CALL -- ARGUMENTS ARE THE DEVICE NUMBER AND THE /CLOSING LENGTH OF THE FILE. PERFORMS A DIRECTORY CLEANUP AFTER /CLOSING THE FILE. IF AN ENTRY ALREADY EXISTS WITH THE NEW FILE'S /NAME IT IS DELETED. (CLOSE MAY BE USED AS A "DELETE" COMMAND /ONLY IF NO OUTPUT FILE WAS ENTERED). AN ERROR RETURN IS /GIVEN IF THE CLOSING LENGTH IS TOO BIG OR IF THERE WAS NEITHER /AN ACTIVE TENTATIVE FILE OR AN OLD FILE TO DELETE. MCLOSE, JMS I [MRDCAT /GET THE CATALOG JMP CRETRN /NON-FILE STRUCTURED DEVICE - RETURN NORMALLY CLA IAC /GET THE NEXT WORD IN THE CALLING SEQUENCE JMS I [FGET DCA T1 /GET CLOSING LENGTH AND STORE IT AWAY JMS I [MDSRCH /SEARCH FOR THE OLD COPY JMP NODLET /NO OLD COPY MTHREE TAD I [DWASTE JMS SQUISH /SQUISH OUT 3+#WASTE WORDS OF THE OLD COPY DCA I XR2 /AND MAKE THE OTHER TWO INTO AN EMPTY TAD T6 /FILE ENTRY WITH THE SAME LENGTH CIA DCA I XR2 /AS THE OLD COPY TAD I T8 AND [7 SNA /IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE JMP EOCLOS /NO - FINISH UP AND GET OUT CIA /GET THE SEGMENT NUMBER WE WANT TAD I [MCATRC SZA CLA /IS IT THE SAME AS THE ONE WE JUST SQUISHED? JMS I [MWRCAT /NO - WRITE OUT THE ONE WE SQUISHED TAD I [DFLAG /GET LOCATION OF TENTATIVE FILE CIA CLL TAD XR2 SZL CLA /IS THE ENTRY TO BE CLOSED ABOVE THE ONE JMP .+3 /WE JUST DELETED? MTHREE /YES - MOVE THE POINTER DOWN TAD I [DWASTE /TO COMPENSATE FOR THE SQUISHING TAD I [DFLAG /THE POINTER WILL NOW POINT DCA I [DFLAG /TO THE LENGTH WORD. /(THIS WAS WASTED WORK UNLESS THE CORRECT SEGMENT IS IN CORE) NODLET, TAD I T8 AND [7 SNA /IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE? JMP I [MRTRN+1 /WHAT DID HE CALL US FOR? - ERROR JMS I [MRDCAT /YES - READ IN THE CORRECT SEGMENT TAD I [DFLAG DCA T4 /T4 POINTS TO THE LENGTH OF THE TENTATIVE ENTRY TAD T1 CIA /IF T1=0, NEW ENTRY WILL BE DELETED AUTOMATICALLY DCA I T4 /DURING CONSOLIDATION ISZ T4 ISZ T4 CLL CML TAD T1 TAD I T4 /SUBTRACT CLOSING LENGTH FROM FREE BLOCK ADJACENT TO ENTRY SNL SZA JMP I [MERROR+3 /THIS CREEP HAS GONE AND DESTROYED HIS TAPE DCA I T4 EOCLOS, JMS CONSOL /CONSOLIDATE THE DIRECTORY TAD [7770 AND I T8 DCA I T8 JMS I [MWRCAT CRETRN, ISZ I [MONITO JMP I [MRTRN+1 /CONSOLIDATOR - CHECKS FOR ENTRIES OF LENGTH 0 AND DELETES THEM. /ALSO CHECKS FOR ADJACENT FREE AREAS AND COMBINES THEM. CONSOL, 0 TAD [DPROPR-1 DCA XR TAD I [DCOUNT DCA T7 /T7 = FILE COUNT CONLP, TAD I XR SNA CLA /EMPTY FILE? JMP CONMTF /YES - GO CHECK FOR NULL AND 2 IN A ROW MTHREE JMS I [BUMPXR /GET PAST THE GARBAGE WORDS TAD I XR /GET COUNT SZA CLA /WOULD THIS HAPPEN TO BE A NULL FILE? JMP CONLPT /NAH, GO TO NEXT ONE TAD [-5 /YEAH, REMOVE IT ENTIRELY TAD I [DWASTE /INCLUDING THE WASTE WORDS
SQCOMN, JMS SQUISH ISZ I [DCOUNT /BUMP DOWN FILE COUNT IN DIRECTORY ISZ NFILES /AS WELL AS THE TEMPORARY ONE IN PAGE 0 JMP CONSOL+1 /REPEAT ENTIRE CONSOLIDATION - THIS DELETION MAY /HAVE BROUGHT TWO FREE ENTRIES TOGEHER CONMTF, TAD I XR /IS THIS FREE ENTRY NULL? SNA JMP SQTRIV /YES - SQUASHITLIKEABUG DCA T2 /NO - SAVE LENGTH TAD XR DCA T1 /SAVE POSITION OF LENGTH WORD ISZ T7 /WAS IT THE LAST FILE? SKP /NO, THEN THERE IS ONE AFTER IT(GOOD THINKING!) JMP I CONSOL /YES - RETURN FROM CONSOLIDATOR TAD I XR SZA CLA /TWO EMPTIES IN A ROW? JMP CONLP+3 /NO - SLIP BACK INTO LOOP TAD I XR TAD T2 /YES - COMBINE LENGTHS DCA I T1 /STORE BACK IN FIRST LENGTH WORD AND SQUISH SECOND ENTRY SQTRIV, CLA CMA CLL RAL JMP SQCOMN /SQUISH OUT 2 WORDS CONLPT, ISZ T7 JMP CONLP /MORE FILES - KEEP PLUGGING JMP I CONSOL /RETURN FROM CONSOLIDATOR MRESET, TAD [-17 DCA T3 MRSETL, TAD T3 JMS I [MCKDEV CLL TAD [200 SNL CLA /ZERO ALL DEVICE HANDLER SLOTS THAT AREN'T RESIDENT DCA I T1 JMS I [FGET SNA CLA /IF NEXT WD IS 0, DONT ZAP OPEN FILES JMP .+4 TAD [7770 AND I T8 DCA I T8 /DELETE THE "FILE CURRENTLY OPEN" FLAG IF ASKED ISZ T3 JMP MRSETL JMP I [MNEXT SQUISH, 0 TAD XR DCA XR1 CLA CLL CMA RAL TAD XR1 DCA XR2 /SET UP XR2 FOR CHANGING SQUISHED ENTRY SQLOOP, TAD I XR DCA I XR1 /MOVE DOWN ONE WORD TAD XR TAD [-1777 SZA CLA /AT END YET? JMP SQLOOP /NO, KEEP GOING JMP I SQUISH
*1377 /MOVE UP IF THE LOCATION IS NEEDED NOPUNCH *1400 ENPUNCH /INITIAL DIRECTORY FOR MONITOR /DEFINES BLEEP LOADER (LOADER.SV) AND DEC BINARY LOADER(BINLDR.SV) DCOUNT, -2 /TWO ENTRIES DORG, MFREE /FILE STORAGE STARTS AT BLOCK "MFREE" DLINK, 0 /THIS IS THE ONLY DIRECTORY RECORD DFLAG, 0 /THERE ARE NO OPEN OUTPUT FILES ON THIS DEVICE DWASTE, -1 /# OF WASTED WORDS PER ENTRY DPROPR, 0102 /AB 2314 /SL 0422 /DR 2326 /.SV 5370 /ENCODING FOR "OCTOBER 31, 1970" -5 /FIVE BLOCKS LONG( 1 BLOCK = 256 WORDS) 0 /EMPTY SPACE -1 /OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH
*3400 /"ENTER" OVERLAY TO USR - RUNS IN 11000 MEOVLP, TAD I [DLINK SNA CLA JMP MELAST /LAST SEGMENT - MUST CREATE A NEW ONE ISZ I [DCOUNT /BUMP ENTRY COUNT DOWN JMS I [MWRCAT /WRITE OUT THIS SEGMENT JMS MSKIPF /FIND END OF SHORTENED DIRECTORY DCA MEFCNT /PREPARE TO TRANSFER LAST ENTRY TAD (MEOVLS-1 DCA XR1 /INTO NEXT DIRECTORY SEGMENT TAD I XR DCA I XR1 ISZ MEFCNT /THROUGH A BUFFER AT LOC 11200 TAD XR CIA TAD T1 /T1 WAS SET UP BY "ENTER" SZA CLA JMP .-7 TAD I T1 /GET LENGTH OF MOVED ENTRY DCA MEOCNT TAD I [DLINK JMS I [MRDCAT /READ NEXT SEGMENT JMS I [CONSOL /MAKE SURE IT IS AT ITS SMALLEST TAD I [DORG TAD MEOCNT DCA I [DORG /BUMP FILE ORIGIN DOWN JMS MSKIPF /FIND LAST LOC IN NEW SEGMENT TAD XR DCA METMP1 TAD XR TAD MEFCNT DCA METMP2 /PREPARE TO PUSH ALL ENTRIES UP MELP3, TAD I METMP1 DCA I METMP2 /DO THE PUSHING CLA CMA TAD METMP1 DCA METMP1 CLA CMA TAD METMP2 DCA METMP2 TAD METMP1 TAD (-DWASTE SZA CLA /ARE WE THROUGH? JMP MELP3 /NO TAD (MEOVLS-1 DCA XR /PREPARE TO MOVE THE SAVED ENTRY INTO THE CLA CMA /NEW SEGMENT TAD I [DCOUNT DCA I [DCOUNT /INCREASE ENTRY COUNT OF NEW SEGMENT TAD MEFCNT CIA MECOMN, DCA MEFCNT /STORE NUMBER OF WORDS TO MOVE TAD [DWASTE DCA XR1 TAD I XR DCA I XR1 ISZ MEFCNT JMP .-3 /MOVE THE ENTRY IN JMS MSKIPF TAD XR DCA T1 /T1=LAST LOC IN SEGMENT TAD I [DWASTE CIA TAD XR TAD [-1772 SMA CLA /HAVE WE MADE THIS SEGMENT TOO BIG? JMP MEOVLP /YES - LOOP UNTIL WE GET IT RIGHT JMS I [MWRCAT /WRITE OUT NEW SEGMENT JMP MEOXIT /READ IN ENTER AND CONTINUE MELAST, TAD I [DCOUNT CLL CML RAR /GIVE THE NEW SEGMENT HALF OF THE OLD ENTRIES DCA METMP1 /LENGTH OF NEW SEGMENT TAD METMP1 CIA TAD I [DCOUNT DCA I [DCOUNT /ADJUST LENGTH OF OLD SEGMENT JMS MSKIPF /FIND BOUNDARY LOC BETWEEN SEGMENTS TAD I [MCATRC IAC DCA I [DLINK /LINK THE OLD LAST SEGMENT TO TAD I [DLINK /THE NEWLY CREATED ONE TAD [-7 SMA CLA JMP I [MEOERR /PROVIDED THAT THERE IS ROOM FOR ANOTHER JMS I [MWRCAT /WRITE OUT THE NEXT-TO-LAST SEGMENT ISZ I [MCATRC /BUMP RECORD NUMBER FOR NEXT WRITE ISZ OLDT9 /LIKEWISE BUMP DIRECTORY KEY TAD METMP1 DCA I [DCOUNT TAD MEOCNT CIA TAD I [DORG DCA I [DORG /SET UP PARAMETERS OF THE NEW SEGMENT DCA I [DLINK /MARK IT AS THE NEW LAST SEGMENT TAD XR TAD (-1777 /SET UP COUNT OF WORDS TO SLIDE DOWN JMP MECOMN /USE COMMON CODE TO SLIDE WORDS AND EXIT MSKIPF, 0 /SUBR TO FIND LAST LOC USED IN A SEGMENT /ALSO FINDS NUMBER OF BLOCKS USED BY SEGMENT TAD I [DCOUNT DCA MNOFIL TAD [DWASTE DCA XR DCA MEOCNT /INITIALIZE POINTER(XR) AND COUNT(MEOCNT) MSKPLP, TAD I XR SNA CLA JMP MEOMTY MTHREE TAD I [DWASTE /BUMP POINTER TO LENGTH WORD OF FILE ENTRY CIA TAD XR DCA XR MEOMTY, TAD I XR TAD MEOCNT DCA MEOCNT ISZ MNOFIL JMP MSKPLP JMP I MSKIPF MEOCNT, 0 MEFCNT, 0 METMP1, 0 METMP2, 0 MNOFIL, 0 MEOVLS=1200 /DESTROYS PART OF "CLOSE" OP FOR BUFFER
/ABSOLUTE LOADER FOR BLEEP MONITOR - VERSION 1( AND ONLY) *2000 CTLBLK=3400 BUFFER=CTLBLK XFIELD=20 ORIGIN=21 B1=22 B2=23 B3=24 C1=25 C2=26 C3=27 WD=30 WD1=31 WD2=32 FILPTR=33 PG7400=34 LOADXR=11 ABSLDR, JMS I (CTINIT JMS I (CTINIT JMP CALLCD JMP NOCD NEXTCD, JMS I (NEXFIL CALLCD, JMS I [200 5 /COMMAND DECODE 0216 /ASSUMED EXTENSION IS .BN NOCD, TAD (6001 CDF 0 DCA I [JSBITS /SET JSBITS TO SAVE CD AREA NEXT TIME CDF 10 TAD I (MPARAM+1 AND [100 SZA CLA /IS /R SWITCH ON? JMS I (CTINIT /YES - RE-INITIALIZE LOADER TABLES LD7400, 7400 TAD (MIFILE DCA FILPTR JMS I (SETADR /GET THE STARTING ADDRESS IF IT APPEARS ON THE LINE NEWFIL, TAD [7001 DCA HANDLR TAD I FILPTR AND [7760 SZA /LENGTH OF 256 BLOCKS IMPLIES AT LEAST 256 TAD [17 CLL CML RTR RTR DCA RCDCNT TAD I FILPTR ISZ FILPTR SNA JMP NEXTCD /FILE POINTER = 0 MEANS NO MORE INPUT FILES JMS I [200 1 /ASSIGN HANDLR, 7001 /LOAD INTO 7000 IF NOT ALREADY LOADED JMP I (IOERR TAD I FILPTR DCA RECNO ISZ FILPTR CLA CMA DCA CHCNT DCA REOF TAD I (MPARAM /TEST FOR /I AND (10 SNA CLA JMP I (LOADER /I IS NOT ON ISZ OFLG /IS /I ALLOWED? JMP I (OERR /NO! JMP I (SLASHO GETCH, 0 /GET-NEXT-INPUT-CHARACTER ROUTINE KRS TAD (-203 SNA CLA KSF SKP JMP I (MGET ISZ JMPGET ISZ CHCNT JMPX, JMP JMPGET TAD REOF SZA CLA JMP I GETCH /EOF REACHED BEFORE LOGICAL END - ERROR CIF 0 JMS I HANDLR 0210 /READ 2 RECORDS INTO FIELD 1 PBUFFR, BUFFER RECNO, 0 JMP RERROR ISZ RECNO ISZ RCDCNT SKP ISZ REOF TAD (-601 DCA CHCNT TAD PBUFFR DCA CHPTR TAD JMPX DCA JMPGET JMP GETCH+1 JMPGET, JMP . JMP CHAR1 JMP CHAR2 CHAR3, TAD JMPX DCA JMPGET TAD I CHPTR AND LD7400 CLL RTR RTR TAD CHTMP RTR RTR ISZ CHPTR JMP GCHCOM CHAR2, TAD I CHPTR AND LD7400 DCA CHTMP ISZ CHPTR CHAR1, TAD I CHPTR GCHCOM, AND (377 ISZ GETCH JMP I GETCH RERROR, SPA CLA JMP I (IOERR /AN ACTUAL READ ERROR - AMAZING! ISZ REOF JMP RECNO+2 REOF, 0 CHCNT, 0 CHPTR, 0 CHTMP, 0 RCDCNT, 0 OFLG, -1 /SWITCH FOR /O OPTION
*2200 PUTWD, 0 / AND I B2 / DCA PUTMP / TAD PUTMP CMA AND I B2 /AND OUT THE PAGE SLOT IN THE PAGE TABLE DCA I B2 TAD ORIGIN DCA ORGX TAD XFIELD CLL RTR RTR SZA CLA /TEST FOR FIELDS 0 OR 1 JMP PUTIT /NEITHER - STORE AS IS SNL JMP FLD0 TAD ORIGIN SPA CLA JMP FLD1 CLA CLL CML RTR TAD ORIGIN SMA CLA JMP .+3 ISZ I (OVLYFG /SET FLAG THAT LOADER IS BEING OVERLAYED TAD (2400 /LOADER OVERLAYS GO IN MTEMP+11 - MTEMP+14 LCOMPR, TAD ORIGIN RTL RTL RAL AND [17 TAD (MTEMP RLCOMN, DCA PGTMP TAD BUFREC CIA TAD PGTMP SNA CLA JMP DONTWR JMS WRBUF / TAD PUTMP WRIBUF, CLA /MODIFIED..IF NOT /O GETS SZA CLA JMP DONTWR CIF 0 JMS I [SHNDLR 0210 1400 /USE CATALOG SPACE PGTMP, 0 JMP I (LIOERR DONTWR, DCA OLDT9 /MARK THE CATALOG DESTROYED TAD PGTMP DCA BUFREC TAD ORIGIN AND [377 TAD PTRBFR DCA ORGX JMP PUTIT2 FLD1, CLL TAD ORIGIN /IGNORE LOCATIONS ABOVE 17600 TAD [200 SZL CLA JMP I PUTWD PUTIT, TAD XFIELD TAD [7770 /CONSTRUCT CDF N FOR PROPER FIELD PUTIT2, TAD CDF10 DCA .+1 HLT TAD C3 DCA I ORGX CDF10, CDF 10 JMP I PUTWD FLD0, TAD ORIGIN /CHECK FOR STUFF IN PAGE 7000 TAD [1000 SNL CLA /IF NON ZERO,OVERLAY JMP PUTIT TAD (7400 /FORM RECORD NO. FOR OVERLAY ISZ PG7400 /SET OVERLAY FLAG JMP LCOMPR /FORM RECORD NO. WRBUF, 0 TAD BUFREC SNA JMP I WRBUF CIF 0 JMS I [SHNDLR 4210 PTRBFR, 1400 BUFREC, 0 JMP I (LIOERR /BAD I/O ON SYSTEM DEVICE JMP I WRBUF PUTMP, 0 CORTAB, ZBLOCK 30 NEXFIL, 0 JMS WRBUF /WRITE WHATEVER TAD I (MPARAM-1 SPA CLA JMP I (BUILD TAD I (MPARAM AND [40 SZA CLA JMP I (BUILD JMP I NEXFIL ORGX=NEXFIL
*2400 ITSOVR, JMS ASSEMB CIA TAD LCKSUM SZAIN, SZA CLA JMP I (BADCKS TAD I (MPARAM+1 AND L40 SNA CLA JMP I (NEWFIL LOADER, DCA LCKSUM DCA I (OFLG /CANCEL FURTHER /I'S TAD SZAIN DCA I (WRIBUF JMS GETFLD DCA XFIELD TAD [200 DCA ORIGIN JMS I (GETCH JMP I (NEWFIL SNA JMP .-3 TAD [-200 SZA CLA JMP LOADER+1 LEADER, JMS I (GETCH JMP I (NEWFIL SNA JMP LOADER+1 TAD [-200 SNA JMP LEADER NEWWD, SMA JMP FIELDW TAD [200 DCA WD1 JMS I (GETCH JMP I (BADINP DCA WD2 JMS I (GETCH JMP I (BADINP TAD [-200 SNA JMP ITSOVR DCA WD JMS ASSEMB SNL JMP DATAWD DCA ORIGIN JMP GETNXT DATAWD, JMS I (LOADWD ISZ ORIGIN L40, 40 GETNXT, TAD WD1 TAD WD2 TAD LCKSUM DCA LCKSUM TAD WD JMP NEWWD ASSEMB, 0 TAD WD1 CLL RTL RTL RTL TAD WD2 JMP I ASSEMB FIELDW, TAD (-32 SNA JMP CTLZ TAD (-46 SPA JMP NOTXP DCA WD1 TAD WD1 AND (7 SZA CLA JMP NOTXP TAD WD1 AND (70 DCA XFIELD JMS I (GETCH JMP I (BADINP TAD [-200 SZA JMP NEWWD NOTXP, CLA TAD LCKSUM SNA CLA JMP LOADER JMP I (BADINP LCKSUM, 0 CTLZ, TAD LCKSUM SZA CLA JMP I (BADINP JMP I (NEWFIL GETFLD, 0 DCA C1 TAD I (MPARAM+2 AND (1774 SNA JMP I GETFLD RTL RAL ISZ C1 SNL JMP .-3 CLA CMA TAD C1 CLL RTL RAL JMP I GETFLD
*2600 BUILD, TAD (CORTAB+25 DCA B1 TAD I (CORTAB+3 CLL CMA AND [7760 SNA CLA CML TAD I (CORTAB CMA AND [7760 SNA CLA IAC RTR DCA I (CTLBLK+3 TAD (CTLBLK+3 DCA LOADXR TAD (-10 DCA C1 TAD (70 DCA FIELDB DCA I (CTLBLK FLDLP, TAD FIELDB CLL RAR SZA CLA /DON'T INCLUDE PAGES 07600 OR 17600 CMA /IN THE CORE MAP TAD (-37 DCA C2 DCA LOWERA MTLOOP, JMS I (SHFT SNL CLA JMP INUSE TAD LOWERA MTRSME, TAD [200 DCA LOWERA ISZ C2 JMP MTLOOP JMP FLDOVR INUSE, TAD LOWERA TAD [200 DCA UPPERA ISZ C2 SKP JMP ENDRGN-2 JMS I (SHFT SZL CLA JMP ENDRGN TAD UPPERA JMP INUSE+1 CLA CMA DCA C2 ENDRGN, TAD LOWERA AND (7400 DCA I LOADXR ISZ I (CTLBLK TAD LOWERA AND (7400 CIA TAD UPPERA CLL RAR TAD FIELDB DCA I LOADXR TAD UPPERA JMP MTRSME FLDOVR, TAD FIELDB TAD (-10 DCA FIELDB CLA CLL CMA RTL TAD B1 DCA B1 ISZ C1 JMP FLDLP TAD I (CTLBLK SNA JMP I (NULERR CIA DCA I (CTLBLK TAD I (MPARAM+2 AND (3 TAD I (CTLBLK+3 DCA I (CTLBLK+3 TAD LSTFLD AND (7 CLL RTL RAL TAD [CDF CIF 0 DCA I (CTLBLK+1 TAD LSTADR DCA I (CTLBLK+2 JMP I (LGTOUT /WRITE CONTROL BLOCK AND EXIT FIELDB, 0 SETADR, 0 UPPERA=SETADR TAD I (MPARAM+3 SNA /IS THERE A STARTING ADDRESS SPECIFIED? JMP I SETADR /NO DCA LSTADR TAD I (MPARAM-1 DCA LSTFLD JMP I SETADR LINIT2, 0 LOWERA=LINIT2 DCA LSTFLD TAD [200 DCA LSTADR /INITIALIZE STARTING FIELD/ADDRESS DCA PG7400 DCA I (OVLYFG /INITIALIZE FLAGS FOR OVERLAYS JMP I LINIT2 LSTFLD, 0 LSTADR, 200
*3000 ZOFILE, MOFILE ZOUCNT, -47 LGTOUT, TAD PG7400 SNA CLA JMP .+7 CIF 0 JMS I [SHNDLR 0300 7000 MTEMP+15 JMP I (LIOERR CIF 0 JMS I [SHNDLR 4210 CTLBLK-200 MTEMP+10 JMP I (LIOERR TAD I (CTLBLK+2 DCA CTL2 /MOVE THINGS INTO THIS PAGE TAD I (CTLBLK+3 DCA CTL3 /SO WE CAN REFERENCE THEM WITH DF=0 TAD I (MPARAM AND (40 SNA CLA JMP LNOGO TAD CTL3 RAL SPA CLA /ARE WE OVERLAYING THE I/O MONITOR? JMP LKICKM /NO CDF 0 DCA I [JSBITS /YES - SET JSBITS TO FORCE A READ CDF 10 JMS I [200 13 /RESET I/O DEVICES AND FILES LKICKM, JMS I [200 11 /KICK MONITOR OUT /******************************************** /NO PAGE ZERO REFERENCES AFTER THIS POINT /PAGE ZERO MAY CONTAIN USER CRAP /******************************************** DCA I ZOFILE /ZERO OUT COMMAND DECODER AREA ISZ ZOFILE ISZ ZOUCNT JMP .-3 TAD I (CTLBLK+1 CDF 0 DCA I (MSTCDF TAD CTL2 DCA I (MSTADR /SET UP STARTING ADDRESS IN FIELD 0 JMP LMOVRD LNOGO, TAD CTL3 SPA CLA /ARE WE OVERLAYING THE KEYBOARD MONITOR? TAD [5 /NO - RETURN TO NON-SAVING ENTRY TAD [7600 CDF 0 DCA I (MSTADR TAD ZCDIF0 DCA I (MSTCDF CLA CMA LMOVRD, CDF 10 DCA I (7700 /SET 7700 TO -1 IF NO GO TAD I (CTLBLK+1 CDF 0 DCA I (JFIELD /SET UP PARAMETERS IN FIELD 0 TAD CTL2 DCA I (JSTART TAD CTL3 DCA I (JSBITS LMOVLP, TAD COMBO DCA I COMBPT ISZ LMOVLP ISZ COMBPT ISZ COMBCT JMP LMOVLP /MOVE THE READ OF THE LOADER OVERLAY INTO FIELD 0 ZCDIF0, CDF CIF 0 TAD OVLYFG SZA CLA JMP I (MREAD /LOADER OVERLAYED - GO READ OVERLAY JMP I (MSTCDF /LOADER NOT OVERLAYED - WHY READ? COMBPT, MREAD-1 COMBCT, -7 COMBO, 7607 MREAD-1&177+4600 /JMS I .-1 1010 2000 MTEMP+11 /LOCATION OF SCRATCH BLOCKS FOR LOADER OVERLAY HLT MSTCDF&177+5200 /JMP MSTCDF CTL2, 0 CTL3, 0 OVLYFG, 0 LOADWD, 0 DCA C3 TAD XFIELD CLL RAR TAD XFIELD RTR TAD (CORTAB-1 DCA B2 TAD ORIGIN AND [7600 CLL RTL RTL RTL ISZ B2 TAD (-14 SMA JMP .-3 DCA CTL2 CLL CML RAL ISZ CTL2 JMP .-2 JMS I (PUTWD JMP I LOADWD
*3200 ERPCH, 0 AND (77 /GET LOW ORDER 6 BITS SZA JMP NZCHAR JMS ERR FILMSG, TEXT /, FILE 0/ NZCHAR, TAD (-40 SPA TAD (100 TAD (240 /CONVERT TO ASCII JMS LDRPCH /PRINT JMP I ERPCH /AND RETURN LDRPCH, 0 TLS TSF JMP .-1 CLA JMP I LDRPCH SHFT, 0 CLA CLL CMA RTL DCA C3 CLA CLL CML RTL TAD B1 SHFTLP, DCA B3 TAD I B3 RAL DCA I B3 CLA CMA CML TAD B3 ISZ C3 JMP SHFTLP JMP I SHFT /NOTE: SHFT LEAVES AC NON-ZERO ERR, 0 CLA CDF 10 TAD I (FILPTR /ZERO CHAR GETS REPLACED BY "FILE #" TAD (322 /MAGIC NUMBER CLL CML RAR /AC NOW CONTAINS " #" DCA FILMSG+3 ERRLUP, TAD I ERR SNA JMP EOMESG /MESSAGE MUST BE EVEN NUMBER OF CHARS LONG RTR RTR RTR JMS ERPCH TAD I ERR JMS ERPCH ISZ ERR JMP ERRLUP EOMESG, TAD (215 /TERMINATE MESSAGE WITH CR-LF JMS LDRPCH TAD (212 JMS LDRPCH JMP I (ABSLDR /RETURN TO LOADER STARTING ADDRESS IOERR, JMS ERR TEXT %I/O ERROR% BADINP, JMS ERR TEXT /BAD INPUT/ BADCKS, JMS ERR TEXT / BAD CHECKSUM/ NULERR, JMS I (CTINIT NOP JMS ERR TEXT /NO INPUT/ LIOERR, JMS ERR TEXT /SYSTEM I-O ERROR/ OERR, JMS ERR TEXT %NO /I!% CTINIT, 0 TAD (-30 DCA C1 TAD (CORTAB-1 DCA LOADXR CLA CMA DCA I LOADXR ISZ C1 JMP .-3 JMS I (LINIT2 ISZ CTINIT JMP I CTINIT
*CTLBLK+200 /CODE FOR OVERLAY OPTION IS HERE.IF /I IS NOT /USED IMMEDIATELY, THIS CODE WILL PROBABLY BE DESTROYED, /AS IT IS USED FOR A BUFFER SLASHO, CLA CMA DCA I (OFLG /RE ENABLE /I TAD I (HANDLR DCA GLONK /ENTRY POINT TO HANDLER TAD I (RECNO DCA CCBLOK CIF 0 JMS I GLONK /READ IN CORE CONTROL BLOCK 0110 CCBPTR, CTLBLK CCBLOK, 0 JMP I (OERR /DATA FAILURE TAD I CCBPTR /NO. SEGMENTS CMA /TEST FOR BAD CORE IMAGE AND (7740 SZA CLA JMP I (BADINP /NOT CORE IMAGE TAD I CCBPTR DCA SEGCNT NEWSEG, TAD I SGSTAD /SEGMENT START ADDRESS DCA ORIGIN TAD I SGFDLT /FIELD AND LENGTH AND (77 DCA XFIELD TAD I SGFDLT AND [7700 DCA SEGLTH TWOPG, TAD SEGLTH SPA SNA /ALL PAGES DONE IN THIS SEGMENT? JMP GTSEG /YES TAD [7600 SMA CLA /NO.. IS TWO PAGE SEGMENT LEFT? TAD [7600 /YES..-400 TO WORD COUNT TAD [7600 /NO.. -200 TO WORD COUNT DCA WDCT TAD SEGLTH TAD [7600 /BUMP DOWN LENGTH LEFT DCA SEGLTH ISZ CCBLOK /POINT TO NEXT DATA RECORD TAD CCBLOK DCA DATRC DCA OLDT9 /MARK DIRECTORY DESTROYED CIF 0 JMS I GLONK /READ THE DATA RECORD IN 0210 BUFPT, 1400 /INTO 11400 DATRC, 0 JMP I (IOERR /DATA FAILURE CLA CMA TAD ORIGIN AND [177 TAD (1200 /SET UP INPUT POINTER CHARPT=10 DCA CHARPT TAD I CHARPT JMS I (LOADWD /MOST OF THE WORK ISZ ORIGIN ISZ WDCT /FINISHED THIS BLOCK? JMP .-4 JMS I (WRBUF /YES.. WRITE THE STUFF OUT DCA I (BUFREC /SO THAT WRBUF DOESN'T SCREW US UP JMP TWOPG /NEXT! GTSEG, ISZ SEGCNT /ANY MORE SEGMENTS SKP JMP RENEW /RESET CCB POINTER FOR NEXT /I CLA CLL CML RTL TAD SGSTAD DCA SGSTAD CLA CLL CML RTL TAD SGFDLT DCA SGFDLT /POINT TO NEXT CCB ENTRIES JMP NEWSEG GLONK, 0 /HANDLER ENTRY POINT HERE WDCT, 0 SEGCNT, 0 SEGLTH, 0 CTLBLK=3400 SGFDLT, CTLBLK+5 /FIELD AND LENGTH WORD SGSTAD, CTLBLK+4 /SEGMENT START ADDRESS RENEW, CLA TAD (CTLBLK+4 DCA SGSTAD TAD (CTLBLK+5 DCA SGFDLT JMP I (NEWFIL
/PAGE 0 - TEMPORARIES AND LITERALS. /LOCATIONS 0-3 ARE RESERVED FOR POINTERS TO KEY LOCATIONS /IN THE MONITOR (SO THE CUSPS CAN GET AT THESE LOCATIONS) /LOCATIONS 4-6 ARE RESERVED FOR SYSTEM ODT FIELD 1 BREAKPOINTS *7 OLDT9, 0 /POINTER TO DEVICE HANDLER OF DIRECTORY IN CORE *15 XR1, 0 XR2, 0 XR, 0 *20 /ENTRY TO MONITOR FROM A CALL TO 17700 - /CAN BE DESTROYED AFTER IT IS EXECUTED MSTART, TAD I T1 DCA MACARG TAD I [7700 DCA I [MONITO TAD I [SMCIF DCA I T2 /FAKE A CALL TO "MONITO" TAD I [MONITO RAL SNL SMA CLA TAD I [SMCIF TAD T3 SNA CLA /CHECK FOR A CALL FROM 10000-11777 JMP I [MERROR /YES - GIVE ERROR IMMEDIATELY JMP I T4 /NO - SLIDE INTO MONITOR CODE *36 /POINTERS TO INTERNAL MONITOR LOCATIONS FOR "BUILD" SDNAME /SYSTEM DEVICE NAME TABLE SDVHND /DEVICE HANDLER ENTRY TABLE *40 /LOCATIONS 20-37 RESERVED FOR CUSP SCRATCH SPACE USERFG, 1 /MUST BE IN 40 - SEE CD LISTING T1, MARG1 /MUST BE AT 41 T2, FGETX T3, -6213 T4, MRENTR T5, 0 T6, 0 T7, 0 T8, 0 T9, 0 NAME, 0 NFILES, 0 ASFLAG, 0 MACARG, 0 EPASS, 0 MERRNO, 4000 MEOXIT, CIF 0 /RETURN FROM ENTER OVERLAY JMS I [SHNDLR 0210 1000 MONTOR+2 /RESTORE LOCS 1000-1377 OF USR HLT /HELP! JMP I .+1 MENTER /RESTART ENTER OPERATION COMPLETELY
$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search