1: / 2: / 3: 4: / io3 -- Fortran I/O 5: 6: .globl getbuf 7: .globl chkunit 8: .globl creatf 9: .globl openf 10: 11: setio: 12: mov r1,unit 13: jsr r5,chkunit 14: movb utable(r1),r0 15: beq 1f 16: bpl 2f 17: mov r1,r0 18: asl r0 19: mov btable(r0),r0 20: mov r0,r2 21: br 4f 22: 2: 23: cmp (r5),r0 24: beq 3f 25: jsr r5,rerr; 101. / inconsistent use of unit 26: sys exit 27: 1: 28: mov r1,-(sp) 29: clr r0 30: dvd $10.,r0 31: swab r1 32: bis r1,r0 33: add $"00,r0 34: mov r0,filnam+4 35: mov (sp)+,r1 36: jsr r5,getbuf 37: mov $filnam,r0 38: 4: 39: movb (r5),utable(r1) 40: bit $1,(r5) 41: bne 2f 42: jsr r5,creatf 43: br 3f 44: 2: 45: jsr r5,openf 46: 3: 47: tst (r5)+ 48: asl r1 49: mov btable(r1),buffer 50: rts r5 51: 52: getbuf: 53: mov $utable,r0 54: mov $btable,r2 55: 1: 56: tstb (r0)+ 57: beq 2f 58: tst (r2)+ 59: br 3f 60: 2: 61: tst (r2)+ 62: beq 3f 63: mov -(r2),r0 64: clr (r2) 65: mov r0,r2 66: br 2f 67: 3: 68: cmp r0,$utable+20. 69: blo 1b 70: mov bufp,r2 71: add $134.,bufp 72: mov bufp,0f 73: sys break; 0:.. 74: 2: 75: mov r1,r0 76: asl r0 77: mov r2,btable(r0) 78: mov r2,buffer 79: rts r5 80: 81: chkunit: 82: cmp r1,$20. 83: blo 1f 84: jsr r5,rerr; 100. / illegal unit number 85: sys exit 86: 1: 87: rts r5 88: 89: creatf: 90: cmp unit,$6 91: bne 2f 92: mov $1,r0 93: br 1f 94: 2: 95: mov r0,0f 96: sys creat; 0:..; 666 97: bec 1f 98: jsr r5,rerr; 102. / create error 99: sys exit 100: 1: 101: mov r2,-(sp) 102: mov r0,(r2)+ 103: clr (r2)+ 104: clr (r2)+ 105: mov r2,-(r2) 106: mov (sp)+,r2 107: rts r5 108: 109: openf: 110: cmp unit,$5 111: bne 2f 112: clr r0 113: br 1f 114: 2: 115: mov r0,0f 116: sys open; 0:..; 0 117: bec 1f 118: jsr r5,rerr; 103. / open error 119: sys exit 120: 1: 121: mov r2,-(sp) 122: mov r0,(r2)+ 123: clr (r2)+ 124: clr (r2)+ 125: mov (sp)+,r2 126: rts r5 127: 128: fputc: 129: mov r1,-(sp) 130: mov buffer,r1 131: dec 2(r1) 132: bge 1f 133: mov r0,-(sp) 134: jsr pc,flush1 135: dec 2(r1) 136: mov (sp)+,r0 137: 1: 138: movb r0,*4(r1) 139: inc 4(r1) 140: mov (sp)+,r1 141: rts r5 142: 143: fflush: 144: mov r1,-(sp) 145: mov buffer,r1 146: jsr pc,flush1 147: mov (sp)+,r1 148: rts r5 149: 150: flush1: 151: mov r1,r0 152: add $6,r0 153: mov r0,-(sp) 154: mov r0,0f 155: neg r0 156: add 4(r1),r0 157: bhis 1f 158: mov r0,0f+2 159: mov (r1),r0 160: sys write; 0:..; .. 161: 1: 162: mov (sp)+,4(r1) 163: mov $128.,2(r1) 164: rts pc 165: 166: fgetc: 167: tst nlflg 168: bne 4f 169: mov r1,-(sp) 170: mov buffer,r1 171: dec 2(r1) 172: bge 1f 173: mov r1,r0 174: add $6,r0 175: mov r0,0f 176: mov r0,4(r1) 177: mov (r1),r0 178: sys read; 0:..; 128. 179: bes 2f 180: tst r0 181: bne 3f 182: 2: 183: jsr r5,rerr; 104. / EOF on input 184: sys exit 185: 3: 186: dec r0 187: mov r0,2(r1) 188: 1: 189: clr r0 190: bisb *4(r1),r0 191: inc 4(r1) 192: mov (sp)+,r1 193: tst binflg 194: bne 1f 195: cmp r0,$'\n 196: bne 1f 197: 4: 198: mov pc,nlflg 199: mov $' ,r0 200: 1: 201: rts r5 202: 203: gnum: 204: mov r1,-(sp) 205: clr r1 206: 1: 207: jsr r5,fmtchr 208: cmp r0,$' / 209: beq 1b 210: sub $'0,r0 211: cmp r0,$9. 212: bhi 1f 213: mpy $10.,r1 214: add r0,r1 215: br 1b 216: 1: 217: mov r1,r0 218: mov (sp)+,r1 219: dec formp 220: rts r5 221: 222: switch: 223: mov (r5)+,r1 224: 1: 225: tst (r1) 226: beq 1f 227: cmp r0,(r1)+ 228: bne 1b 229: tst (sp)+ 230: jmp *(r1) 231: 1: 232: rts r5 233: 234: fmtchr: 235: movb *formp,r0 236: inc formp 237: rts r5 238: 239: getitm: 240: tst itmflg 241: bne 1f 242: mov r5,-(sp) 243: jmp *(r4)+ 244: 1: 245: clr itmflg 246: tst (r5)+ 247: rts r5 248: 249: / just a fake, there's no carriage control 250: 251: fputcc: 252: cmp $' ,r0 253: bne 1f 254: inc nspace 255: rts r5 256: 1: 257: mov r0,-(sp) 258: 1: 259: dec nspace 260: blt 1f 261: mov $' ,r0 262: jsr r5,fputc 263: br 1b 264: 1: 265: clr nspace 266: mov (sp)+,r0 267: beq 1f 268: jsr r5,fputc 269: 1: 270: rts r5 271: 272: eorec: 273: mov unit,r0 274: bitb $1,utable(r0) 275: bne 1f 276: clr nspace 277: mov $'\n,r0 278: jsr r5,fputc 279: eorec1: 280: clr r0 281: jsr r5,fputcc 282: / cmp unit,$6 / tty output 283: / bne 2f 284: jsr r5,fflush 285: 2: 286: rts r5 287: 1: 288: tst nlflg 289: bne 1f 290: jsr r5,fgetc 291: br 1b 292: 1: 293: clr nlflg 294: rts r5 295: 296: spaces: 297: add r1,nspace 298: rts r5