1279 lines
28 KiB
Plaintext
1279 lines
28 KiB
Plaintext
/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 [S]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 [S]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 [S]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 /[S]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 FILL0 /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 [S]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 - [S]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
|
||
|