print (string.sub("knights",2))    -- remove the first character
print (string.sub("knights",1,-2))    -- remove the last character
print (string.sub("knights",2,-2))    -- remove the first and last characters


> s := "some string":
> s[2..-1];
                              "ome string"

> s[1..-2];
                              "some strin"

> s[2..-2];
                              "ome strin"


defmodule Subtractive do
  def new(seed) when seed in 0..999_999_999 do
    s = Enum.reduce(1..53, [1, seed], fn _,[a,b|_]=acc -> [b-a | acc] end)
        |> Enum.reverse
        |> List.to_tuple
    state = for i <- 1..55, do: elem(s, rem(34*i, 55))
    {:ok, _pid} = Agent.start_link(fn -> state end, name: :Subtractive)
    Enum.each(1..220, fn _ -> rand end) # Discard first 220 elements of sequence.
  end

  def rand do
    state = Agent.get(:Subtractive, &(&1))
    n = rem(Enum.at(state, -55) - Enum.at(state, -24) + 1_000_000_000, 1_000_000_000)
    :ok = Agent.update(:Subtractive, fn _ -> tl(state) ++ [n] end)
    hd(state)
  end
end

Subtractive.new(292929)
for _ <- 1..10, do: IO.puts Subtractive.rand


[<EntryPoint>]
let main argv =
    let m = 1000000000
    let init = Seq.unfold (fun ((i, s2, s1)) -> Some((s2,i), (i+1, s1, (m+s2-s1)%m))) (0, 292929, 1)
            |> Seq.take 55
            |> Seq.sortBy (fun (_,i) -> (34*i+54)%55)
            |> Seq.map fst
    let rec r = seq {
        yield! init
        yield! Seq.map2 (fun u v -> (m+u-v)%m) r (Seq.skip 31 r)
    }

    r |> Seq.skip 220 |> Seq.take 3
    |> Seq.iter (printfn "%d")
    0


module subgenerator
  implicit none

  integer, parameter :: modulus = 1000000000
  integer :: s(0:54), r(0:54)

contains

subroutine initgen(seed)
  integer :: seed
  integer :: n, rnum

  s(0) = seed
  s(1) = 1

  do n = 2, 54
    s(n) = mod(s(n-2) - s(n-1), modulus)
    if (s(n) < 0) s(n) = s(n) + modulus
  end do

  do n = 0, 54
    r(n) = s(mod(34*(n+1), 55))
  end do

  do n = 1, 165
    rnum = subrand()
  end do

end subroutine initgen

integer function subrand()
  integer, save :: p1 = 0
  integer, save :: p2 = 31

  r(p1) = mod(r(p1) - r(p2), modulus)
  if (r(p1) < 0) r(p1) = r(p1) + modulus
  subrand = r(p1)
  p1 = mod(p1 + 1, 55)
  p2 = mod(p2 + 1, 55)

end function subrand
end module subgenerator

program subgen_test
  use subgenerator
  implicit none

  integer :: seed = 292929
  integer :: i

  call initgen(seed)
  do i = 1, 10
    write(*,*) subrand()
  end do

end program


StringDrop["input string",1]
StringDrop["input string",-1]
StringTake["input string",{2,-2}]


    % String with first character removed
    str(2:end)
    % String with last character removed
    str(1:end-1)
    % String with both the first and last characters removed
    str(2:end-1)


test = "This thing"
print test[1:]
print test[:-1]
print test[1:-1]


/**
 Subtring/Top-Tail in Neko
*/

var data = "[this is a test]"
var len = $ssize(data)

$print(data, "\n")
$print($ssub(data, 1, len - 1), "\n")
$print($ssub(data, 0, len - 1), "\n")
$print($ssub(data, 1, len - 2), "\n")


package main

import (
    "fmt"
    "os"
)

// A fairly close port of the Bentley code, but parameterized to better
// conform to the algorithm description in the task, which didn't assume
// constants for i, j, m, and seed.  also parameterized here are k,
// the reordering factor, and s, the number of intial numbers to discard,
// as these are dependant on i.
func newSG(i, j, k, s, m, seed int) func() int {
    // check parameters for range and mutual consistency
    assert(i > 0, "i must be > 0")
    assert(j > 0, "j must be > 0")
    assert(i > j, "i must be > j")
    assert(k > 0, "k must be > 0")
    p, q := i, k
    if p < q {
        p, q = q, p
    }
    for q > 0 {
        p, q = q, p%q
    }
    assert(p == 1, "k, i must be relatively prime")
    assert(s >= i, "s must be >= i")
    assert(m > 0, "m must be > 0")
    assert(seed >= 0, "seed must be >= 0")
    // variables for closure f
    arr := make([]int, i)
    a := 0
    b := j
    // f is Bently RNG lprand
    f := func() int {
        if a == 0 {
            a = i
        }
        a--
        if b == 0 {
            b = i
        }
        b--
        t := arr[a] - arr[b]
        if t < 0 {
            t += m
        }
        arr[a] = t
        return t
    }
    // Bentley seed algorithm sprand
    last := seed
    arr[0] = last
    next := 1
    for i0 := 1; i0 < i; i0++ {
        ii := k * i0 % i
        arr[ii] = next
        next = last - next
        if next < 0 {
            next += m
        }
        last = arr[ii]
    }
    for i0 := i; i0 < s; i0++ {
        f()
    }
    // return the fully initialized RNG
    return f
}

func assert(p bool, m string) {
    if !p {
        fmt.Println(m)
        os.Exit(1)
    }
}

func main() {
    // 1st test case included in program_tools/universal.c.
    // (2nd test case fails.  A single digit is missing, indicating a typo.)
    ptTest(0, 1, []int{921674862, 250065336, 377506581})

    // reproduce 3 values given in task description
    skip := 220
    sg := newSG(55, 24, 21, skip, 1e9, 292929)
    for n := skip; n <= 222; n++ {
        fmt.Printf("r(%d) = %d\n", n, sg())
    }
}

func ptTest(nd, s int, rs []int) {
    sg := newSG(55, 24, 21, 220+nd, 1e9, s)
    for _, r := range rs {
        a := sg()
        if r != a {
            fmt.Println("Fail")
            os.Exit(1)
        }
    }
}


using System;
using System.Console;

module RemoveChars
{
    Main() : void
    {
        def str = "*A string*";
        def end = str.Remove(str.Length - 1);  // from pos to end
        def beg = str.Remove(0, 1);            // start pos, # of chars to remove
        def both = str.Trim(array['*']);       // with Trim() you need to know what char's you're removing

        WriteLine($"$str -> $beg -> $end -> $both");
    }
}


/**********************************************************************
* 02.08.2013 Walter Pachl  translated from REXX
**********************************************************************/
z = 'abcdefghijk'
l=z.length()
say '                  the original string =' z
If l>=1 Then Do
  Say 'string first        character removed =' z.substr(2)
  say 'string         last character removed =' z.left(l-1)
  End
If l>=2 Then
  Say 'string first & last character removed =' z.substr(2,l-2)


(let (str "rosetta")
  ;; strip first char
  (println (1 str))
  ;; strip last char
  (println (0 -1 str))
  ;; strip both first and last characters
  (println (1 -1 str)))


import unicode

let s = "Hänsel  ««: 10,00€"
echo "Original: ", s
echo "With first character removed: ", s.runeSubStr(1)
echo "With last character removed: ", s.runeSubStr(0, s.runeLen - 1)
echo "With first and last characters removed: ", s.runeSubStr(1, s.runeLen - 2)
# Using the runes type and slices
let r = s.toRunes
echo "With first and last characters removed (other way): ", r[1 .. ^2]


subtractgen :: Int -> [Int]
subtractgen seed = drop 220 out
  where
    out = mmod $ r <> zipWith (-) out (drop 31 out)
      where
        r = take 55 $ shuffle $ cycle $ take 55 s
        shuffle x = (:) . head <*> shuffle $ drop 34 x
        s = mmod $ seed : 1 : zipWith (-) s (tail s)
        mmod = fmap (`mod` 10 ^ 9)

main :: IO ()
main = mapM_ print $ take 10 $ subtractgen 292929


procedure main()
   every 1 to 10 do
      write(rand_sub(292929))
end

procedure rand_sub(x)
static ring,m
   if /ring then {
      m := 10^9
      every (seed | ring) := list(55)
      seed[1] := \x | ?(m-1)
      seed[2] := 1
      every seed[n := 3 to 55] := (seed[n-2]-seed[n-1])%m
      every ring[(n := 0 to 54) + 1] := seed[1 + (34 * (n + 1)%55)]
      every  n := *ring to 219 do {
         ring[1] -:= ring[-24]
         ring[1] %=  m
         put(ring,get(ring))
         }
   }
   ring[1] -:= ring[-24]
   ring[1] %:= m
   if ring[1] < 0 then ring[1] +:= m
   put(ring,get(ring))
   return ring[-1]
end


bundle Default {
   class TopTail {
      function : Main(args : System.String[]) ~ Nil {
         string := "test";
         string->SubString(1, string->Size() - 1)->PrintLine();
         string->SubString(string->Size() - 1)->PrintLine();
         string->SubString(1, string->Size() - 2)->PrintLine();
      }
   }
}


let strip_first_char str =
  if str = "" then "" else
  String.sub str 1 ((String.length str) - 1)

let strip_last_char str =
  if str = "" then "" else
  String.sub str 0 ((String.length str) - 1)

let strip_both_chars str =
  match String.length str with
  | 0 | 1 | 2 -> ""
  | len -> String.sub str 1 (len - 2)

let () =
  print_endline (strip_first_char "knight");
  print_endline (strip_last_char "socks");
  print_endline (strip_both_chars "brooms");
;;


came_from_locale_sg_=: coname''
cocurrent'sg' NB. install the state of rng sg into locale sg

SEED=: 292929
'I J M first_Bentley_number B2'=: 55 24 1e9 34 165
SG=: 1 : 'M&|@:-/@:(m&{)'
r=: (I|(first_Bentley_number*>:i.I)) { (, _2 _1 SG)^:(I-2) 1,~SEED

sg=: 3 : 0
t=. (, (-I,J)SG)^:y r
r=: y }. t
t {.~ -y
)
discard=. sg B2

cocurrent came_from_locale  NB. return to previous locale
sg=: sg_sg_                 NB. make a local name for sg in locale sg


import java.util.function.IntSupplier;
import static java.util.stream.IntStream.generate;

public class SubtractiveGenerator implements IntSupplier {
    static final int MOD = 1_000_000_000;
    private int[] state = new int[55];
    private int si, sj;

    public SubtractiveGenerator(int p1) {
        subrandSeed(p1);
    }

    void subrandSeed(int p1) {
        int p2 = 1;

        state[0] = p1 % MOD;
        for (int i = 1, j = 21; i < 55; i++, j += 21) {
            if (j >= 55)
                j -= 55;
            state[j] = p2;
            if ((p2 = p1 - p2) < 0)
                p2 += MOD;
            p1 = state[j];
        }

        si = 0;
        sj = 24;
        for (int i = 0; i < 165; i++)
            getAsInt();
    }

    @Override
    public int getAsInt() {
        if (si == sj)
            subrandSeed(0);

        if (si-- == 0)
            si = 54;
        if (sj-- == 0)
            sj = 54;

        int x = state[si] - state[sj];
        if (x < 0)
            x += MOD;

        return state[si] = x;
    }

    public static void main(String[] args) {
        generate(new SubtractiveGenerator(292_929)).limit(10)
                .forEach(System.out::println);
    }
}


: topAndTail(s)
    s right(s size 1-) println
    s left(s size 1-) println
    s extract(2, s size 1- ) println ;


print substr("knight",1), "\n";        # strip first character
print substr("socks", 0, -1), "\n";    # strip last character
print substr("brooms", 1, -1), "\n";   # strip both first and last characters


# If $p is null, then call `subrand`,
# which sets .x as the PRN and which expects the the input to
# be the PRNG state, which is updated.
def subrandSeed($p):

  def subrand:
    if (.si == .sj) then subrandSeed(0) else . end
    | .si |= (if . == 0 then 54 else . - 1 end)
    | .sj |= (if . == 0 then 54 else . - 1 end)
    | .mod as $mod
    | .x = ((.state[.si] - .state[.sj]) | if . < 0 then . + $mod else . end)
    | .state[.si] = .x ;

  if $p == null then subrand
  else
  {mod: 1e9,  state: [],  si: 0,  sj: 0,  p: $p,  p2: 1,  j: 21}
  | .state[0] = ($p % .mod)
  | reduce range(1; 55) as $i (.;
        if .j >= 55 then .j += -55 else . end
        | .state[.j] = .p2
        | .p2 = .p - .p2
        | if .p2 < 0 then .p2 = .p2 + .mod else . end
        | .p = .state[.j]
        | .j += 21)
  | .si = 0
  | .sj = 24
  | reduce range(1; 166) as $i (.; subrand)
  end;

def subrand:
  subrandSeed(null);

subrandSeed(292929)
| foreach range(0; 10) as $i (.;
    subrand;
    "r[\($i+220)] = \(.x)")


i,j,m,d,seed = 55,24,10^9,34,292929     # parameters
s = Array{Int32}(undef,i); r = similar(s)
s[1:2] = [seed,1]                       # table initialization
for n = 3:i; (s[n] = s[n-2]-s[n-1]) < 0 && (s[n] += m) end
t = 1; for u=1:i; (global t+=d)>i && (t-=i); r[u]=s[t] end # permutation, r = s[(d*(1:i) .% i).+1]

u,v,n = i,i-j,i-1
while (n += 1) > 0
    (global u += 1) > i && (u = 1)      # circular indexing: u,v = ((n,n-j) .% i).+1
    (global v += 1) > i && (v = 1)
    (r[u] -= r[v]) < 0 && (r[u] += m)   # table update
    n < 220 && continue                 # 165 silent values
    print((n,r[u]))                     # show (index,value) of next pseudorandom number
    x = readline(stdin)                 # wait until the ENTER key is pressed
    length(x) > 0 && break              # any other key before ENTER => exit
end


// version 1.1.51

const val MOD = 1_000_000_000

val state = IntArray(55)
var si = 0
var sj = 0

fun subrandSeed(p: Int) {
    var p1 = p
    var p2 = 1
    state[0] = p1 % MOD
    var j = 21
    for (i in 1..54) {
        if (j >=55) j -= 55
        state[j] = p2
        p2 = p1 - p2
        if (p2 < 0) p2 += MOD
        p1 = state[j]
        j += 21
    }
    si = 0
    sj = 24
    repeat(165) { subrand() }
}

fun subrand(): Int {
    if (si == sj) subrandSeed(0)
    if (si-- == 0) si = 54
    if (sj-- == 0) sj = 54
    var x = state[si] - state[sj]
    if (x < 0) x += MOD
    state[si] = x
    return x
}

fun main(args: Array<String>) {
    subrandSeed(292_929)
    for (i in 0..9) println("r[${i + 220}] = ${subrand()}")
}


include ..\Utilitys.pmt

"(test)"
dup 1 del ?
dup -1 del ?
dup 1 del -1 del ?


<?php
echo substr("knight", 1), "\n";       // strip first character
echo substr("socks", 0, -1), "\n";    // strip last character
echo substr("brooms", 1, -1), "\n";   // strip both first and last characters
?>


go =>
  test("upraisers"),
  test("Δημοτική"),
  nl.

test(S) =>
  println(s=S),
  println(butfirst=S.slice(2)),
  println(butfirst=S.tail),
  println(butfirst=S[2..S.len]),

  println(butlast=S.but_last()),

  println(butfirst_butlast=S.tail.but_last),
  println(butfirst_butlast=slice(S,2,S.length-1)),
  println(butfirst_butlast=[S[I] : I in 2..S.length-1]),
  println(butfirst_butlast=S[2..S.length-1]),
  nl.

but_last(S)  = S.slice(1,S.length-1).


function SubGen(seed)
  local n, r, s = 54, {}, { [0]=seed, 1 }
  for n = 2,54 do s[n] = (s[n-2] - s[n-1]) % 1e9 end
  for n = 0,54 do r[n] = s[(34*(n+1))%55] end
  local next = function()
    n = (n+1) % 55
    r[n] = (r[(n-55)%55] - r[(n-24)%55]) % 1e9
    return r[n]
  end
  for n = 55,219 do next() end
  return next
end
subgen = SubGen(292929)
for n = 220,229 do print(n,subgen()) end


initialize[n_] :=
 Module[{buffer},
  buffer =
   Join[Nest[[email protected]{#, Mod[Subtract @@ #[[-2 ;;]], 10^9]} &, {n, 1},
       53][[1 + Mod[34 [email protected], 55]]], {n}];
  Nest[nextValue, buffer, 165]]

  nextValue[buffer_] :=
 [email protected]{[email protected], Mod[Subtract @@ buffer[[{1, 32}]], 10^9]}


import deques, sequtils

template shfl(idx): untyped = (K*(idx+1)) mod I

func mutuallyprime(I, K: int16): bool {.compiletime.} =
  ## compile time check shuffling works properly
  let
    x = {1'i16..I}
    s = x.toSeq
  var r: set[int16]
  for n in 0..<I:
    r.incl s[n.shfl]
  r == x

func `%`(i: int, m: int): int = (if i < 0: i+m else: i)
  ## positive modulo, and we don't need to test if > m
  ## because (i-j) is always less than m

template next(state): untyped =
  state.addLast (state[^I]-state[^J]) % M
  discard state.popFirst()

func seedGen[I, J, K, M: static int](seed: range[0..M-1]): Deque[int] =
  var s = @[seed, 1]
  for _ in 2..<I:
    s.add (s[^2]-s[^1]) % M
  #reorder and put into ring buffer
  for i in 0..<I:
    result.addLast s[i.shfl]
  #cycle through the next 165 values
  for _ in 0..<3*I:
    result.next

func initSubGen[I, J, K, M: static int](seed: range[0..M-1]): auto =
  ##check parameters at compile time
  ##seed will be checked to be in the range 0..M-1
  static:
    for x in [I, J, K, M]:
      assert x > 0, "all params must be positive"
    assert I > J, "I must be > J"
    assert mutuallyprime(I, K), "I, K must be relatively prime"
  var r = seedGen[I, J, K, M](seed)
  result = proc(): int =
    r.next
    r.peekLast

let subGen* = initSubGen[55, 24, 34, 1e9.int]

when isMainModule:
  let rand = subGen(292929)
  for _ in 1..3:
    echo rand()


: (pack (cdr (chop "knight")))         # Remove first character
-> "night"

: (pack (head -1 (chop "socks")))      # Remove last character
-> "sock"

: (pack (cddr (rot (chop "brooms"))))  # Remove first and last characters
-> "room"


declare s character (100) varying;
s = 'now is the time to come to the aid of the party';
if length(s) <= 2 then stop;
put skip list ('First character removed=' || substr(s,2) );
put skip list ('Last character removed='  || substr(s, 1, length(s)-1) );
put skip list ('One character from each end removed=' ||
   substr(s, 2, length(s)-2) );


To run:
Start up.
Demonstrate removing the first and last characters from "Rosetta Code".
Wait for the escape key.
Shut down.

To demonstrate removing the first and last characters from a string:
Slap a substring on the string.
Add 1 to the substring's first.
Write the substring on the console.
Subtract 1 from the substring's first.
Subtract 1 from the substring's last.
Write the substring on the console.
Add 1 to the substring's first.
Write the substring on the console.


$string = "top and tail"
$string
$string.Substring(1)
$string.Substring(0, $string.Length - 1)
$string.Substring(1, $string.Length - 2)


remove_first_last_chars :-
    L = "Rosetta",
    L = [_|L1],
    remove_last(L, L2),
    remove_last(L1, L3),
    writef('Original string      : %s\n', [L]),
    writef('Without first char       : %s\n', [L1]),
    writef('Without last char        : %s\n', [L2]),
    writef('Without first/last chars : %s\n', [L3]).

remove_last(L, LR) :-
    append(LR, [_], L).


let _mod = 1_000_000_000
let state = Array.create 55 0
let si = ref 0
let sj = ref 0

let rec subrand_seed _p1 =
  let p1 = ref _p1 in
  let p2 = ref 1 in
  state.(0) <- !p1 mod _mod;
  let j = ref 21 in
  for i = 1 to pred 55 do
    if !j >= 55 then j := !j - 55;
    state.(!j) <- !p2;
    p2 := !p1 - !p2;
    if !p2 < 0 then p2 := !p2 + _mod;
    p1 := state.(!j);
    j := !j + 21;
  done;
  si := 0;
  sj := 24;
  for i = 0 to pred 165 do ignore (subrand()) done

and subrand() =
  if !si = !sj then subrand_seed 0;
  decr si;  if !si < 0 then si := 54;
  decr sj;  if !sj < 0 then sj := 54;
  let x = state.(!si) - state.(!sj) in
  let x = if x < 0 then x + _mod else x in
  state.(!si) <- x;
  (x)

let () =
  subrand_seed 292929;
  for i = 1 to 10 do Printf.printf "%d\n" (subrand()) done


/*REXX program uses a subtractive generaTor,and creates a sequence of ranDom numbers. */
/* array index must be positive! */
s=.array~new
r=.array~new
s[1]=292929
s[2]=1
billion=1e9
numeric digits 20
ci=55
Do i=2 To ci-1
  s[i+1]=mod(s[i-1]-s[i],billion)
  End
cp=34
Do j=0 To ci-1
  r[j+1]=s[mod(cp*(j+1),ci)+1]
  End
m=219
cj= 24
Do k=ci To m
  _=k//ci
  r[_+1]=mod(r[mod(k-ci,ci)+1]-r[mod(k-cj,ci)+1],billion)
  End
t=235
Do n=m+1 To t
  _=n//ci
  r[_+1]=mod(r[mod(n-ci,ci)+1]-r[mod(n-cj,ci)+1],billion)
  Say right(r[_+1],40)
  End
Exit
mod: Procedure
Parse Arg a,b
Return ((a//b)+b)//b


If OpenConsole()
  PrintN(Right("knight", Len("knight") - 1))  ;strip the first letter
  PrintN(Left("socks", Len("socks")- 1))      ;strip the last letter
  PrintN(Mid("brooms", 2, Len("brooms") - 2)) ;strip both the first and last letter

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


print "knight"[1:]     # strip first character
print "socks"[:-1]     # strip last character
print "brooms"[1:-1]   # strip both first and last characters


/O> $ "callipygian"
... say "original string:   "
... dup echo$ cr
... say "without head:      "
... dup behead drop echo$ cr
... say "without tail:      "
... -1 split drop dup echo$ cr
... say "topped and tailed: "
... behead drop echo$ cr
...
original string:   callipygian
without head:      allipygian
without tail:      callipygia
topped and tailed: allipygia


#lang racket

(define str "ストリング")

(substring str 1)
(substring str 0 (sub1 (string-length str)))
(substring str 1 (sub1 (string-length str)))


use 5.10.0;
use strict;

{ # bracket state data into a lexical scope
	my @state;
	my $mod = 1_000_000_000;

	sub bentley_clever {
		my @s = ( shift() % $mod, 1);
		push @s, ($s[-2] - $s[-1]) % $mod	while @s < 55;
		@state = map($s[(34 + 34 * $_) % 55], 0 .. 54);
		subrand() for (55 .. 219);
	}

	sub subrand()
	{
		bentley_clever(0) unless @state; # just incase

		my $x = (shift(@state) - $state[-24]) % $mod;
		push @state, $x;
		$x;
	}
}

bentley_clever(292929);
say subrand() for (1 .. 10);


with javascript_semantics
sequence state = repeat(0,55)
integer pos

constant MAX = 1e9
function cap(integer n)
    if n<0 then n += MAX end if
    return n
end function

function next()
    pos = mod(pos,55)+1
    integer temp = cap(state[pos]-state[mod(pos+30,55)+1])
    state[pos] = temp
    return temp
end function

procedure init(integer seed)
    sequence temp = repeat(0,55)
    temp[1] = cap(seed)
    temp[2] = 1
    for i=3 to 55 do
        temp[i] = cap(temp[i-2]-temp[i-1])
    end for
    for i=1 to 55 do
        state[i] = temp[mod(34*i,55)+1]
    end for
    pos = 55
    for i=55 to 219 do
        {} = next()
    end for
end procedure

init(292929)
for i=220 to 222 do
    printf(1,"%d: %d\n",{i,next()})
end for


my $s = '𝄪♯♮♭𝄫';

print qq:to/END/;
    Original:
    $s

    Remove first character:
    { substr($s, 1) }
    { $s.substr(1) }

    Remove last character:
    { substr($s, 0, *-1) }
    { $s.substr( 0, *-1) }
    { $s.chop }

    Remove first and last characters:
    { substr($s, 1, *-1) }
    { $s.substr(1, *-1) }
    END


define println use $s
   $s print "\n" print

"0123456789" as $str

define offTheTop use $s
   $s 1 0x7FFFFFFF extract

define offTheTail use $s
   $s 0 -1 extract

$str offTheTop  println
$str offTheTail println
$str offTheTop  offTheTail  println


/*REXX program demonstrates removal of  1st/last/1st-and-last  characters from a string.*/
@ = 'abcdefghijk'
say '                  the original string ='  @
say 'string first        character removed ='  substr(@, 2)
say 'string         last character removed ='  left(@, length(@) -1)
say 'string first & last character removed ='  substr(@, 2, length(@) -2)
                                                 /*stick a fork in it,  we're all done. */
   /* ╔═══════════════════════════════════════════════════════════════════════════════╗
      ║  However, the original string may be null or exactly one byte in length which ║
      ║  will cause the  BIFs to fail because of  either zero  or  a negative length. ║
      ╚═══════════════════════════════════════════════════════════════════════════════╝ */


(setq
   *Bentley (apply circ (need 55))
   *Bentley2 (nth *Bentley 32) )

(de subRandSeed (S)
   (let (N 1  P (nth *Bentley 55))
      (set P S)
      (do 54
         (set (setq P (nth P 35)) N)
         (when (lt0 (setq N (- S N)))
            (inc 'N 1000000000) )
         (setq S (car P)) ) )
   (do 165 (subRand)) )

(de subRand ()
   (when (lt0 (dec *Bentley (pop '*Bentley2)))
      (inc *Bentley 1000000000) )
   (pop '*Bentley) )


subtractive_generator: procedure options (main);

   declare (r, s) (0:54) fixed binary (31);
   declare (i, n, seed)  fixed binary (31);

   /* Bentley's initialization */
   seed = 292929;
   s(0) = seed; s(1) = 1;

   /* Compute s2,s3,...,s54 using the subtractive formula sn = s(n-2) - s(n-1)(mod 10**9). */
   do n = 2 to hbound(s,1);
      s(n) = mod ( s(n-2) - s(n-1), 1000000000);
   end;

   /* Rearrange initial values. */
   do n = 0 to hbound(r,1);
      r(n) = s( mod(34*(n+1), 55));
   end;

   do n = 55 to 219;
      i = mod (n, 55);
      r(i) = mod ( r(mod(n-55, 55)) - r(mod(n-24, 55)), 1000000000);
   end;

   do n = 220 to 235;
      i = mod(n, 55);
      r(i) = mod ( r(mod(n-55, 55)) - r(mod(n-24, 55)), 1000000000);
      put skip list (r(i));
   end;

end subtractive_generator;


function Get-SubtractiveRandom ( [int]$Seed )
    {
    function Mod ( [int]$X, [int]$M = 1000000000 ) { ( $X % $M + $M ) % $M }

    If ( $Seed )
        {
        $R = New-Object int[] 55

        $N1 = 55 - 1
        $N2 = ( $N1 + 34 ) % 55

        $R[$N1] = $Seed
        $R[$N2] = 1

        ForEach ( $x in 2..(55-1) )
            {
            $N0, $N1, $N2 = $N1, $N2, ( ( $N2 + 34 ) % 55 )
            $R[$N2] = Mod ( $R[$N0] - $R[$N1] )
            }

        $i = -55 - 1
        $j = -24 - 1

        ForEach ( $x in 55..219 )
            {
            $i = ++$i % 55
            $j = ++$j % 55
            $R[$i] = Mod ( $R[$i] - $R[$j] )
            }

        $Script:RandomRing  = $R
        $Script:RandomIndex = $i
        }

    $i = $Script:RandomIndex = ++$Script:RandomIndex % 55
    $j = ( $i + 55 - 24 ) % 55

    return ( $Script:RandomRing[$i] = Mod ( $Script:RandomRing[$i] - $Script:RandomRing[$j] ) )
    }

Get-SubtractiveRandom 292929
Get-SubtractiveRandom
Get-SubtractiveRandom
Get-SubtractiveRandom
Get-SubtractiveRandom


aString = "1Welcome to the Ring Programming Language2"
see substr(aString,2,len(aString)-1) + nl +
substr(aString,1,len(aString)-1) + nl +
substr(aString,2,len(aString)-2) + nl


puts "knight"[1..-1]   # strip first character
puts "socks"[0..-2]    # strip last character
puts "socks".chop      # alternate way to strip last character
puts "brooms"[1..-2]   # strip both first and last characters
puts "与今令"[1..-2]    # => 今


s$  = "Run BASIC"
print mid$(s$,2)             'strip first
print left$(s$,len(s$) -1)   'strip last
print mid$(s$,2,len(s$) -2)  'strip first and last


fn main() {
    let s = String::from("žluťoučký kůň");

    let mut modified = s.clone();
    modified.remove(0);
    println!("{}", modified);

    let mut modified = s.clone();
    modified.pop();
    println!("{}", modified);

    let mut modified = s;
    modified.remove(0);
    modified.pop();
    println!("{}", modified);
}


println("knight".tail)               // strip first character
println("socks".init)         // strip last character
println("brooms".tail.init)   // strip both first and last characters


import collections
s= collections.deque(maxlen=55)
#    Start with a single seed in range 0 to 10**9 - 1.
seed = 292929

#    Set s0 = seed and s1 = 1.
#    The inclusion of s1 = 1 avoids some bad states
#    (like all zeros, or all multiples of 10).
s.append(seed)
s.append(1)

#    Compute s2,s3,...,s54 using the subtractive formula
#    sn = s(n - 2) - s(n - 1)(mod 10**9).
for n in xrange(2, 55):
    s.append((s[n-2] - s[n-1]) % 10**9)

#    Reorder these 55 values so r0 = s34, r1 = s13, r2 = s47, ...,
#                               rn = s(34 * (n + 1)(mod 55)).

r = collections.deque(maxlen=55)
for n in xrange(55):
    i = (34 * (n+1)) % 55
    r.append(s[i])
#        This is the same order as s0 = r54, s1 = r33, s2 = r12, ...,
#                                  sn = r((34 * n) - 1(mod 55)).
#        This rearrangement exploits how 34 and 55 are relatively prime.
#    Compute the next 165 values r55 to r219. Store the last 55 values.

def getnextr():
    """get next random number"""
    r.append((r[0]-r[31])%10**9)
    return r[54]

# rn = r(n - 55) - r(n - 24)(mod 10**9) for n >= 55
for n in xrange(219 - 54):
    getnextr()

# now fully initilised
# print first five numbers
for i in xrange(5):
    print "result = ", getnextr()


#lang racket
(define (make-initial-state a-list max-i)
  (for/fold ((state a-list))
            ((i (in-range (length a-list) max-i)))
    (append state (list (- (list-ref state (- i 2)) (list-ref state (- i 1))))))) ;from the seed and 1 creates the initial state

(define (shuffle a-list)
  (for/list ((i (in-range (length a-list))))
    (list-ref a-list (modulo (* 34 (add1 i)) 55))))  ;shuffles the state

(define (advance-state state (times 1))
  (cond ((= 0 times) state)
        (else (advance-state
               (cdr (append state
                            (list (modulo (- (list-ref state 0) (list-ref state 31))
                                          (expt 10 9)))))
                             (sub1 times)))))  ;takes a state and the times it must be advanced, and returns the new state

(define (create-substractive-generator s0)
  (define s1 1)
  (define first-state (make-initial-state (list s0 s1) 55))
  (define shuffled-state (shuffle first-state))
  (define last-state (advance-state shuffled-state 165))
  (lambda ((m (expt 10 9)))
    (define new-state (advance-state last-state))
    (set! last-state new-state)
    (modulo (car (reverse last-state)) m)))                    ;the lambda is a function with an optional argument
                                                               ;that returns a new random number each time it's called
(define rand (create-substractive-generator 292929))
(build-list 3 (lambda (_) (rand)))  ;returns a list made from the 3 wanted numbers


sub bentley-clever($seed) {
    constant $mod = 1_000_000_000;
    my @seeds = ($seed % $mod, 1, (* - *) % $mod ... *)[^55];
    my @state = @seeds[ 34, (* + 34 ) % 55 ... 0 ];

    sub subrand() {
        push @state, (my $x = (@state.shift - @state[*-24]) % $mod);
        $x;
    }

    subrand for 55 .. 219;

    &subrand ... *;
}

my @sr = bentley-clever(292929);
.say for @sr[^10];


(define (string-top s)
  (if (string=? s "") s (substring s 0 (- (string-length s) 1))))

(define (string-tail s)
  (if (string=? s "") s (substring s 1 (string-length s))))

(define (string-top-tail s)
  (string-tail (string-top s)))


$ include "seed7_05.s7i";

const proc: main is func
  local
    const string: stri is "upraisers";
  begin
    writeln("Full string:   " <& stri);
    writeln("Without first: " <& stri[2 ..]);
    writeln("Without last:  " <& stri[.. pred(length(stri))]);
    writeln("Without both:  " <& stri[2 .. pred(length(stri))]);
  end func;


set message to peaceSymbol & "Peace!"
put message
put characters second to last of message
put characters 1 to -2 of message
put the second to penultimate characters of message


say "knight".substr(1);       # strip first character
say "socks".substr(0, -1);    # strip last character
say "brooms".substr(1, -1);   # strip both first and last characters
say "与今令".substr(1, -1);    # => 今


/*REXX program uses a  subtractive generator, and creates a sequence of random numbers. */
s.0= 292929;                             s.1= 1;                       billion= 1e9
numeric digits 20
cI= 55;           do i=2    for cI-2;    s.i= mod( s(i-2)  -  s(i-1),  billion)
                  end   /*i*/
Cp= 34
                  do j=0    for cI;      r.j= s( mod( cP * (j+1), cI))
                  end   /*j*/
m= 219;   Cj= 24
                  do k=cI   to m;        _= k // cI
                  r._= mod( r( mod(k-cI, cI))  -  r( mod(k-cJ, cI) ),  billion)
                  end   /*m*/
t= 235
                  do n=m+1  to t;     _= n // cI
                  r._= mod( r( mod(n-cI, cI))  -  r( mod(n-cJ, cI) ),  billion)
                  say   right(r._, 40)
                  end   /*n*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
mod: procedure;   parse arg a,b;         return  ( (a // b)  +  b)  //  b
r:                parse arg #;           return  r.#
s:                parse arg #;           return  s.#


# SubRandom is a subtractive random number generator which generates
# the same sequences as Bentley's generator, as used in xpat2.
class SubRandom
  # The original seed of this generator.
  attr_reader :seed

  # Creates a SubRandom generator with the given _seed_.
  # The _seed_ must be an integer from 0 to 999_999_999.
  def initialize(seed = Kernel.rand(1_000_000_000))
    (0..999_999_999).include? seed or
      raise ArgumentError, "seed not in 0..999_999_999"

    # @state = 55 elements.
    ary = [seed, 1]
    53.times { ary << ary[-2] - ary[-1] }
    @state = []
    34.step(1870, 34) {|i| @state << ary[i % 55] }

    220.times { rand }  # Discard first 220 elements of sequence.

    @seed = seed        # Save original seed.
  end

  # Duplicates internal state so SubRandom#dup never shares state.
  def initialize_copy(orig)
    @state = @state.dup
  end

  # Returns the next random integer, from 0 to 999_999_999.
  def rand
    @state << (@state[-55] - @state[-24]) % 1_000_000_000
    @state.shift
  end
end

rng = SubRandom.new(292929)
p (1..3).map { rng.rand }


s := 'upraisers'.
Transcript show: 'Top: ', s allButLast; nl.
Transcript show: 'Tail: ', s allButFirst; nl.
Transcript show: 'Without both: ', s allButFirst allButLast; nl.
Transcript show: 'Without both using substring method: ', (s copyFrom: 2 to: s size - 1); nl.


     "knight" len(1) rem . output       ;* strip first character
     "socks" rtab(1) . output           ;* strip last character
     "brooms" len(1) rtab(1) . output   ;* strip both first and last characters


- val str = "abcde";
val str = "abcde" : string
- String.substring(str, 1, String.size str - 1);
val it = "bcde" : string
- String.substring(str, 0, String.size str - 1);
val it = "abcd" : string
- String.substring(str, 1, String.size str - 2);
val it = "bcd" : string


let txt = "0123456789"
println(dropFirst(txt))
println(dropLast(txt))
println(dropFirst(dropLast(txt)))


puts [string range "knight" 1 end];       # strip first character
puts [string range "write" 0 end-1];        # strip last character
puts [string range "brooms" 1 end-1];       # strip both first and last characters


struct SubtractiveGenerator {
    /// m in the formula
    modulo: i32,
    /// i and j in the formula
    offsets: (u32, u32),
    /// r in the formula. It is used as a ring buffer.
    state: Vec<i32>,
    /// n in the formula
    position: usize,
}

impl SubtractiveGenerator {
    fn new(modulo: i32, first_offset: u32, second_offset: u32) -> Self {
        // The state size has to fit into a usize to index state properly
        // without overflow.
        let state_size: usize = first_offset.try_into().unwrap();

        // Both offsets have to fit in i32 for the substractions to work
        // without overflow.
        assert!(first_offset <= i32::MAX as u32);
        assert!(first_offset > second_offset);
        SubtractiveGenerator {
            modulo,
            offsets: (first_offset, second_offset),
            state: Vec::with_capacity(state_size),
            position: 0,
        }
    }
}

impl Iterator for SubtractiveGenerator {
    type Item = i32;

    fn next(&mut self) -> Option<<Self as Iterator>::Item> {
        let state_size = self.offsets.0 as usize;

        assert_eq!(self.state.len(), state_size);

        self.position = (self.position + 1) % self.offsets.0 as usize;

        let i1 = (self.position as i32 - self.offsets.0 as i32).rem_euclid(state_size as i32);
        let i2 = (self.position as i32 - self.offsets.1 as i32).rem_euclid(state_size as i32);

        let p1 = self.state[i1 as usize];
        let p2 = self.state[i2 as usize];

        self.state[self.position] = (p1 - p2).rem_euclid(self.modulo);

        Some(self.state[self.position])
    }
}

/// Returns a pre-seeded subtractive generator, which generates the same
/// sequences as Bentley's generator, as used in xpat2.
fn get_seeded_xpat2_gen(seed: i32) -> SubtractiveGenerator {
    let mut gen = SubtractiveGenerator::new(1_000_000_000, 55, 24);

    let state_size = gen.offsets.0 as usize;

    let mut pre_state = Vec::with_capacity(state_size);
    pre_state.push(seed);
    pre_state.push(1);
    for i in 2..state_size {
        pre_state.push((pre_state[i - 2] - pre_state[i - 1]).rem_euclid(gen.modulo));
    }

    for i in 0..state_size {
        gen.state.push(pre_state[(34 * (i + 1)) % 55]);
    }

    gen.position = 54;
    for _ in 0..165 {
        gen.next();
    }

    gen
}

fn main() {
    let gen = get_seeded_xpat2_gen(292929);

    for n in gen.take(5) {
        println!("{}", n);
    }
}


$ include "seed7_05.s7i";

const integer: MOD is 1000000000;

const type: subtractiveGenerator is new struct
    var array integer: state is [0 .. 54] times 0;
    var integer: si is 0;
    var integer: sj is 24;
  end struct;

const func integer: subrand (inout subtractiveGenerator: generator) is forward;

const func subtractiveGenerator: subrandSeed (in var integer: p1) is func
  result
    var subtractiveGenerator: generator is subtractiveGenerator.value;
  local
    var integer: p2 is 1;
    var integer: i is 0;
    var integer: j is 21;
  begin
    generator.state[0] := p1 mod MOD;
    for i range 1 to 54 do
      generator.state[j] := p2;
      p2 := (p1 - p2) mod MOD;
      p1 := generator.state[j];
      j := (j + 21) mod 55;
    end for;
    for i range 1 to 165 do
      ignore(subrand(generator));
    end for;
  end func;

const func integer: subrand (inout subtractiveGenerator: generator) is func
  result
    var integer: subrand is 0;
  begin
    if generator.si = generator.sj then
      generator := subrandSeed(0);
    end if;
    generator.si := pred(generator.si) mod 55;
    generator.sj := pred(generator.sj) mod 55;
    subrand := (generator.state[generator.si] - generator.state[generator.sj]) mod MOD;
    generator.state[generator.si] := subrand;
  end func;

const proc: main is func
  local
    var subtractiveGenerator: gen is subrandSeed(292929);
    var integer: i is 0;
  begin
    for i range 1 to 10 do
      writeln(subrand(gen));
    end for;
  end func;


class SubRandom(seed, state=[]) {

    const mod = 1_000_000_000;

    method init {
        var s = [seed % mod, 1];
        53.times {
            s.append((s[-2] - s[-1]) % mod);
        }
        state = s.range.map {|i| s[(34 + 34*i) % 55] };
        range(55, 219).each { self.subrand };
    }

    method subrand {
        var x = ((state.shift - state[-24]) % mod);
        state.append(x);
        return x;
    }
}

var r = SubRandom(292929);
10.times { say r.subrand };


package require Tcl 8.5
namespace eval subrand {
    variable mod 1000000000 state [lrepeat 55 0] si 0 sj 0

    proc seed p1 {
	global subrand::mod subrand::state subrand::si subrand::sj
	set p2 1
	lset state 0 [expr {$p1 % $mod}]
	for {set i 1; set j 21} {$i < 55} {incr i; incr j 21} {
	    if {$j >= 55} {incr j -55}
	    lset state $j $p2
	    if {[set p2 [expr {$p1 - $p2}]] < 0} {incr p2 $mod}
	    set p1 [lindex $state $j]
	}
	set si 0
	set sj 24
	for {set i 0} {$i < 165} {incr i} { gen }
    }

    proc gen {} {
	global subrand::mod subrand::state subrand::si subrand::sj
	if {$si == $sj} {seed 0}
	if {[incr si -1] < 0} {set si 54}
	if {[incr sj -1] < 0} {set sj 54}
	set x [expr {[lindex $state $si] - [lindex $state $sj]}]
	if {$x < 0} {incr x $mod}
	lset state $si $x
	return $x
    }
}

subrand::seed 292929
for {set i 0} {$i < 10} {incr i} {
    puts [subrand::gen]
}


 %string = "Moo";
 %string = getSubStr(%string, 1, strLen(%string) - 1);
 echo(%string);


$$ MODE TUSCRIPT
str="upraisers"
str1=EXTRACT (str,2,0)
str2=EXTRACT (str,0,-1)
str3=EXTRACT (str,2,-1)
PRINT str
PRINT str1
PRINT str2
PRINT str3


str='abcdefg'
echo "${str#?}"   # Remove first char
echo "${str%?}"   # Remove last char


// declare test string
string s = "Hello, world!";
// remove first letter
string s_first = s[1:s.length];
//remove last letter
string s_last = s[0:s.length - 1];
// remove first and last letters
string s_first_last = s[1:s.length - 1];


Function TopNTail(s,mode)
    Select Case mode
        Case "top"
            TopNTail = Mid(s,2,Len(s)-1)
        Case "tail"
            TopNTail = Mid(s,1,Len(s)-1)
        Case "both"
            TopNTail = Mid(s,2,Len(s)-2)
    End Select
End Function

WScript.Echo "Top: UPRAISERS = " & TopNTail("UPRAISERS","top")
WScript.Echo "Tail: UPRAISERS = " & TopNTail("UPRAISERS","tail")
WScript.Echo "Both: UPRAISERS = " & TopNTail("UPRAISERS","both")


var mod = 1e9
var state = List.filled(55, 0)
var si = 0
var sj = 0

var subrand // forward declaration

var subrandSeed = Fn.new { |p|
    var p2 = 1
    state[0] = p % mod
    var j = 21
    for (i in 1..54) {
        if (j >= 55) j = j - 55
        state[j] = p2
        p2 = p - p2
        if (p2 < 0) p2 = p2 + mod
        p = state[j]
        j = j + 21
    }
    si = 0
    sj = 24
    for (i in 1..165) subrand.call()
}

subrand = Fn.new {
    if (si == sj) subrandSeed.call(0)
    si = (si == 0) ? 54 : si - 1
    sj = (sj == 0) ? 54 : sj - 1
    var x = state[si] - state[sj]
    if (x < 0) x = x + mod
    state[si] = x
    return x
}

subrandSeed.call(292929)
for (i in 0..9) System.print("r[%(i+220)] = %(subrand.call())")


fcn rand_sub(x){
   var ring=L(),m=(1e9).toInt();
   mod:='wrap(n){ if(n<0) n+m else n };
   if(not ring){
      seed:=L( (if(vm.numArgs) x else m-1), 1);
      foreach n in ([2 .. 54]){ seed.append((seed[n-2]-seed[n-1]):mod(_)) }
      foreach n in (55){ ring.append(seed[(34*(n+1))%55]) }
      do(220-ring.len()){ self.fcn() } // 165
   }
   ring.append((ring.pop(0)-ring[-24]):mod(_));
   return(ring[-1]);
}


import "/str" for Str

var a = "Beyoncé"
var b = Str.delete(a, 0)
var len = a.codePoints.count
var c = Str.delete(a, len-1)
var d = Str.delete(c, 0)
for (e in [a, b, c, d]) System.print(e)


include c:\cxpl\stdlib;
char S, P;
[S:= "Smiles";
Text(0, S+1);           \first character removed
CrLf(0);
P:= S + StrLen(S) - 2;  \point to last character in string
P(0):= P(0) ! $80;      \set the MSb on the last character
Text(0, S);             \last character removed
CrLf(0);
Text(0, S+1);           \first and last characters removed
CrLf(0);
]


10 PRINT FN f$("knight"): REM strip the first letter. You can also write PRINT "knight"(2 TO)
20 PRINT FN l$("socks"): REM strip the last letter
30 PRINT FN b$("brooms"): REM strip both the first and last letter
100 STOP

9000 DEF FN f$(a$)=a$(2 TO LEN(a$))
9010 DEF FN l$(a$)=a$(1 TO LEN(a$)-(1 AND (LEN(a$)>=1)))
9020 DEF FN b$(a$)=FN l$(FN f$(a$))


V s = ‘abcdefgh’
V n = 2
V m = 3
V char = ‘d’
V chars = ‘cd’
print(s[n - 1 .+ m])          // starting from n=2 characters in and m=3 in length
print(s[n - 1 ..])            // starting from n characters in, up to the end of the string
print(s[0 .< (len)-1])        // whole string minus last character
print(s[s.index(char) .+ m])  // starting from a known character char="d" within the string and of m length
print(s[s.index(chars) .+ m]) // starting from a known substring chars="cd" within the string and of m length


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program subString64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessString:            .asciz "Result : "
szString1:               .asciz "abcdefghijklmnopqrstuvwxyz"
szStringStart:           .asciz "abcdefg"
szCarriageReturn:        .asciz "\n"
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
szSubString:             .skip 500             // buffer result

/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:

    ldr x0,qAdrszString1                        // address input string
    ldr x1,qAdrszSubString                      // address output string
    mov x2,22                                   // location
    mov x3,4                                    // length
    bl subStringNbChar                          // starting from n characters in and of m length
    ldr x0,qAdrszMessString                     // display message
    bl affichageMess
    ldr x0,qAdrszSubString                      // display substring result
    bl affichageMess
    ldr x0,qAdrszCarriageReturn                 // display line return
    bl affichageMess
    //
    ldr x0,qAdrszString1
    ldr x1,qAdrszSubString
    mov x2,15                                   // location
    bl subStringEnd                             //starting from n characters in, up to the end of the string
    ldr x0,qAdrszMessString                     // display message
    bl affichageMess
    ldr x0,qAdrszSubString
    bl affichageMess
    ldr x0,qAdrszCarriageReturn                 // display line return
    bl affichageMess
    //
    ldr x0,qAdrszString1
    ldr x1,qAdrszSubString
    bl subStringMinus                           // whole string minus last character
    ldr x0,qAdrszMessString                     // display message
    bl affichageMess
    ldr x0,qAdrszSubString
    bl affichageMess
    ldr x0,qAdrszCarriageReturn                 // display line return
    bl affichageMess
    //
    ldr x0,qAdrszString1
    ldr x1,qAdrszSubString
    mov x2,'c'                                  // start character
    mov x3,5                                    // length
    bl subStringStChar                          //starting from a known character within the string and of m length
    cmp x0,-1                                   // error ?
    beq 2f
    ldr x0,qAdrszMessString                     // display message
    bl affichageMess
    ldr x0,qAdrszSubString
    bl affichageMess
    ldr x0,qAdrszCarriageReturn                 // display line return
    bl affichageMess
    //
2:
    ldr x0,qAdrszString1
    ldr x1,qAdrszSubString
    ldr x2,qAdrszStringStart                    // sub string to start
    mov x3,10                                   // length
    bl subStringStString                        // starting from a known substring within the string and of m length
    cmp x0,-1                                   // error ?
    beq 3f
    ldr x0,qAdrszMessString                     // display message
    bl affichageMess
    ldr x0,qAdrszSubString
    bl affichageMess
    ldr x0,qAdrszCarriageReturn                 // display line return
    bl affichageMess
3:
100:                                            // standard end of the program
    mov x0,0                                    // return code
    mov x8,EXIT                                 // request to exit program
    svc 0                                       // perform system call
qAdrszMessString:         .quad szMessString
qAdrszString1:            .quad szString1
qAdrszSubString:          .quad szSubString
qAdrszStringStart:        .quad szStringStart
qAdrszCarriageReturn:     .quad szCarriageReturn
/******************************************************************/
/*     sub strings  index start  number of characters             */
/******************************************************************/
/* x0 contains the address of the input string */
/* x1 contains the address of the output string */
/* x2 contains the start index                  */
/* x3 contains numbers of characters to extract */
/* x0 returns number of characters or -1 if error */
subStringNbChar:
    stp x1,lr,[sp,-16]!            // save  registers
    mov x14,#0                     // counter byte output string
1:
    ldrb w15,[x0,x2]               // load byte string input
    cbz x15,2f                     // zero final ?
    strb w15,[x1,x14]              // store byte output string
    add x2,x2,1                    // increment counter
    add x14,x14,1
    cmp x14,x3                     // end ?
    blt 1b                         // no -> loop
2:
    strb wzr,[x1,x14]              // store final zero byte string 2
    mov x0,x14
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     sub strings  index start at end of string             */
/******************************************************************/
/* x0 contains the address of the input string */
/* x1 contains the address of the output string */
/* x2 contains the start index                  */
/* x0 returns number of characters or -1 if error */
subStringEnd:
    stp x2,lr,[sp,-16]!            // save  registers
    mov x14,0                      // counter byte output string
1:
    ldrb w15,[x0,x2]               // load byte string 1
    cbz x15,2f                     // zero final ?
    strb w15,[x1,x14]
    add x2,x2,1
    add x14,x14,1
    b 1b                           // loop
2:
    strb wzr,[x1,x14]              // store final zero byte string 2
    mov x0,x14
100:

    ldp x2,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*      whole string minus last character                        */
/******************************************************************/
/* x0 contains the address of the input string */
/* x1 contains the address of the output string */
/* x0 returns number of characters or -1 if error */
subStringMinus:
    stp x1,lr,[sp,-16]!            // save  registers
    mov x12,0                      // counter byte input string
    mov x14,0                      // counter byte output string
1:
    ldrb w15,[x0,x12]              // load byte string
    cbz x15,2f                     // zero final ?
    strb w15,[x1,x14]
    add x12,x12,1
    add x14,x14,1
    b 1b                           //  loop
2:
    sub x14,x14,1
    strb wzr,[x1,x14]              // store final zero byte string 2
    mov x0,x14
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*   starting from a known character within the string and of m length  */
/******************************************************************/
/* x0 contains the address of the input string */
/* x1 contains the address of the output string */
/* x2 contains the character    */
/* x3 contains the length
/* x0 returns number of characters or -1 if error */
subStringStChar:
    stp x1,lr,[sp,-16]!            // save  registers
    mov x16,0                      // counter byte input string
    mov x14,0                      // counter byte output string
1:
    ldrb w15,[x0,x16]              // load byte string
    cbz x15,4f                     // zero final ?
    cmp x15,x2                     // character find ?
    beq 2f                         // yes
    add x16,x16,1                  // no -> increment indice
    b 1b                           //  loop
2:
    strb w15,[x1,x14]
    add x16,x16,1
    add x14,x14,1
    cmp x14,x3
    bge 3f
    ldrb w15,[x0,x16]              // load byte string
    cbnz x15,2b                    // loop if no zero final
3:
    strb wzr,[x1,x14]              // store final zero byte string 2
    mov x0,x14
    b 100f
4:
    strb w15,[x1,x14]
    mov x0,#-1
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*   starting from a known substring within the string and of m length  */
/******************************************************************/
/* x0 contains the address of the input string */
/* x1 contains the address of the output string */
/* x2 contains the address of string to start    */
/* x3 contains the length
/* x0 returns number of characters or -1 if error */
subStringStString:
    stp x1,lr,[sp,-16]!            // save  registers
    stp x20,x21,[sp,-16]!          // save  registers
    mov x20,x0                     // save address
    mov x21,x1                     // save address output string
    mov x1,x2
    bl searchSubString
    cmp x0,-1                      // not found ?
    beq 100f
    mov x16,x0                     // counter byte input string
    mov x14,0
1:
    ldrb w15,[x20,x16]             // load byte string
    strb w15,[x21,x14]
    cmp x15,#0                     // zero final ?
    csel x0,x14,x0,eq
    beq 100f
    add x14,x14,1
    cmp x14,x3
    add x15,x16,1
    csel x16,x15,x16,lt
    blt 1b                         //  loop
    strb wzr,[x21,x14]
    mov x0,x14                     // return indice
100:
    ldp x20,x21,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*   search a substring in the string                            */
/******************************************************************/
/* x0 contains the address of the input string */
/* x1 contains the address of substring */
/* x0 returns index of substring in string or -1 if not found */
searchSubString:
    stp x1,lr,[sp,-16]!            // save  registers
    mov x12,0                      // counter byte input string
    mov x13,0                      // counter byte string
    mov x16,-1                     // index found
    ldrb w14,[x1,x13]
1:
    ldrb w15,[x0,x12]              // load byte string
    cbz x15,4f                     // zero final ?
    cmp x15,x14                    // compare character
    beq 2f
    mov x16,-1                     // no equals - > raz index
    mov x13,0                      // and raz counter byte
    add x12,x12,1                  // and increment counter byte
    b 1b                           // and loop
2:                                 // characters equals
    cmp x16,-1                     // first characters equals ?
    csel x16,x12,x16,eq
   // moveq x6,x2                  // yes -> index begin in x6
    add x13,x13,1                  // increment counter substring
    ldrb w14,[x1,x13]              // and load next byte
    cbz x14,3f                     // zero final ? yes -> end search
    add x12,x12,1                  // else increment counter string
    b 1b                           // and loop
3:
    mov x0,x16                     // return indice
    b 100f
4:
   mov x0,#-1                      // yes returns error
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


BYTE FUNC FindC(CHAR ARRAY text CHAR c)
  BYTE i

  i=1
  WHILE i<=text(0)
  DO
    IF text(i)=c THEN
      RETURN (i)
    FI
    i==+1
  OD
RETURN (0)

BYTE FUNC FindS(CHAR ARRAY text,sub)
  BYTE i,j,found

  i=1
  WHILE i<=text(0)-sub(0)+1
  DO
    found=0
    FOR j=1 TO sub(0)
    DO
      IF text(i+j-1)#sub(j) THEN
        found=0 EXIT
      ELSE
        found=1
      FI
    OD
    IF found THEN
      RETURN (i)
    FI
    i==+1
  OD
RETURN (0)

PROC Main()
  CHAR ARRAY text="qwertyuiop"
  CHAR ARRAY sub="tyu"
  CHAR ARRAY res(20)
  BYTE n,m
  CHAR c

  PrintF("Original string:%E  ""%S""%E%E",text)

  n=3 m=5
  SCopyS(res,text,n,n+m-1)
  PrintF("Substring start from %B and length %B:%E  ""%S""%E%E",n,m,res)

  n=4
  SCopyS(res,text,n,text(0))
  PrintF("Substring start from %B up to the end:%E  ""%S""%E%E",n,res)

  SCopyS(res,text,1,text(0)-1)
  PrintF("Whole string without the last char:%E  ""%S""%E%E",res)

  c='w m=4
  n=FindC(text,c)
  IF n=0 THEN
    PrintF("Character '%C' not found in string%E%E",c)
  ELSE
    SCopyS(res,text,n,n+m-1)
    PrintF("Substring start from '%C' and len %B:%E  ""%S""%E%E",c,m,res)
  FI

  n=FindS(text,sub)
  m=6
  IF n=0 THEN
    PrintF("String ""%S"" not found in string%E%E",sub)
  ELSE
    SCopyS(res,text,n,n+m-1)
    PrintF("Substring start from '%S' and len %B:  ""%S""%E%E",sub,m,res)
  FI
RETURN


type String is array (Positive range <>) of Character;


const str = "abcdefg"
var n = 2
var m = 3

println (str[n:n+m-1])    // pos 2 length 3
println (str[n:])           // pos 2 to end
println (str >> 1)      // remove last character
var p = find (str, 'c')
println (str[p:p+m-1])    // from pos of p length 3

var s = find (str, "bc")
println (str[s, s+m-1])    // pos of bc length 3


text s;
data b, d;

s = "The quick brown fox jumps over the lazy dog.";

o_text(cut(s, 4, 15));
o_newline();
o_text(cut(s, 4, length(s)));
o_newline();
o_text(delete(s, -1));
o_newline();
o_text(cut(s, index(s, 'q'), 5));
o_newline();

b_cast(b, s);
b_cast(d, "brown");
o_text(cut(s, b_find(b, d), 15));
o_newline();


main: (
  STRING s = "abcdefgh";
  INT n = 2, m = 3;
  CHAR char = "d";
  STRING chars = "cd";

  printf(($gl$, s[n:n+m-1]));
  printf(($gl$, s[n:]));
  printf(($gl$, s[:UPB s-1]));

  INT pos;
  char in string("d", pos, s);
  printf(($gl$, s[pos:pos+m-1]));
  string in string("de", pos, s);
  printf(($gl$, s[pos:pos+m-1]))
)


	;;;	---------------------------------------------------------------
	;;;	SUBLEQ for CP/M. The word size is 16 bits, and the program
	;;;	is given 16 Kwords (32 KB) of memory. (If the system doesn't
	;;;	have enough, the program will not run.)
	;;;	I/O is via the console; since it cannot normally be redirected,
	;;;	CR/LF translation is on by default. It can be turned off with
	;;;	the 'R' switch.
	;;;	---------------------------------------------------------------
	;;;	CP/M system calls
getch:	equ	1h
putch:	equ	2h
puts:	equ	9h
fopen:	equ	0Fh
fread:	equ	14h
	;;;	RAM locations
fcb1:	equ	5ch	; FCB 1 (automatically preloaded with 1st file name)
fcb2:	equ	6ch	; FCB 2 (we're abusing this one for the switch)
dma:	equ	80h	; default DMA is located at 80h
bdos:	equ	5h 	; CP/M entry point
memtop:	equ	6h	; First reserved memory address (below this is ours)
	;;;	Constants
CR:	equ	13	; CR and LF
LF:	equ	10
EOF:	equ	26	; EOF marker (as we don't have exact filesizes)
MSTART:	equ	2048	; Reserve 2K of memory for this program + the stack
MSIZE:	equ	32768	; Reserve 32K of memory (16Kwords) for the SUBLEQ code
PB:	equ	0C6h	; PUSH B opcode.
	org	100h
	;;;	-- Memory initialization --------------------------------------
	;;;	The fastest way to zero out a whole bunch of memory on the 8080
	;;;	is to push zeroes onto the stack. Since we need to do 32K,
	;;;	and it's slow already to begin with, let's do it that way.
	lxi	d,MSTART+MSIZE	; Top address we need
	lhld	memtop		; See if we even have enough memory
	call	cmp16		; Compare the two
	xchg			; Put top address in HL
	lxi	d,emem		; Memory error message
	jnc	die		; If there isn't enough memory, stop.
	sphl			; Set the stack pointer to the top of memory
	lxi	b,0 		; 2 zero bytes to push
	xra	a		; Zero out A.
	;;;	Each PUSH pushes 2 zeroes. 256 * 64 * 2 = 32768 zeroes.
	;;;	In the interests of "speedy" (ha!) execution, let's unroll this
	;;;	loop a bit. In the interest of the reader, let's not write out
	;;;	64 lines of "PUSH B". 'PB' is set to the opcode for PUSH B, and
	;;;	4*16=64. This costs some memory, but since we're basically
	;;;	assuming a baller >48K system anyway to run any non-trivial
	;;;	SUBLEQ code (ha!), we can spare the 64 bytes.
memini:	db	PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB
	db	PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB
	db	PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB
	db	PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB
	inr	a		; This will loop around 256 times
	jnz	memini
	push	b
	;;;	This conveniently leaves SP pointing just below SUBLEQ memory.
	;;;	-- Check the raw switch ---------------------------------------
	;;;	CP/M conveniently parses the command line for us, under the
	;;;	assumption that there are two whitespace-separated filenames,
	;;;	which are also automatically made uppercase.
	;;;	We only have to see if the second filename starts with 'R'.
	lda	fcb2+1 		; Filename starts at offset 1 in the FCB
	cpi	'R'		; Is it 'R'?
	jnz	readfl		; If not, go read the file (in FCB1).
	lxi	h,chiraw	; If so, rewrite the jumps to use the raw fns
	shld	chin+1
	lxi	h,choraw
	shld	chout+1
	;;;	-- Parse the input file ---------------------------------------
	;;;	The input file should consist of signed integers written in
	;;;	decimal, separated by whitespace. (For simplicity, we'll call
	;;;	all control characters whitespace). CP/M can only read files
	;;;	128 bytes at a time, so we'll process it 128 bytes at a time
	;;;	as well.
readfl:	lda	fcb1+1		; See if a file was given
	cpi	' '		; If not, the filename will be empty (spaces)
	lxi	d,eusage	; Print the usage string if that is the case
	jz	die
	mvi	c,fopen		; Otherwise, try to open the file.
	lxi	d,fcb1
	call	bdos
	inr	a		; FF is returned on error
	lxi	d,efile		; Print 'file error' and stop.
	jz	die
	;;;	Start parsing 16-bit numbers
	lxi	h,MSTART	; Start of SUBLEQ memory
	push	h		; Keep that on the stack
skipws:	call	fgetc		; Get character from file
	jc	rddone		; If EOF, we're done
	cpi	' '+1 		; Is it whitespace?
	jc	skipws		; Then get next character
rdnum:	lxi	h,0		; H = accumulator to store the number
	mov	b,h		; Set B if number should be negative.
	cpi	'-'		; Did we read a minus sign?
	jnz	rddgt		; If not, then this should be a digit.
	inr	b		; But if so, set B,
	call	fgetc		; and get the next character.
	jc	rddone
rddgt:	sui	'0'		; Make ASCII digit
	cpi	10 		; Which should now be less than 10
	jnc	fmterr		; Otherwise, print an error and stop
	mov	d,h		; Set HL=HL*10
	mov	e,l		; DE = HL
	dad	h		; HL *= 2
	dad	h		; HL *= 4
	dad	d 		; HL *= 5
	dad	h 		; HL *= 10
	mvi	d,0		; Add in the digit
	mov	e,a
	dad 	d
	call	fgetc		; Get next character
	jc	rdeof		; EOF while reading number
	cpi	' '+1 		; Is it whitespace?
	jnc	rddgt		; If not, then it should be the next digit
	xchg			; If so, write the number to SUBLEQ memory
	pop	h 		; Number in DE and pointer in HL
	call	wrnum		; Write the number
	push	h		; Put the pointer back
	jmp	skipws		; Then skip to next number and parse it
rdeof:	xchg			; EOF, but we still have a number to write
	pop	h		; Number in DE and pointer in HL
	call	wrnum		; Write the number
	push	h
rddone:	pop	h		; We're done, discard pointer
	;;;	-- Run the SUBLEQ code ----------------------------------------
	lxi	h,MSTART	; Initialize IP
	;;; 	At the start of step, HL = IP (in system memory)
step:	mov	e,m		; Load A into DE
	inx	h
	mov	d,m
	inx	h
	mov	c,m		; Load B into BC
	inx	h
	mov	b,m
	inx	h
	mov	a,e		; Check if A=-1
	ana	d
	inr	a
	jz 	sbin		; If so, read input
	mov	a,b		; Otherwise, check if B=-1
	ana	c
	inr	a
	jz	sbout		; If so, write output
	;;;	Perform the SUBLEQ instruction
	push	h		; Store the IP (-2) on the stack
	mov	a,d		; Obtain [A] (set DE=[DE])
	ani	3Fh		; Make sure address is in 16K words
	mov	d,a
	lxi	h,MSTART	; Add to start address twice
	dad	d		; (SUBLEQ addresses words, we're addressing
	dad 	d		; bytes)
	mov	e,m		; Load low byte
	inx	h
	mov	d,m		; Load high byte
	mov	a,b		; Obtain [B] (set BC=[BC])
	ani	3Fh		; This adress should also be in the 16K words
	mov	b,a
	lxi	h,MSTART	; Add to start address twice, again
	dad	b
	dad	b
	mov	c,m		; Load low byte
	inx	h
	mov	b,m		; Load high byte
	mov	a,c		; BC (B) -= DE (A)
	sub	e		; Subtract low bytes
	mov	c,a
	mov	a,b		; Subtract high bytes
	sbb	d
	mov	b,a
	mov	m,b		; HL is still pointing to the high byte of [B]
	dcx	h
	mov	m,c		; Store the low byte back too
	pop	h		; Restore IP
	ral			; Check sign bit of [B] (which is still in A)
	jc	sujmp		; If set, it's negative, and we need to jump
	rar
	ora	c		; If we're still here, it wasn't set. OR with
	jz	sujmp		; low bit, if zero then we also need to jump
	inx	h 		; We don't need to jump, so we should ignore C;
	inx 	h		; increment the IP to advance past it.
	jmp	step		; Next step
sujmp:	mov	c,m		; We do need to jump, load BC=C
	inx	h
	mov	a,m		; High byte into A
	ral			; See if it is negative
	jc	quit		; If so, stop
	rar
	ani	3Fh		; Don't jump outside the address space
	mov	b,a		; High byte into B
	lxi	h,MSTART	; Calculate new IP
	dad	b
	dad	b
	jmp	step		; Do next step
	;;;	Input: A=-1
sbin:	inx	h		; Advance IP past C
	inx	h
	xchg			; IP in DE
	mov	a,b		; Calculate address for BC (B)
	ani	3Fh
	mov	b,a
	lxi	h,MSTART
	dad	b
	dad	b
	call	chin		; Read character
	mov	m,a		; Store in low byte
	inx	h
	mvi	m,0 		; Store zero in high byte
	xchg			; IP back in HL
	jmp	step		; Next step
	;;;	Output: B=-1
sbout:	inx	h		; Advance IP past C
	inx	h
	xchg			; IP in DE and A in HL
	mov	a,h		; Calculate address for A
	ani	3Fh
	mov	h,a
	dad	h
	lxi	b,MSTART
	dad	b
	mov	a,m		; Retrieve low byte (character)
	call	chout		; Write character
	xchg			; IP back in HL
	jmp	step		; Next step
quit:	rst	0
	;;;	-- Write number to SUBLEQ memory ------------------------------
	;;;	Assuming: DE holds the number, B=1 if number should be negated,
	;;;	HL holds the pointer to SUBLEQ memory.
wrnum:	dcr	b		; Should the number be negated?
	jnz	wrpos		; If not, just write it
	dcx	d		; Otherwise, negate it: decrement,
	mov	a,e		; Then complement low byte,
	cma
	mov	e,a
	mov	a,d		; Then complement high byte
	cma
	mov	d,a		; And then write it
wrpos:	mov	m,e		; Write low byte
	inx	h		; Advance pointer
	mov	m,d		; Write high byte
	inx	h		; Advance pointer
	ret
	;;;	-- Read file byte by byte -------------------------------------
	;;;	The next byte from the file in FCB1 is returned in A, and all
	;;;	other registers are preserved. When 128 bytes have been read,
	;;;	the next record is loaded automatically. Carry set on EOF.
fgetc:	push	h		; Keep HL registers
	lda	fgptr		; Where are we in the record?
	ana	a
	jz	nxtrec		; If at 0 (rollover), load new record.
frecc:	mvi	h,0		; HL = A
	mov	l,a
	inr	a		; Next A
	sta	fgptr 		; Write A back
	mov	a,m		; Retrieve byte
	pop	h		; Restore HL registers
	cpi	EOF		; Is it EOF?
	rnz			; If not, we're done (ANA clears carry)
	stc			; But otherwise, set carry
	ret
nxtrec:	push	d		; Keep the other registers too
	push	b
	mvi	c,fread		; Read record from file
	lxi	d,fcb1
	call	bdos
	dcr	a		; A=1 on EOF
	jz	fgeof
	inr	a		; A<>0 = error
	lxi	d,efile
	jnz	die
	mvi	a,80h		; If we're still here, record read correctly
	sta	fgptr		; Set pointer back to beginning of DMA.
	pop	b		; Restore B and D
	pop	d
	jmp	frecc		; Get first character from the record.
fgeof:	stc			; On EOF (no more records), set carry
	jmp	resbdh		; And restore the registers
fgptr:	db 	0		; Pointer (80h-FFh) into DMA area. Reload on 0.
	;;;	-- Compare DE to HL -------------------------------------------
cmp16:	mov	a,d		; Compare high bytes
	cmp	h
	rnz			; If they are not equal, we know the ordering
	mov	a,e		; If they are equal, compare lower bytes
	cmp 	l
	ret
	;;;	-- Register-preserving I/O routines ---------------------------
chin:	jmp	chitr		; These are rewritten to jump to the raw I/O
chout:	jmp	chotr		; instructions to turn translation off.
	;;;	-- Read character into A with translation ---------------------
chitr:	call	chiraw		; Get raw character
	cpi	CR		; Is it CR?
	rnz			; If not, return character unchanged
	mvi	a,LF		; Otherwise, return LF (terminal sends only CR)
	ret
	;;;	-- Read character into A. -------------------------------------
chiraw:	push	h		; Save all registers except A
	push	d
	push	b
	mvi 	c,getch		; Get character from terminal
	call	bdos		; Character ends up in A
	jmp	resbdh		; Restore registers afterwards
	;;;	-- Write character in A to terminal with translation ----------
chotr:	cpi	LF		; Is it LF?
	jnz	choraw		; If not, just print it
	mvi	a,CR		; Otherwise, print a CR first,
	call	choraw
	mvi	a,LF		; And then a LF. (fall through)
	;;;	-- Write character in A to terminal ---------------------------
choraw:	push	h		; Store all registers
	push	d
	push	b
	push	psw
	mvi	c,putch		; Write character to terminal
	mov	e,a
	call	bdos
	;;;	-- Restore registers ------------------------------------------
restor:	pop	psw		; Restore all registers
resbdh:	pop	b		; Restore B D H
	pop	d
	pop	h
	ret
	;;;	-- Make parse error message and stop --------------------------
	;;;	A should hold the offending character _after_ '0' has already
	;;; 	been subtracted.
fmterr:	adi	'0'		; Undo subtraction of ASCII 0
	lxi	h,eiloc		; Write the characters in the error message
	mov	m,a
	inx	h
	mvi	b,4		; Max. 4 more characters
fmtelp:	call	fgetc		; Get next character
	jc	fmtdne		; If EOF, stop
	mov	m,a		; If not, store the character
	inx	h		; Advance pointer
	dcr	b		; Should we do more characters?
	jnz	fmtelp		; If so, go get another
fmtdne:	lxi	d,einv		; Print 'invalid integer' error message.
	;;;	-- Print an error message and stop ----------------------------
die:	mvi	c,puts
	call	bdos
	rst	0
	;;;	-- Error messages ---------------------------------------------
eusage:	db	'SUBLEQ <file> [R]: Run the SUBLEQ program in <file>.$'
efile:	db	'File error$'
emem:	db	'Memory error$'
einv:	db	'Invalid integer: '
eiloc:	db	'     $'


	;;;	-------------------------------------------------------------
	;;;	SUBLEQ interpreter that runs under MS-DOS.
	;;;	The word size is 16 bits, and the SUBLEQ program gets a 64KB
	;;;	(that is, 32K Subleq words) address space.
	;;;	The SUBLEQ program is read from a text file given on the
	;;;	command line, I/O is done via the console.
	;;;	Console I/O is normally raw, but with the /T parameter,
	;;;	line ending translation is done (CRLF <> LF).
	;;;	-------------------------------------------------------------
	bits	16
	cpu	8086
	;;;	MS-DOS system calls
getch:	equ	1h	; Get character
putch:	equ	2h	; Print character
puts:	equ	9h	; Print string
fopen:	equ	3Dh	; Open file
fclose:	equ	3Eh	; Close file
fread:	equ	3Fh	; Read from file
alloc:	equ	48h	; Allocate memory block
resize:	equ	4Ah	; Change size of memory block
exit:	equ	4Ch	; Exit to DOS
	;;;	Constants
RBUFSZ:	equ	1024	; 1K read buffer
CR:	equ	13	; CR and LF
LF:	equ	10
	;;;	RAM locations
cmdlen:	equ	80h	; Length of command line
cmdlin:	equ	81h	; Contents of command line
	org	100h
section	.text
	clc			; Make sure string instructions go forward
	;;;	-- Memory initialization ------------------------------------
	;;;	This is a .COM file. This means MS-DOS gives us all available
	;;;	memory starting at CS:0, and CS=DS=ES=SS. This means in order
	;;;	to allocate a separate 64k segment for the SUBLEQ memory
	;;;	space, we will first need to free all memory we're not using.
	;;;	-------------------------------------------------------------
memini:	mov	sp,memtop	; Point SP into memory we will be keeping
	mov	dx,emem		; Set up a pointer to the memory error msg
	mov	ah,resize	; Reallocate current block
	mov	bx,sp		; Size is in paragraphs (16 bytes), and the
	mov	cl,4		; assembler will not let me shift a label at
	shr	bx,cl		; compile time, so we'll do it at runtime.
	inc	bx		; BX=(memtop>>4)+1; memtop in last paragraph.
	int	21h
	jnc	.alloc		; Carry not set = allocate memory
	jmp	die		; Otherwise, error (jump > 128 bytes)
	;;;	Allocate a 64K block for the SUBLEQ program's address space
.alloc:	mov	ah,alloc	; Allocate 64K (4096 paragraphs) for the
	mov	bx,4096		; SUBLEQ program. Because that is the size of
	int	21h		; an 8086 segment, we get free wraparound,
	jnc	.zero		; and we don't have to worry about bounds
	jmp	die		; checking.
	;;;	Zero out the memory we're given
.zero:	push	ax		; Keep SUBLEQ segment on stack.
	mov	es,ax		; Let ES point into our SUBLEQ segment.
	mov	cx,32768	; 32K words = 64K bytes to set to zero.
	xor	ax,ax		; We don't have to care about where DI is,
	rep	stosw		; since we're doing all of ES anyway.
	;;;	-- Parse the command line and open the file -----------------
	;;;	A filename should be given on the command line, which should
	;;;	be a text file containing (possibly negative) integers
	;;;	written in base 10. For "efficiency", we read the file 1K
	;;;	at a time into a buffer, rather than character by character.
	;;;	We also handle the '/T' parameter here.
	;;;	-------------------------------------------------------------
rfile:	mov	dx,usage	; Print 'usage' message if no argument
	mov	di,cmdlin	; 0-terminate command line for use with fopen
	xor	bh,bh		; We'll use BX to index into the command line
	mov	bl,[cmdlen]	; Length of command line
	test	bl,bl		; If it's zero, no argument was given
	jnz	.term		; If not zero, go ahead
	jmp 	die		; Otherwise, error (again, jump > 128 bytes)
.term:	mov	[di+bx],bh	; Otherwise, 0-terminate
	mov	ax,ds		; Let ES point into our data segment
	mov	es,ax		; (in order to use SCASB).
.skp:	mov	al,' '		; Skip any preceding spaces
	mov	cx,128		; Max. command line length
	repe	scasb
	dec	di		; As usual, SCASB goes one byte too far
	mov	al,[di]		; If we're at zero now, we don't have an
	test	al,al		; argument either, so same error.
	jnz	.parm		; (Again, jump > 128 bytes)
	jmp	die
.parm	cmp	al,'/'		; Input parameter?
	jne	.open		; If not, this is the filename, open it
	inc	di		; If so, is it 'T' or 't'?
	mov	al,[di]
	inc	di		; Skip past it
	mov	dl,[di]		; And is the next one a space again?
	cmp	dl,' '
	je	.testp		; If so, it's potentially valid
.perr:	mov	dx,eparm	; If not, print error message
	jmp	die
.testp:	or	al,32		; Make lowercase
	cmp	al,'t'		; 'T'?
	jne	.perr		; If not, print error message
	inc	byte [trans]	; If so, turn translation on
	jmp	.skp		; And then get the filename
.open:	mov	ax,fopen<<8	; Open file for reading (AL=0=O_RDONLY)
	mov	dx,di		; 0-terminated path on the command line
	int	21h
	jnc	.read		; Carry not set = file opened
	mov	dx,efile	; Otherwise, file error (we don't much care
	jmp	die		; which one, that's too much work.)
.read:	pop	es 		; Let ES be the SUBLEQ segment (which we
	xor	di,di		; pushed earlier), and DI point to 1st word.
	mov	bp,ax		; Keep the file handle in BP.
	xor	cx,cx		; We have read no bytes yet.
	;;;	-- Read and parse the file ----------------------------------
	;;;	We need to read 16-bit signed integers from the file,
	;;;	in decimal. The integers are separated by whitespace, which
	;;;	for simplicity's sake we'll say is ASCII space and _all_
	;;;	control characters. BP, CX and SI are used as state to
	;;;	emulate character-based I/O, and so must be preserved;
	;;;	furthermore, DI is used as a pointer into the SUBLEQ memory.
	;;;	-------------------------------------------------------------
skipws:	call	fgetc		; Get next character
	jc	fdone		; If we get EOF, we're done.
	cmp	al,' '		; Is it whitespace? (0 upto ' ' inclusive)
	jbe	skipws		; Then keep skipping
rdnum:	xor	dl,dl		; DL is set if number is negative
	xor	bx,bx		; BX will keep the number
	cmp	al,'-'		; Is first character a '-'?
	jne	.dgt		; If not, it's positive
	inc	dx		; Otherwise, set DL,
	call	fgetc		; and get next character.
	jc	fdone
.dgt:	mov	dh,al		; Store character in DH
	sub	dh,'0'		; Subtract '0'
	cmp	dh,9		; Digit is [0..9]?
	jbe	.dgtok		; Then it is OK
	jmp	fmterr		; Otherwise, format error (jump > 128)
.dgtok:	mov	ax,bx		; BX *= 10 (without using MUL or SHL BX,CL;
	shl	bx,1		; since we can't spare the registers).
	shl	bx,1
	add	bx,ax
	shl 	bx,1
	mov	al,dh		; Load digit into AL
	cbw			; Sign extend (in practice just sets AH=0)
	add	bx,ax		; Add it into BX
	call	fgetc		; Get next character
	jc	dgteof		; EOF while reading num is special
	cmp	al,' '		; If it isn't whitespace,
	ja	.dgt		; then it's the next digit.
	test	dl,dl		; Otherwise, number is done. Was it negative?
	jz 	.wrnum		; If not, write it to SUBLEQ memory
	neg	bx		; Otherwise, negate it
.wrnum:	mov	ax,bx		; ...and _then_ write it.
	stosw
	jmp	skipws		; Skip any other wspace and get next number
dgteof:	test	dl,dl		; If we reached EOF while reading a number,
	jz	.wrnum		; we need to do the same conditional negation
	neg	bx		; and write out the number that was still in
.wrnum:	mov	ax,bx		; BX.
	stosw
fdone:	mov	ah,fclose	; When we're done, close the file.
	mov	bx,bp		; (Not strictly necessary since we've only
	int	21h		; read, so we don't care about errors.)
	;;;	-- Run the SUBLEQ code --------------------------------------
	;;;	SI = instruction pointer. An instruction A B C is loaded into
	;;;	BX DI AX respectively. Note that SUBLEQ addresses words,
	;;;	whereas the 8086 addresses bytes, so the addresses all need
	;;;	to be shifted left once before being used.
	;;;	-------------------------------------------------------------
subleq:	xor	si,si		; Start with IP=0
	mov	cl,[trans]	; CL = \r\n translation on or off
	mov	ax,es		; Set DS=ES=SUBLEQ segment
	mov	ds,ax
	;;;	Load instruction
.step:	lodsw			; Load A
	mov	bx,ax		; BP = A
	lodsw			; Load B
	mov	di,ax		; DI = B
	lodsw			; Load C (AX=C)
	;;;	Check for special cases
	inc	bx		; BX=-1 = read byte
	jz	.in		; If ++BP==0, then read character
	dec	bx		; Restore BX
	inc	di		; If ++DI==0, then write character
	jz	.out
	dec	di		; Restore DI
	;;;	Do the SUBLEQ instruction
	shl	di,1		; Addresses must be doubled since SUBLEQ
	shl	bx,1		; addresses words and we're addressing bytes
	mov	dx,[di]		; Retrieve [B]
	sub	dx,[bx]		; DX = [B] - [A]
	mov	[di],dx		; [B] = DX
	jg	.step		; If [B]>[A], (i.e. [B]-[A]>=0), do next step
	shl	ax,1		; Otherwise, AX*2 (C) becomes the new IP
	mov	si,ax
	jnc	.step		; If high bit was 0, next step
	mov	ax,exit<<8	; But otherwise, it was negative, so we stop
	int	21h
	;;;	Read a character from standard input
.in:	mov	ah,getch	; Input: read character into AL
	int	21h
	cmp	al,CR		; Is it CR?
	je	.crin		; If not, just store the character
.sto:	xor	ah,ah		; Character goes in low byte of word
	shl	di,1		; Word address to byte address
	mov	[di],ax		; Store character in memory at B
	jmp	.step		; And do next step
	;;;	Pressing enter only returns CR; not CR LF on two reads,
	;;;	therefore on CR we give LF instead when translation is on.
.crin:	test	cl,cl		; Do we even want translation?
	jz	.sto		; If not, just store the CR and leave it
	mov	al,LF		; But if so, use LF instead
	jmp	.sto
	;;;	Write a character to standard output
.out: 	shl	bx,1		; Load character from [A]
	mov	dl,[bx]		; We only need the low byte
	mov 	ah,putch	; Set AH to print the character
	cmp	dl,LF		; Is it LF?
	je	.lfo		; Then handle it separately
.wr:	int	21h
	jmp	.step		; Do next step
	;;;	LF needs to be translated into CR LF, so we need to print the
	;;;	CR first and then the LF, if translation is on.
.lfo:	test	cl,cl		; Do we even want translation?
	jz	.wr		; If not, just print the LF
	mov	dl,CR		; If so, print a CL first
	int	21h
	mov	dl,LF		; And then a LF
	jmp	.wr
	;;;	-- Subroutine: get byte from file buffer. --------------------
	;;;	If the buffer is empty, fill with more bytes from file.
	;;;	On EOF, return with carry set.
	;;;	Input:  BP = file handle, CX = bytes left in buffer,
	;;;	        SI = current pointer into buffer.
	;;;	Output: AL = byte, CX and SI moved, other registers preserved
	;;;	-------------------------------------------------------------
fgetc:	test	cx,cx		; Bytes left?
	jz	.read		; If not, read from file
.buf:	lodsb			; Otherwise, get byte from buffer
	dec	cx		; One fewer byte left
	ret			; And we're done. (TEST clears carry, LODSB
				; and DEC don't touch it, so it's clear.)
.read:	push	ax		; Keep AX, BX, DX
	push	bx
	push	dx
	mov	ah,fread	; Read from file,
	mov	bx,bp		; BP = file handle,
	mov	cx,RBUFSZ	; Fill up entire buffer if possible,
	mov	dx,fbuf		; Starting at the start of buffer,
	mov	si,dx		; Also start returning bytes from there.
	int	21h
	jc	.err		; Carry set = read error
	mov	cx,ax		; CX = amount of bytes read
	pop	dx		; Restore AX, BX, DX
	pop	bx
	pop 	ax
	test	cx,cx		; If CX not zero, we now have data in buffer
	jnz	.buf		; So get first byte from buffer
	stc			; But if not, EOF, so set carry and return
	ret
.err:	mov	dx,efile	; On error, print the file error message
	jmp	die		; and stop
	;;;	Parse error (invalid digit) ---------------------------------
	;;;	Invalid character is in AL. BP, CX, SI still set to read from
	;;;	file.
fmterr:	mov	dx,ds		; Set ES=DS
	mov	es,dx
	mov	dl,5		; Max. 5 characters
	mov	di,eparse.dat	; DI = empty space in error message
.wrch:	stosb			; Store character in error message
	call	fgetc		; Get next character
	jc	.done		; No more chars = stop
	dec	dl		; If room left,
	jnz	.wrch		; write next character
.done:	mov	dx,eparse	; Use error message with offender written in
				; And fall through to stop the program
	;;;	Print the error message in [DS:DX] and terminate with
	;;;	errorlevel 2.
die:	mov	ah,puts
	int	21h
	mov	ax,exit<<8 | 2
	int	21h
section	.data
usage:	db	'SUBLEQ [/T] <file> - Run the SUBLEQ program in <file>.$'
efile:	db	'Error reading file.$'
eparm:	db	'Invalid parameter.$'
emem:	db	'Memory allocation failure.$'
eparse:	db	'Invalid integer at: '
.dat:	db	'     $'	; Spaces to be filled in by error routine
trans:	db	0	; Will be set if CRLF translation is on
section	.bss
fbuf:	resb	RBUFSZ	; File buffer
stack:	resw	128	; 128 words for main stack (should be enough)
memtop:	equ	$


String x = 'testing123';
//Test1: testing123
System.debug('Test1: ' + x.substring(0,x.length()));
//Test2: esting123
System.debug('Test2: ' + x.substring(1,x.length()));
//Test3: testing123
System.debug('Test3: ' + x.substring(0));
//Test4: 3
System.debug('Test4: ' + x.substring(x.length()-1));
//Test5:
System.debug('Test5: ' + x.substring(1,1));
//Test 6: testing123
System.debug('Test6: ' + x.substring(x.indexOf('testing')));
//Test7: e
System.debug('Test7: ' + x.substring(1,2));


-- SUBSTRINGS -----------------------------------------------------------------

--  take :: Int -> Text -> Text
on take(n, s)
    text 1 thru n of s
end take

--  drop :: Int -> Text -> Text
on drop(n, s)
    text (n + 1) thru -1 of s
end drop

-- breakOn :: Text -> Text -> (Text, Text)
on breakOn(strPattern, s)
    set {dlm, my text item delimiters} to {my text item delimiters, strPattern}
    set lstParts to text items of s
    set my text item delimiters to dlm
    {item 1 of lstParts, strPattern & (item 2 of lstParts)}
end breakOn

--  init :: Text -> Text
on init(s)
    if length of s > 0 then
        text 1 thru -2 of s
    else
        missing value
    end if
end init

-- TEST -----------------------------------------------------------------------
on run
    set str to "一二三四五六七八九十"

    set legends to {¬
        "from n in, of n length", ¬
        "from n in, up to end", ¬
        "all but last", ¬
        "from matching char, of m length", ¬
        "from matching string, of m length"}

    set parts to {¬
        take(3, drop(4, str)), ¬
        drop(3, str), ¬
        init(str), ¬
        take(3, item 2 of breakOn("五", str)), ¬
        take(4, item 2 of breakOn("六七", str))}

    script tabulate
        property strPad : "                                        "

        on |λ|(l, r)
            l & drop(length of l, strPad) & r
        end |λ|
    end script

    linefeed & intercalate(linefeed, ¬
        zipWith(tabulate, ¬
            legends, parts)) & linefeed
end run

-- GENERIC FUNCTIONS FOR TEST -------------------------------------------------

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
    set {dlm, my text item delimiters} to {my text item delimiters, strText}
    set strJoined to lstText as text
    set my text item delimiters to dlm
    return strJoined
end intercalate

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(length of xs, length of ys)
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, item i of ys)
        end repeat
        return lst
    end tell
end zipWith


with Ada.Text_IO;

procedure Subleq is

   Storage_Size: constant Positive := 2**8; -- increase or decrease memory
   Steps: Natural := 999; -- "emergency exit" to stop endless loops

   subtype Address is Integer range -1 .. (Storage_Size-1);
   subtype Memory_Location is Address range 0 .. Address'Last;

   type Storage is array(Memory_Location) of Integer;

   package TIO renames Ada.Text_IO;
   package IIO is new TIO.Integer_IO(Integer);

   procedure Read_Program(Mem: out Storage) is
      Idx: Memory_Location := 0;
   begin
      while not TIO.End_Of_Line loop
	 IIO.Get(Mem(Idx));
 	 Idx := Idx + 1;
      end loop;
   exception
      when others => TIO.Put_Line("Reading program: Something went wrong!");
   end Read_Program;

   procedure Execute_Program(Mem: in out Storage) is
      PC: Integer := 0; -- program counter
      function Source return Integer is (Mem(PC));
      function Dest return Integer is (Mem(PC+1));
      function Branch return Integer is (Mem(PC+2));
      function Next return Integer is (PC+3);
   begin
      while PC >= 0 and Steps >= 0 loop
	 Steps := Steps -1;
	 if Source = -1 then -- read input
            declare
               Char: Character;
            begin
               TIO.Get (Char);
               Mem(Dest) := Character'Pos (Char);
            end;
	    PC := Next;
	 elsif Dest = -1 then -- write output
	    TIO.Put(Character'Val(Mem(Source)));
	    PC := Next;
	 else -- subtract and branch if less or equal
	    Mem(Dest) := Mem(Dest) - Mem(Source);
	    if Mem(Dest) <= 0 then
	       PC := Branch;
	    else
	       PC := Next;
	    end if;
	 end if;
      end loop;
      TIO.Put_Line(if PC >= 0 then "Emergency exit: program stopped!" else "");
    exception
      when others => TIO.Put_Line("Failure when executing Program");
   end Execute_Program;

   Memory: Storage := (others => 0); -- no initial "junk" in memory!

begin

   Read_Program(Memory);
   Execute_Program(Memory);

end Subleq;


# Subleq program interpreter                                                 #
# executes the program specified in code, stops when the instruction pointer #
# becomes negative                                                           #
PROC run subleq = ( []INT code )VOID:
     BEGIN
        INT   max memory = 3 * 1024;
        [ 0 : max memory - 1 ]INT memory;
        # load the program into memory                                       #
        # a slice yields a row with LWB 1...                                 #
        memory[ 0 : UPB code - LWB code ] := code[ AT 1 ];
        # start at instruction 0                                             #
        INT   ip := 0;
        # execute the instructions until ip is < 0                           #
        WHILE ip >= 0 DO
            # get three words at ip and advance ip past them                 #
            INT a := memory[ ip     ];
            INT b := memory[ ip + 1 ];
            INT c := memory[ ip + 2 ];
            ip +:= 3;
            # execute according to a, b and c                                #
            IF   a = -1 THEN
                # input a character to b                                     #
                CHAR input;
                get( stand in, ( input ) );
                memory[ b ] := ABS input
            ELIF b = -1 THEN
                # output character from a                                    #
                print( ( REPR memory[ a ] ) )
            ELSE
                # subtract and branch if le 0                                #
                memory[ b ] -:= memory[ a ];
                IF memory[ b ] <= 0 THEN
                    ip := c
                FI
            FI
        OD
     END # run subleq # ;

# test the interpreter with the hello-world program specified in the task    #
run subleq( (  15,  17,  -1,  17,  -1,  -1
            ,  16,   1,  -1,  16,   3,  -1
            ,  15,  15,   0,   0,  -1,  72
            , 101, 108, 108, 111,  44,  32
            , 119, 111, 114, 108, 100,  33
            ,  10,   0
            )
          )