|
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: 17238 (0x4356)
Notes: pts_type(SC)
Names: »SUBS.SC«
└─⟦cd4bbebb4⟧ Bits:30009680 Philips computer tape "600221"
└─⟦this⟧ »BEBATM/SUBS.SC«
IDENT SUBS 830809 NJ ************************************************************************ * THIS ROUTINE CONTAINS VARIOUS SUBROUTINES USED WITHIN * THE ATM DEMO PACKAGE T A B S I M. ************************************************************************ DDUM DDIV PDIV ENTRY LOADER ENTRY TABINT ENTRY SETKL ENTRY SEDLER ENTRY BUNT ENTRY LUK EXPROC SCRIBE,PFRMT EXPROC KBINP EXPROC DLLATM EXPROC OPEN EXPROC CLOSE EXPROC READ EXPROC OPRCMD EJECT LOADER PROC * * THIS ROUTINE DOWNLINELOADS THE STATES, SCREENS ETC TO THE ATM. * THE INPUT IS TO RESIDE ON A FLOPPY FILE, CREATED BY THE ATM- * CONFIGURATOR. INPUT TO THE CONFIGURATOR IS CREATED BY THE * NORMAL EDITOR. * LOA010 MOVE VARIOUS,=C'SPECIFY DLL-FILE (IF NOT "MASTER")... ' PERF SCRIBE,VARIUS PERF KBINP BOK LOA020 PERF SCRIBE,WRONG INPUT ERROR B LOA010 TRY AGAIN LOA020 MOVE INFO,=C' ' PERF SCRIBE,INF CBNE INDEX,COB1,LOA010 NOT <ENTER> SUB LENGTH,COB1 THROW AWAY ENTER-KEY BNZ LOA025 NOT DEFAULT MOVE BUFIN,=C'MASTER ' MOVE LENGTH,COB6 LOA025 COPY DSFTABLE(COB1),COB0,COB8,INFO,COB0 COPY DSFTABLE(COB1),COB0,LENGTH,BUFIN,COB0 CHANGE FILENAME COPY DSFTABLE(COB1),COB8,COB6,VOLUME,COB0 CLEAR EOF PERF OPEN,COB1,WKB1 OPEN SOURCEFILE BOK LOA030 MOVE VARIOUS,=C'ASSIGNERROR ' PERF SCRIBE,VARIUS B LOA990 EXIT * LOA030 FILE IS NOW OPENED MOVE WKSTR7,=C'2' TAKE ATM OUT OF SERVICE PERF OPRCMD SEND, + RCV SOLL.STAT BNOK LOA030 TRY AGAIN MOVE VARIOUS,=C'* DOWNLINELOAD IN PROGRESS * ' PERF SCRIBE,VARIUS SET DLL INDICATE DLL IN PROGRESS MOVE WKSTG2,=X'4131201B3142331C1C1C31001C' HEADER MOVE PNT4,COB0 READ 1. LOGICAL PART MOVE RECNO,COB0 MOVE DISPL,COB0 MOVE FDLBUF,=C' ' * PERF RDNEXT READ FIRST RECORD BNOK LOA960 PERF RDNEXT READ 2. RECORD BNOK LOA960 PERF RDNEXT READ 3. RECORD BNOK LOA960 * LOA070 PNT4 POINTS TO MODIFIER SET MODIFLG INDICATE WE HAVE A MODIFIER XCOPY BIN5,COB0,COB2,FDLBUF,PNT4 MOVE MODIFIER ADD PNT4,COB2 LOA080 PNT4 POINTS TO RECORDNBR XCOPY BIN6,COB0,COB2,FDLBUF,PNT4 MOVE RECORDNBR ADD PNT4,COB2 XCOPY TLEN,COB0,COB2,FDLBUF,PNT4 MOVE TLEN ADD PNT4,COB2 POINT TO DATA SUB TLEN,COB4 DISREGARD RECNO+TLEN JUST NOW MOVE BUFIN,=X'00' CLEAR BUFFER XCOPY BUFIN,COB0,TLEN,FDLBUF,PNT4 * 'TLEN' CONTAINS DATATLEN IN 'BUFIN' * 'BIN5' CONTAINS MODIFIER * 'BIN6' CONTAINS RECORDNUMBER (NOT USED) MOVE LENGTH,TLEN MOVE WKBCD1,BIN5 MOVE MODIFIER EDIT WKSTG1,MODIF AND EDIT IT COPY WKSTG2,COB11,COB1,WKSTG1,COB0 MOVE IT INTO HEADER PERF DLLATM DOWNLINELOAD IT BNOK LOA970 EXIT IF ERROR ADD TLEN,COB4 RECNO+ACT.TLEN TBF MODIFLG,LOA100 MODIFIER TO BE DELETED? CLEAR MODIFLG IF SO, CLEAR FLAG ADD TLEN,COB2 AND DELETE 2 MORE SUB PNT4,COB2 LOA100 DLETE FDLBUF,COB0,TLEN SUB PNT4,COB4 SUB DISPL,TLEN XCOPY BIN7,COB0,COB2,FDLBUF,PNT4 1.WORD OF NEXT RECORD LOA105 CBNL DISPL,=W'255',LOA120 TIME FOR ANOTHER READ? TBT EOF,LOA120 PERF RDNEXT READ NEXT RECORD BNOK LOA960 B LOA105 EXTRA READ MIGHT BE NECESSARY LOA120 CBL BIN7,=W'256',LOA080 SAME SUBFILE? (:256) BG LOA940 SOME POINTER IS OVERWRITTEN ADD PNT4,COB2 POINT TO NEW MODIFIER XCOPY BIN7,COB0,COB2,FDLBUF,PNT4 AND COPY IT CBNE BIN7,=X'000A',LOA070 FINISHED IF MODIFIER="*A" MOVE VARIOUS,=C'DOWNLINE LOAD CONCLUDED CORRECTLY. ' PERF SCRIBE,VARIUS MOVE WKB1,COB1 PERF CLOSE,WKB1 CLEAR DLL CMP COB0,COB0 RET LOA940 MOVE VARIOUS,=C'DATA ERROR ON DISK ' INVALID RECORDNR PERF SCRIBE,VARIUS B LOA980 LOA960 MOVE VARIOUS,=C'READ/WRITE ERROR ON DATA DISK ' PERF SCRIBE,VARIUS B LOA980 LOA970 MOVE VARIOUS,=C'DLL ERROR ' PERF SCRIBE,VARIUS LOA980 MOVE WKB1,COB1 PERF CLOSE,WKB1 LOA990 RET PEND EJECT TABINT PROC * * THIS PROCEDURE CREATES VARIOUS TABLES AND OTHER FIELDS * IMMEDIATELY AFTER PROGRAM STARTUP. * THE INPUT IS FOUND ON VOLUME "VOLUME". * THE INPUTFIL WAS CREATED BY $PDISC * * IN THIS FILE VARIOUS RECORDTYPES MUST/CAN BE PRESENT: * :1 - DENOMINATION VALUES ETC * :2 - FUNCTION COMMANDS * - PRINTER DATA FOR THE ABOVEMENTIONED FUNCTION COMMANDS * :3 - PRINTER DATA FOR F.X. TOP-OF-RECEIPT * :4 - STATUS TEXTS * :256 - MARKS THE END OF THE FILE * TABI010 MOVE VARIOUS,=C'SPECIFY CONSTANTFILE (IF NOT "CONSTANT").. ' PERF SCRIBE,VARIUS PERF KBINP BOK TABI012 PERF SCRIBE,WRONG B TABI010 * TABI012 TABI020 MOVE INFO,=C' ' PERF SCRIBE,INF CBNE INDEX,COB1,TABI010 TEST FOR <ENTER> * SUB LENGTH,COB1 DISREGARD ENTER-KEY BNZ TABI025 NOT DEFAULT MOVE BUFIN,=C'CONSTANT' MOVE LENGTH,=W'8' TABI025 COPY DSFTABLE(COB2),COB0,COB8,INFO,COB0 SCRATCH FILENAME COPY DSFTABLE(COB2),COB0,LENGTH,BUFIN,COB0 SET FILENAME COPY DSFTABLE(COB2),COB8,COB6,VOLUME,COB0 VOLUMENAME PERF OPEN,COB2,WKB1 OPEN CONSTANT-FILE BOK TABI030 MOVE VARIOUS,=C'ASSIGN ERROR ' PERF SCRIBE,VARIUS B TABI990 EXIT AFTER ERROR * TABI030 MOVE RECNO,COB0 TABI040 READ A RECORD ADD RECNO,COB1 PERF READ,COB2,FDBUF,RECNO,STATUS BNOK TABI980 READ ERROR (PROBABLY) MOVE WKSTG4,FDBUF EXTRACT 4 BYTES CBE WKSTG4,=C':256',TABI900 EOF FOUND? * MOVE STAT,FDBUF NOT YET EOF CBNE STAT,=C':',TABI050 NEW RECORD TYPE? * DLETE WKSTG4,COB0,COB1 DELETE TYPE DELIMITER MOVE WKBCD3,WKSTG4 CONVERT TO BCD MOVE INDEX,COB0 RECORD IDENTIFIER MOVE OLDSET,=D'-1' INIT OLDSET MOVE DISPL,COB0 INIT DIPLACEMENTPOINTER B TABI040 AND TAKE NEXT RECORD * TABI050 * THE CURRENT TYPE IS FOUND IN WKBCD3 MOVE BIN7,WKBCD3 IB BIN7,TABI100, VARIOUS CONSTANTS C TABI200, FUNCTION COMMANDS C TABI300, PRINTER DATA C TABI400, STATUS MSG C TABI500, C TABI600, C TABI700, C TABI800 B TABI040 INVALID TYPE, IGNORE * TABI100 ADD INDEX,COB1 NEXT RECORD IDENTIFIER IB INDEX,TABI110,TABI110,TABI110,TABI110, C TABI110,TABI110,TABI110,TABI110, C TABI120, C TAB130 B TABI040 INVALID INDEX,IGNORE * TABI110 * 8 CURRENCY VALUES, RECORD IDENTIFIER 1..8 MOVE DENOM(INDEX),FDBUF CONVERT TO BCD B TABI040 * TABI120 * CURRENCY TEXT, RECORD IDENTIFIER 9 MOVE CURR,FDBUF B TABI040 * TAB130 * MAXIMUM WITHDRAWAL. NO DECIMALS MOVE HILIMIT,FDBUF B TABI040 * TABI200 * FUNCTION COMMANDS, PRINTER DATA MOVE COMB,FDBUF EXTRACT SEQ.NBR MOVE SET,COMB CONVERT TO BCD DLETE FDBUF,COB0,COB2 DELETE SEQ.NBR CBNE SET,OLDSET,TABI220 * SAME SET, IMPLICITS PRINTER DATA CBL DISPL,=W'211',TABI210 PREVENT OVERFLOW MOVE DISPL,=W'210' TABI210 MOVE WKBIN1,=W'40' XCOPY PTAB(INDEX),DISPL,WKBIN1,FDBUF,COB0 CONCATENATE ADD DISPL,=W'40' ROOM FOR NEXT PRINTERDATA MOVE PLEN(INDEX,COB1),DISPL SET CRUDE LENGTH B TABI040 * TABI220 * NEW SET, IMPLICIT FUNCTION COMMAND ADD INDEX,COB1 NEXT RECORD IDENTIFIER MOVE OLDSET,SET INITIATE FOR FURTHER TESTING MOVE FCBLD(INDEX),FDBUF SAVE FUNCTION COMMAND MOVE DISPL,COB0 PRINTERDATA STARTS IN POS 0 B TABI040 * TABI300 * PRINTER DATA, VARIOUS NATIONAL RUBBISH MOVE COMB,FDBUF MOVE SET,COMB CONVERT SET TO BCD DLETE FDBUF,COB0,COB2 DELETE SEQ.NBR CBNE SET,OLDSET,TABI320 CBL DISPL,=W'211',TABI310 PREVENT OVERFLOW MOVE DISPL,=W'210' BY SETTING FIXED POINTER TABI310 MOVE WKBIN1,PRWIDTH XCOPY PNAT(INDEX),DISPL,WKBIN1,FDBUF,COB0 ADD DISPL,PRWIDTH ROOM FOR NEXT PRINTERDATA MOVE PLEN(INDEX,COB2),DISPL SET CRUDE LENGTH B TABI040 * TABI320 ADD INDEX,COB1 NEW SET MOVE OLDSET,SET MOVE DISPL,COB0 B TABI310 TABI400 MOVE STATTXT(INDEX),FDBUF B TABI040 * TABI500 TABI600 TABI700 TABI800 B TABI040 IGNORE THOSE RECORD TYPES * TABI900 :256 FOUND MOVE VARIOUS,=C'CONSTANTS LOADED CORRECTLY. ' PERF SCRIBE,VARIUS PERF CLOSE,COB2 CLOSE CONSTANTFILE TABI910 MOVE VARIOUS,=C'L@BENR. DEPONERING................. ' PERF SCRIBE,VARIUS PERF KBINP BNOK TABI910 CBNE INDEX,COB1,TABI910 SUB LENGTH,COB1 BNZ TABI915 MOVE BUFIN,=C'1 ' TABI915 MOVE SRLNBR(COB2),BUFIN CONVERT TO BCD CBNG SRLNBR(COB2),=D'9999',TABI920 CHECK FOR VALID RANGE MOVE SRLNBR(COB2),=D'1' SET VALID VALUE TABI920 MOVE VARIOUS,=C'DAGENS DATO: (DDMM]]).............. ' PERF SCRIBE,VARIUS PERF KBINP BNOK TABI920 CBNE INDEX,COB1,TABI920 SUB LENGTH,COB1 BNZ TABI925 MOVE BUFIN,=C'150883' MOVE LENGTH,COB6 TABI925 CBNE LENGTH,COB6,TABI920 MOVE DATE,BUFIN TABI930 PERF SETKL TAB940 MOVE VARIOUS,=C'L@PENR. UTTAK .......... ' PERF SCRIBE,VARIUS PERF KBINP BNOK TAB940 CBNE INDEX,COB1,TAB940 SUB LENGTH,COB1 BZ TAB940 MOVE SRLNBR(COB1),BUFIN PERF SEDLER * MOVE VARIOUS,=C' ' PERF SCRIBE,VARIUS PERF CONVERT PERF CONDENS FIND THE REAL LENGTHS CMP COB0,COB0 RET * TABI980 MOVE VARIOUS,=C'READ ERROR ' PERF SCRIBE,VARIUS PERF CLOSE,COB2 CLOSE CONSTANT FILE CMP COB0,COB1 SET CR TO NOK RET * TABI990 CMP COB0,COB1 SET CR TO NOK RET PEND EJECT SETKL PROC SETKL0 MOVE VARIOUS,=C'HVA ER KLOKKEN? .......... ' PERF SCRIBE,VARIUS PERF KBINP BNOK SETKL0 CBNE INDEX,COB1,SETKL0 SUB LENGTH,COB1 CBNE LENGTH,COB4,SETKL0 MOVE KL,BUFIN RET PEND SEDLER PROC SEDL00 MOVE VARIOUS,=C'BEL@BS[NDRING SKUFFE 1 (+/-) ..... ' PERF SCRIBE,VARIUS PERF KBINP BNOK SEDL00 CBNE INDEX,COB1,SEDL00 SUB LENGTH,COB1 BZ SEDL10 NO CHANGE IN DRAWER 1 MOVE WKBCD1,BUFIN ADD BEHOLDN(COB1,COB1),WKBCD1 SEDL10 MOVE VARIOUS,=C'BEL@PS[NDRING SKIFFE 2(+/-) ..... ' PERF SCRIBE,VARIUS PERF KBINP BNOK SEDL10 CBNE INDEX,COB1,SEDL10 SUB LENGTH,COB1 BZ SEDL20 NO CHANGE IN DRAWER 2 MOVE WKBCD1,BUFIN ADD BEHOLDN(COB2,COB1),WKBCD1 SEDL20 RET PEND EJECT CONDENS PROC * * THE PROCEDURE CONVERTS THE CRUDE LENGTHS OF THE PRINTERDATA * TO SOME MORE CIVILIZED ONES BY FINDING THE LAST USED CHARACTER * IN THE LINE. THIS IS ACCOMPLISHED BY A BACKWARD MATCH. * MOVE BIN4,=W'30' NBR OF ELEMENTS IN PTAB COND10 CBE PLEN(BIN4,COB1),COB0,COND40 ELEMENT IN USE? MOVE BIN6,PLEN(BIN4,COB1) MOVE CRUDE LENGTH SUB BIN6,COB1 ADJUST COND20 XCOPY STAT,COB0,COB1,PTAB(BIN4),BIN6 RIGHTMOST CHR CBNE STAT,=C' ',COND30 NON-BLANK FOUND? SUB BIN6,COB1 NO, TRY NEXT BYTE BNZ COND20 IF ANYTHING LEFT AT ALL COND30 ADD BIN6,COB1 ADJUST AGAIN MOVE PLEN(BIN4,COB1),BIN6 MOVE CLEANED LENGTH COND40 SUB BIN4,COB1 TRY NEXT PRINTLINE BP COND10 IF ANYTHING LEFT * MOVE BIN4,COB10 NBR OF ELEMENTS IN PNAT COND110 CBE PLEN(BIN4,COB2),COB0,COND140 ELEMENT IN USE? MOVE BIN6,PLEN(BIN4,COB2) MOVE CRUDE LENGTH SUB BIN6,COB1 ADJUST COND120 XCOPY STAT,COB0,COB1,PNAT(BIN4),BIN6 RIGHTMOST CHR CBNE STAT,=C' ',COND130 NON-BLANK FOUND SUB BIN6,COB1 NO, TRY NEXT BYTE BNZ COND120 IF ANYTHING LEFT AT ALL COND130 ADD BIN6,COB1 ADJUST BACK MOVE PLEN(BIN4,COB2),BIN6 MOVE CLEANED LENGTH COND140 SUB BIN4,COB1 TRY NEXT PRINTLINE BP COND110 IF THERE WAS MORE LEFT * RET PEND EJECT CONVERT PROC * * THIS ROUTINE CONVERTS EVTL. SPECIAL CHARACTERS IN THE PRINTERDATA * THE FOLLOWING CONVERSIONS TAKE PLACE: * # -> <LF> * ! -> <FF> * " -> <SO> * MOVE BIN4,=W'30' NBR OF ELEMENTS CONV00 MOVE COMB,=X'230A' HASH TO LINEFEED MOVE BIN5,=W'250' MOVE BIN6,COB0 MATCH PTAB(BIN4),BIN6,BIN5,COMB,COB0,COB1 BNOK CONV20 COPY PTAB(BIN4),BIN6,COB1,COMB,COB1 B CONV00 THERE MIGHT BE MORE CONV20 MOVE COMB,=X'210C' EXCL.MARK TO FORMFEED MOVE BIN5,=W'250' MOVE BIN6,COB0 MATCH PTAB(BIN4),BIN6,BIN5,COMB,COB0,COB1 BNOK CONV40 COPY PTAB(BIN4),BIN6,COB1,COMB,COB1 B CONV20 CONV40 MOVE COMB,=X'220E' DOUBLE QUOTE TO SHIFTOUT MOVE BIN5,=W'250' MOVE BIN6,COB0 MATCH PTAB(BIN4),BIN6,BIN5,COMB,COB0,COB1 BNOK CONV60 COPY PTAB(BIN4),BIN6,COB1,COMB,COB1 B CONV40 CONV60 SUB BIN4,COB1 BP CONV00 * MOVE BIN4,=W'10' NUMBER OF ELEMENTS IN PNAT CONV100 MOVE BIN5,=W'250' MOVE BIN6,COB0 MOVE COMB,=X'230A' MATCH PNAT(BIN4),BIN6,BIN5,COMB,COB0,COB1 BNOK CONV120 COPY PNAT(BIN4),BIN6,COB1,COMB,COB1 B CONV100 CONV120 MOVE COMB,=X'210C' MOVE BIN5,=W'250' MOVE BIN6,COB0 MATCH PNAT(BIN4),BIN6,BIN5,COMB,COB0,COB1 BNOK CONV140 COPY PNAT(BIN4),BIN6,COB1,COMB,COB1 B CONV120 CONV140 MOVE COMB,=X'220E' MOVE BIN5,=W'250' MOVE BIN6,COB0 MATCH PNAT(BIN4),BIN6,BIN5,COMB,COB0,COB1 BNOK CONV160 COPY PNAT(BIN4),BIN6,COB1,COMB,COB1 B CONV140 CONV160 SUB BIN4,COB1 BP CONV100 * CMP COB0,COB0 RET PEND EJECT RDNEXT PROC ADD RECNO,COB1 POINT TO NEXT RECORD PERF READ,COB1,FDBUF,RECNO,STATUS BNOK RDN300 * XCOPY FDLBUF,DISPL,RECLEN,FDBUF,COB0 CONCATENATE BUFFER ADD DISPL,RECLEN PREPARE FOR NEXT READ MOVE WKSTR6,=X'1C0100000A' <FS>!<:256>!<*A> MOVE WKB1,COB0 STARTPOINT MATCH MOVE WKBIN1,=W'384' BUFFER LENGTH MATCH FDLBUF,WKB1,WKBIN1,WKSTR6,COB0,COB5 SEARCH FOR EOF BNOK RDN200 NOT FOUND SET EOF EOF FOUND, SET FLAG RDN200 CMP COB0,COB0 RDN300 RET PEND BUNT PROC RET PEND LUK PROC RET PEND EJECT VARIUS FRMT FCOPY ='22' FCOPY VARIOUS FMEND WRONG FRMT FCOPY ='++' FCOPY ='REJECTED' FNL FILLR ' ',30 FCOPY =': ' FMEND MODIF FRMT FMEL '9',WKBCD1 FMEND INF FRMT FCOPY =C'22' FCOPY INFO FMEND END