1
0
mirror of synced 2026-03-09 04:10:04 +00:00
Files
lisper.cpus-pdp8/tss8/system/ts8b.pal
brad 0e9bfd9d85
2010-04-02 12:36:00 +00:00

1263 lines
31 KiB
Plaintext
Raw Permalink 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.
/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 [S]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 - [S]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 [S]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 [S]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 - [S]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