


                   /ISYS: INTERDATA 70 OPERATING SYSTEM
                   /DEPARTMENT OF COMPUTER SCIENCE
                   /EDINBURGH UNIVERSITY

                   $BEGIN

                   $DEF FSLR=X'88', FSLT=X'98'

                   /ASCII CHARACTERS
                   $DEFINE STX=2, EOT=4, ENQ=5, LF=10, NL=10
                   $DEF FF=12, RT=13
                   $DEF ESC=27, ERASE=127

                   /USER STATUS (PSW)
                   $DEF USR=X'4000'

                   /CONDITION-CODE VALUES
                   $DEF ZERO=\3, LESS=8
                   $DEF BUSY=8, CLEAR=\15, TROUBLE=7

                   /SIGN-BIT
                   $DEF S=X'8000'

                   /EXTERNAL REFERENCES
                   $DEF XENT=W(X'1700'), XRENT=W(#XENT+4)
                   $DEF XLIM=X'2600', SYSENT=W(XLIM)
                   $DEF FREE=XLIM+X'400'           /BUFFER SPACE

                   /CONTROL BLOCK COMPONENTS
                   $DEF USER=0, SERVER=2, NAM=4
                   $DEF PROM=6                     /KB ONLY
                   $DEF DEVINF=6, DEVSTAT=B(6), DEVCODE=B(7) /SELF-SERVICE ONLY
                   $DEF GET=8, PUT=10, BUFF=12, MAX=14
                   $DEF DIRPOS=16, DCURR=18, DSTART=20, DLIM=22 /DISK ONLY

                   /EXECUTIVE PRE-KERNEL COMPONENTS
                   $DEF XSTATE=-16, XID=B(-13)
                   $DEF UFUNO=-4, XINT=-2

                   /PROCESS KERNEL COMPONENTS
                   $DEF PS=0, PC=2, EXEC=4, LINK=6
                   $SAVE 8                         /REGISTER SAVE DISPLACEMENT
                   $DEF INAD=40, OUTAD=42, NP=44
                   $DEF INOUT0=64, IN0=B(INOUT0), OUT0=B(INOUT0+1)






















                   $/SVCS
                   $DEF XSTOP=SVC 0
                   $DEF DESPATCH=SVC 3
                   $DEF CLAIM=SVC 4
                   $DEF RELEASE=SVC 5
                   $DEF SERVICE=SVC 6
                   $DEF RESET=SVC 7
                   $DEF NSYM=SVC 8,-1
                   $DEF MATCH=SVC 8
                   $DEF RSYM=SVC 9,0
                   $DEF PSYM=SVC 10
                   $DEF PROMPT=SVC 11
                   $DEF SELECT=SVC 12
                   $DEF EXIT=SSVC 13,0
                   $DEF CLOSE=SSVC 14,0
                   $DEF REFER=SSVC 14,1
                   $DEF REFALL=SSVC 14,2
                   $DEF REFIO=SSVC 14,3
                   $DEF REFIN=SSVC 14,4
                   $DEF REFOUT=SSVC 14,5
                   $DEF CLIN=SSVC 14,6
                   $DEF CLOUT=SSVC 14,7
                   $DEF PUSERNO=SSVC 14,8
                   $DEF SEOT=SSVC 14,9
                   $DEF ABANDON = SSVC 14,14
                   $DEF STOP=SSVC 14,15
                   $DEF IGNORE=SSVC 15,0
                   $DEF SKIP=SSVC 15,1
                   $DEF RHEX=SSVC 15,2
                   $DEF PHEX=SSVC 15,3
                   $DEF RWORD=SSVC 15,4
                   $DEF PWORD=SSVC 15,5
                   $DEF RDEC=SSVC 15,6
                   $DEF PDEC=SSVC 15,7
                   $DEF RNAME=SSVC 15,8
                   $DEF PNAME=SSVC 15,9
                   $DEF PTEXT=SSVC 15,10
                   $DEF PDATE=SSVC 15,11
                   $DEF NEWLINE=SSVC 15,12
                   $DEF SPACE=SSVC 15,13
                   $DEF TESTDIG=SSVC 15,14
                   $DEF TESTLET=SSVC 15,15
                   $DEF FCLAIM = SSVC 14,10
                   $DEF FRELEASE = SSVC 14,11
                   $DEF RESPONSE = SSVC 14,12





















                   $/
                   $TEMP                           /NO TEMP REGISTERS YET

                   /INITIAL ENTRY TO SYSTEM
                   /COPY DOWN FROM WHEREVER LOADED
                   /TO LOCATION ZERO
                   $ASSLOC 0
                   $DEF JUMPR1=X'0301'
  0000  C840 32E9      R4 = JUMPR1+X'3000'-24
  0004  2438           R3 = 8
  0006  C820 0301      R2 = JUMPR1
  000A  4020 0008      W(8) = R2
  000E  0113           BAL R1,W(R3)
  0010  D1C1 0000      LM R12,W(R1)
  0014  D0C2 FD0F      STM R12,W(R2-JUMPR1+16)
  0018  2618           R1 = R1+8
  001A  C120 0010      BXLE R2,W(16)
  001E  4300 2600      JUMP SYSENT

                   /POWER-FAIL (X'22')
  0022  0000 0000      0, 0, 0
  0026  0000

                   /INTERRUPT PSWS (X'28')
  0028  0000 0000      0, 0, X'28', #ILLEG          /FP FAULT
  002C  0028 1312
  0030  0000 0000      0, 0, X'30', #ILLEG          /ILLEGAL INST
  0034  0030 1312
  0038  0000 0000      0, 0, X'38', #ILLEG          /MACHINE ERROR
  003C  0038 1312

  0040  0000 0000  INTPSW:0, 0, 0, #INTSER         /EXTERNAL INT
  0044  0000 0566
  0048  0000 0000      0, 0, X'48', #ILLEG          /DIVIDE ERROR
  004C  0048 1312

                   /SUNDRIES (X'50')
  0050  D500 00CF      X'D500'; X'00CF'
  0054  4300 0080      X'4300'; X'0080'
  0058  0000 0000  REFSAVE: 16 $ 0
  005C  0000 0000
  0060  0000 0000
  0064  0000 0000
  0068  0000 0000
  006C  0000 0000
  0070  0000 0000
  0074  0000 0000

  0078  8880          B FSLR, X'80'
  007A  4300 1638      JUMP STATE                  /FOR EXEC
  007E  E1FA       PDA:PTEXT                       /PRINT DATE
  0080  4444 2F4D      B 'DD/MM/YY',0
  0084  4D2F 5959
  0088  0000
  008A  E1D0           EXIT

  008C  2200       NULL: JUMP W(*)
  008E  0220       SYSOUT:#TCB0+16                 /MONITOR OUTPUT CONSOLE
  0090  0090       BG1: * /BACKGROUND SEMAPHORES
  0092  0092       BG2: *







                   /SVC AREA (X'94')

  0094  0000       SVCARG:0                        /SVC ARGUMENT
  0096  0000 0000  SVCPSW:0, 0                     /SVC PSW
  009A  0000           0                           /SVC STATUS (NEW)
  009C  0A2A           #SVSTOP                     /SVC 0
  009E  008C           #NULL                       /SVC 1
  00A0  008C           #NULL                       /SVC 2
  00A2  09C8           #SVDESP                     /SVC 3
  00A4  05D4           #SVCLAIM                    /SVC 4
  00A6  0650           #SVREL                      /SVC 5
  00A8  068C           #SVSER                      /SVC 6
  00AA  086C           #SVRESET                    /SVC 7
  00AC  06EC           #SVNSYM                     /SVC 8
  00AE  0746           #SVRSYM                     /SVC 9
  00B0  07C4           #SVPSYM                     /SVC 10
  00B2  091C           #SVPROM                     /SVC 11
  00B4  08D4           #SVSEL                      /SVC 12
  00B6  09A4           #SVEXIT                     /SSVC 13
  00B8  0968           #SVCALL                     /SSVC 14
  00BA  0968           #SVCALL                     /SSVC 15

  00BC  0000       WQ: 0                           /WAIT QUEUE
  00BE  0480       FQ: #GP0                        /FREE PROCESS QUEUE









































                   $BEGIN BOOTSTRAP

                      $DEF LR=R15, LT=R14, BLK=R12

  00C0  D1C0 00E6        LM BLK,REGS
  00C4  96EC             WB LT,BLK
                         CYCLE
                            CYCLE
  00C6  9DF0                   SS LR,R0
  00C8  20F1                REPEAT IF 15
  00CA  9BF0                RD LR,R0
  00CC  C900 000A           JUMP W(X'50') IF R0=NL
  00D0  4330 0050
  00D4  2207             REPEAT

  00D6  5A2C 2C4C  Z:    B 'Z,,LEGOS.LEGOS', NL
  00DA  4547 4F53
  00DE  2E4C 4547
  00E2  4F53 0A00

  00E6  00D6 00E4  REGS: #Z, #Z+14, FSLT, FSLR
  00EA  0098 0088

  00EE  0000       0 /ROUND UP
                   $END

                   $DEF LTEMP=*LIST
                   $LIST *LIST&(\1)

                   /INTERRUPT TABLE (X'100')

                   $DEF INTTAB=B(*)
  00F0  0000       B   X'02' $ 0, #TBASE0>>3,
  00F2  6700 0000      FSLR-X'03' $ 0, #LKCB0>>3,
  0176  0000 3E6B      X'89'-X'89' $ 0, #TBASE0+32>>3,
  017A  0000 0000      FSLT-X'8A' $ 0, #LKCB0+8>>3,
  0186  0000 3F6B      X'99'-X'99' $ 0, #TBASE0+32>>3
  018A  0000 0000  B   (#INTTAB+256)-* $ 0




























                   $/STREAM CONTROL BLOCKS
                   /*MUST START ON 8-BYTE BOUNDARY*

                   $MACRO BUF B
                   FREE
                   $REDEF FREE=FREE+B
                   $END

                   /SELF-SERVICE DEVICES (8 BYTES)
                   /USER:ERRSERVER:NAM:DEVINF
                   LKCB0:
  01F0  01F0 0378  FSR:*, #CRBASE, X'4DEC', FSLR
  01F8  01F8 0378  FST:*, #CRBASE, X'4E3C', X'100'+FSLT
                   /OTHER DEVICES (16 BYTES)
                   /USER:SERVER:NAM:(PROM):GET:PUT:BUFF:MAX
                   CRCB:
  0200  0200 0378      *, #CRBASE, X'1590', 0, 0 , 0; BUF 128; 127
                   TCB0:
  0210  0210 0338      *, #TBASE0, X'452C', 0, 0, 0; BUF 128; 127
  0220  0220 0338      *, #TBASE0, X'7F9C', X'100', 0, 0; BUF 64; 63
  0230  0230 0358      *, #TBASE1, X'452D', 0, 0, 0; BUF 128; 127
  0240  0240 0358      *, #TBASE1, X'7F9D', X'100', 0, 0; BUF 64; 63

                   /DISK FILE CONTROL BLOCKS (24 BYTES)
                   /USER:SERVER:NAM:DEVINF:GET:PUT:BUFF:MAX
                   /DIRINF:DCURR:DSTART:DLIM
                   DCB0:
  0250  0250 0000      *, 0, 0, 0, 0, 0; BUF 512; 511, 0, 0, 0, 0
  0268  0268 0000      *, 0, 0, 0, 0, 0; BUF 512; 511, 0, 0, 0, 0
  0280  0280 0000      *, 0, 0, 0, 0, 0; BUF 512; 511, 0, 0, 0, 0
  0298  0298 0000      *, 0, 0, 0, 0, 0; BUF 512; 511, 0, 0, 0, 0
  02B0  02B0 0000      *, 0, 0, 0, 0, 0; BUF 512; 511, 0, 0, 0, 0
  02C8  02C8 0000      *, 0, 0, 0, 0, 0; XLIM; 511, 0, 0, 0, 0
  02E0  02E0 0000      *, 0, 0, 0, 0, 0; XLIM+512; 511, 0, 0, 0, 0
































                   $/PROCESS KERNELS

                   /REMINDER: PS=0, PC=2, EXEC=4, LINK=6

                   /DISKS
                   DBASE0:
  02F8  4000 0F3C      X'4000', #DKENT, 0, 0
  0300  0000 0000      0, 0, *-12, 0, 0, 0, 0, 0
  0310  0000 0000      0,0,0,0,0,0,0,0
  0320  0000 0000      0, 0, *, 9 $ 0

                   /TELETYPES (TRUNCATED KERNELS)
                   TBASE0:
  0338  0000 0DC2      0, #TTENT, #XBASE0, 0
  0340  0B94 0000      #TYP, 0, *-12, 0, 0, 0, 0, 0
  0350  0002 0210      X'02', #TCB0, 0, 0

                   TBASE1:
  0358  0000 0DC2      0, #TTENT, #XBASE1, 0
  0360  0B94 0000      #TYP, 0, *-12, 0, 0, 0, 0, 0
  0370  0089 0230      X'89', #TCB0+32, 0, 0

                   /CARD READER & DEVICE ERROR REPORTER
                   CRBASE:
  0378  0000 0E7A      0, #DERENT, #XBASE0, 0
  0380  0000 0000      0, 0, *-12, 0, 0, 0, 0, 0
  0390  0004 0000      X'04', 0, 0, 0, 0, 0, 0, 0
  03A0  0000 0000      0, 0, *, 0

                   /IDLE PROCESS
                   IBASE:
  03A8  C000 0000        USR+X'8000', 0, 0, 0 /WAIT
  03B0  0000 0000        16 $ 0

                   /EXECUTIVES
                   $DEF XINOUT=#TCB0>>3<<8+(#TCB0+16>>3)
                   /PRE-KERNEL: XSTATE:XID:XSTORE:UNAME1
                   /            UNAME2:UNAME3:UDIR:?
  03D0  0008 0000      8, 0; BUF 112; 0, 0, 0, 0, 0

                   XBASE0:
  03E0  4000 1700      USR, #XENT, *-4, #IBASE
  03E8  0000 0000      0, 0, 0, 0, 0, 0, 0, 0
  03F8  0000 0000      0, 0, 0, 0, 0, 0, 0, 0
  0408  0210 0220      #TCB0, #TCB0+16, *, 9 $ 0, XINOUT, 0, 0, 0
  0428  0000 0001      0, 1; BUF 112; 0,0,0,0,0

                   XBASE1:
  0438  4000 1700      USR, #XENT, *-4, 0
  0440  0000 0000      16 $ 0
  0460  0000 0000      0, 0, *, 9 $ 0, XINOUT+X'0404', 0 ,0 ,0

                   /GENERAL PURPOSE PROCESSES
                   GP0:
  0480  04C8 0000      *+72, 21 $ 0, *, 8 $ 0; BUF 112; 4 $ 0
  04C8  0510 0000      *+72, 21 $ 0, *, 8 $ 0; BUF 112; 4 $ 0
  0510  0000 0000      0, 21 $ 0, *, 8 $ 0; BUF 112; 4 $ 0

  0558  3830 05C6  USAVE:FREE, #PBASE, #ABDN, #SVGO   /(MAKE GLOBAL)

                   /BASIC DEVICE COMMANDS





                   $DEF DISARM=B(*), DISABLE=B(*+1)
  0560  C080       B   X'C0', X'80'
                   $DEF ENABLE=B(*), RETRANS=B(*+1)
  0562  4020       B   X'40', X'20'
                   $DEF CLERR=B(*), SVDUMP=B(*+1)
  0564  1000       B   X'10', 0

                   $LIST LTEMP


























































                   $BEGIN BASIC SUPERVISOR
                   $TEMP R15
                   $DEF PB=R12, SW1=R13, SW2=R14, TEMP=R15
                   $DEF NEWPB=R13, DEV=R13, CB=R14
                   $DEF HCB=R5

                   /INTERRUPT SERVICE
                   INTSER:
  0566  40C0 0558      USAVE = PB                  /FREE A REGISTER
  056A  48C0 05C6      PB = PBASE                  /CURRENT PROCESS BASE
  056E  D00C 0008      STM R0,R0(PB)               /SAVE REGISTERS
  0572  48F0 0558      PB(PB) = USAVE
  0576  40FC 0020
  057A  9F31           AI R3,R1                    /ACKNOWLEDGE
  057C  D1E0 0040      LM R14,INTPSW               /SAVE INTPSW AS PSW
  0580  D0EC 0000      STM R14,PS(PB)
  0584  D3D3 00F0      NEWPB = INTTAB(R3)<<3       /INTERRUPT TABLE ENTRY
  0588  91D3
  058A  2333 0811      JUMP INTIGN IF NEWPB = 0 OR R1#0
  058E  2333
  0590  4300 05C8

  0594  C9D0 02F8      IF NEWPB < #DBASE0          /(CB) DO-IT-YOURSELF
  0598  231C
  059A  DE30 0561        OC R3,DISABLE
  059E  483D 0000        R3 = USER(NEWPB)          /USER WAITING?
  05A2  4310 05C8        JUMP INTIGN IF R3 >= 0    /NO ->
  05A6  CA30 8000        R3 = R3-S                 /REMOVE WAIT BIT
  05AA  403D 0000        USER(NEWPB) = R3
  05AE  08D3             NEWPB = R3
                       FINISH
  05B0  40CD 0006      LINK(NEWPB) = PB            /PUSH-DOWN CURRENT PRO
                   SVGO:
  05B4  40D0 05C6      PBASE = NEWPB
  05B8  2401 980D     R0 = 1; WH R0,NEWPB; WH R0,W(NEWPB+2)
  05BC  D80D 0002
  05C0  D10D 0008      LM R0,R0(NEWPB)             /RESTORE ALL REGISTERS
  05C4  C200           X'C200'                     /LPSW
  05C6  03E0       PBASE:#XBASE0                   /*IMPURE*

                   INTIGN:
  05C8  08DC           NEWPB = PB
  05CA  220B           JUMP SVGO

                   SVOUT:
  05CC  D1C0 0558      LM R12,USAVE
  05D0  C200 0096      LPSW SVCPSW

                   /SVC CLAIM  RESOURCE (CLASS)
                   /ODD AD MEANS NO WAITING
                   /R1<-RESOURCE (<=0 IF UNAVAILABLE)
                   SVCLAIM:
  05D4  D0C0 0558      STM R12,USAVE
  05D8  48C0 05C6      PB = PBASE
  05DC  2512           R1 = \1&SVCARG
  05DE  4410 0094
                   SVCL1:
  05E2  4911 0000      IF USER(R1) = R1            /RESOURCE AVAILABLE
  05E6  2135
  05E8  40C1 0000        USER(R1) = PB
  05EC  4300 05CC        JUMP SVOUT





                       FINISH
  05F0  C910 0250      IF R1 >= #DCB0
  05F4  2116
  05F6  CA10 0018        R1 = R1+24                /NEXT DISK FILE CB (?)
  05FA  C910 02F8        JUMP SVCL1 IF R1 < #DBASE0
  05FE  201E
                       FINISH

                   /ADD CLAIMANT TO QUEUE
  0600  4810 0094  SVQ:R1 = SVCARG<<15
  0604  911F
  0606  4210 05CC      JUMP SVOUT IF R1 < 0        /NO WAITING
                   SVQ1:
  060A  C8D0 00B6      SW1 = #WQ-LINK              /ADJUSTED POINTER
                       CYCLE
  060E  08ED             SW2 = SW1                 /FIND END OF QUEUE
  0610  48DE 0006        SW1 = LINK(SW2)
  0614  2033           REPEAT IF SW1 # 0
  0616  40CE 0006      LINK(SW2) = PB              /APPEND CURRENT PRO
                   SVWT0:
  061A  25F4           SVCPSW(2) = SVCPSW(2)-4     /BACK OFF TO REPEAT SVC
  061C  61F0 0098
                   SVWAIT:
  0620  48DC 0006      NEWPB = LINK(PB)
  0624  2305           JUMPS SVWT1
                   SVSWOP:
  0626  48FC 0006      LINK(NEWPB) = LINK(PB)
  062A  40FD 0006
                   SVWT1:
  062E  24F0           LINK(PB) = 0
  0630  40FC 0006

                   SVWT2:
  0634  D1E0 055C      LM R14,USAVE(4)             /*PB=R12,NEWPB=R13*
  0638  D00C 0008      STM R0,R0(PB)
  063C  D1E0 0558      LM R14,USAVE
  0640  D0EC 0020      STM R14,R12(PB)
  0644  48F0 0098      PC(PB) = SVCPSW(2)
  0648  40FC 0002
  064C  4300 05B4      JUMP SVGO

                   /SVC RELEASE  RESOURCE
                   SVREL:
  0650  D0C0 0558      STM R12,USAVE
  0654  48C0 05C6      PB = PBASE
  0658  48E0 0094      CB = SVCARG
  065C  4320 05CC      JUMP SVOUT IF CB <= 0
                   SVREL1:
  0660  49CE 0000      JUMP SVOUT IF USER(CB) # PB
  0664  4230 05CC
  0668  40EE 0000      USER(CB) = CB               /RELEASED
  066C  48E0 00BC      SW2 = WQ
  0670  4330 05CC      JUMP SVOUT IF SW2 = 0
                       CYCLE
  0674  08DE             SW1 = SW2
  0676  48ED 0006        SW2 = LINK(SW1)
  067A  2033           REPEAT IF SW2 # 0
  067C  40CD 0006      LINK(SW1) = PB
  0680  48D0 00BC      NEWPB = WQ
  0684  40E0 00BC      WQ = SW2                    /ZERO
  0688  4300 0634      JUMP SVWT2





                   /SVC SERVICE  CONTROL-BLOCK
                   /ODD AD MEANS NO WAITING
                   SVSER:
  068C  D0C0 0558      STM R12,USAVE
  0690  48C0 05C6      PB = PBASE
  0694  25E2           CB = \1&SVCARG
  0696  44E0 0094
  069A  49E0 0094      JUMPS SVSER2 IF CB # SVCARG
  069E  2135

                   SVSER1:
  06A0  C8FC 8000      USER(CB) = PB+S             /WAITING
  06A4  40FE 0000

                   SVSER2:
  06A8  48DE 0002      NEWPB = SERVER(CB)
  06AC  C9D0 02F8      IF NEWPB >= #DBASE0         /NOT ON SERVICE Q ALREADY
  06B0  4210 06E0
  06B4  24F0             SERVER(CB) = 0
  06B6  40FE 0002
  06BA  48FD 0012        TEMP = HCB(NEWPB)         /HEAD OF SERVICE Q
  06BE  213B             IF TEMP = 0               /SERVER IDLE
  06C0  40ED 0012          HCB(NEWPB) = CB
  06C4  48FE 0000          JUMP SVSWOP IF USER(CB) < 0
  06C8  4210 0626
  06CC  40CD 0006          LINK(NEWPB) = PB
  06D0  4300 0634          JUMP SVWT2
                         FINISH
                         CYCLE                     /FIND END OF SERVICE Q
  06D4  08DF               SW1 = TEMP
  06D6  48FD 0002          TEMP = SERVER(SW1)
  06DA  2033             REPEAT IF TEMP # 0
  06DC  40ED 0002        SERVER(SW1) = CB          /APPEND THIS CB
                       FINISH
  06E0  48FE 0000      JUMP SVWAIT IF USER(CB) < 0
  06E4  4210 0620
  06E8  4300 05CC      JUMP SVOUT

                   /SVC NEXT SYMBOL TO R1
                   /READ IF SYM = SVCARG
                   SVNSYM:
  06EC  D0C0 0558      STM R12,USAVE
  06F0  48C0 05C6      PB = PBASE
  06F4  24F1           B(#SVCPSW(1)) = 1           /CC NON-ZERO
  06F6  D2F0 0097
  06FA  48EC 0028      CB = INAD(PB)
  06FE  4330 07AC      JUMP SVEOF IF CB = 0
  0702  C9E0 0200      IF CB < #CRCB               /DO-IT-YOURSELF
  0706  231C
  0708  48DE 0006        DEV = DEVINF(CB)
  070C  4210 07AC        JUMP SVEOF IF DEV < 0
  0710  9DDF             SS DEV,TEMP
  0712  42F0 0858        JUMP DIY1 IF \CLEAR
  0716  DED0 0563        OC DEV,RETRANS
  071A  9BD1             RD DEV,R1
  071C  230D           ELSE
  071E  48FE 0008        JUMP SVRS5 IF GET(CB) = PUT(CB)
  0722  49FE 000A
  0726  4330 07A6
  072A  44FE 000E        R1 = B(GET(CB)&MAX(CB)+BUFF(CB))






  072E  4AFE 000C
  0732  D31F 0000
                       FINISH
  0736  4910 0094      JUMP SVOUT IF R1 # SVCARG
  073A  4230 05CC
  073E  24F0           B(#SVCPSW(1)) = 0 /CC ZERO
  0740  D2F0 0097
  0744  2305           JUMPS SVRS1

                   /SVC READ SYMBOL TO R1
                   SVRSYM:
  0746  D0C0 0558      STM R12,USAVE
  074A  48C0 05C6      PB = PBASE
                   SVRS1:
  074E  48EC 0028      CB = INAD(PB)
  0752  4330 07AC      JUMP SVEOF IF CB = 0        /NULL (EOF) ->
  0756  C9E0 0200      IF CB < #CRCB               /DO-IT-YOURSELF
  075A  4310 0786
  075E  48DE 0006        DEV = DEVINF(CB)
  0762  4210 07AC        JUMP SVEOF IF DEV < 0
  0766  9DDF             SS DEV,TEMP
  0768  42F0 0858        JUMP DIY1 IF \CLEAR
  076C  9BD1             RD DEV,R1
  076E  C910 0004        IF R1 = EOT AND DEV<<1 >= 0 /EOT, NOT BINARY
  0772  2139 08FD
  0776  91F1 2116
  077A  C6D0 8000            DEV = DEV!S; DEVINF(CB) = DEV
  077E  40DE 0006
  0782  2511                 R1 = -1
                         FINISH
  0784  230F           ELSE
  0786  48FE 0008        JUMPS SVRS5 IF GET(CB) = PUT(CB) /BUFFER EMPTY ->
  078A  49FE 000A
  078E  233C
  0790  44FE 000E        R1 = B(GET(CB)&MAX(CB)+BUFF(CB))
  0794  4AFE 000C
  0798  D31F 0000

  079C  24F1             GET(CB) = GET(CB)+1
  079E  61FE 0008
                       FINISH
  07A2  4300 05CC      JUMP SVOUT
  07A6  48FE 0006  SVRS5:JUMPS SVRS6 IF DEVINF(CB) >= 0
  07AA  2314
  07AC  2511       SVEOF:R1 = -1
  07AE  4300 05CC      JUMP SVOUT
                   SVRS6:
  07B2  48FE 0000      JUMP SVQ1 IF USER(CB) < 0   /ANOTHER WAITING ->
  07B6  4210 060A
  07BA  25F4           SVCPSW(2) = SVCPSW(2)-4
  07BC  61F0 0098
  07C0  4300 06A0      JUMP SVSER1

                   /SVC PRINT SYMBOL  SYM
                   SVPSYM:
  07C4  D0C0 0558      STM R12,USAVE
  07C8  48C0 05C6      PB = PBASE
  07CC  48EC 002A      CB = OUTAD(PB)
  07D0  4330 05CC      JUMP SVOUT IF CB = 0        /NULL
  07D4  C9E0 0200      IF CB < #CRCB               /DO-IT-YOURSELF
  07D8  231F





  07DA  48DE 0006        DEV = DEVINF(CB)
  07DE  4210 134E        JUMP ABDN IF DEV < 0
  07E2  9DDF             SS DEV,TEMP
  07E4  42F0 0858        JUMP DIY1 IF \CLEAR
  07E8  48F0 0094        TEMP = SVCARG
  07EC  4210 05CC        JUMP SVOUT IF TEMP < 0    /DUMMY ->
  07F0  9ADF             WD DEV,TEMP
  07F2  4300 05CC        JUMP SVOUT
                       FINISH
  07F6  48FE 000A      IF PUT(CB)-GET(CB) > MAX(CB) /BUFF FULL
  07FA  4BFE 0008
  07FE  49FE 000E
  0802  2327
  0804  48FE 0006        JUMP ABDN IF DEVINF(CB) < 0
  0808  4210 134E
  080C  4300 07B2        JUMP SVRS6
                       FINISH
  0810  48DE 000A      SW1 = PUT(CB)&MAX(CB)+BUFF(CB) /COMPUTE SYM AD
  0814  44DE 000E
  0818  4ADE 000C
  081C  24F1           PUT(CB) = PUT(CB)+1
  081E  61FE 000A
  0822  48F0 0094      TEMP = SVCARG
  0826  D2FD 0000      B(SW1) = TEMP               /STORE SYM
  082A  C9F0 0020      JUMP SVOUT IF TEMP >= 32    /NOT CONTROL
  082E  4310 05CC
  0832  C9E0 0250      JUMP SVOUT IF CB >= #DCB0   /NOT TT ->
  0836  4310 05CC
  083A  C9F0 0005      IF TEMP = ENQ               /REPLY REQUIRED
  083E  2137
  0840  48FE 0000        JUMP SVQ1 IF USER(CB) < 0
  0844  4210 060A
  0848  4300 06A0        JUMP SVSER1
                       FINISH
  084C  48FE 0000      JUMP SVOUT IF USER(CB) < 0
  0850  4210 05CC
  0854  4300 06A8      JUMP SVSER2

                   /DO-IT-YOURSELF INPUT/OUTPUT
                   /DEVICE BUSY OR ERROR
                   DIY1:
  0858  4270 07B2      JUMP SVRS6 IF TROUBLE
                   /BUSY
  085C  DED0 0562      OC DEV,ENABLE
  0860  C8F0 8000      USER(CB) = USER(CB)+S       /WAITING
  0864  61FE 0000
  0868  4300 061A      JUMP SVWT0

                   /SVC RESET INOUT(0,1)
                   SVRESET:
  086C  D0C0 0558      STM R12,USAVE
  0870  48C0 05C6      PB = PBASE
  0874  48E0 0094      CB = INAD(SVCARG<<15>>14+PB) /INAD,OUTAD
  0878  91EF 90EE
  087C  0AEC
  087E  48EE 0028
  0882  4330 05CC      JUMP SVOUT IF CB = 0
  0886  C9E0 0200      IF CB < #CRCB               /DIY
  088A  2318
  088C  48DE 0006        DEV = DEVINF(CB)
  0890  2113             OC DEV,CLERR IF DEV >= 0





  0892  DED0 0564
  0896  4300 08C4        ELSE IF CB>=#DCB0
  089A  C9E0 0250
  089E  4210 08C4
  08A2  48FE 0004           IF NAM(CB)=0
  08A6  2137
  08A8  24F1                   NAM(CB) = 1
  08AA  40FE 0004
  08AE  4300 07B2              JUMP SVRS6 /GET PROCESS TO DO IT
  08B2  2309                ELSE
  08B4  48FE 0004              NAM(CB) = 0 IF NAM(CB)=2
  08B8  C9F0 0002
  08BC  2134 24F0
  08C0  40FE 0004
                            FINISH
                       FINISH
  08C4  48FE 0006      DEVINF(CB) = DEVINF(CB)&X'7FFF' /CANCEL EOF
  08C8  C4F0 7FFF
  08CC  40FE 0006
  08D0  4300 05CC      JUMP SVOUT

                   /SVC SELECT/ATTACH/DETACH
                   SVSEL:
  08D4  D0C0 0558      STM R12,USAVE
  08D8  48C0 05C6      PB = PBASE
  08DC  48D0 0094      SW1 = SVCARG
  08E0  24F7 04FD      TEMP = 7&SW1+PB             /SLOT AD
  08E4  0AFC
  08E6  08DD           IF SW1 >= 0                  /SELECT,DETACH
  08E8  4210 0912
  08EC  D3EF 0040        CB = IN0(TEMP)<<3
  08F0  91E3
  08F2  91D1             SW1 = SW1<<1
  08F4  211D             IF SW1 >= 0               /SELECT
  08F6  08FD 90F4          TEMP = SW1>>4
  08FA  C4D0 0002          SW1 = SW1&2+PB
  08FE  0ADC
  0900  40ED 0028            INAD(SW1) = CB        /INAD,OUTAD
  0904  08FF 2332           R1 = CB IF TEMP#0
  0908  081E
  090A  4300 05CC          JUMP SVOUT
                         FINISH
  090E  081E             R1 = CB
  0910  24D0             SW1 = 0
                       FINISH
  0912  90D3           SW1 = SW1>>3                /+ATTACH
  0914  D2DF 0040      IN0(TEMP) = SW1
  0918  4300 05CC      JUMP SVOUT

                   /SVC PROMPT TEXTAD
                   SVPROM:
  091C  D0C0 0558      STM R12,USAVE
  0920  48C0 05C6      PB = PBASE
  0924  24D1           SW1 = 1
  0926  48EC 0028      CB = INAD(PB)
  092A  2334           SW1 = DEVINF(CB)>>15 IF CB # 0
  092C  48DE 0006
  0930  90DF
  0932  C9E0 0210      IF CB >= #TCB0 AND CB < #DCB0
  0936  4210 0960
  093A  C9E0 0250





  093E  4310 0960
  0942  48F0 0094        PROM(CB) = SVCARG
  0946  40FE 0006
  094A  48FE 0008        SW1 = 2 IF GET(CB) = PUT(CB) AND SERVER(CB) >= #DBASE0
  094E  49FE 000A
  0952  2137
  0954  48FE 0002
  0958  C9F0 02F8
  095C  2112 24D2
                       FINISH
  0960  D2D0 0097      B(#SVCPSW(1)) = SW1         /CLEAR IF DATA PENDING
  0964  4300 05CC      JUMP SVOUT

                   /SSVC CALL SYSTEM ROUTINE
                   SVCALL:
  0968  D0C0 0558      STM R12,USAVE
  096C  48C0 05C6      PB = PBASE
  0970  48D0 0098      SW1 = SVCPSW(2)-2           /RETURN ADDRESS
  0974  27D2
  0976  48FD FFFE      SVCPSW(2) = SRTAB(W(SW1-2)&31<<1) /ENTRY-POINT
  097A  C4F0 001F
  097E  91F1
  0980  48FF 0A88
  0984  40F0 0098
  0988  48FC 002C      JUMP W(*) IF NP(PB) >= PB+62 /NEST FULL
  098C  C9FC 003E
  0990  2214
  0992  24F2           NP(PB) = NP(PB)+2
  0994  61FC 002C
  0998  48FC 002C      W(NP(PB)) = SW1
  099C  40DF 0000
  09A0  4300 05CC      JUMP SVOUT

                   /SSVC EXIT FROM SYSTEM ROUTINE
                   SVEXIT:
  09A4  D0C0 0558      STM R12,USAVE
  09A8  48C0 05C6      PB = PBASE
  09AC  48FC 002C      JUMP W(*) IF NP(PB) <= #NP(PB) /NEST EMPTY
  09B0  C9FC 002C
  09B4  2224
  09B6  48FF 0000      SVCPSW(2) = W(NP(PB))       /POP RETURN ADDRESS
  09BA  40F0 0098
  09BE  25F2           NP(PB) = NP(PB)-2
  09C0  61FC 002C
  09C4  4300 05CC      JUMP SVOUT

                   /SVC DESPATCH  ENTRY-POINT
                   /ALLOCATE PROCESS TO EXECUTE TASK
                   /ODD AD MEANS NO WAITING
                   /R1<-KERNEL (<=0 IF NONE AVAILABLE)
                   SVDESP:
  09C8  D0C0 0558      STM R12,USAVE
  09CC  4810 00BE      R1 = FQ                     /FREE-PROCESS QUEUE
  09D0  2135           IF R1 = 0                   /EMPTY
  09D2  48C0 05C6        PB = PBASE
  09D6  4300 0600        JUMP SVQ
                       FINISH
  09DA  D001 0008      STM R0,R0(R1)               /COPY REGISTERS
  09DE  48C0 05C6      PB = PBASE
  09E2  48F1 0000      FQ = W(R1)                  /UPDATE QUEUE
  09E6  40F0 00BE





  09EA  48EC 0004      SW2 = EXEC(PB)              /TRANSMIT EXEC INFO
  09EE  48FE 0040      INOUT0(R1) = INOUT0(SW2)
  09F2  40F1 0040
  09F6  91F8 90F5      OUTAD(R1) = INOUT0(R1)<<8>>5 /SELECT OUT 0
  09FA  40F1 002A
  09FE  24F1           XSTATE(SW2) = XSTATE(SW2)+1
  0A00  61FE FFF0
  0A04  C8F0 4000      PS(R1) = USR
  0A08  40F1 0000
  0A0C  25F2           PC(R1) = \1&SVCARG
  0A0E  44F0 0094
  0A12  40F1 0002
  0A16  40E1 0004      EXEC(R1) = SW2
  0A1A  48FC 0006      LINK(R1) = LINK(PB)
  0A1E  40F1 0006
  0A22  401C 0006      LINK(PB) = R1
  0A26  4300 05CC      JUMP SVOUT

                   /SVC STOP
                   $DEF XB=R5
                   SVSTOP:
  0A2A  D0C0 0558      STM R12,USAVE
  0A2E  48C0 05C6      PB = PBASE
  0A32  48E0 0094      SW2 = SVCARG
  0A36  2133           SW2 = #XRENT IF SW2 = 0
  0A38  C8E0 1704
  0A3C  485C 0004      XB = EXEC(PB)               /*RE-ESTABLISH XB*
  0A40  09C5           IF PB # XB                  /NOT EXEC
  0A42  4330 0A68
  0A46  48F0 00BE        W(PB) = FQ                /RELEASE PROCESS
  0A4A  40FC 0000
  0A4E  40C0 00BE        FQ = PB
  0A52  25F1             XSTATE(XB) = XSTATE(XB)-1
  0A54  61F5 FFF0
  0A58  4230 0620        JUMP SVWAIT IF XSTATE(XB) # 0
  0A5C  24F8             XSTATE(XB) = 8            /EXEC NOW ACTIVE
  0A5E  40F5 FFF0
  0A62  08D5             NEWPB = XB
  0A64  4300 0626        JUMP SVSWOP
                       FINISH
  0A68  40E0 0098      SVCPSW(2) = SW2
  0A6C  25F8           XSTATE(XB) = XSTATE(XB)-8   /EXEC INACTIVE
  0A6E  61F5 FFF0
  0A72  4230 0620      JUMP SVWAIT IF XSTATE(XB) # 0 /SUB-PROS ACTIVE ->
  0A76  C9E0 1704      JUMP SVWAIT IF SW2 # #XRENT /LOGOFF ->
  0A7A  4230 0620
  0A7E  24F8           XSTATE(XB) = 8
  0A80  40F5 FFF0
  0A84  4300 05CC      JUMP SVOUT

                   /SYSTEM ROUTINE ENTRY-POINTS
                   SRTAB:

                   $END BASIC SUPERVISOR

  0A88  12A2 11A8  #CLOS0, #REF0, #REFL0,#REFIO0,#RIN0,#ROUT0,#CLIN0,#CLOUT0
  0A8C  122E 121C
  0A90  1214 1218
  0A94  129A 129E
  0A98  0F06 1260  #PUSER0, #SEOT0, #FCLAI0, #FRELE0, #RESPO0, #NULL, #ABDN, #STOP0
  0A9C  0EB4 0EE8






  0AA0  0F1E 008C
  0AA4  134E 1360
  0AA8  13B2 13BA  #IG0, #SK0, #RH0, #PH0, #RW0, #PW0, #RD0, #PD0
  0AAC  1402 1420
  0AB0  143C 1490
  0AB4  1504 1516
  0AB8  158C 15DE  #RN0, #PN0, #PT0, #PDA, #NL0, #SP0, #TD0, #TL0
  0ABC  1552 007E
  0AC0  1580 1586
  0AC4  13C2 13DE
























































                   $BEGIN DEVICE HANDLERS
                   $TEMP R1
                   $DEF AC=R0, TEMP=R1, PB=R2, WORK=R3
                   $DEF OUT=W(R4), CALL=BAL R4
                   $DEF CB=R5

                   $DEF SIGUSER=CALL W(*)
  0AC8  4835 0000      WORK = USER(CB)
  0ACC  0314           JUMP OUT IF WORK >= 0
  0ACE  CA30 8000      WORK = WORK-S
  0AD2  4035 0000      USER(CB) = WORK
                   $DEF SCHEDULE=CALL W(*)
  0AD6  4812 0006      LINK(WORK) = LINK(PB)
  0ADA  4013 0006
  0ADE  4032 0006      LINK(PB) = WORK
  0AE2  0304           JUMP OUT

                   $DEF REPORT=CALL W(*)
  0AE4  4815 0000      TEMP = USER(CB)
  0AE8  2315           IF TEMP < 0
  0AEA  D311 8041        TEMP = OUT0(TEMP-S)<<3
  0AEE  9113
  0AF0  2123             JUMPS RP1 IF TEMP > 0
                       FINISH
                   $DEF MONITOR=CALL W(*)
  0AF2  4810 008E      TEMP = SYSOUT
  0AF6  4012 002A  RP1:OUTAD(PB) = TEMP
  0AFA  E1A0 0002      PSYM STX                    /ENSURE PRINTING
  0AFE  E1F5           PWORD                       /DEVICE MNEMONIC
  0B00  E1FA 204E      PTEXT; B ' NOT READY (',0
  0B04  4F54 2052
  0B08  4541 4459
  0B0C  2028 0000
  0B10  0803 E1F3      AC = WORK; PHEX             /STATUS
  0B14  E1A0 0029      PSYM ')'
  0B18  0304           JUMP OUT

                   $DEF SETEOT=CALL W(*)
  0B1A  4815 0006      DEVINF(CB) = DEVINF(CB)!8
  0B1E  C610 8000
  0B22  4015 0006
  0B26  0304           JUMP OUT

                   $DEF IDLE=BAL TEMP,W(*)
                   /*NB BAL TEMP*
  0B28  4835 0002      WORK = SERVER(CB)           /SERVICE QUEUE
  0B2C  4025 0002      SERVER(CB) = PB             /RESTORE SERVER
  0B30  0853           CB = WORK
  0B32  0231           JUMP W(TEMP) IF CB # 0
  0B34  2305           JUMPS WAIT

                   /TT,CR INTERRUPT WAIT
                   $DEF TTWAIT=BAL R1,W(*)
  0B36  D0B5 0006      STM R11,W(CB+6)             /UPDATE CONTROL BLOCK
  0B3A  D1B2 001E      LM R11,R11(PB)              /LOAD FOR STORING
                   /INTERRUPT WAIT
                   $DEF INTWAIT=BAL R1,W(*)
                   WAIT:
  0B3E  4012 0002      PC(PB) = R1
  0B42  D032 000E      STM R3,R3(PB)               /SAVE REGISTERS
  0B46  4002 0008      R0(PB) = R0





  0B4A  48D2 0006      R13 = LINK(PB)              /POP-UP NEXT PRO
  0B4E  4220 05B4      JUMP SVGO IF R13 > 0        /*R13=NEWPB*
  0B52  2200           JUMP W(*)































































                   $BEGIN STREAM HANDLERS
                   $DEF CBGET=GET, CBPUT=PUT
                   $DEF SYM=R6
                   $DEF GET=R12, PUT=R13, BUFF=R14, MAX=R15

                   $DEF PUTNL=CALL W(*)
  0B54  246A           SYM = NL
                   $DEF PUTSYM=CALL W(*)
  0B56  0813 041F      B(WORK&MAX+BUFF) = SYM
  0B5A  0A1E
  0B5C  D261 0000
  0B60  2631           WORK = WORK+1
  0B62  0304           JUMP OUT





















































                   $BEGIN TELETYPE HANDLERS
                   $DEF TYPR=R0
                   $DEF TTSYMS=R7, DEV=R8, KCB=R9, SHIFT=R10, PROM=R11
                   $DEF TTLENGTH=72
                   $DEF XB=R5

                   $DEF DIS=128, EN=64, UN=32, BL=16
                   $DEF TTDISWRITE=B(*), TTLISTEN=B(*+1)
                   $DEF TTDISREAD=B(*+2), TTDISLISTEN=B(*+3) /*ADJACENT
  0B64  D854       B   DIS+EN+BL+8, EN+BL+4,
  0B66  E4D4           DIS+EN+UN+4, DIS+EN+BL+4

                   $MACRO TYPE K
                       SYM = K
                       CALL TYPR
                   $END

                   /INPUT SUBROUTINE
                   KREAD:
  0B68  241F 0418      DEV = DEV&15+X'80' IF DEV&15#2
  0B6C  C910 0002
  0B70  2335
  0B72  C480 000F
  0B76  CA80 0080

  0B7A  DE80 0562      OC DEV,ENABLE
                       CYCLE
  0B7E  4110 0B36        TTWAIT
  0B82  D1B5 0006        LM R11,W(CB+6)
  0B86  9D81             SS DEV,TEMP
  0B88  9B86             RD DEV,SYM
  0B8A  0811 2037      REPEAT IF TEMP # 0
  0B8E  C460 007F      SYM = SYM&127
  0B92  0304           JUMP OUT

                   /OUTPUT SUBROUTINE
  0B94  241F 0418  TYP:IF DEV&15#2
  0B98  C910 0002
  0B9C  233A

  0B9E  C480 000F        DEV = DEV&15+X'80'
  0BA2  CA80 0080
  0BA6  DE80 0561        OC DEV,DISABLE
  0BAA  CA80 0010        DEV = DEV+X'10'
  0BAE  2303           ELSE
  0BB0  DE80 0B64        OC DEV,TTDISWRITE
                       FINISH
  0BB4  DE80 0562      OC DEV,ENABLE
  0BB8  9D81           SS DEV,TEMP
  0BBA  42F0 0BDE      JUMP TY6 IF \CLEAR
  0BBE  C960 0020  TY2:TTSYMS = TTSYMS+1 IF SYM >= 32 /SPACING SYM
  0BC2  2112 2671
  0BC6  C960 000D      TTSYMS = 0 IF SYM = RT
  0BCA  2132 2470
  0BCE  9A86           WD DEV,SYM                  /PRINT CHAR
  0BD0  2460          SYM = 0
  0BD2  4110 0B36  TY5:TTWAIT
  0BD6  D1B5 0006      LM R11,W(CB+6)
  0BDA  9D81           SS DEV,TEMP
  0BDC  03F4           JUMP OUT IF CLEAR
  0BDE  9D86       TY6:SS DEV,SYM                  /(SYM NON-ZERO)





  0BE0  2087           JUMP TY5 IF BUSY
  0BE2  241F 0418     OC DEV,RETRANS IF DEV&15#2
  0BE6  C910 0002
  0BEA  2333
  0BEC  DE80 0563

  0BF0  0304           JUMP OUT

                   /KEYBOARD
                   /SPONTANEOUS INPUT
                   KBINT:
  0BF2  0859           CB = KCB
  0BF4  D1B5 0006      LM R11,W(CB+6)
  0BF8  2410           SERVER(CB) = 0
  0BFA  4015 0002
  0BFE  241F 0418     DEV = DEV&15+X'80' IF DEV&15#2
  0C02  C910 0002
  0C06  2335
  0C08  C480 000F
  0C0C  CA80 0080

  0C10  9B83           RD DEV,WORK
  0C12  C430 007F      WORK = WORK&127
  0C16  246A           SYM = LF                    /(CLEARS PRINT CANCEL)
  0C18  0936           IF WORK # SYM               /NOT LF
  0C1A  4330 0C68
  0C1E  C930 001B        IF WORK = ESC             /ESCAPE
  0C22  4230 0C4E
  0C26  4832 0004          WORK = EXEC(PB)
  0C2A  4813 FFF0          SHIFT = 32 IF XSTATE(WORK) = 0
  0C2E  2133
  0C30  C8A0 0020
  0C34  2418               IF XSTATE(WORK)&8 = 0   /EXEC NOT ACTIVE
  0C36  4413 FFF0
  0C3A  2139
  0C3C  2418                 XSTATE(WORK) = XSTATE(WORK)+8 /IT IS NOW
  0C3E  6113 FFF0
  0C42  4033 0012            XB(WORK) = WORK
  0C46  4140 0AD6            SCHEDULE
  0C4A  08DC                 PUT = GET             /?
                           FINISH
  0C4C  230C             ELSE IF WORK=7 /BEL
  0C4E  C930 0007
  0C52  2139
  0C54  4832 0004           WORK = EXEC(PB)
  0C58  4833 FFFE           WORK = XINT(WORK)
  0C5C  2334                IF WORK#0
  0C5E  4033 0000              W(WORK) = WORK
  0C62  08DC                   PUT = GET   /?
                            FINISH
                         FINISH
  0C64  4300 0D84        JUMP TPIDLE
                       FINISH
  0C68  08BB       KB1:JUMP TPIDLE IF PROM < 0     /EOT RECEIVED ->
  0C6A  4210 0D84
  0C6E  C9B0 7FFF     JUMPS KB5 IF PROM=X'7FFF' /SINLGE SHOT MODE
  0C72  233D
  0C74  0866 2332      TYPE SYM IF SYM # 0
  0C78  0140
  0C7A  083B           WORK = PROM
  0C7C  2338           JUMPS KB5 IF WORK = 0





                       CYCLE
  0C7E  D363 0000        SYM = B(WORK)
  0C82  0866 2334        JUMPS KB5 IF SYM = 0
  0C86  0140             TYPE SYM
  0C88  2631             WORK = WORK+1
  0C8A  2206           REPEAT
  0C8C  083D       KB5:WORK = PUT
  0C8E  241F 0418  KB6:JUMPS KB7 IF DEV&15#2
  0C92  C910 0002
  0C96  2135

  0C98  2411 041B      TEMP = 1&PROM
  0C9C  DE81 0B66      OC DEV,TTDISREAD(TEMP)      /DISARM FOR MODE CHANGE
  0CA0  2460       KB7:SYM = 0
  0CA2  0813 0B1C      JUMP KBIDLE IF WORK-GET > MAX /BUFFER FULL ->
  0CA6  091F
  0CA8  4220 0D7A
  0CAC  4140 0B68      CALL KREAD
  0CB0  C960 0020      JUMP KB7(B(#KBTAB(SYM))) IF SYM < 32
  0CB4  2315
  0CB6  D316 0E5A
  0CBA  4301 0CA0
  0CBE  C960 007F      IF SYM = ERASE
  0CC2  213A
  0CC4  093D             JUMP KB7 IF WORK = PUT    /LINE EMPTY ->
  0CC6  4330 0CA0
  0CCA  2731             WORK = WORK-1
  0CCC  C860 005C        TYPE '\'
  0CD0  0140
  0CD2  4300 0C8E        JUMP KB6
                       FINISH
  0CD6  C960 0061      SYM = SYM-SHIFT IF SYM>='a' AND SYM<='z'
  0CDA  2115
  0CDC  C960 007A
  0CE0  2122 0B6A
  0CE4  2671           TTSYMS = TTSYMS+1
  0CE6  4140 0B56  KB77:PUTSYM
  0CEA  C9B0 7FFF     IF PROM=X'7FFF' /SINGLE-SHOT READS
  0CEE  2135
  0CF0  2470             TTSYMS = 0
  0CF2  2460             SYM = 0
  0CF4  4300 0D7A        JUMP KBIDLE
                      FINISH
  0CF8  241F 0418     IF DEV&15#2
  0CFC  C910 0002
  0D00  2336

  0D02  2771             TTSYMS = TTSYMS-1
  0D04  C3B0 0001        TYPE SYM IF PROM&1=0
  0D08  2132
  0D0A  0140

                      FINISH
  0D0C  4300 0CA0      JUMP KB7
                   KBCAN:
  0D10  C860 0040      TYPE '@'
  0D14  0140
  0D16  246D           TYPE RT
  0D18  0140
  0D1A  246A           SYM = LF
  0D1C  4300 0C68      JUMP KB1





                   KBSO:
  0D20  C8A0 0020      SHIFT = 32
  0D24  4300 0CA0      JUMP KB7
                   KBSI:
  0D28  24A0           SHIFT = 0
  0D2A  4300 0CA0      JUMP KB7
                   KBDLE:
  0D2E  4140 0B68      CALL KREAD
  0D32  4300 0CE6      JUMP KB77
                   KBLF:
  0D36  4140 0B54      PUTNL
  0D3A  246A          TYPE LF
  0D3C  0140
  0D3E  08D3           PUT = WORK
  0D40  24B0           PROM = 0
  0D42  4140 0AC8      SIGUSER
  0D46  4300 0C8C      JUMP KB5
                   KBEOT:
  0D4A  C860 0024      TYPE '$'
  0D4E  0140
  0D50  246D           TYPE RT
  0D52  0140
  0D54  246A 25B1      SYM = LF; PROM = -1         /QUA DEVINF
  0D58  4300 0D82      JUMP KB9
                   KBRT:
  0D5C  241F 0418     TYPE 13 IF DEV&15#2
  0D60  C910 0002
  0D64  2333
  0D66  246D
  0D68  0140

  0D6A  4140 0B54      PUTNL
  0D6E  246A           SYM = LF
  0D70  2470           TTSYMS = 0
  0D72  2304           JUMPS KBIDLE
                   KBETX:
  0D74  4140 0B56      PUTSYM
  0D78  2460           SYM = 0
                   KBIDLE:
  0D7A  C9B0 7FFF      PROM = 0 IF PROM#X'7FFF' /KEEP IN GMODE
  0D7E  2332 24B0

  0D82  08D3       KB9:PUT = WORK
                   TPIDLE:
  0D84  4140 0AC8      SIGUSER
  0D88  4830 00BC      WORK = WQ
  0D8C  2337           IF WORK # 0
  0D8E  4813 0006        WQ = LINK(WORK)           /?
  0D92  4010 00BC
  0D96  4140 0AD6        SCHEDULE
                       FINISH
  0D9A  241F 0418      IF DEV&15=2
  0D9E  C910 0002
  0DA2  2134

  0DA4  DE80 0B65        OC DEV,TTLISTEN
  0DA8  2307           ELSE
  0DAA  C480 000F        DEV = DEV&15+X'80'
  0DAE  CA80 0080
  0DB2  DE80 0562        OC DEV,ENABLE
                       FINISH





  0DB6  D0B5 0006      STM R11,W(CB+6)             /PROM,GET,PUT,BUFF,MAX
  0DBA  D1B2 001E      LM R11,R11(PB)              /LOAD FOR STORING
  0DBE  4110 0B28      IDLE
                   TTENT:
  0DC2  0855           JUMP KBINT IF CB = 0        /SPONTANEOUS INPUT
  0DC4  4330 0BF2
  0DC8  D1B5 0006      LM R11,W(CB+6)
  0DCC  0959           JUMP KB1 IF CB = KCB        /KEYBOARD
  0DCE  4330 0C68

                   /TELEPRINTER
  0DD2  09CD       TP1:JUMP TPIDLE IF GET = PUT    /BUFF EMPTY ->
  0DD4  4330 0D84
  0DD8  083C 043F      WORK = B(GET&MAX+BUFF)
  0DDC  0A3E
  0DDE  D333 0000
  0DE2  26C1           GET = GET+1
  0DE4  C930 0002      JUMP TP4 IF WORK = STX      /CLEARS PRINT CANCEL
  0DE8  4330 0E50
  0DEC  0866 201E      JUMP TP1 IF SYM < 0
  0DF0  2322           TYPE SYM IF SYM > 0
  0DF2  0140
  0DF4  0863           SYM = WORK
  0DF6  C970 0048      IF TTSYMS >= TTLENGTH AND PROM#X'7FFF'
  0DFA  2119
  0DFC  C9B0 7FFF
  0E00  2336
  0E02  C960 0020        IF SYM >= 32
  0E06  2113
  0E08  246A 27C1          SYM = NL; GET = GET-1
                         FINISH
                       FINISH
  0E0C  C960 0005      IF SYM = ENQ
  0E10  4230 0E36
  0E14  241F 0418        OC DEV,TTDISREAD IF DEV&15=2
  0E18  C910 0002
  0E1C  2133
  0E1E  DE80 0B66
  0E22  4140 0B68        CALL KREAD
  0E26  4815 0000        R1(USER(CB)-S) = SYM IF USER(CB) < 0
  0E2A  2315
  0E2C  CB10 8000
  0E30  4061 000A
  0E34  246A             SYM = NL
                       FINISH
  0E36  C960 000A      JUMPS TP4 IF SYM = NL
  0E3A  233B
  0E3C  0140           TYPE SYM
  0E3E  0866 2336      IF SYM # 0                  /BREAK-IN
  0E42  246D             SYM = RT; CALL TY2        /ENSURE RT PRINTED
  0E44  4140 0BBE
  0E48  C860 800A        SYM = LF+S                /NEG
                       FINISH
  0E4C  4300 0DD2      JUMP TP1
  0E50  246D       TP4:TYPE RT
  0E52  0140
  0E54  246A           SYM = LF
  0E56  4300 0DD2      JUMP TP1

                   KBTAB:
  0E5A  0000 00D4  B   0, 0, 0, #KBETX-#KB7, #KBEOT-#KB7, 0, 0, 0,





  0E5E  AA00 0000
  0E62  0000 9600      0, 0, #KBLF-#KB7, 0, 0, #KBRT-#KB7, #KBSO-#KB7, #KBSI-#KB7,
  0E66  00BC 8088
  0E6A  8E00 0000      #KBDLE-#KB7, 0, 0, 0, 0, 0, 0, 0,
  0E6E  0000 0000
  0E72  7000 0000      #KBCAN-#KB7, 0, 0, 0, 0, 0, 0, 0
  0E76  0000 0000

                   $END TELETYPE

























































                   $BEGIN CARD READER & DEVICE ERROR REPORTER
                   $DEF DEV=R8, CRTMP2=R9, CRCNT=R10, CRTMP=R11

                   /DEVICE ERROR REPORT
                   DERENT:
  0E7A  48B5 0006      CRTMP = DEVINF(CB)
  0E7E  9DB3           SS CRTMP,WORK               /STATUS
  0E80  4805 0004      AC = NAM(CB)&X'7FFF'
  0E84  C400 7FFF
  0E88  4140 0AE4      REPORT
  0E8C  E1A0 0005      PSYM ENQ
  0E90  D330 0563      WORK = RETRANS
  0E94  C410 005F      IF TEMP&95 = 'E'
  0E98  C910 0045
  0E9C  2135
  0E9E  4140 0B1A        SETEOT
  0EA2  D330 0564        WORK = CLERR
                       FINISH
  0EA6  9EB3           OC CRTMP,WORK
                   CRIDLE:
  0EA8  4140 0AC8      SIGUSER
  0EAC  4110 0B28      IDLE
  0EB0  4300 0E7A      JUMP DERENT

                   $END CARD-READER

                   $END STREAM HANDLERS







































                   $BEGIN FILESTORE SERVICER PROCESS
                      $DEF AC=R0, SYM=R1, PTR=R7, COUNT=R6
                      $DEF DEV=R8
                      $TEMP R4

                   FCLAI0:
  0EB4  E140 01F0        CLAIM #FSR /GET LINKS
  0EB8  E140 01F8        CLAIM #FST
  0EBC  D020 005C        STM R2,REFSAVE(4) /SAVE REGISTERS
  0EC0  4850 05C6        CB = PBASE
  0EC4  D1E5 0028        LM R14,INAD(CB) /SAVE SELECTED IO
  0EC8  D0E0 0058        STM R14,REFSAVE
  0ECC  D1E0 0F02        LM R14,LKS /SET TO LR5,LT5
  0ED0  D0E5 0028        STM R14,INAD(CB)
  0ED4  C8F0 0040        R15 = X'40' /BINARY
  0ED8  D2F0 01F6        B(#FSR+6) = R15
  0EDC  26F1             R15 = R15+1
  0EDE  D2F0 01FE        B(#FST+6) = R15
  0EE2  D1E0 0074        LM R14,REFSAVE(28)
  0EE6  E1D0             EXIT

                   FRELE0:
  0EE8  4850 05C6        CB = PBASE
  0EEC  D1E0 0058        LM R14,REFSAVE /RESET SELECTED IO
  0EF0  D0E5 0028        STM R14,INAD(CB)
  0EF4  D120 005C        LM R2,REFSAVE(4) /RESOTRE REGISTERS
  0EF8  E150 01F0        RELEASE #FSR
  0EFC  E150 01F8        RELEASE #FST
  0F00  E1D0             EXIT

  0F02  01F0 01F8  LKS:  #FSR, #FST

                   PUSER0:
  0F06  E1A0 002C        PSYM ','
  0F0A  4810 05C6        SYM = PBASE
  0F0E  4811 0004        SYM = EXEC(SYM)
  0F12  4801 FFFC        AC = UFUNO(SYM)
  0F16  E1F3             PHEX
  0F18  E1A0 002C        PSYM ','
  0F1C  E1D0             EXIT

                   RESPO0:
  0F1E  E1FC             NEWLINE
  0F20  E180 002D        MATCH '-'
  0F24  2135             IF ZERO
  0F26  E1F2                RHEX; AC = AC!S
  0F28  C600 8000
  0F2C  2302             ELSE
  0F2E  E1F2                RHEX
                         FINISH
                         CYCLE
  0F30  E190 0000           RSYM
  0F34  C910 000A        REPEAT IF SYM>NL
  0F38  2024
  0F3A  E1D0             EXIT

                   DKENT:
  0F3C  E1EA             FCLAIM /GET LINKS
  0F3E  4850 0062        CB = REFSAVE(10) /ARGUMENT CB
  0F42  4845 0004        IF NAM(CB)=1 /RESET
  0F46  C940 0001





  0F4A  4230 0F7C
  0F4E  2442                NAM(CB) = 2
  0F50  4045 0004
  0F54  E1A0 0055           PSYM 'U'; PSYM ','
  0F58  E1A0 002C
  0F5C  4805 0010           AC = DIRPOS(CB); PHEX
  0F60  E1F3
  0F62  E1EC                RESPONSE
  0F64  0800                JUMP FAIL IF AC<0
  0F66  4210 1026
  0F6A  2440                GET(CB) = 0; PUT(CB) = 0; DEVINF(CB) = 0
  0F6C  4045 0008
  0F70  4045 000A
  0F74  4045 0006
  0F78  4300 1006        ELSE IF NAM(CB)<0 /WRITE
  0F7C  4845 0004
  0F80  4310 0FC8
  0F84  E1A0 0059           PSYM 'Y'
  0F88  E1A0 002C           PSYM ','
  0F8C  4805 0010           AC = DIRPOS(CB); PHEX /XNO
  0F90  E1F3
  0F92  E1FA 2C32           PTEXT; B ',200', 0
  0F96  3030 0000
  0F9A  E1EC                RESPONSE
  0F9C  0800                JUMP FAIL IF AC<0
  0F9E  4210 1026
  0FA2  C800 0200           AC = 512
  0FA6  4875 000C           PTR = BUFF(CB)
  0FAA  C880 0098           DEV = FSLT
                            CYCLE
                               CYCLE
  0FAE  9D81                      SS DEV,TEMP
  0FB0  20F1                   REPEAT IF 15
  0FB2  DA87 0000              WD DEV,B(PTR)
  0FB6  2671                   PTR = PTR+1
  0FB8  2701                   AC = AC-1
  0FBA  2026                REPEAT IF AC>0
  0FBC  C840 0200           GET(CB) = GET(CB)+512
  0FC0  6145 0008
  0FC4  4300 1006        ELSE
  0FC8  E1A0 0058           PSYM 'X'
  0FCC  E1A0 002C           PSYM ','
  0FD0  4805 0010           AC = DIRPOS(CB); PHEX /XNO
  0FD4  E1F3
  0FD6  E1EC                RESPONSE
  0FD8  0800                JUMP FAIL IF AC<0
  0FDA  4210 1026
  0FDE  4330 1020           JUMP ENDIT IF AC=0
  0FE2  6105 000A           PUT(CB) = PUT(CB)+AC
  0FE6  C900 0200           SETEOT IF AC<512
  0FEA  2313
  0FEC  4140 0B1A
  0FF0  4875 000C           PTR = BUFF(CB)
  0FF4  C880 0088           DEV = FSLR
                            CYCLE
                               CYCLE
  0FF8  9D81                      SS DEV,TEMP
  0FFA  20F1                   REPEAT IF 15
  0FFC  DB87 0000              RD DEV,B(PTR)
  1000  2671                   PTR = PTR+1
  1002  2701                   AC = AC-1





  1004  2026                REPEAT IF AC>0
                         FINISH
  1006  4140 0AC8  DRUN: SIGUSER
  100A  E1EB             FRELEASE
  100C  C200 1010        LPSW W(*+4)
  1010  0000 1014        0, *+2 /INTS OFF
  1014  4110 0B28        IDLE
  1018  C200 101C        LPSW W(*+4)
  101C  4000 0F3C        USR, #DKENT /INTS ON AGAIN
  1020  4140 0B1A  ENDIT:SETEOT
  1024  220F             JUMP DRUN
  1026  0830       FAIL: WORK = AC
  1028  C800 2878        AC = X'2878'
  102C  4140 0AE4        REPORT
  1030  E1FC             NEWLINE
  1032  4140 0B1A        SETEOT
  1036  4300 1006        JUMP DRUN

                   $END FILESTORE HANDLER

                   $END DEVICE HANDLERS













































                   $BEGIN STREAM CONTROL ROUTINES

                   $TEMP R1
                   $DEF AC=R0, TEMP=R1, SYM=TEMP, WORK=R3
                   $DEF OUT=W(R4), CALL=BAL R4
                   $DEF ON1=R10, ON2=R11, N1=R12, N2=R13, N3=R14
                   $DEF N4=R15, SIZE=R9, DCB=R7, PERMS=R8

                   DKREF:
  103A  E140 0250        CLAIM #DCB0 /GET DCB
  103E  0A01             AC = AC+TEMP /DCB+START
  1040  E1EA             FCLAIM /GET FSTORE LINKS
  1042  0830             WORK = AC /SAVE
  1044  2578 0470        DCB = \7&AC
  1048  C810 02F8        SERVER(DCB) = #DBASE0
  104C  4017 0002
  1050  2410             GET(DCB) = 0
  1052  4017 0008
  1056  4017 000A        PUT(DCB) = 0
  105A  4017 0006        DEVINF(DCB) = 0 /NO EOF
  105E  0810 911F        NAM(DCB) = AC<<15 /NEG FOR OUTPUT
  1062  4017 0004
  1066  0810 911F        IF AC<<15<0 /OUTPUT
  106A  2314
  106C  E1A0 0054           PSYM 'T'
  1070  2303             ELSE
  1072  E1A0 0053           PSYM 'S'
                         FINISH
  1076  E1E8             PUSERNO
  1078  E1F9             PNAME
  107A  4817 0004        IF NAM(DCB)<0
  107E  231D
  1080  E1A0 002C           PSYM ','
  1084  0808 E1F5           AC = PERMS; PWORD; PSYM 'A' IF PERMS#0
  1088  0888 2333
  108C  E1A0 0041
  1090  E1A0 002C           PSYM ','
  1094  0809 E1F3           AC = SIZE; PHEX
                         FINISH
  1098  E1EC             RESPONSE
  109A  4007 0010        DIRPOS(DCB) = AC
  109E  0800 2323        IF AC>0
  10A2  0803                AC = WORK
  10A4  2303             ELSE
  10A6  E157 0000           RELEASE DCB
                         FINISH
  10AA  E1EB             FRELEASE
  10AC  0800             IF AC<0
  10AE  4310 10D8
  10B2  0830                WORK = AC
  10B4  E1FA 5472           PTEXT; B 'Trouble (', 0
  10B8  6F75 626C
  10BC  6520 2800
  10C0  0803                AC = WORK&X'7FFF'; PHEX
  10C2  C400 7FFF
  10C6  E1F3
  10C8  E1FA 2920           PTEXT; B ') with ', 0
  10CC  7769 7468
  10D0  2000
  10D2  E1F9 E1FC           PNAME; NEWLINE
  10D6  2508                AC = \7





                         FINISH
  10D8  2518 0410        TEMP = \7&AC
  10DC  0B01             AC = AC-TEMP
  10DE  E1D0             EXIT

                   DCLOUT:
  10E0  E1EA             FCLAIM
  10E2  08D0             R13 = AC
  10E4  2578 0470        DCB = \7&AC
  10E8  48F7 000A        R15 = PUT(DCB)-GET(DCB)
  10EC  4BF7 0008
  10F0  4330 1122        IF R15#0
  10F4  E1A0 0059           PSYM 'Y'; PSYM ','
  10F8  E1A0 002C
  10FC  4807 0010           AC = DIRPOS(DCB); PHEX; PSYM ','
  1100  E1F3
  1102  E1A0 002C
  1106  080F E1F3           AC = R15; PHEX
  110A  E1EC                RESPONSE
  110C  0800 211A           IF AC>=0
  1110  48E7 000C              R14 = BUFF(DCB)
                               CYCLE
  1114  D31E 0000                 SYM = B(R14); PSYM SYM
  1118  E1A1 0000

  111C  26E1 27F1                 R14 = R14+1; R15 = R15-1
  1120  2026                   REPEAT IF R15>0
                            FINISH
                         FINISH
  1122  080D             AC = R13
  1124  E1EB             FRELEASE
                   DCLIN:
  1126  E1EA             FCLAIM
  1128  2578 0470        DCB = \7&AC
  112C  48F7 0006        R15 = DEVINF(DCB)
  1130  2114             IF R15>=0
  1132  E1A0 004B           PSYM 'K'
  1136  2303             ELSE
  1138  E1A0 0048           PSYM 'H'
                         FINISH
  113C  E1A0 002C        PSYM ','
  1140  4807 0010        AC = DIRPOS(DCB); PHEX /XNO
  1144  E1F3
  1146  E1EC             RESPONSE
  1148  E157 0000        RELEASE DCB
  114C  E1EB             FRELEASE
  114E  E1D0             EXIT

                   /FIND DEVICE CB AD
                   /TEMP <- CB AD
                   $DEF DEVREF=BAL R15,W(*)
  1150  48E0 05C6      R14 = XID(EXEC(PBASE))
  1154  48EE 0004
  1158  D3EE FFF3
  115C  08C0 91CF     N1 = AC<<15
  1160  C9D0 8020      IF N2 = X'8020'
  1164  2137
  1166  C8DE 452C        N2 = R14+X'452C'
  116A  08CC 2313        N2 = R14+X'7F9C' IF N1 < 0
  116E  C8DE 7F9C
                       FINISH





  1172  C810 01F0      TEMP = #LKCB0
                       CYCLE
  1176  49D1 0004        JUMP W(R15) IF NAM(TEMP) = N2
  117A  433F 0000
  117E  2618             TEMP = TEMP+8
  1180  C910 0200        TEMP = TEMP+8 IF TEMP > #CRCB
  1184  2322 2618
  1188  C910 0250      REPEAT IF TEMP < #DCB0
  118C  201B

                   REF7:
  118E  E1FA 5472     PTEXT; B 'Trouble with ', 0
  1192  6F75 626C
  1196  6520 7769
  119A  7468 2000
  119E  080D E1F5      AC = N2; PWORD
  11A2  E1FC           NEWLINE
  11A4  2511           TEMP = -1
  11A6  E1D0           EXIT

                   /REFERENCE STREAM
                   /R8=PERMS,R9=SIZE,R10-R15=NAME
                   /TEMP <- CB AD (NEG IF ERR)
                   REF0:
  11A8  C400 0007      AC = AC&7                   /ENSURE SLOT VALUE OK
  11AC  08CC          JUMP DKREF IF N1#0
  11AE  4230 103A
  11B2  081D           TEMP = N2
  11B4  2132 E1D0      EXIT IF TEMP = 0            /NULL
  11B8  CA10 A880      TEMP = TEMP-X'5780'
  11BC  2132 E1D0      EXIT IF TEMP = 0            /DITTO
  11C0  C9D0 4D80      IF N2=X'4D80'
  11C4  2135
  11C6  25C2             N1 = X'FFFE' /PRINTER SPOOL
  11C8  24D0             N2 = 0
  11CA  4300 103A        JUMP DKREF
                      FINISH
  11CE  41F0 1150      DEVREF
  11D2  08F1           R15 = TEMP
  11D4  D31F 0006     TEMP = DEVSTAT(R15)\AC&1
  11D8  0710
  11DA  C410 0001
  11DE  4230 118E     JUMP REF7 IF TEMP#0 /WRONG DIRN
  11E2  C9F0 0210      IF R15 < #TCB0              /DEDICATED DEVICE
  11E6  4310 120E
  11EA  481F 0000        IF USER(R15) # PBASE
  11EE  4910 05C6
  11F2  2333
  11F4  E14F 0000          CLAIM R15
                         FINISH
  11F8  D31F 0006        TEMP = DEVSTAT(R15)
  11FC  C410 0001        TEMP = TEMP&1
  1200  C9E0 FFFF        TEMP = TEMP!X'40' IF N3 = -1   /BINARY
  1204  2133
  1206  C610 0040
  120A  D21F 0006        DEVSTAT(R15) = TEMP
                       FINISH
  120E  081F 25F1      TEMP = R15;  R15 = -1       /UNKNOWN SIZE
  1212  E1D0           EXIT
                   /REFERENCE INPUT STREAM
                   RIN0:





  1214  9101           AC = AC<<1
  1216  2303           JUMPS REFIO0

                   /REFERENCE OUTPUT STREAM
                   ROUT0:
  1218  9101 2601      AC = AC<<1+1

                   /REFERENCE STREAM
                   REFIO0:
  121C  E1E1           REFER
  121E  0610           TEMP = TEMP!AC
  1220  4210 1360      JUMP STOP0 IF TEMP < 0
  1224  E1C1 8000      SELECT TEMP+S               /ATTACH
  1228  C410 FFF8      TEMP = TEMP&(\7)
  122C  E1D0           EXIT

                   /REFERENCE ALL STREAMS
                   /R6= AD OF STREAMS
                   REFL0:
  122E  D186 0000      LM PERMS,W(R6)                 /INPUT 1
  1232  2402 E1E3      AC = 2; REFIO
  1236  D186 0010      LM PERMS,W(R6+16)              /INPUT 2
  123A  2404 E1E3      AC = 4; REFIO
  123E  D186 0020      LM PERMS,W(R6+32)              /INPUT 3
  1242  2406 E1E3      AC = 6; REFIO
  1246  D186 0030      LM PERMS,W(R6+48)              /OUTPUT 1
  124A  2403 E1E3      AC = 3; REFIO
  124E  D186 0040      LM PERMS,W(R6+64)              /OUTPUT 2
  1252  2405 E1E3      AC = 5; REFIO
  1256  D186 0050      LM PERMS,W(R6+80)              /OUTPUT 3
  125A  2407 E1E3      AC = 7; REFIO
  125E  E1D0           EXIT

                   /SIMULATE EOT
                   SEOT0:
  1260  41F0 1150      DEVREF                      /FIND DEVICE AD
  1264  08F1           R15 = TEMP
  1266  C9F0 0210      JUMP REF7 IF R15 >= #TCB0   /TT ->
  126A  4310 118E
  126E  481F 0006      DEVINF(R15) = DEVINF(R15)!S
  1272  C610 8000
  1276  401F 0006
  127A  48EF 0000      R14 = USER(R15)
  127E  231D           IF R14 < 0
  1280  CAE0 8000        R14 = R14-S
  1284  40EF 0000        USER(R15) = R14
  1288  48F0 05C6        R15 = PBASE
  128C  481F 0006        LINK(R14) = LINK(R15)
  1290  401E 0006
  1294  40EF 0006        LINK(R15) = R14
                       FINISH
  1298  E1D0           EXIT

                   /CLOSE INPUT STREAM
                   CLIN0:
  129A  9101           AC = AC<<1
  129C  2303           JUMPS CLOS0

                   /CLOSE OUTPUT STREAM
                   CLOUT0:
  129E  9101 2601      AC = AC<<1+1






                   /CLOSE STREAM
                   CLOS0:
  12A2  C400 0007      AC = AC&7                   /ENSURE SLOT VALUE OK
  12A6  0810           TEMP = AC; SELECT TEMP      /SELECT STREAM
  12A8  E1C1 0000
  12AC  E1C1 4000      SELECT TEMP+X'4000'         /DETACH
  12B0  0A01           AC = AC+TEMP                /SAVE CB AD
  12B2  C300 0001      THI AC,1
  12B6  213B           IF ZERO                     /INPUT
  12B8  C910 0250        JUMP DCLIN IF TEMP>=#DCB0
  12BC  4310 1126
  12C0  E170 0000        RESET 0
  12C4  E1C0 0000        SELECT 0                  /INPUT 0
  12C8  4300 1308      ELSE
  12CC  4811 0006        IF DEVINF(TEMP) >= 0
  12D0  4210 12F8
  12D4  2518 0410          TEMP = \7&AC
  12D8  C910 0250         JUMP DCLOUT IF TEMP>=#DCB0
  12DC  4310 10E0
  12E0  C910 0200          IF TEMP < #CRCB        /NOT TT
  12E4  2319
  12E6  4811 0006            PSYM EOT IF DEVINF(TEMP)<<1 > 0 /EOT UNLESS BIN
  12EA  9111 2323
  12EE  E1A0 0004
  12F2  E1A0 FFFF            PSYM -1             /DUMMY TO FLUSH
                           FINISH
  12F6  2307             ELSE
  12F8  2518 0410           TEMP = \7&AC
  12FC  C910 0250           JUMP DCLOUT IF TEMP>=#DCB0
  1300  4310 10E0
                         FINISH
  1304  E1C0 0001        SELECT 1                  /OUTPUT 0
                       FINISH
  1308  2518 0410      TEMP = \7&AC; RELEASE TEMP
  130C  E151 0000
  1310  E1D0           EXIT

                   / MACHINE INTERRUPT

                   ILLEG:
  1312  9522             EPSR R2,R2 /GET INT ADDRESS
  1314  4832 0002        R3 = W(R2+2) /GET USERS ADDRESS
  1318  C810 4000        R1 = USR /RESET STATUS
  131C  9521             EPSR R2,R1
  131E  C930 2200        JUMP W(*) IF R3<X'2200' AND R3>4 /SYSTEM - FATAL
  1322  2314
  1324  C930 0004
  1328  2025
  132A  4840 05C6        R4 = PBASE; NP(R4) = #NP(R4) /CLEAR NEST
  132E  C814 002C
  1332  4014 002C
  1336  E1C0 0001        SELECT 0+0+1
  133A  E1FA 496C        PTEXT; B 'Illegal at ', 0
  133E  6C65 6761
  1342  6C20 6174
  1346  2000
  1348  0803 E1F3        AC = R3; PHEX; NEWLINE
  134C  E1FC

  134E  E1C0 0001  ABDN:  SELECT 1; PTEXT; B'*A*', NL, 0





  1352  E1FA 2A41
  1356  2A0A 0000
  135A  C840 0250        R4 = #DCB0; JUMPS STOP1
  135E  2303

                   /CLOSE STREAMS AND STOP
                   STOP0:
  1360  C840 7FFF        R4 = X'7FFF' /STOP FLAG
                   STOP1:
  1364  4830 05C6      R3 = PBASE; NP(R3) = #NP(R3)
  1368  C813 002C
  136C  4013 002C
  1370  2432           R3 = 2                      /CLOSE STREAMS
                       CYCLE
  1372  E1C3 2000        SELECT R3+X'2000'
  1376  4851 0006        R5 = DEVINF(R1)!X'8000'
  137A  C650 8000
  137E  0914 2113        DEVINF(R1) = R5 IF R1>=R4 /ABANDON DISC
  1382  4051 0006
  1386  0803 E1E0        AC = R3; CLOSE
  138A  2631             R3 = R3+1
  138C  C930 0008      REPEAT IF R3 # 8
  1390  203F
  1392  E150 0092        RELEASE #BG2 /RELEASE CORE AREAS
  1396  C830 0250        R3 = #DCB0
                         CYCLE
  139A  C930 02F8           XSTOP 0 IF R3>=#DBASE0
  139E  2113
  13A0  E100 0000
  13A4  E153 0000           RELEASE R3
  13A8  CA30 0018           R3 = R3+24
  13AC  2209             REPEAT

                   $END STREAM CONTROL
































                   $BEGIN INOUT SUBROUTINES

                   $TEMP R1
                   $DEF AC=R0, TEMP=R1, SYM=TEMP   /**AC:SYM**
                   $DEF CLEARCC=X'0511'            /CLHR R1,R1

                   /IGNORE PENDING INPUT
  13AE  E190 0000  IGR:RSYM
  13B2  E1B0 0000  IG0:PROMPT 0                    /DUMMY PROMPT
  13B6  22F4           JUMP IGR IF CLEAR
  13B8  E1D0           EXIT

                   /SKIP SPACES
  13BA  E180 0020  SK0:MATCH ' '
  13BE  2232           JUMP SK0 IF ZERO
  13C0  E1D0           EXIT

                   /TEST DIGIT
                   /READ AND MAP TO 0:9 IF SO
  13C2  E180 FFFF  TD0:NSYM
  13C6  C910 0030      IF SYM >= '0' AND SYM <= '9' /*CC NON-Z IF FALSE*
  13CA  2119
  13CC  C910 0039
  13D0  2126
  13D2  E190 0000        RSYM
  13D6  CA10 FFD0        SYM = SYM-'0'
  13DA  0511             CLEARCC
                       FINISH
  13DC  E1D0           EXIT

                   /TEST LETTER
                   /READ AND MAP TO 0:25 IF SO
  13DE  E180 FFFF  TL0:NSYM
  13E2  C910 0041      IF SYM >= 'A'
  13E6  211D
  13E8  C410 005F        SYM = SYM&95
  13EC  C910 005A        IF SYM <= 'Z'
  13F0  2128
  13F2  E190 0000          RSYM
  13F6  C410 005F          SYM = SYM&95-'A'
  13FA  CA10 FFBF
  13FE  0511               CLEARCC
                         FINISH
                       FINISH
  1400  E1D0           EXIT

                   /READ HEX
  1402  2400       RH0:AC = 0
                       CYCLE
  1404  E1FE             TESTDIG
  1406  233A             IF \ZERO
  1408  C410 005F          SYM = SYM&95
  140C  C910 0046          TESTLET IF SYM <= 'F'   /*CC NON-Z IF FALSE*
  1410  2122 E1FF
  1414  2332 E1D0          EXIT IF \ZERO
  1418  261A               SYM = SYM+10
                         FINISH
  141A  9104 0A01        AC = AC<<4+SYM
  141E  220D           REPEAT

                   /PRINT HEX





  1420  C810 8000  PH0:SYM = X'8000'               /MARKER
                       CYCLE
  1424  EB00 0004        RLL AC,4                  /ROTATE NEXT DIGIT TO SYM
  1428  0800 2132        EXIT IF AC = 0            /FINISHED ->
  142C  E1D0
  142E  2719             SYM = SYM-9
  1430  2322 2617        SYM = SYM+7 IF SYM > 0    /'A':'F'
  1434  E1A1 0039        PSYM SYM+'9'
  1438  2410             SYM = 0
  143A  220B           REPEAT

                   /READ PACKED WORD
  143C  E180 0024  RW0:  MATCH '$'
  1440  2133             IF ZERO
  1442  2501                AC = -1
  1444  E1D0                EXIT
                         FINISH
  1446  2400             AC = 0
  1448  E1FF       RW9:  TESTLET
  144A  4230 1454        JUMP RW1 IF \ZERO
  144E  2611             SYM = SYM+1
  1450  4300 147A        JUMP RW2
  1454  E1FE       RW1:  TESTDIG
  1456  4230 1462        JUMP RW3 IF \ZERO
  145A  CA10 001C        SYM = SYM+28
  145E  4300 147A        JUMP RW2
  1462  E180 003A  RW3:  MATCH ':'
  1466  4230 1472        JUMP RW4 IF \ZERO
  146A  C810 0027        SYM = 39
  146E  4300 147A        JUMP RW2
  1472  2410       RW4:  SYM = 0
  1474  0800 2132        EXIT IF AC=0 /NO WORD HERE AT ALL
  1478  E1D0
  147A  0A10       RW2:  SYM = SYM+AC
  147C  C500 0640        CLH AC,1600
  1480  2386             IF 8
  1482  DC00 14D8           MHU AC,C40
  1486  0801                AC = SYM
  1488  4300 1448           JUMP RW9
                         FINISH
  148C  0801             AC = SYM
  148E  E1D0             EXIT

                   /PRINT RADIX-40 WORD
  1490  0810 2400  PW0:  SYM = AC; AC = 0
  1494  C910 FFFF        SYM = 43200 IF SYM=-1
  1498  2133
  149A  C810 A8C0
  149E  4D00 14DA        DH AC,C1600
  14A2  D311 14DC        SYM = B(#TAB40(SYM))
  14A6  0811 2132        EXIT IF SYM=0
  14AA  E1D0
  14AC  E1A1 0000        PSYM SYM
  14B0  0810 2400        SYM = AC; AC = 0
  14B4  4D00 14D8        DH AC,C40
  14B8  D311 14DC        SYM = B(#TAB40(SYM))
  14BC  0811 2132        EXIT IF SYM=0
  14C0  E1D0
  14C2  E1A1 0000        PSYM SYM
  14C6  0810             SYM = AC
  14C8  D311 14DC        SYM = B(#TAB40(SYM))





  14CC  0811 2132        EXIT IF SYM=0
  14D0  E1D0
  14D2  E1A1 0000        PSYM SYM
  14D6  E1D0             EXIT
  14D8  0028       C40:  40
  14DA  0640       C1600:1600
  14DC  0041 4243  TAB40:B 0,'ABCDEFGHIJKLMNOPQRSTUVWXYZ$0123456789 :'
  14E0  4445 4647
  14E4  4849 4A4B
  14E8  4C4D 4E4F
  14EC  5051 5253
  14F0  5455 5657
  14F4  5859 5A24
  14F8  3031 3233
  14FC  3435 3637
  1500  3839 203A

                   /READ DECIMAL
  1504  2400       RD0:AC = 0
                       CYCLE
  1506  E1FE             TESTDIG
  1508  2332 E1D0        EXIT IF \ZERO
  150C  9101             AC = AC<<1
  150E  0A10             SYM = SYM+AC
  1510  9102 0A01        AC = AC<<2+SYM            /10*AC+SYM
  1514  2207           REPEAT

                   /PRINT DECIMAL
  1516  0810       PD0:SYM = AC
  1518  2134           IF SYM = 0
  151A  E1A0 0030        PSYM '0'
  151E  E1D0             EXIT
                       FINISH
  1520  2400           AC = 0; DH AC,C10000
  1522  4D00 1550
  1526  9101 2601      AC = AC<<1+1                /2*REM + FLAG
  152A  0811 2138      WHILE SYM = 0               /NUM < 10000
  152E  0810 2405        SYM = AC; AC = 5
  1532  9C00             MHU AC,AC                 /COMPLETE MULT BY 10
  1534  4D00 1550        DH AC,C10000
  1538  9101             AC = AC<<1
  153A  2208           REPEAT
                       CYCLE
  153C  E1A1 0030        PSYM SYM+'0'
  1540  0810 2405        SYM = AC; AC = 5
  1544  9C00             MHU AC,AC
  1546  4D00 1550        DH AC,C10000
  154A  9101             AC = AC<<1
  154C  2038           REPEAT IF AC # 0
  154E  E1D0           EXIT
  1550  2710       C10000:10000

                   /PRINT TEXT
  1552  4810 05C6  PT0:TEMP = PBASE
  1556  4801 002C      AC = NP(TEMP)-2
  155A  2702
  155C  4001 002C      NP(TEMP) = AC
  1560  0810           TEMP = AC
  1562  4801 0002      AC = W(TEMP+2)
  1566  0810       PT1:SYM = AC; SYM = B(SYM)
  1568  D311 0000





  156C  2601           AC = AC+1
  156E  0811 2334      IF SYM # 0
  1572  E1A1 0000        PSYM SYM
  1576  2208             JUMP PT1
                       FINISH
  1578  2601 9001      AC = AC+1>>1<<1             /EVEN UP
  157C  9101
  157E  0300           JUMP W(AC)

                   /NEWLINE
  1580  E1A0 000A  NL0:PSYM NL
  1584  E1D0           EXIT

                   /SPACE
  1586  E1A0 0020  SP0:PSYM ' '
  158A  E1D0           EXIT

                   /READ NAME

                   $DEF ON1=R10,ON2=R11,N1=R12,N2=R13,N3=R14,N4=R15
  158C  24A0 24B0  RN0:  ON1 = 0; ON2 = 0; N1 = 0
  1590  24C0

  1592  E180 002E        MATCH '.'
  1596  213C             IF ZERO
  1598  E1F4 08D0           RWORD; N2 = AC
  159C  2133                N2 = X'8020' IF N2=0
  159E  C8D0 8020
  15A2  24E0                N3 = 0
  15A4  E180 0023           MATCH '#'
  15A8  2132 25E1           N3 = -1 IF ZERO
  15AC  E1D0                EXIT
                         FINISH
  15AE  E1F4 08B0        RWORD; ON2 = AC
  15B2  E1F4             RWORD
  15B4  E180 002E        MATCH '.'
  15B8  213C             IF ZERO
  15BA  08AB 08B0           ON1 = ON2; ON2 = AC
  15BE  E1F4 08C0           RWORD; N1 = AC
  15C2  E1F4 08D0           RWORD; N2 = AC
  15C6  E1F4 08E0           RWORD; N3 = AC
  15CA  E1F4 08F0           RWORD; N4 = AC
  15CE  2307             ELSE
  15D0  08CB                N1 = ON2
  15D2  08D0                N2 = AC
  15D4  E1F4 08E0           RWORD; N3 = AC
  15D8  E1F4 08F0           RWORD; N4 = AC
                         FINISH
  15DC  E1D0             EXIT

                   /PRINT NAME
  15DE  C9C0 FFFE  PN0:  IF N1=X'FFFE' /PRINTER
  15E2  2135
  15E4  E1A0 002A           PSYM '*'
  15E8  4300 160C        ELSE
  15EC  08AA 2337           IF ON1#0
  15F0  080A E1F5              AC = ON1; PWORD
  15F4  080B E1F5              AC = ON2; PWORD
  15F8  E1A0 002E              PSYM '.'
                            FINISH
  15FC  080C E1F5           AC = N1; PWORD





  1600  080D E1F5           AC = N2; PWORD
  1604  080E E1F5           AC = N3; PWORD
  1608  080F E1F5           AC = N4; PWORD
                         FINISH
  160C  E1D0             EXIT
                   $END




























































                   $BEGIN STATE
                   /REPORT STATE OF CONTROL BLOCKS
                   /EXECUTIVE PROCEDURE
                   /PLACED HERE TO SIMPLIFY ACCESSING CBS
                   $TEMP R1
                   STAB:
  160E  6A40 00BC      X'6A40', #WQ, 0
  1612  0000
  1614  0DB4 0090     X'DB4', #BG1, 0
  1618  0000
  161A  0DB5 0092     X'DB5', #BG2, 0
  161E  0000
  1620  FF9D 01F0      -99, #LKCB0, 1<<8+8
  1624  0108
  1626  FF9D 0210      -99, #TCB0, 3<<8+16
  162A  0310
  162C  196C 0250      X'196C', #DCB0, 4<<8+24
  1630  0418

                   SLIM:
  1632  8898 8999  DTAB: B X'88',X'98',X'89',X'99',X'02', 0
  1636  0200

                   $DEF AC=R0
                   $DEF POS=R12, IDENT=R13, CB=R14
  1638  C8C0 160E  STATE:POS = #STAB
  163C  D1DC 0000  STAT1:LM R13,W(POS)
  1640  49EE 0000  STAT2:JUMP STAT9 IF USER(CB) = CB
  1644  4330 1666

  1648  080D           AC = IDENT
  164A  2123           AC = NAM(CB) IF AC <= 0
  164C  480E 0004
  1650  E1F5           PWORD
  1652  E1FD           SPACE
  1654  080E E1F3      AC = CB; PHEX
  1658  E1FA 3A20      PTEXT; B ': ',0
  165C  0000
  165E  480E 0000      AC = USER(CB); PHEX
  1662  E1F3
  1664  E1FC           NEWLINE
  1666  26D1       STAT9:IDENT = IDENT+1
  1668  D31C 0005      CB = CB+B(POS+5)            /INC AD
  166C  0AE1
  166E  CAF0 FF00      R15 = R15-X'100'
  1672  4220 1640      JUMP STAT2 IF R15 > 0
  1676  26C6           POS = POS+6
  1678  C9C0 1632      JUMP STAT1 IF POS # #SLIM
  167C  4230 163C
  1680  C8C0 1632      POS = #DTAB
                       CYCLE
  1684  D30C 0000        AC = B(POS)
  1688  0800 2132        STOP IF AC=0
  168C  E1EF
  168E  9D0E             SS AC,CB
  1690  E1F3             PHEX; PSYM '='
  1692  E1A0 003D
  1696  080E E1F3        AC = CB; PHEX; NEWLINE
  169A  E1FC
  169C  26C1             POS = POS+1
  169E  220D           REPEAT





                   $END





F                  ?<1700?
  16A0  0000 0000  B XENT-* $ 0
  16A4  0000 0000
  16A8  0000 0000
  16AC  0000 0000
  16B0  0000 0000
  16B4  0000 0000
  16B8  0000 0000
  16BC  0000 0000
  16C0  0000 0000
  16C4  0000 0000
  16C8  0000 0000
  16CC  0000 0000
  16D0  0000 0000
  16D4  0000 0000
  16D8  0000 0000
  16DC  0000 0000
  16E0  0000 0000
  16E4  0000 0000
  16E8  0000 0000
  16EC  0000 0000
  16F0  0000 0000
  16F4  0000 0000
  16F8  0000 0000
  16FC  0000 0000
                   $END ISYS

$ 1700
