lib/fortran/src/pchar2.asm

   1 *               PRINT CHAR - BUFFERED VERSION
   2 *
   3 *
   4 ****** USAGE
   5 *
   6 *      JST PCHAR
   7 *      DAC Arg1
   8 *
   9 *
  10 *
  11         SUBR    PCHAR,PC
  12         SUBR    PWAIT,PW
  13         SUBR    BUFF
  14         SUBR    INTH
  15         SUBR    EXF
  16         SUBR    RPOS
  17         SUBR    WPOS
  18         SUBR    FILL
  19         REL
  20 *
  21         ABS             INTERRUPT HANDLER IN ABSOLUTE MODE
  22         ORG     '63     STANDARD INTERRUPT VECTOR
  23         DAC     INTH    INTERRUPT HANDLER ADDRESS
  24 *
  25         REL             PROGRAM IS RELOCATABLE
  26         ORG     0
  27 *
  28 INTH    STA     SAVA    SAVE A REGISTER
  29         IAB
  30         STA     SAVB
  31         INK
  32         STA     SAVK    SAVE KEYS
  33         STX     SAVX    SAVE X REGISTER
  34         LDA     RPOS
  35         SUB     WPOS
  36         SZE             SKIP IF NOTHING IN BUFFER
  37         JMP     GOGO    GO ON
  38         LDA     SAVB
  39         IAB
  40         LDA     SAVK    EXIT FROM INTERRUPT WITHOUT RESTORING
  41         OTK
  42         LDA     SAVA
  43         JMP*    INTH    RETURN FROM INTERRUPT, NOT ENABLED ANY MORE.
  44 GOGO    LDA     RPOS
  45         LGR     1       SHIFT TO WORD ADDRESS
  46         STA     0       WRITE TO X REG
  47         LDA     RPOS
  48         SLN             SKIP IF LAST BIT IN A SET
  49         JMP     RUPP    FETCH UPPER CHARACTER
  50         LDA     BUFF,1  FETCH LOWER CHARACTER
  51         JMP     LDED
  52 RUPP    LDA     BUFF,1  READ FROM BUFFER
  53         ICA
  54 LDED    OTA     4       OUTPUT TO ASR
  55         JMP     *-1     SHOULD NOT HAPPEN!
  56 *
  57         LDA     RPOS    NEW READ POS
  58         AOA
  59         ANA     BMSK
  60         STA     RPOS
  61         LDA     FILL
  62         ADD     =-1
  63         STA     FILL
  64 *
  65         LDA     SAVK
  66         OTK
  67         LDA     SAVB
  68         IAB
  69         LDA     SAVA    RESTORE A
  70         LDX     SAVX    RESTORE X
  71         ENB             RE-ENABLE INTERRUPTS
  72         JMP*    INTH    RETURN TO ELSEWHERE
  73 *
  74 **********************************************************************
  75 **********************************************************************
  76 *
  77 PC      DAC     **
  78         INH             DISABLE INTERRUPT
  79         STA     SA      SAVE REGISTERS
  80         INK
  81         STA     SK
  82         IAB
  83         STA     SB
  84         STX     SX
  85 *
  86         LDA*    PC      FIRST ARGUMENT ADDRESS
  87         STA     PTR     STORE TO POINTER
  88         IRS     PC      TALLY RETURN ADDRESS
  89 *
  90         LDA     FILL
  91         SZE
  92         JMP     NINI    NO INITIALISATION
  93         SKS     '104    TEST IF ASR BUSY
  94         JMP     *-1     JUMP BACK
  95         OCP     '104    ASR START
  96 NINI    ENB             ENABLE INTERRUPT
  97         LDA     FILL
  98         CAS     BS
  99         HLT             THAT SHOULD NEVER HAPPEN!
 100         JMP     NINI    LOOP UNTIL ROOM IN BUFFER
 101         INH             DISABLE INTERRUPT
 102         LDA     WPOS    WRITE BYTE POSITION
 103         LGR     1       SHIFT RIGHT, NOW WORD OFFSET
 104         STA     0       TO INDEX REGISTER
 105 *
 106         LDA     WPOS
 107         SLZ             SKIP IF LAST BIT 0
 108         JMP     WLOW    WRITE TO LOWER CHAR
 109 WHIG    LDA     BUFF,1
 110         LRR     8       SHIFT LOWER BITS TO B UPPER
 111         LDA*    PTR     GET DATA
 112         LLR     8       SHIFT BACK
 113         JMP     WRDY    WRITE READY
 114 WLOW    LDA     BUFF,1
 115         ICA
 116         LRR     8
 117         LDA*    PTR
 118         LLR     8
 119         ICA
 120 WRDY    STA     BUFF,1
 121         IRS     FILL    ONE MORE IN BUFFER
 122 *
 123         LDA     WPOS    LOAD WRITE POSITION
 124         AOA             INCREMENT
 125         ANA     BMSK    TALLY ROLLOVER
 126         STA     WPOS
 127 *
 128         LDA     ='60    INTERRUPT MASK FOR ASR33
 129         SMK     '20     SET INTERRUPT MASK
 130 *
 131         LDA     SB      RESTORE REGISTERS
 132         IAB
 133         LDA     SK
 134         OTK
 135         LDA     SA
 136         LDX     SX
 137 *
 138 EXF     ENB             ENABLE INTERRUPT
 139         JMP*    PC      RETURN TO MAIN PROGRAM
 140 *
 141 ************************************************************
 142 ************************************************************
 143 *
 144 PW      DAC     **
 145         LDA     FILL
 146         SNZ
 147         JMP*    PW
 148         JMP     *-3
 149 *
 150 *
 151 *******
 152 FILL    DAC     **      AMOUNT OF BUFFERED DATA
 153 PTR     DAC     **      UNIVERSAL POINTER
 154 SAVB    DAC     **
 155 SAVK    DAC     **      SAVED KEYS IN INTERRUPT-ROUTINE
 156 SAVA    DAC     **      SAVED A-REG IN INTERRUPT-ROUTINE
 157 SAVX    DAC     **      SAVED X-REG IN INTERRUPT-ROUTINE
 158 SB      DAC     **      SAVED B-REG IN MAIN ROUTINE
 159 SX      DAC     **      SAVED X-REG IN MAIN ROUTINE
 160 SA      DAC     **       SAVED A-REG IN MAIN ROUTINE
 161 SK      DAC     **      SAVED KEYS IN MAIN ROUTINE
 162 RPOS    DAC     **      READ POSITION
 163 WPOS    DAC     **      WRITE POSITION
 164 BMSK    OCT     '77
 165 BS      OCT     '100
 166 BUFF    BSS     '40
 167 *******
 168         END