|
DataMuseum.dkPresents historical artifacts from the history of: CR80 Hard and Floppy Disks |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CR80 Hard and Floppy Disks Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 39296 (0x9980)
Types: TextFile
Names: »S8DOCM«
└─⟦cb65a69e7⟧ Bits:30005484 8" CR80 Floppy CR80FD_0203 ( CR/D/0986 )
└─⟦990125f75⟧
└─ ⟦this⟧ »JAS.S8DOCM«
LIST 78.04.07 09.47
; CR80 SYSTEM ONE
; DRIVER
; MODULE: DOC - DRIVER, OPERATOR'S CONSOLE (SILENT 700)
BEGIN MODULE MYPROC MESSAGE <:DOC:> ; BEGIN MODULE: DOC;
GLOBAL NL,LF,CR,BYTE,MADDRESS,WORK,PROGRAM,C,DEVICE
GLOBAL BMTIMER,BMERROR,INTERRUPT,ADJUST,CBASE,BS,EM,CAN,DEL
GLOBAL GETBYTE,PUTBYTE,WAITINTERRUPT
GLOBAL CUREVENT,BNIGNR,STATE,NAMEBYTES
USE BASE
NOLIST
; S8MNAX
;
; CR80 SYSTEM ONE, NAMES
;
; GENERATED AT 78.04.05
; 00151000 0 000E LEVEL 2 NAMES:
ITEMLH= #0005
C= #000D
BMERRR= #0020
BMFULL= #0400
BNLOCT= #000B
BMSPEL= #0009
BNERRR= #0005
BNFULL= #000A
DISKDS= #0002
REALTK= #0000
BMBYTE= #0004
BMDIST= #0100
BMREJT= #0004
PROGLH= #000E
BNBYTE= #0002
BMCONV= #0010
BNDIST= #0008
BNREJT= #0002
BNCONV= #0004
TIMEMK= #6800
CONTLH= #0005
TIMESE= #0064
BMINPT= #0001
BMWORD= #0000
BMTIMR= #0002
BMPARY= #0080
BMPROM= #0002
BNTIMR= #0001
BNPARY= #0007
BNPROM= #0001
TERMIL= #0001
N= #0004
BMUNKN= #2000
DISABD= #E000
POWERE= #0001
BMSTEP= #0020
BNUNKN= #000D
BMWRIR= #0200
BNSTEP= #0005
BNWRIR= #0009
BMREST= #0002
BMPOSN= #0010
BMERAE= #0020
BNREST= #0001
BNPOSN= #0004
BNERAE= #0005
BMNORS= #4000
BNNORS= #000E
EVERSN= #0006
IDLENH= #0004
BMBUSY= #8000
BMCLEN= #0000
BNBUSY= #000F
EAREAS= #000A
BMNOEC= #0040
NAMELH= #0003
BNNOEC= #0006
BMOPUT= #0002
BMCLER= #0040
MAXDEE= #003F
BNOPUT= #0001
BNCLER= #0006
BMRELE= #0004
BMNOTY= #0001
ETYPE= #0007
BNRELE= #0002
BNNOTY= #0000
BMREAR= #0100
BNREAR= #0008
NAMEBS= #0006
BMOUTT= #0003
BMTPUT= #0001
BMSPEC= #0008
BMCONL= #0000
BMUNCE= #0010
BMEOF= #0040
BNTPUT= #0000
BNSPEC= #0003
BNUNCE= #0004
BNEOF= #0006
BMILLL= #0008
BNILLL= #0003
BNMUTX= #0000
BMNOCP= #0080
BMRESE= #0008
BNNOCP= #0007
BNRESE= #0003
BMTERE= #0080
BMDISP= #0001
BMREET= #0001
BNTERE= #0007
BNDISP= #0000
BNREET= #0000
USE BASE
BMWAC:= #0080
OLDPRC:= #001B
SAVE3:= #0029
SSAVE1:= #0019
BNWAC:= #0007
SAVE4:= #002A
SSAVE2:= #001A
SAVE5:= #002B
SBLOCK:= #000C
SSAVE3:= #001B
TERMIE:= #0031
SAVE6:= #002C
STACKH:= #0005
SSAVE4:= #001C
BMPLSB:= #0100
NEXT:= #0002
SAVE7:= #0040
PROCLH:= #0052
CATSLH:= #0040
SSAVE5:= #001D
BS:= #0008
BMWDE:= #0008
BNPLSB:= #0008
WARNIG:= #0030
DELAY:= #0033
SAVE8:= #0041
MESSAG:= #004D
SSAVE6:= #001E
BNWDE:= #0003
CLINK:= #0014
SAVE9:= #0042
SSAVE7:= #001F
DLINK:= #0027
WORK:= #0040
SACTIN:= #0008
SSAVE8:= #0020
BMCHAE:= #0049
BM1:= #FFFF
ELINK:= #0056
ANS0:= #0000
SSAVE9:= #0021
NL:= #000A
BM2:= #FFFF
WORKAA:= #0295
ANS1:= #0001
SFILE:= #000D
ESEGMS:= #000B
EVENTC:= #003D
ANS2:= #0002
EATTRE:= #0006
EAREAE:= #0008
MES0:= #0000
ANS3:= #0003
CR0:= #000D
EVENTE:= #0037
MES1:= #0001
ANS4:= #0004
SIDENT:= #0003
BMLOOP:= #0019
CR1:= #000E
DATE:= #0024
MES2:= #0002
BOPER:= #0000
PARENT:= #0001
CR2:= #000F
SAVE10:= #0043
MES3:= #0003
NAME:= #0007
CR3:= #0010
CAUSE:= #001E
EMRETN:= #001E
SAVE11:= #0044
MES4:= #0004
SSTACD:= #0013
BFIRST:= #0006
CR4:= #0011
SAVE12:= #0045
BSTATE:= #0005
CR5:= #0012
CBASED:= #0016
SAVE13:= #0046
WRK:= #004D
SNAME:= #0000
BMWAN:= #0001
CR6:= #0013
SAVE14:= #0047
STOP:= #000F
EFIRST:= #001A
BNWAN:= #0000
BMMESS:= #0001
CR7:= #0014
RESTIG:= #0038
SAVE15:= #0048
SBLOCT:= #000B
BMWPA:= #0040
BNMESS:= #0000
BMANSW:= #0002
KIND:= #0006
SAVE16:= #0049
UTILIH:= #02A1
MOPERN:= #0000
BNWPA:= #0006
BNANSW:= #0001
BMCHAL:= #00F0
PROCIT:= #0004
SAVE17:= #004A
SMODE:= #0005
SBUFSE:= #0011
BNCHAL:= #0004
SAVE18:= #004B
ACOUNT:= #0001
SKIND:= #0006
BMPRIY:= #FF00
AREACM:= #002E
SAVE19:= #004C
RESERR:= #0052
WORKIG:= #005E
BCOUNT:= #0001
BNPRIY:= #0008
CATWRK:= #0005
PPROGM:= #000C
EBLOCE:= #0009
CONTET:= #0004
CAN:= #0018
BMWIN:= #0004
PROGRM:= #0017
EOFACN:= #0059
EBLOCG:= #000E
BMNEXT:= #0029
BNWIN:= #0002
BMRECD:= #000A
BMPER0:= #0069
BNRECD:= #0001
ANSWER:= #004D
BMCREE:= #0009
BMPER1:= #0079
DEL:= #007F
PREFS:= #0001
CURSLH:= #00B2
EVT0:= #0000
EHIBLK:= #000C
EDUMMY:= #001F
BMPER2:= #0089
KINDFD:= #0400
TIMER:= #0019
DEVPR:= #001F
CURIN:= #005A
EVT1:= #0001
BMPER3:= #0099
BMWC:= #003F
PSW:= #001A
PRESET:= #0020
ADJUST:= #0035
DEVICE:= #0053
ENTRYA:= #0275
USERLH:= #02F0
EVT2:= #0002
BUFFEH:= #0008
BMPER4:= #00A9
BNWC:= #0006
CURSIN:= #005F
EVT3:= #0003
BMPER5:= #00B9
PPRPC:= #000D
MSAVE:= #0026
CENTRY:= #005D
ABLOCK:= #0003
EVT4:= #0004
ERECOE:= #000A
BMPER6:= #00C9
BMACTE:= #BFC0
INTERT:= #0054
CATALG:= #0057
WORKLH:= #000C
BBLOCK:= #0003
CATALH:= #0058
BMXCU:= #4000
BNSSI:= #0001
REF:= #0003
REFLEH:= #0004
BADDR:= #0002
BMPER9:= #00D9
BNXCU:= #000E
PBUFS:= #0002
ITEM:= #FFF3
LOCACN:= #001C
TIME:= #0021
EAREA:= #000F
BMWEV:= #0002
BMPR:= #3F00
ERROR:= #002F
REFS:= #0036
W:= #0040
BNEXT:= #0007
ENTRYH:= #0020
BNWEV:= #0001
CATBIN:= #0003
EVENT:= #004D
STREAT:= #000A
BMRUN:= #8000
RECEIR:= #0001
ARESUT:= #0000
AFILE:= #0004
BNRUN:= #000F
PROC:= #000D
EVENTS:= #003C
MCOUNT:= #0001
BFILE:= #0004
EPAGE:= #001B
CHAIN:= #0005
PRPC:= #0018
ESC:= #001B
BMPEND:= #0009
CHILD:= #0003
SMASK:= #0007
BNPEND:= #0000
PCOUNT:= #0006
FREEAS:= #002A
NEXTET:= #003B
BUFLEH:= #0009
ASTATS:= #0002
BUF:= #0003
FF:= #000C
KINDOC:= #0100
CBASE:= #0015
CUREVT:= #003A
ECHART:= #001C
BMREME:= #0059
BNWAIG:= #0008
CATCAT:= #0006
STATE:= #0000
BUFS:= #0037
CURWOK:= #005C
SPROCT:= #0004
BMRENE:= #0039
CATDAT:= #0001
WCATS:= #02B0
SFIRST:= #000E
EIDENT:= #0003
EBASE:= #0019
KINDCR:= #0200
CATOBJ:= #0004
PSIZE:= #000B
FIRSTT:= #0039
BMPRCH:= #FFF0
SUSED:= #0012
SHAREH:= #0022
BMWSM:= #0010
PWORDS:= #0003
EDATE:= #0004
BNWSM:= #0004
WSAVE:= #02A1
WPROG:= #02A2
BMIGNR:= #000C
CATTXT:= #0002
INTRPT:= #0034
MBLOCK:= #0003
SREM:= #0010
ENAME:= #0000
BMWSP:= #0020
BNIGNR:= #0002
EDRIVE:= #0007
BNWSP:= #0005
BNRSU:= #0000
BMRX:= #C000
DRIVEH:= #0055
MADDRS:= #0002
EMODE:= #001E
WORD:= #0000
SIZE:= #0004
PRICHN:= #0032
ESPECL:= #0055
SEOFAN:= #0009
EKIND:= #001D
LF:= #000A
EM:= #0019
BMDYNC:= #C03F
BMREF:= #0008
CURSWK:= #01C3
BNREF:= #0003
NAMEIT:= #0003
ACTION:= #0058
CURSOT:= #0111
MFILE:= #0004
CR:= #000D
BMSIGN:= #0004
SAVE0:= #003E
CUROUT:= #005B
SSSIZE:= #0017
BMWS:= #00C0
BNSIGN:= #0002
KINDLP:= #0300
SAVE1:= #003F
SENDER:= #0001
ERECOS:= #000D
BMSTAC:= #FFC0
LOCREN:= #001D
SAVE2:= #0028
SSAVE0:= #0018
MTESTS= #0000-128*BASE-128*(PROG-1)
MMODES= #FFFF-128*BASE-128*(PROG-1)
MCHECS= #FFFF-128*BASE-128*(PROG-1)
BYTE= #0000+ 2*BASE+ 0*(PROG-1)
PRIOR0= #0000-128*BASE-128*(PROG-1)
PRIOR1= #0000-128*BASE-128*(PROG-1)
PRIOR2= #0000-128*BASE-128*(PROG-1)
USE #0
; 00175900 0 0100 LEVEL 4 NAMES:
INSPEE= #0070
ENDPRM= #0041
INPARM= #0068
STARTS= #006C
OUTNL= #005D
COMPAS= #0045
CREATS= #006A
OUTTET= #005C
MPER00= #0051
OUTHEA= #0064
STOPPS= #006D
CREATY= #004A
RENAMY= #004D
GETPON= #0058
REMOVE= #0072
CLOSE= #0054
INWORD= #007C
OUTNAE= #0085
PUTARA= #0074
STACK= #0055
OUTEND= #005E
LINKNT= #006E
SETDEY= #0077
BACKSE= #0063
OUTCHR= #005F
REMOVM= #0071
INNEXT= #0069
INCHAR= #0061
OUTBLK= #0060
INTYPE= #0066
OPEN= #0053
OUTTEB= #005B
COMPAE= #0046
INIT= #0052
LINKCD= #006F
GETARA= #0073
FREE01= #0089
SETINT= #0078
SETPON= #0057
PUTBYE= #0049
INNAME= #007B
NEXTON= #0043
REMOVS= #006B
SETPRN= #0076
INCOMD= #0086
CHANGY= #004E
NEXTEY= #004C
UNSTAK= #0056
INITDE= #0042
WAIT= #0059
INITWT= #0075
OUTINR= #0065
REMOVY= #004F
FINDEY= #0050
GETADS= #0047
RETURR= #0044
INBLOK= #0062
OUTTEP= #005A
LOOKUY= #004B
GETBYE= #0048
INELET= #0067
USE #0
; 00197700 0 0040 LEVEL 4 NAMES:
GETINL= #0007
GIVEUE= #0018
SEARCS= #001A
WAITAR= #000D
ENTERL= #0006
WAITIL= #0008
GETINT= #0004
REGISS= #0013
SENDSL= #000A
WAITET= #000F
WAITIT= #0005
WAITDY= #0019
INSERT= #0001
RESERT= #0003
REGREE= #0010
MEMARA= #0014
CREATE= #001C
WAITNT= #000E
LEAVEL= #0009
TRANST= #0012
CLEART= #0000
SENDME= #000B
RELEAT= #0002
SENDAR= #000C
RESUMT= #0011
GETEVE= #001B
USE #0
; 00199200 0 0040 LEVEL 3 NAMES:
USE PROG
LOCINT:= #026F
LOCACT:= #826F
USE #0
LIST
XPD:= DRIVERLENGTH
NOLIST
; CR80 SYSTEM ONE
; MONITOR
; MASTER: XPD - PROCESS DESCRIPTION (PART 1)
IF XPD EQ UTILITYLENGTH OR XPD EQ PROGLENGTH THEN
IF WORDS NE 0 THEN MESSAGE WORDS FI
AREASWITCH=1
USE PROG
LOC=PROG-1
XPSTATE
XREFS
XBUFS
XWORDS
XPSIZE
XCHAIN
XPCOUNT
IF LOC NE NAME THEN MESSAGE <:ERROR: PROG NAME:> FI
XPNAME: XPNAME0
IF NAMELENGTH GT 1 THEN
XPNAME1
IF NAMELENGTH GT 2 THEN
XPNAME2
IF NAMELENGTH GT 3 THEN
0 REPEAT NAMELENGTH-3-1
FI FI FI
IF LOC-XPNAME NE NAMELENGTH THEN MESSAGE <:ERROR: XPNAME LENGTH:> FI
XIDENT
XSIZE
XPROGRAM
XPRPC
IF LOC NE PROGLENGTH THEN MESSAGE <:ERROR: PROG LENGTH:> FI
FI
IF XPD GT PROGLENGTH THEN
USE BASE
LOC=BASE
XSTATE
XPARENT
XNEXT
XCHILD
XSIZE
XCHAIN
XKIND
XNAME: XNAME0
IF NAMELENGTH GT 1 THEN
XNAME1
IF NAMELENGTH GT 2 THEN
XNAME2
IF NAMELENGTH GT 3 THEN
0 REPEAT NAMELENGTH-3-1
FI FI FI
IF LOC-XNAME NE NAMELENGTH THEN MESSAGE <:ERROR: XNAME LENGTH:> FI
XIDENT
XPROCIDENT
XDEBUG
IF LOC NE PROC THEN MESSAGE <:ERROR: XPROC LOCATION:> FI
0 REPEAT 7 ; REGISTERS
XCBASE
XCBASEMOD
XPROGRAM
XPRPC
XTIMER
XPSW
XOLDPROC
XLOCACTION
XLOCRETURN
XCAUSE
XDEVPR
XPRESET
0 REPEAT 12 ; TIME0 - FREEAREAS
#FFFF
XERROR
XWARNING
XTERMINATE
0 REPEAT 3 ; PRICHN - ADJUST
XREFSX
XBUFSX
IF XPD NE UTILITYLENGTH THEN
XREFS=0
XBUFS=1
FI
0 REPEAT 20 ; RESTING - SAVE19
XWRK: 0
IF CONTLENGTH GT 1 THEN
0
IF CONTLENGTH GT 2 THEN
0
IF CONTLENGTH GT 3 THEN
0
IF CONTLENGTH GT 4 THEN
0
IF CONTLENGTH GT 5 THEN
0 REPEAT CONTLENGTH-5-1
FI FI FI FI FI
IF LOC-XWRK NE CONTLENGTH THEN MESSAGE <:ERROR: XWRK LENGTH:> FI
LOC= LOC-C
IF LOC NE PROCLENGTH-C THEN MESSAGE <:ERROR: XPROC LENGTH:> FI
IF XPD GT PROCLENGTH THEN
XRESERVER
XDEVICE
XINTERRUPT
IF LOC NE DRIVERLENGTH-C THEN MESSAGE <:ERROR: XDRIVER LENGTH:> FI
IF XPD GT DRIVERLENGTH THEN
0 REPEAT 2 ; ESPECIAL - CATALOG
IF LOC NE CATALOGLENGTH-C THEN MESSAGE <:ERROR: XCATALOG LENGTH:> FI
IF XPD GT CATALOGLENGTH THEN
XACTION
XEOFACTION
XCURIN
XCUROUT
XCURWORK
XCENTRY
XWORKING
FI FI FI FI
XLOC= LOC
LIST
DEV:= 1
PR:= 0
MYBASE:= #18D0
MYPROC:= MYBASE+ITEM
BNINREADY:= 10
BNOUTREADY:= 11
; 12 ; OVERRUN
BNBREAK:= 13 ; DEVICE-FAILURE
; 14 ; PARITY
AHEADS:= 32
ASAVE= LOC*2
0 REPEAT (AHEADS-1)/2
LOC= LOC-WORK
WLINK0: 0
WLINK1: 0
WLINK2: 0
WMODE: 0
WAHEAD: 0
WLAST: 0
WANY: TRUE
WECHO: TRUE
WBREAK: FALSE
WSEARCHED: FALSE
WINPUT: FALSE
WBUSY: FALSE
LOC= LOC+WORK
WPROMPT:= LOC-WORK
PROMPT: 0
ZERO:
ATTMESS: 0
OUTUSER: <:<7>-> :>
WARROW= OUTUSER*2+1-WORK
USER: 0 REPEAT IDLENGTH-1,0
WIDENT:= USER+NAMEIDENT-WORK
SEND: 0 REPEAT IDLENGTH-1
USE PROG
; PROCEDURE SENSE DEVICE(STATUS,CHAR),(ERROR);
; SENSES THE DEVICE STATUS AND REFLECTS THE SWOPPED STATUS BACK TO
; THE DEVICE. EXTRACTS THE ACTIVE STATUS BITS. DETECTS A POSSIBLE BREAK.
; CALL: EXIT:
; R0 CHAR
; R1 STATUS
; R5 LINK UNDEFINED
; R7 WORK WORK
; LINK0+1 ERROR
; LINK+0 RETURN
BEGIN USE PROG
EXTERNAL WLINK0,WAHEAD,WBREAK,BNBREAK,BNINREADY,L157
EXTERNAL ASAVE,WLAST,AHEADS
ENTRY P10,G10,P11
USE BASE
LOC= LOC-WORK
WSAVE6: 0 ; SAVE R6
LOC= LOC+WORK
USE PROG
P11: ; SENSE DEVICE(*,*,CONTINUE):
MOV R5 WLINK0.X7 ; LINK
DEC WLINK0.X7 ; -1 =>LINK0;
P10: ; SENSE DEVICE:
MOV CUREVENT-C R0 ; CURRENT EVENT.CUR =>EVENT;
JOZ R0 A1 ; IF EVENT<>0 THEN
SUB CBASE-C R0 ;
IBN STATE. X0 BNIGNR ; IF STATE.EVENT[IGNR] THEN
JMP L157 ; GOTO DUMMY RETURN;
A1: MOV DEVICE-C R0 ; DEVICE.CUR =>DEVICE;
SIO R1 R0 ; SENSE(STATUS,DEVICE);
SWP R1 ;
CIO R1 R0 ; CONTROL(SWOP(STATUS),DEVICE);
RIO R0 R0 ; READ(CHAR,DEVICE);
XTR R0 7 ; CHAR[6:7] =>CHAR;
SLL R1 8 ; 0 =>STATUS[7:8];
XTR R1 15 ; STATUS[14:15] =>STATUS;
MOV R6 WSAVE6.X7 ; SAVE(R6);
MOV WAHEAD.X7 R6 ; AHEAD.WORK =>AHEAD;
ILO R6 AHEADS ; IF AHEAD<AHEADS
SBN R1 BNINREADY ; AND STATUS[IN READY] THEN
JMP A2 ; BEGIN
INC WAHEAD.X7 ; INCR(AHEAD.WORK);
ADD WLAST. X7 R6 ; LAST.WORK+AHEAD =>AHEAD;
IHS R6 AHEADS ; IF AHEAD>=AHEADS THEN
ADDC -AHEADS R6 ; AHEAD-AHEADS =>AHEAD;
MOVB R0 ASAVE. X6 ; CHAR =>BYTE.AHEAD.SAVE
A2: ; END;
MOV WSAVE6.X7 R6 ; RESTORE(R6);
SLO R1 1<12 ; IF STATUS[15:12]=0
IBZ R1 BNINREADY ; OR NOT STATUS[IN READY] THEN
JMP 0. X5 ; RETURN;
JON R0 G10 ; IF CHAR=0 THEN
IBNP R1 BNBREAK ; IF STATUS[BREAK] THEN
; BEGIN
CLR WAHEAD.X7 ; 0 =>AHEAD.WORK;
MOV R7 WBREAK.X7 ; TRUE =>BREAK.WORK
; END;
G10: MOV WLINK0.X7 R5 ; ERROR RETURN:
JMP 1. X5 ; GOTO ERROR.LINK0;
END ; END OF SENSE DEVICE;
; PROCEDURE TYPE CHAR(CHAR),(TIMEOUT,ERROR);
; WRITES THE CHARACTER ON THE CONSOLE.
; CALL: EXIT:
; R0 DESTROYED
; R1 DESTROYED
; R3 CHAR CHAR
; R4 DESTROYED
; R5 LINK DESTROYED
; R7 WORK WORK
; LINK0+0 TIMEOUT
; LINK0+1 ERROR
; LINK+0 RETURN
BEGIN USE PROG
EXTERNAL P10,P50,P51,P53,P61,G50,WLINK0,WLINK1,BNOUTREADY,WINPOS,WECHO
EXTERNAL WMODE,PROMPT
ENTRY P20,WPOS
USE BASE
LOC= LOC-WORK
WPOS: 0 ; POSITION ON LINE
WMAX: 80 ; MAX POSITION
WSAVE3: 0 ; SAVE CHAR
LOC= LOC+WORK
USE PROG
P20: MOV WECHO. X7 R0 ; TYPE CHAR:
JON R0 A20 ; IF NOT ECHO.WORK THEN
JMP 0. X5 ; RETURN;
A20: MOV R5 WLINK1.X7 ; SAVE(LINK);
MOV R3 WSAVE3.X7 ; SAVE(CHAR);
IEQ R3 NL ; IF CHAR=NL THEN
MOVC CR R3 ; CR =>CHAR;
IEQP R3 CR ; IF CHAR=CR THEN
; BEGIN
MOVC 8 R4 ; 8 =>LOOP;
JMP L1 ; GOTO SENSE IT
; END;
MOVC 1 R4 ; 1 =>LOOP;
MOV WPOS. X7 R0 ; POS.WORK =>POS;
JOZ R3 L11 ; IF CHAR=0 THEN
; GOTO TEST POSITION;
IEQP R3 BS ; IF CHAR=BS THEN
; BEGIN
DEC WPOS. X7 ; DECR(POS.WORK);
JON R0 L11 ; IF POS<>0 THEN
; GOTO TEST POSITION
; END;
INC WPOS. X7 ; INCR(POS.WORK);
L11: ; TEST POSITION:
MOV WSAVE3.X7 R3 ; RESTORE(CHAR);
XCH R4 R0 ; SAVE(LOOP);
MOV R6 R1 ; SAVE(R6);
JON R4 A12 ; IF POS=0 THEN
MOV WMODE. X7 R4 ; IF MODE.WORK
JOZ R4 A12 ; <>0 THEN
MOVC PROMPT R6 ; IF 0.PROMPT
JOZ 0. X6 A12 ; <>0 THEN
MOV WLINK0.X7 R4 ; IF NOT CALLED
MOVC G50 R5 ; FROM
INE R4 R5 ; TYPE TEXT THEN
JMP S5 P50 ; TYPE TEXT(PROMPT);
A12: MOV WPOS. X7 R5 ; POS.WORK =>POS;
MOV WMAX. X7 R6 ; MAX.WORK =>MAX;
SLO R6 R5 ; IF POS>MAX THEN
JMP A13 ; BEGIN
JMP S5 P53 ; TYPE NL;
JMP S6 A11 ; RE.
<: <92><0>:> ; " <92><0>" =>ADDR;
A11: JMP S5 P51 ; TYPE PROG TEXT(ADDR)
A13: ; END;
MOV R1 R6 ; RESTORE(R6);
MOV R0 R4 ; RESTORE(LOOP);
MOV R3 WSAVE3.X7 ; SAVE(CHAR);
JON R3 L1 ; IF CHAR<>0 THEN
; GOTO SENSE IT;
JMPI WLINK1.X7 ; RETURN;
L1: ; SENSE IT:
JMP S5 P10 ; SENSE DEVICE(STATUS,IRR,
; ERROR: GOTO ERROR.LINK0);
IBZP R1 BNOUTREADY ; IF NOT STATUS[OUTPUT READY] THEN
; BEGIN
JMP S5 P61 ; WAIT IT(50,
; TIMOUT: GOTO TIMOUT.LNK0);
JMP L1 ; GOTO SENSE IT
; END;
IEQ R4 7 ; IF LOOP=7 THEN
MOV WSAVE3.X7 R3 ; RESTORE(CHAR);
IEQ R4 6 ; IF LOOP=6 THEN
MOVC 0 R3 ; 0 =>CHAR;
MOV DEVICE-C R1 ;
WIO R3 R1 ; WRITE(CHAR,DEVICE.CUR);
SOB R4 L1 ; IF DECR(LOOP)<>0 THEN
; GOTO SENSE IT;
JON R3 A2 ; IF CHAR<>0 THEN
; RETURN;
MOV WSAVE3.X7 R3 ; RESTORE(CHAR);
MOV WPOS. X7 R0 ;
MODC WINPOS ; INPOS.WORK
SUB R0 0. X7 ; -POS.WORK =>INPOS.WORK;
CLR WPOS. X7 ; 0 =>POS.WORK;
A2: JMPI WLINK1.X7 ; RETURN;
END ; END OF TYPE CHAR;
; PROCEDURE TYPE IN(COUNT,CHAR,ADDR),(TIMEOUT,ERROR);
; READS A STRING OF CHARACTERS AND STORES THEM AT ADDR AND ON.
; THE VARIABLES, ADDR AND COUNT, ARE INCREMENTED AND DECREMENTED
; ACCORDINGLY. THE CHARACTERS ARE ECHOED BY MEANS OF TYPE CHAR.
; THE FOLLOWING CHARACTERS HAVE SPECIAL MEANINGS:
; LF LINE FEED: THE CHARACTER IS REPLACED BY A CR CHARACTER.
; THE TEXT, "*CR<10>", IS OUTPUT.
; CR CARRIAGE RETURN: THE CHARACTER IS REPLACED BY NL(=LF).
; READING IS TERMINATED WHEN COUNT BECOMES ZERO OR WHEN A CR CHARACTER
; IS READ.
; CALL: EXIT:
; R0 DESTROYED
; R1 DESTROYED
; R2 COUNT COUNT (UPDATED)
; R3 CHAR (LAST INPUT)
; R4 DESTROYED
; R5 LINK DESTROYED
; R6 ADDR ADDR (UPDATED)
; R7 WORK WORK
; LINK+0 TIMEOUT
; LINK+1 ERROR
; LINK+2 RETURN
BEGIN USE PROG
EXTERNAL P10,G10,P11,P20,P51,P51P52,P52,P60,P61
EXTERNAL WLINK0,WBREAK,BNINREADY,WPOS,BNOUTREADY,WAHEAD
EXTERNAL ASAVE,WLAST,AHEADS
ENTRY P30,G30,G31,WINPOS
USE BASE
LOC= LOC-WORK
WCANCEL: FALSE ; CANCEL
WSAVE3: 0 ; SAVE R3
WCOUNT: 0 ; COUNT
WADDR: 0 ; ADDR
WINPOS: 0 ; IN POSITION ON LINE
LOC= LOC+WORK
USE PROG
P30: ; TYPE IN:
MOV R5 WLINK0.X7 ; SAVE(LINK);
MOVC 0 R3 ;
JMP S5 P20 ; TYPE CHAR(0);
MOV R6 WADDR. X7 ; ADDR =>ADDR.WORK;
MOV R2 WCOUNT.X7 ; COUNT =>COUNT.WORK;
MOV WPOS. X7 R4 ; POS.WORK
MOV R4 WINPOS.X7 ; =>INPOS.WORK;
L1: ; NEXT IN:
MOV WAHEAD.X7 R5 ; AHEAD.WORK =>AHEAD;
JOZ R5 L8 ; IF AHEAD=0 THEN
; GOTO SENSE IT;
MOV WLAST. X7 R5 ; LAST.WORK =>LAST;
MOVB ASAVE. X5 R3 ; BYTE.LAST.SAVE =>CHAR;
DEC WAHEAD.X7 ; DECR(AHEAD.WORK);
INC WLAST. X7 ; INCR(LAST.WORK);
IEQ R5 AHEADS-1 ; IF LAST=AHEADS-1 THEN
CLR WLAST. X7 ; 0 =>LAST.WORK;
JMP L3 ; GOTO TEST CHAR;
; GOTO TEST CHAR;
L8: MOV WLINK0.X7 R4 ;*SENSE IT:
JMP S5 P11 ;* SENSE DEVICE(STATUS,CHAR,
MOV R4 WLINK0.X7 ;* ERROR: CONTINUE);
CLR WAHEAD.X7 ; 0 =>AHEAD.WORK;
MOV R0 R3 ;
MOV WCOUNT.X7 R0 ; IF COUNT.WORK
INE R2 R0 ; <>COUNT THEN
MODC #7F00 ; #7F00 =>DELAY
MOVC 50 R0 ; ELSE 50 =>DELAY;
IBZP R1 BNINREADY ; IF NOT STATUS[INPUT READY] THEN
; BEGIN
JMP S5 P60 ; WAIT IT(DELAY,
; TIMOUT: GOTO TIMOUT.LINK);
JMP L1 ; GOTO NEXT IN
; END;
L3: ; TEST CHAR:
MOV WBREAK.X7 R4 ; IF BREAK.WORK THEN
JON R4 L2 ; GOTO DELETE;
IEQ R3 CAN ; IF CHAR=CAN THEN
JMP L4 ; GOTO CANCEL;
INE R3 DEL ; IF CHAR<>DEL THEN
JMP L5 ; GOTO TEST CANCEL;
L2: ; DELETE:
JMP S6 A3 ; RE.
<:*DL<10><0>:> ; "*DL<10>" =>ADDR;
A3: MOV WCOUNT.X7 R5 ;
INEP R5 R2 ; IF COUNT.WORK<>COUNT THEN
; BEGIN
CLR WPOS. X7 ; 0 =>POS.WORK;
JMP S5 P51 ; TYPE PROG TEXT(ADDR)
; END;
MOV WPOS. X7 R4 ; POS.WORK
MOV R4 WINPOS.X7 ; =>INPOS.WORK;
MOV WADDR. X7 R6 ; ADDR.WORK =>ADDR;
MOV WCOUNT.X7 R2 ; COUNT.WORK =>COUNT;
MOV WBREAK.X7 R3 ; IF NOT BREAK.WORK THEN
JOZ R3 L1 ; GOTO NEXT IN;
JMP G10 ; GOTO ERROR RETURN;
L4: MOV WCOUNT.X7 R1 ; CANCEL:
IEQ R1 R2 ; IF COUNT.WORK=COUNT THEN
JMP L1 ; GOTO NEXT IN;
MOV ADJUST-C R1 ; IF ADJUST.CUR
JON R1 A41 ; <>0
IHS R2 -NAMEBYTES ; OR COUNT>=-NAMEBYTES THEN
A41: ADDC -1 R6 ; DECR(ADDR);
MOV R6 R1 ; SAVE(ADDR);
MON GETBYTE ; GET BYTE(ADDR,CHAR);;
SNE R3 BS ; IF CHAR<>BS THEN
JMP A42 ; BEGIN
JMP S6 A4 ; RE.
<:<8>X<8><0>:> ; "<BS>X<BS>" =>ADDR;
A4: MODC P51P52 ; TYPE PROG TEXT(ADDR)
A42: ; END
JMP S5 P52 ; ELSE TYPE SPACE;
MOV R1 R6 ; RESTORE(ADDR);
MOV R7 WCANCL.X7 ; TRUE =>CANCEL.WORK;
ADDC 1 R2 ; INCR(COUNT);
JMP L1 ; GOTO NEXT IN;
L5: ; TEST CANCEL:
MOV WCANCL.X7 R1 ; CANCEL.WORK =>CANCEL;
JOZ R1 L6 ; IF NOT CANCEL THEN
; GOTO ECHO IT;
MOV R3 WSAVE3.X7 ; SAVE(CHAR);
MOVC LF R3 ;
MOV DEVICE-C R1 ;
WIO R3 R1 ; WRITE(LF,DEVICE.CUR);
MOV WSAVE3.X7 R3 ; RESTORE(CHAR);
CLR WCANCL.X7 ; FALSE =>CANCEL.WORK;
L6: MOV WINPOS.X7 R1 ; ECHO IT:
MOV WPOS. X7 R5 ;
IEQP R3 BS ; IF CHAR=BS THEN
IGE R1 R5 ; IF POS.WORK<=INPOS.WORK THEN
JMP L1 ; GOTO NEXT IN;
SEQ R3 LF ; IF CHAR=LF THEN
JMP A51 ; BEGIN
MOV R6 R1 ; SAVE(ADDR);
CLR WPOS. X7 ; 0 =>POS.WORK;
JMP S6 A5 ; RE.
<:*CR<10><0>:> ; "*CR<10>" =>ADDR;
A5: JMP S5 P51 ; TYPE PROG TEXT(ADDR);
CLR WINPOS.X7 ; 0 =>INPOS.WORK;
MOV R1 R6 ; RESTORE(ADDR);
MOVC CR R3 ; CR =>CHAR;
JMP L7 ; GOTO PUT IT
A51: ; END;
IEQ R3 CR ; IF CHAR=CR THEN
MOVC NL R3 ; NL =>CHAR;
JMP S5 P20 ; TYPE CHAR(CHAR,
; TIMEOUT: GOTO TIMEOUT.LINK,
; ERROR: GOTO ERROR.LINK);
L7: ; PUT IT:
MOV ADJUST-C R0 ; IF ADJUST.CUR
JON R0 A7 ; =0 THEN
MOV WADDR. X7 R0 ; IF ADDR.CUR
SUB R6 R0 ; -ADDR
IEQP R0 -NAMEBYTES ; <-NAMEBYTES THEN
INE R3 NL ; IF CHAR<>NL THEN
ADDC -1 R6 ; DECR(ADDR);
A7: MON PUTBYTE ; PUT BYTE(ADDR,CHAR);
ADDC 1 R6 ; INCR(ADDR);
SEQ R3 EM ; IF CHAR=EM
IEQ R3 NL ; OR CHAR=NL THEN
JMP G31 ; GOTO COUNT RETURN;
SOB R2 L1 ; IF DECR(COUNT)<>0 THEN
; GOTO NEXT IN;
JMP G30 ; GOTO TYPE RETURN;
G31: ; COUNT RETURN:
ADDC -1 R2 ; DECR(COUNT);
G30: ; TYPE RETURN:
JMP S5 P10 ; SENSE DEVICE(STATUS,IRR,
; ERROR: GOTO ERROR.LINK0);
IBZ R1 BNOUTREADY ; IF NOT STATUS[OUTPUT READY] THEN
JMP S5 P61 ; WAIT IT(50,
; TIMEOUT: GOTO TIMEOUT.LINK);
MOV WLINK0.X7 R5 ;
JMP 2 .X5 ; RETURN(LINK);
END ; END OF TYPE IN;
; PROCEDURE TYPE OUT(COUNT,CHAR,ADDR),(TIMEOUT,ERROR);
; WRITES A STRING OF CHARACTERS FROM ADDR AND ON. THE VARIABLES,
; ADDR AND COUNT, ARE INCREMENTED AND DECREMENTED ACCORDINGLY. THE
; CHARACTERS ARE WRITTEN BY MEANS OF TYPE CHAR.
; CALL: EXIT:
; R0 DESTROYED
; R1 DESTROYED
; R2 COUNT COUNT (UPDATED)
; R3 CHAR (LAST OUTPUT)
; R4 DESTROYED
; R5 LINK DESTROYED
; R6 ADDR ADDR (UPDATED)
; R7 WORK WORK
; LINK+0 TIMEOUT
; LINK+1 ERROR
; LINK+2 RETURN
BEGIN USE PROG
EXTERNAL P20,G30,G31,WLINK0
ENTRY P40
P40: ; TYPE OUT:
MOV R5 WLINK0.X7 ;* SAVE(LINK);
L1: ; NEXT OUT:
MON GETBYTE ; GET BYTE(ADDR,CHAR);
JMP S5 P20 ; TYPE CHAR(CHAR,
; TIMEOUT: GOTO TIMEOUT.LINK,
; ERROR: GOTO ERROR.LINK);
ADDC 1 R6 ; INCR(ADDR);
JOZ R3 G31 ; IF CHAR=0 THEN
; GOTO COUNT RETURN;
SOB R2 L1 ; IF DECR(COUNT)<>0 THEN
; GOTO NEXT OUT;
JMP G30 ; GOTO TYPE RETURN;
END ; END OF TYPE OUT;
; PROCEDURE TYPE NL;
; TYPES A NL CHARACTER, USING TYPE PROG TEXT.
; CALL: EXIT:
; R4 DESTROYED
; R5 LINK DESTROYED
; R6 DESTROYED
; R7 WORK WORK
BEGIN USE PROG
EXTERNAL P51
ENTRY P53
P53: ; TYPE NL:
JMP S6 P51 ; RE."<10>" =>ADDR;
<:<10><0>:> ; GOTO TYPE PROG TEXT;
END ; END OF TYPE NL;
; PROCEDURE TYPE SPACE;
; TYPES A SPACE, USING TYPE PROG TEXT.
; CALL: EXIT:
; R4 DESTROYED
; R5 LINK DESTROYED
; R6 DESTROYED
; R7 WORK WORK
BEGIN USE PROG
EXTERNAL P51
ENTRY P52
P52: ; TYPE SPACE:
JMP S6 P51 ; RE." " =>ADDR;
<: <0>:> ; GOTO TYPE PROG TEXT;
END ; END OF TYPE SPACE;
; PROCEDURE TYPE PROG TEXT(ADDR);
; ADDR IS CHANGED FROM BEING A PROG-RELATIVE WORD-ADDRESS TO A
; BASE-RELATIVE WORD-ADDRESS. THE PROCEDURE CONTINUES WITH TYPE TEXT.
; CALL: EXIT:
; R4 DESTROYED
; R5 LINK DESTROYED
; R6 ADDR ADDR (CHANGED AND UPDATED)
; R7 WORK WORK
BEGIN USE PROG
EXTERNAL
ENTRY P51
P51: ; TYPE PROG TEXT:
MOD PROGRAM-C ; PROGRAM.CUR
MODN CBASE-C ; -BASE.CUR ORELSE
;* CONTINUE WITH TYPE TEXT;
END ; END OF TYPE PROG TEXT;
P51P52:=P51-P52
; PROCEDURE TYPE TEXT(ADDR);
; ADDR IS CHANGED FROM BEING A WORD-ADDRESS TO A BYTE-ADDRESS. THE
; PROCEDURE TYPES THE TEXT BY MEANS OF TYPE OUT.
; CALL: EXIT:
; R4 DESTROYED
; R5 LINK DESTROYED
; R6 ADDR ADDR (CHANGED AND UPDATED)
; R7 WORK WORK
BEGIN USE PROG
EXTERNAL G4,P40,WLINK0,WLINK2
ENTRY P50,G50
USE BASE
LOC= LOC-WORK
WSAVEA: 0 ; SAVE ADJUST
WSAVEL: 0 ; SAVE LINK0
0 ; SAVE LINK1
WSAVE0: 0 ; SAVE R0
0 ; SAVE R1
WSAVE2: 0 ; SAVE R2
0 ; SAVE R3
LOC= LOC+WORK
USE PROG
P50: ; TYPE TEXT:
MOVC 0 R4 ;* 0 =>ADJUST;
MOV R5 WLINK2.X7 ; SAVE(LINK);
MOVL R01 WSAVE0.X77 ; SAVE(R0,R1);
MOVL R23 WSAVE2.X77 ; SAVE(R2,R3);
MOVL WLINK0.X77 R01 ; SAVE(LINK0,
MOVL R01 WSAVEL.X77 ; ,LINK1);
MOV ADJUST-C R0 ;
MOV R0 WSAVEA.X7 ; SAVE(ADJUST.CUR);
MOV R4 ADJUST-C ; ADJUST =>ADJUST.CUR;
MOVC 100 R2 ; 100 =>COUNT;
ADD R6 R6 ; ADDR+ADDR =>ADDR;
JMP S5 P40 ; TYPE OUT(COUNT,IRR,ADDR,
G50: JMP G4 ; TIMEOUT: GOTO BREAK,
JMP G4 ; ERROR: GOTO BREAK);
MOV WSAVEA.X7 R0 ;
MOV R0 ADJUST-C ; RESTORE(ADJUST.CUR);
MOVL WSAVEL.X77 R01 ; RESTORE(LINK0,
MOVL R01 WLINK0.X77 ; LINK1);
MOVL WSAVE2.X77 R23 ; RESTORE(R2,R3);
MOVL WSAVE0.X77 R01 ; RESTORE(R0,R1);
JMPI WLINK2.X7 ; RETURN;
END ; END OF TYPE TEXT;
; PROCEDURE WAIT IT(DELAY),(TIMEOUT);
; CALL: EXIT:
; R0 DELAY COUNT
; R1 INTERRUPT.CUR
; R5 LINK UNDEFINED
; R7 WORK WORK
BEGIN USE PROG
EXTERNAL WLINK0
ENTRY P60,P61
P61: ; WAIT IT(50,*):
MOVC 50 R0 ; 50 =>DELAY;
P60: ; WAIT IT:
MOV INTERRUPT-C R1 ; INTERRUPT.CUR =>INTRPT;
MON WAITINTERRUPT ; WAIT INTERRUPT(DELAY,INTRPT,
JMPI WLINK0.X7 ; TIMEOUT: GOTO TIMEOUT.LINK0,
JMP 0. X5 ; INTERRUPT: RETURN);
END ; END OF WAIT IT;
; REGISTER USE IN THE DRIVER:
; R0 DESTROYED
; R1 DESTROYED
; R2 COUNT
; R3 CHAR
; R4 LOOP.TYPE CHAR
; R5 LINKS
; R6 ADDR
; R7 WORK
L0: ; INIT:
MON INITDEVICE ; INIT DEVICE(INTERRUPT,DEVICE);
L1: ; ANY USER:
MOVL WSEARD.X77 R01 ; SEARCHED.WORK =>SEARCHED;
MOV R7 WSEARD.X7 ; TRUE =>SEARCHED.WORK;
JOZ R0 L111 ; IF NOT SEARCHED
JON R1 L111 ; OR INPUT.WORK THEN
; GOTO INIT QUEUE;
MOV WBUSY. X7 R0 ;
JOZ R0 A1 ; IF BUSY.WORK THEN
JMP L171 ; GOTO BUSY;
A1: MOV FIRSTEVENT-C R0 ; IF FIRST EVENT.CUR=0 THEN
JOZ R0 L10 ; GOTO READY;
MOV R7 WANY. X7 ; TRUE =>ANY.WORK;
L10: ; READY:
JMP S5 P11 ;* SENSE DEVICE(STATUS,IRR,
;* ERROR: CONTINUE);
MOV INTERRUPT-C R1 ; INTERRUPT.CUR =>INTRPT;
MON CLEARINTERRUPT ; CLEAR INTERRUPT(INTRPT,IRR);
L11: ; INSPECT QUEUE:
CLR WSEARD.X7 ; FALSE =>SEARCHED.WORK;
L111: ; INIT QUEUE:
CLR WINPUT.X7 ; FALSE =>INPUT.WORK;
MON INITWAIT ; INIT WAIT;
L12: MOV WBREAK.X7 R0 ; NEXT EVENT:
JOZ R0 A12 ; IF BREAK.WORK THEN
JMP G4 ; GOTO BREAK;
A12: MOVC 10 R0 ;
MON SETDELAY ; SET DELAY(10);
MOV INTERRUPT-C R1 ; INTERRUPT.CUR =>INTRPT;
MON SETINTERRUPT ; SET INTERRUPT(INTRPT);
MON WAITNEXT ; WAIT NEXT(EVENT,
JMP L1 ; TIME OUT: GOTO ANY USER,
TRP 0 ; ANSWER: IMPOSSIBLE,
JMP L13 ; MESSAGE: GOTO MESSAGE,
; INTERRUPT: CONTINUE);
JMP S5 P11 ;* SENSE DEVICE(STATUS,IRR,
;* ERROR: CONTINUE);
JMP L12 ; GOTO NEXT EVENT;
L13: ; MESSAGE:
MOV MCOUNT.X7 R2 ; COUNT.MESS =>COUNT;
IBN MOPERN.X7 BNTPUT ; IF OPER.MESS[TRANSPUT] THEN
JMP L14 ; GOTO TRANSPUT;
; CONTROL:
IBNP MOPERN.X7 BNRESERVE ; IF OPER.MESS[RESERVE] THEN
MOVC ITEM +KIND R5 ; COUNT
SUB 0. X5 R2 ; -KIND.CUR =>COUNT;
A15: JMP L15 ; GOTO DONE;
L14: ; TRANSPUT:
JOZ R2 A15 ; IF COUNT=0 THEN
; GOTO DONE;
MOVC SEND R0 ;
MON GETEVENTNAME ; GET EVENT NAME(SEND);
MOVC USER R1 ;
MON COMPARENAMES ; COMPARE NAMES(SEND,USER,
JMP L16 ; UNEQUAL: NOT USER);
CLR WBUSY. X7 ; FALSE =>BUSY.WORK;
MOV WSEARD.X7 R0 ;
JON R0 A14 ; IF NOT SEARCHED.WORK
SBZ MOPERN.X7 BNOPUT ; IF NOT OPER.MESS[OUTPUT] THEN
JMP A14 ; BEGIN
MOV R7 WINPUT.X7 ; TRUE =>INPUT.WORK;
MON RESUMEEVENT ; RESUME EVENT;
JMP L12 ; GOTO NEXT EVENT
A14: ; END;
MOV MCOUNT.X7 R2 ; COUNT.MESS =>COUNT;
MON GETADDRESS ; GET ADDRESS(COUNT,ADDR,
JMP L158 ; ILLEGAL: GOTO ILLEGAL);
MOV WPROMT.X7 R1 ; PROMPT.WORK =>OLD;
MOV WMODE. X7 R0 ; IF MODE.WORK<>0 THEN
JOZ R0 A141 ; BEGIN
IBN MOPERN.X7 BNOPUT ; IF OPER.MESS[OUTPUT] THEN
MODC <: :> -<:. :> ; " " =>HEAD
MOVC <:. :> R0 ; ELSE ". " =>HEAD;
MOV R0 WPROMT.X7 ; HEAD =>PROMPT.WORK;
JOZ R1 A141 ; IF OLD<>0 THEN
SNE R1 R0 ; IF OLD<>HEAD THEN
JMP A141 ; BEGIN
MOV R6 R1 ; SAVE(ADDR);
MOV WPOS. X7 R0 ; POS.WORK =>POS;
IEQP R0 2 ; IF POS=2 THEN
JMP S5 P53 ; TYPE NL;
MOV R1 R6 ; RESTORE(ADDR)
; END
A141: ; END;
IBN MOPERN.X7 BNNOEC ; IF OPER.MESS[NO ECHO] THEN
CLR WECHO. X7 ; FALSE =>ECHO.WORK;
IBN MOPERN.X7 BNOPUT ;* IF OPER.MESS[OUTPUT] THEN
MODC -P30 +P40 ;* TYPE OUT(COUNT,IRR,ADDR,
;* TIMEOUT: GOTO TIMER,
;* ERROR: GOTO ERROR)
JMP S5 P30 ;* ELSE TYPE IN(COUNT,IRR,ADDR,
;* TIMEOUT: GOTO TIMER,
;* ERROR: GOTO ERROR);
;* GOTO DONE;
;*TIMER:
MODC BMTIMER -BMERROR ;* TIMER ORELSE
;*ERROR:
MODC BMERROR -0 ;* ERROR ORELSE
L15: ;*DONE:
MODC 0 -BMILLEGAL ;* 0 ORELSE
L158: ; ILLEGAL:
MOVC BMILLEGAL ARESUT.X7 ; ILLEGAL =>RESULT.ANSWER;
JMP S5 P11 ;* SENSE DEVICE(STATUS,IRR,
;* ERROR: CONTINUE);
L157: ; DUMMY RETURN:
MON RETURNANSWER ; RETURN ANSWER(STATUS,COUNT);
MOV R7 WECHO. X7 ; TRUE =>ECHO.WORK;
JMP L10 ; GOTO READY;
G4: MOVC 10 R0 ; BREAK:
MON WAITDELAY ; WAIT DELAY(10);
CLR WBREAK.X7 ; FALSE =>BREAK.WORK;
JMP S5 P11 ;* SENSE DEVICE(STATUS,
;* ERROR: CONTINUE);
MOV WBREAK.X7 R0 ; IF BREAK.WORK THEN
JON R0 G4 ; GOTO BREAK;
JMP S5 P53 ; TYPE NL;
CLR USER -WORK .X7 ; 0 =>0.USER;
CLR PROMPT -WORK. X7 ; 0 =>0.PROMPT;
MOVC <:=:> R0 ; "="
MOVB R0 WARROW.X7 ; =>ARROW.WORK;
MOVC OUTUSER R6 ; RE.OUTUSER =>ADDR;
JMP S5 P50 ; TYPE TEXT(ADDR);
CLR ADJUST-C -WORK. X7 ; 0 =>ADJUST.CUR;
MOVC USER*2 R6 ; RE.USER =>ADDR;
L41: ; IN NAME:
MOVC 0 R2 ; 0 =>COUNT;
JMP S5 P30 ; TYPE IN(COUNT,CHAR,ADDR,
JMP L41 ; TIMEOUT: GOTO IN NAME,
JMP G4 ; ERROR: GOTO BREAK);
CLR WAHEAD.X7 ; 0 =>AHEAD.WORK;
ADDC -1 R6 ; DECR(ADDR);
MOVC USER*2+NAMEBYTES+1R2 ; RE.USER+NAMEBYTES+1
SUB R6 R2 ; -ADDR =>COUNT;
MOVC 0 R3 ; 0 =>CHAR;
L6: ; INSERT ZERO:
MOVB R3 BYTE. X6 ; CHAR =>BYTE.ADDR;
ADDC 1 R6 ; INCR(ADDR);
SOB R2 L6 ; IF DECR(COUNT)<>0 THEN
; GOTO INSERT ZERO;
CLR WIDENT.X7 ; 0 =>IDENT.WORK;
MOVC USER R0 ;
MON SEARCHPROCESS ; SEARCH PROCESS(USER,
JMP L9 ; NOT FOUND: GOTO UNKNOWN);
CLR WANY. X7 ; FALSE =>ANY.WORK;
MOD CBASE-C ;
INE R1 ITEM ; IF PROC<>ITEM.BASE.CUR THEN
JMP L18 ; GOTO ATTENTION;
JMP S6 A6 ; RE.
<:.:<0>:> ; ".:" =>ADDR;
A6: JMP S5 P51 ; TYPE PROG TEXT(ADDR);
L61: ; IN MODE:
MOVC 1 R2 ; 1 =>COUNT;
MOVC USER*2 R6 ; RE.USER =>ADDR;
JMP S5 P30 ; TYPE IN(COUNT,CHAR,ADDR,
JMP L61 ; TIMEOUT: GOTO IN MODE,
JMP G4 ; ERROR: GOTO BREAK);
ADDC -<:0:> R3 ; CHAR-"0"
MOV R3 WMODE. X7 ; =>MODE.WORK;
JMP S5 P53 ; TYPE NL;
JMP L10 ; GOTO READY;
L18: MOVC USER R0 ; ATTENTION:
MOVC ATTMESS R1 ; ATTMESS =>MESS;
MON SENDMESSAGE ; SEND MESSAGE(USER,MESS,EVENT);
MOVC 50 R0 ;
MON SETDELAY ; SET DELAY(50);
MON WAITANSWER ; WAIT ANSWER(EVENT,
MON REGRETMESSAGE ; TIMEOUT: REGRET MESS(EVENT));
MOV R7 WBUSY. X7 ; TRUE =>BUSY.WORK;
JMP L10 ; GOTO READY;
L171: ; BUSY:
CLR WBUSY. X7 ; FALSE =>BUSY.WORK;
JMP S6 L20 ; RE."BUSY" =>ADDR;
<:BUSY<0>:> ; GOTO TYPE OWN TEXT;
L16: ; NOT USER:
MOV EVENTSTATUS-C R2 ; EVENT STATUS.CUR =>STATE;
MON RESUMEEVENT ; RESUME EVENT;
MOV WANY. X7 R5 ;
ILO R2 #100 ; IF PRIORITY.STATE=0 THEN
JOZ R5 L12 ; IF NOT ANY.WORK THEN
; GOTO NEXT EVENT;
MOV WBUSY. X7 R2 ; IF BUSY.WORK THEN
JON R2 L171 ; GOTO BUSY;
MOVC USER R1 ;
MODC IDLENGTH ; IDLENGTH =>LENGTH;
MOVM X0 X1 ; MOVEMULT(LENGTH,SEND,USER);
CLR WANY. X7 ; FALSE =>ANY.WORK;
JMP S5 P53 ; TYPE NL;
MOVC <:-:> R0 ; "-"
MOVB R0 WARROW.X7 ; =>ARROW.WORK;
MOVC OUTUSER R6 ; RE.OUTUSER =>ADDR;
MODC P50 -P51 ; TYPE TEXT(ADDR) ORELSE
L20: ; TYPE OWN TEXT:
JMP S5 P51 ; TYPE PROG TEXT(ADDR);
JMP S5 P53 ; TYPE NL;
JMP L10 ; GOTO READY;
L9: ; UNKNOWN:
JMP S6 L20 ; RE."UNKNOWN" =>ADDR;
<:UNKNOWN<0>:> ; GOTO TYPE OWN TEXT;
USE BASE
XNAME0= <:OC:>
XKIND= KINDOC OR BMBYTE OR BMDISP
XPRPC= L0
XDEVPR= DEV<2+PR
XREFS= 8
XBUFS= 1
NOLIST
; CR80 SYSTEM ONE
; MONITOR
; MASTER: XPD - PROCESS DESCRIPTION (PART 2)
IF XPD EQ UTILITYLENGTH OR XPD EQ PROGLENGTH THEN
USE PROG
XPSTATE= BMREENTRANT
XREFS= 0
XBUFS= 1
XWORDS= 0
XPSIZE= LOC
XCHAIN= 0
XPCOUNT= 1
XPNAME0= 0
XPNAME1= 0
XPNAME2= 0
XIDENT= 0
XPRPC= PROGLENGTH
FI
USE BASE
IF XPD GT PROGLENGTH THEN
XLOC= LOC-XLOC-C
XSTATE= 0
XPARENT= 0
XNEXT= 0
XCHILD= 0
XCHAIN= 0
XKIND= 0
XNAME0= 0
XNAME1= 0
XNAME2= 0
XIDENT= 0
XPROCIDENT= 0
XDEBUG= 0
XCBASE= 0
XCBASEMOD= 0
XPRPC= 0
XTIMER= 100
XPSW= 0
XOLDPROC= 0
XLOCACTION= LOCACT
XLOCRETURN= 0
XCAUSE= 0
XDEVPR= 0
XPRESET= 100
XERROR= 0
XWARNING= 0
XTERMINATE= 0
XRESERVER= 0
XDEVICE= 0
XINTERRUPT= 0
XACTION= LOCACT
XEOFACTION= LOCACT
IF XPD GT CURSIN THEN
IF LOC NE CURSIN+XLOC THEN MESSAGE <:ERROR: XCURSIN LENGTH:> FI
XCURIN= LOC
BEGIN USE BASE
XSHARE:
XSNAME: XSNAME0
IF NAMELENGTH GT 1 THEN
XSNAME1
IF NAMELENGTH GT 2 THEN
XSNAME2
IF NAMELENGTH GT 3 THEN
0 REPEAT NAMELENGTH-3-1
FI FI FI
IF LOC-XSNAME NE NAMELENGTH THEN MESSAGE <:ERROR: XSNAME LENGTH:> FI
XSIDENT
0 ; SPROCIDENT
XSMODE
XSKIND
0 REPEAT 6 ; SMASK - SFILE
XSFIRST
XSTOP
XSREM
XSBUFSIZE
XSUSED
XSSID: 0
IF IDLENGTH GT 1 THEN
0
IF IDLENGTH GT 2 THEN
0
IF IDLENGTH GT 3 THEN
0 REPEAT IDLENGTH-3-1
FI FI FI
IF LOC-XSSID NE IDLENGTH THEN MESSAGE <:ERROR: XSSID LENGTH:> FI
0
IF LOC-XSSID NE STACKLENGTH THEN MESSAGE <:ERROR: STACK LENGTH:> FI
0 REPEAT 9 ; SSAVE0 - SSAVE9
IF LOC-XSHARE NE SHARELENGTH THEN MESSAGE <:ERROR: XSHARE LENGTH:> FI
XSBUFFERS= 1
XSNAME0= <:OC:>
XSMODE= BMINPUT OR BMBYTE
XSKIND= KINDOC OR BMBYTE OR BMDISP
XSBUFSIZE= 128
XSBUFFERS= 2
IF XSMODE>BNBYTE THEN XSFACTOR=2
IF XSBUFSIZE THEN XSFILL=1
ELSE XSFILL=0
FI
ELSE XSFACTOR=1
XSFILL=0
FI
XSNAME0= 0
XSNAME1= 0
XSNAME2= 0
XSIDENT= 0
XSFIRST= (LOC+XSBUFFERS*BUFFERLENGTH)*XSFACTOR
XSTOP= XSFIRST
IF XSMODE>BNOPUT THEN XSREM= XSBUFSIZE
ELSE XSREM= 0
FI
XSUSED= LOC
XSBUFFER= XSBUFFERS*(XSBUFSIZE+XSFILL)
XSBUFAREA= (XSUSED+XSBUFFERS*BUFFERLENGTH)*XSFACTOR
IF XSBUFFERS GT 0 THEN
0 REPEAT BFIRST-1
XSBUFAREA, XSBUFAREA=XSBUFAREA+XSBUFSIZE+XSFILL
IF XSBUFFERS GT 1 THEN
LOC-BNEXT+BUFFERLENGTH
ELSE XSUSED
FI
XSBUFFERS=XSBUFFERS-1
FI
IF XSBUFFERS GT 0 THEN
0 REPEAT BFIRST-1
XSBUFAREA, XSBUFAREA=XSBUFAREA+XSBUFSIZE+XSFILL
IF XSBUFFERS GT 1 THEN
LOC-BNEXT+BUFFERLENGTH
ELSE XSUSED
FI
XSBUFFERS=XSBUFFERS-1
FI
IF XSMODE>BNBYTE AN (NT XSKIND>BNBYTE) AN XSBUFAREA>15 THEN
MESSAGE <:ADDR TOO BIG:>
FI
IF XSBUFFER GT 0 THEN
0 REPEAT (XSBUFFER-1)/XSFACTOR
FI
END
IF XPD GT CURSOUT THEN
IF LOC NE CURSOUT+XLOC THEN MESSAGE <:ERROR: XCURSOUT LENGTH:> FI
XCUROUT= LOC
BEGIN USE BASE
XSHARE:
XSNAME: XSNAME0
IF NAMELENGTH GT 1 THEN
XSNAME1
IF NAMELENGTH GT 2 THEN
XSNAME2
IF NAMELENGTH GT 3 THEN
0 REPEAT NAMELENGTH-3-1
FI FI FI
IF LOC-XSNAME NE NAMELENGTH THEN MESSAGE <:ERROR: XSNAME LENGTH:> FI
XSIDENT
0 ; SPROCIDENT
XSMODE
XSKIND
0 REPEAT 6 ; SMASK - SFILE
XSFIRST
XSTOP
XSREM
XSBUFSIZE
XSUSED
XSSID: 0
IF IDLENGTH GT 1 THEN
0
IF IDLENGTH GT 2 THEN
0
IF IDLENGTH GT 3 THEN
0 REPEAT IDLENGTH-3-1
FI FI FI
IF LOC-XSSID NE IDLENGTH THEN MESSAGE <:ERROR: XSSID LENGTH:> FI
0
IF LOC-XSSID NE STACKLENGTH THEN MESSAGE <:ERROR: STACK LENGTH:> FI
0 REPEAT 9 ; SSAVE0 - SSAVE9
IF LOC-XSHARE NE SHARELENGTH THEN MESSAGE <:ERROR: XSHARE LENGTH:> FI
XSBUFFERS= 1
XSNAME0= <:OC:>
XSMODE= BMOUTPUT OR BMBYTE
XSKIND= KINDOC OR BMBYTE OR BMDISP
XSBUFSIZE= 128
XSBUFFERS= 2
IF XSMODE>BNBYTE THEN XSFACTOR=2
IF XSBUFSIZE THEN XSFILL=1
ELSE XSFILL=0
FI
ELSE XSFACTOR=1
XSFILL=0
FI
XSNAME0= 0
XSNAME1= 0
XSNAME2= 0
XSIDENT= 0
XSFIRST= (LOC+XSBUFFERS*BUFFERLENGTH)*XSFACTOR
XSTOP= XSFIRST
IF XSMODE>BNOPUT THEN XSREM= XSBUFSIZE
ELSE XSREM= 0
FI
XSUSED= LOC
XSBUFFER= XSBUFFERS*(XSBUFSIZE+XSFILL)
XSBUFAREA= (XSUSED+XSBUFFERS*BUFFERLENGTH)*XSFACTOR
IF XSBUFFERS GT 0 THEN
0 REPEAT BFIRST-1
XSBUFAREA, XSBUFAREA=XSBUFAREA+XSBUFSIZE+XSFILL
IF XSBUFFERS GT 1 THEN
LOC-BNEXT+BUFFERLENGTH
ELSE XSUSED
FI
XSBUFFERS=XSBUFFERS-1
FI
IF XSBUFFERS GT 0 THEN
0 REPEAT BFIRST-1
XSBUFAREA, XSBUFAREA=XSBUFAREA+XSBUFSIZE+XSFILL
IF XSBUFFERS GT 1 THEN
LOC-BNEXT+BUFFERLENGTH
ELSE XSUSED
FI
XSBUFFERS=XSBUFFERS-1
FI
IF XSMODE>BNBYTE AN (NT XSKIND>BNBYTE) AN XSBUFAREA>15 THEN
MESSAGE <:ADDR TOO BIG:>
FI
IF XSBUFFER GT 0 THEN
0 REPEAT (XSBUFFER-1)/XSFACTOR
FI
END
IF XPD GT CURSWORK THEN
IF LOC NE CURSWORK+XLOC THEN MESSAGE <:ERROR: XCURSWORK LENGTH:> FI
XCURWRK= LOC
BEGIN USE BASE
XSHARE:
XSNAME: XSNAME0
IF NAMELENGTH GT 1 THEN
XSNAME1
IF NAMELENGTH GT 2 THEN
XSNAME2
IF NAMELENGTH GT 3 THEN
0 REPEAT NAMELENGTH-3-1
FI FI FI
IF LOC-XSNAME NE NAMELENGTH THEN MESSAGE <:ERROR: XSNAME LENGTH:> FI
XSIDENT
0 ; SPROCIDENT
XSMODE
XSKIND
0 REPEAT 6 ; SMASK - SFILE
XSFIRST
XSTOP
XSREM
XSBUFSIZE
XSUSED
XSSID: 0
IF IDLENGTH GT 1 THEN
0
IF IDLENGTH GT 2 THEN
0
IF IDLENGTH GT 3 THEN
0 REPEAT IDLENGTH-3-1
FI FI FI
IF LOC-XSSID NE IDLENGTH THEN MESSAGE <:ERROR: XSSID LENGTH:> FI
0
IF LOC-XSSID NE STACKLENGTH THEN MESSAGE <:ERROR: STACK LENGTH:> FI
0 REPEAT 9 ; SSAVE0 - SSAVE9
IF LOC-XSHARE NE SHARELENGTH THEN MESSAGE <:ERROR: XSHARE LENGTH:> FI
XSBUFFERS= 1
XSMODE= BMWORD
XSKIND= BMWORD
XSBUFSIZE= 64
XSBUFFERS= 2
IF XSMODE>BNBYTE THEN XSFACTOR=2
IF XSBUFSIZE THEN XSFILL=1
ELSE XSFILL=0
FI
ELSE XSFACTOR=1
XSFILL=0
FI
XSNAME0= 0
XSNAME1= 0
XSNAME2= 0
XSIDENT= 0
XSFIRST= (LOC+XSBUFFERS*BUFFERLENGTH)*XSFACTOR
XSTOP= XSFIRST
IF XSMODE>BNOPUT THEN XSREM= XSBUFSIZE
ELSE XSREM= 0
FI
XSUSED= LOC
XSBUFFER= XSBUFFERS*(XSBUFSIZE+XSFILL)
XSBUFAREA= (XSUSED+XSBUFFERS*BUFFERLENGTH)*XSFACTOR
IF XSBUFFERS GT 0 THEN
0 REPEAT BFIRST-1
XSBUFAREA, XSBUFAREA=XSBUFAREA+XSBUFSIZE+XSFILL
IF XSBUFFERS GT 1 THEN
LOC-BNEXT+BUFFERLENGTH
ELSE XSUSED
FI
XSBUFFERS=XSBUFFERS-1
FI
IF XSBUFFERS GT 0 THEN
0 REPEAT BFIRST-1
XSBUFAREA, XSBUFAREA=XSBUFAREA+XSBUFSIZE+XSFILL
IF XSBUFFERS GT 1 THEN
LOC-BNEXT+BUFFERLENGTH
ELSE XSUSED
FI
XSBUFFERS=XSBUFFERS-1
FI
IF XSMODE>BNBYTE AN (NT XSKIND>BNBYTE) AN XSBUFAREA>15 THEN
MESSAGE <:ADDR TOO BIG:>
FI
IF XSBUFFER GT 0 THEN
0 REPEAT (XSBUFFER-1)/XSFACTOR
FI
END
IF XPD GT ENTRYAREA THEN
IF LOC NE ENTRYAREA+XLOC THEN MESSAGE <:ERROR: XENTRYAREA LENGTH:> FI
XCENTRY= LOC
0 REPEAT ENTRYLENGTH-1
IF XPD GT WORKAREA THEN
IF LOC NE WORKAREA+XLOC THEN MESSAGE <:ERROR: XWORKAREA LENGTH:> FI
XWORKING= LOC
0 REPEAT WORKLENGTH-1
IF LOC NE UTILITYLENGTH+XLOC THEN MESSAGE <:ERROR: XUTILITY LENGTH:> FI
FI FI FI FI FI
XCURIN= 0
XCUROUT= 0
XCURWORK= 0
XCENTRY= 0
XWORKING= 0
IF XREFS EQ 0 THEN XREFSX=0
ELSE XREFSX:
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
XREFS=XREFS-1
IF XREFS EQ 0 THEN
0 REPEAT REFLENGTH-1
ELSE
0,0,LOC+REFLENGTH-NEXT,0 REPEAT REFLENGTH-4
FI FI FI FI FI FI FI FI FI FI FI
IF XBUFS EQ 0 THEN XBUFSX=0
ELSE XBUFSX:
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
XBUFS=XBUFS-1
IF XBUFS EQ 0 THEN
0 REPEAT BUFLENGTH-1
ELSE
0,0,LOC+BUFLENGTH-NEXT,0 REPEAT BUFLENGTH-4
FI FI FI FI FI FI FI FI FI FI FI
FI
XSIZE= LOC-ITEM
XPROGRAM= LOC
USE PROG
IF LOC+XSIZE NE WORDS THEN MESSAGE <:ERROR: LOC+XSIZE<>WORDS:> FI
IF XPD NE PROGLENGTH THEN
USE BASE
FI
LIST
END ; END OF MODULE: DOC;
#
«nul»