minnie.tuhs.org/unixen.tar/unixen/PDP-11/Trees/V6/usr/source/fort/io/io3.s

Text File | 1975-07-17 | 3.0 KB | 300 lines

/
/

/ io3 --  Fortran I/O

.globl    getbuf
.globl    chkunit
.globl    creatf
.globl    openf

setio:
    mov    r1,unit
    jsr    r5,chkunit
    movb    utable(r1),r0
    beq    1f
    bpl    2f
    mov    r1,r0
    asl    r0
    mov    btable(r0),r0
    mov    r0,r2
    br    4f
2:
    cmp    (r5),r0
    beq    3f
    jsr    r5,rerr; 101.        / inconsistent use of unit
    sys    exit
1:
    mov    r1,-(sp)
    clr    r0
    dvd    $10.,r0
    swab    r1
    bis    r1,r0
    add    $"00,r0
    mov    r0,filnam+4
    mov    (sp)+,r1
    jsr    r5,getbuf
    mov    $filnam,r0
4:
    movb    (r5),utable(r1)
    bit    $1,(r5)
    bne    2f
    jsr    r5,creatf
    br    3f
2:
    jsr    r5,openf
3:
    tst    (r5)+
    asl    r1
    mov    btable(r1),buffer
    rts    r5

getbuf:
    mov    $utable,r0
    mov    $btable,r2
1:
    tstb    (r0)+
    beq    2f
    tst    (r2)+
    br    3f
2:
    tst    (r2)+
    beq    3f
    mov    -(r2),r0
    clr    (r2)
    mov    r0,r2
    br    2f
3:
    cmp    r0,$utable+20.
    blo    1b
    mov    bufp,r2
    add    $134.,bufp
    mov    bufp,0f
    sys    break; 0:..
2:
    mov    r1,r0
    asl    r0
    mov    r2,btable(r0)
    mov    r2,buffer
    rts    r5

chkunit:
    cmp    r1,$20.
    blo    1f
    jsr    r5,rerr; 100.        / illegal unit number
    sys    exit
1:
    rts    r5

creatf:
    cmp    unit,$6
    bne    2f
    mov    $1,r0
    br    1f
2:
    mov    r0,0f
    sys    creat; 0:..; 666
    bec    1f
    jsr    r5,rerr; 102.        / create error
    sys    exit
1:
    mov    r2,-(sp)
    mov    r0,(r2)+
    clr    (r2)+
    clr    (r2)+
    mov    r2,-(r2)
    mov    (sp)+,r2
    rts    r5

openf:
    cmp    unit,$5
    bne    2f
    clr    r0
    br    1f
2:
    mov    r0,0f
    sys    open; 0:..; 0
    bec    1f
    jsr    r5,rerr; 103.        / open error
    sys    exit
1:
    mov    r2,-(sp)
    mov    r0,(r2)+
    clr    (r2)+
    clr    (r2)+
    mov    (sp)+,r2
    rts    r5

fputc:
    mov    r1,-(sp)
    mov    buffer,r1
    dec    2(r1)
    bge    1f
    mov    r0,-(sp)
    jsr    pc,flush1
    dec    2(r1)
    mov    (sp)+,r0
1:
    movb    r0,*4(r1)
    inc    4(r1)
    mov    (sp)+,r1
    rts    r5

fflush:
    mov    r1,-(sp)
    mov    buffer,r1
    jsr    pc,flush1
    mov    (sp)+,r1
    rts    r5

flush1:
    mov    r1,r0
    add    $6,r0
    mov    r0,-(sp)
    mov    r0,0f
    neg    r0
    add    4(r1),r0
    bhis    1f
    mov    r0,0f+2
    mov    (r1),r0
    sys    write; 0:..; ..
1:
    mov    (sp)+,4(r1)
    mov    $128.,2(r1)
    rts    pc

fgetc:
    tst    nlflg
    bne    4f
    mov    r1,-(sp)
    mov    buffer,r1
    dec    2(r1)
    bge    1f
    mov    r1,r0
    add    $6,r0
    mov    r0,0f
    mov    r0,4(r1)
    mov    (r1),r0
    sys    read; 0:..; 128.
    bes    2f
    tst    r0
    bne    3f
2:
    jsr    r5,rerr; 104.        / EOF on input
    sys    exit
3:
    dec    r0
    mov    r0,2(r1)
1:
    clr    r0
    bisb    *4(r1),r0
    inc    4(r1)
    mov    (sp)+,r1
    tst    binflg
    bne    1f
    cmp    r0,$'\n
    bne    1f
4:
    mov    pc,nlflg
    mov    $' ,r0
1:
    rts    r5

gnum:
    mov    r1,-(sp)
    clr    r1
1:
    jsr    r5,fmtchr
    cmp    r0,$'  /
    beq    1b
    sub    $'0,r0
    cmp    r0,$9.
    bhi    1f
    mpy    $10.,r1
    add    r0,r1
    br    1b
1:
    mov    r1,r0
    mov    (sp)+,r1
    dec    formp
    rts    r5

switch:
    mov    (r5)+,r1
1:
    tst    (r1)
    beq    1f
    cmp    r0,(r1)+
    bne    1b
    tst    (sp)+
    jmp    *(r1)
1:
    rts    r5

fmtchr:
    movb    *formp,r0
    inc    formp
    rts    r5

getitm:
    tst    itmflg
    bne    1f
    mov    r5,-(sp)
    jmp    *(r4)+
1:
    clr    itmflg
    tst    (r5)+
    rts    r5

/ just a fake, there's no carriage control

fputcc:
    cmp    $' ,r0
    bne    1f
    inc    nspace
    rts    r5
1:
    mov    r0,-(sp)
1:
    dec    nspace
    blt    1f
    mov    $' ,r0
    jsr    r5,fputc
    br    1b
1:
    clr    nspace
    mov    (sp)+,r0
    beq    1f
    jsr    r5,fputc
1:
    rts    r5

eorec:
    mov    unit,r0
    bitb    $1,utable(r0)
    bne    1f
    clr    nspace
    mov    $'\n,r0
    jsr    r5,fputc
eorec1:
    clr    r0
    jsr    r5,fputcc
/    cmp    unit,$6            / tty output
/    bne    2f
    jsr    r5,fflush
2:
    rts    r5
1:
    tst    nlflg
    bne    1f
    jsr    r5,fgetc
    br    1b
1:
    clr    nlflg
    rts    r5

spaces:
    add    r1,nspace
    rts    r5