File: OS840.PA of Tape: Original/Originals/os840-1
(Source file text)
/OS8 MONITOR SYSTEM VERS. 40
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
/ AND 1979 BY DATAPLAN GMBH
/
/
/
/
/
/
/
/
/
/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
/10-MAY-1979 WVDM VERSION
/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
MRESER=64 /EXTENDED MEMORY OVERLAY
CCLREC=67 /CCL EXTENSION BLOCK
MFREE=70 /BEGINNING OF FILE STORAGE
CCB=7400
CSOVLY=400
CCOVLY=1400
LXM=6200 /EXTENDED MEMORY LOAD INSTRUCTION
VERSNO=4
PATCHLEV="0
GERMAN=1 /ENABLE GERMAN MESSAGES
/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
/V3F CHANGES:
/1. ADDED MONITOR SUPPORT FOR KT8A
/ A. R,RUN, GET COMMANDS NOW LOAD 128K
/ B. SAVE COMMAND CAN SAVE UP TO 128K
/2. ADDED HIGROUND SUPPORT
/3. ABSLDR ALSO UPDATED TO SUPPORT 128K
/V40:
/ ABSLDR SHOULD WORK NOW
/ WHY NOT USE BSW?
/ KILL OS78
/ GIVE GERMAN ERROR MESSAGES
/KEYBOARD MONITOR FOR OS/8 SYSTEM - UNCOMMENTED AT PRESENT
FIELD 0
MTHREE=CLA CLL CMA RTL
*200
PRINT, JMP I HNDL /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 /ROUTINE TO ACESS TTY INPUT
DCA NM1 /FIRST OFF,INITIALIZE
DCA NM2 /SET UP SYMBOLS FOR STORING NAME
DCA NM3
DCA NM4
TAD TNM1
DCA PN
CLA CMA
DCA PRDSW
GTNMX, DCA NMCT
TAD I LXR /LOCATE FIRST CHARACTER
TAD M240 /IS IT A SPACE?
SNA /IF SO TEST NEXT CHARACTER
JMP .-3
TAD [240 /WE'VE GOT FIRST CHARACTER
SKP
GTNMLP, TAD I LXR /GET ANOTHER CHARACTER
TAD M340 /CONVERT LC TO UC
SMA
TAD [-40
TAD LDBLK /*K*=340
DCA TMP
TAD TMP
TAD M256 /IS IT A PERIOD?
SNA
JMP PERIOD /IF SO, PROCESS IT
TAD [-2
CLL
TAD M12
SNL CLA /IS IT GT ASCII CHARACTER (#9)?
JMP NINSRT /IF NO, INSERT IN NAME
TAD M301
TAD TMP
CLL CML
TAD [-32
SNL CLA /IS IT GT ASCII(Z),IF SO
JMP EONAME /END OF NAME
NINSRT, TAD NMCT /CHECK FOR MAXIMUM CHARS
TAD [-6
SMA CLA
JMP GTNMLP /IF MAXIMUM SAVE NO MORE
TAD NMCT /SET UP POINTER TO STORE CHARACTER
CLL RAR
TAD PN
DCA TEMP1 /HERE IS POINTER TO NM1,NM2,ETC.
TAD TMP
AND [77 /ISOLATE SIX BITS FOR STORAGE
SNL
BSW
TAD I TEMP1 /OR IT IN AND STORE
DCA I TEMP1
ISZ NMCT
JMP GTNMLP
PERIOD, ISZ PRDSW
JMP EONAME
ISZ PN
TAD N4
JMP GTNMX
EONAME, TAD NMCT
SZA CLA
ISZ GETNAM
JMP I GETNAM
HNDL, 4000 /ROUTINE TO RELOAD NON-SYS HANDLER FOR SAVE ROUTINE
JMS I [SHNDLR
0200 /READ TWO PAGES
1000 /INTO 1000
LDBLK, 340 /SET UP BY SAVE ROUTINE
JMP KMONER
JMP I HNDL
KMER3, JMS I [PRMESG
IFDEF GERMAN < TEXT /NEIN/>
IFNDEF GERMAN < TEXT /NO!!/>
N4, 4
TNM1, NM1
M240, -240
PRINLP, JMS PRWD
ISZ PRMESG
SKP
IFNZRO .-330 <CCLTRB,ERRR>
PRMESG, 0 /ERROR MESSAGE PRINTING ROUTINE
CLA
TAD I PRMESG
M340, SZA
JMP PRINLP
TSF
JMP .-1
JMP I ERRET /RETURN TO MONITOR
PRWD, 0
DCA TMP
TAD TMP
BSW
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
M12, -12
M256, -256
M301, -301
PRINTQ, JMS PRMESG
TEXT /?/
0
SAVE12, JMS I [SHNDLR /RELOAD AND RETURN TO MONITOR FROM SAVE
0610
0
MONTOR
JMP KMONER
CLL CLA CMA
CDF 10
DCA I [7700
JMP I [7605
PAGE
KMNTRY, JMP I GDEVNO
BFDIFF, SVLNBF-BEGLN
PCRLF, JMS I [CRLF
IFNZRO .-403 <BTCHER,______>
KEYMON, JMS I GLINE
TAD [BEGLN-1 /ADDRESS REFERENCED BY INIT
DCA LXR
JMS I GNAME
K12, 12 /V3D ALLOW @ IN NAME
JMS I [SRCH
-123; ASSIGN
-2301; SAVE
-2225; RUN
-705; GET
-2200; R
-2324; START
-1704; ODT
-0405; DEAS /GETS 7777 FROM CCL
IFNZRO .-431 <SEECCL,______>
-0401; DATE
0
JMP I CCLSW
IFNZRO .-435 <SEECCL,______>
CCLSW, PRQMRK /MODIFIED FOR CCL TO 'GETCCL'
ASSIGN, TAD K12
JMS GDEVNO
TAD [UDNAME-1
DCA TM1
JMS I GNAME
XKMER1, KMER1 /NO USER DEV. DO A DEASSIGN *FALL THRU*
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, KMINIT
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, 7001 /OR 1001
JMP I XKMER1
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 BFDIFF
DCA LXR
TAD K1001
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
/LOADS SYSTEM ODT OVER THE MONITOR
ODT, JMS I PGTOUT
JMS I [SHNDLR
K1001, 1001
0
ODTREC
IFNZRO .-600 <SEEODT,_____>
/LOCATION 600 IN ODT IS A HLT (ERROR RETURN)
RELOC CSOVLY
PAGE
RELOC /CLEAN UP PAGE
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-1
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
DEAS, TAD [UDNAME-1
DCA X1
TAD [-17
DCA TM1
CDF 10
DCA I X1
ISZ TM1
JMP .-2
ASRET, CDF CIF 0
JMP I [KEYMON
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 EXTMP
DCA I (RUNCNT
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 (RUNCNT /PATCH DSN APR-MAY 79
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 KMONER
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 (RUNCNT /ARE WE DONE WITH ALL SEGMENTS?
SKP /NOT YET. LOOP UNTIL DONE
JMP I [MSWITC
RUN5, DCA I TM1 /SAVE ALTERED CONTROL WORD
JMP RUN2
KMER1, JMS I [PRNAME /DEVICE NOT AVAILABLE
JMS I [PRMESG
IFDEF GERMAN < TEXT / UNBEKANNT/>
IFNDEF GERMAN < TEXT / UNKNOWN! />
PAGE
/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 /MOVE PMSRST TO MSWITC+1
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
RTWTPT, RUNTWT
DCBF, 400
PMSRST, RELOC 7765 /MSWITC+1
JMS SHNDLR
0300
7000
MTEMP+6
IFNZRO .-7771 <SEE78, ______>
HLT /CONTAINS SECOND COPY OF OS/78 BIT
TCF /REVERSED FOR KT8A
CDF CIF 0
RELOC
MVCNT, MOVBUF-MVT3-1
PDBUF, MOVBUF
MVFROM, RELOC 7626
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, -111
RELOC
IFNZRO .-1077 <SEESET, ______>
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
TX212, 212
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
MINCOR, 0
CIF 10
JMS I SYSTEM
10
CDF 10
DCA I [OLDT9 /ZERO OUT "DIRECTORY IN CORE" KEY
KM6203, CIF CDF 0
TAD [200
DCA SYSTEM
JMP I MINCOR
ASDONE, CDF 10
DCA I TM1
JMP I [ASRET
CRLF, KEYMON+1 /V3D NEEDED FOR INIT
TAD [215
DCA NM1
JMS I (PRNT
TAD TX212
JMS I PCH
JMP I CRLF
M203, -203
PAGE
/NOTE: XR=AMFLAG !
/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 /**THIS AREA GETS MODIFIED BY SET**
-375;ALTMOD /-223;CHLOOP
-376;ALTMOD /-221;CHLOOP
-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
IFNZRO .-1261 <BTCHER, ______>
JMP I XGLINE
/THIS PAGE GETS MODIFIED BY SET COMMANDS (FOR REAL SCOPE RUBOUTS)
/**** BEWARE! ***
PRNT, 0
ISZ RBFLAG
JMP .+3
TAD BSLSH /"\ CONSTANT FOR SET =1361
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
IFNZRO .-1302 <SEESET, ______>
ALTMOD, TAD ["$
DCA NM1
JMS PRNT
ISZ AMFLAG /NOTE ALTMODE
JMP CARRET /WHY NOT GIVE CR?
RUBOUT, TAD LXR
TAD [1-BEGLN
SNA CLA
JMP RBSPCL /*** SET STUFF ***
TAD BSLSH /BSPC, 210
ISZ RBFLAG / TAD BSPC
JMS I PCH
CLA CMA / TAD LBCKUP
DCA RBFLAG / JMS I PCH
TAD LXR
DCA TEMP1
TAD I TEMP1 / TAD BSPC
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
IFNZRO .-1357 <SEECCL,______>
PRQMRK, JMS I [PRNAME
JMP I [PRINTQ
BSLSH, "\
IFNZRO .-1362 <FIXCCL,______>
GETCCL, TAD [6003
JMS I [RESET
TAD [CCLREC /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
CSOVLY
IFNZRO .-1375 <SEECCL, ______>
OV, MSOVL2
JMP KMONER
JMP I [DATEXX
PAGE
SAVE2, TAD I LXR
SNA CLA /ARE THERE ANY ARGS?
JMP SAVE2A /NO ... USE CCB
JMS I [SHNDLR /READ IN ARG OVERLAY
0201
CSOVLY
MSOVLY
JMP KMONER
JMP I CCBTST /GO TO IT
SAVE2A, JMS I [SHNDLR
0201
CSOVLY
MTEMP+10
JMP KMONER
SAVE3, TAD [603
DCA XR
DCA LXR /INITIALIZE FOR GT32K I.D.
TAD I [600
JMS I [CCBTST
JMS I [SHNDLR
0101
CSOVLY
MSOVL2
JMP KMONER
JMP I GETOUT
SAV2X, JMS I PGTOUT
TAD I [600 /UPDATE THE SEGMENT COUNT BY
CLL RAL /FIRST,MAKING SURE 4000 BIT IS SET
STL RAR
CIA
TAD MERTST /SUBTRACT # OF GT32K SEGS THIS ALLOW US TO BYPASS...
CIA
DCA EXTMP /SAVE COUNT FOR GT32K
TAD EXTMP
CIA
CLL RAL /WE WANT TO BUMP COUNTER TWICE FOR EVERY SEG
TAD [603 /ADD POINTER TO INITIAL SEGMENT
DCA XR
JMP I (XLOD
KMER4, JMS I [PRMESG
IFDEF GERMAN < TEXT /ANGABEN FEHLEN/>
IFNDEF GERMAN < TEXT /TOO FEW PARAMS/>
CCBTST, SAVE1A /EXAMINE COUNT WORD OF CCB FOR VALIDITY
/ASCII AND BINARY FILES USUALLY FAIL THIS TEST
CLL RAL /INSURES 4000 BIT IS SET--128K INDICATOR
STL RAR
DCA EXTMP
LXM /INITIALIZE EXTENDED MEMORY
TAD EXTMP
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
IFDEF GERMAN < TEXT /KEINE.SV-DATEI/>
IFNDEF GERMAN < TEXT /CORE IMAGE ERR/>
GETOUT, SAVE3A /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
KMER2, JMS PRNAME
JMS I [PRMESG
IFDEF GERMAN < TEXT / NICHT DA />
IFNDEF GERMAN < TEXT / NOT FOUND/>
PRNAME, 0
TAD NM1
JMS I [PRWD
TAD NM2
JMS I [PRWD
TAD NM3
JMS I [PRWD
TAD NM4
SNA CLA
JMP I PRNAME
TAD [256
JMS I [PCHAR
TAD NM4
JMS I [PRWD
JMP I PRNAME
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
JMP I RESET
SVXER, JMS I [PRMESG
IFDEF GERMAN < TEXT /.SA FEHLER/>
IFNDEF GERMAN < TEXT /SAVE ERROR/>
KMER5, JMS I [PRMESG
IFDEF GERMAN < TEXT /?SYNTAX?/>
IFNDEF GERMAN < TEXT /BAD ARGS/>
PAGE
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
RUN7A, TAD DEVHND
DCA I [MREAD-1
TAD DEVHND
DCA RUNHND /STORE DEVICE HANDLER ENTRY IN THIS PAGE
TAD SENTER
DCA I [SBLOCK /STORE DEV NUMBER FOR CHAINING
TAD I ADR1
DCA I ADR2
ISZ ADCNT
JMP .-3
JMP I .+1
RUN8&177+CCB
ADCNT, RUN8&177-200
RFILE, FILE
CHK32, 0 /PROTECTS MONITOR FROM GREATER THAN 32K FIELD 0 LOAD
TAD I RCTL1
AND T76A /ISOLATE CDEB BITS FOR FUTURE USE
DCA CDE
TAD I RCTL1
AND [7700 /LOAD EVERY FIELD INTO FIELD 4
TAD T40 /WE'LL BUMP IT UP FROM THERE---LATER
DCA I RCTL1
JMP I CHK32
T40, 40
T76A, 76
RCTL1, RCTL&177+CCB
SVLNBF= 1652
/LOCATIONS SVLNBF TO SVLNBF+111 DESTROYED BY THE LINE BUFFER DURING A SAVE
MOVUP, 0 /SUBROUTINE TO MOVE UP PROGRAM CODE
TAD I RCTL1
AND [3700 /CALCULATE THE NUMBER OF LOCS
CLL RAL
CIA
DCA COUNT /STORE IT HERE
TAD CDE /PREPARE FOR CDF TO PROPER BANK & FIELD
CLL RTR
SZL
TAD TX20
CLL RTL
TAD T6201 /STORE IT IN EXTEND
DCA EXTEND
STA
TAD I RADR1 /INITIALIZE THE INDEX REGS
DCA ADR1
TAD ADR1
DCA ADR2
TAD [7000 /SET EXTENDED MEMORY
LXM
BACK, CDF 40 /MAKE THE MOVE
TAD I ADR1
EXTEND, 0
DCA I ADR2
ISZ COUNT
JMP BACK
CDF 0
JMP I MOVUP
T6201, 6201
CDE, 0
TX20, 20
COUNT, 0
RADR1, RADR&177+CCB
*1712
RUN8, ISZ RUNCNT /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
TAD RCTL
AND TS7 /TEST FOR GREATER THAN 32K
SNA
DCA HF3
SZA CLA
JMS I CH32
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 HF3 /IF GREATER THAN 32K
SZA CLA
JMS I MOVUPT /LOAD HIGHER FIELDS
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
HF3, -1
CH32, CHK32
MOVUPT, MOVUP
RERR, CIF 10
JMS I RU7700
TS7, 7
0 /TOTALLY MEANINGLESS
RUNADR, CCB+4
RUNCNT, 0
RMRD3, MREAD+3
RU7700, 7700
RUNHND, 0
IFNZRO ROTAT-SVLNBF-111&4000 <ERROR>
*1767 /MUST BE AT TOP OF PAGE
ROTAT, 0
BSW
AND RU37
SNA
TAD RU37
IAC
CLL RAR
JMP I ROTAT
RU37, 37
RELOC RUN6
PAGE
RELOC
/OVERLAY TO KEYBOARD MONITOR FOR "SAVE" WITH ARGUMENTS
RELOC CSOVLY /GOES INTO 400
SAVE1A, TAD [1603
DCA X1
DCA TM1
CDF 10
DCA I [OLDT9
S6203, CIF CDF 0
TAD (SGETOUT /POINTER TO NEW GETOUT
DCA PGTOUT /LIKEWISE "GETOUT"
JMS I [SHNDLR
0210
CCOVLY
MTEMP+10 /READ IN CONTROL BLOCK
JMP KMONER
JMS I (LXRBAK /RESET LXR TO LOOK AT FIRST CHAR
JMS I (LXRBAK
DCA DASHFG
SNUMLP, JMS SGTNUM
JMP SDLOOK /NO NUMBER - GET DELIMETER
TAD I LXR
TAD (-"-
SNA CLA
JMP SVDASH
JMS I (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 I (KMER5 /NO - ERROR
TAD TEMP2
AND [7600
TAD [200
DCA TEMP2
TAD TEMP2
CIA
TAD OLD2
SZL CLA /IS UPPER LIMIT > LOWER LIMIT?
JMP I (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
TAD (-",
SNA
JMP SNUMLP-1
TAD [",-";
SNA
JMP SSTADR
TAD [";-"=
SNA CLA
JMP I (SSBITS
JMP I (KMER5
SVDASH, TAD DASHFG
SZA CLA
JMP I (KMER5
ISZ DASHFG
JMS DASHSB
JMP SNUMLP
SSTADR, JMS SGTNUM
JMP I (KMER5 /NULL STARTING ADR - ERROR
TAD TEMP1 /TRANSFORM FOR CDF --"37" TO "174"-128K
CLL RTR
RTR /CDE/000/000/00A/ B
BSW /000/00A/CDE/000/ B
SZL /"B" BIT ON?
TAD [4 /000/00A/CDE/B00
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 (37 /ISOLATE FIELD( & BANK)
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
JMP .+4
TAD (20
SNA CLA
JMP .-4
JMS I (LXRBAK /SHOVE INDEX BACK
TAD DIGFLG /IS DIGIT PRESENT?
SZA CLA
ISZ SGTNUM
JMP I SGTNUM
PAGE
SSBITS, JMS I (SGTNUM
JMP I (KMER5
TAD TEMP2
CDF 10
DCA I [1603
JMP I (SDLOOK
SVEND, JMS I [SHNDLR
0101
CSOVLY
MSOVL2 /READ IN SECOND PART OF OVERLAY
JMP KMONER
TAD TM1
SNA
JMP I (MOVECB
CIA
CDF 10
DCA I [1600
TAD [1603 /NOW SORT THE ENTRIES IN THE SEGMENT TABLE ON
DCA P1 /DECREASING FIELD AND INCREASING ADDRESS
CLA IAC /WITHIN THE FIELD.
TAD I [1600
SNA
JMP SORTED /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 SORTED /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
LXRBAK, 0
CLA CMA
TAD LXR
DCA LXR
JMP I LXRBAK
SORTED, TAD I [1600
IAC
SNA
JMP I (MERGED
DCA TEMP1
TAD [1603
DCA X1
TAD (1606
DCA LXR
JMP I [MRGLP
PAGE
RELOC
RELOC CSOVLY /LOADS INTO 400 ON TOP OF SAVE1A
/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
JMP I (KMER5 /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 I (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, CDF 0 /LOAD IN MERGED OVERLAY
JMS I [SHNDLR
0100
CSOVLY+200
MRESER
JMP KMONER
JMP I (MERGEX
MOVECB, TAD (-1777
DCA MERTST
JMP MERGED
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
SAVE3A, ISZ XR
TAD I XR /GET THE I/O CONTROL WORD OF THIS SEGMENT
DCA ADR2 /CAUTION AUTO-INDEX TEST FOR GREATER THAN 32K
TAD ADR2
AND [7 /ARE THERE ANY BANK BITS?
SZA CLA
JMP XTAT /NO- PROCEED AS NORMAL
TAD SPTST /ONLY WANT TO ISOLATE FIRST FIELD
SNA CLA /BELOW 32K
JMP XTAT
TAD CLENGT /SET UP FIRST FIELD I.D.
DCA LXR /CAUTION AUTO-INDEX-SAVE BLOCK OFFSET
TAD EXTMP /SAVE NUMBER OF SEGS LEFT
DCA MERTST /... NEGATIVE OF # LEFT
DCA SPTST /SET I.D. "SET" FLAG
XTAT, TAD ADR2
JMS I PROTAT /EXTRACT THE LENGTH FROM IT
TAD CLENGT
DCA CLENGT /UPDATE THE LENGTH OF THE FILE
ISZ EXTMP
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 I (SVXER /SAVERR CODE REPEATED
CIF CDF 10
TAD I [DVHREC
CDF 0
DCA I [LDBLK
TAD SENTER
JMS I SYSTEM
4 /CLOSE
NM1 /NAME FOR "CLOSE"
CLENGT, 1 /CLOSING LENGTH
JMP I (SVXER
JMP I (SAV2X
XLOD, JMS I [SHNDLR
0201
XGLINE
MRESER
JMP KMONER
JMP I (SAVXX /JMP T0 1400
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
CNV, JMP I SGETOUT /CNV ONLY CALLED BY NEXT PAGE
AND [77
SNA
JMP NUL
TAD (-60
SMA
ISZ CNV /SECOND RETURN OK
JMP I CNV
NUL, TAD TM1
JMP I (GODE
PROTAT, ROTAT
PAGE
/DATE PROCESSOR - LOADS IN 400, RUNS IN 600
DATEXX, JMS DECIM
NUM1, AND DA37
NUM2, DCA NUM2
JMS I GNAME
DA37, 37 /NOTHING FOUND WILL GIVE ERROR LATER
NEWLUP, ISZ MONPTR
TAD I MONPTR
ISZ MONPTR
SNA
JMP BADNUM /SYMBOLIC MONTH NOT FOUND
TAD NM1
TAD NM2
SZA CLA
JMP NEWLUP /3 LETTER HASH DOESN'T MATCH
TAD I MONPTR /GET MONTH NUMBER * 40
TAD NUM2
CLL 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
CLL RTL
RTL
AND [600 /ISOLATE EXTENSION DATE BITS
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
CDF 0
TSF
JMS L7177 /TIME OUT A BIT
JMP DATEN /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)
DATEN, TAD AMFLAG /PRINT WEEKDAY IF ALTMODE
SNA CLA
JMP I [7605 /RETURN TO MONITOR
DATERR, TAD [7605
DCA ERRET /IN CASE CCL IS NOT THERE
DCA NM1
JMS I [SHNDLR /RELOAD PAGE 400
0100
CSOVLY
10
JMP KMONER
JMP I [CCLSW-1
DDELIM, -"-
DECIM, 0
JMS I GNAME
MONPTR, MONS-1 /NOTHING THERE (LOGIC WILL CAUSE ERROR LATER)
TAD TMP
TAD DDELIM /COMPARE AGAINST DESIRED DELIMETER
SZA CLA /DASH OR NULL
JMP DATERR /DELIMETER BAD, GO TO CCL
TAD NM2 /ONLY ALLOW 2 CHARS FOR MM
SZA CLA
JMP BADNUM
TAD NM1
BSW
JMS I (CNV
JMP BADNUM
DCA TM1
TAD TM1
CLL RTL
TAD TM1
RAL
DCA TEMP2
TAD NM1
JMS I (CNV
JMP BADNUM
TAD TEMP2
GODE, SZA
JMP I DECIM
BADNUM, CLA /CRAP IN AC
TAD [7605
DCA ERRET
JMS I [PRMESG
IFDEF GERMAN < TEXT /DATUM?/>
IFNDEF GERMAN < TEXT /?DATE?/>
MONS, -1201-1600 /JAN
1^40
-0605-0200 /FEB
2^40
-1501-2200 /MAR
3^40
-0120-2200 /APR
4^40
-1501-3100 /MAY
5^40
-1225-1600 /JUN
6^40
-1225-1400 /JUL
7^40
-0125-0700 /AUG
10^40
-2305-2000 /SEP
11^40
-1703-2400 /OCT
12^40
-1617-2600 /NOV
13^40
-0405-0300 /DEC
14^40
-1501-1100 /MAI
5^40
-1713-2400 /OKT
12^40
-0405-3200 /DEZ
14^40
0
PAGE
RELOC
RELOC CCOVLY /MONITOR ERROR PROCESSOR - LOADS INTO 11400
DLYLPX, AND I 0
D7600, 7600
TAD MERRNO
CLL RAL
ISZ I (ZERO
ISZ I (ZERO /V3C
ISZ I (ZERO
JMP DLYLPX /WAIT FOR TELEPRINTER (WITHOUT CDF'S)
SNA
JMP USRERR
CLL RAR
TAD (4060
DCA I (MERTYP
MERCMN, TAD (MERRXR
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
\AD 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-1 /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
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
/LOADS INTO 1600
MERRXR,
IFDEF GERMAN < TEXT \MONITOR-FEHLER 0 BEI \>
IFNDEF GERMAN < TEXT \MONITOR ERROR 0 AT \>
MERTYP=MERRXR+7
UERRXR,
IFDEF GERMAN < TEXT \ANWENDER-FEHLER 0 BEI \>
IFNDEF GERMAN < TEXT \USER PROG. ERROR 0 AT \>
UERTYP=UERRXR+10
EXPLTBL,MON1
MON2
MON3
MON4
MON5
MON6
MON7
MON1,
IFDEF GERMAN < TEXT \EINTRAGUNGS-FEHLER\>
IFNDEF GERMAN < TEXT \ FILE CLOSE ERROR \>
MON2,
IFDEF GERMAN < TEXT \VERZEICHNIS L/S-FEHLER\>
IFNDEF GERMAN < TEXT \ DIRECTORY I/O ERROR \>
MON3,
IFDEF GERMAN < TEXT \GERAETEHANDLER NICHT GELADEN\>
IFNDEF GERMAN < TEXT \ DEVICE HANDLER NOT IN CORE \>
MON4,
IFDEF GERMAN < TEXT \FALSCHER USR-AUFRUF\>
IFNDEF GERMAN < TEXT \ ILLEGAL USR CALL \>
MON5,
IFDEF GERMAN < TEXT \L/S-FEHLER AUF SYS:\>
IFNDEF GERMAN < TEXT \ I/O ERROR ON SYS: \>
MON6,
IFDEF GERMAN < TEXT \ VERZEICHNIS VOLL \>
IFNDEF GERMAN < TEXT \DIRECTORY OVERFLOW\>
MON7,
IFDEF GERMAN < TEXT \FEHLER NUMMER 7\>
IFNDEF GERMAN < TEXT \---RESERVED----\>
PAGE
RELOC
/EXECUTION TIME LOADER FOR MONITOR "CHAIN" COMMAND
RELOC CCB /EXECUTES IN FIELD 0 IN PAGE 7400
MCHNX, DCA MCHREC /STORE STARTING RECORD #
TAD I (MACARG /PICK UP HANDLER ADDRESS
SZA /IF ANY: NONE=SHNDLR
DCA MCHND
CDF 0
CLL
TAD MCHND /TEST IF RESIDENT
TAD CHERR1 /CONTAINS -7607
SNL CLA
JMP CHERR /ERROR: NOT RESIDENT
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 CH7200 /TEST FOR SAVE FILE!
CMA /TEST FOR VALID CCB
AND (7740
SZA CLA
JMP CHERR
TAD I MC7201
DCA I (MSTCDF /TRANSFER INFORMATION FROM CONTROL BLOCK
MC7201, CLA IAC
TAD I (7202
DCA I (MSTADR /TO PAGE 7600
TAD I (7203
TAD (1000
DCA I (JSBITS
TAD MCHFJM
DCA I (MSWITC
TAD (TCF
DCA I (MSTCDF-1
MCHN1, ISZ I CH7200
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 MCHND
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 MCHND
MCHCTL, 0101 /1 RECORD INTO FIELD 0 STARTING FORWARDS
MCHADR, 7200
MCHREC, 0
JMP CHERR /CHAIN ERROR
TAD MCHCTL
BSW
AND (37
SNA /V3C
TAD (40 /0
EANS FULL 4K READ
IAC
CLL RAR
TAD MCHREC
DCA MCHREC
JMP I MCHRD
MCHT1, 7204
MCHFJM, MSTCDF-1&177+5200 /"JMP MSTCDF-1"
CHERR, IFNDEF GERMAN < bC;"H;"A;"I;"N;" ;"E;"R;"R;"O;"R;" ;215;212;0>
IFDEF GERMAN < "C;"H;"A;"I;"N;" ;"F;"E;"H;"L;"E;"R;215;212;0>
ISZ CHERR1
JMP CHERR /LET TTY DIE DOWN
CH7200, 7200 /ALSO CLA
CHTADC, TAD CHERR
SNA
JMP I (7600 /DONE..BACK TO MONITOR
TLS
TSF
JMP .-1
ISZ CHTADC /NEXT LETTER
JMP CH7200
CHERR1, -7607
MCHND, SHNDLR
PAGE
RELOC
RELOC CCOVLY
SAVXX, TAD I SXFLE /STORES SFILE
DCA SWFILE
JMS I (HNDL /LOAD IN NON SYS HANDLER
JMS SWRITE /WRITE OUT CCB
TAD MERTST /MINUS THE # OF SEGS OF LT32K CODE
DCA I [600
TAD LXR /# OF BLOCKS OF GT 32K SEGS
SNA /LXR IS ZERO IF ALL SEGS ARE ABOVE 32K
JMP OVR32
TAD I SXFLE /LXR--- COMPENSATES FOR CCB
DCA SWFILE
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 (76
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
STA /LXR BECOMES ONE BECAUSE OF CCB
TAD LXR /NUMBER OF BLOCKS OF GT32K SEGS
SNA CLA
JMP I [SAVE12
OVR32, TAD I SXFLE /RESET FILE TO INITIAL BLOCK
IAC /COMPENSATE FOR CCB
DCA SWFILE
TAD [603 /RESET CCB POINTER
DCA ADR1
TAD [7000
LXM
CLA /YOU NEVER KNOW
SAVE4B, TAD I ADR1 /IDENTICAL TO SAVE4 CODE
DCA SADR
CLA CLL CML RAR
TAD I ADR1
DCA SCTL
DCA ADR2 /SET UP TO MOVE GREATER THAN 32K CODE DOWN
DCA X1 /DITTO
DCA SXFLE /INTIALIZE FOR COUNTER
TAD SCTL /SET UP CDF FOR MOVE
AND (76 /ISOLATE BANK AND FIELD
CLL RTR /ADJUST MENT
SZL
TAD (20
CLL RTL
TAD FDC0
DCA .+1
XFSP, 0 /START OF MOVE LOOP
TAD I ADR2
CDF 40 /PUT THEM IN FIELD 4 (SECOND HALF BANK)
DCA I X1 /IT SEEMS LIKE A GOOD FIELD
ISZ SXFLE
JMP .-5
FDC0, CDF 0 /LOOP IS OFFICIALLY OVER
TAD SCTL /ADJUST SWRITE CONTROL WORD
AND [7700
TAD (40 /TO FIELD 4
DCA SCTL
JMS SWRITE
ISZ EXTMP /IS THAT ALL THE SEGMENTS??
JMP SAVE4B /NO ---CONTINUE
JMP I [SAVE12 /TIME TO EXIT
LOADF0, 0
JMS I [SHNDLR
1010
F0OVLY, 0 /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 KMONER
TAD SCTL
BSW
AND (37
SNA
TAD (37
IAC
CLL RAR
TAD SWFILE
DCA SWFILE /BUMP RECORD NUMBER
JMP I SWRITE
SXFLE, SFILE
PAGE
RELOC
/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
1210 /IN FIELD 1 AND IS 10 PAGES LONG
IFNZRO LDRCTL-4113 <BLDER,XQX>
SYTM1, 0
SYTM2, 0
TMSY, 0
SYSHND, 7607
PAGE
*4264
RELOC 664
MERGEX, CDF 10
TAD MERTST
SZA CLA
JMP MOVEC
TAD [1603 /LOADS INTO 600--MERGED--CODE
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
AND (37
CLL RTR /TRANSFORM 'ABCDE' TO 'CDEBA0'
RTR /CDE/000/000/00A/ B
SZL /TEST FOR 'B' BANK
TAD [400 /CDE/B00/000/00A/
CLL RAR /0CD/EB0/000/000/ A
SZL /TEST FOR 'A' BANK
TAD [100 /0CD/EBA/000/000/
CLL RAL
BSW
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 RAR
TAD TEMP2 /ADD IN FIELD
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
TAD I (1605 /TEST FIRST SEGMENT FOR GREATER THAN 32K
AND [7
SNA CLA /IF GREATER THAN 32K SET
JMP MOVEC
TAD I [1600 /THE 4000 BIT OF THE FIRST WORD OF THE CCB TO ZERO
RAL
CLL RAR
DCA I [1600
/REMOVED LXM PUT IT IN MOVE UP CODE
MOVEC, TAD (1577
DCA LXR
TAD (577
DCA X1
TAD [7600
DCA TEMP1
DCA MERTST /SET MOVE I.D. TO ZERO
JMP I MVECB /RETURN TIME
MVECB, CBMOVE
PAGE
RELOC
*7400
RELOC 7600
/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"
MMISC, 0 /WORD FOR SET OPTIONS
RELOC
/********************************************************
/ MAP OF SYSTEM DEVICE AS OF 1-JUN-79
/********************************************************
/ * 256 WORD RECORDS *
/********************************************************
/
/ RECORDS CONTENTS
/ ------- --------
/
/ 0 MONITOR BOOTSTRAP
/ 1- 6 SYSTEM DIRECTORIES
/ 7-12 KEYBOARD MONITOR
/ 13-15 I/O MONITOR(CALLABLE MONITOR) [15.5 EMPTY]
/ 16-25 DEVICE HANDLER RECORDS
/ 26 MONITOR "ENTER" OVERLAY, TM8E EXTENSION
/ 27-50 MONITOR SCRATCH AREA FOR SAVING CORE
/ 51-53 COMMAND DECODER [53.5 EMPTY]
/ 54-55 "SAVE WITH ARGUMENTS" AND "DATE" OVERLAYS
/ 56 MONITOR ERROR ROUTINE
/ 57 "CHAIN" PROCESSOR [57.5 EMPTY]
/ 60-63 SYSTEM ODT
/ 64 MERGED CODE OD&SAVE
/ 65 CCL REMINISCENSES
/ 66 USED BY TWO-PAGE SYS HANDLER
/ 67 USED BY CCL (CCL OVERLAY)
/ 70-END FILE STORAGE
/********************************************************
/
/ SCRATCH BLOCKS:
/ ------- -------
/
/ 27-32 USR SWAP AREA
/ 33-36 OD&KM SWAP AREA
/ 37 CCB IN SECON HALF
/ 40-44 ABSLDR SWAP AREA 12000-14377
/ 45 ABSLDR HANDLER SWAP 7000-7377
/
/
/********************************************************
SHNDLR=7607 /ENTRY POINT TO SYSTEMS HANDLER
*6600
RELOC 7600
/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
RELOC
*6744 /INFORMATION ABOUT CURRENT JOB
RELOC 7744
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
TCF /EXIT WITH A CLEAR CONSCIENCE(ALSO A CLEAR FLAG)
MSTCDF, CDF CIF 0
JMP I .+1
MSTADR, 0
SBLOCK, 0 /GETS DEVICE NUMBER OF RUNNED PROGRAM
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
RELOC
*0
VERSNO /OS/8 VERSION NUMBER
CIF 30
JMP .-1 /HIGROUND SUPPORT
KMONER, CLA
TAD [7605
DCA ERRET
JMS I [PRMESG
IFDEF GERMAN < TEXT /FEHLER/>
IFNDEF GERMAN < TEXT /?ERROR/>
/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-1&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)
EXTMP, 0
MERTST, 0
SPTST, -1 /-1 USED IN RUN CODE
CCLINC, 0 /FLAG USED BY CCL V40 FOR IN-CORE STATUS
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
CCOVLY
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
CIF 0 /CHAIN WILL DO CDF 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
*MONITO+1
PAGE
*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
CCOVLY
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 /"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
/TM8E - EXTENDED HANDLER
/
/ THIS WILL REALLY BE EXECUTED FROM FIELD MYFLD BUT IS
/ ASSEMBLED IN FIELD 0
/
/ *** MUST BE STORED IN BLOCK 26 ON SYS: *** (AFTER 'ENTER OVERLAY')
/
/LOADED AND CALLED BY THE SYSTEM TM8E HANDLER.
/DESTROYS FIELD X
/
/CALLING SEQUENCE:
/ CIF X
/ JMS I (TM8EEX
/ IF AC = -1 THEN
/ IF WRITE - UNPACK BUFFER
/ IF READ - ZERO BUFFER
/ IF AC = 00 THEN
/ IF WRITE - DO NOTHING
/ IF READ - PACK BUFFER
/ WORD -- BIT 0 = 0 (READ); 1 (WRITE)
/ BITS 1-5 = # PAGES IN OS/8 BUFFER
/ IF THIS IS ZERO AND CODE=6, THEN PACK OR
/ UNPACK THE # WORDS INDICATED IN ARG 3.
/ BITS 6-8 = FIELD OF OS/8 BUFFER
/ BITS 9-11= FUNCTION CODE (ONLY 6 MEANINGFUL)
/ CORE -- STARTING LOCATION OF OS/8 BUFFER
/ BLOCK-- USED ONLY TO PASS BUFFER SIZE ON FN CODE 6.
/
/
/LOCATIONS USED ON PAGE 0
TBUF= 17
HLFBLK= 20
NKNT= 21
NBUFF= 22
PKT1= 23
PKT2= 24
MAGSW= 70 /WHY?
PKT3= 100 /WHY?
RELOC 200
ZBLOCK 2 /*KLUDGE FOR HANDLER*
TM8EEX, 0 /ENTRY POINT AT 202!
DCA MAGSW
RIF /GET THIS FIELD
TAD MAGCDF
DCA MYFLD
TAD MAG377 /TAPBUF-1 **
DCA TBUF
TAD MAG100
AND I TM8EEX /SPECIAL CLEARING NEEDED IF
DCA HLFBLK / WRITING 1/2 BLOCK
TAD I TM8EEX /GET WORD
MAG377, AND (3700 /MASK OFF # PAGES
SNA /^ MUST BE FIRST LITERAL
JMP CKCODE
RTRN1, CMA CLL
DCA NKNT /IT'S NOW THE NUMBER OF 3 CHARACTER (2 WORD) GROUPS.
CLA STL RAR /SET LINK ON WRITE
TAD I TM8EEX
AND MAG70 /GET FIELD
TAD MAGCDF
DCA OSFLD1
TAD OSFLD1
DCA OSFLD2
ISZ TM8EEX
TAD I TM8EEX /GET CORE LOCATION
DCA NBUFF
TAD MAGSW
SNA CLA /IF AC WAS =-1 EITHER UNPACK OR ZERO MAG BUFFER
JMP READCK
/ THE PLAN IS TO WRITE ON THE MAGTAPE.
/ UNPACK THE OS8 BUFFER INTO THE TAPE BUFFER
/ AND THEN RETURN TO THE HANDLER TO DO THE
/ ACTUAL WRITE OPERATION.
/
SNL /IF READ ...
CLRPAK, DCA MAGSW /USE SWITCH TO CLEAR BUFFER
UP1, ISZ NKNT
JMP UP2
TAD HLFBLK /DID WE UNPAK 1/2 BLOCK?
SNA
JMP TEXIT /NO
CMA /YES - CLEAR THE REST
DCA NKNT
DCA HLFBLK
JMP CLRPAK
UP2, DCA PKT2
JMS UP9 /GET 1ST WORD
JMS UP8
JMS UP9 /GET 2ND WORD
JMS UP8
TAD PKT2
JMS UP8
JMP UP1
/
UP8, 0
AND MAG377
MAG70, AND MAGSW
DCA I TBUF
JMP I UP8
/
UP9, 0
OSFLD1, HLT
TAD I NBUFF
AND MG7400
RAL
TAD PKT2
RTL
RTL
DCA PKT2
TAD I NBUFF
ISZ NBUFF
MAGCDF, CDF 0 /DON'T CARE IF SKIPS
JMS CDFRST
JMP I UP9
CDFRST, 0
MYFLD, HLT
JMP I CDFRST
/ READ OPERATION -- PACK THE TAPE BUFFER
/ INTO THE OS8 BUFFER AFTER A TAPE READ.
/ THIS INCLUDES MASKING OFF THE PARITY
/ BITS THE HARDWARE INSERTS TO MAKE THINGS
/ DIFFICULT FOR US.
/
/ THIS OPERATION STARTS AT LOC. <READ>.
/
PK1, JMS CDFRST
JMS PK8 /GO GET THE FIRST WORD
DCA PKT1 /SAVE 1ST CHAR OF EACH TRIPLET
JMS PK8 /GO GET THE NEXT
DCA PKT2 /SAVE THIS (2ND) ONE TOO
JMS PK8 /AND FINALLY, GET THE THIRD
OSFLD2, HLT /SET THE OS8 FIELD
JMS PK9 /PACK THE FIRST OS8 WORD AND STORE IT
TAD PKT2
DCA PKT1
TAD PKT3
JMS PK9 /AND ALSO THE SECOND WORD
READ, ISZ NKNT /ANY MORE TO GO?
JMP PK1 /YES
JMP TEXIT /NO -- BUFFER FINISHED
/
PK8, 0 /TRICK SUBROUTINE TO KEEP TRACK
/ OF WHICH CHARACTER WR'RE WORKING
/ ON AT ANY GIVEN TIME.
TAD I TBUF /GET A CHARACTER FROM TAPE BUFFER
AND MAG377 /MASK OFF PARITY BIT
JMP I PK8
/
PK9, 0 /GENERATE AND SAVE ONE PACKED CHARACTER
RTL
RTL
DCA PKT3
TAD MG7400
MAG100, AND PKT3
TAD PKT1
DCA I NBUFF
ISZ NBUFF
MG7400, 7400
JMP I PK9
READCK, SNL /IF AC WAS = 0 AND WRITE DO NOTHING
JMP READ
TEXIT, CIF CDF 0
TAD NBUFF
DCA I TM8EEX /RESET UPDATED BUFFER POINTER
ISZ TM8EEX /BUMP TO EXIT
ISZ TM8EEX
JMP I TM8EEX
/
CKCODE, CLA STL RTL /2+6=10
TAD I TM8EEX
AND (7 /MASK OFF CODE
SZA CLA
JMP RTRN1 /NOT SIX -- RETURN FOR NULL OPERATION
CLL CML RTL /2 => AC
TAD TM8EEX
DCA NKNT
TAD I NKNT /GET ACTUAL REQUESTED BUFFER SIZE
CLL CML RAR /WE NEED BUFFER 3/2 THIS SIZE
TAD I NKNT
CIA
JMP RTRN1 /SEND IT BACK FOR USE
PAGE
RELOC
EJECT ABSLDR
/ABSOLUTE LOADER FOR OS/8 - VERSION 6C
*2000
CTLBLK=3400
BUFFER=CTLBLK
RXM=6230 /KT8A INSTRUCTION
LXM=6200 /KT8A INSTRUCTION
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
XVALU=70 /XCODE
LSTADR=71
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
ISZ JMPGET
ISZ CHCNT
JMPX, JMP JMPGET
JMS I (ABSCTC /CHECK FOR ^C
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, 6603 /ABSLDR VERSION NUMBER
CMA
AND I B2 /AND OUT THE PAGE SLOT IN THE PAGE TABLE
DCA I B2
TAD ORIGIN
DCA ORGX
TAD XVALU
CLL RAR
SZA CLA /TEST FOR FIELDS 0 OR 1
JMP PUTIT /NEITHER - STORE AS IS
SNL
JMP FLD0
TAD ORIGIN
SPA
TAD [-400
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+15
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
CCOVLY /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
CDF 10
JMP PUTIT2
FLD1, CLL
TAD ORIGIN /IGNORE LOCATIONS ABOVE 17600
TAD [200
SZL CLA
JMP I PUTWD
PUTIT, TAD XFIELD
AND (104 /ARE WE OVER 32K?
SZA CLA
CDF 60 /DON'T KILL SYSTEM IF NO KT8A
TAD XFIELD
TAD (6201
DCA .+1
HLT
PUTIT2, 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
ISZ PG7400 /SET OVERLAY FLAG
JMP LCOMPR /FORM RECORD NO. MTEMP+16
WRBUF, 0
TAD BUFREC
SNA
JMP I WRBUF
CIF 0
JMS I [SHNDLR
4210
PTRBFR, CCOVLY
BUFREC, 0
JMP I (LIOERR /BAD I/O ON SYSTEM DEVICE
DCA BUFREC
JMP I WRBUF
ORGX,
NEXFIL, 0
JMS WRBUF /WRITE WHATEVER
TAD I [MPARAM-1
SPA CLA
JMP I (BUILD
TAD I [MPARAM
AND (40
SZA CLA
JMP I (BUILD
JMP I NEXFIL
ABSCTC, 0
TAD [200
KRS
TAD (-203
SNA CLA
KSF
JMP I ABSCTC
JMP I (MGET
PAGE
*2400
ITSOVR, JMS ASSEMB /END OF FILE
CIA
TAD LCKSUM
SZAIN, SZA CLA /TEST CHECKSUM
JMP I (BADCKS
TAD I [MPARAM+1 /TEST FOR S OPTION
AND L40
SNA CLA
JMP I (NEWFIL /TIME FOR ANOTHER FILE
LOADER, DCA LCKSUM
DCA I (OFLG /CANCEL FURTHER /I'S
TAD SZAIN
DCA I (WRIBUF
JMS GETFLD /FIELD SETTING
TAD [200
DCA ORIGIN /ORIGIN SETTING
JMS I (GETCH
JMP I (NEWFIL
SNA /IGNORE ZEROES
JMP .-3
TAD [-200 /LOOKING FOR LEADER CODE
SZA CLA
JMP LOADER+1
LEADER, JMS I (GETCH
JMP I (NEWFIL
SNA
JMP LOADER+1
TAD [-200
SNA /IS IT LEADER CODE?
JMP LEADER
NEWWD, SMA /IS IT POSSIBLY AFIELD PSEUDO-OP?
JMP FIELDW
TAD [200 /IF NOT STORE FOR ASSEMBLING
DCA WD1
NEWD1, DCA I (HT
JMS I (GETCH
JMP I (BADINP
DCA WD2 /STORE SECOND WORD FOR ASSEMBLING
JMS I (GETCH
JMP I (BADINP
TAD [-200
SNA /TEST FOR TRAILER CODE
JMP ITSOVR
DCA WD /STORE THIRD WORD
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 /ASSEMBLING WORDS...
TAD WD1
CLL RTL
RTL
RTL
TAD WD2
JMP I ASSEMB
FIELDW, TAD (-32 /TESTING TO ISOLATE FIELD PSEUDO-OP
SNA /IS IT A CONTROL/Z?
JMP CTLZ
TAD (-46
SPA /IS IT GREATER THAN 300?
JMP NOTXP
DCA WD1
TAD WD1
AND [7
SZA CLA
JMP NOTXP
TAD WD1
AND (70
ISZ I (HT /I.D. DISTINGUISHES BETWEEN GETFLD & FIELDW CALL
JMS I (XTEND /GO SEARCH FOR GREATER THAN 32K FIELD SETTING
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 /TEST FOR SPECIFIED FIELD SETTING
DCA C1
DCA XVALU /INITIALIZE XVALU
DCA XFIELD /AND XFIELD
TAD I (MPARAM+2 /COMMAND DECODER INPUT
AND (1774
SNA /WAS FIELD SPECIFIED?
JMP I GETFLD
RTL /IF SO, WHAT WAS IT?
RAL
ISZ C1
SNL
JMP .-3
CLA CMA
TAD C1 /FIELD...IS HERE
JMS I (XTEND /MAKE NECESSARY ADJUSTMENTS(KT8A)
JMP I GETFLD
PAGE
*2600
/BUILD CORE CONTROL BLOCK
/FIELDS AND PAGES TO BE SAVED HAVE BEEN ISOLATED
/BY LOADWD.SEE CORTAB FOR MORE INFO ON TABLE.
BUILD, TAD (CORTAB+140 /ROUTINE TO SEARCH SAVE TABLE
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 (40
DCA FIELDB
DCA I (CTLBLK
FLDLP, JMS I (EXTST /SET NEXT FIELD
TAD FIELDB
TAD (-2
SMA CLA /IGNORE 07600 AND 17600 IN CCB /V3
CMA /IN THE CORE MAP
TAD [-37
DCA C2 /PAGE COUNT
DCA LOWERA
STA
DCA LUPPER /KILL LAST UPPER LIMIT
MTLOOP, JMS I (SHFT
SNL CLA
JMP INUSE
TAD LOWERA
MTRSME, TAD [200
DCA LOWERA
ISZ C2
JMP MTLOOP
JMP FLDLP
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
JMS I (AMERGE
TAD LOWERA
AND [7400
DCA I LOADXR
ISZ I (CTLBLK
TAD LOWERA
ACOMPR, AND [7400
CIA
TAD UPPERA
CLL RAR
TAD XFB
DCA I LOADXR
TAD UPPERA
DCA LUPPER
TAD UPPERA
JMP MTRSME
XFB, 0
LUPPER, -1
FLDOVR, 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 (37
JMS I (BANKSW /ADJUST FOR CDF
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
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
PAGE
*3000
ZOFILE, MOFILE
ZOUCNT, -47
LGTOUT, TAD PG7400
SNA CLA
JMP .+7
CIF 0
JMS I [SHNDLR
0300
7000
MTEMP+16
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-1 /LOADER NOT OVERLAYED - WHY READ?
COMBPT, MREAD-1
COMBCT, -7
COMBO, 7607
MREAD-1&177+4600 /JMS I .-1
1210
2000
MTEMP+11 /LOCATION OF SCRATCH BLOCKS FOR LOADER OVERLAY
HLT
MSTCDF-1&177+5200 /JMP MSTCDF-1
CTL2, 0
CTL3, 0
OVLYFG, 0
/LOADWD CALCULATES AN INDEX INTO CORTAB
/IT SETS APPROPRIATE BITS FOR IDENTIFYING MEMORY AREA
/TO BE SAVED BY CCB.SEE CORTAB FOR MORE INFO
LOADWD, 0 /ROUTINE TO IDENTIFY FIELDS AND PAGES
DCA C3 /TO BE SAVED.
TAD XVALU /FIELD VALUE-INDEX INTO CORTAB(SEE CORTAB)
CLL RAL
TAD XVALU
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,
IFDEF GERMAN < TEXT / DATEI 0/>
IFNDEF GERMAN < 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 /-3
DCA C3
CLA CLL CML RTL /2
TAD B1
SHFTLP, DCA B3
TAD I B3
RAL
DCA I B3
CLA CMA CML /CML AND CML
TAD B3
ISZ C3
JMP SHFTLP
JMP I SHFT /NOTE: SHFT LEAVES AC NON-ZERO
ERR, 0
CLA
CDF 10
TAD I (FILPTR /ZERO CHAR GETS REPLACED BY "FILE #X"
TAD (1122 /MAGIC NUMBER
CLL CML RAR /AC NOW CONTAINS "#X"
DCA FILMSG+4
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 T212
JMS LDRPCH
ERTRN, JMP I (ABSLDR /RETURN TO LOADER STARTING ADDRESS
IOERR, JMS ERR
IFDEF GERMAN < TEXT \L/S-FEHLER,\>
IFNDEF GERMAN < TEXT \I/O ERROR,\>
BADINP, JMS ERR
IFDEF GERMAN < TEXT /SCHLECHTE/>
IFNDEF GERMAN < TEXT /BAD INPUT/>
BADCKS, JMS ERR
IFDEF GERMAN < TEXT /?PRUEFSUMME?,/>
IFNDEF GERMAN < TEXT /BAD CHECKSUM,/>
NULERR, JMS I (CTINIT
T212, 212
JMS ERR
IFDEF GERMAN < TEXT /NICHTS GELADEN/>
IFNDEF GERMAN < TEXT /NO INPUT />
LIOERR, JMS ERR
IFDEF GERMAN < TEXT \SYS: L/S-FEHLER \>
IFNDEF GERMAN < TEXT \SYSTEM I/O ERROR\>
OERR, JMS ERR
IFDEF GERMAN < TEXT \/I VERBOTEN!\>
IFNDEF GERMAN < TEXT \/I FORBIDDEN\>
PAGE
/INITIAL DIRECTORY FOR MONITOR
/DEFINES OS/8 ABSOLUTE LOADER (ABSLDR.SV)
RELOC 1400
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
3511 /ENCODING FOR 9-JUL-79
-6 /SIX BLOCKS LONG( 1 BLOCK = 256 WORDS)
0 /EMPTY SPACE
-1 /OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH
IFNZRO .-1415 <CNFER,QQQ>
RELOC
*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
CLL RAL
STL RAR /TAKE OUT 32KOVER BIT
DCA SEGCNT
TAD SEGCNT
CMA /TEST FOR BAD CORE IMAGE
AND [7740
SZA CLA
JMP I (BADINP /NOT CORE IMAGE
TAD I SGSTAD /THIS CODE IS NEW FOR V3D
JMS I (CDFLOG /CONVERT CDF TO LOGICAL
DCA LSTFLD
ISZ SGSTAD
TAD I SGSTAD
DCA 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
JMS I (CCBLOG /CONVERT CCB TO LOGICAL
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
JMS I (ABSCTC /CHECK FOR ^C
CIF 0
JMS I GLONK /READ THE DATA RECORD IN
0210
CCOVLY /INTO 11400
TEMP,
DATRC, 0
JMP I (IOERR /DATA FAILURE
TAD (1377 /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
TAD SEGLTH /V3C (REARRANGED)
SMA SZA /ALL PAGES DONE?
JMP TWOPG /NO, NEXT! (IF DONE, FALL INTO 'GTSEG')
CLA
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
RENEW, TAD (CTLBLK+1
DCA SGSTAD
TAD (CTLBLK+5
DCA SGFDLT
JMP I (NEWFIL
PAGE
*4000
XTEND, 0 /CODE TO HANDLE EXTENDED MEMORY BANK MANIPULATIONS
DCA XVALU /STORE INFO TO BE PROCESSED
TAD HT /IS IT A GETFLD OR A FIELDW CALL?
SZA CLA /IF GETFLD CALL ALL WE WANT TO DO IS TRANSFORM
JMP XFLDT
XNDT, TAD XVALU / TRANSFORM FROM ABCDE TO ACDEB00
JMS BANKSW
DCA XFIELD
TAD XFIELD /32K OVER?
AND [70
SZA CLA
TAD (7000 /YES, ENABLE KT8A
LXM /NO, DISABLE KT8A
CLA /IF NONE
JMP I XTEND
XFLDT, JMS I (GETCH /FIELDW CODE TEST FOR SECOND FIELD WORD
JMP I (BADINP
TAD [-200
SNA
JMP I (NOTXP
SMA
JMP XTD
TAD [200 /REPEATED NEWWD CODE
DCA WD1 /REPEATED NEWWD CODE
TAD XVALU /IF NO SECOND FIELD WORD WE PROCEED AS NORMALLY
DCA XFIELD
TAD XVALU
CLL RTR
RAR
DCA XVALU
JMP I (NEWD1 /BY PASS NEWWD CODE -- ALREADY RAN IT
XTD, TAD (-32 /REPITITION OF FIELDW CODE
SNA /IS IT CONTROL/Z?
JMP I (CTLZ
TAD (-46
SPA /IS IT ABOVE 300?
JMP I (NOTXP
CLL RTR
RAR
AND [7
TAD WD1
DCA XVALU
JMP XNDT
HT, 0
EXTST, 0 /BUILD CCB CODE TO HANDLE EXTENDED MEMORY
CLL STA /FIELDB STARTS AT 40
TAD I (FIELDB /TRANSFORM LOGICAL TO CCB
DCA I (FIELDB /000/000/0AB/CDE/ TO
SNL /000/000/CDE/BA0/
JMP FLDEND /FIELDB WAS ZERO-END
TAD I (FIELDB
BSW
CLL RTL /A /BCD/E00/000/000/
SZL
TAD [100 /BCD/E0A/000/000/
CLL RAL /B /CDE/0A0/000/000/
SZL
TAD [400 /CDE/BA0/000/000/
BSW
DCA I (XFB
CLA CLL CMA RTL /-3
TAD B1
DCA B1
JMP I EXTST
FLDEND, TAD I (CTLBLK
SNA
JMP I (NULERR
CIA
DCA I (CTLBLK
RXM
SNA CLA
JMP I (FLDOVR
TAD I (CTLBLK
RAL
CLL RAR
DCA I (CTLBLK
JMP I (FLDOVR
BANKSW, 0 /000/000/0AB/CDE/ TO 000/00A/CDE/B00
CLL RTR /ISOLATE BANK AND FIELD BITS
RTR
BSW /000/00A/CDE/000 B
SZL /ADJUST FOR PROPER CDF CIF
TAD (4 /WAS THERE AN "B" BIT?
/YES: 000/00A/CDE/B00
JMP I BANKSW
CCBLOG, 0 /CONVERT CCB TO LOGICAL
AND (76 /000/000/CDE/BA0 TO
CLL RTR /000/000/0AB/CDE
SZL /"A" BIT ON?
TAD (40 /000/000/A0C/DEB
CLL RAR
SZL /"B" BIT ?
TAD (10
JMS XTEND
JMP I CCBLOG
CDFLOG, 0 /CONVERT CDF TO LOGICAL
AND (174 /000/00A/CDE/B00 TO 000/000/0AB/CDE
BSW /CDE/B00/000/00A
CLL RAR
RTR /0A0/CDE/B00/000
BSW /B00/000/0A0/CDE
SPA
TAD (4010
JMS XTEND
TAD XVALU
JMP I CDFLOG
PAGE
*4200
/CORTAB IS A TABLE FOR STORING SAVE INFO
/FOR EACH OF THE 0-37 FIELDS, THERE ARE THREE
/IDENTIFYING WORDS...THE BITS IN THESE WORDS
/CORRESPOND TO PAGES IN THE RESPECTIVE FIELD
/E.G. CORTAB+130 REFERS TO 130%3=35TH FIELD
/--- FIRST WORD,I.E. PAGES 0-14...
/LOADWD BUILDS THE TABLE...
/BUILD REFERENCES IT FOR CONSTRUCTING THE CCB
CORTAB, ZBLOCK 140
AMERGE, 0 /MERGE SEGMENTS
AND [7400 /COMES IN WITH LOWERA
CIA
TAD I (LUPPER /LAST UPPER LIMIT
MCSIZ, SZA CLA
JMP I AMERGE /TOO FAR APART
CLA CLL CMA RAL
TAD LOADXR /BACK TO OLD SEGMENT
DCA LOADXR
TAD I LOADXR /LOWER OF OLD SEGMENT
JMP I (ACOMPR /DON'T INC CCBCNT
CTINIT, 0
CALONC, JMS ONCE /CALL ONCE-ONLY CODE
TAD MCSIZ /-140=7640=SZA CLA
DCA C1
DCA XFIELD /INITIALIZE XFIELD
TAD (CORTAB-1
DCA LOADXR
CLA CMA
DCA I LOADXR
ISZ C1
JMP .-3
DCA LSTFLD
DCA LSTADR /V3 SET INITIAL STARTING ADDRESS TO 0
DCA I (OVLYFG
DCA PG7400
ISZ CTINIT
JMP I CTINIT
PAGE
*CORTAB
ONCE, 0 /ONCE-ONLY CODE TO CHECK FOR CORRECT MONITOR
DCA CALONC /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 XERTRN
JMS I PERR /THEY DON'T
IFDEF GERMAN < TEXT /USR IST ALT!/> /MUST BE AN EVEN # OF CHARS LONG
IFNDEF GERMAN < TEXT /INCOMPATIBLE/>
CIF CDF 0
JMP I K7605
K7400, 7400
M7, -7
XERTRN, ERTRN
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
$