1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
; Copyright 1996 Acorn Computers Ltd
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
;
; > $.Source.PMF.oswrch
GBLS WrchLimReg
; *****************************************************************************
;
; PMFWrch - Entry point for WriteC vector
; This routine used to be nice and structured before I
; optimised it for plain wrch !
;
; in: R0 = character
;
; out: All registers preserved
;
[ {FALSE}
WrchLimReg SETS "R9" ; would like to only push R0-R9, but
; PMFWrchDirect is called by SWIs like
; OS_WriteN etc, which need R10-R12
PMFWrchDirect
BYTEWS WsPtr ; if called direct, then set up R12
PMFWrch ROUT
Push "R0-$WrchLimReg" ; if called thru vec, already set up
|
WrchLimReg SETS "R12" ; 0.046N, so need to save R0-R12
PMFWrchDirect
PMFWrch ROUT
Push "R0-$WrchLimReg"
BYTEWS WsPtr
]
LDRB R1, WrchDest
LDRB R2, SpoolFileH
ORRS R3, R1, R2
BNE %FT10
[ AssemblingArthur
VDWS WsPtr
BL Vdu
|
BL WrchVdu ; call VDU
]
BVS %FT45
Pull "R0-$WrchLimReg,PC", CC
B %FT15
10
TST R1, #&22 ; branch if wrch not to VDU
BNE %FT50 ; or wrch to extension vector
[ AssemblingArthur
VDWS WsPtr
BL Vdu
|
BL WrchVdu ; call VDU
]
15
BVS %FT45 ; error from VDU
LDR R0,[R13] ; reload R0 with character
BYTEWS WsPtr ; reload workspace pointer
LDRB R1, WrchDest ; and wrch destinations
BCS PrintVdu ; VDU says "Print it"
20
TST R1, #8 ; printer enabled, independent of
; CTRL-B and CTRL-C ?
BNE PrintVdu ; yes, then branch
40
TST R1, #1 ; output to RS423 ?
BNE RS423Vdu ; yes, then do it
42
LDRB R2, SpoolFileH ; spool file open ?
CMP R2, #0 ; (set V=0 for if we drop thru)
BLNE SpoolVdu ; yes, then go
45
[ AssemblingArthur :LOR: Module
Pull "R0-$WrchLimReg, PC", VC
ADD R13, R13, #4
Pull "R1-$WrchLimReg, PC"
|
Pull "R0-$WrchLimReg, PC" ; that's it (phew!)
]
; Come here when Wrch not to VDU or Wrch to VDUXV
50
TST R1, #&02 ; wrch not to VDU at all ?
BNE %BT20 ; then skip
; else must be VDU sent thru VDUXV
MOV R10, #VDUXV
BL GoVec2 ; call vector
B %BT15
; *****************************************************************************
PrintVdu
TST R1, #&40 ; only print via VDU 1 ?
BNE %BT40 ; yes, then skip
LDRB R2, PrinterIgnore ; is it ignore character ?
TEQ R0, R2
LDREQB R2, NoIgnore ; and ignoring enabled ?
TSTEQ R2, #&80
BEQ %BT40 ; yes, then don't print it
BL MOSDoPrintWS ; else print it (R12 -> ByteWS)
BVS %BT45 ; error in printing
LDR R0, [R13] ; reload R0 with character
LDRB R1, WrchDest ; and reload wrchdest
B %BT40
RS423Vdu
Push "r0,r1"
LDRB r1, SerialOutHandle
TEQ r1, #0
BNE %FT60
MOV r0, #open_write
ADR r1, SerialOutFilename
SWI XOS_Find
BVS %FT70 ; if can't open serial output stream, report error
; and don't put anything in buffer
STRB r0, SerialOutHandle
LDR r0, [sp] ; get char back
60
PHPSEI
Push "r14" ; save IRQ indication
MOV r1, #Buff_RS423Out ; RS423 output buffer id
BL WRITE ; write to buffer (waiting)
Pull "r14"
PLP ; restore IRQ state from lr
Pull "r0,r1"
B %BT42
; we got an error from the open, so in order to report it,
; we'd better stop outputting to RS423
70
ADD sp, sp, #4 ; junk stacked r0
Pull "r1"
BIC r1, r1, #1 ; clear RS423 output bit
STRB r1, WrchDest ; write back to OS_Byte
B %BT45 ; report error
SerialOutFilename
= "Serial#Buffer2:", 0
ALIGN
SpoolVdu ; entered with V=0
TST R1, #&10 ; spooling enabled ?
MOVNE PC, R14 ; no, then return
Push R14 ; cos we're doing a SWI in SVC mode
MOV R1, R2 ; put handle in R1
SWI XOS_BPut ; put byte to file
Pull PC, VC ; if no error, return with V clear
; (no need to reload R1, since SPOOL
; is done last)
SpoolBadExit
Push R0
MOV R0, #0 ; stop spooling FIRST
STRB R0, SpoolFileH
SWI XOS_Find ; and close file (R0=0, R1=handle)
Pull "R1, R14"
MOVVC R0, R1 ; if closed OK, then restore old error
RETURNVS ; still indicate error
LTORG
END