Princeton FORTH v2.0 for the VAX, part 8 of 8
William L. Sebok
wls at astrovax.UUCP
Tue Jun 26 11:56:12 AEST 1984
Part 8 of 8
This is a 32 bit public domain implementation of Forth that has been written
for a VAX running under 4.1 or 4.2 BSD UNIX. It has been running now for
about two years at the Astrophysics Dept. at Princeton University and is used
for image processing. It follows the 79-standards except: 1) entries on the
parameter stack are 32 bits wide, 2) addresses are 32 bits (rather than the
demanded 16 bits) wide, 3) Certain escape sequences beginning with a backslash
are recognized in the printing word ." ......"
Some extensions to the 79-standard are: 1) A character string stack, with a
full set of string operators. This also make manipulation of Unix file names
infinitely easier, 2) A floating point stack, and 3) A set of Unix interface
words.
Colon definitions are compiled as a series of bsbb, bsbw, or jsb instructions
(the shortest one that will reach) rather than as list of pointers. The ICODE
operator can be used instead of the ICODE operator for short definitions. When
a word defined by the ICODE operator is compiled its code is stuffed in-line
rather than referenced. Number references are compiled as the shortest of the
many possible instructions to push that number onto the stack.
Dearchive this package in a directory called forth. Edit the makefile to
point to the directory it is in. Convert the file ./vaxforth/forth.blk.txt
to a forth screen file ./vaxforth/forth.blk with the provided utility utf :
utf forth.blk.txt forth.blk
Good luck. I will be gone to an observing run at Mt. Palomar to use the
60 inch telescope there till July 11. I will happy to answer questions after
that.
William L. Sebok
Princeton Univ. Observatory
Peyton Hall, Rm. 129
Princeton, NJ 08544
Phone: (609)452-3586
Uucp: {allegra,akgua,burl,cbosgd,decvax,ihnp4,kpno,vax135}!astrovax!wls
-----------Cut here and extract with sh not csh---------------
mkdir ./vaxforth
/bin/echo 'Extracting ./vaxforth/forth3.S'
sed 's/^X//' <<'//go.sysin dd *' >./vaxforth/forth3.S
X/* ================================================================ */
X/* Dictionary Headers */
.byte 8f-0f
9: .word 9b-fdc1
9: .set fdc1,9b
.long INL+IM+06425151410 /* ASSEMBLER */
0: moval asmdic,context(%u)
8: rsb
.byte 8f-0f
9: .word 9b-fdc6
9: .set fdc6,9b
.long INL+IM+04121107450 /* FORTH */
0: moval fthdic,context(%u)
8: rsb
X/* Vocabulary Operations ----------------------------------- */
9: .word 9b-fdc6
9: .set fdc6,9b
.long 02435107460 /* FORGET (truncate dictionary chain) */
forget: bsbw tick
movl current(%u),context(%u)
movl current(%u),r0
cmpl (%s),-8(r0) /* trying to forget below FENCE? */
bgtru 0f
movl $E.FENCE,r0
jbr abort
0: subl3 $10,(%s)+,r1 /* back up dict pointer */
movl r1,%h
tstw -(%h) /* short link? */
bneq 1f /* yes */
tstl -(%h) /* if not, skip long link */
1: bitb $INL,(r1) /* was it in-line definition */
beql 2f /* no */
decl %h /* if so, skip in-line length */
2: movl $16,r1 /* init count to 16 threads */
3: movl (r0),r2 /* get 1st defin. in thread */
4: cmpl r2,%h /* compare against forgetting point */
blssu 6f /* if it doesn't stick beyond go to nxt thread*/
movzwl -(r2),r3 /* get short link */
beql 5f /* is it short link? */
subl2 r3,r2 /* yes */
bneq 4b /* is it end of chain? */
brb 6f
5: movl -(r2),r2 /* get long link */
bneq 4b /* end of chain? */
6: movl r2,(r0)+ /* replace truncated thread */
sobgtr r1,3b /* go to next thread */
rsb
9: .word 9b-fdc6
9: .set fdc6,9b
.long 01004147520 /* VOCABULARY */
bsbw create /* compile entry */
bisb2 $IM,*head(%u) /* make immediate */
addl3 $72,%h,(%h)+ /* set fence to be right here */
movl context(%u),(%h)+ /* set link to context vocabulary */
movc5 $0,(%h),$0,$64,(%h) /* clear room for 16 threads */
movl r3,%h
bsbw semcod
vocab: addl3 (%r)+,$8,context(%u)
rsb
X/* ================================================================ */
X/* Double Integer Operators (An Extension Word Set) */
.byte 8f-0f
9: .word 9b-fdc2
9: .set fdc2,9b
.long INL+020202020720 /* 2! */
0: movl (%s)+,r0
movq (%s)+,(r0)
8: rsb
.byte 8f-0f
9: .word 9b-fdc2
9: .set fdc2,9b
.long INL+020202000320 /* 2@ */
0: movl (%s)+,r0
movq (r0)+,-(%s)
8: rsb
9: .word 9b-fdc2
9: .set fdc2,9b
.long 011470741710 /* 2CONSTANT */
bsbw create
movq (%s)+,(%h)+
bsbw semcod
movq *(%r)+,-(%s)
rsb
.byte 8f-0f
9: .word 9b-fdc2
9: .set fdc2,9b
.long INL+010075102350 /* 2DROP */
0: addl2 $8,%s
8: rsb
.byte 8f-0f
9: .word 9b-fdc2
9: .set fdc2,9b
.long INL+020101242340 /* 2DUP */
0: movq (%s),-(%s)
8: rsb
.byte 8f-0f
9: .word 9b-fdc2
9: .set fdc2,9b
.long INL+011025307750 /* 2OVER */
0: movq 8(%s),-(%s)
8: rsb
9: .word 9b-fdc2
9: .set fdc2,9b
.long 020120751340 /* 2ROT */
movq 16(%s),-(%s)
movl %s,r0
addl2 $32,%s
movq -(r0),-(%s)
1: movq -(r0),-(%s)
movq -(r0),-(%s)
rsb
9: .word 9b-fdc2
9: .set fdc2,9b
.long 010005351750 /* 2SWAP */
d.swap: movq (%s)+,r0
movq (%s),r2
movq r0,(%s)
movq r2,-(%s)
rsb
9: .word 9b-fdc2
9: .set fdc2,9b
.long 04510053310 /* 2VARIABLE */
bsbw create
clrq (%h)+
rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020202026420 /* D- */
dminus: movq (%s)+,r0
subl2 r1,4(%s)
sbwc r0,(%s)
rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020202036420 /* D= */
bsbw dminus
bsbw dzeq
rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020114100440 /* DABS */
dabs: tstl (%s)
bgeq 1f
bsbw dnegate
1: rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020140046440 /* DMAX */
movq 8(%s),-(%s)
movq 8(%s),-(%s)
bsbw d.less
tstl (%s)+
beql 1f
movq (%s)+,(%s)
rsb
1: addl2 $8,%s
rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020070446440 /* DMIN */
movq 8(%s),-(%s)
movq 8(%s),-(%s)
bsbw d.less
tstl (%s)+
bneq 1f
movq (%s)+,(%s)
rsb
1: addl2 $8,%s
rsb
X/* Double operators not in Standard ---------- */
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020202065430 /* D+! (double sum into addr) */
movl (%s)+,r0
addl2 (%s)+,(r0)+
addl2 (%s)+,(r0)
adwc $0,-(r0)
rsb
9: .word 9b-fdc2
9: .set fdc2,9b
.long 03044411760 /* 2SHIFT (shift double integer) */
movl (%s)+,r2
movl (%s)+,r1
movl (%s),r0
ashq r2,r0,r0
movl r0,(%s)
movl r1,-(%s)
rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020024601040 /* DBLE (signed conversion to double) */
clrl -(%s)
tstl 4(%s)
bgeq 1f
decl (%s)
1: rsb
X/* ================================================================ */
X/* Numeric Output */
9: .word 9b-fdcd
9: .set fdcd,9b
.long 0020200351430 /* MSG (A compiling word for chrs) */
bsbw create
bsbw semcod
fmsg: bsbw does
bsbw count
brw type
9: .word 9b-fdc3
9: .set fdc3,9b
.long 02414050150 /* SPACE (type a space) */
space: bsbb fmsg
.byte 1,BLANK
9: .word 9b-fdc3
9: .set fdc3,9b
.long 020202011020 /* CR */
cr: bsbb fmsg
.byte 1,NL
9: .word 9b-fdc6
9: .set fdc6,9b
.long 020202003020 /* FF (form feed) */
bsbb fmsg
.byte 1,12
9: .word 9b-fdc2
9: .set fdc2,9b
.long 020060602440 /* BELL */
bsbb fmsg
.byte 1,7
9: .word 9b-fdc3
9: .set fdc3,9b
.long 02414050160 /* SPACES */
spaces: movl (%s)+,r0
bgtr 1f
rsb
1: addl3 %h,$PADOFF,r1
movq r0,-(%s)
movc5 $0,(r1),$BLANK,r0,(r1)
movl typer(%u),r0
jmp *(r0)+
9: .word 9b-fdc8
9: .set fdc8,9b
.long 020020607440 /* HOLD */
hold: decl dbparen(%u)
cvtlb (%s)+,*dbparen(%u)
rsb
.byte 8f-0f
9: .word 9b-fdc0
9: .set fdc0,9b
.long INL+020200200530 /* PAD */
0: addl3 %h,$PADOFF,-(%s)
8: rsb
.byte 8f-0f
9: .word 9b-fdcc
9: .set fdcc,9b
.long INL+020202021720 /* <# */
0: addl3 %h,$PADOFF,dbparen(%u)
8: rsb
9: .word 9b-fdc3
9: .set fdc3,9b
.long 020202037220 /* #> */
sharpls:
addl3 %h,$PADOFF,(%s)+
movl dbparen(%u),(%s)
subl2 (%s),-(%s)
2: rsb
9: .word 9b-fdc3
9: .set fdc3,9b
.long 020070344540 /* SIGN */
sign: tstl (%s)+
bgeq 2b
movl $'-,-(%s)
brb hold
9: .word 9b-fdcd
9: .set fdcd,9b
.long 02074667450 /* M/MOD divide double by single */
m_mod: movl (%s)+,r3 /* get divisor */
movl (%s)+,r1 /* get high dividend */
movl (%s)+,r0 /* get low dividend */
clrl r2 /* super high dividend is zero */
ashq $1,r0,r0 /* move low part around */
ediv r3,r1,r2,r1 /* divide high part */
ashq $-1,r0,r0 /* move low part back */
ediv r3,r0,r1,r0 /* divide low part */
ashl $1,r1,r1
ashq $-1,r1,r1 /* move high part back */
movl r1,-(%s) /* low part of quotient */
movl r2,-(%s) /* high part of quotient */
movl r0,-(%s) /* remainder */
rsb
9: .word 9b-fdc3
9: .set fdc3,9b
.long 020202020210 /* # (extract digit and cvt to char) */
sharp: movl base(%u),-(%s)
bsbw m_mod
cmpl (%s),$9
bleq 1f
addl2 $7,(%s)
1: addl2 $'0,(%s)
decl dbparen(%u)
cvtlb (%s)+,*dbparen(%u)
rsb
9: .word 9b-fdc3
9: .set fdc3,9b
.long 020202011620 /* #S (convert until done) */
sharpS: bsbb sharp
movq (%s),r0
bneq sharpS
rsb
pr: addl3 %h,$PADOFF,dbparen(%u)
bsbb sharpS
bsbw rot
bsbw sign
brw sharpls
9: .word 9b-fdc8
9: .set fdc8,9b
.long 020202467230 /* (.) */
dot0: movl (%s),-(%s)
bsbw abs
clrl -(%s)
brb pr
9: .word 9b-fdce
9: .set fdce,9b
.long 020202020210 /* . (print a number) */
dot: bsbb dot0
bsbw type
brw space
9: .word 9b-fdcf
9: .set fdcf,9b
.long 020202020310 /* ? (print number at address) */
movl *(%s)+,-(%s)
brb dot
9: .word 9b-fdc8
9: .set fdc8,9b
.long 020246712640 /* (U.) */
udot0: clrl -(%s)
bsbw swap
clrl -(%s)
brb pr
9: .word 9b-fdc5
9: .set fdc5,9b
.long 020202027120 /* U. (print unsigned number) */
bsbb udot0
bsbw type
brw space
9: .word 9b-fdc8
9: .set fdc8,9b
.long 020246702240 /* (D.) */
d.dot0: bsbw swap
movl 4(%s),-(%s)
bsbw dabs
brb pr
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020202027020 /* D. (print double integer) */
bsbb d.dot0
bsbw type
brw space
rdot: subl3 (%s),(%r)+,-(%s)
bsbw spaces
brw type
9: .word 9b-fdce
9: .set fdce,9b
.long 020202011220 /* .R (right justified signed print) */
dotr: pushl (%s)+
bsbw dot0
brb rdot
9: .word 9b-fdc5
9: .set fdc5,9b
.long 020201127130 /* U.R (right justified unsigned dot) */
u.r: pushl (%s)+
bsbw udot0
brb rdot
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020201127030 /* D.R (right justified double dot) */
d.r: pushl (%s)+
bsbw d.dot0
brb rdot
9: .word 9b-fdcd
9: .set fdcd,9b
.long 04405112210 /* -TRAILING (delete trailing blanks) */
mtrail: movl (%s)+,r0
bleq 2f
addl3 (%s),r0,r1
1: cmpb -(r1),$BLANK
bneq 2f
sobgtr r0,1b
2: movl r0,-(%s)
rsb
9: .word 9b-fdcc
9: .set fdcc,9b
.long 020024704440 /* LINE */
line: cvtwl $64,-(%s)
cvtwl $1024,-(%s)
bsbw tmdvmod
addl2 scr(%u),(%s)
bsbw block
addl2 (%s)+,(%s)
rsb
9: .word 9b-fdcc
9: .set fdcc,9b
.long 020121144440 /* LIST */
list: movl (%s)+,scr(%u)
clrl -(%r)
1: bsbw cr
movl (%r),-(%s)
movl $3,-(%s)
bsbw dotr
bsbw space
movl (%r),-(%s)
bsbb line
cvtwl $LNSIZ,-(%s)
bsbw mtrail
bsbw s.at
bsbw sdot
acbl $15,$1,(%r),1b
tstl (%r)+
rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020100652440 /* DUMP */
dump: clrl -(%s)
bsbw do
1: bsbw cr
movl (%s),-(%s)
movl $12,-(%s)
bsbw u.r
movl $3,-(%s)
bsbw spaces
addl3 $1,4(%r),-(%s)
addl3 $4,(%r),-(%s)
bsbw min
movl (%r),-(%s)
bsbw do
2: bsbw space
movl *0(%s),-(%s)
movl $12,-(%s)
bsbw u.r
addl2 $4,(%s)
aobleq 4(%r),(%r),2b
addl2 $8,%r
acbl 4(%r),$4,(%r),1b
addl2 $8,%r
tstl (%s)+
rsb
X/* ============================================================ */
X/* Editor Vocabulary (Small Resident Line Oriented Editor) */
.set LNSIZ,64 /* max size of edited line */
.set LLNSIZ,6 /* log2(LNSIZ) */
.set edc0,0
.set edc1,0
.set edc2,0
.set edc3,0
.set edc4,0
.set edc5,0
.set edc6,0
.set edc7,0
.set edc8,0
.set edc9,0
.set edca,0
.set edcb,0
.set edcc,0
.set edcd,0
.set edce,0
.set edcf,0
ehold: movl (%s),-(%s)
bsbw line
cvtbl $LNSIZ,-(%s)
bsbw s.at
rsb
9: .word 9b-edc8
9: .set edc8,9b
.long 020202020210 /* ( */
bsbw paren
movl %h,-(%s)
bsbw spush
rsb
9: .word 9b-edc4
9: .set edc4,9b
.long 020202020110 /* T (type out line) */
bsbw cr
movl $2,-(%s)
bsbw spaces
bsbb ehold
bsbw sdup
bsbw sdot
rsb
9: .word 9b-edc2
9: .set edc2,9b
.long 020202020110 /* R (replace line) */
e.r: bsbw line
cvtbl $LNSIZ,-(%s)
bsbw s.stor
bsbw update
rsb
9: .word 9b-edc4
9: .set edc4,9b
.long 020202020010 /* D (delete line) */
bsbb ehold
movl (%s),-(%s)
bsbw line
movl (%s)+,r0
subl3 (%s)+,$15,r1
bleq 1f
ashl $LLNSIZ,r1,r1
movc3 r1,LNSIZ(r0),(r0)
1: movl $15,-(%s)
bsbw line
movc5 $0,(%h),$BLANK,$LNSIZ,*(%s)+
bsbw update
rsb
9: .word 9b-edc9
9: .set edc9,9b
.long 020202020010 /* I ( Insert line) */
incl (%s)
movl (%s),-(%s)
bsbw line
movl (%s)+,r0
subl3 (%s),$15,r1
bleq 1f
ashl $LLNSIZ,r1,r1
movc3 r1,(r0),LNSIZ(r0)
1: bsbb e.r
rsb
9: .word 9b-edcc
9: .set edcc,9b
.long 020202020010 /* L (List current block) */
movl scr(%u),-(%s)
movl (%s),-(%s)
bsbw dot
bsbw list
rsb
9: .word 9b-edc3
9: .set edc3,9b
.long 020145007440 /* COPY (one disk block to another) */
movl (%s)+,-(%r)
bsbw block
movl (%s)+,r0
movl (%r)+,(link1+locat)(r0)
bsbw update
rsb
9: .word 9b-fdc5
9: .set fdc5,9b
ednam: .long IM+07520442060 /* EDITOR */
jsb *$vocab
.long hinit,fthdic
edic: .long edc0,edc1,edc2,edc3,edc4,edc5,edc6,edc7
.long edc8,edc9,edca,edcb,edcc,edcd,edce,edcf
X/* ========================================================================== */
X/* << System Call Interface >> */
unxerr: movl _errno,r0
jbr uerror
un1err: tstl r0
blss 1f
clrl errno(%u)
rsb
1: movl _errno,errno(%u)
rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 011474601660 /* $CLOSE */
s_close:
pushl (%s)+
calls $1,_close
brb un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 07025007650 /* $OPEN */
pushl (%s)
pushal 1(%c)
bsbw sdrop
calls $2,_open
movl r0,(%s)
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 0425101670 /* $CREATE */
s_create:
pushl (%s)
pushal 1(%c)
bsbw sdrop
calls $2,_creat
movl r0,(%s)
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 02004251250 /* $READ */
s_read: movl (%s)+,r1
pushl (%s)+
pushl (%s)
pushl r1
calls $3,_read
movl r0,(%s)
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 012045113660 /* $WRITE */
s_write:
movl (%s)+,r1
pushl (%s)+
pushl (%s)
pushl r1
calls $3,_write
movl r0,(%s)
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 012014744660 /* $IOCTL */
s_ioctl:
movq (%s)+,r0
pushl (%s) /* buf */
pushl r1 /* code */
pushl r0 /* descr */
calls $3,_ioctl
movl r0,(%s)
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 04460712670 /* $UNLINK */
s_unlink:
pushal 1(%c)
bsbw sdrop
calls $1,_unlink
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 07464401660 /* $CHMOD */
s_chmod:
pushl (%s)+
pushal 1(%c)
bsbw sdrop
calls $2,_chmod
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020200201630 /* $CD */
pushal 1(%c)
bsbw sdrop
calls $1,_chdir
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020101242240 /* $DUP */
pushl (%s)
calls $1,_dup
movl r0,(%s)
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 05424251650 /* $SEEK */
s_seek:
movl (%s)+,r1
pushl (%s)+
pushl (%s)
pushl r1
calls $3,_lseek
movl r0,(%s)
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 02425146260 /* $LSEEK */
s_lseek:
movl (%s)+,r1
pushl (%s)+
tstl (%s)+
pushl (%s)+
pushl r1
calls $3,_lseek
movl r0,-(%s)
clrl -(%s)
bgeq 1f
decl (%s)
1: brw un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 03470246270 /* $LENGTH */
movl (%s)+,r0
clrl -(%s)
movl $2,-(%s)
movl r0,-(%s)
jbr s_seek /* seek to end of file and return length */
X/* keeping chmk here because I want to keep feature that the child
receives its parent's uid */
9: .word 9b-fdc4
9: .set fdc4,9b
.long 05510743250 /* $FORK */
pushl $0
movl sp,ap
#ifdef BSD4_2
chmk $SYS_fork
#else
chmk $fork
#endif
jcs 1f
clrl errno(%u)
brb 2f
1:
movl _errno,errno(%u)
2:
tstl (%r)+
movl r0,-(%s)
movl r1,-(%s)
rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 01425402650 /* $EXEC */
addl3 $2,(%s),r6 /* get counter (1st two args are prog name) */
pushl $0 /* provide stopper for end of arg list */
movl %c,(%s) /* args are stacked on string stack */
1: addl3 $1,(%s),-(%r)
bsbw sdown /* go to next one below */
sobgtr r6,1b /* loop */
movl (%r)+,r0 /* retrieve last argument */
pushl envir /* add environment string */
pushal 4(%r) /* add arg list */
pushl r0 /* add routine name */
pushl $3
movl %r,ap
#ifdef BSD4_2
chmk $SYS_execve
#else
chmk $exece
#endif
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 012044053650 /* $WAIT */
clrl -(%s)
pushl %s
calls $1,_wait
movl r0,-(%s)
jbr un1err
X/* Calling Sequence: --- out in */
9: .word 9b-fdc4
9: .set fdc4,9b
.long 02500450250 /* $PIPE */
clrq -(%s)
pushl %s
calls $1,_pipe
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 06060445650 /* $KILL */
s_kill: pushl (%s)+
pushl (%s)+
calls $2,_kill
jbr un1err
9: .word 9b-fdc4
9: .set fdc4,9b
.long 012045402650 /* $EXIT */
s_exit: pushl (%s)+
calls $2,__exit
9: .word 9b-fdc4
9: .set fdc4,9b
.long 010120243670 /* $GETPID */
s_getpid:
calls $0,_getpid
movl r0,-(%s)
jbr un1err
X/* ========================================================================== */
X/* FORTH `WAIT' routine (relict of stand-alone FORTH multi-tasking). */
X/* Under UNIX this routine merely switches between co-processes. */
#ifdef COPROCESS
c_wait: movl %u,r0 /* get reference u pointer */
1: movl -(%u),%u /* get next u */
tstl (%u) /* is he awake? */
bneq 1b /* no, try next guy. */
cmpl r0,%u /* same as current process? */
beql 2f /* yes, no need for context switch. */
pushl 0x0f00 /* save registers (s,h,c,f) */
movl %r,rsav(%u) /* save r */
movl %u,*$owner /* flag new guy as in control. */
movl rsav(%u),%r /* recall r */
popr 0x0f00 /* restore registers (s,h,c,f) */
2: rsb
#endif
9: .word 9b-fdcf
9: .set fdcf,9b
.long 011024713450 /* OWNER is the co-process in control */
moval owner,-(%s)
rsb
X/* =============================================================== */
X/* Words to access User area fields */
udef: addl3 %u,*(%r)+,-(%s)
rsb
9: .word 9b-fdc7
9: .set fdc7,9b
.long 020202012620 /* 'U */
movl %u,-(%s)
rsb
9: .word 9b-fdc2
9: .set fdc2,9b
.long 020120741140 /* RBOT */
jsb *$udef
.long rbot
9: .word 9b-fdc3
9: .set fdc3,9b
.long 020120741140 /* SBOT */
jsb *$udef
.long sbot
9: .word 9b-fdc4
9: .set fdc4,9b
.long 011025014550 /* TYPER */
jsb *$udef
.long typer
9: .word 9b-fdc4
9: .set fdc4,9b
.long 011025014560 /* TYPER0 */
jsb *$udef
.long typer0
9: .word 9b-fdc2
9: .set fdc2,9b
.long 02420042560 /* READER */
jsb *$udef
.long reader
9: .word 9b-fdc2
9: .set fdc2,9b
.long 02420042570 /* READER0 */
jsb *$udef
.long reader0
9: .word 9b-fdc8
9: .set fdc8,9b
.long 020020042440 /* HEAD */
jsb *$udef
.long head
9: .word 9b-fdc4
9: .set fdc4,9b
.long 0425100450 /* DAREA */
jsb *$udef
.long darea
#ifdef COPROCESS
9: .word 9b-fdcc
9: .set fdcc,9b
.long 012070541450 /* LCKNT */
jsb *$udef
.long lcknt
#endif
9: .word 9b-fdce
9: .set fdce,9b
.long 020014746340 /* >LOC */
jsb *$udef
.long floc
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020200610030 /* DPL */
jsb *$udef
.long dpl
9: .word 9b-fdc3
9: .set fdc3,9b
.long 020201101530 /* SCR */
jsb *$udef
.long scr
9: .word 9b-fdc2
9: .set fdc2,9b
.long 020025140440 /* BASE */
jsb *$udef
.long base
9: .word 9b-fdc3
9: .set fdc3,9b
.long 02520707470 /* CONTEXT */
jsb *$udef
.long context
9: .word 9b-fdc3
9: .set fdc3,9b
.long 02511112470 /* CURRENT */
jsb *$udef
.long current
9: .word 9b-fdc3
9: .set fdc3,9b
.long 02520052150 /* STATE */
jsb *$udef
.long state
9: .word 9b-fdce
9: .set fdce,9b
.long 020200704730 /* >IN */
jsb *$udef
.long in
9: .word 9b-fdc2
9: .set fdc2,9b
.long 020200546030 /* BLK */
jsb *$udef
.long blk
9: .word 9b-fdcd
9: .set fdcd,9b
.long 012410351460 /* MSGBUF */
jsb *$udef
.long msgbuf
9: .word 9b-fdcd
9: .set fdcd,9b
.long 012410351470 /* MSGBUF0 */
jsb *$udef
.long msgbuf0
9: .word 9b-fdc8
9: .set fdc8,9b
.long 020202024620 /* () */
jsb *$udef
.long dbparen
9: .word 9b-fdc3
9: .set fdc3,9b
.long 012074111550 /* SSBOT */
jsb *$udef
.long ssbot
9: .word 9b-fdc6
9: .set fdc6,9b
.long 012074111450 /* FSBOT */
jsb *$udef
.long fsbot
9: .word 9b-fdc5
9: .set fdc5,9b
.long 07471111050 /* ERRNO */
jsb *$udef
.long errno
9: .word 9b-fdc3
9: .set fdc3,9b
.long 0470344560 /* SIGNAL */
jsb *$udef
.long quitadd
X/* ---------------------------------------------------------------------- */
X/* Messages (Permanent) */
msgstr: .word (msg0-msgs)
.word (msg1-msgs)
.word (msg2-msgs)
.word (msg3-msgs)
.word (msg4-msgs)
.word (msg5-msgs)
.word (msg6-msgs)
.word (msg7-msgs)
.word (msg8-msgs)
.word (msg9-msgs)
.word (msg10-msgs)
.word (msg11-msgs)
.word (msg12-msgs)
.word (msg13-msgs)
.word (msg14-msgs)
.word (msg15-msgs)
.word (msg16-msgs)
.word (msg17-msgs)
.word (msg18-msgs)
.word (msg19-msgs)
.word (msg20-msgs)
.word (msg21-msgs)
.word (msg22-msgs)
.word (msg23-msgs)
.word (msg24-msgs)
.word (msg25-msgs)
.word (msg26-msgs)
.word (msg27-msgs)
.word (msg28-msgs)
.word (msg29-msgs)
.word (msg30-msgs)
.word (msg31-msgs)
.word (msg32-msgs)
.word (msg33-msgs)
.word (msg34-msgs)
.word (msg35-msgs)
.word (msg36-msgs)
.word (msg37-msgs)
.word (msg38-msgs)
.word (msg39-msgs)
.word (msg40-msgs)
.word (msg41-msgs)
.word (msg42-msgs)
.word (msg43-msgs)
.word (msg44-msgs)
.word (msg45-msgs)
.word (msg46-msgs)
.word (msg47-msgs)
.word (msg48-msgs)
.word (msg49-msgs)
.word (msg50-msgs)
.word (msg51-msgs)
.word (msg52-msgs)
.word (msg53-msgs)
.word (msg54-msgs)
.word (msg55-msgs)
.word (msg56-msgs)
.word (msg57-msgs)
.word (msg58-msgs)
msglen:
.byte (msg1-msg0)
.byte (msg2-msg1)
.byte (msg3-msg2)
.byte (msg4-msg3)
.byte (msg5-msg4)
.byte (msg6-msg5)
.byte (msg7-msg6)
.byte (msg8-msg7)
.byte (msg9-msg8)
.byte (msg10-msg9)
.byte (msg11-msg10)
.byte (msg12-msg11)
.byte (msg13-msg12)
.byte (msg14-msg13)
.byte (msg15-msg14)
.byte (msg16-msg15)
.byte (msg17-msg16)
.byte (msg18-msg17)
.byte (msg19-msg18)
.byte (msg20-msg19)
.byte (msg21-msg20)
.byte (msg22-msg21)
.byte (msg23-msg22)
.byte (msg24-msg23)
.byte (msg25-msg24)
.byte (msg26-msg25)
.byte (msg27-msg26)
.byte (msg28-msg27)
.byte (msg29-msg28)
.byte (msg30-msg29)
.byte (msg31-msg30)
.byte (msg32-msg31)
.byte (msg33-msg32)
.byte (msg34-msg33)
.byte (msg35-msg34)
.byte (msg36-msg35)
.byte (msg37-msg36)
.byte (msg38-msg37)
.byte (msg39-msg38)
.byte (msg40-msg39)
.byte (msg41-msg40)
.byte (msg42-msg41)
.byte (msg43-msg42)
.byte (msg44-msg43)
.byte (msg45-msg44)
.byte (msg46-msg45)
.byte (msg47-msg46)
.byte (msg48-msg47)
.byte (msg49-msg48)
.byte (msg50-msg49)
.byte (msg51-msg50)
.byte (msg52-msg51)
.byte (msg53-msg52)
.byte (msg54-msg53)
.byte (msg55-msg54)
.byte (msg56-msg55)
.byte (msg57-msg56)
.byte (msg58-msg57)
.byte (msg59-msg58)
X/* =============================================================== */
X/* Impure Code Region */
X.data
.long hinit-4,0 /* FORTH vocab head */ /* fence and link */
fthdic: .long fdc0,fdc1,fdc2,fdc3,fdc4,fdc5,fdc6,fdc7
.long fdc8,fdc9,fdca,fdcb,fdcc,fdcd,fdce,fdcf
.long hinit-4,fthdic /* ASSEMBLER vocab head */ /* fence and link */
asmdic: .long adc0,adc1,adc2,adc3,adc4,adc5,adc6,adc7
.long adc8,adc9,adca,adcb,adcc,adcd,adce,adcf
owner: .long user /* co-process currently in control */
utop: .long 0 /* top of available memory. */
envir: .long 0 /* location of environment */
X/* terminal control block */
.word 0,0,0
.word 0,0,0
.byte 0 /* input channel number */
.byte 0xff /* mung flag */
.long unxin
tty: .long unxout
.long 1
sbreak: .long 0 /* current size of memory */
msgfil: .long 0 /* file descriptor for message file */
trpad0: .space 60 /* location of latest trap */
trpadd: .space 20
X/* Disk Block cross reference table */
dtabl: .space Blktab /* reserve space for disk table */
X/* Primary user area ------------------------------------------- */
.long user /* link to next task in circular chain */
user: .long 0 /* 0 if task active, not 0 if inactive */
.long 0 /* RSAV save r */
.long 0 /* RBOT bottom of return stack. */
.long 0 /* SBOT bottom of parameter stack. */
.long tty /* TYPER points to device used in TYPE command */
.long tty /* 0TYPER points to device used in 0TYPE command. */
.long tty /* READER points to device used in EXPECT command. */
.long tty /* 0READER used to reset READER. */
.long 0 /* HEAD points to most recently compiled word. */
.long dtabl /* DAREA points to area which describes disk buffers */
.long 1 /* LCKNT count of times disk buffer is kept locked. */
.long 0 /* >LOC pointer to location being compiled in file. */
.long 0 /* DPL characteristics of last number interpreted by */
/* CONVERT low byte contains decimal digit count */
/* high byte contains flags. */
.long 0 /* SCR block being manipulated by editor */
.long 10 /* BASE used in number conversions */
.long fthdic /* CONTEXT vocabulary used for searches. */
.long fthdic /* CURRENT vocabulary in which new Words are compiled*/
.long 0 /* STATE ==0 if execute, !=0 if compile */
.long 0 /* >IN char pointer in line being interpreted */
.long 3 /* BLK block being currently interpreted */
/* if= 0 then input from keyboard. */
/* if > CHANBOT then BLK-CHANBOT is file descriptor */
/* (kluge to permit interpretation of files). */
.long 0 /* MSGBUF message buffer for terminal I/O */
.long 0 /* 0MSGBUF cell used to reset MSGBUF. */
.long 0 /* () used for graphics and number output */
.long 0 /* SSBOT string stack bottom */
.long 0 /* FSBOT bottom of floating point stack */
.long 0 /* ERRNO unix error number */
.long 0 /* QUITADD intercept forth QUIT (like a Unix signal).*/
hinit: /* dictionary starts here */
X/* Initialization Code given control when Forth is first entered. */
X/* (this code goes away when Forth is running). */
strtup:
movl %r,utop /* tell where our top of memory is. */
movl (%r),r3 /* get number of arguments */
moval 8(%r)[r3],envir /* save location of environment string */
X/* Analyse command string */
addl3 $8,%r,r2 /* get beginning of arg list */
decl r3
bleq endarg /* quit if no arguments */
parstring: /* interpret `argv' */
movl (r2)+,r0 /* get arg */
cmpb (r0)+,$'- /* is it `-' flag? */
beql checksym /* yes */
decl r0 /* back up pointer */
movl r0,b.nam /* use it for default BLOCK file. */
brb nxtarg
checksym:
mnegl $1,r4 /* init counter */
1: incl r4
movl symtab[r4],r1 /* get pointer to symbol */
bneq 2f
brw 9f /* if none match then trouble */
2: cmpb (r0),(r1)+ /* this char match? */
bneq 1b /* no, try next symbol. */
tstb (r0)+ /* if yes, is this end of strings? */
bneq 2b /* no, try next chars. */
pushl argtab[r4]
rsb /* execute operation. */
nxtarg: sobgtr r3,parstring /* get next argument */
endarg: jbr endrgs /* skip over stuff */
X/* -w Open block file for update */
d.w: movl $2,b.mod
jbr nxtarg
X/* -l Suppress automatic loading of block 3. */
d.l: clrl (user+blk)
jbr nxtarg
X/* -buf n Use n buffers (default 7) */
d.buf: bsbw cnvoct
movl r0,nbuf
jbr nxtarg
X/* -top n Use address n as top of memory. */
d.top: bsbw cnvoct
movl r0,utop
movl r0,%r /* make stack grow down from here */
jbr nxtarg
X/* -s Disable Signal Trapping */
d.nhp: clrl hupp
jbr nxtarg
symtab: .long sm1,sm2,sm3,sm4,sm5,0
argtab: .long d.w,d.l,d.buf,d.top,d.nhp
sm1: .asciz "w"
sm2: .asciz "l"
sm3: .asciz "buf"
sm4: .asciz "top"
sm5: .asciz "s"
X/* subroutine returns octal arg in r0 */
cnvoct: decl r3 /* dec argument count */
beql 9f
movl (r2)+,r1
clrl r0
1: movb (r1)+,r4
beql 2f /* quit if done */
subl2 $'0,r4
blss 9f
cmpb r4,$7
bgtr 9f /* valid digits between 0 and 7 */
ashl $3,r0,r0
addl2 r4,r0
brb 1b
2: rsb
1: .ascii "Error in Arguments!!!\n"
2:
9:
argerr: pushl $(2b-1b)
pushal 1b
pushl $2
moval _write,r0
calls $3,(r0)
pushl $1
moval __exit,r0
calls $1,(r0)
endrgs:
X/* initialize BLOCK buffers */
bfset: movl nbuf,r2 /* set number of buffers */
moval user,%u /* set u */
movl darea(%u),r4 /* get disk area */
movl r4,(r4)
movl r4,4(r4) /* init link to link to itself */
movl r2,bufs(r4) /* save number of buffers */
movl $1,n.blktab(r4) /* set initially 1 block file */
movl r4,r1
bicl2 $3,%r /* align stack */
1: clrl -(%r) /* clr hard link pointer */
clrl -(%r) /* clr backward link */
clrl -(%r) /* clr forward link */
insque (%r),(r1) /* insert buffer in queue */
movl %r,link0(r1) /* set hard link */
movl %r,r1 /* save for next link */
mnegl $1,-(%r) /* set location to be undefined */
clrl -(%r) /* clr ownership mark */
clrl -(%r) /* clr update flag and lock count */
movl $(BUFLEN/4),r0 /* skip over buffer */
2: clrl -(%r)
sobgtr r0,2b
sobgtr r2,1b
movl $((TBUFSIZ+3)/4),r0 /* allocate terminal buffer */
0: clrl -(%r)
sobgtr r0,0b
movl %r,msgbuf(%u) /* init msg buffer address */
movl %r,msgbuf0(%u) /* init msg buffer reset */
movl %r,rbot(%u) /* init r stack bottom */
movl $(RSTKSZ/4),r0 /* allocate RSTKSZ word for r stack */
0: clrl -(%r)
sobgtr r0,0b
movl %r,ssbot(%u) /* set string stack bottom */
movl %r,%c /* set string stack pointer */
movl $(STRSTKSZ/4),r0 /* allocate STRSTKSZ for string stack */
1: clrl -(%r)
sobgtr r0,1b
movl %r,fsbot(%u) /* set floating point stack bottom */
movl $(FSTKSZ/4),r0
2: clrl -(%r)
sobgtr r0,2b
movl %r,sbot(%u) /* set s stack bottom */
movl %r,%s
bicl3 $017777,%r,r0 /* to nearest byte boundary */
0: clrl -(%r)
cmpl %r,r0 /* clear stack */
bgtru 0b
movl rbot(%u),%r /* recall return stack top */
X/* Open initial BLOCK file. */
pushl b.mod
pushl b.nam
moval _open,r0
calls $2,(r0) /* open block file */
tstl r0
bgeq 5f
brb 1f
0: .byte 1f-0b-1
.ascii "BLOCK file cannot be Opened!!!\n"
1:
moval 0b,-(%s)
moval sdot,r0
jsb (r0)
movl $1,-(%s)
moval s_exit,r0
jmp (r0)
5:
movb r0,f.blktab(r4) /* save file descriptor. */
X/* find block number of last block. */
opnblk: clrl -(%s)
movl $2,-(%s)
movl r0,-(%s)
moval s_seek,r0
jsb (r0) /* find last block number */
ashl $-10,(%s)+,r0
decl r0
movl r0,e.blktab(r4) /* place in table */
X/* Create and Open Message File in /tmp directory */
crtfil: moval s_getpid,r0
jsb (r0) /*get process id (to make name unique)*/
bicl3 $0xffff0000,(%s)+,r0
cvtlp r0,$5,msgpck /* convert to packed decimal */
cvtps $5,msgpck,$6,msgpid /* convert to decimal */
#ifdef BSD4_2
pushl $0600
pushl $03002 /* O_CREAT|O_TRUNC|O_RDWR */
pushal msgnam
moval _open,r0
calls $3,(r0) /* open and create file */
tstl r0
jlss 1f
#else
pushl $0600
pushl $2
pushal msgnam
moval _creat,r0
calls $2,(r0) /* create file */
tstl r0
jlss 1f
pushl r0
moval _close,r0
calls $1,(r0)
pushl $2
pushal msgnam
moval _open,r0
calls $2,(r0) /* reopen for update */
tstl r0
jlss 1f
#endif
movl r0,msgfil /* save file descriptor */
pushal msgnam
moval _unlink,r0
calls $1,(r0) /* make entry anonymous */
brb wrtmsg
0: .byte 1f-0b-1
.ascii "Unable to Create Message File!!\n"
1: moval 0b,-(%s)
bsbw sdot
movl $1,-(%s)
moval s_exit,r0
jmp (r0)
wrtmsg:
moval msgs,-(%s)
movl $(e.msgs-msgs),-(%s)
movl msgfil,-(%s)
moval s_write,r0
jsb (r0)
tstl (%s)+
X/* Get Terminal Modes */
moval tty,r4
moval s.arg(r4),-(%s)
movl $TIOCGETP,-(%s)
cvtbl rchan(r4),-(%s)
moval s_ioctl,r0
jsb (r0)
tstl (%s)+
movc3 $12,s.arg(r4),is.arg(r4)
#ifdef FPROMPT
bisw2 $FPROMPT,(is.mode+tty) /* make FORTH mode default */
#endif
X/* Set Signals */
blbc hupp,0f
moval hup,r0
jsb (r0)
0:
X/* Initialize Registers and invoke go-loop */
movl fsbot(%u),%f /* init floating point stack */
movl ssbot(%u),%c /* init string stack */
moval hinit,%h /* init dictionary pointer */
pushal quit /* quit after system is loaded */
pushl $0
pushl $0
pushl $0
pushal goloop
rsb
fthblk: .asciz FBLK /* default block file */
msgnam: .ascii "/tmp/"
msgnm0: .ascii "ForthMsg" /* name of Message File */
msgpid: .ascii "XXXXXX" /* cell into which pid number is placed */
.word 0
msgpck: .long 0
hupp: .long 1 /* Enable/disable signal trapping */
nbuf: .long NBUF /* number of buffers */
X/* arg list for block file open */
b.nam: .long fthblk /* pointer to name of block */
b.mod: .long 0 /* open mode for block file */
X/* Initialization of Message File. */
msgs:
msg0: .ascii "\n"
msg1: .ascii " Uncompleted Control Structure!!!"
msg2: .ascii " ?"
msg3: .ascii " Stack Empty!"
msg4: .ascii " Dictionary Full!"
msg5: .ascii " Return Stack Overflow!!!"
msg6: .ascii " All Buffers Locked !!!"
msg7: .ascii " Undefined Block Number !!!"
msg8: .ascii " Attempt to Overflow Dictionary!!!"
msg9: .ascii " Attempt to FORGET below Vocab. FENCE!!!"
msg10: .ascii " String Stack Empty!"
msg11: .ascii " Bad String on String Stack!"
msg12: .ascii " String Stack Overflow!"
msg13: .ascii " Floating Point Stack Empty!"
msg14: .ascii " Floating Point Stack Overflow!"
msg15: .ascii " Ran off end of Line!"
msg16: .ascii " Undefined UNIX Error!!!"
msg17: .ascii " Uerr - Permission Violation!!!"
msg18: .ascii " Uerr - No Such File!!!"
msg19: .ascii " Uerr - No Such Process!!!"
msg20: .ascii " Uerr - Interrupted System Call!!!"
msg21: .ascii " Uerr - I/O Error!!!"
msg22: .ascii " Uerr - No Such Device or Out of Bounds!!!"
msg23: .ascii " Uerr - Argument List too Long!!!"
msg24: .ascii " Uerr - Unexecutable File!!!"
msg25: .ascii " Uerr - File Unopened or Write Protected!!!"
msg26: .ascii " Uerr - No Subprocesses on which to Wait!!!"
msg27: .ascii " Uerr - Process Table is Full!!!"
msg28: .ascii " Uerr - Request for too much Memory!!!"
msg29: .ascii " Uerr - File Permission Denied!!!"
msg30: .ascii " Uerr - Illegal Address passed to Driver!!!"
msg31: .ascii " Uerr - Block Device is Required!!!"
msg32: .ascii " Uerr - Device is Busy!!!"
msg33: .ascii " Uerr - File Already Exists!!!"
msg34: .ascii " Uerr - Attempt to Link to file on another Device!!!"
msg35: .ascii " Uerr - Innapropriate I/O!!!"
msg36: .ascii " Uerr - Not a Directory!!!"
msg37: .ascii " Uerr - Attempt to Write on a Directory!!!"
msg38: .ascii " Uerr - Invalid Argument in System Call!!!"
msg39: .ascii " Uerr - System File Table Full!!!"
msg40: .ascii " Uerr - Too Many Open Files!!!"
msg41: .ascii " Uerr - Invalid stty or gtty Call !!!"
msg42: .ascii " Uerr - Text File Busy!!!"
msg43: .ascii " Uerr - File too Large!!!"
msg44: .ascii " Uerr - No Space Left on Device!!!"
msg45: .ascii " Uerr - Seek issued on Inappropriate Device!!!"
msg46: .ascii " Uerr - Attempt to Write on Read/Only Device!!!"
msg47: .ascii " Uerr - Too Many Links to File!!!"
msg48: .ascii " Uerr - Write on Broken Pipe!!!"
msg49: .ascii " Floating Point or Arithmetic Trap!!!"
msg50: .ascii " Undefined Message!"
msg51: .ascii " Undefined Message!"
msg52: .ascii " Undefined Message!"
msg53: .ascii " Undefined Message!"
msg54: .ascii " Illegal Instruction!"
msg55: .ascii " Illegal (protected) Address!!!"
msg56: .ascii " Illegal (out of range) Address!!!"
msg57: .ascii " Bad System Call arguments!!!"
msg58: .ascii " Write on Broken Pipe!!!"
msg59:
e.msgs:
X.data
//go.sysin dd *
made=TRUE
if [ $made = TRUE ]; then
/bin/chmod 644 ./vaxforth/forth3.S
/bin/echo -n ' '; /bin/ls -ld ./vaxforth/forth3.S
fi
/bin/echo 'Extracting ./vaxforth/makefile'
sed 's/^X//' <<'//go.sysin dd *' >./vaxforth/makefile
ARGS= -DBSD4_2 # -DFPROMPT=0100000
FDIR=\"/usr/src/forth/\"
FBLK=\"/usr/src/forth/vaxforth/forth.blk\"
INSDIR=/usr/local
forth: forth.o
ld -o forth forth.o -lc
forth.o: forth.i
as -d2 -o forth.o forth.i
forth.s: forth1.S forth2.S forth3.S
cat forth1.S forth2.S forth3.S >forth.s
forth.i: forth.s
/lib/cpp -DFDIR=${FDIR} -DFBLK=${FBLK} ${ARGS} forth.s >forth.i
clean:
rm -f forth.s forth.i forth.o forth OUT
install: forth
cp forth ${INSDIR}
//go.sysin dd *
made=TRUE
if [ $made = TRUE ]; then
/bin/chmod 644 ./vaxforth/makefile
/bin/echo -n ' '; /bin/ls -ld ./vaxforth/makefile
fi
/bin/echo 'Extracting ./vaxforth/makefile.4.1'
sed 's/^X//' <<'//go.sysin dd *' >./vaxforth/makefile.4.1
ARGS= # -DFPROMPT=0100000
FDIR=\"/usr/src/forth/\"
FBLK=\"/usr/src/forth/vaxforth/forth.blk\"
INSDIR=/usr/local
forth: forth.o
ld -o forth forth.o -lc
forth.o: forth.i /usr/include/sys.s
as -d2 -o forth.o /usr/include/sys.s forth.i
forth.i: forth.s
/lib/cpp -DFDIR=${FDIR} -DFBLK=${FBLK} ${ARGS} forth.s >forth.i
forth.s forth1.S forth2.S forth3.S
cat forth1.S forth2.S forth3.S >forth.s
clean:
rm -f forth.s forth.i forth.o forth OUT
install: forth
cp forth ${INSDIR}
//go.sysin dd *
made=TRUE
if [ $made = TRUE ]; then
/bin/chmod 664 ./vaxforth/makefile.4.1
/bin/echo -n ' '; /bin/ls -ld ./vaxforth/makefile.4.1
fi
made=TRUE
if [ $made = TRUE ]; then
/bin/chmod 755 ./vaxforth
/bin/echo -n ' '; /bin/ls -ld ./vaxforth
fi
made=TRUE
if [ $made = TRUE ]; then
/bin/chmod 755 .
/bin/echo -n ' '; /bin/ls -ld .
fi
exit
--
Bill Sebok Princeton University, Astrophysics
{allegra,akgua,burl,cbosgd,decvax,ihnp4,kpno,princeton,vax135}!astrovax!wls
More information about the Comp.sources.unix
mailing list