1
0
mirror of synced 2026-01-13 07:19:45 +00:00
2010-04-02 15:46:14 +00:00

6827 lines
153 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/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!!
*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
SWPIOA, SWPIO
*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 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
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
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
B7751, 7751
B7750, 7750
DSKFLD,
IFZERO RF08 <CORMEM>
IFZERO RF08-40 <CORMEM+200>
/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 RF08-40 <TAD C0100>/YES, DF32 NEEDS TRACK IN POSITION 0X00
IFZERO RF08 <IAC > /YES, RF08 NEEDS TRACK IN POSITION 000X
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 RF08-40< CLL RTL;RTL;RTL >/TRACK # IN POSITION 0X00 FOR DF32
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
0
/MICRO-CODED RESIDENT IOT DISPATCH
UUODTB, UTEL /TELEPRINTER
IFNZRO LPT <ULPT> /LINE PRINTER
IFZERO LPT <UUOERR>
UKEY /KEYBOARD
UPTR /READER
IFNZRO PUNCH <UPTP> /PUNCH
IFZERO PUNCH <UUOERR>
UUOERR /RESERVED FOR FUTURE USE
0
/NON-MICRO-CODED RESIDENT IOT DISPATCH
UFILE
UFILE
UCKS
UCLS
UKSB
USBC
UDUP
UUND
UURT
UTOD
URCR
UDATE
USYN
USTM
USRA
UACC
UTSS
UUSE
UCON
UPEEK
USSW
USEA
USIZE
IFNZRO CPU&7776 <UGTF
URTF>
IFZERO CPU&7776 <UUOERR
UUOERR>
IFZERO CPU-2 <USGT>
IFNZRO CPU-2 <UUOERR>
IFNZRO TC01 <UDTXA0>
IFZERO TC01 <UUOERR>
UUOEX2
UDTRB
UDTRBS
IFNZRO RK05 <URK050>
IFZERO RK05 <UUOERR>
IFNZRO CDR <
UUCDR0+2
UUCDR0+1
IFNZRO CPU&7776 <UUCDR0>
IFZERO CPU&7776 <UUOERR>>
IFZERO CDR <UUOERR
UUOERR
UUOERR>
ULOGO /LOGOUT - MUST BE FOLLOWED BY A 0
/SEE ULOGO FOR DETAILS
0
/-# ARGUMENTS FOR NON-RESIDENT IOTS
0 /ASD
0 /REL
UFILCT, -6 /OPEN
0 /CLOS
-6 /REN
0 /PROT
-4 /CRF
-4 /EXT
-4 /RED
0 /SEGS
0
-2 /FINF
-2 /WHO
0
VERNUM
UTSS, TAD .-1 /SKIP ON TSS/8
DCA L2SA /AND RETURN VERSION # IN AC
UUOEX2, ISZ L2SV0 /POSITIVE FLAG TEST EXIT
NOP
/ENTRY FOR UUOEXT
/SETS UP WAIT MASK 1 IF THERE ARE ANY WAIT CONDITIONS FOR STR1
/IF THERE IS NOTHING TO WAIT FOR, WE EXIT BACK TO THE USER
UUOEX1, SNA
JMP UUOEX3 /NO WAIT CONDITIONS
CDF
DCA WS0 /SAVE BITS TO CLEAR
GETJTW /SET UP WAIT MASK
JOBWMK
CLA IAC
TAD WS0 /WAIT ON THIS FLAG+JSWAIT
DATFLD
DCA I JOBSWA /SET WAIT MASK 1
TAD I JOBSWA
JMS I CLEAR1 /CLEAR SAME BITS IN STR1
WAIT
CLEAR1, CLSTR1
UUOEX3, DATFLD
TAD I JOBDAT
IAC
DCA JOBSWA /POINTS TO STR0
TAD I JOBSWA
SMA CLA /STILL RUNNABLE?
WAIT /NO
ISZ JOBSWA
CLL STA RAL /AC=7776
AND I JOBSWA
IAC /MAKE SURE JSWAIT IS SET
DCA I JOBSWA
ISZ JOBSWA
ISZ JOBSWA /POINT TO WAIT MASK
IAC
DCA I JOBSWA /FORCE DUMMY WAIT BIT ONLY
EXIT
/SET SWITCH REGISTER, RESTART ADD, ERROR ADD, OR KEYBOARD BREAK
UKSBRK= C0002 /DDBBRK
UKSB, TAD JOB
TTYUSE /FIND USER INPUT TTY DDB
TAD UKSBRK
DCA JOBSWA /POINTS TO BREAK MASK IN DDB
TAD L2SA /USER AC
DATFLD
SZA
JMP UKSB1 /HE HAS NEW MASK -- GO PICK IT UP
TAD I JOBSWA /HE WANTS TO READ OLD MASK
JMP UKSB1+1 /GIVE IT TO HIM/HER
USSW, TAD C0002 /SET AC=2
USEA1, IAC /AC=AC+1
USRA, TAD C0005 /AC=AC+5
DCA .+2 /SAVE RELATIVE ADDRESS
GETJTW /GET POINTER
0 /POSITION IN LIST
CLA /WE ONLY WANTED POINTER
TAD L2SA /GET CONTENTS OF USER AC
DATFLD
UKSB1, DCA I JOBSWA /SAVE IN JOB DATA AREA
DCA L2SA
UUOEXT /AND AWAY
RINTA, RINT
CDTIMA, TIMCDR
INTCDR, RCSD
JMP I RINTA /CONTINUE IN INTERRUPT SKIP CHAIN
RCRD /CLEAR CARD DONE FLAG
TAD I CDTIMA
SNA CLA /WERE WE EXPECTING AN INTERRUPT?
DISMIS /NO
DCA I CDTIMA /NO MORE INTERRUPTS ALLOWED - WE FINISHED THIS CARD
TAD .+2
DISMIS /SCHEDULE LEVEL 2
CDL20
/ACCOUNT NUMBER
UACC, TAD L2SA
JMS JOBCHK /SEE IF IT'S A VALID JOB
JMP UACC0 /IT WASN'T - RETURN A ZERO
TAD JOBTBA
GETJTI /GET THE ACCOUNT NUMBER OF THE JOB
JOBACC
UACC0, DCA L2SA /RETURN IT TO HIM/HER
UUOEXT
IOR1,
JOBCHK, 0
SNA /SPECIFIC JOB?
TAD JOB /NO - HIS/HER OWN JOB
DCA WS1
TAD WS1
CLL
TAD JOBS /IS IT REALLY A JOB?
SNL CLA
TAD WS1
TAD JOBTBA
DCA JOBSWA
DATFLD
TAD I JOBSWA /IS THERE REALLY A JOB?
SNA CLA
JMP I JOBCHK /NO - RETURN WITHOUT SKIP
ISZ JOBCHK
TAD WS1 /JOB NUMBER REQUESTED
JMP I JOBCHK
JOBS, -JOBMAX-1
DTRKHG, 0
ERROR /DECTAPE OR RK05 IS HUNG
HUNGDV /REPORT IT TO THE USER
CIF DATFLD /BACK TO FIELD 1
JMP I DTRKHG
/INCLUSIVE OR
/CALL TAD ADDRESS OF WORD TO SET
/ IOR
/ BITS TO SET
/ RETURN
IOR0, 0
DCA IOR1 /SAVE ADDRESS TO SET
RDF /FIELD TO SET IT IN
TAD .+2 /COMPUTE FIELD SELECT - FOR THAT FIELD
DCA IOR2 /SAVE IT
CDF
TAD I IOR0 /GET BITS TO SET
IOR2, 0 /SET FIELD AGAIN
DCA IOR2 /SAVE THEM
TAD IOR2
CMA
AND I IOR1 /CLEAR THE BITS IF ALREADY SET
TAD IOR2 /NOW SET THEM
DCA I IOR1 /SAVE NEW VALUE
ISZ IOR0 /SKIP ARGUMENT IN CALL
JMP I IOR0 /RETURN
*7400
IFNZRO DC08A <
JMPDC8= JMP I . /SKIP OVER DC08A VECTORS
.+3
DC8REG= JMP . /SKIP OVER DC08A ACTIVE REGISTERS
IAC
ISZ ACFLG /SWITCH TO OUTPUT SIDE
TAD DCCNT
TAD ACX10
DCA ACX10 /SKIP OVER THE DC08A ENTRIES IN THE TABLE
JMP ACINT1 /BACK TO WORK
DCCNT, DC08A-1 >
*7410
RINT, DCA SRVFLG /CLEAR LEVEL 2 REQUEST FLAG
DATFLD
RSF
JMP ACINT
RRB /GET CHARACTER FROM THE READER
DCA I ACX11 /PUT IT IN THE RING BUFFER
CDF
ISZ RCNT /ENOUGH??
JMP RINT1 /NO - SEE IF THERE'S STILL ROOM IN THE RING BUFFER
RINT0, DCA I RTIM
DATFLD
CMA
JMP ACINT8 /READER IS LINE # 7777
RINT1, TAD KEYC /IS THERE ENOUGH ROOM LEFT IN THE RING-BUFFER?
TAD RLIM
SMA CLA
JMP RINT2
RFC /KEEP THE READER GOING
CLL CMA RAL /SET TIMER FOR 2 MORE SECONDS
JMP RINT0
RINT2, TAD RL2A
DCA I L2Q /SCHEDULE THE READER TO BE RESTARTED AFTER THE BUFFER HAS BEEN EMPTIED
ISZ SRVFLG /REMEMBER WE WANT LEVEL 2
JMP RINT0
RLIM, -NULINE-1
RL2A, L2PTR1
RTIM, TIMPTR
RCNT, 0
OUTIOT= ISZ ACFLG
ENDIOT= JMP ACINT6
ACINT, CLL STA RAL /AC=-2
DCA ACFLG /START BY CHECKING FOR INPUT
TAD ACTBLA /ADDRESS OF THE SKIP IOT'S
DCA ACX10
STL RTL
ACINT0, TAD HIPRO
DCA HICNT /SHORT LOOP COUNT TO PROTECT HI-PRIORITY DEVICES
DATFLD
ACINT1, ISZ HICNT
JMP ACINT2-2
JMS I HIPRIA /GO CHECK RK, DT, & CDR
SNA /ANYTHING REQUESTED?
JMP ACINT0 /NO
DCA I L2Q /QUEUE THEIR REQUEST FOR THEM
ISZ SRVFLG /REMEMBER IT
JMP ACINT0 /RE-INITIALIZE THE COUNT
TAD I ACX10
DCA ACINT2
ACINT2, .-. /DEVICE SKIP
JMP ACINT1 /NOT THIS ONE
TAD ACINT2
TAD C0005 /GENERATE READ OR SEND IOT
ISZ ACFLG
JMP ACINT7 /MUST BE A KEYBOARD
DCA ACINT3 /SAVE THE TLS, PLS, OR LPC
TAD ACX10
TAD ACOUT /DETERMINE THE LINE NUMBER
DCA ACFLG /THIS LINE'S OUTPUT REGISTER
TAD I ACFLG
RAR
SNL
JMP ACINT5 /NOTHING WAITING TO GO
ACINT3, .-.
CLA STL IAC
RTR
DCA I ACFLG /HARDWARE BUSY AND REQUEST FLAGS SET
DCA TTOFLG /SCHEDULE LEVEL 2
ACINT4, TAD L2Q /POSITION OF FILL POINTER
TAD L2QBOT /MINUS L2QTB-1
CIA
TAD SRVFLG /DON'T COUNT THE ONES WE JUST PUT IN
SNA CLA /SHOULD WE SCHEDULE LEVEL 2?
TAD EXITA /YES
DISMIS
ACINT5, CLA IAC
TAD ACINT2
DCA .+1
HICNT, .-. /TCF, PCF, OR LCF
STL CLA RAR /AC=4000
AND I ACFLG
DCA I ACFLG /NO MORE INTERRUPTS EXPECTED FROM THIS LINE
ACEXIT, TAD SRVFLG /ANY REQUESTS?
SZA CLA
JMP ACINT4 /YES - MAKE SURE THEY'RE SCHEDULED
DISMIS /NOTHING SPECIAL
ACINT6, LSRP /LP08/LE8 ERROR?
JMP ACEXIT /NO, MUST BE AN UNDEFINED INTERRUPT
LCP /CLEAR INTERRUPT ENABLE
JMP ACEXIT
ACINT7, DCA ACFLG /SAVE THE KRB IOT
ACFLG, .-.
SNA
JMP ACEXIT /THROW AWAY NULL CHARACTERS
AND C0177
TAD C0200 /FORCE ON THE "PARITY" BIT
DCA I ACX11 /STASH IT IN THE RING BUFFER
TAD ACTBLA
CMA
TAD ACX10 /LINE NUMBER CAUSING INTERRUPT
ACINT8, JMS ACINT9 /STASH LINE NUMBER & UPDATE POINTERS ETC.
JMP ACINT4 /SCHEDULE LEVEL 2 IF WE WERE IN USER MODE
ACINT9, 0
DCA I ACX11 /STASH AWAY THE LINE NUMBER
ISZ KEYC /COUNT THE ENTRY
ISZ ACCNT /END OF RING BUFFER
JMP I ACINT9 /NO
TAD ACRING
DCA ACX11 /YES - RESET POINTER
TAD ACSIZE
DCA ACCNT /AND THE COUNT
JMP I ACINT9
SRVFLG, 0
TTOFLG, 1 /NON-ZERO WHEN SERVICE IS NOT REQUIRED
ACRING, RINGIN-1
ACCNT, -INPUTS
ACSIZE, -INPUTS
KEYC, 0
HIPRO,
IFNZRO CPU-2 < -4 >
IFZERO CPU-2 < -6 >
HIPRIA, DTCHK
ACTBLA, SKPTBL-1
ACOUT, OUTREG-SKPTBL-NULINE-2
L2QBOT, -L2QTB+1
*7600
/SYSTEM DISK HANDLERS FOR TSS/8
/ SWPIO - HANDLES ALL SWAPS (ONLY SWAPS)
/ DSGO0 - HANDLES ALL OTHER TRANSFERS INCLUDING OVERLAYS
SWPIO, 0 /
CLA CLL CMA RTL /=3 IN AC
DCA DSERRI /# OF TRIES
JMS SWPIT /START THE SWAP
JMP I SWPIO /RETURN
SWPIT, 0
TAD SWPA /RETURN ADDRESS FOR INTERRUPT CHAIN
DCA I DSWATA /SAVE IT
IFZERO RF08 <
TAD SQREQ /FIELD TO BE SWAPPED OUT
TAD C0500 /INTERRUPT ON ERROR AND ON COMPLETION
DIML >
DCA DSWC /WORD COUNT
CMA
DCA DSMA /CORE ADDRESS
TAD FINISH /IN OR OUT?
SMA CLA
JMP SWPIN /IN
TAD OUTTRC /GET THE TRACK # TO BE SWAPPED OUT
IFZERO RF08-40 <
TAD SQREQ /FIELD TO BE SWAPPED OUT
DEAL
CLA >
IFZERO RF08 <
DXAL >
DMAW
JMP I SWPIT
SWPIN, TAD INTRC /GET THE TRACK TO READ IN
IFZERO RF08-40 <
TAD SQREQ /FIELD TO BE SWAPPED OUT
DEAL
CLA >
IFZERO RF08 <
DXAL >
DMAR
JMP I SWPIT
SWPA, SWPTR /RETURN ADDRESS AFTER SWAP
SWPTR, JMP SWPERR /OOPS
TAD FINISH /DID WE JUST SWAP IN OR OUT?
SMA
JMP SWPOK /IN; SO WE'RE FINISHED
CIA
DCA FINISH /SAVE IT
JMS SWPIO /START SWAP IN
DISMIS /GO BACK TO WHAT WE WERE DOING
SWPERR, JMS DSERR /GO TO COMMON ERROR ROUTINE
JMP SWPBAD /SORRY - IT'S OFFICIALLY BAD
JMS SWPIT /TRY AGAIN
JMP DSERRX /GO TO COMMON RETRY EXIT
SWPOK, CLA IAC /SWAP OK; SKIP ON RETURN
SWPBAD, TAD SWPREA /DISPATCH TO LEVEL 2 SWAP COMPLETION
JMP OK /CLEAR DISK FLAG AND EXIT
DSERR, 0
IFZERO RF08 <
STA /SET WC TO CAUSE IMMEDIATE OVERFLOW
DCA DSWC /ONLY SAFE WAY TO STOP THIS DISK
DSAC /SEE IF THE DISK IS STILL BUSY
SKP /THINGS ARE QUIET OUT THERE
DISMIS /WAIT A FEW MICRO-SECONDS
DORS /GET THE STATUS BITS
DCMA /CLEAR EVERYTHING
DCXA /INCLUDING THE TRACK ADDRESS
AND C0004 /DO WE HAVE DRL?
SNA >
IFZERO RF08-40 <DCMA > /STOP DF32
ISZ DSERRI /NO; SO COUNT IT AS AN ERROR
ISZ DSERR /OK TO RETRY ON RETURN
IFZERO RF08 <
SZA CLA
TAD SLEEPA > /BETTER KNOCK OFF THE EAE USER
DCA DSGO0 /SAVE ADDRESS; IF ANY
JMP I DSERR /BACK TO CALLER
/START DISC TRANSFER
/CALL TAD ADDRESS OF PARAMETERS
/ DSGO
/ RETURN
DSGO0, 0
DCA DSPARM
CLA CLL CMA RTL
DCA DSERRI
JMS DSTRYA
JMP I DSGO0
DSTRYA, 0
TAD DSRETA
DCA I DSWATA
CLA CMA /ADDRESS OF PARA-1 FOR INDEX REGISTER
TAD DSPARM
DCA DSPAR
DATFLD
TAD I DSPAR /FUNCTION
DCA DSRORW
TAD I DSPAR /DISC EXTENSION
IFZERO RF08-40 <
CLL RTL
CLL RAL
TAD I DSPAR /MEMORY EXTENSION
CLL RAL
DEAL
CLA>
IFZERO RF08 <
CLL RTR
DXAL
TAD I DSPAR
CLL RAL
AND C0070
TAD C0500
DIML /LOAD INTERRUPT ENNABLE AND MEMORY EXTENSION
>
TAD I DSPAR
DCA DSWC
TAD I DSPAR
DCA DSMA
TAD I DSPAR
CDF
DSRORW, 0
JMP I DSTRYA
DSERR1, JMS DSERR /DO COMMON ERROR ROUTINE
JMP DSGBAD /GIVE UP
JMS DSTRYA /TRY AGAIN
DSERRX, TAD DSGO0 /POSSIBLY AN EAE JOB TO GO TO SLEEP
DISMIS
DSRET, JMP DSERR1 /ERROR
IAC
DSGBAD, DATFLD
TAD I DSPAR
OK, DCMA
DISMIS /BACK TO MONITOR
DSPARM, 0
DSRETA, DSRET
DSWATA, DSWAIT
C0500, 500
*7750
DSWC, DSMA /FOR LOADING INTO FIELD 0 ON INITIALIZATION
DSMA, DSMA /(SINCE THE 4K TRANSFER OVERWRITES THE DATA BREAK LOCATIONS)
SLEEPA, SLEEP
DSERRI, 0
0 /FOR DECTAPE SERVICE
0 /FOR DECTAPE SERVICE
FIELD 4 /FORCE TS8II INTO TRACK 4 AT BUILD TIME
/TS8II 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.
*0
ZBLOCK 10 /IF ANY OF THESE BECOMES NON-ZERO, FIND OUT WHY!
*10
K0030, 30
K0614, 614
K0500, 500
IX3, 0
IX4, JOBTBL /WAIT 2 UNQUEUER POINTER
A15, 0 /DECTAPE - FOR EXTRACTING USER INFO. FROM DDB
A16, 0 /BLTF1 - USER FIELD POINTER
A17, 0 /BLTF1 - DATFLD POINTER
DTJOB, 0
DTBUF, 0
DTST, 0
DTBLKP, 0
DTBLK, 0
DTCOM, 0
DTUCA, 0
DTTIME, 0
DTREMB, 0
DTGOA, DTGO
DTERRA, DTERR
DTBUFA, ENDBUF-1
DTCAP, 7755
M2702, -2702
M201, -201
K0214, 214
K0070, 70
K0400, 400
K7400, 7400
K0002, 2
K0037, 37
K0005, 5
K0020, 20
K7770, 7770
K0377, 377
K0006, 6
K1000, 1000
K0600, 600
RKJOB, 0
RKCORE, 0
RKCOM, 0
RKSECT, 0
RKCNT, 0
RKBLKS, 0
RKTIME, 0
SLEEPB, SLEEP
RKERRA, RKERR
DTRKHA, DTRKHG
WAIT2, WAITS2
AWAKEN, WAKEUP
DTCHKA, DEVCHK
QUEUE1, QUEUE0
BLTF1A, BLTF1
JOBTAB, JOBTBL
INTS1, 0 /INTERRUPT TEMPORARY STORAGE
INTS2, 0
TEMP0, 0 /WORKING STORAGE
TEMP1, 0
TEMP2, 0
TEMP3, 0
TEMP4, 0
K0007, 7
K0010, 10
K0200, 200
K0204, 204
K0040, 40
K0004, 4
K6201, 6201
K7000, 7000
K7700, 7700
K7774, 7774
K0003, 3
L2SAP, L2SV0+2 /POINTS TO L2SA IN FIELD 0
UDF1, 0 /SELECT USER FIELD
0
JMP I .-2
JOBCNT, -JOBMAX
UDFP, UUDF
DTRKJA, DTRKJB
F1SCH, 0
EXITF1= JMP .
K6203, CIF CDF
TAD F1SCH
SNA CLA /ANYTHING JUST OUT OF WAIT?
JMP I .+4 /NO - NORMAL LEVEL 2 EXIT
DCA F1SCH /YES - CLEAR FLAG
JMP I .+1 /IF NULL JOB IS RUNNING RE-SCHEDULE
SCHED0
L2EXIT
INTRTN= JMP .
CIF CDF
JMP I .+1
F1RTN /DISMISS INTERRUPT FROM HI-PRIORITY DEVICE
/JOB TABLE ADDRESS TO TEMP0
/CALL TAD JOB #
/ JMS GETTBA
/ TABLE ENTRY
/ RETURN WITH ADDRESS IN TEMP0
GETTBA, 0
DATFLD
DCA TEMP0 /SAVE JOB #
TAD I GETTBA /PICK UP ARGUMENT
DCA .+5
TAD TEMP0 /JOB #
TAD JOBTAB /START OF JOBTBL
CIF
JMS I GETTB1 /GETJTA
0
DCA TEMP0 /ADDRESS TO TEMP0
ISZ GETTBA
JMP I GETTBA
GETTB1, GETJTB
*160
JOB, . /POINTER TO CURRENT JOB NUMBER
CJOBDA, 0 /POINTER TO JOB STATUS BLOCK, CURRENT JOB
CORTBA, CORTBL-1
DEVTBA, DEVTBL
F1OFFJ, 0 /MASK FOR LOGIN; MODIFIED BY THE "ON & OFF" COMMANDS (ON=0; OFF=7774)
WAITF1= JMP .
CIF CDF
JMP I WAIT1
WAIT1, WSCHED
*170
NULINE /SYSTEM PARAMETERS CONVENIENT FOR SYSTAT
JOBMAX
DEVTBL
UPTIM2, 0 /HIGH ORDER UPTIME IN SECONDS
UPTIM1, 0 /LOW ORDER UPTIME IN SECONDS
/DDB POINTERS FOR USE BY SI
F1TCNT, 0 /DDB CHARACTER COUNT
F1ECNT, 0 /DDB EMPTY COUNT
F1BUF, 0 /DDB EMPTY BLOCK
*OUTREG
ZBLOCK SKPTBL-OUTREG
KSKIP= KSF-30
TSKIP= TSF-40
*SKPTBL
KSF /K00 /SKIP IOT FOR CONSOLE KEYBOARD
IFZERO DC08A <
KSKIP+400 /K01 /KEYBOARD SKIP IOTS FOR PT08 AND KL8E
KSKIP+420 /K02
KSKIP+440 /K03
KSKIP+460 > /K04
KSKIP+340 /K05; K01 IF DC08A WITH PT08'S
KSKIP+110 /K06; K02 IF DC08A WITH PT08'S
IFNZRO CPU-1 <
KSKIP+300 > /K07; K03 IF DC08A WITH PT08'S
KSKIP+320 /K10; K04 IF DC08A WITH PT08'S
KSKIP+500 /K11; K05 IF DC08A WITH PT08'S
KSKIP+520 /K12; K06 IF DC08A WITH PT08'S
KSKIP+540 /K13; K07 IF DC08A WITH PT08'S
KSKIP+560 /K14; K10 IF DC08A WITH PT08'S
KSKIP+700 /K15
KSKIP+360 /K16
KSKIP+720 /K17
KSKIP+060 /K20
KSKIP+140 /K21
KSKIP+160 /K22
KSKIP+050 /K23
IFNZRO DC08A <
*SKPTBL+PT08+KL8+1
DC8REG
ZBLOCK DC08A > /DC08A ACTIVE OUTPUT REGISTERS
IFZERO DC08A <*SKPTBL+NULINE+1
OUTIOT > /SWITCH TO OUTPUT SIDE
TSF /K00 /SKIP IOT FOR CONSOLE TELEPRINTER
IFZERO DC08A <
TSKIP+410 /K01 /TELEPRINTER SKIP IOTS FOR PT08 AND KL8E
TSKIP+430 /K02
TSKIP+450 /K03
TSKIP+470 > /K04
TSKIP+350 /K05; K01 IF DC08A WITH PT08'S
TSKIP+120 /K06; K02 IF DC08A WITH PT08'S
IFNZRO CPU-1 <
TSKIP+310 > /K07; K03 IF DC08A WITH PT08'S
TSKIP+330 /K10; K04 IF DC08A WITH PT08'S
TSKIP+510 /K11; K05 IF DC08A WITH PT08'S
TSKIP+530 /K12; K06 IF DC08A WITH PT08'S
TSKIP+550 /K13; K07 IF DC08A WITH PT08'S
TSKIP+570 /K14; K10 IF DC08A WITH PT08'S
TSKIP+710 /K15
TSKIP+370 /K16
TSKIP+730 /K17
TSKIP+070 /K20
TSKIP+150 /K21
TSKIP+170 /K22
TSKIP+650 /K23
IFNZRO DC08A <
*SKPTBL+NULINE+PT08+KL8+3
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 /DC08A OUTPUT VECTOR
JMPDC8 > /DC08A OUTPUT VECTOR
*SKPTP
IFNZRO PUNCH <PSF> /PUNCH
IFZERO PUNCH <NOP>
IFNZRO LPT <LSF> /LINE PRINTER
IFZERO LPT <NOP>
ENDIOT /TERMINATES LIST
*RINGIN
/ADDITIONAL FREE CORE GENERATION TABLE
/REFERENCED BY INIT AT START TIME
/ THE FOLLOWING AREAS WILL BECOME PART OF FREE CORE:
IFZERO TC01+RK05+CDR <
ENDBUF;FCE4 >
IFNZRO TC01+RK05+CDR <
IFZERO TC01 <
ENDBUF;FCE1 >
IFZERO RK05 <
FCB2;FCE2
FCB4;FCE4 >
IFZERO CDR <
FCB3;FCE3 > >
IFNZRO DC08A <
IFNZRO D689 <
FCB5;FCE5 >
IFZERO D689 <
FCB5;DATA1 > >
0 /TO TERMINATE THE LIST
NOPUNCH
ZBLOCK 40000+ENDBUF-. /KEYBOARD INPUT RING BUFFER
// ZBLOCK ENDBUF-. /KEYBOARD INPUT RING BUFFER
ENPUNCH
*ENDBUF
NOPUNCH
ZBLOCK 201 /DECTAPE BUFFER
ENPUNCH
*.
/DECTAPE LEVEL 1 ENTRY
DTL11, TAD DTREMB /PREVIOUS ERRORS FROM THIS TRANSFER
DTRB /"OR'ED" WITH ANY NEW ERRORS
DCA DTREMB
DTRB /WERE THERE ANY ERRORS?
SMA
JMP I DTXOR /A-OK!
AND K0500 /WHAT WAS IT?
SNA /SELECT ERROR OR TIMING ERROR
JMP DTSR0 /NO - MUST BE MARK, END, OR PARITY
AND K0400
SZA CLA /TIMING ERROR?
JMP DTSR1 /NO - SELECT ERROR - DON'T RETRY
CLL CMA RAL /AC=-2
TAD I DTERRA /TIMING ERROR WAS OUR FAULT - INTERRUPT OFF TOO LONG
DCA I DTERRA /DON'T CHARGE HIM/HER FOR THE TURN-AROUNDS
DTSR0, ISZ I DTERRA /COUNT A TURN-AROUND
JMP DTSR2 /OK - CONTINUE SEARCHING
DTSR1, TAD DTREMB /ACCUMULATED ERROR STATUS
RAL
STL RAR /MAKE SURE THE ERROR BIT IS SET
JMP DTSTOP /SHUT HIM/HER DOWN
DTSR2, CDF
TAD DTBLKP
DCA I DTCAP /RESTORE CA TO POINT INTO WORD 2 OF HIS/HER DDB
DTRA /CURRENT STATUS
AND K0377
DTXA /CLEAR GO, FUNCTION, AND INTERRUPT ENABLE
TAD K0614 /SWITCH DIRECTIONS, GO, SEARCH AND ENABLE
DTSRCH, JMS DTXOR /CONTINUE SEARCHING
DTSR3, TAD DTCOM
RTL
RTL
STA CML RAL /AC=-1 IF FORWARDS R/W; AC=-2 IF REVERSE R/W
DCA DTDIR
TAD I DTBLKP
TAD M2702
SNL CLA /ARE WE AT A REASONABLE BLOCK NUMBER?
JMP DTSR0 /NO -- TURN AROUND
TAD DTBLK
TAD M2702
SNL CLA /DOES HE WANT A REASONABLE BLOCK?
JMP DTSR1 /NO -- QUIT LOOKING FOR IT
DTRA /WHICH WAY ARE WE GOING?
RTL
RTL
CLA /PRESENT DIRECTION IS IN THE LINK
TAD DTBLK /BLOCK WANTED
CIA
TAD I DTBLKP /BLOCK FOUND
SNA /ARE WE THERE?
JMP DTSR5 /YES - SEE IF WE ARE GOING IN THE RIGHT DIRECTION
ISZ DTDIR /NO
CIA /REVERSE R/W - NEGATE AC
SMA
JMP DTSR4 /SKIP SOME CODE - WE'RE ON THE WRONG SIDE OF THE BLOCK
SZL /L=1 MEANS WE'RE GOING THE WRONG WAY
TAD K0003 /MAKE ROOM FOR TURN-AROUND
CMA
AND K7770
SNA /ARE WE CLOSE?
JMS DTSR7 /YES - GO CHECK BUFFER STATUS
DTSR4, AND K7700 /ARE WE TOO FAR AWAY?
SZA SNL SMA
JMP DTSR6 /PUT HIM/HER ON THE TIMER
SNL CLA /ARE WE GOING IN THE RIGHT DIRECTION?
JMP DTSRCH /CONTINUE IN THE SAME DIRECTION
JMP DTSR0 /GO TURN AROUND
DTSR5, JMS DTSR7 /CHECK ON BUFFER STATUS
ISZ DTDIR
CML /CORRECT LINK FOR REVERSE R/W
SNL /ARE WE GOING IN THE RIGHT DIRECTION?
JMP DTSRCH /NO - CAUSE OVER-SHOOT FOR TURN-AROUND
TAD M201
CDF
DCA I DTWCP /SET UP DECTAPE WORD COUNT
TAD DTBUFA
DCA I DTCAP /SET UP DECTAPE CURRENT ADDRESS
TAD DTCOM
AND K0040 /READ OR WRITE?
CLL RAR
TAD K0030
JMS DTXOR /CHANGE FROM SEARCH TO READ OR WRITE
DTSTOP, ISZ DTBUF /ASSIGN THE BUFFER - IF HE DOESN'T ALREADY HAVE IT
AND K7701
DCA I DTERRA /SAVE STATUS B FOR HIM/HER
DTRA
AND K0400
SZA CLA /WHICH WAY ARE WE GOING?
TAD K7774
TAD K0002
TAD I DTBLKP /REMEMBER WHERE WE WILL FINALLY STOP
DCA I DTBLKP
DTRA
AND K0204 /CLEAR GO & INTERRUPT ENABLE
JMP DTSRCH /TO STOP THE TAPE
DTWCP, 7754
K7701, 7701
K0014, 14
DTSR6, RTR /DIVIDE BY 100
RTR
RTR
CIA
DCA DTBUF /-SECONDS TO WIND ON TIMER
TAD K0003
TAD I DTST
DCA DTDIR /POINTS TO USER WORD 1
DTRA
AND K0400
SZA CLA /WHICH WAY SHOULD WE SET THE BRAKES LATER?
ISZ I DTDIR /SET BIT 11 TO SHOW REVERSE
TAD K0014
JMP DTSRCH /KEEP HIM/HER MOVING WITH INT. DISABLED
DTSR7, 0
TAD DTCOM
AND K0020 /IS THIS A READ?
TAD DTBUF /OR - IS THE BUFFER LOADED FOR A WRITE?
SZA CLA
JMP I DTSR7 /PROCEED
JMP DTSTOP+2 /STOP AND WAIT FOR THE BUFFER TO BE LOADED
DTDIR,
DTXOR, DTSTOP /WHERE TO RETURN ON SUCCESSFUL INTERRUPT
DTXA /ZAP IN THE NEW FUNCTION
DTRA
RTR
RAR
SZL CLA /DID WE STOP?
CML CMA RTL
DCA DTTIME /LOAD THE CONTROLLER TIMER
SNL
TAD DTL2 /WE'RE DONE - SCHEDULE LEVEL 2
INTRTN
DTL2, DTL20
/DECTAPE LEVEL 2 COMPLETION
DTL21, TAD DTBUF /WHAT KIND OF COMPLETION?
SNA
JMP DTEND4 /END OF A SEARCH - TAPE NOW IN POSITION FOR THE WRITE
SPA CLA
JMP DTEND6 /THIS DRIVE HAS BEEN PUT ON TIMER
TAD DTCOM
AND K0020
SNA /WAS IT A READ OR WRITE?
JMP DTEND3 /WRITE - HE'S ALL DONE
JMS DTDATA /READ - TRANSFER HIS/HER DATA BACK TO HIM/HER
EXITF1 /WAIT FOR DISK TO FINISH
DTEND3, TAD DTJOB
JMS I AWAKEN /TAKE HIM/HER OUT OF WAIT STATUS
DTERR, 0
DTEND4, DCA DTJOB /CONTROLLER IS FREE
DTEND5, JMS I DTGOA /TRY TO START A DECTAPE TRANSFER
EXITF1
DTEND6, TAD DTBUF
DCA I A15 /SAVE -SECONDS TO WIND TAPE
ISZ I DTST /CHANGE TO DECTAPE TIMER WAIT
JMP DTEND4 /FIND SOMETHING ELSE TO DO
/MOVE 201 WORDS TO/FROM USER, FROM/TO DATFLD
/USER MAY BE IN CORE OR ON HIS/HER SWAP TRACK
DTDATA, 0
DCA TEMP1 /SAVE READ/WRITE INDICATOR: 0=WRITE, 20=READ
CIF
TAD DTJOB
JMS I COREA /NOW FIND OUT WHERE HE IS
SWAP LOCK FIP SI CJOB
JMP DTDA1 /HE'S IN HIS/HER SWAP TRACK
AND K0070 /SAVE HIS/HER FIELD
TAD K6201
DCA UDF1+1 /UDF1 IS FIXED FOR BLTF1
TAD DTBUFA
DCA A17 /POINTS TO DECTAPE BUFFER IN DATFLD
TAD DTUCA
DCA A16 /USER BUFFER POINTER
TAD TEMP1
CLL CMA RTR
RTR
RAR
JMS I BLTF1A /L=0 FOR READ, L=1 FOR WRITE; AC=-201
ISZ DTDATA /SKIP - DATA HAS ALREADY BEEN MOVED
JMP I DTDATA
DTDA1, IAC
TAD DTUCA
CLL IAC
TAD K0200
SNL /DO WE HAVE A WRAP-AROUNND SITUATION?
CLA /NO - WE CAN DO THE WHOLE THING AT ONCE
TAD M201
DCA DTDWC /WC FOR DISK TRANSFER
TAD DTBUFA
DCA DTDCA /CA FOR DISK TRANSFER
TAD DTJOB
TAD K0004
CLL RTL
DCA DTDHI /TRACK ADDRESS FOR DISK TRANSFER
TAD TEMP1
SZA CLA
STL RTL
TAD DTDMAR
DCA DTDIOT /DMAR OR DMAW FOR DISK TRANSFER
IAC
TAD DTUCA
JMS DTDGO /START THE DISK
JMP I DTDATA /EXIT - NO SKIP - MUST WAIT FOR DISK
/DISK PARAMETER BLOCK FOR DECTAPE HANDLER
DTDIOT, 0
DTDHI, 0
7
DTDWC, 0
DTDCA, 0
DTDLO, 0
DTDSK
DTDPAR, DTDIOT
COREA, CORSRC
DTDMAR, DMAR
DTDISK, DTDSF0
DTDGO, 0
DCA DTDLO /DISK ADDRESS TO START AT
TAD DTDPAR
CIF
JMS I DTDISK /NOW GO TO TS8 TO START OUR REQUEST
JMP I DTDGO /RETURN HERE AFTER STARTING THE DISK
JMP DTDCMP /RETURN HERE AFTER A GOOD DISK TRANSFER
SKP /RETURN HERE AFTER A BAD DISK TRANSFER
JMP DTEND3 /RETURN HERE AFTER REPORTING THE DISK ERROR
TAD DTJOB /JOB IN TROUBLE
CIF CDF
JMP I .+1 /GO REPORT THE ERROR - MAKE IT SWPRER
DTDEF0
DTDCMP, TAD DTDWC
CIA
TAD M201
SNA /DO WE NEED A SECOND PASS?
JMP DTDCM0 /NO - IT'S DONE
DCA DTDWC
TAD DTDLO /YES - HAVE WE ALREADY DONE IT?
SNA
JMP DTDCM0 /ALL FINISHED!
CIA
TAD DTDCA /UPDATE THE DISK'S C.A.
DCA DTDCA
JMS DTDGO /START THE DISK AGAIN
EXITF1
DTDCM0, TAD DTBUF /WAS IT A READ OR A WRITE?
SZA CLA
JMP DTEND3 /READ - WE'RE FINISHED
ISZ DTBUF /ASSIGN THE BUFFER TO HIM/HER NOW
TAD A15 /GO RESTART HIS/HER WRITE
JMP DTEND5
DTLOAD, 0
DCA DTDGO /SAVE THE DESIRED STATUS A
DTRA
DCA DTDATA /AND THE PRESENT STATUS A
TAD DTDGO
AND DTDATA /WHERE WILL CARRIES BE GENERATED
CIA
CLL RAL /WE WANT TO CANCEL THE CARRIES
TAD DTDGO /NOW ADD THEM TOGETHER
TAD DTDATA /NOW WE HAVE THE "XOR" OF THE "PRESENT" AND THE "DESIRED" STATUS A
DTXA /"XOR" IT INTO THE CONTROLLER
JMP I DTLOAD /THE RESULT WILL BE THE DESIRED STATUS A
STSI, DCA IX4 /SI - WANTS TO STOP A TAPE ON TIMER
CLL CMA RAL
DCA TEMP1 /ONLY STOP ONE TAPE
DCA TEMP2 /PREVENT HIM/HER FROM GOING BACK INTO DECTAPE CONTROLLER WAIT
K7001, IAC
JMS DTIMER /STOP HIM/HER
CIF 20
JMP I .+1 /BACK TO SI
DTSIDT
/START OR RESTART A DECTAPE READ OR WRITE FOR THE USER
DTGO, 0
SZA /ARE WE RESTARTING AFTER A TIMER KILLED US?
JMP DTGO1 /YES - SO WE DON'T NEED TO LOOK AT THE QUEUE
TAD DTJOB
SZA CLA /IS THE CONTROLLER BUSY?
JMP I DTGO /CONTROLLER IS ALREADY BUSY
DCA DTBUF /BUFFER IS EMPTY
JMS I DTRKJA /FIND SOMEONE WAITING FOR THE CONTROLLER
-1
JMP I DTGO /NOTHING WAITING
DTGO1, AND K7770
DCA A15
TAD I A15 /PULL JOB NUMBER FROM DDB
DCA DTJOB
TAD DTJOB
JMS GETTBA /FIND WAIT 2
JOBWMK+1
TAD TEMP0
DCA DTST /SAVE ITS POINTER FOR LATER
ISZ A15
TAD A15 /ADDRESS TO DUMP BLOCK NUMBERS INTO
DCA DTBLKP
ISZ A15
TAD I A15 /USER WORD 1 -- UNIT, DIR, FUNC.
DCA DTCOM
TAD I A15 /USER WORD 2 -- BLOCK NUMBER WANTED
DCA DTBLK
TAD I A15 /USER WORD 3 -- USER'S C.A.
DCA DTUCA
TAD DTCOM /DIRECTION FOR THIS OPERATION
AND K0400
K7740, SZA SMA CLA
TAD DTREV
TAD K0006 /AC=-5 FOR REVERSE R/W; AC=+6 FOR FORWARD R/W
TAD I DTBLKP /GET BLOCK FROM LAST TIME
TAD K0020 /BIAS BY 20 TO AVOID NEG. NUMBERS AND ZERO
STL CIA
TAD K0020
TAD DTBLK /BLOCK WE WANT
SZL
CIA /AC=ABSOLUTE VALUE OF DIFFERENCE
AND K7740
DCA TEMP4 /SAVE THAT RESULT FOR LATER
TAD DTCOM
AND K7000 /SAVE ONLY THE UNIT
SZL /LINK=INITIAL SEARCH DIRECTION
TAD K0400 /SEARCH REVERSE INITIALLY
JMS I DTLOAA /LOAD THE CONTROLLER
TAD DTCOM /LOAD THE DECTAPE BUFFER IF:
AND K0020 / ******* HE'S DOING A WRITE
TAD TEMP4 / ******* THE DESIRED BLOCK IS FAIRLY CLOSE
TAD DTBUF / ******* THE BUFFER IS EMPTY
SZA CLA
JMP DTGO2 /AT LEAST ONE OF THE ABOVE IS FALSE
JMS I DTGETW /MOVE 201 WORDS FROM USER (CORE OR SWAP TRACK) TO DATFLD
JMP DTGO3 /WAIT FOR THE DISK TO FINISH
ISZ DTBUF /ASSIGN THE BUFFER TO HIM/HER
DTGO2, TAD DTSR3A
DCA I DTXORA /SET UP FOR SEARCH MODE
DCA DTREMB /CLEAR ERROR ACCUMULATOR
CDF
TAD DTBLKP
DCA I DTCAP /SET UP CA FOR THE BLOCK NUMBERS
CIF DATFLD /INHIBIT INTERRUPTS
TAD K0010 /ALL DATA BREAKS ARE TO DATFLD
DTLB
TAD K7770
DCA I DTERRA /ALLOW 10 CHANGES OF DIRECTION
TAD K0214
DTXA /GO, SEARCH, INT. ENABLE
CLL CMA RTL /SET CONTROLLER TIMER FOR 3 SECONDS
DTGO3, DCA DTTIME
JMP I DTGO
DTREV, -13
DTSR3A, DTSR3
DTGETW, DTDATA
DTXORA, DTXOR
DTLOAA, DTLOAD
DTIMER, 0
JMS I DTRKJA /FIND A JOB IN DECTAPE TIMER WAIT
-2
JMP DTIME3 /ALL DONE
TAD K0005
DCA TEMP3 /POINTER TO TIMER COUNT
DTIME1, CLL CMA RTL /AC=-3
ISZ I TEMP3 /IS HIS/HER TIMER UP?
JMP DTIMER+1
TAD TEMP3 /YES - JAM ON THE BRAKES
DCA TEMP4 /POINT TO USER WORD 1
CIF DATFLD /INHIBIT INTERRUPTS
DTRA /GET STATUS OF CURRENT UNIT
AND K0004 /SAVE ENABLE
SZA /IS IT REALLY DOING SOMETHING?
TAD K0200 /YES - CLEAR GO AND ENABLE
DTXA
TAD I TEMP4
AND K7001 /SAVE UNIT AND CURRENT DIRECTION
TAD K0377 /MOVE THE DIRECTION BIT INTO POSITION
AND K7400
JMS I DTLOAA /STOP HIM/HER!!!
TAD K7770
AND I TEMP4
DCA I TEMP4 /CLEAR "BRAKE" BIT
TAD TEMP2
TAD I TEMP0
DCA I TEMP0 /PUT HIM/HER BACK IN DECTAPE WAIT
JMP DTIME1 /CHECK FOR OTHER DRIVES TO STOP
DTIME3, TAD TEMP4
SNA CLA
JMP DTIME4 /NOTYING STOPPED THIS TIME
TAD DTTIME /WAS ANYTHING IMPORTANT GOING ON?
SZA CLA
TAD A15 /YES - LET'S GET BACK TO IT
JMS I DTGOA /START SOMETHING
DTIMEX, JMP I DTIMER
DTIME4, CIF DATFLD /INHIBIT INTERRUPTS
TAD DTTIME /IS THE CONTROLLER BUSY?
SZA CLA /NO
ISZ DTTIME /YES - BUMP CONTROLLER TIMER
JMP I DTIMER
DTRA /IT'S HUNG
AND K0204
DTXA /STOP THE TAPE (IF IT'S EVEN MOVING)
STA
DCA I DTERRA /LET HIM/HER KNOW THE TRANSFER PROBABLY DIDN'T HAPPEN
IAC
DCA DTBUF
DCA DTCOM
TAD DTJOB
JMS DTRKER /REPORT THE ERROR & SCHEDULE LEVEL 2
DTL20
JMP I .+1 /BACK THROUGH THE TIMER CODE
DTIMEX
FCE1= .+1&7770
DTRKER, 0
CIF CDF
JMS I DTRKHA /REPORT THE HUNG DEVICE
TAD I DTRKER /GET THE L2 DISPATCH ADDRESS
ISZ DTRKER /BUMP PAST THE ARG.
CIF CDF
JMS I QUEUE1 /PUT IT ON LEVEL 2 QUEUE
JMP I DTRKER
UUDTRK, DCA TEMP2
TAD I L2SAP /GET USER AC
DCA TEMP1
SNL /DON'T CLEAR THE AC IF IT'S AN RK05 REQUEST
DCA I L2SAP /CLEAR HIS/HER AC
TAD I UDFP /GET THE "CDF" FOR HIS/HER FIELD
DCA UDF1+1
JMS UDF1 /CHANGE TO USER FIELD
TAD I TEMP1 /GET WORD 1 OF HIS/HER PARAMETERS
SZL /RK05?
JMP URK05 /YES
RTL
RTL
AND K0007 /AC=UNIT NUMBER
UDTXAD, TAD DTDEVA /INDEX INTO THE DEVICE TABLE
DCA UDTDDB
DATFLD
CIF /FIELD 0 ROUTINE
JMS I DTCHKA /SEE IF HE OWNS THIS UNIT
UDTDDB, 0
STA
TAD TEMP1
DCA A16
TAD I UDTDDB
TAD K0003 /SET UP TO MOVE PARAMETERS
DCA A17
CLL CMA RTL /L=1; AC=-3
JMS I BLTF1A /MOVE 3 WORDS FROM UDF TO DATFLD
TAD I UDTDDB
TAD TEMP2
JMS I WAIT2 /SET WAIT 2 CONDITION FOR DECTAPE OR RK05
TAD TEMP2
CLL RTR
SZL CLA /RK05?
JMP RK05GO /YES
JMS I DTGOA /NO - TRY TO START THE DECTAPE
WAITF1
URK05, CLL RAR
AND K0003 /RK05 UNIT #
TAD K0010 /DISPLACE TO RK05 DDB'S
JMP UDTXAD
DTDEVA, DEVTBE+5
/SEARCH FOR A JOB WAITING FOR A "WAIT 2" CONDITION
/CALLING SEQUENCE:
/ AC=0 COMPLETE PASS; AC NON-ZERO FINISH CURRENT PASS
/ JMS DTRKJB
/ MINUS WAIT CONDITION NUMBER
/ RETURN - NO JOBS FOUND
/ RETURN - CONTENTS OF WAIT 2 IN AC
DTRKJB, 0
SZA CLA /DO WE WANT A FULL PASS?
JMP DTRK2 /NO - JUST COMPLETE FROM WHERE WE LEFT OFF
TAD JOBCNT
DCA TEMP1 /SET COUNT FOR JOBMAX
DTRK1, TAD IX4 /CHECK POSITION OF RING POINTER
TAD DTRKEN
SZA CLA
JMP .+3
TAD JOBTAB /RESET RING POINTER
DCA IX4
TAD I IX4
SNA /IS THIS JOB DEFINED?
JMP DTRK2 /NO
TAD K0005 /POINT AT WAIT 2
DCA TEMP0
TAD I TEMP0
AND K0007
TAD I DTRKJB
SZA CLA /IS HE WAITING FOR OUR CONDITION?
JMP DTRK2 /NOPE
TAD I TEMP0 /PUT THE CONTENTS OF WAIT 2 IN THE AC
ISZ DTRKJB /CAUSE SKIP ON EXIT
JMP DTRK3
DTRK2, ISZ TEMP1 /MORE?
JMP DTRK1
DTRK3, ISZ DTRKJB /INDEX PAST ARGUMENT ON RETURN
JMP I DTRKJB
DTRKEN, -CLKTBL+1
/MOVE DATA TO/FROM DATFLD FROM/TO USER CORE
/ USER'S POINTER IN "A16"
/ DATFLD POINTER IN "A17"
/CALLING SEQUENCE:
/ AC=-NUMBER OF WORDS; LINK=0 FROM DATFLD TO USER, LINK=1 FROM USER TO DATFLD
/ JMS BLTF1
/ RETURN
BLTF1, 0
DCA TEMP1 /SAVE NUMBER OF WORDS TO MOVE
BL0, SNL /WHICH DIRECTION?
JMP BL1
JMS UDF1 /FROM USER
TAD I A16
DATFLD /TO DATFLD
DCA I A17
JMP BL2
BL1, TAD I A17 /FROM DATFLD
JMS UDF1
DCA I A16 /TO USER
DATFLD
BL2, ISZ TEMP1 /MORE?
JMP BL0 /YES
JMP I BLTF1
WAKEUP, 0
ISZ F1SCH /SET FLAG TO SCHEDULE THIS USER IMMEDIATELY IF POSSIBLE
JMS GETTBA /FIND STR1
JOBSTS+1
CLL STA RAL /AC=7776
AND I TEMP0 /CLEAR JSWAIT
IAC
DCA I TEMP0 /NOW WE CAN BE SURE THAT IT IS SET
ISZ TEMP0 /NOW UPDATE THE DEVICE STATUS REGISTER
TAD I WAKEUP
DCA I TEMP0 /THE NEW D.S.R.
ISZ TEMP0
ISZ I TEMP0 /TURN ON DUMMY WAIT BIT IN WAIT MASK 1
ISZ TEMP0
DCA I TEMP0 /TAKE HIM/HER OUT OF WAIT
ISZ WAKEUP
JMP I WAKEUP
FCB2= .+7&7770
RKREDO, REDO0
RK05GO, CIF CDF
TAD RKJOB /WHO OWNS THE CONTROLLER?
SZA CLA
JMP I RKREDO /HE'LL HAVE TO WAIT
TAD I JOB
DCA RKJOB /HE NOW OWNS THE CONTROLLER
DCA I L2SAP /ZERO AC IN CASE TRANSFER DOESN'T START
CIF DATFLD
TAD RKJOB
JMS GETTBA /GET WAIT 2
JOBWMK+1
CLL CMA RTL /AC=-3
DCA RKERR /3 TRIES ON ERROR
DCA RKBLKS /CLEAR SUCCESSFULL TRANSFER COUNTER
JMS USRLOK /LOCK HIM/HER IN HIS/HER FIELD
DCA RKCORE /SAVE THE CORTBL POINTER
TAD I TEMP0 /POINTS TO DDB WORD 4 (-1)
JMS I RKGOA /START UP THE RK05 DISK
SZA CLA
JMP RKL21 /DIDN'T EVEN GET OFF THE GROUND
CLL STA RAL
DCA RKTIME /SET TIMER FOR 2 SECONDS
WAITF1
RKL21, ION
CDF
CLL STA RTR
AND I RKCORE
DCA I RKCORE /UNLOCK HIS/HER FIELD
DCA RKCORE
TAD RKJOB
JMS GETTBA /FIND HIS/HER AC
JOBREG+2
TAD RKBLKS
DCA I TEMP0 /PASS NUMBER OF BLOCKS TRANSFERRED BACK TO THE USER
TAD RKJOB
RKEND2, JMS I AWAKEN /TAKE HIM/HER OUT OF WAIT STATUS
RKERR, 0
DCA RKJOB /FREE THE CONTROLLER
JMS I DTRKJA /LOOK FOR OTHERS WAITING FOR THE CONTROLLER
-3
EXITF1 /NOBODY ELSE WANTS IT
AND K7770
DCA IX3
TAD I IX3 /EXTRACT THE JOB # FROM THE DDB
JMP RKEND2
RKGOA, RKGO
FCE2= .+1&7770
/ROUTINE TO SET A WAIT 2 CONDITION FOR THE CURRENT USER
/ (FOR DECTAPE, RK05, OR CARDREADER)
/ ENTER WITH DESIRED WAIT 2 STATUS IN THE AC
WAITS2, 0
DCA TEMP2
CDF
TAD I JOB /GET USER JOB NUMBER
JMS GETTBA
JOBWMK
DCA I TEMP0 /CLEAR WAIT MASK 1
ISZ TEMP0
TAD TEMP2 /GET WAIT NUMBER
DCA I TEMP0 /NOW HE'S WAITING
JMP I WAITS2
/ROUTINE TO LOCK CURRENT USER IN HIS/HER CORE FIELD
/ RETURNS WITH CORTBL POINTER IN AC
USRLOK, 0
CDF
TAD I L2SFP /POINTER TO LEVEL 2 SAVE FIELD
AND K0007 /JUST THE FIELD
TAD CORTBA /DISPLACEMENT INTO THE CORE TABLE
DCA TEMP2
STL RTR /AC=2000
TAD I TEMP2
DCA I TEMP2 /LOCK IN CORE
DATFLD
TAD TEMP2 /NOW RETURN WITH POINTER INTO CORE TABLE
JMP I USRLOK
L2SFP, L2SF
FCB3= .+7&7770
CDCNT, 0
CDCORE, 0
CDTIMR, TIMCDR
CDL21, CLL CMA RTR /AC=5777
AND I CDCORE
DCA I CDCORE /UNLOCK THE CORE FIELD
TAD CDJOB
JMS GETTBA /FIND HIS/HER AC
JOBREG+2
TAD CDCNT
DCA I TEMP0 /PUT THE COLUMN COUNT IN HIS/HER AC
TAD CDJOB
JMS I AWAKEN /TAKE HIM/HER OUT OF WAIT STATUS
CDBUF, 0
EXITF1
CDL11, TAD I CDTIMR
SNA CLA /WERE WE EXPECTING AN INTERRUPT?
JMP CDIOT /NO
ISZ CDCNT /COUNT A COLUMN
ISZ CDBUF /BUMP THE USER'S POINTER
CDJOB, 0 /JOB OWNING THE CARD READER - (COVERS THE "ISZ SKIP")
CDREAD, .-. /THE PROPER READ IOT IS PLACED HERE
CDFLD, .-. /CDF TO THE USER'S FIELD
DCA I CDBUF /STASH A COLUMN IN THE USER'S BUFFER
INTRTN
CDIOT, RCRA /CLEAR UNWANTED INTERRUPT
CLA
INTRTN
UUCDR, CLL RAL /TIMES 2
TAD CDIOT /CONSTRUCT READ IOT
DCA CDREAD /EITHER ALPHA, BINARY, OR COMPRESSED (8E ONLY)
TAD I L2SAP
DCA CDBUF /SAVE THE USER'S BUFFER POINTER
DCA I L2SAP /CLEAR USER AC - IN CASE THE READER ISN'T READY
TAD I UDFP
DCA CDFLD /SAVE CDF TO USER'S FIELD
TAD I JOB
DCA CDJOB
DCA CDCNT /ZERO COLUMN COUNT
IOF
IFZERO CPU&7776 < JMP .+4 >
IFNZRO CPU&7776 < RCTF > /CLEAR 8E TRANSITION FLAG
IAC
RCNO /ENABLE CARD READER INTERRUPTS
CLA
RCSE /START CARD READER
JMP UUCDRB /NOT READY - PUT HIM/HER TO SLEEP BEFORE CONTINUING
JMS USRLOK /LOCK HIM/HER IN HIS/HER FIELD
DCA CDCORE /SAVE POINTER TO CORTBL
TAD K0004
JMS I WAIT2 /MAKE HIM/HER WAIT FOR THE CARD READER
CIF CDF
CLL CMA RAL /AC=-2
DCA I CDTIMR /SET CARD READER TIMER
JMP I WAIT1
UUCDRB, CIF CDF
JMP I SLEEPB /PUT HIM/HER TO SLEEP FOR A COUPLE OF SECONDS
*2000
FCE3= .&7770
FCB4= .+7&7770
RKL11, DRST /GET CONTROLLER STATUS
CLL RAL /IGNORE THE DONE BIT
SZA
JMP RKSR1 /ERROR!!!!!
ISZ RKBLKS /COUNT A SUCCESSFUL TRANSFER
TAD RKCMD
SNA /ARE WE FINISHED?
JMP RKSR2 /YES
DLDC /LOAD THE NEW COMMAND
TAD RKSECT
DLAG /LOAD THE NEW SECTOR - WE'RE OFF AND RUNNING AGAIN
JMS RKNXT /SET UP FOR THE NEXT BLOCK (IF ANY)
CLL STA RAL
DCA RKTIME /SET CONTROLLER TIMER FOR 2 MORE SECONDS
CLL STA RTL
DCA I RKERRA /THREE ERRORS
INTRTN
RKSR1, ISZ I RKERRA
JMP RKSR4 /STILL OK TO RETRY
DRST
RKSR2, DCA I RKERRA /FINAL STATUS FOR THE USER
DLDC /CLEAR CONTROLLER STATUS AND COMMAND REGISTERS
DCA RKTIME
TAD RKL2 /SCHEDULE LEVEL 2
INTRTN
RKSR4, AND K1012 /SAVE SPECIAL CASE ERROR BITS
SNA
RKSRE, JMP RKSR5+1 /DON'T RECAL. OR PUT CURRENT JOB TO SLEEP
AND K0010
SZA CLA
JMP RKSR5 /PUT CURRENT JOB TO SLEEP AND RE-TRY
IAC
DCLR /IN CASE WE HAVE SOMETHING REALLY IN TROUBLE
TAD RKCOM
AND K0006 /SAVE ONLY THE UNIT #
TAD K0600 /ENABLE INTERRUPT ON SEEK COMPLETION
DLDC
STL RTL
DCLR /RE-CALIBRATE
TAD RKSRE
DCA RKL11 /CHANGE LEVEL 1
CLL STA RTL /ALLOW 3 SECONDS FOR THE RE-CALIBRATE
DCA RKTIME
DCLR
INTRTN
RKSR5, TAD SLEEPB
DCA INTS2
CLL CMA RTL /AC=-3
TAD IX3 /POINTER TO DDB WORD 4 (-1)
JMS RKGO /RE-TRY
SNA /ANYTHING BAD?
TAD INTS2 /NO - HOW ABOUT PUTTING SOMEONE TO SLEEP?
INTRTN
K1012, 1012
RKL2, RKL20
RKFLD, -CORTBL+51
RKGO, 0
DCA IX3 /SAVE THE DDB POINTER
IAC
DCLR /CLEAR THE CONTROLLER
TAD I IX3 /USER WORD 1
CLL RTR
RAR
DCA RKCOM /SAVE COMMAND DIVIDED BY 10
TAD RKCOM
AND K0037 /PAGE COUNT
SNA
TAD K0040 /FOR 0 OR 40 GIVE HIM/HER 40
CMA
TAD RKBLKS
TAD RKBLKS /ADD NUMBER OF PAGES ALREADY TRANSFERRED
DCA RKCNT
TAD RKCOM
AND K7400 /SAVE FUNCTION, DRIVE, AND HI ORDER SECTOR BIT
TAD RKCORE /POINTER TO CORTBL ENTRY
TAD RKFLD /EXTRACT FIELD NUMBER AND INSERT INTERRUPT ENABLE AND HALF BLOCK BITS
CML RTL /"RKFLD" COMPLEMENTED THE LINK
RAL
DCA RKCOM /SAVE THE CONSTRUCTED COMMAND REGISTER
TAD RKBLKS /NUMBER OF SECTORS ALREADY TRANSFERRED
TAD I IX3
DCA RKSECT /STARTING SECTOR NUMBER FROM THE USER
SZL
ISZ RKCOM /BUMP HI ORDER BIT
TAD RKBLKS /NUMBER OF BLOCKS ALREADY TRANSFERRED
CLL RTR /TIMES 400
RTR
RAR
TAD I IX3
IAC /WE ADD ONE SINCE THE CONTROLLER WANTS THE REAL ADDRESS
DLCA /LOAD USER'S CA INTO THE CONTROLLER
JMS RKCMD /GENERATE FIRST COMMAND
IOF
DLDC /LOAD CONTROLLER COMMAND REGISTER
TAD RKSECT
DLAG /LOAD IN THE DESIRED SECTOR - WE ARE OFF AND RUNNING
JMS RKNXT /SET UP FOR THE NEXT SECTOR (IF ANY)
TAD RKDRST
DCA RKL11 /FIX FIRST WORD OF INTERRUPT SERVICE
DSKP /ARE WE TRYING TO DO SOMETHING BAD?
JMP I RKGO /NO - EVERYTHING IS PEACHY
RKDRST, DRST
DCA I RKERRA /SAVE ERROR STATUS - NO RE-TRIES WILL BE MADE
DLDC /CLEAR CONTROLLER STATUS AND COMMAND REGISTERS
TAD RKL2 /RETURN WITH L2 DISPATCH
JMP I RKGO
RKCMD, 0
ISZ RKCNT
TAD RKCNT
SMA CLA /ANY MORE BLOCKS TO GO?
JMP RKDONE /NO - CLOSE IT OUT
ISZ RKCNT /HALF BLOCK?
TAD K7700 /NO - REMOVE THE HALF BLOCK BIT FROM THE COMMAND
TAD RKCOM /GET THE COMMAND
JMP I RKCMD
RKNXT, 0
ISZ RKSECT /BUMP SECTOR
TAD RKSECT
SNA
ISZ RKCOM /BUMP HI-ORDER SECTOR BIT
AND K0037
SZA CLA /WILL WE SEEK ON THIS ONE?
TAD K1000 /NO - DO A READ ALL OR WRITE ALL
DCA INTS1
JMS RKCMD /CHECK FOR HALF BLOCK AND COMPLETION
TAD INTS1
RKDONE, DCA RKCMD /SAVE THE NEW COMMAND REGISTER
JMP I RKNXT
PAGE
FCE4= .&7770
IFNZRO DC08A <
T8ASSM, 0
AND T83770 /THE CHARACTER ONLY
SNA
JMP T8ASS1 /IGNORE NULL CHARACTERS
CLL RTR /BRING THE CHARACTER INTO POSITION
RAR
AND T80177
TAD K0200 /FORCE ON THE PARITY BIT
CIF 00 /STASH IT AWAY
JMS I T8IN1A /THAT'S DONE IN FIELD 0
ION
T8ASS1, CLL STA RTL /AC=-3
TAD T8ASSM
DCA T8T /POINTS TO THE LSW
TAD I T8T
AND T83770 /SAVE ONLY THE LINE NUMBER
DCA I T8T
ISZ T8T /POINTS TO THE CAW
STL RTR /AC=2000
DCA I T8T /RESET THE FLAG BIT
TTIR /BUMP THE "R" REGISTER
JMP I T8ASSM
T80177, 177
T83770, 3770
T8IN1A, T8IN1
T8T, 0
T8TTI, TTI
DC08LO^10+0 /LSW LINE # PT08+DC08LO+1
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+10 /LSW LINE # PT08+DC08LO+2
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+20 /LSW LINE # PT08+DC08LO+3
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+30 /LSW LINE # PT08+DC08LO+4
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+40 /LSW LINE # PT08+DC08LO+5
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+50 /LSW LINE # PT08+DC08LO+6
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+60 /LSW LINE # PT08+DC08LO+7
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+70 /LSW LINE # PT08+DC08LO+10
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+100 /LSW LINE # PT08+DC08LO+11
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+110 /LSW LINE # PT08+DC08LO+12
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+120 /LSW LINE # PT08+DC08LO+13
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+130 /LSW LINE # PT08+DC08LO+14
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+140 /LSW LINE # PT08+DC08LO+15
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+150 /LSW LINE # PT08+DC08LO+16
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+160 /LSW LINE # PT08+DC08LO+17
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+170 /LSW LINE # PT08+DC08LO+20
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+200 /LSW LINE # PT08+DC08LO+21
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+210 /LSW LINE # PT08+DC08LO+22
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+220 /LSW LINE # PT08+DC08LO+23
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
TTI
DC08LO^10+230 /LSW LINE # PT08+DC08LO+24
2000 /CAW
JMS T8ASSM /CHARACTER FULLY ASSEMBLED
*T8TTI+DC08A+DC08A+DC08A+DC08A
CIF 00
JMP I .+1 /BACK TO THE REST OF THE DC08A SERVICE
T8OUT1
FCB5= .+7&7770
*2360
FCE5= .&7770
DFCLS0, ZBLOCK 4
DFCNO0, ZBLOCK 4
DFL2S0, ZBLOCK 4
-1 /TO END TABLE
DFL2DL= .
1-DC08LO+PT08+KL8;11-DC08LO+PT08+KL8
21-DC08LO+PT08+KL8;31-DC08LO+PT08+KL8
DFRING, CTG /CLEAR THE GROUP COUNTER
TAD K7774
DCA TEMP0 /COUNTER FOR GROUP SEARCH
DFRNG1, RRS /READ RING STATUS
SZA
STR /ACKNOWLEDGE RING(S)
CLA
ITG /INCREMENT THE GROUP COUNTER
ISZ TEMP0 /LOOKED AT ALL LINES?
JMP DFRNG1 /NO, KEEP LOOKING
STA
IOF
DCA I .+2 /DATA FLD=0 HERE, I HOPE. RESET COUNTER
EXITF1
D6FLAG
DFCLSI, 0
DFCNWI, 0
DFCLST, DFCLS0
DFCNOW, DFCNO0
DFCNTR, 0
DFCSET, 0
TAD DFCLST
DCA DFCLSI /POINTER TO STATUS AT LAST INTERRUPT
TAD DFCNOW
DCA DFCNWI /POINTER TO STATUS AT THIS INTERRUPT
TAD K7774
DCA DFCNTR /COUNTER FOR COMPARISONNS
CTG /CLEAR GROUP COUNTER
JMP I DFCSET
DFCARR, JMS DFCSET /INITIALIZE STATUS
DFCAR1, RCS /READ CARRIER STATUS
DCA I DFCNWI /PLACE ON TABLE
ISZ DFCNWI
ITG /INCREMENT THE GROUP COUNTER
ISZ DFCNTR /READ ALL FOUR GROUPS?
JMP DFCAR1 /NO, READ NEXT
JMS DFCSET
TAD DFL2ST
DCA DFL2SI
DFCAR2, TAD I DFCNWI
CMA
AND I DFCLSI
SZA /ANY LINES CLEARED?
JMP DFCAR3 /YES, ACKNOWLEDGE
DFCAR5, TAD I DFCLSI
CMA
AND I DFCNWI
SZA
JMS DFCAR6
ISZ DFCLSI
ISZ DFCNWI
ISZ DFL2SI
ITG /INCREMENT THE GROUP COUNTER
ISZ DFCNTR /ALL LINES CHECKED?
JMP DFCAR2 /NO
JMS DFCSET
DFCAR4, TAD I DFCNWI /TRANSFER THIS STATUS TABLE TO LAST
DCA I DFCLSI
ISZ DFCNWI
ISZ DFCLSI
ISZ DFCNTR
JMP DFCAR4
JMP DFL200
DFCAR3, CTR /CLEAR TERMINAL READY
JMS DFCAR6
JMP DFCAR5 /LOOK AT OTHER GROUPS
DFCAR6, 0
DCA TEMP4 /BIT TO SET
TAD TEMP4
CMA
AND I DFL2SI
TAD TEMP4
DCA I DFL2SI
JMP I DFCAR6
DFL200, TAD DFL2ST /INITIALIZE PSEUDO GROUP CTR
DCA DFL2SG
DFL22, TAD K7770 /EIGHT PHONES
DCA TEMP0
IAC
DCA TEMP1 /SELECT EACH LINE IN GROUP
DFL21, TAD I DFL2SG
SNA
JMP DFL23
SPA
EXITF1
AND TEMP1
SZA CLA
JMP DFL25
DFL26, TAD TEMP1
CLL RAL
DCA TEMP1
ISZ TEMP0
JMP DFL21
DFL23, DCA I DFL2SG
ISZ DFL2SG
JMP DFL22
DFGBLK, GETB
DFL25, TAD DFL2SG
TAD DFL2C
DCA TEMP2
TAD I TEMP2
TAD TEMP0
TAD K0010
CLL RAL
TAD DFVTBA
DCA TEMP3
TAD I TEMP3
SZA CLA
JMP .+5 /YES
TAD TEMP3
CIF
JMS I DFGBLK
JMP DFL26
TAD TEMP3
CIF CDF
JMS I DFUMES
JMP DFL26
DFL2SG, 0
DFL2C, DFL2DL-DFL2S0
DFVTBA= DEVTBA
DFL2SI, 0
DFL2ST, DFL2S0
DFUMES, UHLTMS
>
*DATA1
/ROUTINE TO DECREMENT TIMERS
/THEY ARE BUMPED ONCE EACH SECOND
/THUS A USER CAN MEASURE UP TO 1 HOUR, 8 MINUTES, 15 SECONDS
TIMER0, 0
ISZ TIMBIG /HAVE WE GONE THROUGH A SECOND YET?
JMP F0TIMT /NO - DID WE FINISH ALL THE TIMERS LAST TIME?
TAD TICSEC /REFRESH SECOND TIMER
DCA TIMBIG
TAD JOBCNT
DCA TIMET1
TAD TIMTB1 /START OF CLKTBL
DCA TIMET2
TIMER1, DATFLD
TAD I TIMET2
SZA CLA
ISZ I TIMET2
JMP TIMER2
TAD TIMEJM /SET TIMER FLAG
TAD TIMET1
JMS GETTBA /GET PTR TO STATUS 1
JOBSTS+1
TAD TEMP0 /DOES THE JOB STILL EXIST?
SNA CLA
JMP TIMER2 /NO
TAD I TEMP0 /YES, SET JSTIME IN STR1
RAL
STL RAR
DCA I TEMP0
TIMER2, ISZ TIMET2
ISZ TIMET1
JMP TIMER1
ISZ UPTIM1 /INDEX LOW ORDER UPTIME
SKP
ISZ UPTIM2 /INDEX HI ORDER UPTIME
TIMEJM, JOBMAX+1 /NOP
IFZERO TC01 < JMP .+3 >
IFNZRO TC01 < STA >
DCA TEMP2 /ENABLE TRANSFER BACK TO DECTAPE CONTROLLER WAIT
JMS I TIMEDT /RUN DECTAPE TIMERS
IFZERO RK05 < JMP F0TIMR >
IFNZRO RK05 < CIF DATFLD > /NO INTERRUPTS
TAD RKTIME
SZA CLA /ACTIVE?
ISZ RKTIME /YES, BUMP TIMER
JMP F0TIMR /ALL IS WELL
IAC
DCLR /STOP WHATEVER IS GOING ON WITH THE RK05
STA
DCA I RKERRA /SHOW THAT TRANSFER WAS TERMINATED
TAD RKJOB
JMS I RKHUNG /REPORT THE ERROR
RKL20
F0TIMR, TAD TIMER0 / VRS: Reconstructed from working binary
DCA TIMIT
CDF
IOF
TAD I TIMIT
SZA CLA
ISZ I TIMIT
JMP F0TIMT
ION
ISZ TIMIT
TAD I TIMIT
CIF CDF
JMS I QUEUE1
ISZ TIMIT
JMP TIMOUT
F0TIMT, ION
ISZ TIMIT
ISZ TIMIT
TAD TIMIT
CIA
TAD TIME3A
SMA SZA CLA
JMP F0TIMR+2 / VRS: End reconstruction
/ROUTINE TO DUMP VALUE OF ONE CORE CELL INTO MQ
/RUNS AT EACH SYSTEM TICK
/TO USE, SET THE DESIRED CORE ADDRESS IN THE SWITCH REGISTER
/TO SELECT FIELDS, CLEAR SR TO 0, AND SET THE DESIRED
/FIELD IN THE LOW ORDER BITS OF THE SR.
/THIS MEANS THAT YOU CANNOT ADDRESS LOCATIONS 0,1,2, OR 3
/IF THIS ROUTINE IS RUNNING, THE EAE IS NOT MUCH USE
/TO USER PROGRAMS. SORRY ABOUT THAT.
TIMOUT, JMP TIMEX /LAS /INSERT THE "LAS" (7604) TO ENABLE DISPLAY
AND K7774 /TRYING A FIELD SELECT?
SNA
JMP DISPL1 /YES, GO CHANGE THE FIELD
LAS /NO; WHAT WAS THAT ADDRESS AGAIN?
DCA TEMP0
DISFLD, CDF /ASSUME FIELD 0 TO START
TAD I TEMP0 /PICK UP CONTENTS OF SPECIFIED ADDRESS
MQL /DUMP IT IN THE MQ
TIMEX, CIF CDF /BACK TO FIELD 0
JMP I TIME3A /RETURN
TIMIT, TIMER3
TIME3A, TIMER3
TIMBIG, -TICSPS /ACTIVE COUNTER
TICSEC, -TICSPS /STARTING VALUE OF TIMBIG
TIMET1= TEMP4
TIMET2= TEMP2
TIMTB1, CLKTBL+1
TIMEDT, DTIMER
RKHUNG, DTRKER
DISPL1, LAS /WHAT WAS THAT FIELD AGAIN?
CLL RAL
RTL
TAD K6201 /BUILD FIELD SELECT
DCA DISFLD
JMP DISFLD-1 /NOW GO LOOK
DEVDMB= JOBTBL-2
*DEVTBL-1
DEVDMB /DUMMY USED BY FIP RELEASE
ZBLOCK DEVTBE-DEVTBL
0 /WE ALLOW THE READER EVEN IF NOT CONFIGURED FOR ONE
/THIS ALLOWS FIELD SERVICE TO USE THEIR PMK01
IFZERO PUNCH <DEVDMB>
IFNZRO PUNCH <0>
DEVDMB
IFZERO LPT <DEVDMB>
IFNZRO LPT <0>
IFZERO CDR <DEVDMB>
IFNZRO CDR <0>
IFZERO TC01 <DEVDMB
DEVDMB
DEVDMB
DEVDMB
DEVDMB
DEVDMB
DEVDMB
DEVDMB>
IFNZRO TC01 <ZBLOCK 10>
IFNZRO RK05 <ZBLOCK RK05>
IFNZRO .-JOBTBL+1 <DEVDMB>
IFNZRO .-JOBTBL+1 <DEVDMB>
IFNZRO .-JOBTBL+1 <DEVDMB>
IFNZRO .-JOBTBL+1 <DEVDMB>
-1 /TERMINATES ASSIGNABLE DEVICE TABLE
/JOBTBL, CLKTBL, TTYTBL, PRGTBL, & DSUTBL ARE SET UP BY INIT
*FIPBLK
ZBLOCK 10 /FIP'S FIXED PARAMETER BLOCK
*WINBAS
ZBLOCK 50 /BASIC'S WINDOW
$$$$$$$$$$$$$$$$$$$$$$$$$$$$