home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / amiga / programm / language / bcpl4ami.lzh / bcpl / bpl / blib.bpl next >
Encoding:
BCPL source  |  1988-03-25  |  2.8 KB  |  125 lines
  1. //  LIBHDR
  2. GLOBAL $(
  3. START:1
  4. SELECTINPUT:11; SELECTOUTPUT:12
  5. RDCH:13; WRCH:14
  6. STOP:30
  7. LEVEL:31; LONGJUMP:32
  8. REWIND:35; APTOVEC:40
  9. FINDOUTPUT:41; FINDINPUT:42
  10. ENDREAD:46; ENDWRITE:47
  11. WRITES:60; WRITEN:62; NEWLINE:63; NEWPAGE:64
  12. PACKSTRING:66; UNPACKSTRING:67; WRITED:68
  13. WRITEARG:69; READN:70; TERMINATOR:71
  14. WRITEHEX:75; WRITEF:76; WRITEOCT:77
  15. MAPSTORE:78
  16. GETBYTE:85; PUTBYTE:86
  17. $)
  18.  
  19.  
  20. MANIFEST $(
  21. ENDSTREAMCH=-1; BYTESPERWORD=2
  22. $)
  23.  
  24.  
  25. .
  26.  
  27.  
  28. //   BLIB
  29.  
  30.  
  31. GET "LIBHDR"
  32.  
  33. LET WRITES(S) BE  FOR I = 1 TO GETBYTE(S, 0) DO WRCH(GETBYTE(S, I))
  34.  
  35. AND UNPACKSTRING(S, V) BE
  36.          FOR I = 0 TO GETBYTE(S, 0) DO V]I := GETBYTE(S, I)
  37.  
  38. AND PACKSTRING(V, S) = VALOF
  39.     $( LET N = V]0 & 255
  40.        LET I = N/2
  41.        FOR P = 0 TO N DO PUTBYTE(S, P, V]P)
  42.        IF (N&1)=0 DO PUTBYTE(S, N+1, 0)
  43.        RESULTIS I  $)
  44.  
  45. // THE DEFINITIONS THAT FOLLOW ARE MACHINE INDEPENDENT
  46.  
  47. AND WRITED(N, D) BE
  48.  
  49. $(1 LET T = VEC 20
  50.     AND I, K = 0, N
  51.     IF N<0 DO D, K := D-1, -N
  52.     T]I, K, I := K REM 10, K/10, I+1 REPEATUNTIL K=0
  53.     FOR J = I+1 TO D DO WRCH('*S')
  54.     IF N<0 DO WRCH('-')
  55.     FOR J = I-1 TO 0 BY -1 DO WRCH(T]J+'0')  $)1
  56.  
  57. AND WRITEN(N) BE WRITED(N, 0)
  58.  
  59.  
  60. AND NEWLINE() BE WRCH('*N')
  61.  
  62. AND READN() = VALOF
  63.  
  64. $(1 LET SUM = 0
  65.     AND NEG = FALSE
  66.  
  67. L: TERMINATOR := RDCH()
  68.     SWITCHON TERMINATOR INTO
  69.     $(  CASE '*S':
  70.         CASE '*T':
  71.         CASE '*N':    GOTO L
  72.  
  73.         CASE '-':     NEG := TRUE
  74.         CASE '+':     TERMINATOR := RDCH()   $)
  75.     WHILE '0'<=TERMINATOR<='9' DO
  76.                  $( SUM := 10*SUM + TERMINATOR - '0'
  77.                     TERMINATOR := RDCH()  $)
  78.     IF NEG DO SUM := -SUM
  79.     RESULTIS SUM   $)1
  80.  
  81. AND WRITEOCT(N, D) BE
  82.     $( IF D>1 DO WRITEOCT(N>>3, D-1)
  83.        WRCH((N/▓7)+'0')  $)
  84.  
  85. AND WRITEHEX(N, D) BE
  86.     $( IF D>1 DO WRITEHEX(N>>4, D-1)
  87.        WRCH((N&15)]TABLE
  88.             '0','1','2','3','4','5','6','7',
  89.             '8','9','A','B','C','D','E','F')  $)
  90.  
  91.  
  92. AND WRITEF(FORMAT, A, B, C, D, E, F, G, H, I, J, K) BE
  93.  
  94. $(1 LET T = @A
  95.  
  96.     FOR P = 1 TO GETBYTE(FORMAT, 0) DO
  97.     $(2 LET K = GETBYTE(FORMAT, P)
  98.  
  99.         TEST K='%'
  100.  
  101.           THEN $(3 LET F, Q, N = 0, T]0, 0
  102.                    AND TYPE = GETBYTE(FORMAT, P+1)
  103.                    P := P + 1
  104.                    SWITCHON TYPE INTO
  105.                 $( DEFAULT: WRCH(TYPE); ENDCASE
  106.  
  107.                    CASE 'S': F := WRITES; GOTO L
  108.                    CASE 'C': F := WRCH; GOTO L
  109.                    CASE 'O': F := WRITEOCT; GOTO M
  110.                    CASE 'X': F := WRITEHEX; GOTO M
  111.                    CASE 'I': F := WRITED; GOTO M
  112.                    CASE 'N': F := WRITED; GOTO L
  113.  
  114.                 M: P := P + 1
  115.                    N := GETBYTE(FORMAT, P)
  116.                    N := '0'<=N<='9' -> N-'0', N-'A'+10
  117.  
  118.                 L: F(Q, N); T := T + 1  $)3
  119.  
  120.             OR WRCH(K)  $)2  $)1
  121.  
  122.  
  123. AND MAPSTORE() BE WRITES("*NMAPSTORE NOT IMPLEMENTED*N")
  124.  
  125.