LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031988. :SYSTEM-TYPE :LOGICAL :VERSION 5. :TYPE "LISP" :NAME "SERIAL-BUFFER" :DIRECTORY ("REL3-SOURCE" "SERIAL") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758811950. :AUTHOR "REL3" :LENGTH-IN-BYTES 4978. :LENGTH-IN-BLOCKS 5. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ;;; -*- Mode:common-lisp; base:10; package:si -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;; Copyright (C) 1984,1987 Texas Instruments Incorporated. All rights reserved.;;; Routines for mainipulating Serial Buffers.;;; Uses the special macro array-dpb-offset.;; Construct buffers in SERIAL area.  It is static, so gc won't copy.(DEFRESOURCE SERIAL-BUFFER (SIZE) :CONSTRUCTOR   (MAKE-ARRAY (* SIZE 2) :element-TYPE '(unsigned-byte 16) :AREA 'SERIAL) :MATCHER   (>= (ARRAY-DIMENSION OBJECT 0) (* 2 SIZE));2.1 fix to help stabilize the system and prevent   :INITIALIZER (ARRAY-INITIALIZE OBJECT 0);  system crashes when a large number of request is handled.   ) (DEFUN GET-SERIAL-BUFFER (SIZE)  "Allocate a Serial data buffer.  Buffer-Size is size in words."  (LET ((BUFFER (ALLOCATE-RESOURCE 'SERIAL-BUFFER SIZE)))    (WIRE-ARRAY BUFFER);wire it before hacking at the contents & headers    (INITIALIZE-SERIAL-BUFFER BUFFER))) (DEFUN INITIALIZE-SERIAL-BUFFER (BUFFER)  "Initialize starting, ending, and current position pointers in a serial buffer"  (LET ((START-ADDRESS (+ (%POINTER BUFFER) (LENGTH SERIAL-BUFFER-HEADER)    (1+ (%P-LDB %%ARRAY-LONG-LENGTH-FLAG BUFFER))));; end address is actually one beyond the end of the buffer(END-ADDRESS (+ (%POINTER BUFFER) (LDB (BYTE 24 1) (ARRAY-TOTAL-SIZE BUFFER));convert from half to full word count    (1+ (%P-LDB %%ARRAY-LONG-LENGTH-FLAG BUFFER)))))    (ARRAY-DPB-OFFSET START-ADDRESS %%Q-POINTER BUFFER %SERIAL-BUFFER-START)    (ARRAY-DPB-OFFSET END-ADDRESS %%Q-POINTER BUFFER %SERIAL-BUFFER-END)    (ARRAY-DPB-OFFSET START-ADDRESS %%Q-POINTER BUFFER %SERIAL-BUFFER-IN-POINTER)    (ARRAY-DPB-OFFSET START-ADDRESS %%Q-POINTER BUFFER %SERIAL-BUFFER-OUT-POINTER)    BUFFER)) (DEFUN RETURN-SERIAL-BUFFER (BUFFER)  (UNWIRE-ARRAY BUFFER)  (DEALLOCATE-RESOURCE 'SERIAL-BUFFER BUFFER)) (DEFUN READ-SERIAL-BUFFER (BUFFER)  (COND    ((SERIAL-BUFFER-NOT-EMPTY-P BUFFER)     (LET* ((OUT-PTR (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-OUT-POINTER))    (DATA (%P-LDB #o10 OUT-PTR))    (STATUS (%P-LDB #o1003 OUT-PTR)))       (AND(= (SETQ OUT-PTR (1+ OUT-PTR)) (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-END))(SETQ OUT-PTR (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-START)))       (ARRAY-DPB-OFFSET OUT-PTR %%Q-POINTER BUFFER %SERIAL-BUFFER-OUT-POINTER)       (VALUES DATA STATUS)))    (T (VALUES () 0)))) (DEFUN WRITE-SERIAL-BUFFER (BUFFER CHAR)  (COND    ((SERIAL-BUFFER-NOT-FULL-P BUFFER)     (LET ((IN-PTR (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-IN-POINTER)))       (%P-DPB CHAR %%Q-POINTER IN-PTR)       (AND(= (SETQ IN-PTR (1+ IN-PTR)) (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-END))(SETQ IN-PTR (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-START)))       (ARRAY-DPB-OFFSET IN-PTR %%Q-POINTER BUFFER %SERIAL-BUFFER-IN-POINTER))))) (DEFUN SERIAL-BUFFER-NOT-EMPTY-P (BUFFER)  (AND BUFFER;if no buffer - it is obviously empty     (NEQ (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-IN-POINTER)  (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-OUT-POINTER))))   #|(DEFUN SERIAL-BUFFER-NOT-FULL-P (BUFFER &OPTIONAL BUFFER-SIZE-LIMIT)  "T if there is room for more input or output in serial buffer BUFFER."  (LET ((BUFFER-SIZE (- (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-END)    (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-START))))    (<     (GCD      (+       (- (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-IN-POINTER)  (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-OUT-POINTER))       BUFFER-SIZE)      BUFFER-SIZE)     (OR BUFFER-SIZE-LIMIT (1- BUFFER-SIZE))))) |#(DEFUN SERIAL-BUFFER-NOT-FULL-P (BUFFER)  "T if there is room for more input or output in serial buffer BUFFER."  ;; Measure distance between pointers.  If in-pointer is more than one  ;; word behind out-pointer (accounting for wrap-around in the buffer),  ;;  then there is room.  (AND BUFFER;if no buffer -- then it must be full     (LET ((DISTANCE    (- (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-OUT-POINTER)       (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-IN-POINTER) 1)))   ;; adjust if pointers have wrapped around       (IF (MINUSP DISTANCE) (SETQ DISTANCE       (+ DISTANCE  (- (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-END)     (ARRAY-LDB-OFFSET %%Q-POINTER BUFFER %SERIAL-BUFFER-START)))))       ;; now check the absolute difference       (COND ((PLUSP DISTANCE) T) (T NIL))))) DB (BYTE 1 1) STAT))      (FORMAT T " PAPER OUT"))    (IF (= 1 (LDB (BYTE 1 2) STAT))      (FORMAT T " ONLINE"))    (IF (= 0 (LDB (BYTE 1 