TITLE 'TELEFILE ASSEMBLY PROGRAM - APCD' PCC 0 SPACE 6 * %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% * %%%%% MODULE NAME: APCD %%%%% * %%%%% LAST UPDATED: MAR 07, 1984 %%%%% * %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SPACE 2 SPACE 12 * T E L E F I L E P R O P R I E T A R Y P R O D U C T SPACE 2 * THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED * PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION, * DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART, * TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT * SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE * COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF * THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN, * PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN. PAGE SPACE 12 * T E L E F I L E P R O P R I E T A R Y P R O D U C T SPACE 2 * THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED * PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION, * DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART, * TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT * SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE * COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF * THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN, * PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN. PAGE BPMUTS EQU 2 RBM EQU 3 SYS EQU BPMUTS XAPDATA DSECT 0 OVERLAY DATA AREA CAR1 RES 0 CSECT 1 CAR2 RES 0 DO SYS=BPMUTS SYSTEM BPM M:PT 1 GENERATE FPT'S IN PROTECT. TYPE 1 FIN DO SYS=RBM SYSTEM RBM FIN * SYSTEM AP%IL * * EQUATES FOR ABORT AR EQU 0 ABORT REGISTER ABORT13 EQU 13 ABORT14 EQU 14 ABORT15 EQU 15 ABORT16 EQU 16 ABORT17 EQU 17 ABORT18 EQU 18 ABORT19 EQU 19 ABORT20 EQU 20 ABORT23 EQU 23 ABORT24 EQU 24 DEF CAR1,CAR2 DEF IM@READ DEF EOF%FLAG END-OF-FILE FLAG DEF FIN%X1 DEF UPDATE%LINE%COUNT DEF IM@SYS DEF IM@END,IM@COPY DEF READC DEF SYSABN ABNORMAL RETURN ON OPEN F:SYS DEF BUFSI DEF COMPTE%CI DEF LAST%UPDATE,NEXT%UPDATE,PLUS DEF SKIP%COUNT DEF #BLANKS DEF CIRDREGS,CIREC# DEF SYSOPNER DEF CO%REGI,CO%BUF * REF BYX1SIZE REF CNTERM REF CO%IDWDS,CARDSEQ REF CO%SIZE BYTE SIZE OF CO RECORD REF CORRESWD (LO=DO) (LO=C) (SI=C) (----) REF DC%FLAG REF ERR%%C REF ERR%%X1 REF M:SI,M:SO,M:CI,M:CO,M:LO REF IM@NAME REF ACCOUNTS,#ACCTS REF MAJLINE,SUBLINE ASSEMBLY LINE NUMBER REF REWX1 REF SAVAREA REF WRITEDO,WRITELO REF CLRLSTBF,LSTBF REF LINK,ABORT,SYSNAME REF CI%DCB REF ADRDCB,LINE%TYPE REF BLANC REF CO%FLAG,SO%FLAG REF LO%FLAG,LU%FLAG * REF M:C DO SYS=RBM REF M:X1 F:X1 EQU M:X1 REF M:X2,M:X4 ELSE REF F:X1 REF F:X2,F:X2KF REF SO%KEY FIN REF F:SYS REF ERR%%CO,ERR%%SO REF NIVO,FINMAJ,1ERLECTURE%LI REF ERR%%SI,ABN%%X2 REF ROOTEXIT REF UPDT%ERROR REF EODCNT REF EODCNTCI REF ERR%%CI,BA%FLAG * X EQU 1 SR3 EQU 10 R8 EQU 8 R9 EQU 9 X1 EQU 2 X7 EQU 7 NB EQU 5 J EQU 7 RL EQU 7 R EQU 8 R1 EQU 9 VAL1 EQU 10 VAL EQU 11 IOADD EQU 8 IOSIZE EQU 9 IORL EQU 10 LNKR EQU 12 RETRO EQU 13 RETOUR EQU 14 XT EQU 4 TEMP - EVEN XT1 EQU 5 TEMP - ODD XT2 EQU 6 TEMP INDEX * ZERO EQU 0 UN EQU 1 DEUX EQU 2 TROIS EQU 3 MAXSI EQU 80 * SO%KEY%INC EQU 1000 NORMAL 'SO' INCREMENT SO%KEY%INC1 EQU 2 TIGHT 'SO' INCREMENT SO%KEY%LIM EQU 3**24+9900*SO%KEY%INC BREAK FOR NORMAL/TIGHT INC. PAGE USECT CAR1 ZONECI RES 4 BUFSI RES 22 BUFSIEND EQU BUFSI+(MAXSI/4) DO1 SYS=BPMUTS RES 8 COMPTE%CI RES 1 NEXT CI LINE NUMBER LAST%UPDATE RES 1 SECOND LINE # FROM + CARD NEXT%UPDATE RES 1 FIRST LINE # FROM + CARD SKIP%COUNT RES 1 # COMPRESSED LINES TO SKIP UPDATE%LINE%COUNT RES 1 EOF%FLAG RES 1 0= EOF NOT YET FOUND IM@MAJOR EQU MAJLINE MAJOR PART OF LINE NUMBER IM@MINOR EQU SUBLINE SUB-LINE PART OF LINE NUMBER PLUS RES 1 '+' CARD READ IS REQUIRED CI%BSAV RES 27 SAVE AREA FOR CI%BUFR WHEN IN SYST. IM@SYS RES 1 RES ABSVAL(%)&1 BOUND 8 WITH NO ZERO'S GENERATED SYSOPEN EQU % RES 2 DO SYS=BPMUTS RES 1 CODE WORD FOR FILE NAME SYSFILE RES 8 RES 1 CODE WORD FOR ACCOUNT SYSACCT RES 2 FIN MAXSYS EQU 8 STKL EQU 15-7*(SYS=RBM) STACK RES STKL*MAXSYS RES ABSVAL(%)&1 BOUND 8 WITH NO ZERO'S GENERATED SYSSTK RES 2 PAGE * USECT CAR2 * * S T A T I C D A T A * BOUND 8 FIVE%SIX DATA 5,6 EOF-EOT CODES PAGE * IM@READ EQU % LCI 15 SAVE STM,X SAVAREA REGS. LI,X M:SI STW,X ADRDCB TEST%NIVO EQU % MTW,0 NIVO BEZ SUITE%TEST LW,X 1ERLECTURE%LI IS THIS 1ST RECORD IN THE SYSTEM BGZ NIVO%1 NO M:READ *CI%DCB,(BUF,CI%BUFR),(SIZE,120),(WAIT),; (ABN,ERR%%CI),(ERR,ERR%%CI) LB,X CI%BUFR CI,X X'38' BE NIVO%2 THE RECORD IS COMPRESSED CI,X X'18' BE NIVO%2 MTW,+1 1ERLECTURE%LI SET LINE TYPE TO SOURCE LI,X 20 MOVE THE LW,R8 CI%BUFR-1,X LINE TO THE STW,R8 BUFSI-1,X BUFSI AREA BDR,X %-2 B NIVO%3 NIVO%1 RES 0 CI,X 2 IS THIS SYSTEM IN COMPRESSED FORMAT BE APPEL%CI%SI YES M:READ *CI%DCB,(BUF,BUFSI),(SIZE,108-28*(SYS=RBM)),(WAIT),; (ABN,ABN%%SI),(ERR,ABN%%SI) NIVO%3 RES 0 MTW,+1 CIREC# BUMP RECORD NUMBER LI,1 8 GET LH,1 *CI%DCB,1 RECORD SLS,1 -1 SIZE BAL,RETOUR LECT%MAJ%1 FINISH TESTING SI RECORD DO SYS=RBM B BUMP%MAJOR ELSE MTW,+1 IM@MAJOR BUMP MAJOR LINE NUMBER LW,5 CI%DCB DCB ADDRESS B OPT%SO4 BRANCH TO EDIT KEY IF REQUIRED FIN NIVO%2 RES 0 BAL,7 VALIDATE VALIDATE CKSUM & BUMP CIREC# MTW,+2 1ERLECTURE%LI SET LINE TYPE TO COMPRESSED LI,X -27 SET WORD COUNT FOR A FULL RECORD STW,X REG6 APPEL%CI%SI RES 0 BAL,LNKR DECODE%CI%SI B BUMP%MAJOR SUITE%TEST EQU % * LW,R LINE%TYPE CI,R 2 BL GET%SYMBOLIC%LINE BE GET%COMPRESSED%LINE MTW,ZERO FINMAJ BNEZ GET%COMPRESSED%LINE * * * PROCESS CI RECORDS UNTIL NEXT UPDATE POINT IS REACHED. CHOOSE%LINE EQU % LW,R NEXT%UPDATE CW,R COMPTE%CI BG GET%COMPRESSED%LINE BAL,LNKR READ%UPDATE B CHOOSE%LINE * * * READ A COMPRESSED CARD AND DECOMPRESS IT INTO 'BUFSI'. GET%COMPRESSED%LINE EQU % MTW,UN COMPTE%CI MTW,+1 IM@MAJOR BUMP MAJOR LINE NUMBER LI,LNKR 0 AND CLEAR MINOR STW,LNKR IM@MINOR LINE NUMBER BAL,LNKR DECODE%CI%SI MTW,ZERO CO%FLAG BNEZ ECRIRE%CO OPT%SO EQU % * DO SYS=RBM MTW,ZERO SO%FLAG BEZ OPT%SO1 M:WRITE M:SO,(BUF,BUFSI),(SIZE,80),(WAIT),; (ERR,ERR%%SO),(ABN,ERR%%SO) OPT%SO1 RES 0 FIN * DO SYS=BPMUTS * * IF THE 'SO' OPTION WAS SPECIFIED, IT IS TIME TO WRITE THE * SOURCE RECORD SITTING IN 'BUFSI'. * MTW,0 SO%FLAG IF,NE -02- DOIF 'SO' * * MUST WRITE SOURCE RECORD -- EITHER SEQUENTIALLY OR KEYED * LW,XT SO%KEY IF,NE -04- DOIF 'SO' TO KEYED FILE * * TEST KEY FOR LIMITING VALUE -- USE SMALLER INCREMENT * IF OVER LIMIT. * CV,XT SO%KEY%LIM IF,GE -06- DOIF AT OR OVER LIMIT AV,XT SO%KEY%INC1 SMALL INCREMENT ELS 06. AV,XT SO%KEY%INC NORMAL INCREMENT FI -06- STW,XT SO%KEY SAVE NEW KEY M:WRITE M:SO,; (ERR,ERR%%SO),; (ABN,ERR%%SO),; (BUF,BUFSI),; (SIZE,80),; (KEY,SO%KEY),; (NEWKEY),; (WAIT) ELS 04. * * WRITE RECORD TO SEQUENTIAL DEVICE/FILE * M:WRITE M:SO,; (ERR,ERR%%SO),; (ABN,ERR%%SO),; (BUF,BUFSI),; (SIZE,80),; (WAIT) FI -04- FI -02- * * EDIT THE KEY INTO THE LISTING IF THIS IS A KEYED FILE * LW,X LINE%TYPE EDIT ONLY FOR SI CI,X 1 BNE LOAD%REG BRANCH IF NOT SI ONLY LI,5 M:SI DCB ADDRESS OPT%SO4 RES 0 LW,X 5,5 ORGANIZATION FIELD AND,X =X'F0' CI,X X'20' IS ORG KEYED BNE LOAD%REG LW,5 10,5 GET THE LW,R1 0,5 3-BYTE KEY AND,R1 =X'FFFFFF' CLEAN IT LW,R BLANC STW,R BUFSI+18 CLEAR COL'S 73-76 LI,R '.' INSERT THE DECIMAL POINT STB,R BUFSI+19 LI,X 7 OPT%SO2 RES 0 LI,R 0 DW,R =10 AI,R X'F0' STB,R BUFSI+18,X OPT%SO3 RES 0 AI,X -1 CI,X 4 SKIP DECIMAL POINT POSITION BG OPT%SO2 DON'T TERMINATE BEFORE DEC. POINT BE OPT%SO3 SKIP DEC POINT COLUMN CI,R1 0 TERMINATE AFTER LAST BNE OPT%SO2 SIGNIFICANT DIGIT FIN B LOAD%REG BUMP%MAJOR RES 0 MTW,+1 IM@MAJOR LOAD%REG RES 0 RESTORE LCI +15 LM,X SAVAREA B *LINK * * * READ A SYMBOLIC CARD INTO 'BUFSI' & COMPRESS IT IF CO REQUESTED. GET%SYMBOLIC%LINE EQU % BAL,RETOUR LECTURE%MAJ GSL%1 RES 0 MTW,+1 IM@MAJOR GET%SYMBOLIC%LINE1 EQU % MTW,0 CO%FLAG BEZ OPT%SO * * * WRITE COMPRESSED ITEMS TO CO, STARTING WITH THE CARD IN 'ZONECI'. ECRIRE%CO EQU % LCI 3 LM,1 CO%REGI LI,4 -80 B PUT%CHAR BUMP%BLANKS RES 0 MTW,+1 #BLANKS NEXT%OUT RES 0 BIR,4 PUT%CHAR LI,5 X'100' B PUT%CHAR1 LAST%OUT LI,8 2 BAL,7 PUT6BITS LCI 3 STM,1 CO%REGI B OPT%SO * LOCAL %10,%20,%30,%40,%50,%60,%70,%80,%90 LOCAL %85 PUT%CHAR RES 0 LB,5 BUFSI+20,4 PUT%CHAR1 RES 0 CI,5 ' ' BE BUMP%BLANKS LW,6 #BLANKS BEZ %50 LI,8 +7 CI,6 +1 BE %40 LI,8 +5 CI,6 +64 BLE %30 AI,8 +1 AI,6 -64 %30 AI,6 -1 BAL,7 PUT6BITS LW,8 6 %40 RES 0 BAL,7 PUT6BITS LI,6 0 STW,6 #BLANKS %50 CI,5 X'C0' BL %70 BAZ LAST%OUT LB,8 ALFNUM-X'C0'/4,5 BEZ %85 %20 RES 0 BAL,7 PUT6BITS B NEXT%OUT %70 LB,6 SPECIALS %80 CB,5 SPECIALS,6 BE %90 BDR,6 %80 %85 LI,8 4 BAL,7 PUT6BITS LW,8 5 BAL,7 PUT8BITS B NEXT%OUT %90 LI,8 +43 AW,8 6 B %20 * SPECIALS TEXTC '.<(+|&%*);~-/,%ž>:''=' * ALFNUM DATA,1 0,18,19,20,21,22,23,24,25,26,0,0,0,0,0,0,; 0,27,28,29,30,31,32,33,34,35,0,0,0,0,0,0,; 0,0,36,37,38,39,40,41,42,43,0,0,0,0,0,0,; 8,9,10,11,12,13,14,15,16,17,0,0,0,0,0,0 * PUT AN 8-BIT ITEM INTO COMPRESSED RECORD. * PUT A 6-BIT ITEM INTO COMPRESSED RECORD. * REGISTER USAGE: * R1= NUMBER OF BITS LEFT AVAILABLE IN CURRENT CO WORD. * R3= CURRENT CO WORD RIGHT-JUSTIFIED. * R2= CO WORD COUNT LEFT IN CARD (NEGATIBE). * R8= THING TO PUT IN CARD. * R7= LINK REGISTER. * R4= **** MUST BE PRESERVED **** * R5= **** MUST BE PRESERVED **** * R6= **** MUST BE PRESERVED **** PUT8BITS AI,1 -8 BLZ PUT8BIT2 SLS,3 +8 OR,3 8 B 0,7 PUT8BIT2 SLS,3 8,1 CI,2 -1 BNE PUT8BIT3 LI,1 24 B PUT6BIT4 PUT6BITS AI,1 -6 BLZ PUT6BIT2 SLS,3 +6 OR,3 8 B 0,7 PUT6BIT2 SLS,3 6,1 CI,2 -1 BE PUT6BIT3 PUT8BIT3 RES 0 LW,9 8 SLS,9 0,1 OR,3 9 AI,1 32 B PUT6BIT4 PUT6BIT3 LI,1 26 PUT6BIT4 STW,3 CO%BUF+27,2 LW,3 8 BIR,2 0,7 * * WRITE A CO RECORD OUT. * PUT%CO% EQU % * CALCULATE CHECKSUM & PUT IT IN CO RECORD. LI,2 -108 LI,8 0 LB,9 CO%BUF+27,2 AW,8 9 BIR,2 %-2 LI,2 2 STB,8 CO%BUF,2 MTH,0 CO%FLAG IS 'SC' OPTION REQUESTED BEZ PUT%CO%1 NO, OUTPUT AS-IS LCI 4 STM,4 ZONECI SAVE REGISTERS 4-7 LM,6 CO%IDWDS 3 ID WORDS AND CO SEQUENCE NUMBER LCI 3 STM,6 CO%BUF+27 STORE CO ID WORDS AND ZEROES LI,4 HA(CO%BUF)+59 HA OF COLUMN 80 LB,5 CO%FLAG NUMBER OF SEQUENCE NUMBER DIGITS BEZ %+2 BAL,X7 CARDSEQ CONVERT AND STORE SEQUENCE NUMBER LCI 4 LM,4 ZONECI RESTORE REGISTERS MTW,+1 CO%IDWDS+3 BUMP NEXT CO SEQUENCE NUMBER PUT%CO%1 RES 0 * WRITE A CO RECORD. M:WRITE M:CO,; (ERR,ERR%%CO),; (ABN,ERR%%CO),; (BUF,CO%BUF),; (SIZE,*CO%SIZE),; (WAIT) * BLANK OUT THE CO CARD TO ALL ZEROS. LI,8 0 LI,2 26 STW,8 CO%BUF,2 BDR,2 %-1 * CLEAR THE CHECKSUM LI,2 2 STB,8 CO%BUF,2 * BUMP CO CARD COUNT LI,2 1 MTB,+1 CO%BUF,2 * SAY THERE'S A FULL CARD LEFT NOW AND RETURN. LI,2 -26 B 0,7 PAGE * * FINISH UP THE COMPRESSED FILE. * FINSH%CO EQU % * SAVE OUTSIDE REGS; GET INSIDE ONES. LCI 3 STM,1 CO%REGO LM,1 CO%REGI * PUT AN ENDFILE BYTE INTO LAST ACRD. LI,8 3 BAL,7 PUT6BITS * PUT LAST PARTIAL WORD INTO CO CARD BUFFER. SLS,3 0,1 STW,3 CO%BUF+27,2 * PUT A LAST-CARD CODE INTO CO CTLBYTE. LI,2 X'18' STB,2 CO%BUF * WRITE OUT LAST CO RECORD. BAL,7 PUT%CO% LCI 3 LM,1 CO%REGO B *LNKR PAGE USECT CAR1 CO%BUF RES 30 CO%REGO RES 3 CO OUTPUT REGISTERS CO%REGI RES 3 CIREC# RES 1 CI RECORD NUMBER #BLANKS RES 1 # CONSECUTIVE BLANKS FOR DECODE%CI%S * USECT CAR2 PAGE READ%UPDATE EQU % DO SYS=RBM LI,R M:X2 ELSE LI,R F:X2 FIN STW,R ADRDCB * THE CONTROL-RECORDS ARE READ FROM F:X2KF; THE * INFORMATION IN THE CONTROL RECORD IS THEN USED TO PROPERLY * POSITION F:X2 IN ORDER TO READ THE UPDATE RECORDS. MTW,ZERO PLUS BEZ LIRE%X2 MTW,-UN PLUS ZERO SUR PLUS B TEST1%SKIP LIRE%X2 EQU % BAL,RETOUR LECTURE%MAJ MTW,+1 UPDATE%LINE%COUNT LB,R BUFSI CI,R X'4E' CARTE DE CONTROLE? BNE BUMP%MINOR * IF THE CARD WHICH WAS READ IS NOT A CONTROL CARD, * IT IS PLACED IN 'BUFSI' AND (UPDATE%LINE%COUNT) IS BUMPED. TEST1%SKIP EQU % LI,X GET%COMPRESSED%LINE SET EOF EXIT BAL,RETOUR READ%X2KF LH,VAL ZONECI APPEL 1ER DEMI-MOT LI,X UN LH,VAL1 ZONECI,X APPEL 2EME DEMI-MOT BNE COMPAR%VAL%LAST * RETURN VALUES * IN LAST%UPDATE, NEXT%UPDATE, AND SKIP%COUNT. STW,VAL LAST%UPDATE STW,VAL NEXT%UPDATE BAL,RETRO SKIP%COMPRESSED B LOAD%DM BUMP%MINOR RES 0 MTW,+0 CO%FLAG BUMP MINOR LINE NUMBER BNE GSL%1 UNLESS 'CO' IS REQUIRED MTW,+1 IM@MINOR B GET%SYMBOLIC%LINE1 * COMPAR%VAL%LAST EQU % STW,VAL NEXT%UPDATE STW,VAL1 LAST%UPDATE BAL,RETRO SKIP%COMPRESSED LW,VAL1 LAST%UPDATE SW,VAL1 NEXT%UPDATE AI,VAL1 UN STW,VAL1 SKIP%COUNT * USE INFORMATION IN CONTROL-RECORD DOUBLE-WORD TO POSITION * F:X2 FOR THE NEXT READ. LOAD%DM EQU % MTW,+0 ZONECI+2 ARE THERE UPDATE CARDS BEZ POINT%X2 BRANCH IF YES MTW,UN PLUS B *LNKR POINT%X2 EQU % INT,X ZONECI+1 SAVE X2 RECORD NUMBER IN X SW,X UPDATE%LINE%COUNT BEZ *LNKR BLZ PRECORD%BACK AWM,X UPDATE%LINE%COUNT DO SYS=RBM M:PRECORD M:X2,(N,*X),(FWD) ELSE M:PRECORD F:X2,(N,*X),(FWD) FIN B *LNKR PRECORD%BACK EQU % AWM,X UPDATE%LINE%COUNT LCW,X X GET ABS VALUE OF NO. OF RECORDS DO SYS=RBM M:PRECORD M:X2,(N,*X),(REV) ELSE M:PRECORD F:X2,(N,*X),(REV) FIN B *LNKR * * READ%X2KF EQU % DO1 SYS=BPMUTS M:READ F:X2KF,(BUF,ZONECI),(SIZE,12),(ABN,ABNX2KF) DO1 SYS=RBM M:READ M:X4,(BUF,ZONECI),(SIZE,12),(ABN,ABNX2KF) B *RETOUR * PAGE * * HERE MEANS READING OF THE F:X2KF FILE IS FINISHED. ABNX2KF EQU % LB,NB 10 GET ABN CODE FROM SR3. CI,NB +5 QUIT BE ABNOK IF CI,NB +6 NOT BNE SORTIE%ABANDON EOD OR EOF, ABNOK EQU % ELSE OK. BAL,RETRO SKIP%COMPRESSED MTW,+1 FINMAJ B *X * * PRINT A MESSAGE AND THEN EXIT. SORTIE%ABANDON EQU % ABORT ABORT17 ABNORMAL OR ERROR ON M:X4/F:X2KF PAGE * * READ A COMPRESSED CARD AND * DECOMPRESS IT INTO BUFSI. * DECODE%CI%SI EQU % LCI +6 LM,2 CIRDREGS LOAD OURS. #1 STW,3 CI%CARD+20,2 FILL CARD AREA BIR,2 #1 WITH BLANKS. LI,2 -81 INITIALIZE CARD INDEX. #2 BAL,3 GET6BITS GET CI CTRL CODE CI,4 +7 IS IT CHARACTER? BL #4,4 BRANCH IF NO. LB,4 XLATETBL,4 TRANSLATE TO EBCDIC #3 BIR,2 %+2 BUMP CARD INDEX. LI,2 0 RECORD>80 BYTES - IGNORE BEYOND 80 STB,4 CI%CARD+20,2 & STORE INTO CARD. #4 B #2 PADDING. B BADCTRL ERROR; ILLEGAL CI CTRL CODE B USERRTRN END-OF-RECORD. B ENDFILE END-OF-FILE. B #5 8-BIT LITERAL. AI,2 -64 N+1 BLANKS AI,2 +65 N+65 BLANKS BAL,3 GET6BITS GET COUNT AW,2 4 BUMP OUTPUT INDEX TO SKIP BLANKS B #2 #5 BAL,3 GET8BITS PUT 8-BIT LITERAL B #3 INTO CARD & CONTINUE. * GET6BITS EQU % LI,4 +0 CLEAR ANSWER REG. AI,7 -6 ARE 6 BITS AVAILABLE IN REG 5? BLZ #11 BRANCH IF NO. SLD,4 +6 SHIFT THEM INTO ANSWER B 0,3 REG & RETURN GET8BITS EQU % LI,4 +0 CLEAR ANSWER REG. AI,7 -8 ARE 8 BITS AVAILABLE IN REG 5? BLZ #13 BRANCH IF NO. SLD,4 +8 SHIFT THEM INTO ANSWER B 0,3 REG & RETURN #11 BIR,6 #18 BRANCH IF MORE WORDS IN CI BUFFER BAL,7 NEXTCI READ NEW CI RECORD LI,4 0 LI,7 -6 INDICATE STILL 6 BITS TO GET. B #12 GO GET NEW WORD OF BITS. #18 RES 0 SLD,4 +6,7 SHIFT REMAINING BITS INTO ANS REG. #12 LW,5 CI%BUFR+27,6 GET NEXT CI WORD. LCW,7 7 SHIFT REST OF CTRL SLD,4 0,7 CODE BITS INTO LCW,7 7 ANSWER REG. AI,7 +32 COMPUTE REMAINING BITS. B 0,3 RETURN #13 BIR,6 #14 BRANCH IF MORE WORDS IN CI BUFFER. BAL,7 NEXTCI READ NEW CI RECORD LI,4 0 LI,7 -8 INDICATE STILL 8 BITS TO GET. B #12 GO GET NEW WORD OF BITS. #14 SLD,4 +8,7 SHIFT REMAINING BITS INTO ANS REG. B #12 GO GET NEW WORD OF BITS. * NEXTCI EQU % M:READ *CI%DCB,(BUF,CI%BUFR),(SIZE,120),(ERR,ERR%ABN),; (ABN,ERR%ABN),(WAIT) LB,5 CI%BUFR IS RECORD CI,5 X'38' IN CI FORMAT BE VALIDATE CI,5 X'18' MAYBE LAST CARD FORMAT BNE PRINT%ER1 VALIDATE LI,6 1 CHECK RECORD SEQUENCE NUMBER LW,5 CIREC# CB,5 CI%BUFR,6 BE VALID%1 LW,X CI%BUFR CI RECORD CONTROL WORD ABORT ABORT18 SEQUENCE ERROR VALID%1 RES 0 LB,5 CI%BUFR I.D. BYTE AH,5 CI%BUFR SEQUENCE NUMBER LI,6 X'FF' AND,6 CI%BUFR BYTE COUNT AW,5 6 AI,6 -5 ADJUST FOR BYTES NOT IN THE LOOP BEZ VALID%3 BRANCH IF BYTE COUNT IS 5 * VALID%2 RES 0 LB,4 CI%BUFR+1,6 LOOP TO ADD REST OF AW,5 4 RECORD TO CHECKSUM BDR,6 VALID%2 VALID%3 RES 0 LB,4 CI%BUFR+1 BYTE 4 ISN'T IN THE LOOP AW,5 4 LI,6 -26 # WORDS IN THE RECORD - 1 MTW,+1 CIREC# BUMP RECORD NUMBER LI,4 2 COMPARE TO RECORD CB,5 CI%BUFR,4 CHECKSUM BE 0,7 OKAY. EXIT LW,3 CIREC# NUMBER OF NEXT CI RECORD LW,X CI%BUFR CI RECORD CONTROL WORD ABORT ABORT19 CHECKSUM ERROR ENDFILE EQU % CI,2 -81 IS THIS THE FIRST BYTE BNE BADCTRL BRANCH IF NO CI,LNKR SKIP%C2 ARE WE IN SKIP MODE BE BADCTRL BRANCH IF YES ENDFILE1 RES 0 LW,X =' END' STW,X CI%CARD USERRTRN RES 0 LCI +3 SAVE CURRENT REGISTERS FOR STM,5 REGS567 THE NEXT CI RECORD B *LNKR ENDFILE2 RES 0 CI,2 -81 IS THIS THE FIRST BYTE BNE ERR%%CI BRANCH IF NO CI,LNKR SKIP%C2 ARE WE IN SKIP MODE BE ERR%%CI BRANCH IF YES B ENDFILE1 BADCTRL RES 0 LW,3 CIREC# NUMBER OF NEXT CI RECORD ABORT ABORT20 CI CODE ERROR * ERR%ABN EQU % LB,NB SR3 ERROR OR ABN CODE CI,NB 6 IS IT EOF BE ERR%ABN2 YES CI,NB 5 IS IT EOD BNE ERR%%CI NO MTW,0 EODCNTCI YES, IS THIS THE 1ST EOD BNEZ ERR%ABN2 NO MTW,1 EODCNTCI YES, COUNT IT B NEXTCI GO READ AGAIN ERR%ABN2 RES 0 MTW,+0 CIREC# TEST FOR FIRST READ BGZ ENDFILE2 NO MTW,0 BA%FLAG YES, BA SPECIFIED BNEZ ROOTEXIT YES, NORMAL TERMINATION ABORT ABORT13 NO, ABORT WITH MISSING CI XLATETBL EQU %-1 DATA ' ' LAST BLANK IS 1ST ENTRY. TEXT '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' TEXT '.<(+|&%*);~-/,%ž>:''=' CIREGS DATA -20,' ',0,0,0,0 USECT CAR1 CIRDREGS EQU % RES 3 REGS567 RES 1 REG6 RES 1 REG7 RES 1 CI%BUFR RES,1 120 CI%CARD EQU BUFSI USECT CAR2 * PAGE * * * SKIP NUMBER OF COMPRESSED RECORDS INDICATED BY * CONTROL RECORD; ALSO INCREMENT CI%LINE%COUNT. SKIP%COMPRESSED EQU % LW,R1 SKIP%COUNT EXIT IF NO COMPRESSED LINES BEZ *RETRO TO SKIP AWM,R1 COMPTE%CI ADD COUNT TO COMPRESSED LINE COUNT STW,LNKR VAL SAVE LNKR MTW,+0 CO%FLAG BUMP MAJOR LINE NUMBER BNEZ SKIP%C1 UNLESS 'CO' IS REQUESTED AWM,R1 IM@MAJOR SKIP%C1 RES 0 BAL,LNKR DECODE%CI%SI SKIP A COMPRESSED LINE SKIP%C2 RES 0 LABEL USED AS A FLAG IN DECODE%CI%SI MTW,-1 SKIP%COUNT BGZ SKIP%C1 LW,LNKR VAL RESTORE LNKR B *RETRO PAGE * * READ A SYMBOLIC RECORD INTO THE 'BUFSI' AREA * LECTURE%MAJ EQU % LW,1 EOF%FLAG HAS END-OF-FILE BEEN READ BNEZ ABNSI10 BRIF YES * M:READ *ADRDCB,(BUF,BUFSI),(SIZE,120-40*(SYS=RBM)),; (ABN,LECTURE%MAJ%ABN),(ERR,LECTURE%MAJ%ABN) LB,1 BUFSI AND,1 =X'DB' TEST FOR A BINARY CI,1 X'18' OR COMPRESSED RECORD BE PRINT%ER2 LI,1 8 GET LH,1 *ADRDCB,1 RECORD SLS,1 -1 LENGTH LECT%MAJ%1 RES 0 AI,1 -MAXSI BGEZ *RETOUR LI,R1 X'40' BLANK AI,1 -1 LAST LB,R BUFSIEND,1 CHARACTER. CI,R X'15' IS IT LF? BE ZAP%LF%CR BRANCH IF YES. CI,R X'0D' IS IT CR? BNE SUITE%ZAP BRANCH IF NO. ZAP%LF%CR EQU % STB,R1 BUFSIEND,1 CR WITH BLANK SUITE%ZAP EQU % BIR,1 ZAP%LF%CR BLANK BALANCE OF RECORD B *RETOUR * LECTURE%MAJ%ABN RES 0 LW,X ADRDCB CI,X M:SI IS ERROR ON 'SI' BNE ABN%%X2 NO ABN%%SI RES 0 LB,X SR3 CLM,X FIVE%SIX EOD OR EOF ACCEPTABLE *D-CD BOL ERR%%SI - ERROR ON ANYTHING ELSE. *D-CD * *D-CD MTW,0 NIVO *D-CD IF,EZ EITHER TERMINATES SYSTEM *D-CD MTW,0 EODCNT NEED TWO TO TERMINATE SOURCE, *D-CD IF,EZ HOWEVER. *D-CD MTW,+1 EODCNT BUMP EOD COUNT B LECTURE%MAJ GO RE-READ * *D-CD FI *D-CD MTW,+1 EOF%FLAG SET END-OF-FILE FLAG LW,X IM@MAJOR TEST FOR FIRST CARD READ OR,X IM@MINOR BNEZ ABNSI10 NOT FIRST MTW,+0 BA%FLAG BATCH ASSEMBLIES BNEZ ROOTEXIT YES, NORMAL TERMINATION /10770/B-08773 ABORT ABORT14 NO, ABORT WITH MISSING SI FI *D-CD ABNSI10 RES 0 LI,1 -ENDMSIZE - SIZE OF 'END' MESSAGE LW,SR3 ENDMSG+ENDMSIZE,1 MOVE THE 'END' MESSAGE STW,SR3 BUFSI+ENDMSIZE,1 TO BUFSI BIR,1 %-2 LI,1 ENDMSIZE*4-80 - BYTES REMAINING IN BUFSI LI,R1 X'40' LI,RETOUR BUMP%MAJOR SET EXIT FROM LECTURE%MAJOR B ZAP%LF%CR ENDMSG TEXT ' END * END STATEMENT SUPPLIED BY AP *' ENDMSIZE EQU %-ENDMSG PAGE * PRINT ERROR MESSAGE ER1. PRINT%ER1 EQU % LW,3 CIREC# RECORD NUMBER LW,X CI%BUFR CI RECORD CONTROL WORD ABORT ABORT23 ILLEGAL I.D. PRINT%ER2 RES 0 ABORT ABORT24 COMPRESSED RECORD IN SI FILE PAGE LOCAL %10,%20,%30 LOCAL %08,X1 X1 EQU 1 X2 EQU 2 IM@COPY EQU % LCI +15 SAVE CALLER'S STM,1 SAVAREA REGISTERS LI,X1 +1 STW,X1 IM@SYS MTW,+1 NIVO BUMP LEVEL #. LW,X1 NIVO IF IT'S CI,X1 MAXSYS TOO BIG, BG 2MANYSYS QUIT. CI,X1 +1 BG %08 LD,R8 STKINIT INITIALIZE STACK DBLWORD STD,R8 SYSSTK LD,R8 SYSINIT INITIALIZE 'OPEN' FPT STD,R8 SYSOPEN DO SYS=BPMUTS LD,R8 SYSINIT1 STW,R8 SYSFILE-1 CONTROL WORD FOR FILE NAME STW,R9 SYSACCT-1 CONTROL WORD FOR ACCOUNT NAME FIN LI,X1 F:SYS STW,X1 CI%DCB LI,X1 27 LW,R8 CI%BUFR-1,X1 STW,R8 CI%BSAV-1,X1 BDR,X1 %-2 %08 RES 0 BAL,X1 CLOSESYS CLOSE F:SYS IF IT'S OPEN %10 LW,R8 CIREC# SAVE CURRENT LW,R9 1ERLECTURE%LI LINE TYPE STB,R9 R8 PSW,R8 SYSSTK CI POSITION. LW,R8 IM@MAJOR SAVE PSW,R8 SYSSTK LINE #. LI,R8 0 STW,R8 1ERLECTURE%LI CLEAR LINE TYPE STW,R8 CIREC# CLEAR RECORD NUMBER STW,R8 IM@MAJOR LCI +3 SAVE CURRENT LM,X1 REGS567 CI REGS. PSM,X1 SYSSTK DO SYS=RBM LW,X1 F:SYS+5 SAVE CURRENT FILE NAME LW,X1+1 F:SYS+6 AND AREA LI,X1+2 X'3F00' AND,X1+2 F:SYS+1 LCI 3 PSM,X1 SYSSTK LW,R8 BLANC BLANK OUT FILE NAME IN STW,R8 F:SYS+5 STW,R8 F:SYS+6 LB,X1 IM@NAME MOVE FILE NAME INTO DCB CI,X1 8 AND IN SYS NAME FOR 'ABORT' BLE %+2 LI,X1 8 TRUNCATE FILE NAME TO 8 CHARS STB,X1 IM@NAME LW,X2 IM@NAME AND,X2 L(X'FFFFFF') AW,X2 X1 %20 AI,X2 -1 LB,R8 0,X2 AI,X1 -1 STB,R8 F:SYS+5,X1 BGZ %20 ELSE LCI +8 SAVE CURRENT LM,X1 SYSFILE FILE NAME. PSM,X1 SYSSTK LCI +2 SAVE LM,X1 SYSACCT CURRENT PSM,X1 SYSSTK ACCT. LI,X1 +8 BLANK OUT LW,R8 BLANC FILE STW,R8 SYSFILE-1,X1 NAME BDR,X1 %-2 AREA LB,X1 IM@NAME MOVE CI,X1 31 BLE %+2 LIMIT SYSTEM NAME TO 31 CHARS LI,X1 31 STB,X1 IM@NAME STB,X1 SYSFILE FILE LW,X2 IM@NAME NAME AND,X2 =X'FFFFFF' INTO AW,X2 X1 FPT %20 AI,X2 -1 FILE LB,R8 0,X2 NAME STB,R8 SYSFILE,X1 AREA. BDR,X1 %20 FIN LW,R8 NIVO MOVE SYSTEM NAME IF ON LEVEL ONE CI,R8 1 BNE ENDMOVE MOVESYSNAME RES 0 AI,X1 1 LB,R8 0,X2 STB,R8 SYSNAME,X1 AI,X2 1 CB,X1 IM@NAME BL MOVESYSNAME STB,X1 SYSNAME ENDMOVE RES 0 LI,X1 0 DO SYS=RBM %30 LB,R8 ACCOUNTS,X1 SLS,R8 8 LW,R9 L(X'3F00') STS,R8 F:SYS+1 ELSE %30 LD,R8 ACCOUNTS,X1 TRY TO STW,R8 SYSACCT FIND STW,R9 SYSACCT+1 THE FIN CAL1,1 SYSOPEN FILE DO SYS=RBM /27492/*D-CD M:REW F:SYS,(WAIT) /27492/*D-CD FIN /27492/*D-CD B FOUNDIT BY SYSABN LB,SR3 SR3 OPENING CI,SR3 X'03' WITH EACH BNE SYSOPNER POTENTIAL ACCOUNT AI,X1 1 CW,X1 #ACCTS BL %30 LI,X1 0 STW,X1 IM@SYS B IM@END1 CAN'T FIND. RECOVER & RETURN * FOUNDIT LCI +6 START CI LM,X1 CIREGS ROUTINE WITH STM,X1 CIRDREGS FRESH REGS. B RESTORE RESTORE REGS AND EXIT * FCDBIT EQU X'00200000' 'OPEN' BIT IN THE DCB CLOSESYS RES 0 CLOSE F:SYS DBC IF IT'S OPEN LW,R8 F:SYS CW,R8 =FCDBIT TEST FOR DCB OPEN BAZ 0,X1 IT'S ALREADY CLOSED M:CLOSE F:SYS B 0,X1 BOUND 8 STKINIT DATA STACK-1 DATA,2 STKL*MAXSYS,0 SYSINIT GEN,8,24 X'14',F:SYS DATA SYS=BPMUTS * DATA WORDS TO INITIALIZE FPT FOR BPMUTS SYSINIT1 DATA X'01000808' FILE-NAME,NOT-LAST,SIG.,SIZE DATA X'02010202' ACCOUNT,LAST,SIG.,SIZE PAGE LOCAL %08,%10,X1 X1 EQU 1 IM@END LCI 15 STM,1 SAVAREA IM@END1 RES 0 MTW,-1 NIVO BGZ %08 BLZ ENDITALL LI,X1 27 LW,R8 CI%BSAV-1,X1 STW,R8 CI%BUFR-1,X1 BDR,X1 %-2 LI,X1 M:CI STW,X1 CI%DCB %08 RES 0 BAL,X1 CLOSESYS CLOSE F:SYS IF IT'S OPEN DO SYS=RBM %10 LCI 3 RECOVER PREVIOUS FILE NAME PLM,X1 SYSSTK AND AREA STW,X1 F:SYS+5 STW,X1+1 F:SYS+6 LW,R8 X1+2 LW,R9 L(X'3F00') STS,R8 F:SYS+1 ELSE %10 LCI +2 RECOVER PREVIOUS PLM,X1 SYSSTK STW,X1 SYSACCT ACCT STW,X2 SYSACCT+1 NUMBER. LCI +8 RECOVER PLM,X1 SYSSTK PREVIOUS LCI +8 FILE STM,X1 SYSFILE NAME. FIN LCI +3 RECOVER PLM,X1 SYSSTK PREVIOUS LCI +3 CI STM,X1 REGS567 REGS. PLW,X1 SYSSTK RECOVER STW,X1 IM@MAJOR LINE #. PLW,X1 SYSSTK RECOVER LB,R8 X1 PREVIOUS STW,R8 1ERLECTURE%LI LINE TYPE AND,X1 =X'FFFFFF' AND STW,X1 CIREC# PREVIOUS RECORD #. MTW,0 NIVO BEZ RESTORE CAL1,1 SYSOPEN OPEN PREVIOUS FILE. AI,X1 -1 POSITION BEZ IM@END3 M:PRECORD *CI%DCB,(N,*X1),(FWD) IM@END3 RES 0 M:READ *CI%DCB,(BUF,CI%BUFR),(SIZE,120) B RESTORE RESTORE REGS AND EXIT * ENDITALL RES 0 LW,X1 LINE%TYPE IS SI,CI REQUESTED CI,X1 2 BAZ ENDITALL1 BRANCH IF ONLY SI BAL,RETRO SKIP%COMPRESSED LB,R8 CI%BUFR IS LAST RECORD ALREADY READ CI,R8 X'18' BE ENDITALL2 YES, NO PROBLEM LCI +6 LM,2 CIRDREGS THE NEXT BYTE MUST BE END-FILE BAL,3 GET6BITS GET THE NEXT CONTROL BYTE CI,4 3 TEST FOR END-FILE BNE BADCTRL ENDITALL2 RES 0 LW,X1 LINE%TYPE CI,X1 3 BNE ENDITALL1 NOT SI,CI LW,X FINMAJ BRANCH IF EOF WAS FOUND BGZ ENDITALL1 ON X2KF FILE LI,X ENDITALL4 SET EOF EXIT BAL,RETOUR READ%X2KF B ENDITALL6 NO EOF ON X2KF ENDITALL4 RES 0 M:READ *ADRDCB,(BUF,BUFSI),(SIZE,108-28*(SYS=RBM)),; (ABN,ENDITALL5),(ERR,ENDITALL5) LB,X BUFSI MAKE SURE CURRENT UPDATE GROUP CI,X '+' IS FINISHED BE ENDITALL1 YES, IT'S FINISHED ENDITALL6 RES 0 BAL,RL CLRLSTBF CLEAR LSTBF AREA LB,X1 UPDATE%LINE%ERR BYTE COUNT ENDITALL3 RES 0 LB,IOADD UPDATE%LINE%ERR,X1 STB,IOADD LSTBF,X1 MOVE NEXT BYTE OF MESSAGE BDR,X1 ENDITALL3 MTW,+1 UPDT%ERROR LI,IOADD LSTBF LB,IOSIZE UPDATE%LINE%ERR BAL,IORL WRITEDO LW,X1 LO%FLAG OR,X1 LU%FLAG BEZ ENDITALL1 BAL,IORL WRITELO ENDITALL1 RES 0 MTW,0 CO%FLAG BEZ RESTORE BAL,LNKR FINSH%CO B RESTORE RESTORE REGS AND EXIT ENDITALL5 RES 0 LB,NB 10 MAKE SURE ABN OR ERR CODE CI,NB 5 IS EOD OR EOF BE ENDITALL1 CI,NB 6 TEST FOR EOF BE ENDITALL1 B ENDITALL6 SYSOPNER EQU % ABORT ABORT15 ERROR OR ABN WHEN OPENING F:SYS 2MANYSYS RES 0 ABORT ABORT16 SYSTEMS NESTED TOO DEEPLY UPDATE%LINE%ERR RES 0 TEXTC 'UPDATE LINE NUMBERS EXCEED COMPRESSED FILE ' PAGE * * R E A D C * PERFORM READ OF CN CONTROL COMMAND * READC RES 0 LCI 15 STM,1 SAVAREA SAVE REGISTERS LH,XT2 DC%FLAG CI,XT2 2 IF,NE NORMAL - READ FROM C DEVICE M:READ M:C,; (ERR,ERR%%C),; (ABN,ABN%%C),; (BUF,BUFSI),; (SIZE,80),; (WAIT) LI,XT 8 LH,X M:C,XT SLS,X -1 ARS BAL,RETOUR LECT%MAJ%1 FILL RECORD & STRIP CR OR LF LI,XT 1 MTB,0 CORRESWD,XT IF,EZ DON'T ECHO ON SAME DEVICE LCI 10 LM,1 BUFSI STM,1 LSTBF+1 LM,1 BUFSI+10 STM,1 LSTBF+11 LW,XT BLANC STW,XT LSTBF LI,IOADD LSTBF LI,IOSIZE 84 BAL,IORL WRITELO FI ELS INIT HAD TO GET THEM OUT OF THE WAY M:READ F:X1,; (ERR,ERR%%X1),; (ABN,ABN%%X1),; (BUF,BUFSI),; (SIZE,80),; (WAIT) FI LCI 15 LM,1 SAVAREA RESTORE REGISTERS EXIT IORL * * A B N % % X 1 * ABN%%X1 RES 0 LB,XT SR3 CLM,XT FIVE%SIX CHECK FOR EOF OR EOT ON X1 BOL ERR%%X1 OTHER ERROR - STD. HANDLING * CALL FIN%X1 B CNTERM * * A B N % % C * ABN%%C RES 0 LB,XT SR3 CLM,XT FIVE%SIX CHECK FOR EOF OR EOT ON C BOL ERR%%C OTHER ERROR - STD. HANDLING * B CNTERM * * * F I N % X 1 * FIN%X1 RES 0 BAL,IORL REWX1 * DO SYS=RBM M:DEVICE F:X1,; CHANGE BACK FOR ENCODED TEXT (SIZE,BYX1SIZE),; (ORG,UNBLOCK) FIN * EXIT * END