****************************
*  IMP perm                *
*  String Compare          *
*  Define Array Dimension  *
*  Claim Space for Array   *
*  Array Index             *
*  Integer Read            *
*  Integer Write           *
****************************
*
* String compare:
*   Input:
* D7: unassigned pattern
* A1: address of string B
* A0: address of string A
*   Output:
* X: undefined
* N: undefined
* Z: set iff A=B
* V: undefined
* C: set iff A<B
* D0-D7,A0-A7: unchanged

scompu cmp.l a0,d7
  beq.s scunass
  cmp.l a1,d7
  beq.s scunass
  cmp.w (a0),d7
  beq.s scunass
  cmp.w (a1),d7
  bne.s scomp
scunass trap #1
scomp movem.l d0-d1/a0-a1,-(sp)
  clr.w d0
  move.b (a0)+,d0          * length(A)
  beq.s scAnull
  clr.w d1
  move.b (a1)+,d1          * length(B)
  beq.s scBless            * (B="")<(A#"") ->
  subq #1,d0
  subq #1,d1
  cmp.w d1,d0
  bgt.s scBshort           * length(B) < length(A) ->
  sub.w d0,d1              * d1 = length(B)-length(A) >= 0
scloop cmpm.b (a1)+,(a0)+
  dbne d0,scloop
  bne.s scdone
  neg.w d1
scdone movem.l (sp)+,d0-d1/a0-a1
  rts
scBshort cmpm.b (a1)+,(a0)+
  dbne d1,scBshort
  bne.s scdone
scBless  moveq #1,d1       * A>B
  movem.l (sp)+,d0-d1/a0-a1
  rts
scAnull move.b (a1),d0
  neg.w d0                 * B#"" means A<B (otherwise A=B)
  movem.l (sp)+,d0-d1/a0-a1
  rts
*
* Define array dimension
* Input:
* D0 = size of element
* D1 = LB
* D2 = UB
* Output:
* D0 = size of array
* D2 = UB-LB
arraydef sub.l d1,d2
     blt.s insideout
     move.l d2,d1
     addq.l #1,d1     * no of elements
     bsr mull         * has to be long multiplication
     rts
insideout move #-$35,d0
     bra signal

*
* Claim space for array
* Input:
* D0 = size
* D6 = heap front +256
* Output:
* A0 = low address
* D6 = new heap front
* D0 = A0
arrayget addq.l #3,d0  * Longword-align
  and.l #-4,d0
  add.l d0,d6
  neg.l d0
  cmp.l d6,sp
  ble.s nospace
  add.l d6,d0
  sub.l #256,d0
  move.l d0,a0
  rts
nospace add.l d0,d6
  moveq #-$12,d0
  bra signal

*
* Array index
* Input:
* D0 = index
* A0 -> ###.     upper-lower, lower, size, ###
arrayref move.l d1,-(sp)
  move.l -(a0),d1
*arrayref move.l -(a0),d1  * get size
  sub.l -(a0),d0          * subtract lower from index
  blt.s toolow            * simulate CHK.L d0,-(a0)
  cmp.l -(a0),d0
  bgt.s toohigh
  bsr mull
  move.l (sp)+,d1
  rts
*  bra mull                * mult by size and return
toohigh addq.l #4,a0
toolow add.l (a0),d0
  move.l (sp)+,d1
  move.l d0,eventinfo
  clr.w eventmess
  moveq #$26,d0
  bra signal
*
* Longword Write decimal
*
writer   sub.l   #1,d1
         cmp.l   #10,d0
         bcc.s   more
         swap    d0
         tst.l   d1
         blt.s   nolspace
wsploop  move    #' ',d0
         jsr     printsymbol
         dbra    d1,wsploop
nolspace  move d3,d0
          beq.s nosign
           bsr printsymbol
nosign   swap    d0
         add     #'0',d0
         jmp     printsymbol
more     move    d2,-(sp)
         swap    d0
         clr.l   d2
         move    d0,d2
         divu    #10,d2
         move    d2,d0
         clr     d2
         swap    d0
         move    d0,d2
         divu    #10,d2
         move    d2,d0
         swap    d2
         bsr.s   writer
         move    d2,d0
         add     #'0',d0
         jsr     printsymbol
         move    (sp)+,d2
         rts
write    move sr,-(sp)
         movem.l d0-d3,-(sp)
         clr     d3
         subq.l  #1,d1
         blt.s write0
         moveq #' ',d3
write0   tst.l   d0
         bpl.s   wrpos
         neg.l   d0
         moveq #'-',d3
wrpos    bsr writer
         movem.l (sp)+,d0-d3
         rtr
*
*  Longword Read Decimal
*
read     movem.l d1-d2,-(sp)
         clr.l   d0
         clr     d2
         bra.s scanloop
skiploop jsr readsymbol
scanloop jsr nextsymbol
         cmp.b   #' ',d0
         beq     skiploop
         cmp.b   #nl,d0
         beq     skiploop
         cmp.b   #'-',d0
         bne.s   notsign
         eor     #1,d2
         bra     skiploop
inputerr add.b #'0',d0
         move.l  d0,eventinfo
         clr.w   eventmess
         moveq #$14,d0
         bsr signal
notsign  sub.b   #'0',d0
         bmi   inputerr
         cmp.b   #9,d0
         bhi     inputerr
         btst    #0,d2
         beq.s   readpos1
         neg.l   d0
readpos1 move.l  d0,d1
         jsr readsymbol
readlp   clr.l   d0
         jsr     nextsymbol
         sub.b   #'0',d0
         bmi.s   readdone
         cmp.b   #9,d0
         bhi.s   readdone
         btst    #0,d2
         beq.s   readpos2
         neg.l   d0
readpos2 asl.l   #1,d1
         bvc.s   rdnoflo1
         or      #2,d2
rdnoflo1 add.l   d1,d0
         bvc.s   rdnoflo2
         or      #2,d2
rdnoflo2 asl.l   #2,d1
         bvc.s   rdnoflo3
         or      #2,d2
rdnoflo3 add.l   d0,d1
         bvc.s   rdnoflo4
         or      #2,d2
rdnoflo4 jsr     readsymbol
         bra     readlp
readdone and     #2,d2
         move    sr,d0
         or      d0,d2
         move.l  d1,d0
         move    d2,ccr
         movem.l (sp)+,d1-d2
         rts
         end