github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-03-04 02:35:00 +00:00
Code Issues Releases Wiki Activity
Files
16210cb40b9f46eabe58834bee3f4e9861283963
PDP-10.its/src/sits/sits.119
Lars Brinkhoff 46ac182bdc SITS - Small ITS. 
Timesharing system for the Logo PDP-11/45.
2022-10-23 08:30:59 -05:00

12144 lines
369 KiB
Plaintext
Executable File
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.
.ABS
VERN==%FNAM2
%COMPAT==0 ;SUPRESS INCOMPATABLE OP-CODE MESSAGES
NPC==0
NTKDIS==0
TVS==0
NTVS==0
NTVCHN==0
MBFLG==0
.INSRT SITS;SITMAC >
.IIF NDF GUY,GUY==0
.IF Z GUY
NTKDIS==4
TVS==1
MBFLG==1
.ENDC
.IFNZ TVS
NTVS==32.
NTVCHN==4
.ENDC
.SBTTL INTERNAL REGISTER DEFINITIONS
;MEMORY SEGMENTATION UNIT
SSR0=177572
SSR1=177574
SSR2=177576
SSR3=172516
USRISD=177600
USRDSD=177620
USRISA=177640
USRDSA=177660
SUPISD=172200
SUPDSD=172220
SUPISA=172240
SUPDSA=172260
KERISD=172300
KERDSD=172320
KERISA=172340
KERDSA=172360
;SEGMENTATION REGISTER DEFINITION
SEGNRA==100000 ;SEGMENTATION NON RESIDENT ABORT
SEGSLE==40000 ;SEGMENT LENGTH ERROR
SEGRVI==20000 ;READ ONLY VIOLATION
SEGTRP==10000 ;SEGMENTATION TRAP
SEGPMO==177637 ;PAGE MODE THAT CAUSED TRAP
SEGKER==0 ;KERNEL MODE
SEGUSR==140 ;USER MODE
SEGPNO==177741 ;THE PAGE NO. MASK
;CONSOLE SWITCHES AND DISPLAY
CDISP=177570
CSWR=177570
;PROGRAM INTERUPT REQUEST REGISTER
PIRQ=177772
;STACK LIMIT REGISTER
STKLIM=177774
;PROCESSOR STATUS
PS=177776
;START OF PARITY REGISTERS
PARCSR=172100
RUGST==157000 ;RUG STARTING LOCATION
;KERNAL MAP REGISTERS
I0AR=KERISA
I1AR=I0AR+2
I2AR=I1AR+2
I3AR=I2AR+2
I4AR=I3AR+2
I5AR=I4AR+2
I6AR=I5AR+2
I7AR=I6AR+2
RUGIAR=I6AR
I0DR=KERISD
I1DR=I0DR+2
I2DR=I1DR+2
I3DR=I2DR+2
I4DR=I3DR+2
I5DR=I4DR+2
I6DR=I5DR+2
I7DR=I6DR+2
RUGIDR=I6DR
VAR0AR=KERDSA
VAR1AR=VAR0AR+2
VAR2AR=VAR1AR+2
ITM0AR=VAR2AR+2
ITM1AR=ITM0AR+2
ITM2AR=ITM1AR+2
RUGDAR=ITM2AR+2
IOAR=RUGDAR+2
VAR0DR=KERDSD
VAR1DR=VAR0DR+2
VAR2DR=VAR1DR+2
ITM0DR=VAR2DR+2
ITM1DR=ITM0DR+2
ITM2DR=ITM1DR+2
RUGDDR=ITM2DR+2
IODR=RUGDDR+2
;INTERNAL TRAP VECTORS
BEBRV=4
ILLBRV=10
BPTBRV=14
IOTBRV=20
PWFBRV=24
EMTBRV=30
TRPBRV=34
PARBRV=114
PIRBRV=240
FPPBRV=244
SEGBRV=250
.SBTTL DEVICE DEFINITIONS
;RF11 FIXED HEAD DISK
RFCS=177460 ;CONTROL AND STATUS
RFWC=177462 ;WORD COUNT
RFBA=177464 ;BUSS ADDRESS
RFDA=177466 ;DISK ADDRESS (LOW PART)
RFDAE=177470 ;HIGH PART OF ADDRESS AND ERROR REGISTER
RFBRV=204
;RK11 MOVING HEAD DISK
RKDS=177400 ;DRIVE STATUS REGISTER
RKER=177402 ;ERROR REGISTER
RKCS=177404 ;CONTROL AND STATUS REGISTER
RKWC=177406 ;WORD COUNT
RKBA=177410 ;BUSS ADDRESS
RKDA=177412 ;DISK ADDRESS
RKBRV=220
;CONSOLE TELETYPE
;BREAK LEVEL 4
TKBRV=60 ;CONSOLE KEYBOARD BREAK VECTOR
TKS=177560 ;CONSOLE KEYBOARD STATUS
TKB=177562 ;CONSOLE KEYBOARD DATA
TPBRV=64 ;CONSOLE PRINTER BREAK VECTOR
TPS=177564 ;CONSOLE PRINTER STATUS
TPB=177566 ;CONSOLE PRINTER DATA
;PROGRAMMABLE CLOCK KW11-P
PCCS=172540 ;CONTROL AND STATUS
PCCB=172542 ;COUNT SET BUFFER
PCCN=172544 ;COUNTER
PCBRV=104 ;INTERUPT VECTOR
;LINE FEQUENCY CLOCK KW11-L
LCCS=177546 ;CONTROL AND STATUS
LCBRV=100 ;INTERUPT VECTOR
;TK DISPLAY
NGCSR=164040 ;CONTROL AND STATUS
NGREL=164042 ;RELOCATION
;PAPER TAPE PUNCH AND READER
PTRSR=177550 ;PAPER TAPE READER STATUS
PTRBR=177552 ;PAPER TAPE READER BUFFER
PTPSR=177554 ;PAPER TAPE PUNCH STATUS
PTPBR=177556 ;PAPER TAPE PUNCH BUFFER
PTRBRV=70 ;VECTOR FOR READER
PTPBRV=74 ;VECTOR FOR PUNCH
PLTBCR=177500 ;PLOTTER BYTE COUNT REGISTER
LPTMEX=177502 ;DMA MEMORY EXTENSION BITS REGISTER
PRTBCR=177504 ;PRINTER BYTE COUNT REGISTER
LPTBA=177506 ;BUSS ADDRESS FOR THE DMA CONTROLLER
PLTCSR=177510 ;PLOTTER CONTROL STATUS REGISTER
PLTDBR=177512 ;PLOTTER DATA BUFFER REGISTER
PRTCSR=177514 ;PRINTER CONTROL STATUS REGISTER
PRTDBR=177516 ;PRINTER DATA BUFFER REGISTER
PRTBRV=200 ;PRINTER VECTOR
PLTBRV=174 ;PLOTTER VECTOR
;MB11 MAR AND HISTORY REGISTER
MBCSR=170000+0 ;CONTROL AND STATUS
MBXHGH=MBCSR+2 ;HIGH BITS OF X REGISTER
MBXLOW=MBCSR+4 ;LOW BITS OF X REGISTER
MBYHGH=MBCSR+6 ;HIGH BITS OF Y REGISTER
MBYLOW=MBCSR+10 ;LOW BITS OF Y REGISTER
MBHHGH=MBCSR+12 ;HIGH BITS OF HISTORY REGISTER
MBHLOW=MBCSR+14 ;LOW BITS OF HISTORY REGISTER
MBHCNT=MBCSR+16 ;HISTORY MEMORY COUNTER
;BITS IN MBCSR
MBINTE==100
MBAFRZ==200
MBXAYR==400 ;X<A<Y READ TRAP
MBXAYW==1000 ;X<A<Y WRITE TRAP
MBNOIN==2000 ;IGNORE INIT
MBINAO==4000 ;INTERRUPT ON ALMOST OVERFLOW
;BITS IN MBXHGH AND MBYHGH
MBREDT==4 ;READ TRAP BIT
MBWRTT==10 ;WRITE TRAP BIT
;BITS IN MBHHGH
MBWRTB==4 ;WRITE BIT IN HISTORY MEMORY HIGH BITS
;BREAK VECTOR
MBBRV=374
.SBTTL MACROS FOR DEFINING VARIOUS THINGS
;MACRO TO INITIALIZE DEFINITION OF SOME RANDOM THING
.MACRO DTHING
FOO==0
.ENDM
;MACRO TO DEFINE A WORD FOR SOME RANDOM THING
.MACRO DWORD A,B
.IIF P1,.IIF DF A,.ERROR A ALREADY DEFINED
A==FOO
.IF NB B
.IIF P1,.IIF DF B,.ERROR B ALREADY DEFINED
B==FOO+1
.ENDC
FOO==FOO+2
.ENDM
;MACRO TO INIT THE DEFINITION OF RANDOM FLAGS
.MACRO DFLAGS
BAR==1
.ENDM
;MACRO TO DEFINE A RANDOM FLAG BIT
.MACRO DFLAG FLAG
.IIF P1,.IIF DF FLAG,.ERROR FLAG ALREADY DEFINED
.IIF Z BAR,.ERROR FLAG TOO MANY FLAGS
FLAG==BAR
BAR==BAR_1
.ENDM
;MACRO TO ADD SOMETHING TO A REMOTE MACRO
.MACRO ADDMAC MAC,STUFF
MAC <
.MACRO MAC A,B,C
A>,<STUFF>,<B
C
.ENDM>
.ENDM
;MACRO FOR THE INITLS TABLE
.MACRO INITSL A,B,C
A
INITLS:
B
C
.ENDM
;MACRO FOR STORAGE ALLOCATION OF LIST SPACE
.MACRO LSTSTO A,B,C
A
LISTST:
B
C
.ENDM
.MACRO ALSTM FREENM,TABNAM,LENGTH,NUM
ADDMAC LSTSTO,<FREENM: 0
.IIF NB TABNAM,TABNAM:
.BLKB LENGTH*NUM
AILSTM FREENM,NUM,LENGTH>
.ENDM
.MACRO AILSTM FREENM,NUM,LENGTH
ADDMAC INITSL,<ILIST FREENM+2,FREENM,NUM,LENGTH>
.ENDM
;MACRO TO DEFINE A LIST STORAGE AREA
.MACRO ILISTS FREENM,TABNAM,NUM
ALSTM FREENM,TABNAM,\FOO,NUM
.ENDM
.MACRO ILIST AD,FREE,NUM,LEN
WORDS <AD+LEN,FREE,NUM-2,LEN>
.ENDM
.SBTTL DEFINITIONS FOR VARIOUS TYPES OF ITEMS
;MACROS TO DEFINE ITEMS WITH
;THE START DEFINING ITEM MACRO
.MACRO SITEMD SYM
FOO==2
ITMTFO==ITMTFO+1
SYM==ITMTFO
.ENDM
;THE DEFINE SYMBOL MACRO
;IF SECOND ARG IS PRESENT, IT IS HOW MUCH SPACE TO RESERVE, IN BYTES
.MACRO DITMS SYM,SIZE
.IIF P1,.IIF DF SYM,.ERROR SYM ALREADY DEFININED
SYM==FOO
.IIF B SIZE,FOO==FOO+2
.IIF NB SIZE,FOO==FOO+<SIZE>
.ENDM
;THE DEFINE FLAG WORD MACRO
;SPACE IS RESERVED FOR THE FLAG WORD, AND FLAGS ARE DEFIND
;SEQUENTIALLY FROM THE RIGHT TO THE LEFT
.MACRO DFWORD SYM,BITS
FOOBAR==0
SYM==FOO
FOO==FOO+2
.IRP X,<BITS>
X==1_FOOBAR
FOOBAR==FOOBAR+1
.ENDM
.ENDM
;THE DEFINE ITEM SIZE MACRO
;DEFINES A SYMBOL AS THE SIZE OF THE ITEM DEFINED SO FAR
.MACRO DITMSZ SYM
SYM==FOO_-6
.ENDM
.SBTTL MACROS FOR GENERATING CODE
.MACRO LBRLEM ADDR,COND,A,Q
.IF IDN COND,A
B'Q .+6
JMP ADDR
.ENDC
.IF IDN COND,Q
B'A .+6
JMP ADDR
.ENDC
.ENDM
.MACRO LBR COND,ADDR
.IF1
.IFDF ADDR
.IFGE ADDR-.+376
.=.+2
.IFF
.=.+6
.IIF B COND,.=.-2
.ENDC
.IFF
.=.+6
.IIF B COND,.=.-2
.ENDC
.IFF
LBRCSW==0
.IFLE ADDR-.
.IFGE ADDR-.+376
LBRCSW==1
.IF NB COND
B'COND ADDR
.IFF
BR ADDR
.ENDC
.ENDC
.ENDC
.IFZ LBRCSW
.IIF B COND,JMP ADDR
LBRLEM ADDR,COND,EQ,NE
LBRLEM ADDR,COND,LT,GE
LBRLEM ADDR,COND,LE,GT
LBRLEM ADDR,COND,HIS,LO
LBRLEM ADDR,COND,LOS,HI
LBRLEM ADDR,COND,CS,CC
LBRLEM ADDR,COND,VS,VC
.ENDC
.ENDC
.ENDM
;MACRO TO DO A BUG CHECK IN THE "NATURAL DIRECTION"
;THAT IS, IF THE CONDITION IS TRUE, BPT
.MACRO NBUGC COND
RBRPP4 COND
BPT
.ENDM
;MACRO TO BRANCH TO .+4 (PP4) ON THE OPPISITE OF THE SUPPLIED CONDITON
.MACRO RBRPP4 COND
BRO .+4,COND,MI,PL
BRO .+4,COND,EQ,NE
BRO .+4,COND,LT,GE
BRO .+4,COND,LE,GT
BRO .+4,COND,HIS,LO
BRO .+4,COND,LOS,HI
BRO .+4,COND,CS,CC
BRO .+4,COND,VS,VC
.ENDM
;MACRO TO GENERATE BRANCH OF OPPISTIE CONDITION
.MACRO BRO ADDR,COND,A,Q
.IIF IDN COND,A, B'Q ADDR
.IIF IDN COND,Q, B'A ADDR
.ENDM
.MACRO BUGC COND
NBUGC COND
.ENDM
.MACRO CHECKP
; JSR PC,CHEKIN
.ENDM
.MACRO TRAPV DEV,PRI
.=DEV'BRV
.IIF P2,.IIF NDF DEV'BRK,DEV'BRK==0
DEV'BRK
.IIF NB PRI, PRI_5
.IIF B PRI, 200
.ENDM
;MACRO TO GENERATE A CONDITIONAL ERROR TRAP
.MACRO ERRORC COND,ERR,F1,F2
RBRPP4 COND
ERROR ERR,F1,F2
.ENDM
;MACRO TO GENERATE AN ERROR TRAP
.MACRO ERROR ERR,F1,F2
ERRCOD==.E'ERR!TRPZBT
EFLAG F1
EFLAG F2
TRAP ERRCOD
.ENDM
;MACRO TO HELP OUT ERROR
.MACRO EFLAG FLAG
.IIF IDN FLAG,SZ,ERRCOD==ERRCOD!TRPZBT
.IIF IDN FLAG,CZ,ERRCOD==ERRCOD&<-TRPZBT-1>
.IIF IDN FLAG,SV,ERRCOD==ERRCOD!TRPVBT
.IIF IDN FLAG,CV,ERRCOD==ERRCOD&<-TRPVBT-1>
.ENDM
TRPZBT==200
TRPVBT==100
;MACRO TO ASSIGN AN ERROR SYMBOL
.MACRO ERDEF CODE
.E'CODE==FOO
FOO==FOO+1
.ENDM
.MACRO EMTD NAME
.IF NB NAME
.'NAME==FOO+EMT
$'NAME==FOO+200+EMT
E'NAME
.IFF
BADEMT
.ENDC
FOO==FOO+1
.ENDM
.SBTTL SYSTEM PARAMETERS
;GENERALIZED ITEM POINTER DEFINITION
GIPBIT==100000 ;SET IF IT IS A GENERALIZED ITEM POINTER
GIPSPR==40000 ;BIT SET IF UPT IS IN A SPHERE
GIPITM==176000 ;MASK FOR ITEM INDEX
GIPUPT==141777 ;MASK FOR UPT NUMBER (IN SPHERE)
GIPFUP==140000 ;MASK FOR FLOATING UPT TABLE OFFSET
;FOR THE ITEM LIST
NITEMS==150. ;MAXIMUM NUMBER OF ITEMS
NITMBL==8. ;MAXIMUM NUMBER OF BLOCKS ALLOCATED TO ITEM STROAGE
NITMPS==20. ;MAXIMUM DEPTH OF ITEM PUSHES
NITALS==NITMBL*8. ;NUMBER OF FREE STROAGE NODES
;DEFINITION OF AN ITEM TABLE ENTRY
DTHING
DWORD ITLINK ;LINK WORD FOR FREE ENTRIES
ITMADR==ITLINK ;WHERE THE ADDRES OF THE ITEM IS KEPT
DWORD ITACCS,ITLNGT ;ACCESS CODE, LENGTH
ILISTS ITMFRE,ITMTAB,NITEMS
ITMTEL==FOO
.IIF NZ 4-ITMTEL,.ERROR ITEM NODES AND ITEM ALLOCATE NODES NOT SAME SIZE!
ITACCD==6 ;ITEM ACCESS CODE (READ-WRITE NO TRAP)
FOO==4
ILISTS ITMAFR,,NITALS ;FREE STORAGE NODES
;ADDRESSES OF THE ITEM SLOTS
ITM0AD==<ITM0AR-KERDSA>_12.
ITM1AD==<ITM1AR-KERDSA>_12.
ITM2AD==<ITM2AR-KERDSA>_12.
;PROCESS AND USER PARAMETERS
NPROSS==80. ;MAXIMUM NUMBER OF PROCESSES AND USERS
PRPDLL==200 ;LENGTH OF THE PDL FOR THE PROCESS (BYTES)
PIT2PL==14 ;LENGTH OF ITEM 2 PDL IN PROCESS
;DEFINITION OF A PROCESS TABLE ENTRY
PRSTEL==16 ;LENGTH OF A PROCESS TABLE ENTRY
PRTFRD==0 ;FORWARD POINTER
PRTBCK==2 ;BACK POINTER
PRTPPT==4 ;PROCESS POINTER (OR TO ITEM IF USER)
PRTUPT==6 ;USER POINTER (-1 FOR USER)
PRTJTM==10 ;JTMU
PRTPRI==12 ;HIS PRIORITY
PRTTIM==14 ;TIME IN HALF-SECS THIS PROCESS PUT ON THIS QUEUE
;SPHERE PARAMTERS
MNCLSE==200 ;MAXIMUM NUMBER OF C-LIST ENTRIES
NCLSEB==10 ;NUMBER OF C-LIST ENTRIES PER BLOCK
CLSELN==12 ;LENGTH OF A C-LIST ENTRY (NOTE THAT THE LENGTH OF A BLOCK=NCLSEB*CLSELN, WHATEVER IT IS)
;DEFINITION OF A C-LIST ENTRY
CLSETY==0 ;TYPE
CLSEPI==2 ;PRIMARY ITEM FOR ENTRY
CLSESI==4 ;SECONDARY ITEM FOR ENTRY
CLSEM0==6 ;FIRST RANDOM WORD FOR ENTRY
CLSEM1==10 ;SECOND RANDOM WORD
;THESE ARE FOR THE .RDMAP CALL
.PLENM==177770 ;MASK FOR THE LENGTH OF THE PAGE
.PACCM==174377 ;MASK FOR THE ACCESS
.PDEI==100000 ;BIT FOR DATA = I PAGE
.PABS==40000 ;BIT FOR ABSOLUTE PAGE
.PFIL==2000 ;BIT FOR FILE PAGE
;FOR THE TELETYPE ITEM
TITQ==TOQM-1
TIQSZ==350.
TIBSZ==50.
TOQSZ==64.
TIBT==TIQM
TIQLM==TOQM
TOQLM==TOQM+TOQSZ
;FOR THE QUE ITEM
QUESZ==64 ;THE SIZE OF THE QUE
;FOR THE PAPER TAPE ITEMS
PTRSZ==120.
PTPSZ==120.
;FOR THE LOCKED SWITCH LISTS
NLCKBL==NPROSS/4 ;A GUESS
DTHING
DWORD LCKLNK ;THE LINK
DWORD LCKDSP ;DISPATCH ADDRESS FOR LOCK
DWORD LCKTIT ;ITEM
DWORD LCKWD1 ;WORD ONE OF LOCK DATA
DWORD LCKWD2 ;WORD TWO
ILISTS LCKFRE,,NLCKBL
;MISC SYSTEM PARAMETERS
LTIMEL==6 ;TIME BETWEEN CHECKING INATIVE GUYS
JTMUUT==6 ;NUMBER OF TICKS BETWEEN JTMU UPDATES
JTMUAC==40 ;ADDITIVE CONSTANT
JTMUDC==4 ;DECAY CONSTANT
CLKL==1 ;LEVEL CLOCK RUNS AT
CLKPIR==1_<CLKL+10> ;BIT FOR PIRQ
TTYL==2 ;LEVEL TTY PROCESSING RUNS AT
TTYPIR==1_<TTYL+10>
DMRL==3 ;LEVEL THE MIDDLE LEVEL DISK ROUTINES RUN AT
DMRPIR==1_<DMRL+10> ;MIDDLE LEVEL DISK PIRQ BIT
IPRIOR==4 ;PRIORITY TO SET A NEWLY CREATED PROCESS TO
IQUANT==4 ;INTIAL QUANTUM
ITMTFO==0 ;THE TYPE OF THE LAST ITEM DEFINED
ITTYPE==0 ;FOR ALL ITEMS, THE FIRST WORD IS THE TYPE
;DEFINITION OF A PROCESS ITEM
SITEMD ITPROC
;THE NEXT THREE SHOULD NOT BE MOVED
;WITHOUT MOVING THE COORESPONDING THREE IN THE USER DEFINITION
DITMS PRSREF ;REFERENCE COUNT
DITMS PPRTPT ;POINTER TO PROCESS TABLE
DITMS PQBIT ;THE QUEUE BIT
DITMS PRSUSR ;THE USER PROCESS TABLE POINTER
DITMS PTUSED,4 ;TIME USED BY THIS PROCESS IN HALF-TICKS
DITMS PRSID1 ;PROCESS ID LOW PART
DITMS PRSID2 ;PROCESS ID HIGH PART
DITMS PFAULT ;IF NON-ZERO, WHAT KIND OF FAULT
DITMS PERRW ;ERROR WORD FOR SYSTEM CALLS (PERRW AND PERRAD MUST BE IN THIS ORDER)
DITMS PERRAD ;SYSTEM ADDRES WHERE ERRRO TRAP HAPPENED FROM
DITMS PSPHRP ;POINTER TO SPHERE
DITMS PSPHCP ;CIRCULAR POINTER TO OTHER PROCESSES IN SPHERE
DITMS PLCKSL ;END OF THE LOCKED SWITCH LIST
DITMS PUPDLO ;OFFSET OF USER'S PDL IF CALL COMPLETES
DITMS PITM2P,PIT2PL ;PROCESS'S ITEM2 PDL
DITMS PITM2C ;COUNT OF ITEMS ON ITEM2 PDL
DITMS PUREGS,14 ;THE USER'S REGISTER'S
DITMS PUP ;THE USER'S PDL POINTER
DITMS PUPC ;THE USER'S PC
DITMS PUPS ;THE USER'S PROCESSOR STATUS
DITMS PSREGS,14 ;THE SYSTEM'S REGISTERS
DITMS PSP ;THE SYSTEM'S PDL POINTER
DITMS PSPC ;THE SYSTEM'S PC
DITMS OPSPC ;OLD SYSTEM PC
DITMS PPDL,PRPDLL ;THE PROCESS'S PDL
DFWORD PFLAGS,<PFALTB,PFAILB,PFPFLG,PACSVF,PPCLSR,PTVFLG,PPBNMP,PPCLDF> ;PROCESS FLAG WORD
DITMS PSTOPC ;STOP COUNT
DFWORD PSTOP,<PSPHSB,PSUPSB> ;STOP WORD
;PSPHSB INDICATES THE SPHERE HAS STOPPED THE PROCESS
;PSUPSB INDICATES SOME OTHER SUPERIOR PROCESS HAS STOPPED IT
DITMS PTVMAP ;-1 => DON'T MAP IN TV, HIGH BYTE IS TVSEL REGISTER
DITMSZ PRSLNF ;SIZE WITH NO FLOATING POINT
DITMS PTVMSK ;SAVED MASK
DITMS PTVINC ;SAVED INCREMENT REGISTER
DITMS PTVSHR ;SAVED SHIFT COUNT
DITMS PTVRAD ;THE ADDRESS REGISTER
DITMS PFPPRG,24.*2 ;FLOATING POINT REGISTERS
DITMS PFPPS ;FLOATING POINT STATUS
;NEXT TWO MUST BE IN THIS ORDER
DITMS PFEC ;FLOATING EXCEPTION CODE
DITMS PFEAP ;FLOATING EXCEPTION ADDRESS POINTER
DITMSZ PRSLFP ;LENGTH WITH FLOATING POINT
;DEFINITION OF A USER ITEM
SITEMD ITUSER
;THE NEXT THREE SHOULD NOT BE MOVED (SEE PROCESS)
DITMS USRREF ;THE REFERENCE COUNT
DITMS UPRTPT ;POINTER INTO PROCESS TABLE
DITMS UQBIT ;THE QUEUE BIT (HAD BETTER BE USER QUEUE)
DITMS UTUSED,4 ;TIME USED BY THIS USER
DITMS USRTTY ;THE TTY NUMBER OF THIS USER
DITMS USRNAM,10. ;USER NAME
DITMSZ USRLEN ;LENGTH OF A USER ITEM
;DEFINITION OF A SPHERE ITEM
SITEMD ITSPHR
;THE NEXT THREE SHOULD NOT BE MOVED (SEE USER)
DITMS SPHREF ;REFERENCE COUNT
DITMS SPRTPT ;THE SPHERE PROCESS TABLE POINTER
DITMS SQBIT ;THE QUEUE BIT (BETTER BE SPHERE QUE)
DITMS SCLSLK ;SPHERE C-LIST LOCK (CONTAINS THE ITEM NO. OF THE PROCESS THAT
;LOCKED IT
DFWORD SFLAG,<ENFLT1,ENFLT2,FAULT1,FAULT2,FAULT3> ;ENABLE FAULTS ONE AND TWO
;AND SAY WHETHER FAULT OR NOT
DITMS STTFG1 ;TELETYPE FLAG WORD 1
DITMS STTFG2 ;TTY FLAG WORD 2
DITMS SMTTY ;ITEM NO. OF MASTER TTY ITEM
DITMS SIFTTY ;ITEM NO. OF INFERIOR TTY SPHERE
DITMS SPHPRP ;POINTER TO FIRST PORCESS
DITMS SPHPRC ;COUNT OF PROCESSES IN SPHERE
DITMS SPHAPR ;COUNT OF ACTIVE PROCESSES
DITMS SUSRPT ;POINTER TO USER ITEM RESPONSIBLE FOR THIS SPHERE
DITMS SMSSPT ;POINTER TO MASTER SPHERE OF THIS SPHERE
DITMS SCLSEP ;POINTER TO FIRST UNUSED LOCATION, RELATIVE TO ITEM
.IFNZ MBFLG ;IF WE HAVE AN MB11 ON
;NEXT 5 MUST BE IN THIS ORDER
DITMS SPMBCN ;CONTROL REGISTER FOR MB11 (0=> NOT USING)
DITMS SPMBHX ;HIGH X BITS
DITMS SPMBLX ;LOW X BITS
DITMS SPMBHY ;HIGH Y BITS
DITMS SPMBLY ;LOW Y BITS
.ENDC
DITMS SUPTS,16.*UPTLEN ;THE UPT ENTRIES
DITMS SCLSTT,MNCLSE/NCLSEB ;THE INDEX OFFSETS TO THE C-LIST
DITMS SICLST,NCLSEB*CLSELN*2 ;START WITH 2 BLOCKS OF C-LIST
DITMSZ SPHLEN
;DEFINITION OF A TELETYPE ITEM
SITEMD ITTTY
DITMS TTYREF ;REFERENCE COUNTER FOR TTY
DITMS TTITM ;ITEM THAT CURRENTLY OWNS THIS TTY
DITMS TTLTTY ;THE LOGICAL TTY NO. ASSOCIATED WITH THIS ITEM
DITMS TTYU ;USER NUMBER OF THE OWNER OF THIS TTY
DFWORD TTYST1,<TIRST,TIQF,TOTRAN,TIMAGI,TIMAGO,TIRBM,TIEDM,TIECM,TICVM,TILIPM,TORST,TERST,TICTM,TICTF,TMORM,TMORF>
;STATUS OF TTY - FIRST WORD
.TIRST==TIRST ;=> RESET THE TTY ON NEXT INPUT BREAK
.TIQF==TIQF ;=> SUPER QUOTE THE NEXT CHARACTER
.TOTRN==TOTRAN ;=> CURRENTLY TRANSMITTING
.TIMGI==TIMAGI ;=> INPUT IMAGE MODE
.TIMGO==TIMAGO ;=> OUTPUT IMAGE MODE
.TIRBM==TIRBM ;=> IN RUBOUT MODE
.TIEDM==TIEDM ;=> IN EDIT MODE
.TIECM==TIECM ;=> IN ECHO MODE
.TICVM==TICVM ;=> CONVERT FROM LOWER TO UPPER CASE MODE
.TLIPM==TILIPM ;=> LOGO INPUT MODE
.TORST==TORST ;=> RESET THE TTY ON NEXT OUTPUT BREAK
.TERST==TERST ;=> RESET THE TTY EDIT BUFFER ON THE NEXT OUTPUT COMMMAND
.TICTM==TICTM ;=> CONTROLIFY MODE
.TICTF==TICTF ;=> CONTROLIFY THE NEXT CHAR FLAG
.TMORM==TMORM ;=> ENABLE MORE PROCESSING
.TMORF==TMORF ;=> MORE BREAK TRIGGERED
DFWORD TTYST2,<TSCRL,TOEDM,TILWT,TTHANG,TTBK>
;TTY STATUS, SECOND WORD
.TSCRL==TSCRL ;=> SCROLL MODE. IF ZERO THEN WRAP MODE IS ASSUMED
.TOEDM==TOEDM ;=> MEANS THAT THE BYTE OUTPUT WILL GO TO THE EDIT BUFFER
.TTHNG==TTHANG ;=> MEANS THAT WE ARE HANGING ON INPUT IN LINE MODE
;TTBK MEANS THAT WE SHOULD TRANSMIT A BREAK FOR TTBRKL CHARACTERS ON
;NEXT OUTPUT INTERRUPT
DITMS TOTSR ;ADDR OF TRANSMIT STATUS REGISTER
DITMS TIBI ;POINTER TO WHERE NEXT CHAR. GOES IN, IN INPUT BUFFER
DITMS TIBO ; " " " " " COMES OUT " " "
DITMS TIBN ;NUMBER OF CHAR. IN INPUT BUFFER
DITMS TIQI ;POINTER TO WHERE NEXT CHAR GOES IN, IN INPUT QUE
DITMS TIQO ; " " " " " COMES OUT " " "
DITMS TIQN ;NUMBER OF CHAR. IN INPUT QUE
DITMS TOQI ;POINTER TO WHERE NEXT CHAR. GOES IN, IN OUTPUT QUE
DITMS TOQO ; " " " " " COMES OUT " " "
DITMS TOQN ;NUMBER OF CHAR. IN OUTPUT QUE
DITMS TIEQO ;POINTER TO WHERE NEXT CHAR COMES OUT, IN OUTPUT QUE
DITMS TIEQN ;NUMBER OF CHARACTERS IN EDIT QUE
DITMS TIBC ;NUMBER OF UNMATCHED LEFT BRACKETS IN INPUT QUE
DITMS TIEBC ; " " " " " " " "
DITMS TIQTO ;POINTER TO WHERE ECHO IS PROCESSING
DITMS TIQTON ;NUMBER OF CHAR THAT ECHO STILL HAS TO PROCESS
DITMS TIEQTN ;NUMBER OF CHAR THAT RDSTR HAS TO PROCESS
DITMS TIEQTO ;POINTER TO WHERE RDSTR IS PROCESSING
DITMS TITQN ;TOTAL NUMBER OF CHAR IN INPUT/EDIT QUE
DITMS TOPAD ;NUMBER OF CHAR LEFT TO SEND PAD
DITMS TOIPC ;SAVED PC FOR ECHO
DITMS TOISVA ;SAVED A FOR ECHO
DITMS TOPC ;SAVED PC FOR OUTPUT
DITMS TOOPC ;SAVED SAVED PC FOR DEBUGGING
DITMS TOSVC ;SAVED C FOR OUTPUT
DITMS TOSVD ;SAVED D FOR OUTPUT
DITMS CHARNO ;NUMBER OF CHAR PRINTED FROM LEFT EDGE OF PAGE
DITMS LINENO ;NUMBER OF LINES FROM TOP OF SCREEN
DITMS TLAST ;THE LAST CHAR TYPED
DITMS LINEL ;THE LENGTH OF A LINE
DITMS TIHPIT ;ITEM OF PROCESS HANGING ON INPUT
DITMS TIHPI1 ;ID WORD 1 OF "
DITMS TIHPI2 ;ID WORD 2
DITMS TTBRKL ;LENGTH OF BREAK CONDITION IN CHARACTERS
.IFNZ NTVS
DITMS TVCRLN ;BYTE ADDRESS OF THE CURSOR IN BUFFER
DITMS TVSCRL ;ADDRESS IN 64 BIT CHUNKS OF SCROLL START
DITMS TVLINE ;THE LINE NUMBER OF THE CURSOR (CHAR LINE NUMBER)
DITMS TVHIGH ;THE NUMBER OF CHAR LINES ON A SCREEN
DITMS TVFONT ;THE FONT NUMBER OF THIS TV
DITMS TVST ;TV STATUS (CONTENTS OF TVCNSL)
DITMS TVCUR ;INTERRUPT LEVEL CURSOR POSITION
DITMS TVBUF ;THE NUMBER OF THE TV BUFFER FOR THIS TV,AND CURSOR MODE
DITMS TVNLSC ;THE NUMBER OF LINES TO SCROLL
DITMS TVHBIT ;THE HORIZONTAL BIT POSITION ON THE CURRENT LINE OF CURSOR
DITMS TVLCNT ;THE NUMBER OF LINES IN A CHAR - 1, USED BY BLINK FOR TVWC
DITMS TVMSK1 ;THE LEFT SIDE OF THE CURSOR MASK
DITMS TVMSK2 ;THE RIGHT SIDE OF THE CURSOR MASK, IN CASE CURSOR CROSSES WORD
DITMS TVSHCT ;SHIFT COUNT FOR THE CURSOR POSITION
DITMS TVCRSN ;BYTE ADDRESS OF THE BEGINNING OF LINE, LIKE TVCRLN
DITMS TVOFFL ;TOP LINE IN WRAP MODE, WHERE THE CURSOR GOES FROM BOTTOM
.ENDC
DITMS TIBB,TIBSZ ;INPUT BUFFER
DITMS TIQM,TIQSZ ;INPUT QUE
DITMS TOQM,TOQSZ ;OUTPUT QUE
DITMSZ TTYLEN
;DEFINITION OF A QUE ITEM
SITEMD ITQUE ;QUE ITEM
DITMS QUEREF ;REFERENCE COUNT OF THE ITEM
DITMS QUEENO ;NO OF ENTRIES IN QUE
DITMS QUECNT ;NO OF PEOPLE ON QUE
DITMS QUENUM ;THE NUMBER OF PEOPLE WHO CAN LOCK QUE
DITMS QUEQUE,QUESZ ;THE QUE
DITMSZ QUELEN
;DEFINITION OF A MASTER FILE ITEM
SITEMD ITMF ;TOP BYTE IS COUNT OF CAP WITH LOCK ON MFI
DITMS MFFREF ;REFERENCE COUNT INCREMENTED BY INFERIOR MFI'S
;AND FA CAPS
DITMS MFPBRF ;REFERENCE COUNT INCREMENTED BY FPBS
DITMS MFELN ;ACTUAL LENGTH OF THE ITEM IN BYTES
DITMS MFENDB ;DISK ADDRESS OF LAST BLOCK IN THE FILE, SET BY MUTATE AND RESET WHEN BLOCK ADDED
DITMS MFENDT ;DISPATCH ADDRESS FOR TYPE OF LAST REAL BYTE
DITMS MFENDP ;POINTER TO LAST REAL BYTE
DITMS MFIDLN ;NUMBER OF BLOCKS CURRENTLY ALLOCATED TO DIRECTORY
DITMS MFIUCF ;BYTES IN DIRECORY NOT COMMITED TO EXITANT MFI'S
DITMS MFICBY ;BYTES COMMITTED FOR US IN THE DIRECTORY ABOVE
DITMS MFDISK ;DISK THE FILE/DIRECTORY IS ON
DITMS MFDLNK ;LINK TO OTHER OPEN FILES ON THIS DISK
DITMS MFIUPT ;SLOT FOR SYSTEM TO STORE FUPT
DITMS MFIPB ;FIRST IN LIST OF LINKED FPBS
DITMS MFIFNO ;FILE NUMBER IN DIRECTORY
DITMS MFBAKP ;ITEM NUMBER OF PARENT MFI IF A FILE
DITMS MFLAGW ;BOTTOM BYTE IS LOGICAL DSK #
.FALNK==100000 ;USER REQUEST FOR A LINK
;BIT SET IF DIRECTORY
.FADIR==40000 ;USER REQUEST FOR DIRECTORY
;ROOT DIR. BIT
.FARUT==10000 ;USER REQUEST FOR ROOT DIRECTORY
;LOCKED BY USER BIT
.FALOK==4000 ;USER REQUEST TO LOCK MFI
MFEBMB==2000 ;ENTRY BEEN MUNGED
MFIBEB==1000 ;MFI BEING ENLARGED BIT
MFOPNB==400 ;FILE BEING OPENED BIT
MFDWDB==200 ;DELETE WHEN DONE BIT
MFTMPF==100 ;TEMPORARY FILE
MFNODR==40 ;NO ENTRY IN DIR FOR THIS YET
MFELEN==FOO ;EXACT LEGNTH IN BYTES OF OVERHEAD
DITMS MFENHD ;ENTRY HEADER
DITMS MFVERN
DITMS MFPGNO ;EOF PAGE NUMBER
DITMS MFBYTP ;EOF BYTE POINTER
DITMS MFDATE ;FILE DATE
DITMS MFTIME ;AND TIME
DITMS MFNAME ;START OF NAME IF NO ACCESS CODES
DITMS MFDUM,12 ;SPACE TO INTIALLY ALLOCATE FOR ENTRY
MFPARE==0 ;BITS IN ENTRY HEADER FLAG WORD
MFDIRE==1000
MFFILE==2000
;TYPE 3000 IS UNUSED
MFSLFE==4000
MFLNKE==5000
;TYPES 14 AND 16 ARE UNUSED
MFEOFB==100000 ;SET IF EOF DATE AND TIME WORDS EXIST
MFACCB==40000 ;SET IF ACCESS CODE EXIST
;BIT 20000 IS UNUSED
MFSHRB==10000 ;SET IF BLOCKS SHARED WITH OTHER FILE
;BITS 7000 ARE USED BY ENTRY TYPES
MFLSTB==400 ;SET IF EOF WORD POINTS TO EXISTING BLOCK
DITMSZ MFLEN
;DEFINITION OF CORE LINK ITEM, (WHEN A PAGE, IT LOOKS THE SAME)
SITEMD ITCL
DITMS CLREF ;THE REFERENCE COUNT
DITMS CLCONP ;POINTER TO THE CONSUMER
DITMS CLCNT ;THE AMOUNT OF VALID DATA IN ITEM
DITMS CLNUM ;THE NUMBER OF SLOTS IN THE BUFFER
DITMS CLDATI ;POINTER TO DATA IN
DITMS CLDATO ;POINTER TO DATA OUT
CLDATL==FOO ;THE LENGTH OF THE DATA WORDS
;DEFINITION OF A FONT ITEM
SITEMD ITFNT
DITMS FNTREF ;NOT REALLY USED FOR ANYTHING
DITMS FNWIDE ;WIDTH OF THIS FONT
DITMS FNHIGH ;HEIGHT OF THIS FONT
DITMS FNTEND ;POINTER TO THE END OF THE FONT
DITMS FNTLCL ;THE NUMBER OF TV LINES IN ONE CHAR LINE
DITMS FNMSK ;A RIGHT ADJUSTED MASK FOR CHARS IN THIS FONT
;THE SYSTEM COMPUTES THE NEXT 2 VARIABLES WHEN THE ITEM IS CREATED
DITMS FNLINE ;THE NUMBER OF CHAR LINES THAT FIT ON A SCREEN
DITMS FLFINC ;NUMBER OF BYTES IN ONE CHAR LINE
DITMS FNREM ;THE NUMBER OF BYTES AFTER LAST SCREEN LINE. MAY BE NEGATIVE.
DITMS FNLINL ;THE NUMBER OF CHARS PER LINE
DITMS FNLSC ;THE NUMBER OF LINES TO SCROLL
;VARIOUS PRECOMPUTED VARIABLES GO HERE
FOO==40 ;THE DISPATCH TABLE ALWAYS STARTS AT 40
DITMS FNTPNT,400 ;AND IS 128. WORDS LONG
;DEFINITION OF THE PAPER TAPE READER ITEM
SITEMD ITPTR
;DON'T CHANGE THE ORDER BELOW!
DITMS PTRREF ;REFERENCE COUNT
DITMS PTRDAI ;POINTER TO WHERE DATA GOES IN
DITMS PTRDAO ;POINTER TO WHERE DATA COMES OUT
DITMS PTRNO ;NUMBER OF BYTES IN BUFFER
DITMS PTRBUF,PTRSZ ;BUFFER FOR PAPER TAPE READER
PTREND==FOO ;TOP OF BUFFER
DITMSZ PTRLEN
;DEFINITION OF THE PAPER TAPE PUNCH ITEM
SITEMD ITPTP
;DON'T CHANGE THE ORDER BELOW!
DITMS PTPREF ;REFERENCE COUNT
DITMS PTPDAI ;POINTER TO WHERE DATA GOES IN
DITMS PTPDAO ;POINTER TO WHERE DATA COMES OUT
DITMS PTPNO ;NUMBER OF BYTES
DITMS PTPBUF,PTPSZ ;BUFFER FOR DATA
PTPEND==FOO ;TOP OF THE BUFFER
DITMSZ PTPLEN
LPTBSZ==512.
PLTBSZ==4096.
LINSIZ==264. ;THE NUMBER OF BYTES IN A PLODDING LINE
;DEFINITION OF A LINE PRINTER ITEM.
SITEMD ITLPT
;DON'T CHANGE THE ORDER BLEOW WITHOUT CHECKING THE CCPRLP ROUTINE
DITMS LPTREF ;REFERENCE COUNT
DITMS LPTEND ;POINTER TO THE END OF THE BUFFER
DITMS LPTLCT ;NUMBER OF TIMES TO OUTPUT THIS LINE
DITMS LPTMOD ;ZERO IF IN PRINT MODE, OTHERWISE THE SCALE FACTOR FOR PLODDING
DITMS LPTCSR ;CONTAINS THE CONTROL STATUS REGISTER OF THE CURRENT MODE
DITMS LPTDAI ;POINTER TO WHERE DATA GOES IN
DITMS LPTDAO ;POINTER TO WHERE DATA COMES OUT FROM
DITMS LPTNUM ;NUMBER OF CHARACTERS IN THE BUFFER
DITMS LPTWCT ;THE NUMBER OF BYTES TRANSFERED IN THIS TRANSFER
DITMS LPTPCT ;COUNT OF PLOT BYTES TO GO INTO THIS LINE
DITMS LPTPIT ;PROCESS TO ACTIVE
DITMS LPTPI1 ;ID WORD 1 OF PROCESS
DITMS LPTPI2 ;ID WORD 2 OF PROCESS
DITMS LPTBUF,LPTBSZ ;THE BUFFER
PRTEND==FOO ;THE END OF THE PRINTER BUFFER
DITMSZ PRTLEN ;LENGTH FO PRINTER ITEM
DITMS LPTBEX,PLTBSZ-LPTBSZ ;BUFFER EXTENSION FOR THE PLODDER
PLTEND==FOO ;THE END OF THE PLODDER BUFFER
DITMS LPTLBF,LINSIZ ;THE BUFFER FOR THE CURRENT PLODDER LINE
DITMSZ PLTLEN ;LENGTH OF PLODDER ITEM
.SBTTL ERROR DEFINITIONS
FOO==0
ERDEF NUL ;NO ERROR AT ALL
ERDEF APEF ;ACCESS PAST END OF FILE
ERDEF BAC ;BAD ACCESS
ERDEF BAD ;BAD ARGUMENTS TO CALL
ERDEF BCN ;BAD CAPABILITY NUMBER
ERDEF BCT ;BAD CAPABILITY TYPE
ERDEF BFN ;BAD FILE NAME
ERDEF BFUN ;BAD FUNCTION
ERDEF BPN ;BAD PAGE NUMBER
ERDEF CDD ;CAN'T DELETE NON-EMPTY DIRECTORY
ERDEF DEVE ;DEVICE ERROR
ERDEF DFL ;DISK FULL
ERDEF DRF ;DIRECTORY FULL
ERDEF EAE ;ENTRY ALREADY EXISTS
ERDEF FLOK ;FILE LOCKED
ERDEF FNF ;FILE NOT FOUND
ERDEF FNTL ;FILE NAME TOO LONG
ERDEF FTL ;FILE ENTRY TOO LONG
ERDEF NIS ;NO ITEM SPACE AVAILABLE
ERDEF NIT ;NO ITEM AVAILABLE
ERDEF NSS ;NO SWAP SPACE LEFT
ERDEF RNA ;RESOURCE NOT AVAILABLE
ERDEF RPEF ;ATTEMPT TO READ PAST END OF FILE
ERDEF SYS ;CALL MAY ONLY BE EXECUTED BY SYSSPR
ERDEF CLF ;C LIST IS FULL
ERDEF DSKE ;DISK ERROR (ONLY USED BY LSITS)
ERDEF DVBE ;DISK VERY BAD ERROR (ONLY LSITS)
.SBTTL TRAP VECTORS
.=0
BPT
.=4
.REPT 77
.+2
BPT
.ENDR
;TRAP VECTORS FOR INTERNAL DEVICES
TRAPV BE ;BUSS ERRORS
TRAPV ILL ;ILLEGAL INSTRUCTIONS
TRAPV BPT ;BREAKPOINTS
TRAPV IOT ;IOT
TRAPV PWF,7 ;POWER FAILURE
TRAPV EMT ;EMT
TRAPV TRP ;TRAP
TRAPV PAR ;PARITY ERROR
TRAPV PIR,7 ;PROGRAMMED INTERUPT
TRAPV FPP ;FLOATING POINT ERROR
TRAPV SEG ;SEGMENTATION ABORT OR TRAP
;TRAP VECTORS FOR OTHER DEVICES
TRAPV RF,5 ;FIXED HEAD DISK
TRAPV RK,5 ;MOVING HEAD DISK
TRAPV LC,6 ;LINE CLOCK
TRAPV PC,6 ;PROGRAMABLE CLOCK
TRAPV TK ;CONSOLE KEYBOARD
TRAPV TP ;CONSOLE PRINTER
TRAPV PTR,4 ;PAPER TAPE READER
TRAPV PTP,4 ;PAPER TAPE PUNCH
TRAPV PRT,4 ;LINE PRINTER IN PRINT MODE
TRAPV PLT,4 ;LINE PRINTER IN PLOT MODE
.IIF NZ MBFLG,TRAPV MB,7 ;MAR AND HISTORY REGISTER
;USER SYMBOLS FOR TRAP FAULTS
.IRP X,<BE,ILL,BPT,IOT,EMT,TRP,FPP,SLE,RDO,NXM>
.'X'TF==1+.IRPCN
.ENDM
.=400
.SBTTL SYSTEM VARIABLES AND TABLES
ZERO: 0 ;DEFINED TO BE ZERO
ABSLD:
.OFFSET 160000-.
ABSLOD: MOV #ABLDPD,P ;REINIT THE PDL POINTER
CLR D
MOV #20000,E
CLR (D)+
SOB E,.-2
CLR ABSCNT
;C IS CHECKSUM
;D IS CORE ADDRESS
;E IS BYTE COUNT
ABSLOP: CLR C
JSR PC,GBYTE
CMPB #1,A ;IS IT THE START OF A BLOCK?
BNE ABSLOP ;NO, TRY AGAIN
JSR PC,GBYTE
TST A
BNE ABSLOP ;SHOULD BE A ZERO NEXT
JSR PC,GWORD ;GET THE COUNT
MOV A,E ;SAVE IT
JSR PC,GWORD ;GET THE ADDRESS
MOV A,D
ADD E,A ;CHECK THAT WE AREN'T OVERLOADING
CMP #40000,A
BHI .+4 ;MUST BE UNDER 8K
BPT
CMP #6,E ;IS IT THE START BLOCK?
BEQ ABSSRT ;YUP
SUB #6,E ;THAT MANY ALREADY LOADED
ABSLP1: JSR PC,GBYTE
MOVB A,(D)+
SOB E,ABSLP1
JSR PC,GBYTE ;THE CHECKSUM
TSTB C
BEQ ABSLOP ;CHECKSUM GOOD
BPT ;BAD CHECKSUM
ABSSRT: JSR PC,GBYTE ;GET CHECKSUM
TSTB C
BEQ .+4
BPT ;BAD CHECKSUM
CMP -(P),-(P) ;EXTRA WORDS
SAVE <SYSFCP>
BIS #.DELCP,(P) ;DELETE CAPABILITY TO FILE
$INVOK
JMP (D)
GBYTE: DEC ABSCNT
BLT GBYTE1
MOVB @ABSPNT,A
INC ABSPNT
ADD A,C
RTS PC
GBYTE1: MOV #2000,ABSCNT ;A BARFER LOAD
MOV #ABSBRF,ABSPNT
SAVE <#ABSBRF,#-2000,SYSFCP>
$BLKI
BR GBYTE
GWORD: JSR PC,GBYTE
SAVE A
JSR PC,GBYTE
MOVB A,1(P)
REST A
RTS PC
SYSFCP: 0
ABSPNT: 0
ABSCNT: 0
ABLDPD==.+20
ABSBRF==ABLDPD
ABSEND==.
.OFFSET 0
;THE PDL MAY GROW DOWN HERE ON A POWER FAILURE
.BLKW 100 ;FOR THE SYSTEM PDL
.=<.&177700>+200 ;MAKE A NICE NUMBER
PDL:
PARREG: .BLKW 20 ;FOR THE REAL PARITY REGISTERS
CHEKPN: CHEKBG
CHEKBG: .BLKW 20
CHEKEN::
SSTATS:: ;THE SYSTEM STATUS BLOCK
VERN ;SYSTEM VERSION
TIME: .BLKW 2 ;TIME IN 60TH'S SINCE SYS START
SVCSR: 0 ;THE CONSOLE SWITCHES
LOOKSW: 0 ;NON-ZERO=>PAY ATTENTION TO SWITCHES
NSTATS==<.-SSTATS>/2
;DON'T CHANGE ORDER OF THESE THINGS
FDATE: -1 ;FILE DATE
FTIME: -1 ;FILE TIME
SECNT: 1. ;HALF SECOND COUNTER
SECOND: 0 ;CURRENT SECOND
MINUTE: 0 ;MINUTE
HOUR: 0
DAY: 0
MONTH: 0
YEAR: -1
MONS: .BYTE 31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
SECONL: 60.
MINUTL: 60.
HOURL: 24.
DAYL: 0 ;SET FROM MONS
MONTHL: 12.
YEARL: 2000. ;SYSTEM LOSES IN YEAR 2000.
RESETT: .WORD 0,0,0,1,1 ;VALUES TO RESET TO
TSHIFT: .WORD 4,5,5,6,5 ;AMOUNT TO SHIFT BY
TIMCHK: 0 ;IF NON-ZERO MAINTAIN LEVEL TABLE
LEVTAB: .BLKW 8. ;LEVEL CLOCK INTERUPTED FROM
MFITST: .FARUT!0 ;DATA BLOCK TO MAKE ROOT DIR
MFIBIT: ASCIZ <BITS>
MFISYS: ASCIZ <. SYSSPR>
MFIDSC: ASCIZ <DESCR>
.EVEN
PATCH:
PAT: .BLKW 140
SYSJPD: ;THE SYSTEM JOB'S PDL
BMT: .BYTE 1,2,4,10,20,40,100,200 ;BIT MARK TABLE
;FOR MARKING BIT TABLES, THE NTH ENTRY IS THE NTH BIT
DECTAB: .WORD 10000.,1000.,100.,10.,1,0
INITSW: -1 ;ZERO AFTER EXITING INIT CODE
PRUNNG: -1 ;ITEM # OF RUNNING PROCESS, NEG=> IN SYSTEM
;(THIS IS NOT SET TO -1 BY INTERUPT ROUTINES)
USRMOD: -1 ;IF A PROCESS IS RUNNING, NON-ZERO=> IN SYSTEM CODE
;0=>IN USER'S CODE
SYSSPR: -1 ;ITEM NUMBER OF THE SYSTEM SPHERE
CURUSR: -1 ;PROCESS BLOCK INDEX OF THE RUNNING PROCESS'S USER
CURSPH: -1 ;ITEM INDEX OF SPHERE OF THE RUNNING PROCESS
NEWPRI: .BLKW 2 ;PROCESS ID OF NEXT PROCESS TO BE CREATED
STPSVP: 0 ;SAVED P WHEN WE WENT TO START A PROCESS (FOR ERROR RECOVERY)
BPCLSR: 0 ;NON-ZERO WHEN IN PROCESS OF PCLSRING THE GUY GETTING UNLOCKED
QUANT: 0 ;NUMBER OF TICKS BEFORE THE RUNNING PROCESS SHOULD BE STOPPED
PQUANT: IQUANT ;QUANTUM TO GIVE A PROCESS WHEN YOU START IT
WQUANT: IQUANT*2 ;SAME, BUT FOR WINNERS
TUSED: 0 ;TIME THE PROCESS HAS USED SINCE LAST STARTED
STIMER: 0 ;TIME TILL NEXT CHECK OF SHORT FLUSHES
LTIMER: 0 ;TIME TILL NEXT CHECK OF LONG FLUSES
JTMUUP: JTMUUT ;NUMBER OF TICKS TILL NEXT UPDATE OF JTMUS
RUGVEC: 0 ;STORING PLACE FOR RUG'S VECTOR
RUGSTA: 0 ;DITTO FOR RUG'S STATUS
;SAVED VALUES FROM THE SEGMENTER
PSSR0: 0
PSSR1: 0
PSSR2: 0
PIRDIS: .WORD PIRLOS,STOPPR,TTYBRK,DMRBRK,PIRLOS,PIRLOS,PIRLOS,PIRLOS ;THE PIR DISPATCH
PIRBIT: .WORD 0,1000,2000,4000,10000,20000,40000,100000 ;THE PIR BITS
;EMT DISPACTCH TABLES
FOO==0
;REMEMBER THAT USER PROGRAMS DEPEND ON THESE TABLES
;NOT CHANGING ORDER
EMTDIS:
EMTD NOOP ;NOP CALL
EMTD FORK
EMTD POOFF
EMTD SLEEP
EMTD SINK
EMTD FLOAT
EMTD INVOK
EMTD QULK
EMTD QUNLK
EMTD TTGIV
EMTD TTGET
EMTD WRDI
EMTD WRDO
EMTD BYTI
EMTD BYTO
EMTD BLKI
EMTD BLKO
EMTD MAP
EMTD ALLOC
EMTD CRUSR
EMTD RDMAP
EMTD FONT
EMTD SSTAT
EMTD VIDSW
EMTD RUG
EMTD GERRW
EMTD TIME
EMTD SYSJB
EMTD GETID
EMTD MFPI
EMTHGH==FOO
.MACRO CLSTYD X
.'X'CAP==FOO
.=IVKCTB+<2*FOO>
CAPR'X
.IRP Y,<CCPR,CPY,DEL,GIV,TAK,DOIO>
.=.+CAPHGH-2
Y''X
.ENDM
.IIF P1,CAPHGH==CAPHGH+2
.=IVKCTB+<CAPHGH*7> ;7 IS THE NUMBER OF TABLES
FOO==FOO+1
.ENDM
.IIF P1,CAPHGH==0
FOO==0
;REMEMBER THAT USER PROGRAMS DEPEND ON THESE TABLES
;NOT CHANGING ORDER
IVKCTB:
CLSTYD XX ;THE ZERO CAPABILITY SHOULD NOT EXIST
CLSTYD CC ;CREATE CAPABILITY
CLSTYD MS ;MASTER SPHERE
CLSTYD SP ;SPHERE (NON-MASTER I.E. COPY OF MASTER)
CLSTYD PR ;PROCESS CAPABILITY
CLSTYD TT ;TELETYPE CAPABILITY (NO DATA WORDS)
CLSTYD FA ;FILE ACCESS CAPABILITY
CLSTYD QU ;THE QUE CAPABILITY
CLSTYD CL ;CORE LINK CAPABILIY
CLSTYD DS ;DISPLAY CAPABILITY
CLSTYD TR ;PAPER TAPE READER
CLSTYD TP ;PAPER TAPE PUNCH
CLSTYD LP ;LINE PRINTER CAPABILITY
CLSTYD CM ;COLOR MAP
;FIRST ITEM IS THE SPHERE
;SECOND IS SPHERE (IF ANY) IN CIRCULAR LIST OF SPHERES HAVING SHPERE
;CAPABILITY TO THIS SPHERE
;FIRST MISC IS FAULT ENTRY ADDRESS
;SECOND MISC IS C-LIST NUMBER (IF ANY) FOR CIRCULAR LIST
;BITS ARE:
.SPFES==4000 ;SURPRESS ENTERS THROUGH HERE
.SPCLC==10000 ;ALLOW COPY FROM C-LIST
.SPCLD==20000 ;ALLOW DELETE FROM C-LIST
.SPCRR==400 ;ALLOW CORE READ
.SPCRW==1000 ;ALLOW CORE WRITE
.SPCRE==2000 ;ALLOW CORE EXECUTE
;THESE FLAGS ARE FOR EMAP, DIFFERENT NAMES, SAME FUNCTION
.CRPRI==4000 ;PRIVATE PAGE
.CRRD==.SPCRR
.CRWRT==.SPCRW
.CREX==.SPCRE
.SPCAD==40000 ;ALLOW C-LIST APPEND
MSPCBT==.SPCAD!.SPCLC!.SPCLD!.SPCRR!.SPCRW!.SPCRE ;ALL SET IN SPHERE
;SAME PROPERTIES AS MASTER SPHERE, EXCEPT SOME BITS MAY NOT BE SET
;AND THERE IS NO ENTRY ADDRESS
;HERE ARE THE FUNCTIONS FOR THE .SPCAP AND .MSCAP INVOK'S
.SPPTT==0 ;PUT THE PROCESS INTO SPHERE
.SPCLR==1 ;READ THE C-LIST
;WORDS ARE ASSIGNED AS IN MASTER SPHERE AND ENTER ADDRESS IS STARTING ADDRESS
;BITS ARE:
.PRWRA==10000 ;ALLOW WRITING OF INFORMATION
;FLAGS ARE
.TTYO==10000 ;ALLOW OUTPUT TO TTY
.TTYI==20000 ;ALLOW INPUT FROM TTY
FAMFI==2 ;FIRST WORD IS MFI PTR
FAFPN==4 ;SECOND IS FILE PAGE NUMBER
FAUPT==6 ;THIRD IS GIP FOR FUPT
FAFBP==10 ;FOURTH IS BYTE PTR IN FILE PAGE (SEE 2ND WORD)
.FAEOFB==1000 ;SET IF THE POINTER IS IN THE LAST BLOCK OF THE FILE
.FAWD==2000 ;SET IF FIRST BYTE OF DKWDO IS WRITTEN
.FARD==4000 ;FILE READ ACCESS
.FAWT==10000 ;FILE WRITE ACCESS
.FAAP==20000 ;FILE APPEND ACCESS
.FAAC==40000 ;ACCESS CODES ACCESS
.FALB==100000 ;LOCK BIT
;NO FLAGS
;FIRST ITEM IS GIP TO THE BUFFER
;FLAGS ARE
.CLCONS==400 ;I AM THE CONSUMER FLAG
;IT HAS AN ITEM IF IT IS A TV DISPLAY, THE ITEM WORD IS 0 IF TV.
;THE FIRST MISCELLANEOUS WORD IS THE INDEX OF THE DISPLAY. FOR
;TK DISPLAYS, THIS NUMBER IS THE WORD INDEX INTO THE TKD TABLES.
;FOR TV DISPLAYS, IT IS STILL A WORD INDEX, AND SINCE THE TV TABLES
;ARE BYTE TABLES, THE NUMBER MUST BE DIVIDED BY 2 AND HAVE NFTVDS
;SUBTRACTED FROM IT BEFORE USE.
;NO FLAGS, ITEM IS THE PTR ITEM
;NO FLAGS, ITEM IS PTP ITEM
;NO FLAGS, ITEM IS THE LPT ITEM
;NO ITEM, THESE ARE FLAGS FOR CALLS:
.CMRED==2000 ;SET RED
.CMGRN==1000 ;SET GREEN
.CMBLU==400 ;SET BLUE
.CMBIT==100000 ;SET BIT COORESPONDENCE
;DISPATCH TABLES
FOO==IVKCTB
.IRP X,<CC,CPY,DEL,GIV,TAK,DOI>
FOO==FOO+CAPHGH
X'TAB=FOO
.ENDM
;GENERAL FUNCTIONS FOR INVOKE
.MACRO GENFUN NAME
NAME'CAP
.'NAME'CP==400*<200+FOO>
FOO==FOO+1
.ENDM
FOO==0
GENDIS: GENFUN DEL ;DELETE THE CAPABLITY
GENFUN CPY ;COPY THE CAPABILITY
GENFUN GIV ;GIVE THE CAPABILIITY AWAY
GENFUN TAK ;TAKE THE CAPABILITY (GIMMEE,GIMMEE)
GENHGH==FOO*2
;THIS IS THE DISPATCH TABLE FOR I-O DEVICES
.IRP OP,<WDI,WDO,BTI,BTO,BKI,BKO> ;INITIALZE TABLES FOR THESE TRANSFER TYPES
OP'TAB:
.IRP DEV,<DK,TT,CL,TR,TP,LP>
DEV'IDX==.IRPCN
DEV''OP
.ENDM
.ENDM
;THESE ARE THE TABLES FOR THE PROCESS INVOK
.MACRO PRINVK FUN,CNT
.PR'FUN==FOO
.IFB CNT
FOO==FOO+1
PR'FUN
.IFF
FOO==FOO+CNT
.REPT CNT
PR'FUN
.ENDR
.ENDC
.ENDM
FOO==0
PRIVTB: PRINVK REG,8 ;8 REGISTERS
PRINVK PSW ;PROGRAM STATUS WORD
PRINVK FREG,6 ;6 FLOATING POINT REGISTERS
PRINVK FPST ;FLOATING POINT STATUS WORD
PRINVK FPEN ;ENABLE FLOATING POINT
PRINVK STOP ;THE STOP WORD OF THE PROCESS
PRINVK ERR ;THE ERROR WORD
PRINVK FAUL ;THE FAULT WORD (OR WORDS)
PRINVK ERA ;ERROR ADDRESS IN SYSTEM
PRHGH==FOO*2
.PRRD==0 ;THE READ FUNCTION
.PRWRT==40 ;THE WRITE FUNCTION
.MACRO SPINVK FUN
.SP'FUN==FOO
FOO==FOO+1
SP'FUN
.ENDM
FOO==0
SPITAB: SPINVK PTP ;PUT PROCESS
SPINVK RCP ;RETURN CAPABILITY
SPINVK KIL ;KILL ALL PROCESSES
SPINVK STP ;STOP ALL PROCESSES
SPINVK STR ;START ALL PROCESSES
SPINVK PGT ;GET ID AND PC OF PROCESS
SPINVK GNP ;GET NUMBER OF PROCESSES
SPINVK GPC ;GET CAPABILITY TO PROCESS
SPINVK ENT ;SET THE ENTER ADDRESS
SPINVK STX ;SET X OF MAR
SPINVK STY ;SET Y OF MAR
SPINVK SMC ;SET MAR CONTROL REGISTER
SPIHGH==FOO
;FOR THE TTY INVOK
.MACRO TTIVK FNC
.'FNC==NTTFNC
FNC
NTTFNC==NTTFNC+1
.ENDM
.TTWRT==40
.TTIBK==400 ;TTY I/O FLAG SPECIFING AN INPUT TYPE BREAK
.TTMBK==10000 ;TTY FLAG SPECIFYING A MORE BREAK
.TTWD==40000 ;FLAG SAYING THAT FIRST BYTE DONE ON WORD OUTS
.TTEDM==1000 ;SAYING THAT THIS OUTPUT IS TO GO TO THE EDIT BUFFER
NTTFNC==0
;THESE FUNCTIONS WRITE IF THE .TTWRT BIT IS SET AND READ OTHERWISE
TTIVTB: TTIVK TTMOV ;MOVE INTO TTY STATUS WORD (ALWAYS WRITE)
TTIVK TTBIS ;BIS INTO TTY STATUS (ALWAYS WRITE)
TTIVK TTBIC ;BIC INTO TTY STATUS (ALWAYS WRITE)
TTIVK TTRD ;READ THE TTY STATUS (ALWAYS READ)
TTIVK TTCNO ;READ OR SET THE CHARNO VARIABLE
TTIVK TVATC ;ATTACH A DISPLAY BUFFER TO A TTY
TTIVK TVCL ;CLEAR THE SCREEN
TTIVK TTBRK ;READ THE LAST BREAK CHAR TYPED, HANG IF NONE
TTIVK TVREV ;REVERSE WHITE AND BLACK ON SCREEN
TTIVK TTMV2 ;SET TTYST2
TTIVK TTSPD ;SET THE SPEED AND LINE PARAMETERS (DH11 ONLY)
TTIVK TTTYP ;RETURN THE TYPE OF THE TTY TO THE USER
TTIVK TVFNT ;CHANGE THE FONT OF THE TV TTY
TTIVK TTBS2 ;BIS INTO TTY STATUS 2
TTIVK TTBC2 ;BIC INTO TTY STATUS 2
TTIVK TVSET ;READ OR SET TVLINE AND TVCUR
TTIVK TVOFF ;READ OR SET TVOFFL
TTIVK TVRFN ;READ CHAR WIDTH IN BITS AND LINE HEIGHT IN TVLINES
TTIVK TTPEK ;PEEK AT THE NEXT CHARACTER
TTIVK TVMOD ;SET THE CURSOR WRITING MODE
TTIVK TBRAK ;CAUSE BREAK ON LINE FOR (ARG) NUMBER OF CHARACTERS
TTIVK TTSLNL ;SET LINE LENGTH
;THE TV WRITING MODES
.TVIOR=TVIOR_-6
.TVXOR=TVXOR_-6
.TVMOV=TVMOV_-6
.IFNZ NTVS
.MACRO TDSIVK FUNCTION
.WORD FUNCTION
.'FUNCTION==TVDSIM+100
TVDSIM==TVDSIM+1
.ENDM
TVDSIM==0
;TV DISPLAY INVOKES
TVDSIT: TDSIVK TVDSRC ;READ THE CURSOR
TDSIVK TVDSSC ;SET THE CURSOR
TDSIVK TVDSNL ;DRAW A NULL LINE
TDSIVK TVDSIL ;IOR A LINE
TDSIVK TVDSXL ;XOR A LINE
TDSIVK TVDSCL ;CLEAR A BLOCK OF THE SCREEN
TDSIVK TVSAVE ;SAVE TV REGISTERS FOR THIS PROCESS
TDSIVK TVMAPS ;MAP IN TV PAGES FOR THIS PROCESS
;VIDEO SWITCH MODES
.VIABS==0 ;ABSOLUTE MODE
.VILOT==1 ;LOGICAL TTY NUMBER MODE
.VILOD==2 ;LOGICAL DISPLAY NUMBER MODE
.VICAM==3 ;CAPABILITY MODE
.ENDC
.IRPC X,<012>
ITEM'X: -1 ;ITEM CURRENTLY IN PAGE ITM0
ITM'X'PB: 0 ;IF ITEM IS A GIP, THIS IS THE PB FOR IT
ITM'X'A: ITM'X'AD ;ADDRESS OF ITEM IN ITEM'X
ITM'X'D: 0 ;PUSH DEPTH
ITM'X'P: ITM'X'PD ;PDL POINTER FOR ITM'X
.BLKW NITMPS ;PDL FOR ITM'X'
ITM'X'PD::
.ENDM
ITMATB: .BLKW 200 ;ITEM ALLOCATE TABLE (ONE WORD PER SIZE)
;THESE POINT INTO ITMALS
ITMBAL: .BLKW 1 ;ITEM BLOCK STORAGE ALLOCATE LOCK
INITM1:: ;INITIALIZE FOLLOWING AREA TO -1
ITMBNF: .BLKW NITMBL ;NUMBER OF BLOCKS FREE IN THIS BIG BLOCK
ITMBST: .BLKW NITMBL ;ADDRESS OF FIRST BLOCK OF THIS BIG BLOCK
ITMBTP: .BLKW NITMBL ;POINTERS TO BEGGININGS OF BIT TABLES
.BLKW 1 ;THIS IS THE BACKWARDS-SEARCHING FENCE FOR THE 1ST BIT TABLE
ITMBIT: .BLKW 11*NITMBL ;8 WORD BIT TABLE FOR EACH BIG BLOCK
;AND A FENCE BETWEEN THE BLOCKS
EINTM1:: ;END OF STUFF TO INIT TO -1
;TABLES AND SYMBOLS FOR THE FILE SYSTEM
;MACRO TO DEFINE FILE ACCESS CAPABILITY FUNCTIONS
.MACRO MFADCF SYMBOL
.FA'SYMBOL==FOO
MFA'SYMBOL
FOO==FOO+1000
.ENDM
FOO==0
FATAB:
MFADCF CF ;CLEAR FLAGS
MFADCF RE ;RETURN EOF WORDS
MFADCF SP ;SET POINTER
MFADCF RP ;RETURN POINTER
MFADCF DL ;DELETE ENTRY
MFADCF AD ;ADD ENTRY
MFADCF MU ;MUTATE CAPABILITY
MFADCF MB ;SET UP BIT TABLE FOR ROOT DIR
MFADCF RI ;RETURN INFORMATION ABOUT THE FILE
MFADCF DI ;RETURN INFORMAITON ABOUT THE DISK
MFADCF SDL ;DELETE THE FILE OR DIRECTORY, EVEN IF STUFF IN DIR
MFADCF MD ;MAKE A DIRECTORY
MFAHGH==<FOO-1000>/400
;STUFF FOR GROVELING THROUGH DESCRIPTORS
MFBLTB: MFBSKP ;SKIP AND GRAB ONE
MFBGET ;GET LOTS
MFBSET ;SET ADDRESS AND GRAB LOTS
MFBSKG ;SKIP SOME, GRAB SOME
MFENTB: MFESKP ;SKIP AND GRAB ONE
MFEGET ;GET LOTS
MFESET ;SET ADDRESS AND GRAB LOTS
MFESKG ;SKIP SOME, GRAB SOME
ENTPNT: 0 ;POINTER INTO MFI
ENTEND: 0 ;END OF MFI ENTRY
ENTCNT: 0 ;COUNT FOR COUNT TYPES
ENTMOD: 0 ;MODE OF CURENT BYTE, USED FOR ADDING A BLOCK
.SBTTL PROCESS QUEUES
;FOR THE PROCESS TABLE
;MACRO FOR DEFINING A QUEUE
.MACRO DEFQ NAME
NAME'Q: .BLKW 2
NAME'QB==1_FOO
1_FOO
FOO==FOO+1
.ENDM
QLEN==6 ;THE LENGTH OF A QUEUE POINTER
QBIT==4 ;POSITION OF QUEUE BIT WITHIN THE POINTER
FOO==0 ;INITALIZE THE QUEUE NUMBER
FIRSTQ==.
DEFQ WIN ;GUYS WHO ARE REAL WINNERS
DEFQ ACT ;GUYS WHO ARE MODERATE WINNERS
DEFQ DOR ;MODERATE WINNERS WHO ARE HUNG
DEFQ RUN ;GUYS WHO WANT TO RUN BUT ARE LOSERS
DEFQ IACT ;GUYS WHO ARE HUNG AND ARE LOSERS
DEFQ STOP ;GUYS WHO ARE STOPPED
DEFQ USER ;FOR CONFORMITY, USERS ARE KEPT HERE
DEFQ SPHR ;FOR CONFORMITY SPHERES ARE KEPT HERE
NQS==FOO
PFREQB==1_FOO
PFREEQ: .WORD PRSTAB,0,PFREQB ;FREE PROCESS BLOCKS LIST POINTER
FOO==PRSTAB+PRSTEL
FOOBAR==PFREEQ
PRSTAB: .REPT NPROSS
FOO
FOOBAR
FOO==FOO+PRSTEL
FOOBAR==.-4
.=.+PRSTEL-4
.ENDR
.WORD 0,FOOBAR
.BLKB PRSTEL-2 ;THE LAST PROCESS BLOCK MUST GO HERE
DTHING ;THE PROCESS ACTIVATE BLOCKS
DWORD ACTLNK ;LINK WORD
DWORD ACTITM ;PROCESS ITEM
DWORD ACTPI1 ;ID WORD 1
DWORD ACTPI2 ;ID WORD 2
ILISTS ACTFRE,,10. ;TEN OUGHT TO BE PLENTY
ACTLST: 0 ;LIST TO ACTIVATE
PTRITM: 0 ;PAPER TAPE READER ITEM NO.
PTPITM: 0 ;PAPER TAPE PUNCH ITEM NO.
LPTITM: 0 ;CONTAINS ITEM NO OF THE LINE PRINTER ITEM
CMUSE: 0 ;COUNT OF COLOR MAP CAPS
.SBTTL RANDOM DISK PARAMETERS
NRRKD==4 ;NUMBER OF REGULAR RK11S
NRFD==0 ;NUMBER OF RF11 DISKS
NDISKS==NRRKD+NRFD ;TOTAL NUMBER OF DISKS
NSWPA==NDISKS ;MAX NUMBER OF DISK SWAP AREAS
MNRTY==50. ;NUMBER OF TIMES TO RETRY OPERATION
NDRQBL==20 ;NUMBER OF LOW LEVEL DISK REQUEST BLOCKS TO ALLOCATE
;LOW LEVEL DISK REQUEST BLOCKS
DTHING
DWORD DRQLNK ;LINK WORD
DWORD DRQDNO ;DISK NUMBER
DWORD DRQHCA,DRQFUN ;HIGH CORE ADDRESS,,FUNCTION (ALSO GETS ERROR BIT)
DRQFER==100000 ;INT ROUTINES SET THIS BIT TO INDICATE ERROR
DWORD DRQCA ;CORE ADDRESS (LOW PART)
DWORD DRQDA ;DISK BLOCK ADDRESS
DWORD DRQWC ;WORD COUNT
DWORD DRQABL ;PAGE REQUEST BLOCK TO ACTIVATE
ILISTS DSKRFL,,NDRQBL ;ALLOCATE NDRQBL OF THESE BLOCKS
;MIDDLE LEVEL DISK REQUEST BLOCKS
DTHING
DWORD DMRLNK
DWORD DMRPBP ;PAGE BLOCK POINTER
;NEXT 3 MUST STAY IN THIS ORDER
DWORD DMRPWK ;ITEM OF PROCESS TO WAKE UP
DWORD DMRPW1 ;ID WORD 1 OF PROCESS TO WAKE UP
DWORD DMRPW2 ;ID WORD 2 OF PROCESS TO WAKE UP
DWORD DMRFUN ;FUNCTION
DWORD DMRDRC ;COUNT OF DISK REQUESTS ENTERED FOR THIS BLOCK
DWORD DMRPBB ;PB BIT(S) TO CLEAR ON COMPLETION OF REQUESTS
ILISTS DMRPNT,,10. ;ONLY 10 OF THESE=> MAX OF 10 PAGES MOVING AT ONCE
.SBTTL CORE DATA STRUCTURE DEFINITIONS
;DEFINITION OF A PAGE BLOCK
DTHING
DWORD PBFLAG ;WORD OF RANDOM FLAGS, USED AS LINK IN FREE LIST
DFLAGS
DFLAG PBUSED ;MUST BE THE 1 BIT-SET IF USED
DFLAG PBZERO ;THIS PAGE WANTS TO BE ZERO
DFLAG PBWCHK ;THIS PAGE SHOULD ALWAYS BE WRITE-CHECKED
DFLAG PBVAS ;PAGE IS VALID AT SOURCE
DFLAG PBVASS ;PAGE IS VALID AT SWAP SPACE
DFLAG PBVACR ;PAGE IS VALID AT CORE
DFLAG PBFILE ;PAGE IS A FILE PAGE
DFLAG PBSTS ;PAGE SHOULD BE SWAPPED TO SOURCE
DFLAG PBDISK ;PAGE HAS DISK TRANSFER(S) PENDING
DFLAG PBLOCK ;HANDS OFF!
DFLAG PBERR ;PAGE IN ERROR DUE TO DISK LOSSAGE
DFLAG PBNOSW ;NEVER ASSIGN SWAP SPACE
DWORD PBLKPC ;TEMP WORD, PC PB LOCKED FROM
DWORD PBLKPS ;TEMP WORD, PROCESS THAT LOCKED PB
DWORD PBGIP ;GIP IN TH ECIRC LIST OF GIPS FOR THIS PAGE
DWORD PBCAR ;CORE ADDRESS, ZERO=>OUT
DWORD PBRAN,PBLEN ;RANDOM (START AND DISK #),,LENGTH
PBSTRT==177770 ;MASK FOR START
PBDSKM==177407 ;MASK FOR DISK
PBDISS==2 ;DISK SHIFT (LOW ORDER BIT OF DISK IS 0)
DWORD PBDA ;START OF SWAP AREA ADDRESS
DWORD PBAUSR ;NUMBER OF ACTIVE USERS OF THIS PAGE
ILISTS PBFREL,,50. ;ALLOW FOR 50 DIFFERENT PAGES TO EXIST
;THE FOLLOWING IS THE EXTENSION OF PAGE BLOCKS TO FILE PAGE BLOCKS
DWORD PBSDSK ;THE DISK THE SOURCE IS ON
DWORD PBSDA ;THE SOURCE DISK ADDRESSES (8 OF THEM)
FOO==PBSDA+20 ;ALLOCATE THEM
DWORD PBFLEN,PBNEWB ;LENGTH OF PAGE IN BLOCKS, # OF NEW BLOCK
DWORD PBFLNK ;LINK BETWEEN PBS FOR THIS FILE
DWORD PBFPNO ;PAGE NUMBER IN FILE THAT THIS FPB IS FOR
DWORD PBMFIP ;POINTER BACK TO MFI FOR THIS FPB
ILISTS FPBFRE,,50. ;ALLOW FOR 50 FILE PAGES
;DEFINITION OF A UPT OR FUPT
DTHING
DWORD UPTFLG,UPTSTL ;FLAGS, START AND LENGTH
DFLAGS
DFLAG UPTEXB ;THIS PAGE EXISTS!
DFLAG UPTABS ;ABSOLUTE PAGE
DFLAG UPTEXD ;EXPAND DOWN
DFLAG UPTRDO ;READ ONLY
DFLAG UPTEXO ;EXECUTE ONLY
DFLAG UPTIED ;I=D, THIS SET IN THE I SPACE PAGE
DFLAG UPTDEI ;D=I, THIS SET IN THE DATA PAGE
UPTLMS==177770 ;LENGTH
UPTSMS==177617 ;START
UPTSSH==4 ;SHIFT FOR START
DWORD UPTPBP ;POINTER TO PAGE BLOCK (AR OF ABS PAGE)
DWORD UPTGIP ;CIRCULAR LIST POINTER (DR OF ABS PAGE)
UPTLEN==FOO ;LENGTH OF UPT
;FOR FUPTS ALSO HAVE:
DWORD FUPTPR ;POINTER TO PROCESS THAT CURRENTLY "OWNS" THIS FUPT
ILISTS FUPTFR,,50. ;ALLOCATE 50 FUPTS
;LIST FOR DELETEING UPT OR FUPTS
DTHING
DWORD DLULNK ;LINK WORD
DWORD DLUUPT ;UPT TO DELETE
ILISTS DLUFRE,,10.
DLULST: 0 ;DLU LIST TO ACT ON
.SBTTL DISK RANDOM STORAGE
DSKPS: 0 ;PDL POINTER SAVE FOR ERROR CHECK
DSKPSV: 0 ;PDL POINTER SAVE FOR MAIN PROG PDL POINTER
DSKP: DPDL-14 ;PDL POINTER FOR DISK ROUTINES
.BLKW 100 ;DPL STORAGE FOR DISK
DPDL: DSTART ;CAREFULLY INITED PDL
DSKRQ: 0 ;POINTER TO LIST OF PENDING REQUESTS
DRQDL: 0 ;POINTER TO LIST OF DONE REQUESTS
DRQFCN: NDRQBL ;NUMBER OF FREE DISK REQUEST BLOCKS
DMRLST: 0 ;MIDDLE LEVEL DISK REQUEST LIST
DISKER: .BLKW NDISKS ;ERRORS ON EACH DISK
DSKOFS: .REPT NRRKD
.RPCNT_13.
.ENDR
DSKRQS: ;SERVICE ROUTINES FOR THE VARIOUS DISKS
.REPT NRRKD
RKDSKS
.ENDR
DSKREA==0 ;READ
DSKWRT==2 ;WRITE
DSKWCH==4 ;IF THIS BIT IS SET, WRITE-CHECK AFTER READ OR WRITE
DKWCH==10 ;THE INDEX OF THE WRITE CHECK FUNCTION
RKFUN: 105 ;READ
103 ;WRITE
105 ;READ W DSKWCH SET
103 ;WRITE W DSKWCH SET
107 ;WRITE CHECK
NRETRY: 0 ;NUMBER OF DISK RETRYS BEFORE GIVIN GUP
DERBL: .BLKW 10 ;PLACE WHERE THE LAST ERROR IS STORED
CURDSK: RKCS ;CS OF THE CURRENTLY RUNNING DISK
MFBITS: .BLKW NDISKS ;FUPTS OF BIT TABLES
MFFREE: .BLKW NDISKS ;COUNT OF FREE BLOCKS
MFBLNK: .BLKW NDISKS ;LINK THROUGH MFI'S ACTIVE ON THIS DISK
MFROVR: .BLKW NDISKS ;ROVING POINTER INTO BIT TABLE
;FILE NAME BLOCKS
FNBNML==20. ;MAX CHARS IN A FILE NAME
DTHING
DWORD FNBFNE ;END OF THE FILE NAME IN THE USER
DWORD FNBVER ;VERSION NUMBER OF THE FILE NAME
DWORD FNBFNO ;NUMBER O FFILE IN DIR
DWORD FNBFNL ;LENGTH OF FILE NAME
DWORD FNBFN ;ACTUAL FILE NAME
FOO==FNBFN+FNBNML ;ALLOCATE ENOGUH SPACE FOR FILE NAME
ILISTS FNBFRE,,4 ;SHOULDN'T NEED VERY MANY
.SBTTL RANDOM STORAGE FOR SWAP AREA INFO
SWPBPT: SWPBIT ;POINTERS TO THE SWAP AREA BITS TABLES
.BLKW NSWPA
SWPBDK: .BLKW NSWPA ;DISK NUMBER FOR THIS SWAP AREA
SWPBDA: .BLKW NSWPA ;BEGGINING DISK ADDRESS FOR THIS SWAP AREA
SWPEDA: .BLKW NSWPA ;ENDING DISK ADDRESS FOR THIS SWAP AREA
SWPFCN: .BLKW NSWPA ;NUMBER OF FREE SWAP BLOCKS IN THIS SWAP AREA
SWPBIT: .BLKW 105 ;ACTUAL SWAPPING BIT TABLES
SWPBTE:: ;END OF BIT TABLES
BITS: .WORD 1,2,4,10,20,40,100,200
.WORD 400,1000,2000,4000,10000,20000,40000,100000
BITSST: .WORD 0,1,3,7,17,37,77,177,777,1777
.WORD 3777,7777,17777,37777,77777,177777
MNCBLK==124.*2 ;MAX NUMBER OF BLOCKS OF CORE TO WORRY ABOUT
.IIF NZ NTVS,MNCBLK==108.*2 ;NOT AS MANY POSSIBLE IF TVS EXIST
.SBTTL RANDOM STORAGE FOR CORE INFORMATION
DFLAGS
DFLAG CSTFRB ;INDICATES BLOCK IS FREE
DFLAG CSTSYB ;INDICATES BLOCK USED BY SYSTEM
DFLAG CSTBEB ;THE BLOCK EXISTS BIT
CST: .BLKW MNCBLK ;CORE STATUS TABLE
0 ;MAKE SURE THE TABLE HAS AN END
CSTPB: .BLKW MNCBLK ;PB POINTERS FOR CORE USED BY PBS
FREECR: 0 ;AMOUNT OF CORE THAT IS FREE
CSTROV: CSTPB ;FOR LOGJAMS, PLACE TO SWAP A PAGE OUT
CST1FR: CST+<FSTFRB*2> ;POINTER TO FIRST FREE CST ENTRY
CST1NS: CST+<FSTFRB*2> ;POINTER TO FIRST NON-SYSTEM CST ENTRY
CSTTOP: 0 ;POINTER TO LAST REAL WORD IN CST
USRCOR: 0 ;AMOUNT OF CORE NOT USED BY SYSTEM
SYSUPD: 0 ;NUMBER OF TIMES SYS JOB HAS DELETEED UPTS
LOGJAM: 0 ;TIMES WHEN THERE WAS NOT ENOUGH CONGIOUS SPACE
;TO PUT SOME SIZE PAGE, BUT THERE WAS MORE THAN
;6K ACTUALLY FREE
NOFIT: 0 ;NUMBER OF TIMES A PAGE COULDN'T FIT IN CORE
;WHEN THERE WAS ENOUGH FREE
HSECNT: 30. ;60THS TILL TIME TO INC HSECS
HSECS: 0 ;TIME IN .5 SECS, FOR SWAP DESICIONS
LTPSTA: 0 ;LAST TIME PROCESS STARTED (IN .5 SEC)
ACTCHK: 0 ;FLAG TO INDICATE CHECKING FOR ACTIVATING PROSSES
ACORE: 0 ;AMOUNT OF CORE POTENITIALLY NEEDED BY ACTIVE PROCESSES
PBSWPO: .BLKW 50. ;PAGES WHICH MAY BE SWAPPED OUT
PBSWOE: 0 ;DUMMY END ENTRY
NPBSWO: 0 ;NUMBER OF PBS ON SWAP OUT LIST
KERSBT: .BLKB 16.*3 ;KERNAL, NON-EX AND SUPER
.REPT 16. ;USER
.BYTE 1 ;SEGBRK LEGAL ON ALL PAGES
.ENDR
.IRPC X,<012>
ITM'X'KB==KERSBT+<<ITM'X'AR-I0AR>/2> ;BYTE FOR A PARTICULAR PAGE
.ENDM
.SBTTL ASSEMBLE THE STUFF GENEATED BY THE REMOTE MACROS
LSTSTO ;STORAGE FOR THE LISTS
LSTEND: ;END OF LIST STORAGE AREA
INITSL ;INIT TABLE FOR THE LISTS
0
;DISPLAY VARIABLES
;AND PARAMTERS
.IFNZ NTKDIS
DISMAL==2
DISBIG==4
TKDLEN: .WORD DISMAL,DISMAL,DISMAL,DISBIG
.IIF NE .-TKDLEN-<2*NTKDIS>,.ERROR BAD TKDLEN TABLE LENGTH
TKDITM: .BLKW 8. ;THE ITEMS FOR THE DISPLAYS
TKDOWN: .BLKW 8. ;IF DISPLAY OWNED
TKDPDA: 0 ;PDL ADDRESS
TKDPDL: 0 ;THE ITEM FOR THE DISPLAY PDLS
TKRELS: 0 ;THE RELOCATION REGISTER FOR THE DISPLAY
TKDRUN: .WORD -1,-1,-1,-1,-1,-1,-1,-1 ;THE RUN FLAGS
TKDPDP: .WORD 40,130,220,310,400,470,560,650 ;PDL POINTERS FOR EACH DISPLAY
DPUSHJ==100000
DSTOP==140400
TKRUN==4000
TKGO==10000
TKSTOP==20000
.ENDC
.IFNZ NTVS
NFTVDS==NTKDIS ;THE FIRST TV IS THE ONE AFTER THE TK DISPLAYS
;THIS TABLE CONTAINS THE REFERENCE COUNTS FOR EACH OF THE TVS. THE BUFFER
;FOR A TV SHOULD BE RELEASED WHEN THE REFERENCE COUNT REACHES ZERO. THE
;REFERENCE COUNT CAN BE INCREMENTED FOR EACH TTY ITEM WHICH REFERS TO
;THIS TV AND FOR EACH DISPLAY CAPABILITY TO THE TV.
TVDSRF:
.REPT NTVS
.BYTE 0
.ENDR
;TVDSBF CONTAINS THE BUFFER NUMBER OF EACH TV. THIS NUMBER IS -1 WHEN
;THERE IS NO BUFFER ALLOCATED TO A PARTICULAR TV.
TVDSBF:
.REPT NTVS
.BYTE -1
.ENDR
;TVBUFF SHOWS WHICH BUFFERS HAVE BEEN ALLOCATED. IF THE VALUE IS -1,
;THEN THE BUFFER IS FREE. OTHERWISE, IT CONTAINS THE NUMBER OF THE
;TV WHICH USES THIS BUFFER.
TVBUFF:
.REPT NTVCHN
.BYTE -1
.ENDR
.ENDC
;TV DISPLAY CURSOR (OR TURTLE) VARIABLES
;Y POSITIONS
TVDSCY: .REPT NTVCHN
.WORD 0
.ENDR
;X POSITIONS
TVDSCX: .REPT NTVCHN
.WORD 0
.ENDR
;FONT TABLE CONTAINS THE ITEM OF EACH FONT
NFONTS==4 ;INITIALLY, THERE CAN BE TWO FONTS
FNTITM: .BLKW NFONTS
.INSRT STYI >
CHEKIN: SAVE PS
SPL 7
ADD #2,CHEKPN
CMP #CHEKEN,CHEKPN
BHI 1$
MOV #CHEKBG,CHEKPN
1$: MOV 2(P),@CHEKPN
REST PS
RTS PC
.SBTTL DISK INTERUPT LEVEL ROUTINES
;ALL DISK INTERUPTS COME HERE-ONLY ONE DISK CAN BE ACTIVE AT A TIME
;IN THIS SCHEME.
RKBRK:RFBRK:
DSKBRK: JSR F,ACSAV ;COMPLETE THE SAVE OF THE CURRENT CONTEXT
MOV P,DSKPSV ;SAVE A POINTER TO THE "FRAME"
MOV DSKP,P ;POINT TO DISK CONTEXT FRAME
MOV P,DSKPS ;SAVE FOR ERROR CHECKING
JMP ACRET
;THIS IS THE ROUTINE TO CALL TO RETURN TO NORMAL CONTEXT UNTIL NEXT INTERUPT
DFLUSH: CMP DSKP,DSKPS ;CHECK THAT STACK DIDN'T OVERFLOW
BUGC NE
JSR F,ACSAV ;SAVE THE DISK LEVEL CONTEXT
MOV P,DSKP ;AND THE FRAME POINTER
MOV DSKPSV,P ;PREPARE TO RESTORE REGULAR CONTEXT
JSR F,ACRES ;RETORE REGISTERS
CHECKP
RTT ;RETORE PS AND PC
;MAIN DISK SERVICE LOOP
;PICKS UP REQUESTS FROM THE DSKRQ LIST AND SERVICES THEM
;BY CALLING SERVICE ROUTINE FOR PROPER DISK
DSTART: MOV DSKRQ,A ;GET FIRST NODE ON LIST
BNE DSKRQP ;GOT ONE, GO PROCESS IT
CLR @CURDSK ;NO REQUEST, CLEAR CS OF CURRENT DISK
JSR PC,DFLUSH ;AND RETURN CONTROL
BR DSTART ;GO TRY AGAIN
;REALLY PROCESS A REQUEST
DSKRQP: MOV (A),DSKRQ ;TAKE THE BLOCK OFF THE LIST
CLR (A) ;AND CLEAR ITS LINK POINTER
MOV #MNRTY,NRETRY ;NUMBER OF TIMES TO TRY BEFORE YOU GIVE UP
DSKRQR: MOVB DRQDNO(A),B ;GET THE DISK NUMBER
MOVB DRQFUN(A),D ;AND THE FUNCTION
JSR PC,@DSKRQS(B) ;RUN THE SERVICE ROUTINE
BNE DSKRQD ;ERROR ON TRANSFER?
DEC NRETRY ;HAVE WE EXHUASTED RETRY COUNT?
BGE DSKRQR ;IF NOT, GO RETRY
BIS #DRQFER,DRQHCA(A) ;SET THE TRANSFER ERROR BIT
DSKRQD: MOV #DRQDL,B ;ADDRESS OF BEG OF THE DONE LIST
JSR PC,BLISTE ;GET TO END OF LIST IN B
MOV A,(B) ;PUT THIS ONE ON THE END OF THE LIST
BIS #DMRPIR,PIRQ ;CAUSE A MIDDLE LEVEL INTERUPT
BR DSTART ;AND TRY FOR ANOTHER
;SEARCH TO THE END OF THE LIST POINTED TO BY B
;LEAVE THE POINTER IN B POINTING TO THE LINK WORD
;OF THE NODE ON THE END OF THE LIST
BLISTE: TST (B) ;IS THIS THE LAST NODE
BEQ BLIST1 ;YUP
MOV (B),B ;GO TO NEXT NODE
BR BLISTE
BLIST1: RTS PC
;ENTER HERE TO WRITE-CHECK THE FUNCTION YOU JUST PERFORMED
RKDSKW: MOV #DKWCH,D ;CHANGE FUNCTION TO WRITE CHECK
;THE DISK SERVICE ROUTINE FOR REGULAR TYPE RK11 DISKS
RKDSKS: MOV #RKCS,CURDSK ;THE RK11 IS THE CURRENT DISK
MOV #RKDA,C ;POINTER TO THE DISK REGISTERS
CLR E ;FOR THE DIVIDE
MOV DRQDA(A),F ;GET THE DISK ADDRESS
ASL F ;CONVERT TO 256 WORD BLOCKS
DIV #12.,E ;CONVERT TO CYLENDIR AND SECTOR ADDRESSES
ASH #4,E ;PUT THE CYLENDER ADDRESS IN THE RIGHT PLACE
BIS F,E ;AND THE SECTOR ADDRESS
BIS DSKOFS(B),E ;THE DISK NUMBER TOO
MOV E,(C) ;ALL THAT JUST FOR THE DISK ADDRESS
MOV DRQCA(A),-(C) ;CORE ADDRESS IS SIMPLE
MOV DRQWC(A),-(C) ;SO IS WORD COUNT
MOV DRQHCA(A),E ;HIGH CORE ADDRESS IS HARDER
ASH #4,E ;PUT IT IN THE RIGHT PLACE
BIS RKFUN(D),E ;AND BIS IN THE FUNCTION
MOV E,-(C) ;START UP THE DISK!
RKDSWT: JSR PC,DFLUSH ;WAIT FOR TH ENEXT INTERUPT
TSTB (C) ;IS THE DISK REALLY DONE?
BGE RKDSWT ;NOPE, KEEP WAITING
TST (C) ;WAS THERE AN ERROR?
BLT RKDSKE ;BRANCH IF THERE WAS
BIT #DSKWCH,D ;AM I SUPOSED TO WRITE CHECK THIS FUNCTION?
BNE RKDSKW ;YUP, GO CALL YOURSELF
CLZ ;FINISHED SUCESSFULLY
RTS PC
;GOT AN ERROR ON THE RK11
RKDSKE: INC DISKER(B) ;INC NUMBER OF ERRORS ON THIS DISK
MOV #DERBL,C ;THE DISK ERROR RECORDING BLOCK
MOV #RKDS,D ;THE REGISTERS OF THE RK11
MOV #6,E ;ALL 6 OF THEM
2$: MOV (D)+,(C)+ ;GET COPYIED
SOB E,2$
MOV #17,RKCS ;RESET THE DRIVE
MOV #1,RKCS ;AND THE CONTROL
1$: TSTB RKCS ;MAKE SURE ITS READY
BGE 1$
SEZ ;RETURN AN ERROR
RTS PC
.SBTTL LOW LEVEL MAIN PROGRAM LEVEL DISK ROUTINES
;GET A LOW LEVEL DISK REQUEST BLOCK AND LEAVE IT'S INDEX IN C
GRQBLK: MOV DSKRFL,C ;TRY TO GET A BLOCK
BUGC EQ ;MUST BE ONE THERE!
MOV (C),DSKRFL ;LINK IT OUT OF LIST
DEC DRQFCN ;ONE LESS FREE
RTS PC
;PUT A LOW LEVEL DISK REQUEST BLOCK ONTO THE REQUEST LIST
;POINT TO REQUEST ARRIVES IN C
ADDRQ: SAVE B ;RANDOM REG
MOV #DSKRQ,B ;LIST OF REQUESTS
JSR PC,BLISTE ;GET TO THE END OF THE LIST
CLR (C) ;MAKE SURE NEW GUY DOESN'T POINT ANYWHERE
MOV C,(B) ;CLOBBER NEW GUY ONTO END
BIS #100,@CURDSK ;WAKE UP THE DISK IF IT NEEDS IT
REST B
RTS PC
.SBTTL MIDDLE LEVEL DISK ROUTINES
;REQUEST A MIDDLE LEVEL DISK TRANSFER AND WAIT FOR ITS COMPLETION
;ENTER WITHT THE POINTER TO THE PAGE BLOCK IN B
;AND THE FUNCTION IN E
DMRWT: JSR PC,DMRBGT ;TRY TO PLACE THE REQUEST
BNE DMRWT1 ;IF SUCCESS, CONTINUE
JSR PC,SFLUSH ;WAIT A SEC
JSR PC,RUNME ;NOT LONG
BR DMRWT ;AND TRY AGAIN
DMRWT1: JSR PC,PBWAIT ;WAIT FOR THE TRANSFER TO BE DONE
RTS PC ;AND RETURN
;REQUEST A MIDDLE LEVEL PAGE VALIDATION DISK TRANSFER
;ENTER WITH THE POINTER TO THE PAGE BLOCK IN B
;AND THE FUNTION IN E
DMRBGT: SAVE A
SPL 7 ;TO PREVENT THE DISK ROUTINES FROM SCREWING US
MOV DMRPNT,A ;TRY TO GET A DISK REQUEST BLOCK
BNE DMRBG1 ;GOT ONE
REST A
SPL 0
SEZ ;FAILED
RTS PC
DMRBG1: MOV (A),DMRPNT ;TAKE IT OFF THE FREE LIST
SPL 0 ;OUT OF DANGER
CLR (A) ;DON'T POINT LIKE THAT, IT'S IMPOLITE!
BIS #PBDISK,(B) ;DISK TRANSFER PENDING FOR THIS PAGE
MOV B,DMRPBP(A) ;THIS IS THE PAGE TO OPERATE ON
SAVE B
MOV A,B ;POINTER TO BLOCK
ADD #DMRPWK,B ;FIRST OF 3 WORDS
JSR PC,ACTSET ;SETUP TO ACTIVATE ME
MOV E,DMRFUN(A) ;SET IN THE FUNCTION
CLR DMRDRC(A) ;NO REQUESTS ENTERED FOR HIM YET
CLR DMRPBB(A) ;AND NO BITS TO CLEAR
MOV #DMRLST,B ;NOW FIND THE END OF THE REQUEST LIST
JSR PC,BLISTE
MOV A,(B) ;AND TACK THE REQUEST ON THERE
REST <B,A>
BIS #DMRPIR,PIRQ ;CAUSE A MIDDLE LEVEL INTERUPT
CLZ ;INDICATE REQUEST PLACED
RTS PC
;WAIT FOR A GIP TO STOP DISKING
GPWAIT: SAVE B
JSR PC,GIPPB ;CONVERT TO PB
JSR PC,PBWAIT ;WAIT FOR PB TO STOP
REST B
RTS PC
;WAIT FOR A PAGE BLOCK TO NO LONGER HAVE A DISK REQUEST PENDING
;THE PAGE BLOCK INDEX IS IN B
PBWAIT: SAVE A
MOV #PBDISK,A
BR PBULW3
PBWAI1: REST A
RTS PC
;WAIT FOR A PAGE TO BE HACKABLE
;I.E. PBDISK AND PBLOCK CLEAR
PBULWT: SAVE A
MOV #PBDISK!PBLOCK,A ;WAIT FOR THESE FLAGS TO CLEAR
PBULW3: BIT A,(B) ;IS IT UNLOCKED NOW?
BEQ PBWAI1 ;YES, JUST RETURN
PBULW1: JSR PC,SFLUSH ;WAIT A LITTLE WHILE
BIT #PBUSED,(B) ;STILL THERE?
BEQ PBULW5 ;GONE???
BIT A,(B) ;NOW?
BNE PBULW1 ;NOT YET
JSR PC,RUNME ;MAYBE NOW
BR PBULW3 ;TRY AGAIN
PBULW5: MOV ITM0A,A ;POINT TO PROCESS
BIT #PPCLSR,PFLAGS(A) ;IS HE GOING TO PCLOSER>
BEQ PBULW6 ;NO, BETTER EXPECT THIS THEN
JSR PC,RUNME ;THIS WILL NEVER RETURN
BPT ;I HOPE
PBULW6: BIT #PPBNMP,PFLAGS(A) ;DID HE EPECT IT?
BUGC EQ ;NO, WHAT A LOSER
JSR PC,RUNME ;REVIVE HIM
BR PBWAI1
;ROUTINE CALLED BY THE PIRQ ROUTINE
DMRBRK: JSR F,ACSAV ;SAVE MAIN PROG ACS
DMRBR1: BIC #DMRPIR,PIRQ ;PREVENT UNNESSARY INTERUPTS
MOV DRQDL,A ;ANYHTING ON LIST OF DONE REQUESTS?
BEQ DMRBR2 ;NOPE
MOV DSKRFL,F ;POINTER TO FREE BLOCKS
MOV A,DSKRFL ;LIST BEING FREED IS NOW AT FRONT OF FREELIST
DMRBR3: INC DRQFCN ;ONE MORE FREE ONE
JSR PC,DRQDNE ;GO CLEAN UP FOR THIS REQUEST
SPL 7 ;I VANT TO BE ALONE
TST (A) ;IS THERE ANOTHER DONE ONE?
BEQ DMRBR4 ;NOPE
SPL DMRL ;BACK TO NORMAL
MOV (A),A ;GET NEXT ONE
BR DMRBR3 ;AND PROCESS IT
DMRBR4: MOV F,(A) ;TACK OLD FREE LIST ON END OF NEW
CLR DRQDL ;ALL DONE ONES PROCESSED
SPL DMRL ;AND GO BACK TO NORMAL
DMRBR2: CMP #8.,DRQFCN ;ARE THERE AT LEAST 8 BLOCKS FREE?
BGE DMRBR9 ;EXIT TO WAIT FOR MORE BLOCKS FREE
MOV DMRLST,A ;GET FIRST REQUEST
BEQ DMRBR9 ;NO REQUESTS
MOV (A),DMRLST ;TAKE IT OFF THE LIST
MOV DMRPBP(A),B ;GET POINTER TO PAGE BLOCK
BIT DMRFUN(A),(B) ;IS WHAT WE WNAT ALREADY TRUE?
BNE DMRBR8 ;YUP, IGNORE THE REQUEST
CLR F ;TO BUILD UP THE FUNCTION IN
BIT #PBWCHK,(B) ;ARE WE SUPPOSED TO BE CAREFU WITH THIS PAGE?
BEQ 1$ ;NO, NO WRITE CHECK
BIS #DSKWCH,F ;SET THE WRITE CHECK BIT
1$: BIT #PBVACR,DMRFUN(A) ;VALIDATE IN CORE?
BNE DMRBVC ;YES, GO DO IT
BIT #PBVACR,(B) ;IT BETTER BE VALID IN CORE!
BUGC EQ
BIS #DSKWRT,F ;FUNCTION WILL BE A WRITE TO DISK
BIS DMRFUN(A),(B) ;AND THIS INDICATES THAT THE TRUE WILL
;EVENTUALLY BE THAT THE REQUEST HAS BEEN GRANTED
;THUS IF THE PAGE IS MODIFIED IN CORE AFTER WE
;START TO WRITE IT OUT, THE WRITE WILL HAVE BEEN
;A NO-OP, WHICH IS THE RIGHT THING
BIT #PBVASS,DMRFUN(A) ;WANT TO VALIDATE AT SWAP SPACE?
BNE DMRBVW ;GO DO IT
BIT #PBVAS,DMRFUN(A) ;VALIDATE AT SOURCE?
BNE DMRBVS ;GO DO THAT
BPT ;NO FUNCTION????
;COME HERE FOR A REQUEST THAT NEEDS NO ACTION
DMRBR8: BIC #PBDISK,(B) ;DISK TRANSFER "DONE"
JSR PC,ACTDMR ;ACTIVATE PROCESS THAT MADE THIS REQUEST (THE TURKEY)
MOV DMRPNT,(A) ;PUT REQUEST
MOV A,DMRPNT ;ONTO FREE LIST
BR DMRBR2 ;AND TRY TO FIND SOMEONE WHO IS MORE OF A WINNER
;COME HERE WHEN WE THINK WE'RE ALL DONE
DMRBR9: BIT #DMRPIR,PIRQ ;IS SOMEONE TRING TO WAKE US UP?
BNE DMRBR1 ;SIGH GO FIND OUT WHAT HE WANTS
JSR F,ACRES
REST A
CHECKP
RTT
;COME HERE TO TRY TO VALIDATE THE PAGE IN CORE
DMRBVC: BIS #DSKREA,F ;WE WANT TO READ FROM THE DISK
MOV #PBVACR,DMRPBB(A) ;WILL SET THE VALID IN CORE BIT WHEN DONE
BIT #PBVASS,(B) ;IS IT VALID ON SWAP SPACE?
BNE DMRBVW ;GO GET IT FROM SWAP SPACE
BIT #PBVAS,(B) ;IS IT VALID AT SOURCE?
BNE DMRBVS ;GO GET IT FROM SOURCE
BPT ;NOT VALID ANYWHERE????
;COME HERE TO DO A TRANSFER TO OR FROM SWAP SPACE
;DEPENDING ON THE FUNCTION THAT IS IN F
DMRBVW: BIT #PBSTS,(B) ;IS IT A SWAP TO SOURCE PAGE?
BNE DMRBVS ;YUP
JSR PC,GRQBLK ;GET A REQUEST BLOCK
MOVB F,DRQFUN(C) ;STORE AWAY THE FUNCTION
CLR E ;FOR THE ASHC
MOV PBCAR(B),F ;THE CORE ADDRESS IN 512 WORD BLOCKS
ASHC #10.,E ;MAKE INTO A BYTE ADDRESS
MOVB E,DRQHCA(C) ;SET THE HIGH PART OF THE ADDRESS
MOV F,DRQCA(C) ;SET THE LOW PART
MOVB PBRAN(B),E ;GET DISK #
BIC #PBDSKM,E ;CLEAR CRAP
ASH #-PBDISS,E ;SHIFT INTO PLACE
MOV E,DRQDNO(C) ;SET IN THE DISK NUMBER
MOV PBDA(B),E ;GET THE STARTING DISK ADDRESS
MOVB PBRAN(B),F ;NOW NEED THE START
BIC #PBSTRT,F ;TO GET TO THE RIGHT PLACE IN THE SWAP SPACE
ADD F,E ;THIS SHOULD BE IT
MOV E,DRQDA(C) ;PUT IT INTO THE BLOCK
MOVB PBLEN(B),E ;GET THE LENGTH
INC E ;CONVERT 0 TO 1
ASH #9.,E ;CONVERT TO WORDS
NEG E ;WORD COUNT ONLY A DISK COULD LOVE
MOV E,DRQWC(C) ;SO GIVE IT TO A DISK
MOV A,DRQABL(C) ;ACTIVE ME ON YOUR COMPLETION
INC DMRDRC(A) ;NUMBER OF REQUESTS MADE FOR THIS REQUEST
JSR PC,ADDRQ ;MAKE THE REQUEST
JMP DMRBR2
;COME HERE TO READ OR WRITE SOURCE
;DEPENDING ON FUNCTION IN F
DMRBVS: BIT #PBFILE,(B) ;BETTER BE A FILE PAGE
BUGC EQ
SAVE F ;SAVE THE FUNCTION
CLR E ;TO COMUTE CORE ADDRESS
MOV PBCAR(B),F ;HAVE TO SHIFT IT
ASHC #10.,E ;TO MAKE IT INTO BYTES
SAVE <E,F> ;SAVE IT ON THE STACK
MOV B,D ;COPY THE PB POINTER
ADD #PBSDA,D ;POINT TO FIRST DISK ADDRESS
MOVB PBRAN(B),E ;TO GET START
BIC #PBSTRT,E ;CLEAR CRAP
ASL E ;BITES
ADD E,D ;BLOCK TO REALLY START WITH
MOVB PBLEN(B),E ;NUMBER OF BLOCKS WE WANT
DRBVS3: JSR PC,GRQBLK ;GET A BLOCK TO MAKE THE REQUEST WITH
INC DMRDRC(A) ;NUBER OF REQUESTS FOR THIS REQUEST
MOV A,DRQABL(C) ;ACTIVATE ME ON YOUR COMPELETION
MOVB 4(P),DRQFUN(C) ;GET BACK THE FUNCTION
MOVB 2(P),DRQHCA(C) ;THE HIGH CORE ADDRESS
MOV (P),DRQCA(C) ;AND THE LOW CORE ADDRESS
MOVB PBSDSK(B),DRQDNO(C) ;THE DISK #
CLR DRQWC(C) ;NOW COMPUTE TRANSFER LENGTH
MOV (D),DRQDA(C) ;GET STARTING DISK ADDRESS
BUGC EQ ;SHOULD NEVER TOUCH BLOCK ZERO!
DRBVS2: MOV (D)+,F ;INTO F ALSO
CMP #-1,F ;MAKE SURE NOT NON-EX BLOCK
BUGC EQ
ADD #2000,(P) ;INC CORE ADDRESS
ADC 2(P) ;TO NEXT BLOCK
ADD #-1000,DRQWC(C) ;ONE MORE BLOCK
DEC E ;ONE MORE BLOCK READY TO GO
BLT DRBVS1 ;THAT'S ALL WE WANT
INC F ;ADDRESS OF NEXT SEQUENTIAL BLOCK
CMP F,(D) ;IS THE NEXT BLOCK RIGHT AFTER THIS ONE?
BEQ DRBVS2 ;YUP, GOBBLE IT ON THIS TRANSFER
JSR PC,ADDRQ ;HAVE TO SPLIT TRANSFER
BR DRBVS3 ;GO TAKE ANOTHER CRACK AT IT
DRBVS1: JSR PC,ADDRQ ;ADD THE LAST REQUEST
ADD #6,P ;FLUSH CRAP FROM STACK
JMP DMRBR2 ;DONE WITH THIS ONE
;COME HERE TO CLEAN UP FOR EACH DISK REQUEST THAT FINISHES
;MUST CHECK IF ALL REQUESTS ARE DONE, AND FINISH THE GUY UP IF THEY ARE
;THE REQUEST BLOCK IS POINTED TO BY A
DRQDNE: MOV DRQABL(A),B ;MIDDLE LEVEL BLOCK TO ACTIVATE
MOV DMRPBP(B),C ;POINTER TO PAGE BLOCK
BIT #DRQFER,DRQHCA(A) ;WAS THERE A HARD ERROR?
BEQ DRQDN1 ;NOPE
BIS #PBERR,(C) ;FLAG ERROR FOR MAIN PROGRAM
BPT ;UGH
DRQDN1: DEC DMRDRC(B) ;ONE LESS REQUEST PENDING
BNE DRQDN2 ;BUT MORE STILL THERE
SAVE A ;THIS GUY IS ALL DONE, FINISH HIM OFF
MOV B,A ;ACTDMR EXPECTS ARG IN A
JSR PC,ACTDMR ;THIS GUY IS A WINNER, RUN HIM QUICK
REST A
BIS DMRPBB(B),(C) ;SET ANY BITS YOU NEED TO
BIC #PBDISK,(C) ;AND INDICATE DISK OP IS DONE
MOV DMRPNT,(B) ;PUT THE FREE LIST
MOV B,DMRPNT ;BACK TOGETHER
DRQDN2: RTS PC
ACTDMR: JSR F,ACSAV ;GROSS OUT
MOV #DMRPWK,B ;POINTER TO 3 WORD BLOCK
ADD A,B ;IN THIS BLOCK
JSR PC,GOACT ;GO PUT ON ACTIVATE LIST
JMP ACRET
.SBTTL MAIN PROGRAM LEVEL PAGE VALIDATION ROUTINES
;VALIDATE THE PAGE WHOSE PB IS IN B IN CORE
;THE ASSUMPTION IS THAT THE PAGE IS EITHER PBZERO OR
;IS VALID ON SWAP OR SOURCE
;ALSO, THE PAGE MUST HAV ECORE ASSIGNED TO IT
VALCOR: JSR F,ACSAV ;SO WE DON'T HAVE TO WORRY
BIT #PBLOCK!PBDISK,(B) ;IS SOMETHING FISHY?
BUGC NE
BIT #PBZERO,(B) ;SHOULD IT BE ZEROED?
BEQ VALCO3 ;NOPE, GO SWAP IT IN INSTEAD
BIC #PBZERO,(B) ;WE GO THIS WAY BUT ONCE....
;NOW WE PROCEED TO PLAY WITH ITEM2
;IN A FUNNY WAY TO CLEAR THE PAGE
MOV #-1,A ;FIRST WE DO A FAKE PUSH
JSR PC,ITM2PL
MOV PBCAR(B),A ;GET THE REAL CORE ADDRESS
BUGC EQ ;WHICH BETTER BE NON-ZERO
ASH #4,A ;MAKE IT IN 32 WORD BLOCKS
MOV #ITM2AD,C ;POINT TO ITEM2
MOVB PBLEN(B),D ;GET THE LENGTH
INC D ;0=>1
ASH #9.,D ;CONVERT TO WORDS
SPL 7 ;PREVENT INT LEVEL FROM GETTIGN CONFUSED
MOV A,ITM2AR ;POINT TO PAGE
MOV #77406,ITM2DR ;MAXIMAL LENGTH PAGE
1$: CLR (C)+ ;CLEAR A WORD
SOB D,1$
SPL 0 ;INTS OK NOW
JSR PC,ITM2PO
BIS #PBVACR,(B) ;NOW VALID IN CORE
BIC #PBVAS!PBVASS,(B) ;NOT VALID ON SOURCE OR SWAP SPACE
VALCO1: JMP ACRET
VALCO5: JSR PC,RUNME ;TRY AGAIN FOR BLOCK
;COME HERE TO TRY TO ENTER REQUEST TO VALIDATE PAGE IN CORE
VALCO3: MOV (B),F ;SAVE FOR THE LOCK FLAG
MOV #PBVACR,E ;REQUEST TO VALIDATE IN CORE
JSR PC,DMRBGT ;TRY TO ENTER REQUEST
BNE VALCO2 ;BR IF YOU WON
VALCO4: JSR PC,SFLUSH ;WAIT....
BIT #PBLOCK,F ;IF IT WAS LOCKED WHEN I STARTED
BNE VALCO5 ;THEN IT DAMN WELL BETTER BE ME WHO HAS IT LOCKED!
BIT #PBLOCK!PBVACR,(B) ;SOMEONE ELSE BRINGING IT IN?
BEQ VALCO5
BIT #PBLOCK!PBDISK,(B) ;WAIT FOR IT TO SETTLE DOWN?
BNE VALCO4
JSR PC,RUNME ;SOMEONE ELSE WAS KIND ENOUGH TO BRING IT IN
BR VALCO1 ;I CAN RETURN
VALCO2: JSR PC,PBWAIT ;WAIT FOR THE DISK TO WIN
BR VALCO1 ;DONE!
;VALIDATE PAGE ON SWAP SPACE
;THE PAGE MUST BE VALID IN CORE WHEN THE ROUTINE IS ENTERED
;A PB POINTER TO THE PAGE IS IN B
VALSWP: BIT #PBSTS,(B) ;IS IT A SWAP TO SOURCE PAGE?
BNE PBVLSR ;YES, VALIDATE AT SOURCE INSTEAD
JSR F,ACSAV ;BETTER SAFE THAN...
MOV (B),F
VALSW5: JSR PC,PBWAIT
BIT #PBVASS,(B) ;IS PAGE ALREADY VALID ON SWAP SPACE?
BNE VALCO1 ;RETURN IF ALREADY VALID
BIT #PBVACR,(B) ;IT BETTER BE VALID IN CORE!
; BUGC EQ
BNE VALSW1
JSR PC,BUGGER
;COME HERE TO ENTER THE REQUEST TO VALIDATE THE PAGE ON SWAP SPACE
VALSW1: MOV #PBVASS,E ;REQUEST VALIDATION OF PAGE ON SWAP SPACE
BIT #PBFILE,(B) ;IS THIS A FILE PAGE?
BNE 1$ ;YES
BIS #PBVAS,E ;SWAP SPACE IS SOURCE
1$: JSR PC,DMRBGT ;GO TRY TO REQUEST IT
BNE VALCO1 ;BRANCH IF YOU WIN, WE'RE DONE
VALSW2: JSR PC,SFLUSH ;WAIT FOR CONDITIONS TO IMPROVE
BIT #PBLOCK,F ;HAVE I GOT THE PAGE LOCKED?
BNE VALSW4 ;BR IF I'VE GOT IT
BIT #PBLOCK,(B) ;SOMEONE ELSE GOT IT LOCKED?
BNE VALSW2 ;BR TO WAIT FOR UNLOCKED
VALSW4: JSR PC,RUNME ;TRY AGAIN
BR VALSW5
;VALIDATE A PAGE BLOCK ON SOURCE
PBVLSR: JSR F,ACSAV ;SAVE THE RESGISTERS
BR VALS59 ;JUMP IN AFTER GIP CONVERT
;VALIDATE PAGE AT SOURCE
;THE PAGE MUST BE VALID IN CORE WHEN ROUTINE IS ENTERED
;A GIP TO TH PAGE IS IN B
VALSRC: JSR F,ACSAV ;BETTER SAFE THAN...
JSR PC,GIPPB ;CONVERT GIP TO PB
VALS59: MOV (B),F
VALS5: JSR PC,PBWAIT ;WAIT FOR ANY DISKING TO DIE DOWN
BIT #PBVAS,(B) ;IS PAGE ALREADY VALID ON SOURCE
BNE VALCO1 ;RETURN IF ALREADY VALID
BIT #PBFILE,(B) ;IS IT REALLY A FILE PAGE?
BEQ VALSW5 ;NO, REALLY VALIDATE IT AT SWAP
BIT #PBVACR,(B) ;IT BETTER BE VALID IN CORE!
; BUGC EQ
BNE VALS1
JSR PC,BUGGER ;TRY TO PCLOSER OUT
;COME HERE TO ENTER THE REQUEST TO VALIDATE THE PAGE ON SAP SPACE
VALS1: MOV #PBVAS,E ;REQUEST VALIDATION OF PAGE ON SAP SPACE
JSR PC,DMRBGT ;GO TRY TO REQUEST IT
BNE VALCO1 ;BRANCH IF YOU WIN, WE'RE DONE
VALS2: JSR PC,SFLUSH ;WAIT FOR CONDITIONS TO IMPROVE
BIT #PBLOCK,F ;HAVE I GOT THE PAGE LOCKED?
BNE VALS4 ;BR IF I'VE GOT IT
BIT #PBLOCK,(B) ;SOMEONE ELSE GOT IT LOCKED?
BNE VALS2 ;BR TO WAIT FOR UNLOCKED
VALS4: JSR PC,RUNME ;TRY AGAIN
BR VALS5
.SBTTL SWAP SPACE ALLOCATE/DEALLOCATE ROUTINES
;FIND SWAP SPACE FOR THE PB IN B
;AND CLOBBER THE PB TO REFLECT IT
FINSWP: JSR F,ACSAV
MOV B,F ;SAVE AWAY THE PB POINTER SO IT IS EASY TO GET LATER
CLR C ;INDEX TO BIT TABLE POINTERS
FINSW1: MOV SWPBPT+2(C),B ;HAVE WE EXHAUSTED SPACE TO SEARCH?
BEQ FINSW8 ;YUP, YOU LOSE
MOV SWPBPT(C),A ;POINT TO BEG OF THIS TABLE
TST (C)+ ;GO TO THE NEXT ONE
TST SWPFCN-2(C) ;ARE THERE ANY FREE ONES?
BEQ FINSW1 ;NO, TRY FOR THE NEXT ONE
JSR PC,FINBIT ;TRY TO FIND A FREE BIT
BEQ FINSW1 ;LOSEY LOSEY
DEC SWPFCN-2(C) ;ONE LESS FREE ONE
ASH #3,B ;FROM 4K => 512
ADD SWPBDA-2(C),B ;GET THE REAL DISK ADDRESS
MOV B,PBDA(F) ;SET IN THE DISK ADDRESS
BIC #PBVASS!PBSTS,(F) ;SHOULD NOT BE SWAPPED TO SOURCE, NOT VALID AT SWAP SPACE
MOV SWPBDK-2(C),D ;GET THE DISK
ASH #PBDISS,D ;PUT IT IN THE RIGHT PLACE
BISB D,PBRAN(F) ;SET IT IN
ACRETC: JSR F,ACRES
CLZ
RTS PC
ACRETS:
FINSW8: JSR F,ACRES
SEZ
RTS PC
;FIND A FREE BIT IN A RANDOM BT TABLE AND SET IT
;CALL WITH START OF TABLE IN A, END IN B
;SEZ IF CAN'T FIND ONE
;IF YOU WIN, A GETS THE POINTER TO TH WORD AND B GETS THE BIT NUMBER
FINBIT: SAVE <C,A>
FINBI1: CMP A,B ;OFF THE END OF THE TABLE
BHIS FINBI7 ;YUP, NO BITS FOR YOU
CMP #-1,(A)+ ;ANY FREE BITS IN THIS WORD?
BEQ FINBI1 ;NOPE, TRY THE NEXT
CLR B ;CLEAR A COUNTER
MOV -(A),C ;GET THE WORD IN QUESTION
FINBI2: ROR C ;GET THE LOW ORDER BIT
BCC FINBI3 ;IF CARRY IS CLEAR, THATS THE ONE WE WANT
SOB B,FINBI2 ;CHUCKLE
;WE NEVER (I HOPE) FALL THROUGH THE SOB
FINBI3: NEG B ;MAY HAVE SAVED SOME CYCLES WITH THIS TRICK
ASL B ;GET A WORD INDEX
BIS BITS(B),(A) ;SET THE RIGHT BIT
ASR B ;ADJUST BACK
SUB (P),A ;OFFSET FROM START OF TABLE
ASH #3,A ;MULITPLIED BY 16
ADD A,B ;GIVES BIT NUMBER IN TABLE
REST <A,C>
CLZ ;WIN
RTS PC
FINBI7: REST <A,C>
SEZ ;LOSE
RTS PC
;FREE THE SWAP AREA USED BY THE PB IN B
PBSFRE: BIT #PBSTS,(B) ;DOES IT HAVE SWAP SPACE?
BNE PBSFR3 ;NO SPACE, DON'T FREE IT!
JSR F,ACSAV
CLR C ;POINTER TO THE BIT TABLE TABLES
MOVB PBRAN(B),A ;GET THE DISK NUMBER
BIC #PBDSKM,A ;MASK THE DISK # OFF
ASH #-PBDISS,A ;SHIFT IT TO A REASNABLE SPOT
MOV PBDA(B),E ;MAKE THE DISK ADDRESS EASY TO GET AT
PBSFR1: CMP A,SWPBDK(C) ;IS IT MAYBE IN THIS BIT TABLE?
BNE PBSFR2 ;NOPE
CMP E,SWPBDA(C) ;IS IT AFTER THE START
BLO PBSFR2 ;NOPE (???)
CMP E,SWPEDA(C) ;BUT BEFORE THE END
BHIS PBSFR2 ;NO
SUB SWPBDA(C),E ;MAKE IT RELATIVE TO THIS TABLE
MOV E,F ;NOW HAVE 2 COPIES
ASH #-6,E ;GET THE WORD NUMBER
BIC #160001,E ;EXTRA CRAP
ASH #-2,F ;THE BIT NUMBER
BIC #177741,F ;LIKEWISE
ADD SWPBPT(C),E ;POINT
BIC BITS(F),(E) ;CLEAR THE RIGHT BIT
INC SWPFCN(C) ;ONE MORE FREE
CLR PBDA(B) ;MAKE SURE HE DOESN'T USE IT AGAIN!
JSR F,ACRES
PBSFR3: RTS PC
PBSFR2: TST (C)+ ;GO TO THE NEXT BIT TABLE
TST SWPBPT+2(C) ;MAKE SURE IT ISN'T NON-EX
BNE PBSFR1 ;WIN
BPT ;LOSE
;ALLOCATE SWAP SPACE
;THIS CALL MAY ONLY BE EXECUTED BY THE SYSSPR
;THE 3 ARGS ON THE STACK ARE THE SIZE OF THESWAP SPACE
;IN BLOCKS, THE BLOCK ADDRESS OF THE START OF SWAP SPACE
;AND THE DISK NUMBER THAT THIS SWAP SPACE IS ON
;THE CALL IS EXECUTED ONCE FOR EACH SWAP SPACE TO BE ALLOCATED
EALLOC: JSR PC,SYSCHK ;CHECK THAT THIS IS SYSSPR
JSR PC,RETNSW ;GET THE DISK NUMBER
MOV A,E ;STORE IT AWAY
JSR PC,RETNSW ;GET THE NUMBER OF BLOCKS
MOV A,F ;AND SAVE IT
JSR PC,RETNSW ;FINNALLY, GET THE START
MOV #NSWPA,D ;NUMBER OF SWAP SPACES POSSIBLE
CLR C ;POINTER INTO SWAP SPACE TABLES
EALLO1: TST SWPBPT+2(C) ;IS THIS SPACE FREE?
;IF IT IS, NEXT SPACE BEGGINING=0
BEQ EALLO3 ;FOUND A FREE SPACE
TST (C)+ ;TRY THE NEXT
SOB D,EALLO1 ;UNLESS WE RUN OUT
ERROR BAD ;SYSSPR WAS BAD, SLAP ITS WRIST
EALLO3: MOV E,SWPBDK(C) ;SAVE THE DISK NUMBER
MOV A,SWPBDA(C) ;AND SAVE THAT AS THE START
MOV SWPBPT(C),D ;GET THE POINTER TO THIS BIT TABLE
ADD F,A ;GET END BLOCK
MOV A,SWPEDA(C) ;STORE IT AWAY
ASH #-3,F ;CONVERT TO 4K BLOCKS
MOV F,SWPFCN(C) ;SAVE COUNT OF FREE SWAP SPACES
EALLO4: CLR (D)+ ;16 FREE BITS
SUB #20,F ;ALLOCATE 16 SWAP SPACES
BGT EALLO4 ;MORE
BEQ EALLO6 ;A FULL WORD OF BITS
MOV #100000,E ;GET A BIT
INC F ;CAUSE ONE BIT IS ALREADY SET
ASH F,E ;SET THE BITS IN THE HIGH PART OF THE WORD
BIS E,-(D) ;PUT THEM IN THE WORD WE JUST CLEARED
EALLO6: TST (D)+ ;GO TO THE FIRST FREE WORD
CMP D,#SWPBTE ;HIGHER THAN THE END OF THE TABLE?
BUGC HIS
MOV D,SWPBPT+2(C) ;SET THE START OF THE NEXT TABL
JMP ERETCZ ;WIN
.SBTTL SWAP IN/OUT AND ITEM SPACE ALLOCATE
;SWAP OUT PAGE WHOSE PB IS IN B
;BUT BE HAPPY IF THE PAGE GETS FREED OUT FROM UNDER US
SWPNMP: SAVE A
MOV ITM0A,A
BIS #PPBNMP,PFLAGS(A) ;SET THE MAGIC FLAG
JSR PC,SWPPAG ;DO THE SWAP
BIC #PPBNMP,PFLAGS(A)
REST A
RTS PC
;SWAP OUT PAGE WHOSE PB IS IN B
SWPPAG: JSR PC,PBULWT ;WAIT FOR IT TO BE HACKABLE
SAVE B
MOV PBGIP(B),B ;CONVERT PB TO GIP
JSR PC,PAGPCL ;PCLOSER EVERYONE WHO MIGHT DEPEND ON THIS PAGE
REST B ;GET BACK PB
SWPPG: JSR PC,SAVAWB ;IN CASE IT IS IN MY MAP
JSR PC,PBLCK ;NOW I LOCK IT!
JSR PC,VALSWP ;VALIDATE ON SWAP SPACE
JSR PC,PBWAIT ;WAIT FOR DISKING TO STOP
JSR PC,LSWPOP ;POP SWITCH, UNLOCKING BLOCK
BIT #PBVASS!PBVAS,(B) ;IS IT REALLY VALID AT SWAP, OR AT LEAST AT SOURCE?
BEQ SWPPAG ;NOPE, TRY AGAIN
JSR PC,PBCFRE ;FREE THE CORE IT TOOK
JMP MAPRES ;IN CASE MY MAP NEEDS UPDATEING
;GET CORE TO EXPAND ITEM SPACE
;CALL WITH DESIRED AMOUNT OF COORE IN A
ITMSEX: JSR F,ACSAV
INC A ;0=1
ITMSE1: MOV CST1NS,C ;POINT TO FIRST NON-SYSTEM BLOCK
ITMSE6: MOV A,D ;COPY FOR SOB
MOV C,E ;COPY START OF SPACE BEING GOBBLED
ITMSE2: BIT #CSTFRB,(C)+ ;IS THIS BLOCK FREE?
BEQ ITMSE4 ;NOPE, HAVE TO FREE IT
SOB D,ITMSE2 ;CHECK ALL THE BLOCKS WE WANT TO GOBBLE
SUB A,FREECR ;THAT MUCH LESS FREE CORE TOO
SUB A,USRCOR ;THIS MUCH WILL BE STOLEN FROM USERS
BUGC LE ;SYSTEM HAS ZERO OR NEGATIVE CORE FOR USERS!
MOV E,C ;POINT TO START AGAIN, THEY ARE ALL FREEE
SUB #CST,E ;CONVERT
ASR E ;TO BLOCK NUMBER
MOV E,2(P) ;RETURN THE START IN B FOR THE USER
ITMSE3: BIT #CSTFRB,(C) ;IS IT REALLY FREE?
BUGC EQ
BIS #CSTSYB,(C) ;USED BY SYSTEM
BIC #CSTFRB,(C)+ ;AND NO LONGER FREE
CMP C,CST1FR ;IS THIS THE FIRST FREE BLOCK?
BNE 1$
ADD #2,CST1FR ;NOT ANY MORE
1$: SOB A,ITMSE3 ;FOR ALL THE BLOCKS
JMP ACRET
ITMSE4: TST -(C) ;BACK TO BLOCK THAT ISN'T FREE
BIT #CSTSYB,(C) ;IS THIS BLOCK ALREADY USED BY THE SYSTEM?
BNE ITMSE5 ;YES, WE'LL IGNORE IT
MOV CSTPB-CST(C),B ;WHO IS THAT, ANYWAY
JSR PC,PCLDEF ;DEFERE A PCLOSER TILL WE ARE DONE
JSR PC,SWPNMP ;OUT WITH HIM!(NOT MY PAGE)
BR ITMSE1 ;GO TRY IT ALL AGAIN
ITMSE5: TST (C)+ ;GO HIGHER
CMP C,CSTTOP ;OFF THE TOP?
BUGC HIS ;UGH RAN OFF TOP
BR ITMSE6 ;TRY AGAIN
.SBTTL SEGMENT BREAK ROUTINES
SEGBRK: MOV SSR0,PSSR0 ;COPY INTO PSEUDO SEGMENT REGISTERS
MOV SSR1,PSSR1
MOV SSR2,PSSR2
BIC #174000,SSR0 ;RESUME MONITORING
MOV PSSR2,(P) ;GET THE PC WHERE THE INSTRUCTION STARTED
BIT #200,PSSR0 ;DID THE INSTRUCTION COMPLETE?
BUGC NE ;STRANGE, I DON'T THINK THIS SHOULD HAPPEN
BIT #140000,2(P) ;WAS IT FROM KERNAL MODE?
BEQ SEGKR ;YES, GO PROCESS IT LIKE A SUBROUTINE CALL
MOV PC,USRMOD ;FROM USER MODE, TREAT LIKE A SSYTEM CAL
SPL 0
JSR F,SPCPSP ;SAVE THE PS, PC AND P POINTER OF TH EUSER
JSR PC,PACSAV ;AND HIS ACS
MOV ITM0A,A ;POINT TO THE PROCESS BLOCK
ADD #PUREGS,A ;POINT TO SAVED REGISTERS
JSR PC,ACFIX ;FIX UP THE USERS REGISTERS
JSR PC,PAGIN ;SWAP IN THE PAGE
MOV ITM0A,B ;POINT TO THE PROCESS
JSR PC,PACRES ;RESTORE USERS REGISTERS
SAVE PUP(B) ;GET USERS P POINTER
MTPI P ;RESTORE IT
SAVE <PUPS(B),PUPC(B)> ;TO RETURN TO USER MODE
SPL CLKL ;PREVENT A SCHEDULE
CLR USRMOD ;THIS COULD CAUSE ONE
TST QUANT ;HAS HE OVERSTAYED HIS WELCOME?
BGE 1$ ;NO
BIS #CLKPIR,PIRQ ;GET HIM AFTER THE RTT
1$: CHECKP
RTT ;GO TO USER MODE
SEGKR: SPL 0
CLR -(P) ;SAVE A 0 VALUE FOR P
JSR F,ACSAV ;SAVE THE REST OF THE KERNAL REGISTERS
MOV PSSR0,A ;GET SEGMENTER STATUS
ASR A ;SHIFT
BIC #177700,A ;GET THE PAGE NUMBER THAT WE FAULTED ON
TSTB KERSBT(A) ;IS IT OK TO FAULT ON THIS PAGE FROM KERNAL?
BUGC EQ ;NO, UGH
BGT SEGKR1 ;YES, IT IS A USER PAGE
BIT #SEGNRA,PSSR0 ;THE ONLY LEGAL KERNAL PAGE TRAP
BUGC EQ ;IS NON-RESIDENT
SEGKR1: MOV P,A ;A POINTER TO THE KERNAL REGISTERS
JSR PC,ACFIX ;FIX THEM UP
JSR F,ACRES ;GET BACK THE FIXED UP ACS
TST (P) ;DOES KERNAL P NEED FIXING?
BUGC LT ;CAN'T WIN IF NEED TO ADD TO IT
ADD (P),P ;CORRECT THE P STACK (REMOVE THINGS PUSHED)
TST (P)+ ;AND FLUSH THE DUMMY P VALUE
SAVE <A,B> ;SAVE THE CORRECTED ACS ON THE CORRECTED STACK
JSR PC,PAGIN ;TRY TO SWAP IN THE PAGE
REST <B,A> ;RESTORE THE KERNAL REGISTERS
CHECKP
RTT ;RETURN FROM THIS "SUBROUTINE"
;FIX UP THE REGISTER SET POINTED TO BY A
ACFIX: MOV #2,F ;DO IT TWICE
MOV PSSR1,E ;GET THE CORRECTION VALUES
ACFIX1: MOVB E,B ;GET ONE OF THEM
BEQ ACFIX2 ;ZERO, ALL DONE
BIC #177770,B ;WHCIH REGISTER?
CMP #7,B ;NEVER FIX UP THE PC
BEQ ACFIX2 ;SSR2 TAKES CARE OF THAT
ASL B ;WORD INDEX
MOVB E,C ;GET THE AMOUNT(SIGN EXTENDED)
ASH #-3,C ;THEN FLUSH THE REGISTER # AND SIGN EXTEND MORE
ADD A,B ;POINT TO THE STORED REGISTER VALUE
SUB C,(B) ;CORRECT IT
ACFIX2: SWAB E ;FOR THE SECOND ONE
SOB F,ACFIX1 ;DO IT AGAIN
ACFIX3: RTS PC
;SWAP IN THE PAGE THAT WE FAULTED ON, OR GIVE THE USER AN ERROR
;IF THE FAULT WAS NOT NON-RESIDENT OR THE PAGE IS NON-EX
PAGIN: MOV PSSR0,A ;GET STATUS
BIT #SEGNRA,A ;NON-RESIDENT?
BEQ PAGERR ;NO, ERROR ON THE PART OF THE USER
ASR A ;CONVERT TO PAGE NUM
BIT #60,A ;IS IT A KERNAL PAGE?
BEQ PAGIN1 ;YES, BETTER BE ITEM2
BIC #177760,A ;GET PAGE NUMBER
MOV A,B ;COPY IT
MUL #UPTLEN,B ;MAKE A POINTER
ADD ITM1A,B ;INTO THE SPHERE'S
ADD #SUPTS,B ;UPTS
TST (B) ;DOES THE PAGE EXIST?
BEQ PAGACV ;NXM ERRROR
MOV UPTPBP(B),B ;GET THE PB TO SWAP IN
JSR PC,PBULWT ;MAKE SURE IT IS UNLOCKED
JSR PC,SAVAWB ;SAVE THE W BITS
JSR PC,PBSWPI ;GO DO IT
JMP MAPRES ;RESTORE THE MAP WITH THE NEW PAGE
PAGIN1: BIC #177700,A ;CLEAR CRAP
CMP #<<ITM2AR-I0AR>/2>,A ;IS IT ITEM2?
BUGC NE
MOV ITEM2,B ;GET THE ITEM
JSR PC,SWPIN ;SWAP IT IN
MOV ITEM2,A ;NOW
JMP ITM2LD ;RELOAD IT
PAGERR: MOV ITM0A,A ;THE PROCESS
BIT #SEGSLE,PSSR0 ;SEGMENT LENGTH ERROR?
BNE PAGSLE ;ITS SET
BIT #SEGRVI,PSSR0 ;READ ONLY VIOLATION?
BNE PAGRDO ;READ ONLY PAGE
BPT
PAGSLE: MOV #100000+.SLETF,PFAULT(A) ;SEGMENT LENGTH ERROR
SEGFLT: CMP (P)+,(P)+ ;POP OFF SSR0,SSR1, AND RETURN ADDRESS
JMP CFAULT ;HE LOSES
PAGRDO: MOV #100000+.RDOTF,PFAULT(A) ;READ ONLY FAULT
BR SEGFLT ;FAULT HIM
PAGACV: MOV ITM0A,A ;POINT TO PROCESS
MOV #100000+.NXMTF,PFAULT(A) ;NON EXISTANT MEMORY FAULT
BR SEGFLT
;SWAP IN THE PAGE POINTED TO BY THE GIP IN B
SWPIN: SAVE B
JSR PC,UPTPLD ;GET THE UPT FOR THE PAGE
MOV UPTPBP(B),B ;GET THE POINTER TO THE PAGE BLOCK
JSR PC,ITM2PO ;PUSHED BY UPTPLD
JSR PC,PBSWPI ;SWAP IN THE PAGE
REST B
RTS PC
;SWPA IN THE PAGE REPRESENTED BY THE PB IN B
;THIS ROUTINE TAKES CARE OF MAKING SPACE IN CORE BY SWAPPING
;OUT PAGES AND/OR DEACTIVATING OTHER USERS AS NEEDED
PBSWPI: JSR PC,PBWAIT ;MAKE SURE PAGE IS AVAILABLE
BIT #PBVACR,(B) ;ALREADY IN CORE?
BNE PBSWP1 ;YES, NOTING TO DO
JSR PC,FINPAG ;TRY TO FIND A PLACE TO PUT IT
BEQ PBSWP2 ;UGH, HAVE TO WORK FOR OUR CORE
JSR PC,VALCOR ;SWAP IT IN
BR PBSWPI ;AND WE SHOULD BE ALL SET
PBSWP1: RTS PC
PBSWP2: JSR PC,CRFREE ;GO OFF TO FREE SOME CORE
BR PBSWPI ;AND TRY AGAIN
.SBTTL SWAP SCHEDULING ROUTINES
;THE PROCESS IN A IS ABOUT TO BE MOVED TO THE QUQUE IN B
;IF THE PAGES THE PROCESS USES SHOULD BE ACTIVIATED OR DEACTIVATED
;THIS ROUTINE WILL DO IT
PRSAOD: JSR F,ACSAV ;GORSS
MOV PRTPPT(A),A ;GET ITEM #
JSR PC,ITM0PL ;LOAD PROCESS
BIT #WINQB!ACTQB!DORQB,PQBIT(A) ;ARE THE PAGES ACTIVE NOW?
BEQ PRSAC1 ;NO, GO SEE IF WE SHOULD ACTIVATE
BIT #WINQB!ACTQB!DORQB,QBIT(B) ;ARE WE GOING TO AN ACTIVE QUQE?
BNE PRSAO1 ;YES, DO NOTHING
MOV #PBDACT,F ;MUST DEATIVATE PAGES
MOV #-1,C ;ONE LESS ACTIVE
BR PRSAO2 ;GO DO IT
PRSAC1: BIT #RUNQB!IACTQB!STOPQB!PFREQB,QBIT(B) ;ARE WE GOING TO AN INACTIVE QUQE?
BNE PRSAO1 ;YES, DO NOTHING
MOV #PBACT,F ;NO, ACTIVATE THE PAGES
MOV #1,C ;ONE MORE ACTIVE
PRSAO2: MOV PPRTPT(A),B ;GET POINTER TO PROCESS TABLE ENTRY
MOV HSECS,PRTTIM(B) ;TIME THAT THIS PROCESS WENT ONTO THIS QUQUE
MOV PSPHRP(A),A ;GET THE SPHERE
JSR PC,ITM1PL ;LOAD IT UP
ADD C,SPHAPR(A) ;ONE MORE OR LESS ACTIVE
ADD #SUPTS,A ;POINT TO THE UPTS
MOV #16.,D ;PROCESS ALL 16 OF THEM
PRSAO3: TST (A) ;DOES IT EXIST?
BEQ PRSAO4 ;NO, IGNORE IT
BIT #UPTABS,(A) ;IS IT AN ABSOLUTE PAGE?
BNE PRSAO4 ;YES, LEAVE IT ALONE
MOV UPTPBP(A),B ;GET ITS PAGE BLOCK
MOV #1,C ;ONLY ONE PROCESS
JSR PC,(F) ;CALL APPROPRIATE ROUTINE
PRSAO4: ADD #UPTLEN,A ;NEXT
SOB D,PRSAO3
JSR PC,ITM1PO
PRSAO1: JSR PC,ITM0PO
JMP ACRET
PBDACT: SUB C,PBAUSR(B) ;ONE LESS ACTIVE PROCESS USING THIS PAGE
BUGC LT ;FIX THIS
BNE PBDAC2 ;ALREADY NON-ZERO
SAVE A
MOVB PBLEN(B),A ;GET THE LENTGH OF THE PAGE BEING DEATIVATED
SUB A,ACORE ;THAT MUCH LESS ACTIVE CORE
BIT #PBVACR,(B) ;IS IT VALID IN CORE?
BEQ PBDAC3 ;NO, DON'T PUT ON SWAP OUT LIST
MOV #PBSWPO,A ;SIMPLE LINEAR SWAP OUT LIST
1$: TST (A)+ ;LOOK FOR A FREE ENTRY
BNE 1$
CMP #PBSWOE,A ;DID WE GET TOT THE END?
BUGC EQ ;OOPS, TRYING TO PUT TOO MANY PAGES ON SWAP OUT LIST
MOV B,-(A) ;PUT IT ON THE LIST
INC NPBSWO ;ONE MORE PAGE TO BE SWAPPED OUT
PBDAC3: REST A
PBDAC2: RTS PC
;ACTIVATE PAGE POINTED TO BY B
PBACT: TST PBAUSR(B) ;IS IT ALREADY ACTIVE?
BNE PBACT1 ;YUP, NOTHING TO DO
SAVE <A,C>
MOVB PBLEN(B),A ;LENGTH OF PAGE BEING ACTIVATED
ADD A,ACORE ;MORE ACTIVE CORE
JSR PC,PBNSWP ;TAKE OFF SWAP OUT LIST IF ON IT
REST <C,A>
PBACT1: ADD C,PBAUSR(B) ;INC THE COUNT
RTS PC
;IF THE PB IN B IS ON THE SWAP OUT LIST, TAKE IT OFF
PBNSWP: SAVE A
MOV #PBSWPO,A ;IS IT ON SWAP OUT LIST?
PBNSW2: CMP B,(A)+ ;THIS ONE?
BNE PBNSW3 ;YUP, SAVE HIM
DEC NPBSWO
CLR -(A)
PBNSW3: CMP #PBSWOE,A ;AT END OF LIST?
BNE PBNSW2 ;NOT YET
PBNSW4: REST A
RTS PC
;FREE UP SOME CORE, MOVING PROCESSES FROM DORMANT TO INACTIVE OR
;ACTIVE TO RUNNING AS NEEDED
CRFREE: JSR F,ACSAV
CRFRE1: CMP #NDRQBL-4,DRQFCN ;ARE THERE MANY ACTIVE DISK TRANSFERS?
BLT CRFRE3 ;NO, LETS DO SOME
CRFRE2: JSR PC,SFLUSH ;WAIT FOR THINGS TO CALM DOWN
CMP #NDRQBL-4,DRQFCN ;HAVE THEY?
BGE CRFRE2 ;NOPE
JSR PC,RUNME ;MAYBE NOW THERE WILL BE ROOM
CMP #8,FREECR ;IS THERE AT LEAST 4K?
BLE CRFRE9 ;YES, ASSUME THERE MIGHT BE ENOUGH FREE
CRFRE3: TST NPBSWO ;ANY PAGES WAITING TO BE SWAPPED OUT?
BEQ CRFRE4 ;NO, BETTER MAKE SOME
MOV #PBSWPO,A ;POINT TO THE SWAP OUT LIST
1$: MOV (A)+,B ;LOOK FOR A NON-ZERO ENTRY
BEQ 1$
CMP #PBSWOE,A ;WITHIN THE TABLE?
BUGC LOS ;UGH
DEC NPBSWO ;ONE LESS ENTRY
CLR -(A) ;FLUSH IT
CRFRE8: BIT #PBUSED,(B) ;REALLY STILL THERE?
BEQ CRFRE3 ;NO, TRY AGAIN
JSR PC,SWPNMP ;SWAP IT OUT (NOT MY PAGE)
JSR PC,PCLCHK ;MUST PCLOSER SELF IF SWAPPED OUT MY OWN PAGE
CRFRE9: JMP ACRET ;MAYBE NOW THERE WILL BE SPACE
CRFRE4: CMP #12.,FREECR ;IS THERE MORE THAN 6K FREE?
BLE CRFRE7 ;THEN THINGS ARE IN BAD SHAPE
MOV #DORQ,A ;SEE IF ANYONE ON THE DORMANT QUEUE
MOV #IACTQ,E ;WOULD LIKE TO BECOME INACTIVE
JSR PC,CRFREL
BNE CRFRE3 ;GOT ONE, GO SWAP OUT A PAGE OF HIS
MOV #ACTQ,A ;HAVE TO REMOVE AN ACTIVE USER
MOV #RUNQ,E ;TO THE RUNQ
JSR PC,CRFREL
BNE CRFRE3 ;GOT ONE, GO SWAP
BR CRFRE2 ;UGH BLETCH!!!!!!
CRFRE7: INC LOGJAM ;ANOTHER DAY, ANOTHER LOGJAM
MOV CSTROV,A ;ROVING CSTPB POINTER
1$: MOV (A)+,B ;GET A PB
BNE 2$ ;FOUND ONE
BIT #CSTBEB,CST-CSTPB(A) ;COME TOT HE END OF THE CORE?
BNE 1$ ;NOPE
MOV #CSTPB,A ;RESET POINTER
BR 1$
2$: MOV A,CSTROV ;FOR THE NEXT TIME
BR CRFRE8
CRFREL: JSR PC,GLQTIM ;GET THE GUY LONGEST ON THE QUEUE
TST A ;ANYONE ON?
BEQ CRFRL1 ;NOPE
MOV E,B ;MOVE HIM TO A LESS FAVORED POSITION
JSR PC,PRSAOD ;DEACTIVATE HIS PAGES
JSR PC,TQUEUE ;AND MOVE HIM
CLZ
CRFRL1: RTS PC
.SBTTL RANDOM UTILITIES FOR MUNGING WITH CORE TABLES
;CONVERT THE GIP IN B TO A PAGE BLOCK POINTER IN B
GIPPB: SAVE A
MOV #-1,A
JSR PC,ITM1PL ;DO A DUMMY PUSH
TST B ;MAKE SURE WE HAVE A GIP
BUGC GT ;WHATCH OUT FOR REAL ITEMS
BIT #GIPSPR,B ;IS IT A SPHERE GIP?
BEQ GIPPB1 ;NOPE
MOV B,A ;COPY IT
BIC #GIPITM,A ;GET THE ITEM PART
ASH #2,A ;MAKE IT A REAL ITEM INDEX
JSR PC,ITM1LD ;LOAD IT UP
ADD #SUPTS,A ;POINT INTO UPTS
BIC #GIPUPT,B ;GET THE UPT #
ASH #-10.,B ;INTO THE RIGHT PLACE
MUL #UPTLEN,B ;MAKE IT AN INDEX
ADD A,B ;REAL POINTER
BR GIPPB2
GIPPB1: BIC #GIPBIT,B ;CLEAR THE EXTRA BIT
GIPPB2: MOV UPTPBP(B),B ;GET THE PAGE BLOCK POINTER
JSR PC,ITM1PO
REST A
RTS PC
;GET A FILE PAGE BLOCK, SETTING THE LENGTH TO WHAT
;IS IN B. RETRUN POINTER TO PAGE BLOCK IN B
;SET PBFILE BUT NOT PBZERO
;SWAP SPACE IS NOT ALLOCATED
;WILL HANG FOREVER FOR PB IF NONE AVAILABLE
FPBGET: SAVE <A,B>
MOV #FPBFRE,B ;POINTER TO FILE PAGE BLOCKS
JSR PC,FREEGT ;GET ONE
MOV #PBUSED!PBFILE!PBVAS!PBSTS,(A) ;INDICATE IT IS A FILE BLOCK
BR PBGET1 ;GO JOIN NORMAL PB GETTING
;GET A REGULAR PAGE BLOCK, ARGS AND RETURNS
;JUST LIKE FPBGET, EXCEPT IT SETS PBZERO AND NOT PBFILE
PBGET: SAVE <A,B>
MOV #PBFREL,B ;POINTER TO REGULAR FREE LIST
JSR PC,FREEGT ;GET THE BLOCK
MOV #PBUSED!PBZERO,(A) ;ZERO BLOCK ON FIRST SWAP IN
PBGET1: JSR PC,FREELK ;MAKE A LOCK THAT WILL PUT IT BACK ON THE FREE LIST
MOVB (P)+,PBLEN(A) ;POP THE LENGTH OFF THE STACK
CLRB PBRAN(A) ;CLEAR THE RANDOM BYTE
CLR PBAUSR(A) ;NO ACTIVE USERS (???)
CLR PBGIP(A) ;DOESN'T POINT AT GIP
MOV A,B ;COPY POINTER TO THE PB
REST A
RTS PC
;LOCK THE "LOCKED" BIT IN THE PB POINTED TO BY B
;TO BE UNLOCKED WHENEVER SWITCH IS POPED
PBLCK: SAVE <A,B,C>
JSR PC,PBWAIT ;WAIT FOR ANY DISKING TO STOP
MOV B,A
MOV #PBLOCK,B ;BIT TO LOCK
CLR C ;NO ITEM
JSR PC,LCKASW ;LOCK IT
REST <C,B,A>
MOV (P),PBLKPC(B) ;SAVE PC
MOV PRUNNG,PBLKPS(B) ;AND PROCESS
RTS PC
;GET A NODE OUT OF A STANDARD FREE LIST
;B CONTAINS POINTER TO FREE POINTER
;ON RETURN A CONTAINS POINTER TO GOBBLED NODE
;ROUTINE WILL HANG FOREVER WAITING FOR NODE
FREEGT: TST (B) ;ANY FREE ONES?
BNE FREEG2 ;YES, GO GOBBLE
FREEG1: JSR PC,SFLUSH ;WAIT A LITTLE
TST (B) ;ANY?
BEQ FREEG1 ;NOPE
JSR PC,RUNME ;HOPE ITS STILL THERE WHEN I GET BACK
BR FREEGT ;TRY AGAIN
FREEG2: MOV (B),A ;THE FREE ONE
MOV (A),(B) ;FREE POINTER NOW POINTS AT NEXT FREE
RTS PC
;LOCK A STANDARD NODE OFF A FREE LIST
;NO PROCESSING IS DONE ON PCLOSERING EXCPET FREEING THE
;NODE, SO BE CAREFUL HOW YOU USE THIS!
;ON ENTRY, A POINTS TO THE NODE AND B POINTS
;TO THE FREE POINTER FOR THIS TYPE OF NODE
FREELK: SAVE <A,B>
MOV #LSPULN,A ;AN UNLINK TYPE OF LOCK
CLR B ;NO ITEM
JSR PC,LOCKSW ;GET A LOCK BLOCK
MOV (P),LCKWD2(A) ;LOCK WORD 2 POINTS TO THE FREE POINTER
MOV 2(P),LCKWD1(A) ;WORD ONE POINTS TOT EH NODE
REST <B,A>
RTS PC
;THIS CROCK WILL FREE A LOCKED LIST NODE IF YOU FAIL IN
;SOME WAY OTHER THAN PCLOSERING BY PRETENDING TO PCLOSER
;FOR THE TOP SWITCH
FRELSE: MOV PC,BPCLSR ;SAY WE ARE PCLOSERING
JSR PC,LSWPOP ;POP THE SWITCH
CLR BPCLSR ;PREVIOUS STATEMENTS ARE NOW INOOPERATIVE
;(WE LIED)
RTS PC
.SBTTL CORE HACKING ROUTINES
;INTIAL MAP-SETTING ROUTINE
;CLOBBERS MOST AC'S, INTENDED TO BE RUN ONLY AT ITIALIZE TIME
;OR AFTER A POWER FAIL RESTART
MAPSET: MOV #I0AR,A ;FIRST WE'LL SET UP A STRAIGHT MAP
CLR B ;I AND D SPACE THE SAME AND MAPPED DIRECTLY
MOV #8.,C ;FROM VIRTUAL CORE TO PHYSICAL
MAPST1: MOV #77406,VAR0DR-I0AR(A) ;DATA SPACE 4K SEGEMNET
MOV #77406,I0DR-I0AR(A) ;INSTRUCTION SPACE 4K SEGMENT
MOV B,VAR0AR-I0AR(A) ;VIRTUAL MAPPED DIRECTLY TO PHYSICAL
MOV B,(A)+ ;FOR BOTH INST AND DATA SPACE
ADD #200,B ;4K WORTH
SOB C,MAPST1 ;DO FORR 8 SEGMENTS
;NOW WE'LL HACK THE SPEECAIL THINGS
MOV #7600,IOAR ;MAP USUAL I/O SPACE TO REAL I/O SPACE
;THE FOLLOWING THING IS THE DR FOR THE RUG PAGES (UGH!)
FOO==<<200-<<RUGIDR-I0DR+2>*100>+<<RUGST_-6>&1777>>_8.>+16
MOV #FOO,RUGDDR ;MAP 156000-157776 VIRTUAL TO SAME PHYSICAL
MOV #VAR2DR,A ;NOW FLUSH UNUSED VARIABLE PAGE AND 3 ITEM PAGES
CLR (A)+
CLR (A)+
CLR (A)+
CLR (A)
MOV #I7DR,A
CLR (A) ;FLUSH HIGH INSTRUCTION PAGE
TST -(A) ;DON'T CLOBBER RUG PAGE
MOV #120000,B ;FIRST LOCATION IN A PAGE BEFORE RUG PAGE
MAPST2: CMP #LSTILC,B ;LAST INSTRUCTION LOCATION
BHI MAPST3 ;IF THERE IS SOMETHING THERE, WE'RE DONE
CLR -(A) ;NO ONE THERE, FLUSH IT
SUB #20000,B ;NEXT PAGE DOWN
BR MAPST2
MAPST3: MOV #7,SSR3 ;ENABLE I AND D FOR ALL MAPS
MOV #1,SSR0 ;THERE WE GO!!
RTS PC
;MAP RESTORE ROUTINE
;CLOBBERS NO REGISTERS
;EXPECTS THE SPHERE TO RESTORE IN ITEM1
;DOES NOT RESTORE IF CURSPH IS SAME AS ITEM1
MAPRES: CMP CURSPH,ITEM1 ;IS IT ALREADY LOADED?
BNE 1$ ;NO
RTS PC
1$: CMP #-1,CURSPH ;IS THERE A SPHERE MAPPED IN?
BUGC NE ;UGH, THAT MEANS HIS W BITS DIDN'T GET COPIED OUT!
MAPRE1: MOV ITEM1,CURSPH
JSR F,ACSAV ;THIS IS THE ENTRY POINT FOR RESTORING THE MAP EVERY TIME
MOV #20,A ;FOR ALL PAGES
MOV #USRISD,B ;ALL DR'S
1$: CLR (B)+ ;MAKE NON-EX
SOB A,1$
MOV ITM1A,A ;POINTER TO THE ITEM
ADD #SUPTS,A ;GET POINTER TO UPTS FOR SPHERE
CLR B ;POINT TO USER MAP
MOV #20,C ;NUMBER OF SEGMENTS TO LOAD
MAPRE2: TST (A) ;DOES THE PAGE EXIST?
BEQ MAPRE3 ;NO PAGE HERE
MAPRE7: BIT #UPTABS,(A) ;IS IT AN ABS PAGE?
BNE MAPRE8 ;YUP, GO LOAD IT
BIT #UPTDEI,(A) ;IS IT THE DATA PART OF A D=I ?
BNE MAPRE3 ;YUP, GO IGNORE IT
MOV UPTPBP(A),D ;GET A POINTER TO THE PAGE BLOCK
BEQ MAPRE3 ;NO PB=>NO PAGE
BIT #PBVACR,(D) ;IS THE PAGE IN CORE?
BEQ MAPRE3 ;NOPE, IGNORE IT
BIT #PBLOCK!PBDISK,(D) ;LOCKED OR IN DISK TRANSFER?
BNE MAPRE3 ;IF SO, IGNORE IT
MOVB UPTSTL(A),E ;GET THE UPT START AND LENGTH
BIC #UPTSMS,E ;CLEAR OFF CRAP
ASH #-UPTSSH,E ;SHIFT TO GET # OF START BLOCK
MOVB PBRAN(D),F ;TO GET PB START
BIC #PBSTRT,F ;IT IS IN BLOCKS
SUB F,E ;GETS HOW FAR PAST PB START UPT START IS
ADD PBCAR(D),E ;WHICH TELLS US WHAT TO ADD TO THE CORE ADDRESS
ASH #4,E ;32.=512.
BIT #UPTEXD,(A) ;IF IT IS EXPAND DOWN
BUGC NE ;WE HAVE TO DO SPECIAL STUFF
MOV E,USRISA(B) ;LOAD THE AR
MOVB UPTSTL(A),E ;NOW TO GET THE START TO USE
BIC #UPTLMS,E ;GET THE START
ASH #12.,E ;GET INTO DR FORMAT
BIS #17_8.,E ;FIX FOR THE SEGMENTER
MOV #4,F ;READ/WRITE TRAP (TRAP IS NOT ENABLED THOUGH)
BIT #UPTRDO,(A) ;IS IT READ-ONLY?
BEQ 1$ ;NO, READ-WRITE
MOV #1,F ;READ-ONLY, TRAP
1$: BIS F,E ;SET INTO DR WORD
MOV E,USRISD(B) ;SET INTO THE DR
MAPRE6: BIT #UPTIED,(A) ;IS THIS TH EI SPACE HALF OF AN I=D?
BEQ MAPRE3
MOV USRISD(B),USRDSD(B) ;COPY THE DR
MOV USRISA(B),USRDSA(B) ;COPY THE AR
MAPRE3: TST (B)+ ;NEXT
ADD #UPTLEN,A
DEC C
BEQ 1$
JMP MAPRE2
1$:
.IFNZ TVS
MOVB #73,TVSHR+1 ;SET THE THING INTO MEMORY
MOV ITM0A,A ;POINTER TO ITEM 0
MOVB PTVMAP+1(A),TVSEL ;SET SELECT REGISTER
MOVB PTVMAP(A),D ;SET >0 IF HE WANTS IT IN HIS MAP
BMI MAPRE0 ;DOESNT WANT IT
CLR TVMSK ;NO MASKING
ASL D ;FOR INDEXING
MOV #4,E ;MAX NUMBER OF DISPLAY PAGES
MOV #6600,F ;THE APPROPRIATE AR
MAPRE4: CMP #20,D ;PAST ALL THE POSSIBLE D PAGES?
BLOS MAPRE0 ;THEN WE'RE DONE
MOV #77406,USRDSD(D) ;A FULL 4K PAGE
MOV F,USRDSA(D) ;WHERE THE DISPLAY IS
ADD #200,F ;4K MORE
TST (D)+ ;NEXT PAGE
SOB E,MAPRE4
.ENDC
MAPRE0: JSR F,ACRES
MAPRE9: RTS PC
MAPRE8: MOV UPTPBP(A),USRISA(B) ;PB POINTER IS THE AR
MOV UPTGIP(A),USRISD(B) ;GIP POINTER IS THE DR
BR MAPRE6 ;CHECK FOR I=D
;THE MEMORY TABLE INITIALIZER
;CLOBBERS ALL REGISTERS
MEMTST: MOV #20,ITM0AR ;FIRST FIND HOW MUCH MEMORY
MOV #6,ITM0DR ;LENGTH 1 PAGE
SAVE BEBRV ;SAVE THE BUSS ERROR VECTOR
MOV #MEMTS1,BEBRV ;TRAP BACK TO THE ROUTINE
MOV #MNCBLK,A ;THE MOST WE WILL PAY ATTENTION TO
MOV #CST,B
MEMTS2: TST ITM0AD ;CAUSE BUSS ERROR IF NXM
ADD #20,ITM0AR ;INCREMENT BY 512 WORDS
MOV #CSTBEB!CSTSYB,(B)+ ;SAY IT EXISTS AND SYSTEM USING IT
SOB A,MEMTS2 ;TRY AGAIN UNLESS WE HAVE ENOUGH
MOV B,CSTTOP
BR MEMTS3
MEMTS1: SPL 0
MOV B,CSTTOP
CMP (P)+,(P)+ ;FLUSH THE TRAP
1$: MOV #CSTSYB,(B)+ ;SAY THE SYSTEM IS USING NON-EX CORE
SOB A,1$
MEMTS3: REST BEBRV
MOV ITM0AR,B
.IF NZ NTVS
CMP #<124.-16.>*<1024./32.>,B ;DOES CORE CONFLICT WITH DISPLAY?
BUGC LO
.ENDC
SUB #20+<<<RUGIAR-I0AR>+2>*100>,B ;CONVERT TO AMOUNT ABOVE RUG
BUGC LE ;IS THERE ENOGUH FOR RUG
ASH #-4,B ;CONVERT TO 512 WORD BLOCKS
MOV #<<RUGIAR-I0AR>+2>*4,A ;FIRST BLOCK AFTER RUG
.IIF NZ NTKDIS,JSR PC,DISALC
ASL A ;CONVERT TO
ADD #CST,A ;INDEX IN TO THE CST
MOV B,FREECR ;AMOUNT OF FREE CORE
MEMAL1: BIC #CSTSYB,(A) ;NOT USED BY SYSTEM
BIS #CSTFRB,(A)+ ;AND FREE
SOB B,MEMAL1
MOV #CST+<FSTFRB*2>,A ;POINT TO FIRST FREE CST ENTRY
MOV #<<<RUGST-LSTILC>_-10.>>&77-1,B ;NUMBER FREE BEFORE RUG
ADD B,FREECR
MOV FREECR,USRCOR ;ALL FREE CORE IS CURRENTLY USER CORE
MEMAL2: BIC #CSTSYB,(A)
BIS #CSTFRB,(A)+ ;FREE BLOCK, NOT USED BY SYSTEM
SOB B,MEMAL2
MOV #CSTSYB!CSTBEB,CST+<<RUGST_-9.>&176> ;PROTECT RUG PAGE
RTS PC
.IFNZ NTKDIS
;DISPLAY ALLOCATION ROUTINE
;ENTER WITH PLACE TO START ALLOCATING IN A
;NUMBER OF BLOCKS FREE IN B
;RETURN WITH A POINTING PAST WHAT WE HAVE ALLOCATED
;AND B HAVING WHAT WE HAVE ALLOCATED REMOVED
DISALC: CMP #100,A ;THE DISPLAYS MUST START
NBUGC LE
MOV A,C ;SAVE START
ASH #10.,C ;CONVERT TO WORD ADDRESS
MOV C,TKRELS ;AND SAVE AS THE RELOCATION
MOV C,NGREL ;ALSO SET RELOCATION
MOV #1,C ;LENGTH ONE BLOCK
JSR PC,ITMFAK ;FAKE UP AN ITEM
MOV D,TKDPDL ;THE PDL AND START VECTOR ITEM
MOV ITMTAB(D),TKDPDA ;SAVE THE START IN A CONVEINET PLACE
CLR E ;THE ONE WE ARE ALLOCATING
MOV #NTKDIS,F
DISAL1: MOV TKDLEN(E),C ;LENGTH FOR THIS ONE
JSR PC,ITMFAK ;FAKE UP AN ITEM
MOV D,TKDITM(E) ;SAVE THE ITEM FOR THIS DISPLAY BUFFER
TST (E)+
SOB F,DISAL1
SAVE <A>
MOV TKDPDL,A ;THE PDLS AND START WORDS
JSR PC,ITM2LD
MOV #8.,C
DISAL2: MOV #DSTOP,(A)+ ;STOP ALL DISPLAYS
SOB C,DISAL2
REST <A>
RTS PC
;FAKE UP AN ITEM
ITMFAK: SAVE <C>
MOV ITMFRE,D ;THE ITEM LIST
MOV (D),ITMFRE ;TAKE THIS ITEM
ASH #4,C ;MAKE LENGHT INTO 32. WORD BLOCKS
DEC C ;CAUSE OF WAY SEGMENTS WORK
MOVB C,ITLNGT(D) ;SET LENGHT
MOVB #ITACCD,ITACCS(D) ;AND ACCESS
MOV A,C ;COPY START
ASH #4,C ;MAKE IT INTO 32. WORD BLOCKS
MOV C,(D) ;SET THE ADDRESS INTO THE ITEM
SUB #ITMTAB,D ;MAKE IT INTO AN ITEM NUMBER
REST <C> ;RESTORE LENGHT IN 512. WORD BLOCKS
ADD C,A ;NEXT PLACE TO ALLOCATE
SUB C,B ;STUFF WE'VE USED
BUGC LE
RTS PC
.ENDC
;TRY TO FIND A NUMBER OF CONTIGOUS BLOCKS LARGE ENOUGH FOR THE PAGE
;REPRESENTED BY THE PB POINTED TO BY B
;ON SUCESS, CLOBBER THE CAR OF THE PAGE TO THE RIGHT THING
;AND UNFREE THE CORE IN CST AND CSTPB
FINPAG: TST PBCAR(B) ;DOES IT ALREADY HAVE CORE?
BNE FINPA0 ;YES, JUST RETURN WINNING
JSR F,ACSAV ;MIGHT AS WELL SAVE THEM ALL...
MOVB PBLEN(B),A ;HOW LONG DO WE NEED?
INC A ;0=1
CMP A,FREECR ;DO WE HAVE THAT MUCH ALL TOGETHER?
BGT FINPA8 ;NO WAY TO WIN
MOV CST1FR,C ;POINT TO CST ENTRY OF FIRST FREE BLOCK
MOV #CSTFRB,E ;A COMMONLY USED CONSTANT
MOV CSTTOP,F ;GENERATE NUMBER OF TIMES TO TRY
SUB C,F ;DEIFFERENCE OF TOP AND FIRST FREE
ASR F ;WORDS
FINPA1: MOV A,D ;COPY THE LENGTH
BIT E,(C)+ ;THIS ONE FREE?
BNE FINPA3 ;GOT ONE
FINPA4: SOB F,FINPA1 ;KEEP TRYING
BR FINPA8 ;NO GOOD
FINPA3: MOV C,B ;SAVE POINT TO START OF BLOCK+2
DEC D ;GOT ONE BLOCK, IS THAT ENOUGH?
BEQ FINPA9 ;YUP, WIN
FINPA5: BIT E,(C)+ ;IS NEXT ONE FREE?
BEQ FINPA4 ;NO, HAVE TO TRY ANOTHER PAGE
DEC D ;ONE MORE, ENOUGH?
BEQ FINPA9 ;YUP
SOB F,FINPA5 ;KEEP TRYING
INC NOFIT ;INCREMENT NUMBER OF TIMES THAT A PAGE WOULDN'T FIT
FINPA8: JMP ACRETS ;NO LUCK, GIVE UP
FINPA9: MOV B,F ;GET BACK THE POINTER TO THE START+2
TST -(F) ;BACK UP TOT HE REAL ENTRY
MOV F,C ;COPY IT
MOV A,D ;AND THE LENGTH
FINPA6: MOV 2(P),CSTPB-CST(C) ;THIS PAGE OCCUPIES THIS BLOCK
BIC E,(C)+ ;BLOCK IS NO LONGER FREE
SOB D,FINPA6
SUB A,FREECR ;TAKE THIS AWAY FROM FREE CORE
BNE FINP10 ;SOMETHING STILL FREE
MOV CSTTOP,CST1FR ;TOP IS FIRST FREE, IS NOTHING
BR FINPA7
FINP10: CMP F,CST1FR ;IS THIS WHAT USED TO BE FIRST FREE?
BNE FINPA7 ;NOPE
1$: BIT E,(C)+ ;IS THIS FREE?
BEQ 1$ ;LOOP UNTIL WE FIND THE FIRST FREE BLOCK
TST -(C) ;OVERSHOT
MOV C,CST1FR ;REPLACE WITH NEW FIRST FREE
FINPA7: SUB #CST,F ;GET THE BLOCK NUMBER
ASR F
MOV 2(P),B ;GET BACK POINTER TO THE PB
MOV F,PBCAR(B) ;AND PUT TI INTO THE PB
JSR F,ACRES
FINPA0: CLZ
RTS PC
;FLUSH CORE USED BY THE B IN B, PCLOSERING AS NEEDED
PBCFLS: BIT #PBVACR,(B) ;IS THE PAGE IN CORE?
BEQ PBCFR9 ;NO, DON'T NEED TO WORRY
SAVE B ;SAVE THE PB POINTER
MOV PBGIP(B),B ;GET A GIP FOR IT
JSR PC,PAGPCL ;PCLOSER ANYONE WHO MIGHT HACK THIS PAGE
JSR PC,PCLCLR ;I DON'T WANT TO BE PCLOSERED BY THIS!
REST B ;GET BACK PB POINTER
;FALL IN
;FREE THE BLOCKS BELONGING TO THE PAGE BLOCK POINTED TO BY B
PBCFRE: SAVE <A,C>
BIT #PBDISK!PBLOCK,(B) ;BETTER NOT BE LOCKED OR DISKING
; BUGC NE
BEQ 1$
JSR PC,BUGGER
1$: BIC #PBVACR,(B) ;NO LONGER VALID IN CORE
MOVB PBLEN(B),A ;GET THE LENGTH
INC A ;0=1
MOV PBCAR(B),C ;GET THE START
BEQ PBCFR2 ;SOMEONE ELSE ALREADY FREED HIS CORE
CLR PBCAR(B) ;NO LONGER VALID
ASL C ;CONVERT TO A WORD INDEX
ADD #CST,C ;POINTER INTO CST
CMP C,CST1FR ;IS THIS BEFORE THE FIRST FREE?
BHI PBCFR1 ;NO
MOV C,CST1FR ;NOW THIS IS FIRST FREE
PBCFR1: BIS #CSTFRB,(C) ;FREE THE BLOCK
CLR CSTPB-CST(C) ;DOESN'T BELONG TO ANYONE
INC FREECR ;ONE MORE FREE
TST (C)+ ;NEXT
SOB A,PBCFR1 ;AS MANY TIMES AS NEEDED
PBCFR2: REST <C,A>
PBCFR9: RTS PC
BUGGER: BIT #10,CSWR
BEQ 1$
BPT
1$: MOV ITM0A,A
BIS #PPCLSR,PFLAGS(A)
JSR PC,PCLCHK
BPT
.SBTTL FUPT HACKING ROUTINES
;GET A FUPT THAT POINTS AT A PB THAT REPRESENTS (B) BLOCKS OF FREE CORE
;ON EXIT, A CONTAINS A GIP TO THE NEW PAGE AND B POINTS TO THE PB
;Z IS SET IF NO SWAP SPACE IS AVAILABLE
;A SWITCH IS PUSHED THAT WILL DELETE THE PAGE IF PCLOSERED
FRCRGT: JSR PC,PBGET ;GET A PAGE BLOCK
JSR PC,FUPTGT ;GET A FUPT AND POINT IT AT THE PB
JSR PC,FINSWP ;TRY TO FIND SWAP SPACE FOR IT
BEQ FRCRG1 ;CAN'T
JSR PC,LSWPOP ;POP LOCK FOR FUPT
JSR PC,LSWPOP ;POP LOCK FOR PB
SAVE <B,A> ;NOW TO LOCK FPT A DIFFERENT WAY
MOV #LSPPCL,A ;RUN ROUTINE ON PCLOSER
CLR B ;NO ITEM
JSR PC,LOCKSW ;GET A LOCK BLOCK
MOV #FUPTFL,LCKWD1(A) ;ROUTINE
MOV (P),LCKWD2(A) ;FUPT POINTER
REST <A,B>
CLZ
RTS PC
FRCRG1: JSR PC,FRELSE ;FLUSH THE FUPT
JSR PC,FRELSE ;FLUSH THE PB
SEZ
RTS PC
;GET A FUPT TO POINT TO THE PB POINTED TO BY B
;COPY THE LENGTH FROM THE PB INTO THE FUPT
FUPTGT: SAVE <C,B>
MOV #FUPTFR,B ;FREE POINTER FOR FUPTS
JSR PC,FREEGT ;GET ONE
JSR PC,FREELK ;LOCK IT
MOV (P),B ;POINTER TO THE PB
MOV B,UPTPBP(A) ;POINT FPT AT IT
CLR FUPTPR(A) ;THE THING CURRENTLY IS NOT LOCKED BY A PROCESS
MOV #UPTEXB,UPTFLG(A) ;INIT THE FLAGS
MOVB PBLEN(B),UPTSTL(A) ;INIT THE LENGTH AND START
TST PBGIP(B) ;DOES THIS PB POINT TO OTHER UPTS?
BEQ FUPTG1 ;NO, EASY CASE
MOV PBGIP(B),B ;FIRST ONE IT POINTS TO IN CIRC LIST
JSR PC,UPTPLD ;PUSH AND LOAD
MOV UPTGIP(B),UPTGIP(A) ;POINT NEW ONE TO 2ND IN LIST
BIS #GIPBIT,A ;MAKE A A VALID GIP
MOV A,UPTGIP(A) ;POINT FIRST IN LIST AT NEW ONE
JSR PC,ITM2PO ;RESTORE ITEM2
FUPTG2: REST <B,C>
RTS PC
FUPTG1: MOV A,C ;COPY POINTER TO NEW FUPT
BIS #GIPBIT,A ;MAKE A VALID GIP
MOV A,PBGIP(B) ;POINT THE PB AT IT
MOV A,UPTGIP(C) ;AND POINT IT AT ITSELF
BR FUPTG2
;THIS PCLOSER ROUTINE FLUSHS A FUPT ASSUMMING IT HAS NO CIRCLAR LIST
;AND THE PAGE DOESN'T NEED TO BE SWAPPED BACK TO SOURCE
FUPTFL: MOV LCKWD2(B),B ;GET THE GIP
BIC #GIPBIT,B ;CONVERT TO FUPT POINTER
SAVE B ;WE'LL NEED IT OCCASIONALLY
MOV UPTPBP(B),B ;POINT TO THE PB
JSR PC,PBSFRE ;FREE THE SWAP SPACE
JSR PC,FPBFR ;FREE A FILE PAGE BLOCK
REST B ;GET FUPT POINTER BACK
MOV FUPTFR,A ;ONES FREE NOW
MOV B,FUPTFR ;NEW ONE
MOV A,(B) ;INTO LIST
RTS PC
;MAKES A GENERALIZED ITEM POINTER, B CONTAINS UPT NO, C CONTAINS SPHERE NO.
;THEN DELETES UPT, BY FALLING INTO UPTDL
SUPTDL: ASH #10.,B ;SET THE UPT NO. IN THE CORRECT BITS
ASH #-2,C ;FOR GIP
BIS C,B ;SET IN THE ITEM NO.
ASH #2,C
BIS #GIPBIT!GIPSPR,B ;SAY IT IS A GIP AND IN A SPHERE
;FALL INTO UPTDL
;THIS ROUTINE FLUSHS A UPT THAT MIGHT HAVE A CIRCULAR LIST
;AND THAT MIGHT POINT AT CORE THAT IS NOT VALID AT SOURCE
;NEEDLESS TO SAY, IT MIGHT HANG
;THE UPT IS POINTED TO BY B, WHICH MIGHT GET CLOBBERED
UPTDL: JSR PC,SAVAWB ;IN CASE WE AFFECT A MAPPED IN PAGE
JSR F,ACSAV
SAVE B ;SAVE THE ACTUAL GIP
JSR PC,UPTPLD ;LOAD UP THE UPT
SAVE B ;SAVE THE POINTER TO THE UPT
BIT #UPTABS,(B) ;ABSOLUTE PAGE?
BNE UPTDL7 ;YUP, EASY
TST (B) ;DOES IT EXIST?
BEQ UPTDL7 ;NO, JUST AS EASY
UPTDL4: MOV UPTPBP(B),B ;GET ITS PB POINTER
JSR PC,PBWAIT ;MAKE SURE PAGE IS STABLE
BIT #PBVAS,(B) ;IS IT VALID AT SOURCE?
BNE UPTDL1 ;YES, WE'RE SAFE
MOV 2(P),B ;GET BACK GIP POINTER TO IT
JSR PC,SWPIN ;SWAP IT IN
JSR PC,VALSRC ;VALIDATE IT AT THE SOURCE
JSR PC,GPWAIT ;WAIT FOR IT TO SETTLE DOWN
MOV (P),B ;GET ADDRESS BACK
BR UPTDL4 ;DOUBLE CHECK
UPTDL1: MOV (P),B ;GET BACK THE ADDRESS
CMP 2(P),UPTGIP(B) ;DOES IT POINT TO ITSELF?
BEQ UPTDL8 ;YES, EASY CASE
CLR E ;NO BITS SET YET
SAVE <UPTGIP(B),UPTGIP(B)> ;TWO COPIES OF WHAT IT POINTS TO
UPTDL2: MOV (P),B ;GET THE NEXT POINTER
JSR PC,UPTLD ;LOAD IT
MOV UPTGIP(B),(P) ;GET THE NEW NEXT
JSR PC,UPTEST ;SET BITS IN E ACCORDING TO UPT
CMP 6(P),(P) ;IS THE NEXT THING THE THING WE STARTED WITH?
BNE UPTDL2 ;NOPE, KEEP TRING
MOV 2(P),UPTGIP(B) ;THIS UPT POINTS AT WHAT WE WANT TO FLUSH
;2(P) IS WHAT THE THING WE ARE FLUSHING POINTS TO
;THUS, THIS INST FLUSHES THE UPT WE WANT TO FLUSH
MOV 6(P),B ;GET POINTER TO GIP BEING FLUSHED
JSR PC,UPTLD ;MAKE SURE THATS WHATS LOADED
MOV UPTPBP(B),B ;GET POINTER TO THE PB
CMP 6(P),PBGIP(B) ;WAS THIS THE ONE THE PB POINTED TO?
BNE 1$ ;NO, SAFE
MOV 2(P),PBGIP(B) ;DON'T LET THE PB GET LONELY
1$: CLR C ;ACCUMULATE STARTT
JSR PC,PBLFIX ;GO FIX UP THE PB TO ACCOMADATE ONLY WHAT'S LEFT
CMP (P)+,(P)+ ;FLUSH DUMMIES FROM STACK
UPTDL7: REST B ;GET BACK ORRIGINAL ADDRESS
BIT #GIPSPR,(P) ;IS IT A SPHERE UPT?
BNE UPTDL3 ;GO HANDLE THAT
;COME HERE FOR FUPT
UPTD.2: SAVE FUPTFR ;LINK INTO
MOV B,FUPTFR ;THE FREE LIST
UPTDL5: REST (B) ;THE FUPT
REST B ;GET BACK THE NOW USLESS GIP
JSR PC,ITMFLS ;FLUSH THIS IF IT MIGHT EVER GET LOADED SOMEPLACE
JSR PC,MAPRES
JMP ACRTP2
UPTDL3: BIT #UPTABS,(B) ;ABSOLUTE PAGE?
BNE UPTD.1 ;IGNORE
BIT #UPTEXB,(B) ;EXIST?
BEQ UPTD.1 ;NO, IGNORE
SAVE <A,B,C>
MOV ITM2A,A ;POINT TO SPHERE BEING AFFECTED
MOV SPHAPR(A),C ;NUMBER OF ACTIVE PROCESSES
MOV UPTPBP(B),B ;THE PB BEING AFFECTED
JSR PC,PBDACT ;DEACTIVE THIS MANY TIMES
REST <C,B,A>
UPTD.1: CLR -(P) ;TO CLOBBER UPT WHEN DONE
BIT #UPTDEI,(B) ;IS IT A D=I PAGE?
BEQ UPTDL0 ;NO
BIC #UPTIED,-8.*UPTLEN(B) ;DELETE CORESPONDING BIT INI PAGE
BR UPTDL5
UPTDL0: BIT #UPTIED,(B) ;IS IT THE I HALF?
BEQ UPTDL5 ;NOPE
BIC #UPTDEI,8.*UPTLEN(B) ;DELETE COORESPONDING BIT
BR UPTDL5
UPTDL8: MOV (P),B ;GET POINTER TO FUPT
MOV UPTPBP(B),B ;GET POINTER TO PB
MOV (B),C ;UGH, SAVE FLAGS
JSR PC,PBCFRE ;FREE THE CORE
JSR PC,PBSFRE ;FREE THE SWAP SPACE
JSR PC,FPBFR ;FREE FPB OR REGUALR PB
BIT #PBFILE,C ;IS IT A FILE PAGE?
BEQ UPTDL6 ;NO, NOTHING SPECIAL THEN
JSR PC,MFIPBD ;DELETEING A PB FROM AN MFI
UPTDL6: REST B
BIT #GIPSPR,(P) ;DELETED FROM SPHERE?
BEQ UPTD.2 ;NO, FREE FUPT
CLR -(P) ;YES, PREPARE TO CLOBBER UPT
BR UPTDL5
;FLUSH THE THING IN B FROM ANY ITEMS IT MIGHT GET LOADED INTO
;IN ENGLISH, CLOBBER THIS ITEM OFF OF STACKS AND ITEMN
ITMFLS: SAVE <A,C>
.IRPC N,<012>
CMP B,ITEM'N ;LOADED INTO THIS ITEM?
BNE ITMFL'N ;NOPE
MOV #-1,ITEM'N ;DUMMY ITEM
ITMFL'N: MOV ITM'N'D,A ;NUMBER OF FROBS ON THIS STACK
BEQ 1$ ;NONE
MOV ITM'N'P,C ;STACK POINTER
3$: CMP B,(C) ;SAME?
BNE 2$ ;NOPE
MOV #-1,(C) ;CLOBBER
2$: TST (C)+ ;NEXT
SOB A,3$
1$:
.ENDM
REST <C,A>
RTS PC
;SET BITS IN E CORESPONDING TO BLOCK STHE UPT POINTED TO
;BY B USES.
;CLOBBERS C AND D
UPTEST: MOVB UPTSTL(B),C ;GET START AND LENGTH
BLT EBSET2 ;NOT SET UP YET FOR THIS GUY
MOV C,D ;COPY IT
BIC #UPTLMS,D ;GET LENGTH
BIC #UPTSMS,C ;AND START
ASH #-UPTSSH,C ;SHIFT START
;ENTER HERE TO JUST SET THE BITS FOR THE START IN C AND LENGHT IN D
;CLOBBERS C AND D
EBSET: INC D ;0=>1
EBSET1: CMP #7,C ;CHECK THAT BLOCK IS OK
ERRORC LO,BAD ;BAD ARGUMENT TO CALL
BISB BMT(C),E ;SET BIT FOR THIS BLOCK
INC C ;NEXT BLOCK
SOB D,EBSET1 ;GO FOR THE WHOLE LENGTH
EBSET2: RTS PC
;CALL THIS TO FIX UP A PB TO CONFORM TO THE NEEDS REPRESENTED
;BY THE BITS IN E. B POINTS TO THE PB, C AND D GET CLOBBERED
PBLFIX: TST E ;ANY?
BEQ PBLFI9 ;NOPE
CLR C
PBLFI1: BITB BMT(C),E ;THIS BIT ON?
BNE PBLFI6 ;YUP, WE HAVE THE START
INC C ;ONE MORE
BR PBLFI1
PBLFI6: MOV #7,D ;NOW FROM THE OTHER END
PBLFI7: BITB BMT(D),E ;THIS ONE HERE?
BNE 1$ ;YUP
SOB D,PBLFI7 ;KEEP TRYING
1$: SUB C,D ;CONVERT END TO LENGTH
CMPB D,PBLEN(B) ;SAME LENGTH AS BEFORE?
BNE PBLFI4 ;NO, NEED TO FLUSH FROM CORE
MOVB PBRAN(B),E ;GET THE START
BIC #PBSTRT,E
ASH #-UPTSSH,E
CMP C,E ;STARTS THE SAME?
BEQ PBLFI5 ;YUP, NO NEED TO CHANGE
PBLFI4: JSR PC,PBCFLS ;FLUSH THE PB'S CORE
BIT #PBFILE,(B) ;SWAP TO SOURCE?
BEQ PBFLI8 ;YES, OK
BIC #PBVASS,(B) ;IT IS NOT VALID ON SWAP SPACE, MUST GET FROM SOURCE
PBFLI8: MOVB D,PBLEN(B) ;SET THE LENGTH
BICB #7,PBRAN(B) ;FLUSH OLD START
BISB C,PBRAN(B) ;SET IN NEW START
PBLFI5: RTS PC
PBLFI9: MOV #-1,D ;NO BLOCKS
BR PBLFI4
;PC LOSER ROUTINE TO CLOBBER A FUPTPR BACK TO ZERO
PRPFIX: MOV LCKWD2(B),A ;GET POINTER TO FUPT
CMP ITEM0,FUPTPR(A) ;DO I HAVE IT LOCKED?
BUGC NE ;UGH, I SHOULDN'T BE UNLOCKING IT!
CLR FUPTPR(A) ;UNLOCK
MOV UPTPBP(A),B ;THE PB BEING AFFECTED
MOV #1,C ;ONE PROCESS
JSR PC,PBDACT ;NO LONGER REFERS TO IT
RTS PC
;SET THE FUPTPR OF AN FUPT
;HANG UNTIL IT IS ZERO, THEN SET IT TO RUNNING PROCESS
;WITH A ROUTINE TO RUN WHEN THE LOCK IS POPED
FUPTLK: JSR F,ACSAV
BIC #GIPBIT,B ;CONVERT TO CORE ADDRESS
FUPTL3: TST FUPTPR(B) ;ALREADY LOCKED?
BEQ FUPTL1
CMP PRUNNG,FUPTPR(B) ;AM I THE GUY WHO HAS IT LOCKED?
BUGC EQ ;WILL NEVER BE AVAILABLE..
FUPTL2: JSR PC,SFLUSH ;WAIT
TST FUPTPR(B) ;TRY AGAIN
BNE FUPTL2
JSR PC,RUNME
BR FUPTL3
FUPTL1: MOV ITEM0,FUPTPR(B) ;SAY I USE THIS FUPT
MOV B,F ;SAVE POINTER TO IT
MOV #LSPRTN,A ;RUN THIS ROUTINE WHEN UNLOCKED
CLR B ;SAY THERE IS NO ITEM
JSR PC,LOCKSW ;LOCK A SWITCH
MOV #PRPFIX,LCKWD1(A) ;PUT IN THE ROUTINE TO RUN
MOV F,LCKWD2(A) ;POINTER TO THE FUPT TO FIX
MOV UPTPBP(F),B ;THE PB BEING AFFECTED
MOV #1,C ;ONE PROCESS
JSR PC,PBACT ;REFERES TO IT
FUPTL4: JMP ACRET
;ROUTINE TO FIX UP A PB TO BE A SPECIFIED START AND LENGTH
;CALL WITH PB POINTER IN B, DESIRED START IN C
;DESIRED LENGTH IN D
;ROUTINNE RETURNS WITH Z SET IF NOT ALL THE REQUESTED
;BLOCKS EXIST IN A FILE PAGE
PBSETU: JSR F,ACSAV
JSR PC,PBLONG ;GET THE NEEDED START AND LENGTH
;AND THE CURENT START AND LENGTH
BEQ PBSET1 ;NOT ALL BLOCKS OF FILE PAGE EXIST
CMPB #-1,PBLEN(B) ;IS THE PAGE NOT SET UP?
BEQ PBSET3 ;THEN JUST SET IT
CMP C,E ;IS NEEDED START = EXISTING?
BNE PBSET2 ;NO, NEED TO WORK
CMP D,F ;IS NEEDED LENGTH EQUAL ALSO?
BNE PBSET2 ;OH WELL...
JMP ACRETC ;NOTHING TO DO
PBSET2: BIT #PBVAS,PBFLAG(B) ;IS IT VALID AT SOURCE?
BNE PBSET3 ;YES, WE CAN CLOBBER THE PAGE
JSR PC,PBSWPI ;MAKE SURE PAGE IS IN CORE
JSR PC,PBVLSR ;VALIDATE THE PAGE AT SOURCE
JSR F,ACRES
BR PBSETU ;GO TRY IT ALL AGAIN
PBSET3: JSR PC,PBWAIT ;WAIT FOR DISKING TO DIE DOWN
JSR PC,PBCFLS ;FLUSH THE CORE
PBSET4: MOVB D,PBLEN(B) ;SET EH NEW LENGTH
BICB #7,PBRAN(B) ;CLEAR OLD START
BISB C,PBRAN(B) ;SET IN NEW START
JMP ACRETC
PBSET1: JMP ACRETS
;DO LENGTH COMPARISIONS FOR NEW AND OLD PB STARTS AND LENGTHS
;CALL WITH PB POINTER IN B, NEW START AND LENGTH IN C AND D
;RETURNS WITH NEEDED START AND LENGTH IN C AND D AND CURRENT
;START AND LENGTH IN E AND F
;RETURNS WITH Z SET IF SOME BLOCKS IN THE NEEDED PAGE ARE NON-EX
PBLONG: SAVE A
ADD C,D ;CONVERT LENGTH TO LAST BLOCK #
MOVB PBLEN(B),F ;GET CURRENT LENGTH
BLT PBLON2 ;PB NOT SET UP
MOVB PBRAN(B),E ;AND CURENT START
BIC #PBSTRT,E
ADD F,E ;;CONVERT TO END BLOCK
CMP C,E ;IS NEW START LESS THAN OLD START?
BLT PBLON1 ;YES, NEED TO EXPAND PAGE DOWN
MOV E,C ;THIS WILL BE THE REQUIRED START
CMP F,D ;IS NEW END PAST OLD END?
BLT PBLON2 ;YES, NEED TO EXPAND UP
MOV F,D ;OLD ONE IS HIGH ENOUGH
PBLON3: SUB C,D ;CONVERT BACK TO LENGTH
SUB E,F ;LIKEWISE
REST A
CLZ
RTS PC
PBLON1: CMP F,D ;IS NEW END PAST OLD END?
BLT PBLON2 ;YES, USE NEW
MOV F,D ;NO, USE OLD
PBLON2: BIT #PBFILE,PBFLAG(B) ;IS THIS A FILE PAGE?
BEQ PBLON3 ;NO, WE'RE DONE
MOV B,A ;COPY PB POINTER
ADD #PBSDA,A ;POINT AT SOURCE ADDRESSES
ADD C,A ;POINT AT
ADD C,A ;FIRST ONE WE REFERENCE
SAVE D ;SAVE END POINTER
SUB C,D ;CONVERT TO LENGTH
PBLON5: CMP #-1,(A)+ ;NON-EX BLOCK?
BEQ PBLON4 ;YOU CAN'T MAP THAT IN!
DEC D ;DONE ALL?
BGE PBLON5 ;NOT YET
REST D ;MADE IT THROUGH OK
BR PBLON3
PBLON4: REST <D,A>
SEZ ;TRYIED TO MAP IN NON-EX BLOCK
RTS PC
.SBTTL ITEM TABLE ROUTINES
.IIF NZ ITMADR!ITLINK,.ERROR NO, IT WON'T WORK WITH ITLINK OR ITADDR NON-ZERO
;CREATE AN ITEM OF SPECIFIED SIZE
;THE SIZE IS PUT INTO A; THE ITEM'S INDEX RETURNS IN B
;THE Z BIT IS SET IF THE ITEM CANNOT BE CREATED; OTHERWISE, IT IS CLEARED
;THIS MAKES NO ATTEMPT TO COMPRESS EXISTING ITEMS TO PRODUCE CONTIGOUS FREE SAPCE
;THAT FEATURE IS OF SOMEWHAT QUESTIONALBE VALUE, BUT MIGHT BE ADDED LATER
CRITEM: CMP #200,A ;CHECK THAT NO ONE ASKS FOR A BLOCK>4K
BUGC LE
MOV ITMFRE,B ;ATTEMPT TO GET A FREE ITEM
BEQ CRITM1 ;NO MORE AVAILABLE, GO LOSE
SAVE <C,D>
CRITM8: MOV A,C ;GET THE LENGTH
ASL C ;CONVERT IT TO AN INDEX
ADD #ITMATB,C ;INTO THE ALLOCATE TABLE
CLR D ;FOR THE LEFTOVER COUNT
CRITM3: TST (C)+ ;IS THERE A FREE ITEM BLOCK OF THIS SIZE?
BNE CRITM2 ;YES, GO USE IT
TST (D)+ ;ONE MORE TO FREE WHEN WE FINALLY FIND
;A BLOCK BIGGER THAN WHAT WE REALLY WANTED
CMP #ITMATB+400,C ;ARE WE ALREADY OFF THE TOP?
BNE CRITM3 ;NOPE, NOT YET
;IF WE GET HERE WE HAVE TO ALLOCATE A NEW BIG BLOCK
TST ITMBAL ;IS SOMEONE ELSE ALREADY ALLOCATING?
BEQ CRIT11 ;NO, GO LOCK THE SWTICH
CRIT13: JSR PC,SFLUSH ;WAIT FOR THE OTHER GUY TO BE DONE
TST ITMBAL ;DONE YET?
BNE CRIT13 ;NOPE
JSR PC,RUNME ;DONE, NOW SEE IF HE LEFT ENGOUGH FOR US
CRIT16: MOV ITMFRE,B ;HAVE TO GET ANOTHER ITEM
BEQ CRIT12 ;MAYBE OTHER PEOPLE TOOK THEM ALL
BR CRITM8 ;NOPE
CRIT11: SAVE A ;LOCK SWTCH SO NO ONE ELSE GETS TO THIS CODE
MOV #ITMBAL,A
MOV #-1,B ;USE ALL THE BITS
CLR C ;THE SWITCH IS INOT IN AN ITEM
JSR PC,LCKASW ;IN CASE WE HANG WAITING FOR A BLOCK
MOV #NITMBL,B ;FIND A FREE ITEM BLOCK SLOT
MOV #ITMBST,C
CRIT10: TST (C)+ ;NEGATIVE INDICATES FREE
BLT CRITM9 ;FOUND ONE!
SOB B,CRIT10 ;KEEP TRYING
JSR PC,LSWPOP ;LOSE, NO SPACE TO PUT ANOTHER BLOCK
REST A
CRIT12: REST <D,C>
CRITM1: SEZ ;INDICATE FAILURE
RTS PC
;NO, THIS ISN'T THE END OF THE ROUTINE!
CRITM2: MOV (B),ITMFRE ;NOW THE ITEM POINTED TO BY THIS ONE IS
;THE BEGINNING OF THE FREE LIST
MOVB A,ITLNGT(B) ;SET IN THE LENGTH
MOVB #ITACCD,ITACCS(B) ;AND THE ACCESS CODE
SAVE <E,F>
MOV -(C),E ;GET A POINTER TO THE NODE FOR THE FREE BLOCK
MOV (E),(C) ;SPLICE OUT THIS NODE
MOV 2(E),F ;ADDRESS OF THE BLOCK
MOV F,(B) ;PUT IT AWAY IN THE ITEM
MOV F,C ;COPY IT
BIC #170000,F ;GET THE ADDRESS PART
SAVE F ;AND SAVE IT FOR LATER
TST D ;IS THERE ANY LEFTOVER?
BEQ CRITM4 ;NO, JUST GO FREE THE NODE
TST -(D) ;CORRECT D, IT'S OVERENTHUSIASTIC
MOV ITMATB(D),(E) ;PUT THE NODE INTO THE LIST FOR THE LEFTOVER SIZE
MOV E,ITMATB(D) ;THERE!
ADD A,2(E) ;ADD THE AMOUNT USED TO THE ADDRESS
INC 2(E) ;SINCE ZERO IS ONE(?)
BR CRITM5 ;NOW GO USE WHAT WE GOT
CRITM4: MOV ITMAFR,(E) ;LINK IT BACK TO THE FREE LIST
MOV E,ITMAFR
CLR 2(E)
CRITM5: JSR PC,BITSET ;GRAB THE BLOCKS WE WANT
TST (P)+ ;FLUSH THE ADDRESS FROM THE STACK
SUB #ITMTAB,B
REST <F,E,D,C>
CLZ
RTS PC
CRITM9: MOV (P),A ;GET LENGTH OF THING WE'RE ALLOCATING
ASH #-4,A ;CHANGE TO 512 WORD BLOCKS
CMP #3,A ;IS IT BIGGER THAN 2K?
BLE 1$ ;IF SO, USE IT
MOV #3,A ;OTHERWISE, TRY FOR 2K
1$: JSR PC,ITMSEX ;EXPAND ITEM SPACE
ASH #4,A ;CONVERT BACK TO 32 WORD UNITS
ASH #4,B ;CONVERT TO AN AR-STYLE
BIS #17,A ;CONVERT TO DR-STYLE
JSR PC,LSWPOP
;DONE ALLOCATING CORE
MOV B,-(C) ;B GETS THE ADDRESS
SUB #ITMBST,C ;UN-RELATIVE IT
MOV A,ITMBNF(C) ;A GETS THE NUMBER OF BLOCKS GOBBLED
MOV ITMAFR,D ;GET AN ALLOCATE NODE
BUGC EQ ;THERE SHOULD ALWAYS BE ONE AVAILABLE
MOV (D),ITMAFR ;SPLICE IT OUT OF THE FREE LIST
SAVE C ;SAVE FOR LATER
ASH #11.,C ;PUT IT INTO THE HIGH FOUR BITS
ADD B,C ;COMBINE THE BLOCK ADDRESS AND THE BIG BLOCK NUMBER
MOV C,2(D) ;AND SAVE IT IN THE NODE
ASL A ;CONVERT SIZE OF BLOCK TO WORD OFFSET
MOV ITMATB(A),(D) ;SPLICE THIS NODE
MOV D,ITMATB(A) ;INTO LIST FOR THIS SIZE
ASR A ;RESTORE A
REST C ;GET THE INDEX INTO THE BLOCK VARIABLES
MOV ITMBTP(C),C ;ADDRESS OF THE BIT TABLE FOR THIS BLOCK
MOV C,D ;COPY POINTER TO BIT TABLE
MOV #8.,B ;THERE ARE 8 WORDS
CRIT14: MOV #-1,(C)+ ;FIRST, SET ALL BLOCKS AS USED
SOB B,CRIT14 ;DO 8 TIMES
INC A ;0 IS ONE BLOCK!
ASH #-4,A ;COVERT TO 512 WORD BLOCKS
CRIT15: CLR (D)+ ;THERE WILL ALWAYS BE AT LEAST ONE
SOB A,CRIT15 ;DO UP TO 8 TIMES
REST A
CMP #-1,PRUNNG ;ARE WE STILL IN TH EINIT CODE?
BNE 1$ ;NOPE
JMP CRIT16 ;THEN JUST RETRY IT
1$: JSR PC,PCLSET ;ALWAYS PCLOSER
JMP PCLCHK
;DELETE THE ITEM WHOSE ITEM NUMBER IS IN A
;A GETS CLOBBERED
;THIS MAKES NO ATTEMPT TO RETURN AN EMPTY BIG BLOCK
;THAT FEATURE SHOULD BE ADDED AS SOON AS POSSIBLE (PROBABLY)
DLITEM: JSR F,ACSAV
CLR -(P) ;SAVE A STACK WORD FOR TEMP
ADD #ITMTAB,A ;RELOCATE INDEX TO BE ACTUAL ADDRESS
TSTB ITACCS(A) ;IS THIS ITEM FOR REAL?
BUGC EQ ;OOPS!
MOV (A),E ;GET THE ADDRESS AND BLOCK # OF THE ITEM
MOVB ITLNGT(A),(P) ;SAVE THE LENGTH ON THE STACK
MOV ITMFRE,(A) ;PUT THE NEWLY-FREED NODE ON THE HEAD OF THE
CLRB ITACCS(A) ;MARK IT AS FREE
MOV A,ITMFRE ;FREE LIST. IT WON'T BE FREE LONG!
INC (P) ;CORRECT FOR OFFSET
MOV (P),F
MOV E,A
JSR PC,BITCLR ;CLEAR THE BITS OF THE BLOCK WE ARE FREEING
MOV #-1,C ;NOW SEE IF THE SPACE BEFORE THE BLOCK IS FREE
DEC E ;LOOK BEFORE THE BLOCK
JSR PC,CNTFRE ;GO SEE IF THERE'S ANYTHING WE CAN FREE
MOV E,F ;SAVE THE REAL BEGGING ADDRESS
ADD (P),E ;GO TO THE END OF THE SO-FAR FREE BLOCK
MOV #1,C ;NOW SEARCH FORWARD
JSR PC,CNTFRE ;GO SEE IF ANYTHING THERE AND FREE WHATEVER YOU FIND
MOV F,C ;GET THE REAL BEGGINING OF THE BLOCK
JSR PC,BLKFRE ;FREE THE BLOCK WE HAVE FOUND
TST (P)+ ;FLUSH THE COUNT FROM THE STACK
JMP ACRET
;EXPAND OR CONTRACT ITEM WHOSE INDEX IS IN B
;TO THE SIZE IN A
;CLEAR Z IF SUCCESSFUL, OTHERWISE SET Z
EXITEM: JSR F,ACSAV
EXITM4: TSTB ITACCS+ITMTAB(B) ;IS THIS ITEM FOR REAL?
BUGC EQ ;OOOPS!
CMPB A,ITLNGT+ITMTAB(B) ;WHAT IS THE RELATION OF THE DESIRED LENGTH
;TO THE CURRENT LENGHT?
BGT EXITM2 ;NEED TO ADD MORE TO THE ITEM
BEQ EXITM1 ;THE ITEM IS ALREADY THE DESIRED LENGTH
;GET HERE TO REMOVE EXTRA STUFF FROM ITEM
MOVB ITLNGT+ITMTAB(B),F ;GET THE CURRENT LENGTH
SUB A,F ;DIFFERENCE BETWEEN CURRENT AND DESIRED
SAVE F ;SAVE THE NUMBER OF BLOCKS TO BE FREED
MOV ITMADR+ITMTAB(B),E ;ADDRESS OF THE ITEM
MOVB A,ITLNGT+ITMTAB(B) ;SET THE NEW LENGTH INTO THE ITEM
ADD A,E ;GET TO THE END OF THE DESIRED PART
INC E ;CORRECT IT
MOV E,A ;MAKE THE ROUTINE HAPPY
JSR PC,BITCLR ;CLEAR THE NEWLY FREED AREA
MOV E,F ;SAVE THE ADDRESS OF THE BLOCK WE ARE ABOUT TO FREE
ADD (P),E ;END OF AREA WE KNOW TO BE FREE
MOV #1,C ;SEARCH FORWARD
JSR PC,CNTFRE ;LOOK FOR FREE BLOCKS AND FREE THOSE YOU FIND
MOV F,C ;PUT ADDRESS OF BLOCK INTO THE RIGHT PLACE
JSR PC,BLKFRE ;PUT FREE BLOCKS ON FREE LIST
TST (P)+ ;GET RID OF COUNT ON PDL
EXITM1: JMP ACRETC
;CONTINUED NEXT WEEK (ACTUALLY, NEXT PAGE)
;GET HERE IF MORE SPACE NEEDED FOR ITEM
EXITM2: MOV ITMADR+ITMTAB(B),E ;ADDRESS OF START OF ITEM
MOVB ITLNGT+ITMTAB(B),A ;GET CURRENT SIZE
ADD A,E ;TO GET END OF CURRENT BLOCK
INC E ;CORRECT IT
MOV E,D ;NOW FIND WHICH BLOCK
ASH #-11.,D
BIC #177741,D ;WORD INDEX
MOV #1,C ;NOW SEARCH FORWARD FOR FREE BLOCKS
JSR PC,CNTBLK
BLT EXITM3 ;FORGET THIS IF THERE AREN'T ANY
MOV (P),C ;GET THE DESIRED COUNT
INC A ;CORRECT THE AMOUNT FOUND
SUB A,C ;C=AMOUNT NEEDED-EXTRA FOUND
MOVB ITLNGT+ITMTAB(B),F ;THE AMOUNT WE ALREADY HAVE
CMP C,F ;WILL THE TOTAL BE ENOUGH?
BGT EXITM3 ;NO, FORGET IT
ADD A,F ;YES, WHAT IS THAT TOTAL?
MOVB F,ITLNGT+ITMTAB(B) ;THAT IS THE NEW ITEM LENGTH
MOV A,F ;SAVE THE NUMBER OF BLOCKS WE ARE STEALING
DEC A ;UNCORRECT IT
JSR PC,FINDEL ;DELETE IT FROM THE FREE LIST
MOV F,A ;GET THE COUNT BACK
MOV E,C ;MAKE THE ROUTINE HAPPY
SAVE E ;HAPPY!!??
JSR PC,BITSET ;INDICATE THOSE BLOCKS IN USE
TST (P)+ ;GET RID OF THE GARBAGE
MOV (P),A ;NOW, HOW MUCH DID WE REALLY WANT?
MOV 2(P),B ;FOR WHAT ITEM?
BR EXITM4 ;GO FLUSH ANY EXTRA WE TOOK
;GET HERE IF THE BLOCK CAN'T BE EXPANDED NICELY
EXITM3: MOV (P),A ;GET THE DESIRED SIZE
JSR PC,CRITEM ;GET AN ITEM OF THE RIGHT SIZE
BNE EXITM6 ;GOT IT, GO USE IT
JMP ACRETS ;LOSE, RESTORE AC'S AND GET OUT
;TO BE CONTINUED (NEXT PAGE)
EXITM6: MOV B,A ;LOAD THE NEW ITEM INTO THE MAP
JSR PC,ITM0PL ;PUSH AND LOAD
MOV A,C ;SAVE THE ADDRESS IT WAS LOADED AT
MOV 2(P),D ;THE ITEM WE WANT TO EXPAND (COPY)
MOV D,A ;LOAD IT INTO THE MAP TOO
JSR PC,ITM1PL ;PUSH AND LOAD
MOVB ITLNGT+ITMTAB(D),F ;GET THE LENGTH OF THE OLD THING
INC F ;CORRECT IT
ASH #5,F ;CONVERT TO WORDS
1$: MOV (A)+,(C)+ ;COPY THE BLOCK
SOB F,1$
JSR PC,ITM0PO ;POP ITEM0
JSR PC,ITM1PO ;POP ITEM1
MOV B,A ;SAVE THE NEW ITEM INDEX
ADD #ITMTAB,D ;MAKE AN ACTUAL ADDRESS
ADD #ITMTAB,B
MOV #ITMTEL/2,F ;NUMBER OF WORDS TO EXCAHNGE
EXITM5: MOV (B),E
MOV (D),(B)+
MOV E,(D)+
SOB F,EXITM5 ;EXCAHNGE OLD AND NEW ITEMS
JSR PC,DLITEM ;DELETE THE NEW ITEM SLOT WITH THE OLD ITEM CONTENTS!!
BR EXITM1 ;RETURN SUCESSFULLY, IF SOMEWHAT WEARILY
;CLEAR ITEM WHOSE INDEX IS IN B
;IT'S LENGTH IS IN A. IT IS ALSO LOADED INTO ITEM0
;AND ITEM0'S PDL IS PUSHED. A IS CLOBBERED TO THE ADDRESS OF THE ITEM
CLITEM: SAVE C ;FOR THE WORD COUNT
MOV A,C ;THE BLOCK COUNT
INC C ;CORRECTED
ASH #5,C ;CONVERT TO WORDS
MOV B,A ;THE ITEM TO CLEAR
JSR PC,ITM0PL ;GETS LOADED
ADD C,A ;POINT A TO THE END OF THE ITEM
ADD C,A ;SINCE C IS A WORD COUNT
1$: CLR -(A) ;CLEAR TE ITEM, CORRECTING A
SOB C,1$ ;CLEAR ALL THE WORDS
REST C
RTS PC
;SET THE BITS IN THE ITEM BLOCK BIT TABLE
;THE STARTING ADDRESS IS EXPECTED IN C AND 2(P)
;THE COUNT OF BLOCKS (UNCORRECTED) IS EXPECTED IN A (IT SHOULD NOT BE -1)
;CLOBBERS C,D,E AND F
BITSET: ASH #-11.,C ;GET THE BIG BLOCK NUMBER
BIC #177741,C
DEC ITMBNF(C) ;CORRECT FOR 0=1
SUB A,ITMBNF(C) ;THAT MANY FEWER BLOCKS AVAILABLE
MOV 2(P),E ;GET THE ADDRESS BACK
BIC #170000,E ;CLEAR BIG BLOCK BITS
MOV A,D ;AND A COUNT WE CAN MUNGE
SUB ITMBST(C),E ;CONVERT TO BLOCK WITHIN BIG BLOCK
ASHC #-3.,E ;FIGURE IT OUT YOURSELF
ASH #-13.,F
BIC #177770,F
ADD ITMBTP(C),E ;MAKE IT POINT INTO THE BIT TABLE
INC D ;SINCE 0=1
BITST1: BISB BMT(F),(E) ;SET THE BIT
INC F ;CHANGE THE BIT NUMBER
BIT #7,F ;HAVE WE JUMPED A BYTE?
BNE BITST2 ;NOT YET
CLR F ;NEW BIT NUMBER
INC E ;AND NEW BYTE NUMBER
BITST2: SOB D,BITST1 ;DO FOR HOWEVER MANY LITTLE BLOCKS
RTS PC
;CLEAR BITS IN THE BIT TABLE FOR THE ITEM BLOCK
;EXPECTS THE STARTING ADDRESS IN A AND THE COUNT (CORRECTED) IN F
;CLOBBERS A,B,D AND F
BITCLR: MOV A,D ;COPY IT
ASH #-11.,D ;TO GET THE BLOCK #
BIC #177741,D ;CLEAR BITS THAT MAY BE SET BY ASH
BIC #170000,A ;GET RID OF THE BLOCK NUMBER
SUB ITMBST(D),A ;AND MAKE RELATIVE TO START OF BLOCK
ASHC #-3,A ;KNOCK THE BIT ADDRESS OFF THE END
ASH #-13.,B ;AND PUT IT IN IT'S PLACE
BIC #177770,B ;OH FOR A LSH!
ADD ITMBTP(D),A ;ADDRESS IN THE BIT TABLE
ADD F,ITMBNF(D) ;MORE FREE SPACE!
;THIS IS WHERE THE RETURN BIG BLOCK STUFF SHOULD GO
BITCL1: BICB BMT(B),(A) ;THIS BLOCK NOW FREE
INC B ;GO TO NEXT BIT ADDRESS
BIT #7,B ;TO NEXT BYTE?
BNE BITCL2 ;NOT YET
CLR B ;ZEROTH BIT
INC A ;IN THE NEXT BYTE
BITCL2: SOB F,BITCL1 ;CLEAR UNTIL DEAD
RTS PC
;PUT AN ENTRY ON THE APPROPRIATE FREE LIST FOR THE BLOCK WE HAVE FREED
;EXPECTS THE COUNT (CORRECTED) ON 2(P), THE ADDESS OF THE BLOCK IN C
;CLOBBERS A AND B
BLKFRE: MOV 2(P),A ;AND IT'S LENGTH
DEC A ;SIGH
ASL A ;CONVERT THE LENGTH INTO A WORD INDEX
ADD #ITMATB,A ;NOW, THE ADDRESS IN THE ALLOCATE TABLE
MOV ITMAFR,B ;GET THE FIRST FREE ALLOCATE NODE
BUGC EQ ;WE SHOULD NEVER RUN OUT OF THESE!
MOV (B),ITMAFR ;SPLICE IT OUT
MOV (A),(B) ;SPLICE INTO THE LIST FOR THIS SIZE BLOCK
MOV B,(A) ;AND FIX THE POINTER TO THE LIST
MOV C,2(B) ;FINALLY, THE LOCATION OF THE NEWLY FREED BLOCK
RTS PC
;THIS ROUTINE IS SPECIAL FOR DLITEM
;IT FINDS FREE SPACE A TACKS IT ON TO EXISTING FREE SPACE
;NOTE THAT THE WORD AT 2(P) IS EXPECTED TO CONTAIN THE COUNT
;OF BLOCKS THAT HAVE BEEN FOUND TO BE FREE
;CLOBBERS A AND B ADDS THE NUMBER OF BLOCKS IT FINDS TO 2(P)
CNTFRE: JSR PC,CNTBLK ;AND IF SO, HOW MUCH?
BLT CNTFR1 ;NONE FREE THERE!
ADD A,2(P) ;SOME THERE, ADD TO PREVIOUS AMOUNT
INC 2(P) ;SIGH
FINDEL: JSR PC,FINBLK ;FIND THE BLOCK THAT IS FREE
DELBLK: MOV (A),(B) ;SPLICE THE NODE OUT OF THE LIST
MOV ITMAFR,(A) ;AND PUT THE FREED NODE ON THE FREE LIST
MOV A,ITMAFR ;NEW START OF FREE LIST
CNTFR1: RTS PC
;FIND A BLOCK OF A PARTICULAR SIZE THAT BEGINS AT A CERTAIN LOCATION
;SIZE IN A
;LOCATION IN E
;POINTER TO NODE IS RETURNED IN A
;POINTER TO PREVIOUS NODE IS RETURNED IN B
;(IT IS A BUG FOR THERE TO BE NO SUCH BLOCK!!!)
FINBLK: ASL A ;CONVERT THIS INTO A POINTER
ADD #ITMATB,A ;INTO THE ALLOCATE VECTOR
FINBL1: MOV A,B ;THE OLD ONE
MOV (A),A ;THE ONE IT POINTS TO
BUGC EQ ;MUST BE THERE!!
CMP 2(A),E ;IS THIS THE ONE?
BNE FINBL1 ;NOPE
RTS PC ;YES, WE'RE ALL SET
;FIND HOW MANY BLOCKS ARE FREE STARTING AT A GIVEN BLOCK AND
;LOOKING IN A GIVEN DIRETION
;E CONTAINS THE ABSOULUTE BLOCK NUMBER
;D CONTIANS THE INDEX OF THE BLOCK IT IS IN
;C CONTAINS THE DIRECTION (1=> FORWARD, -1=> BACKWARDS)
;A GETS -1 OR THE LENGTH OF WHAT'S FOUND
;CONDITON CODES ARE SET BY TST A, I.E. N IS CLEAR IF ANYTHING FOUND
;E GETS THE ADDRESS OF THE FIRST BLOCK IN THE CHUNK
CNTBLK: SAVE <F,B,E>
MOV #-1,A ;THE INTIAL COUNT
BIC #170000,E ;GET RID OF BLOCK #
SUB ITMBST(D),E ;MAKE IT RELATIVE TO START OF BLOCK
BLT CNTBL2 ;NO BLOCKS BEFORE BLOCK!
ASHC #-4,E ;GET THE BIT NUMBER
ASH #-12.,F ;AND THE WORD NUMBER
BIC #177760,F ;MAKE SURE THE BIT NUMBER IS RIGHT
ASL E ;MAKE A WORD ADDRESS
MOV #1,B ;THE FIRST BIT
ASH F,B ;SHIFT BY THE BIT NUMBER
ADD ITMBTP(D),E ;THE REAL BIT TABLE ADDRESS
CNTBL1: BIT B,(E) ;IS THIS ONE FREE?
BNE CNTBL2 ;THEN WE'RE DONE
INC A ;ANOTHER ONE FREE
;SHIFT ONE WAY OR THE OTHER
CLC ;CLEAR THE WAY FOR THE ROTATES
TST C ;WHICH WAY?
BLT CNTBL4 ;RIGHT
ROL B ;LEFT
BR CNTBL5
CNTBL4: ROR B ;RIGHT
CNTBL5: BNE CNTBL1 ;NOT DONE WITH WORD YET
ADD C,E ;ADJUST ADDRESS
ADD C,E ;IT IS A WORD ADDRESS
MOV #1,B ;RESET THE BIT
TST C ;UNLESS WE ARE LOOKING BACKWARDS
BGT CNTBL1 ;NOPE, FORWARDS
MOV #100000,B ;OOPS, BACKWARDS
BR CNTBL1
CNTBL2: REST E
TST C ;THIS IS OK FOR FORWARDS SEARCH
BGT CNTBL3
SUB A,E ;BUT MUST BE CORRECTED FOR BACKWARD
CNTBL3: REST <B,F>
TST A ;TO SET THE CONDITION CODES
RTS PC
;ROUTINES TO LOAD ITEMS INTO THE MAP AND TO PUSH AND POP THE ITEM STACKS
.IRPC X,<012> ;CONSTRUCT ROUTINES FOR EACH OF THE ITEM PAGES
;PUSH THE CURRENT ITEM FOR THIS PAGE ON THE STACK
;AND LOAD THE ITEM WHOSE INDEX IS IN A
ITM'X'PL: SUB #2,ITM'X'P ;DECREMENT THE STACK POINTER
MOV ITEM'X,@ITM'X'P ;STORE CURRENT ITEM ON STACK
INC ITM'X'D ;INDICATE PUSHED ONE MORE LEVEL
CMP #NITMPS,ITM'X'D ;ABOUT TO OVERFLOW?
BUGC LE
;FALL INTO THE LOAD ITEM ROUTINE
;LOAD ITEM WHOSE INDEX IS IN A INTO AN ITEM PAGE
;RETURN THE ADDRESS THAT THE ITEM WAS LOADED INTO IN A
ITM'X'LD:
TST A ;MAKE SURE ITEM NUMBER IS NON ZERO
BUGC EQ
SAVE PS
SPL 7
CLRB ITM'X'KB ;NO PAGE MAPPED IN
TST ITM'X'PB ;IS PREVIOUS ITEM A GIP?
BEQ ITM'X'L4 ;NOPE
BIT #100,ITM'X'DR ;WAS THIS GIP WRITTEN?
BEQ ITM'X'L4 ;NO, CAN IGNORE IT
SAVE B ;SAVE A REGISTER
MOV ITM'X'PB,B ;THE THING TO INDICATE WAS WRITTEN
JSR PC,ITMGWT ;GO MARK IT AS WRITTEN
REST B
ITM'X'L4: CLR ITM'X'PB
MOV A,ITEM'X ;THIS IS NOW THE CURRENT ITEM
BLT ITM'X'L1 ;NOT REALLY AN ITEM
MOV ITMTAB(A),ITM'X'AR ;SET THE AR
MOV ITMTAB+ITACCS(A),ITM'X'DR ;AND THE DR
ITM'X'L2:
REST PS
MOV #ITM'X'AD,A ;AND THE ADDRESS
RTS PC
ITM'X'L1: CMP A,#-1
BNE ITM'X'L3 ;ITS A GIP
CLR ITM'X'DR ;MAKE THE ITEM NXM
BR ITM'X'L2 ;GO FINISH
ITM'X'L3: SAVE <C,B,A> ;SAVE REG AND GIP AND LOAD UP A UPT
MOV #-1,ITEM'X ;SO WHEN WE POP ITEM2 WE WIN
JSR PC,ITMGIP
REST <ITEM'X> ;SET ITEM FIRST TO AVOID TIMING SCREW
MOV A,ITM'X'DR ;CAN ONLY RECURSE ONE LEVEL
MOV B,ITM'X'AR
MOV C,ITM'X'PB
MOVB #-1,ITM'X'KB ;LEGAL TO GET A PAGE TRAP ON THIS PAGE
REST <B,C> ;RESTORE REGISTER
BR ITM'X'L2
;POP THE TOP ITEM OFF THE STACK
ITM'X'PO: SAVE A ;DON'T CLOBBER A
DEC ITM'X'D ;INDICATE POPED ONE LEVEL
BUGC LT ;DID WE OVER POP?
MOV @ITM'X'P,A ;GET THE OLD THING
ADD #2,ITM'X'P ;FLUSH ITFROM THE PDL
JSR PC,ITM'X'LD ;LOAD THE OLD ITEM
REST A
RTS PC
.ENDM
;CLEAR THE VALID AT SWAP SPACE AND VALID AT SOURCE BITS OF THE GIP POINTED TO BY A
ITMGWT: BIT #PBVACR,PBFLAG(B) ;BETTER BE VALID IN CORE!
BUGC EQ ;UGH, GOT OUT BEFORE WE MAPPED IT OUT!
BIC #PBVASS!PBVAS,PBFLAG(B) ;CAN'T BE VALID AT SWAP SPACE OR SOURCE, WE'VE WRITTEN IT
RTS PC
ITMGIP: SAVE <D,E>
MOV A,B
JSR PC,UPTPLD ;RETURN ADDRESS OF UPT IN B
BIT #UPTABS,(B) ;CHECK THAT IT ISN'T AN ABSOLUTE PAGE
BUGC NE
MOV B,E ;COPY POINTER TO THE UPT
MOV UPTPBP(E),D ;GET A POINTER TO THE PB
BIT #PBVACR,PBFLAG(D) ;IS IT VALID IN CORE?
BEQ ITMGP2 ;NO, FORGET ABOUT IT
MOVB UPTSTL(E),A ;GET THE UPT START
BLT ITMGP2 ;NOT SET UP YET
BIC #UPTSMS,A ;CLEAR OTHER BITS
.IIF NZ 4-UPTSSH,ASH #4-UPTSSH,A ;SHIFT IF NEEDED
MOVB PBRAN(D),C ;GET THE PB START
BIC #PBSTRT,C ;CLEAR OTHER STUFF
ASH #4,C ;32.=512.
SUB A,C ;GET PBSTART-UPTSTART
NEG C ;CHANGE TO UPTSTART-PBSTART
MOV PBCAR(D),B ;THE PB START ADDRESS
ASH #4,B ;CONVERT TO 32 WORD BLOCKS
ADD C,B ;CORRECTED
MOVB UPTSTL(E),A ;GET START AND LENGTH AGAIN
BIC #UPTLMS,A ;GET LENGHT OF PAGE
ASH #4,A ;IN 32 WORD BLOCKS
SWAB A ;PUT IT INTO THE RIGHT PLACE
BIS #17_8.+4,A ;OTHERWISE FIX UP THE DR
ITMGP1: MOV D,C ;RETURN PB POINTER
REST <E,D>
JSR PC,ITM2PO
RTS PC
ITMGP2: CLR A ;NOBODY HOME
CLR D
BR ITMGP1
;RESTORE THE ITEM2 PDL OF TH EPROCESS POINTED TO BY A
ITM2RS: SAVE C
MOV A,C ;SAVE ANOTHER POINTER TO ITEM
ADD #PITM2P,C ;POINT AT ITEM2 STACK
MOV (C)+,A ;GET FIRST ITEM2
JSR PC,ITM2LD ;LOAD IT UP
ITM2R3: DEC PITM2C(B) ;ONE LESS TO LOAD
BLT ITM2R4 ;NO MORE
MOV (C)+,A ;GET NEXT ONE
JSR PC,ITM2PL ;LOAD
BR ITM2R3
ITM2R4: REST C
RTS PC
.SBTTL .RDMAP AND .MAP
;.RDMAP => READ THE MAP OF A SPHERE INTO THE USERS CORE.
;FIRST ARGUMENT IS THE SPHERE CAPABILITY OF THE MAP TO READ
;SECOND ARGUMENT IS A POINTER INTO THE USERS CORE, WHERE TO PUT
;MAP INFO. IT RETURNS 16 WORDS IN THE FOLLOWING FORMAT.
;BOTTOM 3 BITS ARE THE LENGTH OF THE PAGE., THE TOP BIT IS D=I, NEXT IS ABS
;NEXT IS FILE PAGE BIT.
ERDMAP: JSR PC,RETNSW ;GET THE SPHERE CAPABILITY
MOV A,B ;COPY IT
BIC #177400,B ;CLEAR THE EXTRA BITS
MOV ITM1A,A ;THE CURRENT SPHERE
JSR PC,GCLSTA ;FIND THE CPABILITY
BEQ RDMAP1 ;FAILED
ADD A,B ;POINT TO THE CAPABILITY DIRECTLY
CMPB (B),#.MSCAP ;IS IT A MS CAPABILITY
BEQ RDMAP2 ;YES, EVERYTHING IS OKAY
CMPB (B),#.SPCAP ;IS IT A SPHERE CAPABILITY
BEQ RDMAP2 ;YES, IT IS OKAY SO FAR
RDMAP1: ERROR BCT ;FAILED
RDMAP2: BIT #.SPCRR!.SPCRW,(B) ;DOES HE HAVE ACCESS
BEQ RDMAP1 ;NO
MOV 2(B),A ;THE SPHERE TO READ THE MAP FROM
JSR PC,ITM2LD ;LOAD IT UP
JSR PC,RETNSW ;GET THE POINTER INTO HIS CORE
MOV #20,B ;THE NUMBER OF WORDS WE ARE RETURNING
MOV A,C ;COPY IT
RDMAP3: MFPD (A) ;MAKE SURE ALL THE WORDS ARE WRITABLE
MTPD (A)+
SOB B,RDMAP3
MOV ITM2A,A ;POINTER TO THE UPTS
MOV #20,B ;NUMBER OF THEM
ADD #SUPTS,A ;POINT TO THE UPT'S DIRECTLY
RDMAP4: CLR D ;NO PAGE
BIT #UPTEXB,(A) ;HELLO?
BEQ RDMAP5 ;NOBODY HERE
BIT #UPTABS,(A) ;ABS PAGE?
BEQ 2$ ;NOPE
MOV UPTGIP(A),F ;LENGTH OF ABS PAGE
ASH #-12.,D ;IN 512 WORD BLOCKS
BIS #.PABS,D ;YUP
BR 3$
2$: MOVB UPTSTL(A),D ;GET START AND LENGTH
BIC #177760,D ;CLEAR EXTRA BITS TO GET LENGTH
BIT #PBFILE,@UPTPBP(A) ;FILE PAGE?
BEQ 3$ ;NOPE
BIS #.PFIL,D ;TELL HIM
3$: BIT #UPTDEI!UPTIED,(A) ;I=D?
BEQ 1$ ;NOPE
BIS #.PDEI,D ;TELL USER
1$: BIS #.CRRD,D ;READ ALLOWED
BIT #UPTRDO,(A) ;WRITE ALLOWED?
BNE 4$ ;NO, READ ONLY
BIS #.CRWRT,D ;WRITE ALLOWED
4$: BIT #UPTEXO,(A) ;DATA SPACE ALLOWED?
BEQ RDMAP5 ;YUP
BIS #.CREX,D ;EXECUTE ONLY
RDMAP5: SAVE D ;THE INFO WORD
MTPD (C)+ ;RETURN IT TO HIM
ADD #UPTLEN,A ;POINT TO THE NEXT ONE
SOB B,RDMAP4 ;DO ALL THE PAGES
JMP ERETCZ ;DONE
;.MAP
;CREATE A PAGE FOR A SPHERE,
;THE FIRST BYTE IS THE SPHERE CAPABILITY TO THE DESTINATION SPHERE
;THE SECOND IS THE ACCESS INFO (READ, WRITE, AND PRIVATE OR PUBLIC COPY)
;THE THIRD IS THE SOURCE OF THE PAGE
;(FILE ACCESS CAP. OR SPHERE CAP, -1 FOR FRESH PAGE, -2 FOR ABSOLUTE PAGE,
;OR -3 FOR JUST DELETE THIS PAGE)
;THE FOURTH IS THE UPT NO. OF THE PAGE TO CREATE
;(0-7 UPT NO. IS I SPACE, 10-17 IS D-SPACE, 20-27 IS I=D SPACE)
;THE FIFTH AND SIXTH ARE THE PAGE NO. IN SOURCE (IF FILE)
;THE SEVENTH IS THE START OF THE PAGE (IN 512. WORD BLOCKS)
;THE EIGHTH IS THE LENGTH-1" " " " " " "
;IF IT IS A REQUEST FOR A PUBLIC PAGE, AND IT IS PART OF A FILE AND HE
;IS ASKING FOR WRITE ACCESS, CLEAR THE BYTE AND WORD LEFT FLAGS IN MFI
;IF IT IS ANOTHER SPHERE, AND IT IS A REQUEST FOR A PUBLIC PAGE, AND HE
;IS ASKING FOR WRITE ACCESS, EXPAND THE PAGE, AND LINK THE UPT'S TOGETHER
EMAP: SUB #10,P ;MAKE 4 STORAGE CELLS
MOV P,D ;GET POINTER TO THE STORAGE
MOV #4,B ;THE NUMBER OF ARGS
EMAP1: JSR PC,RETNSW ;GET THE SPHERE CAP AND FLAGS
MOV A,(D)+ ;SAVE IT
SOB B,EMAP1
JSR PC,SAVAWB ;SAVE CURRENT A&W BITS
MOV (P),B ;THE SPHERE CAP
BIC #177400,B ;CLEAR THE EXTRA BITS
MOV ITM1A,A ;THE ADDRESS OF THE ITEM
JSR PC,GCLSTA ;FIND THE CAPABILITY
ERRORC EQ,BCN
ADD B,A ;MAKE A POINT TO THE SPHERE CAP
MOV (A),B ;GET THE TYPE AND FLAGS
ERRORC EQ,BCN
CMPB B,#.SPCAP ;IS IT A SPHERE CAPABILITY
BEQ EMAP3 ;YES
CMPB B,#.MSCAP ;IS IT A MASTER SPHERE CAPABILITY
BEQ EMAP3 ;YES
ERROR BCT ;BAD CAPABILITY TYPE
EMAP3: BIT #.SPCRW,B ;IS HE ALLOWED TO MODIFY THE CORE MAP?
ERRORC EQ,BAC ;BAD ACCESS
MOVB 3(P),B ;THE UPT NO.
CMP B,#30 ;IS IT A LEGAL PAGE
ERRORC HIS,BPN ;BAD PAGE NUMBER
MOV (P),C ;THE ACCESS
BIC #377,C ;CLEAR THE LOW BYTE
CLR E ;IN CASE THERE IS NO ACCESS
BIT #.CRRD,C ;ASKING FOR READ ACCESS
BEQ 1$ ;NO,
MOV #UPTRDO!UPTEXB,E ;SAY READ ONLY ACCESS
1$: BIT #.CRWRT,C ;ASKING FOR WRITE ACCESS
BEQ 2$ ;NO
MOV #UPTEXB,E ;SAY WRITE ACCESS
2$: BIT #.CREX,C ;ASKING FOR EXECUTE ONLY ACCESS
BEQ EMAP5 ;NO
CMPB 3(P),#10 ;BETTER BE AN I SPACE PAGE
ERRORC LT,BAC ;BAD ACCESS
EMAP5: CMP B,#20 ;IS IT I=D
BLT 1$ ;NO
SUB #10,B ;MAKE IT POINT TO THE D PAGE
1$: ASH #10.,B ;SET IT INTO CORRECT PLACE
MOV CLSEPI(A),F ;THE SPHERE AFFECTED
ASH #-2,F ;ITEMS ARE MULTIPLES OF 4
BIS B,F ;MAKE A GIP
BIS #GIPSPR!GIPBIT,F
MOV F,B ;GIP TO THE UPT TO DELETE
CMPB 2(P),#-4 ;IS IT A PAGE EXPAND REQUEST?
LBR EQ,PAGEXP ;YES
BITB #20,3(P) ;IS IT I=D
BEQ EMAP4 ;NO JUST DELETE CURRENT PAGE
JSR PC,UPTDL ;DELETE IT
SUB #<10_10.>,F ;MAKE IT POINT TO THE I UPT
MOV F,B ;COPY IT AGAIN
EMAP4: JSR PC,UPTDL ;DELETE THE UPT
MOVB 2(P),B ;THE SOURCE
CMP B,#-3 ;IS IT REQUEST FOR JUST FLUSHING PAGE
LBR EQ,EMAPRT ;JUST RETURN
TSTB B
BGE EMAP6 ;ITS A CAPABILITY
MOVB 6(P),D ;THE START
ERRORC LT,BAD ;BAD: NEGATIVE START
MOVB 7(P),C ;THE LENGTH OF THE BLOCK TO CREATE
ERRORC LT,BAD ;NO NEGATIVE LENGTHS
ADD C,D ;GET THE SUM OF THE LENGTH AND START
ERRORC VS,BAD ;OVER FLOW
CMP D,#10 ;IS THE SUM OF THE START AND LENGTH OVER 10
ERRORC GE,BAD ;YES, LOSE LOSE
CMP B,#-1 ;IS IT A REQUEST FOR A FRESH PAGE
LBR EQ,MAPFRS ;YES
CMP B,#-2 ;IS IT REQUEST FOR ABSOLUTE PAGE
BEQ MAPABS ;GET AN ABSOLUTE PAGE
ERROR BFUN
EMAP6: MOV ITM1A,A ;GET THE ADDRESS
JSR PC,GCLSTA ;GET THE OFFSET OF THE CAPABILITY
ERRORC EQ,BCN ;COULDN'T GET IT
ADD B,A ;MAKE A POINT DIRECTLY TO IT
MOV (A),B ;THE FLAGS WORD OF THE CAPABILITY
ERRORC EQ,BCN ;NO CAPABILITY
CMPB B,#.FACAP ;IS IT A FILE ACCESS CAPABILITY
LBR EQ,MAPFIL ;YES
.IF NZ NTVS
CMPB B,#.DSCAP ;IS IT A DISPLAY CAPABILITY
LBR EQ,MAPDS ;YES
.ENDC
CMPB B,#.SPCAP ;IS IT A SPHERE
BEQ MAPSPR ;YES
CMPB B,#.MSCAP ;IS IT A MASTER SPHERE
BEQ MAPSPR ;YES
ERROR BCT ;CAN'T MAP THIS TYPE
MAPSPR: CMP 4(P),#17 ;IS HE ASKING FOR A LEGAL PAGE?
ERRORC HI,BAD ;NO
MOV 2(A),A ;GET THE SPHERE
JSR PC,ITM1PL ;LOAD IT UP
ADD #SUPTS,A ;POINT TO THE FIRST UPTS
MOV 4(P),D ;THE PAGE NO.
MUL #UPTLEN,D ;GET THE LENGTH OF THE OFFSET
ADD D,A ;POINT TO THE UPT IN SPHERE
MOV F,B ;POINTER TO PAGE TO CREATE
JSR PC,UPTPLD ;LOAD IT UP
BIT #UPTRDO,(A) ;IS IT READ ONLY?
BEQ MAPSP3 ;NO, FINE
BIT #UPTRDO,E ;IS HE ASKING FOR READ ONLY?
ERRORC EQ,BAC ;BAD ACCESS
MAPSP3: MOV #UPTLEN/2,C ;THE LENGTH IN WORDS
MOV B,D ;COPY POINTER TO UPT
1$: MOV (A)+,(D)+ ;COPY UPT
SOB C,1$
BIC #UPTDEI!UPTIED,-UPTLEN(D) ;DONT WANT THE NEW PAGE D=I UNLESS HE ASKS
BIT #UPTABS,-UPTLEN(A) ;COPYING ABS PAGE?
BNE MAPSP2 ;YES, NO CIRC LIST
MOV F,-UPTLEN+UPTGIP(A) ;MAKE COPIED POINT TO THE COPY
MAPSP2: JSR PC,ITM1PO ;POP THE SPHERE WE COPIED
MAPSP1: JMP MAPFR2 ;TAKE CARE OF I=D, ETC.
MAPABS: BIT #UPTRDO,E ;HAD BETTER BE READ ONLY
ERRORC EQ,BAC
CMP C,#7
ERRORC HI,BAD
ASH #12.,C
BIS #7401,C ;SET IN ACCESS
MOV 4(P),A ;THE START IN 512. WORDS BLOCKS
CMP #256.,A ;HIGHER THAN THE HIGHEST BLOCK?
ERRORC LOS,BAD
ASH #4,A ;PUT IT INTO THE CORRECT BITS
MOV F,B
JSR PC,UPTPLD ;LOAD THE UPT
MOV #UPTABS!UPTEXB!UPTRDO,(B)+
MOV A,(B)+ ;SET IN UPTAR
MOV C,(B)+ ;SET IN UPTDR
SUB #6,B ;BACK UP THE POINTER TO THE START OF THE UPT
JMP MAPFR2 ;CHECK FOR I=D, ETC.
;HERE SET UP THE DISPLAY'S PAGES AS ABSOLUTE PAGES
.IFNZ NTKDIS+NTVS
MAPDS: .IFNZ NTVS
TST (A) ;TV OR TK?
BLT MAPTV
.ENDC
MOV 2(A),C ;THE ITEM OF THE DISPLAY
MOV F,B ;THE PLACE TO PUT IT
JSR PC,UPTPLD ;LOAD IT UP
MOV B,D ;COPY POINTER TO UPT
MOV #UPTABS!UPTEXB,(D)+
MOV ITMTAB(C),(D)+ ;SET IN THE AR
MOV ITMTAB+ITACCS(C),(D) ;SET IN THE DR
CLR E
MAPDS1: JMP MAPFR2 ;TAKE CARE OF D=I ETC.
.ENDC
.IFNZ NTVS
MAPTV: MOV F,B ;THE PAGE
JSR PC,UPTPLD ;LOAD IT
MOV 4(P),C ;DESIRED PAGE NUMBER
CMP #4,C ;IS IT A GOOD NUMBER?
ERRORC LO,BAD ;NOPE
BEQ MAPTV1 ;GIVE THE REGISTERS
ASH #7,C ;BLOCK NUMBER TO OFFSET
ADD #<128.-4-16.>_5,C ;WHERE THE TV GOES
MOV C,2(B) ;THE AR
MOV #77406,4(B) ;THE DR
BR MAPTV2 ;GO FINISH
MAPTV1: MOV #<TVINCR_-6>&1777!6000,2(B) ;THE AR
MOV #6,4(B) ;THE DR
MAPTV2: MOV #UPTABS!UPTEXB,(B) ;ABSOLUTE PAGE
JMP MAPFR2 ;I=D ETC
.ENDC
;A POINTS TO THE FA CAP.
;F IS GIP TO THE UPT TO CREATE
;E HAS ACCESS REQUESTED
MAPFIL: SAVE E ;SAVE ACCESS
BIT #UPTRDO,E ;IS ALL HE WANTS READ?
BNE 1$ ;YES, FINE
BIT #.FAWT,(A) ;DOES HE HAVE WRITE ACCESS?
ERRORC EQ,BAC ;BAD ACCESS
1$: MOV FAMFI(A),A ;GET THE RIGHT MFI
MOV 6(P),C ;GET THE PAGE NUMBER DESIRED
JSR PC,MAKFPB ;GET THE RIGHT PB
SAVE B ;SAVE PB POINTER
MOVB 13(P),D ;GET THE LENGTH
CMP #-1,D ;DOES HE WANT ALL WE GOT?
BNE MAPFI1 ;NOPE, SOMETHING ELSE
MOVB PBFLEN(B),D ;GET THE LENGTH
DEC D ;1=>0
ERRORC LT,BAD
MAPFI1: CMP #7,D ;IS LENGTH LEGAL?
ERRORC LO,BAD ;NOPE
MOVB 12(P),C ;GET START
CMP #7,C ;IS START LEGAL?
ERRORC LO,BAD ;NOPE
JSR PC,PBSETU ;FIX UP THE PB
ERRORC EQ,RPEF ;HE ASKED FOR TOO MUCH
TST PBDA(B) ;ALREADY GOT SWAP SPACE?
BNE MAPFI8 ;YUP, DON'T ALOCATE AGAIN
BIT #PBNOSW,PBFLAG(B) ;DON'T ALLOCATE SWAP SPACE?
BNE MAPFI8 ;RIGHT, I WON'T
JSR PC,FINSWP ;GET SOME, BUT DON'T CARE IF YOU LOSE
MAPFI8: MOV F,B ;COPY GIP
JSR PC,UPTPLD ;LOAD IT UP
ASH #UPTSSH,C ;PUT START INTO RIGHT PLACE
BIS C,D ;COMBINE WITH LENGTH
MOVB D,UPTSTL(B) ;SET UP IN NEW UPT
REST C ;GET BACK PB POINTER
MOV C,UPTPBP(B) ;POINT UPT AT PB
JSR PC,PCLCLR ;SAFE NOW
MOV PBGIP(C),E ;GET POINTER INTO CIRCULAR LIST
BEQ MAPFI2 ;THERE IS NONE
SAVE B ;SAVE POINTER INTO GIP
MOV E,B ;GET FIRST IN CIRC LIST
JSR PC,UPTPLD ;LOADED UP
SAVE UPTGIP(B) ;SAVE WHAT IT POINTS TO
MOV F,UPTGIP(B) ;POINT IT AT NEW THING
JSR PC,ITM2PO ;BACK UP
REST <E,B>
MOV E,UPTGIP(B) ;POINT NEW AT WHAT OLD POINTED AT
BR MAPFI3
MAPFI2: MOV F,PBGIP(C) ;POINT PB AT NEW CIRC LIST
MOV F,UPTGIP(B) ;OF ONE ITEM
MAPFI3: BIS #UPTEXB,(B) ;PAGE EXISTS
REST E ;GET ACCESS BACK
JMP MAPFR2
MAPFRS: MOV C,B ;THE SIZE OF THE PAGE
JSR PC,PBGET ;GET A PAGE BLOCK FOR THE NEW PAGE
JSR PC,FINSWP ;TRY TO FIND SOME SWAP SPACE FOR IT
BNE MAPFR1 ;GOT SOME
JSR PC,FRELSE ;FREE THE PB, WE LOST
ERROR NSS ;NO SWAP SPACE
MAPFR1: SAVE B ;SAVE POINTER TO PB
MOV F,PBGIP(B) ;NEW PB POINTS TO GIP BEING CREATED
MOV F,B ;THE GIP TO THE PAGE BEING CREATED
JSR PC,UPTPLD ;LOAD IT UP
MOV #UPTEXB,(B) ;FLAGS
REST A
MOVB PBLEN(A),UPTSTL(B) ;COPY THE LENGTH
MOV A,UPTPBP(B) ;GET THE PB POINTER
MOV F,UPTGIP(B) ;POINT TO YOURSELF
MAPFR2: BIC #UPTEXO!UPTRDO,(B) ;CLEAR OLD ACCESS
BIS E,(B) ;SET IN THE ACCESS
MOVB 3(P),C ;GET THE PAGE NO. AGAIN
BIT #UPTABS,(B) ;ABS PAGE?
BNE MAPFR4 ;IGNORE IT
BIT #UPTEXB,(B) ;DOES IT EXISTS?
BEQ MAPFR4 ;NO, IGNORE IT
SAVE <B,C>
MOV ITM2A,A ;GET SPHERE BEING AFFECTED
MOV SPHAPR(A),C ;NUMBER OF ACTIVE PROCESSES
CMP #20,(P) ;MAPPING IN TWICE?
BGT 1$ ;NOPE
ASL C ;TWICE AS MANY REFERENCES
1$: MOV UPTPBP(B),B ;THE AFFECTED PB
JSR PC,PBACT ;ACTIVATE PAGE
REST <C,B>
MAPFR4: CMP C,#20 ;IS IT A D=I PAGE
BLT MAPFR5 ;NOPE
MOV B,D ;COPY POINTER TO UPT
MOV B,E ;AND A POINTER TO THE DATA HALF
ADD #<UPTLEN*10>,E ;INTO THE SECOND HALF
MOV #UPTLEN/2,C ;THE LENGTH OF THE UPT
1$: MOV (D)+,(E)+ ;COPY THE UPT ENTRY
SOB C,1$ ;COPY ALL THE WORDS
SUB #UPTLEN,E ;MAKE IT POINT AT THE NEW ONE AGAIN
BIS #UPTIED,(B) ;ON THIS HALF, DATA=I
BIS #UPTDEI,(E) ;AND ON THIS HALF, THE OPPISTIE
MOV F,A ;COPY GIP TO DATA HALF
BIS #20000,F ;MAKE IT POINT TO THE TOP HALF
BIT #UPTABS,(B) ;ABS PAGE?
BNE MAPFR5 ;YES, NO CIRC LIST
MOV F,UPTGIP(B) ;POINT FIRST HALF AT SECOND
MAPFR5: JSR PC,ITM2PO ;POP THE SPHERE
EMAPRT: ADD #10,P ;POP OFF THE ARGUMENTS
EMAPR1: JSR PC,MAPRE1 ;MAKE SURE HIS MAP GETS MODIFIED IMMEDIATELY
MAPFR3: JMP ERETCZ ;SUCESS
PAGEXP: SAVE <E,F>
CMPB #20,7(P) ;IS HE ASKING TO AFFECT AN I=D PAGE?
BGT PAGEX1 ;NOPE
SAVE F ;SAVE THE D PART
SUB #<10_10.>,F ;GET THE D PART
MOV F,B ;FOR UPTLD
JSR PC,UPTLD ;POINT US AT THE UPT
BIT #UPTIED,(B) ;BETTER BE A D=I PAGE
ERRORC EQ,BAD
BR PAGEX2
PAGEX1: SAVE <#0> ;NO OTHER HALF
MOV F,B ;COPY FOR UPTLD
JSR PC,UPTLD
BIT #UPTDEI!UPTIED,(B) ;BETTER NOT BE D=I
ERRORC NE,BAD ;CAN ONLY DO BOTH TOGETHER NOW
PAGEX2: SAVE B
BIT #UPTRDO,E ;DOES HE WANT READ ONLY?
BNE 1$ ;CAN'T LOSE
BIT #UPTRDO,(B) ;OLD PAGE READ ONLY?
ERRORC NE,BAC ;YES, BAD ACCESS
1$: BIT #UPTEXB,(B) ;DOES THE PAGE EXIST?
ERRORC EQ,BAD ;NOPE
BIT #UPTABS,(B) ;ABSOLUTE PAGE?
ERRORC NE,BAD ;YUP
MOV UPTPBP(B),B ;GET PB POINTER
BIT #PBVAS,(B) ;IS IT VALID AT SOURCE?
BNE PAGEX3 ;YUP
MOV F,B ;GET THE GIP
JSR PC,SWPIN ;MAKE SURE IT IS IN
JSR PC,VALSRC ;GO AND VALIDATE IT
JSR PC,GPWAIT ;WAIT FOR IT TO BE OUT
REST <B,,F,E>
BR PAGEXP ;TRY AGAIN
PAGEX3: REST <B,(P)>
CLR E ;THIS WILL ACCUMULATE BITS
MOVB 12(P),C ;GET START
MOVB 13(P),D ;GET LENGTH
JSR PC,EBSET ;ACCUMLATE BITS FOR DESIRED THING
SAVE <F,UPTGIP(B)> ;PUT THE NEXT THING
PAGEX4: MOV (P),B ;GET CURRENT UPT
JSR PC,UPTLD ;LOAD IT UP
CMP 4(P),(P) ;IS CURRENT ONE THE I HALF OF THE D=I?
BEQ PAGEX5 ;YES, IGNORE IT
CMP 2(P),(P) ;HAVE WE GOTTEN BACK TO THE BEGGINING?
BEQ PAGEX6 ;YES, DONE
JSR PC,UPTEST ;ACCUMULATE MORE BITS
PAGEX5: MOV UPTGIP(B),(P) ;GET NEXT ONE
BR PAGEX4
PAGEX6: MOV UPTPBP(B),B ;GET THE PB
JSR PC,PBLFIX ;GO FIGURE OUT E AND SET UP THE PB APPROPRIATELY
MOV 2(P),B ;GET BACK THE ORIGINAL
JSR PC,UPTLD ;AND LOAD IT
ADD #6,P ;FLUSH TEMPS
MOVB 10(P),C ;GET DESIRED START
MOVB 11(P),D ;AND LENGTH
ASH #UPTSSH,C ;PUT START IN RIGHT PLACE
BIS C,D ;COMBINE THEM
MOVB D,UPTSTL(B) ;WE DID THE WORK, REAP THE BENIFITS
REST E ;GET DESIRED ACCESS
BIC #UPTEXO!UPTRDO,(B) ;CLEAR OLD ACCESS
BIS E,(B) ;SET NEW ACCESS
BIT #UPTIED,(B) ;DID WE DO ONLY HALF THE JOB?
BEQ PAGEX7 ;NO, NOT AN I=D
MOVB D,UPTSTL+<UPTLEN*10>(B) ;SET IN THE DATA HALF
BIC #UPTEXO!UPTRDO,<UPTLEN*10>(B) ;CLEAR OLD
BIS E,<UPTLEN*10>(B) ;SET NEW
PAGEX7: ADD #10,P ;FLUSH ARGS
JMP EMAPR1 ;AND RETURN
.STITL FILE ACCESS CAPABILITY ROUTINES, CREATE FA CAP
CCPRFA: JSR PC,GETWRD ;GET THE FLAG WORD FROM THE USER
BIT #.FARUT,A ;DOES HE WANT A ROOT DIR?
BNE CCFA.1 ;GO TRY FOR THAT
MOV A,C
MOV #0,D ;FOR NOW, ALL TEMP FILES ON DISK 0
JSR PC,CRDMFL ;CREATE A DUMMY MFI
MOV #MFDWDB!MFTMPF,MFLAGW(C) ;SAY IT IS DELETE WHEN DONE AND TEMPORARY
MOV #MFFILE!MFEOFB+<MFNAME-MFENHD+1>,MFENHD(C) ;SAY IT IS A FILE WITH NO BLOCK AT THE EOF, TIME AND DATE EXIST, DUMMY LENGTH
JSR PC,MFFEND ;SET UP VARIOUS WORDS
JSR PC,LSWPOP ;WON'T GET PCLOSERED
MOV A,B ;COPY ITEM POINTER
MOV #.FAEOF!.FARD!.FAWT!.FAAP!.FAAC!.FACAP,A ;GIVE HIM ALL PERRMISSIONS
CLR C
CLZ
RTS PC
;COME HERE TO CREATE A ROOT DIRECTORY
CCFA.1: BIC #177701,A ;WHCIHC DISK DOES HE WANT?
CMP #NDISKS*2,A ;BIGGER THAN BIGGEST DISK?
ERRORC LE,BAD ;THIS USED TO CRASH THE SYSTEM
TST MFBLNK(A) ;THAT ONE ALREADY EXIST?
ERRORC NE,BAD ;YES, BAD DISK
MOV A,D ;COPY DISK NUMBER
JSR PC,CRDMFL ;GET A MFI
MOV #MFOPNB!.FADIR!.FARUT,MFLAGW(C) ;NOT DONE OPENING, DIRECTORY, ROOT DIRECTORY, WRITE TO SOURCE
MOV #MFDIRE!MFLSTB!MFEOFB+<MFNAME-MFENHD+2>,MFENHD(C) ;DIRECTORY, EOF POINTS TO EXISTING BLOCK, TIME AND DATE EXIST, LENGTH OF DUMMY
MOVB #46,MFNAME+1(C) ;SKIP 46 (GETS YOU TO THE ROOT)
JSR PC,DIRENT ;THIS CONVERTS THE DUMMY MFI TO THE REAL THING
JSR PC,MFFEND ;SET STUFF UP
JSR PC,LSWPOP
MOV A,B ;COPY ITEM NUMBER
MOV #.FADIR!.FARD!.FAAP!.FAAC!.FACAP,A ;MOST PRIVILIGES, BUT NOT WRITE
CLR C
CLZ
RTS PC
;CREATE A DUMMY MFI FOR TEMP FILES AND ROOT DIRECTORIES
CRDMFL: JSR PC,CRMFI ;GET AN MFI
ERRORC EQ,NIS ;NO ITEM SPACE AVAILABLE FOR IT
MOV ITM2A,C ;POINT TO THE NEW MFI
MOV #377,MFNAME(C) ;NAME IS RUBOUT
MOV D,MFDISK(C) ;SET THE DISK # IN TH EMFI
MOV MFBLNK(D),MFDLNK(C) ;LINK THE NEW MFI
MOV A,MFBLNK(D) ;INTO THE LIST FOR THIS DISK
RTS PC
.SBTTL FILE CAPABILITY ROUTINES- RANDOM INVOKES
CAPRFA: REST <B,E,F>
MOV A,D ;OTHER PEOPLE EXPECT THIS HERE
SWAB B
BIC #177401,B
CMP B,#MFAHGH
LBR GT,CAPRC2
JMP @FATAB(B)
MFARE: MOV FAMFI(D),A ;RETURN EOF POINTER
JSR PC,ITM2LD
MOV MFPGNO(A),E
CLR F
ASHC #-3,E
ADD MFBYTP(A),F
MOV F,B
JSR PC,GIVPSW
MOV E,B
JSR PC,GIVPSW
BR MFARTN
MFACF: BIC #<-.FARD-.FAWT-.FAAP-.FAAC>-1,E ;CLEAR ACESS FLAGS
BIC E,(D)
BR MFARTN
MFASP: MOV F,FAFBP(D) ;SET FILE POINTER
BIC #160000,FAFBP(D)
ASHC #3,E
MOV E,FAFPN(D)
BIS #.FAEOF,(D) ;FORCE EOF CHECK
BR MFARTN
MFARP: MOV FAFPN(D),A ;RETURN POINTER
CLR B
ASHC #-3,A
ADD FAFBP(D),B
JSR PC,GIVPSW
MOV A,B
JSR PC,GIVPSW
MFARTN: JMP ERETCZ
;RETURN INFO ABOUT THE DISK A FILE IS ON
MFADI: MOV FAMFI(D),A ;GET THE MFI
JSR PC,ITM2LD ;LOAD IT UP
MOV MFDISK(A),C ;THE DISK NUMBER
MOV C,B ;THE DISK NUMBER
ASR B ;2=>1
JSR PC,GIVPSW ;BACK TO THE USER
MOV MFFREE(C),B ;NUMBER OF FREE BLOCKS
JSR PC,GIVPSW
BR MFARTN
;SET UP BIT TABLE FOR THE DISK THE BIT TABLE FILE IS ON
MFAMB: MOV FAMFI(D),A ;GET THE MFI
JSR PC,ITM2LD ;LOAD IT UP
MOV MFDISK(A),D ;GET DISK NUMBER
MOV MFBYTP(A),F ;GET LENGHT IN BYTES
DEC F ;MAKE 2000=1777
ASH #-10.,F ;CONVERT TO BLOCKS
CLR E ;START AT 0
CLR C ;ON PAGE ZERO
MOV ITEM2,A ;GET MFI AGAIN
JSR PC,MAKFPG ;MAKE A FUPT FOR THE BIT TABLE
BUGC EQ ;FAILED?
MOV C,A ;COPY THE UPT POINTER
JSR PC,ITM2LD ;LOAD THE BIT TABLE
MOV (A)+,B ;NUMBER OF BLOCKS ON EMPTY DISK
CLR MFFREE(D) ;NUMBER OF FREE BLOCKS
MOV C,MFBITS(D) ;SAVE MFI OF BIT TABLE
BIC #GIPBIT,C ;MAKE INTO FUPT ADDRESS
MOV UPTPBP(C),E ;GET PB POINT
BIS #PBNOSW!PBWCHK,(E) ;NEVER ASSIGN SWAP SPACE TO BIT TABLES AND WRITE-CHECK THEM
MFAMB1: MOV #16.,C ;NUMBER OF BITS/WORD
MOV (A)+,E ;GET A WORD OF BITS
MFAMB2: ROR E ;GET A BIT TO TEST
BCS 1$ ;NOT FREE
INC MFFREE(D) ;ONE MORE FREE
1$: DEC B ;PAST TOTAL BLOCKS?
BEQ MFAMB3 ;YUP
SOB C,MFAMB2 ;DO WHOLE WORD
BR MFAMB1 ;DO NEXT WORD
MFAMB3: JSR PC,LSWPOP
JMP ERETCZ ;RETURN
.SBTTL FILE ACCESS CAP ROUTINES-MUTATE
MFAMU: JSR PC,FAUPDL ;DELETE ANY UPT (IN CASE HE DID INPUT ON DIRECTORY)
CLR FAFBP(D) ;CLEAR THE FILE POINTER
CLR FAFPN(D)
JSR PC,MAKFNB ;MAKE UP A FILE NAME BLOCK
BNE MFAMU1 ;JSUT RETURN IF NOTHING THERE
JMP ERETCZ
MFAMU1: SAVE A ;SAVE POINTER TO THE NEW FNB
MOV FAMFI(D),A ;GET POINTER TO MFI
JSR PC,ITM2LD
BIT #.FADIR,MFLAGW(A) ;IS IT A DIRECTORY?
ERRORC EQ,BAC ;BAD CAPABILITY
MOV MFDISK(A),E ;THE DISK NUMBER
JSR PC,CRMFI ;CREATE AN MFI IN CASE WE NEED IT
ERRORC EQ,NIS ;NO ITEM SAPCE AVAILABLE
SAVE A ;SAVE POINTER TO THE NEW MFI
MOV ITM2A,C ;POINTER INTO MFI
MOV E,MFDISK(C) ;THE DISK NUMBER
MOV MFBLNK(E),MFDLNK(C) ;PUT THE NEW MFI
MOV A,MFBLNK(E) ;ONTO THE LIST FOR THIS DISK
MOV FAMFI(D),A ;GET BACK THE MFI
JSR PC,ITM2LD
MOV ITEM2,A ;POINTER TO THE MFI
MOV 2(P),B ;GET BACK POINTER TO THE FNB
JSR PC,DIRSER ;LOOK THE THING UP IN THE DIRECTORY
ERRORC EQ,FNF ;FILE NOT FOUND IN DIR
SAVE B ;SAVE POINTER INTO DIRECTORY
MOV 4(P),A ;POINTER TO THE FNB IN A
SAVE FNBFNO(A) ;GET NUMBER IN DIR, AS DETERMINED BY DIRSER
MOV FAMFI(D),B ;POINTER TO DIRECTORY
MOV C,FNBVER(A) ;SAVE AWAY THE EXACT VERSION NUMBER
JSR PC,MFISER ;SEARCH TROUGH THE MFIS FOR EXACT MATCH
;NOTE THAT THE DISK NUMBER IS STILL IN E...
BEQ MFAMU2 ;NONE FOUND, MUST CREATE NEW MFI
REST <E,B> ;GET BACK USELESS POINTER
MOV A,(P) ;SAVE INDEX OF PROPER MFI
JSR PC,ITM2LD ;LOAD UP THE MFI WE FOUND TO BE THE RIGHT THING
CMP E,MFIFNO(A) ;IS NUMBER IN DIR THE SAME?
BUGC NE ;UGH!
INC MFFREF(A) ;THERE IS ONE MORE CAP TO IT
JSR PC,LSWPOP ;DON'T NEED TO LOCK DIR ANY MORE
JSR PC,FRELSE ;FREE UP THE UNNEEDED MFI
BR MFAMU3 ;GO DO THE COMMON STUFF
MFAMU2: REST <E,B> ;GET BACK POINTER INTO DIR
SAVE D ;SAVE POINTER TO CAP
MOV (B),D ;GET HEADER WORD FROM DIR
MOV 2(P),A ;GET INDEX OF THE MFI
JSR PC,MFIEXP ;SEE IF MFI NEEDS EXPANDING
MOV E,MFIFNO(A) ;THE FILE NUMBER IN DIR, OBTAINED ABOVE
ADD #MFENHD,A ;POINT TO THE ENTRY PART OF THE MFI
ASR D ;CHANGE TO A COUNT
1$: MOV (B)+,(A)+ ;COPY FROM DIR
SOB D,1$
JSR PC,ITM1PO ;FLUSH MFI FROM THERE
MOV 2(P),A ;THE MFI AGAIN....
JSR PC,ITM2LD
MOV MFENHD(A),F ;GET HEADER WORD AGAIN
REST D
MOV FAMFI(D),MFBAKP(A) ;POINT AT PARENT
BIC #170777,F ;GET THE TYPE OF THE NEW ENTRY
CMP #MFDIRE,F ;IS IT A DIRECTORY?
BNE MFAMU4 ;NOPE, WE CAN RELAX
MOV (P),A ;GET THE MFI INDEX BACK
JSR PC,DIRENT ;GO DO THE MAGIC FOR THE DIRECTORY
MFAMU4: MOV (P),A ;MFI AGAIN
JSR PC,ITM2LD
JSR PC,MFFEND ;SET UP END POINTERS
BIC #MFOPNB,MFLAGW(A) ;OPEN NOW
JSR PC,LSWPOP ;FLUSH LOCK ON DIRECTROY
JSR PC,LSWPOP ;LOCK LOCK ON MFI WITHOUT DELETEING IT
MFAMU3: REST FAMFI(D) ;PUT INDEX OF PROPER MFI INTO CAP
MOV ITM2A,A ;POINTER TO MFI
BIT #.FADIR,MFLAGW(A)
BEQ 1$ ;NO, MUST BE A FILE
BIC #.FAWT,(D) ;MUSN'T WRITE ON DIR!
BR 2$
1$: BIC #.FADIR,(D) ;THIS IS NOT A DIR
BIS #.FAWT,(D) ;BUT YOU CAN WRITE ON IT
2$: CLR FAFPN(D) ;RESET POINTER
CLR FAFBP(D) ;TO BEGGINING OF FILE
BIS #.FAEOF,(D) ;SAY THAT WE ARE IN THE EOF BLOCK (EVEN THOUGH IT MIGHT NOT BE TRUE)
REST A ;GET BACK POINTER TO FNB
MOV FNBFNE(A),E ;GET WHAT USER'S POINTER SHOULD GET CLOBBERED TO
MOV ITM0A,A ;POINT TO OUR PROCESS BLOCK
MOV PUP(A),C ;USER'S PDL POINTER
ADD #2,C ;WANT TO CLOBBER HIS SECOND ARGUMENT
SAVE E ;TO SEND TO THE USER
MTPD (C) ;GIVE IT BACK TO HIM
JSR PC,LSWPOP ;FLUSH FNB
JMP MFAMU ;NOW GO AROUND AGAIN FOR THE NEXT NAME
;RETURN A BLOCK OF DATA ABOUT THE FILE THIS IS A CAPABILITY TO
;(F)= POINTS TO DESTINATION OF DATA
;(E)= NEGATIVE OF THE MAXIMUM NUMBER OF BYTES TO GIVE USER
MFARI: TST E ;IS IT NEGATIVE
BPL 1$
NEG E ;MAKE IT POSITIVE
1$: ASR E ;WE ONLY GIVE USER WORDS
BNE MFARI9
MOV #400,E ;GIVE HIM ALL THERE IS
MFARI9: SAVE (D) ;CAP. FLAGS
MTPD (F)+ ;GIVE USER FLAGS
MOV FAMFI(D),A
JSR PC,ITM2LD ;LOAD UP MFI
DEC E ;WORD COUNT
BEQ MFARI6
SAVE MFLAGW(A)
MTPD (F)+
ADD #MFENHD,A ;NOW POINTS TO ENTRY IN MFI
MOV 6(A),B ;EOF BYTE POINTER
ADD #1777,B ;ROUND IT UP
BIT #MFLSTB,(A) ;DOES THE LAST BLOCK EXIST
BEQ 1$
INC B ;CATCH TRICKY BOUNDARY PROBLEM
1$: BIC #1777,B
MOV 4(A),C ;EOF PAGE NUMBER
ASH #3,C ;BLOCK COUNT NOW
ADD C,B
DEC E ;WORD OCUNT
BEQ MFARI6
SAVE B ;LEGNTH OF FILE IN BLOCKS
MTPD (F)+
DEC E ;WORD OCUNT
BEQ MFARI6
SAVE 10(A) ;DATE
MTPD (F)+
DEC E ;WORD OCUNT
BEQ MFARI6
SAVE 12(A)
MTPD (F)+
JSR PC,MFNDNM ;MAKE A POINT TO NAME
CLR C
CLR B ;END OF NAME FLAG
SAVE #MFSENB ;SET UP CO-ROUTINE LINKAGE
MFARI1: BISB (A),C
TSTB (A)+
BGE MFARI2
BIC #200,C ;CLEAR HIGH BIT
INC B ;SET DONE FLAG
;FALLS INTO NEXT PAGE
;FALLS IN FROM ABOVE
MFARI2: JSR PC,@(P)+ ;GIVE HIM A BYTE
TST B
BEQ MFARI1 ;STILL MORE NAME
MOV ITM2A,A ;POINTER TO MFI
MOV MFVERN(A),B ;VERSION NUMBER
BLT MFARI8 ;NONE, DONE
BISB #'#,C ;INDICATE VERSION NUMBER
JSR PC,@(P)+ ;PASS TO USER
MOV #DECTAB,D ;POINTER TO TABLE OF NUMBERS
1$: CMP B,(D)+ ;IS NUMBER THIS BIG?
BGT 1$ ;NO, SUPRESS LEADING ZERO
TST -(D) ;WHAT WAS THAT AGAIN?
2$: CLR A ;CLEAR HIGH PART
DIV (D)+,A ;DIVIDE BY THIS POWER OF TEN
BISB A,C ;THE RESULT
ADD #60,C ;CONVERT TO DIGIT
JSR PC,@(P)+ ;PASS TO USER
TST (D) ;PAST END?
BNE 2$
MFARI8: JSR PC,@(P)+ ;ONE ZERO
JSR PC,@(P)+ ;MAKE SURE PASSED TO USER
TST (P)+
JMP ERETCZ ;RETURN
MFARI7: TST (P)+ ;POP CO-ROUTINE LINKAGE
MFARI6: CCC
SEV
JMP EMTRET
;CO-ROUTINE TO PUT BYTES INTO USER'S SPACE
MFSENB: SWAB C
JSR PC,@(P)+ ;THIS IS A CO-ROUTINE
SWAB C
DEC E ;WORD OCUNT
BEQ MFARI7
SAVE C
MTPD (F)+
CLR C
JSR PC,@(P)+ ;RETURN FROM CO-ROUTINE
BR MFSENB
MFNDNM: SAVE B ;(A)= POINTER TO ENTRY
MOV (A)+,B ;HEADER WORD
TST (A)+ ;SKIP VERSION NUMBER
BIT #MFEOFB,B ;TIEM DATE, EOF ETC?
BEQ 1$ ;NOPE
ADD #10,A ;SKIP EOF DATE AND TIME
1$: BIT #MFACCB,B ;ACCESS CODES?
BEQ MFND.2
MFND.1: ADD #2,A ;SKIP ACCESS CODES
TSTB (A)+
BLT MFND.1 ;MORE ACCESS CODES?
MFND.2: REST B
RTS PC ;DONE
.SBTTL DELETE FROM DIRECTORY
;COMMON BEGINNING FOR DELETE AND SUPER DELETE
MFACDL: MOV FAMFI(D),A ;GET THE FILE OR DIR MFI TO DELETE
JSR PC,ITM2LD ;LOAD IT
MOV MFBAKP(A),A ;GET DIR IT IS IN
JSR PC,ITM2LD ;LOAD IT
MOV MFIUPT(A),B ;FUPT FOR THE DIR ITSELF
JSR PC,FUPTLK ;LOCK THE DIR
MOV B,A
JSR PC,ITM2PL ;LOAD THE ACTUAL DIR
TST (A) ;MAKE SURE IT IS IN CORE
MOV FAMFI(D),A ;GET THE FILE OR DIR MFI TO DELETE
JSR PC,ITM2PL ;LOAD IT
BIT #MFOPNB!MFDWDB!MFTMPF,MFLAGW(A) ;ALREADY SORT OF GONE?
ERRORC NE,FNF ;WELL, NOT IN DIRECTORY ANYWAY
RTS PC
;SUPER DELETE, DELETE A DIR EVEN IF IT ISN'T EMPTY
MFASDL: JSR PC,MFACDL ;DO COMMON STUFF
BIT #.FADIR,MFLAGW(A) ;IS IT A DIR?
ERRORC EQ,BAD ;SUPER DELETE ISN'T NEEDED, SLAP HIS WRIST
CMP #1,MFFREF(A) ;IS THERE A FILE OPEN IN THIS DIR?
ERRORC NE,CDD ;DANGEROUS TO DELETE IF MORE THAN ONE CAP
BR MFADL2 ;GO DELETE IT, WHATEVER IT IS
;REGULAR DELETE
MFADL: JSR PC,MFACDL ;DO COMMON START
BIT #.FADIR,MFLAGW(A) ;IS IT A DIR?
BEQ MFADL2 ;IF A FILE, DON'T NEED EXTRA CHECKING
;CHECK THAT DIR IS EMPTY
MOV MFIUPT(A),B ;THE FUPT FOR THE ACTUAL DIR
JSR PC,FUPTLK ;MINE, ALL MINE!
MOV MFBYTP(A),C ;THE DIR'S EOF
MOV B,A
JSR PC,ITM2PL ;LOAD THE DIR
MOV #2,D ;DO TWICE
MFADL1: MOV (A),B ;GET HEADER WORD
INC B ;IN CASE COUNT IS ODD
BIC #177401,B ;EVEN IT
ADD B,A
SOB D,MFADL1
SUB ITM2A,A ;UNREALATIVE
CMP A,C ;SAME AS EOF?
ERRORC NE,CDD ;CAN'T DELETE DIRECTORY THAT ISN'T EMPTY
JSR PC,LSWPOP ;NON LONGER LOCKED
JSR PC,ITM2PO ;OR LOADED
MOV ITM2A,A ;RESTORE A
;FALLS THROUGH
;FALLS IN
MFADL2: BIS #MFDWDB,MFLAGW(A) ;DELETE BLOCKS WHEN MFI GOES AWAY
MOV MFIFNO(A),C ;FILE NUMBER BEFORE GETTING HACKED
MOV #-1,F ;ONE LESS FILE IN DIR
JSR PC,MFIUND ;ADJUST ANY ACTIVE MFIS ABOVE THIS FILE
JSR PC,ITM2PO ;POP TO ACTUAL DIRICTORY
MOV ITM2A,A ;POINT TO BEGINNING OF IT
MFADL3: MOV (A),B ;GET HEADER WORD OF ENTRY
INC B ;IN CASE ODD
BIC #177401,B ;EVEN IT OUT
ADD B,A ;POINT TO NEXT ENTRY
SOB C,MFADL3 ;TILL WE GET TO THE ONE WE'RE INTERESTED IN
MOV (A),F ;GET HEADER WORD
INC F ;IN CASE ODD
BIC #177401,F ;MAKE EVEN
MOV ITM2A,C ;POINT AT BEG OF DIR AGAIN
SUB F,MFBYTP-MFENHD(C) ;ADJUST EOF POINTER IN DIR
MOV A,B ;COPY POINTER TO ENTRY BEING FLUSHED
ADD F,B ;POINT TO BEG OF NEXT ENTRY
MOV ITM2A,C ;POINT TO BEGINNING
ADD MFBYTP-MFENHD(C),C ;POINT TO NEW END
MFADL4: CMP C,A ;ARE WE ABOUT TO COPY PAST THE END?
BEQ MFADL5 ;YUP
MOV (B)+,(A)+ ;COPY NE WORD
BR MFADL4
MFADL5: MOV ITEM2,B ;GIP TO THE DIR
JSR PC,ITM2PO ;MAP IT OUT
JSR PC,VALSRC ;ENTER REQUEST TO WRIT IT OUT
MOV ITM2A,A ;POINTER TO PARENT MFI
SUB F,MFBYTP(A) ;ADJUST EOF
ADD F,MFIUCF(A) ;AND FREE BYTES
JSR PC,LSWPOP
JMP ERETCZ
;DELETE THE BLOCKS BELONGING TO THE FILE WHOSE MFI IS IN ITEM2 AND DISK # IS IN D
MFIBFL: JSR F,ACSAV
MOV MFBITS(D),A ;GET THE RIGHT BIT TABLE
JSR PC,ITM2PL ;LOAD IT UP
TST (A) ;MAKE SURE IT IS SWAPPED IN
JSR PC,ITM2PO ;POP IT
MOV MFBITS(D),A ;GET AGAIN
JSR PC,ITM1PL ;THIS TIME INTO ITEM 1
MOV ITM2A,B ;POINTER INTO MFI
MOV MFBYTP(B),E ;EOF BYTE POINTER
ASH #-10.,E ;MAKE INTO BLOCK COUNT
INC E ;JUST FOR GOOD MEASURE
MOV MFPGNO(B),C ;GET PAGE EOF
ASH #3,C ;CONVERT TO BLOCKS
ADD E,C ;LAST BLOCK ADDRESS
MOV D,B ;SAVE DISK #
INC C ;FOR GOOD MEASURE
JSR PC,MFBLKG ;START STAREING AT BLOCKS
MFIBF1: CMP #-1,E ;REALLY THER?
BEQ MFIBF2 ;NO, IGNORE THIS ONE
CMP E,(A) ;BIGGER THAN BIGGEST?
BUGC HIS ;I HOPE NOT!
TST E ;ZERO?
BUGC EQ
SAVE E
MOV E,F ;COPY BLOCK NUMBER
BIC #177770,F ;GET BIT NUMBER
ASH #-3,E ;AND BYTE NUMBER
ADD A,E ;BYTE POINTER
BICB BMT(F),2(E) ;TABLE IS OFFSET BY 2
INC MFFREE(B) ;ONE MORE BLOCK FREE
REST E
MFIBF2: JSR PC,@(P)+ ;GET NEXT BLOCK
CMP D,C ;THIS THE LAST BLOCK?
BLOS MFIBF1 ;NO, KEEP GOING
TST (P)+ ;FLUSH LINKAGE
JSR PC,ITM1PO ;FLUSH BIT TABLE
MOV MFBITS(B),B ;GET THE GIP AGAIN
JSR PC,VALSRC ;SWAP TABLE OUT
JMP ACRET
;ADD A FILE OR DIR TO A DIR, AND MUTATE TO THAT DIR OR FILE
MFAAD: JSR PC,MAKFNB ;GET THE FILE NAME
ERRORC EQ,BFN ;NO FILE NAME???
CMP #-3,FNBVER(A) ;FOO< ?
ERRORC EQ,BFN ;CAN'T CREATE THAT
SAVE A ;SAVE POINTER TO THE FNB
MOV FAMFI(D),A ;GET THE DIR MFI
JSR PC,ITM2LD ;LOAD IT
BIT #.FADIR,MFLAGW(A) ;IT BETTER BE A DIR!
ERRORC EQ,BCT ;CAN'T INSERT INTO FILES!
BIT #MFDWDB,MFLAGW(A) ;STILL A VIABLE DIR?
ERRORC NE,BCT ;WELL, SORT OF
MOV MFDISK(A),E ;THE DISK THIS IS ON
JSR PC,CRMFI ;CREATE A MFI FOR THE ENTRY
ERRORC EQ,NIS ;NO ROOM
MOV ITM2A,C ;POINTER INTO MFI
MOV E,MFDISK(C) ;THE DISK NUMBER
MOV MFBLNK(E),MFDLNK(C) ;PUT THE NEW MFI
MOV A,MFBLNK(E) ;ONTO THE LIST FOR THIS DISK
MOV (P),F ;GET FNB POINTER
SAVE <A,D> ;SAVE MFI INDEX AND CAP POINTER
MOV FNBFNL(F),D ;GET NUMBER OF BYTES IN THE NAME
ADD #MFNAME-MFENHD,D ;ADD IN OVERHEAD IF FILE
SAVE D ;SAVE COMPUTED LENGTH
JSR PC,MFIEXP ;EXPAND IF NESSECARY
JSR PC,ITM1PO ;CRETINOUS MFIEXP PUSHES IT
REST <E,D> ;GET BACK COUNT, CAP POINTER
MOV FAMFI(D),A ;GET DIR MFI AGAIN
SAVE E ;SAVE REAL COUNT
INC E ;WE NEED TO
BIC #1,E ;EVEN THIS ONE OFF
JSR PC,DIRCMT ;COMMIT BYTES IN DIR
MOV FAMFI(D),A ;THE MFI WE HAVE A PSUEDO INFERIOR TO
JSR PC,ITM2PL ;LOAD IT
INC MFFREF(A) ;ONE MORE REF
JSR PC,ITM2PO ;POP IT
MOV ITM2A,A ;ADDRESS OF MFI WE ARE WORKING ON
MOV E,MFICBY(A) ;WE HAVE THIS MANY COMMITED FOR US
MOV FAMFI(D),MFBAKP(A) ;SET HIS BACK POINTER
REST E ;GET BACK REAL COUNT
BIS #MFFILE!MFEOFB,E ;LENGTH, ASSUMMED FILE
MOV E,MFENHD(A) ;HEADER WORD
;VERN WILL BE INSERTED WHEN WE KNOW IT
;EOF POINTER IS ALREADY 0
JSR PC,CMDATE ;GO COMPUTE DATE AND TIME
MOV FDATE,MFDATE(A) ;DATE
MOV FTIME,MFTIME(A) ;TIME
ADD #FNBFN,F ;POINT TO NAME IN FNB
ADD #MFNAME,A ;AND IN MFI
1$: MOVB (F)+,(A)+ ;ON BYTE AT A TIME
BGE 1$ ;TILL END SEEN
MOV FAMFI(D),A ;MFI OF DIR
JSR PC,ITM2LD ;FOR DIRSER
MOV FAMFI(D),A ;ALSO
MOV 2(P),B ;FNB POINTER
JSR PC,DIRSER ;LOOK FOR FILE IN DIR
BEQ MFAAD2 ;NOT THERE, THAT'S FINE
MOV 2(P),B ;FNB POINTER AGAIN
CMP #-2,FNBVER(B) ;ARE WE ADDING >?
ERRORC NE,EAE ;NO, FILE ALREADY EXISTS
INC C ;NEXT VERSION NUMBER
INC FNBFNO(B) ;GO TO NEXT SPOT IN DIR
BR MFAAD3 ;ADD THAT ONE
MFAAD2: MOV 2(P),B ;FNB AGAIN
MOV FNBVER(B),C ;SPECIFIED VERSION NUMBER
CMP #-2,C ;ARE WE ADDING >?
BNE MFAAD3
INC FNBFNO(B) ;GO TO NEXT SPOT
MOV #1,C ;VERSION NUMBER 1
MFAAD3: REST A ;GET BACK NEW MFI INDEX
JSR PC,ITM2LD ;LOAD IT UP
MOV C,MFVERN(A) ;GIVE IT THE CORRECT VERSION NUMBER
MOV FNBFNO(B),MFIFNO(A) ;AND FILE NUMBER
BIS #MFEBMB!MFNODR,MFLAGW(A) ;BEEN MODIFIED AND NOT YET IN DIR
MOV #1,F ;ADDING A FILE
JSR PC,MFIUND ;ADJUST OTHER FILES IN THE DIR
DEC MFIFNO(A) ;DON'T WANT JUST ADDED ENTRY ADJUSTED
JSR PC,MFFEND ;SET UP THE END POINTERS
JSR PC,LSWPOP ;POP LOCK ON DIR, MFIINS WILL RELOCK
JSR PC,MFIINS ;PUT IT INTO DIR
MOV FAMFI(D),A ;THE ABOUT TO BE SUPERIOR
JSR PC,ITM2PL ;LOAD IT
DEC MFFREF(A) ;NO EXTRA REFERENC ENOW
JSR PC,ITM2PO
MOV ITM2A,A
MOV ITEM2,FAMFI(D) ;MUTATE CAP
CLR FAFBP(D) ;CLEAR POINTER
CLR FAFPN(D)
BIT #.FADIR,MFLAGW(A) ;IS IT A DIR?
BNE 1$ ;YES, DON'T DO ANYTHING
BIS #.FAWT,(D) ;YOU CAN WRITE ON THE FILE YOU CREATED
BIC #.FADIR,(D) ;NO, MAKE CAP A FILE TOO
1$: BIC #MFOPNB,MFLAGW(A) ;NO LONGER BEING OPENED
TST (P)+ ;FLUSH FNB POINTER
JSR PC,LSWPOP ;DIR LOCK
JSR PC,LSWPOP ;MFI LOCK
JSR PC,LSWPOP ;FNB LOCK
JMP ERETCZ ;WIN
;COMMIT SPACE IN A DIR
;RESERVES (E) BYTES IN A DIR, GIVES ERROR IF NOT AVAILABLE
;SOMEDAY THIS WILL EXPAND THE DIR TO UP TO 8 BLOCKS
;CALL WITH DIR MFI IN A
DIRCMT: JSR F,ACSAV
JSR PC,ITM2PL ;LOAD THE DIR
INC E ;ALWAYS ALLOCATE
BIC #1,E ;AN EVEN NUMBER OF BYTES
CMP E,MFIUCF(A) ;DO THAT MANY UNCOMMITED FREE BYTES EXIST?
ERRORC HIS,DRF ;NOT ENOUGH, FULL DIR
SUB E,MFIUCF(A) ;COMMIT THAT MANY
JSR PC,ITM2PO ;POP DIR MFI
JMP ACRET
;CHANGE A FILE INTO A DIRECTORY
MFAMD: BIT #.FADIR,(D) ;IS IT ALREADY A DIR?
ERRORC NE,BAD ;YES!
MOV FAMFI(D),A ;THE MFI FOR THE FILE TO CONVERT
JSR PC,ITM2LD ;LOAD IT
MOV MFBAKP(A),A ;MFI OF PARENT DIR
ERRORC EQ,BAD ;UGH!
JSR PC,ITM2PL ;LAOD THAT
MOV MFIUPT(A),B ;GIP TO DIR
JSR PC,FUPTLK ;LOCK IT
MOV B,A
JSR PC,ITM2LD ;LOAD IT
TST (A) ;MAKE SURE IT'S SWAPPED IN
JSR PC,ITM2PO ;POP BACK TO FILE MFI
MOV ITM2A,A ;POINTER TO IT
TST MFPGNO(A) ;IS IT > 8 BLOCKS?
ERRORC NE,BAD ;YES, THAT'S A NO-NO
CMP #2000,MFBYTP(A) ;IS IT > 1 BLOCK?
ERRORC LT,BAD ;SO IS THAT
TST MFBYTP(A) ;BUT IS THERE SOMETHING THERE?
ERRORC EQ,BAD ;NOPE!
CLR FAFBP(D) ;SET FILE POINTER TO ZERO
MOV #2,C ;LIE A LITTLE
JSR PC,DKISET ;SET UP THE PAGE
MOV FAMFI(D),A ;GET THE MFI WE A FOOLING WITH
JSR PC,ITM1PL ;LOAD IT UP
MOV MFBAKP(A),B ;ITEM NUMBER OF PARENT
ERRORC EQ,BAD ;TEMP FILE?
CLR -(P) ;FOR TOTAL LENGTH
MOV #MFSLFE,F ;FOR THE SELF ENTRY
JSR PC,MFAMDC ;COPY ENTRY INTO DIR
MOV B,A ;THE PARENT OF THE NEW DIR
JSR PC,ITM1LD ;LOAD MFI OF PARENT
MOV E,B ;SAVE POINTER INTO DIR
MOV #MFPARE,F ;PARENT ENTRY
JSR PC,MFAMDC ;COPY PARENT INTO DIR
BIC #100000,(B) ;FLUSH THE EOF BIT
SUB #10,(B) ;FLUSH THE BYTES WE WILL FLUSH
MOV (B)+,E ;THE HEADER WORD
INC E
BIC #177401,E ;SAVE JUST COUNT
ASR E ;WORD COUNT
SUB #2,E ;HEADER+VERSION NUMBER
SUB #10,(P) ;ON THE STACK TOO
TST (B)+ ;PAST VERSION NUMBER
1$: MOV 10(B),(B)+
SOB E,1$
JSR PC,ITM1PO ;POP THE MFI
MOV ITM2A,A ;POINTER TO DIR
CLR 4(A) ;NUMBER OF REAL PAGES
MOV (P),6(A) ;NUMBER OF USED BYTES
JSR PC,ITM2PO ;GET RID OF PUSHED WHATEVER
MOV FAMFI(D),A ;THE MFI WE ARE HACKING
JSR PC,ITM2LD ;LOAD IT UP
MOV FAUPT(D),B ;UPT TO THE NEW DIR
JSR PC,VALSRC ;WRITE IT ON THE DISK
ADD #MFENHD,A ;POINT TO ENTYR IN MFI
MOV (A),B ;GET HEADER WORD
INC B
BIC #177401,B ;GET A BYTE COUNT
ASR B ;WORD
SUB #6,B ;LESS EOF+TIEM+DATE+HEADER+VERN
SAVE <A,B>
BIC #117000,(A) ;FLUSH TYPE AND EOF BIT
BIS #MFDIRE,(A) ;IT IS A DIR
SUB #10,(A)+ ;FLUSH 8. BYTES
TST (A)+ ;DON'T TOUCH VERN
MFAMD3: MOV 10(A),(A)+
SOB B,MFAMD3
JSR PC,LSWPOP
JSR PC,LSWPOP
JSR PC,MFIINS ;INSERT THIS INTO THE PARENT
REST <B,A>
ADD #10,(A) ;SET BACK THE LENGTH
BIS #100000,(A)+
TST (A)+ ;SKIP VERN
ADD B,A
ADD B,A ;GET TO THE END OF THE GOOD STUFF
MFAMD2: MOV -(A),10(A) ;COPY UP
SOB B,MFAMD2
MOV ITM2A,A
CLR MFPGNO(A)
REST MFBYTP(A) ;THE LENGHT OF THE DIR WAS COMPUTED A LONG TIME AGO
MOV FAUPT(D),MFIUPT(A)
CLR FAUPT(D)
CLR FAFBP(D)
CLR FAFPN(D)
BIS #.FADIR,(D) ;SAY THIS IS A DIR
BIC #.FAWT,(D) ;PREVENT WRITEING ON DIRS
BIS #.FADIR,MFLAGW(A) ;ALSO IN THE MFI
MOV #1,MFIDLN(A) ;ONE BLOCK LONG
MOV MFBYTP(A),C ;GET THE END OF THE DIRECTORY
NEG C
ADD #2000,C ;GET THE NUMBER OF FREE BYTES IN THIS DIRECTORY
MOV C,MFIUCF(A) ;THE NUMBER OF FREE BYTES IN THE DIRECTORY
JMP ERETCZ ;DONE???
MFAMDC: ADD #MFENHD,A ;POINT TO ENTRY ITSELF
MOV (A),C ;GET HEARER WORD
INC C ;ROUND UP
BIC #177401,C ;CLEAR CRAP
ADD C,2(P) ;SAVE LENGTH IN BYTES
ASR C ;FOR THE SOB
MOV (A)+,(E) ;COPY THIS INTO DIR
BIC #17000,(E) ;CLEAR OLD TYPE
BIS F,(E)+ ;CHANGE TO A SELF ENTRY
DEC C
MFAMD1: MOV (A)+,(E)+ ;A WORD AT A TIME
SOB C,MFAMD1
RTS PC
.SBTTL FILE CAPABILITIES-DIRECTORY HACKING
;SEARCH THE DIRECTORY POINTED TO BY THE MFI IN A FOR THE FILE POINTED
;TO BY THE FNB IN B
;RETURN IN A A POINTER TO WHERE WE SHOULD PUT A NEW FILE OF THIS NAME,
;AND IN B A POINTER TO THE "EXACT" MATCH IF ONE WAS FOUND.
;IF THE FNB HAS NO VERSION NUMBER OR A SPECIFIC VERSION NUMBER,
;THEN THE DIRECTORY ENTRY MUST HAVE THE SAME FOR AN EXACT MATCH
;IF THE FNB HAS < FOR A VERSION NUMBER, THE FIRST FILE
;WITH A VERSION NUMBER IS AN EXACT MATCH. IF THE FNB HAS
;> AS A VERSION NUMBER, THEN THE LAST FILE WITH THE RIGHT
;NAME AND A VERSION NUMBER IS AN EXACT MATCH. NOTE THAT
;> AND < NEVER EXACT MATCH TO A FILE WITH NO VERSION NUMBER,
;AND A FILE WITH NO VERSION NUMBER NEVER EXACT MATCHES A FILE
;WITH ONE
;THE VERSION NUMBER OF THE EXACT MATCH IS RETURNED IN C
;AND Z IS SET IF NO EXACT MATHC IS FOUND
;CALL WITH MFI LOADED INTO ITEM 2
;RETURNS WITH DIR LOADED INTO ITEM 2
DIRSER: JSR F,ACSAV
CLR 2(P) ;RETURNED B
MOV B,E ;COPY FNB POINTER
MOV #1,FNBFNO(E) ;FIRST FILE (WE SKIP THE SELF ENTRY)
MOV ITM2A,A ;POINTER TO MFI
MOV MFBYTP(A),F ;POINTER TO END OF DIRECTORY
MOV MFIUPT(A),B ;GIP FOR DIRECTORY
JSR PC,FUPTLK ;LOCK THE DIRECOTORY
MOV B,A ;COPY THE GIP
JSR PC,ITM2LD ;LOAD THE DIR OVER THE MFI
ADD A,F ;REAL END POINTER NOW
MOV (A),B ;FIRST WORD OF SELF ENTRY
INC B ;ROUND OFF BYTE COUNT
BIC #177401,B ;BYTE COUNT
ADD B,A ;SKIP SELF
;AND THEN SKIP THE PARENT ENTRY TOO
DIRSE1: INC FNBFNO(E) ;NEXT FILE
MOV (A),B ;GET FIRST WORD OF ENTRY
INC B ;ROUND OFF BYTE COUNT
BIC #177401,B ;GET BYTE COUNT
ADD B,A ;GO TO NEXT ENTRY
MOV A,(P) ;SAVE FOR CALLER
CMP A,F ;ARE WE AT OR PAST THE END?
BHIS DIRSE2 ;YUP, RETURN TO CALLER
JSR PC,NAMCMP ;COMPARE THE FILE NAMES
BGT DIRSE1 ;HAVEN'T GONE FAR ENOUGH YET
BLT DIRSE2 ;WE'VE GONE TOO FAR
MOV FNBVER(E),D ;MATCHED FILE NAMES, GET VERSION FROM FNB
INC D ;WAS IT NO VERSION?
BGE DIRSE4 ;YES, OR POSITIVE VERSION
CMP #-1,C ;NO VERSION ON THE DIR ENTRY?
BEQ DIRSE1 ;THEN IT CAN'T MATCH < OR >
MOV A,2(P) ;THIS A REAL MATCH FOR <, AND A POSSIBLE FOR >
MOV C,4(P) ;SO SAVE IT
INC D ;WAS IT >?
BEQ DIRSE1 ;SEE IF WE CAN FIND A BIGGER ONE
DIRSE2: CMP #-2,FNBVER(E) ;IS IT >?
BNE 1$ ;NOPE
DEC FNBFNO(E) ;CORRECT FILE NUMBER
1$: JSR F,ACRES ;RESTORE THE CLOBBERED RESGISTERS
TST B ;SET Z IF NO EXACT MATCH
RTS PC
DIRSE4: DEC D ;COMPENSATE FOR TEST
CMP D,C ;BOTH HAVE VERSIONS OR NO VERSION
BGT DIRSE1 ;FNB VERSION > FOUND VERSION, KEEP TRYING
BLT DIRSE2 ;FNB VERSION < FOUND, GIVE UP
MOV A,2(P) ;EXACT MATCH
MOV C,4(P) ;PREPARE TO RETURN
BR DIRSE2
;COMPARE THE NAME IN A FNB WITH THE NAME IN A DIRECTORY AN DECIDE
;IF THEY ARE GREATER, EQUAL OR LESS
;POINTER TO FNB IS IN E, POINTER TO DIR IS IN A
NAMCMP: SAVE <#0,A,B,E>
MOV A,B ;COPY DIRECTORY POINTER
ADD #FNBFN,E ;POINT TO FILE NAME IN FILE NAME BLOCK
MOV MFVERN-MFENHD(A),C ;GET VERSION NUMBER TO RETURN TO CALLER
ADD #MFVERN-MFENHD+2,A ;POINT TO POTENTIAL NAME
BIT #MFEOFB,(B) ;ARE THERE TIEM DATE ETC?
BEQ 1$ ;NOPE
ADD #10,A ;SKIP STUFF
1$: BIT #MFACCB,(B) ;ACCESS CODES?
BEQ NAMCM2 ;NOPE
NAMCM1: ADD #3,A ;SKIP ONE SET OF CODES
TSTB -1(A) ;LAST?
BLT NAMCM1 ;KEEP GOING
NAMCM2: CMPB (A)+,(E)+ ;COMPARE CHARACTERS
BNE NAMCM3 ;NOT EQUAL, GO FINISH UP
TSTB -1(A) ;DID THEY BOTH END?
BGE NAMCM2 ;NOPE
NAMCM4: REST <E,B,A>
TST (P)+ ;SET CONDITION CODES
RTS PC
NAMCM3: MOVB -(A),A ;GET LAST CHAR FROM DIRECTORY
MOV A,B ;COPY IT
MOVB -(E),E ;GET LAST FROM FNB
BIC #177600,A ;FLUSH CRAP
BIC #177600,E ;LIKEWISE
DEC 6(P) ;ASSUME FNB IS LESS
CMP E,A ;WHICH IS GREATER?
BLT NAMCM4 ;ASSUMED RIGHT
BGT NAMCM5 ;DIRETORY IS LESS
TST B ;TEST SIGN EXTENDED DIRECTORY CHARACTER
BGE NAMCM4 ;DIRETORY ENDED FIRST, FNB IS BIGGER
NAMCM5: MOV #1,6(P) ;DIRECTORY ENTRY IS SMALLER THAN FNB
BR NAMCM4
;SEARCH THROUGH ALL MFI'S FOR THE DISK IN E FOR THE FNB
;THAT IS IN A. IF FOUND, RETURN ITEM # IN A AND CLEAR Z
;CALL WITH MFI OF DIRECTORY IN B
;ELSE SET Z
MFISER: JSR F,ACSAV
MOV A,B ;COPY FNB POINTER
MOV A,C ;TWICE
ADD #FNBFN,B ;ACTUALLY POINT AT NAME
MOV MFBLNK(E),A ;FIRST MFI ON THE LIST
BEQ MFISE1 ;NOT FOUND
JSR PC,ITM2PL ;LOAD UP THE MFI
MFISE2: CMP MFBAKP(A),2(P) ;SAME DIRECTORY?
BNE MFISE6 ;NOPE
BIT #MFDWDB,MFLAGW(A) ;DELETE WHEN DONE?
BNE MFISE6 ;YES, FILE DOESN'T REALLY EXIST
MOV A,E ;COPY MFI POINTER
MOV B,F ;COPY FNB NAME POINTER
ADD #MFENHD,E ;POINT TO ENTRY
MOV E,D ;COPY THAT
ADD #4,E ;FIRST POSSIBLE PLACE FOR NAME
BIT #MFEOFB,(D) ;DOES IT HAVE EOF ETC?
BEQ 1$
ADD #10,E ;PUSH FORWARD...
1$: BIT #MFACCB,(D) ;ACCESS CODES?
BEQ MFISE3 ;NOPE
MFISE4: ADD #3,E ;SKIP ONE SET
TSTB -1(E) ;LAST SET?
BGE MFISE4 ;NOPE
MFISE3: CMPB (E)+,(F)+ ;COMPARE NAME BYTES
BNE MFISE6 ;NOT THE SAME NAME
TSTB -1(E) ;END OF NAMES?
BGE MFISE3 ;NOT YET
CMP MFVERN-MFENHD(D),FNBVER-FNBFN(B) ;SAME NAME, SAME VERSION?
BNE MFISE6 ;NOPE
BIT #.FALOK,MFLAGW(A) ;IS THE FILE LOCKED?
ERRORC NE,FLOK ;FILE LOCKED!
MOV ITEM2,(P) ;FOR THE CALLER
JSR PC,ITM2PO
JMP ACRETC
MFISE6: MOV MFDLNK(A),A ;NEXT MFI ON THIS DISK
BEQ MFISE7 ;NO MORE
JSR PC,ITM2LD ;LOAD THIS ONE
BR MFISE2 ;AND GIVE IT A TRY
MFISE7: JSR PC,ITM2PO
MFISE1: JMP ACRETS
;INSERT MFI IN ITEM 2 INTO IT'S DIRECTORY
MFIINS: JSR F,ACSAV
MOV ITEM2,F ;SAVE THE INDEX OF THE MFI BEING INSERTED
MOV ITM2A,A ;POINTER TO BEING INERTED MFI
MOV MFBAKP(A),A ;GET POINTER TO MFI OF DIR IT IS IN
JSR PC,ITM2PL ;LOAD THAT MFI
MOV MFIUPT(A),B ;NOW GET FUPT FOR THE DIRECTORY ITSELF
JSR PC,FUPTLK ;LOCK THE DIRECTROY
MOV MFBYTP(A),D ;SAVE THE EOF OF THE DIRECTORY
MOV F,A ;GET BACK THE MFI BEING INSERTED
JSR PC,ITM2PL ;LOAD IT FOR A SEC
MOV MFIFNO(A),E ;GET IT'S FILE NUMBER
MOV B,A ;NOW THE DIRECTORY ITSELF
JSR PC,ITM2LD ;LOAD OVER THE MFI
MFIIN1: MOV (A),C ;HEADER WORD
INC C ;MUST ROUND UP
BIC #177401,C ;TO EVENNESS
ADD C,A ;GO TO NEXT ENTRY
SOB E,MFIIN1 ;TILL WE GET WHERE WE'RE GOING
MOV A,B ;COPY POINTER TO ENTRY BEING REPLACED
MOV (B),E ;GET FIRST WORD
INC E ;AGAIN MUST ROUND UP
BIC #177401,E ;AND OFF
MOV F,A ;GET THE MFI AGAIN
JSR PC,ITM1PL ;LOAD INTO ITEM 1 THIS TIME
BIT #MFNODR,MFLAGW(A) ;ARE WE REPLACING IN DIR, OR JUST ADDING?
BEQ 1$ ;REPLACEING
CLR E ;ADDING, OLD ENTRY HAD ZERO LENGTH
1$: BIC #MFNODR!MFEBMB,MFLAGW(A) ;ENTRY WILL SOON BE SAFELY IN THE DIR
ADD #MFENHD,A ;POINT TO THE ENTRY ITSELF
MOV (A),C ;NOW WE NEED
INC C ;TO ROUND UP
BIC #177401,C ;AND OFF THE ENTRY WE ARE INSERTING
MOV E,F ;COPY LENGTH OF OLD ENTRY
SUB C,F ;GET DIFFERENCE IN LENGTHS OF NEW AND OLD
;IF ZERO, THEY ARE THE SAME
;IF POSITIVE, NEW ENTRY IS SHORTER
;IF NEGATIVE NEW ONE IS LONGER
SAVE <F,B> ;SAVE DIFFERENCE AND POINTER
MOV ITM2A,B ;GET POINTER TO BEG OF DIRECTORY
SUB F,MFBYTP-MFENHD(B) ;ADJUST THE BYTE COUNT IN THE SELF ENTRY
ADD B,D ;MAKE IT POINT INTO ITEM
MOV (P),B ;WE'LL GET IT IN THE MFI LATER
TST F ;CHECK SIGN OF DIFF
BLT MFIIN2 ;NEW IS LONGER THE USUAL CASE
BEQ MFIIN3 ;THEY ARE THE SAME, ANOTHER COMMON OCCURENCE
;HERE, THE NEW ENTRY IS SHORTER
;IF IT DOES HAPPEN, WE MUST COPY THE RIGHT NUMBER OF WORDS
;DOWN OVER THE OLD ENTRY
ADD C,B ;POINT PAST THE ENTRY BEING FLUSHED
ADD B,F ;PLACE TO COPY DOWN FROM
MFIIN4: CMP D,F ;ABOUT TO COPY STUFF FROM PAST END?
BEQ MFIIN3 ;YUP, DONE
MOV (F)+,(B)+ ;COPY A WORD
BR MFIIN4 ;CHECK AGAIN
;COME HERE IF WE HAVE TO COPY PART OF THE DIRECTORY UP
;TO MAKE ROOM FOR THE NEW LARGER ENTRY
MFIIN2: MOV D,B ;COPY THE END OF DIRETORY POINTER
SUB D,F ;THIS IS NEGATIVE OF <END OF DIR>+<AMOUNT BEING ADDED>
NEG F ;SO THIS POINTS TO NEW END OF DIR
MFIIN5: CMP B,(P) ;HAVE WE COPIED THE OLD ENTRY UP YET?
BEQ MFIIN3 ;YUP, GO FINISH UP
MOV -(B),-(F) ;UP YOU GO!
BR MFIIN5
;COME HERE WITH ROOM IN THE DIR FOR THE NEW ENTRY
MFIIN3: REST <B,F> ;B=> WHERE IT GOES, F IS DIFFERENCE IN SIZE
ASR C ;C WAS BYTES, NOW WORDS, LENGTH OF NEW ONE
1$: MOV (A)+,(B)+
SOB C,1$ ;COPY INTO DIR
MOV ITM1A,A ;POINTER TO MFI JUST PUT INTO DIR
MOV MFICBY(A),B ;GET NUMBER WE THOUGHT WE HAD COMMITTED IN DIR
CLR MFICBY(A) ;NOW NONE ARE COMMITTED
JSR PC,ITM1PO ;NO LONGER NEED INSERTED MFI
MOV ITEM2,E ;SAVE GIP OF DIR
JSR PC,ITM2PO ;NOR DIRECTORY
MOV ITM2A,A ;THIS SHOULD BE THE DIRECTORY MFI
ADD B,MFIUCF(A) ;FLUSH THE ONES WE THOUGHT WE NEEDED
ADD F,MFIUCF(A) ;BUT GRAB THE ONES WE USED
SUB F,MFBYTP(A) ;AND ADJUST EOF POINTER
MOV MFDISK(A),B ;DISK NUMBER FIE IS ON
MOV MFBITS(B),B ;GIP OF BIT TABLE
JSR PC,VALSRC ;MAKE SURE VALID AT SOURCE
MOV E,B ;GIP OF DIR
JSR PC,VALSRC ;VALIDATE AT SOURCE
ACRTP2: JSR PC,ITM2PO ;FLUSH DIR MFI
JMP ACRET
;FIX UP ANY MFI'S THAT ARE ABOVE A ENTRY BEING CREATED OR DELETED
;CALL WITH: NUMBER OF AFFECTED FILE IN C
;ITEM # OF DIRECTORY MFI IN D, DISK NUMBER IN E
;AMOUNT TO ADJUST BY IN F (I.E. 1 OR -1)
MFIUND: JSR F,ACSAV
MOV ITM2A,A
MOV MFBAKP(A),D ;DIR MFI
MOV MFIFNO(A),C ;FILE BEING ADDED OR DELETED
MOV MFDISK(A),E ;THE DISK IT IS ON
MOV MFBLNK(E),A ;GET FIRST MFI IN LIST
JSR PC,ITM2PL ;LOAD IT UP
MFINU4: CMP D,MFBAKP(A) ;IS THIS MFI IN THE RIGHT DIR?
BNE MFINU2 ;NOPE
CMP C,MFIFNO(A) ;SAME OR ABOVE BEING HACKED ENTRY?
BGT MFINU2 ;NO
ADD 12(P),MFIFNO(A) ;ADJUST THIS ONE
MFINU2: MOV MFDLNK(A),A ;GET NEXT IN LINE
BEQ MFINU3 ;NO MORE
JSR PC,ITM2LD ;LOAD OVER THE PREVIOUS ONE
BR MFINU4 ;KEEP LOOKING
MFINU3: JMP ACRTP2
.SBTTL FILE I/O CALLS
;DISK BYTE INPUT
DKBTI: MOV #1,C ;WE NEED ONLY 1 BYTE
JSR PC,DKISET ;SET UP TO DO IT
ERRORC EQ,RPEF,SV ;ATTEMPT TO READ PAST EOF?
MOVB (E),B ;GET THE BYTE
BIC #177400,B ;CLEAR THE TOP BYTE
JSR PC,GIVPSW ;GIVE IT TO THE USER
DKBTI1: JSR PC,ITM2PO ;POP THE FILE PAGE
JSR PC,LSWPOP ;POP THE LOCK ON THE FA
JSR PC,FAINC ;INCREMENT THE FILE POINTER
JMP ERETCZ ;AND RETURN HAPPILY
;DISK WORD INPUT
DKWDI: MOV #2,C ;THIS TIME WE NEED 2 BYTES
JSR PC,DKISET ;TRY TO GET THEM
ERRORC EQ,RPEF,SV ;PAST EOF
CMP #1,C ;DID WE GET ONLY 1?
BEQ DKWDI1 ;YUP, PAINFULLY CASE
MOVB 1(E),B ;GET HIGH BYTE
SWAB B ;INTO RIGHT PLACE
CLRB B ;MAKE ROOM FOR LOW BYTE
BISB (E),B ;PUT IT IN
JSR PC,GIVPSW ;PUT IT ONTO USER'S STACK
INC FAFBP(D) ;THIS CAN'T OVERFLOW THE PAGE
BR DKBTI1 ;GO CLEAN UP AND INC AGAIN
;IF ONLY 1 BYTE IS AVAILABLE, WE HAVE POTENTIAL PCLOSER PROBLEMS
DKWDI1: MOVB (E),-(P) ;GET THE FIRST BYTE
JSR PC,ITM2PO ;POP TH EFILE PAGE
JSR PC,LSWPOP ;FLUSH THE LOCK ON THE FA
JSR PC,FAINC ;GO TO THE NEXT FILE BYTE
MOV #LSPPCL,A ;RUN ON PCLOSER
MOV ITEM1,B ;THE SPHERE
JSR PC,LOCKSW ;GET A LOCK BLOCK
MOV #FAPDEC,LCKWD1(B) ;DEC POINTER ON PCLOSER
MOV D,LCKWD2(B) ;POINTER TO CAP
SUB ITM1A,LCKWD2(B) ;MAKE INTO OFFSET
MOV #1,C ;NOW ONLY NEED ONE MORE BYTE
JSR PC,DKISET ;MAKE UP THE NEW FUPT
ERRORC EQ,RPEF,SV ;OOOPS, EOF
MOVB (E),1(P) ;GET SECOND BYTE
REST B ;ASSEMBLED WORD INTO B
JSR PC,GIVPSW ;PASS TO THE USER
JSR PC,LSWPOP ;POP THE LOCK ON THE FA
BR DKBTI1 ;FINISH CLEANING UP AS USUAL
;INCREMENT THE FILE POINTER AND DO THE RIGHT THING ON OVERFLOW
FAINC: INC FAFBP(D) ;INC BYTE PART
FAINTS: CMP #20000,FAFBP(D) ;OVERFLOW?
BNE FAINC1 ;NOPE
CLR FAFBP(D) ;RESET BYTE PART
INC FAFPN(D) ;NEXT PAGE
FAINC1: RTS PC
;PCLOSER ROUTINE TO DECREMENT THE FILE POINTER
FAPDEC: MOV LCKWD2(B),B ;GET OFFSET
ADD A,B ;GET ADDRESS OF CAP
DEC FAFBP(B) ;BACK ONE BYTE
BNE FAPDE1 ;NO UNDERFLOW
MOV #17777,FAFBP(B) ;CORRECT FOR UNDERFLOW
DEC FAFPN(B) ;IN PAGE NUMBER TOO
FAPDE1: RTS PC
;DISK BLOCK IN ROUTINE
DKBKI: JSR PC,RETNSW ;GET THE NEGATIVE BYTE COUNT
MOV A,B ;SAVE IN B
JSR PC,RETNSW ;GET THE USER ADDRESS
DKBKI3: TST B ;DOES HE WANT ANY?
BEQ DKBKI4 ;NOPE, RETURN TO USER MODE
BIT #1,A ;ODD USER ADDRESS?
BNE DKBKBI ;GO INPUT EXACTLY ONE BYTE TO EVEN IT OFF
CMP #-1,B ;DOES THE USER WANT EXACTLY ONE BYTE?
BEQ DKBKBI ;GO GIVE HIM EXACTLY THAT
MOV B,C ;COPY BYTE COUNT
NEG C ;MAKE IT POSITIVE
SAVE <A,B> ;SAVE BYTE COUNT
JSR PC,DKISET ;SET UP TO TRANSFER THE STUFF
ERRORC EQ,RPEF,SV ;HE READ PAST THE EOF
REST <B,A>
CMP #1,C ;ONLY ONE BYTE?
BEQ DKBKB1 ;GO GIVE HIM THAT
ASR C ;CONVERT TO WORD COUNT
DKBKI6: SAVE C ;SAVE WORD COUNT
DKBKI1: MFPD (A) ;JUST TO MAKE SURE PAGE IS IN CORE
MOVB (E)+,(P) ;GET LOW BYTE
MOVB (E)+,1(P) ;GET HIGH ONE
MTPD (A)+ ;GIVE WORD TO USER
BIT #1777,A ;CROSS USER BLOCK BOUNDARY?
BEQ DKBKI2 ;YES, GO CLEAN UP IN CASE OF ERRROR ON NEXT BLOCK
SOB C,DKBKI1 ;FOR ALL AVAILABLE WORDS
BR DKBKI7 ;COUNTED OUT
DKBKI2: DEC C ;GOT A WORD WE HAVEN'T COUNTED YET
SUB C,(P) ;IF WE DIDN'T TAKE THEM ALL, DON'T COUNT THEM ALL
DKBKI7: MOV C,F ;BUT SAVE COUNT OF EXTRA WORDS
REST C ;GET COUNT OF WORDS WE TOOK
ASL C ;CONVERT TO BYTES
DKBKI5: ADD C,B ;ADJUST USER'S BYTE COUNT
JSR PC,DKUPDT ;UPDATE USER POINTERS
ADD C,FAFBP(D) ;UPDATE FILE POINTER
JSR PC,FAINTS ;TEST FOR INCREMTENT OVERFLOWING PAGE
MOV F,C ;GET COUNT OF LEFTOVER WORDS
BNE DKBKI6 ;JUST TRANSFER THEM
JSR PC,ITM2PO
JSR PC,LSWPOP ;FLUSH LOCK ON FUPT
BR DKBKI3 ;NONE, DO IT THE HARD WAY
DKBKI4: JMP DKBKEX ;RETURN TO THE USER
;COME HERE TO EVEN OUT THE WORLD. THIS WILL TRANSFER EXACTLY ONE BYTE
DKBKBI: MOV #1,C ;ONLY WANT 1 BYTES FROM THE FILE
SAVE <A,B>
JSR PC,DKISET ;SET IT UP
ERRORC EQ,RPEF,SV
REST <B,A>
DKBKB1: SAVE A ;SAVE REAL USER POINTER
BIC #1,A ;MAKE IT EVEN
MFPD (A) ;GET THE USER'S WORD
BIT #1,2(P) ;IS THE REAL POINTER ODD?
BEQ DKBKB2 ;NOPE, EVEN
MOVB (E),1(P) ;TRANSFER THE ODD BYTE
BR DKBKB3
DKBKB2: MOVB (E),(P) ;TRANSFER THE EVEN BYTE
DKBKB3: MTPD (A) ;RETURN MUNGED WORD TO THE USER
REST A ;GET THE REAL USER POINTER
INC A ;TRANSFERED ONE BYTE
CLR F ;NO EXTRA BYTES TO TRANSFER
BR DKBKI5 ;GO RETURN POINTERS AND CONTINUE TRANSFER
;RETURN THE USER'S POINTERS TO HIM TO WIN ON PCLOSER
DKUPDT: SAVE B ;SAVE BYTE COUNT
MOV A,B ;GET USER ADDRESS
JSR PC,GIVPSW ;TRANSFER BACK TO HIM
MOV (P),B ;BYTE COUNT
JSR PC,GIVPSW ;TRANSFER BACK
MOV ITM0A,B ;POINT TO PROCESS
ADD #4,PUPDLO(B) ;FIX UP STACK POINTER
REST B
RTS PC
;SET UP FOR A DISK INPUT CALL
;CALL THIS ROTUINE WITH THE DESIRED NUMBER OF BYTES IN C
;AND A POINTER TO THE FA CAP IN D
;IT WIL RETURN THE NUMBER OF BYTES AVAILABLE IN C
;AND A POINTER TO THE THE FIRST BYTE IN E
;IT WILL HAVE LOCKED THE FILE CAPABILITY AND LOADED THE FILE PAGE
;INTO ITEM 2
;IT SETS Z IF THERE ARE NO BYTES AVAILABLE, AND ERRORS OUT
;IF THE FILE POINTER IS BEYOND THE END OF FILE
;LOTS OF REGISTERS MIGHT GET CLOBBERED
DKISET: SAVE C ;SAVE # OF BYTES DESIRED
DKISE8: MOV FAUPT(D),B ;GET THE FUPT
BEQ DKISE2 ;NONE, GO MAKE ONE UP
CMP #-1,B ;IS SOMEONE ELSE IS MAKING ONE UP?
BEQ DKISE5 ;YUP, WAIT FOR HIM
BIC #GIPBIT,B ;MAKE INTO AN ADDRESS
TST FUPTPR(B) ;SOMEONE ELSE USING THE CAP?
BEQ DKISE1 ;NOPE, GRAB IT
DKISE5: JSR PC,SFLUSH ;WAIT
JSR PC,RUNME ;BUT NOT LONG
BR DKISE8 ;TRY AGAIN
DKISE1: JSR PC,FUPTLK ;LOCK THIS FUPT
MOV UPTPBP(B),E ;GET PB POINTER
CMP FAFPN(D),PBFPNO(E) ;IS THIS FUPT FOR TH EPAGE WE ARE ON?
BNE DKISE3 ;NOPE, GET A NEW ONE
MOVB UPTSTL(B),E ;GET THE START AND LENGTH
MOV E,F ;COPY
BIC #UPTSMS,E ;START
BIC #UPTLMS,F ;LENGTH
ASH #10.-UPTSSH,E ;START INTO BYTES
INC F ;0=>1
ASH #10.,F ;LENGTH INTO BYTES
ADD E,F ;LENGHT INTO END
CMP FAFBP(D),E ;ARE WE INTERESTED IN STUFF AFTER THE START?
BLT DKISE3 ;NOPE, BEFORE IT
CMP FAFBP(D),F ;AND BEFORE THE END?
BGE DKISE3 ;NOPE, AFTER IT
JSR PC,DKIEFC ;CHECK FOR THE EOF BEING IN THIS BLOCK
SUB FAFBP(D),F ;THAT'S HOW MANY BYTES THERE ARE AVAILABLE
MOV F,C ;WANT TO RETURN IT IN C
CMP C,(P) ;DO WE HAVE MORE THAN HE WANTS?
BLOS 1$ ;NOPE
MOV (P),C ;ONLY GIVE WHAT HE ASKS FOR (OR LESS)
1$: SAVE A
MOV FAUPT(D),A ;GET THE FILE PAGE
JSR PC,ITM2PL ;LOAD IT UP
SUB E,A ;SUBTRACT OFF THE PAGE START
MOV A,E ;COPY
ADD FAFBP(D),E ;AND ADD IN THE FILE POINTER
REST <A,> ;RESTORE A AND FLUSH SAVED C
TST C ;SET CONDITION CODES
RTS PC
;COME HERE IF THE CURENT FILE PAGE IS USLESS TO US
DKISE3: JSR PC,FAUPDL ;DELETE THE CURRENT UPT
JSR PC,LSWFLS ;FLUSH THE LOCK WE HAD ON IT
;FALL INTO MAKING A NEW FUPT THAT IS THE RIGHT THING
DKISE2: REST C ;WE WNAT TO PRESERVE
JSR F,ACSAV ;ALL THE REGISTERS NOW
MOV D,A ;COPY CAP POINTER
SUB ITM1A,A ;MAKE IT RELATIVE
ADD #FAUPT,A ;WANT TO LOCK THE FAUPT
MOV #-1,B ;LOCK ALL BITS
MOV ITEM1,C ;IN THE CURRENT SPHERE
JSR PC,LCKASW ;LOCK IT
MOV FAFPN(D),C ;THE PAGE NUMBER
MOV FAMFI(D),A ;NEED TO LOOK IN THE MFI
JSR PC,ITM2PL
MOV #20000,F ;DEFAULT END OF THIS PAGE
MOV FAFBP(D),E ;POINTER INTO PAGE
CMP C,MFPGNO(A) ;ARE WE ON THE EOF PAGE?
ERRORC HI,APEF ;NO, WE ARE BEYOND IT!
BLO DKISE6 ;NO, WE ARE BEFORE IT
CMP E,MFBYTP(A) ;IS FILE POINTER BEYOND EOF?
ERRORC HI,APEF ;ACCESS BEYOND END OF FILE IF SO
BIS #.FAEOF,(D) ;TELL THE WORLD TO BE CAREFUL
MOV MFBYTP(A),F ;END OF FILE IS END OF PAGE
DKISE6: MOV E,B ;COPY FILE POINTER
ADD 4(P),B ;ADD NUMBER OF BYTES CALLER WANTS TO IT
CMP B,F ;DOES CALLER WANT MORE THAN CAN FIT ON PAGE?
BHI 1$ ;YES, HE ONLY GETS WHAT FITS
MOV B,F ;GIVE HIM ONLY WHAT HE WANTS
1$: ASH #-10.,E ;CONVERT TO BLOCKS
DEC F ;MAKE 2000 INTO 1777
ASH #-10.,F ;THIS TOO
SUB E,F ;CONVERT END TO LENGTH
BGE DKISE4 ;THERE ARE SOEM BYTES AVAILABLE
BIT #MFLSTB,MFENHD(A) ;NO BYTES, BUT IS THE BLOCK THERE?
BEQ DKISE7 ;NOPE, NOTHING
CLR F ;YES, MAP IN THE BLOCK ANYWAY
DKISE4: MOV FAMFI(D),A ;GET THE MFI #
MOV FAFPN(D),C ;GET THE RIGHT PAGE NUMBER
JSR PC,MAKFPG ;MAKE A FILE PAGE
ERRORC EQ,APEF ;UGH, MUST HAVE HIT A HOLE!
JSR PC,LSWPOP ;LOCK ON JUST CREATED FUPT
JSR PC,LSWPOP ;LOCK ON FA CAP
MOV C,FAUPT(D) ;THE NEW FILE PAGE
JSR PC,ITM2PO ;FLUSH LOADED MFI
JSR F,ACRES
JMP DKISET ;TRY IT AGAIN
DKISE7: JSR PC,LSWPOP ;POP LOCK ON UPT OF FA
JSR PC,ITM2PO ;FLUSH MFI
JSR F,ACRES ;GET REGISTERS BACK
CLR C ;NOTE THAT NO BYTES ARE AVAIABLE
RTS PC ;AND RETURN
;ROUTINE TO ADJUST F IF THE PAGE IS THE LAST IN THE FILE
;AND F POINTS BEYOND TH EEND OF THE FILE
DKIEFC: BIT #.FAEOF,(D) ;ARE WE POSSIBLY IN THE LAST PAGE OF THE FILE?
BEQ DKIEF3 ;NO, DON'T WORRY
SAVE A
MOV FAMFI(D),A ;GET THE MFI
JSR PC,ITM2PL
CMP FAFPN(D),MFPGNO(A) ;ARE WE REALLY ON THE LAST PAGE>
BLO DKIEF1 ;NO, NO NEED TO WORRY
CMP F,MFBYTP(A) ;DOES THIS POINT PAST THE EOF?
BLOS DKIEF2 ;NOPE
MOV MFBYTP(A),F ;SET IT TO THE EOF
DKIEF2: JSR PC,ITM2PO
REST A
DKIEF3: RTS PC
DKIEF1: BIC #.FAEOF,(D) ;NO NEED TO WORRY FOR NOW
BR DKIEF2
;DELETE THE CURRENT UPT IF THE TRANSFER END ON AN EVEN BLOCK BOUNDARY
DKBECK: BIT #1777,FAFBP(D) ;ON BOUNDARY?
BNE FAUPD1 ;NOPE
FAUPDL: MOV FAUPT(D),B ;GET THE CURENNT PAGE
BEQ FAUPD1 ;NONE TO FLUSH
JSR PC,UPTDL ;FLUSH IT
CLR FAUPT(D) ;IT IS FLUSHED
FAUPD1: RTS PC
;DISK BYTE OUTPUT
DKBTO: BIT #.FAWT,(D) ;DOES HE HAVE WRITE ACCESS?
ERRORC EQ,BAC ;NOPE, DON'T LET HIM WRITE
MOV #1,C ;WANT TO INSERT 1 BYTE
JSR PC,DKOSET ;GET SPACE
JSR PC,RETNSW ;GET THE BYTE TO OUTPUT
MOVB A,(E) ;PUT INTO FILE
DKBTO1: JSR PC,ITM2PO ;THE FILE PAGE
JSR PC,FAEFIN ;INCREMENT FA POINTER AND MAYBE EOF
JSR PC,LSWPOP ;POP LOCK ON FUPT
JMP ERETCZ ;RETURN TO USER
;DISK WORD OUTPUT
DKWDO: BIT #.FAWT,(D) ;DOES HE HAVE WRITE ACCESS?
ERRORC EQ,BAC ;NOPE, DON'T LET HIM WRITE
BIT #.FAWD,A ;FIRST PART DONE?
BNE DKWDO2 ;YUP, GO DO SECOND PART
MOV #2,C ;WANT TO OUTPUT 2 BYTES
JSR PC,DKOSET ;TRY TO SET IT UP
CMP #2,C ;DID WE GET THEM?
BGT DKWDO1 ;NOPE, ONLY 1
JSR PC,RETNSW ;GET WORD TO OUTPUT
MOVB A,(E)+ ;OUTPUT FIRST BYTE
JSR PC,FAEFIN ;RECORD THAT BYTE
DKWDO3: SWAB A ;GET TOP BYTE
MOVB A,(E) ;OUTPUT THAT
BR DKBTO1 ;RETURN TO USER
DKWDO1: JSR PC,RETNSW ;GET WORD WE WANT TO OUTPUT
MOVB A,(E) ;OUTPUT FIRST BYTE
SAVE B ;SAVE FLAGS
MOV A,B ;GET WORD
JSR PC,GIVPSW ;GIVE BACK WORD
REST B ;GET FLAGS
BIS #.FAWD,B ;FIRST PART DONE
JSR PC,GIVPSW ;GIVE BACK FLAGS
JSR PC,ITM2PO ;FILE PAGE
JSR PC,FAEFIN ;FA POINTER AND EOF
JSR PC,LSWPOP ;LOCK ON PAGE
;TAKE ME NOW LORD!
DKWDO2: MOV #1,C ;ONLY HAVE TO OUTPUT 2ND BYTE
JSR PC,DKOSET ;MAKE ROOM
JSR PC,RETNSW ;GET THE WORD
BR DKWDO3 ;RETURN TOP BYTE
;DISK BLOCK OUT ROUTINE
DKBKO: BIT #.FAWT,(D) ;DOES HE HAVE WRITE ACCESS?
ERRORC EQ,BAC ;NOPE, DON'T LET HIM WRITE
JSR PC,RETNSW ;GET THE NEGATIVE BYTE COUNT
MOV A,B ;SAVE IN B
JSR PC,RETNSW ;GET THE USER ADDRESS
DKBKO3: TST B ;DOES HE WANT ANY?
BNE DKBKO4 ;YES, CONTINUE GETTING THEM
DKBKEX: JSR PC,DKBECK ;CHECK FOR END OF BLOCK
JMP ERETCZ ;RETURN TO THE USER
DKBKO4: BIT #1,A ;ODD USER ADDRESS?
BNE DKBKCI ;GO INPUT EXACTLY ONE BYTE TO EVEN IT OFF
CMP #-1,B ;DOES THE USER WANT EXACTLY ONE BYTE?
BEQ DKBKCI ;GO GIVE HIM EXACTLY THAT
MOV B,C ;COPY BYTE COUNT
NEG C ;MAKE IT POSITIVE
SAVE <A,B> ;SAVE BYTE COUNT
JSR PC,DKOSET ;SET UP TO TRANSFER THE STUFF
REST <B,A>
CMP #1,C ;ONLY ONE BYTE?
BEQ DKBKC1 ;GO GIVE HIM THAT
ASR C ;CONVERT TO WORD COUNT
DKBKO6: SAVE C ;SAVE WORD COUNT
DKBKO1: MFPD (A)+ ;GET WORD TO TRANSFER
MOVB (P),(E)+ ;INSERT LOW BYTE
MOVB 1(P),(E)+ ;INSERT HIGH ONE
TST (P)+ ;FLUSH WORD FROM STACK
BIT #1777,A ;CROSS USER BLOCK BOUNDARY?
BEQ DKBKO2 ;YES, GO CLEAN UP IN CASE OF ERRROR ON NEXT BLOCK
SOB C,DKBKO1 ;FOR ALL AVAILABLE WORDS
BR DKBKO7 ;COUNTED OUT
DKBKO2: DEC C ;GOT A WORD WE HAVEN'T COUNTED YET
SUB C,(P) ;IF WE DIDN'T TAKE THEM ALL, DON'T COUNT THEM ALL
DKBKO7: MOV C,F ;BUT SAVE COUNT OF EXTRA WORDS
REST C ;GET COUNT OF WORDS WE TOOK
ASL C ;CONVERT TO BYTES
DKBKO5: ADD C,B ;ADJUST USER'S BYTE COUNT
JSR PC,DKUPDT ;UPDATE USER POINTERS
ADD C,FAFBP(D) ;UPDATE FILE POINTER
JSR PC,FAEFTS ;TEST FOR INCREMTENT OVERFLOWING PAGE
MOV F,C ;GET COUNT OF LEFTOVER WORDS
BNE DKBKO6 ;JUST TRANSFER THEM
JSR PC,ITM2PO
JSR PC,LSWPOP ;POP THE SWITCH
BR DKBKO3 ;NONE, DO IT THE HARD WAY
;COME HERE TO EVEN OUT THE WORLD. THIS WILL TRANSFER EXACTLY ONE BYTE
DKBKCI: MOV #1,C ;ONLY WANT 1 BYTES FROM THE FILE
SAVE <A,B>
JSR PC,DKOSET ;SET IT UP
REST <B,A>
DKBKC1: SAVE A ;SAVE REAL USER POINTER
BIC #1,A ;MAKE IT EVEN
MFPD (A) ;GET THE USER'S WORD
BIT #1,2(P) ;IS THE REAL POINTER ODD?
BEQ DKBKC2 ;NOPE, EVEN
MOVB 1(P),(E) ;TRANSFER THE ODD BYTE
BR DKBKC3
DKBKC2: MOVB (P),(E) ;TRANSFER THE EVEN BYTE
DKBKC3: REST <,A> ;GET THE REAL USER POINTER
INC A ;TRANSFERED ONE BYTE
CLR F ;NO EXTRA BYTES TO TRANSFER
BR DKBKO5 ;GO RETURN POINTERS AND CONTINUE TRANSFER
;SETUP ROUTINE FOR DISK OUTPUT
;CALL WITH NUMBER OF BYTES YOU WANT TO OUTPUT IN C, RETURNS WITH
;NUMBER YOU CAN OUTPUT IN C
DKOSET: SAVE C ;SAVE NUMBER HE WANTS TO OUTPUT
JSR PC,DKISET ;SEE IF THERE ARE ANY BEFORE THE EOF
BNE DKOSE1 ;YES, LET HIM OUTPUT THAT MANY FOR NOW
MOV FAFBP(D),F ;GET THE POINTER INTO THIS PAGE
BIC #176000,F ;ARE WE AT THE END OF THE LAST BLOCK?
BEQ DKOSE2 ;PROBABLY SO
MOV #2000,C ;THIS MANY BYTES ARE IN A BLOCK
SUB F,C ;SO THIS MANY BYTES AREN'T USED IN THE LAST BLOCK
DKOSE1: CMP C,(P) ;DO WE HAVE MORE THAN HE WANTS?
BHIS 1$ ;YUP, GIVE HIM ONLY WHAT HE ASKED FOR
MOV C,(P) ;GIVE HIM ALL WE GOT
1$: REST C ;GET NUMBER WE HAVE FOR HIM
RTS PC
DKOSE2: REST C ;GET BACK C
JSR F,ACSAV ;AND SAVE THEM ALL
MOV FAMFI(D),A ;MFI FOR THIS FILE
JSR PC,ITM2PL ;LOAD IT UP
BIT #MFLSTB,MFENHD(A) ;DOES THE BLOCK THE EOF POINTS TO EXIST?
BEQ DKOSE3 ;NOPE, NEED A NEW BLOCK
DKOSE5: JSR PC,ITM2PO
JSR F,ACRES ;GET BACK THE REGISTERS
SAVE C ;SAVE WHAT THE USER WANTS
MOV #2000,C ;WE HAVE A WHOLE BLOCK TO GIVE HIM
BR DKOSE1 ;SEE IF HE WANTS IT
;COME HERE WHEN WE NEED A NEW BLOCK=> HAIR**2
DKOSE3: BIT #MFIBEB,MFLAGW(A) ;IS SOMEONE ELSE HACKING THIS?
BNE DKOSE8 ;YES, GO POUT
MOV #MFLAGW,A ;WORD TO LOCK BIT IN
MOV #MFIBEB,B ;BIT TO LOCK
MOV FAMFI(D),C ;IN THE MFI
JSR PC,LCKASW ;LOCK THE BIT
MOV ITM2A,A ;POINT TO MFI AGAIN
MOV MFENHD(A),D ;GET HEADER WORD
ADD #4,D ;MAY HAVE TO ADD BYTES TO ENTRY
MOV ITEM2,A ;THE MFI
JSR PC,MFIEXP ;MAYBE EXPAND ITEM
JSR PC,ITM1PO ;MFIEXP PUSHES IT...
MOV ITM2A,A ;POINTER TO MFI
TST MFBAKP(A) ;ROOT OR TEMP FILE?
BEQ DKOSE4 ;YES, NO NEED TO COMMIT
CMP #4,MFICBY(A) ;DO WE HAVE AT LEAST 4 BYTES COMMITTED?
BLE DKOSE4 ;YES, SAFE
MOV #6,E ;MIGHT AS WELL BE GREEDY
SUB MFICBY(A),E ;BUT NOT TOO GREEDY
INC E ;EVEN IT OFF
BIC #1,E
MOV MFBAKP(A),A ;POINT TO DIR ABOVE US
JSR PC,DIRCMT ;COMMIT THOSE BYTES ABOVE US
MOV ITM2A,A ;POINT AT OUT MFI AGAIN
ADD E,MFICBY(A) ;GOT THEM
DKOSE4: MOV MFDISK(A),D ;GET DISK NUMBER FILE IS ON
MOV MFBITS(D),B ;THE FUPT OF THE BIT TABLE
JSR PC,FUPTLK ;MAKE SURE I GET PCLOSERED IF IT IS SWAPPED OUT
MOV B,A
JSR PC,ITM2PL ;LOAD BIT TABLE
TST (A) ;SWAP IT IN
JSR PC,ITM2PO ;UNLOAD
MOV ITM2A,A ;POINT AT MFI AGAIN
MOV MFIPB(A),B ;POINT TO FIRST PB
BEQ DKOSE6 ;NONE
DKOSE7: CMP MFPGNO(A),PBFPNO(B) ;IS THIS THE EOF PB?
BNE DKOSE9 ;NOPE
DKOS.1: JSR PC,PBWAIT ;MAKE SURE IT ISN'T BEING HACKED
BIT #PBVAS,(B) ;VALID AT SOURCE?
BNE DKOS.2 ;YUP
JSR PC,PBVLSR ;VALIDATE AT SOURCE
BR DKOS.1
DKOS.2: BIT #PBSTS,(B) ;IS IT SWAP TO SOURCE?
BNE 1$ ;YES, VALID AT SWAP SPACE
BIC #PBVASS,(B) ;NOT VALID AT SWAP SPACE
1$: JSR PC,PBCFLS ;FLUSH ITS CORE
BR DKOSE6 ;DONE
DKOSE9: MOV PBFLNK(B),B ;NEXT
BNE DKOSE7 ;TRY AGAIN
DKOSE6: MOV MFENDB(A),E ;GET ADDRESS OF THE LAST BLOCK IN THE FILE
JSR PC,GETDBL ;GET A DISK BLOCK
JSR PC,ADDBLK ;ADD A BLOCK TO THE END OF THE MFI IN ITEM 2
TST B ;IS THERE A PB?
BEQ DKOS.3 ;NO
MOV MFBYTP(A),C ;BYTE POINTER IN LAST PAGE
ASH #-10.,C ;BLOCK # OF BLOCK JUST ADDED
ASL C ;IN BYTES
ADD B,C ;POINT INTO PB
MOV E,PBSDA(C) ;NEW BLOCK
INCB PBFLEN(B) ;INCREASE SIZE OF PAGE
DKOS.3: BIS #MFLSTB,MFENHD(A) ;THE EOF NOW POINTS TO AN EXISTING BLOCK
BIS #MFEBMB,MFLAGW(A) ;ENTRY HAS BEEN HACKED
JSR PC,LSWPOP ;FLUSH LOCK ON ENTRY
JSR PC,LSWPOP ;FLUSH LOCK ON BIT TABLE
BR DKOS.4
DKOSE8: JSR PC,SFLUSH ;WAIT FOR THE OTHER GUY TO FINISH EXPANDING ENTRY
BIT #MFIBEB,MFLAGW(A) ;DONE?
BNE DKOSE8 ;NOT YET
JSR PC,RUNME ;FINISHED
DKOS.4: JSR PC,ITM2PO ;POP MFI
JSR F,ACRES ;AND REGISTERS
JMP DKOSET ;TRY IT ALL AGAIN
;ADD A BLOCK TO THE END OF THE MFI IN ITEM2
ADDBLK: JSR F,ACSAV
MOV ITM2A,A ;POINT TO MFI
MOV MFENDP(A),B ;PLACE TO ADD STUFF
ADD A,B ;POINT INTO ITEM
MOV MFENDB(A),C ;LAST BLOCK WE HAD IN FILE
SUB E,C ;GET DIFFERENCE
NEG C ;MAKE POSITIVE
MOV E,MFENDB(A) ;NEW LAST BLOCK
JSR PC,@MFENDT(A) ;ROUTINE TO ADD NEXT BLOCK
SUB A,B ;UN RELOCATE
MOV B,MFENDP(A) ;NEW PLACE
MOV F,MFENDT(A) ;NEW DISPATCH
JMP ACRET
;COME HERE IF WE CAN'T ADD TO PREVIOUS BYTE
ADDNXT: INC B
;COME HERE IF THERE ARE NO BLOCKS IN FILE YET
ADDEMP: JSR PC,ADDBYT ;ADD A BYTE TO COUNTS
DEC C ;CHECK FOR EXACTLY 1
BEQ CNTADD ;ADD A COUNT TYPE
CMP #10,C ;LESS THAN 10 AWAY?
BHI SKGADD ;ADD A SKIP AND GET TYPE
CMP #100,C ;LESS THAN 100 AWAY?
BHI SKPADD ;ADD A SKIP TYPE
MOV MFENHD(A),C ;GET HEADER
BIC #177400,C ;GET COUNT
CMP #374,C ;IS THERE ROOM?
BGE ADDEM1 ;YES
DEC MFENHD(A) ;FLUSH BYTE ALREADY ADDED
INC MFICBY(A) ;RETURN COMMITED BYTE
ERROR FTL ;FILE TOO LONG
ADDEM1: JSR PC,ADDBYT ;MUST ADD
JSR PC,ADDBYT ;A SET ADDR TYPE
MOV B,C ;POINTER
MOVB #200,(C)+ ;THE TYPE, NO COUNT
MOVB E,(C)+ ;LOW BYTE
SWAB E ;GET HIGH BYTE
MOVB E,(C)+
MOV #ADDSET,F ;TYPE
RTS PC
CNTADD: MOVB #100,(B) ;COUNT BYTE
MOV #ADDCNT,F ;TYPE
RTS PC
SKGADD: ASH #3,C ;PUT SKIP INTO PLACE
BIS #300,C
MOVB C,(B)
MOV #ADDSKG,F
RTS PC
SKPADD: MOVB C,(B) ;SKIP BYTE
MOV #ADDNXT,F ;TYPE
RTS PC
ADDCNT: CMP #1,C ;NEXT?
BNE ADDNXT ;NOPE
MOVB (B),D ;GET OLD BYTE
BIC #177700,D ;GET COUNT SO FAR
CMP #37,D ;MAX YET?
BEQ ADDNXT
INCB (B) ;ONE MORE TIME!
MOV #ADDCNT,F ;THIS IS STILL A COUNT BYTE
RTS PC
ADDSKG: CMP #1,C ;NEXT?
BNE ADDNXT ;NOPE
MOVB (B),D ;GET OLD BYTE
BIC #177770,D ;GET COUNT
CMP #7,D ;GOING TO OVERFLOW
BEQ ADDNXT ;YES, GO ADD ANOTHER BYTE
INCB (B) ;ONE MORE
MOV #ADDSKG,F
RTS PC
ADDSET: CMP #1,C ;NEXT?
BNE ADDSE1 ;CAN'T ADD THE BLOCK
MOVB (B),D ;GET THE COUNT
BIC #177700,D ;COUNT
CMP #77,D ;WILL WE OVERFLOW
BEQ ADDSE1 ;YES
INCB (B) ;INC IT
MOV #ADDSET,F
RTS PC
ADDSE1: ADD #2,B ;SKIP THE CURENT ONE
BR ADDNXT
ADDHOL: CMP #-1,E ;ARE WE STILL HOLEY?
BNE ADDNXT ;NOPE
MOVB (B),D ;GET BYTE
BIC #177700,D ;GET COUNT
CMP #77,D ;ABOUT TO OVERFLOW?
BEQ ADDNXT
INCB (B)
MOV #ADDHOL,F
RTS PC
ADDBYT: SAVE B
MOV MFENHD(A),B ;GET HEADER
BIC #177400,B ;GET BYTE COUNT
CMP #377,B ;ABOUT TO OVERFLOW?
ERRORC EQ,FTL ;FILE TOO LONG
INC MFENHD(A) ;GOING TO ADD 1 BYTE AT LEAST
DEC MFICBY(A) ;ONE LESS COMMITED BYTE AVAILABLE
REST B
RTS PC
;GET A DISK BLOCK ON DISK (D)
;PREFERABLY CLOSE TO (E)
;IF THAT'S NOT AVAIABLE, TRY MFROVR(D)
GETDBL: JSR F,ACSAV
MOV D,C ;D IS USED FOR OTHER THINGS
TST MFFREE(C) ;ANY FREE?
ERRORC EQ,DFL ;DISK FULL
DEC MFFREE(C) ;GOING TO GRAB ONE
MOV MFBITS(C),A ;BIT TABLE FOR THIS DISK
JSR PC,ITM2PL ;LOAD IT
MOV (A),B ;NUMBER OF BLOCKS ON THE DISK
INC E ;GET ONE AFTER THIS ONE
BEQ GETDB3 ;IF THIS IS FIRST BLOCK IN A FILE, START ANYWHERE
MOV E,B ;END OF WORLD
ADD #77,B ;IS LONGEST USEFUL DISTANCE
CMP (A),B ;UNLESS IT IS BEYOND
BHIS 1$ ;THE REAL END
MOV (A),B ;IN WHCIH CASE USE THAT
1$: CMP B,E ;ARE WE AT END?
BEQ 2$ ;SKIP TRYING
JSR PC,TRYGET ;TRY TO GET ONE AFTER (E)
BNE GETDB4 ;WIN
2$: CMP MFROVR(C),E ;MIGHT THERE BE ANYTHING AFTER THE ROVER?
BLO GETDB2 ;MAYBE
CLR MFROVR(C) ;NO CHANCE, MIGHT AS WELL TRY HERE
GETDB2: MOV (A),B ;END OF WORLD
GETDB3: MOV MFROVR(C),E ;TRY AT THE ROVING POINTER
JSR PC,TRYGET ;TRY AFTER THE ROVER
BNE GETDB1 ;NOPE
CLR E ;I'LL TAKE ANYTHING!
JSR PC,TRYGET
BUGC EQ ;MFFREE SAID....
GETDB1: MOV D,MFROVR(C) ;SET ROVER AT FIRST FREE BLOCK
ADD #16.,MFROVR(C) ;MAKE IT ROVE
CMP MFROVR(C),(A) ;TOO FAR?
BLO GETDB4 ;NOPE
CLR MFROVR(C) ;BACK TOT HE BEGGINING
GETDB4: MOV D,10(P) ;CLOBBER E TO RETURN
BUGC EQ
JSR F,ACRES
JSR PC,ITM2PO
RTS PC
;TRY TO GET A BLOCK STARTING AT E AND ENDING AT B
TRYGET: SAVE <E,F>
MOV E,D ;COPY STARTING PLACE
ASHC #-3,E ;CONVERT STARTING ADDRESS
ASH #-13.,F ;INTO BYTE ADDRESS AND OFFSET
BIC #177770,F ;BYTE ADDRESS
ADD A,E ;OFFSETIFY
ADD #2,E ;INTO BIT TABLE
TRYGE1: BITB BMT(F),(E) ;FREE?
BEQ TRYGE2 ;YES, WIN
INC F ;NEXT BIT
BIC #177770,F ;ONLY 8 BITS/BYTE
BNE 1$ ;OVERFLOW?
INC E ;YES, TRY NEXT BYTE
1$: INC D ;NEXT BLOCK
CMP D,B ;OVER THE END?
BLO TRYGE1 ;NOT YET
REST <F,E>
SEZ
RTS PC
TRYGE2: BISB BMT(F),(E) ;GOBBLE THE BLOCK
REST <F,E>
CLZ ;WIN
RTS PC
;INCREMENT THE POINTER IN THE CURRENT FILE CAP, AND IF IT
;GOES BEYOND THE EOF INCREMENT THE EOF
FAEFIN: INC FAFBP(D) ;INCREMENT POINTER
FAEFTS: JSR PC,FAINTS ;TEST IT DIDN'T OVERFLOW
SAVE A
MOV FAMFI(D),A ;GET THE MFI
JSR PC,ITM2PL ;LOAD IT
CMP FAFPN(D),MFPGNO(A) ;AT EOF?
BLO FAEFT1 ;NO, BEFORE IT
BHI FAEFT2 ;NO, PAST IT
CMP FAFBP(D),MFBYTP(A) ;PAST EOF?
BLOS FAEFT1 ;NO, BEFORE IT
FAEFT2: MOV FAFPN(D),MFPGNO(A)
BIS #MFEBMB,MFLAGW(A) ;CHANGED ENTRY
MOV FAFBP(D),MFBYTP(A) ;UPDATE BYTE POINTER TOO
FAEFT1: BIT #1777,FAFBP(D) ;AT END OF BLOCK?
BNE 1$ ;NOPE
BIC #MFLSTB,MFENHD(A) ;NOT AT BEG OF BLOCK, EOF DOESN'T POINT AT EXTANT BLOCK
1$: REST A
JMP ITM2PO
.SBTTL FILE CAPABILITIES-LOWER LEVEL ROUTINES
;GET A FILE NAME FROM THE USER
;TAKES POINTER TO USER CORE IN E
;RETURNS WITH POINTER TO THE FILE NAME BLOCK IN A
;SAID BLOCK IS LOCKED, AND WILL BE RETURNED WHEN THE SWITCH IS POPED
;RETURNS WITH Z SET IF RAN OFF END OF USER'S STRING
;NO OTHER REGISTERS ARE DISTURBED
MAKFNB: JSR F,ACSAV
MAKFN1: JSR PC,GETUBY ;GET THE NEXT USER BYTE
BNE MAKFN2 ;SOMETHING THERE IF BYTE IS NON-ZERO
JSR F,ACRES ;NO NAME THERE
SEZ
RTS PC
MAKFN2: CMP #40,A ;IS IT JUST A SPACE?
BEQ MAKFN1
DEC E ;I'LL WANT THAT ONE AGAIN
MOV #FNBFRE,B ;GET A FILE NAME BLOCK
JSR PC,FREEGT ;STANDARD METHOD
SAVE A ;SAVE POINTER TO THING WE GOT
MOV #LSPRTN,A ;EXECUTE WHENEVER POPED
CLR B ;NO ITEM
JSR PC,LOCKSW ;GET A LOCK BLOCK
MOV #FNBULK,LCKWD1(A)
MOV (P),LCKWD2(A) ;SAVE POINTER TO THIS BLOCK IN THE LOCK BLOCK
REST B ;GET BACK THE POINTER
MOV #-1,FNBVER(B) ;NO VERSION YET
CLR FNBFNL(B) ;FILE NAME IS ZERO LONG
MOV B,C ;COPY POINTER TO THE BLOCK
ADD #FNBFN,C ;POINT TO THE FILE NAME PART
MOV #FNBNML,D ;MAX LENGTH OF NAME
MAKF.1: JSR PC,GETUBY ;GET THE NEXT BYTE
BEQ MAKF.2 ;GO FINISH UP IF BYTE IS ZERO
CMP #40,A ;ANOTHER TYPE OF END
BEQ MAKF.2
CMP #'#,A ;VERSION NUMBER INDICATOR
BEQ MAKF.3 ;GO PROCESS THAT
CMP #'",A ;QUOTED CHARACTER NEXT
BEQ MAKF.7 ;GO GOBBLE IT
CMP #'>,A ;GREATER THAN VERSION?
BEQ MAKF.4 ;YUP
CMP #'<,A ;LESS THAN?
BEQ MAKF.5 ;YUP
MAKF.8: INC FNBFNL(B) ;ONE MORE CHAR IN FILE NAME
MOVB A,(C)+ ;NOTHING SPECIAL, PUT IT INTO THE STRING
SOB D,MAKF.1 ;KEEP LOOKING FOR THE END
ERROR FNTL ;FILE NAME TOO LONG
MAKF.4: MOV #-2,D ;THE > MARKER
BR MAKF.9 ;GO PLACE IT
MAKF.5: MOV #-3,D ;THE < MARKER
MAKF.9: MOV D,FNBVER(B) ;PLACE IT IN THE BLOCK
MAKF.2: BISB #200,-(C) ;MARK THE END OF THE NAME
TST A ;IF THE LAST BYTE WAS A ZERO
BNE 1$
DEC E ;WE WANT TO BE SURE TO SEE IT THE NEXT TIME
1$: MOV E,FNBFNE(B) ;SAVE THE END POINTER INTO THE USER
MOV B,(P) ;RETURN THE POINTER TO THE BLOCK IN A
JMP ACRETC
MAKF.7: JSR PC,GETUBY ;GET A QUOTED CHARACTER
BR MAKF.8 ;AND STUFF IT INTO THE NAME
;COME HERE TO GET A VERSION NUMBER
MAKF.3: CLR D ;START NUMBER AT ZERO
MAKF.6: JSR PC,GETUBY ;GET THE NEXT BYTE
BEQ MAKF.9 ;GO INSERT NUMBER INTO BLOCK IF BYTE IS ZERO
CMP #40,A ;ANOTHER TERMINATOR?
BEQ MAKF.9 ;YUP
SUB #'0,A ;MAKE INTO BCD
ERRORC LT,BFN ;BAD FILE NAME, NON-NUMERIC
CMP #9.,A ;IS IT A NUMBER?
ERRORC LT,BFN ;BAD FILE NAME AGAIN
MUL #10.,D ;CONVERT TO DECIMAL
ERRORC CS,BFN ;NUMBER TOO BIG
ADD A,D
BR MAKF.6 ;GET NEXT DIGIT
;GET A BYTE FROM THE USER USING E AS A POINTER
;RETURN THE BYTE IN A AND INCREMENT E
;AND SET Z IF THE BYTE IS ZERO
GETUBY: SAVE E ;SAVE THE POINTER
BIC #1,E ;MAKE IT EVEN
MFPD (E) ;GET WORD FROM USER
BIT #1,2(P) ;WAS ORIGINAL POINTER ODD?
BEQ 1$ ;IF NOT, WORD ON STACK IS OK
SWAB (P) ;REVERSE BYTES TO GET ODD ONE
1$: REST <A,E> ;GET USERS WORD AND OLD POINTER
INC E ;UPDATE POINTER
BIC #177400,A ;CLEAR TOP BYTE
RTS PC
;PUT A BYTE INTO THE USERS CORE
;TAKE THE BYTE IN A, THE POINTER TO USER CORE IN E
;INCREMENTS E
;SETS Z IF ZERO BYTE TRANSFERED
PUTUBY: SAVE E
BIC #1,E ;MAKE THE POINTER EVEN
MFPD (E) ;GET WORD BYTE IS GOING INTO
BIT #1,2(P) ;WAS ORIGINAL ODD?
BNE 1$ ;YUP
MOVB A,(P) ;INSERT BYTE
BR 2$
1$: MOVB A,1(P) ;INSERT INTO ODD BYTE
2$: MTPD (E) ;RETURN MODIFIED WORD
REST E
INC E
TST A
RTS PC
;GET A WORD FROM THE USER, POSSIBLY ON AN ODD BOUNDARY
;RETURN THE WORD IN A
;AND ADD 2 TO E
GETWRD: JSR PC,GETUBY ;FIRST BYTE
SAVE A
JSR PC,GETUBY ;SECOND BYTE
SWAB A ;IS HIGH PART
BIS (P)+,A ;GET FULL WORD
RTS PC
;WHEN SWITCH IS POPED RETURN NODE TO FREE LIST
FNBULK: MOV FNBFRE,@LCKWD2(B) ;CLOBBER NODE BEING RETURNED
MOV LCKWD2(B),FNBFRE ;POINT FREE POINTER AT IT
RTS PC
;ROUTINE TO CREATE AN MFI AND RETURN POINTER TO IT IN A
;CLEAR Z IF YOU WIN
CRMFI: SAVE B
MOV #MFLEN,A ;THE LENGTH OF A BASIC MFI
JSR PC,CRITEM ;CREATE IT
BEQ CRMFI1 ;FAILED
SAVE B ;SAVE THE POINTER TO IT
JSR PC,CLITEM ;CLEAR OUT THE NEW ITEM
JSR PC,ITM0PO ;RECOVER FROM CLITEM
MOV (P),A ;GET BACK THE ITEM NUMBER
JSR PC,ITM2LD ;LOAD IT UP
MOV #ITMF,(A) ;YOU ARE AN MFI
MOV #MFLEN_6,MFELN(A) ;CURRENTLY THIS LONG
MOV #1,MFFREF(A) ;PRESUMABLY, THERE WILL SOON BE A CAPABILITY
MOV #MFOPNB,MFLAGW(A) ;ENTRY BEING OPENED
MOV #LSPPCL,A ;RUN ROUTINE ON PCLOSER
MOV (P),B ;FOR THIS ITEM
JSR PC,LOCKSW ;GET A LOCK BLOCK
MOV #MFIUNL,LCKWD1(A) ;MUST DO SPECIAL THINGS TO UNLOCK
REST <A,B> ;GET OLD B AND NEW A
CLZ ;INDICATE SUCCESS
RTS PC
CRMFI1: REST B
SEZ ;FAILURE
RTS PC
;ROUTINE TO FLUSH A REFERENCE TO AN MFI BY A FA OR INFERIOR DIRECTORY
;CALL WITH MFI ITEM # IN A
MFIDEL: SAVE A
JSR PC,ITM2PL ;LOAD UP THE ITEM
MFIDE3: DEC MFFREF(A) ;ONE LESS REFERENCE
BNE MFIDE1 ;BUT STILL NON-ZERO
BIT #MFEBMB,MFLAGW(A) ;HAS THE ENTRY BE MODIFIED?
BEQ MFIDE2 ;NO, IT CAN GO QUIETLY
BIT #MFDWDB,MFLAGW(A) ;DELETE WHEN DONE?
BNE MFIDE2 ;YUP, DON'T PUT IT BACK
INC MFFREF(A) ;IN CASE OF PCLOSER
JSR PC,MFIINS ;INSERT ENTRY INTO THE DIRECTORY
BR MFIDE3 ;RUN THAT BY AGAIN
MFIDE2: JSR PC,MFIDFL ;FLUSH THE STRANGE WAY, IF NESSESARY
BEQ MFIDE1 ;IT WAS
TST MFPBRF(A) ;ANY PAGES LEFT?
BNE MFIDE1 ;YES, DON'T FLUSH MFI
JSR PC,MFIUN ;BYE-BYE MFI
MFIDE1: JSR PC,ITM2PO
REST A
RTS PC
;ROUTINE TO FLUSH THE REFERENCE TO A FILE BY A PAGE BLOCK
;CALL WITH PB INDEX IN B
MFIPBD: JSR F,ACSAV
MOV PBMFIP(B),A ;THE MFI THIS PB IS FROM
JSR PC,ITM2PL
DEC MFPBRF(A) ;ONE LESS
BNE MFIPB1 ;STILL MORE THOUGH
TST MFFREF(A) ;ANY OTHER REFERENCES?
BNE MFIPB1 ;YUP
JSR PC,MFIUN ;FLUSH IT
MFIPB1: JMP ACRTP2
;THIS WILL FLUSH THE MFIUPT OF A DIRECTORY IF THERE IS
;ONE AND THERE IS ONLY ONE PB STILL HANGING AROUND
;AND THE FUPT FOR THE DIR POINTS AT ITSELF
;IF ALL THESE CONDIONS ARE TRUE, THEN DELETEING THE
;FUPT WILL CAUSE THE MFI TO GET FLUSHED BY A
;(POSSIBLY RECURSIVE) CALL THE MFIPBD, SO THAT
;THE CALLER SHOULD NOT TRY TO FINSH THE DELETEION
;HIMSELF. THIS ROUTINE SETS Z IF THIS IS THE CASE
MFIDFL: SAVE <B,C>
TST MFIUPT(A) ;IS THERE A MFIUPT (MEANING THIS IS A DIR)
BEQ MFIDF1 ;NOPE
MFIDF3: CMP #1,MFPBRF(A) ;IS THERE EXACTLY ONE PB?
BUGC NE ;UGH, HOW DO YOU GET MORE THAN ONE PB FOR A DIR?
MOV MFIUPT(A),B ;GET THE FUPT
MOV B,C ;COPY
BIC #GIPBIT,C ;MAKE INTO ADDRESS
CMP UPTGIP(C),B ;DOES IT POINT AT ITSELF?
BNE MFIDF1 ;NO, IT CAN STAY
MOV UPTPBP(C),B ;GET POINTER TO TH EPB
BIT #PBVAS,PBFLAG(B) ;IS IT VALID AT SOURCE?
BNE MFIDF2 ;YES, WIN
JSR PC,PBSWPI ;SWAP IN THE PAGE
JSR PC,PBVLSR ;VALIDATE AT SOURCE
BR MFIDF3 ;NOW CHECK THINGS AGAIN
MFIDF2: MOV C,B ;GET BACK FUPT
BIS #GIPBIT,B ;WELL, ALMOST
;WELL, ALMOST. HAVE TO WORRY ABOUT THE GUY ABOVE US GETTING FLUSHEDD
;GUESS WE BETTER DO IT OURSELVES...
JSR PC,UPTDL ;THIS OUGHT TO TAKE CARE OF EVERYTHING... (AND NOT HANG)
REST <C,B>
SEZ
RTS PC
MFIDF1: REST <C,B>
CLZ
RTS PC
;PCLOSER ROUTINE TO FLUSH AN INCOMPLETE MFI
MFIUNL: BIT #MFOPNB,MFLAGW(A) ;WE BETTER NOT BE DONE OPENING!
BUGC EQ ;OOPS
JSR PC,MFIUNX ;FLSUH THE MFI
RTS PC
;AS MFIUN, BUT FLUSH THE MFIUPT IF IT EXISTS ALSO
MFIUNX: SAVE <A,C,D,E>
MOV MFIUPT(A),B ;IF THERE IS AN ASSOCIATED FUPT...
BEQ MFIUL1 ;NOPE, NO NEED TO GET RID OF IT
JSR PC,UPTDL ;BETTER NOT HANG...
BR MFIUL1
;FLUSH A MFI THAT IS READY FOR FLUSHING, I.E. IS ASSUMED SAFELY PUT BACK INTO
;THE DIRECTORY AND ALL ASSOCIATED PAGES ARE WINNING, ETC.
;CALL WITH THE MFI LOADED INTO ITEM2 AND THE ADDRESS IN A
MFIUN: SAVE <A,C,D,E>
MFIUL1: MOV MFDISK(A),D ;GET THE DISK NUMBER
BIT #MFDWDB,MFLAGW(A) ;SHOULD THE FILE BE DELETED?
BEQ 1$ ;NOPE
BIT #MFSHRB,MFENHD(A) ;DOES IT SHARE BLOCKS?
BNE 1$ ;YES, DON'T RELEASE THEM
JSR PC,MFIBFL ;YES, GO FLUSH THE BLOCKS
1$: MOV MFDLNK(A),C ;THE ONE IT POINTS TO
MOV MFBLNK(D),A ;GET THE FIRST ITEM IN THE LIST FOR THIS DISK
MOV ITEM2,E ;GET ITEM NUMBER OF THE BEING FLUSHED MFI
CMP E,A ;FIRST ON THE LIST?
BEQ MFIUL2 ;YUP, THIS IS EASY
JSR PC,ITM2PL ;LOAD THE FIRST ON THE LIST
MFIUL3: CMP E,MFDLNK(A) ;THIS ONE?
BEQ MFIUL4 ;YUP
MOV MFDLNK(A),A ;GET NEXT
BUGC EQ ;END OF LIST?
JSR PC,ITM2LD
BR MFIUL3
MFIUL4: MOV C,MFDLNK(A) ;UNLINK THE BLOCK
JSR PC,ITM2PO
BR MFIUL5
MFIUL2: MOV C,MFBLNK(D) ;POINT ONE FURTHER DOWN THE LIST
MFIUL5: MOV ITM2A,A
MOV MFBAKP(A),A ;POINTER TO PARENT
BEQ MFIUL6 ;KNOW PARENT, BETTER BE A ROOT
JSR PC,MFIDEL ;RECURSE TO FLUSH A REFERENCE TO THE ABOVE DIRECTORY
MFIUL6: MOV ITEM2,A ;NOW GET THE ITEM NUMBER
JSR PC,DLITEM ;AND FLUSH THE MFI
REST <E,D,C,A>
RTS PC
;ROUTINE TO CONVERT AN MFI DESCRIBING THE FIRST BLOCK OF A DIRECTORY
;TO AN MFI FOR THE WHOLE DIRECOTRY
;THIS IS DONE BY READING THE SELF ENTRY IN THE DIRECTORY'S FIRST BLOCK
;AND COPYING IT INTO THE MFI
;A POINTS TO THE MFI BEING HACKED
DIRENT: JSR F,ACSAV
CLR C ;FOR PAGE ZERO
JSR PC,MAKFUP ;GET AN FUPT
JSR PC,PCLCLR ;WE'RE SAFE (I HOPE)
CLRB UPTSTL(C) ;FLUSH START AND LENGTH TO BE FOR ONE BLOCK PAGE
MOV UPTPBP(C),B ;GET THE PB
CLRB PBLEN(B) ;SAME FOR PB
JSR PC,ITM2PL ;LOAD THE MFI
BIS #GIPBIT,C ;CONVERT FUPT ADDRESS TO A GIP
MOV C,MFIUPT(A) ;FUPT FOR THE DIRECTORY
JSR PC,ITM2PO ;FLUSH THE MFI
MOV C,A ;COPY GIP TO THE PARTIAL DIRECTROY
JSR PC,ITM2PL ;LOAD UP THE DIRETORY
MOV A,E ;COPY POINTER TO IT
MOV (A),D ;HEADER WORD OF SELF ENTRY
MOV (P),A ;GET THE MFI AGAIN
JSR PC,MFIEXP ;GO EXPAND MFI IF NEEDED
ADD #MFENHD,A ;POINT TOT THE RIGHT PLACE IN THE MFI
ASR D ;CONVERT TO WORD COUNT
1$: MOV (E)+,(A)+ ;COPY A WORD
SOB D,1$
MOV ITM1A,A ;POINT TO MFI AGAIN
BIC #17000,MFENHD(A) ;FLUSH SELF TYPE
BIS #MFDIRE,MFENHD(A) ;MAKE IT A DIR ENTRY
JSR PC,ITM1PO ;POP MFI
JSR PC,ITM2PO ;POP DIRECTORY
MOV (P),A ;GET BACK MFI POINTER
JSR PC,ITM2PL ;LOAD IT
CLR C ;PAGE NUMBER DESIRED
MOV MFIUPT(A),A ;GET THE FUPT FOR THE DIR
BIC #GIPBIT,A ;CONVERT TO AN ADDRESS
MOV A,F ;SAVE THAT
MOV UPTPBP(A),B ;GET THE PAGE BLOCK POINTER FOR THE FUPT
BIS #PBNOSW!PBWCHK,(B) ;NEVER ASSIGN SWAP SPACE TO DIR, ALWAYS WRITE-CHECK IT
JSR PC,SWPPG ;FLUSH THE THING FROM CORE
JSR PC,PCLCLR ;DON'T PCLOSER SELF
MOV B,A ;COPY PB POINTER
JSR PC,FILFPB ;FILL IN TH EDISK ADDRESSES
MOVB PBFLEN(B),A ;GET THE LENGTH OF THIS FILE PAGE
DEC A ;NOW THIS IS NUMBER OF VALID BLOCKS-1
MOVB A,PBLEN(B) ;WHICH IS ALWAYS THE LENGTH OF THE PAGE
MOV ITM2A,F ;POINTER TO MFI
MOVB A,UPTSTL(F) ;FUPT'S LENGTH IS WHOLE THING AND START IS ZERO
INC A ;NOW NUMBER OF BLOCKS
MOV A,MFIDLN(F) ;IN CASE SOMEONE IS EVER INTERESTED....
ASH #10.,A ;CONVERT TO BYTES
SUB MFBYTP(F),A ;SUBTRACT NUMBER KNOW TO BE USED
MOV A,MFIUCF(F) ;THAT IS THE NUMBER OF "UNCOMMITED FREE BYTES"
BIC #MFOPNB,MFLAGW(F) ;DIRECTORY IS NOW OPEN FOR BUSINESS..
BIS #.FADIR,MFLAGW(F) ;NOTE IN MFI THAT THIS IS A DIR
JSR PC,ITM2PO
JMP ACRET
;TRY TO EPAND THE MFI IF IT WILL NEED TO BE EXPANDED
;TO TAKE AN ENTRY OF LENGTH IN D
;MFI NUMBER IN A
;D GETS INCREMENTED AND BIC #177400
MFIEXP: SAVE B
BIC #177400,D ;GET LENGTH OF SELF ENTRY IN BYTES
INC D ;MUST ROUND IT TO WORDS
JSR PC,ITM1PL ;LOAD THE MFI
CLR B
ADD D,B ;GET THE TOTAL LENGTH NEEDED FOR THE MFI
ADD #MFENHD,B ;ADD IN THE OVERHEAD
CMP B,MFELN(A) ;LONGER THAN THE MFI IS NOW?
BLT DIREX1 ;NO, WE'RE SAFE!
MOV B,A ;COPY THE NEEDED LENGTH
ASH #-6,A ;MAKE IT INTO 32 WORD BLOCKS
MOV ITEM1,B ;GET BACK THE ITEM NUMBER
JSR PC,ITM1PO ;CAN'T HAVE THIS PUSHED IF WE HANG
JSR PC,EXITEM ;EXPAND THE MFI
ERRORC EQ,NIS ;NOT ENOUGH SPACE
SAVE A ;SAVE THE NEW LENGTH
MOV B,A ;ITEM NUMBER AGAIN
JSR PC,ITM1PL ;LOAD AGAIN
REST B
INC B ;0=>1
ASH #6,B ;CONVERT TO BYTES
MOV B,MFELN(A) ;SET THE NEW LENGTH
DIREX1: REST B
RTS PC
;MAKE AN FUPT FOR A PAGE OF A FILE
;CALL WITH MFI POINTER IN A, PAGE NUMBER IN C
;RETURN POINTER TO FUPT IN C
MAKFUP: JSR F,ACSAV
MOV #FUPTFR,B ;FREE POINTER FOR FUPTS
JSR PC,FREEGT ;GET A FREE ONE
JSR PC,FREELK ;LOCK IT IN CASE OF PCLOSER
MOV #UPTEXB,(A) ;IT EXISTS, AT LEAST
CLR UPTGIP(A) ;DOESN'T HAVE A GIP POINTER
CLR FUPTPR(A) ;NO USER EITHER
MOV A,4(P) ;SAVE TO RETURN TO THE CALLER
MOV A,D ;SAVE POINTER TO FUPT
MOV (P),A ;GET BACK MFI POINTER
JSR PC,MAKFPB ;GO GET A PB FOR THAT PAGE
MOV B,UPTPBP(D) ;PB POINTER
MOV PBGIP(B),E ;GET THE POINTER TO THE CURRENT CIRCULAR LIST
BEQ MAKFU1 ;BRANCH IF THERE ISN'T ONE
MOV E,B ;COPY THE GIP
JSR PC,UPTPLD ;GET A GOOD POINTER TO THE GIP
MOV UPTGIP(B),UPTGIP(D) ;POINT THE NEW FUPT INTO THE LIST
BIS #GIPBIT,D ;MAKE A GIP POINTER FOR THE FUPT
MOV D,UPTGIP(B) ;AND POINT OLD GIP AT IT
JSR PC,ITM2PO ;PUSHED BY UPTPLD
BR MAKFU2 ;KEEP GOING
MAKFU1: MOV D,E ;COPY FUPT POINTER
BIS #GIPBIT,E ;MAKE A GIP OUT OF ONE OF THEM
MOV E,UPTGIP(D) ;POINT TO YOURSELF
MOV E,PBGIP(B) ;POINT TH EPB AT THIS NEW CIRCULAR LIST
MAKFU2: JSR PC,LSWPOP ;FLUSH THE LOCK ON THE PB
JSR PC,LSWPOP ;AND THE FUPT
JMP ACRET
;MAKE UP A FUPT FOR THE PAGE # IN C OF THE FILE
;WHOSE MFI IS IN A WITH START AND LENGTH IN E AND F
;RETURN POINTER TO THE FUPT IN C, UNLESS BLOCKS DON'T
;ALL EXIST, IN WHCIH CASE SET Z
MAKFPG: JSR F,ACSAV
MOV 12(P),F ;CALL TO ACSAV CLOBBERS F, RESTORE IT
JSR PC,MAKFUP ;MAKE UP THE FUPT
BIS #GIPBIT,C ;MAKFUP DOESN'T SET IT
MOV C,4(P) ;SAVE FOR THE CALLER
MOV #LSPPCL,A ;RUN ON PCLOSER
CLR B ;NO ITEM
JSR PC,LOCKSW
MOV #UPTPCD,LCKWD1(A) ;ROUTINE TO RUN
MOV C,LCKWD2(A) ;ON THIS UPT
BIC #GIPBIT,C ;CONVERT TO ADDRESS
MOV UPTPBP(C),B ;GET POINTER TO THE PB
MOV E,C ;START
MOV F,D ;LENGHT
JSR PC,PBSETU ;FIX UP THE PB
BEQ MAKFP1 ;LOSE
MOV 4(P),E ;GET BACK FUPT
BIC #GIPBIT,E ;CONVERT TO ADDRESS
ASH #UPTSSH,C ;GET START INTO RIGHT PLACE
BIS C,D ;COMBINE START AND LENGTH
MOVB D,UPTSTL(E) ;SET UP THE START AND LENGTH
JSR PC,PCLCLR ;SAVE NOW ON THE FPB
JMP ACRETC
MAKFP1: JSR PC,FRELSE ;FLUSH THE UPT
JMP ACRETS
;PCLOSER ROUTINE TO DELETE AN ITEM
;THIS WILL BE A REAL PROBLEM IF THIS EVER HANGS
UPTPCD: MOV LCKWD2(B),B
;FALL INTO UPT DEFERED DELETE
UPTDDL: SAVE <A,B>
MOV #DLUFRE,B
JSR PC,FREEGT ;THIS BETTER NOT HANG
MOV (P),DLUUPT(A) ;PUT IT IN THE NODE
CLR (A) ;FLUSH LINK WORD IN THE NODE
MOV #DLULST,B ;LIST OF NODES TO ACT ON
JSR PC,BLISTE ;GO TO THE END OF THE LIST
MOV A,(B) ;CLOBBER THIS NODE ONTO END OF LIST
REST <B,A>
RTS PC ;NOW HOPE THE SYSTEM DOES THE WORK
;FIND OR MAKE E A PB FOR A PAGE IN A FILE
;CALL WITH ITEM POINTER TO THE MFI IN A
;PAGE NUMBER DESIRED IN C
;RETURNS WITH POINTER TO PB IN B
MAKFPB: JSR F,ACSAV
JSR PC,FPBGET ;GET A BLOCK IN CASE WE NEED ONE
MOVB #-1,PBLEN(B) ;FLUSH THE LENGTH
MOV B,2(P) ;SAVE IT FOR LATER AND TO RETURN TO USER
MOV A,PBMFIP(B) ;POINT THE PB AT THE ASSOCIATED MFI
JSR PC,ITM2PL ;LOAD UP THE MFI
MOV MFIPB(A),B ;POINTER TO FIRST PB
BEQ MAKFP4 ;COULDN'T FIND ANY PBS
MAKFP6: CMP C,PBFPNO(B) ;IS THIS THE PAGE WE'RE LOOKING FOR?
BEQ MAKFP5 ;YUP, WIN
MOV PBFLNK(B),B ;GET THE NEXT ONE
BNE MAKFP6 ;TRY THE NEXT ONE IF IT EXISTS
MAKFP4: MOV 2(P),B ;GET THE PB POINTER BACK
MOV B,A ;MAKE A COPY OF IT
JSR PC,FILFPB ;FILL UP THE FPB WITH DISK ADDRESES
MOV ITM2A,A ;NOW LINK THE NEW THING
MOV MFIPB(A),PBFLNK(B) ;ONTO THE EXISTING LIST
MOV MFDISK(A),PBSDSK(B) ;COPY DISK NUMBER OUT OF MFI
MOV B,MFIPB(A) ;OF PBS FOR THIS FILE
INC MFPBRF(A) ;ONE MORE PB FOR THIS MFI
JSR PC,LSWPOP ;FLUSH SIMPLE LOCK ON BLOCK
MOV #FPBPFL,E ;PCLOSER ROUTINE IF WE GOT A NEW BLOCK
MAKFP9: MOV #LSPPCL,A ;RUN ROUTINE ON PCLOSER
CLR B ;NO ITEM
JSR PC,LOCKSW ;GET A LOCK BLOCK
MOV E,LCKWD1(A) ;ROUTINE
MOV 2(P),LCKWD2(A) ;FPB POINTER
JMP ACRTP2
MAKFP8: RTS PC
MAKFP5: JSR PC,PCLSET ;IN CASE WE HANG BEFORE WE HAVE IT SAFELY TUCKED AWAY
JSR PC,FRELSE ;FLUSH THE PB WE'RE NOT USING
MOV B,2(P) ;RETURN POINTER TO EXISTING PB
MOV #MAKFP8,E ;DUMMY PCLOSER IF WE GOT OLD BLOCK
BR MAKFP9
;FILL UP A FPB WITH DISK BLOCK NUMBERS
;CALL WITH PAGE NUMBER DESIRED IN C
;POINTER TO PB IN A
;CLOBBERS D AND E
FILFPB: ADD #PBSDA,A ;TO POINT AT THE BLOCK NUMBERS
ASH #3,C ;PAGE NUMBER=>BLOCK NUMBER
JSR PC,MFBLKG ;INITIALIZE COROUTINE AND VARIABLES
FILFP1: CMP C,D ;IS THSI THE RIGHT FIRST BLOCK NUMBER?
BEQ FILFP2 ;YUP, START GOBBLING
JSR PC,@(P)+ ;JUMP BACK
BR FILFP1 ;TO TRY AGAIN
FILFP2: ASH #-3,C ;BACK TO PAGE NUMBER
MOV C,PBFPNO(B) ;THIS IS THE PAGE FOR THIS PB
MOV #8.,C ;FOR 8 BLOCKS
CLRB PBFLEN(B) ;ZERO VALID BLOCKS
FILFP3: MOV E,(A)+ ;STORE IN THE PB
CMP #-1,E ;VALID BLOCK?
BEQ 1$ ;NOPE
INCB PBFLEN(B) ;ONE MORE THEN
1$: JSR PC,@(P)+ ;GET NEXT BLOCK
SOB C,FILFP3 ;CONTINUE TILL 8 DONE
TST (P)+ ;FLUSH COROUTINE LINK
RTS PC
;PCLOSER ROUTINE TO FLUSH A FILE PAGE BLOCK
;WHICH HAS NOT YET BECOME ASSOCIATED WITH AN FUPT
FPBPFL: MOV LCKWD2(B),B ;POINTER TO FUPT
TST PBGIP(B) ;DOES THE PAGE HAVE A GIP POINTER?
BUGC NE ;HAVE TO MORE THAN THIS THEN!
FPBFR: JSR PC,PBNSWP ;MAKE SURE IT IS NOT ON SWAP OUT LIST
BIT #PBLOCK!PBDISK,PBFLAG(B) ;IS THE PAGE MOVING?
BUGC NE ;ARG!
BIT #PBFILE,PBFLAG(B) ;REALLY A FILE PAGE?
BEQ PBFR ;FREE A REGULAR PB
MOV PBMFIP(B),A ;THE MFI FOR THIS FPB
BEQ FPBPF6 ;NONE
JSR PC,ITM2PL ;LOAD IT UP
CMP B,MFIPB(A) ;IS THIS ONE THE FIRST IN THE LIST
BEQ FPBPF1 ;YES
MOV MFIPB(A),A ;NO, CONTINUE DOWN LIST
FPBPF3: BUGC EQ ;RAN OFF THE END
CMP PBFLNK(A),B ;THIS ONE?
BEQ FPBPF2 ;YUP
MOV PBFLNK(A),A ;NEXT?
BR FPBPF3
FPBPF1: MOV PBFLNK(B),MFIPB(A) ;POINT IT AT THE NEXT IN THE LIST
BR FPBPF5 ;CONTINUE ON
FPBPF2: MOV PBFLNK(B),PBFLNK(A) ;LINK ME OUT OF THE LIST
FPBPF5: JSR PC,ITM2PO
FPBPF6: MOV FPBFRE,(B) ;MAKE THE NEW FREE ONE POINT AT THE FREE LIST
MOV B,FPBFRE ;NEW FREE LIST
RTS PC
PBFR: MOV PBFREL,(B) ;NEW FREE POINTS AT OLD
MOV B,PBFREL ;LIST POINTS AT NEW
RTS PC
;THIS ROUTINE TAKES A MFI IN ITEM2 AND SPITS OUT BLOCK NUMBERS
;FOR IT. IT USES THE GLOBAL VARIABLES ENTPNT, ENTEND AND ENDCNT,
;SO YOU BETTER NOT SCHEDULE OUT OF IT. IT MAINTAINS THE BLOCK NUMBER
;IN THE FILE IN D AND THE PYHSICAL BLOCK NUMBER IN E
;NON-EXISTANT BLOCKS COME BACK AS -1
;AFTER THE FIRST CALL IT IS A CO-ROUTINE
MFBLKG: SAVE <A,F>
CLR D ;START AT ZERO IN THE FILE
MOV #-1,E ;AND ZERO ON THE DISK (WELL, WILL BE AFTER FIRST INC)
MOV ITM2A,F ;POINT TO THE MFI
MOV F,A ;COPY POINTER
ADD #MFVERN+2,F ;POINT TO NAME IF NO TIME, DATE AND EOF
BIT #MFEOFB,MFENHD(A) ;TIME DATE ETC?
BEQ 1$ ;NOPE
ADD #10,F ;SKIP IT
1$: BIT #MFACCB,MFENHD(A) ;ACCESS CODES?
BEQ MFBLK2 ;NOPE
MFBLK1: ADD #3,F ;SKIP FIRST CODE GROUP
TSTB -1(F) ;WAS THAT THE LAST ONE?
BLT MFBLK2 ;AFRAID NOT
MFBLK2: TSTB (F)+ ;LAST CHAR OF NAME?
BGE MFBLK2 ;NOT YET
MOV F,ENTPNT ;THIS POINTS TO THE FIRST DESCRIPTOR BYTE
MOV MFENHD(A),F ;GET THE HEADER WORD
BIC #177400,F ;GET THE ENTRY LENGTH
ADD A,F ;POINT TO THE FIRST BYTE NOT IN THIS ENTRY
ADD #MFENHD,F ;NOW IT POINTS TO THE END
MOV F,ENTEND ;SAVE THAT QUANTITY
REST <F,A> ;NOW FOR THE MAIN LOOP
MFBLK3: CMP ENTPNT,ENTEND ;ARE WE AT OR PAST THE END?
BHIS MFBLK8 ;YUP, GIVE HIM -1'S
SAVE <A,B>
MOVB @ENTPNT,A ;GET A DESCRIPTOR BYTE
MOV A,B ;IN TWO PALCES
INC ENTPNT ;POINT TO NEXT ONE
BIC #177477,A ;GET THE TYPE
ASH #-5,A ;AS A BYTE INDEX
BIC #177700,B ;ALSO GET THE DATA BITS
INC E ;ALWAYS GO TO THE NEXT BLOCK
JMP @MFBLTB(A) ;GO TO THE RIGHT PLACE
;COME HERE FOR A SKIP AND GRAB ONE TYPE
MFBSKP: ADD B,E ;SKIP
REST <B,A>
JSR PC,@(P)+ ;GRAB ONE
INC D ;NEXT BLOCK IN FILE
BR MFBLK3 ;GO GET NEXT BLOCK
;COME HERE FOR A GRAB N BLOCKS TYPE
MFBGET: MOV B,ENTCNT ;GET THAT MANY BLOCKS
CMP #40,B ;MAYBE REALLY A HOLE IN THE FILE
BLE MFBGE2 ;YES, GO HOLIFY
MFBGE4: REST <B,A>
MFBGE1: JSR PC,@(P)+ ;GET ONE BLOCK
INC D ;NEXT IN FILE
DEC ENTCNT ;ANY MORE?
BLT MFBLK3 ;NO, GET NEXT BYTE
INC E ;NEXT ON DISK
BR MFBGE1
MFBGE2: SUB #40,ENTCNT ;REMOVE FLAG BIT
REST <B,A>
MFBGE3: MOV #-1,E ;NOTHINGNESS
JSR PC,@(P)+ ;RETURN IT
INC D ;NEXT BLOCK IN FILE
DEC ENTCNT ;MORE OF SAME?
BNE MFBGE3 ;YUP
BR MFBLK3 ;NO, NEXT BYTE
;COME HERE FOR A SET ADDRESS TYPE OF DESCRIPTOR
MFBSET: MOV B,ENTCNT ;SAVE THE COUNT
MOVB @ENTPNT,A ;GET NEXT BYTE
INC ENTPNT
BIC #177400,A ;LOSING SIGN EXTEND!
MOVB @ENTPNT,E ;AND HIGH ORDER BYTE
INC ENTPNT
SWAB E ;INTO RIGHT PLACE
BIC #377,E ;UNEXTEND AGAIN
ADD A,E ;WHOLE WORD
BR MFBGE4 ;GO DO REGULAR COUNT
;COME HERE FOR SKIP AND COUNT TYPE
MFBSKG: MOV B,A ;COPY DATA
ASH #-3,A ;GET THE SKIP
ADD A,E ;SKIP IT
BIC #177770,B ;GET THE COUNT
BR MFBGET ;TREAT LIKE REGULAR GET
;COME HERE ON END OF FILE, INFINITE NON-EX BLOCKS
MFBLK8: MOV #-1,E ;NO BLOCK HERE
MOV E,ENTCNT ;FLUSH ANY COUNT LEFT OVER
JSR PC,@(P)+ ;RETURN IT
INC D ;AND SO ON
BR MFBLK8 ;FOREVER
;SET UP THE VARIABLES IN THE MFI IN ITEM2
;SO WE CAN ADD BLOCKS TO IT
MFFEND: JSR F,ACSAV
MOV ITM2A,A ;POINTER TO MFI
MOV A,B
ADD #MFENHD,B ;POINT TO REAL ENTRY
MOV MFENHD(A),C ;GET HEADER WORD
BIC #177400,C ;GET LENGTH
ADD B,C ;MAKE END POINTER
BIT #MFEOFB,(B) ;TIEM DATE ETC?
BEQ 1$ ;NOPE
ADD #10,B ;YES, SKIP
1$: CMP (B)+,(B)+ ;SKIP HEADER WORD AND VERSION #
BIT #MFACCB,MFENHD(A) ;ACCESS CODES?
BEQ MFFEN2 ;NOPE
MFFEN1: ADD #2,B ;SKIP CODES
TSTB (B)+ ;LAST OF THEM?
BLT MFFEN1 ;NOT YET
MFFEN2: TSTB (B)+ ;LAST CHAR OF NAME?
BGE MFFEN2 ;KEEP GOING
MOV #-1,E ;NO BLOCK YET
MOV #ADDEMP,F ;ADD TO EMPTY DESC
MOV B,MFENDP(A) ;THE LAST GOOD BYTE
MFFEN3: CMP B,C ;AT END?
BHIS MFFEN8 ;YES, DONE
MOV B,MFENDP(A) ;THE LAST GOOD BYTE
MOVB (B),D ;GET DESC BYTE
BIC #177477,D ;GET TYPE
ASH #-5,D ;INTO BYTE INDEX
INC E ;NEXT BLOCK
JMP @MFENTB(D) ;GO SERVICE THE TYPE
MFESKP: MOVB (B)+,D ;GET BYTE AGAIN
BIC #177700,D ;GET AMOUNT TO SKIP
ADD D,E ;SKIP IT
MOV #ADDNXT,F ;CAN'T ADD TO THIS BYTE
BR MFFEN3 ;GET NEXT
MFEGET: MOV #ADDCNT,F ;ADD TO REGULAR COUNT
MOVB (B)+,D ;GET THE COUNT
BIC #177700,D
CMP D,#40 ;IS IT A HOLE?
BGE 1$ ;YES
ADD D,E
1$: MOV #-1,E ;RESET BLOCK NUMBER
MOV #ADDHOL,F ;ADD TO A HOLE
BR MFFEN3
MFESET: MOVB (B)+,F ;GET THE DESR FOR THE COUNT BITS
BIC #177700,F ;GET THE COUNT
MOVB (B)+,E ;GET LOW BYTE
BIC #177400,E
MOVB (B)+,D ;GET HIGH BYTE
SWAB D
BIC #377,D
BIS D,E ;GET ADDRESS
ADD F,E ;TAKE CARE OF THE COUNT
MOV #ADDSET,F ;ADD TO COUNT OF SET ADDRESS
BR MFFEN3
MFESKG: MOVB (B)+,D ;GET THE AMOUNT TO SKIP
MOV D,F ;COPY IT
BIC #177770,F ;GET THE COUNT
ADD F,E
ASH #-3,D ;THE HIGH 3 BITS OF THE 6
BIC #177770,D ;AR ETHE SKIP
ADD D,E
MOV #ADDSKG,F ;ADD TO GET SKIP TYPE
BR MFFEN3
MFFEN8: SUB A,MFENDP(A) ;MAKE IT RELATIVE TO BEGGINING
MOV F,MFENDT(A) ;TYPE DISPATCH FOR END
MOV E,MFENDB(A) ;BLOCK FOR END
JMP ACRET
.STITL RANDOM CAPABILITY ROUTINES
CAPRMS:
CAPRSP: MOVB 1(P),B ;GET FUNCTION
CMP B,#SPIHGH ;TOO HIGH?
ERRORC HIS,BFUN ;YUP
ASL B ;INDEX
JMP @SPITAB(B) ;GO DO IT
SPPTP: MOV A,F ;COPY POINTER TO THE SPHERE CAPABILITY
MOV 2(P),B ;THE PROCESS CAPABILITY POINTER
MOV ITM1A,A ;POINTER TO THE SPHERE IN THE MAP
JSR PC,GCLSTA ;FIND THE C-LIST
BEQ CPRSP1 ;COULDN'T FIND IT
ADD B,A ;POINT TO THE CAPABILITY DIRECTLY
CMP 2(A),ITEM0 ;IS IT THIS CURRENT PROCESS
BEQ CPRSP1 ;CAN'T DO IT.
BIT #.SPCAD,(F) ;CAN I ADD TO THE SPHERE
BEQ CPRSP2 ;NOPE
BIT #.PRWRA,(A) ;CAN I MOVE THIS PROCESS
BEQ CPRSP2 ;NOPE
MOV 2(A),A ;GET THE PROCESS NO.
MOV 2(F),B ;THE SPHERE NO.
JSR PC,PUTPRS ;PUT THE PROCESS INTO THAT SPHERE
BEQ CPRSP1 ;FAILED, MUST BE RUNNING OR TO MANY PROCESSES
CAPRS3: ADD #6,P ;POP THE OTHER ARGUMENTS
JMP ERETCZ ;DONE
CPRSP1: ERROR BCN ;BAD CAPABILITY NUMBER
CPRSP2: ERROR BAC ;BAD ACCESS
SPRCP: CLR F ;WHERE TO PUT WHAT FROM THERE
MOV 2(P),B ;THE C-LIST NUMBER TO INVESTIGATE
BIT #177400,B ;ANY BIT NUMBERS?
BNE CPRSP1 ;WELL NO CAPABILITY THERE
MOV 2(A),A ;THE SPHERE TO READ FROM
JSR PC,ITM1PL ;LOAD IT UP
MOV ITM1A,A ;THE PLACE TO INVESTIGATE IT AT
JSR PC,GCLSTA ;GET THE C-LIST ENTRY
BEQ CAPRS4 ;FAILED
ADD A,B ;POINT TO IT
MOVB (B),F ;COPY IT
BGE CAPRS2 ;THERE IS CAPABILITY THERE
CAPRS4: CLR F
CAPRS2: MOV F,B
JSR PC,GIVPSW ;GIVE HIM THE CAPABILITY
JSR PC,ITM1PO
BR CAPRS3
;STOP ALL PROCESSES EXCEPT ME
SPSTP: MOV #SPRSTP,F
BR SPKIL1
;START ALL PROCESSES
SPSTR: MOV #SPRSTR,F
BR SPKIL1
;KILL ALL PROCESSES EXCEPT ME
SPKIL: MOV #SPRKIL,F
SPKIL1: MOV 2(A),C ;SPHERE INDEX
JSR PC,(F) ;KILL THEM
BR CAPRS3 ;RETURN
;GET NUMBER OF PROCESSES IN A SPHERE
SPGNP: MOV 2(A),A ;SPHERE
JSR PC,ITM2LD ;LOAD IT
MOV SPHPRC(A),B ;NUMBER OF PROCESSES
JSR PC,GIVPSW ;PASS TO USER
BR CAPRS3
;GET PC AND PROCESS ID OF PROCESS #
SPPGT: JSR PC,GETFPR ;LOAD FIRST PROCESS INTO ITEM2
MOV 2(P),B ;THE PROCESS TO GET
BEQ SPPGT1 ;GOT THE ONE WE WANT LOADED
SPPGT2: MOV PSPHCP(A),A ;NEXT PROCESS
ERRORC LE,BAD ;NO SUCH THING
JSR PC,ITM2LD ;LOAD IT
SOB B,SPPGT2 ;TILL WE GET TO THE DESIRED ONE
SPPGT1: MOV PUPC(A),B ;THE GUY'S PC
JSR PC,GIVPSW ;RETURN IT
MOV PRSID1(A),B ;ID WORD ONE
JSR PC,GIVPSW ;RETURN
MOV PRSID2(A),B ;ID WORD TWO
JSR PC,GIVPSW
BR CAPRS3 ;RETURN
;GET A CAPABILITY TO A PROCESS IN THE SPHERE
SPGPC: JSR PC,GETFPR ;LAOD FIRST PROCESS INTO ITEM2
MOV ITEM1,C ;BEING CREATED IN EXECUTING SPHERE
MOV #-1,B ;CREATE IN FIRST FREE SLOT
JSR PC,CRCLST ;TRY TO CREATE
ERRORC CS,CLF ;C-LIST FULL
ADD ITM1A,A ;POINT AT ENTRY IN C LIST
MOV A,C ;SAVE THAT
MOV ITM2A,A ;POINT AT FIRST PROCESS
SPGPC1: CMP 4(P),PRSID1(A) ;SAME ID WORD 1?
BNE SPGPC2 ;NOPE
CMP 2(P),PRSID2(A) ;SAME ID WORD 2?
BEQ SPGPC3 ;YES, THSI IS THE ONE
SPGPC2: MOV PSPHCP(A),A ;NEXT PROCESS
ERRORC LE,BAD ;NO SUCH PROCESS
JSR PC,ITM2LD ;LOAD IT
BR SPGPC1 ;TRY AGAIN
SPGPC3: INC PRSREF(A) ;ONE MORE REFERENCE
MOV #.PRCAP!.PRWRA,(C) ;A PROCESS CAP
MOV ITEM2,2(C) ;THE ITEM FOR THE CAP
JSR PC,GIVPSW
JMP CAPRS3 ;RETURN
;SET THE ENTER ADDRESS
SPENT: CMPB (A),#.MSCAP ;MASTER SPHERE CAPABILITY
ERRORC NE,BCT ;BAD CAP TYPE
MOV 2(P),B ;GET THE ARGUMENT
BIT #1,B ;ODD
ERRORC NE,BAD ;BETTER NOT BE
MOV B,6(A) ;SET IN THE ENTER ADDRESS
BIC #.SPFES,(A) ;ALLOW ENTERS
JMP CAPRS3 ;DONE
;LOAD THE FIRST PROCESS IN THE SPHERE INTO ITEM2
GETFPR: MOV 2(A),A ;THE SPHERE
JSR PC,ITM2LD ;LAOD IT
MOV SPHPRP(A),A ;THE ZEROTH PROCESS
ERRORC LE,BAD ;THERE ISN'T ONE!
JMP ITM2LD ;LOAD THAT
.IFZ MBFLG
SPSTY:SPSTX:SPSMC: ERROR RNA ;NO MB11 ON THIS MACHINE!
.IFF
SPSTX: MOV #SPMBHX,F ;POINT TO X PART
BR SPSTY1 ;AND DO SAME AS Y
SPSTY: MOV #SPMBHY,F ;POINT TO Y PART
SPSTY1: MOV 2(A),A ;GET THE SPHERE ITEM
JSR PC,ITM2LD ;LOAD IT
MOV 4(P),B ;GET WORD WITH CONTROL BITS
MOV 2(P),C ;GET WORD WITH ADDRESS
BIT #177763,B ;ANYTHING OTHER THAN READ AND/OR WRITE TRAP SET?
ERRORC NE,BAD
BIT #1,C ;ODD ADDRESS TRAP ON?
ERRORC NE,BAD ;CAN'T DO THAT!
ADD A,F ;POINT INTO SPHERE AT RIGHT PLACE
SAVE <(F),2(F)> ;SAVE OLD VALUES
MOV B,(F) ;TRAP BITS
MOV C,2(F) ;ADDRESS
JSR PC,SPTRTS ;TEST THAT TRAP IS OK
BNE SPSTY2 ;YUP, WIN
REST <2(F),(F)> ;RESTORE OLD VALUES
ERROR BAD ;AND EXIT
SPSTY2: CMP (P)+,(P)+
JMP CAPRS3 ;EXIT WINNINGLY
;TEST THAT WE HAVE A CONSISTENT SET OF TESTS, NAMELY, THAT
;WE DON'T HAVE AN X<A<Y TEST THAT CROSSES A PAGE BOUNDARY
SPTRTS: BIT #MBXAYR!MBXAYW,SPMBCN(A) ;X<A<Y TRAP SET?
BEQ SPTRT1 ;NO, CAN'T LOSE
MOV SPMBLY(A),E ;GET Y REGISTER
CMP E,SPMBLX(A) ;IS Y>X?
BLO SPTRT2 ;NOPE, LOSER
BIC #17777,E ;CLEAR ALL BUT PAGE BITS
SUB SPMBLX(A),E
BEQ SPTRT1 ;THAT'S OK
COM E
BIT #170000,E
BNE SPTRT2 ;THAT'S NOT!
SPTRT1: CLZ
RTS PC
SPTRT2: SEZ
RTS PC
;SET MB11 CONTROL REGISTER
SPSMC: MOV 2(A),A
JSR PC,ITM2LD ;LOAD THE SPHERE UP
MOV 2(P),B ;GET THE ARG
BIT #176267,B ;THE USER DOESN'T GET TO HACK
;UNUSED BITS 170060
;NO INIT=4000, INT ON ALMOST OVERFLOW=2000
;DONE=200, LOW 3 FREEZE BITS=7
ERRORC NE,BAD
SAVE SPMBCN(A)
JSR PC,SPTRTS ;TEST THAT THIS TRAP IS A WIN
BNE SPSMC1 ;YUP
REST SPMBCN(A) ;RESTORE OLD TRAP
ERROR BAD
SPSMC1: TST (P)+
JMP CAPRS3 ;WIN, RETURN
.ENDC
CAPRQU: ERROR BFUN
CAPRCL: TST (P)+ ;GET RID OF FIRST ARGUMENT
MOV A,F ;COPY POINTER TO CAPABILITY
REST D ;IF < 0 GRAB CONSUMER, ELSE RELEASE IT
BMI CAPCL2 ;TRY TO GRAB IN
BIT #.CLCONS,(F) ;IS HE THE CONSUMER
BEQ CAPCL1 ;NO, RETURN SUCCESSFUL
MOV 2(F),A ;THE POINTER TO THE CL
JSR PC,ITM2LD ;LOAD IT UP
CLR CLCONP(A) ;CLEAR THE CONSUMER POINTER
BIC #.CLCONS,(F) ;CLEAR THE CONSUMER BIT
CAPCL1: TST (P)+ ;POP OFF OTHER ARG
JMP ERETCZ ;RETURN SUCESSFULP
CAPCL2: BIT #.CLCONS,(F) ;AM I THE CONSUMER ALREADY
BNE CAPCL1 ;YES, WIN
MOV 2(F),A ;THE POINTER TO THE CL
JSR PC,ITM2LD ;LOAD IT UP
TST CLCONP(A) ;IS SOME ONE ELSE CONSUMER
ERRORC NE,RNA ;YES, RESOURCE NOT AVAILABLE
MOV ITEM0,CLCONP(A) ;SAY I AM THE CONSUMER
BIS #.CLCONS,(F) ;SET THE BIT THAT SAYS SO
BR CAPCL1 ;RETURN SUCCESSFULL
;THIS CALL USES THE SAME CONVENTIONS ON READ/WRITE SELECT AS CAPRPR (40 BIT MEANS
;WRITE, CLEAR MEANS READ) IF WRITE, 40 => MOV,41 => BIS,42 => BIC.
CAPRTT: MOVB 1(P),B ;THE FUNCTION
MOV B,C ;COPY IT
BIC #40,B ;CLEAR THE WRITE BIT
CMP B,#NTTFNC ;IS IT LEAGL
ERRORC HI,BFUN ;BAD FUNCTION TYPE
CAPRT4: TST (P)+
MOV 2(A),A ;THE TTY ITEM
JSR PC,ITM2LD ;LOAD IT UP
CAPRT3: CMP ITEM1,TTITM(A) ;DO I OWN THE TTY
BEQ CAPRT1 ;YES
CAPRT2: JSR PC,LFLUSH ;WAIT FOR IT
MOV ITM2A,A ;POINT TO THE TTY
CMP ITEM1,TTITM(A) ;DO I OWN IT NOW
BNE CAPRT2 ;NO
JSR PC,RUNME ;LETS GO
BR CAPRT3 ;MAKE SURE
CAPRT1: ASL B ;CONVERT FUNCTION NUMBER TO WORD OFFSET
JMP @TTIVTB(B) ;DISPATCH TO TTY INVOKE FUNCTION
CAPRT5: TST (P)+ ;FLUSH THIRD ARG
JMP ERETCZ ;RETURN SUCESS FUL
;THIS SUBROUTINE CAN BE CALLED TO FORCE THE INVOK TO WAIT UNTIL THE
;OUTPUT BUFFER IS EMPTY
TOWAIT: TST TOQN(A) ;IS THERE ANYTHING IN OUTPUT QUE?
BEQ TOWAI2 ;NO
TOWAI1: JSR PC,LFLUSH ;GO AWAY FOR A WHILE
TST TOQN(A) ;IS THE QUE EMPTY YET?
BNE TOWAI1 ;NO, WAIT SOME MORE
JSR PC,RUNME ;GO AHEAD
BR TOWAIT ;MAKE SURE
TOWAI2: RTS PC
;RESET THE TTY'S IF WANTED
TTRST: BIT #TORST,2(P) ;RESET OUTPUT?
BEQ TTRST1 ;NO
BIC #TORST,2(P) ;TURN THE BIT OFF
SAVE PS
SPL 7
MOV TTLTTY(A),E ;THE LOGICAL TTY NUMBER
JSR PC,TYORT ;RESET OUTPUT
REST PS
TTRST1: BIT #TIRST,2(P) ;RESET INPUT?
BEQ TTRST2 ;NO
BIC #TIRST,2(P)
SAVE PS
SPL 7
JSR PC,TYIRT1 ;RESET INPUT QUE
JSR PC,TYBRT ;RESET INPUT BUFFER
REST PS
TTRST2: RTS PC
;MISCELLANEOUS TTY INVOKES
TTMOV: JSR PC,TTRST ;RESET TTY'S IF DESIRED
JSR PC,TOWAIT ;WAIT FOR BUFFER TO CLEAR
REST TTYST1(A) ;DO A MOVE INTO THE TTYST1 WORD
BR CAPRT5
TTBIS: JSR PC,TTRST ;RESET TTY'S IF DESIRED
JSR PC,TOWAIT ;WAIT FOR BUFFER TO CLEAR
BIS (P)+,TTYST1(A) ;DO A BIS ON THE WORD
BR CAPRT5
TTBIC: JSR PC,TOWAIT ;WAIT FOR BUFFER TO CLEAR
BIC (P)+,TTYST1(A) ;DO A BIC ON THE STATUS WORD
BR CAPRT5
TTBS2: JSR PC,TOWAIT ;WAIT FOR BUFFER TO CLEAR
BIS (P)+,TTYST2(A) ;SET BITS IN TTYST2
BR CAPRT5
TTBC2: JSR PC,TOWAIT ;WAIT FOR BUFFER TO CLEAR
BIC (P)+,TTYST2(A) ;CLEAR BITS IN TTYST2
BR CAPRT5
TTRD: JSR PC,TOWAIT ;WAIT FOR BUFFER TO CLEAR
MOV TTYST1(A),B ;GET THE WORD
BR TTCNO1 ;GIVE HIM THE WORD AND RETURN
TTCNO: JSR PC,TOWAIT ;WAIT FOR BUFFER TO CLEAR
MOV CHARNO(A),B ;GET THE WORD
TTCNO1: ADD #4,P
JSR PC,GIVPSW ;GIVE IT TO HIM
JMP ERETCZ ;SUCCESSFUL RETURN
TTMV2: JSR PC,TOWAIT ;WAIT FOR BUFFER TO CLEAR
REST TTYST2(A) ;SET TTYST2
BR CAPRT5
TTTYP: MOV TTLTTY(A),E ;THE LOGICAL TTY NO.
MOV TTYTBL(E),B ;THE INFO ABOUT WHAT KIND OF TTY IT IS
BR TTCNO1 ;RETURN IT TO THE USER
TTPEK: TST TIBN(A) ;ANY CHARACTERS?
BEQ TTPEK1 ;NO
MOV TIBO(A),B ;GET POINTER TO THE STUFF
ADD A,B ;MAKE IT UNRELATIVE
MOVB (B),B ;GET THE BYTE
BIC #177400,B ;CLEAR THE TOP BYTE
BR TTCNO1 ;RETURN THE VALUE
TTPEK1: MOV #-1,B ;RETURN -1
BR TTCNO1 ;AND GO RETURN IT
TTSPD: MOV TTLTTY(A),E ;THE LOGICAL TTY NO.
BIT #DHF,TTYTBL(E) ;IS IT A DH11?
ERRORC EQ,BAD ;DONT KNOW WHAT TO CALL IT (ALMOST RNA)
TTSPD1: SPL 5 ;STOP IT FROM CHANGING
BIT #TOTRAN,TTYST1(A) ;IS IT TRANSMITTING?
BEQ TTSPD3 ;NO, WE CAN MUNG IT
TTSPD2: SPL 0 ;LOWER PRIORITY
JSR PC,SFLUSH ;WAIT FOR A SHORT TIME
SPL 5
BIT #TOTRAN,TTYST1(A) ;TRANSMITTING?
BNE TTSPD2 ;YES
SPL 0
JSR PC,RUNME ;IT HAS STOPPED FOR A WHILE
BR TTSPD1 ;NOW TRY TO CHANGE THE SPEED
TTSPD3: SUB #NFDHTY,E ;GET THE DH LINE NO.
ASR E ;INTO A NUMBER
BIC #17,DH0SCR ;CLEAR THE LINE NO.
BIS E,DH0SCR ;SET IN THE NEW ONE
REST DH0LPR ;GET THE SPEED
SPL 0 ;BACK TO LOW LEVEL
TST (P)+ ;POP OFF EXTRA ARGUMENTS
JMP ERETCZ ;AND RETURN
TBRAK: REST TTBRKL(A) ;SET UP COUNT FOR THE BREAK
JSR PC,TOCINT ;CAUSE OUTPUT INTERRUPT
TST (P)+ ;POP OFF ARGUMENT
JMP ERETCZ ;RETURN
;SET LINE LENGTH
TTSLNL: REST LINEL(A)
JMP CAPRT5
;THIS TTY INVOK CAN BE USED TO IMPLEMENT CONTROL Z TYPE BREAKS. THE IDEA
;IS THAT THE USER JOB HAS A PROCESS WHICH SIMPLY MAKES THIS CALL TO CHECK
;FOR ONE OF THE BREAK CHARS. THE PROCESS HANGS UNTIL THE CALL SUCCEEDS
;WHICH DEPENDS ON THE ARGUMENT TO THE CALL. TWO CONDITIONS CAN MAKE THE
;CALL SUCCEED WHICH CORRESPOND TO THE TWO ARUGMENTS TO THE CALL. THE
;FIRST ARGUMENT IS A PAIR OF BYTES. IF ANY OF THE TYPED IN CHARS HAPPENS
;TO EQUAL ONE OF THESE BYTES THEN THE CALL SUCCEEDS. THE SECOND ARG IS
;A NUMBER SUCH THAT IF ANY OF THE TYPED IN CHARS IS LESS THAN THIS NUMBER
;THEN THE CALL ALSO SUCCEEDS. A TYPICAL NUMBER MIGHT BE 40, IN WHICH CASE,
;THE CALL WOULD SUCCEED ANY TIME A CONTROL CHAR WAS TYPED. THE ACTUAL CHAR
;TYPED IS RETURNED ON THE USER'S STACK. NOTE TWO INHERENT BUGS IN THIS CODE:
;FIRST, SINCE THE LAST CHAR IS CHECKED AT LONG-FLUSHED FREQUENCEY, A CHAR
;COULD POTENTIALLY GO BY WITHOUT BEING CHECKED, EG THE USER IS TYPING VERY FAST.
;SECOND, IF TWO PROCESSES MAKE THIS CALL, THEN THE FIRST ONE TO SUCCEED WILL
;CLEAR THE LAST CHAR WORD, SO THAT THE OTHER CANNOT SUCCEED.
TTBRK: REST B ;SECOND ARG IS A PAIR OF CHARS TO CHECK FOR
MOV B,C ;MAKE A COPY
SWAB C ;GET THE HIGH BYTE CHAR
BIC #177600,B ;CLEAN OFF THE CRUFT
BIC #177600,C ;AGAIN
REST E ;THIRD ARG IS THE NUMBER
JSR PC,TTBCHK ;SHOULD WE BREAK HERE?
BEQ TTBRK2 ;NO
TTBRK1: JSR PC,GIVPSW ;TTBCHK RETURNS VALUE IN B
JMP ERETCZ ;SUCCEED
TTBRK2: JSR PC,LFLUSH ;GO AWAY FOR A WHILE
JSR PC,TTBCHK ;SHOULD WE BREAK HERE
BEQ TTBRK2 ;NO
TTBRK3: JSR PC,RUNME ;AS IT SAYS...
BR TTBRK1 ;RESTART TO MAKE SURE
;THIS SUBROUTINE CHECKS IF THE BREAK PROCESS SHOULD BE RELEASED FOR ANY
;REASON AND SETS UP THE CHAR TO RETURN TO THE USER IS IT SHOULD. IT CLEARS
;Z IF THE BREAK SHOULD COMPLETE. EXPECTS CHECK CHARS IN B AND C, AND THE
;CHECK NUMBER IN E, LOW BYTE, FLAGS IN HIGH BYTE.
TTBCHK: MOV TLAST(A),F ;GET THE LAST CHAR TYPED
BEQ TTBCH0 ;JUST CHECK FOR MORE BREAK
CLR TLAST(A) ;SO WE DON'T GET THIS AGAIN
CMPB F,B ;IS IT ONE OF THE BYTES TO CHECK FOR?
BEQ TTBCH1 ;YES
CMPB F,C ;HOW ABOUT THE OTHER CHAR?
BEQ TTBCH1 ;YUP
CMPB F,E ;IS IT PERHAPS LESS THAN THE NUMBER?
BLT TTBCH1 ;YES
TTBCH0: BIT #.TTMBK,E ;DOES HE WANT TO DO MORE BREAKS?
BEQ TTBCH3 ;NO
BIT #.TMORM,TTYST1(A) ;IS MORE PROCESSING ENABLED?
BEQ TTBCH3 ;NO, HANG AROUND FOR A WHILE
BIT #.TMORF,TTYST1(A) ;IS MORE TRIGGERED?
BEQ TTBCH3 ;NO, HANG AROUND
MOV #.TTMBK,B ;TELL THE CALLER THIS IS A MORE BREAK
BR TTBCH2
TTBCH1: MOV F,B ;GET THE CHAR
BIC #177400,B ;CLEAR THE HIGH BYTE
BIS #.TTIBK,B ;TELL HIM THIS IS AN INPUT BREAK
CLR TLAST(A) ;FLUSH THE OLD LAST CHAR
TTBCH2: CLZ ;SUCCEED
RTS PC
TTBCH3: SEZ ;FAIL
RTS PC
.IFNZ NTVS
;TV INVOKES WHICH ARE ACTUALLY INVOKES OF TTY CAPABILITY
;TVATC ATTACHES A TV DISPLAY TO A TTY AND KEYBOARD. THE SECOND
;ARGUMENT TO THE INVOKE IS THE CAPABILITY INDEX OF THE DISPLAY.
TVATC: REST B ;GET THE DISPLAY CAPABILITY NUMBER
MOV #ITM1AD,A ;GET THE SPHERE ADDRESS IN B
JSR PC,GCLSTA ;GET THE OFFSET OF THE CAPABILITY INTO SPHERE
ERRORC EQ,BCN ;BAD C-LIST NUMBER
ADD B,A ;GCLSTA RETURNS THE OFFSET IN B
CMPB (A),#.DSCAP ;MAKE SURE ITS A DISPLAY CAP
MOV CLSEM0(A),B ;GET THE NUMBER OF THIS DISPLAY
ASR B ;CONVERT FROM WORD OFFSET TO NUMBER
SUB #NFTVDS,B ;MAKE SURE IT'S A TV DISPLAY
ERRORC LT,BAD ;NOPE
CMP B,#NTVS ;IN CASE THE CAP IS SCREWED UP
BUGC GE
MOV #ITM2AD,A ;ADDRESS OF THE TTY ITEM
MOVB TVDSBF(B),C ;GET THE BUFFER NUMBER OF THIS DISPLAY
BUGC LT ;IT HAD BETTER HAVE A BUFFER ASSIGNED
CMP C,#NTVCHN ;IN CASE IT'S SCREWED UP
BUGC GE
BIS #TVIOR,C ;START IN CURSOR IOR MODE
MOV C,TVBUF(A) ;GIVE THIS TV TTY A BUFFER
INCB TVDSRF(B) ;ONE MORE THING IS REFERENCING THIS BUFFER
MOV TTLTTY(A),B ;GET THE LOGICAL TTY NUMBER
MOVB #-TVBLTM,TVBLNK(B) ;TURN ON THE CURSOR FOR THIS TV
ADD #2,P ;POP THE THIRD ARG
JMP ERETCZ ;SUCCEED
;THE FOLLOWING INVOKE CAN BE USED TO CLEAR AND GENERALLY RESET THE SCREEN
TVCL: JSR PC,TOWAIT ;WAIT UNTIL THE OUTPUT BUFFER CLEARS
SAVE PS
SPL 7 ;TEMPORARILY
JSR PC,TVINIT ;INITIALIZE TV VARIABLES, PUSH THE FONT IN ITEM 1
BEQ TVCL1 ;IN CASE TVINIT FAILS
JSR PC,TVCS ;CLEAR THE SCREEN
CLR CHARNO(A) ;CURSOR IN POSITION 0. NOTE A SET UP BY TVINIT
CLR LINENO(A) ;CLEAR THE LINE NUMBER
JSR PC,ITM1PO ;POP THE FONT ITEM, SET UP BY TVINIT
REST PS ;BACK TO NORMAL PRIORITY
ADD #4,P ;CLEAN OFF THE ARGUMENTS
JMP ERETCZ ;SUCCEED
TVCL1: REST PS ;BACK TO NORMAL PRIORITY
ERROR BAD ;BAD, NOT TV
;THIS INVOK IS USED FOR REVERSING WHITE AND BLACK ON SCREEN
TVREV: SAVE PS
SPL 7
JSR PC,TVINIT ;INITIALIZE THE TV VARIABLES
BEQ TVREV1 ;IN CASE TVINIT FAILS
JSR PC,REVSCR ;DO THE REVERSE
JSR PC,ITM1PO ;POP THE FONT ITEM SET UP BY TVINIT
REST PS
ADD #4,P ;CLEAN UP
JMP ERETCZ ;SUCCEED
TVREV1: REST PS
ERROR BAD ;NOT A TV
;CHANGE THE FONT OF A TV
TVFNT: JSR PC,TOWAIT ;WAIT UNTIL THE BUFFER CLEARS
REST B ;THE NUMBER OF THE FONT THAT HE WANTS
BLT TVFNT1 ;ERROR, NO NEGATIVE FONT NUMBERS
CMP B,#NFONTS ;IS IT GREATER THAN THE NUMBER OF FONTS?
BGE TVFNT1 ;YES, ERROR
ASL B ;CONVERT TO WORD INDEX
MOV FNTITM(B),A ;GET THE FONT ITEM FOR THIS FONT
BLE TVFNT1 ;NONE
JSR PC,ITM1PL ;LOAD IT UP
MOV ITM2A,C ;ADDRESS OF THE TTY ITEM
MOV FNHIGH(A),D ;NUMBER OF LINES IN A CHAR
DEC D ;THIS IS USED FOR LOADING TVWC BY BLINK ETC
NEG D ;ALLOW 1 FOR LOADING TVRWIN. TVWC EXPECTS NEGATIVE COUNT.
MOV D,TVLCNT(C) ;LINES IN CHAR MINUS ONE
MOV FNLINE(A),TVHIGH(C) ;NUMBER OF CHAR LINES ON THE SCREEN
MOV FNLINL(A),LINEL(C) ;NUMBER OF CHARS PER LINE
MOV FNLSC(A),TVNLSC(C) ;NUMBER OF LINES TO SCROLL
JSR PC,ITM1PO ;POP THE FONT ITEM
MOV B,TVFONT(C) ;SET IN THE NUMBER FOR THIS FONT
MOV C,A ;COPY TTY ITEM ADDRESS
CLR -(P) ;PUSH A DUMMY ARGUMENT
JMP TVCL ;AND DO A CLEAR SCREEN BEFOR RETURNING
TVFNT1: ERROR BAD ;BAD ARGUMENTS
TVSET: JSR PC,TOWAIT ;WAIT FOR BUFFER TO CLEAR
BIT #40,C ;DOES HE WANT READ?
BNE TVSET1 ;NO WRITE
MOV TVCUR(A),B ;THE CHAR POSITION ON LINE
JSR PC,GIVPSW ;GIVE IT TO HIM
MOV TVLINE(A),B ;THE LINE NUMBER OF CURSOR
JSR PC,GIVPSW ;GIVE IT TO HIM
ADD #4,P ;POP THE ARGS
JMP ERETCZ ;SUCCEED
TVSET1: REST <C,D> ;TVLINE AND TVCUR
CMP C,TVHIGH(A) ;MAKE SURE IT'S LEGAL
BGE TVSET2 ;TOO HIGH
CMP D,LINEL(A) ;LENGTH OF A LINE
BGE TVSET2 ;CANNOT PUT IT THERE
SAVE PS
SPL 7 ;SO THE CURSOR WILL NOT GET CONFUSED
MOV C,TVLINE(A) ;SET THE TVLINE
MOV D,TVCUR(A) ;AND THE CHAR NO.
JSR PC,TVINIT ;LOAD UP FONT ITM ETC
BEQ TVSET3 ;IN CASE INIT FAILS
JSR PC,RSCUR ;RESET THE VARIABLES
JSR PC,ITM1PO ;POP THE FONT ITEM
REST PS ;BACK TO NORMAL PRIORITY
JMP ERETCZ ;SUCCEED
TVSET3: REST PS ;BACK TO NORMAL PRIORITY
TVSET2: ERROR BAD ;BAD ARGUMENTS
.ENDC
.IFNZ NTVS
TVOFF: JSR PC,TOWAIT ;WAIT UNTIL BUFFER CLEARS
BIT #.PRWRT,C ;DOES HE WANT TO READ OR WRITE
BNE TVOFF1 ;WRITE
MOV TVOFFL(A),B ;GET TVOFFL
JSR PC,GIVPSW ;RETURN IT TO USER
ADD #4,P ;POP THE ARGUMENTS
JMP ERETCZ ;SUCCEED
TVOFF1: MOV (P),TVOFFL(A) ;FIRST ARG GOES INTO TVOFFLE
JMP TVCL ;NOW CLEAR THE SCREEN BEFORE RETURNING
.ENDC
;RETURN THE WIDTH OF CHAR AND TV LINES PER CHAR LINE FOR CURRENT FONT
TVRFN:
.IFNZ NTVS
ADD #4,P ;NO ARGUMENTS
JSR PC,TVINIT ;LOAD UP THE FONT
ERRORC EQ,BAD ;BAD ARGUMENTS
MOV FNWIDE(B),E ;WIDTH OF A CHAR
MOV FNTLCL(B),F ;NUMBER OF TV LINES IN 1 CHAR LINE
JSR PC,ITM1PO ;POP THE FONT ITEM
MOV E,B
JSR PC,GIVPSW ;RETURN THE WIDTH
MOV F,B
JSR PC,GIVPSW ;RETURN THE HEIGHT
JMP ERETCZ ;SUCCEED
TVMOD: JSR PC,TOWAIT ;WAIT FOR THE BUFFER TO EMPTY
REST B ;GET THE NUMBER
BNE 1$ ;THERE IS A FUNCTION
2$: ERROR BAD ;BAD ARG
1$: CMP B,#.TVMOV ;IS IT A MOVE FUNCTINO
BHI 2$ ;BAD FUNCTION
ASH #6,B ;SHIFT IT TO RIGHT POSITION
MOV TVBUF(A),C ;GET THE BUFFER NUMBER
BIC #TVMOV,C ;CLEAR OUT THE OLD FUNCTION
BIS B,C ;IN WITH THE NEW FUNCTION
MOV C,TVBUF(A) ;PUT IT AWAY
TST (P)+ ;BYE TO THE THIRRD ARG
JMP ERETCZ
.IFF
ERROR+BFUN
.ENDC
CAPRDS: .IFZ NTKDIS+NTVS
BPT
.IFF
BITB #100,1(P) ;IS THIS AN OLD STYLE DISPLAY?
BNE CAPRD5 ;NO
.ENDC
CAPRD3: .IFZ NTKDIS
BPT
.IFF
TST (A) ;IS THIS AN OLD DISPLAY?
ERRORC LT,BCT ;NEW ONE
SAVE <A> ;POINTER TO CAP
MOV TKDPDL,A ;THE PDLS ETC
JSR PC,ITM2PL ;LOAD THEM TOO
REST <A,D>
SWAB D ;GET THE FUNCTION
TSTB D
BEQ CAPRD1 ;GO START THE DISPLAY
CMPB #1,D ;IS IT ONE?
BEQ CAPRD2 ;YES, STOP THE DISPLAY
ADD #4,P
JSR PC,ITM2PO
JMP BADEMT ;NAUGHTY!
CAPRD2: JSR PC,TKDSP ;STOP IT
CAPRD4: ADD #4,P
JSR PC,ITM2PO
JMP ERETCZ ;WIN
CAPRD1: JSR PC,TKDSP ;MAKE SURE IT IS STOPPED
ASL C
BIC #177760,C ;CONVERT DISPLAY NUMBER TO AN INDEX
ADD ITM2A,C ;POINT TO THE FIRST WORD EXECUTED FOR THIS DISPLAY
MOV (P),A ;THE START ADDRESS
BIS #DPUSHJ,A ;IT IS A PUSHJ
MOV A,(C)
BIC #100000,TKDRUN(D) ;START IT ON INT LEVEL
BR CAPRD4
.ENDC
;TV DISPLAY INVOKES. THESE ARE CALLED WITH A NEGATIVE
;FUNCTION NUMBERS.
CAPRD5: .IFZ NTVS
BPT
.IFF
MOV CLSEM0(A),C ;GET LOGICAL DISPLAY NUMBER
BGE 1$
MOVB C,E
BR 2$
1$: ASR C ;TV DISPLAYS USE BYTE DATA
SUB #NFTVDS,C ;GET THE TV NUMBER
BLT CAPRD6 ;IT'S A TK DISPLAY!!!
CMP C,#NTVS ;MAKE SURE IT'S LEGAL
BUGC GE ;TOO BIG
MOVB TVDSBF(C),E ;GET THE BUFFER OF THIS TV
2$: ASL E ;FOR NOW, WORD OFFSET
MOVB 1(P),B ;THE FUNCTION HE WANTS
TST (P)+ ;POP THE FIRST ARG
REST <C,D> ;THE OTHER TWO ARGS
BIC #100,B ;MAKE INTO SMALL INTEGER
CMP B,#TVDSIM ;IS IT A LEGAL FUNCTION?
BGE CAPRD6 ;NO!
ASL B ;OK, SO MAKE INTO WORD OFFSET
JSR PC,@TVDSIT(B) ;NOW EXECUTE THE FUNCTION
BEQ CAPRD6 ;IN CASE SOMETHING WENT WRONG
JMP ERETCZ ;EVERTHING'S OK, WE'RE DONE
CAPRD6: ERROR BFUN ;BAD FUNCTION
;READ THE CURSOR (OR TURTLE) POSITION
TVDSRC: MOV TVDSCX(E),B ;THE X POSITION
JSR PC,GIVPSW ;GIVE IT TO HIM
MOV TVDSCY(E),B ;THE Y POSITION
JSR PC,GIVPSW ;LAY IT ON HIM
CLZ ;SUCCEED
RTS PC
;SET THE CURSOR POSITION
;TVDSSC CHECKS THE NEW CURSOR POSITION AND UPDATES IT IF IT'S LEGAL
TVDSSC: TST C ;MAKE SURE IT'S POSITIVE
BLT TVDSS1 ;BAD
CMP C,#455. ;IS IT TOO HIGH?
BGE TVDSS1 ;YES
TST D ;THIS ALSO CANNOT BE NEGATIVE
BLT TVDSS1 ;BAD
CMP D,#576. ;IT X TOO HIGH?
BGE TVDSS1 ;YES!
MOV C,TVDSCY(E) ;THE NEW Y
MOV D,TVDSCX(E) ;AND THE NEW X
CLZ ;OK
RTS PC
TVDSS1: SEZ ;SOMETHING WENT WRONG
RTS PC
;TVDSNL DRAWS A LINE WITH THE PEN UP. IE, IT SETS THE CURSOR
;TO A RELATIVE POSITION JUST LIKE THE REAL LINE DRAWERS
TVDSNL: SAVE <C,D> ;GET SOME REGISTERS
MOV TVDSCY(E),A ;OLD Y POSITION
MOV TVDSCX(E),B ;OLD X POSITION
ADD A,C ;OLD X + DELTA X
ADD B,D ;OLD Y + DELTA Y
JSR PC,TVDSSC ;TRY TO UPDATE THE CURSOR
BEQ TVDSN1 ;SOMETHING WRONG WITH NEW POSITION
REST <D,C> ;PUT THE INCREMENTS BACK
CLZ ;SUCCEED
RTS PC
TVDSN1: ADD #4,P ;POP THE STUFF WE SAVED
SEZ ;FAIL
RTS PC
;TVDSIL IOR'S A LINE ON THE SCREEN
TVDSIL: JSR PC,TVDSNL ;UPDATE THE CURSOR
BEQ TVDSX2 ;SOMETHING WENT WRONG
ASR E ;GET THE TV BUFFER NUMBER
BIS #TVIOR,E ;IOR MODE
BR TVDSX1 ;DRAW THE LINE AND RETURN
;TVDSXL XOR'S A LINE ON THE SCREEN
TVDSXL: JSR PC,TVDSNL ;UPDATE THE CURSOR
BEQ TVDSX2 ;SOMETHING WRONG
ASR E ;GET THE BUFFER NUMBER
BIS #TVXOR,E ;XOR MODE
TVDSX1: JSR PC,DRAW ;DRAW THE LINE
CLZ ;SUCCEED
RTS PC
TVDSX2: SEZ ;FAIL
RTS PC
;TVDSCL CLEARS AN AREA OF THE SCREEN
TVDSCL: JSR PC,TVDSNL ;UPDATE THE CURSOR, CHECK BOUNDS
BEQ TVDSX2 ;FAIL
ASR E ;THE TV BUFFER NUMBER
JSR PC,SCRCLR ;CLEAR THE SCREEN
CLZ ;SUCCEED
RTS PC
.ENDC
TVSAVE:
.IFNZ NTVS
MOV ITM0A,B ;POINT TO PROCESS
BIT #PTVFLG,PFLAGS(B) ;ALREADY SAVING?
BNE TVSAV1 ;YUP
MOV #PRSLFP,A ;SIZE OF PROCESS WITH FLOATING POINT
MOV ITEM0,B ;THE ITEM INDEX OF THE PROCESS
JSR PC,EXITEM ;EXPAND THE PROCESS TO INCLUDE SPACE FOR FLOATING POINT AC'S
ERRORC EQ,NIS
MOV B,A
JSR PC,ITM0LD ;LOAD THE NEW PROCESS
BIS #PTVFLG,PFLAGS(A) ;INDICATE SAVING
ASR E ;CONVERT WORD OFFSET TO BUFFER NUMBER
MOVB E,TVSEL ;SET THE RIGHT VALUE INTO THE SELECT REGISTER
TVSAV1: CLZ
RTS PC
.IFF
ERROR BFUN
.ENDC
TVMAPS:
.IFNZ NTVS
JSR PC,SAVAWB ;SAVE ANY WRITTEN PAGES
MOV ITM0A,B ;POINTER TO PROCESS
MOVB C,PTVMAP(B) ;SET IT'S MAP WORD
JSR PC,MAPRE1 ;RELOAD MY MAP
JMP ERETCZ
.IFF
ERROR BFUN
.ENDC
.STITL CREATE CAPABILITY ROUTINES
GIVXX:
TAKXX:
CPYXX:
DELXX:
COPXX:
CAPRXX:
CCPRXX:
CCPRSP: ERROR BCT ;THE ZERO CAPABILITY
CPYCC:
CCPRCC: CLR B
MOV #.CCCAP,A ;THIS IS EASY
CCRTS: RTS PC
;CREATE A COLOR MAP CAP
CCPRCM: TST CMUSE ;ANYONE ELSE GOT IT?
ERRORC NE,RNA ;YES
CPYCM: INC CMUSE
CLR B ;NO ITEM
MOV #.CMCAP,A
RTS PC
;CREATE A MASTER SHPERE CAPABILITY
CCPRMS: JSR PC,CRSPHR ;CREATE THE ACTUAL SPHERE
BEQ CCRTS ;NO SPHERE AVAILABLE
MOV A,B ;THE ITEM NO OF THE SPHERE
MOV E,C ;ENTER ADDRESS IS 2ND ARG TO CALL
MOV #MSPCBT!.MSCAP,A ;THE TYPE AND FLAGS
RTS PC
;CREATE A PROCESS CAPABILITY
CCPRPR: JSR PC,CRPROC ;CREATE THE ACTUAL PROCESS
BEQ CCRTS ;NO PROCESS AVAILABLE
MOV A,B ;FOR THE LOCK ROUTINE
JSR PC,ITM0PL ;LOAD IT UP
MOV E,C ;GET THE STARTING ADRS FOR THE PROCESS
MOV C,PUPC(A) ;PUT THE STARTING ADRS. INTO ITS USER PC
JSR PC,ITM0PO ;GET BACK THE ORIGINAL PROCESS
MOV #.PRCAP!.PRWRA,A ;ITS A PROCESS CAPABILITY
RTS PC ;SUCCESS
CCPRTT: CMP E,#NTTYS ;IS IT A LEGAL TTY NO.
BGT CCPRT1 ;NOPE TO LARGE
ASL E ;TURN IT INTO THE WORD INDEX
TST TTYITM(E) ;IS THERE ALREADY A ITEM FOR THIS TTY
BGT CCPRT1 ;YES, THIS IS A BAD CALL THEN
BIT #MXEEF,TTYTBL(E) ;IS IT A MULTIPLEXOR?
BEQ CCPRT2 ;NO
SAVE E ;THE TTY NUMBER
MOVB TTYTBL(E),E ;GET THE NUMBER OF THE MULTIPLEXOR TTY
MOV TTYITM(E),A ;IS THERE A TTY FOR THE MULTIPLEXOR
BNE CCPRT3 ;YES, JUST CREATE THE MULTIPLEXEE
JSR PC,CRTTY ;CREATE THE TTY
BEQ CCPRT5 ;FAILED
;HERE PUT IN SOMETHING TO CLEAN UP IF IT LOSES
MOV B,A ;THE ITEM NO. OF MXOR
JSR PC,ITM2LD ;LOAD IT UP
ADD TOQI(A),A ;POINT TO START OF OUTPUT QUEUE
MOV #NFNLTY,D ;POINT TO PSEUDO TTYS
MOV #NNLTY,B ;NUMBER OF TTY'S TO CHECK
CCPRT7: CMPB TTYTBL(D),E ;IS IT THE MULTIPLEXOR?
BNE CCPRT8 ;NOT THIS ONE
MOVB D,(A)+ ;PUT IT INTO QUEUE
CCPRT8: TST (D)+ ;SKIP THIS TTY NEXT TIME
SOB B,CCPRT7
BR CCPRT6 ;NOW OPEN UP THE MULTIPLEXEE
CCPRT3: JSR PC,ITM2LD ;LOAD UP THE TTY
TST TTYU(A) ;IS IT REALLY OWNED OR JUST OPENED BY THE SYSTEM
BEQ CCPRT4 ;OPENED BY THE SYSTEM
CMP TTYU(A),CURUSR ;IS IT OPENED BY THE CURRENT USER
BNE CCPRT1 ;NO, SO HE LOSES ON THE OPEN
CCPRT4: INC TTYREF(A) ;INCREMENT ITS REFERENCE COUNT
CCPRT6: REST E ;GET BACK THE MULTIPLEXEE'S TTY NO.
CCPRT2: JSR PC,CRTTY ;CREATE THE TTY
BEQ CCPRT1 ;IT FAILED FOR SOME REASON
MOV #.TTCAP!.TTYI!.TTYO,A ;GIVE HIM I/O CAPABILITY
RTS PC
CCPRT5: TST (P)+
CCPRT1: SEZ
RTS PC
;CREATE A QUE CAPABILITY
CCPRQU: MOV E,C ;THE NUMBER OF PEOPLE WHO CAN LOCK THE QUE
JSR PC,CRQUE ;CREATE THE QUE
BEQ CCPRQ1 ;FAILED
CLR C ;NO DATA WORDS
MOV #.QUCAP,A ;THE TYPE
CCPRQ1: RTS PC
;CREATE A QUE ITEM, C CONTAINS THE NUMBER OF PEOPLE WHO CAN LOCK THE QUE
CRQUE: MOV #QUELEN,A ;LENGTH OF QUE
JSR PC,CRITEM ;CREATE THE ITEM
BEQ CRQUE2 ;FAILED
MOV B,A ;THE ITEM NO
JSR PC,ITM2PL ;LOAD TI
MOV #ITQUE,(A) ;SET THE TYPE
CLR QUECNT(A) ;NOONE ON THE QUE TO START
MOV C,QUENUM(A) ;THE NUMBER OF PEOPLE WHO CAN LOCK THE QUE
MOV #1,QUEREF(A) ;ASSUME THE GUY WHO CREATES IT IS GOING TO REFERENCE IT
MOV #QUESZ/2,QUEENO(A) ;THE NUMBER OF ENTRIES IN THE QUE
JSR PC,ITM2PO ;POP THE QUE
CLZ
RTS PC
CRQUE1: SEZ
CRQUE2: RTS PC
.IFZ 105
CCPRTR: TST PTRITM ;IS THERE ONE ALREADY
BNE CRQUE1 ;YES, LOSER
MOV #PTRLEN,A ;GET THE LENGTH
JSR PC,CRITEM ;CREATE THE ITEM
BEQ CRQUE2 ;FAILED FOR RANDOM REASON
MOV B,A ;GET THE ITEM NO.
JSR PC,ITM2PL ;LOAD IT UP
MOV #ITPTR,(A)+ ;SET IN THE TYPE
MOV #1,(A)+ ;THE REFERENCE COUNT
MOV #PTRBUF,(A) ;THE START OF THE BUFFER
MOV (A)+,(A)+ ;SET IN THE DATA OUT POINTER
CLR (A)+ ;NOTHING IN BUFFER CURRENTLY
JSR PC,ITM2PO ;POP IT
MOV B,PTRITM ;SAY THIS IS THE PTR ITEM
MOV #1,PTRSR ;SET THE INTERRUPT ENABLE
CLR C ;NO SECONDARY ITEM
MOV #.TRCAP,A
RTS PC
CCPRTP: TST PTPITM ;PAPER TAPBE ITEM
BNE CRQUE1 ;FAIL THERE ALREADY IS ON
MOV #PTPLEN,A ;GET THE LENGTH
JSR PC,CRITEM ;CREATE THE ITEM
BEQ CRQUE2 ;FAILED
MOV B,A ;COPy THE ITEM NO.
JSR PC,ITM2PL ;LOAD IT UP
MOV #ITPTP,(A)+ ;TYPE
MOV #1,(A)+ ;REFERENCE COUNT
MOV #PTPBUF,(A) ;THE POINNTER TO START
MOV (A)+,(A)+ ;SET IT IN
CLR (A)+ ;NOTHING IN THE BUFFER
JSR PC,ITM2PO ;POP IT
MOV #.TPCAP,A ;THE TYPE OF CAPABLITY
CLR C ;NOTHING
MOV B,PTPITM ;THE ITEM IS NOW HERE
RTS PC
.IFF
CCPRTR: MOV #PTRLEN,A ;LENGHT OF ITEM
MOV #ITPTR,C ;TYPE OF ITEM
MOV #PTRBUF,D ;POINTER TO BUFFER IN ITEM
MOV #.TRCAP,E ;TYPE OF CAPABILITY
MOV #PTRITM,F ;WHERE ITEM IS STORED
TST (F) ;ITEM ALREADY?
BNE CCPRT0 ;YES, HE IS GOING TO LOSE
INC PTRSR ;OTHERWISE START TAPE READER AGAIN
BR CCPRT0
CCPRTP: MOV #PTPLEN,A ;LENGHT OF ITEM
MOV #ITPTP,C ;TYPE OF ITEM
MOV #PTPBUF,D ;POINTER TO BUFFER IN ITEM
MOV #.TPCAP,E ;TYPE OF CAPABILITY
MOV #PTPITM,F ;WHERE ITEM IS STORED
CCPRT0: TST (F) ;IS THERE ALREADY AN ITEM?
BNE CRQUE1 ;YUP, LOSE
JSR PC,CRITEM ;TRY TO CREATE ONE
BEQ CRQUE2 ;CAN'T
MOV B,A ;CREATED ITEM
JSR PC,ITM2LD ;LOAD IT
MOV C,(A)+ ;SET IN THE TYPE
MOV #1,(A)+ ;SET IN THE REFERENCE COUNT
MOV D,(A) ;SET POINTER TO START OF BUFFER
MOV (A)+,(A)+ ;COPY IT
CLR (A)+ ;CLEAR CHAR COUNT
MOV E,A ;CAPABILITY TYPE
CLR C
MOV B,(F) ;THE ITEM FOR THIS DEVICE
RTS PC
.ENDC
;CREATE A CORE LINK CAPABILITY, LENGTH OF BUFFER IN E
CCPRCL: MOV E,A ;COPY LENGTH
BLE CRQUE1 ;BAD LENGTH
ADD #CLDATL,A ;ADD THE NUMBER OF DATA WORDS
ASH #-6,A ;GET THE LENGTH IN 32. WORD BLOCKS
CMP A,#1 ;IS IT MORE THAN 2 BLOCKS
BGT CRCL1 ;YES, MAKE AN FUPT FOR IT
JSR PC,CRITEM ;CREATE AN ITEM
BEQ CCPRQ1 ;FAILED
MOV B,A ;COPY THE ITEM NO. CREATED
JSR PC,ITM2PL ;LOAD IT UP
MOV #ITCL,(A)+ ;SET IN THE TYPE
MOV B,C ;GET THE ITEM NO.
CRCL2: MOV #1,(A)+ ;SET IN THE REFENCE COUNT
CLR (A)+ ;SAY THERE IS NO CONSUMER
CLR (A)+ ;CLEAR THE COUNT OF VALID DATA
MOV E,(A)+ ;SET IN THE NUMBER OF ENTRIES
MOV #CLDATL,(A) ;SET IN THE DATA IN POINTER
MOV (A)+,(A) ;SET IN THE DATA OUT POINTER
SAVE B
JSR PC,ITM2PO ;POP THE ITEM
MOV #.CLCAP,A ;THE TYPE
BIT #GIPBIT,C ;IS IT IN A SPHERE
BNE CRCL4 ;NO
REST B
CLZ
RTS PC
CRCL4: MOV (P),B ;THE GIP TO THE FUPT
BIC #GIPBIT,B
CLR FUPTPR(B) ;SAY NO ONE OWNS IT NOW
REST B
CLZ
RTS PC
CRCL1: ASH #-4,A ;CONVERT 32 WORD BLOCKS TO 512 WORD BLOCKS
MOV A,B ;COPY
MOV A,D ;TWICE
CMP #7,A ;MORE THAN 4K?
ERRORC LT,BAD ;BAD ARG
JSR PC,FRCRGT ;GET SOME FREE CORE
ERRORC EQ,NSS ;NO SWAP SPACE AVAILABLE
MOV B,A ;GIP FOR CREATED CORE
JSR PC,ITM2PL ;LOAD IT UP
MOV #ITCL,(A)+ ;SWAP IT IN
JSR PC,LSWPOP ;NOW WE ARE SURE TO RUN TO COMPLETION
BR CRCL2 ;GO FINISH UP
;CREATE DISPLAY CAPABILITY
CCPRDS: .IFZ NTKDIS+NTVS
ERROR RNA
.IFF
TST E ;DOES HE WANT THE ONE ASSOCIATED WITH TTY?
BGE CCPRD7 ;NO
MOV E,B ;THIS HAS THE CAP INDEX OF TTY IN HIGH BYTE
BIC #177600,B ;CLEAN OFF THE 377
MOV #ITM1AD,A ;ADDRESS OF THE SPHERE
JSR PC,GCLSTA ;GET THE OFFSET OF THE CAPABILITY INTO SPHERE
BEQ CCPR15 ;Z SET MEANS BAD CAPABILITY NUMBER PASSED TO GCLSTA
ADD B,A ;THE OFFSET IS RETURNED IN B, GET THE ADDRESS OF CAP
CMPB (A),#.TTCAP ;MAKE SURE IT WAS A TTY
BEQ CCPR19 ;IT WASN'T SO FAIL
CCPR15: JMP CCPR12
CCPR19: MOV CLSEPI(A),A ;GET THE TTY ITEM NUMBER
JSR PC,ITM2LD ;LOAD IT UP
MOV TTLTTY(A),C ;GET THE LOGICAL TTY NUMBER OF THIS TTY
BIT #TVF,TTYTBL(C) ;IS IT A TV?
BNE CCPRD8 ;YES
BIT #40000,E ;DOE SHE WANT A TV?
BNE CCPRD5 ;LOSE
TST TYDISP(C) ;DOES IT EXIST
BLT CCPRD5 ;NO
BIC #377,E ;CLEAR OUT THE TTY NO.
BIS TYDISP(C),E ;GET TK DISP NEAR TTY
.ENDC
.IFZ NTKDIS
SEZ
RTS PC ;NO TK DISPLAYS
.IFF
MOV #DISMAL,A ;START LOOKING FOR A SMALL ONE
BIT #400,E
BEQ 1$
MOV #DISBIG,A ;HE REALLY WANTS A BIG ONE
1$: CLR B ;INDEX TO DISPLAY TABLES
MOV #NTKDIS,C ;NUMBER OF BUFFERS AVAILABLE
CCPRD3: CMP #-1,TKDRUN(B) ;AVAILABLE?
BNE CCPRD1 ;NOPE
CMP A,TKDLEN(B) ;ADEQUATE SIZE?
BLE CCPRD2 ;YES!
CCPRD1: TST (B)+ ;NEXT!
SOB C,CCPRD3
CCPRD5: SEZ ;RAN OUT OF POSSIBLITES
RTS PC
CCPRD2: MOVB E,C ;GET THE DISPLAY NUMBER HE WANTS
ERRORC LT,RNA
CCPRD4: TSTB TKDOWN(C) ;IS THAT DISPLAY FREE?
BNE CCPRD5 ;NOPE, YOU LOSE
MOVB #1,TKDOWN(C) ;USED NOW!
JSR PC,TKDSTP ;MAKE SURE IT IS STOPPED
BIS #100000,C ;OWNED, BUT DON'T START IT YET
MOV C,TKDRUN(B) ;IT BELONGS TO HIM
MOV B,C ;INDEX TO TABLES IS FIRST MISC WORD
MOV TKDITM(C),D ;THE ITEM FOR THE DISPLAY
MOV ITMTAB(D),B ;GET THE ADDRESS IN 32 WORD BLOCKS
SUB TKDPDA,B ;SUBTRACT START OF DISPLAY WORLD IN 32 WORD BLOCKS
ASH #5,B
JSR PC,GIVPSW ;RETURN THE OFFSET IN WORDS
MOVB ITLNGT+ITMTAB(D),B ;LENGTH IN 32 WORDS
INC B ;MINUSE ONE
ASH #5,B ;MAKE IT WORDS
JSR PC,GIVPSW ;RETRUN IT
MOV D,B ;SO THE ITEM GETS SAVED
MOV #.DSCAP,A ;AND THE TYPE
RTS PC
TKDSP: MOV 6(A),D ;THE DISPLAY INDEX
BIS #100000,TKDRUN(D) ;SO INT LEVEL WON'T START IT
MOV TKDRUN(D),C ;THE DISPLAY NUMBER
TKDSTP: SAVE <C>
BIC #177400,C ;JUST THE DISPLAY
BIS #TKSTOP,C
MOV C,NGCSR
REST <C>
RTS PC
.ENDC
.IFNZ NTVS
CCPRD7: MOVB E,C ;NUMER OF THE DISPLAY HE WANTS
BLT CCPRDT
CMPB C,#NFTVDS+NTVS ;THERE ARE ONLY THIS MANY DISPLAYS
BGE CCPR12 ;TOO HIGH! FAIL.
SUB #NFTVDS,C ;CONVERT TO PHYSICAL TV NUMBER FOR INDEX TO TABLES
BLT CCPR12 ;TOO LOW! FAIL
BR CCPRD9
CCPRD8: BIT #40000,E ;DOE SHE WANT A TV?
BEQ CCPR12 ;NOPE, LOSE
SUB #NFTV,C ;GET THE PHYSICAL NUMBER OF THE KEYBOARD
ASR C ;THIS WILL BE THE SAME AS THE NUMBER OF THE TV
CCPRD9: TST FNTITM ;DOES FONT ZERO EXIST?
ERRORC EQ,DEVE ;NO, "DEVICE" ERROR
MOVB TVDSBF(C),D;DOES THIS TV ALREADY HAVE A BUFFER?
BGE CCPR11 ;YES, IT MUST ALREADY HAVE A TV BUFFER
JSR PC,GETTV
CCPR11: MOVB D,TVDSBF(C);ALLOCATE THIS BUFFER (D) TO THIS TV (C)
MOVB C,TVBUFF(D);SAY THAT THIS BUFFER IS ALLOCATED
INCB TVDSRF(C) ;ONE MORE PERSON IS REFERENCING THIS TV
ADD #NFTVDS,C ;FIRST RANDOM WORD IN CAP IS LOGICAL DISPLAY NUMBER
ASL C ;IT SHOULD BE A WORD INDEX INTO TABLES
CCPR10: MOV D,B ;FOR NOW, THE ADDRESS OF A TV BUFFER IS IRRELEVENT
JSR PC,GIVPSW ;RETURN A ZERO, JUST FOR COMPATABILITY
MOV #100000,B ;A TV BUFFER HAPPENS TO BE 16K WORDS LONG
JSR PC,GIVPSW ;MIGHT AS WELL GIVE IT TO HIM ANYWAY
CLR B ;RETURN THE FACT THAT THERE IS NO ITEM FOR TV DISPLAY
MOV #100000!.DSCAP,A ;THIS WILL BE A DISPLAY CAPABILITY
RTS PC ;NOTE THAT THE PREVIOUS INST. CAUSED Z CLEARED
CCPR12: SEZ ;FAIL
RTS PC
GETTV: MOV #NTVCHN,B ;THE NUMBER OF TV CHANNELS OR BUFFERS
CLR D ;OFFSET INTO THE TVBUFF TABLE
GETTV1: TSTB TVBUFF(D) ;IS THIS BUFFER FREE?
BLT GETTV2 ;YES (-1 MEANS FREE)
INC D ;TRY THE NEXT BUFFER
SOB B,GETTV1 ;ANY MORE BUFFERS LEFT?
ERROR RNA
GETTV2: RTS PC
CCPRDT: BIT #40000,E ;DOES HE WANT A TV?
BEQ CCPR12 ;NOPE
JSR PC,GETTV ;GET ONE
CLRB TVBUFF(D) ;MAKE IT USED
MOV D,C
BIS #100000,C
BR CCPR10
.ENDC
CCPRLP: MOV #PRTLEN,A ;GET THE ITEM ALLOCATED
JSR PC,CRITEM ;CREAT AN ITEM
ERRORC EQ,NIT ;NO ITEM
MOV B,A ;LOAD UP THE ITEM
TST LPTITM ;LPT UNUSED?
BEQ 1$ ;YES
JSR PC,DLITEM ;DELETE THE ITEM
ERROR RNA ;AND REPORT ERROR
1$: JSR PC,ITM2LD
MOV #ITLPT,(A)+ ;FILL IT IN
MOV #1,(A)+ ;REFERENCE COUNT
MOV #PRTEND,(A)+ ;POINT TO THE END OF THE PRINTER BUFFER
CLR (A)+ ;SET THE LINE COUNT TO 0
CLR (A)+ ;START IN PRINT MODE
MOV #PRTCSR,(A)+ ;SET IN POINTER TO THE PRINTER CONTROL STATUS REG.
MOV #LPTBUF,(A) ;PUT IN THE DATA IN POINTER
MOV (A)+,(A)+ ;COPY IT
CLR (A)+ ;CLEAR THE NUMBER OF BYTES IN BUFFER
CLR (A)+ ;NO BYTES TRANSFERED ON LAST TRANSFER
CLR (A)+ ;NO BYTES ON THE CURRENT LINE
CLR C ;NO DATA WORDS
MOV #.LPCAP,A ;TYPE OF CAP
MOV B,LPTITM ;TELL EVERYONE THAT THERE EXISTS ONE
MOV #2,PRTCSR ;DO A REMOTE RESET ON THE PRINTER
RTS PC ;DONE
.STITL PROCESS CAPABILITY ROUTINES
;INVOKE A PROCESS CAPABILITY, FUNCTION 0-7 IS USER'S REGISTERS
;10 IS USERS PS, 11-16 IS USERS FPP REGISTERS 17 IS FLOATING POINT STATUS
;40 BIT CLEAR MEANS READ (CURRENT VALUE PUSHED ON USERS STACK)
;40 BIT SET MEANS WRITE (2ND DATA WORD IS PLACED IN USERS REGISTER)
;A FUNCTION OF 20 ALLOWS READ/WRITE OF THE AVAILABILITY OF FPP
;IF READ, THE WORD RETURNED IS EITHER 1 (FLOATING POINT ENABLED) OR
;0 (NO FLOATING POINT). IF WRITE, THE SECOND WORD ON THE STACK MUST BE
;EITHER 1 OR 0. A FUNCTION OF 21 ALLOWS WRITE AND READ OF THE SUPERIOR STOP BIT.
;IF WRITE, 0 MEANS START THE PROCESS, 1 MEANS STOP IT. READ, NON ZERO MEANS STOPPED
;FUNCTIONS 23-25 MEAN READ AND WRITE THE FAULT WORDS 1-3
;FUNCTION 24 READS AND WRITES THE ERROR WORD
CAPRPR: REST C ;GET THE FUNCTION BYTE
ASH #-7,C ;TURN IT INTO A WORD INDEX
BIC #177001,C ;CLEAR EXTRA BITS
MOV C,D ;COPY IT
ASR D ;SHIFT IT BACK DOWN
BIC #.PRWRT*2,C ;CLEAR THE READ/WRITE BIT
BIT #.PRWRT,D ;IS HE WRITING
BEQ CPRPR1 ;NOPE
BIT #.PRWRA,(A) ;DOES HE HAVE WRITE ACCESS?
BNE CPRPR1 ;YES
CPRPR2: ADD #4,P
JMP BADEMT ;BARF
CPRPR1: CMP C,#PRHGH ;IS IT TO HIGH
BGE CPRPR2 ;YES
MOV 2(A),A ;ITEM OF THE PROCESS
JSR PC,ITM2LD ;LOAD IT UP
JMP @PRIVTB(C) ;DO THE FUNCTION
PRREG: ADD C,A ;MAKE A POINT TO THE REG (WELL ALMOST)
ADD #PUREGS,A ;POINT TO THE REGISTER IN DOUBT
PRRET: BIT #.PRWRT,D ;READING?
BNE REGWRT ;NOPE
MOV (A),B ;GET THE APPROPRIATE REG INTO B
PRRET1: JSR PC,GIVPSW ;GIVE IT TO HIM
ADD #4,P ;GET RID OF TWO ARGUMENTS
JMP ERETCZ ;WE WIN
REGWRT: REST (A) ;SECOND ARG GOES INTO REGISTER
PRRET0: TST (P)+ ;GET RID OF THIRD ARG
JMP ERETCZ ;WE WIN
;HERE IS PSW AND FLOATING REG READ
PRPSW: ADD #PUPS,A ;POINT TO THE PSW
MOVB 1(A),1(P) ;DONT LET HIM CHANGE MODE
BIC #340,(P) ;OR PRIORITY
BR PRRET ;RETURN IT OR WRITE IT
PRFREG: MOV (P),E ;GET POINTER TO DATA
MFPD (E)+ ;MAKE SURE WE CAN GIVE IT TO HIM
MFPD (E)+
MFPD (E)+
MFPD (E)+
ADD #10,P ;POP OFF THE STUFF
REST E ;POINTER TO DATA IS 2ND ARG
SUB #2*.PRFREG,C ;MAKE THIS AN INDEX TO A FLOATING REG
ASH #2,C ;EACH REGISTER IS 4 WORDS
BIT #PFPFLG,PFLAGS(A) ;DOES HE HAVE THE FPP ENABLED?
BEQ PRFLT3 ;NOPE
BIT #.PRWRT,D ;IS HE WRITING INTO THIS REG?
BNE PRWRT ;YEP
ADD C,A ;MAKE THE A POINT TO A FLOATING REG(ALMOST)
ADD #PFPPRG+10,A ;MAKE IT ABSOLUTELY POINT TO THE APPROPRIATE REG
SAVE <-(A),-(A),-(A),-(A)> ;SAVE THE FPP REGISTER
MTPD (E)+ ;GIVE HIM THE REGISTER IF YOU CAN
MTPD (E)+
MTPD (E)+
MTPD (E)+
PRFLT2: TST (P)+ ;THIRD ARG NOT USED
JMP ERETCZ
PRFLT3: ERROR BAC ;NO ACCESSS TO FPP
PRWRT: MFPD (E)+ ;GET THE REGISTER (IF WE CAN)
MFPD (E)+
MFPD (E)+
MFPD (E)+
ADD C,A ;MAKE THE A POINT TO A FLOATING REG(ALMOST)
ADD #PFPPRG+10,A ;MAKE IT ABSOLUTELY POINT TO THE APPROPRIATE REG
REST <-(A),-(A),-(A),-(A)> ;PUT THE REGISTER AWAY
BR PRFLT2 ;RETURN
PRFPST: BIT #PFPFLG,PFLAGS(A) ;DOES IT USE THE FPP
BEQ PRFLT3 ;NO LUSER
ADD #PFPPS,A ;POINT TO THE REGISTER
BIT #.PRWRT,D ;IS IT A WRITE
LBR ,PRRET ;TRANFER THE PROCESSOR STATUS
PRFPEN: BIT #.PRWRT,D ;IS HE WRITING
BNE FPPWRT ;YEP
CLR B ;ASSUME THAT THERE ISNT ANY FPP
BIT #PFPFLG,PFLAGS(A) ;DOES HE HAVE FPP
BEQ 1$ ;NOTHING HERE
INC B ;SAY HE HAS FPP
1$: JMP PRRET1 ;RETURN 1 ARG
FPPWRT: MOV ITEM2,B ;WE WANT THE ITEM TO DO IT TO
REST E ;GET THE FIRST ARG
CMP E,#1 ;IS IT A LEGAL ARG
BHI PRLOSE ;TO BIG
BEQ PWRT1 ;ITS A REQUEST FOR FPP
BIT #PFPFLG,PFLAGS(A) ;DOES HE ALREADY HAVE IT
BEQ PWRT2 ;NO, WHY BOTHER
MOV ITEM2,B ;THE ITEM INDEX OF WHAT TO SHRINK
MOV #PRSLNF,A ;TELL IT THE SIZE WE WANT
JSR PC,EXITEM ;SHRINK THIS ITEM
MOV ITEM2,A ;GET BACK THE ITEM
JSR PC,ITM2LD ;LOAD IT BACK UP IN ITS NEW FORM
BIC #PFPFLG,PFLAGS(A) ;SAY HE DOESN'T HAVE FPP
JMP PRRET0 ;RETURN SUCESSFUL
PWRT1: BIT #PFPFLG,PFLAGS(A) ;DOES HE ALREADY HAVE IT
BNE PWRT2 ;YES
MOV #PRSLFP,A ;THE LENGTH WE WANT IT TO BE
JSR PC,EXITEM ;EXPAND THE PROCESS
ERRORC EQ,NIT ;NO ITEM LARGE ENOUGH
MOV ITEM2,A ;THE NEW ITEM
JSR PC,ITM2LD ;LOAD IT UP
BIS #PFPFLG,PFLAGS(A) ;SAY WE HAVE FPP
MOV #40300,PFPPS(A) ;START WITH INT. DISABLED AND LONG AND DOUBLE
PWRT2: JMP PRRET0 ;RETURN NO ARG
PRLOSE: ERROR BFUN ;BAD FUNCTION
PRSTOP: ADD #PSTOP,A ;POINT TO THE STOP WORD
BIT #.PRWRT,D ;IS IT A WRITE
BNE PRSTP1 ;YES
MOV (A),B ;GET THE STOP WORD
JMP PRRET1 ;RETURN IT TO HIM
PRSTP1: CMP (P),#1 ;IS IT A ONE
BHI PRLOSE ;FAIL
BEQ PRSTP2 ;STOP IT
BIT #PSUPSB,(A) ;IS HE STOPPED BY A CAPABILITY
BEQ PRSTP3 ;NO, JUST RETURN
BIC #PSUPSB,(A) ;CLEAR THE BIT
MOV ITM2A,A ;POINT AT THE PROCESS
TST PSPHRP(A) ;IS IT IN A SPHERE?
ERRORC LE,BAD ;NO, DON'T TRY TO START IT
MOV ITEM2,A ;THE PROCESS
JSR PC,PSTPDC ;DECREMENT THE STOP COUNT
PRSTP3: TST (P)+ ;POP OFF THE ARG
JMP PRRET0 ;DONE
PRSTP2: BIT #PSUPSB,(A) ;HAS SOMEONE ELSE ALREADY STOPPED IT
BNE PRSTP3 ;SOMEONE BEAT US TO IT.
BIS #PSUPSB,(A) ;SET THE STOP BIT
MOV ITEM2,A ;THE PROCESS TO STOP
JSR PC,PSTPIN ;STOP IT
ADD #4,P ;POP ARGS
JMP ERETCZ
PRFAUL: SUB #.PRFAUL*2,C ;CREATE AN OFFSET
ADD C,A ;POINT TO IT
ADD #PFAULT,A ;GET THE FIRST FAULT WORD
BIT #.PRWRT,D ;IS IT A WRITE REQUEST
BNE PRFAUW ;WRITE REQUEST
MOV (A),B ;GET THE FAULT WORD
JMP PRRET1 ;RETURN IT
PRFAUW: TST (P) ;WRITING A ZERO?
BEQ PFAUW1 ;YES
PFAUW2: JMP PRRET ;CAUSE THE WRITE
PFAUW1: TST (A) ;IS IT FAULTED ALREADY
BEQ PFAUW2 ;NO
MOV PSPHRP-PFAULT(A),B ;POINTER TO THE SPHERE
BEQ 1$ ;NOT IN SPHERE?
JSR PC,FALTFX ;FIX THE FAULT
1$: JMP REGWRT
PRERR: ADD #PERRW,A
BR PFAUW2 ;DO THE READ/WRITE
PRERA: ADD #PERRAD,A
BR PFAUW2
CAPRLP: TST (P)+ ;GET RID OF FIRST ARGUMENT
CMP (P),#4 ;THE MAXIMUM SCALE FACTOR
ERRORC HI,BAD ;BAD ARUMENTS
MOV 2(A),A ;THE LPTITM
MOV A,B ;COPY IT FOR EXITEM
JSR PC,ITM2LD ;LOAD IT UP
CAPRL1: TST LPTPCT(A) ;GOT BYTES TO TRANSFER ON A LINE STILL
ERRORC NE,BFUN ;CANT UNTIL TRANSFER IS FINISHED
BIT #40100,@LPTCSR(A) ;IS THE INTERRUPT TURNED OFF?
BNE CAPRL2 ;NO FLUSH YOURSELF
TST LPTNUM(A) ;BYTES IN LINE BUFFER?
BEQ LPTMD1 ;FINE ITS EMPTY
CAPRL2: JSR PC,LFLUSH ;FLUSH YOURSELF
TST LPTPCT(A) ;GOT BYTES TO TRANSFER ON LINE?
BNE CAPRL3 ;CHECK THIS OUT IMMEDIATELY
BIT #40100,@LPTCSR(A) ;INTERRUPT OFF?
BNE CAPRL2 ;NO
TST LPTNUM(A) ;BYTES LEFT?
BNE CAPRL2 ;YES, FLUSH AWAY
CAPRL3: JSR PC,RUNME ;RUN ME
BR CAPRL1 ;MAKE SURE IT IS STILL DONE
LPTMD1: MOV #LPTBUF,LPTDAI(A) ;RESET THE POINTERS TO THE START
MOV #LPTBUF,LPTDAO(A) ;IN CASE WE WERE IN PLOT MODE, AND SHRINKING BUFFER
BIS #4,@LPTCSR(A) ;SET THE CLEAR BUFFER BIT (IN EITHER CSR, DONT MATTER)
MOV (P)+,LPTMOD(A) ;SET THE MODE
BEQ LPTPR ;INTO PRINT MODE
MOV #PLTCSR,LPTCSR(A) ;NOW IN PLOT MODE
MOV #PLTEND,LPTEND(A) ;POINT TO THE END OF THE BUFFER OF THE PLODDER
MOV #PLTLEN,A ;NEW LENGTH
BR LPTMD2 ;NOW RETURN
LPTPR: MOV #PRTCSR,LPTCSR(A)
MOV #PRTEND,LPTEND(A) ;POINT TO THE END OF THE PRINTER BUFFER
MOV #PRTLEN,A ;THE LENGTH IN PRINT MODE
LPTMD2: JSR PC,EXITEM ;DO THE RIGHT THING (EXPAND, CONTRACT, OR IGNORE)
TST (P)+ ;POP OFF LAST ARG
JMP ERETCZ ;RETURN
CAPRTR:
CAPRTP: ERROR BFUN
CPYCL: MOV #.CLCONS,E ;CLEAR THE CONSUMER FLAG ON COPY
MOV 2(F),B ;POINTER TO CORE LNK
BR CPYFA1 ;INCREMENT THE REFERENCE COUNT
CPYLP:
CPYTR:
CPYTP:
CPYQU: CLR E ;NO FLAGS TO CLEAR
BR CPYFA1 ;INCREMENT THE REFERENCE COUNT
;COPY PROCESS CAPABILITY, 2ND ARG SPECIFIES A MASK OF BITS TO
;BE CLEARED, NO BITS MAY BE SET.
CPYPR: BIC #377,E ;MAKE SURE YOU ONLY TOUCH THE TOP BYTE
BR CPYFA1 ;CREATE THE SPERE CAP.
CPYFA: BIS #<-.FARD-.FAWT-.FAAP-.FAAC>-177400,E
CLRB E
MOV FAMFI(F),B
CPYFA1: JSR PC,SPRINC
MOV (F),A ;THE FLAG WORD
BIC E,A
RTS PC
;COPY TTY CAPABILITY, SAME AS COPY SPHERE
CPYTT:
;COPY SPHERE CAPABILITY, ARGS SAME AS PROCESS CALL
CPYSP: MOV (F),A
BR CPYMS1
;COPY A MASTER SPHERE CAPABILITY, BECOMES A SPHERE CAP. 2ND ARG
;SPECIFIES A MASK OF BITS TO BE CLEARED DURING THE COPY
CPYMS: MOV #MSPCBT!.SPCAP,A
TST 4(F) ;IS THIS THE FIRST COPY OF A MASTER SPHERE?
BNE CPYMS1 ;NOPE
MOV D,10(F) ;MAKE THE MASTER SPHERE POINT TO ITSELF TEMPORARILY
MOV ITEM1,4(F) ;SET IN THE ITEM NO.
CPYMS1: MOV 2(F),B ;THE ITEM NO.
JSR PC,SPRINC ;INCREMENT SPERE'S REFERENCE COUNTER
BIC #377,E ;ONLY THE TOP BYTE IS SIGNIFICANT
BIC E,A ;CLEAR THE CORRECT BITS
MOV 2(P),E ;POINTER TO CAP DESTINATION
MOV 2(F),B ;THE ITEM NO. OF SPHERE OF MS CAP
MOV 4(F),4(E) ;POINTER TO NEXT SPHERE CAP
MOV 10(F),10(E) ;REST OF POINTER TO NEXT CIRCULAR LIST ENTRY
MOV ITEM1,4(F) ;THE FIRST SPHERE ON CIRCLE LIST IS THIS SPHERE
MOV 4(P),10(F) ;THE CAP. NO IS IN B
RTS PC
;COPY OF DISPLAY CAPABILITY IS NOT ALLOWED
CPYDS: ERROR BFUN
.STITL GIVE CAPABILIY ROUTINES
GIVSP: SAVE <A,B,C,D>
;A CONTAINS RELATIVE POINTER TO DEST. C-LIST ENTRY
;B THE C-LIST NO. OF DEST
;C THE SPHERE NO. OF DEST
MOV E,B ;THE C-LIST NO. OF THE SOURCE C-LIST ENTRY
MOV D,A ;THE POINTER TO THE SOURCE C-LIST ENTRY
JSR PC,FNBKPT ;FIND THE PREVIOUS ENTRY IN CIRCULAR LIST
MOV C,A ;THE PREVIOUS SPHERE
MOV D,B ;THE PREVIOUS C-LIST NO
JSR PC,ITM1PL ;LOAD IT UP
JSR PC,GCLSTA ;FIND IT
ADD A,B ;MAKE A POINT TO IT
MOV 2(P),4(B) ;CORRECT SPHERE POINTER
MOV 4(P),10(B) ;CORRECT C-LIST POINTER
JSR PC,ITM1PO ;POP THE SPHERE
REST <D,C,B,A>
;FALL THROUGH AND TRANSFER THE CAPABILITY
;MAY FALL THROUGH FROM GIVE SPHERE ROUTINE
GIVCC: ;CREATE CAP. GIV IS SAME AS PROCESS CAP. GIVE
GIVCM:
GIVTP:
GIVTR:
GIVTT:
GIVLP:
GIVQU:
GIVCL:
GIVFA:
GIVPR:
GIVDS: JSR PC,GIVPSW ;GIVE HIM THE WORD, (CAN'T FAIL FROM HERE ON IN)
SAVE A ;SAVE THE POINTER TO THE CAP TO GIVE
MOV C,A ;THE DESTINATION SPHERE
JSR PC,ITM2LD ;LOAD IT UP
ADD (P)+,A ;MAKE A POINT TO THE C-LIST ENTRY
MOV D,B ;POINTER TO THE CAPABILITY TO GIVE
MOV (B)+,(A)+ ;MOV THE CAPABILITY
MOV (B)+,(A)+
MOV (B)+,(A)+
MOV (B)+,(A)+
MOV (B)+,(A)+
CLR (D) ;GET RID OF IT
ADD #4,P ;POP OFF THE TWO ARGS
JMP ERETCZ
GIVMS: SAVE <A,D>
MOV C,A ;THE SPHERE THAT WE ARE GIVING TO
JSR PC,ITM2LD
MOV 2(D),D ;THE SPHERE THAT THE MS REFERS TO
MOV SMSSPT(A),A ;JUST CHECK THIS ONE'S SUPERIOR
GIVMS1: CMP A,D ;IS THE SUPERIOR SPHERE, THE ONE THE MS REFERS TO
BEQ GIVMS2 ;YES, WE MUST FAIL
CMP A,SYSSPR ;IS IT THE SYSTEM SPHERE
BEQ GIVMS3 ;YES, THEN GIVING IT AWAY IS FINE
JSR PC,ITM2LD ;LOAD UP THE SUPERIOR SPHERE
MOV SMSSPT(A),A ;GET THIS ONES SUPERIOR SPHERE
BR GIVMS1 ;GO BACK AND CHECK IT OUT
GIVMS2: ERROR BAD ;TRIED TO GIVE TO INFERIOR (NOT GOOD ENOUGH) SPHER
GIVMS3: MOV D,A ;THE SPHERE THE MS REFERS TO
JSR PC,ITM2LD ;LOAD IT UP
MOV C,SMSSPT(A) ;FIX ITS MASTER SPHERE POINTER
;(HERE FIX USER POINTER ALSO?)
REST <D,A>
BIS #.SPFES,(D) ;SUPRESS ENTERS UNLESS HE TURNS IT ON
BR GIVSP ;NOW GIVE IT AWAY LIKE A SPHERE
.STITL DELETE CAPABILITY ROUTINES
DELCM: DEC CMUSE ;ONE LESS CAP
DELCC: CLR (A) ;CLEAR THE FIRST WORD
CLZ
RTS PC
DELPR: CLR (A) ;FLUSH THE CAPABILITY
MOV 2(A),A ;GET THE ITEM INDEX
JSR PC,PSTPIN ;STOP HIM FROM RUNNING
SAVE A
JSR PC,DLPROC ;DEC PROCESSES REF COUNT
BEQ DELPR1 ;WE DELETED THE PROCESS
REST A ;GET THE PROCESS ITEM NO.
JSR PC,PSTPDC ;DECREMENT HIS STOP COUNT
CLZ
RTS PC
DELPR1: REST A ;GET BACK ITEM INDEX
CLZ
RTS PC
DELSP: SAVE A
MOV E,B ;THE CAP. NO. TO FLUSH
JSR PC,FNBKPT ;FIND THE PREVIOUS ENTRY
MOV (P),A ;GET THE ADDRESS BACK
MOV 4(A),E ;THIS SPHERE'S POINTER
MOV 10(A),F ;THE REST OF THE POINTER
MOV C,A ;THE PREVIOUS ENTRY'S SPHERE
JSR PC,ITM1PL ;LOAD IT UP
JSR PC,GCLSTA ;GET APOINTER TO IT
ADD A,B ;MAKE THE POINTER ABSOLUTE
TST B ;DOES IT EXIST
BUGC EQ ;YES
MOV E,4(B) ;SPLICE OUT ENTRY WE ARE DELETING
MOV F,10(B)
JSR PC,ITM1PO ;POP THE SPHERE
REST A
DELTP: SAVE A ;SAVE POINTER TO CAP
MOV 2(A),A ;THE ITEM
DELTP3: JSR PC,ITM2PL ;LOAD IT UP
CMP #1,PTPREF(A) ;IS THIS THE LAST ONE?
BNE DELTR1 ;NO, JUST DELETE IT
TST PTRNO(A) ;ANY CHARACTERS LEFT TO PUNCH?
BEQ DELTP4 ;NO
DELTP1: MOV ITEM2,A ;COPY ITEM NO.
JSR PC,ITM2PO ;POP IT
JSR PC,LFLUSH ;WAIT A LONG TIME
JSR PC,ITM2PL ;LOAD IT
CMP #1,PTPREF(A) ;ANOTHER CAP?
BNE DELTP2 ;YES
TST PTRNO(A) ;CHARACTERS LEFT?
BNE DELTP1 ;YES
DELTP2: MOV ITEM2,A
JSR PC,ITM2PO ;CLEAN UP A BIT
JSR PC,RUNME
BR DELTP3 ;CHECK TO MAKE SURE
DELTP4: CLR PTPITM
BR DELTR1
DELTR: SAVE A ;SAVE POINTER TO CAP
MOV 2(A),A ;GET THE TR ITEM
JSR PC,ITM2PL ;LOAD IT UP
CMP #1,PTRREF(A) ;REF COUNT 1
BNE DELTR1 ;NO
CLR PTRITM ;NO MORE PTR
DELTR1: JSR PC,ITM2PO ;POP IT
REST A ;GET BACK A AND DROP IN TO DELETE IT
;DELETE QUE CAPABILITY, JUST DEC REFERENCE COUNT, AND FLUSH CAP.
DELQU: CLR (A) ;FLUSH THE CAPABLITY
MOV 2(A),A ;THE ITEM INDEX OF THE SPRERE
JSR PC,SPRDEC ;DECREMENT SPHERE REF COUNT
CLZ
RTS PC
;DELETE CORE LINK JUST FLUSH IT AND CHECK REFERENCE COUNT
DELCL: BIT #.CLCONS,(A) ;AM I THE CONSUMER
BEQ DELQU ;YES
SAVE A
MOV 2(A),A ;THE ITEM OR GIP
JSR PC,ITM2PL
CLR CLCONP(A) ;SAY THERE IS NO MORE CONSUMER
JSR PC,ITM2PO
REST A
BR DELQU
;DELETE LINPRINTER CAPABILITY
DELLP: SAVE A ;SAVE THE CAPABILITY
MOV 2(A),A ;GET THE LPT ITEM
JSR PC,ITM2PL ;LAOD IT UP
DELLP2: CMP #1,LPTREF(A) ;IS HE THE ONLY ONE
BNE DELLP1 ;NO
JSR PC,LPTCHK ;CAN WE FLUSH HIM
BEQ DELLP3 ;YES
DELLP6: JSR PC,SFLUSH ;GO AWAY FOR A WHILE
CMP #1,LPTREF(A) ;STILL THE ONLY ONE?
BNE DELLP5 ;NO TRY AGAIN
JSR PC,LPTCHK ;SEE IF WE CAN FLUSH HIM
BNE DELLP6 ;CANT
DELLP5: JSR PC,RUNME ;RUN ME
BR DELLP2 ;JUST MAKE SURE
DELLP3: MOV ITEM2,A ;THE ITEM TO DELETE
CLR LPTITM ;SAY NO MORE ITEM
JSR PC,DLITEM ;BYE BYE
BR DELLP4
DELLP1: DEC LPTREF(A) ;DEC REF COUNT
DELLP4: JSR PC,ITM2PO ;POP IT
REST A ;POINTER TO THE CAPABILITY
CLR (A) ;DELETE IT
CLZ ;AND RETURN
RTS PC
LPTCHK: TST @LPTCSR(A) ;ERROR?
BMI LPTFLS ;YES, ALLOW IT TO BE FLUSHED
TST LPTNUM(A) ;ANY CHARACTERS?
BNE LPTNFL ;YES, DONT FLUSH ME YET...
TST LPTWCT(A) ;INTERRUPT DONE?
BEQ LPTFLS ;FLUSH IT
LPTNFL: CLZ
RTS PC
LPTFLS: SEZ
RTS PC
;DELETE TTY CAP, WAIT FOR END OF TRANSMISSION IF LAST CAPABILITY,
;THEN FLUSH ITEM AND CAPABILITY
DELTT: MOV A,F ;COPY THE TTY CAPABILITY POINTER
MOV 2(A),A ;GET THE TTY ITEM NO.
JSR PC,ITM2LD ;LOAD IT UP
DELTT1: CMP TTYREF(A),#1 ;AM I THE LAST
BGT DELTT6 ;NO
SPL 7 ;STOP TTY, AND CLOCK
BIT #TOTRAN,TTYST1(A) ;IS HE TRANSMITTING
BNE DELTT2 ;NO
TST TOQN(A) ;MORE TO PRINT
BEQ DELTT4 ;NO, DONT BOTHER
DELTT2: SPL 0 ;RESTORE LOW PRIORITY
JSR PC,LFLUSH ;LONG, LONG FLUSH
CMP TTYREF(A),#1 ;CHECK IF SOMEONE ELSE COPIED THIS ONE
BGT DELTT3 ;YES, DONE?
SPL 7
BIT #TOTRAN,TTYST1(A) ;TRANSMITTING
BNE DELTT2 ;YES
TST TOQN(A) ;CHARS TO BE OUTPUT
BNE DELTT2 ;NO
DELTT3: SPL 0
JSR PC,RUNME ;TRY ME AGAIN
BR DELTT1 ;JUST TO MAKE SURE
DELTT4: MOV TTLTTY(A),E ;THE LOGICAL TTY NO.
.IFNZ NTVS
BIT #TVF,TTYTBL(E) ;IS THIS A TV
BEQ DELTT7 ;NO
TST TVBUF(A) ;THE BUFFER NUMBER OF THIS TV
BLT DELTT7 ;NO BUFFER ASSIGNED TO THIS TV
MOV E,B ;THE LOGICAL TTY NUMBER
SUB #NFTV,B ;GET THE PHYSICAL NUMBER OF THIS TV
ASR B ;THIS IS A BYTE OFFSET
JSR PC,DELTV ;DECREMENT THE REFERENCE COUNT FOR THIS TV
CLR TVSTAT(E) ;TURN OFF BLINK AND INTERRUPT BITS
DELTT7:
.ENDC
CLR TTYITM(E) ;CLEAR THE ITEM NO.
SPL 0 ;CANT BE BOTHERER ANY MORE
MOV ITEM2,A ;DELETE THE TTY ITEM
JSR PC,DLITEM ;DELETE IT
DELTT5: CLR (F) ;FLUSH THE CAPABILITY
CLZ
RTS PC
DELTT6: DEC TTYREF(A) ;SAY ONE LESS CAPABILITY
BR DELTT5 ;FLUSH IT
DELFA: MOV A,D ;COPY POINTER TO CAP
MOV FAUPT(D),B ;GET THE GIP REFERED TO BY THE FILE
BEQ DELFA1 ;THERE IS NONE
JSR PC,UPTDL ;FLUSH IT
CLR FAUPT(D) ;AND OUR POINTER TO IT
DELFA1: MOV FAMFI(D),A ;GET POINTER TO THE MFI
JSR PC,MFIDEL ;ONE LESS REFERENCE TO THE MFI
CLR (D) ;FLUSH ACTUAL CAPABILITY
CLZ
RTS PC
;DELETE DISPLAY CAP
DELDS: .IFZ NTKDIS+NTVS
BPT ;CAN'T EXIST!
.IFF
MOV CLSEM0(A),B ;GET THE TABLE INDEX
.ENDC
.IFNZ NTVS
BLT DELDS9
CMP B,#NFTVDS*2 ;IS IT A TV DISPLAY?
BGE DELDS1 ;YES
.ENDC
.IFZ NTKDIS
BPT ;THERE SHOULDN'T BE ANY TK DISPLAYS
.IFF
MOV TKDRUN(B),C
MOV #-1,TKDRUN(B) ;RETURN THE DISPLAY
JSR PC,TKDSTP ;STOP THE DISPLAY
BIC #177770,C
CLRB TKDOWN(C)
CLR (A) ;FLUSH THE ACTUAL CAPABILITY
CLZ
RTS PC
.ENDC
.IFNZ NTVS
DELDS9: BIC #100000,B
MOVB #377,TVBUFF(B)
CLZ
RTS PC
DELDS1: ASR B ;CONVERT TO BYTE INDEX
SUB #NFTVDS,B ;CONVERT TO PHYSICAL TV NUMBER
JSR PC,DELTV ;IF REFCOUNT IS ZERO, THEN RELEASE THE BUFFER
BEQ DELDS2 ;IN CASE TVDEL LOSES FOR SOME REASON
CLR (A)
CLZ ;SUCCEED
RTS PC
DELDS2: SEZ ;FAIL
RTS PC
;DELTV DECREMENTS THE REFERENCE COUNT OF A TV AND RELEASES THE BUFFER
;OF THAT TV WHEN THE REF COUNT REACHES ZERO. IT EXPECTS THE PHYSICAL
;TV NUMBER IN B
DELTV: SAVE A
TST B
BLT DELTV2 ;THERE ARE NO NEGATIVE TV'S
CMP B,#NTVS ;IS THIS ONE A LEGAL TV
BGE DELTV2 ;NO
DECB TVDSRF(B) ;DECREMENT THE REFERENCE COUNT
BGT DELTV1 ;IF NOT ZERO, THEN WE'RE DONE
MOVB TVDSBF(B),A ;GET THE BUFFER NUMBER OF THE TV
BLT DELTV2 ;THIS SHOULD NOT BE NEGATIVE
CMP A,#NTVCHN ;IS THIS WITHIN THE TABLE?
BGE DELTV2 ;NO, FAIL
SAVE B
ASL B ;CONVERT TO WORD INDEX
MOV TVMAP(B),B ;GET THE RIGHT CONSOLE
BIS #17*400,B ;THE SOURCE IS THE BLANK CHANNEL
MOV B,VIDSW ;CONNECT THIS CONSOLE TO THE BLANK CHANNEL
REST B
MOVB #-1,TVDSBF(B) ;SAY THAT THIS TV HAS NO BUFFER
MOVB #-1,TVBUFF(A) ;SAY THAT THIS BUFFER HAS NO TV
DELTV1: REST A
CLZ
RTS PC
DELTV2: REST A
SEZ
RTS PC
.ENDC
DELMS: SAVE A ;SAVE POINTER TO CAP FOR END OF ROUTINE
CLR -(P)
MOV A,F ;FOR SPCPDL
JSR PC,SPCPDL
MOV 2(F),A ;THE ITEM OF THIS SPHERE
JSR PC,ITM1PL ;PUSH ONCE ONLY!
MOV ITEM1,A
DELMS2: JSR PC,ITM1LD ;LOAD IT UP
SUB D,SPHREF(A) ;FLUSH THE REFERENCES WE FLUSHED
CMP #1,SPHREF(A) ;WE SHOULD BE THE ONLY ONE LEFT
BUGC NE ;BUG IF NOT ZERO
MOV #-1,E ;FLAG TO STOP ALL PROCESSES
JSR PC,STPMS ;STOP!!!
DELMS9: CLR D ;POINTER INTO C-LIST
JSR PC,GNMSCP ;GET THE NEXT MSCAP
BEQ DELMS1 ;NONE, CAN FLUSH SPHERE AT THIS LEVEL NOW
INC (P) ;ONE MORE SPHERE DOWN
MOV 2(B),A ;POINTER TO THE ITEM
MOV B,F ;FOR THE CALL TO SPCPDL
MOV D,E ;THE CAP NUMBER
JSR PC,SPCPDL ;DELETE THE CIRC LIST
BR DELMS2 ;GO LOAD IT UP AND LOOK FOR MSCAPS IN IT
DELMS1: MOV #-1,A ;NEED TO PUSH THE ITEM TO USE IT
JSR PC,ITM0PL
DELMS3: MOV ITM1A,A ;ADDRESS OF SPHERE
MOV SPHPRP(A),A ;GET POINTER TO FIRST PROCESS
BEQ DELMS4 ;NONE LEFT
JSR PC,ITM0LD ;LOAD IT UP
JSR PC,REMPRS ;REMOVE IT FROM THE SPHERE
BR DELMS3 ;GET THEM ALL!
DELMS4: JSR PC,ITM0PO
CLR D ;C-LIST ENTRY COUNTER
MOV ITM1A,A
DELMS5: JSR PC,GNCLST ;GET THE NEXT REAL ONE
BEQ DELMS6 ;NO MORE
SAVE <A,B,D,ITEM1>
ADD #CLSELN,B ;POINT PAST IT
SAVE <-(B),-(B),-(B),-(B),-(B)> ;SAVE THE CAPABILITY
MOV P,A ;POINT TO IT
JSR PC,ITM1PO ;POP IT IN CASE WE GET STOPPED
MOV (A),B ;FIRST WORD OF CAP
ASL B ;TURN IT INTO A WORD INDEX
BIC #177001,B ;CLEAR THE EXTRA BITS
JSR PC,@DELTAB(B) ;DELETE THE CAPABILITY
BUGC EQ ;SUCCEEDED
ADD #CLSELN,P ;POP OFF STUFF
REST A ;THE ITEM NO.
JSR PC,ITM1PL ;LOAD IT BACK UP
REST <D,B,A>
CLR (B) ;MAKE IT NXM
INC D
BR DELMS5
;CONTINUES NEXT PAGE
DELMS6: MOV ITEM1,C ;THE ITEM THE GIP WILL BE IN
JSR F,ACSAV
CLR B ;THE PAGE WE WANT
JSR PC,ITM1PO
DELMS7: SAVE <C,B>
JSR PC,SUPTDL ;FLUSH THAT ONE
REST <B,C>
INC B ;NEXT ONE
CMP #20,B ;GOT TO THE LAST ONE YET?
BNE DELMS7 ;NOPE
JSR F,ACRES
MOV C,A ;THE SPHERE WE HAVE NOW FLUSHED
JSR PC,ITM1PL ;LOAD IT UP FOR A SEC
MOV SMSSPT(A),F ;GET THE SUPERIOR SPHERE INDEX
MOV SPRTPT(A),A ;POINTER TO THE PROCESS BLOCK FOR THE SPHER
MOV #PFREEQ,B ;MOVE IT TO THE FREE QUQUE
JSR PC,PRSAOD ;MARK THE PAGES
JSR PC,TQUEUE
MOV ITM1A,A
MOV SUSRPT(A),A ;THE USER
MOV PRTPPT(A),A ;GET THE ITEM
JSR PC,ITM1PO
JSR PC,USRDEL ;DELETE A REFERENCE TO HIM
MOV C,A ;THE ITEM NUM
JSR PC,DLITEM ;GONE!!!
MOV F,A ;NOW LOAD THE SUPERIOR
JSR PC,ITM1PL
DEC (P) ;AT TOP LEVEL?
BLT DELMS8 ;YES, GO FINISH UP
CLR D ;GET THE FIRST MSCAP IN THE SUPERIOR
JSR PC,GNMSCP
CLR (B) ;FLUSH CAP TO SPHERE WE JUST FLUSHED
BR DELMS9 ;GO FIND ANY OTHER MSCAPS
DELMS8: JSR PC,ITM1PO ;GET TO THE REAL SPHERE
REST <B,B> ;FLUSH COUNT, GET POINTER TO CAP
CLR (B) ;FLUSHED!
CLZ
RTS PC
;THIS ROUTINE TAKES POINTER TO CAPABILITY IN F, THE MSCAP NO. IN E
;IT DELETES THE CIRCULAR LIST ASSOCIATED WITH IT.
SPCPDL: SAVE A
CLR D
MOV ITEM1,A ;MAKE A BOGUS PUSH
JSR PC,ITM2PL
TST 4(F) ;IS THERE A CIRCULAR LIST
BEQ SPCPDN ;NO
MOV F,A ;RESTORE POINTER TO CAPABILITY
BR SPCPD3 ;A ALREADY POINT TO THE CAPABILITY AND DON'T WANT MSCAP TO GO AWAY
SPCPD4: CMP ITEM2,ITEM1 ;IS THIS THE SAME SPHERE AS WE STARTED WITH
BEQ SPCPD2 ;YES, DON'T BOTHER TO TEST THE C-LIST LOCK (WE ALREADY LOCKED IT)
TST SCLSLK(A) ;IS THE C-LIST LOCKED?
BLE SPCPD2 ;NO, JUST DELETE IT
MOV SCLSLK(A),A ;THE PROCESS THAT LOCKED IT
JSR PC,PRSPCL ;STOP HIM, (I WANT THAT C-LIST BAD)
MOV ITM2A,A ;GET THE ADDRESS BACK
TST SCLSLK(A) ;IT HAD BETTER BE 0
BUGC NE ;IT IS
SPCPD2: ADD B,A ;MAKE A POINT TO THE SPHERE CAPABILITY
CLR (A) ;MAKE THIS CAPABILITY GO AWAY
INC D ;KEEP COUNT OF FLUSHED CAPS
SPCPD3: MOV 10(A),B ;THE C-LIST NO. OF NEXT CAP.
MOV 4(A),A ;GET THE SPHERE POINTER TO THE NEXT CAPABILITY
BUGC EQ ;GOT IT
CMP A,ITEM1 ;IS THIS THE SAME SPHERE
BNE SPCPD1 ;NO
CMP B,E ;SAME AS THE MSCAP?
BEQ SPCPDN ;YES, WE ARE DONE
SPCPD1: CMP A,ITEM1 ;IS THIS THE CURRENT SPHERE
BEQ SPCPD5 ;YES, DON'T STOP IT
MOV A,C ;SAVE FOR SPRSTP
.IFNZ NPC
JSR PC,SPRRPC ;PCLOSER THE SPHERE
.IFF
JSR PC,SPRSTP ;STOP THE SPHERE
JSR PC,SPRSTR ;START IT
.ENDC
MOV C,A ;RESTORE THE SPHERE NO.
SPCPD5: JSR PC,ITM2LD ;LOAD THE NEXT SPHERE
MOV ITM2A,A ;GET THE ADDRESS
JSR PC,GCLSTA ;GET POINTER TO NEXT CAP
BNE SPCPD4 ;GO BACK AND TRY AGAIN
BPT ;ERF, SOMETHING IS SCREWED
SPCPDN: JSR PC,ITM2PO ;POP THE ITEM PUSHED
CLR 4(F) ;MAKE SURE THERE IS NO CIRCULAR LIST
CLR 10(F) ;DITTO
REST A
RTS PC
.STITL TAKE CAPABILITY ROUTINES
TAKSP: SAVE <A,B,C,D>
MOV C,A ;THE SPHERE OF THE TAKEE
SAVE ITEM1 ;CURRENT SPHERE NO.
JSR PC,ITM1PL ;LOAD IT UP
ADD D,A ;MAKE A POINT TO THE CAP
MOV E,B ;B IS THE C-LIST NO.
JSR PC,FNBKPT ;GET BACK POINTER
MOV C,A ;THE PREVIOUS SPHERE
MOV D,B ;THE PREVIOUS C-LIST NO.
JSR PC,ITM1LD ;LOAD IT UP
JSR PC,GCLSTA ;GET THE CAPABILITY
ADD A,B ;MAKE A POINT TO THE CAP.
TST (B) ;IS IT THERE
BUGC EQ ;YEP
REST 4(B) ;THE CURRENT SPHERE IS WHERE THIS SHOULD POINT
MOV 4(P),10(B) ;SET THE C-LIST NO. ALSO
JSR PC,ITM1PO ;POP THE ITEM STACK
REST <D,C,B,A>
TAKFA:
TAKTP:
TAKTR:
TAKLP:
TAKTT:
TAKPR:
TAKCL:
TAKQU:
TAKCM:
TAKDS:
TAKCC: JSR PC,GIVPSW ;GIVE THE USER THE C-LIST NO. OF DEST
SAVE A ;SAVE POINTER TO WHERE THE CAP. IS GOING
MOV C,A ;THE SPHERE TO TAKE FROM
JSR PC,ITM2PL ;LOAD IT UP
ADD D,A ;MAKE THE POINTER ABSOLUTE
REST B ;POINTER TO DESTINATION
SAVE A
MOV (A)+,(B)+
MOV (A)+,(B)+
MOV (A)+,(B)+
MOV (A)+,(B)+
MOV (A)+,(B)+
CLR @(P)+ ;FLUSH THE CAPABILITY
JSR PC,ITM2PO
ADD #4,P ;POP THE TWO ARGS
JMP ERETCZ
;THIS ROUTINE MAKES SURE THAT THE SPHERE STRUCTURE ALWAYS POINTS DOWN
TAKMS: SAVE <A,B,C>
SAVE ITEM1 ;THE SPHERE OF TAKER
MOV C,A ;THE SPHERE OF TAKEE
JSR PC, ITM1PL ;LOAD IT UP
ADD D,A ;MAKE A POINT TO THE CAPABILITY TO BE TAKEN
MOV 2(A),C ;THE SPHERE THAT THE MASTER SPHERE CAP. REFFERS TO
REST A ;GET THE TAKER'S SPHERE NO.
CMP C,A ;IS TAKING HIS OWN MASTER SPHERE CAPATILITY
BEQ TAKMS1 ;YES, DONT LET HIM
CMP C,SYSSPR ;IS HE TAKING THE SYSTEM SPHERE'S MASTER CAP. TO ITSELF
BEQ TAKMS1 ;YES DONT ALLOW HIM TO
TAKMS2: JSR PC,ITM1LD ;LOAD UP THE SPHERE
MOV SMSSPT(A),A ;GET THIS SPHERES MASTER SPHERES NO
CMP A,SYSSPR ;ARE WE AT THE ROOT OF THE SPHERE TREE
BEQ TAKMS3 ;YES
CMP C,A ;IS IT A SUPERIOR OF THE TAKER
BNE TAKMS2 ;NOPE, GET THE NEXT SUPERIOR
TAKMS1: JSR PC,ITM1PO
ERROR BAD ;CANT TAKE A SUPERIOR MS
TAKMS3: JSR PC,ITM1PO ;POP THE SPHERE
JSR PC,SPRSTP ;STOP THE SPHERE THAT THE MS CAP. REFERS TO
MOV C,B ;THE SPHERE THAT WE STOPPED
MOV #LSPRTN,A ;RUN A ROUTINE WHEN UNLOCKED
JSR PC,LOCKSW ;GET A LOCK
MOV #PCSPST,LCKWD1(A) ;START THE SPHERE WHEN IT IS NULOCKED
MOV ITEM0,B ;SAY WE LOCKED THE C-LIST
MOV #SCLSLK,A ;LOCK ITS C-LIST
JSR PC,LCKASW ;LOCK IT IF YOU CAN
MOV C,A ;THE SPHERE NO.
JSR PC,ITM2PL ;LOAD IT
MOV ITEM1,SMSSPT(A) ;UPDATE THE SUPERIOR SPHERE POINTER
MOV (P),A ;THE SPHERE THAT THE CAPABILITY IS IN
JSR PC,ITM2LD ;LOAD IT UP
ADD D,A ;POINT TO THE CAPABILITY
BIS #.SPFES,(D) ;SUPRESS ENTERS FOR NOW
JSR PC,ITM2PO ;POP THE SPHERE
REST <C,B,A>
JMP TAKSP ;UPDATE THE CIRCULAR PINTERS AND TAKE THE CAPABILITY
;INCREMENT SPHERE OR PROCESS REFERENCE COUNT, ITEM NO. IN C
;THIS DEPENDS ON THE SPHERE AND PROCESS REFERENCE COUNT BEING IN THE SAME PLACE
.IIF NZ SPHREF-PRSREF,.ERROR BARF IT WONT WORK
SPRINC: SAVE A ;DON'T CLOBBER A
MOV B,A ;GET THE ITEM NO.
JSR PC,ITM1PL ;LOAD THE SPERE
INC SPHREF(A) ;INC REFERENCE COUNT
JSR PC,ITM1PO ;RELOAD ORIGINAL ITEM1
REST A ;RESTORE IT
RTS PC
;DECREMENT REFERENCE COUNT OF CORE LINK OR PROCESS
;ITEM NUMBER IN A
SPRDEC: JSR PC,ITM1PL ;LOAD THE SPHERE
DEC SPHREF(A) ;DECREMENT THE REFERENCE COUNT
BEQ SPRDC1 ;NO ONE REFERS TO IT ANY MORE
JSR PC,ITM1PO ;POP THE ITEM STACK
RTS PC
SPRDC1: MOV ITEM1,A ;SAVE THE ITEM NO.
JSR PC,ITM1PO ;IN CASE WE GET STOPPED
BIT #GIPBIT,A ;IS IT A GIP
BNE SPRDC2 ;YES, MUST BE A FUPT
JSR PC,DLITEM ;DELETE THE ITEM
RTS PC
SPRDC2: SAVE B
MOV A,B ;COPY THE FUPT
JSR PC,UPTDL ;DELETE IT
REST B ;GET B BACK
RTS PC ;RETURN
.STITL I-O ROUTINES
EWRDI: MOV #WDITAB,F
BR IOTYPE
EWRDO: MOV #WDOTAB,F
BR IOTYPE
EBYTI: MOV #BTITAB,F
BR IOTYPE
EBYTO: MOV #BTOTAB,F
BR IOTYPE
EBLKI: MOV #BKITAB,F
BR IOTYPE
EBLKO: MOV #BKOTAB,F
IOTYPE: JSR PC,RETNSW ;GET THE CAP NO. OF THE IO DEVICE
MOV A,B ;CAP NO.IF IT IS NEGATIVE, WAIT FOR COMPLETION
MOV A,E ;CONTAINS FLAGS IN HIGH BYTE
BIC #177600,B ;CLEAR THE FLAG BITS
MOV ITM1A,A ;START OF SPHERE
JSR PC,GCLSTA ;GET THE CAPABILITY
BEQ IOTYP1 ;FAILED
ADD B,A ;MAKE A POINT TO THE CAP.
MOV A,D ;SAVE POINTER FOR IO ROUTINES
MOV (A),B ;GET FLAGS FOR CALLED ROUTINES
MOVB (A),C ;GET THE TYPE
ASL C ;INDEX
JMP @DOITAB(C) ;DISPATCH ON TYPE
DOIOCC: DOIOCM: DOIOSP: DOIOMS: DOIOPR: DOIOQU: DOIODS: DOIOXX:
IOTYP1: ERROR BCT ;NOT RECOGNIZE I-O CAPABILITY TYPE
;THESE ARE FOR MEANINGLESS OPERATIONS (OUTPUT TO THE TAPE READER)
LPBKI: LPWDI: LPBTI:
TRBKO: TRWDO: TRBTO:
TPBKI: TPWDI: TPBTI: ERROR BFUN ;BAD FUNCTION, FOR THIS DEVICE
;BRANCHES INTO NEXT PAGE
;BRANCHED INTO FROM PREVIOUS PAGE
DOIOTR: JMP @TRIDX*2(F) ;NOTHING TO DO
DOIOTP: JMP @TPIDX*2(F) ;DITTO
DOIOLP: JMP @LPIDX*2(F) ;DITTO
DOIOFA: JMP @DKIDX*2(F) ;THE DISK ROUTINES ARE FIRST IN TABLE
DOIOTT: MOV 2(D),A ;THE TTY ITEM NO.
JSR PC,ITM2LD
CMP ITEM1,TTITM(A) ;DO I CURRENTLY OWN IT
BNE DOIOT1 ;NOPE
JMP @TTIDX*2(F) ;THE TTY ROUTINES ARE SECOND IN TABLE
DOIOT1: JSR PC,LFLUSH ;FLUSH YOURSELF
CMP ITEM1,TTITM(A) ;DO I OWN IT NOW
BNE DOIOT1 ;NO, GO FLUSH YOURSEF AGAIN
JSR PC,RUNME ;I THINK I HAVE GOT THE TTY
BR DOIOTT ;GO TRY AGAIN
DOIOCL: MOV 2(D),A ;THE CORE LINK POINTER
BIT #GIPBIT,A ;IS IT A GIP (MEANS IT IS AN FUPT)
BEQ CLIO1 ;NO, JUST GO AHEAD
SAVE <B,F>
MOV A,B ;POINTER TO FUPT
JSR PC,FUPTLK
JSR PC,SWPIN ;SWAP IT IN
REST <F,B> ;NOW WE WILL GET PC-LOSERED IF IT GOES OUT AGAIN
CLIO1: JMP @CLIDX*2(F) ;THE CORE LINK ROUTINES ARE THIRD IN THE TABLES
.STITL CORE LINK ROUTINES
CLGTBY: TST CLCNT(A) ;ARE THERE ANY BYTES
BEQ CLGTB1 ;NO, RETURN SEZ
MOV CLDATO(A),D ;POINTER TO THE DATA OUT
ADD A,D ;MAKE THE POINTER ABSOLUTE
MOVB (D),D ;GET THE BYTE
DEC CLCNT(A) ;DECREMENT THE BYTE COUNT
INC CLDATO(A) ;INCREMENT THE POINTER
SAVE B ;GET A REGISTER
MOV CLNUM(A),B ;THE NUMBER OF ENTRIES IN BUFFER
ADD #CLDATL,B ;GET THE TOTAL MAXIMUM OFFSET
CMP CLDATO(A),B ;ARE WE AT THE END OF THE BUFFER
BLT 1$
MOV #CLDATL,CLDATO(A) ;RESET THE DATA OUT POINTER
1$: REST B
CLGTB1: RTS PC
CLCHAR: MOV CLCNT(A),B ;GET THE NUMBER OF CHARACTERS LEFT
RTS PC
CLDPBY: CMP CLCNT(A),CLNUM(A) ;ANY SPACE LEFT
BEQ CLGTB1 ;NO
SAVE B
MOV CLDATI(A),B ;THE DATA IN POINTER
ADD A,B ;MAKE THE POINTER ABSOLUE
MOVB D,(B) ;PUT IN THE BYTE
INC CLCNT(A) ;SAY ANOTHER CHARACTER
INC CLDATI(A) ;INCREMENT POINTER TO NEXT
MOV CLNUM(A),B ;GET THE NUMVER OF SLOTS
ADD #CLDATL,B ;GET THE TOTAL OFFSET
CMP CLDATI(A),B ;ARE WE AT THE END
BLT 1$
MOV #CLDATL,CLDATI(A) ;RESET THE POINTER
1$: REST B
RTS PC
CLO: JSR PC,CLDPBY ;DEPOSITE THE BYTE
BEQ CLO1 ;FAILED
RTS PC
CLO1: JSR PC,LFLUSH ;FLUSH YOURSELF
CMP CLCNT(A),CLNUM(A) ;IS IT STILL FULL
BEQ CLO1 ;YES
JSR PC,RUNME
BR CLO
STIOQ: JSR PC,TIOQ ;GET A CHARACTER
BIT #TILIPM,TTYST1(A) ;AM I IN LOGO INPUT MODE
BEQ STIOQ1 ;NO
CLR E ;CLEAR THE WAIT FLAG
STIOQ1: RTS PC
;SET UP LINE MODE
TTLINE: MOV 2(D),A ;LOAD THE TTY
JSR PC,ITM2LD ;LOAD IT UP
SAVE B
MOV #TIHPIT,B
ADD A,B
JSR PC,ACTSET ;SET UP TO BE ACTIVATED
REST B
BIT #TILIPM,TTYST1(A) ;IN LINE MODE?
BEQ TTLIN1 ;NO
TST TIEQTN(A) ;ANY CHARACTERS?
BNE TTLIN1 ;YES, JUST FORGET IT
BIS #TTHANG,TTYST2(A) ;SET THE HANG BIT
TTLIN1: RTS PC
LPOBYT: TST @LPTCSR(A) ;IS THERE AN ERROR?
BPL 1$ ;NO
BIC #100000,@LPTCSR(A) ;CLEAR THE ERROR IF POSSIBLE
ERROR BPN,SV ;PRINTER ERROR ERO
1$: MOV LPTEND(A),E ;POINTER TO THE END OF THE BUFFER
SUB #LPTBUF+1,E ;NUMBER OF SPOTS IN BUFFER-1 SO THAT PRINTER KLUDGE WILL WORK
CMP LPTNUM(A),E ;BUFFER FULL?
BHIS LPOBY1 ;YES
MOV LPTDAI(A),E ;GET THE BUFFER POINTER
ADD A,E ;POINT TO THE BUFFER
MOVB D,(E)+ ;PUT IT IN
SUB A,E ;MAKE IT RELATIVE AGAIN
CMP E,LPTEND(A) ;AT THE END YET
BLO LPOBY2 ;NO
MOV #LPTBUF,E ;RESET THE POINTER
LPOBY2: MOV E,LPTDAI(A) ;POINT TO THE NEXT DATA SLOT
INC LPTNUM(A) ;SAY ONE MORE BYTE THERE
RTS PC
LPOBY1: JSR PC,SFLUSH ;WAIT A WHILE
TST @LPTCSR(A) ;ERROR?
BMI LPOBY3 ;UNFLUSH YOURSELF IF THERE IS
CMP LPTNUM(A),E ;STILL FULL
BHIS LPOBY1 ;NOT EMPTY YET
LPOBY3: JSR PC,RUNME ;FINISHED
BR LPOBYT
LPO: JSR PC,LPOBYT ;OUTPUT THE BYTE
TST LPTMOD(A) ;IN PLOT MODE
BNE PLO ;YES
BIS #40000,@LPTCSR(A) ;SET INTERRUPT ENABLE
RTS PC
PLO: DEC LPTPCT(A) ;DECREMENT THE PLOTTER COUNT
BMI PLO1 ;GOT A BYTE
BNE PLO2 ;NOT DONE WITH THIS LINE
BIS #40000,@LPTCSR(A) ;SET INTERRUPT ENABLE
PLO2: RTS PC
PLO1: CMP LPTPCT(A),#-1 ;WAS THE COUNT 0?
BNE PLO3 ;NO
MOVB D,LPTPCT(A) ;SET IN THE BOTTOM BYTE
BR PLO2 ;DONE FOR NOW
PLO3: INC LPTPCT(A) ;GET BACK BYTE COUNT, BECAUSE WE DEC IT ONCE TO MANY
MOVB D,LPTPCT+1(A) ;SET IN THE TOP OF THE BYTE COUNT
MOV LPTPCT(A),D ;GET THE TOTAL COUNT
MUL LPTMOD(A),D ;GET THE TOTAL LENGTH OF LINE
BVS PLO4 ;OVERFLOW?
CMP D,#LINSIZ ;IS IT LONGER THAN THE LINE
BLOS PLO2 ;NO
PLO4: CLR LPTPCT(A) ;NO BYTES TO BE TRANSFERED ON THIS LINE
SUB #2,LPTDAI(A) ;RESET THE DATA IN POINTER
CMP LPTDAI(A),#LPTBUF ;IS IT BEFORE THE BUFFER
BHIS PLO5 ;NO, FORGET IT
ADD LPTEND(A),LPTDAI(A) ;UNWRAP IT
PLO5: SUB #2,LPTNUM(A) ;TWO FEWER BYTES
ERROR BFUN ;BAD FUNCTION
.STITL TTY AND CORE LINK INPUT ROUTINES
;THIS ROUTINE TAKES A CHARACTER FROM THE TTY POINTED TO BY THE CAPABILITY POINTED TO BY D
;AND PUTS IT ON THE TOP OF THE USERS STACK
TRBTI: SAVE <#TRGTBY,#TRCHAR>
BR TTBTI1 ;LOAD IT UP
CLBTI: SAVE <#CLGTBY,#CLCHAR> ;GET A BYTE
BIT #.CLCONS,B ;AM I THE CONSUMER
BEQ TTBTI4 ;NO, ERROR
BR TTBTI1
TTBTI: SAVE <#STIOQ,#CHARCK>
BIT #.TTYI,B ;DOES HE HAVE INPUT ACCESS
BEQ TTBTI4 ;NOPE
JSR PC,TTLINE ;SET UP LINE MODE
TTBTI1: MOV 2(D),A ;GET THE TTY ITEM NO
JSR PC,ITM2LD ;LOAD IT UP
JSR PC,@(P) ;GET THE NUMBER OF CHARACTERS INTO B
TST B ;EOF?
BMI TTBTI6
CMP B,#1 ;CAN WE GET ONE
BLT TTBTI3 ;NOPE
JSR PC,@2(P) ;GET IT
MOV D,B ;THE CHAR
JSR PC,GIVPSW ;GIVE IT TO THE USER
ADD #4,P
JMP ERETCZ
TTBTI3: MOV (P),C ;GET THE ADDRESS OF THE CHARACTER RETURNING ROUTINE
TTBTI5: TST E ;SHOULD WE WAIT
BMI TTBTI4 ;NOPE
JSR PC,LFLUSH ;GET RID OF YOURSELF FOR A LONG TIME
JSR PC,(C) ;IS THERE A CHARACTER
CMP B,#1 ;ANY CHARACTERS
BLT TTBTI5 ;NO
JSR PC,RUNME ;I CAN GET ONE NOW
BR TTBTI1 ;GO GET IN
TTBTI6: TTBTI4: ADD #4,P
JMP ERETSC
;THIS ROUTINE IS THE SAME AS THE TTBTI, EXCEPT IT RETURNS TWO CHARACTERS
;THE FIRST IN THE LOW ORDER BYTE, AND THE NEXT IN THE TOP ORDER BYTE
TRWDI: SAVE <#TRGTBY,#TRCHAR>
BR TTWDI1
CLWDI: SAVE <#CLGTBY,#CLCHAR> ;GET A BYTE
BIT #.CLCONS,B ;IS HE A CONSUMER
BEQ TTWDI3 ;NO
BR TTWDI1
TTWDI: SAVE <#STIOQ,#CHARCK>
BIT #.TTYI,B ;DOES HE HAVE INPUT ACCESS
BEQ TTWDI3 ;NOPE
JSR PC,TTLINE ;SET UP LINE MODE
TTWDI1: MOV 2(D),A ;THE TTY ITEM NO.
JSR PC,ITM2LD ;LOAD IT UP
TTWDI7: JSR PC,@(P) ;CHECK TO SEE IF THERE ARE ENOUGH
TST B ;EOF?
BMI TTBTI6 ;YES
CMP B,#2 ;2 BYTES LEFT
BLT TTWDI2 ;NOPE
JSR PC,@2(P) ;GET A BYTE
MOV D,B ;SAVE IT
BIC #177400,B ;CLEAR THE HIGH BYTE
JSR PC,@2(P) ;GET ANOTHER BYTE
SWAB D ;PUT IT INTO THE TOP BYTE
BIC #377,D ;CLEAR THE LOWER BYTE
BIS D,B ;PUT THEM BOTH IN THE SAME WORD
JSR PC,GIVPSW ;GIVE THE WORD TO THE USER
ADD #4,P
JMP ERETCZ ;RETURN SUCCESSFUL
TTWDI3: ERROR BAC
TTWDI4: JSR PC,@2(P)
MOV D,B ;THE CHARACTER
JSR PC,GIVPSW ;GIVE THE CHAR TO THE USERR
ADD #4,P
ERETSC: MOV ITM0A,A ;GET THE PROCESS ADDRESS
CLR PUPDLO(A) ;NOTHING GETS POPPED
SEZ!SEC
JMP EMTRET
TTWDI2:
TTWDI5: MOV (P),C ;THE ADDRESS OF THE ROUTINE THAT RETURNS NUMBER OF BYTES
TTWDI6: JSR PC,LFLUSH ;GET RID OF YOURSELF FOR A LONG TIME
JSR PC,(C) ;GET NUMBER OF CHARACTERS
CMP B,#2 ;ENOUGH CHARACTERS YET
BLT TTWDI6 ;NOPE
JSR PC,RUNME ;I THINK I HAVE GOT THEM
BR TTWDI7
;THIS ROUTINE TAKES A BLOCK OF CHARACTER FROM THE TTY, THE FIRST THING ON
;THE STACK IS THE NEGATIVE OF THE BYTE COUNT, THE SECOND IS A POINTER TO WHERE THE DATA
;GOES IN THE USERS D-SPACE
TRBKI: SAVE <#TRGTBY,#TRCHAR>
BR BKICOM
CLBKI: SAVE <#CLGTBY,#CLCHAR> ;GET A BYTE
BIT #.CLCONS,B ;AM I THE CONSUMER
BEQ TBKISZ ;NO LOSER
BR BKICOM
TTBKI: SAVE <#STIOQ,#CHARCK>
BIT #.TTYI,B ;DOES HE HAVE INPUT ACCESS
BEQ TBKISZ ;NO
JSR PC,TTLINE ;SET UP LINE MODE
BKICOM: JSR PC,RETNSW ;GET THE COUNT
MOV A,C ;SAVE IT
BPL TBKISZ ;ITS POSITIVE, WE WANT A NEGATIVE COUNT
JSR PC,RETNSW ;GET THE POINTER
TST C ;COUNT ZERO?
BEQ TBKICZ ;YES, MUST BE FINISHED
MOV A,F ;SAVE IT
ASR A ;SEE IF IT IS AT AN ODD ADRESS
BCC TBKI2 ;IT IS OK
MOV 2(D),A ;THE ITEM NO.
TBKI1: DEC F ;MAKE B POINT TO THE PREVIOUS WORD
MFPD (F) ;GET THE PREVIOUS WORD
SAVE (P)
MTPD (F) ;MAKE SURE WE CAN WRITE IT
JSR PC,ITM2LD
BR TBKI4
TBKI2: MOV 2(D),A ;THE TTY ITEM NO.
TBKI3: MFPD (F) ;MAKE SURE WE CAN WRITE THIS WORD
SAVE (P) ;SAVE IT
MTPD (F) ;MAKE VBERY SURE WE CAN WRITE IT
TBKI11: JSR PC,ITM2LD ;LOAD THE TTY
JSR PC,@2(P) ;CAN I GET A CHAR
CMP B,#1 ;IS THERE ONE
BLT TBKI5 ;FAILED
JSR PC,@4(P) ;GET THE CHARACTER
MOVB D,(P) ;SAVE THE FIRST CHAR
INC C ;INCREMENT THE COUNT
BEQ TBKIRT ;DONE IF ZERO
;BRANCHES INTO NEXT PAGE
;BRANCHES IN FROM ABOVE
TBKI4: JSR PC,@2(P) ;ARE THERE CHAR.
CMP B,#1
BLT TBKI9 ;NOPE
JSR PC,@4(P) ;GET THE CHARACTER
MOVB D,1(P) ;PUT IT IN THE TOP BYTE
MOV ITEM2,A
MTPD (F)+ ;RETURN THE CHARACTERS
INC C ;INC THE COUNT
BEQ TBKICZ ;IF ZERO WE ARE DONE
SAVE <A,B,C,F>
MOV ITM0A,A ;GET THE ADDRESS OF ITEM
MOV PUP(A),B ;THE PDL POINTER
ADD PUPDLO(A),B ;CORRECT IT
MTPD -(B) ;PUT BACK THE POINTER
MTPD -(B) ;PUT BACK THE COUNT
REST <B,A>
BR TBKI3 ;GO BACK FOR MORE
TBKI5:TBKI6: ADD #4,P
JMP ERETSC ;SET THE CARRY AND RETURN
TBKI7: SAVE C
MOV 4(P),C ;THE CHARACTER CHECKING ROUTINE
TBKI8: JSR PC,LFLUSH ;FLUSH YOURSELF
MOV ITM2A,A
JSR PC,(C) ;ANY CHARACTERS
CMP B,#1
BLT TBKI8 ;NOPE
MOV ITEM2,A ;SAVE IT FOR LATER
JSR PC,RUNME ;I THINK I HAVE GOT IT
REST C ;GET BACK RANDOM REG
BR TBKI11 ;GO GET THE CHAR
;BRANCHES INTO NEXT PAGE
;BRANCHES IN FROM ABOVE
TBKIRT: MTPD (F) ;GIVE IT BACK, WITH ONE BYTE CHANGED
TBKICZ: ADD #4,P ;POP OFF GARBAGE
JMP ERETCZ ;RETURN SUCCESSFUL
TBKISZ: ERROR BAC
TBKI9: MTPD (F) ;GIV IT BACK WITH BYTE MODIFIED
INC F ;CORRECT BYTE POINTER
MOV F,B ;GIVE HIM THE POINTER
JSR PC,GIVPSW
MOV C,B ;THE COUNT
JSR PC,GIVPSW ;GIVE IT TO HIM
TST B ;EOF ERROR?
BMI TBKI6 ;YES
SAVE C
MOV ITM0A,C ;POINT TO THE PROCESS
ADD #4,PUPDLO(C) ;CORRECT THE OFFSET
MOV 2(P),C ;THE CHARACTER CHECKING ROUTINE
BR TBKI12
TBKI10:TBKI12: JSR PC,LFLUSH ;FLUSH YOURSELF
MOV ITM2A,A
JSR PC,(C) ;ARE THERE CHARACTERS
CMP B,#1
BLT TBKI10 ;NOPE
MOV ITEM2,A ;SAVE FOR LATER
JSR PC,RUNME ;RUN ME, RUN ME
REST C
JMP TBKI1 ;FIX THE POINTER AND GET THE CHAR
.STITL CORE LINK AND TTY OUTPUT ROUTINES
;THIS ROUTINE TAKES A BYTE OFF THE TOP OF THE USERS STACK AND OUTPUTS IT TO THE TTY
LPBTO: SAVE <#LPO>
BR TTBTO2
TPBTO: SAVE <#TPO>
BR TTBTO2
CLBTO: SAVE <#CLO>
BR TTBTO2
TTBTO: SAVE <#TYO>
BIT #.TTYO,B ;DOES HE HAVE OUTPUT ACCESS
ERRORC EQ,BAC ;BAD ACCESS
TTBTO2: JSR PC,RETNSW ;GET THE CHARACTER TO TRANSMIT
MOV A,F ;SAVE IT
MOV 2(D),A ;THE TTY ITEM NO
JSR PC,ITM2LD ;LOAD IT UP
MOV F,D ;THE CHAR
JSR PC,@(P) ;SEND THE CHARACTER
TST (P)+ ;POP OFF THE ARGUMENT
JMP ERETCZ ;SUCESS
;THIS ROUTINE TAKES A WORD OFF THE USERS STACK AND OUTPUTS IT TO THE TTY
LPWDO: SAVE #LPO
BR TTWDO2
TPWDO: SAVE #TPO
BR TTWDO2
CLWDO: SAVE #CLO
BR TTWDO2
TTWDO: SAVE #TYO
BIT #.TTYO,B ;DOES HE HAVE OUTPUT ACCESS
BNE TTWDO2 ;NOPE
TTWDO1: ERROR BAC
TTWDO2: JSR PC,RETNSW ;GET THE CHARACTERS TO OUTPUT
MOV A,F ;SAVE THEM
TTWDO3: MOV 2(D),A ;THE TTY ITEM NO
TTWDO4: JSR PC,ITM2LD ;LOAD IT
BIT #.TTWD,E ;HAVE WE SENT THE FIRST BYTE YET?
BNE TTWDO5 ;YES
MOVB F,D ;COPY THE BYTE
JSR PC,@(P) ;SEND IT
BIS #.TTWD,E ;FIRST BYTE WRITTEN BIT
MOV F,B ;PUT BACK THE OUTPUT WORD
JSR PC,GIVPSW ;GIVE BACK TO USER
MOV E,B ;PUT FLAGS AND CAP NUMBER BACK THE WAY THEY WERE
JSR PC,GIVPSW ;GIVE BACK TO USER
JSR PC,RETNSW
JSR PC,RETNSW ;THIS IS THE WAY WE WERE CALLED
TTWDO5: SWAB F ;GET THE NEXT CHAR
MOVB F,D ;THE OTHER CHAR
MOV ITM2A,A
JSR PC,@(P) ;SEND IT ALSO
ADD #2,P ;POP THE ADDRESS
JMP ERETCZ ;SUCCESS
;CL AND TTY BLOCK OUTPUT
LPBKO: SAVE #LPO
BR TBKO1
TPBKO: SAVE #TPO
BR TBKO1
CLBKO: SAVE #CLO
BR TBKO1
TTBKO: SAVE #TYO
BIT #.TTYO,B ;DOES HE HAVE OUTPUT ACCESS
BNE TBKO1
TBKOSZ: ERROR BAC
TBKO1: MOV 2(D),A ;THE TTY ITEM
JSR PC,ITM2LD ;LOAD IT UP
JSR PC,RETNSW ;GET THE COUNT
MOV A,C ;SAVE IT
BPL TBKOSZ ;POSITIVE COUNT?
JSR PC,RETNSW ;GET THE POINTER
TST C ;IS THE COUNT 0?
BEQ TBKOCZ ;YES, MUST HAVE FINISHED
MOV A,F ;SAVE IT
MOV ITM2A,A ;GET THE ADDRESS OF THE TTY ITEM
BIT #1,F ;DOES POINTER POINT TO A BYTE?
BEQ TBKO2 ;NO, IT POINTS TO A WORD
DEC F ;MAKE IT POINT TO THE PREVIOUS WORD
MFPD (F) ;GET THE WORD
INC F ;GET BACK TO THE CORRECT POINTER
BR TBKO4 ;PRETEND YOU HAVE ALREADY SENT A CHARACTER
TBKO2:
TBKO3: MFPD (F) ;GET THE TWO CHARACTERS
MOVB (P),D ;THE FIRST CHARACTER
JSR PC,@2(P)
INC F
INC C ;INCREMENT THE COUNT
BEQ TBKORT ;DONE
JSR PC,TBKRSP ;RESET THE POINTERS IN USER SPACE
;BRANCHES INTO NEXT PAGE
;BRANCHES IN FROM ABOVE
TBKO4: MOVB 1(P),D ;THE SECOND CHAR
JSR PC,@2(P) ;PUT THE CHAR IN THE BUFFER
INC F ;THE POINTER
INC C ;INC THE COUNT
BEQ TBKORT ;DONE
JSR PC,TBKRSP ;RESET THE POINTERS IN USER SPACE
TST (P)+ ;POP OFF THE CHARACTERS
BR TBKO3 ;DO IT AGAIN
TBKORT: TST (P)+ ;POP OFF THE CHARACTERS
TBKOCZ: ADD #2,P ;POP OFF THE ROUTINE ADDRESSES
JMP ERETCZ
;THIS SUBROUTINE RESETS THE POINTERS SO THAT IS WE GET PC-LUSERED, WE'RE OK
TBKRSP: SAVE <A,B,C,F>
MOV ITM0A,A ;GET THE ADDRESS OF ITEM
MOV PUP(A),B ;THE PDL POINTER
ADD PUPDLO(A),B ;CORRECT IT
MTPD -(B) ;PUT BACK THE POINTER
MTPD -(B) ;PUT BACK THE COUNT
REST <B,A>
RTS PC
ACSAV: SAVE <E,D,C,B,A>
JMP (F)
ACRES: TST (P)+
REST <A,B,C,D,E>
RTS F
.SBTTL PROCESS HACKING ROUTINES
;CREATE PROCESS AND PUT IT ON THE STOPPED QUQUE
;RETURN ITEM NUMBER IN A AND CLEAR Z IF SUCESSFUL
;OTHERWISE SEET Z
;RETURN ADDRESS OF PROCESS TABLE ENTRY IN B
CRPROC: MOV #PRSLNF,A ;SIZE OF A PROCESS WITHOUT THE FLOATING POINT
JSR PC,CRITEM ;GET AN ITEM FOR IT
BEQ CRPRO1 ;NO ITEM, TOUGH LUCK
JSR PC,CLITEM ;CLEAR IT AND PUT IT IN ITEM0
MOV #ITPROC,(A) ;SET THE TYPE
BIS #PSUPSB,PSTOP(A) ;STOPPED!
INC PSTOPC(A) ;ONE FOR THE BIT
MOV #-1,PSPHRP(A) ;NO SPHERE AS OF NOW
MOV #-1,PITM2P(A) ;NO ITEMS EITHER
MOV #174000,PUPS(A) ;THE USER MODE PS
.IIF NZ TVS, MOV #-1,PTVMAP(A) ;DON'T MAP IN TV
INC NEWPRI ;GET TO NEXT RPOCESS ID #
BNE 1$
INC NEWPRI+2
1$: MOV NEWPRI,PRSID1(A) ;SET THE PROCESS ID
MOV NEWPRI+2,PRSID2(A)
MOV CURUSR,PRSUSR(A) ;CURRENT USER OWNS THIS
JSR PC,CURUIN ;TELL HIM HE OWNS ANOTHER PROCESS
;NOTE THAT CRUSER ENTERS HERE
;AND INTIALIZES THE VARIABLES THAT IT HAS IN COMMON WITH PROCESSES
CRUSR1: INC PRSREF(A) ;PRESUMABLY, THE GUY ASKING FOR IT WILL REFERENCE IT
MOV PFREEQ,PPRTPT(A) ;THE PROCESS BLOCK WE WILL SOON GOBBLE
JSR PC,ITM0PO ;NOW WE POP THE ITEM STACK
MOV PFREEQ,A ;GET A PROCESS TABLE ENTRY
BNE CRPRO2 ;GOT ONE!
MOV B,A ;AFTER ALL THAT WORK
JSR PC,DLITEM ;WE HAVE TO GIVE UP
CRPRO1: SEZ ;FAILURE
RTS PC
CRPRO2: MOV B,PRTPPT(A) ;SAVE THE ITEM # OF THE PROCESS IN THE PROCESS TABLE
MOV #IPRIOR,PRTPRI(A) ;EVERYONE STARTS OUT WITH THIS
SAVE B ;SAVE THE ITEM NUM
MOV CURUSR,B ;THE CURRENT USER BLOCK
CMP #-1,B ;ONLY THE VERY FIRST TIME (I HOPE)
BEQ CRPRO3
MOV PRTJTM(B),PRTJTM(A) ;START HIM AT A DISADVANTAGE
CRPRO3: MOV B,PRTUPT(A) ;THE USER CREATING THIS IS THE PROCESS'S USER
MOV #STOPQ,B ;MOVE FROM THE FREE Q TO THE STOPPED Q
JSR PC,TQUEUE
MOV A,B
POPACZ: REST A ;ITEM NUM
CLZ ;SUCESS
RTS PC
;KEEP THIS NEAR CRPROC
;CREATE A USER
;RETURN ITEM NUMBER IN A, ADDRESS OF PROCESS TABLE ENTRY IN B
;CLEAR Z IF SUCESSFUL, OTHERWISE SET IT
CRUSER: MOV #USRLEN,A ;THE LENGTH OF A USER
JSR PC,CRITEM ;DO IT!
BEQ CRPRO1 ;FAIL
JSR PC,CLITEM ;CLEAR THE ITEM
MOV #ITUSER,(A) ;SET THE TYPE
JSR PC,CRUSR1 ;USE A LOT OF CODE FROM CRPROC
;NOTE THAT THIS WILL LEAVE THE USER ON THE STOP QUEUE
;WHICH WILL CAUSE A PROBLEM IF THE SCHEDULER RUNS
;WHICH IT SHOULDN'T
BEQ CRPRO1 ;FAILURE
SAVE A ;SAVE THE ITEM INDEX
MOV B,A ;THE PROCESS TABLE ADDRESS
MOV #USERQ,B ;THE PLACE WHERE A USER BELONGS
JSR PC,TQUEUE ;TRANSFER TO USER QUEUE
MOV A,B
BR POPACZ ;SUCCESS
;DECREMENT REFERENCE COUNT OF PROCESS IN A
;WIPE IT OUT IFCOUNT REACHES ZERO
USRDEL: ;SAME THING FOR USER
DLPROC: SAVE B
JSR PC,ITM0PL
DEC PRSREF(A) ;ONE LESS REFERENCE
BNE DLPRO1 ;SOMEONE ELSE STILL REFERENCES IT
MOV ITM0A,A
MOV PPRTPT(A),A ;THE PROCESS TABLE ENTRY FOR IT
MOV #PFREEQ,B ;MAKE THE PROCESS TABLE ENTRY FREE
JSR PC,PRSAOD ;DEATVIATE PAGES FOR THIS PROCESS IF ACTIVE
JSR PC,TQUEUE
MOV ITM0A,A ;PROCESS AGAIN
CMP #ITPROC,(A) ;REALLY A PROCESS?
BNE DLPRO2 ;NO, PROBABLY A USER
MOV PRSUSR(A),A ;USER WHO OWNS IT
MOV PRTPPT(A),A ;THE ITEM OF THE USER
JSR PC,USRDEL ;ONE LESS FOR HIM
DLPRO2: MOV ITEM0,A
JSR PC,DLITEM ;FLUSH THE ACTUAL PROCESS
JSR PC,ITM0PO
REST B
SEZ ;SAY YOU DELETED IT
RTS PC
DLPRO1: JSR PC,ITM0PO
REST B
CLZ ;SAY YOU DIDN'T DELETE THE PROCESS
RTS PC
;INCREMENT REFERENC ECOUNT OF CURRENT USER
CURUIN: SAVE A
MOV CURUSR,A ;GET IT
MOV PRTPPT(A),A ;GET THE ITEM
JSR PC,ITM2PL ;LOAD IT
INC USRREF(A) ;INC IT
JSR PC,ITM2PO ;RESTORE
REST A
RTS PC
;TRANFER PROCESS TABLE ENTRY IN A
;FROM IT'S PRESENT QUEUE TO THE ONE IN B
TQUEUE: SAVE <C,PS>
SPL 7
;MUST SPL 7 HERE IF THE INT LEVEL LOOKS AT QUEUES BACKWARDS
MOV (A),C ;THE FORWARD POINTER OF THE ENTRY TO BE MOVED
MOV C,@PRTBCK(A) ;CORRECT THE FORWARD POINTER OF THE PREVIOUS ENTRY
TST C ;IS THERE A NEXT ENTRY?
BEQ 2$ ;NO, DON'T DO ANYTHING TO IT!
MOV PRTBCK(A),PRTBCK(C) ;CORRECT THE BACK POINTER OF THE NEXT ENTRY
;MAY SPL 0 HERE, THE ENTRY IS IN LIMBO FOR THE TIME BEING
2$: MOV (B),C ;GET THE CONTENTS OF THE QUEUE POINTER
MOV C,(A) ;POINT THE THING BEING MOVED AT THE BEGGINING OF THE QUEUE
MOV B,PRTBCK(A) ;CORRECT BACK POINTER OF THING WE ARE MOVING
;SPL 7 HERE IF YOU DID ABOVE
TST C ;IS THERE AN OLD FIRST ENTRY?
BEQ 1$ ;NO, DON'T DO ANYTHING TO IT!
MOV A,PRTBCK(C) ;FIX BACK POINTER OF OLD FIRST ENTRY ON NEW QUEUE
1$: MOV A,(B) ;FIX QUEUE POINTER ITSELF
;SPL 0
SAVE A
MOV PRTPPT(A),A ;GET THE ITEM NUMBER OF THE THING
JSR PC,ITM0PL
MOV QBIT(B),PQBIT(A) ;SET THE RIGHT Q-BIT
JSR PC,ITM0PO
REST A
REST <PS,C>
RTS PC
;PUT THE PROCESS WHO'S ITEM IS IN A
;INTO THE SPHERE WHOS ITEM IS IN B
;SHOULD FAIL FOR RUNNING PROCESS OR TOO MANY PROCESSES IN SPHERE (NOT YET)
;CLEARS Z ON SUCESS
PUTPRS: SAVE <A,B>
JSR PC,ITM0PL ;PUT THE PROCESS INTO ITEM 0
TST PSTOPC(A) ;IS IT STOPPED?
BEQ PUTPR2 ;NO, CAN'T MOVE IT THEN
JSR PC,REMPRS ;GET IT OUT OF ANY SPHERE IT IS IN
MOV (P),A ;GET THE SPHERE INDEX
JSR PC,ITM1PL ;LOAD IT UP
MOV ITM0A,B ;ADDRESS OF THE PROCESS
MOV SPHPRP(A),PSPHCP(B) ;POINT PROCESS TO BEG OF OLD LIST
MOV (P),PSPHRP(B) ;TELL PROCESS WHO IT BELONGS TO
MOV 2(P),SPHPRP(A) ;LINK IT INTO THE LIST
INC SPHPRC(A) ;ONE MORE PROCESS
INC PRSREF(B) ;INCREMENT THE REFERENCE COUNT
REST <B,A>
JSR PC,ITM0PO
JSR PC,ITM1PO
CLZ
RTS PC
PUTPR2: JSR PC,ITM0PO ;POP ITEM 0
REST <B,A>
SEZ ;SAY WE CAN'T DO IT
RTS PC
;REMOVE PROCESS IN ITEM0 (ADDRESS IN A) FROM WHATEVER SPHERE IT IS IN
;CLOBBERS B AND A
REMPRS: MOV PSPHRP(A),A ;POINTER TO SPHERE THIS BELONGS TO
BLE REMPR1 ;WHEW, NO SPHERE, IT'S EASY
JSR PC,ITM1PL ;GET THE SPHERE IT'S IN
MOV ITM0A,B ;ADDRESS OF THE PROCESS ITEM
CMP SPHPRP(A),ITEM0 ;DOES IT POINT DIRECTLY TO THE PROCESS?
BNE REMPR3 ;NO, GO SEARCH FO RIT
MOV PSPHCP(B),SPHPRP(A) ;SPLICE IT OUT OF THE LIST
BR REMP10 ;SKIP THIS LOAD
REMPR5: MOV PSPHRP(A),A ;GET THE SPHERE BACK
JSR PC,ITM1LD ;LOAD IT UP
REMP10: BIT #FAULT1!FAULT2!FAULT3,SFLAG(A) ;WAS IT STOPPED FOR FAULT
; BEQ REMPR9 ;NO
BR REMPR9 ;WELL BRUCE, I DON'T KNOW WHAT THIS CRAP IS FOR!!-RON
DEC PSTOPC(B) ;RESTART IT
BIC #PSPHSB,PSTOP(B) ;CLEAR THE SPHERE STOPPING IT BIT.
BGT REMPR8 ;WAS STOPPED FOR ANOTHER REASON
INC PSTOPC(B) ;STOP IT AGAIN BUT SAY SUPERIOR STOPPED IT
BIS #PSUPSB,PSTOP(B) ;OKAY FOR NOW
REMPR8: ADD #PFAULT,B ;POINT TO THE FIRST PHAULT WORD
TST (B)+ ;CHECK THE THREE PHAULT WORDS
BNE REMPR7
REMPR9: JSR PC,ITM1PO ;RESTORE ITEM 1
MOV ITM0A,A ;ADDRESS OF PROCESS
CLR PSPHRP(A) ;NO LONGER IN SPHERE
MOV ITEM0,A ;THE PROCESS
JSR PC,DLPROC ;DECREMTENT THE REF COUNT AND DELETE IF 0
REMPR1: RTS PC
REMPR7: MOV ITEM1,A ;THE SPHERE TO DO THE DEED ON
JSR PC,FALTFX ;FIX THE FAULT
CLR -(B) ;CLEAR THE FAULT WORDS
BR REMPR9 ;DONE
REMPR3: DEC SPHPRC(A) ;ONE LESS PROCESS
MOV SPHPRP(A),A ;GET THE FIRST PROCESS IN LINE
REMPR6: BUGC EQ ;IS THERE ANOTHER ONE?
JSR PC,ITM1LD ;PUT THIS PROCESS INTO ITEM1
CMP PSPHCP(A),ITEM0 ;DOES IT POINT TO PROCESS WE WANT TO SPLICE OUT?
BNE REMPR4 ;NOPE, KEEP TRYING
MOV ITM0A,B
MOV PSPHCP(B),PSPHCP(A) ;SPLICE IT OUT OF THE LIST
BR REMPR5 ;NOW WE CAN PUT IT WHERE WE WANT TO
REMPR4: MOV PSPHCP(A),A ;GET NEXT ONE
BR REMPR6 ;GO CHECK IT OUT
;DECREMENT STOP COUNT OF PROCESS
;IF IT REACHES ZERO, PUT PROCESS ONTO RUN Q
;ASSUMES PROCESS IS LOADED INTO ITEM 0
PSTPDC: SAVE A
JSR PC,ITM0PL
DEC PSTOPC(A) ;ONE LESS REASON TO BE STOPPED
BUGC LT ;SHOULD NOT GET NEGATIVE!
BGT PSTPD1 ;DON'T START IT YET
SAVE <B,C>
MOV PPRTPT(A),A ;POINTER TO THE PROCESS TABLE
MOV #ACTQ,B ;START HIM UP AT AN ADVANTAGE
JSR PC,PRSAOD
JSR PC,TQUEUE
REST <C,B>
PSTPD1: JSR PC,ITM0PO
REST A
RTS PC
;INCREMENT STOP COUNT OF PROCESS WHOSEITEM ISIN A
;IF THE COUNT WAS ZERO AND THE PROCESS WAS IN THE SYSTEM, PCLOSER IT
PSTPIN: JSR F,ACSAV
JSR PC,ITM0PL ;GET IT INTO THE MAP
TST PSTOPC(A) ;IS IT ALREADY NON-ZERO?
BNE PSTPI1 ;YES, JUST INCREMENT
MOV PPRTPT(A),A ;IT'S PROCESS TABLE ENTRY
MOV #STOPQ,B ;STOP THE PROCESS
JSR PC,PRSAOD ;DEACTIVE PAGES OF THIS PROCESS
JSR PC,TQUEUE
.IFNZ NPC
JSR PC,PRSRPC ;PCLOSER IT
.IFF
MOV ITM0A,A
TST PSPC(A) ;IN THE SYSTEM?
BEQ PSTPI1 ;NOPE, PC ISUSER MODE PC
CLR PSPC(A) ;CLEAR HIS PC
JSR PC,PRSUNL ;UNLOCK HIS SWITCHES
.ENDC
PSTPI1: INC PSTOPC(A) ;TELL THE WORLDHE IS STOPPED
JMP ACRTP0 ;POP 0 AND RESTORE REGISTERS
PRSRPC: CMP PRUNNG,ITEM0 ;NOT ADVISABLE TO DO THIS TO RUNNNG PROCESS
BUGC EQ
MOV ITM0A,A
TST PSPC(A) ;IN THE SYSTEM?
BEQ 1$ ;NOPE, PC ISUSER MODE PC
CLR PSPC(A) ;CLEAR HIS PC
JMP PRSUNL ;UNLOCK HIS SWITCHES
1$: RTS PC
;UNLOCK ALL THE SWITCHES OF THE GUY IN ITEM0
;IN "BEING PCLOSERED" MODE
;CAN BE EXPECTED TO CLOBBER MOST REGISTERS
PRSUNL: SAVE BPCLSR ;SAVE THE FLAG
MOV #1,BPCLSR ;SAY WE ARE PCLOSERING HIM
PSTPI2: MOV ITM0A,A
TST PLCKSL(A) ;ANY SWITCHES LOCKED
BEQ PSTPI3 ;NOPE
JSR PC,LSWPOP ;POP THE TOP SWITCH
BR PSTPI2
PSTPI3: REST BPCLSR ;DONE PCLOSERING HIM
RTS PC
;THIS IS WHERE WE GET AFTER SOMEONE SETS PIRQ AND PIRBRK DISPATCHES
;(NOTE THAT WE DON'T GET TO PIRBRK UNTIL ALL INTERUPTS HIGHER
;THAN CLKL HAVE EXITED. CLKL SHOULD BE THE LOWEST INTERUPT IN
;THE SYSTEM, SO IT ALWAYS INTERRUPTS DIRECTLY FROM
;THE MAIN PROGRAM LEVEL)
;STOP A PROCESS IF IT IS IN USER MODE
;IF IT FINDS THE PROCESS
;WAS IN USER MODE, IT ASSUMES THAT THE SECOND REGISTER SET
;WAS BEING USED, AND CLOBBERS SET 0 ARBITRAILY
;IT SAVES THE PROCESSES REGISTERS, THEN RETURNS TO WHOMEVER STARTED
;THE PROCESS BY DOING AN RTS PC
STOPPR: TST USRMOD ;ARE WE IN USER MODE?
BNE PIRRET ;NOPE, THE SYSTEM WILL STOP HIM
MOV PC,USRMOD ;NO LONGER IN USER MODE
TST (P)+ ;FLUSH THE SAVED A
JSR F,SPCPSP ;SAVE THE PC, THE PS AND P
JSR PC,PACSAV ;SAVE THE REST OF THE REGISTERS, INCLUDING THE FPP
JSR PC,SAVAWB ;SAVE THE A AND W BITS
JSR PC,TIMEUS ;GO CHARGE HIM FOR TIME USED
MOV #-1,PRUNNG ;NO PROCESS RUNNING NOW
CLR CDISP ;NO ONE AROUND
RTS PC ;(GULP!!) RETURN TO CALLER
PIRRET: REST A
CHECKP
RTT
;CHARGE USER FOR THE TIME HE HAS USED
;EXPECTS POINTER TO ITEM0 IN A. CLOBBERS B AND C
;AND SPHERE IN ITEM1
TIMEUS: MOV TUSED,B ;NUMBER OF TICKS HE USED
ASL B ;CONVERT TO HALF TICKS
BNE 1$ ;DID HE USE ANY TIME?
INC B ;EVERYONE USES AT LEAST ONE HALF-TICK
1$: ADD B,PTUSED(A) ;UPDATE HIS TIME USED
ADC PTUSED+2(A)
MUL #JTMUAC,B ;MULTIPLY BY THE ADDTIVE FACTOR
MOV PPRTPT(A),C ;POINTER TO PROCESS BLOCK
ADD B,PRTJTM(C) ;UPDATE THE PROCESS JTMU
MOV PRTUPT(C),C ;POINTER TO THE USER BLOCK
ADD B,PRTJTM(C) ;UPDATE THAT JTMU TOO
RTS PC
;ENTER THE RUNNING QUEUE
RUNME: TST ACTCHK
BNE RUNME1
SAVE <#ACTQ> ;PROPABLY WANT TO GO TO ACTIVE QUQUE FROM DORMANT
SAVE A
MOV ITM0A,A ;POINT TO PROCESS
BIT #DORQB,PQBIT(A) ;WAS IT DORMANT?
BNE FLUSH5 ;YES, GO TO ACTIVE STATE
MOV #RUNQ,2(P) ;NO, GO TO RUN STATE
BR FLUSH5
RUNME1: SAVE <#WINQ> ;I'M BEING ACTIVATED SO PUT ME ON WINQ
BR FLUSH
;ENTER THE SHORT FLUSHED QUEUE
SFLUSH:LFLUSH: ;ENTER A HANGING QUQUE
SAVE #DORQ ;IF WE ARE ALREADY RUNNING, BECOME DORMANT
SAVE A
MOV ITM0A,A ;POINT TO PROCESS
TST PSPC(A) ;ALREADY FLUSHED?
BEQ FLUSH5 ;NO, BECOME DORMANT
BIT #DORQB,PQBIT(A) ;DORMANT BEFORE?
BNE FLUSH5 ;STAY THAT WAY
MOV #IACTQ,2(P) ;STAY INACTIVE
BR FLUSH5
FLUSH: SAVE A ;GET A FREE REGISTER
MOV ITM0A,A ;THE RUNNING PROCESS IS ALWAYS ITEM 0
FLUSH5: ADD #PSREGS,A ;A POINTER TO THE SYSTEM REGISTERS FOR THE GUY
TST BPCLSR ;IS THIS GUY BEING PCLOSERED?
BUGC NE ;SHOULD NEVER HANG!
REST (A)+ ;GET BACK A
.IRPC X,<BCDEF>
MOV X,(A)+
.ENDM
MOV ITM0A,E
MOV PPRTPT(E),A ;POINTER TO PROCESS TABLE
MOV (P),B ;QUEUE TO MOV IT TO
JSR PC,PRSAOD ;ACTIVATE OR DEACTIVE PAGES IF APPROPRIATE
JSR PC,TQUEUE ;DO THE ACTUAL MOVE
MOV ITM0A,A
REST <B,E> ;GET THE QUEUE AGAIN
TST PSPC(A) ;WERE WE ALREADY FLUSHED?
BNE FLUSH2 ;YES
.IRPC X,<01>
TST ITM'X'D
BUGC NE ;HAD ITEMS PUSHED
.ENDM
CLR CDISP ;OLD GUY NOT RUNNING ANY MORE
JSR PC,PACSAV ;IN CASE USER'S REGISTERS NOT SAVED YET
JSR PC,TIMEUS ;CHARGE HIM FOR TIME USED
JSR PC,SAVAWB ;SAVE REFERENCED PAGES
JSR PC,PDLSAV ;SAVE THE SYSTEM PDL
MOV ITM1A,A ;POINT TO THE SPHERE
MOV SPRTPT(A),A ;POINT TO THE PROCESS TABLE ENTRY
FLUSH2: MOV ITM0A,A
MOV A,B ;COPY POINTER INTO ITEM
ADD #PITM2P+2,A ;POINT TO ITEM2 PDL
MOV ITM2D,C ;COUNT OF ITEMS PUSHED ON ITEM2 STACK
MOV C,PITM2C(B)
BEQ FLUSH4 ;NONE, EASY CASE
ASL C ;MAKE COUNT INTO INDEX
CMP #PIT2PL-2,C ;CHECK THAT THERE AREN'T TOO MANY PUSHED
BUGC LT
ADD C,A ;POINT TO END OF PDL AREA TO BE USED
ASR C ;CONVERT BACK TO COUNT
FLUSH3: MOV ITEM2,-(A) ;SAVE CURRENTLY LOADED ITEM
JSR PC,ITM2PO ;POP NEXT ONE
SOB C,FLUSH3
FLUSH4: MOV ITEM2,-(A) ;SAVE THE LAST ONE
MOV #-1,A ;DUMMY ITEM
JSR PC,ITM2LD ;LOAD TO FORCE W BITS ON ITEM2
MOV E,PSPC(B)
RTS PC
;START THE PROCESS WHOSE PROCESS TABLE ENTRY IS
;POINTED TO BY A
;WHEN PROCESS FINALLY STOPS, THE ROUTINE WILL RETURN
;CLOBBERS ALL REGISTERS
STPROC: MOV HSECS,LTPSTA ;SAVE THE LAST TIME A PROCESS WAS STARTED
MOV P,STPSVP ;SAVE P FOR ERROR RECOVERY
BIS #30000,PS ;MAKE SURE PREVIOUS MODE IS USER
SPL CLKL ;STOP US FROM GETTING STOPPED
BIC #CLKPIR,PIRQ ;MAKE SURE NO STOP PENDING
MOV PRTUPT(A),CURUSR ;THE GUY TO "CHARGE" FOR THIS RUN
CLR TUSED ;START COUNTING NOW
MOV PRTPPT(A),A ;GET THE PROCESS ITEM #
MOV A,PRUNNG ;THIS IS THE RUNING PROCESS
MOV A,CDISP ;SAY WHICH PROCESS IS RUNNING
JSR PC,ITM0LD ;IT IS EXPECTED TO BE IN ITEM0
MOV A,B ;SAVE THE POINTER TO IT
MOV PSPHRP(B),A ;GET A POINTER TO THE SPHERE
JSR PC,ITM1LD ;IT IS EPECTED IN ITEM1
JSR PC,PACRES ;RESTORE REGISTER SET 1
JSR PC,MAPRES ;RESTORE THE MAP
SAVE PUP(B) ;GET THE USER'S PDL POINTER
MTPI P ;RESTORE IT TO HIM
TST PSPC(B) ;IS HE RUNNING IN THE SYSTEM?
BNE STPRO1 ;YES, GO RESTORE OTHER THINGS
STPRO3: BIC #PPCLDF!PPCLSR!PFALTB,PFLAGS(B) ;THEN HE DOESN'T NEED TO BE PCLOSERED!
TST PFAULT(B) ;IS THERE A FAULT?
BEQ 1$ ;NO, JUST RETURN TO HIM
JMP CFAULT ;CAUSE THE MAGIC FAULT TO HAPPEN
1$: MOV P,PSP(B) ;WHERE THE PDL ENDS
SAVE <PUPS(B),PUPC(B)> ;HIS PROCESSOR STATUS AND HIS PROGRAM COUNTER
CLR USRMOD ;THE WORLD IS NOW IN USER MODE
CHECKP
RTT ;RETURN TO HIM IN USER MODE
STPRO1: BIT #PPCLSR,PFLAGS(B) ;SHOULD HE BE PCLOSERED?
BEQ STPRO2 ;NO
BIT #PPCLDF,PFLAGS(B) ;DEFERED?
BNE STPRO2 ;YUP
CLR PITM2C(B) ;FLUSH THE ITEM STACK
CLR PSPC(B)
MOV PC,BPCLSR ;HE'S BEING PCLOSERED
JSR PC,LSWCLR ;CLEAR THE SWITCHES
CLR BPCLSR
BR STPRO3 ;GO START IT IN USER MODE
STPRO2: JSR F,PDLRES ;RESTORE HIS SYSTEM PDL
MOV B,A ;POINTER TO PROCESS
JSR PC,ITM2RS ;RESTORE ITEM 2 PDL
SAVE <#30000,PSPC(B)> ;GET PS AND GET PC
MOV (P),OPSPC(B) ;SAVE FOR DEBUGGING
CLR PSPC(B) ;INDICATE NOT HUNG
MOV PC,USRMOD ;INDICATE THAT WE ARE NOT IN USER MODE
MOV B,A ;POINTER TO THE PROCESS
ADD #PSREGS+14,A ;THE SYSTEM REGISTERS
.IRPC X,FEDCBA
MOV -(A),X
.ENDM
CHECKP
RTT ;EXIT TO RIGHT PLACE IN THE SYSTEM
;SAVE THE USER'S PC, PS AND PDL POINTER
;CALL WITH JSR F,SPCPSP
;A GETS CLOBBERED TO ITEM 0 ADDRESS
;F GETS CLOBBERED TO VALUE OF THE USER'S P
;ITEM0 IS EXPECTED TO BE THE PROCESS
SPCPSP: TST (P)+
MOV ITM0A,A ;THE ADDRESS OF THE PROCESS IN THE MAP
REST <PUPC(A),PUPS(A)> ;SAVE HIS PC AND HIS PS
SAVEPP: MOV #30000,PS ;MAKE SURE PREVIOUS MODE IS RIGHT
MOV ITM0A,A
MFPD P ;GET HIS P
MOV (P),PUP(A) ;SAVE HIS PDL POINTER (PUP-P?)
RTS F ;RETURN WITH P IN F
;SAVE THE PROCESSES REGISTERS, INCLUDING THE FPP IF THAT IS ENABLED
;THE GENERAL REGISTERS ARE IN SET 1
;THE ADDRESS OF THE PROCESS ITEM IS EXPECTED IN A
;THE PROCESS ITEM IS EXPECTED TO BE IN THE MAP
PACSAV: SAVE A ;TO COMMUNICATE WITH THE OTHER REGISTER SET
BIT #PACSVF,PFLAGS(A) ;HAVE THE AC'S ALREADY BEEN SAVED?
BEQ PACSV2 ;ZERO=>SAVED
BIC #PACSVF,PFLAGS(A)
BIS #4000,PS ;CHANGE TO OTHER SET
SAVE A ;SAVE A OF SET 1
MOV 2(P),A ;GET A FROM SET 0
ADD #PUREGS,A ;POINT TO PALCE TO SAVE REGISTERS
REST (A)+ ;SAVE A OF SET 1
MOV B,(A)+ ;SAVE REST OF SET 1
MOV C,(A)+
MOV D,(A)+
MOV E,(A)+
MOV F,(A)+
BIC #4000,PS ;BACK TO SET 0
;NOTE THAT SET 0'S A HAS NOT BEEN CLOBBERED
BIT #PFPFLG,PFLAGS(A) ;HAS HE ENABLED THE FPP?
BEQ PACSV1 ;NOPE
STFPS PFPPS(A) ;STORE THE STATUS
ADD #PFPPRG,A ;POINT TO FPP REGISTERS
SETD ;SO WE SAVE ALL THE BITS
STD A,(A)+
STD B,(A)+
STD C,(A)+
STD D,(A)+ ;SAVE ALL WE CAN GET TO DIRECTLY
LDD E,A ;LAST 2 HAVE TO BE MOVED SPECIAL
STD A,(A)+
LDD F,A
STD A,(A)+
PACSV1: MOV (P),A ;POINT BACK TO THE ITEM START
BIT #PTVFLG,PFLAGS(A) ;SAVING TV REGISTERS?
BEQ PACSV2
MOV TVMSK,PTVMSK(A)
MOV TVINCR,PTVINC(A)
MOV TVSHR,PTVSHR(A)
MOV TVRADR,PTVRAD(A)
PACSV2: REST A
RTS PC
;RESTORE THE USER'S REGISTERS
;B IS EXPECTED TO CONTAIN A POINTER TO THE PROCESS ITEM
;NO REGISTERS ARE CLOBBERED (EXCEPT, OF COURSE, THE USER'S)
PACRES: SAVE B
BIT #PACSVF,PFLAGS(B) ;WERE THEY EVER SAVED?
BNE PACRS1 ;ONE=>NOT SAVED
BIS #PACSVF,PFLAGS(B)
BIS #4000,PS ;GO TO REGISTER SET 1
MOV (P),A ;GET THE POINTER TO THE ITEM
ADD #PUREGS+14,A ;CONVERT TO A REGISTER POINTER
.IRPC X,<FEDCBA>
MOV -(A),X
.ENDM
BIC #4000,PS ;BACK TO SET 0
BIT #PFPFLG,PFLAGS(B)
BEQ PACRS2 ;DOESN'T USE FPP
SETD ;RESTORE ALL BITS
ADD #PFPPRG+<16.*2>,B ;POINT TO REGISTERS E AND F FIRST
LDD (B)+,A
STD A,E
LDD (B)+,A
STD A,F
MOV (P),B
ADD #PFPPRG,B ;GO BACK FOR REG'S A THROUGH D
.IRPC X,<ABCD>
LDD (B)+,X
.ENDM
MOV (P),B
LDFPS PFPPS(B)
PACRS2: BIT #PTVFLG,PFLAGS(B)
BEQ PACRS1
MOV PTVMSK(B),TVMSK
MOV PTVINC(B),TVINCR
MOV PTVSHR(B),TVSHR
MOV PTVRAD(B),TVRADR
MOVB #73,TVSHR+1 ;SET THE THING INTO MEMORY
PACRS1: REST B
RTS PC
;RESTORE THE USER'S SYSTEM PDL
;CALLED WITH JSR F,PDLRES
;CLOBBERS A AND C AND F
;AS WELL AS PUSHING THINGS ONTO P
;EXPECTS A POINTER TO THE PROCESS ITEM IN B
PDLRES: TST (P)+
MOV PSP(B),A ;THE INCREMENT FOR THE STACK POINTER
MOV P,PSP(B) ;FOR PDLSAV, THE VALUE IT SHOULD HAVE AFTER SAVING
ASR A ;CONVERT TO COUNT
BEQ PDLRE1 ;NONE, DON'T LOOP
MOV B,C ;COPY POINTER TO ITEM
ADD #PPDL,C ;MAKE IT A POINTER TO THE PDL
PDLRE2: MOV (C)+,-(P) ;POP-PUSH
SOB A,PDLRE2
PDLRE1: JMP (F)
;SAVE THE SYSTEM PDL INTO THE PROCESS'S
;SYSTEM PDL AREA. SAVES UP TO WHAT IS INDICATED BY PSP
;CALLED WITH JSR PC,PDLSAV
;CLOBBERS A,B,C, AND F
;ALSO POPS STUFF OFF THE STACK
PDLSAV: REST F ;GET THE RETURN ADDRESS
MOV ITM0A,A ;GET A POINTER TO THE PROCESS
MOV PSP(A),B ;WHAT THE PDL POINTER SHOULD BE
MOV B,C
SUB P,B ;WHAT'S THE DIFFERENCE?
MOV B,PSP(A) ;SAVE THE OFFSET
BEQ PDLSA1 ;NONE, FORGET IT
BUGC LT ;MAKE SURE IT'S POSITIVE
CMP #PRPDLL,B ;IS IT PUSHED TO DEEP?
BUGC LE ;NAUTGHY!
ADD A,B ;MAKE A POINTER TO THE END OF
ADD #PPDL,B ;THE PROCESS'S PDL
PDLSA2: MOV (P)+,-(B) ;POP-PUSH
CMP C,P ;ARE WE DONE YET?
BNE PDLSA2 ;NOPE
PDLSA1: JMP (F)
;RETURN THE NEXT WOR DFROM THE USER'S PDL
;INCREMENT THE POP COUNT SO IT IS POPED IF THE CALL RETURNS
;THE WORD IS RETURNED IN A
RETNSW: SAVE B
MOV ITM0A,A ;ASSUME THE PROCESS IS ITEM 0
RETNS1: MOV PUP(A),B ;THE PDL POINTER
ADD PUPDLO(A),B ;THE OFFSET SO FAR
ADD #2,PUPDLO(A) ;POPPED ONE MORE THING
MFPD (B) ;GET THE WORD
MOV (P),A ;SAVE THE WORD
MTPD (B) ;MAKE SURE WE CAN WRITE IT BACK
REST B
RTS PC
;RETURN THE PREVIOUS WORD FROM THE USER'S STACK (THE ONE YOU GOT ALREADY)
;RETURNED IN A
RETPSW: SAVE B
MOV ITM0A,A
SUB #2,PUPDLO(A) ;BACK UP!
BR RETNS1 ;GO DO THE REST
:GIVE THE WORD IN B TO THE USER
GIVPSW: SAVE <A,C>
MOV ITM0A,A ;ASSUME PROCESS IS IN ITEM0
MOV PUP(A),C ;THE PDL POINTER
SUB #2,PUPDLO(A) ;DEC THE OFFSET
ADD PUPDLO(A),C ;MAKE IT CORRECTED
MFPD (C) ;TO COMPENSATE FOR PAGE LOSSAGE
MOV B,(P) ;WORD TO TRANSFER TO USER
MTPD (C) ;MOVE THE WORD
REST <C,A> ;RESTORE REGS
RTS PC
.SBTTL SPHERE HACKING ROUTINES
;CREATE A SPHERE
;RETURN THE INDEX OF THE ITEM IN A
CRSPHR: SAVE B
MOV #SPHLEN,A ;THE LENGTH OF A SPHERE (INITIALLY)
JSR PC,CRITEM ;MAKE ONE
BNE CRSPH1 ;DID IT SUCEED?
CRSPH0: REST B
SEZ ;INDICATE FAILURE
RTS PC ;NOPE
CRSPH1: JSR PC,CLITEM ;LOAD IT INTO ITEM0 AND CLEAR IT
MOV #ITSPHR,(A) ;SET THE TYPE
JSR PC,CURUIN ;INCREMENT THE CURENT USER
MOV CURUSR,SUSRPT(A) ;THE GUY WHO CREATES IT GETS "CHARGED" FOR IT
MOV #SICLST+<NCLSEB*CLSELN*2>,SCLSEP(A) ;THE LAST LOCATION USED
SAVE <C,B>
MOV A,B
ADD #SCLSTT,B ;GET AN ADDRESS POINTER TO THE INDEX TABLE
MOV #<MNCLSE/NCLSEB>/2,C ;NUMBER OF WORDS OF POINTERS
1$: MOV #-1,(B)+
SOB C,1$ ;INTIALIZE THEM TO POINT AT NOTHING
MOVB #1,-(B) ;EXPECT THE LAST ONE POINTS AT THE 2ND BLOCK
CLRB SCLSTT(A) ;AND THE FIRST TO THE FIRST
MOV CURSPH,SMSSPT(A)
MOV (P),B ;GET THE ITEM INDEX BACK
JSR PC,CRUSR1 ;INITIALIZE THE PROCESS TABLE ENTRY
BEQ CRSPH2
MOV B,A ;THE PROCESS TABLE ENTRY
MOV #SPHRQ,B ;THE PLACE TO PUT IT
JSR PC,TQUEUE ;MOVE IT
REST A ;THE ITEM #
REST C
REST B ;THE ORIGINAL CONTENTS OF B
CLZ ;SUCECESS
RTS PC
CRSPH2: REST <A,C>
BR CRSPH0
;SAVE THE A AND W BITS FOR THE CURRENT SPHERE
;THE SPHERE IS EXPECTED TO BE IN ITEM1, AND THE USER
;SEGMENTATION REGISTERS ARE EXPECTED TO REFLECT THIS SPHERE
SAVAWB: JSR F,ACSAV
.IFNZ NTVS
MOV ITM0A,A ;POINTER TO PROCESS
MOVB TVSEL,PTVMAP+1(A) ;SAVE VALUE OF SELECT REGISTER
.ENDC
MOV ITM1A,A ;ADDRESS OF ITEM1 IN THE MAP
ADD #SUPTS,A ;POINT TO THE UPTS DR
MOV #USRISD,B ;THE ACTUAL SEGMENTATION REGISTERS
MOV #20,C ;NUMBER OF SEGMENTS
SAVAW1: BIT #100,(B)+ ;THE SEGMENTER'S DR, W BIT
BEQ SAVAW2 ;NOT WRITTEN, CAN IGNORE IT
BIC #100,-2(B) ;FLUSH THE W BIT
TST (A) ;IS THE PAGE STILL THERE?
BEQ SAVAW2 ;NOPE, DELETED
BIT #7,-2(B) ;REAL PAGE?
BEQ SAVAW2 ;NOPE
BIT #UPTABS,(A) ;IS IT AN ABS PAGE?
BEQ 1$ ;NOPE, DO YOUR THING
BIS #100,4(A) ;SAVE THE W BIT IN THE GUYS DR, JUST FOR FUN
BR SAVAW2
1$: MOV UPTPBP(A),D ;GET PB POINTER
BIC #PBVASS!PBVAS,PBFLAG(D) ;NO LONGER VALID AT SOURCE OR SWAP SPACE
SAVAW2: ADD #UPTLEN,A ;TO THE NEXT UPT ENTRY
SOB C,SAVAW1
MOV #-1,CURSPH ;NO SPHERE MAPPED IN NOW!
JMP ACRET
.SBTTL SPHERE HACKING ROUTINES- C-LIST HANDLERS
;GET ADDRESS OF A C-LIST ENTRY
;A CONTAINS ADDRESS OF SPHERE IN MAP
;B CONTAINS C-LIST NUMBER
;B RETURNS OFFSET INTO SPHERE IF SUCESSFUL (Z CLEAR)
;OTHERWISE Z SET AND B CONTAINS SPHERE BYTE ADDRESS OF INDEX BYTE
GCLSTA: SAVE <D,C,A>
CMP B,#200 ;IS IT TO LARGE?
BHIS GCLST1 ;YES
CLR C ;FOR THE DIVIDE
MOV B,D ;SAVE C-LIST NUMBER
DIV #NCLSEB,C ;GET THE BLOCK AND OFFSET
ADD C,A ;CONVERT TO
ADD #SCLSTT,A ;ADDRESS OF INDEX BYTE
MOVB (A),B ;GET THE BYTE
BLT GCLST1 ;NEGATIVE IMPLIES NO STUCK BLOCK
MUL #NCLSEB*CLSELN,B ;RELATIVE ADDRESS OF BLOCK
MUL #CLSELN,D ;REMANDER
ADD D,B ;NOW WITHIN BLOCK
ADD #SICLST,B ;LESS RELATIVE
REST <A,C,D>
CLZ ;SUCESS
RTS PC
GCLST1: MOV A,B ;SAVE FOR THE CALLER
REST <A,C,D>
SEZ ;FAILURE
RTS PC
;ALWAYS GET THE ADDRESS OF A C-LIST ENTRY
;(CREATE IF NON-EXISTANT)
;B CONTAINSC-LIST NUMBER
;C CONTAINS ITEM NUMBER TO INSERT INTO
;A GETS CLOBBERED
;B RETURNS OFFSET INTO SPHERE IF SUCESSFUL (Z CLEARED)
;OTHERWISE, SET Z
AGCLSA: SAVE B
MOV C,A ;COPY SPHERE ITEM NUMBER
JSR PC,ITM1PL ;LOAD IT INTO THE MAP
JSR PC,GCLSTA ;SEE IF THE ENTRY IS ALREADY THERE
BNE AGCLS1 ;SUCESS, IT'S ALREADY THERE
MOV SCLSEP(A),A ;POINTER TO BEGGINING OF UNUSED SPACE
ADD #NCLSEB*CLSELN,A ;NEW END
JSR PC,ITM1PO ;IN CASE WE HANG
SAVE B
MOV C,B ;COPY SPHERE ITEM NUMBER
ASH #-6,A ;MAKE WORD SIZE INTO BLOCK SIZE
JSR PC,EXITEM ;MAKE SURE IT'S BIG ENOUGH
BEQ AGCLS2 ;FAILURE
MOV C,A ;ITEM WHERE THE NEW THING IS GOING
JSR PC,ITM1PL ;LOAD IT UP
MOV #NCLSEB*CLSELN/2,B ;NUMBER OF WORDS WE JUST ADDED
MOV SCLSEP(A),C ;POINTER TO OLD END+2
ADD #NCLSEB*CLSELN,SCLSEP(A) ;THE NEW END
SAVE D
MOV C,D ;FOR DIVIDE LATER
ADD A,C ;MAKE IT A REAL ADDRESS FOR CLEAR
1$: CLR (C)+ ;WIPE OUT NEW STUFF
SOB B,1$
CLR C ;FOR DIVIDE
SUB #SICLST,D ;MAKE IT RELATIVE
DIV #NCLSEB*CLSELN,C ;GET BLOCK NUMBER
MOV 2(P),B ;RESTORE BYTE POINTER
MOVB C,(B) ;NEW BLOCK NUMBER
MOV ITEM1,C ;THE SPHERE WE ARE HACKING
JSR PC,ITM1PO ;RESTORE ITEM 1
REST <D,,B>
BR GCLSTA ;TRY AGAIN
AGCLS1: JSR PC,ITM1PO ;POP THE ITEM WE PUSHED
TST (P)+
CLZ
RTS PC
AGCLS2: REST <,B>
SEZ
RTS PC
;GET THE ADDRESS OF A C-LIST ENTRY, ASSUMING THE SPHERE IS IN ITEM 1
;RETURN REAL ADDRESS IN A AND CLEAR Z, UNLESS YOU FAIL
AGCLAD: SAVE <B,C>
MOV ITEM1,C ;ASSUME THE SPHERE IS IN ITEM 1
JSR PC,AGCLSA ;GO GET THE ADDRESS
BEQ AGCLA1 ;FAILURE
MOV ITM1A,A ;GET THE ADDRESS IN THE MAP
ADD B,A ;MAKE A REAL ADDRESS
REST <C,B>
CLZ
RTS PC
AGCLA1: REST <C,B>
SEZ
RTS PC
;GET A POINTER TO THE NEXT EXISTANT C-LIST ENTRY
;ON ENTRY, A POINTS TO THE ITEM WITH THE SPHERE
;D IS THE FIRST C-LIST NUMBER TO CHECK
;B RETURNS POINTING TO THE C-LIST ENTRY
;D RETURNS POINTING TO THE C-LIST ENTRY
;CLEAR Z IF SUCESSFUL, SET OTHERWISE
GNCLST: CMP #MNCLSE,D ;AT THE LAST ENTRY?
BNE GNCLS3 ;NOT YET, TRY AGAIN
RTS PC ;AT END, NOTE THAT Z IS SET
GNCLS3: MOV D,B ;COPY THE C-LIST NUMBER
JSR PC,GCLSTA ;TRY TO GET POINTER
BEQ GNCLS1 ;NO SUCH BLOCK
ADD A,B ;MAKE A REAL POINTER
TST (B) ;ANYHTING THERE?
BEQ GNCLS2 ;NO, TRY NEXT ONE
RTS PC ;FOUND ONE, NOTE THAT Z IS CLEAR
GNCLS1: ADD #NCLSEB-1,D ;NEXT BLOCK
GNCLS2: INC D ;NEXT ENTRY
BR GNCLST
;CREATE A C-LIST ENTRY, ITEM OF SPHERE IN C, POSITION OF ENTRY
;TO BE CREATED IN B (-1 GETS THE FIRST AVAILABLE ENTRY), RETRURNS WITH Z CLEARED
;NORMALLY, SETS Z IF SLOT ISN'T AVAILABLE, AND SETS C IF NO SLOTS AVAILABLE
;ON NORMAL RETURN, B CONTAINS C-LIST NO. AND A CONTAINS ADDRESS OF ENTRY RELATIVE TO SPHERE
CRCLST: BIC #177400,B ;ONLY THE BOTTOM BYTE IS SIGINIFICANT
CMP #377,B ;IS IT -1
BNE CRCLS1 ;NO, FIGURE OUT WHICH ONE IT IS
MOV #MNCLSE-1,B ;START LOOKING AT THE TOP
CRCLS2: SAVE B ;THE CURRENT C-LIST NO.
JSR PC,AGCLSA ;GET A C-LIST ENTRY
BEQ CRCLS3 ;FAILED, BECAUSE NOT AVAILABLE
MOV C,A ;THE SPHERES ITEM NO.
JSR PC,ITM1PL ;LOAD IT UP
ADD B,A ;MAKE THE POINTER TO THE C-LIST ENTRY ABSOLUTE
TST (A) ;IS IT FREE
BEQ CRCLS4 ;YES RETURN SUCESSFUL
REST B
DEC B ;TRY THE NEXT C-LIST ENTRY
BEQ CRCLS5 ;NO MORE RETURN WITH CARRY SET
JSR PC,ITM1PO ;POP THE SPHERE
BR CRCLS2 ;TRY THE NEXT ONE
CRCLS1: SAVE B
JSR PC,AGCLSA ;GET A C-LIST ENTRY
BEQ CRCLS3 ;FAILED (NOT AVAILABLE)
MOV C,A ;SPHERES ITEM NO
JSR PC,ITM1PL ;LOAD UP THE SPHERE
ADD B,A ;MAKE THE POINTER ABSOLUTE
TST (A) ;IS TI FREE
BNE CRCLS6 ;NOPE
CRCLS4: REST B
SUB ITM1A,A ;MAKE IT RELATIVE AGAIN
JSR PC,ITM1PO ;POP THE SPHERE
CLZ!CLC ;CLEAR EVERYTHING
RTS PC
CRCLS6: REST B
CRCLS5: JSR PC,ITM1PO ;POP THE SHPERE
CLZ
SEC
RTS PC
CRCLS3: REST B
SEZ
RTS PC
;THIS ROUTINE TAKES A POINTER TO THE FIRST CAPABILITY OF A CIRCULAR
;LIST IN A AND THE C-LIST NO. OF THAT CAP IN B, AND RETURNS THE
;ITEM NO. (IN C) AND THE C-LIST NO. (IN D) OF THE C-LIST ENTRY THAT
;POINTS TO IT. THE C-LIST NO. OF THE ORIG. ENTRY IS IN B,AND THE ORIG.
;ITEM NO. IN A. RETURNS WITH Z SET IF NO CIRCULAR LIST
FNBKPT: TST 4(A) ;IS THERE A CIRCULAR LIST
BNE FNBPT1 ;YES
MOV ITEM1,C ;FAKE THE CIRCULAR LIST
MOV B,D ;COPY IT
RTS PC
FNBPT1: MOV ITEM1,A ;THE CURRENT ITEM NO.
SAVE <A,B> ;FOR REFERENCE LATER
FNBPT2: SAVE <A,B> ;SAVE CURRENT ITEM AND C-LIST
JSR PC,ITM1PL ;LOAD UP THIS SPHERE
JSR PC,GCLSTA ;GET ADDRESS OF C-LIST ENTRY
BUGC EQ ;DID WE SUCCEED
ADD A,B ;MAKE THE POINTER ABSOLUTE
MOV 4(B),A ;THE NEXT C-LIST NO.
MOV 10(B),B ;THE NEXT C-LIST ITEM
BUGC EQ ;THE ITEM SHOULDN'T BE 0
JSR PC,ITM1PO ;GET RID OF THIS ITEM
REST <D,C> ;GET THE OLD VALUES
CMP A,2(P) ;IS THE POINTER THE SAME AS THE ORIG.
BNE FNBPT2 ;NOPE FIND THE NEXT ONE
CMP B,(P) ;IS THE REST OF THE POINTER THE SAME
BNE FNBPT2 ;NOPE TRY AGAIN
ADD #4,P ;POP OFF THE ORIG. ITEM AND C-LIST NO.
CLZ
RTS PC
;PCLOSER ALL PROCESSES IN SPHERE
SPRRPC: SAVE F
MOV #RPCLSR,F
BR SPRKI1
RPCLSR: SAVE A
JSR PC,ITM0PL ;LOAD PROCESS BEING HACKED
JSR PC,PRSRPC ;PCLOSER IT
JSR PC,ITM0PO
REST A
RTS PC
;START SPHERE WITH INDEX IN C
SPRSTR: SAVE F
MOV #PSTPDC,F ;DECREMENT STOP COUNT
BR SPRKI1
;STOP SPHERE WITH INDEX IN C
SPRSTP: SAVE F
MOV #PSTPIN,F ;ROUTINE FOR EACH PROCESS
BR SPRKI1
;KILL ALL PROCESSES IN SPHERE INDEX IN C
SPRKIL: SAVE F
MOV #DLSPRO,F ;DELETE FROM SPHERE
SPRKI1: JSR PC,SPRPRH ;ALL IN SPHERE
REST F
RTS PC
DLSPRO: SAVE <B,A>
JSR PC,PSTPIN ;STOP PROCESS
JSR PC,ITM0PL ;LOAD PROCESS BEING HACKED
JSR PC,REMPRS ;REMOVE FROM SPHERE
JSR PC,ITM0PO
REST <A,B>
RTS PC
;HACK EACH OF PROCESSES IN SPHERE IN C WITH ROUTINE IN F
;EXCEPT THE CURRENTLY RUNNING PROCESS
SPRPRH: SAVE <A,B>
MOV #-1,A ;FOR THE BOGUS PUSH
JSR PC,ITM0PL ;CREATE A WORK CELL
MOV C,A ;THE SPHERE NO.
JSR PC,ITM1PL ;LOAD THE SPHERE
MOV SPHPRP(A),B ;GET POINTER TO THE FIRST PROCESS
JSR PC,ITM1PO ;POP THE SPHERE
BR SPRPH2 ;CHECK OUT THE FIRST PROCESS
SPRPH1: JSR PC,(F) ;HACK THE PROCESS
SPRPH2: MOV B,A ;PROCESS ABOUT TO HACK
BEQ SPRPH3 ;DONE
JSR PC,ITM0LD ;LOAD IT
MOV PSPHCP(A),B ;GET THE NEXT PROCESS
MOV ITEM0,A ;GET BACK PROCESS ITEM NUMBER
MOV #-1,ITEM0 ;CLOBBER ITEM0
CMP A,PRUNNG ;DONT STOP THE CURRENT PROCESS
BEQ SPRPH2 ;THIS IS IT
BR SPRPH1 ;YES
SPRPH3: JSR PC,ITM0PO ;POP THE WORK CELL
REST <B,A>
RTS PC
;PCLOSER ROUTINE FOR DECREMENTING SPHERE STOP COUNTS
PCSPST: SAVE <E,C,PRUNNG>
MOV LCKWD2(B),PRUNNG ;THE ONE NOT TO START (KLUDDDDGGGGE)
MOV ITEM2,C ;THE SPHERE IS LOADED INTO ITEM2
JSR PC,SPRSTR ;START ALL THE PROCESSES
REST <PRUNNG,C,E>
RTS PC
;THIS ROUTINE IS THE PC-LOSER ROUTINE FOR RESTARTING PROCESSES IN A SPHERE AND
;ALL INFERIOR SPHERES
PCMSST: MOV ITEM2,A ;GET THE SPHERE NO.
JSR PC,ITM1PL ;LOAD UP THE SPHERE
SAVE E ;KEEP E FROM BEING CLOBBERED
CLR E ;SAY WE SHOULD START THE PROCESSES
JSR PC,STPMS ;START THEM
REST E ;RESTORE E
JSR PC,ITM1PO ;POP THE SPHERE
RTS PC ;RETURN
;THIS ROUTINE EXPECTS THAT MS TO BE STOPPED OR STARTED TO BE LOADED IN ITEM1
;IF E IS < 0 THE SPHERE (AND INFERIORS ARE STOPPED, ELSE STARTED)
STPMS: JSR F,ACSAV ;SAVE THE AC'S
SAVE <#-1> ;FLAG THE TOP OF THE STACK
STPMS8: MOV ITEM1,C ;WHATEVER IS IN ITEM1 IS WHAT WE WANT TO STOP
TST E ;OR START
BLT STPMS1 ;STOPPING
JSR PC,SPRSTR ;STARTING
BR STPMS2
STPMS1: JSR PC,SPRSTP ;STOP IT
STPMS2: CLR D ;D IS THE CURRENT C-LIST ENTRY NUMBER
STPMS3: MOV ITM1A,A ;POINT TO THE CURRENT SPHERE
STPMS9: JSR PC,GNMSCP ;GET NEXT MS CAP
BEQ STPMS4 ;NO ONE HOME
SAVE <D> ;SAVE THE CONTINUATION POINT
MOV 2(B),A ;GET THE INDEX OF THE SPHERE POINTED TO
JSR PC,ITM1LD ;LOAD IT UP
BR STPMS8 ;GO STOP/START IT AND LOOK AT ITS C-LIST
STPMS4: REST D ;TRY TO POP TO SUPERIOR SPHERE
BLT STPMS6 ;GOT THE FLAG
MOV SMSSPT(A),A ;GET THE SUPERIOR
JSR PC,ITM1LD ;AND MAKE IT CURRENT
INC D ;NEXT C-LIST ENTRY
BR STPMS9 ;CONTINUE THROUGH ITS C-LIST
STPMS6: JMP ACRET
;GET NEXT MSCAP
;A POINTS TO THE SPHERE IN THE MAP
;D POINTS TO THE FIRST C-LIST ENTRY TO CHECK
;B GETS THE POINTER TO THE ENTRY
;D GETS THE NUMBER OF THE ENTRY
;SET Z ON FAILURE
GNMSC2: INC D ;LOOP TO NEXT ENTRY
GNMSCP: JSR PC,GNCLST ;GET THE NEXT C-LIST ENTRY
BEQ GNMSC1 ;NONE
CMPB #.MSCAP,(B) ;IS IT A MSCAP?
BNE GNMSC2 ;NO, TRY NEXT ONE
CLZ ;Z HAD BEEN SET, BUT WE WON SO CLEAR IT
GNMSC1: RTS PC ;RETRUN WITH Z SET OR CLEARED
;TAKES POINTER TO UPT IN B PCLOSERS EVERYONE NEAR THAT PAGE
PAGPCL: CMP #-1,B ;IS IT REALLY NULL?
BUGC EQ
SAVE <A,B>
MOV #-1,A ;BOGUS PUSH
JSR PC,ITM2PL ;LOAD UP NOTHING
PAGPLP: JSR PC,UPTLD ;LOAD A UPT
MOV ITEM2,A ;THE SPHERE TO PC-LOSER
BMI PAGL1 ;FUPT
JSR PC,SPRPCL ;PC-LOSER THAT SPHERE
PAGL2: MOV UPTGIP(B),B ;GET NEXT UPT
BEQ PAGDON ;NO MORE
CMP B,(P) ;IS IT THE SAME AS THE FIRST
BNE PAGPLP ;NO, PC-LOSER IT
PAGDON: REST <B,A>
JSR PC,ITM2PO ;POP THE SPHERE
PAGL3: RTS PC
PAGL1: MOV FUPTPR(B),A ;THE PROCESS THIS BELONGS TO
BLE PAGL2 ;NO ONE TRY NEXT UPT
JSR PC,PRSPCL ;PCLOSER PROCESS
BR PAGL2 ;TRY NEXT UPT
;PCLOSER SPHERE ITEM IN A
SPRPCL: SAVE A
MOV #-1,A
JSR PC,ITM0PL ;FOR A BOGUS PUSH
MOV (P),A ;GET BACK POINTER TO SPHERE
JSR PC,ITM1PL ;LOAD IT UP
MOV SPHPRP(A),A ;POINTER TO THE CURRENT PROCESS
JSR PC,ITM1PO ;POP SPHERE
TST A ;ARE THERE ANY PROCESSES
BEQ SPRPC2
SPRPC1: JSR PC,PRSPCL ;PCLOSER PROCESS
JSR PC,ITM0LD ;LOAD THE CURRENT PROCESS
MOV PSPHCP(A),A ;POINTER TO NEXT PROCESS
BNE SPRPC1 ;THERE IS ANOTHER
SPRPC2: JSR PC,ITM0PO ;POP THE BOGUS PUSH
REST A
RTS PC
;PCLOSER PROCESS ITEM IN A
PRSPCL: JSR F,ACSAV
JSR PC,ITM0PL ;LOAD THE PROCESS
TST PSTOPC(A) ;IS IT STOPPED ALREADY
BNE PRSPC1 ;YES
CMP ITEM0,PRUNNG ;IS THIS THE RUNNING PROCESS?
BEQ PRSPC3 ;DON'T UNLOCK SWITCHES, BUT SET FLAG
TST PSPC(A) ;IS IT IN SYSTEM
BEQ PRSPC1 ;NO
PRSPC3: BIS #PPCLSR,PFLAGS(A) ;SET BIT TO PCLOSER HIM
ACRTP0:
PRSPC1: JSR PC,ITM0PO ;POP PROCESS
ACRET: JSR F,ACRES
PRSPC2: RTS PC
;CHECK IF OUR OWN PCLOSER BIT IS SET AND PCLOSER IF IT IS
PCLCHK: SAVE A
MOV ITM0A,A ;ASSUME WE ARE LOADED IN ITEM0
BIT #PPCLSR,PFLAGS(A) ;IS IT ON?
BEQ PCLCH1 ;NO, JUST RETRUN
JSR PC,SFLUSH ;FLUSHING SHOULD CAUSE PCLOSERING TO HAPPEN
JSR PC,RUNME ;ACTUALLY, HAPPENS ON THE RUNME
BPT ;CAN'T GET HERE FROM THERE!
PCLCH1: REST A
RTS PC
PCLCLR: SAVE A ;WANT TO CLEAR OUR OWN PCLOSER BIT
MOV ITM0A,A ;ASSUME WE ARE LOADED IN 0
BIC #PPCLSR,PFLAGS(A) ;CLEAR IT
BR PCLCH1 ;AND RETURN
PCLSET: SAVE A ;WANT TO SET OUR OWN PCLOSER BIT
MOV ITM0A,A ;ASSUME WE ARE LOADED IN 0
BIC #PPCLDF,PFLAGS(A) ;CLEAR OUR DEFER BIT
BIS #PPCLSR,PFLAGS(A) ;SET IT
BR PCLCH1 ;AND RETURN
PCLDEF: SAVE A
MOV ITM0A,A
BIS #PPCLDF,PFLAGS(A)
BR PCLCH1
;PUSH ITEM2 AND THEN FALL INTO LOAD A UPT
;GIP IS IN B
;RETURN CORE ADDRESS IN B
UPTPLD: SAVE <A>
MOV #-1,A ;MAKE IT NXM
JSR PC,ITM2PL
REST <A>
UPTLD: TST B
BUGC EQ
BIT #GIPSPR,B ;THIS BIT SET IN SPHERE UPT
BNE UPTL.1
BIC #GIPBIT,B ;GET FUPT ADDRESS
RTS PC
UPTL.1: SAVE <A>
MOV B,A
BIC #GIPITM,A ;GET THE ITEM NUMBER
ASH #2,A ;CONVERT TO ITEM NUMBER
JSR PC,ITM2LD ;LOAD THE SPHERE OVER THIS ITEM
BIC #GIPUPT,B ;GET THE UPT NUMBER
SWAB B
ASH #-2,B ;GET THE UPT NO.
MUL #UPTLEN,B
ADD A,B
ADD #SUPTS,B
REST <A>
RTS PC
.SBTTL CLOCK AND PIRQ ROUTINES
;ENTERED BY AN INTERUPT FROM EITHER THE LINE CLOCK OR THE PROGRAMABLE
;CLOCK. HOPEFULLY, ONLY ONE OF THESE WILL BE ENABLED!
LCBRK:
PCBRK: JSR F,ACSAV ;SAVE THE ACS
JSR PC,SWCHEK
INC TIME ;INCREASE TIME-SINCE-SYSTEM UP
BNE 1$ ;OVERFLOW?
INC TIME+2 ;YUP
1$: DEC HSECNT ;TIME TO INC HSECS?
BGT 2$
INC HSECS
MOV #30.,HSECNT
DEC SECNT ;TIEM TO UPDATE SECONDS?
BGT 2$ ;NOPE
MOV #2,SECNT ;2 HALF SECS IN A SEC
JSR PC,DATEIN ;GO UPDATE SECS ETC.
2$:
BIS #100000,DH0SCR ;KLUDGE FOR DH11
.IIF NZ NTKDIS,JSR PC,TKDCLK ;KEEP DISPLAYS GOING
BIT #1,TIME ;DO THIS ONLY EVERY OTHER TICK
BNE 3$
BIS #TTYPIR,PIRQ ;CAUSE TTY'S TO GET PROCESED
3$: INC TUSED ;ONE MORE TICK FOR THIS USER
DEC STIMER ;MAINTAIN TIMERS
DEC LTIMER
DEC JTMUUP ;TIME TO UPDATE THE JTMUS?
BNE 4$ ;NOT YET
JSR PC,JTMUU ;GO UPDATE THEM
4$: DEC QUANT ;HAS THE CURRENT USER OVERSTAYED HIS WELCOME?
BGT CLKRET ;NO, RETURN TO MAIN PROGRAM
BIS #CLKPIR,PIRQ ;CAUSE THE STOP USER ROUTINE TO RUN
CLKRET: JSR F,ACRES ;RESTORE THE ACS
CHECKP
RTT
SWCHEK: MOV CSWR,SVCSR ;IS SWITCH REGISTER ZERO?
BNE 1$
MOV PC,LOOKSW ;YES, SAY WE SHOULD LOOK AT SWITCHES
1$: TST LOOKSW ;SHOULD WE LOOK AT SWITCHES?
BEQ SWCHE1 ;NOPE
BIT #100000,CSWR ;BPT SWITCH?
BUGC NE
BIT #1,CSWR ;INGNORE SWITCHES SWITCH
BEQ SWCHE1
CLR LOOKSW
SWCHE1: TST TIMCHK ;ARE WE RECORDING?
BEQ SWCHE2 ;NOPE
MOV 2+12.+2(P),A ;SWCHEK RETURN+PUSHED REGS+PC GETS YOU TO PS
BIC #177437,A ;GET LEVEL
ASH #-4,A
INC LEVTAB(A) ;ONE MORE TIME!
BIT #20000,CSWR ;STOP?
BNE SWCHE3 ;NOPE
CLR TIMCHK ;YES
RTS PC
SWCHE2: BIT #20000,CSWR ;SHOULD WE START?
BEQ SWCHE3 ;STILL ZERO
MOV #LEVTAB,A ;TABLE
MOV #8.,B ;LEVELS
1$: CLR (A)+
SOB B,1$
MOV PC,TIMCHK
SWCHE3: RTS PC
.IFNZ NTKDIS
TKDCLK: MOV TKDPDL,A ;THE PDL ITEM
JSR PC,ITM2PL ;LOAD IT UP
MOV A,F ;SAVE POINTER INTO IT
ADD #20,F ;MAKE IT POINT TO PDLS
CLR A ;THE DISPLAY NUMBER
CLR D ;THE DISPLAY*2
MOV #8.,C ;THERE ARE 8 DISPLAYS
TKDCL1: MOV TKDRUN(A),B ;IF RUNNING, WHICH DISPLAY I AM
BLT TKDCL2 ;NOT RUNNING
MOV B,D
SWAB B
MOV B,NGCSR ;CHECK THAT DISPLAY
BIT #TKRUN,NGCSR ;STILL RUNNING?
BNE TKDCL2 ;YUP
ASL D
BIC #17,F
ADD D,F
MOV TKDPDP(D),(F) ;RESTORE THE PDL POINTER
BIS #TKGO,B ;BIS DOESN'T WORK ON NGCSR
MOV B,NGCSR ;RESTART DISPLAY
TKDCL2: TST (A)+
SOB C,TKDCL1 ;DO THEM ALL
JSR PC,ITM2PO
RTS PC
.ENDC
DATEIN: MOV MONTH,A ;THE MONTH
MOVB MONS-1(A),DAYL ;SET THE LIMIT ON DAYS FOR THIS MONTH
MOV #SECOND,A ;POINT TO TABLES
MOV #SECONL,B ;THE LIMITS
MOV #RESETT,C ;VALUES TO RESET TO
DATEI1: INC (A) ;INCREMENT THIS
CMP (A),(B)+ ;HAS THIS OVERFLOWED?
BLT DATEI2 ;NO, DONE
MOV (C)+,(A)+ ;BACK TO BEGINNING OF MIN, HOUR, DAY, MON OR YEAR
BR DATEI1 ;GO DO NEXT
DATEI2: RTS PC
;ROUTINE ON LEVEL TTYL (2) TO PROCESS TVS AND TTYS
TTYBRK: REST A ;SAVED BY PIRBRK
JSR F,ACSAV
.IIF NZ NTVS,JSR PC,TVTICK ;PROCESS TV CHARS
JSR PC,CLKTTY ;PROCESS CHARACTERS
JSR F,ACRES
RTT
;THE GET/SET TIME CALL
ETIME: JSR PC,RETNSW ;GET POINTER WORD FROM STACK
MOV #6,B ;FOR THE SIX VARIABLES
1$: MFPD (A) ;GET WORD FROM USER
MTPD (A)+ ;MAKE SURE IT CAN BE PUT BACK
SOB B,1$
SUB #6*2,A ;BACK TO BEGINING
MOV #6,B
MOV #SECOND,C ;TABLE OF TIMES
SPL 7 ;AVOID TIMING ERROR
ETIME1: MFPD (A) ;GET WORD FROM USER
BGE ETIME2 ;HE DOESN'T WANT TO SET THIS WORD
BIC #100000,(P) ;CLEAR FLAG
MOV (P),(C) ;SET THIS ONE
ETIME2: MOV (C)+,(P) ;GET VALUE TO RETURN
MTPD (A)+ ;RETURN IT
SOB B,ETIME1
SPL 0
JMP ERETCZ
;COMPUTE THE DATE AND TIME WORDS FOR A FILE
CMDATE: JSR F,ACSAV
MOV #YEAR,C ;POINTER TO UPDATED DATE+TIME
TST (C)+ ;HAS YEAR BEEN SET?
BLT CMDAT2 ;NO, LEAVE FILE DATES -1
MOV #TSHIFT,D ;TABLE OF SHIFT COUNTS
MOV #5,E ;NUMBER OF PARTS
CLR B ;CLEAR LOW ORDER PATE OF 2 WORDS
SAVE PS
SPL 7
CMDAT1: BIS -(C),B ;SET THIS PART IN
ASHC (D)+,A ;SHIFT UP
SOB E,CMDAT1
MOV -(C),E ;SECONDS
ASR E
BIS E,B ;SECONDS GET DIVIDED BY 2
REST PS
MOV A,FDATE ;THE DATE
MOV B,FTIME ;AND TIME
CMDAT2: JMP ACRET
;THIS IS ENTERED BY THE PROGRAM INTERUPT REQUEST
;CURRENTLY IT IS ONLY USED FOR THE "CLOCK", BUT ITS DISPATCH
;TABLE COULD ACCOMADATE USES FOR OTHER LEVELS
PIRBRK: SAVE A ;SAVE A REGISTER
MOV PIRQ,A ;GET THE INTERUPT LEVEL
BIC #177761,A ;USE AS AN INDEX TO DISPATCH
BIC PIRBIT(A),PIRQ ;CLEAR THE RIGHT BIT
ASH #4,A ;GET PRIORITY INTO RIGHT BITS
MOVB A,PS ;SET PRIORITY OF PROCESSOR TO PRIORITY
;LEVEL RESPONSABLE FOR THIS INTERUPT
ASH #-4,A ;GET BACK FOR DISPATCHING
JMP @PIRDIS(A)
PIRLOS: BPT ;UNIMPLEMENTED LEVELS COME HERE
REST A
CHECKP
RTT
.SBTTL SCHEDULING ROUTINES
;THE SYSTEM'S MAIN LOOP
;ENTERED AT SCHED, NEVER EXITED
SCHED: JSR PC,CHKACT ;CHECK FOR PROCESSES TO BE ACTIVATED
SCHED4: MOV WINQ,A ;ANYBODY ON THE WINNERS QUEUE?
BEQ SCHED1 ;NOPE, TRY FOR THE LOSERS
MOV WQUANT,QUANT ;GIVE HIM A WINNERS QUANTUM
MOV #ACTQ,B ;DON'T LET HIM COME BACK HERE
JSR PC,TQUEUE ;MOVE HIM TO ACTIVE
JSR PC,STPROC ;START HIM UP
BR SCHED ;TRY FOR MORE WINNERS
SCHED1: MOV #DORQ,A ;SEE IF ANY OF TH EDORMANT GUYS WANT TO WAKE UP
JSR PC,CHKQ
TST LTIMER ;TIME TO CHECK THE SLOW GUYS?
BLT SCHED3 ;YUP
TST ACTQ ;ANYONE ACTIVE?
BEQ SCHED3 ;NO, GO CHECK THE SLOW GUYS ANYWAY
JSR PC,RUNBPS ;RUN THE BEST PROCESS
BR SCHED
SCHED3: MOV #LTIMEL,LTIMER ;RESET THE TIMER
MOV #IACTQ,A ;THE INACTIVE GUYS
JSR PC,CHKQ ;TRY TO PUT THEM ON THE RUN QUEUE OR ACTQ
SCHED5: MOV #RUNQ,A ;GUYS ON THE RUN QUE
JSR PC,GLQTIM ;GET THE ONE ON FOR THE LARGEST TIME
CMP #5*2,C ;IS IT > 5 SECS?
BGT SCHED7 ;NO, HE STAYS THERE
MOV #ACTQ,B ;HE GETS MOVED TO THE ACTIVE QUEUE
JSR PC,PRSAOD ;ACTIVEATE HIM
JSR PC,TQUEUE ;MOVE HIM
BR SCHED5 ;TRY FOR THE NEXT GUY WHO'S GOOD
SCHED7: TST WINQ ;WINNERS?
BNE SCHED ;GET THEM
TST ACTQ ;MODERATE WINNERS?
BNE SCHED ;THEM TOO
WAIT ;TWIDDLE THUMBS
BR SCHED ;AND TRY AGAIN
;UPDATE JTMUS ON ALL QUEUES
JTMUU: MOV #JTMUUT,JTMUUP ;RESTORE TIME TILL NEXT UPDATE
MOV #FIRSTQ,A ;BEGGINING OF THE QUEUE POINTERS
MOV #NQS,B ;NUMBER OF QUEUES THAT EXIST
JTMUU1: MOV (A),C ;POINTER TO BEGGINING OF QUEUE
BEQ JTMUU2 ;NOBODY THERE!
JTMUU4: MOV PRTJTM(C),F ;GET THE JTMU
BEQ JTMUU3 ;IT'S ALREADY ZERO, FORGET IT
CLR E ;FOR THE DIVIDE
DIV #JTMUDC,E ;FIND OUT HOW MUCH TO DECAY BY
INC E ;MAKE SURE IT EVENTUALLY GETS TO ZERO
SUB E,PRTJTM(C) ;DECAY IT
JTMUU3: MOV (C),C ;GO DOWN THE LINK
BNE JTMUU4 ;MORE ON THIS QUEUE
JTMUU2: ADD #QLEN,A ;GO TO NEXT QUEUE
SOB B,JTMUU1 ;GO THROUGH ALL QUEUES
RTS PC
;RETURN THE LENGTH OF TIME THE PROCESS TABLE ENTRY POINTED
;TO BY A HAS BEEN ON IT'S CURRENT QUEUE
GQTIME: MOV HSECS,C ;CURRENT TIME
SUB PRTTIM(A),C ;TIME ON QUEUE
RTS PC
;GET THE PROCESS THAT HAS BEEN ON THE Q IN A THE LONGEST TIME
;AND RETURN IT IN A, RETURN TIME ON Q IN C
;A AND C ARE ZERO IF NOT PROCESS ON Q
GLQTIM: JSR F,ACSAV
CLR D ;LONGEST TIME WE'VE FOUND
MOV #GLQTM,F ;"FLAG"
BR GQTIM
;SIMILAR TO GLQTIM, BUT FOR SHORTEST TIME
;C IS -1 IF NONE FOUN
GSQTIM: JSR F,ACSAV
MOV #-1,D ;SHORTEST TIME FOUND
MOV #GSQTM,F ;"FLAG"
GQTIM: CLR (P) ;SAVED A FOR RETURN
GQTIM1: MOV (A),A ;NEXT ONE
BEQ GQTIM2 ;NO MORE
JSR PC,GQTIME ;GET AMOUNT OF TIME ON QUEUE
JSR PC,(F) ;DO COMPARE
BHI GQTIM1 ;NOT A RECORD SETTER
MOV C,D ;NEW RECORD
MOV A,(P) ;BY NEW PROCESS
BR GQTIM1
GQTIM2: MOV D,4(P) ;SET C FOR RETURN
JMP ACRET
GLQTM: CMP D,C
RTS PC
GSQTM: CMP C,D
RTS PC
;CHECK RUNNABILITY OF A PROCESS
;PROCESS TABLE ENTRY IN A
;MIGHT CLOBBER ALL REGISTERS
CHKPRS: MOV PRTPPT(A),A ;GET THE ITEM
JSR PC,ITM0LD
CHKPRL: SAVE PSPC(A) ;GET THE PLACE TO CONTINUE IT AT
BUGC EQ ;MAKE SURE IT IS NON-ZERO
MOV A,B
MOV PSPHRP(A),A ;GET THE SPHERE
JSR PC,ITM1LD
MOV B,A ;RESTORE ITEM ADDRESS
JSR PC,ITM2RS ;RETORE THE ITEM2 STACK
MOV B,A
ADD #PSREGS+14,A ;POINTER TO REGISTERS
.IRPC X,<FEDCBA>
MOV -(A),X
.ENDM
RTS PC
;CHECK RUNNABLITY OF PROCESSES ON QUEUE IN A
;MAY CLOBBER ALL REGISTERS
CHKQ: SAVE (A)
CHKQ1: MOV (P),A ;GET THE NEXT IN LINE TO CHECK
BEQ CHKQ2 ;NO MORE
MOV (A),(P) ;LINK THROUGH FOR NEXT TIME
JSR PC,CHKPRS ;CHECK IT
BR CHKQ1
CHKQ2: REST A
RTS PC
;SET UP THE CURRENT PROCESS TO BE WOKEN UP BY THE BLOCK
;POINTED TO BY B
ACTSET: SAVE A
MOV PRUNNG,(B)+ ;STORE PROCESS ITEM
MOV ITM0A,A ;ASSUME CURRENT PROCESS IN ITEM 0
MOV PRSID1(A),(B)+ ;ID WORD 1
MOV PRSID2(A),(B)+ ;ID WORD 2
REST A
GOACT1: RTS PC
;TRY TO GOBBLE AN ACTIVATE BLOCK FOR THE PROCESS DESCRIBED
;IN THE 3 WORDS B POINTS TO
GOACT: TST (B) ;ANYTHING TO ACTIVATE?
BEQ GOACT1 ;NOPE
JSR F,ACSAV
MOV B,F ;COPY BLOCK POINTER
MOV (F),A ;ITEM
CLR (F)+ ;ONLY COME THIS WAY ONCE
MOV (F)+,B ;ID WORD 1
MOV (F)+,C ;ID WORD 2
JSR PC,PRSWAK ;GO GOBBLE BLOCK
JMP ACRET ;AND RETURN
;PUT PROCESS ON THE WAKE-UP QUICK LIST
;CALL WITH ITEM IN A, PROCESS ID WORD 1 IN B, PROCESS ID WORD 2 IN C
;IF CAN'T PUT IT ON LIST, JUST RETURNS....
PRSWAK: SAVE <PS,D>
SPL 7 ;DON'T INTERUPT ME
MOV ACTFRE,D ;GET A FREE BLOCK
BEQ PRSWA1 ;THERE ARE NONE
MOV (D),ACTFRE ;SPLICE IT OUT
MOV A,ACTITM(D) ;THE ITEM
MOV B,ACTPI1(D) ;PROCESS ID WORD 1
MOV C,ACTPI2(D) ;PROCESS ID WORD 2
MOV ACTLST,ACTLNK(D) ;LINK TH ENEW NODE
MOV D,ACTLST ;TO THE FRONT OF THE LIST
PRSWA1: REST <D,PS> ;RESTORE THE INT LEVEL AND D
RTS PC
;CHECK THE RUNABILITY OF ALL PROCESSES ON THE ACTLST
CHKACT: MOV PC,ACTCHK
SPL 7 ;SO THE LIST DOESN'T CHANGE
MOV ACTLST,E ;GET THE FIRST GUY
BEQ CHKAC1 ;NOBODY HOME
MOV (E),ACTLST ;SPLICE HIM OUT
SPL 0 ;OK NOW
MOV ACTITM(E),A ;THE ITEM
JSR PC,ITM0LD ;LOAD HIM UP
CMPB #ITACCD,ITM0DR ;IS THIS STILL A GOOD ITEM?
BNE CHKAC2 ;NOPE, FORGET THIS LOSER
CMP #ITPROC,(A) ;IS THIS THING I LOADED A PROCESS?
BNE CHKAC2 ;NO, CAN'T BE WHAT I WANT
CMP ACTPI2(E),PRSID2(A) ;DO THE IDS MATCH?
BNE CHKAC2 ;NOPE
BIT #RUNQB!STOPQB!WINQB!ACTQB,PQBIT(A) ;IS HE RUNNING OR STOPPED?
BNE CHKAC2 ;YUP
SAVE E
JSR PC,CHKPRL ;GO CHECK HIM OUT
REST E
CHKAC2: SPL 7
MOV ACTFRE,(E)
MOV E,ACTFRE ;PUT IT ON THE FREE LIST
BR CHKACT ;AND TRY AGAIN
CHKAC1: SPL 0
CLR ACTCHK
RTS PC
;RUN THE BEST PROCESS ON THE RUN QUEUE
;CLOBBERS ALL REGISTERS
RUNBPS: MOV ACTQ,A ;START OF GUYS TO RUN
BNE RUNBP1 ;SOME THERE FIND HIM
WAIT ;TWIDDLE YOUR THUMBS
RTS PC ;I GIVE UP!
RUNBP1: SAVE <#-1,#77777,#-1,#-1,#77777,A>
RUNBP2: MOV PRTUPT(A),B ;WHO IS THIS GUY'S USER?
CMP 6(P),B ;SAME GUY WHO IS ALREADY BEST?
BEQ RUNBP3 ;YES, GO SEE IF THIS PROCESS IS BETTER
MOV PRTPRI(B),E ;GET THE PRIORITY MULITPLE FOR THIS GUY
BIC #177760,E ;MASK IT TO 4 BITS
MUL PRTJTM(B),E ;GET THE NET PRIOTIRTY
CMP E,10(P) ;HIGH PART > THAN OLD HIGH PART?
BLO RUNBP4 ;NO, THIS USER IS BETTER!
BHI RUNBP6 ;YES, THIS USER NOT AS GOOD
CMP F,12(P) ;HIGH ORDER EQUAL, TRY LOW
BHIS RUNBP6 ;SAME OR WORSE
RUNBP4: MOV B,6(P) ;THIS IS THE NEW BEST USER
MOV E,10(P) ;AND HERE IS HIS PRIORITY
MOV F,12(P)
MOV PRTPRI(A),E ;NOW COMPUTE PRIORITY FOR THIS PROCESS
BIC #177760,E
MUL PRTJTM(A),E
RUNBP5: MOV A,(P) ;THIS IS NOW THE BEST PROCESS
MOV E,2(P) ;AND THIS IS IT'S PRIORITY
MOV F,4(P)
RUNBP6: MOV (A),A ;NEXT ONE ON THE QUEUE
BNE RUNBP2 ;GO SEE IF HE IS BETTER
REST A ;THIS ONE IS BEST
ADD #12,P ;FLUSH THE CRAP OFF THE STACK
MOV PQUANT,QUANT ;HOW LONG TO RUN HIM FOR
JMP STPROC ;GO TO IT (WILL RETURN TO CALLER OF RUNBPR)
RUNBP3: MOV PRTPRI(A),E ;SAME USER, IS THIS PROCESS BETTER?
BIC #177760,E
MUL PRTJTM(A),E
CMP E,2(P) ;IS THE HIGH PART BETTER?
BLO RUNBP5 ;YUP, HE'S NOW BEST
BHI RUNBP6 ;NOPE, OLD GUY IS BEST
CMP F,4(P) ;SAME HIGH PARTS, WHAT ABOUT LOW?
BHIS RUNBP6 ;OLD GUY BEST
BR RUNBP5 ;NEW GUY BEST
.SBTTL LOCK SWITCH ROUTINES
;GET A LOCKED SWITCH BLOCK AND STUFF THE TYPE AND ITEM INTO IT
;AND LINK IT INTO THE CURRENT PROCESS'S LOCKED LIST
;CALL WITH TYPE IN A, ITEM IN B
;PUTS ADDRESS OF BLOCK INTO A, CLOBBERS B
LOCKSW: TST LCKFRE ;ARE THERE ANY FREE LOCKS?
BNE LOCKS1 ;YES, GO GOBBLE
LOCKS3: BPT ;WE JUST RAN OUT OF LOCK BLOCKS!!!
;NO GARENTEES IF YOU PROCEED FROM HERE, BUT IT WILL TRY
JSR PC,SFLUSH ;WAIT A WHILE
TST LCKFRE ;TRY AGAIN
BNE LOCKS3 ;NONE YET
JSR PC,RUNME ;HOPEFULLY, WE CAN GET ONE NOW
BR LOCKSW ;TRY AGAIN
LOCKS1: SAVE <A,B>
MOV LCKFRE,A ;GET THE FREE LOCK BLOCK
MOV (A),LCKFRE ;SPLICE IT OUT
REST <LCKTIT(A),LCKDSP(A)> ;POP THE THING INTO THE TYPE AND ITEM
MOV ITM0A,B ;ADDRESS OF THE PROCESS
MOV PLCKSL(B),(A) ;PUT IT INTO LIST FOR THIS PROCESS
MOV A,PLCKSL(B)
MOV #-1,LCKWD1(A) ;LOCK NOT REALLY USED YET
CLR LCKWD2(A)
RTS PC
;CLEAR THE LOCKED SWITCH LIST
LSWCLR: SAVE A
MOV ITM0A,A
LSWCL2: TST PLCKSL(A) ;ANY LOCKED
BEQ LSWCL1 ;NOPE, ALL POPED
JSR PC,LSWPOP ;FLUSH ONE
BR LSWCL2 ;TRY AGAIN
LSWCL1: REST A
RTS PC
;LOCK A PARTICULAR SWITCH
;A HAS THE ADDRESS OF THE SWITCH, OR THE OFFSET INTO THE SPHERE
;B HAS THE BIT(S) WHICH ARE TO BE LOCKED
;C HAS THE ITEM NO THAT THE SWITCH IS IN (OR 0 IF ABSOLUTE)
LCKASW: TST INITSW ;NO SWITCHES LOCKED IN THE INIT CODE
BNE LOCKA5
SAVE <E,D,A,B>
MOV A,E ;COPY THE OFFSET
MOV #LSPONF,A ;THE TYPE OF LOCK
MOV C,B ;THE ITEM NO. OF THE SPHERE
JSR PC,LOCKSW ;GET A LOCK
REST B
MOV A,D ;SAVE POINTER TO THE LOCK
LOCKA2: MOV C,A ;THE SPHERE NO. THAT THE SWITCH IS IN
BEQ 1$ ;NO ITEM
JSR PC,ITM1PL ;LOAD IT UP
1$: ADD E,A ;MAKE A POINT TO THE SWITCH
BIT B,(A) ;IS THE LOCK UNLOCKED?
BEQ LOCKA1 ;YES
LOCKA3: TST C ;ANY ITEM PUSHES
BEQ 1$ ;NOPE
JSR PC,ITM1PO ;POP THE SPHERE
1$: JSR PC,SFLUSH ;TWIDDLE OUR THUMBS
MOV C,A ;THE SPHERE NO.
BEQ 2$ ;ABSLOLUTE SWITCH
JSR PC,ITM1PL ;LOAD IT UP
2$: ADD E,A ;MAKE A POINT TO THE SWITCH
BIT B,(A) ;IS IT UNLOCKED YET
BNE LOCKA3 ;NOT YET
TST C ;IS THE SWITCH IN AN ITEM
BEQ 3$ ;NOPE
JSR PC,ITM1PO ;POP THE SPHERE
3$: JSR PC,RUNME ;I THINK I HAVE GOT IT
BR LOCKA2 ;MAKE SURE
LOCKA1: BIS B,(A) ;LOCK THE SWITCH
TST C ;ANY ITEM PUSHED
BEQ 1$ ;NOPE
JSR PC,ITM1PO ;POP THE SPHERE
1$: REST A ;GET THE POINTER TO THE LOCK
MOV A,LCKWD1(D) ;SAY THIS LOCK IS USED
MOV B,LCKWD2(D) ;THE BITS LOCKED
REST <D,E> ;GET ORIGINAL CONTENTS OF D
LOCKA5: RTS PC
;POP THE TOP LOCK OFF THE LOCKED SWITCH LIST
LSWPOP: TST INITSW ;ARE WE IN INIT CODE?
BNE LSWPO2 ;NO SWITCHES EVER LOCKED
JSR F,ACSAV
MOV ITM0A,A ;ASSUME ITEM0 IS THE PROCESS WHICH IS UNLOCKING
MOV PLCKSL(A),B ;SPLICE LOCK OUT OF IT'S LIST
BUGC EQ ;ONLY SHOULD GET CALLED IF ANYTHING IS LOCKED
MOV (B),PLCKSL(A)
MOV LCKFRE,(B) ;PUT IT ONTO THE FREE LIST
MOV B,LCKFRE
CMP #-1,LCKWD1(B) ;IS IT FOR REAL?
BEQ LSWPR4 ;NOPE, WE HAVE "UNLOCKED" IT
MOV LCKTIT(B),A ;GET THE TYPE
BNE 1$ ;IF REALLY ONE THERE
MOV #-1,A ;MAKE ITEM NXM (FOR THE SAKE OF THE PUSH)
1$: JSR PC,ITM2PL
TST LCKTIT(B) ;IS THERE REALLY AN ITEM?
BNE 2$ ;YES
CLR A ;NONE
2$: JMP @LCKDSP(B) ;DISPATCH ON TYPE
LSPONF: ADD LCKWD1(B),A ;POINT INTO ITEM IF THERE IS ONE
BIC LCKWD2(B),(A) ;UNLOCK ON-OFF TYPE LOCK
LSWPOR: JSR PC,ITM2PO ;POP THE ITEM STACK
LSWPR4: JSR F,ACRES
LSWPO2: RTS PC
LSPPCL: TST BPCLSR ;IS HE BEING PCLSRED?
BEQ LSWPOR ;IF NO, GO AWAY
LSPRTN: JSR PC,@LCKWD1(B) ;BEING PCLSRED, RUN ROUTINE
BR LSWPOR ;ALL DONE WITH THIS SWITCH
LSPDEC: ADD LCKWD1(B),A ;GET ABSOULUTE ADDRESS
DEC (A) ;FIXUP THE FLAG
BNE LSWPOR ;IF NOT ZERO, ALL DONE
TST LCKWD2(B) ;IS THERE A ROUTINE TO RUN ON ZERO FLAG?
BEQ LSWPOR ;NO, FINISHED THEN
JSR PC,@LCKWD2(B) ;CALL THE ROUTINE
BR LSWPOR
LSPULN: TST BPCLSR ;PCLOSERING ?
BEQ LSWPOR ;NO, JUST POP
MOV @LCKWD2(B),A ;GET THE CONTENTS OF FREE LIST POINTER
MOV LCKWD1(B),@LCKWD2(B) ;POINT FREE LIST AT ENTRY TO BE FLUSHED
MOV A,@LCKWD1(B) ;AND FLUSHED ENTRY AT REST OF LIST
BR LSWPOR
;THE DELETE ON PCLOSERING ROUTINE, FOR THINGS THAT NEED ITEMS FLUSHED
PCLDLI: MOV ITEM2,A
JMP DLITEM ;THE LOADED ITEM IS GETTING FLUSHED
;POP A SWITCH WITHOUT DOING ANYTHING WITH IT
LSWFLS: SAVE <A,B>
MOV ITM0A,A ;POINT INTO PROCESS
MOV PLCKSL(A),B ;GET FIRST SWITCH
BUGC EQ ;NO SWITCH?
MOV (B),PLCKSL(A) ;FLUSH THIS ONE
MOV LCKFRE,(B) ;RETURN THE NODE
MOV B,LCKFRE ;TO THE FREE LIST
REST <B,A>
RTS PC
.SBTTL TRAP AND FAULT ROUTINS
ILLBRK: TSTB PS+1
BNE ILLBR1
1$: BPT
BR 1$
ILLBR1: MOV #100000+.ILLTF,C
BR CCFAUL
BEBRK: TSTB PS+1 ;DID IT COME FROM USER MODE?
BNE BEBRK1 ;YES
BPT
RTT
BEBRK1: MOV #100000+.BETF,C ;BEBRK FAULT
BR CCFAUL
IOTBRK: TSTB PS+1 ;DID IT COME FROM USER MODE
BNE IOTBR1 ;YES
BPT
RTT
IOTBR1: MOV #100000+.IOTTF,C
BR CCFAUL
FPPBRK: MOV ITM0A,A ;POINT TO ITEM
BIT #PFPFLG,PFLAGS(A) ;SAVING FPP FOR THIS GUY?
BEQ FPPBR1 ;NO, DON'T SAVE THE ERROR FOR HIM
STST PFEC(A) ;SAVE ERROR
FPPBR1: MOV #100000+.FPPTF,PFAULT(A) ;SET THE FAULT
BIS #CLKPIR,PIRQ ;SCHEDULE HIM OUT WITH THE ERROR
CHECKP
RTT
PARBRK: BPT
RTT
BPTBRK: TSTB PS+1 ;FROM USER MOD
BNE BPTBR1 ;YES
SAVE <RUGSTA,RUGVEC> ;SAVE THE STUFF FOR RUG
CHECKP
RTI ;RETURN TO RUG
BPTBR1: MOV #100000+.BPTTF,C ;SAY A BPT FAULT
CCFAUL: MOV PC,USRMOD ;IN THE SYSTEM NOW
JSR F,SPCPSP
MOV C,PFAULT(A) ;THE TYPE OF FAULT
;FALLS IN TO THE NEXT PAGE
;FALLS IN FROM PREVIOUS PAGE
CFAULT: SPL 0 ;JUST IN CASE
MOV STPSVP,P ;RESTORE STACK TO THE STATE IT WAS IN WHEN SHED CALLED US
JSR F,SAVEPP ;SAVE THE USERS PDL POINTER
TST (P)+ ;CAUSE SAVEPP LEAVES IT THERE, THAT'S WHY!
MOV PC,BPCLSR ;WE NEED TO PCLOSER HIM
JSR PC,LSWCLR ;TO FLUSH WHAT EVER HE WAS DOING
CLR BPCLSR
TST LOOKSW
BEQ CFAUL9 ;IGNORE SWITCHES
BIT #40000,CSWR
BEQ CFAUL9
BPT
CFAUL9: MOV ITEM1,C ;THE SPHERE TO STOP
CMP C,SYSSPR ;THE SYSTEM SPHERE?
BUGC EQ ;BPT IF IT IS THE SYSTEM SPHERE THAT FAULTED
JSR PC,SPRSTP ;STOP THE SPHERE
MOV ITM1A,A ;THE SUPERIOR SPHERE
BIS #FAULT1,SFLAG(A) ;SAY THERE IS A FAULT
MOV SMSSPT(A),A ;GET THE SUPERIOR SPHERE
JSR PC,ITM2LD ;LOAD IT UP
SAVE #177 ;THE FIRST CAPABILITY NO.
CFAUL2: MOV (P),B ;GET THE CAPAIBLITY NO.
JSR PC,GCLSTA
BEQ CFAUL3 ;COULDN'T GET IT
ADD A,B ;POINT TO IT DIRECTLY
CMPB (B),#.MSCAP ;IS IT MASTER SPHERE
BNE CFAUL3 ;NO
CMP 2(B),ITEM1 ;FOR THIS SPHERE
BEQ CFAUL4 ;YES
CFAUL3: DEC (P) ;THE COUNTER
BGE CFAUL2 ;TRY THE NEXT ONE
BPT ;COULDN'T FIND IT
TST (P)+
CFAUL5: MOV ITEM0,A ;PROCESS THAT FAULTED
JSR PC,PSTPIN ;INCREMENT MY STOP WORD NOW, AND PCLOSER MYSELF
SAVE <A,PC,#STOPQ>
JMP FLUSH ;LET THE PROCESS CREATED HANDLE IT
CFAUL4: BIT #.SPFES,(B) ;CAN I CAUSE AN ENTER
BNE CFAUL5 ;NO, FORGET IT
MOV 6(B),E ;THE ENTER ADDRESS
BIT #1,E ;DOES IT EXIST
BNE CFAUL5 ;NO
;FALLS THROUGH
;FALLS IN
CFAUL6: MOV ITEM2,C ;POINTER TO THE SUPERIOR SPHERE
MOV #-1,B ;PUT IT ANYWHERE
JSR PC,CRCLST ;CREATE A PACE FOR IT
BCS CFAUL5 ;C-LIST FULL FORGET IT
ADD ITM2A,A ;POINT TO THE C-LIST ENTRY
MOV #-1,(A) ;RESERVE IT
MOV A,F ;SAVE THE POINTER
MOV B,D ;SAVE THE CAPABILITY NO.
MOV #LSPPCL,A ;INCASE OF PC-LOSER
MOV ITEM2,B ;THE ITEM
JSR PC,LOCKSW ;RELEASE THE SLOT
MOV F,LCKWD2(A) ;POINT TO THE C-LIST SLOT
CFAUL7: MOV F,A ;POINTER TO FIRST CAPABILITY
MOV #.PRWRA!.PRCAP,(A)+ ;CREATE A PROCESS CAPABILITY TO THE FAULTING PROCESS
MOV ITEM0,(A)+ ;SET IN THE PROCESS ITEM NO.
MOV ITM0A,A
INC PRSREF(A)
JSR PC,CRPROC ;CREATE PROCESS
BEQ CFAUL5 ;FAILED
JSR PC,ITM0PL ;LOAD IT UP
DEC PRSREF(A) ;SINCE THERE WILL BE NO CAP TO IT, AND PUTPRS WILL INCREMENT IT
BIC #PSUPSB,PSTOP(A) ;CLEAR THE BIT
MOV E,PUPC(A) ;SET UP THE STARTING ADDRESS
ADD #PUREGS,A ;POINT TO THE REGISTERS
MOV D,(A)+ ;PUT IN CAPABILITY TO THE FAULTING PROCESS INTO %0
REST (A) ;PUT IN CAPABILITY OF MS CAPABILITY TO FAULTING SPHERE
MOV ITEM0,A ;COPY THE ITEM NO. OF THE FAULT HANDLER
MOV ITEM2,B ;THE SUPERIOR SPHERE
JSR PC,PUTPRS ;PUT THE PROCESS INTO THE SPHERE
MOV ITEM0,A
JSR PC,PSTPDC ;START IT
JSR PC,ITM0PO ;POP THE ITEM
JSR PC,LSWPOP ;POP LOCK ON CAP
JMP CFAUL5
;FIX THE FAULT FOR THE SPHERE IN B
FALTFX: SAVE <A,C> ;SAVE SOME REGS.
MOV B,A ;THE SPHERE
JSR PC,ITM1PL ;LOAD IT UP
BIT #FAULT1!FAULT2!FAULT3,SFLAG(A) ;IS THERE A FAULT
BUGC EQ ;JUST CHECKING
BIC #FAULT1!FAULT2!FAULT3,SFLAG(A) ;SAY NO MORE FAULT
MOV ITEM1,C ;GET THE SPHERE NO.
JSR PC,ITM1PO ;POP THE SPHERE
JSR PC,SPRSTR ;START IT UP
REST <C,A> ;CLEAN UP
RTS PC
TRPBRK: MOV #TRPBRV,A ;POINTER TO THE TRAP STUFF
JSR PC,USRTRP ;CHECK OUT THE TRAP
MOV ITM0A,A ;POINTER TO THE PROCESS
TSTB PS+1 ;IS IT FROM KERNEL MODE
BEQ TRPBR1 ;YES,
MOV #100000+.TRPTF,PFAULT(A) ;FAULT TYPE FOR BAD TRAP
JMP CFAULT ;JUST CAUSE THE FAULT
TRPBR1: .IRPC X,<012>
TRPIP'X: TST ITM'X'D ;ANY PUSHED?
BEQ TRPPD'X
JSR PC,ITM'X'PO
BR TRPIP'X
TRPPD'X:
.ENDM
MOV ITM0A,A
SUB #2,(P) ;POINT TO THE TRAP
MOV (P),PERRAD(A) ;SAVE SYSTEM ADDRESS WHERE ERROR HAPPENED
MFPI @(P) ;GET THE ACTUAL TRAP INSTRUCTION
REST B ;GET BACK THE INSCTRUCTION
MOV STPSVP,P ;RESTORE STACK TO THE STATE IT WAS IN WHEN SHED CALLED US
CCC ;CLEAR THE CONDITION CODES
SAVE PS ;SAVE A COPY OF THE PS TO MUNG
BIT #TRPZBT,B ;ARE WE SUPPOSED TO SET THE Z BIT?
BEQ 1$ ;NO
BIS #4,(P) ;SET IT
1$: BIT #TRPVBT,B ;ARE WE SUPPOSED TO SET THE V BIT?
BEQ 2$ ;NO
BIS #2,(P) ;SET IT
2$: BIC #177400!TRPZBT!TRPVBT,B ;CLEAR BITS
MOV B,PERRW(A) ;THAT'S THE ERROR TYPE
MOV PC,BPCLSR ;FLUSH SWITCHES
JSR PC,LSWCLR ;LIKE HE'S BEING PCLOSERED
CLR BPCLSR
JMP EMTRTP ;EMT RETURN SPECIAL ENTRY
;THIS ROUTINE EXPECTS A TO BE A POINTER TO THE TRAP VECTOR IN THE USERS CORE
;AND DECIDES IF IT IS A FAULT OR A TRAP THROUGH
USRTRP: TSTB PS+1 ;IS IT FROM KERNEL MODE
BNE USRTR1 ;NO
RTS PC ;TEMPORARY FOR TRAP TO WORK
USRTR1: MOV PC,USRMOD ;SAY WE ARE IN THE SYSTEM
REST E ;THE CALLING ADDRESS
MOV A,B ;SAVE THE POINTER TO THE TRAP
JSR F,SPCPSP ;SAVE HIS STUFF, AND F GETS USER P POINTER
SUB #2,PUPC(A) ;DECREMENT IT TO THE CALL IF PCLOSERED
;HERE IF NOT TRAP THROUGH JUST RETURN BY JMP (E)
MFPD -(F) ;GET THAT WORD
MFPD -(F) ;GET THE PC WORD
MFPI 2(B) ;ALL THIS TO PREVENT HANG BELOW
MFPI (B) ;PROBABLY UNNECCESSARY
ADD #10,P ;POP OFF THE EXTRA STUFF
SAVE <PUPS(A),PUPC(A)>
ADD #2,(P) ;MAKE IT LOOK LIKE REAL TRAP
MTPD (F)+ ;GIVE HIM THE PC
MTPD (F)+ ;AND THE PS
SUB #4,F
SAVE F ;THE NEW P
MTPI P ;GIVE IT BACK
MFPI 2(B) ;GET THE TRAP VECTOR STATUS
BIC #340,(P) ;CLEAR THE PRIORITY BITS
BIS #174000,(P) ;USER MODE, FOR SURE
MFPI (B) ;AND THE ADDRESS
SPL CLKL ;INHIBIT SCHEDULES
CLR USRMOD
CHECKP
RTT ;RETURN
.SBTTL EMT HANDLERS
;GET HERE WHEN A USER EXECUTES AN EMT
EMTBRK: CMPB #60,PS+1 ;MAKE SURE IT CAM FROM USER MODE
BUGC NE
MOV PC,USRMOD ;NOW WE AREIN THE SYSTEM!
JSR F,SPCPSP ;SAVE THE USER'S PC, PS AND PDL POINTER
CLR PUPDLO(A) ;NOTHING POPED YET
SUB #2,PUPC(A) ;POINT TO THE CALL ITSELF
MFPI @PUPC(A) ;GET THE ACTUAL CALL
REST B ;POP IT OFF THE STACK
ASL B ;CONVERT IT TO A WORD INDEX
BIC #177001,B ;8 BITS ARE SIGNIFICANT
BIC #PFALTB,PFLAGS(A) ;SET THE TEMPORARY FAULT BIT
BIT #400,B ;IS THE FAULT ON FAIL BIT SET?
BEQ 1$ ;NO
BIS #PFALTB,PFLAGS(A) ;SET THE TEMPORARY FAULT BIT
1$: BIC #400,B ;CLEAR THE TOP BIT
CMP #EMTHGH*2,B ;IS IT TOO HIGH?
BLOS BADEMT ;YUP, TELL HIM HE IS A LOSER
SAVE PS ;NOTE THAT TRACE TRAPS WILL ACT STRANGELY HERE
BIC #357,(P) ;PRIORITY 0
SAVE EMTDIS(B) ;DISPATCH ADDRESS
CHECKP
RTT
BADEMT: MOV ITM0A,A ;POINT TO THE PROCESS
MOV #100000+.EMTTF,PFAULT(A) ;CAPABILITY FAULT
JMP CFAULT
EGERRW: MOV #PERRW,E
EGERR1: ADD ITM0A,E ;POINT TO PROCESS
MOV (E)+,B ;HIS ERROR WORD
ERRORC EQ,NUL ;NO ERROR, GIVE HIM AN ERROR
JSR PC,GIVPSW ;GIVE HIM THE ERROR NUMBER
MOV (E),B ;AND THE ERROR ADDRESS IN THE SYSTEM
JSR PC,GIVPSW
CLR PERRW(A) ;NO ERROR FOR NEXT TIME
JMP ERETCZ
EGETID: MOV #PRSID1,E
BR EGERR1
EMFPI: JSR PC,RETNSW ;GET THE ADDRESS FROM THE STACK
BIC #1,A ;AVOID LOSSAGE
MFPI (A)
REST B
JSR PC,GIVPSW
JMP ERETCZ
ERUG: CMP CURSPH,SYSSPR
BNE BADEMT
BPT
MOV ITM0A,A ;POINTER TO PROCESS
MFPI @PUPC(A) ;GET WHAT SHOULD BE THE .RUG
BIC #200,(P) ;LOSE BIT
CMP #.RUG,(P)+ ;STILL A .RUG?
BEQ ENOOP ;YUP, JUST RETURN
SUB #2,PUPC(A) ;REEXECUTE THE CHANGED INSTRUCTION
;RETURN FROM EMT TO USER
ENOOP:
EMTRET: SAVE PS ;FOR THE CONDITION CODES
EMTRTP: MOV ITM0A,A ;PROCESS HAD BETTER BE THERE
EMTRE1:
CMP #PDL-4,P ;CROCK TO CATCH EMT'S THAT DON'T FULLY POP THE STAKC
BUGC NE
;THIS IS TEMPORARY INSTRUCTION
MOV #30000,PS ;MAKE SURE PREVIOUS MODE IS USER
TST PLCKSL(A) ;ANY LOCKED SWITCHES?
; BUGC NE ;YES, BUG
JSR PC,LSWCLR
EMTRE2:
.IRPC X,<012>
TST ITM'X'D
BUGC NE ;HAD ITEMS PUSHED
.ENDM
MOV #-1,A
JSR PC,ITM2LD ;CLOBBER LOADED ITEM 2
MOV ITM0A,A
BIT #4,(P) ;HAS THE CALL FAILED?
BEQ EMTRE4 ;BR IF NOT
CLR PUPDLO(A) ;NOTHING GETS POPPED
BIT #PFALTB!PFAILB,PFLAGS(A) ;SHOULD HE BE FAULTED
BNE BADEMT ;YES, IT IS A BADEMT
EMTRE4: BIC #PFALTB,PFLAGS(A) ;CERTAINLY NO LONGER A $ EMT
CLR PSPC(A) ;NOT IN THE SYS ANYMORE
MOVB #370,1(P) ;GO BACK TO USER MODE PROPERLY
BIT #20,PUPS(A) ;RESTORE TRAP BIT IF WAS SET
BEQ 1$
BIS #20,(P) ;SET THE TRAP BIT
1$: SAVE PUP(A) ;GET HIS OLD P ONTO MY STACK
ADD PUPDLO(A),(P) ;ANYTHING POPED FROM IT?
MTPI P ;RESTORE P FOR HIM
SAVE PUPC(A) ;PUT THE PC ON THE STACK NOW
ADD #2,(P) ;START HIM AFTER THE CALL
MOV A,B ;THE ITEM ADDRESS
JSR PC,PACRES ;RESTORE HIS AC'S
SPL CLKL ;PREVENT A SCHEDULE
CLR USRMOD ;THIS COULD CAUSE ONE
TST QUANT ;HAS HE OVERSTAYED HIS WELCOME?
BGE 2$ ;NO
BIS #CLKPIR,PIRQ ;GET HIM AFTER THE RTI
2$: CHECKP
RTI ;GO TO USER MODE
;PROCESS HACKING EMTS
;.FORK:
;1 ARGUMENT IS ADDRESS OF PLACE TO START NEW PROCESS
;CLEARS Z IF IT SUCEEDS IN CREATING A NEW PROCESS
EFORK: JSR PC,RETNSW
SAVE A
JSR PC,CRPROC ;ATTEMPT TO CREATE A PROCESS
BEQ EFORK1 ;FAIL
MOV CURSPH,B ;PUT IT INTO THE CURRENT PROCESS
JSR PC,PUTPRS
JSR PC,ITM0PL ;LOAD IT TEMPORARILLY
DEC PRSREF(A) ;IT IS ONE TO LARGE (SHOULD BE ONLY ONE)
BUGC LE
REST PUPC(A) ;SET ITS PC
BIC #PSUPSB,PSTOP(A) ;CLEAR THE STOP BIT
MOV ITEM0,A
JSR PC,PSTPDC ;GO START IT
MOV ITM0A,A
ADD #PUREGS,A ;MAKE A POINT TO THE OLD REGISTERS
BIS #4000,PS
SAVE <F,E,D,C,B,A>
BIC #4000,PS
MOV #6,E ;THE NUMBER TO COPY
1$: REST (A)+
SOB E,1$
JSR PC,ITM0PO ;POP ITEM STACK
ERETCZ: CCC ;SUCESS
EFORK1: JMP EMTRET
;.POOFF:
;NO ARGUMENT. MAKE THE PROCESS EXECUTING ITDISAPPEAR WITHOUT A TRACE
;CURRENTLY, THE PROCESS IS ONLY STOPPED
;IF THERE ARE ANY REFERENCES TO ITREMAINING
EPOOFF: MOV ITEM0,B ;THE PROCESS ITEM
JSR PC,SPRINC ;INCREMENT THE REFERENCE COUNT (SO IT DOESN'T DISAPPEAR
;IN REMPRS)
MOV ITM0A,A ;THE FOLLOWING IS ONLY DONE TO KEEP THINGS CONSISTENT
JSR PC,PACSAV
JSR PC,TIMEUS
JSR PC,SAVAWB
JSR PC,PDLSAV
MOV PRUNNG,A
JSR PC,PSTPIN ;INCREMENT THE STOP COUNT
MOV ITM0A,A ;PROCESS POINTER
JSR PC,REMPRS ;REMOVE IT FROM THE SPHERE IT IS IN
MOV PRUNNG,A
JMP DLPROC ;DECREMENT REFERENCE COUTN AND DELETE IF ZERO
;.INVOKE:
;1 ARG IS CAPABILITY NUMBER TO INVOKE AND MAYBE FLAGS
;MORE ARGS MAY BE TAKEN IF CAPABILTY WANTS THEM
;BUT THERE MUST ALWAYS BE 3 THINGS ON THE STACK AND 3 THINGS WILL BE POPPED
EINVOK: SUB #6,P ;CREATE 3 WORDS OF TEMP STORAGE FOR ARG
JSR PC,RETNSW ;GET THE TOP OF THE STACK
MOV A,(P) ;LOTS OF PEOPLE WILL WANT IT
JSR PC,RETNSW ;GET 2ND ARG
MOV A,2(P) ;SAVE IT
JSR PC,RETNSW ;GET 3RD ARG
MOV A,4(P) ;SAVE LAST ARG
MOV ITM1A,A ;GET ADDRESS OF SPHERE
MOV (P),B ;THE CAP NUMBER
BIC #177400,B ;CLEAR WHATEVER IS THERE
MOV B,E ;TO SAVE IT FOR LATER ROUTINES
JSR PC,GCLSTA ;SEE IF IT IS THERE
BEQ EIVOK1 ;LOSER
ADD B,A ;GET A REAL ADDRESS FOR CAP
MOV (A),B ;THE FIRST WORD OF CAP
BEQ EIVOK1 ;NOTHING THERE
CMP B,#-1
BEQ EIVOK1
ASL B ;TO A WORD ADDR
BIC #177001,B ;FLUSH EXTRA BITS
CMP B,#CAPHGH*2
BUGC GE ;IF THE CAPABLITY IS TOO BIG
MOVB 1(P),C ;THE FUNCTION
BITB #200,C ;IS IT A GENERAL REQUEST
BNE 1$
JMP @IVKCTB(B) ;GO TO THE RIGHT ROUTINE
1$: ASL C ;TURN IT INTO A WORD INDEX
BIC #177400,C ;CLEAR THE TOP BYTE
CMP C,#GENHGH
ERRORC GE,BFUN
JMP @GENDIS(C) ;GO TO THE GENERAL FUNCTION ROUTINE
EIVOK1: ERROR BAD
.IFNZ NPC
DELCAP: ADD #6,P ;POP OFF ALL THE ARGUMENTS
JSR PC,@DELTAB(B) ;DELETE ROUTINE FOR THIS CAPABILITY
BUGC EQ ;NOT BEING ABLE TO DELETE A CAP SHOULDN'T HAPPEN
MOV CURSPH,C ;SPHERE TO PCLOSER
JSR PC,SPRRPC ;REALLY PCLOSER IT
JMP ERETCZ
.IFF
DELCAP: MOV CURSPH,C ;THE CURRENT SPHERE MUST BE PCLOSERED
;Z JSR PC,SPRSTP ;STOP IT
;Z JSR PC,SPRSTR ;AND START IT UP
ADD #6,P ;POP OFF ALL THE ARGUMENTS
JSR PC,@DELTAB(B) ;DELETE ROUTINE FOR THIS CAPABILITY
JMP EMTRET ;RETURN WHATEVER FLAGS SET
.ENDC
CPYCAP: MOV A,F
MOV B,C ;FOR ROUTINES LATER
TST (P)+ ;ONLY WANT TWO ARGS
ADD #CPYTAB,C
JMP CPYCA1
GIVCAP: TST (P)+ ;FIRST ARG NO LONGER NEEDED
MOV (A),C ;TYPE AND FLAGS OF CAP TO USE WHEN GIVING AWAY
CMPB C,#.MSCAP ;IS IT A MASTER SPHERE CAPABILITY
BEQ GVCAP1 ;YES
CMPB C,#.SPCAP ;IS IT SPHERE CAP.
BEQ GVCAP1 ;YEP
GVCAP2: ADD #4,P ;POP OFF GARBAGE
JMP BADEMT
GVCAP1: BIT #.SPCAD,C ;DOES HE HAVE APPEND ACCESS
BEQ GVCAP2 ;NOPE, HE LOSES
MOV (P),B ;THE SECOND ARG SPECIFIES WHAT TO GIVE AWAY
BIC #177400,B ;GET THE GOOD BITS
MOV B,E ;TO SAVE IT FOR LATER
MOV A,C ;SAVE POINTER TO SPHERE OR MS CAP
MOV ITM1A,A ;FIND IT IN THIS SPHERE
JSR PC,GCLSTA ;FIND THE CAP.
BEQ GIVLOS ;CAN'T FIND IT
ADD A,B ;MAKE B POINT TO THE CAPABILITY
MOV B,D ;FOR LATER DELETION
MOV (B),F ;GET THE TYPE AND FLAGS
BEQ GIVLOS ;THERE ISN'T A CAPABILITY THERE
CMP #-1,F
BEQ GIVLOS
ASL F ;CHANGE IT TO A WORD INDEX
BIC #177001,F ;CLEAR EXTRA BITS
MOV 2(C),C ;GET THE SPHERE NO. THAT WE ARE GIVING TO
JSR PC,SPRSTP ;STOP IT
MOV C,B ;FOR THE LOCK ROUTINES
MOV #LSPRTN,A ;RUN A ROUTINE IF UNLOCKED
JSR PC,LOCKSW ;GET A LOCK
MOV #PCSPST,LCKWD1(A) ;START PROCESSES IF UNLOCKED
MOV #-1,B ;BECAUSE LCKASW DOES A BIT
MOV #SCLSLK,A ;C-LIST LOCK
JSR PC,LCKASW ;LOCK AN ITEM'S SWITCH
MOV C,A ;GET BACK THE SPHERE
JSR PC,ITM2PL ;LOAD IT UP
MOV PRUNNG,SCLSLK(A) ;PUT MY PROCESS NUMBER THERE
JSR PC,ITM2PO ;POP IT AGAIN
MOV 2(P),B ;WHERE TO PUT IT
JSR PC,CRCLST ;CREATE A C-LIST ENTRY IN HIS C-LIST
BCS GVCAP2 ;C-LIST FULL
BEQ GIVLOS ;DESTINATION OCCUPIED
SAVE <C,B,A>
MOV ITEM1,C ;THIS SPHERE
JSR PC,SPRSTP ;STOP IT (EXCEPT FOR ME)
MOV C,B ;THE ITEM FOR THE LOCKSW ROUTINES
MOV #LSPRTN,A ;RUN A ROUTINE WHEN UNLOCKED
JSR PC,LOCKSW ;LOCK THE SWITCH
MOV #PCSPST,LCKWD1(A) ;START THE PROCESSES WHEN UNLOCKED
MOV ITEM0,LCKWD2(A) ;START ALL THE PROCESSES, EXCEPT ME
REST <A,B,C>
JMP @GIVTAB(F) ;DISPATCH ON TYPE
GIVLOS: ERROR BAD
;THIS ROUTINE CALLS THE APPROPRIATE ROUTINE WITH INFO AS FOLLOWS
;A- POINTER TO CAP DEST.,C- SPHERE OF TAKEE, D-OFFSET OF TAKEE CAP.
;B-C LIST NO. OF DESTINATION,E-C LIST NO. OF TAKEE,F-DISPATCH TYPE
TAKCAP: TST (P)+ ;FIRST ARGUMENT NO LONGER NEEDED
MOV (A),C ;TYPE AND FLAGS OF CAP. TO USE WHEN TAKING AWAY
CMPB C,#.MSCAP ;MASTER SPHERE CAP.
BEQ TKCAP1 ;YES
CMPB C,#.SPCAP ;SPHERE CAP.?
BEQ TKCAP1 ;YES
TKCAP2: ADD #4,P ;POP OFF ARGS
JMP BADEMT
TKCAP1: BIT #.SPCLD,C ;CAN WE DELETE FROM THIS C-LIST
BEQ TKCAP2 ;NO!
MOV (P),B ;WHAT WE ARE SUPPOSED TO TAKE AWAY
BIC #177400,B ;GET THE GOOD BITS
MOV B,E ;THE C-LIST NO. OF TAKEE
MOV 2(A),A ;THE SPHERE NO. OF TAKEE
MOV A,C ;SAVE IT FOR LATER
JSR PC,ITM2PL ;LOAD IT UP
JSR PC,GCLSTA ;DOES THE CAP EXIST
BEQ TAKLOS ;NOPE
MOV B,D ;OFFSET OF TAKEE
ADD A,B ;MAKE B POINT TO IT
MOV (B),F ;CAPABILITY TYPE AND FLAGS
BEQ TAKLOS ;DOESN'T EXIST
CMP #-1,F
BEQ TAKLOS
JSR PC,ITM2PO ;DONE FOR NOW WITH THIS
ASL F ;TURN TYPE INTO WORD INDEX
BIC #177001,F ;CLEAR EXTRA BITS
JSR PC,SPRSTP ;STOP THE SPHERE OF TAKEE
MOV C,B ;FOR THE LOCK ROUTINE
MOV #LSPRTN,A ;RUN A ROUTINE WHEN UNLOCKED
JSR PC,LOCKSW ;GET A LOCK
MOV #PCSPST,LCKWD1(A) ;START THE SPHERE WHEN UNLOCKED
MOV #-1,B ;BECAUSE LCKASW DOES A BIT
MOV #SCLSLK,A ;LOCK THE SPHERES C-LIST
JSR PC,LCKASW ;LOCK AN ITEM'S SWITCH
MOV C,A ;GET THE SPHERE NO
JSR PC,ITM2PL ;LOAD IT BACK UP
MOV PRUNNG,SCLSLK(A) ;PUT MY ITEM NO. THERE
JSR PC,ITM2PO ;POP IT AGAIN
MOV 2(P),B ;THE DESTINATION IN TAKER
SAVE C ;SAVE SPHERE OF TAKEE
MOV ITEM1,C ;CREATE THE C-LIST ENTRY IN THIS SPHERE
JSR PC,CRCLST ;CREATE AN ENTRY
BCS TKCAP4 ;C-LIST FULL
BEQ TKCAP3 ;C-LIST DESTINATION OCCUPIED
ADD ITM1A,A ;MAKE A POINT ABSOLUTELY
REST C ;SPHERE OF TAKEE
JMP @TAKTAB(F)
TAKLOS: JSR PC,ITM2PO
BR TKCAP2
TKCAP3: JMP EIVOK1
TKCAP4: ADD #6,P
JMP BADEMT
;.SINK
;DISABLES FLOATING POINT FOR THIS PROCEEDURE
;ALWAYS SUCCEEDS
ESINK: MOV #PRSLNF,A ;SIZE OF A PROCESS WITHOUT FLOATING POINT AC'S
MOV ITEM0,B ;THE ITEM INDEX OF THE PROCESS
JSR PC,EXITEM ;SHRINK THE PROCESS IF NECESSARY
MOV ITM0A,A ;THE ADDRESS OF THE ITEM
BIC #PFPFLG,PFLAGS(A) ;CLEAR THE FLOATING POINT FLAG IN PROCESS
JMP ERETCZ
;.FLOAT
;ENABLES FLOATING POINT FOR THIS PROCEDURE
EFLOAT: MOV ITM0A,A
BIT #PFPFLG,PFLAGS(A)
BNE EFLOT2
MOV #PRSLFP,A ;SIZE OF PROCESS WITH FLOATING POINT
MOV ITEM0,B ;THE ITEM INDEX OF THE PROCESS
JSR PC,EXITEM ;EXPAND THE PROCESS TO INCLUDE SPACE FOR FLOATING POINT AC'S
BNE EFLOT1 ;IT FAILED
JMP EMTRET
EFLOT1: MOV B,A
JSR PC,ITM0LD ;LOAD THE NEW PROCESS
MOV #40300,PFPPS(A) ;START HIM WITH INT. DISABLED AND IN DOUBLE AND LONG MODE
BIS #PFPFLG,PFLAGS(A)
EFLOT2: JMP ERETCZ
;MAKE THE PROCESS EXECUTING THIS CALL, A USER, AND GIVE THE PROCESS TO THAT USER
;TAKES 3 ARGS, IF FIRST IS NON ZERO, PUT THE NAME OF THE USER INTO THE CURUSR
;LENGTH OF NAME IS SECOND ARG
;POINTER TO NAME IS THIRD
ECRUSR: JSR PC,RETNSW ;GET THE SWITCH
TST A
BGT ECRUS2 ;SET IN THE NAME
BLT ECRUS3 ;RETURN THE NAME
JSR PC,SYSCHK ;JUST CREATE NEW USER
JSR PC,CRUSER ;CREATE A USER
ERRORC EQ,NIT ;NO ITEM AVAILABLE
MOV ITM0A,F ;GET ADDRESS OF THE PROCESS
MOV PUP(F),E ;POINTER TO TOP OF PDL
SAVE #-1 ;PUSH A -1 ONTO USERS STACK
MTPD (E) ;PUT THE WORD BACK
MOV B,PRSUSR(F) ;THE NEW USER FOR THIS PROCESS
MOV PPRTPT(F),F ;THE PROCESS TABLE POINTER
MOV B,PRTUPT(F) ;SAY THE NEW USER IS THIS USER
MOV B,CURUSR ;SAY IT TO EVERYONE
ECRUS2: JSR PC,ECRSET ;SET UP
MOV #10.,F ;MAX LENGTH
1$: JSR PC,GETUBY ;GET A BYTE FROM THE USER
MOVB A,(B)+ ;SAVE THE BYTE
BEQ 2$ ;EXIT IF END OF STRING
SOB F,1$ ;GO FOR UP TO 10 CHARS
CLR -(B) ;TOO MANY CHARS
2$: JMP ERETCZ ;SUCESS
ECRUS1: ERROR BAD
ECRUS3: JSR PC,ECRSET ;SET UP
1$: MOVB (B)+,A
JSR PC,PUTUBY ;GIVE BYTE TO USER
BNE 1$ ;UNTIL END OF STRING
JMP ERETCZ
ECRSET: MOV CURUSR,B ;GET THE PROCESS TABLE ENTRY FOR USER
MOV PRTPPT(B),A ;ITEM NO. OF THE USER
JSR PC,ITM2LD ;LOAD IT UP
JSR PC,RETNSW ;GET THE NAME
MOV A,E ;SAVE ADDRESS
MOV ITM2A,B ;POINT TO USER
ADD #USRNAM,B ;POINT TO NAME
RTS PC
;.TTGIV
;GIVE TTY AWAY, THE FIRST ARGUMENT IS A MASTER SPHERE CAPABILITY
;THE SECOND IS A TELETYPE CAPABILITY
ETTGIV: JSR PC,RETNSW ;GET THE FIRST ARG
MOV A,B ;THE MASTER SPHERE CAPABILITY
BIC #177400,B ;CLEAR THE TOP BYTE
MOV ITM1A,A ;THE ADDRESS OF THE SPHERE IN THE MAP
JSR PC,GCLSTA ;FIND THE CAPABILITY
ERRORC EQ,RNA ;RESOURCE NOT AVAILABLE
ADD B,A ;MAKE A POINT TO THE SPHERE CAP
MOV (A),C ;THE TYPE AND FLAGS
BEQ TTGIV1 ;DOESN'T EXIST
CMPB C,#.MSCAP ;IS IT A MASTER SPHERE CAP.
BNE TTGIV1 ;NOPE, CAN'T DO IT
MOV 2(A),D ;THE SPHERE TO GIVE IT TO
JSR PC,RETNSW ;GET THE SECOND ARG
MOV A,B ;THE ARGUMENT
BIC #177400,B ;CLEAR THE TOP BYTE
MOV ITM1A,A
JSR PC,GCLSTA ;FIND THE CAPABILITY
BEQ TTGIV1 ;COULDN'T FIND IT
ADD B,A ;MAKE A POINT TO THE TTY CAP
MOV (A),C ;TYPE AND FLAGS
BEQ TTGIV1 ;DOESN'T EXIST
CMPB C,#.TTCAP ;IS IT A TTY CAPABILITY
BNE TTGIV1 ;NOPE
MOV 2(A),A ;THE MASTER TTY ITEM NO.
JSR PC,ITM2LD ;LOAD IT UP
MOV ITM1A,B ;POINTER TO THE CURRENT SPHERE
MOV CURSPH,C ;THE CURRETN SPHERE
TTGIV2: CMP C,TTITM(A) ;IS THIS SPHERE THE OWNER OF THE TTY
BEQ TTGIV4 ;YES
TTGIV3: JSR PC,LFLUSH ;WAIT FOR IT
CMP C,TTITM(A) ;DO I OWN IT NOW?
BNE TTGIV3 ;NO
JSR PC,RUNME ;TRY TO GET IT
BR TTGIV2 ;MAKE SURE
TTGIV4: MOV TTYST1(A),STTFG1(B) ;STORE THE CURRENT TTY STATUS
MOV TTYST2(A),STTFG2(B) ;STORE THE EXTRA STATUS WORD
MOV D,SIFTTY(B) ;NEW INFERIOR SPHERE
MOV D,A ;THE SPHERE WE ARE GIVING IT TO
JSR PC,ITM1PL ;BOGUS PUSH
MOV D,A
TTGIV5: JSR PC,ITM1LD ;LOAD UP THE INFERIOR SPHERE
MOV SIFTTY(A),A ;GET THE SPHERE IT GAVE THE TTY TO
BNE TTGIV5 ;HE GAVE IT AWAY
MOV ITM2A,B ;POINTER TO THE TTY ITEM
MOV ITM1A,A ;POINTER TO THE SPHER
MOV CURUSR,TTYU(B) ;FIX USER POINTER
MOV STTFG1(A),TTYST1(B) ;SET UP HIS STATUS
MOV STTFG2(A),TTYST2(B) ;SET UP HIS OTHER STATUS WORD
MOV ITEM1,TTITM(B) ;SET IN THE NEW OWNER
JSR PC,ITM1PO ;GET RID OF HIM
.IFNZ NPC
MOV CURSPH,C
JSR PC,SPRRPC ;PCLOSER EVERY (EXCEPT ME)
MOV ITM0A,A ;POINT TO ME
.IFF
MOV CURSPH,A
JSR PC,SPRPCL ;PCLOSER EVERY (EXCEPT ME)
MOV ITM0A,A ;POINT TO ME
BIC #PPCLSR,PFLAGS(A) ;CLEAR THE PCLOSER BIT
.ENDC
JMP ERETCZ ;SUCCESS
TTGIV1: ERROR BCN ;BAD CAPABILITY
;.TTGET
;GET THE TTY, THE ARGUMENT IS A TTY CAPABILITY
;HANGS UNTIL IT CAN GET THE TTY
ETTGET: JSR PC,RETNSW ;GET THE CAPABILITY NO. OF A TTY CAP.
MOV A,B ;GET THE TTY NO.
BIC #177400,B ;CLEAR THE EXTRA BITS
TTGET1: MOV ITM1A,A
JSR PC,GCLSTA ;FIND THE CAPABILITY
BEQ TTGIV1 ;COULDN'T FIND IT
ADD B,A ;MAKE A POINT TO THE CAPABILITY
CMPB (A),#.TTCAP ;IS IT A TTY CAP
BNE TTGIV1 ;NO, HE IS A LOSER
MOV 2(A),E ;GET THE TTY ITEM NO.
MOV CURSPH,C ;THE CURRENT SPHERE
TTGET2: MOV E,A ;THE TTY NUMBER
JSR PC,ITM1PL ;LOAD THE TTY ITEM
MOV TTITM(A),D ;THE CURRENT OWNER OF THE TTY
MOV D,A
CMP C,A ;DO I ALREADY OWN IT
BEQ TTGET5 ;YES, SUCCEED
TTGET3: JSR PC,ITM1LD ;LOAD THE ITEM
MOV SMSSPT(A),A ;THE MASTER OF THIS SPHERE
CMP A,C ;IS ITS SUPERIOR THE REQUESTOR
BEQ TTGET4 ;SUCESS
CMP SYSSPR,A ;ARE WE AT THE ROOT OF THE SPHERE STRUCTURE
BNE TTGET3 ;LINK THROUGH TO THE NEXT SPHERE
JSR PC,ITM1PO ;CLEAN UP THE STACK
JSR PC,LFLUSH ;GET RID OF YOURSELF FOR A LONG TIME
BR TTGET2 ;TRY AGAIN
TTGET4: MOV E,A ;THE TTY ITEM
JSR PC,ITM2LD ;LOAD IT UP
MOV A,B ;POINTER TO THE TTY ITEM
MOV D,A ;THE SPHERE THAT CURRENTLY OWNS IT
JSR PC,ITM1LD ;LOAD THE OWNER OF THE TTY
MOV TTYST1(B),STTFG1(A) ;STORE THE FLAGS
MOV TTYST2(B),STTFG2(A) ;STORE THE OTHER FLAGS
MOV CURUSR,TTYU(B) ;SET THE USER
MOV CURSPH,A ;THE NEW OWNER OF THE TTY
MOV A,TTITM(B) ;NOW EVERYONE KNOWS
JSR PC,ITM1LD ;LOAD THE NEW OWNER
MOV STTFG1(A),TTYST1(B) ;SET IN THE OLD FLAGS
MOV STTFG2(A),TTYST2(B) ;SET UP OTHER OLD FLAGS
.IFNZ NPC
MOV D,C ;THE OLD OWNER
JSR PC,SPRRPC ;AND HE GETS PCLOSERED
.IFF
MOV D,A ;THE OLD OWNER
JSR PC,SPRPCL ;AND HE GETS PCLOSERED
.ENDC
TTGET5: JSR PC,ITM1PO ;THIS WAS PUSHED SOMEWHERE
MOV ITM1A,A ;POINT TO THE SPHERE
CLR SIFTTY(A) ;NO INFERIOR NOW
JMP ERETCZ
;.SLEEP:
;1 ARG IS TOP 2 WORDS ON STACK (LOW ORDER IS TOP WORD)
;NEGATIVE=>NEGATIVE OF SYSTEM TIME TO CONTINUE
;POSITIVE=>NUMBER OF 60THS TO SLEEP
ESLEEP: MOV PUP(A),B ;GET HIS PDL POINTER
MFPD (B) ;GET TOP WORD
MOV (P),C ;SAVE IT IN C
MTPD (B)+ ;MAKE SURE WE CAN WRITE IT
MFPD (B) ;GET HIGH ORDER WORD
MOV (P),D ;SAVE IT IN D
MTPD (B) ;MAKE SURE WE CAN WRITE IT
MOV #4,PUPDLO(A) ;POP 2 THINGS IF SUCESSFUL
TST D ;IS IT NEGATIVE?
BLT ESLEE1 ;YES, GO SEE IF IT'S TIME YET
NEG C ;NEGATE DOUBLE WORD NUMBER
ADC D
NEG D
SUB TIME,C ;NOW COMPUTE NEGATIVE TIME TO WAKE UP
SBC D
SUB TIME+2,D
SAVE D ;NOW CLOBBER USER'S THING TO NEGATTIVE
MTPD (B) ;CLOBBER HIGH ORDER
SAVE C
MTPD -(B)
ESLEE1: JSR PC,ESLEEC ;CHECK IF TIME IS UP
BLT ESLEE4 ;NOPE SLEEP SOME MORE
JMP ERETCZ ;TIME IS UP, GO AWAY
ESLEE4: JSR PC,SFLUSH ;NOT LONG
ESLEE3: JSR PC,ESLEEC ;WELL, TIME UP NOW?
BLT ESLEE4 ;NOPE
JSR PC,RUNME ;ALL DONE
JMP ERETCZ ;GO RETURN TO USER
ESLEEC: MOV C,A ;COPY TIME TO WAKE UP
MOV D,B
ADD TIME,A
ADC B
ADD TIME+2,B
RTS PC
;RETURN THE SYSTEM STATUS BLOCK TO THE GUY AT THE PLACE HE PASES TO US
ESSTAT: JSR PC,RETNSW ;GET THE ONE ARGUMENT
MOV #SSTATS,B ;POINTER TO THE BLOCK WE GIVE HIM
MOV #NSTATS,C ;AMOUNT OF STUFF TO GIVE HIM
ESSTA1: MFPD (A) ;YEAH DEC!
MOV (B)+,(P) ;WHAT I REALLY WANT TO DO
MTPD (A)+ ;IS GIVE IT TO HIM
SOB C,ESSTA1
JMP ERETCZ
;.QUNLK
;THE FIRST ARG IS THE CAPABILITY NO. OF THE QUE CAP
EQUNLK: JSR PC,RETNSW ;GET THE FIRST ARG
MOV A,B ;GET THE CAP. NO
BIC #177400,B ;CLEAR THE SILLY BITS
MOV ITM1A,A ;THE ADDRESS OF THE SPHERE
JSR PC,GCLSTA ;FIND THE CAPABILITY
ERRORC EQ,BCN
ADD B,A ;MAKE A POINT TO THE CAPABILITY
CMPB (A),#.QUCAP ;IS IT A QUE CAPABILITY
ERRORC NE,BCT
MOV 2(A),A ;THE ITEM NO OF THE QUE
JSR PC,ITM2LD ;LOAD IT UP
INC QUENUM(A) ;UNLOCK (FEATURE: IF NEVER LOCKED, INCREASES MAX LOCKS)
JSR PC,QUECHK ;SHORT FLUSH FIRST GUY ON QUQUE
JMP ERETCZ
QUECHK: TST QUENUM(A) ;CAN ANYONE WIN?
BNE QUECH2 ;YES
QUECH1: RTS PC ;NO
QUECH2: TST QUECNT(A) ;IS ANYONE WAITING?
BEQ QUECH1 ;NO
MOV QUEQUE(A),A ;GET THE FIRST GUY WHO CAN WIN
JSR PC,ITM0PL ;LOAD HIM
SAVE <B,C>
MOV PRSID1(A),B ;ID WORD 1
MOV PRSID2(A),C ;ID WORD 2
MOV ITEM0,A ;THE ITEM
JSR PC,PRSWAK ;SET IT TO WAKE UP
REST <C,B>
JMP ITM0PO ;POP HIM OFF
;REMOVE THE GUY IN ITEM0 FROM THE QUE POINTED TO BY A
;IF HE HAS IT LOCKED, START SOMEONE ELSE, OTHERWISE JUST
;REMOVE HIM
PCQUNL: SAVE A
MOV QUECNT(A),F ;THE NUMBER OF PEOPLE ON THE QUE
BEQ QUNLK7
MOV F,A ;COPY THE COUNT
MOV F,C ;COPY IT AGAIN
ASL A ;TURN IT INTO A WORD INDEX
ADD (P),A ;MAKE IT LESS RELATIVE
ADD #QUEQUE,A ;MAKE A POINT TO THE START OF THE QUE
MOV ITEM0,B ;THE PERSON TO LOOK FOR
QUNLK1: CMP -(A),B ;IS HE HERE
BEQ QUNLK2 ;YES
SOB C,QUNLK1 ;TRY THE NEXT QUE ENTRY
QUNLK7: REST A
SEZ ;SAY HE WASN'T HERE
RTS PC
QUNLK2: SUB F,C ;THE NUMBER OF PEOPLE AFTER HIM
NEG C ;MAKE THE COUNT POSITIVE
SAVE C ;SAVE THE COUNT
BEQ QUNLK4 ;NOBODY AFTER HIM ON THE QUE
QUNLK3: MOV 2(A),(A)+ ;MOVE EVERYONE UP ONE SLOT ON THE QUE
SOB C,QUNLK3
QUNLK4: REST <C,A>
DEC QUECNT(A) ;ONE LESS PERSON ON THE QUE
JSR PC,QUECHK
QUNLK6: CLZ
RTS PC
;.QULK,;THE FIRST ARG IS THE CAPABILITY NO OF THE QUE TO LOCK
EQULK: JSR PC,RETNSW ;GET THE CAPABILITY NO
MOV A,B
BIC #177400,B ;CLEAR THE EXTRA BITS
MOV ITM1A,A
JSR PC,GCLSTA ;GET THE CAPABILITY
ERRORC EQ,BCN ;BAD C-LIST NUMBER
ADD B,A ;MAKE A POINT TO THE CAP
CMPB (A),#.QUCAP ;IS IT A QUE
ERRORC NE,BCT ;BAD TYPE
MOV 2(A),A ;THE ITEM NO OF THE QUE
JSR PC,ITM2LD ;LOAD IT
QULK5: MOV QUECNT(A),C ;THE NUMBER OF PEOPLE ON THE QUE
CMP C,QUEENO(A) ;IS THERE ROOM FOR ONE MORE
BEQ QULK4 ;NO, ENLARGE THE QUE
INC QUECNT(A) ;ONE MORE PERSON ON THE QUE
ASL C ;CHANGE IT INTO A WORD INDEX
ADD A,C ;MAKE C POINT TO THE QUE ENTRY (ALMOST)
MOV PRUNNG,QUEQUE(C) ;PUT HIM ON THE QUE
MOV ITEM2,B ;THE Q ITEM
MOV #LSPPCL,A ;RUN IF PCLOSERED
JSR PC,LOCKSW ;LOCK IT
MOV #PCQUNL,LCKWD1(A) ;FLUSH HIM FROM Q IF PCLOSERED
QULK9: MOV ITM2A,A
TST QUENUM(A) ;CAN I LOCK IT?
BEQ QULK1 ;NO, FULL
CMP PRUNNG,QUEQUE(A) ;AM I FIRST?
BNE QULK3 ;NO, SOMEONE ELSE BEFORE ME
DEC QUENUM(A) ;LOCK
DEC QUECNT(A) ;ONE LESS WAITING
BEQ QULK2 ;NO ONE WAITING NOW
MOV QUECNT(A),B
MOV A,C
ADD #QUEQUE,C
1$: MOV 2(C),(C)+ ;COPY ME OUT OF WAITING LIST
SOB B,1$
QULK2: JSR PC,LSWPOP ;FLUSH THE SWITCH
JSR PC,QUECHK ;START ANYONE ELSE
JMP ERETCZ
QULK3: JSR PC,QUECHK
MOV ITM2A,A
QULK1: JSR PC,LFLUSH ;WAIT A LONG TIME
TST QUENUM(A) ;CAN IT BE LOCKED?
BEQ QULK1 ;NOPE, WAIT
JSR PC,RUNME ;GIVE IT A TRY
BR QULK9
QULK4: MOV QUEENO(A),A ;THE NUMBER OF ENTRIES IN THE QUE
ASH #-6,A ;TURN IT INTO A ITEM SIZE
INC A ;WE WANT TO MAKE IT ONE SIZE LOARGER
MOV (P),B ;THE IUTEM NO FOR EXITEM
JSR PC,EXITEM ;EXPAND THE QUE
ERRORC EQ,NIT ;NO ITEM SPACE AVAILABLE
QULK6: ADD #32.,QUEENO(A) ;MADE IT 16. ENTRIES LARGER
BR QULK5 ;GO TRY TO LOCK IT
;.FONT CALL
;FIRST ARG IS FUNCTION,,FONT #
;SECOND ARG IS POINTER INTO USER CORE
;FUNCTION 0=> READ FONT INTO USER
;FUNCTION .PRWRT=> WRITE FONT FROM USER CORE
.IFNZ NTVS
EFONT: JSR PC,RETNSW ;GET THE FIRST ARG
MOV A,B ;SAVE IT
BIC #177400,A ;GET THE FONT #
CMP #NFONTS,A
ERRORC LE,BAD
SAVE A ;SAVE THE FONT NUMBER
JSR PC,RETNSW ;GET SECOND (USER ADDRESS)
SAVE A
BIT #.PRWRT*400,B ;WRITE TO USER OR FONT?
BNE EFONT9 ;GO TO WRITE THE FONT
BIC #177400,B
ASL B ;MAKE A WORD ADDRESS
MOV FNTITM(B),A ;GET THE FONT ITEM NUMBER
JSR PC,ITM2LD
;NOTE THAT IN CASE OF PCLOSERING, WE DO ALL THIS WORK AGAIN,
;BUT AT LEAST NO HARM IS DONE. BESIDES, IF THE FONT IS BEING
;READ INTO ONLY ONE PAGE, IT CAN ONLY LOSE THE FIRST TIME
;OF COURSE, IF THE USER BITES THE BAG, HIS POINTER DOESN'T POINT
;THE FACT OUT TO HIM.
MOV FNTEND(A),C ;GET THE END POINTER FOR THE FONT
BLE EFNTL ;CALL FAILS IF FONT NOT THERE
REST B ;GET BACK THE USER'S ADDRESS
ASR C ;FOR THE SOB
EFONT8: MFPD (B) ;LET'S HEAR IT FOR DEC!
MOV (A)+,(P) ;AND THE WORD JUST KEEP ON COMING!
MTPD (B)+ ;AND GOING
SOB C,EFONT8 ;LOTS OF TIMES
TST (P)+
JMP ERETCZ ;WIN
;THIS PART READS IN A FONT FROM USER
EFONT9: ADD #FNWIDE,A ;SET THE POINTER TO THE WIDTH
MFPD (A)+ ;GET WIDTH
REST C ;C WILL HOLD IT FOR A WHILE
CMP #16.,C
BLT EFNTL ;CAN'T HAVE A WIDTH OVER 16!
MFPD (A)+ ;HOW HIGH?
REST E ;E WILL KEEP THAT FOR A MINUTE
CMP #454.,E ;HIGHT OF SCREEN!
BLT EFNTL ;DON'T BE SILLY
MFPD (A)+ ;END OF FONT (LENGTH IN BYTES)
REST D ;KEEP IN D
CMP #20000,D ;IS IT MORE THAN 4K?
BLT EFNTL ;WELLL.....
MFPD (A)+ ;THE NUMBER OF TV LINES IN A CHAR LINE
REST F
CMP F,E ;THIS HAD BETTER BE GREATER OR EQUAL TO HEIGHT
BLT EFNTL ;OTHERWISE CHARS WON'T FIT IN A LINE
CMP F,#454. ;IT HAD ALSO BETTER BE LESS THAN OR EQUAL TO SCREEN SIZE
BGT EFNTL ;STRANGE CHARACTERS..
MOV D,F ;COPY THE BYTE COUNT OF THE FONT
ASR F ;FOR THE SOB
MOV (P),B ;GET BACK USER POINTER
EFONT1: MFPD (B)+ ;THIS LOOP PREVENTS US FROM
TST (P)+ ;GETTING SCREWED
SOB F,EFONT1 ;BY A PAGE NOT BEING IN CORE WHEN WE WANT IT
MOV (P),B ;NOW WE WILL CHECK THE LEGALITY OF THE POINTERS
ADD #FNTPNT,B ;POINT TO THE POINTER TABLE
MOV #128.,F ;FOR THE SOB
EFONT2: MFPD (B)+ ;GET A POINTER
TST (P) ;ZERO MEANS NO CHARATCER
BEQ EFONT3 ;WHICH IS FINE
CMP #<FNTPNT+256.>,(P) ;DEFS START AFTER TABLE
BGT EFNTL0 ;UGH
CMP D,(P) ;AND END AT (D)
BLT EFNTL0
EFONT3: TST (P)+ ;YOU'RE OK, POINTER
SOB F,EFONT2 ;CHECK ALL 128. OF THEM
MOV D,A ;LENGTH IN BYTES OF THE TABLE
ASH #-6,A ;NUMBER OF BLOCKS FOR CRITEM
JSR PC,CRITEM ;CREATE AN ITEM OF THE SIZE IN A
BEQ EFNTL ;CAN'T CREATE AN ITEM
MOV B,A ;CRITEM RETURNS THE INDEX IN B
JSR PC,ITM2LD ;LOAD UP THE ITEM WE JUST CREATED
REST C ;THE USER'S ADDRESS
ASR D ;CONVERT TO WORD COUNT
EFONT4: MFPD (C)+ ;READ THE USER'S DATA
REST (A)+ ;A IS INITIALLY SET BY THE ITM2LD CALL
SOB D,EFONT4 ;KEEP MOVING UNTIL WE GET ALL OF HIS DATA
MOV #454.,D ;THE NUMBER OF LINES ON A SCREEN
CLR C ;FOR THE DIVIDE
MOV ITM2A,A ;ADDRESS OF THE FONT ITEM
MOV #ITFNT,(A) ;SET THE TYPE OF THE ITEM
DIV FNTLCL(A),C ;FIND HOW MANY LINES FIT ON A SCREEN
CMP D,FNHIGH(A) ;THE LAST LINE DOES NOT NEED SEPARATOR SPACE
BLT EFON10 ;NOT ENOUGH ROOM FOR ANOTHER LINE
INC C ;WE CAN FIT IN ONE MORE LINE
SUB FNTLCL(A),D ;GET THE AMOUNT TO ADD TO NEXT LINE TO GET TO TOP
;FALLS THROUGH
;FALLS IN
EFON10: MOV C,FNLINE(A) ;THIS MANY LINES FIT ON A SCREEN
SAVE C
MOV D,C ;FOR THE MULTIPLY
MUL #110,C ;COMPUTE THE NUMBER OF BYTES LEFT OVER AT THE BOTTOM OF SCREEN
MOV D,FNREM(A) ;THIS NUMBER MAY BE NEGATIVE IF WE SQEEZED IN AN EXTRA LINE
MOV FNTLCL(A),C ;THE NUMBER OF TV LINES IN ONE CHAR LINE
MUL #110,C ;COMPUTE THE NUMBER OF BYTES IN ONE CHAR LINE
MOV D,FLFINC(A) ;THIS IS THE LINE FEED INCREMENT
REST D ;THE NUMBER OF LINES ON SCREEN
CLR C ;FOR THE DIVIDE
DIV #5,C ;5 SEEMS TO GIVE GOOD RESULTS
MOV C,FNLSC(A) ;THE NUMBER OF LINES TO SCROLL
MOV #576.,D ;NUMBER OF BITS ON A LINE
CLR C ;FOR THE DIVIDE
DIV FNWIDE(A),C ;DIVIDE BY THE NUMBER OF BITS PER CHAR
MOV C,FNLINL(A) ;GET THE NUMBER OF CHARS PER LINE
REST C ;THE FONT NUMBER
ASL C ;CONVERT TO WORD INDEX
MOV FNTITM(C),A ;GET THE ITEM INDEX OF THE CURRENT FONT WITH THIS NUM
MOV B,FNTITM(C) ;NOW THE NEW ITEM IT THIS FONT NUMBER
TST A ;WAS ANYTHING THERE?
BEQ EFONT5 ;NO
JSR PC,DLITEM ;DELETE THE OLD FONT
EFONT5: JMP ERETCZ ;WIN
EFNTL0: ADD #2,P ;POP SOME STUFF
EFNTL: ADD #4,P ;POP GARBAGE OFF THE STACK
EFNTL1: ERROR BAD ;LOSE
.ENDC
;THIS SYSTEM CALL ALLOWS CONTROL OF THE VIDEO SWITCH. BASICALLY,
;THE FIRST ARGUMENT SETS THE SOURCE IN VARIOUS MODES, AND THE
;SECOND ARGUMENT SETS THE DESTINATION IN SIMILAR MODES. FOR
;BOTH SOURCE AND DESTINATION ARGUMENTS, THE GENERAL FORM IS
;A NUMBER IN THE LOW BYTE AND A MODE IN THE HIGH BYTE. THE SOURCE
;USUALLY MEANS THE BUFFER ASSOCIATED WITH THE TV IMPLIED BY THE
;THE MODE AND NUMBER EXCEPT ABSOLUTE GOES DIRECTLY TO THE SWITCH.
;THE MODES ARE:
;.VIABS => JUST PUT THE NUMBER INTO THE APPROPRIATE PART OF SWITCH
;.VILOT => THE NUMBER IS THE LOGICAL NUMBER OF A TTY
; THE SAME NUMBER THAT IS USED IN THE CREATE INVOK.
;.VILOD => THE NUMBER IS THE LOGICAL NUMBER OF A DISPLAY
;.VICAM => THE NUMBER IS THE INDEX OF A CAPABILITY IN THE CALLER'S
; SPHERE, WHICH IS THE TTY OR DISPLAY TO SWITCH IN.
;
;IF THE CALL FAILS, IT IS GENERALLY BECAUSE THE NUMBER IN AN
;ARGUMENT IS INAPPROPRIATE FOR THE MODE, SUCH AS A LOGICAL
;TTY NUMBER THAT IS NOT A TV TTY, OR CAPABILITY THAT IS NOT
;THE APPROPRIATE TYPE ETC.
.IFNZ NTVS
EVIDSW: JSR PC,RETNSW ;GET THE FIRST ARGUMENT, THE SOURCE
MOV A,C ;THE VALUE IS RETURNED IN A
JSR PC,RETNSW ;GET THE SECOND ARG, THE DESTINATION
MOV A,D ;SAVE VALUE IN D
SWAB A ;GET DESTINATION MODE IN LOW BYTE
BIC #177600,D ;ISOLATE THE DESTINATION NUMBER
CMPB A,#.VICAM ;IS IT CAPABILITY MODE
BNE EVIDS2 ;NO
MOV D,B ;THE DESTINATION NUMBER IS CAPABILITY INDEX
MOV ITM1A,A ;ADDRESS OF THE SPHERE ITEM
JSR PC,GCLSTA ;GET THE OFFSET OF THE CAPABILITY INTO SPHERE
BEQ EVID15 ;ERROR, BAD CAPABILITY NUMBER
ADD A,B ;CONVERT OFFSET TO ABSOLUTE ADDRESS
CMPB (B),#.TTCAP ;IS DESTINATION A TTY?
BNE EVIDS1 ;NO
MOV CLSEPI(B),A ;THE TTY ITEM
JSR PC,ITM2LD ;LOAD IT UP
MOV TTLTTY(A),D ;THE LOGICAL TTY NUMBER - WORD OFFSET VERSION
ASR D ;CONVERT WORD OFFSET VERSION TO NUMBER
BR EVIDS3 ;CONTINUE LIKE LOGICAL TTY NUMBER
EVIDS1: CMPB (B),#.DSCAP ;IS DESTINATION A DISPLAY?
BNE EVID15 ;NO, BAD CAPABILITY TYPE ERROR
MOV CLSEM0(B),A ;THE LOGICAL DISPLAY NUMBER - WORD OFFSET
ASR A ;CONVERT WORD OFFSET VERSION TO NUMBER
BR EVIDS5 ;NOW CONTINUE LIKE LOGICAL DISPLAY NUMBER
EVIDS2: CMPB A,#.VILOT ;IS MODE LOGICAL TTY NUMBER MODE
BNE EVIDS4 ;NO
EVIDS3: SUB #NFTV/2,D ;CONVERT TO PHYSICAL TV NUMBER
BLT EVID15 ;ERROR, THIS TTY IS NOT A TV TTY
CMP D,#NTVS ;MAKE SURE ITS A VALIDE TV NUMBER
BGE EVID15 ;NO, BAD TTY NUMBER ERROR
ASL D ;GET WORD OFFSET
MOV TVMAP(D),D ;ARRANGE TO GET THE CORRECT MONITOR
BR EVIDS7 ;NOW PROCESS THE SOURCE ARGUMENT
EVIDS4: CMPB A,#.VILOD ;IS MODE LOGICAL DISPLAY NUMBER MODE
BNE EVIDS6 ;NO
EVIDS5: SUB #NFTVDS,D ;GET PHYSICAL TV NUMBER
BLT EVID15 ;BAD DISPLAY TYPE, MUST BE A TK DISPLAY
CMP D,#NTVS ;MAKE SURE THIS NUMBER IS LEGAL
BGE EVID15 ;ERROR, BAD DISPLAY NUMBER
ASL D ;GET WORD OFFSET
MOV TVMAP(D),D ;ARRANGE TO GET RIGHT MONITOR
BR EVIDS7 ;NOW PROCESS THE SOURCE ARGUMENT
EVIDS6: CMPB A,#.VIABS ;ABSOLUTE MODE?
BNE EVID15 ;NO, THERE ARE NO MORE LEGAL MODES SO ERROR
EVIDS7: MOV C,A ;GET SOURCE MODE
SWAB A ;GET MODE IN LOW BYTE
BIC #177600,C ;ISOLATE THE SOURCE NUMBER
CMPB A,#.VICAM ;CAPABILITY MODE?
BNE EVIDS9 ;NO
MOV C,B ;THE CAPABILITY NUMBER
MOV ITM1A,A ;SPHERE ITEM ADDRESS
JSR PC,GCLSTA ;GET THE OFFSET INTO THE SPHERE OF CAPABILITY
BEQ EVID15 ;BAD CAPABILITY NUMBER ERROR
ADD A,B ;GET THE ABSOLUTE ADDRESS OF CAPABILITY
CMPB (B),#.DSCAP ;IS IT A DISPLAY CAPABILITY?
BNE EVIDS8 ;NO
MOV CLSEM0(B),C ;GET LOGICAL DISPLAY NUMBER
ASR C ;CONVERT FROM WORD OFFSET VERSION TO NUMBER
BR EVID10 ;CONTINUE AS LOGICAL DISPLAY NUMBER
EVIDS8: CMPB (B),#.TTCAP ;IS CAPABILITY A TTY CAP?
BNE EVID15 ;BAD CAPABILITY TYPE ERROR
MOV CLSEPI(B),A ;GET THE TTY ITEM
BR EVID12 ;GET THE BUFFER ASSOCIATED WITH THIS TTY
EVIDS9: CMPB A,#.VILOD ;IS SOURCE MODE LOGICAL DISPLAY?
BNE EVID11 ;NO
EVID10: SUB #NFTVDS,C ;MAKE SURE IT'S A TV DISPLAY
BLT EVID15 ;ERROR, MUST BE A TK DISPLAY
CMP C,#NTVS ;MAKE SURE IT'S A VALID TV NUMBER
BGE EVID15 ;ERROR, IT'S NOT
MOVB TVDSBF(C),C ;GET THE BUFFER ASSIGNED TO THIS DISPLAY
BLT EVID15 ;NO BUFFER ASSIGNED TO THIS DISPLAY
BR EVID14 ;SWITCH IN THE NUMBERS
EVID11: CMPB A,#.VILOT ;IS SOURCE LOGICAL TTY NUMBER MODE?
BNE EVID13 ;NO
CMP C,#NTTYS ;IS THIS A VALID TTY NUMBER?
BGE EVID15 ;NO, ERROR
TST C ;MAKE ABSOLUTELY SURE
BLT EVID15 ;AHA! IT'S NEGATIVE, THEREFOR ERROR
ASL C ;CONVERT TO WORD OFFSET
MOV TTYITM(C),A ;GET THE ITEM FOR THIS TTY
BLE EVID15 ;THIS TTY HAS NO ITEM
EVID12: JSR PC,ITM2LD ;LOAD IT UP
MOV TVBUF(A),C ;GET THE BUFFER NUMBER FOR THIS TTY
BLT EVID15 ;ERROR, NO BUFFER ATTACHED TO THIS TTY
BIC #TVMOV,C ;CLEAR OUT THE ALU FUNCTION
BR EVID14 ;GO AHEAD AND SWITCH IN THE ARGUMENTS
EVID13: CMPB A,#.VIABS ;IS IT ABSOLUTE MODE?
BNE EVID15 ;NO MORE MODES, THUS ERROR
EVID14: SWAB D ;DESTINATION GOES IN HIGH BYTE
BIS D,C ;SOURCE IN LOW BYTE
MOV C,VIDSW ;SWITCH IT
JMP ERETCZ ;THAT'S ALL FOLKS.
EVID15: ERROR BAD ;SOMETHING WENT WRONG
;INVOK OF COLOR MAP
CAPRCM: TST (P)+ ;GET RID OF LAST ARG
REST <E,F> ;GET THE ONES WE NEED
BLT CPRCM1 ;BRANCH TO SET UP CORESPONDENCE
MOV #.CMRED!.CMGRN!.CMBLU,D ;SET UP FOR XOR
XOR D,F ;SO THEY LOOK SENSIBLE TO THE USER
MOV E,COLORD ;VALUE TO SET TO
MOV F,COLORA ;ADDRESS TO SET
CPRCM1: MOVB E,B ;COPY CAP NUMBER
MOV ITM1A,A ;POINT TO SPHERE
JSR PC,GCLSTA ;GET CAP
ERRORC EQ,BCN
ADD A,B ;POINT TO IT
CMPB (B),#.DSCAP ;IS IT A DISPLAY?
ERRORC NE,BCT ;NOPE
MOV CLSEM0(B),C ;GET DISPLAY NUMBER
ASR C ;CONVERT TO NUMBER
SUB #NFTVDS,C ;GET TV NUMBER
ERRORC LT,BCT ;OOOPS, IT IS A TK DIS
MOVB TVDSBF(C),C ;GET TV BUFFER NUMBER
ERRORC LT,BCT ;NO BUFFER?
.ENDC
.SBTTL INVOKE CAPABILITY ROUTINES
CAPRCC: TST (P)+ ;ONLY WANT TWO ARGS
ASL C ;THE CAPABILITY TYPE TO CREATE
CMP C,#CAPHGH ;IS HE ASKING FOR A NON-EXISTANT TYPE?
BGE CAPRC1 ;LOSER!
ADD #CCTAB,C
CPYCA1: MOV E,D ;CAP NUMBER
MOV 2(P),B ;CAP DESTINATION
MOV (P)+,(P) ;SECOND ARG
SAVE <C> ;ADDRESS OF ROUTINE
MOV ITEM1,C
JSR PC,CRCLST
BEQ CAPRC4 ;THE C-LIST ENTRY WAS USED
BCS CAPRC1 ;FULL C-LIST
ADD ITM1A,A ;MAKE A POINT ABSOLUTELY TO ENTRY
REST <C,E> ;ROUTINE ADDRESS AND SECOND ARG
SAVE <B,A>
MOV #-1,(A)+ ;SAVE THIS SPACE
CLR (A)+
CLR (A)+
CLR (A)+
CLR (A)+
MOV #LSPPCL,A
MOV ITEM1,B
JSR PC,LOCKSW
MOV (P),LCKWD2(A)
MOV #CAPRC5,LCKWD1(A)
MOV C,A ;ROUTINE ADDRESS
CLR C
JSR PC,@(A)
;THE ROUTINE WE CALL IS EXPECTED TO RETURN:
;IN A THE CAP TYPE AND FLAGS
;IN B THE PRIMARY ITEM
;THE SECONDARY ITEM IS NEVER RETURNED
;IN C THE FIRST MISC WORD
;THE SECOND MISC WORD IS NEVER RETURNED
;THE ROUTINE SHOULD SET Z IF IT FAILS, OTHERWISE CLEAR IT
BEQ CAPRC3 ;FAILURE
REST F
MOV A,(F)+ ;THE TYPE AND FLAGS
MOV B,(F)+ ;THE PRIMARY ITEM
TST (F)+ ;NO SECONDARY ITEM
MOV C,(F)+ ;THE 1ST MISC WORD
REST <B>
JSR PC,GIVPSW
JSR PC,LSWPOP ;LOCK ON CAP
JMP ERETCZ ;SUCESS
CAPRC1: CMP (P)+,(P)+
CAPRC2: JMP BADEMT
CAPRC3: CLR @(P) ;FREE CAP SLOT
CAPRC4: ERROR BCN ;FAIL
CAPRC5: MOV LCKWD2(B),B
CLR (B) ;RELEASE CAP SPACE
RTS PC
.SBTTL START THE WORLD ROUTINE
GO: RESET
MOV #PDL,P ;SET UP THE PDL
MOV #RUGVEC,A ;POINTER TO VECTOR STORAGE
MOV #BPTBRV,B ;THE VECOTR
MOV (B),(A)+ ;THE STUFF
MOV #BPTBRK,(B)+ ;SET UP OUR VECTOR
MOV (B),(A)+ ;STORE STATUS
MOV #340,(B)+ ;SET UP INFINITE PRIORITY
JSR PC,PARIN ;INITIALIZE THE PARITY STUFF
JSR PC,TYINIT ;INITIALIZE THE TTY'S
JSR PC,MAPSET ;SET UP THE INTIAL MAP
JSR PC,INITTB ;LINK UP LISTS
JSR PC,MEMTST ;SET UP MEMORY TABLES
JSR PC,CLKIN ;START UP THE CLOCK
;FALL THROUGH TO NEXT PAGE TO START UP THE SYSTEM PROCESS, ETC.
;FALLS IN FROM PREVIOUS PAGE
;START UP THE SYSTEM PROCESS
JSR PC,CRUSER ;CREATE A USER
MOV B,CURUSR ;HE IS THE CURRENT USER
MOV #2,PRTPRI(B) ;INCREASE HIS PRITORITY
JSR PC,CRSPHR ;CREATE A SPHERE FOR HIM
MOV A,SYSSPR ;THE SYSTEM SHPERE
MOV A,C ;SAVE THE SPHERE ITEM#
JSR PC,CRPROC ;CREATE A PROCESS
MOV C,B ;PUT THE SPHERE ITEM IN THE RIGHT PLACE
JSR PC,PUTPRS ;PUT THE PROCESS INTO THE SPHERE
MOV A,D ;SAVE THE PROCESS ITEM
JSR PC,ITM0LD ;MAKE PROCESS ITEM 0
MOV A,C ;SAVE ADDRESS
MOV B,A ;GET SPHERE ITEM #
JSR PC,ITM1LD ;MAKE SPHERE ITEM1
ADD #SUPTS,A ;GET A POINTER TO THE UPTS
MOV #20,D ;THERE ARE 20 PAGES
CLR E ;WE WILL SET UP MAP TO ABS CORE FOR THIS SPHERE
SYSJI1: MOV #UPTABS,(A)+ ;AN ABSOLUTE PAGE
MOV E,(A)+ ;THE AR
MOV #77406,(A)+ ;THE DR
ADD #200,E ;GO TO NEXT PAGE
BIC #176000,E ;FOR THE OVERFLOW INTO I SPACE
SOB D,SYSJI1 ;DO FOR 20 PAGES
CLR B ;CAPABILITY ZERO
JSR PC,AGCLAD ;GO GET THE ADDRESS
MOV #.CCCAP,(A) ;A CREATE CAPABILITY CAPABILITY
MOV #1,B ;CAPABILITY ONE
JSR PC,AGCLAD ;GO GET THE ADDRESS
MOV #.MSCAP,(A) ;MAKE IT A MASTER SPHERE CAPABILITY TO ITSELF (!!!!)
BIS #MSPCBT!.SPFES,(A)+ ;EVERYTHING AND NO ENTERS
MOV SYSSPR,(A) ;THSI IS IT
MOV #30.,E ;THE NUMBER OF SLOTS OF USERS TO TRY TO START
SAVE C ;SO THAT IT DOESN'T GET CLOBBERED
JSR PC,CCPRCL ;CREATE A CORE LINK
REST C
MOV B,TTYCL ;SET UP POINTER TO THE CORE LINK FOR TTY ROUTINES
MOV #2,B ;THE CAPABILITY 2
JSR PC,AGCLAD ;GET THE ADDRESS
MOV #.CLCAP!.CLCONS,(A)+ ;SET IN THE FLAGS
MOV TTYCL,B ;GET THE POINTER TO IT
MOV B,(A)+ ;SET IT IN
MOV B,A ;GET IT
JSR PC,ITM2LD ;LOAD IT
MOV ITEM0,CLCONP(A) ;SET IN CONSUMER POINTER
MOV #SYSJOB,PUPC(C) ;SET THE THINGS PROGRAM COUNTER
MOV #SYSJPD,PUP(C) ;AND ITS PDL POINTER
BIC #PSUPSB,PSTOP(C) ;CLEAR THE STOP BIT
MOV ITEM0,A
JSR PC,PSTPDC ;GO DECREMENT THE STOP COUNT AND PUT ON RUN Q
MOV #5*2,HSECS ;THE WORLD STARTS 5 SECONDS AGO (RUN THAT BY AGAIN???)
CLR INITSW ;EXITING INIT CODE
JMP SCHED ;GO GO GO!
;INITIALIZE THE CLOCK THAT EXISTS TO TICK AT 60. HZ
CLKIN: SAVE BEBRV ;FIND OUT WHICH CLOCK WE HAVE
MOV #CLKIN1,BEBRV ;GO TO GOPC FOR PROGRAMMABLE CLOCK
MOV #100,LCCS ;TRY TO START THE LINE CLOCK
BR CLKIN2 ;WON'T GET HERE IF UNSUCESSFUL
CLKIN1: SPL 0 ;IN CASE SET BY THE BREAK
CMP (P)+,(P)+ ;FLUSH SAVED THINGS
MOV #1666.,PCCB ;WE HAD BETTER HAVE A PROGRAMMABLE CLOCK!
MOV #111,PCCS ;LINE FEQUENCY, REPEAT INT, ETC.
CLKIN2: REST BEBRV ;WE HAVE SET UP THE CLOCK
RTS PC
;INIT THE TABLES AND HARDWARE REGISTERS ASSOCIATED WITH PARITY
PARIN: SAVE BEBRV ;TO TRAP NON-EX PARITY REGISTERS
MOV #PARIN1,BEBRV
MOV #PARREG,A ;POINT TO THE BEGINING OF THE TABLE
MOV #PARCSR,B ;POINT TO THE BEGGINING OF THE HARWARE REGISTERS
MOV B,C
MOV #20,D ;THERE MAY BE AS MANY AS 16. OF THEM
PARRCK: MOV #1,(B)+ ;ENABLE THE PARITY CHECKING
MOV C,(A)+ ;SKIPPED IF REG NOT THERE
PARIN2: ADD #2,C ;UPDATE THE POINTER TO THE REGISTER THAT IS STORED AWAY
SOB D,PARRCK
REST BEBRV
RTS PC
PARIN1: CMP (P)+,(P)+ ;CLEAR CRAP OFF STACK
SPL 0
BR PARIN2
;INITIALIZE VARIOUS TABLES
INITTB: MOV #INITLS,A ;THINGS TO LINK INTO FREE LISTS
INTLST: MOV (A)+,B ;GET THE TABLE ADDRESS
BEQ INTLS1 ;DONE WITH THESE THINGS
MOV (A)+,C ;GET THE ADDRESS OF THE FREE POINTER
MOV (A)+,D ;GET THE NUMBER OF THINGS
MOV (A)+,E ;GET THE LENGTH OF THEM
MOV B,(C) ;SET UP THE FREE POINTER
MOV B,C ;COPY POINTER INTO TABLE
INTLS2: ADD E,C ;POINTER TO NEXT ONE
MOV C,(B) ;GET PUT INTO THIS ONE
ADD E,B ;GO TO NEXT ONE
SOB D,INTLS2 ;HOWEVER MANY TIMES
BR INTLST
INTLS1: MOV #INITM1,A ;STUFF TO MAKE -1
INTM11: MOV #-1,(A)+
CMP #EINTM1,A
BNE INTM11
MOV #ITMBIT,A ;THE BIT TABLE POINTERS
MOV #ITMBTP,B
MOV #NITMBL,C
INTBT1: MOV A,(B)+ ;POINTER TO A BIT TABLE
ADD #22,A ;FURTHER ON
SOB C,INTBT1 ;FOR SO MANY BIT TABLES
RTS PC
;THIS SYSTEM CALL IS EXECUTED BY THE SYSSPR TO PROVIDE A PC
;TO DO SOME HOUSEKEEPING FUNCTIONS. IT DELETES UPTS PLACED ON THE DLU LIST
ESYSJB: JSR PC,SYSCHK
ESYSJ4: TST DLULST ;ANY ON THE LIST?
BNE ESYSJ3
JSR PC,SFLUSH
ESYSJ1: TST DLULST
BNE ESYSJ2
JSR PC,SFLUSH ;HANG
BR ESYSJ1 ;FOREVER
ESYSJ2: JSR PC,RUNME
ESYSJ3: MOV DLULST,A ;GET POINTER TO FIRST TO ACT ON
MOV DLUUPT(A),B ;GET THE UPT
JSR PC,UPTDL ;DELETE IT
INC SYSUPD ;SAY WE DID SOMETHING
MOV (A),DLULST ;FLUSH NODE FROM LIST
MOV DLUFRE,(A) ;ADD IT TO THE FREE LIST
MOV A,DLUFRE
BR ESYSJ4 ;TRY AGAIN
SYSCHK: CMP CURSPH,SYSSPR ;IS THIS THE SYSTEM SPHERE
ERRORC NE,SYS
RTS PC
SYSJOB: SAVE <#10,#MFITST,#.FACAP*400>
$INVOK ;MAKE A ROOT MFI
REST <A> ;ROOT CAP IN A
SAVE <#-1,#0,A>
BIS #.CPYCP,(P) ;COPY THE ROOT CAP
$INVOK
REST C
SAVE <#0,#MFIDSC,C>
BIS #.FAMU,(P) ;GET THE DESCRIPTOR FILE
$INVOK
SAVE <C,C> ;FOR THE WRDI
$WRDI
REST F ;GET THE BASE YEAR
$WRDI ;GET THE START
SAVE C
$WRDI ;AND LENGTH
SAVE <#0> ;DISK NUMBER
$ALLOC
SAVE <,,C> ;DELET ETHE CAP
BIS #.DELCP,(P)
$INVOK
SAVE <#-1,#0,A>
BIS #.CPYCP,(P) ;COPY THE ROOT CAP
$INVOK
REST <B> ;BITS CAP WIL BE IN B
SAVE <#0,#MFIBIT,B>
BIS #.FAMU,(P)
$INVOK
SAVE <#0,F,B>
BIS #.FAMB,(P) ;SET UP BIT TABLE
$INVOK
SAVE <,,B>
BIS #.DELCP,(P)
$INVOK ;DELETE CAP TO BITS FILE
SAVE <#-1,#0,A>
BIS #.CPYCP,(P)
$INVOK
REST C
SAVE <#0,#MFISYS,C>
BIS #.FAMU,(P) ;MUTATE THE ROOT
$INVOK
SAVE <#<7*400>,#0,#13777,#.CRWRT+1> ;SET UP FRESH PAGE IN PAGE 7-17
$MAP
MOV #ABSLD,A
MOV #<<ABSEND-ABSLOD>/2>,B ;NUMBER OF WORDS
MOV #160000,D ;TOP PAGE
1$: MOV (A)+,(D)+
SOB B,1$
MOV C,SYSFCP ;POINTER TO SYSTEM FILE CAPABILITY
SAVE <#<7*400>,#0,#10000+377,#.CRWRT+1> ;SET UP FRESH PAGE IN PAGE 0-10
$MAP
SAVE <#<7*400>,#0,#10400+377,#.CRWRT+1> ;SET UP FRESH PAGE IN PAGE 1-11
$MAP
JMP 160000 ;START IT UP
LSTILC=. ;PUT THIS AT THE LAST INSTRUCTION LOCATION
FSTFRB==<<<.!1777>+1>_-10.>&77 ;FIRST FREE BLOCK
.MACRO PAD A,B
.PRINT /A B
/
.ENDM
.IF2
PAD ^/SYSTEM END =/,\.
.IRP Y,<0,1,2,3>
.IRP X,<0.,1.,2.,3.,4.,5.,6.,7.,8.,9.>
.IIF Z <<<FSTFRB+1>/2>-Y''X>,PAD Y''X,<K>
.ENDM
.ENDM
.ENDC
.END GO
Reference in New Issue View Git Blame Copy Permalink