! PERM file for Motorola 68000 IMP Compiler -- VTI Graphics 3
%constinteger NL=10
%integermapspec INTEGER(%integer a)
%realmapspec REAL(%integer a)
%string(*)%mapspec STRING(%integer a)
%record(*)%mapspec RECORD(%integer a)
%bytemapspec BYTEINTEGER(%integer a)
%shortmapspec SHORTINTEGER(%integer a)
%bytemapspec LENGTH(%string(*)%name s)
%bytemapspec CHARNO(%string(*)%name s, %integer n)

%integerfnspec ADDR(%name n)
%string(1)%fn TOSTRING(%integer k)
%string(1) s;  shortinteger(addr(s)) = k+256
%result = s
%end
%integerfnspec(16_1124) REM(%integer a,b)
%integerfnspec(16_10CC) NEXTCH

%routinespec(16_10C8) READCH(%name n)
%routinespec(16_10C0) PRINTCH(%integer k)
%routinespec(16_10C8) SKIPCH
%routinespec(16_10C4) PRINTSTR(%string(255) s)
%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 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;  !full-screen frame
%ownrecord(wininfo) WIN;  !current frame
%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 donormalpad=escflag+'>',dospecialpad=escflag+'='
!
!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

%constinteger black=0,red=1,green=2,blue=4
%constinteger yellow=red+green,magenta=red+blue,cyan=blue+green
%constinteger white=red+green+blue
%ownbyteintegerarray colours(0:3) =
  blue+green,red,blue+green+8,red+8
%ownbyteinteger paper=black, colour=blue+green
%owninteger vpos=0, hpos=0

%routine SHOW CH(%integer k)
!Display (flagged) symbol K @ position VPOS,HPOS (top,left)
! ex RWT
%integerarrayspec(16_C00000) frame(0:32767)
%bytespec(16_C20000) enable reg
%bytespec(16_C20001) colour reg

%owninteger flip=0
%integer p,q,shiftcount
%constbyteintegerarray FSTORE(0:128*11-1) <-
  0, 0, 0, 0, 0, 255, 0, 0, 0, 0, 0,
  8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
  8, 8, 8, 8, 8, 255, 8, 8, 8, 8, 8,
  8, 8, 8, 8, 8, 255, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 255, 8, 8, 8, 8, 8,
  8, 8, 8, 8, 8, 15, 0, 0, 0, 0, 0,
  120, 132, 132, 132, 120, 0, 0, 0, 0, 0, 0,
  0, 8, 8, 8, 254, 8, 8, 254, 0, 0, 0,
  0, 0, 0, 8, 4, 254, 4, 8, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 198, 198, 0, 0,
  0, 48, 48, 0, 252, 0, 48, 48, 0, 0, 0,
  8, 8, 8, 8, 8, 8, 84, 56, 8, 0, 0,
  0, 0, 0, 0, 0, 248, 8, 8, 8, 8, 8,
  8, 8, 8, 8, 8, 248, 0, 0, 0, 0, 0,
  8, 8, 8, 8, 8, 15, 8, 8, 8, 8, 8,
  8, 8, 8, 8, 8, 248, 8, 8, 8, 8, 8,
  130, 130, 68, 40, 254, 16, 254, 16, 16, 0, 0,
  0, 16, 120, 132, 128, 132, 120, 16, 0, 0, 0,
  2, 66, 64, 64, 224, 64, 64, 64, 254, 0, 0,
  0, 0, 0, 0, 0, 15, 8, 8, 8, 8, 8,
  0, 0, 0, 0, 112, 136, 152, 168, 200, 136, 112,
  0, 0, 0, 0, 32, 96, 160, 32, 32, 32, 248,
  0, 0, 0, 0, 112, 136, 8, 16, 32, 64, 248,
  0, 0, 0, 0, 240, 8, 8, 48, 8, 8, 240,
  0, 0, 0, 0, 16, 48, 80, 144, 248, 16, 16,
  0, 0, 0, 0, 248, 128, 240, 8, 8, 136, 112,
  0, 0, 0, 0, 56, 64, 128, 240, 136, 136, 112,
  0, 0, 0, 0, 248, 8, 16, 32, 64, 64, 64,
  0, 0, 0, 0, 112, 136, 136, 112, 136, 136, 112,
  0, 0, 0, 0, 112, 136, 136, 120, 8, 16, 224,
  126, 242, 242, 242, 114, 18, 18, 18, 18, 0, 0,
  224, 144, 224, 128, 158, 16, 28, 16, 30, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  8, 8, 8, 8, 8, 0, 0, 8, 8, 0, 0,
  72, 72, 72, 0, 0, 0, 0, 0, 0, 0, 0,
  40, 40, 40, 254, 40, 254, 40, 40, 40, 0, 0,
  16, 126, 144, 144, 124, 18, 18, 252, 16, 0, 0,
  64, 162, 68, 8, 16, 32, 68, 138, 4, 0, 0,
  112, 136, 136, 80, 32, 82, 140, 140, 114, 0, 0,
  24, 24, 16, 32, 0, 0, 0, 0, 0, 0, 0,
  8, 16, 32, 32, 32, 32, 32, 16, 8, 0, 0,
  32, 16, 8, 8, 8, 8, 8, 16, 32, 0, 0,
  0, 16, 146, 84, 56, 84, 146, 16, 0, 0, 0,
  0, 16, 16, 16, 254, 16, 16, 16, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 48, 48, 32, 64,
  0, 0, 0, 0, 254, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 48, 48, 0, 0,
  0, 2, 4, 8, 16, 32, 64, 128, 0, 0, 0,
  124, 130, 134, 138, 146, 162, 194, 130, 124, 0, 0,
  16, 48, 80, 16, 16, 16, 16, 16, 124, 0, 0,
  124, 130, 2, 4, 8, 16, 32, 64, 254, 0, 0,
  124, 130, 2, 2, 60, 2, 2, 130, 124, 0, 0,
  4, 12, 20, 36, 68, 132, 252, 4, 4, 0, 0,
  252, 128, 128, 248, 4, 2, 2, 132, 120, 0, 0,
  60, 64, 128, 128, 252, 130, 130, 130, 124, 0, 0,
  254, 130, 4, 8, 16, 32, 32, 32, 32, 0, 0,
  124, 130, 130, 130, 124, 130, 130, 130, 124, 0, 0,
  124, 130, 130, 130, 126, 2, 2, 4, 120, 0, 0,
  0, 0, 0, 48, 48, 0, 0, 48, 48, 0, 0,
  0, 0, 0, 48, 48, 0, 0, 48, 48, 32, 64,
  8, 16, 32, 64, 128, 64, 32, 16, 8, 0, 0,
  0, 0, 0, 124, 0, 124, 0, 0, 0, 0, 0,
  32, 16, 8, 4, 2, 4, 8, 16, 32, 0, 0,
  60, 66, 66, 4, 8, 16, 16, 0, 16, 0, 0,
  60, 66, 154, 170, 170, 188, 128, 64, 60, 0, 0,
  56, 68, 130, 130, 254, 130, 130, 130, 130, 0, 0,
  252, 66, 66, 66, 124, 66, 66, 66, 252, 0, 0,
  60, 66, 128, 128, 128, 128, 128, 66, 60, 0, 0,
  248, 68, 66, 66, 66, 66, 66, 68, 248, 0, 0,
  254, 128, 128, 128, 240, 128, 128, 128, 254, 0, 0,
  254, 128, 128, 128, 240, 128, 128, 128, 128, 0, 0,
  60, 66, 128, 128, 128, 158, 130, 66, 60, 0, 0,
  130, 130, 130, 130, 254, 130, 130, 130, 130, 0, 0,
  124, 16, 16, 16, 16, 16, 16, 16, 124, 0, 0,
  2, 2, 2, 2, 2, 2, 130, 130, 124, 0, 0,
  130, 132, 136, 144, 160, 208, 136, 132, 130, 0, 0,
  128, 128, 128, 128, 128, 128, 128, 128, 254, 0, 0,
  130, 198, 170, 146, 146, 130, 130, 130, 130, 0, 0,
  130, 194, 162, 146, 138, 134, 130, 130, 130, 0, 0,
  56, 68, 130, 130, 130, 130, 130, 68, 56, 0, 0,
  252, 130, 130, 130, 252, 128, 128, 128, 128, 0, 0,
  56, 68, 130, 130, 130, 146, 138, 68, 58, 0, 0,
  252, 130, 130, 130, 252, 144, 136, 132, 130, 0, 0,
  124, 130, 128, 128, 124, 2, 2, 130, 124, 0, 0,
  254, 16, 16, 16, 16, 16, 16, 16, 16, 0, 0,
  130, 130, 130, 130, 130, 130, 130, 130, 124, 0, 0,
  130, 130, 130, 68, 68, 40, 40, 16, 16, 0, 0,
  130, 130, 130, 130, 146, 146, 170, 198, 130, 0, 0,
  130, 130, 68, 40, 16, 40, 68, 130, 130, 0, 0,
  130, 130, 68, 40, 16, 16, 16, 16, 16, 0, 0,
  254, 2, 4, 8, 16, 32, 64, 128, 254, 0, 0,
  120, 64, 64, 64, 64, 64, 64, 64, 120, 0, 0,
  0, 128, 64, 32, 16, 8, 4, 2, 0, 0, 0,
  120, 8, 8, 8, 8, 8, 8, 8, 120, 0, 0,
  16, 40, 68, 130, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 254, 0,
  48, 48, 16, 8, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 120, 4, 124, 132, 132, 122, 0, 0,
  128, 128, 128, 184, 196, 132, 132, 196, 184, 0, 0,
  0, 0, 0, 120, 132, 128, 128, 132, 120, 0, 0,
  4, 4, 4, 116, 140, 132, 132, 140, 116, 0, 0,
  0, 0, 0, 120, 132, 252, 128, 128, 120, 0, 0,
  24, 36, 32, 32, 248, 32, 32, 32, 32, 0, 0,
  0, 0, 0, 116, 140, 132, 140, 116, 4, 132, 120,
  128, 128, 128, 184, 196, 132, 132, 132, 132, 0, 0,
  0, 16, 0, 48, 16, 16, 16, 16, 56, 0, 0,
  0, 4, 0, 12, 4, 4, 4, 4, 4, 68, 56,
  128, 128, 128, 136, 144, 160, 208, 136, 132, 0, 0,
  48, 16, 16, 16, 16, 16, 16, 16, 56, 0, 0,
  0, 0, 0, 236, 146, 146, 146, 146, 146, 0, 0,
  0, 0, 0, 184, 196, 132, 132, 132, 132, 0, 0,
  0, 0, 0, 120, 132, 132, 132, 132, 120, 0, 0,
  0, 0, 0, 184, 196, 132, 196, 184, 128, 128, 128,
  0, 0, 0, 116, 140, 132, 140, 116, 4, 4, 4,
  0, 0, 0, 184, 196, 128, 128, 128, 128, 0, 0,
  0, 0, 0, 120, 132, 96, 24, 132, 120, 0, 0,
  0, 32, 32, 248, 32, 32, 32, 36, 24, 0, 0,
  0, 0, 0, 132, 132, 132, 132, 140, 116, 0, 0,
  0, 0, 0, 130, 130, 130, 68, 40, 16, 0, 0,
  0, 0, 0, 130, 146, 146, 146, 146, 108, 0, 0,
  0, 0, 0, 132, 72, 48, 48, 72, 132, 0, 0,
  0, 0, 0, 132, 132, 132, 140, 116, 4, 132, 120,
  0, 0, 0, 252, 8, 16, 32, 64, 252, 0, 0,
  24, 32, 32, 32, 64, 32, 32, 32, 24, 0, 0,
  16, 16, 16, 16, 0, 16, 16, 16, 16, 0, 0,
  48, 8, 8, 8, 4, 8, 8, 8, 48, 0, 0,
  96, 146, 12, 0, 0, 0, 0, 0, 0, 0, 0,
  72, 146, 36, 72, 146, 36, 72, 146, 36, 0, 0

  q = addr(frame(0))+(vpos!!16_3FF)<<7+(hpos&16_3F0)>>3
  shiftcount = (\hpos)&15
  %if k < 0 %start;  !cursor
    flip = flip!!8
    enable reg = 8;  colour reg = flip
    *move.l q,a1
    *move #11,d0;  !height 11
    *moveq #-128,d2
    *move.l shiftcount,d3
    *move.l #2_1111111110000000,d1
    *lsl.l d3,d1
loop0: 
    *move.l d1,(a1)
    *add.l d2,a1
    *subq #1,d0
    *bgt loop0
    enable reg = 15
  %finish %else %start
    k = k-96 %if k >= 96 %and win_mode&graphical # 0
    colour = colours(win_mode&3)
    p = addr(fstore(k*10+k))
    *move.l p,a0
    *move.l q,a1
    *move #11,d0;  !height 11
    *moveq #-128,d2
    *move.l shiftcount,d3
    *move.l #2_1111111110000000,d1
    *lsl.l d3,d1
    *addq #8,d3
loop: 
    *move.b paper,colourreg;  !restore background
    *move.l d1,(a1)
    *move.b colour,colourreg
    *clr.l d4
    *move.b (a0)+,d4
    *lsl.l d3,d4
    *move.l d4,(a1)
    *add.l d2,a1
    *subq #1,d0
    *bgt loop
  %finish
%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;  vpos = row*10+row+8
  col = win_cols-1 %if col >= win_cols
  col = col+win_left;  hpos = col*9+8
  vdu_row = row;  vdu_col = col
%end
!
!!!!!!!!!!!!!!!!!!   External procedures   !!!!!!!!!!!!!!!!!!!!
!
%routine CLEAR LINE
%bytespec(16_C20001) colour reg
%routinespec(16_11a8) fill(%integer x1,y1,x2,y2)
%integer i
  %if win_col < win_cols %start
    position cursor(win_row,win_col)
    colour reg = paper
    fill(hpos,\vpos,hpos+(win_cols-win_col)*9-1,\(vpos+10))
!    i = win_col
!    %cycle
!      position cursor(win_row,i)
!      show ch(' ');  i = i+1
!      vdu_col = vdu_col+1 %if vdu_col # vright
!    %repeat %until i = win_cols
  %finish
%end
!
%routine CLEAR FRAME
!(no point in updating?)
  win_row = 0;  win_col = 0
  position cursor(0,0)
  %cycle
    clear line
    win_row = win_row+1
  %repeat %until win_row >= win_rows
  win_row = 0
%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
  print ch('%')
%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 sym&96 # 0 %start;  !not control
    %return %if win_col >= win_cols
    position cursor(win_row,win_col)
    show 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
    %finish
  %finish %else %start
    clear line
    %if win_row # win_rows-1 %start
      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
!
%recordformat eventfm(%integer event,subevent,extra,pc,
        %string(255) message,%integerarray r(0:15))
%record(eventfm)%spec(16_3400) event
!
%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 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)
%shortspec(16_480000) mapreg4
%bytespec(16_C20000) enable reg
%shortspec(16_C20002) origin reg
%bytespec(16_C20001) colour reg
%routinespec(16_11a8) fill(%integer x1,y1,x2,y2)
%owninteger zero=0
%integer p
  %return %if mode = options
  p = mode&specialpad
  %if options = untouched %start
    vdu_fun = intense
    vdu_rows = 24;  vdu_cols = 80
    inmode = vdu_fun;  outmode = vdu_fun
    win = vdu
    mapreg4 = 16_40; !Map reg 4 -> 004xxxxx
    enable reg = 15
    colour reg = paper; fill(0,0,1023,1023)
    origin reg = zero
  %finish
  set terminal mode(mode!(single+noecho)-p)
  echoinc = 1;  echoinc = 0 %if options&noecho # 0
  %if (mode!!options)&specialpad # 0 %start;  !change in pad mode
    %if p # 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
  position cursor(win_row,win_col)
  show ch(-1)
  read ch(kk)
  show ch(-1)
  %if ' ' <= kk < del %start
    %if echoinc # 0 %start
      win_col = win_col+echoinc
      show ch(kk)
    %finish
  %finish
  %if kk = esc %start
    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)
  win_col = win_col-echoinc %if ' '  <= pend < del
  %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)
%record(*)%spec(0) NIL