--- /dev/null
+/12 OS8 MONITOR SYSTEM OS8 VERS. 3D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975,1977 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/13-APRIL-1977 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="Q
+
+/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
+
+/FIXES FOR MAINTENANCE RELEASE:
+
+/1. CHANGED VERSION NUMBER OF MONITOR TO V3M
+/2. INCORPORATED PATCH RE LOC 13121 AFTER MONITOR ERROR
+/ [SEQ #1, DSN APRIL 1975]
+/3. ALLOW CHAIN TO WORK ON FULL FIELD SAVES
+/ [SEQ #2, DSN JUNE 1975]
+/4. ALLOW ABSLDR/I TO WORK ON FULL FIELD CORE IMAGES
+/ [SEQ #1, DSN OCTOBER 1975]
+/5. ADDED INTERNAL VERSION NUMBER TO ABSLDR AT LOCATION 2200
+/ MAINT. RELEASE VERSION # IS V4
+/6. SET INITIAL ABSLDR DATE TO 1-NOVEMBER-1975
+
+/V3D AND OS/78 CHANGES:
+
+/1. ACCEPT DEC STANDARD DATE FORMAT FOR INPUT (DD-MMM-YY)
+/2. CHANGED VERSION NUMBER TO V3Q
+/3. ADDED DATE/78 CHANGES
+/4. FIXED BUG ABOUT WAITING FOR TTY FLAG & BATCH
+/5. ADDED STUFF FOR LINKER [USES SOFSET]
+/6. CHANGED ABSLDR DATE TO 1-JUNE-77
+/7. DISALLOW RUN OF PROGRAM WITH BIT 4 OF JSW ON [OS/78 ONLY]
+/8. ASSIGNED RESIDENT BITS FOR SCOPE AND OS/78
+/9. ALLOW @ IN KBM COMMAND
+/10. COULD RUN INIT.CM ON SYSTEM START-UP
+/11. CHANGED BAD CORE IMAGE MSG TO CORE IMAGE ERR
+/12. CHANGED ABSLDR/I SO THAT IT SETS UP JSW AND SA
+\f /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
+\fPRNAME, 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
+\fPRINTQ, 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
+\f *400
+KMNTRY, JMP I HANDAD /V3
+ 0 /FREE LOCATION !
+PCRLF, JMS I [CRLF
+ IFNZRO .-403 <BTCHER,XXXX>
+
+KEYMON, JMS I GLINE
+ TAD [BEGLN-1 /ADDRESS REFERENCED BY INIT
+ DCA LXR
+ JMS I GNAME
+/V3D JMP I [PRINTQ
+ XXX=[PRINTQ /NEED LITERAL IN SAME PLACE
+ NOP /V3D ALLOW @ IN NAME
+ 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
+\fR, 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
+\fGET, 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
+\f *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)
+\f *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
+\fMINCOR, 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+3 /V3D
+ RAL /V3D
+ JMS I KRCHK /V3D CAN'T RUN SYSTEM CUSP UNDER OS78
+ 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
+\fRUN2, 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
+\f/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/
+\f *1000
+/MUST BE AT 1000 FOR BATCH
+BEGLN, 0 /LINE BUFFER COULD BECOME "@
+ "I
+ "N
+ "I
+ "T
+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.
+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
+ JMP CLR /V3D
+/CCLADR, GETCCL /V3D DIDN'T SEEM TO BE USED
+RTWTPT, RUNTWT
+DCBF, 400
+/START
+PMSRST, SHNDLR&177+4200 /JMS SHNDLR
+ 0300
+ 7000
+ MTEMP+6
+ HLT /CONTAINS SECOND COPY OF OS/78 BIT
+ CDF CIF 0
+ TCF
+/END
+MVCNT, MOVBUF-MVT3-1
+PDBUF, MOVBUF
+\fMVFROM, 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
+
+
+ *1077 /V3D
+INIT, CDF 10 /V3D (INITIALIZATION)
+ TAD DCBF
+ DCA I ROT /RESTORE LOC 7677 TO '400'
+ CDF 0
+ DCA KMINIT /END LINE WITH 0
+ TLS
+ JMP I CRLF /FAKE OUT KBM AS IF USER TYPED @INIT
+
+
+CLR, KCC
+ JMP I .+1
+ CTRLC
+\f *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, 7677 /V3D NEEDED FOR INIT
+ TAD TEMP2
+ CLL RAL
+ DCA TEMP2
+ TAD TEMP1
+ RAL
+ DCA TEMP1
+ JMP I ROT
+\fDEAS, 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, KEYMON+1 /V3D NEEDED FOR INIT
+ TAD [215
+ DCA NM1
+ JMS I (PRNT
+ TAD [212
+ JMS I PCH
+ JMP I CRLF
+
+M203, -203
+ PAGE
+\f/NOTE: XR=AMFLAG !
+
+ *1200
+ /TELETYPE INPUT ROUTINE
+XGLINE, KEYMON+1 /MUST BE AT 1200 FOR BATCH & CCL
+ 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 /THIS AREA GETS MODIFIED BY SET
+ -376;ALTMOD
+ -233;ALTMOD
+ -212;LFEED
+ -200;CHLOOP
+ -217;CHLOOP /IGNORE ^O
+ -203;CTRLC /MUST BE JUST BEFORE 0
+ /MUST BE HERE FOR CCL
+ 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
+\f/THIS PAGE GETS MODIFIED BY SET COMMANDS (FOR REAL SCOPE RUBOUTS)
+/**** BEWARE! ***
+
+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 ["\ /MUST BE HERE
+ 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
+\fSRCH, 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
+\f *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 /LENGHT 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
+\fSAVE5, 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 ***
+
+\fLOADF0, 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
+\f *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
+CIERR, TAD [7605
+ DCA ERRET /RELOAD MONITOR ON THIS ERROR
+ JMS I [PRMESG /IT WASN'T - TELL THE USER
+ TEXT /CORE IMAGE ERR/
+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
+\fSVLNBF,
+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
+/V3D CDF 0 /THIS INSTRUCTION SEEMS UNNECESSARY
+ JMP I RESET
+
+RCHK, 0
+ AND I RADR /V3D
+ AND [200 /CAN'T ALLOW BOTH OS78 BIT AND SYSTEM CUSP BIT
+ SNA CLA
+ JMP I RCHK
+ JMP CIERR /V3D CAN'T FALL INTO KMER3
+ /BECAUSE HAVE TO RELOAD KBM TO RESET 'PGNAME'
+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 /V3D FOR LINKER
+ DCA I RCTL /V3D SAVE BLOCK NUMBER IN 'SOFSET'
+ 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
+\fRUN8, 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, SOFSET /V3D THESE ARE STORED INTO ONLY AFTER MOVING
+RADR, OS78 /V3D
+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
+\f /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
+\fSDLOOK, 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
+
+\fSGTNUM, 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
+\f *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
+\fTIE, 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
+
+\fSTARTX, 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
+\f *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
+\fMERGED, 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
+
+\fSGETOUT,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
+DECIMB, JMP I SGETOUT /DECIMB ONLY CALLED BY NEXT PAGE
+ /PART OF NEXT PAGE'S ROUTINE:
+ TAD NM2 /ALL NEW FOR V3D
+ TAD NM4 /ONLY ALLOW 2 CHARS FOR MM
+ SNA CLA
+ ISZ DECIMB
+ TAD NM1
+ RTR
+ RTR
+ JMP I DECIMB
+ PAGE
+\f *2600 /DATE PROCESSOR - LOADS IN 400, RUNS IN 600
+DATEXX, JMS DECIM
+NUM2, DCA NUM2
+ TAD NUM2
+ TAD M40
+ SMA CLA
+ JMP BADNUM /DAY > 31
+ JMS I GNAME
+L30, 30 /NOTHING FOUND WILL GIVE ERROR LATER
+/ DCA NUM1 /NUM1 IS INITIALLY 0
+NEWLUP, ISZ MONPTR
+ ISZ NUM1
+ TAD I MONPTR
+ ISZ MONPTR
+ SMA
+ JMP BADNUM /SYMBOLIC MONTH NOT FOUND
+ TAD NM1
+ SNA CLA /SKIP IF FIRST 2 LETTERS DON'T MATCH
+ TAD NM2
+ TAD I MONPTR
+ SZA CLA
+ JMP NEWLUP /SECOND 2 LETTERS DON'T MATCH
+/*** TEST DELIMETER HERE
+ TAD NUM1
+ CLL RTL
+ RTL
+ RAL
+ TAD NUM2
+ RTL
+ RAL
+ DCA NUM2
+ DCA DDELIM /MAKE END-OF-LINE THE DELIMITER
+ JMS DECIM
+ TAD (-106 /SCALE DOWN TO RANGE 1970-1999
+ SPA
+ JMP BADNUM /DIDN'T MAKE THE RANGE
+ DCA NUM1
+ TAD NUM1
+ AND L30 /ISOLATE EXTENSION DATE BITS
+ CLL RTL
+ RTL
+ DCA TM1
+ TAD I (BIPCCL
+ AND L7177 /STORE THEM INTO BITS RESERVED FOR THIS PURPOSE
+ TAD TM1
+TSLUP, DCA I (BIPCCL
+ TAD NUM1
+ AND [7
+ TAD NUM2 /COMBINE WITH MONTH AND DAY
+ CDF 10
+ DCA I (MDATE /STORE IN SYSTEM DATE CELL
+ TSF /7605 SETS THE DF
+ JMS L7177 /TIME OUT A BIT
+ JMP I [7605 /IN CASE RUNNING UNDER BATCH
+L7177, 7177 /JMS IS LONGER THAN JMP
+ ISZ DDELIM /DDELIM IS 0 AT END
+ JMS TSLUP /WAIT FOR TELETYPE TO DIE DOWN (RF08)
+ JMP I [7605 /RETURN TO MONITOR
+\fDDELIM, -"-
+
+/WOULD LIKE TO BRANCH TO CCLSW-1 IF DATE ENDED WITH ALTMODE
+
+CNV, 0
+ AND [77
+ SNA
+ JMP NUL
+ TAD (-60
+ SPA
+ JMP BADNUM
+ JMP I CNV
+NUL, TAD TM1
+ JMP GODE
+
+DECIM, 0
+ JMS I GNAME
+M40, -40 /NOTHING THERE (LOGIC WILL CAUSE ERROR LATER)
+ TAD TMP
+ TAD DDELIM /COMPARE AGAINST DESIRED DELIMETER
+ SNA CLA /DASH OR NULL
+ JMS I (DECIMB-2400+400
+ JMP BADNUM /DELIMETER BAD
+ RTR
+ JMS CNV
+ DCA TM1
+ TAD TM1
+ CLL RTL
+ TAD TM1
+ RAL
+ DCA TEMP2
+ TAD NM1
+ JMS CNV
+ TAD TEMP2
+GODE, SZA
+ JMP I DECIM
+BADNUM, CLA /CRAP IN AC
+ TAD [7605
+ DCA ERRET
+ JMS I [PRMESG
+ TEXT /BAD DATE/
+NUM1, 0 /MONTH NUMBER (MUST BE 0 INITIALLY)
+\fMONS, -1201 /JAN
+ -1600
+ -0605 /FEB
+ -0200
+ -1501 /MAR
+ -2200
+ -0120 /APR
+ -2200
+ -1501 /MAY
+ -3100
+ -1225 /JUN
+ -1600
+ -1225 /JUL
+ -1400
+ -0125 /AUG
+ -0700
+ -2305 /SEP
+ -2000
+ -1703 /OCT
+ -2400
+ -1617 /NOV
+ -2600
+ -0405 /DEC
+ -0300
+MONPTR, MONS-2600+600-1 /RELOCATES TO PAGE 600
+ /MUST BE POSITIVE
+
+ PAGE
+\f *3000 /MONITOR ERROR PROCESSOR - LOADS INTO 11400
+DLYLPX, AND I 0
+D7600, 7600
+ TAD MERRNO
+ CLL RAL
+ ISZ I (ZERO-1400
+ ISZ I (ZERO-1400 /V3C
+ ISZ I (ZERO-1400
+ 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
+\fEPRINT, 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
+\f *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\
+\fMON3, 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\
+\f /EXECUTION TIME LOADER FOR MONITOR "CHAIN" COMMAND
+ *3400 /EXECUTES IN FIELD 0 IN PAGE 7400
+MCHNX, DCA MCHREC /STORE STARTING RECORD #
+ TAD MCHREC
+ DCA I (SOFSET /V3D SAVE STARTING ADDRESS
+ 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
+\fMCHRD, 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
+ SNA /V3C
+ TAD (40 /0 MEANS FULL 4K READ
+ 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
+\fCHERR1, 0
+CHERR2, -6
+CHARS, "C;"H;"A;"I;"N;" ;"E;"R;"R;215;212;0
+ PAGE
+\f *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
+\f *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 /V3D GETS CHANGED TO INIT
+\fMCALL1, 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
+SCOPE, HLT /BIT 4 IS A 1 IF CONSOLE IS A SCOPE
+ 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
+\fMARG1, 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
+\fDCB, 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 RESERVED FOR EXPANSION
+ /65 CCL REMINISCENSES
+ / 66 USED BY TWO-PAGE SYS HANDLER
+ / 67 USED BY CCL (CCL OVERLAY)
+ / 70-END FILE STORAGE
+\f 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
+\f *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 /THIS AREA MODIFIED BY ODT
+ MTEMP+6
+OS78, HLT /BIT 4 IS A 1 IF OS/78 IS RUNNING
+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
+\f *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)
+KRCHK, RCHK
+\f FIELD 1
+\f /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
+\fMCD, 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
+\fCDSWAP, 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
+\f *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
+\fGETREC, 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"
+\f 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
+\f 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"
+\fMEMPTY, 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
+\f /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
+\f /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
+\fMRESET, 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
+\f *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
+ 3017 /V3D ENCODING FOR 1-JUN-77
+ -5 /FIVE BLOCKS LONG( 1 BLOCK = 256 WORDS)
+ 0 /EMPTY SPACE
+ -1 /OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH
+
+ IFNZRO .-1415 <CNFER,QQQ>
+\f *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
+\fMWRONG, 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
+\fMEOCNT, 0
+MEFCNT, 0
+METMP1, 0
+METMP2, 0
+MNOFIL, 0
+ MEOVLS=1200 /DESTROYS PART OF "CLOSE" OP FOR BUFFER
+ PAGE
+\f EJECT ABSLDR
+ /ABSOLUTE LOADER FOR OS/8 - VERSION 4A
+ *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
+\fGETCH, 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
+\fJMPGET, 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
+\f *2200
+PUTWD, 6402 /ABSLDR VERSION NUMBER
+ 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
+\fFLD1, 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
+M7, -7
+ 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, CALONC
+ 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
+\fORGX,
+NEXFIL, ERTRN
+ 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
+
+CORTAB, ZBLOCK 30 /ONCE-ONLY CODE INSERTED HERE KATER
+ ZBLOCK 2 /EXTRA NEEDED BY ONCE-ONLY CODE
+ /NOT USED BY CORE TABLE
+ PAGE
+\f *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
+\fDATAWD, JMS I (LOADWD
+ ISZ ORIGIN
+L40, 40
+GETNXT, TAD WD1
+ TAD WD2
+ TAD LCKSUM
+ DCA LCKSUM
+ TAD WD
+ JMP NEWWD
+\fASSEMB, 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 /V3C
+ 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
+\fGETFLD, 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
+\f *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
+\fFLDOVR, 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
+\fUPPERA,
+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
+\f *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
+\fLNOGO, 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
+\fLOADWD, 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
+\f *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
+\fERR, 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/
+\fLIOERR, JMS ERR
+ TEXT /SYSTEM I-O ERROR/
+OERR, JMS ERR
+ TEXT %NO /I!%
+
+CTINIT, 0
+CALONC, JMS I ERR /CALL ONCE-ONLY CODE
+ 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
+ ISZ CTINIT
+ JMP I CTINIT
+ PAGE
+\f
+*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 L7740
+ SZA CLA
+ JMP I (BADINP /NOT CORE IMAGE
+ TAD I CCBPTR
+ DCA SEGCNT
+ TAD I SGSTAD /THIS CODE IS NEW FOR V3D
+/ AND [70 /GET FIELD
+ CLL RTR
+ RAR
+ DCA I (LSTFLD
+ ISZ SGSTAD
+ TAD I SGSTAD
+ DCA I (LSTADR
+ ISZ SGSTAD
+ TAD I SGSTAD /GET JSW FROM SAVE FILE
+ AND [400
+ DCA TEMP /PRESERVE /P
+ TAD I [MPARAM+1
+ AND (7377
+ TAD TEMP
+ DCA I [MPARAM+1
+ TAD I SGSTAD
+ AND (3 /PRESERVE LAST 2 BITS
+ DCA TEMP
+ TAD I (MPARAM+2
+ AND [7774
+ TAD TEMP
+ DCA I (MPARAM+2
+ ISZ SGSTAD
+NEWSEG, TAD I SGSTAD /SEGMENT START ADDRESS
+ DCA ORIGIN
+ TAD I SGFDLT /FIELD AND LENGTH
+ AND L77
+ DCA XFIELD
+ TAD I SGFDLT
+ AND [7700
+ SNA /V3C
+ STL CLA RAR /AC4000
+ DCA SEGLTH
+ TAD SEGLTH
+TWOPG, 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
+ 1400 /INTO 11400
+TEMP,
+DATRC, 0
+ JMP I (IOERR /DATA FAILURE
+ CLA CMA
+ TAD ORIGIN
+ AND [177
+ TAD (1200 /SET UP INPUT POINTER
+ CHARPT=10
+ DCA CHARPT
+LOOPI, TAD I CHARPT
+ JMS I (LOADWD /MOST OF THE WORK
+ ISZ ORIGIN
+L7400, 7400 /NOP
+ ISZ WDCT /FINISHED THIS BLOCK?
+ JMP LOOPI
+ JMS I (WRBUF /YES.. WRITE THE STUFF OUT
+ DCA I (BUFREC /SO THAT WRBUF DOESN'T SCREW US UP
+ TAD SEGLTH /V3C (REARRANGED)
+ SMA SZA /ALL PAGES DONE?
+ JMP TWOPG /NO, NEXT! (IF DONE, FALL INTO 'GTSEG')
+ ISZ SEGCNT /YES, 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+1 /SEGMENT START ADDRESS
+
+L7740,
+RENEW, 7740 /USED TO CLEAR AC
+L77, 77 /MIGHT OR MIGHT NOT SKIP
+ TAD (CTLBLK+1
+ DCA SGSTAD
+ TAD (CTLBLK+5
+ DCA SGFDLT
+ JMP I (NEWFIL
+ PAGE
+\f *CORTAB /ONCE-ONLY CODE
+
+ONCE, 0 /ONCE-ONLY CODE TO CHECK FOR CORRECT MONITOR
+ DCA I WRBUF /DON'T CALL AGAIN
+ TAD [400
+ TAD K7400
+ SZA CLA
+ JMP OLDMON
+ TAD [7
+ TAD M7
+ SNA CLA
+ JMP I ONCE /THEY AGREE
+OLDMON, TAD KERR
+ DCA I NEXFIL
+ JMS I PERR /THEY DON'T
+ TEXT /INCOMPATIBLE/ /MUST BE AN EVEN # OF CHARS LONG
+ CIF CDF 0
+ JMP I K7605
+K7400, 7400
+PERR, ERR
+K7605, 7605
+KERR, ERR&177+5600
+\f /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
+\f *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
+\f $
+\f
projects / pdp8.git / blobdiff