File: OS8.PA of Tape: OS8/OS8-V3D/al-4697c-sa-os8-v3d-7
(Source file text)
/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.
/
/
/
/
/
/
/
/
/
/
/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
/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 /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
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+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
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 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
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
*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
*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
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, KEYMON+1 /V3D NEEDED FOR INIT
TAD [215
DCA NM1
JMS I (PRNT
TAD [212
JMS I PCH
JMP I CRLF
M203, -203
PAGE
/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
/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
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 /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
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
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
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
/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
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, 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
/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
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
*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
DDELIM, -"-
/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)
MONS, -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
*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
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 #
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
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
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
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 /V3D GETS CHANGED TO INIT
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
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
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 RESERVED FOR EXPANSION
/65 CCL REMINISCENSES
/ 66 USED BY TWO-PAGE SYS HANDLER
/ 67 USED BY CCL (CCL OVERLAY)
/ 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 /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
*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
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
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>
*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
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
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, 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
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
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
ORGX,
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
*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 /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
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
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
*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
*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
/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
$