File OS8.PA (PAL assembler source file)

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

/7 OS8 MONITOR SYSTEM		OS8 VERS. 3
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1970,1971,1972,1973,1974 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/

/NOVEMBER 30, 1973 RL/EF/HJ/SR /THIS VERSION OF OS/8 IS THE BATCH OPERATING SYSTEM /AS WELL AS THE STANDARD KEYBOARD SYSTEM. THIS SYSTEM /IS EXTERNALLY COMPATIBLE WITH ALL PREVIOUS OS/8-PS/8 /USER PROGRAMS. HOWEVER, INTERNALLY THE SYSTEMS ARE /QUITE DIFFERENT. THE MARCH 1972 OS/8 WILL NOT RUN BATCH. /THIS VERSION IS COMPATIBLE WITH CCL. / 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 CCB=7400 CSOVLY=400 RSOVL1=1400 RSOVL2=2000 VERSNO=3 PATCHLEV=" /V3 CHANGES: /1. CCL SUPPORT /2. FIXED KILLER CLOSE BUG /3. ADDED VERSION NUMBER /4. ^U, RO TO BOL, AND LF ALL PRINT '.' AGAIN /5. CALL TO USR WITH CODE OF 0 GIVES ERROR /6. MONITOR ERROR MESSAGES NOW GIVE EXPLANATION /7. ENTER NOW MOVES 7 FILES TO MAKE ROOM INSTEAD OF HALF SEGMENT /8. DIRECTORY VERIFICATION HAS IMPROVED /V3 FIXES TO ABSLDR: /1. ALLOWED PARITY ^C /2. PUT IN SELF-STARTING STUFF /3. FIXED CCB BUG FOR 17600 /FIXES TO FIELD RELEASE /1. ABSLDR CHECKS PAGE 0 LITERALS /2. FIXED BUG RE MONITOR ERROR MESSAGES /3. ADDITIONAL INFO FIX /4. BATCH FIX
/KEYBOARD MONITOR FOR OS/8 SYSTEM - UNCOMMENTED AT PRESENT FIELD 0 MTHREE=CLA CLL CMA RTL *200 PRINT, JMP I PRNAME /MUST BE AT 200 FOR BATCH JMP .+3 /****GETS CIF CDF N FOR BATCH***** TSF /****GETS JMP I .+1****** JMP .-1 /*GETS BOSPRT***** TLS CLA TAD [7000 DCA PRINT+1 JMP I PRINT GETNAM, 0 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 IFNZRO .-330 <CCLTRB,ERRR> 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 [240 AND [77 TAD [240 JMS I PCH JMP I PCHAR
PRINTQ, JMS PRMESG TEXT /?/ 0 *367 KSV2A, SAVE2A SAVE2, TAD I LXR SNA /ARE THERE ARGUMENTS? JMP I KSV2A /NO..USE CCB JMS I [SHNDLR /READ IN ARGUMENT OVERLAY 0201 CSOVLY MSOVLY JMP KMONER /NORMAL RETURN IS TO 400
*400 KMNTRY, JMP I HANDAD /V3 0 /FREE LOCATION ! PCRLF, JMS I [CRLF IFNZRO .-403 <BTCHER,XXXX> KEYMON, JMS I GLINE TAD [BEGLN-1 DCA LXR JMS I GNAME JMP I [PRINTQ JMS I [SRCH -123; ASSIGN -2301; SAVE -2225; RUN -705; GET -2200; R -2324; START -1704; ODT -0405; DEAS IFNZRO .-431 <SEECCL,ZZZ> -0401; DATE 0 JMP I .+1 CCLSW, PRQMRK /MODIFIED FOR CCL TO 'GETCCL' IFNZRO CCLSW-435 <SEECCL,ZZ> ASSIGN, TAD [12 JMS GDEVNO TAD [UDNAME-1 DCA TM1 JMS I GNAME JMP ASGN2+1 /NO USER DEV. DO A DEASSIGN TAD NM2 /SEE IF WE HASH IT SNA JMP ASGN2 /DON'T HASH..ONLY 1 OR 2 CHARS TAD NM1 RAL /LINK BECOMES 4000 IF NECESSARY CLA CML RAR TAD NM2 ASGN2, TAD NM1 JMP I [ASDONE
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, KMINIT /V3 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 MOVBUF /USED AS POINTER TO FIELD 1 SR JMP I [KMER2 JMP I [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 CIF 10 /MOVE THE LINE BUFFER TO 1600 DURING JMS I PGNAME+1 /A SAVE, AS HANDLER WIPES IT OUT TAD LXR /LET'S MOVE THE REGISTER AROUND TAD [SVLNBF-BEGLN DCA LXR TAD [1001 DCA HNDLAD CLA IAC JMS GDEVNO JMS RSCOMN JMP I [SAVE2 HNDLAD, /REPLACED WITH 1001 BY SAVE WRCTLB, 7001 /WRITE OVERLAY AND CCB JMS I [SHNDLR 4600 6200 MTEMP+6 JMP KMONER JMP I WRCTLB
*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, DCA TEMP1 DCA TEMP2 TAD I LXR /V3 SZA /V3 JMP I [STRTX /V3 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 CCB FILE, 0 /READ IN THE HEADER BLOCK JMP KMONER /ERROR WHILE READING HEADER BLOCK TAD I [CCB JMS I [CCBTST /TEST FOR VALID CORE CONTROL TAD I [CCB+1 DCA I [MSTCDF TAD I [CCB+2 DCA I [MSTADR /MOVE THE STARTING ADDRESS INTO UPPER CORE TAD I [CCB+1 DCA I [JFIELD TAD I [CCB+2 DCA I [JSTART TAD I [CCB+3 /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 [CCB CLL CMA RAL /POINT TO LAST DOUBLEWORD IN CCB TAD [CCB+4 DCA TM1 /TM1 POINTS TO SEG. ADDRESS TAD I TM1 /STORE ADDRES TO READ POSSIBLE OVERLAY DCA I [MREAD+2 ISZ TM1 /POINT TO SEGMENT CONTROL WORD TAD DEVHND /IF THE HANDLER IS IN 7600, OR TAD [200 /IF THE SEGMENT DOES NOT LOAD OVER CLA RAL /7000, NO OVERLAY IS NEEDED. ALSO IF TAD I TM1 /THE SEGMENT IS IN FIELDS 1-7. AND [77 RUN5A, SZA CLA JMP I [RUN6 /NO PROBLEMS.. READ STUFF IN TAD I [MREAD+2 /SEE IF WE OVERLAY 7000 CLL CML RAR TAD I TM1 /ADD IN CONTROL WORD TAD [300 SPA /IF NEGATIVE, 7000 IS NOT OVERLAYED JMP RUN5A TAD [7600 /GETS 0, 100, 200, OR 300 SMA /IF POSITIVE READ 3 PAGE OVERLAY ISZ I [PGNAME+1 /POINT TO NEXT TO LAST RECORD TAD [300 DCA RDCNT TAD I [PGNAME+1 CMA /GET RECORD TO READ OVERLAY FROM TAD FILE DCA R7000 JMS I DEVHND /READ OVERLAY FROM THE FILE INTO PAGES RDCNT, 0 /BEFORE CCB 6200 /THEN WRITE THE WHOLE MESS OUT R7000, 0 JMP I [RERR JMS I [WRCTLB /WRITE OUT THE OVERLAY+CCB DCA .-1 /BUT ONLY ONCE!! ISZ RUNSW DCA I [MSWITC /ENABLE READ OF OVERLAY TAD RDCNT /SEE IF THIS SEG IS EXHAUSTED CIA TAD I TM1 SPA SNA ISZ I [CCB /ARE WE DONE ALL SEGMENTS? SKP /NOT YET. LOOP UNTIL DONE JMP I [MSWITC RUN5, DCA I TM1 /SAVE ALTERED CONTROL WORD JMP RUN2
/ASDONE, CDF 10 / DCA I TM1 /THIS COULD BE OPTIMIZED / CDF 0 / JMP I [KEYMON KMER1, JMS I [PRNAME /DEVICE NOT AVAILABLE JMS I [PRMESG TEXT / NOT AVAILABLE/
*1000 /MUST BE AT 1000 FOR BATCH 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 I LXR DCA I X1 ISZ TEMP2 JMP .-3 CDF 10 TAD MVFROM DCA I PDBUF ISZ .-2 ISZ PDBUF ISZ MVCNT JMP .-5 CDF 0 TAD I PDBUF+1 /SEE IF BATCH IS SET RAL /IF YES, GO TO PAGE 0 TO CONTINUE SMA CLA /IF IT ISN'T, CONTINUE NORMALLY JMP INTGO /NORMAL KEYBOARD SYSTEM DCA I RTWTPT /DON'T WAIT ON TTY FLAG IF BATCH IS RUNNING TAD I [JSBITS /IS BOS IN PLACE? AND DCBF SNA CLA JMP BATCH /NO. GO READ IT IN. JMP BCHGO /YES. START IT UP. RTWTPT, RUNTWT INTGO, 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" CCLADR, GETCCL M203, -203 DCBF, 400 /START PMSRST, SHNDLR&177+4200 /JMS SHNDLR 0300 7000 MTEMP+6 HLT CDF CIF 0 TCF /END MVCNT, MOVBUF-MVT3-1 PDBUF, MOVBUF
MVFROM, NOPUNCH *7626 ENPUNCH MOVBUF, 7777 /USED IN BATCH SETUP TAD I MVT1 /MOVE THE LINE BUFFER FROM 1000 DCA I MVT2 /TO 1655 ISZ MVT1 ISZ MVT2 ISZ MVT3 JMP .-5 CIF CDF 0 JMP I MOVBUF MVT1, BEGLN MVT2, SVLNBF MVT3, -112
*1112 ENPUNCH DIGTLP, TAD I LXR STRTX, TAD (-270 CLL TAD [10 DCA TMP1 /V3 SNL JMP EONUM /V3 ISZ DIGFLG JMS ROT JMS ROT JMS ROT TAD TEMP2 TAD TMP1 DCA TEMP2 JMP DIGTLP EONUM, TAD TEMP1 AND [7 CLL RTL RAL TAD KM6203 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
DEAS, TAD [UDNAME-1 DCA X1 TAD [-17 DCA TM1 CDF 10 DCA I X1 ISZ TM1 JMP .-2 KM6203, CDF CIF 0 JMP I [KEYMON ASDONE, CDF 10 /V3 DCA I TM1 /V3 JMP KM6203 /V3 CRLF, 0 TAD [215 DCA NM1 JMS I (PRNT TAD [212 JMS I PCH JMP I CRLF PAGE
/NOTE: XR=AMFLAG ! *1200 /TELETYPE INPUT ROUTINE XGLINE, KEYMON+1 /MUST BE AT 1200 FOR BATCH TAD [". JMS I PCH DCA RBFLAG TAD [BEGLN-1 CHLM1, DCA LXR DCA AMFLAG /ZERO ALTMODE FLAG 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 / -232;CTRLU /FOR HACK ONLY, REMOVE IF NEED ROOM -203;CTRLC /MUST BE JUST BEFORE 0 0 JMS PRNT CINSRT, TAD NM1 DCA I LXR TAD LXR TAD [-BEGLN-110 SPA CLA JMP CHLOOP CARRET, JMS I [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 ["\ JMS I PCH DCA RBFLAG TAD NM1 JMS I PCH JMP I PRNT CTRLC, CTRLU, TAD ["^ JMS I PCH TAD NM1 TAD [100 CLRLIN, JMS I PCH RBSPCL, JMS I [CRLF JMP XGLINE+1 ALTMOD, TAD ["$ DCA NM1 JMS PRNT ISZ AMFLAG /NOTE ALTMODE JMP CARRET+1 RUBOUT, TAD LXR TAD [1-BEGLN SNA CLA JMP RBSPCL TAD ["\ 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 CHLM1
SRCH, 0 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 I [CRLF DCA I LXR TAD [". JMS I PCH TAD [BEGLN-1 DCA XR TAD I XR SNA JMP LBCKUP JMS I PCH JMP .-4 PRQMRK, JMS I [PRNAME JMP I [PRINTQ IFNZRO PRQMRK-1357 <SEECCL,ZZXX> ZBLOCK 1 /A FREE LOCATION! IFNZRO .-1362 <FIXCCL,ERRRR> GETCCL, TAD [6003 JMS I [RESET TAD [67 /CCL OVERLAY BLOCK IS BLOCK 67 *** DCA OV JMP DATE2 DATE, TAD TMP SNA CLA JMP I [CCLSW-1 /USED TO BE JMP GETCCL DATE2, JMS I [SHNDLR /READ IN DATE OVERLAY 0201 0400 OV, MSOVL2 JMP KMONER JMP I [600 PAGE
*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 VALID CCB SAVE3A, 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 SAVE3A /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 0 /LENFGHT UNIMPORTANT 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 SMA /FULL FIELD SAVE IN F0 MAKES THIS + TAD [4000 /COMPENSATE FOR THAT CASE 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/ PROTAT, ROTAT
*1600 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 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
SVLNBF, KMER2, JMS I [PRNAME JMS I [PRMESG TEXT / NOT FOUND/ / /NEXT 112 LOCATIONS DESTROYED BY THE LINE BUFFER DURING A SAVE / 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 0 JMP I RESET KMER3, JMS I [PRMESG TEXT /NO!!/ RUN6, TAD I TM1 /STORE CONTROL WORD FOR LAST SEG. DCA I [MREAD+1 TAD RUNSW /IS THIS R OR RUN? SNA CLA JMS I [WRCTLB /RUN TAD I RFILE 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 ADCNT JMP .-3 JMP I .+1 /AND GO TO IT RUN8&177+7400 RFILE, FILE ADCNT, RUN8&177+7600
RUN8, ISZ I R7400 /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 RUNTWT, 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 RERR, CIF 10 JMS I RU7700 7 0 /TOTALLY MEANINGLESS RUNADR, CCB+4 R7400, 7400 RMRD3, MREAD+3 RU7700, 7700 RUNHND, 0 IFNZRO ROTAT-SVLNBF-112&4000 <ERROR> *1765 /MUST BE AT TOP OF PAGE ROTAT, 0 CLL RTR RTR RTR AND RU37 SNA TAD RU37 IAC CLL RAR JMP I ROTAT RU37, 37
/OVERLAY TO KEYBOARD MONITOR FOR "SAVE" WITH ARGUMENTS *2000 /GOES INTO 400 SAVE1A, TAD (1603 DCA X1 DCA TM1 CDF 10 DCA I [OLDT9 S6203, CIF CDF 0 TAD (SGETOUT-RSOVL2 /POINTER TO NEW GETOUT 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 SGTNUM 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 CLL CML TAD OLD1 SZA CLA /ARE THE FIELDS THE SAME? JMP KMER5 /NO - ERROR TAD TEMP2 AND [7600 TAD [200 DCA TEMP2 TAD TEMP2 CIA 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-RSOVL1 TAD (-", SNA JMP SNUMLP-1 TAD (",-"; SNA JMP SSTADR TAD (";-"= SNA CLA JMP I (SSBITS-RSOVL1 KMER5, JMS I [PRMESG TEXT /BAD ARGS/ 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 SGTNUM 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
SGTNUM, 0 /GET A NUMBER ROUTINE DCA DIGFLG /CLEAR DIGIT COLLECTED FLAG DCA TEMP1 DCA TEMP2 JMS I (STARTX-RSOVL1 JMP .+4 TAD (20 SNA CLA JMP .-4 JMS LXRBAK /SHOVE INDEX BACK TAD DIGFLG /IS DIGIT PRESENT? SZA CLA ISZ SGTNUM JMP I SGTNUM PAGE
*2200 /LOADS INTO 600 SSBITS, JMS I (SGTNUM-RSOVL1 JMP I (KMER5-RSOVL1 TAD TEMP2 CDF 10 DCA I (1603 JMP I (SDLOOK-RSOVL1 SVEND, JMS I [SHNDLR 0101 0400 MSOVL2 /READ IN SECOND PART OF OVERLAY JMP KMONER TAD TM1 SNA JMP I (MOVECB-RSOVL2 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-RSOVL2 /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-RSOVL2 /SORT COMPLETE - CHECK FOR CONSISTENCY
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
STARTX, 0 TAD I LXR /ANYTHING LEFT? SNA JMP I STARTX /NO.. TAKE EMPTY RETURN SKP ADGTLP, TAD I LXR TAD (-270 CLL /SEE IF THIS IS A DIGIT TAD [10 SNL JMP AONUM /NO.. GET OUT DCA TMP1 ISZ DIGFLG JMS ROT2 JMS ROT2 JMS ROT2 TAD TEMP2 TAD TMP1 DCA TEMP2 JMP ADGTLP /KEEP LOOKING AONUM, ISZ STARTX JMP I STARTX ROT2, 0 TAD TEMP2 CLL RAL /WE NEED THIS BECAUSE THE HANDLER DCA TEMP2 /WIPED THE FIRST COPY (MAYBE!!!) TAD TEMP1 RAL DCA TEMP1 JMP I ROT2 PAGE
*2400 /LOADS INTO 400 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 X1 CIA CLL TAD I LXR SNA CLA JMP BUTTNG /UPPER LIMIT(2)=LOWER LIMIT(1) - ABUTTING SEGMENTS SZL 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 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
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 PAGE
*2600 /DATE PROCESSOR - LOADS IN 400, RUNS IN 600 DATEXX,/SNA CLA / JMP CCL /CHAIN TO CCL 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 DCA DZRO /CLEAR ZERO SUPPRESSOR 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 TM1 /BAD DATE IF NOTHING BUT ZEROES SZA CLA ISZ DZRO 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 TAD DZRO /IF THIS IS STILL 0, GIVE ERROR SNA CLA JMP BADNUM 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 DZRO, 0 PAGE
*3000 /MONITOR ERROR PROCESSOR - LOADS INTO 11400 DLYLPX, AND I 0 D7600, 7600 TAD MERRNO CLL RAL ISZ I (ZERO ISZ I (ZERO ISZ I (ZERO JMP DLYLPX /WAIT FOR TELEPRINTER (WITHOUT CDF'S) SNA JMP USRERR CLL RAL RTL RTL TAD (6040 DCA I (MERTYP-1400 MERCMN, TAD (MERRXR-1400 JMS EPRINT 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 CLL RAL SNA JMP NOEXPL /NO EXPLANATION FOR USER ERRORS CLL RAR TAD (EXPLTBL-1401 /PRINT EXPLANATION DCA T1 /GET ADDRESS INTO MESSAGE TABLE TAD (240 JMS MERPCH TAD ("( JMS MERPCH TAD I T1 /GET ADDRESS OF MESSAGE JMS EPRINT TAD (") JMS MERPCH TAD MERRNO NOEXPL, 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 D7600 USRERR, CLA CLL JMS I (FGET TAD (4060 DCA I (UERTYP-1400 TAD (UERRXR-MERRXR JMP MERCMN MERPCH, 0 TLS TSF JMP .-1 CLA JMP I MERPCH ZERO, 0
EPRINT, 0 DCA T2 EPRLUP, TAD I T2 RTR RTR RTR JMS EPR TAD I T2 JMS EPR ISZ T2 JMP EPRLUP EPR, 0 AND (77 SNA JMP I EPRINT TAD (240 AND (77 TAD (240 JMS MERPCH JMP I EPR PAGE
*3200 /LOADS INTO 1600 MERRXR, TEXT \MONITOR ERROR 0 AT \ MERTYP=MERRXR+7 UERRXR, TEXT \USER ERROR 0 AT \ UERTYP=UERRXR+5 EXPLTBL,MON1-1400 MON2-1400 MON3-1400 MON4-1400 MON5-1400 MON6-1400 MON7-1400 MON1, TEXT \CLOSE ERROR\ MON2, TEXT \DIRECTORY I/O ERROR\
MON3, TEXT \DEVICE HANDLER NOT IN CORE\ MON4, TEXT \ILLEGAL USR CALL\ MON5, TEXT \I/O ERROR ON SYS:\ MON6, TEXT \DIRECTORY OVERFLOW\ MON7, TEXT \RESERVED\
/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 (7200 /TEST FOR SAVE FILE! CMA /TEST FOR VALID CCB AND (7740 SZA CLA JMP CHERR 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 JMP CHERR /CHAIN ERROR 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" CHERR, ISZ CHERR1 JMP CHERR /LET TTY DIE DOWN ISZ CHERR2 JMP CHERR CHTADC, TAD CHARS SNA JMP I (7600 /DONE..BACK TO MONITOR TLS TSF JMP .-1 CLA ISZ CHTADC /NEXT LETTER JMP CHTADC
CHERR1, 0 CHERR2, -6 CHARS, "C;"H;"A;"I;"N;" ;"E;"R;"R;215;212;0 PAGE
*4000 /SYSTEM GENERATOR - WRITES STUFF OUT USING SHNDLR WRITE=JMS I SYSHND JMS SYSSWP /SWAP SYSTEM DEVICE HANDLER INTO 7600 WRITE; 4200; 7400; 0; JMP BERR /BOOTSTRAP TAD RBFLAG SZA CLA JMP .+6 WRITE; 4210; DCOUNT; 01; JMP BERR /DIRECTORY WRITE; 5001; 0000; 07; JMP BERR /KEYBOARD MONITOR WRITE; 4610; 0000; MONTOR; JMP BERR /USR 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 SYTM1 TAD W7600 DCA SYTM2 SWAPLP, TAD I SYTM1 DCA TMSY TAD I SYTM2 DCA I SYTM1 TAD TMSY DCA I SYTM2 ISZ SYTM1 ISZ SYTM2 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 IFNZRO LDRCTL-4113 <BLDER,XQX> SYTM1, 0 SYTM2, 0 TMSY, 0 SYSHND, 7607 PAGE
*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 2/21/73 /******************************************************** / * 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-65 RESERVED FOR EXPANSION / 66 USED BY BATCH / 67 USED BY CCL / 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 OPTIMIZATION /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 400 - DOESN'T DESTROY BATCH MONITOR /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 7000 (HANDLER) MUST BE READ OVER JMS SHNDLR 0300 7000 MTEMP+6 HLT MSTCDF, CDF CIF 0 TCF /EXIT WITH A CLEAR CONSCIENCE(ALSO A CLEAR FLAG) JMP I .+1 MSTADR, 0 SBLOCK, 0 BIPCCL, 0 /MORE STATUS BITS. /BIT 1: 1=> BATCH IS IN PROGRESS /BITS 6-8: FIELD OF BATCH MONITOR /HIGHEST CORE FIELD USED BY OS/8 /OR 0 TO MEAN OS/8 MAY USE ALL OF CORE
*0 VERSNO /OS/8 VERSION 3 KMONER, CLA TAD [7605 DCA ERRET JMS I [PRMESG TEXT /SYSTEM ERR/ /THE FOLLOWING REGISTERS ARE SET TO VITAL INITIAL VALUES. TO ALTER /THESE VALUES IS TO BRING DISASTER DOWN UPON YOUR HEAD! LXR, PMSRST-1 X1, MSWITC /THESE TWO ARE USED AT INITIALIZATION. ADR1, RUN8-1 ADR2, RUN8&177+7377 /USED DURING R, AND RUN COMMANDS XR, AMFLAG, 0 /1 MEANS SAW ALTMODE /MUST NOT MOVE FOR CCL AND BATCH *20 RBFLAG, 0 /MUST BE AT LOCATION 20 TEMP2, -7 SYSTEM, 7700 PCH, PRINT GLINE, XGLINE GNAME, GETNAM DEVHND, 7607 FUDJMP, MSTCDF&177+5200 P6203, 6203 TMP, PATCHLEV /MONITOR PATCH LEVEL MUST BE AT LOC 31 FOR CCL PGTOUT, GETOUT ERRET, PCRLF /MUST BE AT 33 FOR CCL /THE FOLLOWING LOCS. ARE TEMPORARIES. HOWEVER, THERE IS NOW /VITAL ONCE ONLY CODE TO HELP THE BATCH PROCESSOR. THIS CODE IS /READ IN EVERY TIME THE KEYBOARD MONITOR IS RE-READ. NM1, 203 /THIS MUST BE A 203! BATCH, /ENTRY TO READ NEW BATCH MONITOR NM2, JMS I [7607 /THE BATCH INITIALIZER ALTERS SOME VALUES NM3, 610 /IN THIS LIST...THIS ONE********** NM4, 0 /THIS ONE*****GETS ADDRESS OF BOS. TEMP1, 13 /******GETS RECORD OF BOS***** TM1, SKP CLA /ERROR. DON'T RUN BATCH TMP1, JMP BCHGO NMCT, DCA I KM1 /CLEAR BATCH FLAG. PN, JMP KMONER PRDSW, KM1, 7777 BCHGO, RUNSW, CIF CDF 0 DIGFLG, JMP I .+1 SENTER, KMINIT /GETS ENTRY POINT (BOS)
FIELD 1
/FIELD 1 /OS/8 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 /BRANCH TO APPROPRIATE ROUTINE WITH LINK ON FGET, 0 /MUST PRESERVE LINK TAD MONITO JMS FGETW JMP I FGET /MONITOR COMMAND DISPATCH TABLE MUST BE JAMMED BEFORE 'FPUT' MERROR 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 STL /LINK MUST BE ON AT MRESET 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 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 /MUST PRESERVE LINK 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 MRTRN2, 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 CML CMA RAL SZL SPA JMP JMPME2 CMA CML RAR /NEW V3 DIRECTORY VERIFYER 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 JMPME2, JMP I [MERROR+2 /CANNOT REWRITE CATALOG JMP I MWRCAT IFNZRO .-772 <REASSEMBLE CONFIG> /USED TO BE 766 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 [MRTRN2 /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
/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 SNA CLA JMP .+3 JMS CONSOL 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 SKP CRETRN, TAD [7600 /DO A WRITE OF 0 PAGES. (MAGTAPE) JMS I [MWRCAT ISZ I [MONITO JMP I [MRTRN2
/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 NOP /V3 RL INSISTS JMP CONSOL+1 /REPEAT ENTIRE CONSOLIDATION - THIS DELETION MAY /HAVE BROUGHT TWO FREE ENTRIES TOGEHER / THE ABOVE NOP FIXES THE KILLER CLOSE BUG CONLPT, ISZ T7 JMP CONLP /MORE FILES - KEEP PLUGGING JMP I CONSOL /RETURN FROM CONSOLIDATOR CONMTF, TAD I XR /IS THIS FREE ENTRY NULL? SNA JMP SQTRIV /YES - SQUASHITLIKEABUG DCA T2 /NO - SAVE LENGTH TAD XR DCA SQUISH /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 SQUISH /STORE BACK IN FIRST LENGTH WORD AND SQUISH SECOND ENTRY SQTRIV, CLA CMA CLL RAL JMP SQCOMN /SQUISH OUT 2 WORDS
MRESET, TAD [-17 DCA T3 MRSETL, TAD T3 JMS I [MCKDEV /LINK MUST BE ON AT THIS POINT TAD [200 SZL CLA /ZERO ALL DEVICE HANDLER SLOTS THAT AREN'T RESIDENT DCA I T1 JMS I [FGET SZA CLA TAD [7 CMA STL AND I T8 DCA I T8 /DELETE THE "FILE CURRENTLY OPEN" FLAG IF ASKED ISZ T3 JMP MRSETL JMP I [MNEXT /SUBR TO COLLAPSE DIRECTORY AFTER A POINT 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
*1400 /INITIAL DIRECTORY FOR MONITOR /DEFINES OS/8 ABSOLUTE LOADER (ABSLDR.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 0574 /ENCODING FOR JAN 15, 1974 -5 /FIVE BLOCKS LONG( 1 BLOCK = 256 WORDS) 0 /EMPTY SPACE -1 /OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH IFNZRO .-1415 <CNFER,QQQ>
*3400 /"ENTER" OVERLAY TO USR - RUNS IN 11000 JMP .+3 MSEGLM, -7 /# DIRECT. SEGS NEWLEN, -10 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 MELP3, TAD XR DCA METMP1 TAD XR TAD MEFCNT DCA METMP2 /PREPARE TO PUSH ALL ENTRIES UP TAD I METMP1 DCA I METMP2 /DO THE PUSHING STA TAD XR DCA XR TAD XR 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
MWRONG, IAC MELAST, TAD NEWLEN DCA METMP1 /LENGTH OF NEW SEGMENT TAD METMP1 CIA TAD I [DCOUNT SMA /WERE THERE "NEWLEN+1" JMP MWRONG /NO - SET OUR SIGHTS LOWER 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 MSEGLM 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 PAGE
/ABSOLUTE LOADER FOR OS/8 - VERSION 3( 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 LSTFLD=35 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 TAD [200 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 PAGE
*2200 PUTWD, 0 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 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 DCA BUFREC /BAD I/O ON SYSTEM DEVICE JMP I WRBUF CORTAB, ZBLOCK 30
ORGX, 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 PAGE
*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 DCA I (LOADWD /ZERO 'DATA LOADED' FLAG V3 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 PAGE
*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 TAD [-20 SMA CLA /IGNORE 07600 AND 17600 IN CCB /V3 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+1 /CLOBBER BATCH? AND [400 TAD I (MPARAM+2 /AH ED, BUG IF YOU SPEC /P/1 TO LOADER AND (403 TAD I (CTLBLK+3 DCA I (CTLBLK+3 TAD LSTFLD AND [7 CLL RTL RAL TAD [CDF CIF 0 DCA I (CTLBLK+1 SKP ORG200, TAD [200 TAD LSTADR SZA /V3 JMP NOORG /V3 ALLOW EXPLICIT START ADDR TO OVERRIDE DEFAULT TAD I (LOADWD /V3 NO EXPLICIT START ADDR CLA /REPLACE BY 'SZA CLA' TO ALLOW SELF-STARTING STUFF /* SZA CLA /V3 IS IT SELF STARTING BIN FORMAT? JMP ORG200 /V3 NO TAD XFIELD /V3 YES TAD [CIF CDF 0 /V3 DCA I (CTLBLK+1 /V3 TAD I (ORIGIN /V3 NOORG, DCA I (CTLBLK+2 JMP I (LGTOUT /WRITE CONTROL BLOCK AND EXIT FIELDB, 0
UPPERA, SETADR, 0 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 LOWERA, 0 LSTADR, 0 PAGE
*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 CODE /******************************************** 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 /ABOVE COMMENT DOESN'T APPLY TO NEXT 9 LINES 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 PAGE
*3200 ERPCH, 0 AND (77 /GET LOW ORDER 6 BITS SZA JMP NZCHAR JMS ERR FILMSG, TEXT /, FILE 0/ NZCHAR, TAD (240 AND (77 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, ONCE /CAN'T USE PAGE 0 LITERALS 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 ERTRN, 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 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 DCA LSTFLD DCA I (LSTADR /V3 SET INITIAL STARTING ADDRESS TO 0 DCA I (OVLYFG DCA PG7400 CALONC, JMS I ERR /CALL ONCE-ONLY CODE ISZ CTINIT JMP I CTINIT PAGE
*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
ONCE, 0 /ONCE-ONLY CODE TO CHECK FOR CORRECT MONITOR DCA I (CALONC /DON'T CALL AGAIN TAD [400 TAD (-400 SZA CLA JMP OLDMON TAD [7 TAD (-7 SNA CLA JMP I ONCE /THEY AGREE OLDMON, TAD (ERR&177+5600 DCA I (ERTRN JMS I (ERR /THEY DON'T TEXT /INCOMPATIBLE/ /MUST BE AN EVEN # OF CHARS LONG CIF CDF 0 JMP I (7605 PAGE
/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