Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50246/block.mac
There are no other files named block.mac in the archive.
TITLE BLOCK PROGRAM TO TRANSLATE AN ASCII FILE TO BCD(026,029)
;AND/OR EBCDIC ON MULTIPLE OUTPUT UNITS
SUBTTL W.H.KROPP AUG 1971
;BROOKHAVEN NATIONAL LABS
;BLD 197
;UPTON L.I. N. Y. 11973
;TEL AC/516 345 2903 OR 2902
;AC DEFINITION
AC0=0
AC1=1
AC2=2
AC3=3
AC4=4
AC5=5
AC6=6
AC7=7
AC10=10
AC11=11
AC12=12
AC13=13
AC14=14
AC15=15
AC16=16
Q=16
PDL=17
INDEX=1
RES=2
NUM=4
FLG=0
UNITS==5
;CONFIGURED FOR FIVE UNITS-HOWEVER IT CAN BE EXTENDED ARBITARILY
;TO 14 (# OF SOFTWARE CHANNELS AVAILABLE) ----THUS SET UNITS TO DESIRED NUMBER OF OUTPUT UNITS
EXTERN JOBFF,JOBVER,JOBSA,JOBREL
VBLK==UNITS,,2
;VERSION 2 JULY 1972
;VERSION 1 DEC 1971
LOC 137
VBLK
RELOC
BLOCK: CALL [SIXBIT/RESET/] ;RESET I/O
MOVEI AC2,GRPPTR-BUFPTR-1 ;NUM OF LOCATIONS TO CLEAR
CLRLP: SETZM ,BUFPTR(AC2) ;CLEAR LOCATION
SOJGE AC2,CLRLP ;LOOP OVER CLEAR AREA
MOVE PDL,[IOWD 15,PDLST] ;SET UP PUSH DOWN LST
PUSHJ PDL,TTYINT ;INITALIZE TTY
MOVE AC6,JOBFF ;PICK UP LOWESTS LOC
MOVEM AC6,JOBFFP# ;SAVE FOR RELEASING CORE
INPT: SETZB FLG,INDEX ;SET FLAG FOR INPUT
TTCALL 3,IN1 ;TYPE MESSAGE
PUSHJ PDL,UNITDF ;DEFINE INPUT UNIT
MOVE AC6,[XWD 0,INBBUF] ;GET BUFFER WD
MOVEM AC6,SPEC+2 ;STORE IN SPEC+2
OPENN: OPEN 15,SPEC ;INPUT ON CHANNEL 15
JRST ERRNA ;INPUT UNIT NOT AVAIL
SETZM ,SPEC+2 ;CLEAR BUFFER WORD
LOOKUP 15,FILNA ;SEARCH FOR FILE
JRST LOOKER ;FILE NOT FOUND
MOVEI INDEX,15 ;SET INDEX FOR SKIPER
HLRZ AC6,SPEC+1 ;GET SIXBIT DEVICE NAME
CAIN AC6,556441 ;MTA?
PUSHJ PDL,SKIPER ;YES SKIP FILES
SETZ INDEX, ;ZERO INDEX
SETO FLG, ;SET FLG
MOVEI AC6,ONE ;GET ADR OF DECODING LOOP
MOVEM AC6,STONE ;STORE ADR
DEFLP: TTCALL 3,OT1 ;TYPE OUTPUT MESSAGE
PUSHJ PDL,UNITDF ;DEFINE OUTPUT UNIT
STDQUS: TTCALL 3,STD ;TYPE MESSAGE
PUSHJ PDL,INCHRS ;GET RESPONSE
JUMPE RES,STDQU ;CR ANS SKIP STD OPTION
TLNE RES,230000 ;ANS YES?
SKIPA ;NO---SKIP INST
JRST STDOP ;YES--SET STANDARD OPTION
TLNE RES,260000 ;ANS SAME?
SKIPA ;NO-- SKIP NEXT INST
JRST SAMSET ;YES---SKIP OVER PROCESSING
TLNE RES,304000 ;ANS NO?
JRST STDQUS ;---NO REPEAT QUESTION
STDQU: TTCALL 3,STDFMT ;TYPE STANDARD FORMAT MESS
PUSHJ PDL,INCHRS ;GET RESPONSE
JUMPE RES,CODQU ;CR ANS---GO TO NEXT QUESTION
LSH RES,-^D29 ;SHIFT RESPONSE
SUBI RES,101 ;SUBTRACT 100
JUMPL RES,STDQU ;REPEAT QUESTION
CAIG RES,3 ;103-101
JRST @DSP(RES) ;YES DISPATCH
CAIE RES,7 ;HELP?
JRST STDQU ;NO REPEAT QUESTION
TTCALL 3,STDMTS ;YES---EXPAND DEFINITION
JRST STDQU+1 ;GET RESPONSE
CODQU: PUSHJ PDL,CODE ;DEFINE CODE
LRECQU: TTCALL 3,BKFATR ;TYPE LOGICAL PHY REC MESS
PUSHJ PDL,INCHRS ;GET RESPONSE
JUMPE RES,.-2 ;LOOP ANS BLANK
PUSHJ PDL,CONVT ;CONVERT TO INTEGER
PUSHJ PDL,EXPAND ;SET UP OUTPUT BUFFER
GPMK: TTCALL 3,GPMRK ;TYPE GROUP MARKER MESS
PUSHJ PDL,INCHRS ;GET RESPONSE
JUMPE RES,RECMK ;SKIP IF BLANK
MOVEI AC16,2 ;SET CTR FOR OCTIN
MOVE AC10,STATWD(INDEX) ;GET STATWD
TLNE AC10,1B19 ;BCD MODE?
MOVEI AC16,3 ;NO---SET FOR EBCDIC ANS
MOVE AC3,AC16 ;STORE CTR
PUSHJ PDL,OCTIN ;CONVERT TO OCTAL
IMULI AC3,3 ;COMP # OF PLACES
ROT NUM,0(AC3) ;ROTATE LEFT
PUSHJ PDL,STOGRP ;STORE GROUP MARKER
RECMK: TTCALL 3,RCMRK ;TYPE RECORD MARKER MESS
PUSHJ PDL,INCHRS ;GET RESPONSE
JUMPE RES,SETLP ;SKIP PROCESSING
MOVEI AC16,2 ;SET CTR FOR OCTIN
TLNE AC10,1B19 ;SKIP IF BCD
MOVEI AC16,3 ;SET FOR EBCDIC
MOVE AC3,AC16 ;STORE CTR
PUSHJ PDL,OCTIN ;CONVERT TO OCTAL
IMULI AC3,3 ;COMP # OF PLACES
ROT NUM,0(AC3) ;ROTATE LEFT
PUSHJ PDL,STORMK ;STORE RECORD MARKER
SETLP: HRLI AC6,COPY ;SET UP AC FOR BLT
HRR AC6,STONE ;PICK UP STONE ADR
MOVE AC7,STONE ;GET STONE ADR
BLT AC6,2(AC7) ;STORE 3 INST IN DECODING LOOP
ADDI AC7,3 ;INCR STONE
MOVEM AC7,STONE# ;RESTORE STONE
DEFENT: JSP AC16,STOCHN ;STORE CHANNEL #
OPEN 0,SPEC ;INIT UNIT
JRST ERRNA1 ;CHANNEL NOT AVAILABLE
MOVE AC6,SPEC ;GET SPEC
MOVEM AC6,UNITST(INDEX) ;SAVE UNIT SPECS
PUSHJ PDL,SKIPER ;SKIP FILES
MOVE AC6,STATWD(INDEX) ;GET STATWD
TLNN AC6,1B19 ;EBCDIC?
JRST DEFEND ;NO SKIP OVER 9TK SET
JSP AC16,STOCH1 ;STORE CHANNEL NUMBER
MTAPE 0,101 ;SET FOR 9TK
MTAPE 0,13 ;WRITE 3 INCHES BLANK TAPE
DEFEND: AOJA INDEX,DEFLP ;LOOP OVER DEFINITIONS
FINDEF: MOVN AC6,INDEX ;GET NEGATIVE
HRLZM AC6,INDLOC ;SWAP HALFS
MOVE AC6,NEEDLO ;PICK UP JRST INST
SOS AC7,STONE ;OVER WRITE
MOVEM AC6,(AC7) ;TERMINATE LOOP
SETZ AC0, ;ZERO FOR CHAR CTR
JRST LOOP
; SAME AS PREVIOUS FORMAT
SAMSET: JUMPE INDEX,ERRR4 ;CAN'T TYPE SAME ON 1 ST OUTPUT
MOVE AC6,STONE ;GET LAST LOOP INST
SOJ AC6, ;SUBTRACT ONE
AOS ,@AC6 ;BUMP INST IN DECODING LOOP
MOVE AC6,STATWD-1(INDEX) ;PICK UP LAST STATWD
TLZ AC6,1B18 ;ZERO BUFFER BIT
MOVEM AC6,STATWD(INDEX) ;STORE MODIFIED STATWD WD
MOVE AC6,UNMARK-1(INDEX) ;GET PREVIOUS UNMARK
MOVEM AC6,UNMARK(INDEX) ;STORE UNMARK
MOVE AC6,GETCHR-1(INDEX) ;USED IN HEADER
MOVEM AC6,GETCHR(INDEX) ;TO DETERMINE CODE
JRST DEFENT ;RETURN TO DEFINITION LOOP
ERRR4: TTCALL 3,ERRR4M ;TYPE ERROR MESS
JRST DEFLP ;RETURN TO DEFINITION LOOP
; LOOP INSTRUCTIONS
COPY: LDB AC11,GETCHR(INDEX)
IDPB AC11,STOCHR(INDEX)
ADDI INDEX,1
; GENERAL TRANSLATION LOOP
READ: INPUT 15, ;READ INPUT ASCII RECORD
STATZ 15,362000 ;STATUS OK?
PUSHJ PDL,STATIN ;NO PROCESS INPUT STATUS
AOS ,PSYIN ;INCR INPUT PSY REC CTR
LOOP: SOSGE ,INBBUF+2 ;-1 FROM BUFFER WD CTR
JRST READ ;BUFFER EMPTY READ NEXT RECORD
ILDB AC10,INBBUF+1 ;GET CHAR FROM INPUT BUFFER
JUMPE AC10,LOOP ;JUMP IF NULL
CAIN AC10,15 ;END OF LOG REC ON INPUT
JRST ENTRY ;YES PROCESS REC MARKS ETC
SUBI AC10,40 ;REMOVE OFFSET
JUMPL AC10,LOOP ;LOOP IF LESS THAN 40
AOJ AC0, ;INCREMENT CHAR CTR
SETZ INDEX, ;ZERO INDEX
ONE: BLOCK UNITS*3-1
; ROUTINE ENTERED AFTER LOGICAL RECORD READ ON INPUT
ENTRY: MOVE INDEX,INDLOC ;SET UP INDEX
AOS ,LOGCTR ;INCR LOGICAL RECORD CTR
SKIPN ,CHLOGR ;SKIP IF NOT 1 ST TIME THRU
MOVEM AC0,CHLOGR ;STORE CHARACTERS PER LOG REC
CAMN AC0,CHLOGR ;IS LOGICAL REC FIXED LENGTH?
JRST ENTRY1 ;YES
ENTRY0: MOVE AC16,STATWD(INDEX) ;GET STATWD
TLNE AC16,1B21 ;HAS IT BEEN SET TO VAR LENGTH?
JRST ENTRY1 ;YES--SKIP PROCESSING
TLO AC16,1B21 ;NO---FLAG VARIABLE LENGTH
MOVEM AC16,STATWD(INDEX) ;RESTORE STATWD
AOBJN INDEX,ENTRY0 ;LOOP OVER UNITS
MOVE INDEX,INDLOC ;RESET INDEX
ENTRY1: AOS AC16,STATWD(INDEX) ;ADD ONE TO LOGICAL RECORD CTR
SKIPGE AC10,UNMARK(INDEX) ;GROUP OR RECORD MARKER USED
PUSHJ PDL,MARKER ;YES --INSERT MARKER
LDB AC10,LOGPTR ;GET CURRENT LOG REC CTR
HRRZS ,AC16 ;ZERO LEFT HALF
CAML AC16,AC10 ;CURRENT LOG REC# = SET # OF LOG RECS
JRST OUTPUT ;YES --DO OUTPUT
AOBJN INDEX,ENTRY1 ;LOOP OVER UNITS
ENTRY2: SETZ AC0, ;CLEAR CHARACTER CTR
SKIPGE ,BUFCLR ;DO ANY BUFFER HAVE TO BE CLEARED
JRST SETPTR ;YES SET POINTERS & CLR BUFFER
NEEDLO: JRST LOOP ;RETURN TO TRANSLATION
OUTPUT: HRRZ AC10,STOCHR(INDEX) ;GET ADR IN OUTBUF
HRRZ AC11,BUFPTR(INDEX) ;GET INITAL ADR OF BUFFER
SUB AC10,AC11 ;WDS IN OUTBUF
JUMPE AC10,PLUS6 ;FIX ????
MOVN AC12,AC10 ;GET NEGATIVE
MOVE AC13,BUFPTR(INDEX) ;GET BUF STATS
HRRM AC13,LST ;STORE ADR IN OUTPUT LST
HLRES ,AC13 ;GET NEG # OF WDS IN BUFFER
CAMGE AC12,AC13 ;BUFFER EXCEED AREA PROVIDED?
JRST ERRR1 ;YES---PROBLEM
HRLM AC12,LST ;NO STORE WD CT IN LST
SAME: JSP AC16,STOCH1 ;STORE CHANNEL NUMBERS
OUTPUT 0,LST ;OUTPUT
STATZ 0,742000 ;STATUS OK?
PUSHJ PDL,STATOT ;NO PROCESS OUTPUT STATUS
AOS ,PSYCTR(INDEX) ;INCR OUTPUT PSY CTR
SKIPE ,FINFLG ;SKIP IF NOT FINISHING
POPJ PDL, ;RETURN TO DMPOUT ROUTINE
PLUS6: SETOM ,BUFCLR# ;SET FLAG FOR CLEARING BUFF
HRLZI AC10,1B20 ;GET CLEAR BUFFER BIT
IORM AC10,STATWD(INDEX) ;SET BIT IN STATWD
AOBJN INDEX,.+2 ;END OF LOOP
JRST ENTRY2 ;YES
SKIPL ,STATWD(INDEX) ;SAME POUPUT BUFFER?
JRST SAME ;YES
JRST ENTRY1 ;CONTINUE LOOP
; ERROR ROUTINES
ERRR1: TTCALL 3,ERRR1M ;TYPE ERROR MESSAGE
CALL [SIXBIT/EXIT/] ;EXIT
; ROUTINE TO CLOSE OUT OUPUT UNITS WHEN EOF ON INPUT
DMPOUT: SETOM ,FINFLG ;SET FINFLG CLOSING BUFFERS
MOVE INDEX,INDLOC ;SET UP INDEX
EXOUT: SKIPL AC16,STATWD(INDEX) ;SAME OUTPUT BUFFER?
JRST SAMCLS ;YES PROCESS
SETZM ,LASTOT ;ZERO LASTOT---RESET FLG
TRNN AC16,377777 ;ANY MISC RECORDS IN OUTBUF?
JRST CLSOUT ;NO---CLOSE OUTPUT---EOF
TLNN AC16,1B21 ;FIXED LENGTH?
JRST FILOUT ;YES--FILL OUT LAST REC
FILRET: SETOM ,LASTOT ;SET LAST OUTPUT FLG
SKIPL AC10,UNMARK(INDEX) ;ANY MARKERS USED?
JRST EXOUT1 ;NO---SKIP MARKER PROCESS
LDB AC11,LOGPTR ;GET BLOCKING FACTOR
IORM AC11,AC16 ;SET TO FORSE RECORD MARKER
PUSHJ PDL,MARKER ;WRITE MARKER
EXOUT1: PUSHJ PDL,OUTPUT ;WRITE LAST OUTPUT
CLSOUT: JSP AC16,STOCHN ;SET SOFTWARE CHANNEL #
CLOSE 0,0 ;WRITE EOF
AOBJN INDEX,EXOUT ;LOOP
CLOSE 15,0 ;CLOSE INPUT
JRST DESCPT
;SAME OUTPUT BUFFER
SAMCLS: SKIPE ,LASTOT ;LAST OUTPUT BUFFER WRITTEN?
PUSHJ PDL,SAME ;YES---DUMP BUFFER
JRST CLSOUT ;WRITE EOF
; ROUTINE TO FILL OUT LAST PHYSICAL RECORD IF BLOCKING FACTOR
; GT 1 AND FIXED LENGTH LOGICAL RECORDS
FILOUT: LDB AC6,LOGPTR ;GET BLOCKING FACTOR
CAIN AC6,1 ;BF=1
JRST FILRET ;YES---RETURN
MOVE AC13,BCDBLK ;GET BCD FILLER CHAR
TLNE AC16,1B19 ;EBCDIC?
SETZ AC13, ;YES--SET TO NULL CHAR
HRRZS ,AC16 ;GET CURRENT # OF LOGICAL RECS
SUB AC6,AC16 ;# OF LOGICAL RECS TO FILL
MOVEM AC6,FILREC(INDEX) ;STORE COUNT OF FILLER RECS
SOJ AC6, ;SUBTRACT ONE
JUMPL AC6,FILRET ;RECORD FILLED OUT
SETZM ,FINFLG ;RESET FLG FOR FILLER
RECLOP: MOVEI AC5,1 ;SET UP AC CTR
FILOP: IDPB AC13,STOCHR(INDEX) ;STORE FILLER CHAR
CAMGE AC5,CHLOGR ;LOGICAL RECORD FILLED?
AOJA AC5,FILOP ;NO CONTINUE FILLING
SKIPGE AC10,UNMARK(INDEX) ;GROUP OR RECORD MARKER USED?
PUSHJ PDL,MARKER ;YES INSERT MARKER
SOJGE AC6,RECLOP ;LOOP OVER RECORDS
SETOM ,FINFLG ;RESET FLG
JRST FILRET ;RETURN
; ROUTINETO INSERT GROUP AND RECORD MARKERS
MARKER: TLNN AC10,1B20 ;RECORD MARKER USED
JRST GRPMRK ;NO PROCESS AS GROUP MARKER
LDB AC11,LOGPTR ;GET # OF LOG REC PER PHYSICAL
HRRZ AC12,AC16 ;GET CURRENT # OF LOG RECS
CAML AC12,AC11 ;BUFFER FULL OF LOG RECS
JRST RECMRK ;YES GENERATE RECORD MARKER
TLNN AC10,1B19 ;GROUP MARKERS USED?
POPJ PDL, ;NO --RETURN
GRPMRK: LDB AC10,GRPPTR ;GET GROUP MARKER
SKIPGE ,FINFLG ;LAST OUTPUT BUFFER?
JRST LASTMK ;YES---DON'T INCR BYTE POINTER
IDPB AC10,STOCHR(INDEX) ;STORE MARKER IN OUTBUF
POPJ PDL, ;RETURN
RECMRK: LDB AC10,RECPTR ;GET RECORD POINTER
JRST GRPMRK+1 ;STORE AND RETURN
;WRITE OVER LAST MARKER
LASTMK: DPB AC10,STOCHR(INDEX) ;STORE MARKER
POPJ PDL, ;RETURN
; ROUTINE TO STORE CHANNEL NUMBER IN I/O UUO'S
STOCH2: DPB INDEX,STOCP2 ;STORE CHANNEL NUMBER
STOCH1: DPB INDEX,STOCP1 ;STORE CHANNEL NUMBER
STOCHN: DPB INDEX,STOCHP ;DEPOSIT INDEX IN CHANNEL #
JRST (AC16) ;RETURN
STOCHP: POINT 4,(AC16),12
STOCP1: POINT 4,1(AC16),12
STOCP2: POINT 4,2(AC16),12
; ROUTINE TO RESET POINTERS AND CLEAR BUFFERS
SETPTR: SETZM ,BUFCLR ;RESET FLAG
MOVE INDEX,INDLOC ;SET UP INDEX
SETPT1: SKIPL AC16,STATWD(INDEX) ;SAME OUTPUT BUFFER
JRST SETLOP ;YES ---SKIP PROCESSING
TLZN AC16,1B20 ;IS BUFFER TO BE CLEARED?
JRST SETLOP ;NO
HLLZS ,AC16 ;ZERO LOG REC CTR
MOVE AC10,STOCHR(INDEX) ;GET STOCHR POINTER
TLZ AC10,770000 ;ZERO POSITION
HRR AC10,BUFPTR(INDEX) ;RESET BUFFER ADR
MOVEM AC10,STOCHR(INDEX) ;STORE NEW POINTER
MOVE AC10,BUFPTR(INDEX) ;GET BUFPTR
MOVE AC6,BCDBLK ;GET WD OF BCD BLANKS
TLNE AC16,1B19 ;IS CODE EBCDIC?
SETZ AC6, ;YES--SET FILLERS TO ZEROS
MOVEM AC6,1(AC10) ;SET UP INPUT BUFFER
AOBJN AC10,.-1 ;LOOP
RESTOR: MOVEM AC16,STATWD(INDEX) ;RESTORE STATWD
SETLOP: AOBJN INDEX,SETPT1 ;LOOP OVER UNITS
JRST LOOP ;CONTINUE TRANSLATION
BCDBLK: 202020202020
; ROUTINE TO SKIP FILES
SKIPER: TTCALL 3,SKPMES ;TYPE MESSAGE
PUSHJ PDL,INCHRS ;GET RESPONSE
PUSHJ PDL,CONVT ;CONVERT TO INTEGER
SKPENT: JUMPE NUM,SKPRET ;RETURN IF 0
MOVE AC6,NUM ;SAVE CTR
MOVMS ,NUM ;GET MAGNITUDE
MOVEI AC3,16 ;SET FOR FORWARD DIRECTION
SKIPG ,AC6 ;BACKSPACE
TRO AC3,1B35 ;YES--SET TO 17
JSP AC16,STOCH2 ;STORE CHANNEL NUMBERS
SKPFIL: MTAPE 0,0(AC3) ;SKIP
MTAPE 0,0 ;I/O WAIT
STATO 0,4000 ;BEG OF TAPE?
SOJG NUM,SKPFIL ;LOOP OVER FILES
JUMPG AC6,SKPRET ;FORWARD RETURN
JSP AC16,STOCHN ;STORE CHANNEL NUMBER
STATZ 0,4000 ;BEG OF TAPE?
SKPRET: POPJ PDL, ;YES--RETURN
JSP AC16,STOCH1 ;STORE CHANNEL NUMBERS
MTAPE 0,16 ;SKIP OVER EOF
MTAPE 0,0 ;I/O WAIT
POPJ PDL, ;RETURN
; UNIT NOT AVAILABLE MESSAGES
ERRNA: TTCALL 3,IN1 ;TYPE INPUT
JRST ERRNA2 ;SKIP
ERRNA1: TTCALL 3,UNITNA(INDEX) ;TYPE OUTPUT
ERRNA2: TTCALL 3,MESS3 ;TYPE NOT AVAILABLE MESSAGE
JUMPE FLG,INPT ;RETURN TO INPUT
JRST DEFLP ;RETURN
MESS3: ASCIZ/UNIT NOT AVAILABLE
/
; ROUTINE TO SET GROUP MARKER
STOGRP: DPB NUM,GRPPTR ;STORE GROUP MARKER
HRLZI AC6,1B18+1B19 ;SET UP MASK
IORM AC6,UNMARK(INDEX) ;SET BITS
POPJ PDL, ;RETURN
; ROUTINE TO SET RECORD MARKER
STORMK: DPB NUM,RECPTR ;STORE RECORD MARKER
HRLZI AC6,1B18+1B20 ;SET UP MASK
IORM AC6,UNMARK(INDEX) ;SET BITS
POPJ PDL, ;RETURN
; ROUTINE TO SET OUTPUT FOR STANDARD OPTION
; STANDARD OPTION
; A ONE(1) PHYSICAL RECORD PER LOGICAL RECORD
; B O26 BCD FORMAT
STDOP: PUSHJ PDL,STDCOD ;SET O26 CODE
MOVEI NUM,1 ;SET NUMBER FOR EXPAND
PUSHJ PDL,EXPAND ;SET UP OUTPUT BUFFERS
JRST SETLP ;RETURN TO LOOP
; ROUTINE TO COMPUTE OUTPUT BUFFER SIZE AND EXPAND CORE
; ASSUMPTION----- LOGICAL RECORD DOES NOT EXCEED 134 CHARACTERS
BCDWDS==^D24
EBCDWD==^D34
EXPAND: DPB NUM,LOGPTR ;DEPOSITE # OF LOGICAL RECORDS
MOVE AC16,STATWD(INDEX) ;GET STATWD
TLO AC16,1B18 ;SET BUFFER BIT
TLNN AC16,1B19 ;EBCDIC?
IMULI NUM,BCDWDS ;NO--SET FOR BCD
TLNE AC16,1B19 ;BCD?
IMULI NUM,EBCDWD ;NO-- SET FOR EBCDIC
MOVEM AC16,STATWD(INDEX) ;RESTORE STATWD
MOVE AC6,JOBFF ;GET PROG CURRENT SIZE
HRRZM AC6,BUFPTR(INDEX) ;STORE OUTPUT BUFFER ADR
HRRM AC6,STOCHR(INDEX) ;SET FOR 1ST PASS
ADDM NUM,JOBFF ;INCREASE PROG SIZE
AOS AC7,JOBFF ;ADD ONE BEYOND BUFFER
CORTST: CAML AC7,JOBREL ;REQUIRED TO EXPAND CORE?
JRST CORE ;YES----
MOVNS ,NUM ;GET NEGATIVE BUFFER SIZE CT
HRLM NUM,BUFPTR(INDEX) ;STORE
HRLZS NUM,NUM ;SET UP CTR
HRRM AC6,ZLOOP ;STORE STARTING ADR
MOVE AC6,BCDBLK ;GET BCD FILLER
TLNE AC16,1B19 ;EBCDIC CODE?
SETZ AC6, ;YES ZERO FILLER
ZLOOP: MOVEM AC6,(NUM) ;SETUP NEW BUFFER AREA
AOBJN NUM,ZLOOP ;LOOP
POPJ PDL, ;RETURN
CORE: CALL AC7,[SIXBIT/CORE/] ;EXPAND CORE
JRST CORERR ;ERROR---CORE NOT AVAIL
JRST CORTST ;TEST AGAIN
CORERR: TTCALL 3,CORER
JRST EXIT
; ROUTINE TO SET STANDARD FORMATS
; DISPATCH TABLE
DSP: JRST CODQU
JRST USAEU1
JRST IBM36
; USAER1----80 CHARS PER LOGICAL REC; BLOCKING FACTOR 10
; GROUP MARKER 32(8); RECORD MARKER 77(8)
USAEU1: PUSHJ PDL,STDCOD ;SET CODE TO BCD O26
MOVEI NUM,^D10 ;GET BLOCKING FACTOR
PUSHJ PDL,EXPAND ;EXPAND CORE
MOVEI NUM,32 ;GET GROUP MARKER
PUSHJ PDL,STOGRP ;STORE GROUP MARKER
MOVEI NUM,77 ;GET RECORD MARKER
PUSHJ PDL,STORMK ;STORE RECORD MARKER
JRST SETLP ;RETURN TO DEFINITION LOOP
; IBM360----BLOCKING FACTOR 91; NO GROUP & REC MARKERS
; UPPER & LOWER CASE EBCDIC
IBM36: PUSHJ PDL,CDEBL+2 ;SET EBCDIC CODE
MOVEI NUM,^D91 ;GET BLOCKING FACTOR
PUSHJ PDL,EXPAND ;EXPAND CORE
JRST SETLP ;RETURN TO DEFINITION LOOP
;STATUS PROCESSING
EOT==1B25
RECLNG==1B21
EOF==1B22
MISDAT==1B19
PARER==1B20
WRLOK==1B18
STATOT: SETZM STATFG# ;ZERO STATFG
JSP AC16,STOCHN ;STORE UNIT CH NUM
GETSTS 0,AC2 ;GET STATUS
JRST STATUS ;PROCESS STATUS
VERST: MOVEI AC2,1 ;GET ONE
MOVEM AC2,STATFG ;SET FLAG
AOJ AC7, ;INCR ERROR CTR
MOVEM AC10,LOGCTR ;RESET LOGCTR
JRST STATOT+1 ;GET STATUS ETC
STATIN: GETSTS 15,AC2 ;GET STATUS
SETOM STATFG ;STORE STATUS
STATUS: TTCALL 3,CR ;SKIP LINE
TRNE AC2,WRLOK ;UNIT WRITE LOCKED
JRST WRTLK ;YES PROCESS
TRNE AC2,EOF ;END OF FILE?
JRST ENDOF ;YES PROCESS
TRNE AC2,PARER ;PARITY ERROR
JRST PARERR ;YES PROCESS
TRNE AC2,EOT ;END OF TAPE?
JRST EDOT ;YES PRICESS
TRNE AC2,RECLNG ;BLOCK TO LARGE?
JRST RECLG ;YES PROCESS
TRNE AC2,MISDAT ;MISSED DAT?
JRST MISSDT ;YES PROCESS
WRTLK: POP PDL, ;DROP LAST ADR ON PDL LIST
TTCALL 3,WLK ;TYPE WRITE LOCK MESSAGE
TRZ AC2,WRLOK ;COMPLEMENT BIT
PUSHJ PDL,SETOUT ;SET STATUS
JRST SAME ;TRY WRITE AGAIN
PARERR: TTCALL 3,PARR ;TYPE PARITY ERROR
TRZ AC2,PARER ;COMPLEMENT BIT
DECISN: SKIPL ,STATFG ;SKIP IF INPUT
JRST SETOUT ;SET OUTPUT AND VERIFY STATUS
JRST SETIN ;SET INPUT STATUS
EDOT: TTCALL 3,ENDOT ;TYPE END OF TAPE MESS
TRZ AC2,EOT ;COMPLEMENT BIT
JRST DECISN
RECLG: TTCALL 3,RECLRG ;TYPE RECORD TO LARGE
TRZ AC2,RECLNG ;COMPLEMENT BIT
JRST DECISN ;FINISH PROCESSING
MISSDT: TTCALL 3,MISDT ;TYPE MISSED DATA MESS
TRZ AC2,MISDAT ;COMPLEMENT BIT
JRST DECISN ;FINISH PROCESSING
ENDOF: POP PDL, ;DROP LAST ADR ON PDL LIST
SKIPL ,STATFG ;SKIP IF IN OUTPUT LOOP
JRST ENDVER ;RETURN TOVERIFY LOOP
JRST DMPOUT ;RETURN TO OUTPUT LOOP
SETOUT: TTCALL 3,UNITNA(INDEX) ;TYPE UNIT
JSP AC16,STOCHN ;SET CHANNEL # IN UUO
SETSTS 0,(AC2) ;STORE STATUS
PUSHJ PDL,GENMES ;TYPE GENERAL MESSAGE
POPJ PDL, ;RETURN
SETIN: TTCALL 3,IN1 ;TYPE INPUT
SETSTS 15,(AC2) ;RESET STATUS
JRST SETOUT+3 ;FINISH PROCESSING
GENMES: TTCALL 3,CR ;SKIP LINE
PUSHJ PDL,RECTR ;TYPE RECORD COUNTER
TTCALL 3,EXCONT ;MESS TO CONT OR EXIT
PUSHJ PDL,INCHRS ;GET RESPONSE
JUMPE RES,EXIT ;CR?---YES EXIT
TLNE RES,360000 ;ANS C?
JRST GENMES+2 ;NO--REPEART MESSAGE
POPJ PDL, ;RETURN
;STATUS TELETYPE MESSAGES
WLK: ASCIZ/ UNIT WRITE LOCKED /
EXCONT: ASCIZ/ CONT OR CR TO EXIT: /
PARR: ASCIZ/ PARITY ERROR ON /
ENDOT: ASCIZ/ END OF TAPE ON /
RECLRG: ASCIZ/ RECORD TO LARGE ON /
MISDT: ASCIZ/ DATA MISSED;OR DSK SEARCH ERROR ON /
; EXIT ROUTINE
EXIT: CALL [SIXBIT/EXIT/]
; GENERAL ROUTINES******************
; TTY INITALIZATION AND INPUT ROUTINE INCHRS
TTYINT: INIT 17,0 ;INIT CHANNEL 17
SIXBIT/TTY/ ;TELETYPE
XWD 0,TTYBUF ;ONLY INPUT BUFFER
JRST EXIT ;TELETYPE NOT AVAILABLE
INBUF 17,1 ;ONLY ONE BUFFER
POPJ PDL, ;RETURN
TTYBUF: BLOCK 3
INCHRS: MOVE AC13,CHPNTR ;GET BYTE POINTER
INPUT 17,0 ;READ INPUT
TTYOK: SETZB RES,RES+1 ;ZERO ACS
INNN: ILDB AC6,TTYBUF+1 ;GET CHARACTER
CAIN AC6,15 ;END OF LINE?
POPJ PDL, ;YES
IDPB AC6,AC13 ;DEPOSITE CHAR
JRST INNN ;LOOP OVER INPUT
CHPNTR: POINT 7,RES
; ROUTINE TO CONVERT ASCII TO INTEGER
CONVT: MOVE AC11,ASCPT ;GET ASCII POINTER
SETZB AC3,NUM ;ZERO REGS
ILDB AC7,AC11 ;GET 1ST CHAR
CAIE AC7,"-" ;IS IT NEG?
JRST ANOTH+1 ;NO CONTINUE PROCESSING
SETO AC3, ;YES FLAG NEG
ANOTH: ILDB AC7,AC11 ;GET CHARACTER
CAIL AC7,60 ;TEST IF IT IS A NUMBER
CAILE AC7,71 ;
JRST ENDER ;IT ISN'T--PROCESS
SUBI AC7,60 ;REMOVE OFFSET
ADD AC7,NUM ;ADD TO LOC
IMULI AC7,12 ;MULT BY 10
MOVEM AC7,NUM ;STORE RESULT
JRST ANOTH ;LOOP
ENDER: JUMPE AC7,FINIS ;END OF INPUT STRING
TTCALL 3,ERRCHR ;ERROR IN INPUT MESSAGE
POP PDL,AC15 ;GET RETURN ADR
JRST -3(AC15) ;RETURN
FINIS: IDIVI NUM,12 ;REMOVE LAST MULT
SKIPE ,AC3 ;SKIP IF NEG FLAG NOT SET
MOVNS ,NUM ;GET NEGATIVE RESULT
POPJ PDL, ;RETURN
ASCPT: POINT 7,RES
; ROUTINE TO CONVERT ASCII TO SIXBIT
CVTSIX: MOVE AC10,ASCPT ;GET POINTER
MOVE AC11,SIXPTR ;GET SIXBIT POINTER
SETZ NUM, ;ZERO RESULT
NEXT: ILDB AC12,AC10 ;GET CHARACTER
JUMPE AC12,.+3 ;END OF STRING?
CAIE AC12,"." ;EXTENSION?
CAIN AC12," " ;BLANK-END OF STRING ASSUMED
POPJ PDL, ;RETURN
CAIL AC12,"0" ;CHARACTER WITHIN LEGAL RANGE
CAILE AC12,"Z" ; " " " "
JRST ERRIN ;NO ERROR PROCESS
SUBI AC12,40 ;REMOVE OFFSET
IDPB AC12,AC11 ;STOPE IN NUM
AOJL AC6,NEXT ;LOOP
POPJ PDL, ;RETURN
SIXPTR: POINT 6,NUM
; ERROR ROUTINE FOR CVTSIX--AC7 CONTAINS CTR TO REPROCESS
ERRIN: TTCALL 3,ERRCHR ;TYPE MESSAGE
POP PDL,.+1 ;STORE ADR
JRST 0(AC7) ;RETURN
; RECORD COUNTER MESSAGE
RECTR: TTCALL 3,LOGREC ;TYPE MESS
MOVE AC15,PSYCTR(INDEX) ;GET COUNTER
AOJ AC15, ;ADD ONE
SKIPGE ,STATFG ;INPUT STATUS?
MOVE AC15,PSYIN ;YES SET CTR FOR IN CTR
PUSHJ PDL,DECMAL ;TYPE COUNTER
TTCALL 3,CR ;TYPE CR
POPJ PDL, ;RETURN
LOGREC: ASCIZ/ PHYSICAL RECORD /
; ROUTINE TO CONVERT ASCII TO OCTAL
OCTIN: MOVE AC5,CHPNTR ;GET ASCII POINTER
MOVE AC6,PTROIN ;GET OCTAL POINTER
SETZ NUM, ;ZERO REG
OCTINN: ILDB AC15,AC5 ;GET CHAR
CAIL AC15,60 ;WITH IN LEGAL RANGE
CAILE AC15,71 ;
JRST OCTER ;NO ERROR
SUBI AC15,60 ;REMOVE OFFSET
IDPB AC15,AC6 ;STORE
SOJG AC16,OCTINN ;LOOP
POPJ PDL, ;RETURN
OCTER: TTCALL 3,ERRCHR ;TYPE ERROR MESSAGE
POP PDL,AC15 ;GET RETURN ADR
JRST -5(AC15) ;RETURN
PTROIN: POINT 3,NUM
; ROUTINE TO CONVERT OCTAL TO DECIMAL
DECMAL: SETZ AC6, ;ZERO CTR
DECLOP: JUMPE AC15,DECOUT ;JUMP IF NUM=0
IDIVI AC15,12 ;DIVIDE BY 10
ADDI AC16,60 ;OFFSET REMAINDER
PUSH PDL,AC16 ;STORE ON PUSH DNWN LST
AOJA AC6,DECLOP ;LOOP
DECOUT: JUMPE AC6,DECRET ;RETURN IF ZERO
POP PDL,AC16 ;GET NUMBER
TTCALL 1,AC16 ;TYPE NUMBER
SOJG AC6,DECOUT+1 ;LOOP
DECRET: POPJ PDL, ;RETURN
; ROUTINE TO OUTPUT OCTAL NUMBERS
OCTOUT: MOVEI AC16,^D12 ;SET CTR TO 12
MOVE AC5,OCTPTR ;GET POINTER
LOAD: ILDB AC15,AC5 ;GET CHARACTER
ADDI AC15,60 ;ADD OFFSET
TTCALL 1,AC15 ;TYPE CHARACTER
SOJG AC16,LOAD ;LOOP OVER NUMBER
POPJ PDL, ;RETURN
;OCTRZ ROUTINE SKIPS LEADING ZERO OCTAL DIGITS
OCTRZ: MOVEI AC16,^D12 ;SET UP CTR
MOVE AC5,OCTPTR ;GET OCTAL POINTER
ILDB AC15,AC5 ;GET OCTAL CHARACTER
JUMPN AC15,LOAD+1 ;GO TO OUTPUT LOOP
SOJG AC16,OCTRZ+2
OCTPTR: POINT 3,AC6
; ROUTINE TO DEFINE UNIT
UNITDF: TTCALL 3,UNT ;TYPE UNIT
PUSHJ PDL,INCHRS ;GET RESPONSE
SKIPE ,FLG ;SKIP IF INPUT
JUMPE RES,FINDEF ;END OF DEFINITION
CAIL INDEX,UNITS ;SKIP IF LESS THAN UNITS
JRST ERTOMY ;TYPE ERROR
MOVEM RES,UNITNA(INDEX) ;STORE UNIT NAME
MOVNI AC6,4 ;MAX # OF CHARS
MOVNI AC7,7 ;ERROR RET CTR
PUSHJ PDL,CVTSIX ;CONVERT TO SIXBIT
MOVEM NUM,SPEC+1 ;STORE DEVICE NAME
LSH RES,-^D18 ;SHIFT RESPONSE
CAIN RES,466510 ;MTA?
JRST TAPEE ;YES
JUMPN FLG,UNTRET ;NO---OUTPUT TAPE ONLY
JRST DSKSPC ;YES--DEFINE FILE ETC
UNTRET: POP PDL,AC15 ;GET RETURN ADR
TTCALL 3,TAPONL ;TYPRE TAPE ONLY MESS
JRST -2(AC15) ;TYPE MESSAGE AGAIN
ERTOMY: TTCALL 3,ERTM ;TYPE ERROR
JRST FINDEF ;CONTINUE PROCESSING
DSKSPC: TTCALL 3,FILNAM ;TYPE MESSAGE
PUSHJ PDL,INCHRS ;GET RESPONSE
MOVNI AC6,7 ;SET CHAR CTR
MOVNI AC7,5 ;SET RET ADR
PUSHJ PDL,CVTSIX ;CONVERT TO SIXBIT
MOVEM NUM,FILNA ;STORE FILE NAME
MOVNI AC6,3 ;SET CHAR CTR
MOVNI AC7,11 ;SET RETURN ADR
PUSHJ PDL,CVTSIX+1 ;CONVERT TO SIXBIT
MOVEM NUM,FILEXT ;SAVE FILE EXTENSION
POPJ PDL, ;RETURN
LOOKER: TTCALL 3,LOKER ;TYPE LOOKUP ERROR MESSAGE
JRST INPT ;GIVE EM ANOTHER CHANCE
TAPEE: TTCALL 3,DENMES ;TYPE DENSITY MESS
PUSHJ PDL,INCHRS ;GET RESPONSE
TLNE RES,464000 ;200 BPI?
JRST D556 ;NO
MOVEI AC14,200 ;SET MODE
JRST SET ;STORE IN SPEC
D556: TLNE RES,450000 ;IS IT 556?
JRST D800 ;NO TRY 800 BPI
MOVEI AC14,400 ;SET MODE
JRST SET ;STORE IN SPEC
D800: TLNE RES,434000 ;IS IT 800 BPI?
JRST TAPEE ;NO TRY AGAIN
MOVEI AC14,600 ;SET MODE
SET: SKIPE ,FLG ;INPUT UNIT SKIP!
IORI AC14,1017 ;SET DUMP MODE EVEN PARITY
HRRM AC14,SPEC ;STORE IT
POPJ PDL, ;RETURN
; CODE DEFINITION
CODE: TTCALL 3,CODMES ;TYPE MESSAGE
PUSHJ PDL,INCHRS ;GET RESPONSE
MOVNI AC6,3 ;SET UP ACS
MOVNI AC7,5 ;FOR SIXBIT ROUTINE
PUSHJ PDL,CVTSIX ;CONVERT TO SIXBIT
LSH NUM,-^D18 ;SHIFT
CAIE NUM,572226 ;IS IT O26?
JRST CD29 ;NO TRY 029
STDCOD: MOVE AC6,PTRO26 ;GET CHAR POINTER
JRST CD29+3 ;STORE REST AND EXIT
CD29: CAIE NUM,572231 ;IS IT O29?
JRST CDEB ;NO-TRY EBCDIC
MOVE AC6,PTRO29 ;GET O29 CHAR POINTER
MOVE AC7,OUTBCD ;GET OUTPUT POINTER
JRST CODRET ;STORE AND RETURN
CDEB: CAIE NUM,654542 ;EBCDIC UPPER CASE ONLY?
JRST CDEBL ;NO-TRY EBCDIC UPPER AND LOWER
MOVE AC6,PTREBU ;GET EBCDIC UPPER POINTER
JRST CDEBL+3 ;STORE AND RETURN
CDEBL: CAIE NUM,655445 ;EBCDIC UPPER AND LOWER CASE?
JRST CODE ;NO --TRY AGAIN
MOVE AC6,PTREBL ;GET POINTER
MOVE AC7,OUTEB ;GET EBCDIC OUTPUT POINTER
HRLZI AC5,1B19 ;SET MASK BIT
IORM AC5,STATWD(INDEX) ;SET BIT TO INDICATE EBCDIC
CODRET: MOVEM AC6,GETCHR(INDEX) ;STORE CHAR POINTER
MOVEM AC7,STOCHR(INDEX) ;STORE LEFT HALF OF OUTPUT POINTER
POPJ PDL, ;RETURN
; CODE POINTERS
PTRO26: POINT 6,TAB(AC10),17 ;POINTER TO RETRIEVE CHAR FROMTAB
PTRO29: POINT 6,TAB(AC10),8
PTREBU: POINT 8,TAB(AC10),35
PTREBL: POINT 8,TAB(AC10),26
OUTBCD: POINT 6,0,35
OUTEB: POINT 8,0,35
; TABLES
BUFPTR: BLOCK UNITS ;CONTAINSINITAL ADR OF OUTBUF AND WD CTR
;LEFT HALF CONTAINS NEG # OF WDS ALLOCATED FOR BUFFER
;RIGHT HALF CONTAINS INITAL BUFFER ADR -1
GETCHR: BLOCK UNITS ;CONTAINS BYTE POINTER TO RETRIEVE CHAR
;FROM TAB
; FORMAT OF BYTE POINTERS
;029 POINT 6,TAB(AC10),8
;026 POINT 6,TAB(AC10),17
;EBCDIC POINT 8,TAB(AC10),26 (UPPER AND LOWER CASE)
;EBCDIC POINT 8,TAB(AC10),35 (UPPER CASE ONLY)
STOCHR: BLOCK UNITS ;CONTAIS INCR POINTER TO STORE CHAR IN
;OUTPUT BUFFER
;BCD FORMAT POINT 6,
;EBCDIC FORMAT POINT 8,
; STATUS WORD CONVENTIONS
UNMARK: BLOCK UNITS
;BITS 0,1,2 GROUP AND RECORD MARKERS USED
; 110 GROUP MARKERS USED
; 101 RECORD MARKERS USED
;BITS 3-10 GROUP MARKER CHAR
;BITS 11-18 RECORD MARKER CHAR
;BITS 19-35 # OF LOGICAL RECS PER PHYSICAL REC
;STATUS WORD -STATWD---CONTAINS GENERAL INFORMATION
STATWD: BLOCK UNITS
;BIT 1 =1 EBCDIC
; =0 BCD
;BITS 18-35 CURRENT # OF LOG RECS IN OUTBUF
;BIT 0-SAME OUTPUT BUFFER AS PREVIOS TRANSLATION
; =0 SAME BUFFER AS PREVIOUS OUTPUT
; =1 UNIT HAS ITS OWN OUTPUT BUFFER
;BIT 2-SHOULD OUTPUT BUFFER BE CLEARED
; =0 DON'T CLEAR OUTPUT BUFFER
; =1 CLEAR OUTPUT BUFFER
;BIT 3--FIXED OR VARIABLE LENGTH INPUT LOGICAL RECORDS
; =0 FIXED LENGTH
; =1 VARIABLE LENGTH
;PROGRAM ASSUMES FIXED LENGTH UNTILL OTHERWISE DETECTED
CHLOGR: 0 ;CHARACTERS IN INPUT LOGICAL REC
LST: BLOCK 2 ;OUTPUT LST
INDLOC: 0
;LEFT HALF CONTAINS NEGATIVE # OF UNITS
;RIGTH HALF CONTAINS ZERO
;PUSH DOWN LIST
PDLST: BLOCK 15
;INPUT BUFFER HEADER
INBBUF: BLOCK 3
;OUTPUT UNIT NAME TABLE
UNITNA: BLOCK UNITS
;OUTPUT UNIT SPECS
UNITST: BLOCK UNITS
SPEC: BLOCK 3 ;OPEN UUO SPECS
FILNA: 0 ;FILE NAME FOR LOOKUP UUO
FILEXT: BLOCK 3 ;EXT PG,PJ PROT
LOGCTR: 0
STATFG: 0 ;STATUS FLAG
FILREC: BLOCK UNITS ;# OF FILLER RECS IN LAST PHYSICAL REC
LASTOT: 0 ;PREVIOUS OUTPUT FLG
FINFLG: 0 ;FINISHED FLAG--CLOSE BUFFERS
PSYIN: 0 ;INPUT PHYSICAL REC CTR
PSYCTR: BLOCK UNITS ;OUTPUT PHYSICAL REC CTR
;PHYSICAL RECORD COUNTER FOR OUTPUT
;UNMARK POINTERS
GRPPTR: POINT 8,UNMARK(INDEX),10 ;SETS AND RETRIEVES GROUP MARKER
RECPTR: POINT 8,UNMARK(INDEX),18 ;SETS AND RETRIEVES RECORD MARKER
LOGPTR: POINT 17,UNMARK(INDEX),35 ;GETS LOGICAL RECORD COUNTER
PAGE
;TABLE TO CONVERT ASCII TO BCD(029,026) AND EBCDIC
;TABLE CONFIGURATION
;BITS 0-8 BCD 029 FORMAT
;BITS 9-17 BCD 026 FORMAT
;BITS 18-26 EBCDIC UPPER AND LOWER CASE FORMAT
;BITS 27-35 EBCDIC UPPER CASE ONLY FORMAT
;COMMENT ABOVE TABLE ENTRY--1 ST LETTER ASCII CHAR
; 2 ND LETTER 029 BCD CHAR
; 3 RD LETTER 026 BCD CHAR
; 4 TH LETTER EBCDIC U&L CASE CHAR
; 5 TH LETTER EBCDIC UPPER CASE CHAR
;NOTE DASH SEPERATES CHARACTERS--ALSO IF SPACE IN LETTER POSITION
;INDICATES THAT SET DOES NOT HAVE AN EQUIVALENT CHAR AND
;A BLANK IS INSERTED
;NOTE-- UPPER CASE CHARACTERS USED IN LIEU OF LOWER CASE CHAR
;IN BCD(026&029) AND EBCDIC UPPER CASE ONLY SETS
; - - - - , !- - -!-!, "- - -"-", #- - -#-#,
TAB: EXP 020020100100, 020020132132, 020020177177, 020020173173
; $-$-$-$-$, %- -%-%-%, &- - -&-&, '- - -'-'
EXP 053053133133, 020016154154, 020020120120, 020020175175
; (-(-(-(-(, )-)-)-)-), *-*-*-*-*, +-+-+-+-+
EXP 075034115115, 055074135135, 054054134134, 076060116116
; ,-,-,-,-,, ---------, .-.-.-.-., /-/-/-/-/
EXP 033033153153, 040040140140, 073073113113, 021021141141
; 0-0-0-0-0, 1-1-1-1-1, 2-2-2-2-2, 3-3-3-3-3
EXP 012012360360, 001001361361, 002002362362, 003003363363
; 4-4-4-4-4, 5-5-5-5-5, 6-6-6-6-6, 7-7-7-7-7
EXP 004004364364, 005005365365, 006006366366, 007007367367
; 8-8-8-8-8, 9-9-9-9-9, :- - -:-:, ;-;-;-;-;
EXP 010010370370, 011011371371, 020020172172, 077077136136
; <-<-<-<-<, =-=-=-=-=, >->->->->, ?- - -?-?
EXP 072072114114, 016013176176, 057057156156, 020020157157
; @- - -@-@, A-A-A-A-A, B-B-B-B-B, C-C-C-C-C
EXP 020020174174, 061061301301, 062062302302, 063063303303
; D-D-D-D-D, E-E-E-E-E, F-F-F-F-F, G-G-G-G-G
EXP 064064304304, 065065305305, 066066306306, 067067307307
; H-H-H-H-H, I-I-I-I-I, J-J-J-J-J, K-K-K-K-K
EXP 070070310310, 071071311311, 041041321321, 042042322322
; L-L-L-L-L, M-M-M-M-M, N-N-N-N-N, O-O-O-O-O
EXP 043043323323, 044044324324, 045045325325, 046046326326
; P-P-P-P-P, Q-Q-Q-Q-Q, R-R-R-R-R, S-S-S-S-S
EXP 047047327327, 050050330330, 051051331331, 022022342342
; T-T-T-T-T, U-U-U-U-U, V-V-V-V-V, W-W-W-W-W
EXP 023023343343, 024024344344, 025025345345, 026026346346
; X-X-X-X-X, Y-Y-Y-Y-Y, Z-Z-Z-Z-Z, [-[-[- -
EXP 027027347347, 030030350350, 031031351351, 017017100100
; ]-]-]- - , ^- -^- - , _- - - -
EXP 020020100100, 032032100100, 020055100100, 020020100100
; *******LOWER CASE********
; A-A-A-A-A, B-B-B-B-B, C-C-C-C-C
EXP 020020100100, 061061201301, 062062202302, 063063203303
; D-D-D-D-D, E-E-E-E-E, F-F-F-F-F, G-G-G-G-G
EXP 0640644204304, 065065205305, 066066206306, 067067207307
; H-H-H-H-H, I-I-I-I-I, J-J-J-J-J, K-K-K-K-K
EXP 070070210310, 071071211311, 041041221321, 042042222322
; L-L-L-L-L, M-M-M-M-M, N-N-N-N-N, O-O-O-O-O
EXP 043043223323, 044044224324, 045045225325, 046046226326
; P-P-P-P-P, Q-Q-Q-Q-Q, R-R-R-R-R, S-S-S-S-S
EXP 047047227327, 050050230330, 051051231331, 022022242342
; T-T-T-T-T, U-U-U-U-U, V-V-V-V-V, W-W-W-W-W
EXP 023023243343, 024024244344, 025025245345, 026026246346
; X-X-X-X-X, Y-Y-Y-Y-Y, Z-Z-Z-Z-Z,
EXP 027027247347, 030030250350, 031031251351, 020020100100
; 174, 175, 176, 177
EXP 020020100100, 020020100100, 020020100100, 020020100100
PAGE
;TELETYPE MESSAGES
IN1: ASCIZ/INPUT /
OT1: ASCIZ/OUTPUT /
UNT: ASCIZ/UNIT:/
STD: ASCIZ/ STANDARD OPTION:/
DENMES: ASCIZ/ DENSITY:/
LOKER: ASCIZ/ ?CAN'T FIND INPUT FILE?/
ERRCHR: ASCIZ/ ?ILLEGAL CHARACTER TYPED?/
FILNAM: ASCIZ/ FILE NAME(NAME.EXT):/
GPMRK: ASCIZ/ GROUP MARKER(OCTAL):/
RCMRK: ASCIZ/ RECORD MARKER(OCTAL):/
CODMES: ASCIZ/ CODE BCD(O26,O29) OR EBCDIC(UEB,ULE):/
STDFMT: ASCIZ/ STANDARD FORMAT(A-C OR H):/
SKPMES: ASCIZ / # OF FILES TO SKIP:/
ERRR1M: ASCIZ/ ?EXCEEDED OUTPUT BUFFER AREA---- CALL SYS PROGRAMMER
(INCREASE BCDWDS OR EBCDWD IN EXPAND)?/
ERRR4M: ASCIZ/ ?1 ST OUTPUT DEFINITION AS SAME?/
TAPONL: ASCIZ/ ?OUTPUT ON TAPE ONLY?
/
CR: ASCIZ/
/
CORER: ASCIZ/? EXCEEDED AVAILABLE CORE?/
ERTM: ASCIZ/ ?EXCEEDED PROGRAMABLE UNITS---CALL SYS PROGRAMMER
(INCREASE PARAMETER UNITS)---PROG CONTINUES?/
STDMTS: ASCIZ/ FORMATS AVAILABLE:
A DEFINE BLOCKING FACTOR ETC
B USAEU1 BF:10 GM:32 RM:77 BCD O26
C IBM360 BF:91 EBCDIC
TYPE LETTER OF FORMAT DESIRED: /
PAGE
;ROUTINE TO TYPE DESCRIPTION OF OUTPUT FILE
DESCPT: MOVE AC6,JOBFFP ;GET LOW END OF PROG
CALL AC6,[SIXBIT/CORE/] ;DROP CORE
JFCL 0, ;ERROR RETURN FOR CORE UUO
MOVE INDEX,INDLOC ;SET UP INDEX
HEAD: TTCALL 3,CR2 ;SKIP TWO LINES
TTCALL 3,HEADER ;TYPE HEADER
TTCALL 3,FILDES ;TYPE FILE DESCRIPTION
TTCALL 3,TPDEN ;TYPE TAPE DENSITY
LDB AC10,[POINT 2,UNITST(INDEX),28] ;GET DENSITY BITS
TTCALL 3,D2-1(AC10) ;TYPE DENSITY
TTCALL 3,BPI ;TYPE BPI
TTCALL 3,CRDATE ;TYPE CREATION DATE
CALL AC14,[SIXBIT/DATE/] ;GET DATE
IDIVI AC14,^D31 ;GET DAY
AOJ AC15, ;ADD ONE TO DAY
PUSHJ PDL,DECMAL ;TYPE DAY
IDIVI AC14,^D12 ;GET MONTH
TTCALL 3,MONTH(AC15) ;TYPE MONTH
TTCALL 3,SPACE ;INSERT SPACE
MOVEI AC15,^D1964(AC14) ;CONSTRUCT YEAR
PUSHJ PDL,DECMAL ;TYPE NUMBER
TTCALL 3,CR ;TYPE CR
TTCALL 3,FILNUM ;TYPE FILE NUMBER
TTCALL 3,CODEM ;TYPE CODE OUTPUT
LDB AC10,[POINT 2,GETCHR(INDEX),5] ;GET CODE
CAILE AC10,1 ;SKIP IF EBCDIC
TTCALL 3,CB ;TYPE BCD
CAIGE AC10,2 ;SKIP IF BCD
TTCALL 3,CE ;TYPE EBCDIC
XCT 3,C10(AC10) ;TYPE REST OF MESSAGE
TTCALL 3,CR ;TYPPE CR
TTCALL 3,BKFATR ;TYPE BLOCKING FACTOR
LDB AC15,LOGPTR ;GET BLOCKING FACTOR
PUSHJ PDL,DECMAL ;TYPE #
TTCALL 3,TAB1 ;INSERT TAB
TTCALL 3,TPID ;TYPE TAPE IDENTIFICATION
SKIPL AC7,UNMARK(INDEX) ;GROUP & RECORD MARKERS USED?
JRST TPUNIT ;SKIP PROCESSING
TLNN AC7,1B19 ;GROUP MARKER USED?
JRST RMARKR ;NO
LDB AC6,GRPPTR ;GET GROUP MARKER
TTCALL 3,GPMRK ;TYPE GROUP MARKER
PUSHJ PDL,OCTRZ ;TYPE IT
CAILE AC10,1 ;SKIP IF EBCDIC
TTCALL 3,SPACE ;NO---NEED SPACE FOR BCD
RMARKR: TLNN AC7,1B20 ;RECORD MARKER USED?
JRST TPUNIT-1 ;NO
LDB AC6,RECPTR ;GET RECORD MARKER
TTCALL 3,RCMRK ;TYPE MESS
PUSHJ PDL,OCTRZ ;TYPE OCTAL
TTCALL 3,CR ;CR
TPUNIT: TTCALL 3,TPUT ;TYPE UNIT
TTCALL 3,UNITNA(INDEX) ;TYPE TAPE UNIT
MOVE AC10,STATWD(INDEX) ;GET STATWD
TLNE AC10,1B19 ;BIT 19=0----BCD?
TTCALL 3,S9TK ;NO----EBCDIC
TLNN AC10,1B19 ;SKIP IF BIT 19=1
TTCALL 3,S7TK ;BCD
TTCALL 3,NLOGRC ;TYPE # OF LOGICAL RECORDS
MOVE AC15,LOGCTR ;GET # OF LOGICAL RECS
PUSHJ PDL,DECMAL ;TYPE DECIMAL NUMBER
SKIPN ,FILREC(INDEX) ;ANY FILLER RECS USED?
JRST DCLR ;NO----SKIP
TTCALL 3,FILRC1 ;TYPE BEGINING OF STATEMENT
MOVE AC15,FILREC(INDEX) ;GET # OF FILLER RECS
PUSHJ PDL,DECMAL ;TYPE #
TTCALL 3,FILRC2 ;FINNISH MESSAGE
DCLR: TTCALL 3,DCPLR ;TYPE DATA CHARS/LOG REC
TLNE AC10,1B21 ;FIXED OR VARIABLE LENGTH LOG REC
JRST VAR ;VARIABLE
TTCALL 3,FIXED ;TYPE FIXED---
MOVE AC15,CHLOGR ;GET # OF CHARS
PUSHJ PDL,DECMAL ;TYPE # OF CHARS
TTCALL 3,CHRS ;TYPE REST OF MESSAGE
SKIPA ;SKIP
VAR: TTCALL 3,VAR1 ;TYPE VARIABLE
HDLP: AOBJN INDEX,HEAD ;LOOP OVER UNITS
JRST VERIFY ;VERIFY UNITS
;MESSAGES FOR TAPE LABEL
HEADER: ASCIZ/ BROOKHAVEN NATIONAL LABS
NNCSC,BLD 197
UPTON L.I. N.Y. 11973
TEL: AC(516) 345-2903 OR 2902
/
FILDES: ASCIZ/ FILE DESCRIPTION:
/
FILRC1: ASCIZ/ +( /
FILRC2: ASCIZ/FILLER LOG RECS)/
TPDEN: ASCIZ/ TAPE DENSITY: /
FILNUM: ASCIZ/ TAPE FILE: /
CRDATE: ASCIZ/ CREATION DATE: /
CODEM: ASCIZ/ CODE: /
BPI: ASCIZ/BPI /
BKFATR: ASCIZ/ BLOCKING FACTOR: /
D2: ASCIZ/200 /
D5: ASCIZ/556 /
D8: ASCIZ/800 /
MONTH: ASCIZ/ JAN/
ASCIZ/ FEB/
ASCIZ/ MAR/
ASCIZ/ APR/
ASCIZ/ MAY/
ASCIZ/ JUN/
ASCIZ/ JUL/
ASCIZ/ AUG/
ASCIZ/ SEP/
ASCIZ/ OCT/
ASCIZ/ NOV/
ASCIZ/ DEC/
CB: ASCIZ/ BCD/
CE: ASCIZ/ EBCDIC/
C0: ASCIZ/ UPPER CASE ONLY/
C1: ASCIZ/ UPPER & LOWER CASE/
C2: ASCIZ/ O26/
C3: ASCIZ/ O29/
TPID: ASCIZ/ TAPE IDENTIFICATION:
/
TPUT: ASCIZ/ TAPE UNIT: /
NLOGRC: ASCIZ/ NUM OF LOGICAL RECS: /
DCPLR: ASCIZ/
NUM OF DATA CHARS PER LOG REC: /
CHRS: ASCIZ/ CHARS (NOT INCLUDING MARKERS)
/
FIXED: ASCIZ/FIXED-- /
VAR1: ASCIZ/ VARIABLE
/
C10: TTCALL 3,C0
C20: TTCALL 3,C1
C30: TTCALL 3,C2
C40: TTCALL 3,C3
SPACE: ASCIZ/ /
CR2: ASCIZ/
/
TAB1: ASCIZ/ /
S7TK: ASCIZ/ 7TK /
S9TK: ASCIZ/ 9TK /
PAGE
; ROUTINE TO VERIFY OUTPUT UNITS FOR PARITY ERRORS
VERIFY: MOVE INDEX,INDLOC ;GET INDEX
TTCALL 3,CR2 ;SKIP TWO LINES
TTCALL 3,VERUNT ;TYPE VERIFY UNITS:?
PUSHJ PDL,INCHRS ;GET RESPONSE
JUMPE RES,EXIT ;CR---EXIT
TLNE RES,304000 ;ANS NO?
SKIPA ;NO---SKIP
JRST EXIT ;ANS IS NO----EXIT
TLNE RES,230000 ;ANS YES?
JRST VERIFY+1 ;NO---REPEAT QUESTION
VERLP: MOVEI NUM,1 ;USE ONLY 1 AS BLOCKING FACTOR
PUSHJ PDL,EXPAND ;EXPAND CORE FOR BUFFER
MOVE AC6,BUFPTR ;GET BUFFER POINTER
MOVEM AC6,LST ;STORE IN LIST
VERLP1: TTCALL 3,CR2 ;SKIP 2 LIMES
TTCALL 3,TPUT ;TYPE OUTPUT UNIT
TTCALL 3,UNITNA(INDEX) ;TYPE UNIT NAME
MOVE RES,UNITNA(INDEX) ;GET UNITNAME
MOVNI AC6,4 ;SET UP CVTSIX CTR
SETZM ,AC7 ;ZERO AC7
PUSHJ PDL,CVTSIX ;CONVERT TO SIXBIT
MOVEM NUM,SPEC+1 ;STORE IN SPEC +1
MOVE AC6,UNITST(INDEX) ;GET UNIT STATUS
MOVEM AC6,SPEC ;STORE IN SPEC
JSP AC16,STOCHN ;STORE CHANNEL NUMBER
OPEN 0,SPEC ;OPEN UNIT
JRST EXIT ;SOMEBODY STOLE THE UNIT
MOVE AC6,STATWD(INDEX) ;GET STATWD
TLNN AC6,1B19 ;EBCDIC?
JRST RLOOP ;NO---SKIP MATPE
JSP AC16,STOCHN ;STORE CHANNEL NUMBER
MTAPE 0,101 ;SET FOR 9 TK
RLOOP: SETZB AC10,AC7 ;ZERO CTRS
SETZM ,PSYCTR(INDEX) ;ZERO PHYSICAL REC CTR
HRREI NUM,-2 ;BACKSPACE
PUSHJ PDL,SKPENT ;SKIP
JSP AC16,STOCH1 ;STORE CHANNEL NUMBERS
RLOOP1: INPUT 0,LST ;READ UNIT
STATZ 0,362000 ;CHECK STATUS
PUSHJ PDL,VERST ;ERROR---PROCESS
AOS ,PSYCTR(INDEX) ;INCR PHSICAL REC CTR
AOJA AC10,RLOOP1 ;LOOP
LOOPED: AOBJN INDEX,VERLP1 ;LOOP OVER UNITS
JRST EXIT ;EXIT
;END OF VERIFY LOOP PROCESSING
ENDVER: SOJ AC7, ;-1 FROM ERROR CTR
JUMPE AC7,AOK ;JUMP IF NO ERRORS
TTCALL 3,UNITNA(INDEX) ;TYPE UNIT NAME
TTCALL 3,TAB1 ;TYPE TAB
MOVE AC15,AC7 ;SET UP ERROR CTR FOR DECMAL
PUSHJ PDL,DECMAL ;TYPE # OF ERRORS
SKIPA ;FINISH PROCESSING
AOK: TTCALL 3,NO ;TYPE NO
TTCALL 3,ERRDET ;TYPE ERROR MESS
JRST LOOPED ;CONTINUE VERIFYING
NO: ASCIZ/ NO/
ERRDET: ASCIZ/ ERRORS DETECTED/
VERUNT: ASCIZ/ VERIFY OUTPUT UNITS: /
END BLOCK