Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/check/check.mac
There are 4 other files named check.mac in the archive. Click here to see a list.
TITLE CHECK
SUBTTL WMU LIBRARY PROGRAM
;PROGRAM TO VERIFY DATA FILES
;
;THIS PROGRAM WAS WRITTEN AT WESTERN MICHIGAN UNIVERSITY
;
;PROGRAMMED BY SAM ANEMA
;
;MODIFICATIONS:
; 29 JAN 73 R. BARR - SUBSCRIPT GLITCH
; 3 JUL 73 R. BARR - ATTEMPT TO FIX END OF LINE GARBAGE
; - INSERT CORRECTION FEATURE(TURNED OFF)
; 29 AUG 73 R. BARR - MAJOR REWRITE
; 20 DEC 74 R. BARR - DATE75 PATCHES
;
;COMMENT ON CORRECTION FEATURE
; IF SOURCE IS NOT IN USERS AREA
; -NO BACKUP IS GENERATED.
; -IF SOURCE WITH SAME NAME AS ABOVE SOURCE EXISTS IN USER AREA
; IT IS LOST.
; EXTERN USAGE ;LOAD FROM NGLIB[210,210]
DATA: BLOCK 635
ARROW: BLOCK 635
MAX: BLOCK 635
MIN: BLOCK 635
IBUF: BLOCK 3
OBUF: BLOCK 3
OB: BLOCK 3
CH1=6
CH2=7
CH3=10
CH4=11
X: BLOCK 4
Y: SIXBIT/ERROR/
SIXBIT/OUT/
XWD 055000,0
0
BAKFIL: 0
SIXBIT/BAK/
0
0
TMPFIL: SIXBIT/CHECK/
SIXBIT/TMP/
0
0
NAME: ASCIZ/CHECK /
BLANK=40
SUBTTL DEFINITION AREA
DEFINE MAXMIN (AA,%A,%B,%C)
< MOVEI 4,BLANK
SETZB 1,3
SETZ 2,
%A: TTCALL 4,0 ;GET A CHR
CAIN 0,15 ;CR?
JRST %A ;GOBBLE CRLF
CAIN 0,12 ;LF?
JRST %B ;GO FILL VOID
CAIL 3,120 ;LINE FULL(80 CHRS)?
JRST %A ;YES-EAT REST OF LINE
MOVEM 0,AA(1) ;NO - STORE CHR
AOJ 1, ;COUNT CHRS
AOJA 3,%A ;THIS LINE COUNT
%B: CAIL 3,120 ;ANY MORE ROOM?
JRST %C ;NO
MOVEM 4,AA(1) ;YES-FILL WITH BLANKS
AOJ 1,
AOJA 3,%B
%C: SETZ 3,
AOJ 2, ;ANOTHER LINE FINISHED
CAMGE 2,10 ;MORE TO GO?
JRST %A ;YES
>
DEFINE OUT80 (AA,%D,%E)
< SETZ 6,
%D: MOVE 1,AA(4)
JUMPE 1,%E
JSR PUTCHR
SETZM AA(4)
AOJ 6,
AOJ 4,
CAIGE 6,120
JRST %D
%E: MOVEI 1,15
JSR PUTCHR
MOVEI 1,12
JSR PUTCHR
>
SUBTTL MAIN PROGRAM CODE
BEGIN: RESET
TTCALL 3,[ASCIZ/
WMU DATA VERIFICATION PROGRAM
/]
; JSA 16,USAGE
; EXP NAME
JRST GETSET
NEWTRY: MOVE 1,[POINT 6,X]
TTCALL 3,[ASCIZ/ENTER NAME OF FILE TO BE VERIFIED
/]
GETMO: TTCALL 4,0
CAIN 0,15
JRST NOMORE
CAIN 0,56
JRST EXTENS
CAIN 0,"["
JRST PROJG
ADDI 0,40
IDPB 0,1
JRST GETMO
EXTENS: MOVE 1,[POINT 6,X+1]
GET: TTCALL 4,0
CAIN 0,15
JRST NOMORE
CAIN 0,"["
JRST PROJG
ADDI 0,40
IDPB 0,1
JRST GET
PROJG: SETZ 1,
MORENS: TTCALL 4,0
CAIN 0,"]"
JRST EATUM
CAIN 0,","
JRST LEFTH
CAIL 0,"0"
CAILE 0,"7"
JRST ERRORN
SUBI 0,60
IMULI 1,10
ADD 1,0
JRST MORENS
LEFTH: HRLZM 1,X+3
JRST PROJG
EATUM: HRRM 1,X+3
NOTYIT: TTCALL 4,0
CAIN 0,15
TTCALL 4,0
CAIN 0,12
JRST PRESON
JRST NOTYIT
ERRORN: TTCALL 3,[ASCIZ/
?SYNTAX ERROR
/]
GETSET: SETZM X+1
SETZM X+2
SETZM X+3
JRST NEWTRY
CANTF: TTCALL 3,[ASCIZ/
?CAN'T FIND FILE
/]
JRST GETSET
NOMORE: TTCALL 4,0
PRESON: INIT CH1,0
SIXBIT/DSK/
XWD ,IBUF
JRST ERROR
INIT CH2,0
SIXBIT/DSK/
XWD OBUF,
JRST ERROR
MOVE 0,X+3
MOVEM 0,PPN#
LOOKUP CH1,X
JRST CANTF
ENTER CH2,Y
JRST ERROR
TTCALL 3,[ASCIZ/
ENTER THE NUMBER OF CARDS PER OBSERVATION
/]
GETNBR: TTCALL 4,10
SUBI 10,60
TTCALL 4,0
TTCALL 4,0
TTCALL 3,[ASCIZ/
ENTER MAXIMUM VALUES
/]
MAXMIN MAX ;DEFINED-GET MAX
RDMIN: TTCALL 3,[ASCIZ/
ENTER MINIMUM VALUES
/]
MAXMIN MIN ;DEFINED-GET MIN
RDBL: TTCALL 3,[ASCIZ/
ARE BLANKS OK?
/]
TTCALL 4,15 ;GET 1ST CHR
CAIN 15,12 ;LF?
JRST BEGINI ;YES
TTCALL 4,2 ;NO GOBBLE MORE
CAIE 2,12 ;LF?
JRST .-2 ;NO-GOBBLE MORE
BEGINI: SETZM MISFLG# ;YES
JRST BEGINK ;*****THIS BLOCKS OUT THE MISSING DATA OPTION***
TTCALL 3,[ASCIZ/
DO YOU WISH TO REPLACE BAD CHARACTERS WITH A MISSING
DATA SYMBOL?(YES OR NO)
/]
TTCALL 4,4 ;GET 1ST CHR
CAIN 4,12 ;LF
JRST BEGINJ ;YES
TTCALL 4,2 ;NO
CAIE 2,12 ;LF?
JRST .-2 ;NO GOBBLE MORE
BEGINJ: CAIE 4,"Y" ;YES
JRST BEGINK
SETOM MISFLG
INIT CH3,0
SIXBIT/DSK/
XWD OB,
JRST ERROR
OUTBUF CH3,3
ENTER CH3,TMPFIL
JRST ERROR
MIS3: TTCALL 3,[ASCIZ/
ENTER A SINGLE CHARACTER MISSING DATA SYMBOL.
/]
TTCALL 4,3 ;GET 1ST CHR
CAIN 3,12 ;LF?
JRST MIS3 ;YES-ILLEGAL
TTCALL 4,2 ;NO-GOBBLE
CAIE 2,12 ;LF?
JRST .-2 ;NO GOBBLE
MIS4: MOVEM 3,MISSYM# ;YES-SAV 1ST CHR
BEGINK: SETZ 11,
MOVEI 0,BLANK
MOVEI 2,"^"
NEWLIN: SETZB 3,4
SETZB 5,6
AOJ 11,
GETC: JSR GETCHR
CAIN 1,15
JRST OUTL
CAIN 1,12 ;LF NO CR?
JRST OUTLPA ;YES
MOVEM 1,DATA(4)
MOVEM 0,ARROW(4)
CAMN 0,MAX(4)
JRST GINC
CAMG 1,MAX(4)
CAMGE 1,MIN(4)
JRST ERR
GINC: SKIPE MISFLG
JSA 16,OUTCHR
AOJ 4,
AOJ 6,
CAIGE 6,120
JRST GETC
JRST OUTLP
ERR: CAIE 1,BLANK
JRST ERRO
CAIN 15,"Y" ;BLANK OK?
JRST GINC ;YES
ERRO: MOVEM 2,ARROW(4) ;NO
SETO 5, ;ERROR DETECTED
SKIPE MISFLG
MOVE 1,MISSYM
JRST GINC
OUTL: SKIPE MISFLG
JSA 16,OUTCHR
OUTLP: JSR GETCHR
SKIPE MISFLG
JSA 16,OUTCHR
CAIE 1,12
JRST OUTLP
OUTLPA: SETZM DATA(4)
SETZM ARROW(4)
AOJ 3,
SETZ 6,
MOVE 4,3
IMULI 4,120
CAMGE 3,10
JRST GETC
JUMPE 5,NEWLIN
SETOM ERRFLG#
MOVEI 12,^D10000
MOVE 13,11
DIVIDE: IDIV 13,12
MOVE 1,13
ADDI 1,60
JSR 16,PUTCHR
CAIN 12,1
JRST FINAL
IDIVI 12,^D10
MOVE 13,14
JRST DIVIDE
FINAL: MOVEI 1,15
JSR 16,PUTCHR
MOVEI 1,12
JSR 16,PUTCHR
SETZ 3,
SETZ 5,
MOROUT: MOVE 4,5
OUT80 DATA ;DEFINED-OUTPUT LINE OF DATA
MOVE 4,5
OUT80 ARROW ;DEFINED-OUTPUT LINE OF ARROW
ADDI 5,120
AOJ 3,
CAMGE 3,10 ;ALL LINES OF THIS SET OUT?
JRST MOROUT ;NO
JRST NEWLIN ;YES
ENDFIL: SKIPN ERRFLG
JRST NOERRS
SKIPN PPN
JRST GOON
GETPPN 4,
SKIP ;NO OP
CAMN 4,PPN
JRST GOON
MOVE 0,X+1
MOVEM 0,BAKFIL+1
GOON: SKIPN MISFLG
JRST CLOSIT
MOVE 0,X
MOVEM 0,BAKFIL
INIT CH4,16
SIXBIT/DSK/
0
JRST ERROR
LOOKUP CH4,BAKFIL
JRST NOBAK
RENAME CH4,[0]
JRST ERROR
NOBAK: HLRZ 0,BAKFIL+1
CAIE 0,'BAK'
JRST MORE
SETZM BAKFIL+3
HLLZS BAKFIL+1
HRLZI 0,077000
MOVEM 0,BAKFIL+2
RENAME CH1,BAKFIL
JRST ERROR
MORE: SETZM X+3
RENAME CH3,X
JRST ERROR
CLOSIT: TTCALL 3,[ASCIZ/
OUTPUT FILE IS ERROR.OUT
/]
EXIT
NOERRS: TTCALL 3,[ASCIZ/
NO ERRORS ENCOUNTERED
/]
CLOSE CH2,40 ;DELETE NEW COPY
CLOSE CH3,40
EXIT
ERROR: TTCALL 3,[ASCIZ"?FATAL I/O ERROR
"]
JRST CLOSIT
GETCHR: 0
GETCNT: SOSG IBUF+2
JRST GETBUF
GETNXT: ILDB 1,IBUF+1
JUMPN 1,@GETCHR
JRST GETCNT
GETBUF: IN CH1,
JRST GETNXT
STATZ CH1,740000
JRST ERROR
JRST ENDFIL
PUTCHR: 0
SOSG OBUF+2
JRST PUTBUF
PUTNXT: IDPB 1,OBUF+1
JRST @PUTCHR
PUTBUF: OUT CH2,
JRST PUTNXT
JRST ERROR
OUTCHR: 0
SOSG OB+2
JRST PUTBF
PUTC: IDPB 1,OB+1
JRA 16,(16)
PUTBF: OUT CH3,
JRST PUTC
JRST ERROR
END BEGIN