|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 42934 (0xa7b6)
Notes: pts_type(SC)
Names: »NYCONV.SC«
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
└─⟦this⟧ »DEN10/NYCONV.SC«
IDENT NYCONV NJ-AMT 830225/EV BATCH TRANSMISSION 82-11-10/EV 820506/NJ UPD 82-02-22/EV UPD 81-08-27/EV UPD 80-12-12/SHB UPD 80-07-14/JAER DDUM DEDDIV PDIV ENTRY DECONV EXT DEPOOL EXT TESTB EXT EMPTYT EXT DERROR EXT ATTDEV ATTACH DEVICE EXT ATTPRT EXT DETPRT EXT MASK EXT GETFWD EXT ADJUST EXT FDIO * EXT DCSGON EXT DCSGOF EXT DCSEND * EJECT * * KEYTABLE * CLR EQU X'8F' CLEAR CAN EQU X'91' CANCEL RET EQU X'98' RETURN ENT EQU X'8C' ENTER * KEYTAB KTAB CLR,CAN,RET,ENT * * STIMO EQU X'0B' ATTACH EQU X'0E' DETACH EQU X'0F' TRPAR EQU X'00' EJECT * THIS MODULE TAKE CARES OF THE DIFFERENT CONVERTIONS- * -METHODS * ONE OF THEM IS ALREADY PREPAIRED FOR YOUR PRINTOUT). * THE OTHER YOU HAVE TO CODE YOURSELVES. * FORMAL PARAMETERS: FC = FUNCTION-CODE (DEVICE-CLASS) * = 1 DATACOMMUNICATION OUT * = 2 DATACOMMUNICATION IN * = 3 CASETTE OUTPUT * = 4 PRINTOUT LP/GP * = 5 DISCFILE * = 6 FLOPPYDISC FILE * = 7 DELETE BATCHES ON USERFILE * = 8 FREEZE BATCHES ON USER FILE * = 9 LISTING LP/GP * TYPE = TYPE OF HANDLING * = 1 OPEN * = 2 BATCHHEAD-RECORD * = 3 DATA RECORD * = 4 BALANCE RECORD * = 5 CLOSE * RETCON = RETURN-CODE * = 0 OK * /= 0 ERROR MESSAGE-NUMBER * =-1 SKIP CURR BATCH, GO TO NEXT * =-2 SKIP TO BALANCE * =-3 RESTART CURRENT BATCH (CANCEL) * =-4 ABORT CONVERSION (RETURN) * =-5 DELETE THIS BATCH * =-6 GET CURRENT RECORD * INPUT VARIABLE: BIN4 = FC-CODE FOR DEVICE EJECT DECONV PROC FC,TYPE,RETCON IB FC,TRANSM,RECEIV,CASSET JUMP ON DEVICE-CLASS C PRINTA,DISCFD,FLOPPY,DELETE,FREEZE,LISTE RECEIV DISCFD CASSET ERROR MOVE RETCON,W4 'FUNCTION NOT ALLOWED? B RETURN * * THIS IS THE PRINTOUT FUNCTION * PRINTA IB TYPE,PR100,PR200,PR200 JUMP ON TYPE 0F HANDLING C PR200,PR500 B ERROR * * OPEN DEVICE = ATTACH PRINTER * PR100 PERF ATTDEV,BIN6 ATTACH DEVICE BOK DECOOK B RETURN EJECT * * * PRINTOUT OF THE DIFFERENT RECORD TYPES * PR200 EDWRT DEDSPRT,FCOUNT BNOK PR298 MOVE DEBINW3,W1 PRINT DEDSPRT,DEBINW3,W0 BNOK PR298 B DECOOK PR298 MOVE RETCON,=W'35' OUTPUT DEVICE NOT OP....' B RETURN GO AND CLOSE * * CLOSE DEVICE = DETACH PRINTER * PR500 PERF DETPRT DETACH DEVICE B RETURN EJECT * * THIS ROUTINE DELETE BATCHES ON THE USERFILE * DELETE IB TYPE,DECOOK,DEL100 B DECOOK DEL100 MOVE RETCON,=W'-5' CBNE WORK(W8),W0,DEL110 NOT THE WHOLE FILE MOVE DATE,HEX00 RESET DATE DEL110 B RETURN EJECT * * THIS ROUTINE FREEZE BATCHES ON USER FILE * FREEZE IB TYPE,FRE100,FRE200,FRE300 OPEN BATCHHEAD DATA C FRE400,FRE500 BALANCE CLOSE * OPEN FRE100 B DECOOK FRE200 B DECOOK FRE300 B DECOOK * BALANCE RECORD FRE400 B DECOOK * CLOSE FRE500 B DECOOK EJECT * * OK * DECOOK MOVE RETCON,W0 RETURN RET EJECT * * BATCH TRANSMISSION * TRANSM MOVE BTYPE,TYPE IB TYPE,DC100,DC200,DC300 OPEN,BATCHHEAD,DATA C DC400,DC500 BALANCE,CLOSE * REQLEN REQUESTED LENGTH * RECLGD MAX RECORD LENGTH * DCBUF DCBUFFER * REQDC BUFFER POINTER * * SEND SOF * SEND '001'+DATE * DC100 TBT DCBAB,DC170 MOVE BIN4,W20 DSC1 DSDCFD,ATTACH,BIN4 ATTACH DEVICE DC BNOK DCERR PERF GETBUF GET 3 CONSECUTIVE BUFFERS B DC110 OK B DCERR ERROR DC110 DC140 MOVE BCDI21(W5),=D'0' RECORD COUNT MOVE WORK(W15),W0 LENGTH HEADER MOVE WORK(W17),W0 LENGTH RECORD NO MOVE WORK(W19),W0 LENGTH SEQUENCE NO CLEAR BCONT CONTINUATION MARK CLEAR BSUPR SET SPLITFL NORMAL SPLIT MOVE BIN6,=X'0036' FILE CODE PRINTER PERF ATTDEV,BIN6 ATTACH DEVICE BNOK DC335 MOVE STRG10A,HEX00 GETTIME STRG10A MOVE TIME,STRG10A EDWRT DEDSPRT,FDCHDR MOVE BIN4,TSKADR DSC1 DSDCFD,TRPAR,BIN4 PASS DCADR TO DRIVER BNOK DCERR MOVE REQLEN,=W'504' DCREQLEN MOVE RECLGD,=D'128' OR =D'080' ??????? MOVE DCBUF,=C' ' MOVE REQDC,W0 BUFFER POINTER EDSUB DCBUF,REQDC,SNDFRM2 PERF DCRVOL READ VOLUME LABEL B DC150 OK B DCERR ERR DC150 IB DEBINW2,DC160,DC180,DC170 CLR,CAN,RET * ENT DC160 PERF DCSGON SIGN ON B DC165 OK B DCERR ERROR DC165 B DECOOK OK DC170 MOVE RETCON,=W'-4' ABORT CONVERSION B DCERRT DCERR MOVE RETCON,=W'53' OUTP. DEV. NOT OPERABLE DCERRT DSC1 DSDCFD,TRPAR,W0 SET DCBAB B RETURN DC180 DSC1 DSDCFD,TRPAR,W0 PASS DCADR 0 B RETURN EJECT * * BATCHEAD RECORD * DC200 TBT DCBAB,DC330 TBF BDAFOR,DC300 ANY FORCED FIELDS? EDWRT DEDSPRT,FBATC3 PRINT ERROR REPORT SET DCBAB MOVE RETCON,=W'-1' GET NEXT BATCH B RETURN DC300 TBT DCBAB,DC330 CBE TYPE,W4,DC305 PRINTING CBE TYPE,W2,DC305 PRINTING B DC308 NO PRINTING DC305 * PRINT BATCH HEAD AND BALANCE RECORD MOVE DEBINW3,W1 PRINT DEDSPRT,DEBINW3,W0 BNOK DC335 DC308 MOVE BIN10,WORK(W13) GET BUFFER INDEX MOVE BIN9,BIN10 GET BPOOL INDEX ADD BIN9,W1 MOVE BIN8,W0 RESET FIELD NUMBER TBT DCBAB,DC330 ABORTION DC310 MOVE BIN4,W0 DC311 PERF CONV,BIN4,FC B DECOOK ALL DONE B DC340 WRITE BLOCKS B DC315 CUMP FIELD EMPTHY B DC320 BCD FIELD OVERFLOW B DC320 EDIT BUFFER OVERFLOW DC315 MOVE RETCON,W5 B DCERRT DC320 MOVE RETCON,=W'54' EDIT ERROR B DCERRT * * DC330 MOVE RETCON,=W'-4' ABORT B RETURN * * DC335 MOVE RETCON,=W'35' B RETURN * * WRITE BLOCKS * DC340 PERF DCWRIT,FC,TYPE,RETCON B DC310 OK B DC360 ERROR B DC360 EOE MOVE BIN4,W1 CONTINUE IN SAME BUFFER B DC311 DC360 *???????? ERROR, SEND TERMINATE ??????? B DCERR EJECT DC400 * BALANCE FORMAT B DC300 DC500 TBT DCBAB,DC560 ABORT PERF DCSGOF B DC510 B DCERR DC510 MOVE STRG10A,HEX00 GETTIME STRG10A MOVE TIME,STRG10A EDWRT DEDSPRT,FDCEND DC550 CLEAR DCBAB DSC1 DSDCFD,TRPAR,W0 PASS DCADR 0 MOVE BIN4,W0 DSC1 DSDCFD,DETACH,BIN4 PERF DETPRT * RELEAS BUFFERS PERF DEPOOL,W6,BIN10,BIN4,STRG10A B DECOOK DC560 MOVE STRG10A,HEX00 GETTIME STRG10A MOVE TIME,STRG10A EDWRT DEDSPRT,FDCERR B DC550 EJECT * * LISTING * LISTE MOVE BTYPE,TYPE IB TYPE,LS100,LS200,LS300, OPEN,BATCHHEAD,DATA, C LS400,LS500 BALANCE,CLOSE LS100 TBT LSBAB,LS170 PERF GETBUF GET 3 CONSECUTIVE BUFFERS B LS110 OK B LSERR ERROR LS110 MOVE BCDI21(W5),=D'0' RECORD COUNT MOVE WORK(W15),W0 LENGTH HEADER MOVE WORK(W17),W0 LENGTH RECORD NO MOVE WORK(W19),W0 LENGTH SEQUENCE NO CLEAR BCONT CONTINUATION MARK CLEAR BSUPR CLEAR SPLITFL NNO SPLIT CLEAR FIRSTFL INITIATE FIRST RECORD PERF ATTDEV,BIN6 ATTACH DEVICE BNOK LSERR MOVE STRG10A,HEX00 GETTIME STRG10A MOVE TIME,STRG10A EDWRT DEDSPRT,FLSHDR MOVE RECLGD,=D'112' * ENT B DECOOK OK LS170 MOVE RETCON,=W'-4' ABORT CONVERSION B LSERRT LSERR MOVE RETCON,=W'35' OUTPUT DEV NOT OPERABLE LSERRT SET LSBAB B RETURN * * BATCHEAD RECORD * LS200 TBT LSBAB,LS170 TBF BDAFOR,LS250 ANY FORCED FIELDS? EDWRT DEDSPRT,FBATC3 PRINT ERROR REPORT SET LSBAB MOVE RETCON,=W'-1' GET NEXT BATCH B RETURN LS250 BATCHHEAD OR BALANCE TBT LSBAB,LS170 MOVE DEBINW3,W1 PRINT DEDSPRT,DEBINW3,W0 BNOK LSERR * CONVERT HEADER TO SET CONVERSION INDICATIONS LS220 MOVE BIN10,WORK(W13) GET BUFFER INDEX MOVE BIN9,BIN10 GET BPOOL INDEX ADD BIN9,W1 MOVE BIN8,W0 RESET FIELD NO MOVE BIN4,W0 LS210 PERF CONV,BIN4,FC B DECOOK ALL DONE B LS210 NOT ALL DONE B LS315 COMP FIELD EMPTY B LS320 BCD FIELD OVERFLOW B LS320 EDIT BUFFER OVERFLOW B DECOOK LS300 TBT FDBAB,LS170 MOVE BIN10,WORK(W13) GET BUFFER INDEX MOVE BIN9,BIN10 GET BPOOL INDEX ADD BIN9,W1 MOVE BIN8,W0 RESET FIELD NUMBER LS310 MOVE BIN4,W0 LS311 PERF CONV,BIN4,FC B DECOOK ALL DONE B LS340 WRITE BLOCKS B LS315 CUMP FIELD EMPTY B LS320 BCD FIELD OVERFLOW B LS320 EDIT BUFFER OVERFLOW LS315 MOVE RETCON,W5 B LSERRT LS320 MOVE RETCON,=W'54' B LSERRT * WRITE BLOCKS LS340 PERF LSWRIT,FC,TYPE,RETCON B LS310 OK B LS310 DUMMY B LS310 DUMMY MOVE BIN4,W1 CONTINUE IN SAME BUFFER B LS311 LS400 * BALANCE FORMAT B LS250 LS500 MOVE BIN10,WORK(W13) GET BUFFER INDEX TBT FDBAB,LS560 ABORT B LS570 LS550 CLEAR LSBAB MOVE BIN4,W0 PERF DETPRT * RELEAS BUFFERS PERF DEPOOL,W6,BIN10,BIN4,STRG10A B DECOOK LS560 MOVE STRG10A,HEX00 GETTIME STRG10A MOVE TIME,STRG10A EDWRT DEDSPRT,FLSERR B LS550 LS570 MOVE STRG10A,HEX00 GETTIME STRG10A MOVE TIME,STRG10A EDWRT DEDSPRT,FLSEND B LS550 EJECT * * FLOPPY DUMPING * FLOPPY MOVE BTYPE,TYPE IB TYPE,FD100,FD200,FD300 OPEN,BATCHHEAD,DATA C FD400,FD500 BALANCE,CLOSE * * SEND SOF * SEND '001'+DATE * FD100 TBT FDBAB,FD170 PERF GETBUF GET 3 CONSECUTIVE BUFFERS B FD110 OK B FDERR ERROR FD110 MOVE CWFD,W7 HDR RECORD MOVE REQFD,=W'128' CALL FDIO,DSFD,X'A1',BPOOL(BIN10),REQFD,CWFD OPEN MOVE BIN4,W20 DSC1 DSFD,ATTACH,BIN4 ATTACH DEVICE FD BNOK FDERR PERF FDLOAD B FD140 OK B FDERR ERROR FD140 MOVE BCDI21(W5),=D'0' RECORD COUNT MOVE WORK(W15),W0 LENGTH HEADER MOVE WORK(W17),W0 LENGTH RECORD NO MOVE WORK(W19),W0 LENGTH SEQUENCE NO CLEAR BCONT CONTINUATION MARK CLEAR BSUPR SET SPLITFL NORMAL SPLIT MOVE BIN6,=X'0036' FILE CODE PRINTER PERF ATTDEV,BIN6 ATTACH DEVICE BNOK FDERR MOVE STRG10A,HEX00 GETTIME STRG10A MOVE TIME,STRG10A EDWRT DEDSPRT,FFDHDR PERF FDRVOL READ VOLUME LABEL B FD150 OK B FDERR ERR FD150 IB DEBINW2,FD160,FD180,FD170 CLR,CAN,RET * ENT FD160 MOVE STR8A,STR8B SAVE FILE NAME MOVE FDCNT,W1 RESET FD COUNTER PERF FDWVOL WRITE VOLUME LABEL B FD165 OK B FDERR ERROR FD165 B DECOOK OK FD170 MOVE RETCON,=W'-4' ABORT CONVERSION B FDERRT FDERR MOVE RETCON,=W'35' OUTP. DEV. NOT OPERABLE FDERRT SET FDBAB B RETURN FD180 MOVE CWFD,W7 MOVE REQFD,=W'128' CALL FDIO,DSFD,X'B8',BPOOL(BIN10),REQFD,CWFD *UNLOAD HDR1 MOVE RETCON,=W'55' CHANGE FD B RETURN EJECT * * BATCHEAD RECORD * FD200 TBT FDBAB,FD170 TBF BDAFOR,FD300 ANY FORCED FIELDS? EDWRT DEDSPRT,FBATC3 PRINT ERROR REPORT SET FDBAB MOVE RETCON,=W'-1' GET NEXT BATCH B RETURN FD300 TBT FDBAB,FD170 TBT FDEOF,FDEOF10 CBE TYPE,W4,FD305 PRINTING CBE TYPE,W2,FD305 PRINTING B FD308 NO PRINTING FD305 * PRINT BATCH HEAD AND BALANCE RECORD MOVE DEBINW3,W1 PRINT DEDSPRT,DEBINW3,W0 BNOK FDERR FD308 MOVE BIN10,WORK(W13) GET BUFFER INDEX MOVE BIN9,BIN10 GET BPOOL INDEX ADD BIN9,W1 MOVE BIN8,W0 RESET FIELD NUMBER FD310 MOVE BIN4,W0 FD311 PERF CONV,BIN4,FC B DECOOK ALL DONE B FD340 WRITE BLOCKS B FD315 CUMP FIELD EMPTHY B FD320 BCD FIELD OVERFLOW B FD320 EDIT BUFFER OVERFLOW FD315 MOVE RETCON,W5 B FDERRT FD320 MOVE RETCON,=W'54' EDIT ERROR B FDERRT * * WRITE BLOCKS * FD340 PERF FDWRIT,FC,TYPE,RETCON B FD310 OK B FD360 ERROR B FDEOF05 EOE MOVE BIN4,W1 CONTINUE IN SAME BUFFER B FD311 FD350 PERF FDLOAD B FD370 OK B FD360 ERROR FD360 MOVE REQFD,=W'128' MOVE CWFD,W7 CALL FDIO,DSFD,X'B8',BPOOL(BIN10),REQFD,CWFD UNLOAD FD365 MOVE DEBINW4,=W'55' CHANGE FLOPPYDISK PERF DERROR,KEYTAB IB DEBINW2,FD350,FD360,FD170 CLR,CAN,RET B FD350 ENT FD370 PERF FDRVOL READ VOLUME LABEL B FD375 OK B FD360 ERROR FD375 IB DEBINW2,FD380,FD360,FD170 CLR,CAN,RET * ENT FD380 PERF FDWVOL WRITE VOLUME LABEL B FD382 OK B FD360 ERROE FD382 TBF FDEOF,FD340 NOT EOF MOVE RETCON,=W'-6' GET CURRENT RECORD B RETURN FDEOF05 SET FDEOF INDICATE EOF MOVE WORK(W14),BIN8 SAVE FIELD NO B FD360 FDEOF10 CLEAR FDEOF MOVE BIN10,WORK(W13) GET BUFFER INDEX MOVE BIN9,BIN10 GET BPOOL INDEX ADD BIN9,W1 MOVE BIN8,WORK(W14) GET FIELD NO MOVE REQFD,=W'128' MOVE CWFD,W0 CALL FDIO,DSFD,X'06',BPOOL(BIN10),REQFD,CWFD WRITE BLOCKS B FD340 EJECT FD400 * BALANCE FORMAT B FD300 FD500 TBT FDBAB,FD560 ABORT FD505 ***PERF FDWRIT B FD570 OK B FDERR ERR B FD510 EOE FD510 MOVE REQFD,=W'128' MOVE CWFD,W7 CALL FDIO,DSFD,X'B8',BPOOL(BIN10),REQFD,CWFD UNLOAD FD515 MOVE DEBINW4,=W'55' CHANGE FLOPPYDISK PERF DERROR,KEYTAB IB DEBINW2,FD520,FD510,FD170 CLR,CAN,RET FD520 PERF FDLOAD B FD525 OK B FD510 ERROR FD525 PERF FDRVOL READ VOLUME LABEL B FD530 OK B FD510 ERROR FD530 IB DEBINW2,FD535,FD510,FD170 CLR,CAN,RET * ENT FD535 PERF FDWVOL WRITE VOLUME LABEL B FD540 OK B FD510 ERROR FD540 MOVE REQFD,=W'128' MOVE CWFD,W0 CALL FDIO,DSFD,X'06',BPOOL(BIN10),REQFD,CWFD WRITE BLOCKS B FD505 FD550 WAIT DSFD CLEAR FDBAB MOVE CWFD,W7 HDR SECTOR MOVE REQFD,=W'128' CALL FDIO,DSFD,X'B8',BPOOL(BIN10),REQFD,CWFD UNLOAD CLEAR FDEOF RESET EOF MOVE CWFD,W7 MOVE REQFD,=W'128' CALL FDIO,DSFD,X'A2',BPOOL(BIN10),REQFD,CWFD CLOSE MOVE BIN4,W0 DSC1 DSFD,DETACH,BIN4 PERF DETPRT * RELEAS BUFFERS PERF DEPOOL,W6,BIN10,BIN4,STRG10A B DECOOK FD560 MOVE STRG10A,HEX00 GETTIME STRG10A MOVE TIME,STRG10A EDWRT DEDSPRT,FFDERR B FD550 FD570 MOVE STRG10A,HEX00 GETTIME STRG10A MOVE TIME,STRG10A EDWRT DEDSPRT,FFDEND B FD550 PEND EJECT * * GETBUF GET TWO CONSECUTIVE BUFFERS * * BUFFER INDEX IN WORK(W13) * GETBUF PROC MOVE BIN10,W3 TOTAL NUMBER OF BUFFERS MOVE BIN4,W3 NO. OF COSECUTIVE BUFFERS PERF DEPOOL,W2,BIN10,BIN4,STRG10A GET 3 COSECUTIVE BUFFERS BNOK GETBU2 NO BUFFERS AVAIBLE MOVE WORK(W13),BIN10 SAVE BUFFER INDEX MOVE BIN9,BIN10 LOAD WORKING BUFFER INDEX ADD BIN9,W1 INDEX EDIT BUFFER MOVE BPOOL(BIN10),=X'00' RESET TRANSMIT BUFFER RET GETBU2 RET 2 PEND EJECT * * FDRVOL READ VOLUME LABEL AND DISPLAY * FDRVOL PROC MOVE REQFD,=W'128' MOVE BIN13,BIN10 GET BUFFER INDEX ADD BIN13,W2 ADJUST FOR READ BUFFER MOVE CWFD,W7 CALL FDIO,DSFD,X'91',BPOOL(BIN13),REQFD,CWFD READ (HDR1) XSTAT DSFD,BIN4 MOVE BIN7,=X'086F' CALL MASK,BIN4,BIN7 BNOK FDRV02 MOVE BIN7,=W'66' XCOPY STR6A,W0,W6,BPOOL(BIN13),BIN7 EXPIRATION DATE XCOPY STR8A,W0,W8,BPOOL(BIN13),W5 GET FILE NAME MOVE BIN7,W22 GET RECORD LENGTH XCOPY STR6B,W1,W5,BPOOL(BIN13),BIN7 MOVE RECLGD,STR6B MOVE BIN7,=W'45' XCOPY STR2A,W0,W2,BPOOL(BIN13),BIN7 GET FD NUMBER ATTFMT FCAS02 SET DEPROMPT DISPLAY 0,W1,W0 THOME MOVE DEBINW3,W1 REQUESTED LENGTH NKI .NE,DEDSDYKB,STR1A,KEYTAB,DEBINW3,DEBINW2 RET FDRV02 RET 2 PEND EJECT * * FDWVOL WRITE VOLUME LABEL * FDWVOL PROC MOVE BIN7,=W'66' MOVE BIN13,BIN10 GET BUFFER INDEX ADD BIN13,W2 ADJUST FOR READ BUFFER EDSUB BPOOL(BIN13),BIN7,FRMVOL2 DATE MOVE BIN7,W5 EDSUB BPOOL(BIN13),BIN7,FRMVOL1 VOLUME NAME MOVE BIN7,=W'45' EDSUB BPOOL(BIN13),BIN7,FRMVOL3 FD NUMBER MOVE REQFD,=W'128' REQUESTED LENGTH MOVE CWFD,W7 CALL FDIO,DSFD,X'95',BPOOL(BIN13),REQFD,CWFD WRITE (HDR1) XSTAT DSFD,BIN4 MOVE BIN7,=X'024F' CALL MASK,BIN4,BIN7 BNOK FDWVO2 ADD FDCNT,=D'1' UPDATE FD NUMBER MOVE CWFD,=W'26' HDR RECORD MOVE REQFD,=W'128' REQUESTED LENGTH CALL FDIO,DSFD,X'B1',BPOOL(BIN13),REQFD,CWFD REWIND RET FDWVO2 RET 2 PEND EJECT * * LSWRIT WRITE BLOCKS * LSWRIT PROC FC,TYPE,RETCON PERF BAWRIT,FC,TYPE,RETCON RET RET 2 RET 4 RET 6 PEND EJECT * * FDWRIT WRITE BLOCKS * FDWRIT PROC FC,TYPE,RETCON FDWR00 WAIT DSFD XSTAT DSFD,BIN4 CALL TESTB,BIN4,W2 EOE BZ FDWR10 RET 4 END OF EXTENT FDWR10 MOVE BIN7,=X'024F' CALL MASK,BIN4,BIN7 BERR FDWR20 IB BTYPE,FDWROP,FDWRHD,FDWRDATA,FDWRBAL,FDWRCL FDWROP FDWRCL B FDWR20 FDWRHD BATCH HEADER MOVE BPOOL(BIN10),=X'00' INITIATE OUTPUT BUFFER MOVE BIN4,RECLGD XCOPY BPOOL(BIN10),W0,BIN4,BPOOL(BIN9),W0 PERF FDSEND RET RET 2 FDWRBAL MOVE BPOOL(BIN10),=X'00' INITIATE OUTPUT BUFFER EDIT BPOOL(BIN9),FFD999 MOVE BIN4,RECLGD XCOPY BPOOL(BIN10),W0,BIN4,BPOOL(BIN9),W0 PERF FDSEND RET * FDWRDATA PERF BAWRIT,FC,TYPE,RETCON RET FDWR20 RET 2 RET 4 RET 6 B FDWR00 REPEAT PEND EJECT * * FDLOAD LOAD FD PROCEDURE * FDLOAD PROC MOVE CWFD,W7 HDR RECORD MOVE REQFD,=W'128' CALL FDIO,DSFD,X'B7',BPOOL(BIN10),REQFD,CWFD LOAD XSTAT DSFD,BIN4 CALL TESTB,BIN4,W5 IBM BZ FDLOA2 MOVE BIN7,=X'000F' CALL MASK,BIN4,BIN7 BNOK FDLOA2 RET FDLOA2 MOVE CWFD,W7 HDR RECORD MOVE REQFD,=W'128' CALL FDIO,DSFD,X'B8',BPOOL(BIN10),REQFD,CWFD UNLOAD RET 2 PEND EJECT * * DCRVOL DISPLAY * DCRVOL PROC ATTFMT SNDFRM SET DEPROMPT DISPLAY 0,W1,W0 THOME MOVE DEBINW3,W1 REQUESTED LENGTH NKI .NE,DEDSDYKB,STR1A,KEYTAB,DEBINW3,DEBINW2 RET DCRV02 RET 2 PEND EJECT * * BAWRIT WRITE BLOCKS * BAWRIT PROC FC,TYPE,RETCON BAWR00 * BIN16 NO OF CHARS TO SEND * BIN4 AVAILABLE SPACE IN OUTPUT BUFFER * DEBIN3 LENGTH OF HEADER * BIN15 ACTUAL LENGTH OF INPUT DATA USED CMP BIN16,W0 BE BAWRRET NODATA=NOWRITE MOVE BIN4,RECLGD SET RECORD LENGTH ADD BCDI21(W5),=D'1' ADD 1 TO RECORD NO ADD BCDI21(W4),=D'1' ADD 1 TO SEQUENCE NO CBE BCDI21(W4),=D'1',BAWR50 * NOT FIRST TIME (SEQUENCE NO > 1) * COPY HEADER PART, LENGTH IN WORK(W15) SUB BIN4,WORK(W15) MAKE ROOM FOR HEADER MOVE DEBIN3,WORK(W15) START POINT B BAWR55 BAWR50 * FIRST OUTPUT RECORD FOR THIS INPUT RECORD MOVE DEBIN3,W0 START POINT * BAWR55 CBL BIN16,BIN4,BAWR58 ROOM FOR EVERYTING? NO ROOM TBT SPLITFL,BAWR57 NORMAL SPLIT FIND PRECEDING & MOVE DEBIN1,BIN4 START AT END OF RECORD MOVE STR2A,=C'&&' LOOK FOR & BAWR56 SUB DEBIN1,W1 CBNG DEBIN1,W0,BAWR57 NO & MOVE DEBIN2,DEBIN1 MATCH BPOOL(BIN9),DEBIN2,W1,STR2A,W0,W1 BNOK BAWR56 NOT FOUND MOVE BIN15,DEBIN2 B BAWR59 *NORMAL SPLIT BAWR57 MOVE BIN15,BIN4 B BAWR59 * NO OF CHARS, FIT IN AVAILABLE ROOM BAWR58 MOVE BIN15,BIN16 SEND ALL CHARS * BAWR59 XCOPY BPOOL(BIN10),DEBIN3,BIN15,BPOOL(BIN9),W0 COPY FIRST * MOVE BLANKS INTO REMAINING PART OF OUTPUT BUFFER * BIN4 = NO OF CHARS IN OUTPUT BUFFER MOVE BIN4,BIN15 ADD BIN4,DEBIN3 ADD HEADER * MOVE DEBIN1,RECLGD SUB DEBIN1,BIN4 NO OF BLANKS XCOPY BPOOL(BIN10),BIN4,DEBIN1,BPOOL(BIN9),BIN16 MOVE BLANKS * BAWR60 * INSERT RECORD NO - BCDI21(W5) CBE WORK(W17),W0,BAWR70 SKIP IF LENGTH ZERO MOVE STRG10A,BCDI21(W5) CONVERT RECORD NO MOVE DEBIN1,W10 LENGTH FIELD SUB DEBIN1,WORK(W17) FIND START OF NO XCOPY BPOOL(BIN10),WORK(W16),WORK(W17),STRG10A,DEBIN1 * BAWR70 * INSERT SEQUENCE NO - BCDI21(W4) CBE WORK(W19),W0,BAWR80 SKIPIF LENGTH ZERO MOVE STRG10A,BCDI21(W4) CONVERT SEQUENCE NO MOVE DEBIN1,W10 LENGTH FIELD SUB DEBIN1,WORK(W19) FIELD START OF NO XCOPY BPOOL(BIN10),WORK(W18),WORK(W19),STRG10A,DEBIN1 * BAWR80 * HANDLE END OF RECORD CBG BIN16,BIN15,BAWR100 NO ROOM, CONT * INSERT EOR * CBE FC,W6,BAWR85 FD CBE FC,W1,BAWR85 DC B BAWRSEND BAWR85 MOVE STR2A,=X'7F' EOR CHAR XCOPY BPOOL(BIN10),BIN4,W1,STR2A,W1 INSERT EOR ADD BIN4,W1 * FLOPPY DISK B BAWRSEND * BAWR100 * IB FC, C DCWR105, SEND BATCH C BAWR105, DUMMY C BAWR105, DUMMY C BAWR105, DUMMY C BAWR105, DUMMY C FDWR105, FLOPPY CONVERSION C BAWR105, DUMMY C BAWR105, DUMMY C LSWR105 LISTING B BAWR105 DCWR105 PERF DCSEND,FC,TYPE,RETCON B BAWR105 * FDWR105 * CHECK IF CONTINUATION CHAR NEEDED TBF BCONT,FDWR150 * CONTINUATION MOVE DEBIN1,RECLGD CBNE BIN4,DEBIN1,FDWR140 SUB BIN4,W1 SUB BIN15,W1 FDWR140 MOVE STR2A,=X'21' CONTINUATION MARK XCOPY BPOOL(BIN10),BIN4,W1,STR2A,W1 FDWR150 PERF FDSEND B BAWR105 * LSWR105 PERF LSSEND B BAWR105 * BAWR105 MOVE CWFD,W0 DELETE BPOOL(BIN9),CWFD,BIN15 DELETE WHAT IS SEND SUB BIN16,BIN15 MOVE BIN13,BIN16 CMP VSEIND,W1 BE BAWR110 WRITE RESET OF BUFFER RET 6 * BAWR110 REPEAT IB FC, C BAWR111, SEND BATCH C BAWR111, DUMMY C BAWR111, DUMMY C BAWR111, DUMMY C BAWR111, DUMMY C BAWR112, FD C BAWR111, DUMMY C BAWR111, DUMMY C BAWR111 LISTE * BAWR111 REPEAT INSIDE B BAWR00 * BAWR112 REPEAT OUTSIDE RET 8 * * * BAWRSEND * IB FC, C DCWR205, SEND BATCH C BAWR205, DUMMY C BAWR205, DUMMY C BAWR205, DUMMY C BAWR205, DUMMY C FDWR205, FLOPPY CONVERSION C BAWR205, DUMMY C BAWR205, DUMMY C LSWR205 LISTING B BAWR205 DCWR205 PERF DCSEND,FC,TYPE,RETCON B BAWR205 B BAWRERR * FDWR205 PERF FDSEND B BAWR205 B BAWRERR * LSWR205 PERF LSSEND B BAWR205 B BAWRERR * BAWR205 BAWRRET RET BAWRERR RET 2 PEND EJECT LSSEND PROC INSRT BPOOL(BIN10),W0,W2,INSERT,W0 MOVE DEBIN1,RECLGD ADD DEBIN1,W2 WRITE DEDSPRT,BPOOL(BIN10),DEBIN1 DLETE BPOOL(BIN10),W0,W2 RET PEND EJECT FDSEND PROC MOVE REQFD,=W'128' MOVE CWFD,W0 CALL FDIO,DSFD,X'06',BPOOL(BIN10),REQFD,CWFD RET PEND EJECT * * DCWRIT WRITE BLOCKS * DCWRIT PROC FC,TYPE,RETCON * DCWR00 CBNE TYPE,W4,DCWR010 MOVE BIN4,W0 EDSUB BPOOL(BIN10),BIN4,FDC999 PERF DCSEND,FC,TYPE,RETCON RET RET 2 DCWR010 MOVE BIN4,=W'600' DSC1 .NW,DSDCFD,STIMO,BIN4 * PERF BAWRIT,FC,TYPE,RETCON RET DCWRERR RET 2 RET 4 RET 6 B DCWR00 REPEAT PEND EJECT * * CONVERSI0N OF DATA ENTRY RECORDS TO BPOOL BUFFER * RET =RECORD CONVERTED * RET 2 =TRANSMIT * RET 4 =CUMPULSORY FIELD EMPTHY * RET 6 =BCD-FIELD OVERFLOW * RET 8 =EDIT BUFFER OVERFLOW * * APPL = FIELD INTO BUFFER * APPL = 1 FIELD INTO BUFFER, TRANSMIT BLOCK * APPL = 2 NO TRANSMIT FIELD * APPL = 3 SUPPRESS LEADING ZEROES (IF HEADER:SETR GENEREL) * APPL = 4 LENGTH OF FIELD=MAXL (IF HEADER: SET GENERAL) * LISTE: ALWAYS SET * FOLLOWING APPL ONLY USED IN BATCHHEADER * APPL = 13 EOR-CHAR AS END OF EACH RECORD * LISTE: ALWAYS CLEAR * APPL = 14 CONT-CHAR IN END OF EACH DATA RECORD WHICH IS CONTINUED * LISTE: ALWAYS CLEAR * APPL = 15 INSERT BACHNAME IN THIS FIELD * APPL = 16 FIELDS (STARTING WITH &) ARE NOT SPLIT * LSTE: ALWAYS CLEAR * * APPL = 1XXX XXX=LENGTH OF RECORD HEADER * APPL = 2XXX THIS FIELD IS THE RECORD NUMBER FIELD * APPL = 3XXX THIS FIELD IS THE CONTINUATION SEQUENCE NUMBER FIELD * * BIN4 = WORK ITEM * BIN7 = MAX LENGTH * BIN8 = FIELD NUMBER * BIN9 = INDEX TO EDIT BUFFER * BIN13= DELETE START POINTER * BIN16= EDIT POINTER * * BIN15 = NO OF CHAR INSERTED IN OUTPUT RECORD * STRG10A = WORK STRING FOR DATE/TIME/CONVERTED BCD * WORK(W15) = LENGTH OF HEADER * WORK(W16) = RECORD NUMBER POSITION * WORK(W17) = RECORD NUMBER LENGTH * WORK(W18) = CONTINUATION SEQUENCE POSITION * WORD(W19) = CONTINUATION SEQUENCE LENGTH * BCDI21(W4) = CONTINUATION SEQUENCE NUMBER * BCDI21(W5) = RECORD NUMBER * CONV PROC CONT,FC CBG CONT,W0,CON100 CON090 MOVE BPOOL(BIN9),=X'20' MOVE BCDI21(W4),=D'0' RESET SEQUENCE NO MOVE BIN13,W0 RESET DELETE POINTER MOVE BIN16,BIN13 LOAD EDIT POINTER CON100 CLEAR FSUPR TBF BSUPR,CON105 SET FSUPR CON105 ADD BIN8,W1 UPDATE FIELD NUMBER CALL GETFWD,BIN7,2,BIN8,BIN4 CALL ADJUST,BIN7 BOK CON130 BN CONRET ALL FIELD DONE B CONER1 COMPULSORY FIELD EMPTHY CON130 GETCTL 0,VSEIND GET APPL * CBL VSEIND,=W'1000',CON131 NORMAL APPL VALUE CBL VSEIND,=W'2000',APL1000 HANDLE RECORD HEADER CBL VSEIND,=W'3000',APL2000 HANDLE RECORD NO CBL VSEIND,=W'4000',APL3000 HANDLE SEQUENCE NO MOVE VSEIND,W2 CLEAR ERROR APPL B CON131 * * HANDLE RECORD HEADER: * APPL=1000, WHERE XXX=LENGTH OF RECORD HEADER APL1000 SUB VSEIND,=W'1000' MOVE WORK(W15),VSEIND WORK(W15) = LENGTH OF HEADER SET FIRSTFL FIRST TIME B CON100 * * HANDLE POSITION AND LENGTH OF RECORD NO APL2000 MOVE WORK(W16),BIN16 SET START POS OF RECORD NO GETCTL 1,BIN7 GET MAXL OF FIELD MOVE WORK(W17),BIN7 SET LENGTH OF RECORD NO SUB VSEIND,=W'2000' ADJUST APPL VALUE B CON131 FURTHER HANDLING * * HANDLE POSITION AND LENGTH OF SEQUENCE NO APL3000 MOVE WORK(W18),BIN16 SET START POSITION OF SEQUENCE NO GETCTL 1,BIN7 GET MAXL OF FIELD MOVE WORK(W19),BIN7 SET LENGTH OF SEQUENCE NO SUB VSEIND,=W'3000' ADJUST APPL VALUE B CON131 FURTHER HANDLING * * CON131 * CBNE BTYPE,W3,CON150 * DATA RECORD IB VSEIND,CON132,CON100,CON135,CON140 CON132 B CON190 * CON135 * SUPPRESS LEADING ZEROES SET FSUPR B CON190 * CON140 * NO SUPPRESSION CLEAR FSUPR B CON190 * * CON150 * IN HEADER, SET GENERAL CONDITIONS IB VSEIND,CON152,CON100,CON155,CON160,CON152, C CON152,CON152,CON152,CON152,CON152, C CON152,CON152,CON165,CON170,CON175,CON180 CON152 B CON190 * CON155 * GENERAL SUPPRESS LEADING ZEROES SET BSUPR B CON100 * CON160 * GENERAL NO SUPPRESSION CBE W9,FC,CON100 LISTE: ALWAYS SET CLEAR BSUPR B CON100 * CON165 * EOR CHARACTER B CON100 * CON170 * CONTINUATION CHARACTER CBE W9,FC,CON100 LISTE: ALWAYS CLEAR SET BCONT INDICATE CONT. CHAR NEEDED B CON100 * CON175 * INSERT BATCH NAME MOVE BIN7,W6 MOVE BIN4,W188 SUB BIN4,BIN7 LENGTH FIELD SUB BIN4,BIN16 EDSUB BPOOL(BIN9),BIN16,FMTBATCH INSERT BATCHNAME B CON260 * CON180 * FIELDS (STARTING WITH &) ARE NOT SPLIT CLEAR SPLITFL NOT NORMAL SPLIT B CON100 * * CON190 CBE W9,FC,CON195 LISTE: ALL FIELDS INCLUDED TBF FSUPR,CON195 CALL EMPTYT,:FMTITEM TEST IF EMPTY BNZ CON280 EMPTY, IGNORE FIELD CON195 GETCTL 1,BIN7 GET MAXL TSTCTL 0 TEST - ALPHA BZ CON200 BCD * ALPHA MOVE BIN4,W188 GET EDIT BUFFER LENGTH SUB BIN4,BIN7 ADJUST WITH MAX LENGTH SUB BIN4,BIN16 ADJUST WITH EDIT POINTER BN CONER3 EDSUB BPOOL(BIN9),BIN16,FRMALP B CON260 EJECT * BCD CON200 CBG BIN7,W21,CONER2 BCD-OVERFLOW MOVE BIN4,W188 GET EDIT BUFFER LENGTH SUB BIN4,BIN7 ADJUST WITH MAX LENGTH SUB BIN4,BIN16 ADJUST WITH EDIT POINTER BN CONER3 GETCTL 3,BIN4 GET SCHK CALL TESTB,BIN4,W15 SIGN BZ CON220 NO TBF FSUPR,CON210 CBE W9,FC,CON205 EDSUB BPOOL(BIN9),BIN16,FRMTCS MOVE BIN13,BIN16 B CON280 CON205 IF LISTE EDSUB BPOOL(BIN9),BIN16,FRMZCS EDIT 21 DIGITS B CON215 CON210 EDSUB BPOOL(BIN9),BIN16,FRMBCS EDIT 21 DIGITS CON215 MOVE BIN4,W22 SET PICTURE LENGTH ADD BIN7,W1 ADJUST POINTER FOR SIGN B CON250 CON220 TBF FSUPR,CON230 CBE W9,FC,CON225 EDSUB BPOOL(BIN9),BIN16,FRMTCD MOVE BIN13,BIN16 B CON280 CON225 IF LISTE EDSUB BPOOL(BIN9),BIN16,FRMZCD B CON235 CON230 EDSUB BPOOL(BIN9),BIN16,FRMBCD CON235 MOVE BIN4,W21 SET PICUTR LENGTH CON250 SUB BIN4,BIN7 SET DELETE LENGTH DELETE BPOOL(BIN9),BIN13,BIN4 DELETE ADDED ZEROES CON260 ADD BIN13,BIN7 ADJUST DELETE/EDIT POINTER MOVE BIN16,BIN13 LOAD EDIT POINTER CON280 CBNE W9,FC,CON290 EDSUB BPOOL(BIN9),BIN16,FRMFILL LISTE: INSERT FILLER TBF FIRSTFL,CON285 NOT FIRST HEADER CBNE BTYPE,W3,CON285 NOT NORMAL TRANS CBL BIN16,WORK(W15),CON283 CLEAR FIRSTFL OUT OF FIRST HEADER CON283 IN FIRST HEADER ADD WORK(W15),W1 CON285 MOVE BIN13,BIN16 CON290 CBE VSEIND,W1,CONTRM APPL =1 TRANSM MOVE BIN4,RECLGD CBG BIN16,BIN4,CONTRM B CON100 EJECT CONRET RET ALL DONE CONTRM RET 2 WRITE/TRANSMIT BLOCK CONER1 RET 4 CUMPULSORY FIELD EMPTHY CONER2 RET 6 BCD FIELD OVERFLOW CONER3 RET 8 EDIT BUFFER OVERFLOW PEND EJECT * * FORMATS * FRMFILL FRMT FILLR ' ',1 FMEND FCOUNT FRMT FTEXT ' 1' FEOR NEW PAGE FILLR ' ',2 FILLR '*',10 FTEXT 'NUMMER: ' FMEL '9999',NUMBER FEOR FILLR ' ',2 FEOR FMEND FRMVOL1 FRMT FCOPY STR8A FMEND FRMVOL2 FRMT FMEL '999999',DATE FMEND FRMVOL3 FRMT FMEL '99',FDCNT FMEND FBATC3 FRMT FLINK FBATCH FTEXT 'EJ GODKENDT' FEOR FMEND FBATCH FRMT FNL FEOR FNL FTEXT 'JOBNAME: ' FCOPY JOBNAME FILLR ' ',4 FTEXT 'BATCHNAME: ' FCOPY BATCH FILLR ' ',4 FMEND FMTBATCH FRMT FCOPY BATCH FMEND FFDHDR FRMT FNL FEOR FNL FCOPY ='FLOPPY DISC SKRIVNING' FLINK HDR FMEND FFDEND FRMT FNL FEOR FNL FCOPY ='FLOPPY DISC SKRIVNING' FCOPY =' KLAR' FLINK HDR FEOR FNL FMEND FFDERR FRMT FNL FEOR FNL FCOPY ='FLOPPY DISC SKRIVNING' FCOPY =' AFBRYDES' FLINK HDR FEOR FNL FMEND FLSHDR FRMT FNL FEOR FNL FCOPY ='LISTNING' FLINK HDR FMEND FLSEND FRMT FNL FEOR FNL FCOPY ='LISTNING' FCOPY =' KLAR' FLINK HDR FEOR FNL FMEND FLSERR FRMT FNL FEOR FNL FCOPY ='LISTNING' FCOPY =' AFBRYDES' FLINK HDR FEOR FNL FMEND HDR FRMT FILLR ' ',4 FTEXT 'DATO: ' FMEL '99-99-99',DATE FILLR ' ',4 FTEXT 'TID: ' FMEL '99-99-99',TIME FEOR FNL FTEXT 'IND: ' FMEL '99999',NUMBER FTEXT ' UD: ' FMEL '99999',BCDI21(W5) FEOR FNL FMEND FCAS02 FRMT FSL FCOPY =C'DEVICE' FILLR ':',1 FINP 9 FCOPY STSAVE(W3) FTAB 20 FCOPY =C'FILE' FILLR '-',1 FCOPY =C'NAME' FILLR ':',1 FINP 32 FCOPY STR8B FNL FCOPY =C'EXPIRATION DATE:' FINP 32 FCOPY STR6A FNL FCOPY =C'OLD DATA SET IDENTIFIER:' FINP 32 FCOPY STR8A FNL FCOPY =C'OLD VOLUME SEQUENCE NO:' FINP 32 FCOPY STR2A FNL FKI 1 FCOPY HEX00 FMEND FFD999 FRMT FTEXT =C'SLUTD' FMEL '99999',BCDI21(W5) FILLR ' ',60 FILLR ' ',62 FMEND FRMALP FRMT FCOPY :FMTITEM FMEND FRMTCD FRMT FMEL 'TTTTTTTTTTTTTTTTTTTT9',:FMTITEM FMEND FRMTCS FRMT FMEL 'TTTTTTTTTTTTTTTTTTTT9-',:FMTITEM FMEND FRMZCD FRMT FMEL 'ZZZZZZZZZZZZZZZZZZZZ9',:FMTITEM FMEND FRMZCS FRMT FMEL 'ZZZZZZZZZZZZZZZZZZZZ9-',:FMTITEM FMEND FRMBCD FRMT FMEL '999999999999999999999',:FMTITEM FMEND FRMBCS FRMT FMEL '999999999999999999999-',:FMTITEM FMEND SNDFRM FRMT FSL FCOPY =C'DATATRANSMISSION' FILLR '?',1 FNL FNL FMEND * SNDFRM2 FRMT FILLR ' ',2 FCOPY =X'272020' FMEND * FDC999 FRMT FTEXT =C'SLUTD' FMEL '99999',BCDI21(W5) FMEND * FDCHDR FRMT FNL FEOR FNL FCOPY =C'BATCH TRANSMISSION' FLINK HDR FMEND * FDCEND FRMT FNL FEOR FNL FCOPY ='BATCH TRANSMISSION' FCOPY =C' KLAR' FLINK HDR FMEND * FDCERR FRMT FNL FEOR FNL FCOPY ='BATCH TRANSMISSION' FCOPY =' AFBRYDES' FLINK HDR FEOR FNL FMEND * * END