|
|
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.