* 28-9-79 
* MODIFIED 13/3/80 TO ALLOW BINARY CARD READING FOR MARK SENSE
   PROG 5/16 - 7/32 LINK TEST PROGRAM
TEST EQU 0
CHECKS EQU 0
 SPACE
INTERVAL EQU -5 * BASIC INTERVAL - SECONDS
RESET EQU INTERVAL*3 * RE-INITIALISE AFTER SO MANY INTERVALS
 SPACE
* BASIC SYSTEM PARAMETERS
BUFFLEN EQU 8192
BUFF EQU PROGEND
MESSLEN EQU 24
 SPACE
* DEVICE ADDRESSES
LINKIN EQU X'1E'
LINKOUT EQU X'1F'
CONSOLE EQU X'92'
CARD EQU X'04'
CLOCK EQU X'07'
 SPACE
* LINK SPEEDS
CLKA EQU 0
CLKB EQU X'40'
LINKRATE EQU CLKB
 SPACE
IOF EQU 0
ION EQU X'4800' * VECTORED EXTERNAL INTERRUPTS ONLY
 SPACE
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
 SPACE
* DON'T CHANGE ANY OF THESE LIGHTLY
INBP EQU R3
OUTBP EQU R4
GAP EQU R5
LINK1 EQU R15
 SPACE
* GENERAL WORK REGISTERS IN INTERRUPTABLE SEGMENTS
J EQU R13
K EQU R14
L EQU R15 *     **** NOTE OVERLAP WITH 'LINK1' ****
 SPACE
* ASSORTED CONSTANTS
NL EQU 10 * ASCII NEWLINE
SUB EQU C'?' * SUBSTITUTE CHARACTER USED BY CARD/ASCII CONVERSION
O82PUNCH EQU X'0282' * USED TO FORCE FEP BUFFER FLUSHING
BINKEY EQU X'FFF' * CARD WITH ALL 1'S WILL SIGNIFY BINARY
 EJECT
* LOADER HEADER
   ORG X'1000'-8
   DC Z(IOF)
   DC Z(INIT)
   DC Z(INIT)
   DC Z(PROGEND-2)
 SPACE 2
* INITIALISATION
INIT LHI K,IOF
   EPSR J,K
   LIS J,0
   LHI L,ILLEGAL
   STM K,X'34' * ILLEGAL INSTRUCTION TRAP
   LHI L,DIVERR
   STM K,X'4C' * FIXED POINT DIVIDE ERROR
   STH J,X'80' * SYSTEM Q POINTER
   LHI L,SYSQINT
   STH K,X'86'
   STH L,X'88'
   STH K,X'9A' * SVC STATUS
   LHI J,256*2-2
INIT.1 STH L,X'D0'(J)
   SIS J,2
   BNM INIT.1
   LHI J,.LINKIN
   STH J,2*LINKIN+X'D0'
   LHI J,.LINKOUT
   STH J,2*LINKOUT+X'D0'
   LHI J,.CARD
   STH J,2*CARD+X'D0'
   LHI J,.CLOCK
   STH J,2*CLOCK+X'D0'
   LHI J,.CONSOLE
   STH J,2*CONSOLE+X'D0'
   LHI J,CONSOLE
   OC J,CONRESET
   LHI J,LINKIN
   OC J,LNKCMD2 * CLOCK + 8 DATA BITS + ODD PARITY
   OC J,LNKCMD1A * ENABLE + READ + CMD1
   RDR J,K * CLEAR BUSY
   AIS J,1 * OUTPUT SIDE
   OC J,LNKCMD1B
REINIT LHI K,IOF
   EPSR J,K
   LHI J,CARD
   OC J,CARDDIS
   LIS INBP,0
   LIS OUTBP,0
  STH OUTBP,BINFLAG
   STH OUTBP,CARDTOGO * SET INTO KNOWN STATE
   STH OUTBP,CARDWAIT * DITTO
   STH OUTBP,FLUSH082
   LHI GAP,BUFFLEN
   LHI LKSTATE,LKIDLE
   STM LKSTATE,LINKREGS
   LCS CDBP,1
   STM DEV,CARDREGS
   STH CDBP,CARDLEN
   LHI J,RESET
   STH J,IDLENESS
   LHI J,INTERVAL
   STH J,CARDTOGO
   STH J,FLUSHED * ANY NON-ZERO VALUE
   IFNZ TEST
   LHI R1,X'3000'
   ENDC
   LPSW ENTER
   ALIGN 4
ENTER DC Z(ION)
   DC Z(WAIT)
 SPACE 4
* DEVICE COMMANDS
CONRESET DB X'03'
CONREAD DB X'92'
CONWRITE DB X'31'
 SPACE
CARDDIS DB X'80'
CARDFEED DB X'60'
 SPACE
LNKCMD2 DB LINKRATE+X'34' * CLOCK + 8 DATA BITS + ODD PARITY
LNKCMD1A DB X'41' * ENABLE + READ + CMD1
LNKCMD1B DB X'43' * ENABLE + WRITE + CMD1
   DB *
 SPACE 3
ILLEGAL DC X'8801'
 SPACE
SYSQINT EQU *
DIVERR EQU *
   DC X'8802'
 SPACE
PGMERR DC X'8803'
   EJECT
* DISPATCHER
WAIT LH J,IDLENESS
   BP  FLUSH * BOW-WOW THE FAITHFUL WATCHDOG!
 SPACE
   CLHI GAP,BUFFLEN-MESSLEN * ENOUGH FOR ONE MESSAGE ?
   BP WAIT.0 * NO   ->
   BAL LINK1,LINKSEND * YES
   LH J,FLUSH082 * DRAINING BUFFER ?
   BNZ WAIT * YES - SO DON'T READ ANY MORE
   B WAIT.1
WAIT.0 LH J,FLUSH082 * FORCED FLUSH?
   BNZ FLUSH * YES     ->
WAIT.1 EQU *
 SPACE
   IFNM TEST
 SPACE
WAIT.2 LH J,CARDTOGO
   CLHI GAP,BUFFLEN*3/4 * GAP > BUFFLEN*3/4  ?
   BNP WAIT.3
   LIS J,1 * YES
WAIT.3 CLHI GAP,160+1 * GAP < MAX CARD LENGTH ?
   BNL WAIT.4
   LIS J,0
WAIT.4 STH J,CARDTOGO
   LR J,J
   BZ WAIT.5
 SPACE
   BAL LINK1,KICKCARD
WAIT.41 LH J,IDLENESS
   CHI J,RESET+2 * AT LEAST 1 SECOND
   BP WAIT.43
   LH J,CARDREGS+4
   BNM WAIT.41
   LH J,CARDLEN * MANAGE TO READ ANYTHING ?
   BM WAIT.5 * NO  ->
  LIS K,2
   LH J,CARDBUFF(K) * BINARY FLAG TO BE SET ?
   CLHI J,BINKEY
   BNE WAIT.42 * NO  ->
  LIS J,1 * SET BINARY FLAG
  STH J,BINFLAG
  B WAIT.42
WAIT.43 LIS J,1
   STH J,FLUSH082
   B WAIT.5
 SPACE
WAIT.42 BAL LINK1,CONVERT
   LIS J,0
   STH J,FLUSHED
 SPACE
WAIT.5 EQU *
   ELSE
   BAL LINK1,FILLUP * SET TEST = -1 TO BASH LINK ONLY
   ENDC
   B WAIT
   EJECT
* ROUTINE TO FLUSH BUFFER PRIOR TO RESET
FLUSH LH J,FLUSHED * ALREADY FLUSHED ?
   BNZ REINIT * YES    ->
   LHI J,ENDLINE
FLUSH.1 LB K,0(J)
   AIS INBP,1
   NHI INBP,BUFFLEN-1
   STB K,BUFF(INBP)
   SIS GAP,1
   AIS J,1
   CLHI J,ENDLINE1
   BNE FLUSH.1
FLUSH.2 CLHI GAP,BUFFLEN-MESSLEN * CLEARED YET ?
   BP REINIT * YES     ->
   LHI J,LKIDLE
   CLH J,LINKREGS+0 * LINK BUSY ?
   BNE FLUSH.3 * YES     ->
   BAL LINK1,LINKSEND
FLUSH.3 LH J,IDLENESS
   CHI J,RESET+5 * 5 SECONDS GRACE
   BP REINIT
   B FLUSH.2
 SPACE
ENDLINE DB NL,C'//END'
   DO 7
   DB NL,NL,NL,NL
ENDLINE1 EQU *
   DB *
FLUSHED DSH 1
FLUSH082 DSH 1
CARDTOGO DSH 1
BINFLAG DSH 1
   EJECT
   IFM TEST
* ROUTINE TO BASH CIRCULAR BUFFER + LINK DRIVER
FILLUP LHI J,TESTLINE
FILLUP.1 LB K,0(J)
   AIS J,1
   AIS INBP,1
   NHI INBP,BUFFLEN-1
   STB K,BUFF(INBP)
  AIS GAP,1
   SIS K,NL
   BNZ FILLUP.1
   BR LINK1
TESTLINE DB C'ABCDEFGHIJKLMOPQRSTUVWXYZ',NL
   DB *
   ENDC
   EJECT
* CARD CODE TO ASCII CONVERSION ROUTINE
* INPUT FROM 'CARDBUFF', OUTPUT TO CIRCULAR BUFFER 'BUFF' VIA 'OUTBP'
 SPACE
CONV1 EQU R10
CONV2 EQU R11
CONVEND EQU R12
J EQU R13
K EQU R14
CHAR EQU R15
 SPACE
CONVERT STM CONV1,CONVTEMP
   LH CONVEND,CARDLEN
 SPACE
   IFNZ CHECKS
   CLHI CONVEND,160
   BE CONV.OK
   DC X'8809'
CONV.OK EQU *
   ENDC
 SPACE
BINCHECK LH J,BINFLAG * ARE WE READING BINARY?
  BNZ BINCONV * FLAG SET - SWITCH TO OTHER ROUTINE
 SPACE
CONV.1 SIS CONVEND,2
   LH CHAR,CARDBUFF(CONVEND)
   BZ CONV.1
 SPACE
   LHI J,-2
CONV.2 AIS J,2
   CLR J,CONVEND
   BP CONV.9 * ALL DONE
   LH CHAR,CARDBUFF(J)
 SPACE
   BZ CONV.SP * A BLANK?:  YES    ->
 SPACE
   LR K,CHAR
   SRHLS K,9 * EXTRACT ZONE BITS
   LB CONV2,HZTAB(K)
   CLHI CONV2,255
   BE CONV.SUB
   LIS K,2
   NR K,CHAR
   OR CONV2,K * INSERT ROW 8 INTO ZONE
   NHI CHAR,X'01FD' * STRIP ZONE BITS AND ROW 8
 SPACE
   LHI CONV1,9*2
CONV.3 SIS CONV1,1*2
   BM CONV.SUB
   CLH CHAR,DTAB(CONV1)
   BNE CONV.3
 SPACE
   SLHLS CONV1,3-1 * --- N.B. *2 ABOVE ---
   AR CONV1,CONV2
   LB CHAR,ATAB(CONV1)
   B CONV.4
 SPACE
CONV.SP LH K,CARDBUFF-2(J) * PREVIOUS CHAR
   BNZ CONV.SP1
   LB CHAR,BUFF(INBP)
   AIS CHAR,1
   STB CHAR,BUFF(INBP)
   CLHI CHAR,X'FF'
   BNE CONV.SP2
CONV.SP1 LHI CHAR,128+64+1 * ONE SPACE
   B CONV.4
 SPACE
CONV.SUB LHI CHAR,SUB
 SPACE
CONV.4 AIS INBP,1
   NHI INBP,BUFFLEN-1
   STB CHAR,BUFF(INBP)
   SIS GAP,1
CONV.SP2 B CONV.2
 SPACE
CONV.9 LIS CHAR,NL
   AIS INBP,1
   NHI INBP,BUFFLEN-1
   STB CHAR,BUFF(INBP)
   SIS GAP,1
 SPACE
CONV.10   LHI J,-1
   STH J,CARDLEN * SET CHECK THAT BUFFER REALLY HAS BEEN MOVED
  LM CONV1,CONVTEMP
   BR LINK1
 SPACE
BINCONV LIS J,0 * SET BUFFER COUNT
  LIS K,1
  LH CHAR,CARDBUFF(K) * CHECK FOR FLAG CARD
  CLHI CHAR,BINKEY
  BE CONV.10
NEXBIN CLR J,CONVEND
  BP CONV.9 * END OF CARD - INSERT NL
  LH CHAR,CARDBUFF(J) * GET 12 BIT CARD CHAR
  LR CONV1,CHAR * TAKE A COPY
  SRHLS CONV1,6
  AHI CONV1,33 * MAKE ASCII CHAR
  NHI CHAR,X'3F' * EXTRACT LEAST SIG. 6 BITS
  AHI CHAR,33
  AIS INBP,1 * INCREMENT BUFFER POINTER
  NHI INBP,BUFFLEN-1
  STB CONV1,BUFF(INBP) * STORE MOST SIGNIFICANT CHAR
  AIS INBP,1
  NHI INBP,BUFFLEN-1
  STB CHAR,BUFF(INBP) * STORE LEAST SIGNIFICANT CHAR
  SIS GAP,2
  AIS J,2
  B NEXBIN
 SPACE
* ZONE TABLE
HZTAB DB X'00',X'01',X'04',X'FF',X'05',X'FF',X'FF',X'FF'
 SPACE
* DIGIT TABLE
DTAB DC X'0000',X'0100',X'0080',X'0040'
   DC X'0020',X'0010',X'0008',X'0004',X'0001'
 SPACE
* ASCII TABLE
ATAB DB X'20',X'30',X'38',X'59',X'2D',X'26',X'51',X'48'
   DB X'31',X'2F',SUB,SUB,X'4A',X'41',X'5C',SUB
   DB X'32',X'53',X'3A',X'20',X'4B',X'42',X'21',X'5B'
   DB X'33',X'54',X'23',X'2C',X'4C',X'43',X'24',X'2E'
   DB X'34',X'55',X'40',X'25',X'4D',X'44',X'2A',X'3C'
   DB X'35',X'56',X'27',X'5F',X'4E',X'45',X'29',X'28'
   DB X'36',X'57',X'3D',X'3E',X'4F',X'46',X'3B',X'2B'
   DB X'37',X'58',X'22',X'3F',X'50',X'47',X'5E',X'5D'
   DB X'39',X'5A',SUB,SUB,X'52',X'49',SUB,SUB
 SPACE
   ALIGN 4
CONVTEMP DSH 6
   EJECT
* CLOCK DRIVER
   ALIGN 4
.CLOCK DC Z(0)
   DC Z(0)
   DC Z(IOF)
   STH J,CLOCKTMP
   LIS J,1
   AHM J,CLOCKCNT
   BP CLOCK.2
CLOCK.1 LH J,CLOCKTMP
   LPSW .CLOCK
CLOCK.2 AHM J,IDLENESS
   AHM J,CARDWAIT
   LHI J,-50 * LINE FREQUENCY
   STH J,CLOCKCNT
   B CLOCK.1
CLOCKTMP DC Z(0)
CLOCKCNT DC Z(0)
IDLENESS DC Z(0)
CARDWAIT DC Z(0)
   EJECT
 EJECT
* REGISTERS USED (AND RESTORED) BY LINK DRIVER
LKSTATE EQU R10
LKSUM EQU R11
LKCOUNT EQU R12
DEV EQU R13
SYM EQU R14
LKBP EQU R15
 SPACE
 SPACE
* CONTROL CODES USED BY PROTOCOL
ENQ EQU X'85' * CAN I SEND ?
STX EQU X'82' * O.K. - START TRANSMISSION
ACK EQU X'86' * ACKNOWLEDGE - EACH CHARACTER OF MESSAGE
ETB EQU X'97' * TRANSMISSION OF BLOCK COMPLETE
NAK EQU X'95' * UNIVERSAL 'NO'
SYN EQU X'96' * RE-SYNCHRONISE
 SPACE
   ALIGN 4
.LINKIN DC Z(0)
   DC Z(0)
   DC Z(IOF)
   STM LKSTATE,LINKTEMP
   LM LKSTATE,LINKREGS
   LHI DEV,LINKIN
   RDR DEV,SYM
   SSR DEV,SYM
   THI SYM,X'E0'
   BNZ LKSYNCH
   RDR DEV,SYM
   IFNZ TEST
   STB SYM,0(R1)
   AIS R1,1
   ENDC
   BR LKSTATE
 SPACE
LKQUERY CLHI SYM,STX
   BNE LKSYNCH
   LHI LKSTATE,LKINIT
   LHI DEV,LINKOUT
   LHI LKSUM,24
   WDR DEV,LKSUM
   IFNZ TEST
   STB LKSUM,0(R1)
   AIS R1,1
   ENDC
   B LINKEXIT
 SPACE
LKINIT LHI LKSTATE,LKDATA
   LHI LKCOUNT,24
   LR LKBP,OUTBP
LKDATA CLHI SYM,ACK
   BNE LKSYNCH
   AIS LKBP,1
   NHI LKBP,BUFFLEN-1
   LB SYM,BUFF(LKBP)
   AR LKSUM,SYM
   LHI DEV,LINKOUT
   WDR DEV,SYM
   IFNZ TEST
   STB SYM,0(R1)
   AIS R1,1
   ENDC
   SIS LKCOUNT,1
   BNZ LINKEXIT
   LHI LKSTATE,LKCHECK
   B LINKEXIT
 SPACE
LKCHECK CLHI SYM,ACK
   BNE LKSYNCH
   EXBR SYM,LKSUM
   XR SYM,LKSUM
   LHI DEV,LINKOUT
   WDR DEV,SYM
   IFNZ TEST
   STB SYM,0(R1)
   AIS R1,1
   ENDC
   LHI LKSTATE,LKSTOP
   B LINKEXIT
 SPACE
LKSTOP CLHI SYM,ETB
   BNE LKSYNCH
   LHI LKSTATE,LKIDLE
   LR OUTBP,LKBP
   AHI GAP,24
   B LINKEXIT
 SPACE
LKIDLE EQU LINKEXIT
 SPACE
LINKEXIT STM LKSTATE,LINKREGS
   LM LKSTATE,LINKTEMP
   LPSW .LINKIN
 SPACE
LKSYNCH CLHI LKSTATE,LKIDLE * IS LINK INHIBITED
   BE LINKEXIT * YES - IGNORE ERROR
   CLHI SYM,SYN * RE-SYNCHRONISE AFTER PROTOCOL HICCUP
   BE LKRETRY
   LHI LKSTATE,LKSYNCH
   LHI DEV,LINKOUT
   LHI SYM,SYN
   WDR DEV,SYM
   IFNZ TEST
   STB SYM,0(R1)
   AIS R1,1
   ENDC
   B LINKEXIT
 SPACE
LKRETRY LHI LKSTATE,LKQUERY * TRY AGAIN
   LHI DEV,LINKOUT
   LHI SYM,ENQ
   WDR DEV,SYM * CAN I SEND ?
   IFNZ TEST
   STB SYM,0(R1)
   AIS R1,1
   ENDC
   B LINKEXIT
 SPACE
   ALIGN 4
.LINKOUT DC Z(0) * IGNORE OUTPUT INTERRUPTS
   DC Z(0)
   DC Z(IOF)
   LPSW .LINKOUT
 SPACE
* GIVE LINK INITIAL KICK TO START TRANSMIT CYCLE
LINKSEND LHI J,IOF
   EPSR K,J
   LHI J,LKIDLE
   CLH J,LINKREGS+0 * STORED 'LKSTATE' = 'LKIDLE' ?
   BNE LKRETURN
   LHI J,RESET
   STH J,IDLENESS
   STH K,.LINKIN * CALLER'S STATUS
   STH LINK1,.LINKIN+2 * RETURN ADDRESS
   STM LKSTATE,LINKTEMP
   LM LKSTATE,LINKREGS
   B LKRETRY
 SPACE
LKRETURN EPSR J,K
   BR LINK1
   ALIGN 4
LINKTEMP DSH 6
LINKREGS DSH 6
   EJECT
* CARD READ DRIVER
DEV EQU R13
SYM EQU R14
CDBP EQU R15
 SPACE
   ALIGN 4
.CARD DC Z(0)
   DC Z(0)
   DC Z(IOF)
   STM DEV,CARDTEMP
   LM DEV,CARDREGS
   LHI DEV,CARD * --- N.B. THIS REALLY IS NECESSARY ---
 SPACE
CARDLOOP SSR DEV,SYM
   BFC 8,CARDREAD * O.K.   GO READ
   BFC 4,CARDLOOP * STATUS ERROR
   SSR DEV,SYM * MAKE SURE STATUS IS SET
   THI SYM,X'E1' * ALL ERRORS EXCEPT 'NO MOTION'
   BNZ CARDERR * AN ERROR IS SET
   LR CDBP,CDBP
   BZ CARDOFF * IGNORE LEADING 'NMTN'
   B CARDOK * NO ERROR   ->
CARDERR LHI CDBP,INTERVAL
   STH CDBP,CARDWAIT
   THI SYM,X'20' * HOPPER EMPTY
   BNZ CARDOK
   THI SYM,X'40' * 'TROUBLE' ?
   IFZ CHECKS
   B CARDOFF
   ELSE
   BZ CARDEOV
   DC X'8804'
   ENDC
CARDEOV THI SYM,X'80' * OVERRUN
   BZ CARDOFF
   DC X'8805' * YES - IT REALLY HAPPENED!!
 SPACE
CARDOK STH CDBP,CARDLEN
 SPACE
CARDOFF LCS CDBP,1 * SET 'NOT BUSY'
   OC DEV,CARDDIS
 SPACE
CARDEXIT STM DEV,CARDREGS
   LM DEV,CARDTEMP
   LPSW .CARD
 SPACE
CARDREAD RHR DEV,SYM
   LR DEV,SYM
   NHI DEV,X'3F00'
   NHI SYM,X'003F'
   SRHLS DEV,2
   OR SYM,DEV
  STH SYM,CARDBUFF(CDBP)
   AIS CDBP,2
   B CARDEXIT
 SPACE
KICKCARD LH J,CARDWAIT
   BMR LINK1
   LHI J,IOF
   EPSR K,J
   LH J,CARDREGS+4 * STORED VERSION OF 'CDBP'
   BNM CARDBUSY
 SPACE
   LH J,CARDLEN
   BM KICKCD.1
   DC X'8807'
KICKCD.1 EQU *
 SPACE
   STH K,.CARD
   STH LINK1,.CARD+2
   LHI J,RESET
   STH J,IDLENESS
   LIS CDBP,0
   STH CDBP,CARDREGS+4 * --- SETTING POINTER ALSO MARKS 'CARD BUSY'
   LHI DEV,CARD * DEVICE NO
   OC DEV,CARDFEED
   LPSW .CARD
 SPACE
CARDBUSY EPSR J,K
   BR LINK1
 SPACE
   ALIGN 4
CARDTEMP DSH 4
CARDREGS DSH 4
CARDLEN DSH 1
 SPACE
   DC Z(-1) * STOPPER FOR CONVERT ROUTINE
CARDBUFF DSH 81
 EJECT
   ALIGN 4
.CONSOLE DC Z(0)
   DC Z(0)
   DC Z(IOF)
   LPSW .CONSOLE
 SPACE 3
   DSH 6
PROGEND EQU *
* --- MAIN CIRCULAR BUFFER IN HERE ---
   END