Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
7263 lines (6635 sloc) 165 KB
/TS8 VERSION 8.24 (01-JANUARY-75)
/
/
/
/
/COPYRIGHT (C) 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR
/RELIABILITY OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT
/SUPPLIED BY DEC.
VERNUM=30
/PAGE 0
FIELD 3 /LOAD THIS INTO TRACK 3 ON DISK
*1
JMP I .+1
C0200, 200
WS0, 0 /WORKING STORAGE FOR MAIN FLOW
WS1, 0
JOBSWA, 0
*10
ACX10, 0 /FOR INTERRUPT SERVICE
ACX11, RINGIN-1 /INPUT RING BUFFER POINTER (LEVEL 1)
DSPAR, 0 /DISK HANDLER
L2Q, L2QTB-1 /LEVEL 2 QUEUE
L2QE, L2QTB-1 /LEVEL 2 EMPTY POINTER
AXS1, 0 /MISCELLANEOUS LEVEL 2 AUTO-INDEX
AXS2, 0 / "
DSKPTR, DSUTBL+6 /DISK REQUEST QUEUE POINTER
SIDATA=20 /SYSTEM INTERPRETER DATA
*SIDATA
COMPTR, DEVTBL /POINTER TO LAST DEVTBL ENTRY SCANNED
SIBUF, 0 /BUFFER STATE
SICNT, 0
COMDSP, 0 /FIP RETURN DISPATCH
SIFLG, 0 /COMMAND FLAGS
SICHAR, 0 /SAVE LAST CHAR FROM COMMAND SCAN
SIREG, 0 /USER AC, LINK, PC
0
0
TTCHAR, 0 /TTY CHARACTER
CONSTANTS=SIDATA+12
*CONSTANTS
C0002, 2
C0003, 3
C0004, 4
C0007, 7
C0037, 37
C0100, 100
C1000, 1000
C7770, 7770
JOBCON=CONSTANTS+11 /JOB CONTROL
*JOBCON
JOBTIM, 0 /NUMBER OF TICKS RUN
JOBTBA, JOBTBL /JOB TABLE ADDRESS
FRSTOR=JOBCON+3
*FRSTOR
FREE, 0 /POINTER TO HEAD OF FREE STORAGE
FRECNT, 0 /# FREE BLOCKS AVAILABLE
TIMDAT=FRSTOR+2 /CLOCK AND DATE
*TIMDAT
/CLOCK
CLK2, 0
CLK1, 0
SCHDAT=TIMDAT+2
*SCHDAT /SCHEDULING DATA
COMCNT, 0 /NUMBER OF COMMANDS AWAITING EXECUTION
SQREQ, 0 /SWAP REQUEST FLAG
FINISH, 0 /+(I)-(O) FIELD OF JOB BEING SWAPPED
FIT, 0 /JOB # TO BE SWAPPED IN
FORCE, 0 /FIELD TO BE SWAPPED OUT
DATEND=60 /END OF FIELD 0 PAGE 0 DATA
FIPDAT=155 /DATA REFERENCED BY FIP
*FIPDAT
FIPJOB, 0 /JOB NOW (OR SOON TO BE) RUNNING FIP
C0400, 400
SEGSIZ=C0400 /# WORDS PER SEGMENT
*160
JOB, 0 /# OF CURRENT JOB
JOBDAT, . /ADDRESS OF CURRENT JOB DATA LIST. MUST RESIDE IN DATA FIELD.
C7000,
CORTBA, CORTBL-1 /CORE ALLOCATION TABLE
DEVTBA, DEVTBL /DEVICE TABLE
DSUTBA, DSUTBL /USER DISC REQUEST QUEUE
DSBUSY, -1 /DISC BUSY COUNT
/THE DATE IS KEPT AS A 12 BIT NUMBER IN THE FORMAT
/DATE=((YEAR-1974)*12+(MONTH-1))*31+DAY-1
DATE, 0
FISUBL=400
BLTA, BLT0 /BLOCK TRANSFER
BLT=JMS I BLTA
CORSRA, CORSRC
CORE=JMS I CORSRA
GETBA, GETB
GETBLK=JMS I GETBA
GETDBA, GETDB0 /GET A DATA BLOCK
GETDDB=JMS I GETDBA
PRINTA, PRINT0 /TYPE OUT A CHARACTER
PRINT=JMS I PRINTA
GETJT0, GETJTB /GET JOB DATA TABLE ADDRESS
GETJTA=JMS I GETJT0
GIRSCA, GIRSC /STORE CHARACTER IN BUFFER
STORE=JMS I GIRSCA
RETBA, RETB /RETURN BLOCK TO FREE STORAGE
RETBLK=JMS I RETBA
WAITA, WSCHED
WAIT=JMP I WAITA
/SUBROUTINE DISPATCHES
SUBDSP=DATEND
*SUBDSP
IOR=JMS I .
IOR0 /INCLUSIVE OR
UUOEXT=JMP I .
UUOEX1 /UUO EXIT
FIUSER, DSUSER /QUEUE FILE REQUEST IN DSUBTL
ERROR=JMS I .
SYSERR /SYSTEM ERROR
TTYUSE=JMS I .
TTYSRC /FIND USER TTY
SCHED=JMP I .
SCHEDA, SCHEDI /SCHEDULE NEXT JOB NOW CORE RESIDENT
RSCHED=JMP I .
RSCHEA, SCHED0 /FIND NEXT JOB TO BE RUN
EXIT=JMP I .
EXITA, L2EXIT /LEAVE LEVEL 2
REDO=JMP I .
REDO0 /REPEAT IOT LATER WHEN (HOPEFULLY) IT CAN BE COMPLETED
KEY=JMS I .
KBD00 /PROCESS KEYBOARD INPUT INTO A USER'S INPUT BUFFER
SAVJOB=JMS I .
SAVJO0 /SAVE THE STATUS OF THE CURRENT JOB
RESJOB=JMS I .
RESJO0 /RESTORE THE PREVIOUSLY SAVED STATUS
START=JMP I . /START USER JOB
SUJ
DSGO=JMS I .
DSGO0 /START DISK REQUEST
GETJTW=JMS I .
GETJW0 /GET CONTENT OF JOB STATUS WORD (CURRENT JOB)
GETJTI=JMS I .
GETJI0 /GET CONTENT OF JOB STATUS WORD (ANY JOB)
DISMIS=JMP I .
DISMI0 /DISMISS INTERRUPTS
RUNABL=JMS I .
RUNTST /TEST IF SPECIFIED JOB IS RUNNABLE
SETFLG, PTSTAR
L2CON=SUBDSP+23 /LEVEL 2 (EXEC) CONTROL
*L2CON
L2SF, 100 /RELOCATION AND MODE
L2SV0, NULJOB /SAVED PC
L2SVLK, 0 /SAVED LINK
L2SA, 0 /SAVED ACCUMULATOR
FETCH=JMS I .
TOF /RETRIEVE A CHARACTER FROM A LINKED FREE CORE BLOCK
CLOCK, -1 /NUMBER OF SYSTEM TICKS PENDING ON LEVEL 2 (MINUS 1)
DEAD, 0 /CORTBL-1 OF JOB THAT SHOULD BE PUSHED OUT
SCHNEW, 0 /-1 TO ALLOW FULL TIME SLICES
C0010, 10
IFNZRO DC08A <
D6FLAG, -1 /ALLOW 689 ANSWER ONLY ONE TIME IN L2Q
D6ANSR, ANSWER >
/ROOM FOR PATCHES!!
RKSWSE, 0 /RK05 SECTOR FOR SWAPPING
RKADR, 0 /RK05 CORE ADDRESS FOR SWAPPING
DSWATA, DSWAIT
*CONDBA
0 /POINTER TO DEVTBL POSITION CURRENTLY UNDER CONSIDERATION
CONDDB, 0 /ADDRESS OF DDB UNDER CONSIDERATION
SEGLMK, 7400 /-WRDSEG
C7400=SEGLMK
BASWIN, -WINBAS-1
CJOBDA= JOBDAT
C0006, 6
C0070, 70
SEGSM1, /WRDSEG-1
C0377, 377
C0005, 5
C0600, 600
C3777, 3777
C6203, 6203
QUANTM,
C7776, 7776
C0177, 177
CURJOB, 0 /NUMBER OF JOB INTERRUPTED BY FILE TRANSFER
*150
UDF=JMS . /SELECT FIELD OF CURRENT JOB
WS2, 0
UUDF, 0 /DATA FIELD SELECT FOR FIELD OF CURRENT JOB
JMP I .-2
INTRC, 0 /TRACK # TO BE SWAPPED IN (DF32 0X00) (RF08 000X)
OUTTRC, 0 /TRACK # TO BE SWAPPED OUT
*42
FANCOR, CORTBL+1 /FIELD OF PHANTOM I.E. FIELD 2
*57
BONUS, 0 /JOB # JUST BROKEN OUT OF I/O WAIT
*157
IFZERO RKSYS <
SWPIOA, SWPIO
>
IFNZRO RKSYS <
SWPIOA, SWPIR
>
*45
SWPREA, SWPRET
/FIELD 0 PAGE DIRECTORY
IOTS=4000
DISC=IOTS+1400 /DISC CONTROL
*200
/PRIORITY LEVEL 0 (HIGHEST PRIORITY)
/KEEPS TRACK OF REAL TIME
/ALWAYS ENTERED BY CLOCK FLAG
/DISMISSES TO LEVEL 1 IF INTERRUPT WAS NOT FROM LEVEL 1
/OTHERWISE, DISMISSES TO INTERRUPTED LOCATION.
INT,
IFZERO CPU-2 <
SPL /POWER FAILURE?
JMP INTX0 /NO
JMP I .+1 /YES, HURRY UP AND SERVICE IT
POWINT
INTX0, >
IFZERO CPU-4 <
SPL /POWER LOW
SKP /NO
JMP .-2 /WAIT FOR POWER
CAL > /CLEAR POWER LOW CONDITION
SINT /USER IOT? (HAS TO BE CHECKED FIRST!!!)
IFZERO DC08A <JMP INT0 >
IFNZRO DC08A <SKP >/DC08?
JMP I UUOA /YES, GO SAVE LEVEL 2 STUFF
IFNZRO DC08A <
T1SKP /CLOCK?
JMP INT0 /NO, KEEP LOOKING
ISZ CLKCNT /YES, IS A SYSTEM TICK UP YET?
JMP I T8DISA /NO, RUN DC08 INTERRUPT SERVICE
DCA CLKIT /SAVE AC AT INTERRUPT
TAD L2TIMA /SCHEDULE L2TIME ON L2QUE
ISZ CLOCK /BUMP NUMBER OF TICKS TO COUNT AT LEVEL 2
CLA SKP /ALREADY SCHEDULED
DCA I L2Q
TAD CLKINI /RESET TIMER FOR NEXT TICK
DCA CLKCNT
TAD CLKIT /GET AC AT INTERRUPT
JMP I T8DISA /RUN DC08 SERVICE
T8DISA, T8DIS>
/INTERRUPTS OTHER THAN 680 (LEVEL 1)
/DISMISSES TO LEVEL 2 IF NOT FROM LEVEL 1 OR 2.
INTAC, 0 /AC AT LEVEL 1
INTLK, 0 /LINK AT LEVEL 1
UUOA, UUO0
INT0, DCA INTAC /SAVE AC AND LINK
RAR
DCA INTLK
IFZERO DC08A <
IFNZRO CPU-4 <CSCF> /SKIP AND CLEAR FLAG IF FLAG
IFZERO CPU-4 <CLSK> /SKIP IF CLOCK FLAG
JMP DTINT
IFZERO CPU-4 <CLCL> /CLEAR CLOCK FLAG
IFZERO CPU-1 <
CLA CMA /KW08
CCF CLB /CLEAR FLAG AND LOAD BUFFER
CECI > /ENABLE
ISZ CLKCNT /IT WAS CLOCK - WAS IT A SYSTEM TICK
JMP DISMI1 /NO - NOTHING TO DO THEN
TAD CLKINI /YES - SET FOR NEXT SYSTEM TICK
DCA CLKCNT
ISZ CLOCK
JMP DISMI1
TAD L2TIMA /SCHEDULE A SYSTEM TICK ON LEVEL 2
JMP DISMI0 >
DTINT, JMS DTCHK
DISMIS
IFNZRO D689 <
SRF
JMP D6CF
DFCRF /CLEAR THE RING FLAG
ISZ D6FLAG /HAVE WE GOTTEN MORE THAN ONE FLAG?
DISMIS /YES! DON'T OVERFLOW L2Q
TAD D6ANSR
DISMIS /SCHEDULE PHONE ANSWERING ON L2Q
D6CF, SCF
JMP RFINT
CCF /A CARRIER HAS CHANGED
TAD DFM4
DCA I TIM68A /TAKE A LOOK AT IT IN FOUR SECONDS
DISMIS
DFM4, -4
TIM68A, TIM689 >
RFINT,
IFZERO RKSYS <
IFZERO RF08-40 <DFSE /DF32 DISK ERROR?
JMP I DSWAIT /YES
DFSC /DF32 DISK COMPLETION FLAG?
JMP I INT2 /NOPE
>
IFZERO RF08 <DFSC DFSE /RF08 DISK?
JMP I INT2 /NO
DFSE > /RF08 ERROR?
ISZ DSWAIT /NO ERROR - TRANSFER OK >
IFNZRO RKSYS <
DSKP /DONE/ERROR?
JMP I INT2 /NEGATORY
DRST /GET RK05 STATUS
CLL RAL /MASK OFF TRANSFER DONE FLAG
SNA /ANY ERRORS?
ISZ DSWAIT /NOPE - TRANSFER OK
>
CLA
JMP I DSWAIT
DSWAIT, 0 /SET BY DISK SERVICE
INT2,
IFNZRO CDR <INTCDR> /CONTINUE IN THE INTERRUPT CHAIN
IFZERO CDR <RINT>
DTCHK, 0
IFNZRO CDR <RCSF > /CARD READER?
IFZERO CDR <JMP .+6 >
JMP .+5
CIF DATFLD-1
CDF
JMP I .+1
CDL11
IFNZRO RK05 < DSKP > /RK05?
IFZERO RK05 < JMP .+5 >
JMP .+4
CIF DATFLD
JMP I .+1
RKL11
IFNZRO TC01 <DTSF > /DECTAPE?
IFZERO TC01 <JMP .+11 >
JMP .+10
DTRA
AND C0004
SNA CLA
JMP .+4
CIF DATFLD
JMP I .+1
DTL11
ISZ DTCHK
F1RTN, JMP I DTCHK /THESE 3 DEVICES RETURN HERE FROM FIELD 1
INT7, TAD CLKIT
DCA I L2Q /QUEUE REQUEST
DISMI1, TAD INTLK /RESTORE LINK AND AC
CLL RAL
TAD INTAC
DISMI2, RMF /RESTORE IF, DF, & MODE
ION
JMP I 0 /BACK TO INTERRUPTED PROGRAM
L2TIMA, L2TIME
REST0,
CLKIT, 0 /TEMPORARY FOR AC
CLKCNT, -3 /WILL INITIALIZE ITSELF TO THE CORRECT VALUE
*322
CLKINI, 0 /SET BY INIT TO CAUSE 1 SYSTEM TICK TO = 100 M.S.
/DISMIS ROUTINE
/ENTERED FROM INTERRUPT HANDLER TO ENTER LEVEL 2 FROM LEVEL 1
/AC = ADDRESS OF LEVEL 2 SERVICE ROUTINE
/ OR 0 IF NO LEVEL 2 SERVICE REQUIRED
DISMI0,
C6201, CDF
SNA /DISMISS INTERRUPTS?
JMP DISMI1 /NO - BACK TO WHATEVER WAS GOING ON BEFORE
DCA CLKIT /SAVE DISPATCH
RIB /MODE BIT = 100
AND C0100
SNA CLA /FROM USER MODE?
JMP INT7 /NO - QUEUE REQUEST UNTIL LATER
TAD INTAC /MOVE THE AC TO LEVEL 2
DCA L2SA
TAD INTLK /MOVE LINK TO LEVEL 2
DCA L2SVLK
TAD 0 /MOVE PC TO LEVEL 2
DCA L2SV0
RIB
DCA L2SF /FIELDS AND MODE TO LEVEL 2
ION /DISMISS TO EXEC MODE, FIELD 0, LEVEL 2
JMP I CLKIT
/RESTORE INTERRUPTED STATE
RESTOR, DCA REST0 /POINTER TO SAVED INFO
TAD I REST0 /SAVED FIELDS AND STATE
AND C0070 /GET INSTRUCTION FIELD
TAD C6203
DCA RCIF /CIF FOR PROPER FIELD
TAD I REST0
CLL RTL
RAL
AND C0070 /CDF FOR RETURN
TAD C6201 /NOT NECESSARILLY EQUAL TO INSTRUCTION FIELD
DCA RCDF
TAD I REST0
AND C0100 /USER PROGRAM, FIP OR SI?
SZA CLA
SUF /USER MODE; SET USER FLAG
ISZ REST0
TAD I REST0 /PC
DCA 0
ISZ REST0
TAD I REST0 /LINK
CLL RAL
ISZ REST0
CLA
TAD I REST0 /AC
RCIF, 0
RCDF, 0
ION
JMP I 0 /BACK TO INTERRUPTED PROGRAM
/RETURN ADDRESS OF LINKED TABLE ENTRY
/CALL TAD TABLE ENTRY ADDRESS
/ GETJTA
/ ENTRY NAME (NUMBER)
/ RETURN
GETJTB, 0
DCA GETJT1 /SAVE JOBTABLE ADDRESS
TAD I GETJTB /ENTRY #
DCA GETJT2
RDF /FIELD CALLED FROM
TAD C6203
DCA GETJT3 /SO WE CAN GET BACK
DATFLD /CHANGE TO DATA FIELD
DCA I GETJTZ /CLEAR FLD 1 LOC. 0
GETJ1, TAD I GETJT1 /GET JOBTBL ENTRY
CLL /TO LET CALLER KNOW IT DOESN'T EXIST
SNA /LINK 0?
JMP GETJ3 /YES - RETURN 0
DCA GETJT1 /NO, JOB DATA ADDRESS
TAD GETJM7
TAD GETJT2 /ARE WE IN PROPER BLOCK?
SPA /ENTRY<7?
JMP .+3 /YES
DCA GETJT2 /NO, LINK TO NEXT
JMP GETJ1 /AND TRY AGAIN
STL CLA IAC /SET LINK TO LET CALLER KNOW WE WERE SUCCESSFUL
TAD GETJT2 /INDEX INTO BLOCK
TAD GETJT1 /START OF BLOCK
GETJ3, ISZ GETJTB /SKIP CALLING ARGUMENT
GIRSB,
GETJT3, 0 /BACK TO CALLING FIELD
JMP I GETJTB
GETJTZ, 0 /POINTER TO LOC. 0 OF FIELD 1 (NOT FOR TEMPORARY STORAGE)
GIRSCT, /POINTER TO ITEM COUNT
GETJT1, 0
GIRST,
GETJT2, 0
GETJM7, -7
/STORE CHARACTER
/CALL WITH ADDRESS OF DDB IN AC, CHARACTER IN TTCHAR
/ STORE
/ ADDRESS OF ROUTINE TO CHECK BUFFER SIZE
/ WON'T FIT
/ OK
EMPTY=WS1
DBINPA=C0004
GIRSC, 0
TAD DBINPA
DCA GIRSB /POINTS TO ADDRESS OF BUFFER
TAD I GIRSB
SNA /IS BUFFER SET UP? (I.E. IS FILL POINTER NON ZERO?)
JMP GIRSC8 /NO - GO GET A BUFFER
DCA GIRSCT /POINTER TO FILL COUNT
ISZ I GIRSCT /ANY ROOM LEFT?
JMP GIRSC1 /YES
CDF
TAD I GIRSC /GET ADDRESS OF SIZE SUBROUTINE
DATFLD
DCA GIRST
TAD GIRSB
IAC /POINT TO CHARACTER COUNT
JMS I GIRST /GO CHECK BUFFER SIZE
JMP GIRSC0 /BUFFER ALREADY FULL - NO ROOM FOR THIS ENTRY
GIRS11, CLL CLA CMA RTL /IS THERE ENOUGH (I.E. 3 BLOCKS) FREE CORE LEFT?
TAD FRECNT
SPA SNA CLA
JMP GIRSC0 /NO - DON'T GIVE HIM ANOTHER BUFFER NOW
TAD GIRSCT /OK - GET A BUFFER
CDF
GETBLK /NO, LINK NEW BUFFER
JMP GIRSC0 /NONE AVAILABLE
DATFLD
TAD I GIRSCT /POINTER TO HEAD OF NEW BUFFER
DCA I GIRSB /BUFFERS NOW CHAINED TOGETHER
GIRSC7, TAD I GIRSB
DCA GIRSCT /POINT TO NEW FILL COUNT
TAD GIRSIZ /INITIALIZE CHAR COUNT TO -12
DCA I GIRSCT /AND SAVE IN NEW BLOCK
GIRSC1, TAD I GIRSCT /ARE WE DOING LAST THREE CHARACTERS IN BLOCK?
TAD C0003
SMA
STL RAL /YES SO MULT. BY 2 THEN ADD 1
SPA /PACK?
STL CIA /NO - GET ADDRESS WITHIN BUFFER
TAD I GIRSB /START OF BUFFER
DCA GIRSCT /ADDRESS TO STORE CHARACTER
TAD TTCHAR
SNL /PACK?
JMP GIRSC4 /YES
AND C0377
GIRSC5, DCA I GIRSCT /STORE CHARACTER
ISZ GIRSB /POINT TO CHARACTER COUNT
ISZ I GIRSB /COUNT THIS ENTRY
ISZ GIRSC /INDICATE SUCCESS
GIRSC3, ISZ GIRSC /TO SKIP PAST ARG.
JMP I GIRSC
GIRSC4, RTL /SHIFT BITS TO LEFT
RTL
AND C7400
TAD I GIRSCT /AND SAVE IN CURRENT LOCATION IN BUFFER
DCA I GIRSCT
ISZ GIRSCT /NEXT LOCATION IN BUFFER
TAD TTCHAR /GET LOW 4 BITS FROM CHARACTER
RTR
RTR
RAR
AND C7400 /AND COMBINE WITH PREVIOUS CHARACTER
TAD I GIRSCT /SAVE THE WHOLE MESS
JMP GIRSC5 /AND AWAY
GIRSC8, CDF /ATTACH A BUFFER TO FILL POINTER
TAD GIRSB /LINK ADDRESS
GETBLK
JMP GIRSC3 /CAN'T GET ONE - TOO BAD
DATFLD /OK - SET UP POINTERS
STL RTL / 2 PLUS
TAD GIRSB /ADDRESS OF FILL POINTER
DCA EMPTY / = ADDRESS OF EMPTY COUNT
STA
TAD GIRSIZ /-13 TO THE EMPTY COUNT
DCA I EMPTY
ISZ EMPTY /NOW INITIALIZE THE EMPTY POINTER
TAD I GIRSB /SET EMPTY POINTER EQUAL TO FILL POINTER
DCA I EMPTY /SINCE IT'S THE ONLY BUFFER
JMP GIRSC7
GIRSC0, DATFLD /COULDN'T SQUEEZE CHARACTER IN
STA /BUT WE ALREADY BUMPED FILL COUNT
DCA I GIRSCT /INDICATE CURRENT BLOCK IS STILL FULL
JMP GIRSC3 /AND EXIT WITHOUT SKIPPING
GIRSIZ, -12 /10 (DECIMAL) CHARACTERS/BLOCK
OVRLA1, JMS I FIUSER
WAIT
REMJOB, 0
TAD SCHNEW /GET NEW JOB MASK
AND JOB /AND THE CURRENT JOB
DCA CURJOB /IF THERE'S A JOB; REMEMBER HIM/HER
SAVJOB /SAVE HIS/HER STATE
STA
DCA SCHNEW /SET MASK FOR FULL SLICE
JMP I REMJOB
READFI, TAD SIREG /FIND RESIDENT FIELD FOR THIS JOB
FILCON, DCA WS0
JMS REMJOB /BUMP OFF THE PRESENT USER - BUT MAYBE REMEMBER WHO HE IS
TAD WS0
CORE
CJOB /ANY FIELD WITH THIS JOB IN IT IS OK
HLT /IF IT'S NOT THERE IT'S DOOMS DAY FOR ALL
DCA L2SF /RESTORE FOR THIS JOB
TAD WS0
RUNFI, RESJOB /RESTORE LEVEL TWO FOR THIS JOB
GETJTW /GET ADDRESS OF FILE PARAMETER BLOCK
JOBLNK
JMP I SIFILA /AND OFF TO THE FILE HANDLER
/RETURN BLOCK TO FREE LIST
/CALL TAD BLOCK ADDRESS
/ RETBLK
/ RETURN WITH LINK IN AC
RETB, 0
DCA RETB1 /SAVE BLOCK ADDRESS
RDF
TAD C6203
DCA RETF /FOR RETURNING TO CALLER
TAD RETB1
CLL
TAD RETEND /SEE IF IT'S FIP'S BLOCK OR A FILL COUNT FOR A LINKED BUFFER
SZL CLA
JMP RETF /IT IS - DON'T RELEASE IT
TAD RETB1
SNA
HLT /SHOULD NEVER RETURN 0000
AND C0007
SZA
HLT /SHOULD ALWAYS BE XXX0
DATFLD
TAD I RETB1 /NOW GET THE LINK, IF ANY
DCA RETBL /SAVE IT
TAD FREE /GET OLD START OF FREE LIST
DCA I RETB1 /PUT IT IN LINK
TAD RETB1 /PUT ADDRESS OF THIS BLOCK
DCA FREE /AS START OF FREE LIST
ISZ FRECNT /INCREMENT FREE
TAD RETBL
RETF, 0 /RETURN WITH LINK
JMP I RETB
RETEND, -FIPBLK
SIFILA, SIFILE
SJCOPY, JSIOTC
SUJERR= C0007
/RESTART USER JOB AT RESTART ADDRESS
GIR90, CIA /NEGATE THE JOB NUMBER
TAD JOB /IS THE JOB CURRENTLY RUNNING?
SZA CLA
JMP GIR91 /NO
TAD I WS0
DCA L2SV0 /SET PC=RESTART ADDRESS
DCA L2SVLK /SET LINK=0
DCA L2SA /SET AC=0
JMP I GIR0A /LEAVE
GIR91, TAD I WS0
DCA I JOBSWA /SET PC=RESTART ADD
ISZ JOBSWA
STA
DCA I JOBSWA /SET LINK=-1 SO WE'LL REMEMBER TO CLEAR HIS'HER LINK & AC LATER
JMP I GIR0A
GIR0A, KBD01
CNOTR, -NOTRUN-1
/START USER JOB
SUJ, TAD L2SF /CLEAR NOTRUN FLAG SO JOB CAN BE SWAPPED
AND C0007 /GET CORTBL INDEX
TAD CORTBA
DCA SUJSRC /POINTS TO ENTRY IN CORTBL FOR THIS JOB
TAD I SUJSRC /GET CORTBL ENTRY
AND CNOTR /CLEAR NOT RUN BIT
DCA I SUJSRC /SAVE ENTRY
TAD JOB /IS IT A PHANTOM?
AND C0600
SUJ2, SZA CLA
EXIT /YES - WE'RE ALL SET
SUJ5, GETJTW /NO, IOT RESULTS TO USER?
JOBSTS
AND SJCOPY /IOTC BIT IN STR0
DATFLD
SNA
JMP SUJ4 /NO - WAS THERE A SYSTEM ERROR?
CMA /CLEAR THE BIT
AND I JOBSWA /JSIOTC:=0
DCA I JOBSWA /SAVE NEW STR0
CDF /GET # ARGUMENTS TO RETURN
GETJTW
JOBLNK
DCA SUJSRC /POINTS TO WORD1 OF PARAMETER BLOCK
DATFLD
TAD I SUJSRC /IOT IN QUESTION
CDF
RAR /SAVE "WHO FINF" INDICATOR IN LINK
AND C0004
SNA CLA /WAS BIT 8 ON?
JMP SUJ3 /NO - MUST HAVE BEEN AN RFILE OR WFILE WINDOW TURN
CML CMA RAL
CLL RTL /CA=-3 FOR "WHO"; AC=-7 FOR "FINF"
DCA SUJCNT /SAVE COUNT
TAD SUJSRC /RETURN PARAMETER BLOCK
RETBLK
CLA
ISZ SUJSRC /POINTS TO WORD 2 OF BLOCK
TAD UUDF /TRANSFER RESULTS TO USER'S FIELD
DCA SUJDFS /...SET FIELD IN BLT CALL
TAD L2SA /POINTS TO USER'S PARAMETERS
DCA SUJDES /SAVE FOR BLT
DCA L2SA /CLEAR HIS/HER AC
BLT /MOVE RESULTS TO USER
DATFLD /FROM FIELD 1
SUJSRC, 0 /SOURCE ADDRESS
RETBL,
SUJDFS, 0 /TO USER FIELD
RETB1,
SUJDES, 0 /AT THIS ADDRESS
SUJCNT, 0 /-WORD COUNT
TAD JOB
RUNABL /IS HE STILL RUNNABLE?
WAIT /NO - JUST NEEDED TO PASS THE INFO TO HIM/HER
JMP SUJ5
SUJ3, TAD SUJSRC /UFILE RETURN
JMP I SIFILA
SUJ4, ISZ JOBSWA /POINT AT STR1
TAD I JOBSWA
STL RTR /PLACE SYSTEM ERROR PENDING BIT IN LINK
SNL /IS THERE AN ERROR?
JMP SUJ2 /NO; GO CLEAR AC AND EXIT
/ROUTINE TO START USER JOB AT ERROR ADDRESS
/DOES A JMS TO ERROR ADDRESS
/USER PC AT TIME OF ERROR TO ADDRESS; JMP TO ADD+1
CLL RTL /CLEAR THE ERROR PENDING BIT
DCA I JOBSWA /TO AVOID A SECOND JMS TO HIS ERROR ROUTINE
TAD JOBSWA
TAD C0005
DCA JOBSWA /POINTS TO ERROR RESTART ADD
TAD I JOBSWA /ERROR ADDRESS
DCA WS0
TAD L2SV0 /OLD PC
UDF /GET USER'S FIELD
DCA I WS0 /SAVE OLD PC
IAC
TAD WS0 /ERROR ADDRESS + 1
DCA L2SV0 /NEW PC
EXIT
/PAPER TAPE READER SERVICE FOR TSS/8
UPTR, JMS I PTRCHK /DOES HE OWN DEVICE?
PTRDEV, DEVTBE /POINTS TO READER ENTRY IN DEVTBL
TAD URCBI /CHECK FOR "RCB"
TAD UUOCAL
SNA CLA
JMP URCB /IT IS!
JMS I PTRIOT /ANALYZE IOT
JMP URRS /READ A STRING
PTRFL, JSPTR /READER FLAG
JMP I PTRSKP /WE ALWAYS SKIP
SNL CLA /RRB?
UUOEXT /NO - MUST HAVE BEEN RFC - SO WHAT!
DCA WS0 /SET READER'S BREAK MASK TO 0
DATFLD
TAD I PTRDEV /ADDRESS OF DDB
FETCH /FETCH A CHARACTER FROM READER BUFFER
JMP PSTWT0 /NONE AVAILABLE - START READER
DCA PTRCH /SAVE FOR NEXT RRB
CDF
TAD PTRACA /POINTS TO L2SA
IOR /OR CHARACTER INTO L2SA
PTRCH, 0
UUOEXT /EXIT TO USER
PTRSKP, UUOEX2
URRS, DATFLD
TAD I PTRDEV /GET DDB ADDRESS
DCA CONDDB
JMS I PSTRIN /TRANSFER STRING TO USER
JMP PSTWT0 /INSUFFICIENT NUMBER OF CHARACTERS IN BUFFER
UUOEXT
URCB, DATFLD
TAD I PTRDEV /CLEAR THE ENTIRE READER BUFFER
JMS I PTRCLR
UUOEXT
PSTWT0, STA
L2PTR1, DCA PTRSET /REMEMBER WHY WE ARE HERE
CDF CIF /SELECT F0 AND INHIBIT INTERRUPTS
TAD I PTRTIM /IS THE READER BUSY?
SNA CLA
RFC /START THE READER
CLL STA RAL /AC=-2
DCA I PTRTIM /SET READER TIMER
DCA I RCNTA /NO LIMIT UNTIL IT'S READ AT LEAST ONE BLOCK WORTH
ISZ PTRSET /FROM UUO OR LEVEL 2?
EXIT /LEVEL 2 - FINISHED
STA
TAD L2SV0 /BACK UP HIS PC FOR A REDO
DCA L2SV0
TAD PTRFL
UUOEXT /NOW WAIT FOR THE READER
PTRSIZ, 0
DCA PTRSET /SAVE POINTER TO CHARACTER COUNT
ISZ PTRSIZ /WE ALWAYS SUCCEED
CDF CIF /NO INTERRUPTS WHILE WE CHECK THE READER'S STATUS
TAD I PTRTIM
SMA CLA /IS IT STILL RUNNING?
JMP PTRSI2 /NO - JUST MAKE SURE THE FLAG IS SET
TAD FRECNT /HOW'S THE SUPPLY OF FREE CORE?
TAD C7770
SMA SZA CLA
TAD PTRFUL /MINUS NUMBER ALLOWED
DATFLD
TAD I PTRSET /PLUS CURRENT CHARACTER COUNT
CDF
SMA
STA /SHUT DOWN THE READER AFTER THE NEXT CHARACTER
DCA I RCNTA
TAD I RCNTA
TAD C0100
SMA CLA
PTRSI2, JMS PTRSET /SET THE READER FLAG IN STR1
JMP I PTRSIZ
L2PTR, JMS PTRSET /WAKE HIM/HER UP - HE'S HUNG
TAD I PTRDEV /DDB?
SNA
EXIT /NO
DCA AXS2 /YES - SAVE IT, WE'LL NEED THE JOB # FROM IT
TAD AXS2
TAD C0004
DCA WS0
TAD I WS0 /IS IT EMPTY?
SZA CLA
EXIT /NO - SO IT ISN'T OFFICIALLY HUNG YET
TAD I AXS2 /JOB OWNING PTR
CDF
ERROR /REPORT THE HUNG READER TO HIM/HER
HUNGDV
EXIT
PTRSET, 0
DATFLD
TAD PTRDEV /READER'S POSITION IN DEVTBL
DCA CONDBA
TAD PTRFL
JMS I SETFLG /SET JSPTR IN STR1
JMP I PTRSET
PTRCHK, DEVCHK
PTRIOT, UKT1
PSTRIN, UKREAD
PTRTIM, TIMPTR
RCNTA, RCNT
URCBI, -6017
PTRCLR, CLRBUF
PTRFUL, -240
/ROUTINE TO HANDLE EASY DECTAPE STUFF
/LIKE DTSF AND DTRB
/DTSF ALWAYS SKIPS
UDTRBS, ISZ L2SV0 /BUMP HIS PC
PTRACA, L2SA /TRICKY, TRICKY
UDTRB, GETJTW /GET LAST VALUE OF STATUS B
JOBSTB
DCA L2SA /GIVE IT TO USER
UUOEXT
C4000, 4000
MCSCQ, -4044 /COVERS BOTH ^Q AND ^S
CONSQ, 0
ISZ CONDBA /POINT TO OUTPUT SIDE IN DEVTBL
TAD TTCHAR
CLL RTR
TAD MCSCQ /CHECK FOR ^Q AND ^S
SZA CLA
JMP I CONSQ /NEITHER
TAD I CONDBA
SNA
JMP I CONSQ /DOESN'T HAVE AN OUTPUT DDB - SO ^S/^Q MEANS NOTHING
DCA WS2 /ADDRESS OF OUTPUT DDB
TAD I WS2
AND C3777 /CLEAR THE BIT FIRST
SNL /NOW WHICH WAS IT?
TAD C4000 /^S - SET THE BIT TO INHIBIT HIS/HER TTY FROM PRINTING
DCA I WS2 /SAVE UPDATED STATUS
SZL /WHICH WAS IT AGAIN?
JMS TYPE /^Q - START HIM/HER TYPING IF HE HAS ANYTHING TO TYPE
JMP I .+1 /TAKE SUCCESSFUL EXIT THROUGH "KEY"
KBDXIT
/MULTI-FIELD ROUTINE TO OUTPUT TO A TTY, PTP, OR LPT
/CALL: CONDBA CONTAINS POINTER TO POSITION IN DEVTBL
/ TTCHAR CONTAINS CHARACTER TO BE OUTPUT
/ PRINT
/ NO ROOM IN OUTPUT BUFFER
/ OK
PRINT0, 0
RDF
TAD C6203
DCA PRINTX /REMEMBER FROM WHENCE WE CAME
DCA EMPTY /CLEAR EMPTY BUFFER INDICATOR
PRINT1, DATFLD
TAD I CONDBA /GET ADDRESS OF DDB
SNA
JMP PRINT2
STORE /STASH THE CHARACTER IN HIS BUFFER
OUTSIZ /ADDRESS OF SIZE CHECK ROUTINE FOR OUTPUT
JMP PRINTX /WOULDN'T FIT
ISZ PRINT0 /OK - SKIP ON RETURN
TAD EMPTY /WAS THE BUFFER EMPTY?
SZA CLA
JMS TYPE /YES - BETTER START THE HARDWARE
PRINTX, .-. /FIELD SELECT
JMP I PRINT0 /AND BACK
PRINT2, TAD CONDBA /NO BUFFER SETUP YET
CDF
GETBLK /CREATE A PSEUDO DDB
JMP PRINTX /NO BLOCKS AVAILABLE
JMP PRINT1
TTOFLB, TTOFLG
CORSR4,
TYPE, 0
TAD CONDBA /DEVTBL POINTER
TAD OUTOFF /MINUS DIF.
CLL RAR /DIVIDE BY 2
DCA OUTSIZ / = OUTREG POINTER
CIF /NO INTERRUPTS
TAD I OUTSIZ
AND C4001
SZA CLA /CHECK SERVICE AND CHARACTER FLAGS
JMP I TYPE /CHARACTER WILL BE TAKEN BY AN INTERRUPT
STL RAR
TAD I OUTSIZ /SET THE SERVICE FLAG
DCA I OUTSIZ
CDF
DCA I TTOFLB /SCHEDULE LEVEL 2 TO PRINT IT
JMP I TYPE
CORSR2,
OUTSIZ, 0
DCA TYPE /SAVE POINTER TO CHARACTER COUNT
TAD I TYPE /CURRENT COUNT
SPA /DOES IT INCLUDE A FILLER CHARACTER COUNT
AND C0377 /YES - DISREGARD IT
DCA TYPE /THE ACTUAL COUNT TO COMPARE WITH
TAD PRINTX
AND C0070
SZA CLA
JMP OUTSI1 /CALLED FROM SI
TAD CONDBA
CLL
TAD LPTSIZ /ALLOW LINE PRINTER BUFFER TO GOBBLE UP ABOUT 40% OF FREE CORE
AND FRECNT
AND C0400 /DON'T LOOK AT TOO MUCH FREE CORE
SNA
TAD FRECNT
SZL
CLL RTL /THE LINE PRINTER GETS 4 TIMES AS MUCH
CIA
OUTSI2, TAD TYPE /CURRENT COUNT
TAD OUTLIM
SPA CLA
ISZ OUTSIZ /STILL ROOM
JMP I OUTSIZ
OUTSI1, TAD C7366
JMP OUTSI2
C4001, 4001
C7366, 7366
OUTLIM, 25
LPTSIZ, -DEVTBE-3
OUTOFF, -OUTDIF
/SEARCH FOR JOB IN CORE
/CALL TAD JOB #
/ JMS CORSRC
/ MASK
/ NOT THERE, AC:=0
/ THERE, SAVE FIELD IN AC
/THESE TWO WORDS MUST IMMEDIATELY PRECEDE CORSRC
/THEY MUST ALSO BE ORIGINED AT CORSRC-2
*CORSRC-2
CORCNT, 0 /INIT TO -NUMBER OF USER FIELDS
CORTBE, 0 /INIT TO -((END OF CORTBL)+1)
CORSRC, 0 /ENTER WITH BIT PATTERN TO MATCH
AND I CORSRC /MASK AS SPECIFIED
CIA
DCA CORSR4 /-WHAT WE WANT
RDF /FIGURE OUT WHENCE WE CAME
TAD C6203
DCA CORSR3 /SO WE CAN RETURN
TAD I CORSRC /GET THE MASK
DCA CORSR2 /SAVE IT
ISZ CORSRC /SKIP PAST MASK IN CALL
CDF
TAD CORCNT /-# ENTRIES TO CHECK
DCA AXS1 /USED AS COUNTER
CORSR1, ISZ CORTBP /INCREMENT TABLE POINTER
TAD CORTBP /ARE WE AT END OF TABLE?
TAD CORTBE
SPA CLA
JMP CORSR5 /NO
STL RTL
TAD CORTBA /YES, START ALL OVER AT FIELD 2
DCA CORTBP
CORSR5, TAD I CORTBP /GET TABLE ENTRY
AND CORSR2 /MASK IT
TAD CORSR4 /COMPARE WITH DESIRED ENTRY
SNA CLA
JMP CORSR6 /FOUND IT!
ISZ AXS1 /NOT YET
JMP CORSR1 /KEEP GOING
CORSR3, 0 /RETURN WITH AC=0
JMP I CORSRC
CORSR6, TAD CORTBA /WE HAVE IT; GET CORTBL INDEX
CIA
TAD CORTBP
DCA AXS1 /FIELD #
TAD CORSR4 /WE HAVE TO SET MODE BIT APPROPRIATELY
CIA /RECOMPLEMENT CALLING JOB #
AND C0600 /A PHANTOM?
SNA CLA /EXEC MODE?
TAD C0010 /NO - SET USER MODE BIT
TAD AXS1 /SET UP SAVE FIELD
CLL RTL /SHIFT AND ADD DATA FIELD
RAL
TAD AXS1
ISZ CORSRC /SKIP TO INDICATE SUCCESS
JMP CORSR3 /BACK
CORTBP, CORTBL+1 / "ROUND-ROBIN" POINTER
/WHEN THE USER EXECUTES A "SEA" IOT,
/WE MUST DO TWO THINGS:
/ 1) SET THE ERROR ENABLE BIT IN STR0
/ 2) SAVE THE USER'S AC IN THE JOB DATA AREA
/ JSEREN IS SET HERE
/ WE GO TO USEA1 TO SAVE THE ERROR ADDRESS
/JSEREN MAY BE CLEARED BY .RUN, START, OR
/A USER EXECUTING A "CLEAR STATUS" IOT.
USEA, DATFLD /SET JSEREN WHEN USER EXECUTES SEA
TAD I CJOBDA /POINTS TO WORD 0 OF JOB DATA AREA
IAC /POINTS TO STR0
IOR /OR IN JSEREN
JSEREN
CDF
JMP I .+1
USEA1 /GO PICK UP ERROR ADDRESS
/GET A BUFFER FROM FREE LIST
/CALL TAD (ADDRESS TO STORE LINK)
/ GETBLK
/ NONE AVAILABLE
/ OK WITH LINK STORED
GETB,
GETDB2, 0
DCA GETBT /SAVE ADDRESS TO SAVE PTR
RDF /SAVE CALLING FIELD
TAD C6203
DCA GETB1 /SO WE CAN GET BACK
DATFLD
TAD FREE /ANY BUFFERS LEFT?
SNA
JMP GETB1 /NONE LEFT
DCA I GETBT /STORE LINK IN ADDRESS SPECIFIED
STA /NOW WE'LL BE GOOD GUYS
TAD FREE /AND PREPARE TO CLEAR THE BUFFER
DCA AXS1
TAD I FREE /REMOVE FROM FREE LIST
DCA FREE /SET NEW POINTER TO FREE LIST
ISZ GETB /INDICATES SUCCESS
STA /DECREMENT FREE COUNT
TAD FRECNT
DCA FRECNT
TAD C7770 /8 WORDS TO ZERO
DCA GETBT
DCA I AXS1
ISZ GETBT /DONE?
JMP .-2 /NO
GETB1, 0 /RETURN
JMP I GETB
USTM, TAD L2SA /GET UNITS OF TIME IN AC
DCA USTM1 /SAVE IT
DCA L2SA /ZERO USER'S AC
TAD USTM1
SNA /ANY TIME SPECIFIED?
UUOEXT /NO, SO DON'T SLEEP
JMP I USTM2 /YES, GO PUT TO SLEEP
USTM2, DOUSTM
/GET A DATA BLOCK
/CALL TAD LINK
/ GETDDB
/ NONE AVAILABLE
/ OK
GETDB0,
DEVWT0, 0
DCA GETDB1 /ADDRESS OF DDB POINTER (USUALLY IN DEVTBL)
RDF
TAD C6203
DCA GETDB5 /SAVE CALLING FIELD SO WE CAN GET OUT
CDF
TAD GETDB1 /GET A BUFFER FROM FREE CORE
GETBLK
JMP GETDB5 /SORRY
DATFLD
ISZ GETDB0 /SUCCESSFUL RETURN
TAD I GETDB1
TAD C0003
DCA GETDB1 /SAVE IT
TAD CLK1 /GET LOW ORDER CLOCK
RTL /AND SHIFT BITS 0-2 INTO AC 9-11
RTL
AND C0007 /GET MOST SIGNIFICANT BITS FROM LOW ORDER
DCA GETDB2 /SAVE THEM
TAD CLK2 /GET HIGH ORDER TIME
RTL /SHIFT LEFT 3 PLACES
RAL
AND C7770 /KEEP BITS 0-8
TAD GETDB2 /ADD COMPONENT DERIVED FROM CLK1
DCA I GETDB1 /SAVE IN DDB
GETDB5, 0 /RETURN
JMP I GETDB0
CTIMER, -5
TIMCOA, TIMCON
CONJMS, JMSTIM
TTIMEB, TTIMER
L2OUT, TAD CTIMER /AC=-5
DCA I TIMCOA /RESET THE OUTPUT MASTER TIMER
TAD CONJMS
DCA I TTIMEB /PLACE THE TIMER "HOOK" IN CONOUT
DCA I TTOFLC /SCHEDULE CONOUT FOR LEVEL 2
/BEFORE DISMISSING BACK TO USER JOB, IT IS A GOOD IDEA TO CHECK AND SEE IF ANY OTHER
/LEVEL 2 PROCESSING HAS BEEN SCHEDULED WHILE WE WERE WORKING ON THE LAST REQUEST
/WE CAN ASCERTAIN IF THIS IS THE CASE BY COMPARING THE L2QUE EMPTY AND
/FILL POINTERS -- IF THEY ARE EQUAL, THEN WE'RE DONE, AND CAN GO TO L2EX1,
/WHERE BOTH POINTERS ARE RESET. IF UNEQUAL, WE GET THE NEXT ENTRY POINTED
/TO BY L2QE, AND DISPATCH TO IT LEAVE LEVEL 2
L2EXIT, CDF
IOF /NO INTERRUPTS WHILE CHECKING L2QUE STATUS
CLA
TAD I L2KEY
SZA CLA
JMP I CONINP /KEYBOARDS NEED SERVICE - TAKE CARE OF THEM FIRST
L2EX0, TAD L2Q /ARE FILL AND EMPTY POINTERS EQUAL?
CIA
TAD L2QE /-FILL PTR + EMPTY PTR
SNA CLA
JMP L2EX1 /YES - WE ARE CAUGHT UP
TAD I L2QE /NO; GET ADDRESS FROM L2QUE
DCA JOBSWA
ION /INTERRUPT BACK ON
JMP I JOBSWA /DISPATCH
L2EX1, TAD L2QTA
DCA L2QE
TAD L2QTA
DCA L2Q /RESET FILL POINTER
TAD I TTOFLC
SNA CLA
JMP I CONOUA /PRINTERS NEED SERVICE
TAD L2SFA
JMP I .+1 /NOW BACK TO WORK
RESTOR
TTOFLC, TTOFLG
CONOUA, CONOUT
L2QTA, L2QTB-1
L2KEY, KEYC
CONINP, CONIN
L2SFA, L2SF
KBDJOA, DEVJOB
GETDB1,
CLST0,
KBDDLM, 0 /ROUTINE TO SET DELIMITER FLAG IN STR1
TAD CONDDB
JMS I KBDJOA /GET JOB #
DCA BONUS /GIVE HIM/HER HIGHEST SCHEDULER PRIORITY
TAD C0100 /JSDEL
JMS I SETFLG /SET HIS/HER DELIMITER BIT
JMP I KBDDLM /AND BACK
GETBT,
USTM1,
CLSTR1, 0 /ROUTINE TO CLEAR BITS IN STR1
CMA /ENTER WITH BITS TO CLEAR IN AC
DCA CLST0 /SAVE MASK OF BITS TO SAVE
CDF
GETJTW /GET CURRENT SETTING OF STR1
JOBSTS+1
AND CLST0 /CLEAR SELECTED BITS
DATFLD
DCA I JOBSWA /SAVE CLEARED STATUS REGISTER
JMP I CLSTR1 /RETURN
URK050, TAD C0005
UDTXA0, TAD C0002
CLL RAR
CIF DATFLD-1 /FIELD 1 DTA UUO SERVICE
JMP I .+1
UUDTRK
*FISUBL+1202
/BLOCK TRANSFER
/CALL BLT
/ 62S1 SELECT SOURCE DATA FIELD
/ SOURCE
/ 62D1 SELECT DESTINATION DATA FIELD
/ DESTINATION
/ -NUMBER WORDS
/ RETURN
BLT0,
RUNTDB, 0
TAD I BLT0 /GET SOURCE FIELD SELECT
DCA BLT1 /SAVE
ISZ BLT0 /POINTS TO SOURCE ADDRESS
STA
TAD I BLT0 /CORE ADDRESS -1 OF SOURCE
DCA AXS1 /AUTO INDEX
ISZ BLT0 /POINTS TO DESTINATION FIELD SELECT
TAD I BLT0 /GET DESTINATION SELECT
DCA BLT2 /SAVE
ISZ BLT0 /POINTS TO DEST. ADD
STA
TAD I BLT0 /DEST. ADD-1
DCA AXS2 /AUTO INDEX
ISZ BLT0 /POINTS TO -WORD COUNT
TAD I BLT0
DCA BLTC /SAVE
ISZ BLT0 /RETURN ADDRESS
RDF
TAD C6203
DCA BLTF /SAVE RETURN FIELD SELECT
BLT1, 0 /SELECT SOURCE DATA FIELD
TAD I AXS1
BLT2, 0 /SELECT DESTINATION DATA FIELD
DCA I AXS2
ISZ BLTC /DONE?
JMP BLT1 /NO
BLTF, 0 /RETURN
JMP I BLT0
/TEST JOB FOR RUNNABILITY
/CALL TAD JOB #
/ RUNABL
/ NOT RUNNABLE
/ RUNNABLE
BLTC,
RUNTST, 0 /COME HERE WITH JOB # IN AC
TAD JOBTBA /TO GET JOBTABLE ADDRESS
GETJTI /GET STR0
JOBSTS
SMA /RUN BIT ON?
JMP RUNTS3 /NO
DATFLD /YES, SEE IF IT RAN AS A COMPUTE BOUND JOB LAST TIME
AND C1000 /IS BIT 1000 ON SHOWING THAT IT WAS A COMPUTE BOUND JOB?
SNA /SNA
JMP RUNTS2 /NO, IT MAY BE READY TO RUN - TEST FURTHER
CMA /LAST TIME IT WAS COMPUTE BOUND, SKIP THIS TURN
AND I JOBSWA /CLEAR THE BIT 1000, SO THAT IT WILL RUN NEXT TIME
DCA I JOBSWA
JMP RUNTS1 /RETURN BY NOT RUNNABLE EXIT
RUNTS2, ISZ JOBSWA /GET THE ADDRESS OF STR1
TAD I JOBSWA
ISZ JOBSWA
ISZ JOBSWA /POINT TO WAIT MASK 1
AND I JOBSWA /ANY STR1-MASK1 MATCHES?
SZA CLA
ISZ RUNTST /YES
RUNTS1, CDF /NO
JMP I RUNTST
RUNTS3, AND RC0147
SNA /FIP REQUEST STILL PENDING? OR ANY ERRORS SINCE HE STOPPED?
JMP I RUNTST /NONE
AND C0007 /IS IT FOR FIP OR SI?
SNA CLA
JMP RUNTS1-1 /FIP - LET HIM FINISH UP SO WE DON'T LOSE A FREE CORE BLOCK
DATFLD
CLL CMA RTR
AND I JOBSWA /CLEAR HIS ERROR ENABLE
DCA I JOBSWA
JMP RUNTS1-1 /ERROR - LET SI REPORT IT NOW
RC0147, JSIOT JSIOTC UUOERF SWPRER SWPWER DSKERR HUNGDV
SIWAIT, 0
L2SI, TAD SIWAIT /NUMBER OF SI COMMANDS IN "WAIT"
TAD COMCNT /PLUS NEW COMMANDS
DCA COMCNT /NOW THEY'RE ALL BACK ON-LINE
DCA SIWAIT /NONE NOW IN WAIT STATE
EXIT
/SET SYSTEM ERROR CODE
/CALL TAD JOB #
/ JMS SYSERR
/ ERROR CODE
/ NORMAL RETURN
SYSERR, 0
AND C0037 /JOB # ONLY
SNA /IS IT JOB 0?
JMP SYSER1-1 /YES, RETURN
TAD JOBTBA /POINTER TO JOBTBL
GETJTI /GET CURRENT VALUE OF STR0
JOBSTS
AND C0007 /EXTRACT ANY ERROR CODE IN THERE
SZA CLA /ANY OLD BITS?
JMP SYSER1 /YES; DON'T CONFUSE THE ISSUE
TAD I SYSERR /GET THE ERROR CODE SUPPLIED
DATFLD
TAD I JOBSWA /ADD IT TO OLD VALUE OF STR0
DCA I JOBSWA /SAVE THE WHOLE MESS
ISZ JOBSWA
TAD JOBSWA /POINTS TO STR1
IOR /SET THE "ERROR HAS OCCURRED" BIT IN STR1
JSERR
CDF
SYSER1, ISZ SYSERR /SKIP ARGUMENT IN CALL
JMP I SYSERR /RETURN
/SKIP IF DISK NOT ACTIVE
/CALL TAD FIELD #
/ JMS DSKACT
/ ACTIVE
/ NOT ACTIVE
DSUSTA,
DAUTBL, DSUTBL-1
DSKACT, 0
CLL RTL /FIELD # *4 IS MAJOR INDEX IN DSUTBL
TAD DAUTBL /START OF TABLE -1
DCA AXS1 /AUTO INDEX
DATFLD
TAD I AXS1 /FILE 1 BUSY?
TAD I AXS1 / " 2 "
TAD I AXS1 / " 3 "
TAD I AXS1 / " 4 "
CDF
SNA CLA /IF ANY ONE WAS BUSY, AC.NE.0
ISZ DSKACT /NO ACTIVITY; INDEX RETURN
JMP I DSKACT /AND OFF
/START USER DISC REQUEST FROM QUEUE
/IF THIS ROUTINE IS CALLED, THERE HAD
/BETTER BE SOMETHING IN SQREQ OR DSUTBL
/FOR IT TO FIND. IT WON'T STOP LOOKING!
/CALL JMS DSUSER
/ RETURN
DSUSER, 0
TAD SQREQ /IS A SWAP REQUESTED?
SZA CLA
JMP DSUSR5 /YES, DO IT FIRST
DATFLD
DSUSR4, TAD I DSKPTR /GET ENTRY FROM DSUTBL
SNA /IS IT A REQUEST?
JMP DSUSR4 /NO - CHECK NEXT POSITION
CMA
SNA /END OF LIST?
JMP DSUSR2 /YES
CMA /REAL REQUEST FLIP IT BACK AGAIN
CDF
DSGO /YES, START IT UP
JMP I DSUSER /AND BACK
DSUSR5,
JMS I SWPIOA /START A SWAP DISK I/O
JMP I DSUSER /RETURN BACK
DSUSR2, TAD DSUSTA /START OF DSU TABLE +7
TAD C0007
DCA DSKPTR
JMP DSUSR4
*2000
/KEYBOARD SERVICE
/ENTERED WHENEVER CHARACTER IS RECEIVED. --==-- HIGHEST PRIORITY ON LEVEL 2
BELL=1000
KLOST, 0 /NUMBER OF CHARACTERS LOST BECAUSE OF OVERFLOW SINCE THE SYSTEM WAS LAST STARTED
TYPEA, TYPE
KEYB, RINGIN /POINTER TO INPUT RING BUFFER
KEYCNT, -INPUTS
KEYA, KEYC
KEYSIZ, -INPUTS /SIZE OF KEYBOARD INPUT RING BUFFER
CONIN, DCA I SETFLG /CLEAR THE SCHEDULER REQUEST FLAG
CONIN3, STA
CDF
IOF
TAD I KEYA
SMA /ARE WE FINISHED?
JMP CONIN4 /NO
CONEXT, CDF
AND I SETFLG /DID WE AROUSE ANYONE?
SZA CLA
RSCHED /IF NULL JOB IS RUNNING WE MAY TERMINATE IT
EXIT
CONIN4, DCA I KEYA /DECREMENTED COUNT
TAD I KEYA /CHECK FOR OVERFLOW
TAD KEYSIZ
SMA SZA CLA
JMP CONIN0 /OVERFLOW - SKIP AROUND TO THE FIRST ENTRY
DATFLD
TAD I KEYB /GRAB A CHARACTER FROM THE RING BUFFER
DCA TTCHAR
ISZ KEYB
ION
TAD I KEYB /LINE NUMBER
SPA
JMP HIPTR /HIGH SPEED READER
CLL RAL /TIMES 2
TAD DEVTBA
DCA CONINA /POSITION IN DEVICE TABLE
TAD I CONINA
SZA CLA
JMP CONIN1
TAD CONINA /NO DDB SETUP YET
CDF
GETBLK /ESTABLISH A PSEUDO DDB FOR THE TIME BEING
JMP CONIN2 /NONE AVAILABLE - DON'T BOTHER WITH BELLS
DATFLD
TAD I CONINA
IOR
DSI /SET NEW CONSOLE IN SI MODE
CONIN1, CDF
KEY /PROCESS THIS CHARACTER
CONINA, .-.
SKP /NO ROOM - RING BELL
JMP CONIN2
DATFLD
TAD I CONDBA /POINTS TO OUTPUT SIDE
SNA
JMP CONIN2 /NO DDB DON'T BOTHER WITH BELLS
IOR
BELL /RING-A-DING TOO BAD!!
JMS I TYPEA /REMEMBER WE WANT TO RING HIS/HER CHIME
JMP CONIN2
CONIN0, ISZ KLOST /COUNT A LOST CHARACTER
KEYBA, RINGIN /NOP
ISZ KEYB
CONIN2, ISZ KEYB
ISZ KEYCNT /END OF RING BUFFER?
JMP CONIN3 /NO
TAD KEYBA
DCA KEYB /RESET POINTER
TAD KEYSIZ
DCA KEYCNT /AND THE COUNT
JMP CONIN3
PTRPTR, DEVTBE
HIPTR, AND I PTRPTR /GET DDB ADDRESS OF PTR
SNA
JMP CONIN2 /OOPS - HE RELEASED IT
STORE /STASH ITS CHARACTER AWAY
PTRSIZ /SIZE CHECK ROUTINE
SKP
JMP CONIN2 /ALL IS WELL
CDF /OOPS! - RAN OUT OF FREE CORE
IOF
ISZ I KEYA /UN-COUNT THE CHARACTER
STA
TAD KEYB
DCA KEYB /BACK UP THE RING BUFFER POINTER
JMP I .+1 /AND BACK TO THE REMAINDER OF L2 SERVICE
L2EX0 /JUST PAST THE HI-PRIORITY CHECK POINT
/CHECK DEVICE ASSIGNMENT AND ASSIGN IF AVAILABLE
/CALLING SEQUENCE:
/ JMS DEVCHK
/ DEVTBL ADDRESS FOR THE DESIRED DEVICE
/ RETURN - IF OK TO USE
/ IF NOT OK THE RETURN IS THROUGH "UUOERR"
DEVCHK, 0
TAD I DEVCHK /GET DEVTBL POINTER
ISZ DEVCHK /INDEX PAST PARAMETER
DCA WS2 /DEVTBL ADDRESS
RDF /THE FIELD FROM WHERE WE CAME
TAD C6203
DCA DEVEXT
DATFLD
TAD I WS2 /DDB ADDRESS
SZA /IN USE?
JMP DEVCH1 /YES
TAD WS2
CDF
GETDDB /GET DATA BLOCK
REDO
DATFLD
TAD I WS2 /ADDRESS OF DDB
DCA WS1
TAD WS2 /DEVTBE+UNIT#
TAD DEVCH0 /-DEVTBE
DCA I WS1 /SAVE IN WORD 0 OF DDB
ISZ WS1 /POINTS TO JOB # IN DDB
TAD JOB
AND C0037
DCA I WS1 /SAVE OWNER JOB
DEVEXT, 0
JMP I DEVCHK /RETURN
DEVCH1, DCA AXS1 /NOW POINTS TO WORD 0 OF DDB
TAD JOB
CIA
TAD I AXS1 /DOES THIS JOB OWN DEVICE?
SNA CLA
JMP DEVEXT
JMP I .+1
UUOERR
DEVCH0, -DEVTBE
UUOCAL=WS0
UUOADD=WS1
/ SAVE MACHINE STATUS WHEN USER EXECUTES IOT
/WE MUST CHECK USER IOT FLAG BEFORE ANYTHING ELSE, EVEN CLOCK FLAG
/IF WE DON'T, AND CLOCK INTERRUPTS WITHIN 8 MICROSECONDS AFTER USER
/EXECUTES IOT, THEN WE WOULD TRIP ON CLOCK FLAG, AND NOT BE ABLE TO
/FIGURE OUT WHAT IOT THE USER EXECUTED.
UUO0, DCA L2SA /WE MUST HAVE BEEN IN USER MODE WHEN INTERRUPT OCCURRED!
RAR /SAVE LINK
DCA L2SVLK
TAD 0
DCA L2SV0 /SAVE PC
RIB
DCA L2SF /SAVE FIELDS AND MODE
CINT /CLEAR FLAG
ION
STA
TAD L2SV0 /BACK UP USER PC TO POINT TO IOT IN QUESTION
DCA UUOADD
UDF /SELECT USER DATA FIELD
TAD I UUOADD /GET THE IOT THAT CAUSED ENTRY HERE
DCA UUOCAL
CDF
TAD UUOTBA /START SCANNING THE IOT TABLE
DCA AXS1
TAD UUOCAL
AND C7770 /GET DEVICE CODE
CIA
DCA UUOC77 /SAVE-CODE
JMS UUOSR /FIRST SEE IF IT IS MICRO-CODED
JMP UUO22
UUO3, TAD AXS1 /YES, NOW COMPUTE ADDRESS OF SERVICE ROUTINE
TAD UUOTLL /OFFSET BETWEEN IOT TABLE AND DISPATCH TABLE
DCA UUOC77 /POINTS TO DISPATCH ENTRY
TAD I UUOC77 /GET DISPATCH ADDRESS
DCA UUOC77 /SAVE IT
JMP I UUOC77 /AND JUMP TO IT
UUO7, JMS UUOSR /CHECK FOR NON-RESIDENT IOTS WHICH RETURN ARGUMENTS
UUOEXT /UNDEFINED
JMP UUO8 /FIND # OF ARGUMENTS TO SEND TO FIP
UUO22, TAD UUOCAL /IS IT AN IOT AT ALL?
AND C1000
SZA CLA
JMP I UHALTA /IT'S A HLT, OSR, OR SOME COMBINATION
TAD UUOCAL /IT'S NOT MICROCODED
CIA
DCA UUOC77 /-IOT CAUSING INTERRUPT
JMS UUOSR /CHECK FOR NON-MICRO-CODED RESIDENT IOTS
SKP
JMP UUO3 /FOUND ONE; NOW GO GET DISPATCH ADDRESS AND AWAY---
JMS UUOSR /SEARCH FOR SHORT NON-RESIDENT IOTS
JMP UUO7
UUO6, TAD UUOCAL /THROW AWAY BITS 0-2 OF IOT
AND C0377
DCA UUOCAL /AND SAVE IT
UUO8, TAD AXS1 /NOW FIND NUMBER OF ARGUMENTS
TAD UUOTLL /THIS POINTS TO # IN UUOTBL
JMS GETUSP /GET USER PARAMENTERS
UFILE4, TAD CJOBDA /GET POINTER TO STR0
GETJTA
JOBSTS
DATFLD /OR IN "NON-RESIDENT IOT" BIT
IOR /SO FIP WILL RUN IN PLACE OF THIS JOB
JSIOT
TAD FIPJOB /ANYTHING CURRENTLY SCHEDULED?
SZA CLA
WAIT /YES - FIP WILL PICK US UP LATER
TAD JOB
DCA FIPJOB /SO THE SCHEDULER WILL TAKE US AS SOON AS POSSIBLE
WAIT /AND WAIT FOR FIP
UUOSR, 0 /SEARCH FOR MATCH
TAD I AXS1 /GET ENTRY FROM TABLE
SNA /LAST ENTRY?
JMP I UUOSR /YES, RETURN
TAD UUOC77 /NO, CHECK FOR MATCH
SZA CLA /MATCH?
JMP .-5 /NO, KEEP GOING
ISZ UUOSR /YES, SKIP
JMP I UUOSR /AND RETURN
UHALTA, UHALT
UUOTBA, UUOTBL-1
UUOTLL, UUODTB-UUOTBL
/THIS ROUTINE COPIES THE PARAMETERS SUPPLIED BY THE
/USER PROGRAM INTO *BLOCK IN FREE CORE, WHICH IS POINTED
/TO BY JOBLNK.
/THE IOT ITSELF IS SAVED IN THE FIRST WORD OF THE PARAMETER BLOCK
/IF NO ARGUMENTS ARE REQUIRED, JOBLNK CONTAINS THE IOT,
/RATHER THAN A POINTER TO THE IOT PARAMETER BLOCK.
/FIP CAN TELL BY EXAMINING BITS 0-3 OF JOBLNK; IF THEY ARE
/NON-ZERO, JOBLNK IS AN ADDRESS; IF ZERO, JOBLNK IS THE IOT ITSELF.
/NOW YOU KNOW WHY THE START OF THE FREE CORE LIST MUST ALWAYS BE
/ON OR AFTER 400 OCTAL IN FIELD ONE?
UUODAC, DSKACT
GETUSP, 0 /ENTER WITH PTR -# ARGUEMTS TO GET
DCA UUOC77 /SAVE IT
CDF
TAD CJOBDA /OK - NOW GET PTR TO JOBLNK
GETJTA
JOBLNK
DCA UUOLNK /AND SAVE IT
TAD I UUOC77
SNA /ANY ARGUMENTS?
JMP GETUS1 /NO - JUST SAVE IOT IN JOBLNK
CDF
DCA UUOC77 /YES. SAVE # ARGUMENTS
CLL CLA CMA RAL /CAN WE GET PARAMETER BLOCKS?
TAD FRECNT
SPA SNA CLA
REDO /NO - TRY LATER
TAD UUOLNK /PUT ADDRESS OF LINKAGE BLOCK IN UUOLNK
GETBLK /GET A FREE BLOCK
HLT /WHAT? "FRECNT" SAID THERE WERE PLENTY!!
DATFLD
TAD I UUOLNK /GET ADDRESS OF PARAMETER BLOCK
CDF
DCA UUOLNK /SAVE IT IN BLT CALLING SEQUENCE
STA /GET POINTER TO USER PARAMETERS-1
TAD L2SA
DCA UUSRC /SAVE FOR BLT CALL
TAD UUDF /MOVE USER PARAMETERS TO LINKAGE AREA IN DATFLD
DCA .+2
BLT
0 /SOURCE FIELD SELECT
UUSRC, 0 /SOURCE ADDRESS
DATFLD /DESTINATION FIELD SELECT
UUOLNK, 0 /DESTINATION ADDRESS
UUOC77, 0 /-#WORDS
GETUS1, TAD UUOCAL /NOW GET IOT
DATFLD
DCA I UUOLNK /AND SAVE IT IN APPROPRIATE PLACE
CDF
JMP I GETUSP /RETURN
/STASH LEVEL 2 REQUESTS FROM FIELD 1
QUEUE0, 0
DCA I L2Q /QUEUE REQUEST FROM FIELD 1
CIF DATFLD
JMP I QUEUE0 /AND BACK
L2689,
IFNZRO D689 <
CIF DATFLD
JMP I .+1 /TO FIELD 1 689 CARRIER SERVICE
DFCARR >
IFNZRO DC08A <*2364
T8OUT, CLA /DC08A CODE CALLED FROM "CONOUT"
TAD T8OBF2 /FIND ACTIVE OUTPUT REGISTER
TAD WS0
DCA UUOSR
TAD TTCHAR /CHARACTER TO BE OUTPUT
CLL RAL
TAD T8STOP
DCA I UUOSR /STASH IT COMPLETE WITH STOP & START BITS
JMP I .+1
CONTLS+1
T8OBF2, SKPTBL-OUTREG+1
T8STOP, 3000 >
IFNZRO CPU&7776 <*2360
KLEN, SKPTBL-1
KDEV, SKPTBL-1
TIMER4, CLA
TAD KDEV /END OF LIST; RE-SET THE POINTER
DCA KLEN
L2TIME=.
ISZ KLEN /MAKE SURE THAT THE KL8E'S STAY ENABLED
DATFLD
TAD I KLEN
CDF
SMA
JMP TIMER4 /END OF LIST, RESET POINTER FOR NEXT TIME
TAD C0004 /CONSTRUCT A "KIE"
DCA .+2
IAC
.-.
CLA >
*2400
IFZERO CPU&7776 <L2TIME=.>
L2TIM2, ISZ CLK1 /UPDATE LOW ORDER DAY CLOCK
JMP L2TIM3 /NOTHING UNUSUAL
ISZ CLK2 /UPDATE HIGH ORDER TIME. WOW!
JMP L2TIM3
ISZ DATE /WOULD YOU BELIEVE IT'S MIDNIGHT!
TAD ICLK2 /REINITIALIZE THE CLOCK FOR ANOTHER
DCA CLK2 /24 HOURS WORTH OF TICKS
TAD ICLK1 /AND BUMP THE DATE ONE
DCA CLK1 /(EVERY MONTH HAS 31 DAYS FOR OUR PDP-8)
L2TIM3, CIF DATFLD /DECREMENT TIMERS
JMS I TIMERA /ROUTINE TO RUN TIMERS
TIMCON, -5 /TIMES OUT EVERY FIVE SECONDS
L2OUT /SCHEDULE "CONOUT-TIMER" SERVICE
TIMPTR, 0 /NON-ZERO IF BUSY
L2PTR /WHERE TO GO WHEN READER HANGS
TIMCDR, 0 /NON-ZERO IF BUSY
L2CDR /WHERE TO GO IF THE CARD READER HANGS
TIMSI, 0 /NON-ZERO WHEN SI IS IN THE WAIT STATE
L2SI /WHERE TO GO WHEN IT TIMES OUT
TIMFIP, 0 /NON-ZERO IF "FIPLOCK" IS ON
L2FIP /WHERE TO GO TO TURN "FIPLOCK" OFF
TIM689, 0 /NON-ZERO IF ACTIVE
L2689 /WHERE TO GO TO CHECK CARRIER STATUS
TIMER3, ISZ JOBTIM
NOP
CIF /INHIBIT INTERRUPTS WHILE WE UN-BUMP THE CLOCK
CLL STA
TAD CLOCK
DCA CLOCK
SZL /HAVE WE COUNTED ALL THE SCHEDULED SYSTEM TICKS?
JMP L2TIM2 /NO
/"RSCHED" IS ENTERED AT THIS POINT
/RSCHED'S FUNCTION IS TO FIND JOBS TO RUN, REGARDLESS
/OF WHERE THEY MAY CURRENTLY RESIDE. IF THEY ARE IN CORE,
/GOOD; IF NOT, THE NECESSARY STEPS WILL BE TAKEN TO
/BRING THEM INTO CORE. IN THE LATTER CASE, WE WILL THEN
/GO OFF AND FIND SOMETHING TO DO WHILE THE NON-RESIDENT
/JOB IS MADE RESIDENT.
SCHED0, TAD JOB /GET CURRENT JOB
AND C0600
SZA CLA
EXIT /?? - DON'T BUMP OFF A PHANTOM!
TAD SCHNEW /IS THIS SOMETHING THAT CAN BE BUMPED OFF?
SNA
JMP SCHE12 /YES - GET RID OF HIM/HER
TAD JOBTIM /HAS HE USED A FULL TIME SLICE YET?
SPA SNA CLA
EXIT /NO, GO BACK TO HIM/HER
SCHE12, ION
SAVJOB /YES. SAVE ITS STATE. SET JOB=0
STA
DCA SCHNEW /SET FOR FULL TIME SLICES
TAD CURJOB /DID FILE TRANSFER PROCESSING CUT INTO SOMEONE'S TIME SLICE?
SZA
JMP SCHEI6 /YES - START IT BACK UP
TAD NXTMAX
DCA I NXTJCA /NUMBER OF JOBS TO CONSIDER
TAD SQREQ /SWAP REQUEST IN PROGRESS?
SNA CLA /IF SO, THERE IS NO POINT IN GOING FURTHER NOW.
JMP SCHED1 /NO - PROCEED
/SCHEDULE NEXT RESIDENT JOB
/THIS IS THE ENTRY FOR "SCHED"
/WE ONLY COME HERE IF A SWAP IS IN PROGRESS
/OR IF WE FIND THE JOB WE REALLY
/WANT TO RUN IS CURRENTLY INDISPOSED TO RUNNING. SCHED
/WILL FIND SOME RESIDENT JOB TO RUN. IF NO JOB IS
/RUNNABLE OR RESIDENT, JOB 0 (THE NULL JOB) IS RUN.
SCHEDI, TAD FANCOR /CHECK FOR PHANTOMS FIRST SO
DCA WS0 /START AT FIELD 2
TAD I SCHMUC /NUMBER OF USER CORE FIELDS TO CONSIDER
CLL RAL /TIMES 2
DCA I NXTCNA /ON THE SECOND PASS WE MAY PICK UP A COMPUTE-BOUND JOB
TAD I SCHMUC /NUMBER OF FIELDS
DCA WS1
SCHEI3, TAD I WS0
AND C1000 /CHECK FOR "NOTRUN"
SZA
JMP SCHEI4 /WE FOUND ONE
ISZ WS0
ISZ WS1
JMP SCHEI3 /TRY AGAIN
JMP I SCHNXT /LOOK FOR SOMEONE TO RUN ON BORROWED TIME
SCHEI4, CMA
AND I WS0 /REMOVE THE "NOTRUN" BIT
DCA I WS0
TAD I WS0
AND C0600 /IS IT A PHANTOM?
SZA CLA
JMP SCHEI5 /YES - THEN IT MUST BE READY TO EXECUTE
TAD I WS0
AND C0037
RUNABL /IS IT RUNNABLE?
JMP SCHEI3+4 /NO
SCHEI5, TAD I WS0 /YES - IT MUST BE RUNNABLE
SCHEI2, DCA SCHNJN /IS JOB IN CORE?
TAD SCHNJN /SEARCH CORTBL FOR HIM/HER
CORE
SWAP LOCK FIP SI CJOB
SCHED /NOT THERE; HAVE TO SWAP HIM/HER IN LATER
DCA L2SF /YES - SET UP SAVE FIELD
TAD SCHNJN /RESTORE REST OF LEVEL 2 REGISTERS
RESJOB
START /START JOB
SCHEI6, DCA SCHNJN /SAVE JOB NUMBER
DCA CURJOB /CLEAR "REMEMBERED" JOB
JMP SCHEI2+1 /NOW GO START HIM/HER BACK UP
SCHNXT, NXTCO1
ICLK1, -INCLK1
ICLK2, -INCLK2-1
SCHNJN=WS0
SCHSI=C0200
TIMERA, TIMER0
NXTMAX, -JOBMAX-1
NXTJCA, NXTJCT
SCHMUC, CORCNT
NXTCNA, NXTCNT
L2CDR, DATFLD
TAD I UUCDR1
DCA AXS1
TAD I AXS1
CDF
ERROR /PASS HUNG DEVICE ERROR TO THE USER
HUNGDV
CDL20, CIF DATFLD-1
JMP I .+1
CDL21
UUCDR0, IAC
IAC
DCA UUOCAL /SAVE THE IOT INDICATOR
JMS I CDRCHK /SEE IF IT'S OK FOR HIM/HER TO USE THE CARD READER
UUCDR1, DEVTBE+4
TAD UUOCAL /ALL IS WELL
CIF DATFLD-1
JMP I .+1 /OFF TO THE CARD READER HANDLER
UUCDR
CDRCHK, DEVCHK
REDO0, STA /IF WE CAN'T FINISH AN IOT FOR LACK OF SYSTEM
TAD L2SV0 /FACILITIES, WE BACK UP THE USER'S PC TO POINT
DCA L2SV0 /TO THE SAME IOT AND HOPE THAT LATER ON THINGS WILL LOOSEN UP.
WSCHED, CDF /THE USER PROGRAM IS TO GO INTO A WAIT
JMP SCHE12
SCHED1, TAD FIT /SOMETHING LEFT FROM LAST PASS THROUGH SCHEDULER?
AND C0037 /JOB ONLY
SZA
JMP SCHED4 /YES
TAD COMCNT /SI REQUESTED?
SNA CLA
JMP SCHED6 /NO
TAD SCHSI
JMP SCHED8 /YES - SCHEDULE IT
SCHED6, TAD FIPJOB /SOMETHING WAITING FOR FIP?
SNA
JMP SCHE13 /NO SPECIFIC JOB
SCHED4, DCA FIT /SAVE IT
TAD FIT
RUNABL /IS IT STILL GOOD?
SKP /NO
JMP SCHED5 /YES - CHECK IT OUT
SCHE13, JMS I SCHNXA /GET NEXT RUNNABLE JOB
DCA FIT /SAVE JOB #
DCA BONUS /BONUS JOB ALREADY PICKED UP
SCHED5, TAD FIT
TAD JOBTBA
GETJTI /GET CONTENTS OF STR0
JOBSTS
RTL /PUT ERROR ENABLE IN THE LINK
AND SCFIP /NEED FIP?
SZA
JMP SCHED7 /YES; SCHEDULE FIP FOR HIM/HER
DATFLD
TAD I JOBSWA /GET STR0 AGAIN
CDF
AND C0007 /ANY ERROR BITS ON?
SZA SNL CLA /EVEN IF THERE ARE WE'LL LET HIM/HER HANDLE IT IF HE'S ENABLED (LINK=1)
TAD SCHSI /CALL SI TO HANDLE ERROR
SCHED7, TAD FIT /UPDATE "FIT" IF THERE'S A NEED FOR FIP OR SI
SCHED8, DCA FIT
TAD FIT
SCHED3, AND C0600 /IS FIT JOB FIP OR SI?
SNA CLA
JMP SCHE11 /NO
TAD I FANCOR /IS FIP OR SI IN CORE?
AND FIT /IS IT THE PROPER PHANTOM?
AND C0600
SNA CLA
JMP SCHE15 /NO - SCHEDULE THEIR SWAP IN
TAD I FANCOR /YES - IS THE PHANTOM IN USE?
AND C0037 /JOB #
SZA CLA
JMP SCHED9 /YES - NOT MUCH TO DO NOW
SCLOCK /LOCK PHANTOM FOR THIS JOB
TAD FIT /NO - LOCK PHANTOM FOR THIS USER
DCA I FANCOR /INDICATE THAT THIS FIELD IS NOW LOCKED
SCHED9, DCA FIT /CLEAR FIT
FANFLD /DISK ACTIVITY HERE?
JMS I SCDACT
JMP SCHE13 /YES - FORGET ABOUT PHANTOM FOR NOW
TAD I FANCOR /NO
JMP I .+1 /NOW GO FINISH BOOKKEEPING
SCHEI2
SCHNXA, NXTJOB
SCFIP= C0400 /FIP
SCLOCK= CLA CLL CML RTR /LOCK BIT AC=2000
SCDACT, DSKACT
FANFLD= CLA STL RTL /PHANTOMS ALWAYS RUN IN FIELD 2
SCHE15, TAD I FANCOR /FANFLD LOCKED, SWAPPED, OR NOTRUN?
AND C7000
SZA CLA
JMP SCHE13 /YES - GO FIND SOMETHING ELSE TO DO NOW
TAD I FANCOR /IS THERE CURRENTLY A USER JOB IN FANFLD?
AND C0037 /IS THERE A USER JOB IN FANFLD?
SZA CLA
JMP SCHE16 /YES, FORCE IT OUT
FANFLD /NO; FINISH:=FANFLD
JMP SCHE14
SCHE16, TAD I FANCOR /IS A PHANTOM IN HERE?
AND C0600
SZA CLA
JMP SCHE13 /YES, GO FIND ANOTHER JOB TO RUN
DCA DEAD /DON'T GO LOOKING FOR AN ALTERNATIVE FIELD!
FANFLD /FORCE JOB OUT OF FANFLD
DCA FORCE
JMP SCHFR1
SCHE10, CORE /FIRST LOOK FOR A FIELD WITH NOTHING IN IT
SWAP LOCK NOTRUN FIP SI NOHOLD CJOB
SKP /NO SUCH FIELDS
JMP SCHE19 /FOUND ONE TO USE
TAD DEAD /ARE THERE ANY OLD DEAD JOBS STILL IN CORE?
SZA
JMP SCHDED /YES - SEE IF WE CAN GET RID OF IT
SCHE18, CORE /LET'S TRY AGAIN
FIPLOK, SWAP LOCK NOTRUN CJOB
JMP SCNOUT /NO, SCAN FOR OUTPUT
SCHE19, AND C0007 /YES
SCHE14, DCA FINISH /FINISH:=FIELD #
TAD FINISH /SET SWAP BIT IN CORTBL ENTRY
TAD CORTBA
DCA SUJT2 /POINTS TO CORTBL ENTRY
STL RAR /AC=4000 (SWAP)
TAD FIT /JOB TO SWAP IN
DCA I SUJT2 /SAVE IN CORTBL
JMP I SCSWAP /SWAP IN
SCNOUT, TAD SCNSVP /RESTORE CORTBBL POINTER FOR OUTPUT SCANNING
SCHDED, DCA I SCNSV1
CORE /SCAN FOR AVAILABLE FIELD
LOCK+NOTRUN+FIP+SI
JMP SCHE17 /ARE WE STUCK?
AND C0007
DCA FORCE /FIELD TO SWAP OUT
TAD I SCNSV1 /PICK UP POSITION OF POINTER
DCA SCNSVP /SAVE FOR THE NEXT TIME
SCHFR1, TAD FORCE /DISC XFER IN PROGRESS?
JMS I SCDACT
JMP SCHE17 /SEE IF WE CAN TAKE ONE MORE LOOK AROUND
TAD FORCE
TAD CORTBA
DCA SUJT2 /CORTBL POINTER TO FORCED FIELD
DCA DEAD
TAD FORCE
CIA
DCA FINISH /SET FINISH=-FORCE (TO INDICATE SWAP OUT)
JMP I .+1 /NOW GO SET UP THE OUTSWAP
SWPOUT
SCHE17, TAD DEAD /CAN WE LOOK FURTHER?
SNA CLA
SCHED /NO - WE'RE STUCK
DCA DEAD /YES - GUESS WE GOT BAD ADVICE
JMP SCHE18 /GO TAKE ANOTHER LOOK
SCSWAP, SWAPIN
SUJT2= WS0
SCNSVP, CORTBL+1 /VALUE OF CORTBL POINTER AFTER LAST SEARCH
SCNSV1, CORTBP /POINTS TO CORTBL POINTER IN CORE SEARCH ROUTINE
SCHE11, TAD FIT /IS FIT JOB IN CORE?
CORE
SWAP LOCK FIP SI CJOB
JMP SCHE10 /NO - HE HAS TO BE SWAPPED IN
DCA L2SF /SAVE FIELD
TAD FIT /RESTORE LEVEL 2 REGISTERS
RESJOB
DCA FIT /CLEAR FIT
START /START JOB
SWERER= C0002 /SWPRER
SWPRET, JMP SWERR /ERROR ON SWAP
TAD CORTBA /GET A POINTER TO THIS FIELD'S
TAD FINISH /ENTRY IN CORTBL
DCA SQREQ
TAD FIT /JOB SWAPPED IN
TAD C1000 /NOT RUN BIT
SWGOD1, DCA I SQREQ /STORE IT IN THE CORTABLE
DCA FINISH
DCA FIT /SET ALL CONCERNED WORDS TO ZERO
DCA FORCE
DCA SQREQ
JMS I SWSCON /SEE IF ANY MORE DISC I/O WAITING TO BE ATTENDED TO
RSCHED /RE SCHEDULE
SWSCON, DSKCON
SWERR, TAD FINISH /ERROR WHILE SWAPPING OUT OR SWAPPING IN?
SPA
CIA /DURING SWAP OUT
TAD CORTBA
DCA SQREQ /POINTER TO CORTBA FOR THIS FIELD
TAD FINISH
SPA CLA
JMP SWER1 /WHILE SWAPPING OUT; CODE=3
TAD SWERER /WHILE SWAPPING IN; CODE=2
DCA SWPER1
TAD FIT
SWER2, AND C0037 /GET THE JOB #
SNA /IS IT A PHANTOM?
JMP SWGOD1 /YES, SO NO ERROR CODE TO SET
ERROR /NO JOB BEING SWAPPED IN SO HAVE TO SET ERROR CODE
SWPER1, 0 /ERROR CODE
JMP SWGOD1 /CLEAR ALL THE CONCERNED WORDS BEFORE LEAVING
SWER1, TAD SWER3 /ERROR CODE
DCA SWPER1
TAD I SQREQ /JOB BEING SWAPPED OUT
JMP SWER2
SWER3= C0003
REMJOA, REMJOB
SCHFAN, JMS I REMJOA /REMEMBER WHO'S RUNNING
SCHED /GO RUN THE PHANTOM
/BOOTSTRAP FOR CRASH RECOVERY, USED TO BRING INIT INTO HIGHEST MEMORY FIELD
IFZERO RKSYS <
BOOT, CDF /IN THE (VERY RARE) EVEN THE SYSTEM
STA /SHOULD CRASH, THIS ROUTINE MAY
DCA I B7751 /BE STARTED AT 4200 OF FIELD 0
DCA I B7750 /WC AND CA
TAD DSKFLD /HIGHEST FIELD
IFZERO RF08 <
DIML
CLA STL RTL
DXAL /TRACK 2
>
IFZERO RF08-40 <
DEAL
NOP /FOR SIZE
CLA
>
DMAR
DFSC /WAIT
JMP .-1
CIF CDF+CORMEM
JMP 0 /OFF TO INIT
B7551, 7551
B7750, 7750
>
IFNZRO RKSYS < /SEE ABOVE (CHECK LISTING FOR START ADDRESS)
/AND MAKE SURE TO CLEAR AC, IF, DF BEFORE START!
BOOT,
DCA RKADR /RESET CORE ADDRESS, COUNT, AND
TAD ICOUNT
DCA WS0
TAD IDADDR /DISK ADDRESS JUST IN CASE WE GET INVOKED
DCA RKSWSE /MORE THAN ONCE
BLOOP, TAD RKADR
DLCA
TAD DSKFLD /DOUBLES AS READ COMMAND INTO HIGHEST FIELD
DLDC
TAD RKSWSE
DLAG
BWAIT, DSKP
JMP BWAIT /WAIT FOR READ TO COMPLETE
TAD RKADR
TAD C0400 /NEXT CORE ADDRESS
DCA RKADR
ISZ RKSWSE /NEXT DISK ADDRESS
ISZ WS0
JMP BLOOP /NEXT SECTOR
CIF CDF+CORMEM
JMP 0 /OFF TO INIT
IDADDR, 0040 /TRACK 2
ICOUNT, -16 /COUNT OF SECTORS TO BE READ
>
DSKFLD,
IFZERO RKSYS <
IFZERO RF08 <CORMEM>
IFZERO RF08-40 <CORMEM+200> >
IFNZRO RKSYS <CORMEM>
/SAVE JOB REGISTERS
/THIS ROUTINE IS USED TO SAVE THE LEVEL 2 REGISTERS
/IN THE JOB DATA AREA. AFTER SAVING THIS
/INFORMATION, JOB IS SET TO 0 TO INDICATE
/THAT NULJOB IS RUNNING
/CALL SAVJOB
/ RETURN
SAVJO0, 0
TAD JOB /IS NULJOB RUNNING ALREADY?
SNA
JMP I SAVJO0 /YES - NOTHING TO SAVE
AND C0600
SZA CLA /IS A PHANTOM RUNNING?
JMP SAVJO3 /YES
TAD CJOBDA /MOVE LEVEL TWO REGISTERS TO JOB DATA AREA
GETJTA
JOBREG
DCA .+5
BLT /MOVE PC, LINK, AC TO JOB DATA AREA
CDF /FROM FIELD 0
L2SV0
DATFLD
0
-3
IFNZRO MQREG <
GETJTW /IF THERE'S AN MQ AND MAYBE AN EAE, SAVE THEM TOO
JOBEAE
IFNZRO CPU-1 <
CLA MQA MQL > /LOAD AC FROM MQ, CLEAR MQ
IFZERO CPU-1 <
CLA MQA > /LOAD AC FROM MQ
DATFLD
DCA I JOBSWA > /SAVE IN JOB MQ
IFNZRO EAE <
ISZ JOBSWA /GET POINTER TO JOB SC
IFNZRO CPU-2 <
SCA /GET SC
DCA I JOBSWA > /AND SAVE IT
IFZERO CPU-2 <
SCA /GET SC
CLL RTL /MAKE ROOM FOR MODE AND GT
DCA I JOBSWA /SAVE SC
DPSZ /SKIPS IF MODE B
ISZ I JOBSWA /INCR IF MODE A
SGT /CHECK GT FLAG
ISZ I JOBSWA /INCR, IF GT=0 OR IF MODE A
> > /IF MODE=A THERE MAY BE JUNK IN THE AC AT THIS POINT BUT
/BITS 7-11 ARE GUARANTEED CLEAR
SAVJO3, TAD JOB /DO WE HAVE A JOB #?
AND C0037
SNA CLA
JMP SAVJO2 /NOT YET
CLA IAC /CORRECT THE CLOCK SINCE IT'S ALWAYS ONE BEHIND
TAD CLOCK /ADD IN ANY TIME HE HASN'T BEEN CHARGED FOR YET
TAD JOBTIM /TO THE NUMBER OF TICKS HE HAS ACCUMULATED
DCA JOBTIM /NOW IT'S OK TO PUT HIM/HER AWAY
CDF /GET POINTER TO LOW ORDER RUNTIME
GETJTW
JOBRTM
CLL
TAD JOBTIM /# TICKS HE USED
DATFLD
DCA I JOBSWA /SAVE THE NEW CUMULATIVE TIME
ISZ JOBSWA
SZL /OVERFLOW INTO HIGH ORDER?
ISZ I JOBSWA /BUMP IT; WOULD NEED 16777216 TICKS FOR THIS TO SKIP!!
TAD SCHNEW /WAS THIS JOB TO HAVE A FULL SLICE?
TAD JOBTIM /ANY PART OF HIS/HER TIME SLICE STILL LEFT?
SPA SNA CLA
JMP SAVJO2 /YES, SO THIS JOB IS NOT A COMPUTE BOUND JOB AT THIS STAGE
TAD I CJOBDA
IAC /STR0
IOR /MAKE HIM/HER COMPUTE BOUND
JCOMBD
SAVJO2, DCA JOB /SIMULATE NULJOB
DATFLD
DCA I CJOBDA /CLEAR POINTER TO CURRENT JOB DATA AREA
CDF
JMP I SAVJO0 /AND EXIT
RUNULL, SCHNUL
DEBUG, /RESTART FOR DEBUGGING
IFZERO DC08A <
IFZERO CPU-1 < /SET PDP-8 CLOCK COUNT
STA
CCF CLB >
IFNZRO CPU-4 <CECI>
IFZERO CPU-4 <IAC
CLLE
CLA>>
IFNZRO DC08A < T1ON > /TURN ON DC08 CLOCK
IFZERO D689-4 < EDF > /REENABLE DATA PHONES
DCA SCHNEW /ENABLE SCHEDULER TO BUMP NULL JOB
JMP I RUNULL
*3200
/PROCESS KEYBOARD INPUT CHARACTERS (MAY BE PSEUDO-INPUT)
/MULTI-FIELD ROUTINE
/CALL: CHARACTER IN "TTCHAR"
/ JMS KBD
/ DEVTBL POINTER
/ RETURN; NO ROOM - CHARACTER NOT STORED
/ RETURN; CHARACTER STORED
/
KBDCNT=WS2
KBDSIB, -212 /DO NOT MOVE FROM BEGINNING OF A PAGE - SEE "DUPSI"
IFNZRO KBDSIB&177 <YOU GOOFED>
KBD00, 0
TAD I KBD00 /GET DEVTBL POINTER
DCA CONDBA
RDF
TAD C6203
DCA KBDNSX /REMEMBER FROM WHENCE WE CAME
ISZ KBD00
DATFLD
TAD I CONDBA /GET DDB ADDRESS
DCA CONDDB
KBDSQ, JMS I KBDCON /CHECK ^S/^Q; (ISZ CONDBA IF FEATURE DISABLED)
TAD I CONDDB /YES - GET DDB STATUS
AND C0100
SZA CLA /"SICOM" SET?
JMP KBDNSX /YES - EXIT
TAD TTCHAR /CHECK FOR ^B, ^C
TAD KBDMCB
CLL RAR
SZA CLA /IS IT ^B OR ^C?
JMP KBD05 /NOTHING SPECIAL ABOUT THIS ONE
TAD CONDDB
JMS I KBDCLB /CLEAR HIS/HER INPUT BUFFER
TAD TTCHAR
RAR
SNL CLA /WAS IT ^B OR ^C?
JMS I KBDCHK /WAS ^B TYPED IN USER MODE?
JMP KBD04 /CLEAR OUTPUT
TAD I CONDDB
TAD C1000 /PUT THIS TTY IN SI MODE
DCA I CONDDB
KBD02, TAD KBDUPA
DCA TTCHAR /CHANGE TO ^
CDF
PRINT /STASH "^" IN HIS/HER OUTPUT BUFFER
"B /WE DON'T CARE IF "PRINT" FAILS
TAD .-1
DCA TTCHAR /CHANGE TO B
KBD01, CLL STA RTR
RTR
DATFLD
AND I CONDDB /CLEAR "FULL" STATUS
DCA I CONDDB
KBD03, TAD I CONDDB /GET DDB STATUS BITS
AND DUPSI
ISZ CONDDB
SZA CLA /DUPLEX OR SI MODE?
TAD I CONDDB
SNA CLA /AND LOGGED IN?
JMP KBDXIT /NO - SO DON'T ECHO
CDF
PRINT /STASH (TTCHAR) IN HIS/HER OUTPUT BUFFER
KBDUPA, "^ /WE DON'T CARE IF "PRINT" FAILS
KBDXIT, ISZ KBD00 /SHOW SUCCESS
KBDNSX, .-. /BACK TO THE CALLING FIELD
JMP I KBD00
KBD04, TAD I CONDBA
JMS I KBDCLB /CLEAR THE OUTPUT BUFFER
TAD TTCHAR
RAR
SNL CLA /WAS IT ^B OR, OR ^C?
JMP KBD02 /IT WAS ^B
JMS I KBDCHK /USER MODE?
JMP KBDSSI /NO, GO TO SI FOR DOT OR ^B
JMP I KBDCCA /YES, GO DO ^C BUSINESS
KBD05, TAD C7770 /IS THERE PLENTY OF FREE CORE?
TAD FRECNT
SPA CLA
JMP KBDNSX /NO
JMS I KBDCHK /WHICH MODE?
JMS I KBDLRA /SI - CHECK FOR LINE-FEED AND RUBOUT
TAD I CONDDB
AND C0400 /"FULL" FLAG SET?
SZA CLA
JMP KBDNSX /YES - EXIT
TAD CONDDB
STORE /STASH (TTCHAR) IN HIS/HER INPUT BUFFER
KBD06 /FOR SIZE CHECK
JMP KBDNSX /STORE FAILED; BUFFER ALREADY FULL
JMS I KBDCHK /WHICH MODE?
JMP KBD08 /SI
STL RTL /AC=2
TAD CONDDB /POINT TO BREAK MASK
DCA KBDCNT
TAD I KBDCNT /GET THE BREAK MASK
JMS I BRKTSA /IS IT A BREAK CHARACTER?
JMS I KBDBRK /GO SET DEL BIT IN STR1 AND PUT HIS/HER JOB NUMBER IN BONUS
DATFLD
JMP KBD03 /SEE IF WE SHOULD ECHO
KBDBRK, KBDDLM
KBDCCA, GIR9
KBDLRA, KBDLRB
DUPSI,
KBD08, TAD KBDSIB /USED AS CONSTANT (MASK) SEE "KBD03+1"
TAD TTCHAR
AND KBDSIM
SZA CLA /IS THIS A BREAK FOR SI?
JMP KBD03 /NO
KBD11, ISZ COMCNT /TO SCHEDULE "SI"
TAD I CONDDB
TAD C0100 /SET "SICOM"
DCA I CONDDB /SAVE NEW KEYBOARD STATUS
JMP KBDXIT /EXIT WITHOUT ECHOING THE DELIMITING CHARACTER
KBDCON, CONSQ
BRKTSA, BRKTST
KBDMCB, -"B+100 /-^B
KBDCLB, CLRBUF
KBDCHK, KBDMOD
KBD09, TAD CONDDB
TAD C0005
DCA KBDCNT /POINTS TO CHARACTER COUNT IN DDB
TAD I KBDCNT
CIA
DCA KBDCNT /NUMBER OF CHARACTERS TO SPIN THROUGH THE BUFFER
DCA WS0 /FAKE HIS/HER BREAK MASK TO ZERO
KBD10, TAD CONDDB
FETCH /FETCH A CHARACTER
JMP KBDSSI /BUFFER EMPTY
DCA TTCHAR /SAVE IT
ISZ KBDCNT /RUB THIS ONE?
SKP
JMP KBD03 /YES - PRINT IT
TAD CONDDB
STORE /NO - PUT IT BACK
ALLOK /NO LIMIT
KB0040, DECHO /NOP /CAN'T FAIL
JMP KBD10
KBDSIM, /THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
KBDSSI, TAD KB0040 /SET "DECHO"; SCHEDULE SI TO PRINT CURRENT LINE
JMP KBD11 /PRECEDED BY EITHER "." OR "^B"
IFNZRO KB0040&177-174 <CHANGE KBDSIM>
*3400
/KEYBOARD IOTS
/SEE IF THE USER IS GOING TO EXECUTE A "JMP .-1" AFTER A NON-SKIPPING "KSF"
JMPTST, TAD UUOADD /ADDRESS OF THE "KSF"
AND C0177 /JUST THE PAGE ADDRESS BITS
TAD C5200 /MAKE UP THE REQUIRED "JMP" INSTRUCTION
CIA
UDF /SELECTS USER'S FIELD
TAD I L2SV0 /USER'S INSTRUCTION
DATFLD
SNA
JMP JMPTS1 /WE CAUGHT HIM/HER!
TAD C0200 /MAYBE IT'S A PAGE 0 "JMP"
SZA CLA
JMP JMPTS0 /NO - MUST BE SOMETHING ELSE - LET HIM/HER CONTINUE
TAD CC7600 /WILL WE BE ON PAGE 0?
AND UUOADD
SNA CLA
JMPTS1, TAD UKEYFL /PUT HIM/HER TO SLEEP - SO HE DOESN'T WASTE OUR TIME
JMPTS0, DCA UKEYC /SAVE WAIT CCONDITION
STL RTR
AND I CONDDB
SNA CLA /NEED XON?
JMP JMPTS2 /NO
TAD UKXON
DCA TTCHAR
ISZ CONDBA /POINT TO OUTPUT SIDE
CDF
PRINT /SEND XON
WAIT /DIDN'T FIT - TRY AGAIN LATER
CLL STA RTR
DATFLD
AND I CONDDB /CLEAR XOFF BIT
DCA I CONDDB
JMPTS2, TAD UKEYC /WAIT FOR FLAG; EXCEPT KSF WITHOUT JMP .-1
UUOEXT
IFNZRO JMPTST&4177 <YOU GOOFED>
UKL2SA, L2SA
UKEY0A, UKT0
UKEY1A, UKT1
UKWAIT, STA /BACK UP HIS/HER PC
TAD L2SV0
DCA L2SV0
JMP JMPTS1 /SEE IF XON SHOULD BE SENT
UKXON, 221
UKEY, JMS I UKEY0A /MAKE SURE HE'S NOT IN SI MODE
JMS I UKEY1A /WHAT DOES HE WANT TO DO?
JMP UKEYRS /READ STRING
UKEYFL, JSDEL JSERR /DELIMITER FLAG OR ERROR FLAG
C5200, JMP JMPTST /MAKE SURE HE'S NOT HANGING ON "JMP .-1"
RAR
SPA CLA
DCA L2SA /KCC - CLEAR AC
SNL CLA /IS KRB OR KRS REQUESTED?
UUOEXT /NO - ALL DONE
DATFLD
TAD CONDDB
FETCH /GET A CHARACTER FROM THE BUFFER
JMP UKWAIT /NONE AVAILABLE
DCA UKEYC /SAVE CHARACTER
TAD UKL2SA /OR INTO USER'S AC
CDF
IOR /IT WOULD PROBABLY BE ADEQUATE TO JAM IT INTO HIS/HER AC
UKEYC, 0
UUOEXT /AND BACK TO USER
UKREAD, 0
DCA WS0 /SAVE THE BREAK MASK
TAD L2SA /POINTS TO PARAMETERS IN USER AREA
IAC
DCA WS1 /ADDR OF USER BUFFER POINTER
UDF
TAD I WS1 /USER BUFFER ADDRESS
DCA AXS2
UKEYR1, DATFLD
TAD CONDDB
FETCH /GET A CHARACTER
JMP I UKREAD /THEY'RE FRESH OUT
UDF /SELECT USER FIELD
DCA TTCHAR
TAD TTCHAR
DCA I AXS2
ISZ I WS1 /UPDATE USER POINTER
MRUB, -377 /NOP
TAD WS0 /IS IT A DELIMITER?
ISZ I L2SA /DONE?
JMS BRKTST
CLA SKP /WE'RE FINISHED
JMP UKEYR1 /BACK FOR MORE
DCA L2SA /CLEAR AC
ISZ UKREAD /SKIP ON RETURN
JMP I UKREAD
/READ INPUT STRING
UKEYRS, DATFLD
STL RTL
TAD CONDDB /ADDRESS OF DDB
DCA WS0 /POINTS TO BREAK MASK
TAD I WS0 /GET BREAK MASK
JMS UKREAD /READ STRING
JMP UKWAIT /WAIT FOR HIM/HER TO TYPE SOME MORE
UUOEXT
BRKTST, 0
CDF
SPA SNA
JMP BRKTS2
DCA WS0 /SAVE THE BREAK MASK
TAD BRKTBA /ADDRESS OF BREAK TABLE
DCA AXS1
TAD TTCHAR /CHARACTER TO COMPARE WITH TABLE
BRKTS1, ISZ AXS1 /SKIP OVER MASK
TAD I AXS1 /-HIGH END OF RANGE
CLL
TAD I AXS1 /+NUMBER OF CHARACTERS IN THIS RANGE
SNL
JMP BRKTS1 /NOT IN THIS GROUP
CC7600, CLA 400 /WE FOUND IT
TAD I AXS1 /GET THE MASK
AND WS0 /COMPARE IT WITH OUR MASK
BRKTS2, SNA CLA /IS IT A BREAK CHARACTER?
ISZ BRKTST /NO
JMP I BRKTST
BRKTBA, BRKTBL-2
MLF, 377-212
KBD09A, KBD09
KBDLRB, 0
TAD MRUB
TAD TTCHAR
SNA
JMP I KBD09A /RUBOUT
TAD MLF
SZA CLA
JMP I KBDLRB /NORMAL CHARACTER
JMP I .+1 /LINE-FEED
KBDSSI
*3600
IFZERO CPU-2 < /TEMPORARY POWER FAIL HANDLER FOR 8/E
POWINT, CLA
DCA 0 /CLEAR LOCATION 0 SO WE'LL FALL THROUGH IT
TAD POW2 /CLOBBER LOCATION 2 (C0200) SO WE'LL COME TO "POWST"
/WHEN THE JUICE RETURNS
DCA 2
HLT /POWER FAILURE; WILL START AT POWST WHEN POWER COMES UP
POW2, POWST
POWST, DCA WS1
ISZ WS0 /WE DELAY ABOUT A MINUTE TO MAKE SURE
JMP .-1 /THE DISK IS UP TO SPEED
ISZ WS1
JMP .-3
JMP I .+1 /NOW GO CALL INIT
BOOT
USGT, SGT /SKIP ON PDP-8/E GREATER THAN FLAG (EAE)
UUOEXT
JMP I .+1 /CAUSE SKIP ON RETURN
UUOEX2
>
IFNZRO CPU&7776 <
UGTF, SGT /PDP-8/E "GET FLAGS" SIMULATOR
SKP
STL RTR /POSITION OF GT FLAG
TAD L2SVLK /AND GIVE HIM/HER THE LINK
DCA L2SA
UUOEXT
URTF, CLA STL IAC RTR /AC=6000
AND L2SA /SAVE ONLY LINK AND GT BITS OF HIS/HER AC
RTF /RESTORE AS REQUESTED
CLA RAR /FETCH NEW LINK
DCA L2SVLK /SAVE FOR THE USER
UUOEXT
>
IFNZRO DC08A <
DC08B= DC08A+4%5
T8FITH, -DC08B
T8TTIA, T8TTI
T8LC, -1
T8SF, 0
T8SV0, 0
T8SVLK, 0
T8SA, 0
T8FLG, 0
T8CNT0, -1 /SO IT WILL INITIALIZE ITSELF THE FIRST TIME IT'S USED
T8CNT1, 0
T8CNT2, 0
T8N5, -5
T8OBA, SKPTBL+PT08+KL8+2
T8OBF, 0
T8NLN, -DC08A
T8LINE, DC08LO-SKPTBL-PT08-KL8-2
RESTA, RESTOR
T8SFA, T8SF
T8BF2, OUTREG-SKPTBL-1
T8TMP, 0
T83000, 3000
TTOFLD, TTOFLG
T8RTN, DISMI2
T8DIS, T1ON /RE-ENABLE THE CLOCK
ISZ T8LC
JMP I T8RTN /ALREADY SERVICING DC08
DCA T8SA /SAVE AC
RAR
DCA T8SVLK /AND LINK
TAD 0
DCA T8SV0 /AND PC
RIB
DCA T8SF /FIELD & MODE
DCA T8FLG /CLEAR DC08A LEVEL 2 SERVICE FLAG
T8IN, TAD T8FITH
TTCR TTLR /LIMIT INPUT TO 1/5 OF THE LINES
DCA T8CNT2 /SAVE ALSO AS THE OUTPUT LINE COUNT
ION
CIF DATFLD
JMP I T8TTIA /TAKE A PASS THROUGH THE TTI STRING
/RETURNS HERE AFTER SERVICING INPUT SIDE (TTI'S)
T8OUT1, ISZ T8CNT0 /BUMP DIVIDE BY 5 COUNTER
JMP T8OUT2 /CONTINUE CURRENT PASS
TAD T8N5
DCA T8CNT0 /RESET MAJOR COUNTER
TAD T8OBA
DCA T8OBF /RESET OUTPUT BUFFER POINTER
TAD T8NLN
DCA T8CNT1 /RESET TOTAL NUMBER OF LINES COUNTER
T8OUT2, TAD T8CNT1
SMA CLA /ANYTHING LEFT THIS PASS?
JMP T8EXT /NO
TAD T8LINE /LINE NUMBER TO START AT
TAD T8OBF /COMPUTED FROM CURRENT BUFFER POSITION
TTCL TTLL /LOAD IT INTO THE DC08A
CLA
T8OUT3, TAD I T8OBF /BITS TO BE OUTPUT
SZA
JMP T8OUT5 /MUST BE SOMETHING THERE
TTIL /NOTHING - JUST BUMP THE LINE NUMBER
T8OUT4, ISZ T8OBF /BUMP THE BUFFER POINTER
ISZ T8CNT1 /AND THE TOTAL LINE COUNT
SKP
JMP T8EXT /FINISHED
ISZ T8CNT2 /CURRENT PASS COCUNT
JMP T8OUT3 /ONTO THE NEXT LINE
T8EXT, IOF
STL STA /DECREMENT THE INTERRUPT COUNT
TAD T8LC
DCA T8LC
SNL /ALL ACCOUNTED FOR?
JMP T8IN /NO - MAKE ANOTHER ROUND
TAD T8FLG /DOES THE DC08 REQUIRE LEVEL 2
TAD L2Q /OR SOMETHING ELSE?
CIA
TAD L2QE
AND T8SF /ALLOW "L2EXIT" ONLY IF FROM USER MODE
AND C0100
SZA CLA /HOW SHOULD WE EXIT?
JMP T8EXIT /VIA L2EXIT
TAD T8SFA /BACK TO WHERE WE CAME FROM
CDF
JMP I RESTA
/MOVE THE ACTIVE REGISTERS OVER TO LEVEL 2
T8EXIT, TAD T8SVLK /THE LINK
DCA L2SVLK
TAD T8SA /THE AC
DCA L2SA
TAD T8SV0 /THE PC
DCA L2SV0
TAD T8SF /FIELDS & MODE
DCA L2SF
EXIT
T8OUT5, TTO TTIL /OUTPUT A BIT
SZA
JMP T8OUT8 /SAVE THE REMAINING BITS FOR NEXT TIME
T8OUT6, TAD T8OBF /OUR POSITION
TAD T8BF2 /MINUS THE OFFSET
DCA T8TMP /SECOND BUFFER
TAD I T8TMP
RAR
SNL /ANYTHING WAITING?
JMP T8OUT7 /NO
AND C0377
CLL RAL
TAD T83000 /NOW THE STOP BITS & START BIT ARE IN PLACE
DCA I T8OBF /SAVE IT TO BE OUTPUT NEXT TIME
STL IAC RTR
DCA I T8TMP /SET BOTH HARDWARE BUSY AND SERVICE FLAGS
CDF
DCA I TTOFLD /SET "CONOUT" FLAG
DATFLD
ISZ T8FLG /SCHEDULE LEVEL 2 FOR US
JMP T8OUT4
T8OUT7, STL CLA RAR
AND I T8TMP
DCA I T8TMP /CLEAR EVERYTHING EXCEPT SERVICE FLAG
T8OUT8, DCA I T8OBF
JMP T8OUT4
T8IN1, 0
IOF
DCA I ACX11 /STASH IT IN THE RING BUFFER
TTRL
TAD T8BASE /MAKE DC08A LINE NUMBER = KXX
JMS I T8INPA /FINISH HOUSE-CLEANING
ISZ T8FLG /SCHEDULE LEVEL 2
CIF DATFLD
JMP I T8IN1 /BACK TO FIELD 1
T8BASE, PT08+KL8-DC08LO+1
T8INPA, ACINT9
>/END OF FIELD 0 DC08A CODE
*4000
/ THIS WILL RUN A "ROUND ROBIN" OF CORE RESIDENT JOBS
NXTCO1, DCA SCHNEW /ANY JOB STARTED FROM HERE MAY BE THROWN OFF
NXTCOR, ISZ NXTCNT /HAVE WE CHECK ALL ENTRIES?
TAD NXTCNT
SMA SZA CLA
JMP I NXTNUL /YES; NOTHING RUNNABLE EXCEPT NULL JOB
NXTCO2, ISZ NXTCOP /BUMP CORTBL POINTER
TAD NXTCOP /ARE WE PAST THE END OF THE TABLE?
TAD I NXTEND
SZA CLA /?
JMP .+3 /NOT YET
TAD FANCOR /YES, START AT THE BEGINNING AGAIN
DCA NXTCOP /ALL SET
TAD I NXTCOP /GET CORTBL ENTRY
SNA /IS THERE ANYTHING IN THERE?
JMP NXTCO4 /NO; CLEAR DEAD JOB POINTER (A FREE FIELD IS BETTER)
AND C6600 /IS IT BEING SWAPPED, LOCKED, OR A PHANTOM?
SZA CLA
JMP NXTCOR /YES - SO IT'S NOT A USEFULL FIELD NOW
TAD I NXTCOP
AND C0037
RUNABL
JMP NXTCO3 /NOT RUNNABLE
TAD I NXTCOP /TRY TO RUN THIS ONE
AND C0037 /GET JOBTBL INDEX
TAD JOBTBA /GET POINTER TO JOB DATA
GETJTI /GET VALUE OF STR0
JOBSTS
AND C0107 /DOES HE WANT TO RUN FIP OR SI FOR ERROR?
SZA CLA
JMP NXTCOR /HAVE TO WAIT 'TIL LATER
TAD I NXTCOP
JMP I .+1 /GO RUN THIS ONE
SCHEI2
NXTCO3, STA
TAD NXTCOP /POINTER-1 OF DEAD JOB
DCA DEAD /SAVE IT
TAD NXTCOP
TAD NXTFLD /FIELD INDEX ONLY
JMS I NXTDSK /IS THERE DISK ACTIVITY IN THIS FIELD?
NXTCO4, DCA DEAD /YES; SO HE'S NOT REALLY DEAD-WOOD THEN
JMP NXTCOR /KEEPLOOKING
NXTNUL, SCHNUL
NXTFLD= C1000 /-CORTBL+1
NXTDSK, DSKACT
NXTCOP, CORTBL+1 /ROUND ROBIN CORTBL POINTER
NXTEND, CORTBE /END OR CORTBL
C0107, 107
C6600, SWAP+LOCK+FIP+SI
UHALSA, L2SA
UHALT, TAD UUOCAL /IS IT AN OSR?
AND C0004
SNA CLA /OSR?
JMP UHALT1 /NO
CDF
GETJTW /YES, GET CURRENT VALUE OF SWITCHES
JOBSWR
DCA UHALT2 /OR IT INTO AC
TAD UHALSA /WHICH IS RIDICULOUS, SINCE OSR
IOR /IS UNIVERSALLY CODED AS LAS, AND
NXTCNT,
UHALT2, 0 /A SIMPLE "DCA L2SA" WOULD DO
UHALT1, TAD UUOCAL /NOW SEE IF IT WAS MICROCODED
AND C0002 /HALT?
SNA CLA
UUOEXT
JMS I USBCSI /LOCATE HIS/HER DDB AND SEE IF HE'S IN SI MODE
TAD FRECNT /USER HAS EXECUTED HLT
TAD C7770
SPA SNA CLA /IF WE'RE SHORT ON FREE CORE, TRY LATER
REDO
GETJTW /CLEAR HIS/HER RUN BIT
JOBSTS
AND C3777 /CLEAR JSRUN
DATFLD
DCA I JOBSWA
TAD CONDBA /CONDBA WAS SET UP BY THE JMS TO UKT0
JMS UHLTMS /NOW TYPE ^BS FOR HIM/HER
WAIT
UHLTMS, 0
DCA UHLTM1 /SET DEVTBL POINTER
RDF
TAD UHMES /EITHER TYPE ^BS OR ^BS;K
DCA AXS2
CDF
UHLTM0, TAD I AXS2 /GET A CHARACTER
SPA SNA
JMP UHLTM2 /END OF TEXT
DCA TTCHAR /SAVE IT
KEY /RUN IT INTO HIS/HER INPUT BUFFER
UHLTM1, .-.
NOP
JMP UHLTM0 /GET ANOTHER ONE
UHLTM2, SZA CLA /WHERE DID WE COME FROM?
CIF DATFLD /BACK TO 689 SERVICE
JMP I UHLTMS
UHMES, .
"B-100
"S
";
"K
215
C7377, 7377
USBCLR, CLRBUF
USBFLG, CLSTR1
"B-100
"S
213
0
USBCSI, UKT0
/SELECTIVE BUFFER CLEAR
USBC, JMS I USBCSI /CHECK FOR SI MODE
DATFLD
TAD L2SA
CLL RAL
SMA CLA /CLEAR INPUT BUFFER?
JMP USBC3 /NO
TAD CONDDB /INPUT DDB ADDRESS
JMS I USBCLR /CLEAR INPUT BUFFER
TAD C0100
JMS I USBFLG /CLEAR FLAG
TAD I CONDDB
AND C7377 /CLEAR FULL BIT
DCA I CONDDB
USBC3, TAD L2SA /WHAT IS REQUESTED?
SMA CLA /CLEAR OUTPUT BUFFER?
JMP USBC4 /NO
ISZ CONDBA /POINT TO OUTPUT SIDE
TAD I CONDBA
JMS I USBCLR /CLEAR OUTPUT BUFFER
USBC4, DCA L2SA /CLEAR HIS/HER AC
UUOEXT
*4200
/STANDARD BOOTSTRAP AND RESTART ADDRESSES
JMP I .+2 /INIT BOOTSTRAP
JMP I .+2 /RESTART ADDRESS
BOOT
DEBUG
FILERC, 0 /ROUTINE TO RECOVER FROM DISK ERRORS
FILUSA, 0 /AND SET ERROR CODES FOR USER
FILEWC, 0 /ERROR CODES ARE:
FILER1= WS2 / 1 PARITY
/ 2 END OF FILE
/ 3 FILE NOT OPEN
/ 4 PROTECTION VIOLATION
FJSF3, -JSF3-1
FILECA= C0004 /FILPCA
FILECT= C0007 /FILPCT
FILEIF= C0002 /FILPIF
C6000, 6000
FILERR, 0
DCA FILERC /ERROR CODE
CLL CLA CMA RAL /AC:=-2
TAD FILERC /ERROR CODE - .GT.2?
SPA SNA CLA /PROTECTED OR NOT OPEN?
JMP FILER2 /NO
GETJTW /GET ADDRESS OF PARAMETER BLOCK
JOBLNK
RETBLK /RETURN IT TO FREE CORE
CLA
TAD L2SA /GET POINTER TO PARAMETERS IN USER AREA
TAD F0005
DCA FILERR /POINTS TO SIXTH USER PARAMETER (ERROR CODE)
TAD FILERC /GET ERROR
UDF /SELECT USER FIELD
DCA I FILERR /PASS ERROR TO USER
CDF
DCA L2SA /CLEAR HIS/HER AC
UUOEXT /AND BACK TO HIM/HER
FILER2, TAD I FILERR /END OF FILE OR PARITY ERROR...
TAD FILEIF /GET ADDRESS OF FILE PARAMETER BLOCK
DCA FILER5 /POINTS TO WORD 3 OF BLOCK
DATFLD
TAD I FILER5 /WAS FILE CALL ORIGINATED BY SI?
AND C6000 /BITS 0-1 WILL BE SET IF SO...
SNA CLA
JMP FILER4 /NO - IT CAME FROM USER PROGRAM
TAD I FILER5 /YES - GET FIELD # FOR TRANSFER
RTR
AND C0007 /MASK OUT FILE # BITS
TAD CORTBA /INDEX INTO CORTBL
DCA FILUSA /SAVE POINTER TO CORTBL ENTRY FOR THIS TRANSFER
CDF
TAD I FILUSA /GET CORTBL ENTRY
AND C0037 /EXTRACT JOB #
DCA FILUSA /SAVE JOB #
CLL CMA RAL /AC=-2
TAD FILERC /IS IT AN END OF FILE?
SNA CLA
JMP FILER3 /YES; WE'RE ALMOST DONE THEN
TAD FILERC /NO - WAS THERE ANY ERROR AT ALL?
SNA CLA
JMP FILER3 /NO
TAD FILUSA /PARITY ERROR - SET SYSTEM ERROR CODE IN STR0
ERROR
F0005, DSKERR
FILER3, ISZ FILERR /INDEX PAST CALLING ARGUMENT
CDF
JMP I FILERR /AND BACK
FILER4, TAD I FILER5 /UPDATE USER CONTROL TO INDICATE ERROR CODE
RAL /SHIFT FIELD # INTO BITS 6-8
AND C0070 /SAVE IT
TAD FILCDF /GENERATE "UDF"
DCA FILER5 /USER FIELD SELECT
CDF
TAD I FILERR /PARAMETER BLOCK ADDRESS
DCA FILEWC /SAVE IT
TAD FILEWC
DATFLD
TAD FILECA
DCA FILER1 /POINTS TO CORE ADDRESS IN PARAMETER BLOCK
TAD I FILER1 /GET CORE ADDRESS
DCA FILER1 /SAVE IT
TAD FILEWC /START OF PARAMETERS
TAD FILECT /+7
DCA FILUSA /POINTS TO PTR TO FILE CONTROL
TAD I FILUSA /GET ADDRESS OF FILE CONTROL
TAD C0006 /POINTS TO WORD COUNT IN FILE CONTROL
DCA FILEWC /SAVE IT
TAD FILEWC
IAC
DCA FILUSA /POINTS TO POINTER TO USER PARAMETERS
TAD I FILUSA /GET POINTER TO USER ARGUMENTS
DCA FILUSA /SAVE
TAD I FILEWC /GET WORD COUNT TO GO FROM CONTROL BLOCK
FILER5, 0 /SELECT USER FIELD
DCA I FILUSA /SAVE IN USER AREA
ISZ FILUSA /POINTS TO WORD 4 OF USER ARGUMENTS
TAD FILER1 /GET LATEST CORE XFER ADDRESS
DCA I FILUSA /SAVE FOR USER
ISZ FILUSA
ISZ FILUSA /POINTS TO WORD 6 (ERROR WORD)
TAD FILERC /GET ERROR CODE
DCA I FILUSA /PASS ON TO USER
FILCDF, CDF
JMP FILER3 /AND BACK
BRKTBL, -"Z-1 /LETTERS
"Z-"A+1
2000
"A-"9-1 /NUMBERS
"9-"0+1
1000
"0-211-1 /HORIZONTAL TAB
211-211+1
0400
211-215-1 /LF, VT, FF, CR
215-212+1
0200
212-";-1 /! @ # DOLLAR % & ' ( ) * + , - . / : ;
";-"!+1
0100
"!-240-1 /SPACE
240-240+1
0040
240-"@-1 /< = > ? @
"@-"<+1
0020
"<-"_-1 /[ \ ] _
"_-"[+1
0010
"[-377-1 /RUBOUT
377-377+1
0004
377-376-1 /ALTMODE
376-375+1
0002
375-377-1 /EVERYTHING ELSE
377-0+1
0001
*4400
/RFILE AND WFILE IOTS
UFILE, TAD UFILWA /NO, GET USER PARAMETERS
JMS I UFPARM /AND MOVE TO PARAMETER BLOCK
TAD I UFLNKA /ADDRESS OF PARAMETER BLOCK
TAD UFIPIF
DCA UFPARA /POINTS TO WORD 3 OF BLBOCK
DATFLD
TAD I UFPARA /CLEAR ALL BUT FILE # IN BLOCK
AND C0003
DCA I UFPARA /SAVE IT
TAD L2SA /ADDRESS OF USER PARAMETERS
TAD UFIPWC /+2
DCA UFILE1 /POINTS TO WORD COUNT IN USER AREA
TAD I UFPARA /FILE #
SIFIL1, CDF
TAD UFJF0 /RELATIVE ADDRESS OF FILE 0 POINTER
DCA UFJOBF /RELATIVE ADDR OF FILE POINTER FOR THIS FILE
GETJTW
UFJOBF, 0 /POINTER TO FILE CONTROL INFO
SNA
JMP UFILER+1 /FILE NOT OPEN
DCA UFJOBF /SAVE POINTER TO FILE CONTROL
DATFLD
TAD I UFPARA /FILE #
JMS I UFIGJF /GENERATE CORRESPONDING FILE BIT IN STR1
DCA UFIJSF /FILE STATUS FLAG
TAD L2SF /USER'S FIELD #
AND C0007
CLL RTL /*4
DCA JOBSWA /SAVE
TAD I UFPARA /GET FILE # + ORIGINATING STATUS INFO
AND C7743 /CLEAR FIELD #
TAD JOBSWA /SET FIELD #
DCA I UFPARA /SAVE IN PARAMETERS
TAD UFJOBF /SAVE GLOBAL PARAMETERS
IAC /POINTS TO WORD 2 OF CONTROL BLOCK
DCA AXS1 /CONTROL INDEX
CLL CLA CMA RTL /AC:=-3
TAD UFPARA
DCA AXS2 /PARAMETER INDEX POINTS TO START OF PARAMETERS-1
TAD I AXS2 /WRITE AND PROTECTED?
AND I AXS1
AND C0004 /CHECK ONLY FOR WRITE PROTECT
SZA CLA
JMP UFILER /YES - ERROR
TAD AXS2 /NO, SET FILPAR = START OF PARAMETER BLOCK
DCA I AXS1
TAD I AXS2 /DISC EXTENSION FROM PARAMETERS
DCA I AXS1 /TO CONTROL BLOCK
ISZ AXS2 /SKIP FIELD
TAD I AXS2 /SAVE WC
DCA JOBSWA
ISZ AXS2 /SKIP CORE ADDRESS FOR NOW
TAD I AXS2 /DISC ADDRESS
DCA I AXS1 /TO CONTROL BLOCK
TAD UFIRET /RETURN ADDRESS
DCA I AXS2 /TO PARAMETER BLOCK
TAD UFJOBF /POINTER TO FILE CONTROL
DCA I AXS2 /TO PARAMETER BLOCK
TAD JOBSWA /WORD COUNT
DCA I AXS1 /TO CONTROL BLOCK
TAD UFILE1 /POINTS TO WC IN USER AREA
SNA /IS THIS AN SI REQUEST?
JMP .+3 /YES
DCA I AXS1 /NO, SAVE POINTER TO WC IN CONTROL BLOCK
DCA L2SA /CLEAR USER AC
TAD UFJOBF /POINTER TO CONTROL BLOCK
TAD UFPAR2 /+3
DCA UFILPA /POINTS TO POINTER IN CONTROL BLOCK POINTING TO PARAM. BLOCK
TAD UFJOBF /POINTS TO FILE CONTROL
JMS I UFILIX /GET SEGMENT INDEX
JMP I UFIL4A /NOT IN CORE - DO A WINDOW TURN
JMP UFILE2 /NON-EXISTENT DISC ADDRESS
JMS I UFICTB /OK, SET UP TRANSFER BLOCK - POINTER TO SEGMENT # IN AC
UFILPA, 0 /POINTER TO FILPAR
TAD I UFILPA /ADDRESS OF PARAMETERS
JMS I UFIQUE /QUEUE THE REQUEST IN DSUTBL
ISZ DSBUSY /DISC BUSY?
SKP /YES
JMS I FIUSER /NO, START TRANSFER
TAD UFIJSF /CLEAR FILE STATUS BIT
UUOEXT /EXIT
SIFILE, DATFLD /HANDLE SI FILE TRANSFERS
TAD UFIPIF
DCA UFPARA /POINTS TO FILE # IN PARAMETERS
DCA UFILE1
TAD I UFPARA /GET FILE #
AND C0003 /ONLY FILE #
JMP SIFIL1 /REST IS SAME AS USER PROGRAMS
UFILE2, GETJTW /NON-EXISTENT DISK ADDRESS
JOBLNK /GET ADDRESS OF PARAMETERS
DCA UFILE1 /SAVE IT
JMP .+3
UFILER, IAC /PROTECTED
IAC /NOT OPEN
TAD C0002 /EOF
CDF
JMS I UFERR /FILE ERROR ROUTINE
UFILE1, 0 /POINTS TO PARAMETER BLOCK
TAD UFILE1
RETBLK /RETURN PARA BLK
CLA
TAD CURJOB /DID WE BUMP SOMEONE ELSE OFF?
SZA CLA
WAIT /YES - GO BACK TO HIM/HER
UUOEXT /NO - BACK TO THIS USER
UFPARA= WS0 /ADDR OF USER PARAMETERS
UFIJSF= WS1 /FILE STATUS FLAG
C7743, 7743
UFILWA, UFILCT
UFJF0, JOBF0
UFPAR2= C0003 /FILPAR
UFIPIF= C0002 /FILPIF
UFIPWC= C0002 /FILPWC
UFPARM, GETUSP
UFLNKA, UUOLNK
UFERR, FILERR
UFILIX, FILIX
UFIRET, DSURET
UFICTB, FILCTB
UFIGJF, GETJFX
UFIQUE, DSQUE
UFIL4A, UFILE4
RKL20, CIF DATFLD-1
JMP I .+1
RKL21
/RETURN CONTENT OF JOB STATUS FOR CURRENT JOB
/CALL
/ GETJTW
/ RELATIVE ADDRESS OF WORD
/ RETURN (CONTENTS IN AC, ABSOLUTE ADD IN JOBSWA)
GETJW0, 0
TAD I GETJW0 /GET RELATIVE ADDRESS
DCA .+3 /SAVE IT
TAD CJOBDA /POINTER TO CURRENT JOB STATUS
GETJTI /GETCONTENTS
0
ISZ GETJW0 /INDEX RETURN
JMP I GETJW0
*4600
/RETURN NUMBER OF NEXT RUNNABLE JOB IN AC
/CALL JMS NXTJOB
/ RETURN WITH JOB # IN AC
FILCDA,
NXTJCT, 0
NXTJBN, 0 /NEXT JOB #
NXTJMM, -JOBMAX
FILCT2,
NXTJOB, 0
DCA FIT /CLEAR FIT
TAD BONUS /IS THERE ANY JOB BROKEN OUT OF KEYBOARD WAIT?
RUNABL /IS IT RUNNABLE?
JMP NXTJ1 /NO, GET THE NEXT JOB
TAD BONUS /THIS JOB
JMP I NXTJOB
NXTJ1, ISZ NXTJCT /HAVE WE TRIED ALL JOBS?
SKP /NO, KEEP GOING
SCHED /TRY FOR A RESIDENT JOB
TAD NXTJBN /IS IT TIME TO WRAP AROUND TO JOB 1?
TAD NXTJMM
SNA CLA
DCA NXTJBN /YES
ISZ NXTJBN /INCREMENT NUMBER OF JOB UNDER CONSIDERATION
NXTJ2, TAD NXTJBN /IS THE JOB RUNNABLE?
RUNABL
JMP NXTJ1 /NO, CONTINUE JOB TABLE ROUND ROBIN
TAD NXTJBN /YES, RETURN WITH JOB NO. IN AC
JMP I NXTJOB
/CONSTRUCT TRANSFER BLOCK
/CALL TAD SEGMENT WINDOW POINTER
/ JMS FILCTB
/ POINTER TO FILPAR
FILCPD= C0004 /FILPDA-FILPDX
FILCWC= C7776 /FILPWC-FILPDA
FILCSW= JOBSWA /POINTER TO SEGMENT WINDOW
FILCPA= WS2 /POINTER TO FILPAR & FILDA
FILCWA, 0
FILCPX, 0 /POINTER TO FILPDX, FILPDA & FILPWC
FILCTB, 0
DCA FILCSW /SAVE POINTER TO SEGMENT IN WINDOW
TAD I FILCTB
DCA FILCPA /ADDRESS OF POINTER TO PARAMETER BLOCK
ISZ FILCTB /SKIP ARGUMENT IN CALL
DATFLD
TAD I FILCPA /GET ADDRESS OF PARAMETERS
IAC /POINTS TO WORD 2 OF PARAMETERS
DCA FILCPX
ISZ FILCPA /POINTS TO DISK EXTENSION IN CONTROL BLOCK
CLA CMA
TAD I FILCSW /GET SEGMENT #
CLL RAR
RTR
RTR /MULTIPLY BY 400 SEG SIZE
DCA FILCT2 /SAVE "PRODUCT"
TAD FILCT2
RAL
AND SEGSM1 /THROW OUT CONTRIBUTION FROM HI ORDER BITS OF EXTENSION
TAD FIBAS1 /START OF LOGICAL FILE AREA
CLL RTL
DCA I FILCPX /SAVE IN DISK EXTENSION IN PARAMETER BLOCK
TAD FILCT2 /NOW GET LOW ORDER ADDRESS
AND SEGLMK
DCA FILCT2 /AND SAVE IT
TAD FILCPX /SET DISC ADDRESS
TAD FILCPD
DCA FILCPX /POINTS TO LOW ORDER ADDRESS IN PAR. BLOCK
TAD FILCPA
IAC
DCA FILCDA /POINTS TO LOW ORDER ADDRESS IN CONTROL BLOCK
TAD I FILCDA /GET WORD ADDRESS SUPPLIED BY USER
AND SEGSM1 /(WORD IN SEGMENT)
TAD FILCT2 /+ WORD ADDRESS FROM SEGMENT ARITHMETIC
DCA I FILCPX /SAVE IT IN PARAMETER BLOCK
TAD FILCPX /SET WORD COUNT
TAD FILCWC
DCA FILCPX /POINTS TO WORD COUNT IN PARAMETER BLOCK
DCA I FILCPX /NOTHING TRANSFERRED YET
TAD FILCDA
IAC
DCA FILCWA /POINTS TO WORD COUNT IN CONTROL BLOCK
FILCT1, TAD SEGSM1 /SEGS12-1
AND I FILCDA /LOW ORDER ADDRESS IN CONTROL BLOCK
DCA FILCT2 /DISC ADDRESS MOD SEGS!Z
TAD I FILCWA /GET -WC FROM CONTROL BLOCK
CLL CIA /+WC
TAD FILCT2 /IF WE DO ENTIRE WC WILL WE GO INTO NEXT
AND SEGLMK / SEGMENT?
SNA CLA
SZL
JMP FILCT3
TAD I FILCWA /NO
JMP .+3
FILCT3, TAD SEGLMK /SUBTRACT SEGS12 FROM WC, SO WE STAY IN SAME SEGMENT
TAD FILCT2
DCA FILCT2 /WORD COUNT FOR TRANSFER
TAD FILCT2 /UPDATE WORD COUNT IN PARAMETER BLOCK
TAD I FILCPX /OLD VALUE
DCA I FILCPX /NEW VALUE
TAD FILCT2 /UPDATE WORD COUNT IN FILE CONTROL BLOCK
CIA /+WC
TAD I FILCWA /OLD -WC
DCA I FILCWA /NEW -WC
TAD I FILCWA /ARE WE DONE?
SNA CLA
JMP I FILCTB /YES
TAD FILCT2 /INCREMENT DISC ADDRESS
CLL CIA /+WC
TAD I FILCDA /OLD DISC ADDRESS
DCA I FILCDA /NEW DISC ADDRESS
SZL /OVERFLOW?
ISZ I FILCPA /YES - INDEX DISC EXTENSION
TAD I FILCSW /GET CURRENT SEGMENT #
CLL CMA /-(SEGMENT # +1)
DCA FILCT2 /SAVE IT
ISZ FILCSW /POINTS TO NEXT SEGMENT IN WINDOW
TAD FILCSW /ARE WE STILL IN THE WINDOW?
AND C0007
SZA CLA /NEXT POINTER IN CORE?
JMP FILCT4 /YES, SEE IF NEXT SEGMENT IS CONTIGUOUS
TAD BASWIN /NO, IS IT BASIC?
TAD FILCSW /COMPARE THE WINDOW ADDRESS WITH BASIC WINDOW ADDRESS
SNL CLA
JMP I FILCTB /NO, RETURN
FILCT4, TAD I FILCSW /GET THE NEXT SEGMENT
TAD FILCT2 /CONTIGUOUS SEGMENTS?
SNA CLA
JMP FILCT1 /YES - CONTINUE THE TRANSFER
JMP I FILCTB /RETURN
FIBAS1, SWDEX+JOBMAX
/TAKE CARE OF DUPLEX AND UNDUPLEX IOT'S
UDUP, TAD C0200 /DUPLEX BIT IN DDB WORD 1
UUND, DCA WS0 /WS0 CONTAINS BIT TO ADD FOR BOTH IOT'S
TAD JOB
TTYUSE /FIND INPUT DDB
DCA WS1 /ADDRESS OF DDB
DATFLD
TAD I WS1 /WORD ONE OF DDB
AND C7577 /CLEAR DUPLEX BIT
TAD WS0 /SET IT AS CALLED FOR
DCA I WS1
UUOEXT
C7577, 7577
*5000
/TELEPRINTER IOT'S
UTELC= WS0
UTEL, JMS UKT0 /FIND THE CONSOLE # ATTACHED TO JOB
ISZ CONDBA /POINT TO OUTPUT SIDE
UULPT, TAD UJSTEL /TTY FLAG
UUPTP, DCA UOUTFL /SAVE THE DEVICE'S FLAG
JMS UKT1 /WHAT IS REQUESTED BY USER?
JMP UTELS /SEND A STRING (6XX0)
UOUTFL, JSTEL /DEVICE FLAG POSITION IN STR1
JMP I UTELS1 /UNCONDITIONAL SKIP ON USER "TSF, PSF, OR LSF"
SNA CLA /6XX4 OR 6XX2
UUOEXT /6XX2 - IF WE CLEAR FLAGS WE MAY DIE
TAD L2SA /6XX4
DCA TTCHAR
PRINT /OUTPUT THE CHARACTER
SKP /NO ROOM - REDO LATER
UUOEXT /OK - ALL DONE
STA /BACK UP HIS/HER PC
TAD L2SV0
DCA L2SV0
JMP UTELS6
UTELS5, DCA L2SA /CLEAR USER'S AC
TAD UKT0 /KEEP HIM/HER RUNNING IF WE WERE ABLE TO ACCEPT ANY CHARACTERS
SNA CLA
UTELS6, TAD UOUTFL /MAKE HIM/HER WAIT FOR DEVICE FLAG
UUOEXT /AND AWAY
UJSTEL, JSTEL
UKT0, 0
TAD JOB
TTYUSE /GET ADDR OF INPUT DDB
DCA CONDDB /SAVE IT
DATFLD /GET CONTENTS OF FIRST WORD OF DDB
TAD I CONDDB /UNIT # + FLAGS IN AC
CDF
AND C1000
SNA CLA /CONSOLE IN SI MODE?
JMP I UKT0 /NO - OK TO CONTINUE
GETJTW
JOBWMK
CLA
DATFLD
DCA I JOBSWA /CLEAR HIS/HER WAIT MASK TO HANG HIM/HER UP
REDO /SI WILL WAKE HIM/HER UP TO TRY AGAIN LATER
UJSPTP= C0004
/ "SEND-A-STRING"
UTELS, UDF /SELECT USER'S FIELD
TAD I L2SA
SNA CLA
JMP UTELS4 /USER'S W.C. IS ZERO - SO SEND NOTHING
DCA UKT0
TAD L2SA
IAC
DCA UTELC /POINTS TO ADDRESS OF STRING IN USER AREA
TAD I UTELC /GET ADDRESS-1 OF STRING
DCA AXS2 /SAVE POINTER TO STRING
UTELS3, TAD I AXS2 /GET CHARACTER FROM USER
CDF
DCA TTCHAR
PRINT /OUTPUT THE CHARACTER
JMP UTELS5 /BUFFER FULL
UDF
ISZ I UTELC /BUMP ADDRESS IN USER AREA
ISZ UKT0 /DOESN'T MATTER THAT WE MAY SKIP THIS
ISZ I L2SA /BUMP USER'S WORD COUNT
JMP UTELS3 /KEEP GOING
UTELS4, DCA L2SA /ALL DONE --- CLEAR USER AC
JMP I UTELS1 /EXIT AND SKIP
UTELS1, UUOEX2
/LINE PRINTER UUO'S
ULPT, JMS I UPTLPA
DEVTBE+3 /LINE PRINTER POSITION IN DEVTBL
TAD .-1
DCA CONDBA /IT'S OK TO USE THE PRINTER
TAD UJSTEL /LPT FLAG (20+20=40)
JMP UULPT
/PAPER TAPE PUNCH UUO'S
UPTP, JMS I UPTLPA /OK TO USE PUNCH?
DEVTBE+1 /PUNCH'S POSITION IN THE DEVTBL
TAD .-1
DCA CONDBA /PASS ON THE PUNCH'S POSITION
TAD UJSPTP /PUNCH FLAG
JMP UUPTP
UPTLPA, DEVCHK
/ROUTINE TO ANALYZE IOT'S
/CALLING SEQUENCE:
/ IOT IN UUOCAL
/ JMS UKT1
/ RETURN FOR STRING IOT
/ FLAG TO CHECK IN STR1
/ RETURN FOR NON-SKIPPING FLAG TESTS
/ RETURN FOR EVENT TIMES 2 AND 4 (AC=BIT 9 OF IOT; LINK=BIT 10)
/ ILLEGAL MICRO-CODING RESULTS IN "NOP"
/ SKIPPING FLAG RESULTS IN INCREMENT OF USER PC
UKT1, 0
TAD UUOCAL
AND C0007
SNA /STRING?
JMP I UKT1 /YES
ISZ UKT1
CLL RAR /NO
SNL /SKIP TEST?
JMP UKT12 /NO
SZA CLA /YES - ANYTHING ELSE?
UUOEXT /YES - BAD MICRO-CODING
GETJTW /GET HIS/HER STR1
JOBSTS+1
AND I UKT1 /FLAG TO CHECK
CLL RTR /IGNORE THE ERROR FLAG
ISZ UKT1 /INDEX PAST ARGUMENT
SNA CLA /FLAG SET?
JMP I UKT1 /NO - DON'T SKIP
JMP I UTELS1 /YES - SKIP ON EXIT
UKT12, ISZ UKT1
ISZ UKT1
CLL RAR
JMP I UKT1 /INDEX RETURN
UUOERR, CDF /SET "ILLEGAL IOT" ERROR CODE
TAD JOB
ERROR
UUOERF /CODE=1
USYN, WAIT /AND BACK TO THE SCHEDULER
USTMT1= WS0
SLEEP, TAD JOB
SNA CLA /PROBABLE TROUBLE DUE TO EAE
EXIT
TAD C0002
DOUSTM, CIA /NEGATE
DCA DOSTM1 /SAVE - # UNITS OF TIME
TAD JOB /SET CLKTBBL ENTRY FOR THIS JOB
TAD CLKTBA
DCA USTMT1 /POINTS TO THIS JOB'S ENTRY
TAD DOSTM1
DATFLD
DCA I USTMT1 /SET TABLE ENTRY
STL RAR /SET AC=JSTIME
UUOEXT /EXIT AND WAIT
DOSTM1, 0
CLKTBA, CLKTBL /JOB TIMER TABLE ADDRESS
*5171
OVERLA, SKP /ERROR
JMP I OVER1A /OK, FINISH UP
TAD I FANCOR /GET NUMBER OF JOB IN TROUBLE
ERROR /PASS ERROR TO USER
DSKERR
JMP I OVER1A /NOW FINISH UP
OVER1A, OVERL1
/NULL JOB IS THE ONLY INSTRUCTION IN FIELD 0 WHICH
/IS EXECUTED IN USER MODE.
/IT IS RUN WHENEVER THERE IS NOTHING ELSE
/TO DO, OR NOTHING ELSE THAT CAN BE DONE.
/
/WHEN DEBUGGING THE MONITOR, IT IS POSSIBLE
/TO STOP (VIA THE PDP-8 OPERATOR CONSOLE) THE MONITOR
/TO ENTER XDDT. THIS MAY ONLY BE DONE
/WHEN THE SYSTEM IS IN NULJOB. IF THE
/SYSTEM IS STOPPED WHEN NOT IN NULJOB, IT MAY
/BE RESTARTED BY HITTING "CONTINUE," AND THEN
/STOPPED AGAIN. KEEP TRYING - EVENTUALLY YOU'LL CATCH IT.
/DO NOT STOP THE SYSTEM (AND EXPECT TO GET AWAY WITH IT)
/IF ANY I/O IS IN PROGRESS.
/IF THE SYSTEM IS STOPPED IN NULJOB, IT MAY BE
/RESTARTED AT LOCATION 4201 IN FIELD 0.
NULJOB, JMP . /IT'S A BIGGY, ISN'T IT?
/RETURN FILE WINDOW INDEX
/CALL TAD POINTER TO FILE CONTROL
/ JMS FILIX
/ SEGMENT ADDRESS NOT IN WINDOW
/ NON-EXISTENT FILE ADDRESS
/ OK RETURN WITH ADDRESS OF SEGMENT POINTER
FILIDA= C0004 /FILDA
FILIX, 0
DCA FILICN /SAVE POINTER TO FILE CONTROL
TAD FILICN
TAD FILIDA /4
DATFLD
DCA FILSP2 /POINTS TO FILE EXTENSION IN CONTROL BLOCK
TAD I FILSP2 /FILE EXTENSION
AND C0177 /LIMIT FILE SIZE TO 1777777 (?!?)
DCA FILSP1 /HIGH ORDER COMPONENT OF SEG #
ISZ FILSP2 /POINTS TO LOW ARDER ADD
TAD I FILSP2 /LOW ORDER ADDRESS
AND SEGLMK /GET RID OF ADDRESS IN SEGMENT
CLL RAL
TAD FILSP1 /HIGH ORDER PART
RTL /"DIVIDE" BY 400 SEG SIZE
RTL
CIA /-(SEGMENT# -1)
DCA FILISN
TAD FILICN
IAC
DCA FILICA /POINTS TO SEGMENT # INDEX IN WINDOW
TAD I FILICN /POINT TO WINDOW
DCA FILICN
TAD I FILICN /GET WORD 1 OF WINDOW
AND C0007 /VALID WINDOW?
SZA
JMP FILIX5 /NO, IT IS A BASIC WINDOW
TAD I FILICA /YES
TAD FILISN
SMA SZA /FILSCT-SN>0?
JMP FILIX2 /YES, SEGMENT POINTER NOT IN CORE
TAD C0006 /FILSCT+6-SN<0?
SMA
JMP FILIX1
CLA /YES, SEGMENT POINTER NOT IN CORE
TAD I FILICN /ANY MORE SEGMENTS?
SNA CLA
ISZ FILIX /NO, NON-EXISTENT FILE ADDRESS
FILIX2, CLA
FILIX3, CDF
JMP I FILIX /RETURN
FILIX5, AND C0006 /IS IT BASIC OR INVALID WINDOW?
SNA CLA
JMP FILIX3 /INVALID WINDOW
TAD FILISN /GET -(SEG # -1)
TAD BASWIN
CIA /AC=SEG # -1
SPA
JMP FILIX4
JMP FILIX2-1 /BASIC BUT NON-EXISTENT
FILIX1, CIA
TAD C0007 /WINDOW INDEX
TAD FILICN /START OF WINDOW
FILIX4, DCA FILICA /POINTS TO SEGMENT #
ISZ FILIX /SEGMENT ADDRESS IN CORE - EXIT
TAD I FILICA /GET SEGMENT # FOR THIS FILE ADDRESS
SNA CLA
JMP FILIX3 /ZERO SEGMENT NUMBER IS NOT A SEGMENT!
TAD FILICA /EXIT WITH POINTER TO THIS SEGMENT IN AC
ISZ FILIX
JMP FILIX3
FILISN, 0
FILICN, 0
/RETURN USER RUN TIME
/USER CALLS WITH ADDRESS OF THREE WORD BLOCK
/WORD 1 CONTAINS THE JOB #
/THE HI AND LO ORDER RUN TIMES ARE RETURNED IN WORDS 2 AND 3
UURT, UDF /USER FIELD
TAD I L2SA /JOB #
JMS I JOBCHB /SEE IF IT'S A VALID JOB
JMP UURT0 /IT WASN'T
TAD JOBTBA
GETJTI /LOW ORDER RUNTIME
JOBRTM
ISZ JOBSWA
UURT0, DCA UCOP2
DATFLD
TAD I JOBSWA
DCA UCOP1
JMP UCOPY2-2 /COPY IN USER AREA
JOBCHB, JOBCHK
/RETURN THE TIME OF DAY IN SYSTEM TICKS SINCE MIDNIGHT.
/USER CALLS WITH ADDRESS OF TWO WORD BLOCK IN AC.
/HI AND LOW ORDER PARTS RETURNED IN WORDS 1 AND 2.
UTOD, TAD CLK1 /-TIME TILL MIDNIGHT
CLL
TAD INKLK1 /TIME AT MIDNIGHT
DCA UCOP2 /LOW ORDER TIME NOW
RAL
TAD CLK2 /-TIME TILL MIDNIGHT
TAD INKLK2 /TIME AT MIDNIGHT
DCA UCOP1 /TIME NOW (HIGH ORDER)
JMP UCOPY2 /COPY IN USER AREA
INKLK1, INCLK1
INKLK2, INCLK2
/RETURN THE USER'S STATUS REGISTERS
/CALLED WITH ADDRESS OF THREE WORD BLOCK IN AC
UCKS, GETJTW
JOBSTS
DCA UCOP0 /STATUS 0
DATFLD
ISZ JOBSWA
TAD I JOBSWA /STATUS 1
DCA UCOP1
ISZ JOBSWA
TAD I JOBSWA
DCA UCOP2 /STATUS 2
UDF /SELECT USER FIELD
TAD UCOP0
DCA I L2SA
ISZ L2SA /BUMP POINTER
NOP
UCOPY2, UDF /FOR LATER ENTRIES
TAD UCOP1 /SECOND WORD
DCA I L2SA
ISZ L2SA
NOP
TAD UCOP2 /THIRD WORD
DCA I L2SA
DCA L2SA /CLEAR USER AC
UUOEXT
DEVJO0,
UCOP0,
FILSP1, 0
UCOP1,
FILSP2, 0
UCOP2, 0
/ROUTINE TO EXTRACT JOB NUMBER FROM DDB
/CALL
/ TAD (DDB ADDRESS)
/ JMS DEVJOB
/ RETURN WITH JOB # IN AC
FILICA,
DEVJOB, 0
IAC
DCA DEVJO0 /POINTS TO WORD 1 OF DDB
DATFLD
TAD I DEVJO0 /GET WORD 1
AND C0037 /IGNORE JUNK
JMP I DEVJOB /RETURN
C7037, SWAP LOCK NOTRUN CJOB
FIPLOA, FIPLOK
L2FIP, TAD C7037 /OK - ALLOW FIP TO BE OVER-WRITTEN BY USER JOBS AGAIN
DCA I FIPLOA
EXIT
/WE ENTER THIS ROUTINE AT LEVEL 2
/AFTER COMPLETING A DISK TRANSFER
/IF A FILE TRANSFER IS INVOLVED, WE CONTINUE
/WITH IT
/IF OVERLAY, WE GO TO OVERLAY CONTROL
/IF OVERLAY IS COMPLETED WE FORCE THE SCHEDULER TO RUN THE PHANTOM
DSURT1= WS0
DSURT2= WS1
DSURDA= C0004 /FILDA
DSUET1= WS0
DSURET, IAC /ERROR IN DISK TRANSFER
DCA DSKCOD /SAVE ERROR CODE
TAD DSKPTR /POINTS TO REQUEST CURRENTLY RUNNING
TAD DSUMTB /FIND RELATIVE INDEX IN TABLE
CLL RTR /DIVIDE BY FOUR
AND C0007 /SAVE FIELD
TAD CORTBA /INDEX INTO CORTBL
DCA DSUCOR
TAD I DSUCOR /GET CORTBL ENTRY
AND C0037 /EXTRACT JOB #
TAD JOBTBA /POINTS TO JOBTBL
DCA DSUJTE /SAVE JOBTBL ADDRESS
TAD DSUJTE
GETJTA /GET ADDRESS OF STR0
JOBSTS
DCA DSUJST /SAVE IT
TAD DSKCOD /IS THERE AN ERROR?
SZA
JMP DSURER /YES - JMP OUT OF THE ROUTINE AS QUICKLY AS POSSIBLE
JMS DSUPAR /PARAMETER BLOCK ADDRESS
TAD DSURDA
DCA DSURT1 /POINTS TO WORD 5 OF PARAMETERS
TAD I DSURPA /ADDRESS OF PARAMETERS
IAC
DCA DSURT2 /POINTS TO DISK EXTENSION IN PARAMETERS
DATFLD
TAD I DSURT1 /DISC EXTENSION FROM CONTROL...
DCA I DSURT2 / ... TO PARAMETERS
TAD DSURT2
TAD C0004
DCA DSURT2 /POINTS TO DISC ADDRESS IN PARAMETERS
ISZ DSURT1 /POINTS TO DISC ADDRESS IN FILE CONTROL
TAD I DSURT1 /DISC ADDRESS FROM CONTROL...
DCA I DSURT2 / ...TO PARAMETERS
ISZ DSURT1 /POINTS TO WORD COUNT IN FILE CONTROL
CLL CMA RAL
TAD DSURT2
DCA DSURT2 /POINTS TO WORD COUNT IN PARAMETERS
TAD I DSURT2 /SAVE TEMPORARILY -WC FROM PARAMETERS
CIA
DCA DSKCOD
TAD I DSURT1 /MOVE WC FROM FILE CONTROL...
DCA I DSURT2 / ...TO PARAMETERS
ISZ DSURT2 /POINTS TO CORE ADD IN PARAM.
TAD DSKCOD /UPDATE CORE ADD BY COUNT TRANSFERRED
TAD I DSURT2
DCA I DSURT2 /SAVE NEW AADD
TAD I DSURT1 /GET WORD COUNT FROM CONTROL
CDF
C7640, SZA CLA /ARE WE DONE?
JMP DSURE2 /NO
DSURER, DCA DSKCOD /SAVE ERROR STATUS IF IT IS AN ERROR
TAD I DSURPA /GET ADDRESS OF PARAMETER BLOCK
DCA .+3 /FOR CALL TO FILERR
TAD DSKCOD /ERROR CODE
JMS I DSUFEA /HANDLE ERROR
0
CLL
TAD I DSUCOR
TAD C7640 /SET "NOTRUN" IF NOT INHIBITED
AND DSHOLD /SAVE "NOTRUN," "NOHOLD," & AND JOB
SNL /ANY MORE BONUSES DUE?
DCA I DSUCOR /YES - SET "NOTRUN" SO HE WON'T BE SWAPPED OUT BEFORE BEING RUN AGAIN
DSURE1, DCA DSFLAG
ISZ DSUJST /SET INACTIVE FLAG IN STR1
TAD DSKPTR /FIGURE OUT WHICH INTERNAL FILE #
TAD DSUMTB
JMS I DGETJX
DATFLD
TAD I DSUJST /NOW SET FILE READY & DUMMY WAIT BIT
DCA I DSUJST /SAVE STR1
JMS DSURE4
ISZ DSFLAG /THIS TRANSFER COMPLETE?
RSCHED /YES - BUMP OOFF THE NULL JOB IF POSSIBLE
TAD I DSUCOR
JMP I .+1 /GO SET UP FOR THE NEXT PART OF THIS TRANSFER
FILCON
DSURPA, DSPARM
DSUFEA, FILERR
/MOVE SEGMENT WINDOW
DSURE2, TAD DSUJTE /SET JOBLNK
GETJTA
JOBLNK
DCA DSKCOD /SAVE POINTER TO JOBLNK
TAD I DSURPA /GET ADDRESS OF PARAMETER BLOCK
DATFLD
DCA I DSKCOD /AND SAVE IN JOBLNK
CDF
DCA I DSURPA /CLEAR DSPARM
STA /-1 TO SET TRANSFER INCOMPLETE FLAG
JMP DSURE1
DSUCOR, 0
DSHOLD, NOTRUN NOHOLD CJOB
DSUMTB, -DSUTBL
DGETJX, GETJFX
DSKCT, DSKCON
DSKCOD, 0
DSURE4, 0
TAD DSKPTR /CURRENT REQUEST POINTER
DCA DSUET1
DATFLD
DCA I DSUET1 /CLEAR THIS REQUEST
CDF
TAD I DSURPA /RETURN PARAMETER BLOCK IF FINISHED
SZA
RETBLK /OK - RETURN IT
JMS I DSKCT /DECREMENT BUSY - START ANY TRANSFER THAT'S WAITING
JMP I DSURE4
DSUJST, 0 /POINTER TO JOB STATUS
DSUJTE, 0 /JOB TABLE ENTRY
DSFLAG,
DSUPAR, 0 /GET PARAMETER BLOCK ADDRESS
TAD I DSURPA /GET ADDRESS
TAD C0007 /GET POINTER TO LAST WORD IN BLOCK
DCA DSUET1
DATFLD
TAD I DSUET1 /GET ADDRESS OF FILE CONTROL
CDF
JMP I DSUPAR /EXIT
OVERL1, JMS DSUPAR /GET ADDRESS OF FILE CONTROL, & CLEAR DSFLAG
SZA
JMP OVE2
TAD I FANCOR
TAD C1000 /NOT RUN YET
DCA I FANCOR
TAD SCHPHA
OVE2, DCA DSFLAG /DISPATCH ADDRESS
JMS DSURE4
JMP I DSFLAG
SCHPHA, SCHFAN
/GET JSFX
/CALL TAD FILE #
/ JMS GETJFX
/ RETURN WITH JSFX IN AC
GETJFX, 0
AND C0003 /FILE # ONLY
CMA
DCA TRAC /-SHIFT COUNT
STL RAR
RAR
ISZ TRAC /DONE?
JMP .-2
JMP I GETJFX /YES, EXIT WITH BIT SET IN AC
USIZE, TAD SEGSIZ /RETURN SEGMENT SIZE IN AC
JMP UUAC
UUSE, TAD JOB /RETURN JOB # IN AC
JMP UUAC
TICSPS /# TICKS PER SECOND
URCR, TAD .-1 /RETURN CLOCK RATE
UUAC, DCA L2SA
UUOEXT
/ROUTINE TO RECOGNIZE AND REPLY TO ^C
GIR9, TAD CONDDB
JMS I PTJOB /GET HIS/HER JOB NUMBER FROM THE DDB
CDF
TAD JOBTBA
DCA WS1
TAD WS1 /POINTS TO JOB DATA AREA
GETJTI
JOBSTS+1 /GET STR1
AND GIRFCL /CLEAR TIMER, AND DELIMITER FLAGS & JSWAIT
DATFLD
DCA I JOBSWA
STL RTL
TAD JOBSWA
DCA WS0 /POINTS AT WAIT MASK 1
TAD I WS0 /ARE WE WAITING FOR A FILE TRANSFER?
AND GIRFIL
ISZ WS0 /POINTS AT WAIT 2
TAD I WS0 /OR - WAITING FOR DECTAPE, RK05, OR CARDREADER?
SNA CLA
ISZ I JOBSWA /NO - SET DUMMY WAIT BIT
ISZ WS0 /POINT TO RESTART ADDRESS
CDF
TAD WS1 /GET POIONTER TO JOBREG
GETJTI
JOBREG
CLA
TAD CONDDB /GET JOB NUMBER
JMS I PTJOB /AC=JOB; DATA FIELD=1
JMP I .+1
GIR90 /OFF TO PART TWO
GIRCBF, CLRBUF
GIRFIL, JSF0+JSF1+JSF2+JSF3
GIRFCL, -JSTIME-JSDEL-JSWAIT-1
SWBASE= C0004 /SWAP TRACK OF JOB 1 (SWDEX-1)
/ROUTINE TO SET UP SWAP
/CORTBL POINTER TO FIELD TO SWAPPED OUT IN WS0
/FINISH= +FIELD # FOR SWAP IN; FINISH= -FIELD # FOR SWAP OUT
/FIT=JOB TO BE SWAPPED IN OR PHANTOM TO BE BROUGHT IN
/FORCE=FIELD TO BE SWAPPED OUT
/ENTER AT SWAPIN FOR SWAP IN
/ENTER AT SWPOUT FOR SWAP OUT
SWPOUT, TAD WS0 /OR SWAP BIT INTO CORTBL
IOR
SWAP
TAD I WS0 /JOBS ARE THE ONLY ONES TO BE SWAPPED OUT
JMS TRAC /GET THE TRACK # FOR THIS JOB
DCA OUTTRC /SAVE IT
SWAPIN, TAD FINISH /FINISH HAS FIELD # FOR SWAP ACTIVITY + OR -
SPA
CIA /GET THE ABSOLUTE VALUE
CLL RTL
RAL /IN POSITION 00X0
DCA SQREQ /SAVE IT FOR SETTING UP DISC I/O
TAD FIT /IS A PHANTOM NEEDED?
AND C0600
SNA
JMP SWAP1 /NO JOB IS TO BROUGHT IN
AND C0400 /IS FIP NEEDED?
SZA CLA
IFZERO RKSYS <
IFZERO RF08-40 <TAD C0100>/YES, DF32 NEEDS TRACK IN POSITION 0X00
IFZERO RF08 <IAC > /YES, RF08 NEEDS TRACK IN POSITION 000X >
IFNZRO RKSYS < TAD C0020> /YES, RK05 NEEDS TRACK IN BITS 0-7
SWAP3, DCA INTRC
ISZ DSBUSY /IS ANY DISC ACTIVITY GOING ON?
SCHED /YES, SO FIND A RESIDENT JOB
JMS I SWPIOA /NO, START THE SWAP I/O
SCHED /FIND A RESIDENT JOB IN THE MEANTIME
SWAP1, TAD FIT /GET THE JOB # TO BE SWAPPED IN
JMS TRAC /GET ITS TRACK #
JMP SWAP3
/ROUTINE TO SET FLAG IN USER STATUS REG AND EXIT
/CALLING SEQUENCE:
/ CONDBA POINTS TO POSITION IN DEVTBL
/ TAD (FLAGS TO SET)
/ JMS PTSTAR
/ RETURN
PTSTAR, 0
DCA PTFLAG /SAVE FLAGS TO SET
TAD I CONDBA
JMS I PTJOB /GET JOB # FROM DDB
SNA
JMP I PTSTAR
TAD JOBTBA /START OF JOB TABLE
DCA TRAC
STL RTL
TAD I TRAC /ADDRESS OF STR1
IOR /OR IN FLAGS
PTFLAG, 0
JMP I PTSTAR
PTJOB, DEVJOB
/DECTAPE HANDLER CODE
/FOR DISK TRANSFERS TO OR FROM USER SWAP AREA
/ALSO FOR ALL LEVEL 2 COMPLETION
DTDSF0, 0 /MAY RETURN UP TO 4 TIMES - EACH +1 FROM THE LAST
DCA I DTDQUE /PUT THE DECTAPE'S DISK REQUEST IN THE QUEUE
CDF
ISZ DSBUSY /DISK ALREADY BUSY?
SKP
JMS I FIUSER /NO, START IT
DTDXF0, CIF DATFLD
JMP I DTDSF0 /BACK TO DECTAPE HANDLER
DTL20, CIF DATFLD /LEVEL 2 DISPATCHER
JMP I DTLEV2
DTDEF0, ERROR /DECTAPE DISK ERROR
SWPRER
DTDCF0, ISZ DTDSF0 /INCR. RETURN
JMP DTDXF0
DTDSK, ISZ DTDSF0 /DISK ERROR - SKIP ON RETURN
DATFLD
DCA I DTDQUE /REMOVE REQUEST FROM QUEUE
CDF
JMS DSKCON /START ANYTHING ELSE THAT'S WAITING
JMP DTDCF0
DTLEV2, DTL21 /POINTER TO DECTAPE LEVEL 2 COMPLETION ENTRY
DTDQUE, DSUTBL+7 /POSITION FOR FIELD 1 REQUESTS
DSKCON, 0
STA CLL /REDUCE COUNT FOR DSBUSY
TAD DSBUSY
DCA DSBUSY
SZL /IS THERE ANYTHING ELSE TO RUN?
JMS I FIUSER /YES -- START NEXT TRANSFER
JMP I DSKCON
TRAC, 0
AND C0037 /JUST GET THE JOB #
TAD SWBASE /TRACK # WHERE SWAP AREA BEGINS -1 TO TAKE CARE OF JOB 1
IFZERO RKSYS <
IFZERO RF08-40< CLL RTL;RTL;RTL >/TRACK # IN POSITION 0X00 FOR DF32
>
IFNZRO RKSYS <
CLL RTL; RTL /TRACK # IN POSITION 000|XXX|XX0|000
/FOR RK8E (HEAD + 4 BITS OF CYL)
>
JMP I TRAC /RETURN
*6000
KBDMOD, 0
TAD I CONDDB
AND C1000
SNA CLA /USER MODE?
ISZ KBDMOD /YES; CAUSE SKIP ON EXIT
JMP I KBDMOD
XOFF= 3000
KBDFUL, -130
KBDOFF, -70
OFFBRK, KBDDLM
KBD06, 0 /SIZE CHECK FOR KEYBOARD INPUT
DCA KBDMOD /SAVE POINTER TO CHARACTER COUNT
TAD I KBDMOD
TAD KBDFUL
SMA CLA /BUFFER FULL?
JMP KBD07 /YES
ISZ KBD06 /SKIP ON RETURN - OK TO GIVE ANOTHER BLOCK
TAD I KBDMOD
TAD KBDOFF /TIME FOR XOFF?
SPA CLA
JMP I KBD06 /NO
TAD I CONDDB /GET DDB FLAGS
RTL
SZL SPA /SHOULD "XOFF" BE SENT?
JMP I KBD06 /NO - EITHER IT HAS ALREADY BEEN SENT OR HE'S IN SI MODE
STL RTR /YES - REMEMBER TO SEND "XON" LATER
DCA I CONDDB
TAD I CONDBA /POINT TO WORD 2 OF OUTPUT SIDE
IOR
XOFF /SCHEDULE XOFF TO BE SENT
JMS I TYPEC
JMS I OFFBRK /SET KEYBOARD FLAG
JMP I KBD06
KBD07, TAD C0400
TAD I CONDDB /SET BUFFER FULL BIT
DCA I CONDDB
JMP I KBD06 /EXIT - NO SKIP
TYPEC, TYPE
ALLOK, 0
ISZ ALLOK /WE DON'T CARE HOW BIG THE BUFFER IS
DCA KBDMOD
TAD I KBDMOD /THE COUNT
TAD KBDFUL /THE LIMIT
SMA SZA CLA
JMP I ALLOK /TOO MANY - DON'T CLEAR "FULL STATUS"
TAD I CONDDB
AND CC7377
DCA I CONDDB
JMP I ALLOK
CC7377, 7377
/SEARCH FOR TTY
/CALL TAD JOB #
/ TTYUSE
/ RETURN WITH DDB ADDR IN AC, 0 IF NOT FOUND
TTYSRC, 0
AND C0037 /GET JOB #
TAD TTYTBA /START OF TTY TABLE
DCA CONDBA
DATFLD
TAD I CONDBA /GET UNIT # FROM TABLE
CLL RAL /POSITION IN DEVTBL
TAD DEVTBA /POINTER TO DEVTBL
DCA CONDBA
TAD I CONDBA /DDB ADDRESS
CDF
JMP I TTYSRC
TTYTBA, TTYTBL
JOBCHA, JOBCHK
UCON, TAD L2SA /PICK UP JOB NO.
JMS I JOBCHA /SEE IF IT'S A VALID JOB
JMP UCON0 /IT WASN'T
TTYUSE /GET DDB ADDRESS
DCA WS0
DATFLD
TAD I WS0 /GET WORD 1 OF DDB
AND C0037 /ISOLATE CONSOLE NO.
SKP
UCON0, STA /RETURN A -1
DCA L2SA /STASH IT IN HIS/HER AC
UUOEXT
/DATE
UDATE, TAD DATE
JMP UCON0+1 /RETURN DATE IN AC
/RESTORE JOB REGISTERS
/CALL TAD JOB #
/ RESJOB
/ RETURN
RESCOR, FIP SI CJOB
RESJO0, 0
AND RESCOR /CLEAR CORE STATUS BITS
DCA JOB /AND SAVE IN JOB
TAD JOB
AND C0037
TAD JOBTBA
DCA RESJO1 /JOBTBL POINTER FOR THIS JOB
DATFLD
TAD I RESJO1 /GET ADDRESS OF JOB DATA AREA
DCA I CJOBDA /AND SAVE IN FIELD 1
CDF
TAD CLOCK /SUBTRACT THE CLOCKS STILL PENDING ON LEVEL 2
CMA
DCA JOBTIM /THE NET RESULT IS ZERO TICKS WHEN WE ACTUALLY START HIM/HER
DCA L2SV0 /SET PC=0 IN ANTICIPATION OF PHANTOMS
TAD JOB /IS IT A PHANTOM?
AND C0600
SZA CLA
JMP I RESJO0 /YES; WE'RE RESTORED!
/
/ NOW RESTORE THE EAE REGISTERS IF THEY EXIST
/
IFZERO EAE-20 <
IFZERO CPU-2 < /PDP-8E
GETJTW /PICK UP SC (AC5:9), THE MODE + GT FLAG IN AC10 + 11
JOBEAE+1 /IF AC10-11=00 THEN MODE=B GT=1
CMA /IF AC10-11=01 THEN MODE=B GT=0
/IF AC10-11=10 THEN MODE=A GT IS ALWAYS 0 IN MODE A
SWAB /SWITCH TO MODE B AND LOAD THE MQ
MQA LSR /SHIFT INTO THE GT FLAG (SETS TEMPORARILY IF WE WANT MODE A)
1 /MQ IS ALSO COPIED BACK INTO THE AC
CMA RAR /POSITION THE SC FOR LOADING AND PUT THE MODE INTO THE LINK
ACS /AC LOADS SC, AC IS CLEARED
SZL /WHICH MODE?
SWBA /"A," SO SWITCH MODES AND CLEAR THE GT FLAG
>
IFNZRO CPU-1 < /SORRY - THE PDP-8 CAN'T RESTORE ITS STEP COUNTER
IFNZRO CPU-2 < / PDP-8/I AND PDP-12
GETJTW /PICK UP SC
JOBEAE+1
CMA /COMPLEMENT AND STORE FOR
DCA .+2 / OLD-STYLE EAE
SCL /LOAD SC
0 >>>
IFZERO MQREG-1 <
GETJTW /RESTORE MQ
JOBEAE
MQL >
TAD RESJO1
GETJTA /GEET ADDRESS OF PC IN JOB DATA AREA
JOBREG /MOVE PC, LINK, AC TO LEVEL 2 REGISTERS
DCA RESJO1
BLT
DATFLD
RESJO1, 0
UDFCDF, CDF
L2SV0
-3
TAD L2SF
AND C0070
TAD UDFCDF
DCA UUDF /SET UP IN CASE OF USER INTERRUPT
ISZ L2SVLK /DID HE JUST TYPE CONTROL C?
JMP I RESJO0 /ALL RESTORED
DCA L2SA /YES - MAKE SURE HIS/HER AC AND LINK ARE CLEARED
JMP I RESJO0
IFNZRO DC08A <
ANSWER, CIF DATFLD-1 /DISPATCH TO FIELD 1 TO ANSWER PHONE
JMP I .+1
DFRING >/END D689
*6200
/SERVICE ALL AC TRANSFER OUTPUT DEVICES (TELEPRINTERS, PAPER TAPE PUNCH, AND LINE PRINTER)
/IF FILLER CHARACTERS ARE NEEDED, THE NEXT 3 WORDS MUST BE PATCHED ACCORDING TO YOUR NEEDS
/THE VALUE OF DEVTBL IS ASSEMBLED HERE FOR YOUR CALCULATING CONVENIENCE
FILHI, DEVTBL /-(DEVTBL+2*(KXX+1)) WHERE KXX IS THE HIGHEST LINE REQUIRING FILLER CHARACTERS
FILLO, 0 /2 TIMES NUMBER OF LINES REQUIRING FILLER CHARACTERS
FILLC, 0 /-(ASCII CHAR.) TO LOOK FOR - 7 BITS ONLY (CR=7763; LF=7766)
TTIMEA, TTIME
JMSTIM= JMS I TTIMEA
CONCNT, -NULINE-3
IFNZRO DC08A <IFNZRO .&177-5 <YOU GOOFED>
T8OUT> /PASS OUTPUT CHARACTER TO DC08A
*6206
DEVOUT, OUTDIF
CONREG= C0200
CONDEV, SKPTP+1
TTOFLA, TTOFLG
CONLPF, JSLPT
C0014, 14
IFNZRO OUTREG-200 <YOU GOOFED>
CONOUT, DCA I SETFLG /CLEAR SCHEDULER FLAG
ION
ISZ I TTOFLA /SHOW THAT OUTPUT IS BEING SERVICED
DATFLD
TAD CONREG
DCA WS0 /OUTPUT REGISTER TABLE POINTER FOR OUTPUT SCAN
TAD CONCNT
DCA WS1 /NUMBER OF LINES TO CHECK + PUNCH & LINE PRINTER
CONOU0, TAD I WS0
TTIMER, SPA CLA /DOES THIS DEVICE HAVE A REQUEST?
JMP CONOU2 /YES
CONOU1, ISZ WS0 /BUMP POINTER
ISZ WS1 /AND THE COUNT
JMP CONOU0
TAD CONSKP /RESTOORE THE NORMAL INSTRUCTION
DCA TTIMER
STA
LSRP /LP08 OR LE8 ERROR?
LIE /OK - TURN ON INTERRUPT ENABLE
JMP I .+1
CONEXT
CONOU2, JMS CONGET /FIND HIS/HER DDB
DCA CONDDB
TAD I CONDDB /GET OUTPUT STATUS
SPA
JMP CONOU9 /HE HAS TYPED ^S
RTL
CONSKP, SPA CLA
JMP CONJAM /SPECIAL CHARACTERS
CONOU3, TAD CONDDB
FETCH /GET A CHARACTER
JMP CONOU9 /BUFFER EMPTY
CONOU4, DCA TTCHAR
TAD TTCHAR /CHECK FOR CARRIAGE RETURN (FOR SERIAL LA30'S @ 300 BAUD)
AND C0177 /LET'S KEEP DAWNWOOD JUNIOR HIGH HAPPY
TAD FILLC
SZA CLA
JMP CONOU5 /NORMAL CHARACTER
TAD CONDBA
TAD FILHI /HI LINE LIMIT FOR FILLERS
CLL
TAD FILLO /LO LINE LIMIT FOR FILLERS
SNL CLA
JMP CONOU5 /NO FILLERS FOR THIS LINE
TAD CONDDB
TAD C0005
DCA WS2 /POINTER TO DDB CHARACTER COUNT
STL RAR
TAD I WS2 /INDICATE THE NEED FOR FILLERS
DCA I WS2
CONOU5, IOF
TAD I WS0 /WHAT'S THE HARDWARE DOING?
RTL
SNL CLA /HARDWARE BUSY FLAG IN THE LINK
JMP CONOU6 /NOTHING - SEND TO IT
TAD TTCHAR
RAL /SET THE CHARACTER READY FLAG
CONOU8, ION
DCA I WS0 /NEW LINE STATUS
JMP CONOU1 /CHECK NEXT LINE
CONOU6, TAD WS1
IAC
SZA /LINE PRINTER?
JMP CONOU7 /NO - EITHER TTY OR PTP
LIE /DISABLE LS08/LS8E INTERRUPTS
LCP /DISABLE LP08/LE8 INTERRUPTS
ION
TAD CONLPF
JMS I SETFLG /SET THE LINE PRINTER FLAG FOR THE USER
TAD TTCHAR
JMP CONLP2
CONLP1, TAD CONDDB
FETCH /NO - GET ANOTHER CHARARCTER FOR THE LINE PRINTER
JMP CONOU9 /LINE PRINTER BUFFER IS EMPTY
LSF /IS IT READY FOR THE NEXT CHARACTER ALREADY?
JMP CONOU4 /NO - JUST TUCK THIS ONE AWAY FOR AN INTERRUPT TO TAKE
CONLP2, LPC
STL CLA RTR
DCA I WS0 /REMEMBER THE HHARDWARE IS BUSY
JMP CONLP1
CONJAM, TAD I CONDDB
AND C0037 /REMOVE THE JAM REQUEST
DCA I CONDDB
TAD C0007 /BELL?
SZL
TAD C0014 /NO - "XOFF"
JMP CONOU4
CONOU7, TAD CONDEV
DCA CONTLS
TAD I CONTLS
TAD C0005 /CONSTRUCT TLS, PLS, OR "JMP T8OUT"
DCA CONTLS
TAD TTCHAR
CONTLS, .-. /TLS, PLS, OR "JMP T8OUT"
STL CLA RTR /AC=2000
ION
DCA I WS0
JMP CONOU3 /GET ANOTHER CHARACTER
CONGET, 0
TAD WS0
STL RAL /TIMES 2 PLUS 1
TAD DEVOUT
DCA CONDBA /DEVTBL POINTER
TAD I CONDBA /IS THERE A DDB FOR THIS DEVICE?
SZA
JMP I CONGET
CONOU9, CLL STA RAR
CIF /NO INTERRUPTS
AND I WS0
DCA I WS0 /CLEAR THE REQUEST FLAG
TAD I CONDBA /DOES HE EXIST?
SNA
JMP CONOU1 /NO - SO WE'RE FINISHED
DCA AXS1
TAD I AXS1 /JOB
SZA CLA
JMP CONOU1 /STILL DEFINED
DCA I CONDBA /CLEAR HIM/HER FROM DEVTBL
TAD CONDDB /TIME TO RELEASE THE DDB
CDF
RETBLK
DATFLD
STA
TTIME2, TAD AXS1 /ADDRESS OF DDB
JMS I CONCLR /FLUSH OUT BUFFER
DCA I WS0
JMP I .+1
CONOU2
TOFA1,
TTIME, 0
AND C1000
C7740, SZA SMA CLA /SMA HERE TO MAKE CONSTANT
JMP TTIME1 /OOPS!
CIF /NO INTERRUPTS
TAD I WS0
SZA SMA /REQUEST OR INACTIVE?
TAD C1000 /NO - SET TIMER BIT
SMA /HOW SHALL WE EXIT?
ISZ TTIME /SKIP - HE'S CURRENTLY ACTIVE
DCA I WS0 /SAVE UPDATED STATUS
JMP I TTIME /AND AWAY
TTIME1, JMS I CONGEA /HUNG - FIND HIS/HER DDB
DCA AXS1
JMS I CONSEA /WAKE HIM/HER UP
STL RTL
TAD WS1
SPA CLA /WHICH DEVICE IS IT?
JMP TTIME2 /TELEPRINTER
TAD I AXS1 /JOB OWNING DEVICE
SNA
JMP TTIME2-1 /NO JOB, HUNG -- LET'S GET RID OF HIS/HER BUFFER!!
CDF
ERROR /PASS THE ERROR TO HIM/HER
HUNGDV
DATFLD
JMP I CONO1A /TRY AGAIN NOW
CONGEA, CONGET
CONSEA, CONSET
CONO1A, CONOU1
CONCLR, CLRBUF
TOFT1,
TOFSET, 0 /ONLY CALLED BY "TOF
TAD TOF
SPA CLA /CALLED FROM INPUT OR OUTPUT HANDLER?
JMS I CONSEA /SET OUTPUT FLAGS
JMP I TOFSET
/RETRIEVE A CHARACTER FROM LINKED BUFFER
/CALL: DDB ADDRESS IN AC
/ JMS TOF
/ RETURN BUFFER EMPTY
/ RETURN CHARACTER IN AC
TOF, 0
TAD C0005 /INDEX TO COUNT
DCA TOFA1
TAD I TOFA1
SNA
JMP I TOF /ALREADY EMPTY
ISZ TOF /SHOW SUCCESS
SPA
JMP TOF3 /GENERATE A FILLER
TAD C7740
SNA
JMS TOFSET /TIME TO SET STR1 BIT
TAD C0037 /AC NOW = COUNT -1
SNA
JMP TOF4 /THIS WILL BE THE LAST CHARACTER
TOF0, DCA I TOFA1
ISZ TOFA1 /POINT TO EMPTY COUNT
ISZ I TOFA1 /ANY LEFT IN THIS BLOCK?
JMP TOF1 /MUST BE
TAD TC7766
DCA I TOFA1 /RESET THE EMPTY COUNT
ISZ TOFA1 /EMPTY BLOCK
TAD I TOFA1
CDF
RETBLK /RETURN THE EMPTY BLOCK
DATFLD
DCA I TOFA1 /LINK TO NEXT BLOCK
TAD TC7766
JMP TOF1+2
TOF1, TAD I TOFA1 /GET THE COUNT TO DETERMINE POSITION WITHIN THE BLOCK
ISZ TOFA1 /POINT TO EMPTY BLOCK
TAD C0003
SMA /UNPACK?
STL RAL /YES (MULT BY 2 THEN ADD 1) FUDGE POSITION
SPA /UNPACK?
STL CIA /NO - MAKE OFFSET POSITIVE - SET LINK TO INDICATE NO UNPACKING NEEDED
TAD I TOFA1 /ADD OFFSET TO EMPTY BLOCK POINTER
DCA TOFA1
TAD I TOFA1 /GET CHARACTER; OR AT LEAST PART OF IT
SZL /UNPACK?
JMP TOF2 /NO
AND C7400 /SAVE PERTINENT BITS
DCA TOFT1
ISZ TOFA1
TAD I TOFA1 /GET THE OTHER HALF OF THE CHARACTER
AND C7400 /THROW AWAY THE JUNK
CLL RTR /START MOVING IT INTO PLACE
RTR
TAD TOFT1 /GET THE M.S. BITS
RTR
RTR /THAT SHOULD DO IT
TOF2, AND C0377 /CLEAR ANY JUNK LEFT OVER
JMP I TOF /AND AWAY
TOF3, TAD C0400 /INCR. FILLER COUNT
DCA I TOFA1
JMP I TOF /EXIT WITH FILLER (NULL) CHARACTER
TOF4, JMS TOFSET /SET THE STR1 BIT FOR THIS DEVICE
STA
TAD TOFA1
DCA TOFT1 /POINTS TO FILL BLOCK POINTER
TAD I TOFT1
CDF
RETBLK /RETURN THE LAST BLOCK OF THE BUFFER
DATFLD
AND TOF
SMA CLA /CALLED FROM INPUT OR OUTPUT HANDLER?
TAD WS0 /INPUT - CHECK FOR NON-ZERO BREAK-MASK
SNA CLA
JMP TOF5 /NO "JSDEL" TO CLEAR
TAD C0100
JMS I TOFCLR /CLEAR JSDEL - THIS IS THE LAST CHARACTER
TOF5, DCA I TOFT1 /CLEAR FILL POINTER SO WE KNOW WE'RE EMPTY
JMP TOF0
TC7766, 7766
TOFCLR, CLSTR1
/ROUTINE TO ALLOW SI & FIP TO CLEAR BUFFERS BY WAY OF FIELD 0 ROUTINE
SICLR, 0
JMS I CONCLR
CIF CDF 20 /BACK TO FIELD 2
JMP I SICLR
/CLEAR STATUS
UCLS, GETJTW /ADDRESS OF STR0 TO JOBSWA
JOBSTS
CLA CLL CMA RTL /-3 IN AC
DCA WS0
TAD C2407 /DON'T LET HIM/HER MESS UP STR0
SKP
Y1, STA /LET HIM/HER ANYTHING IN STR1 AND D.S.R.
UDF /UP TO USER FIELD
AND I L2SA /GET BITS TO CLEAR
CMA
DATFLD
AND I JOBSWA /CLEAR THEM
DCA I JOBSWA /SAVE NEW VALUE
ISZ L2SA /BUMP POINTER
C0020, 20 /NOP
ISZ JOBSWA /BUMP POINTER
ISZ WS0 /COUNT, 3 STATUS WORDS TO CLEAR
JMP Y1
DCA L2SA /CLEAR HIS/HER AC
UUOEXT
C2407, JSEREN JSPEEK UUOERF SWPRER SWPWER DSKERR HUNGDV
/RETURN CONTENT OF STATUS WORD IN AC
/CALL TAD POINTER TO JOB STATUS ADDRESS
/ GETJTI
/ RELATIVE ADDR OF WORD
/ RETURN (ADDRESS OF WORD IN JOBSWA)
CLR0,
GETJI0, 0
CDF
DCA JOBSWA /SAVE POINTER TO JOB STATUS
TAD I GETJI0 /GET POSITION IN LIST
DCA .+3 /SAVE IT
TAD JOBSWA /NOW GET ADDRESS OF THIS ENTRY
GETJTA
0
DCA JOBSWA /SAVE IT
DATFLD
SZL /IF LINK=0 THERE'S NOTHING TO GET
TAD I JOBSWA /GET CONTENTS OF THAT ADDRESS
CDF
ISZ GETJI0 /INDEX RETURN
JMP I GETJI0
/RETURN ALL BLOCKS OF LINKED BUFFER TO FREE CORE (EXCEPT DDB)
/CLEAR ENTRIES IN DDB SO WE KNOW IT'S EMPTY
CLRBUF, 0
SNA
JMP I CLRBUF /OOPS!
TAD C0004 /POINT TO WORD 4 (FILL POINTER
DCA CLR0
TAD I CLR0
SNA CLA
JMP I CLRBUF /BUFFER ALREADY EMPTY
DCA I CLR0 /CLEAR FILL POINTER
ISZ CLR0
DCA I CLR0 /CLEAR CHARACTER COUNT
ISZ CLR0
ISZ CLR0
TAD I CLR0 /EMPTY BLOCK POINTER
CDF
RETBLK /RETURN A BLOCK TO FREE CORE
SZA
JMP .-2 /DELETE ANOTHER BLOCK
DATFLD
DCA I CLR0 /CLEAR THE EMPTY BLOCK POINTER
JMP I CLRBUF
SCHNUL, TAD C0100 /RUN NULL JOB IN USER MODE
DCA L2SF /FIELD 0; USER MODE
TAD SCHNJA
DCA L2SV0
ISZ NULAC /BUMP NULL JOB'S AC
TAD NULAC
DCA L2SA /RESTORE IT
EXIT /OFF TO NULL JOB
NULAC, 0
SCHNJA, NULJOB
/ROUTINE TO SET EITHER JSTEL, JSLPT, OR JSPTP IN STR1
CONSET, 0
CLA STL RTL
TAD WS1 /FROM POSITION IN OUTREG DETERMINE DEVICE FLAG POSITION
SNA
JMP .+4 /IT'S THE PUNCH
SMA CLA /SKIP IF TELEPRINTER
TAD C0020 /IT'S THE LINE PRINTER
TAD CC0014
TAD C0004
JMS I SETFLG /SET THE APPROPRIATE BIT IN STR1
JMP I CONSET
/QUEUE DISC REQUEST
/CALL TAD ADDRESS OF TRANSFER BLOCK
/ JMS DSQUE
/ RETURN
DSQFLD= C0002 /FILPIF
DSQUE, 0
DCA DSQUE1 /SAVE ADDRESS OF PARAMETER BLOCK
TAD DSQUE1 /NOW GET POINTER TO WORD WITH FIELD & FILE DATA
TAD DSQFLD
DCA DSQUE2 /SAVE POINTER
DATFLD
TAD I DSQUE2 /GET FIELD # (BITS 7-9) AND FILE # (BITS 10-11)
AND C0037 /USE THIS VALUE AS DSUTBL INDEX
TAD DSUTBA
DCA DSQUE2 /SAVE POINTER TO DSUTBL
TAD DSQUE1 /GET PARAMETER ADDRESS
DCA I DSQUE2 /SAVE IN DSUTBL
UPEEK3, CDF /AND EXIT
JMP I DSQUE
/SUBROUTINE TO CHECK FOR PRIVILEGE CONDITION FOR USER DOING UUO
/PRIVILEGE BITS ARE SET EITHER BY THE ACCOUNT NUMBER BEING LESS THAN
/FOUR (FIP) OR BY A REQUEST TO RUN A LIBRARY PROGRAM USING R, KJOB,
/SYSTAT, OR LOGOUT. THE LATTER BIT IS SET BY SI, AND CLEARED EVERY
/TIME THAT SI IS ENTERED.
DSQUE1,
PRIV, 0
GETJTW
JOBSTS /GET STR0
AND C0600 /IS EITHER PRIVILEGE BIT SET?
SZA CLA
JMP I PRIV /YES, OK
JMP I .+1 /NO, ERROR; INVALID IOT
UUOERR
/LOGOUT IS A PRIVILEGED IOT, UNLESS THE AC=0
ULOGO, TAD L2SA /IS AC=0?
SZA CLA
JMS PRIV /NO - CHECK FOR PRIVILEGE
ISZ AXS1 /FUDGE SO AXS1 WILL LEAD TO A 0
JMP I .+1 /NOW JUMP DIRECTLY TO THE NON-RESIDENT
UUO6 /UUO CODE
/PEEK IS A PRIVILEGED IOT
UPEEK, JMS PRIV /MAKE SURE A PRIVILEGE BIT IS SET
STA /BACK UP HIS/HER AC
TAD L2SA
DCA AXS1 /BECAUSE OF AUTO-INDEX
UDF
TAD I AXS1 /GET CORE-FIELD
AND C0010 /LET HIM/HER SEE FIELDS 0,1
/COULD PROBABLY LET HIM/HER SEE MORE, BUT HAVE
/TO WORRY ABOUT NON-EXISTENT CORE.
TAD UPEEK3 /MAKE A CDF
DCA UPEEK1
STA
TAD I AXS1 /BEGINNING MONITOR ADDRESS-1
DCA AXS2
TAD I AXS1 /BEGINNING USER ADDRESS
DCA WS0
TAD I AXS1 /MINUS HOW MANY WORDS
DCA L2SA
DSQUE2,
UPEEK1, .-. /CDF TO MONITOR FIELD
TAD I AXS2 /GET WORD
UDF /USER DATA FIELD
DCA I WS0 /GET RID OF WORD
ISZ WS0
CC0014, 14 /NOP
ISZ L2SA /THROUGH?
JMP UPEEK1 /NO
UUOEXT /YES -- AND HIS/HER AC=0!!
*CORTBL
LOCK /DATFLD
LOCK /FIELD 2
LOCK /FIELD 3
LOCK /FIELD 4
LOCK /FIELD 5
LOCK /FIELD 6
LOCK /FIELD 7
/THE ABOVE ARE UNLOCKED BY INIT AS A FUNCTION OF # USER FIELDS
*L2QTB
ZBLOCK 20 /LEVEL 2 QUEUE
/COMBINED RESIDENT IOTS
UUOTBL, 6040 /TELEPRINTER
6660 /LPT
6030 /KEYBOARD
6010 /READER
6020 /PUNCH
6500 /RESERVED FOR FUTURE USE
0
/UNCOMBINED RESIDENT IOTS
6603 /RFILE
6605 /WFILE
6200 /CKS - CHECK STATUS
6405 /CLS - CLEAR STATUS
6400 /KSB - SET KEYBOARD BREAK
6401 /SBC - SELECTIVE BUFFER CLEAR
6402 /DUP - DUPLEX TELETYPE CONSOLE
6403 /UND - UNDUPLEX TTY
6411 /URT - USER RUN TIME
6412 /TOD - TIME OF DAY
6413 /RCR - RETURN CLOCK RATE
6414 /DATE
6415 /SYN - QUANTUM SYNCHRONIZATION
6416 /STM - SET TIMER
6417 /SRA - SET RESTART ADDRESS
6617 /ACT - RETURN ACCOUNT NUMBER
6420 /TSS - SKIP ON TSS/8
6421 /USE - USER
6422 /CON - USER CONSOLE
6423 /PEEK - LOOK IN MONITOR CORE
6430 /SSW - SET SWITCH REGISTER
6431 /SEA - SET ERROR ADDRESS
6614 /SIZE
6004 /GTF - GET FLAGS ( LINK AND GT ONLY )
6005 /RTF - RESTORE FLAGS (LINK AND GT ONLY)
6006 /SGT - SKIP ON EAE GT FLAG
6764 /DTXA - DECTAPE READ OR WRITE
6771 /DTSF - DECTAPE SKIP
6772 /RDS - READ DEVICE STATUS REGISTER (DT, RK, & CDR)
6773 /DTSF RDS - MICROCODED
6743 /DLAG - RK05 READ OR WRITE
6632 /RCRA - READ CARD ALPHA
6634 /RCRB - READ CARD BINARY
6636 /RCRC - READ CARD COMPRESSED
6615 /LOGOUT - MUST BE LAST IN GROUP, SEE ULOGO FOR DETAILS
0
/NON-RESIDENT IOTS
6440 /ASD - ASSIGN DEVICE
6442 /REL - RELEASE DEVICE
6601 /OPEN - OPEN FILE
6602 /CLOS - CLOSE FILE
6600 /REN - RENAME FILE
6604 /PROT - PROTECT FILE
6610 /CRF - CREATE FILE
6611 /EXT - EXTEND FILE
6612 /RED - REDUCE FILE
6406 /SEGS - RETURN NUMBER OF FREE DISK SEGMENTS
0
/LONG NON-RESIDENT IOTS
6613 /FINF
6616 /WHO