|
|
1.1 root 1: #
2: #
3: # 31writeold.s
4: #
5: # The following opcodes are provided to maintain compatability
6: # with the previous pascal interpreter. They convert the stack to
7: # the standard I/O format then branch to the appropriate function.
8: #
9: # These routines, especially "calcfmt", are an abomination for which
10: # I apologize in advance. The formats should be calculated by the
11: # compiler and this module discarded!
12: #
13: _WRITB:
14: subl2 $len,sp #allocate space for format
15: tstw len(sp) #'true' => minimum width = 4
16: beql l3120
17: pushl $4
18: brb l3121
19: l3120:
20: pushl $5 #'false' => minimum width = 5
21: l3121:
22: pushl $2 #data size
23: pushal wrbool #default format
24: calls $3,calcfmt #r0 pts to new top of stack
25: movl r0,sp #update stack
26: movl $len,r6 #set format length
27: jbr bentry #execute normal write
28: _WRITC:
29: tstb (r10) #check for formatting
30: jeql _WRITEC #none, so go to it !
31: movzwl (sp)+,-(sp) #align data
32: moval wrchr,r0 #default format string to be used
33: fprint:
34: subl2 $len,sp #allocate space for format
35: pushl $1 #minimum field width
36: pushl $4 #data size
37: pushl r0 #default format
38: calls $3,calcfmt #r0 pts to new top of stack
39: movl r0,sp #update stack
40: movl $len,r6 #set format length
41: movl $1,r5 #number of data arguements
42: jbr fentry #execute normal write
43: _WRHEX2:
44: cvtwl (sp)+,-(sp) #align data
45: _WRHEX4:
46: moval wrhex,r0 #default format string to be used
47: jbr fprint
48: _WROCT2:
49: cvtwl (sp)+,-(sp) #align data
50: _WROCT4:
51: moval wroct,r0 #default format string to be used
52: jbr fprint
53: _WRIT2:
54: cvtwl (sp)+,-(sp) #align data
55: _WRIT4:
56: moval wrint,r0 #default format string to be used
57: jbr fprint
58: _WRIT8:
59: subl2 $len,sp #allocate space for format
60: pushl $8 #minimum field width
61: pushl $8 #data size
62: pushal wrreal #default format
63: calls $3,calcfmt #r0 pts to new top of stack
64: movl r0,sp #update stack
65: pushl $14 #push default precision
66: pushal -(sp) #get field width spec, so that
67: pushal rd4 # maximum permissable precision
68: pushal 26(sp) # can be calculated
69: calls $3,_sscanf #field width returned on stack
70: subl3 $7,(sp)+,r0 #r0 = max_precision = width - required_space
71: cmpl (sp),r0 #if precision requested < r0
72: bleq l3122 # then use request
73: movl r0,(sp) # else use max permissable
74: l3122:
75: movl $len,r6 #set format length
76: movl $3,r5 #real data and precision
77: jbr fentry
78: _WRIT82:
79: subl2 $len,sp #allocate space for format
80: pushl $1 #minimum field width
81: pushl $8 #data size
82: pushal wrfixd #default format
83: calls $3,calcfmt #r0 pts to new top of stack
84: movl r0,sp #update stack
85: bbs $4,-1(r10),l3123#check precision size
86: movl len+8(sp),-(sp) #push precision
87: movl $len+4,r6 #set format + precision length
88: brb l3124
89: l3123:
90: cvtwl len+8(sp),-(sp) #push precision
91: movl $len+2,r6 #set format + precision length
92: l3124:
93: movl $3,r5 #real data and precision
94: jbr fentry
95: #
96: _WRITG:
97: cvtwl 1(r10),r5 #r5 has string length
98: addl3 $1,r5,r6 #make space for null terminater
99: blbc r6,l3125 #r6 has data length
100: incl r6
101: l3125:
102: subl3 r5,r6,r0 #check for need to add terminater
103: blbs r0,l3126 #1 => already terminated; 2 => needed
104: subl2 $2,sp #allocate terminater space
105: movc5 r5,2(sp),$0,r6,(sp) #put in terminater
106: l3126:
107: subl2 $len,sp #allocate space for format
108: cvtwl 1(r10),-(sp) #push minimum string length
109: pushl r6 #data size
110: pushal wrstr #default format
111: calls $3,calcfmt #r0 pts to new top of stack
112: movl r0,sp #update stack
113: addl2 $2,r10 #update lc
114: movl $len,r5 #set format length
115: jbr sentry #execute normal write string
116: #
117: # Default formats
118: #
119: .set len,12 #maximum format size
120: wrbool: .byte '%,'1,'0,'s, 0
121: wrhex: .byte '%,'8,'X, 0
122: wroct: .byte '%,'1,'1,'O, 0
123: wrint: .byte '%,'1,'0,'D, 0
124: wrchr: .byte '%,'c, 0
125: wrstr: .byte '%,'s, 0
126: .data
127: wrreal: .byte ' ,'%,'2,'1,'.,'*,'e, 0
128: wrfixd: .byte ' ,'%,'2,'1,'.,'*,'f, 0
129: .text
130: #
131: #
132: # Routine to calculate formats and place them on the stack
133: #
134:
135: calcfmt:#(format, datasize, minsize)
136:
137: #char *format; /* pointer to default format */
138: #long datasize; /* number of bytes of data */
139: #long minsize; /* minimum width of output field */
140:
141: .set args,16 #size of arguements on the stack
142:
143: .word R2|R3|R4|R5|R6|R9
144: cvtbl (r10)+,r0 #r0 has width spec
145: bneq l3140 #check for width spec
146: moval args(ap), r9 # r9 pts to return sp value
147: movl 4(ap),r6 #r6 pts to default format
148: jbr l3148
149: l3140:
150: moval len+args(ap),r1 #r1 pts to data
151: addl2 8(ap),r1 #r1 pts to width specification
152: bbs $1,r0,l3141 #check format size
153: moval args+4(ap), r9 # r9 pts to return sp value
154: movl (r1),r2 #r2 has width spec
155: brb l3142
156: l3141:
157: moval args+2(ap), r9 # r9 pts to return sp value
158: cvtwl (r1),r2 #r2 has width spec
159: l3142:
160: cmpl r2,12(ap) #check to meet minimum width
161: bgeq l3143
162: movl 12(ap),r2 #if not, set to minimum width
163: l3143:
164: movl 4(ap),r6 #r6 pts to default format
165: subl2 $len,sp #allocate workspace for new format
166: movl sp,r5 #r5 pts to new format
167: l3144:
168: movb (r6),(r5)+ #move format up to data spec
169: cmpb (r6)+,$'%
170: bneq l3144
171: subl2 $4,sp #convert length to ascii
172: cvtlp r2,$7,(sp)
173: cvtps $7,(sp),$7,(r5) #place ascii in format
174: addl2 $4,sp
175: skpc $'0,$7,1(r5) #remove sign and leading zeros
176: movc3 r0,(r1),(r5) #r3 pts to next free byte
177: l3145:
178: subb3 $'0,(r6)+,r0 #move r6 over default width
179: blss l3146 #(note: could use 'spanc' for this)
180: cmpb r0,$9
181: bleq l3145
182: l3146:
183: decl r6
184: l3147:
185: movb (r6)+,(r3)+ #copy remainder of format
186: bneq l3147 #(note: could use 'movtuc' for this)
187: movl sp,r6 #r6 pts to format to be used
188: l3148:
189: movc3 8(ap),len+args(ap),( r9) #move up data to make room for format
190: addl3 8(ap), r9,r0 #r0 pts to space for format
191: movc3 $len,(r6),(r0) #copy in format
192: movl r9,r0 #r0 pts to top of stack on return
193: ret
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.