$LIST -1
/BASIC I/O PACKAGE FOR ICL 7502
/Department of Computer Science
/Edinburgh University

$DEF NP=R4, SYM=R3
$DEF NL=10, EOT=4, BS=8, CAN=23
$DEF CURSOR=X'8000', SOM=X'4000'
$DEF FLASH=X'2000', BLANKED=X'1000'
$DEF LRDEV=X'C', LTDEV=X'E'
$DEF HOWL=X'4000', NOP=X'4001'
$DEF INSTREAM=W(R1+1), OUTSTREAM=W(R1+2), TOP=W(R1+3)
$DEF KIN=R1+4, VOUT=R1+8

$MACRO SWOP R                   /SWOP BYTES
SRC R,7,R
$END

$LOC 4
    #INT-1                      /LINK TO INTERRUPT SERVICE
TIMER:0
LRSTAT:0

KB1:
    -1; -1; 0; 0                /KPEND, KSYM, KREP, KMODE
KSPEC:
    0; 0; 0; 0
USER1:                          /USER 1 BASE
    12 $ 0                      /REGISTER SAVE AREA
    #LRSYM; #LPSYM              /MAKE GLOBAL
    #KRSYM-1                    /INSTREAM
    #VPSYM-1                    /OUTSTREAM
    X'4000'                     /TOP (VIDEO START AD)
/KEYBOARD INPUT (SINGLE LINE)
    #KB1; X'4780'; #KR0-2; 80   /KB,LBEG,ENTRY,COUNT
/VIDEO OUTPUT (SINGLE LINE)
    0; X'46E0'; #VP0-2; 80      /SPARE,LBEG,ENTRY,COUNT

BIT:
    X'8000', X'4000', X'2000', X'1000'
    X'800', X'400', X'200', X'100'
    X'80', X'40', X'20', X'10'
    X'8', X'4', X'2', X'1'

$BEGIN INTERRUPT HANDLER
$LOC X'100'

$TEMP R2,R3
$DEF ASP2=X'F888'_X'B111'       /ACCESS SCRATCHPAD 2
$DEF KBDEV=X'2B'
$DEF DEV=R4, CONTR=R5, DATA=R6, IPC=R7

INT:ASP2 R1,PC,R1               /GET USER PC
    R1 = R1-2                   /SUB 2 FOR RECOVER
    DUMP R0,R2,0                /SAVE AND SWITCH TO S0
    W(R0) = R1                  /UPDATE USER PC
    READSR DEV; HOWL            /GET REQUESTING DEVICE NO.
    DEV = DEV&X'3F'             /ONLY DEVICE NO.
    JUMP CLOCKH IF DEV = 0
    JUMP KEYH IF DEV = KBDEV
    JUMP LRH IF DEV = LRDEV
    JUMP LTH IF DEV = LTDEV
TERMINATE:
    READ CONTR,DEV; NOP
    WRITE CONTR,DEV; NOP
    CONTR = 1
    WRITEC CONTR,DEV; NOP

INTDIS:
    R0 = R0-14
    R1 = R0
    REC R1,R2,1                 /RESTORE AND SWITCH TO S1


/CLOCK
CLOCKH:
    WRITEC DEV,DEV; NOP         /CLEAR SR
    IF TIMER # 0
      TIMER = TIMER-1
/      JUMP KEYCLK IF TIMER = 0
    FINISH
    JUMP INTDIS

/LINK RECEIVER
LRH:
    JUMP TERMINATE

/LINK TRANSMITTER
LTH:
    JUMP TERMINATE


$BEGIN BASIC KEYBOARD HANDLER
$DEF KB=R8, WK=R9, VAL=R10, SLOT=R11
$DEF KPEND=W(KB), KSYM=W(KB+1), KREP=W(KB+2), KMODE=W(KB+3)

KEYH:
    READC CONTR,DEV; JUMP INTDIS /READ STATUS
    CONTR = CONTR&12            /GET WA AND WB BITS
    JUMP INTDIS IF CONTR # 0    /RESCAN?
    READ DATA,DEV; JUMP INTDIS /TIMESLOT AND KEYB BITS
    SLOT = DATA>>8&127
    KB = #KB1
    IF SLOT&64 # 0              /SPECIAL KEY
      VAL = KTAB(SLOT/2+32)
      SWOP VAL IF SLOT&1 = 0    /MS BYTE IF EVEN
    ELSE
      VAL = KTAB(SLOT)
      SWOP VAL IF KMODE < 0     /MS BYTE IF SHIFT KEY DOWN
    FINISH
    VAL = VAL&255
    IF VAL&128 # 0              /SPECIAL ACTION
      WK = VAL&15
      VAL = VAL>>4&3
      IF VAL # 0
        WK = BIT(WK); VAL = VAL+2
        IF DATA&16 # 0          /KEY DEPRESSED
          W(KB+VAL) = W(KB+VAL)!WK
        ELSE
          W(KB+VAL) = W(KB+VAL)&(\WK)
        FINISH
        JUMP INTDIS
      FINISH
      PC = PC+WK                /SWITCH ON SUB-GROUP
      JUMP INTDIS
      JUMP KLOCK
      JUMP KCTRL
    FINISH
    VAL = VAL&95 IF VAL >= 96 AND KMODE&2 # 0
    IF DATA&16 # 0              /KEY DEPRESSED
      KSYM = VAL
    ELSE
      KPEND = 0 IF KPEND&127 = VAL
    FINISH
    JUMP INTDIS
KLOCK:
    KMODE = KMODE!X'8000'       /SET SHIFT BIT
    JUMP INTDIS
KCTRL:
    KMODE = KMODE\2 IF DATA&16 # 0 /INVERT CASEMAP BIT
    JUMP INTDIS

/KEYBOARD CONVERSION TABLE
$DEF S=128
KTAB:
B    ' ','0', '!','1', '"','2', 35,'3',
    36,'4', '%','5', '&','6', 39,'7',
    '(','8', ')','9', '*',':', '+',';',
    S,S, S,S, S,S, S,S,
    S,S, S,S, S,S, S,S,
    S,S, S,S, S,S, S,S,
    S,S, S,S, S,S, S,S,
    '<',',', '=','-', '>','.', '?','/',
    'P','p', 'Q','q', 'R','r', 'S','s',
    'T','t', 'U','u', 'V','v', 'W','w',
    'X','x', 'Y','y', 'Z','z', '{','[',
    '|','\', '}',']', '~','^', 127,1,
    '`','@', 'A','a', 'B','b', 'C','c',
    'D','d', 'E','e', 'F','f', 'G','g',
    'H','h', 'I','i', 'J','j', 'K','k',
    'L','l', 'M','m', 'N','n', 'O','o',
    '0', '1', '2', '3',
    '4', '5', '6', '7',
    '8', '9', S, S,
    S, S, S, S,
    S, S, S, S,
    S, S, S, S,
    S, S, S, S,
    S, '-', '.', S,
    CAN, S, NL, S,
    S, S, S, S,
    S, S, S, S,
    S, S+1, S+16, S,
    S, NL, S, S,
    ' ', S, S, S,
    S+47, BS, S, S+46,
    S+2, S+45, S, S

$END KEYBOARD HANDLER

$END INTERRUPT HANDLER

$BEGIN INPUT-OUTPUT ROUTINES (USER LEVEL)

OUT:NP = NP-1
    R2 = NP
    REC R2,PC,1

/KEYBOARD
$TEMP R10,R11
$DEF TEMP=R10
$DEF C=R12, KB=R13, BEG=R14
$DEF COUNT=W(R2+1), KSYM=W(KB+1)
KNSYM:
    R3 = 0
    JUMP KRS
KRSYM:
    R3 = 1
KRS:R2 = KIN-1
    DUMP NP,R10,1
    REC R2,R13,1
    JUMP OUT
KR0:C = COUNT; COUNT = R3
    JUMP KR5 IF C # 80
KR1:C = 79
    CYCLE
      W(BEG+C) = ' '
      C = C-1
    REPEAT IF C # 0
KR2:W(BEG+C) = CURSOR+' '
    CYCLE
      SYM = KSYM
    REPEAT IF SYM < 0
    KSYM = -1
    IF SYM = BS
      IF C # 0
        W(BEG+C) = ' '
        C = C-1
      FINISH
      JUMP KR2
    FINISH
    JUMP KR1 IF SYM = CAN
    IF SYM # NL
      W(BEG+C) = SYM
      C = C+1
      JUMP KR2 IF C # 80
    ELSE
      W(BEG+C) = BLANKED+SYM
    FINISH
    C = 0
KR5:SYM = W(BEG+C)
    SYM = SYM&X'7F'
    IF COUNT # 0
      C = C+1
      C = 80 IF SYM = NL
    FINISH
KR9:COUNT = C
    NP = NP-6
    R2 = NP
    REC R2,R10,1

VPSYM:
    R2 = VOUT-1
    DUMP NP,R10,1
    REC R2,R13,1
    JUMP OUT
VP0:C = COUNT
    IF SYM # NL
      IF C = 80
        CYCLE
          C = C-1
          W(BEG+C) = ' '
        REPEAT IF C # 0
      FINISH
      W(BEG+C) = SYM
      C = C+1
    ELSE
      C = 80
    FINISH
    JUMP KR9

$TEMP R2
$REDEF TEMP=R2
LRSYM:
    CYCLE
      SYM = EOT; JUMP OUT IF KSPEC = 3
      TEMP = LRDEV
      READC SYM,TEMP; NOP       /WAIT FOR READY SET
    REPEAT IF SYM&2 = 0
    READ SYM,TEMP; NOP
    SYM = SYM&X'7F'
    JUMP OUT


LPSYM:
    W(NP+1) = SYM
    CYCLE                       /WAIT FOR BUSY CLEAR
      JUMP OUT IF KSPEC = 5
      TEMP = LTDEV
      READC SYM,TEMP; NOP
      JUMP W(X'400') IF SYM&1 # 0
    REPEAT IF SYM&2 # 0
    SYM = W(NP+1)
    WRITE SYM,TEMP; NOP
    JUMP OUT

$END

$MACRO NEXTSYM                  /KEYBOARD ONLY
R2 = INSTREAM-1
DUMP NP,PC,1; JUMP W(R2)
$END

$MACRO READSYM
DUMP NP,PC,1; PC = INSTREAM
$END

$MACRO PRINT CHAR
SYM = CHAR
DUMP NP,PC,1; PC = OUTSTREAM
$END

$MACRO NEWLINE
PRINT NL
$END

$MACRO SPACE
PRINT ' '
$END

$MACRO MONITOR
DUMP NP,R5,1; JUMP MON
$END

MON:
$BEGIN
$DEF TEMP=R2
$DEF POS=R14, RCOUNT=R13, VAL=R12, COUNT=R11
    POS = X'46DF'; RCOUNT = 12
    CYCLE
      VAL = W(NP); COUNT = 4
      CYCLE
        TEMP = VAL&15-9
        TEMP = TEMP+7 IF TEMP > 0
        TEMP = TEMP+'9'
        W(POS) = TEMP; POS = POS-1
        SRC VAL,3,VAL
        COUNT = COUNT-1
      REPEAT IF COUNT # 0
      W(POS) = ' '; POS = POS-1
      NP = NP-1; RCOUNT = RCOUNT-1
    REPEAT IF RCOUNT # 0
    NP = NP+1
    TEMP = NP
    REC TEMP,R5,1
$END

$LOC X'400'
/INITIAL ENTRY
$DEF DISABLE=8, RESET=9
    R0 = #USER1-1
    R1 = R0+14
    R2 = LRDEV; R3 = DISABLE
    WRITEC R3,R2; NOP
    LRSTAT = 0
    R2 = LTDEV; R3 = RESET
    WRITEC R3,R2; NOP
    KB1(1) = -1                 /KSYM
    KIN(3) = 80                 /KPOS
    VOUT(3) = 80                /VPOS
    TIMER = 0
    REC PC,PC,1                 /SET STATE 1
    *+1-2
    NP = X'4000'
    CYCLE
      W(NP) = ' '
      NP = NP+1
    REPEAT IF NP # X'47D0'
    NP = X'A0'

