--- /dev/null
+#\f
+# 03bool.s
+#
+# BOOLEAN OPERATIONS
+#
+_AND:
+ incl r10
+ mcomw (sp)+,r0
+ bicw2 r0,(sp)
+ jmp (r8)
+_OR:
+ incl r10
+ bisw2 (sp)+,(sp)
+ jmp (r8)
+_NOT:
+ incl r10
+ xorw2 $1,(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 04as.s
+#
+# ASSIGNMENT OPERATORS
+#
+_AS2:
+ incl r10
+ movw (sp)+,*(sp)+
+ jmp (r8)
+_AS24:
+ incl r10
+ cvtwl (sp)+,*(sp)+
+ jmp (r8)
+_AS42:
+ incl r10
+ cvtlw (sp)+,*(sp)+
+ jmp (r8)
+_AS4:
+ incl r10
+ movl (sp)+,*(sp)+
+ jmp (r8)
+_AS21:
+ incl r10
+ cvtwb (sp)+,*(sp)+
+ jmp (r8)
+_AS41:
+ incl r10
+ cvtlb (sp)+,*(sp)+
+ jmp (r8)
+_AS28:
+ incl r10
+ cvtwd (sp)+,*(sp)+
+ jmp (r8)
+_AS48:
+ incl r10
+ cvtld (sp)+,*(sp)+
+ jmp (r8)
+_AS8:
+ incl r10
+ movd (sp)+,*(sp)+
+ jmp (r8)
+_AS:
+ cvtbl (r10)+,r0
+ bneq l0401
+ cvtwl (r10)+,r0 #r0 has data length in bytes
+l0401:
+ addl3 sp,r0,r6 #r6 points to destination addr
+ blbc r6,l0402 #adjust for word boundry
+ incl r6
+l0402:
+ movc3 r0,(sp),*(r6)+ #move data from stack to dest
+ movl r6,sp #update stack pointer
+ jmp (r8)
--- /dev/null
+#\f
+# 05index.s
+#
+# OFF, INDEX and NIL
+#
+_OFF:
+ cvtbl (r10)+,r0
+ bneq l0501
+ cvtwl (r10)+,r0
+l0501:
+ addl2 r0,(sp)
+ jmp (r8)
+_INX2:
+ cvtbl (r10)+,r0
+ bneq l0502
+ cvtwl (r10)+,r0 #r0 has size
+l0502:
+ cvtwl (r10)+,r1 #r1 has lower bound
+ cvtwl (r10)+,r2 #r2 has upper bound
+ cvtwl (sp)+,r3 #r3 contains subscript
+ subl2 r1,r3 #r3 has base subscript
+ index r3,$0,r2,r0,$0,r1 #r1 has calculated offset
+ addl2 r1,(sp) #calculate actual address
+ jmp (r8)
+_INX4:
+ cvtbl (r10)+,r0
+ bneq l0503
+ cvtwl (r10)+,r0 #r0 has size
+l0503:
+ cvtwl (r10)+,r1 #r1 has lower bound
+ cvtwl (r10)+,r2 #r2 has upper bound
+ movl (sp)+,r3 #r3 contains subscript
+ subl2 r1,r3 #r3 has base subscript
+ index r3,$0,r2,r0,$0,r1 #r1 has calculated offset
+ addl2 r1,(sp) #calculate actual address
+ jmp (r8)
+_NIL:
+ incl r10
+ tstl (sp)
+ jeql l0504
+ jmp (r8)
+l0504:
+ movw $ENILPTR,_perrno
+ jbr error
+_INX4P2:
+ cvtbl (r10)+,r0 #r0 has shift amount
+ cvtwl (r10)+,r2 #r2 has lower bound
+ subl3 r2,(sp)+,r1 #r1 has base subscript
+ ashl r0,r1,r1
+ addl2 r1,(sp)
+ jmp (r8)
+_INX2P2:
+ cvtbl (r10)+,r0 #r0 has shift amount
+ clrl r1 #clear upper half of r1
+ subw3 (r10)+,(sp)+,r1 #r1 has base subscript
+ ashl r0,r1,r1
+ addl2 r1,(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 06add.s
+#
+# ADDITION
+#
+_ADD2:
+ incl r10
+ cvtwl (sp)+,r0
+ cvtwl (sp)+,r1
+ addl3 r0,r1,-(sp)
+ jmp (r8)
+_ADD24:
+ incl r10
+ cvtwl (sp)+,r0
+ addl2 r0,(sp)
+ jmp (r8)
+_ADD42:
+ incl r10
+ movl (sp)+,r0
+ cvtwl (sp)+,r1
+ addl3 r0,r1,-(sp)
+ jmp (r8)
+_ADD4:
+ incl r10
+ addl2 (sp)+,(sp)
+ jmp (r8)
+_ADD28:
+ incl r10
+ cvtwd (sp)+,r0
+ addd2 r0,(sp)
+ jmp (r8)
+_ADD82:
+ incl r10
+ movd (sp)+,r0
+ cvtwd (sp)+,r2
+ addd3 r0,r2,-(sp)
+ jmp (r8)
+_ADD48:
+ incl r10
+ cvtld (sp)+,r0
+ addd2 r0,(sp)
+ jmp (r8)
+_ADD84:
+ incl r10
+ movd (sp)+,r0
+ cvtld (sp)+,r2
+ addd3 r0,r2,-(sp)
+ jmp (r8)
+_ADD8:
+ incl r10
+ addd2 (sp)+,(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 07sub.s
+#
+# SUBTRACTION
+#
+_SUB2:
+ incl r10
+ cvtwl (sp)+,r0
+ cvtwl (sp)+,r1
+ subl3 r0,r1,-(sp)
+ jmp (r8)
+_SUB24:
+ incl r10
+ cvtwl (sp)+,r0
+ subl2 r0,(sp)
+ jmp (r8)
+_SUB42:
+ incl r10
+ movl (sp)+,r0
+ cvtwl (sp)+,r1
+ subl3 r0,r1,-(sp)
+ jmp (r8)
+_SUB4:
+ incl r10
+ subl2 (sp)+,(sp)
+ jmp (r8)
+_SUB28:
+ incl r10
+ cvtwd (sp)+,r0
+ subd2 r0,(sp)
+ jmp (r8)
+_SUB82:
+ incl r10
+ movd (sp)+,r0
+ cvtwd (sp)+,r2
+ subd3 r0,r2,-(sp)
+ jmp (r8)
+_SUB48:
+ incl r10
+ cvtld (sp)+,r0
+ subd2 r0,(sp)
+ jmp (r8)
+_SUB84:
+ incl r10
+ movd (sp)+,r0
+ cvtld (sp)+,r2
+ subd3 r0,r2,-(sp)
+ jmp (r8)
+_SUB8:
+ incl r10
+ subd2 (sp)+,(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 10mul.s
+#
+# MULTIPLICATION AND SQUARING
+#
+_SQR2:
+ movw (sp),-(sp)
+_MUL2:
+ incl r10
+ cvtwl (sp)+,r0
+ cvtwl (sp)+,r1
+ mull3 r0,r1,-(sp)
+ jmp (r8)
+_MUL24:
+ incl r10
+ cvtwl (sp)+,r0
+ mull2 r0,(sp)
+ jmp (r8)
+_MUL42:
+ incl r10
+ movl (sp)+,r0
+ cvtwl (sp)+,r1
+ mull3 r0,r1,-(sp)
+ jmp (r8)
+_SQR4:
+ movl (sp),-(sp)
+_MUL4:
+ incl r10
+ mull2 (sp)+,(sp)
+ jmp (r8)
+_MUL28:
+ incl r10
+ cvtwd (sp)+,r0
+ muld2 r0,(sp)
+ jmp (r8)
+_MUL82:
+ incl r10
+ movd (sp)+,r0
+ cvtwd (sp)+,r2
+ muld3 r0,r2,-(sp)
+ jmp (r8)
+_MUL48:
+ incl r10
+ cvtld (sp)+,r0
+ muld2 r0,(sp)
+ jmp (r8)
+_MUL84:
+ incl r10
+ movd (sp)+,r0
+ cvtld (sp)+,r2
+ muld3 r0,r2,-(sp)
+ jmp (r8)
+_SQR8:
+ movd (sp),-(sp)
+_MUL8:
+ incl r10
+ muld2 (sp)+,(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 12div.s
+#
+# INTEGER DIVISION
+#
+_DIV2:
+ incl r10
+ cvtwl (sp)+,r0
+ cvtwl (sp)+,r1
+ divl3 r0,r1,-(sp)
+ jmp (r8)
+_DIV24:
+ incl r10
+ cvtwl (sp)+,r0
+ divl2 r0,(sp)
+ jmp (r8)
+_DIV42:
+ incl r10
+ movl (sp)+,r0
+ cvtwl (sp)+,r1
+ divl3 r0,r1,-(sp)
+ jmp (r8)
+_DIV4:
+ incl r10
+ divl2 (sp)+,(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 13mod.s
+#
+# MODULO
+#
+_MOD2:
+ incl r10
+ cvtwl (sp),r0
+ cvtwl 2(sp),r2
+ ashq $-32,r1,r1
+ ediv r0,r1,r3,(sp)
+ jmp (r8)
+_MOD24:
+ incl r10
+ cvtwl (sp)+,r0
+ movl (sp),r2
+ ashq $-32,r1,r1
+ ediv r0,r1,r3,(sp)
+ jmp (r8)
+_MOD42:
+ incl r10
+ movl (sp)+,r0
+ cvtwl (sp)+,r2
+ ashq $-32,r1,r1
+ ediv r0,r1,r3,-(sp)
+ jmp (r8)
+_MOD4:
+ incl r10
+ movl (sp)+,r0
+ movl (sp),r2
+ ashq $-32,r1,r1
+ ediv r0,r1,r3,(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 14neg.s
+#
+# NEGATION & ABSOLUTE VALUE
+#
+_ABS2:
+ incl r10
+ cvtwl (sp)+,r0
+ blss l1401
+ pushl r0
+ jmp (r8)
+_NEG2:
+ incl r10
+ cvtwl (sp)+,r0
+l1401:
+ mnegl r0,-(sp)
+ jmp (r8)
+_ABS4:
+ incl r10
+ tstl (sp)
+ jgeq l1402
+ mnegl (sp),(sp)
+l1402:
+ jmp (r8)
+_NEG4:
+ incl r10
+ mnegl (sp),(sp)
+ jmp (r8)
+_ABS8:
+ incl r10
+ tstd (sp)
+ jgeq l1403
+ mnegd (sp),(sp)
+l1403:
+ jmp (r8)
+_NEG8:
+ incl r10
+ mnegd (sp),(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 16dvd.s
+#
+# FLOATING DIVISION
+#
+_DVD2:
+ incl r10
+ cvtwd (sp)+,r0
+ cvtwd (sp)+,r2
+ divd3 r0,r2,-(sp)
+ jmp (r8)
+_DVD24:
+ incl r10
+ cvtwd (sp)+,r0
+ cvtld (sp)+,r2
+ divd3 r0,r2,-(sp)
+ jmp (r8)
+_DVD42:
+ incl r10
+ cvtld (sp)+,r0
+ cvtwd (sp)+,r2
+ divd3 r0,r2,-(sp)
+ jmp (r8)
+_DVD4:
+ incl r10
+ cvtld (sp),r0
+ cvtld 4(sp),r2
+ divd3 r0,r2,(sp)
+ jmp (r8)
+_DVD28:
+ incl r10
+ cvtwd (sp)+,r0
+ divd2 r0,(sp)
+ jmp (r8)
+_DVD82:
+ incl r10
+ movd (sp)+,r0
+ cvtwd (sp)+,r2
+ divd3 r0,r2,-(sp)
+ jmp (r8)
+_DVD48:
+ incl r10
+ cvtld (sp)+,r0
+ divd2 r0,(sp)
+ jmp (r8)
+_DVD84:
+ incl r10
+ movd (sp)+,r0
+ cvtld (sp)+,r2
+ divd3 r0,r2,-(sp)
+ jmp (r8)
+_DVD8:
+ incl r10
+ divd2 (sp)+,(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 17rv.s
+#
+# LVALUES and RVALUES
+#
+_LV:
+ cvtbl (r10)+,r0
+ cvtwl (r10)+,r1
+ addl3 _display[r0],r1,-(sp)
+ jmp (r8)
+_RV1:
+ cvtbl (r10)+,r0
+ cvtwl (r10)+,r1
+ addl2 _display[r0],r1
+ cvtbw (r1),-(sp)
+ jmp (r8)
+_RV2:
+ cvtbl (r10)+,r0
+ cvtwl (r10)+,r1
+ addl2 _display[r0],r1
+ movw (r1),-(sp)
+ jmp (r8)
+_RV4:
+ cvtbl (r10)+,r0
+ cvtwl (r10)+,r1
+ addl2 _display[r0],r1
+ pushl (r1)
+ jmp (r8)
+_RV8:
+ cvtbl (r10)+,r0
+ cvtwl (r10)+,r1
+ addl2 _display[r0],r1
+ movq (r1),-(sp)
+ jmp (r8)
+_RV:
+ cvtbl (r10)+,r0
+ cvtwl (r10)+,r1
+ addl2 _display[r0],r1 #r1 points to string o be moved
+ cvtwl (r10)+,r0 #r0 has length of string to be moved
+movblk:
+ movl r0,r2 #r2 has length of stack space
+ blbc r2,l1701 #adjust r2 to word boundry
+ incl r2
+l1701:
+ subl2 r2,sp #allocate stack space
+ movc5 r0,(r1),$0,r2,(sp) #move string to stack
+ jmp (r8)
--- /dev/null
+#\f
+# 20con.s
+#
+# CONOPS
+#
+_CON1:
+ cvtbw (r10)+,-(sp)
+ jmp (r8)
+_CON2:
+ incl r10
+ movw (r10)+,-(sp)
+ jmp (r8)
+_CON4:
+ incl r10
+ pushl (r10)+
+ jmp (r8)
+_CON8:
+ incl r10
+ movd (r10)+,-(sp)
+ jmp (r8)
+_CON:
+ cvtbl (r10)+,r0
+ bneq l2001
+ cvtwl (r10)+,r0 #r0 has length to be moved
+l2001:
+ movl r10,r1 #r1 has addr of data to be moved
+ movl r0,r2 #r2 has length of stack space
+ blbc r2,l2002
+ incl r2
+l2002:
+ subl2 r2,sp #allocate stack space
+ addl2 r2,r10 #advance over data
+ movc5 r0,(r1),$0,r2,(sp) #move string to stack
+ jmp (r8)
--- /dev/null
+#\f
+# 21rang.s
+#
+# range checking
+#
+_RANG2:
+ cvtbl (r10)+,r1
+ bneq l2101
+ cvtwl (r10)+,r1
+l2101:
+ cvtwl (r10)+,r2
+ cvtwl (sp),r0
+ index r0,r1,r2,$1,$1,r3
+ jmp (r8)
+_RANG24:
+ incl r10
+ cvtwl (sp),r0
+ index r0,(r10)+,(r10)+,$1,$1,r2
+ jmp (r8)
+_RANG42:
+ cvtbl (r10)+,r0
+ bneq l2102
+ cvtwl (r10)+,r0
+l2102:
+ cvtwl (r10)+,r1
+ index (sp),r0,r1,$1,$1,r2
+ jmp (r8)
+_RANG4:
+ incl r10
+ index (sp),(r10)+,(r10)+,$1,$1,r2
+ jmp (r8)
+_RSNG2:
+ cvtbl (r10)+,r1
+ bneq l2103
+ cvtwl (r10)+,r1
+l2103:
+ cvtwl (sp),r0
+ index r0,$0,r1,$1,$1,r2
+ jmp (r8)
+_RSNG24:
+ incl r10
+ cvtwl (sp),r0
+ index r0,$0,(r10)+,$1,$1,r2
+ jmp (r8)
+_RSNG42:
+ cvtbl (r10)+,r1
+ bneq l2104
+ cvtwl (r10)+,r1
+l2104:
+ index (sp),$0,r1,$1,$1,r2
+ jmp (r8)
+_RSNG4:
+ incl r10
+ index (sp),$0,(r10)+,$1,$1,r2
+ jmp (r8)
--- /dev/null
+#\f
+# 25set.s
+#
+# SET OPERATIONS
+#
+_ADDT:
+ cvtbl (r10)+,r0
+ bneq l2501
+ cvtwl (r10)+,r0
+l2501:
+ blbc r0,l2502
+ incl r0 #r0 has number of bytes in set
+l2502:
+ addl3 sp,r0,r1 #r1 has pointer to second set
+ ashl $-1,r0,r0 #r0 has number of words in set
+l2503:
+ bisw2 (sp)+,(r1)+
+ sobgtr r0,l2503
+ jmp (r8)
+_SUBT:
+ cvtbl (r10)+,r0
+ bneq l2504
+ cvtwl (r10)+,r0
+l2504:
+ blbc r0,l2505
+ incl r0 #r0 has number of bytes in set
+l2505:
+ addl3 sp,r0,r1 #r1 has pointer to second set
+ ashl $-1,r0,r0 #r0 has number of words in set
+l2506:
+ bicw2 (sp)+,(r1)+
+ sobgtr r0,l2506
+ bicw2 (r10)+,-(r1)
+ jmp (r8)
+_MULT:
+ cvtbl (r10)+,r0
+ bneq l2507
+ cvtwl (r10)+,r0
+l2507:
+ blbc r0,l2508
+ incl r0 #r0 has number of bytes in set
+l2508:
+ addl3 sp,r0,r1 #r1 has pointer to second set
+ ashl $-1,r0,r0 #r0 has number of words in set
+l2509:
+ mcomw (sp)+,r3
+ bicw2 r3,(r1)+
+ sobgtr r0,l2509
+ jmp (r8)
+_CARD:
+ cvtbl (r10)+,r0 #r0 has number of bytes in set
+ bneq l2510
+ cvtwl (r10)+,r0
+l2510:
+ blbc r0,l2511
+ incl r0
+l2511:
+ addl3 r0,sp,r4 #r4 has new stack addr
+ ashl $3,r0,r0 #r0 has number of bits in set
+ mnegl $1,r1 #will init r1 to zero
+ mnegl $1,r5 #will init r2 to zero
+l2512:
+ incl r1 #count found element
+ incl r5 #advance to next field position
+l2521:
+ ffs r5,$32,(sp),r5 #find next set bit
+ beql l2521 #nothing found, so continue
+ cmpl r5,r0 #check for end of field
+ blss l2512 #element found, so count and continue
+ movl r4,sp #clear stack
+ movw r1,-(sp) #put answer on stack
+ jmp (r8)
+_CTTOT:
+ cvtbl (r10)+,-(sp)
+ bneq l2513
+ cvtwl (r10)+,(sp)
+l2513:
+ cvtwl (r10)+,-(sp)
+ cvtwl (r10)+,-(sp)
+ calls $4,_pcttot
+ movw r0,sp
+ jmp (r8)
+_IN:
+ cvtbl (r10)+,r0
+ bneq l2514
+ cvtwl (r10)+,r0 #r0 has size of set
+l2514:
+ blbc r0,l2515
+ incl r0
+l2515:
+ cvtwl (sp)+,r1 #r1 has set index
+ addl3 r0,sp,r4 #r4 points to new top of stack
+ subw2 (r10)+,r1 #check below lower
+ blssu l2516
+ cmpw r1,(r10)+ #check above upper
+ bgtru l2517
+ bbc r1,(sp),l2517 #check for bit set
+ movl r4,sp #bit found
+ movw $1,-(sp)
+ jmp (r8)
+l2516:
+ addl2 $2,r10
+l2517:
+ movl r4,sp #bit not found
+ clrw -(sp)
+ jmp (r8)
+_INCT:
+ incl r10
+ cvtwl (sp)+,r0 #r0 has value to find
+ cvtwl (sp)+,r1 #r1 has pair count
+l2518:
+ cmpw r0,(sp)+
+ blss l2519
+ cmpw r0,(sp)+
+ bgtr l2520
+ decl r1
+ moval (sp)[r1],sp #clear off remaining data on stack
+ movw $1,-(sp) #success
+ jmp (r8)
+l2519:
+ addl2 $2,sp
+l2520:
+ sobgtr r1,l2518
+ clrw -(sp) #failure
+ jmp (r8)
--- /dev/null
+#\f
+# 27conv.s
+#
+# CONVERSIONS
+#
+_STOI:
+ incl r10
+ cvtwl (sp)+,-(sp)
+ jmp (r8)
+_STOD:
+ incl r10
+ cvtwd (sp)+,-(sp)
+ jmp (r8)
+_ITOD:
+ incl r10
+ cvtld (sp)+,-(sp)
+ jmp (r8)
+_ITOS:
+ incl r10
+ cvtlw (sp)+,-(sp)
+ jmp (r8)
--- /dev/null
+#\f
+# 30read.s
+#
+# READ OPERATIONS
+#
+_GET:
+ incl r10
+ calls $0,_iosync #insure that something is in the window
+ bisw2 $SYNC,FUNIT(r7) #throw it away
+ jmp (r8)
+_FNIL:
+ incl r10
+ movl (sp),r0
+ bbs $fWRITE,FUNIT(r0),l3002 #ignore sync of output files
+ movl r7,r2
+ movl _file,r3
+ calls $0,_unit #do not discard arguement to unit on return
+ calls $0,_iosync
+ movl r2,r7
+ movl r3,_file
+l3002:
+ jmp (r8)
+_READ4:
+ incl r10
+ calls $0,_unsync #prepare input stream
+ pushl $0 #space for answer
+ pushl sp #ptr to answer space
+ pushal rd4 #ptr to input format
+ pushl FBUF(r7) #stream
+ calls $3,_fscanf
+ cmpl $1,r0
+ bneq eiread
+ bisw2 $SYNC,FUNIT(r7)
+ jmp (r8)
+eiread:
+ movw $EBADINUM,_perrno
+ jbr error
+_READ8:
+ incl r10
+ calls $0,_unsync #prepare input stream
+ clrd -(sp) #space for answer
+ pushl sp #ptr to answer space
+ pushal rd8 #ptr to input format
+ pushl FBUF(r7) #stream
+ calls $3,_fscanf
+ cmpl $1,r0
+ bneq efread
+ bisw2 $SYNC,FUNIT(r7)
+ jmp (r8)
+efread:
+ movw $EBADFNUM,_perrno
+ jbr error
+_READLN:
+ incl r10
+ calls $0,_iosync
+ bbs $fEOLN,FUNIT(r7),l3005 #check for already at end of line
+ pushal rdln
+ pushl FBUF(r7)
+ calls $2,_fscanf
+l3005:
+ bisw2 $SYNC,FUNIT(r7)
+ jmp (r8)
+_READC:
+ incl r10
+ calls $0,_iosync
+ cvtbw (r7),-(sp)
+ bisw2 $SYNC,FUNIT(r7)
+ jmp (r8)
+
+rd4: .byte '%,'l,'d, 0
+rd8: .byte '%,'l,'f, 0
+rdln: .byte '%,'*,'[,'^,linefeed,'],'%,'*,'c, 0
--- /dev/null
+#\f
+# 31write.s
+#
+# WRITE OPERATIONS
+#
+_PUT:
+ incl r10
+ bbc $fWRITE,FUNIT(r7),ewriteit
+ pushl FBUF(r7) #stream
+ pushl $1 #number of items
+ pushl FSIZE(r7) #item size
+ pushl r7 #ptr to data
+ calls $4,_fwrite
+cleanup:
+ movl FBUF(r7),r5 #ptr to FILE
+ bbs $ioERR,FLAG(r5),ewrite
+ cmpl r7,$stdout #check for output to stdout
+ bneq l3101
+ tstw _bufopt #check for buffering on stdout
+ bneq l3101
+ pushl r5 #if unbuffered then flush
+ calls $1,_fflush
+l3101:
+ jmp (r8)
+ewriteit:
+ movw $EWRITEIT,_perrno
+ jbr error
+ewrite:
+ movw $EWRITE,_perrno
+ jbr error
+
+_WRITEF:
+ cvtbl (r10)+,r6 #r6 has length of format string
+ cvtwl (r10)+,r5 #r5 has number of longword arguements
+fentry:
+ bbc $fWRITE,FUNIT(r7),ewriteit
+ pushal (sp)[r5] #addr of format string
+ pushl FBUF(r7) #stream
+ addl2 $2,r5 #r5 has total number of arguements
+ calls r5,_fprintf #output formatted data
+ addl2 r6,sp #pop format string
+ jbr cleanup
+
+_WRITLN:
+ aobleq LLIMIT(r7),LCOUNT(r7),l3105
+ movw $ELLIMIT,_perrno
+ jbr error
+l3105:
+ movw $linefeed,-(sp) #push a linefeed
+ clrl r6
+ cmpl r7,$stdout #check for flushing
+ bneq l3102
+ cmpw $1,_bufopt #check for eoln flushing
+ bneq l3102
+ incl r6 #set flush request
+ brb l3102
+_PAGE:
+ movw $formfeed,-(sp) #push a formfeed
+_WRITEC:
+ clrl r6
+l3102:
+ incl r10
+ jbc $fWRITE,FUNIT(r7),ewriteit
+ cvtwl (sp)+,r2 #hold data
+ pushl FBUF(r7) #stream
+ pushl r2 #push data
+ calls $2,_fputc
+ jlbc r6,cleanup #if no flush request, normal exit
+ movl FBUF(r7),r5
+ jbs $ioERR,FLAG(r5),ewrite #check for I/O error
+ pushl r5 #flush
+ calls $1,_fflush
+ jmp (r8)
+
+_WRITES:
+ cvtbl (r10)+,r5 #r5 has length of format string
+ cvtwl (r10)+,r6 #r6 has length of data
+sentry:
+ jbc $fWRITE,FUNIT(r7),ewriteit
+ addl2 sp,r6 #r6 pts to format string
+ pushl sp #ptr to data
+ pushl r6 #ptr to format string
+ addl2 r5,r6 #r6 points to cleared top of stack
+ pushl FBUF(r7) #stream
+ calls $3,_fprintf #output string
+ movl r6,sp #pop data and format string
+ jbr cleanup
+
+_WRITEB:
+ cvtbl (r10)+,r6 #r6 has length of format string
+bentry:
+ jbc $fWRITE,FUNIT(r7),ewriteit
+ movw (sp)+,r0 #push addr of appropriate string
+ beql l3103
+ pushal s_true
+ brb l3104
+l3103:
+ pushal s_false
+l3104:
+ pushal 4(sp) #addr of format string
+ pushl FBUF(r7) #stream
+ calls $3,_fprintf #print boolean
+ addl2 r6,sp #pop format string
+ jbr cleanup
+
+s_true: .byte 't,'r,'u,'e,linefeed,0
+s_false:.byte 'f,'a,'l,'s,'e,linefeed,0
--- /dev/null
+#\f
+# 32iostat.s
+#
+# FILE ACTIVATION AND STATUS OPERATIONS
+#
+_UNIT:
+ incl r10
+ calls $1,_unit
+ jmp (r8)
+_UNITINP:
+ incl r10
+ pushal stdin
+ calls $1,_unit
+ jmp (r8)
+_UNITOUT:
+ incl r10
+ moval stdout,r7
+ movl stdout+PFNAME,_file
+ jmp (r8)
+_EOF:
+ cvtwl $EOF,r5
+ brb l3202
+_EOLN:
+ cvtwl $EOF+EOLN,r5
+l3202:
+ incl r10
+ movl _file,r4 #save active file
+ movl r7,r3
+ calls $1,_unit
+ clrw -(sp)
+ bbs $fEOF,FUNIT(r7),l3204
+ calls $0,_iosync
+ bitw r5,FUNIT(r7)
+ beql l3205
+l3204:
+ incw (sp)
+l3205:
+ movl r3,r7 #restore active file
+ movl r4,_file
+ jmp (r8)
--- /dev/null
+#\f
+# 33iofile.s
+#
+# FILE HOUSEKEEPING OPERATIONS
+#
+_DEFNAME:
+ calls $0,_getname
+ movl r1,sp
+ bisw2 $FDEF,FUNIT(r0)
+ jmp (r8)
+_BUFF:
+ cvtbw (r10)+,_bufopt
+ jmp (r8)
+_RESET:
+ cvtbl (r10),r3 #attempt to rewind only if stdin
+ bneq l3301 # and no name is given
+ cmpl *(sp),$stdin
+ bneq l3301
+ tstb stdin+FNAME
+ bneq l3301
+ pushl stdin+FBUF
+ calls $1,_rewind
+ tstl r0 # -1 => error
+ blss eseek
+ addl2 $3,r10
+ addl2 $4,sp #clear stack
+ bicw2 $EOF+EOLN,stdin+FUNIT
+ bisw2 $SYNC,stdin+FUNIT
+ jmp (r8)
+l3301:
+ calls $0,_getname
+ movl r1,sp
+ movl r0,r6
+ pushal rdopen
+ pushal FNAME(r6)
+ calls $2,_fopen
+ tstl r0
+ beql eopen
+ movl r0,FBUF(r6)
+ bisw2 $SYNC+FREAD,FUNIT(r6)
+ jmp (r8)
+eseek:
+ movl stdin+PFNAME,_file
+ movw $ESEEK,_perrno
+ jbr error
+eopen:
+ movl PFNAME(r6),_file
+ movw $EOPEN,_perrno
+ jbr error
+_REWRITE:
+ calls $0,_getname
+ movl r1,sp
+ movl r0,r6
+ movl PFNAME(r6),_file
+ pushal wtopen
+ pushal FNAME(r6)
+ calls $2,_fopen
+ tstl r0
+ beql ecreat
+ movl r0,FBUF(r6)
+ bisw2 $EOF+FWRITE,FUNIT(r6)
+ jmp (r8)
+ecreat:
+ movw $ECREATE,_perrno
+ jbr error
+_FLUSH:
+ incl r10
+ calls $1,_unit
+ bbc $fWRITE,FUNIT(r7),l3302
+ pushl FBUF(r7)
+ calls $1,_fflush
+l3302:
+ jmp (r8)
+_REMOVE:
+ cvtbl (r10)+,r3 #r3 has filename length
+ bneq l3303
+ cvtwl (r10)+,r3
+l3303:
+ movl r3,r6 #r6 has stack length
+ blbc r6,l3304
+ incl r6
+l3304:
+ addl3 r3,sp,r1 #r1 pts to end of name
+l3305:
+ cmpb -(r1),$blank #delete trailing blanks
+ bneq l3306 #(note: could use "spanc" here)
+ clrb (r1)
+ sobgtr r3,l3305
+l3306:
+ movl sp,_file #remove file
+ pushl sp
+ calls $1,_unlink
+ tstl r0
+ bneq eremove
+ addl2 r6,sp
+ jmp (r8)
+eremove:
+ movl _file,sp #recover filename
+ movw $EREMOVE,_perrno
+ jbr error
+_MESSAGE:
+ incl r10
+ calls $0,_pflush
+ pushal stderr
+ calls $1,_unit
+ jmp (r8)
--- /dev/null
+#\f
+# 34err.s
+#
+ .set ECHR,1
+ .set ESYSTEM,2
+ .set EBUILTIN,3
+ .set EHALT,4
+ .set ENILPTR,5
+ .set EPASTEOF,6
+ .set ESQRT,7
+ .set ESTKNEMP,8
+ .set ESUBSCR,9
+ .set EREFINAF,10
+ .set EWRITE,11
+ .set ENAMESIZE,12
+ .set ELN,13
+ .set EBADOP,14
+ .set EBADINUM,15
+ .set EGOTO,16
+ .set ECASE,17
+ .set ESEEK,18
+ .set ECREATE,19
+ .set EOUTOFMEM,20
+ .set ECTTOT,21
+ .set ESTLIM,22
+ .set ESTKOVFLO,23
+ .set EBADFNUM,24
+ .set EREMOVE,25
+ .set ECLOSE,26
+ .set EOPEN,27
+ .set EARGV,28
+ .set EPACK,29
+ .set EUNPACK,30
+ .set ERANGE,31
+ .set EASRT,32
+ .set EREADIT,33
+ .set EWRITEIT,34
+ .set EINTR,35
+ .set EASSIGN,36
+ .set EFIXADD,37
+ .set EFLTADD,38
+ .set EFIXSUB,39
+ .set EFLTSUB,40
+ .set EFIXMUL,41
+ .set EFLTMUL,42
+ .set EFIXDIV,43
+ .set EFLTDIV,44
+ .set EMODDIV,45
+ .set EFIXNEG,46
+ .set ELLIMIT,47
+ .set EFRAMESIZE,48
+ .set ETRASHHEAP,49
+#
+# Fielding interrupts and processing errors
+#
+# Process interpreter detected errors
+#
+error:
+ movzwl _perrno,-(sp)
+ calls $1,_error
+ jmp (r8)
+
+_endinterpret:
+ .byte 'e,'n,'d, 0
+
+#
+# Keyboard interrupts
+#
+ .align 1
+ .globl _intr
+_intr:
+ .word 0
+ pushal _intr #reset interrupt signal
+ pushl $SIGINT
+ calls $2,_signal
+ pushl $EINTR
+ calls $1,_error
+ ret
+#
+# Segmentation Violations => No more memory available for the stack
+#
+ .align 1
+ .globl _memsize
+_memsize:
+ .word 0
+ pushl $ESTKOVFLO
+ calls $1,_error
+ ret
+#
+# Process computational errors
+#
+ .align 1
+ .globl _except
+_except:
+ .word 0
+ pushal _except #reset signal
+ pushl $SIGFPE
+ calls $2,_signal
+ movl PC(fp),r0 #r0 has PC at point following error
+ moval errtbl-4,r1 #r1 points to error offset table
+l3404:
+ addl2 $4,r1 #determine cause of error
+ cmpl r0,(r1)+
+ blssu l3405 #not in table => system error
+ cmpl r0,(r1)+
+ bgtru l3404
+ movzwl (r1),-(sp) #select error message
+ brb l3406
+l3405:
+ pushl $ESYSTEM
+l3406:
+ calls $1,_error
+ ret
+#
+# Table of offsets and their associated errors
+#
+ .align 1
+errtbl:
+ .long _AS2, _OFF, EASSIGN
+ .long _INX2, _NIL, ESUBSCR
+ .long _ADD2, _ADD28, EFIXADD
+ .long _ADD28, _SUB2, EFLTADD
+ .long _SUB2, _SUB28, EFIXSUB
+ .long _SUB28, _SQR2, EFLTSUB
+ .long _SQR2, _MUL28, EFIXMUL
+ .long _MUL28, _DIV2, EFLTMUL
+ .long _DIV2, _MOD2, EFIXDIV
+ .long _MOD2, _ABS2, EMODDIV
+ .long _ABS2, _ABS8, EFIXNEG
+ .long _DVD2, _IND1, EFLTDIV
+ .long _RANG2, _CASE1OP, ERANGE
+ .long _STOI, _UNDEF, EBUILTIN
+ .long _PACK, _UNPACK, EPACK
+ .long _UNPACK, _GET, EUNPACK
+ .long 0xffffffff
+#
+# recover values of dp and lino from the stack
+#
+ .globl _fetchdp
+
+_fetchdp:
+ .word R2|R3|R4|R5|R6|R7|R8|R9|R10|R11
+ pushl fp #sift through the stack to get the
+ movl sp,oldsp # values of dp and lino
+l3401:
+ bicw3 $0xf000,MASK(fp),mask #register save mask
+ moval REGS(fp),sp #point to saved registers
+ popr mask #pop them
+ cmpl PC(fp),$_interpret #check for interpreter frame
+ blss l3402 #not found
+ cmpl PC(fp),$_endinterpret #check for end of interpreter
+ blss l3403 #found
+l3402:
+ movl FP(fp),fp #get next frames registers
+ jbr l3401
+l3403:
+ movl oldsp,sp #restore current frame
+ movl (sp)+,fp
+ movl r9,*4(ap) #return dp
+ movl r11,*8(ap) #return lino
+ ret
+ .data
+oldsp: .space 4 #old value of sp
+mask: .space 2 #register pop mask
+ .text
--- /dev/null
+ECHR 1
+ESYSTEM 2
+EBUILTIN 3
+EHALT 4
+ENILPTR 5
+EPASTEOF 6
+ESQRT 7
+ESTKNEMP 8
+ESUBSCR 9
+EREFINAF 10
+EWRITE 11
+ENAMESIZE 12
+ELN 13
+EBADOP 14
+EBADINUM 15
+EGOTO 16
+ECASE 17
+ESEEK 18
+ECREATE 19
+EOUTOFMEM 20
+ECTTOT 21
+ESTLIM 22
+ESTKOVFLO 23
+EBADFNUM 24
+EREMOVE 25
+ECLOSE 26
+EOPEN 27
+EARGV 28
+EPACK 29
+EUNPACK 30
+ERANGE 31
+EASRT 32
+EREADIT 33
+EWRITEIT 34
+EINTR 35
+EASSIGN 36
+EFIXADD 37
+EFLTADD 38
+EFIXSUB 39
+EFLTSUB 40
+EFIXMUL 41
+EFLTMUL 42
+EFIXDIV 43
+EFLTDIV 44
+EMODDIV 45
+EFIXNEG 46
+ELLIMIT 47
+EFRAMESIZE 48
+ETRASHHEAP 49
--- /dev/null
+#define ECHR 1
+#define ESYSTEM 2
+#define EBUILTIN 3
+#define EHALT 4
+#define ENILPTR 5
+#define EPASTEOF 6
+#define ESQRT 7
+#define ESTKNEMP 8
+#define ESUBSCR 9
+#define EREFINAF 10
+#define EWRITE 11
+#define ENAMESIZE 12
+#define ELN 13
+#define EBADOP 14
+#define EBADINUM 15
+#define EGOTO 16
+#define ECASE 17
+#define ESEEK 18
+#define ECREATE 19
+#define EOUTOFMEM 20
+#define ECTTOT 21
+#define ESTLIM 22
+#define ESTKOVFLO 23
+#define EBADFNUM 24
+#define EREMOVE 25
+#define ECLOSE 26
+#define EOPEN 27
+#define EARGV 28
+#define EPACK 29
+#define EUNPACK 30
+#define ERANGE 31
+#define EASRT 32
+#define EREADIT 33
+#define EWRITEIT 34
+#define EINTR 35
+#define EASSIGN 36
+#define EFIXADD 37
+#define EFLTADD 38
+#define EFIXSUB 39
+#define EFLTSUB 40
+#define EFIXMUL 41
+#define EFLTMUL 42
+#define EFIXDIV 43
+#define EFLTDIV 44
+#define EMODDIV 45
+#define EFIXNEG 46
+#define ELLIMIT 47
+#define EFRAMESIZE 48
+#define ETRASHHEAP 49
--- /dev/null
+/*
+ * operations
+ */
+#define O_HALT 01
+#define O_NULL 02
+#define O_NODUMP 03
+#define O_BEG 04
+#define O_END 05
+#define O_CALL 06
+#define O_TRACNT 07
+#define O_PUSH 010
+#define O_POP 011
+#define O_INX4 012
+#define O_SDUP 013
+#define O_IF 014
+#define O_TRA 015
+#define O_LINO 016
+#define O_GOTO 017
+#define O_REL2 020
+#define O_REL4 021
+#define O_REL24 022
+#define O_REL42 023
+#define O_REL8 024
+#define O_RELG 025
+#define O_RELT 026
+#define O_REL28 030
+#define O_REL48 031
+#define O_REL82 032
+#define O_REL84 033
+#define O_AND 034
+#define O_OR 035
+#define O_NOT 036
+#define O_AS2 040
+#define O_AS4 041
+#define O_AS24 042
+#define O_AS42 043
+#define O_AS8 044
+#define O_INX2P2 045
+#define O_INX4P2 046
+#define O_AS 047
+#define O_AS21 050
+#define O_AS41 051
+#define O_AS28 052
+#define O_AS48 053
+#define O_OFF 054
+#define O_INX2 055
+#define O_NIL 056
+#define O_LV 057
+#define O_ADD2 060
+#define O_ADD4 061
+#define O_ADD24 062
+#define O_ADD42 063
+#define O_ADD28 064
+#define O_ADD48 065
+#define O_ADD82 066
+#define O_ADD84 067
+#define O_SUB2 070
+#define O_MUL2 0100
+#define O_ABS2 0110
+#define O_ABS8 0112
+#define O_ADD8 0114
+#define O_SUB8 0115
+#define O_MUL8 0116
+#define O_DVD8 0117
+#define O_DIV2 0120
+#define O_MOD2 0130
+#define O_NEG2 0140
+#define O_NEG8 0142
+#define O_DVD2 0160
+#define O_RV1 0170
+#define O_RV2 0171
+#define O_RV4 0172
+#define O_RV8 0173
+#define O_IND1 0174
+#define O_IND2 0175
+#define O_CON1 0200
+#define O_CON2 0201
+#define O_CON4 0202
+#define O_CON8 0203
+#define O_RV 0204
+#define O_IND 0205
+#define O_CON 0206
+#define O_RANG2 0210
+#define O_RANG42 0211
+#define O_RSNG2 0212
+#define O_RSNG42 0213
+#define O_RANG4 0214
+#define O_RSNG4 0216
+#define O_RSNG24 0217
+#define O_WRITEB 0220
+#define O_WRITE2 0221
+#define O_WRITE4 0222
+#define O_WRITE8 0223
+#define O_WRITEC 0226
+#define O_WRITES 0227
+#define O_CONC 0230
+#define O_CASEBEG 0231
+#define O_CASE1 0232
+#define O_CASE2 0233
+#define O_CASE4 0234
+#define O_CASEEND 0235
+#define O_CONG 0236
+#define O_ORD2 0237
+#define O_CASE1OP 0240
+#define O_CASE2OP 0241
+#define O_CASE4OP 0242
+#define O_PXPBUF 0243
+#define O_COUNT 0244
+#define O_ADDT 0250
+#define O_SUBT 0251
+#define O_MULT 0252
+#define O_INCT 0253
+#define O_CTTOT 0254
+#define O_CARD 0255
+#define O_IN 0256
+#define O_ASRT 0257
+#define O_FOR1U 0260
+#define O_FOR2U 0261
+#define O_FOR4U 0262
+#define O_FOR1D 0263
+#define O_FOR2D 0264
+#define O_FOR4D 0265
+#define O_STLIM 0266
+#define O_SCLCK 0267
+#define O_STOI 0270
+#define O_STOD 0271
+#define O_ITOD 0272
+#define O_ITOS 0273
+#define O_BUFF 0274
+#define O_WCLCK 0275
+#define O_WRHEX2 0276
+#define O_GET 0300
+#define O_PUT 0301
+#define O_MESSAGE 0302
+#define O_FNIL 0303
+#define O_EOF 0304
+#define O_EOLN 0305
+#define O_RESET 0306
+#define O_REWRITE 0307
+#define O_REMOVE 0310
+#define O_READ4 0311
+#define O_UNIT 0312
+#define O_READC 0313
+#define O_READ8 0314
+#define O_UNITINP 0315
+#define O_UNITOUT 0316
+#define O_READLN 0317
+#define O_WRIT2 0320
+#define O_WRIT4 0321
+#define O_WRITB 0322
+#define O_WRITC 0323
+#define O_WRIT8 0324
+#define O_WRITG 0325
+#define O_WRIT82 0326
+#define O_WRITLN 0327
+#define O_WROCT2 0330
+#define O_FLUSH 0332
+#define O_PACK 0333
+#define O_UNPACK 0334
+#define O_LLIMIT 0335
+#define O_ARGC 0336
+#define O_ARGV 0337
+#define O_CLCK 0340
+#define O_SEED 0341
+#define O_RANDOM 0342
+#define O_DISPOSE 0343
+#define O_NEW 0344
+#define O_EXPO 0345
+#define O_DATE 0346
+#define O_TIME 0347
+#define O_ATAN 0350
+#define O_COS 0351
+#define O_EXP 0352
+#define O_LN 0353
+#define O_SIN 0354
+#define O_SQRT 0355
+#define O_CHR2 0356
+#define O_ODD2 0360
+#define O_PRED2 0362
+#define O_PRED24 0364
+#define O_SUCC2 0365
+#define O_DEFNAME 0370
+#define O_PAGE 0371
+#define O_UNDEF 0372
+#define O_SQR2 0373
+#define O_ROUND 0376
+#define O_TRUNC 0377
--- /dev/null
+/*
+ * Format of an a.out header
+ */
+
+struct exec { /* a.out header */
+ int a_magic; /* magic number */
+ unsigned a_text; /* size of text segment */
+ unsigned a_data; /* size of initialized data */
+ unsigned a_bss; /* size of uninitialized data */
+ unsigned a_syms; /* size of symbol table */
+ unsigned a_entry; /* entry point */
+ unsigned a_trsize; /* size of text relocation */
+ unsigned a_drsize; /* size of data relocation */
+};
+
+#define A_MAGIC1 0407 /* normal */
+#define A_MAGIC2 0410 /* read-only text */
+#define A_MAGIC3 0411 /* separated I&D */
+#define A_MAGIC4 0405 /* overlay */
--- /dev/null
+e errdata
+1,$s/^/#define /
+w h01errs.h
+e errdata
+1,$s/ //g
+1,$s/^/ .set /
+1,$s/[0-9]*$/,&/
+w E.s
+e 34err.s
+g/\.set/d
+3r E.s
+w
+q
--- /dev/null
+g/^#\f/s//\f/g
+g/\([^ ]\)r7/s//\1buf/g
+g/\([^ ]\)r8/s//\1loop/g
+g/\([^ ]\)r9/s//\1dp/g
+g/\([^ ]\)r10/s//\1lc/g
+g/\([^ ]\)r11/s//\1lino/g
+g/ \(r[1789]\)/s//\1/g
+w
+q
--- /dev/null
+#ifdef debug
+#define ASSERT(p,t) if(!(p))return(t(TRASHED));else
+#else
+#define ASSERT(p,t)
+#endif
+
+/* avoid break bug */
+#ifdef pdp11
+#define GRANULE 64
+#else
+#define GRANULE 0
+#endif
+/* C storage allocator
+ * circular first-fit strategy
+ * works with noncontiguous, but monotonically linked, arena
+ * each block is preceded by a ptr to the (pointer of)
+ * the next following block
+ * blocks are exact number of words long
+ * aligned to the data type requirements of ALIGN
+ * pointers to blocks must have BUSY bit 0
+ * bit in ptr is 1 for busy, 0 for idle
+ * gaps in arena are merely noted as busy blocks
+ * last block of arena (pointed to by alloct) is empty and
+ * has a pointer to first
+ * idle blocks are coalesced during space search
+ *
+ * a different implementation may need to redefine
+ * ALIGN, NALIGN, BLOCK, BUSY, INT
+ * where INT is integer type to which a pointer can be cast
+*/
+#define INT int
+#define ALIGN int
+#define NALIGN 1
+#define WORD sizeof(union store)
+#define BLOCK 1024 /* a multiple of WORD*/
+#define BUSY 1
+#define NULL 0
+#define TRASHED -1
+#define testbusy(p) ((INT)(p)&BUSY)
+#define setbusy(p) (union store *)((INT)(p)|BUSY)
+#define clearbusy(p) (union store *)((INT)(p)&~BUSY)
+
+union store { union store *ptr;
+ ALIGN dummy[NALIGN];
+ int calloc; /*calloc clears an array of integers*/
+};
+
+static union store allocs[2]; /*initial arena*/
+static union store *allocp; /*search ptr*/
+static union store *alloct; /*arena top*/
+static union store *allocx; /*for benefit of realloc*/
+char *sbrk();
+
+char *
+malloc(nbytes)
+unsigned nbytes;
+{
+ register union store *p, *q;
+ register nw;
+ static temp; /*coroutines assume no auto*/
+
+ if(allocs[0].ptr==0) { /*first time*/
+ allocs[0].ptr = setbusy(&allocs[1]);
+ allocs[1].ptr = setbusy(&allocs[0]);
+ alloct = &allocs[1];
+ allocp = &allocs[0];
+ }
+ nw = (nbytes+WORD+WORD-1)/WORD;
+ ASSERT(allocp>=allocs && allocp<=alloct,(char *));
+ ASSERT(allock(),(char *));
+ for(p=allocp; ; ) {
+ for(temp=0; ; ) {
+ if(!testbusy(p->ptr)) {
+ while(!testbusy((q=p->ptr)->ptr)) {
+ ASSERT(q>p&&q<alloct,(char *));
+ p->ptr = q->ptr;
+ }
+ if(q>=p+nw && p+nw>=p)
+ goto found;
+ }
+ q = p;
+ p = clearbusy(p->ptr);
+ if(p>q)
+ ASSERT(p<=alloct,(char *));
+ else if(q!=alloct || p!=allocs) {
+ ASSERT(q==alloct&&p==allocs,(char *));
+ return(NULL);
+ } else if(++temp>1)
+ break;
+ }
+ temp = ((nw+BLOCK/WORD)/(BLOCK/WORD))*(BLOCK/WORD);
+ q = (union store *)sbrk(0);
+ if(q+temp+GRANULE < q) {
+ return(NULL);
+ }
+ q = (union store *)sbrk(temp*WORD);
+ if((INT)q == -1) {
+ return(NULL);
+ }
+ ASSERT(q>alloct,(char *));
+ alloct->ptr = q;
+ if(q!=alloct+1)
+ alloct->ptr = setbusy(alloct->ptr);
+ alloct = q->ptr = q+temp-1;
+ alloct->ptr = setbusy(allocs);
+ }
+found:
+ allocp = p + nw;
+ ASSERT(allocp<=alloct,(char *));
+ if(q>allocp) {
+ allocx = allocp->ptr;
+ allocp->ptr = p->ptr;
+ }
+ p->ptr = setbusy(allocp);
+ return((char *)(p+1));
+}
+
+/* freeing strategy tuned for LIFO allocation
+*/
+free(ap)
+register char *ap;
+{
+ register union store *p = (union store *)ap;
+
+ ASSERT(p != 0,(long));
+ ASSERT(p>clearbusy(allocs[1].ptr)&&p<=alloct,(long));
+ ASSERT(allock(),(long));
+ allocp = --p;
+ ASSERT(testbusy(p->ptr),(long));
+ p->ptr = clearbusy(p->ptr);
+ ASSERT(p->ptr > allocp && p->ptr <= alloct,(long));
+ return(NULL);
+}
+
+/* realloc(p, nbytes) reallocates a block obtained from malloc()
+ * and freed since last call of malloc()
+ * to have new size nbytes, and old content
+ * returns new location, or 0 on failure
+*/
+
+char *
+realloc(p, nbytes)
+register union store *p;
+unsigned nbytes;
+{
+ register union store *q;
+ union store *s, *t;
+ register unsigned nw;
+ unsigned onw;
+
+ if(testbusy(p[-1].ptr))
+ free((char *)p);
+ onw = p[-1].ptr - p;
+ q = (union store *)malloc(nbytes);
+ if(q==NULL || q==p)
+ return((char *)q);
+ s = p;
+ t = q;
+ nw = (nbytes+WORD-1)/WORD;
+ if(nw<onw)
+ onw = nw;
+ while(onw--!=0)
+ *t++ = *s++;
+ if(q<p && q+nw>=p)
+ (q+(q+nw-p))->ptr = allocx;
+ return((char *)q);
+}
+
+#ifdef debug
+allock()
+{
+#ifdef longdebug
+ register union store *p;
+ int x;
+ x = 0;
+ for(p= &allocs[0]; clearbusy(p->ptr) > p; p=clearbusy(p->ptr)) {
+ if(p==allocp)
+ x++;
+ }
+ ASSERT(p==alloct,(long));
+ return(x==1|p==allocp);
+#else
+ return(1);
+#endif
+}
+#endif
+