folkert/simh-testsetgenerator
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1
simh-testsetgenerator/PDP11/11logo/system.327

3103 lines
No EOL
67 KiB
Text
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.

.TITLE PDP11 LOGO
FOO==VERNF
VERN==%FNAM2
FOO==VERNF
.STITL CONFIGURATION PARAMTERS
.IF1
.PRINT /0=>FULL 1=>NO DEBUG 2=>QUERY
ASSSW=/
.TTYMAC FLAG
ASSSW=FLAG
.ENDM
.IFZ ASSSW
DEBUG==1
DISASS==1
GCDBUG==1
MNUSRS==10.
MNSLTS==5
.ENDC
.IFZ <ASSSW-1>
DEBUG==0
DISASS==0
GCDBUG==1 ;ZERO LATER, BUT DOESN'T WORK YET
MNUSRS==4
MNSLTS==2
.ENDC
.IFZ <ASSSW-2>
.MACR SETFLG FLG
.PRINT /FLG=/
.TTYMAC FLAG
FLG==FLAG
.ENDM
.ENDM
SETFLG DEBUG
SETFLG DISASS
SETFLG GCDBUG
SETFLG MNUSRS
SETFLG MNSLTS
.ENDC
.ENDC
.MACR FOR FLG
.XLIST
.IFNZ FLG
.LIST
.ENDM
.MACR ENDC FLG
.XLIST
.IFZ FLG
.LIST
.ENDC
.LIST
.ENDM
.STITL SYSTEM PARAMETERS
A=%0
B=%1
C=%2
D=%3
E=%4
F=%5
U=%5
P=%6
SP=%6
PC=%7
ERROR=TRAP
RUG=100000 ;DONT CHANGE THE S.A., RADIA!!
SKPRET==EMT
;DEVICE INFORMATION
;CONSOLE SWITCHES
SWB=177570 ;CONSOLE SWITCH DATA
;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
;DM11
;BREAK LEVEL 5
DMRBRV=310 ;DM11 RECEIVER BREAK VECTOR
DMTBRV=314 ;DM11 TRANSMITTER BREAK VECTOR
DMCSR=175000 ;DM11 CONTROL AND STATUS REGISTER
DMBAR=175002 ;DM11 BUFFER ACTIVE REGISTER
DMBCR=175004 ;DM11 BREAK CONTROL REGISTER
DMTBR=175006 ;DM11 TABLE BASE REGISTER
;PROGRAMMABLE CLOCK
;BREAK LEVEL 6
PCBRV=104 ;PROGRAMMABLE CLOCK BREAK VECTOR
PCS=172540 ;PROGRAMMABLE CLOCK STATUS
PCSTBF=172542 ;PROGRAMMABLE CLOCK SET BUFFER
PCCNT=172544 ;PROGRAMMABLE CLOCK COUNTER
;RF11/RS11 DISK
;BREAK LEVEL 5
DSKBRV=204 ;DISK BREAK VECTOR
DSKS=177460 ;DISK STATUS REGISTER
DSKDBR=177472 ;DISK DATA REGISTER
DSKWC=177462 ;DISK WORD COUNT
DSKCA=177464 ;DISK CURRENT ADDRESS
DSKA=177466 ;DISK ADDRESS
DSKAE=177470 ;DISK EXTENDED ADDRESS
DSKMT=177474 ;DISK MAINTENCE(WELL...)
DSKSG=177476 ;DISK SEGMENT
;TK DISPLAY
;BREAK LEVEL 7?
DISBRV=270 ;DISPLAY BREAK VECTOR
NGCSR=164040 ;DISPLAY CONTROL AND STATUS REGISTER
NGREL=164042 ;DISPLAY RELOCATION REGISTER
;DC11 HIGH SPEED LIN INTERFACE
;BREAK LEVEL 5
DCRBRV=300 ;RECIEVE BREAK VECTOR
DCRS=174000 ;RECIEVE STATUS WORD
DCRB=174002 ;RECIEVE BUFFER
DCTBRV=304 ;TRANSMIT BREAK VECTOR
DCTS=174004 ;TRANSMIT STATUS
DCTB=174006 ;TRANSMIT BUFFER
;POWER FAIL
PFBRV=24
;BUS ERRORS
BEBRV=4
;TRAPS
TRPBRV=34
EMTBRV=30
IOTBRV=20
BPTBRV=14
PWFBRV=24
;EAE REGISTERS
DIVIDE=177300
AC=177302
MQ=177304
MULTIP=177306
SR=177310
EAESR==177311
NORMAL=177312
LGS=177314
ARS=177316
SIPRBT==2
MQZ==10
;PSSESOR STATUS
PS=177776
.STITL ALLOCATION PARAMETERS
SYPDLL==100
TMPDLL==20
PPDLL==600
SPDLL==600
DBUFL==400
DDIRBL==400
DTIBFL==2000
DEDBFL==2000
DDIRL==2000
DWRTEC==103
DREADC==105
DWRTCC==107
FRTRCF==1
SWTRCF==2
SPTRCF==4
GCTRCF==10
FRSCED==1 ;FLUSHED DUE TO SCEDULEING
FRDSKW==3 ;HANGING ON DISK
FRTYIW==4 ;HANGING ON TYI OF CHAR
FRTYOW==5 ;HANGING ON FULL TYO BUFFER
FRRAND==6 ;HANGING FOR "UNKNOWN" REASON
FRNEWU==7 ;HANGING BECUASE HAVE NOT YET BEEN INITIALIZED
FRTYIH==10 ;HANGING ON LINE INPUT
.STITL MACROS
.MACR PUSH AA
MOV AA,-(P)
JSR PC,PPUSHT
.ENDM
.MACR POP AA
MOV (P)+,AA
JSR PC,PPOPT
.ENDM
.MACR PUSHS AA
JSR PC,SPUSHT
MOV AA,@S
.ENDM
.MACR POPS AA
MOV @S,AA
JSR PC,SPOPT
.ENDM
.MACR SPUSH AA
MOV AA,-(P)
.ENDM
.MACR SPOP AA
MOV (P)+,AA
.ENDM
.MACR SPUSHS AA
SUB #2,S
MOV AA,@S
.ENDM
.MACR SPOPS AA
MOV @S,AA
ADD #2,S
.ENDM
.MACR TEXT AA
.XLIST
.ASCII \AA\
.BYTE 0
.EVEN
.LIST
.ENDM
.MACR PRTXT AA
.XLIST
JSR PC,ERTAS
TEXT ^\AA\
.LIST
.ENDM
.MACR PRCR
JSR PC,.CRLF
.ENDM
.MACR SPACE
JSR PC,.SPACE
.ENDM
.MACR TIMER A
JSR PC,.TIME
.ENDM
.MACR UNTIME A
JSR E,.UTIME
A
.ENDM
.MACR UTIMER A
JSR PC,.TIME
.ENDM
.MACR UUNTIM A
MOV #A,.+20
ADD USER,.+12
JSR E,.UTIME
0
.ENDM
.MACR REPT1 A,B
.XLIST
.REPT A
B
.ENDR
.LIST
.ENDM
.MACR REPT2 A,B,C
.XLIST
.REPT A
B
C
.ENDR
.LIST
.ENDM
.MACR NOP NUM
.XLIST
.IFG NUM
BR .+<NUM*2>
NOP <NUM-1>
.ENDC
.LIST
.ENDM
.MACR EXCH LOC1,LOC2
MOV LOC1,EXCH1
MOV LOC2,LOC1
MOV EXCH1,LOC2
.ENDM
.MACR PAD A,B
.PRINT \A B\
.ENDM
.STITL TRAP VECTORS
;TRAP VECTORS
;UNUSED VECTORS
.=0
REPT2 100,.+2,IOT ;GO TO 2ND WORD OF VECTOR AND DIE
.=TRPBRV
ERRBK ;TRAP IS USED FOR ERRORS
0
.=TKBRV
TKBRK ;CONSOLE TTY KEYBOARD
200 ;IS ON BR4
.=TPBRV
TPBRK ;CONSOLE TTY PRINTER
200 ;IS ON BR4
.=PCBRV
CLKBRK ;PROGRAMMABLE CLOCK
300 ;IS ON BR6
.=DSKBRV
DSKBRK ;FIXED HEAD DISK
300 ;IS ON BR5, INT ROUTINE RUNS ON LEVEL 6
.=DISBRV
DISBRK ;DISPLAY
240 ;???????????
.=DMRBRV
DMRBRK ;DM11 RECEIVE
240 ;?
.=DMTBRV
DMTBRK ;DM11 TRANSMIT
240 ;?
.=IOTBRV
IOTBRK
340
.=EMTBRV
EMTBK
340
.=DCRBRV ;DC11 RECIEVE
DCRBRK
240
.=DCTBRV ;DC11 TRANSMIT
DCTBRK
240
.STITL SYSTEM VARIABLES(ONE COPY)
.=400
JMP START
.=.+SYPDLL ;SYSTEM PDL
SPDLP: . ;SYSTEM PDL POINTER
PAT:
PATCH: .=.+200 ;PATCH AREA
PATEND:
.=770
LVERNF: VERNF
.=<.!377>+1
DMCA=.-NFDMTY
.=.+40 ;DM11 CURRENT ADDRESS
DMWC=.-NFDMTY
.=.+40 ;DM11 -BYTE COUNT
.=.+40 ;DM11 BIT ASSEMBLY TABLE
.=.+40 ;UNUSED
DMTT: .=.+200 ;DM11 TUMBLE TABLE
TKBRK: MOV TKB,CHI
BIC #177600,CHI
CMP CHI,BRKCHR
BNE TKBRK1
MOV PC,BRAKE
TKBRK1: RTI
TPBRK: HALT
DISBRK: HALT
DMRBRK: HALT
DMTBRK: HALT
TMPDLP: TMPDL
TMPDL: .=.+<TMPDLL*2>
ELAPSE: 0
0
USER: -1
ULAST: 0 ;LAST USER WHO WAS RUN
NULTIM: 0
0
TIME: 0 ;TIME IN 1/100 TH'S OF A SEC
0 ;FROM START OF SYSTEM RUN
QUANT: 4 ;UQUANT SET FRCM THIS
UQUANT: 0 ;TIME IN 1/100THS USER SHOULD RUN
NRABLU: 0 ;NUMBER OF USERS WITH FLSADR=0
NSWPU: 0 ;NUMBER OF USERS ASSIGNED TO SLOTS BUT NOT YET IN
NINU: 0 ; " " " " " " AND ALREADY IN
PUSPSL: 0 ;PREFERED USER SLOT TO SWAP
PUSRSP: 0 ;PREFERED USER TO SWAP OUT
SWPLEP: SWPLST ;PLACE TOO PUT NEXT REQ
SWPLST: .=.+<MNSLTS*2>+2 ;LIST OF SWAP REQUESTS
MSWPOR: .=.+<16*MNSLTS*2> ;MOBY SWAP IN AND OUT BLOCKS
SYSWPR: .=.+<16*MNUSRS> ;10 DISK REQUEST BLOCKS FOR GENERAL USE
DSKCRB: 0 ;CURRENT DISK REQUEST
SLOTST: .=.+<MNSLTS*4> ;WORD 1 = SLOT USER
;WORD 2 = NEG, USER COMING IN; 1, USER JUST IN, >1 USER IN A WHILE
0 ;SO END TEST ALWAYS WORKS
0
DKRTYS: 0 ;# OF DISK RETRYS
CORTOP: 0 ;FIRST NON-EX LOCATION
NUNODE: 0 ;NUMBER OF NODES PER USER
NUSERS: 1 ;NUMBER OF USERS
NSLOTS: 1 ;NUMBER OF IN CORE SLOTS
NUSER2: 2
FOO==0
.MACR MSWF
MSWPOR+FOO
FOO==FOO+34
.ENDM
SLTCAD: REPT2 MNSLTS,MSWF,0
USWCNT: 0 ;NEGATIVE LENGTH OF USER SLOT
USLENT: 0 ;LENGHT OF SLOT IN BYTES
DUSECT: 0 ;COUNT OF SYSTEM DISK USAGES MOD 256
DSKDST: 20000 ;DISK OFFSET( NO USER OR SYSTEM CRAP BEFORE HERE)
2
DCLRUS: 20000 ;ADDRESS OF CLEAR USER IMAGE
2
DCRBFS: 40000 ;ADDRESS OF RECIEVE BUFFERS
2
DCTBFS: 42000 ;ADDRESS OF TRANSMIT BUFFERS
2
DSKRND: 140000 ;START OF RANDOM USER STORAGE
2
SNXTDB: 100000 ;NEXT BLOCK AVAILABLE
2
SDSKAD: 100000 ;BASE OF SYSTEM DISK BLOCKS
2
SDBITB: 1 ;SYSTEM DISK BIT TABLE
REPT1 7,0
SDBITE: 100000
SFLAGS: 0 ;RANDOM SYSTEM FLAGS
LOCKUS: -1 ;INDEX OF USER LOCKED IN CORE
GCLOCK: -1 ;USER USING GARBAGE COLLLECTOR IS LOCKED IN
CRMES: .BYTE 15,0 ;CR FOR ERTAP
RWWSW: 0
BRKCHR: 0 ;THE BREAK CHAR FOR TODAY!
JDCSW: 0
;DISPLAY SYSTEM VARIABLES
DLEN==400 ;LENGTH OF EACH DISPLAY LIST (IN BYTES)
DPDLL==60 ;LENGTH OF EACH DISPLAY PDL (IN BYTES)
TLEN==20 ;LENGTH OF EACH TURTLE LIST (IN BYTES)
SDPDLL==60*3 ;TOTAL LENGTH OF DISPLAY PDL AREA (IN BYTES)
SDLEN==400*3 ;TOTAL LENGTH OF DISPLAY LIST AREA (IN BYTES)
STLEN==20*3 ;TOTAL LENGTH OF TURTLE LIST AREA (IN BYTES)
DCONS: ;USER DISPLAY CONSOLE TABLE
.BYTE 0
.BYTE 1
.BYTE 2
REPT1 5,.BYTE -1
SDISBT: ;EACH ENTRY HAS A 1 IN THE NTH BIT OVER
.BYTE 1,2,4
.EVEN
SDPDLP: ;DISPLAY PDL POINTER TABLE
<DPDL-DISREL>+<DPDLL*<0+1>>
<DPDL-DISREL>+<DPDLL*<1+1>>
<DPDL-DISREL>+<DPDLL*<2+1>>
STLIST: ;TURTLE DISPLAY LIST AREA TABLE
REPT1 3,TLIST+<TLEN*.RPCNT>
;DISPLAY TEMPORARIES
;THESE MUST BE IN THIS ORDER
NEWX: .WORD 0,0 ;NEWX IS A TEMPORARY STORAGE FOR ROUTINES
; LIKE SETXY. IT CONTAINS WHAT CURX WILL BE SET
; TO IF THE ROUTINE DOESN'T
; ENCOUNTER A FATAL ERROR
NEWY: .WORD 0,0 ;LIKE NEWX
;END OF ORDER
TUT: 0 ;TURTLE TOP. POINTS TO TOP OF TURTLE DISPLAY LIST
SNPTEM: 0 ;USED BY GARBAGE COLLECTOR
EXCH1: 0
.CSRET==-127.
GCMKL: TOPS
TOPS1
GCP1
GCP2
GCPREV
0
.STITL SYSTEM VARIABLES (ONE COPY PER USER)
UBLK=.
FLSRES: 0 ;REASON USER NOT RUNNING
FLSADR: 0 ;ADDRESS TO START AT AFTER FLUSH
UACA: 0
UACB: 0
UACC: 0
UACD: 0
UACE: 0
TIMUSD: 0
0
UPC: 0 ;PROGRAM COUNTER
UTTY: 0
BRAKE: 0
;DO NOT CHANGE THE ORDER BELOW
USWPAD: .=.+4 ;BEGINNING OF SWAP AREA
DTYIBF: .=.+4 ;BEGINING OF TYI BUFFER ON DISK
DEDTBF: .=.+4 ;BEGINNG OF EDIT BUFFER
DHDDIR: .=.+4 ;BEGINING OF DISK DIRECTORY(OF HOME DISK)
UNXTDB: .=.+4 ;NEXT DISK BLOCK AWAILABLE
UDSKAD: .=.+4 ;RANDOM DISK STORAGE AREA
LUBLK==.-UBLK
L==LUBLK
.=.+<MNUSRS-1*LUBLK>
;NODE TYPES
SFUN==000000
INFIX==10000
UFUN==20000
UVAR==30000
TYP1==40000
;THE FOLLOWING TYPES ARE NEEDED IN THIS ORDER BY THE CONVERT ROUTINES
SSTR==70000 ;NOT VALID TOKEN TYPE
SNP==100000
ATOM==110000
SNUM==120000 ;NOT A VALID TOKEN TYPE
LNUM==130000
LSTR==140000
RNUM==150000
LIST==170000
SENT==LIST
;END OF ORDER
;BINDING TYPES
FBIND==20000
VBIND==30000
SFBIND==120000 ;SWAPPED OUT FUNCTION BINDING
SVBIND==130000 ;SWAPPED OUT VARIABLE BINDING
;SOE FLAGS SEE OLE MACRO STUFF
VNAF==2000
;READ FLAGS SEE DTBL:
DOTF==400 ;IN LEFT HALF
;EVAL FLAGS - PUSHED BY PEVAL
PTLPF==1 ;PREVIOUS TOKEN WAS LEFT PAREN
RTF==2 ;REPEAT TOKEN
CRF==4 ;CURRENT TOKEN IS CR
EDITF==10 ;EDIT FLAG
TOF==20 ;TO FLAG
IFF==40 ;IF FLAG
TPTF==400 ;THIS PROCEDURE TRACED FLAG ;MUST BE IN LEFT HALF
;EVAL FLAGS2 - NOT PUSHED
TESTF==1
TRACEF==2
PQF==4 ;PRINT QUOTE FLAG - FOR PRSTR
DPQF=10 ;DONT " " "
MMF==20 ;MULTIPLE MAKE FLAG
ERRF==40 ;ERROR FLAG
DSAMFL==1000 ;DISK ALMOST FULL
PPNAIF==2000 ;P PDL NOT ALL THE WAY IN
SPNAIF==4000 ;S PDL NOT ALL THE WAY IN
;TEMP FLAGS IN TFLAGS
TF6==1
TF1==100
TF2==200
TF3==400
TF4==10000
TF5==20000
;FLAGS IN LEFT HALF OF 1ST NODE OF SWAPPED PROC LIST
; TPTF==400 DEFINED ABOVE
.STITL USER VARIABLES
UVBLK=.
;BELOW RELATIVE TO BASE OF SLOT WHEN USER NOT RUNNING
UAB: NODESP-SLOT1 ;BASE OF CURRENT USER'S NODE SPACE
S: IS-SLOT1
UPDLP: IP-SLOT1 ;USER PDL POINTER(ONLY WHEN USER NOT RUNNING)
SPOPL: IS-SLOT1
SPUSHL: IS-SLOT1-524
SSWPAD: IS-SLOT1-400+4-2
SPBASE: IS-SLOT1
SPRBAO: IS-SLOT1 ;SAME FOR S : S-SPRBAO = REL ADDR OF TOP THING ON S PDL
PPOPL: IP-SLOT1
PPUSHL: IP-SLOT1-524
PSWPAD: IP-SLOT1-400+4-2
PPBASE: IP-SLOT1
PRBAO: IP-SLOT1 ;PDL REL BASE ADDR OFFSET
SUHCT: UHCT-SLOT1 ;START OF USER HASH CODE TABLE
GCBITS: DBUF-SLOT1
BASEUS: 0 ;BASE OF USER SLOT(MUST BE LAST RELOCATED)
UVREND=. ;END OF VARIABLES TO BE RELOCATED
;BELOW ARE NOT RELATIVE
UAC: 0 ;EAE AC
UMQ: 0 ;EAE MQ
USR: 0 ;EAE STATUS REGISTER
RELA==1
RELB==2
RELC==4
RELD==10
RELE==20
ACRELF: 0
NNGC: 0 ;NUMBER OF NODES GARBAGE COLLECTED
ERRINA: -1 ;ADDRESS OF SWAPED IN ERROE ROUTINE
SSAVEA: 0 ;PLACE S PDL SAVED WHEN MARKING SWAPED OUT PDL
0
FREE: SOFN ;START OF FREE NODES
TOPS: 0 ;GC MARK FROM HERE IF NON 0
TOPS1: 0 ; "
GCP1: 0
GCP2: 0
GCPREV: 0
;THE FOLLOWING ARE PUSHED BY PEVAL
CPP: 0 ;CURRENT PROCEDURE POINTER
CPSN: 0 ;C.P. SWAP NO.
CLN: 0 ;CURRENT LINE NO.
CLP: 0 ;CURRENT LINE POINTER - GOOD IF CPSN'S AGREE
CLGN: 0 ;CURRENT LINE GENERATION NO.
CTN: 0 ;CURRENT TOKEN NO.
CTP: 0 ;CURRENT TOKEN POINTER
FUNLEV: 0 ;FUNCTION LEVEL
IFLEV: 0 ;IF LEVEL
FLAGS: 0 ;FLAG WORD
CSPDLP: 0 ;CURRENT S PDL PTR AFTER LAST PEVAL PUSH
CPDLP: 0 ;CURRENT PDL PTR AFTER LAST PEVAL PUSH
;END OF PEVAL PUSHES EXCEPT REL. S, CO AND CO+2 ARE ALSO PUSHED
;THE FOLLOWING ARE PUSHED (SOMETIMES) BY EVAL
CO: 0 ;CURRENT OPERATOR
0
NOR: 0 ;NO. OF OPERANDS STILL NEEDED BEFORE CO CAN BE EXECUTED
;END OF EVAL PUSHES
COF: 0 ;CURRENT OPERATOR FLAGS
LO: 0 ;LAST OPERATOR
0
CT: 0 ;CURRENT TOKEN
0 ; "
RDFLAG: 0 ;FOR READ
LISTBD: 0 ;LIST BUILD DEPTH
PSTOPR: 0 ;RETURN ADDR FOR PSTOP
UNGRAB: 0 ;FOR .GRAB. PUTTING A NODE ADDR HERE MEANS THAT IT
;WILL BE THE NEXT GRABBED. GC WILL MARK FROM "UNGRAB"
;USE WITH CAUTION!!
TEMP: 0
TFLAGS: 0 ;TEMP FLAGS (ALL TFN'S SHOULD EVENTALLY POINT HERE)
NCHR: 0 ;FOR BLST
TOPRNM: 0 ;PTR TO UOE OF PROC. BEING "TO"'ED
FNLLP: 0 ;FIRST NODE OF LIST OF LINE POINTERS (FOR "TO")
FLAGS2: 0 ;EVAL FLAGS - NOT PUSHED BY PEVAL
ALTL: 0 ;TEST LINE POINTER
LINENO: 0 ;FOR TEST MODE
CHI: 0 ;FOR TYI
PRMTCH: '? ;PROMPT CHAR
GNCN: 0 ;"GET NEXT CHAR" NODE
0
NBKTS: 0 ;FOR RDSTR
PCHR: TYO ;PLACE WHERE OUTPUT CHARS GO (TYO, BLST, ...)
DBITTB: .=.+40
DBITBE=.-2
;VARIABLES AND CONSTANTS FOR DISPLAY SYSTEM
;THESE MUST BE IN THIS ORDER
DORBEG==. ;MARKS BEGINNING OF THESE VARIABLES
CURX: .WORD 0,0 ;CURX = CURRENT X POSITION
; THE FIREST WORD IS THE INTEGER PART
; THE SECOND WORD IS THE FRACTION PART
CURY: .WORD 0,0 ;CURY = CURRENT Y POSITION
CURA: 0 ;CURA = THE CURRENT ANGLE
OLDX: 0 ;CONTAINS CURX AT THE TIME OF LAST NEW SNAP
OLDY: 0 ;CONTAINS CURY AT THE TIME OF LAST NEW SNAP
OLDIR: .BYTE 0 ;CONTAINS DIREC WHEN DR.LIN LAST CALLED
DFLAGS: .BYTE 0
.EVEN
DOREND==. ;MARKS END OF THESE VARIABLES
;END OF ORDER
STB: 0 ;STATIC AREA BOTTOM
STT: 0 ;STATIC AREA TOP.POINTS TO TOP OF STATIC DISPLAY AREA
DYB: 0 ;DYNAMIC BOTTOM. POINTS TO BOT OF DY AREA
DYR: 0 ;ROVING POINTER USED BY DISPLAY STORAGE ALLOCATIN ROUTINES
DYT: 0 ;POINTER TO DYNAMIC AREA TOP
TUB: 0 ;POINTER TO TURTLE AREA BOTTOM
SNLIST: 0 ;POINTER TO SNAP LIST
SNABOT: 0 ;BOTTOM OF CURRENT SNAP
SINA: 0 ;CONTAINS SIN OF THE CURENT ANGLE
COSA: 0 ;CONTAINS COS OF THE CURENT ANGLE
DIREC: 0 ;CONTAINS DIRECTION CODE FRO CURRENT ANGLE
BYCNT: 0 ;KEEPS TRACK OF LAST BIT IN DISPLAY LIST
PUSHJT: 0 ;DISPLAY PUSHJ TO TURTLE
DISBIT: 0 ;HAS A BIT SET CORRESPONDING TO DISPLAY SLOT
;THIS MUST BE AT THE END
MAXELN==60
ERRBUF: .=.+MAXELN
LUVBLK==.-UVBLK
;DISPLAY COMMANDS
ADDX==150000
ADDY==144000
ADDXY==ADDX!ADDY
DPUSHJ==100000
DPOP==140200
DPOPJ==140100
DSTOP==140400
DRSTXY==143000 ;RESET X AND Y TO 0
TURSIZ==4 ;THE SIZE OF THE TURTLE
;FLAGS USED FOR DFLAGS
PENUF==1
HOOKF==2
HIDETF==4
TURTF==10
TEMF==20
.STITL SYSTEM OBLIST
VARIABLE==4 ;FOR VARIABLE NUMBER OF ARGUMENTS
$==-1 ;DEFAULT INDICATOR IN OLE
YINFIX==20 ;"YES INFIX" FLAG FOR OLE
;ARGUMENT TYPES
; 0 ==== ANYTHING
ANYT==0
ATOMT==1
WORDT==ATOMT ;A WORD IS THE SAME AS AN ATOM
NUMT==2
SENTT==4
SNAPT==10
LISTT==20
ANSLT==ATOMT+NUMT+SENTT+LISTT ;ALL BUT SNAP
;SOE FIELDS 1.==RIGHT BYTE (EVEN ADDR) 2.==LEFT BYTE
; 1.1==RIGHT BIT 2.8==LEFT BIT
;1.1-1.8 INPUT TYPE ACCEPTABLE BY THIS PROCEDURE
;2.1-2.2 "STANDARD" NO. OF INPUT ARGS
;2.3 VNAF 1==CAN TAKE "ANY" NO. OF ARGS
;2.5 INFIX 1==THIS IS AN INFIX PROCEDURE
;2.6-2.8 PRECEDENCE
.MACR NGPTWO A
.XLIST
NGP2=NGP2*2
FOO==A
.IFLE NGP2-FOO
NGPTWO A
.ENDC
.LIST
.ENDM
;****************************************************
;MACRO TO DEFINE SYSTEM OBLIST ELEMENTS
;THE PARAMETERS ARE:
;1) THE PRINT NAME
;2) THE NAME OF THE POINTER TO THE OBLIST ELEMENT.
; THIS PARAMETER CAN BE $ IF YOU DON'T CARE ABOUT THE
; NAME, OR IF YOU WANT THE NAME TO BE $PNAME
;3) THE ADDRESS OF THE PROGRAM
; THIS PARAMETER CAN BE $ IF THE NAME OF THE PROGRAM
; IS THE SAME AS THE PRINT NAME
;4) THE PRECEDENCE. A NUMBER FROM 0-7
;5) THE TYPE OF PERMISSIBLE ARGUMENTS
; IF IT CAN TAKE MORE THAN ONE KIND OF ARGUMENT
; ADD UP ALL THE KINDS. EG NUMT+LISTT+ATOMT
;6) THE STANDARD NUMBER OF ARGUMENTS + THE SYMBOL "VARIABLE"
; IF IT CAN ALSO TAKE A VARIABLE NUMBER OF ARGUMENTS
;7) THE SYMBOL "YINFIX" IF THIS IS AN INFIX OPERATOR
;
;IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT
;ANY PARAMETER THAT YOU WANT TO BE 0 YOU CAN LEAVE OUT
;ANY PARAMETER YOU DON'T CARE ABOUT YOU CAN LEAVE OUT.
.MACR OLE PNAME,OBNAME,ADDR,PRECED,ARGTYP,NUMARG,QINFIX
.XLIST
OBX0=OBSTRT-. ;CHECK TO SEE THAT THE OBLIST DOESN'T
;OVERWRITE THE OBLIST ELEMENTS
.IF2
.IFNDF OBNAME
OBNAME=0 ;TO AVOID UNDEFINED SYMBOL ERROR
.ENDC
.ENDC
.IFG OBX0
OBADD2 ;POINTER TO OBLIST ELEMENT
OBADD1=.
.=OBADD2
.IFL OBNAME+0 ;$ HAS BEEN DEFINED TO BE -1
$'PNAME=.
.ENDC
.IFGE OBNAME+0
$'OBNAME=.
.ENDC
.BYTE ARGTYP+0
OBX1=NUMARG+0
OBX2=PRECED+0*40
.BYTE QINFIX+OBX1+OBX2
.IFL ADDR+0
PNAME ;ADDRESS OF PROGRAM
.ENDC
.IFGE ADDR+0
ADDR+0
.ENDC
TEXT ^\PNAME\
OBADD2=.
.=OBADD1
.ENDC
.IFLE OBX0
.LIST
********
NUMOBS IS LESS THAN THE NUMBER OF SYSTEM OBLIST ELEMENTS.
THEREFORE, YOU ARE OVERWRITING THE SYSTEM OBLIST
********
.XLIST
.ENDC
.LIST
.ENDM
.MACR CDM A
A==<.-SOBLSU>/2
.ENDM
;THE SYSTEM OBLIST
;ADD ITEMS (EXCEPT FOR SPECIAL CHAR ITEMS) ALPHABETICALLY.
;****
NUMOBS==91. ;THE NUMBER OF OBLIST ELEMENTS
;**** WHENEVER YOU ADD AN OBLIST ELEMENT, MAKE SURE YOU INCREMENT
;**** NUMOBS !!!!!!
SOOMX: 2+SOBLSU ;2 > THAN HIGHEST ADDR USED IN SYS OBLIST
NGP2==1
NGPTWO SOBLSU-SOBLST+2
SOBP2: NGP2 ;( SMALLEST POWER OF 2 >= NUMOBS )*2
OBADD1=.
OBADD2=.+<2*NUMOBS>
OBSTRT=OBADD2 ;WHERE THE SYSTEM OBLIST ELEMENTS START
SOBLST: OLE AND,$
OLE BACK,$,$,2,NUMT,1
OLE BUTFIRST,$,$,2,ANYT,1
OLE BUTLAST,$,$,2,ANYT,1
OLE COUNT,$,$,2,ANYT,1
OLE CTF,$,CLRSTF,2
OLE DIFFERENCE,$,DIFF,2,NUMT,2
OLE DISPLAY,$,$,2,LISTT+SNAPT,1
OLE DO,$,$,2,,1
OLE EDIT,$,$,2
OLE ELSE,$,$,2
OLE EMPTYP,$,$,2,ANYT,1
OLE END,$,$,2
OLE EQUAL,$,$,2,NUMT,2
OLE ERASETRACE,$,ETRACE,2,,1
OLE FIRST,$,$,2,ANYT,1
OLE FORWARD,$,$,2,NUMT,1
OLE FPRINT,$,$,2,,1+VARIABLE
OLE FPUT,$,$,2,,2+VARIABLE
OLE GO,$,$,2,NUMT,1
OLE GREATER,$,GREATR,2,NUMT,2
OLE HEADING,$,$,2
OLE HERE,$,$,2
OLE HIDETURTLE,$,$,2
OLE HOME,$,$,2
OLE IF,$,$,2,WORDT,1
OLE KILLDISPLAY,$,$,2
OLE LAMPOFF,LPOFF,$,2
OLE LAMPON,LPON,$,2
OLE LAST,$,$,2,ANYT,1
OLE LEFT,$,$,2,NUMT,1
OLE LESS,$,$,2,NUMT,2
OLE LEVEL,$,FLEV,2
OLE LIST,$,LIST.P,2,,2+VARIABLE
OLE LISTP,$,$,2,,1
OLE LPUT,$,$,2,,2+VARIABLE
OLE MAKE,$,$,2,,2
OLE MOD,$,$,2,NUMT,2
OLE NEWSNAP,$,$,2
OLE NUMBERP,$,NUMBP,2,ANYT,1
OLE OF,$
OLE OUTPUT,$,$,2,0,1
OLE PENDOWN,$,$,2
OLE PENUP,$,$,2
OLE PRINT,$,$,2,ANSLT,1+VARIABLE
OLE PRODUCT,$,PROD,2,NUMT,2+VARIABLE
OLE QUOTIENT,$,DIVDE,2,NUMT,2
OLE REQUEST,$,RQUEST,2
OLE RIGHT,$,$,2,NUMT,1
OLE RUG,$,RUNRUG
OLE SENTENCE,$,$,2,ANYT,2+VARIABLE
OLE SETHEADING,$,$,2,NUMT,1
OLE SETTURTLE,$,$,2,SENTT,1
OLE SETX,$,$,2,NUMT,1
OLE SETXY,$,$,2,NUMT,2
OLE SETY,$,$,2,NUMT,1
OLE SHOW,$,$,2,,1
OLE SHOWTURTLE,$,$,2
OLE SNAP,$,$,2
OLE STARTDISPLAY,$,$,2
OLE STF,$,SETSTF,2
OLE STOP,$,$,2
OLE SUM,$,$,2,NUMT,2+VARIABLE
OLE THEN,$,$,2
OLE TO,$,$,2
OLE TOOT,$,$,2,NUMT,1
OLE TRACE,$,$,2,,1
OLE TYPE,$,$,2,ANSLT,1+VARIABLE
OLE VERSION,$,VERSN,2
OLE WIPE,$,$,2,ATOMT+NUMT,1
OLE WIPECLEAN,$,$,2
OLE WORD,$,$,2,ANYT,2+VARIABLE
OLE WORDP,$,$,2,ANYT,1
OLE XCOR,$,$,2
SOBLSU: OLE YCOR,$,$,2 ;MUST BE ON LAST ENTRY BEFORE SINGLE CHAR ENTRIES
OLE ^\!\,LLPAR,LLPAR,1,ANYT,1
CDM HAS$
OLE ^\#\,PROC,PROC,6,ATOMT,1
CDM LP$
OLE ^\(\,LPAR,LPAR,1,,1
CDM RP$
OLE ^\)\,RPAR,RPAR,1
CDM PRD$
OLE ^\*\,STAR,PROD,5,NUMT,2+VARIABLE,YINFIX
CDM PLU$
OLE ^\+\,PLUS,SUM,4,NUMT,2+VARIABLE,YINFIX
OLE ^\+.\,UPLUS,UPLUS,6,NUMT,1
CDM MIN$
OLE ^\-\,MINUS,DIFF,4,NUMT,2,YINFIX
OLE ^\-.\,UMINS,UMINS,6,NUMT,1
CDM DIV$
OLE ^\/\,SLSH,DIVDE,5,NUMT,2,YINFIX
CDM DOTS$
OLE ^\:\,DOTS,DOTS,6,ATOMT,1
CDM LSS$
OLE ^\<\,LESS,LESS,3,NUMT,2,YINFIX
CDM EQL$
OLE ^\=\,EQUAL,EQUAL,3,NUMT,2,YINFIX
CDM GTR$
OLE ^\>\,GRTR,GREATR,3,NUMT,2,YINFIX
CDM BKSL$
; OLE ^/^/,BKSL,MOD,5,NUMT,2,YINFIX
.=OBADD2
.STITLE DISPATCH TABLE (ENGLISH)
;FLAGS--
;FSF -- SPECIAL ON INPUT
;FOF -- SPECIAL ON OUTPUT
;FQF -- QUOTING CHARACTER
;SEPF -- SEPARATOR CHARACTER
;WSF -- WORD SEPARATOR
;NNUMF -- NOT A NUMBER
;OPERF -- OPERATOR
;FLAGS--BYTE ONE NUMBER--BYTE TWO
; FSF FOF FQF SEPF WSF NNUMF OPERF #
;^@ . . . . . NNUMF . .
;^A . . . . . NNUMF . .
;^B . FOF . . . NNUMF . 0
;^C FSF . . . . NNUMF . 0
;^D FSF . . . . NNUMF . 2
;^E . . . . . NNUMF . .
;^F . . . . . NNUMF . .
;^G FSF FOF . . . NNUMF . 4
;^H . FOF . . . NNUMF . 2
;^I . FOF . SEPF WSF NNUMF . 10
;^J . FOF . SEPF WSF NNUMF . 12
;^K . FOF . SEPF WSF NNUMF . 14
;^L . FOF . SEPF WSF NNUMF . 16
;^M FSF FOF . SEPF WSF NNUMF . 6
;^N FSF . . . . NNUMF . 10
;^O . . . . . NNUMF . .
;^P . . . . . NNUMF . .
;^Q FSF . . . . NNUMF . 12
;^R FSF . . . . NNUMF . 14
;^S FSF . . . . NNUMF . 16
;^T . . . . . NNUMF . .
;^U . . . . . NNUMF . .
;^V . . . . . NNUMF . .
;^W FSF . . . . NNUMF . 20
;^X FSF . . . . NNUMF . 22
;^Y FSF . . . . NNUMF . 24
;^Z FSF . . . . NNUMF . 26
;^[ . . . . . NNUMF . .
;^\ . . . . . NNUMF . .
;^] . . . . . NNUMF . .
;^^ . . . . . NNUMF . .
;^_ . . . . . NNUMF . .
;SP . . . SEPF WSF NNUMF . .
;! . . . . . NNUMF . .
;" . . . SEPF . NNUMF . .
;# . . . SEPF . NNUMF OPERF HAS$
;$ . . . . . NNUMF . .
;% . . . . . NNUMF . .
;& . . . . . NNUMF . .
;' . . . SEPF . NNUMF . .
;( . . . SEPF . NNUMF OPERF LP$
;) . . . SEPF . NNUMF OPERF RP$
;* . . . SEPF . NNUMF OPERF PRD$
;+ . . . SEPF . NNUMF OPERF PLU$
;, . . . . . NNUMF . .
;- . . . SEPF . NNUMF OPERF MIN$
;. . . . . . NNUMF . .
;/ . . . SEPF . NNUMF OPERF DIV$
;0 . . . . . . . .
;1 . . . . . . . .
;2 . . . . . . . .
;3 . . . . . . . .
;4 . . . . . . . .
;5 . . . . . . . .
;6 . . . . . . . .
;7 . . . . . . . .
;8. . . . . . . . .
;9. . . . . . . . .
;: . . . SEPF . NNUMF OPERF DOTS$
;; . . . SEPF . NNUMF . .
;< . . . SEPF . NNUMF OPERF LSS$
;= . . . SEPF . NNUMF OPERF EQL$
;> . . . SEPF . NNUMF OPERF GTR$
;? . . . . . NNUMF . .
;@ . . . . . NNUMF . .
;A . . . . . NNUMF . .
;B . . . . . NNUMF . .
;C . . . . . NNUMF . .
;D . . . . . NNUMF . .
;E . . . . . NNUMF . .
;F . . . . . NNUMF . .
;G . . . . . NNUMF . .
;H . . . . . NNUMF . .
;I . . . . . NNUMF . .
;J . . . . . NNUMF . .
;K . . . . . NNUMF . .
;L . . . . . NNUMF . .
;M . . . . . NNUMF . .
;N . . . . . NNUMF . .
;O . . . . . NNUMF . .
;P . . . . . NNUMF . .
;Q . . . . . NNUMF . .
;R . . . . . NNUMF . .
;S . . . . . NNUMF . .
;T . . . . . NNUMF . .
;U . . . . . NNUMF . .
;V . . . . . NNUMF . .
;W . . . . . NNUMF . .
;X . . . . . NNUMF . .
;Y . . . . . NNUMF . .
;Z . . . . . NNUMF . .
;[ . . FQF SEPF WSF NNUMF . 0
;\ . . . . . NNUMF . .
;] . . FQF SEPF WSF NNUMF . 2
;^ . . . SEPF . NNUMF OPERF BKSL$
;_ . . . SEPF . NNUMF . .
;` . . . . . NNUMF . .
;a . . . . . NNUMF . .
;b . . . . . NNUMF . .
;c . . . . . NNUMF . .
;d . . . . . NNUMF . .
;e . . . . . NNUMF . .
;f . . . . . NNUMF . .
;g . . . . . NNUMF . .
;h . . . . . NNUMF . .
;i . . . . . NNUMF . .
;j . . . . . NNUMF . .
;k . . . . . NNUMF . .
;l . . . . . NNUMF . .
;m . . . . . NNUMF . .
;n . . . . . NNUMF . .
;o . . . . . NNUMF . .
;p . . . . . NNUMF . .
;q . . . . . NNUMF . .
;r . . . . . NNUMF . .
;s . . . . . NNUMF . .
;t . . . . . NNUMF . .
;u . . . . . NNUMF . .
;v . . . . . NNUMF . .
;w . . . . . NNUMF . .
;x . . . . . NNUMF . .
;y . . . . . NNUMF . .
;z . . . . . NNUMF . .
;{ . . . . . NNUMF . .
;| . . . . . NNUMF . .
;} . . . . . NNUMF . .
;~ . . . . . NNUMF . .
;RBO FSF . . . . NNUMF . 30
.STITLE SYSTEM DISPATCH TABLE (BYTE ONE)
;FLAG DEFINITIONS
FSF==200 ;SPECIAL INPUT
FOF==100 ;SPECIAL OUTPUT
FQF==20 ;QUOTING
SEPF==4 ;SEPARATOR
WSF==2 ;WORD SEPARATOR
NNUMF==40 ;NOT A NUMBER
OPERF==10 ;OPERATOR
DTBL:
.BYTE NNUMF,NNUMF ;^@ ;^A
.BYTE FOF!NNUMF,FSF!NNUMF ;^B ECHOES AS BLANK ;^C COPYS NEXT CHARACTER
.BYTE FSF!NNUMF,NNUMF ;^D DELETES NEXT CHARACTER ;^E
.BYTE NNUMF,FSF!FOF!NNUMF ;^F ;^G BREAK
.BYTE FOF!NNUMF,FOF!SEPF!WSF!NNUMF ;^H BACKSPACE ;^I TABULATE
.BYTE FOF!SEPF!WSF!NNUMF,FOF!SEPF!WSF!NNUMF ;^J LINE FEED ;^K TABULATE VERTICALLY
.BYTE FOF!SEPF!WSF!NNUMF,FSF!FOF!SEPF!WSF!NNUMF ;^L FORM FEED ;^M CARRIAGE RETURN ECHOES AS CARRIAGE RETURN LINE FEED
.BYTE FSF!NNUMF,NNUMF ;^N GET NEXT WORD ;^O
.BYTE NNUMF,FSF!NNUMF ;^P ;^Q SUPER-QUOTE
.BYTE FSF!NNUMF,FSF!NNUMF ;^R COPY REST OF LINE ;^S SKIP NEXT WORD
.BYTE NNUMF,NNUMF ;^T ;^U
.BYTE NNUMF,FSF!NNUMF ;^V ;^W ERASE LAST WORD
.BYTE FSF!NNUMF,FSF!NNUMF ;^X CLARIFY INPUT ;^Y EDIT PREVIOUS LINE
.BYTE FSF!NNUMF,NNUMF ;^Z DESTROY INPUT BUFFER ;^[ MAYBE ALTMODE
.BYTE NNUMF,NNUMF ;^\ ;^]
.BYTE NNUMF,NNUMF ;^^ ;^_ WELL, ANY BETTER IDEAS FOR THEM?
.BYTE SEPF!WSF!NNUMF,NNUMF ;SP ;! ?????
.BYTE SEPF!NNUMF,SEPF!NNUMF!OPERF ;" ;# ACTION OF
.BYTE NNUMF,NNUMF ;$ ;%
.BYTE NNUMF,NNUMF!OPERF ;& ;' (MAYBE LE)
.BYTE SEPF!NNUMF!OPERF,SEPF!NNUMF!OPERF ;( ARITHMETIC GROUPING ;) DITTO
.BYTE SEPF!NNUMF!OPERF,SEPF!NNUMF!OPERF ;* MULTIPLY ;+ ADD
.BYTE NNUMF,SEPF!NNUMF!OPERF ;, ;- SUBTRACT
.BYTE NNUMF,SEPF!NNUMF!OPERF ;. ;/ DIVIDE
.BYTE 0,0 ;0 ;1
.BYTE 0,0 ;2 ;3
.BYTE 0,0 ;4 ;5
.BYTE 0,0 ;6 ;7
.BYTE 0,0 ;8. ;9.
.BYTE SEPF!NNUMF!OPERF,SEPF!NNUMF ;: THING OF ;; PROPERTY OF
.BYTE SEPF!NNUMF!OPERF,SEPF!NNUMF!OPERF ;< ;=
.BYTE SEPF!NNUMF!OPERF,NNUMF ;> ;?
.BYTE NNUMF,NNUMF ;@ ;A
.BYTE NNUMF,NNUMF ;B ;C
.BYTE NNUMF,NNUMF ;D ;E
.BYTE NNUMF,NNUMF ;F ;G
.BYTE NNUMF,NNUMF ;H ;I
.BYTE NNUMF,NNUMF ;J ;K
.BYTE NNUMF,NNUMF ;L ;M
.BYTE NNUMF,NNUMF ;N ;O
.BYTE NNUMF,NNUMF ;P ;Q
.BYTE NNUMF,NNUMF ;R ;S
.BYTE NNUMF,NNUMF ;T ;U
.BYTE NNUMF,NNUMF ;V ;W
.BYTE NNUMF,NNUMF ;X ;Y
.BYTE NNUMF,FQF!SEPF!WSF!NNUMF ;Z ;[
.BYTE NNUMF,FQF!SEPF!WSF!NNUMF ;\ LOGICAL OR ;]
.BYTE SEPF!NNUMF!OPERF,SEPF!NNUMF ;^ EXPONENTIATE, MAYBE ;_ MAKE
.BYTE NNUMF,NNUMF ;` GRAVE ACCENT. LOOK THAT UP ON YOUR TELTERM. ;a LOWER CASE
.BYTE NNUMF,NNUMF ;b LOWER CASE ;c LOWER CASE
.BYTE NNUMF,NNUMF ;d LOWER CASE ;e LOWER CASE
.BYTE NNUMF,NNUMF ;f LOWER CASE ;g LOWER CASE
.BYTE NNUMF,NNUMF ;h LOWER CASE ;i LOWER CASE
.BYTE NNUMF,NNUMF ;j LOWER CASE ;k LOWER CASE
.BYTE NNUMF,NNUMF ;l LOWER CASE ;m LOWER CASE
.BYTE NNUMF,NNUMF ;n LOWER CASE ;o LOWER CASE
.BYTE NNUMF,NNUMF ;p LOWER CASE ;q LOWER CASE
.BYTE NNUMF,NNUMF ;r LOWER CASE ;s LOWER CASE
.BYTE NNUMF,NNUMF ;t LOWER CASE ;u LOWER CASE
.BYTE NNUMF,NNUMF ;v LOWER CASE ;w LOWER CASE
.BYTE NNUMF,NNUMF ;x LOWER CASE ;y LOWER CASE
.BYTE NNUMF,NNUMF ;Z LOWER CASE ;LEFT BRACE
.BYTE NNUMF,NNUMF ;VERTICAL BAR ;RIGHT BRACE
.BYTE NNUMF,FSF!NNUMF ;TILDE ;RUBOUT
.STITLE SYSTEM DISPATCH TABLE (BYTE TWO)
;NUMBERS POINT TO OTHER TABLES
;$ POINTS TO SYSTEM OBLIST
DTBL2:
.BYTE 0,0 ;^@ ;^A
.BYTE 0,0 ;^B ECHOES AS BLANK ;^C COPYS NEXT CHARACTER
.BYTE 2,0 ;^D DELETES NEXT CHARACTER ;^E
.BYTE 0,4 ;^F ;^G BREAK
.BYTE 2,10 ;^H BACKSPACE ;^I TABULATE
.BYTE 12,14 ;^J LINE FEED ;^K TABULATE VERTICALLY
.BYTE 16,6 ;^L FORM FEED ;^M CARRIAGE RETURN ECHOES AS CARRIAGE RETURN LINE FEED
.BYTE 10,0 ;^N GET NEXT WORD ;^O
.BYTE 0,12 ;^P ;^Q SUPER-QUOTE
.BYTE 14,16 ;^R ;^S SKIP NEXT WORD
.BYTE 0,0 ;^T ;^U
.BYTE 0,20 ;^V ;^W ERASE LAST WORD
.BYTE 22,24 ;^X CLARIFY INPUT ;^Y
.BYTE 26,0 ;^Z DESTROY INPUT BUFFER ;^[ MAYBE ALTMODE
.BYTE 0,0 ;^\ ;^]
.BYTE 0,0 ;^^ ;^_ WELL, ANY BETTER IDEAS FOR THEM?
.BYTE 0,0 ;SP ;! ?????
.BYTE 0,HAS$ ;" ;# ACTION OF
.BYTE 0,0 ;$ ;%
.BYTE 0,0 ;& ;' (MAYBE LE)
.BYTE LP$,RP$ ;( ARITHMETIC GROUPING ;) DITTO
.BYTE PRD$,PLU$ ;* MULTIPLY ;+ ADD
.BYTE 0,MIN$ ;, ;- SUBTRACT
.BYTE 0,DIV$ ;. ;/ DIVIDE
.BYTE 0,0 ;0 ;1
.BYTE 0,0 ;2 ;3
.BYTE 0,0 ;4 ;5
.BYTE 0,0 ;6 ;7
.BYTE 0,0 ;8. ;9.
.BYTE DOTS$,0 ;: THING OF ;; PROPERTY OF
.BYTE LSS$,EQL$ ;< ;=
.BYTE GTR$,0 ;> ;?
.BYTE 0,0 ;@ ;A
.BYTE 0,0 ;B ;C
.BYTE 0,0 ;D ;E
.BYTE 0,0 ;F ;G
.BYTE 0,0 ;H ;I
.BYTE 0,0 ;J ;K
.BYTE 0,0 ;L ;M
.BYTE 0,0 ;N ;O
.BYTE 0,0 ;P ;Q
.BYTE 0,0 ;R ;S
.BYTE 0,0 ;T ;U
.BYTE 0,0 ;V ;W
.BYTE 0,0 ;X ;Y
.BYTE 0,0 ;Z ;[
.BYTE 0,2 ;\ LOGICAL OR ;]
.BYTE BKSL$,0 ;^ TEMPORARILY MODULO (MAYBE EXPONENTIATE) ;_ MAKE
.BYTE 0,0 ;` GRAVE ACCENT. LOOK THAT UP ON YOUR TELTERM. ;a LOWER CASE
.BYTE 0,0 ;b LOWER CASE ;c LOWER CASE
.BYTE 0,0 ;d LOWER CASE ;e LOWER CASE
.BYTE 0,0 ;f LOWER CASE ;g LOWER CASE
.BYTE 0,0 ;h LOWER CASE ;i LOWER CASE
.BYTE 0,0 ;j LOWER CASE ;k LOWER CASE
.BYTE 0,0 ;l LOWER CASE ;m LOWER CASE
.BYTE 0,0 ;n LOWER CASE ;o LOWER CASE
.BYTE 0,0 ;p LOWER CASE ;q LOWER CASE
.BYTE 0,0 ;r LOWER CASE ;s LOWER CASE
.BYTE 0,0 ;t LOWER CASE ;u LOWER CASE
.BYTE 0,0 ;v LOWER CASE ;w LOWER CASE
.BYTE 0,0 ;x LOWER CASE ;y LOWER CASE
.BYTE 0,0 ;z LOWER CASE ;{ OPEN BRACE
.BYTE 0,0 ;| VERTICAL BAR, MAYBE OR, MAYBE XOR ;} CLOSE BRACE
.BYTE 0,30 ;~ TILDE, LOGICAL NOT ;RBO RUBOUT????
.STITL LOSS CHECKING ROUTINES
IOTBRK: INC #-4
LOSSCT=.-2
BGT LOSER
SPUSH A
SPUSH USER
MOV #-1,USER
PRCR
PRTXT ^/BAD TRAP--VECTOR /
MOV 6(SP),A
SUB #4,A ;MAKE IT REAL
CMP #BEBRV,A ;IS IT A BUS ERROR?
BEQ BUSSER
JSR PC,PRON
PRTXT ^/ TRAPPED FROM /
MOV 12(SP),A
JSR PC,PRON
PRCR
SPOP USER
SPOP A
ADD #4,SP
RTI
EMTBRK: HALT
BUSSER: PRTXT ^/BUSS ERROR!!!/
LOSER: PRTXT ^/I GIVE UP!!/
HALT
BR .-2
.STITL DISK STARTER
DSKSRT: MOV #DCRDRB,A ;CHECK FOR DC11 RECIEVE FIRST
TST 14(A)
BNE DSKSGO
MOV #SYSWPR,A ;NEXT LOOK AT SYSTEM REQUESTS
DSKSR1: TSTB 14(A) ;IS THE FUNCTION NON ZERO?
BNE DSKSGO ;FOUND A REQUEST, GO DO IT
ADD #16,A ;LOOK AT NEXT BLOCK
CMP #16*MNUSRS+SYSWPR,A ;LAST BLOCK?
BGT DSKSR1
MOV SWPLST,A ;MOOBY SWAP OUT REQS?
BNE DSKSGO
CLR DSKS
RTS PC ;NO DISK REQUESTS EXTANT, BETTER LUCK NEXT TIME
DSKSGO: MOV A,DSKCRB ;ADDRESS OF BLOCK ABOUT TO BE SERVICED
MOV (A),B
BEQ .+4 ;BRANCH IF NO
JSR PC,(B) ;RUN START ROUTINE
DSKSG1: TST (A)+
MOV #DSKWC,B ;START OF DISK I/O WORDS
MOV (A)+,(B)+ ;WORD COUNT
MOV (A)+,(B) ;CORE ADDRESS
ADD #2,(B)+ ;GODFORSAKEN DEC!!!!!
MOV (A)+,(B)+ ;LOW ORDER DISK ADDRESS
MOV (A)+,(B)+ ;HIGH " " "
TST (A)+ ;GO PAST UNUSED WORD
MOVB (A),DSKS ;SET FUCTION, ENABLE INTERUPT, GO!!
RTS PC
DPROVK: SPUSH PS
MOV #340,PS
CMP #200,DSKS ;IF THE INTERUPT IS OFF AND THE DISK IS READY
BNE DSKSG2 ;PROVOKE IT; OTHERWISE LEAVE IT FOR SOMEONE ELSE
SPUSH A
SPUSH B
JSR PC,DSKSRT
SPOP B
SPOP A
DSKSG2: SPOP PS
RTS PC
.STITL DISK REQUEST BLOCK GRABBER
SYDRBG: SPUSH PS ;SAVE OLD PROSSESOR LEVEL
MOV #340,PS ;LOCK OUT INTERUPTS
MOV #SYSWPR,A ;LOOK FOR A FREE SYSTEM DISK REQUEST BLOCK
SDRBG1: TST 14(A) ;IS IT FREE?
BEQ SDRBG2
ADD #16,A ;LOOK AT NEXT ONE
CMP #16*MNUSRS+SYSWPR,A ;ANY MORE?
BGT SDRBG1 ;YES, SEE IF FREE
SPOP PS ;NO MORE, WE HAVE LOST BIG
WAIT ;THIS WILL PROBABLY NOT DO ANY GOOD
BR SYDRBG ;AND CERTAINLY WON'T UNLESS OUR PRIORITY IS <5
SDRBG2: MOV DUSECT,14(A) ;LABEL BLOCK AS IN USE, BUT NO REQUEST
INCB DUSECT+1 ;SO PEOPLE CAN DISTINGUISH
SPOP PS ;YOU CAN INTERUPT NOW.
RTS PC
;USER ROUTINE TO FLUSH UNTIL DISK REQUEST POINTED TO BY A DONE
DSKWA2: ADD #14,A
DSKWAI: MOV USER,U
MOV (A),B
DSKWA1: CMP B,(A)
BEQ DNDONE
JSR PC,RUNME
RTS PC
DNDONE: MOV #FRDSKW,FLSRES(U)
JSR PC,FLUSH
BR DSKWA1
UBLKGR: MOV #DBITTB,A ;USERS BIT TABLE ADDR
MOV #DBITBE,B
MOV #UNXTDB,D ;POINTER TO ADDR OF NEXT AWAILABLE BLOCK
ADD USER,D
MOV #DBITBE,E ;END OF USERS BIT TABLE
CLR F ;DISK ISN'T NEARLY FULL
BIT #DSAMFL,FLAGS2 ;IS THE DISK ALLMOST FULL?
BEQ .+4 ;NO
INC F ;YES
JSR PC,BLKGRB ;GO DO GOOD THINGS
RTS PC ;DISK REALLY FULL
TST F ;IS DISK NEARLY FULL?
BEQ UBLKG1 ;NO, SKIP RETURN
BIS #DSAMFL,FLAGS2 ;YES WARN THE WORLD.
UBLKG1: JMP SRET ;WIN ANYWAY, SKIP RETURN
UBLKFR: MOV #DBITTB,E
MOV USER,B
MOV UDSKAD(B),D
JSR PC,BLKFRE
BIC #DSAMFL,FLAGS2 ;DISK NOW SURELY HAS A FREE BLOCK
RTS PC
;GRABS A DISK BLOCK AND A REQUEST BLOCK
;REQUEST BLOCK ADDR RETURNS IN A
;DISK BLOCK ADDR RETURNS IN B AND C
;ARGS: BEGINNING OF BIT TABLE IN A
;END OF BIT TABLE IN B
;ADDR OF NEXT BLOCK WORDS IN D
;DISK ALMOST FULL FLAG IN F
BLKGRB: CLR C
BLKGR3: MOV #1,E
BLKGR2: BIT E,(A) ;IS THIS BLOCK FREE?
BEQ BLKGR5 ;YES, PRAISE THE LORD!
INC C ;NO, TRY THE NEXT BLOCK
ASL E
BCC BLKGR2 ;NO OVERFLOW?
TST (A)+ ;NEXT WORD
CMP A,B ;AT END OF THE TABLE
BLE BLKGR3 ;CONTINUE
TST F ;NO BLOCK AVAILABLE, ARE WE REAL FULL?
BEQ BLKGR4 ;NO, BUT CLOSE
RTS PC ;YES, VERY FULL
BLKGR4: INC F ;DISK ALMOST FULL
BR BLKGR6
BLKGR5: BIS E,(A) ;THAT BLOCK IS NO LONGER FREE
CLR F ;AND THE DISK ISN'T NEARLY FULL
BLKGR6: JSR PC,SYDRBG ;GET A DISK REQUEST BLOCK
MOV #-200,2(A) ;ALL BLOCKS ARE THIS LONG
MOV (D),6(A) ;NEXT AVAILABLE BLOCK
MOV 2(D),10(A)
SPUSH (D)
SPUSH 2(D)
SWAB C ;MULTIPLY BY 200
ASR C
BIC #100000,C
MOV 6(D),2(D) ;LOW ORDER BASE ADDR
ADD 4(D),C ;LOW ORDER BASE ADDR
ADC 2(D)
MOV C,(D)
SPOP C
SPOP B
JMP SRET
;FREES THE DISK BLOCK WHOSE LOW ORDER ADDR IS IN C
;BASE OF THIS DISK SPACE IS IN D
;ADDRESS OF THE APPRPRIATE BIT TABLE IS IN E
BLKFRE: SUB D,C ;RELOCATE DISK ADDR RELATIVE TO ZERO
MOV #1,B
BIT #177,C
BEQ .+4
HALT
BLKFR1: BIT #3777,C ;IS ADDR DIVISABLE BY 20*200?
BEQ BLKFR2 ;YES
SUB #200,C ;NO, TRY TO MAKE IT BE
ASL B ;AND GET "REMAINDER" IN B
BR BLKFR1
BLKFR2: SWAB C ;DIVIDE BY 400
ASR C ;BY 2
ASR C ;BY 2=>DIVIDED BY 400*2*2=2000=4000/2
ADD C,E ;GET POINTER INTO BIT TABLE
BIC B,(E) ;AND FREE THE BLOCK
RTS PC
.STITL DISK INTERUPT ROUTINE
DSKBRK: SPUSH A
SPUSH B
BIT #100000,DSKS ;ANY ERROR BITS SET?
BNE DSKLOS ;BITE THE BAG!
MOV DSKCRB,A ;POINTER TO FUNCTION WORD
CLR 14(A) ;REQUEST HAS BEEN SERVICED
MOV (A),B
BEQ .+4 ;NO
JSR PC,(B) ;YES, GO DO IT
CLR (A)
DSKRTY: JSR PC,DSKSRT ;LOOK FOR SOMETHING ELSE TO DO
DSKRET: SPOP B
SPOP A
RTI
DSKLOS: HALT ;DISK LOST BIG
MOV #400,DSKS ;POWER CLEAR IT
HALT ;GIVE IT A CHANCE
BR DSKRTY ;TRY AGAIN(EVENTUALLY)
.STITL SCHEDUALER
RUNME: TST USER
BGE RUNME1
RUNME2: RTS PC ;SYSTEM CALLED RUNME
RUNME1: TST FLSADR(U) ;IF HE WANTS TO RUN HE SHOULD JSR HERE
BEQ RUNME2 ;IF FLSADR IS ZERO, JUST KEEP RUNNING HIM
MOV #-1,USER ;SYSTEM IS NOW USER
JSR PC,UACSAV ;STORE HIS ACS
CLR FLSADR(U) ;GUY IS NOW RUNABLE
CLR FLSRES(U)
INC NRABLU
SPOP UPC(U) ;HE SHOULD START AFTER THE JSR PC,RUNME
NEXTU1: MOV #SLOTST,A ;TRY TO RUN USER IN U
NEXTU2: CMP U,(A)+ ;IS HE ASSIGNED A SLOT IN CORE?
BNE NEXTU3 ;NOT THIS ONE, ANYWAY
TST (A) ;IS HE ALL THE WAY IN?
BLT NEXTUS ;NO CAN'T RUN HIM YET
BEQ NEXTU3
CMP #FRNEWU,FLSRES(U)
BNE NEXT14
MOV #UGO,FLSADR(U)
TST RWWSW
BNE NEXT15
MOV SLTCAD-SLOTST-2(A),C
MOV #16,D
JMP NEXT11
NEXT14: CLR FLSRES(U)
JMP RUNUSR
;CALL TO GET INDEX OF NEXT USER TO RUN
NEXTUS: SUB #LUBLK,ULAST ;COUNT BACKWARDS
BGE .+10 ;DON'T GO NEG
MOV #<MNUSRS-1>*LUBLK,ULAST ;LAST POSSIBLE USER INDEX
MOV ULAST,U ;SEE IF THIS IS A GOOD GUY TO RUN
NEXT15: CMP #FRTYIH,FLSRES(U)
BEQ NEXTUS
TST FLSADR(U) ;IF FLSADR IS ZERO, RUNABLE(???)
BEQ NEXTU1 ;RUN HIM.
BLT NEXTUS ;NEG=>NON EX USER
MOV U,USER ;USER IS NOW USER
JSR PC,UACRES ;RESTORE HIS ACS
JMP @FLSADR(U) ;SEE IF HE SHOULD REALLY RUN
NEXTU3: TST (A)+ ;EXTANT CORE SLOT?
BNE NEXTU2 ;YES, CHECK NEXT ONE
MOV PUSPSL,A ;SEE IF THERE IS A PREFERED SLOT
BGT NEXTU6
MOV #SLOTST,A
NEXTU4: TST (A)+
TST (A)+
BLT NEXTU4
BEQ NEXTUS
CMP #1,-2(A)
BEQ NEXTU4 ;GUY HASN'T RUN YET, DON'T SWAP HIM OUT
MOV -2(A),B ;USER THAT MAY BE SWAPED OUT
CMP B,LOCKUS ;IS HE LOCKED IN?
BEQ NEXTU4 ;YES, DON'T BOTHER HIM
CMP B,GCLOCK
BEQ NEXTU4
TST NSWPU ;ARE THERE USERS BEING SWAPED?
BEQ NEXTU6 ;NO, SWAP ONE
CMP NINU,#1 ;IS THERE ONLY ONE USER IN CORE?
BEQ NEXTUS ;YES, RUN HIM
NEXTU6: CLR PUSPSL ;IF THERE WAS A PREFERED SLOT, WE ARE DOING IT
TST -(A)
MOV -2(A),B ;FOUND A GOOD SLOT, USER TO SWAP OUT INTO B
MOV U,-2(A) ;NEW OCCUPANT OF SLOT
FOR DEBUG
BIT #SWTRCF,SFLAGS ;TRACE SWAPS?
BEQ NEXTU5
SPUSH A
PRTXT ^/SWAPPING: /
MOV B,A
JSR PC,PRON
SPACE
MOV U,A ;USER WHO IS COMING IN
JSR PC,PRON
SPACE
MOV (P),A
SUB #SLOTST+2,A
ASR A
ASR A
JSR PC,PRON ;SLOT
SPACE
MOV TIME,A
JSR PC,PRON
PRCR
SPOP A
.ENDC
ENDC DEBUG
NEXTU5: CLR D
MOV SLTCAD-SLOTST-2(A),C ;MOBY SWAP OUT BLOCK FOR THIS SLOT
MOV #SWPOST,(C)+ ;SWAP OUT USER START ROUTINE
MOV USWCNT,(C)+ ;WORD COUNT OF A USER SLOT
MOV SLTCAD-SLOTST(A),(C)+ ;SLOT CORE ADDRESS
MOV USWPAD(B),(C)+ ;LOW ORDER SWAP OUT ADDR OF U TO SWAP OUT
MOV USWPAD+2(B),(C)+ ;HIGH OORDER
TST (C)+ ;WASTED WORD
MOV #DWRTEC,(C)+ ;DISK WRITE COMMAND
NEXT11: DEC NINU ;ONE LESS IN CORE
INC NSWPU ;ONE MORE MOVING AROUND
MOV #SWPIST,(C)+ ;SWAP IN USER START ROUTINE
MOV USWCNT,(C)+ ;SLOT WORD COUT
MOV SLTCAD-SLOTST(A),(C)+ ;SLOT CORE ADDRESS
CMP #FRNEWU,FLSRES(U)
BNE NEXT12
MOV DCLRUS,(C)+
MOV DCLRUS+2,(C)+
MOV #UGO,FLSADR(U)
MOV UDSKAD(U),UNXTDB(U)
MOV UDSKAD+2(U),UNXTDB+2(U)
BR NEXT13
NEXT12: MOV USWPAD(U),(C)+ ; " "
MOV USWPAD+2(U),(C)+ ;USER ADDRESS ON DISK
NEXT13: MOV A,(C)+ ;ADDRESS OF PLACE TO ZAP TO 1 WHEN DONE
MOV #DREADC,(C) ;READ FROM DISK
SUB #32,C ;BEGINING OF MOOBY SWAP REQ PAIR
ADD D,C
SPUSH PS
MOV #340,PS ;NO INTS!
MOV C,@SWPLEP
ADD #2,SWPLEP
SPOP PS
MOV #-1,(A) ;NOT IN YET
BR NEXT10
NEXTU7: MOV #-1,USER ;FLUSH ENTERS HERE, SYSTEM NOW USER
MOV #SLOTST,A ;SEE IF THIS SUPER FLUSHED GUY IS IN CORE
NEXTU8: CMP U,(A)+
BNE NEXTU9 ;NOT HERE.
TST (A)+ ;IS HE REALLY IN?
BLE NEXT10 ;NO, NOT REALLY
CMP #FRDSKW,FLSRES ;IF JUST HUNG ON DISK
BEQ NEXT10 ;FORGET HIM
MOV A,PUSPSL ;HE IS PREFERED OUT
MOV U,PUSRSP
BR NEXT10
NEXTU9: TST (A)+
BNE NEXTU8
NEXT10: JMP NEXTUS
FLUSH: TST USER
BGE FLUSH4
RTS PC
FLUSH4: JSR PC,UACSAV ;STOP USER; STORE HIS ACS
MOV AC,UAC
MOV MQ,UMQ
MOV SR,USR
MOV FLSADR(U),A
SPOP FLSADR(U) ;SAVE PC
TST A ;IS THIS GUY ALREADY STOPED?
BNE NEXTU7 ;GO TRY ANOTHER GUY
UUNTIM TIMUSD
MOV #-1,USER
TIMER NULTIM
TST FLSRES(U)
BNE .+10
MOV #FRRAND,FLSRES(U)
DEC NRABLU
MOV P,UPDLP ;SAVE USER'S POINTER
MOV SPDLP,P ;SYSTEM PDL
FOR DEBUG
BIT #FRTRCF,SFLAGS
BEQ FLUSH3
PRTXT ^/FLUSHING USER /
MOV U,A
JSR PC,PRON
SPACE
MOV TIME,A
JSR PC,PRON
PRCR
.ENDC
ENDC DEBUG
FLUSH3: MOV #UVBLK,A
MOV BASEUS,B ;TO BLT OUT USER VARIABLES
FLUSH1: SUB B,(A)+ ;UNRELOCATE A POINTER
CMP #UVREND,A ;END OF VARS TO BE UNRELOCATED?
BGT FLUSH1 ;GO DO ANOTHER
MOV #UVBLK,A ;SET UP FOR BLT
MOV ACRELF,C
BEQ FLUSH2
MOV U,D
ADD #UACA-2,D ;POINTER TO USERS ACS
FLUSH5: TST (D)+ ;NEXT AC TO MAYBE RELOCATE
TST C
BEQ FLUSH2 ;NO MORE TO RELOCATE
CLC
ROR C
BCC FLUSH5 ;DON'T RELOCATE THIS ONE
SUB B,(D)
BR FLUSH5
FLUSH2: MOV (A)+,(B)+ ;ONE AT A TIME, KIDDIES!
CMP #UVBLK+LUVBLK-MAXELN,A ;DONE?
BGT FLUSH2
JMP NEXTUS
;RUNUSR, THE "MAIN LOOP"
RUNUSR: CMP U,PUSRSP ;AM I THE GUY THEY WANT OUT?
BNE .+6 ;BRANCH IF NO
CLR PUSPSL ;I DON'T WANT TO GO!
INC (A) ;INDICATE THAT THIS GUY HAS BEEN RUN
MOV SLTCAD-SLOTST(A),D ;SLOT ADDRESS THIS GUY IS IN
TST (D)+ ;REALLY RIGHT NOW
MOV D,B ;BASE OF SLOT
MOV #UVBLK,C ;BASE OF USER VARIABLES
RUNUS1: MOV (B)+,(C)+ ;BLTTTTTTTTTTTT!
CMP #UVBLK+LUVBLK,C
BGT RUNUS1
MOV #UVBLK,C ;TO RELOCATE VARIABLES
RUNUS2: ADD D,(C)+ ;ADD BASE OF SLOT
CMP #UVREND-2,C
BGT RUNUS2
MOV D,BASEUS
MOV ACRELF,A
BEQ RUNUS5
MOV U,B
ADD #UACA-2,B
RUNUS6: TST (B)+
TST A
BEQ RUNUS5
CLC
ROR A
BCC RUNUS6
ADD D,(B)
BR RUNUS6
RUNUS5:
FOR DEBUG
BIT #FRTRCF,SFLAGS
BEQ RUNUS4
PRTXT ^/STARTING USER /
MOV U,A
JSR PC,PRON
SPACE
MOV TIME,A
JSR PC,PRON
PRCR
.ENDC
ENDC DEBUG
RUNUS4: MOV P,SPDLP ;SAVE SYSTEM PDL POINTER
MOV UPDLP,P ;GET USER PDL POINTER
MOV U,USER ;NOW HE'S REALLY THE GUY
SPUSH UPC(U) ;PLACE TO START USER
MOV QUANT,UQUANT ;RUN FOR 3 1/100TH'S????
UNTIME NULTIM
UTIMER TIMUSD
MOV UAC,AC
MOV UMQ,MQ
MOV USR,SR
JMP UACRES ;RESTORE USER ACS AND START USER
SCHEDP: TST UQUANT ;SEE IF IT'S TIME TO FLUSH
BLE .+4 ;NOT YET
RTS PC
SPUSH U
MOV USER,U
MOV #FRSCED,FLSRES(U)
JSR PC,FLUSH
JSR PC,RUNME
SPOP U
RTS PC
.STITL CLOCK BREAK ROUTINE
CLKBRK: SPUSH A
SPUSH B
ADD #200,TIME
ADC TIME+2
DEC UQUANT
TSTB DSKS ;IS THE DISK BUSY?
BGE .+6 ;YES
JSR PC,DSKSRT
CMP #13183.,TIME+2 ;IS IT MIDNIGHT?
BLE DATEC ;YES, CHANGE THE DATE
CLKBR1: JMP @#CLKBR2
CLKBR2: SPOP B
SPOP A
RTI
CLKBDM: BIT #7777,TIME ;EVERY 4 BRKS (=<4*128>/10,000 SECS)
BNE CLKBR2 ;1/20 < T < 1/21 SECS
JSR PC,DMSQ
JSR PC,TI2Q
BR CLKBR2
DATEC: CLR TIME+2 ;TIME IS NOW ZERO
INC RDAY ;CHANGE THE DAY
MOV RMONTH,A
CMPB RDAY,DMON(A)
BLE CLKBR1 ;NOT ON A MONTH BOUNDARY
INC RMONTH
MOV #1,RDAY
CMP #12,RMONTH
BLE CLKBR1
INC RYEAR
MOV #1,RMONTH
BR CLKBR1
RDAY: 0
RMONTH: 0
RYEAR: 0
DMON: .BYTE 31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
.STITL SWAP START+STOP ROUTINES
SWPOST: MOV #SWPOSP,(A) ;SWAP OUT USER START, SET UP STOP
RTS PC
SWPOSP: TST (P)+ ;FLUSH RETURN, WE'RE NOT GOING BACK THAT WAY
ADD #16,A ;POINT TO SWAP IN BLOCK
JSR PC,DSKSGO ;START DISK ON THAT
JMP DSKRET ;AND RETURN FROM INTERUPT
SWPIST: MOV #SWPISP,(A) ;SWAP IN START, SET UP STOP
RTS PC
SWPISP: CLR UQUANT ;SCHED REAL SOON
MOV 12(A),B ;FLAG
MOV #1,(B) ;THIS GUY IS IN AND NOT RUN YET
SUB #2,SWPLEP
SPUSH A
MOV #SWPLST+2,A
MOV #SWPLST,B
MOV (A)+,(B)+
BNE .-2
INC NINU ;ONE MORE GUY IN
DEC NSWPU ;ONE LESS GUY MOVING
SPOP A
RTS PC
.STITL MISC ROUTINES
ACSAV: MOV E,-(P)
MOV D,-(P)
MOV C,-(P)
MOV B,-(P)
MOV A,-(P)
JMP (F)
ACRES: TST (P)+
MOV (P)+,A
MOV (P)+,B
MOV (P)+,C
MOV (P)+,D
MOV (P)+,E
RTS F
UACSAV: MOV A,UACA(U)
MOV B,UACB(U)
MOV C,UACC(U)
MOV D,UACD(U)
MOV E,UACE(U)
RTS PC
UACRES: MOV UACA(U),A
MOV UACB(U),B
MOV UACC(U),C
MOV UACD(U),D
MOV UACE(U),E
RTS PC
PPUSHT: CMP P,PPUSHL
BLOS .+4
RTS PC
BIT #177000,P ;IS IT THE SYSYTEM PDL?
BNE .+4
RTS PC ;YES, IGNORE
JMP PPSWPO ;PDL REALLY OVERFLOWED
PPOPT: CMP P,PPOPL
BHIS .+4
RTS PC
JMP PPSWPI
SPUSHT: SUB #2,S
CMP S,SPUSHL
BLOS .+4
RTS PC
JMP SPSWPO
SPOPT: ADD #2,S
CMP S,SPOPL
BHI .+4
RTS PC
JMP SPSWPI
.SPACE: PRTXT ^\ \
RTS PC
.CRLF: JMP @#.+4
JSR PC,ERTAP
CRMES
RTS PC
CRLF: MOV #15,D
JMP TYO
.STITL P AND S PDL SWAP OUTERS
PPSWPO: JSR F,ACSAV ;TIME TO WORK!
FOR DEBUG
BIT #SPTRCF,SFLAGS
BEQ PPSWP1
SUB #100,PPUSHL ;SO IT DOESN'T OVERFLOW AGAIN
PRTXT ^/SWAPPING OUT P PDL /
MOV P,A
SUB A,PRBAO
NEG A
JSR PC,PRON
PRCR
ADD #100,PPUSHL
.ENDC
ENDC DEBUG
PPSWP1: JSR PC,UBLKGR ;GET ALL THE GOOD STUFF WE NEED
HALT ;WHAT, NO DISK SPACE
HALT ;STOP, YOU STUPID MACHINE
SPUSH B ;SAVE ADDRESS
MOV PSWPAD,4(A) ;PLACE WHERE PDL IS
MOVB #DWRTEC,14(A) ;WRITE IT ONTO THE RIGHT PLACE
JSR PC,DSKWA2 ;FLUSH UNTIL IT IS REALLY OUT
MOV BASEUS,A
ADD #PDLINK+4-SLOT1,A ;GIVING US THE LINK ADDRESS+4 FOR THIS GUY
MOV C,-(A) ;HIGH ORDER PART
SPOP -(A) ;LOW ORDER PART
BIT #PPNAIF,FLAGS2 ;WAS THE PDL NOT ALL THE WAY IN ANYWAY?
BNE .+10 ;PART ALREADY OUT
SUB #54,PPOPL ;NONE OUT BEFORE, CHANGE LIMIT
BIS #PPNAIF,FLAGS2 ;CERTAINLY NOT ALL IN NOW
MOV PSWPAD,B ;ADDRESS-2 PDL SWAPED FROM
MOV (B),-(A) ;MOVE WORDS UP
MOV -(B),-(A)
CMP B,P
BGE .-4
ADD #374,P ;PDL HAS MOVED!
ADD #374,PRBAO
JSR F,ACRES ;ALL DONE!
RTS PC
SPSWPO: JSR F,ACSAV ;TIME TO WORK!
FOR DEBUG
BIT #SPTRCF,SFLAGS
BEQ SPSWP1
PRTXT ^/SWAPING OUT S PDL /
MOV S,A
SUB A,SPRBAO
NEG A
JSR PC,PRON
PRCR
.ENDC
ENDC DEBUG
SPSWP1: JSR PC,UBLKGR ;GET ALL THE GOOD STUFF WE NEED
HALT ;WHAT, NO DISK SPACE
HALT ;STOP, YOU STUPID MACHINE
SPUSH B ;SAVE ADDRESS
MOV SSWPAD,4(A) ;PLACE WHERE PDL IS
MOVB #DWRTEC,14(A) ;WRITE IT ONTO THE RIGHT PLACE
JSR PC,DSKWA2 ;FLUSH UNTIL IT IS REALLY OUT
MOV BASEUS,A
ADD #SDLINK+4-SLOT1,A ;GIVING US THE LINK ADDRESS+4 FOR THIS GUY
MOV C,-(A) ;HIGH ORDER PART
SPOP -(A) ;LOW ORDER PART
BIT #SPNAIF,FLAGS2 ;WAS THE PDL NOT ALL THE WAY IN ANYWAY?
BNE .+10 ;PART ALREADY OUT
SUB #54,SPOPL ;NONE OUT BEFORE, CHANGE LIMIT
BIS #SPNAIF,FLAGS2 ;CERTAINLY NOT ALL IN NOW
MOV SSWPAD,B ;ADDRESS-2 PDL SWAPED FROM
MOV (B),-(A) ;MOVE WORDS UP
MOV -(B),-(A)
CMP B,S
BGE .-6
ADD #374,S ;PDL HAS MOVED!
ADD #374,SPRBAO
JSR F,ACRES ;ALL DONE!
RTS PC
.STITL P AND S PDL SWAPER INERS
PPSWPI: BIT #PPNAIF,FLAGS2 ;IS THE PDL ALL THE WAY IN?
BNE .+4 ;NO (PRAISE THE LORD!)
HALT
JSR F,ACSAV
FOR DEBUG
BIT #SPTRCF,SFLAGS
BEQ PSWPI1
PRTXT ^/SWAPING IN P PDL /
MOV P,A
SUB A,PRBAO
NEG A
JSR PC,PRON
PRCR
.ENDC
ENDC DEBUG
PSWPI1: MOV PSWPAD,A
MOV A,B
ADD #374,A
MOV (A),(B)
MOV -(A),-(B)
CMP A,P
BGT .-4
SUB #374,P
SUB #374,PRBAO
JSR PC,SYDRBG
TST (A)+
MOV #-200,(A)+
MOV PSWPAD,(A)+
MOV PPBASE,E
MOV (E)+,C
MOV C,(A)+
MOV (E),(A)+
TST (A)+
MOVB #DREADC,(A)
JSR PC,DSKWAI
MOV PPBASE,D
TST (D)+
BNE PSWPI2
TST (D)
BNE PSWPI2
BIC #PPNAIF,FLAGS2 ;IF BOTH LINKS ARE ZERO NOW, THERE IS NO MORE PDL ON DISK
ADD #54,PPOPL
PSWPI2: JSR PC,UBLKFR
JSR F,ACRES
RTS PC
SPSWPI: BIT #SPNAIF,FLAGS2 ;IS THE PDL ALL THE WAY IN?
BNE .+4 ;NO (PRAISE THE LORD!)
HALT
JSR F,ACSAV
FOR DEBUG
BIT #SPTRCF,SFLAGS
BEQ SSWPI1
PRTXT ^/SWAPING IN S PDL /
MOV S,A
SUB A,SPRBAO
NEG A
JSR PC,PRON
PRCR
.ENDC
ENDC DEBUG
SSWPI1: MOV SSWPAD,A
MOV A,B
MOV (A),(B)
ADD #374,A
MOV (A),(B)
MOV -(A),-(B)
CMP A,S
BGT .-6
SUB #374,S
SUB #374,SPRBAO
JSR PC,SYDRBG
TST (A)+
MOV #-200,(A)+
MOV SSWPAD,(A)+
MOV SPBASE,E
MOV (E)+,C
MOV C,(A)+
MOV (E),(A)+
TST (A)+
MOVB #DREADC,(A)
JSR PC,DSKWAI
MOV SPBASE,D
TST (D)+
BNE SSWPI2
TST (D)
BNE SSWPI2
BIC #SPNAIF,FLAGS2 ;IF BOTH LINKS ARE ZERO NOW, THERE IS NO MORE PDL ON DISK
ADD #54,SPOPL
SSWPI2: JSR PC,UBLKFR
JSR F,ACRES
RTS PC
.IFZ 105
SWAPER: CLR A
SWAP1: PUSH A
PUSHS A
INC A
CMP A,B
BGT SWAP2
BR SWAP1
SWAP2: POP C
POPS D
DEC A
CMP A,D
BEQ .+4
HALT
CMP A,C
BEQ .+4
HALT
TST A
BEQ SWAPER
BR SWAP2
.ENDC
.STITL TIMER ROUTINES
.TIME: SPUSH A
SPUSH B
SPUSH C
SPUSH D
SPUSH PS
MOV #340,PS
JSR PC,GTIME
JSR PC,URELTM
MOV TMPDLP,D
MOV (A),(D)+
MOV -(A),(D)+
MOV D,TMPDLP
CLR (A)+
CLR (A)
JSR PC,RELTIM
SPOP PS
SPOP D
SPOP C
SPOP B
SPOP A
RTS PC
.UTIME: SPUSH A
SPUSH B
SPUSH C
SPUSH D
SPUSH PS
MOV #340,PS
JSR PC,GTIME
JSR PC,URELTM
MOV (E)+,A
ADD ELAPSE,(A)+
ADC (A)
ADD ELAPSE+2,(A)
MOV TMPDLP,D
MOV -(D),ELAPSE
MOV -(D),ELAPSE+2
MOV D,TMPDLP
JSR PC,RELTIM
SPOP PS
SPOP D
SPOP C
SPOP B
SPOP A
RTS E
URELTM: MOV #ELAPSE,A
ADD B,(A)+
ADC (A)
ADD C,(A)
RTS PC
RELTIM: MOV #ELAPSE,A
SUB B,(A)+
SBC (A)
SUB C,(A)
RTS PC
GTIME: MOV PCCNT,B
ADD #200,B
TSTB PCS
BGE .+6
MOV #200,B
MOV TIME+2,C
ADD TIME,B
ADC C
RTS PC
.STITL COMMUNICATE WITH MAIN MACHINE
RJLSW: 0 ;NON-ZERO=> ACTIVATE COMMUNICATE LINK
REDY10: 0 ;NON-ZERO=>10 IS READY
SYSMES: 0 ;NUMBER OF MESSAGES WAITING FOR THE SYSTEM
.MACR EXCHA X,Y
MOV X,A
MOV Y,X
MOV A,Y
.ENDM
;LOGIN STRING
LOGMES: .BYTE 'Z-100,'S-100,'S-100,'_-100
.ASCII /R11LOGO/
.BYTE 33
.ASCII /U11HERE/
.BYTE 'K-100,0
.EVEN
;RECIEVE VARIABLES
RBPOIN: 0
DCRBIP: DCRBF1-2 ;INITIAL POINTER
DCRACF: 0 ;ACKNOWLEDGE FLAG
DCRCKS: 0 ;CHECKSUM OF INCOMING WORDS
DCRMID: 0 ;ID # SENT WITH MESSAGE
DCRWCT: 0 ;WORD COUNT OF CURRENT MESSAGE
DCRPRB: 0 ;"PARITY" BITS FOR INCOMING WORD
DCRWBL: 0 ;BUILD RECIEVED WORD HERE
DCRLST: .=.+40 ;MESSAGES WAITNING TO BE PICKED UP
DCRDRB: .WORD 0,-400,DCRBF2-2,0,0,0,0 ;DISK REQUEST BLOCK
;TRANSMIT VARIABLES
TBPOIN: 0
DCTSMS: .=.+20 ;SMALL (1 OR 2 CHAR)MESSAGES TO BE SENT
DCTBST: .=.+40 ;MESSAGES WAITING TO BE SENT
;BUFFERS
DCRBF1: .=.+100 ;RECIEVE BUFFER 1
DCRBF2: .=.+100 ; " " 2
;DC11 PDLS
.=.+20
RLOGIN
RPDLP: .-2
.=.+20
TLOGIN
TPDLP: .-2
;RECIEVE INTERUPT ROUTINES
DCRBRK: SPUSH A
EXCHA RPDLP,P ;SET UP RECIEVE PDL
MOV DCRB,A ;GET CHAR FROM LINE
RTS PC ;RESUME PROCESSING
RFLUSH: EXCHA RPDLP,P ;RESTORE PDL
SPOP A
RTI
RLOGIN: BIS #100,DCTS ;WAKE UP TRANSMIT ROUTINE
JSR PC,RFLUSH ;GET NEXT CHAR
CMP #140,A ;IS IT SYNC?
BNE RLOGIN ;NO, WAIT FOR THE 10 TO WAKE UP
INC REDY10 ;10 IS READY TO COMMUNICATE
RECLOP: JSR PC,RFLUSH ;GET THE NEXT CHAR OFF THE LINE
SUB #140,A ;IS IT CONTROL CHAR?
BLT RECLOP ;NO (THIS SHOULDN'T HAPPEN)
CMP #10,A ;IS IT TOO BIG?
BLE RECLOP ;YUP (THIS SHOULD HAPPEN EVEN LESS!!)
ASL A
JMP @RECTAB(A) ;DO THE CONTROL CHAR
RECTAB: RECLOP ;NULL, SYNC(WHATEVER YOU WANT TO CALL IT)
STPREC ;STOP!
ACTREC ;WELL?????
RECLOP ;???
RECLOP ;????
ACKREC ;ACKNOWLEDGEMENT OF TRANSMITTED MESSAGE
NAKREC ;NEGATIVE, PLEASE SEND AGAIN
DATA ;DATA BLOCK COMES NEXT
STPREC:ACTREC: BR RECLOP
NAKREC: MOV #-1,DCRACF ;FOR NAK
BR ACKRC1
ACKREC: CLR DCRACF
ACKRC1: JSR PC,GBITCH ;GET NUMBER OF MESSAGE BEING "ACK"ED
BR RECLOP ;LOSE!
CMP #20,A ;IS IT TOO BIG?
BLE RECLOP
ASL A
MOV DCRACF,DCTBST(A) ;TELL TRANSMIT ROUTINES ACK OR NAK
BR RECLOP
DATA: CLR DCRCKS ;CLEAR CHECKSUM
JSR PC,GWORD ;GET A WORD OFF THE LINE
JMP RECLOP ;BAD PARITY IN WORD, CAN'T WIN
MOVB DCRWBL+1,DCRMID ;SENDERS ID # FOR THIS DATA
MOVB A,DCRWCT ;NUMBER OF WORDS FOLLOWING, INC. CHECKSUM
MOV DCRBIP,RBPOIN ;POINTER TO CURRENT BUFFER
DATA1: ADD #2,RBPOIN ;POINT TO NEXT WORD
JSR PC,GWORD
BR NODATA ;PARITY ERROR IN WORD
MOV A,@RBPOIN ;SAVE WORD
DEC DCRWCT ;IS IT THE LAST ONE(CHECKSUM)?
BGT DATA1 ;NO
TST DCRCKS ;SHOULD BE ZERO
BNE NODATA ;NO SUCH LUCK
TST DCRDRB+14 ;HAS THE LAST MESSAGE MADE IT TO THE DISK?
BNE NODATA ;NO, CAN'T KEEP THIS MESSAGE
SPUSH B
MOV #DCRLST,B
TST (B)+ ;IS THIS RECIEVE BUFFER FREE?
BNE .-2 ;NO
TST -(B) ;FOUND A FREE ONE
CMP #DCRLST+40,B ;IS IT REALLY ONE?
BGE NODATA ;NO PLACE TO PUT MESSAGE
EXCHA DCRBIP,DCRDRB+4 ;EXCH BUFFER USAGE
TST (A)+
MOV (A),A ;THIS IS THE MESSAGE ID
MOV A,(B) ;SO THE USER CAN FIND IT
BIT #177400,A ;IS THIS MESSAGE FOR THE SYSTEM?
BNE .+6 ;NO
INC SYSMES ;TELL THE SYSTEM IT HAS A MESSAGE
SUB #DCRLST,B
ASL B
ASL B
ASL B
ASL B
ADD DCRBFS,B
MOV B,DCRDRB+6
MOV DCRBFS+2,DCRDRB+10 ;DISK ADDRESS OF BUFFER
MOV #DCTSMS,A ;FIND A SMALL MESSAGE SLOT
TST (A)+
BNE .-2
MOV #<145_10>,B
BIS DCRMID,B
ADD #40,B
SWAB B
MOV B,-(A)
SPOP B
JMP RECLOP
NODATA: JMP RECLOP
;GET 16 BIT WORD OFF THE LINE
;6 BITS, 6 BITS, 2 PARITY+4 BITS (PPBBBB)
;3 333 222 222 111 111
GWORD: JSR PC,GBITCH ;GET A BINARY CHAR
RTS PC ;BAD CHAR, LOSE
MOV A,DCRWBL ;STATRT BUILDING WORD 0 000 000 000 BBB BBB
JSR PC,GBITCH
RTS PC ;BAD CHAR
SWAB A ; 0 0BB BBB B00 000 000
ASR A ; 0 00B BBB BB0 000 000
ASR A ; 0 000 BBB BBB 000 000
BIS A,DCRWBL ; 0 000 222 222 111 111
JSR PC,GBITCH
DCRRTS: RTS PC ;BAD CHAR
ASL A ; 0 000 000 00B BBB BB0
ASL A ; 0 000 000 0BB BBB B00
ASL A ; 0 000 000 BBB BBB 000
ASL A ; 0 000 00B BBB BB0 000
BISB A,DCRWBL+1 ; BB BB0 000
SWAB A ; B BBB 000 000 000 0BB
MOVB A,DCRPRB ; 00 000 0BB
SPUSH B
MOV DCRWBL,A
JSR PC,BITCNT ;GET NUMBER OF BITS IN THE WORD
BIC #177774,B ;MOD 4
COM B ;AND COMPLEMENTED
CMP B,DCRPRB ;IS IT THE SAME AS WAS SENT ON THE LINE?
BNE GWORDB ;NO, HAVE GOT BAD WORD
ADD A,DCRCKS ;YES, ADD TO CHECKSUM
SPOP B
JMP SRET
GWORDB: SPOP B
RTS PC
;GET 6 BITS OFF THE LINE
GBITCH: JSR PC,RFLUSH
SUB #40,A
BIT #177700,A
BNE DCRRTS
JMP SRET
BITCNT: SPUSH A
CLR B
BR BITCT2
BITCT1: INC B
BITCT2: ASL A
BCS BITCT1
BNE BITCT2
SPOP A
RTS PC
;TRANSMIT INTERUPT ROUTINES
DCTBRK: SPUSH A
EXCHA TPDLP,P
RTS PC
TFLUSH: MOV A,DCTB
T1FLSH: EXCHA TPDLP,P
SPOP A
RTI
TLOGIN: MOV #'Z-100,A
JSR PC,TFLUSH
MOV #LOGMES,TBPOIN
LOGSEN: MOVB @TBPOIN,A
BEQ LOGDNE
INC TBPOIN
BIC #100,DCTS ;DON'T CARE IF NO ECHO
JSR PC,TFLUSH
BR LOGSEN
LOGDNE: BIC #100,DCTS ;PUT IT TO SLEEP
JSR PC,T1FLSH
TST REDY10
BEQ LOGDNE
;FALL IN HERE WHEN 10 IS READY TO RECIEVE
.STITL INITIALIZE THE WORLD!
START: RESET
MOV SPDLP,P ;SET UP SYSTEM PDL
CLR TIME
MOV #200,PCSTBF ;EVERY 128/10000 TH'S
MOV #113,PCS
TST RJLSW
BEQ NODC11
MOV #121,DCRS
MOV #121,DCTS
MOV #'Z-100,DCTB
NODC11: MOV #CORCHK,BEBRV ;WHERE TO GO ON MEM TRAP
MOV #LOGEND,A ;LAST LOCATION WITH CRAP IN IT
ADD #200,A
TST (A) ;IS IT REALLY THERE?
BR .-6 ;LOOP ENDED BY MEM TRAP
CORCHK: BIC #377,A
MOV #BEBRV+2,BEBRV
MOV A,CORTOP
SUB #22000+SLOT1,A ;FUDGE AREA (NOW RADIA CAN FIT DDT THERE!)
CLR B
MOV #MQ+2,C
MOV A,-(C) ;MOVE A TO MQ
CLR -(C) ;CLEAR HIGH ORDER(AC)
MOV NSLOTS,-(C) ;DIVIDE
MOV MQ,B ;GET RESULT
CMP B,#MSLTLN
BLO .+6
MOV #MSLTLN,B
BIC #37,B
MOV #SLOT1-2,A ;BEGINING OF SLOT-2 (FOR DISK)
MOV #SLTCAD+2,C ;ADDRESS OF SLOT
MOV NSLOTS,D
MOV D,NINU ;NUMBER OF USERS IN CORE NOW.
CLR E
SLTAL1: MOV A,(C)+ ;ADDRESS OF THIS SLOT
ADD B,A ;NEXT ONE
MOV E,SLOTST-SLTCAD-4(C) ;USER OF THIS SLOT
MOV #1,SLOTST-SLTCAD-2(C) ;JUST SWAPED IN
ADD #LUBLK,E ;NEXT USER
TST (C)+
DEC D
BGT SLTAL1 ;DO THIS NSLOTS TIMES
MOV B,USLENT
ASR B
MOV B,A ;SAVE A POSITIVE WORD COUNT
NEG B
MOV B,USWCNT
MOV #3,A
MOV #-1,B ;SIE OF DISK IN A AND B
SUB DSKRND,B ;MINUS RANDOM SYSTEM STORAGE
SUB DSKRND+2,B
MOV #MQ+2,C
MOV B,-(C)
MOV A,-(C)
MOV NUSERS,-(C) ;DIVIDE AMOUNT OF DISK BY # OF USERS
MOV #-1,A ;FULL ALOCATION
TST AC
BNE .+6
MOV MQ,A ;AMOUNT OF DISK PER USER
DALOC2: ADD USWCNT,A ;ADD NEGATIVE WORD COUNT TO AMOUNT OF DISK
SUB #DTIBFL+DEDBFL+DDIRL,A ;SUBTRACT FIXED BUFFERS
BGT DALOC3 ;RESULT <15 BITS
MOV #77777,A ;MAKE IT 15 BITS
DALOC3: BIC #377,A ;TO GET # OF WORDS OF RANDOM STORAGE
MOV A,E ;SAVE THAT QUANT IN E FOR (MUCH) LATER
SWAB A
MOV A,B
ASL A ;NUMBER OF BLOCKS (200 WORDS) NOW IN A
ASR B
ASR B
ASR B ;NUMBER OF BLOCKS/20 NOW IN B
MOV #DBITTB,C ;SET UP TO INIT DISK BIT TABLE
DALOC5: DEC B ;20 BLOCKS (=1 WORD IN TABLE)AT A TIME
BLT DALOC4 ;ALL DONE
CLR (C)+
BR DALOC5
DALOC4: CLR (C) ;ONLY SOME BITS ON IN THIS WORD
COM (C)
MOV #1,D
BIC #177760,A ;# OF WORDS MOD 20
DALOC6: DEC A
BLT DALOC7
BIC D,(C)
ASL D
BR DALOC6
DALOC7: TST (C)+
CMP C,#DBITBE
BGT DALOC8
MOV #-1,(C)
BR DALOC7
DALOC8: BIS #1,DBITTB ;FIRST BLOCK TO BE USED
BIS #100000,DBITBE ;IMPOSSIBLE TO GO OFF TOP
MOV E,D
MOV #3,A
MOV #-1,B
MOV #MNUSRS,E
MOV #LUBLK*<MNUSRS>,U
UVINIT: SUB #LUBLK,U ;FOR NEXT GUY DOWN
MOV #-1,FLSADR(U) ;INDICATE THAT THIS GUY ISN'T REALLY HERE
CLR FLSRES(U)
DEC E
CMP E,NUSERS ;MAYBE HE REALLY IS HERE
BGE UVINIT ;NOPE!
CLR FLSADR(U)
MOV #FRNEWU,FLSRES(U)
MOV #UDSKAD+4,C
ADD U,C
SUB D,B ;AMOUNT OF RANDOM STORAGE
SBC A
MOV A,-(C) ;HIGH ORDER RANDOM STORAGE ADDR
MOV B,-(C) ;LOW ORDER
MOV A,-(C) ;HIGH ORDER RANDOM STORAGE ADDR
MOV B,-(C) ;LOW ORDER
SUB #DDIRL,B
SBC A
MOV A,-(C) ;HIGH DISK DIR
MOV B,-(C) ;LOW
SUB #DEDBFL,B
SBC A
MOV A,-(C)
MOV B,-(C)
SUB #DTIBFL,B
SBC A
MOV A,-(C)
MOV B,-(C)
ADD USWCNT,B
BCS .+4
DEC A
MOV A,-(C)
MOV B,-(C)
TST E
BGT UVINIT
MOV #SLOT1,D
MOV #SOFN,B
MOV #ASOFN-SLOT1,C
ADD D,C
ADD USLENT,D ;LAST AVAILABLE WORD ADDR
CLR LINENO
INIT1: INC B
BIT #10000,B
BNE INIT2
MOV B,(C)+
CLR (C)+
CMP D,C
BHI INIT1
INIT2: CLR (C)+
CLR @C
ADD #SOFN,B
MOV B,NUNODE ;NUMBER OF NODES PER USER
MOV #UVBLK,A ;TO INITIALIZE USER VARIABLES IN SWAPPED OUT USERS
MOV #SLOT1,B ;SET UP FOR BLT
SETUVS: MOV (A)+,(B)+ ;BLLLLLLLLLLLLLLLLLT
CMP #UVBLK+LUVBLK,A
BGT SETUVS
TST RWWSW
BNE STARTF
JSR PC,SYDRBG ;GET A SYSTEM DISK REQUEST BLOCK
CLR (A)+ ;NO START ROUTINE
MOV USWCNT,(A)+ ;LENGTH OF A USER SLOT
MOV #SLOT1-2,(A)+ ;SWAP OUT SLOT1
MOV DCLRUS,(A)+ ;GETS PUT INTO THE CLEAR USER PLACE
MOV DCLRUS+2,(A)+
TST (A)+
MOVB #DWRTEC,(A)
STARTF: MOV NUSERS,NUSER2
ASL NUSER2
TST JDCSW
BNE ITINIT
MOV #UTYO,TYO+2
MOV #UTYI,TYI+2
MOV #3,BRKCHR
JMP NEXTUS
ITINIT: JMP TINIT
UGO: JSR PC,RUNME
PRTXT ^/11LOGO /
MOV LVERNF,A
JSR PC,PRDN
PRCR
RSTART:
MOV SALTL,ALTL
MOV #100,TKS ;ENABLE INTERRUPTS FOR TYI
TEST1:
MLOOP: JSR PC,SCHEDP
TST BRAKE(U)
BEQ MLOOP1
JSR PC,BRAKR ;BREAK
JMP ERTLN
MLOOP1: JSR PC,GETSTR
JSR PC,MREAD
JSR PC,EVLINE
ERROR+WDW ;WHAT SHOULD I DOO WITH (S)
BR MLOOP
WSTART: MOV #IP,P ;USE WITH CAUTION!!
BR RSTART
RUNRUG: 3
BR .+2 ;RUG SHOULD RETURN HERE IF $P'ED
BR .+2
JMP NORT
.STITL GET A STRING
GSTR9: MOV CLN,B
JSR PC,GTLINE
ERROR+LDE ;LINE ..(B).. DOESN'T EXIST
MOV C,A
BR GSTR8
GETSTR: TST FUNLEV ;ARE WE IN A PROC
BEQ GSTR0 ;NO
BIT #ERRF,FLAGS2 ;ERROR, MAYBE
BNE GSTR0 ;YES
MOV CLP,B ;NO, GET THIS NODE OF LLP
BEQ GSTR9
JSR PC,.LOAD
BIT #7777,A ;IS IT LAST NODE
BNE GSTR8
SPUSH A ;"STOP" POPS 5 WORDS
SPUSH A
SPUSH A
SPUSH A
JMP PSTOP
GSTR8: MOV A,CLP
MOV A,B
JSR PC,.LOAD
JSR PC,.LOAD ;OK, GET FIRST NODE OF LINE, = LINE #
MOV B,CLN
MOV A,CTP ;IN CASE THERE IS; NO GENERATION #
MOV A,C
JSR PC,.LOADC ;GET SECOND NODE
CLR CLGN ; IF TYPE = SNUM, IT IS GEN #
MOV A,C
BIC #7777,C
CMP #SNUM,C
BNE GSTR6
MOV B,CLGN ;IT IS
MOV A,CTP
;FALLS THROUGH
;FALLS IN
GSTR6: BIS #LIST,CTP
SPUSHS CTP
BIT #TRACEF,FLAGS2
BEQ GSTRT
PRCR
PRTXT ^\ #\
MOV CPP,B
JSR PC,PPNAME ;PRINT PNAME
PRTXT ^\ LINE \
MOV CLN,A
JSR PC,PRDN
PRCR
JSR PC,PRLN
BR GSTRT
GSTR0: BIT #TESTF,FLAGS2
BEQ GSTR1
MOV ALTL,A
MOV (A)+,B
BEQ DONE
MOV A,ALTL
PUSHS B
PRCR
PRTXT ^/TEST LINE /
INC LINENO
MOV LINENO,A
JSR PC,PRDN
PRCR
JSR PC,PRLN
CLR FLAGS
CLR CO
CLR CO+2
CLR NOR
GSTRT: RTS PC
POP A ;GET RETURN ADDR
PUSH #1
JMP @A
GSTR1: JSR PC,RDSTR
BR GSTRT
DONE: PRTXT ^/ALL DONE!/
PRCR
SPOP A ;CROCK!!!
JMP RSTART ;BLECTCH?
.STITL READ A STRING - PTR ON S
RDSTR1: PRCR
RDSTR: CLR NBKTS
CLR BRAKE
MOV PRMTCH,D
BEQ RDSTR9
JSR PC,TYO
RDSTR9: JSR PC,RLINE
JSR PC,BLSTI
RDSTR2: JSR PC,TYI
TST BRAKE
BEQ .+10
JSR PC,BRAKR
BR RDSTR7
CMP BRKCHR,D ;BREAK TYPED?
BEQ RDSTR7 ;YES
TST NBKTS ;IN A LIST?
BGT RDSTR3 ;YES
CMP #15,D ;CR?
BEQ RDSTR4
RDSTR3: CMP #'[,D
BNE RDSTR6
INC NBKTS
RDSTR6: CMP #'],D
BNE RDSTR5
DEC NBKTS
RDSTR5: JSR PC,BLST
BR RDSTR2
RDSTR4: JSR PC,BLSTF
BR RDSTR ;NO CHARS TYPED
PUSHS TOPS
CLR TOPS
RTS PC
RDSTR7: JSR PC,BLSTF
BR RDSTR1
JSR PC,FRELST
BR RDSTR1
RQUEST: PUSH PRMTCH
MOV #'<,PRMTCH
JSR PC,RDSTR
POP PRMTCH
JMP ORT
.STITL MORE READ ROUTINES!!!
MREAD: TST FUNLEV ;ARE WE IN PROC?
BEQ MRD1 ;NO
BIT #ERRF,FLAGS2 ;YES, BUT ERROR?
BNE MRD1 ;YES
RTS PC ;NO
MRD1: BIT #TESTF,FLAGS2
BNE MRD2
JMP READ ;CONVERT CHAR STRING TO TOKEN LIST
MRD2: RTS PC
RLINE: TST USER
BLT RLINE1
TST JDCSW
BEQ RLINE1
PUSH U
MOV USER,U
MOV #FRTYIH,FLSRES(U)
JSR PC,FLUSH ;RETURNS WHEN LINE DONE
JSR PC,RUNME
POP U
RLINE1: RTS PC
.STITL EVAL 1 LINES
EVLINE: TST TOPRNM
BNE EVLI4
EVLI6: JSR PC,IGNT ;EVALUATES 1 LINES ON S
EVLI1: BIT #CRF,FLAGS
BNE EVLI2
JSR PC,EVAL
BR EVLI3 ;NO OUTPUT, OK
RTS PC
EVLI3: BIT #CRF,FLAGS
BNE EVLI2
JSR PC,GNT
BIS #RTF,FLAGS
BR EVLI1
EVLI4: MOV @S,B
JSR PC,.LOAD
MOV A,D
BIC #7777,A
CMP #SNUM,A
BEQ EVLI5 ;AN SNUM
CMP #LNUM,A
BNE EVLI6 ;NOT EVEN A NUMBER
JSR PC,.LOAD ;AN LNUM, SEE IF TOO BIG
BIT #7777,A
BNE EVLI7 ;TOO BIG
BIC #170000,D ;MAKE IT INTO AN SNUM
ADD D,A
JSR PC,GRBAD
MOV C,@S
EVLI5: JSR PC,ADLN
POPS A
EVLI2: SKPRET
EVLI7: ERROR+LNTB ;LINE # TOO BIG
.STITL GET NEXT TOKEN
GNT: BIT #RTF,FLAGS ;IS REPEAT TOKEN FLAG SET?
BEQ GNT1
BIC #RTF,FLAGS ;YES
MOV CT,A
MOV CT+2,B
BNE GNT6
CMP #SFUN,A
BNE GNT6
BIS #CRF,FLAGS
GNT6: RTS PC
GNT1: BIC #PTLPF,FLAGS
CMP #$LLPAR,CT+2 ;IS CT "("
BEQ GNT3
CMP #$LPAR,CT+2
BNE .+8.
GNT3: BIS #PTLPF,FLAGS ;YES, SET PTLPF
MOV CT,B ;GET LINK TO NEXT TOKEN
MOV B,CTP
BIT #7777,B
BEQ GNT2 ;ANY TOKENS LEFT
JSR PC,.LOAD ;YES
GNT4: MOV A,CT
MOV B,CT+2
RTS PC
GNT2: BIT #CRF,FLAGS
BNE GNT5
BIS #CRF,FLAGS
MOV #SFUN,A
CLR B
BR GNT4
GNT5: ERROR+OOT ;OUT OF TOKENS
IGNT: POPS B
BIT #7777,B
BEQ IGNT1
BIC #CRF,FLAGS
JSR PC,.LOAD
IGNT2: MOV A,CT
MOV B,CT+2
BIS #RTF,FLAGS
MOV #1,CTN
RTS PC
IGNT1: BIS #CRF,FLAGS
MOV #SFUN,A
CLR B
BR IGNT2
TYO: JMP @#STYO
STYO: TSTB TPS
BPL .-4
MOV D,TPB
RTS PC
UTYO: TSTB TPS
BPL .-4
MOVB D,TPB
CMP #15,D
BNE UTYOR
MOV #12,D
JSR PC,TYO
MOV #15,D
UTYOR: RTS PC
TYOT: 0
0
CH: 0
TYI: JMP @#STYI
STYI: WAIT
TSTB TKS
BPL STYI
MOVB TKB,D
BIC #177200,D
BR STYO
UTYI: WAIT
TST CHI
BEQ UTYI
MOVB CHI,D
CLR CHI
BIC #177600,D
BR TYO
.STITL GARBAGE COLLECTOR
NNODES==4096.
GCBTL== NNODES/8./2.*2.+2. ;GARBAGE COLLECT BIT TABLE LENGTH
MARKN: SPUSH A ;MARK NODE(B)
SPUSH B
MOV B,A
BIC #170000,A
BIC #177770,B
MOVB BMT(B),B
ASR A
ASR A
ASR A
ADD GCBITS,A
BISB B,(A)
SPOP B
SPOP A
RTS PC
BMT: .BYTE 1,2,4,10,20,40,100,200
.IFNZ GCDBUG
LMT: DMK ;SYSTEM FUNCTION
DMK ;INFIX (SYSTEM FUNCTION)
DMK ;USER FUNCTION
DMK ;VARIABLE BINDING
GCDIE ;UNUSED
GCDIE ;UNUSED
GCDIE ;UNUSED
DMK ;SHORT STRING
MKSNP ;SNAP
DMK ;ATOM
DMK ;SHORT NUMBER
GCMARK ;LONG NUMBEB
GCMARK ;LONG STRING
GCDIE ;TBA
GCMARK ;SENTENCE
GCMARK ;LIST
.ENDC
MARKL: CMP B,#SNP ;IS LIST A SNAP?
BLOS MKL0 ;NO
CMP B,#<SNP+10000>
BLO MKSNPL ;YES
MKL0: PUSH A ;MARK LIST
SPUSH B ;NODE ADDS IN B
SPUSH C
.IFNZ GCDBUG
SPUSH D
.ENDC
MOV B,A
MKL1: MOV A,C
BIT #7777,C ;IS THERE ANOTHER NODE
BEQ MKL3
MOV C,B ;YES, MARK IT
JSR PC, MARKN
JSR PC,.LOADC ;GET IT
.IFNZ GCDBUG
MOV A,D
SWAB D
BIC #177417,D
ASR D
ASR D
ASR D ;ALL THIS GIVES YOU THE TYPE*2
JMP @LMT(D) ;WHICH YOU MIGHT MARK ON
DMK: BR MKL1
GCDIE: HALT
GCMARK: JSR PC,MARKL
BR MKL1
.ENDC
MKSNPL: EXCH SNPTEM,C ;B POINTS TO SNAP
JSR PC,MKDC
MOV SNPTEM,C ;RESTORE C
BR MKL0
MKSNP: JSR PC,MKDC ;ONLY MARKS THE DISPLAY CODE
JSR PC,MKL0 ;ALSO NEED TO MARK THE NODES
BR MKL1
.IFZ GCDBUG
BIC #7777,A
CMP #100000,A
BLO MKL1
BEQ MKSNP
CMP #120000,A
BLOS MKL1
JSR PC,MARKL
BR MKL1
.ENDC
MKL3: .IFNZ GCDBUG
SPOP D
.ENDC
SPOP C
SPOP B
POP A
RTS PC
.GCOLL: JSR F,ACSAV
PUSH ACRELF
MOV USER,U
.GCOL2: TST GCLOCK ;IS SOMEONE ELSE GC'ING?
BLT .GCOL3 ;NO, GO AHEAD
JSR PC,FLUSH ;WAIT
BR .GCOL2
.GCOL3: MOV U,GCLOCK
JSR PC,RUNME
MOV GCBITS,A ;GARBAGE COLLECT
MOV #GCBTL/2-1,B ;CLEAR BIT TABLE
MOV #1,(A)+ ;ALWAYS PROTECT NODE ZERO
.GCOL1: CLR (A)+
DEC B
BGT .GCOL1
PUSHS SNLIST ;PROTECT THESE LOSERS
SPUSHS #TRUE
SPUSHS #FALSE
MOV #RELE,ACRELF
MOV #HCC,F ;NUMBER OF HASH CODE ELEMENTS
MOV SUHCT,E ;ADDRESS OF HASH TABLE
MKUOBL: DEC F
BLT MKTPS
MOV (E)+,D ;GET A HASH CODE ELEMENT
MKUOBI: MOV D,C
BEQ MKUOBL ;NO MORE
MOV D,B ;MARK THE NODE
JSR PC,MARKN
JSR PC,.LOADC
MOV A,D
MOV B,C
JSR PC,MARKN ;MARK NODE POINTED TO BY THIS ONE
JSR PC,.LOADC ;THEN GET IT
JSR PC,MARKL ;SHOULD BE PNAME POINTER NODE
MOV A,C
MKUOE: BIT #7777,C ;ONE OTHER NODE?
BEQ MKUOBI ;NO
MOV C,B ;YES
JSR PC,MARKN ;MARK IT
JSR PC,.LOADC
MOV C,SNPTEM ;SAVE IN CASE VBIND IS SNAP
MOV A,C
BIC #7777,A
CMP #FBIND,A
BEQ MKFB ;FUNCTION BINDING
CMP #VBIND,A
BEQ MKVB ;VARIABLE BINDING
CMP #SFBIND,A
BEQ MKSFB ;SWAPPED FB
CMP #SVBIND,A
BEQ MKSVB ;SWAPPED VB
HALT ;BUG
MKVB: JSR PC,MARKL
BR MKUOE
MKFB: JSR PC,MARKL
BR MKUOE
MKSVB: BR MKUOE
MKSFB: JSR PC,MARKL
BR MKUOE
MKTPS: MOV #GCMKL,F
MKRNDM: MOV (F)+,B ;POINTER TO POINTER
BEQ MKSPDL ;LAST ONE
MOV (B),B ;REAL NODE ADDRESS
BEQ MKRNDM ;NOTHING THERE
JSR PC,MARKL
BR MKRNDM
MKSPDL: MOV SPBASE,E
MKSP1: MOV -(E),B ;GET A S PDL WORD
CMP E,S ;END OF S PDL?
BLT MKSP2 ;YES
JSR PC,MARKL ;MARK S PDL WORD
BR MKSP1
MKSP2: MOV SPBASE,A
TST (A)+
BNE MKSP3 ;THERE I S PDL ON DISK, GO MARK IT
TST (A)
BEQ MKSP4
MKSP3: JSR PC,UBLKGR
HALT
HALT
MOV B,SSAVEA
MOV C,SSAVEA+2 ;PLACE TO SAVE S PDL
MOV SSWPAD,4(A)
MOVB #DWRTEC,14(A) ;WRITE OUT CURRENT S PDL
JSR PC,DSKWA2
MKSP8: MOV SPBASE,B
TST (B)+ ;IS @HERE ANODHER BLOCK ON DHSK?
BNE MKSP5 ;YES
TST (B)
BEQ MKSP6 ;NO
MKSP5: JSR PC,SYDRBG ;PREPARE TO SWAP IN BLOCK
CLR (A)+
MOV #-200,(A)+
MOV SSWPAD,(A)+
MOV SPBASE,B
MOV (B)+,(A)+
MOV (B)+,(A)+
TST (A)+
MOVB #DREADC,(A)
JSR PC,DSKWAI
MOV #200,F
MOV SPBASE,E
MKSP7: MOV -(E),B ;MRK THIS PIECE OF S PDL
JSR PC,MARKL
DEC F
BGT MKSP7
BR MKSP8
MKSP6: JSR PC,SYDRBG ;PREPARE TO SWAP CURBENT PDLBACK
CLR (A)+
MOV #-200,(A)+
MOV SSWPAD,(A)+
MOV SSAVEA,(A)+
MOV SSAVEA+2,(A)+
TST (A)+
MOVB #DREADC,(A)
JSR PC,DSKWAI
MOV SSAVEA,C
JSR PC,UBLKFR
MKSP4:
JSR PC,DSGCF
ADD #6,S ;GET RID OF 3 GUYS PUSHED BEFORE
;OK NOW RETURN ALL IN MARKED NODES
;RA ADDS OF LIT MAP
;RB NODE ADDS
;RC ACTUAL ADDER OF NODE
;RD BIT MAP
;RE POINT TO LIST OF FREE STORAGE RECYCLES NODES
;START COLLECTING AT LUNN(LOWEST UNPROTECTED NODE #)
CLR E
CLR NNGC
CLR B ;NODE ZERO
MOV UAB,C ;NODE ZERO ADDRESS
MOV NUNODE,F ;NUMBER OF NODES
MOV GCBITS,A ;BIT TABLE ADDR
MOV (A)+,D
SEC
ROR D
GCRT2: BCS GCRT3
MOV E,(C)+ ;WE HAVE A NODE, LINK IN 1ST WORD
CLR (C)+ ;CLEAR SECOND
MOV B,E ;NEW FREE STORAGE HEAD NODE
INC NNGC
BR GCRT4
GCRT3: ADD #4,C
GCRT4: INC B
DEC F
BLE GCRT5
CLC
ROR D
BNE GCRT2
MOV (A)+,D ;GET NEXT WORD OF BIT MAP
SEC
ROR D
BR GCRT2
GCRT5: MOV E,FREE ;YES
MOV #-1,GCLOCK
POP ACRELF
JSR F,ACRES
RTS PC

Reference in a new issue View git blame Copy permalink