! VTI PERM file for Motorola 68000 IMP Compiler
!**NB order up to READSTRING
%recordformat EVENTFM(%integer event,(%integer sub %or %integer subevent),
  %integer extra,line,%string(255) message)
@16_3400%record(eventfm) EVENT
@16_1114%routine SIG
@16_1128%routine SCOMP
%routine ASET
  *sub.l d2,d1
  *ble #6
  *moveq #-16_35,d0
  sig
  *neg.l d1
  *addq.l #1,d1
!  *mulu d1,d0
!  *rts
  *jmp 16_1120
%end
%routine AGET
  *addq.l #3,d0
  *and.l #-4,d0
  *move.l d6,a0
  *add.l d0,d6
  *cmp.l d6,sp
  *ble #6
  *lea -256(a0),a0
  *rts
  *sub.l d0,d6
  *moveq #-16_12,d0
  sig
%end
%routine IX
%label bad,ok,bigel,bigx,big
  *cmp.l (a0)+,d0
  *bgt bad
  *sub.l (a0)+,d0
  *bge ok
  *add.l -(a0),d0
bad:*move.l d0,16_3408
  *clr.w 16_3410
  *move #16_26,d0
  sig
ok:
  *tst.w (a0)+
  *bne bigel
  *swap d0
  *tst.w d0
  *bne bigx
  *swap d0
  *mulu (a0)+,d0
  *rts
bigel:
  *move d1,-(sp)
  *move d0,d1
  *mulu -2(a0),d1
  *bra big
bigx:
  *move d1,-(sp)
  *move d0,d1
  *swap d0
  *mulu (a0),d1
big:
  *swap d1
  *mulu (a0)+,d0
  *add d1,d0
  *move (sp)+,d1
%end
@16_11B4%routine RES
@16_11BC%routine LOA
@16_1120%routine MUL
@16_1124%routine DIV
@16_1144%routine POW
@16_1148%routine FPLUS
@16_114C%routine FMIN
@16_1150%routine FMUL
@16_1154%routine FDIV
@16_1158%routine FPOW
@16_115C%routine FNEG
@16_1160%routine FLOAT
@16_1114%record(*)%map ZNEW(%name(d0) v)
@16_1114%routine DISPOSE(%record(*)%name v)
%routinespec(16_10C8) READCH(%name(d0) n)
%routinespec(16_10C4) PRINTSTR(%string(255) s)
%routinespec READ(%name(d0) v)
%externalroutinespec READREAL(%realname v)
%externalroutinespec READSTRING(%string(*)%name v)

@0%record(*) NIL
%constinteger NL=10
@0%integerfn ADDR{(%name n)
@0%integermap INTEGER(%integer a)
@0%realmap REAL(%integer a)
@0%string(*)%map STRING(%integer a)
@0%record(*)%map RECORD(%integer a)
@0%bytemap BYTEINTEGER(%integer a)
@0%shortmap SHORTINTEGER(%integer a)
@0%bytemap LENGTH(%string(*)%name z)
@0%bytemap CHARNO(%string(*)%name z, %integer n)
%string(1)%fn TOSTRING(%integer k)
%short z=k
  byteinteger(addr(z)) = 1
  %result = string(addr(z))
%end
@16_1124%integerfn REM(%integer a,b)
!
%integerfnspec(16_10CC) NEXTCH
%routinespec(16_10C0) PRINTCH(%integer k)
%routinespec(16_10C8) SKIPCH
%routinespec(16_10D0) PROMPT(%string(31) S)
%integerfnspec(16_10D4) TESTSYMBOL
%routinespec(16_10D8) SELECTIN(%integer n)
%routinespec(16_10DC) SELECTOUT(%integer n)
%routinespec(16_10E0) RESET INPUT
%routinespec(16_10E4) RESET OUTPUT
%routinespec(16_10E8) CLOSE INPUT
%routinespec(16_10EC) CLOSE OUTPUT
%routinespec(16_10F0) OPEN INPUT(%integer n, %string(31) S)
%routinespec(16_10F4) OPEN OUTPUT(%integer n, %string(31) S)
%routinespec(16_10E0) READDD
%routinespec(16_111C) WRIT(%integer m,n)
%routinespec(16_1140) SET TERMINAL MODE(%integer m)
%integerfnspec(4400) CPUTIME;  !1130
%integerfnspec(16_1168) INTPT(%real x)
%realfnspec(16_1164) FRACPT(%real x)
%realfnspec(16_116C) SQRT(%real x)
%externalintegerfnspec INSTREAM
%externalintegerfnspec OUTSTREAM
! ............................
!
!!!!!!!!!!!!!!  Standard Video Terminal Interface  !!!!!!!!!!!!!
! Terminal mode options
%constinteger single=1<<2, noecho=1<<0, notermecho=1<<1,
              nopage=1<<3,
              specialpad=1<<13
%constinteger ttmodebits=single+noecho+notermecho+nopage
%constinteger screenmode=single+notermecho+nopage
! Video FUNction/MODE flag values:-
%constinteger intense=1, reverse=2, underline=4, blink=8,
              graphical=16, shade=31
%constinteger fullscroll=64, anyscroll=128;  !FUN only
%constinteger noscroll=64, freeze=128;       !MODE only
%recordformat WININFO(%byteinteger top,rows,left,cols,
               row,col,fun,mode)
%ownrecord(wininfo) VDU=0;  !full-screen frame
%ownrecord(wininfo) WIN=0;  !current frame
%owninteger insertpos=0
%constinteger STACKMAX=7
%ownrecord(wininfo)%array STACK(1:stackmax)
%owninteger SP=0
!
! Video operations
%constinteger escflag=128 {flag for ESC},
              rowcode=254 {place-saver for row},
              colcode=255 {place-saver for col}
! Control sequences (coded - 4 bytes max)
!  [Initial values shown are for V200]
%owninteger docursor=escflag+'Y'+rowcode<<8+colcode<<16,
            doclearline=escflag+'x',doclearscreen=escflag+'v',
            dodelete=escflag+'M',doinsert=escflag+'L',
            donormalpad=escflag+'>',dospecialpad=escflag+'=',
            dostandard=escflag+'G',dograph=escflag+'F',
            dostartins=escflag+'i',dostopins=escflag+'j',
            dodelchar=escflag+'O'
%ownintegerarray doselect(0:15) = escflag+'3', escflag+'4', 0 (*)
!
!ASCII control characters:
%constinteger bs=8, tab=9, lf=10, ff=12, rt=13, esc=27
%constinteger del=127
!
%owninteger vbot=23,vright=79;  !=VDU_ROWS-1,VDU_COLS-1
%constinteger untouched=1<<30
%owninteger options=untouched;  !record of VIDEO MODE
%owninteger echoinc=1;      !0 if NOECHO
%owninteger escaping=0;  !temp for current window
%owninteger inmode=-1, outmode=-1;     !input/output modes
!  IN/OUTMODE < 0 ==> file,etc
!             = 0 ==> hardcopy terminal
!             > 0 ==> video terminal
!
!!!!!!!!!!!!!!!!!   Internal procedures   !!!!!!!!!!!!!!!!!!!!
!
%routine PUT SEQUENCE(%integer seq)
  %while seq # 0 %cycle
    print ch(esc) %if seq&escflag # 0 %and seq&127 # 0
    print ch(seq&127)
    seq = seq>>8
  %repeat
%end

%routine INSERT CHAR(%integer k)
  put sequence(dostartins)
  print ch(k)
  put sequence(dostopins)
%end

%routine POSITION CURSOR(%integer row,col)
! Set cursor to row ROW and column COL (relative)
%integer k,seq
  row = win_rows-1 %if row >= win_rows;  row = row+win_top
  col = win_cols-1 %if col >= win_cols;  col = col+win_left
  %if row = vdu_row %start
    %return %if col = vdu_col;  !already there =>
    ! Check for optimisable cases
    %if col = 0 %start
      print ch(rt);  vdu_col = 0
      %return
    %finish
    %if  0 > col-vdu_col >= -3 %start
      %cycle
        print ch(bs)
        vdu_col = vdu_col-1
      %repeat %until vdu_col = col
      %return
    %finish
  %finish
  %if col = 0 %and row-vdu_row = 1 %start
    print ch(nl)
    vdu_row = vdu_row+1;  vdu_col = 0
    %return
  %finish
  vdu_row = row;  vdu_col = col;      !new values
!Interpret cursor address sequence
  seq = docursor
  %while seq # 0 %cycle
    k = seq&255
    k = row+' ' %if k = rowcode
    %if k = colcode %start
      k = col+' '
    %finish
    print ch(esc) %if k&escflag # 0
    print ch(k&127)
    seq = seq>>8
  %repeat
%end
!
%routine CHANGE SHADE
  %if (win_mode!!vdu_mode)&graphical # 0 %start
    %if win_mode&graphical = 0 %then put sequence(dostandard) %c
    %else put sequence(dograph)
  %finish
  %if (win_mode!!vdu_mode)&15 # 0 %start
    put sequence(doselect(win_mode&15))
  %finish
  vdu_mode = win_mode&shade
%end
!!!!!!!!!!!!!!!!!!   External procedures   !!!!!!!!!!!!!!!!!!!!
!
%routine CLEAR LINE
  %if win_col < win_cols %start
    position cursor(win_row,win_col)
    %if win_cols = vdu_cols %and doclearline # 0 %start
      put sequence(doclearline)
    %finish %else %start
      %cycle
        print ch(' ');  win_col = win_col+1
        vdu_col = vdu_col+1 %if vdu_col # vright
      %repeat %until win_col = win_cols
    %finish
  %finish
%end
!
%routine CLEAR FRAME
!(no point in updating?)
  win_row = 0;  win_col = 0
  position cursor(0,0)
  ![optimisable by record variation]
  %if win_top=0=win_left %and win_rows=vdu_rows %c
   %and win_cols=vdu_cols %and doclearscreen # 0 %start
    put sequence(doclearscreen)
  %finish %else %start
    %cycle
      clear line
      win_row = win_row+1
    %repeat %until win_row >= win_rows
    win_row = 0
  %finish
%end
!
%routine SCROLL(%integer t,b,n)
!Scroll area delimited by T and B by N lines
! -- reverse scroll if N < 0
%integer i,vt,vb
  %return %unless outmode > 0 %and t >= 0 %and b < win_rows
  win_row = b;  win_col = 0
  %if t >= b %or win_cols # vdu_cols %start
    clear line;  !clear single line
    %return
  %finish
  vt = t+win_top;  vb = b+win_top
  %if n >= 0 %start
    %if vt = 0 %and vb = vbot %start;  !full screen
      position cursor(b,0) %if vb # vdu_row;  !any col OK
      print ch(nl);  !hardware scroll
      %return
    %finish
  %finish %else win_row = t
  %if n < 0 %start
    n = -n
    i = t;  t = b;  b = i
    vt = t;  vb = b
  %finish
  %if vt < vbot %start
    position cursor(t,0) %if vdu_row # vt;  !any col OK
    %for i = 1,1,n %cycle
      put sequence(dodelete)
      vdu_col = 0
    %repeat
  %finish
  %if vb < vbot %start
    position cursor(b,0)
    %for i = 1,1,n %cycle
      put sequence(doinsert)
    %repeat
  %finish
%end;  !SCROLL
!
%routine SELECT INPUT(%integer n)
  *JSR 16_10D8
  inmode = -1;  inmode = vdu_fun %if n = 0
%end
%routine SELECT OUTPUT(%integer n)
  *JSR 16_10DC
  outmode = -1;  outmode = vdu_fun %if n = 0
%end
!
%routine PRINT SYMBOL(%integer sym)
%integer i
  %if outmode <= 0 %start;  !non-video
    print ch(sym)
  %finish %else %if escaping # 0 %start
    escaping = 0
    print ch(sym)
    vdu_row = 255
  %finish %else %if sym = del %start
    %return %if win_col = 0
    win_col = win_col-1
    %return %if win_col >= win_cols
    position cursor(win_row,win_col)
    %if insertpos # 0 %then put sequence(dodelchar) %c
    %else print ch(' ') %and vdu_col = vdu_col+1
  %finish %else %if sym&96 # 0 %start;  !not control
    %return %if win_col >= win_cols
    position cursor(win_row,win_col)
    change shade %if win_mode&shade # vdu_mode
    %if insertpos # 0 %then insert char(sym) %c
    %else print ch(sym)
    vdu_col = vdu_col+1 %if vdu_col # vright
    win_col = win_col+1 %if win_col # 255
  %finish %else %if sym # nl %start
    %if sym = rt %start
      win_col = 0
    %finish %else %if sym = bs %start
      win_col = win_col-1 %if win_col # 0
    %finish %else %if sym = ff %start
      clear frame
    %finish %else %start
      position cursor(win_row,win_col)
      print ch(sym)
      escaping = 1 %if sym = esc
    %finish
  %finish %else %start
    clear line
    %if win_row # win_rows-1 %start
      ![following line shouldn't be necessary, but lower-level]
      ![software happier with regular NLs]
!      print ch(nl);  vdu_row = vdu_row+1;  vdu_col = 0
      win_row = win_row+1
    %finish %else %start
      %if win_mode&freeze # 0 %start
        i = instream;  select input(0) %if i # 0
        read ch(sym);  vdu_row = 255
        %if sym = esc %start
          read ch(sym)
          read ch(sym) %if sym = '?';  !%or sym = 'O' %or sym = '['
        %finish
        select input(i) %if i # 0
      %finish
      %if win_mode&(noscroll+freeze) # 0 %then win_row = 0 %c
      %else scroll(0,win_row,1)
    %finish
    win_col = 0
  %finish
%end;  !print symbol
!
%routine AT(%integer row,col)
  %if row >= 0 %and col >= 0 %start
    row = win_rows-1 %if row >= win_rows
    win_row = row
    col = 255 %if col > 255
    win_col = col
  %finish
%end
%routine GOTOXY(%integer x,y)
  at(y,x)
%end
%routine SET MODE(%integer m)
  win_mode = win_mode&shade+m
%end
%routine SET SHADE(%integer s)
  win_mode = win_mode&(\shade)+s
%end
!
%routine SET FRAME(%integer t,r,l,c)
  r = 1 %if r <= 0;  r = vdu_rows %if r > vdu_rows
  t = vdu_rows-r %if t > vdu_rows-r;  t = 0 %if t < 0
  c = 1 %if c <= 0;  c = vdu_cols %if c > vdu_cols
  l = vdu_cols-c %if l > vdu_cols-c;  l = 0 %if l < 0
  win = 0
  win_top = t;  win_rows = r;  win_row = r-1
  win_left = l;  win_cols = c
  win_fun = vdu_fun
  win_fun = win_fun&(\(anyscroll+fullscroll)) %if c # vdu_cols %c
             %or (win_fun&anyscroll = 0 %and r # vdu_rows)
%end
!
%routine HILIGHT(%integer k)
  set shade(intense)
  %if k > ' ' %then print symbol(k) %c
  %else print symbol('|')
  set shade(0)
%end

%routine LOLIGHT(%integer k)
  print symbol(k)
%end

%routine PUSH WINDOW
  %if sp = stackmax %start
    event_message = "Too many windows";  %signal 9,4
  %finish
  sp = sp+1;  stack(sp) = win
%end

%routine POP WINDOW
  %if sp > 0 %then win = stack(sp) %and sp = sp-1 %c
  %else win = vdu
%end

%routine SWOP WINDOW
%record(wininfo) temp
  %if sp > 0 %start
    temp = stack(sp);  stack(sp) = win;  win = temp
  %finish %else %start
    sp = 1;  stack(sp) = win;  win = vdu
  %finish
%end

%routine SET VIDEO MODE(%integer mode)
%integer p
  %return %if mode = options
  %if options = untouched %start
    vdu_fun = anyscroll+fullscroll+intense
    vdu_rows = 24;  vdu_cols = 80
    inmode = vdu_fun;  outmode = vdu_fun
    win = vdu
  %finish
  set terminal mode(mode&ttmodebits)
  echoinc = 1;  echoinc = 0 %if mode&noecho # 0
  %if (mode!!options)&specialpad # 0 %start;  !change in pad mode
    %if mode&specialpad # 0 %then put sequence(dospecialpad) %c
    %else put sequence(donormalpad)
  %finish
  options = mode
%end
!
%owninteger pend=\nl
%routine READ SYMBOL(%integername k)
%integer kk,r,c
  read ch(k) %and %return %if inmode < 0
  k = pend %and pend = \pend %and %return %if pend >= 0
  %unless \' ' >= pend > \del %start;  !last was control
    %if outmode > 0 %start
      position cursor(win_row,win_col)
      change shade %if win_mode&shade # vdu_mode
    %finish %else win_col = 0
  %finish
  read ch(kk)
  %if ' ' <= kk < del %start
    %if options&(single+noecho) = single %start
      !IE echoing wanted at this level
      %if insertpos # 0 %then insert char(kk) %c
      %else print ch(kk)
    %finish
    win_col = win_col+echoinc
  %else %if kk = esc
    read ch(kk)
    %if kk = '?' %start
      read ch(kk);  kk = kk!!96
    %finish
    kk = kk!128
  %finish
  vdu_row = 255;  ![safety for now]
  pend = \kk
  k = kk
%end

%integerfn NEXT SYMBOL
  %result = next ch %if inmode < 0
  %result = pend %if pend >= 0
  read symbol(pend)
  %result = pend
%end
%routine SKIP SYMBOL
%integer i
  read symbol(i)
%end

!!!!!!!!!!!!!!!   End of Video Package  !!!!!!!!!!!!!!!!!!!!!

%routine PRINT STRING(%string(255) s)
%integer i
  print symbol(charno(s,i)) %for i = 1,1,length(s)
%end
!
%routine NEWLINE
  print symbol(nl)
%end
%routine NEWLINES(%integer i)
  newline %and i = i-1 %while i > 0
%end
%routine SPACE
  print symbol(' ')
%end
%routine SPACES(%integer i)
  space %and i = i-1 %while i > 0
%end
%routine WRITE(%integer v,p)
%integer vv,q,pos
%byteintegerarray store(0:15)
  vv = v;  vv = -vv %if vv > 0
  pos = 15
  %while vv <= -10 %cycle
    q = vv//10
    store(pos) = q*10-vv+'0';  pos = pos-1
    vv = q
  %repeat
  store(pos) = '0'-vv
  %if p <= 0 %start
    spaces(pos-16-p) %if p < 0
  %finish %else %start
    spaces(pos-16+p)
    print symbol(' ') %if v >= 0
  %finish
  print symbol('-') %if v < 0
  print symbol(store(pos)) %and pos = pos+1 %until pos = 16
%end

%routine READ(%integername v)
%integer i,k,sign
  %cycle
    k = next symbol
    %exit %if k > ' '
    read symbol(k)
  %repeat
  sign = 0
  %if k = '-' %start
    sign = 1
    read symbol(k);  k = next symbol
  %finish
  %signal 4 %unless '0' <= k <= '9'
  i = k-'0'
  %cycle
    read symbol(k)
    k = next symbol
    %exit %unless '0' <= k <= '9'
    i = i*10-'0'+k
  %repeat
  i = -i %if sign # 0
  v = i
%end

%externalstring(15)%fnspec DATE
%externalstring(15)%fnspec TIME
%externalstring(31)%fnspec DATETIME
%externalstring(255)%fnspec SUBSTRING(%string(255) z, %integer from,to)